diff --git a/.arcconfig b/.arcconfig
new file mode 100644
index 000000000000..b9c39321eda3
--- /dev/null
+++ b/.arcconfig
@@ -0,0 +1,5 @@
+{
+  "project.name"        : "ghc",
+  "repository.callsign" : "GHC",
+  "phabricator.uri"     : "https://phabricator.haskell.org"
+}
diff --git a/.arclint b/.arclint
new file mode 100644
index 000000000000..f7980155fbff
--- /dev/null
+++ b/.arclint
@@ -0,0 +1,86 @@
+{
+  "linters": {
+    "filename": {
+      "type": "filename"
+    },
+    "generated": {
+      "type": "generated"
+    },
+    "merge-conflict": {
+      "type": "merge-conflict"
+    },
+    "nolint": {
+      "type": "nolint"
+    },
+    "haskell": {
+      "type": "text",
+      "include": ["(\\.(l?hs(-boot)?|x|y\\.pp)(\\.in)?$)"],
+      "severity": {
+        "5": "disabled"
+      }
+    },
+    "c": {
+      "type": "text",
+      "include": ["(\\.(c|h)(\\.in)?$)"]
+    },
+    "text-xml": {
+      "type": "text",
+      "include": "(\\.xml$)",
+      "severity": {
+        "5": "disabled",
+        "3": "disabled"
+      }
+    },
+    "shell": {
+      "type": "text",
+      "include": [ "(\\.sh$)" ],
+      "text.max-line-length": 200
+    },
+    "makefiles": {
+      "type": "text",
+      "include": [ "(Makefile$)", "(\\.mk$)" ],
+      "text.max-line-length": 200,
+      "severity": {
+        "2": "disabled"
+      }
+    }
+  },
+
+  "exclude":
+    [ "(^libffi-tarballs)",
+      "(^libraries/binary)",
+      "(^libraries/bytestring)",
+      "(^libraries/Cabal)",
+      "(^libraries/containers)",
+      "(^libraries/haskeline)",
+      "(^libraries/pretty)",
+      "(^libraries/terminfo)",
+      "(^libraries/transformers)",
+      "(^libraries/xhtml)",
+      "(^libraries/Win32)",
+      "(^libraries/primitive)",
+      "(^libraries/vector)",
+      "(^libraries/time)",
+      "(^libraries/random)",
+      "(^libraries/array)",
+      "(^libraries/deepseq)",
+      "(^libraries/directory)",
+      "(^libraries/filepath)",
+      "(^libraries/haskell98)",
+      "(^libraries/haskell2010)",
+      "(^libraries/hoopl)",
+      "(^libraries/hpc)",
+      "(^libraries/old-locale)",
+      "(^libraries/old-time)",
+      "(^libraries/process)",
+      "(^libraries/unix)",
+      "(^libraries/parallel)",
+      "(^libraries/stm)",
+      "(^libraries/dph)",
+      "(^utils/haddock)",
+      "(^nofib)",
+      "(^utils/hsc2hs)",
+      "(^libffi-tarballs)",
+      "(^ghc-tarballs)"
+    ]
+}
diff --git a/.gitignore b/.gitignore
index 57774d1ac27f..99bf3a6bab7c 100644
--- a/.gitignore
+++ b/.gitignore
@@ -46,33 +46,6 @@ _darcs/
 # sub-repositories
 
 /ghc-tarballs/
-/libffi-tarballs/
-/libraries/array/
-/libraries/base/
-/libraries/deepseq/
-/libraries/directory/
-/libraries/dph/
-/libraries/extensible-exceptions/
-/libraries/filepath/
-/libraries/ghc-prim/
-/libraries/haskell2010/
-/libraries/haskell98/
-/libraries/hoopl/
-/libraries/hpc/
-/libraries/integer-gmp/
-/libraries/integer-simple/
-/libraries/mtl/
-/libraries/old-locale/
-/libraries/old-time/
-/libraries/parallel/
-/libraries/process/
-/libraries/stm/
-/libraries/template-haskell/
-/libraries/unix/
-/libraries/utf8-string/
-/nofib/
-/utils/haddock/
-/utils/hsc2hs/
 
 # -----------------------------------------------------------------------------
 # Cabal dist directories
@@ -173,5 +146,7 @@ _darcs/
 /utils/runghc/runghc.cabal
 
 /extra-gcc-opts
+/sdistprep
 
 .tm_properties
+VERSION
diff --git a/.gitmodules b/.gitmodules
index f0fd2807abc1..66f4f37d6d9f 100644
--- a/.gitmodules
+++ b/.gitmodules
@@ -1,56 +1,133 @@
 [submodule "libraries/binary"]
 	path = libraries/binary
-	url = http://git.haskell.org/packages/binary.git
+	url = ../packages/binary.git
 	ignore = untracked
 [submodule "libraries/bytestring"]
 	path = libraries/bytestring
-	url = http://git.haskell.org/packages/bytestring.git
+	url = ../packages/bytestring.git
 	ignore = untracked
 [submodule "libraries/Cabal"]
 	path = libraries/Cabal
-	url = http://git.haskell.org/packages/Cabal.git
+	url = ../packages/Cabal.git
 	ignore = untracked
 [submodule "libraries/containers"]
 	path = libraries/containers
-	url = http://git.haskell.org/packages/containers.git
+	url = ../packages/containers.git
 	ignore = untracked
 [submodule "libraries/haskeline"]
 	path = libraries/haskeline
-	url = http://git.haskell.org/packages/haskeline.git
+	url = ../packages/haskeline.git
 	ignore = untracked
 [submodule "libraries/pretty"]
 	path = libraries/pretty
-	url = http://git.haskell.org/packages/pretty.git
+	url = ../packages/pretty.git
 	ignore = untracked
 [submodule "libraries/terminfo"]
 	path = libraries/terminfo
-	url = http://git.haskell.org/packages/terminfo.git
+	url = ../packages/terminfo.git
 	ignore = untracked
 [submodule "libraries/transformers"]
 	path = libraries/transformers
-	url = http://git.haskell.org/packages/transformers.git
+	url = ../packages/transformers.git
 	ignore = untracked
 [submodule "libraries/xhtml"]
 	path = libraries/xhtml
-	url = http://git.haskell.org/packages/xhtml.git
+	url = ../packages/xhtml.git
 	ignore = untracked
 [submodule "libraries/Win32"]
 	path = libraries/Win32
-	url = http://git.haskell.org/packages/Win32.git
+	url = ../packages/Win32.git
 	ignore = untracked
 [submodule "libraries/primitive"]
 	path = libraries/primitive
-	url = http://git.haskell.org/packages/primitive.git
+	url = ../packages/primitive.git
 	ignore = untracked
 [submodule "libraries/vector"]
 	path = libraries/vector
-	url = http://git.haskell.org/packages/vector.git
+	url = ../packages/vector.git
 	ignore = untracked
 [submodule "libraries/time"]
 	path = libraries/time
-	url = http://git.haskell.org/packages/time.git
+	url = ../packages/time.git
 	ignore = untracked
 [submodule "libraries/random"]
 	path = libraries/random
-	url = http://git.haskell.org/packages/random.git
+	url = ../packages/random.git
 	ignore = untracked
+[submodule "libraries/array"]
+	path = libraries/array
+	url = ../packages/array.git
+	ignore = none
+[submodule "libraries/deepseq"]
+	path = libraries/deepseq
+	url = ../packages/deepseq.git
+	ignore = none
+[submodule "libraries/directory"]
+	path = libraries/directory
+	url = ../packages/directory.git
+	ignore = none
+[submodule "libraries/filepath"]
+	path = libraries/filepath
+	url = ../packages/filepath.git
+	ignore = none
+[submodule "libraries/haskell98"]
+	path = libraries/haskell98
+	url = ../packages/haskell98.git
+	ignore = none
+[submodule "libraries/haskell2010"]
+	path = libraries/haskell2010
+	url = ../packages/haskell2010.git
+	ignore = none
+[submodule "libraries/hoopl"]
+	path = libraries/hoopl
+	url = ../packages/hoopl.git
+	ignore = none
+[submodule "libraries/hpc"]
+	path = libraries/hpc
+	url = ../packages/hpc.git
+	ignore = none
+[submodule "libraries/old-locale"]
+	path = libraries/old-locale
+	url = ../packages/old-locale.git
+	ignore = none
+[submodule "libraries/old-time"]
+	path = libraries/old-time
+	url = ../packages/old-time.git
+	ignore = none
+[submodule "libraries/process"]
+	path = libraries/process
+	url = ../packages/process.git
+	ignore = none
+[submodule "libraries/unix"]
+	path = libraries/unix
+	url = ../packages/unix.git
+	ignore = none
+[submodule "libraries/parallel"]
+	path = libraries/parallel
+	url = ../packages/parallel.git
+	ignore = none
+[submodule "libraries/stm"]
+	path = libraries/stm
+	url = ../packages/stm.git
+	ignore = none
+[submodule "libraries/dph"]
+	path = libraries/dph
+	url = ../packages/dph.git
+	ignore = none
+[submodule "utils/haddock"]
+	path = utils/haddock
+	url = ../haddock.git
+	ignore = none
+	branch = ghc-head
+[submodule "nofib"]
+	path = nofib
+	url = ../nofib.git
+	ignore = none
+[submodule "utils/hsc2hs"]
+	path = utils/hsc2hs
+	url = ../hsc2hs.git
+	ignore = none
+[submodule "libffi-tarballs"]
+	path = libffi-tarballs
+	url = ../libffi-tarballs.git
+	ignore = none
diff --git a/.travis.yml b/.travis.yml
new file mode 100644
index 000000000000..aaf7dd776eda
--- /dev/null
+++ b/.travis.yml
@@ -0,0 +1,36 @@
+git:
+  submodules: false
+
+notifications:
+  email:
+    - mail@joachim-breitner.de
+    - ghc-builds@haskell.org
+
+env:
+ - DEBUG_STAGE2=YES
+ - DEBUG_STAGE2=NO
+
+before_install:
+ - git config --global url."git://github.com/ghc/packages-".insteadOf     git://github.com/ghc/packages/
+ - git config --global url."http://github.com/ghc/packages-".insteadOf    http://github.com/ghc/packages/
+ - git config --global url."https://github.com/ghc/packages-".insteadOf   https://github.com/ghc/packages/
+ - git config --global url."ssh://git@github.com/ghc/packages-".insteadOf ssh://git@github.com/ghc/packages/
+ - git config --global url."git@github.com:/ghc/packages-".insteadOf      git@github.com:/ghc/packages/
+ - git submodule update --init --recursive
+install:
+ - sudo apt-get update
+ - sudo apt-get install haskell-platform autoconf libtool make ncurses-dev g++ dblatex docbook-xsl docbook-utils
+ - cabal update
+ - cabal install happy alex
+script:
+ - echo 'V = 0' >> mk/validate.mk # otherwise we hit log file limits on travis.
+ # do  not build docs
+ - echo 'HADDOCK_DOCS       = NO' >> mk/validate.mk
+ - echo 'BUILD_DOCBOOK_HTML = NO' >> mk/validate.mk
+ - echo 'BUILD_DOCBOOK_PS   = NO' >> mk/validate.mk
+ - echo 'BUILD_DOCBOOK_PDF  = NO' >> mk/validate.mk
+ # do not build dynamic libraries
+ - echo 'DYNAMIC_GHC_PROGRAMS = NO' >> mk/validate.mk
+ - echo 'GhcLibWays = v' >> mk/validate.mk
+ - if [ "$DEBUG_STAGE" = "YES" ]; then echo 'GhcStage2HcOpts += -DDEBUG' >> mk/validate.mk; fi
+ - CPUS=2 SKIP_PERF_TESTS=YES PATH=~/.cabal/bin:$PATH ./validate --fast
diff --git a/Makefile b/Makefile
index ce6735979205..c4cce6d4056d 100644
--- a/Makefile
+++ b/Makefile
@@ -30,10 +30,10 @@ default : all
 
 # For help, type 'make help'
 .PHONY: help
-help :
+help:
 	@cat MAKEHELP
 
-ifneq "$(findstring clean,$(MAKECMDGOALS))" ""
+ifneq "$(filter maintainer-clean distclean clean help,$(MAKECMDGOALS))" ""
 -include mk/config.mk
 else
 include mk/config.mk
@@ -72,7 +72,7 @@ endif
 	$(MAKE) -r --no-print-directory -f ghc.mk phase=final $@
 
 binary-dist: binary-dist-prep
-	mv bindistprep/*.tar.bz2 .
+	mv bindistprep/*.tar.$(TAR_COMP_EXT) .
 
 binary-dist-prep:
 ifeq "$(mingw32_TARGET_OS)" "1"
diff --git a/README.md b/README.md
index c9c38f1960f7..f35df7256b74 100644
--- a/README.md
+++ b/README.md
@@ -1,6 +1,8 @@
 The Glasgow Haskell Compiler
 ============================
 
+[![Build Status](https://api.travis-ci.org/ghc/ghc.svg?branch=master)](http://travis-ci.org/ghc/ghc)
+
 This is the source tree for [GHC][1], a compiler and interactive
 environment for the Haskell functional programming language.
 
diff --git a/Vagrantfile b/Vagrantfile
new file mode 100644
index 000000000000..9f6f1a0ab6c7
--- /dev/null
+++ b/Vagrantfile
@@ -0,0 +1,50 @@
+# -*- mode: ruby -*-
+# vi: set ft=ruby :
+
+MACHINES =
+  { "ubuntu1204-i386" =>
+      { :box       => "chef/ubuntu-12.04-i386",
+        :provision => "utils/vagrant/bootstrap-deb.sh"
+      },
+    "ubuntu1204-amd64" =>
+      { :box       => "chef/ubuntu-12.04",
+        :provision => "utils/vagrant/bootstrap-deb.sh"
+      },
+    "centos65-i386" =>
+      { :box       => "chef/centos-6.5-i386",
+        :provision => "utils/vagrant/bootstrap-rhel.sh"
+      },
+    "centos65-amd64" =>
+      { :box       => "chef/centos-6.5",
+        :provision => "utils/vagrant/bootstrap-rhel.sh"
+      },
+    "debian74-i386" =>
+      { :box       => "chef/debian-7.4-i386",
+        :provision => "utils/vagrant/bootstrap-deb.sh"
+      },
+    "debian74-amd64" =>
+      { :box       => "chef/debian-7.4",
+        :provision => "utils/vagrant/bootstrap-deb.sh"
+      }
+  }
+
+VAGRANTFILE_API_VERSION = "2"
+Vagrant.configure(VAGRANTFILE_API_VERSION) do |config|
+  MACHINES.each_pair do |name, opts|
+    config.vm.define name do |c|
+      c.vm.box = opts[:box]
+      c.vm.network "public_network"
+      c.vm.provision :shell, :path => opts[:provision]
+      c.vm.provider "virtualbox" do |vb|
+        vb.gui = false; vb.memory = 4096; vb.cpus = 2
+        vb.customize ["modifyvm", :id, "--natdnshostresolver1", "on"]
+      end
+      c.vm.provider "vmware_workstation" do |vb|
+        vb.gui = false; vb.vmx["memsize"]  = "4096"; vb.vmx["numvcpus"] = "2"
+      end
+      c.vm.provider "vmware_fusion" do |vb|
+        vb.gui = false; vb.vmx["memsize"]  = "4096"; vb.vmx["numvcpus"] = "2"
+      end
+    end
+  end
+end
diff --git a/aclocal.m4 b/aclocal.m4
index a30fa4fa67ee..d3a32b80c2d0 100644
--- a/aclocal.m4
+++ b/aclocal.m4
@@ -197,6 +197,9 @@ AC_DEFUN([FPTOOLS_SET_HASKELL_PLATFORM_VARS],
             GET_ARM_ISA()
             test -z "[$]2" || eval "[$]2=\"ArchARM {armISA = \$ARM_ISA, armISAExt = \$ARM_ISA_EXT, armABI = \$ARM_ABI}\""
             ;;
+        aarch64)
+            test -z "[$]2" || eval "[$]2=ArchARM64"
+            ;;
         alpha)
             test -z "[$]2" || eval "[$]2=ArchAlpha"
             ;;
@@ -206,7 +209,7 @@ AC_DEFUN([FPTOOLS_SET_HASKELL_PLATFORM_VARS],
         mipsel)
             test -z "[$]2" || eval "[$]2=ArchMipsel"
             ;;
-        hppa|hppa1_1|ia64|m68k|rs6000|s390|s390x|sparc64|vax)
+        hppa|hppa1_1|ia64|m68k|powerpc64le|rs6000|s390|s390x|sparc64|vax)
             test -z "[$]2" || eval "[$]2=ArchUnknown"
             ;;
         *)
@@ -451,6 +454,8 @@ AC_DEFUN([FP_SETTINGS],
     then
         mingw_bin_prefix=mingw/bin/
         SettingsCCompilerCommand="\$topdir/../${mingw_bin_prefix}gcc.exe"
+        SettingsHaskellCPPCommand="\$topdir/../${mingw_bin_prefix}gcc.exe"
+        SettingsHaskellCPPFlags="$HaskellCPPArgs"
         SettingsLdCommand="\$topdir/../${mingw_bin_prefix}ld.exe"
         SettingsArCommand="\$topdir/../${mingw_bin_prefix}ar.exe"
         SettingsPerlCommand='$topdir/../perl/perl.exe'
@@ -459,6 +464,8 @@ AC_DEFUN([FP_SETTINGS],
         SettingsTouchCommand='$topdir/touchy.exe'
     else
         SettingsCCompilerCommand="$WhatGccIsCalled"
+        SettingsHaskellCPPCommand="$HaskellCPPCmd"
+        SettingsHaskellCPPFlags="$HaskellCPPArgs"
         SettingsLdCommand="$LdCmd"
         SettingsArCommand="$ArCmd"
         SettingsPerlCommand="$PerlCmd"
@@ -483,6 +490,8 @@ AC_DEFUN([FP_SETTINGS],
     SettingsCCompilerLinkFlags="$CONF_GCC_LINKER_OPTS_STAGE2"
     SettingsLdFlags="$CONF_LD_LINKER_OPTS_STAGE2"
     AC_SUBST(SettingsCCompilerCommand)
+    AC_SUBST(SettingsHaskellCPPCommand)
+    AC_SUBST(SettingsHaskellCPPFlags)
     AC_SUBST(SettingsCCompilerFlags)
     AC_SUBST(SettingsCCompilerLinkFlags)
     AC_SUBST(SettingsLdCommand)
@@ -517,6 +526,12 @@ AC_DEFUN([FPTOOLS_SET_C_LD_FLAGS],
     esac
 
     case $$1 in
+    i386-unknown-mingw32)
+        $2="$$2 -march=i686"
+        ;;
+    i386-portbld-freebsd*)
+        $2="$$2 -march=i686"
+        ;;
     i386-apple-darwin)
         $2="$$2 -m32"
         $3="$$3 -m32"
@@ -529,6 +544,12 @@ AC_DEFUN([FPTOOLS_SET_C_LD_FLAGS],
         $4="$$4 -arch x86_64"
         $5="$$5 -m64"
         ;;
+    x86_64-unknown-solaris2)
+        $2="$$2 -m64"
+        $3="$$3 -m64"
+        $4="$$4 -m64"
+        $5="$$5 -m64"
+        ;;
     alpha-*)
         # For now, to suppress the gcc warning "call-clobbered
         # register used for global register variable", we simply
@@ -643,6 +664,10 @@ AC_ARG_WITH($2,
     else
         $1=$withval
     fi
+
+    # Remember that we set this manually.  Used to override CC_STAGE0
+    # and friends later, if we are not cross-compiling.
+    With_$2=$withval
 ],
 [
     if test "$HostOS" != "mingw32"
@@ -685,6 +710,10 @@ AC_ARG_WITH($2,
     else
         $1=$withval
     fi
+
+    # Remember that we set this manually.  Used to override CC_STAGE0
+    # and friends later, if we are not cross-compiling.
+    With_$2=$withval
 ],
 [
     if test "$HostOS" != "mingw32"
@@ -695,6 +724,8 @@ AC_ARG_WITH($2,
 )
 ]) # FP_ARG_WITH_PATH_GNU_PROG_OPTIONAL
 
+
+
 # FP_PROG_CONTEXT_DIFF
 # --------------------
 # Figure out how to do context diffs. Sets the output variable ContextDiffCmd.
@@ -864,7 +895,7 @@ else
 fi;
 changequote([, ])dnl
 ])
-if test ! -f compiler/parser/Parser.hs || test ! -f compiler/cmm/CmmParse.hs || test ! -f compiler/parser/ParserCore.hs
+if test ! -f compiler/parser/Parser.hs || test ! -f compiler/cmm/CmmParse.hs
 then
     FP_COMPARE_VERSIONS([$fptools_cv_happy_version],[-lt],[1.19],
       [AC_MSG_ERROR([Happy version 1.19 or later is required to compile GHC.])])[]
@@ -1137,6 +1168,16 @@ AC_DEFUN([FP_PROG_AR_NEEDS_RANLIB],[
         esac
     fi
 
+    # workaround for AC_PROG_RANLIB which sets RANLIB to `:' when
+    # ranlib is missing on the target OS. The problem is that
+    # ghc-cabal cannot execute `:' which is a shell built-in but can
+    # execute `true' which is usually simple program supported by the
+    # OS.
+    # Fixes #8795
+    if test "$RANLIB" = ":"
+    then
+        RANLIB="true"
+    fi
     REAL_RANLIB_CMD="$RANLIB"
     if test $fp_cv_prog_ar_needs_ranlib = yes
     then
@@ -1788,7 +1829,12 @@ AC_MSG_NOTICE(Building in-tree ghc-pwd)
     dnl except we don't want to have to know what make is called. Sigh.
     rm -rf utils/ghc-pwd/dist-boot
     mkdir  utils/ghc-pwd/dist-boot
-    if ! "$WithGhc" -v0 -no-user-$GHC_PACKAGE_DB_FLAG -hidir utils/ghc-pwd/dist-boot -odir utils/ghc-pwd/dist-boot -stubdir utils/ghc-pwd/dist-boot --make utils/ghc-pwd/Main.hs -o utils/ghc-pwd/dist-boot/ghc-pwd
+    dnl If special linker flags are needed to build things, then allow
+    dnl the user to pass them in via LDFLAGS.
+    changequote(, )dnl
+    GHC_LDFLAGS=`echo $LDFLAGS | sed -r 's/(^| )([^ ])/\1-optl\2/g'`
+    changequote([, ])dnl
+    if ! "$WithGhc" $GHC_LDFLAGS -v0 -no-user-$GHC_PACKAGE_DB_FLAG -hidir utils/ghc-pwd/dist-boot -odir utils/ghc-pwd/dist-boot -stubdir utils/ghc-pwd/dist-boot --make utils/ghc-pwd/Main.hs -o utils/ghc-pwd/dist-boot/ghc-pwd
     then
         AC_MSG_ERROR([Building ghc-pwd failed])
     fi
@@ -1831,6 +1877,9 @@ AC_MSG_CHECKING(for path to top of build tree)
 # converts cpu from gnu to ghc naming, and assigns the result to $target_var
 AC_DEFUN([GHC_CONVERT_CPU],[
 case "$1" in
+  aarch64*)
+    $2="aarch64"
+    ;;
   alpha*)
     $2="alpha"
     ;;
@@ -1861,6 +1910,9 @@ case "$1" in
   mips*)
     $2="mips"
     ;;
+  powerpc64le*)
+    $2="powerpc64le"
+    ;;
   powerpc64*)
     $2="powerpc64"
     ;;
@@ -2017,7 +2069,11 @@ AC_DEFUN([FIND_LLVM_PROG],[
         IFS=":;"
         for p in ${PATH}; do
             if test -d "${p}"; then
-                $1=`${FindCmd} "${p}" -type f -perm +111 -maxdepth 1 -regex '.*/$3-[[0-9]]\.[[0-9]]' -or -type l -perm +111 -maxdepth 1 -regex '.*/$3-[[0-9]]\.[[0-9]]' | ${SortCmd} -n | tail -1`
+                if test "$windows" = YES; then
+                    $1=`${FindCmd} "${p}" -type f -maxdepth 1 -regex '.*/$3-[[0-9]]\.[[0-9]]' -or -type l -maxdepth 1 -regex '.*/$3-[[0-9]]\.[[0-9]]' | ${SortCmd} -n | tail -1`
+                else
+                    $1=`${FindCmd} "${p}" -type f -perm +111 -maxdepth 1 -regex '.*/$3-[[0-9]]\.[[0-9]]' -or -type l -perm +111 -maxdepth 1 -regex '.*/$3-[[0-9]]\.[[0-9]]' | ${SortCmd} -n | tail -1`
+                fi
                 if test -n "$$1"; then
                     break
                 fi
@@ -2048,7 +2104,8 @@ AC_DEFUN([FIND_GCC],[
         $1="$CC"
     else
         FP_ARG_WITH_PATH_GNU_PROG_OPTIONAL([$1], [$2], [$3])
-        # From Xcode 5 on, OS X command line tools do not include gcc anymore. Use clang.
+        # From Xcode 5 on/, OS X command line tools do not include gcc
+        # anymore. Use clang.
         if test -z "$$1"
         then
             FP_ARG_WITH_PATH_GNU_PROG_OPTIONAL([$1], [clang], [clang])
@@ -2061,4 +2118,13 @@ AC_DEFUN([FIND_GCC],[
     AC_SUBST($1)
 ])
 
+AC_DEFUN([MAYBE_OVERRIDE_STAGE0],[
+  if test ! -z "$With_$1" -a "$CrossCompiling" != "YES"; then
+      AC_MSG_NOTICE([Not cross-compiling, so --with-$1 also sets $2])
+      $2=$With_$1
+  fi
+])
+
+
+
 # LocalWords:  fi
diff --git a/bindisttest/Makefile b/bindisttest/Makefile
index ecd029afd9b1..bc805c849415 100644
--- a/bindisttest/Makefile
+++ b/bindisttest/Makefile
@@ -21,9 +21,9 @@ include $(TOP)/mk/tree.mk
 include $(TOP)/mk/config.mk
 
 ifeq "$(TEST_PREP)" "YES"
-BIN_DIST_TEST_TAR_BZ2 = ../$(BIN_DIST_PREP_TAR_BZ2)
+BIN_DIST_TEST_TAR_COMP = ../$(BIN_DIST_PREP_TAR_COMP)
 else
-BIN_DIST_TEST_TAR_BZ2 = ../$(BIN_DIST_TAR_BZ2)
+BIN_DIST_TEST_TAR_COMP = ../$(BIN_DIST_TAR_COMP)
 endif
 
 all:
@@ -36,7 +36,7 @@ all:
 # NB. tar has funny interpretation of filenames sometimes (thinking
 # c:/foo is a remote file), so it's safer to bzip and then pipe into
 # tar rather than using tar -xjf:
-	cd a/b/c/ && $(BZIP2_CMD) -cd ../../../$(BIN_DIST_TEST_TAR_BZ2) | $(TAR_CMD) -xf -
+	cd a/b/c/ && $(TAR_COMP_CMD) -cd ../../../$(BIN_DIST_TEST_TAR_COMP) | $(TAR_CMD) -xf -
 ifeq "$(Windows)" "YES"
 	mv a/b/c/$(BIN_DIST_NAME) $(BIN_DIST_INST_DIR)
 else
diff --git a/bindisttest/ghc.mk b/bindisttest/ghc.mk
index 0126e391d87f..4b211064b127 100644
--- a/bindisttest/ghc.mk
+++ b/bindisttest/ghc.mk
@@ -11,9 +11,9 @@
 # -----------------------------------------------------------------------------
 
 ifeq "$(TEST_PREP)" "YES"
-BIN_DIST_TEST_TAR_BZ2 = $(BIN_DIST_PREP_TAR_BZ2)
+BIN_DIST_TEST_TAR_COMP = $(BIN_DIST_PREP_TAR_COMP)
 else
-BIN_DIST_TEST_TAR_BZ2 = $(BIN_DIST_TAR_BZ2)
+BIN_DIST_TEST_TAR_COMP = $(BIN_DIST_TAR_COMP)
 endif
 
 .PHONY: test_bindist
@@ -33,7 +33,7 @@ test_bindist:
 	mkdir bindisttest/a
 	mkdir bindisttest/a/b
 	mkdir bindisttest/a/b/c
-	cd bindisttest/a/b/c/ && $(BZIP2_CMD) -cd ../../../../$(BIN_DIST_TEST_TAR_BZ2) | $(TAR_CMD) -xf -
+	cd bindisttest/a/b/c/ && $(TAR_COMP_CMD) -cd ../../../../$(BIN_DIST_TEST_TAR_COMP) | $(TAR_CMD) -xf -
 	$(SHELL) bindisttest/checkBinaries.sh $(ProjectVersion)
 ifeq "$(Windows_Host)" "YES"
 	mv bindisttest/a/b/c/$(BIN_DIST_NAME) $(BIN_DIST_INST_DIR)
diff --git a/boot b/boot
index 676f434bdb06..8977eaf9a39d 100755
--- a/boot
+++ b/boot
@@ -1,5 +1,6 @@
-#!/usr/bin/perl -w
+#!/usr/bin/env perl
 
+use warnings;
 use strict;
 
 use Cwd;
diff --git a/compiler/basicTypes/BasicTypes.lhs b/compiler/basicTypes/BasicTypes.lhs
index 9a92b003bc38..2f86db77963b 100644
--- a/compiler/basicTypes/BasicTypes.lhs
+++ b/compiler/basicTypes/BasicTypes.lhs
@@ -41,7 +41,8 @@ module BasicTypes(
 
         TopLevelFlag(..), isTopLevel, isNotTopLevel,
 
-        OverlapFlag(..),
+        OverlapFlag(..), OverlapMode(..), setOverlapModeMaybe,
+        hasOverlappingFlag, hasOverlappableFlag,
 
         Boxity(..), isBoxed,
 
@@ -447,39 +448,92 @@ instance Outputable Origin where
 -- | The semantics allowed for overlapping instances for a particular
 -- instance. See Note [Safe Haskell isSafeOverlap] (in `InstEnv.lhs`) for a
 -- explanation of the `isSafeOverlap` field.
-data OverlapFlag
-  -- | This instance must not overlap another
-  = NoOverlap { isSafeOverlap :: Bool }
-
-  -- | Silently ignore this instance if you find a
-  -- more specific one that matches the constraint
-  -- you are trying to resolve
-  --
-  -- Example: constraint (Foo [Int])
-  --        instances  (Foo [Int])
-  --                   (Foo [a])        OverlapOk
-  -- Since the second instance has the OverlapOk flag,
-  -- the first instance will be chosen (otherwise
-  -- its ambiguous which to choose)
-  | OverlapOk { isSafeOverlap :: Bool }
-
-  -- | Silently ignore this instance if you find any other that matches the
-  -- constraing you are trying to resolve, including when checking if there are
-  -- instances that do not match, but unify.
-  --
-  -- Example: constraint (Foo [b])
-  --        instances  (Foo [Int])      Incoherent
-  --                   (Foo [a])
-  -- Without the Incoherent flag, we'd complain that
-  -- instantiating 'b' would change which instance
-  -- was chosen. See also note [Incoherent instances]
-  | Incoherent { isSafeOverlap :: Bool }
+data OverlapFlag = OverlapFlag
+  { overlapMode   :: OverlapMode
+  , isSafeOverlap :: Bool
+  } deriving (Eq, Data, Typeable)
+
+setOverlapModeMaybe :: OverlapFlag -> Maybe OverlapMode -> OverlapFlag
+setOverlapModeMaybe f Nothing  = f
+setOverlapModeMaybe f (Just m) = f { overlapMode = m }
+
+hasOverlappableFlag :: OverlapMode -> Bool
+hasOverlappableFlag mode =
+  case mode of
+    Overlappable -> True
+    Overlaps     -> True
+    Incoherent   -> True
+    _            -> False
+
+hasOverlappingFlag :: OverlapMode -> Bool
+hasOverlappingFlag mode =
+  case mode of
+    Overlapping  -> True
+    Overlaps     -> True
+    Incoherent   -> True
+    _            -> False
+
+data OverlapMode  -- See Note [Rules for instance lookup] in InstEnv
+  = NoOverlap
+    -- ^ This instance must not overlap another `NoOverlap` instance.
+    -- However, it may be overlapped by `Overlapping` instances,
+    -- and it may overlap `Overlappable` instances.
+
+
+  | Overlappable
+    -- ^ Silently ignore this instance if you find a
+    -- more specific one that matches the constraint
+    -- you are trying to resolve
+    --
+    -- Example: constraint (Foo [Int])
+    --   instance                      Foo [Int]
+    --   instance {-# OVERLAPPABLE #-} Foo [a]
+    --
+    -- Since the second instance has the Overlappable flag,
+    -- the first instance will be chosen (otherwise
+    -- its ambiguous which to choose)
+
+
+  | Overlapping
+    -- ^ Silently ignore any more general instances that may be
+    --   used to solve the constraint.
+    --
+    -- Example: constraint (Foo [Int])
+    --   instance {-# OVERLAPPING #-} Foo [Int]
+    --   instance                     Foo [a]
+    --
+    -- Since the first instance has the Overlapping flag,
+    -- the second---more general---instance will be ignored (otherwise
+    -- it is ambiguous which to choose)
+
+
+  | Overlaps
+    -- ^ Equivalent to having both `Overlapping` and `Overlappable` flags.
+
+  | Incoherent
+    -- ^ Behave like Overlappable and Overlapping, and in addition pick
+    -- an an arbitrary one if there are multiple matching candidates, and
+    -- don't worry about later instantiation
+    --
+    -- Example: constraint (Foo [b])
+    -- instance {-# INCOHERENT -} Foo [Int]
+    -- instance                   Foo [a]
+    -- Without the Incoherent flag, we'd complain that
+    -- instantiating 'b' would change which instance
+    -- was chosen. See also note [Incoherent instances] in InstEnv
+
   deriving (Eq, Data, Typeable)
 
+
 instance Outputable OverlapFlag where
-   ppr (NoOverlap  b) = empty <+> pprSafeOverlap b
-   ppr (OverlapOk  b) = ptext (sLit "[overlap ok]") <+> pprSafeOverlap b
-   ppr (Incoherent b) = ptext (sLit "[incoherent]") <+> pprSafeOverlap b
+   ppr flag = ppr (overlapMode flag) <+> pprSafeOverlap (isSafeOverlap flag)
+
+instance Outputable OverlapMode where
+   ppr NoOverlap    = empty
+   ppr Overlappable = ptext (sLit "[overlappable]")
+   ppr Overlapping  = ptext (sLit "[overlapping]")
+   ppr Overlaps     = ptext (sLit "[overlap ok]")
+   ppr Incoherent   = ptext (sLit "[incoherent]")
 
 pprSafeOverlap :: Bool -> SDoc
 pprSafeOverlap True  = ptext $ sLit "[safe]"
@@ -761,7 +815,7 @@ data InlinePragma            -- Note [InlinePragma]
       , inl_rule   :: RuleMatchInfo  -- Should the function be treated like a constructor?
     } deriving( Eq, Data, Typeable )
 
-data InlineSpec   -- What the user's INLINE pragama looked like
+data InlineSpec   -- What the user's INLINE pragma looked like
   = Inline
   | Inlinable
   | NoInline
diff --git a/compiler/basicTypes/ConLike.lhs b/compiler/basicTypes/ConLike.lhs
index de10d0fb0a2c..3414aa4230e4 100644
--- a/compiler/basicTypes/ConLike.lhs
+++ b/compiler/basicTypes/ConLike.lhs
@@ -5,6 +5,7 @@
 \section[ConLike]{@ConLike@: Constructor-like things}
 
 \begin{code}
+{-# LANGUAGE CPP, DeriveDataTypeable #-}
 
 module ConLike (
         ConLike(..)
diff --git a/compiler/basicTypes/DataCon.lhs b/compiler/basicTypes/DataCon.lhs
index ad56290694ad..771aa303a141 100644
--- a/compiler/basicTypes/DataCon.lhs
+++ b/compiler/basicTypes/DataCon.lhs
@@ -5,7 +5,8 @@
 \section[DataCon]{@DataCon@: Data Constructors}
 
 \begin{code}
-{-# OPTIONS -fno-warn-tabs #-}
+{-# LANGUAGE CPP, DeriveDataTypeable #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
 -- The above warning supression flag is a temporary kludge.
 -- While working on this module you are encouraged to remove it and
 -- detab the module (please do the detabbing in a separate patch). See
@@ -941,7 +942,7 @@ dataConRepArgTys (MkData { dcRep = rep
 -- to its info table and used by the GHCi debugger and the heap profiler
 dataConIdentity :: DataCon -> [Word8]
 -- We want this string to be UTF-8, so we get the bytes directly from the FastStrings.
-dataConIdentity dc = bytesFS (packageIdFS (modulePackageId mod)) ++ 
+dataConIdentity dc = bytesFS (packageKeyFS (modulePackageKey mod)) ++
                   fromIntegral (ord ':') : bytesFS (moduleNameFS (moduleName mod)) ++
                   fromIntegral (ord '.') : bytesFS (occNameFS (nameOccName name))
   where name = dataConName dc
diff --git a/compiler/basicTypes/Demand.lhs b/compiler/basicTypes/Demand.lhs
index 9607a159c28b..ed055b58084f 100644
--- a/compiler/basicTypes/Demand.lhs
+++ b/compiler/basicTypes/Demand.lhs
@@ -5,6 +5,7 @@
 \section[Demand]{@Demand@: A decoupled implementation of a demand domain}
 
 \begin{code}
+{-# LANGUAGE CPP, FlexibleInstances, TypeSynonymInstances #-}
 
 module Demand (
         StrDmd, UseDmd(..), Count(..), 
@@ -41,9 +42,10 @@ module Demand (
         deferAfterIO,
         postProcessUnsat, postProcessDmdTypeM,
 
-        splitProdDmd, splitProdDmd_maybe, peelCallDmd, mkCallDmd,
+        splitProdDmd_maybe, peelCallDmd, mkCallDmd,
         dmdTransformSig, dmdTransformDataConSig, dmdTransformDictSelSig,
         argOneShots, argsOneShots,
+        trimToType, TypeShape(..),
 
         isSingleUsed, reuseEnv, zapDemand, zapStrictSig,
 
@@ -64,9 +66,10 @@ import BasicTypes
 import Binary
 import Maybes           ( orElse )
 
-import Type            ( Type )
+import Type            ( Type, isUnLiftedType )
 import TyCon           ( isNewTyCon, isClassTyCon )
 import DataCon         ( splitDataProductType_maybe )
+import FastString
 \end{code}
 
 %************************************************************************
@@ -198,11 +201,13 @@ seqMaybeStr Lazy    = ()
 seqMaybeStr (Str s) = seqStrDmd s
 
 -- Splitting polymorphic demands
-splitStrProdDmd :: Int -> StrDmd -> [MaybeStr]
-splitStrProdDmd n HyperStr     = replicate n strBot
-splitStrProdDmd n HeadStr      = replicate n strTop
-splitStrProdDmd n (SProd ds)   = ASSERT( ds `lengthIs` n) ds
-splitStrProdDmd _ d@(SCall {}) = pprPanic "attempt to prod-split strictness call demand" (ppr d)
+splitStrProdDmd :: Int -> StrDmd -> Maybe [MaybeStr]
+splitStrProdDmd n HyperStr   = Just (replicate n strBot)
+splitStrProdDmd n HeadStr    = Just (replicate n strTop)
+splitStrProdDmd n (SProd ds) = ASSERT( ds `lengthIs` n) Just ds
+splitStrProdDmd _ (SCall {}) = Nothing
+      -- This can happen when the programmer uses unsafeCoerce,
+      -- and we don't then want to crash the compiler (Trac #9208)
 \end{code}
 
 %************************************************************************
@@ -439,13 +444,15 @@ seqMaybeUsed (Use c u)  = c `seq` seqUseDmd u
 seqMaybeUsed _          = ()
 
 -- Splitting polymorphic Maybe-Used demands
-splitUseProdDmd :: Int -> UseDmd -> [MaybeUsed]
-splitUseProdDmd n Used          = replicate n useTop
-splitUseProdDmd n UHead         = replicate n Abs
-splitUseProdDmd n (UProd ds)    = ASSERT2( ds `lengthIs` n, ppr n $$ ppr ds ) ds
-splitUseProdDmd _ d@(UCall _ _) = pprPanic "attempt to prod-split usage call demand" (ppr d)
+splitUseProdDmd :: Int -> UseDmd -> Maybe [MaybeUsed]
+splitUseProdDmd n Used        = Just (replicate n useTop)
+splitUseProdDmd n UHead       = Just (replicate n Abs)
+splitUseProdDmd n (UProd ds)  = ASSERT2( ds `lengthIs` n, text "splitUseProdDmd" $$ ppr n $$ ppr ds ) 
+                                Just ds
+splitUseProdDmd _ (UCall _ _) = Nothing
+      -- This can happen when the programmer uses unsafeCoerce,
+      -- and we don't then want to crash the compiler (Trac #9208)
 \end{code}
-  
 %************************************************************************
 %*                                                                      *
 \subsection{Joint domain for Strictness and Absence}
@@ -638,8 +645,66 @@ isSingleUsed (JD {absd=a}) = is_used_once a
     is_used_once Abs         = True
     is_used_once (Use One _) = True
     is_used_once _           = False
+
+
+data TypeShape = TsFun TypeShape
+               | TsProd [TypeShape]
+               | TsUnk
+
+instance Outputable TypeShape where
+  ppr TsUnk        = ptext (sLit "TsUnk")
+  ppr (TsFun ts)   = ptext (sLit "TsFun") <> parens (ppr ts)
+  ppr (TsProd tss) = parens (hsep $ punctuate comma $ map ppr tss)
+
+trimToType :: JointDmd -> TypeShape -> JointDmd
+-- See Note [Trimming a demand to a type]
+trimToType (JD ms mu) ts
+  = JD (go_ms ms ts) (go_mu mu ts)
+  where
+    go_ms :: MaybeStr -> TypeShape -> MaybeStr
+    go_ms Lazy    _  = Lazy
+    go_ms (Str s) ts = Str (go_s s ts)
+
+    go_s :: StrDmd -> TypeShape -> StrDmd
+    go_s HyperStr    _            = HyperStr
+    go_s (SCall s)   (TsFun ts)   = SCall (go_s s ts)
+    go_s (SProd mss) (TsProd tss)
+      | equalLength mss tss       = SProd (zipWith go_ms mss tss)
+    go_s _           _            = HeadStr
+
+    go_mu :: MaybeUsed -> TypeShape -> MaybeUsed
+    go_mu Abs _ = Abs
+    go_mu (Use c u) ts = Use c (go_u u ts)
+
+    go_u :: UseDmd -> TypeShape -> UseDmd
+    go_u UHead       _          = UHead
+    go_u (UCall c u) (TsFun ts) = UCall c (go_u u ts)
+    go_u (UProd mus) (TsProd tss)
+      | equalLength mus tss      = UProd (zipWith go_mu mus tss)
+    go_u _           _           = Used
 \end{code}
 
+Note [Trimming a demand to a type]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Consider this:
+
+  f :: a -> Bool
+  f x = case ... of
+          A g1 -> case (x |> g1) of (p,q) -> ...
+          B    -> error "urk"
+
+where A,B are the constructors of a GADT.  We'll get a U(U,U) demand
+on x from the A branch, but that's a stupid demand for x itself, which
+has type 'a'. Indeed we get ASSERTs going off (notably in
+splitUseProdDmd, Trac #8569).
+
+Bottom line: we really don't want to have a binder whose demand is more
+deeply-nested than its type.  There are various ways to tackle this.
+When processing (x |> g1), we could "trim" the incoming demand U(U,U)
+to match x's type.  But I'm currently doing so just at the moment when
+we pin a demand on a binder, in DmdAnal.findBndrDmd.
+
+
 Note [Threshold demands]
 ~~~~~~~~~~~~~~~~~~~~~~~~
 Threshold usage demand is generated to figure out if
@@ -659,26 +724,18 @@ can be expanded to saturate a callee's arity.
 
 
 \begin{code}
-splitProdDmd :: Arity -> JointDmd -> [JointDmd]
-splitProdDmd n (JD {strd = s, absd = u})
-  = mkJointDmds (split_str s) (split_abs u)
-  where
-    split_str Lazy    = replicate n Lazy
-    split_str (Str s) = splitStrProdDmd n s
-
-    split_abs Abs       = replicate n Abs
-    split_abs (Use _ u) = splitUseProdDmd n u
-
 splitProdDmd_maybe :: JointDmd -> Maybe [JointDmd]
 -- Split a product into its components, iff there is any
 -- useful information to be extracted thereby
 -- The demand is not necessarily strict!
 splitProdDmd_maybe (JD {strd = s, absd = u})
   = case (s,u) of
-      (Str (SProd sx), Use _ u)          -> Just (mkJointDmds sx (splitUseProdDmd (length sx) u))
-      (Str s,          Use _ (UProd ux)) -> Just (mkJointDmds (splitStrProdDmd (length ux) s) ux)
-      (Lazy,           Use _ (UProd ux)) -> Just (mkJointDmds (replicate (length ux) Lazy)    ux)
-      _                                  -> Nothing
+      (Str (SProd sx), Use _ u)          | Just ux <- splitUseProdDmd (length sx) u
+                                         -> Just (mkJointDmds sx ux)
+      (Str s,          Use _ (UProd ux)) | Just sx <- splitStrProdDmd (length ux) s
+                                         -> Just (mkJointDmds sx ux)
+      (Lazy,           Use _ (UProd ux)) -> Just (mkJointDmds (replicate (length ux) Lazy) ux)
+      _ -> Nothing
 \end{code}
 
 %************************************************************************
@@ -960,7 +1017,7 @@ this has a strictness signature of
 meaning that "b2 `seq` ()" and "b2 1 `seq` ()" might well terminate, but
 for "b2 1 2 `seq` ()" we get definite divergence.
 
-For comparision,
+For comparison,
   b1 x = x `seq` error (show x)
 has a strictness signature of
   <S>b
@@ -1144,13 +1201,18 @@ type DeferAndUse   -- Describes how to degrade a result type
 type DeferAndUseM = Maybe DeferAndUse
   -- Nothing <=> absent-ify the result type; it will never be used
 
-toCleanDmd :: Demand -> (CleanDemand, DeferAndUseM)
--- See Note [Analyzing with lazy demand and lambdas]
-toCleanDmd (JD { strd = s, absd = u })
+toCleanDmd :: Demand -> Type -> (CleanDemand, DeferAndUseM)
+toCleanDmd (JD { strd = s, absd = u }) expr_ty
   = case (s,u) of
-      (Str s', Use c u') -> (CD { sd = s',      ud = u' },   Just (False, c))
-      (Lazy,   Use c u') -> (CD { sd = HeadStr, ud = u' },   Just (True,  c))
-      (_,      Abs)      -> (CD { sd = HeadStr, ud = Used }, Nothing)
+      (Str s', Use c u') -> -- The normal case
+                            (CD { sd = s',      ud = u' }, Just (False, c))
+
+      (Lazy,   Use c u') -> -- See Note [Analyzing with lazy demand and lambdas]
+                            (CD { sd = HeadStr, ud = u' }, Just (True,  c))
+
+      (_,      Abs)  -- See Note [Analysing with absent demand]
+         | isUnLiftedType expr_ty -> (CD { sd = HeadStr, ud = Used }, Just (False, One))
+         | otherwise              -> (CD { sd = HeadStr, ud = Used }, Nothing)
 
 -- This is used in dmdAnalStar when post-processing
 -- a function's argument demand. So we only care about what
@@ -1325,13 +1387,13 @@ cardinality analysis of the following example:
 {-# NOINLINE build #-}
 build g = (g (:) [], g (:) [])
 
-h c z = build (\x -> 
-                let z1 = z ++ z 
+h c z = build (\x ->
+                let z1 = z ++ z
                  in if c
                     then \y -> x (y ++ z1)
                     else \y -> x (z1 ++ y))
 
-One can see that `build` assigns to `g` demand <L,C(C1(U))>. 
+One can see that `build` assigns to `g` demand <L,C(C1(U))>.
 Therefore, when analyzing the lambda `(\x -> ...)`, we
 expect each lambda \y -> ... to be annotated as "one-shot"
 one. Therefore (\x -> \y -> x (y ++ z)) should be analyzed with a
@@ -1340,6 +1402,46 @@ demand <C(C(..), C(C1(U))>.
 This is achieved by, first, converting the lazy demand L into the
 strict S by the second clause of the analysis.
 
+Note [Analysing with absent demand]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Suppose we analyse an expression with demand <L,A>.  The "A" means
+"absent", so this expression will never be needed.  What should happen?
+There are several wrinkles:
+
+* We *do* want to analyse the expression regardless.
+  Reason: Note [Always analyse in virgin pass]
+
+  But we can post-process the results to ignore all the usage
+  demands coming back. This is done by postProcessDmdTypeM.
+
+* But in the case of an *unlifted type* we must be extra careful,
+  because unlifted values are evaluated even if they are not used.
+  Example (see Trac #9254):
+     f :: (() -> (# Int#, () #)) -> ()
+          -- Strictness signature is
+          --    <C(S(LS)), 1*C1(U(A,1*U()))>
+          -- I.e. calls k, but discards first component of result
+     f k = case k () of (# _, r #) -> r
+
+     g :: Int -> ()
+     g y = f (\n -> (# case y of I# y2 -> y2, n #))
+
+  Here f's strictness signature says (correctly) that it calls its
+  argument function and ignores the first component of its result.
+  This is correct in the sense that it'd be fine to (say) modify the
+  function so that always returned 0# in the first component.
+
+  But in function g, we *will* evaluate the 'case y of ...', because
+  it has type Int#.  So 'y' will be evaluated.  So we must record this
+  usage of 'y', else 'g' will say 'y' is absent, and will w/w so that
+  'y' is bound to an aBSENT_ERROR thunk.
+
+  An alternative would be to replace the 'case y of ...' with (say) 0#,
+  but I have not tried that. It's not a common situation, but it is
+  not theoretical: unsafePerformIO's implementation is very very like
+  'f' above.
+
+
 %************************************************************************
 %*                                                                      *
                      Demand signatures
@@ -1451,7 +1553,7 @@ dmdTransformDataConSig :: Arity -> StrictSig -> CleanDemand -> DmdType
 -- which has a special kind of demand transformer.
 -- If the constructor is saturated, we feed the demand on 
 -- the result into the constructor arguments.
-dmdTransformDataConSig arity (StrictSig (DmdType _ _ con_res)) 
+dmdTransformDataConSig arity (StrictSig (DmdType _ _ con_res))
                              (CD { sd = str, ud = abs })
   | Just str_dmds <- go_str arity str
   , Just abs_dmds <- go_abs arity abs
@@ -1461,12 +1563,12 @@ dmdTransformDataConSig arity (StrictSig (DmdType _ _ con_res))
   | otherwise   -- Not saturated
   = nopDmdType
   where
-    go_str 0 dmd        = Just (splitStrProdDmd arity dmd)
+    go_str 0 dmd        = splitStrProdDmd arity dmd
     go_str n (SCall s') = go_str (n-1) s'
     go_str n HyperStr   = go_str (n-1) HyperStr
     go_str _ _          = Nothing
 
-    go_abs 0 dmd            = Just (splitUseProdDmd arity dmd)
+    go_abs 0 dmd            = splitUseProdDmd arity dmd
     go_abs n (UCall One u') = go_abs (n-1) u'
     go_abs _ _              = Nothing
 
diff --git a/compiler/basicTypes/Id.lhs b/compiler/basicTypes/Id.lhs
index 50b36419585b..85e9b3083a21 100644
--- a/compiler/basicTypes/Id.lhs
+++ b/compiler/basicTypes/Id.lhs
@@ -5,6 +5,8 @@
 \section[Id]{@Ids@: Value and constructor identifiers}
 
 \begin{code}
+{-# LANGUAGE CPP #-}
+
 -- |
 -- #name_types#
 -- GHC uses several kinds of name internally:
@@ -30,6 +32,7 @@ module Id (
         mkGlobalId, mkVanillaGlobal, mkVanillaGlobalWithInfo,
         mkLocalId, mkLocalIdWithInfo, mkExportedLocalId,
         mkSysLocal, mkSysLocalM, mkUserLocal, mkUserLocalM,
+        mkDerivedLocalM,
         mkTemplateLocals, mkTemplateLocalsNum, mkTemplateLocal,
         mkWorkerId, mkWiredInIdName,
 
@@ -71,7 +74,8 @@ module Id (
         isStateHackType, stateHackOneShot, typeOneShot,
 
         -- ** Reading 'IdInfo' fields
-        idArity, 
+        idArity,
+        idCallArity,
         idUnfolding, realIdUnfolding,
         idSpecialisation, idCoreRules, idHasRules,
         idCafInfo,
@@ -82,6 +86,7 @@ module Id (
         setIdUnfoldingLazily,
         setIdUnfolding,
         setIdArity,
+        setIdCallArity,
 
         setIdSpecialisation,
         setIdCafInfo,
@@ -131,6 +136,7 @@ import StaticFlags
 infixl  1 `setIdUnfoldingLazily`,
           `setIdUnfolding`,
           `setIdArity`,
+          `setIdCallArity`,
           `setIdOccInfo`,
           `setIdOneShotInfo`,
 
@@ -248,8 +254,9 @@ mkLocalIdWithInfo name ty info = Var.mkLocalVar VanillaId name ty info
 
 -- | Create a local 'Id' that is marked as exported.
 -- This prevents things attached to it from being removed as dead code.
-mkExportedLocalId :: Name -> Type -> Id
-mkExportedLocalId name ty = Var.mkExportedLocalVar VanillaId name ty vanillaIdInfo
+-- See Note [Exported LocalIds]
+mkExportedLocalId :: IdDetails -> Name -> Type -> Id
+mkExportedLocalId details name ty = Var.mkExportedLocalVar details name ty vanillaIdInfo
         -- Note [Free type variables]
 
 
@@ -269,6 +276,10 @@ mkUserLocal occ uniq ty loc = mkLocalId (mkInternalName uniq occ loc) ty
 mkUserLocalM :: MonadUnique m => OccName -> Type -> SrcSpan -> m Id
 mkUserLocalM occ ty loc = getUniqueM >>= (\uniq -> return (mkUserLocal occ uniq ty loc))
 
+mkDerivedLocalM :: MonadUnique m => (OccName -> OccName) -> Id -> Type -> m Id
+mkDerivedLocalM deriv_name id ty
+    = getUniqueM >>= (\uniq -> return (mkLocalId (mkDerivedInternalName deriv_name uniq (getName id)) ty))
+
 mkWiredInIdName :: Module -> FastString -> Unique -> Id -> Name
 mkWiredInIdName mod fs uniq id
  = mkWiredInName mod (mkOccNameFS varName fs) uniq (AnId id) UserSyntax
@@ -297,6 +308,40 @@ mkTemplateLocalsNum :: Int -> [Type] -> [Id]
 mkTemplateLocalsNum n tys = zipWith mkTemplateLocal [n..] tys
 \end{code}
 
+Note [Exported LocalIds]
+~~~~~~~~~~~~~~~~~~~~~~~~
+We use mkExportedLocalId for things like
+ - Dictionary functions (DFunId)
+ - Wrapper and matcher Ids for pattern synonyms
+ - Default methods for classes
+ - etc
+
+They marked as "exported" in the sense that they should be kept alive
+even if apparently unused in other bindings, and not dropped as dead
+code by the occurrence analyser.  (But "exported" here does not mean
+"brought into lexical scope by an import declaration". Indeed these
+things are always internal Ids that the user never sees.)
+
+It's very important that they are *LocalIds*, not GlobalIs, for lots
+of reasons:
+
+ * We want to treat them as free variables for the purpose of
+   dependency analysis (e.g. CoreFVs.exprFreeVars).
+
+ * Look them up in the current substitution when we come across
+   occurrences of them (in Subst.lookupIdSubst)
+
+ * Ensure that for dfuns that the specialiser does not float dict uses
+   above their defns, which would prevent good simplifications happening.
+
+ * The strictness analyser treats a occurrence of a GlobalId as
+   imported and assumes it contains strictness in its IdInfo, which
+   isn't true if the thing is bound in the same module as the
+   occurrence.
+
+In CoreTidy we must make all these LocalIds into GlobalIds, so that in
+importing modules (in --make mode) we treat them as properly global.
+That is what is happening in, say tidy_insts in TidyPgm.
 
 %************************************************************************
 %*                                                                      *
@@ -466,6 +511,12 @@ idArity id = arityInfo (idInfo id)
 setIdArity :: Id -> Arity -> Id
 setIdArity id arity = modifyIdInfo (`setArityInfo` arity) id
 
+idCallArity :: Id -> Arity
+idCallArity id = callArityInfo (idInfo id)
+
+setIdCallArity :: Id -> Arity -> Id
+setIdCallArity id arity = modifyIdInfo (`setCallArityInfo` arity) id
+
 idRepArity :: Id -> RepArity
 idRepArity x = typeRepArity (idArity x) (idType x)
 
diff --git a/compiler/basicTypes/IdInfo.lhs b/compiler/basicTypes/IdInfo.lhs
index 20d9b49cb9e1..f6336480a105 100644
--- a/compiler/basicTypes/IdInfo.lhs
+++ b/compiler/basicTypes/IdInfo.lhs
@@ -8,7 +8,7 @@
 Haskell. [WDP 94/11])
 
 \begin{code}
-{-# OPTIONS -fno-warn-tabs #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
 -- The above warning supression flag is a temporary kludge.
 -- While working on this module you are encouraged to remove it and
 -- detab the module (please do the detabbing in a separate patch). See
@@ -38,6 +38,8 @@ module IdInfo (
 	unknownArity, 
 	arityInfo, setArityInfo, ppArityInfo, 
 
+        callArityInfo, setCallArityInfo,
+
 	-- ** Demand and strictness Info
  	strictnessInfo, setStrictnessInfo, 
   	demandInfo, setDemandInfo, pprStrictness,
@@ -69,8 +71,6 @@ module IdInfo (
 	ppCafInfo, mayHaveCafRefs,
 	cafInfo, setCafInfo,
 
-        -- ** Tick-box Info
-        TickBoxOp(..), TickBoxId,
     ) where
 
 import CoreSyn
@@ -84,7 +84,6 @@ import DataCon
 import TyCon
 import ForeignCall
 import Outputable	
-import Module
 import FastString
 import Demand
 
@@ -133,8 +132,6 @@ data IdDetails
   | PrimOpId PrimOp		-- ^ The 'Id' is for a primitive operator
   | FCallId ForeignCall		-- ^ The 'Id' is for a foreign call
 
-  | TickBoxOpId TickBoxOp	-- ^ The 'Id' is for a HPC tick box (both traditional and binary)
-
   | DFunId Int Bool             -- ^ A dictionary function.
        -- Int = the number of "silent" arguments to the dfun
        --       e.g.  class D a => C a where ...
@@ -163,7 +160,6 @@ pprIdDetails other     = brackets (pp other)
    pp (ClassOpId {})    = ptext (sLit "ClassOp")
    pp (PrimOpId _)      = ptext (sLit "PrimOp")
    pp (FCallId _)       = ptext (sLit "ForeignCall")
-   pp (TickBoxOpId _)   = ptext (sLit "TickBoxOp")
    pp (DFunId ns nt)    = ptext (sLit "DFunId")
                              <> ppWhen (ns /= 0) (brackets (int ns))
                              <> ppWhen nt (ptext (sLit "(nt)"))
@@ -204,8 +200,9 @@ data IdInfo
 
         strictnessInfo  :: StrictSig,      --  ^ A strictness signature
 
-        demandInfo      :: Demand        -- ^ ID demand information
-
+        demandInfo      :: Demand,       -- ^ ID demand information
+        callArityInfo :: !ArityInfo    -- ^ How this is called.
+                                         -- n <=> all calls have at least n arguments
     }
 
 -- | Just evaluate the 'IdInfo' to WHNF
@@ -264,6 +261,8 @@ setUnfoldingInfo info uf
 
 setArityInfo :: IdInfo -> ArityInfo -> IdInfo
 setArityInfo	  info ar  = info { arityInfo = ar  }
+setCallArityInfo :: IdInfo -> ArityInfo -> IdInfo
+setCallArityInfo info ar  = info { callArityInfo = ar  }
 setCafInfo :: IdInfo -> CafInfo -> IdInfo
 setCafInfo        info caf = info { cafInfo = caf }
 
@@ -291,7 +290,8 @@ vanillaIdInfo
 	    inlinePragInfo 	= defaultInlinePragma,
 	    occInfo		= NoOccInfo,
             demandInfo	        = topDmd,
-	    strictnessInfo      = nopSig
+	    strictnessInfo      = nopSig,
+	    callArityInfo     = unknownArity
 	   }
 
 -- | More informative 'IdInfo' we can use when we know the 'Id' has no CAF references
@@ -511,20 +511,3 @@ zapFragileInfo info
   where
     occ = occInfo info
 \end{code}
-
-%************************************************************************
-%*									*
-\subsection{TickBoxOp}
-%*									*
-%************************************************************************
-
-\begin{code}
-type TickBoxId = Int
-
--- | Tick box for Hpc-style coverage
-data TickBoxOp 
-   = TickBox Module {-# UNPACK #-} !TickBoxId
-
-instance Outputable TickBoxOp where
-    ppr (TickBox mod n)         = ptext (sLit "tick") <+> ppr (mod,n)
-\end{code}
diff --git a/compiler/basicTypes/Literal.lhs b/compiler/basicTypes/Literal.lhs
index c77915fef66d..13fbb4d46d59 100644
--- a/compiler/basicTypes/Literal.lhs
+++ b/compiler/basicTypes/Literal.lhs
@@ -5,7 +5,7 @@
 \section[Literal]{@Literal@: Machine literals (unboxed, of course)}
 
 \begin{code}
-{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE CPP, DeriveDataTypeable #-}
 
 module Literal
         (
diff --git a/compiler/basicTypes/MkId.lhs b/compiler/basicTypes/MkId.lhs
index 604163fd4618..7816ad90056a 100644
--- a/compiler/basicTypes/MkId.lhs
+++ b/compiler/basicTypes/MkId.lhs
@@ -12,7 +12,8 @@ have a standard form, namely:
 - primitive operations
 
 \begin{code}
-{-# OPTIONS -fno-warn-tabs #-}
+{-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
 -- The above warning supression flag is a temporary kludge.
 -- While working on this module you are encouraged to remove it and
 -- detab the module (please do the detabbing in a separate patch). See
@@ -20,7 +21,7 @@ have a standard form, namely:
 -- for details
 
 module MkId (
-        mkDictFunId, mkDictFunTy, mkDictSelId,
+        mkDictFunId, mkDictFunTy, mkDictSelId, mkDictSelRhs,
 
         mkPrimOpId, mkFCallId,
 
@@ -66,7 +67,6 @@ import PrimOp
 import ForeignCall
 import DataCon
 import Id
-import Var              ( mkExportedLocalVar )
 import IdInfo
 import Demand
 import CoreSyn
@@ -125,7 +125,7 @@ is right here.
 \begin{code}
 wiredInIds :: [Id]
 wiredInIds
-  =  [lazyId]
+  =  [lazyId, dollarId]
   ++ errorIds		-- Defined in MkCore
   ++ ghcPrimIds
 
@@ -272,39 +272,36 @@ at the outside.  When dealing with classes it's very convenient to
 recover the original type signature from the class op selector.
 
 \begin{code}
-mkDictSelId :: DynFlags
-            -> Bool	     -- True <=> don't include the unfolding
-			     -- Little point on imports without -O, because the
-			     -- dictionary itself won't be visible
- 	    -> Name	     -- Name of one of the *value* selectors 
+mkDictSelId :: Name	     -- Name of one of the *value* selectors 
 	       		     -- (dictionary superclass or method)
             -> Class -> Id
-mkDictSelId dflags no_unf name clas
+mkDictSelId name clas
   = mkGlobalId (ClassOpId clas) name sel_ty info
   where
-    sel_ty = mkForAllTys tyvars (mkFunTy (idType dict_id) (idType the_arg_id))
-        -- We can't just say (exprType rhs), because that would give a type
-        --      C a -> C a
-        -- for a single-op class (after all, the selector is the identity)
-        -- But it's type must expose the representation of the dictionary
-        -- to get (say)         C a -> (a -> a)
+    tycon      	   = classTyCon clas
+    sel_names      = map idName (classAllSelIds clas)
+    new_tycon  	   = isNewTyCon tycon
+    [data_con] 	   = tyConDataCons tycon
+    tyvars     	   = dataConUnivTyVars data_con
+    arg_tys    	   = dataConRepArgTys data_con	-- Includes the dictionary superclasses
+    val_index      = assoc "MkId.mkDictSelId" (sel_names `zip` [0..]) name
+
+    sel_ty = mkForAllTys tyvars (mkFunTy (mkClassPred clas (mkTyVarTys tyvars))
+                                         (getNth arg_tys val_index))
 
     base_info = noCafIdInfo
                 `setArityInfo`         1
                 `setStrictnessInfo`    strict_sig
-                `setUnfoldingInfo`     (if no_unf then noUnfolding
-	                                else mkImplicitUnfolding dflags rhs)
-		   -- In module where class op is defined, we must add
-		   -- the unfolding, even though it'll never be inlined
-		   -- because we use that to generate a top-level binding
-		   -- for the ClassOp
-
-    info | new_tycon = base_info `setInlinePragInfo` alwaysInlinePragma
+
+    info | new_tycon
+         = base_info `setInlinePragInfo` alwaysInlinePragma
+                     `setUnfoldingInfo`  mkInlineUnfolding (Just 1) (mkDictSelRhs clas val_index)
     	   	   -- See Note [Single-method classes] in TcInstDcls
 		   -- for why alwaysInlinePragma
-         | otherwise = base_info  `setSpecInfo`       mkSpecInfo [rule]
-		       		  `setInlinePragInfo` neverInlinePragma
-		   -- Add a magic BuiltinRule, and never inline it
+
+         | otherwise
+         = base_info `setSpecInfo` mkSpecInfo [rule]
+		   -- Add a magic BuiltinRule, but no unfolding
 		   -- so that the rule is always available to fire.
 		   -- See Note [ClassOp/DFun selection] in TcInstDcls
 
@@ -326,25 +323,26 @@ mkDictSelId dflags no_unf name clas
     strict_sig = mkClosedStrictSig [arg_dmd] topRes
     arg_dmd | new_tycon = evalDmd
             | otherwise = mkManyUsedDmd $
-                          mkProdDmd [ if the_arg_id == id then evalDmd else absDmd
-                                    | id <- arg_ids ]
-
+                          mkProdDmd [ if name == sel_name then evalDmd else absDmd
+                                    | sel_name <- sel_names ]
+
+mkDictSelRhs :: Class
+             -> Int         -- 0-indexed selector among (superclasses ++ methods)
+             -> CoreExpr
+mkDictSelRhs clas val_index
+  = mkLams tyvars (Lam dict_id rhs_body)
+  where
     tycon      	   = classTyCon clas
     new_tycon  	   = isNewTyCon tycon
     [data_con] 	   = tyConDataCons tycon
     tyvars     	   = dataConUnivTyVars data_con
     arg_tys    	   = dataConRepArgTys data_con	-- Includes the dictionary superclasses
 
-    -- 'index' is a 0-index into the *value* arguments of the dictionary
-    val_index      = assoc "MkId.mkDictSelId" sel_index_prs name
-    sel_index_prs  = map idName (classAllSelIds clas) `zip` [0..]
-
     the_arg_id     = getNth arg_ids val_index
     pred       	   = mkClassPred clas (mkTyVarTys tyvars)
     dict_id    	   = mkTemplateLocal 1 pred
     arg_ids    	   = mkTemplateLocalsNum 2 arg_tys
 
-    rhs = mkLams tyvars  (Lam dict_id   rhs_body)
     rhs_body | new_tycon = unwrapNewTypeBody tycon (map mkTyVarTy tyvars) (Var dict_id)
              | otherwise = Case (Var dict_id) dict_id (idType the_arg_id)
                                 [(DataAlt data_con, arg_ids, varToCoreExpr the_arg_id)]
@@ -956,29 +954,13 @@ mkFCallId dflags uniq fcall ty
 %*                                                                      *
 %************************************************************************
 
-Important notes about dict funs and default methods
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Note [Dict funs and default methods]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 Dict funs and default methods are *not* ImplicitIds.  Their definition
 involves user-written code, so we can't figure out their strictness etc
 based on fixed info, as we can for constructors and record selectors (say).
 
-We build them as LocalIds, but with External Names.  This ensures that
-they are taken to account by free-variable finding and dependency
-analysis (e.g. CoreFVs.exprFreeVars).
-
-Why shouldn't they be bound as GlobalIds?  Because, in particular, if
-they are globals, the specialiser floats dict uses above their defns,
-which prevents good simplifications happening.  Also the strictness
-analyser treats a occurrence of a GlobalId as imported and assumes it
-contains strictness in its IdInfo, which isn't true if the thing is
-bound in the same module as the occurrence.
-
-It's OK for dfuns to be LocalIds, because we form the instance-env to
-pass on to the next module (md_insts) in CoreTidy, afer tidying
-and globalising the top-level Ids.
-
-BUT make sure they are *exported* LocalIds (mkExportedLocalId) so 
-that they aren't discarded by the occurrence analyser.
+NB: See also Note [Exported LocalIds] in Id
 
 \begin{code}
 mkDictFunId :: Name      -- Name to use for the dict fun;
@@ -988,12 +970,12 @@ mkDictFunId :: Name      -- Name to use for the dict fun;
             -> [Type]
             -> Id
 -- Implements the DFun Superclass Invariant (see TcInstDcls)
+-- See Note [Dict funs and default methods]
 
 mkDictFunId dfun_name tvs theta clas tys
-  = mkExportedLocalVar (DFunId n_silent is_nt)
-                       dfun_name
-                       dfun_ty
-                       vanillaIdInfo
+  = mkExportedLocalId (DFunId n_silent is_nt)
+                      dfun_name
+                      dfun_ty
   where
     is_nt = isNewTyCon (classTyCon clas)
     (n_silent, dfun_ty) = mkDictFunTy tvs theta clas tys
@@ -1040,20 +1022,32 @@ another gun with which to shoot yourself in the foot.
 \begin{code}
 lazyIdName, unsafeCoerceName, nullAddrName, seqName,
    realWorldName, voidPrimIdName, coercionTokenName,
-   magicDictName, coerceName, proxyName :: Name
-unsafeCoerceName  = mkWiredInIdName gHC_PRIM (fsLit "unsafeCoerce#") unsafeCoerceIdKey  unsafeCoerceId
-nullAddrName      = mkWiredInIdName gHC_PRIM (fsLit "nullAddr#")     nullAddrIdKey      nullAddrId
-seqName           = mkWiredInIdName gHC_PRIM (fsLit "seq")           seqIdKey           seqId
-realWorldName     = mkWiredInIdName gHC_PRIM (fsLit "realWorld#")    realWorldPrimIdKey realWorldPrimId
-voidPrimIdName    = mkWiredInIdName gHC_PRIM (fsLit "void#")         voidPrimIdKey      voidPrimId
-lazyIdName        = mkWiredInIdName gHC_MAGIC (fsLit "lazy")         lazyIdKey           lazyId
-coercionTokenName = mkWiredInIdName gHC_PRIM (fsLit "coercionToken#") coercionTokenIdKey coercionTokenId
-magicDictName     = mkWiredInIdName gHC_PRIM (fsLit "magicDict")     magicDictKey magicDictId
-coerceName        = mkWiredInIdName gHC_PRIM (fsLit "coerce")        coerceKey          coerceId
-proxyName         = mkWiredInIdName gHC_PRIM (fsLit "proxy#")        proxyHashKey       proxyHashId
+   magicDictName, coerceName, proxyName, dollarName :: Name
+unsafeCoerceName  = mkWiredInIdName gHC_PRIM  (fsLit "unsafeCoerce#")  unsafeCoerceIdKey  unsafeCoerceId
+nullAddrName      = mkWiredInIdName gHC_PRIM  (fsLit "nullAddr#")      nullAddrIdKey      nullAddrId
+seqName           = mkWiredInIdName gHC_PRIM  (fsLit "seq")            seqIdKey           seqId
+realWorldName     = mkWiredInIdName gHC_PRIM  (fsLit "realWorld#")     realWorldPrimIdKey realWorldPrimId
+voidPrimIdName    = mkWiredInIdName gHC_PRIM  (fsLit "void#")          voidPrimIdKey      voidPrimId
+lazyIdName        = mkWiredInIdName gHC_MAGIC (fsLit "lazy")           lazyIdKey          lazyId
+coercionTokenName = mkWiredInIdName gHC_PRIM  (fsLit "coercionToken#") coercionTokenIdKey coercionTokenId
+magicDictName     = mkWiredInIdName gHC_PRIM  (fsLit "magicDict")      magicDictKey       magicDictId
+coerceName        = mkWiredInIdName gHC_PRIM  (fsLit "coerce")         coerceKey          coerceId
+proxyName         = mkWiredInIdName gHC_PRIM  (fsLit "proxy#")         proxyHashKey       proxyHashId
+dollarName        = mkWiredInIdName gHC_BASE  (fsLit "$")              dollarIdKey        dollarId
 \end{code}
 
 \begin{code}
+dollarId :: Id  -- Note [dollarId magic]
+dollarId = pcMiscPrelId dollarName ty
+             (noCafIdInfo `setUnfoldingInfo` unf)
+  where
+    fun_ty = mkFunTy alphaTy openBetaTy
+    ty     = mkForAllTys [alphaTyVar, openBetaTyVar] $
+             mkFunTy fun_ty fun_ty
+    unf    = mkInlineUnfolding (Just 2) rhs
+    [f,x]  = mkTemplateLocals [fun_ty, alphaTy]
+    rhs    = mkLams [alphaTyVar, openBetaTyVar, f, x] $
+             App (Var f) (Var x)
 
 ------------------------------------------------
 -- proxy# :: forall a. Proxy# a
@@ -1160,6 +1154,20 @@ coerceId = pcMiscPrelId coerceName ty info
 	  [(DataAlt coercibleDataCon, [eq], Cast (Var x) (CoVarCo eq))]
 \end{code}
 
+Note [dollarId magic]
+~~~~~~~~~~~~~~~~~~~~~
+The only reason that ($) is wired in is so that its type can be
+    forall (a:*, b:Open). (a->b) -> a -> b
+That is, the return type can be unboxed.  E.g. this is OK
+    foo $ True    where  foo :: Bool -> Int#
+because ($) doesn't inspect or move the result of the call to foo.
+See Trac #8739.
+
+There is a special typing rule for ($) in TcExpr, so the type of ($)
+isn't looked at there, BUT Lint subsequently (and rightly) complains
+if sees ($) applied to Int# (say), unless we give it a wired-in type
+as we do here.
+
 Note [Unsafe coerce magic]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~
 We define a *primitive*
diff --git a/compiler/basicTypes/Module.lhs b/compiler/basicTypes/Module.lhs
index 90bf717a857d..8f21d66bc18f 100644
--- a/compiler/basicTypes/Module.lhs
+++ b/compiler/basicTypes/Module.lhs
@@ -9,6 +9,7 @@ These are Uniquable, hence we can build Maps with Modules as
 the keys.
 
 \begin{code}
+{-# LANGUAGE DeriveDataTypeable #-}
 
 module Module
     (
@@ -22,30 +23,31 @@ module Module
         mkModuleNameFS,
         stableModuleNameCmp,
 
-        -- * The PackageId type
-        PackageId,
-        fsToPackageId,
-        packageIdFS,
-        stringToPackageId,
-        packageIdString,
-        stablePackageIdCmp,
+        -- * The PackageKey type
+        PackageKey,
+        fsToPackageKey,
+        packageKeyFS,
+        stringToPackageKey,
+        packageKeyString,
+        stablePackageKeyCmp,
 
-        -- * Wired-in PackageIds
+        -- * Wired-in PackageKeys
         -- $wired_in_packages
-        primPackageId,
-        integerPackageId,
-        basePackageId,
-        rtsPackageId,
-        thPackageId,
-        dphSeqPackageId,
-        dphParPackageId,
-        mainPackageId,
-        thisGhcPackageId,
-        interactivePackageId, isInteractiveModule,
+        primPackageKey,
+        integerPackageKey,
+        basePackageKey,
+        rtsPackageKey,
+        thPackageKey,
+        dphSeqPackageKey,
+        dphParPackageKey,
+        mainPackageKey,
+        thisGhcPackageKey,
+        interactivePackageKey, isInteractiveModule,
+        wiredInPackageKeys,
 
         -- * The Module type
         Module,
-        modulePackageId, moduleName,
+        modulePackageKey, moduleName,
         pprModule,
         mkModule,
         stableModuleCmp,
@@ -81,6 +83,7 @@ import UniqFM
 import FastString
 import Binary
 import Util
+import {-# SOURCE #-} Packages
 
 import Data.Data
 import Data.Map (Map)
@@ -227,15 +230,15 @@ moduleNameColons = dots_to_colons . moduleNameString
 %************************************************************************
 
 \begin{code}
--- | A Module is a pair of a 'PackageId' and a 'ModuleName'.
+-- | A Module is a pair of a 'PackageKey' and a 'ModuleName'.
 data Module = Module {
-   modulePackageId :: !PackageId,  -- pkg-1.0
+   modulePackageKey :: !PackageKey,  -- pkg-1.0
    moduleName      :: !ModuleName  -- A.B.C
   }
   deriving (Eq, Ord, Typeable)
 
 instance Uniquable Module where
-  getUnique (Module p n) = getUnique (packageIdFS p `appendFS` moduleNameFS n)
+  getUnique (Module p n) = getUnique (packageKeyFS p `appendFS` moduleNameFS n)
 
 instance Outputable Module where
   ppr = pprModule
@@ -255,25 +258,25 @@ instance Data Module where
 -- not be stable from run to run of the compiler.
 stableModuleCmp :: Module -> Module -> Ordering
 stableModuleCmp (Module p1 n1) (Module p2 n2)
-   = (p1 `stablePackageIdCmp`  p2) `thenCmp`
+   = (p1 `stablePackageKeyCmp`  p2) `thenCmp`
      (n1 `stableModuleNameCmp` n2)
 
-mkModule :: PackageId -> ModuleName -> Module
+mkModule :: PackageKey -> ModuleName -> Module
 mkModule = Module
 
 pprModule :: Module -> SDoc
 pprModule mod@(Module p n)  =
   pprPackagePrefix p mod <> pprModuleName n
 
-pprPackagePrefix :: PackageId -> Module -> SDoc
+pprPackagePrefix :: PackageKey -> Module -> SDoc
 pprPackagePrefix p mod = getPprStyle doc
  where
    doc sty
        | codeStyle sty =
-          if p == mainPackageId
+          if p == mainPackageKey
                 then empty -- never qualify the main package in code
-                else ztext (zEncodeFS (packageIdFS p)) <> char '_'
-       | qualModule sty mod = ftext (packageIdFS (modulePackageId mod)) <> char ':'
+                else ztext (zEncodeFS (packageKeyFS p)) <> char '_'
+       | qualModule sty mod = ppr (modulePackageKey mod) <> char ':'
                 -- the PrintUnqualified tells us which modules have to
                 -- be qualified with package names
        | otherwise = empty
@@ -287,51 +290,59 @@ class HasModule m where
 
 %************************************************************************
 %*                                                                      *
-\subsection{PackageId}
+\subsection{PackageKey}
 %*                                                                      *
 %************************************************************************
 
 \begin{code}
--- | Essentially just a string identifying a package, including the version: e.g. parsec-1.0
-newtype PackageId = PId FastString deriving( Eq, Typeable )
+-- | A string which uniquely identifies a package.  For wired-in packages,
+-- it is just the package name, but for user compiled packages, it is a hash.
+-- ToDo: when the key is a hash, we can do more clever things than store
+-- the hex representation and hash-cons those strings.
+newtype PackageKey = PId FastString deriving( Eq, Typeable )
     -- here to avoid module loops with PackageConfig
 
-instance Uniquable PackageId where
- getUnique pid = getUnique (packageIdFS pid)
+instance Uniquable PackageKey where
+ getUnique pid = getUnique (packageKeyFS pid)
 
 -- Note: *not* a stable lexicographic ordering, a faster unique-based
 -- ordering.
-instance Ord PackageId where
+instance Ord PackageKey where
   nm1 `compare` nm2 = getUnique nm1 `compare` getUnique nm2
 
-instance Data PackageId where
+instance Data PackageKey where
   -- don't traverse?
-  toConstr _   = abstractConstr "PackageId"
+  toConstr _   = abstractConstr "PackageKey"
   gunfold _ _  = error "gunfold"
-  dataTypeOf _ = mkNoRepType "PackageId"
+  dataTypeOf _ = mkNoRepType "PackageKey"
 
-stablePackageIdCmp :: PackageId -> PackageId -> Ordering
+stablePackageKeyCmp :: PackageKey -> PackageKey -> Ordering
 -- ^ Compares package ids lexically, rather than by their 'Unique's
-stablePackageIdCmp p1 p2 = packageIdFS p1 `compare` packageIdFS p2
+stablePackageKeyCmp p1 p2 = packageKeyFS p1 `compare` packageKeyFS p2
 
-instance Outputable PackageId where
-   ppr pid = text (packageIdString pid)
+instance Outputable PackageKey where
+   ppr pk = getPprStyle $ \sty -> sdocWithDynFlags $ \dflags ->
+    text (packageKeyPackageIdString dflags pk)
+    -- Don't bother qualifying if it's wired in!
+       <> (if qualPackage sty pk && not (pk `elem` wiredInPackageKeys)
+            then char '@' <> ftext (packageKeyFS pk)
+            else empty)
 
-instance Binary PackageId where
-  put_ bh pid = put_ bh (packageIdFS pid)
-  get bh = do { fs <- get bh; return (fsToPackageId fs) }
+instance Binary PackageKey where
+  put_ bh pid = put_ bh (packageKeyFS pid)
+  get bh = do { fs <- get bh; return (fsToPackageKey fs) }
 
-fsToPackageId :: FastString -> PackageId
-fsToPackageId = PId
+fsToPackageKey :: FastString -> PackageKey
+fsToPackageKey = PId
 
-packageIdFS :: PackageId -> FastString
-packageIdFS (PId fs) = fs
+packageKeyFS :: PackageKey -> FastString
+packageKeyFS (PId fs) = fs
 
-stringToPackageId :: String -> PackageId
-stringToPackageId = fsToPackageId . mkFastString
+stringToPackageKey :: String -> PackageKey
+stringToPackageKey = fsToPackageKey . mkFastString
 
-packageIdString :: PackageId -> String
-packageIdString = unpackFS . packageIdFS
+packageKeyString :: PackageKey -> String
+packageKeyString = unpackFS . packageKeyFS
 
 
 -- -----------------------------------------------------------------------------
@@ -347,7 +358,7 @@ packageIdString = unpackFS . packageIdFS
 -- versions of them installed.  However, for each invocation of GHC,
 -- only a single instance of each wired-in package will be recognised
 -- (the desired one is selected via @-package@\/@-hide-package@), and GHC
--- will use the unversioned 'PackageId' below when referring to it,
+-- will use the unversioned 'PackageKey' below when referring to it,
 -- including in .hi files and object file symbols.  Unselected
 -- versions of wired-in packages will be ignored, as will any other
 -- package that depends directly or indirectly on it (much as if you
@@ -355,27 +366,37 @@ packageIdString = unpackFS . packageIdFS
 
 -- Make sure you change 'Packages.findWiredInPackages' if you add an entry here
 
-integerPackageId, primPackageId,
-  basePackageId, rtsPackageId,
-  thPackageId, dphSeqPackageId, dphParPackageId,
-  mainPackageId, thisGhcPackageId, interactivePackageId  :: PackageId
-primPackageId        = fsToPackageId (fsLit "ghc-prim")
-integerPackageId     = fsToPackageId (fsLit cIntegerLibrary)
-basePackageId        = fsToPackageId (fsLit "base")
-rtsPackageId         = fsToPackageId (fsLit "rts")
-thPackageId          = fsToPackageId (fsLit "template-haskell")
-dphSeqPackageId      = fsToPackageId (fsLit "dph-seq")
-dphParPackageId      = fsToPackageId (fsLit "dph-par")
-thisGhcPackageId     = fsToPackageId (fsLit ("ghc-" ++ cProjectVersion))
-interactivePackageId = fsToPackageId (fsLit "interactive")
+integerPackageKey, primPackageKey,
+  basePackageKey, rtsPackageKey,
+  thPackageKey, dphSeqPackageKey, dphParPackageKey,
+  mainPackageKey, thisGhcPackageKey, interactivePackageKey  :: PackageKey
+primPackageKey        = fsToPackageKey (fsLit "ghc-prim")
+integerPackageKey     = fsToPackageKey (fsLit cIntegerLibrary)
+basePackageKey        = fsToPackageKey (fsLit "base")
+rtsPackageKey         = fsToPackageKey (fsLit "rts")
+thPackageKey          = fsToPackageKey (fsLit "template-haskell")
+dphSeqPackageKey      = fsToPackageKey (fsLit "dph-seq")
+dphParPackageKey      = fsToPackageKey (fsLit "dph-par")
+thisGhcPackageKey     = fsToPackageKey (fsLit "ghc")
+interactivePackageKey = fsToPackageKey (fsLit "interactive")
 
 -- | This is the package Id for the current program.  It is the default
 -- package Id if you don't specify a package name.  We don't add this prefix
 -- to symbol names, since there can be only one main package per program.
-mainPackageId      = fsToPackageId (fsLit "main")
+mainPackageKey      = fsToPackageKey (fsLit "main")
 
 isInteractiveModule :: Module -> Bool
-isInteractiveModule mod = modulePackageId mod == interactivePackageId
+isInteractiveModule mod = modulePackageKey mod == interactivePackageKey
+
+wiredInPackageKeys :: [PackageKey]
+wiredInPackageKeys = [ primPackageKey,
+                       integerPackageKey,
+                       basePackageKey,
+                       rtsPackageKey,
+                       thPackageKey,
+                       thisGhcPackageKey,
+                       dphSeqPackageKey,
+                       dphParPackageKey ]
 \end{code}
 
 %************************************************************************
diff --git a/compiler/basicTypes/Module.lhs-boot b/compiler/basicTypes/Module.lhs-boot
index 63839b55bc5e..6d194d6a2a0e 100644
--- a/compiler/basicTypes/Module.lhs-boot
+++ b/compiler/basicTypes/Module.lhs-boot
@@ -3,8 +3,8 @@ module Module where
 
 data Module
 data ModuleName
-data PackageId
+data PackageKey
 moduleName :: Module -> ModuleName
-modulePackageId :: Module -> PackageId
-packageIdString :: PackageId -> String
+modulePackageKey :: Module -> PackageKey
+packageKeyString :: PackageKey -> String
 \end{code}
diff --git a/compiler/basicTypes/Name.lhs b/compiler/basicTypes/Name.lhs
index e2742bb3a8ed..7651c7c74926 100644
--- a/compiler/basicTypes/Name.lhs
+++ b/compiler/basicTypes/Name.lhs
@@ -5,6 +5,8 @@
 \section[Name]{@Name@: to transmit name info from renamer to typechecker}
 
 \begin{code}
+{-# LANGUAGE DeriveDataTypeable #-}
+
 -- |
 -- #name_types#
 -- GHC uses several kinds of name internally:
@@ -501,7 +503,7 @@ pprModulePrefix sty mod occ = sdocWithDynFlags $ \dflags ->
     case qualName sty mod occ of              -- See Outputable.QualifyName:
       NameQual modname -> ppr modname <> dot       -- Name is in scope
       NameNotInScope1  -> ppr mod <> dot           -- Not in scope
-      NameNotInScope2  -> ppr (modulePackageId mod) <> colon     -- Module not in
+      NameNotInScope2  -> ppr (modulePackageKey mod) <> colon     -- Module not in
                           <> ppr (moduleName mod) <> dot         -- scope either
       _otherwise       -> empty
 
diff --git a/compiler/basicTypes/NameEnv.lhs b/compiler/basicTypes/NameEnv.lhs
index 79433ca14451..f39627706db8 100644
--- a/compiler/basicTypes/NameEnv.lhs
+++ b/compiler/basicTypes/NameEnv.lhs
@@ -5,7 +5,8 @@
 \section[NameEnv]{@NameEnv@: name environments}
 
 \begin{code}
-{-# OPTIONS -fno-warn-tabs #-}
+{-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
 -- The above warning supression flag is a temporary kludge.
 -- While working on this module you are encouraged to remove it and
 -- detab the module (please do the detabbing in a separate patch). See
@@ -58,7 +59,7 @@ depAnal get_defs get_uses nodes
   = stronglyConnCompFromEdgedVertices (map mk_node keyed_nodes)
   where
     keyed_nodes = nodes `zip` [(1::Int)..]
-    mk_node (node, key) = (node, key, mapCatMaybes (lookupNameEnv key_map) (get_uses node))
+    mk_node (node, key) = (node, key, mapMaybe (lookupNameEnv key_map) (get_uses node))
 
     key_map :: NameEnv Int   -- Maps a Name to the key of the decl that defines it
     key_map = mkNameEnv [(name,key) | (node, key) <- keyed_nodes, name <- get_defs node]                        
diff --git a/compiler/basicTypes/NameSet.lhs b/compiler/basicTypes/NameSet.lhs
index ed42c2b1aadf..9cd9fcef939f 100644
--- a/compiler/basicTypes/NameSet.lhs
+++ b/compiler/basicTypes/NameSet.lhs
@@ -4,7 +4,8 @@
 %
 
 \begin{code}
-{-# OPTIONS -fno-warn-tabs #-}
+{-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
 -- The above warning supression flag is a temporary kludge.
 -- While working on this module you are encouraged to remove it and
 -- detab the module (please do the detabbing in a separate patch). See
diff --git a/compiler/basicTypes/OccName.lhs b/compiler/basicTypes/OccName.lhs
index 6dbae4bb61d4..d942362db790 100644
--- a/compiler/basicTypes/OccName.lhs
+++ b/compiler/basicTypes/OccName.lhs
@@ -4,6 +4,8 @@
 %
 
 \begin{code}
+{-# LANGUAGE DeriveDataTypeable #-}
+
 -- |
 -- #name_types#
 -- GHC uses several kinds of name internally:
@@ -20,7 +22,7 @@
 --
 -- * 'Var.Var': see "Var#name_types"
 
-{-# OPTIONS -fno-warn-tabs #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
 -- The above warning supression flag is a temporary kludge.
 -- While working on this module you are encouraged to remove it and
 -- detab the module (please do the detabbing in a separate patch). See
@@ -30,6 +32,8 @@
 module OccName (
 	-- * The 'NameSpace' type
 	NameSpace, -- Abstract
+
+        nameSpacesRelated,
 	
 	-- ** Construction
 	-- $real_vs_source_data_constructors
@@ -51,7 +55,6 @@ module OccName (
 	mkTcOcc, mkTcOccFS,
 	mkClsOcc, mkClsOccFS,
         mkDFunOcc,
-	mkTupleOcc, 
 	setOccNameSpace,
         demoteOccName,
         HasOccName(..),
@@ -62,9 +65,9 @@ module OccName (
         mkGenDefMethodOcc, 
 	mkDerivedTyConOcc, mkNewTyCoOcc, mkClassOpAuxOcc,
         mkCon2TagOcc, mkTag2ConOcc, mkMaxTagOcc,
-  	mkClassDataConOcc, mkDictOcc, mkIPOcc, 
- 	mkSpecOcc, mkForeignExportOcc, mkGenOcc1, mkGenOcc2,
- 	mkGenD, mkGenR, mkGen1R, mkGenRCo, mkGenC, mkGenS,
+	mkClassDataConOcc, mkDictOcc, mkIPOcc,
+	mkSpecOcc, mkForeignExportOcc, mkRepEqOcc, mkGenOcc1, mkGenOcc2,
+	mkGenD, mkGenR, mkGen1R, mkGenRCo, mkGenC, mkGenS,
         mkDataTOcc, mkDataCOcc, mkDataConWorkerOcc,
 	mkSuperDictSelOcc, mkLocalOcc, mkMethodOcc, mkInstTyTcOcc,
 	mkInstTyCoOcc, mkEqPredCoOcc,
@@ -82,14 +85,12 @@ module OccName (
 	
 	isTcClsNameSpace, isTvNameSpace, isDataConNameSpace, isVarNameSpace, isValNameSpace,
 
-	isTupleOcc_maybe,
-
 	-- * The 'OccEnv' type
 	OccEnv, emptyOccEnv, unitOccEnv, extendOccEnv, mapOccEnv,
 	lookupOccEnv, mkOccEnv, mkOccEnv_C, extendOccEnvList, elemOccEnv,
 	occEnvElts, foldOccEnv, plusOccEnv, plusOccEnv_C, extendOccEnv_C,
         extendOccEnv_Acc, filterOccEnv, delListFromOccEnv, delFromOccEnv,
-        alterOccEnv, 
+        alterOccEnv, pprOccEnv,
 
 	-- * The 'OccSet' type
 	OccSet, emptyOccSet, unitOccSet, mkOccSet, extendOccSet, 
@@ -103,12 +104,14 @@ module OccName (
 	-- * Lexical characteristics of Haskell names
 	isLexCon, isLexVar, isLexId, isLexSym,
 	isLexConId, isLexConSym, isLexVarId, isLexVarSym,
-	startsVarSym, startsVarId, startsConSym, startsConId
+	startsVarSym, startsVarId, startsConSym, startsConId,
+
+        -- FsEnv
+        FastStringEnv, emptyFsEnv, lookupFsEnv, extendFsEnv, mkFsEnv
     ) where
 
 import Util
 import Unique
-import BasicTypes
 import DynFlags
 import UniqFM
 import UniqSet
@@ -119,6 +122,29 @@ import Data.Char
 import Data.Data
 \end{code}
 
+%************************************************************************
+%*									*
+              FastStringEnv
+%*									*
+%************************************************************************
+
+FastStringEnv can't be in FastString because the env depends on UniqFM
+
+\begin{code}
+type FastStringEnv a = UniqFM a         -- Keyed by FastString
+
+
+emptyFsEnv  :: FastStringEnv a
+lookupFsEnv :: FastStringEnv a -> FastString -> Maybe a
+extendFsEnv :: FastStringEnv a -> FastString -> a -> FastStringEnv a
+mkFsEnv     :: [(FastString,a)] -> FastStringEnv a
+
+emptyFsEnv  = emptyUFM
+lookupFsEnv = lookupUFM
+extendFsEnv = addToUFM
+mkFsEnv     = listToUFM
+\end{code}
+
 %************************************************************************
 %*									*
 \subsection{Name space}
@@ -248,6 +274,9 @@ instance Data OccName where
   toConstr _   = abstractConstr "OccName"
   gunfold _ _  = error "gunfold"
   dataTypeOf _ = mkNoRepType "OccName"
+
+instance HasOccName OccName where
+  occName = id
 \end{code}
 
 
@@ -261,6 +290,11 @@ instance Data OccName where
 instance Outputable OccName where
     ppr = pprOccName
 
+instance OutputableBndr OccName where
+    pprBndr _ = ppr
+    pprInfixOcc n = pprInfixVar (isSymOcc n) (ppr n)
+    pprPrefixOcc n = pprPrefixVar (isSymOcc n) (ppr n)
+
 pprOccName :: OccName -> SDoc
 pprOccName (OccName sp occ) 
   = getPprStyle $ \ sty ->
@@ -338,7 +372,20 @@ demoteOccName (OccName space name) = do
   space' <- demoteNameSpace space
   return $ OccName space' name
 
-{- | Other names in the compiler add aditional information to an OccName.
+-- Name spaces are related if there is a chance to mean the one when one writes
+-- the other, i.e. variables <-> data constructors and type variables <-> type constructors
+nameSpacesRelated :: NameSpace -> NameSpace -> Bool
+nameSpacesRelated ns1 ns2 = ns1 == ns2 || otherNameSpace ns1 == ns2
+
+otherNameSpace :: NameSpace -> NameSpace
+otherNameSpace VarName = DataName
+otherNameSpace DataName = VarName
+otherNameSpace TvName = TcClsName
+otherNameSpace TcClsName = TvName
+
+
+
+{- | Other names in the compiler add additional information to an OccName.
 This class provides a consistent way to access the underlying OccName. -}
 class HasOccName name where
   occName :: name -> OccName
@@ -415,7 +462,10 @@ filterOccEnv x (A y)       = A $ filterUFM x y
 alterOccEnv fn (A y) k     = A $ alterUFM fn y k
 
 instance Outputable a => Outputable (OccEnv a) where
-    ppr (A x) = ppr x
+    ppr x = pprOccEnv ppr x
+
+pprOccEnv :: (a -> SDoc) -> OccEnv a -> SDoc
+pprOccEnv ppr_elt (A env) = pprUniqFM ppr_elt env
 
 type OccSet = UniqSet OccName
 
@@ -496,7 +546,7 @@ isDataSymOcc _                    = False
 -- it is a data constructor or variable or whatever)
 isSymOcc :: OccName -> Bool
 isSymOcc (OccName DataName s)  = isLexConSym s
-isSymOcc (OccName TcClsName s) = isLexConSym s || isLexVarSym s
+isSymOcc (OccName TcClsName s) = isLexSym s
 isSymOcc (OccName VarName s)   = isLexSym s
 isSymOcc (OccName TvName s)    = isLexSym s
 -- Pretty inefficient!
@@ -572,7 +622,7 @@ isDerivedOccName occ =
 \begin{code}
 mkDataConWrapperOcc, mkWorkerOcc, mkMatcherOcc, mkDefaultMethodOcc,
         mkGenDefMethodOcc, mkDerivedTyConOcc, mkClassDataConOcc, mkDictOcc,
- 	mkIPOcc, mkSpecOcc, mkForeignExportOcc, mkGenOcc1, mkGenOcc2,
+	mkIPOcc, mkSpecOcc, mkForeignExportOcc, mkRepEqOcc, mkGenOcc1, mkGenOcc2,
  	mkGenD, mkGenR, mkGen1R, mkGenRCo,
 	mkDataTOcc, mkDataCOcc, mkDataConWorkerOcc, mkNewTyCoOcc,
 	mkInstTyCoOcc, mkEqPredCoOcc, mkClassOpAuxOcc,
@@ -593,6 +643,7 @@ mkDictOcc	    = mk_simple_deriv varName  "$d"
 mkIPOcc		    = mk_simple_deriv varName  "$i"
 mkSpecOcc	    = mk_simple_deriv varName  "$s"
 mkForeignExportOcc  = mk_simple_deriv varName  "$f"
+mkRepEqOcc          = mk_simple_deriv tvName   "$r"      -- In RULES involving Coercible
 mkNewTyCoOcc        = mk_simple_deriv tcName   "NTCo:"	-- Coercion for newtypes
 mkInstTyCoOcc       = mk_simple_deriv tcName   "TFCo:"   -- Coercion for type functions
 mkEqPredCoOcc	    = mk_simple_deriv tcName   "$co"
@@ -805,55 +856,6 @@ tidyOccName env occ@(OccName occ_sp fs)
          new_fs = mkFastString (base ++ show n)
 \end{code}
 
-%************************************************************************
-%*									*
-		Stuff for dealing with tuples
-%*									*
-%************************************************************************
-
-\begin{code}
-mkTupleOcc :: NameSpace -> TupleSort -> Arity -> OccName
-mkTupleOcc ns sort ar = OccName ns (mkFastString str)
-  where
- 	-- no need to cache these, the caching is done in the caller
-	-- (TysWiredIn.mk_tuple)
-    str = case sort of
-		UnboxedTuple    -> '(' : '#' : commas ++ "#)"
-		BoxedTuple      -> '(' : commas ++ ")"
-                ConstraintTuple -> '(' : commas ++ ")"
-                  -- Cute hack: reuse the standard tuple OccNames (and hence code)
-                  -- for fact tuples, but give them different Uniques so they are not equal.
-                  --
-                  -- You might think that this will go wrong because isTupleOcc_maybe won't
-                  -- be able to tell the difference between boxed tuples and fact tuples. BUT:
-                  --  1. Fact tuples never occur directly in user code, so it doesn't matter
-                  --     that we can't detect them in Orig OccNames originating from the user
-                  --     programs (or those built by setRdrNameSpace used on an Exact tuple Name)
-                  --  2. Interface files have a special representation for tuple *occurrences*
-                  --     in IfaceTyCons, their workers (in IfaceSyn) and their DataCons (in case
-                  --     alternatives). Thus we don't rely on the OccName to figure out what kind
-                  --     of tuple an occurrence was trying to use in these situations.
-                  --  3. We *don't* represent tuple data type declarations specially, so those
-                  --     are still turned into wired-in names via isTupleOcc_maybe. But that's OK
-                  --     because we don't actually need to declare fact tuples thanks to this hack.
-                  --
-                  -- So basically any OccName like (,,) flowing to isTupleOcc_maybe will always
-                  -- refer to the standard boxed tuple. Cool :-)
-
-    commas = take (ar-1) (repeat ',')
-
-isTupleOcc_maybe :: OccName -> Maybe (NameSpace, TupleSort, Arity)
--- Tuples are special, because there are so many of them!
-isTupleOcc_maybe (OccName ns fs)
-  = case unpackFS fs of
-	'(':'#':',':rest     -> Just (ns, UnboxedTuple, 2 + count_commas rest)
-	'(':',':rest         -> Just (ns, BoxedTuple,   2 + count_commas rest)
-	_other               -> Nothing
-  where
-    count_commas (',':rest) = 1 + count_commas rest
-    count_commas _          = 0
-\end{code}
-
 %************************************************************************
 %*									*
 \subsection{Lexical categories}
@@ -863,6 +865,15 @@ isTupleOcc_maybe (OccName ns fs)
 These functions test strings to see if they fit the lexical categories
 defined in the Haskell report.
 
+Note [Classification of generated names]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+Some names generated for internal use can show up in debugging output,
+e.g.  when using -ddump-simpl. These generated names start with a $
+but should still be pretty-printed using prefix notation. We make sure
+this is the case in isLexVarSym by only classifying a name as a symbol
+if all its characters are symbols, not just its first one.
+
 \begin{code}
 isLexCon,   isLexVar,    isLexId,    isLexSym    :: FastString -> Bool
 isLexConId, isLexConSym, isLexVarId, isLexVarSym :: FastString -> Bool
@@ -889,19 +900,26 @@ isLexConSym cs				-- Infix type or data constructors
   | cs == (fsLit "->") = True
   | otherwise	       = startsConSym (headFS cs)
 
-isLexVarSym cs				-- Infix identifiers
-  | nullFS cs	      = False		-- 	e.g. "+"
-  | otherwise         = startsVarSym (headFS cs)
+isLexVarSym fs				-- Infix identifiers e.g. "+"
+  | fs == (fsLit "~R#") = True
+  | otherwise
+  = case (if nullFS fs then [] else unpackFS fs) of
+      [] -> False
+      (c:cs) -> startsVarSym c && all isVarSymChar cs
+        -- See Note [Classification of generated names]
 
 -------------
 startsVarSym, startsVarId, startsConSym, startsConId :: Char -> Bool
-startsVarSym c = isSymbolASCII c || (ord c > 0x7f && isSymbol c) -- Infix Ids
-startsConSym c = c == ':'				-- Infix data constructors
+startsVarSym c = isSymbolASCII c || (ord c > 0x7f && isSymbol c)  -- Infix Ids
+startsConSym c = c == ':'		-- Infix data constructors
 startsVarId c  = isLower c || c == '_'	-- Ordinary Ids
 startsConId c  = isUpper c || c == '('	-- Ordinary type constructors and data constructors
 
 isSymbolASCII :: Char -> Bool
 isSymbolASCII c = c `elem` "!#$%&*+./<=>?@\\^|~-"
+
+isVarSymChar :: Char -> Bool
+isVarSymChar c = c == ':' || startsVarSym c
 \end{code}
 
 %************************************************************************
diff --git a/compiler/basicTypes/PatSyn.lhs b/compiler/basicTypes/PatSyn.lhs
index 9285b3c365a7..cba842729276 100644
--- a/compiler/basicTypes/PatSyn.lhs
+++ b/compiler/basicTypes/PatSyn.lhs
@@ -5,21 +5,25 @@
 \section[PatSyn]{@PatSyn@: Pattern synonyms}
 
 \begin{code}
+{-# LANGUAGE CPP, DeriveDataTypeable #-}
 
 module PatSyn (
         -- * Main data types
         PatSyn, mkPatSyn,
 
         -- ** Type deconstruction
-        patSynId, patSynType, patSynArity, patSynIsInfix,
-        patSynArgs, patSynArgTys, patSynTyDetails,
+        patSynName, patSynArity, patSynIsInfix,
+        patSynArgs, patSynTyDetails, patSynType,
         patSynWrapper, patSynMatcher,
-        patSynExTyVars, patSynSig, patSynInstArgTys
+        patSynExTyVars, patSynSig,
+        patSynInstArgTys, patSynInstResTy,
+        tidyPatSynIds, patSynIds
     ) where
 
 #include "HsVersions.h"
 
 import Type
+import TcType( mkSigmaTy )
 import Name
 import Outputable
 import Unique
@@ -27,8 +31,6 @@ import Util
 import BasicTypes
 import FastString
 import Var
-import Id
-import TcType
 import HsBinds( HsPatSynDetails(..) )
 
 import qualified Data.Data as Data
@@ -37,8 +39,8 @@ import Data.Function
 \end{code}
 
 
-Pattern synonym representation
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Note [Pattern synonym representation]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 Consider the following pattern synonym declaration
 
         pattern P x = MkT [x] (Just 42)
@@ -58,15 +60,49 @@ with the following typeclass constraints:
 
 In this case, the fields of MkPatSyn will be set as follows:
 
-  psArgs       = [x :: b]
+  psArgs       = [b]
   psArity      = 1
   psInfix      = False
 
   psUnivTyVars = [t]
   psExTyVars   = [b]
-  psTheta      = ((Show (Maybe t), Ord b), (Eq t, Num t))
+  psProvTheta  = (Show (Maybe t), Ord b)
+  psReqTheta   = (Eq t, Num t)
   psOrigResTy  = T (Maybe t)
 
+Note [Matchers and wrappers for pattern synonyms]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+For each pattern synonym, we generate a single matcher function which
+implements the actual matching. For the above example, the matcher
+will have type:
+
+        $mP :: forall r t. (Eq t, Num t)
+            => T (Maybe t)
+            -> (forall b. (Show (Maybe t), Ord b) => b -> r)
+            -> r
+            -> r
+
+with the following implementation:
+
+        $mP @r @t $dEq $dNum scrut cont fail = case scrut of
+            MkT @b $dShow $dOrd [x] (Just 42) -> cont @b $dShow $dOrd x
+            _                                 -> fail
+
+For *bidirectional* pattern synonyms, we also generate a single wrapper
+function which implements the pattern synonym in an expression
+context. For our running example, it will be:
+
+        $WP :: forall t b. (Show (Maybe t), Ord b, Eq t, Num t)
+            => b -> T (Maybe t)
+        $WP x = MkT [x] (Just 42)
+
+NB: the existential/universal and required/provided split does not
+apply to the wrapper since you are only putting stuff in, not getting
+stuff out.
+
+Injectivity of bidirectional pattern synonyms is checked in
+tcPatToExpr which walks the pattern and returns its corresponding
+expression when available.
 
 %************************************************************************
 %*                                                                      *
@@ -76,21 +112,36 @@ In this case, the fields of MkPatSyn will be set as follows:
 
 \begin{code}
 -- | A pattern synonym
+-- See Note [Pattern synonym representation]
 data PatSyn
   = MkPatSyn {
-        psId          :: Id,
-        psUnique      :: Unique,                 -- Cached from Name
-        psMatcher     :: Id,
-        psWrapper     :: Maybe Id,
+        psName        :: Name,
+        psUnique      :: Unique,      -- Cached from Name
 
-        psArgs        :: [Var],
-        psArity       :: Arity,                  -- == length psArgs
-        psInfix       :: Bool,                   -- True <=> declared infix
+        psArgs        :: [Type],
+        psArity       :: Arity,       -- == length psArgs
+        psInfix       :: Bool,        -- True <=> declared infix
 
-        psUnivTyVars  :: [TyVar],                -- Universially-quantified type variables
-        psExTyVars    :: [TyVar],                -- Existentially-quantified type vars
-        psTheta       :: (ThetaType, ThetaType), -- Provided and required dictionaries
-        psOrigResTy   :: Type
+        psUnivTyVars  :: [TyVar],     -- Universially-quantified type variables
+        psExTyVars    :: [TyVar],     -- Existentially-quantified type vars
+        psProvTheta   :: ThetaType,   -- Provided dictionaries
+        psReqTheta    :: ThetaType,   -- Required dictionaries
+        psOrigResTy   :: Type,        -- Mentions only psUnivTyVars
+
+        -- See Note [Matchers and wrappers for pattern synonyms]
+        psMatcher     :: Id,
+             -- Matcher function, of type
+             --   forall r univ_tvs. req_theta
+             --                   => res_ty
+             --                   -> (forall ex_tvs. prov_theta -> arg_tys -> r)
+             --                   -> r -> r
+
+        psWrapper     :: Maybe Id
+             -- Nothing  => uni-directional pattern synonym
+             -- Just wid => bi-direcitonal
+             -- Wrapper function, of type
+             --  forall univ_tvs, ex_tvs. (prov_theta, req_theta)
+             --                       =>  arg_tys -> res_ty
   }
   deriving Data.Typeable.Typeable
 \end{code}
@@ -117,7 +168,7 @@ instance Uniquable PatSyn where
     getUnique = psUnique
 
 instance NamedThing PatSyn where
-    getName = getName . psId
+    getName = patSynName
 
 instance Outputable PatSyn where
     ppr = ppr . getName
@@ -144,7 +195,7 @@ instance Data.Data PatSyn where
 -- | Build a new pattern synonym
 mkPatSyn :: Name
          -> Bool       -- ^ Is the pattern synonym declared infix?
-         -> [Var]      -- ^ Original arguments
+         -> [Type]     -- ^ Original arguments
          -> [TyVar]    -- ^ Universially-quantified type variables
          -> [TyVar]    -- ^ Existentially-quantified type variables
          -> ThetaType  -- ^ Wanted dicts
@@ -158,29 +209,30 @@ mkPatSyn name declared_infix orig_args
          prov_theta req_theta
          orig_res_ty
          matcher wrapper
-    = MkPatSyn {psId = id, psUnique = getUnique name,
+    = MkPatSyn {psName = name, psUnique = getUnique name,
                 psUnivTyVars = univ_tvs, psExTyVars = ex_tvs,
-                psTheta = (prov_theta, req_theta),
+                psProvTheta = prov_theta, psReqTheta = req_theta,
                 psInfix = declared_infix,
                 psArgs = orig_args,
                 psArity = length orig_args,
                 psOrigResTy = orig_res_ty,
                 psMatcher = matcher,
                 psWrapper = wrapper }
-  where
-    pat_ty = mkSigmaTy univ_tvs req_theta $
-             mkSigmaTy ex_tvs prov_theta $
-             mkFunTys (map varType orig_args) orig_res_ty
-    id = mkLocalId name pat_ty
 \end{code}
 
 \begin{code}
 -- | The 'Name' of the 'PatSyn', giving it a unique, rooted identification
-patSynId :: PatSyn -> Id
-patSynId = psId
+patSynName :: PatSyn -> Name
+patSynName = psName
 
 patSynType :: PatSyn -> Type
-patSynType = psOrigResTy
+-- The full pattern type, used only in error messages
+patSynType (MkPatSyn { psUnivTyVars = univ_tvs, psReqTheta = req_theta
+                     , psExTyVars   = ex_tvs,   psProvTheta = prov_theta
+                     , psArgs = orig_args, psOrigResTy = orig_res_ty })
+  = mkSigmaTy univ_tvs req_theta $
+    mkSigmaTy ex_tvs prov_theta $
+    mkFunTys orig_args orig_res_ty
 
 -- | Should the 'PatSyn' be presented infix?
 patSynIsInfix :: PatSyn -> Bool
@@ -190,22 +242,24 @@ patSynIsInfix = psInfix
 patSynArity :: PatSyn -> Arity
 patSynArity = psArity
 
-patSynArgs :: PatSyn -> [Var]
+patSynArgs :: PatSyn -> [Type]
 patSynArgs = psArgs
 
-patSynArgTys :: PatSyn -> [Type]
-patSynArgTys = map varType . patSynArgs
-
 patSynTyDetails :: PatSyn -> HsPatSynDetails Type
-patSynTyDetails ps = case (patSynIsInfix ps, patSynArgTys ps) of
-    (True, [left, right]) -> InfixPatSyn left right
-    (_, tys) -> PrefixPatSyn tys
+patSynTyDetails (MkPatSyn { psInfix = is_infix, psArgs = arg_tys })
+  | is_infix, [left,right] <- arg_tys
+  = InfixPatSyn left right
+  | otherwise
+  = PrefixPatSyn arg_tys
 
 patSynExTyVars :: PatSyn -> [TyVar]
 patSynExTyVars = psExTyVars
 
-patSynSig :: PatSyn -> ([TyVar], [TyVar], (ThetaType, ThetaType))
-patSynSig ps = (psUnivTyVars ps, psExTyVars ps, psTheta ps)
+patSynSig :: PatSyn -> ([TyVar], [TyVar], ThetaType, ThetaType, [Type], Type)
+patSynSig (MkPatSyn { psUnivTyVars = univ_tvs, psExTyVars = ex_tvs
+                    , psProvTheta = prov, psReqTheta = req
+                    , psArgs = arg_tys, psOrigResTy = res_ty })
+  = (univ_tvs, ex_tvs, prov, req, arg_tys, res_ty)
 
 patSynWrapper :: PatSyn -> Maybe Id
 patSynWrapper = psWrapper
@@ -213,13 +267,43 @@ patSynWrapper = psWrapper
 patSynMatcher :: PatSyn -> Id
 patSynMatcher = psMatcher
 
+patSynIds :: PatSyn -> [Id]
+patSynIds (MkPatSyn { psMatcher = match_id, psWrapper = mb_wrap_id })
+  = case mb_wrap_id of
+      Nothing      -> [match_id]
+      Just wrap_id -> [match_id, wrap_id]
+
+tidyPatSynIds :: (Id -> Id) -> PatSyn -> PatSyn
+tidyPatSynIds tidy_fn ps@(MkPatSyn { psMatcher = match_id, psWrapper = mb_wrap_id })
+  = ps { psMatcher = tidy_fn match_id, psWrapper = fmap tidy_fn mb_wrap_id }
+
 patSynInstArgTys :: PatSyn -> [Type] -> [Type]
-patSynInstArgTys ps inst_tys
+-- Return the types of the argument patterns
+-- e.g.  data D a = forall b. MkD a b (b->a)
+--       pattern P f x y = MkD (x,True) y f
+--          D :: forall a. forall b. a -> b -> (b->a) -> D a
+--          P :: forall c. forall b. (b->(c,Bool)) -> c -> b -> P c
+--   patSynInstArgTys P [Int,bb] = [bb->(Int,Bool), Int, bb]
+-- NB: the inst_tys should be both universal and existential
+patSynInstArgTys (MkPatSyn { psName = name, psUnivTyVars = univ_tvs
+                           , psExTyVars = ex_tvs, psArgs = arg_tys })
+                 inst_tys
   = ASSERT2( length tyvars == length inst_tys
-          , ptext (sLit "patSynInstArgTys") <+> ppr ps $$ ppr tyvars $$ ppr inst_tys )
+          , ptext (sLit "patSynInstArgTys") <+> ppr name $$ ppr tyvars $$ ppr inst_tys )
     map (substTyWith tyvars inst_tys) arg_tys
   where
-    (univ_tvs, ex_tvs, _) = patSynSig ps
-    arg_tys = map varType (psArgs ps)
     tyvars = univ_tvs ++ ex_tvs
+
+patSynInstResTy :: PatSyn -> [Type] -> Type
+-- Return the type of whole pattern
+-- E.g.  pattern P x y = Just (x,x,y)
+--         P :: a -> b -> Just (a,a,b)
+--         (patSynInstResTy P [Int,Bool] = Maybe (Int,Int,Bool)
+-- NB: unlikepatSynInstArgTys, the inst_tys should be just the *universal* tyvars
+patSynInstResTy (MkPatSyn { psName = name, psUnivTyVars = univ_tvs
+                          , psOrigResTy = res_ty })
+                inst_tys
+  = ASSERT2( length univ_tvs == length inst_tys
+           , ptext (sLit "patSynInstResTy") <+> ppr name $$ ppr univ_tvs $$ ppr inst_tys )
+    substTyWith univ_tvs inst_tys res_ty
 \end{code}
diff --git a/compiler/basicTypes/RdrName.lhs b/compiler/basicTypes/RdrName.lhs
index 4ffeae0d7736..d4afaf10fc04 100644
--- a/compiler/basicTypes/RdrName.lhs
+++ b/compiler/basicTypes/RdrName.lhs
@@ -4,7 +4,7 @@
 %
 
 \begin{code}
-{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE CPP, DeriveDataTypeable #-}
 
 -- |
 -- #name_types#
@@ -331,49 +331,71 @@ instance Ord RdrName where
 -- It is keyed by OccName, because we never use it for qualified names
 -- We keep the current mapping, *and* the set of all Names in scope
 -- Reason: see Note [Splicing Exact Names] in RnEnv
-type LocalRdrEnv = (OccEnv Name, NameSet)
+data LocalRdrEnv = LRE { lre_env      :: OccEnv Name
+                       , lre_in_scope :: NameSet }
+
+instance Outputable LocalRdrEnv where
+  ppr (LRE {lre_env = env, lre_in_scope = ns})
+    = hang (ptext (sLit "LocalRdrEnv {"))
+         2 (vcat [ ptext (sLit "env =") <+> pprOccEnv ppr_elt env
+                 , ptext (sLit "in_scope =") <+> braces (pprWithCommas ppr (nameSetToList ns))
+                 ] <+> char '}')
+    where
+      ppr_elt name = parens (ppr (getUnique (nameOccName name))) <+> ppr name
+                     -- So we can see if the keys line up correctly
 
 emptyLocalRdrEnv :: LocalRdrEnv
-emptyLocalRdrEnv = (emptyOccEnv, emptyNameSet)
+emptyLocalRdrEnv = LRE { lre_env = emptyOccEnv, lre_in_scope = emptyNameSet }
 
 extendLocalRdrEnv :: LocalRdrEnv -> Name -> LocalRdrEnv
 -- The Name should be a non-top-level thing
-extendLocalRdrEnv (env, ns) name
+extendLocalRdrEnv (LRE { lre_env = env, lre_in_scope = ns }) name
   = WARN( isExternalName name, ppr name )
-    ( extendOccEnv env (nameOccName name) name
-    , addOneToNameSet ns name
-    )
+    LRE { lre_env      = extendOccEnv env (nameOccName name) name
+        , lre_in_scope = addOneToNameSet ns name }
 
 extendLocalRdrEnvList :: LocalRdrEnv -> [Name] -> LocalRdrEnv
-extendLocalRdrEnvList (env, ns) names
+extendLocalRdrEnvList (LRE { lre_env = env, lre_in_scope = ns }) names
   = WARN( any isExternalName names, ppr names )
-    ( extendOccEnvList env [(nameOccName n, n) | n <- names]
-    , addListToNameSet ns names
-    )
+    LRE { lre_env = extendOccEnvList env [(nameOccName n, n) | n <- names]
+        , lre_in_scope = addListToNameSet ns names }
 
 lookupLocalRdrEnv :: LocalRdrEnv -> RdrName -> Maybe Name
-lookupLocalRdrEnv (env, _) (Unqual occ) = lookupOccEnv env occ
-lookupLocalRdrEnv _        _            = Nothing
+lookupLocalRdrEnv (LRE { lre_env = env }) (Unqual occ) = lookupOccEnv env occ
+lookupLocalRdrEnv _                       _            = Nothing
 
 lookupLocalRdrOcc :: LocalRdrEnv -> OccName -> Maybe Name
-lookupLocalRdrOcc (env, _) occ = lookupOccEnv env occ
+lookupLocalRdrOcc (LRE { lre_env = env }) occ = lookupOccEnv env occ
 
 elemLocalRdrEnv :: RdrName -> LocalRdrEnv -> Bool
-elemLocalRdrEnv rdr_name (env, _)
-  | isUnqual rdr_name = rdrNameOcc rdr_name `elemOccEnv` env
-  | otherwise         = False
+elemLocalRdrEnv rdr_name (LRE { lre_env = env, lre_in_scope = ns })
+  = case rdr_name of
+      Unqual occ -> occ  `elemOccEnv` env
+      Exact name -> name `elemNameSet` ns  -- See Note [Local bindings with Exact Names]
+      Qual {} -> False
+      Orig {} -> False
 
 localRdrEnvElts :: LocalRdrEnv -> [Name]
-localRdrEnvElts (env, _) = occEnvElts env
+localRdrEnvElts (LRE { lre_env = env }) = occEnvElts env
 
 inLocalRdrEnvScope :: Name -> LocalRdrEnv -> Bool
 -- This is the point of the NameSet
-inLocalRdrEnvScope name (_, ns) = name `elemNameSet` ns
+inLocalRdrEnvScope name (LRE { lre_in_scope = ns }) = name `elemNameSet` ns
 
 delLocalRdrEnvList :: LocalRdrEnv -> [OccName] -> LocalRdrEnv
-delLocalRdrEnvList (env, ns) occs = (delListFromOccEnv env occs, ns)
+delLocalRdrEnvList (LRE { lre_env = env, lre_in_scope = ns }) occs 
+  = LRE { lre_env = delListFromOccEnv env occs
+        , lre_in_scope = ns }
 \end{code}
 
+Note [Local bindings with Exact Names]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+With Template Haskell we can make local bindings that have Exact Names.
+Computing shadowing etc may use elemLocalRdrEnv (at least it certainly
+does so in RnTpes.bindHsTyVars), so for an Exact Name we must consult
+the in-scope-name-set.
+
+
 %************************************************************************
 %*                                                                      *
                         GlobalRdrEnv
@@ -586,7 +608,7 @@ pickGREs rdr_name gres
   = ASSERT2( isSrcRdrName rdr_name, ppr rdr_name )
     candidates
   where
-    candidates = mapCatMaybes pick gres
+    candidates = mapMaybe pick gres
     internal_candidates = filter (isInternalName . gre_name) candidates
 
     rdr_is_unqual = isUnqual rdr_name
@@ -700,7 +722,7 @@ shadow_name env name
   = alterOccEnv (fmap alter_fn) env (nameOccName name)
   where
     alter_fn :: [GlobalRdrElt] -> [GlobalRdrElt]
-    alter_fn gres = mapCatMaybes (shadow_with name) gres
+    alter_fn gres = mapMaybe (shadow_with name) gres
 
     shadow_with :: Name -> GlobalRdrElt -> Maybe GlobalRdrElt
     shadow_with new_name old_gre@(GRE { gre_name = old_name, gre_prov = LocalDef })
@@ -719,7 +741,7 @@ shadow_name env name
        | null imp_specs' = Nothing
        | otherwise       = Just (old_gre { gre_prov = Imported imp_specs' })
        where
-         imp_specs' = mapCatMaybes (shadow_is new_name) imp_specs
+         imp_specs' = mapMaybe (shadow_is new_name) imp_specs
 
     shadow_is :: Name -> ImportSpec -> Maybe ImportSpec
     shadow_is new_name is@(ImpSpec { is_decl = id_spec })
@@ -795,7 +817,7 @@ data ImpDeclSpec
                                    -- the defining module for this thing!
 
                                    -- TODO: either should be Module, or there
-                                   -- should be a Maybe PackageId here too.
+                                   -- should be a Maybe PackageKey here too.
         is_as       :: ModuleName, -- ^ Import alias, e.g. from @as M@ (or @Muggle@ if there is no @as@ clause)
         is_qual     :: Bool,       -- ^ Was this import qualified?
         is_dloc     :: SrcSpan     -- ^ The location of the entire import declaration
diff --git a/compiler/basicTypes/SrcLoc.lhs b/compiler/basicTypes/SrcLoc.lhs
index d53ac2b0eacc..006bce9a31e1 100644
--- a/compiler/basicTypes/SrcLoc.lhs
+++ b/compiler/basicTypes/SrcLoc.lhs
@@ -3,6 +3,7 @@
 %
 
 \begin{code}
+{-# LANGUAGE DeriveDataTypeable #-}
 {-# OPTIONS_GHC -fno-omit-interface-pragmas #-}
    -- Workaround for Trac #5252 crashes the bootstrap compiler without -O
    -- When the earliest compiler we want to boostrap with is
@@ -45,7 +46,7 @@ module SrcLoc (
         srcSpanStart, srcSpanEnd,
         realSrcSpanStart, realSrcSpanEnd,
         srcSpanFileName_maybe,
-        showUserSpan,
+        showUserSpan, showUserRealSpan,
 
         -- ** Unsafely deconstructing SrcSpan
         -- These are dubious exports, because they crash on some inputs
@@ -55,6 +56,8 @@ module SrcLoc (
 
         -- ** Predicates on SrcSpan
         isGoodSrcSpan, isOneLineSpan,
+        containsSpan,
+        isDumpSrcSpan,
 
         -- * Located
         Located,
@@ -263,8 +266,8 @@ data SrcSpan =
   | UnhelpfulSpan !FastString   -- Just a general indication
                                 -- also used to indicate an empty span
 
-  deriving (Eq, Typeable, Show) -- Show is used by Lexer.x, because we
-                                -- derive Show for Token
+  deriving (Eq, Ord, Typeable, Show) -- Show is used by Lexer.x, because we
+                                     -- derive Show for Token
 
 -- | Built-in "bad" 'SrcSpan's for common sources of location uncertainty
 noSrcSpan, wiredInSrcSpan :: SrcSpan
@@ -347,6 +350,20 @@ isOneLineSpan :: SrcSpan -> Bool
 isOneLineSpan (RealSrcSpan s) = srcSpanStartLine s == srcSpanEndLine s
 isOneLineSpan (UnhelpfulSpan _) = False
 
+-- | Tests whether the first span "contains" the other span, meaning
+-- that it covers at least as much source code. True if the spans are eqal.
+containsSpan :: RealSrcSpan -> RealSrcSpan -> Bool
+containsSpan s1 s2
+  = srcSpanFile s1 == srcSpanFile s2
+    && (srcSpanStartLine s1, srcSpanStartCol s1)
+       <= (srcSpanStartLine s2, srcSpanStartCol s2)
+    && (srcSpanEndLine s1, srcSpanEndCol s1)
+       >= (srcSpanEndLine s2, srcSpanEndCol s2)
+
+-- | Tests whether the source span refers to a generated dump file
+isDumpSrcSpan :: RealSrcSpan -> Bool
+isDumpSrcSpan = isPrefixOf ".dump" . takeExtension . unpackFS . srcSpanFile
+
 \end{code}
 
 %************************************************************************
@@ -423,12 +440,11 @@ srcSpanFileName_maybe (UnhelpfulSpan _) = Nothing
 
 \begin{code}
 
--- We want to order SrcSpans first by the start point, then by the end point.
-instance Ord SrcSpan where
+-- We want to order RealSrcSpans first by the start point, then by the end point.
+instance Ord RealSrcSpan where
   a `compare` b =
-     (srcSpanStart a `compare` srcSpanStart b) `thenCmp`
-     (srcSpanEnd   a `compare` srcSpanEnd   b)
-
+     (realSrcSpanStart a `compare` realSrcSpanStart b) `thenCmp`
+     (realSrcSpanEnd   a `compare` realSrcSpanEnd   b)
 
 instance Outputable RealSrcSpan where
     ppr span
diff --git a/compiler/basicTypes/UniqSupply.lhs b/compiler/basicTypes/UniqSupply.lhs
index fea1489efbd7..6ceee2079398 100644
--- a/compiler/basicTypes/UniqSupply.lhs
+++ b/compiler/basicTypes/UniqSupply.lhs
@@ -4,6 +4,8 @@
 %
 
 \begin{code}
+{-# LANGUAGE UnboxedTuples #-}
+
 module UniqSupply (
         -- * Main data type
         UniqSupply, -- Abstractly
diff --git a/compiler/basicTypes/Unique.lhs b/compiler/basicTypes/Unique.lhs
index 037aed06419c..897b093e3923 100644
--- a/compiler/basicTypes/Unique.lhs
+++ b/compiler/basicTypes/Unique.lhs
@@ -16,7 +16,7 @@ Some of the other hair in this code is to be able to use a
 Haskell).
 
 \begin{code}
-{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE CPP, BangPatterns, MagicHash #-}
 
 module Unique (
         -- * Main data types
diff --git a/compiler/basicTypes/Var.lhs b/compiler/basicTypes/Var.lhs
index 70c5d4491a6a..1f20d4adeccc 100644
--- a/compiler/basicTypes/Var.lhs
+++ b/compiler/basicTypes/Var.lhs
@@ -5,7 +5,8 @@
 \section{@Vars@: Variables}
 
 \begin{code}
-{-# OPTIONS -fno-warn-tabs #-}
+{-# LANGUAGE CPP, DeriveDataTypeable #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
 -- The above warning supression flag is a temporary kludge.
 -- While working on this module you are encouraged to remove it and
 -- detab the module (please do the detabbing in a separate patch). See
diff --git a/compiler/basicTypes/VarSet.lhs b/compiler/basicTypes/VarSet.lhs
index b756283b91eb..8b7f755dcd4b 100644
--- a/compiler/basicTypes/VarSet.lhs
+++ b/compiler/basicTypes/VarSet.lhs
@@ -4,7 +4,8 @@
 %
 
 \begin{code}
-{-# OPTIONS -fno-warn-tabs #-}
+{-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
 -- The above warning supression flag is a temporary kludge.
 -- While working on this module you are encouraged to remove it and
 -- detab the module (please do the detabbing in a separate patch). See
diff --git a/compiler/cmm/Bitmap.hs b/compiler/cmm/Bitmap.hs
index 54db1a9a673b..e7aa07206359 100644
--- a/compiler/cmm/Bitmap.hs
+++ b/compiler/cmm/Bitmap.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE CPP #-}
+
 --
 -- (c) The University of Glasgow 2003-2006
 --
diff --git a/compiler/cmm/BlockId.hs b/compiler/cmm/BlockId.hs
index 8a46aed8f0f6..e4cc0bccb741 100644
--- a/compiler/cmm/BlockId.hs
+++ b/compiler/cmm/BlockId.hs
@@ -1,5 +1,7 @@
-{- BlockId module should probably go away completely, being superseded by Label -}
+{-# LANGUAGE TypeSynonymInstances #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
+
+{- BlockId module should probably go away completely, being superseded by Label -}
 module BlockId
   ( BlockId, mkBlockId -- ToDo: BlockId should be abstract, but it isn't yet
   , BlockSet, BlockEnv
diff --git a/compiler/cmm/CLabel.hs b/compiler/cmm/CLabel.hs
index 1b86f3d6b41c..8ce82d25583b 100644
--- a/compiler/cmm/CLabel.hs
+++ b/compiler/cmm/CLabel.hs
@@ -44,6 +44,8 @@ module CLabel (
         mkStringLitLabel,
 
         mkAsmTempLabel,
+        mkAsmTempDerivedLabel,
+        mkAsmTempEndLabel,
 
         mkPlainModuleInitLabel,
 
@@ -54,8 +56,13 @@ module CLabel (
         mkIndStaticInfoLabel,
         mkMainCapabilityLabel,
         mkMAP_FROZEN_infoLabel,
+        mkMAP_FROZEN0_infoLabel,
         mkMAP_DIRTY_infoLabel,
+        mkSMAP_FROZEN_infoLabel,
+        mkSMAP_FROZEN0_infoLabel,
+        mkSMAP_DIRTY_infoLabel,
         mkEMPTY_MVAR_infoLabel,
+        mkArrWords_infoLabel,
 
         mkTopTickyCtrLabel,
         mkCAFBlackHoleInfoTableLabel,
@@ -94,7 +101,7 @@ module CLabel (
         mkHpcTicksLabel,
 
         hasCAF,
-        needsCDecl, isAsmTemp, maybeAsmTemp, externallyVisibleCLabel,
+        needsCDecl, maybeAsmTemp, externallyVisibleCLabel,
         isMathFun,
         isCFunctionLabel, isGcPtrLabel, labelDynamic,
 
@@ -118,6 +125,7 @@ import FastString
 import DynFlags
 import Platform
 import UniqSet
+import PprCore ( {- instances -} )
 
 -- -----------------------------------------------------------------------------
 -- The CLabel type
@@ -153,14 +161,14 @@ data CLabel
 
   -- | A label from a .cmm file that is not associated with a .hs level Id.
   | CmmLabel
-        PackageId               -- what package the label belongs to.
+        PackageKey               -- what package the label belongs to.
         FastString              -- identifier giving the prefix of the label
         CmmLabelInfo            -- encodes the suffix of the label
 
   -- | A label with a baked-in \/ algorithmically generated name that definitely
   --    comes from the RTS. The code for it must compile into libHSrts.a \/ libHSrts.so
   --    If it doesn't have an algorithmically generated name then use a CmmLabel
-  --    instead and give it an appropriate PackageId argument.
+  --    instead and give it an appropriate PackageKey argument.
   | RtsLabel
         RtsLabelInfo
 
@@ -185,6 +193,10 @@ data CLabel
   | AsmTempLabel
         {-# UNPACK #-} !Unique
 
+  | AsmTempDerivedLabel
+        CLabel
+        FastString              -- suffix
+
   | StringLitLabel
         {-# UNPACK #-} !Unique
 
@@ -232,7 +244,7 @@ data CLabel
 data ForeignLabelSource
 
    -- | Label is in a named package
-   = ForeignLabelInPackage      PackageId
+   = ForeignLabelInPackage      PackageKey
 
    -- | Label is in some external, system package that doesn't also
    --   contain compiled Haskell code, and is not associated with any .hi files.
@@ -400,26 +412,33 @@ mkStaticConEntryLabel name  c     = IdLabel name c StaticConEntry
 -- Constructing Cmm Labels
 mkDirty_MUT_VAR_Label, mkSplitMarkerLabel, mkUpdInfoLabel,
     mkBHUpdInfoLabel, mkIndStaticInfoLabel, mkMainCapabilityLabel,
-    mkMAP_FROZEN_infoLabel, mkMAP_DIRTY_infoLabel,
+    mkMAP_FROZEN_infoLabel, mkMAP_FROZEN0_infoLabel, mkMAP_DIRTY_infoLabel,
     mkEMPTY_MVAR_infoLabel, mkTopTickyCtrLabel,
-    mkCAFBlackHoleInfoTableLabel, mkCAFBlackHoleEntryLabel :: CLabel
+    mkCAFBlackHoleInfoTableLabel, mkCAFBlackHoleEntryLabel,
+    mkArrWords_infoLabel, mkSMAP_FROZEN_infoLabel, mkSMAP_FROZEN0_infoLabel,
+    mkSMAP_DIRTY_infoLabel :: CLabel
 mkDirty_MUT_VAR_Label           = mkForeignLabel (fsLit "dirty_MUT_VAR") Nothing ForeignLabelInExternalPackage IsFunction
-mkSplitMarkerLabel              = CmmLabel rtsPackageId (fsLit "__stg_split_marker")    CmmCode
-mkUpdInfoLabel                  = CmmLabel rtsPackageId (fsLit "stg_upd_frame")         CmmInfo
-mkBHUpdInfoLabel                = CmmLabel rtsPackageId (fsLit "stg_bh_upd_frame" )     CmmInfo
-mkIndStaticInfoLabel            = CmmLabel rtsPackageId (fsLit "stg_IND_STATIC")        CmmInfo
-mkMainCapabilityLabel           = CmmLabel rtsPackageId (fsLit "MainCapability")        CmmData
-mkMAP_FROZEN_infoLabel          = CmmLabel rtsPackageId (fsLit "stg_MUT_ARR_PTRS_FROZEN0") CmmInfo
-mkMAP_DIRTY_infoLabel           = CmmLabel rtsPackageId (fsLit "stg_MUT_ARR_PTRS_DIRTY") CmmInfo
-mkEMPTY_MVAR_infoLabel          = CmmLabel rtsPackageId (fsLit "stg_EMPTY_MVAR")        CmmInfo
-mkTopTickyCtrLabel              = CmmLabel rtsPackageId (fsLit "top_ct")                CmmData
-mkCAFBlackHoleInfoTableLabel    = CmmLabel rtsPackageId (fsLit "stg_CAF_BLACKHOLE")     CmmInfo
-mkCAFBlackHoleEntryLabel        = CmmLabel rtsPackageId (fsLit "stg_CAF_BLACKHOLE")     CmmEntry
+mkSplitMarkerLabel              = CmmLabel rtsPackageKey (fsLit "__stg_split_marker")    CmmCode
+mkUpdInfoLabel                  = CmmLabel rtsPackageKey (fsLit "stg_upd_frame")         CmmInfo
+mkBHUpdInfoLabel                = CmmLabel rtsPackageKey (fsLit "stg_bh_upd_frame" )     CmmInfo
+mkIndStaticInfoLabel            = CmmLabel rtsPackageKey (fsLit "stg_IND_STATIC")        CmmInfo
+mkMainCapabilityLabel           = CmmLabel rtsPackageKey (fsLit "MainCapability")        CmmData
+mkMAP_FROZEN_infoLabel          = CmmLabel rtsPackageKey (fsLit "stg_MUT_ARR_PTRS_FROZEN") CmmInfo
+mkMAP_FROZEN0_infoLabel         = CmmLabel rtsPackageKey (fsLit "stg_MUT_ARR_PTRS_FROZEN0") CmmInfo
+mkMAP_DIRTY_infoLabel           = CmmLabel rtsPackageKey (fsLit "stg_MUT_ARR_PTRS_DIRTY") CmmInfo
+mkEMPTY_MVAR_infoLabel          = CmmLabel rtsPackageKey (fsLit "stg_EMPTY_MVAR")        CmmInfo
+mkTopTickyCtrLabel              = CmmLabel rtsPackageKey (fsLit "top_ct")                CmmData
+mkCAFBlackHoleInfoTableLabel    = CmmLabel rtsPackageKey (fsLit "stg_CAF_BLACKHOLE")     CmmInfo
+mkCAFBlackHoleEntryLabel        = CmmLabel rtsPackageKey (fsLit "stg_CAF_BLACKHOLE")     CmmEntry
+mkArrWords_infoLabel            = CmmLabel rtsPackageKey (fsLit "stg_ARR_WORDS")         CmmInfo
+mkSMAP_FROZEN_infoLabel         = CmmLabel rtsPackageKey (fsLit "stg_SMALL_MUT_ARR_PTRS_FROZEN") CmmInfo
+mkSMAP_FROZEN0_infoLabel        = CmmLabel rtsPackageKey (fsLit "stg_SMALL_MUT_ARR_PTRS_FROZEN0") CmmInfo
+mkSMAP_DIRTY_infoLabel          = CmmLabel rtsPackageKey (fsLit "stg_SMALL_MUT_ARR_PTRS_DIRTY") CmmInfo
 
 -----
 mkCmmInfoLabel,   mkCmmEntryLabel, mkCmmRetInfoLabel, mkCmmRetLabel,
   mkCmmCodeLabel, mkCmmDataLabel,  mkCmmClosureLabel
-        :: PackageId -> FastString -> CLabel
+        :: PackageKey -> FastString -> CLabel
 
 mkCmmInfoLabel      pkg str     = CmmLabel pkg str CmmInfo
 mkCmmEntryLabel     pkg str     = CmmLabel pkg str CmmEntry
@@ -535,6 +554,11 @@ mkStringLitLabel                = StringLitLabel
 mkAsmTempLabel :: Uniquable a => a -> CLabel
 mkAsmTempLabel a                = AsmTempLabel (getUnique a)
 
+mkAsmTempDerivedLabel :: CLabel -> FastString -> CLabel
+mkAsmTempDerivedLabel = AsmTempDerivedLabel
+
+mkAsmTempEndLabel :: CLabel -> CLabel
+mkAsmTempEndLabel l = mkAsmTempDerivedLabel l (fsLit "_end")
 mkPlainModuleInitLabel :: Module -> CLabel
 mkPlainModuleInitLabel mod      = PlainModuleInitLabel mod
 
@@ -622,12 +646,13 @@ needsCDecl (PlainModuleInitLabel _)     = True
 
 needsCDecl (StringLitLabel _)           = False
 needsCDecl (AsmTempLabel _)             = False
+needsCDecl (AsmTempDerivedLabel _ _)    = False
 needsCDecl (RtsLabel _)                 = False
 
 needsCDecl (CmmLabel pkgId _ _)
         -- Prototypes for labels defined in the runtime system are imported
         --      into HC files via includes/Stg.h.
-        | pkgId == rtsPackageId         = False
+        | pkgId == rtsPackageKey         = False
 
         -- For other labels we inline one into the HC file directly.
         | otherwise                     = True
@@ -640,12 +665,6 @@ needsCDecl (DynamicLinkerLabel {})      = panic "needsCDecl DynamicLinkerLabel"
 needsCDecl PicBaseLabel                 = panic "needsCDecl PicBaseLabel"
 needsCDecl (DeadStripPreventer {})      = panic "needsCDecl DeadStripPreventer"
 
--- | Check whether a label is a local temporary for native code generation
-isAsmTemp  :: CLabel -> Bool
-isAsmTemp (AsmTempLabel _)              = True
-isAsmTemp _                             = False
-
-
 -- | If a label is a local temporary used for native code generation
 --      then return just its unique, otherwise nothing.
 maybeAsmTemp :: CLabel -> Maybe Unique
@@ -751,6 +770,7 @@ externallyVisibleCLabel :: CLabel -> Bool -- not C "static"
 externallyVisibleCLabel (CaseLabel _ _)         = False
 externallyVisibleCLabel (StringLitLabel _)      = False
 externallyVisibleCLabel (AsmTempLabel _)        = False
+externallyVisibleCLabel (AsmTempDerivedLabel _ _)= False
 externallyVisibleCLabel (PlainModuleInitLabel _)= True
 externallyVisibleCLabel (RtsLabel _)            = True
 externallyVisibleCLabel (CmmLabel _ _ _)        = True
@@ -837,11 +857,11 @@ idInfoLabelType info =
 -- @labelDynamic@ returns @True@ if the label is located
 -- in a DLL, be it a data reference or not.
 
-labelDynamic :: DynFlags -> PackageId -> Module -> CLabel -> Bool
+labelDynamic :: DynFlags -> PackageKey -> Module -> CLabel -> Bool
 labelDynamic dflags this_pkg this_mod lbl =
   case lbl of
    -- is the RTS in a DLL or not?
-   RtsLabel _           -> not (gopt Opt_Static dflags) && (this_pkg /= rtsPackageId)
+   RtsLabel _           -> not (gopt Opt_Static dflags) && (this_pkg /= rtsPackageKey)
 
    IdLabel n _ _        -> isDllName dflags this_pkg this_mod n
 
@@ -874,7 +894,9 @@ labelDynamic dflags this_pkg this_mod lbl =
             -- libraries
             True
 
-   PlainModuleInitLabel m -> not (gopt Opt_Static dflags) && this_pkg /= (modulePackageId m)
+   PlainModuleInitLabel m -> not (gopt Opt_Static dflags) && this_pkg /= (modulePackageKey m)
+
+   HpcTicksLabel m        -> not (gopt Opt_Static dflags) && this_pkg /= (modulePackageKey m)
 
    -- Note that DynamicLinkerLabels do NOT require dynamic linking themselves.
    _                 -> False
@@ -967,6 +989,13 @@ pprCLabel platform (AsmTempLabel u)
      else
         char '_' <> pprUnique u
 
+pprCLabel platform (AsmTempDerivedLabel l suf)
+ | cGhcWithNativeCodeGen == "YES"
+   = ptext (asmTempLabelPrefix platform)
+     <> case l of AsmTempLabel u -> pprUnique u
+                  _other         -> pprCLabel platform l
+     <> ftext suf
+
 pprCLabel platform (DynamicLinkerLabel info lbl)
  | cGhcWithNativeCodeGen == "YES"
    = pprDynamicLinkerAsmLabel platform info lbl
@@ -1092,6 +1121,7 @@ pprCLbl (HpcTicksLabel mod)
   = ptext (sLit "_hpc_tickboxes_")  <> ppr mod <> ptext (sLit "_hpc")
 
 pprCLbl (AsmTempLabel {})       = panic "pprCLbl AsmTempLabel"
+pprCLbl (AsmTempDerivedLabel {})= panic "pprCLbl AsmTempDerivedLabel"
 pprCLbl (DynamicLinkerLabel {}) = panic "pprCLbl DynamicLinkerLabel"
 pprCLbl (PicBaseLabel {})       = panic "pprCLbl PicBaseLabel"
 pprCLbl (DeadStripPreventer {}) = panic "pprCLbl DeadStripPreventer"
diff --git a/compiler/cmm/Cmm.hs b/compiler/cmm/Cmm.hs
index fadce0b5eb2b..9e9bae93c6aa 100644
--- a/compiler/cmm/Cmm.hs
+++ b/compiler/cmm/Cmm.hs
@@ -1,5 +1,5 @@
 -- Cmm representations using Hoopl's Graph CmmNode e x.
-{-# LANGUAGE GADTs #-}
+{-# LANGUAGE CPP, GADTs #-}
 
 module Cmm (
      -- * Cmm top-level datatypes
@@ -80,10 +80,7 @@ data GenCmmDecl d h g
                        -- registers will be correct in generated C-- code, but
                        -- not in hand-written C-- code. However,
                        -- splitAtProcPoints calculates correct liveness
-                       -- information for CmmProc's. Right now only the LLVM
-                       -- back-end relies on correct liveness information and
-                       -- for that back-end we always call splitAtProcPoints, so
-                       -- all is good.
+                       -- information for CmmProcs.
      g                 -- Control-flow graph for the procedure's code
 
   | CmmData     -- Static data
diff --git a/compiler/cmm/CmmBuildInfoTables.hs b/compiler/cmm/CmmBuildInfoTables.hs
index 04c3b71494d7..6521a84006f0 100644
--- a/compiler/cmm/CmmBuildInfoTables.hs
+++ b/compiler/cmm/CmmBuildInfoTables.hs
@@ -1,10 +1,6 @@
-{-# LANGUAGE GADTs, NoMonoLocalBinds #-}
+{-# LANGUAGE CPP, GADTs #-}
 
--- Norman likes local bindings
--- If this module lives on I'd like to get rid of the NoMonoLocalBinds
--- extension in due course
-
--- Todo: remove -fno-warn-warnings-deprecations
+-- See Note [Deprecations in Hoopl] in Hoopl module
 {-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}
 module CmmBuildInfoTables
     ( CAFSet, CAFEnv, cafAnal
@@ -290,7 +286,7 @@ bundle :: Map CLabel CAFSet
        -> (CAFEnv, CmmDecl)
        -> (CAFSet, Maybe CLabel)
        -> (BlockEnv CAFSet, CmmDecl)
-bundle flatmap (env, decl@(CmmProc infos lbl _ g)) (closure_cafs, mb_lbl)
+bundle flatmap (env, decl@(CmmProc infos _lbl _ g)) (closure_cafs, mb_lbl)
   = ( mapMapWithKey get_cafs (info_tbls infos), decl )
  where
   entry = g_entry g
@@ -301,9 +297,13 @@ bundle flatmap (env, decl@(CmmProc infos lbl _ g)) (closure_cafs, mb_lbl)
 
   get_cafs l _
     | l == entry = entry_cafs
-    | otherwise  = if not (mapMember l env)
-                      then pprPanic "bundle" (ppr l <+> ppr lbl <+> ppr (info_tbls infos) $$ ppr env $$ ppr decl)
-                      else flatten flatmap $ expectJust "bundle" $ mapLookup l env
+    | Just info <- mapLookup l env = flatten flatmap info
+    | otherwise  = Set.empty
+    -- the label might not be in the env if the code corresponding to
+    -- this info table was optimised away (perhaps because it was
+    -- unreachable).  In this case it doesn't matter what SRT we
+    -- infer, since the info table will not appear in the generated
+    -- code.  See #9329.
 
 bundle _flatmap (_, decl) _
   = ( mapEmpty, decl )
diff --git a/compiler/cmm/CmmCallConv.hs b/compiler/cmm/CmmCallConv.hs
index 60e2c8c8f73f..f36fc0bae5df 100644
--- a/compiler/cmm/CmmCallConv.hs
+++ b/compiler/cmm/CmmCallConv.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 
 module CmmCallConv (
   ParamLocation(..),
diff --git a/compiler/cmm/CmmCommonBlockElim.hs b/compiler/cmm/CmmCommonBlockElim.hs
index 34e22cecfb8d..b3fbe785558e 100644
--- a/compiler/cmm/CmmCommonBlockElim.hs
+++ b/compiler/cmm/CmmCommonBlockElim.hs
@@ -13,8 +13,10 @@ import Prelude hiding (iterate, succ, unzip, zip)
 
 import Hoopl hiding (ChangeFlag)
 import Data.Bits
+import Data.Maybe (fromMaybe,mapMaybe)
 import qualified Data.List as List
 import Data.Word
+import qualified Data.Map as M
 import Outputable
 import UniqFM
 
@@ -37,7 +39,7 @@ my_trace = if False then pprTrace else \_ _ a -> a
 
 -- TODO: Use optimization fuel
 elimCommonBlocks :: CmmGraph -> CmmGraph
-elimCommonBlocks g = replaceLabels env g
+elimCommonBlocks g = replaceLabels env $ copyTicks env g
   where
      env = iterate hashed_blocks mapEmpty
      hashed_blocks = map (\b -> (hash_block b, b)) $ postorderDfs g
@@ -59,17 +61,13 @@ type HashCode = Int
 common_block :: State -> (HashCode, CmmBlock) -> State
 common_block (old_change, bmap, subst) (hash, b) =
   case lookupUFM bmap hash of
-    Just bs -> case (List.find (eqBlockBodyWith (eqBid subst) b) bs,
-                     mapLookup bid subst) of
-                 (Just b', Nothing)                         -> addSubst b'
-                 (Just b', Just b'') | entryLabel b' /= b'' -> addSubst b'
-                                     | otherwise -> (old_change, bmap, subst)
-                 _ -> (old_change, addToUFM bmap hash (b : bs), subst)
-    Nothing -> (old_change, addToUFM bmap hash [b], subst)
+    Just bs | Just b' <- List.find (eqBlockBodyWith (eqBid subst) b) bs
+            -> if mapLookup bid subst == Just (entryLabel b')
+               then (old_change, bmap, subst)
+               else my_trace "found new common block" (ppr bid <> char '=' <> ppr (entryLabel b')) $
+                    (True, bmap, mapInsert bid (entryLabel b') subst)
+    m_bs    -> (old_change, addToUFM bmap hash (b : fromMaybe [] m_bs), subst)
   where bid = entryLabel b
-        addSubst b' = my_trace "found new common block" (ppr bid <> char '=' <> ppr (entryLabel b')) $
-                      (True, bmap, mapInsert bid (entryLabel b') subst)
-
 
 -- -----------------------------------------------------------------------------
 -- Hashing and equality on blocks
@@ -89,7 +87,8 @@ hash_block block =
         hash_lst m h = hash_node m + h `shiftL` 1
 
         hash_node :: CmmNode O x -> Word32
-        hash_node (CmmComment _) = 0 -- don't care
+        hash_node n | dont_care n = 0 -- don't care
+        hash_node (CmmUnwind _ e) = hash_e e
         hash_node (CmmAssign r e) = hash_reg r + hash_e e
         hash_node (CmmStore e e') = hash_e e + hash_e e'
         hash_node (CmmUnsafeForeignCall t _ as) = hash_tgt t + hash_list hash_e as
@@ -98,6 +97,7 @@ hash_block block =
         hash_node (CmmCall e _ _ _ _ _) = hash_e e
         hash_node (CmmForeignCall t _ _ _ _ _ _) = hash_tgt t
         hash_node (CmmSwitch e _) = hash_e e
+        hash_node _ = error "hash_node: unknown Cmm node!"
 
         hash_reg :: CmmReg -> Word32
         hash_reg   (CmmLocal _) = 117
@@ -127,6 +127,13 @@ hash_block block =
         hash_list f = foldl (\z x -> f x + z) (0::Word32)
 
         cvt = fromInteger . toInteger
+
+-- | Ignore these node types for equality
+dont_care :: CmmNode O x -> Bool
+dont_care CmmComment {}  = True
+dont_care CmmTick {}     = True
+dont_care _other         = False
+
 -- Utilities: equality and substitution on the graph.
 
 -- Given a map ``subst'' from BlockID -> BlockID, we define equality.
@@ -143,7 +150,6 @@ lookupBid subst bid = case mapLookup bid subst of
 --
 eqMiddleWith :: (BlockId -> BlockId -> Bool)
              -> CmmNode O O -> CmmNode O O -> Bool
-eqMiddleWith _ (CmmComment _) (CmmComment _) = True
 eqMiddleWith eqBid (CmmAssign r1 e1) (CmmAssign r2 e2)
   = r1 == r2 && eqExprWith eqBid e1 e2
 eqMiddleWith eqBid (CmmStore l1 r1) (CmmStore l2 r2)
@@ -178,10 +184,12 @@ eqExprWith eqBid = eq
 -- IDs to block IDs.
 eqBlockBodyWith :: (BlockId -> BlockId -> Bool) -> CmmBlock -> CmmBlock -> Bool
 eqBlockBodyWith eqBid block block'
-  = and (zipWith (eqMiddleWith eqBid) (blockToList m) (blockToList m')) &&
+  = and (zipWith (eqMiddleWith eqBid) nodes nodes') &&
     eqLastWith eqBid l l'
   where (_,m,l)   = blockSplit block
+        nodes     = filter (not . dont_care) (blockToList m)
         (_,m',l') = blockSplit block'
+        nodes'    = filter (not . dont_care) (blockToList m')
 
 
 
@@ -202,3 +210,20 @@ eqMaybeWith :: (a -> b -> Bool) -> Maybe a -> Maybe b -> Bool
 eqMaybeWith eltEq (Just e) (Just e') = eltEq e e'
 eqMaybeWith _ Nothing Nothing = True
 eqMaybeWith _ _ _ = False
+
+copyTicks :: BlockEnv BlockId -> CmmGraph -> CmmGraph
+copyTicks env g = ofBlockMap (g_entry g) $ mapMap copyTo blockMap
+  where -- Reverse block merge map
+        blockMap = toBlockMap g
+        revEnv = mapFoldWithKey insertRev M.empty env
+        insertRev k x = M.insertWith (const (k:)) x [k]
+        -- Copy ticks and scopes into the given block
+        copyTo block = case M.lookup (entryLabel block) revEnv of
+          Nothing -> block
+          Just ls -> foldr copy block $ mapMaybe (flip mapLookup blockMap) ls
+        copy from to =
+          let ticks = blockTicks from
+              CmmEntry  _   scp0        = firstNode from
+              (CmmEntry lbl scp1, code) = blockSplitHead to
+          in CmmEntry lbl (combineTickScopes scp0 scp1) `blockJoinHead`
+             foldr blockCons code (map CmmTick ticks)
diff --git a/compiler/cmm/CmmContFlowOpt.hs b/compiler/cmm/CmmContFlowOpt.hs
index 52b95a93ccfb..bcb4cf97b336 100644
--- a/compiler/cmm/CmmContFlowOpt.hs
+++ b/compiler/cmm/CmmContFlowOpt.hs
@@ -46,25 +46,20 @@ import Prelude hiding (succ, unzip, zip)
 -- Note [Control-flow optimisations]
 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 --
--- This optimisation does four things:
+-- This optimisation does three things:
 --
 --   - If a block finishes in an unconditonal branch to another block
 --     and that is the only jump to that block we concatenate the
 --     destination block at the end of the current one.
 --
---   - If a block finishes in an unconditional branch, we may be able
---     to shortcut the destination block.
---
 --   - If a block finishes in a call whose continuation block is a
 --     goto, then we can shortcut the destination, making the
 --     continuation block the destination of the goto - but see Note
 --     [Shortcut call returns].
 --
---   - For block finishing in conditional branch we try to invert the
---     condition and shortcut destination of alternatives.
---
 --   - For any block that is not a call we try to shortcut the
---     destination(s).
+--     destination(s). Additionally, if a block ends with a
+--     conditional branch we try to invert the condition.
 --
 -- Blocks are processed using postorder DFS traversal. A side effect
 -- of determining traversal order with a graph search is elimination
@@ -204,11 +199,8 @@ blockConcat splitting_procs g@CmmGraph { g_entry = entry_id }
         --   (2) remove b' from the map of blocks
         --   (3) remove information about b' from predecessors map
         --
-        -- This guard must be first so that we always eliminate blocks that have
-        -- only one predecessor. If we had a target block that is both
-        -- shorcutable and has only one predecessor and attempted to shortcut it
-        -- first we would make that block unreachable but would not remove it
-        -- from the graph.
+        -- Since we know that the block has only one predecessor we call
+        -- mapDelete directly instead of calling decPreds.
         --
         -- Note that we always maintain an up-to-date list of predecessors, so
         -- we can ignore the contents of shortcut_map
@@ -220,20 +212,6 @@ blockConcat splitting_procs g@CmmGraph { g_entry = entry_id }
              , shortcut_map
              , mapDelete b' backEdges )
 
-        -- If:
-        --   (1) current block ends with unconditional branch to b' and
-        --   (2) we can shortcut block b'
-        -- Then:
-        --   (1) concatenate b' at the end of current block, effectively
-        --       changing target of uncondtional jump from b' to dest
-        --   (2) increase number of predecessors of dest by 1
-        --   (3) decrease number of predecessors of b' by 1
-        | CmmBranch b' <- last
-        , Just blk' <- mapLookup b' blocks
-        , Just dest <- canShortcut blk'
-        = ( mapInsert bid (splice head blk') blocks, shortcut_map,
-            decPreds b' $ incPreds dest backEdges )
-
         -- If:
         --   (1) we are splitting proc points (see Note
         --       [Shortcut call returns and proc-points]) and
@@ -263,7 +241,10 @@ blockConcat splitting_procs g@CmmGraph { g_entry = entry_id }
         --       conditional
         --   (2) attempt to shortcut all destination blocks
         --   (3) if new successors of a block are different from the old ones
-        --       we update the of predecessors accordingly
+        --       update the of predecessors accordingly
+        --
+        -- A special case of this is a situation when a block ends with an
+        -- unconditional jump to a block that can be shortcut.
         | Nothing <- callContinuation_maybe last
         = let oldSuccs = successors last
               newSuccs = successors swapcond_last
@@ -336,18 +317,22 @@ decPreds bid edges = case mapLookup bid edges of
 canShortcut :: CmmBlock -> Maybe BlockId
 canShortcut block
     | (_, middle, CmmBranch dest) <- blockSplit block
-    , isEmptyBlock middle
+    , all dont_care $ blockToList middle
     = Just dest
     | otherwise
     = Nothing
-
+    where dont_care CmmComment{} = True
+          dont_care CmmTick{}    = True
+          dont_care _other       = False
 
 -- Concatenates two blocks. First one is assumed to be open on exit, the second
 -- is assumed to be closed on entry (i.e. it has a label attached to it, which
 -- the splice function removes by calling snd on result of blockSplitHead).
 splice :: Block CmmNode C O -> CmmBlock -> CmmBlock
-splice head rest = head `blockAppend` snd (blockSplitHead rest)
-
+splice head rest = entry `blockJoinHead` code0 `blockAppend` code1
+  where (CmmEntry lbl sc0, code0) = blockSplitHead head
+        (CmmEntry _   sc1, code1) = blockSplitHead rest
+        entry = CmmEntry lbl (combineTickScopes sc0 sc1)
 
 -- If node is a call with continuation call return Just label of that
 -- continuation. Otherwise return Nothing.
@@ -394,14 +379,14 @@ predMap blocks = foldr add_preds mapEmpty blocks
 -- Removing unreachable blocks
 removeUnreachableBlocksProc :: CmmDecl -> CmmDecl
 removeUnreachableBlocksProc proc@(CmmProc info lbl live g)
-   | length used_blocks < mapSize (toBlockMap g) 
-   = CmmProc info' lbl live g' 
+   | length used_blocks < mapSize (toBlockMap g)
+   = CmmProc info' lbl live g'
    | otherwise
    = proc
    where
      g'    = ofBlockList (g_entry g) used_blocks
      info' = info { info_tbls = keep_used (info_tbls info) }
-             -- Remove any info_tbls for unreachable 
+             -- Remove any info_tbls for unreachable
 
      keep_used :: BlockEnv CmmInfoTable -> BlockEnv CmmInfoTable
      keep_used bs = mapFoldWithKey keep emptyBlockMap bs
diff --git a/compiler/cmm/CmmExpr.hs b/compiler/cmm/CmmExpr.hs
index 0c0c9714ecea..1d6c97f41eea 100644
--- a/compiler/cmm/CmmExpr.hs
+++ b/compiler/cmm/CmmExpr.hs
@@ -1,4 +1,7 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE UndecidableInstances #-}
 
 module CmmExpr
diff --git a/compiler/cmm/CmmInfo.hs b/compiler/cmm/CmmInfo.hs
index 42c9e6ba53f4..3bfc728ac07f 100644
--- a/compiler/cmm/CmmInfo.hs
+++ b/compiler/cmm/CmmInfo.hs
@@ -1,10 +1,4 @@
-{-# OPTIONS -fno-warn-tabs #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and
--- detab the module (please do the detabbing in a separate patch). See
---     http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
--- for details
-
+{-# LANGUAGE CPP #-}
 module CmmInfo (
   mkEmptyContInfoTable,
   cmmToRawCmm,
@@ -61,7 +55,7 @@ import Data.Word
 
 -- When we split at proc points, we need an empty info table.
 mkEmptyContInfoTable :: CLabel -> CmmInfoTable
-mkEmptyContInfoTable info_lbl 
+mkEmptyContInfoTable info_lbl
   = CmmInfoTable { cit_lbl  = info_lbl
                  , cit_rep  = mkStackRep []
                  , cit_prof = NoProfilingInfo
@@ -83,31 +77,31 @@ cmmToRawCmm dflags cmms
 -- represented by a label+offset expression).
 --
 -- With tablesNextToCode, the layout is
---	<reversed variable part>
---	<normal forward StgInfoTable, but without 
---		an entry point at the front>
---	<code>
+--      <reversed variable part>
+--      <normal forward StgInfoTable, but without
+--              an entry point at the front>
+--      <code>
 --
 -- Without tablesNextToCode, the layout of an info table is
---	<entry label>
---	<normal forward rest of StgInfoTable>
---	<forward variable part>
+--      <entry label>
+--      <normal forward rest of StgInfoTable>
+--      <forward variable part>
 --
---	See includes/rts/storage/InfoTables.h
+--      See includes/rts/storage/InfoTables.h
 --
 -- For return-points these are as follows
 --
 -- Tables next to code:
 --
---			<srt slot>
---			<standard info table>
---  	ret-addr -->	<entry code (if any)>
+--                      <srt slot>
+--                      <standard info table>
+--      ret-addr -->    <entry code (if any)>
 --
 -- Not tables-next-to-code:
 --
---	ret-addr -->	<ptr to entry code>
---			<standard info table>
---			<srt slot>
+--      ret-addr -->    <ptr to entry code>
+--                      <standard info table>
+--                      <srt slot>
 --
 --  * The SRT slot is only there if there is SRT info to record
 
@@ -167,21 +161,21 @@ mkInfoTable dflags proc@(CmmProc infos entry_lbl live blocks)
                               reverse rel_extra_bits ++ rel_std_info))
 
 -----------------------------------------------------
-type InfoTableContents = ( [CmmLit]	     -- The standard part
-                         , [CmmLit] )	     -- The "extra bits"
+type InfoTableContents = ( [CmmLit]          -- The standard part
+                         , [CmmLit] )        -- The "extra bits"
 -- These Lits have *not* had mkRelativeTo applied to them
 
 mkInfoTableContents :: DynFlags
                     -> CmmInfoTable
                     -> Maybe Int               -- Override default RTS type tag?
                     -> UniqSM ([RawCmmDecl],             -- Auxiliary top decls
-                               InfoTableContents)	-- Info tbl + extra bits
+                               InfoTableContents)       -- Info tbl + extra bits
 
 mkInfoTableContents dflags
                     info@(CmmInfoTable { cit_lbl  = info_lbl
                                        , cit_rep  = smrep
                                        , cit_prof = prof
-                                       , cit_srt = srt }) 
+                                       , cit_srt = srt })
                     mb_rts_tag
   | RTSRep rts_tag rep <- smrep
   = mkInfoTableContents dflags info{cit_rep = rep} (Just rts_tag)
@@ -215,9 +209,9 @@ mkInfoTableContents dflags
   where
     mk_pieces :: ClosureTypeInfo -> [CmmLit]
               -> UniqSM ( Maybe StgHalfWord  -- Override the SRT field with this
-                 	, Maybe CmmLit       -- Override the layout field with this
-                 	, [CmmLit]           -- "Extra bits" for info table
-                 	, [RawCmmDecl])	     -- Auxiliary data decls 
+                        , Maybe CmmLit       -- Override the layout field with this
+                        , [CmmLit]           -- "Extra bits" for info table
+                        , [RawCmmDecl])      -- Auxiliary data decls
     mk_pieces (Constr con_tag con_descr) _no_srt    -- A data constructor
       = do { (descr_lit, decl) <- newStringLit con_descr
            ; return ( Just (toStgHalfWord dflags (fromIntegral con_tag))
@@ -230,7 +224,7 @@ mkInfoTableContents dflags
       = return (Just (toStgHalfWord dflags 0), Just (mkWordCLit dflags (fromIntegral offset)), [], [])
          -- Layout known (one free var); we use the layout field for offset
 
-    mk_pieces (Fun arity (ArgSpec fun_type)) srt_label 
+    mk_pieces (Fun arity (ArgSpec fun_type)) srt_label
       = do { let extra_bits = packIntsCLit dflags fun_type arity : srt_label
            ; return (Nothing, Nothing,  extra_bits, []) }
 
@@ -280,7 +274,7 @@ mkSRTLit dflags (C_SRT lbl off bitmap) = ([cmmLabelOffW dflags lbl off], bitmap)
 
 -------------------------------------------------------------------------
 --
---	Position independent code
+--      Position independent code
 --
 -------------------------------------------------------------------------
 -- In order to support position independent code, we mustn't put absolute
@@ -292,7 +286,7 @@ mkSRTLit dflags (C_SRT lbl off bitmap) = ([cmmLabelOffW dflags lbl off], bitmap)
 -- as we want to keep binary compatibility between PIC and non-PIC.
 
 makeRelativeRefTo :: DynFlags -> CLabel -> CmmLit -> CmmLit
-        
+
 makeRelativeRefTo dflags info_lbl (CmmLabel lbl)
   | tablesNextToCode dflags
   = CmmLabelDiffOff lbl info_lbl 0
@@ -304,16 +298,16 @@ makeRelativeRefTo _ _ lit = lit
 
 -------------------------------------------------------------------------
 --
---		Build a liveness mask for the stack layout
+--              Build a liveness mask for the stack layout
 --
 -------------------------------------------------------------------------
 
 -- There are four kinds of things on the stack:
 --
---	- pointer variables (bound in the environment)
--- 	- non-pointer variables (bound in the environment)
--- 	- free slots (recorded in the stack free list)
--- 	- non-pointer data slots (recorded in the stack free list)
+--      - pointer variables (bound in the environment)
+--      - non-pointer variables (bound in the environment)
+--      - free slots (recorded in the stack free list)
+--      - non-pointer data slots (recorded in the stack free list)
 --
 -- The first two are represented with a 'Just' of a 'LocalReg'.
 -- The last two with one or more 'Nothing' constructors.
@@ -331,7 +325,7 @@ mkLivenessBits dflags liveness
   | n_bits > mAX_SMALL_BITMAP_SIZE dflags -- does not fit in one word
   = do { uniq <- getUniqueUs
        ; let bitmap_lbl = mkBitmapLabel uniq
-       ; return (CmmLabel bitmap_lbl, 
+       ; return (CmmLabel bitmap_lbl,
                  [mkRODataLits bitmap_lbl lits]) }
 
   | otherwise -- Fits in one word
@@ -342,10 +336,10 @@ mkLivenessBits dflags liveness
     bitmap :: Bitmap
     bitmap = mkBitmap dflags liveness
 
-    small_bitmap = case bitmap of 
+    small_bitmap = case bitmap of
                      []  -> toStgWord dflags 0
                      [b] -> b
-		     _   -> panic "mkLiveness"
+                     _   -> panic "mkLiveness"
     bitmap_word = toStgWord dflags (fromIntegral n_bits)
               .|. (small_bitmap `shiftL` bITMAP_BITS_SHIFT dflags)
 
@@ -356,7 +350,7 @@ mkLivenessBits dflags liveness
 
 -------------------------------------------------------------------------
 --
---	Generating a standard info table
+--      Generating a standard info table
 --
 -------------------------------------------------------------------------
 
@@ -369,23 +363,23 @@ mkLivenessBits dflags liveness
 
 mkStdInfoTable
    :: DynFlags
-   -> (CmmLit,CmmLit)	-- Closure type descr and closure descr  (profiling)
+   -> (CmmLit,CmmLit)   -- Closure type descr and closure descr  (profiling)
    -> Int               -- Closure RTS tag
    -> StgHalfWord       -- SRT length
-   -> CmmLit		-- layout field
+   -> CmmLit            -- layout field
    -> [CmmLit]
 
 mkStdInfoTable dflags (type_descr, closure_descr) cl_type srt_len layout_lit
- = 	-- Parallel revertible-black hole field
+ =      -- Parallel revertible-black hole field
     prof_info
-	-- Ticky info (none at present)
-	-- Debug info (none at present)
+        -- Ticky info (none at present)
+        -- Debug info (none at present)
  ++ [layout_lit, type_lit]
 
- where  
-    prof_info 
-	| gopt Opt_SccProfilingOn dflags = [type_descr, closure_descr]
-	| otherwise = []
+ where
+    prof_info
+        | gopt Opt_SccProfilingOn dflags = [type_descr, closure_descr]
+        | otherwise = []
 
     type_lit = packHalfWordsCLit dflags (toStgHalfWord dflags (fromIntegral cl_type)) srt_len
 
@@ -416,7 +410,7 @@ srtEscape dflags = toStgHalfWord dflags (-1)
 
 -------------------------------------------------------------------------
 --
---	Accessing fields of an info table
+--      Accessing fields of an info table
 --
 -------------------------------------------------------------------------
 
@@ -491,7 +485,7 @@ funInfoTable dflags info_ptr
   = cmmOffsetB dflags info_ptr (- stdInfoTableSizeB dflags - sIZEOF_StgFunInfoExtraRev dflags)
   | otherwise
   = cmmOffsetW dflags info_ptr (1 + stdInfoTableSizeW dflags)
-				-- Past the entry code pointer
+                                -- Past the entry code pointer
 
 -- Takes the info pointer of a function, returns the function's arity
 funInfoArity :: DynFlags -> CmmExpr -> CmmExpr
@@ -514,7 +508,7 @@ funInfoArity dflags iptr
 --      Info table sizes & offsets
 --
 -----------------------------------------------------------------------------
-	
+
 stdInfoTableSizeW :: DynFlags -> WordOff
 -- The size of a standard info table varies with profiling/ticky etc,
 -- so we can't get it from Constants
@@ -546,15 +540,14 @@ stdInfoTableSizeB  :: DynFlags -> ByteOff
 stdInfoTableSizeB dflags = stdInfoTableSizeW dflags * wORD_SIZE dflags
 
 stdSrtBitmapOffset :: DynFlags -> ByteOff
--- Byte offset of the SRT bitmap half-word which is 
+-- Byte offset of the SRT bitmap half-word which is
 -- in the *higher-addressed* part of the type_lit
 stdSrtBitmapOffset dflags = stdInfoTableSizeB dflags - hALF_WORD_SIZE dflags
 
 stdClosureTypeOffset :: DynFlags -> ByteOff
--- Byte offset of the closure type half-word 
+-- Byte offset of the closure type half-word
 stdClosureTypeOffset dflags = stdInfoTableSizeB dflags - wORD_SIZE dflags
 
 stdPtrsOffset, stdNonPtrsOffset :: DynFlags -> ByteOff
 stdPtrsOffset    dflags = stdInfoTableSizeB dflags - 2 * wORD_SIZE dflags
 stdNonPtrsOffset dflags = stdInfoTableSizeB dflags - 2 * wORD_SIZE dflags + hALF_WORD_SIZE dflags
-
diff --git a/compiler/cmm/CmmLayoutStack.hs b/compiler/cmm/CmmLayoutStack.hs
index 95483a2f520b..b8be6afc9684 100644
--- a/compiler/cmm/CmmLayoutStack.hs
+++ b/compiler/cmm/CmmLayoutStack.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE RecordWildCards, GADTs #-}
+{-# LANGUAGE CPP, RecordWildCards, GADTs #-}
 module CmmLayoutStack (
        cmmLayoutStack, setInfoTableStackMap
   ) where
@@ -189,16 +189,10 @@ cmmLayoutStack :: DynFlags -> ProcPointSet -> ByteOff -> CmmGraph
 cmmLayoutStack dflags procpoints entry_args
                graph0@(CmmGraph { g_entry = entry })
   = do
-    -- pprTrace "cmmLayoutStack" (ppr entry_args) $ return ()
-
-    -- We need liveness info.  We could do removeDeadAssignments at
-    -- the same time, but it buys nothing over doing cmmSink later,
-    -- and costs a lot more than just cmmLocalLiveness.
-    -- (graph, liveness) <- removeDeadAssignments graph0
+    -- We need liveness info. Dead assignments are removed later
+    -- by the sinking pass.
     let (graph, liveness) = (graph0, cmmLocalLiveness dflags graph0)
-
-    -- pprTrace "liveness" (ppr liveness) $ return ()
-    let blocks = postorderDfs graph
+        blocks = postorderDfs graph
 
     (final_stackmaps, _final_high_sp, new_blocks) <-
           mfix $ \ ~(rec_stackmaps, rec_high_sp, _new_blocks) ->
@@ -206,12 +200,9 @@ cmmLayoutStack dflags procpoints entry_args
                    rec_stackmaps rec_high_sp blocks
 
     new_blocks' <- mapM (lowerSafeForeignCall dflags) new_blocks
-
-    -- pprTrace ("Sp HWM") (ppr _final_high_sp) $ return ()
     return (ofBlockList entry new_blocks', final_stackmaps)
 
 
-
 layout :: DynFlags
        -> BlockSet                      -- proc points
        -> BlockEnv CmmLocalLive         -- liveness
@@ -245,15 +236,13 @@ layout dflags procpoints liveness entry entry_args final_stackmaps final_sp_high
 
     go (b0 : bs) acc_stackmaps acc_hwm acc_blocks
       = do
-       let (entry0@(CmmEntry entry_lbl), middle0, last0) = blockSplit b0
+       let (entry0@(CmmEntry entry_lbl tscope), middle0, last0) = blockSplit b0
 
        let stack0@StackMap { sm_sp = sp0 }
                = mapFindWithDefault
                      (pprPanic "no stack map for" (ppr entry_lbl))
                      entry_lbl acc_stackmaps
 
-       -- pprTrace "layout" (ppr entry_lbl <+> ppr stack0) $ return ()
-
        -- (a) Update the stack map to include the effects of
        --     assignments in this block
        let stack1 = foldBlockNodesF (procMiddle acc_stackmaps) middle0 stack0
@@ -271,9 +260,7 @@ layout dflags procpoints liveness entry entry_args final_stackmaps final_sp_high
        --     details.
        (middle2, sp_off, last1, fixup_blocks, out)
            <- handleLastNode dflags procpoints liveness cont_info
-                             acc_stackmaps stack1 middle0 last0
-
-       -- pprTrace "layout(out)" (ppr out) $ return ()
+                             acc_stackmaps stack1 tscope middle0 last0
 
        -- (d) Manifest Sp: run over the nodes in the block and replace
        --     CmmStackSlot with CmmLoad from Sp with a concrete offset.
@@ -395,7 +382,7 @@ getStackLoc (Young l) n stackmaps =
 
 handleLastNode
    :: DynFlags -> ProcPointSet -> BlockEnv CmmLocalLive -> BlockEnv ByteOff
-   -> BlockEnv StackMap -> StackMap
+   -> BlockEnv StackMap -> StackMap -> [CmmTickScope]
    -> Block CmmNode O O
    -> CmmNode O C
    -> UniqSM
@@ -407,7 +394,7 @@ handleLastNode
       )
 
 handleLastNode dflags procpoints liveness cont_info stackmaps
-               stack0@StackMap { sm_sp = sp0 } middle last
+               stack0@StackMap { sm_sp = sp0 } tscope middle last
  = case last of
     --  At each return / tail call,
     --  adjust Sp to point to the last argument pushed, which
@@ -505,7 +492,7 @@ handleLastNode dflags procpoints liveness cont_info stackmaps
         | Just stack2 <- mapLookup l stackmaps
         = do
              let assigs = fixupStack stack0 stack2
-             (tmp_lbl, block) <- makeFixupBlock dflags sp0 l stack2 assigs
+             (tmp_lbl, block) <- makeFixupBlock dflags sp0 l stack2 tscope assigs
              return (l, tmp_lbl, stack2, block)
 
         --   (b) if the successor is a proc point, save everything
@@ -514,12 +501,9 @@ handleLastNode dflags procpoints liveness cont_info stackmaps
         = do
              let cont_args = mapFindWithDefault 0 l cont_info
                  (stack2, assigs) =
-                      --pprTrace "first visit to proc point"
-                      --             (ppr l <+> ppr stack1) $
                       setupStackFrame dflags l liveness (sm_ret_off stack0)
-                                                       cont_args stack0
-             --
-             (tmp_lbl, block) <- makeFixupBlock dflags sp0 l stack2 assigs
+                                                        cont_args stack0
+             (tmp_lbl, block) <- makeFixupBlock dflags sp0 l stack2 tscope assigs
              return (l, tmp_lbl, stack2, block)
 
         --   (c) otherwise, the current StackMap is the StackMap for
@@ -533,14 +517,14 @@ handleLastNode dflags procpoints liveness cont_info stackmaps
               is_live (r,_) = r `elemRegSet` live
 
 
-makeFixupBlock :: DynFlags -> ByteOff -> Label -> StackMap -> [CmmNode O O]
+makeFixupBlock :: DynFlags -> ByteOff -> Label -> StackMap -> [CmmTickScope] -> [CmmNode O O]
                -> UniqSM (Label, [CmmBlock])
-makeFixupBlock dflags sp0 l stack assigs
+makeFixupBlock dflags sp0 l stack tscope assigs
   | null assigs && sp0 == sm_sp stack = return (l, [])
   | otherwise = do
     tmp_lbl <- liftM mkBlockId $ getUniqueM
     let sp_off = sp0 - sm_sp stack
-        block = blockJoin (CmmEntry tmp_lbl)
+        block = blockJoin (CmmEntry tmp_lbl tscope)
                           (maybeAddSpAdj dflags sp_off (blockFromList assigs))
                           (CmmBranch l)
     return (tmp_lbl, [block])
@@ -682,8 +666,6 @@ allocate :: DynFlags -> ByteOff -> LocalRegSet -> StackMap
 allocate dflags ret_off live stackmap@StackMap{ sm_sp = sp0
                                               , sm_regs = regs0 }
  =
-  -- pprTrace "allocate" (ppr live $$ ppr stackmap) $
-
    -- we only have to save regs that are not already in a slot
    let to_save = filter (not . (`elemUFM` regs0)) (Set.elems live)
        regs1   = filterUFM (\(r,_) -> elemRegSet r live) regs0
@@ -807,8 +789,14 @@ manifestSp dflags stackmaps stack0 sp0 sp_high
     adj_pre_sp  = mapExpDeep (areaToSp dflags sp0            sp_high area_off)
     adj_post_sp = mapExpDeep (areaToSp dflags (sp0 - sp_off) sp_high area_off)
 
+    add_unwind_info | gopt Opt_Debug dflags
+                    = (:) $ CmmUnwind Sp $ CmmRegOff (CmmGlobal Sp) (sp0 - wORD_SIZE dflags)
+                    | otherwise
+                    = id
+
     final_middle = maybeAddSpAdj dflags sp_off $
                    blockFromList $
+                   add_unwind_info $
                    map adj_pre_sp $
                    elimStackStores stack0 stackmaps area_off $
                    middle_pre
@@ -888,7 +876,7 @@ areaToSp _ _ _ _ other = other
 -- really the job of the stack layout algorithm, hence we do it now.
 
 optStackCheck :: CmmNode O C -> CmmNode O C
-optStackCheck n = -- Note [null stack check]
+optStackCheck n = -- Note [Always false stack check]
  case n of
    CmmCondBranch (CmmLit (CmmInt 0 _)) _true false -> CmmBranch false
    other -> other
@@ -923,8 +911,7 @@ elimStackStores stackmap stackmaps area_off nodes
          CmmStore (CmmStackSlot area m) (CmmReg (CmmLocal r))
             | Just (_,off) <- lookupUFM (sm_regs stackmap) r
             , area_off area + m == off
-            -> -- pprTrace "eliminated a node!" (ppr r) $
-               go stackmap ns
+            -> go stackmap ns
          _otherwise
             -> n : go (procMiddle stackmaps n stackmap) ns
 
@@ -1000,7 +987,7 @@ that safe foreign call is replace by an unsafe one in the Cmm graph.
 
 lowerSafeForeignCall :: DynFlags -> CmmBlock -> UniqSM CmmBlock
 lowerSafeForeignCall dflags block
-  | (entry, middle, CmmForeignCall { .. }) <- blockSplit block
+  | (entry@(CmmEntry _ tscope), middle, CmmForeignCall { .. }) <- blockSplit block
   = do
     -- Both 'id' and 'new_base' are KindNonPtr because they're
     -- RTS-only objects and are not subject to garbage collection
@@ -1038,11 +1025,11 @@ lowerSafeForeignCall dflags block
                        , cml_ret_args  = ret_args
                        , cml_ret_off   = ret_off }
 
-    graph' <- lgraphOfAGraph $ suspend <*>
+    graph' <- lgraphOfAGraph ( suspend <*>
                                midCall <*>
                                resume  <*>
                                copyout <*>
-                               mkLast jump
+                               mkLast jump, tscope)
 
     case toBlockList graph' of
       [one] -> let (_, middle', last) = blockSplit one
diff --git a/compiler/cmm/CmmLex.x b/compiler/cmm/CmmLex.x
index bb5b4e3ae5af..d5a8067486b6 100644
--- a/compiler/cmm/CmmLex.x
+++ b/compiler/cmm/CmmLex.x
@@ -44,7 +44,7 @@ $white_no_nl = $whitechar # \n
 $ascdigit  = 0-9
 $unidigit  = \x01 -- Trick Alex into handling Unicode. See alexGetChar.
 $digit     = [$ascdigit $unidigit]
-$octit	   = 0-7
+$octit     = 0-7
 $hexit     = [$digit A-F a-f]
 
 $unilarge  = \x03 -- Trick Alex into handling Unicode. See alexGetChar.
@@ -70,56 +70,56 @@ $namechar  = [$namebegin $digit]
 
 cmm :-
 
-$white_no_nl+		;
+$white_no_nl+           ;
 ^\# pragma .* \n        ; -- Apple GCC 3.3 CPP generates pragmas in its output
 
-^\# (line)? 		{ begin line_prag }
+^\# (line)?             { begin line_prag }
 
 -- single-line line pragmas, of the form
 --    # <line> "<file>" <extra-stuff> \n
-<line_prag> $digit+			{ setLine line_prag1 }
-<line_prag1> \" [^\"]* \"	{ setFile line_prag2 }
-<line_prag2> .*				{ pop }
+<line_prag> $digit+                     { setLine line_prag1 }
+<line_prag1> \" [^\"]* \"       { setFile line_prag2 }
+<line_prag2> .*                         { pop }
 
 <0> {
-  \n			;
-
-  [\:\;\{\}\[\]\(\)\=\`\~\/\*\%\-\+\&\^\|\>\<\,\!]	{ special_char }
-  
-  ".." 			{ kw CmmT_DotDot }
-  "::" 			{ kw CmmT_DoubleColon }
-  ">>"			{ kw CmmT_Shr }
-  "<<"			{ kw CmmT_Shl }
-  ">="			{ kw CmmT_Ge }
-  "<="			{ kw CmmT_Le }
-  "=="			{ kw CmmT_Eq }
-  "!="			{ kw CmmT_Ne }
-  "&&"			{ kw CmmT_BoolAnd }
-  "||"			{ kw CmmT_BoolOr }
-  
-  P@decimal		{ global_regN (\n -> VanillaReg n VGcPtr) }
-  R@decimal		{ global_regN (\n -> VanillaReg n VNonGcPtr) }
-  F@decimal		{ global_regN FloatReg }
-  D@decimal		{ global_regN DoubleReg }
-  L@decimal		{ global_regN LongReg }
-  Sp			{ global_reg Sp }
-  SpLim			{ global_reg SpLim }
-  Hp			{ global_reg Hp }
-  HpLim			{ global_reg HpLim }
+  \n                    ;
+
+  [\:\;\{\}\[\]\(\)\=\`\~\/\*\%\-\+\&\^\|\>\<\,\!]      { special_char }
+
+  ".."                  { kw CmmT_DotDot }
+  "::"                  { kw CmmT_DoubleColon }
+  ">>"                  { kw CmmT_Shr }
+  "<<"                  { kw CmmT_Shl }
+  ">="                  { kw CmmT_Ge }
+  "<="                  { kw CmmT_Le }
+  "=="                  { kw CmmT_Eq }
+  "!="                  { kw CmmT_Ne }
+  "&&"                  { kw CmmT_BoolAnd }
+  "||"                  { kw CmmT_BoolOr }
+
+  P@decimal             { global_regN (\n -> VanillaReg n VGcPtr) }
+  R@decimal             { global_regN (\n -> VanillaReg n VNonGcPtr) }
+  F@decimal             { global_regN FloatReg }
+  D@decimal             { global_regN DoubleReg }
+  L@decimal             { global_regN LongReg }
+  Sp                    { global_reg Sp }
+  SpLim                 { global_reg SpLim }
+  Hp                    { global_reg Hp }
+  HpLim                 { global_reg HpLim }
   CCCS                  { global_reg CCCS }
   CurrentTSO            { global_reg CurrentTSO }
   CurrentNursery        { global_reg CurrentNursery }
-  HpAlloc		{ global_reg HpAlloc }
-  BaseReg		{ global_reg BaseReg }
-  
-  $namebegin $namechar*	{ name }
-  
-  0 @octal		{ tok_octal }
-  @decimal		{ tok_decimal }
-  0[xX] @hexadecimal	{ tok_hexadecimal }
-  @floating_point	{ strtoken tok_float }
-  
-  \" @strchar* \"	{ strtoken tok_string }
+  HpAlloc               { global_reg HpAlloc }
+  BaseReg               { global_reg BaseReg }
+
+  $namebegin $namechar* { name }
+
+  0 @octal              { tok_octal }
+  @decimal              { tok_decimal }
+  0[xX] @hexadecimal    { tok_hexadecimal }
+  @floating_point       { strtoken tok_float }
+
+  \" @strchar* \"       { strtoken tok_string }
 }
 
 {
@@ -160,6 +160,7 @@ data CmmToken
   | CmmT_case
   | CmmT_default
   | CmmT_push
+  | CmmT_unwind
   | CmmT_bits8
   | CmmT_bits16
   | CmmT_bits32
@@ -171,9 +172,9 @@ data CmmToken
   | CmmT_float64
   | CmmT_gcptr
   | CmmT_GlobalReg GlobalReg
-  | CmmT_Name	   FastString
-  | CmmT_String	   String
-  | CmmT_Int	   Integer
+  | CmmT_Name      FastString
+  | CmmT_String    String
+  | CmmT_Int       Integer
   | CmmT_Float     Rational
   | CmmT_EOF
   deriving (Show)
@@ -196,88 +197,89 @@ kw :: CmmToken -> Action
 kw tok span buf len = return (L span tok)
 
 global_regN :: (Int -> GlobalReg) -> Action
-global_regN con span buf len 
+global_regN con span buf len
   = return (L span (CmmT_GlobalReg (con (fromIntegral n))))
   where buf' = stepOn buf
-	n = parseUnsignedInteger buf' (len-1) 10 octDecDigit
+        n = parseUnsignedInteger buf' (len-1) 10 octDecDigit
 
 global_reg :: GlobalReg -> Action
 global_reg r span buf len = return (L span (CmmT_GlobalReg r))
 
 strtoken :: (String -> CmmToken) -> Action
-strtoken f span buf len = 
+strtoken f span buf len =
   return (L span $! (f $! lexemeToString buf len))
 
 name :: Action
-name span buf len = 
+name span buf len =
   case lookupUFM reservedWordsFM fs of
-	Just tok -> return (L span tok)
-	Nothing  -> return (L span (CmmT_Name fs))
+        Just tok -> return (L span tok)
+        Nothing  -> return (L span (CmmT_Name fs))
   where
-	fs = lexemeToFastString buf len
+        fs = lexemeToFastString buf len
 
 reservedWordsFM = listToUFM $
-	map (\(x, y) -> (mkFastString x, y)) [
-	( "CLOSURE",		CmmT_CLOSURE ),
-	( "INFO_TABLE",		CmmT_INFO_TABLE ),
-	( "INFO_TABLE_RET",	CmmT_INFO_TABLE_RET ),
-	( "INFO_TABLE_FUN",	CmmT_INFO_TABLE_FUN ),
-	( "INFO_TABLE_CONSTR",	CmmT_INFO_TABLE_CONSTR ),
-	( "INFO_TABLE_SELECTOR",CmmT_INFO_TABLE_SELECTOR ),
-	( "else",		CmmT_else ),
-	( "export",		CmmT_export ),
-	( "section",		CmmT_section ),
-	( "align",		CmmT_align ),
-	( "goto",		CmmT_goto ),
-	( "if",			CmmT_if ),
+        map (\(x, y) -> (mkFastString x, y)) [
+        ( "CLOSURE",            CmmT_CLOSURE ),
+        ( "INFO_TABLE",         CmmT_INFO_TABLE ),
+        ( "INFO_TABLE_RET",     CmmT_INFO_TABLE_RET ),
+        ( "INFO_TABLE_FUN",     CmmT_INFO_TABLE_FUN ),
+        ( "INFO_TABLE_CONSTR",  CmmT_INFO_TABLE_CONSTR ),
+        ( "INFO_TABLE_SELECTOR",CmmT_INFO_TABLE_SELECTOR ),
+        ( "else",               CmmT_else ),
+        ( "export",             CmmT_export ),
+        ( "section",            CmmT_section ),
+        ( "align",              CmmT_align ),
+        ( "goto",               CmmT_goto ),
+        ( "if",                 CmmT_if ),
         ( "call",               CmmT_call ),
         ( "jump",               CmmT_jump ),
         ( "foreign",            CmmT_foreign ),
-	( "never",		CmmT_never ),
-	( "prim",		CmmT_prim ),
+        ( "never",              CmmT_never ),
+        ( "prim",               CmmT_prim ),
         ( "reserve",            CmmT_reserve ),
         ( "return",             CmmT_return ),
-	( "returns",		CmmT_returns ),
-	( "import",		CmmT_import ),
-	( "switch",		CmmT_switch ),
-	( "case",		CmmT_case ),
+        ( "returns",            CmmT_returns ),
+        ( "import",             CmmT_import ),
+        ( "switch",             CmmT_switch ),
+        ( "case",               CmmT_case ),
         ( "default",            CmmT_default ),
         ( "push",               CmmT_push ),
+        ( "unwind",             CmmT_unwind ),
         ( "bits8",              CmmT_bits8 ),
-	( "bits16",		CmmT_bits16 ),
-	( "bits32",		CmmT_bits32 ),
-	( "bits64",		CmmT_bits64 ),
-	( "bits128",		CmmT_bits128 ),
-	( "bits256",		CmmT_bits256 ),
-	( "bits512",		CmmT_bits512 ),
-	( "float32",		CmmT_float32 ),
-	( "float64",		CmmT_float64 ),
+        ( "bits16",             CmmT_bits16 ),
+        ( "bits32",             CmmT_bits32 ),
+        ( "bits64",             CmmT_bits64 ),
+        ( "bits128",            CmmT_bits128 ),
+        ( "bits256",            CmmT_bits256 ),
+        ( "bits512",            CmmT_bits512 ),
+        ( "float32",            CmmT_float32 ),
+        ( "float64",            CmmT_float64 ),
 -- New forms
-	( "b8",			CmmT_bits8 ),
-	( "b16",		CmmT_bits16 ),
-	( "b32",		CmmT_bits32 ),
-	( "b64",		CmmT_bits64 ),
-	( "b128",		CmmT_bits128 ),
-	( "b256",		CmmT_bits256 ),
-	( "b512",		CmmT_bits512 ),
-	( "f32",		CmmT_float32 ),
-	( "f64",		CmmT_float64 ),
-	( "gcptr",		CmmT_gcptr )
-	]
-
-tok_decimal span buf len 
+        ( "b8",                 CmmT_bits8 ),
+        ( "b16",                CmmT_bits16 ),
+        ( "b32",                CmmT_bits32 ),
+        ( "b64",                CmmT_bits64 ),
+        ( "b128",               CmmT_bits128 ),
+        ( "b256",               CmmT_bits256 ),
+        ( "b512",               CmmT_bits512 ),
+        ( "f32",                CmmT_float32 ),
+        ( "f64",                CmmT_float64 ),
+        ( "gcptr",              CmmT_gcptr )
+        ]
+
+tok_decimal span buf len
   = return (L span (CmmT_Int  $! parseUnsignedInteger buf len 10 octDecDigit))
 
-tok_octal span buf len 
+tok_octal span buf len
   = return (L span (CmmT_Int  $! parseUnsignedInteger (offsetBytes 1 buf) (len-1) 8 octDecDigit))
 
-tok_hexadecimal span buf len 
+tok_hexadecimal span buf len
   = return (L span (CmmT_Int  $! parseUnsignedInteger (offsetBytes 2 buf) (len-2) 16 hexDigit))
 
 tok_float str = CmmT_Float $! readRational str
 
 tok_string str = CmmT_String (read str)
-		 -- urk, not quite right, but it'll do for now
+                 -- urk, not quite right, but it'll do for now
 
 -- -----------------------------------------------------------------------------
 -- Line pragmas
@@ -286,7 +288,7 @@ setLine :: Int -> Action
 setLine code span buf len = do
   let line = parseUnsignedInteger buf len 10 octDecDigit
   setSrcLoc (mkRealSrcLoc (srcSpanFile span) (fromIntegral line - 1) 1)
-	-- subtract one: the line number refers to the *following* line
+        -- subtract one: the line number refers to the *following* line
   -- trace ("setLine "  ++ show line) $ do
   popLexState
   pushLexState code
@@ -316,17 +318,17 @@ lexToken = do
   sc <- getLexState
   case alexScan inp sc of
     AlexEOF -> do let span = mkRealSrcSpan loc1 loc1
-		  setLastToken span 0
-		  return (L span CmmT_EOF)
+                  setLastToken span 0
+                  return (L span CmmT_EOF)
     AlexError (loc2,_) -> do failLocMsgP loc1 loc2 "lexical error"
     AlexSkip inp2 _ -> do
-	setInput inp2
-	lexToken
+        setInput inp2
+        lexToken
     AlexToken inp2@(end,buf2) len t -> do
-	setInput inp2
-	let span = mkRealSrcSpan loc1 end
-	span `seq` setLastToken span len
-	t span buf len
+        setInput inp2
+        let span = mkRealSrcSpan loc1 end
+        span `seq` setLastToken span len
+        t span buf len
 
 -- -----------------------------------------------------------------------------
 -- Monad stuff
@@ -351,7 +353,7 @@ alexGetByte (loc,s)
   where c    = currentChar s
         b    = fromIntegral $ ord $ c
         loc' = advanceSrcLoc loc c
-	s'   = stepOn s
+        s'   = stepOn s
 
 getInput :: P AlexInput
 getInput = P $ \s@PState{ loc=l, buffer=b } -> POk s (l,b)
diff --git a/compiler/cmm/CmmLint.hs b/compiler/cmm/CmmLint.hs
index 970ce6814939..28a8d89ec81f 100644
--- a/compiler/cmm/CmmLint.hs
+++ b/compiler/cmm/CmmLint.hs
@@ -138,6 +138,8 @@ notNodeReg _                             = True
 lintCmmMiddle :: CmmNode O O -> CmmLint ()
 lintCmmMiddle node = case node of
   CmmComment _ -> return ()
+  CmmTick _    -> return ()
+  CmmUnwind{}  -> return ()
 
   CmmAssign reg expr -> do
             dflags <- getDynFlags
diff --git a/compiler/cmm/CmmLive.hs b/compiler/cmm/CmmLive.hs
index 7d674b76a224..dfacd139b605 100644
--- a/compiler/cmm/CmmLive.hs
+++ b/compiler/cmm/CmmLive.hs
@@ -1,7 +1,9 @@
+{-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
+-- See Note [Deprecations in Hoopl] in Hoopl module
 {-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}
 
 module CmmLive
@@ -11,11 +13,9 @@ module CmmLive
     , cmmGlobalLiveness
     , liveLattice
     , noLiveOnEntry, xferLive, gen, kill, gen_kill
-    , removeDeadAssignments
     )
 where
 
-import UniqSupply
 import DynFlags
 import BlockId
 import Cmm
@@ -98,30 +98,3 @@ xferLive dflags = mkBTransfer3 fst mid lst
         mid n f = gen_kill dflags n f
         lst :: CmmNode O C -> FactBase (CmmLive r) -> CmmLive r
         lst n f = gen_kill dflags n $ joinOutFacts liveLattice n f
-
------------------------------------------------------------------------------
--- Removing assignments to dead variables
------------------------------------------------------------------------------
-
-removeDeadAssignments :: DynFlags -> CmmGraph
-                      -> UniqSM (CmmGraph, BlockEnv CmmLocalLive)
-removeDeadAssignments dflags g =
-   dataflowPassBwd g [] $ analRewBwd liveLattice (xferLive dflags) rewrites
-   where rewrites = mkBRewrite3 nothing middle nothing
-         -- SDM: no need for deepBwdRw here, we only rewrite to empty
-         -- Beware: deepBwdRw with one polymorphic function seems more
-         -- reasonable here, but GHC panics while compiling, see bug
-         -- #4045.
-         middle :: CmmNode O O -> Fact O CmmLocalLive -> CmmReplGraph O O
-         middle (CmmAssign (CmmLocal reg') _) live
-                 | not (reg' `elemRegSet` live)
-                 = return $ Just emptyGraph
-         -- XXX maybe this should be somewhere else...
-         middle (CmmAssign lhs (CmmReg rhs))   _ | lhs == rhs
-                 = return $ Just emptyGraph
-         middle (CmmStore lhs (CmmLoad rhs _)) _ | lhs == rhs
-                 = return $ Just emptyGraph
-         middle _ _ = return Nothing
-
-         nothing :: CmmNode e x -> Fact x CmmLocalLive -> CmmReplGraph e x
-         nothing _ _ = return Nothing
diff --git a/compiler/cmm/CmmMachOp.hs b/compiler/cmm/CmmMachOp.hs
index 684a4b97291b..a7b2c85175de 100644
--- a/compiler/cmm/CmmMachOp.hs
+++ b/compiler/cmm/CmmMachOp.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 
 module CmmMachOp
     ( MachOp(..)
@@ -18,6 +19,9 @@ module CmmMachOp
     -- CallishMachOp
     , CallishMachOp(..), callishMachOpHints
     , pprCallishMachOp
+
+    -- Atomic read-modify-write
+    , AtomicMachOp(..)
    )
 where
 
@@ -545,9 +549,28 @@ data CallishMachOp
   | MO_Memmove
 
   | MO_PopCnt Width
+  | MO_Clz Width
+  | MO_Ctz Width
+
   | MO_BSwap Width
+
+  -- Atomic read-modify-write.
+  | MO_AtomicRMW Width AtomicMachOp
+  | MO_AtomicRead Width
+  | MO_AtomicWrite Width
+  | MO_Cmpxchg Width
   deriving (Eq, Show)
 
+-- | The operation to perform atomically.
+data AtomicMachOp =
+      AMO_Add
+    | AMO_Sub
+    | AMO_And
+    | AMO_Nand
+    | AMO_Or
+    | AMO_Xor
+      deriving (Eq, Show)
+
 pprCallishMachOp :: CallishMachOp -> SDoc
 pprCallishMachOp mo = text (show mo)
 
diff --git a/compiler/cmm/CmmNode.hs b/compiler/cmm/CmmNode.hs
index 5c520d389978..d7a83c41dcd1 100644
--- a/compiler/cmm/CmmNode.hs
+++ b/compiler/cmm/CmmNode.hs
@@ -1,16 +1,22 @@
--- CmmNode type for representation using Hoopl graphs.
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE ExplicitForAll #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE UndecidableInstances #-}
 
+-- CmmNode type for representation using Hoopl graphs.
+
 module CmmNode (
-     CmmNode(..), CmmFormal, CmmActual,
+     CmmNode(..), CmmFormal, CmmActual, CmmTickScope,
      UpdFrameOffset, Convention(..),
      ForeignConvention(..), ForeignTarget(..), foreignTargetHints,
      CmmReturnInfo(..),
      mapExp, mapExpDeep, wrapRecExp, foldExp, foldExpDeep, wrapRecExpf,
-     mapExpM, mapExpDeepM, wrapRecExpM, mapSuccessors
+     mapExpM, mapExpDeepM, wrapRecExpM, mapSuccessors,
+     combineTickScopes,
   ) where
 
 import CodeGen.Platform
@@ -19,6 +25,8 @@ import DynFlags
 import FastString
 import ForeignCall
 import SMRep
+import CoreSyn (RawTickish)
+import qualified Unique as U
 
 import Compiler.Hoopl
 import Data.Maybe
@@ -32,10 +40,13 @@ import Prelude hiding (succ)
 #define ULabel {-# UNPACK #-} !Label
 
 data CmmNode e x where
-  CmmEntry :: ULabel -> CmmNode C O
+  CmmEntry :: ULabel -> [CmmTickScope] -> CmmNode C O
 
   CmmComment :: FastString -> CmmNode O O
 
+  CmmTick :: !RawTickish -> CmmNode O O
+  CmmUnwind :: !GlobalReg -> !CmmExpr -> CmmNode O O
+
   CmmAssign :: !CmmReg -> !CmmExpr -> CmmNode O O
     -- Assign to register
 
@@ -201,7 +212,7 @@ deriving instance Eq (CmmNode e x)
 -- Hoopl instances of CmmNode
 
 instance NonLocal CmmNode where
-  entryLabel (CmmEntry l) = l
+  entryLabel (CmmEntry l _) = l
 
   successors (CmmBranch l) = [l]
   successors (CmmCondBranch {cml_true=t, cml_false=f}) = [f, t] -- meets layout constraint
@@ -218,6 +229,8 @@ type CmmFormal = LocalReg
 
 type UpdFrameOffset = ByteOff
 
+type CmmTickScope = U.Unique
+
 -- | A convention maps a list of values (function arguments or return
 -- values) to registers or stack locations.
 data Convention
@@ -430,8 +443,10 @@ wrapRecExp f (CmmLoad addr ty)    = f (CmmLoad (wrapRecExp f addr) ty)
 wrapRecExp f e                    = f e
 
 mapExp :: (CmmExpr -> CmmExpr) -> CmmNode e x -> CmmNode e x
-mapExp _ f@(CmmEntry _)                          = f
+mapExp _ f@(CmmEntry{})                          = f
 mapExp _ m@(CmmComment _)                        = m
+mapExp _ m@(CmmTick _)                           = m
+mapExp _ m@(CmmUnwind _ _)                       = m
 mapExp f   (CmmAssign r e)                       = CmmAssign r (f e)
 mapExp f   (CmmStore addr e)                     = CmmStore (f addr) (f e)
 mapExp f   (CmmUnsafeForeignCall tgt fs as)      = CmmUnsafeForeignCall (mapForeignTarget f tgt) fs (map f as)
@@ -459,8 +474,10 @@ wrapRecExpM f n@(CmmLoad addr ty)  = maybe (f n) (f . flip CmmLoad ty) (wrapRecE
 wrapRecExpM f e                    = f e
 
 mapExpM :: (CmmExpr -> Maybe CmmExpr) -> CmmNode e x -> Maybe (CmmNode e x)
-mapExpM _ (CmmEntry _)              = Nothing
+mapExpM _ (CmmEntry{})              = Nothing
 mapExpM _ (CmmComment _)            = Nothing
+mapExpM _ (CmmTick _)               = Nothing
+mapExpM _ (CmmUnwind _ _)           = Nothing
 mapExpM f (CmmAssign r e)           = CmmAssign r `fmap` f e
 mapExpM f (CmmStore addr e)         = (\[addr', e'] -> CmmStore addr' e') `fmap` mapListM f [addr, e]
 mapExpM _ (CmmBranch _)             = Nothing
@@ -512,6 +529,8 @@ wrapRecExpf f e                  z = f e z
 foldExp :: (CmmExpr -> z -> z) -> CmmNode e x -> z -> z
 foldExp _ (CmmEntry {}) z                         = z
 foldExp _ (CmmComment {}) z                       = z
+foldExp _ (CmmTick {}) z                          = z
+foldExp _ (CmmUnwind {}) z                        = z
 foldExp f (CmmAssign _ e) z                       = f e z
 foldExp f (CmmStore addr e) z                     = f addr $ f e z
 foldExp f (CmmUnsafeForeignCall t _ as) z         = foldr f (foldExpForeignTarget f t z) as
@@ -532,3 +551,11 @@ mapSuccessors f (CmmCondBranch p y n)  = CmmCondBranch p (f y) (f n)
 mapSuccessors f (CmmSwitch e arms)     = CmmSwitch e (map (fmap f) arms)
 mapSuccessors _ n = n
 
+-- -----------------------------------------------------------------------------
+
+combineTickScopes :: [CmmTickScope] -> [CmmTickScope] -> [CmmTickScope]
+combineTickScopes sc0 sc1
+  | l0 > l1    = take (l1 - common) sc1 ++ sc0
+  | otherwise  = take (l0 - common) sc0 ++ sc1
+  where l0 = length sc0; l1 = length sc1
+        common = length $ takeWhile id $ zipWith (==) (reverse sc0) (reverse sc1)
diff --git a/compiler/cmm/CmmOpt.hs b/compiler/cmm/CmmOpt.hs
index 54dbbebae67a..84499b97de93 100644
--- a/compiler/cmm/CmmOpt.hs
+++ b/compiler/cmm/CmmOpt.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE CPP #-}
+
 -----------------------------------------------------------------------------
 --
 -- Cmm optimisation
diff --git a/compiler/cmm/CmmParse.y b/compiler/cmm/CmmParse.y
index 5f2c4d86be48..37c18af711f7 100644
--- a/compiler/cmm/CmmParse.y
+++ b/compiler/cmm/CmmParse.y
@@ -209,7 +209,7 @@ import StgCmmExtCode
 import CmmCallConv
 import StgCmmProf
 import StgCmmHeap
-import StgCmmMonad hiding ( getCode, getCodeR, emitLabel, emit, emitStore
+import StgCmmMonad hiding ( getCode, getCodeR, getCodeScoped, emitLabel, emit, emitStore
                           , emitAssign, emitOutOfLine, withUpdFrameOff
                           , getUpdFrameOff )
 import qualified StgCmmMonad as F
@@ -220,6 +220,7 @@ import StgCmmClosure
 import StgCmmLayout     hiding (ArgRep(..))
 import StgCmmTicky
 import StgCmmBind       ( emitBlackHoleCode, emitUpdateFrame )
+import CoreSyn          ( Tickish(SourceNote) )
 
 import CmmOpt
 import MkGraph
@@ -324,6 +325,7 @@ import Data.Maybe
         'case'          { L _ (CmmT_case) }
         'default'       { L _ (CmmT_default) }
         'push'          { L _ (CmmT_push) }
+        'unwind'        { L _ (CmmT_unwind) }
         'bits8'         { L _ (CmmT_bits8) }
         'bits16'        { L _ (CmmT_bits16) }
         'bits32'        { L _ (CmmT_bits32) }
@@ -428,10 +430,12 @@ lits    :: { [CmmParse CmmExpr] }
 cmmproc :: { CmmParse () }
         : info maybe_conv maybe_formals maybe_body
                 { do ((entry_ret_label, info, stk_formals, formals), agraph) <-
-                       getCodeR $ loopDecls $ do {
+                       getCodeScoped $ loopDecls $ do {
                          (entry_ret_label, info, stk_formals) <- $1;
+                         dflags <- getDynFlags;
                          formals <- sequence (fromMaybe [] $3);
-                         $4;
+                         withName (showSDoc dflags (ppr entry_ret_label))
+                           $4;
                          return (entry_ret_label, info, stk_formals, formals) }
                      let do_layout = isJust $3
                      code (emitProcWithStackFrame $2 info
@@ -444,7 +448,7 @@ maybe_conv :: { Convention }
 
 maybe_body :: { CmmParse () }
            : ';'                { return () }
-           | '{' body '}'       { $2 }
+           | '{' body '}'       { withSourceNote $1 $3 $2 }
 
 info    :: { CmmParse (CLabel, Maybe CmmInfoTable, [LocalReg]) }
         : NAME
@@ -573,7 +577,7 @@ importName
 
         -- A label imported with an explicit packageId.
         | STRING NAME
-        { ($2, mkCmmCodeLabel (fsToPackageId (mkFastString $1)) $2) }
+        { ($2, mkCmmCodeLabel (fsToPackageKey (mkFastString $1)) $2) }
         
         
 names   :: { [FastString] }
@@ -626,11 +630,13 @@ stmt    :: { CmmParse () }
         | 'if' bool_expr 'goto' NAME
                 { do l <- lookupLabel $4; cmmRawIf $2 l }
         | 'if' bool_expr '{' body '}' else      
-                { cmmIfThenElse $2 $4 $6 }
+                { cmmIfThenElse $2 (withSourceNote $3 $5 $4) $6 }
         | 'push' '(' exprs0 ')' maybe_body
                 { pushStackFrame $3 $5 }
         | 'reserve' expr '=' lreg maybe_body
                 { reserveStackFrame $2 $4 $5 }
+        | 'unwind' GLOBALREG '=' expr
+                { $4 >>= code . emitUnwind $2 }
 
 foreignLabel     :: { CmmParse CmmExpr }
         : NAME                          { return (CmmLit (CmmLabel (mkForeignLabel $1 Nothing ForeignLabelInThisPackage IsFunction))) }
@@ -679,7 +685,7 @@ arm     :: { CmmParse ([Int],Either BlockId (CmmParse ())) }
         : 'case' ints ':' arm_body      { do b <- $4; return ($2, b) }
 
 arm_body :: { CmmParse (Either BlockId (CmmParse ())) }
-        : '{' body '}'                  { return (Right $2) }
+        : '{' body '}'                  { return (Right (withSourceNote $1 $3 $2)) }
         | 'goto' NAME ';'               { do l <- lookupLabel $2; return (Left l) }
 
 ints    :: { [Int] }
@@ -687,7 +693,7 @@ ints    :: { [Int] }
         | INT ',' ints                  { fromIntegral $1 : $3 }
 
 default :: { Maybe (CmmParse ()) }
-        : 'default' ':' '{' body '}'    { Just $4 }
+        : 'default' ':' '{' body '}'    { Just (withSourceNote $3 $5 $4) }
         -- taking a few liberties with the C-- syntax here; C-- doesn't have
         -- 'default' branches
         | {- empty -}                   { Nothing }
@@ -696,7 +702,7 @@ default :: { Maybe (CmmParse ()) }
 -- CmmNode does.
 else    :: { CmmParse () }
         : {- empty -}                   { return () }
-        | 'else' '{' body '}'           { $3 }
+        | 'else' '{' body '}'           { withSourceNote $2 $4 $3 }
 
 -- we have to write this out longhand so that Happy's precedence rules
 -- can kick in.
@@ -1101,7 +1107,7 @@ profilingInfo dflags desc_str ty_str
     else ProfilingInfo (stringToWord8s desc_str)
                        (stringToWord8s ty_str)
 
-staticClosure :: PackageId -> FastString -> FastString -> [CmmLit] -> CmmParse ()
+staticClosure :: PackageKey -> FastString -> FastString -> [CmmLit] -> CmmParse ()
 staticClosure pkg cl_label info payload
   = do dflags <- getDynFlags
        let lits = mkStaticClosure dflags (mkCmmInfoLabel pkg info) dontCareCCS payload [] [] []
@@ -1275,6 +1281,15 @@ emitCond (e1 `BoolAnd` e2) then_id = do
   emitCond e2 then_id
   emitLabel else_id
 
+-- -----------------------------------------------------------------------------
+-- Source code notes
+
+withSourceNote :: Located a -> Located b -> CmmParse c -> CmmParse c
+withSourceNote a b parse = do
+  name <- getName
+  case combineSrcSpans (getLoc a) (getLoc b) of
+    RealSrcSpan span -> code (emitTick (SourceNote span name)) >> parse
+    _other           -> parse
 
 -- -----------------------------------------------------------------------------
 -- Table jumps
@@ -1321,7 +1336,7 @@ doSwitch mb_range scrut arms deflt
 
 forkLabelledCode :: CmmParse () -> CmmParse BlockId
 forkLabelledCode p = do
-  ag <- getCode p
+  (_,ag) <- getCodeScoped p
   l <- newBlockId
   emitOutOfLine l ag
   return l
@@ -1334,7 +1349,7 @@ forkLabelledCode p = do
 initEnv :: DynFlags -> Env
 initEnv dflags = listToUFM [
   ( fsLit "SIZEOF_StgHeader",
-    VarN (CmmLit (CmmInt (fromIntegral (fixedHdrSize dflags * wORD_SIZE dflags)) (wordWidth dflags)) )),
+    VarN (CmmLit (CmmInt (fromIntegral (fixedHdrSize dflags)) (wordWidth dflags)) )),
   ( fsLit "SIZEOF_StgInfoTable",
     VarN (CmmLit (CmmInt (fromIntegral (stdInfoTableSizeB dflags)) (wordWidth dflags)) ))
   ]
@@ -1354,7 +1369,8 @@ parseCmmFile dflags filename = do
         return ((emptyBag, unitBag msg), Nothing)
     POk pst code -> do
         st <- initC
-        let (cmm,_) = runC dflags no_module st (getCmm (unEC code (initEnv dflags) [] >> return ()))
+        let fcode = getCmm $ unEC code "global" (initEnv dflags) [] >> return ()
+            (cmm,_) = runC dflags no_module st fcode
         let ms = getMessages pst
         if (errorsFound dflags ms)
          then return (ms, Nothing)
diff --git a/compiler/cmm/CmmPipeline.hs b/compiler/cmm/CmmPipeline.hs
index 5c2d54d5ba48..af4f62a4a8d4 100644
--- a/compiler/cmm/CmmPipeline.hs
+++ b/compiler/cmm/CmmPipeline.hs
@@ -1,6 +1,4 @@
-{-# LANGUAGE NoMonoLocalBinds #-}
--- Norman likes local bindings
--- If this module lives on I'd like to get rid of this extension in due course
+{-# LANGUAGE BangPatterns #-}
 
 module CmmPipeline (
   -- | Converts C-- with an implicit stack and native C-- calls into
@@ -40,8 +38,6 @@ cmmPipeline  :: HscEnv -- Compilation env including
 cmmPipeline hsc_env topSRT prog =
   do let dflags = hsc_dflags hsc_env
 
-     showPass dflags "CPSZ"
-
      tops <- {-# SCC "tops" #-} mapM (cpsTop hsc_env) prog
 
      (topSRT, cmms) <- {-# SCC "doSRTs" #-} doSRTs dflags topSRT tops
@@ -88,10 +84,6 @@ cpsTop hsc_env proc =
              else
                return call_pps
 
-       let noncall_pps = proc_points `setDifference` call_pps
-       when (not (setNull noncall_pps) && dopt Opt_D_dump_cmm dflags) $
-         pprTrace "Non-call proc points: " (ppr noncall_pps) $ return ()
-
        ----------- Layout the stack and manifest Sp ----------------------------
        (g, stackmaps) <-
             {-# SCC "layoutStack" #-}
@@ -109,57 +101,40 @@ cpsTop hsc_env proc =
        let cafEnv = {-# SCC "cafAnal" #-} cafAnal g
        dumpIfSet_dyn dflags Opt_D_dump_cmm "CAFEnv" (ppr cafEnv)
 
-       if splitting_proc_points
-          then do
-            ------------- Split into separate procedures -----------------------
-            pp_map  <- {-# SCC "procPointAnalysis" #-} runUniqSM $
-                             procPointAnalysis proc_points g
-            dumpWith dflags Opt_D_dump_cmm_procmap "procpoint map" pp_map
-            gs <- {-# SCC "splitAtProcPoints" #-} runUniqSM $
-                  splitAtProcPoints dflags l call_pps proc_points pp_map
-                                    (CmmProc h l v g)
-            dumps Opt_D_dump_cmm_split "Post splitting" gs
-
-            ------------- Populate info tables with stack info -----------------
-            gs <- {-# SCC "setInfoTableStackMap" #-}
-                  return $ map (setInfoTableStackMap dflags stackmaps) gs
-            dumps Opt_D_dump_cmm_info "after setInfoTableStackMap" gs
-
-            ----------- Control-flow optimisations -----------------------------
-            gs <- {-# SCC "cmmCfgOpts(2)" #-}
-                  return $ if optLevel dflags >= 1
-                             then map (cmmCfgOptsProc splitting_proc_points) gs
-                             else gs
-            gs <- return (map removeUnreachableBlocksProc gs)
-                -- Note [unreachable blocks]
-            dumps Opt_D_dump_cmm_cfg "Post control-flow optimisations" gs
-
-            return (cafEnv, gs)
-
-          else do
-            -- attach info tables to return points
-            g <- return $ attachContInfoTables call_pps (CmmProc h l v g)
-
-            ------------- Populate info tables with stack info -----------------
-            g <- {-# SCC "setInfoTableStackMap" #-}
-                  return $ setInfoTableStackMap dflags stackmaps g
-            dump' Opt_D_dump_cmm_info "after setInfoTableStackMap" g
-
-            ----------- Control-flow optimisations -----------------------------
-            g <- {-# SCC "cmmCfgOpts(2)" #-}
-                 return $ if optLevel dflags >= 1
-                             then cmmCfgOptsProc splitting_proc_points g
-                             else g
-            g <- return (removeUnreachableBlocksProc g)
-                -- Note [unreachable blocks]
-            dump' Opt_D_dump_cmm_cfg "Post control-flow optimisations" g
-
-            return (cafEnv, [g])
+       g <- if splitting_proc_points
+            then do
+               ------------- Split into separate procedures -----------------------
+               pp_map  <- {-# SCC "procPointAnalysis" #-} runUniqSM $
+                          procPointAnalysis proc_points g
+               dumpWith dflags Opt_D_dump_cmm_procmap "procpoint map" pp_map
+               g <- {-# SCC "splitAtProcPoints" #-} runUniqSM $
+                    splitAtProcPoints dflags l call_pps proc_points pp_map
+                                      (CmmProc h l v g)
+               dumps Opt_D_dump_cmm_split "Post splitting" g
+               return g
+             else do
+               -- attach info tables to return points
+               return $ [attachContInfoTables call_pps (CmmProc h l v g)]
+
+       ------------- Populate info tables with stack info -----------------
+       g <- {-# SCC "setInfoTableStackMap" #-}
+            return $ map (setInfoTableStackMap dflags stackmaps) g
+       dumps Opt_D_dump_cmm_info "after setInfoTableStackMap" g
+
+       ----------- Control-flow optimisations -----------------------------
+       g <- {-# SCC "cmmCfgOpts(2)" #-}
+            return $ if optLevel dflags >= 1
+                     then map (cmmCfgOptsProc splitting_proc_points) g
+                     else g
+       g <- return (map removeUnreachableBlocksProc g)
+            -- See Note [unreachable blocks]
+       dumps Opt_D_dump_cmm_cfg "Post control-flow optimisations" g
+
+       return (cafEnv, g)
 
   where dflags = hsc_dflags hsc_env
         platform = targetPlatform dflags
         dump = dumpGraph dflags
-        dump' = dumpWith dflags
 
         dumps flag name
            = mapM_ (dumpWith dflags flag name)
@@ -351,10 +326,9 @@ _GLOBAL_OFFSET_TABLE_, regardless of which entry point we arrived via.
 {- Note [unreachable blocks]
 
 The control-flow optimiser sometimes leaves unreachable blocks behind
-containing junk code.  If these blocks make it into the native code
-generator then they trigger a register allocator panic because they
-refer to undefined LocalRegs, so we must eliminate any unreachable
-blocks before passing the code onwards.
+containing junk code.  These aren't necessarily a problem, but
+removing them is good because it might save time in the native code
+generator later.
 
 -}
 
@@ -383,4 +357,3 @@ dumpWith dflags flag txt g = do
    dumpIfSet_dyn dflags flag txt (ppr g)
    when (not (dopt flag dflags)) $
       dumpIfSet_dyn dflags Opt_D_dump_cmm txt (ppr g)
-
diff --git a/compiler/cmm/CmmProcPoint.hs b/compiler/cmm/CmmProcPoint.hs
index 5f9c27fe7a28..3b5220e805da 100644
--- a/compiler/cmm/CmmProcPoint.hs
+++ b/compiler/cmm/CmmProcPoint.hs
@@ -145,7 +145,7 @@ forward :: FwdTransfer CmmNode Status
 forward = mkFTransfer3 first middle last
     where
       first :: CmmNode C O -> Status -> Status
-      first (CmmEntry id) ProcPoint = ReachedBy $ setSingleton id
+      first (CmmEntry id _) ProcPoint = ReachedBy $ setSingleton id
       first  _ x = x
 
       middle _ x = x
@@ -282,7 +282,7 @@ splitAtProcPoints dflags entry_label callPPs procPoints procMap
      -- and replace branches to procpoints with branches to the jump-off blocks
      let add_jump_block (env, bs) (pp, l) =
            do bid <- liftM mkBlockId getUniqueM
-              let b = blockJoin (CmmEntry bid) emptyBlock jump
+              let b = blockJoin (CmmEntry bid []) emptyBlock jump
                   live = ppLiveness pp
                   jump = CmmCall (CmmLit (CmmLabel l)) Nothing live 0 0 0
               return (mapInsert pp bid env, b : bs)
diff --git a/compiler/cmm/CmmRewriteAssignments.hs b/compiler/cmm/CmmRewriteAssignments.hs
index 3c0a05b949dd..621d90dbbb8c 100644
--- a/compiler/cmm/CmmRewriteAssignments.hs
+++ b/compiler/cmm/CmmRewriteAssignments.hs
@@ -381,6 +381,10 @@ middleAssignment dflags (Plain n@(CmmUnsafeForeignCall{})) assign
 
 middleAssignment _ (Plain (CmmComment {})) assign
     = assign
+middleAssignment _ (Plain (CmmTick {})) assign
+    = assign
+middleAssignment _ (Plain (CmmUnwind {})) assign
+    = assign
 
 -- Assumptions:
 --  * Writes using Hp do not overlap with any other memory locations
diff --git a/compiler/cmm/CmmSink.hs b/compiler/cmm/CmmSink.hs
index c404a2e93244..4dced9afd229 100644
--- a/compiler/cmm/CmmSink.hs
+++ b/compiler/cmm/CmmSink.hs
@@ -9,6 +9,7 @@ import BlockId
 import CmmLive
 import CmmUtils
 import Hoopl
+import CodeGen.Platform
 
 import DynFlags
 import UniqFM
@@ -16,6 +17,7 @@ import PprCmm ()
 
 import Data.List (partition)
 import qualified Data.Set as Set
+import Data.Maybe
 
 -- -----------------------------------------------------------------------------
 -- Sinking and inlining
@@ -197,7 +199,7 @@ cmmSink dflags graph = ofBlockList (g_entry graph) $ sink mapEmpty $ blocks
       drop_if a@(r,rhs,_) live_sets = (should_drop, live_sets')
           where
             should_drop =  conflicts dflags a final_last
-                        || not (isTrivial rhs) && live_in_multi live_sets r
+                        || not (isTrivial dflags rhs) && live_in_multi live_sets r
                         || r `Set.member` live_in_joins
 
             live_sets' | should_drop = live_sets
@@ -219,26 +221,24 @@ cmmSink dflags graph = ofBlockList (g_entry graph) $ sink mapEmpty $ blocks
 
 -- small: an expression we don't mind duplicating
 isSmall :: CmmExpr -> Bool
-isSmall (CmmReg (CmmLocal _)) = True  -- not globals, we want to coalesce them instead* See below
+isSmall (CmmReg (CmmLocal _)) = True  --
 isSmall (CmmLit _) = True
 isSmall (CmmMachOp (MO_Add _) [x,y]) = isTrivial x && isTrivial y
 isSmall (CmmRegOff (CmmLocal _) _) = True
 isSmall _ = False
-
-Coalesce global registers? What does that mean? We observed no decrease
-in performance comming from inlining of global registers, hence we do it now
-(see isTrivial function). Ideally we'd like to measure performance using
-some tool like perf or VTune and make decisions what to inline based on that.
 -}
 
 --
 -- We allow duplication of trivial expressions: registers (both local and
 -- global) and literals.
 --
-isTrivial :: CmmExpr -> Bool
-isTrivial (CmmReg _) = True
-isTrivial (CmmLit _) = True
-isTrivial _          = False
+isTrivial :: DynFlags -> CmmExpr -> Bool
+isTrivial _ (CmmReg (CmmLocal _)) = True
+isTrivial dflags (CmmReg (CmmGlobal r)) = -- see Note [Inline GlobalRegs?]
+   isJust (globalRegMaybe (targetPlatform dflags) r)
+   -- GlobalRegs that are loads from BaseReg are not trivial
+isTrivial _ (CmmLit _) = True
+isTrivial _ _          = False
 
 --
 -- annotate each node with the set of registers live *after* the node
@@ -401,7 +401,7 @@ tryToInline dflags live node assigs = go usages node [] assigs
    | cannot_inline           = dont_inline
    | occurs_none             = discard  -- Note [discard during inlining]
    | occurs_once             = inline_and_discard
-   | isTrivial rhs           = inline_and_keep
+   | isTrivial dflags rhs    = inline_and_keep
    | otherwise               = dont_inline
    where
         inline_and_discard = go usages' inl_node skipped rest
@@ -516,7 +516,7 @@ conflicts :: DynFlags -> Assignment -> CmmNode O x -> Bool
 conflicts dflags (r, rhs, addr) node
 
   -- (1) node defines registers used by rhs of assignment. This catches
-  -- assignmnets and all three kinds of calls. See Note [Sinking and calls]
+  -- assignments and all three kinds of calls. See Note [Sinking and calls]
   | globalRegistersConflict dflags rhs node                       = True
   | localRegistersConflict  dflags rhs node                       = True
 
@@ -650,6 +650,10 @@ data AbsMem
 -- perhaps we ought to have a special annotation for calls that can
 -- modify heap/stack memory.  For now we just use the conservative
 -- definition here.
+--
+-- Some CallishMachOp imply a memory barrier e.g. AtomicRMW and
+-- therefore we should never float any memory operations across one of
+-- these calls.
 
 
 bothMems :: AbsMem -> AbsMem -> AbsMem
@@ -695,3 +699,91 @@ regAddr _      (CmmGlobal Hp) _ _ = HeapMem
 regAddr _      (CmmGlobal CurrentTSO) _ _ = HeapMem -- important for PrimOps
 regAddr dflags r _ _ | isGcPtrType (cmmRegType dflags r) = HeapMem -- yay! GCPtr pays for itself
 regAddr _      _ _ _ = AnyMem
+
+{-
+Note [Inline GlobalRegs?]
+
+Should we freely inline GlobalRegs?
+
+Actually it doesn't make a huge amount of difference either way, so we
+*do* currently treat GlobalRegs as "trivial" and inline them
+everywhere, but for what it's worth, here is what I discovered when I
+(SimonM) looked into this:
+
+Common sense says we should not inline GlobalRegs, because when we
+have
+
+  x = R1
+
+the register allocator will coalesce this assignment, generating no
+code, and simply record the fact that x is bound to $rbx (or
+whatever).  Furthermore, if we were to sink this assignment, then the
+range of code over which R1 is live increases, and the range of code
+over which x is live decreases.  All things being equal, it is better
+for x to be live than R1, because R1 is a fixed register whereas x can
+live in any register.  So we should neither sink nor inline 'x = R1'.
+
+However, not inlining GlobalRegs can have surprising
+consequences. e.g. (cgrun020)
+
+  c3EN:
+      _s3DB::P64 = R1;
+      _c3ES::P64 = _s3DB::P64 & 7;
+      if (_c3ES::P64 >= 2) goto c3EU; else goto c3EV;
+  c3EU:
+      _s3DD::P64 = P64[_s3DB::P64 + 6];
+      _s3DE::P64 = P64[_s3DB::P64 + 14];
+      I64[Sp - 8] = c3F0;
+      R1 = _s3DE::P64;
+      P64[Sp] = _s3DD::P64;
+
+inlining the GlobalReg gives:
+
+  c3EN:
+      if (R1 & 7 >= 2) goto c3EU; else goto c3EV;
+  c3EU:
+      I64[Sp - 8] = c3F0;
+      _s3DD::P64 = P64[R1 + 6];
+      R1 = P64[R1 + 14];
+      P64[Sp] = _s3DD::P64;
+
+but if we don't inline the GlobalReg, instead we get:
+
+      _s3DB::P64 = R1;
+      if (_s3DB::P64 & 7 >= 2) goto c3EU; else goto c3EV;
+  c3EU:
+      I64[Sp - 8] = c3F0;
+      R1 = P64[_s3DB::P64 + 14];
+      P64[Sp] = P64[_s3DB::P64 + 6];
+
+This looks better - we managed to inline _s3DD - but in fact it
+generates an extra reg-reg move:
+
+.Lc3EU:
+        movq $c3F0_info,-8(%rbp)
+        movq %rbx,%rax
+        movq 14(%rbx),%rbx
+        movq 6(%rax),%rax
+        movq %rax,(%rbp)
+
+because _s3DB is now live across the R1 assignment, we lost the
+benefit of coalescing.
+
+Who is at fault here?  Perhaps if we knew that _s3DB was an alias for
+R1, then we would not sink a reference to _s3DB past the R1
+assignment.  Or perhaps we *should* do that - we might gain by sinking
+it, despite losing the coalescing opportunity.
+
+Sometimes not inlining global registers wins by virtue of the rule
+about not inlining into arguments of a foreign call, e.g. (T7163) this
+is what happens when we inlined F1:
+
+      _s3L2::F32 = F1;
+      _c3O3::F32 = %MO_F_Mul_W32(F1, 10.0 :: W32);
+      (_s3L7::F32) = call "ccall" arg hints:  []  result hints:  [] rintFloat(_c3O3::F32);
+
+but if we don't inline F1:
+
+      (_s3L7::F32) = call "ccall" arg hints:  []  result hints:  [] rintFloat(%MO_F_Mul_W32(_s3L2::F32,
+                                                                                            10.0 :: W32));
+-}
diff --git a/compiler/cmm/CmmType.hs b/compiler/cmm/CmmType.hs
index d03c2dc0b957..37d92c207d4f 100644
--- a/compiler/cmm/CmmType.hs
+++ b/compiler/cmm/CmmType.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 
 module CmmType
     ( CmmType   -- Abstract
diff --git a/compiler/cmm/CmmUtils.hs b/compiler/cmm/CmmUtils.hs
index f6d1ddde58cd..308cb751fd01 100644
--- a/compiler/cmm/CmmUtils.hs
+++ b/compiler/cmm/CmmUtils.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE GADTs #-}
+{-# LANGUAGE CPP, GADTs, RankNTypes #-}
 
 -----------------------------------------------------------------------------
 --
@@ -55,7 +55,10 @@ module CmmUtils(
 
         analFwd, analBwd, analRewFwd, analRewBwd,
         dataflowPassFwd, dataflowPassBwd, dataflowAnalFwd, dataflowAnalBwd,
-        dataflowAnalFwdBlocks
+        dataflowAnalFwdBlocks,
+
+        -- * Ticks
+        blockTicks
   ) where
 
 #include "HsVersions.h"
@@ -72,6 +75,7 @@ import Unique
 import UniqSupply
 import DynFlags
 import Util
+import CoreSyn  ( RawTickish )
 
 import Data.Word
 import Data.Maybe
@@ -286,22 +290,23 @@ cmmOffsetLitB = cmmOffsetLit
 
 -----------------------
 -- The "W" variants take word offsets
+
 cmmOffsetExprW :: DynFlags -> CmmExpr -> CmmExpr -> CmmExpr
 -- The second arg is a *word* offset; need to change it to bytes
 cmmOffsetExprW dflags  e (CmmLit (CmmInt n _)) = cmmOffsetW dflags e (fromInteger n)
 cmmOffsetExprW dflags e wd_off = cmmIndexExpr dflags (wordWidth dflags) e wd_off
 
 cmmOffsetW :: DynFlags -> CmmExpr -> WordOff -> CmmExpr
-cmmOffsetW dflags e n = cmmOffsetB dflags e (wORD_SIZE dflags * n)
+cmmOffsetW dflags e n = cmmOffsetB dflags e (wordsToBytes dflags n)
 
 cmmRegOffW :: DynFlags -> CmmReg -> WordOff -> CmmExpr
-cmmRegOffW dflags reg wd_off = cmmRegOffB reg (wd_off * wORD_SIZE dflags)
+cmmRegOffW dflags reg wd_off = cmmRegOffB reg (wordsToBytes dflags wd_off)
 
 cmmOffsetLitW :: DynFlags -> CmmLit -> WordOff -> CmmLit
-cmmOffsetLitW dflags lit wd_off = cmmOffsetLitB lit (wORD_SIZE dflags * wd_off)
+cmmOffsetLitW dflags lit wd_off = cmmOffsetLitB lit (wordsToBytes dflags wd_off)
 
 cmmLabelOffW :: DynFlags -> CLabel -> WordOff -> CmmLit
-cmmLabelOffW dflags lbl wd_off = cmmLabelOffB lbl (wORD_SIZE dflags * wd_off)
+cmmLabelOffW dflags lbl wd_off = cmmLabelOffB lbl (wordsToBytes dflags wd_off)
 
 cmmLoadIndexW :: DynFlags -> CmmExpr -> Int -> CmmType -> CmmExpr
 cmmLoadIndexW dflags base off ty = CmmLoad (cmmOffsetW dflags base off) ty
@@ -492,7 +497,7 @@ mapGraphNodes :: ( CmmNode C O -> CmmNode C O
                  , CmmNode O C -> CmmNode O C)
               -> CmmGraph -> CmmGraph
 mapGraphNodes funs@(mf,_,_) g =
-  ofBlockMap (entryLabel $ mf $ CmmEntry $ g_entry g) $ mapMap (mapBlock3' funs) $ toBlockMap g
+  ofBlockMap (entryLabel $ mf $ CmmEntry (g_entry g) []) $ mapMap (mapBlock3' funs) $ toBlockMap g
 
 mapGraphNodes1 :: (forall e x. CmmNode e x -> CmmNode e x) -> CmmGraph -> CmmGraph
 mapGraphNodes1 f = modifyGraph (mapGraph f)
@@ -566,3 +571,13 @@ dataflowPassBwd :: NonLocal n =>
 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)
+
+-------------------------------------------------
+-- Tick utilities
+
+blockTicks :: Block CmmNode C C -> [RawTickish]
+blockTicks b = reverse $ foldBlockNodesF goStmt b []
+  where goStmt :: CmmNode e x -> [RawTickish] -> [RawTickish]
+        goStmt  (CmmTick t) ts = t:ts
+        goStmt  _other      ts = ts
+
diff --git a/compiler/cmm/Debug.hs b/compiler/cmm/Debug.hs
new file mode 100644
index 000000000000..175966a8bb2f
--- /dev/null
+++ b/compiler/cmm/Debug.hs
@@ -0,0 +1,498 @@
+
+{-# LANGUAGE GADTs, CPP #-}
+
+-----------------------------------------------------------------------------
+--
+-- Debugging data
+--
+-- Association of debug data on the Cmm level, with methods to encode it in
+-- event log format for later inclusion in profiling event logs.
+--
+-----------------------------------------------------------------------------
+
+module Debug (
+
+  DebugBlock(..), dblIsEntry,
+  UnwindTable, UnwindExpr(..),
+  cmmDebugGen,
+  cmmDebugLink,
+  debugToMap,
+  writeDebugToEventlog
+
+  ) where
+
+import Binary
+import BlockId         ( blockLbl )
+import CLabel
+import Cmm
+import CmmUtils
+import CoreSyn
+import DynFlags
+import FastString      ( nilFS, mkFastString, unpackFS )
+import Module
+import Outputable
+import PprCore         ()
+import PprCmmExpr      ( pprExpr )
+import SrcLoc
+import UniqFM
+import Util
+import Var             ( Var, varType )
+
+import Compiler.Hoopl
+
+import Control.Monad   ( foldM, forM_, void, when, ap )
+import Control.Applicative ( Applicative(..) )
+
+import Data.Char       ( ord)
+import Data.Maybe
+import Data.List       ( find, minimumBy )
+import Data.Ord        ( comparing )
+import qualified Data.Map as Map
+import Data.Word       ( Word8, Word16 )
+
+import Foreign.ForeignPtr
+
+#define EVENTLOG_CONSTANTS_ONLY
+#include "../../includes/rts/EventLogFormat.h"
+
+-- | Debug information about a block of code. Context is encoded through nesting.
+data DebugBlock =
+  DebugBlock
+  { dblProcedure  :: !Label              -- ^ Entry label of containing producedure
+  , dblLabel      :: !Label              -- ^ Hoopl label
+  , dblCLabel     :: !CLabel             -- ^ Output label
+  , dblHasInfoTbl :: !Bool               -- ^ Has an info table?
+  , dblTicks      :: ![RawTickish]       -- ^ Ticks defined in this block
+  , dblSourceTick :: !(Maybe RawTickish) -- ^ Best source tick covering this block
+  , dblPosition   :: !(Maybe Int)        -- ^ Output position relative to other blocks in proc.
+                                         --   @Nothing@ means the block has been optimized out.
+  , dblUnwind     :: !UnwindTable        -- ^ Unwind information
+  , dblBlocks     :: ![DebugBlock]       -- ^ Nested blocks
+  }
+
+dblIsEntry :: DebugBlock -> Bool
+dblIsEntry blk = dblProcedure blk == dblLabel blk
+
+instance Outputable DebugBlock where
+  ppr blk = (if dblProcedure blk == dblLabel blk
+             then text "proc "
+             else if dblHasInfoTbl blk
+                  then text "pp-blk "
+                  else text "blk ") <>
+            ppr (dblLabel blk) <+> parens (ppr (dblCLabel blk)) <+>
+            (maybe empty ppr (dblSourceTick blk)) <+>
+            (maybe empty ppr (find isCore (dblTicks blk))) <+>
+            (maybe (text "removed") ((text "pos " <>) . ppr) (dblPosition blk)) <+>
+            pprUwMap (dblUnwind blk) $$
+            (if null (dblBlocks blk) then empty else ppr (dblBlocks blk))
+    where isCore CoreNote{} = True
+          isCore _other     = False
+          pprUw (g, expr) = ppr g <> char '=' <> ppr expr
+          pprUwMap = braces . hsep . punctuate comma . map pprUw . Map.toList
+
+type BlockContext = (CmmBlock, RawCmmDecl, UnwindTable)
+
+-- | Extract debug data from a group of procedures
+cmmDebugGen :: ModLocation -> RawCmmGroup -> [DebugBlock]
+cmmDebugGen modLoc decls = map (blocksForScope Nothing) topScopes
+  where
+      blockCtxs = blockContexts decls
+
+      -- Analyse tick scope structure: Each one is either a top-level
+      -- tick scope, or the child of another. Note that we are using
+      -- "postfix" instead of "subset" relation here, implicitly
+      -- reducing the graph to a tree.
+      (topScopes, childScopes)
+        = splitEithers $ map (\a -> findP a a) $ Map.keys blockCtxs
+      findP tsc []                                  = Left tsc
+      findP tsc (_:sc) | sc `Map.member` blockCtxs  = Right (sc, tsc)
+                       | otherwise                  = findP tsc sc
+      scopeMap = foldr (uncurry insertMulti) Map.empty childScopes
+
+      -- Finding the "best" source tick is somewhat arbitrary -- we
+      -- select the first source span, while preferring source ticks
+      -- from the same source file.  Furthermore, dumps take priority
+      -- (if we generated one, we probably want debug information to
+      -- refer to it).
+      bestSrcTick = minimumBy (comparing rangeRating)
+      rangeRating (SourceNote span _)
+        | isDumpSrcSpan span           = 0
+        | srcSpanFile span == thisFile = 1
+        | otherwise                    = 2 :: Int
+      rangeRating _non_source_note     = error "rangeRating"
+      thisFile = maybe nilFS mkFastString $ ml_hs_file modLoc
+
+      -- Returns block tree for this scope as well as all nested
+      -- scopes. Note that if there are multiple blocks in the (exact)
+      -- same scope we elect one as the "branch" node and add the rest
+      -- as children.
+      blocksForScope cstick scope = mkBlock True (head bctxs)
+        where bctxs = fromJust $ Map.lookup scope blockCtxs
+              nested = fromMaybe [] $ Map.lookup scope scopeMap
+              childs = map (mkBlock False) (tail bctxs) ++
+                       map (blocksForScope stick) nested
+              mkBlock top (block, prc, unwind)
+                = DebugBlock { dblProcedure    = g_entry graph
+                             , dblLabel        = label
+                             , dblCLabel       = case info of
+                                 Just (Statics infoLbl _)   -> infoLbl
+                                 Nothing
+                                   | g_entry graph == label -> entryLbl
+                                   | otherwise              -> blockLbl label
+                             , dblHasInfoTbl   = isJust info
+                             , dblTicks        = if top then ticks else []
+                             , dblPosition     = Nothing -- updated in cmmDebugLink
+                             , dblUnwind       = unwind
+                             , dblSourceTick   = stick
+                             , dblBlocks       = if top then childs else []
+                             }
+                where (CmmProc infos entryLbl _ graph) = prc
+                      label = entryLabel block
+                      info = mapLookup label infos
+
+              -- A source tick scopes over all nested blocks. However
+              -- their source ticks might take priority.
+              isSourceTick SourceNote {} = True
+              isSourceTick _             = False
+              ticks = concatMap (blockTicks . fstOf3) bctxs
+              stick = case filter isSourceTick ticks of
+                []     -> cstick
+                sticks -> Just $! bestSrcTick (sticks ++ maybeToList cstick)
+
+-- | Build a map of blocks sorted by their tick scopes
+--
+-- This involves a pre-order traversal, as we want blocks in rough
+-- control flow order (so ticks have a chance to be sorted in the
+-- right order). We also use this opportunity to have blocks inherit
+-- unwind information from their predecessor blocks where it is
+-- lacking.
+blockContexts :: RawCmmGroup -> Map.Map [CmmTickScope] [BlockContext]
+blockContexts decls = Map.map reverse $ foldr walkProc Map.empty decls
+  where walkProc CmmData{}                 m = m
+        walkProc prc@(CmmProc _ _ _ graph) m
+          | mapNull blocks = m
+          | otherwise      = snd $ walkBlock prc entry Map.empty (emptyLbls, m)
+          where blocks = toBlockMap graph
+                entry  = [mapFind (g_entry graph) blocks]
+                emptyLbls = setEmpty :: LabelSet
+        walkBlock _   []             _      c            = c
+        walkBlock prc (block:blocks) unwind (visited, m)
+          | lbl `setMember` visited
+          = walkBlock prc blocks unwind (visited, m)
+          | otherwise
+          = walkBlock prc blocks unwind $
+            walkBlock prc succs unwind' (lbl `setInsert` visited,
+                                         insertMulti scope (block, prc, unwind') m)
+          where CmmEntry lbl scope = firstNode block
+                unwind' = extractUnwind block `Map.union` unwind
+                (CmmProc _ _ _ graph) = prc
+                succs = map (flip mapFind (toBlockMap graph))
+                            (successors (lastNode block))
+        mapFind = mapFindWithDefault (error "contextTree: block not found!")
+
+insertMulti :: Ord k => k -> a -> Map.Map k [a] -> Map.Map k [a]
+insertMulti k v = Map.insertWith (const (v:)) k [v]
+
+-- | Sets position fields in the debug block tree according to native
+-- generated code.
+cmmDebugLink :: (i -> Bool) -> GenCmmGroup d g (ListGraph i)
+                -> [DebugBlock] -> [DebugBlock]
+cmmDebugLink isMeta nats blocks =
+  let -- Find order in which procedures will be generated by the
+      -- back-end (that actually matters for DWARF generation).
+      --
+      -- Note that we might encounter blocks that are missing or only
+      -- consist of meta instructions -- we will declare them missing,
+      -- which will skip debug data generation without messing up the
+      -- block hierarchy.
+      getBlocks (CmmProc _ _ _ (ListGraph bs)) = bs
+      getBlocks _other                         = []
+      allMeta (BasicBlock _ instrs) = all isMeta instrs
+      blockPosition :: LabelMap Int
+      blockPosition = mapFromList $ flip zip [0..] $ map blockId $ filter (not . allMeta) $
+                      concatMap getBlocks nats
+
+      link block = block { dblPosition = mapLookup (dblLabel block) blockPosition
+                         , dblBlocks   = map link (dblBlocks block)
+                         }
+   in map link blocks
+
+-- | Converts debug blocks into a label map for easier lookups
+debugToMap :: [DebugBlock] -> LabelMap DebugBlock
+debugToMap = mapUnions . map go
+   where go b = mapInsert (dblLabel b) b $ mapUnions $ map go (dblBlocks b)
+
+-- | Maps registers to expressions that yield their "old" values
+-- further up the stack. Most interesting for the stack pointer Sp,
+-- but might be useful to document saved registers, too.
+type UnwindTable = Map.Map GlobalReg UnwindExpr
+
+-- | Expressions, used for unwind information
+data UnwindExpr = UwConst Int                   -- ^ literal value
+                | UwReg GlobalReg Int           -- ^ register plus offset
+                | UwDeref UnwindExpr            -- ^ pointer dereferencing
+                | UwPlus UnwindExpr UnwindExpr
+                | UwMinus UnwindExpr UnwindExpr
+                | UwTimes UnwindExpr UnwindExpr
+                deriving (Eq)
+
+instance Outputable UnwindExpr where
+  pprPrec _ (UwConst i)     = ppr i
+  pprPrec _ (UwReg g 0)     = ppr g
+  pprPrec p (UwReg g x)     = pprPrec p (UwPlus (UwReg g 0) (UwConst x))
+  pprPrec _ (UwDeref e)     = char '*' <> pprPrec 3 e
+  pprPrec p (UwPlus e0 e1)  | p <= 0
+                            = pprPrec 0 e0 <> char '+' <> pprPrec 0 e1
+  pprPrec p (UwMinus e0 e1) | p <= 0
+                            = pprPrec 1 e0 <> char '-' <> pprPrec 1 e1
+  pprPrec p (UwTimes e0 e1) | p <= 1
+                            = pprPrec 2 e0 <> char '*' <> pprPrec 2 e1
+  pprPrec _ other           = parens (pprPrec 0 other)
+
+extractUnwind :: CmmBlock -> UnwindTable
+extractUnwind b = go $ blockToList mid
+  where (_, mid, _) = blockSplit b
+        go :: [CmmNode O O] -> UnwindTable
+        go []       = Map.empty
+        go (x : xs) = case x of
+          CmmUnwind g so -> Map.insert g (toUnwindExpr so) $! go xs
+          CmmTick {}     -> go xs
+          _other         -> Map.empty -- TODO: Unwind statements after actual instructions
+
+-- | Conversion of Cmm expressions to unwind expressions. We check for
+-- unsupported operator usages and simplify the expression as far as
+-- possible.
+toUnwindExpr :: CmmExpr -> UnwindExpr
+toUnwindExpr (CmmLit (CmmInt i _))       = UwConst (fromIntegral i)
+toUnwindExpr (CmmRegOff (CmmGlobal g) i) = UwReg g i
+toUnwindExpr (CmmReg (CmmGlobal g))      = UwReg g 0
+toUnwindExpr (CmmLoad e _)               = UwDeref (toUnwindExpr e)
+toUnwindExpr e@(CmmMachOp op [e1, e2])   =
+  case (op, toUnwindExpr e1, toUnwindExpr e2) of
+    (MO_Add{}, UwReg r x, UwConst y) -> UwReg r (x + y)
+    (MO_Sub{}, UwReg r x, UwConst y) -> UwReg r (x - y)
+    (MO_Add{}, UwConst x, UwReg r y) -> UwReg r (x + y)
+    (MO_Add{}, UwConst x, UwConst y) -> UwConst (x + y)
+    (MO_Sub{}, UwConst x, UwConst y) -> UwConst (x - y)
+    (MO_Mul{}, UwConst x, UwConst y) -> UwConst (x * y)
+    (MO_Add{}, u1,        u2       ) -> UwPlus u1 u2
+    (MO_Sub{}, u1,        u2       ) -> UwMinus u1 u2
+    (MO_Mul{}, u1,        u2       ) -> UwTimes u1 u2
+    _otherwise                       -> pprPanic "Unsupported operator in unwind expression!" (pprExpr e)
+toUnwindExpr e
+  = pprPanic "Unsupported unwind expression!" (ppr e)
+
+-- | Generates debug data into a buffer
+writeDebugToEventlog :: DynFlags -> ModLocation -> [DebugBlock] -> IO (Int, ForeignPtr Word8)
+writeDebugToEventlog dflags mod_loc blocks = do
+
+  -- Write data into a binary memory handle
+  bh <- openBinMem $ 1024 * 1024
+  let code = do putEvent EVENT_DEBUG_MODULE $ do
+                  putString $ packageKeyString (thisPackage dflags)
+                  putString $ fromMaybe "???" $ ml_hs_file mod_loc
+                foldM (putBlock maxBound) 0 blocks
+  void $ runPutDbg code bh dflags emptyUFM
+  getBinMemBuf bh
+
+-- | Packs the given static value into a (variable-length) event-log
+-- packet.
+putEvent :: Word8 -> PutDbgM () -> PutDbgM ()
+putEvent id cts
+  = PutDbgM $ \bh df cm ->
+     let wrap = do
+           put_ bh id
+           -- Put placeholder for size
+           sizePos <- put bh (0 :: Word16)
+           -- Put contents
+           res <- runPutDbg cts bh df cm
+           -- Put final size
+           endPos <- tellBin bh
+           putAt bh sizePos $ fromIntegral $ (endPos `diffBin` sizePos) - 2
+           -- Seek back
+           seekBin bh endPos
+           return res
+     in do catchSize bh 0x10000 wrap (return (cm, ()))
+
+-- | Puts an alternate version if the first one is bigger than the
+-- given limit.
+--
+-- This is a pretty crude way of handling oversized
+-- packets... Can't think of a better way right now though.
+catchSize :: BinHandle -> Int -> IO a -> IO a -> IO a
+catchSize bh limit cts1 cts2 = do
+
+  -- Put contents, note how much size it uses
+  start <- tellBin bh :: IO (Bin ())
+  a <- cts1
+  end <- tellBin bh
+
+  -- Seek back and put second version if size is over limit
+  if (end `diffBin` start) >= limit
+    then seekBin bh start >> cts2
+    else return a
+
+type BlockId = Word16
+
+putBlock :: BlockId -> BlockId -> DebugBlock -> PutDbgM BlockId
+putBlock pid bid block = do
+  -- Put sub-blocks
+  bid' <- foldM (putBlock bid) (bid+1) (dblBlocks block)
+  -- Write our own data
+  putEvent EVENT_DEBUG_BLOCK $ do
+    putDbg bid
+    putDbg pid
+    dflags <- getDynFlags
+    let showSDocC = flip (renderWithStyle dflags) (mkCodeStyle CStyle)
+    putString $ showSDocC $ ppr $ dblCLabel block
+  -- Write annotations.
+  mapM_ putAnnotEvent (dblTicks block)
+  return bid'
+
+putAnnotEvent :: RawTickish -> PutDbgM ()
+putAnnotEvent (SourceNote ss names) =
+  putEvent EVENT_DEBUG_SOURCE $ do
+    putDbg $ encLoc $ srcSpanStartLine ss
+    putDbg $ encLoc $ srcSpanStartCol ss
+    putDbg $ encLoc $ srcSpanEndLine ss
+    putDbg $ encLoc $ srcSpanEndCol ss
+    putString $ unpackFS $ srcSpanFile ss
+    putString names
+ where encLoc x = fromIntegral x :: Word16
+
+putAnnotEvent (CoreNote lbl corePtr)
+  -- This piece of core was already covered earlier in this block?
+  = do elem <- elemCoreMap (lbl, exprPtrCons corePtr)
+       when (not elem) $ putEvent EVENT_DEBUG_CORE $ do
+         dflags <- getDynFlags
+         putString $ showSDocDump dflags $ ppr lbl
+         -- Emit core, leaving out (= referencing) any core pieces
+         -- that were emitted from sub-blocks
+         case corePtr of
+           ExprPtr core -> putCoreExpr core >> addToCoreMap lbl DEFAULT
+           AltPtr  alt  -> putCoreAlt alt >> addToCoreMap lbl (fstOf3 alt)
+
+putAnnotEvent _ = return ()
+
+-- | Constants for core binary representation
+coreMisc, coreApp, coreRef, coreLam, coreLet, coreCase, coreAlt :: Word8
+coreMisc = 0
+coreApp  = 1
+coreRef  = 2
+coreLam  = 3
+coreLet  = 4
+coreCase = 5
+coreAlt  = 6
+
+type CoreMap = UniqFM [AltCon]
+newtype PutDbgM a = PutDbgM { runPutDbg :: BinHandle -> DynFlags -> CoreMap -> IO (CoreMap, a) }
+
+instance Functor PutDbgM where
+  fmap f m = PutDbgM $ \bh df cm -> runPutDbg m bh df cm >>= \(cm', a) -> return (cm', f a)
+instance Monad PutDbgM where
+  return x = PutDbgM $ \_ _ cm -> return (cm, x)
+  m >>= f = PutDbgM $ \bh df cm -> runPutDbg m bh df cm >>= \(cm', a) -> runPutDbg (f a) bh df cm'
+instance Applicative PutDbgM where
+  pure = return
+  (<*>) = ap
+
+instance HasDynFlags PutDbgM where
+  getDynFlags = PutDbgM $ \_ df cm -> return (cm,df)
+
+putDbg :: Binary a => a -> PutDbgM ()
+putDbg x = PutDbgM $ \bf _ cm -> put_ bf x >> return (cm,())
+
+-- | Put a C-style string (null-terminated). We assume that the string
+-- is ASCII.
+--
+-- This could well be subject to change in future...
+putString :: String -> PutDbgM ()
+putString str = do
+  let putByte = putDbg :: Word8 -> PutDbgM ()
+  mapM_ (putByte . fromIntegral . ord) str
+  putByte 0
+
+putSDoc :: SDoc -> PutDbgM ()
+putSDoc str = do
+  dflags <- getDynFlags
+  putString $ showSDoc dflags str
+
+elemCoreMap :: (Var, AltCon) -> PutDbgM Bool
+elemCoreMap (bind, con) = PutDbgM $ \_ _ cm -> return $ (,) cm $
+  case lookupUFM cm bind of
+    Just cs -> con `elem` cs
+    Nothing -> False
+
+addToCoreMap :: Var -> AltCon -> PutDbgM ()
+addToCoreMap b a = PutDbgM $ \_ _ cm -> return (addToUFM_C (\o _ -> a:o) cm b [a], ())
+
+putCoreExpr :: CoreExpr -> PutDbgM ()
+putCoreExpr (App e1 e2) = do
+  putDbg coreApp
+  putCoreExpr e1
+  putCoreExpr e2
+putCoreExpr (Lam b e) = do
+  putDbg coreLam
+  putSDoc $ ppr b
+  putSDoc $ ppr $ varType b
+  putCoreExpr e
+putCoreExpr (Let es e) = do
+  putDbg coreLet
+  putCoreLet es
+  putCoreExpr e
+putCoreExpr (Case expr bind _ alts) = do
+  putDbg coreCase
+  putCoreExpr expr
+  putSDoc $ ppr bind
+  putSDoc $ ppr $ varType bind
+  putDbg (fromIntegral (length alts) :: Word16)
+  forM_ alts $ \alt@(a, _, _) ->
+    checkCoreRef (bind, a) $
+      putCoreAlt alt
+putCoreExpr (Cast e _) = putCoreExpr e
+putCoreExpr (Tick _ e) = putCoreExpr e
+-- All other elements are supposed to have a simple "pretty printed"
+-- representation that we can simply output verbatim.
+putCoreExpr other = do
+  putDbg coreMisc
+  putSDoc $ ppr other
+
+putCoreAlt :: CoreAlt -> PutDbgM ()
+putCoreAlt (a,binds,e) = do
+  putDbg coreAlt
+  putSDoc $ case a of
+    DEFAULT -> empty
+    _       -> ppr a
+  putDbg (fromIntegral (length binds) :: Word16)
+  forM_ binds $ \b -> do
+    putSDoc . ppr $ b
+    putSDoc . ppr . varType $ b
+  putCoreExpr e
+
+putCoreLet :: CoreBind -> PutDbgM ()
+putCoreLet (NonRec b e) = do
+  putDbg (1 :: Word16) -- could use 0 to mark non-recursive case?
+  putSDoc $ ppr b
+  putSDoc $ ppr $ varType b
+  checkCoreRef (b, DEFAULT) $ putCoreExpr e
+putCoreLet (Rec ps) = do
+  putDbg (fromIntegral $ length ps :: Word16)
+  forM_ ps $ \(b, e) -> do
+    putSDoc $ ppr b
+    putSDoc $ ppr $ varType b
+    checkCoreRef (b, DEFAULT) $ putCoreExpr e
+
+-- | Generate reference to core piece that was output elsewhere... Or
+-- proceed with given code otherwise.
+checkCoreRef :: (Var, AltCon) -> PutDbgM () -> PutDbgM ()
+checkCoreRef (b,a) code = do
+  elem <- elemCoreMap (b,a)
+  if elem
+    then do putDbg coreRef
+            dflags <- getDynFlags
+            putString $ showSDocDump dflags $ ppr b
+            putSDoc $ case a of
+              DEFAULT -> empty
+              _       -> ppr a
+    else do addToCoreMap b a
+            code
diff --git a/compiler/cmm/Hoopl.hs b/compiler/cmm/Hoopl.hs
index 08d95b5073ea..4b3717288f47 100644
--- a/compiler/cmm/Hoopl.hs
+++ b/compiler/cmm/Hoopl.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE RankNTypes, ScopedTypeVariables #-}
+
 module Hoopl (
     module Compiler.Hoopl,
     module Hoopl.Dataflow,
@@ -36,7 +38,7 @@ deepFwdRw f = deepFwdRw3 f f f
 -- But rw and rw' are single functions.
 thenFwdRw :: forall n f.
              FwdRewrite UniqSM n f
-          -> FwdRewrite UniqSM n f 
+          -> FwdRewrite UniqSM n f
           -> FwdRewrite UniqSM n f
 thenFwdRw rw3 rw3' = wrapFR2 thenrw rw3 rw3'
  where
@@ -124,3 +126,30 @@ badd_rw :: BwdRewrite UniqSM n f
         -> (Graph n e x, BwdRewrite UniqSM n f)
         -> (Graph n e x, BwdRewrite UniqSM n f)
 badd_rw rw2 (g, rw1) = (g, rw1 `thenBwdRw` rw2)
+
+-- Note [Deprecations in Hoopl]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+--
+-- CmmLive and CmmBuildInfoTables modules enable -fno-warn-warnings-deprecations
+-- flag because they import deprecated functions from Hoopl. I spent some time
+-- trying to figure out what is going on, so here's a brief explanation. The
+-- culprit is the joinOutFacts function, which should be replaced with
+-- joinFacts. The difference between them is that the latter one needs extra
+-- Label parameter. Labels identify blocks and are used in the fact base to
+-- assign facts to a block (in case you're wondering, Label is an Int wrapped in
+-- a newtype). Lattice join function is also required to accept a Label but the
+-- only reason why it is so are the debugging purposes: see joinInFacts function
+-- which is a no-op and is run only because join function might produce
+-- debugging output. Now, going back to the Cmm modules. The "problem" with the
+-- deprecated joinOutFacts function is that it passes wrong label when calling
+-- lattice join function: instead of label of a block for which we are joining
+-- facts it uses labels of successors of that block. So the joinFacts function
+-- expects to be given a label of a block for which we are joining facts. I
+-- don't see an obvious way of recovering that Label at the call sites of
+-- joinOutFacts (if that was easily done then joinFacts function could do it
+-- internally without requiring label as a parameter). A cheap way of
+-- eliminating these warnings would be to create a bogus Label, since none of
+-- our join functions is actually using the Label parameter. But that doesn't
+-- feel right. I think the real solution here is to fix Hoopl API, which is
+-- already broken in several ways. See Hoopl/Cleanup page on the wiki for more
+-- notes on improving Hoopl.
diff --git a/compiler/cmm/Hoopl/Dataflow.hs b/compiler/cmm/Hoopl/Dataflow.hs
index 78b930a20f7e..f5511515a931 100644
--- a/compiler/cmm/Hoopl/Dataflow.hs
+++ b/compiler/cmm/Hoopl/Dataflow.hs
@@ -1,3 +1,12 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE MultiParamTypeClasses  #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# OPTIONS_GHC -fprof-auto-top #-}
+
 --
 -- Copyright (c) 2010, João Dias, Simon Marlow, Simon Peyton Jones,
 -- and Norman Ramsey
@@ -9,10 +18,6 @@
 -- specialised to the UniqSM monad.
 --
 
-{-# LANGUAGE RankNTypes, ScopedTypeVariables, GADTs, EmptyDataDecls, PatternGuards, TypeFamilies, MultiParamTypeClasses #-}
-{-# OPTIONS_GHC -fprof-auto-top #-}
-{-# LANGUAGE Trustworthy #-}
-
 module Hoopl.Dataflow
   ( DataflowLattice(..), OldFact(..), NewFact(..), Fact, mkFactBase
   , ChangeFlag(..)
diff --git a/compiler/cmm/MkGraph.hs b/compiler/cmm/MkGraph.hs
index 6f9bbf8872ea..b2e7a7785227 100644
--- a/compiler/cmm/MkGraph.hs
+++ b/compiler/cmm/MkGraph.hs
@@ -1,7 +1,7 @@
-{-# LANGUAGE GADTs #-}
+{-# LANGUAGE BangPatterns, CPP, GADTs #-}
 
 module MkGraph
-  ( CmmAGraph, CgStmt(..)
+  ( CmmAGraph, CmmAGraphScoped, CgStmt(..)
   , (<*>), catAGraphs
   , mkLabel, mkMiddle, mkLast, outOfLine
   , lgraphOfAGraph, labelAGraph
@@ -13,6 +13,7 @@ module MkGraph
   , mkRawJump
   , mkCbranch, mkSwitch
   , mkReturn, mkComment, mkCallEntry, mkBranch
+  , mkUnwind
   , copyInOflow, copyOutOflow
   , noExtraStack
   , toCall, Transfer(..)
@@ -61,19 +62,20 @@ import Prelude (($),Int,Eq(..)) -- avoid importing (<*>)
 -- by providing a label for the entry point; see 'labelAGraph'.
 --
 type CmmAGraph = OrdList CgStmt
+type CmmAGraphScoped = (CmmAGraph, [CmmTickScope])
 
 data CgStmt
-  = CgLabel BlockId
+  = CgLabel BlockId [CmmTickScope]
   | CgStmt  (CmmNode O O)
   | CgLast  (CmmNode O C)
-  | CgFork  BlockId CmmAGraph
+  | CgFork  BlockId CmmAGraphScoped
 
-flattenCmmAGraph :: BlockId -> CmmAGraph -> CmmGraph
-flattenCmmAGraph id stmts =
+flattenCmmAGraph :: BlockId -> CmmAGraphScoped -> CmmGraph
+flattenCmmAGraph id stmts_t =
     CmmGraph { g_entry = id,
                g_graph = GMany NothingO body NothingO }
   where
-  body = foldr addBlock emptyBody $ flatten id stmts []
+  body = foldr addBlock emptyBody $ flatten id stmts_t []
 
   --
   -- flatten: given an entry label and a CmmAGraph, make a list of blocks.
@@ -81,9 +83,9 @@ flattenCmmAGraph id stmts =
   -- NB. avoid the quadratic-append trap by passing in the tail of the
   -- list.  This is important for Very Long Functions (e.g. in T783).
   --
-  flatten :: Label -> CmmAGraph -> [Block CmmNode C C] -> [Block CmmNode C C]
-  flatten id g blocks
-      = flatten1 (fromOL g) (blockJoinHead (CmmEntry id) emptyBlock) blocks
+  flatten :: Label -> CmmAGraphScoped -> [Block CmmNode C C] -> [Block CmmNode C C]
+  flatten id (g, tscope) blocks
+      = flatten1 (fromOL g) (blockJoinHead (CmmEntry id tscope) emptyBlock) blocks
 
   --
   -- flatten0: we are outside a block at this point: any code before
@@ -92,12 +94,12 @@ flattenCmmAGraph id stmts =
   flatten0 :: [CgStmt] -> [Block CmmNode C C] -> [Block CmmNode C C]
   flatten0 [] blocks = blocks
 
-  flatten0 (CgLabel id : stmts) blocks
+  flatten0 (CgLabel id tscope : stmts) blocks
     = flatten1 stmts block blocks
-    where !block = blockJoinHead (CmmEntry id) emptyBlock
+    where !block = blockJoinHead (CmmEntry id tscope) emptyBlock
 
-  flatten0 (CgFork fork_id stmts : rest) blocks
-    = flatten fork_id stmts $ flatten0 rest blocks
+  flatten0 (CgFork fork_id stmts_t : rest) blocks
+    = flatten fork_id stmts_t $ flatten0 rest blocks
 
   flatten0 (CgLast _ : stmts) blocks = flatten0 stmts blocks
   flatten0 (CgStmt _ : stmts) blocks = flatten0 stmts blocks
@@ -127,14 +129,14 @@ flattenCmmAGraph id stmts =
     = flatten1 stmts block' blocks
     where !block' = blockSnoc block stmt
 
-  flatten1 (CgFork fork_id stmts : rest) block blocks
-    = flatten fork_id stmts $ flatten1 rest block blocks
+  flatten1 (CgFork fork_id stmts_t : rest) block blocks
+    = flatten fork_id stmts_t $ flatten1 rest block blocks
 
   -- a label here means that we should start a new block, and the
   -- current block should fall through to the new block.
-  flatten1 (CgLabel id : stmts) block blocks
+  flatten1 (CgLabel id tscope : stmts) block blocks
     = blockJoinTail block (CmmBranch id) :
-      flatten1 stmts (blockJoinHead (CmmEntry id) emptyBlock) blocks
+      flatten1 stmts (blockJoinHead (CmmEntry id tscope) emptyBlock) blocks
 
 
 
@@ -147,8 +149,8 @@ catAGraphs     :: [CmmAGraph] -> CmmAGraph
 catAGraphs      = concatOL
 
 -- | created a sequence "goto id; id:" as an AGraph
-mkLabel        :: BlockId -> CmmAGraph
-mkLabel bid     = unitOL (CgLabel bid)
+mkLabel        :: BlockId -> [CmmTickScope] -> CmmAGraph
+mkLabel bid scp = unitOL (CgLabel bid scp)
 
 -- | creates an open AGraph from a given node
 mkMiddle        :: CmmNode O O -> CmmAGraph
@@ -159,16 +161,17 @@ mkLast         :: CmmNode O C -> CmmAGraph
 mkLast last     = unitOL (CgLast last)
 
 -- | A labelled code block; should end in a last node
-outOfLine      :: BlockId -> CmmAGraph -> CmmAGraph
-outOfLine l g   = unitOL (CgFork l g)
+outOfLine      :: BlockId -> CmmAGraphScoped -> CmmAGraph
+outOfLine l c   = unitOL (CgFork l c)
 
 -- | allocate a fresh label for the entry point
-lgraphOfAGraph :: CmmAGraph -> UniqSM CmmGraph
-lgraphOfAGraph g = do u <- getUniqueM
-                      return (labelAGraph (mkBlockId u) g)
+lgraphOfAGraph :: CmmAGraphScoped -> UniqSM CmmGraph
+lgraphOfAGraph g = do
+  u <- getUniqueM
+  return (labelAGraph (mkBlockId u) g)
 
 -- | use the given BlockId as the label of the entry point
-labelAGraph    :: BlockId -> CmmAGraph -> CmmGraph
+labelAGraph    :: BlockId -> CmmAGraphScoped -> CmmGraph
 labelAGraph lbl ag = flattenCmmAGraph lbl ag
 
 ---------- No-ops
@@ -263,6 +266,8 @@ mkJumpReturnsTo dflags f callConv actuals ret_lbl ret_off updfr_off  = do
 mkUnsafeCall  :: ForeignTarget -> [CmmFormal] -> [CmmActual] -> CmmAGraph
 mkUnsafeCall t fs as = mkMiddle $ CmmUnsafeForeignCall t fs as
 
+mkUnwind :: GlobalReg -> CmmExpr -> CmmAGraph
+mkUnwind g e = mkMiddle $ CmmUnwind g e
 
 --------------------------------------------------------------------------
 
diff --git a/compiler/cmm/PprC.hs b/compiler/cmm/PprC.hs
index 23989811ddf8..90252853177f 100644
--- a/compiler/cmm/PprC.hs
+++ b/compiler/cmm/PprC.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE CPP, GADTs #-}
+
 -----------------------------------------------------------------------------
 --
 -- Pretty-printing of Cmm as C, suitable for feeding gcc
@@ -16,7 +18,6 @@
 --
 -----------------------------------------------------------------------------
 
-{-# LANGUAGE GADTs #-}
 module PprC (
         writeCs,
         pprStringInCStyle
@@ -137,10 +138,10 @@ pprTop (CmmData _section (Statics lbl lits)) =
 
 pprBBlock :: CmmBlock -> SDoc
 pprBBlock block =
-  nest 4 (pprBlockId lbl <> colon) $$
+  nest 4 (pprBlockId (entryLabel block) <> colon) $$
   nest 8 (vcat (map pprStmt (blockToList nodes)) $$ pprStmt last)
  where
-  (CmmEntry lbl, nodes, last)  = blockSplit block
+  (_, nodes, last)  = blockSplit block
 
 -- --------------------------------------------------------------------------
 -- Info tables. Just arrays of words.
@@ -170,13 +171,15 @@ pprStmt :: CmmNode e x -> SDoc
 pprStmt stmt =
     sdocWithDynFlags $ \dflags ->
     case stmt of
-    CmmEntry _ -> empty
+    CmmEntry{}   -> empty
     CmmComment _ -> empty -- (hang (ptext (sLit "/*")) 3 (ftext s)) $$ ptext (sLit "*/")
                           -- XXX if the string contains "*/", we need to fix it
                           -- XXX we probably want to emit these comments when
                           -- some debugging option is on.  They can get quite
                           -- large.
 
+    CmmTick _ -> empty
+
     CmmAssign dest src -> pprAssign dflags dest src
 
     CmmStore  dest src
@@ -752,6 +755,12 @@ pprCallishMachOp_for_C mop
         MO_Memmove      -> ptext (sLit "memmove")
         (MO_BSwap w)    -> ptext (sLit $ bSwapLabel w)
         (MO_PopCnt w)   -> ptext (sLit $ popCntLabel w)
+        (MO_Clz w)      -> ptext (sLit $ clzLabel w)
+        (MO_Ctz w)      -> ptext (sLit $ ctzLabel w)
+        (MO_AtomicRMW w amop) -> ptext (sLit $ atomicRMWLabel w amop)
+        (MO_Cmpxchg w)  -> ptext (sLit $ cmpxchgLabel w)
+        (MO_AtomicRead w)  -> ptext (sLit $ atomicReadLabel w)
+        (MO_AtomicWrite w) -> ptext (sLit $ atomicWriteLabel w)
         (MO_UF_Conv w)  -> ptext (sLit $ word2FloatLabel w)
 
         MO_S_QuotRem  {} -> unsupported
diff --git a/compiler/cmm/PprCmm.hs b/compiler/cmm/PprCmm.hs
index 46257b4188b7..78d5c8a28364 100644
--- a/compiler/cmm/PprCmm.hs
+++ b/compiler/cmm/PprCmm.hs
@@ -1,3 +1,6 @@
+{-# LANGUAGE GADTs, TypeFamilies, FlexibleContexts, FlexibleInstances #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
 ----------------------------------------------------------------------------
 --
 -- Pretty-printing of Cmm as (a superset of) C--
@@ -30,8 +33,6 @@
 --
 -- A useful example pass over Cmm is in nativeGen/MachCodeGen.hs
 
-{-# OPTIONS_GHC -fno-warn-orphans #-}
-{-# LANGUAGE GADTs, TypeFamilies, FlexibleContexts #-}
 module PprCmm
   ( module PprCmmDecl
   , module PprCmmExpr
@@ -42,11 +43,13 @@ import BlockId ()
 import CLabel
 import Cmm
 import CmmUtils
+import DynFlags
 import FastString
 import Outputable
 import PprCmmDecl
 import PprCmmExpr
 import Util
+import PprCore ()
 
 import BasicTypes
 import Compiler.Hoopl
@@ -137,6 +140,9 @@ pprCmmGraph g
   $$ nest 2 (vcat $ map ppr blocks)
   $$ text "}"
   where blocks = postorderDfs g
+    -- postorderDfs has the side-effect of discarding unreachable code,
+    -- so pretty-printed Cmm will omit any unreachable blocks.  This can
+    -- sometimes be confusing.
 
 ---------------------------------------------
 -- Outputting CmmNode and types which it contains
@@ -175,13 +181,23 @@ pprNode :: CmmNode e x -> SDoc
 pprNode node = pp_node <+> pp_debug
   where
     pp_node :: SDoc
-    pp_node = case node of
+    pp_node = sdocWithDynFlags $ \dflags -> case node of
       -- label:
-      CmmEntry id -> ppr id <> colon
+      CmmEntry id tscope -> ppr id <> colon <+>
+         (sdocWithDynFlags $ \dflags ->
+           ppWhen (gopt Opt_PprShowTicks dflags) (text "//" <+> ppr tscope))
 
       -- // text
       CmmComment s -> text "//" <+> ftext s
 
+      -- //tick bla<...>
+      CmmTick t -> if gopt Opt_PprShowTicks dflags
+                   then ptext (sLit "//tick") <+> ppr t
+                   else empty
+
+      -- unwind reg = expr;
+      CmmUnwind r e -> ptext (sLit "unwind ") <> ppr r <+> char '=' <+> ppr e
+
       -- reg = expr;
       CmmAssign reg expr -> ppr reg <+> equals <+> ppr expr <> semi
 
@@ -264,6 +280,8 @@ pprNode node = pp_node <+> pp_debug
       else case node of
              CmmEntry {}             -> empty -- Looks terrible with text "  // CmmEntry"
              CmmComment {}           -> empty -- Looks also terrible with text "  // CmmComment"
+             CmmTick {}              -> empty -- Looks equally bad with text "  // CmmTick"
+             CmmUnwind {}            -> text "  // CmmUnwind"
              CmmAssign {}            -> text "  // CmmAssign"
              CmmStore {}             -> text "  // CmmStore"
              CmmUnsafeForeignCall {} -> text "  // CmmUnsafeForeignCall"
diff --git a/compiler/cmm/PprCmmDecl.hs b/compiler/cmm/PprCmmDecl.hs
index 354a3d456330..dd80f5cd56b6 100644
--- a/compiler/cmm/PprCmmDecl.hs
+++ b/compiler/cmm/PprCmmDecl.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE CPP #-}
+
 ----------------------------------------------------------------------------
 --
 -- Pretty-printing of common Cmm types
diff --git a/compiler/cmm/SMRep.lhs b/compiler/cmm/SMRep.lhs
index 0185ababe50f..0713620c5a03 100644
--- a/compiler/cmm/SMRep.lhs
+++ b/compiler/cmm/SMRep.lhs
@@ -6,15 +6,17 @@
 Storage manager representation of closures
 
 \begin{code}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE CPP,GeneralizedNewtypeDeriving #-}
 
 module SMRep (
         -- * Words and bytes
+        WordOff, ByteOff,
+        wordsToBytes, bytesToWordsRoundUp,
+        roundUpToWords,
+
         StgWord, fromStgWord, toStgWord,
         StgHalfWord, fromStgHalfWord, toStgHalfWord,
         hALF_WORD_SIZE, hALF_WORD_SIZE_IN_BITS,
-        WordOff, ByteOff,
-        roundUpToWords,
 
         -- * Closure repesentation
         SMRep(..), -- CmmInfo sees the rep; no one else does
@@ -23,21 +25,27 @@ module SMRep (
         ConstrDescription,
 
         -- ** Construction
-        mkHeapRep, blackHoleRep, indStaticRep, mkStackRep, mkRTSRep,
+        mkHeapRep, blackHoleRep, indStaticRep, mkStackRep, mkRTSRep, arrPtrsRep,
+        smallArrPtrsRep, arrWordsRep,
 
         -- ** Predicates
         isStaticRep, isConRep, isThunkRep, isFunRep, isStaticNoCafCon,
         isStackRep,
 
         -- ** Size-related things
-        heapClosureSize,
-        fixedHdrSize, arrWordsHdrSize, arrPtrsHdrSize,
-        profHdrSize, thunkHdrSize, nonHdrSize,
+        heapClosureSizeW,
+        fixedHdrSizeW, arrWordsHdrSize, arrWordsHdrSizeW, arrPtrsHdrSize,
+        arrPtrsHdrSizeW, profHdrSize, thunkHdrSize, nonHdrSize, nonHdrSizeW,
+        smallArrPtrsHdrSize, smallArrPtrsHdrSizeW, hdrSize, hdrSizeW,
+        fixedHdrSize,
 
         -- ** RTS closure types
         rtsClosureType, rET_SMALL, rET_BIG,
         aRG_GEN, aRG_GEN_BIG,
 
+        -- ** Arrays
+        card, cardRoundUp, cardTableSizeB, cardTableSizeW,
+
         -- * Operations over [Word8] strings that don't belong here
         pprWord8String, stringToWord8s
     ) where
@@ -63,11 +71,33 @@ import Data.Bits
 %************************************************************************
 
 \begin{code}
-type WordOff = Int -- Word offset, or word count
-type ByteOff = Int -- Byte offset, or byte count
+-- | Word offset, or word count
+type WordOff = Int
 
+-- | Byte offset, or byte count
+type ByteOff = Int
+
+-- | Round up the given byte count to the next byte count that's a
+-- multiple of the machine's word size.
 roundUpToWords :: DynFlags -> ByteOff -> ByteOff
-roundUpToWords dflags n = (n + (wORD_SIZE dflags - 1)) .&. (complement (wORD_SIZE dflags - 1))
+roundUpToWords dflags n =
+  (n + (wORD_SIZE dflags - 1)) .&. (complement (wORD_SIZE dflags - 1))
+
+-- | Convert the given number of words to a number of bytes.
+--
+-- This function morally has type @WordOff -> ByteOff@, but uses @Num
+-- a@ to allow for overloading.
+wordsToBytes :: Num a => DynFlags -> a -> a
+wordsToBytes dflags n = fromIntegral (wORD_SIZE dflags) * n
+{-# SPECIALIZE wordsToBytes :: DynFlags -> Int -> Int #-}
+{-# SPECIALIZE wordsToBytes :: DynFlags -> Word -> Word #-}
+{-# SPECIALIZE wordsToBytes :: DynFlags -> Integer -> Integer #-}
+
+-- | First round the given byte count up to a multiple of the
+-- machine's word size and then convert the result to words.
+bytesToWordsRoundUp :: DynFlags -> ByteOff -> WordOff
+bytesToWordsRoundUp dflags n = (n + word_size - 1) `quot` word_size
+ where word_size = wORD_SIZE dflags
 \end{code}
 
 StgWord is a type representing an StgWord on the target platform.
@@ -140,6 +170,16 @@ data SMRep
         !WordOff         --  # non-ptr words INCLUDING SLOP (see mkHeapRep below)
         ClosureTypeInfo  -- type-specific info
 
+  | ArrayPtrsRep
+        !WordOff        -- # ptr words
+        !WordOff        -- # card table words
+
+  | SmallArrayPtrsRep
+        !WordOff        -- # ptr words
+
+  | ArrayWordsRep
+        !WordOff        -- # bytes expressed in words, rounded up
+
   | StackRep            -- Stack frame (RET_SMALL or RET_BIG)
         Liveness
 
@@ -221,13 +261,22 @@ blackHoleRep = HeapRep False 0 0 BlackHole
 indStaticRep :: SMRep
 indStaticRep = HeapRep True 1 0 IndStatic
 
+arrPtrsRep :: DynFlags -> WordOff -> SMRep
+arrPtrsRep dflags elems = ArrayPtrsRep elems (cardTableSizeW dflags elems)
+
+smallArrPtrsRep :: WordOff -> SMRep
+smallArrPtrsRep elems = SmallArrayPtrsRep elems
+
+arrWordsRep :: DynFlags -> ByteOff -> SMRep
+arrWordsRep dflags bytes = ArrayWordsRep (bytesToWordsRoundUp dflags bytes)
+
 -----------------------------------------------------------------------------
 -- Predicates
 
 isStaticRep :: SMRep -> IsStatic
 isStaticRep (HeapRep is_static _ _ _) = is_static
-isStaticRep (StackRep {})             = False
 isStaticRep (RTSRep _ rep)            = isStaticRep rep
+isStaticRep _                         = False
 
 isStackRep :: SMRep -> Bool
 isStackRep StackRep{}     = True
@@ -259,9 +308,12 @@ isStaticNoCafCon _                           = False
 -----------------------------------------------------------------------------
 -- Size-related things
 
+fixedHdrSize :: DynFlags -> ByteOff
+fixedHdrSize dflags = wordsToBytes dflags (fixedHdrSizeW dflags)
+
 -- | Size of a closure header (StgHeader in includes/rts/storage/Closures.h)
-fixedHdrSize :: DynFlags -> WordOff
-fixedHdrSize dflags = sTD_HDR_SIZE dflags + profHdrSize dflags
+fixedHdrSizeW :: DynFlags -> WordOff
+fixedHdrSizeW dflags = sTD_HDR_SIZE dflags + profHdrSize dflags
 
 -- | Size of the profiling part of a closure header
 -- (StgProfHeader in includes/rts/storage/Closures.h)
@@ -273,32 +325,73 @@ profHdrSize dflags
 -- | The garbage collector requires that every closure is at least as
 --   big as this.
 minClosureSize :: DynFlags -> WordOff
-minClosureSize dflags = fixedHdrSize dflags + mIN_PAYLOAD_SIZE dflags
+minClosureSize dflags = fixedHdrSizeW dflags + mIN_PAYLOAD_SIZE dflags
 
 arrWordsHdrSize :: DynFlags -> ByteOff
 arrWordsHdrSize dflags
- = fixedHdrSize dflags * wORD_SIZE dflags + sIZEOF_StgArrWords_NoHdr dflags
+ = fixedHdrSize dflags + sIZEOF_StgArrWords_NoHdr dflags
+
+arrWordsHdrSizeW :: DynFlags -> WordOff
+arrWordsHdrSizeW dflags =
+    fixedHdrSizeW dflags +
+    (sIZEOF_StgArrWords_NoHdr dflags `quot` wORD_SIZE dflags)
 
 arrPtrsHdrSize :: DynFlags -> ByteOff
 arrPtrsHdrSize dflags
- = fixedHdrSize dflags * wORD_SIZE dflags + sIZEOF_StgMutArrPtrs_NoHdr dflags
+ = fixedHdrSize dflags + sIZEOF_StgMutArrPtrs_NoHdr dflags
+
+arrPtrsHdrSizeW :: DynFlags -> WordOff
+arrPtrsHdrSizeW dflags =
+    fixedHdrSizeW dflags +
+    (sIZEOF_StgMutArrPtrs_NoHdr dflags `quot` wORD_SIZE dflags)
+
+smallArrPtrsHdrSize :: DynFlags -> ByteOff
+smallArrPtrsHdrSize dflags
+ = fixedHdrSize dflags + sIZEOF_StgSmallMutArrPtrs_NoHdr dflags
+
+smallArrPtrsHdrSizeW :: DynFlags -> WordOff
+smallArrPtrsHdrSizeW dflags =
+    fixedHdrSizeW dflags +
+    (sIZEOF_StgSmallMutArrPtrs_NoHdr dflags `quot` wORD_SIZE dflags)
 
 -- Thunks have an extra header word on SMP, so the update doesn't
 -- splat the payload.
 thunkHdrSize :: DynFlags -> WordOff
-thunkHdrSize dflags = fixedHdrSize dflags + smp_hdr
+thunkHdrSize dflags = fixedHdrSizeW dflags + smp_hdr
         where smp_hdr = sIZEOF_StgSMPThunkHeader dflags `quot` wORD_SIZE dflags
 
-
-nonHdrSize :: SMRep -> WordOff
-nonHdrSize (HeapRep _ p np _) = p + np
-nonHdrSize (StackRep bs)      = length bs
-nonHdrSize (RTSRep _ rep)     = nonHdrSize rep
-
-heapClosureSize :: DynFlags -> SMRep -> WordOff
-heapClosureSize dflags (HeapRep _ p np ty)
+hdrSize :: DynFlags -> SMRep -> ByteOff
+hdrSize dflags rep = wordsToBytes dflags (hdrSizeW dflags rep)
+
+hdrSizeW :: DynFlags -> SMRep -> WordOff
+hdrSizeW dflags (HeapRep _ _ _ ty)    = closureTypeHdrSize dflags ty
+hdrSizeW dflags (ArrayPtrsRep _ _)    = arrPtrsHdrSizeW dflags
+hdrSizeW dflags (SmallArrayPtrsRep _) = smallArrPtrsHdrSizeW dflags
+hdrSizeW dflags (ArrayWordsRep _)     = arrWordsHdrSizeW dflags
+hdrSizeW _ _                          = panic "SMRep.hdrSizeW"
+
+nonHdrSize :: DynFlags -> SMRep -> ByteOff
+nonHdrSize dflags rep = wordsToBytes dflags (nonHdrSizeW rep)
+
+nonHdrSizeW :: SMRep -> WordOff
+nonHdrSizeW (HeapRep _ p np _) = p + np
+nonHdrSizeW (ArrayPtrsRep elems ct) = elems + ct
+nonHdrSizeW (SmallArrayPtrsRep elems) = elems
+nonHdrSizeW (ArrayWordsRep words) = words
+nonHdrSizeW (StackRep bs)      = length bs
+nonHdrSizeW (RTSRep _ rep)     = nonHdrSizeW rep
+
+-- | The total size of the closure, in words.
+heapClosureSizeW :: DynFlags -> SMRep -> WordOff
+heapClosureSizeW dflags (HeapRep _ p np ty)
  = closureTypeHdrSize dflags ty + p + np
-heapClosureSize _ _ = panic "SMRep.heapClosureSize"
+heapClosureSizeW dflags (ArrayPtrsRep elems ct)
+ = arrPtrsHdrSizeW dflags + elems + ct
+heapClosureSizeW dflags (SmallArrayPtrsRep elems)
+ = smallArrPtrsHdrSizeW dflags + elems
+heapClosureSizeW dflags (ArrayWordsRep words)
+ = arrWordsHdrSizeW dflags + words
+heapClosureSizeW _ _ = panic "SMRep.heapClosureSize"
 
 closureTypeHdrSize :: DynFlags -> ClosureTypeInfo -> WordOff
 closureTypeHdrSize dflags ty = case ty of
@@ -306,13 +399,34 @@ closureTypeHdrSize dflags ty = case ty of
                   ThunkSelector{} -> thunkHdrSize dflags
                   BlackHole{}     -> thunkHdrSize dflags
                   IndStatic{}     -> thunkHdrSize dflags
-                  _               -> fixedHdrSize dflags
+                  _               -> fixedHdrSizeW dflags
         -- All thunks use thunkHdrSize, even if they are non-updatable.
         -- this is because we don't have separate closure types for
         -- updatable vs. non-updatable thunks, so the GC can't tell the
         -- difference.  If we ever have significant numbers of non-
         -- updatable thunks, it might be worth fixing this.
 
+-- ---------------------------------------------------------------------------
+-- Arrays
+
+-- | The byte offset into the card table of the card for a given element
+card :: DynFlags -> Int -> Int
+card dflags i = i `shiftR` mUT_ARR_PTRS_CARD_BITS dflags
+
+-- | Convert a number of elements to a number of cards, rounding up
+cardRoundUp :: DynFlags -> Int -> Int
+cardRoundUp dflags i =
+  card dflags (i + ((1 `shiftL` mUT_ARR_PTRS_CARD_BITS dflags) - 1))
+
+-- | The size of a card table, in bytes
+cardTableSizeB :: DynFlags -> Int -> ByteOff
+cardTableSizeB dflags elems = cardRoundUp dflags elems
+
+-- | The size of a card table, in words
+cardTableSizeW :: DynFlags -> Int -> WordOff
+cardTableSizeW dflags elems =
+  bytesToWordsRoundUp dflags (cardTableSizeB dflags elems)
+
 -----------------------------------------------------------------------------
 -- deriving the RTS closure type from an SMRep
 
@@ -403,6 +517,12 @@ instance Outputable SMRep where
        pp_n _ 0 = empty
        pp_n s n = int n <+> text s
 
+   ppr (ArrayPtrsRep size _) = ptext (sLit "ArrayPtrsRep") <+> ppr size
+
+   ppr (SmallArrayPtrsRep size) = ptext (sLit "SmallArrayPtrsRep") <+> ppr size
+
+   ppr (ArrayWordsRep words) = ptext (sLit "ArrayWordsRep") <+> ppr words
+
    ppr (StackRep bs) = ptext (sLit "StackRep") <+> ppr bs
 
    ppr (RTSRep ty rep) = ptext (sLit "tag:") <> ppr ty <+> ppr rep
diff --git a/compiler/codeGen/CgUtils.hs b/compiler/codeGen/CgUtils.hs
index 6b36ab09cd22..51b8ed9ec8c3 100644
--- a/compiler/codeGen/CgUtils.hs
+++ b/compiler/codeGen/CgUtils.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE CPP, GADTs #-}
+
 -----------------------------------------------------------------------------
 --
 -- Code generator utilities; mostly monadic
@@ -6,7 +8,6 @@
 --
 -----------------------------------------------------------------------------
 
-{-# LANGUAGE GADTs #-}
 module CgUtils ( fixStgRegisters ) where
 
 #include "HsVersions.h"
diff --git a/compiler/codeGen/CodeGen/Platform/ARM.hs b/compiler/codeGen/CodeGen/Platform/ARM.hs
index 727a43561fd8..5d1148496c2a 100644
--- a/compiler/codeGen/CodeGen/Platform/ARM.hs
+++ b/compiler/codeGen/CodeGen/Platform/ARM.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 
 module CodeGen.Platform.ARM where
 
diff --git a/compiler/codeGen/CodeGen/Platform/NoRegs.hs b/compiler/codeGen/CodeGen/Platform/NoRegs.hs
index c4c63b7572eb..0c85ffbda77a 100644
--- a/compiler/codeGen/CodeGen/Platform/NoRegs.hs
+++ b/compiler/codeGen/CodeGen/Platform/NoRegs.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 
 module CodeGen.Platform.NoRegs where
 
diff --git a/compiler/codeGen/CodeGen/Platform/PPC.hs b/compiler/codeGen/CodeGen/Platform/PPC.hs
index bcbdfe244b09..76a2b020ac37 100644
--- a/compiler/codeGen/CodeGen/Platform/PPC.hs
+++ b/compiler/codeGen/CodeGen/Platform/PPC.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 
 module CodeGen.Platform.PPC where
 
diff --git a/compiler/codeGen/CodeGen/Platform/PPC_Darwin.hs b/compiler/codeGen/CodeGen/Platform/PPC_Darwin.hs
index 42bf22f26c97..a98e558cc10e 100644
--- a/compiler/codeGen/CodeGen/Platform/PPC_Darwin.hs
+++ b/compiler/codeGen/CodeGen/Platform/PPC_Darwin.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 
 module CodeGen.Platform.PPC_Darwin where
 
diff --git a/compiler/codeGen/CodeGen/Platform/SPARC.hs b/compiler/codeGen/CodeGen/Platform/SPARC.hs
index b49af144096b..991f515eaf4d 100644
--- a/compiler/codeGen/CodeGen/Platform/SPARC.hs
+++ b/compiler/codeGen/CodeGen/Platform/SPARC.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 
 module CodeGen.Platform.SPARC where
 
diff --git a/compiler/codeGen/CodeGen/Platform/X86.hs b/compiler/codeGen/CodeGen/Platform/X86.hs
index 6dd74df130a5..e74807ff88d5 100644
--- a/compiler/codeGen/CodeGen/Platform/X86.hs
+++ b/compiler/codeGen/CodeGen/Platform/X86.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 
 module CodeGen.Platform.X86 where
 
diff --git a/compiler/codeGen/CodeGen/Platform/X86_64.hs b/compiler/codeGen/CodeGen/Platform/X86_64.hs
index 190d642ea6ca..102132d6797b 100644
--- a/compiler/codeGen/CodeGen/Platform/X86_64.hs
+++ b/compiler/codeGen/CodeGen/Platform/X86_64.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 
 module CodeGen.Platform.X86_64 where
 
diff --git a/compiler/codeGen/StgCmm.hs b/compiler/codeGen/StgCmm.hs
index a92f80439bfa..efc89fe04a82 100644
--- a/compiler/codeGen/StgCmm.hs
+++ b/compiler/codeGen/StgCmm.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE CPP #-}
+
 -----------------------------------------------------------------------------
 --
 -- Stg to C-- code generation
@@ -37,7 +39,6 @@ import DataCon
 import Name
 import TyCon
 import Module
-import ErrUtils
 import Outputable
 import Stream
 import BasicTypes
@@ -60,9 +61,7 @@ codeGen :: DynFlags
 
 codeGen dflags this_mod data_tycons
         cost_centre_info stg_binds hpc_info
-  = do  { liftIO $ showPass dflags "New CodeGen"
-
-              -- cg: run the code generator, and yield the resulting CmmGroup
+  = do  {     -- cg: run the code generator, and yield the resulting CmmGroup
               -- Using an IORef to store the state is a bit crude, but otherwise
               -- we would need to add a state monad layer.
         ; cgref <- liftIO $ newIORef =<< initC
diff --git a/compiler/codeGen/StgCmmBind.hs b/compiler/codeGen/StgCmmBind.hs
index 23367926c763..5fcea81fdd9c 100644
--- a/compiler/codeGen/StgCmmBind.hs
+++ b/compiler/codeGen/StgCmmBind.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE CPP #-}
+
 -----------------------------------------------------------------------------
 --
 -- Stg to C-- code generation: bindings
@@ -29,7 +31,7 @@ import StgCmmClosure
 import StgCmmForeign    (emitPrimCall)
 
 import MkGraph
-import CoreSyn          ( AltCon(..) )
+import CoreSyn          ( AltCon(..), tickishIsCode )
 import SMRep
 import Cmm
 import CmmInfo
@@ -46,7 +48,6 @@ import Util
 import BasicTypes
 import Outputable
 import FastString
-import Maybes
 import DynFlags
 
 import Control.Monad
@@ -262,14 +263,22 @@ mkRhsClosure    dflags bndr _cc _bi
                 [NonVoid the_fv]                -- Just one free var
                 upd_flag                -- Updatable thunk
                 []                      -- A thunk
-                (StgCase (StgApp scrutinee [{-no args-}])
-                      _ _ _ _   -- ignore uniq, etc.
-                      (AlgAlt _)
-                      [(DataAlt _, params, _use_mask,
-                            (StgApp selectee [{-no args-}]))])
-  |  the_fv == scrutinee                -- Scrutinee is the only free variable
-  && maybeToBool maybe_offset           -- Selectee is a component of the tuple
-  && offset_into_int <= mAX_SPEC_SELECTEE_SIZE dflags -- Offset is small enough
+                expr
+  | let strip = snd . stripStgTicksTop (not . tickishIsCode) -- ignore non-code ticks
+  , StgCase (StgApp scrutinee [{-no args-}])
+         _ _ _ _   -- ignore uniq, etc.
+         (AlgAlt _)
+         [(DataAlt _, params, _use_mask, sel_expr)] <- strip expr
+  , StgApp selectee [{-no args-}] <- strip sel_expr
+  , the_fv == scrutinee                -- Scrutinee is the only free variable
+
+  , let (_, _, params_w_offsets) = mkVirtConstrOffsets dflags (addIdReps params)
+                                   -- Just want the layout
+  , Just the_offset <- assocMaybe params_w_offsets (NonVoid selectee)
+
+  , let offset_into_int = bytesToWordsRoundUp dflags the_offset
+                          - fixedHdrSizeW dflags
+  , offset_into_int <= mAX_SPEC_SELECTEE_SIZE dflags -- Offset is small enough
   = -- NOT TRUE: ASSERT(is_single_constructor)
     -- The simplifier may have statically determined that the single alternative
     -- is the only possible case and eliminated the others, even if there are
@@ -278,15 +287,8 @@ mkRhsClosure    dflags bndr _cc _bi
     -- will evaluate to.
     --
     -- srt is discarded; it must be empty
-    cgRhsStdThunk bndr lf_info [StgVarArg the_fv]
-  where
-    lf_info               = mkSelectorLFInfo bndr offset_into_int
-                                 (isUpdatable upd_flag)
-    (_, _, params_w_offsets) = mkVirtConstrOffsets dflags (addIdReps params)
-                               -- Just want the layout
-    maybe_offset          = assocMaybe params_w_offsets (NonVoid selectee)
-    Just the_offset       = maybe_offset
-    offset_into_int       = the_offset - fixedHdrSize dflags
+    let lf_info = mkSelectorLFInfo bndr offset_into_int (isUpdatable upd_flag)
+    in cgRhsStdThunk bndr lf_info [StgVarArg the_fv]
 
 ---------- Note [Ap thunks] ------------------
 mkRhsClosure    dflags bndr _cc _bi
@@ -341,7 +343,7 @@ mkRhsClosure dflags bndr cc _ fvs upd_flag args body
         ; dflags <- getDynFlags
         ; let   name  = idName bndr
                 descr = closureDescription dflags mod_name name
-                fv_details :: [(NonVoid Id, VirtualHpOffset)]
+                fv_details :: [(NonVoid Id, ByteOff)]
                 (tot_wds, ptr_wds, fv_details)
                    = mkVirtHeapOffsets dflags (isLFThunk lf_info)
                                        (addIdReps (map unsafe_stripNV reduced_fvs))
@@ -434,7 +436,7 @@ closureCodeBody :: Bool            -- whether this is a top-level binding
                 -> [NonVoid Id]    -- incoming args to the closure
                 -> Int             -- arity, including void args
                 -> StgExpr
-                -> [(NonVoid Id, VirtualHpOffset)] -- the closure's free vars
+                -> [(NonVoid Id, ByteOff)] -- the closure's free vars
                 -> FCode ()
 
 {- There are two main cases for the code for closures.
@@ -472,25 +474,21 @@ closureCodeBody top_lvl bndr cl_info cc args arity body fv_details
             \(_offset, node, arg_regs) -> do
                 -- Emit slow-entry code (for entering a closure through a PAP)
                 { mkSlowEntryCode bndr cl_info arg_regs
-
                 ; dflags <- getDynFlags
                 ; let node_points = nodeMustPointToIt dflags lf_info
                       node' = if node_points then Just node else Nothing
-                -- Emit new label that might potentially be a header
-                -- of a self-recursive tail call. See Note
-                -- [Self-recursive tail calls] in StgCmmExpr
                 ; loop_header_id <- newLabelC
-                ; emitLabel loop_header_id
-                ; when node_points (ldvEnterClosure cl_info (CmmLocal node))
                 -- Extend reader monad with information that
                 -- self-recursive tail calls can be optimized into local
-                -- jumps
+                -- jumps. See Note [Self-recursive tail calls] in StgCmmExpr.
                 ; withSelfLoop (bndr, loop_header_id, arg_regs) $ do
                 {
                 -- Main payload
                 ; entryHeapCheck cl_info node' arity arg_regs $ do
-                { -- ticky after heap check to avoid double counting
-                  tickyEnterFun cl_info
+                { -- emit LDV code when profiling
+                  when node_points (ldvEnterClosure cl_info (CmmLocal node))
+                -- ticky after heap check to avoid double counting
+                ; tickyEnterFun cl_info
                 ; enterCostCentreFun cc
                     (CmmMachOp (mo_wordSub dflags)
                          [ CmmReg (CmmLocal node) -- See [NodeReg clobbered with loopification]
@@ -518,10 +516,10 @@ closureCodeBody top_lvl bndr cl_info cc args arity body fv_details
 
 -- A function closure pointer may be tagged, so we
 -- must take it into account when accessing the free variables.
-bind_fv :: (NonVoid Id, VirtualHpOffset) -> FCode (LocalReg, WordOff)
+bind_fv :: (NonVoid Id, ByteOff) -> FCode (LocalReg, ByteOff)
 bind_fv (id, off) = do { reg <- rebindToReg id; return (reg, off) }
 
-load_fvs :: LocalReg -> LambdaFormInfo -> [(LocalReg, WordOff)] -> FCode ()
+load_fvs :: LocalReg -> LambdaFormInfo -> [(LocalReg, ByteOff)] -> FCode ()
 load_fvs node lf_info = mapM_ (\ (reg, off) ->
    do dflags <- getDynFlags
       let tag = lfDynTag dflags lf_info
@@ -551,11 +549,12 @@ mkSlowEntryCode bndr cl_info arg_regs -- function closure is already in `Node'
                                 (mkLblExpr fast_lbl)
                                 (map (CmmReg . CmmLocal) (node : arg_regs))
                                 (initUpdFrameOff dflags)
-       emitProcWithConvention Slow Nothing slow_lbl (node : arg_regs) jump
+       tscope <- getTickScope
+       emitProcWithConvention Slow Nothing slow_lbl (node : arg_regs) (jump, tscope)
   | otherwise = return ()
 
 -----------------------------------------
-thunkCode :: ClosureInfo -> [(NonVoid Id, VirtualHpOffset)] -> CostCentreStack
+thunkCode :: ClosureInfo -> [(NonVoid Id, ByteOff)] -> CostCentreStack
           -> LocalReg -> Int -> StgExpr -> FCode ()
 thunkCode cl_info fv_details _cc node arity body
   = do { dflags <- getDynFlags
@@ -624,7 +623,7 @@ emitBlackHoleCode node = do
              -- work with profiling.
 
   when eager_blackholing $ do
-    emitStore (cmmOffsetW dflags node (fixedHdrSize dflags))
+    emitStore (cmmOffsetW dflags node (fixedHdrSizeW dflags))
                   (CmmReg (CmmGlobal CurrentTSO))
     emitPrimCall [] MO_WriteBarrier []
     emitStore node (CmmReg (CmmGlobal EagerBlackholeInfo))
@@ -676,7 +675,7 @@ pushUpdateFrame lbl updatee body
        updfr  <- getUpdFrameOff
        dflags <- getDynFlags
        let
-           hdr         = fixedHdrSize dflags * wORD_SIZE dflags
+           hdr         = fixedHdrSize dflags
            frame       = updfr + hdr + sIZEOF_StgUpdateFrame_NoHdr dflags
        --
        emitUpdateFrame dflags (CmmStackSlot Old frame) lbl updatee
@@ -685,7 +684,7 @@ pushUpdateFrame lbl updatee body
 emitUpdateFrame :: DynFlags -> CmmExpr -> CLabel -> CmmExpr -> FCode ()
 emitUpdateFrame dflags frame lbl updatee = do
   let
-           hdr         = fixedHdrSize dflags * wORD_SIZE dflags
+           hdr         = fixedHdrSize dflags
            off_updatee = hdr + oFFSET_StgUpdateFrame_updatee dflags
   --
   emitStore frame (mkLblExpr lbl)
diff --git a/compiler/codeGen/StgCmmClosure.hs b/compiler/codeGen/StgCmmClosure.hs
index af9c7b8e07e2..b65d56bae2a9 100644
--- a/compiler/codeGen/StgCmmClosure.hs
+++ b/compiler/codeGen/StgCmmClosure.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE CPP, RecordWildCards #-}
+
 -----------------------------------------------------------------------------
 --
 -- Stg to C-- code generation:
@@ -9,8 +11,6 @@
 --
 -----------------------------------------------------------------------------
 
-{-# LANGUAGE RecordWildCards #-}
-
 module StgCmmClosure (
         DynTag,  tagForCon, isSmallFamily,
         ConTagZ, dataConTagZ,
@@ -450,25 +450,27 @@ in TcGenDeriv.) -}
 whether or not it has free variables, and whether we're running
 sequentially or in parallel.
 
-Closure                               Node   Argument   Enter
-Characteristics                  Par   Req'd  Passing    Via
--------------------------------------------------------------------------------
-Unknown                         & no & yes & stack      & node
-Known fun (>1 arg), no fvs      & no & no  & registers  & fast entry (enough args)
-                                                        & slow entry (otherwise)
-Known fun (>1 arg), fvs         & no & yes & registers  & fast entry (enough args)
-0 arg, no fvs \r,\s             & no & no  & n/a        & direct entry
-0 arg, no fvs \u                & no & yes & n/a        & node
-0 arg, fvs \r,\s                & no & yes & n/a        & direct entry
-0 arg, fvs \u                   & no & yes & n/a        & node
-Unknown                         & yes & yes & stack     & node
-Known fun (>1 arg), no fvs      & yes & no  & registers & fast entry (enough args)
-                                                        & slow entry (otherwise)
-Known fun (>1 arg), fvs         & yes & yes & registers & node
-0 arg, no fvs \r,\s             & yes & no  & n/a       & direct entry
-0 arg, no fvs \u                & yes & yes & n/a       & node
-0 arg, fvs \r,\s                & yes & yes & n/a       & node
-0 arg, fvs \u                   & yes & yes & n/a       & node
+Closure                           Node   Argument   Enter
+Characteristics              Par   Req'd  Passing    Via
+---------------------------------------------------------------------------
+Unknown                     & no  & yes & stack     & node
+Known fun (>1 arg), no fvs  & no  & no  & registers & fast entry (enough args)
+                                                    & slow entry (otherwise)
+Known fun (>1 arg), fvs     & no  & yes & registers & fast entry (enough args)
+0 arg, no fvs \r,\s         & no  & no  & n/a       & direct entry
+0 arg, no fvs \u            & no  & yes & n/a       & node
+0 arg, fvs \r,\s,selector   & no  & yes & n/a       & node
+0 arg, fvs \r,\s            & no  & yes & n/a       & direct entry
+0 arg, fvs \u               & no  & yes & n/a       & node
+Unknown                     & yes & yes & stack     & node
+Known fun (>1 arg), no fvs  & yes & no  & registers & fast entry (enough args)
+                                                    & slow entry (otherwise)
+Known fun (>1 arg), fvs     & yes & yes & registers & node
+0 arg, fvs \r,\s,selector   & yes & yes & n/a       & node
+0 arg, no fvs \r,\s         & yes & no  & n/a       & direct entry
+0 arg, no fvs \u            & yes & yes & n/a       & node
+0 arg, fvs \r,\s            & yes & yes & n/a       & node
+0 arg, fvs \u               & yes & yes & n/a       & node
 
 When black-holing, single-entry closures could also be entered via node
 (rather than directly) to catch double-entry. -}
@@ -519,7 +521,8 @@ getCallMethod dflags _name _ lf_info _n_args _cg_loc _self_loop_info
         -- fetched since we allocated it.
     EnterIt
 
-getCallMethod dflags name id (LFReEntrant _ arity _ _) n_args _cg_loc _self_loop_info
+getCallMethod dflags name id (LFReEntrant _ arity _ _) n_args _cg_loc
+              _self_loop_info
   | n_args == 0    = ASSERT( arity /= 0 )
                      ReturnIt        -- No args at all
   | n_args < arity = SlowCall        -- Not enough args
@@ -531,7 +534,8 @@ getCallMethod _ _name _ LFUnLifted n_args _cg_loc _self_loop_info
 getCallMethod _ _name _ (LFCon _) n_args _cg_loc _self_loop_info
   = ASSERT( n_args == 0 ) ReturnIt
 
-getCallMethod dflags name id (LFThunk _ _ updatable std_form_info is_fun) n_args _cg_loc _self_loop_info
+getCallMethod dflags name id (LFThunk _ _ updatable std_form_info is_fun)
+              n_args _cg_loc _self_loop_info
   | is_fun      -- it *might* be a function, so we must "call" it (which is always safe)
   = SlowCall    -- We cannot just enter it [in eval/apply, the entry code
                 -- is the fast-entry code]
@@ -544,6 +548,12 @@ getCallMethod dflags name id (LFThunk _ _ updatable std_form_info is_fun) n_args
          of jumping directly to the entry code is still valid.  --SDM
         -}
   = EnterIt
+
+  -- even a non-updatable selector thunk can be updated by the garbage
+  -- collector, so we must enter it. (#8817)
+  | SelectorThunk{} <- std_form_info
+  = EnterIt
+
     -- We used to have ASSERT( n_args == 0 ), but actually it is
     -- possible for the optimiser to generate
     --   let bot :: Int = error Int "urk"
@@ -553,7 +563,8 @@ getCallMethod dflags name id (LFThunk _ _ updatable std_form_info is_fun) n_args
 
   | otherwise        -- Jump direct to code for single-entry thunks
   = ASSERT( n_args == 0 )
-    DirectEntry (thunkEntryLabel dflags name (idCafInfo id) std_form_info updatable) 0
+    DirectEntry (thunkEntryLabel dflags name (idCafInfo id) std_form_info
+                updatable) 0
 
 getCallMethod _ _name _ (LFUnknown True) _n_arg _cg_locs _self_loop_info
   = SlowCall -- might be a function
@@ -562,7 +573,8 @@ getCallMethod _ name _ (LFUnknown False) n_args _cg_loc _self_loop_info
   = ASSERT2( n_args == 0, ppr name <+> ppr n_args )
     EnterIt -- Not a function
 
-getCallMethod _ _name _ LFLetNoEscape _n_args (LneLoc blk_id lne_regs) _self_loop_info
+getCallMethod _ _name _ LFLetNoEscape _n_args (LneLoc blk_id lne_regs)
+              _self_loop_info
   = JumpToIt blk_id lne_regs
 
 getCallMethod _ _ _ _ _ _ _ = panic "Unknown call method"
diff --git a/compiler/codeGen/StgCmmCon.hs b/compiler/codeGen/StgCmmCon.hs
index eb00bbf0c0a2..edd064848fc5 100644
--- a/compiler/codeGen/StgCmmCon.hs
+++ b/compiler/codeGen/StgCmmCon.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE CPP #-}
+
 -----------------------------------------------------------------------------
 --
 -- Stg to C--: code generation for constructors
@@ -21,6 +23,7 @@ import CoreSyn  ( AltCon(..) )
 import StgCmmMonad
 import StgCmmEnv
 import StgCmmHeap
+import StgCmmLayout
 import StgCmmUtils
 import StgCmmClosure
 import StgCmmProf ( curCCS )
@@ -187,9 +190,9 @@ buildDynCon' dflags platform binder _ _cc con [arg]
   , StgLitArg (MachInt val) <- arg
   , val <= fromIntegral (mAX_INTLIKE dflags) -- Comparisons at type Integer!
   , val >= fromIntegral (mIN_INTLIKE dflags) -- ...ditto...
-  = do  { let intlike_lbl   = mkCmmClosureLabel rtsPackageId (fsLit "stg_INTLIKE")
+  = do  { let intlike_lbl   = mkCmmClosureLabel rtsPackageKey (fsLit "stg_INTLIKE")
               val_int = fromIntegral val :: Int
-              offsetW = (val_int - mIN_INTLIKE dflags) * (fixedHdrSize dflags + 1)
+              offsetW = (val_int - mIN_INTLIKE dflags) * (fixedHdrSizeW dflags + 1)
                 -- INTLIKE closures consist of a header and one word payload
               intlike_amode = cmmLabelOffW dflags intlike_lbl offsetW
         ; return ( litIdInfo dflags binder (mkConLFInfo con) intlike_amode
@@ -202,8 +205,8 @@ buildDynCon' dflags platform binder _ _cc con [arg]
   , let val_int = ord val :: Int
   , val_int <= mAX_CHARLIKE dflags
   , val_int >= mIN_CHARLIKE dflags
-  = do  { let charlike_lbl   = mkCmmClosureLabel rtsPackageId (fsLit "stg_CHARLIKE")
-              offsetW = (val_int - mIN_CHARLIKE dflags) * (fixedHdrSize dflags + 1)
+  = do  { let charlike_lbl   = mkCmmClosureLabel rtsPackageKey (fsLit "stg_CHARLIKE")
+              offsetW = (val_int - mIN_CHARLIKE dflags) * (fixedHdrSizeW dflags + 1)
                 -- CHARLIKE closures consist of a header and one word payload
               charlike_amode = cmmLabelOffW dflags charlike_lbl offsetW
         ; return ( litIdInfo dflags binder (mkConLFInfo con) charlike_amode
diff --git a/compiler/codeGen/StgCmmEnv.hs b/compiler/codeGen/StgCmmEnv.hs
index 2b8677c408ca..4127b6740182 100644
--- a/compiler/codeGen/StgCmmEnv.hs
+++ b/compiler/codeGen/StgCmmEnv.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE CPP #-}
+
 -----------------------------------------------------------------------------
 --
 -- Stg to C-- code generation: the binding environment
diff --git a/compiler/codeGen/StgCmmExpr.hs b/compiler/codeGen/StgCmmExpr.hs
index cc32a1445bf8..278b10c937f7 100644
--- a/compiler/codeGen/StgCmmExpr.hs
+++ b/compiler/codeGen/StgCmmExpr.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE CPP #-}
+
 -----------------------------------------------------------------------------
 --
 -- Stg to C-- code generation: expressions
@@ -45,6 +47,7 @@ import FastString
 import Outputable
 
 import Control.Monad (when,void)
+import Control.Arrow (first)
 
 ------------------------------------------------------------------------
 --              cgExpr: the main function
@@ -60,10 +63,7 @@ cgExpr (StgOpApp (StgPrimOp SeqOp) [StgVarArg a, _] _res_ty) =
 
 cgExpr (StgOpApp op args ty) = cgOpApp op args ty
 cgExpr (StgConApp con args)  = cgConApp con args
-cgExpr (StgSCC cc tick push expr) = do { emitSetCCC cc tick push; cgExpr expr }
-cgExpr (StgTick m n expr) = do dflags <- getDynFlags
-                               emit (mkTickBox dflags m n)
-                               cgExpr expr
+cgExpr (StgTick t e)         = cgTick t >> cgExpr e
 cgExpr (StgLit lit)       = do cmm_lit <- cgLit lit
                                emitReturn [CmmLit cmm_lit]
 
@@ -127,8 +127,8 @@ cgLetNoEscapeRhs
 cgLetNoEscapeRhs join_id local_cc bndr rhs =
   do { (info, rhs_code) <- cgLetNoEscapeRhsBody local_cc bndr rhs
      ; let (bid, _) = expectJust "cgLetNoEscapeRhs" $ maybeLetNoEscape info
-     ; let code = do { body <- getCode rhs_code
-                     ; emitOutOfLine bid (body <*> mkBranch join_id) }
+     ; let code = do { (_, body) <- getCodeScoped rhs_code
+                     ; emitOutOfLine bid (first (<*> mkBranch join_id) body) }
      ; return (info, code)
      }
 
@@ -422,8 +422,8 @@ cgCase scrut bndr alt_type alts
        ; up_hp_usg <- getVirtHp        -- Upstream heap usage
        ; let ret_bndrs = chooseReturnBndrs bndr alt_type alts
              alt_regs  = map (idToReg dflags) ret_bndrs
-             simple_scrut = isSimpleScrut scrut alt_type
-             do_gc  | not simple_scrut = True
+       ; simple_scrut <- isSimpleScrut scrut alt_type
+       ; let do_gc  | not simple_scrut = True
                     | isSingleton alts = False
                     | up_hp_usg > 0    = False
                     | otherwise        = True
@@ -450,6 +450,13 @@ recover any unused heap before passing control to the sequel.  If we
 don't do this, then any unused heap will become slop because the heap
 check will reset the heap usage. Slop in the heap breaks LDV profiling
 (+RTS -hb) which needs to do a linear sweep through the nursery.
+
+
+Note [Inlining out-of-line primops and heap checks]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+If shouldInlinePrimOp returns True when called from StgCmmExpr for the
+purpose of heap check placement, we *must* inline the primop later in
+StgCmmPrim. If we don't things will go wrong.
 -}
 
 -----------------
@@ -460,21 +467,25 @@ maybeSaveCostCentre simple_scrut
 
 
 -----------------
-isSimpleScrut :: StgExpr -> AltType -> Bool
+isSimpleScrut :: StgExpr -> AltType -> FCode Bool
 -- Simple scrutinee, does not block or allocate; hence safe to amalgamate
 -- heap usage from alternatives into the stuff before the case
 -- NB: if you get this wrong, and claim that the expression doesn't allocate
 --     when it does, you'll deeply mess up allocation
-isSimpleScrut (StgOpApp op _ _) _          = isSimpleOp op
-isSimpleScrut (StgLit _)       _           = True       -- case 1# of { 0# -> ..; ... }
-isSimpleScrut (StgApp _ [])    (PrimAlt _) = True       -- case x# of { 0# -> ..; ... }
-isSimpleScrut _                _           = False
+isSimpleScrut (StgOpApp op args _) _       = isSimpleOp op args
+isSimpleScrut (StgLit _)       _           = return True       -- case 1# of { 0# -> ..; ... }
+isSimpleScrut (StgApp _ [])    (PrimAlt _) = return True       -- case x# of { 0# -> ..; ... }
+isSimpleScrut _                _           = return False
 
-isSimpleOp :: StgOp -> Bool
+isSimpleOp :: StgOp -> [StgArg] -> FCode Bool
 -- True iff the op cannot block or allocate
-isSimpleOp (StgFCallOp (CCall (CCallSpec _ _ safe)) _) = not (playSafe safe)
-isSimpleOp (StgPrimOp op)                              = not (primOpOutOfLine op)
-isSimpleOp (StgPrimCallOp _)                           = False
+isSimpleOp (StgFCallOp (CCall (CCallSpec _ _ safe)) _) _ = return $! not (playSafe safe)
+isSimpleOp (StgPrimOp op) stg_args                  = do
+    arg_exprs <- getNonVoidArgAmodes stg_args
+    dflags <- getDynFlags
+    -- See Note [Inlining out-of-line primops and heap checks]
+    return $! isJust $ shouldInlinePrimOp dflags op arg_exprs
+isSimpleOp (StgPrimCallOp _) _                           = return False
 
 -----------------
 chooseReturnBndrs :: Id -> AltType -> [StgAlt] -> [NonVoid Id]
@@ -574,8 +585,8 @@ cgAlts _ _ _ _ = panic "cgAlts"
 
 -------------------
 cgAlgAltRhss :: (GcPlan,ReturnKind) -> NonVoid Id -> [StgAlt]
-             -> FCode ( Maybe CmmAGraph
-                      , [(ConTagZ, CmmAGraph)] )
+             -> FCode ( Maybe CmmAGraphScoped
+                      , [(ConTagZ, CmmAGraphScoped)] )
 cgAlgAltRhss gc_plan bndr alts
   = do { tagged_cmms <- cgAltRhss gc_plan bndr alts
 
@@ -594,14 +605,14 @@ cgAlgAltRhss gc_plan bndr alts
 
 -------------------
 cgAltRhss :: (GcPlan,ReturnKind) -> NonVoid Id -> [StgAlt]
-          -> FCode [(AltCon, CmmAGraph)]
+          -> FCode [(AltCon, CmmAGraphScoped)]
 cgAltRhss gc_plan bndr alts = do
   dflags <- getDynFlags
   let
     base_reg = idToReg dflags bndr
-    cg_alt :: StgAlt -> FCode (AltCon, CmmAGraph)
+    cg_alt :: StgAlt -> FCode (AltCon, CmmAGraphScoped)
     cg_alt (con, bndrs, _uses, rhs)
-      = getCodeR                  $
+      = getCodeScoped             $
         maybeAltHeapCheck gc_plan $
         do { _ <- bindConArgs con base_reg bndrs
            ; _ <- cgExpr rhs
@@ -737,10 +748,16 @@ cgIdApp fun_id args = do
 --
 --   * Whenever we are compiling a function, we set that information to reflect
 --     the fact that function currently being compiled can be jumped to, instead
---     of called. We also have to emit a label to which we will be jumping. Both
---     things are done in closureCodyBody in StgCmmBind.
+--     of called. This is done in closureCodyBody in StgCmmBind.
 --
---   * When we began compilation of another closure we remove the additional
+--   * We also have to emit a label to which we will be jumping. We make sure
+--     that the label is placed after a stack check but before the heap
+--     check. The reason is that making a recursive tail-call does not increase
+--     the stack so we only need to check once. But it may grow the heap, so we
+--     have to repeat the heap check in every self-call. This is done in
+--     do_checks in StgCmmHeap.
+--
+--   * When we begin compilation of another closure we remove the additional
 --     information from the environment. This is done by forkClosureBody
 --     in StgCmmMonad. Other functions that duplicate the environment -
 --     forkLneBody, forkAlts, codeOnly - duplicate that information. In other
@@ -755,8 +772,8 @@ cgIdApp fun_id args = do
 --     arity. (d) loopification is turned on via -floopification command-line
 --     option.
 --
---   * Command line option to control turn loopification on and off is
---     implemented in DynFlags
+--   * Command line option to turn loopification on and off is implemented in
+--     DynFlags.
 --
 
 
@@ -820,12 +837,28 @@ emitEnter fun = do
          -- inlined in the RHS of the R1 assignment.
        ; let entry = entryCode dflags (closureInfoPtr dflags (CmmReg nodeReg))
              the_call = toCall entry (Just lret) updfr_off off outArgs regs
+       ; tscope <- getTickScope
        ; emit $
            copyout <*>
            mkCbranch (cmmIsTagged dflags (CmmReg nodeReg)) lret lcall <*>
-           outOfLine lcall the_call <*>
-           mkLabel lret <*>
+           outOfLine lcall (the_call,tscope) <*>
+           mkLabel lret tscope <*>
            copyin
        ; return (ReturnedTo lret off)
        }
   }
+
+------------------------------------------------------------------------
+--              Ticks
+------------------------------------------------------------------------
+
+cgTick :: Tickish Id -> FCode ()
+cgTick tick
+  = do { dflags <- getDynFlags
+       ; case tick of
+           ProfNote   cc t p -> emitSetCCC cc t p
+           HpcTick    m n    -> emit (mkTickBox dflags m n)
+           SourceNote s n    -> emitTick $ SourceNote s n
+           CoreNote   b n    -> emitTick $ CoreNote b n
+           _other            -> return () -- ignore
+       }
diff --git a/compiler/codeGen/StgCmmExtCode.hs b/compiler/codeGen/StgCmmExtCode.hs
index df1733978f9f..9801829664aa 100644
--- a/compiler/codeGen/StgCmmExtCode.hs
+++ b/compiler/codeGen/StgCmmExtCode.hs
@@ -16,6 +16,9 @@ module StgCmmExtCode (
         loopDecls,
         getEnv,
 
+        withName,
+        getName,
+
         newLocal,
         newLabel,
         newBlockId,
@@ -26,7 +29,7 @@ module StgCmmExtCode (
 
         code,
         emit, emitLabel, emitAssign, emitStore,
-        getCode, getCodeR,
+        getCode, getCodeR, getCodeScoped,
         emitOutOfLine,
         withUpdFrameOff, getUpdFrameOff
 )
@@ -57,7 +60,7 @@ data Named
         = VarN CmmExpr          -- ^ Holds CmmLit(CmmLabel ..) which gives the label type,
                                 --      eg, RtsLabel, ForeignLabel, CmmLabel etc.
 
-        | FunN   PackageId      -- ^ A function name from this package
+        | FunN   PackageKey      -- ^ A function name from this package
         | LabelN BlockId                -- ^ A blockid of some code or data.
 
 -- | An environment of named things.
@@ -69,15 +72,15 @@ type Decls      = [(FastString,Named)]
 -- | Does a computation in the FCode monad, with a current environment
 --      and a list of local declarations. Returns the resulting list of declarations.
 newtype CmmParse a
-        = EC { unEC :: Env -> Decls -> FCode (Decls, a) }
+        = EC { unEC :: String -> Env -> Decls -> FCode (Decls, a) }
 
 type ExtCode = CmmParse ()
 
 returnExtFC :: a -> CmmParse a
-returnExtFC a   = EC $ \_ s -> return (s, a)
+returnExtFC a   = EC $ \_ _ s -> return (s, a)
 
 thenExtFC :: CmmParse a -> (a -> CmmParse b) -> CmmParse b
-thenExtFC (EC m) k = EC $ \e s -> do (s',r) <- m e s; unEC (k r) e s'
+thenExtFC (EC m) k = EC $ \c e s -> do (s',r) <- m c e s; unEC (k r) c e s'
 
 instance Functor CmmParse where
       fmap = liftM
@@ -91,8 +94,8 @@ instance Monad CmmParse where
   return = returnExtFC
 
 instance HasDynFlags CmmParse where
-    getDynFlags = EC (\_ d -> do dflags <- getDynFlags
-                                 return (d, dflags))
+    getDynFlags = EC (\_ _ d -> do dflags <- getDynFlags
+                                   return (d, dflags))
 
 
 -- | Takes the variable decarations and imports from the monad
@@ -103,18 +106,25 @@ instance HasDynFlags CmmParse where
 --
 loopDecls :: CmmParse a -> CmmParse a
 loopDecls (EC fcode) =
-      EC $ \e globalDecls -> do
-        (_, a) <- F.fixC (\ ~(decls, _) -> fcode (addListToUFM e decls) globalDecls)
+      EC $ \c e globalDecls -> do
+        (_, a) <- F.fixC (\ ~(decls, _) -> fcode c (addListToUFM e decls) globalDecls)
         return (globalDecls, a)
 
 
 -- | Get the current environment from the monad.
 getEnv :: CmmParse Env
-getEnv  = EC $ \e s -> return (s, e)
+getEnv  = EC $ \_ e s -> return (s, e)
+
+-- | Get the current context name from the monad
+getName :: CmmParse String
+getName  = EC $ \c _ s -> return (s, c)
 
+-- | Set context name for a sub-parse
+withName :: String -> CmmParse a -> CmmParse a
+withName c' (EC fcode) = EC $ \_ e s -> fcode c' e s
 
 addDecl :: FastString -> Named -> ExtCode
-addDecl name named = EC $ \_ s -> return ((name, named) : s, ())
+addDecl name named = EC $ \_ _ s -> return ((name, named) : s, ())
 
 
 -- | Add a new variable to the list of local declarations.
@@ -153,7 +163,7 @@ newBlockId = code F.newLabelC
 -- | Add add a local function to the environment.
 newFunctionName
         :: FastString   -- ^ name of the function
-        -> PackageId    -- ^ package of the current module
+        -> PackageKey    -- ^ package of the current module
         -> ExtCode
 
 newFunctionName name pkg = addDecl name (FunN pkg)
@@ -193,12 +203,12 @@ lookupName name = do
      case lookupUFM env name of
         Just (VarN e)   -> e
         Just (FunN pkg) -> CmmLit (CmmLabel (mkCmmCodeLabel pkg          name))
-        _other          -> CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageId name))
+        _other          -> CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageKey name))
 
 
 -- | Lift an FCode computation into the CmmParse monad
 code :: FCode a -> CmmParse a
-code fc = EC $ \_ s -> do
+code fc = EC $ \_ _ s -> do
                 r <- fc
                 return (s, r)
 
@@ -206,7 +216,7 @@ emit :: CmmAGraph -> CmmParse ()
 emit = code . F.emit
 
 emitLabel :: BlockId -> CmmParse ()
-emitLabel = code. F.emitLabel
+emitLabel = code . F.emitLabel
 
 emitAssign :: CmmReg  -> CmmExpr -> CmmParse ()
 emitAssign l r = code (F.emitAssign l r)
@@ -215,21 +225,26 @@ emitStore :: CmmExpr  -> CmmExpr -> CmmParse ()
 emitStore l r = code (F.emitStore l r)
 
 getCode :: CmmParse a -> CmmParse CmmAGraph
-getCode (EC ec) = EC $ \e s -> do
-  ((s',_), gr) <- F.getCodeR (ec e s)
+getCode (EC ec) = EC $ \c e s -> do
+  ((s',_), gr) <- F.getCodeR (ec c e s)
   return (s', gr)
 
 getCodeR :: CmmParse a -> CmmParse (a, CmmAGraph)
-getCodeR (EC ec) = EC $ \e s -> do
-  ((s', r), gr) <- F.getCodeR (ec e s)
+getCodeR (EC ec) = EC $ \c e s -> do
+  ((s', r), gr) <- F.getCodeR (ec c e s)
+  return (s', (r,gr))
+
+getCodeScoped :: CmmParse a -> CmmParse (a, CmmAGraphScoped)
+getCodeScoped (EC ec) = EC $ \c e s -> do
+  ((s', r), gr) <- F.getCodeScoped (ec c e s)
   return (s', (r,gr))
 
-emitOutOfLine :: BlockId -> CmmAGraph -> CmmParse ()
+emitOutOfLine :: BlockId -> CmmAGraphScoped -> CmmParse ()
 emitOutOfLine l g = code (F.emitOutOfLine l g)
 
 withUpdFrameOff :: UpdFrameOffset -> CmmParse () -> CmmParse ()
 withUpdFrameOff size inner
-  = EC $ \e s -> F.withUpdFrameOff size $ (unEC inner) e s
+  = EC $ \c e s -> F.withUpdFrameOff size $ (unEC inner) c e s
 
 getUpdFrameOff :: CmmParse UpdFrameOffset
 getUpdFrameOff = code $ F.getUpdFrameOff
diff --git a/compiler/codeGen/StgCmmForeign.hs b/compiler/codeGen/StgCmmForeign.hs
index a688074b9ed9..0553edf85cf5 100644
--- a/compiler/codeGen/StgCmmForeign.hs
+++ b/compiler/codeGen/StgCmmForeign.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE CPP #-}
+
 -----------------------------------------------------------------------------
 --
 -- Code generation for foreign calls.
@@ -218,6 +220,7 @@ emitForeignCall safety results target args
     k <- newLabelC
     let (off, _, copyout) = copyInOflow dflags NativeReturn (Young k) results []
        -- see Note [safe foreign call convention]
+    tscope <- getTickScope
     emit $
            (    mkStore (CmmStackSlot (Young k) (widthInBytes (wordWidth dflags)))
                         (CmmLit (CmmBlock k))
@@ -228,7 +231,7 @@ emitForeignCall safety results target args
                                        , ret_args = off
                                        , ret_off = updfr_off
                                        , intrbl = playInterruptible safety })
-            <*> mkLabel k
+            <*> mkLabel k tscope
             <*> copyout
            )
     return (ReturnedTo k off)
@@ -267,7 +270,12 @@ maybe_assign_temp e = do
 saveThreadState :: DynFlags -> CmmAGraph
 saveThreadState dflags =
   -- CurrentTSO->stackobj->sp = Sp;
-  mkStore (cmmOffset dflags (CmmLoad (cmmOffset dflags stgCurrentTSO (tso_stackobj dflags)) (bWord dflags)) (stack_SP dflags)) stgSp
+  let stackobj = CmmLoad (cmmOffset dflags stgCurrentTSO (tso_stackobj dflags)) (bWord dflags)
+      sp_fld = cmmOffset dflags stackobj (stack_SP dflags)
+  in (if gopt Opt_Debug dflags
+      then mkUnwind Sp (CmmLoad sp_fld (bWord dflags))
+      else mkNop)
+  <*> mkStore sp_fld stgSp
   <*> closeNursery dflags
   -- and save the current cost centre stack in the TSO when profiling:
   <*> if gopt Opt_SccProfilingOn dflags then
@@ -358,7 +366,7 @@ stack_SP     dflags = closureField dflags (oFFSET_StgStack_sp dflags)
 
 
 closureField :: DynFlags -> ByteOff -> ByteOff
-closureField dflags off = off + fixedHdrSize dflags * wORD_SIZE dflags
+closureField dflags off = off + fixedHdrSize dflags
 
 stgSp, stgHp, stgCurrentTSO, stgCurrentNursery :: CmmExpr
 stgSp             = CmmReg sp
@@ -405,6 +413,9 @@ add_shim dflags arg_ty expr
   | tycon == arrayPrimTyCon || tycon == mutableArrayPrimTyCon
   = cmmOffsetB dflags expr (arrPtrsHdrSize dflags)
 
+  | tycon == smallArrayPrimTyCon || tycon == smallMutableArrayPrimTyCon
+  = cmmOffsetB dflags expr (smallArrPtrsHdrSize dflags)
+
   | tycon == byteArrayPrimTyCon || tycon == mutableByteArrayPrimTyCon
   = cmmOffsetB dflags expr (arrWordsHdrSize dflags)
 
diff --git a/compiler/codeGen/StgCmmHeap.hs b/compiler/codeGen/StgCmmHeap.hs
index 55ddfd4f9694..2261b1996393 100644
--- a/compiler/codeGen/StgCmmHeap.hs
+++ b/compiler/codeGen/StgCmmHeap.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE CPP #-}
+
 -----------------------------------------------------------------------------
 --
 -- Stg to C--: heap management functions
@@ -8,16 +10,15 @@
 
 module StgCmmHeap (
         getVirtHp, setVirtHp, setRealHp,
-        getHpRelOffset, hpRel,
+        getHpRelOffset,
 
         entryHeapCheck, altHeapCheck, noEscapeHeapCheck, altHeapCheckReturnsTo,
         heapStackCheckGen,
         entryHeapCheck',
 
-        mkVirtHeapOffsets, mkVirtConstrOffsets,
         mkStaticClosureFields, mkStaticClosure,
 
-        allocDynClosure, allocDynClosureCmm,
+        allocDynClosure, allocDynClosureCmm, allocHeapClosure,
         emitSetDynHdr
     ) where
 
@@ -68,7 +69,7 @@ allocDynClosure
 
 allocDynClosureCmm
         :: Maybe Id -> CmmInfoTable -> LambdaFormInfo -> CmmExpr -> CmmExpr
-        -> [(CmmExpr, VirtualHpOffset)]
+        -> [(CmmExpr, ByteOff)]
         -> FCode CmmExpr -- returns Hp+n
 
 -- allocDynClosure allocates the thing in the heap,
@@ -89,61 +90,70 @@ allocDynClosureCmm
 -- significant - see test T4801.
 
 
-allocDynClosure mb_id info_tbl lf_info use_cc _blame_cc args_w_offsets
-  = do  { let (args, offsets) = unzip args_w_offsets
-        ; cmm_args <- mapM getArgAmode args     -- No void args
-        ; allocDynClosureCmm mb_id info_tbl lf_info
-                             use_cc _blame_cc (zip cmm_args offsets)
-        }
+allocDynClosure mb_id info_tbl lf_info use_cc _blame_cc args_w_offsets = do
+  let (args, offsets) = unzip args_w_offsets
+  cmm_args <- mapM getArgAmode args     -- No void args
+  allocDynClosureCmm mb_id info_tbl lf_info
+                     use_cc _blame_cc (zip cmm_args offsets)
+
 
-allocDynClosureCmm mb_id info_tbl lf_info use_cc _blame_cc amodes_w_offsets
-  = do  { virt_hp <- getVirtHp
+allocDynClosureCmm mb_id info_tbl lf_info use_cc _blame_cc amodes_w_offsets = do
+  -- SAY WHAT WE ARE ABOUT TO DO
+  let rep = cit_rep info_tbl
+  tickyDynAlloc mb_id rep lf_info
+  let info_ptr = CmmLit (CmmLabel (cit_lbl info_tbl))
+  allocHeapClosure rep info_ptr use_cc amodes_w_offsets
 
-        -- SAY WHAT WE ARE ABOUT TO DO
-        ; let rep = cit_rep info_tbl
-        ; tickyDynAlloc mb_id rep lf_info
-        ; profDynAlloc rep use_cc
 
-        -- FIND THE OFFSET OF THE INFO-PTR WORD
-        ; let   info_offset = virt_hp + 1
-                -- info_offset is the VirtualHpOffset of the first
-                -- word of the new object
-                -- Remember, virtHp points to last allocated word,
-                -- ie 1 *before* the info-ptr word of new object.
+-- | Low-level heap object allocation.
+allocHeapClosure
+  :: SMRep                            -- ^ representation of the object
+  -> CmmExpr                          -- ^ info pointer
+  -> CmmExpr                          -- ^ cost centre
+  -> [(CmmExpr,ByteOff)]              -- ^ payload
+  -> FCode CmmExpr                    -- ^ returns the address of the object
+allocHeapClosure rep info_ptr use_cc payload = do
+  profDynAlloc rep use_cc
 
-                info_ptr = CmmLit (CmmLabel (cit_lbl info_tbl))
+  virt_hp <- getVirtHp
 
-        -- ALLOCATE THE OBJECT
-        ; base <- getHpRelOffset info_offset
-        ; emitComment $ mkFastString "allocDynClosure"
-        ; emitSetDynHdr base info_ptr  use_cc
-        ; let (cmm_args, offsets) = unzip amodes_w_offsets
-        ; hpStore base cmm_args offsets
+  -- Find the offset of the info-ptr word
+  let info_offset = virt_hp + 1
+            -- info_offset is the VirtualHpOffset of the first
+            -- word of the new object
+            -- Remember, virtHp points to last allocated word,
+            -- ie 1 *before* the info-ptr word of new object.
 
-        -- BUMP THE VIRTUAL HEAP POINTER
-        ; dflags <- getDynFlags
-        ; setVirtHp (virt_hp + heapClosureSize dflags rep)
+  base <- getHpRelOffset info_offset
+  emitComment $ mkFastString "allocHeapClosure"
+  emitSetDynHdr base info_ptr use_cc
+
+  -- Fill in the fields
+  hpStore base payload
+
+  -- Bump the virtual heap pointer
+  dflags <- getDynFlags
+  setVirtHp (virt_hp + heapClosureSizeW dflags rep)
+
+  return base
 
-        ; getHpRelOffset info_offset
-        }
 
 emitSetDynHdr :: CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
 emitSetDynHdr base info_ptr ccs
   = do dflags <- getDynFlags
-       hpStore base (header dflags) [0..]
+       hpStore base (zip (header dflags) [0, wORD_SIZE dflags ..])
   where
     header :: DynFlags -> [CmmExpr]
     header dflags = [info_ptr] ++ dynProfHdr dflags ccs
         -- ToDof: Parallel stuff
         -- No ticky header
 
-hpStore :: CmmExpr -> [CmmExpr] -> [VirtualHpOffset] -> FCode ()
 -- Store the item (expr,off) in base[off]
-hpStore base vals offs
-  = do dflags <- getDynFlags
-       let mk_store val off = mkStore (cmmOffsetW dflags base off) val
-       emit (catAGraphs (zipWith mk_store vals offs))
-
+hpStore :: CmmExpr -> [(CmmExpr, ByteOff)] -> FCode ()
+hpStore base vals = do
+  dflags <- getDynFlags
+  sequence_ $
+    [ emitStore (cmmOffsetB dflags base off) val | (val,off) <- vals ]
 
 -----------------------------------------------------------
 --              Layout of static closures
@@ -406,7 +416,8 @@ altOrNoEscapeHeapCheck checkYield regs code = do
         lret <- newLabelC
         let (off, _, copyin) = copyInOflow dflags NativeReturn (Young lret) regs []
         lcont <- newLabelC
-        emitOutOfLine lret (copyin <*> mkBranch lcont)
+        tscope <- getTickScope
+        emitOutOfLine lret (copyin <*> mkBranch lcont, tscope)
         emitLabel lcont
         cannedGCReturnsTo checkYield False gc regs lret off code
 
@@ -506,7 +517,7 @@ generic_gc = mkGcLabel "stg_gc_noregs"
 
 -- | Create a CLabel for calling a garbage collector entry point
 mkGcLabel :: String -> CmmExpr
-mkGcLabel s = CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageId (fsLit s)))
+mkGcLabel s = CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageKey (fsLit s)))
 
 -------------------------------
 heapCheck :: Bool -> Bool -> CmmAGraph -> FCode a -> FCode a
@@ -531,7 +542,7 @@ heapStackCheckGen stk_hwm mb_bytes
        lretry <- newLabelC
        emitLabel lretry
        call <- mkCall generic_gc (GC, GC) [] [] updfr_sz []
-       do_checks stk_hwm False  mb_bytes (call <*> mkBranch lretry)
+       do_checks stk_hwm False mb_bytes (call <*> mkBranch lretry)
 
 -- Note [Single stack check]
 -- ~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -569,11 +580,11 @@ heapStackCheckGen stk_hwm mb_bytes
 -- number of bytes of stack that the function will use, so we use a
 -- special late-bound CmmLit, namely
 --       CmmHighStackMark
--- to stand for the number of bytes needed. When the stack is made 
+-- to stand for the number of bytes needed. When the stack is made
 -- manifest, the number of bytes needed is calculated, and used to
 -- replace occurrences of CmmHighStackMark
 --
--- The (Maybe CmmExpr) passed to do_checks is usually 
+-- The (Maybe CmmExpr) passed to do_checks is usually
 --     Just (CmmLit CmmHighStackMark)
 -- but can also (in certain hand-written RTS functions)
 --     Just (CmmLit 8)  or some other fixed valuet
@@ -615,21 +626,31 @@ do_checks mb_stk_hwm checkYield mb_alloc_lit do_gc = do
     Nothing -> return ()
     Just stk_hwm -> tickyStackCheck >> (emit =<< mkCmmIfGoto (sp_oflo stk_hwm) gc_id)
 
+  -- Emit new label that might potentially be a header
+  -- of a self-recursive tail call.
+  -- See Note [Self-recursive loop header].
+  self_loop_info <- getSelfLoop
+  case self_loop_info of
+    Just (_, loop_header_id, _)
+        | checkYield && isJust mb_stk_hwm -> emitLabel loop_header_id
+    _otherwise -> return ()
+
   if (isJust mb_alloc_lit)
     then do
      tickyHeapCheck
      emitAssign hpReg bump_hp
      emit =<< mkCmmIfThen hp_oflo (alloc_n <*> mkBranch gc_id)
     else do
-      when (not (gopt Opt_OmitYields dflags) && checkYield) $ do
+      when (checkYield && not (gopt Opt_OmitYields dflags)) $ do
          -- Yielding if HpLim == 0
          let yielding = CmmMachOp (mo_wordEq dflags)
                                   [CmmReg (CmmGlobal HpLim),
                                    CmmLit (zeroCLit dflags)]
          emit =<< mkCmmIfGoto yielding gc_id
 
-  emitOutOfLine gc_id $
-     do_gc -- this is expected to jump back somewhere
+  tscope <- getTickScope
+  emitOutOfLine gc_id
+   (do_gc, tscope) -- this is expected to jump back somewhere
 
                 -- Test for stack pointer exhaustion, then
                 -- bump heap pointer, and test for heap exhaustion
@@ -637,3 +658,27 @@ do_checks mb_stk_hwm checkYield mb_alloc_lit do_gc = do
                 -- stack check succeeds.  Otherwise we might end up
                 -- with slop at the end of the current block, which can
                 -- confuse the LDV profiler.
+
+-- Note [Self-recursive loop header]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+--
+-- Self-recursive loop header is required by loopification optimization (See
+-- Note [Self-recursive tail calls] in StgCmmExpr). We emit it if:
+--
+--  1. There is information about self-loop in the FCode environment. We don't
+--     check the binder (first component of the self_loop_info) because we are
+--     certain that if the self-loop info is present then we are compiling the
+--     binder body. Reason: the only possible way to get here with the
+--     self_loop_info present is from closureCodeBody.
+--
+--  2. checkYield && isJust mb_stk_hwm. checkYield tells us that it is possible
+--     to preempt the heap check (see #367 for motivation behind this check). It
+--     is True for heap checks placed at the entry to a function and
+--     let-no-escape heap checks but false for other heap checks (eg. in case
+--     alternatives or created from hand-written high-level Cmm). The second
+--     check (isJust mb_stk_hwm) is true for heap checks at the entry to a
+--     function and some heap checks created in hand-written Cmm. Otherwise it
+--     is Nothing. In other words the only situation when both conditions are
+--     true is when compiling stack and heap checks at the entry to a
+--     function. This is the only situation when we want to emit a self-loop
+--     label.
diff --git a/compiler/codeGen/StgCmmLayout.hs b/compiler/codeGen/StgCmmLayout.hs
index 54e2e920f91f..2453639a8aaf 100644
--- a/compiler/codeGen/StgCmmLayout.hs
+++ b/compiler/codeGen/StgCmmLayout.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE CPP #-}
+
 -----------------------------------------------------------------------------
 --
 -- Building info tables.
@@ -15,7 +17,7 @@ module StgCmmLayout (
 
         slowCall, directCall,
 
-        mkVirtHeapOffsets, mkVirtConstrOffsets, getHpRelOffset, hpRel,
+        mkVirtHeapOffsets, mkVirtConstrOffsets, getHpRelOffset, 
 
         ArgRep(..), toArgRep, argRepSizeW -- re-exported from StgCmmArgRep
   ) where
@@ -114,7 +116,8 @@ emitCallWithExtraStack (callConv, retConv) fun args extra_stack
                   (off, _, copyin) = copyInOflow dflags retConv area res_regs []
                   copyout = mkCallReturnsTo dflags fun callConv args k off updfr_off
                                    extra_stack
-              emit (copyout <*> mkLabel k <*> copyin)
+              tscope <- getTickScope
+              emit (copyout <*> mkLabel k tscope <*> copyin)
               return (ReturnedTo k off)
       }
 
@@ -218,15 +221,16 @@ slowCall fun stg_args
              let correct_arity = cmmEqWord dflags (funInfoArity dflags fun_iptr)
                                                   (mkIntExpr dflags n_args)
 
+             tscope <- getTickScope
              emit (mkCbranch (cmmIsTagged dflags funv) is_tagged_lbl slow_lbl
-                   <*> mkLabel is_tagged_lbl
+                   <*> mkLabel is_tagged_lbl tscope
                    <*> mkCbranch correct_arity fast_lbl slow_lbl
-                   <*> mkLabel fast_lbl
+                   <*> mkLabel fast_lbl tscope
                    <*> fast_code
                    <*> mkBranch end_lbl
-                   <*> mkLabel slow_lbl
+                   <*> mkLabel slow_lbl tscope
                    <*> slow_code
-                   <*> mkLabel end_lbl)
+                   <*> mkLabel end_lbl tscope)
              return r
 
            else do
@@ -357,22 +361,23 @@ slowArgs dflags args -- careful: reps contains voids (V), but args does not
     (arg_pat, n)            = slowCallPattern (map fst args)
     (call_args, rest_args)  = splitAt n args
 
-    stg_ap_pat = mkCmmRetInfoLabel rtsPackageId arg_pat
+    stg_ap_pat = mkCmmRetInfoLabel rtsPackageKey arg_pat
     this_pat   = (N, Just (mkLblExpr stg_ap_pat)) : call_args
     save_cccs  = [(N, Just (mkLblExpr save_cccs_lbl)), (N, Just curCCS)]
-    save_cccs_lbl = mkCmmRetInfoLabel rtsPackageId (fsLit "stg_restore_cccs")
+    save_cccs_lbl = mkCmmRetInfoLabel rtsPackageKey (fsLit "stg_restore_cccs")
 
 -------------------------------------------------------------------------
 ----        Laying out objects on the heap and stack
 -------------------------------------------------------------------------
 
--- The heap always grows upwards, so hpRel is easy
+-- The heap always grows upwards, so hpRel is easy to compute
 hpRel :: VirtualHpOffset         -- virtual offset of Hp
       -> VirtualHpOffset         -- virtual offset of The Thing
       -> WordOff                -- integer word offset
 hpRel hp off = off - hp
 
 getHpRelOffset :: VirtualHpOffset -> FCode CmmExpr
+-- See Note [Virtual and real heap pointers] in StgCmmMonad
 getHpRelOffset virtual_offset
   = do dflags <- getDynFlags
        hp_usg <- getHpUsage
@@ -384,7 +389,7 @@ mkVirtHeapOffsets
   -> [(PrimRep,a)]        -- Things to make offsets for
   -> (WordOff,                -- _Total_ number of words allocated
       WordOff,                -- Number of words allocated for *pointers*
-      [(NonVoid a, VirtualHpOffset)])
+      [(NonVoid a, ByteOff)])
 
 -- Things with their offsets from start of object in order of
 -- increasing offset; BUT THIS MAY BE DIFFERENT TO INPUT ORDER
@@ -397,22 +402,31 @@ mkVirtHeapOffsets
 -- than the unboxed things
 
 mkVirtHeapOffsets dflags is_thunk things
-  = let non_void_things               = filterOut (isVoidRep . fst)  things
-        (ptrs, non_ptrs)              = partition (isGcPtrRep . fst) non_void_things
-        (wds_of_ptrs, ptrs_w_offsets) = mapAccumL computeOffset 0 ptrs
-        (tot_wds, non_ptrs_w_offsets) = mapAccumL computeOffset wds_of_ptrs non_ptrs
-    in
-    (tot_wds, wds_of_ptrs, ptrs_w_offsets ++ non_ptrs_w_offsets)
+  = ( bytesToWordsRoundUp dflags tot_bytes
+    , bytesToWordsRoundUp dflags bytes_of_ptrs
+    , ptrs_w_offsets ++ non_ptrs_w_offsets
+    )
   where
-    hdr_size | is_thunk   = thunkHdrSize dflags
-             | otherwise  = fixedHdrSize dflags
-
-    computeOffset wds_so_far (rep, thing)
-      = (wds_so_far + argRepSizeW dflags (toArgRep rep),
-         (NonVoid thing, hdr_size + wds_so_far))
-
-mkVirtConstrOffsets :: DynFlags -> [(PrimRep,a)] -> (WordOff, WordOff, [(NonVoid a, VirtualHpOffset)])
--- Just like mkVirtHeapOffsets, but for constructors
+    hdr_words | is_thunk   = thunkHdrSize dflags
+              | otherwise  = fixedHdrSizeW dflags
+    hdr_bytes = wordsToBytes dflags hdr_words
+
+    non_void_things    = filterOut (isVoidRep . fst)  things
+    (ptrs, non_ptrs)   = partition (isGcPtrRep . fst) non_void_things
+
+    (bytes_of_ptrs, ptrs_w_offsets) =
+       mapAccumL computeOffset 0 ptrs
+    (tot_bytes, non_ptrs_w_offsets) =
+       mapAccumL computeOffset bytes_of_ptrs non_ptrs
+
+    computeOffset bytes_so_far (rep, thing)
+      = (bytes_so_far + wordsToBytes dflags (argRepSizeW dflags (toArgRep rep)),
+         (NonVoid thing, hdr_bytes + bytes_so_far))
+
+-- | Just like mkVirtHeapOffsets, but for constructors
+mkVirtConstrOffsets
+  :: DynFlags -> [(PrimRep,a)]
+  -> (WordOff, WordOff, [(NonVoid a, ByteOff)])
 mkVirtConstrOffsets dflags = mkVirtHeapOffsets dflags False
 
 
@@ -520,7 +534,7 @@ emitClosureProcAndInfoTable top_lvl bndr lf_info info_tbl args body
 emitClosureAndInfoTable ::
   CmmInfoTable -> Convention -> [LocalReg] -> FCode () -> FCode ()
 emitClosureAndInfoTable info_tbl conv args body
-  = do { blks <- getCode body
+  = do { (_, blks) <- getCodeScoped body
        ; let entry_lbl = toEntryLbl (cit_lbl info_tbl)
        ; emitProcWithConvention conv (Just info_tbl) entry_lbl args blks
        }
diff --git a/compiler/codeGen/StgCmmMonad.hs b/compiler/codeGen/StgCmmMonad.hs
index 3d82e6940228..de7c7d85acd7 100644
--- a/compiler/codeGen/StgCmmMonad.hs
+++ b/compiler/codeGen/StgCmmMonad.hs
@@ -1,4 +1,5 @@
-{-# LANGUAGE GADTs #-}
+{-# LANGUAGE CPP, GADTs, UnboxedTuples #-}
+
 -----------------------------------------------------------------------------
 --
 -- Monad for Stg to C-- code generation
@@ -19,9 +20,10 @@ module StgCmmMonad (
         emit, emitDecl, emitProc,
         emitProcWithConvention, emitProcWithStackFrame,
         emitOutOfLine, emitAssign, emitStore, emitComment,
+        emitTick, emitUnwind,
 
         getCmm, aGraphToGraph,
-        getCodeR, getCode, getHeapUsage,
+        getCodeR, getCode, getCodeScoped, getHeapUsage,
 
         mkCmmIfThenElse, mkCmmIfThen, mkCmmIfGoto,
         mkCall, mkCmmCall,
@@ -34,6 +36,7 @@ module StgCmmMonad (
         withSequel, getSequel,
 
         setTickyCtrLabel, getTickyCtrLabel,
+        tickScope, getTickScope,
 
         withUpdFrameOff, getUpdFrameOff, initUpdFrameOff,
 
@@ -73,11 +76,13 @@ import Unique
 import UniqSupply
 import FastString
 import Outputable
+import CoreSyn (RawTickish)
 
 import qualified Control.Applicative as A
 import Control.Monad
 import Data.List
 import Prelude hiding( sequence, succ )
+import Control.Arrow ( first )
 
 infixr 9 `thenC`        -- Right-associative!
 infixr 9 `thenFC`
@@ -179,10 +184,11 @@ data CgInfoDownwards        -- information only passed *downwards* by the monad
         cgd_updfr_off :: UpdFrameOffset,    -- Size of current update frame
         cgd_ticky     :: CLabel,            -- Current destination for ticky counts
         cgd_sequel    :: Sequel,            -- What to do at end of basic block
-        cgd_self_loop :: Maybe SelfLoopInfo -- Which tail calls can be compiled
+        cgd_self_loop :: Maybe SelfLoopInfo,-- Which tail calls can be compiled
                                             -- as local jumps? See Note
                                             -- [Self-recursive tail calls] in
                                             -- StgCmmExpr
+        cgd_tick_scope:: [CmmTickScope]     -- Contexts ticks should be added to
   }
 
 type CgBindings = IdEnv CgIdInfo
@@ -303,7 +309,8 @@ initCgInfoDown dflags mod
                  , cgd_updfr_off = initUpdFrameOff dflags
                  , cgd_ticky     = mkTopTickyCtrLabel
                  , cgd_sequel    = initSequel
-                 , cgd_self_loop = Nothing }
+                 , cgd_self_loop = Nothing
+                 , cgd_tick_scope= [] }
 
 initSequel :: Sequel
 initSequel = Return False
@@ -331,17 +338,47 @@ data CgState
 
      cgs_uniqs :: UniqSupply }
 
-data HeapUsage =
-  HeapUsage {
+data HeapUsage   -- See Note [Virtual and real heap pointers]
+  = HeapUsage {
         virtHp :: VirtualHpOffset,       -- Virtual offset of highest-allocated word
                                          --   Incremented whenever we allocate
         realHp :: VirtualHpOffset        -- realHp: Virtual offset of real heap ptr
                                          --   Used in instruction addressing modes
-  }
+    }
 
 type VirtualHpOffset = WordOff
 
 
+{- Note [Virtual and real heap pointers]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+The code generator can allocate one or more objects contiguously, performing
+one heap check to cover allocation of all the objects at once.  Let's call
+this little chunk of heap space an "allocation chunk".  The code generator
+will emit code to
+  * Perform a heap-exhaustion check
+  * Move the heap pointer to the end of the allocation chunk
+  * Allocate multiple objects within the chunk
+
+The code generator uses VirtualHpOffsets to address words within a
+single allocation chunk; these start at one and increase positively.
+The first word of the chunk has VirtualHpOffset=1, the second has
+VirtualHpOffset=2, and so on.
+
+ * The field realHp tracks (the VirtualHpOffset) where the real Hp
+   register is pointing.  Typically it'll be pointing to the end of the
+   allocation chunk.
+
+ * The field virtHp gives the VirtualHpOffset of the highest-allocated
+   word so far.  It starts at zero (meaning no word has been allocated),
+   and increases whenever an object is allocated.
+
+The difference between realHp and virtHp gives the offset from the
+real Hp register of a particular word in the allocation chunk. This
+is what getHpRelOffset does.  Since the returned offset is relative
+to the real Hp register, it is valid only until you change the real
+Hp register.  (Changing virtHp doesn't matter.)
+-}
+
 
 initCgState :: UniqSupply -> CgState
 initCgState uniqs
@@ -463,7 +500,7 @@ withSelfLoop self_loop code = do
 instance HasDynFlags FCode where
     getDynFlags = liftM cgd_dflags getInfoDown
 
-getThisPackage :: FCode PackageId
+getThisPackage :: FCode PackageKey
 getThisPackage = liftM thisPackage getDynFlags
 
 withInfoDown :: FCode a -> CgInfoDownwards -> FCode a
@@ -525,6 +562,20 @@ setTickyCtrLabel ticky code = do
         info <- getInfoDown
         withInfoDown code (info {cgd_ticky = ticky})
 
+-- ----------------------------------------------------------------------------
+-- Manage tick scopes
+
+getTickScope :: FCode [CmmTickScope]
+getTickScope = do
+        info <- getInfoDown
+        return (cgd_tick_scope info)
+
+tickScope :: FCode a -> FCode a
+tickScope code = do
+        scope <- newUnique
+        info <- getInfoDown
+        withInfoDown code $ info { cgd_tick_scope = scope : cgd_tick_scope info }
+
 
 --------------------------------------------------------
 --                 Forking
@@ -613,6 +664,20 @@ getCodeR fcode
 getCode :: FCode a -> FCode CmmAGraph
 getCode fcode = do { (_,stmts) <- getCodeR fcode; return stmts }
 
+-- | Generate code into a fresh tick scope and gather generated code
+getCodeScoped :: FCode a -> FCode (a, CmmAGraphScoped)
+getCodeScoped fcode
+  = do  { state1 <- getState
+        ; ((a, tscope), state2) <-
+            tickScope $
+            flip withState state1 { cgs_stmts = mkNop } $
+            do { a   <- fcode
+               ; scp <- getTickScope
+               ; return (a, scp) }
+        ; setState $ state2 { cgs_stmts = cgs_stmts state1  }
+        ; return (a, (cgs_stmts state2, tscope)) }
+
+
 -- 'getHeapUsage' applies a function to the amount of heap that it uses.
 -- It initialises the heap usage to zeros, and passes on an unchanged
 -- heap usage.
@@ -643,7 +708,8 @@ emitCgStmt stmt
         }
 
 emitLabel :: BlockId -> FCode ()
-emitLabel id = emitCgStmt (CgLabel id)
+emitLabel id = do tscope <- getTickScope
+                  emitCgStmt (CgLabel id tscope)
 
 emitComment :: FastString -> FCode ()
 #if 0 /* def DEBUG */
@@ -652,6 +718,15 @@ emitComment s = emitCgStmt (CgStmt (CmmComment s))
 emitComment _ = return ()
 #endif
 
+emitTick :: RawTickish -> FCode ()
+emitTick = emitCgStmt . CgStmt . CmmTick
+
+emitUnwind :: GlobalReg -> CmmExpr -> FCode ()
+emitUnwind g e = do
+  dflags <- getDynFlags
+  when (gopt Opt_Debug dflags) $
+     emitCgStmt $ CgStmt $ CmmUnwind g e
+
 emitAssign :: CmmReg  -> CmmExpr -> FCode ()
 emitAssign l r = emitCgStmt (CgStmt (CmmAssign l r))
 
@@ -673,7 +748,7 @@ emitDecl decl
   = do  { state <- getState
         ; setState $ state { cgs_tops = cgs_tops state `snocOL` decl } }
 
-emitOutOfLine :: BlockId -> CmmAGraph -> FCode ()
+emitOutOfLine :: BlockId -> CmmAGraphScoped -> FCode ()
 emitOutOfLine l stmts = emitCgStmt (CgFork l stmts)
 
 emitProcWithStackFrame
@@ -682,7 +757,7 @@ emitProcWithStackFrame
    -> CLabel                            -- label for the proc
    -> [CmmFormal]                       -- stack frame
    -> [CmmFormal]                       -- arguments
-   -> CmmAGraph                         -- code
+   -> CmmAGraphScoped                   -- code
    -> Bool                              -- do stack layout?
    -> FCode ()
 
@@ -693,22 +768,22 @@ emitProcWithStackFrame _conv mb_info lbl _stk_args [] blocks False
 emitProcWithStackFrame conv mb_info lbl stk_args args blocks True -- do layout
   = do  { dflags <- getDynFlags
         ; let (offset, live, entry) = mkCallEntry dflags conv args stk_args
-        ; emitProc_ mb_info lbl live (entry <*> blocks) offset True
+        ; emitProc_ mb_info lbl live (first (entry <*>) blocks) offset True
         }
 emitProcWithStackFrame _ _ _ _ _ _ _ = panic "emitProcWithStackFrame"
 
 emitProcWithConvention :: Convention -> Maybe CmmInfoTable -> CLabel
                        -> [CmmFormal]
-                       -> CmmAGraph
+                       -> CmmAGraphScoped
                        -> FCode ()
 emitProcWithConvention conv mb_info lbl args blocks
   = emitProcWithStackFrame conv mb_info lbl [] args blocks True
 
-emitProc :: Maybe CmmInfoTable -> CLabel -> [GlobalReg] -> CmmAGraph -> Int -> FCode ()
+emitProc :: Maybe CmmInfoTable -> CLabel -> [GlobalReg] -> CmmAGraphScoped -> Int -> FCode ()
 emitProc  mb_info lbl live blocks offset
  = emitProc_ mb_info lbl live blocks offset True
 
-emitProc_ :: Maybe CmmInfoTable -> CLabel -> [GlobalReg] -> CmmAGraph -> Int -> Bool
+emitProc_ :: Maybe CmmInfoTable -> CLabel -> [GlobalReg] -> CmmAGraphScoped -> Int -> Bool
           -> FCode ()
 emitProc_ mb_info lbl live blocks offset do_layout
   = do  { dflags <- getDynFlags
@@ -744,24 +819,27 @@ getCmm code
 
 mkCmmIfThenElse :: CmmExpr -> CmmAGraph -> CmmAGraph -> FCode CmmAGraph
 mkCmmIfThenElse e tbranch fbranch = do
+  tscp  <- getTickScope
   endif <- newLabelC
   tid   <- newLabelC
   fid   <- newLabelC
   return $ mkCbranch e tid fid <*>
-            mkLabel tid <*> tbranch <*> mkBranch endif <*>
-            mkLabel fid <*> fbranch <*> mkLabel endif
+            mkLabel tid tscp <*> tbranch <*> mkBranch endif <*>
+            mkLabel fid tscp <*> fbranch <*> mkLabel endif tscp
 
 mkCmmIfGoto :: CmmExpr -> BlockId -> FCode CmmAGraph
 mkCmmIfGoto e tid = do
   endif <- newLabelC
-  return $ mkCbranch e tid endif <*> mkLabel endif
+  tscp  <- getTickScope
+  return $ mkCbranch e tid endif <*> mkLabel endif tscp
 
 mkCmmIfThen :: CmmExpr -> CmmAGraph -> FCode CmmAGraph
 mkCmmIfThen e tbranch = do
   endif <- newLabelC
   tid   <- newLabelC
+  tscp  <- getTickScope
   return $ mkCbranch e tid endif <*>
-         mkLabel tid <*> tbranch <*> mkLabel endif
+           mkLabel tid tscp <*> tbranch <*> mkLabel endif tscp
 
 
 mkCall :: CmmExpr -> (Convention, Convention) -> [CmmFormal] -> [CmmActual]
@@ -769,10 +847,11 @@ mkCall :: CmmExpr -> (Convention, Convention) -> [CmmFormal] -> [CmmActual]
 mkCall f (callConv, retConv) results actuals updfr_off extra_stack = do
   dflags <- getDynFlags
   k      <- newLabelC
+  tscp   <- getTickScope
   let area = Young k
       (off, _, copyin) = copyInOflow dflags retConv area results []
       copyout = mkCallReturnsTo dflags f callConv actuals k off updfr_off extra_stack
-  return (copyout <*> mkLabel k <*> copyin)
+  return (copyout <*> mkLabel k tscp <*> copyin)
 
 mkCmmCall :: CmmExpr -> [CmmFormal] -> [CmmActual] -> UpdFrameOffset
           -> FCode CmmAGraph
@@ -783,7 +862,7 @@ mkCmmCall f results actuals updfr_off
 -- ----------------------------------------------------------------------------
 -- turn CmmAGraph into CmmGraph, for making a new proc.
 
-aGraphToGraph :: CmmAGraph -> FCode CmmGraph
+aGraphToGraph :: CmmAGraphScoped -> FCode CmmGraph
 aGraphToGraph stmts
   = do  { l <- newLabelC
         ; return (labelAGraph l stmts) }
diff --git a/compiler/codeGen/StgCmmPrim.hs b/compiler/codeGen/StgCmmPrim.hs
index 6411e89a5484..9e1242735554 100644
--- a/compiler/codeGen/StgCmmPrim.hs
+++ b/compiler/codeGen/StgCmmPrim.hs
@@ -1,4 +1,6 @@
------------------------------------------------------------------------------
+{-# LANGUAGE CPP #-}
+
+----------------------------------------------------------------------------
 --
 -- Stg to C--: primitive operations
 --
@@ -8,8 +10,9 @@
 
 module StgCmmPrim (
    cgOpApp,
-   cgPrimOp -- internal(ish), used by cgCase to get code for a
-            -- comparison without also turning it into a Bool.
+   cgPrimOp, -- internal(ish), used by cgCase to get code for a
+             -- comparison without also turning it into a Bool.
+   shouldInlinePrimOp
  ) where
 
 #include "HsVersions.h"
@@ -40,8 +43,8 @@ import FastString
 import Outputable
 import Util
 
+import Data.Bits ((.&.), bit)
 import Control.Monad (liftM, when)
-import Data.Bits
 
 ------------------------------------------------------------------------
 --      Primitive operations and foreign calls
@@ -86,36 +89,163 @@ cgOpApp (StgPrimOp TagToEnumOp) [arg] res_ty
           -- That won't work.
         tycon = tyConAppTyCon res_ty
 
-cgOpApp (StgPrimOp primop) args res_ty
-  | primOpOutOfLine primop
-  = do  { cmm_args <- getNonVoidArgAmodes args
-        ; let fun = CmmLit (CmmLabel (mkRtsPrimOpLabel primop))
-        ; emitCall (NativeNodeCall, NativeReturn) fun cmm_args }
-
-  | ReturnsPrim VoidRep <- result_info
-  = do cgPrimOp [] primop args
-       emitReturn []
-
-  | ReturnsPrim rep <- result_info
-  = do dflags <- getDynFlags
-       res <- newTemp (primRepCmmType dflags rep)
-       cgPrimOp [res] primop args
-       emitReturn [CmmReg (CmmLocal res)]
-
-  | ReturnsAlg tycon <- result_info, isUnboxedTupleTyCon tycon
-  = do (regs, _hints) <- newUnboxedTupleRegs res_ty
-       cgPrimOp regs primop args
-       emitReturn (map (CmmReg . CmmLocal) regs)
-
-  | otherwise = panic "cgPrimop"
-  where
-     result_info = getPrimOpResultInfo primop
+cgOpApp (StgPrimOp primop) args res_ty = do
+    dflags <- getDynFlags
+    cmm_args <- getNonVoidArgAmodes args
+    case shouldInlinePrimOp dflags primop cmm_args of
+        Nothing -> do  -- out-of-line
+          let fun = CmmLit (CmmLabel (mkRtsPrimOpLabel primop))
+          emitCall (NativeNodeCall, NativeReturn) fun cmm_args
+
+        Just f  -- inline
+          | ReturnsPrim VoidRep <- result_info
+          -> do f []
+                emitReturn []
+
+          | ReturnsPrim rep <- result_info
+          -> do dflags <- getDynFlags
+                res <- newTemp (primRepCmmType dflags rep)
+                f [res]
+                emitReturn [CmmReg (CmmLocal res)]
+
+          | ReturnsAlg tycon <- result_info, isUnboxedTupleTyCon tycon
+          -> do (regs, _hints) <- newUnboxedTupleRegs res_ty
+                f regs
+                emitReturn (map (CmmReg . CmmLocal) regs)
+
+          | otherwise -> panic "cgPrimop"
+          where
+             result_info = getPrimOpResultInfo primop
 
 cgOpApp (StgPrimCallOp primcall) args _res_ty
   = do  { cmm_args <- getNonVoidArgAmodes args
         ; let fun = CmmLit (CmmLabel (mkPrimCallLabel primcall))
         ; emitCall (NativeNodeCall, NativeReturn) fun cmm_args }
 
+-- | Interpret the argument as an unsigned value, assuming the value
+-- is given in two-complement form in the given width.
+--
+-- Example: @asUnsigned W64 (-1)@ is 18446744073709551615.
+--
+-- This function is used to work around the fact that many array
+-- primops take Int# arguments, but we interpret them as unsigned
+-- quantities in the code gen. This means that we have to be careful
+-- every time we work on e.g. a CmmInt literal that corresponds to the
+-- array size, as it might contain a negative Integer value if the
+-- user passed a value larger than 2^(wORD_SIZE_IN_BITS-1) as the Int#
+-- literal.
+asUnsigned :: Width -> Integer -> Integer
+asUnsigned w n = n .&. (bit (widthInBits w) - 1)
+
+-- TODO: Several primop implementations (e.g. 'doNewByteArrayOp') use
+--     ByteOff (or some other fixed width signed type) to represent
+--     array sizes or indices. This means that these will overflow for
+--     large enough sizes.
+
+-- | Decide whether an out-of-line primop should be replaced by an
+-- inline implementation. This might happen e.g. if there's enough
+-- static information, such as statically know arguments, to emit a
+-- more efficient implementation inline.
+--
+-- Returns 'Nothing' if this primop should use its out-of-line
+-- implementation (defined elsewhere) and 'Just' together with a code
+-- generating function that takes the output regs as arguments
+-- otherwise.
+shouldInlinePrimOp :: DynFlags
+                   -> PrimOp     -- ^ The primop
+                   -> [CmmExpr]  -- ^ The primop arguments
+                   -> Maybe ([LocalReg] -> FCode ())
+
+shouldInlinePrimOp dflags NewByteArrayOp_Char [(CmmLit (CmmInt n w))]
+  | asUnsigned w n <= fromIntegral (maxInlineAllocSize dflags) =
+      Just $ \ [res] -> doNewByteArrayOp res (fromInteger n)
+
+shouldInlinePrimOp dflags NewArrayOp [(CmmLit (CmmInt n w)), init]
+  | wordsToBytes dflags (asUnsigned w n) <= fromIntegral (maxInlineAllocSize dflags) =
+      Just $ \ [res] ->
+      doNewArrayOp res (arrPtrsRep dflags (fromInteger n)) mkMAP_DIRTY_infoLabel
+      [ (mkIntExpr dflags (fromInteger n),
+         fixedHdrSize dflags + oFFSET_StgMutArrPtrs_ptrs dflags)
+      , (mkIntExpr dflags (nonHdrSizeW (arrPtrsRep dflags (fromInteger n))),
+         fixedHdrSize dflags + oFFSET_StgMutArrPtrs_size dflags)
+      ]
+      (fromInteger n) init
+
+shouldInlinePrimOp _ CopyArrayOp
+    [src, src_off, dst, dst_off, (CmmLit (CmmInt n _))] =
+        Just $ \ [] -> doCopyArrayOp src src_off dst dst_off (fromInteger n)
+
+shouldInlinePrimOp _ CopyMutableArrayOp
+    [src, src_off, dst, dst_off, (CmmLit (CmmInt n _))] =
+        Just $ \ [] -> doCopyMutableArrayOp src src_off dst dst_off (fromInteger n)
+
+shouldInlinePrimOp _ CopyArrayArrayOp
+    [src, src_off, dst, dst_off, (CmmLit (CmmInt n _))] =
+        Just $ \ [] -> doCopyArrayOp src src_off dst dst_off (fromInteger n)
+
+shouldInlinePrimOp _ CopyMutableArrayArrayOp
+    [src, src_off, dst, dst_off, (CmmLit (CmmInt n _))] =
+        Just $ \ [] -> doCopyMutableArrayOp src src_off dst dst_off (fromInteger n)
+
+shouldInlinePrimOp dflags CloneArrayOp [src, src_off, (CmmLit (CmmInt n w))]
+  | wordsToBytes dflags (asUnsigned w n) <= fromIntegral (maxInlineAllocSize dflags) =
+      Just $ \ [res] -> emitCloneArray mkMAP_FROZEN_infoLabel res src src_off (fromInteger n)
+
+shouldInlinePrimOp dflags CloneMutableArrayOp [src, src_off, (CmmLit (CmmInt n w))]
+  | wordsToBytes dflags (asUnsigned w n) <= fromIntegral (maxInlineAllocSize dflags) =
+      Just $ \ [res] -> emitCloneArray mkMAP_DIRTY_infoLabel res src src_off (fromInteger n)
+
+shouldInlinePrimOp dflags FreezeArrayOp [src, src_off, (CmmLit (CmmInt n w))]
+  | wordsToBytes dflags (asUnsigned w n) <= fromIntegral (maxInlineAllocSize dflags) =
+      Just $ \ [res] -> emitCloneArray mkMAP_FROZEN_infoLabel res src src_off (fromInteger n)
+
+shouldInlinePrimOp dflags ThawArrayOp [src, src_off, (CmmLit (CmmInt n w))]
+  | wordsToBytes dflags (asUnsigned w n) <= fromIntegral (maxInlineAllocSize dflags) =
+      Just $ \ [res] -> emitCloneArray mkMAP_DIRTY_infoLabel res src src_off (fromInteger n)
+
+shouldInlinePrimOp dflags NewSmallArrayOp [(CmmLit (CmmInt n w)), init]
+  | wordsToBytes dflags (asUnsigned w n) <= fromIntegral (maxInlineAllocSize dflags) =
+      Just $ \ [res] ->
+      doNewArrayOp res (smallArrPtrsRep (fromInteger n)) mkSMAP_DIRTY_infoLabel
+      [ (mkIntExpr dflags (fromInteger n),
+         fixedHdrSize dflags + oFFSET_StgSmallMutArrPtrs_ptrs dflags)
+      ]
+      (fromInteger n) init
+
+shouldInlinePrimOp _ CopySmallArrayOp
+    [src, src_off, dst, dst_off, (CmmLit (CmmInt n _))] =
+        Just $ \ [] -> doCopySmallArrayOp src src_off dst dst_off (fromInteger n)
+
+shouldInlinePrimOp _ CopySmallMutableArrayOp
+    [src, src_off, dst, dst_off, (CmmLit (CmmInt n _))] =
+        Just $ \ [] -> doCopySmallMutableArrayOp src src_off dst dst_off (fromInteger n)
+
+shouldInlinePrimOp dflags CloneSmallArrayOp [src, src_off, (CmmLit (CmmInt n w))]
+  | wordsToBytes dflags (asUnsigned w n) <= fromIntegral (maxInlineAllocSize dflags) =
+      Just $ \ [res] -> emitCloneSmallArray mkSMAP_FROZEN_infoLabel res src src_off (fromInteger n)
+
+shouldInlinePrimOp dflags CloneSmallMutableArrayOp [src, src_off, (CmmLit (CmmInt n w))]
+  | wordsToBytes dflags (asUnsigned w n) <= fromIntegral (maxInlineAllocSize dflags) =
+      Just $ \ [res] -> emitCloneSmallArray mkSMAP_DIRTY_infoLabel res src src_off (fromInteger n)
+
+shouldInlinePrimOp dflags FreezeSmallArrayOp [src, src_off, (CmmLit (CmmInt n w))]
+  | wordsToBytes dflags (asUnsigned w n) <= fromIntegral (maxInlineAllocSize dflags) =
+      Just $ \ [res] -> emitCloneSmallArray mkSMAP_FROZEN_infoLabel res src src_off (fromInteger n)
+
+shouldInlinePrimOp dflags ThawSmallArrayOp [src, src_off, (CmmLit (CmmInt n w))]
+  | wordsToBytes dflags (asUnsigned w n) <= fromIntegral (maxInlineAllocSize dflags) =
+      Just $ \ [res] -> emitCloneSmallArray mkSMAP_DIRTY_infoLabel res src src_off (fromInteger n)
+
+shouldInlinePrimOp dflags primop args
+  | primOpOutOfLine primop = Nothing
+  | otherwise = Just $ \ regs -> emitPrimOp dflags regs primop args
+
+-- TODO: Several primops, such as 'copyArray#', only have an inline
+-- implementation (below) but could possibly have both an inline
+-- implementation and an out-of-line implementation, just like
+-- 'newArray#'. This would lower the amount of code generated,
+-- hopefully without a performance impact (needs to be measured).
+
 ---------------------------------------------------
 cgPrimOp   :: [LocalReg]        -- where to put the results
            -> PrimOp            -- the op
@@ -141,63 +271,6 @@ emitPrimOp :: DynFlags
 -- First we handle various awkward cases specially.  The remaining
 -- easy cases are then handled by translateOp, defined below.
 
-emitPrimOp dflags [res_r,res_c] IntAddCOp [aa,bb]
-{-
-   With some bit-twiddling, we can define int{Add,Sub}Czh portably in
-   C, and without needing any comparisons.  This may not be the
-   fastest way to do it - if you have better code, please send it! --SDM
-
-   Return : r = a + b,  c = 0 if no overflow, 1 on overflow.
-
-   We currently don't make use of the r value if c is != 0 (i.e.
-   overflow), we just convert to big integers and try again.  This
-   could be improved by making r and c the correct values for
-   plugging into a new J#.
-
-   { r = ((I_)(a)) + ((I_)(b));                                 \
-     c = ((StgWord)(~(((I_)(a))^((I_)(b))) & (((I_)(a))^r)))    \
-         >> (BITS_IN (I_) - 1);                                 \
-   }
-   Wading through the mass of bracketry, it seems to reduce to:
-   c = ( (~(a^b)) & (a^r) ) >>unsigned (BITS_IN(I_)-1)
-
--}
-   = emit $ catAGraphs [
-        mkAssign (CmmLocal res_r) (CmmMachOp (mo_wordAdd dflags) [aa,bb]),
-        mkAssign (CmmLocal res_c) $
-          CmmMachOp (mo_wordUShr dflags) [
-                CmmMachOp (mo_wordAnd dflags) [
-                    CmmMachOp (mo_wordNot dflags) [CmmMachOp (mo_wordXor dflags) [aa,bb]],
-                    CmmMachOp (mo_wordXor dflags) [aa, CmmReg (CmmLocal res_r)]
-                ],
-                mkIntExpr dflags (wORD_SIZE_IN_BITS dflags - 1)
-          ]
-     ]
-
-
-emitPrimOp dflags [res_r,res_c] IntSubCOp [aa,bb]
-{- Similarly:
-   #define subIntCzh(r,c,a,b)                                   \
-   { r = ((I_)(a)) - ((I_)(b));                                 \
-     c = ((StgWord)((((I_)(a))^((I_)(b))) & (((I_)(a))^r)))     \
-         >> (BITS_IN (I_) - 1);                                 \
-   }
-
-   c =  ((a^b) & (a^r)) >>unsigned (BITS_IN(I_)-1)
--}
-   = emit $ catAGraphs [
-        mkAssign (CmmLocal res_r) (CmmMachOp (mo_wordSub dflags) [aa,bb]),
-        mkAssign (CmmLocal res_c) $
-          CmmMachOp (mo_wordUShr dflags) [
-                CmmMachOp (mo_wordAnd dflags) [
-                    CmmMachOp (mo_wordXor dflags) [aa,bb],
-                    CmmMachOp (mo_wordXor dflags) [aa, CmmReg (CmmLocal res_r)]
-                ],
-                mkIntExpr dflags (wORD_SIZE_IN_BITS dflags - 1)
-          ]
-     ]
-
-
 emitPrimOp _ [res] ParOp [arg]
   =
         -- for now, just implement this in a C function
@@ -231,10 +304,10 @@ emitPrimOp _ [res] GetCurrentCCSOp [_dummy_arg]
    = emitAssign (CmmLocal res) curCCS
 
 emitPrimOp dflags [res] ReadMutVarOp [mutv]
-   = emitAssign (CmmLocal res) (cmmLoadIndexW dflags mutv (fixedHdrSize dflags) (gcWord dflags))
+   = emitAssign (CmmLocal res) (cmmLoadIndexW dflags mutv (fixedHdrSizeW dflags) (gcWord dflags))
 
 emitPrimOp dflags [] WriteMutVarOp [mutv,var]
-   = do emitStore (cmmOffsetW dflags mutv (fixedHdrSize dflags)) var
+   = do emitStore (cmmOffsetW dflags mutv (fixedHdrSizeW dflags)) var
         emitCCall
                 [{-no results-}]
                 (CmmLit (CmmLabel mkDirty_MUT_VAR_Label))
@@ -243,7 +316,7 @@ emitPrimOp dflags [] WriteMutVarOp [mutv,var]
 --  #define sizzeofByteArrayzh(r,a) \
 --     r = ((StgArrWords *)(a))->bytes
 emitPrimOp dflags [res] SizeofByteArrayOp [arg]
-   = emit $ mkAssign (CmmLocal res) (cmmLoadIndexW dflags arg (fixedHdrSize dflags) (bWord dflags))
+   = emit $ mkAssign (CmmLocal res) (cmmLoadIndexW dflags arg (fixedHdrSizeW dflags) (bWord dflags))
 
 --  #define sizzeofMutableByteArrayzh(r,a) \
 --      r = ((StgArrWords *)(a))->bytes
@@ -261,14 +334,14 @@ emitPrimOp dflags [res] ByteArrayContents_Char [arg]
 
 --  #define stableNameToIntzh(r,s)   (r = ((StgStableName *)s)->sn)
 emitPrimOp dflags [res] StableNameToIntOp [arg]
-   = emitAssign (CmmLocal res) (cmmLoadIndexW dflags arg (fixedHdrSize dflags) (bWord dflags))
+   = emitAssign (CmmLocal res) (cmmLoadIndexW dflags arg (fixedHdrSizeW dflags) (bWord dflags))
 
 --  #define eqStableNamezh(r,sn1,sn2)                                   \
 --    (r = (((StgStableName *)sn1)->sn == ((StgStableName *)sn2)->sn))
 emitPrimOp dflags [res] EqStableNameOp [arg1,arg2]
    = emitAssign (CmmLocal res) (CmmMachOp (mo_wordEq dflags) [
-                                   cmmLoadIndexW dflags arg1 (fixedHdrSize dflags) (bWord dflags),
-                                   cmmLoadIndexW dflags arg2 (fixedHdrSize dflags) (bWord dflags)
+                                   cmmLoadIndexW dflags arg1 (fixedHdrSizeW dflags) (bWord dflags),
+                                   cmmLoadIndexW dflags arg2 (fixedHdrSizeW dflags) (bWord dflags)
                          ])
 
 
@@ -296,37 +369,21 @@ emitPrimOp dflags [res] DataToTagOp [arg]
 --      }
 emitPrimOp _      [res] UnsafeFreezeArrayOp [arg]
    = emit $ catAGraphs
-   [ setInfo arg (CmmLit (CmmLabel mkMAP_FROZEN_infoLabel)),
+   [ setInfo arg (CmmLit (CmmLabel mkMAP_FROZEN0_infoLabel)),
      mkAssign (CmmLocal res) arg ]
 emitPrimOp _      [res] UnsafeFreezeArrayArrayOp [arg]
    = emit $ catAGraphs
-   [ setInfo arg (CmmLit (CmmLabel mkMAP_FROZEN_infoLabel)),
+   [ setInfo arg (CmmLit (CmmLabel mkMAP_FROZEN0_infoLabel)),
+     mkAssign (CmmLocal res) arg ]
+emitPrimOp _      [res] UnsafeFreezeSmallArrayOp [arg]
+   = emit $ catAGraphs
+   [ setInfo arg (CmmLit (CmmLabel mkSMAP_FROZEN0_infoLabel)),
      mkAssign (CmmLocal res) arg ]
 
 --  #define unsafeFreezzeByteArrayzh(r,a)       r=(a)
 emitPrimOp _      [res] UnsafeFreezeByteArrayOp [arg]
    = emitAssign (CmmLocal res) arg
 
--- Copying pointer arrays
-
-emitPrimOp _      [] CopyArrayOp [src,src_off,dst,dst_off,n] =
-    doCopyArrayOp src src_off dst dst_off n
-emitPrimOp _      [] CopyMutableArrayOp [src,src_off,dst,dst_off,n] =
-    doCopyMutableArrayOp src src_off dst dst_off n
-emitPrimOp _      [res] CloneArrayOp [src,src_off,n] =
-    emitCloneArray mkMAP_FROZEN_infoLabel res src src_off n
-emitPrimOp _      [res] CloneMutableArrayOp [src,src_off,n] =
-    emitCloneArray mkMAP_DIRTY_infoLabel res src src_off n
-emitPrimOp _      [res] FreezeArrayOp [src,src_off,n] =
-    emitCloneArray mkMAP_FROZEN_infoLabel res src src_off n
-emitPrimOp _      [res] ThawArrayOp [src,src_off,n] =
-    emitCloneArray mkMAP_DIRTY_infoLabel res src src_off n
-
-emitPrimOp _      [] CopyArrayArrayOp [src,src_off,dst,dst_off,n] =
-    doCopyArrayOp src src_off dst dst_off n
-emitPrimOp _      [] CopyMutableArrayArrayOp [src,src_off,dst,dst_off,n] =
-    doCopyMutableArrayOp src src_off dst dst_off n
-
 -- Reading/writing pointer arrays
 
 emitPrimOp _      [res] ReadArrayOp  [obj,ix]    = doReadPtrArrayOp res obj ix
@@ -344,8 +401,14 @@ emitPrimOp _      []  WriteArrayArrayOp_MutableByteArray  [obj,ix,v] = doWritePt
 emitPrimOp _      []  WriteArrayArrayOp_ArrayArray        [obj,ix,v] = doWritePtrArrayOp obj ix v
 emitPrimOp _      []  WriteArrayArrayOp_MutableArrayArray [obj,ix,v] = doWritePtrArrayOp obj ix v
 
+emitPrimOp _      [res] ReadSmallArrayOp  [obj,ix] = doReadSmallPtrArrayOp res obj ix
+emitPrimOp _      [res] IndexSmallArrayOp [obj,ix] = doReadSmallPtrArrayOp res obj ix
+emitPrimOp _      []  WriteSmallArrayOp [obj,ix,v] = doWriteSmallPtrArrayOp obj ix v
+
+-- Getting the size of pointer arrays
+
 emitPrimOp dflags [res] SizeofArrayOp [arg]
-   = emit $ mkAssign (CmmLocal res) (cmmLoadIndexW dflags arg (fixedHdrSize dflags + oFFSET_StgMutArrPtrs_ptrs dflags) (bWord dflags))
+   = emit $ mkAssign (CmmLocal res) (cmmLoadIndexW dflags arg (fixedHdrSizeW dflags + oFFSET_StgMutArrPtrs_ptrs dflags) (bWord dflags))
 emitPrimOp dflags [res] SizeofMutableArrayOp [arg]
    = emitPrimOp dflags [res] SizeofArrayOp [arg]
 emitPrimOp dflags [res] SizeofArrayArrayOp [arg]
@@ -353,6 +416,13 @@ emitPrimOp dflags [res] SizeofArrayArrayOp [arg]
 emitPrimOp dflags [res] SizeofMutableArrayArrayOp [arg]
    = emitPrimOp dflags [res] SizeofArrayOp [arg]
 
+emitPrimOp dflags [res] SizeofSmallArrayOp [arg] =
+    emit $ mkAssign (CmmLocal res)
+    (cmmLoadIndexW dflags arg
+     (fixedHdrSizeW dflags + oFFSET_StgSmallMutArrPtrs_ptrs dflags) (bWord dflags))
+emitPrimOp dflags [res] SizeofSmallMutableArrayOp [arg] =
+    emitPrimOp dflags [res] SizeofSmallArrayOp [arg]
+
 -- IndexXXXoffAddr
 
 emitPrimOp dflags res IndexOffAddrOp_Char             args = doIndexOffAddrOp   (Just (mo_u_8ToWord dflags)) b8 res args
@@ -493,6 +563,20 @@ emitPrimOp _      [res] PopCnt32Op [w] = emitPopCntCall res w W32
 emitPrimOp _      [res] PopCnt64Op [w] = emitPopCntCall res w W64
 emitPrimOp dflags [res] PopCntOp   [w] = emitPopCntCall res w (wordWidth dflags)
 
+-- count leading zeros
+emitPrimOp _      [res] Clz8Op  [w] = emitClzCall res w W8
+emitPrimOp _      [res] Clz16Op [w] = emitClzCall res w W16
+emitPrimOp _      [res] Clz32Op [w] = emitClzCall res w W32
+emitPrimOp _      [res] Clz64Op [w] = emitClzCall res w W64
+emitPrimOp dflags [res] ClzOp   [w] = emitClzCall res w (wordWidth dflags)
+
+-- count trailing zeros
+emitPrimOp _      [res] Ctz8Op [w]  = emitCtzCall res w W8
+emitPrimOp _      [res] Ctz16Op [w] = emitCtzCall res w W16
+emitPrimOp _      [res] Ctz32Op [w] = emitCtzCall res w W32
+emitPrimOp _      [res] Ctz64Op [w] = emitCtzCall res w W64
+emitPrimOp dflags [res] CtzOp   [w] = emitCtzCall res w (wordWidth dflags)
+
 -- Unsigned int to floating point conversions
 emitPrimOp _      [res] Word2FloatOp  [w] = emitPrimCall [res]
                                             (MO_UF_Conv W32) [w]
@@ -663,6 +747,25 @@ emitPrimOp _ res PrefetchByteArrayOp0        args = doPrefetchByteArrayOp 0 res
 emitPrimOp _ res PrefetchMutableByteArrayOp0 args = doPrefetchByteArrayOp 0 res args
 emitPrimOp _ res PrefetchAddrOp0             args = doPrefetchAddrOp 0 res args
 
+-- Atomic read-modify-write
+emitPrimOp dflags [res] FetchAddByteArrayOp_Int [mba, ix, n] =
+    doAtomicRMW res AMO_Add mba ix (bWord dflags) n
+emitPrimOp dflags [res] FetchSubByteArrayOp_Int [mba, ix, n] =
+    doAtomicRMW res AMO_Sub mba ix (bWord dflags) n
+emitPrimOp dflags [res] FetchAndByteArrayOp_Int [mba, ix, n] =
+    doAtomicRMW res AMO_And mba ix (bWord dflags) n
+emitPrimOp dflags [res] FetchNandByteArrayOp_Int [mba, ix, n] =
+    doAtomicRMW res AMO_Nand mba ix (bWord dflags) n
+emitPrimOp dflags [res] FetchOrByteArrayOp_Int [mba, ix, n] =
+    doAtomicRMW res AMO_Or mba ix (bWord dflags) n
+emitPrimOp dflags [res] FetchXorByteArrayOp_Int [mba, ix, n] =
+    doAtomicRMW res AMO_Xor mba ix (bWord dflags) n
+emitPrimOp dflags [res] AtomicReadByteArrayOp_Int [mba, ix] =
+    doAtomicReadByteArray res mba ix (bWord dflags)
+emitPrimOp dflags [] AtomicWriteByteArrayOp_Int [mba, ix, val] =
+    doAtomicWriteByteArray mba ix (bWord dflags) val
+emitPrimOp dflags [res] CasByteArrayOp_Int [mba, ix, old, new] =
+    doCasByteArray res mba ix (bWord dflags) old new
 
 -- The rest just translate straightforwardly
 emitPrimOp dflags [res] op [arg]
@@ -703,6 +806,10 @@ callishPrimOpSupported dflags op
       WordAdd2Op     | ncg && x86ish  -> Left (MO_Add2       (wordWidth dflags))
                      | otherwise      -> Right genericWordAdd2Op
 
+      IntAddCOp                       -> Right genericIntAddCOp
+
+      IntSubCOp                       -> Right genericIntSubCOp
+
       WordMul2Op     | ncg && x86ish  -> Left (MO_U_Mul2     (wordWidth dflags))
                      | otherwise      -> Right genericWordMul2Op
 
@@ -808,6 +915,67 @@ genericWordAdd2Op [res_h, res_l] [arg_x, arg_y]
                    (bottomHalf (CmmReg (CmmLocal r1))))]
 genericWordAdd2Op _ _ = panic "genericWordAdd2Op"
 
+genericIntAddCOp :: GenericOp
+genericIntAddCOp [res_r, res_c] [aa, bb]
+{-
+   With some bit-twiddling, we can define int{Add,Sub}Czh portably in
+   C, and without needing any comparisons.  This may not be the
+   fastest way to do it - if you have better code, please send it! --SDM
+
+   Return : r = a + b,  c = 0 if no overflow, 1 on overflow.
+
+   We currently don't make use of the r value if c is != 0 (i.e.
+   overflow), we just convert to big integers and try again.  This
+   could be improved by making r and c the correct values for
+   plugging into a new J#.
+
+   { r = ((I_)(a)) + ((I_)(b));                                 \
+     c = ((StgWord)(~(((I_)(a))^((I_)(b))) & (((I_)(a))^r)))    \
+         >> (BITS_IN (I_) - 1);                                 \
+   }
+   Wading through the mass of bracketry, it seems to reduce to:
+   c = ( (~(a^b)) & (a^r) ) >>unsigned (BITS_IN(I_)-1)
+
+-}
+ = do dflags <- getDynFlags
+      emit $ catAGraphs [
+        mkAssign (CmmLocal res_r) (CmmMachOp (mo_wordAdd dflags) [aa,bb]),
+        mkAssign (CmmLocal res_c) $
+          CmmMachOp (mo_wordUShr dflags) [
+                CmmMachOp (mo_wordAnd dflags) [
+                    CmmMachOp (mo_wordNot dflags) [CmmMachOp (mo_wordXor dflags) [aa,bb]],
+                    CmmMachOp (mo_wordXor dflags) [aa, CmmReg (CmmLocal res_r)]
+                ],
+                mkIntExpr dflags (wORD_SIZE_IN_BITS dflags - 1)
+          ]
+        ]
+genericIntAddCOp _ _ = panic "genericIntAddCOp"
+
+genericIntSubCOp :: GenericOp
+genericIntSubCOp [res_r, res_c] [aa, bb]
+{- Similarly:
+   #define subIntCzh(r,c,a,b)                                   \
+   { r = ((I_)(a)) - ((I_)(b));                                 \
+     c = ((StgWord)((((I_)(a))^((I_)(b))) & (((I_)(a))^r)))     \
+         >> (BITS_IN (I_) - 1);                                 \
+   }
+
+   c =  ((a^b) & (a^r)) >>unsigned (BITS_IN(I_)-1)
+-}
+ = do dflags <- getDynFlags
+      emit $ catAGraphs [
+        mkAssign (CmmLocal res_r) (CmmMachOp (mo_wordSub dflags) [aa,bb]),
+        mkAssign (CmmLocal res_c) $
+          CmmMachOp (mo_wordUShr dflags) [
+                CmmMachOp (mo_wordAnd dflags) [
+                    CmmMachOp (mo_wordXor dflags) [aa,bb],
+                    CmmMachOp (mo_wordXor dflags) [aa, CmmReg (CmmLocal res_r)]
+                ],
+                mkIntExpr dflags (wORD_SIZE_IN_BITS dflags - 1)
+          ]
+        ]
+genericIntSubCOp _ _ = panic "genericIntSubCOp"
+
 genericWordMul2Op :: GenericOp
 genericWordMul2Op [res_h, res_l] [arg_x, arg_y]
  = do dflags <- getDynFlags
@@ -1013,6 +1181,7 @@ translateOp dflags SameMVarOp             = Just (mo_wordEq dflags)
 translateOp dflags SameMutableArrayOp     = Just (mo_wordEq dflags)
 translateOp dflags SameMutableByteArrayOp = Just (mo_wordEq dflags)
 translateOp dflags SameMutableArrayArrayOp= Just (mo_wordEq dflags)
+translateOp dflags SameSmallMutableArrayOp= Just (mo_wordEq dflags)
 translateOp dflags SameTVarOp             = Just (mo_wordEq dflags)
 translateOp dflags EqStablePtrOp          = Just (mo_wordEq dflags)
 
@@ -1149,7 +1318,7 @@ doWritePtrArrayOp addr idx val
 
 loadArrPtrsSize :: DynFlags -> CmmExpr -> CmmExpr
 loadArrPtrsSize dflags addr = CmmLoad (cmmOffsetB dflags addr off) (bWord dflags)
- where off = fixedHdrSize dflags * wORD_SIZE dflags + oFFSET_StgMutArrPtrs_ptrs dflags
+ where off = fixedHdrSize dflags + oFFSET_StgMutArrPtrs_ptrs dflags
 
 mkBasicIndexedRead :: ByteOff      -- Initial offset in bytes
                    -> Maybe MachOp -- Optional result cast
@@ -1407,6 +1576,32 @@ mkBasicPrefetch locality off res base idx
           [reg] -> emitAssign (CmmLocal reg) base
           _     -> panic "StgCmmPrim: mkBasicPrefetch"
 
+-- ----------------------------------------------------------------------------
+-- Allocating byte arrays
+
+-- | Takes a register to return the newly allocated array in and the
+-- size of the new array in bytes. Allocates a new
+-- 'MutableByteArray#'.
+doNewByteArrayOp :: CmmFormal -> ByteOff -> FCode ()
+doNewByteArrayOp res_r n = do
+    dflags <- getDynFlags
+
+    let info_ptr = mkLblExpr mkArrWords_infoLabel
+        rep = arrWordsRep dflags n
+
+    tickyAllocPrim (mkIntExpr dflags (arrWordsHdrSize dflags))
+        (mkIntExpr dflags (nonHdrSize dflags rep))
+        (zeroExpr dflags)
+
+    let hdr_size = fixedHdrSize dflags
+
+    base <- allocHeapClosure rep info_ptr curCCS
+                     [ (mkIntExpr dflags n,
+                        hdr_size + oFFSET_StgArrWords_bytes dflags)
+                     ]
+
+    emit $ mkAssign (CmmLocal res_r) base
+
 -- ----------------------------------------------------------------------------
 -- Copying byte arrays
 
@@ -1495,6 +1690,47 @@ doSetByteArrayOp ba off len c
          p <- assignTempE $ cmmOffsetExpr dflags (cmmOffsetB dflags ba (arrWordsHdrSize dflags)) off
          emitMemsetCall p c len (mkIntExpr dflags 1)
 
+-- ----------------------------------------------------------------------------
+-- Allocating arrays
+
+-- | Allocate a new array.
+doNewArrayOp :: CmmFormal             -- ^ return register
+             -> SMRep                 -- ^ representation of the array
+             -> CLabel                -- ^ info pointer
+             -> [(CmmExpr, ByteOff)]  -- ^ header payload
+             -> WordOff               -- ^ array size
+             -> CmmExpr               -- ^ initial element
+             -> FCode ()
+doNewArrayOp res_r rep info payload n init = do
+    dflags <- getDynFlags
+
+    let info_ptr = mkLblExpr info
+
+    tickyAllocPrim (mkIntExpr dflags (hdrSize dflags rep))
+        (mkIntExpr dflags (nonHdrSize dflags rep))
+        (zeroExpr dflags)
+
+    base <- allocHeapClosure rep info_ptr curCCS payload
+
+    arr <- CmmLocal `fmap` newTemp (bWord dflags)
+    emit $ mkAssign arr base
+
+    -- Initialise all elements of the the array
+    p <- assignTemp $ cmmOffsetB dflags (CmmReg arr) (hdrSize dflags rep)
+    for <- newLabelC
+    emitLabel for
+    let loopBody =
+            [ mkStore (CmmReg (CmmLocal p)) init
+            , mkAssign (CmmLocal p) (cmmOffsetW dflags (CmmReg (CmmLocal p)) 1)
+            , mkBranch for ]
+    emit =<< mkCmmIfThen
+        (cmmULtWord dflags (CmmReg (CmmLocal p))
+         (cmmOffsetW dflags (CmmReg arr)
+          (hdrSizeW dflags rep + n)))
+        (catAGraphs loopBody)
+
+    emit $ mkAssign (CmmLocal res_r) (CmmReg arr)
+
 -- ----------------------------------------------------------------------------
 -- Copying pointer arrays
 
@@ -1516,7 +1752,7 @@ assignTempE e = do
 -- destination 'MutableArray#', an offset into the destination array,
 -- and the number of elements to copy.  Copies the given number of
 -- elements from the source array to the destination array.
-doCopyArrayOp :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr
+doCopyArrayOp :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> WordOff
               -> FCode ()
 doCopyArrayOp = emitCopyArray copy
   where
@@ -1524,14 +1760,15 @@ doCopyArrayOp = emitCopyArray copy
     -- they're of different types)
     copy _src _dst dst_p src_p bytes =
         do dflags <- getDynFlags
-           emitMemcpyCall dst_p src_p bytes (mkIntExpr dflags (wORD_SIZE dflags))
+           emitMemcpyCall dst_p src_p (mkIntExpr dflags bytes)
+               (mkIntExpr dflags (wORD_SIZE dflags))
 
 
 -- | Takes a source 'MutableArray#', an offset in the source array, a
 -- destination 'MutableArray#', an offset into the destination array,
 -- and the number of elements to copy.  Copies the given number of
 -- elements from the source array to the destination array.
-doCopyMutableArrayOp :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr
+doCopyMutableArrayOp :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> WordOff
                      -> FCode ()
 doCopyMutableArrayOp = emitCopyArray copy
   where
@@ -1541,114 +1778,299 @@ doCopyMutableArrayOp = emitCopyArray copy
     copy src dst dst_p src_p bytes = do
         dflags <- getDynFlags
         [moveCall, cpyCall] <- forkAlts [
-            getCode $ emitMemmoveCall dst_p src_p bytes (mkIntExpr dflags (wORD_SIZE dflags)),
-            getCode $ emitMemcpyCall  dst_p src_p bytes (mkIntExpr dflags (wORD_SIZE dflags))
+            getCode $ emitMemmoveCall dst_p src_p (mkIntExpr dflags bytes)
+            (mkIntExpr dflags (wORD_SIZE dflags)),
+            getCode $ emitMemcpyCall  dst_p src_p (mkIntExpr dflags bytes)
+            (mkIntExpr dflags (wORD_SIZE dflags))
             ]
         emit =<< mkCmmIfThenElse (cmmEqWord dflags src dst) moveCall cpyCall
 
-emitCopyArray :: (CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr
-                  -> FCode ())
-              -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr
+emitCopyArray :: (CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> ByteOff
+                  -> FCode ())  -- ^ copy function
+              -> CmmExpr        -- ^ source array
+              -> CmmExpr        -- ^ offset in source array
+              -> CmmExpr        -- ^ destination array
+              -> CmmExpr        -- ^ offset in destination array
+              -> WordOff        -- ^ number of elements to copy
               -> FCode ()
-emitCopyArray copy src0 src_off0 dst0 dst_off0 n0 = do
+emitCopyArray copy src0 src_off dst0 dst_off0 n = do
     dflags <- getDynFlags
-    n       <- assignTempE n0
-    nonzero <- getCode $ do
+    when (n /= 0) $ do
         -- Passed as arguments (be careful)
         src     <- assignTempE src0
-        src_off <- assignTempE src_off0
         dst     <- assignTempE dst0
         dst_off <- assignTempE dst_off0
 
         -- Set the dirty bit in the header.
         emit (setInfo dst (CmmLit (CmmLabel mkMAP_DIRTY_infoLabel)))
 
-        dst_elems_p <- assignTempE $ cmmOffsetB dflags dst (arrPtrsHdrSize dflags)
+        dst_elems_p <- assignTempE $ cmmOffsetB dflags dst
+                       (arrPtrsHdrSize dflags)
         dst_p <- assignTempE $ cmmOffsetExprW dflags dst_elems_p dst_off
-        src_p <- assignTempE $ cmmOffsetExprW dflags (cmmOffsetB dflags src (arrPtrsHdrSize dflags)) src_off
-        bytes <- assignTempE $ cmmMulWord dflags n (mkIntExpr dflags (wORD_SIZE dflags))
+        src_p <- assignTempE $ cmmOffsetExprW dflags
+                 (cmmOffsetB dflags src (arrPtrsHdrSize dflags)) src_off
+        let bytes = wordsToBytes dflags n
 
         copy src dst dst_p src_p bytes
 
         -- The base address of the destination card table
-        dst_cards_p <- assignTempE $ cmmOffsetExprW dflags dst_elems_p (loadArrPtrsSize dflags dst)
+        dst_cards_p <- assignTempE $ cmmOffsetExprW dflags dst_elems_p
+                       (loadArrPtrsSize dflags dst)
 
         emitSetCards dst_off dst_cards_p n
 
-    emit =<< mkCmmIfThen (cmmNeWord dflags n (mkIntExpr dflags 0)) nonzero
+doCopySmallArrayOp :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> WordOff
+                   -> FCode ()
+doCopySmallArrayOp = emitCopySmallArray copy
+  where
+    -- Copy data (we assume the arrays aren't overlapping since
+    -- they're of different types)
+    copy _src _dst dst_p src_p bytes =
+        do dflags <- getDynFlags
+           emitMemcpyCall dst_p src_p (mkIntExpr dflags bytes)
+               (mkIntExpr dflags (wORD_SIZE dflags))
+
+
+doCopySmallMutableArrayOp :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> WordOff
+                          -> FCode ()
+doCopySmallMutableArrayOp = emitCopySmallArray copy
+  where
+    -- The only time the memory might overlap is when the two arrays
+    -- we were provided are the same array!
+    -- TODO: Optimize branch for common case of no aliasing.
+    copy src dst dst_p src_p bytes = do
+        dflags <- getDynFlags
+        [moveCall, cpyCall] <- forkAlts
+            [ getCode $ emitMemmoveCall dst_p src_p (mkIntExpr dflags bytes)
+              (mkIntExpr dflags (wORD_SIZE dflags))
+            , getCode $ emitMemcpyCall  dst_p src_p (mkIntExpr dflags bytes)
+              (mkIntExpr dflags (wORD_SIZE dflags))
+            ]
+        emit =<< mkCmmIfThenElse (cmmEqWord dflags src dst) moveCall cpyCall
+
+emitCopySmallArray :: (CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> ByteOff
+                       -> FCode ())  -- ^ copy function
+                   -> CmmExpr        -- ^ source array
+                   -> CmmExpr        -- ^ offset in source array
+                   -> CmmExpr        -- ^ destination array
+                   -> CmmExpr        -- ^ offset in destination array
+                   -> WordOff        -- ^ number of elements to copy
+                   -> FCode ()
+emitCopySmallArray copy src0 src_off dst0 dst_off n = do
+    dflags <- getDynFlags
+
+    -- Passed as arguments (be careful)
+    src     <- assignTempE src0
+    dst     <- assignTempE dst0
+
+    -- Set the dirty bit in the header.
+    emit (setInfo dst (CmmLit (CmmLabel mkSMAP_DIRTY_infoLabel)))
+
+    dst_p <- assignTempE $ cmmOffsetExprW dflags
+             (cmmOffsetB dflags dst (smallArrPtrsHdrSize dflags)) dst_off
+    src_p <- assignTempE $ cmmOffsetExprW dflags
+             (cmmOffsetB dflags src (smallArrPtrsHdrSize dflags)) src_off
+    let bytes = wordsToBytes dflags n
+
+    copy src dst dst_p src_p bytes
 
 -- | Takes an info table label, a register to return the newly
 -- allocated array in, a source array, an offset in the source array,
--- and the number of elements to copy.  Allocates a new array and
--- initializes it form the source array.
-emitCloneArray :: CLabel -> CmmFormal -> CmmExpr -> CmmExpr -> CmmExpr
+-- and the number of elements to copy. Allocates a new array and
+-- initializes it from the source array.
+emitCloneArray :: CLabel -> CmmFormal -> CmmExpr -> CmmExpr -> WordOff
                -> FCode ()
-emitCloneArray info_p res_r src0 src_off0 n0 = do
+emitCloneArray info_p res_r src src_off n = do
     dflags <- getDynFlags
-    let arrPtrsHdrSizeW dflags = mkIntExpr dflags (fixedHdrSize dflags +
-                                     (sIZEOF_StgMutArrPtrs_NoHdr dflags `div` wORD_SIZE dflags))
-        myCapability = cmmSubWord dflags (CmmReg baseReg) (mkIntExpr dflags (oFFSET_Capability_r dflags))
-    -- Passed as arguments (be careful)
-    src     <- assignTempE src0
-    src_off <- assignTempE src_off0
-    n       <- assignTempE n0
 
-    card_bytes <- assignTempE $ cardRoundUp dflags n
-    size <- assignTempE $ cmmAddWord dflags n (bytesToWordsRoundUp dflags card_bytes)
-    words <- assignTempE $ cmmAddWord dflags (arrPtrsHdrSizeW dflags) size
+    let info_ptr = mkLblExpr info_p
+        rep = arrPtrsRep dflags n
 
-    arr_r <- newTemp (bWord dflags)
-    emitAllocateCall arr_r myCapability words
-    tickyAllocPrim (mkIntExpr dflags (arrPtrsHdrSize dflags)) (cmmMulWord dflags n (wordSize dflags))
-                   (zeroExpr dflags)
+    tickyAllocPrim (mkIntExpr dflags (arrPtrsHdrSize dflags))
+        (mkIntExpr dflags (nonHdrSize dflags rep))
+        (zeroExpr dflags)
 
-    let arr = CmmReg (CmmLocal arr_r)
-    emitSetDynHdr arr (CmmLit (CmmLabel info_p)) curCCS
-    emit $ mkStore (cmmOffsetB dflags arr (fixedHdrSize dflags * wORD_SIZE dflags +
-                                           oFFSET_StgMutArrPtrs_ptrs dflags)) n
-    emit $ mkStore (cmmOffsetB dflags arr (fixedHdrSize dflags * wORD_SIZE dflags +
-                                           oFFSET_StgMutArrPtrs_size dflags)) size
+    let hdr_size = fixedHdrSize dflags
 
-    dst_p <- assignTempE $ cmmOffsetB dflags arr (arrPtrsHdrSize dflags)
-    src_p <- assignTempE $ cmmOffsetExprW dflags (cmmOffsetB dflags src (arrPtrsHdrSize dflags))
-             src_off
+    base <- allocHeapClosure rep info_ptr curCCS
+                     [ (mkIntExpr dflags n,
+                        hdr_size + oFFSET_StgMutArrPtrs_ptrs dflags)
+                     , (mkIntExpr dflags (nonHdrSizeW rep),
+                        hdr_size + oFFSET_StgMutArrPtrs_size dflags)
+                     ]
 
-    emitMemcpyCall dst_p src_p (cmmMulWord dflags n (wordSize dflags)) (mkIntExpr dflags (wORD_SIZE dflags))
+    arr <- CmmLocal `fmap` newTemp (bWord dflags)
+    emit $ mkAssign arr base
 
-    emitMemsetCall (cmmOffsetExprW dflags dst_p n)
-        (mkIntExpr dflags 1)
-        card_bytes
+    dst_p <- assignTempE $ cmmOffsetB dflags (CmmReg arr)
+             (arrPtrsHdrSize dflags)
+    src_p <- assignTempE $ cmmOffsetExprW dflags src
+             (cmmAddWord dflags
+              (mkIntExpr dflags (arrPtrsHdrSizeW dflags)) src_off)
+
+    emitMemcpyCall dst_p src_p (mkIntExpr dflags (wordsToBytes dflags n))
+        (mkIntExpr dflags (wORD_SIZE dflags))
+
+    emit $ mkAssign (CmmLocal res_r) (CmmReg arr)
+
+-- | Takes an info table label, a register to return the newly
+-- allocated array in, a source array, an offset in the source array,
+-- and the number of elements to copy. Allocates a new array and
+-- initializes it from the source array.
+emitCloneSmallArray :: CLabel -> CmmFormal -> CmmExpr -> CmmExpr -> WordOff
+                    -> FCode ()
+emitCloneSmallArray info_p res_r src src_off n = do
+    dflags <- getDynFlags
+
+    let info_ptr = mkLblExpr info_p
+        rep = smallArrPtrsRep n
+
+    tickyAllocPrim (mkIntExpr dflags (smallArrPtrsHdrSize dflags))
+        (mkIntExpr dflags (nonHdrSize dflags rep))
+        (zeroExpr dflags)
+
+    let hdr_size = fixedHdrSize dflags
+
+    base <- allocHeapClosure rep info_ptr curCCS
+                     [ (mkIntExpr dflags n,
+                        hdr_size + oFFSET_StgSmallMutArrPtrs_ptrs dflags)
+                     ]
+
+    arr <- CmmLocal `fmap` newTemp (bWord dflags)
+    emit $ mkAssign arr base
+
+    dst_p <- assignTempE $ cmmOffsetB dflags (CmmReg arr)
+             (smallArrPtrsHdrSize dflags)
+    src_p <- assignTempE $ cmmOffsetExprW dflags src
+             (cmmAddWord dflags
+              (mkIntExpr dflags (smallArrPtrsHdrSizeW dflags)) src_off)
+
+    emitMemcpyCall dst_p src_p (mkIntExpr dflags (wordsToBytes dflags n))
         (mkIntExpr dflags (wORD_SIZE dflags))
-    emit $ mkAssign (CmmLocal res_r) arr
+
+    emit $ mkAssign (CmmLocal res_r) (CmmReg arr)
 
 -- | Takes and offset in the destination array, the base address of
 -- the card table, and the number of elements affected (*not* the
 -- number of cards). The number of elements may not be zero.
 -- Marks the relevant cards as dirty.
-emitSetCards :: CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
+emitSetCards :: CmmExpr -> CmmExpr -> WordOff -> FCode ()
 emitSetCards dst_start dst_cards_start n = do
     dflags <- getDynFlags
-    start_card <- assignTempE $ card dflags dst_start
-    let end_card = card dflags (cmmSubWord dflags (cmmAddWord dflags dst_start n) (mkIntExpr dflags 1))
+    start_card <- assignTempE $ cardCmm dflags dst_start
+    let end_card = cardCmm dflags
+                   (cmmSubWord dflags
+                    (cmmAddWord dflags dst_start (mkIntExpr dflags n))
+                    (mkIntExpr dflags 1))
     emitMemsetCall (cmmAddWord dflags dst_cards_start start_card)
         (mkIntExpr dflags 1)
         (cmmAddWord dflags (cmmSubWord dflags end_card start_card) (mkIntExpr dflags 1))
         (mkIntExpr dflags 1) -- no alignment (1 byte)
 
 -- Convert an element index to a card index
-card :: DynFlags -> CmmExpr -> CmmExpr
-card dflags i = cmmUShrWord dflags i (mkIntExpr dflags (mUT_ARR_PTRS_CARD_BITS dflags))
+cardCmm :: DynFlags -> CmmExpr -> CmmExpr
+cardCmm dflags i =
+    cmmUShrWord dflags i (mkIntExpr dflags (mUT_ARR_PTRS_CARD_BITS dflags))
 
--- Convert a number of elements to a number of cards, rounding up
-cardRoundUp :: DynFlags -> CmmExpr -> CmmExpr
-cardRoundUp dflags i = card dflags (cmmAddWord dflags i (mkIntExpr dflags ((1 `shiftL` mUT_ARR_PTRS_CARD_BITS dflags) - 1)))
+------------------------------------------------------------------------------
+-- SmallArray PrimOp implementations
+
+doReadSmallPtrArrayOp :: LocalReg
+                      -> CmmExpr
+                      -> CmmExpr
+                      -> FCode ()
+doReadSmallPtrArrayOp res addr idx = do
+    dflags <- getDynFlags
+    mkBasicIndexedRead (smallArrPtrsHdrSize dflags) Nothing (gcWord dflags) res addr
+        (gcWord dflags) idx
+
+doWriteSmallPtrArrayOp :: CmmExpr
+                       -> CmmExpr
+                       -> CmmExpr
+                       -> FCode ()
+doWriteSmallPtrArrayOp addr idx val = do
+    dflags <- getDynFlags
+    let ty = cmmExprType dflags val
+    mkBasicIndexedWrite (smallArrPtrsHdrSize dflags) Nothing addr ty idx val
+    emit (setInfo addr (CmmLit (CmmLabel mkSMAP_DIRTY_infoLabel)))
 
-bytesToWordsRoundUp :: DynFlags -> CmmExpr -> CmmExpr
-bytesToWordsRoundUp dflags e = cmmQuotWord dflags (cmmAddWord dflags e (mkIntExpr dflags (wORD_SIZE dflags - 1)))
-                                                  (wordSize dflags)
+------------------------------------------------------------------------------
+-- Atomic read-modify-write
+
+-- | Emit an atomic modification to a byte array element. The result
+-- reg contains that previous value of the element. Implies a full
+-- memory barrier.
+doAtomicRMW :: LocalReg      -- ^ Result reg
+            -> AtomicMachOp  -- ^ Atomic op (e.g. add)
+            -> CmmExpr       -- ^ MutableByteArray#
+            -> CmmExpr       -- ^ Index
+            -> CmmType       -- ^ Type of element by which we are indexing
+            -> CmmExpr       -- ^ Op argument (e.g. amount to add)
+            -> FCode ()
+doAtomicRMW res amop mba idx idx_ty n = do
+    dflags <- getDynFlags
+    let width = typeWidth idx_ty
+        addr  = cmmIndexOffExpr dflags (arrWordsHdrSize dflags)
+                width mba idx
+    emitPrimCall
+        [ res ]
+        (MO_AtomicRMW width amop)
+        [ addr, n ]
+
+-- | Emit an atomic read to a byte array that acts as a memory barrier.
+doAtomicReadByteArray
+    :: LocalReg  -- ^ Result reg
+    -> CmmExpr   -- ^ MutableByteArray#
+    -> CmmExpr   -- ^ Index
+    -> CmmType   -- ^ Type of element by which we are indexing
+    -> FCode ()
+doAtomicReadByteArray res mba idx idx_ty = do
+    dflags <- getDynFlags
+    let width = typeWidth idx_ty
+        addr  = cmmIndexOffExpr dflags (arrWordsHdrSize dflags)
+                width mba idx
+    emitPrimCall
+        [ res ]
+        (MO_AtomicRead width)
+        [ addr ]
+
+-- | Emit an atomic write to a byte array that acts as a memory barrier.
+doAtomicWriteByteArray
+    :: CmmExpr   -- ^ MutableByteArray#
+    -> CmmExpr   -- ^ Index
+    -> CmmType   -- ^ Type of element by which we are indexing
+    -> CmmExpr   -- ^ Value to write
+    -> FCode ()
+doAtomicWriteByteArray mba idx idx_ty val = do
+    dflags <- getDynFlags
+    let width = typeWidth idx_ty
+        addr  = cmmIndexOffExpr dflags (arrWordsHdrSize dflags)
+                width mba idx
+    emitPrimCall
+        [ {- no results -} ]
+        (MO_AtomicWrite width)
+        [ addr, val ]
+
+doCasByteArray
+    :: LocalReg  -- ^ Result reg
+    -> CmmExpr   -- ^ MutableByteArray#
+    -> CmmExpr   -- ^ Index
+    -> CmmType   -- ^ Type of element by which we are indexing
+    -> CmmExpr   -- ^ Old value
+    -> CmmExpr   -- ^ New value
+    -> FCode ()
+doCasByteArray res mba idx idx_ty old new = do
+    dflags <- getDynFlags
+    let width = (typeWidth idx_ty)
+        addr = cmmIndexOffExpr dflags (arrWordsHdrSize dflags)
+               width mba idx
+    emitPrimCall
+        [ res ]
+        (MO_Cmpxchg width)
+        [ addr, old, new ]
 
-wordSize :: DynFlags -> CmmExpr
-wordSize dflags = mkIntExpr dflags (wORD_SIZE dflags)
+------------------------------------------------------------------------------
+-- Helpers for emitting function calls
 
 -- | Emit a call to @memcpy@.
 emitMemcpyCall :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
@@ -1675,19 +2097,6 @@ emitMemsetCall dst c n align = do
         MO_Memset
         [ dst, c, n, align ]
 
--- | Emit a call to @allocate@.
-emitAllocateCall :: LocalReg -> CmmExpr -> CmmExpr -> FCode ()
-emitAllocateCall res cap n = do
-    emitCCall
-        [ (res, AddrHint) ]
-        allocate
-        [ (cap, AddrHint)
-        , (n, NoHint)
-        ]
-  where
-    allocate = CmmLit (CmmLabel (mkForeignLabel (fsLit "allocate") Nothing
-                                 ForeignLabelInExternalPackage IsFunction))
-
 emitBSwapCall :: LocalReg -> CmmExpr -> Width -> FCode ()
 emitBSwapCall res x width = do
     emitPrimCall
@@ -1701,3 +2110,17 @@ emitPopCntCall res x width = do
         [ res ]
         (MO_PopCnt width)
         [ x ]
+
+emitClzCall :: LocalReg -> CmmExpr -> Width -> FCode ()
+emitClzCall res x width = do
+    emitPrimCall
+        [ res ]
+        (MO_Clz width)
+        [ x ]
+
+emitCtzCall :: LocalReg -> CmmExpr -> Width -> FCode ()
+emitCtzCall res x width = do
+    emitPrimCall
+        [ res ]
+        (MO_Ctz width)
+        [ x ]
diff --git a/compiler/codeGen/StgCmmProf.hs b/compiler/codeGen/StgCmmProf.hs
index e8a2a10fddf8..7249477c9f69 100644
--- a/compiler/codeGen/StgCmmProf.hs
+++ b/compiler/codeGen/StgCmmProf.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE CPP #-}
+
 -----------------------------------------------------------------------------
 --
 -- Code generation for profiling
@@ -149,7 +151,7 @@ profDynAlloc :: SMRep -> CmmExpr -> FCode ()
 profDynAlloc rep ccs
   = ifProfiling $
     do dflags <- getDynFlags
-       profAlloc (mkIntExpr dflags (heapClosureSize dflags rep)) ccs
+       profAlloc (mkIntExpr dflags (heapClosureSizeW dflags rep)) ccs
 
 -- | Record the allocation of a closure (size is given by a CmmExpr)
 -- The size must be in words, because the allocation counter in a CCS counts
@@ -181,7 +183,7 @@ enterCostCentreFun ccs closure =
   ifProfiling $ do
     if isCurrentCCS ccs
        then do dflags <- getDynFlags
-               emitRtsCall rtsPackageId (fsLit "enterFunCCS")
+               emitRtsCall rtsPackageKey (fsLit "enterFunCCS")
                    [(CmmReg (CmmGlobal BaseReg), AddrHint),
                     (costCentreFrom dflags closure, AddrHint)] False
        else return () -- top-level function, nothing to do
@@ -283,7 +285,7 @@ emitSetCCC cc tick push
 pushCostCentre :: LocalReg -> CmmExpr -> CostCentre -> FCode ()
 pushCostCentre result ccs cc
   = emitRtsCallWithResult result AddrHint
-        rtsPackageId
+        rtsPackageKey
         (fsLit "pushCostCentre") [(ccs,AddrHint),
                                 (CmmLit (mkCCostCentre cc), AddrHint)]
         False
@@ -354,7 +356,7 @@ ldvEnter cl_ptr = do
 
 loadEra :: DynFlags -> CmmExpr
 loadEra dflags = CmmMachOp (MO_UU_Conv (cIntWidth dflags) (wordWidth dflags))
-    [CmmLoad (mkLblExpr (mkCmmDataLabel rtsPackageId (fsLit "era")))
+    [CmmLoad (mkLblExpr (mkCmmDataLabel rtsPackageKey (fsLit "era")))
              (cInt dflags)]
 
 ldvWord :: DynFlags -> CmmExpr -> CmmExpr
diff --git a/compiler/codeGen/StgCmmTicky.hs b/compiler/codeGen/StgCmmTicky.hs
index 3f3c3c5a19be..3652a799798b 100644
--- a/compiler/codeGen/StgCmmTicky.hs
+++ b/compiler/codeGen/StgCmmTicky.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE BangPatterns, CPP #-}
+
 -----------------------------------------------------------------------------
 --
 -- Code generation for ticky-ticky profiling
@@ -325,7 +327,7 @@ registerTickyCtr ctr_lbl = do
         , mkStore (CmmLit (cmmLabelOffB ctr_lbl
                                 (oFFSET_StgEntCounter_registeredp dflags)))
                    (mkIntExpr dflags 1) ]
-    ticky_entry_ctrs = mkLblExpr (mkCmmDataLabel rtsPackageId (fsLit "ticky_entry_ctrs"))
+    ticky_entry_ctrs = mkLblExpr (mkCmmDataLabel rtsPackageKey (fsLit "ticky_entry_ctrs"))
   emit =<< mkCmmIfThen test (catAGraphs register_stmts)
 
 tickyReturnOldCon, tickyReturnNewCon :: RepArity -> FCode ()
@@ -415,7 +417,7 @@ tickyDynAlloc :: Maybe Id -> SMRep -> LambdaFormInfo -> FCode ()
 --
 -- TODO what else to count while we're here?
 tickyDynAlloc mb_id rep lf = ifTicky $ getDynFlags >>= \dflags ->
-  let bytes = wORD_SIZE dflags * heapClosureSize dflags rep
+  let bytes = wORD_SIZE dflags * heapClosureSizeW dflags rep
 
       countGlobal tot ctr = do
         bumpTickyCounterBy tot bytes
@@ -470,12 +472,12 @@ tickyAllocHeap genuine hp
                      bytes,
             -- Bump the global allocation total ALLOC_HEAP_tot
             addToMemLbl (cLong dflags)
-                        (mkCmmDataLabel rtsPackageId (fsLit "ALLOC_HEAP_tot"))
+                        (mkCmmDataLabel rtsPackageKey (fsLit "ALLOC_HEAP_tot"))
                         bytes,
             -- Bump the global allocation counter ALLOC_HEAP_ctr
             if not genuine then mkNop
             else addToMemLbl (cLong dflags)
-                             (mkCmmDataLabel rtsPackageId (fsLit "ALLOC_HEAP_ctr"))
+                             (mkCmmDataLabel rtsPackageKey (fsLit "ALLOC_HEAP_ctr"))
                              1
             ]}
 
@@ -485,7 +487,9 @@ tickyAllocHeap genuine hp
 
 -- the units are bytes
 
-tickyAllocPrim :: CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
+tickyAllocPrim :: CmmExpr  -- ^ size of the full header, in bytes
+               -> CmmExpr  -- ^ size of the payload, in bytes
+               -> CmmExpr -> FCode ()
 tickyAllocPrim _hdr _goods _slop = ifTicky $ do
   bumpTickyCounter    (fsLit "ALLOC_PRIM_ctr")
   bumpTickyCounterByE (fsLit "ALLOC_PRIM_adm") _hdr
@@ -537,13 +541,13 @@ ifTickyDynThunk :: FCode () -> FCode ()
 ifTickyDynThunk code = tickyDynThunkIsOn >>= \b -> when b code
 
 bumpTickyCounter :: FastString -> FCode ()
-bumpTickyCounter lbl = bumpTickyLbl (mkCmmDataLabel rtsPackageId lbl)
+bumpTickyCounter lbl = bumpTickyLbl (mkCmmDataLabel rtsPackageKey lbl)
 
 bumpTickyCounterBy :: FastString -> Int -> FCode ()
-bumpTickyCounterBy lbl = bumpTickyLblBy (mkCmmDataLabel rtsPackageId lbl)
+bumpTickyCounterBy lbl = bumpTickyLblBy (mkCmmDataLabel rtsPackageKey lbl)
 
 bumpTickyCounterByE :: FastString -> CmmExpr -> FCode ()
-bumpTickyCounterByE lbl = bumpTickyLblByE (mkCmmDataLabel rtsPackageId lbl)
+bumpTickyCounterByE lbl = bumpTickyLblByE (mkCmmDataLabel rtsPackageKey lbl)
 
 bumpTickyEntryCount :: CLabel -> FCode ()
 bumpTickyEntryCount lbl = do
diff --git a/compiler/codeGen/StgCmmUtils.hs b/compiler/codeGen/StgCmmUtils.hs
index 45b0f0c785f8..3dacf00192d9 100644
--- a/compiler/codeGen/StgCmmUtils.hs
+++ b/compiler/codeGen/StgCmmUtils.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE CPP #-}
+
 -----------------------------------------------------------------------------
 --
 -- Code generator utilities; mostly monadic
@@ -71,6 +73,7 @@ import Data.List
 import Data.Ord
 import Data.Word
 import Data.Maybe
+import Control.Arrow ( first )
 
 
 -------------------------------------------------------------------------
@@ -142,7 +145,8 @@ addToMemE rep ptr n
 --
 -------------------------------------------------------------------------
 
-mkTaggedObjectLoad :: DynFlags -> LocalReg -> LocalReg -> WordOff -> DynTag -> CmmAGraph
+mkTaggedObjectLoad
+  :: DynFlags -> LocalReg -> LocalReg -> ByteOff -> DynTag -> CmmAGraph
 -- (loadTaggedObjectField reg base off tag) generates assignment
 --      reg = bitsK[ base + off - tag ]
 -- where K is fixed by 'reg'
@@ -150,7 +154,7 @@ mkTaggedObjectLoad dflags reg base offset tag
   = mkAssign (CmmLocal reg)
              (CmmLoad (cmmOffsetB dflags
                                   (CmmReg (CmmLocal base))
-                                  (wORD_SIZE dflags * offset - tag))
+                                  (offset - tag))
                       (localRegType reg))
 
 -------------------------------------------------------------------------
@@ -172,10 +176,10 @@ tagToClosure dflags tycon tag
 --
 -------------------------------------------------------------------------
 
-emitRtsCall :: PackageId -> FastString -> [(CmmExpr,ForeignHint)] -> Bool -> FCode ()
+emitRtsCall :: PackageKey -> FastString -> [(CmmExpr,ForeignHint)] -> Bool -> FCode ()
 emitRtsCall pkg fun args safe = emitRtsCallGen [] (mkCmmCodeLabel pkg fun) args safe
 
-emitRtsCallWithResult :: LocalReg -> ForeignHint -> PackageId -> FastString
+emitRtsCallWithResult :: LocalReg -> ForeignHint -> PackageKey -> FastString
         -> [(CmmExpr,ForeignHint)] -> Bool -> FCode ()
 emitRtsCallWithResult res hint pkg fun args safe
    = emitRtsCallGen [(res,hint)] (mkCmmCodeLabel pkg fun) args safe
@@ -450,11 +454,11 @@ mustFollow :: Stmt -> Stmt -> Bool
 -------------------------------------------------------------------------
 
 
-emitSwitch :: CmmExpr                -- Tag to switch on
-           -> [(ConTagZ, CmmAGraph)] -- Tagged branches
-           -> Maybe CmmAGraph        -- Default branch (if any)
-           -> ConTagZ -> ConTagZ     -- Min and Max possible values; behaviour
-                                     -- outside this range is undefined
+emitSwitch :: CmmExpr                      -- Tag to switch on
+           -> [(ConTagZ, CmmAGraphScoped)] -- Tagged branches
+           -> Maybe CmmAGraphScoped        -- Default branch (if any)
+           -> ConTagZ -> ConTagZ           -- Min and Max possible values; behaviour
+                                           -- outside this range is undefined
            -> FCode ()
 emitSwitch tag_expr branches mb_deflt lo_tag hi_tag
   = do  { dflags <- getDynFlags
@@ -464,18 +468,18 @@ emitSwitch tag_expr branches mb_deflt lo_tag hi_tag
                  | otherwise                = False
 
 
-mkCmmSwitch :: Bool                   -- True <=> never generate a
-                                      -- conditional tree
-            -> CmmExpr                -- Tag to switch on
-            -> [(ConTagZ, CmmAGraph)] -- Tagged branches
-            -> Maybe CmmAGraph        -- Default branch (if any)
-            -> ConTagZ -> ConTagZ     -- Min and Max possible values; behaviour
-                                      -- outside this range is undefined
+mkCmmSwitch :: Bool                         -- True <=> never generate a
+                                            -- conditional tree
+            -> CmmExpr                      -- Tag to switch on
+            -> [(ConTagZ, CmmAGraphScoped)] -- Tagged branches
+            -> Maybe CmmAGraphScoped        -- Default branch (if any)
+            -> ConTagZ -> ConTagZ           -- Min and Max possible values; behaviour
+                                            -- outside this range is undefined
             -> FCode ()
 
 -- First, two rather common cases in which there is no work to do
-mkCmmSwitch _ _ []         (Just code) _ _ = emit code
-mkCmmSwitch _ _ [(_,code)] Nothing     _ _ = emit code
+mkCmmSwitch _ _ []         (Just code) _ _ = emit (fst code)
+mkCmmSwitch _ _ [(_,code)] Nothing     _ _ = emit (fst code)
 
 -- Right, off we go
 mkCmmSwitch via_C tag_expr branches mb_deflt lo_tag hi_tag = do
@@ -631,17 +635,17 @@ mk_switch tag_expr branches mb_deflt lo_tag hi_tag via_C
     is_lo (t,_) = t < mid_tag
 
 --------------
-emitCmmLitSwitch :: CmmExpr               -- Tag to switch on
-               -> [(Literal, CmmAGraph)]  -- Tagged branches
-               -> CmmAGraph               -- Default branch (always)
-               -> FCode ()                -- Emit the code
+emitCmmLitSwitch :: CmmExpr                    -- Tag to switch on
+               -> [(Literal, CmmAGraphScoped)] -- Tagged branches
+               -> CmmAGraphScoped              -- Default branch (always)
+               -> FCode ()                     -- Emit the code
 -- Used for general literals, whose size might not be a word,
 -- where there is always a default case, and where we don't know
 -- the range of values for certain.  For simplicity we always generate a tree.
 --
 -- ToDo: for integers we could do better here, perhaps by generalising
 -- mk_switch and using that.  --SDM 15/09/2004
-emitCmmLitSwitch _scrut []       deflt = emit deflt
+emitCmmLitSwitch _scrut []       deflt = emit $ fst deflt
 emitCmmLitSwitch scrut  branches deflt = do
     scrut' <- assignTemp' scrut
     join_lbl <- newLabelC
@@ -682,7 +686,7 @@ mk_lit_switch scrut deflt_blk_id branches
 
 
 --------------
-label_default :: BlockId -> Maybe CmmAGraph -> FCode (Maybe BlockId)
+label_default :: BlockId -> Maybe CmmAGraphScoped -> FCode (Maybe BlockId)
 label_default _ Nothing
   = return  Nothing
 label_default join_lbl (Just code)
@@ -690,7 +694,7 @@ label_default join_lbl (Just code)
        return (Just lbl)
 
 --------------
-label_branches :: BlockId -> [(a,CmmAGraph)] -> FCode [(a,BlockId)]
+label_branches :: BlockId -> [(a,CmmAGraphScoped)] -> FCode [(a,BlockId)]
 label_branches _join_lbl []
   = return []
 label_branches join_lbl ((tag,code):branches)
@@ -699,14 +703,14 @@ label_branches join_lbl ((tag,code):branches)
        return ((tag,lbl):branches')
 
 --------------
-label_code :: BlockId -> CmmAGraph -> FCode BlockId
+label_code :: BlockId -> CmmAGraphScoped -> FCode BlockId
 --  label_code J code
 --      generates
 --  [L: code; goto J]
 -- and returns L
 label_code join_lbl code = do
     lbl <- newLabelC
-    emitOutOfLine lbl (code <*> mkBranch join_lbl)
+    emitOutOfLine lbl (first (<*> mkBranch join_lbl) code)
     return lbl
 
 --------------
diff --git a/compiler/coreSyn/CoreArity.lhs b/compiler/coreSyn/CoreArity.lhs
index 7042718af5d3..26669b6d32b7 100644
--- a/compiler/coreSyn/CoreArity.lhs
+++ b/compiler/coreSyn/CoreArity.lhs
@@ -6,7 +6,8 @@
 	Arity and eta expansion
 
 \begin{code}
-{-# OPTIONS -fno-warn-tabs #-}
+{-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
 -- The above warning supression flag is a temporary kludge.
 -- While working on this module you are encouraged to remove it and
 -- detab the module (please do the detabbing in a separate patch). See
@@ -15,7 +16,7 @@
 
 -- | Arit and eta expansion
 module CoreArity (
-	manifestArity, exprArity, exprBotStrictness_maybe,
+	manifestArity, exprArity, typeArity, exprBotStrictness_maybe,
 	exprEtaExpandArity, findRhsArity, CheapFun, etaExpand
     ) where
 
@@ -73,7 +74,8 @@ should have arity 3, regardless of f's arity.
 
 \begin{code}
 manifestArity :: CoreExpr -> Arity
--- ^ manifestArity sees how many leading value lambdas there are
+-- ^ manifestArity sees how many leading value lambdas there are,
+--   after looking through casts
 manifestArity (Lam v e) | isId v    	= 1 + manifestArity e
 			| otherwise 	= manifestArity e
 manifestArity (Tick t e) | not (tickishIsCode t) =  manifestArity e
@@ -143,7 +145,7 @@ exprBotStrictness_maybe e
 	Nothing -> Nothing
 	Just ar -> Just (ar, sig ar)
   where
-    env    = AE { ae_bndrs = [], ae_ped_bot = True, ae_cheap_fn = \ _ _ -> False }
+    env    = AE { ae_ped_bot = True, ae_cheap_fn = \ _ _ -> False }
     sig ar = mkClosedStrictSig (replicate ar topDmd) botRes
                   -- For this purpose we can be very simple
 \end{code}
@@ -323,14 +325,10 @@ this transformation.  So we try to limit it as much as possible:
      going to diverge eventually anyway then getting the best arity 
      isn't an issue, so we might as well play safe
 
- (3) Do NOT move a lambda outside a case unless 
+ (3) Do NOT move a lambda outside a case unless
      (a) The scrutinee is ok-for-speculation, or
-     (b) There is an enclosing value \x, and the scrutinee is x
-         E.g.  let x = case y of ( DEFAULT -> \v -> blah }
-     We don't move the \y out.  This is pretty arbitrary; but it
-     catches the common case of doing `seq` on y.
-     This is the reason for the under_lam argument to arityType.
-     See Trac #5625
+     (b) more liberally: the scrutinee is cheap (e.g. a variable), and
+         -fpedantic-bottoms is not enforced (see Trac #2915 for an example)
 
 Of course both (1) and (2) are readily defeated by disguising the bottoms.
 
@@ -492,8 +490,7 @@ exprEtaExpandArity dflags e
       ATop oss -> length oss
       ABot n   -> n
   where
-    env = AE { ae_bndrs    = []
-             , ae_cheap_fn = mk_cheap_fn dflags isCheapApp
+    env = AE { ae_cheap_fn = mk_cheap_fn dflags isCheapApp
              , ae_ped_bot  = gopt Opt_PedanticBottoms dflags }
 
 getBotArity :: ArityType -> Maybe Arity
@@ -562,8 +559,7 @@ rhsEtaExpandArity dflags cheap_app e
       ATop []             -> 0
       ABot n              -> n
   where
-    env = AE { ae_bndrs    = []
-             , ae_cheap_fn = mk_cheap_fn dflags cheap_app
+    env = AE { ae_cheap_fn = mk_cheap_fn dflags cheap_app
              , ae_ped_bot  = gopt Opt_PedanticBottoms dflags }
 
     has_lam (Tick _ e) = has_lam e
@@ -698,9 +694,7 @@ type CheapFun = CoreExpr -> Maybe Type -> Bool
 	-- of the expression; Nothing means "don't know"
 
 data ArityEnv 
-  = AE { ae_bndrs :: [Id]          -- Enclosing value-lambda Ids
-                                   -- See Note [Dealing with bottom (3)]
-       , ae_cheap_fn :: CheapFun
+  = AE { ae_cheap_fn :: CheapFun
        , ae_ped_bot  :: Bool       -- True <=> be pedantic about bottoms
   }
 
@@ -734,19 +728,14 @@ arityType _ (Var v)
 
 	-- Lambdas; increase arity
 arityType env (Lam x e)
-  | isId x    = arityLam x (arityType env' e)
+  | isId x    = arityLam x (arityType env e)
   | otherwise = arityType env e
-  where
-    env' = env { ae_bndrs = x : ae_bndrs env }
 
 	-- Applications; decrease arity, except for types
 arityType env (App fun (Type _))
    = arityType env fun
 arityType env (App fun arg )
-   = arityApp (arityType env' fun) (ae_cheap_fn env arg Nothing) 
-   where
-     env' = env { ae_bndrs = case ae_bndrs env of
-                                { [] -> []; (_:xs) -> xs } }
+   = arityApp (arityType env fun) (ae_cheap_fn env arg Nothing)
 
 	-- Case/Let; keep arity if either the expression is cheap
 	-- or it's a 1-shot lambda
@@ -766,17 +755,11 @@ arityType env (Case scrut _ _ alts)
      	     | otherwise -> ABot 0     -- if RHS is bottomming
     			               -- See Note [Dealing with bottom (2)]
 
-     ATop as | not (ae_ped_bot env)    -- Check -fpedantic-bottoms
-             , is_under scrut             -> ATop as
-             | exprOkForSpeculation scrut -> ATop as
-             | otherwise                  -> ATop (takeWhile isOneShotInfo as)
+     ATop as | not (ae_ped_bot env)    -- See Note [Dealing with bottom (3)]
+             , ae_cheap_fn env scrut Nothing -> ATop as
+             | exprOkForSpeculation scrut    -> ATop as
+             | otherwise                     -> ATop (takeWhile isOneShotInfo as)
   where
-    -- is_under implements Note [Dealing with bottom (3)]
-    is_under (Var f)           = f `elem` ae_bndrs env
-    is_under (App f (Type {})) = is_under f
-    is_under (Cast f _)        = is_under f
-    is_under _                 = False
-
     alts_type = foldr1 andArityType [arityType env rhs | (_,_,rhs) <- alts]
 
 arityType env (Let b e) 
@@ -1025,4 +1008,3 @@ freshEtaId n subst ty
 		  mkSysLocal (fsLit "eta") (mkBuiltinUnique n) ty'
 	subst'  = extendTvInScope subst eta_id'		  
 \end{code}
-
diff --git a/compiler/coreSyn/CoreFVs.lhs b/compiler/coreSyn/CoreFVs.lhs
index 636c049c4254..51b5f34d2690 100644
--- a/compiler/coreSyn/CoreFVs.lhs
+++ b/compiler/coreSyn/CoreFVs.lhs
@@ -5,6 +5,8 @@
 Taken quite directly from the Peyton Jones/Lester paper.
 
 \begin{code}
+{-# LANGUAGE CPP #-}
+
 -- | A module concerned with finding the free variables of an expression.
 module CoreFVs (
         -- * Free variables of expressions and binding groups
@@ -254,7 +256,7 @@ exprOrphNames e
     go (Coercion co)        = orphNamesOfCo co
     go (App e1 e2)          = go e1 `unionNameSets` go e2
     go (Lam v e)            = go e `delFromNameSet` idName v
-    go (Tick _ e)         = go e
+    go (Tick _ e)           = go e
     go (Cast e co)          = go e `unionNameSets` orphNamesOfCo co
     go (Let (NonRec _ r) e) = go e `unionNameSets` go r
     go (Let (Rec prs) e)    = exprsOrphNames (map snd prs) `unionNameSets` go e
diff --git a/compiler/coreSyn/CoreLint.lhs b/compiler/coreSyn/CoreLint.lhs
index 836164e0ce9f..f4607823a8f4 100644
--- a/compiler/coreSyn/CoreLint.lhs
+++ b/compiler/coreSyn/CoreLint.lhs
@@ -7,19 +7,13 @@
 A ``lint'' pass to check for Core correctness
 
 \begin{code}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and
--- detab the module (please do the detabbing in a separate patch). See
---     http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
--- for details
-
+{-# LANGUAGE CPP #-}
 {-# OPTIONS_GHC -fprof-auto #-}
 
 module CoreLint ( lintCoreBindings, lintUnfolding, lintExpr ) where
 
 #include "HsVersions.h"
 
-import Demand
 import CoreSyn
 import CoreFVs
 import CoreUtils
@@ -213,7 +207,8 @@ lintSingleBinding top_lvl_flag rec_flag (binder,rhs)
        ; binder_ty <- applySubstTy binder_ty
        ; checkTys binder_ty ty (mkRhsMsg binder (ptext (sLit "RHS")) ty)
 
-        -- Check (not isUnLiftedType) (also checks for bogus unboxed tuples)
+        -- Check the let/app invariant
+        -- See Note [CoreSyn let/app invariant] in CoreSyn
        ; checkL (not (isUnLiftedType binder_ty)
             || (isNonRec rec_flag && exprOkForSpeculation rhs))
            (mkRhsPrimMsg binder rhs)
@@ -226,6 +221,7 @@ lintSingleBinding top_lvl_flag rec_flag (binder,rhs)
         -- Check that if the binder is local, it is not marked as exported
        ; checkL (not (isExportedId binder) || isTopLevel top_lvl_flag)
            (mkNonTopExportedMsg binder)
+
         -- Check that if the binder is local, it does not have an external name
        ; checkL (not (isExternalName (Var.varName binder)) || isTopLevel top_lvl_flag)
            (mkNonTopExternalNameMsg binder)
@@ -239,9 +235,13 @@ lintSingleBinding top_lvl_flag rec_flag (binder,rhs)
 
       -- Check whether arity and demand type are consistent (only if demand analysis
       -- already happened)
-       ; checkL (case dmdTy of
-                  StrictSig dmd_ty -> idArity binder >= dmdTypeDepth dmd_ty || exprIsTrivial rhs)
-           (mkArityMsg binder)
+      --
+      -- Note (Apr 2014): this is actually ok.  See Note [Demand analysis for trivial right-hand sides]
+      --                  in DmdAnal.  After eta-expansion in CorePrep the rhs is no longer trivial.
+      --       ; let dmdTy = idStrictness binder
+      --       ; checkL (case dmdTy of
+      --                  StrictSig dmd_ty -> idArity binder >= dmdTypeDepth dmd_ty || exprIsTrivial rhs)
+      --           (mkArityMsg binder)
 
        ; lintIdUnfolding binder binder_ty (idUnfolding binder) }
 
@@ -249,7 +249,6 @@ lintSingleBinding top_lvl_flag rec_flag (binder,rhs)
         -- the unfolding is a SimplifiableCoreExpr. Give up for now.
    where
     binder_ty                  = idType binder
-    dmdTy                      = idStrictness binder
     bndr_vars                  = varSetElems (idFreeVars binder)
 
     -- If you edit this function, you may need to update the GHC formalism
@@ -454,6 +453,8 @@ lintCoreArg fun_ty (Type arg_ty)
 
 lintCoreArg fun_ty arg
   = do { arg_ty <- lintCoreExpr arg
+       ; checkL (not (isUnLiftedType arg_ty) || exprOkForSpeculation arg)
+                (mkLetAppMsg arg)
        ; lintValApp arg fun_ty arg_ty }
 
 -----------------
@@ -854,6 +855,9 @@ lintCoercion co@(TyConAppCo r tc cos)
        ; checkRole co2 r r2
        ; return (rk, mkFunTy s1 s2, mkFunTy t1 t2, r) }
 
+  | Just {} <- synTyConDefn_maybe tc
+  = failWithL (ptext (sLit "Synonym in TyConAppCo:") <+> ppr co)
+
   | otherwise
   = do { (ks,ss,ts,rs) <- mapAndUnzip4M lintCoercion cos
        ; rk <- lint_co_app co (tyConKind tc) (ss `zip` ks)
@@ -1391,6 +1395,11 @@ mkRhsMsg binder what ty
      hsep [ptext (sLit "Binder's type:"), ppr (idType binder)],
      hsep [ptext (sLit "Rhs type:"), ppr ty]]
 
+mkLetAppMsg :: CoreExpr -> MsgDoc
+mkLetAppMsg e
+  = hang (ptext (sLit "This argument does not satisfy the let/app invariant:"))
+       2 (ppr e)
+
 mkRhsPrimMsg :: Id -> CoreExpr -> MsgDoc
 mkRhsPrimMsg binder _rhs
   = vcat [hsep [ptext (sLit "The type of this binder is primitive:"),
@@ -1421,6 +1430,7 @@ mkKindErrMsg tyvar arg_ty
           hang (ptext (sLit "Arg type:"))
                  4 (ppr arg_ty <+> dcolon <+> ppr (typeKind arg_ty))]
 
+{- Not needed now
 mkArityMsg :: Id -> MsgDoc
 mkArityMsg binder
   = vcat [hsep [ptext (sLit "Demand type has"),
@@ -1433,7 +1443,7 @@ mkArityMsg binder
 
          ]
            where (StrictSig dmd_ty) = idStrictness binder
-
+-}
 mkCastErr :: CoreExpr -> Coercion -> Type -> Type -> MsgDoc
 mkCastErr expr co from_ty expr_ty
   = vcat [ptext (sLit "From-type of Cast differs from type of enclosed expression"),
diff --git a/compiler/coreSyn/CorePrep.lhs b/compiler/coreSyn/CorePrep.lhs
index 5e0cd6599d27..4baac8cd0101 100644
--- a/compiler/coreSyn/CorePrep.lhs
+++ b/compiler/coreSyn/CorePrep.lhs
@@ -5,7 +5,7 @@
 Core pass to saturate constructors and PrimOps
 
 \begin{code}
-{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE BangPatterns, CPP #-}
 
 module CorePrep (
       corePrepPgm, corePrepExpr, cvtLitInteger,
@@ -53,6 +53,8 @@ import Outputable
 import Platform
 import FastString
 import Config
+import Name             ( NamedThing(..), nameSrcSpan )
+import SrcLoc           ( SrcSpan(..), realSrcLocSpan, mkRealSrcLoc )
 import Data.Bits
 import Data.List        ( mapAccumL )
 import Control.Monad
@@ -113,6 +115,9 @@ The goal of this pass is to prepare for code generation.
     special case where we use the S# constructor for Integers that
     are in the range of Int.
 
+11. Uphold tick consistency while doing this: Move floatable ticks
+    out of applications, and wrap floats for scoped ticks.
+
 This is all done modulo type applications and abstractions, so that
 when type erasure is done for conversion to STG, we don't end up with
 any trivial or useless bindings.
@@ -157,13 +162,14 @@ type CpeRhs  = CoreExpr    -- Non-terminal 'rhs'
 %************************************************************************
 
 \begin{code}
-corePrepPgm :: DynFlags -> HscEnv -> CoreProgram -> [TyCon] -> IO CoreProgram
-corePrepPgm dflags hsc_env binds data_tycons = do
+corePrepPgm :: HscEnv -> ModLocation -> CoreProgram -> [TyCon] -> IO CoreProgram
+corePrepPgm hsc_env mod_loc binds data_tycons = do
+    let dflags = hsc_dflags hsc_env
     showPass dflags "CorePrep"
     us <- mkSplitUniqSupply 's'
     initialCorePrepEnv <- mkInitialCorePrepEnv dflags hsc_env
 
-    let implicit_binds = mkDataConWorkers data_tycons
+    let implicit_binds = mkDataConWorkers dflags mod_loc data_tycons
             -- NB: we must feed mkImplicitBinds through corePrep too
             -- so that they are suitably cloned and eta-expanded
 
@@ -173,7 +179,13 @@ corePrepPgm dflags hsc_env binds data_tycons = do
                       return (deFloatTop (floats1 `appendFloats` floats2))
 
     endPass hsc_env CorePrep binds_out []
-    return binds_out
+
+    -- Output of Core preparation might be useful for debugging
+    let binds_out'
+          | gopt Opt_DebugCore dflags = map annotateCoreNotes binds_out
+          | otherwise                 = binds_out
+
+    return binds_out'
 
 corePrepExpr :: DynFlags -> HscEnv -> CoreExpr -> IO CoreExpr
 corePrepExpr dflags hsc_env expr = do
@@ -194,13 +206,27 @@ corePrepTopBinds initialCorePrepEnv binds
                                binds' <- go env' binds
                                return (bind' `appendFloats` binds')
 
-mkDataConWorkers :: [TyCon] -> [CoreBind]
+mkDataConWorkers :: DynFlags -> ModLocation -> [TyCon] -> [CoreBind]
 -- See Note [Data constructor workers]
-mkDataConWorkers data_tycons
-  = [ NonRec id (Var id)        -- The ice is thin here, but it works
+-- c.f. Note [Injecting implicit bindings] in TidyPgm
+mkDataConWorkers dflags mod_loc data_tycons
+  = [ NonRec id (tick_it (getName data_con) (Var id))
+                                -- The ice is thin here, but it works
     | tycon <- data_tycons,     -- CorePrep will eta-expand it
       data_con <- tyConDataCons tycon,
-      let id = dataConWorkId data_con ]
+      let id = dataConWorkId data_con
+    ]
+ where
+   -- If debugging, we try to put a source note on the worker. This is
+   -- useful especially for heap profiling.
+   tick_it name
+     | not (gopt Opt_Debug dflags)           = id
+     | RealSrcSpan span <- nameSrcSpan name  = Tick (SourceNote span nameStr)
+     | Just file <- ml_hs_file mod_loc       = Tick (SourceNote (dummySpan file) nameStr)
+     | otherwise                             = Tick (SourceNote (dummySpan "???") nameStr)
+     where nameStr = showSDoc dflags (ppr name)
+           dummySpan file = realSrcLocSpan $ mkRealSrcLoc (mkFastString file) 1 1
+
 \end{code}
 
 Note [Floating out of top level bindings]
@@ -387,7 +413,7 @@ cpePair top_lvl is_rec dmd is_unlifted env bndr rhs
        ; (floats2, rhs2) <- float_from_rhs floats1 rhs1
 
        -- Make the arity match up
-       ; (floats3, rhs')
+       ; (floats3, rhs3)
             <- if manifestArity rhs1 <= arity
                then return (floats2, cpeEtaExpand arity rhs2)
                else WARN(True, text "CorePrep: silly extra arguments:" <+> ppr bndr)
@@ -397,15 +423,18 @@ cpePair top_lvl is_rec dmd is_unlifted env bndr rhs
                         ; return ( addFloat floats2 float
                                  , cpeEtaExpand arity (Var v)) })
 
+        -- Wrap floating ticks
+       ; let (floats4, rhs4) = wrapTicks floats3 rhs3
+
         -- Record if the binder is evaluated
         -- and otherwise trim off the unfolding altogether
         -- It's not used by the code generator; getting rid of it reduces
         -- heap usage and, since we may be changing uniques, we'd have
         -- to substitute to keep it right
-       ; let bndr' | exprIsHNF rhs' = bndr `setIdUnfolding` evaldUnfolding
+       ; let bndr' | exprIsHNF rhs3 = bndr `setIdUnfolding` evaldUnfolding
                    | otherwise      = bndr `setIdUnfolding` noUnfolding
 
-       ; return (floats3, bndr', rhs') }
+       ; return (floats4, bndr', rhs4) }
   where
     is_strict_or_unlifted = (isStrictDmd dmd) || is_unlifted
 
@@ -494,11 +523,13 @@ cpeRhsE env (Let bind expr)
        ; return (new_binds `appendFloats` floats, body) }
 
 cpeRhsE env (Tick tickish expr)
-  | ignoreTickish tickish
-  = cpeRhsE env expr
-  | otherwise         -- Just SCCs actually
+  | tickishPlace tickish == PlaceNonLam && tickish `tickishScopesLike` SoftScope
+  = do { (floats, body) <- cpeRhsE env expr
+         -- See [Floating Ticks in CorePrep]
+       ; return (unitFloat (FloatTick tickish) `appendFloats` floats, body) }
+  | otherwise
   = do { body <- cpeBodyNF env expr
-       ; return (emptyFloats, Tick tickish' body) }
+       ; return (emptyFloats, mkTick tickish' body) }
   where
     tickish' | Breakpoint n fvs <- tickish
              = Breakpoint n (map (lookupCorePrepEnv env) fvs)
@@ -577,9 +608,9 @@ rhsToBody :: CpeRhs -> UniqSM (Floats, CpeBody)
 -- Remove top level lambdas by let-binding
 
 rhsToBody (Tick t expr)
-  | not (tickishScoped t)  -- we can only float out of non-scoped annotations
+  | tickishScoped t == NoScope  -- we can only float out of non-scoped annotations
   = do { (floats, expr') <- rhsToBody expr
-       ; return (floats, Tick t expr') }
+       ; return (floats, mkTick t expr') }
 
 rhsToBody (Cast e co)
         -- You can get things like
@@ -679,8 +710,10 @@ cpeApp env expr
            ; return (Cast fun' co, hd, ty2, floats, ss) }
 
     collect_args (Tick tickish fun) depth
-      | ignoreTickish tickish   -- Drop these notes altogether
-      = collect_args fun depth  -- They aren't used by the code generator
+      | tickishPlace tickish == PlaceNonLam && tickish `tickishScopesLike` SoftScope
+      = do { (fun',hd,fun_ty,floats,ss) <- collect_args fun depth
+             -- See [Floating Ticks in CorePrep]
+           ; return (fun',hd,fun_ty,addFloat floats (FloatTick tickish),ss) }
 
         -- N-variable fun, better let-bind it
     collect_args fun depth
@@ -801,10 +834,6 @@ of the scope of a `seq`, or dropped the `seq` altogether.
 %************************************************************************
 
 \begin{code}
--- we don't ignore any Tickishes at the moment.
-ignoreTickish :: Tickish Id -> Bool
-ignoreTickish _ = False
-
 cpe_ExprIsTrivial :: CoreExpr -> Bool
 -- Version that doesn't consider an scc annotation to be trivial.
 cpe_ExprIsTrivial (Var _)        = True
@@ -908,6 +937,9 @@ tryEtaReducePrep bndrs (Let bind@(NonRec _ r) body)
   where
     fvs = exprFreeVars r
 
+tryEtaReducePrep bndrs (Tick tickish e)
+  = fmap (mkTick tickish) $ tryEtaReducePrep bndrs e
+
 tryEtaReducePrep _ _ = Nothing
 \end{code}
 
@@ -932,11 +964,14 @@ data FloatingBind
       Id CpeBody
       Bool              -- The bool indicates "ok-for-speculation"
 
+ | FloatTick (Tickish Id)
+
 data Floats = Floats OkToSpec (OrdList FloatingBind)
 
 instance Outputable FloatingBind where
   ppr (FloatLet b) = ppr b
   ppr (FloatCase b r ok) = brackets (ppr ok) <+> ppr b <+> equals <+> ppr r
+  ppr (FloatTick t) = ppr t
 
 instance Outputable Floats where
   ppr (Floats flag fs) = ptext (sLit "Floats") <> brackets (ppr flag) <+>
@@ -982,6 +1017,7 @@ wrapBinds (Floats _ binds) body
   where
     mk_bind (FloatCase bndr rhs _) body = Case rhs bndr (exprType body) [(DEFAULT, [], body)]
     mk_bind (FloatLet bind)        body = Let bind body
+    mk_bind (FloatTick tickish)    body = mkTick tickish body
 
 addFloat :: Floats -> FloatingBind -> Floats
 addFloat (Floats ok_to_spec floats) new_float
@@ -991,6 +1027,7 @@ addFloat (Floats ok_to_spec floats) new_float
     check (FloatCase _ _ ok_for_spec)
         | ok_for_spec  =  IfUnboxedOk
         | otherwise    =  NotOkToSpec
+    check FloatTick{}  = OkToSpec
         -- The ok-for-speculation flag says that it's safe to
         -- float this Case out of a let, and thereby do it more eagerly
         -- We need the top-level flag because it's never ok to float
@@ -1114,9 +1151,9 @@ data CorePrepEnv = CPE {
 
 lookupMkIntegerName :: DynFlags -> HscEnv -> IO Id
 lookupMkIntegerName dflags hsc_env
-    = if thisPackage dflags == primPackageId
+    = if thisPackage dflags == primPackageKey
       then return $ panic "Can't use Integer in ghc-prim"
-      else if thisPackage dflags == integerPackageId
+      else if thisPackage dflags == integerPackageKey
       then return $ panic "Can't use Integer in integer"
       else liftM tyThingId
          $ initTcForLookup hsc_env (tcLookupGlobal mkIntegerName)
@@ -1191,4 +1228,51 @@ newVar ty
  = seqType ty `seq` do
      uniq <- getUniqueM
      return (mkSysLocal (fsLit "sat") uniq ty)
+
+
+------------------------------------------------------------------------------
+-- Floating ticks
+-- ---------------------------------------------------------------------------
+--
+-- Note [Floating Ticks in CorePrep]
+--
+-- It might seem counter-intuitive to float ticks by default, given
+-- that we don't actually want to move them if we can help it. On the
+-- other hand, nothing gets very far in CorePrep anyway, and we want
+-- to preserve the order of let bindings and tick annotations in
+-- relation to each other. For example, if we just wrapped let floats
+-- when they pass through ticks, we might end up performing the
+-- following transformation:
+--
+--   src<...> let foo = bar in baz
+--   ==>  let foo = src<...> bar in src<...> baz
+--
+-- Because the let-binding would float through the tick, and then
+-- immediately materialize, achieving nothing but decreasing tick
+-- accuracy. The only special case is the following scenario:
+--
+--   let foo = src<...> (let a = b in bar) in baz
+--   ==>  let foo = src<...> bar; a = src<...> b in baz
+--
+-- Here we would not want the source tick to end up covering "baz" and
+-- therefore refrain from pushing ticks outside. Instead, we copy them
+-- into the floating binds (here "a") in cpePair. Note that where "b"
+-- or "bar" are (value) lambdas we have to push the annotations
+-- further inside in order to uphold our rules.
+--
+-- All of this is implemented below in @wrapTicks@.
+
+-- | Like wrapFloats, but only wraps tick floats
+wrapTicks :: Floats -> CoreExpr -> (Floats, CoreExpr)
+wrapTicks (Floats flag floats0) expr = (Floats flag floats1, expr')
+  where (floats1, expr') = foldrOL go (nilOL, expr) floats0
+        go (FloatTick t) (fs, e) = ASSERT(tickishPlace t == PlaceNonLam)
+                                   (mapOL (wrap t) fs, mkTick t e)
+        go other         (fs, e) = (other `consOL` fs, e)
+        wrap t (FloatLet bind)    = FloatLet (wrapBind t bind)
+        wrap t (FloatCase b r ok) = FloatCase b (mkTick t r) ok
+        wrap _ other              = pprPanic "wrapTicks: unexpected float!" (ppr other)
+        wrapBind t (NonRec binder rhs) = NonRec binder (mkTick t rhs)
+        wrapBind t (Rec pairs)         = Rec (mapSnd (mkTick t) pairs)
+
 \end{code}
diff --git a/compiler/coreSyn/CoreSubst.lhs b/compiler/coreSyn/CoreSubst.lhs
index fef3e86a2e54..5ab82fa9aeee 100644
--- a/compiler/coreSyn/CoreSubst.lhs
+++ b/compiler/coreSyn/CoreSubst.lhs
@@ -6,7 +6,8 @@
 Utility functions on @Core@ syntax
 
 \begin{code}
-{-# OPTIONS -fno-warn-tabs #-}
+{-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
 -- The above warning supression flag is a temporary kludge.
 -- While working on this module you are encouraged to remove it and
 -- detab the module (please do the detabbing in a separate patch). See
@@ -23,7 +24,7 @@ module CoreSubst (
 	substTy, substCo, substExpr, substExprSC, substBind, substBindSC,
         substUnfolding, substUnfoldingSC,
 	lookupIdSubst, lookupTvSubst, lookupCvSubst, substIdOcc,
-        substTickish,
+        substTickish, substVarSet,
 
         -- ** Operations on substitutions
 	emptySubst, mkEmptySubst, mkSubst, mkOpenSubst, substInScope, isEmptySubst, 
@@ -40,7 +41,7 @@ module CoreSubst (
 
 	-- ** Simple expression optimiser
         simpleOptPgm, simpleOptExpr, simpleOptExprWith,
-        exprIsConApp_maybe, exprIsLiteral_maybe
+        exprIsConApp_maybe, exprIsLiteral_maybe, exprIsLambda_maybe,
     ) where
 
 #include "HsVersions.h"
@@ -61,7 +62,7 @@ import Coercion hiding ( substTy, substCo, extendTvSubst, substTyVarBndr, substC
 
 import TyCon       ( tyConArity )
 import DataCon
-import PrelNames   ( eqBoxDataConKey )
+import PrelNames   ( eqBoxDataConKey, coercibleDataConKey )
 import OptCoercion ( optCoercion )
 import PprCore     ( pprCoreBindings, pprRules )
 import Module	   ( Module )
@@ -355,7 +356,7 @@ instance Outputable Subst where
 %************************************************************************
 
 \begin{code}
--- | Apply a substititon to an entire 'CoreExpr'. Rememeber, you may only 
+-- | Apply a substitution to an entire 'CoreExpr'. Remember, you may only 
 -- apply the substitution /once/: see "CoreSubst#apply_once"
 --
 -- Do *not* attempt to short-cut in the case of an empty substitution!
@@ -402,8 +403,8 @@ subst_expr subst expr
 				 where
 				   (subst', bndrs') = substBndrs subst bndrs
 
--- | Apply a substititon to an entire 'CoreBind', additionally returning an updated 'Subst'
--- that should be used by subsequent substitutons.
+-- | Apply a substitution to an entire 'CoreBind', additionally returning an updated 'Subst'
+-- that should be used by subsequent substitutions.
 substBind, substBindSC :: Subst -> CoreBind -> (Subst, CoreBind)
 
 substBindSC subst bind 	  -- Short-cut if the substitution is empty
@@ -460,7 +461,7 @@ preserve occ info in rules.
 
 \begin{code}
 -- | Substitutes a 'Var' for another one according to the 'Subst' given, returning
--- the result and an updated 'Subst' that should be used by subsequent substitutons.
+-- the result and an updated 'Subst' that should be used by subsequent substitutions.
 -- 'IdInfo' is preserved by this process, although it is substituted into appropriately.
 substBndr :: Subst -> Var -> (Subst, Var)
 substBndr subst bndr
@@ -484,7 +485,7 @@ substRecBndrs subst bndrs
 \begin{code}
 substIdBndr :: SDoc 
             -> Subst		-- ^ Substitution to use for the IdInfo
-	    -> Subst -> Id 	-- ^ Substitition and Id to transform
+	    -> Subst -> Id 	-- ^ Substitution and Id to transform
 	    -> (Subst, Id)	-- ^ Transformed pair
 				-- NB: unfolding may be zapped
 
@@ -555,7 +556,7 @@ cloneRecIdBndrs subst us ids
 -- Just like substIdBndr, except that it always makes a new unique
 -- It is given the unique to use
 clone_id    :: Subst			-- Substitution for the IdInfo
-	    -> Subst -> (Id, Unique)	-- Substitition and Id to transform
+	    -> Subst -> (Id, Unique)	-- Substitution and Id to transform
 	    -> (Subst, Id)		-- Transformed pair
 
 clone_id rec_subst subst@(Subst in_scope idvs tvs cvs) (old_id, uniq)
@@ -966,6 +967,14 @@ simple_app subst (Lam b e) (a:as)
   where
     (subst', b') = subst_opt_bndr subst b
     b2 = add_info subst' b b'
+simple_app subst (Var v) as
+  | isCompulsoryUnfolding (idUnfolding v)
+  -- See Note [Unfold compulsory unfoldings in LHSs]
+  =  simple_app subst (unfoldingTemplate (idUnfolding v)) as
+simple_app subst (Tick t e) as
+  -- Okay to do "(Tick t e) x ==> Tick t (e x)"?
+  | t `tickishScopesLike` SoftScope
+  = mkTick t $ simple_app subst e as
 simple_app subst e as
   = foldl App (simple_opt_expr subst e) as
 
@@ -1039,7 +1048,7 @@ maybe_substitute subst b r
     trivial | exprIsTrivial r = True
             | (Var fun, args) <- collectArgs r
             , Just dc <- isDataConWorkId_maybe fun
-            , dc `hasKey` eqBoxDataConKey
+            , dc `hasKey` eqBoxDataConKey || dc `hasKey` coercibleDataConKey
             , all exprIsTrivial args = True -- See Note [Optimise coercion boxes agressively]
             | otherwise = False
 
@@ -1112,6 +1121,12 @@ we don't know what phase we're in.  Here's an example
 When inlining 'foo' in 'bar' we want the let-binding for 'inner' 
 to remain visible until Phase 1
 
+Note [Unfold compulsory unfoldings in LHSs]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+When the user writes `map coerce = coerce` as a rule, the rule will only ever
+match if we replace coerce by its unfolding on the LHS, because that is the
+core that the rule matching engine will find. So do that for everything that
+has a compulsory unfolding. Also see Note [Desugaring coerce as cast] in Desugar
 
 %************************************************************************
 %*                                                                      *
@@ -1289,4 +1304,77 @@ exprIsLiteral_maybe env@(_, id_unf) e
       Var v     | Just rhs <- expandUnfolding_maybe (id_unf v)
                 -> exprIsLiteral_maybe env rhs
       _         -> Nothing
-\end{code}       
+\end{code}
+
+Note [exprIsLambda_maybe]
+~~~~~~~~~~~~~~~~~~~~~~~~~~
+exprIsLambda_maybe will, given an expression `e`, try to turn it into the form
+`Lam v e'` (returned as `Just (v,e')`). Besides using lambdas, it looks through
+casts (using the Push rule), and it unfolds function calls if the unfolding
+has a greater arity than arguments are present.
+
+Currently, it is used in Rules.match, and is required to make
+"map coerce = coerce" match.
+
+\begin{code}
+exprIsLambda_maybe :: InScopeEnv -> CoreExpr -> Maybe (Var, CoreExpr)
+    -- See Note [exprIsLambda_maybe]
+
+-- The simple case: It is a lambda already
+exprIsLambda_maybe _ (Lam x e)
+    = Just (x, e)
+
+-- Also possible: A casted lambda. Push the coercion inside
+exprIsLambda_maybe (in_scope_set, id_unf) (Cast casted_e co)
+    | Just (x, e) <- exprIsLambda_maybe (in_scope_set, id_unf) casted_e
+    -- Only do value lambdas.
+    -- this implies that x is not in scope in gamma (makes this code simpler)
+    , not (isTyVar x) && not (isCoVar x)
+    , ASSERT( not $ x `elemVarSet` tyCoVarsOfCo co) True
+    , let res = pushCoercionIntoLambda in_scope_set x e co
+    = -- pprTrace "exprIsLambda_maybe:Cast" (vcat [ppr casted_e, ppr co, ppr res])
+      res
+
+-- Another attempt: See if we find a partial unfolding
+exprIsLambda_maybe (in_scope_set, id_unf) e
+    | (Var f, as) <- collectArgs e
+    , let unfolding = id_unf f
+    , Just rhs <- expandUnfolding_maybe unfolding
+    -- Make sure there is hope to get a lambda
+    , unfoldingArity unfolding > length (filter isValArg as)
+    -- Optimize, for beta-reduction
+    , let e' =  simpleOptExprWith (mkEmptySubst in_scope_set) (rhs `mkApps` as)
+    -- Recurse, because of possible casts
+    , Just (x', e'') <- exprIsLambda_maybe (in_scope_set, id_unf) e'
+    , let res = Just (x', e'')
+    = -- pprTrace "exprIsLambda_maybe:Unfold" (vcat [ppr e, ppr res])
+      res
+
+exprIsLambda_maybe _ _e
+    = -- pprTrace "exprIsLambda_maybe:Fail" (vcat [ppr _e])
+      Nothing
+
+
+pushCoercionIntoLambda
+    :: InScopeSet -> Var -> CoreExpr -> Coercion -> Maybe (Var, CoreExpr)
+pushCoercionIntoLambda in_scope x e co
+    -- This implements the Push rule from the paper on coercions
+    -- Compare with simplCast in Simplify
+    | ASSERT(not (isTyVar x) && not (isCoVar x)) True
+    , Pair s1s2 t1t2 <- coercionKind co
+    , Just (_s1,_s2) <- splitFunTy_maybe s1s2
+    , Just (t1,_t2) <- splitFunTy_maybe t1t2
+    = let [co1, co2] = decomposeCo 2 co
+          -- Should we optimize the coercions here?
+          -- Otherwise they might not match too well
+          x' = x `setIdType` t1
+          in_scope' = in_scope `extendInScopeSet` x'
+          subst = extendIdSubst (mkEmptySubst in_scope')
+                                x
+                                (mkCast (Var x') co1)
+      in Just (x', subst_expr subst e `mkCast` co2)
+    | otherwise
+    = pprTrace "exprIsLambda_maybe: Unexpected lambda in case" (ppr (Lam x e))
+      Nothing
+
+\end{code}
diff --git a/compiler/coreSyn/CoreSyn.lhs b/compiler/coreSyn/CoreSyn.lhs
index 3dc8eeb31f7a..782697a24390 100644
--- a/compiler/coreSyn/CoreSyn.lhs
+++ b/compiler/coreSyn/CoreSyn.lhs
@@ -4,9 +4,8 @@
 %
 
 \begin{code}
-{-# LANGUAGE DeriveDataTypeable, DeriveFunctor #-}
-
-{-# OPTIONS -fno-warn-tabs #-}
+{-# LANGUAGE CPP, DeriveDataTypeable, DeriveFunctor #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
 -- The above warning supression flag is a temporary kludge.
 -- While working on this module you are encouraged to remove it and
 -- detab the module (please do the detabbing in a separate patch). See
@@ -16,9 +15,10 @@
 -- | CoreSyn holds all the main data types for use by for the Glasgow Haskell Compiler midsection
 module CoreSyn (
 	-- * Main data types
-        Expr(..), Alt, Bind(..), AltCon(..), Arg, Tickish(..),
+        Expr(..), Alt, Bind(..), AltCon(..), Arg,
+        Tickish(..), RawTickish, TickishScoping(..), TickishPlacement(..), ExprPtr(..),
         CoreProgram, CoreExpr, CoreAlt, CoreBind, CoreArg, CoreBndr,
-        TaggedExpr, TaggedAlt, TaggedBind, TaggedArg, TaggedBndr(..),
+        TaggedExpr, TaggedAlt, TaggedBind, TaggedArg, TaggedBndr(..), deTagExpr,
 
         -- ** 'Expr' construction
 	mkLets, mkLams,
@@ -44,8 +44,11 @@ module CoreSyn (
         isValArg, isTypeArg, isTyCoArg, valArgCount, valBndrCount,
         isRuntimeArg, isRuntimeVar,
 
-        tickishCounts, tickishScoped, tickishIsCode, mkNoCount, mkNoScope,
-        tickishCanSplit,
+        tickishCounts, tickishScoped, tickishScopesLike, tickishFloatable,
+        tickishCanSplit, mkNoCount, mkNoScope,
+        tickishIsCode, tickishPlace,
+        exprPtrCons,
+        tickishContains,
 
         -- * Unfolding data types
         Unfolding(..),  UnfoldingGuidance(..), UnfoldingSource(..),
@@ -105,6 +108,7 @@ import DynFlags
 import FastString
 import Outputable
 import Util
+import SrcLoc     ( RealSrcSpan, containsSpan )
 
 import Data.Data hiding (TyCon)
 import Data.Int
@@ -181,25 +185,8 @@ These data types are the heart of the compiler
 --    /must/ be of lifted type (see "Type#type_classification" for
 --    the meaning of /lifted/ vs. /unlifted/).
 --    
---    #let_app_invariant#
---    The right hand side of of a non-recursive 'Let' 
---    _and_ the argument of an 'App',
---    /may/ be of unlifted type, but only if the expression 
---    is ok-for-speculation.  This means that the let can be floated 
---    around without difficulty. For example, this is OK:
---    
---    > y::Int# = x +# 1#
---    
---    But this is not, as it may affect termination if the 
---    expression is floated out:
---    
---    > y::Int# = fac 4#
---    
---    In this situation you should use @case@ rather than a @let@. The function
---    'CoreUtils.needsCaseBinding' can help you determine which to generate, or
---    alternatively use 'MkCore.mkCoreLet' rather than this constructor directly,
---    which will generate a @case@ if necessary
---    
+--    See Note [CoreSyn let/app invariant]
+--
 --    #type_let#
 --    We allow a /non-recursive/ let to bind a type variable, thus:
 --    
@@ -360,9 +347,28 @@ See #letrec_invariant#
 
 Note [CoreSyn let/app invariant]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-See #let_app_invariant#
+The let/app invariant
+     the right hand side of of a non-recursive 'Let', and
+     the argument of an 'App',
+    /may/ be of unlifted type, but only if
+    the expression is ok-for-speculation.
+
+This means that the let can be floated around
+without difficulty. For example, this is OK:
 
-This is intially enforced by DsUtils.mkCoreLet and mkCoreApp
+   y::Int# = x +# 1#
+
+But this is not, as it may affect termination if the
+expression is floated out:
+
+   y::Int# = fac 4#
+
+In this situation you should use @case@ rather than a @let@. The function
+'CoreUtils.needsCaseBinding' can help you determine which to generate, or
+alternatively use 'MkCore.mkCoreLet' rather than this constructor directly,
+which will generate a @case@ if necessary
+
+Th let/app invariant is initially enforced by DsUtils.mkCoreLet and mkCoreApp
 
 Note [CoreSyn case invariants]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -395,7 +401,7 @@ Here's another example:
   f :: T -> Bool
   f = \(x:t). case x of Bool {}
 Since T has no data constructors, the case alternatives are of course
-empty.  However note that 'x' is not bound to a visbily-bottom value;
+empty.  However note that 'x' is not bound to a visibly-bottom value;
 it's the *type* that tells us it's going to diverge.  Its a bit of a
 degnerate situation but we do NOT want to replace
    case x of Bool {}   -->   error Bool "Inaccessible case"
@@ -472,8 +478,48 @@ data Tickish id =
                                 -- Note [substTickish] in CoreSubst.
     }
 
+  -- | A source note.
+  --
+  -- Source notes are pure annotations: Their presence should neither
+  -- influence compilation nor execution. The semantics are given by
+  -- causality: The presence of a source note means that a local
+  -- change in the referenced source code span will possibly provoke
+  -- the generated code to change. On the flip-side, the functionality
+  -- of annotated code *must* be invariant against changes to all
+  -- source code *except* the spans referenced in the source notes
+  -- (see "Causality of optimized Haskell" paper for details).
+  --
+  -- Therefore extending the scope of any given source note is always
+  -- valid. Note that it is still undesirable though, as this reduces
+  -- their usefulness for debugging and profiling. Therefore we will
+  -- generally try only to make use of this property where it is
+  -- neccessary to enable optimizations.
+  | SourceNote
+    { sourceSpan :: RealSrcSpan -- ^ Source covered
+    , sourceName :: String      -- ^ Name for source location
+                                --   (uses same names as CCs)
+    }
+
+  -- | A core note. These types of ticks only live after Core2Stg and
+  -- carry the core that a piece of Stg was generated from.
+  | CoreNote
+    { coreBind :: Var          -- ^ Name the core fragment is bound to
+    , coreNote :: ExprPtr Var  -- ^ Source covered
+    }
+
   deriving (Eq, Ord, Data, Typeable)
 
+-- | Tickish out of Core context
+type RawTickish = Tickish ()
+
+-- | Pointer to a Core expression or case alternative. Ignored for the
+-- purpose of equality checks.
+data ExprPtr id = ExprPtr (Expr id)
+                | AltPtr (Alt id)
+                deriving (Data, Typeable)
+instance Eq (ExprPtr id)  where _ == _       = True
+instance Ord (ExprPtr id) where compare _ _  = EQ
+
 
 -- | A "counting tick" (where tickishCounts is True) is one that
 -- counts evaluations in some way.  We cannot discard a counting tick,
@@ -483,41 +529,210 @@ data Tickish id =
 -- However, we still allow the simplifier to increase or decrease
 -- sharing, so in practice the actual number of ticks may vary, except
 -- that we never change the value from zero to non-zero or vice versa.
---
 tickishCounts :: Tickish id -> Bool
 tickishCounts n@ProfNote{} = profNoteCount n
 tickishCounts HpcTick{}    = True
 tickishCounts Breakpoint{} = True
-
-tickishScoped :: Tickish id -> Bool
-tickishScoped n@ProfNote{} = profNoteScope n
-tickishScoped HpcTick{}    = False
-tickishScoped Breakpoint{} = True
+tickishCounts _            = False
+
+
+-- | Specifies the scoping behaviour of ticks. This governs the
+-- behaviour of ticks that care about the covered code and the cost
+-- associated with it. Important for ticks relating to profiling.
+data TickishScoping =
+    -- | No scoping: The tick does not care about what code it
+    -- covers. Transformations can freely move code inside as well as
+    -- outside without any additional annotation obligations
+    NoScope
+
+    -- | Soft scoping: We want all code that is covered to stay
+    -- covered.  Note that this scope type does not forbid
+    -- transformations from happening, as as long as all results of
+    -- the transformations are still covered by this tick or a copy of
+    -- it. For example
+    --
+    --   let x = tick<...> (let y = foo in bar) in baz
+    --     ===>
+    --   let x = tick<...> bar; y = tick<...> foo in baz
+    --
+    -- Is a valid transformation as far as "bar" and "foo" is
+    -- concerned, because both still are scoped over by the tick.
+    --
+    -- Note though that one might object to the "let" not being
+    -- covered by the tick any more. However, we are generally lax
+    -- with this - constant costs don't matter too much, and given
+    -- that the "let" was effectively merged we can view it as having
+    -- lost its identity anyway.
+    --
+    -- Also note that this scoping behaviour allows floating a tick
+    -- "upwards" in pretty much any situation. For example:
+    --
+    --   case foo of x -> tick<...> bar
+    --     ==>
+    --   tick<...> case foo of x -> bar
+    --
+    -- While this is always leagl, we want to make a best effort to
+    -- only make us of this where it exposes transformation
+    -- opportunities.
+  | SoftScope
+
+    -- | Cost centre scoping: We don't want any costs to move to other
+    -- cost-centre stacks. This means we not only want no code or cost
+    -- to get moved out of their cost centres, but we also object to
+    -- code getting associated with new cost-centre ticks - or
+    -- changing the order in which they get applied.
+    --
+    -- A rule of thumb is that we don't want any code to gain new
+    -- annotations. However, there are notable exceptions, for
+    -- example:
+    --
+    --   let f = \y -> foo in tick<...> ... (f x) ...
+    --     ==>
+    --   tick<...> ... foo[x/y] ...
+    --
+    -- In-lining lambdas like this is always legal, because inlining a
+    -- function does not change the cost-centre stack when the
+    -- function is called.
+  | CostCentreScope
+
+  deriving (Eq)
+
+-- | Returns the intended scoping rule for a Tickish
+tickishScoped :: Tickish id -> TickishScoping
+tickishScoped n@ProfNote{}
+  | profNoteScope n        = CostCentreScope
+  | otherwise              = NoScope
+tickishScoped HpcTick{}    = NoScope
+tickishScoped Breakpoint{} = CostCentreScope
    -- Breakpoints are scoped: eventually we're going to do call
    -- stacks, but also this helps prevent the simplifier from moving
    -- breakpoints around and changing their result type (see #1531).
+tickishScoped SourceNote{} = SoftScope
+tickishScoped CoreNote{}   = SoftScope
+
+-- | Returns whether the tick scoping rule is at least as permissive
+-- as the given scoping rule.
+tickishScopesLike :: Tickish id -> TickishScoping -> Bool
+tickishScopesLike t scope = tickishScoped t `like` scope
+  where NoScope         `like` _               = True
+        _               `like` NoScope         = False
+        SoftScope       `like` _               = True
+        _               `like` SoftScope       = False
+        CostCentreScope `like` _               = True
+
+-- | Returns @True@ for ticks that can be floated upwards easily even
+-- where it might change execution counts, such as:
+--
+--   Just (tick<...> foo)
+--     ==>
+--   tick<...> (Just foo)
+--
+-- This is a combination of @tickishSoftScope@ and
+-- @tickishCounts@. Note that in principle splittable ticks can become
+-- floatable using @mkNoTick@ -- even though there's currently no
+-- tickish for which that is the case.
+tickishFloatable :: Tickish id -> Bool
+tickishFloatable t = t `tickishScopesLike` SoftScope && not (tickishCounts t)
+
+-- | Returns @True@ for a tick that is both counting /and/ scoping and
+-- can be split into its (tick, scope) parts using 'mkNoScope' and
+-- 'mkNoTick' respectively.
+tickishCanSplit :: Tickish id -> Bool
+tickishCanSplit ProfNote{profNoteScope = True, profNoteCount = True}
+                   = True
+tickishCanSplit _  = False
 
 mkNoCount :: Tickish id -> Tickish id
-mkNoCount n@ProfNote{} = n {profNoteCount = False}
-mkNoCount Breakpoint{} = panic "mkNoCount: Breakpoint" -- cannot split a BP
-mkNoCount HpcTick{}    = panic "mkNoCount: HpcTick"
+mkNoCount n | not (tickishCounts n)   = n
+            | not (tickishCanSplit n) = panic "mkNoCount: Cannot split!"
+mkNoCount n@ProfNote{}                = n {profNoteCount = False}
+mkNoCount _                           = panic "mkNoCount: Undefined split!"
 
 mkNoScope :: Tickish id -> Tickish id
-mkNoScope n@ProfNote{} = n {profNoteScope = False}
-mkNoScope Breakpoint{} = panic "mkNoScope: Breakpoint" -- cannot split a BP
-mkNoScope HpcTick{}    = panic "mkNoScope: HpcTick"
-
--- | Return True if this source annotation compiles to some code, or will
--- disappear before the backend.
+mkNoScope n | tickishScoped n == NoScope  = n
+            | not (tickishCanSplit n)     = panic "mkNoScope: Cannot split!"
+mkNoScope n@ProfNote{}                    = n {profNoteScope = False}
+mkNoScope _                               = panic "mkNoScope: Undefined split!"
+
+-- | Return @True@ if this source annotation compiles to some backend
+-- code. Without this flag, the tickish is seen as a simple annotation
+-- that does not have any associated evaluation code.
+--
+-- What this means that we are allowed to disregard the tick if doing
+-- so means that we can skip generating any code in the first place. A
+-- typical example is top-level bindings:
+--
+--   foo = tick<...> \y -> ...
+--     ==>
+--   foo = \y -> tick<...> ...
+--
+-- Here there is just no operational difference between the first and
+-- the second version. Therefore code generation should simply
+-- translate the code as if it found the latter.
 tickishIsCode :: Tickish id -> Bool
-tickishIsCode _tickish = True  -- all of them for now
-
--- | Return True if this Tick can be split into (tick,scope) parts with
--- 'mkNoScope' and 'mkNoCount' respectively.
-tickishCanSplit :: Tickish Id -> Bool
-tickishCanSplit Breakpoint{} = False
-tickishCanSplit HpcTick{}    = False
-tickishCanSplit _ = True
+tickishIsCode SourceNote{} = False
+tickishIsCode CoreNote{}   = False
+tickishIsCode _tickish     = True  -- all the rest for now
+
+
+-- | Governs the kind of expression that the tick gets placed on when
+-- annotating for example using @mkTick@. If we find that we want to
+-- put a tickish on an expression ruled out here, we try to float it
+-- inwards until we find a suitable expression.
+data TickishPlacement =
+
+    -- | Place ticks exactly on run-time expressions. We can still
+    -- move the tick through pure compile-time constructs such as
+    -- other ticks, casts or type lambdas. This is the most
+    -- restrictive placement rule for ticks, as all tickishs have in
+    -- common that they want to track runtime processes. The only
+    -- legal placement rule for counting ticks.
+    PlaceRuntime
+
+    -- | As @PlaceRuntime@, but we float the tick through all
+    -- lambdas. This makes sense where there is little difference
+    -- between annotating the lambda and annotating the lambda's code.
+  | PlaceNonLam
+
+    -- | In addition to floating through lambdas, cost-centre style
+    -- tickishs can also be moved from constructors, non-function
+    -- variables and literals. For example:
+    --
+    --   let x = scc<...> C (scc<...> y) (scc<...> 3) in ...
+    --
+    -- Neither the constructor application, the variable or the
+    -- literal are likely to have any cost worth mentioning. And even
+    -- if y names a thunk, the call would not care about the
+    -- evaluation context. Therefore removing all annotations in the
+    -- above example is safe.
+  | PlaceCostCentre
+
+  deriving (Eq)
+
+-- | Placement behaviour we want for the ticks
+tickishPlace :: Tickish id -> TickishPlacement
+tickishPlace n@ProfNote{}
+  | profNoteCount n        = PlaceRuntime
+  | otherwise              = PlaceCostCentre
+tickishPlace HpcTick{}     = PlaceRuntime
+tickishPlace Breakpoint{}  = PlaceRuntime
+tickishPlace SourceNote{}  = PlaceNonLam
+tickishPlace CoreNote{}    = PlaceNonLam
+
+-- | Returns whether one tick "contains" the other one, therefore
+-- making the second tick redundant.
+tickishContains :: Tickish Id -> Tickish Id -> Bool
+tickishContains (SourceNote sp1 n1) (SourceNote sp2 n2)
+  = n1 == n2 && containsSpan sp1 sp2
+tickishContains t1 t2
+  = t1 == t2
+
+-- | Gives constructor of expr pointer or DEFAULT if not an
+-- alternative.
+exprPtrCons :: ExprPtr a -> AltCon
+exprPtrCons ExprPtr{}          = DEFAULT
+exprPtrCons (AltPtr (con,_,_)) = con
+
 \end{code}
 
 
@@ -1106,6 +1321,25 @@ instance Outputable b => OutputableBndr (TaggedBndr b) where
   pprBndr _ b = ppr b	-- Simple
   pprInfixOcc  b = ppr b
   pprPrefixOcc b = ppr b
+
+deTagExpr :: TaggedExpr t -> CoreExpr
+deTagExpr (Var v)                   = Var v
+deTagExpr (Lit l)                   = Lit l
+deTagExpr (Type ty)                 = Type ty
+deTagExpr (Coercion co)             = Coercion co
+deTagExpr (App e1 e2)               = App (deTagExpr e1) (deTagExpr e2)
+deTagExpr (Lam (TB b _) e)          = Lam b (deTagExpr e)
+deTagExpr (Let bind body)           = Let (deTagBind bind) (deTagExpr body)
+deTagExpr (Case e (TB b _) ty alts) = Case (deTagExpr e) b ty (map deTagAlt alts)
+deTagExpr (Tick t e)                = Tick t (deTagExpr e)
+deTagExpr (Cast e co)               = Cast (deTagExpr e) co
+
+deTagBind :: TaggedBind t -> CoreBind
+deTagBind (NonRec (TB b _) rhs) = NonRec b (deTagExpr rhs)
+deTagBind (Rec prs)             = Rec [(b, deTagExpr rhs) | (TB b _, rhs) <- prs]
+
+deTagAlt :: TaggedAlt t -> CoreAlt
+deTagAlt (con, bndrs, rhs) = (con, [b | TB b _ <- bndrs], deTagExpr rhs)
 \end{code}
 
 
@@ -1197,8 +1431,9 @@ mkDoubleLitDouble :: Double -> Expr b
 mkDoubleLit       d = Lit (mkMachDouble d)
 mkDoubleLitDouble d = Lit (mkMachDouble (toRational d))
 
--- | Bind all supplied binding groups over an expression in a nested let expression. Prefer to
--- use 'MkCore.mkCoreLets' if possible
+-- | Bind all supplied binding groups over an expression in a nested let expression. Assumes
+-- that the rhs satisfies the let/app invariant.  Prefer to use 'MkCore.mkCoreLets' if
+-- possible, which does guarantee the invariant
 mkLets	      :: [Bind b] -> Expr b -> Expr b
 -- | Bind all supplied binders over an expression in a nested lambda expression. Prefer to
 -- use 'MkCore.mkCoreLams' if possible
@@ -1375,8 +1610,8 @@ seqExpr (Lam b e)       = seqBndr b `seq` seqExpr e
 seqExpr (Let b e)       = seqBind b `seq` seqExpr e
 seqExpr (Case e b t as) = seqExpr e `seq` seqBndr b `seq` seqType t `seq` seqAlts as
 seqExpr (Cast e co)     = seqExpr e `seq` seqCo co
-seqExpr (Tick n e)    = seqTickish n `seq` seqExpr e
-seqExpr (Type t)       = seqType t
+seqExpr (Tick n e)      = seqTickish n `seq` seqExpr e
+seqExpr (Type t)        = seqType t
 seqExpr (Coercion co)   = seqCo co
 
 seqExprs :: [CoreExpr] -> ()
@@ -1387,6 +1622,8 @@ seqTickish :: Tickish Id -> ()
 seqTickish ProfNote{ profNoteCC = cc } = cc `seq` ()
 seqTickish HpcTick{} = ()
 seqTickish Breakpoint{ breakpointFVs = ids } = seqBndrs ids
+seqTickish SourceNote{} = ()
+seqTickish CoreNote{} = ()
 
 seqBndr :: CoreBndr -> ()
 seqBndr b = b `seq` ()
diff --git a/compiler/coreSyn/CoreTidy.lhs b/compiler/coreSyn/CoreTidy.lhs
index 8c0ae4a65ac7..4754aa5afbfe 100644
--- a/compiler/coreSyn/CoreTidy.lhs
+++ b/compiler/coreSyn/CoreTidy.lhs
@@ -7,7 +7,8 @@ This module contains "tidying" code for *nested* expressions, bindings, rules.
 The code for *top-level* bindings is in TidyPgm.
 
 \begin{code}
-{-# OPTIONS -fno-warn-tabs #-}
+{-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
 -- The above warning supression flag is a temporary kludge.
 -- While working on this module you are encouraged to remove it and
 -- detab the module (please do the detabbing in a separate patch). See
@@ -33,7 +34,6 @@ import Name hiding (tidyNameOcc)
 import SrcLoc
 import Maybes
 import Data.List
-import Outputable
 \end{code}
 
 
@@ -141,18 +141,48 @@ tidyBndr env var
 tidyBndrs :: TidyEnv -> [Var] -> (TidyEnv, [Var])
 tidyBndrs env vars = mapAccumL tidyBndr env vars
 
+-- Non-top-level variables
+tidyIdBndr :: TidyEnv -> Id -> (TidyEnv, Id)
+tidyIdBndr env@(tidy_env, var_env) id
+  = -- Do this pattern match strictly, otherwise we end up holding on to
+    -- stuff in the OccName.
+    case tidyOccName tidy_env (getOccName id) of { (tidy_env', occ') ->
+    let
+	-- Give the Id a fresh print-name, *and* rename its type
+	-- The SrcLoc isn't important now,
+	-- though we could extract it from the Id
+	--
+        ty'      = tidyType env (idType id)
+        name'    = mkInternalName (idUnique id) occ' noSrcSpan
+	id'      = mkLocalIdWithInfo name' ty' new_info
+	var_env' = extendVarEnv var_env id id'
+
+	-- Note [Tidy IdInfo]
+        new_info = vanillaIdInfo `setOccInfo` occInfo old_info
+                                 `setUnfoldingInfo` new_unf
+	old_info = idInfo id
+        old_unf  = unfoldingInfo old_info
+        new_unf | isEvaldUnfolding old_unf = evaldUnfolding
+                | otherwise                = noUnfolding
+          -- See Note [Preserve evaluatedness]
+    in
+    ((tidy_env', var_env'), id')
+   }
+
 tidyLetBndr :: TidyEnv	       -- Knot-tied version for unfoldings
             -> TidyEnv 	       -- The one to extend
             -> (Id, CoreExpr) -> (TidyEnv, Var)
 -- Used for local (non-top-level) let(rec)s
-tidyLetBndr rec_tidy_env env (id,rhs) 
-  = ((tidy_occ_env,new_var_env), final_id)
-  where
-    ((tidy_occ_env,var_env), new_id) = tidyIdBndr env id
-    new_var_env = extendVarEnv var_env id final_id
-       -- Override the env we get back from tidyId with the 
-       -- new IdInfo so it gets propagated to the usage sites.
+-- Just like tidyIdBndr above, but with more IdInfo
+tidyLetBndr rec_tidy_env env@(tidy_env, var_env) (id,rhs)
+  = case tidyOccName tidy_env (getOccName id) of { (tidy_env', occ') ->
+    let
+        ty'      = tidyType env (idType id)
+        name'    = mkInternalName (idUnique id) occ' noSrcSpan
+	id'      = mkLocalIdWithInfo name' ty' new_info
+	var_env' = extendVarEnv var_env id id'
 
+	-- Note [Tidy IdInfo]
 	-- We need to keep around any interesting strictness and
 	-- demand info because later on we may need to use it when
 	-- converting to A-normal form.
@@ -161,48 +191,27 @@ tidyLetBndr rec_tidy_env env (id,rhs)
 	--	into  case (g x) of z -> f z  by CorePrep, but only if f still
 	-- 	has its strictness info.
 	--
-	-- Similarly for the demand info - on a let binder, this tells 
+	-- Similarly for the demand info - on a let binder, this tells
 	-- CorePrep to turn the let into a case.
 	--
 	-- Similarly arity info for eta expansion in CorePrep
-	-- 
-	-- Set inline-prag info so that we preseve it across 
+	--
+	-- Set inline-prag info so that we preseve it across
 	-- separate compilation boundaries
-    final_id = new_id `setIdInfo` new_info
-    idinfo   = idInfo id
-    new_info = idInfo new_id
-		`setArityInfo`		exprArity rhs
-                `setStrictnessInfo`	strictnessInfo idinfo
-                `setDemandInfo`	        demandInfo idinfo
-		`setInlinePragInfo`	inlinePragInfo idinfo
-		`setUnfoldingInfo`	new_unf
-
-    new_unf | isStableUnfolding unf = tidyUnfolding rec_tidy_env unf (panic "tidy_unf")
-            | otherwise	            = noUnfolding
-    unf = unfoldingInfo idinfo
-
--- Non-top-level variables
-tidyIdBndr :: TidyEnv -> Id -> (TidyEnv, Id)
-tidyIdBndr env@(tidy_env, var_env) id
-  = -- Do this pattern match strictly, otherwise we end up holding on to
-    -- stuff in the OccName.
-    case tidyOccName tidy_env (getOccName id) of { (tidy_env', occ') -> 
-    let 
-	-- Give the Id a fresh print-name, *and* rename its type
-	-- The SrcLoc isn't important now, 
-	-- though we could extract it from the Id
-	-- 
-        ty'      = tidyType env (idType id)
-        name'    = mkInternalName (idUnique id) occ' noSrcSpan
-	id'      = mkLocalIdWithInfo name' ty' new_info
-	var_env' = extendVarEnv var_env id id'
-
-	-- Note [Tidy IdInfo]
-        new_info = vanillaIdInfo `setOccInfo` occInfo old_info
 	old_info = idInfo id
+        new_info = vanillaIdInfo
+                    `setOccInfo`        occInfo old_info
+                    `setArityInfo`	exprArity rhs
+                    `setStrictnessInfo`	strictnessInfo old_info
+                    `setDemandInfo`	demandInfo old_info
+                    `setInlinePragInfo`	inlinePragInfo old_info
+                    `setUnfoldingInfo`	new_unf
+
+        new_unf | isStableUnfolding old_unf = tidyUnfolding rec_tidy_env old_unf old_unf
+                | otherwise	            = noUnfolding
+        old_unf = unfoldingInfo old_info
     in
-    ((tidy_env', var_env'), id')
-   }
+    ((tidy_env', var_env'), id') }
 
 ------------ Unfolding  --------------
 tidyUnfolding :: TidyEnv -> Unfolding -> Unfolding -> Unfolding
@@ -234,9 +243,26 @@ two reasons:
       the benefit of that occurrence analysis when we use the rule or
       or inline the function.  In particular, it's vital not to lose
       loop-breaker info, else we get an infinite inlining loop
-      
+
 Note that tidyLetBndr puts more IdInfo back.
 
+Note [Preserve evaluatedness]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Consider
+  data T = MkT !Bool
+  ....(case v of MkT y ->
+       let z# = case y of
+                  True -> 1#
+                  False -> 2#
+       in ...)
+
+The z# binding is ok because the RHS is ok-for-speculation,
+but Lint will complain unless it can *see* that.  So we
+preserve the evaluated-ness on 'y' in tidyBndr.
+
+(Another alternative would be to tidy unboxed lets into cases,
+but that seems more indirect and surprising.)
+
 
 \begin{code}
 (=:) :: a -> (a -> b) -> b
diff --git a/compiler/coreSyn/CoreUnfold.lhs b/compiler/coreSyn/CoreUnfold.lhs
index a219de8a8cc2..2d32d392f0d6 100644
--- a/compiler/coreSyn/CoreUnfold.lhs
+++ b/compiler/coreSyn/CoreUnfold.lhs
@@ -15,7 +15,8 @@ literal'').  In the corner of a @CoreUnfolding@ unfolding, you will
 find, unsurprisingly, a Core expression.
 
 \begin{code}
-{-# OPTIONS -fno-warn-tabs #-}
+{-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
 -- The above warning supression flag is a temporary kludge.
 -- While working on this module you are encouraged to remove it and
 -- detab the module (please do the detabbing in a separate patch). See
@@ -98,8 +99,11 @@ mkSimpleUnfolding :: DynFlags -> CoreExpr -> Unfolding
 mkSimpleUnfolding dflags = mkUnfolding dflags InlineRhs False False
 
 mkDFunUnfolding :: [Var] -> DataCon -> [CoreExpr] -> Unfolding
-mkDFunUnfolding bndrs con ops 
-  = DFunUnfolding { df_bndrs = bndrs, df_con = con, df_args = ops }
+mkDFunUnfolding bndrs con ops
+  = DFunUnfolding { df_bndrs = bndrs
+                  , df_con = con
+                  , df_args = map occurAnalyseExpr ops }
+                  -- See Note [Occurrrence analysis of unfoldings]
 
 mkWwInlineRule :: CoreExpr -> Arity -> Unfolding
 mkWwInlineRule expr arity
@@ -143,6 +147,7 @@ mkCoreUnfolding :: UnfoldingSource -> Bool -> CoreExpr
 -- Occurrence-analyses the expression before capturing it
 mkCoreUnfolding src top_lvl expr arity guidance 
   = CoreUnfolding { uf_tmpl   	    = occurAnalyseExpr expr,
+                      -- See Note [Occurrrence analysis of unfoldings]
     		    uf_src          = src,
     		    uf_arity        = arity,
 		    uf_is_top 	    = top_lvl,
@@ -162,6 +167,7 @@ mkUnfolding dflags src top_lvl is_bottoming expr
   = NoUnfolding    -- See Note [Do not inline top-level bottoming functions]
   | otherwise
   = CoreUnfolding { uf_tmpl   	    = occurAnalyseExpr expr,
+                      -- See Note [Occurrrence analysis of unfoldings]
     		    uf_src          = src,
     		    uf_arity        = arity,
 		    uf_is_top 	    = top_lvl,
@@ -176,6 +182,24 @@ mkUnfolding dflags src top_lvl is_bottoming expr
 	-- See Note [Calculate unfolding guidance on the non-occ-anal'd expression]
 \end{code}
 
+Note [Occurrence analysis of unfoldings]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+We do occurrence-analysis of unfoldings once and for all, when the
+unfolding is built, rather than each time we inline them.
+
+But given this decision it's vital that we do
+*always* do it.  Consider this unfolding
+    \x -> letrec { f = ...g...; g* = f } in body
+where g* is (for some strange reason) the loop breaker.  If we don't
+occ-anal it when reading it in, we won't mark g as a loop breaker, and
+we may inline g entirely in body, dropping its binding, and leaving
+the occurrence in f out of scope. This happened in Trac #8892, where
+the unfolding in question was a DFun unfolding.
+
+But more generally, the simplifier is designed on the
+basis that it is looking at occurrence-analysed expressions, so better
+ensure that they acutally are.
+
 Note [Calculate unfolding guidance on the non-occ-anal'd expression]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 Notice that we give the non-occur-analysed expression to
@@ -234,7 +258,8 @@ calcUnfoldingGuidance
         -> CoreExpr    -- Expression to look at
         -> (Arity, UnfoldingGuidance)
 calcUnfoldingGuidance dflags expr
-  = case collectBinders expr of { (bndrs, body) ->
+  = case stripTicksTop (not . tickishIsCode) expr of { (_, expr') ->
+    case collectBinders expr' of { (bndrs, body) ->
     let
         bOMB_OUT_SIZE = ufCreationThreshold dflags
                -- Bomb out if size gets bigger than this
@@ -264,7 +289,7 @@ calcUnfoldingGuidance dflags expr
                        | otherwise             = (+)
              -- See Note [Function and non-function discounts]
     in
-    (n_val_bndrs, guidance) }
+    (n_val_bndrs, guidance) } }
 \end{code}
 
 Note [Computing the size of an expression]
diff --git a/compiler/coreSyn/CoreUtils.lhs b/compiler/coreSyn/CoreUtils.lhs
index ea2e17fb048a..7082bb80cadc 100644
--- a/compiler/coreSyn/CoreUtils.lhs
+++ b/compiler/coreSyn/CoreUtils.lhs
@@ -6,11 +6,13 @@
 Utility functions on @Core@ syntax
 
 \begin{code}
+{-# LANGUAGE CPP #-}
+
 -- | Commonly useful utilites for manipulating the Core language
 module CoreUtils (
         -- * Constructing expressions
         mkCast,
-        mkTick, mkTickNoHNF, tickHNFArgs,
+        mkTick, mkTicks, mkTickNoHNF, tickHNFArgs,
         bindNonRec, needsCaseBinding,
         mkAltExpr,
 
@@ -31,14 +33,17 @@ module CoreUtils (
         CoreStats(..), coreBindsStats,
 
         -- * Equality
-        cheapEqExpr, eqExpr,
+        cheapEqExpr, cheapEqExpr', eqExpr,
 
         -- * Eta reduction
         tryEtaReduce,
 
         -- * Manipulating data constructors and types
         applyTypeToArgs, applyTypeToArg,
-        dataConRepInstPat, dataConRepFSInstPat
+        dataConRepInstPat, dataConRepFSInstPat,
+
+        -- * Working with ticks
+        stripTicksTop, stripTicks, annotateCoreNotes,
     ) where
 
 #include "HsVersions.h"
@@ -69,6 +74,9 @@ import Platform
 import Util
 import Pair
 import Data.List
+import Control.Applicative
+import Data.Traversable    ( traverse )
+import OrdList
 \end{code}
 
 
@@ -215,7 +223,7 @@ mkCast expr co
 --    if to_ty `eqType` from_ty
 --    then expr
 --    else
-        WARN(not (from_ty `eqType` exprType expr), text "Trying to coerce" <+> text "(" <> ppr expr $$ text "::" <+> ppr (exprType expr) <> text ")" $$ ppr co $$ pprEqPred (coercionKind co))
+        WARN(not (from_ty `eqType` exprType expr), text "Trying to coerce" <+> text "(" <> ppr expr $$ text "::" <+> ppr (exprType expr) <> text ")" $$ ppr co $$ ppr (coercionType co))
          (Cast expr co)
 \end{code}
 
@@ -223,48 +231,73 @@ mkCast expr co
 -- | Wraps the given expression in the source annotation, dropping the
 -- annotation if possible.
 mkTick :: Tickish Id -> CoreExpr -> CoreExpr
-
-mkTick t (Var x)
-  | isFunTy (idType x) = Tick t (Var x)
-  | otherwise
-  = if tickishCounts t
-       then if tickishScoped t && tickishCanSplit t
-               then Tick (mkNoScope t) (Var x)
-               else Tick t (Var x)
-       else Var x
-
-mkTick t (Cast e co)
-  = Cast (mkTick t e) co -- Move tick inside cast
-
-mkTick _ (Coercion co) = Coercion co
-
-mkTick t (Lit l)
-  | not (tickishCounts t) = Lit l
-
-mkTick t expr@(App f arg)
-  | not (isRuntimeArg arg) = App (mkTick t f) arg
-  | isSaturatedConApp expr
-    = if not (tickishCounts t)
-         then tickHNFArgs t expr
-         else if tickishScoped t && tickishCanSplit t
-                 then Tick (mkNoScope t) (tickHNFArgs (mkNoCount t) expr)
-                 else Tick t expr
-
-mkTick t (Lam x e)
-     -- if this is a type lambda, or the tick does not count entries,
-     -- then we can push the tick inside:
-  | not (isRuntimeVar x) || not (tickishCounts t) = Lam x (mkTick t e)
-     -- if it is both counting and scoped, we split the tick into its
-     -- two components, keep the counting tick on the outside of the lambda
-     -- and push the scoped tick inside.  The point of this is that the
-     -- counting tick can probably be floated, and the lambda may then be
-     -- in a position to be beta-reduced.
-  | tickishScoped t && tickishCanSplit t
-         = Tick (mkNoScope t) (Lam x (mkTick (mkNoCount t) e))
-     -- just a counting tick: leave it on the outside
-  | otherwise        = Tick t (Lam x e)
-
-mkTick t other = Tick t other
+mkTick t orig_expr = mkTick' id id orig_expr
+ where
+  -- Some ticks (cost-centres) can be split in two, with the
+  -- non-counting part having laxer placement properties.
+  canSplit = tickishCanSplit t && tickishPlace (mkNoCount t) /= tickishPlace t
+
+  mkTick' top rest expr = case expr of
+
+    -- Walk through ticks, making sure to not introduce tick duplication
+    -- along the way. The "rest" parameter accumulates ticks we need to
+    -- put on the result expression *if* we end up
+    -- actually modifying the expression.
+    Tick t2 e | tickishContains t t2   -> mkTick' top rest e
+              | tickishContains t2 t   -> orig_expr
+              | otherwise              -> mkTick' top (rest . Tick t2) e
+
+    -- Ticks don't care about types, so we just float all ticks
+    -- through them. Note that it's not enough to check for these
+    -- cases top-level. While mkTick will never produce Core with type
+    -- expressions below ticks, such constructs can be the result of
+    -- unfoldings. We therefore make an effort to put everything into
+    -- the right place no matter what we start with.
+    Cast e co   -> mkTick' (top . flip Cast co) rest e
+    Coercion co -> Coercion co
+
+    Lam x e
+      -- Always float through type lambdas. Even for non-type lambdas,
+      -- floating is allowed for all but the most strict placement rule.
+      | not (isRuntimeVar x) || tickishPlace t /= PlaceRuntime
+      -> mkTick' (top . Lam x) rest e
+
+      -- If it is both counting and scoped, we split the tick into its
+      -- two components, often allowing us to keep the counting tick on
+      -- the outside of the lambda and push the scoped tick inside.
+      -- The point of this is that the counting tick can probably be
+      -- floated, and the lambda may then be in a position to be
+      -- beta-reduced.
+      | canSplit
+      -> top $ Tick (mkNoScope t) $ rest $ Lam x $ mkTick (mkNoCount t) e
+
+    App f arg
+      -- Always float through type applications.
+      | not (isRuntimeArg arg)
+      -> mkTick' (top . flip App arg) rest f
+
+      -- We can also float through constructor applications, placement
+      -- permitting. Again we can split.
+      | isSaturatedConApp expr && tickishPlace t == PlaceCostCentre
+      -> top $ rest $ tickHNFArgs t expr
+      | canSplit
+      -> top $ Tick (mkNoScope t) $ rest $ tickHNFArgs (mkNoCount t) expr
+
+    Var x
+      | not (isFunTy (idType x)) && tickishPlace t == PlaceCostCentre
+      -> orig_expr
+      | canSplit
+      -> top $ Tick (mkNoScope t) $ rest expr
+
+    Lit{}
+      | tickishPlace t == PlaceCostCentre
+      -> orig_expr
+
+    -- Catch-all: Annotate where we stand
+    _any -> top $ Tick t $ rest expr
+
+mkTicks :: [Tickish Id] -> CoreExpr -> CoreExpr
+mkTicks ticks expr = foldr mkTick expr ticks
 
 isSaturatedConApp :: CoreExpr -> Bool
 isSaturatedConApp e = go e []
@@ -286,6 +319,55 @@ tickHNFArgs t e = push t e
   push t (App f (Type u)) = App (push t f) (Type u)
   push t (App f arg) = App (push t f) (mkTick t arg)
   push _t e = e
+
+-- | Strip ticks satisfying a predicate from top of an expression
+stripTicksTop :: (Tickish Id -> Bool) -> Expr b -> ([Tickish Id], Expr b)
+stripTicksTop p = go []
+  where go ts (Tick t e) | p t = go (t:ts) e
+        go ts other            = (reverse ts, other)
+
+-- | Completely strip ticks satisfying a predicate from an expression
+stripTicks :: (Tickish Id -> Bool) -> Expr b -> ([Tickish Id], Expr b)
+stripTicks p expr = (fromOL ticks, expr')
+  where (ticks, expr') = go expr
+        -- Note that  OrdList (Tickish Id) is a Monoid, which makes
+        -- ((,) (OrdList (Tickish Id))) an Applicative.
+        go (App e a)        = App <$> go e <*> go a
+        go (Lam b e)        = Lam b <$> go e
+        go (Let b e)        = Let <$> go_bs b <*> go e
+        go (Case e b t as)  = Case <$> go e <*> pure b <*> pure t <*> traverse go_a as
+        go (Cast e c)       = Cast <$> go e <*> pure c
+        go (Tick t e)
+          | p t             = let (ts, e') = go e in (t `consOL` ts, e')
+          | otherwise       = Tick t <$> go e
+        go other            = pure other
+        go_bs (NonRec b e)  = NonRec b <$> go e
+        go_bs (Rec bs)      = Rec <$> traverse go_b bs
+        go_b (b, e)         = (,) <$> pure b <*> go e
+        go_a (c,bs,e)       = (,,) <$> pure c <*> pure bs <*> go e
+
+-- | Add Core ticks to a Core expression.
+annotateCoreNotes :: CoreBind -> CoreBind
+annotateCoreNotes = go_bs
+  where go (App e a)        = App (go e) (go a)
+        go (Lam b e)        = Lam b (go e)
+        go (Let b e)        = Let (go_bs b) (go e)
+        go (Case e b t as)  = Case (go e) b t (map (go_a b) as)
+        go (Cast e c)       = Cast (go e) c
+        go (Tick t e)       = Tick t (go e)
+        go other            = other
+        go_bs (NonRec b e)  = NonRec b $ tick_bind b e $ go e
+        go_bs (Rec bs)      = Rec $ map go_b bs
+        go_b (b, e)         = (b, tick_bind b e $ go e)
+        go_a b alt@(c,bs,e) = (c, bs, Tick (CoreNote b (AltPtr alt)) $ go e)
+        -- When ticking let bindings, we want to move the Core note
+        -- inside lambdas in order to fulfill CorePrep invariants
+        tick_bind b e (Lam b' e') = Lam b' (tick_bind b e e')
+        tick_bind b e (Tick t e') | tickishFloatable t
+                                  = Tick t (tick_bind b e e')
+        tick_bind b e (Cast e' c) = Cast (tick_bind b e e') c
+        tick_bind b e e'          = Tick (CoreNote b (ExprPtr e)) e'
+
 \end{code}
 
 %************************************************************************
@@ -547,18 +629,20 @@ saturating them.
 
 Note [Tick trivial]
 ~~~~~~~~~~~~~~~~~~~
-Ticks are not trivial.  If we treat "tick<n> x" as trivial, it will be
-inlined inside lambdas and the entry count will be skewed, for
-example.  Furthermore "scc<n> x" will turn into just "x" in mkTick.
+
+Ticks are only trivial if they are pure annotations. If we treat
+"tick<n> x" as trivial, it will be inlined inside lambdas and the
+entry count will be skewed, for example.  Furthermore "scc<n> x" will
+turn into just "x" in mkTick.
 
 \begin{code}
 exprIsTrivial :: CoreExpr -> Bool
 exprIsTrivial (Var _)          = True        -- See Note [Variables are trivial]
-exprIsTrivial (Type _)        = True
+exprIsTrivial (Type _)         = True
 exprIsTrivial (Coercion _)     = True
 exprIsTrivial (Lit lit)        = litIsTrivial lit
 exprIsTrivial (App e arg)      = not (isRuntimeArg arg) && exprIsTrivial e
-exprIsTrivial (Tick _ _)       = False  -- See Note [Tick trivial]
+exprIsTrivial (Tick t e)       = not (tickishIsCode t) && exprIsTrivial e -- See Note [Tick trivial]
 exprIsTrivial (Cast e _)       = exprIsTrivial e
 exprIsTrivial (Lam b body)     = not (isRuntimeVar b) && exprIsTrivial body
 exprIsTrivial _                = False
@@ -775,8 +859,8 @@ exprIsCheap' good_app (Case e _ _ alts) = exprIsCheap' good_app e &&
 exprIsCheap' good_app (Tick t e)
   | tickishCounts t = False
   | otherwise       = exprIsCheap' good_app e
-     -- never duplicate ticks.  If we get this wrong, then HPC's entry
-     -- counts will be off (check test in libraries/hpc/tests/raytrace)
+     -- never duplicate counting ticks.  If we get this wrong, then
+     -- HPC's entry counts will be off (check test in libraries/hpc/tests/raytrace)
 
 exprIsCheap' good_app (Let (NonRec _ b) e)
   = exprIsCheap' good_app b && exprIsCheap' good_app e
@@ -815,6 +899,10 @@ exprIsCheap' good_app other_expr        -- Applications and variables
                         -- always gives bottom; we treat this as cheap
                         -- because it certainly doesn't need to be shared!
 
+    go (Tick t e) args
+      | not (tickishCounts t) -- don't duplicate counting ticks, see above
+      = go e args
+
     go _ _ = False
 
     --------------
@@ -906,13 +994,22 @@ it's applied only to dictionaries.
 -- Note [exprOkForSpeculation: case expressions] below
 --
 -- Precisely, it returns @True@ iff:
+--  a) The expression guarantees to terminate,
+--  b) soon,
+--  c) without causing a write side effect (e.g. writing a mutable variable)
+--  d) without throwing a Haskell exception
+--  e) without risking an unchecked runtime exception (array out of bounds,
+--     divide by zero)
+--
+-- For @exprOkForSideEffects@ the list is the same, but omitting (e).
 --
---  * The expression guarantees to terminate,
---  * soon,
---  * without raising an exception,
---  * without causing a side effect (e.g. writing a mutable variable)
+-- Note that
+--    exprIsHNF            implies exprOkForSpeculation
+--    exprOkForSpeculation implies exprOkForSideEffects
+--
+-- See Note [PrimOp can_fail and has_side_effects] in PrimOp
+-- and Note [Implementation: how can_fail/has_side_effects affect transformations]
 --
--- Note that if @exprIsHNF e@, then @exprOkForSpecuation e@.
 -- As an example of the considerations in this test, consider:
 --
 -- > let x = case y# +# 1# of { r# -> I# r# }
@@ -954,15 +1051,16 @@ expr_ok primop_ok (Case e _ _ alts)
 
 expr_ok primop_ok other_expr
   = case collectArgs other_expr of
-        (Var f, args) -> app_ok primop_ok f args
-        _             -> False
+        (expr, args) | (_, Var f) <- stripTicksTop (not . tickishCounts) expr
+                     -> app_ok primop_ok f args
+        _            -> False
 
 -----------------------------
 app_ok :: (PrimOp -> Bool) -> Id -> [Expr b] -> Bool
 app_ok primop_ok fun args
   = case idDetails fun of
       DFunId _ new_type ->  not new_type
-         -- DFuns terminate, unless the dict is implemented 
+         -- DFuns terminate, unless the dict is implemented
          -- with a newtype in which case they may not
 
       DataConWorkId {} -> True
@@ -981,14 +1079,12 @@ app_ok primop_ok fun args
         -> True
 
         | otherwise
-        -> primop_ok op        -- A bit conservative: we don't really need
-        && all (expr_ok primop_ok) args
-                                  
-                                  -- to care about lazy arguments, but this is easy
+        -> primop_ok op                   -- A bit conservative: we don't really need
+        && all (expr_ok primop_ok) args   -- to care about lazy arguments, but this is easy
 
       _other -> isUnLiftedType (idType fun)          -- c.f. the Var case of exprIsHNF
              || idArity fun > n_val_args             -- Partial apps
-             || (n_val_args == 0 && 
+             || (n_val_args == 0 &&
                  isEvaldUnfolding (idUnfolding fun)) -- Let-bound values
              where
                n_val_args = valArgCount args
@@ -1222,7 +1318,7 @@ dataConInstPat :: [FastString]          -- A long enough list of FSs to use for
                -> [Unique]              -- An equally long list of uniques, at least one for each binder
                -> DataCon
                -> [Type]                -- Types to instantiate the universally quantified tyvars
-               -> ([TyVar], [Id])          -- Return instantiated variables
+               -> ([TyVar], [Id])       -- Return instantiated variables
 -- dataConInstPat arg_fun fss us con inst_tys returns a triple
 -- (ex_tvs, arg_ids),
 --
@@ -1250,14 +1346,14 @@ dataConInstPat :: [FastString]          -- A long enough list of FSs to use for
 --
 --  where the double-primed variables are created with the FastStrings and
 --  Uniques given as fss and us
-dataConInstPat fss uniqs con inst_tys 
+dataConInstPat fss uniqs con inst_tys
   = ASSERT( univ_tvs `equalLength` inst_tys )
     (ex_bndrs, arg_ids)
-  where 
+  where
     univ_tvs = dataConUnivTyVars con
     ex_tvs   = dataConExTyVars con
     arg_tys  = dataConRepArgTys con
-
+    arg_strs = dataConRepStrictness con  -- 1-1 with arg_tys
     n_ex = length ex_tvs
 
       -- split the Uniques and FastStrings
@@ -1268,7 +1364,7 @@ dataConInstPat fss uniqs con inst_tys
     univ_subst = zipOpenTvSubst univ_tvs inst_tys
 
       -- Make existential type variables, applyingn and extending the substitution
-    (full_subst, ex_bndrs) = mapAccumL mk_ex_var univ_subst 
+    (full_subst, ex_bndrs) = mapAccumL mk_ex_var univ_subst
                                        (zip3 ex_tvs ex_fss ex_uniqs)
 
     mk_ex_var :: TvSubst -> (TyVar, FastString, Unique) -> (TvSubst, TyVar)
@@ -1280,11 +1376,30 @@ dataConInstPat fss uniqs con inst_tys
         kind     = Type.substTy subst (tyVarKind tv)
 
       -- Make value vars, instantiating types
-    arg_ids = zipWith3 mk_id_var id_uniqs id_fss arg_tys
-    mk_id_var uniq fs ty = mkUserLocal (mkVarOccFS fs) uniq 
-                                       (Type.substTy full_subst ty) noSrcSpan
+    arg_ids = zipWith4 mk_id_var id_uniqs id_fss arg_tys arg_strs
+    mk_id_var uniq fs ty str
+      = mkLocalIdWithInfo name (Type.substTy full_subst ty) info
+      where
+        name = mkInternalName uniq (mkVarOccFS fs) noSrcSpan
+        info | isMarkedStrict str = vanillaIdInfo `setUnfoldingInfo` evaldUnfolding
+             | otherwise          = vanillaIdInfo
+             -- See Note [Mark evaluated arguments]
 \end{code}
 
+Note [Mark evaluated arguments]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+When pattern matching on a constructor with strict fields, the binder
+can have an 'evaldUnfolding'.  Moreover, it *should* have one, so that
+when loading an interface file unfolding like:
+  data T = MkT !Int
+  f x = case x of { MkT y -> let v::Int# = case y of I# n -> n+1
+                             in ... }
+we don't want Lint to complain.  The 'y' is evaluated, so the
+case in the RHS of the binding for 'v' is fine.  But only if we
+*know* that 'y' is evaluated.
+
+c.f. add_evals in Simplify.simplAlt
+
 %************************************************************************
 %*                                                                      *
          Equality
@@ -1298,19 +1413,27 @@ dataConInstPat fss uniqs con inst_tys
 --
 -- See also 'exprIsBig'
 cheapEqExpr :: Expr b -> Expr b -> Bool
+cheapEqExpr = cheapEqExpr' (const False)
+
+-- | Same cheap equality test as @cheapEqExpr@, but also cheaply looks
+-- through given ticks while doing so.
+cheapEqExpr' :: (Tickish Id -> Bool) -> Expr b -> Expr b -> Bool
+cheapEqExpr' ignoreTick = go
+  where go (Var v1)   (Var v2)   = v1==v2
+        go (Lit lit1) (Lit lit2) = lit1 == lit2
+        go (Type t1) (Type t2) = t1 `eqType` t2
+        go (Coercion c1) (Coercion c2) = c1 `coreEqCoercion` c2
 
-cheapEqExpr (Var v1)   (Var v2)   = v1==v2
-cheapEqExpr (Lit lit1) (Lit lit2) = lit1 == lit2
-cheapEqExpr (Type t1) (Type t2) = t1 `eqType` t2
-cheapEqExpr (Coercion c1) (Coercion c2) = c1 `coreEqCoercion` c2
+        go (App f1 a1) (App f2 a2)
+          = f1 `cheapEqExpr` f2 && a1 `cheapEqExpr` a2
 
-cheapEqExpr (App f1 a1) (App f2 a2)
-  = f1 `cheapEqExpr` f2 && a1 `cheapEqExpr` a2
+        go (Cast e1 t1) (Cast e2 t2)
+          = e1 `cheapEqExpr` e2 && t1 `coreEqCoercion` t2
 
-cheapEqExpr (Cast e1 t1) (Cast e2 t2)
-  = e1 `cheapEqExpr` e2 && t1 `coreEqCoercion` t2
+        go (Tick t e1) e2 | ignoreTick t = go e1 e2
+        go e1 (Tick t e2) | ignoreTick t = go e1 e2
 
-cheapEqExpr _ _ = False
+        go _ _ = False
 \end{code}
 
 \begin{code}
@@ -1605,9 +1728,16 @@ tryEtaReduce bndrs body
       = Just (mkCast fun co)   -- Check for any of the binders free in the result
                                -- including the accumulated coercion
 
+    go bs (Tick t e) co
+      | tickishFloatable t
+      = fmap (Tick t) $ go bs e co
+      -- Float app ticks: \x -> Tick t (e x) ==> Tick t e
+
     go (b : bs) (App fun arg) co
-      | Just co' <- ok_arg b arg co
-      = go bs fun co'
+      | let (ticks, arg') = stripTicksTop tickishFloatable arg
+      , Just co' <- ok_arg b arg' co
+      = fmap (flip (foldr mkTick) ticks) $ go bs fun co'
+      -- Float arg ticks: \x -> e (Tick t x) ==> Tick t e
 
     go _ _ _  = Nothing         -- Failure!
 
@@ -1652,6 +1782,7 @@ tryEtaReduce bndrs body
        | bndr == v  = Just (mkFunCo Representational (mkSymCo co_arg) co)
        -- The simplifier combines multiple casts into one,
        -- so we can have a simple-minded pattern match here
+
     ok_arg _ _ _ = Nothing
 \end{code}
 
diff --git a/compiler/coreSyn/ExternalCore.lhs b/compiler/coreSyn/ExternalCore.lhs
deleted file mode 100644
index ecc24b115583..000000000000
--- a/compiler/coreSyn/ExternalCore.lhs
+++ /dev/null
@@ -1,118 +0,0 @@
-%
-% (c) The University of Glasgow 2001-2006
-%
-\begin{code}
-module ExternalCore where
-
-import Data.Word
-
-data Module
- = Module Mname [Tdef] [Vdefg]
-
-data Tdef
-  = Data (Qual Tcon) [Tbind] [Cdef]
-  | Newtype (Qual Tcon) (Qual Tcon) [Tbind] Ty
-
-data Cdef
-  = Constr (Qual Dcon) [Tbind] [Ty]
-  | GadtConstr (Qual Dcon) Ty
-
-data Vdefg
-  = Rec [Vdef]
-  | Nonrec Vdef
-
--- Top-level bindings are qualified, so that the printer doesn't have to pass
--- around the module name.
-type Vdef = (Bool,Qual Var,Ty,Exp)
-
-data Exp
-  = Var (Qual Var)
-  | Dcon (Qual Dcon)
-  | Lit Lit
-  | App Exp Exp
-  | Appt Exp Ty
-  | Lam Bind Exp
-  | Let Vdefg Exp
-  | Case Exp Vbind Ty [Alt] {- non-empty list -}
-  | Cast Exp Coercion
-  | Tick String Exp {- XXX probably wrong -}
-  | External String String Ty {- target name, convention, and type -}
-  | DynExternal String Ty {- convention and type (incl. Addr# of target as first arg) -}
-  | Label String
-
-data Bind
-  = Vb Vbind
-  | Tb Tbind
-
-data Alt
-  = Acon (Qual Dcon) [Tbind] [Vbind] Exp
-  | Alit Lit Exp
-  | Adefault Exp
-
-type Vbind = (Var,Ty)
-type Tbind = (Tvar,Kind)
-
-data Ty
-  = Tvar Tvar
-  | Tcon (Qual Tcon)
-  | Tapp Ty Ty
-  | Tforall Tbind Ty
-
-data Coercion
--- We distinguish primitive coercions because External Core treats
--- them specially, so we have to print them out with special syntax.
-  = ReflCoercion Role Ty
-  | SymCoercion Coercion
-  | TransCoercion Coercion Coercion
-  | TyConAppCoercion Role (Qual Tcon) [Coercion]
-  | AppCoercion Coercion Coercion
-  | ForAllCoercion Tbind Coercion
-  | CoVarCoercion Var
-  | UnivCoercion Role Ty Ty
-  | InstCoercion Coercion Ty
-  | NthCoercion Int Coercion
-  | AxiomCoercion (Qual Tcon) Int [Coercion]
-  | LRCoercion LeftOrRight Coercion
-  | SubCoercion Coercion
-
-data Role = Nominal | Representational | Phantom
-
-data LeftOrRight = CLeft | CRight
-
-data Kind
-  = Klifted
-  | Kunlifted
-  | Kunboxed
-  | Kopen
-  | Karrow Kind Kind
-
-data Lit
-  = Lint Integer Ty
-  | Lrational Rational Ty
-  | Lchar Char Ty
-  | Lstring [Word8] Ty
-
-
-type Mname = Id
-type Var = Id
-type Tvar = Id
-type Tcon = Id
-type Dcon = Id
-
-type Qual t = (Mname,t)
-
-type Id = String
-
-primMname :: Mname
--- For truly horrible reasons, this must be z-encoded.
--- With any hope, the z-encoding will die soon.
-primMname = "ghczmprim:GHCziPrim"
-
-tcArrow :: Qual Tcon
-tcArrow = (primMname, "(->)")
-
-\end{code}
-
-
-
-
diff --git a/compiler/coreSyn/MkCore.lhs b/compiler/coreSyn/MkCore.lhs
index f71b4b4ff651..3ba8b1d6eee6 100644
--- a/compiler/coreSyn/MkCore.lhs
+++ b/compiler/coreSyn/MkCore.lhs
@@ -1,5 +1,6 @@
 \begin{code}
-{-# OPTIONS -fno-warn-tabs #-}
+{-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
 -- The above warning supression flag is a temporary kludge.
 -- While working on this module you are encouraged to remove it and
 -- detab the module (please do the detabbing in a separate patch). See
@@ -303,9 +304,9 @@ mkStringExprFS str
 mkEqBox :: Coercion -> CoreExpr
 mkEqBox co = ASSERT2( typeKind ty2 `eqKind` k, ppr co $$ ppr ty1 $$ ppr ty2 $$ ppr (typeKind ty1) $$ ppr (typeKind ty2) )
              Var (dataConWorkId datacon) `mkTyApps` [k, ty1, ty2] `App` Coercion co
-  where Pair ty1 ty2 = coercionKind co
+  where (Pair ty1 ty2, role) = coercionKindRole co
         k = typeKind ty1
-        datacon = case coercionRole co of 
+        datacon = case role of
             Nominal ->          eqBoxDataCon
             Representational -> coercibleDataCon
             Phantom ->          pprPanic "mkEqBox does not support boxing phantom coercions"
@@ -414,12 +415,17 @@ mkBigCoreTupTy = mkChunkified mkBoxedTupleTy
 %************************************************************************
 
 \begin{code}
-data FloatBind 
+data FloatBind
   = FloatLet  CoreBind
-  | FloatCase CoreExpr Id AltCon [Var]       
+  | FloatCase CoreExpr Id AltCon [Var]
       -- case e of y { C ys -> ... }
       -- See Note [Floating cases] in SetLevels
 
+instance Outputable FloatBind where
+  ppr (FloatLet b) = ptext (sLit "LET") <+> ppr b
+  ppr (FloatCase e b c bs) = hang (ptext (sLit "CASE") <+> ppr e <+> ptext (sLit "of") <+> ppr b)
+                                2 (ppr c <+> ppr bs)
+
 wrapFloat :: FloatBind -> CoreExpr -> CoreExpr
 wrapFloat (FloatLet defns)       body = Let defns body
 wrapFloat (FloatCase e b con bs) body = Case e b (exprType body) [(con, bs, body)]
diff --git a/compiler/coreSyn/MkExternalCore.lhs b/compiler/coreSyn/MkExternalCore.lhs
deleted file mode 100644
index 6a6f0551ed51..000000000000
--- a/compiler/coreSyn/MkExternalCore.lhs
+++ /dev/null
@@ -1,360 +0,0 @@
-
-% (c) The University of Glasgow 2001-2006
-%
-\begin{code}
-module MkExternalCore (
-        emitExternalCore
-) where
-
-#include "HsVersions.h"
-
-import qualified ExternalCore as C
-import Module
-import CoreSyn
-import HscTypes
-import TyCon
-import CoAxiom
--- import Class
-import TypeRep
-import Type
-import Kind
-import PprExternalCore () -- Instances
-import DataCon
-import Coercion
-import Var
-import IdInfo
-import Literal
-import Name
-import Outputable
-import Encoding
-import ForeignCall
-import DynFlags
-import FastString
-import Exception
-
-import Control.Applicative (Applicative(..))
-import Control.Monad
-import qualified Data.ByteString as BS
-import Data.Char
-import System.IO
-
-emitExternalCore :: DynFlags -> FilePath -> CgGuts -> IO ()
-emitExternalCore dflags extCore_filename cg_guts
- | gopt Opt_EmitExternalCore dflags
- = (do handle <- openFile extCore_filename WriteMode
-       hPutStrLn handle (show (mkExternalCore dflags cg_guts))
-       hClose handle)
-   `catchIO` (\_ -> pprPanic "Failed to open or write external core output file"
-                             (text extCore_filename))
-emitExternalCore _ _ _
- | otherwise
- = return ()
-
--- Reinventing the Reader monad; whee.
-newtype CoreM a = CoreM (CoreState -> (CoreState, a))
-data CoreState = CoreState {
-                     cs_dflags :: DynFlags,
-                     cs_module :: Module
-                 }
-
-instance Functor CoreM where
-    fmap = liftM
-
-instance Applicative CoreM where
-    pure = return
-    (<*>) = ap
-
-instance Monad CoreM where
-  (CoreM m) >>= f = CoreM (\ s -> case m s of
-                                    (s',r) -> case f r of
-                                                CoreM f' -> f' s')
-  return x = CoreM (\ s -> (s, x))
-runCoreM :: CoreM a -> CoreState -> a
-runCoreM (CoreM f) s = snd $ f s
-ask :: CoreM CoreState
-ask = CoreM (\ s -> (s,s))
-
-instance HasDynFlags CoreM where
-    getDynFlags = liftM cs_dflags ask
-
-mkExternalCore :: DynFlags -> CgGuts -> C.Module
--- The ModGuts has been tidied, but the implicit bindings have
--- not been injected, so we have to add them manually here
--- We don't include the strange data-con *workers* because they are
--- implicit in the data type declaration itself
-mkExternalCore dflags (CgGuts {cg_module=this_mod, cg_tycons = tycons,
-                               cg_binds = binds})
-{- Note that modules can be mutually recursive, but even so, we
-   print out dependency information within each module. -}
-  = C.Module (mname dflags) tdefs (runCoreM (mapM (make_vdef True) binds) initialState)
-  where
-    initialState = CoreState {
-                       cs_dflags = dflags,
-                       cs_module = this_mod
-                   }
-    mname dflags = make_mid dflags this_mod
-    tdefs  = foldr (collect_tdefs dflags) [] tycons
-
-collect_tdefs :: DynFlags -> TyCon -> [C.Tdef] -> [C.Tdef]
-collect_tdefs dflags tcon tdefs
-  | isAlgTyCon tcon = tdef: tdefs
-  where
-    tdef | isNewTyCon tcon =
-                C.Newtype (qtc dflags tcon)
-                  (qcc dflags (newTyConCo tcon))
-                  (map make_tbind tyvars)
-                  (make_ty dflags (snd (newTyConRhs tcon)))
-         | otherwise =
-                C.Data (qtc dflags tcon) (map make_tbind tyvars)
-                   (map (make_cdef dflags) (tyConDataCons tcon))
-    tyvars = tyConTyVars tcon
-
-collect_tdefs _ _ tdefs = tdefs
-
-qtc :: DynFlags -> TyCon -> C.Qual C.Tcon
-qtc dflags = make_con_qid dflags . tyConName
-
-qcc :: DynFlags -> CoAxiom br -> C.Qual C.Tcon
-qcc dflags = make_con_qid dflags . co_ax_name
-
-make_cdef :: DynFlags -> DataCon -> C.Cdef
-make_cdef dflags dcon =  C.Constr dcon_name existentials tys
-  where
-    dcon_name    = make_qid dflags False False (dataConName dcon)
-    existentials = map make_tbind ex_tyvars
-    ex_tyvars    = dataConExTyVars dcon
-    tys          = map (make_ty dflags) (dataConRepArgTys dcon)
-
-make_tbind :: TyVar -> C.Tbind
-make_tbind tv = (make_var_id (tyVarName tv), make_kind (tyVarKind tv))
-
-make_vbind :: DynFlags -> Var -> C.Vbind
-make_vbind dflags v = (make_var_id  (Var.varName v), make_ty dflags (varType v))
-
-make_vdef :: Bool -> CoreBind -> CoreM C.Vdefg
-make_vdef topLevel b =
-  case b of
-    NonRec v e -> f (v,e)     >>= (return . C.Nonrec)
-    Rec ves    -> mapM f ves  >>= (return . C.Rec)
-  where
-  f :: (CoreBndr,CoreExpr) -> CoreM C.Vdef
-  f (v,e) = do
-          localN <- isALocal vName
-          let local = not topLevel || localN
-          rhs <- make_exp e
-          -- use local flag to determine where to add the module name
-          dflags <- getDynFlags
-          return (local, make_qid dflags local True vName, make_ty dflags (varType v),rhs)
-        where vName = Var.varName v
-
-make_exp :: CoreExpr -> CoreM C.Exp
-make_exp (Var v) = do
-  let vName = Var.varName v
-  isLocal <- isALocal vName
-  dflags <- getDynFlags
-  return $
-     case idDetails v of
-       FCallId (CCall (CCallSpec (StaticTarget nm _ True) callconv _))
-           -> C.External (unpackFS nm) (showPpr dflags callconv) (make_ty dflags (varType v))
-       FCallId (CCall (CCallSpec (StaticTarget _ _ False) _ _)) ->
-           panic "make_exp: FFI values not supported"
-       FCallId (CCall (CCallSpec DynamicTarget     callconv _))
-           -> C.DynExternal            (showPpr dflags callconv) (make_ty dflags (varType v))
-       -- Constructors are always exported, so make sure to declare them
-       -- with qualified names
-       DataConWorkId _ -> C.Var (make_var_qid dflags False vName)
-       DataConWrapId _ -> C.Var (make_var_qid dflags False vName)
-       _ -> C.Var (make_var_qid dflags isLocal vName)
-make_exp (Lit (MachLabel s _ _)) = return $ C.Label (unpackFS s)
-make_exp (Lit l) = do dflags <- getDynFlags
-                      return $ C.Lit (make_lit dflags l)
-make_exp (App e (Type t)) = do b <- make_exp e
-                               dflags <- getDynFlags
-                               return $ C.Appt b (make_ty dflags t)
-make_exp (App _e (Coercion _co)) = error "make_exp (App _ (Coercion _))"    -- TODO
-make_exp (App e1 e2) = do
-   rator <- make_exp e1
-   rand <- make_exp e2
-   return $ C.App rator rand
-make_exp (Lam v e) | isTyVar v = make_exp e >>= (\ b ->
-                                    return $ C.Lam (C.Tb (make_tbind v)) b)
-make_exp (Lam v e) | otherwise = do b <- make_exp e
-                                    dflags <- getDynFlags
-                                    return $ C.Lam (C.Vb (make_vbind dflags v)) b
-make_exp (Cast e co) = do b <- make_exp e
-                          dflags <- getDynFlags
-                          return $ C.Cast b (make_co dflags co)
-make_exp (Let b e) = do
-  vd   <- make_vdef False b
-  body <- make_exp e
-  return $ C.Let vd body
-make_exp (Case e v ty alts) = do
-  scrut <- make_exp e
-  newAlts  <- mapM make_alt alts
-  dflags <- getDynFlags
-  return $ C.Case scrut (make_vbind dflags v) (make_ty dflags ty) newAlts
-make_exp (Tick _ e) = make_exp e >>= (return . C.Tick "SCC") -- temporary
-make_exp _ = error "MkExternalCore died: make_exp"
-
-make_alt :: CoreAlt -> CoreM C.Alt
-make_alt (DataAlt dcon, vs, e) = do
-    newE <- make_exp e
-    dflags <- getDynFlags
-    return $ C.Acon (make_con_qid dflags (dataConName dcon))
-           (map make_tbind tbs)
-           (map (make_vbind dflags) vbs)
-           newE
-        where (tbs,vbs) = span isTyVar vs
-make_alt (LitAlt l,_,e)   = do x <- make_exp e
-                               dflags <- getDynFlags
-                               return $ C.Alit (make_lit dflags l) x
-make_alt (DEFAULT,[],e)   = make_exp e >>= (return . C.Adefault)
--- This should never happen, as the DEFAULT alternative binds no variables,
--- but we might as well check for it:
-make_alt a@(DEFAULT,_ ,_) = pprPanic ("MkExternalCore: make_alt: DEFAULT "
-             ++ "alternative had a non-empty var list") (ppr a)
-
-
-make_lit :: DynFlags -> Literal -> C.Lit
-make_lit dflags l =
-  case l of
-    -- Note that we need to check whether the character is "big".
-    -- External Core only allows character literals up to '\xff'.
-    MachChar i | i <= chr 0xff -> C.Lchar i t
-    -- For a character bigger than 0xff, we represent it in ext-core
-    -- as an int lit with a char type.
-    MachChar i             -> C.Lint (fromIntegral $ ord i) t
-    MachStr s -> C.Lstring (BS.unpack s) t
-    MachNullAddr -> C.Lint 0 t
-    MachInt i -> C.Lint i t
-    MachInt64 i -> C.Lint i t
-    MachWord i -> C.Lint i t
-    MachWord64 i -> C.Lint i t
-    MachFloat r -> C.Lrational r t
-    MachDouble r -> C.Lrational r t
-    LitInteger i _ -> C.Lint i t
-    _ -> pprPanic "MkExternalCore died: make_lit" (ppr l)
-  where
-    t = make_ty dflags (literalType l)
-
--- Expand type synonyms, then convert.
-make_ty :: DynFlags -> Type -> C.Ty     -- Be sure to expand types recursively!
-                                        -- example: FilePath ~> String ~> [Char]
-make_ty dflags t | Just expanded <- tcView t = make_ty dflags expanded
-make_ty dflags t = make_ty' dflags t
-
--- note calls to make_ty so as to expand types recursively
-make_ty' :: DynFlags -> Type -> C.Ty
-make_ty' _      (TyVarTy tv)     = C.Tvar (make_var_id (tyVarName tv))
-make_ty' dflags (AppTy t1 t2)     = C.Tapp (make_ty dflags t1) (make_ty dflags t2)
-make_ty' dflags (FunTy t1 t2)     = make_ty dflags (TyConApp funTyCon [t1,t2])
-make_ty' dflags (ForAllTy tv t)  = C.Tforall (make_tbind tv) (make_ty dflags t)
-make_ty' dflags (TyConApp tc ts) = make_tyConApp dflags tc ts
-make_ty' _      (LitTy {})       = panic "MkExernalCore can't do literal types yet"
-
--- Newtypes are treated just like any other type constructor; not expanded
--- Reason: predTypeRep does substitution and, while substitution deals
---         correctly with name capture, it's only correct if you see the uniques!
---         If you just see occurrence names, name capture may occur.
--- Example: newtype A a = A (forall b. b -> a)
---          test :: forall q b. q -> A b
---          test _ = undefined
---      Here the 'a' gets substituted by 'b', which is captured.
--- Another solution would be to expand newtypes before tidying; but that would
--- expose the representation in interface files, which definitely isn't right.
--- Maybe CoreTidy should know whether to expand newtypes or not?
-
-make_tyConApp :: DynFlags -> TyCon -> [Type] -> C.Ty
-make_tyConApp dflags tc ts =
-  foldl C.Tapp (C.Tcon (qtc dflags tc))
-            (map (make_ty dflags) ts)
-
-make_kind :: Kind -> C.Kind
-make_kind (FunTy k1 k2)  = C.Karrow (make_kind k1) (make_kind k2)
-make_kind k
-  | isLiftedTypeKind k   = C.Klifted
-  | isUnliftedTypeKind k = C.Kunlifted
-  | isOpenTypeKind k     = C.Kopen
-make_kind _ = error "MkExternalCore died: make_kind"
-
-{- Id generation. -}
-
-make_id :: Bool -> Name -> C.Id
--- include uniques for internal names in order to avoid name shadowing
-make_id _is_var nm = ((occNameString . nameOccName) nm)
-  ++ (if isInternalName nm then (show . nameUnique) nm else "")
-
-make_var_id :: Name -> C.Id
-make_var_id = make_id True
-
--- It's important to encode the module name here, because in External Core,
--- base:GHC.Base => base:GHCziBase
--- We don't do this in pprExternalCore because we
--- *do* want to keep the package name (we don't want baseZCGHCziBase,
--- because that would just be ugly.)
--- SIGH.
--- We encode the package name as well.
-make_mid :: DynFlags -> Module -> C.Id
--- Super ugly code, but I can't find anything else that does quite what I
--- want (encodes the hierarchical module name without encoding the colon
--- that separates the package name from it.)
-make_mid dflags m
-            = showSDoc dflags $
-              (text $ zEncodeString $ packageIdString $ modulePackageId m)
-              <> text ":"
-              <> (pprEncoded $ pprModuleName $ moduleName m)
-     where pprEncoded = pprCode CStyle
-
-make_qid :: DynFlags -> Bool -> Bool -> Name -> C.Qual C.Id
-make_qid dflags force_unqual is_var n = (mname,make_id is_var n)
-    where mname =
-           case nameModule_maybe n of
-            Just m | not force_unqual -> make_mid dflags m
-            _ -> ""
-
-make_var_qid :: DynFlags -> Bool -> Name -> C.Qual C.Id
-make_var_qid dflags force_unqual = make_qid dflags force_unqual True
-
-make_con_qid :: DynFlags -> Name -> C.Qual C.Id
-make_con_qid dflags = make_qid dflags False False
-
-make_co :: DynFlags -> Coercion -> C.Coercion
-make_co dflags (Refl r ty)           = C.ReflCoercion (make_role r) $ make_ty dflags ty
-make_co dflags (TyConAppCo r tc cos) = C.TyConAppCoercion (make_role r) (qtc dflags tc) (map (make_co dflags) cos)
-make_co dflags (AppCo c1 c2)         = C.AppCoercion (make_co dflags c1) (make_co dflags c2)
-make_co dflags (ForAllCo tv co)      = C.ForAllCoercion (make_tbind tv) (make_co dflags co)
-make_co _      (CoVarCo cv)          = C.CoVarCoercion (make_var_id (coVarName cv))
-make_co dflags (AxiomInstCo cc ind cos) = C.AxiomCoercion (qcc dflags cc) ind (map (make_co dflags) cos)
-make_co dflags (UnivCo r t1 t2)      = C.UnivCoercion (make_role r) (make_ty dflags t1) (make_ty dflags t2)
-make_co dflags (SymCo co)            = C.SymCoercion (make_co dflags co)
-make_co dflags (TransCo c1 c2)       = C.TransCoercion (make_co dflags c1) (make_co dflags c2)
-make_co dflags (NthCo d co)          = C.NthCoercion d (make_co dflags co)
-make_co dflags (LRCo lr co)          = C.LRCoercion (make_lr lr) (make_co dflags co)
-make_co dflags (InstCo co ty)        = C.InstCoercion (make_co dflags co) (make_ty dflags ty)
-make_co dflags (SubCo co)            = C.SubCoercion (make_co dflags co)
-make_co _ (AxiomRuleCo {})           = panic "make_co AxiomRuleCo: not yet implemented"
-
-
-make_lr :: LeftOrRight -> C.LeftOrRight
-make_lr CLeft  = C.CLeft
-make_lr CRight = C.CRight
-
-make_role :: Role -> C.Role
-make_role Nominal          = C.Nominal
-make_role Representational = C.Representational
-make_role Phantom          = C.Phantom
-
--------
-isALocal :: Name -> CoreM Bool
-isALocal vName = do
-  modName <- liftM cs_module ask
-  return $ case nameModule_maybe vName of
-             -- Not sure whether isInternalName corresponds to "local"ness
-             -- in the External Core sense; need to re-read the spec.
-             Just m | m == modName -> isInternalName vName
-             _                     -> False
-\end{code}
-
-
-
-
diff --git a/compiler/coreSyn/PprCore.lhs b/compiler/coreSyn/PprCore.lhs
index d7990085fe74..44ad90862360 100644
--- a/compiler/coreSyn/PprCore.lhs
+++ b/compiler/coreSyn/PprCore.lhs
@@ -29,6 +29,7 @@ import BasicTypes
 import Util
 import Outputable
 import FastString
+import SrcLoc      ( showUserRealSpan )
 \end{code}
 
 %************************************************************************
@@ -91,7 +92,14 @@ ppr_bind (Rec binds)           = vcat (map pp binds)
 ppr_binding :: OutputableBndr b => (b, Expr b) -> SDoc
 ppr_binding (val_bdr, expr)
   = pprBndr LetBind val_bdr $$
-    hang (ppr val_bdr <+> equals) 2 (pprCoreExpr expr)
+    hang (ppr val_bdr <+> equals) 2 (ppr_annot val_bdr $ pprCoreExpr expr)
+
+ppr_annot :: Outputable b => b -> SDoc -> SDoc
+ppr_annot name doc = sdocWithDynFlags $ \dflags ->
+  let annot = showSDocDump dflags $ text "ann<#" <> ppr name <> text "#>"
+  in pprAnnotate annot doc
+
+
 \end{code}
 
 \begin{code}
@@ -121,7 +129,7 @@ ppr_expr add_par (Cast expr co)
                if gopt Opt_SuppressCoercions dflags
                then ptext (sLit "...")
                else parens $
-                        sep [ppr co, dcolon <+> pprEqPred (coercionKind co)]
+                        sep [ppr co, dcolon <+> ppr (coercionType co)]
 
 
 ppr_expr add_par expr@(Lam _ _)
@@ -164,7 +172,8 @@ ppr_expr add_par (Case expr var ty [(con,args,rhs)])
                      <+> ppr_bndr var
                    , ptext (sLit "<-") <+> ppr_expr id expr
                      <+> ptext (sLit "} in") ]
-             , pprCoreExpr rhs
+             , ppr_annot (var, con) $
+               pprCoreExpr rhs
              ]
     else add_par $
          sep [sep [ptext (sLit "case") <+> pprCoreExpr expr,
@@ -172,6 +181,7 @@ ppr_expr add_par (Case expr var ty [(con,args,rhs)])
                    sep [ptext (sLit "of") <+> ppr_bndr var,
                         char '{' <+> ppr_case_pat con args <+> arrow]
                ],
+              ppr_annot (var, con) $
               pprCoreExpr rhs,
               char '}'
          ]
@@ -184,11 +194,12 @@ ppr_expr add_par (Case expr var ty alts)
                 <+> pprCoreExpr expr
                 <+> ifPprDebug (braces (ppr ty)),
               ptext (sLit "of") <+> ppr_bndr var <+> char '{'],
-         nest 2 (vcat (punctuate semi (map pprCoreAlt alts))),
+         nest 2 (vcat (punctuate semi (map ppr_alt alts))),
          char '}'
     ]
   where
     ppr_bndr = pprBndr CaseBind
+    ppr_alt alt@(con,_,_) = ppr_annot (var, con) $ pprCoreAlt alt
 
 
 -- special cases: let ... in let ...
@@ -223,7 +234,10 @@ ppr_expr add_par (Let bind expr)
                 NonRec _ _ -> (sLit "let {")
 
 ppr_expr add_par (Tick tickish expr)
-  = add_par (sep [ppr tickish, pprCoreExpr expr])
+  = sdocWithDynFlags $ \dflags ->
+  if gopt Opt_PprShowTicks dflags
+  then add_par (sep [ppr tickish, pprCoreExpr expr])
+  else ppr_expr add_par expr
 
 pprCoreAlt :: OutputableBndr a => (AltCon, [a] , Expr a) -> SDoc
 pprCoreAlt (con, args, rhs)
@@ -376,10 +390,11 @@ ppIdInfo id info
     else
     showAttributes
     [ (True, pp_scope <> ppr (idDetails id))
-    , (has_arity,      ptext (sLit "Arity=") <> int arity)
-    , (has_caf_info,   ptext (sLit "Caf=") <> ppr caf_info)
-    , (True,           ptext (sLit "Str=") <> pprStrictness str_info)
-    , (has_unf,        ptext (sLit "Unf=") <> ppr unf_info)
+    , (has_arity,        ptext (sLit "Arity=") <> int arity)
+    , (has_called_arity, ptext (sLit "CallArity=") <> int called_arity)
+    , (has_caf_info,     ptext (sLit "Caf=") <> ppr caf_info)
+    , (True,             ptext (sLit "Str=") <> pprStrictness str_info)
+    , (has_unf,          ptext (sLit "Unf=") <> ppr unf_info)
     , (not (null rules), ptext (sLit "RULES:") <+> vcat (map pprRule rules))
     ]   -- Inline pragma, occ, demand, one-shot info
         -- printed out with all binders (when debug is on);
@@ -392,6 +407,9 @@ ppIdInfo id info
     arity = arityInfo info
     has_arity = arity /= 0
 
+    called_arity = callArityInfo info
+    has_called_arity = called_arity /= 0
+
     caf_info = cafInfo info
     has_caf_info = not (mayHaveCafRefs caf_info)
 
@@ -510,6 +528,12 @@ instance Outputable id => Outputable (Tickish id) where
          (True,True)  -> hcat [ptext (sLit "scctick<"), ppr cc, char '>']
          (True,False) -> hcat [ptext (sLit "tick<"),    ppr cc, char '>']
          _            -> hcat [ptext (sLit "scc<"),     ppr cc, char '>']
+  ppr (SourceNote span _) =
+      hcat [ ptext (sLit "src<"), text (showUserRealSpan True span), char '>']
+  ppr (CoreNote {coreBind = bnd, coreNote = ExprPtr{}}) =
+      hcat [ ptext (sLit "core<"), ppr bnd, ptext (sLit "=...>") ]
+  ppr (CoreNote {coreBind = bnd, coreNote = AltPtr (con,_,_)}) =
+      hcat [ ptext (sLit "core<"), ppr bnd <+> ppr con <>ptext (sLit "->...>") ]
 \end{code}
 
 -----------------------------------------------------
diff --git a/compiler/coreSyn/PprExternalCore.lhs b/compiler/coreSyn/PprExternalCore.lhs
deleted file mode 100644
index 7fd3ac1d6531..000000000000
--- a/compiler/coreSyn/PprExternalCore.lhs
+++ /dev/null
@@ -1,260 +0,0 @@
-%
-% (c) The University of Glasgow 2001-2006
-%
-
-\begin{code}
-{-# OPTIONS_GHC -fno-warn-orphans #-}
-
-module PprExternalCore () where
-
-import Encoding
-import ExternalCore
-
-import Pretty
-import Data.Char
-import Data.Ratio
-
-instance Show Module where
-  showsPrec _ m = shows (pmodule m)
-
-instance Show Tdef where
-  showsPrec _ t = shows (ptdef t)
-
-instance Show Cdef where
-  showsPrec _ c = shows (pcdef c)
-
-instance Show Vdefg where
-  showsPrec _ v = shows (pvdefg v)
-
-instance Show Exp where
-  showsPrec _ e = shows (pexp e)
-
-instance Show Alt where
-  showsPrec _ a = shows (palt a)
-
-instance Show Ty where
-  showsPrec _ t = shows (pty t)
-
-instance Show Kind where
-  showsPrec _ k = shows (pkind k)
-
-instance Show Lit where
-  showsPrec _ l = shows (plit l)
-
-
-indent :: Doc -> Doc
-indent = nest 2
-
-pmodule :: Module -> Doc
-pmodule (Module mname tdefs vdefgs) =
-  (text "%module" <+> text mname)
-    $$ indent ((vcat (map ((<> char ';') . ptdef) tdefs))
-               $$ (vcat (map ((<> char ';') . pvdefg) vdefgs)))
-
-ptdef :: Tdef -> Doc
-ptdef (Data tcon tbinds cdefs) =
-  (text "%data" <+> pqname tcon <+> (hsep (map ptbind tbinds)) <+> char '=')
-  $$ indent (braces ((vcat (punctuate (char ';') (map pcdef cdefs)))))
-
-ptdef (Newtype tcon coercion tbinds rep) =
-  text "%newtype" <+> pqname tcon <+> pqname coercion 
-   <+> (hsep (map ptbind tbinds)) $$ indent repclause
-       where repclause = char '=' <+> pty rep
-
-pcdef :: Cdef -> Doc
-pcdef (Constr dcon tbinds tys)  =
-  (pqname dcon) <+> (sep [hsep (map pattbind tbinds),sep (map paty tys)])
-pcdef (GadtConstr dcon ty)  =
-  (pqname dcon) <+> text "::" <+> pty ty
-
-pname :: Id -> Doc
-pname id = text (zEncodeString id)
-
-pqname :: Qual Id -> Doc
-pqname ("",id) = pname id
-pqname (m,id)  = text m <> char '.' <> pname id
-
-ptbind, pattbind :: Tbind -> Doc
-ptbind (t,Klifted) = pname t
-ptbind (t,k) = parens (pname t <> text "::" <> pkind k)
-
-pattbind (t,k) = char '@' <> ptbind (t,k)
-
-pakind, pkind :: Kind -> Doc
-pakind (Klifted) = char '*'
-pakind (Kunlifted) = char '#'
-pakind (Kopen) = char '?'
-pakind k = parens (pkind k)
-
-pkind (Karrow k1 k2) = parens (pakind k1 <> text "->" <> pkind k2)
-pkind k = pakind k
-
-paty, pbty, pty :: Ty -> Doc
--- paty: print in parens, if non-atomic (like a name)
--- pbty: print in parens, if arrow (used only for lhs of arrow)
--- pty:  not in parens
-paty (Tvar n) = pname n
-paty (Tcon c) = pqname c
-paty t = parens (pty t)
-
-pbty (Tapp(Tapp(Tcon tc) t1) t2) | tc == tcArrow = parens(fsep [pbty t1, text "->",pty t2])
-pbty t = paty t
-
-pty (Tapp(Tapp(Tcon tc) t1) t2) | tc == tcArrow = fsep [pbty t1, text "->",pty t2]
-pty (Tforall tb t) = text "%forall" <+> pforall [tb] t
-pty ty@(Tapp {}) = pappty ty []
-pty ty@(Tvar {}) = paty ty
-pty ty@(Tcon {}) = paty ty
-
-pappty :: Ty -> [Ty] -> Doc
-pappty (Tapp t1 t2) ts = pappty t1 (t2:ts)
-pappty t ts = sep (map paty (t:ts))
-
-pforall :: [Tbind] -> Ty -> Doc
-pforall tbs (Tforall tb t) = pforall (tbs ++ [tb]) t
-pforall tbs t = hsep (map ptbind tbs) <+> char '.' <+> pty t
-
-paco, pbco, pco :: Coercion -> Doc
-paco (ReflCoercion r ty) = char '<' <> pty ty <> text ">_" <> prole r
-paco (TyConAppCoercion r qtc []) = pqname qtc <> char '_' <> prole r
-paco (AxiomCoercion qtc i []) = pqname qtc <> char '[' <> int i <> char ']'
-paco (CoVarCoercion cv) = pname cv
-paco c = parens (pco c)
-
-pbco (TyConAppCoercion _ arr [co1, co2])
-  | arr == tcArrow
-  = parens (fsep [pbco co1, text "->", pco co2])
-pbco co = paco co
-
-pco c@(ReflCoercion {})          = paco c
-pco (SymCoercion co)             = sep [text "%sub", paco co]
-pco (TransCoercion co1 co2)      = sep [text "%trans", paco co1, paco co2]
-pco (TyConAppCoercion _ arr [co1, co2])
-  | arr == tcArrow               = fsep [pbco co1, text "->", pco co2]
-pco (TyConAppCoercion r qtc cos) = parens (pqname qtc <+> sep (map paco cos)) <> char '_' <> prole r
-pco co@(AppCoercion {})          = pappco co []
-pco (ForAllCoercion tb co)       = text "%forall" <+> pforallco [tb] co
-pco co@(CoVarCoercion {})        = paco co
-pco (UnivCoercion r ty1 ty2)     = sep [text "%univ", prole r, paty ty1, paty ty2]
-pco (InstCoercion co ty)         = sep [text "%inst", paco co, paty ty]
-pco (NthCoercion i co)           = sep [text "%nth", int i, paco co]
-pco (AxiomCoercion qtc i cos)    = pqname qtc <> char '[' <> int i <> char ']' <+> sep (map paco cos)
-pco (LRCoercion CLeft co)        = sep [text "%left", paco co]
-pco (LRCoercion CRight co)       = sep [text "%right", paco co]
-pco (SubCoercion co)             = sep [text "%sub", paco co]
-
-pappco :: Coercion -> [Coercion ] -> Doc
-pappco (AppCoercion co1 co2) cos = pappco co1 (co2:cos)
-pappco co cos = sep (map paco (co:cos))
-
-pforallco :: [Tbind] -> Coercion -> Doc
-pforallco tbs (ForAllCoercion tb co) = pforallco (tbs ++ [tb]) co
-pforallco tbs co = hsep (map ptbind tbs) <+> char '.' <+> pco co
- 
-prole :: Role -> Doc
-prole Nominal          = char 'N'
-prole Representational = char 'R'
-prole Phantom          = char 'P'
-
-pvdefg :: Vdefg -> Doc
-pvdefg (Rec vdefs) = text "%rec" $$ braces (indent (vcat (punctuate (char ';') (map pvdef vdefs))))
-pvdefg (Nonrec vdef) = pvdef vdef
-
-pvdef :: Vdef -> Doc
--- TODO: Think about whether %local annotations are actually needed.
--- Right now, the local flag is never used, because the Core doc doesn't
--- explain the meaning of %local.
-pvdef (_l,v,t,e) = sep [(pqname v <+> text "::" <+> pty t <+> char '='),
-                    indent (pexp e)]
-
-paexp, pfexp, pexp :: Exp -> Doc
-paexp (Var x) = pqname x
-paexp (Dcon x) = pqname x
-paexp (Lit l) = plit l
-paexp e = parens(pexp e)
-
-plamexp :: [Bind] -> Exp -> Doc
-plamexp bs (Lam b e) = plamexp (bs ++ [b]) e
-plamexp bs e = sep [sep (map pbind bs) <+> text "->",
-                    indent (pexp e)]
-
-pbind :: Bind -> Doc
-pbind (Tb tb) = char '@' <+> ptbind tb
-pbind (Vb vb) = pvbind vb
-
-pfexp (App e1 e2) = pappexp e1 [Left e2]
-pfexp (Appt e t) = pappexp e [Right t]
-pfexp e = paexp e
-
-pappexp :: Exp -> [Either Exp Ty] -> Doc
-pappexp (App e1 e2) as = pappexp e1 (Left e2:as)
-pappexp (Appt e t) as = pappexp e (Right t:as)
-pappexp e as = fsep (paexp e : map pa as)
-           where pa (Left e) = paexp e
-                 pa (Right t) = char '@' <+> paty t
-
-pexp (Lam b e) = char '\\' <+> plamexp [b] e
-pexp (Let vd e) = (text "%let" <+> pvdefg vd) $$ (text "%in" <+> pexp e)
-pexp (Case e vb ty alts) = sep [text "%case" <+> paty ty <+> paexp e,
-                             text "%of" <+> pvbind vb]
-                        $$ (indent (braces (vcat (punctuate (char ';') (map palt alts)))))
-pexp (Cast e co) = (text "%cast" <+> parens (pexp e)) $$ paco co
-pexp (Tick s e) = (text "%source" <+> pstring s) $$ pexp e
-pexp (External n cc t) = (text "%external" <+> text cc <+> pstring n) $$ paty t
-pexp (DynExternal cc t) = (text "%dynexternal" <+> text cc) $$ paty t
-pexp (Label n) = (text "%label" <+> pstring n)
-pexp e = pfexp e
-
-pvbind :: Vbind -> Doc
-pvbind (x,t) = parens(pname x <> text "::" <> pty t)
-
-palt :: Alt -> Doc
-palt (Acon c tbs vbs e) =
-        sep [pqname c, 
-             sep (map pattbind tbs),
-             sep (map pvbind vbs) <+> text "->"]
-        $$ indent (pexp e)
-palt (Alit l e) = 
-        (plit l <+>  text "->")
-        $$ indent (pexp e)
-palt (Adefault e) = 
-        (text "%_ ->")
-        $$ indent (pexp e)
-
-plit :: Lit -> Doc
-plit (Lint i t) = parens (integer i <> text "::" <> pty t)
--- we use (text (show (numerator r))) (and the same for denominator)
--- because "(rational r)" was printing out things like "2.0e-2" (which
--- isn't External Core), and (text (show r)) was printing out things
--- like "((-1)/5)" which isn't either (it should be "(-1/5)").
-plit (Lrational r t) = parens (text (show (numerator r)) <+> char '%'
-   <+> text (show (denominator r)) <>  text "::" <> pty t)
-plit (Lchar c t) = parens (text ("\'" ++ escape [c] ++ "\'") <> text "::" <> pty t)
--- This is a little messy. We shouldn't really be going via String.
-plit (Lstring bs t) = parens (pstring str <> text "::" <> pty t)
-    where str = map (chr . fromIntegral) bs
-
-pstring :: String -> Doc
-pstring s = doubleQuotes(text (escape s))
-
-escape :: String -> String
-escape s = foldr f [] (map ord s)
-    where 
-     f cv rest
-        | cv > 0xFF = '\\':'x':hs ++ rest
-        | (cv < 0x20 || cv > 0x7e || cv == 0x22 || cv == 0x27 || cv == 0x5c) = 
-         '\\':'x':h1:h0:rest
-           where (q1,r1) = quotRem cv 16
-                 h1 = intToDigit q1
-                 h0 = intToDigit r1
-                 hs = dropWhile (=='0') $ reverse $ mkHex cv
-                 mkHex 0 = ""
-                 mkHex cv = intToDigit r : mkHex q
-                    where (q,r) = quotRem cv 16
-     f cv rest = (chr cv):rest
-
-\end{code}
-
-
-
-
diff --git a/compiler/coreSyn/TrieMap.lhs b/compiler/coreSyn/TrieMap.lhs
index ac04adab1bc3..2744c5d0b853 100644
--- a/compiler/coreSyn/TrieMap.lhs
+++ b/compiler/coreSyn/TrieMap.lhs
@@ -4,14 +4,14 @@
 %
 
 \begin{code}
-{-# OPTIONS -fno-warn-tabs #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
 -- The above warning supression flag is a temporary kludge.
 -- While working on this module you are encouraged to remove it and
 -- detab the module (please do the detabbing in a separate patch). See
 --     http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
 -- for details
 
-{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE RankNTypes, TypeFamilies #-}
 module TrieMap(
    CoreMap, emptyCoreMap, extendCoreMap, lookupCoreMap, foldCoreMap,
    TypeMap, emptyTypeMap, extendTypeMap, lookupTypeMap, foldTypeMap, 
diff --git a/compiler/deSugar/Check.lhs b/compiler/deSugar/Check.lhs
index 960475cedd03..e07a70fc6544 100644
--- a/compiler/deSugar/Check.lhs
+++ b/compiler/deSugar/Check.lhs
@@ -5,6 +5,8 @@
 % Author: Juan J. Quintela    <quintela@krilin.dc.fi.udc.es>
 
 \begin{code}
+{-# LANGUAGE CPP #-}
+
 module Check ( check , ExhaustivePat ) where
 
 #include "HsVersions.h"
@@ -21,7 +23,6 @@ import Name
 import TysWiredIn
 import PrelNames
 import TyCon
-import Type
 import SrcLoc
 import UniqSet
 import Util
@@ -123,7 +124,7 @@ untidy_message :: (Name, [HsLit]) -> (Name, [HsLit])
 untidy_message (string, lits) = (string, map untidy_lit lits)
 \end{code}
 
-The function @untidy@ does the reverse work of the @tidy_pat@ funcion.
+The function @untidy@ does the reverse work of the @tidy_pat@ function.
 
 \begin{code}
 
@@ -144,7 +145,7 @@ untidy b (L loc p) = L loc (untidy' b p)
     untidy' _ p@(ConPatIn _ (PrefixCon [])) = p
     untidy' b (ConPatIn name ps)     = pars b (L loc (ConPatIn name (untidy_con ps)))
     untidy' _ (ListPat pats ty Nothing)     = ListPat (map untidy_no_pars pats) ty Nothing   
-    untidy' _ (TuplePat pats box ty) = TuplePat (map untidy_no_pars pats) box ty
+    untidy' _ (TuplePat pats box tys) = TuplePat (map untidy_no_pars pats) box tys
     untidy' _ (ListPat _ _ (Just _)) = panic "Check.untidy: Overloaded ListPat"    
     untidy' _ (PArrPat _ _)          = panic "Check.untidy: Shouldn't get a parallel array here!"
     untidy' _ (SigPatIn _ _)         = panic "Check.untidy: SigPat"
@@ -421,8 +422,8 @@ compare_cons _ _ = panic "Check.compare_cons: Not ConPatOut with RealDataCon"
 
 remove_dups :: [Pat Id] -> [Pat Id]
 remove_dups []     = []
-remove_dups (x:xs) | or (map (\y -> compare_cons x y) xs) = remove_dups  xs
-                   | otherwise                            = x : remove_dups xs
+remove_dups (x:xs) | any (\y -> compare_cons x y) xs = remove_dups  xs
+                   | otherwise                       = x : remove_dups xs
 
 get_used_cons :: [(EqnNo, EquationInfo)] -> [Pat Id]
 get_used_cons qs = remove_dups [pat | q <- qs, let pat = firstPatN q,
@@ -468,8 +469,8 @@ get_unused_cons used_cons = ASSERT( not (null used_cons) ) unused_cons
      where
        used_set :: UniqSet DataCon
        used_set = mkUniqSet [d | ConPatOut{ pat_con = L _ (RealDataCon d) } <- used_cons]
-       (ConPatOut { pat_ty = ty }) = head used_cons
-       Just (ty_con, inst_tys) = splitTyConApp_maybe ty
+       (ConPatOut { pat_con = L _ (RealDataCon con1), pat_arg_tys = inst_tys }) = head used_cons
+       ty_con      = dataConTyCon con1
        unused_cons = filterOut is_used (tyConDataCons ty_con)
        is_used con = con `elementOfUniqSet` used_set
                      || dataConCannotMatch inst_tys con
@@ -593,9 +594,9 @@ make_con (ConPatOut{ pat_con = L _ (RealDataCon id) }) (lp:lq:ps, constraints)
      | isInfixCon id    = (nlInfixConPat (getName id) lp lq : ps, constraints)
    where q  = unLoc lq
 
-make_con (ConPatOut{ pat_con = L _ (RealDataCon id), pat_args = PrefixCon pats, pat_ty = ty }) (ps, constraints)
-      | isTupleTyCon tc  = (noLoc (TuplePat pats_con (tupleTyConBoxity tc) ty) : rest_pats, constraints)
-      | isPArrFakeCon id = (noLoc (PArrPat pats_con placeHolderType)           : rest_pats, constraints)
+make_con (ConPatOut{ pat_con = L _ (RealDataCon id), pat_args = PrefixCon pats, pat_arg_tys = tys }) (ps, constraints)
+      | isTupleTyCon tc  = (noLoc (TuplePat pats_con (tupleTyConBoxity tc) tys) : rest_pats, constraints)
+      | isPArrFakeCon id = (noLoc (PArrPat pats_con placeHolderType)            : rest_pats, constraints)
       | otherwise        = (nlConPat name pats_con      : rest_pats, constraints)
     where
         name                  = getName id
@@ -696,17 +697,16 @@ tidy_pat (CoPat _ pat _)  = tidy_pat pat
 tidy_pat (NPlusKPat id _ _ _) = WildPat (idType (unLoc id))
 tidy_pat (ViewPat _ _ ty)     = WildPat ty
 tidy_pat (ListPat _ _ (Just (ty,_))) = WildPat ty
-tidy_pat (ConPatOut { pat_con = L _ PatSynCon{}, pat_ty = ty })
-  = WildPat ty
+tidy_pat (ConPatOut { pat_con = L _ (PatSynCon syn), pat_arg_tys = tys })
+  = WildPat (patSynInstResTy syn tys)
 
 tidy_pat pat@(ConPatOut { pat_con = L _ con, pat_args = ps })
   = pat { pat_args = tidy_con con ps }
 
 tidy_pat (ListPat ps ty Nothing)
-  = unLoc $ foldr (\ x y -> mkPrefixConPat consDataCon [x,y] list_ty)
-                                  (mkNilPat list_ty)
+  = unLoc $ foldr (\ x y -> mkPrefixConPat consDataCon [x,y] [ty])
+                                  (mkNilPat ty)
                                   (map tidy_lpat ps)
-  where list_ty = mkListTy ty
 
 -- introduce fake parallel array constructors to be able to handle parallel
 -- arrays with the existing machinery for constructor pattern
@@ -714,11 +714,11 @@ tidy_pat (ListPat ps ty Nothing)
 tidy_pat (PArrPat ps ty)
   = unLoc $ mkPrefixConPat (parrFakeCon (length ps))
                            (map tidy_lpat ps)
-                           (mkPArrTy ty)
+                           [ty]
 
-tidy_pat (TuplePat ps boxity ty)
+tidy_pat (TuplePat ps boxity tys)
   = unLoc $ mkPrefixConPat (tupleCon (boxityNormalTupleSort boxity) arity)
-                           (map tidy_lpat ps) ty
+                           (map tidy_lpat ps) tys
   where
     arity = length ps
 
@@ -735,8 +735,8 @@ tidy_lit_pat :: HsLit -> Pat Id
 -- overlap with each other, or even explicit lists of Chars.
 tidy_lit_pat lit
   | HsString s <- lit
-  = unLoc $ foldr (\c pat -> mkPrefixConPat consDataCon [mkCharLitPat c, pat] stringTy)
-                  (mkPrefixConPat nilDataCon [] stringTy) (unpackFS s)
+  = unLoc $ foldr (\c pat -> mkPrefixConPat consDataCon [mkCharLitPat c, pat] [charTy])
+                  (mkPrefixConPat nilDataCon [] [charTy]) (unpackFS s)
   | otherwise
   = tidyLitPat lit
 
diff --git a/compiler/deSugar/Coverage.lhs b/compiler/deSugar/Coverage.lhs
index 0ac7de802299..3af9d55a0048 100644
--- a/compiler/deSugar/Coverage.lhs
+++ b/compiler/deSugar/Coverage.lhs
@@ -3,6 +3,8 @@
 % (c) University of Glasgow, 2007
 %
 \begin{code}
+{-# LANGUAGE NondecreasingIndentation #-}
+
 module Coverage (addTicksToBinds, hpcInitCode) where
 
 import Type
@@ -62,11 +64,9 @@ addTicksToBinds
         -> LHsBinds Id
         -> IO (LHsBinds Id, HpcInfo, ModBreaks)
 
-addTicksToBinds dflags mod mod_loc exports tyCons binds =
-
- case ml_hs_file mod_loc of
-   Nothing        -> return (binds, emptyHpcInfo False, emptyModBreaks)
-   Just orig_file -> do
+addTicksToBinds dflags mod mod_loc exports tyCons binds
+  | let passes = coveragePasses dflags, not (null passes),
+    Just orig_file <- ml_hs_file mod_loc = do
 
      if "boot" `isSuffixOf` orig_file
          then return (binds, emptyHpcInfo False, emptyModBreaks)
@@ -74,9 +74,8 @@ addTicksToBinds dflags mod mod_loc exports tyCons binds =
 
      let  orig_file2 = guessSourceFile binds orig_file
 
-          (binds1,_,st)
-                 = unTM (addTickLHsBinds binds)
-                   (TTE
+          tickPass tickish (binds,st) =
+            let env = TTE
                       { fileName     = mkFastString orig_file2
                       , declPath     = []
                       , tte_dflags   = dflags
@@ -86,19 +85,18 @@ addTicksToBinds dflags mod mod_loc exports tyCons binds =
                       , blackList    = Map.fromList
                                           [ (getSrcSpan (tyConName tyCon),())
                                           | tyCon <- tyCons ]
-                      , density      = mkDensity dflags
+                      , density      = mkDensity tickish dflags
                       , this_mod     = mod
-                      , tickishType  = case hscTarget dflags of
-                          HscInterpreted          -> Breakpoints
-                          _ | gopt Opt_Hpc dflags -> HpcTicks
-                            | gopt Opt_SccProfilingOn dflags
-                                                  -> ProfNotes
-                            | otherwise           -> error "addTicksToBinds: No way to annotate!"
-                       })
-                   (TT
-                      { tickBoxCount = 0
-                      , mixEntries   = []
-                      })
+                      , tickishType  = tickish
+                      }
+                (binds',_,st') = unTM (addTickLHsBinds binds) env st
+            in (binds', st')
+          (binds1,st) = foldr tickPass
+                              (binds,
+                               TT { tickBoxCount = 0
+                                  , mixEntries   = []
+                                  } )
+                              passes
 
      let entries = reverse $ mixEntries st
 
@@ -112,12 +110,13 @@ addTicksToBinds dflags mod mod_loc exports tyCons binds =
 
      return (binds1, HpcInfo count hashNo, modBreaks)
 
+  | otherwise = return (binds, emptyHpcInfo False, emptyModBreaks)
 
 guessSourceFile :: LHsBinds Id -> FilePath -> FilePath
 guessSourceFile binds orig_file =
      -- Try look for a file generated from a .hsc file to a
      -- .hs file, by peeking ahead.
-     let top_pos = catMaybes $ foldrBag (\ (_, (L pos _)) rest ->
+     let top_pos = catMaybes $ foldrBag (\ (L pos _) rest ->
                                  srcSpanFileName_maybe pos : rest) [] binds
      in
      case top_pos of
@@ -152,8 +151,8 @@ writeMixEntries dflags mod count entries filename
             mod_name = moduleNameString (moduleName mod)
 
             hpc_mod_dir
-              | modulePackageId mod == mainPackageId  = hpc_dir
-              | otherwise = hpc_dir ++ "/" ++ packageIdString (modulePackageId mod)
+              | modulePackageKey mod == mainPackageKey  = hpc_dir
+              | otherwise = hpc_dir ++ "/" ++ packageKeyString (modulePackageKey mod)
 
             tabStop = 8 -- <tab> counts as a normal char in GHC's location ranges.
 
@@ -181,20 +180,18 @@ data TickDensity
   | TickCallSites         -- for stack tracing
   deriving Eq
 
-mkDensity :: DynFlags -> TickDensity
-mkDensity dflags
-  | gopt Opt_Hpc dflags                  = TickForCoverage
-  | HscInterpreted  <- hscTarget dflags  = TickForBreakPoints
-  | ProfAutoAll     <- profAuto dflags   = TickAllFunctions
-  | ProfAutoTop     <- profAuto dflags   = TickTopFunctions
-  | ProfAutoExports <- profAuto dflags   = TickExportedFunctions
-  | ProfAutoCalls   <- profAuto dflags   = TickCallSites
-  | otherwise = panic "desnity"
-  -- ToDo: -fhpc is taking priority over -fprof-auto here.  It seems
-  -- that coverage works perfectly well with profiling, but you don't
-  -- get any auto-generated SCCs.  It would make perfect sense to
-  -- allow both of them, and indeed to combine some of the other flags
-  -- (-fprof-auto-calls -fprof-auto-top, for example)
+mkDensity :: TickishType -> DynFlags -> TickDensity
+mkDensity tickish dflags = case tickish of
+  HpcTicks             -> TickForCoverage
+  SourceNotes          -> TickForCoverage
+  Breakpoints          -> TickForBreakPoints
+  ProfNotes ->
+    case profAuto dflags of
+      ProfAutoAll      -> TickAllFunctions
+      ProfAutoTop      -> TickTopFunctions
+      ProfAutoExports  -> TickExportedFunctions
+      ProfAutoCalls    -> TickCallSites
+      _other           -> panic "mkDensity"
 
 -- | Decide whether to add a tick to a binding or not.
 shouldTickBind  :: TickDensity
@@ -229,11 +226,7 @@ shouldTickPatBind density top_lev
 -- Adding ticks to bindings
 
 addTickLHsBinds :: LHsBinds Id -> TM (LHsBinds Id)
-addTickLHsBinds binds = mapBagM addTick binds
-  where
-    addTick (origin, bind) = do
-        bind' <- addTickLHsBind bind
-        return (origin, bind')
+addTickLHsBinds = mapBagM addTickLHsBind
 
 addTickLHsBind :: LHsBind Id -> TM (LHsBind Id)
 addTickLHsBind (L pos bind@(AbsBinds { abs_binds   = binds,
@@ -560,6 +553,13 @@ addTickHsExpr (ArithSeq  ty wit arith_seq) =
              where addTickWit Nothing = return Nothing
                    addTickWit (Just fl) = do fl' <- addTickHsExpr fl
                                              return (Just fl')
+
+-- We might encounter existing ticks (multiple Coverage passes)
+addTickHsExpr (HsTick t e) =
+        liftM (HsTick t) (addTickLHsExpr e)
+addTickHsExpr (HsBinTick t0 t1 e) =
+        liftM (HsBinTick t0 t1) (addTickLHsExpr e)
+
 addTickHsExpr (HsTickPragma _ (L pos e0)) = do
     e2 <- allocTickBox (ExpBox False) False False pos $
                 addTickHsExpr e0
@@ -940,8 +940,17 @@ data TickTransEnv = TTE { fileName     :: FastString
 
 --      deriving Show
 
-data TickishType = ProfNotes | HpcTicks | Breakpoints
+data TickishType = ProfNotes | HpcTicks | Breakpoints | SourceNotes
 
+coveragePasses :: DynFlags -> [TickishType]
+coveragePasses dflags =
+    ifa (hscTarget dflags == HscInterpreted) Breakpoints $
+    ifa (gopt Opt_Hpc dflags)                HpcTicks $
+    ifa (gopt Opt_SccProfilingOn dflags &&
+         profAuto dflags /= NoProfAuto)      ProfNotes $
+    ifa (gopt Opt_Debug dflags)              SourceNotes []
+  where ifa f x xs | f         = x:xs
+                   | otherwise = xs
 
 -- | Tickishs that only make sense when their source code location
 -- refers to the current file. This might not always be true due to
@@ -1114,6 +1123,9 @@ mkTickish boxLabel countEntries topOnly pos fvs decl_path =
           HpcTicks    -> HpcTick (this_mod env) c
           ProfNotes   -> ProfNote cc count True{-scopes-}
           Breakpoints -> Breakpoint c ids
+          SourceNotes | RealSrcSpan pos' <- pos
+                      -> SourceNote pos' cc_name
+          _otherwise  -> panic "mkTickish: bad source span!"
     in
     ( tickish
     , fvs
@@ -1235,9 +1247,9 @@ hpcInitCode this_mod (HpcInfo tickCount hashNo)
     module_name  = hcat (map (text.charToC) $
                          bytesFS (moduleNameFS (Module.moduleName this_mod)))
     package_name = hcat (map (text.charToC) $
-                         bytesFS (packageIdFS  (modulePackageId this_mod)))
+                         bytesFS (packageKeyFS  (modulePackageKey this_mod)))
     full_name_str
-       | modulePackageId this_mod == mainPackageId
+       | modulePackageKey this_mod == mainPackageKey
        = module_name
        | otherwise
        = package_name <> char '/' <> module_name
diff --git a/compiler/deSugar/Desugar.lhs b/compiler/deSugar/Desugar.lhs
index e13767ff59eb..908114202646 100644
--- a/compiler/deSugar/Desugar.lhs
+++ b/compiler/deSugar/Desugar.lhs
@@ -6,6 +6,8 @@
 The Desugarer: turning HsSyn into Core.
 
 \begin{code}
+{-# LANGUAGE CPP #-}
+
 module Desugar ( deSugar, deSugarExpr ) where
 
 import DynFlags
@@ -18,6 +20,7 @@ import Id
 import Name
 import Type
 import FamInstEnv
+import Coercion
 import InstEnv
 import Class
 import Avail
@@ -33,8 +36,11 @@ import Module
 import NameSet
 import NameEnv
 import Rules
+import TysPrim (eqReprPrimTyCon)
+import TysWiredIn (coercibleTyCon )
 import BasicTypes       ( Activation(.. ) )
 import CoreMonad        ( endPass, CoreToDo(..) )
+import MkCore
 import FastString
 import ErrUtils
 import Outputable
@@ -46,8 +52,6 @@ import OrdList
 import Data.List
 import Data.IORef
 import Control.Monad( when )
-import Data.Maybe ( mapMaybe )
-import UniqFM
 \end{code}
 
 %************************************************************************
@@ -96,15 +100,9 @@ deSugar hsc_env
         ; let export_set = availsToNameSet exports
               target     = hscTarget dflags
               hpcInfo    = emptyHpcInfo other_hpc_info
-              want_ticks = gopt Opt_Hpc dflags
-                        || target == HscInterpreted
-                        || (gopt Opt_SccProfilingOn dflags
-                            && case profAuto dflags of
-                                 NoProfAuto -> False
-                                 _          -> True)
 
         ; (binds_cvr, ds_hpc_info, modBreaks)
-                         <- if want_ticks && not (isHsBoot hsc_src)
+                         <- if not (isHsBoot hsc_src)
                               then addTicksToBinds dflags mod mod_loc export_set
                                           (typeEnvTyCons type_env) binds
                               else return (binds, hpcInfo, emptyModBreaks)
@@ -119,27 +117,20 @@ deSugar hsc_env
                           ; let hpc_init
                                   | gopt Opt_Hpc dflags = hpcInitCode mod ds_hpc_info
                                   | otherwise = empty
-                          ; let patsyn_defs = [(patSynId ps, ps) | ps <- patsyns]
                           ; return ( ds_ev_binds
                                    , foreign_prs `appOL` core_prs `appOL` spec_prs
                                    , spec_rules ++ ds_rules, ds_vects
-                                   , ds_fords `appendStubC` hpc_init
-                                   , patsyn_defs) }
+                                   , ds_fords `appendStubC` hpc_init) }
 
         ; case mb_res of {
            Nothing -> return (msgs, Nothing) ;
-           Just (ds_ev_binds, all_prs, all_rules, vects0, ds_fords, patsyn_defs) -> do
+           Just (ds_ev_binds, all_prs, all_rules, vects0, ds_fords) -> do
 
      do {       -- Add export flags to bindings
           keep_alive <- readIORef keep_var
-        ; let (rules_for_locals, rules_for_imps)
-                   = partition isLocalRule all_rules
-              final_patsyns = addExportFlagsAndRules target export_set keep_alive [] patsyn_defs
-              exp_patsyn_wrappers = mapMaybe (patSynWrapper . snd) final_patsyns
-              exp_patsyn_matchers = map (patSynMatcher . snd) final_patsyns
-              keep_alive' = addListToUFM keep_alive (map (\x -> (x, getName x)) (exp_patsyn_wrappers ++ exp_patsyn_matchers))
-              final_prs = addExportFlagsAndRules target
-                              export_set keep_alive' rules_for_locals (fromOL all_prs)
+        ; let (rules_for_locals, rules_for_imps) = partition isLocalRule all_rules
+              final_prs = addExportFlagsAndRules target export_set keep_alive
+                                                 rules_for_locals (fromOL all_prs)
 
               final_pgm = combineEvBinds ds_ev_binds final_prs
         -- Notice that we put the whole lot in a big Rec, even the foreign binds
@@ -183,7 +174,7 @@ deSugar hsc_env
                 mg_fam_insts    = fam_insts,
                 mg_inst_env     = inst_env,
                 mg_fam_inst_env = fam_inst_env,
-                mg_patsyns      = map snd . filter (isExportedId . fst) $ final_patsyns,
+                mg_patsyns      = filter ((`elemNameSet` export_set) . patSynName) patsyns,
                 mg_rules        = ds_rules_for_imps,
                 mg_binds        = ds_binds,
                 mg_foreign      = ds_fords,
@@ -347,6 +338,7 @@ Reason
 %************************************************************************
 
 \begin{code}
+
 dsRule :: LRuleDecl Id -> DsM (Maybe CoreRule)
 dsRule (L loc (HsRule name act vars lhs _tv_lhs rhs _fv_rhs))
   = putSrcSpanDs loc $
@@ -359,9 +351,11 @@ dsRule (L loc (HsRule name act vars lhs _tv_lhs rhs _fv_rhs))
         ; rhs' <- dsLExpr rhs
         ; dflags <- getDynFlags
 
+        ; (bndrs'', lhs'', rhs'') <- unfold_coerce bndrs' lhs' rhs'
+
         -- Substitute the dict bindings eagerly,
         -- and take the body apart into a (f args) form
-        ; case decomposeRuleLhs bndrs' lhs' of {
+        ; case decomposeRuleLhs bndrs'' lhs'' of {
                 Left msg -> do { warnDs msg; return Nothing } ;
                 Right (final_bndrs, fn_id, args) -> do
 
@@ -370,7 +364,7 @@ dsRule (L loc (HsRule name act vars lhs _tv_lhs rhs _fv_rhs))
                 -- we don't want to attach rules to the bindings of implicit Ids,
                 -- because they don't show up in the bindings until just before code gen
               fn_name   = idName fn_id
-              final_rhs = simpleOptExpr rhs'    -- De-crap it
+              final_rhs = simpleOptExpr rhs''    -- De-crap it
               rule      = mkRule False {- Not auto -} is_local
                                  name act fn_name final_bndrs args final_rhs
 
@@ -398,6 +392,27 @@ dsRule (L loc (HsRule name act vars lhs _tv_lhs rhs _fv_rhs))
 
         ; return (Just rule)
         } } }
+
+-- See Note [Desugaring coerce as cast]
+unfold_coerce :: [Id] -> CoreExpr -> CoreExpr -> DsM ([Var], CoreExpr, CoreExpr)
+unfold_coerce bndrs lhs rhs = do
+    (bndrs', wrap) <- go bndrs
+    return (bndrs', wrap lhs, wrap rhs)
+  where
+    go :: [Id] -> DsM ([Id], CoreExpr -> CoreExpr)
+    go []     = return ([], id)
+    go (v:vs)
+        | Just (tc, args) <- splitTyConApp_maybe (idType v)
+        , tc == coercibleTyCon = do
+            let ty' = mkTyConApp eqReprPrimTyCon args
+            v' <- mkDerivedLocalM mkRepEqOcc v ty'
+
+            (bndrs, wrap) <- go vs
+            return (v':bndrs, mkCoreLet (NonRec v (mkEqBox (mkCoVarCo v'))) . wrap)
+        | otherwise = do
+            (bndrs,wrap) <- go vs
+            return (v:bndrs, wrap)
+
 \end{code}
 
 Note [Desugaring RULE left hand sides]
@@ -417,6 +432,20 @@ the rule is precisly to optimise them:
   {-# RULES "fromRational/id" fromRational = id :: Rational -> Rational #-}
 
 
+Note [Desugaring coerce as cast]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+We want the user to express a rule saying roughly “mapping a coercion over a
+list can be replaced by a coercion�. But the cast operator of Core (▷) cannot
+be written in Haskell. So we use `coerce` for that (#2110). The user writes
+    map coerce = coerce
+as a RULE, and this optimizes any kind of mapped' casts aways, including `map
+MkNewtype`.
+
+For that we replace any forall'ed `c :: Coercible a b` value in a RULE by
+corresponding `co :: a ~#R b` and wrap the LHS and the RHS in
+`let c = MkCoercible co in ...`. This is later simplified to the desired form
+by simpleOptExpr (for the LHS) resp. the simplifiers (for the RHS).
+
 %************************************************************************
 %*                                                                      *
 %*              Desugaring vectorisation declarations
diff --git a/compiler/deSugar/DsArrows.lhs b/compiler/deSugar/DsArrows.lhs
index 763106f2b3f4..35a2477fd531 100644
--- a/compiler/deSugar/DsArrows.lhs
+++ b/compiler/deSugar/DsArrows.lhs
@@ -6,7 +6,8 @@
 Desugaring arrow commands
 
 \begin{code}
-{-# OPTIONS -fno-warn-tabs #-}
+{-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
 -- The above warning supression flag is a temporary kludge.
 -- While working on this module you are encouraged to remove it and
 -- detab the module (please do the detabbing in a separate patch). See
@@ -465,8 +466,8 @@ dsCmd ids local_vars stack_ty res_ty (HsCmdIf mb_fun cond then_cmd else_cmd)
     left_con   <- dsLookupDataCon leftDataConName
     right_con  <- dsLookupDataCon rightDataConName
 
-    let mk_left_expr ty1 ty2 e = mkConApp left_con [Type ty1, Type ty2, e]
-        mk_right_expr ty1 ty2 e = mkConApp right_con [Type ty1, Type ty2, e]
+    let mk_left_expr ty1 ty2 e = mkCoreConApps left_con   [Type ty1, Type ty2, e]
+        mk_right_expr ty1 ty2 e = mkCoreConApps right_con [Type ty1, Type ty2, e]
 
         in_ty = envStackType env_ids stack_ty
         then_ty = envStackType then_ids stack_ty
@@ -517,7 +518,7 @@ case bodies, containing the following fields:
 
 \begin{code}
 dsCmd ids local_vars stack_ty res_ty 
-      (HsCmdCase exp (MG { mg_alts = matches, mg_arg_tys = arg_tys }))
+      (HsCmdCase exp (MG { mg_alts = matches, mg_arg_tys = arg_tys, mg_origin = origin }))
       env_ids = do
     stack_id <- newSysLocalDs stack_ty
 
@@ -561,7 +562,7 @@ dsCmd ids local_vars stack_ty res_ty
         in_ty = envStackType env_ids stack_ty
 
     core_body <- dsExpr (HsCase exp (MG { mg_alts = matches', mg_arg_tys = arg_tys
-                                        , mg_res_ty = sum_ty }))
+                                        , mg_res_ty = sum_ty, mg_origin = origin }))
         -- Note that we replace the HsCase result type by sum_ty,
         -- which is the type of matches'
 
diff --git a/compiler/deSugar/DsBinds.lhs b/compiler/deSugar/DsBinds.lhs
index cd683ba36592..172d19b9ac5b 100644
--- a/compiler/deSugar/DsBinds.lhs
+++ b/compiler/deSugar/DsBinds.lhs
@@ -10,7 +10,8 @@ in that the @Rec@/@NonRec@/etc structure is thrown away (whereas at
 lower levels it is preserved with @let@/@letrec@s).
 
 \begin{code}
-{-# OPTIONS -fno-warn-tabs #-}
+{-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
 -- The above warning supression flag is a temporary kludge.
 -- While working on this module you are encouraged to remove it and
 -- detab the module (please do the detabbing in a separate patch). See
@@ -34,6 +35,7 @@ import HsSyn		-- lots of things
 import CoreSyn		-- lots of things
 import Literal          ( Literal(MachStr) )
 import CoreSubst
+import OccurAnal        ( occurAnalyseExpr )
 import MkCore
 import CoreUtils
 import CoreArity ( etaExpand )
@@ -95,13 +97,8 @@ ds_lhs_binds :: LHsBinds Id -> DsM (OrdList (Id,CoreExpr))
 ds_lhs_binds binds = do { ds_bs <- mapBagM dsLHsBind binds
                         ; return (foldBag appOL id nilOL ds_bs) }
 
-dsLHsBind :: (Origin, LHsBind Id) -> DsM (OrdList (Id,CoreExpr))
-dsLHsBind (origin, L loc bind)
-  = handleWarnings $ putSrcSpanDs loc $ dsHsBind bind
-  where
-    handleWarnings = if isGenerated origin
-                     then discardWarningsDs
-                     else id
+dsLHsBind :: LHsBind Id -> DsM (OrdList (Id,CoreExpr))
+dsLHsBind (L loc bind) = putSrcSpanDs loc $ dsHsBind bind
 
 dsHsBind :: HsBind Id -> DsM (OrdList (Id,CoreExpr))
 
@@ -458,7 +455,10 @@ dsSpec mb_poly_rhs (L loc (SpecPrag poly_id spec_co spec_inl))
        ; (bndrs, ds_lhs) <- liftM collectBinders
                                   (dsHsWrapper spec_co (Var poly_id))
        ; let spec_ty = mkPiTypes bndrs (exprType ds_lhs)
-       ; case decomposeRuleLhs bndrs ds_lhs of {
+       ; -- pprTrace "dsRule" (vcat [ ptext (sLit "Id:") <+> ppr poly_id
+         --                         , ptext (sLit "spec_co:") <+> ppr spec_co
+         --                         , ptext (sLit "ds_rhs:") <+> ppr ds_lhs ]) $
+         case decomposeRuleLhs bndrs ds_lhs of {
            Left msg -> do { warnDs msg; return Nothing } ;
            Right (rule_bndrs, _fn, args) -> do
 
@@ -582,73 +582,173 @@ SPEC f :: ty                [n]   INLINE [k]
 decomposeRuleLhs :: [Var] -> CoreExpr -> Either SDoc ([Var], Id, [CoreExpr])
 -- (decomposeRuleLhs bndrs lhs) takes apart the LHS of a RULE,
 -- The 'bndrs' are the quantified binders of the rules, but decomposeRuleLhs
--- may add some extra dictionary binders (see Note [Constant rule dicts])
+-- may add some extra dictionary binders (see Note [Free dictionaries])
 --
 -- Returns Nothing if the LHS isn't of the expected shape
-decomposeRuleLhs bndrs lhs 
-  =  -- Note [Simplifying the left-hand side of a RULE]
-    case collectArgs opt_lhs of
-        (Var fn, args) -> check_bndrs fn args
-
-        (Case scrut bndr ty [(DEFAULT, _, body)], args)
-	        | isDeadBinder bndr	-- Note [Matching seqId]
-		-> check_bndrs seqId (args' ++ args)
-		where
-		   args' = [Type (idType bndr), Type ty, scrut, body]
-	   
-	_other -> Left bad_shape_msg
+-- Note [Decomposing the left-hand side of a RULE]
+decomposeRuleLhs orig_bndrs orig_lhs
+  | not (null unbound)    -- Check for things unbound on LHS
+                          -- See Note [Unused spec binders]
+  = Left (vcat (map dead_msg unbound))
+
+  | Var fn_var <- fun
+  , not (fn_var `elemVarSet` orig_bndr_set)
+  = -- pprTrace "decmposeRuleLhs" (vcat [ ptext (sLit "orig_bndrs:") <+> ppr orig_bndrs
+    --                                  , ptext (sLit "orig_lhs:") <+> ppr orig_lhs
+    --                                  , ptext (sLit "lhs1:")     <+> ppr lhs1
+    --                                  , ptext (sLit "bndrs1:") <+> ppr bndrs1
+    --                                  , ptext (sLit "fn_var:") <+> ppr fn_var
+    --                                  , ptext (sLit "args:")   <+> ppr args]) $
+    Right (bndrs1, fn_var, args)
+
+  | Case scrut bndr ty [(DEFAULT, _, body)] <- fun
+  , isDeadBinder bndr	-- Note [Matching seqId]
+  , let args' = [Type (idType bndr), Type ty, scrut, body]
+  = Right (bndrs1, seqId, args' ++ args)
+
+  | otherwise 
+  = Left bad_shape_msg
  where
-   opt_lhs = simpleOptExpr lhs
-
-   check_bndrs fn args
-     | null dead_bndrs = Right (extra_dict_bndrs ++ bndrs, fn, args)
-     | otherwise       = Left (vcat (map dead_msg dead_bndrs))
-     where
-       arg_fvs = exprsFreeVars args
-
-            -- Check for dead binders: Note [Unused spec binders]
-       dead_bndrs = filterOut (`elemVarSet` arg_fvs) bndrs
+   lhs1       = drop_dicts orig_lhs
+   lhs2       = simpleOptExpr lhs1  -- See Note [Simplify rule LHS]
+   (fun,args) = collectArgs lhs2
+   lhs_fvs    = exprFreeVars lhs2
+   unbound    = filterOut (`elemVarSet` lhs_fvs) orig_bndrs
+   bndrs1     = orig_bndrs ++ extra_dict_bndrs
 
-            -- Add extra dict binders: Note [Constant rule dicts]
-       extra_dict_bndrs = [ mkLocalId (localiseName (idName d)) (idType d)
-                          | d <- varSetElems (arg_fvs `delVarSetList` bndrs)
-         	          , isDictId d]
+   orig_bndr_set = mkVarSet orig_bndrs
 
+        -- Add extra dict binders: Note [Free dictionaries]
+   extra_dict_bndrs = [ mkLocalId (localiseName (idName d)) (idType d)
+                      | d <- varSetElems (lhs_fvs `delVarSetList` orig_bndrs)
+                      , isDictId d ]
 
    bad_shape_msg = hang (ptext (sLit "RULE left-hand side too complicated to desugar"))
-                      2 (ppr opt_lhs)
+                      2 (vcat [ text "Optimised lhs:" <+> ppr lhs2
+                              , text "Orig lhs:" <+> ppr orig_lhs])
    dead_msg bndr = hang (sep [ ptext (sLit "Forall'd") <+> pp_bndr bndr
 			     , ptext (sLit "is not bound in RULE lhs")])
-                      2 (ppr opt_lhs)
+                      2 (vcat [ text "Orig bndrs:" <+> ppr orig_bndrs
+                              , text "Orig lhs:" <+> ppr orig_lhs
+                              , text "optimised lhs:" <+> ppr lhs2 ])
    pp_bndr bndr
     | isTyVar bndr                      = ptext (sLit "type variable") <+> quotes (ppr bndr)
     | Just pred <- evVarPred_maybe bndr = ptext (sLit "constraint") <+> quotes (ppr pred)
     | otherwise                         = ptext (sLit "variable") <+> quotes (ppr bndr)
+
+   drop_dicts :: CoreExpr -> CoreExpr
+   drop_dicts e 
+       = wrap_lets needed bnds body
+     where
+       needed = orig_bndr_set `minusVarSet` exprFreeVars body
+       (bnds, body) = split_lets (occurAnalyseExpr e)
+       	   -- The occurAnalyseExpr drops dead bindings which is
+           -- crucial to ensure that every binding is used later;
+           -- which in turn makes wrap_lets work right
+
+   split_lets :: CoreExpr -> ([(DictId,CoreExpr)], CoreExpr)
+   split_lets e
+     | Let (NonRec d r) body <- e
+     , isDictId d
+     , (bs, body') <- split_lets body
+     = ((d,r):bs, body')
+     | otherwise
+     = ([], e)
+
+   wrap_lets :: VarSet -> [(DictId,CoreExpr)] -> CoreExpr -> CoreExpr
+   wrap_lets _ [] body = body
+   wrap_lets needed ((d, r) : bs) body
+     | rhs_fvs `intersectsVarSet` needed = Let (NonRec d r) (wrap_lets needed' bs body)
+     | otherwise                         = wrap_lets needed bs body
+     where
+       rhs_fvs = exprFreeVars r
+       needed' = (needed `minusVarSet` rhs_fvs) `extendVarSet` d
 \end{code}
 
-Note [Simplifying the left-hand side of a RULE]
+Note [Decomposing the left-hand side of a RULE]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-simpleOptExpr occurrence-analyses and simplifies the lhs
-and thereby
-(a) sorts dict bindings into NonRecs and inlines them
-(b) substitute trivial lets so that they don't get in the way
-    Note that we substitute the function too; we might 
-    have this as a LHS:  let f71 = M.f Int in f71
-(c) does eta reduction
-
-For (c) consider the fold/build rule, which without simplification
-looked like:
-	fold k z (build (/\a. g a))  ==>  ...
-This doesn't match unless you do eta reduction on the build argument.
-Similarly for a LHS like
-	augment g (build h) 
-we do not want to get
-	augment (\a. g a) (build h)
-otherwise we don't match when given an argument like
-	augment (\a. h a a) (build h)
-
-NB: tcSimplifyRuleLhs is very careful not to generate complicated
-    dictionary expressions that we might have to match
+There are several things going on here.  
+* drop_dicts: see Note [Drop dictionary bindings on rule LHS]
+* simpleOptExpr: see Note [Simplify rule LHS]
+* extra_dict_bndrs: see Note [Free dictionaries]
+
+Note [Drop dictionary bindings on rule LHS]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+drop_dicts drops dictionary bindings on the LHS where possible.  
+   E.g.  let d:Eq [Int] = $fEqList $fEqInt in f d
+     --> f d
+   Reasoning here is that there is only one d:Eq [Int], and so we can 
+   quantify over it. That makes 'd' free in the LHS, but that is later
+   picked up by extra_dict_bndrs (Note [Dead spec binders]).
+
+   NB 1: We can only drop the binding if the RHS doesn't bind
+         one of the orig_bndrs, which we assume occur on RHS. 
+         Example
+            f :: (Eq a) => b -> a -> a
+            {-# SPECIALISE f :: Eq a => b -> [a] -> [a] #-}
+         Here we want to end up with
+            RULE forall d:Eq a.  f ($dfEqList d) = f_spec d
+         Of course, the ($dfEqlist d) in the pattern makes it less likely
+         to match, but ther is no other way to get d:Eq a
+
+   NB 2: We do drop_dicts *before* simplOptEpxr, so that we expect all 
+         the evidence bindings to be wrapped around the outside of the
+         LHS.  (After simplOptExpr they'll usually have been inlined.)
+         dsHsWrapper does dependency analysis, so that civilised ones
+         will be simple NonRec bindings.  We don't handle recursive
+         dictionaries!
+
+    NB3: In the common case of a non-overloaded, but perhpas-polymorphic
+         specialisation, we don't need to bind *any* dictionaries for use
+         in the RHS. For example (Trac #8331)
+             {-# SPECIALIZE INLINE useAbstractMonad :: ReaderST s Int #-}
+             useAbstractMonad :: MonadAbstractIOST m => m Int
+         Here, deriving (MonadAbstractIOST (ReaderST s)) is a lot of code
+         but the RHS uses no dictionaries, so we want to end up with
+             RULE forall s (d :: MonadBstractIOST (ReaderT s)).
+                useAbstractMonad (ReaderT s) d = $suseAbstractMonad s
+
+   Trac #8848 is a good example of where there are some intersting
+   dictionary bindings to discard.
+
+The drop_dicts algorithm is based on these observations:
+
+  * Given (let d = rhs in e) where d is a DictId,
+    matching 'e' will bind e's free variables.
+
+  * So we want to keep the binding if one of the needed variables (for
+    which we need a binding) is in fv(rhs) but not already in fv(e).
+
+  * The "needed variables" are simply the orig_bndrs.  Consider
+       f :: (Eq a, Show b) => a -> b -> String
+       {-# SPECIALISE f :: (Show b) => Int -> b -> String
+    Then orig_bndrs includes the *quantified* dictionaries of the type
+    namely (dsb::Show b), but not the one for Eq Int
+
+So we work inside out, applying the above criterion at each step.
+
+
+Note [Simplify rule LHS]
+~~~~~~~~~~~~~~~~~~~~~~~~
+simplOptExpr occurrence-analyses and simplifies the LHS:
+
+   (a) Inline any remaining dictionary bindings (which hopefully 
+       occur just once)
+
+   (b) Substitute trivial lets so that they don't get in the way
+       Note that we substitute the function too; we might 
+       have this as a LHS:  let f71 = M.f Int in f71
+
+   (c) Do eta reduction.  To see why, consider the fold/build rule, 
+       which without simplification looked like:
+          fold k z (build (/\a. g a))  ==>  ...
+       This doesn't match unless you do eta reduction on the build argument.
+       Similarly for a LHS like
+       	 augment g (build h) 
+       we do not want to get
+       	 augment (\a. g a) (build h)
+       otherwise we don't match when given an argument like
+          augment (\a. h a a) (build h)
 
 Note [Matching seqId]
 ~~~~~~~~~~~~~~~~~~~
@@ -671,8 +771,8 @@ the constraint is unused.  We could bind 'd' to (error "unused")
 but it seems better to reject the program because it's almost certainly
 a mistake.  That's what the isDeadBinder call detects.
 
-Note [Constant rule dicts]
-~~~~~~~~~~~~~~~~~~~~~~~~~~
+Note [Free dictionaries]
+~~~~~~~~~~~~~~~~~~~~~~~~
 When the LHS of a specialisation rule, (/\as\ds. f es) has a free dict, 
 which is presumably in scope at the function definition site, we can quantify 
 over it too.  *Any* dict with that type will do.
diff --git a/compiler/deSugar/DsCCall.lhs b/compiler/deSugar/DsCCall.lhs
index f3f0adc66871..a47b9ea4ddb9 100644
--- a/compiler/deSugar/DsCCall.lhs
+++ b/compiler/deSugar/DsCCall.lhs
@@ -6,7 +6,8 @@
 Desugaring foreign calls
 
 \begin{code}
-{-# OPTIONS -fno-warn-tabs #-}
+{-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
 -- The above warning supression flag is a temporary kludge.
 -- While working on this module you are encouraged to remove it and
 -- detab the module (please do the detabbing in a separate patch). See
@@ -32,7 +33,6 @@ import CoreUtils
 import MkCore
 import Var
 import MkId
-import Maybes
 import ForeignCall
 import DataCon
 
@@ -50,6 +50,8 @@ import VarSet
 import DynFlags
 import Outputable
 import Util
+
+import Data.Maybe
 \end{code}
 
 Desugaring of @ccall@s consists of adding some state manipulation,
@@ -177,7 +179,7 @@ unboxArg arg
   --	data MutableByteArray s ix = MutableByteArray ix ix (MutableByteArray# s)
   | is_product_type &&
     data_con_arity == 3 &&
-    maybeToBool maybe_arg3_tycon &&
+    isJust maybe_arg3_tycon &&
     (arg3_tycon ==  byteArrayPrimTyCon ||
      arg3_tycon ==  mutableByteArrayPrimTyCon)
   = do case_bndr <- newSysLocalDs arg_ty
@@ -192,7 +194,7 @@ unboxArg arg
   where
     arg_ty					= exprType arg
     maybe_product_type 			   	= splitDataProductType_maybe arg_ty
-    is_product_type			   	= maybeToBool maybe_product_type
+    is_product_type			   	= isJust maybe_product_type
     Just (_, _, data_con, data_con_arg_tys)	= maybe_product_type
     data_con_arity				= dataConSourceArity data_con
     (data_con_arg_ty1 : _)			= data_con_arg_tys
@@ -236,9 +238,9 @@ boxResult result_ty
 		     _ -> []
 
 	      return_result state anss
-		= mkConApp (tupleCon UnboxedTuple (2 + length extra_result_tys))
-	         	   (map Type (realWorldStatePrimTy : io_res_ty : extra_result_tys)
-			      ++ (state : anss)) 
+		= mkCoreConApps (tupleCon UnboxedTuple (2 + length extra_result_tys))
+	         	        (map Type (realWorldStatePrimTy : io_res_ty : extra_result_tys)
+			         ++ (state : anss)) 
 
 	; (ccall_res_ty, the_alt) <- mk_alt return_result res
 
diff --git a/compiler/deSugar/DsExpr.lhs b/compiler/deSugar/DsExpr.lhs
index 546a198ca859..2a2d73399562 100644
--- a/compiler/deSugar/DsExpr.lhs
+++ b/compiler/deSugar/DsExpr.lhs
@@ -6,6 +6,8 @@
 Desugaring exporessions.
 
 \begin{code}
+{-# LANGUAGE CPP #-}
+
 module DsExpr ( dsExpr, dsLExpr, dsLocalBinds, dsValBinds, dsLit ) where
 
 #include "HsVersions.h"
@@ -99,7 +101,7 @@ ds_val_bind :: (RecFlag, LHsBinds Id) -> CoreExpr -> DsM CoreExpr
 -- a tuple and doing selections.
 -- Silently ignore INLINE and SPECIALISE pragmas...
 ds_val_bind (NonRecursive, hsbinds) body
-  | [(_, L loc bind)] <- bagToList hsbinds,
+  | [L loc bind] <- bagToList hsbinds,
         -- Non-recursive, non-overloaded bindings only come in ones
         -- ToDo: in some bizarre case it's conceivable that there
         --       could be dict binds in the 'binds'.  (See the notes
@@ -130,11 +132,11 @@ dsStrictBind :: HsBind Id -> CoreExpr -> DsM CoreExpr
 dsStrictBind (AbsBinds { abs_tvs = [], abs_ev_vars = []
                , abs_exports = exports
                , abs_ev_binds = ev_binds
-               , abs_binds = binds }) body
+               , abs_binds = lbinds }) body
   = do { let body1 = foldr bind_export body exports
              bind_export export b = bindNonRec (abe_poly export) (Var (abe_mono export)) b
-       ; body2 <- foldlBagM (\body (_, bind) -> dsStrictBind (unLoc bind) body)
-                            body1 binds 
+       ; body2 <- foldlBagM (\body lbind -> dsStrictBind (unLoc lbind) body)
+                            body1 lbinds 
        ; ds_binds <- dsTcEvBinds ev_binds
        ; return (mkCoreLets ds_binds body2) }
 
@@ -163,11 +165,11 @@ dsStrictBind bind body = pprPanic "dsLet: unlifted" (ppr bind $$ ppr body)
 
 ----------------------
 strictMatchOnly :: HsBind Id -> Bool
-strictMatchOnly (AbsBinds { abs_binds = binds })
-  = anyBag (strictMatchOnly . unLoc . snd) binds
-strictMatchOnly (PatBind { pat_lhs = lpat, pat_rhs_ty = ty })
-  =  isUnLiftedType ty 
-  || isBangLPat lpat   
+strictMatchOnly (AbsBinds { abs_binds = lbinds })
+  = anyBag (strictMatchOnly . unLoc) lbinds
+strictMatchOnly (PatBind { pat_lhs = lpat, pat_rhs_ty = rhs_ty })
+  =  isUnLiftedType rhs_ty
+  || isStrictLPat lpat
   || any (isUnLiftedType . idType) (collectPatBinders lpat)
 strictMatchOnly (FunBind { fun_id = L _ id })
   = isUnLiftedType (idType id)
@@ -290,9 +292,9 @@ dsExpr (ExplicitTuple tup_args boxity)
        ; (lam_vars, args) <- foldM go ([], []) (reverse tup_args)
                 -- The reverse is because foldM goes left-to-right
 
-       ; return $ mkCoreLams lam_vars $ 
-                  mkConApp (tupleCon (boxityNormalTupleSort boxity) (length tup_args))
-                           (map (Type . exprType) args ++ args) }
+       ; return $ mkCoreLams lam_vars $
+                  mkCoreConApps (tupleCon (boxityNormalTupleSort boxity) (length tup_args))
+                                (map (Type . exprType) args ++ args) }
 
 dsExpr (HsSCC cc expr@(L loc _)) = do
     mod_name <- getModule
@@ -433,7 +435,7 @@ dsExpr (RecordCon (L _ data_con_id) con_expr rbinds) = do
                 then mapM unlabelled_bottom arg_tys
                 else mapM mk_arg (zipEqual "dsExpr:RecordCon" arg_tys labels)
     
-    return (mkApps con_expr' con_args)
+    return (mkCoreApps con_expr' con_args)
 \end{code}
 
 Record update is a little harder. Suppose we have the decl:
@@ -488,7 +490,7 @@ dsExpr expr@(RecordUpd record_expr (HsRecFields { rec_flds = fields })
         -- constructor aguments.
         ; alts <- mapM (mk_alt upd_fld_env) cons_to_upd
         ; ([discrim_var], matching_code) 
-                <- matchWrapper RecUpd (MG { mg_alts = alts, mg_arg_tys = [in_ty], mg_res_ty = out_ty })
+                <- matchWrapper RecUpd (MG { mg_alts = alts, mg_arg_tys = [in_ty], mg_res_ty = out_ty, mg_origin = Generated })
 
         ; return (add_field_binds field_binds' $
                   bindNonRec discrim_var record_expr' matching_code) }
@@ -548,7 +550,7 @@ dsExpr expr@(RecordUpd record_expr (HsRecFields { rec_flds = fields })
                                          , pat_dicts = eqs_vars ++ theta_vars
                                          , pat_binds = emptyTcEvBinds
                                          , pat_args = PrefixCon $ map nlVarPat arg_ids
-                                         , pat_ty = in_ty
+                                         , pat_arg_tys = in_inst_tys
                                          , pat_wrap = idHsWrapper }
            ; let wrapped_rhs | null eq_spec = rhs
                              | otherwise    = mkLHsWrap (mkWpCast (mkTcSubCo wrap_co)) rhs
@@ -789,7 +791,8 @@ dsDo stmts
         rets         = map noLoc rec_rets
         mfix_app     = nlHsApp (noLoc mfix_op) mfix_arg
         mfix_arg     = noLoc $ HsLam (MG { mg_alts = [mkSimpleMatch [mfix_pat] body]
-                                         , mg_arg_tys = [tup_ty], mg_res_ty = body_ty })
+                                         , mg_arg_tys = [tup_ty], mg_res_ty = body_ty
+                                         , mg_origin = Generated })
         mfix_pat     = noLoc $ LazyPat $ mkBigLHsPatTup rec_tup_pats
         body         = noLoc $ HsDo DoExpr (rec_stmts ++ [ret_stmt]) body_ty
         ret_app      = nlHsApp (noLoc return_op) (mkBigLHsTup rets)
diff --git a/compiler/deSugar/DsForeign.lhs b/compiler/deSugar/DsForeign.lhs
index e2f4f4ff3cd3..c60e9146bca9 100644
--- a/compiler/deSugar/DsForeign.lhs
+++ b/compiler/deSugar/DsForeign.lhs
@@ -6,6 +6,8 @@
 Desugaring foreign declarations (see also DsCCall).
 
 \begin{code}
+{-# LANGUAGE CPP #-}
+
 module DsForeign ( dsForeigns
                  , dsForeigns'
                  , dsFImport, dsCImport, dsFCall, dsPrimCall
@@ -222,9 +224,9 @@ dsFCall fn_id co fcall mDeclHeader = do
     dflags <- getDynFlags
     (fcall', cDoc) <-
               case fcall of
-              CCall (CCallSpec (StaticTarget cName mPackageId isFun) CApiConv safety) ->
+              CCall (CCallSpec (StaticTarget cName mPackageKey isFun) CApiConv safety) ->
                do wrapperName <- mkWrapperName "ghc_wrapper" (unpackFS cName)
-                  let fcall' = CCall (CCallSpec (StaticTarget wrapperName mPackageId True) CApiConv safety)
+                  let fcall' = CCall (CCallSpec (StaticTarget wrapperName mPackageKey True) CApiConv safety)
                       c = includes
                        $$ fun_proto <+> braces (cRet <> semi)
                       includes = vcat [ text "#include <" <> ftext h <> text ">"
diff --git a/compiler/deSugar/DsGRHSs.lhs b/compiler/deSugar/DsGRHSs.lhs
index 4573e54ce0af..a571e807d4bf 100644
--- a/compiler/deSugar/DsGRHSs.lhs
+++ b/compiler/deSugar/DsGRHSs.lhs
@@ -6,6 +6,8 @@
 Matching guarded right-hand-sides (GRHSs)
 
 \begin{code}
+{-# LANGUAGE CPP #-}
+
 module DsGRHSs ( dsGuarded, dsGRHSs, dsGRHS ) where
 
 #include "HsVersions.h"
@@ -61,10 +63,8 @@ dsGRHSs hs_ctx _ (GRHSs grhss binds) rhs_ty
   = ASSERT( notNull grhss )
     do { match_results <- mapM (dsGRHS hs_ctx rhs_ty) grhss
        ; let match_result1 = foldr1 combineMatchResults match_results
-             match_result2 = adjustMatchResultDs
-                                 (\e -> dsLocalBinds binds e)
-                                 match_result1
-                -- NB: nested dsLet inside matchResult
+             match_result2 = adjustMatchResultDs (dsLocalBinds binds) match_result1
+                             -- NB: nested dsLet inside matchResult
        ; return match_result2 }
 
 dsGRHS :: HsMatchContext Name -> Type -> LGRHS Id (LHsExpr Id) -> DsM MatchResult
diff --git a/compiler/deSugar/DsListComp.lhs b/compiler/deSugar/DsListComp.lhs
index a1131a812672..2111c95f8285 100644
--- a/compiler/deSugar/DsListComp.lhs
+++ b/compiler/deSugar/DsListComp.lhs
@@ -6,7 +6,7 @@
 Desugaring list comprehensions, monad comprehensions and array comprehensions
 
 \begin{code}
-{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE CPP, NamedFieldPuns #-}
 
 module DsListComp ( dsListComp, dsPArrComp, dsMonadComp ) where
 
diff --git a/compiler/deSugar/DsMeta.hs b/compiler/deSugar/DsMeta.hs
index 56fba1434f3b..28e6feffece2 100644
--- a/compiler/deSugar/DsMeta.hs
+++ b/compiler/deSugar/DsMeta.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE CPP #-}
+
 -----------------------------------------------------------------------------
 --
 -- (c) The University of Glasgow 2006
@@ -277,7 +279,7 @@ repFamilyDecl (L loc (FamilyDecl { fdInfo    = info,
                                    fdKindSig = opt_kind }))
   = do { tc1 <- lookupLOcc tc           -- See note [Binders and occurrences]
        ; dec <- addTyClTyVarBinds tvs $ \bndrs ->
-           case (opt_kind, info) of 
+           case (opt_kind, info) of
                   (Nothing, ClosedTypeFamily eqns) ->
                     do { eqns1 <- mapM repTyFamEqn eqns
                        ; eqns2 <- coreList tySynEqnQTyConName eqns1
@@ -286,13 +288,13 @@ repFamilyDecl (L loc (FamilyDecl { fdInfo    = info,
                     do { eqns1 <- mapM repTyFamEqn eqns
                        ; eqns2 <- coreList tySynEqnQTyConName eqns1
                        ; ki1 <- repLKind ki
-                       ; repClosedFamilyKind tc1 bndrs ki1 eqns2 }              
+                       ; repClosedFamilyKind tc1 bndrs ki1 eqns2 }
                   (Nothing, _) ->
                     do { info' <- repFamilyInfo info
                        ; repFamilyNoKind info' tc1 bndrs }
                   (Just ki, _) ->
                     do { info' <- repFamilyInfo info
-                       ; ki1 <- repLKind ki 
+                       ; ki1 <- repLKind ki
                        ; repFamilyKind info' tc1 bndrs ki1 }
        ; return (loc, dec)
        }
@@ -389,15 +391,15 @@ repClsInstD (ClsInstDecl { cid_poly_ty = ty, cid_binds = binds
 repTyFamInstD :: TyFamInstDecl Name -> DsM (Core TH.DecQ)
 repTyFamInstD decl@(TyFamInstDecl { tfid_eqn = eqn })
   = do { let tc_name = tyFamInstDeclLName decl
-       ; tc <- lookupLOcc tc_name               -- See note [Binders and occurrences]  
+       ; tc <- lookupLOcc tc_name               -- See note [Binders and occurrences]
        ; eqn1 <- repTyFamEqn eqn
        ; repTySynInst tc eqn1 }
 
 repTyFamEqn :: LTyFamInstEqn Name -> DsM (Core TH.TySynEqnQ)
-repTyFamEqn (L loc (TyFamInstEqn { tfie_pats = HsWB { hswb_cts = tys
-                                                    , hswb_kvs = kv_names
-                                                    , hswb_tvs = tv_names }
-                                 , tfie_rhs = rhs }))
+repTyFamEqn (L loc (TyFamEqn { tfe_pats = HsWB { hswb_cts = tys
+                                               , hswb_kvs = kv_names
+                                               , hswb_tvs = tv_names }
+                                 , tfe_rhs = rhs }))
   = do { let hs_tvs = HsQTvs { hsq_kvs = kv_names
                              , hsq_tvs = userHsTyVarBndrs loc tv_names }   -- Yuk
        ; addTyClTyVarBinds hs_tvs $ \ _ ->
@@ -705,12 +707,14 @@ addTyVarBinds :: LHsTyVarBndrs Name                            -- the binders to
 -- the computations passed as the second argument is executed in that extended
 -- meta environment and gets the *new* names on Core-level as an argument
 
-addTyVarBinds tvs m
-  = do { freshNames <- mkGenSyms (hsLKiTyVarNames tvs)
-       ; term <- addBinds freshNames $
-                 do { kbs <- repList tyVarBndrTyConName mk_tv_bndr (hsQTvBndrs tvs `zip` freshNames)
+addTyVarBinds (HsQTvs { hsq_kvs = kvs, hsq_tvs = tvs }) m
+  = do { fresh_kv_names <- mkGenSyms kvs
+       ; fresh_tv_names <- mkGenSyms (map hsLTyVarName tvs)
+       ; let fresh_names = fresh_kv_names ++ fresh_tv_names
+       ; term <- addBinds fresh_names $
+                 do { kbs <- repList tyVarBndrTyConName mk_tv_bndr (tvs `zip` fresh_tv_names)
                     ; m kbs }
-       ; wrapGenSyms freshNames term }
+       ; wrapGenSyms fresh_names term }
   where
     mk_tv_bndr (tv, (_,v)) = repTyVarBndrWithKind tv (coreVar v)
 
@@ -754,31 +758,9 @@ repLContext :: LHsContext Name -> DsM (Core TH.CxtQ)
 repLContext (L _ ctxt) = repContext ctxt
 
 repContext :: HsContext Name -> DsM (Core TH.CxtQ)
-repContext ctxt = do preds <- repList predQTyConName repLPred ctxt
+repContext ctxt = do preds <- repList typeQTyConName repLTy ctxt
                      repCtxt preds
 
--- represent a type predicate
---
-repLPred :: LHsType Name -> DsM (Core TH.PredQ)
-repLPred (L _ p) = repPred p
-
-repPred :: HsType Name -> DsM (Core TH.PredQ)
-repPred (HsParTy ty) 
-  = repLPred ty
-repPred ty
-  | Just (cls, tys) <- splitHsClassTy_maybe ty
-  = do
-      cls1 <- lookupOcc cls
-      tys1 <- repList typeQTyConName repLTy tys
-      repClassP cls1 tys1
-repPred (HsEqTy tyleft tyright)
-  = do
-      tyleft1  <- repLTy tyleft
-      tyright1 <- repLTy tyright
-      repEqualP tyleft1 tyright1
-repPred ty
-  = notHandled "Exotic predicate type" (ppr ty)
-
 -- yield the representation of a list of types
 --
 repLTys :: [LHsType Name] -> DsM [Core TH.TypeQ]
@@ -833,6 +815,11 @@ repTy (HsTupleTy _ tys)     = do tys1 <- repLTys tys
 repTy (HsOpTy ty1 (_, n) ty2) = repLTy ((nlHsTyVar (unLoc n) `nlHsAppTy` ty1)
                                    `nlHsAppTy` ty2)
 repTy (HsParTy t)           = repLTy t
+repTy (HsEqTy t1 t2) = do
+                         t1' <- repLTy t1
+                         t2' <- repLTy t2
+                         eq  <- repTequality
+                         repTapps eq [t1', t2']
 repTy (HsKindSig t k)       = do
                                 t1 <- repLTy t
                                 k1 <- repLKind k
@@ -848,6 +835,7 @@ repTy (HsExplicitTupleTy _ tys) = do
 repTy (HsTyLit lit) = do
                         lit' <- repTyLit lit
                         repTLit lit'
+                          
 repTy ty                      = notHandled "Exotic form of type" (ppr ty)
 
 repTyLit :: HsTyLit -> DsM (Core TH.TyLitQ)
@@ -1196,7 +1184,7 @@ rep_binds binds = do { binds_w_locs <- rep_binds' binds
                      ; return (de_loc (sort_by_loc binds_w_locs)) }
 
 rep_binds' :: LHsBinds Name -> DsM [(SrcSpan, Core TH.DecQ)]
-rep_binds' binds = mapM (rep_bind . snd) (bagToList binds)
+rep_binds' = mapM rep_bind . bagToList
 
 rep_bind :: LHsBind Name -> DsM (SrcSpan, Core TH.DecQ)
 -- Assumes: all the binders of the binding are alrady in the meta-env
@@ -1238,7 +1226,7 @@ rep_bind (L _ (VarBind { var_id = v, var_rhs = e}))
         ; return (srcLocSpan (getSrcLoc v), ans) }
 
 rep_bind (L _ (AbsBinds {}))  = panic "rep_bind: AbsBinds"
-rep_bind (L _ (PatSynBind {})) = panic "rep_bind: PatSynBind"
+rep_bind (L _ dec@(PatSynBind {})) = notHandled "pattern synonyms" (ppr dec)
 -----------------------------------------------------------------------------
 -- Since everything in a Bind is mutually recursive we need rename all
 -- all the variables simultaneously. For example:
@@ -1428,7 +1416,7 @@ globalVar name
   where
       mod = ASSERT( isExternalName name) nameModule name
       name_mod = moduleNameString (moduleName mod)
-      name_pkg = packageIdString (modulePackageId mod)
+      name_pkg = packageKeyString (modulePackageKey mod)
       name_occ = nameOccName name
       mk_varg | OccName.isDataOcc name_occ = mkNameG_dName
               | OccName.isVarOcc  name_occ = mkNameG_vName
@@ -1488,7 +1476,7 @@ rep2 n xs = do { id <- dsLookupGlobalId n
 
 dataCon' :: Name -> [CoreExpr] -> DsM (Core a)
 dataCon' n args = do { id <- dsLookupDataCon n
-                     ; return $ MkC $ mkConApp id args }
+                     ; return $ MkC $ mkCoreConApps id args }
 
 dataCon :: Name -> DsM (Core a)
 dataCon n = dataCon' n []
@@ -1772,12 +1760,6 @@ repProto (MkC s) (MkC ty) = rep2 sigDName [s, ty]
 repCtxt :: Core [TH.PredQ] -> DsM (Core TH.CxtQ)
 repCtxt (MkC tys) = rep2 cxtName [tys]
 
-repClassP :: Core TH.Name -> Core [TH.TypeQ] -> DsM (Core TH.PredQ)
-repClassP (MkC cla) (MkC tys) = rep2 classPName [cla, tys]
-
-repEqualP :: Core TH.TypeQ -> Core TH.TypeQ -> DsM (Core TH.PredQ)
-repEqualP (MkC ty1) (MkC ty2) = rep2 equalPName [ty1, ty2]
-
 repConstr :: Core TH.Name -> HsConDeclDetails Name
           -> DsM (Core TH.ConQ)
 repConstr con (PrefixCon ps)
@@ -1816,6 +1798,9 @@ repTapps f (t:ts) = do { f1 <- repTapp f t; repTapps f1 ts }
 repTSig :: Core TH.TypeQ -> Core TH.Kind -> DsM (Core TH.TypeQ)
 repTSig (MkC ty) (MkC ki) = rep2 sigTName [ty, ki]
 
+repTequality :: DsM (Core TH.TypeQ)
+repTequality = rep2 equalityTName []
+
 repTPromotedList :: [Core TH.TypeQ] -> DsM (Core TH.TypeQ)
 repTPromotedList []     = repPromotedNilTyCon
 repTPromotedList (t:ts) = do  { tcon <- repPromotedConsTyCon
@@ -2069,8 +2054,6 @@ templateHaskellNames = [
     roleAnnotDName,
     -- Cxt
     cxtName,
-    -- Pred
-    classPName, equalPName,
     -- Strict
     isStrictName, notStrictName, unpackedName,
     -- Con
@@ -2080,7 +2063,7 @@ templateHaskellNames = [
     -- VarStrictType
     varStrictTypeName,
     -- Type
-    forallTName, varTName, conTName, appTName,
+    forallTName, varTName, conTName, appTName, equalityTName,
     tupleTName, unboxedTupleTName, arrowTName, listTName, sigTName, litTName,
     promotedTName, promotedTupleTName, promotedNilTName, promotedConsTName,
     -- TyLit
@@ -2134,7 +2117,7 @@ thLib = mkTHModule (fsLit "Language.Haskell.TH.Lib")
 qqLib = mkTHModule (fsLit "Language.Haskell.TH.Quote")
 
 mkTHModule :: FastString -> Module
-mkTHModule m = mkModule thPackageId (mkModuleNameFS m)
+mkTHModule m = mkModule thPackageKey (mkModuleNameFS m)
 
 libFun, libTc, thFun, thTc, thCon, qqFun :: FastString -> Unique -> Name
 libFun = mk_known_key_name OccName.varName  thLib
@@ -2323,11 +2306,6 @@ roleAnnotDName    = libFun (fsLit "roleAnnotD")    roleAnnotDIdKey
 cxtName :: Name
 cxtName = libFun (fsLit "cxt") cxtIdKey
 
--- data Pred = ...
-classPName, equalPName :: Name
-classPName = libFun (fsLit "classP") classPIdKey
-equalPName = libFun (fsLit "equalP") equalPIdKey
-
 -- data Strict = ...
 isStrictName, notStrictName, unpackedName :: Name
 isStrictName      = libFun  (fsLit "isStrict")      isStrictKey
@@ -2351,7 +2329,7 @@ varStrictTypeName = libFun  (fsLit "varStrictType") varStrictTKey
 
 -- data Type = ...
 forallTName, varTName, conTName, tupleTName, unboxedTupleTName, arrowTName,
-    listTName, appTName, sigTName, litTName,
+    listTName, appTName, sigTName, equalityTName, litTName,
     promotedTName, promotedTupleTName,
     promotedNilTName, promotedConsTName :: Name
 forallTName         = libFun (fsLit "forallT")        forallTIdKey
@@ -2363,6 +2341,7 @@ arrowTName          = libFun (fsLit "arrowT")         arrowTIdKey
 listTName           = libFun (fsLit "listT")          listTIdKey
 appTName            = libFun (fsLit "appT")           appTIdKey
 sigTName            = libFun (fsLit "sigT")           sigTIdKey
+equalityTName       = libFun (fsLit "equalityT")      equalityTIdKey
 litTName            = libFun (fsLit "litT")           litTIdKey
 promotedTName       = libFun (fsLit "promotedT")      promotedTIdKey
 promotedTupleTName  = libFun (fsLit "promotedTupleT") promotedTupleTIdKey
@@ -2681,11 +2660,6 @@ roleAnnotDIdKey              = mkPreludeMiscIdUnique 352
 cxtIdKey :: Unique
 cxtIdKey            = mkPreludeMiscIdUnique 360
 
--- data Pred = ...
-classPIdKey, equalPIdKey :: Unique
-classPIdKey         = mkPreludeMiscIdUnique 361
-equalPIdKey         = mkPreludeMiscIdUnique 362
-
 -- data Strict = ...
 isStrictKey, notStrictKey, unpackedKey :: Unique
 isStrictKey         = mkPreludeMiscIdUnique 363
@@ -2709,7 +2683,7 @@ varStrictTKey     = mkPreludeMiscIdUnique 375
 
 -- data Type = ...
 forallTIdKey, varTIdKey, conTIdKey, tupleTIdKey, unboxedTupleTIdKey, arrowTIdKey,
-    listTIdKey, appTIdKey, sigTIdKey, litTIdKey,
+    listTIdKey, appTIdKey, sigTIdKey, equalityTIdKey, litTIdKey,
     promotedTIdKey, promotedTupleTIdKey,
     promotedNilTIdKey, promotedConsTIdKey :: Unique
 forallTIdKey        = mkPreludeMiscIdUnique 380
@@ -2721,21 +2695,22 @@ arrowTIdKey         = mkPreludeMiscIdUnique 385
 listTIdKey          = mkPreludeMiscIdUnique 386
 appTIdKey           = mkPreludeMiscIdUnique 387
 sigTIdKey           = mkPreludeMiscIdUnique 388
-litTIdKey           = mkPreludeMiscIdUnique 389
-promotedTIdKey      = mkPreludeMiscIdUnique 390
-promotedTupleTIdKey = mkPreludeMiscIdUnique 391
-promotedNilTIdKey   = mkPreludeMiscIdUnique 392
-promotedConsTIdKey  = mkPreludeMiscIdUnique 393
+equalityTIdKey      = mkPreludeMiscIdUnique 389
+litTIdKey           = mkPreludeMiscIdUnique 390
+promotedTIdKey      = mkPreludeMiscIdUnique 391
+promotedTupleTIdKey = mkPreludeMiscIdUnique 392
+promotedNilTIdKey   = mkPreludeMiscIdUnique 393
+promotedConsTIdKey  = mkPreludeMiscIdUnique 394
 
 -- data TyLit = ...
 numTyLitIdKey, strTyLitIdKey :: Unique
-numTyLitIdKey = mkPreludeMiscIdUnique 394
-strTyLitIdKey = mkPreludeMiscIdUnique 395
+numTyLitIdKey = mkPreludeMiscIdUnique 395
+strTyLitIdKey = mkPreludeMiscIdUnique 396
 
 -- data TyVarBndr = ...
 plainTVIdKey, kindedTVIdKey :: Unique
-plainTVIdKey       = mkPreludeMiscIdUnique 396
-kindedTVIdKey      = mkPreludeMiscIdUnique 397
+plainTVIdKey       = mkPreludeMiscIdUnique 397
+kindedTVIdKey      = mkPreludeMiscIdUnique 398
 
 -- data Role = ...
 nominalRIdKey, representationalRIdKey, phantomRIdKey, inferRIdKey :: Unique
diff --git a/compiler/deSugar/DsMonad.lhs b/compiler/deSugar/DsMonad.lhs
index b590f4b2d29d..c017a7cc0191 100644
--- a/compiler/deSugar/DsMonad.lhs
+++ b/compiler/deSugar/DsMonad.lhs
@@ -6,6 +6,8 @@
 @DsMonad@: monadery used in desugaring
 
 \begin{code}
+{-# LANGUAGE FlexibleInstances #-}
+
 module DsMonad (
         DsM, mapM, mapAndUnzipM,
         initDs, initDsTc, fixDs,
diff --git a/compiler/deSugar/DsUtils.lhs b/compiler/deSugar/DsUtils.lhs
index 2ad70c67d360..c52b917efd2e 100644
--- a/compiler/deSugar/DsUtils.lhs
+++ b/compiler/deSugar/DsUtils.lhs
@@ -8,7 +8,8 @@ Utilities for desugaring
 This module exports some utility functions of no great interest.
 
 \begin{code}
-{-# OPTIONS -fno-warn-tabs #-}
+{-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
 -- The above warning supression flag is a temporary kludge.
 -- While working on this module you are encouraged to remove it and
 -- detab the module (please do the detabbing in a separate patch). See
@@ -64,7 +65,6 @@ import ConLike
 import DataCon
 import PatSyn
 import Type
-import Coercion
 import TysPrim
 import TysWiredIn
 import BasicTypes
@@ -638,12 +638,13 @@ mkSelectorBinds ticks pat val_expr
         -- efficient too.
 
         -- For the error message we make one error-app, to avoid duplication.
-        -- But we need it at different types... so we use coerce for that
-       ; err_expr <- mkErrorAppDs iRREFUT_PAT_ERROR_ID  unitTy (ppr pat)
-       ; err_var <- newSysLocalDs unitTy
-       ; binds <- zipWithM (mk_bind val_var err_var) ticks' binders
-       ; return ( (val_var, val_expr) : 
-                  (err_var, err_expr) :
+        -- But we need it at different types, so we make it polymorphic:
+        --     err_var = /\a. iRREFUT_PAT_ERR a "blah blah blah"
+       ; err_app <- mkErrorAppDs iRREFUT_PAT_ERROR_ID alphaTy (ppr pat)
+       ; err_var <- newSysLocalDs (mkForAllTy alphaTyVar alphaTy)
+       ; binds   <- zipWithM (mk_bind val_var err_var) ticks' binders
+       ; return ( (val_var, val_expr) :
+                  (err_var, Lam alphaTyVar err_app) :
                   binds ) }
 
   | otherwise
@@ -665,14 +666,13 @@ mkSelectorBinds ticks pat val_expr
 
     mk_bind scrut_var err_var tick bndr_var = do
     -- (mk_bind sv err_var) generates
-    --          bv = case sv of { pat -> bv; other -> coerce (type-of-bv) err_var }
+    --          bv = case sv of { pat -> bv; other -> err_var @ type-of-bv }
     -- Remember, pat binds bv
         rhs_expr <- matchSimply (Var scrut_var) PatBindRhs pat
                                 (Var bndr_var) error_expr
         return (bndr_var, mkOptTickBox tick rhs_expr)
       where
-        error_expr = mkCast (Var err_var) co
-        co         = mkUnsafeCo (exprType (Var err_var)) (idType bndr_var)
+        error_expr = Var err_var `App` Type (idType bndr_var)
 
     is_simple_lpat p = is_simple_pat (unLoc p)
 
@@ -709,8 +709,7 @@ mkLHsVarPatTup bs  = mkLHsPatTup (map nlVarPat bs)
 
 mkVanillaTuplePat :: [OutPat Id] -> Boxity -> Pat Id
 -- A vanilla tuple pattern simply gets its type from its sub-patterns
-mkVanillaTuplePat pats box 
-  = TuplePat pats box (mkTupleTy (boxityNormalTupleSort box) (map hsLPatType pats))
+mkVanillaTuplePat pats box = TuplePat pats box (map hsLPatType pats)
 
 -- The Big equivalents for the source tuple expressions
 mkBigLHsVarTup :: [Id] -> LHsExpr Id
diff --git a/compiler/deSugar/Match.lhs b/compiler/deSugar/Match.lhs
index 0433d873d55a..a14027862a70 100644
--- a/compiler/deSugar/Match.lhs
+++ b/compiler/deSugar/Match.lhs
@@ -6,6 +6,8 @@
 The @match@ function
 
 \begin{code}
+{-# LANGUAGE CPP #-}
+
 module Match ( match, matchEquations, matchWrapper, matchSimply, matchSinglePat ) where
 
 #include "HsVersions.h"
@@ -40,7 +42,7 @@ import Maybes
 import Util
 import Name
 import Outputable
-import BasicTypes ( boxityNormalTupleSort )
+import BasicTypes ( boxityNormalTupleSort, isGenerated )
 import FastString
 
 import Control.Monad( when )
@@ -552,9 +554,8 @@ tidy1 v (LazyPat pat)
 tidy1 _ (ListPat pats ty Nothing)
   = return (idDsWrapper, unLoc list_ConPat)
   where
-    list_ty     = mkListTy ty
-    list_ConPat = foldr (\ x y -> mkPrefixConPat consDataCon [x, y] list_ty)
-                        (mkNilPat list_ty)
+    list_ConPat = foldr (\ x y -> mkPrefixConPat consDataCon [x, y] [ty])
+                        (mkNilPat ty)
                         pats
 
 -- Introduce fake parallel array constructors to be able to handle parallel
@@ -563,13 +564,13 @@ tidy1 _ (PArrPat pats ty)
   = return (idDsWrapper, unLoc parrConPat)
   where
     arity      = length pats
-    parrConPat = mkPrefixConPat (parrFakeCon arity) pats (mkPArrTy ty)
+    parrConPat = mkPrefixConPat (parrFakeCon arity) pats [ty]
 
-tidy1 _ (TuplePat pats boxity ty)
+tidy1 _ (TuplePat pats boxity tys)
   = return (idDsWrapper, unLoc tuple_ConPat)
   where
     arity = length pats
-    tuple_ConPat = mkPrefixConPat (tupleCon (boxityNormalTupleSort boxity) arity) pats ty
+    tuple_ConPat = mkPrefixConPat (tupleCon (boxityNormalTupleSort boxity) arity) pats tys
 
 -- LitPats: we *might* be able to replace these w/ a simpler form
 tidy1 _ (LitPat lit)
@@ -586,8 +587,6 @@ tidy1 _ non_interesting_pat
 
 --------------------
 tidy_bang_pat :: Id -> SrcSpan -> Pat Id -> DsM (DsWrapper, Pat Id)
--- BangPatterns: Pattern matching is already strict in constructors,
--- tuples etc, so the last case strips off the bang for those patterns.
 
 -- Discard bang around strict pattern
 tidy_bang_pat v _ p@(ListPat {})   = tidy1 v p
@@ -596,8 +595,7 @@ tidy_bang_pat v _ p@(PArrPat {})   = tidy1 v p
 tidy_bang_pat v _ p@(ConPatOut {}) = tidy1 v p
 tidy_bang_pat v _ p@(LitPat {})    = tidy1 v p
 
--- Discard lazy/par/sig under a bang
-tidy_bang_pat v _ (LazyPat (L l p))     = tidy_bang_pat v l p
+-- Discard par/sig under a bang
 tidy_bang_pat v _ (ParPat (L l p))      = tidy_bang_pat v l p
 tidy_bang_pat v _ (SigPatOut (L l p) _) = tidy_bang_pat v l p
 
@@ -607,7 +605,10 @@ tidy_bang_pat v l (AsPat v' p)  = tidy1 v (AsPat v' (L l (BangPat p)))
 tidy_bang_pat v l (CoPat w p t) = tidy1 v (CoPat w (BangPat (L l p)) t)
 
 -- Default case, leave the bang there:
--- VarPat, WildPat, ViewPat, NPat, NPlusKPat
+-- VarPat, LazyPat, WildPat, ViewPat, NPat, NPlusKPat
+-- For LazyPat, remember that it's semantically like a VarPat
+--  i.e.  !(~p) is not like ~p, or p!  (Trac #8952)
+
 tidy_bang_pat _ l p = return (idDsWrapper, BangPat (L l p))
   -- NB: SigPatIn, ConPatIn should not happen
 \end{code}
@@ -752,12 +753,14 @@ JJQC 30-Nov-1997
 \begin{code}
 matchWrapper ctxt (MG { mg_alts = matches
                       , mg_arg_tys = arg_tys
-                      , mg_res_ty = rhs_ty })
+                      , mg_res_ty = rhs_ty
+                      , mg_origin = origin })
   = do  { eqns_info   <- mapM mk_eqn_info matches
         ; new_vars    <- case matches of
                            []    -> mapM newSysLocalDs arg_tys
                            (m:_) -> selectMatchVars (map unLoc (hsLMatchPats m))
-        ; result_expr <- matchEquations ctxt new_vars eqns_info rhs_ty
+        ; result_expr <- handleWarnings $
+                         matchEquations ctxt new_vars eqns_info rhs_ty
         ; return (new_vars, result_expr) }
   where
     mk_eqn_info (L _ (Match pats _ grhss))
@@ -765,6 +768,10 @@ matchWrapper ctxt (MG { mg_alts = matches
            ; match_result <- dsGRHSs ctxt upats grhss rhs_ty
            ; return (EqnInfo { eqn_pats = upats, eqn_rhs  = match_result}) }
 
+    handleWarnings = if isGenerated origin
+                     then discardWarningsDs
+                     else id
+
 
 matchEquations  :: HsMatchContext Name
                 -> [Id] -> [EquationInfo] -> Type
diff --git a/compiler/deSugar/MatchCon.lhs b/compiler/deSugar/MatchCon.lhs
index 2b51638bf36b..8e581f66e21a 100644
--- a/compiler/deSugar/MatchCon.lhs
+++ b/compiler/deSugar/MatchCon.lhs
@@ -6,7 +6,8 @@
 Pattern-matching constructors
 
 \begin{code}
-{-# OPTIONS -fno-warn-tabs #-}
+{-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
 -- The above warning supression flag is a temporary kludge.
 -- While working on this module you are encouraged to remove it and
 -- detab the module (please do the detabbing in a separate patch). See
@@ -124,7 +125,7 @@ matchOneConLike :: [Id]
                 -> [EquationInfo]
                 -> DsM (CaseAlt ConLike)
 matchOneConLike vars ty (eqn1 : eqns)	-- All eqns for a single constructor
-  = do	{ arg_vars <- selectConMatchVars arg_tys args1
+  = do	{ arg_vars <- selectConMatchVars val_arg_tys args1
 	 	-- Use the first equation as a source of 
 		-- suggestions for the new variables
 
@@ -140,27 +141,24 @@ matchOneConLike vars ty (eqn1 : eqns)	-- All eqns for a single constructor
                               alt_wrapper = wrapper1,
                               alt_result = foldr1 combineMatchResults match_results } }
   where
-    ConPatOut { pat_con = L _ con1, pat_ty = pat_ty1, pat_wrap = wrapper1,
+    ConPatOut { pat_con = L _ con1, pat_arg_tys = arg_tys, pat_wrap = wrapper1,
 	        pat_tvs = tvs1, pat_dicts = dicts1, pat_args = args1 }
 	      = firstPat eqn1
     fields1 = case con1 of
-        RealDataCon dcon1 -> dataConFieldLabels dcon1
-	PatSynCon{} -> []
-
-    arg_tys  = inst inst_tys
-      where
-        inst = case con1 of
-            RealDataCon dcon1 -> dataConInstOrigArgTys dcon1
-            PatSynCon psyn1 -> patSynInstArgTys psyn1
-    inst_tys = tcTyConAppArgs pat_ty1 ++ 
-	       mkTyVarTys (takeList exVars tvs1)
-	-- Newtypes opaque, hence tcTyConAppArgs
+        	RealDataCon dcon1 -> dataConFieldLabels dcon1
+        	PatSynCon{}       -> []
+
+    val_arg_tys = case con1 of
+                    RealDataCon dcon1 -> dataConInstOrigArgTys dcon1 inst_tys
+                    PatSynCon psyn1   -> patSynInstArgTys      psyn1 inst_tys
+    inst_tys = ASSERT( tvs1 `equalLength` ex_tvs )
+               arg_tys ++ mkTyVarTys tvs1
 	-- dataConInstOrigArgTys takes the univ and existential tyvars
 	-- and returns the types of the *value* args, which is what we want
-      where
-        exVars = case con1 of
-            RealDataCon dcon1 -> dataConExTyVars dcon1
-            PatSynCon psyn1 -> patSynExTyVars psyn1
+
+    ex_tvs = case con1 of
+               RealDataCon dcon1 -> dataConExTyVars dcon1
+               PatSynCon psyn1   -> patSynExTyVars psyn1
 
     match_group :: [Id] -> [(ConArgPats, EquationInfo)] -> DsM MatchResult
     -- All members of the group have compatible ConArgPats
@@ -178,7 +176,7 @@ matchOneConLike vars ty (eqn1 : eqns)	-- All eqns for a single constructor
            return ( wrapBinds (tvs `zip` tvs1)
                   . wrapBinds (ds  `zip` dicts1)
                   . mkCoreLets ds_bind
-                  , eqn { eqn_pats = conArgPats arg_tys args ++ pats }
+                  , eqn { eqn_pats = conArgPats val_arg_tys args ++ pats }
                   )
     shift (_, (EqnInfo { eqn_pats = ps })) = pprPanic "matchOneCon/shift" (ppr ps)
 
diff --git a/compiler/deSugar/MatchLit.lhs b/compiler/deSugar/MatchLit.lhs
index 7429a613d989..71a5e10636f6 100644
--- a/compiler/deSugar/MatchLit.lhs
+++ b/compiler/deSugar/MatchLit.lhs
@@ -6,6 +6,8 @@
 Pattern-matching literal patterns
 
 \begin{code}
+{-# LANGUAGE CPP, ScopedTypeVariables #-}
+
 module MatchLit ( dsLit, dsOverLit, hsLitKey, hsOverLitKey
                 , tidyLitPat, tidyNPat
                 , matchLiterals, matchNPlusKPats, matchNPats
@@ -90,7 +92,7 @@ dsLit (HsInt i)        = do dflags <- getDynFlags
 dsLit (HsRat r ty) = do
    num   <- mkIntegerExpr (numerator (fl_value r))
    denom <- mkIntegerExpr (denominator (fl_value r))
-   return (mkConApp ratio_data_con [Type integer_ty, num, denom])
+   return (mkCoreConApps ratio_data_con [Type integer_ty, num, denom])
   where
     (ratio_data_con, integer_ty)
         = case tcSplitTyConApp ty of
@@ -264,8 +266,8 @@ tidyLitPat :: HsLit -> Pat Id
 tidyLitPat (HsChar c) = unLoc (mkCharLitPat c)
 tidyLitPat (HsString s)
   | lengthFS s <= 1     -- Short string literals only
-  = unLoc $ foldr (\c pat -> mkPrefixConPat consDataCon [mkCharLitPat c, pat] stringTy)
-                  (mkNilPat stringTy) (unpackFS s)
+  = unLoc $ foldr (\c pat -> mkPrefixConPat consDataCon [mkCharLitPat c, pat] [charTy])
+                  (mkNilPat charTy) (unpackFS s)
         -- The stringTy is the type of the whole pattern, not
         -- the type to instantiate (:) or [] with!
 tidyLitPat lit = LitPat lit
@@ -297,7 +299,7 @@ tidyNPat tidy_lit_pat (OverLit val False _ ty) mb_neg _
   | isStringTy ty, Just str_lit <- mb_str_lit = tidy_lit_pat (HsString str_lit)
   where
     mk_con_pat :: DataCon -> HsLit -> Pat Id
-    mk_con_pat con lit = unLoc (mkPrefixConPat con [noLoc $ LitPat lit] ty)
+    mk_con_pat con lit = unLoc (mkPrefixConPat con [noLoc $ LitPat lit] [])
 
     mb_int_lit :: Maybe Integer
     mb_int_lit = case (mb_neg, val) of
diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in
index a5d9785a4307..5281b11b91d7 100644
--- a/compiler/ghc.cabal.in
+++ b/compiler/ghc.cabal.in
@@ -18,7 +18,7 @@ Description:
     through this package.
 Category: Development
 Build-Type: Simple
-Cabal-Version: >= 1.2.3
+Cabal-Version: >=1.10
 
 Flag ghci
     Description: Build GHCi support.
@@ -41,6 +41,7 @@ Flag stage3
     Manual: True
 
 Library
+    Default-Language: Haskell2010
     Exposed: False
 
     Build-Depends: base       >= 4   && < 5,
@@ -53,7 +54,9 @@ Library
                    filepath   >= 1   && < 1.4,
                    Cabal,
                    hpc,
-                   transformers
+                   transformers,
+                   bin-package-db,
+                   hoopl
 
     if flag(stage1) && impl(ghc < 7.5)
         Build-Depends: old-time   >= 1   && < 1.2
@@ -70,19 +73,44 @@ Library
         CPP-Options: -DGHCI
         Include-Dirs: ../rts/dist/build @FFIIncludeDir@
 
-    Build-Depends: bin-package-db
-    Build-Depends: hoopl
-
-    Extensions: CPP, MagicHash, UnboxedTuples, PatternGuards,
-                ForeignFunctionInterface, EmptyDataDecls,
-                TypeSynonymInstances, MultiParamTypeClasses,
-                FlexibleInstances, RankNTypes, ScopedTypeVariables,
-                DeriveDataTypeable, BangPatterns
-    if impl(ghc >= 7.1)
-        Extensions: NondecreasingIndentation
+    Other-Extensions:
+        BangPatterns
+        CPP
+        DataKinds
+        DeriveDataTypeable
+        DeriveFoldable
+        DeriveFunctor
+        DeriveTraversable
+        DisambiguateRecordFields
+        ExplicitForAll
+        FlexibleContexts
+        FlexibleInstances
+        GADTs
+        GeneralizedNewtypeDeriving
+        MagicHash
+        MultiParamTypeClasses
+        NamedFieldPuns
+        NondecreasingIndentation
+        RankNTypes
+        RecordWildCards
+        ScopedTypeVariables
+        StandaloneDeriving
+        Trustworthy
+        TupleSections
+        TypeFamilies
+        TypeSynonymInstances
+        UnboxedTuples
+        UndecidableInstances
 
     Include-Dirs: . parser utils
 
+    if impl( ghc >= 7.9 )
+        -- We need to set the package key to ghc (without a version number)
+        -- as it's magic.  But we can't set it for old versions of GHC (e.g.
+        -- when bootstrapping) because those versions of GHC don't understand
+        -- that GHC is wired-in.
+        GHC-Options: -this-package-key ghc
+
     if flag(stage1)
         Include-Dirs: stage1
     else
@@ -96,8 +124,6 @@ Library
 
     c-sources:
         parser/cutils.c
-
-    c-sources:
         ghci/keepCAFsForGHCi.c
         cbits/genSym.c
 
@@ -134,6 +160,7 @@ Library
         DataCon
         PatSyn
         Demand
+        Debug
         Exception
         GhcMonad
         Hooks
@@ -165,6 +192,7 @@ Library
         Var
         VarEnv
         VarSet
+        UnVarGraph
         BlockId
         CLabel
         Cmm
@@ -183,7 +211,6 @@ Library
         CmmOpt
         CmmParse
         CmmProcPoint
-        CmmRewriteAssignments
         CmmSink
         CmmType
         CmmUtils
@@ -232,11 +259,8 @@ Library
         CoreTidy
         CoreUnfold
         CoreUtils
-        ExternalCore
         MkCore
-        MkExternalCore
         PprCore
-        PprExternalCore
         Check
         Coverage
         Desugar
@@ -303,12 +327,9 @@ Library
         TidyPgm
         Ctype
         HaddockUtils
-        LexCore
         Lexer
         OptCoercion
         Parser
-        ParserCore
-        ParserCoreUtils
         RdrHsSyn
         ForeignCall
         PrelInfo
@@ -351,6 +372,7 @@ Library
         CoreToStg
         StgLint
         StgSyn
+        CallArity
         DmdAnal
         WorkWrap
         WwLib
@@ -532,6 +554,9 @@ Library
             RegAlloc.Linear.X86_64.FreeRegs
             RegAlloc.Linear.PPC.FreeRegs
             RegAlloc.Linear.SPARC.FreeRegs
+            Dwarf
+            Dwarf.Types
+            Dwarf.Constants
 
     if flag(ghci)
         Exposed-Modules:
diff --git a/compiler/ghc.mk b/compiler/ghc.mk
index 0a1871307e57..d23d1fe5b607 100644
--- a/compiler/ghc.mk
+++ b/compiler/ghc.mk
@@ -99,8 +99,6 @@ endif
 	@echo 'cGhcEnableTablesNextToCode = "$(GhcEnableTablesNextToCode)"' >> $@
 	@echo 'cLeadingUnderscore    :: String'                             >> $@
 	@echo 'cLeadingUnderscore    = "$(LeadingUnderscore)"'              >> $@
-	@echo 'cRAWCPP_FLAGS         :: String'                             >> $@
-	@echo 'cRAWCPP_FLAGS         = "$(RAWCPP_FLAGS)"'                   >> $@
 	@echo 'cGHC_UNLIT_PGM        :: String'                             >> $@
 	@echo 'cGHC_UNLIT_PGM        = "$(utils/unlit_dist_PROG)"'          >> $@
 	@echo 'cGHC_SPLIT_PGM        :: String'                             >> $@
@@ -353,6 +351,11 @@ else
 compiler_CONFIGURE_OPTS += --ghc-option=-DNO_REGS
 endif
 
+ifneq "$(GhcWithSMP)" "YES"
+compiler_CONFIGURE_OPTS += --ghc-option=-DNOSMP
+compiler_CONFIGURE_OPTS += --ghc-option=-optc-DNOSMP
+endif
+
 # Careful optimisation of the parser: we don't want to throw everything
 # at it, because that takes too long and doesn't buy much, but we do want
 # to inline certain key external functions, so we instruct GHC not to
@@ -434,8 +437,14 @@ ifeq "$(compiler_stage1_VERSION_MUNGED)" "YES"
 compiler_stage1_MUNGED_VERSION = $(subst .$(ProjectPatchLevel),,$(ProjectVersion))
 define compiler_PACKAGE_MAGIC
 compiler_stage1_VERSION = $(compiler_stage1_MUNGED_VERSION)
+compiler_stage1_PACKAGE_KEY = $(subst .$(ProjectPatchLevel),,$(compiler_stage1_PACKAGE_KEY))
 endef
 
+# NB: the PACKAGE_KEY munging has no effect for new-style package keys
+# (which indeed, have nothing version like in them, but are important for
+# old-style package keys which do.)  The subst operation is idempotent, so
+# as long as we do it at least once we should be good.
+
 # Don't register the non-munged package
 compiler_stage1_REGISTER_PACKAGE = NO
 
@@ -662,9 +671,9 @@ compiler_stage2_CONFIGURE_OPTS += --disable-library-for-ghci
 compiler_stage3_CONFIGURE_OPTS += --disable-library-for-ghci
 
 # after build-package, because that sets compiler_stage1_HC_OPTS:
-compiler_stage1_HC_OPTS += $(GhcStage1HcOpts)
-compiler_stage2_HC_OPTS += $(GhcStage2HcOpts)
-compiler_stage3_HC_OPTS += $(GhcStage3HcOpts)
+compiler_stage1_HC_OPTS += $(GhcHcOpts) $(GhcStage1HcOpts)
+compiler_stage2_HC_OPTS += $(GhcHcOpts) $(GhcStage2HcOpts)
+compiler_stage3_HC_OPTS += $(GhcHcOpts) $(GhcStage3HcOpts)
 
 ifneq "$(BINDIST)" "YES"
 
diff --git a/compiler/ghci/ByteCodeAsm.lhs b/compiler/ghci/ByteCodeAsm.lhs
index 9ec783a40deb..52d6adde863d 100644
--- a/compiler/ghci/ByteCodeAsm.lhs
+++ b/compiler/ghci/ByteCodeAsm.lhs
@@ -5,8 +5,8 @@
 ByteCodeLink: Bytecode assembler and linker
 
 \begin{code}
-{-# OPTIONS -optc-DNON_POSIX_SOURCE #-}
-{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE BangPatterns, CPP, MagicHash #-}
+{-# OPTIONS_GHC -optc-DNON_POSIX_SOURCE #-}
 
 module ByteCodeAsm (
         assembleBCOs, assembleBCO,
diff --git a/compiler/ghci/ByteCodeGen.lhs b/compiler/ghci/ByteCodeGen.lhs
index 58612e2e4898..645a0d8118d1 100644
--- a/compiler/ghci/ByteCodeGen.lhs
+++ b/compiler/ghci/ByteCodeGen.lhs
@@ -5,13 +5,7 @@
 ByteCodeGen: Generate bytecode from Core
 
 \begin{code}
-{-# OPTIONS -fno-warn-tabs #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and
--- detab the module (please do the detabbing in a separate patch). See
---     http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
--- for details
-
+{-# LANGUAGE CPP, MagicHash #-}
 module ByteCodeGen ( UnlinkedBCO, byteCodeGen, coreExprToBCOs ) where
 
 #include "HsVersions.h"
@@ -277,7 +271,7 @@ collect :: AnnExpr Id VarSet -> ([Var], AnnExpr' Id VarSet)
 collect (_, e) = go [] e
   where
     go xs e | Just e' <- bcView e = go xs e'
-    go xs (AnnLam x (_,e)) 
+    go xs (AnnLam x (_,e))
       | UbxTupleRep _ <- repType (idType x)
       = unboxedTupleException
       | otherwise
@@ -819,8 +813,8 @@ doCase d s p (_,scrut) bndr alts is_unboxed_tuple
              MASSERT(isAlgCase)
              rhs_code <- schemeE (d_alts + size) s p' rhs
              return (my_discr alt, unitOL (UNPACK (trunc16 size)) `appOL` rhs_code)
-	   where
-	     real_bndrs = filterOut isTyVar bndrs
+           where
+             real_bndrs = filterOut isTyVar bndrs
 
         my_discr (DEFAULT, _, _) = NoDiscr {-shouldn't really happen-}
         my_discr (DataAlt dc, _, _)
@@ -933,6 +927,11 @@ generateCCall d0 s p (CCallSpec target cconv safety) fn args_r_to_l
                              code <- parg_ArrayishRep (fromIntegral (arrPtrsHdrSize dflags)) d p a
                              return ((code,AddrRep):rest)
 
+                     | t == smallArrayPrimTyCon || t == smallMutableArrayPrimTyCon
+                       -> do rest <- pargs (d + fromIntegral addr_sizeW) az
+                             code <- parg_ArrayishRep (fromIntegral (smallArrPtrsHdrSize dflags)) d p a
+                             return ((code,AddrRep):rest)
+
                      | t == byteArrayPrimTyCon || t == mutableByteArrayPrimTyCon
                        -> do rest <- pargs (d + fromIntegral addr_sizeW) az
                              code <- parg_ArrayishRep (fromIntegral (arrWordsHdrSize dflags)) d p a
@@ -1247,8 +1246,8 @@ pushAtom d p e
    | Just e' <- bcView e
    = pushAtom d p e'
 
-pushAtom _ _ (AnnCoercion {})	-- Coercions are zero-width things, 
-   = return (nilOL, 0)	  	-- treated just like a variable V
+pushAtom _ _ (AnnCoercion {})   -- Coercions are zero-width things,
+   = return (nilOL, 0)          -- treated just like a variable V
 
 pushAtom d p (AnnVar v)
    | UnaryRep rep_ty <- repType (idType v)
@@ -1558,12 +1557,12 @@ isVAtom :: AnnExpr' Var ann -> Bool
 isVAtom e | Just e' <- bcView e = isVAtom e'
 isVAtom (AnnVar v)              = isVoidArg (bcIdArgRep v)
 isVAtom (AnnCoercion {})        = True
-isVAtom _ 	              = False
+isVAtom _                     = False
 
 atomPrimRep :: AnnExpr' Id ann -> PrimRep
 atomPrimRep e | Just e' <- bcView e = atomPrimRep e'
-atomPrimRep (AnnVar v)    	    = bcIdPrimRep v
-atomPrimRep (AnnLit l)    	    = typePrimRep (literalType l)
+atomPrimRep (AnnVar v)              = bcIdPrimRep v
+atomPrimRep (AnnLit l)              = typePrimRep (literalType l)
 atomPrimRep (AnnCoercion {})        = VoidRep
 atomPrimRep other = pprPanic "atomPrimRep" (ppr (deAnnotate (undefined,other)))
 
diff --git a/compiler/ghci/ByteCodeInstr.lhs b/compiler/ghci/ByteCodeInstr.lhs
index 005a430cd993..5535d58453f9 100644
--- a/compiler/ghci/ByteCodeInstr.lhs
+++ b/compiler/ghci/ByteCodeInstr.lhs
@@ -4,23 +4,16 @@
 ByteCodeInstrs: Bytecode instruction definitions
 
 \begin{code}
-{-# OPTIONS -fno-warn-tabs #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and
--- detab the module (please do the detabbing in a separate patch). See
---     http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
--- for details
-
+{-# LANGUAGE CPP, MagicHash #-}
 {-# OPTIONS_GHC -funbox-strict-fields #-}
-
-module ByteCodeInstr ( 
- 	BCInstr(..), ProtoBCO(..), bciStackUse, BreakInfo (..) 
+module ByteCodeInstr (
+        BCInstr(..), ProtoBCO(..), bciStackUse, BreakInfo (..)
   ) where
 
 #include "HsVersions.h"
 #include "../includes/MachDeps.h"
 
-import ByteCodeItbls	( ItblPtr )
+import ByteCodeItbls    ( ItblPtr )
 
 import StgCmmLayout     ( ArgRep(..) )
 import PprCore
@@ -43,17 +36,17 @@ import Data.Word
 -- ----------------------------------------------------------------------------
 -- Bytecode instructions
 
-data ProtoBCO a 
-   = ProtoBCO { 
-	protoBCOName       :: a,	  -- name, in some sense
-	protoBCOInstrs     :: [BCInstr],  -- instrs
-	-- arity and GC info
-	protoBCOBitmap     :: [StgWord],
-	protoBCOBitmapSize :: Word16,
-	protoBCOArity	   :: Int,
-	-- what the BCO came from
-	protoBCOExpr       :: Either  [AnnAlt Id VarSet] (AnnExpr Id VarSet),
-	-- malloc'd pointers
+data ProtoBCO a
+   = ProtoBCO {
+        protoBCOName       :: a,          -- name, in some sense
+        protoBCOInstrs     :: [BCInstr],  -- instrs
+        -- arity and GC info
+        protoBCOBitmap     :: [StgWord],
+        protoBCOBitmapSize :: Word16,
+        protoBCOArity      :: Int,
+        -- what the BCO came from
+        protoBCOExpr       :: Either  [AnnAlt Id VarSet] (AnnExpr Id VarSet),
+        -- malloc'd pointers
         protoBCOPtrs       :: [Either ItblPtr (Ptr ())]
    }
 
@@ -79,14 +72,14 @@ data BCInstr
 
    -- Pushing literals
    | PUSH_UBX  (Either Literal (Ptr ())) Word16
-	-- push this int/float/double/addr, on the stack. Word16
-	-- is # of words to copy from literal pool.  Eitherness reflects
-	-- the difficulty of dealing with MachAddr here, mostly due to
-	-- the excessive (and unnecessary) restrictions imposed by the
-	-- designers of the new Foreign library.  In particular it is
-	-- quite impossible to convert an Addr to any other integral
-	-- type, and it appears impossible to get hold of the bits of
-	-- an addr, even though we need to assemble BCOs.
+        -- push this int/float/double/addr, on the stack. Word16
+        -- is # of words to copy from literal pool.  Eitherness reflects
+        -- the difficulty of dealing with MachAddr here, mostly due to
+        -- the excessive (and unnecessary) restrictions imposed by the
+        -- designers of the new Foreign library.  In particular it is
+        -- quite impossible to convert an Addr to any other integral
+        -- type, and it appears impossible to get hold of the bits of
+        -- an addr, even though we need to assemble BCOs.
 
    -- various kinds of application
    | PUSH_APPLY_N
@@ -111,8 +104,8 @@ data BCInstr
    | MKPAP     !Word16{-ptr to PAP is this far down stack-} !Word16{-number of words-}
    | UNPACK    !Word16 -- unpack N words from t.o.s Constr
    | PACK      DataCon !Word16
-			-- after assembly, the DataCon is an index into the
-			-- itbl array
+                        -- after assembly, the DataCon is an index into the
+                        -- itbl array
    -- For doing case trees
    | LABEL     LocalLabel
    | TESTLT_I  Int    LocalLabel
@@ -146,13 +139,13 @@ data BCInstr
 
    -- To Infinity And Beyond
    | ENTER
-   | RETURN		-- return a lifted value
+   | RETURN             -- return a lifted value
    | RETURN_UBX ArgRep -- return an unlifted value, here's its rep
 
-   -- Breakpoints 
+   -- Breakpoints
    | BRK_FUN          (MutableByteArray# RealWorld) Word16 BreakInfo
 
-data BreakInfo 
+data BreakInfo
    = BreakInfo
    { breakInfo_module :: Module
    , breakInfo_number :: {-# UNPACK #-} !Int
@@ -172,8 +165,8 @@ instance Outputable BreakInfo where
 
 instance Outputable a => Outputable (ProtoBCO a) where
    ppr (ProtoBCO name instrs bitmap bsize arity origin malloced)
-      = (text "ProtoBCO" <+> ppr name <> char '#' <> int arity 
-		<+> text (show malloced) <> colon)
+      = (text "ProtoBCO" <+> ppr name <> char '#' <> int arity
+                <+> text (show malloced) <> colon)
         $$ nest 3 (case origin of
                       Left alts -> vcat (zipWith (<+>) (char '{' : repeat (char ';'))
                                                        (map (pprCoreAltShort.deAnnAlt) alts)) <+> char '}'
@@ -211,8 +204,8 @@ instance Outputable BCInstr where
    ppr (PUSH_L offset)       = text "PUSH_L  " <+> ppr offset
    ppr (PUSH_LL o1 o2)       = text "PUSH_LL " <+> ppr o1 <+> ppr o2
    ppr (PUSH_LLL o1 o2 o3)   = text "PUSH_LLL" <+> ppr o1 <+> ppr o2 <+> ppr o3
-   ppr (PUSH_G nm)  	     = text "PUSH_G  " <+> ppr nm
-   ppr (PUSH_PRIMOP op)      = text "PUSH_G  " <+> text "GHC.PrimopWrappers." 
+   ppr (PUSH_G nm)           = text "PUSH_G  " <+> ppr nm
+   ppr (PUSH_PRIMOP op)      = text "PUSH_G  " <+> text "GHC.PrimopWrappers."
                                                <> ppr op
    ppr (PUSH_BCO bco)        = hang (text "PUSH_BCO") 2 (ppr bco)
    ppr (PUSH_ALTS bco)       = hang (text "PUSH_ALTS") 2 (ppr bco)
@@ -220,23 +213,23 @@ instance Outputable BCInstr where
 
    ppr (PUSH_UBX (Left lit) nw) = text "PUSH_UBX" <+> parens (ppr nw) <+> ppr lit
    ppr (PUSH_UBX (Right aa) nw) = text "PUSH_UBX" <+> parens (ppr nw) <+> text (show aa)
-   ppr PUSH_APPLY_N		= text "PUSH_APPLY_N"
-   ppr PUSH_APPLY_V		= text "PUSH_APPLY_V"
-   ppr PUSH_APPLY_F		= text "PUSH_APPLY_F"
-   ppr PUSH_APPLY_D		= text "PUSH_APPLY_D"
-   ppr PUSH_APPLY_L		= text "PUSH_APPLY_L"
-   ppr PUSH_APPLY_P		= text "PUSH_APPLY_P"
-   ppr PUSH_APPLY_PP		= text "PUSH_APPLY_PP"
-   ppr PUSH_APPLY_PPP		= text "PUSH_APPLY_PPP"
-   ppr PUSH_APPLY_PPPP		= text "PUSH_APPLY_PPPP"
-   ppr PUSH_APPLY_PPPPP		= text "PUSH_APPLY_PPPPP"
-   ppr PUSH_APPLY_PPPPPP	= text "PUSH_APPLY_PPPPPP"
+   ppr PUSH_APPLY_N             = text "PUSH_APPLY_N"
+   ppr PUSH_APPLY_V             = text "PUSH_APPLY_V"
+   ppr PUSH_APPLY_F             = text "PUSH_APPLY_F"
+   ppr PUSH_APPLY_D             = text "PUSH_APPLY_D"
+   ppr PUSH_APPLY_L             = text "PUSH_APPLY_L"
+   ppr PUSH_APPLY_P             = text "PUSH_APPLY_P"
+   ppr PUSH_APPLY_PP            = text "PUSH_APPLY_PP"
+   ppr PUSH_APPLY_PPP           = text "PUSH_APPLY_PPP"
+   ppr PUSH_APPLY_PPPP          = text "PUSH_APPLY_PPPP"
+   ppr PUSH_APPLY_PPPPP         = text "PUSH_APPLY_PPPPP"
+   ppr PUSH_APPLY_PPPPPP        = text "PUSH_APPLY_PPPPPP"
 
    ppr (SLIDE n d)           = text "SLIDE   " <+> ppr n <+> ppr d
    ppr (ALLOC_AP sz)         = text "ALLOC_AP   " <+> ppr sz
    ppr (ALLOC_AP_NOUPD sz)   = text "ALLOC_AP_NOUPD   " <+> ppr sz
    ppr (ALLOC_PAP arity sz)  = text "ALLOC_PAP   " <+> ppr arity <+> ppr sz
-   ppr (MKAP offset sz)      = text "MKAP    " <+> ppr sz <+> text "words," 
+   ppr (MKAP offset sz)      = text "MKAP    " <+> ppr sz <+> text "words,"
                                                <+> ppr offset <+> text "stkoff"
    ppr (MKPAP offset sz)     = text "MKPAP   " <+> ppr sz <+> text "words,"
                                                <+> ppr offset <+> text "stkoff"
@@ -255,8 +248,8 @@ instance Outputable BCInstr where
    ppr (TESTEQ_P  i lab)     = text "TESTEQ_P" <+> ppr i <+> text "__" <> ppr lab
    ppr CASEFAIL              = text "CASEFAIL"
    ppr (JMP lab)             = text "JMP"      <+> ppr lab
-   ppr (CCALL off marshall_addr int) = text "CCALL   " <+> ppr off 
-						<+> text "marshall code at" 
+   ppr (CCALL off marshall_addr int) = text "CCALL   " <+> ppr off
+                                                <+> text "marshall code at"
                                                <+> text (show marshall_addr)
                                                <+> (if int == 1
                                                     then text "(interruptible)"
@@ -264,7 +257,7 @@ instance Outputable BCInstr where
    ppr (SWIZZLE stkoff n)    = text "SWIZZLE " <+> text "stkoff" <+> ppr stkoff
                                                <+> text "by" <+> ppr n
    ppr ENTER                 = text "ENTER"
-   ppr RETURN		     = text "RETURN"
+   ppr RETURN                = text "RETURN"
    ppr (RETURN_UBX pk)       = text "RETURN_UBX  " <+> ppr pk
    ppr (BRK_FUN _breakArray index info) = text "BRK_FUN" <+> text "<array>" <+> ppr index <+> ppr info
 
@@ -283,54 +276,54 @@ protoBCOStackUse bco = sum (map bciStackUse (protoBCOInstrs bco))
 
 bciStackUse :: BCInstr -> Word
 bciStackUse STKCHECK{}            = 0
-bciStackUse PUSH_L{}       	  = 1
-bciStackUse PUSH_LL{}       	  = 2
+bciStackUse PUSH_L{}              = 1
+bciStackUse PUSH_LL{}             = 2
 bciStackUse PUSH_LLL{}            = 3
-bciStackUse PUSH_G{} 		  = 1
+bciStackUse PUSH_G{}              = 1
 bciStackUse PUSH_PRIMOP{}         = 1
-bciStackUse PUSH_BCO{}    	  = 1
+bciStackUse PUSH_BCO{}            = 1
 bciStackUse (PUSH_ALTS bco)       = 2 + protoBCOStackUse bco
 bciStackUse (PUSH_ALTS_UNLIFTED bco _) = 2 + protoBCOStackUse bco
 bciStackUse (PUSH_UBX _ nw)       = fromIntegral nw
-bciStackUse PUSH_APPLY_N{}	  = 1
-bciStackUse PUSH_APPLY_V{}	  = 1
-bciStackUse PUSH_APPLY_F{}	  = 1
-bciStackUse PUSH_APPLY_D{}	  = 1
-bciStackUse PUSH_APPLY_L{}	  = 1
-bciStackUse PUSH_APPLY_P{}	  = 1
-bciStackUse PUSH_APPLY_PP{}	  = 1
-bciStackUse PUSH_APPLY_PPP{}	  = 1
-bciStackUse PUSH_APPLY_PPPP{}	  = 1
-bciStackUse PUSH_APPLY_PPPPP{}	  = 1
-bciStackUse PUSH_APPLY_PPPPPP{}	  = 1
+bciStackUse PUSH_APPLY_N{}        = 1
+bciStackUse PUSH_APPLY_V{}        = 1
+bciStackUse PUSH_APPLY_F{}        = 1
+bciStackUse PUSH_APPLY_D{}        = 1
+bciStackUse PUSH_APPLY_L{}        = 1
+bciStackUse PUSH_APPLY_P{}        = 1
+bciStackUse PUSH_APPLY_PP{}       = 1
+bciStackUse PUSH_APPLY_PPP{}      = 1
+bciStackUse PUSH_APPLY_PPPP{}     = 1
+bciStackUse PUSH_APPLY_PPPPP{}    = 1
+bciStackUse PUSH_APPLY_PPPPPP{}   = 1
 bciStackUse ALLOC_AP{}            = 1
 bciStackUse ALLOC_AP_NOUPD{}      = 1
 bciStackUse ALLOC_PAP{}           = 1
 bciStackUse (UNPACK sz)           = fromIntegral sz
-bciStackUse LABEL{}       	  = 0
-bciStackUse TESTLT_I{}     	  = 0
-bciStackUse TESTEQ_I{}     	  = 0
-bciStackUse TESTLT_W{}     	  = 0
-bciStackUse TESTEQ_W{}     	  = 0
-bciStackUse TESTLT_F{}     	  = 0
-bciStackUse TESTEQ_F{}     	  = 0
-bciStackUse TESTLT_D{}     	  = 0
-bciStackUse TESTEQ_D{}     	  = 0
-bciStackUse TESTLT_P{}     	  = 0
-bciStackUse TESTEQ_P{}     	  = 0
-bciStackUse CASEFAIL{}		  = 0
-bciStackUse JMP{}		  = 0
-bciStackUse ENTER{}		  = 0
-bciStackUse RETURN{}		  = 0
-bciStackUse RETURN_UBX{}	  = 1
-bciStackUse CCALL{} 		  = 0
-bciStackUse SWIZZLE{}    	  = 0
-bciStackUse BRK_FUN{}    	  = 0
+bciStackUse LABEL{}               = 0
+bciStackUse TESTLT_I{}            = 0
+bciStackUse TESTEQ_I{}            = 0
+bciStackUse TESTLT_W{}            = 0
+bciStackUse TESTEQ_W{}            = 0
+bciStackUse TESTLT_F{}            = 0
+bciStackUse TESTEQ_F{}            = 0
+bciStackUse TESTLT_D{}            = 0
+bciStackUse TESTEQ_D{}            = 0
+bciStackUse TESTLT_P{}            = 0
+bciStackUse TESTEQ_P{}            = 0
+bciStackUse CASEFAIL{}            = 0
+bciStackUse JMP{}                 = 0
+bciStackUse ENTER{}               = 0
+bciStackUse RETURN{}              = 0
+bciStackUse RETURN_UBX{}          = 1
+bciStackUse CCALL{}               = 0
+bciStackUse SWIZZLE{}             = 0
+bciStackUse BRK_FUN{}             = 0
 
 -- These insns actually reduce stack use, but we need the high-tide level,
 -- so can't use this info.  Not that it matters much.
-bciStackUse SLIDE{}		  = 0
-bciStackUse MKAP{}		  = 0
-bciStackUse MKPAP{}		  = 0
-bciStackUse PACK{}		  = 1 -- worst case is PACK 0 words
+bciStackUse SLIDE{}               = 0
+bciStackUse MKAP{}                = 0
+bciStackUse MKPAP{}               = 0
+bciStackUse PACK{}                = 1 -- worst case is PACK 0 words
 \end{code}
diff --git a/compiler/ghci/ByteCodeItbls.lhs b/compiler/ghci/ByteCodeItbls.lhs
index ce6bd01f16e3..7a7a62d98025 100644
--- a/compiler/ghci/ByteCodeItbls.lhs
+++ b/compiler/ghci/ByteCodeItbls.lhs
@@ -4,7 +4,8 @@
 ByteCodeItbls: Generate infotables for interpreter-made bytecodes
 
 \begin{code}
-{-# OPTIONS -optc-DNON_POSIX_SOURCE #-}
+{-# LANGUAGE CPP, MagicHash #-}
+{-# OPTIONS_GHC -optc-DNON_POSIX_SOURCE #-}
 
 module ByteCodeItbls ( ItblEnv, ItblPtr(..), itblCode, mkITbls, peekItbl
                      , StgInfoTable(..)
diff --git a/compiler/ghci/ByteCodeLink.lhs b/compiler/ghci/ByteCodeLink.lhs
index 4c484097f0f9..cbedb717fe76 100644
--- a/compiler/ghci/ByteCodeLink.lhs
+++ b/compiler/ghci/ByteCodeLink.lhs
@@ -5,7 +5,12 @@ ByteCodeLink: Bytecode assembler and linker
 
 \begin{code}
 {-# LANGUAGE BangPatterns #-}
-{-# OPTIONS -optc-DNON_POSIX_SOURCE #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE UnboxedTuples #-}
+{-# OPTIONS_GHC -optc-DNON_POSIX_SOURCE #-}
 
 module ByteCodeLink (
         ClosureEnv, emptyClosureEnv, extendClosureEnv,
@@ -255,13 +260,13 @@ linkFail who what
 -- HACKS!!!  ToDo: cleaner
 nameToCLabel :: Name -> String{-suffix-} -> String
 nameToCLabel n suffix
-   = if pkgid /= mainPackageId
+   = if pkgid /= mainPackageKey
         then package_part ++ '_': qual_name
         else qual_name
   where
-        pkgid = modulePackageId mod
+        pkgid = modulePackageKey mod
         mod = ASSERT( isExternalName n ) nameModule n
-        package_part = zString (zEncodeFS (packageIdFS (modulePackageId mod)))
+        package_part = zString (zEncodeFS (packageKeyFS (modulePackageKey mod)))
         module_part  = zString (zEncodeFS (moduleNameFS (moduleName mod)))
         occ_part     = zString (zEncodeFS (occNameFS (nameOccName n)))
         qual_name = module_part ++ '_':occ_part ++ '_':suffix
diff --git a/compiler/ghci/Debugger.hs b/compiler/ghci/Debugger.hs
index 0807bf17b51c..49667141819b 100644
--- a/compiler/ghci/Debugger.hs
+++ b/compiler/ghci/Debugger.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE MagicHash #-}
+
 -----------------------------------------------------------------------------
 --
 -- GHCi Interactive debugging commands 
diff --git a/compiler/ghci/DebuggerUtils.hs b/compiler/ghci/DebuggerUtils.hs
index 3d73e69e2bfe..9ccb11331497 100644
--- a/compiler/ghci/DebuggerUtils.hs
+++ b/compiler/ghci/DebuggerUtils.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE CPP #-}
+
 module DebuggerUtils (
        dataConInfoPtrToName,
   ) where
@@ -44,7 +46,7 @@ dataConInfoPtrToName x = do
        modFS = mkFastStringByteList mod
        occFS = mkFastStringByteList occ
        occName = mkOccNameFS OccName.dataName occFS
-       modName = mkModule (fsToPackageId pkgFS) (mkModuleNameFS modFS) 
+       modName = mkModule (fsToPackageKey pkgFS) (mkModuleNameFS modFS)
    return (Left $ showSDoc dflags $ ppr modName <> dot <> ppr occName)
     `recoverM` (Right `fmap` lookupOrig modName occName)
 
diff --git a/compiler/ghci/Linker.lhs b/compiler/ghci/Linker.lhs
index eb3e226ab4c6..40b83bbbaef4 100644
--- a/compiler/ghci/Linker.lhs
+++ b/compiler/ghci/Linker.lhs
@@ -2,15 +2,16 @@
 % (c) The University of Glasgow 2005-2012
 %
 \begin{code}
+{-# LANGUAGE CPP, NondecreasingIndentation #-}
+{-# OPTIONS_GHC -fno-cse #-}
+-- -fno-cse is needed for GLOBAL_VAR's to behave properly
+
 -- | The dynamic linker for GHCi.
 --
 -- This module deals with the top-level issues of dynamic linking,
 -- calling the object-code linker and the byte-code linker where
 -- necessary.
 
-{-# OPTIONS -fno-cse #-}
--- -fno-cse is needed for GLOBAL_VAR's to behave properly
-
 module Linker ( getHValue, showLinkerState,
                 linkExpr, linkDecls, unload, withExtendedLinkEnv,
                 extendLinkEnv, deleteFromLinkEnv,
@@ -58,7 +59,6 @@ import Control.Monad
 
 import Data.IORef
 import Data.List
-import qualified Data.Map as Map
 import Control.Concurrent.MVar
 
 import System.FilePath
@@ -69,7 +69,7 @@ import System.Directory hiding (findFile)
 import System.Directory
 #endif
 
-import Distribution.Package hiding (depends, PackageId)
+import Distribution.Package hiding (depends, mkPackageKey, PackageKey)
 
 import Exception
 \end{code}
@@ -123,7 +123,7 @@ data PersistentLinkerState
         -- The currently-loaded packages; always object code
         -- Held, as usual, in dependency order; though I am not sure if
         -- that is really important
-        pkgs_loaded :: ![PackageId]
+        pkgs_loaded :: ![PackageKey]
      }
 
 emptyPLS :: DynFlags -> PersistentLinkerState
@@ -139,10 +139,10 @@ emptyPLS _ = PersistentLinkerState {
   --
   -- The linker's symbol table is populated with RTS symbols using an
   -- explicit list.  See rts/Linker.c for details.
-  where init_pkgs = [rtsPackageId]
+  where init_pkgs = [rtsPackageKey]
 
 
-extendLoadedPkgs :: [PackageId] -> IO ()
+extendLoadedPkgs :: [PackageKey] -> IO ()
 extendLoadedPkgs pkgs =
   modifyPLS_ $ \s ->
       return s{ pkgs_loaded = pkgs ++ pkgs_loaded s }
@@ -378,7 +378,16 @@ preloadLib dflags lib_paths framework_paths lib_spec
              -> do maybe_errstr <- loadDLL (mkSOName platform dll_unadorned)
                    case maybe_errstr of
                       Nothing -> maybePutStrLn dflags "done"
-                      Just mm -> preloadFailed mm lib_paths lib_spec
+                      Just mm | platformOS platform /= OSDarwin ->
+                        preloadFailed mm lib_paths lib_spec
+                      Just mm | otherwise -> do
+                        -- As a backup, on Darwin, try to also load a .so file
+                        -- since (apparently) some things install that way - see
+                        -- ticket #8770.
+                        err2 <- loadDLL $ ("lib" ++ dll_unadorned) <.> "so"
+                        case err2 of
+                          Nothing -> maybePutStrLn dflags "done"
+                          Just _  -> preloadFailed mm lib_paths lib_spec
 
           DLLPath dll_path
              -> do maybe_errstr <- loadDLL dll_path
@@ -517,7 +526,7 @@ getLinkDeps :: HscEnv -> HomePackageTable
             -> Maybe FilePath                   -- replace object suffices?
             -> SrcSpan                          -- for error messages
             -> [Module]                         -- If you need these
-            -> IO ([Linkable], [PackageId])     -- ... then link these first
+            -> IO ([Linkable], [PackageKey])     -- ... then link these first
 -- Fails with an IO exception if it can't find enough files
 
 getLinkDeps hsc_env hpt pls replace_osuf span mods
@@ -555,8 +564,8 @@ getLinkDeps hsc_env hpt pls replace_osuf span mods
         -- tree recursively.  See bug #936, testcase ghci/prog007.
     follow_deps :: [Module]             -- modules to follow
                 -> UniqSet ModuleName         -- accum. module dependencies
-                -> UniqSet PackageId          -- accum. package dependencies
-                -> IO ([ModuleName], [PackageId]) -- result
+                -> UniqSet PackageKey          -- accum. package dependencies
+                -> IO ([ModuleName], [PackageKey]) -- result
     follow_deps []     acc_mods acc_pkgs
         = return (uniqSetToList acc_mods, uniqSetToList acc_pkgs)
     follow_deps (mod:mods) acc_mods acc_pkgs
@@ -570,7 +579,7 @@ getLinkDeps hsc_env hpt pls replace_osuf span mods
           when (mi_boot iface) $ link_boot_mod_error mod
 
           let
-            pkg = modulePackageId mod
+            pkg = modulePackageKey mod
             deps  = mi_deps iface
 
             pkg_deps = dep_pkgs deps
@@ -1035,7 +1044,7 @@ showLS (Framework nm) = "(framework) " ++ nm
 -- automatically, and it doesn't matter what order you specify the input
 -- packages.
 --
-linkPackages :: DynFlags -> [PackageId] -> IO ()
+linkPackages :: DynFlags -> [PackageKey] -> IO ()
 -- NOTE: in fact, since each module tracks all the packages it depends on,
 --       we don't really need to use the package-config dependencies.
 --
@@ -1051,16 +1060,13 @@ linkPackages dflags new_pkgs = do
   modifyPLS_ $ \pls -> do
     linkPackages' dflags new_pkgs pls
 
-linkPackages' :: DynFlags -> [PackageId] -> PersistentLinkerState
+linkPackages' :: DynFlags -> [PackageKey] -> PersistentLinkerState
              -> IO PersistentLinkerState
 linkPackages' dflags new_pks pls = do
     pkgs' <- link (pkgs_loaded pls) new_pks
     return $! pls { pkgs_loaded = pkgs' }
   where
-     pkg_map = pkgIdMap (pkgState dflags)
-     ipid_map = installedPackageIdMap (pkgState dflags)
-
-     link :: [PackageId] -> [PackageId] -> IO [PackageId]
+     link :: [PackageKey] -> [PackageKey] -> IO [PackageKey]
      link pkgs new_pkgs =
          foldM link_one pkgs new_pkgs
 
@@ -1068,17 +1074,16 @@ linkPackages' dflags new_pks pls = do
         | new_pkg `elem` pkgs   -- Already linked
         = return pkgs
 
-        | Just pkg_cfg <- lookupPackage pkg_map new_pkg
+        | Just pkg_cfg <- lookupPackage dflags new_pkg
         = do {  -- Link dependents first
-               pkgs' <- link pkgs [ Maybes.expectJust "link_one" $
-                                    Map.lookup ipid ipid_map
+               pkgs' <- link pkgs [ resolveInstalledPackageId dflags ipid
                                   | ipid <- depends pkg_cfg ]
                 -- Now link the package itself
              ; linkPackage dflags pkg_cfg
              ; return (new_pkg : pkgs') }
 
         | otherwise
-        = throwGhcExceptionIO (CmdLineError ("unknown package: " ++ packageIdString new_pkg))
+        = throwGhcExceptionIO (CmdLineError ("unknown package: " ++ packageKeyString new_pkg))
 
 
 linkPackage :: DynFlags -> PackageConfig -> IO ()
@@ -1199,7 +1204,9 @@ locateLib dflags is_hs dirs lib
      mk_hs_dyn_lib_path dir = dir </> mkHsSOName platform hs_dyn_lib_name
 
      so_name = mkSOName platform lib
-     mk_dyn_lib_path dir = dir </> so_name
+     mk_dyn_lib_path dir = case (arch, os) of
+                             (ArchX86_64, OSSolaris2) -> dir </> ("64/" ++ so_name)
+                             _ -> dir </> so_name
 
      findObject     = liftM (fmap Object)  $ findFile mk_obj_path        dirs
      findDynObject  = liftM (fmap Object)  $ findFile mk_dyn_obj_path    dirs
@@ -1216,6 +1223,8 @@ locateLib dflags is_hs dirs lib
                            Nothing -> g
 
      platform = targetPlatform dflags
+     arch = platformArch platform
+     os = platformOS platform
 
 searchForLibUsingGcc :: DynFlags -> String -> [FilePath] -> IO (Maybe FilePath)
 searchForLibUsingGcc dflags so dirs = do
diff --git a/compiler/ghci/RtClosureInspect.hs b/compiler/ghci/RtClosureInspect.hs
index 76b845114ac1..dde813d31db6 100644
--- a/compiler/ghci/RtClosureInspect.hs
+++ b/compiler/ghci/RtClosureInspect.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE CPP, ScopedTypeVariables, MagicHash, UnboxedTuples #-}
+
 -----------------------------------------------------------------------------
 --
 -- GHC Interactive support for inspecting arbitrary closures at runtime
@@ -5,14 +7,6 @@
 -- Pepe Iborra (supported by Google SoC) 2006
 --
 -----------------------------------------------------------------------------
-
-{-# OPTIONS -fno-warn-tabs #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and
--- detab the module (please do the detabbing in a separate patch). See
---     http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
--- for details
-
 module RtClosureInspect(
      cvObtainTerm,      -- :: HscEnv -> Int -> Bool -> Maybe Type -> HValue -> IO Term
      cvReconstructType,
@@ -83,9 +77,9 @@ import System.IO.Unsafe
 data Term = Term { ty        :: RttiType
                  , dc        :: Either String DataCon
                                -- Carries a text representation if the datacon is
-                               -- not exported by the .hi file, which is the case 
+                               -- not exported by the .hi file, which is the case
                                -- for private constructors in -O0 compiled libraries
-                 , val       :: HValue 
+                 , val       :: HValue
                  , subTerms  :: [Term] }
 
           | Prim { ty        :: RttiType
@@ -140,20 +134,20 @@ instance Outputable (Term) where
 -------------------------------------------------------------------------
 -- Runtime Closure Datatype and functions for retrieving closure related stuff
 -------------------------------------------------------------------------
-data ClosureType = Constr 
-                 | Fun 
-                 | Thunk Int 
+data ClosureType = Constr
+                 | Fun
+                 | Thunk Int
                  | ThunkSelector
-                 | Blackhole 
-                 | AP 
-                 | PAP 
-                 | Indirection Int 
+                 | Blackhole
+                 | AP
+                 | PAP
+                 | Indirection Int
                  | MutVar Int
                  | MVar   Int
                  | Other  Int
  deriving (Show, Eq)
 
-data Closure = Closure { tipe         :: ClosureType 
+data Closure = Closure { tipe         :: ClosureType
                        , infoPtr      :: Ptr ()
                        , infoTable    :: StgInfoTable
                        , ptrs         :: Array Int HValue
@@ -161,7 +155,7 @@ data Closure = Closure { tipe         :: ClosureType
                        }
 
 instance Outputable ClosureType where
-  ppr = text . show 
+  ppr = text . show
 
 #include "../includes/rts/storage/ClosureTypes.h"
 
@@ -173,7 +167,7 @@ pAP_CODE = PAP
 
 getClosureData :: DynFlags -> a -> IO Closure
 getClosureData dflags a =
-   case unpackClosure# a of 
+   case unpackClosure# a of
      (# iptr, ptrs, nptrs #) -> do
            let iptr'
                 | ghciTablesNextToCode =
@@ -192,11 +186,11 @@ getClosureData dflags a =
                nptrs_data = [W# (indexWordArray# nptrs i)
                               | I# i <- [0.. fromIntegral (BCI.nptrs itbl)-1] ]
            ASSERT(elems >= 0) return ()
-           ptrsList `seq` 
+           ptrsList `seq`
             return (Closure tipe (Ptr iptr) itbl ptrsList nptrs_data)
 
 readCType :: Integral a => a -> ClosureType
-readCType i 
+readCType i
  | i >= CONSTR && i <= CONSTR_NOCAF_STATIC = Constr
  | i >= FUN    && i <= FUN_STATIC          = Fun
  | i >= THUNK  && i < THUNK_SELECTOR       = Thunk i'
@@ -210,7 +204,7 @@ readCType i
  | i == MVAR_CLEAN    || i == MVAR_DIRTY   = MVar i'
  | otherwise                               = Other  i'
   where i' = fromIntegral i
- 
+
 isConstr, isIndirection, isThunk :: ClosureType -> Bool
 isConstr Constr = True
 isConstr    _   = False
@@ -238,7 +232,7 @@ unsafeDeepSeq :: a -> b -> b
 unsafeDeepSeq = unsafeDeepSeq1 2
  where unsafeDeepSeq1 0 a b = seq a $! b
        unsafeDeepSeq1 i a b   -- 1st case avoids infinite loops for non reducible thunks
-        | not (isConstr tipe) = seq a $! unsafeDeepSeq1 (i-1) a b     
+        | not (isConstr tipe) = seq a $! unsafeDeepSeq1 (i-1) a b
      -- | unsafePerformIO (isFullyEvaluated a) = b
         | otherwise = case unsafePerformIO (getClosureData a) of
                         closure -> foldl' (flip unsafeDeepSeq) b (ptrs closure)
@@ -313,7 +307,7 @@ mapTermTypeM f = foldTermM TermFoldM {
 
 termTyVars :: Term -> TyVarSet
 termTyVars = foldTerm TermFold {
-            fTerm       = \ty _ _ tt   -> 
+            fTerm       = \ty _ _ tt   ->
                           tyVarsOfType ty `plusVarEnv` concatVarEnv tt,
             fSuspension = \_ ty _ _ -> tyVarsOfType ty,
             fPrim       = \ _ _ -> emptyVarEnv,
@@ -345,21 +339,21 @@ ppr_termM y p Term{dc=Left dc_tag, subTerms=tt} = do
   tt_docs <- mapM (y app_prec) tt
   return $ cparen (not (null tt) && p >= app_prec)
                   (text dc_tag <+> pprDeeperList fsep tt_docs)
-  
-ppr_termM y p Term{dc=Right dc, subTerms=tt} 
+
+ppr_termM y p Term{dc=Right dc, subTerms=tt}
 {-  | dataConIsInfix dc, (t1:t2:tt') <- tt  --TODO fixity
-  = parens (ppr_term1 True t1 <+> ppr dc <+> ppr_term1 True ppr t2) 
-    <+> hsep (map (ppr_term1 True) tt) 
+  = parens (ppr_term1 True t1 <+> ppr dc <+> ppr_term1 True ppr t2)
+    <+> hsep (map (ppr_term1 True) tt)
 -} -- TODO Printing infix constructors properly
   | null sub_terms_to_show
   = return (ppr dc)
-  | otherwise 
+  | otherwise
   = do { tt_docs <- mapM (y app_prec) sub_terms_to_show
        ; return $ cparen (p >= app_prec) $
          sep [ppr dc, nest 2 (pprDeeperList fsep tt_docs)] }
   where
-    sub_terms_to_show	-- Don't show the dictionary arguments to 
-    			-- constructors unless -dppr-debug is on
+    sub_terms_to_show   -- Don't show the dictionary arguments to
+                        -- constructors unless -dppr-debug is on
       | opt_PprStyle_Debug = tt
       | otherwise = dropList (dataConTheta dc) tt
 
@@ -376,9 +370,9 @@ ppr_termM _ _ t = ppr_termM1 t
 
 
 ppr_termM1 :: Monad m => Term -> m SDoc
-ppr_termM1 Prim{value=words, ty=ty} = 
+ppr_termM1 Prim{value=words, ty=ty} =
     return $ repPrim (tyConAppTyCon ty) words
-ppr_termM1 Suspension{ty=ty, bound_to=Nothing} = 
+ppr_termM1 Suspension{ty=ty, bound_to=Nothing} =
     return (char '_' <+> ifPprDebug (text "::" <> ppr ty))
 ppr_termM1 Suspension{ty=ty, bound_to=Just n}
 --  | Just _ <- splitFunTy_maybe ty = return$ ptext (sLit("<function>")
@@ -390,7 +384,7 @@ ppr_termM1 NewtypeWrap{} = panic "ppr_termM1 - NewtypeWrap"
 pprNewtypeWrap y p NewtypeWrap{ty=ty, wrapped_term=t}
   | Just (tc,_) <- tcSplitTyConApp_maybe ty
   , ASSERT(isNewTyCon tc) True
-  , Just new_dc <- tyConSingleDataCon_maybe tc = do 
+  , Just new_dc <- tyConSingleDataCon_maybe tc = do
              real_term <- y max_prec t
              return $ cparen (p >= app_prec) (ppr new_dc <+> real_term)
 pprNewtypeWrap _ _ _ = panic "pprNewtypeWrap"
@@ -399,11 +393,11 @@ pprNewtypeWrap _ _ _ = panic "pprNewtypeWrap"
 -- Custom Term Pretty Printers
 -------------------------------------------------------
 
--- We can want to customize the representation of a 
---  term depending on its type. 
+-- We can want to customize the representation of a
+--  term depending on its type.
 -- However, note that custom printers have to work with
 --  type representations, instead of directly with types.
--- We cannot use type classes here, unless we employ some 
+-- We cannot use type classes here, unless we employ some
 --  typerep trickery (e.g. Weirich's RepLib tricks),
 --  which I didn't. Therefore, this code replicates a lot
 --  of what type classes provide for free.
@@ -411,7 +405,7 @@ pprNewtypeWrap _ _ _ = panic "pprNewtypeWrap"
 type CustomTermPrinter m = TermPrinterM m
                          -> [Precedence -> Term -> (m (Maybe SDoc))]
 
--- | Takes a list of custom printers with a explicit recursion knot and a term, 
+-- | Takes a list of custom printers with a explicit recursion knot and a term,
 -- and returns the output of the first successful printer, or the default printer
 cPprTerm :: Monad m => CustomTermPrinter m -> Term -> m SDoc
 cPprTerm printers_ = go 0 where
@@ -428,7 +422,7 @@ cPprTerm printers_ = go 0 where
 -- Default set of custom printers. Note that the recursion knot is explicit
 cPprTermBase :: forall m. Monad m => CustomTermPrinter m
 cPprTermBase y =
-  [ ifTerm (isTupleTy.ty) (\_p -> liftM (parens . hcat . punctuate comma) 
+  [ ifTerm (isTupleTy.ty) (\_p -> liftM (parens . hcat . punctuate comma)
                                       . mapM (y (-1))
                                       . subTerms)
   , ifTerm (\t -> isTyCon listTyCon (ty t) && subTerms t `lengthIs` 2)
@@ -439,7 +433,7 @@ cPprTermBase y =
   , ifTerm (isTyCon doubleTyCon . ty) ppr_double
   , ifTerm (isIntegerTy         . ty) ppr_integer
   ]
- where 
+ where
    ifTerm :: (Term -> Bool)
           -> (Precedence -> Term -> m SDoc)
           -> Precedence -> Term -> m (Maybe SDoc)
@@ -447,11 +441,11 @@ cPprTermBase y =
        | pred t    = Just `liftM` f prec t
    ifTerm _ _ _ _  = return Nothing
 
-   isTupleTy ty    = fromMaybe False $ do 
-     (tc,_) <- tcSplitTyConApp_maybe ty 
+   isTupleTy ty    = fromMaybe False $ do
+     (tc,_) <- tcSplitTyConApp_maybe ty
      return (isBoxedTupleTyCon tc)
 
-   isTyCon a_tc ty = fromMaybe False $ do 
+   isTyCon a_tc ty = fromMaybe False $ do
      (tc,_) <- tcSplitTyConApp_maybe ty
      return (a_tc == tc)
 
@@ -459,7 +453,7 @@ cPprTermBase y =
      (tc,_) <- tcSplitTyConApp_maybe ty
      return (tyConName tc == integerTyConName)
 
-   ppr_int, ppr_char, ppr_float, ppr_double, ppr_integer 
+   ppr_int, ppr_char, ppr_float, ppr_double, ppr_integer
       :: Precedence -> Term -> m SDoc
    ppr_int     _ v = return (Ppr.int     (unsafeCoerce# (val v)))
    ppr_char    _ v = return (Ppr.char '\'' <> Ppr.char (unsafeCoerce# (val v)) <> Ppr.char '\'')
@@ -472,16 +466,16 @@ cPprTermBase y =
    ppr_list p (Term{subTerms=[h,t]}) = do
        let elems      = h : getListTerms t
            isConsLast = not(termType(last elems) `eqType` termType h)
-   	   is_string  = all (isCharTy . ty) elems
+           is_string  = all (isCharTy . ty) elems
 
        print_elems <- mapM (y cons_prec) elems
        if is_string
         then return (Ppr.doubleQuotes (Ppr.text (unsafeCoerce# (map val elems))))
         else if isConsLast
-        then return $ cparen (p >= cons_prec) 
-                    $ pprDeeperList fsep 
+        then return $ cparen (p >= cons_prec)
+                    $ pprDeeperList fsep
                     $ punctuate (space<>colon) print_elems
-        else return $ brackets 
+        else return $ brackets
                     $ pprDeeperList fcat
                     $ punctuate comma print_elems
 
@@ -513,16 +507,18 @@ repPrim t = rep where
     | t == threadIdPrimTyCon         = text "<ThreadId>"
     | t == weakPrimTyCon             = text "<Weak>"
     | t == arrayPrimTyCon            = text "<array>"
+    | t == smallArrayPrimTyCon       = text "<smallArray>"
     | t == byteArrayPrimTyCon        = text "<bytearray>"
     | t == mutableArrayPrimTyCon     = text "<mutableArray>"
+    | t == smallMutableArrayPrimTyCon = text "<smallMutableArray>"
     | t == mutableByteArrayPrimTyCon = text "<mutableByteArray>"
     | t == mutVarPrimTyCon           = text "<mutVar>"
     | t == mVarPrimTyCon             = text "<mVar>"
     | t == tVarPrimTyCon             = text "<tVar>"
     | otherwise                      = char '<' <> ppr t <> char '>'
-    where build ww = unsafePerformIO $ withArray ww (peek . castPtr) 
---   This ^^^ relies on the representation of Haskell heap values being 
---   the same as in a C array. 
+    where build ww = unsafePerformIO $ withArray ww (peek . castPtr)
+--   This ^^^ relies on the representation of Haskell heap values being
+--   the same as in a C array.
 
 -----------------------------------
 -- Type Reconstruction
@@ -533,14 +529,14 @@ The algorithm walks the heap generating a set of equations, which
 are solved with syntactic unification.
 A type reconstruction equation looks like:
 
-  <datacon reptype>  =  <actual heap contents> 
+  <datacon reptype>  =  <actual heap contents>
 
 The full equation set is generated by traversing all the subterms, starting
 from a given term.
 
 The only difficult part is that newtypes are only found in the lhs of equations.
-Right hand sides are missing them. We can either (a) drop them from the lhs, or 
-(b) reconstruct them in the rhs when possible. 
+Right hand sides are missing them. We can either (a) drop them from the lhs, or
+(b) reconstruct them in the rhs when possible.
 
 The function congruenceNewtypes takes a shot at (b)
 -}
@@ -570,7 +566,7 @@ runTR hsc_env thing = do
 
 runTR_maybe :: HscEnv -> TR a -> IO (Maybe a)
 runTR_maybe hsc_env thing_inside
-  = do { (_errs, res) <- initTc hsc_env HsSrcFile False 
+  = do { (_errs, res) <- initTc hsc_env HsSrcFile False
                                 (icInteractiveModule (hsc_IC hsc_env))
                                 thing_inside
        ; return res }
@@ -579,17 +575,17 @@ traceTR :: SDoc -> TR ()
 traceTR = liftTcM . traceOptTcRn Opt_D_dump_rtti
 
 
--- Semantically different to recoverM in TcRnMonad 
+-- Semantically different to recoverM in TcRnMonad
 -- recoverM retains the errors in the first action,
 --  whereas recoverTc here does not
 recoverTR :: TR a -> TR a -> TR a
-recoverTR recover thing = do 
+recoverTR recover thing = do
   (_,mb_res) <- tryTcErrs thing
-  case mb_res of 
+  case mb_res of
     Nothing  -> recover
     Just res -> return res
 
-trIO :: IO a -> TR a 
+trIO :: IO a -> TR a
 trIO = liftTcM . liftIO
 
 liftTcM :: TcM a -> TR a
@@ -604,17 +600,17 @@ instTyVars :: [TyVar] -> TR ([TcTyVar], [TcType], TvSubst)
 instTyVars = liftTcM . tcInstTyVars
 
 type RttiInstantiation = [(TcTyVar, TyVar)]
-   -- Associates the typechecker-world meta type variables 
-   -- (which are mutable and may be refined), to their 
+   -- Associates the typechecker-world meta type variables
+   -- (which are mutable and may be refined), to their
    -- 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 RuntimeUnk
 
--- | Returns the instantiated type scheme ty', and the 
+-- | Returns the instantiated type scheme ty', and the
 --   mapping from new (instantiated) -to- old (skolem) type variables
 instScheme :: QuantifiedType -> TR (TcType, RttiInstantiation)
-instScheme (tvs, ty) 
+instScheme (tvs, ty)
   = liftTcM $ do { (tvs', _, subst) <- tcInstTyVars tvs
                  ; let rtti_inst = [(tv',tv) | (tv',tv) <- tvs' `zip` tvs]
                  ; return (substTy subst ty, rtti_inst) }
@@ -694,7 +690,7 @@ cvObtainTerm hsc_env max_depth force old_ty hval = runTR hsc_env $ do
             text "Term obtained: " <> ppr term $$
             text "Type obtained: " <> ppr (termType term))
    return term
-    where 
+    where
   dflags = hsc_dflags hsc_env
 
   go :: Int -> Type -> Type -> HValue -> TcM Term
@@ -711,7 +707,7 @@ cvObtainTerm hsc_env max_depth force old_ty hval = runTR hsc_env $ do
     clos <- trIO $ getClosureData dflags a
     return (Suspension (tipe clos) my_ty a Nothing)
   go max_depth my_ty old_ty a = do
-    let monomorphic = not(isTyVarTy my_ty)   
+    let monomorphic = not(isTyVarTy my_ty)
     -- This ^^^ is a convention. The ancestor tests for
     -- monomorphism and passes a type instead of a tv
     clos <- trIO $ getClosureData dflags a
@@ -731,14 +727,14 @@ cvObtainTerm hsc_env max_depth force old_ty hval = runTR hsc_env $ do
       MutVar _ | Just (tycon,[world,contents_ty]) <- tcSplitTyConApp_maybe old_ty
              -> do
                   -- Deal with the MutVar# primitive
-                  -- It does not have a constructor at all, 
+                  -- It does not have a constructor at all,
                   -- so we simulate the following one
                   -- MutVar# :: contents_ty -> MutVar# s contents_ty
          traceTR (text "Following a MutVar")
          contents_tv <- newVar liftedTypeKind
          contents <- trIO$ IO$ \w -> readMutVar# (unsafeCoerce# a) w
          ASSERT(isUnliftedTypeKind $ typeKind my_ty) return ()
-         (mutvar_ty,_) <- instScheme $ quantifyType $ mkFunTy 
+         (mutvar_ty,_) <- instScheme $ quantifyType $ mkFunTy
                             contents_ty (mkTyConApp tycon [world,contents_ty])
          addConstraint (mkFunTy contents_tv my_ty) mutvar_ty
          x <- go (pred max_depth) contents_tv contents_ty contents
@@ -758,12 +754,12 @@ cvObtainTerm hsc_env max_depth force old_ty hval = runTR hsc_env $ do
                         -- In such case, we return a best approximation:
                         --  ignore the unpointed args, and recover the pointeds
                         -- This preserves laziness, and should be safe.
-		       traceTR (text "Not constructor" <+> ppr dcname)
+                       traceTR (text "Not constructor" <+> ppr dcname)
                        let dflags = hsc_dflags hsc_env
                            tag = showPpr dflags dcname
-                       vars     <- replicateM (length$ elems$ ptrs clos) 
+                       vars     <- replicateM (length$ elems$ ptrs clos)
                                               (newVar liftedTypeKind)
-                       subTerms <- sequence [appArr (go (pred max_depth) tv tv) (ptrs clos) i 
+                       subTerms <- sequence [appArr (go (pred max_depth) tv tv) (ptrs clos) i
                                               | (i, tv) <- zip [0..] vars]
                        return (Term my_ty (Left ('<' : tag ++ ">")) a subTerms)
           Just dc -> do
@@ -871,7 +867,7 @@ cvReconstructType hsc_env max_depth old_ty hval = runTR_maybe hsc_env $ do
   search _ _ _ 0 = traceTR (text "Failed to reconstruct a type after " <>
                                 int max_depth <> text " steps")
   search stop expand l d =
-    case viewl l of 
+    case viewl l of
       EmptyL  -> return ()
       x :< xx -> unlessM stop $ do
                   new <- expand x
@@ -917,7 +913,7 @@ findPtrTys i ty
   | Just (tc, elem_tys) <- tcSplitTyConApp_maybe ty
   , isUnboxedTupleTyCon tc
   = findPtrTyss i elem_tys
-  
+
   | otherwise
   = case repType ty of
       UnaryRep rep_ty | typePrimRep rep_ty == PtrRep -> return (i + 1, [(i, ty)])
@@ -939,8 +935,7 @@ findPtrTyss i tys = foldM step (i, []) tys
 -- The types can contain skolem type variables, which need to be treated as normal vars.
 -- In particular, we want them to unify with things.
 improveRTTIType :: HscEnv -> RttiType -> RttiType -> Maybe TvSubst
-improveRTTIType _ base_ty new_ty
-  = U.tcUnifyTys (const U.BindMe) [base_ty] [new_ty]
+improveRTTIType _ base_ty new_ty = U.tcUnifyTy base_ty new_ty
 
 getDataConArgTys :: DataCon -> Type -> TR [Type]
 -- Given the result type ty of a constructor application (D a b c :: ty)
@@ -951,7 +946,7 @@ getDataConArgTys :: DataCon -> Type -> TR [Type]
 -- I believe that con_app_ty should not have any enclosing foralls
 getDataConArgTys dc con_app_ty
   = do { let UnaryRep rep_con_app_ty = repType con_app_ty
-       ; traceTR (text "getDataConArgTys 1" <+> (ppr con_app_ty $$ ppr rep_con_app_ty 
+       ; traceTR (text "getDataConArgTys 1" <+> (ppr con_app_ty $$ ppr rep_con_app_ty
                    $$ ppr (tcSplitTyConApp_maybe rep_con_app_ty)))
        ; (_, _, subst) <- instTyVars (univ_tvs ++ ex_tvs)
        ; addConstraint rep_con_app_ty (substTy subst (dataConOrigResTy dc))
@@ -972,7 +967,7 @@ Consider a GADT (cf Trac #7386)
      ...
 
 In getDataConArgTys
-* con_app_ty is the known type (from outside) of the constructor application, 
+* con_app_ty is the known type (from outside) of the constructor application,
   say D [Int] Int
 
 * The data constructor MkT has a (representation) dataConTyCon = DList,
@@ -981,7 +976,7 @@ In getDataConArgTys
       MkT :: a -> DList a (Maybe a)
       ...
 
-So the dataConTyCon of the data constructor, DList, differs from 
+So the dataConTyCon of the data constructor, DList, differs from
 the "outside" type, D. So we can't straightforwardly decompose the
 "outside" type, and we end up in the "_" branch of the case.
 
@@ -1123,9 +1118,9 @@ check2 (_, rtti_ty) (_, old_ty)
 -- Dealing with newtypes
 --------------------------
 {-
- congruenceNewtypes does a parallel fold over two Type values, 
- compensating for missing newtypes on both sides. 
- This is necessary because newtypes are not present 
+ congruenceNewtypes does a parallel fold over two Type values,
+ compensating for missing newtypes on both sides.
+ This is necessary because newtypes are not present
  in runtime, but sometimes there is evidence available.
    Evidence can come from DataCon signatures or
  from compile-time type inference.
@@ -1171,8 +1166,8 @@ congruenceNewtypes lhs rhs = go lhs rhs >>= \rhs' -> return (lhs,rhs')
          return (mkFunTy r1' r2')
 -- TyconApp Inductive case; this is the interesting bit.
     | Just (tycon_l, _) <- tcSplitTyConApp_maybe lhs
-    , Just (tycon_r, _) <- tcSplitTyConApp_maybe rhs 
-    , tycon_l /= tycon_r 
+    , Just (tycon_r, _) <- tcSplitTyConApp_maybe rhs
+    , tycon_l /= tycon_r
     = upgrade tycon_l r
 
     | otherwise = return r
@@ -1182,7 +1177,7 @@ congruenceNewtypes lhs rhs = go lhs rhs >>= \rhs' -> return (lhs,rhs')
             | not (isNewTyCon new_tycon) = do
               traceTR (text "(Upgrade) Not matching newtype evidence: " <>
                        ppr new_tycon <> text " for " <> ppr ty)
-              return ty 
+              return ty
             | otherwise = do
                traceTR (text "(Upgrade) upgraded " <> ppr ty <>
                         text " in presence of newtype evidence " <> ppr new_tycon)
@@ -1190,7 +1185,7 @@ congruenceNewtypes lhs rhs = go lhs rhs >>= \rhs' -> return (lhs,rhs')
                let ty' = mkTyConApp new_tycon vars
                    UnaryRep rep_ty = repType ty'
                _ <- liftTcM (unifyType ty rep_ty)
-        -- assumes that reptype doesn't ^^^^ touch tyconApp args 
+        -- assumes that reptype doesn't ^^^^ touch tyconApp args
                return ty'
 
 
@@ -1202,7 +1197,7 @@ zonkTerm = foldTermM (TermFoldM
                                              return (Suspension ct ty v b)
              , fNewtypeWrapM = \ty dc t -> zonkRttiType ty >>= \ty' ->
                                            return$ NewtypeWrap ty' dc t
-             , fRefWrapM     = \ty t -> return RefWrap  `ap` 
+             , fRefWrapM     = \ty t -> return RefWrap  `ap`
                                         zonkRttiType ty `ap` return t
              , fPrimM        = (return.) . Prim })
 
@@ -1211,13 +1206,13 @@ zonkRttiType :: TcType -> TcM Type
 -- by skolems, safely out of Meta-tyvar-land
 zonkRttiType = zonkTcTypeToType (mkEmptyZonkEnv zonk_unbound_meta)
   where
-    zonk_unbound_meta tv 
+    zonk_unbound_meta tv
       = ASSERT( isTcTyVar tv )
         do { tv' <- skolemiseUnboundMetaTyVar tv RuntimeUnk
-	     -- This is where RuntimeUnks are born: 
-	     -- otherwise-unconstrained unification variables are
-	     -- turned into RuntimeUnks as they leave the
-	     -- typechecker's monad
+             -- This is where RuntimeUnks are born:
+             -- otherwise-unconstrained unification variables are
+             -- turned into RuntimeUnks as they leave the
+             -- typechecker's monad
            ; return (mkTyVarTy tv') }
 
 --------------------------------------------------------------------------------
diff --git a/compiler/hsSyn/Convert.lhs b/compiler/hsSyn/Convert.lhs
index 9996e620f008..d722a402e07f 100644
--- a/compiler/hsSyn/Convert.lhs
+++ b/compiler/hsSyn/Convert.lhs
@@ -6,6 +6,8 @@
 This module converts Template Haskell syntax into HsSyn
 
 \begin{code}
+{-# LANGUAGE MagicHash #-}
+
 module Convert( convertToHsExpr, convertToPat, convertToHsDecls,
                 convertToHsType,
                 thRdrNameGuesses ) where
@@ -22,6 +24,7 @@ import SrcLoc
 import Type
 import qualified Coercion ( Role(..) )
 import TysWiredIn
+import TysPrim (eqPrimTyCon)
 import BasicTypes as Hs
 import ForeignCall
 import Unique
@@ -198,13 +201,20 @@ cvtDec (ClassD ctxt cl tvs fds decs)
         ; unless (null adts')
             (failWith $ (ptext (sLit "Default data instance declarations are not allowed:"))
                    $$ (Outputable.ppr adts'))
+        ; at_defs <- mapM cvt_at_def ats'
         ; returnL $ TyClD $
           ClassDecl { tcdCtxt = cxt', tcdLName = tc', tcdTyVars = tvs'
                     , tcdFDs = fds', tcdSigs = sigs', tcdMeths = binds'
-                    , tcdATs = fams', tcdATDefs = ats', tcdDocs = []
+                    , tcdATs = fams', tcdATDefs = at_defs, tcdDocs = []
                     , tcdFVs = placeHolderNames }
                               -- no docs in TH ^^
         }
+  where
+    cvt_at_def :: LTyFamInstDecl RdrName -> CvtM (LTyFamDefltEqn RdrName)
+    -- Very similar to what happens in RdrHsSyn.mkClassDecl
+    cvt_at_def decl = case RdrHsSyn.mkATDefault decl of
+                        Right def     -> return def
+                        Left (_, msg) -> failWith msg
 
 cvtDec (InstanceD ctxt ty decs)
   = do  { let doc = ptext (sLit "an instance declaration")
@@ -213,7 +223,7 @@ cvtDec (InstanceD ctxt ty decs)
         ; ctxt' <- cvtContext ctxt
         ; L loc ty' <- cvtType ty
         ; let inst_ty' = L loc $ mkImplicitHsForAllTy ctxt' $ L loc ty'
-        ; returnL $ InstD (ClsInstD (ClsInstDecl inst_ty' binds' sigs' ats' adts')) }
+        ; returnL $ InstD (ClsInstD (ClsInstDecl inst_ty' binds' sigs' ats' adts' Nothing)) }
 
 cvtDec (ForeignD ford)
   = do { ford' <- cvtForD ford
@@ -277,9 +287,9 @@ cvtTySynEqn :: Located RdrName -> TySynEqn -> CvtM (LTyFamInstEqn RdrName)
 cvtTySynEqn tc (TySynEqn lhs rhs)
   = do  { lhs' <- mapM cvtType lhs
         ; rhs' <- cvtType rhs
-        ; returnL $ TyFamInstEqn { tfie_tycon = tc
-                                 , tfie_pats = mkHsWithBndrs lhs'
-                                 , tfie_rhs = rhs' } }
+        ; returnL $ TyFamEqn { tfe_tycon = tc
+                             , tfe_pats = mkHsWithBndrs lhs'
+                             , tfe_rhs = rhs' } }
 
 ----------------
 cvt_ci_decs :: MsgDoc -> [TH.Dec]
@@ -300,7 +310,7 @@ cvt_ci_decs doc decs
         ; unless (null bads) (failWith (mkBadDecMsg doc bads))
           --We use FromSource as the origin of the bind
           -- because the TH declaration is user-written
-        ; return (listToBag (map (\bind -> (FromSource, bind)) binds'), sigs', fams', ats', adts') }
+        ; return (listToBag binds', sigs', fams', ats', adts') }
 
 ----------------
 cvt_tycl_hdr :: TH.Cxt -> TH.Name -> [TH.TyVarBndr]
@@ -535,9 +545,7 @@ cvtLocalDecs doc ds
        ; let (binds, prob_sigs) = partitionWith is_bind ds'
        ; let (sigs, bads) = partitionWith is_sig prob_sigs
        ; unless (null bads) (failWith (mkBadDecMsg doc bads))
-       ; return (HsValBinds (ValBindsIn (toBindBag binds) sigs)) }
-  where
-    toBindBag = listToBag . map (\bind -> (FromSource, bind))
+       ; return (HsValBinds (ValBindsIn (listToBag binds) sigs)) }
 
 cvtClause :: TH.Clause -> CvtM (Hs.LMatch RdrName (LHsExpr RdrName))
 cvtClause (Clause ps body wheres)
@@ -562,10 +570,10 @@ cvtl e = wrapL (cvt e)
 
     cvt (AppE x y)     = do { x' <- cvtl x; y' <- cvtl y; return $ HsApp x' y' }
     cvt (LamE ps e)    = do { ps' <- cvtPats ps; e' <- cvtl e
-                            ; return $ HsLam (mkMatchGroup [mkSimpleMatch ps' e']) }
+                            ; return $ HsLam (mkMatchGroup FromSource [mkSimpleMatch ps' e']) }
     cvt (LamCaseE ms)  = do { ms' <- mapM cvtMatch ms
                             ; return $ HsLamCase placeHolderType
-                                                 (mkMatchGroup ms')
+                                                 (mkMatchGroup FromSource ms')
                             }
     cvt (TupE [e])     = do { e' <- cvtl e; return $ HsPar e' }
                                  -- Note [Dropping constructors]
@@ -581,7 +589,7 @@ cvtl e = wrapL (cvt e)
     cvt (LetE ds e)    = do { ds' <- cvtLocalDecs (ptext (sLit "a let expression")) ds
                             ; e' <- cvtl e; return $ HsLet ds' e' }
     cvt (CaseE e ms)   = do { e' <- cvtl e; ms' <- mapM cvtMatch ms
-                            ; return $ HsCase e' (mkMatchGroup ms') }
+                            ; return $ HsCase e' (mkMatchGroup FromSource ms') }
     cvt (DoE ss)       = cvtHsDo DoExpr ss
     cvt (CompE ss)     = cvtHsDo ListComp ss
     cvt (ArithSeqE dd) = do { dd' <- cvtDD dd; return $ ArithSeq noPostTcExpr Nothing dd' }
@@ -829,8 +837,8 @@ cvtp (TH.LitP l)
   | otherwise          = do { l' <- cvtLit l; return $ Hs.LitPat l' }
 cvtp (TH.VarP s)       = do { s' <- vName s; return $ Hs.VarPat s' }
 cvtp (TupP [p])        = do { p' <- cvtPat p; return $ ParPat p' } -- Note [Dropping constructors]
-cvtp (TupP ps)         = do { ps' <- cvtPats ps; return $ TuplePat ps' Boxed void }
-cvtp (UnboxedTupP ps)  = do { ps' <- cvtPats ps; return $ TuplePat ps' Unboxed void }
+cvtp (TupP ps)         = do { ps' <- cvtPats ps; return $ TuplePat ps' Boxed   [] }
+cvtp (UnboxedTupP ps)  = do { ps' <- cvtPats ps; return $ TuplePat ps' Unboxed [] }
 cvtp (ConP s ps)       = do { s' <- cNameL s; ps' <- cvtPats ps
                             ; return $ ConPatIn s' (PrefixCon ps') }
 cvtp (InfixP p1 s p2)  = do { s' <- cNameL s; p1' <- cvtPat p1; p2' <- cvtPat p2
@@ -894,16 +902,7 @@ cvtContext :: TH.Cxt -> CvtM (LHsContext RdrName)
 cvtContext tys = do { preds' <- mapM cvtPred tys; returnL preds' }
 
 cvtPred :: TH.Pred -> CvtM (LHsType RdrName)
-cvtPred (TH.ClassP cla tys)
-  = do { cla' <- if isVarName cla then tName cla else tconName cla
-       ; tys' <- mapM cvtType tys
-       ; mk_apps (HsTyVar cla') tys'
-       }
-cvtPred (TH.EqualP ty1 ty2)
-  = do { ty1' <- cvtType ty1
-       ; ty2' <- cvtType ty2
-       ; returnL $ HsEqTy ty1' ty2'
-       }
+cvtPred = cvtType
 
 cvtType :: TH.Type -> CvtM (LHsType RdrName)
 cvtType = cvtTypeKind "type"
@@ -983,6 +982,10 @@ cvtTypeKind ty_str ty
            ConstraintT
              -> returnL (HsTyVar (getRdrName constraintKindTyCon))
 
+           EqualityT
+             | [x',y'] <- tys' -> returnL (HsEqTy x' y')
+             | otherwise       -> mk_apps (HsTyVar (getRdrName eqPrimTyCon)) tys'
+
            _ -> failWith (ptext (sLit ("Malformed " ++ ty_str)) <+> text (show ty))
     }
 
@@ -1112,8 +1115,10 @@ thRdrName loc ctxt_ns th_occ th_name
      TH.NameQ mod  -> (mkRdrQual  $! mk_mod mod) $! occ
      TH.NameL uniq -> nameRdrName $! (((Name.mkInternalName $! mk_uniq uniq) $! occ) loc)
      TH.NameU uniq -> nameRdrName $! (((Name.mkSystemNameAt $! mk_uniq uniq) $! occ) loc)
-     TH.NameS | Just name <- isBuiltInOcc ctxt_ns th_occ -> nameRdrName $! name
-              | otherwise                                -> mkRdrUnqual $! occ
+     TH.NameS | Just name <- isBuiltInOcc_maybe occ -> nameRdrName $! name
+              | otherwise                           -> mkRdrUnqual $! occ
+              -- We check for built-in syntax here, because the TH
+              -- user might have written a (NameS "(,,)"), for example
   where
     occ :: OccName.OccName
     occ = mk_occ ctxt_ns th_occ
@@ -1133,25 +1138,6 @@ thRdrNameGuesses (TH.Name occ flavour)
                 | otherwise                       = [OccName.varName, OccName.tvName]
     occ_str = TH.occString occ
 
-isBuiltInOcc :: OccName.NameSpace -> String -> Maybe Name.Name
--- Built in syntax isn't "in scope" so an Unqual RdrName won't do
--- We must generate an Exact name, just as the parser does
-isBuiltInOcc ctxt_ns occ
-  = case occ of
-        ":"              -> Just (Name.getName consDataCon)
-        "[]"             -> Just (Name.getName nilDataCon)
-        "()"             -> Just (tup_name 0)
-        '(' : ',' : rest -> go_tuple 2 rest
-        _                -> Nothing
-  where
-    go_tuple n ")"          = Just (tup_name n)
-    go_tuple n (',' : rest) = go_tuple (n+1) rest
-    go_tuple _ _            = Nothing
-
-    tup_name n
-        | OccName.isTcClsNameSpace ctxt_ns = Name.getName (tupleTyCon BoxedTuple n)
-        | otherwise                        = Name.getName (tupleCon BoxedTuple n)
-
 -- The packing and unpacking is rather turgid :-(
 mk_occ :: OccName.NameSpace -> String -> OccName.OccName
 mk_occ ns occ = OccName.mkOccName ns occ
@@ -1164,8 +1150,8 @@ mk_ghc_ns TH.VarName   = OccName.varName
 mk_mod :: TH.ModName -> ModuleName
 mk_mod mod = mkModuleName (TH.modString mod)
 
-mk_pkg :: TH.PkgName -> PackageId
-mk_pkg pkg = stringToPackageId (TH.pkgString pkg)
+mk_pkg :: TH.PkgName -> PackageKey
+mk_pkg pkg = stringToPackageKey (TH.pkgString pkg)
 
 mk_uniq :: Int# -> Unique
 mk_uniq u = mkUniqueGrimily (I# u)
@@ -1179,7 +1165,7 @@ Consider this TH term construction:
      ; x3 <- TH.newName "x"
 
      ; let x = mkName "x"     -- mkName :: String -> TH.Name
-                              -- Builds a NameL
+                              -- Builds a NameS
 
      ; return (LamE (..pattern [x1,x2]..) $
                LamE (VarPat x3) $
diff --git a/compiler/hsSyn/HsBinds.lhs b/compiler/hsSyn/HsBinds.lhs
index e904633eec64..04a72225f1ac 100644
--- a/compiler/hsSyn/HsBinds.lhs
+++ b/compiler/hsSyn/HsBinds.lhs
@@ -89,7 +89,7 @@ type LHsBind  id = LHsBindLR  id id
 type LHsBinds id = LHsBindsLR id id
 type HsBind   id = HsBindLR   id id
 
-type LHsBindsLR idL idR = Bag (Origin, LHsBindLR idL idR)
+type LHsBindsLR idL idR = Bag (LHsBindLR idL idR)
 type LHsBindLR  idL idR = Located (HsBindLR idL idR)
 
 data HsBindLR idL idR
@@ -166,13 +166,7 @@ data HsBindLR idL idR
         abs_binds    :: LHsBinds idL   -- ^ Typechecked user bindings
     }
 
-  | PatSynBind {
-        patsyn_id   :: Located idL,                   -- ^ Name of the pattern synonym
-        bind_fvs    :: NameSet,                       -- ^ See Note [Bind free vars]
-        patsyn_args :: HsPatSynDetails (Located idR), -- ^ Formal parameter names
-        patsyn_def  :: LPat idR,                      -- ^ Right-hand side
-        patsyn_dir  :: HsPatSynDir idR                -- ^ Directionality
-    }
+  | PatSynBind (PatSynBind idL idR)
 
   deriving (Data, Typeable)
         -- Consider (AbsBinds tvs ds [(ftvs, poly_f, mono_f) binds]
@@ -195,6 +189,14 @@ data ABExport id
         , abe_prags :: TcSpecPrags  -- ^ SPECIALISE pragmas
   } deriving (Data, Typeable)
 
+data PatSynBind idL idR
+  = PSB { psb_id   :: Located idL,                   -- ^ Name of the pattern synonym
+          psb_fvs  :: NameSet,                       -- ^ See Note [Bind free vars]
+          psb_args :: HsPatSynDetails (Located idR), -- ^ Formal parameter names
+          psb_def  :: LPat idR,                      -- ^ Right-hand side
+          psb_dir  :: HsPatSynDir idR                -- ^ Directionality
+  } deriving (Data, Typeable)
+
 -- | Used for the NameSet in FunBind and PatBind prior to the renamer
 placeHolderNames :: NameSet
 placeHolderNames = panic "placeHolderNames"
@@ -322,7 +324,7 @@ instance (OutputableBndr idL, OutputableBndr idR) => Outputable (HsValBindsLR id
 pprLHsBinds :: (OutputableBndr idL, OutputableBndr idR) => LHsBindsLR idL idR -> SDoc
 pprLHsBinds binds
   | isEmptyLHsBinds binds = empty
-  | otherwise = pprDeclList (map (ppr . snd) (bagToList binds))
+  | otherwise = pprDeclList (map ppr (bagToList binds))
 
 pprLHsBindsForUser :: (OutputableBndr idL, OutputableBndr idR, OutputableBndr id2)
                    => LHsBindsLR idL idR -> [LSig id2] -> [SDoc]
@@ -338,7 +340,7 @@ pprLHsBindsForUser binds sigs
 
     decls :: [(SrcSpan, SDoc)]
     decls = [(loc, ppr sig)  | L loc sig <- sigs] ++
-            [(loc, ppr bind) | (_, L loc bind) <- bagToList binds]
+            [(loc, ppr bind) | L loc bind <- bagToList binds]
 
     sort_by_loc decls = sortBy (comparing fst) decls
 
@@ -437,20 +439,7 @@ ppr_monobind (FunBind { fun_id = fun, fun_infix = inf,
     $$  ifPprDebug (pprBndr LetBind (unLoc fun))
     $$  pprFunBind (unLoc fun) inf matches
     $$  ifPprDebug (ppr wrap)
-ppr_monobind (PatSynBind{ patsyn_id = L _ psyn, patsyn_args = details,
-                          patsyn_def = pat, patsyn_dir = dir })
-  = ppr_lhs <+> ppr_rhs
-      where
-        ppr_lhs = ptext (sLit "pattern") <+> ppr_details details
-        ppr_simple syntax = syntax <+> ppr pat
-
-        ppr_details (InfixPatSyn v1 v2) = hsep [ppr v1, pprInfixOcc psyn, ppr v2]
-        ppr_details (PrefixPatSyn vs)   = hsep (pprPrefixOcc psyn : map ppr vs)
-
-        ppr_rhs = case dir of
-            Unidirectional         -> ppr_simple (ptext (sLit "<-"))
-            ImplicitBidirectional  -> ppr_simple equals
-
+ppr_monobind (PatSynBind psb) = ppr psb
 ppr_monobind (AbsBinds { abs_tvs = tyvars, abs_ev_vars = dictvars
                        , abs_exports = exports, abs_binds = val_binds
                        , abs_ev_binds = ev_binds })
@@ -467,6 +456,23 @@ instance (OutputableBndr id) => Outputable (ABExport id) where
     = vcat [ ppr gbl <+> ptext (sLit "<=") <+> ppr lcl
            , nest 2 (pprTcSpecPrags prags)
            , nest 2 (ppr wrap)]
+
+instance (OutputableBndr idL, OutputableBndr idR) => Outputable (PatSynBind idL idR) where
+  ppr (PSB{ psb_id = L _ psyn, psb_args = details, psb_def = pat, psb_dir = dir })
+      = ppr_lhs <+> ppr_rhs
+    where
+      ppr_lhs = ptext (sLit "pattern") <+> ppr_details
+      ppr_simple syntax = syntax <+> ppr pat
+
+      (is_infix, ppr_details) = case details of
+          InfixPatSyn v1 v2 -> (True, hsep [ppr v1, pprInfixOcc psyn, ppr v2])
+          PrefixPatSyn vs   -> (False, hsep (pprPrefixOcc psyn : map ppr vs))
+
+      ppr_rhs = case dir of
+          Unidirectional           -> ppr_simple (ptext (sLit "<-"))
+          ImplicitBidirectional    -> ppr_simple equals
+          ExplicitBidirectional mg -> ppr_simple (ptext (sLit "<-")) <+> ptext (sLit "where") $$
+                                      (nest 2 $ pprFunBind psyn is_infix mg)
 \end{code}
 
 
@@ -785,10 +791,9 @@ instance Traversable HsPatSynDetails where
     traverse f (InfixPatSyn left right) = InfixPatSyn <$> f left <*> f right
     traverse f (PrefixPatSyn args) = PrefixPatSyn <$> traverse f args
 
-data HsPatSynDirLR idL idR
+data HsPatSynDir id
   = Unidirectional
   | ImplicitBidirectional
+  | ExplicitBidirectional (MatchGroup id (LHsExpr id))
   deriving (Data, Typeable)
-
-type HsPatSynDir id = HsPatSynDirLR id id
 \end{code}
diff --git a/compiler/hsSyn/HsDecls.lhs b/compiler/hsSyn/HsDecls.lhs
index bae804eb079b..9680c89e9b36 100644
--- a/compiler/hsSyn/HsDecls.lhs
+++ b/compiler/hsSyn/HsDecls.lhs
@@ -23,13 +23,14 @@ module HsDecls (
   tyFamInstDeclName, tyFamInstDeclLName,
   countTyClDecls, pprTyClDeclFlavour,
   tyClDeclLName, tyClDeclTyVars,
+  hsDeclHasCusk, famDeclHasCusk,
   FamilyDecl(..), LFamilyDecl,
 
   -- ** Instance declarations
   InstDecl(..), LInstDecl, NewOrData(..), FamilyInfo(..),
   TyFamInstDecl(..), LTyFamInstDecl, instDeclDataFamInsts,
   DataFamInstDecl(..), LDataFamInstDecl, pprDataFamInstFlavour,
-  TyFamInstEqn(..), LTyFamInstEqn,
+  TyFamEqn(..), TyFamInstEqn, LTyFamInstEqn, TyFamDefltEqn, LTyFamDefltEqn,
   LClsInstDecl, ClsInstDecl(..),
 
   -- ** Standalone deriving declarations
@@ -93,6 +94,7 @@ import Bag
 import Data.Data        hiding (TyCon)
 import Data.Foldable (Foldable)
 import Data.Traversable
+import Data.Maybe
 \end{code}
 
 %************************************************************************
@@ -472,7 +474,7 @@ data TyClDecl name
                 tcdSigs    :: [LSig name],              -- ^ Methods' signatures
                 tcdMeths   :: LHsBinds name,            -- ^ Default methods
                 tcdATs     :: [LFamilyDecl name],       -- ^ Associated types; ie
-                tcdATDefs  :: [LTyFamInstDecl name],    -- ^ Associated type defaults
+                tcdATDefs  :: [LTyFamDefltEqn name],    -- ^ Associated type defaults
                 tcdDocs    :: [LDocDecl],               -- ^ Haddock docs
                 tcdFVs     :: NameSet
     }
@@ -573,7 +575,7 @@ tyFamInstDeclName = unLoc . tyFamInstDeclLName
 tyFamInstDeclLName :: OutputableBndr name
                    => TyFamInstDecl name -> Located name
 tyFamInstDeclLName (TyFamInstDecl { tfid_eqn =
-                     (L _ (TyFamInstEqn { tfie_tycon = ln })) })
+                     (L _ (TyFamEqn { tfe_tycon = ln })) })
   = ln
 
 tyClDeclLName :: TyClDecl name -> Located name
@@ -604,8 +606,54 @@ countTyClDecls decls
    
    isNewTy DataDecl{ tcdDataDefn = HsDataDefn { dd_ND = NewType } } = True
    isNewTy _                                                      = False
+
+-- | Does this declaration have a complete, user-supplied kind signature?
+-- See Note [Complete user-supplied kind signatures]
+hsDeclHasCusk :: TyClDecl name -> Bool
+hsDeclHasCusk (ForeignType {}) = True
+hsDeclHasCusk (FamDecl { tcdFam = fam_decl }) = famDeclHasCusk fam_decl
+hsDeclHasCusk (SynDecl { tcdTyVars = tyvars, tcdRhs = rhs })
+  = hsTvbAllKinded tyvars && rhs_annotated rhs
+  where
+    rhs_annotated (L _ ty) = case ty of
+      HsParTy lty  -> rhs_annotated lty
+      HsKindSig {} -> True
+      _            -> False
+hsDeclHasCusk (DataDecl { tcdTyVars = tyvars })  = hsTvbAllKinded tyvars
+hsDeclHasCusk (ClassDecl { tcdTyVars = tyvars }) = hsTvbAllKinded tyvars
+
+-- | Does this family declaration have a complete, user-supplied kind signature?
+famDeclHasCusk :: FamilyDecl name -> Bool
+famDeclHasCusk (FamilyDecl { fdInfo = ClosedTypeFamily _
+                           , fdTyVars = tyvars
+                           , fdKindSig = m_sig })
+  = hsTvbAllKinded tyvars && isJust m_sig
+famDeclHasCusk _ = True  -- all open families have CUSKs!
 \end{code}
 
+Note [Complete user-supplied kind signatures]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+We kind-check declarations differently if they have a complete, user-supplied
+kind signature (CUSK). This is because we can safely generalise a CUSKed
+declaration before checking all of the others, supporting polymorphic recursion.
+See https://ghc.haskell.org/trac/ghc/wiki/GhcKinds/KindInference#Proposednewstrategy
+and #9200 for lots of discussion of how we got here.
+
+A declaration has a CUSK if we can know its complete kind without doing any inference,
+at all. Here are the rules:
+
+ - A class or datatype is said to have a CUSK if and only if all of its type
+variables are annotated. Its result kind is, by construction, Constraint or *
+respectively.
+
+ - A type synonym has a CUSK if and only if all of its type variables and its
+RHS are annotated with kinds.
+
+ - A closed type family is said to have a CUSK if and only if all of its type
+variables and its return type are annotated.
+
+ - An open type family always has a CUSK -- unannotated type variables (and return type) default to *.
+
 \begin{code}
 instance OutputableBndr name
               => Outputable (TyClDecl name) where
@@ -632,7 +680,7 @@ instance OutputableBndr name
       | otherwise       -- Laid out
       = vcat [ top_matter <+> ptext (sLit "where")
              , nest 2 $ pprDeclList (map ppr ats ++
-                                     map ppr at_defs ++
+                                     map ppr_fam_deflt_eqn at_defs ++
                                      pprLHsBindsForUser methods sigs) ]
       where
         top_matter = ptext (sLit "class") 
@@ -657,7 +705,7 @@ instance (OutputableBndr name) => Outputable (FamilyDecl name) where
             ClosedTypeFamily eqns -> ( ptext (sLit "where")
                                      , if null eqns
                                        then ptext (sLit "..")
-                                       else vcat $ map ppr eqns )
+                                       else vcat $ map ppr_fam_inst_eqn eqns )
             _                     -> (empty, empty)
 
 pprFlavour :: FamilyInfo name -> SDoc
@@ -678,7 +726,7 @@ pp_vanilla_decl_head thing tyvars context
 
 pp_fam_inst_lhs :: OutputableBndr name
    => Located name
-   -> HsWithBndrs [LHsType name]
+   -> HsTyPats name
    -> HsContext name
    -> SDoc
 pp_fam_inst_lhs thing (HsWB { hswb_cts = typats }) context -- explicit type patterns
@@ -686,12 +734,13 @@ pp_fam_inst_lhs thing (HsWB { hswb_cts = typats }) context -- explicit type patt
           , hsep (map (pprParendHsType.unLoc) typats)]
 
 pprTyClDeclFlavour :: TyClDecl a -> SDoc
-pprTyClDeclFlavour (ClassDecl {})  = ptext (sLit "class")
-pprTyClDeclFlavour (FamDecl {})    = ptext (sLit "family")
-pprTyClDeclFlavour (SynDecl {})    = ptext (sLit "type")
-pprTyClDeclFlavour (DataDecl { tcdDataDefn = (HsDataDefn { dd_ND = nd }) })
-  = ppr nd
+pprTyClDeclFlavour (ClassDecl {})   = ptext (sLit "class")
+pprTyClDeclFlavour (SynDecl {})     = ptext (sLit "type")
 pprTyClDeclFlavour (ForeignType {}) = ptext (sLit "foreign type")
+pprTyClDeclFlavour (FamDecl { tcdFam = FamilyDecl { fdInfo = info }})
+  = pprFlavour info
+pprTyClDeclFlavour (DataDecl { tcdDataDefn = HsDataDefn { dd_ND = nd } })
+  = ppr nd
 \end{code}
 
 %************************************************************************
@@ -893,25 +942,49 @@ pprConDecl decl@(ConDecl { con_details = InfixCon ty1 ty2, con_res = ResTyGADT {
 %*                                                                      *
 %************************************************************************
 
+Note [Type family instance declarations in HsSyn]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+The data type TyFamEqn represents one equation of a type family instance.
+It is parameterised over its tfe_pats field:
+
+ * An ordinary type family instance declaration looks like this in source Haskell
+      type instance T [a] Int = a -> a
+   (or something similar for a closed family)
+   It is represented by a TyFamInstEqn, with *type* in the tfe_pats field.
+
+ * On the other hand, the *default instance* of an associated type looksl like
+   this in source Haskell
+      class C a where
+        type T a b
+        type T a b = a -> b   -- The default instance
+   It is represented by a TyFamDefltEqn, with *type variables8 in the tfe_pats field.
+
 \begin{code}
 ----------------- Type synonym family instances -------------
+type LTyFamInstEqn  name = Located (TyFamInstEqn  name)
+type LTyFamDefltEqn name = Located (TyFamDefltEqn name)
 
-type LTyFamInstEqn name = Located (TyFamInstEqn name)
-
--- | One equation in a type family instance declaration
-data TyFamInstEqn name   
-  = TyFamInstEqn
-       { tfie_tycon :: Located name
-       , tfie_pats  :: HsWithBndrs [LHsType name]
+type HsTyPats name = HsWithBndrs [LHsType name]
             -- ^ Type patterns (with kind and type bndrs)
             -- See Note [Family instance declaration binders]
-       , tfie_rhs   :: LHsType name }         
+
+type TyFamInstEqn  name = TyFamEqn name (HsTyPats name)
+type TyFamDefltEqn name = TyFamEqn name (LHsTyVarBndrs name)
+  -- See Note [Type family instance declarations in HsSyn]
+
+-- | One equation in a type family instance declaration
+-- See Note [Type family instance declarations in HsSyn]
+data TyFamEqn name pats
+  = TyFamEqn
+       { tfe_tycon :: Located name
+       , tfe_pats  :: pats
+       , tfe_rhs   :: LHsType name }
   deriving( Typeable, Data )
 
 type LTyFamInstDecl name = Located (TyFamInstDecl name)
-data TyFamInstDecl name 
+data TyFamInstDecl name
   = TyFamInstDecl
-       { tfid_eqn  :: LTyFamInstEqn name 
+       { tfid_eqn  :: LTyFamInstEqn name
        , tfid_fvs  :: NameSet }
   deriving( Typeable, Data )
 
@@ -921,11 +994,9 @@ type LDataFamInstDecl name = Located (DataFamInstDecl name)
 data DataFamInstDecl name
   = DataFamInstDecl
        { dfid_tycon :: Located name
-       , dfid_pats  :: HsWithBndrs [LHsType name]   -- lhs
-            -- ^ Type patterns (with kind and type bndrs)
-            -- See Note [Family instance declaration binders]
-       , dfid_defn  :: HsDataDefn  name             -- rhs
-       , dfid_fvs   :: NameSet }                    -- free vars for dependency analysis
+       , dfid_pats  :: HsTyPats name      -- LHS
+       , dfid_defn  :: HsDataDefn  name   -- RHS
+       , dfid_fvs   :: NameSet }          -- Rree vars for dependency analysis
   deriving( Typeable, Data )
 
 
@@ -937,10 +1008,11 @@ data ClsInstDecl name
       { cid_poly_ty :: LHsType name    -- Context => Class Instance-type
                                        -- Using a polytype means that the renamer conveniently
                                        -- figures out the quantified type variables for us.
-      , cid_binds :: LHsBinds name
-      , cid_sigs  :: [LSig name]                -- User-supplied pragmatic info
-      , cid_tyfam_insts :: [LTyFamInstDecl name]  -- type family instances
-      , cid_datafam_insts :: [LDataFamInstDecl name] -- data family instances
+      , cid_binds         :: LHsBinds name           -- Class methods
+      , cid_sigs          :: [LSig name]             -- User-supplied pragmatic info
+      , cid_tyfam_insts   :: [LTyFamInstDecl name]   -- Type family instances
+      , cid_datafam_insts :: [LDataFamInstDecl name] -- Data family instances
+      , cid_overlap_mode :: Maybe OverlapMode
       }
   deriving (Data, Typeable)
 
@@ -983,17 +1055,23 @@ instance (OutputableBndr name) => Outputable (TyFamInstDecl name) where
 
 pprTyFamInstDecl :: OutputableBndr name => TopLevelFlag -> TyFamInstDecl name -> SDoc
 pprTyFamInstDecl top_lvl (TyFamInstDecl { tfid_eqn = eqn })
-   = ptext (sLit "type") <+> ppr_instance_keyword top_lvl <+> (ppr eqn)
+   = ptext (sLit "type") <+> ppr_instance_keyword top_lvl <+> ppr_fam_inst_eqn eqn
 
 ppr_instance_keyword :: TopLevelFlag -> SDoc
 ppr_instance_keyword TopLevel    = ptext (sLit "instance")
 ppr_instance_keyword NotTopLevel = empty
 
-instance (OutputableBndr name) => Outputable (TyFamInstEqn name) where
-  ppr (TyFamInstEqn { tfie_tycon = tycon
-                    , tfie_pats  = pats
-                    , tfie_rhs   = rhs })
-    = (pp_fam_inst_lhs tycon pats []) <+> equals <+> (ppr rhs)
+ppr_fam_inst_eqn :: OutputableBndr name => LTyFamInstEqn name -> SDoc
+ppr_fam_inst_eqn (L _ (TyFamEqn { tfe_tycon = tycon
+                                , tfe_pats  = pats
+                                , tfe_rhs   = rhs }))
+    = pp_fam_inst_lhs tycon pats [] <+> equals <+> ppr rhs
+
+ppr_fam_deflt_eqn :: OutputableBndr name => LTyFamDefltEqn name -> SDoc
+ppr_fam_deflt_eqn (L _ (TyFamEqn { tfe_tycon = tycon
+                                 , tfe_pats  = tvs
+                                 , tfe_rhs   = rhs }))
+    = pp_vanilla_decl_head tycon tvs [] <+> equals <+> ppr rhs
 
 instance (OutputableBndr name) => Outputable (DataFamInstDecl name) where
   ppr = pprDataFamInstDecl TopLevel
@@ -1013,6 +1091,7 @@ pprDataFamInstFlavour (DataFamInstDecl { dfid_defn = (HsDataDefn { dd_ND = nd })
 instance (OutputableBndr name) => Outputable (ClsInstDecl name) where
     ppr (ClsInstDecl { cid_poly_ty = inst_ty, cid_binds = binds
                      , cid_sigs = sigs, cid_tyfam_insts = ats
+                     , cid_overlap_mode = mbOverlap
                      , cid_datafam_insts = adts })
       | null sigs, null ats, null adts, isEmptyBag binds  -- No "where" part
       = top_matter
@@ -1024,7 +1103,21 @@ instance (OutputableBndr name) => Outputable (ClsInstDecl name) where
                map (pprDataFamInstDecl NotTopLevel . unLoc) adts ++
                pprLHsBindsForUser binds sigs ]
       where
-        top_matter = ptext (sLit "instance") <+> ppr inst_ty
+        top_matter = ptext (sLit "instance") <+> ppOverlapPragma mbOverlap
+                                             <+> ppr inst_ty
+
+ppOverlapPragma :: Maybe OverlapMode -> SDoc
+ppOverlapPragma mb =
+  case mb of
+    Nothing           -> empty
+    Just NoOverlap    -> ptext (sLit "{-# NO_OVERLAP #-}")
+    Just Overlappable -> ptext (sLit "{-# OVERLAPPABLE #-}")
+    Just Overlapping  -> ptext (sLit "{-# OVERLAPPING #-}")
+    Just Overlaps     -> ptext (sLit "{-# OVERLAPS #-}")
+    Just Incoherent   -> ptext (sLit "{-# INCOHERENT #-}")
+
+
+
 
 instance (OutputableBndr name) => Outputable (InstDecl name) where
     ppr (ClsInstD     { cid_inst  = decl }) = ppr decl
@@ -1052,12 +1145,14 @@ instDeclDataFamInsts inst_decls
 \begin{code}
 type LDerivDecl name = Located (DerivDecl name)
 
-data DerivDecl name = DerivDecl { deriv_type :: LHsType name }
+data DerivDecl name = DerivDecl { deriv_type :: LHsType name
+                                , deriv_overlap_mode :: Maybe OverlapMode
+                                }
   deriving (Data, Typeable)
 
 instance (OutputableBndr name) => Outputable (DerivDecl name) where
-    ppr (DerivDecl ty) 
-        = hsep [ptext (sLit "deriving instance"), ppr ty]
+    ppr (DerivDecl ty o)
+        = hsep [ptext (sLit "deriving instance"), ppOverlapPragma o, ppr ty]
 \end{code}
 
 %************************************************************************
@@ -1236,7 +1331,7 @@ instance OutputableBndr name => Outputable (RuleDecl name) where
                nest 4 (equals <+> pprExpr (unLoc rhs) <+> text "#-}") ]
         where
           pp_forall | null ns   = empty
-                    | otherwise = text "forall" <+> fsep (map ppr ns) <> dot
+                    | otherwise = forAllLit <+> fsep (map ppr ns) <> dot
 
 instance OutputableBndr name => Outputable (RuleBndr name) where
    ppr (RuleBndr name) = ppr name
diff --git a/compiler/hsSyn/HsDoc.hs b/compiler/hsSyn/HsDoc.hs
index 1f3adafec1b1..72bf0e56a44f 100644
--- a/compiler/hsSyn/HsDoc.hs
+++ b/compiler/hsSyn/HsDoc.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE CPP, DeriveDataTypeable #-}
 
 module HsDoc (
   HsDocString(..),
@@ -20,7 +20,7 @@ newtype HsDocString = HsDocString FastString
 type LHsDocString = Located HsDocString
 
 instance Outputable HsDocString where
-  ppr _ = text "<document comment>"
+  ppr (HsDocString fs) = ftext fs
 
 ppr_mbDoc :: Maybe LHsDocString -> SDoc
 ppr_mbDoc (Just doc) = ppr doc
diff --git a/compiler/hsSyn/HsExpr.lhs b/compiler/hsSyn/HsExpr.lhs
index 4c0c955cdd93..69b6df64ec21 100644
--- a/compiler/hsSyn/HsExpr.lhs
+++ b/compiler/hsSyn/HsExpr.lhs
@@ -3,7 +3,7 @@
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
 \begin{code}
-{-# LANGUAGE DeriveDataTypeable, ScopedTypeVariables #-}
+{-# LANGUAGE CPP, DeriveDataTypeable, ScopedTypeVariables #-}
 
 -- | Abstract Haskell syntax for expressions.
 module HsExpr where
@@ -79,8 +79,6 @@ noSyntaxExpr = HsLit (HsString (fsLit "noSyntaxExpr"))
 type CmdSyntaxTable id = [(Name, SyntaxExpr id)]
 -- See Note [CmdSyntaxTable]
 
-noSyntaxTable :: CmdSyntaxTable id
-noSyntaxTable = []
 \end{code}
 
 Note [CmdSyntaxtable]
@@ -88,7 +86,7 @@ Note [CmdSyntaxtable]
 Used only for arrow-syntax stuff (HsCmdTop), the CmdSyntaxTable keeps
 track of the methods needed for a Cmd.
 
-* Before the renamer, this list is 'noSyntaxTable'
+* Before the renamer, this list is an empty list
 
 * After the renamer, it takes the form @[(std_name, HsVar actual_name)]@
   For example, for the 'arr' method
@@ -630,13 +628,13 @@ ppr_expr (HsTickPragma externalSrcLoc exp)
           ptext (sLit ")")]
 
 ppr_expr (HsArrApp arrow arg _ HsFirstOrderApp True)
-  = hsep [ppr_lexpr arrow, ptext (sLit "-<"), ppr_lexpr arg]
+  = hsep [ppr_lexpr arrow, larrowt, ppr_lexpr arg]
 ppr_expr (HsArrApp arrow arg _ HsFirstOrderApp False)
-  = hsep [ppr_lexpr arg, ptext (sLit ">-"), ppr_lexpr arrow]
+  = hsep [ppr_lexpr arg, arrowt, ppr_lexpr arrow]
 ppr_expr (HsArrApp arrow arg _ HsHigherOrderApp True)
-  = hsep [ppr_lexpr arrow, ptext (sLit "-<<"), ppr_lexpr arg]
+  = hsep [ppr_lexpr arrow, larrowtt, ppr_lexpr arg]
 ppr_expr (HsArrApp arrow arg _ HsHigherOrderApp False)
-  = hsep [ppr_lexpr arg, ptext (sLit ">>-"), ppr_lexpr arrow]
+  = hsep [ppr_lexpr arg, arrowtt, ppr_lexpr arrow]
 
 ppr_expr (HsArrForm (L _ (HsVar v)) (Just _) [arg1, arg2])
   = sep [pprCmdArg (unLoc arg1), hsep [pprInfixOcc v, pprCmdArg (unLoc arg2)]]
@@ -849,13 +847,13 @@ ppr_cmd (HsCmdCast co cmd) = sep [ ppr_cmd cmd
                                  , ptext (sLit "|>") <+> ppr co ]
 
 ppr_cmd (HsCmdArrApp arrow arg _ HsFirstOrderApp True)
-  = hsep [ppr_lexpr arrow, ptext (sLit "-<"), ppr_lexpr arg]
+  = hsep [ppr_lexpr arrow, larrowt, ppr_lexpr arg]
 ppr_cmd (HsCmdArrApp arrow arg _ HsFirstOrderApp False)
-  = hsep [ppr_lexpr arg, ptext (sLit ">-"), ppr_lexpr arrow]
+  = hsep [ppr_lexpr arg, arrowt, ppr_lexpr arrow]
 ppr_cmd (HsCmdArrApp arrow arg _ HsHigherOrderApp True)
-  = hsep [ppr_lexpr arrow, ptext (sLit "-<<"), ppr_lexpr arg]
+  = hsep [ppr_lexpr arrow, larrowtt, ppr_lexpr arg]
 ppr_cmd (HsCmdArrApp arrow arg _ HsHigherOrderApp False)
-  = hsep [ppr_lexpr arg, ptext (sLit ">>-"), ppr_lexpr arrow]
+  = hsep [ppr_lexpr arg, arrowtt, ppr_lexpr arrow]
 
 ppr_cmd (HsCmdArrForm (L _ (HsVar v)) (Just _) [arg1, arg2])
   = sep [pprCmdArg (unLoc arg1), hsep [pprInfixOcc v, pprCmdArg (unLoc arg2)]]
@@ -909,7 +907,8 @@ patterns in each equation.
 data MatchGroup id body
   = MG { mg_alts    :: [LMatch id body]  -- The alternatives
        , mg_arg_tys :: [PostTcType]      -- Types of the arguments, t1..tn
-       , mg_res_ty  :: PostTcType  }     -- Type of the result, tr 
+       , mg_res_ty  :: PostTcType        -- Type of the result, tr 
+       , mg_origin  :: Origin }
      -- The type is the type of the entire group
      --      t1 -> ... -> tn -> tr
      -- where there are n patterns
@@ -1299,7 +1298,7 @@ instance (OutputableBndr idL, OutputableBndr idR, Outputable body)
 pprStmt :: (OutputableBndr idL, OutputableBndr idR, Outputable body)
         => (StmtLR idL idR body) -> SDoc
 pprStmt (LastStmt expr _)         = ifPprDebug (ptext (sLit "[last]")) <+> ppr expr
-pprStmt (BindStmt pat expr _ _)   = hsep [ppr pat, ptext (sLit "<-"), ppr expr]
+pprStmt (BindStmt pat expr _ _)   = hsep [ppr pat, larrow, ppr expr]
 pprStmt (LetStmt binds)           = hsep [ptext (sLit "let"), pprBinds binds]
 pprStmt (BodyStmt expr _ _ _)     = ppr expr
 pprStmt (ParStmt stmtss _ _)      = sep (punctuate (ptext (sLit " | ")) (map ppr stmtss))
diff --git a/compiler/hsSyn/HsLit.lhs b/compiler/hsSyn/HsLit.lhs
index 9565acbc8f89..a4749dd730a7 100644
--- a/compiler/hsSyn/HsLit.lhs
+++ b/compiler/hsSyn/HsLit.lhs
@@ -5,14 +5,14 @@
 \section[HsLit]{Abstract syntax: source-language literals}
 
 \begin{code}
-{-# OPTIONS -fno-warn-tabs #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
 -- The above warning supression flag is a temporary kludge.
 -- While working on this module you are encouraged to remove it and
 -- detab the module (please do the detabbing in a separate patch). See
 --     http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
 -- for details
 
-{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE CPP, DeriveDataTypeable #-}
 
 module HsLit where
 
diff --git a/compiler/hsSyn/HsPat.lhs b/compiler/hsSyn/HsPat.lhs
index 9d458b79c4b3..4b8fcdaae73b 100644
--- a/compiler/hsSyn/HsPat.lhs
+++ b/compiler/hsSyn/HsPat.lhs
@@ -16,8 +16,8 @@ module HsPat (
 
         mkPrefixConPat, mkCharLitPat, mkNilPat,
 
-        isBangHsBind, isLiftedPatBind,
-        isBangLPat, hsPatNeedsParens,
+        isStrictHsBind, looksLazyPatBind,
+        isStrictLPat, hsPatNeedsParens,
         isIrrefutableHsPat,
 
         pprParendLPat
@@ -75,10 +75,13 @@ data Pat id
                    -- overall type of the pattern, and the toList
                    -- function to convert the scrutinee to a list value
 
-  | TuplePat    [LPat id]               -- Tuple
-                Boxity                  -- UnitPat is TuplePat []
-                PostTcType
-        -- You might think that the PostTcType was redundant, but it's essential
+  | TuplePat    [LPat id]    -- Tuple sub-patterns
+                Boxity       -- UnitPat is TuplePat []
+                [PostTcType] -- [] before typechecker, filled in afterwards with
+                             -- the types of the tuple components
+        -- You might think that the PostTcType was redundant, because we can 
+        -- get the pattern type by getting the types of the sub-patterns.
+        -- But it's essential
         --      data T a where
         --        T1 :: Int -> T Int
         --      f :: (T a, a) -> Int
@@ -89,6 +92,8 @@ data Pat id
         -- Note the (w::a), NOT (w::Int), because we have not yet
         -- refined 'a' to Int.  So we must know that the second component
         -- of the tuple is of type 'a' not Int.  See selectMatchVar
+        -- (June 14: I'm not sure this comment is right; the sub-patterns
+        --           will be wrapped in CoPats, no?)
 
   | PArrPat     [LPat id]               -- Syntactic parallel array
                 PostTcType              -- The type of the elements
@@ -98,14 +103,18 @@ data Pat id
                 (HsConPatDetails id)
 
   | ConPatOut {
-        pat_con   :: Located ConLike,
+        pat_con     :: Located ConLike,
+        pat_arg_tys :: [Type],          -- The univeral arg types, 1-1 with the universal
+                                        -- tyvars of the constructor/pattern synonym
+                                        --   Use (conLikeResTy pat_con pat_arg_tys) to get 
+                                        --   the type of the pattern
+
         pat_tvs   :: [TyVar],           -- Existentially bound type variables (tyvars only)
         pat_dicts :: [EvVar],           -- Ditto *coercion variables* and *dictionaries*
                                         -- One reason for putting coercion variable here, I think,
                                         --      is to ensure their kinds are zonked
         pat_binds :: TcEvBinds,         -- Bindings involving those dictionaries
         pat_args  :: HsConPatDetails id,
-        pat_ty    :: Type,              -- The type of the pattern
         pat_wrap  :: HsWrapper          -- Extra wrapper to pass to the matcher
     }
 
@@ -313,18 +322,18 @@ instance (OutputableBndr id, Outputable arg)
 %************************************************************************
 
 \begin{code}
-mkPrefixConPat :: DataCon -> [OutPat id] -> Type -> OutPat id
+mkPrefixConPat :: DataCon -> [OutPat id] -> [Type] -> OutPat id
 -- Make a vanilla Prefix constructor pattern
-mkPrefixConPat dc pats ty
+mkPrefixConPat dc pats tys
   = noLoc $ ConPatOut { pat_con = noLoc (RealDataCon dc), pat_tvs = [], pat_dicts = [],
                         pat_binds = emptyTcEvBinds, pat_args = PrefixCon pats,
-                        pat_ty = ty, pat_wrap = idHsWrapper }
+                        pat_arg_tys = tys, pat_wrap = idHsWrapper }
 
 mkNilPat :: Type -> OutPat id
-mkNilPat ty = mkPrefixConPat nilDataCon [] ty
+mkNilPat ty = mkPrefixConPat nilDataCon [] [ty]
 
 mkCharLitPat :: Char -> OutPat id
-mkCharLitPat c = mkPrefixConPat charDataCon [noLoc $ LitPat (HsCharPrim c)] charTy
+mkCharLitPat c = mkPrefixConPat charDataCon [noLoc $ LitPat (HsCharPrim c)] []
 \end{code}
 
 
@@ -358,34 +367,34 @@ patterns are treated specially, of course.
 
 The 1.3 report defines what ``irrefutable'' and ``failure-free'' patterns are.
 \begin{code}
-isBangLPat :: LPat id -> Bool
-isBangLPat (L _ (BangPat {})) = True
-isBangLPat (L _ (ParPat p))   = isBangLPat p
-isBangLPat _                  = False
-
-isBangHsBind :: HsBind id -> Bool
--- A pattern binding with an outermost bang
+isStrictLPat :: LPat id -> Bool
+isStrictLPat (L _ (ParPat p))             = isStrictLPat p
+isStrictLPat (L _ (BangPat {}))           = True
+isStrictLPat (L _ (TuplePat _ Unboxed _)) = True
+isStrictLPat _                            = False
+
+isStrictHsBind :: HsBind id -> Bool
+-- A pattern binding with an outermost bang or unboxed tuple must be matched strictly
 -- Defined in this module because HsPat is above HsBinds in the import graph
-isBangHsBind (PatBind { pat_lhs = p }) = isBangLPat p
-isBangHsBind _                         = False
-
-isLiftedPatBind :: HsBind id -> Bool
--- A pattern binding with a compound pattern, not just a variable
---    (I# x)       yes
---    (# a, b #)   no, even if a::Int#
---    x            no, even if x::Int#
--- We want to warn about a missing bang-pattern on the yes's
-isLiftedPatBind (PatBind { pat_lhs = p }) = isLiftedLPat p
-isLiftedPatBind _                         = False
-
-isLiftedLPat :: LPat id -> Bool
-isLiftedLPat (L _ (ParPat p))   = isLiftedLPat p
-isLiftedLPat (L _ (BangPat p))  = isLiftedLPat p
-isLiftedLPat (L _ (AsPat _ p))  = isLiftedLPat p
-isLiftedLPat (L _ (TuplePat _ Unboxed _)) = False
-isLiftedLPat (L _ (VarPat {}))            = False
-isLiftedLPat (L _ (WildPat {}))           = False
-isLiftedLPat _                            = True
+isStrictHsBind (PatBind { pat_lhs = p }) = isStrictLPat p
+isStrictHsBind _                         = False
+
+looksLazyPatBind :: HsBind id -> Bool
+-- Returns True of anything *except*
+--     a StrictHsBind (as above) or 
+--     a VarPat
+-- In particular, returns True of a pattern binding with a compound pattern, like (I# x)
+looksLazyPatBind (PatBind { pat_lhs = p }) = looksLazyLPat p
+looksLazyPatBind _                         = False
+
+looksLazyLPat :: LPat id -> Bool
+looksLazyLPat (L _ (ParPat p))             = looksLazyLPat p
+looksLazyLPat (L _ (AsPat _ p))            = looksLazyLPat p
+looksLazyLPat (L _ (BangPat {}))           = False
+looksLazyLPat (L _ (TuplePat _ Unboxed _)) = False
+looksLazyLPat (L _ (VarPat {}))            = False
+looksLazyLPat (L _ (WildPat {}))           = False
+looksLazyLPat _                            = True
 
 isIrrefutableHsPat :: OutputableBndr id => LPat id -> Bool
 -- (isIrrefutableHsPat p) is true if matching against p cannot fail,
diff --git a/compiler/hsSyn/HsSyn.lhs b/compiler/hsSyn/HsSyn.lhs
index e9c3a5eeee37..72cbac14874b 100644
--- a/compiler/hsSyn/HsSyn.lhs
+++ b/compiler/hsSyn/HsSyn.lhs
@@ -23,7 +23,7 @@ module HsSyn (
         module HsDoc,
         Fixity,
 
-        HsModule(..), HsExtCore(..),
+        HsModule(..)
 ) where
 
 -- friends:
@@ -40,10 +40,9 @@ import HsDoc
 
 -- others:
 import OccName          ( HasOccName )
-import IfaceSyn         ( IfaceBinding )
 import Outputable
 import SrcLoc
-import Module           ( Module, ModuleName )
+import Module           ( ModuleName )
 import FastString
 
 -- libraries:
@@ -77,13 +76,6 @@ data HsModule name
       hsmodHaddockModHeader :: Maybe LHsDocString
         -- ^ Haddock module info and description, unparsed
    } deriving (Data, Typeable)
-
-data HsExtCore name     -- Read from Foo.hcr
-  = HsExtCore
-        Module
-        [TyClDecl name] -- Type declarations only; just as in Haskell source,
-                        -- so that we can infer kinds etc
-        [IfaceBinding]  -- And the bindings
 \end{code}
 
 
diff --git a/compiler/hsSyn/HsTypes.lhs b/compiler/hsSyn/HsTypes.lhs
index 28c6a2b89c73..0cf8455bad4c 100644
--- a/compiler/hsSyn/HsTypes.lhs
+++ b/compiler/hsSyn/HsTypes.lhs
@@ -25,7 +25,7 @@ module HsTypes (
 
         ConDeclField(..), pprConDeclFields,
         
-        mkHsQTvs, hsQTvBndrs,
+        mkHsQTvs, hsQTvBndrs, isHsKindedTyVar, hsTvbAllKinded,
         mkExplicitHsForAllTy, mkImplicitHsForAllTy, hsExplicitTvs,
         hsTyVarName, mkHsWithBndrs, hsLKiTyVarNames,
         hsLTyVarName, hsLTyVarNames, hsLTyVarLocName, hsLTyVarLocNames,
@@ -35,7 +35,7 @@ module HsTypes (
         splitHsAppTys, hsTyGetAppHead_maybe, mkHsAppTys, mkHsOpTy,
 
         -- Printing
-        pprParendHsType, pprHsForAll, pprHsContext, pprHsContextNoArrow, ppr_hs_context,
+        pprParendHsType, pprHsForAll, pprHsContext, pprHsContextNoArrow, 
     ) where
 
 import {-# SOURCE #-} HsExpr ( HsSplice, pprUntypedSplice )
@@ -45,6 +45,7 @@ import HsLit
 import Name( Name )
 import RdrName( RdrName )
 import DataCon( HsBang(..) )
+import TysPrim( funTyConName )
 import Type
 import HsDoc
 import BasicTypes
@@ -162,7 +163,7 @@ mkHsWithBndrs x = HsWB { hswb_cts = x, hswb_kvs = panic "mkHsTyWithBndrs:kvs"
                                      , hswb_tvs = panic "mkHsTyWithBndrs:tvs" }
 
 
--- | These names are used eary on to store the names of implicit
+-- | These names are used early on to store the names of implicit
 -- parameters.  They completely disappear after type-checking.
 newtype HsIPName = HsIPName FastString-- ?x
   deriving( Eq, Data, Typeable )
@@ -187,6 +188,15 @@ data HsTyVarBndr name
          (LHsKind name)  -- The user-supplied kind signature
   deriving (Data, Typeable)
 
+-- | Does this 'HsTyVarBndr' come with an explicit kind annotation?
+isHsKindedTyVar :: HsTyVarBndr name -> Bool
+isHsKindedTyVar (UserTyVar {})   = False
+isHsKindedTyVar (KindedTyVar {}) = True
+
+-- | Do all type variables in this 'LHsTyVarBndr' come with kind annotations?
+hsTvbAllKinded :: LHsTyVarBndrs name -> Bool
+hsTvbAllKinded = all (isHsKindedTyVar . unLoc) . hsQTvBndrs
+
 data HsType name
   = HsForAllTy  HsExplicitFlag          -- Renamer leaves this flag unchanged, to record the way
                                         -- the user wrote it originally, so that the printer can
@@ -506,15 +516,31 @@ splitLHsClassTy_maybe ty
         HsKindSig ty _     -> checkl ty args
         _                  -> Nothing
 
--- Splits HsType into the (init, last) parts
+-- splitHsFunType decomposes a type (t1 -> t2 ... -> tn)
 -- Breaks up any parens in the result type: 
 --      splitHsFunType (a -> (b -> c)) = ([a,b], c)
-splitHsFunType :: LHsType name -> ([LHsType name], LHsType name)
-splitHsFunType (L _ (HsFunTy x y)) = (x:args, res)
-  where
-  (args, res) = splitHsFunType y
-splitHsFunType (L _ (HsParTy ty))  = splitHsFunType ty
-splitHsFunType other               = ([], other)
+-- Also deals with (->) t1 t2; that is why it only works on LHsType Name
+--   (see Trac #9096)
+splitHsFunType :: LHsType Name -> ([LHsType Name], LHsType Name)
+splitHsFunType (L _ (HsParTy ty)) 
+  = splitHsFunType ty
+
+splitHsFunType (L _ (HsFunTy x y))
+  | (args, res) <- splitHsFunType y
+  = (x:args, res)
+
+splitHsFunType orig_ty@(L _ (HsAppTy t1 t2)) 
+  = go t1 [t2]
+  where  -- Look for (->) t1 t2, possibly with parenthesisation
+    go (L _ (HsTyVar fn))    tys | fn == funTyConName
+                                 , [t1,t2] <- tys
+                                 , (args, res) <- splitHsFunType t2
+                                 = (t1:args, res)
+    go (L _ (HsAppTy t1 t2)) tys = go t1 (t2:tys)
+    go (L _ (HsParTy ty))    tys = go ty tys
+    go _                     _   = ([], orig_ty)  -- Failure to match
+
+splitHsFunType other = ([], other)
 \end{code}
 
 
@@ -550,7 +576,7 @@ pprHsForAll exp qtvs cxt
     show_forall =  opt_PprStyle_Debug
                 || (not (null (hsQTvBndrs qtvs)) && is_explicit)
     is_explicit = case exp of {Explicit -> True; Implicit -> False}
-    forall_part = ptext (sLit "forall") <+> ppr qtvs <> dot
+    forall_part = forAllLit <+> ppr qtvs <> dot
 
 pprHsContext :: (OutputableBndr name) => HsContext name -> SDoc
 pprHsContext []  = empty
@@ -558,12 +584,8 @@ pprHsContext cxt = pprHsContextNoArrow cxt <+> darrow
 
 pprHsContextNoArrow :: (OutputableBndr name) => HsContext name -> SDoc
 pprHsContextNoArrow []         = empty
-pprHsContextNoArrow [L _ pred] = ppr pred
-pprHsContextNoArrow cxt        = ppr_hs_context cxt
-
-ppr_hs_context :: (OutputableBndr name) => HsContext name -> SDoc
-ppr_hs_context []  = empty
-ppr_hs_context cxt = parens (interpp'SP cxt)
+pprHsContextNoArrow [L _ pred] = ppr_mono_ty FunPrec pred
+pprHsContextNoArrow cxt        = parens (interpp'SP cxt)
 
 pprConDeclFields :: OutputableBndr name => [ConDeclField name] -> SDoc
 pprConDeclFields fields = braces (sep (punctuate comma (map ppr_fld fields)))
@@ -585,27 +607,12 @@ and the problem doesn't show up; but having the flag on a KindedTyVar
 seems like the Right Thing anyway.)
 
 \begin{code}
-pREC_TOP, pREC_FUN, pREC_OP, pREC_CON :: Int
-pREC_TOP = 0  -- type   in ParseIface.y
-pREC_FUN = 1  -- btype  in ParseIface.y
-              -- Used for LH arg of (->)
-pREC_OP  = 2  -- Used for arg of any infix operator
-              -- (we don't keep their fixities around)
-pREC_CON = 3  -- Used for arg of type applicn:
-              -- always parenthesise unless atomic
-
-maybeParen :: Int       -- Precedence of context
-           -> Int       -- Precedence of top-level operator
-           -> SDoc -> SDoc      -- Wrap in parens if (ctxt >= op)
-maybeParen ctxt_prec op_prec p | ctxt_prec >= op_prec = parens p
-                               | otherwise            = p
-        
--- printing works more-or-less as for Types
+-- Printing works more-or-less as for Types
 
 pprHsType, pprParendHsType :: (OutputableBndr name) => HsType name -> SDoc
 
-pprHsType ty       = getPprStyle $ \sty -> ppr_mono_ty pREC_TOP (prepare sty ty)
-pprParendHsType ty = ppr_mono_ty pREC_CON ty
+pprHsType ty       = getPprStyle $ \sty -> ppr_mono_ty TopPrec (prepare sty ty)
+pprParendHsType ty = ppr_mono_ty TyConPrec ty
 
 -- Before printing a type
 -- (a) Remove outermost HsParTy parens
@@ -615,15 +622,15 @@ prepare :: PprStyle -> HsType name -> HsType name
 prepare sty (HsParTy ty)          = prepare sty (unLoc ty)
 prepare _   ty                    = ty
 
-ppr_mono_lty :: (OutputableBndr name) => Int -> LHsType name -> SDoc
+ppr_mono_lty :: (OutputableBndr name) => TyPrec -> LHsType name -> SDoc
 ppr_mono_lty ctxt_prec ty = ppr_mono_ty ctxt_prec (unLoc ty)
 
-ppr_mono_ty :: (OutputableBndr name) => Int -> HsType name -> SDoc
+ppr_mono_ty :: (OutputableBndr name) => TyPrec -> HsType name -> SDoc
 ppr_mono_ty ctxt_prec (HsForAllTy exp tvs ctxt ty)
-  = maybeParen ctxt_prec pREC_FUN $
-    sep [pprHsForAll exp tvs ctxt, ppr_mono_lty pREC_TOP ty]
+  = maybeParen ctxt_prec FunPrec $
+    sep [pprHsForAll exp tvs ctxt, ppr_mono_lty TopPrec ty]
 
-ppr_mono_ty _    (HsBangTy b ty)     = ppr b <> ppr_mono_lty pREC_CON ty
+ppr_mono_ty _    (HsBangTy b ty)     = ppr b <> ppr_mono_lty TyConPrec ty
 ppr_mono_ty _    (HsQuasiQuoteTy qq) = ppr qq
 ppr_mono_ty _    (HsRecTy flds)      = pprConDeclFields flds
 ppr_mono_ty _    (HsTyVar name)      = pprPrefixOcc name
@@ -632,10 +639,10 @@ ppr_mono_ty _    (HsTupleTy con tys) = tupleParens std_con (interpp'SP tys)
   where std_con = case con of
                     HsUnboxedTuple -> UnboxedTuple
                     _              -> BoxedTuple
-ppr_mono_ty _    (HsKindSig ty kind) = parens (ppr_mono_lty pREC_TOP ty <+> dcolon <+> ppr kind)
-ppr_mono_ty _    (HsListTy ty)       = brackets (ppr_mono_lty pREC_TOP ty)
-ppr_mono_ty _    (HsPArrTy ty)       = paBrackets (ppr_mono_lty pREC_TOP ty)
-ppr_mono_ty prec (HsIParamTy n ty)   = maybeParen prec pREC_FUN (ppr n <+> dcolon <+> ppr_mono_lty pREC_TOP ty)
+ppr_mono_ty _    (HsKindSig ty kind) = parens (ppr_mono_lty TopPrec ty <+> dcolon <+> ppr kind)
+ppr_mono_ty _    (HsListTy ty)       = brackets (ppr_mono_lty TopPrec ty)
+ppr_mono_ty _    (HsPArrTy ty)       = paBrackets (ppr_mono_lty TopPrec ty)
+ppr_mono_ty prec (HsIParamTy n ty)   = maybeParen prec FunPrec (ppr n <+> dcolon <+> ppr_mono_lty TopPrec ty)
 ppr_mono_ty _    (HsSpliceTy s _)    = pprUntypedSplice s
 ppr_mono_ty _    (HsCoreTy ty)       = ppr ty
 ppr_mono_ty _    (HsExplicitListTy _ tys) = quote $ brackets (interpp'SP tys)
@@ -651,45 +658,45 @@ ppr_mono_ty ctxt_prec (HsWrapTy (WpKiApps _kis) ty)
   where
     go ctxt_prec [] ty = ppr_mono_ty ctxt_prec ty
     go ctxt_prec (ki:kis) ty
-      = maybeParen ctxt_prec pREC_CON $
-        hsep [ go pREC_FUN kis ty
+      = maybeParen ctxt_prec TyConPrec $
+        hsep [ go FunPrec kis ty
              , ptext (sLit "@") <> pprParendKind ki ]
 -}
 
 ppr_mono_ty ctxt_prec (HsEqTy ty1 ty2)
-  = maybeParen ctxt_prec pREC_OP $
-    ppr_mono_lty pREC_OP ty1 <+> char '~' <+> ppr_mono_lty pREC_OP ty2
+  = maybeParen ctxt_prec TyOpPrec $
+    ppr_mono_lty TyOpPrec ty1 <+> char '~' <+> ppr_mono_lty TyOpPrec ty2
 
 ppr_mono_ty ctxt_prec (HsAppTy fun_ty arg_ty)
-  = maybeParen ctxt_prec pREC_CON $
-    hsep [ppr_mono_lty pREC_FUN fun_ty, ppr_mono_lty pREC_CON arg_ty]
+  = maybeParen ctxt_prec TyConPrec $
+    hsep [ppr_mono_lty FunPrec fun_ty, ppr_mono_lty TyConPrec arg_ty]
 
 ppr_mono_ty ctxt_prec (HsOpTy ty1 (_wrapper, L _ op) ty2)
-  = maybeParen ctxt_prec pREC_OP $
-    sep [ ppr_mono_lty pREC_OP ty1
-        , sep [pprInfixOcc op, ppr_mono_lty pREC_OP ty2 ] ]
+  = maybeParen ctxt_prec TyOpPrec $
+    sep [ ppr_mono_lty TyOpPrec ty1
+        , sep [pprInfixOcc op, ppr_mono_lty TyOpPrec ty2 ] ]
     -- Don't print the wrapper (= kind applications)
     -- c.f. HsWrapTy
 
 ppr_mono_ty _         (HsParTy ty)
-  = parens (ppr_mono_lty pREC_TOP ty)
+  = parens (ppr_mono_lty TopPrec ty)
   -- Put the parens in where the user did
   -- But we still use the precedence stuff to add parens because
   --    toHsType doesn't put in any HsParTys, so we may still need them
 
 ppr_mono_ty ctxt_prec (HsDocTy ty doc) 
-  = maybeParen ctxt_prec pREC_OP $
-    ppr_mono_lty pREC_OP ty <+> ppr (unLoc doc)
+  = maybeParen ctxt_prec TyOpPrec $
+    ppr_mono_lty TyOpPrec ty <+> ppr (unLoc doc)
   -- we pretty print Haddock comments on types as if they were
   -- postfix operators
 
 --------------------------
-ppr_fun_ty :: (OutputableBndr name) => Int -> LHsType name -> LHsType name -> SDoc
+ppr_fun_ty :: (OutputableBndr name) => TyPrec -> LHsType name -> LHsType name -> SDoc
 ppr_fun_ty ctxt_prec ty1 ty2
-  = let p1 = ppr_mono_lty pREC_FUN ty1
-        p2 = ppr_mono_lty pREC_TOP ty2
+  = let p1 = ppr_mono_lty FunPrec ty1
+        p2 = ppr_mono_lty TopPrec ty2
     in
-    maybeParen ctxt_prec pREC_FUN $
+    maybeParen ctxt_prec FunPrec $
     sep [p1, ptext (sLit "->") <+> p2]
 
 --------------------------
diff --git a/compiler/hsSyn/HsUtils.lhs b/compiler/hsSyn/HsUtils.lhs
index 558c104fadd3..5d4d22fae2c1 100644
--- a/compiler/hsSyn/HsUtils.lhs
+++ b/compiler/hsSyn/HsUtils.lhs
@@ -1,10 +1,12 @@
+> {-# LANGUAGE ScopedTypeVariables #-}
+
 %
 % (c) The University of Glasgow, 1992-2006
 %
 
 Here we collect a variety of helper functions that construct or
 analyse HsSyn.  All these functions deal with generic HsSyn; functions
-which deal with the intantiated versions are located elsewhere:
+which deal with the instantiated versions are located elsewhere:
 
    Parameterised by	Module
    ----------------     -------------
@@ -13,7 +15,8 @@ which deal with the intantiated versions are located elsewhere:
    Id			typecheck/TcHsSyn	
 
 \begin{code}
-{-# OPTIONS -fno-warn-tabs #-}
+{-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
 -- The above warning supression flag is a temporary kludge.
 -- While working on this module you are encouraged to remove it and
 -- detab the module (please do the detabbing in a separate patch). See
@@ -99,7 +102,10 @@ import FastString
 import Util
 import Bag
 import Outputable
+
 import Data.Either
+import Data.Function
+import Data.List
 \end{code}
 
 
@@ -132,8 +138,8 @@ unguardedGRHSs rhs = GRHSs (unguardedRHS rhs) emptyLocalBinds
 unguardedRHS :: Located (body id) -> [LGRHS id (Located (body id))]
 unguardedRHS rhs@(L loc _) = [L loc (GRHS [] rhs)]
 
-mkMatchGroup :: [LMatch id (Located (body id))] -> MatchGroup id (Located (body id))
-mkMatchGroup matches = MG { mg_alts = matches, mg_arg_tys = [], mg_res_ty = placeHolderType }
+mkMatchGroup :: Origin -> [LMatch id (Located (body id))] -> MatchGroup id (Located (body id))
+mkMatchGroup origin matches = MG { mg_alts = matches, mg_arg_tys = [], mg_res_ty = placeHolderType, mg_origin = origin }
 
 mkHsAppTy :: LHsType name -> LHsType name -> LHsType name
 mkHsAppTy t1 t2 = addCLoc t1 t2 (HsAppTy t1 t2)
@@ -144,7 +150,7 @@ mkHsApp e1 e2 = addCLoc e1 e2 (HsApp e1 e2)
 mkHsLam :: [LPat id] -> LHsExpr id -> LHsExpr id
 mkHsLam pats body = mkHsPar (L (getLoc body) (HsLam matches))
 	where
-          matches = mkMatchGroup [mkSimpleMatch pats body]
+          matches = mkMatchGroup Generated [mkSimpleMatch pats body]
 
 mkHsLams :: [TyVar] -> [EvVar] -> LHsExpr Id -> LHsExpr Id
 mkHsLams tyvars dicts expr = mkLHsWrap (mkWpTyLams tyvars <.> mkWpLams dicts) expr
@@ -351,11 +357,11 @@ nlHsIf   :: LHsExpr id -> LHsExpr id -> LHsExpr id -> LHsExpr id
 nlHsCase :: LHsExpr id -> [LMatch id (LHsExpr id)] -> LHsExpr id
 nlList   :: [LHsExpr id] -> LHsExpr id
 
-nlHsLam	match		= noLoc (HsLam (mkMatchGroup [match]))
-nlHsPar e		= noLoc (HsPar e)
-nlHsIf cond true false	= noLoc (mkHsIf cond true false)
-nlHsCase expr matches	= noLoc (HsCase expr (mkMatchGroup matches))
-nlList exprs		= noLoc (ExplicitList placeHolderType Nothing exprs)
+nlHsLam	match          = noLoc (HsLam (mkMatchGroup Generated [match]))
+nlHsPar e              = noLoc (HsPar e)
+nlHsIf cond true false = noLoc (mkHsIf cond true false)
+nlHsCase expr matches  = noLoc (HsCase expr (mkMatchGroup Generated matches))
+nlList exprs           = noLoc (ExplicitList placeHolderType Nothing exprs)
 
 nlHsAppTy :: LHsType name -> LHsType name -> LHsType name
 nlHsTyVar :: name                         -> LHsType name
@@ -382,7 +388,7 @@ mkLHsVarTuple :: [a] -> LHsExpr a
 mkLHsVarTuple ids  = mkLHsTupleExpr (map nlHsVar ids)
 
 nlTuplePat :: [LPat id] -> Boxity -> LPat id
-nlTuplePat pats box = noLoc (TuplePat pats box placeHolderType)
+nlTuplePat pats box = noLoc (TuplePat pats box [])
 
 missingTupArg :: HsTupArg a
 missingTupArg = Missing placeHolderType
@@ -478,20 +484,20 @@ l
 mkFunBind :: Located RdrName -> [LMatch RdrName (LHsExpr RdrName)] -> HsBind RdrName
 -- Not infix, with place holders for coercion and free vars
 mkFunBind fn ms = FunBind { fun_id = fn, fun_infix = False
-                          , fun_matches = mkMatchGroup ms
-			  , fun_co_fn = idHsWrapper
+                          , fun_matches = mkMatchGroup Generated ms
+                          , fun_co_fn = idHsWrapper
                           , bind_fvs = placeHolderNames
-			  , fun_tick = Nothing }
+                          , fun_tick = Nothing }
 
-mkTopFunBind :: Located Name -> [LMatch Name (LHsExpr Name)] -> HsBind Name
+mkTopFunBind :: Origin -> Located Name -> [LMatch Name (LHsExpr Name)] -> HsBind Name
 -- In Name-land, with empty bind_fvs
-mkTopFunBind fn ms = FunBind { fun_id = fn, fun_infix = False
-                             , fun_matches = mkMatchGroup ms
-			     , fun_co_fn = idHsWrapper
-                             , bind_fvs = emptyNameSet	-- NB: closed binding
-			     , fun_tick = Nothing }
+mkTopFunBind origin fn ms = FunBind { fun_id = fn, fun_infix = False
+                                    , fun_matches = mkMatchGroup origin ms
+                                    , fun_co_fn = idHsWrapper
+                                    , bind_fvs = emptyNameSet	-- NB: closed binding
+                                    , fun_tick = Nothing }
 
-mkHsVarBind :: SrcSpan -> RdrName -> LHsExpr RdrName -> (Origin, LHsBind RdrName)
+mkHsVarBind :: SrcSpan -> RdrName -> LHsExpr RdrName -> LHsBind RdrName
 mkHsVarBind loc var rhs = mk_easy_FunBind loc var [] rhs
 
 mkVarBind :: id -> LHsExpr id -> LHsBind id
@@ -499,17 +505,19 @@ mkVarBind var rhs = L (getLoc rhs) $
 		    VarBind { var_id = var, var_rhs = rhs, var_inline = False }
 
 mkPatSynBind :: Located RdrName -> HsPatSynDetails (Located RdrName) -> LPat RdrName -> HsPatSynDir RdrName -> HsBind RdrName
-mkPatSynBind name details lpat dir = PatSynBind{ patsyn_id = name
-                                               , patsyn_args = details
-                                               , patsyn_def = lpat
-                                               , patsyn_dir = dir
-                                               , bind_fvs = placeHolderNames }
+mkPatSynBind name details lpat dir = PatSynBind psb
+  where
+    psb = PSB{ psb_id = name
+             , psb_args = details
+             , psb_def = lpat
+             , psb_dir = dir
+             , psb_fvs = placeHolderNames }
 
 ------------
 mk_easy_FunBind :: SrcSpan -> RdrName -> [LPat RdrName]
-		-> LHsExpr RdrName -> (Origin, LHsBind RdrName)
+		-> LHsExpr RdrName -> LHsBind RdrName
 mk_easy_FunBind loc fun pats expr
-  = (Generated, L loc $ mkFunBind (L loc fun) [mkMatch pats expr emptyLocalBinds])
+  = L loc $ mkFunBind (L loc fun) [mkMatch pats expr emptyLocalBinds]
 
 ------------
 mkMatch :: [LPat id] -> LHsExpr id -> HsLocalBinds id -> LMatch id (LHsExpr id)
@@ -571,7 +579,7 @@ collect_bind (AbsBinds { abs_exports = dbinds, abs_binds = _binds }) acc
 	-- I don't think we want the binders from the nested binds
 	-- The only time we collect binders from a typechecked 
 	-- binding (hence see AbsBinds) is in zonking in TcHsSyn
-collect_bind (PatSynBind { patsyn_id = L _ ps }) acc = ps : acc
+collect_bind (PatSynBind (PSB { psb_id = L _ ps })) acc = ps : acc
 
 collectHsBindsBinders :: LHsBindsLR idL idR -> [idL]
 collectHsBindsBinders binds = collect_binds binds []
@@ -580,11 +588,11 @@ collectHsBindListBinders :: [LHsBindLR idL idR] -> [idL]
 collectHsBindListBinders = foldr (collect_bind . unLoc) []
 
 collect_binds :: LHsBindsLR idL idR -> [idL] -> [idL]
-collect_binds binds acc = foldrBag (collect_bind . unLoc . snd) acc binds
+collect_binds binds acc = foldrBag (collect_bind . unLoc) acc binds
 
 collectMethodBinders :: LHsBindsLR RdrName idR -> [Located RdrName]
 -- Used exclusively for the bindings of an instance decl which are all FunBinds
-collectMethodBinders binds = foldrBag (get . unLoc . snd) [] binds
+collectMethodBinders binds = foldrBag (get . unLoc) [] binds
   where
     get (FunBind { fun_id = f }) fs = f : fs
     get _                        fs = fs	
@@ -742,24 +750,26 @@ hsDataDefnBinders (HsDataDefn { dd_cons = cons }) = hsConDeclsBinders cons
   -- See Note [Binders in family instances]
 
 -------------------
-hsConDeclsBinders :: (Eq name) => [LConDecl name] -> [Located name]
+hsConDeclsBinders :: forall name. (Eq name) => [LConDecl name] -> [Located name]
   -- See hsLTyClDeclBinders for what this does
   -- The function is boringly complicated because of the records
   -- And since we only have equality, we have to be a little careful
-hsConDeclsBinders cons
-  = snd (foldl do_one ([], []) cons)
-  where
-    do_one (flds_seen, acc) (L loc (ConDecl { con_name = L _ name
-                                            , con_details = RecCon flds }))
-	= (map unLoc new_flds ++ flds_seen, L loc name : new_flds ++ acc)
-	where
+hsConDeclsBinders cons = go id cons
+  where go :: ([Located name] -> [Located name]) -> [LConDecl name] -> [Located name]
+        go _ [] = []
+        go remSeen (r:rs) =
           -- don't re-mangle the location of field names, because we don't
           -- have a record of the full location of the field declaration anyway
-	  new_flds = filterOut (\f -> unLoc f `elem` flds_seen) 
-			       (map cd_fld_name flds)
+          case r of
+             -- remove only the first occurrence of any seen field in order to
+             -- avoid circumventing detection of duplicate fields (#9156)
+             L loc (ConDecl { con_name = L _ name , con_details = RecCon flds }) ->
+               (L loc name) : r' ++ go remSeen' rs
+                  where r' = remSeen (map cd_fld_name flds)
+                        remSeen' = foldr (.) remSeen [deleteBy ((==) `on` unLoc) v | v <- r']
+             L loc (ConDecl { con_name = L _ name }) ->
+                (L loc name) : go remSeen rs
 
-    do_one (flds_seen, acc) (L loc (ConDecl { con_name = L _ name }))
-	= (flds_seen, L loc name : acc)
 \end{code}
 
 Note [Binders in family instances]
@@ -808,7 +818,7 @@ hsValBindsImplicits (ValBindsIn binds _)
   = lhsBindsImplicits binds
 
 lhsBindsImplicits :: LHsBindsLR Name idR -> NameSet
-lhsBindsImplicits = foldBag unionNameSets (lhs_bind . unLoc . snd) emptyNameSet
+lhsBindsImplicits = foldBag unionNameSets (lhs_bind . unLoc) emptyNameSet
   where
     lhs_bind (PatBind { pat_lhs = lpat }) = lPatImplicits lpat
     lhs_bind _ = emptyNameSet
diff --git a/compiler/iface/BinIface.hs b/compiler/iface/BinIface.hs
index 9fd0c33423d4..4ec9ec7cbbbe 100644
--- a/compiler/iface/BinIface.hs
+++ b/compiler/iface/BinIface.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE CPP #-}
+
 --
 --  (c) The University of Glasgow 2002-2006
 --
@@ -258,7 +260,7 @@ getSymbolTable bh ncu = do
                 mapAccumR (fromOnDiskName arr) namecache od_names
         in (namecache', arr)
 
-type OnDiskName = (PackageId, ModuleName, OccName)
+type OnDiskName = (PackageKey, ModuleName, OccName)
 
 fromOnDiskName :: Array Int Name -> NameCache -> OnDiskName -> (NameCache, Name)
 fromOnDiskName _ nc (pid, mod_name, occ) =
@@ -275,7 +277,7 @@ fromOnDiskName _ nc (pid, mod_name, occ) =
 serialiseName :: BinHandle -> Name -> UniqFM (Int,Name) -> IO ()
 serialiseName bh name _ = do
     let mod = ASSERT2( isExternalName name, ppr name ) nameModule name
-    put_ bh (modulePackageId mod, moduleName mod, nameOccName name)
+    put_ bh (modulePackageKey mod, moduleName mod, nameOccName name)
 
 
 -- Note [Symbol table representation of names]
diff --git a/compiler/iface/BuildTyCl.lhs b/compiler/iface/BuildTyCl.lhs
index e412d7ef301c..46091adf80e4 100644
--- a/compiler/iface/BuildTyCl.lhs
+++ b/compiler/iface/BuildTyCl.lhs
@@ -4,7 +4,8 @@
 %
 
 \begin{code}
-{-# OPTIONS -fno-warn-tabs #-}
+{-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
 -- The above warning supression flag is a temporary kludge.
 -- While working on this module you are encouraged to remove it and
 -- detab the module (please do the detabbing in a separate patch). See
@@ -15,7 +16,7 @@ module BuildTyCl (
         buildSynTyCon,
         buildAlgTyCon, 
         buildDataCon,
-        buildPatSyn, mkPatSynMatcherId, mkPatSynWrapperId,
+        buildPatSyn,
         TcMethInfo, buildClass,
         distinctAbstractTyConRhs, totallyAbstractTyConRhs,
         mkNewTyConRhs, mkDataTyConRhs, 
@@ -36,10 +37,9 @@ import MkId
 import Class
 import TyCon
 import Type
-import TypeRep
-import TcType
 import Id
 import Coercion
+import TcType
 
 import DynFlags
 import TcRnMonad
@@ -184,67 +184,34 @@ mkDataConStupidTheta tycon arg_tys univ_tvs
 
 
 ------------------------------------------------------
-buildPatSyn :: Name -> Bool -> Bool
-            -> [Var]
+buildPatSyn :: Name -> Bool
+            -> Id -> Maybe Id
+            -> [Type]
             -> [TyVar] -> [TyVar]     -- Univ and ext
             -> ThetaType -> ThetaType -- Prov and req
             -> Type                  -- Result type
-            -> TyVar
-            -> TcRnIf m n PatSyn
-buildPatSyn src_name declared_infix has_wrapper args univ_tvs ex_tvs prov_theta req_theta pat_ty tv
-  = do	{ (matcher, _, _) <- mkPatSynMatcherId src_name args
-                                              univ_tvs ex_tvs
-                                              prov_theta req_theta
-                                              pat_ty tv
-        ; wrapper <- case has_wrapper of
-            False -> return Nothing
-            True -> fmap Just $
-                    mkPatSynWrapperId src_name args
-                                      (univ_tvs ++ ex_tvs) (prov_theta ++ req_theta)
-                                      pat_ty
-        ; return $ mkPatSyn src_name declared_infix
-                            args
-                            univ_tvs ex_tvs
-                            prov_theta req_theta
-                            pat_ty
-                            matcher
-                            wrapper }
-
-mkPatSynMatcherId :: Name
-                  -> [Var]
-                  -> [TyVar]
-                  -> [TyVar]
-                  -> ThetaType -> ThetaType
-                  -> Type
-                  -> TyVar
-                  -> TcRnIf n m (Id, Type, Type)
-mkPatSynMatcherId name args univ_tvs ex_tvs prov_theta req_theta pat_ty res_tv
-  = do { matcher_name <- newImplicitBinder name mkMatcherOcc
-
-       ; let res_ty = TyVarTy res_tv
-             cont_ty = mkSigmaTy ex_tvs prov_theta $
-                       mkFunTys (map varType args) res_ty
-
-       ; let matcher_tau = mkFunTys [pat_ty, cont_ty, res_ty] res_ty
-             matcher_sigma = mkSigmaTy (res_tv:univ_tvs) req_theta matcher_tau
-             matcher_id = mkVanillaGlobal matcher_name matcher_sigma
-       ; return (matcher_id, res_ty, cont_ty) }
-
-mkPatSynWrapperId :: Name
-                  -> [Var]
-                  -> [TyVar]
-                  -> ThetaType
-                  -> Type
-                  -> TcRnIf n m Id
-mkPatSynWrapperId name args qtvs theta pat_ty
-  = do { wrapper_name <- newImplicitBinder name mkDataConWrapperOcc
-
-       ; let wrapper_tau = mkFunTys (map varType args) pat_ty
-             wrapper_sigma = mkSigmaTy qtvs theta wrapper_tau
-
-       ; let wrapper_id = mkVanillaGlobal wrapper_name wrapper_sigma
-       ; return wrapper_id }
-
+            -> PatSyn
+buildPatSyn src_name declared_infix matcher wrapper
+            args univ_tvs ex_tvs prov_theta req_theta pat_ty
+  = ASSERT((and [ univ_tvs == univ_tvs'
+                , ex_tvs == ex_tvs'
+                , pat_ty `eqType` pat_ty'
+                , prov_theta `eqTypes` prov_theta'
+                , req_theta `eqTypes` req_theta'
+                , args `eqTypes` args'
+                ]))
+    mkPatSyn src_name declared_infix
+             args
+             univ_tvs ex_tvs
+             prov_theta req_theta
+             pat_ty
+             matcher
+             wrapper
+  where
+    ((_:univ_tvs'), req_theta', tau) = tcSplitSigmaTy $ idType matcher
+    ([pat_ty', cont_sigma, _], _) = tcSplitFunTys tau
+    (ex_tvs', prov_theta', cont_tau) = tcSplitSigmaTy cont_sigma
+    (args', _) = tcSplitFunTys cont_tau
 \end{code}
 
 
@@ -254,10 +221,7 @@ type TcMethInfo = (Name, DefMethSpec, Type)
         -- A temporary intermediate, to communicate between 
         -- tcClassSigs and buildClass.
 
-buildClass :: Bool		-- True <=> do not include unfoldings 
-				--	    on dict selectors
-				-- Used when importing a class without -O
-	   -> Name -> [TyVar] -> [Role] -> ThetaType
+buildClass :: Name -> [TyVar] -> [Role] -> ThetaType
 	   -> [FunDep TyVar]		   -- Functional dependencies
 	   -> [ClassATItem]		   -- Associated types
 	   -> [TcMethInfo]                 -- Method info
@@ -265,10 +229,9 @@ buildClass :: Bool		-- True <=> do not include unfoldings
 	   -> RecFlag			   -- Info for type constructor
 	   -> TcRnIf m n Class
 
-buildClass no_unf tycon_name tvs roles sc_theta fds at_items sig_stuff mindef tc_isrec
+buildClass tycon_name tvs roles sc_theta fds at_items sig_stuff mindef tc_isrec
   = fixM  $ \ rec_clas -> 	-- Only name generation inside loop
     do	{ traceIf (text "buildClass")
-        ; dflags <- getDynFlags
 
 	; datacon_name <- newImplicitBinder tycon_name mkClassDataConOcc
 		-- The class name is the 'parent' for this datacon, not its tycon,
@@ -282,7 +245,7 @@ buildClass no_unf tycon_name tvs roles sc_theta fds at_items sig_stuff mindef tc
 	      -- Make selectors for the superclasses 
 	; sc_sel_names <- mapM  (newImplicitBinder tycon_name . mkSuperDictSelOcc) 
 				[1..length sc_theta]
-        ; let sc_sel_ids = [ mkDictSelId dflags no_unf sc_name rec_clas 
+        ; let sc_sel_ids = [ mkDictSelId sc_name rec_clas 
                            | sc_name <- sc_sel_names]
 	      -- We number off the Dict superclass selectors, 1, 2, 3 etc so that we 
 	      -- can construct names for the selectors. Thus
@@ -348,14 +311,13 @@ buildClass no_unf tycon_name tvs roles sc_theta fds at_items sig_stuff mindef tc
   where
     mk_op_item :: Class -> TcMethInfo -> TcRnIf n m ClassOpItem
     mk_op_item rec_clas (op_name, dm_spec, _) 
-      = do { dflags <- getDynFlags
-           ; dm_info <- case dm_spec of
+      = do { dm_info <- case dm_spec of
                           NoDM      -> return NoDefMeth
                           GenericDM -> do { dm_name <- newImplicitBinder op_name mkGenDefMethodOcc
 			  	          ; return (GenDefMeth dm_name) }
                           VanillaDM -> do { dm_name <- newImplicitBinder op_name mkDefaultMethodOcc
 			  	          ; return (DefMeth dm_name) }
-           ; return (mkDictSelId dflags no_unf op_name rec_clas, dm_info) }
+           ; return (mkDictSelId op_name rec_clas, dm_info) }
 \end{code}
 
 Note [Class newtypes and equality predicates]
@@ -368,7 +330,7 @@ We cannot represent this by a newtype, even though it's not
 existential, because there are two value fields (the equality
 predicate and op. See Trac #2238
 
-Moreover, 
+Moreover,
 	  class (a ~ F b) => C a b where {}
 Here we can't use a newtype either, even though there is only
 one field, because equality predicates are unboxed, and classes
diff --git a/compiler/iface/IfaceEnv.lhs b/compiler/iface/IfaceEnv.lhs
index 42c3e326050a..c29778dc2380 100644
--- a/compiler/iface/IfaceEnv.lhs
+++ b/compiler/iface/IfaceEnv.lhs
@@ -1,7 +1,8 @@
 (c) The University of Glasgow 2002-2006
 
 \begin{code}
-{-# OPTIONS -fno-warn-tabs #-}
+{-# LANGUAGE CPP, RankNTypes #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
 -- The above warning supression flag is a temporary kludge.
 -- While working on this module you are encouraged to remove it and
 -- detab the module (please do the detabbing in a separate patch). See
@@ -28,13 +29,10 @@ module IfaceEnv (
 import TcRnMonad
 import TysWiredIn
 import HscTypes
-import TyCon
 import Type
-import DataCon
 import Var
 import Name
 import Avail
-import PrelNames
 import Module
 import UniqFM
 import FastString
@@ -183,23 +181,34 @@ lookupOrig mod occ
 
 See Note [The Name Cache] above.
 
+Note [Built-in syntax and the OrigNameCache]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+You might think that usin isBuiltInOcc_maybe in lookupOrigNameCache is
+unnecessary because tuple TyCon/DataCons are parsed as Exact RdrNames
+and *don't* appear as original names in interface files (because
+serialization gives them special treatment), so we will never look
+them up in the original name cache.
+
+However, there are two reasons why we might look up an Orig RdrName:
+
+  * If you use setRdrNameSpace on an Exact RdrName it may be
+    turned into an Orig RdrName. 
+
+  * Template Haskell turns a BuiltInSyntax Name into a TH.NameG
+    (DsMeta.globalVar), and parses a NameG into an Orig RdrName
+    (Convert.thRdrName).  So, eg $(do { reify '(,); ... }) will
+    go this route (Trac #8954).
+
 \begin{code}
 lookupOrigNameCache :: OrigNameCache -> Module -> OccName -> Maybe Name
-lookupOrigNameCache _ mod occ
-  -- Don't need to mention gHC_UNIT here because it is explicitly
-  -- included in TysWiredIn.wiredInTyCons
-  | mod == gHC_TUPLE || mod == gHC_PRIM,		-- Boxed tuples from one, 
-    Just tup_info <- isTupleOcc_maybe occ	-- unboxed from the other
-  = 	-- Special case for tuples; there are too many
+lookupOrigNameCache nc mod occ
+  | Just name <- isBuiltInOcc_maybe occ
+  = 	-- See Note [Known-key names], 3(c) in PrelNames
+        -- Special case for tuples; there are too many
 	-- of them to pre-populate the original-name cache
-    Just (mk_tup_name tup_info)
-  where
-    mk_tup_name (ns, sort, arity)
-	| ns == tcName   = tyConName (tupleTyCon sort arity)
-	| ns == dataName = dataConName (tupleCon sort arity)
-	| otherwise      = Var.varName (dataConWorkId (tupleCon sort arity))
+    Just name
 
-lookupOrigNameCache nc mod occ	-- The normal case
+  | otherwise
   = case lookupModuleEnv nc mod of
 	Nothing      -> Nothing
 	Just occ_env -> lookupOccEnv occ_env occ
diff --git a/compiler/iface/IfaceSyn.lhs b/compiler/iface/IfaceSyn.lhs
index b58230543466..9496a9f087ff 100644
--- a/compiler/iface/IfaceSyn.lhs
+++ b/compiler/iface/IfaceSyn.lhs
@@ -4,7 +4,8 @@
 %
 
 \begin{code}
-{-# OPTIONS -fno-warn-tabs #-}
+{-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
 -- The above warning supression flag is a temporary kludge.
 -- While working on this module you are encouraged to remove it and
 -- detab the module (please do the detabbing in a separate patch). See
@@ -15,13 +16,14 @@ module IfaceSyn (
         module IfaceType,
 
         IfaceDecl(..), IfaceSynTyConRhs(..), IfaceClassOp(..), IfaceAT(..), 
-        IfaceConDecl(..), IfaceConDecls(..),
+        IfaceConDecl(..), IfaceConDecls(..), IfaceEqSpec,
         IfaceExpr(..), IfaceAlt, IfaceLetBndr(..),
         IfaceBinding(..), IfaceConAlt(..),
         IfaceIdInfo(..), IfaceIdDetails(..), IfaceUnfolding(..),
         IfaceInfoItem(..), IfaceRule(..), IfaceAnnotation(..), IfaceAnnTarget,
         IfaceClsInst(..), IfaceFamInst(..), IfaceTickish(..), 
         IfaceBang(..), IfaceAxBranch(..),
+        IfaceTyConParent(..),
 
         -- Misc
         ifaceDeclImplicitBndrs, visibleIfConDecls,
@@ -31,7 +33,9 @@ module IfaceSyn (
         freeNamesIfDecl, freeNamesIfRule, freeNamesIfFamInst,
 
         -- Pretty printing
-        pprIfaceExpr
+        pprIfaceExpr,
+        pprIfaceDecl,
+        ShowSub(..), ShowHowMuch(..)
     ) where
 
 #include "HsVersions.h"
@@ -51,13 +55,18 @@ import BasicTypes
 import Outputable
 import FastString
 import Module
-import TysWiredIn ( eqTyConName )
+import SrcLoc
 import Fingerprint
 import Binary
 import BooleanFormula ( BooleanFormula )
+import HsBinds
+import TyCon (Role (..))
+import StaticFlags (opt_PprStyle_Debug)
+import Util( filterOut )
 
 import Control.Monad
 import System.IO.Unsafe
+import Data.Maybe (isJust)
 
 infixl 3 &&&
 \end{code}
@@ -65,18 +74,27 @@ infixl 3 &&&
 
 %************************************************************************
 %*                                                                      *
-    Data type declarations
+                    Declarations
 %*                                                                      *
 %************************************************************************
 
 \begin{code}
+type IfaceTopBndr = OccName
+  -- It's convenient to have an OccName in the IfaceSyn, altough in each
+  -- case the namespace is implied by the context. However, having an
+  -- OccNames makes things like ifaceDeclImplicitBndrs and ifaceDeclFingerprints
+  -- very convenient. 
+  --   
+  -- We don't serialise the namespace onto the disk though; rather we 
+  -- drop it when serialising and add it back in when deserialising.
+
 data IfaceDecl
-  = IfaceId { ifName      :: OccName,
+  = IfaceId { ifName      :: IfaceTopBndr,
               ifType      :: IfaceType,
               ifIdDetails :: IfaceIdDetails,
               ifIdInfo    :: IfaceIdInfo }
 
-  | IfaceData { ifName       :: OccName,        -- Type constructor
+  | IfaceData { ifName       :: IfaceTopBndr,        -- Type constructor
                 ifCType      :: Maybe CType,    -- C type for CAPI FFI
                 ifTyVars     :: [IfaceTvBndr],  -- Type variables
                 ifRoles      :: [Role],         -- Roles
@@ -86,355 +104,115 @@ data IfaceDecl
                 ifPromotable :: Bool,           -- Promotable to kind level?
                 ifGadtSyntax :: Bool,           -- True <=> declared using
                                                 -- GADT syntax
-                ifAxiom      :: Maybe IfExtName -- The axiom, for a newtype, 
-                                                -- or data/newtype family instance
+                ifParent     :: IfaceTyConParent -- The axiom, for a newtype,
+                                                 -- or data/newtype family instance
     }
 
-  | IfaceSyn  { ifName    :: OccName,           -- Type constructor
+  | IfaceSyn  { ifName    :: IfaceTopBndr,           -- Type constructor
                 ifTyVars  :: [IfaceTvBndr],     -- Type variables
                 ifRoles   :: [Role],            -- Roles
                 ifSynKind :: IfaceKind,         -- Kind of the *rhs* (not of the tycon)
                 ifSynRhs  :: IfaceSynTyConRhs }
 
-  | IfaceClass { ifCtxt    :: IfaceContext,     -- Context...
-                 ifName    :: OccName,          -- Name of the class TyCon
-                 ifTyVars  :: [IfaceTvBndr],    -- Type variables
-                 ifRoles   :: [Role],           -- Roles
-                 ifFDs     :: [FunDep FastString], -- Functional dependencies
-                 ifATs     :: [IfaceAT],      -- Associated type families
-                 ifSigs    :: [IfaceClassOp],   -- Method signatures
-                 ifMinDef  :: BooleanFormula OccName, -- Minimal complete definition
-                 ifRec     :: RecFlag           -- Is newtype/datatype associated
-                                                --   with the class recursive?
+  | IfaceClass { ifCtxt    :: IfaceContext,          	-- Context...
+                 ifName    :: IfaceTopBndr,          	-- Name of the class TyCon
+                 ifTyVars  :: [IfaceTvBndr],         	-- Type variables
+                 ifRoles   :: [Role],                	-- Roles
+                 ifFDs     :: [FunDep FastString],   	-- Functional dependencies
+                 ifATs     :: [IfaceAT],                -- Associated type families
+                 ifSigs    :: [IfaceClassOp],           -- Method signatures
+                 ifMinDef  :: BooleanFormula IfLclName, -- Minimal complete definition
+                 ifRec     :: RecFlag           	-- Is newtype/datatype associated
+                                                	--   with the class recursive?
     }
 
-  | IfaceAxiom { ifName       :: OccName,        -- Axiom name
+  | IfaceAxiom { ifName       :: IfaceTopBndr,        -- Axiom name
                  ifTyCon      :: IfaceTyCon,     -- LHS TyCon
                  ifRole       :: Role,           -- Role of axiom
                  ifAxBranches :: [IfaceAxBranch] -- Branches
     }
 
-  | IfaceForeign { ifName :: OccName,           -- Needs expanding when we move
+  | IfaceForeign { ifName :: IfaceTopBndr,           -- Needs expanding when we move
                                                 -- beyond .NET
                    ifExtName :: Maybe FastString }
 
-  | IfacePatSyn { ifName          :: OccName,           -- Name of the pattern synonym
-                  ifPatHasWrapper :: Bool,
+  | IfacePatSyn { ifName          :: IfaceTopBndr,           -- Name of the pattern synonym
                   ifPatIsInfix    :: Bool,
+                  ifPatMatcher    :: IfExtName,
+                  ifPatWrapper    :: Maybe IfExtName,
+                  -- Everything below is redundant,
+                  -- but needed to implement pprIfaceDecl
                   ifPatUnivTvs    :: [IfaceTvBndr],
                   ifPatExTvs      :: [IfaceTvBndr],
                   ifPatProvCtxt   :: IfaceContext,
                   ifPatReqCtxt    :: IfaceContext,
-                  ifPatArgs       :: [IfaceIdBndr],
+                  ifPatArgs       :: [IfaceType],
                   ifPatTy         :: IfaceType }
 
--- A bit of magic going on here: there's no need to store the OccName
--- for a decl on the disk, since we can infer the namespace from the
--- context; however it is useful to have the OccName in the IfaceDecl
--- to avoid re-building it in various places.  So we build the OccName
--- when de-serialising.
-
-instance Binary IfaceDecl where
-    put_ bh (IfaceId name ty details idinfo) = do
-        putByte bh 0
-        put_ bh (occNameFS name)
-        put_ bh ty
-        put_ bh details
-        put_ bh idinfo
-
-    put_ _ (IfaceForeign _ _) = 
-        error "Binary.put_(IfaceDecl): IfaceForeign"
-
-    put_ bh (IfaceData a1 a2 a3 a4 a5 a6 a7 a8 a9 a10) = do
-        putByte bh 2
-        put_ bh (occNameFS a1)
-        put_ bh a2
-        put_ bh a3
-        put_ bh a4
-        put_ bh a5
-        put_ bh a6
-        put_ bh a7
-        put_ bh a8
-        put_ bh a9
-        put_ bh a10
-
-    put_ bh (IfaceSyn a1 a2 a3 a4 a5) = do
-        putByte bh 3
-        put_ bh (occNameFS a1)
-        put_ bh a2
-        put_ bh a3
-        put_ bh a4
-        put_ bh a5
-
-    put_ bh (IfaceClass a1 a2 a3 a4 a5 a6 a7 a8 a9) = do
-        putByte bh 4
-        put_ bh a1
-        put_ bh (occNameFS a2)
-        put_ bh a3
-        put_ bh a4
-        put_ bh a5
-        put_ bh a6
-        put_ bh a7
-        put_ bh a8
-        put_ bh a9
-
-    put_ bh (IfaceAxiom a1 a2 a3 a4) = do
-        putByte bh 5
-        put_ bh (occNameFS a1)
-        put_ bh a2
-        put_ bh a3
-        put_ bh a4
-
-    put_ bh (IfacePatSyn name a2 a3 a4 a5 a6 a7 a8 a9) = do
-        putByte bh 6
-        put_ bh (occNameFS name)
-        put_ bh a2
-        put_ bh a3
-        put_ bh a4
-        put_ bh a5
-        put_ bh a6
-        put_ bh a7
-        put_ bh a8
-        put_ bh a9
 
-    get bh = do
-        h <- getByte bh
-        case h of
-            0 -> do name    <- get bh
-                    ty      <- get bh
-                    details <- get bh
-                    idinfo  <- get bh
-                    occ <- return $! mkOccNameFS varName name
-                    return (IfaceId occ ty details idinfo)
-            1 -> error "Binary.get(TyClDecl): ForeignType"
-            2 -> do a1  <- get bh
-                    a2  <- get bh
-                    a3  <- get bh
-                    a4  <- get bh
-                    a5  <- get bh
-                    a6  <- get bh
-                    a7  <- get bh
-                    a8  <- get bh
-                    a9  <- get bh
-                    a10 <- get bh
-                    occ <- return $! mkOccNameFS tcName a1
-                    return (IfaceData occ a2 a3 a4 a5 a6 a7 a8 a9 a10)
-            3 -> do a1 <- get bh
-                    a2 <- get bh
-                    a3 <- get bh
-                    a4 <- get bh
-                    a5 <- get bh
-                    occ <- return $! mkOccNameFS tcName a1
-                    return (IfaceSyn occ a2 a3 a4 a5)
-            4 -> do a1 <- get bh
-                    a2 <- get bh
-                    a3 <- get bh
-                    a4 <- get bh
-                    a5 <- get bh
-                    a6 <- get bh
-                    a7 <- get bh
-                    a8 <- get bh
-                    a9 <- get bh
-                    occ <- return $! mkOccNameFS clsName a2
-                    return (IfaceClass a1 occ a3 a4 a5 a6 a7 a8 a9)
-            5 -> do a1 <- get bh
-                    a2 <- get bh
-                    a3 <- get bh
-                    a4 <- get bh
-                    occ <- return $! mkOccNameFS tcName a1
-                    return (IfaceAxiom occ a2 a3 a4)
-            6 -> do a1 <- get bh
-                    a2 <- get bh
-                    a3 <- get bh
-                    a4 <- get bh
-                    a5 <- get bh
-                    a6 <- get bh
-                    a7 <- get bh
-                    a8 <- get bh
-                    a9 <- get bh
-                    occ <- return $! mkOccNameFS dataName a1
-                    return (IfacePatSyn occ a2 a3 a4 a5 a6 a7 a8 a9)
-            _ -> panic (unwords ["Unknown IfaceDecl tag:", show h])
+data IfaceTyConParent
+  = IfNoParent
+  | IfDataInstance IfExtName
+                   IfaceTyCon
+                   IfaceTcArgs
 
 data IfaceSynTyConRhs
   = IfaceOpenSynFamilyTyCon
-  | IfaceClosedSynFamilyTyCon IfExtName  -- name of associated axiom
+  | IfaceClosedSynFamilyTyCon IfExtName       -- name of associated axiom
+                              [IfaceAxBranch] -- for pretty printing purposes only
   | IfaceAbstractClosedSynFamilyTyCon
   | IfaceSynonymTyCon IfaceType
+  | IfaceBuiltInSynFamTyCon -- for pretty printing purposes only
 
-instance Binary IfaceSynTyConRhs where
-    put_ bh IfaceOpenSynFamilyTyCon           = putByte bh 0
-    put_ bh (IfaceClosedSynFamilyTyCon ax)    = putByte bh 1 >> put_ bh ax
-    put_ bh IfaceAbstractClosedSynFamilyTyCon = putByte bh 2
-    put_ bh (IfaceSynonymTyCon ty)            = putByte bh 3 >> put_ bh ty
-
-    get bh = do { h <- getByte bh
-                ; case h of
-                    0 -> return IfaceOpenSynFamilyTyCon
-                    1 -> do { ax <- get bh
-                            ; return (IfaceClosedSynFamilyTyCon ax) }
-                    2 -> return IfaceAbstractClosedSynFamilyTyCon
-                    _ -> do { ty <- get bh
-                            ; return (IfaceSynonymTyCon ty) } }
-
-data IfaceClassOp = IfaceClassOp OccName DefMethSpec IfaceType
+data IfaceClassOp = IfaceClassOp IfaceTopBndr DefMethSpec IfaceType
         -- Nothing    => no default method
         -- Just False => ordinary polymorphic default method
         -- Just True  => generic default method
 
-instance Binary IfaceClassOp where
-    put_ bh (IfaceClassOp n def ty) = do 
-        put_ bh (occNameFS n)
-        put_ bh def     
-        put_ bh ty
-    get bh = do
-        n   <- get bh
-        def <- get bh
-        ty  <- get bh
-        occ <- return $! mkOccNameFS varName n
-        return (IfaceClassOp occ def ty)
-
-data IfaceAT = IfaceAT
-                  IfaceDecl        -- The associated type declaration
-                  [IfaceAxBranch]  -- Default associated type instances, if any
-
-instance Binary IfaceAT where
-    put_ bh (IfaceAT dec defs) = do
-        put_ bh dec
-        put_ bh defs
-    get bh = do
-        dec  <- get bh
-        defs <- get bh
-        return (IfaceAT dec defs)
-
-instance Outputable IfaceAxBranch where
-  ppr = pprAxBranch Nothing
-
-pprAxBranch :: Maybe IfaceTyCon -> IfaceAxBranch -> SDoc
-pprAxBranch mtycon (IfaceAxBranch { ifaxbTyVars = tvs
-                                  , ifaxbLHS = pat_tys
-                                  , ifaxbRHS = ty
-                                  , ifaxbIncomps = incomps })
-  = ppr tvs <+> ppr_lhs <+> char '=' <+> ppr ty $+$
-    nest 2 maybe_incomps
-      where
-        ppr_lhs
-          | Just tycon <- mtycon
-          = ppr (IfaceTyConApp tycon pat_tys)
-          | otherwise
-          = hsep (map ppr pat_tys)
-
-        maybe_incomps
-          | [] <- incomps
-          = empty
+data IfaceAT = IfaceAT  -- See Class.ClassATItem
+                  IfaceDecl          -- The associated type declaration
+                  (Maybe IfaceType)  -- Default associated type instance, if any
 
-          | otherwise
-          = parens (ptext (sLit "incompatible indices:") <+> ppr incomps)
 
--- this is just like CoAxBranch
+-- This is just like CoAxBranch
 data IfaceAxBranch = IfaceAxBranch { ifaxbTyVars  :: [IfaceTvBndr]
-                                   , ifaxbLHS     :: [IfaceType]
+                                   , ifaxbLHS     :: IfaceTcArgs
                                    , ifaxbRoles   :: [Role]
                                    , ifaxbRHS     :: IfaceType
                                    , ifaxbIncomps :: [BranchIndex] }
                                      -- See Note [Storing compatibility] in CoAxiom
 
-instance Binary IfaceAxBranch where
-    put_ bh (IfaceAxBranch a1 a2 a3 a4 a5) = do
-        put_ bh a1
-        put_ bh a2
-        put_ bh a3
-        put_ bh a4
-        put_ bh a5
-    get bh = do
-        a1 <- get bh
-        a2 <- get bh
-        a3 <- get bh
-        a4 <- get bh
-        a5 <- get bh
-        return (IfaceAxBranch a1 a2 a3 a4 a5)
-
 data IfaceConDecls
   = IfAbstractTyCon Bool        -- c.f TyCon.AbstractTyCon
   | IfDataFamTyCon              -- Data family
   | IfDataTyCon [IfaceConDecl]  -- Data type decls
   | IfNewTyCon  IfaceConDecl    -- Newtype decls
 
-instance Binary IfaceConDecls where
-    put_ bh (IfAbstractTyCon d) = putByte bh 0 >> put_ bh d
-    put_ bh IfDataFamTyCon     = putByte bh 1
-    put_ bh (IfDataTyCon cs)    = putByte bh 2 >> put_ bh cs
-    put_ bh (IfNewTyCon c)      = putByte bh 3 >> put_ bh c
-    get bh = do
-        h <- getByte bh
-        case h of
-            0 -> liftM IfAbstractTyCon $ get bh
-            1 -> return IfDataFamTyCon
-            2 -> liftM IfDataTyCon $ get bh
-            _ -> liftM IfNewTyCon $ get bh
-
-visibleIfConDecls :: IfaceConDecls -> [IfaceConDecl]
-visibleIfConDecls (IfAbstractTyCon {}) = []
-visibleIfConDecls IfDataFamTyCon      = []
-visibleIfConDecls (IfDataTyCon cs)     = cs
-visibleIfConDecls (IfNewTyCon c)       = [c]
-
 data IfaceConDecl
   = IfCon {
-        ifConOcc     :: OccName,                -- Constructor name
+        ifConOcc     :: IfaceTopBndr,                -- Constructor name
         ifConWrapper :: Bool,                   -- True <=> has a wrapper
         ifConInfix   :: Bool,                   -- True <=> declared infix
-        ifConUnivTvs :: [IfaceTvBndr],          -- Universal tyvars
+
+        -- The universal type variables are precisely those
+        -- of the type constructor of this data constructor
+        -- This is *easy* to guarantee when creating the IfCon
+        -- but it's not so easy for the original TyCon/DataCon
+        -- So this guarantee holds for IfaceConDecl, but *not* for DataCon
+
         ifConExTvs   :: [IfaceTvBndr],          -- Existential tyvars
-        ifConEqSpec  :: [(OccName,IfaceType)],  -- Equality constraints
+        ifConEqSpec  :: IfaceEqSpec,            -- Equality constraints
         ifConCtxt    :: IfaceContext,           -- Non-stupid context
         ifConArgTys  :: [IfaceType],            -- Arg types
-        ifConFields  :: [OccName],              -- ...ditto... (field labels)
+        ifConFields  :: [IfaceTopBndr],         -- ...ditto... (field labels)
         ifConStricts :: [IfaceBang]}            -- Empty (meaning all lazy),
                                                 -- or 1-1 corresp with arg tys
 
-instance Binary IfaceConDecl where
-    put_ bh (IfCon a1 a2 a3 a4 a5 a6 a7 a8 a9 a10) = do
-        put_ bh a1
-        put_ bh a2
-        put_ bh a3
-        put_ bh a4
-        put_ bh a5
-        put_ bh a6
-        put_ bh a7
-        put_ bh a8
-        put_ bh a9
-        put_ bh a10
-    get bh = do
-        a1 <- get bh
-        a2 <- get bh
-        a3 <- get bh
-        a4 <- get bh
-        a5 <- get bh
-        a6 <- get bh
-        a7 <- get bh
-        a8 <- get bh
-        a9 <- get bh
-        a10 <- get bh
-        return (IfCon a1 a2 a3 a4 a5 a6 a7 a8 a9 a10)
+type IfaceEqSpec = [(IfLclName,IfaceType)]
 
 data IfaceBang
   = IfNoBang | IfStrict | IfUnpack | IfUnpackCo IfaceCoercion
 
-instance Binary IfaceBang where
-    put_ bh IfNoBang        = putByte bh 0
-    put_ bh IfStrict        = putByte bh 1
-    put_ bh IfUnpack        = putByte bh 2
-    put_ bh (IfUnpackCo co) = putByte bh 3 >> put_ bh co
-
-    get bh = do
-            h <- getByte bh
-            case h of
-              0 -> do return IfNoBang
-              1 -> do return IfStrict
-              2 -> do return IfUnpack
-              _ -> do { a <- get bh; return (IfUnpackCo a) }
-
 data IfaceClsInst
   = IfaceClsInst { ifInstCls  :: IfExtName,                -- See comments with
                    ifInstTys  :: [Maybe IfaceTyCon],       -- the defn of ClsInst
@@ -448,21 +226,6 @@ data IfaceClsInst
         -- If this instance decl is *used*, we'll record a usage on the dfun;
         -- and if the head does not change it won't be used if it wasn't before
 
-instance Binary IfaceClsInst where
-    put_ bh (IfaceClsInst cls tys dfun flag orph) = do
-        put_ bh cls
-        put_ bh tys
-        put_ bh dfun
-        put_ bh flag
-        put_ bh orph
-    get bh = do
-        cls  <- get bh
-        tys  <- get bh
-        dfun <- get bh
-        flag <- get bh
-        orph <- get bh
-        return (IfaceClsInst cls tys dfun flag orph)
-
 -- The ifFamInstTys field of IfaceFamInst contains a list of the rough
 -- match types
 data IfaceFamInst
@@ -472,19 +235,6 @@ data IfaceFamInst
                  , ifFamInstOrph     :: Maybe OccName        -- Just like IfaceClsInst
                  }
 
-instance Binary IfaceFamInst where
-    put_ bh (IfaceFamInst fam tys name orph) = do
-        put_ bh fam
-        put_ bh tys
-        put_ bh name
-        put_ bh orph
-    get bh = do
-        fam      <- get bh
-        tys      <- get bh
-        name     <- get bh
-        orph     <- get bh
-        return (IfaceFamInst fam tys name orph)
-
 data IfaceRule
   = IfaceRule {
         ifRuleName   :: RuleName,
@@ -497,82 +247,14 @@ data IfaceRule
         ifRuleOrph   :: Maybe OccName   -- Just like IfaceClsInst
     }
 
-instance Binary IfaceRule where
-    put_ bh (IfaceRule a1 a2 a3 a4 a5 a6 a7 a8) = do
-        put_ bh a1
-        put_ bh a2
-        put_ bh a3
-        put_ bh a4
-        put_ bh a5
-        put_ bh a6
-        put_ bh a7
-        put_ bh a8
-    get bh = do
-        a1 <- get bh
-        a2 <- get bh
-        a3 <- get bh
-        a4 <- get bh
-        a5 <- get bh
-        a6 <- get bh
-        a7 <- get bh
-        a8 <- get bh
-        return (IfaceRule a1 a2 a3 a4 a5 a6 a7 a8)
-
 data IfaceAnnotation
   = IfaceAnnotation {
         ifAnnotatedTarget :: IfaceAnnTarget,
         ifAnnotatedValue  :: AnnPayload
   }
 
-instance Outputable IfaceAnnotation where
-  ppr (IfaceAnnotation target value) = ppr target <+> colon <+> ppr value
-
-instance Binary IfaceAnnotation where
-    put_ bh (IfaceAnnotation a1 a2) = do
-        put_ bh a1
-        put_ bh a2
-    get bh = do
-        a1 <- get bh
-        a2 <- get bh
-        return (IfaceAnnotation a1 a2)
-
 type IfaceAnnTarget = AnnTarget OccName
 
--- We only serialise the IdDetails of top-level Ids, and even then
--- we only need a very limited selection.  Notably, none of the
--- implicit ones are needed here, because they are not put it
--- interface files
-
-data IfaceIdDetails
-  = IfVanillaId
-  | IfRecSelId IfaceTyCon Bool
-  | IfDFunId Int          -- Number of silent args
-
-instance Binary IfaceIdDetails where
-    put_ bh IfVanillaId      = putByte bh 0
-    put_ bh (IfRecSelId a b) = putByte bh 1 >> put_ bh a >> put_ bh b
-    put_ bh (IfDFunId n)     = do { putByte bh 2; put_ bh n }
-    get bh = do
-        h <- getByte bh
-        case h of
-            0 -> return IfVanillaId
-            1 -> do { a <- get bh; b <- get bh; return (IfRecSelId a b) }
-            _ -> do { n <- get bh; return (IfDFunId n) }
-
-data IfaceIdInfo
-  = NoInfo                      -- When writing interface file without -O
-  | HasInfo [IfaceInfoItem]     -- Has info, and here it is
-
-instance Binary IfaceIdInfo where
-    put_ bh NoInfo      = putByte bh 0
-    put_ bh (HasInfo i) = putByte bh 1 >> lazyPut bh i -- NB lazyPut
-
-    get bh = do
-        h <- getByte bh
-        case h of
-            0 -> return NoInfo
-            _ -> liftM HasInfo $ lazyGet bh    -- NB lazyGet
-
 -- Here's a tricky case:
 --   * Compile with -O module A, and B which imports A.f
 --   * Change function f in A, and recompile without -O
@@ -583,6 +265,10 @@ instance Binary IfaceIdInfo where
 --   * The version comparison sees that new (=NoInfo) differs from old (=HasInfo *)
 --      and so gives a new version.
 
+data IfaceIdInfo
+  = NoInfo                      -- When writing interface file without -O
+  | HasInfo [IfaceInfoItem]     -- Has info, and here it is
+
 data IfaceInfoItem
   = HsArity         Arity
   | HsStrictness    StrictSig
@@ -591,23 +277,6 @@ data IfaceInfoItem
                     IfaceUnfolding   -- See Note [Expose recursive functions]
   | HsNoCafRefs
 
-instance Binary IfaceInfoItem where
-    put_ bh (HsArity aa)          = putByte bh 0 >> put_ bh aa
-    put_ bh (HsStrictness ab)     = putByte bh 1 >> put_ bh ab
-    put_ bh (HsUnfold lb ad)      = putByte bh 2 >> put_ bh lb >> put_ bh ad
-    put_ bh (HsInline ad)         = putByte bh 3 >> put_ bh ad
-    put_ bh HsNoCafRefs           = putByte bh 4
-    get bh = do
-        h <- getByte bh
-        case h of
-            0 -> liftM HsArity $ get bh
-            1 -> liftM HsStrictness $ get bh
-            2 -> do lb <- get bh
-                    ad <- get bh
-                    return (HsUnfold lb ad)
-            3 -> liftM HsInline $ get bh
-            _ -> return HsNoCafRefs
-
 -- NB: Specialisations and rules come in separately and are
 -- only later attached to the Id.  Partial reason: some are orphans.
 
@@ -625,253 +294,19 @@ data IfaceUnfolding
 
   | IfDFunUnfold [IfaceBndr] [IfaceExpr]
 
-instance Binary IfaceUnfolding where
-    put_ bh (IfCoreUnfold s e) = do
-        putByte bh 0
-        put_ bh s
-        put_ bh e
-    put_ bh (IfInlineRule a b c d) = do
-        putByte bh 1
-        put_ bh a
-        put_ bh b
-        put_ bh c
-        put_ bh d
-    put_ bh (IfDFunUnfold as bs) = do
-        putByte bh 2
-        put_ bh as
-        put_ bh bs
-    put_ bh (IfCompulsory e) = do
-        putByte bh 3
-        put_ bh e
-    get bh = do
-        h <- getByte bh
-        case h of
-            0 -> do s <- get bh
-                    e <- get bh
-                    return (IfCoreUnfold s e)
-            1 -> do a <- get bh
-                    b <- get bh
-                    c <- get bh
-                    d <- get bh
-                    return (IfInlineRule a b c d)
-            2 -> do as <- get bh
-                    bs <- get bh
-                    return (IfDFunUnfold as bs)
-            _ -> do e <- get bh
-                    return (IfCompulsory e)
 
---------------------------------
-data IfaceExpr
-  = IfaceLcl    IfLclName
-  | IfaceExt    IfExtName
-  | IfaceType   IfaceType
-  | IfaceCo     IfaceCoercion
-  | IfaceTuple 	TupleSort [IfaceExpr]	-- Saturated; type arguments omitted
-  | IfaceLam 	IfaceBndr IfaceExpr
-  | IfaceApp 	IfaceExpr IfaceExpr
-  | IfaceCase	IfaceExpr IfLclName [IfaceAlt]
-  | IfaceECase  IfaceExpr IfaceType     -- See Note [Empty case alternatives]
-  | IfaceLet	IfaceBinding  IfaceExpr
-  | IfaceCast   IfaceExpr IfaceCoercion
-  | IfaceLit    Literal
-  | IfaceFCall  ForeignCall IfaceType
-  | IfaceTick   IfaceTickish IfaceExpr    -- from Tick tickish E
+-- We only serialise the IdDetails of top-level Ids, and even then
+-- we only need a very limited selection.  Notably, none of the
+-- implicit ones are needed here, because they are not put it
+-- interface files
 
-instance Binary IfaceExpr where
-    put_ bh (IfaceLcl aa) = do
-        putByte bh 0
-        put_ bh aa
-    put_ bh (IfaceType ab) = do
-        putByte bh 1
-        put_ bh ab
-    put_ bh (IfaceCo ab) = do
-        putByte bh 2
-        put_ bh ab
-    put_ bh (IfaceTuple ac ad) = do
-        putByte bh 3
-        put_ bh ac
-        put_ bh ad
-    put_ bh (IfaceLam ae af) = do
-        putByte bh 4
-        put_ bh ae
-        put_ bh af
-    put_ bh (IfaceApp ag ah) = do
-        putByte bh 5
-        put_ bh ag
-        put_ bh ah
-    put_ bh (IfaceCase ai aj ak) = do
-        putByte bh 6
-        put_ bh ai
-        put_ bh aj
-        put_ bh ak
-    put_ bh (IfaceLet al am) = do
-        putByte bh 7
-        put_ bh al
-        put_ bh am
-    put_ bh (IfaceTick an ao) = do
-        putByte bh 8
-        put_ bh an
-        put_ bh ao
-    put_ bh (IfaceLit ap) = do
-        putByte bh 9
-        put_ bh ap
-    put_ bh (IfaceFCall as at) = do
-        putByte bh 10
-        put_ bh as
-        put_ bh at
-    put_ bh (IfaceExt aa) = do
-        putByte bh 11
-        put_ bh aa
-    put_ bh (IfaceCast ie ico) = do
-        putByte bh 12
-        put_ bh ie
-        put_ bh ico
-    put_ bh (IfaceECase a b) = do
-        putByte bh 13
-        put_ bh a
-        put_ bh b
-    get bh = do
-        h <- getByte bh
-        case h of
-            0 -> do aa <- get bh
-                    return (IfaceLcl aa)
-            1 -> do ab <- get bh
-                    return (IfaceType ab)
-            2 -> do ab <- get bh
-                    return (IfaceCo ab)
-            3 -> do ac <- get bh
-                    ad <- get bh
-                    return (IfaceTuple ac ad)
-            4 -> do ae <- get bh
-                    af <- get bh
-                    return (IfaceLam ae af)
-            5 -> do ag <- get bh
-                    ah <- get bh
-                    return (IfaceApp ag ah)
-            6 -> do ai <- get bh
-                    aj <- get bh
-                    ak <- get bh
-                    return (IfaceCase ai aj ak)
-            7 -> do al <- get bh
-                    am <- get bh
-                    return (IfaceLet al am)
-            8 -> do an <- get bh
-                    ao <- get bh
-                    return (IfaceTick an ao)
-            9 -> do ap <- get bh
-                    return (IfaceLit ap)
-            10 -> do as <- get bh
-                     at <- get bh
-                     return (IfaceFCall as at)
-            11 -> do aa <- get bh
-                     return (IfaceExt aa)
-            12 -> do ie <- get bh
-                     ico <- get bh
-                     return (IfaceCast ie ico)
-            13 -> do a <- get bh
-                     b <- get bh
-                     return (IfaceECase a b)
-            _ -> panic ("get IfaceExpr " ++ show h)
+data IfaceIdDetails
+  = IfVanillaId
+  | IfRecSelId IfaceTyCon Bool
+  | IfDFunId Int          -- Number of silent args
 
-data IfaceTickish
-  = IfaceHpcTick Module Int                -- from HpcTick x
-  | IfaceSCC     CostCentre Bool Bool      -- from ProfNote
-  -- no breakpoints: we never export these into interface files
+\end{code}
 
-instance Binary IfaceTickish where
-    put_ bh (IfaceHpcTick m ix) = do
-        putByte bh 0
-        put_ bh m
-        put_ bh ix
-    put_ bh (IfaceSCC cc tick push) = do
-        putByte bh 1
-        put_ bh cc
-        put_ bh tick
-        put_ bh push
-
-    get bh = do
-        h <- getByte bh
-        case h of
-            0 -> do m <- get bh
-                    ix <- get bh
-                    return (IfaceHpcTick m ix)
-            1 -> do cc <- get bh
-                    tick <- get bh
-                    push <- get bh
-                    return (IfaceSCC cc tick push)
-            _ -> panic ("get IfaceTickish " ++ show h)
-
-type IfaceAlt = (IfaceConAlt, [IfLclName], IfaceExpr)
-        -- Note: IfLclName, not IfaceBndr (and same with the case binder)
-        -- We reconstruct the kind/type of the thing from the context
-        -- thus saving bulk in interface files
-
-data IfaceConAlt = IfaceDefault
-                 | IfaceDataAlt IfExtName
-                 | IfaceLitAlt Literal
-
-instance Binary IfaceConAlt where
-    put_ bh IfaceDefault      = putByte bh 0
-    put_ bh (IfaceDataAlt aa) = putByte bh 1 >> put_ bh aa
-    put_ bh (IfaceLitAlt ac)  = putByte bh 2 >> put_ bh ac
-    get bh = do
-        h <- getByte bh
-        case h of
-            0 -> return IfaceDefault
-            1 -> liftM IfaceDataAlt $ get bh
-            _ -> liftM IfaceLitAlt  $ get bh
-
-data IfaceBinding
-  = IfaceNonRec IfaceLetBndr IfaceExpr
-  | IfaceRec    [(IfaceLetBndr, IfaceExpr)]
-
-instance Binary IfaceBinding where
-    put_ bh (IfaceNonRec aa ab) = putByte bh 0 >> put_ bh aa >> put_ bh ab
-    put_ bh (IfaceRec ac)       = putByte bh 1 >> put_ bh ac
-    get bh = do
-        h <- getByte bh
-        case h of
-            0 -> do { aa <- get bh; ab <- get bh; return (IfaceNonRec aa ab) }
-            _ -> do { ac <- get bh; return (IfaceRec ac) }
-
--- IfaceLetBndr is like IfaceIdBndr, but has IdInfo too
--- It's used for *non-top-level* let/rec binders
--- See Note [IdInfo on nested let-bindings]
-data IfaceLetBndr = IfLetBndr IfLclName IfaceType IfaceIdInfo
-
-instance Binary IfaceLetBndr where
-    put_ bh (IfLetBndr a b c) = do
-            put_ bh a
-            put_ bh b
-            put_ bh c
-    get bh = do a <- get bh
-                b <- get bh
-                c <- get bh
-                return (IfLetBndr a b c)
-\end{code}
-
-Note [Empty case alternatives]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-In IfaceSyn an IfaceCase does not record the types of the alternatives,
-unlike CorSyn Case.  But we need this type if the alternatives are empty.
-Hence IfaceECase.  See Note [Empty case alternatives] in CoreSyn.
-
-Note [Expose recursive functions]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-For supercompilation we want to put *all* unfoldings in the interface
-file, even for functions that are recursive (or big).  So we need to
-know when an unfolding belongs to a loop-breaker so that we can refrain
-from inlining it (except during supercompilation).
-
-Note [IdInfo on nested let-bindings]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Occasionally we want to preserve IdInfo on nested let bindings. The one
-that came up was a NOINLINE pragma on a let-binding inside an INLINE
-function.  The user (Duncan Coutts) really wanted the NOINLINE control
-to cross the separate compilation boundary.
-
-In general we retain all info that is left by CoreTidy.tidyLetBndr, since
-that is what is seen by importing module with --make
 
 Note [Orphans]: the ifInstOrph and ifRuleOrph fields
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -948,10 +383,22 @@ Note [Versioning of instances]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 See [http://ghc.haskell.org/trac/ghc/wiki/Commentary/Compiler/RecompilationAvoidance#Instances]
 
+
+%************************************************************************
+%*                                                                      *
+                Functions over declarations
+%*                                                                      *
+%************************************************************************
+
 \begin{code}
--- -----------------------------------------------------------------------------
--- Utils on IfaceSyn
+visibleIfConDecls :: IfaceConDecls -> [IfaceConDecl]
+visibleIfConDecls (IfAbstractTyCon {}) = []
+visibleIfConDecls IfDataFamTyCon       = []
+visibleIfConDecls (IfDataTyCon cs)     = cs
+visibleIfConDecls (IfNewTyCon c)       = [c]
+\end{code}
 
+\begin{code}
 ifaceDeclImplicitBndrs :: IfaceDecl -> [OccName]
 --  *Excludes* the 'main' name, but *includes* the implicitly-bound names
 -- Deeply revolting, because it has to predict what gets bound,
@@ -1014,11 +461,6 @@ ifaceDeclImplicitBndrs (IfaceClass {ifCtxt = sc_ctxt, ifName = cls_tc_occ,
     dc_occ = mkClassDataConOcc cls_tc_occ
     is_newtype = n_sigs + n_ctxt == 1 -- Sigh
 
-ifaceDeclImplicitBndrs (IfacePatSyn{ ifName = ps_occ, ifPatHasWrapper = has_wrapper })
-  = [wrap_occ | has_wrapper]
-  where
-    wrap_occ = mkDataConWrapperOcc ps_occ  -- Id namespace
-
 ifaceDeclImplicitBndrs _ = []
 
 -- -----------------------------------------------------------------------------
@@ -1037,159 +479,418 @@ ifaceDeclFingerprints hash decl
      computeFingerprint' =
        unsafeDupablePerformIO
         . computeFingerprint (panic "ifaceDeclFingerprints")
+\end{code}
 
------------------------------ Printing IfaceDecl ------------------------------
+%************************************************************************
+%*                                                                      *
+                Expressions
+%*                                                                      *
+%************************************************************************
 
-instance Outputable IfaceDecl where
-  ppr = pprIfaceDecl
+\begin{code}
+data IfaceExpr
+  = IfaceLcl    IfLclName
+  | IfaceExt    IfExtName
+  | IfaceType   IfaceType
+  | IfaceCo     IfaceCoercion
+  | IfaceTuple 	TupleSort [IfaceExpr]	-- Saturated; type arguments omitted
+  | IfaceLam 	IfaceBndr IfaceExpr
+  | IfaceApp 	IfaceExpr IfaceExpr
+  | IfaceCase	IfaceExpr IfLclName [IfaceAlt]
+  | IfaceECase  IfaceExpr IfaceType     -- See Note [Empty case alternatives]
+  | IfaceLet	IfaceBinding  IfaceExpr
+  | IfaceCast   IfaceExpr IfaceCoercion
+  | IfaceLit    Literal
+  | IfaceFCall  ForeignCall IfaceType
+  | IfaceTick   IfaceTickish IfaceExpr    -- from Tick tickish E
+
+data IfaceTickish
+  = IfaceHpcTick Module Int                -- from HpcTick x
+  | IfaceSCC     CostCentre Bool Bool      -- from ProfNote
+  | IfaceSource  RealSrcSpan String        -- from SourceNote
+  -- no breakpoints: we never export these into interface files
 
-pprIfaceDecl :: IfaceDecl -> SDoc
-pprIfaceDecl (IfaceId {ifName = var, ifType = ty,
-                       ifIdDetails = details, ifIdInfo = info})
-  = sep [ ppr var <+> dcolon <+> ppr ty,
-          nest 2 (ppr details),
-          nest 2 (ppr info) ]
+type IfaceAlt = (IfaceConAlt, [IfLclName], IfaceExpr)
+        -- Note: IfLclName, not IfaceBndr (and same with the case binder)
+        -- We reconstruct the kind/type of the thing from the context
+        -- thus saving bulk in interface files
 
-pprIfaceDecl (IfaceForeign {ifName = tycon})
-  = hsep [ptext (sLit "foreign import type dotnet"), ppr tycon]
+data IfaceConAlt = IfaceDefault
+                 | IfaceDataAlt IfExtName
+                 | IfaceLitAlt Literal
+
+data IfaceBinding
+  = IfaceNonRec IfaceLetBndr IfaceExpr
+  | IfaceRec    [(IfaceLetBndr, IfaceExpr)]
+
+-- IfaceLetBndr is like IfaceIdBndr, but has IdInfo too
+-- It's used for *non-top-level* let/rec binders
+-- See Note [IdInfo on nested let-bindings]
+data IfaceLetBndr = IfLetBndr IfLclName IfaceType IfaceIdInfo
+\end{code}
+
+Note [Empty case alternatives]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+In IfaceSyn an IfaceCase does not record the types of the alternatives,
+unlike CorSyn Case.  But we need this type if the alternatives are empty.
+Hence IfaceECase.  See Note [Empty case alternatives] in CoreSyn.
+
+Note [Expose recursive functions]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+For supercompilation we want to put *all* unfoldings in the interface
+file, even for functions that are recursive (or big).  So we need to
+know when an unfolding belongs to a loop-breaker so that we can refrain
+from inlining it (except during supercompilation).
+
+Note [IdInfo on nested let-bindings]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Occasionally we want to preserve IdInfo on nested let bindings. The one
+that came up was a NOINLINE pragma on a let-binding inside an INLINE
+function.  The user (Duncan Coutts) really wanted the NOINLINE control
+to cross the separate compilation boundary.
 
-pprIfaceDecl (IfaceSyn {ifName = tycon,
-                        ifTyVars = tyvars,
-                        ifSynRhs = IfaceSynonymTyCon mono_ty})
-  = hang (ptext (sLit "type") <+> pprIfaceDeclHead [] tycon tyvars)
-       2 (vcat [equals <+> ppr mono_ty])
+In general we retain all info that is left by CoreTidy.tidyLetBndr, since
+that is what is seen by importing module with --make
+
+
+%************************************************************************
+%*                                                                      *
+              Printing IfaceDecl
+%*                                                                      *
+%************************************************************************
 
-pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars,
-                        ifSynRhs = rhs, ifSynKind = kind })
-  = hang (ptext (sLit "type family") <+> pprIfaceDeclHead [] tycon tyvars)
-       2 (sep [dcolon <+> ppr kind, parens (pp_rhs rhs)])
+\begin{code}
+pprAxBranch :: SDoc -> IfaceAxBranch -> SDoc
+-- The TyCon might be local (just an OccName), or this might
+-- be a branch for an imported TyCon, so it would be an ExtName
+-- So it's easier to take an SDoc here
+pprAxBranch pp_tc (IfaceAxBranch { ifaxbTyVars = tvs
+                                  , ifaxbLHS = pat_tys
+                                  , ifaxbRHS = rhs
+                                  , ifaxbIncomps = incomps })
+  = hang (pprUserIfaceForAll tvs)
+       2 (hang pp_lhs 2 (equals <+> ppr rhs))
+    $+$
+    nest 2 maybe_incomps
   where
-    pp_rhs IfaceOpenSynFamilyTyCon           = ptext (sLit "open")
-    pp_rhs (IfaceClosedSynFamilyTyCon ax)    = ptext (sLit "closed, axiom") <+> ppr ax
-    pp_rhs IfaceAbstractClosedSynFamilyTyCon = ptext (sLit "closed, abstract")
-    pp_rhs _ = panic "pprIfaceDecl syn"
+    pp_lhs = hang pp_tc 2 (pprParendIfaceTcArgs pat_tys)
+    maybe_incomps = ppUnless (null incomps) $ parens $
+                    ptext (sLit "incompatible indices:") <+> ppr incomps
+
+instance Outputable IfaceAnnotation where
+  ppr (IfaceAnnotation target value) = ppr target <+> colon <+> ppr value
 
-pprIfaceDecl (IfaceData {ifName = tycon, ifCType = cType,
-                         ifCtxt = context,
-                         ifTyVars = tyvars, ifRoles = roles, ifCons = condecls,
-                         ifRec = isrec, ifPromotable = is_prom,
-                         ifAxiom = mbAxiom})
-  = hang (pp_nd <+> pprIfaceDeclHead context tycon tyvars)
-       2 (vcat [ pprCType cType
-               , pprRoles roles
-               , pprRec isrec <> comma <+> pp_prom
-               , pp_condecls tycon condecls
-               , pprAxiom mbAxiom])
+instance HasOccName IfaceClassOp where
+  occName (IfaceClassOp n _ _) = n
+
+instance HasOccName IfaceConDecl where
+  occName = ifConOcc
+
+instance HasOccName IfaceDecl where
+  occName = ifName
+
+instance Outputable IfaceDecl where
+  ppr = pprIfaceDecl showAll
+
+data ShowSub
+  = ShowSub
+      { ss_ppr_bndr :: OccName -> SDoc  -- Pretty-printer for binders in IfaceDecl
+                                        -- See Note [Printing IfaceDecl binders]
+      , ss_how_much :: ShowHowMuch }
+
+data ShowHowMuch
+  = ShowHeader   -- Header information only, not rhs
+  | ShowSome [OccName]    -- []     <=> Print all sub-components
+                          -- (n:ns) <=> print sub-component 'n' with ShowSub=ns
+                          --            elide other sub-components to "..."
+                          -- May 14: the list is max 1 element long at the moment
+  | ShowIface    -- Everything including GHC-internal information (used in --show-iface)
+
+showAll :: ShowSub
+showAll = ShowSub { ss_how_much = ShowIface, ss_ppr_bndr = ppr }
+
+ppShowIface :: ShowSub -> SDoc -> SDoc
+ppShowIface (ShowSub { ss_how_much = ShowIface }) doc = doc
+ppShowIface _                                     _   = empty
+
+ppShowRhs :: ShowSub -> SDoc -> SDoc
+ppShowRhs (ShowSub { ss_how_much = ShowHeader }) _   = empty
+ppShowRhs _                                      doc = doc
+
+showSub :: HasOccName n => ShowSub -> n -> Bool
+showSub (ShowSub { ss_how_much = ShowHeader })     _     = False
+showSub (ShowSub { ss_how_much = ShowSome (n:_) }) thing = n == occName thing
+showSub (ShowSub { ss_how_much = _ })              _     = True
+\end{code}
+
+Note [Printing IfaceDecl binders]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+The binders in an IfaceDecl are just OccNames, so we don't know what module they
+come from.  But when we pretty-print a TyThing by converting to an IfaceDecl
+(see PprTyThing), the TyThing may come from some other module so we really need
+the module qualifier.  We solve this by passing in a pretty-printer for the
+binders.
+
+When printing an interface file (--show-iface), we want to print
+everything unqualified, so we can just print the OccName directly.
+
+\begin{code}
+ppr_trim :: [Maybe SDoc] -> [SDoc]
+-- Collapse a group of Nothings to a single "..."
+ppr_trim xs
+  = snd (foldr go (False, []) xs)
   where
-    pp_prom | is_prom   = ptext (sLit "Promotable")
-            | otherwise = ptext (sLit "Not promotable")
+    go (Just doc) (_,     so_far) = (False, doc : so_far)
+    go Nothing    (True,  so_far) = (True, so_far)
+    go Nothing    (False, so_far) = (True, ptext (sLit "...") : so_far)
+
+isIfaceDataInstance :: IfaceTyConParent -> Bool
+isIfaceDataInstance IfNoParent = False
+isIfaceDataInstance _          = True
+
+pprIfaceDecl :: ShowSub -> IfaceDecl -> SDoc
+-- NB: pprIfaceDecl is also used for pretty-printing TyThings in GHCi
+--     See Note [Pretty-printing TyThings] in PprTyThing
+pprIfaceDecl ss (IfaceData { ifName = tycon, ifCType = ctype,
+                             ifCtxt = context, ifTyVars = tc_tyvars,
+                             ifRoles = roles, ifCons = condecls,
+                             ifParent = parent, ifRec = isrec,
+                             ifGadtSyntax = gadt,
+                             ifPromotable = is_prom })
+
+  | gadt_style = vcat [ pp_roles
+                      , pp_nd <+> pp_lhs <+> pp_where
+                      , nest 2 (vcat pp_cons)
+                      , nest 2 $ ppShowIface ss pp_extra ]
+  | otherwise  = vcat [ pp_roles
+                      , hang (pp_nd <+> pp_lhs) 2 (add_bars pp_cons)
+                      , nest 2 $ ppShowIface ss pp_extra ]
+  where
+    is_data_instance = isIfaceDataInstance parent
+
+    gadt_style = gadt || any (not . isVanillaIfaceConDecl) cons
+    cons       = visibleIfConDecls condecls
+    pp_where   = ppWhen (gadt_style && not (null cons)) $ ptext (sLit "where")
+    pp_cons    = ppr_trim (map show_con cons) :: [SDoc]
+
+    pp_lhs = case parent of
+               IfNoParent -> pprIfaceDeclHead context ss tycon tc_tyvars
+               _          -> ptext (sLit "instance") <+> pprIfaceTyConParent parent
+
+    pp_roles
+      | is_data_instance = empty
+      | otherwise        = pprRoles (== Representational) (pprPrefixIfDeclBndr ss tycon) 
+                                    tc_tyvars roles
+            -- Don't display roles for data family instances (yet)
+            -- See discussion on Trac #8672.
+
+    add_bars []     = empty
+    add_bars (c:cs) = sep ((equals <+> c) : map (char '|' <+>) cs)
+
+    ok_con dc = showSub ss dc || any (showSub ss) (ifConFields dc)
+
+    show_con dc
+      | ok_con dc = Just $ pprIfaceConDecl ss gadt_style mk_user_con_res_ty dc
+      | otherwise = Nothing
+
+    mk_user_con_res_ty :: IfaceEqSpec -> ([IfaceTvBndr], SDoc)
+    -- See Note [Result type of a data family GADT]
+    mk_user_con_res_ty eq_spec
+      | IfDataInstance _ tc tys <- parent
+      = (con_univ_tvs, pprIfaceType (IfaceTyConApp tc (substIfaceTcArgs gadt_subst tys)))
+      | otherwise
+      = (con_univ_tvs, sdocWithDynFlags (ppr_tc_app gadt_subst))
+      where
+        gadt_subst = mkFsEnv eq_spec
+        done_univ_tv (tv,_) = isJust (lookupFsEnv gadt_subst tv)
+        con_univ_tvs = filterOut done_univ_tv tc_tyvars
+
+    ppr_tc_app gadt_subst dflags
+       = pprPrefixIfDeclBndr ss tycon
+         <+> sep [ pprParendIfaceType (substIfaceTyVar gadt_subst tv)
+                 | (tv,_kind) <- stripIfaceKindVars dflags tc_tyvars ]
+
     pp_nd = case condecls of
-                IfAbstractTyCon dis -> ptext (sLit "abstract") <> parens (ppr dis)
-                IfDataFamTyCon     -> ptext (sLit "data family")
-                IfDataTyCon _       -> ptext (sLit "data")
-                IfNewTyCon _        -> ptext (sLit "newtype")
-
-pprIfaceDecl (IfaceClass {ifCtxt = context, ifName = clas, ifTyVars = tyvars,
-                          ifRoles = roles, ifFDs = fds, ifATs = ats, ifSigs = sigs,
-                          ifRec = isrec})
-  = hang (ptext (sLit "class") <+> pprIfaceDeclHead context clas tyvars <+> pprFundeps fds)
-       2 (vcat [pprRoles roles,
-                pprRec isrec,
-                sep (map ppr ats),
-                sep (map ppr sigs)])
-
-pprIfaceDecl (IfaceAxiom {ifName = name, ifTyCon = tycon, ifAxBranches = branches })
-  = hang (ptext (sLit "axiom") <+> ppr name <> colon)
-       2 (vcat $ map (pprAxBranch $ Just tycon) branches)
-
-pprIfaceDecl (IfacePatSyn { ifName = name, ifPatHasWrapper = has_wrap,
-                            ifPatIsInfix = is_infix,
-                            ifPatUnivTvs = univ_tvs, ifPatExTvs = ex_tvs,
-                            ifPatProvCtxt = prov_ctxt, ifPatReqCtxt = req_ctxt,
-                            ifPatArgs = args,
-                            ifPatTy = ty })
-  = hang (text "pattern" <+> header)
-       4 details
+              IfAbstractTyCon d -> ptext (sLit "abstract") <> ppShowIface ss (parens (ppr d))
+              IfDataFamTyCon    -> ptext (sLit "data family")
+              IfDataTyCon _     -> ptext (sLit "data")
+              IfNewTyCon _      -> ptext (sLit "newtype")
+
+    pp_extra = vcat [pprCType ctype, pprRec isrec, pp_prom]
+
+    pp_prom | is_prom   = ptext (sLit "Promotable")
+            | otherwise = empty
+
+
+pprIfaceDecl ss (IfaceClass { ifATs = ats, ifSigs = sigs, ifRec = isrec
+                            , ifCtxt   = context, ifName  = clas
+                            , ifTyVars = tyvars,  ifRoles = roles
+                            , ifFDs    = fds })
+  = vcat [ pprRoles (== Nominal) (pprPrefixIfDeclBndr ss clas) tyvars roles
+         , ptext (sLit "class") <+> pprIfaceDeclHead context ss clas tyvars
+                                <+> pprFundeps fds <+> pp_where
+         , nest 2 (vcat [vcat asocs, vcat dsigs, pprec])]
+    where
+      pp_where = ppShowRhs ss $ ppUnless (null sigs && null ats) (ptext (sLit "where"))
+
+      asocs = ppr_trim $ map maybeShowAssoc ats
+      dsigs = ppr_trim $ map maybeShowSig sigs
+      pprec = ppShowIface ss (pprRec isrec)
+
+      maybeShowAssoc :: IfaceAT -> Maybe SDoc
+      maybeShowAssoc asc@(IfaceAT d _)
+        | showSub ss d = Just $ pprIfaceAT ss asc
+        | otherwise    = Nothing
+
+      maybeShowSig :: IfaceClassOp -> Maybe SDoc
+      maybeShowSig sg
+        | showSub ss sg = Just $  pprIfaceClassOp ss sg
+        | otherwise     = Nothing
+
+pprIfaceDecl ss (IfaceSyn { ifName   = tc
+                          , ifTyVars = tv
+                          , ifSynRhs = IfaceSynonymTyCon mono_ty })
+  = hang (ptext (sLit "type") <+> pprIfaceDeclHead [] ss tc tv <+> equals)
+       2 (sep [pprIfaceForAll tvs, pprIfaceContextArr theta, ppr tau])
+  where
+    (tvs, theta, tau) = splitIfaceSigmaTy mono_ty
+
+pprIfaceDecl ss (IfaceSyn { ifName = tycon, ifTyVars = tyvars
+                          , ifSynRhs = rhs, ifSynKind = kind })
+  = vcat [ hang (text "type family" <+> pprIfaceDeclHead [] ss tycon tyvars <+> dcolon)
+              2 (ppr kind <+> ppShowRhs ss (pp_rhs rhs))
+         , ppShowRhs ss (nest 2 (pp_branches rhs)) ]
   where
-    header = ppr name <+> dcolon <+>
-             (pprIfaceForAllPart univ_tvs req_ctxt $
-              pprIfaceForAllPart ex_tvs prov_ctxt $
-              pp_tau)
+    pp_rhs IfaceOpenSynFamilyTyCon             = ppShowIface ss (ptext (sLit "open"))
+    pp_rhs IfaceAbstractClosedSynFamilyTyCon   = ppShowIface ss (ptext (sLit "closed, abstract"))
+    pp_rhs (IfaceClosedSynFamilyTyCon _ (_:_)) = ptext (sLit "where")
+    pp_rhs IfaceBuiltInSynFamTyCon = ppShowIface ss (ptext (sLit "built-in"))
+    pp_rhs _ = panic "pprIfaceDecl syn"
 
-    details = sep [ if is_infix then text "Infix" else empty
-                  , if has_wrap then text "HasWrapper" else empty
-                  ]
+    pp_branches (IfaceClosedSynFamilyTyCon ax brs)
+      = vcat (map (pprAxBranch (pprPrefixIfDeclBndr ss tycon)) brs)
+        $$ ppShowIface ss (ptext (sLit "axiom") <+> ppr ax)
+    pp_branches _ = empty
+
+pprIfaceDecl _ (IfacePatSyn { ifName = name, ifPatWrapper = wrapper,
+                              ifPatIsInfix = is_infix,
+                              ifPatUnivTvs = _univ_tvs, ifPatExTvs = _ex_tvs,
+                              ifPatProvCtxt = prov_ctxt, ifPatReqCtxt = req_ctxt,
+                              ifPatArgs = args,
+                              ifPatTy = ty })
+  = pprPatSynSig name has_wrap args' ty' (pprCtxt prov_ctxt) (pprCtxt req_ctxt)
+  where
+    has_wrap = isJust wrapper
+    args' = case (is_infix, args) of
+        (True, [left_ty, right_ty]) ->
+            InfixPatSyn (pprParendIfaceType left_ty) (pprParendIfaceType right_ty)
+        (_, tys) ->
+            PrefixPatSyn (map pprParendIfaceType tys)
+
+    ty' = pprParendIfaceType ty
+
+    pprCtxt [] = Nothing
+    pprCtxt ctxt = Just $ pprIfaceContext ctxt
+
+pprIfaceDecl ss (IfaceId { ifName = var, ifType = ty,
+                              ifIdDetails = details, ifIdInfo = info })
+  = vcat [ hang (pprPrefixIfDeclBndr ss var <+> dcolon)
+              2 (pprIfaceSigmaType ty)
+         , ppShowIface ss (ppr details)
+         , ppShowIface ss (ppr info) ]
+
+pprIfaceDecl _ (IfaceForeign {ifName = tycon})
+  = hsep [ptext (sLit "foreign import type dotnet"), ppr tycon]
 
-    pp_tau = case map pprParendIfaceType (arg_tys ++ [ty]) of
-        (t:ts) -> fsep (t : map (arrow <+>) ts)
-        []     -> panic "pp_tau"
+pprIfaceDecl _ (IfaceAxiom { ifName = name, ifTyCon = tycon
+                           , ifAxBranches = branches })
+  = hang (ptext (sLit "axiom") <+> ppr name <> dcolon)
+       2 (vcat $ map (pprAxBranch (ppr tycon)) branches)
 
-    arg_tys = map snd args
 
 pprCType :: Maybe CType -> SDoc
-pprCType Nothing = ptext (sLit "No C type associated")
+pprCType Nothing      = empty
 pprCType (Just cType) = ptext (sLit "C type:") <+> ppr cType
 
-pprRoles :: [Role] -> SDoc
-pprRoles []    = empty
-pprRoles roles = text "Roles:" <+> ppr roles
+-- if, for each role, suppress_if role is True, then suppress the role
+-- output
+pprRoles :: (Role -> Bool) -> SDoc -> [IfaceTvBndr] -> [Role] -> SDoc
+pprRoles suppress_if tyCon tyvars roles
+  = sdocWithDynFlags $ \dflags ->
+      let froles = suppressIfaceKinds dflags tyvars roles
+      in ppUnless (all suppress_if roles || null froles) $
+         ptext (sLit "type role") <+> tyCon <+> hsep (map ppr froles)
 
 pprRec :: RecFlag -> SDoc
-pprRec isrec = ptext (sLit "RecFlag") <+> ppr isrec
+pprRec NonRecursive = empty
+pprRec Recursive    = ptext (sLit "RecFlag: Recursive")
 
-pprAxiom :: Maybe Name -> SDoc
-pprAxiom Nothing   = ptext (sLit "FamilyInstance: none")
-pprAxiom (Just ax) = ptext (sLit "FamilyInstance:") <+> ppr ax
+pprInfixIfDeclBndr, pprPrefixIfDeclBndr :: ShowSub -> OccName -> SDoc
+pprInfixIfDeclBndr (ShowSub { ss_ppr_bndr = ppr_bndr }) occ 
+  = pprInfixVar (isSymOcc occ) (ppr_bndr occ)
+pprPrefixIfDeclBndr (ShowSub { ss_ppr_bndr = ppr_bndr }) occ
+  = parenSymOcc occ (ppr_bndr occ)
 
 instance Outputable IfaceClassOp where
-   ppr (IfaceClassOp n dm ty) = ppr n <+> ppr dm <+> dcolon <+> ppr ty
+   ppr = pprIfaceClassOp showAll
+
+pprIfaceClassOp :: ShowSub -> IfaceClassOp -> SDoc
+pprIfaceClassOp ss (IfaceClassOp n dm ty) = hang opHdr 2 (pprIfaceSigmaType ty)
+  where opHdr = pprPrefixIfDeclBndr ss n
+                <+> ppShowIface ss (ppr dm) <+> dcolon
 
 instance Outputable IfaceAT where
-   ppr (IfaceAT d defs) 
-      = vcat [ ppr d
-             , ppUnless (null defs) $ nest 2 $
-               ptext (sLit "Defaults:") <+> vcat (map ppr defs) ]
-
-pprIfaceDeclHead :: IfaceContext -> OccName -> [IfaceTvBndr] -> SDoc
-pprIfaceDeclHead context thing tyvars
-  = hsep [pprIfaceContext context, parenSymOcc thing (ppr thing),
-          pprIfaceTvBndrs tyvars]
-
-pp_condecls :: OccName -> IfaceConDecls -> SDoc
-pp_condecls _  (IfAbstractTyCon {}) = empty
-pp_condecls _  IfDataFamTyCon      = empty
-pp_condecls tc (IfNewTyCon c)   = equals <+> pprIfaceConDecl tc c
-pp_condecls tc (IfDataTyCon cs) = equals <+> sep (punctuate (ptext (sLit " |"))
-                                                            (map (pprIfaceConDecl tc) cs))
-
-mkIfaceEqPred :: IfaceType -> IfaceType -> IfacePredType
--- IA0_NOTE: This is wrong, but only used for pretty-printing.
-mkIfaceEqPred ty1 ty2 = IfaceTyConApp (IfaceTc eqTyConName) [ty1, ty2]
-
-pprIfaceConDecl :: OccName -> IfaceConDecl -> SDoc
-pprIfaceConDecl tc
-        (IfCon { ifConOcc = name, ifConInfix = is_infix, ifConWrapper = has_wrap,
-                 ifConUnivTvs = univ_tvs, ifConExTvs = ex_tvs,
+   ppr = pprIfaceAT showAll
+
+pprIfaceAT :: ShowSub -> IfaceAT -> SDoc
+pprIfaceAT ss (IfaceAT d mb_def)
+  = vcat [ pprIfaceDecl ss d
+         , case mb_def of
+              Nothing  -> empty
+              Just rhs -> nest 2 $
+                          ptext (sLit "Default:") <+> ppr rhs ]
+
+instance Outputable IfaceTyConParent where
+  ppr p = pprIfaceTyConParent p
+
+pprIfaceTyConParent :: IfaceTyConParent -> SDoc
+pprIfaceTyConParent IfNoParent
+  = empty
+pprIfaceTyConParent (IfDataInstance _ tc tys)
+  = sdocWithDynFlags $ \dflags ->
+    let ftys = stripKindArgs dflags tys
+    in pprIfaceTypeApp tc ftys
+
+pprIfaceDeclHead :: IfaceContext -> ShowSub -> OccName -> [IfaceTvBndr] -> SDoc
+pprIfaceDeclHead context ss tc_occ tv_bndrs
+  = sdocWithDynFlags $ \ dflags ->
+    sep [ pprIfaceContextArr context
+        , pprPrefixIfDeclBndr ss tc_occ
+          <+> pprIfaceTvBndrs (stripIfaceKindVars dflags tv_bndrs) ]
+
+isVanillaIfaceConDecl :: IfaceConDecl -> Bool
+isVanillaIfaceConDecl (IfCon { ifConExTvs  = ex_tvs
+                             , ifConEqSpec = eq_spec
+                             , ifConCtxt   = ctxt })
+  = (null ex_tvs) && (null eq_spec) && (null ctxt)
+
+pprIfaceConDecl :: ShowSub -> Bool
+                -> (IfaceEqSpec -> ([IfaceTvBndr], SDoc))
+                -> IfaceConDecl -> SDoc
+pprIfaceConDecl ss gadt_style mk_user_con_res_ty
+        (IfCon { ifConOcc = name, ifConInfix = is_infix,
+                 ifConExTvs = ex_tvs,
                  ifConEqSpec = eq_spec, ifConCtxt = ctxt, ifConArgTys = arg_tys,
-                 ifConStricts = strs, ifConFields = fields })
-  = sep [main_payload,
-         if is_infix then ptext (sLit "Infix") else empty,
-         if has_wrap then ptext (sLit "HasWrapper") else empty,
-         ppUnless (null strs) $
-            nest 2 (ptext (sLit "Stricts:") <+> hsep (map ppr_bang strs)),
-         ppUnless (null fields) $
-            nest 2 (ptext (sLit "Fields:") <+> hsep (map ppr fields))]
+                 ifConStricts = stricts, ifConFields = labels })
+  | gadt_style = pp_prefix_con <+> dcolon <+> ppr_ty
+  | otherwise  = ppr_fields tys_w_strs
   where
-    ppr_bang IfNoBang = char '_'        -- Want to see these
-    ppr_bang IfStrict = char '!'
-    ppr_bang IfUnpack = ptext (sLit "!!")
-    ppr_bang (IfUnpackCo co) = ptext (sLit "!!") <> pprParendIfaceCoercion co
-
-    main_payload = ppr name <+> dcolon <+>
-                   pprIfaceForAllPart (univ_tvs ++ ex_tvs) (eq_ctxt ++ ctxt) pp_tau
+    tys_w_strs :: [(IfaceBang, IfaceType)]
+    tys_w_strs = zip stricts arg_tys
+    pp_prefix_con = pprPrefixIfDeclBndr ss name
 
-    eq_ctxt = [(mkIfaceEqPred (IfaceTyVar (occNameFS tv)) ty)
-              | (tv,ty) <- eq_spec]
+    (univ_tvs, pp_res_ty) = mk_user_con_res_ty eq_spec
+    ppr_ty = pprIfaceForAllPart (univ_tvs ++ ex_tvs) ctxt pp_tau
 
         -- A bit gruesome this, but we can't form the full con_tau, and ppr it,
         -- because we don't have a Name for the tycon, only an OccName
@@ -1197,7 +898,26 @@ pprIfaceConDecl tc
                 (t:ts) -> fsep (t : map (arrow <+>) ts)
                 []     -> panic "pp_con_taus"
 
-    pp_res_ty = ppr tc <+> fsep [ppr tv | (tv,_) <- univ_tvs]
+    ppr_bang IfNoBang = ppWhen opt_PprStyle_Debug $ char '_'
+    ppr_bang IfStrict = char '!'
+    ppr_bang IfUnpack = ptext (sLit "{-# UNPACK #-}")
+    ppr_bang (IfUnpackCo co) = ptext (sLit "! {-# UNPACK #-}") <>
+                               pprParendIfaceCoercion co
+
+    pprParendBangTy (bang, ty) = ppr_bang bang <> pprParendIfaceType ty
+    pprBangTy       (bang, ty) = ppr_bang bang <> ppr ty
+
+    maybe_show_label (lbl,bty)
+      | showSub ss lbl = Just (pprPrefixIfDeclBndr ss lbl <+> dcolon <+> pprBangTy bty)
+      | otherwise      = Nothing
+
+    ppr_fields [ty1, ty2]
+      | is_infix && null labels
+      = sep [pprParendBangTy ty1, pprInfixIfDeclBndr ss name, pprParendBangTy ty2]
+    ppr_fields fields
+      | null labels = pp_prefix_con <+> sep (map pprParendBangTy fields)
+      | otherwise   = pp_prefix_con <+> (braces $ sep $ punctuate comma $ ppr_trim $
+                                    map maybe_show_label (zip labels fields))
 
 instance Outputable IfaceRule where
   ppr (IfaceRule { ifRuleName = name, ifActivation = act, ifRuleBndrs = bndrs,
@@ -1209,15 +929,15 @@ instance Outputable IfaceRule where
       ]
 
 instance Outputable IfaceClsInst where
-  ppr (IfaceClsInst {ifDFun = dfun_id, ifOFlag = flag,
-                  ifInstCls = cls, ifInstTys = mb_tcs})
+  ppr (IfaceClsInst { ifDFun = dfun_id, ifOFlag = flag
+                    , ifInstCls = cls, ifInstTys = mb_tcs})
     = hang (ptext (sLit "instance") <+> ppr flag
                 <+> ppr cls <+> brackets (pprWithCommas ppr_rough mb_tcs))
          2 (equals <+> ppr dfun_id)
 
 instance Outputable IfaceFamInst where
-  ppr (IfaceFamInst {ifFamInstFam = fam, ifFamInstTys = mb_tcs,
-                     ifFamInstAxiom = tycon_ax})
+  ppr (IfaceFamInst { ifFamInstFam = fam, ifFamInstTys = mb_tcs
+                    , ifFamInstAxiom = tycon_ax})
     = hang (ptext (sLit "family instance") <+>
             ppr fam <+> pprWithCommas (brackets . ppr_rough) mb_tcs)
          2 (equals <+> ppr tycon_ax)
@@ -1227,6 +947,26 @@ ppr_rough Nothing   = dot
 ppr_rough (Just tc) = ppr tc
 \end{code}
 
+Note [Result type of a data family GADT]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Consider 
+   data family T a
+   data instance T (p,q) where
+      T1 :: T (Int, Maybe c)
+      T2 :: T (Bool, q)
+
+The IfaceDecl actually looks like 
+
+   data TPr p q where
+      T1 :: forall p q. forall c. (p~Int,q~Maybe c) => TPr p q
+      T2 :: forall p q. (p~Bool) => TPr p q
+
+To reconstruct the result types for T1 and T2 that we
+want to pretty print, we substitute the eq-spec 
+[p->Int, q->Maybe c] in the arg pattern (p,q) to give
+   T (Int, Maybe c)
+Remember that in IfaceSyn, the TyCon and DataCon share the same
+universal type variables.
 
 ----------------------------- Printing IfaceExpr ------------------------------------
 
@@ -1234,6 +974,9 @@ ppr_rough (Just tc) = ppr tc
 instance Outputable IfaceExpr where
     ppr e = pprIfaceExpr noParens e
 
+noParens :: SDoc -> SDoc
+noParens pp = pp
+
 pprParendIfaceExpr :: IfaceExpr -> SDoc
 pprParendIfaceExpr = pprIfaceExpr parens
 
@@ -1316,6 +1059,8 @@ pprIfaceTickish (IfaceHpcTick m ix)
   = braces (text "tick" <+> ppr m <+> ppr ix)
 pprIfaceTickish (IfaceSCC cc tick scope)
   = braces (pprCostCentreCore cc <+> ppr tick <+> ppr scope)
+pprIfaceTickish (IfaceSource src _names)
+  = braces (text $ showUserRealSpan True src)
 
 ------------------
 pprIfaceApp :: IfaceExpr -> [SDoc] -> SDoc
@@ -1359,17 +1104,22 @@ instance Outputable IfaceUnfolding where
                                         pprParendIfaceExpr e]
   ppr (IfDFunUnfold bs es) = hang (ptext (sLit "DFun:") <+> sep (map ppr bs) <> dot)
                                 2 (sep (map pprParendIfaceExpr es))
+\end{code}
 
--- -----------------------------------------------------------------------------
--- | Finding the Names in IfaceSyn
+%************************************************************************
+%*                                                                      *
+              Finding the Names in IfaceSyn
+%*                                                                      *
+%************************************************************************
 
--- This is used for dependency analysis in MkIface, so that we
--- fingerprint a declaration before the things that depend on it.  It
--- is specific to interface-file fingerprinting in the sense that we
--- don't collect *all* Names: for example, the DFun of an instance is
--- recorded textually rather than by its fingerprint when
--- fingerprinting the instance, so DFuns are not dependencies.
+This is used for dependency analysis in MkIface, so that we
+fingerprint a declaration before the things that depend on it.  It
+is specific to interface-file fingerprinting in the sense that we
+don't collect *all* Names: for example, the DFun of an instance is
+recorded textually rather than by its fingerprint when
+fingerprinting the instance, so DFuns are not dependencies.
 
+\begin{code}
 freeNamesIfDecl :: IfaceDecl -> NameSet
 freeNamesIfDecl (IfaceId _s t d i) =
   freeNamesIfType t &&&
@@ -1379,7 +1129,7 @@ freeNamesIfDecl IfaceForeign{} =
   emptyNameSet
 freeNamesIfDecl d@IfaceData{} =
   freeNamesIfTvBndrs (ifTyVars d) &&&
-  maybe emptyNameSet unitNameSet (ifAxiom d) &&&
+  freeNamesIfaceTyConParent (ifParent d) &&&
   freeNamesIfContext (ifCtxt d) &&&
   freeNamesIfConDecls (ifCons d)
 freeNamesIfDecl d@IfaceSyn{} =
@@ -1396,11 +1146,13 @@ freeNamesIfDecl d@IfaceAxiom{} =
   freeNamesIfTc (ifTyCon d) &&&
   fnList freeNamesIfAxBranch (ifAxBranches d)
 freeNamesIfDecl d@IfacePatSyn{} =
+  unitNameSet (ifPatMatcher d) &&&
+  maybe emptyNameSet unitNameSet (ifPatWrapper d) &&&
   freeNamesIfTvBndrs (ifPatUnivTvs d) &&&
   freeNamesIfTvBndrs (ifPatExTvs d) &&&
   freeNamesIfContext (ifPatProvCtxt d) &&&
   freeNamesIfContext (ifPatReqCtxt d) &&&
-  fnList freeNamesIfType (map snd (ifPatArgs d)) &&&
+  fnList freeNamesIfType (ifPatArgs d) &&&
   freeNamesIfType (ifPatTy d)
 
 freeNamesIfAxBranch :: IfaceAxBranch -> NameSet
@@ -1408,7 +1160,7 @@ freeNamesIfAxBranch (IfaceAxBranch { ifaxbTyVars = tyvars
                                    , ifaxbLHS    = lhs
                                    , ifaxbRHS    = rhs }) =
   freeNamesIfTvBndrs tyvars &&&
-  fnList freeNamesIfType lhs &&&
+  freeNamesIfTcArgs lhs &&&
   freeNamesIfType rhs
 
 freeNamesIfIdDetails :: IfaceIdDetails -> NameSet
@@ -1419,16 +1171,20 @@ freeNamesIfIdDetails _                 = emptyNameSet
 freeNamesIfSynRhs :: IfaceSynTyConRhs -> NameSet
 freeNamesIfSynRhs (IfaceSynonymTyCon ty)            = freeNamesIfType ty
 freeNamesIfSynRhs IfaceOpenSynFamilyTyCon           = emptyNameSet
-freeNamesIfSynRhs (IfaceClosedSynFamilyTyCon ax)    = unitNameSet ax
+freeNamesIfSynRhs (IfaceClosedSynFamilyTyCon ax br)
+  = unitNameSet ax &&& fnList freeNamesIfAxBranch br
 freeNamesIfSynRhs IfaceAbstractClosedSynFamilyTyCon = emptyNameSet
+freeNamesIfSynRhs IfaceBuiltInSynFamTyCon = emptyNameSet
 
 freeNamesIfContext :: IfaceContext -> NameSet
 freeNamesIfContext = fnList freeNamesIfType
 
 freeNamesIfAT :: IfaceAT -> NameSet
-freeNamesIfAT (IfaceAT decl defs)
+freeNamesIfAT (IfaceAT decl mb_def)
   = freeNamesIfDecl decl &&&
-    fnList freeNamesIfAxBranch defs
+    case mb_def of
+      Nothing  -> emptyNameSet
+      Just rhs -> freeNamesIfType rhs
 
 freeNamesIfClsSig :: IfaceClassOp -> NameSet
 freeNamesIfClsSig (IfaceClassOp _n _dm ty) = freeNamesIfType ty
@@ -1439,25 +1195,30 @@ freeNamesIfConDecls (IfNewTyCon c)  = freeNamesIfConDecl c
 freeNamesIfConDecls _               = emptyNameSet
 
 freeNamesIfConDecl :: IfaceConDecl -> NameSet
-freeNamesIfConDecl c =
-  freeNamesIfTvBndrs (ifConUnivTvs c) &&&
-  freeNamesIfTvBndrs (ifConExTvs c) &&&
-  freeNamesIfContext (ifConCtxt c) &&&
-  fnList freeNamesIfType (ifConArgTys c) &&&
-  fnList freeNamesIfType (map snd (ifConEqSpec c)) -- equality constraints
+freeNamesIfConDecl c
+  = freeNamesIfTvBndrs (ifConExTvs c) &&&
+    freeNamesIfContext (ifConCtxt c) &&&
+    fnList freeNamesIfType (ifConArgTys c) &&&
+    fnList freeNamesIfType (map snd (ifConEqSpec c)) -- equality constraints
 
 freeNamesIfKind :: IfaceType -> NameSet
 freeNamesIfKind = freeNamesIfType
 
+freeNamesIfTcArgs :: IfaceTcArgs -> NameSet
+freeNamesIfTcArgs (ITC_Type t ts) = freeNamesIfType t &&& freeNamesIfTcArgs ts
+freeNamesIfTcArgs (ITC_Kind k ks) = freeNamesIfKind k &&& freeNamesIfTcArgs ks
+freeNamesIfTcArgs ITC_Nil         = emptyNameSet
+
 freeNamesIfType :: IfaceType -> NameSet
 freeNamesIfType (IfaceTyVar _)        = emptyNameSet
 freeNamesIfType (IfaceAppTy s t)      = freeNamesIfType s &&& freeNamesIfType t
 freeNamesIfType (IfaceTyConApp tc ts) =
-   freeNamesIfTc tc &&& fnList freeNamesIfType ts
+   freeNamesIfTc tc &&& freeNamesIfTcArgs ts
 freeNamesIfType (IfaceLitTy _)        = emptyNameSet
 freeNamesIfType (IfaceForAllTy tv t)  =
    freeNamesIfTvBndr tv &&& freeNamesIfType t
 freeNamesIfType (IfaceFunTy s t)      = freeNamesIfType s &&& freeNamesIfType t
+freeNamesIfType (IfaceDFunTy s t)     = freeNamesIfType s &&& freeNamesIfType t
 
 freeNamesIfCoercion :: IfaceCoercion -> NameSet
 freeNamesIfCoercion (IfaceReflCo _ t) = freeNamesIfType t
@@ -1539,8 +1300,7 @@ freeNamesIfExpr (IfaceCast e co)  = freeNamesIfExpr e &&& freeNamesIfCoercion co
 freeNamesIfExpr (IfaceTick _ e)   = freeNamesIfExpr e
 freeNamesIfExpr (IfaceECase e ty) = freeNamesIfExpr e &&& freeNamesIfType ty
 freeNamesIfExpr (IfaceCase s _ alts)
-  = freeNamesIfExpr s 
-    &&& fnList fn_alt alts &&& fn_cons alts
+  = freeNamesIfExpr s &&& fnList fn_alt alts &&& fn_cons alts
   where
     fn_alt (_con,_bs,r) = freeNamesIfExpr r
 
@@ -1562,7 +1322,7 @@ freeNamesIfExpr (IfaceLet (IfaceRec as) x)
 freeNamesIfExpr _ = emptyNameSet
 
 freeNamesIfTc :: IfaceTyCon -> NameSet
-freeNamesIfTc (IfaceTc tc) = unitNameSet tc
+freeNamesIfTc tc = unitNameSet (ifaceTyConName tc)
 -- ToDo: shouldn't we include IfaceIntTc & co.?
 
 freeNamesIfRule :: IfaceRule -> NameSet
@@ -1572,13 +1332,18 @@ freeNamesIfRule (IfaceRule { ifRuleBndrs = bs, ifRuleHead = f
     fnList freeNamesIfBndr bs &&&
     fnList freeNamesIfExpr es &&&
     freeNamesIfExpr rhs
-    
+
 freeNamesIfFamInst :: IfaceFamInst -> NameSet
 freeNamesIfFamInst (IfaceFamInst { ifFamInstFam = famName
                                  , ifFamInstAxiom = axName })
   = unitNameSet famName &&&
     unitNameSet axName
 
+freeNamesIfaceTyConParent :: IfaceTyConParent -> NameSet
+freeNamesIfaceTyConParent IfNoParent = emptyNameSet
+freeNamesIfaceTyConParent (IfDataInstance ax tc tys)
+  = unitNameSet ax &&& freeNamesIfTc tc &&& freeNamesIfTcArgs tys
+
 -- helpers
 (&&&) :: NameSet -> NameSet -> NameSet
 (&&&) = unionNameSets
@@ -1612,3 +1377,555 @@ Now, lookupModule depends on DynFlags, but the transitive dependency
 on the *locally-defined* type PackageState is not visible. We need
 to take account of the use of the data constructor PS in the pattern match.
 
+
+%************************************************************************
+%*                                                                      *
+                Binary instances
+%*                                                                      *
+%************************************************************************
+
+\begin{code}
+instance Binary IfaceDecl where
+    put_ bh (IfaceId name ty details idinfo) = do
+        putByte bh 0
+        put_ bh (occNameFS name)
+        put_ bh ty
+        put_ bh details
+        put_ bh idinfo
+
+    put_ _ (IfaceForeign _ _) = 
+        error "Binary.put_(IfaceDecl): IfaceForeign"
+
+    put_ bh (IfaceData a1 a2 a3 a4 a5 a6 a7 a8 a9 a10) = do
+        putByte bh 2
+        put_ bh (occNameFS a1)
+        put_ bh a2
+        put_ bh a3
+        put_ bh a4
+        put_ bh a5
+        put_ bh a6
+        put_ bh a7
+        put_ bh a8
+        put_ bh a9
+        put_ bh a10
+
+    put_ bh (IfaceSyn a1 a2 a3 a4 a5) = do
+        putByte bh 3
+        put_ bh (occNameFS a1)
+        put_ bh a2
+        put_ bh a3
+        put_ bh a4
+        put_ bh a5
+
+    put_ bh (IfaceClass a1 a2 a3 a4 a5 a6 a7 a8 a9) = do
+        putByte bh 4
+        put_ bh a1
+        put_ bh (occNameFS a2)
+        put_ bh a3
+        put_ bh a4
+        put_ bh a5
+        put_ bh a6
+        put_ bh a7
+        put_ bh a8
+        put_ bh a9
+
+    put_ bh (IfaceAxiom a1 a2 a3 a4) = do
+        putByte bh 5
+        put_ bh (occNameFS a1)
+        put_ bh a2
+        put_ bh a3
+        put_ bh a4
+
+    put_ bh (IfacePatSyn name a2 a3 a4 a5 a6 a7 a8 a9 a10) = do
+        putByte bh 6
+        put_ bh (occNameFS name)
+        put_ bh a2
+        put_ bh a3
+        put_ bh a4
+        put_ bh a5
+        put_ bh a6
+        put_ bh a7
+        put_ bh a8
+        put_ bh a9
+        put_ bh a10
+
+    get bh = do
+        h <- getByte bh
+        case h of
+            0 -> do name    <- get bh
+                    ty      <- get bh
+                    details <- get bh
+                    idinfo  <- get bh
+                    occ <- return $! mkVarOccFS name
+                    return (IfaceId occ ty details idinfo)
+            1 -> error "Binary.get(TyClDecl): ForeignType"
+            2 -> do a1  <- get bh
+                    a2  <- get bh
+                    a3  <- get bh
+                    a4  <- get bh
+                    a5  <- get bh
+                    a6  <- get bh
+                    a7  <- get bh
+                    a8  <- get bh
+                    a9  <- get bh
+                    a10 <- get bh
+                    occ <- return $! mkTcOccFS a1
+                    return (IfaceData occ a2 a3 a4 a5 a6 a7 a8 a9 a10)
+            3 -> do a1 <- get bh
+                    a2 <- get bh
+                    a3 <- get bh
+                    a4 <- get bh
+                    a5 <- get bh
+                    occ <- return $! mkTcOccFS a1
+                    return (IfaceSyn occ a2 a3 a4 a5)
+            4 -> do a1 <- get bh
+                    a2 <- get bh
+                    a3 <- get bh
+                    a4 <- get bh
+                    a5 <- get bh
+                    a6 <- get bh
+                    a7 <- get bh
+                    a8 <- get bh
+                    a9 <- get bh
+                    occ <- return $! mkClsOccFS a2
+                    return (IfaceClass a1 occ a3 a4 a5 a6 a7 a8 a9)
+            5 -> do a1 <- get bh
+                    a2 <- get bh
+                    a3 <- get bh
+                    a4 <- get bh
+                    occ <- return $! mkTcOccFS a1
+                    return (IfaceAxiom occ a2 a3 a4)
+            6 -> do a1 <- get bh
+                    a2 <- get bh
+                    a3 <- get bh
+                    a4 <- get bh
+                    a5 <- get bh
+                    a6 <- get bh
+                    a7 <- get bh
+                    a8 <- get bh
+                    a9 <- get bh
+                    a10 <- get bh
+                    occ <- return $! mkDataOccFS a1
+                    return (IfacePatSyn occ a2 a3 a4 a5 a6 a7 a8 a9 a10)
+            _ -> panic (unwords ["Unknown IfaceDecl tag:", show h])
+
+instance Binary IfaceSynTyConRhs where
+    put_ bh IfaceOpenSynFamilyTyCon           = putByte bh 0
+    put_ bh (IfaceClosedSynFamilyTyCon ax br) = putByte bh 1 >> put_ bh ax
+                                                             >> put_ bh br
+    put_ bh IfaceAbstractClosedSynFamilyTyCon = putByte bh 2
+    put_ bh (IfaceSynonymTyCon ty)            = putByte bh 3 >> put_ bh ty
+    put_ _ IfaceBuiltInSynFamTyCon
+        = pprPanic "Cannot serialize IfaceBuiltInSynFamTyCon, used for pretty-printing only" empty
+
+    get bh = do { h <- getByte bh
+                ; case h of
+                    0 -> return IfaceOpenSynFamilyTyCon
+                    1 -> do { ax <- get bh
+                            ; br <- get bh
+                            ; return (IfaceClosedSynFamilyTyCon ax br) }
+                    2 -> return IfaceAbstractClosedSynFamilyTyCon
+                    _ -> do { ty <- get bh
+                            ; return (IfaceSynonymTyCon ty) } }
+
+instance Binary IfaceClassOp where
+    put_ bh (IfaceClassOp n def ty) = do 
+        put_ bh (occNameFS n)
+        put_ bh def     
+        put_ bh ty
+    get bh = do
+        n   <- get bh
+        def <- get bh
+        ty  <- get bh
+        occ <- return $! mkVarOccFS n
+        return (IfaceClassOp occ def ty)
+
+instance Binary IfaceAT where
+    put_ bh (IfaceAT dec defs) = do
+        put_ bh dec
+        put_ bh defs
+    get bh = do
+        dec  <- get bh
+        defs <- get bh
+        return (IfaceAT dec defs)
+
+instance Binary IfaceAxBranch where
+    put_ bh (IfaceAxBranch a1 a2 a3 a4 a5) = do
+        put_ bh a1
+        put_ bh a2
+        put_ bh a3
+        put_ bh a4
+        put_ bh a5
+    get bh = do
+        a1 <- get bh
+        a2 <- get bh
+        a3 <- get bh
+        a4 <- get bh
+        a5 <- get bh
+        return (IfaceAxBranch a1 a2 a3 a4 a5)
+
+instance Binary IfaceConDecls where
+    put_ bh (IfAbstractTyCon d) = putByte bh 0 >> put_ bh d
+    put_ bh IfDataFamTyCon     = putByte bh 1
+    put_ bh (IfDataTyCon cs)    = putByte bh 2 >> put_ bh cs
+    put_ bh (IfNewTyCon c)      = putByte bh 3 >> put_ bh c
+    get bh = do
+        h <- getByte bh
+        case h of
+            0 -> liftM IfAbstractTyCon $ get bh
+            1 -> return IfDataFamTyCon
+            2 -> liftM IfDataTyCon $ get bh
+            _ -> liftM IfNewTyCon $ get bh
+
+instance Binary IfaceConDecl where
+    put_ bh (IfCon a1 a2 a3 a4 a5 a6 a7 a8 a9) = do
+        put_ bh a1
+        put_ bh a2
+        put_ bh a3
+        put_ bh a4
+        put_ bh a5
+        put_ bh a6
+        put_ bh a7
+        put_ bh a8
+        put_ bh a9
+    get bh = do
+        a1 <- get bh
+        a2 <- get bh
+        a3 <- get bh
+        a4 <- get bh
+        a5 <- get bh
+        a6 <- get bh
+        a7 <- get bh
+        a8 <- get bh
+        a9 <- get bh
+        return (IfCon a1 a2 a3 a4 a5 a6 a7 a8 a9)
+
+instance Binary IfaceBang where
+    put_ bh IfNoBang        = putByte bh 0
+    put_ bh IfStrict        = putByte bh 1
+    put_ bh IfUnpack        = putByte bh 2
+    put_ bh (IfUnpackCo co) = putByte bh 3 >> put_ bh co
+
+    get bh = do
+            h <- getByte bh
+            case h of
+              0 -> do return IfNoBang
+              1 -> do return IfStrict
+              2 -> do return IfUnpack
+              _ -> do { a <- get bh; return (IfUnpackCo a) }
+
+instance Binary IfaceClsInst where
+    put_ bh (IfaceClsInst cls tys dfun flag orph) = do
+        put_ bh cls
+        put_ bh tys
+        put_ bh dfun
+        put_ bh flag
+        put_ bh orph
+    get bh = do
+        cls  <- get bh
+        tys  <- get bh
+        dfun <- get bh
+        flag <- get bh
+        orph <- get bh
+        return (IfaceClsInst cls tys dfun flag orph)
+
+instance Binary IfaceFamInst where
+    put_ bh (IfaceFamInst fam tys name orph) = do
+        put_ bh fam
+        put_ bh tys
+        put_ bh name
+        put_ bh orph
+    get bh = do
+        fam      <- get bh
+        tys      <- get bh
+        name     <- get bh
+        orph     <- get bh
+        return (IfaceFamInst fam tys name orph)
+
+instance Binary IfaceRule where
+    put_ bh (IfaceRule a1 a2 a3 a4 a5 a6 a7 a8) = do
+        put_ bh a1
+        put_ bh a2
+        put_ bh a3
+        put_ bh a4
+        put_ bh a5
+        put_ bh a6
+        put_ bh a7
+        put_ bh a8
+    get bh = do
+        a1 <- get bh
+        a2 <- get bh
+        a3 <- get bh
+        a4 <- get bh
+        a5 <- get bh
+        a6 <- get bh
+        a7 <- get bh
+        a8 <- get bh
+        return (IfaceRule a1 a2 a3 a4 a5 a6 a7 a8)
+
+instance Binary IfaceAnnotation where
+    put_ bh (IfaceAnnotation a1 a2) = do
+        put_ bh a1
+        put_ bh a2
+    get bh = do
+        a1 <- get bh
+        a2 <- get bh
+        return (IfaceAnnotation a1 a2)
+
+instance Binary IfaceIdDetails where
+    put_ bh IfVanillaId      = putByte bh 0
+    put_ bh (IfRecSelId a b) = putByte bh 1 >> put_ bh a >> put_ bh b
+    put_ bh (IfDFunId n)     = do { putByte bh 2; put_ bh n }
+    get bh = do
+        h <- getByte bh
+        case h of
+            0 -> return IfVanillaId
+            1 -> do { a <- get bh; b <- get bh; return (IfRecSelId a b) }
+            _ -> do { n <- get bh; return (IfDFunId n) }
+
+instance Binary IfaceIdInfo where
+    put_ bh NoInfo      = putByte bh 0
+    put_ bh (HasInfo i) = putByte bh 1 >> lazyPut bh i -- NB lazyPut
+
+    get bh = do
+        h <- getByte bh
+        case h of
+            0 -> return NoInfo
+            _ -> liftM HasInfo $ lazyGet bh    -- NB lazyGet
+
+instance Binary IfaceInfoItem where
+    put_ bh (HsArity aa)          = putByte bh 0 >> put_ bh aa
+    put_ bh (HsStrictness ab)     = putByte bh 1 >> put_ bh ab
+    put_ bh (HsUnfold lb ad)      = putByte bh 2 >> put_ bh lb >> put_ bh ad
+    put_ bh (HsInline ad)         = putByte bh 3 >> put_ bh ad
+    put_ bh HsNoCafRefs           = putByte bh 4
+    get bh = do
+        h <- getByte bh
+        case h of
+            0 -> liftM HsArity $ get bh
+            1 -> liftM HsStrictness $ get bh
+            2 -> do lb <- get bh
+                    ad <- get bh
+                    return (HsUnfold lb ad)
+            3 -> liftM HsInline $ get bh
+            _ -> return HsNoCafRefs
+
+instance Binary IfaceUnfolding where
+    put_ bh (IfCoreUnfold s e) = do
+        putByte bh 0
+        put_ bh s
+        put_ bh e
+    put_ bh (IfInlineRule a b c d) = do
+        putByte bh 1
+        put_ bh a
+        put_ bh b
+        put_ bh c
+        put_ bh d
+    put_ bh (IfDFunUnfold as bs) = do
+        putByte bh 2
+        put_ bh as
+        put_ bh bs
+    put_ bh (IfCompulsory e) = do
+        putByte bh 3
+        put_ bh e
+    get bh = do
+        h <- getByte bh
+        case h of
+            0 -> do s <- get bh
+                    e <- get bh
+                    return (IfCoreUnfold s e)
+            1 -> do a <- get bh
+                    b <- get bh
+                    c <- get bh
+                    d <- get bh
+                    return (IfInlineRule a b c d)
+            2 -> do as <- get bh
+                    bs <- get bh
+                    return (IfDFunUnfold as bs)
+            _ -> do e <- get bh
+                    return (IfCompulsory e)
+
+
+instance Binary IfaceExpr where
+    put_ bh (IfaceLcl aa) = do
+        putByte bh 0
+        put_ bh aa
+    put_ bh (IfaceType ab) = do
+        putByte bh 1
+        put_ bh ab
+    put_ bh (IfaceCo ab) = do
+        putByte bh 2
+        put_ bh ab
+    put_ bh (IfaceTuple ac ad) = do
+        putByte bh 3
+        put_ bh ac
+        put_ bh ad
+    put_ bh (IfaceLam ae af) = do
+        putByte bh 4
+        put_ bh ae
+        put_ bh af
+    put_ bh (IfaceApp ag ah) = do
+        putByte bh 5
+        put_ bh ag
+        put_ bh ah
+    put_ bh (IfaceCase ai aj ak) = do
+        putByte bh 6
+        put_ bh ai
+        put_ bh aj
+        put_ bh ak
+    put_ bh (IfaceLet al am) = do
+        putByte bh 7
+        put_ bh al
+        put_ bh am
+    put_ bh (IfaceTick an ao) = do
+        putByte bh 8
+        put_ bh an
+        put_ bh ao
+    put_ bh (IfaceLit ap) = do
+        putByte bh 9
+        put_ bh ap
+    put_ bh (IfaceFCall as at) = do
+        putByte bh 10
+        put_ bh as
+        put_ bh at
+    put_ bh (IfaceExt aa) = do
+        putByte bh 11
+        put_ bh aa
+    put_ bh (IfaceCast ie ico) = do
+        putByte bh 12
+        put_ bh ie
+        put_ bh ico
+    put_ bh (IfaceECase a b) = do
+        putByte bh 13
+        put_ bh a
+        put_ bh b
+    get bh = do
+        h <- getByte bh
+        case h of
+            0 -> do aa <- get bh
+                    return (IfaceLcl aa)
+            1 -> do ab <- get bh
+                    return (IfaceType ab)
+            2 -> do ab <- get bh
+                    return (IfaceCo ab)
+            3 -> do ac <- get bh
+                    ad <- get bh
+                    return (IfaceTuple ac ad)
+            4 -> do ae <- get bh
+                    af <- get bh
+                    return (IfaceLam ae af)
+            5 -> do ag <- get bh
+                    ah <- get bh
+                    return (IfaceApp ag ah)
+            6 -> do ai <- get bh
+                    aj <- get bh
+                    ak <- get bh
+                    return (IfaceCase ai aj ak)
+            7 -> do al <- get bh
+                    am <- get bh
+                    return (IfaceLet al am)
+            8 -> do an <- get bh
+                    ao <- get bh
+                    return (IfaceTick an ao)
+            9 -> do ap <- get bh
+                    return (IfaceLit ap)
+            10 -> do as <- get bh
+                     at <- get bh
+                     return (IfaceFCall as at)
+            11 -> do aa <- get bh
+                     return (IfaceExt aa)
+            12 -> do ie <- get bh
+                     ico <- get bh
+                     return (IfaceCast ie ico)
+            13 -> do a <- get bh
+                     b <- get bh
+                     return (IfaceECase a b)
+            _ -> panic ("get IfaceExpr " ++ show h)
+
+instance Binary IfaceTickish where
+    put_ bh (IfaceHpcTick m ix) = do
+        putByte bh 0
+        put_ bh m
+        put_ bh ix
+    put_ bh (IfaceSCC cc tick push) = do
+        putByte bh 1
+        put_ bh cc
+        put_ bh tick
+        put_ bh push
+    put_ bh (IfaceSource src name) = do
+        putByte bh 2
+        put_ bh (srcSpanFile src)
+        put_ bh (srcSpanStartLine src)
+        put_ bh (srcSpanStartCol src)
+        put_ bh (srcSpanEndLine src)
+        put_ bh (srcSpanEndCol src)
+        put_ bh name
+
+    get bh = do
+        h <- getByte bh
+        case h of
+            0 -> do m <- get bh
+                    ix <- get bh
+                    return (IfaceHpcTick m ix)
+            1 -> do cc <- get bh
+                    tick <- get bh
+                    push <- get bh
+                    return (IfaceSCC cc tick push)
+            2 -> do file <- get bh
+                    sl <- get bh
+                    sc <- get bh
+                    el <- get bh
+                    ec <- get bh
+                    let start = mkRealSrcLoc file sl sc
+                        end = mkRealSrcLoc file el ec
+                    name <- get bh
+                    return (IfaceSource (mkRealSrcSpan start end) name)
+            _ -> panic ("get IfaceTickish " ++ show h)
+
+instance Binary IfaceConAlt where
+    put_ bh IfaceDefault      = putByte bh 0
+    put_ bh (IfaceDataAlt aa) = putByte bh 1 >> put_ bh aa
+    put_ bh (IfaceLitAlt ac)  = putByte bh 2 >> put_ bh ac
+    get bh = do
+        h <- getByte bh
+        case h of
+            0 -> return IfaceDefault
+            1 -> liftM IfaceDataAlt $ get bh
+            _ -> liftM IfaceLitAlt  $ get bh
+
+instance Binary IfaceBinding where
+    put_ bh (IfaceNonRec aa ab) = putByte bh 0 >> put_ bh aa >> put_ bh ab
+    put_ bh (IfaceRec ac)       = putByte bh 1 >> put_ bh ac
+    get bh = do
+        h <- getByte bh
+        case h of
+            0 -> do { aa <- get bh; ab <- get bh; return (IfaceNonRec aa ab) }
+            _ -> do { ac <- get bh; return (IfaceRec ac) }
+
+instance Binary IfaceLetBndr where
+    put_ bh (IfLetBndr a b c) = do
+            put_ bh a
+            put_ bh b
+            put_ bh c
+    get bh = do a <- get bh
+                b <- get bh
+                c <- get bh
+                return (IfLetBndr a b c)
+
+instance Binary IfaceTyConParent where
+    put_ bh IfNoParent = putByte bh 0
+    put_ bh (IfDataInstance ax pr ty) = do
+        putByte bh 1
+        put_ bh ax
+        put_ bh pr
+        put_ bh ty
+    get bh = do
+        h <- getByte bh
+        case h of
+            0 -> return IfNoParent
+            _ -> do
+                ax <- get bh
+                pr <- get bh
+                ty <- get bh
+                return $ IfDataInstance ax pr ty
+\end{code}
diff --git a/compiler/iface/IfaceType.lhs b/compiler/iface/IfaceType.lhs
index 822e3da75a6c..c55edc618513 100644
--- a/compiler/iface/IfaceType.lhs
+++ b/compiler/iface/IfaceType.lhs
@@ -6,47 +6,63 @@
 This module defines interface types and binders
 
 \begin{code}
+{-# LANGUAGE CPP #-}
 module IfaceType (
         IfExtName, IfLclName,
 
         IfaceType(..), IfacePredType, IfaceKind, IfaceTyCon(..), IfaceCoercion(..),
-        IfaceTyLit(..),
-        IfaceContext, IfaceBndr(..), IfaceTvBndr, IfaceIdBndr, 
+        IfaceTyLit(..), IfaceTcArgs(..),
+        IfaceContext, IfaceBndr(..), IfaceTvBndr, IfaceIdBndr,
 
         -- Conversion from Type -> IfaceType
-        toIfaceType, toIfaceKind, toIfaceContext,
-        toIfaceBndr, toIfaceIdBndr, toIfaceTvBndrs,
-        toIfaceTyCon, toIfaceTyCon_name,
+        toIfaceType, toIfaceTypes, toIfaceKind, toIfaceTyVar,
+        toIfaceContext, toIfaceBndr, toIfaceIdBndr,
+        toIfaceTvBndrs, toIfaceTyCon, toIfaceTyCon_name,
+        toIfaceTcArgs,
+
+        -- Conversion from IfaceTcArgs -> IfaceType
+        tcArgsIfaceTypes,
 
         -- Conversion from Coercion -> IfaceCoercion
         toIfaceCoercion,
 
         -- Printing
-        pprIfaceType, pprParendIfaceType, pprIfaceContext,
+        pprIfaceType, pprParendIfaceType, pprIfaceContext, pprIfaceContextArr,
         pprIfaceIdBndr, pprIfaceTvBndr, pprIfaceTvBndrs,
-        pprIfaceBndrs,
-        tOP_PREC, tYCON_PREC, noParens, maybeParen, pprIfaceForAllPart,
-        pprIfaceCoercion, pprParendIfaceCoercion
-
+        pprIfaceBndrs, pprIfaceTcArgs, pprParendIfaceTcArgs,
+        pprIfaceForAllPart, pprIfaceForAll, pprIfaceSigmaType,
+        pprIfaceCoercion, pprParendIfaceCoercion,
+        splitIfaceSigmaTy, pprIfaceTypeApp, pprUserIfaceForAll,
+
+        suppressIfaceKinds,
+        stripIfaceKindVars,
+        stripKindArgs,
+        substIfaceType, substIfaceTyVar, substIfaceTcArgs, mkIfaceTySubst
     ) where
 
+#include "HsVersions.h"
+
 import Coercion
-import TypeRep hiding( maybeParen )
+import DataCon ( dataConTyCon )
+import TcType
+import DynFlags
+import TypeRep
 import Unique( hasKey )
-import TyCon
+import Util ( filterOut, lengthIs, zipWithEqual )
+import TyCon hiding ( pprPromotionQuote )
 import CoAxiom
 import Id
 import Var
+-- import RnEnv( FastStringEnv, mkFsEnv, lookupFsEnv )
 import TysWiredIn
 import TysPrim
-import PrelNames( funTyConKey )
+import PrelNames( funTyConKey, ipClassName )
 import Name
 import BasicTypes
 import Binary
 import Outputable
 import FastString
-
-import Control.Monad
+import UniqSet
 \end{code}
 
 %************************************************************************
@@ -75,8 +91,9 @@ data IfaceType     -- A kind of universal type, used for types and kinds
   = IfaceTyVar    IfLclName               -- Type/coercion variable only, not tycon
   | IfaceAppTy    IfaceType IfaceType
   | IfaceFunTy    IfaceType IfaceType
+  | IfaceDFunTy   IfaceType IfaceType
   | IfaceForAllTy IfaceTvBndr IfaceType
-  | IfaceTyConApp IfaceTyCon [IfaceType]  -- Not necessarily saturated
+  | IfaceTyConApp IfaceTyCon IfaceTcArgs  -- Not necessarily saturated
                                           -- Includes newtypes, synonyms, tuples
   | IfaceLitTy IfaceTyLit
 
@@ -87,9 +104,24 @@ data IfaceTyLit
   = IfaceNumTyLit Integer
   | IfaceStrTyLit FastString
 
--- Encodes type constructors, kind constructors
--- coercion constructors, the lot
-newtype IfaceTyCon = IfaceTc { ifaceTyConName :: IfExtName }
+-- See Note [Suppressing kinds]
+-- We use a new list type (rather than [(IfaceType,Bool)], because
+-- it'll be more compact and faster to parse in interface
+-- files. Rather than two bytes and two decisions (nil/cons, and
+-- type/kind) there'll just be one.
+data IfaceTcArgs
+  = ITC_Nil
+  | ITC_Type IfaceType IfaceTcArgs
+  | ITC_Kind IfaceKind IfaceTcArgs
+
+-- Encodes type constructors, kind constructors,
+-- coercion constructors, the lot.
+-- We have to tag them in order to pretty print them
+-- properly.
+data IfaceTyCon
+  = IfaceTc              { ifaceTyConName :: IfExtName }
+  | IfacePromotedDataCon { ifaceTyConName :: IfExtName }
+  | IfacePromotedTyCon   { ifaceTyConName :: IfExtName }
 
 data IfaceCoercion
   = IfaceReflCo      Role IfaceType
@@ -129,40 +161,167 @@ splitIfaceSigmaTy ty
         = case split_foralls ty of { (tvs, rho) -> (tv:tvs, rho) }
     split_foralls rho = ([], rho)
 
-    split_rho (IfaceFunTy ty1 ty2)
-      | isIfacePredTy ty1 = case split_rho ty2 of { (ps, tau) -> (ty1:ps, tau) }
+    split_rho (IfaceDFunTy ty1 ty2)
+        = case split_rho ty2 of { (ps, tau) -> (ty1:ps, tau) }
     split_rho tau = ([], tau)
+
+suppressIfaceKinds :: DynFlags -> [IfaceTvBndr] -> [a] -> [a]
+suppressIfaceKinds dflags tys xs
+  | gopt Opt_PrintExplicitKinds dflags = xs
+  | otherwise = suppress tys xs
+    where
+      suppress _       []      = []
+      suppress []      a       = a
+      suppress (k:ks) a@(_:xs)
+        | isIfaceKindVar k = suppress ks xs
+        | otherwise        = a
+
+stripIfaceKindVars :: DynFlags -> [IfaceTvBndr] -> [IfaceTvBndr]
+stripIfaceKindVars dflags tyvars
+  | gopt Opt_PrintExplicitKinds dflags = tyvars
+  | otherwise = filterOut isIfaceKindVar tyvars
+
+isIfaceKindVar :: IfaceTvBndr -> Bool
+isIfaceKindVar (_, IfaceTyConApp tc _) = ifaceTyConName tc == superKindTyConName
+isIfaceKindVar _                       = False
+
+ifTyVarsOfType :: IfaceType -> UniqSet IfLclName
+ifTyVarsOfType ty
+  = case ty of
+      IfaceTyVar v -> unitUniqSet v
+      IfaceAppTy fun arg
+        -> ifTyVarsOfType fun `unionUniqSets` ifTyVarsOfType arg
+      IfaceFunTy arg res
+        -> ifTyVarsOfType arg `unionUniqSets` ifTyVarsOfType res
+      IfaceDFunTy arg res
+        -> ifTyVarsOfType arg `unionUniqSets` ifTyVarsOfType res
+      IfaceForAllTy (var,t) ty
+        -> delOneFromUniqSet (ifTyVarsOfType ty) var `unionUniqSets`
+           ifTyVarsOfType t
+      IfaceTyConApp _ args -> ifTyVarsOfArgs args
+      IfaceLitTy    _      -> emptyUniqSet
+
+ifTyVarsOfArgs :: IfaceTcArgs -> UniqSet IfLclName
+ifTyVarsOfArgs args = argv emptyUniqSet args
+   where
+     argv vs (ITC_Type t ts) = argv (vs `unionUniqSets` (ifTyVarsOfType t)) ts
+     argv vs (ITC_Kind k ks) = argv (vs `unionUniqSets` (ifTyVarsOfType k)) ks
+     argv vs ITC_Nil         = vs
+\end{code}
+
+Substitutions on IfaceType. This is only used during pretty-printing to construct
+the result type of a GADT, and does not deal with binders (eg IfaceForAll), so
+it doesn't need fancy capture stuff.
+
+\begin{code}
+type IfaceTySubst = FastStringEnv IfaceType
+
+mkIfaceTySubst :: [IfaceTvBndr] -> [IfaceType] -> IfaceTySubst
+mkIfaceTySubst tvs tys = mkFsEnv $ zipWithEqual "mkIfaceTySubst" (\(fs,_) ty -> (fs,ty)) tvs tys
+
+substIfaceType :: IfaceTySubst -> IfaceType -> IfaceType
+substIfaceType env ty
+  = go ty
+  where
+    go (IfaceTyVar tv)        = substIfaceTyVar env tv
+    go (IfaceAppTy  t1 t2)    = IfaceAppTy  (go t1) (go t2)
+    go (IfaceFunTy  t1 t2)    = IfaceFunTy  (go t1) (go t2)
+    go (IfaceDFunTy t1 t2)    = IfaceDFunTy (go t1) (go t2)
+    go ty@(IfaceLitTy {})     = ty
+    go (IfaceTyConApp tc tys) = IfaceTyConApp tc (substIfaceTcArgs env tys)
+    go (IfaceForAllTy {})     = pprPanic "substIfaceType" (ppr ty)
+
+substIfaceTcArgs :: IfaceTySubst -> IfaceTcArgs -> IfaceTcArgs
+substIfaceTcArgs env args
+  = go args
+  where
+    go ITC_Nil           = ITC_Nil
+    go (ITC_Type ty tys) = ITC_Type (substIfaceType env ty) (go tys)
+    go (ITC_Kind ty tys) = ITC_Kind (substIfaceType env ty) (go tys)
+
+substIfaceTyVar :: IfaceTySubst -> IfLclName -> IfaceType
+substIfaceTyVar env tv
+  | Just ty <- lookupFsEnv env tv = ty
+  | otherwise                     = IfaceTyVar tv
 \end{code}
 
 %************************************************************************
 %*                                                                      *
-                Pretty-printing
+                Functions over IFaceTcArgs
 %*                                                                      *
 %************************************************************************
 
-Precedence
-~~~~~~~~~~
-@ppr_ty@ takes an @Int@ that is the precedence of the context.
-The precedence levels are:
-\begin{description}
-\item[tOP_PREC]   No parens required.
-\item[fUN_PREC]   Left hand argument of a function arrow.
-\item[tYCON_PREC] Argument of a type constructor.
-\end{description}
 
 \begin{code}
-tOP_PREC, fUN_PREC, tYCON_PREC :: Int
-tOP_PREC    = 0 -- type   in ParseIface.y
-fUN_PREC    = 1 -- btype  in ParseIface.y
-tYCON_PREC  = 2 -- atype  in ParseIface.y
-
-noParens :: SDoc -> SDoc
-noParens pp = pp
-
-maybeParen :: Int -> Int -> SDoc -> SDoc
-maybeParen ctxt_prec inner_prec pretty
-  | ctxt_prec < inner_prec = pretty
-  | otherwise              = parens pretty
+stripKindArgs :: DynFlags -> IfaceTcArgs -> IfaceTcArgs
+stripKindArgs dflags tys
+  | gopt Opt_PrintExplicitKinds dflags = tys
+  | otherwise = suppressKinds tys
+    where
+      suppressKinds c
+        = case c of
+            ITC_Kind _ ts -> suppressKinds ts
+            _ -> c
+
+toIfaceTcArgs :: TyCon -> [Type] -> IfaceTcArgs
+-- See Note [Suppressing kinds]
+toIfaceTcArgs tc ty_args
+  = go (tyConKind tc) ty_args
+  where
+    go _                []     = ITC_Nil
+    go (ForAllTy _ res) (t:ts) = ITC_Kind (toIfaceKind t) (go res ts)
+    go (FunTy _ res)    (t:ts) = ITC_Type (toIfaceType t) (go res ts)
+    go kind             (t:ts) = WARN( True, ppr tc $$ ppr (tyConKind tc) $$ ppr ty_args )
+                                 ITC_Type (toIfaceType t) (go kind ts) -- Ill-kinded
+
+tcArgsIfaceTypes :: IfaceTcArgs -> [IfaceType]
+tcArgsIfaceTypes ITC_Nil = []
+tcArgsIfaceTypes (ITC_Kind t ts) = t : tcArgsIfaceTypes ts
+tcArgsIfaceTypes (ITC_Type t ts) = t : tcArgsIfaceTypes ts
+\end{code}
+
+Note [Suppressing kinds]
+~~~~~~~~~~~~~~~~~~~~~~~~
+We use the IfaceTcArgs to specify which of the arguments to a type
+constructor instantiate a for-all, and which are regular kind args.
+This in turn used to control kind-suppression when printing types,
+under the control of -fprint-explicit-kinds.  See also TypeRep.suppressKinds.
+For example, given
+    T :: forall k. (k->*) -> k -> *    -- Ordinary kind polymorphism
+    'Just :: forall k. k -> 'Maybe k   -- Promoted
+we want
+  T * Tree Int    prints as    T Tree Int
+  'Just *         prints as    Just *
+
+
+%************************************************************************
+%*                                                                      *
+                Functions over IFaceTyCon
+%*                                                                      *
+%************************************************************************
+
+\begin{code}
+--isPromotedIfaceTyCon :: IfaceTyCon -> Bool
+--isPromotedIfaceTyCon (IfacePromotedTyCon _) = True
+--isPromotedIfaceTyCon _ = False
+\end{code}
+%************************************************************************
+%*                                                                      *
+                Pretty-printing
+%*                                                                      *
+%************************************************************************
+
+\begin{code}
+pprIfaceInfixApp :: (TyPrec -> a -> SDoc) -> TyPrec -> SDoc -> a -> a -> SDoc
+pprIfaceInfixApp pp p pp_tc ty1 ty2
+  = maybeParen p FunPrec $
+    sep [pp FunPrec ty1, pprInfixVar True pp_tc <+> pp FunPrec ty2]
+
+pprIfacePrefixApp :: TyPrec -> SDoc -> [SDoc] -> SDoc
+pprIfacePrefixApp p pp_fun pp_tys
+  | null pp_tys = pp_fun
+  | otherwise   = maybeParen p TyConPrec $
+                  hang pp_fun 2 (sep pp_tys)
 \end{code}
 
 
@@ -180,9 +339,9 @@ pprIfaceIdBndr :: (IfLclName, IfaceType) -> SDoc
 pprIfaceIdBndr (name, ty) = hsep [ppr name, dcolon, ppr ty]
 
 pprIfaceTvBndr :: IfaceTvBndr -> SDoc
-pprIfaceTvBndr (tv, IfaceTyConApp tc [])
+pprIfaceTvBndr (tv, IfaceTyConApp tc ITC_Nil)
   | ifaceTyConName tc == liftedTypeKindTyConName = ppr tv
-pprIfaceTvBndr (tv, kind) = parens (ppr tv <> dcolon <> ppr kind)
+pprIfaceTvBndr (tv, kind) = parens (ppr tv <+> dcolon <+> ppr kind)
 
 pprIfaceTvBndrs :: [IfaceTvBndr] -> SDoc
 pprIfaceTvBndrs tyvars = sep (map pprIfaceTvBndr tyvars)
@@ -211,106 +370,200 @@ instance Outputable IfaceType where
   ppr ty = pprIfaceType ty
 
 pprIfaceType, pprParendIfaceType ::IfaceType -> SDoc
-pprIfaceType       = ppr_ty tOP_PREC
-pprParendIfaceType = ppr_ty tYCON_PREC
+pprIfaceType       = ppr_ty TopPrec
+pprParendIfaceType = ppr_ty TyConPrec
 
-isIfacePredTy :: IfaceType -> Bool
-isIfacePredTy _  = False
--- FIXME: fix this to print iface pred tys correctly
--- isIfacePredTy ty = isConstraintKind (ifaceTypeKind ty)
-
-ppr_ty :: Int -> IfaceType -> SDoc
+ppr_ty :: TyPrec -> IfaceType -> SDoc
 ppr_ty _         (IfaceTyVar tyvar)     = ppr tyvar
-ppr_ty ctxt_prec (IfaceTyConApp tc tys) = ppr_tc_app ppr_ty ctxt_prec tc tys
-
-ppr_ty _ (IfaceLitTy n) = ppr_tylit n
-
+ppr_ty ctxt_prec (IfaceTyConApp tc tys) = sdocWithDynFlags (pprTyTcApp ctxt_prec tc tys)
+ppr_ty _         (IfaceLitTy n)         = ppr_tylit n
         -- Function types
 ppr_ty ctxt_prec (IfaceFunTy ty1 ty2)
   = -- We don't want to lose synonyms, so we mustn't use splitFunTys here.
-    maybeParen ctxt_prec fUN_PREC $
-    sep (ppr_ty fUN_PREC ty1 : ppr_fun_tail ty2)
+    maybeParen ctxt_prec FunPrec $
+    sep [ppr_ty FunPrec ty1, sep (ppr_fun_tail ty2)]
   where
-    arr | isIfacePredTy ty1 = darrow
-        | otherwise         = arrow
-
     ppr_fun_tail (IfaceFunTy ty1 ty2)
-      = (arr <+> ppr_ty fUN_PREC ty1) : ppr_fun_tail ty2
+      = (arrow <+> ppr_ty FunPrec ty1) : ppr_fun_tail ty2
     ppr_fun_tail other_ty
-      = [arr <+> pprIfaceType other_ty]
+      = [arrow <+> pprIfaceType other_ty]
 
 ppr_ty ctxt_prec (IfaceAppTy ty1 ty2)
-  = maybeParen ctxt_prec tYCON_PREC $
-    ppr_ty fUN_PREC ty1 <+> pprParendIfaceType ty2
+  = maybeParen ctxt_prec TyConPrec $
+    ppr_ty FunPrec ty1 <+> pprParendIfaceType ty2
+
+ppr_ty ctxt_prec ty
+  = maybeParen ctxt_prec FunPrec (ppr_iface_sigma_type True ty)
+
+instance Outputable IfaceTcArgs where
+  ppr tca = pprIfaceTcArgs tca
+
+pprIfaceTcArgs, pprParendIfaceTcArgs :: IfaceTcArgs -> SDoc
+pprIfaceTcArgs  = ppr_tc_args TopPrec
+pprParendIfaceTcArgs = ppr_tc_args TyConPrec
 
-ppr_ty ctxt_prec ty@(IfaceForAllTy _ _)
-  = maybeParen ctxt_prec fUN_PREC (pprIfaceForAllPart tvs theta (pprIfaceType tau))
- where
+ppr_tc_args :: TyPrec -> IfaceTcArgs -> SDoc
+ppr_tc_args ctx_prec args
+ = let pprTys t ts = ppr_ty ctx_prec t <+> ppr_tc_args ctx_prec ts
+   in case args of
+        ITC_Nil       -> empty
+        ITC_Type t ts -> pprTys t ts
+        ITC_Kind t ts -> pprTys t ts
+
+-------------------
+ppr_iface_sigma_type :: Bool -> IfaceType -> SDoc
+ppr_iface_sigma_type show_foralls_unconditionally ty
+  = ppr_iface_forall_part show_foralls_unconditionally tvs theta (ppr tau)
+  where
     (tvs, theta, tau) = splitIfaceSigmaTy ty
 
- -------------------
--- needs to handle type contexts and coercion contexts, hence the
--- generality
 pprIfaceForAllPart :: Outputable a => [IfaceTvBndr] -> [a] -> SDoc -> SDoc
-pprIfaceForAllPart tvs ctxt doc
-  = sep [ppr_tvs, pprIfaceContext ctxt, doc]
+pprIfaceForAllPart tvs ctxt sdoc = ppr_iface_forall_part False tvs ctxt sdoc
+
+ppr_iface_forall_part :: Outputable a
+                      => Bool -> [IfaceTvBndr] -> [a] -> SDoc -> SDoc
+ppr_iface_forall_part show_foralls_unconditionally tvs ctxt sdoc
+  = sep [ if show_foralls_unconditionally
+          then pprIfaceForAll tvs
+          else pprUserIfaceForAll tvs
+        , pprIfaceContextArr ctxt
+        , sdoc]
+
+pprIfaceForAll :: [IfaceTvBndr] -> SDoc
+pprIfaceForAll []  = empty
+pprIfaceForAll tvs = ptext (sLit "forall") <+> pprIfaceTvBndrs tvs <> dot
+
+pprIfaceSigmaType :: IfaceType -> SDoc
+pprIfaceSigmaType ty = ppr_iface_sigma_type False ty
+
+pprUserIfaceForAll :: [IfaceTvBndr] -> SDoc
+pprUserIfaceForAll tvs
+   = sdocWithDynFlags $ \dflags ->
+     ppWhen (any tv_has_kind_var tvs || gopt Opt_PrintExplicitForalls dflags) $
+     pprIfaceForAll tvs
+   where
+     tv_has_kind_var (_,t) = not (isEmptyUniqSet (ifTyVarsOfType t))
+-------------------
+
+-- See equivalent function in TypeRep.lhs
+pprIfaceTyList :: TyPrec -> IfaceType -> IfaceType -> SDoc
+-- Given a type-level list (t1 ': t2), see if we can print
+-- it in list notation [t1, ...].
+-- Precondition: Opt_PrintExplicitKinds is off
+pprIfaceTyList ctxt_prec ty1 ty2
+  = case gather ty2 of
+      (arg_tys, Nothing)
+        -> char '\'' <> brackets (fsep (punctuate comma
+                        (map (ppr_ty TopPrec) (ty1:arg_tys))))
+      (arg_tys, Just tl)
+        -> maybeParen ctxt_prec FunPrec $ hang (ppr_ty FunPrec ty1)
+           2 (fsep [ colon <+> ppr_ty FunPrec ty | ty <- arg_tys ++ [tl]])
+  where
+    gather :: IfaceType -> ([IfaceType], Maybe IfaceType)
+     -- (gather ty) = (tys, Nothing) means ty is a list [t1, .., tn]
+     --             = (tys, Just tl) means ty is of form t1:t2:...tn:tl
+    gather (IfaceTyConApp tc tys)
+      | tcname == consDataConName
+      , (ITC_Kind _ (ITC_Type ty1 (ITC_Type ty2 ITC_Nil))) <- tys
+      , (args, tl) <- gather ty2
+      = (ty1:args, tl)
+      | tcname == nilDataConName
+      = ([], Nothing)
+      where tcname = ifaceTyConName tc
+    gather ty = ([], Just ty)
+
+pprIfaceTypeApp :: IfaceTyCon -> IfaceTcArgs -> SDoc
+pprIfaceTypeApp tc args = sdocWithDynFlags (pprTyTcApp TopPrec tc args)
+
+pprTyTcApp :: TyPrec -> IfaceTyCon -> IfaceTcArgs -> DynFlags -> SDoc
+pprTyTcApp ctxt_prec tc tys dflags
+  | ifaceTyConName tc == ipClassName
+  , ITC_Type (IfaceLitTy (IfaceStrTyLit n)) (ITC_Type ty ITC_Nil) <- tys
+  = char '?' <> ftext n <> ptext (sLit "::") <> ppr_ty TopPrec ty
+
+  | ifaceTyConName tc == consDataConName
+  , not (gopt Opt_PrintExplicitKinds dflags)
+  , ITC_Kind _ (ITC_Type ty1 (ITC_Type ty2 ITC_Nil)) <- tys
+  = pprIfaceTyList ctxt_prec ty1 ty2
+
+  | otherwise
+  = ppr_iface_tc_app ppr_ty ctxt_prec tc tys_wo_kinds
   where
-    ppr_tvs | null tvs  = empty
-            | otherwise = ptext (sLit "forall") <+> pprIfaceTvBndrs tvs <> dot
+    tys_wo_kinds = tcArgsIfaceTypes $ stripKindArgs dflags tys
 
--------------------
-ppr_tc_app :: (Int -> a -> SDoc) -> Int -> IfaceTyCon -> [a] -> SDoc
-ppr_tc_app _  _         tc          []   = ppr_tc tc
-
-
-ppr_tc_app pp _         (IfaceTc n) [ty]
-  | n == listTyConName
-  = brackets (pp tOP_PREC ty)
-  | n == parrTyConName
-  = paBrackets (pp tOP_PREC ty)
-ppr_tc_app pp _         (IfaceTc n) tys
-  | Just (ATyCon tc) <- wiredInNameTyThing_maybe n
-  , Just sort <- tyConTuple_maybe tc
-  , tyConArity tc == length tys
-  = tupleParens sort (sep (punctuate comma (map (pp tOP_PREC) tys)))
-ppr_tc_app pp ctxt_prec tc tys
-  = maybeParen ctxt_prec tYCON_PREC
-               (sep [ppr_tc tc, nest 4 (sep (map (pp tYCON_PREC) tys))])
-
-ppr_tc :: IfaceTyCon -> SDoc
--- Wrap infix type constructors in parens
-ppr_tc tc = wrap (ifaceTyConName tc) (ppr tc)
+pprIfaceCoTcApp :: TyPrec -> IfaceTyCon -> [IfaceCoercion] -> SDoc
+pprIfaceCoTcApp ctxt_prec tc tys = ppr_iface_tc_app ppr_co ctxt_prec tc tys
+
+ppr_iface_tc_app :: (TyPrec -> a -> SDoc) -> TyPrec -> IfaceTyCon -> [a] -> SDoc
+ppr_iface_tc_app pp _ tc [ty]
+  | n == listTyConName = pprPromotionQuote tc <> brackets (pp TopPrec ty)
+  | n == parrTyConName = pprPromotionQuote tc <> paBrackets (pp TopPrec ty)
+  where
+    n = ifaceTyConName tc
+
+ppr_iface_tc_app pp ctxt_prec tc tys
+  | Just (tup_sort, tup_args) <- is_tuple
+  = pprPromotionQuote tc <>
+    tupleParens tup_sort (sep (punctuate comma (map (pp TopPrec) tup_args)))
+
+  | not (isSymOcc (nameOccName tc_name))
+  = pprIfacePrefixApp ctxt_prec (ppr tc) (map (pp TyConPrec) tys)
+
+  | [ty1,ty2] <- tys  -- Infix, two arguments;
+                      -- we know nothing of precedence though
+  = pprIfaceInfixApp pp ctxt_prec (ppr tc) ty1 ty2
+
+  | tc_name == liftedTypeKindTyConName || tc_name == unliftedTypeKindTyConName
+  = ppr tc   -- Do not wrap *, # in parens
+
+  | otherwise
+  = pprIfacePrefixApp ctxt_prec (parens (ppr tc)) (map (pp TyConPrec) tys)
   where
-  -- The kind * does not get wrapped in parens.
-  wrap name | name == liftedTypeKindTyConName = id
-  wrap name                                   = parenSymOcc (getOccName name)
+    tc_name = ifaceTyConName tc
+
+    is_tuple = case wiredInNameTyThing_maybe tc_name of
+                 Just (ATyCon tc)
+                   | Just sort <- tyConTuple_maybe tc
+                   , tyConArity tc == length tys
+                   -> Just (sort, tys)
+
+                   | Just dc <- isPromotedDataCon_maybe tc
+                   , let dc_tc = dataConTyCon dc
+                   , isTupleTyCon dc_tc
+                   , let arity = tyConArity dc_tc
+                         ty_args = drop arity tys
+                   , ty_args `lengthIs` arity
+                   -> Just (tupleTyConSort tc, ty_args)
+
+                 _ -> Nothing
+
 
 ppr_tylit :: IfaceTyLit -> SDoc
 ppr_tylit (IfaceNumTyLit n) = integer n
 ppr_tylit (IfaceStrTyLit n) = text (show n)
 
 pprIfaceCoercion, pprParendIfaceCoercion :: IfaceCoercion -> SDoc
-pprIfaceCoercion = ppr_co tOP_PREC
-pprParendIfaceCoercion = ppr_co tYCON_PREC
+pprIfaceCoercion = ppr_co TopPrec
+pprParendIfaceCoercion = ppr_co TyConPrec
 
-ppr_co :: Int -> IfaceCoercion -> SDoc
+ppr_co :: TyPrec -> IfaceCoercion -> SDoc
 ppr_co _         (IfaceReflCo r ty) = angleBrackets (ppr ty) <> ppr_role r
 ppr_co ctxt_prec (IfaceFunCo r co1 co2)
-  = maybeParen ctxt_prec fUN_PREC $
-    sep (ppr_co fUN_PREC co1 : ppr_fun_tail co2)
+  = maybeParen ctxt_prec FunPrec $
+    sep (ppr_co FunPrec co1 : ppr_fun_tail co2)
   where
     ppr_fun_tail (IfaceFunCo r co1 co2)
-      = (arrow <> ppr_role r <+> ppr_co fUN_PREC co1) : ppr_fun_tail co2
+      = (arrow <> ppr_role r <+> ppr_co FunPrec co1) : ppr_fun_tail co2
     ppr_fun_tail other_co
       = [arrow <> ppr_role r <+> pprIfaceCoercion other_co]
 
 ppr_co _         (IfaceTyConAppCo r tc cos)
-  = parens (ppr_tc_app ppr_co tOP_PREC tc cos) <> ppr_role r
+  = parens (pprIfaceCoTcApp TopPrec tc cos) <> ppr_role r
 ppr_co ctxt_prec (IfaceAppCo co1 co2)
-  = maybeParen ctxt_prec tYCON_PREC $
-    ppr_co fUN_PREC co1 <+> pprParendIfaceCoercion co2
+  = maybeParen ctxt_prec TyConPrec $
+    ppr_co FunPrec co1 <+> pprParendIfaceCoercion co2
 ppr_co ctxt_prec co@(IfaceForAllCo _ _)
-  = maybeParen ctxt_prec fUN_PREC (sep [ppr_tvs, pprIfaceCoercion inner_co])
+  = maybeParen ctxt_prec FunPrec (sep [ppr_tvs, pprIfaceCoercion inner_co])
   where
     (tvs, inner_co) = split_co co
     ppr_tvs = ptext (sLit "forall") <+> pprIfaceTvBndrs tvs <> dot
@@ -322,16 +575,16 @@ ppr_co ctxt_prec co@(IfaceForAllCo _ _)
 ppr_co _         (IfaceCoVarCo covar)       = ppr covar
 
 ppr_co ctxt_prec (IfaceUnivCo r ty1 ty2)
-  = maybeParen ctxt_prec tYCON_PREC $
+  = maybeParen ctxt_prec TyConPrec $
     ptext (sLit "UnivCo") <+> ppr r <+>
     pprParendIfaceType ty1 <+> pprParendIfaceType ty2
 
 ppr_co ctxt_prec (IfaceInstCo co ty)
-  = maybeParen ctxt_prec tYCON_PREC $
+  = maybeParen ctxt_prec TyConPrec $
     ptext (sLit "Inst") <+> pprParendIfaceCoercion co <+> pprParendIfaceType ty
 
 ppr_co ctxt_prec (IfaceAxiomRuleCo tc tys cos)
-  = maybeParen ctxt_prec tYCON_PREC
+  = maybeParen ctxt_prec TyConPrec
                (sep [ppr tc, nest 4 (sep (map pprParendIfaceType tys ++ map pprParendIfaceCoercion cos))])
 
 ppr_co ctxt_prec co
@@ -346,9 +599,9 @@ ppr_co ctxt_prec co
                      ; IfaceSubCo co            -> (ptext (sLit "Sub"), [co])
                      ; _                        -> panic "pprIfaceCo" }
 
-ppr_special_co :: Int -> SDoc -> [IfaceCoercion] -> SDoc
+ppr_special_co :: TyPrec -> SDoc -> [IfaceCoercion] -> SDoc
 ppr_special_co ctxt_prec doc cos
-  = maybeParen ctxt_prec tYCON_PREC
+  = maybeParen ctxt_prec TyConPrec
                (sep [doc, nest 4 (sep (map pprParendIfaceCoercion cos))])
 
 ppr_role :: Role -> SDoc
@@ -360,14 +613,30 @@ ppr_role r = underscore <> pp_role
 
 -------------------
 instance Outputable IfaceTyCon where
-  ppr = ppr . ifaceTyConName
+  ppr tc = pprPromotionQuote tc <> ppr (ifaceTyConName tc)
+
+pprPromotionQuote :: IfaceTyCon -> SDoc
+pprPromotionQuote (IfacePromotedDataCon _ ) = char '\''
+pprPromotionQuote (IfacePromotedTyCon _)    = ifPprDebug (char '\'')
+pprPromotionQuote _                         = empty
 
 instance Outputable IfaceCoercion where
   ppr = pprIfaceCoercion
 
 instance Binary IfaceTyCon where
-   put_ bh (IfaceTc ext) = put_ bh ext
-   get bh = liftM IfaceTc (get bh)
+   put_ bh tc =
+     case tc of
+       IfaceTc n              -> putByte bh 0 >> put_ bh n
+       IfacePromotedDataCon n -> putByte bh 1 >> put_ bh n
+       IfacePromotedTyCon   n -> putByte bh 2 >> put_ bh n
+
+   get bh =
+     do tc <- getByte bh
+        case tc of
+          0 -> get bh >>= return . IfaceTc
+          1 -> get bh >>= return . IfacePromotedDataCon
+          2 -> get bh >>= return . IfacePromotedTyCon
+          _ -> panic ("get IfaceTyCon " ++ show tc)
 
 instance Outputable IfaceTyLit where
   ppr = ppr_tylit
@@ -385,15 +654,36 @@ instance Binary IfaceTyLit where
                  ; return (IfaceStrTyLit n) }
          _ -> panic ("get IfaceTyLit " ++ show tag)
 
+instance Binary IfaceTcArgs where
+  put_ bh tk =
+    case tk of
+      ITC_Type t ts -> putByte bh 0 >> put_ bh t >> put_ bh ts
+      ITC_Kind t ts -> putByte bh 1 >> put_ bh t >> put_ bh ts
+      ITC_Nil       -> putByte bh 2
+
+  get bh =
+    do c <- getByte bh
+       case c of
+         0 -> do
+           t  <- get bh
+           ts <- get bh
+           return $! ITC_Type t ts
+         1 -> do
+           t  <- get bh
+           ts <- get bh
+           return $! ITC_Kind t ts
+         2 -> return ITC_Nil
+         _ -> panic ("get IfaceTcArgs " ++ show c)
+
 -------------------
-pprIfaceContext :: Outputable a => [a] -> SDoc
+pprIfaceContextArr :: Outputable a => [a] -> SDoc
 -- Prints "(C a, D b) =>", including the arrow
-pprIfaceContext []    = empty
-pprIfaceContext theta = ppr_preds theta <+> darrow
+pprIfaceContextArr []    = empty
+pprIfaceContextArr theta = pprIfaceContext theta <+> darrow
 
-ppr_preds :: Outputable a => [a] -> SDoc
-ppr_preds [pred] = ppr pred    -- No parens
-ppr_preds preds  = parens (sep (punctuate comma (map ppr preds)))
+pprIfaceContext :: Outputable a => [a] -> SDoc
+pprIfaceContext [pred] = ppr pred    -- No parens
+pprIfaceContext preds  = parens (fsep (punctuate comma (map ppr preds)))
 
 instance Binary IfaceType where
     put_ bh (IfaceForAllTy aa ab) = do
@@ -411,6 +701,10 @@ instance Binary IfaceType where
             putByte bh 3
             put_ bh ag
             put_ bh ah
+    put_ bh (IfaceDFunTy ag ah) = do
+            putByte bh 4
+            put_ bh ag
+            put_ bh ah
     put_ bh (IfaceTyConApp tc tys)
       = do { putByte bh 5; put_ bh tc; put_ bh tys }
 
@@ -431,9 +725,11 @@ instance Binary IfaceType where
               3 -> do ag <- get bh
                       ah <- get bh
                       return (IfaceFunTy ag ah)
+              4 -> do ag <- get bh
+                      ah <- get bh
+                      return (IfaceDFunTy ag ah)
               5 -> do { tc <- get bh; tys <- get bh
                       ; return (IfaceTyConApp tc tys) }
-
               30 -> do n <- get bh
                        return (IfaceLitTy n)
 
@@ -553,7 +849,7 @@ instance Binary IfaceCoercion where
                    b <- get bh
                    c <- get bh
                    return $ IfaceAxiomRuleCo a b c
-           _ -> panic ("get IfaceCoercion " ++ show tag)             
+           _ -> panic ("get IfaceCoercion " ++ show tag)
 
 \end{code}
 
@@ -585,8 +881,10 @@ toIfaceType :: Type -> IfaceType
 -- Synonyms are retained in the interface type
 toIfaceType (TyVarTy tv)      = IfaceTyVar (toIfaceTyVar tv)
 toIfaceType (AppTy t1 t2)     = IfaceAppTy (toIfaceType t1) (toIfaceType t2)
-toIfaceType (FunTy t1 t2)     = IfaceFunTy (toIfaceType t1) (toIfaceType t2)
-toIfaceType (TyConApp tc tys) = IfaceTyConApp (toIfaceTyCon tc) (toIfaceTypes tys)
+toIfaceType (FunTy t1 t2)
+  | isPredTy t1 = IfaceDFunTy (toIfaceType t1) (toIfaceType t2)
+  | otherwise   = IfaceFunTy  (toIfaceType t1) (toIfaceType t2)
+toIfaceType (TyConApp tc tys) = IfaceTyConApp (toIfaceTyCon tc) (toIfaceTcArgs tc tys)
 toIfaceType (LitTy n)         = IfaceLitTy (toIfaceTyLit n)
 toIfaceType (ForAllTy tv t)   = IfaceForAllTy (toIfaceTvBndr tv) (toIfaceType t)
 
@@ -598,7 +896,11 @@ toIfaceCoVar = occNameFS . getOccName
 
 ----------------
 toIfaceTyCon :: TyCon -> IfaceTyCon
-toIfaceTyCon = toIfaceTyCon_name . tyConName
+toIfaceTyCon tc
+  | isPromotedDataCon tc = IfacePromotedDataCon tc_name
+  | isPromotedTyCon tc   = IfacePromotedTyCon tc_name
+  | otherwise            = IfaceTc tc_name
+    where tc_name = tyConName tc
 
 toIfaceTyCon_name :: Name -> IfaceTyCon
 toIfaceTyCon_name = IfaceTc
@@ -647,4 +949,3 @@ toIfaceCoercion (AxiomRuleCo co ts cs) = IfaceAxiomRuleCo
                                           (map toIfaceType ts)
                                           (map toIfaceCoercion cs)
 \end{code}
-
diff --git a/compiler/iface/LoadIface.lhs b/compiler/iface/LoadIface.lhs
index d7877943261e..2be6e9d4d83d 100644
--- a/compiler/iface/LoadIface.lhs
+++ b/compiler/iface/LoadIface.lhs
@@ -6,6 +6,7 @@
 Loading interface files
 
 \begin{code}
+{-# LANGUAGE CPP #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 module LoadIface (
         -- RnM/TcM functions
@@ -352,13 +353,13 @@ wantHiBootFile dflags eps mod from
                      -- The boot-ness of the requested interface, 
                      -- based on the dependencies in directly-imported modules
   where
-    this_package = thisPackage dflags == modulePackageId mod
+    this_package = thisPackage dflags == modulePackageKey mod
 
 badSourceImport :: Module -> SDoc
 badSourceImport mod
   = hang (ptext (sLit "You cannot {-# SOURCE #-} import a module from another package"))
        2 (ptext (sLit "but") <+> quotes (ppr mod) <+> ptext (sLit "is from package")
-          <+> quotes (ppr (modulePackageId mod)))
+          <+> quotes (ppr (modulePackageKey mod)))
 \end{code}
 
 Note [Care with plugin imports]
@@ -391,7 +392,7 @@ compiler expects.
 -- the declaration itself, will find the fully-glorious Name
 --
 -- We handle ATs specially.  They are not main declarations, but also not
--- implict things (in particular, adding them to `implicitTyThings' would mess
+-- implicit things (in particular, adding them to `implicitTyThings' would mess
 -- things up in the renaming/type checking of source programs).
 -----------------------------------------------------
 
@@ -416,7 +417,6 @@ loadDecl ignore_prags mod (_version, decl)
   = do  {       -- Populate the name cache with final versions of all 
                 -- the names associated with the decl
           main_name      <- lookupOrig mod (ifName decl)
---        ; traceIf (text "Loading decl for " <> ppr main_name)
 
         -- Typecheck the thing, lazily
         -- NB. Firstly, the laziness is there in case we never need the
@@ -445,11 +445,11 @@ loadDecl ignore_prags mod (_version, decl)
         --      [ "MkT" -> <datacon MkT>, "x" -> <selector x>, ... ]
         -- (where the "MkT" is the *Name* associated with MkT, etc.)
         --
-        -- We do this by mapping the implict_names to the associated
+        -- We do this by mapping the implicit_names to the associated
         -- TyThings.  By the invariant on ifaceDeclImplicitBndrs and
         -- implicitTyThings, we can use getOccName on the implicit
         -- TyThings to make this association: each Name's OccName should
-        -- be the OccName of exactly one implictTyThing.  So the key is
+        -- be the OccName of exactly one implicitTyThing.  So the key is
         -- to define a "mini-env"
         --
         -- [ 'MkT' -> <datacon MkT>, 'x' -> <selector x>, ... ]
@@ -457,7 +457,7 @@ loadDecl ignore_prags mod (_version, decl)
         --
         -- However, there is a subtlety: due to how type checking needs
         -- to be staged, we can't poke on the forkM'd thunks inside the
-        -- implictTyThings while building this mini-env.  
+        -- implicitTyThings while building this mini-env.  
         -- If we poke these thunks too early, two problems could happen:
         --    (1) When processing mutually recursive modules across
         --        hs-boot boundaries, poking too early will do the
@@ -490,9 +490,11 @@ loadDecl ignore_prags mod (_version, decl)
                              pprPanic "loadDecl" (ppr main_name <+> ppr n $$ ppr (decl))
 
         ; implicit_names <- mapM (lookupOrig mod) (ifaceDeclImplicitBndrs decl)
+
+--         ; traceIf (text "Loading decl for " <> ppr main_name $$ ppr implicit_names)
         ; return $ (main_name, thing) :
                       -- uses the invariant that implicit_names and
-                      -- implictTyThings are bijective
+                      -- implicitTyThings are bijective
                       [(n, lookup n) | n <- implicit_names]
         }
   where
@@ -571,7 +573,7 @@ findAndReadIface doc_str mod hi_boot_file
                                                            (ml_hi_file loc)
 
                        -- See Note [Home module load error]
-                       if thisPackage dflags == modulePackageId mod &&
+                       if thisPackage dflags == modulePackageKey mod &&
                           not (isOneShot (ghcMode dflags))
                            then return (Failed (homeModError mod loc))
                            else do r <- read_file file_path
@@ -751,7 +753,7 @@ pprModIface iface
         , vcat (map pprUsage (mi_usages iface))
         , vcat (map pprIfaceAnnotation (mi_anns iface))
         , pprFixities (mi_fixities iface)
-        , vcat (map pprIfaceDecl (mi_decls iface))
+        , vcat [ppr ver $$ nest 2 (ppr decl) | (ver,decl) <- mi_decls iface]
         , vcat (map ppr (mi_insts iface))
         , vcat (map ppr (mi_fam_insts iface))
         , vcat (map ppr (mi_rules iface))
@@ -817,10 +819,6 @@ pprDeps (Deps { dep_mods = mods, dep_pkgs = pkgs, dep_orphs = orphs,
     ppr_boot True  = text "[boot]"
     ppr_boot False = empty
 
-pprIfaceDecl :: (Fingerprint, IfaceDecl) -> SDoc
-pprIfaceDecl (ver, decl)
-  = ppr ver $$ nest 2 (ppr decl)
-
 pprFixities :: [(OccName, Fixity)] -> SDoc
 pprFixities []    = empty
 pprFixities fixes = ptext (sLit "fixities") <+> pprWithCommas pprFix fixes
@@ -878,7 +876,9 @@ badIfaceFile file err
 
 hiModuleNameMismatchWarn :: Module -> Module -> MsgDoc
 hiModuleNameMismatchWarn requested_mod read_mod = 
-  withPprStyle defaultUserStyle $
+  -- ToDo: This will fail to have enough qualification when the package IDs
+  -- are the same
+  withPprStyle (mkUserStyle alwaysQualify AllTheWay) $
     -- we want the Modules below to be qualified with package names,
     -- so reset the PrintUnqualified setting.
     hsep [ ptext (sLit "Something is amiss; requested module ")
diff --git a/compiler/iface/MkIface.lhs b/compiler/iface/MkIface.lhs
index 379b39de583a..8a30816855c6 100644
--- a/compiler/iface/MkIface.lhs
+++ b/compiler/iface/MkIface.lhs
@@ -4,6 +4,8 @@
 %
 
 \begin{code}
+{-# LANGUAGE CPP, NondecreasingIndentation #-}
+
 -- | Module for constructing @ModIface@ values (interface files),
 -- writing them to disk and comparing two versions to see if
 -- recompilation is required.
@@ -78,6 +80,7 @@ import DataCon
 import PatSyn
 import Type
 import TcType
+import TysPrim ( alphaTyVars )
 import InstEnv
 import FamInstEnv
 import TcRnMonad
@@ -215,12 +218,12 @@ mkDependencies
                 --  on M.hi-boot, and hence that we should do the hi-boot consistency
                 --  check.)
 
-          pkgs | th_used   = insertList thPackageId (imp_dep_pkgs imports)
+          pkgs | th_used   = insertList thPackageKey (imp_dep_pkgs imports)
                | otherwise = imp_dep_pkgs imports
 
           -- Set the packages required to be Safe according to Safe Haskell.
           -- See Note [RnNames . Tracking Trust Transitively]
-          sorted_pkgs = sortBy stablePackageIdCmp pkgs
+          sorted_pkgs = sortBy stablePackageKeyCmp pkgs
           trust_pkgs  = imp_trust_pkgs imports
           dep_pkgs'   = map (\x -> (x, x `elem` trust_pkgs)) sorted_pkgs
 
@@ -556,7 +559,7 @@ addFingerprints hsc_env mb_old_fingerprint iface0 new_decls
    -- dependency tree.  We only care about orphan modules in the current
    -- package, because changes to orphans outside this package will be
    -- tracked by the usage on the ABI hash of package modules that we import.
-   let orph_mods = filter ((== this_pkg) . modulePackageId)
+   let orph_mods = filter ((== this_pkg) . modulePackageKey)
                    $ dep_orphs sorted_deps
    dep_orphan_hashes <- getOrphanHashes hsc_env orph_mods
 
@@ -658,7 +661,7 @@ getOrphanHashes hsc_env mods = do
 sortDependencies :: Dependencies -> Dependencies
 sortDependencies d
  = Deps { dep_mods   = sortBy (compare `on` (moduleNameFS.fst)) (dep_mods d),
-          dep_pkgs   = sortBy (stablePackageIdCmp `on` fst) (dep_pkgs d),
+          dep_pkgs   = sortBy (stablePackageKeyCmp `on` fst) (dep_pkgs d),
           dep_orphs  = sortBy stableModuleCmp (dep_orphs d),
           dep_finsts = sortBy stableModuleCmp (dep_finsts d) }
 \end{code}
@@ -876,6 +879,13 @@ instOrphWarn :: DynFlags -> PrintUnqualified -> ClsInst -> WarnMsg
 instOrphWarn dflags unqual inst
   = mkWarnMsg dflags (getSrcSpan inst) unqual $
     hang (ptext (sLit "Orphan instance:")) 2 (pprInstanceHdr inst)
+    $$ text "To avoid this"
+    $$ nest 4 (vcat possibilities)
+  where
+    possibilities =
+      text "move the instance declaration to the module of the class or of the type, or" :
+      text "wrap the type with a newtype and declare the instance on the new type." :
+      []
 
 ruleOrphWarn :: DynFlags -> PrintUnqualified -> Module -> IfaceRule -> WarnMsg
 ruleOrphWarn dflags unqual mod rule
@@ -936,7 +946,7 @@ mk_mod_usage_info :: PackageIfaceTable
               -> NameSet
               -> [Usage]
 mk_mod_usage_info pit hsc_env this_mod direct_imports used_names
-  = mapCatMaybes mkUsage usage_mods
+  = mapMaybe mkUsage usage_mods
   where
     hpt = hsc_HPT hsc_env
     dflags = hsc_dflags hsc_env
@@ -979,7 +989,7 @@ mk_mod_usage_info pit hsc_env this_mod direct_imports used_names
                                         -- things in *this* module
       = Nothing
 
-      | modulePackageId mod /= this_pkg
+      | modulePackageKey mod /= this_pkg
       = Just UsagePackageModule{ usg_mod      = mod,
                                  usg_mod_hash = mod_hash,
                                  usg_safe     = imp_safe }
@@ -1131,27 +1141,35 @@ recompileRequired _ = True
 -- first element is a bool saying if we should recompile the object file
 -- and the second is maybe the interface file, where Nothng means to
 -- rebuild the interface file not use the exisitng one.
-checkOldIface :: HscEnv
-              -> ModSummary
-              -> SourceModified
-              -> Maybe ModIface         -- Old interface from compilation manager, if any
-              -> IO (RecompileRequired, Maybe ModIface)
+checkOldIface
+  :: HscEnv
+  -> ModSummary
+  -> SourceModified
+  -> Maybe ModIface         -- Old interface from compilation manager, if any
+  -> IO (RecompileRequired, Maybe ModIface)
 
 checkOldIface hsc_env mod_summary source_modified maybe_iface
   = do  let dflags = hsc_dflags hsc_env
         showPass dflags $
-            "Checking old interface for " ++ (showPpr dflags $ ms_mod mod_summary)
+            "Checking old interface for " ++
+              (showPpr dflags $ ms_mod mod_summary)
         initIfaceCheck hsc_env $
             check_old_iface hsc_env mod_summary source_modified maybe_iface
 
-check_old_iface :: HscEnv -> ModSummary -> SourceModified -> Maybe ModIface
-                -> IfG (RecompileRequired, Maybe ModIface)
+check_old_iface
+  :: HscEnv
+  -> ModSummary
+  -> SourceModified
+  -> Maybe ModIface
+  -> IfG (RecompileRequired, Maybe ModIface)
+
 check_old_iface hsc_env mod_summary src_modified maybe_iface
   = let dflags = hsc_dflags hsc_env
         getIface =
             case maybe_iface of
                 Just _  -> do
-                    traceIf (text "We already have the old interface for" <+> ppr (ms_mod mod_summary))
+                    traceIf (text "We already have the old interface for" <+>
+                      ppr (ms_mod mod_summary))
                     return maybe_iface
                 Nothing -> loadIface
 
@@ -1300,7 +1318,7 @@ checkDependencies hsc_env summary iface
                          return (RecompBecause reason)
                  else
                          return UpToDate
-           where pkg = modulePackageId mod
+           where pkg = modulePackageKey mod
         _otherwise  -> return (RecompBecause reason)
 
 needInterface :: Module -> (ModIface -> IfG RecompileRequired)
@@ -1329,7 +1347,7 @@ needInterface mod continue
 -- | Given the usage information extracted from the old
 -- M.hi file for the module being compiled, figure out
 -- whether M needs to be recompiled.
-checkModUsage :: PackageId -> Usage -> IfG RecompileRequired
+checkModUsage :: PackageKey -> Usage -> IfG RecompileRequired
 checkModUsage _this_pkg UsagePackageModule{
                                 usg_mod = mod,
                                 usg_mod_hash = old_mod_hash }
@@ -1458,10 +1476,10 @@ checkList (check:checks) = do recompile <- check
 \begin{code}
 tyThingToIfaceDecl :: TyThing -> IfaceDecl
 tyThingToIfaceDecl (AnId id)      = idToIfaceDecl id
-tyThingToIfaceDecl (ATyCon tycon) = tyConToIfaceDecl emptyTidyEnv tycon
+tyThingToIfaceDecl (ATyCon tycon) = snd (tyConToIfaceDecl emptyTidyEnv tycon)
 tyThingToIfaceDecl (ACoAxiom ax)  = coAxiomToIfaceDecl ax
 tyThingToIfaceDecl (AConLike cl)  = case cl of
-    RealDataCon dc -> pprPanic "toIfaceDecl" (ppr dc) -- Should be trimmed out earlier
+    RealDataCon dc -> dataConToIfaceDecl dc -- for ppr purposes only
     PatSynCon ps   -> patSynToIfaceDecl ps
 
 --------------------------
@@ -1476,29 +1494,36 @@ idToIfaceDecl id
               ifIdDetails = toIfaceIdDetails (idDetails id),
               ifIdInfo    = toIfaceIdInfo (idInfo id) }
 
+--------------------------
+dataConToIfaceDecl :: DataCon -> IfaceDecl
+dataConToIfaceDecl dataCon
+  = IfaceId { ifName      = getOccName dataCon,
+              ifType      = toIfaceType (dataConUserType dataCon),
+              ifIdDetails = IfVanillaId,
+              ifIdInfo    = NoInfo }
+
 --------------------------
 patSynToIfaceDecl :: PatSyn -> IfaceDecl
 patSynToIfaceDecl ps
   = IfacePatSyn { ifName          = getOccName . getName $ ps
-                , ifPatHasWrapper = isJust $ patSynWrapper ps
+                , ifPatMatcher    = matcher
+                , ifPatWrapper    = wrapper
                 , ifPatIsInfix    = patSynIsInfix ps
                 , ifPatUnivTvs    = toIfaceTvBndrs univ_tvs'
                 , ifPatExTvs      = toIfaceTvBndrs ex_tvs'
                 , ifPatProvCtxt   = tidyToIfaceContext env2 prov_theta
                 , ifPatReqCtxt    = tidyToIfaceContext env2 req_theta
-                , ifPatArgs       = map toIfaceArg args
+                , ifPatArgs       = map (tidyToIfaceType env2) args
                 , ifPatTy         = tidyToIfaceType env2 rhs_ty
                 }
   where
-    toIfaceArg var = (occNameFS (getOccName var),
-                      tidyToIfaceType env2 (varType var))
-
-    (univ_tvs, ex_tvs, (prov_theta, req_theta)) = patSynSig ps
-    args = patSynArgs ps
-    rhs_ty = patSynType ps
+    (univ_tvs, ex_tvs, prov_theta, req_theta, args, rhs_ty) = patSynSig ps
     (env1, univ_tvs') = tidyTyVarBndrs emptyTidyEnv univ_tvs
     (env2, ex_tvs')   = tidyTyVarBndrs env1 ex_tvs
 
+    matcher = idName (patSynMatcher ps)
+    wrapper = fmap idName (patSynWrapper ps)
+
 
 --------------------------
 coAxiomToIfaceDecl :: CoAxiom br -> IfaceDecl
@@ -1509,19 +1534,19 @@ coAxiomToIfaceDecl ax@(CoAxiom { co_ax_tc = tycon, co_ax_branches = branches
  = IfaceAxiom { ifName       = name
               , ifTyCon      = toIfaceTyCon tycon
               , ifRole       = role
-              , ifAxBranches = brListMap (coAxBranchToIfaceBranch
-                                            emptyTidyEnv
-                                            (brListMap coAxBranchLHS branches)) branches }
+              , ifAxBranches = brListMap (coAxBranchToIfaceBranch tycon
+                                            (brListMap coAxBranchLHS branches))
+                                         branches }
  where
    name = getOccName ax
 
 -- 2nd parameter is the list of branch LHSs, for conversion from incompatible branches
 -- to incompatible indices
--- See [Storing compatibility] in CoAxiom
-coAxBranchToIfaceBranch :: TidyEnv -> [[Type]] -> CoAxBranch -> IfaceAxBranch
-coAxBranchToIfaceBranch env0 lhs_s
+-- See Note [Storing compatibility] in CoAxiom
+coAxBranchToIfaceBranch :: TyCon -> [[Type]] -> CoAxBranch -> IfaceAxBranch
+coAxBranchToIfaceBranch tc lhs_s
                         branch@(CoAxBranch { cab_incomps = incomps })
-  = (coAxBranchToIfaceBranch' env0 branch) { ifaxbIncomps = iface_incomps }
+  = (coAxBranchToIfaceBranch' tc branch) { ifaxbIncomps = iface_incomps }
   where
     iface_incomps = map (expectJust "iface_incomps"
                         . (flip findIndex lhs_s
@@ -1529,63 +1554,91 @@ coAxBranchToIfaceBranch env0 lhs_s
                         . coAxBranchLHS) incomps
 
 -- use this one for standalone branches without incompatibles
-coAxBranchToIfaceBranch' :: TidyEnv -> CoAxBranch -> IfaceAxBranch
-coAxBranchToIfaceBranch' env0
-                        (CoAxBranch { cab_tvs = tvs, cab_lhs = lhs
-                                    , cab_roles = roles, cab_rhs = rhs })
+coAxBranchToIfaceBranch' :: TyCon -> CoAxBranch -> IfaceAxBranch
+coAxBranchToIfaceBranch' tc (CoAxBranch { cab_tvs = tvs, cab_lhs = lhs
+                                        , cab_roles = roles, cab_rhs = rhs })
   = IfaceAxBranch { ifaxbTyVars = toIfaceTvBndrs tv_bndrs
-                  , ifaxbLHS    = map (tidyToIfaceType env1) lhs
+                  , ifaxbLHS    = tidyToIfaceTcArgs env1 tc lhs
                   , ifaxbRoles  = roles
                   , ifaxbRHS    = tidyToIfaceType env1 rhs
                   , ifaxbIncomps = [] }
   where
-    (env1, tv_bndrs) = tidyTyClTyVarBndrs env0 tvs
+    (env1, tv_bndrs) = tidyTyClTyVarBndrs emptyTidyEnv tvs
     -- Don't re-bind in-scope tyvars
     -- See Note [CoAxBranch type variables] in CoAxiom
 
 -----------------
-tyConToIfaceDecl :: TidyEnv -> TyCon -> IfaceDecl
+tyConToIfaceDecl :: TidyEnv -> TyCon -> (TidyEnv, IfaceDecl)
 -- We *do* tidy TyCons, because they are not (and cannot
 -- conveniently be) built in tidy form
+-- The returned TidyEnv is the one after tidying the tyConTyVars
 tyConToIfaceDecl env tycon
   | Just clas <- tyConClass_maybe tycon
   = classToIfaceDecl env clas
 
   | Just syn_rhs <- synTyConRhs_maybe tycon
-  = IfaceSyn {  ifName    = getOccName tycon,
-                ifTyVars  = toIfaceTvBndrs tyvars,
-                ifRoles   = tyConRoles tycon,
-                ifSynRhs  = to_ifsyn_rhs syn_rhs,
-                ifSynKind = tidyToIfaceType env1 (synTyConResKind tycon) }
+  = ( tc_env1
+    , IfaceSyn {  ifName    = getOccName tycon,
+                  ifTyVars  = if_tc_tyvars,
+                  ifRoles   = tyConRoles tycon,
+                  ifSynRhs  = to_ifsyn_rhs syn_rhs,
+                  ifSynKind = tidyToIfaceType tc_env1 (synTyConResKind tycon) })
 
   | isAlgTyCon tycon
-  = IfaceData { ifName    = getOccName tycon,
-                ifCType   = tyConCType tycon,
-                ifTyVars  = toIfaceTvBndrs tyvars,
-                ifRoles   = tyConRoles tycon,
-                ifCtxt    = tidyToIfaceContext env1 (tyConStupidTheta tycon),
-                ifCons    = ifaceConDecls (algTyConRhs tycon),
-                ifRec     = boolToRecFlag (isRecursiveTyCon tycon),
-                ifGadtSyntax = isGadtSyntaxTyCon tycon,
-                ifPromotable = isJust (promotableTyCon_maybe tycon),
-                ifAxiom   = fmap coAxiomName (tyConFamilyCoercion_maybe tycon) }
+  = ( tc_env1
+    , IfaceData { ifName    = getOccName tycon,
+                  ifCType   = tyConCType tycon,
+                  ifTyVars  = if_tc_tyvars,
+                  ifRoles   = tyConRoles tycon,
+                  ifCtxt    = tidyToIfaceContext tc_env1 (tyConStupidTheta tycon),
+                  ifCons    = ifaceConDecls (algTyConRhs tycon),
+                  ifRec     = boolToRecFlag (isRecursiveTyCon tycon),
+                  ifGadtSyntax = isGadtSyntaxTyCon tycon,
+                  ifPromotable = isJust (promotableTyCon_maybe tycon),
+                  ifParent  = parent })
 
   | isForeignTyCon tycon
-  = IfaceForeign { ifName    = getOccName tycon,
-                   ifExtName = tyConExtName tycon }
-
-  | otherwise = pprPanic "toIfaceDecl" (ppr tycon)
+  = (env, IfaceForeign { ifName    = getOccName tycon,
+                         ifExtName = tyConExtName tycon })
+
+  | otherwise  -- FunTyCon, PrimTyCon, promoted TyCon/DataCon
+  -- For pretty printing purposes only.
+  = ( env
+    , IfaceData { ifName       = getOccName tycon,
+                  ifCType      = Nothing,
+                  ifTyVars     = funAndPrimTyVars,
+                  ifRoles      = tyConRoles tycon,
+                  ifCtxt       = [],
+                  ifCons       = IfDataTyCon [],
+                  ifRec        = boolToRecFlag False,
+                  ifGadtSyntax = False,
+                  ifPromotable = False,
+                  ifParent     = IfNoParent })
   where
-    (env1, tyvars) = tidyTyClTyVarBndrs env (tyConTyVars tycon)
+    (tc_env1, tc_tyvars) = tidyTyClTyVarBndrs env (tyConTyVars tycon)
+    if_tc_tyvars = toIfaceTvBndrs tc_tyvars
+
+    funAndPrimTyVars = toIfaceTvBndrs $ take (tyConArity tycon) alphaTyVars
+
+    parent = case tyConFamInstSig_maybe tycon of
+               Just (tc, ty, ax) -> IfDataInstance (coAxiomName ax)
+                                                   (toIfaceTyCon tc)
+                                                   (tidyToIfaceTcArgs tc_env1 tc ty)
+               Nothing           -> IfNoParent
+
+    to_ifsyn_rhs OpenSynFamilyTyCon        = IfaceOpenSynFamilyTyCon
+    to_ifsyn_rhs (ClosedSynFamilyTyCon ax) = IfaceClosedSynFamilyTyCon axn ibr
+      where defs = fromBranchList $ coAxiomBranches ax
+            ibr  = map (coAxBranchToIfaceBranch' tycon) defs
+            axn  = coAxiomName ax
+    to_ifsyn_rhs AbstractClosedSynFamilyTyCon
+      = IfaceAbstractClosedSynFamilyTyCon
 
-    to_ifsyn_rhs OpenSynFamilyTyCon           = IfaceOpenSynFamilyTyCon
-    to_ifsyn_rhs (ClosedSynFamilyTyCon ax)
-      = IfaceClosedSynFamilyTyCon (coAxiomName ax)
-    to_ifsyn_rhs AbstractClosedSynFamilyTyCon = IfaceAbstractClosedSynFamilyTyCon
     to_ifsyn_rhs (SynonymTyCon ty)
-      = IfaceSynonymTyCon (tidyToIfaceType env1 ty)
+      = IfaceSynonymTyCon (tidyToIfaceType tc_env1 ty)
 
-    to_ifsyn_rhs (BuiltInSynFamTyCon {}) = pprPanic "toIfaceDecl: BuiltInFamTyCon" (ppr tycon)
+    to_ifsyn_rhs (BuiltInSynFamTyCon {})
+      = IfaceBuiltInSynFamTyCon
 
 
     ifaceConDecls (NewTyCon { data_con = con })     = IfNewTyCon  (ifaceConDecl con)
@@ -1601,23 +1654,28 @@ tyConToIfaceDecl env tycon
         = IfCon   { ifConOcc     = getOccName (dataConName data_con),
                     ifConInfix   = dataConIsInfix data_con,
                     ifConWrapper = isJust (dataConWrapId_maybe data_con),
-                    ifConUnivTvs = toIfaceTvBndrs univ_tvs',
                     ifConExTvs   = toIfaceTvBndrs ex_tvs',
-                    ifConEqSpec  = to_eq_spec eq_spec,
-                    ifConCtxt    = tidyToIfaceContext env2 theta,
-                    ifConArgTys  = map (tidyToIfaceType env2) arg_tys,
+                    ifConEqSpec  = map to_eq_spec eq_spec,
+                    ifConCtxt    = tidyToIfaceContext con_env2 theta,
+                    ifConArgTys  = map (tidyToIfaceType con_env2) arg_tys,
                     ifConFields  = map getOccName
                                        (dataConFieldLabels data_con),
-                    ifConStricts = map (toIfaceBang env2) (dataConRepBangs data_con) }
+                    ifConStricts = map (toIfaceBang con_env2) (dataConRepBangs data_con) }
         where
           (univ_tvs, ex_tvs, eq_spec, theta, arg_tys, _) = dataConFullSig data_con
 
-          -- Start with 'emptyTidyEnv' not 'env1', because the type of the
-          -- data constructor is fully standalone
-          (env1, univ_tvs') = tidyTyVarBndrs emptyTidyEnv univ_tvs
-          (env2, ex_tvs')   = tidyTyVarBndrs env1 ex_tvs
-          to_eq_spec spec = [ (getOccName (tidyTyVar env2 tv), tidyToIfaceType env2 ty)
-                            | (tv,ty) <- spec]
+          -- Tidy the univ_tvs of the data constructor to be identical
+          -- to the tyConTyVars of the type constructor.  This means
+          -- (a) we don't need to redundantly put them into the interface file
+          -- (b) when pretty-printing an Iface data declaration in H98-style syntax,
+          --     we know that the type variables will line up
+          -- The latter (b) is important because we pretty-print type construtors
+          -- by converting to IfaceSyn and pretty-printing that
+          con_env1 = (fst tc_env1, mkVarEnv (zipEqual "ifaceConDecl" univ_tvs tc_tyvars))
+                     -- A bit grimy, perhaps, but it's simple!
+
+          (con_env2, ex_tvs') = tidyTyVarBndrs con_env1 ex_tvs
+          to_eq_spec (tv,ty)  = (toIfaceTyVar (tidyTyVar con_env2 tv), tidyToIfaceType con_env2 ty)
 
 toIfaceBang :: TidyEnv -> HsBang -> IfaceBang
 toIfaceBang _    HsNoBang            = IfNoBang
@@ -1626,17 +1684,18 @@ toIfaceBang env (HsUnpack (Just co)) = IfUnpackCo (toIfaceCoercion (tidyCo env c
 toIfaceBang _   HsStrict             = IfStrict
 toIfaceBang _   (HsUserBang {})      = panic "toIfaceBang"
 
-classToIfaceDecl :: TidyEnv -> Class -> IfaceDecl
+classToIfaceDecl :: TidyEnv -> Class -> (TidyEnv, IfaceDecl)
 classToIfaceDecl env clas
-  = IfaceClass { ifCtxt   = tidyToIfaceContext env1 sc_theta,
-                 ifName   = getOccName (classTyCon clas),
-                 ifTyVars = toIfaceTvBndrs clas_tyvars',
-                 ifRoles  = tyConRoles (classTyCon clas),
-                 ifFDs    = map toIfaceFD clas_fds,
-                 ifATs    = map toIfaceAT clas_ats,
-                 ifSigs   = map toIfaceClassOp op_stuff,
-                 ifMinDef = fmap getOccName (classMinimalDef clas),
-                 ifRec    = boolToRecFlag (isRecursiveTyCon tycon) }
+  = ( env1
+    , IfaceClass { ifCtxt   = tidyToIfaceContext env1 sc_theta,
+                   ifName   = getOccName (classTyCon clas),
+                   ifTyVars = toIfaceTvBndrs clas_tyvars',
+                   ifRoles  = tyConRoles (classTyCon clas),
+                   ifFDs    = map toIfaceFD clas_fds,
+                   ifATs    = map toIfaceAT clas_ats,
+                   ifSigs   = map toIfaceClassOp op_stuff,
+                   ifMinDef = fmap getFS (classMinimalDef clas),
+                   ifRec    = boolToRecFlag (isRecursiveTyCon tycon) })
   where
     (clas_tyvars, clas_fds, sc_theta, _, clas_ats, op_stuff)
       = classExtraBigSig clas
@@ -1645,8 +1704,10 @@ classToIfaceDecl env clas
     (env1, clas_tyvars') = tidyTyVarBndrs env clas_tyvars
 
     toIfaceAT :: ClassATItem -> IfaceAT
-    toIfaceAT (tc, defs)
-      = IfaceAT (tyConToIfaceDecl env1 tc) (map (coAxBranchToIfaceBranch' env1) defs)
+    toIfaceAT (ATI tc def)
+      = IfaceAT if_decl (fmap (tidyToIfaceType env2) def)
+      where
+        (env2, if_decl) = tyConToIfaceDecl env1 tc
 
     toIfaceClassOp (sel_id, def_meth)
         = ASSERT(sel_tyvars == clas_tyvars)
@@ -1672,6 +1733,9 @@ classToIfaceDecl env clas
 tidyToIfaceType :: TidyEnv -> Type -> IfaceType
 tidyToIfaceType env ty = toIfaceType (tidyType env ty)
 
+tidyToIfaceTcArgs :: TidyEnv -> TyCon -> [Type] -> IfaceTcArgs
+tidyToIfaceTcArgs env tc tys = toIfaceTcArgs tc (tidyTypes env tys)
+
 tidyToIfaceContext :: TidyEnv -> ThetaType -> IfaceContext
 tidyToIfaceContext env theta = map (tidyToIfaceType env) theta
 
@@ -1904,7 +1968,9 @@ toIfaceExpr (Tick t e)
 toIfaceTickish :: Tickish Id -> Maybe IfaceTickish
 toIfaceTickish (ProfNote cc tick push) = Just (IfaceSCC cc tick push)
 toIfaceTickish (HpcTick modl ix)       = Just (IfaceHpcTick modl ix)
-toIfaceTickish (Breakpoint {})         = Nothing 
+toIfaceTickish (SourceNote src names)  = Just (IfaceSource src names)
+toIfaceTickish (CoreNote {})           = Nothing
+toIfaceTickish (Breakpoint {})         = Nothing
    -- Ignore breakpoints, since they are relevant only to GHCi, and 
    -- should not be serialised (Trac #8333)
 
diff --git a/compiler/iface/TcIface.lhs b/compiler/iface/TcIface.lhs
index 20adfe5896be..4d94ab8d7b01 100644
--- a/compiler/iface/TcIface.lhs
+++ b/compiler/iface/TcIface.lhs
@@ -6,14 +6,15 @@
 Type checking of type signatures in interface files
 
 \begin{code}
+{-# LANGUAGE CPP #-}
+
 module TcIface (
         tcLookupImported_maybe,
         importDecl, checkWiredInTyCon, tcHiBootIface, typecheckIface,
         tcIfaceDecl, tcIfaceInst, tcIfaceFamInst, tcIfaceRules,
         tcIfaceVectInfo, tcIfaceAnnotations,
         tcIfaceExpr,    -- Desired by HERMIT (Trac #7683)
-        tcIfaceGlobal,
-        tcExtCoreBindings
+        tcIfaceGlobal
  ) where
 
 #include "HsVersions.h"
@@ -343,26 +344,34 @@ tcHiBootIface hsc_src mod
           else do
 
         -- OK, so we're in one-shot mode.
-        -- In that case, we're read all the direct imports by now,
-        -- so eps_is_boot will record if any of our imports mention us by
-        -- way of hi-boot file
-        { eps <- getEps
-        ; case lookupUFM (eps_is_boot eps) (moduleName mod) of {
-            Nothing -> return emptyModDetails ; -- The typical case
+        -- Re #9245, we always check if there is an hi-boot interface
+        -- to check consistency against, rather than just when we notice
+        -- that an hi-boot is necessary due to a circular import.
+        { read_result <- findAndReadIface
+                                need mod
+                                True    -- Hi-boot file
 
-            Just (_, False) -> failWithTc moduleLoop ;
+        ; case read_result of {
+                Succeeded (iface, _path) -> typecheckIface iface ;
+                Failed err               ->
+
+        -- There was no hi-boot file. But if there is circularity in
+        -- the module graph, there really should have been one.
+        -- Since we've read all the direct imports by now,
+        -- eps_is_boot will record if any of our imports mention the
+        -- current module, which either means a module loop (not
+        -- a SOURCE import) or that our hi-boot file has mysteriously
+        -- disappeared.
+    do  { eps <- getEps
+        ; case lookupUFM (eps_is_boot eps) (moduleName mod) of
+            Nothing -> return emptyModDetails -- The typical case
+
+            Just (_, False) -> failWithTc moduleLoop
                 -- Someone below us imported us!
                 -- This is a loop with no hi-boot in the way
 
-            Just (_mod, True) ->        -- There's a hi-boot interface below us
-
-    do  { read_result <- findAndReadIface
-                                need mod
-                                True    -- Hi-boot file
-
-        ; case read_result of
-                Failed err               -> failWithTc (elaborate err)
-                Succeeded (iface, _path) -> typecheckIface iface
+            Just (_mod, True) -> failWithTc (elaborate err)
+                -- The hi-boot file has mysteriously disappeared.
     }}}}
   where
     need = ptext (sLit "Need the hi-boot interface for") <+> ppr mod
@@ -451,41 +460,26 @@ tc_iface_decl parent _ (IfaceData {ifName = occ_name,
                           ifCtxt = ctxt, ifGadtSyntax = gadt_syn,
                           ifCons = rdr_cons,
                           ifRec = is_rec, ifPromotable = is_prom,
-                          ifAxiom = mb_axiom_name })
+                          ifParent = mb_parent })
   = bindIfaceTyVars_AT tv_bndrs $ \ tyvars -> do
     { tc_name <- lookupIfaceTop occ_name
     ; tycon <- fixM $ \ tycon -> do
             { stupid_theta <- tcIfaceCtxt ctxt
-            ; parent' <- tc_parent tyvars mb_axiom_name
+            ; parent' <- tc_parent mb_parent
             ; cons <- tcIfaceDataCons tc_name tycon tyvars rdr_cons
             ; return (buildAlgTyCon tc_name tyvars roles cType stupid_theta
                                     cons is_rec is_prom gadt_syn parent') }
     ; traceIf (text "tcIfaceDecl4" <+> ppr tycon)
     ; return (ATyCon tycon) }
   where
-    tc_parent :: [TyVar] -> Maybe Name -> IfL TyConParent
-    tc_parent _ Nothing = return parent
-    tc_parent tyvars (Just ax_name)
+    tc_parent :: IfaceTyConParent -> IfL TyConParent
+    tc_parent IfNoParent = return parent
+    tc_parent (IfDataInstance ax_name _ arg_tys)
       = ASSERT( isNoParent parent )
         do { ax <- tcIfaceCoAxiom ax_name
-           ; let fam_tc = coAxiomTyCon ax
+           ; let fam_tc  = coAxiomTyCon ax
                  ax_unbr = toUnbranchedAxiom ax
-                 -- data families don't have branches:
-                 branch    = coAxiomSingleBranch ax_unbr
-                 ax_tvs    = coAxBranchTyVars branch
-                 ax_lhs    = coAxBranchLHS branch
-                 tycon_tys = mkTyVarTys tyvars
-                 subst     = mkTopTvSubst (ax_tvs `zip` tycon_tys)
-                            -- The subst matches the tyvar of the TyCon
-                            -- with those from the CoAxiom.  They aren't
-                            -- necessarily the same, since the two may be
-                            -- gotten from separate interface-file declarations
-                            -- NB: ax_tvs may be shorter because of eta-reduction
-                            -- See Note [Eta reduction for data family axioms] in TcInstDcls
-                 lhs_tys = substTys subst ax_lhs `chkAppend`
-                           dropList ax_tvs tycon_tys
-                            -- The 'lhs_tys' should be 1-1 with the 'tyvars'
-                            -- but ax_tvs maybe shorter because of eta-reduction
+           ; lhs_tys <- tcIfaceTcArgs arg_tys
            ; return (FamInstTyCon ax_unbr fam_tc lhs_tys) }
 
 tc_iface_decl parent _ (IfaceSyn {ifName = occ_name, ifTyVars = tv_bndrs,
@@ -502,12 +496,14 @@ tc_iface_decl parent _ (IfaceSyn {ifName = occ_name, ifTyVars = tv_bndrs,
    where
      mk_doc n = ptext (sLit "Type syonym") <+> ppr n
      tc_syn_rhs IfaceOpenSynFamilyTyCon   = return OpenSynFamilyTyCon
-     tc_syn_rhs (IfaceClosedSynFamilyTyCon ax_name)
+     tc_syn_rhs (IfaceClosedSynFamilyTyCon ax_name _)
        = do { ax <- tcIfaceCoAxiom ax_name
             ; return (ClosedSynFamilyTyCon ax) }
      tc_syn_rhs IfaceAbstractClosedSynFamilyTyCon = return AbstractClosedSynFamilyTyCon
      tc_syn_rhs (IfaceSynonymTyCon ty)    = do { rhs_ty <- tcIfaceType ty
                                                ; return (SynonymTyCon rhs_ty) }
+     tc_syn_rhs IfaceBuiltInSynFamTyCon   = pprPanic "tc_iface_decl"
+                                               (ptext (sLit "IfaceBuiltInSynFamTyCon in interface file"))
 
 tc_iface_decl _parent ignore_prags
             (IfaceClass {ifCtxt = rdr_ctxt, ifName = tc_occ,
@@ -524,11 +520,11 @@ tc_iface_decl _parent ignore_prags
     ; sigs <- mapM tc_sig rdr_sigs
     ; fds  <- mapM tc_fd rdr_fds
     ; traceIf (text "tc-iface-class3" <+> ppr tc_occ)
-    ; mindef <- traverse lookupIfaceTop mindef_occ
+    ; mindef <- traverse (lookupIfaceTop . mkVarOccFS) mindef_occ
     ; cls  <- fixM $ \ cls -> do
               { ats  <- mapM (tc_at cls) rdr_ats
               ; traceIf (text "tc-iface-class4" <+> ppr tc_occ)
-              ; buildClass ignore_prags tc_name tyvars roles ctxt fds ats sigs mindef tc_isrec }
+              ; buildClass tc_name tyvars roles ctxt fds ats sigs mindef tc_isrec }
     ; return (ATyCon (classTyCon cls)) }
   where
    tc_sc pred = forkM (mk_sc_doc pred) (tcIfaceType pred)
@@ -548,13 +544,18 @@ tc_iface_decl _parent ignore_prags
                 -- it mentions unless it's necessary to do so
           ; return (op_name, dm, op_ty) }
 
-   tc_at cls (IfaceAT tc_decl defs_decls)
+   tc_at cls (IfaceAT tc_decl if_def)
      = do ATyCon tc <- tc_iface_decl (AssocFamilyTyCon cls) ignore_prags tc_decl
-          defs <- forkM (mk_at_doc tc) (tc_ax_branches tc defs_decls)
+          mb_def <- case if_def of
+                      Nothing  -> return Nothing
+                      Just def -> forkM (mk_at_doc tc)                 $
+                                  extendIfaceTyVarEnv (tyConTyVars tc) $
+                                  do { tc_def <- tcIfaceType def
+                                     ; return (Just tc_def) }
                   -- Must be done lazily in case the RHS of the defaults mention
                   -- the type constructor being defined here
                   -- e.g.   type AT a; type AT b = AT [b]   Trac #8002
-          return (tc, defs)
+          return (ATI tc mb_def)
 
    mk_sc_doc pred = ptext (sLit "Superclass") <+> ppr pred
    mk_at_doc tc = ptext (sLit "Associated type") <+> ppr tc
@@ -573,9 +574,8 @@ tc_iface_decl _ _ (IfaceAxiom { ifName = ax_occ, ifTyCon = tc
                               , ifAxBranches = branches, ifRole = role })
   = do { tc_name     <- lookupIfaceTop ax_occ
        ; tc_tycon    <- tcIfaceTyCon tc
-       ; tc_branches <- tc_ax_branches tc_tycon branches
-       ; let axiom = computeAxiomIncomps $
-                     CoAxiom { co_ax_unique   = nameUnique tc_name
+       ; tc_branches <- tc_ax_branches branches
+       ; let axiom = CoAxiom { co_ax_unique   = nameUnique tc_name
                              , co_ax_name     = tc_name
                              , co_ax_tc       = tc_tycon
                              , co_ax_role     = role
@@ -584,7 +584,8 @@ tc_iface_decl _ _ (IfaceAxiom { ifName = ax_occ, ifTyCon = tc
        ; return (ACoAxiom axiom) }
 
 tc_iface_decl _ _ (IfacePatSyn{ ifName = occ_name
-                              , ifPatHasWrapper = has_wrapper
+                              , ifPatMatcher = matcher_name
+                              , ifPatWrapper = wrapper_name
                               , ifPatIsInfix = is_infix
                               , ifPatUnivTvs = univ_tvs
                               , ifPatExTvs = ex_tvs
@@ -594,31 +595,35 @@ tc_iface_decl _ _ (IfacePatSyn{ ifName = occ_name
                               , ifPatTy = pat_ty })
   = do { name <- lookupIfaceTop occ_name
        ; traceIf (ptext (sLit "tc_iface_decl") <+> ppr name)
+       ; matcher <- tcExt "Matcher" matcher_name
+       ; wrapper <- case wrapper_name of
+                        Nothing -> return Nothing
+                        Just wn -> do { wid <- tcExt "Wrapper" wn
+                                      ; return (Just wid) }
        ; bindIfaceTyVars univ_tvs $ \univ_tvs -> do
        { bindIfaceTyVars ex_tvs $ \ex_tvs -> do
-       { bindIfaceIdVars args $ \args -> do
-       { ~(prov_theta, req_theta, pat_ty) <- forkM (mk_doc name) $
+       { patsyn <- forkM (mk_doc name) $
              do { prov_theta <- tcIfaceCtxt prov_ctxt
                 ; req_theta  <- tcIfaceCtxt req_ctxt
                 ; pat_ty     <- tcIfaceType pat_ty
-                ; return (prov_theta, req_theta, pat_ty) }
-       ; bindIfaceTyVar (fsLit "r", toIfaceKind liftedTypeKind) $ \tv -> do
-       { patsyn <- buildPatSyn name is_infix has_wrapper args univ_tvs ex_tvs prov_theta req_theta pat_ty tv
-       ; return (AConLike (PatSynCon patsyn)) }}}}}
+                ; arg_tys    <- mapM tcIfaceType args
+                ; return $ buildPatSyn name is_infix matcher wrapper
+                                       arg_tys univ_tvs ex_tvs prov_theta req_theta pat_ty }
+       ; return $ AConLike . PatSynCon $ patsyn }}}
   where
      mk_doc n = ptext (sLit "Pattern synonym") <+> ppr n
+     tcExt s name = forkM (ptext (sLit s) <+> ppr name) $ tcIfaceExtId name
 
+tc_ax_branches :: [IfaceAxBranch] -> IfL [CoAxBranch]
+tc_ax_branches if_branches = foldlM tc_ax_branch [] if_branches
 
-tc_ax_branches :: TyCon -> [IfaceAxBranch] -> IfL [CoAxBranch]
-tc_ax_branches tc if_branches = foldlM (tc_ax_branch (tyConKind tc)) [] if_branches
-
-tc_ax_branch :: Kind -> [CoAxBranch] -> IfaceAxBranch -> IfL [CoAxBranch]
-tc_ax_branch tc_kind prev_branches
+tc_ax_branch :: [CoAxBranch] -> IfaceAxBranch -> IfL [CoAxBranch]
+tc_ax_branch prev_branches
              (IfaceAxBranch { ifaxbTyVars = tv_bndrs, ifaxbLHS = lhs, ifaxbRHS = rhs
                             , ifaxbRoles = roles, ifaxbIncomps = incomps })
   = bindIfaceTyVars_AT tv_bndrs $ \ tvs -> do
          -- The _AT variant is needed here; see Note [CoAxBranch type variables] in CoAxiom
-    { tc_lhs <- tcIfaceTcArgs tc_kind lhs   -- See Note [Checking IfaceTypes vs IfaceKinds]
+    { tc_lhs <- tcIfaceTcArgs lhs   -- See Note [Checking IfaceTypes vs IfaceKinds]
     ; tc_rhs <- tcIfaceType rhs
     ; let br = CoAxBranch { cab_loc     = noSrcSpan
                           , cab_tvs     = tvs
@@ -629,7 +634,7 @@ tc_ax_branch tc_kind prev_branches
     ; return (prev_branches ++ [br]) }
 
 tcIfaceDataCons :: Name -> TyCon -> [TyVar] -> IfaceConDecls -> IfL AlgTyConRhs
-tcIfaceDataCons tycon_name tycon _ if_cons
+tcIfaceDataCons tycon_name tycon tc_tyvars if_cons
   = case if_cons of
         IfAbstractTyCon dis -> return (AbstractTyCon dis)
         IfDataFamTyCon  -> return DataFamilyTyCon
@@ -639,11 +644,12 @@ tcIfaceDataCons tycon_name tycon _ if_cons
                                 ; mkNewTyConRhs tycon_name tycon data_con }
   where
     tc_con_decl (IfCon { ifConInfix = is_infix,
-                         ifConUnivTvs = univ_tvs, ifConExTvs = ex_tvs,
+                         ifConExTvs = ex_tvs,
                          ifConOcc = occ, ifConCtxt = ctxt, ifConEqSpec = spec,
                          ifConArgTys = args, ifConFields = field_lbls,
                          ifConStricts = if_stricts})
-     = bindIfaceTyVars univ_tvs $ \ univ_tyvars -> do
+     = -- Universally-quantified tyvars are shared with 
+       -- parent TyCon, and are alrady in scope
        bindIfaceTyVars ex_tvs    $ \ ex_tyvars -> do
         { traceIf (text "Start interface-file tc_con_decl" <+> ppr occ)
         ; name  <- lookupIfaceTop occ
@@ -665,12 +671,12 @@ tcIfaceDataCons tycon_name tycon _ if_cons
 
         -- Remember, tycon is the representation tycon
         ; let orig_res_ty = mkFamilyTyConApp tycon
-                                (substTyVars (mkTopTvSubst eq_spec) univ_tyvars)
+                                (substTyVars (mkTopTvSubst eq_spec) tc_tyvars)
 
         ; con <- buildDataCon (pprPanic "tcIfaceDataCons: FamInstEnvs" (ppr name))
                        name is_infix
                        stricts lbl_names
-                       univ_tyvars ex_tyvars
+                       tc_tyvars ex_tyvars
                        eq_spec theta
                        arg_tys orig_res_ty tycon
         ; traceIf (text "Done interface-file tc_con_decl" <+> ppr name)
@@ -683,11 +689,11 @@ tcIfaceDataCons tycon_name tycon _ if_cons
     tc_strict (IfUnpackCo if_co) = do { co <- tcIfaceCo if_co
                                       ; return (HsUnpack (Just co)) }
 
-tcIfaceEqSpec :: [(OccName, IfaceType)] -> IfL [(TyVar, Type)]
+tcIfaceEqSpec :: IfaceEqSpec -> IfL [(TyVar, Type)]
 tcIfaceEqSpec spec
   = mapM do_item spec
   where
-    do_item (occ, if_ty) = do { tv <- tcIfaceTyVar (occNameFS occ)
+    do_item (occ, if_ty) = do { tv <- tcIfaceTyVar occ
                               ; ty <- tcIfaceType if_ty
                               ; return (tv,ty) }
 \end{code}
@@ -958,25 +964,38 @@ tcIfaceType :: IfaceType -> IfL Type
 tcIfaceType (IfaceTyVar n)         = do { tv <- tcIfaceTyVar n; return (TyVarTy tv) }
 tcIfaceType (IfaceAppTy t1 t2)     = do { t1' <- tcIfaceType t1; t2' <- tcIfaceType t2; return (AppTy t1' t2') }
 tcIfaceType (IfaceLitTy l)         = do { l1 <- tcIfaceTyLit l; return (LitTy l1) }
-tcIfaceType (IfaceFunTy t1 t2)     = do { t1' <- tcIfaceType t1; t2' <- tcIfaceType t2; return (FunTy t1' t2') }
+tcIfaceType (IfaceFunTy t1 t2)     = tcIfaceTypeFun t1 t2
+tcIfaceType (IfaceDFunTy t1 t2)    = tcIfaceTypeFun t1 t2
 tcIfaceType (IfaceTyConApp tc tks) = do { tc' <- tcIfaceTyCon tc
-                                        ; tks' <- tcIfaceTcArgs (tyConKind tc') tks
+                                        ; tks' <- tcIfaceTcArgs tks
                                         ; return (mkTyConApp tc' tks') }
 tcIfaceType (IfaceForAllTy tv t)  = bindIfaceTyVar tv $ \ tv' -> do { t' <- tcIfaceType t; return (ForAllTy tv' t') }
 
-tcIfaceTypes :: [IfaceType] -> IfL [Type]
-tcIfaceTypes tys = mapM tcIfaceType tys
-
-tcIfaceTcArgs :: Kind -> [IfaceType] -> IfL [Type]
-tcIfaceTcArgs _ []
-  = return []
-tcIfaceTcArgs kind (tk:tks)
-  = case splitForAllTy_maybe kind of
-      Nothing         -> tcIfaceTypes (tk:tks)
-      Just (_, kind') -> do { k'   <- tcIfaceKind tk
-                            ; tks' <- tcIfaceTcArgs kind' tks
-                            ; return (k':tks') }
-
+tcIfaceTypeFun :: IfaceType -> IfaceType -> IfL Type
+tcIfaceTypeFun t1 t2 = do { t1' <- tcIfaceType t1; t2' <- tcIfaceType t2; return (FunTy t1' t2') }
+
+tcIfaceKind :: IfaceKind -> IfL Type
+tcIfaceKind (IfaceAppTy t1 t2)  = do { t1' <- tcIfaceKind t1; t2' <- tcIfaceKind t2; return (AppTy t1' t2') }
+tcIfaceKind (IfaceFunTy t1 t2)  = tcIfaceKindFun t1 t2
+tcIfaceKind (IfaceDFunTy t1 t2) = tcIfaceKindFun t1 t2
+tcIfaceKind (IfaceLitTy l)      = pprPanic "tcIfaceKind" (ppr l)
+tcIfaceKind k                   = tcIfaceType k
+
+tcIfaceKindFun :: IfaceKind -> IfaceKind -> IfL Type
+tcIfaceKindFun t1 t2 = do { t1' <- tcIfaceKind t1; t2' <- tcIfaceKind t2; return (FunTy t1' t2') }
+
+tcIfaceTcArgs :: IfaceTcArgs -> IfL [Type]
+tcIfaceTcArgs args
+  = case args of
+      ITC_Type t ts ->
+        do { t'  <- tcIfaceType t
+           ; ts' <- tcIfaceTcArgs ts
+           ; return (t':ts') }
+      ITC_Kind k ks ->
+        do { k'  <- tcIfaceKind k
+           ; ks' <- tcIfaceTcArgs ks
+           ; return (k':ks') }
+      ITC_Nil -> return []
 -----------------------------------------
 tcIfaceCtxt :: IfaceContext -> IfL ThetaType
 tcIfaceCtxt sts = mapM tcIfaceType sts
@@ -985,43 +1004,8 @@ tcIfaceCtxt sts = mapM tcIfaceType sts
 tcIfaceTyLit :: IfaceTyLit -> IfL TyLit
 tcIfaceTyLit (IfaceNumTyLit n) = return (NumTyLit n)
 tcIfaceTyLit (IfaceStrTyLit n) = return (StrTyLit n)
-
------------------------------------------
-tcIfaceKind :: IfaceKind -> IfL Kind   -- See Note [Checking IfaceTypes vs IfaceKinds]
-tcIfaceKind (IfaceTyVar n)        = do { tv <- tcIfaceTyVar n; return (TyVarTy tv) }
-tcIfaceKind (IfaceAppTy t1 t2)    = do { t1' <- tcIfaceKind t1; t2' <- tcIfaceKind t2; return (AppTy t1' t2') }
-tcIfaceKind (IfaceFunTy t1 t2)    = do { t1' <- tcIfaceKind t1; t2' <- tcIfaceKind t2; return (FunTy t1' t2') }
-tcIfaceKind (IfaceTyConApp tc ts) = do { tc' <- tcIfaceKindCon tc; ts' <- tcIfaceKinds ts; return (mkTyConApp tc' ts') }
-tcIfaceKind (IfaceForAllTy tv t)  = bindIfaceTyVar tv $ \ tv' -> do { t' <- tcIfaceKind t; return (ForAllTy tv' t') }
-tcIfaceKind t                     = pprPanic "tcIfaceKind" (ppr t)  -- IfaceCoApp, IfaceLitTy
-
-tcIfaceKinds :: [IfaceKind] -> IfL [Kind]
-tcIfaceKinds tys = mapM tcIfaceKind tys
 \end{code}
 
-Note [Checking IfaceTypes vs IfaceKinds]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-We need to know whether we are checking a *type* or a *kind*.
-Consider   module M where
-             Proxy :: forall k. k -> *
-             data T = T
-and consider the two IfaceTypes
-      M.Proxy * M.T{tc}
-      M.Proxy 'M.T{tc} 'M.T(d}
-The first is conventional, but in the latter we use the promoted
-type constructor (as a kind) and data constructor (as a type).  However,
-the Name of the promoted type constructor is just M.T; it's the *same name*
-as the ordinary type constructor.
-
-We could add a "promoted" flag to an IfaceTyCon, but that's a bit heavy.
-Instead we use context to distinguish, as in the source language.
-  - When checking a kind, we look up M.T{tc} and promote it
-  - When checking a type, we look up M.T{tc} and don't promote it
-                                 and M.T{d}  and promote it
-    See tcIfaceKindCon and tcIfaceKTyCon respectively
-
-This context business is why we need tcIfaceTcArgs, and tcIfaceApps
-
 
 %************************************************************************
 %*                                                                      *
@@ -1170,8 +1154,14 @@ tcIfaceExpr (IfaceLet (IfaceRec pairs) body)
 
 tcIfaceExpr (IfaceTick tickish expr) = do
     expr' <- tcIfaceExpr expr
-    tickish' <- tcIfaceTickish tickish
-    return (Tick tickish' expr')
+    -- If debug flag is not set: Ignore source notes
+    dbgFlag <- fmap (gopt Opt_Debug) getDynFlags
+    case tickish of
+      IfaceSource{} | not dbgFlag
+                    -> return expr'
+      _otherwise    -> do
+        tickish' <- tcIfaceTickish tickish
+        return (Tick tickish' expr')
 
 -------------------------
 tcIfaceApps :: IfaceExpr -> IfaceExpr -> IfL CoreExpr
@@ -1187,7 +1177,7 @@ tcIfaceApps fun arg
     go_up fun _ [] = return fun
     go_up fun fun_ty (IfaceType t : args)
        | Just (tv,body_ty) <- splitForAllTy_maybe fun_ty
-       = do { t' <- if isKindVar tv  -- See Note [Checking IfaceTypes vs IfaceKinds]
+       = do { t' <- if isKindVar tv
                     then tcIfaceKind t
                     else tcIfaceType t
             ; let fun_ty' = substTyWith [tv] [t'] body_ty
@@ -1202,6 +1192,7 @@ tcIfaceApps fun arg
 tcIfaceTickish :: IfaceTickish -> IfM lcl (Tickish Id)
 tcIfaceTickish (IfaceHpcTick modl ix)   = return (HpcTick modl ix)
 tcIfaceTickish (IfaceSCC  cc tick push) = return (ProfNote cc tick push)
+tcIfaceTickish (IfaceSource src name)   = return (SourceNote src name)
 
 -------------------------
 tcIfaceLit :: Literal -> IfL Literal
@@ -1252,30 +1243,6 @@ tcIfaceDataAlt con inst_tys arg_strs rhs
 \end{code}
 
 
-\begin{code}
-tcExtCoreBindings :: [IfaceBinding] -> IfL CoreProgram  -- Used for external core
-tcExtCoreBindings []     = return []
-tcExtCoreBindings (b:bs) = do_one b (tcExtCoreBindings bs)
-
-do_one :: IfaceBinding -> IfL [CoreBind] -> IfL [CoreBind]
-do_one (IfaceNonRec bndr rhs) thing_inside
-  = do  { rhs' <- tcIfaceExpr rhs
-        ; bndr' <- newExtCoreBndr bndr
-        ; extendIfaceIdEnv [bndr'] $ do
-        { core_binds <- thing_inside
-        ; return (NonRec bndr' rhs' : core_binds) }}
-
-do_one (IfaceRec pairs) thing_inside
-  = do  { bndrs' <- mapM newExtCoreBndr bndrs
-        ; extendIfaceIdEnv bndrs' $ do
-        { rhss' <- mapM tcIfaceExpr rhss
-        ; core_binds <- thing_inside
-        ; return (Rec (bndrs' `zip` rhss') : core_binds) }}
-  where
-    (bndrs,rhss) = unzip pairs
-\end{code}
-
-
 %************************************************************************
 %*                                                                      *
                 IdInfo
@@ -1458,26 +1425,19 @@ tcIfaceGlobal name
 -- emasculated form (e.g. lacking data constructors).
 
 tcIfaceTyCon :: IfaceTyCon -> IfL TyCon
-tcIfaceTyCon (IfaceTc name)
-  = do { thing <- tcIfaceGlobal name
-       ; case thing of    -- A "type constructor" can be a promoted data constructor
-                          --           c.f. Trac #5881
-           ATyCon   tc               -> return tc
-           AConLike (RealDataCon dc) -> return (promoteDataCon dc)
-           _ -> pprPanic "tcIfaceTyCon" (ppr name $$ ppr thing) }
-
-tcIfaceKindCon :: IfaceTyCon -> IfL TyCon
-tcIfaceKindCon (IfaceTc name)
-  = do { thing <- tcIfaceGlobal name
-       ; case thing of    -- A "type constructor" here is a promoted type constructor
-                          --           c.f. Trac #5881
-           ATyCon tc
-             | isSuperKind (tyConKind tc)
-             -> return tc   -- Mainly just '*' or 'AnyK'
-             | Just prom_tc <- promotableTyCon_maybe tc
-             -> return prom_tc
-
-           _ -> pprPanic "tcIfaceKindCon" (ppr name $$ ppr thing) }
+tcIfaceTyCon itc
+  = do {
+    ; thing <- tcIfaceGlobal (ifaceTyConName itc)
+    ; case itc of
+        IfaceTc _ -> return $ tyThingTyCon thing
+        IfacePromotedDataCon _ -> return $ promoteDataCon $ tyThingDataCon thing
+        IfacePromotedTyCon name ->
+          let ktycon tc
+                | isSuperKind (tyConKind tc) = return tc
+                | Just prom_tc <- promotableTyCon_maybe tc = return prom_tc
+                | otherwise = pprPanic "tcIfaceTyCon" (ppr name $$ ppr thing)
+          in ktycon (tyThingTyCon thing)
+    }
 
 tcIfaceCoAxiom :: Name -> IfL (CoAxiom Branched)
 tcIfaceCoAxiom name = do { thing <- tcIfaceGlobal name
@@ -1519,14 +1479,6 @@ bindIfaceBndrs (b:bs) thing_inside
     bindIfaceBndrs bs   $ \ bs' ->
     thing_inside (b':bs')
 
------------------------
-newExtCoreBndr :: IfaceLetBndr -> IfL Id
-newExtCoreBndr (IfLetBndr var ty _)    -- Ignoring IdInfo for now
-  = do  { mod <- getIfModule
-        ; name <- newGlobalBinder mod (mkVarOccFS var) noSrcSpan
-        ; ty' <- tcIfaceType ty
-        ; return (mkLocalId name ty') }
-
 -----------------------
 bindIfaceTyVar :: IfaceTvBndr -> (TyVar -> IfL a) -> IfL a
 bindIfaceTyVar (occ,kind) thing_inside
@@ -1548,22 +1500,8 @@ bindIfaceTyVars bndrs thing_inside
   where
     (occs,kinds) = unzip bndrs
 
-bindIfaceIdVar :: IfaceIdBndr -> (Id -> IfL a) -> IfL a
-bindIfaceIdVar (occ, ty) thing_inside
-  = do  { name <- newIfaceName (mkVarOccFS occ)
-        ; ty' <- tcIfaceType ty
-        ; let id = mkLocalId name ty'
-        ; extendIfaceIdEnv [id] (thing_inside id) }
-
-bindIfaceIdVars :: [IfaceIdBndr] -> ([Id] -> IfL a) -> IfL a
-bindIfaceIdVars []     thing_inside = thing_inside []
-bindIfaceIdVars (v:vs) thing_inside
-  = bindIfaceIdVar v     $ \ v' ->
-    bindIfaceIdVars vs   $ \ vs' ->
-    thing_inside (v':vs')
-
 isSuperIfaceKind :: IfaceKind -> Bool
-isSuperIfaceKind (IfaceTyConApp (IfaceTc n) []) = n == superKindTyConName
+isSuperIfaceKind (IfaceTyConApp tc ITC_Nil) = ifaceTyConName tc == superKindTyConName
 isSuperIfaceKind _ = False
 
 mk_iface_tyvar :: Name -> IfaceKind -> IfL TyVar
diff --git a/compiler/llvmGen/Llvm/AbsSyn.hs b/compiler/llvmGen/Llvm/AbsSyn.hs
index f92bd89c5cd6..24d0856ea32e 100644
--- a/compiler/llvmGen/Llvm/AbsSyn.hs
+++ b/compiler/llvmGen/Llvm/AbsSyn.hs
@@ -65,6 +65,8 @@ data LlvmFunction = LlvmFunction {
 
 type LlvmFunctions = [LlvmFunction]
 
+type SingleThreaded = Bool
+
 -- | LLVM ordering types for synchronization purposes. (Introduced in LLVM
 -- 3.0). Please see the LLVM documentation for a better description.
 data LlvmSyncOrdering
@@ -223,6 +225,11 @@ data LlvmExpression
   -}
   | Load LlvmVar
 
+  {- |
+    Atomic load of the value at location ptr
+  -}
+  | ALoad LlvmSyncOrdering SingleThreaded LlvmVar
+
   {- |
     Navigate in an structure, selecting elements
       * inbound: Is the pointer inbounds? (computed pointer doesn't overflow)
diff --git a/compiler/llvmGen/Llvm/PpLlvm.hs b/compiler/llvmGen/Llvm/PpLlvm.hs
index b8343ceff361..73077257f89a 100644
--- a/compiler/llvmGen/Llvm/PpLlvm.hs
+++ b/compiler/llvmGen/Llvm/PpLlvm.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE CPP #-}
+
 --------------------------------------------------------------------------------
 -- | Pretty print LLVM IR Code.
 --
@@ -237,6 +239,7 @@ ppLlvmExpression expr
         Insert     vec elt idx      -> ppInsert vec elt idx
         GetElemPtr inb ptr indexes  -> ppGetElementPtr inb ptr indexes
         Load       ptr              -> ppLoad ptr
+        ALoad      ord st ptr       -> ppALoad ord st ptr
         Malloc     tp amount        -> ppMalloc tp amount
         Phi        tp precessors    -> ppPhi tp precessors
         Asm        asm c ty v se sk -> ppAsm asm c ty v se sk
@@ -325,13 +328,18 @@ ppSyncOrdering SyncSeqCst    = text "seq_cst"
 -- of specifying alignment.
 
 ppLoad :: LlvmVar -> SDoc
-ppLoad var
-    | isVecPtrVar var = text "load" <+> ppr var <>
-                        comma <+> text "align 1"
-    | otherwise       = text "load" <+> ppr var
+ppLoad var = text "load" <+> ppr var <> align
   where
-    isVecPtrVar :: LlvmVar -> Bool
-    isVecPtrVar = isVector . pLower . getVarType
+    align | isVector . pLower . getVarType $ var = text ", align 1"
+          | otherwise = empty
+
+ppALoad :: LlvmSyncOrdering -> SingleThreaded -> LlvmVar -> SDoc
+ppALoad ord st var = sdocWithDynFlags $ \dflags ->
+  let alignment = (llvmWidthInBits dflags $ getVarType var) `quot` 8
+      align     = text ", align" <+> ppr alignment
+      sThreaded | st        = text " singlethread"
+                | otherwise = empty
+  in text "load atomic" <+> ppr var <> sThreaded <+> ppSyncOrdering ord <> align
 
 ppStore :: LlvmVar -> LlvmVar -> SDoc
 ppStore val dst
diff --git a/compiler/llvmGen/Llvm/Types.hs b/compiler/llvmGen/Llvm/Types.hs
index 6b9c8c181a26..89b0e4e14179 100644
--- a/compiler/llvmGen/Llvm/Types.hs
+++ b/compiler/llvmGen/Llvm/Types.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE CPP, GeneralizedNewtypeDeriving #-}
 
 --------------------------------------------------------------------------------
 -- | The LLVM Type System.
diff --git a/compiler/llvmGen/LlvmCodeGen.hs b/compiler/llvmGen/LlvmCodeGen.hs
index d0f343fa925b..dd16e5286854 100644
--- a/compiler/llvmGen/LlvmCodeGen.hs
+++ b/compiler/llvmGen/LlvmCodeGen.hs
@@ -1,7 +1,8 @@
+{-# LANGUAGE CPP, TypeFamilies #-}
+
 -- -----------------------------------------------------------------------------
 -- | This is the top-level module in the LLVM code generator.
 --
-
 module LlvmCodeGen ( llvmCodeGen, llvmFixupAsm ) where
 
 #include "HsVersions.h"
diff --git a/compiler/llvmGen/LlvmCodeGen/Base.hs b/compiler/llvmGen/LlvmCodeGen/Base.hs
index 5d5f385ade29..50cd824b2481 100644
--- a/compiler/llvmGen/LlvmCodeGen/Base.hs
+++ b/compiler/llvmGen/LlvmCodeGen/Base.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE CPP #-}
+
 -- ----------------------------------------------------------------------------
 -- | Base LLVM Code Generation module
 --
@@ -404,7 +406,7 @@ strDisplayName_llvm lbl = do
     dflags <- getDynFlags
     let sdoc = pprCLabel platform lbl
         depth = Outp.PartWay 1
-        style = Outp.mkUserStyle (\ _ _ -> Outp.NameNotInScope2, Outp.alwaysQualifyModules) depth
+        style = Outp.mkUserStyle Outp.reallyAlwaysQualify depth
         str = Outp.renderWithStyle dflags sdoc style
     return (fsLit (dropInfoSuffix str))
 
diff --git a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs
index 808c591d92d7..98df17440479 100644
--- a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs
+++ b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs
@@ -1,9 +1,8 @@
-{-# OPTIONS -fno-warn-type-defaults #-}
+{-# LANGUAGE CPP, GADTs #-}
+{-# OPTIONS_GHC -fno-warn-type-defaults #-}
 -- ----------------------------------------------------------------------------
 -- | Handle conversion of CmmProc to LLVM code.
 --
-
-{-# LANGUAGE GADTs #-}
 module LlvmCodeGen.CodeGen ( genLlvmProc ) where
 
 #include "HsVersions.h"
@@ -16,6 +15,7 @@ import BlockId
 import CodeGen.Platform ( activeStgRegs, callerSaves )
 import CLabel
 import Cmm
+import CPrim
 import PprCmm
 import CmmUtils
 import Hoopl
@@ -33,6 +33,7 @@ import Unique
 import Data.List ( nub )
 import Data.Maybe ( catMaybes )
 
+type Atomic = Bool
 type LlvmStatements = OrdList LlvmStatement
 
 -- -----------------------------------------------------------------------------
@@ -73,7 +74,8 @@ basicBlocksCodeGen live (entryBlock:cmmBlocks)
 -- | Generate code for one block
 basicBlockCodeGen :: CmmBlock -> LlvmM ( LlvmBasicBlock, [LlvmCmmDecl] )
 basicBlockCodeGen block
-  = do let (CmmEntry id, nodes, tail)  = blockSplit block
+  = do let (_, nodes, tail)  = blockSplit block
+           id = entryLabel block
        (mid_instrs, top) <- stmtsToInstrs $ blockToList nodes
        (tail_instrs, top')  <- stmtToInstrs tail
        let instrs = fromOL (mid_instrs `appOL` tail_instrs)
@@ -101,6 +103,8 @@ stmtToInstrs :: CmmNode e x -> LlvmM StmtData
 stmtToInstrs stmt = case stmt of
 
     CmmComment _         -> return (nilOL, []) -- nuke comments
+    CmmTick    _         -> return (nilOL, [])
+    CmmUnwind  {}        -> return (nilOL, [])
 
     CmmAssign reg src    -> genAssign reg src
     CmmStore addr src    -> genStore addr src
@@ -223,12 +227,28 @@ genCall t@(PrimTarget (MO_Prefetch_Data localityInt)) [] args
     return (stmts, top1 ++ top2)
   | otherwise = panic $ "prefetch locality level integer must be between 0 and 3, given: " ++ (show localityInt)
 
--- Handle PopCnt and BSwap that need to only convert arg and return types
+-- Handle PopCnt, Clz, Ctz, and BSwap that need to only convert arg
+-- and return types
 genCall t@(PrimTarget (MO_PopCnt w)) dsts args =
     genCallSimpleCast w t dsts args
+genCall t@(PrimTarget (MO_Clz w)) dsts args =
+    genCallSimpleCast w t dsts args
+genCall t@(PrimTarget (MO_Ctz w)) dsts args =
+    genCallSimpleCast w t dsts args
 genCall t@(PrimTarget (MO_BSwap w)) dsts args =
     genCallSimpleCast w t dsts args
 
+genCall (PrimTarget (MO_AtomicRead _)) [dst] [addr] = do
+  dstV <- getCmmReg (CmmLocal dst)
+  (v1, stmts, top) <- genLoad True addr (localRegType dst)
+  let stmt1 = Store v1 dstV
+  return (stmts `snocOL` stmt1, top)
+
+-- TODO: implement these properly rather than calling to RTS functions.
+-- genCall t@(PrimTarget (MO_AtomicWrite width)) [] [addr, val] = undefined
+-- genCall t@(PrimTarget (MO_AtomicRMW width amop)) [dst] [addr, n] = undefined
+-- genCall t@(PrimTarget (MO_Cmpxchg width)) [dst] [addr, old, new] = undefined
+
 -- Handle memcpy function specifically since llvm's intrinsic version takes
 -- some extra parameters.
 genCall t@(PrimTarget op) [] args'
@@ -546,10 +566,11 @@ cmmPrimOpFunctions mop = do
 
     (MO_PopCnt w) -> fsLit $ "llvm.ctpop."  ++ showSDoc dflags (ppr $ widthToLlvmInt w)
     (MO_BSwap w)  -> fsLit $ "llvm.bswap."  ++ showSDoc dflags (ppr $ widthToLlvmInt w)
+    (MO_Clz w)    -> fsLit $ "llvm.ctlz."   ++ showSDoc dflags (ppr $ widthToLlvmInt w)
+    (MO_Ctz w)    -> fsLit $ "llvm.cttz."   ++ showSDoc dflags (ppr $ widthToLlvmInt w)
 
     (MO_Prefetch_Data _ )-> fsLit "llvm.prefetch"
 
-
     MO_S_QuotRem {}  -> unsupported
     MO_U_QuotRem {}  -> unsupported
     MO_U_QuotRem2 {} -> unsupported
@@ -559,6 +580,12 @@ cmmPrimOpFunctions mop = do
     MO_Touch         -> unsupported
     MO_UF_Conv _     -> unsupported
 
+    MO_AtomicRead _  -> unsupported
+
+    MO_AtomicRMW w amop -> fsLit $ atomicRMWLabel w amop
+    MO_Cmpxchg w        -> fsLit $ cmpxchgLabel w
+    MO_AtomicWrite w    -> fsLit $ atomicWriteLabel w
+
 -- | Tail function calls
 genJump :: CmmExpr -> [GlobalReg] -> LlvmM StmtData
 
@@ -805,7 +832,7 @@ genSwitch cond maybe_ids = do
 
     let pairs = [ (ix, id) | (ix,Just id) <- zip [0..] maybe_ids ]
     let labels = map (\(ix, b) -> (mkIntLit ty ix, blockIdToLlvm b)) pairs
-    -- out of range is undefied, so lets just branch to first label
+    -- out of range is undefined, so let's just branch to first label
     let (_, defLbl) = head labels
 
     let s1 = Switch vc defLbl labels
@@ -850,7 +877,7 @@ exprToVarOpt opt e = case e of
         -> genLit opt lit
 
     CmmLoad e' ty
-        -> genLoad e' ty
+        -> genLoad False e' ty
 
     -- Cmmreg in expression is the value, so must load. If you want actual
     -- reg pointer, call getCmmReg directly.
@@ -1002,8 +1029,8 @@ genMachOp _ op [x] = case op of
         sameConv from ty reduce expand = do
             x'@(vx, stmts, top) <- exprToVar x
             let sameConv' op = do
-                (v1, s1) <- doExpr ty $ Cast op vx ty
-                return (v1, stmts `snocOL` s1, top)
+                    (v1, s1) <- doExpr ty $ Cast op vx ty
+                    return (v1, stmts `snocOL` s1, top)
             dflags <- getDynFlags
             let toWidth = llvmWidthInBits dflags ty
             -- LLVM doesn't like trying to convert to same width, so
@@ -1269,41 +1296,41 @@ genMachOp_slow _ _ _ = panic "genMachOp: More then 2 expressions in MachOp!"
 
 
 -- | Handle CmmLoad expression.
-genLoad :: CmmExpr -> CmmType -> LlvmM ExprData
+genLoad :: Atomic -> CmmExpr -> CmmType -> LlvmM ExprData
 
 -- First we try to detect a few common cases and produce better code for
 -- these then the default case. We are mostly trying to detect Cmm code
 -- like I32[Sp + n] and use 'getelementptr' operations instead of the
 -- generic case that uses casts and pointer arithmetic
-genLoad e@(CmmReg (CmmGlobal r)) ty
-    = genLoad_fast e r 0 ty
+genLoad atomic e@(CmmReg (CmmGlobal r)) ty
+    = genLoad_fast atomic e r 0 ty
 
-genLoad e@(CmmRegOff (CmmGlobal r) n) ty
-    = genLoad_fast e r n ty
+genLoad atomic e@(CmmRegOff (CmmGlobal r) n) ty
+    = genLoad_fast atomic e r n ty
 
-genLoad e@(CmmMachOp (MO_Add _) [
+genLoad atomic e@(CmmMachOp (MO_Add _) [
                             (CmmReg (CmmGlobal r)),
                             (CmmLit (CmmInt n _))])
                 ty
-    = genLoad_fast e r (fromInteger n) ty
+    = genLoad_fast atomic e r (fromInteger n) ty
 
-genLoad e@(CmmMachOp (MO_Sub _) [
+genLoad atomic e@(CmmMachOp (MO_Sub _) [
                             (CmmReg (CmmGlobal r)),
                             (CmmLit (CmmInt n _))])
                 ty
-    = genLoad_fast e r (negate $ fromInteger n) ty
+    = genLoad_fast atomic e r (negate $ fromInteger n) ty
 
 -- generic case
-genLoad e ty
+genLoad atomic e ty
     = do other <- getTBAAMeta otherN
-         genLoad_slow e ty other
+         genLoad_slow atomic e ty other
 
 -- | Handle CmmLoad expression.
 -- This is a special case for loading from a global register pointer
 -- offset such as I32[Sp+8].
-genLoad_fast :: CmmExpr -> GlobalReg -> Int -> CmmType
-                -> LlvmM ExprData
-genLoad_fast e r n ty = do
+genLoad_fast :: Atomic -> CmmExpr -> GlobalReg -> Int -> CmmType
+             -> LlvmM ExprData
+genLoad_fast atomic e r n ty = do
     dflags <- getDynFlags
     (gv, grt, s1) <- getCmmRegVal (CmmGlobal r)
     meta          <- getTBAARegMeta r
@@ -1316,7 +1343,7 @@ genLoad_fast e r n ty = do
                 case grt == ty' of
                      -- were fine
                      True -> do
-                         (var, s3) <- doExpr ty' (MExpr meta $ Load ptr)
+                         (var, s3) <- doExpr ty' (MExpr meta $ loadInstr ptr)
                          return (var, s1 `snocOL` s2 `snocOL` s3,
                                      [])
 
@@ -1324,32 +1351,34 @@ genLoad_fast e r n ty = do
                      False -> do
                          let pty = pLift ty'
                          (ptr', s3) <- doExpr pty $ Cast LM_Bitcast ptr pty
-                         (var, s4) <- doExpr ty' (MExpr meta $ Load ptr')
+                         (var, s4) <- doExpr ty' (MExpr meta $ loadInstr ptr')
                          return (var, s1 `snocOL` s2 `snocOL` s3
                                     `snocOL` s4, [])
 
             -- If its a bit type then we use the slow method since
             -- we can't avoid casting anyway.
-            False -> genLoad_slow e ty meta
-
+            False -> genLoad_slow atomic  e ty meta
+  where
+    loadInstr ptr | atomic    = ALoad SyncSeqCst False ptr
+                  | otherwise = Load ptr
 
 -- | Handle Cmm load expression.
 -- Generic case. Uses casts and pointer arithmetic if needed.
-genLoad_slow :: CmmExpr -> CmmType -> [MetaAnnot] -> LlvmM ExprData
-genLoad_slow e ty meta = do
+genLoad_slow :: Atomic -> CmmExpr -> CmmType -> [MetaAnnot] -> LlvmM ExprData
+genLoad_slow atomic e ty meta = do
     (iptr, stmts, tops) <- exprToVar e
     dflags <- getDynFlags
     case getVarType iptr of
          LMPointer _ -> do
                     (dvar, load) <- doExpr (cmmToLlvmType ty)
-                                           (MExpr meta $ Load iptr)
+                                           (MExpr meta $ loadInstr iptr)
                     return (dvar, stmts `snocOL` load, tops)
 
          i@(LMInt _) | i == llvmWord dflags -> do
                     let pty = LMPointer $ cmmToLlvmType ty
                     (ptr, cast)  <- doExpr pty $ Cast LM_Inttoptr iptr pty
                     (dvar, load) <- doExpr (cmmToLlvmType ty)
-                                           (MExpr meta $ Load ptr)
+                                           (MExpr meta $ loadInstr ptr)
                     return (dvar, stmts `snocOL` cast `snocOL` load, tops)
 
          other -> do dflags <- getDynFlags
@@ -1358,6 +1387,9 @@ genLoad_slow e ty meta = do
                             "Size of Ptr: " ++ show (llvmPtrBits dflags) ++
                             ", Size of var: " ++ show (llvmWidthInBits dflags other) ++
                             ", Var: " ++ showSDoc dflags (ppr iptr)))
+  where
+    loadInstr ptr | atomic    = ALoad SyncSeqCst False ptr
+                  | otherwise = Load ptr
 
 
 -- | Handle CmmReg expression. This will return a pointer to the stack
diff --git a/compiler/llvmGen/LlvmCodeGen/Data.hs b/compiler/llvmGen/LlvmCodeGen/Data.hs
index 6212cfc9fbf6..1dbfb4b52769 100644
--- a/compiler/llvmGen/LlvmCodeGen/Data.hs
+++ b/compiler/llvmGen/LlvmCodeGen/Data.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 -- ----------------------------------------------------------------------------
 -- | Handle conversion of CmmData to LLVM code.
 --
diff --git a/compiler/llvmGen/LlvmCodeGen/Ppr.hs b/compiler/llvmGen/LlvmCodeGen/Ppr.hs
index 202e685c0e0f..9c6a719613cf 100644
--- a/compiler/llvmGen/LlvmCodeGen/Ppr.hs
+++ b/compiler/llvmGen/LlvmCodeGen/Ppr.hs
@@ -1,7 +1,8 @@
+{-# LANGUAGE CPP #-}
+
 -- ----------------------------------------------------------------------------
 -- | Pretty print helpers for the LLVM Code generator.
 --
-
 module LlvmCodeGen.Ppr (
         pprLlvmHeader, pprLlvmCmmDecl, pprLlvmData, infoSection, iTableSuf
     ) where
diff --git a/compiler/llvmGen/LlvmCodeGen/Regs.hs b/compiler/llvmGen/LlvmCodeGen/Regs.hs
index 9f20aa5de567..004865906978 100644
--- a/compiler/llvmGen/LlvmCodeGen/Regs.hs
+++ b/compiler/llvmGen/LlvmCodeGen/Regs.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE CPP #-}
+
 --------------------------------------------------------------------------------
 -- | Deal with Cmm registers
 --
diff --git a/compiler/llvmGen/LlvmMangler.hs b/compiler/llvmGen/LlvmMangler.hs
index a9054174e145..8652a890cf83 100644
--- a/compiler/llvmGen/LlvmMangler.hs
+++ b/compiler/llvmGen/LlvmMangler.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE CPP #-}
+
 -- -----------------------------------------------------------------------------
 -- | GHC LLVM Mangler
 --
@@ -56,13 +58,23 @@ llvmFixupAsm dflags f1 f2 = {-# SCC "llvm_mangler" #-} do
     hClose w
     return ()
 
+-- | This rewrites @.type@ annotations of function symbols to @%object@.
+-- This is done as the linker can relocate @%functions@ through the
+-- Procedure Linking Table (PLT). This is bad since we expect that the
+-- info table will appear directly before the symbol's location. In the
+-- case that the PLT is used, this will be not an info table but instead
+-- some random PLT garbage.
 rewriteSymType :: B.ByteString -> B.ByteString
 rewriteSymType s =
-    foldl (\s' (typeFunc,typeObj)->replace typeFunc typeObj s') s types
+    B.unlines $ map (rewrite '@' . rewrite '%') $ B.lines s
   where
-    types = [ (B.pack "@function", B.pack "@object")
-            , (B.pack "%function", B.pack "%object")
-            ]
+    rewrite :: Char -> B.ByteString -> B.ByteString
+    rewrite prefix x
+        | isType x = replace funcType objType x
+        | otherwise = x
+      where
+        funcType = prefix `B.cons` B.pack "function"
+        objType  = prefix `B.cons` B.pack "object"
 
 -- | Splits the file contents into its sections
 readSections :: Handle -> Handle -> IO [Section]
diff --git a/compiler/main/BreakArray.hs b/compiler/main/BreakArray.hs
index d16d6f229dc3..6455912b671f 100644
--- a/compiler/main/BreakArray.hs
+++ b/compiler/main/BreakArray.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE CPP, MagicHash, UnboxedTuples #-}
+
 -------------------------------------------------------------------------------
 --
 -- | Break Arrays in the IO monad
diff --git a/compiler/main/CmdLineParser.hs b/compiler/main/CmdLineParser.hs
index 22811d44cc1b..5ee7086cbc77 100644
--- a/compiler/main/CmdLineParser.hs
+++ b/compiler/main/CmdLineParser.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE CPP #-}
+
 -------------------------------------------------------------------------------
 --
 -- | Command-line parser
diff --git a/compiler/main/CodeOutput.lhs b/compiler/main/CodeOutput.lhs
index b8b187241b71..043163790afb 100644
--- a/compiler/main/CodeOutput.lhs
+++ b/compiler/main/CodeOutput.lhs
@@ -4,6 +4,8 @@
 \section{Code output phase}
 
 \begin{code}
+{-# LANGUAGE CPP #-}
+
 module CodeOutput( codeOutput, outputForeignStubs ) where
 
 #include "HsVersions.h"
@@ -48,7 +50,7 @@ codeOutput :: DynFlags
            -> FilePath
            -> ModLocation
            -> ForeignStubs
-           -> [PackageId]
+           -> [PackageKey]
            -> Stream IO RawCmmGroup ()                       -- Compiled C--
            -> IO (FilePath,
                   (Bool{-stub_h_exists-}, Maybe FilePath{-stub_c_exists-}))
@@ -72,10 +74,9 @@ codeOutput dflags this_mod filenm location foreign_stubs pkg_deps cmm_stream
                 ; return cmm
                 }
 
-        ; showPass dflags "CodeOutput"
         ; stubs_exist <- outputForeignStubs dflags this_mod location foreign_stubs
         ; case hscTarget dflags of {
-             HscAsm         -> outputAsm dflags this_mod filenm linted_cmm_stream;
+             HscAsm         -> outputAsm dflags this_mod location filenm linted_cmm_stream;
              HscC           -> outputC dflags filenm linted_cmm_stream pkg_deps;
              HscLlvm        -> outputLlvm dflags filenm linted_cmm_stream;
              HscInterpreted -> panic "codeOutput: HscInterpreted";
@@ -99,7 +100,7 @@ doOutput filenm io_action = bracket (openFile filenm WriteMode) hClose io_action
 outputC :: DynFlags
         -> FilePath
         -> Stream IO RawCmmGroup ()
-        -> [PackageId]
+        -> [PackageKey]
         -> IO ()
 
 outputC dflags filenm cmm_stream packages
@@ -114,7 +115,7 @@ outputC dflags filenm cmm_stream packages
        --   * -#include options from the cmdline and OPTIONS pragmas
        --   * the _stub.h file, if there is one.
        --
-       let rts = getPackageDetails (pkgState dflags) rtsPackageId
+       let rts = getPackageDetails dflags rtsPackageKey
                        
        let cc_injects = unlines (map mk_include (includes rts))
            mk_include h_file = 
@@ -140,8 +141,8 @@ outputC dflags filenm cmm_stream packages
 %************************************************************************
 
 \begin{code}
-outputAsm :: DynFlags -> Module -> FilePath -> Stream IO RawCmmGroup () -> IO ()
-outputAsm dflags this_mod filenm cmm_stream
+outputAsm :: DynFlags -> Module -> ModLocation -> FilePath -> Stream IO RawCmmGroup () -> IO ()
+outputAsm dflags this_mod location filenm cmm_stream
  | cGhcWithNativeCodeGen == "YES"
   = do ncg_uniqs <- mkSplitUniqSupply 'n'
 
@@ -149,7 +150,7 @@ outputAsm dflags this_mod filenm cmm_stream
 
        _ <- {-# SCC "OutputAsm" #-} doOutput filenm $
            \h -> {-# SCC "NativeCodeGen" #-}
-                 nativeCodeGen dflags this_mod h ncg_uniqs cmm_stream
+                 nativeCodeGen dflags this_mod location h ncg_uniqs cmm_stream
        return ()
 
  | otherwise
@@ -190,11 +191,8 @@ outputForeignStubs dflags mod location stubs
    stub_c <- newTempName dflags "c"
 
    case stubs of
-     NoStubs -> do
-        -- When compiling External Core files, may need to use stub
-        -- files from a previous compilation
-        stub_h_exists <- doesFileExist stub_h
-        return (stub_h_exists, Nothing)
+     NoStubs ->
+        return (False, Nothing)
 
      ForeignStubs h_code c_code -> do
         let
@@ -212,7 +210,7 @@ outputForeignStubs dflags mod location stubs
 
         -- we need the #includes from the rts package for the stub files
         let rts_includes = 
-               let rts_pkg = getPackageDetails (pkgState dflags) rtsPackageId in
+               let rts_pkg = getPackageDetails dflags rtsPackageKey in
                concatMap mk_include (includes rts_pkg)
             mk_include i = "#include \"" ++ i ++ "\"\n"
 
diff --git a/compiler/main/DriverMkDepend.hs b/compiler/main/DriverMkDepend.hs
index cda0b4729f6e..03545d482864 100644
--- a/compiler/main/DriverMkDepend.hs
+++ b/compiler/main/DriverMkDepend.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE CPP #-}
+
 -----------------------------------------------------------------------------
 --
 -- Makefile Dependency Generation
diff --git a/compiler/main/DriverPhases.hs b/compiler/main/DriverPhases.hs
index 2de19b9795cc..fa8b2d060f14 100644
--- a/compiler/main/DriverPhases.hs
+++ b/compiler/main/DriverPhases.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE CPP #-}
+
 -----------------------------------------------------------------------------
 --  $Id: DriverPhases.hs,v 1.38 2005/05/17 11:01:59 simonmar Exp $
 --
@@ -18,7 +20,6 @@ module DriverPhases (
    isHaskellSrcSuffix,
    isObjectSuffix,
    isCishSuffix,
-   isExtCoreSuffix,
    isDynLibSuffix,
    isHaskellUserSrcSuffix,
    isSourceSuffix,
@@ -27,7 +28,6 @@ module DriverPhases (
    isHaskellSrcFilename,
    isObjectFilename,
    isCishFilename,
-   isExtCoreFilename,
    isDynLibFilename,
    isHaskellUserSrcFilename,
    isSourceFilename
@@ -56,7 +56,7 @@ import System.FilePath
 -}
 
 data HscSource
-   = HsSrcFile | HsBootFile | ExtCoreFile
+   = HsSrcFile | HsBootFile
      deriving( Eq, Ord, Show )
         -- Ord needed for the finite maps we build in CompManager
 
@@ -64,7 +64,6 @@ data HscSource
 hscSourceString :: HscSource -> String
 hscSourceString HsSrcFile   = ""
 hscSourceString HsBootFile  = "[boot]"
-hscSourceString ExtCoreFile = "[ext core]"
 
 isHsBoot :: HscSource -> Bool
 isHsBoot HsBootFile = True
@@ -82,7 +81,7 @@ data Phase
         | HCc           -- Haskellised C (as opposed to vanilla C) compilation
         | Splitter      -- Assembly file splitter (part of '-split-objs')
         | SplitAs       -- Assembler for split assembly files (part of '-split-objs')
-        | As            -- Assembler for regular assembly files
+        | As Bool       -- Assembler for regular assembly files (Bool: with-cpp)
         | LlvmOpt       -- Run LLVM opt tool over llvm assembly
         | LlvmLlc       -- LLVM bitcode to native assembly
         | LlvmMangle    -- Fix up TNTC by processing assembly produced by LLVM
@@ -119,7 +118,7 @@ eqPhase Cobjcpp     Cobjcpp    = True
 eqPhase HCc         HCc        = True
 eqPhase Splitter    Splitter   = True
 eqPhase SplitAs     SplitAs    = True
-eqPhase As          As         = True
+eqPhase (As x)      (As y)     = x == y
 eqPhase LlvmOpt     LlvmOpt    = True
 eqPhase LlvmLlc     LlvmLlc    = True
 eqPhase LlvmMangle  LlvmMangle = True
@@ -150,21 +149,21 @@ nextPhase dflags p
       Splitter   -> SplitAs
       LlvmOpt    -> LlvmLlc
       LlvmLlc    -> LlvmMangle
-      LlvmMangle -> As
+      LlvmMangle -> As False
       SplitAs    -> MergeStub
-      As         -> MergeStub
-      Ccpp       -> As
-      Cc         -> As
-      Cobjc      -> As
-      Cobjcpp    -> As
+      As _       -> MergeStub
+      Ccpp       -> As False
+      Cc         -> As False
+      Cobjc      -> As False
+      Cobjcpp    -> As False
       CmmCpp     -> Cmm
       Cmm        -> maybeHCc
-      HCc        -> As
+      HCc        -> As False
       MergeStub  -> StopLn
       StopLn     -> panic "nextPhase: nothing after StopLn"
     where maybeHCc = if platformUnregisterised (targetPlatform dflags)
                      then HCc
-                     else As
+                     else As False
 
 -- the first compilation phase for a given file is determined
 -- by its suffix.
@@ -175,7 +174,6 @@ startPhase "hs"       = Cpp   HsSrcFile
 startPhase "hs-boot"  = Cpp   HsBootFile
 startPhase "hscpp"    = HsPp  HsSrcFile
 startPhase "hspp"     = Hsc   HsSrcFile
-startPhase "hcr"      = Hsc   ExtCoreFile
 startPhase "hc"       = HCc
 startPhase "c"        = Cc
 startPhase "cpp"      = Ccpp
@@ -186,8 +184,8 @@ startPhase "mm"       = Cobjcpp
 startPhase "cc"       = Ccpp
 startPhase "cxx"      = Ccpp
 startPhase "split_s"  = Splitter
-startPhase "s"        = As
-startPhase "S"        = As
+startPhase "s"        = As False
+startPhase "S"        = As True
 startPhase "ll"       = LlvmOpt
 startPhase "bc"       = LlvmLlc
 startPhase "lm_s"     = LlvmMangle
@@ -202,7 +200,6 @@ startPhase _          = StopLn     -- all unknown file types
 phaseInputExt :: Phase -> String
 phaseInputExt (Unlit HsSrcFile)   = "lhs"
 phaseInputExt (Unlit HsBootFile)  = "lhs-boot"
-phaseInputExt (Unlit ExtCoreFile) = "lhcr"
 phaseInputExt (Cpp   _)           = "lpp"       -- intermediate only
 phaseInputExt (HsPp  _)           = "hscpp"     -- intermediate only
 phaseInputExt (Hsc   _)           = "hspp"      -- intermediate only
@@ -215,7 +212,8 @@ phaseInputExt Cobjc               = "m"
 phaseInputExt Cobjcpp             = "mm"
 phaseInputExt Cc                  = "c"
 phaseInputExt Splitter            = "split_s"
-phaseInputExt As                  = "s"
+phaseInputExt (As True)           = "S"
+phaseInputExt (As False)          = "s"
 phaseInputExt LlvmOpt             = "ll"
 phaseInputExt LlvmLlc             = "bc"
 phaseInputExt LlvmMangle          = "lm_s"
@@ -226,13 +224,12 @@ phaseInputExt MergeStub           = "o"
 phaseInputExt StopLn              = "o"
 
 haskellish_src_suffixes, haskellish_suffixes, cish_suffixes,
-    extcoreish_suffixes, haskellish_user_src_suffixes
+    haskellish_user_src_suffixes
  :: [String]
 haskellish_src_suffixes      = haskellish_user_src_suffixes ++
                                [ "hspp", "hscpp", "hcr", "cmm", "cmmcpp" ]
 haskellish_suffixes          = haskellish_src_suffixes ++ ["hc", "raw_s"]
 cish_suffixes                = [ "c", "cpp", "C", "cc", "cxx", "s", "S", "ll", "bc", "lm_s", "m", "M", "mm" ]
-extcoreish_suffixes          = [ "hcr" ]
 -- Will not be deleted as temp files:
 haskellish_user_src_suffixes = [ "hs", "lhs", "hs-boot", "lhs-boot" ]
 
@@ -240,22 +237,21 @@ objish_suffixes :: Platform -> [String]
 -- Use the appropriate suffix for the system on which
 -- the GHC-compiled code will run
 objish_suffixes platform = case platformOS platform of
-                           OSMinGW32 -> [ "o", "O", "obj", "OBJ" ]
-                           _         -> [ "o" ]
+  OSMinGW32 -> [ "o", "O", "obj", "OBJ" ]
+  _         -> [ "o" ]
 
 dynlib_suffixes :: Platform -> [String]
 dynlib_suffixes platform = case platformOS platform of
-                           OSMinGW32 -> ["dll", "DLL"]
-                           OSDarwin  -> ["dylib"]
-                           _         -> ["so"]
+  OSMinGW32 -> ["dll", "DLL"]
+  OSDarwin  -> ["dylib", "so"]
+  _         -> ["so"]
 
-isHaskellishSuffix, isHaskellSrcSuffix, isCishSuffix, isExtCoreSuffix,
+isHaskellishSuffix, isHaskellSrcSuffix, isCishSuffix,
     isHaskellUserSrcSuffix
  :: String -> Bool
 isHaskellishSuffix     s = s `elem` haskellish_suffixes
 isHaskellSrcSuffix     s = s `elem` haskellish_src_suffixes
 isCishSuffix           s = s `elem` cish_suffixes
-isExtCoreSuffix        s = s `elem` extcoreish_suffixes
 isHaskellUserSrcSuffix s = s `elem` haskellish_user_src_suffixes
 
 isObjectSuffix, isDynLibSuffix :: Platform -> String -> Bool
@@ -266,13 +262,12 @@ isSourceSuffix :: String -> Bool
 isSourceSuffix suff  = isHaskellishSuffix suff || isCishSuffix suff
 
 isHaskellishFilename, isHaskellSrcFilename, isCishFilename,
-    isExtCoreFilename, isHaskellUserSrcFilename, isSourceFilename
+    isHaskellUserSrcFilename, isSourceFilename
  :: FilePath -> Bool
 -- takeExtension return .foo, so we drop 1 to get rid of the .
 isHaskellishFilename     f = isHaskellishSuffix     (drop 1 $ takeExtension f)
 isHaskellSrcFilename     f = isHaskellSrcSuffix     (drop 1 $ takeExtension f)
 isCishFilename           f = isCishSuffix           (drop 1 $ takeExtension f)
-isExtCoreFilename        f = isExtCoreSuffix        (drop 1 $ takeExtension f)
 isHaskellUserSrcFilename f = isHaskellUserSrcSuffix (drop 1 $ takeExtension f)
 isSourceFilename         f = isSourceSuffix         (drop 1 $ takeExtension f)
 
diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs
index 3d34bdbcac67..183f43529636 100644
--- a/compiler/main/DriverPipeline.hs
+++ b/compiler/main/DriverPipeline.hs
@@ -1,5 +1,5 @@
-{-# OPTIONS -fno-cse #-}
-{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE CPP, NamedFieldPuns, NondecreasingIndentation #-}
+{-# OPTIONS_GHC -fno-cse #-}
 -- -fno-cse is needed for GLOBAL_VAR's to behave properly
 
 -----------------------------------------------------------------------------
@@ -54,7 +54,6 @@ import Util
 import StringBuffer     ( hGetStringBuffer )
 import BasicTypes       ( SuccessFlag(..) )
 import Maybes           ( expectJust )
-import ParserCoreUtils  ( getCoreModuleName )
 import SrcLoc
 import FastString
 import LlvmCodeGen      ( llvmFixupAsm )
@@ -139,11 +138,13 @@ compileOne' m_tc_result mHscMessage
        input_fnpp  = ms_hspp_file summary
        mod_graph   = hsc_mod_graph hsc_env0
        needsTH     = any (xopt Opt_TemplateHaskell . ms_hspp_opts) mod_graph
+       needsQQ     = any (xopt Opt_QuasiQuotes     . ms_hspp_opts) mod_graph
+       needsLinker = needsTH || needsQQ
        isDynWay    = any (== WayDyn) (ways dflags0)
        isProfWay   = any (== WayProf) (ways dflags0)
    -- #8180 - when using TemplateHaskell, switch on -dynamic-too so
    -- the linker can correctly load the object files.
-   let dflags1 = if needsTH && dynamicGhc && not isDynWay && not isProfWay
+   let dflags1 = if needsLinker && dynamicGhc && not isDynWay && not isProfWay
                   then gopt_set dflags0 Opt_BuildDynamicToo
                   else dflags0
 
@@ -167,8 +168,6 @@ compileOne' m_tc_result mHscMessage
    output_fn <- getOutputFilename next_phase
                         Temporary basename dflags next_phase (Just location)
 
-   let extCore_filename = basename ++ ".hcr"
-
    -- -fforce-recomp should also work with --make
    let force_recomp = gopt Opt_ForceRecomp dflags
        source_modified
@@ -205,7 +204,7 @@ compileOne' m_tc_result mHscMessage
                                                hm_linkable = maybe_old_linkable })
                    _ -> do guts0 <- hscDesugar hsc_env summary tc_result
                            guts <- hscSimplify hsc_env guts0
-                           (iface, _changed, details, cgguts) <- hscNormalIface hsc_env extCore_filename guts mb_old_hash
+                           (iface, _changed, details, cgguts) <- hscNormalIface hsc_env guts mb_old_hash
                            (hasStub, comp_bc, modBreaks) <- hscInteractive hsc_env cgguts summary
 
                            stub_o <- case hasStub of
@@ -229,7 +228,9 @@ compileOne' m_tc_result mHscMessage
                                                 hm_iface    = iface,
                                                 hm_linkable = Just linkable })
                HscNothing ->
-                   do (iface, _changed, details) <- hscSimpleIface hsc_env tc_result mb_old_hash
+                   do (iface, changed, details) <- hscSimpleIface hsc_env tc_result mb_old_hash
+                      when (gopt Opt_WriteInterface dflags) $
+                         hscWriteIface dflags iface changed summary
                       let linkable = if isHsBoot src_flavour
                                      then maybe_old_linkable
                                      else Just (LM (ms_hs_date summary) this_mod [])
@@ -249,7 +250,7 @@ compileOne' m_tc_result mHscMessage
 
                    _ -> do guts0 <- hscDesugar hsc_env summary tc_result
                            guts <- hscSimplify hsc_env guts0
-                           (iface, changed, details, cgguts) <- hscNormalIface hsc_env extCore_filename guts mb_old_hash
+                           (iface, changed, details, cgguts) <- hscNormalIface hsc_env guts mb_old_hash
                            hscWriteIface dflags iface changed summary
 
                            -- We're in --make mode: finish the compilation pipeline.
@@ -389,7 +390,7 @@ link' dflags batch_attempt_linking hpt
         return Succeeded
 
 
-linkingNeeded :: DynFlags -> Bool -> [Linkable] -> [PackageId] -> IO Bool
+linkingNeeded :: DynFlags -> Bool -> [Linkable] -> [PackageKey] -> IO Bool
 linkingNeeded dflags staticLink linkables pkg_deps = do
         -- if the modification time on the executable is later than the
         -- modification times on all of the objects and libraries, then omit
@@ -410,9 +411,8 @@ linkingNeeded dflags staticLink linkables pkg_deps = do
 
         -- next, check libraries. XXX this only checks Haskell libraries,
         -- not extra_libraries or -l things from the command line.
-        let pkg_map = pkgIdMap (pkgState dflags)
-            pkg_hslibs  = [ (libraryDirs c, lib)
-                          | Just c <- map (lookupPackage pkg_map) pkg_deps,
+        let pkg_hslibs  = [ (libraryDirs c, lib)
+                          | Just c <- map (lookupPackage dflags) pkg_deps,
                             lib <- packageHsLibs dflags c ]
 
         pkg_libfiles <- mapM (uncurry (findHSLib dflags)) pkg_hslibs
@@ -426,7 +426,7 @@ linkingNeeded dflags staticLink linkables pkg_deps = do
 
 -- Returns 'False' if it was, and we can avoid linking, because the
 -- previous binary was linked with "the same options".
-checkLinkInfo :: DynFlags -> [PackageId] -> FilePath -> IO Bool
+checkLinkInfo :: DynFlags -> [PackageKey] -> FilePath -> IO Bool
 checkLinkInfo dflags pkg_deps exe_file
  | not (platformSupportsSavingLinkOpts (platformOS (targetPlatform dflags)))
  -- ToDo: Windows and OS X do not use the ELF binary format, so
@@ -496,8 +496,8 @@ compileFile hsc_env stop_phase (src, mb_phase) = do
          | otherwise = Persistent
 
         stop_phase' = case stop_phase of
-                        As | split -> SplitAs
-                        _          -> stop_phase
+                        As _ | split -> SplitAs
+                        _            -> stop_phase
 
    ( _, out_file) <- runPipeline stop_phase' hsc_env
                             (src, fmap RealPhase mb_phase) Nothing output
@@ -728,7 +728,7 @@ getOutputFilename stop_phase output basename dflags next_phase maybe_location
           -- sometimes, we keep output from intermediate stages
           keep_this_output =
                case next_phase of
-                       As      | keep_s     -> True
+                       As _    | keep_s     -> True
                        LlvmOpt | keep_bc    -> True
                        HCc     | keep_hc    -> True
                        _other               -> False
@@ -890,16 +890,11 @@ runPhase (RealPhase (Hsc src_flavour)) input_fn dflags0
         setDynFlags dflags
 
   -- gather the imports and module name
-        (hspp_buf,mod_name,imps,src_imps) <- liftIO $
-            case src_flavour of
-                ExtCoreFile -> do  -- no explicit imports in ExtCore input.
-                    m <- getCoreModuleName input_fn
-                    return (Nothing, mkModuleName m, [], [])
-
-                _           -> do
-                    buf <- hGetStringBuffer input_fn
-                    (src_imps,imps,L _ mod_name) <- getImports dflags buf input_fn (basename <.> suff)
-                    return (Just buf, mod_name, imps, src_imps)
+        (hspp_buf,mod_name,imps,src_imps) <- liftIO $ do
+          do
+            buf <- hGetStringBuffer input_fn
+            (src_imps,imps,L _ mod_name) <- getImports dflags buf input_fn (basename <.> suff)
+            return (Just buf, mod_name, imps, src_imps)
 
   -- Take -o into account if present
   -- Very like -ohi, but we must *only* do this if we aren't linking
@@ -934,8 +929,6 @@ runPhase (RealPhase (Hsc src_flavour)) input_fn dflags0
                                   then return SourceUnmodified
                                   else return SourceModified
 
-        let extCore_filename = basename ++ ".hcr"
-
         PipeState{hsc_env=hsc_env'} <- getPipeState
 
   -- Tell the finder cache about this module
@@ -955,7 +948,7 @@ runPhase (RealPhase (Hsc src_flavour)) input_fn dflags0
                                         ms_srcimps      = src_imps }
 
   -- run the compiler!
-        result <- liftIO $ hscCompileOneShot hsc_env' extCore_filename
+        result <- liftIO $ hscCompileOneShot hsc_env'
                                mod_summary source_unchanged
 
         return (HscOut src_flavour mod_name result,
@@ -1043,7 +1036,7 @@ runPhase (RealPhase cc_phase) input_fn dflags
         -- files; this is the Value Add(TM) that using ghc instead of
         -- gcc gives you :)
         pkg_include_dirs <- liftIO $ getPackageIncludePath dflags pkgs
-        let include_paths = foldr (\ x xs -> "-I" : x : xs) []
+        let include_paths = foldr (\ x xs -> ("-I" ++ x) : xs) []
                               (cmdline_include_paths ++ pkg_include_dirs)
 
         let gcc_extra_viac_flags = extraGccViaCFlags dflags
@@ -1076,7 +1069,7 @@ runPhase (RealPhase cc_phase) input_fn dflags
                    | otherwise            = []
 
         -- Decide next phase
-        let next_phase = As
+        let next_phase = As False
         output_fn <- phaseOutputFilename next_phase
 
         let
@@ -1119,7 +1112,7 @@ runPhase (RealPhase cc_phase) input_fn dflags
                 -- way we do the import depends on whether we're currently compiling
                 -- the base package or not.
                        ++ (if platformOS platform == OSMinGW32 &&
-                              thisPackage dflags == basePackageId
+                              thisPackage dflags == basePackageKey
                                 then [ "-DCOMPILING_BASE_PACKAGE" ]
                                 else [])
 
@@ -1188,7 +1181,7 @@ runPhase (RealPhase Splitter) input_fn dflags
 -- As, SpitAs phase : Assembler
 
 -- This is for calling the assembler on a regular assembly file (not split).
-runPhase (RealPhase As) input_fn dflags
+runPhase (RealPhase (As with_cpp)) input_fn dflags
   = do
         -- LLVM from version 3.0 onwards doesn't support the OS X system
         -- assembler, so we use clang as the assembler instead. (#5636)
@@ -1214,6 +1207,7 @@ runPhase (RealPhase As) input_fn dflags
         -- might be a hierarchical module.
         liftIO $ createDirectoryIfMissing True (takeDirectory output_fn)
 
+        ccInfo <- liftIO $ getCompilerInfo dflags
         let runAssembler inputFilename outputFilename
                 = liftIO $ as_prog dflags
                        ([ SysTools.Option ("-I" ++ p) | p <- cmdline_include_paths ]
@@ -1228,8 +1222,13 @@ runPhase (RealPhase As) input_fn dflags
                        ++ (if platformArch (targetPlatform dflags) == ArchSPARC
                            then [SysTools.Option "-mcpu=v9"]
                            else [])
-
-                       ++ [ SysTools.Option "-x", SysTools.Option "assembler-with-cpp"
+                       ++ (if any (ccInfo ==) [Clang, AppleClang, AppleClang51]
+                            then [SysTools.Option "-Qunused-arguments"]
+                            else [])
+                       ++ [ SysTools.Option "-x"
+                          , if with_cpp
+                              then SysTools.Option "assembler-with-cpp"
+                              else SysTools.Option "assembler"
                           , SysTools.Option "-c"
                           , SysTools.FileOption "" inputFilename
                           , SysTools.Option "-o"
@@ -1254,6 +1253,7 @@ runPhase (RealPhase SplitAs) _input_fn dflags
             osuf = objectSuf dflags
             split_odir  = base_o ++ "_" ++ osuf ++ "_split"
 
+        -- this also creates the hierarchy
         liftIO $ createDirectoryIfMissing True split_odir
 
         -- remove M_split/ *.o, because we're going to archive M_split/ *.o
@@ -1335,7 +1335,7 @@ runPhase (RealPhase LlvmOpt) input_fn dflags
         -- passes only, so if the user is passing us extra options we assume
         -- they know what they are doing and don't get in the way.
         optFlag  = if null (getOpts dflags opt_lo)
-                       then map SysTools.Option $ words (llvmOpts !! opt_lvl)
+                       then map SysTools.Option $ words (llvmOpts ver !! opt_lvl)
                        else []
         tbaa | ver < 29                 = "" -- no tbaa in 2.8 and earlier
              | gopt Opt_LlvmTBAA dflags = "--enable-tbaa=true"
@@ -1355,7 +1355,11 @@ runPhase (RealPhase LlvmOpt) input_fn dflags
   where 
         -- we always (unless -optlo specified) run Opt since we rely on it to
         -- fix up some pretty big deficiencies in the code we generate
-        llvmOpts = ["-mem2reg -globalopt", "-O1", "-O2"]
+        llvmOpts ver = [ "-mem2reg -globalopt"
+                       , if ver >= 34 then "-O1 -globalopt" else "-O1"
+                         -- LLVM 3.4 -O1 doesn't eliminate aliases reliably (bug #8855)
+                       , "-O2"
+                       ]
 
 -----------------------------------------------------------------------------
 -- LlvmLlc phase
@@ -1379,7 +1383,7 @@ runPhase (RealPhase LlvmLlc) input_fn dflags
     let next_phase = case gopt Opt_NoLlvmMangler dflags of
                          False                            -> LlvmMangle
                          True | gopt Opt_SplitObjs dflags -> Splitter
-                         True                             -> As
+                         True                             -> As False
                         
     output_fn <- phaseOutputFilename next_phase
 
@@ -1448,7 +1452,7 @@ runPhase (RealPhase LlvmLlc) input_fn dflags
 
 runPhase (RealPhase LlvmMangle) input_fn dflags
   = do
-      let next_phase = if gopt Opt_SplitObjs dflags then Splitter else As
+      let next_phase = if gopt Opt_SplitObjs dflags then Splitter else As False
       output_fn <- phaseOutputFilename next_phase
       liftIO $ llvmFixupAsm dflags input_fn output_fn
       return (RealPhase next_phase, output_fn)
@@ -1460,6 +1464,7 @@ runPhase (RealPhase MergeStub) input_fn dflags
  = do
      PipeState{maybe_stub_o} <- getPipeState
      output_fn <- phaseOutputFilename StopLn
+     liftIO $ createDirectoryIfMissing True (takeDirectory output_fn)
      case maybe_stub_o of
        Nothing ->
          panic "runPhase(MergeStub): no stub"
@@ -1553,7 +1558,7 @@ mkExtraObj dflags extn xs
  = do cFile <- newTempName dflags extn
       oFile <- newTempName dflags "o"
       writeFile cFile xs
-      let rtsDetails = getPackageDetails (pkgState dflags) rtsPackageId
+      let rtsDetails = getPackageDetails dflags rtsPackageKey
       SysTools.runCc dflags
                      ([Option        "-c",
                        FileOption "" cFile,
@@ -1602,7 +1607,7 @@ mkExtraObjToLinkIntoBinary dflags = do
 -- this was included as inline assembly in the main.c file but this
 -- is pretty fragile. gas gets upset trying to calculate relative offsets
 -- that span the .note section (notably .text) when debug info is present
-mkNoteObjsToLinkIntoBinary :: DynFlags -> [PackageId] -> IO [FilePath]
+mkNoteObjsToLinkIntoBinary :: DynFlags -> [PackageKey] -> IO [FilePath]
 mkNoteObjsToLinkIntoBinary dflags dep_packages = do
    link_info <- getLinkInfo dflags dep_packages
 
@@ -1643,7 +1648,7 @@ mkNoteObjsToLinkIntoBinary dflags dep_packages = do
 -- link.  We save this information in the binary, and the next time we
 -- link, if nothing else has changed, we use the link info stored in
 -- the existing binary to decide whether to re-link or not.
-getLinkInfo :: DynFlags -> [PackageId] -> IO String
+getLinkInfo :: DynFlags -> [PackageKey] -> IO String
 getLinkInfo dflags dep_packages = do
    package_link_opts <- getPackageLinkOpts dflags dep_packages
    pkg_frameworks <- if platformUsesFrameworks (targetPlatform dflags)
@@ -1721,13 +1726,13 @@ mk_pvm_wrapper_script pvm_executable pvm_executable_base sysMan = unlines $
 -----------------------------------------------------------------------------
 -- Look for the /* GHC_PACKAGES ... */ comment at the top of a .hc file
 
-getHCFilePackages :: FilePath -> IO [PackageId]
+getHCFilePackages :: FilePath -> IO [PackageKey]
 getHCFilePackages filename =
   Exception.bracket (openFile filename ReadMode) hClose $ \h -> do
     l <- hGetLine h
     case l of
       '/':'*':' ':'G':'H':'C':'_':'P':'A':'C':'K':'A':'G':'E':'S':rest ->
-          return (map stringToPackageId (words rest))
+          return (map stringToPackageKey (words rest))
       _other ->
           return []
 
@@ -1744,10 +1749,10 @@ getHCFilePackages filename =
 -- read any interface files), so the user must explicitly specify all
 -- the packages.
 
-linkBinary :: DynFlags -> [FilePath] -> [PackageId] -> IO ()
+linkBinary :: DynFlags -> [FilePath] -> [PackageKey] -> IO ()
 linkBinary = linkBinary' False
 
-linkBinary' :: Bool -> DynFlags -> [FilePath] -> [PackageId] -> IO ()
+linkBinary' :: Bool -> DynFlags -> [FilePath] -> [PackageKey] -> IO ()
 linkBinary' staticLink dflags o_files dep_packages = do
     let platform = targetPlatform dflags
         mySettings = settings dflags
@@ -1785,6 +1790,15 @@ linkBinary' staticLink dflags o_files dep_packages = do
                               then []
                               else ["-Wl,-rpath-link", "-Wl," ++ l]
               in ["-L" ++ l] ++ rpathlink ++ rpath
+         | osMachOTarget (platformOS platform) &&
+           dynLibLoader dflags == SystemDependent &&
+           not (gopt Opt_Static dflags) &&
+           gopt Opt_RPath dflags
+            = let libpath = if gopt Opt_RelativeDynlibPaths dflags
+                            then "@loader_path" </>
+                                 (l `makeRelativeTo` full_output_fn)
+                            else l
+              in ["-L" ++ l] ++ ["-Wl,-rpath", "-Wl," ++ libpath]
          | otherwise = ["-L" ++ l]
 
     let lib_paths = libraryPaths dflags
@@ -1858,7 +1872,7 @@ linkBinary' staticLink dflags o_files dep_packages = do
             let os = platformOS (targetPlatform dflags)
             in if os == OSOsf3 then ["-lpthread", "-lexc"]
                else if os `elem` [OSMinGW32, OSFreeBSD, OSOpenBSD,
-                                  OSNetBSD, OSHaiku, OSQNXNTO, OSiOS]
+                                  OSNetBSD, OSHaiku, OSQNXNTO, OSiOS, OSDarwin]
                then []
                else ["-lpthread"]
          | otherwise               = []
@@ -1920,13 +1934,6 @@ linkBinary' staticLink dflags o_files dep_packages = do
                           then ["-Wl,-read_only_relocs,suppress"]
                           else [])
 
-                      ++ (if platformOS platform == OSDarwin &&
-                             not staticLink &&
-                             not (gopt Opt_Static dflags) &&
-                             gopt Opt_RPath dflags
-                          then ["-Wl,-rpath","-Wl," ++ topDir dflags]
-                          else [])
-
                       ++ o_files
                       ++ lib_path_opts)
                       ++ extra_ld_inputs
@@ -2019,7 +2026,7 @@ maybeCreateManifest dflags exe_filename
  | otherwise = return []
 
 
-linkDynLibCheck :: DynFlags -> [String] -> [PackageId] -> IO ()
+linkDynLibCheck :: DynFlags -> [String] -> [PackageKey] -> IO ()
 linkDynLibCheck dflags o_files dep_packages
  = do
     when (haveRtsOptsFlags dflags) $ do
@@ -2029,7 +2036,7 @@ linkDynLibCheck dflags o_files dep_packages
 
     linkDynLib dflags o_files dep_packages
 
-linkStaticLibCheck :: DynFlags -> [String] -> [PackageId] -> IO ()
+linkStaticLibCheck :: DynFlags -> [String] -> [PackageKey] -> IO ()
 linkStaticLibCheck dflags o_files dep_packages
  = do
     when (platformOS (targetPlatform dflags) `notElem` [OSiOS, OSDarwin]) $
@@ -2126,26 +2133,27 @@ joinObjectFiles dflags o_files output_fn = do
   let mySettings = settings dflags
       ldIsGnuLd = sLdIsGnuLd mySettings
       osInfo = platformOS (targetPlatform dflags)
-      ld_r args ccInfo = SysTools.runLink dflags ([
-                            SysTools.Option "-nostdlib",
-                            SysTools.Option "-Wl,-r"
-                            ]
-                         ++ (if ccInfo == Clang then []
-                              else [SysTools.Option "-nodefaultlibs"])
-                         ++ (if osInfo == OSFreeBSD
-                              then [SysTools.Option "-L/usr/lib"]
-                              else [])
-                            -- gcc on sparc sets -Wl,--relax implicitly, but
-                            -- -r and --relax are incompatible for ld, so
-                            -- disable --relax explicitly.
-                         ++ (if platformArch (targetPlatform dflags) == ArchSPARC
-                             && ldIsGnuLd
-                                then [SysTools.Option "-Wl,-no-relax"]
-                                else [])
-                         ++ map SysTools.Option ld_build_id
-                         ++ [ SysTools.Option "-o",
-                              SysTools.FileOption "" output_fn ]
-                         ++ args)
+      ld_r args cc = SysTools.runLink dflags ([
+                       SysTools.Option "-nostdlib",
+                       SysTools.Option "-Wl,-r"
+                     ]
+                     ++ (if any (cc ==) [Clang, AppleClang, AppleClang51]
+                          then []
+                          else [SysTools.Option "-nodefaultlibs"])
+                     ++ (if osInfo == OSFreeBSD
+                          then [SysTools.Option "-L/usr/lib"]
+                          else [])
+                        -- gcc on sparc sets -Wl,--relax implicitly, but
+                        -- -r and --relax are incompatible for ld, so
+                        -- disable --relax explicitly.
+                     ++ (if platformArch (targetPlatform dflags) == ArchSPARC
+                         && ldIsGnuLd
+                            then [SysTools.Option "-Wl,-no-relax"]
+                            else [])
+                     ++ map SysTools.Option ld_build_id
+                     ++ [ SysTools.Option "-o",
+                          SysTools.FileOption "" output_fn ]
+                     ++ args)
 
       -- suppress the generation of the .note.gnu.build-id section,
       -- which we don't need and sometimes causes ld to emit a
@@ -2157,7 +2165,9 @@ joinObjectFiles dflags o_files output_fn = do
   if ldIsGnuLd
      then do
           script <- newTempName dflags "ldscript"
-          writeFile script $ "INPUT(" ++ unwords o_files ++ ")"
+          cwd <- getCurrentDirectory
+          let o_files_abs = map (cwd </>) o_files
+          writeFile script $ "INPUT(" ++ unwords o_files_abs ++ ")"
           ld_r [SysTools.FileOption "" script] ccInfo
      else if sLdSupportsFilelist mySettings
      then do
@@ -2178,7 +2188,7 @@ hscPostBackendPhase dflags _ hsc_lang =
   case hsc_lang of
         HscC -> HCc
         HscAsm | gopt Opt_SplitObjs dflags -> Splitter
-               | otherwise                 -> As
+               | otherwise                 -> As False
         HscLlvm        -> LlvmOpt
         HscNothing     -> StopLn
         HscInterpreted -> StopLn
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index 615fdbb08b95..c006480dd78d 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE CPP #-}
+
 -------------------------------------------------------------------------------
 --
 -- | Dynamic flags
@@ -11,7 +13,7 @@
 --
 -------------------------------------------------------------------------------
 
-{-# OPTIONS -fno-cse #-}
+{-# OPTIONS_GHC -fno-cse #-}
 -- -fno-cse is needed for GLOBAL_VAR's to behave properly
 
 module DynFlags (
@@ -30,6 +32,7 @@ module DynFlags (
         wopt, wopt_set, wopt_unset,
         xopt, xopt_set, xopt_unset,
         lang_set,
+        useUnicodeSyntax,
         whenGeneratingDynamicToo, ifGeneratingDynamicToo,
         whenCannotGenerateDynamicToo,
         dynamicTooMkDynamicDynFlags,
@@ -40,7 +43,7 @@ module DynFlags (
         targetRetainsAllBindings,
         GhcMode(..), isOneShot,
         GhcLink(..), isNoLink,
-        PackageFlag(..),
+        PackageFlag(..), PackageArg(..), ModRenaming,
         PkgConfRef(..),
         Option(..), showOpt,
         DynLibLoader(..),
@@ -58,7 +61,7 @@ module DynFlags (
         safeHaskellOn, safeImportsOn, safeLanguageOn, safeInferOn,
         packageTrustOn,
         safeDirectImpsReq, safeImplicitImpsReq,
-        unsafeFlags,
+        unsafeFlags, unsafeFlagsForInfer,
 
         -- ** System tool settings and locations
         Settings(..),
@@ -87,7 +90,7 @@ module DynFlags (
         getVerbFlags,
         updOptLevel,
         setTmpDir,
-        setPackageName,
+        setPackageKey,
 
         -- ** Parsing DynFlags
         parseDynamicFlagsCmdLine,
@@ -187,6 +190,8 @@ import Data.Word
 import System.FilePath
 import System.IO
 import System.IO.Error
+import Text.ParserCombinators.ReadP hiding (char)
+import Text.ParserCombinators.ReadP as R
 
 import Data.IntSet (IntSet)
 import qualified Data.IntSet as IntSet
@@ -240,6 +245,7 @@ data DumpFlag
    | Opt_D_dump_spec
    | Opt_D_dump_prep
    | Opt_D_dump_stg
+   | Opt_D_dump_call_arity
    | Opt_D_dump_stranal
    | Opt_D_dump_strsigs
    | Opt_D_dump_tc
@@ -265,8 +271,10 @@ data DumpFlag
    | Opt_D_dump_hi
    | Opt_D_dump_hi_diffs
    | Opt_D_dump_mod_cycles
+   | Opt_D_dump_mod_map
    | Opt_D_dump_view_pattern_commoning
    | Opt_D_verbose_core2core
+   | Opt_D_dump_debug
 
    deriving (Eq, Show, Enum)
 
@@ -288,6 +296,7 @@ data GeneralFlag
    | Opt_PrintExplicitKinds
 
    -- optimisation opts
+   | Opt_CallArity
    | Opt_Strictness
    | Opt_LateDmdAnal
    | Opt_KillAbsence
@@ -328,6 +337,7 @@ data GeneralFlag
    | Opt_IgnoreInterfacePragmas
    | Opt_OmitInterfacePragmas
    | Opt_ExposeAllUnfoldings
+   | Opt_WriteInterface -- forces .hi files to be written even with -fno-code
 
    -- profiling opts
    | Opt_AutoSccsOnIndividualCafs
@@ -382,6 +392,7 @@ data GeneralFlag
    | Opt_ErrorSpans -- Include full span info in error messages,
                     -- instead of just the start position.
    | Opt_PprCaseAsLet
+   | Opt_PprShowTicks
 
    -- Suppress all coercions, them replacing with '...'
    | Opt_SuppressCoercions
@@ -401,8 +412,6 @@ data GeneralFlag
    | Opt_SuppressUniques
 
    -- temporary flags
-   | Opt_RunCPS
-   | Opt_RunCPSZ
    | Opt_AutoLinkPackages
    | Opt_ImplicitImportQualified
 
@@ -420,6 +429,10 @@ data GeneralFlag
    | Opt_DistrustAllPackages
    | Opt_PackageTrust
 
+   -- debugging flags
+   | Opt_Debug
+   | Opt_DebugCore
+
    deriving (Eq, Show, Enum)
 
 data WarningFlag =
@@ -455,7 +468,6 @@ data WarningFlag =
    | Opt_WarnTabs
    | Opt_WarnUnrecognisedPragmas
    | Opt_WarnDodgyForeignImports
-   | Opt_WarnLazyUnliftedBindings
    | Opt_WarnUnusedDoBind
    | Opt_WarnWrongDoBind
    | Opt_WarnAlternativeLayoutRuleTransitional
@@ -477,7 +489,6 @@ data SafeHaskellMode
    | Sf_Unsafe
    | Sf_Trustworthy
    | Sf_Safe
-   | Sf_SafeInferred
    deriving (Eq)
 
 instance Show SafeHaskellMode where
@@ -485,7 +496,6 @@ instance Show SafeHaskellMode where
     show Sf_Unsafe       = "Unsafe"
     show Sf_Trustworthy  = "Trustworthy"
     show Sf_Safe         = "Safe"
-    show Sf_SafeInferred = "Safe-Inferred"
 
 instance Outputable SafeHaskellMode where
     ppr = text . show
@@ -579,6 +589,7 @@ data ExtensionFlag
    | Opt_TraditionalRecordSyntax
    | Opt_LambdaCase
    | Opt_MultiWayIf
+   | Opt_BinaryLiterals
    | Opt_NegativeLiterals
    | Opt_EmptyCase
    | Opt_PatternSynonyms
@@ -626,7 +637,7 @@ data DynFlags = DynFlags {
   ctxtStkDepth          :: Int,         -- ^ Typechecker context stack depth
   tyFunStkDepth         :: Int,         -- ^ Typechecker type function stack depth
 
-  thisPackage           :: PackageId,   -- ^ name of package currently being compiled
+  thisPackage           :: PackageKey,   -- ^ name of package currently being compiled
 
   -- ways
   ways                  :: [Way],       -- ^ Way flags from the command line
@@ -733,11 +744,14 @@ data DynFlags = DynFlags {
   language              :: Maybe Language,
   -- | Safe Haskell mode
   safeHaskell           :: SafeHaskellMode,
+  safeInfer             :: Bool,
+  safeInferred          :: Bool,
   -- We store the location of where some extension and flags were turned on so
   -- we can produce accurate error messages when Safe Haskell fails due to
   -- them.
   thOnLoc               :: SrcSpan,
   newDerivOnLoc         :: SrcSpan,
+  overlapInstLoc        :: SrcSpan,
   pkgTrustOnLoc         :: SrcSpan,
   warnSafeOnLoc         :: SrcSpan,
   warnUnsafeOnLoc       :: SrcSpan,
@@ -773,7 +787,7 @@ data DynFlags = DynFlags {
   pprCols               :: Int,
   traceLevel            :: Int, -- Standard level is 1. Less verbose is 0.
 
-  useUnicodeQuotes      :: Bool,
+  useUnicode      :: Bool,
 
   -- | what kind of {-# SCC #-} to add automatically
   profAuto              :: ProfAuto,
@@ -797,8 +811,21 @@ data DynFlags = DynFlags {
   rtldInfo              :: IORef (Maybe LinkerInfo),
 
   -- | Run-time compiler information
-  rtccInfo              :: IORef (Maybe CompilerInfo)
- }
+  rtccInfo              :: IORef (Maybe CompilerInfo),
+
+  -- Constants used to control the amount of optimization done.
+
+  -- | Max size, in bytes, of inline array allocations.
+  maxInlineAllocSize    :: Int,
+
+  -- | Only inline memcpy if it generates no more than this many
+  -- pseudo (roughly: Cmm) instructions.
+  maxInlineMemcpyInsns  :: Int,
+
+  -- | Only inline memset if it generates no more than this many
+  -- pseudo (roughly: Cmm) instructions.
+  maxInlineMemsetInsns  :: Int
+}
 
 class HasDynFlags m where
     getDynFlags :: m DynFlags
@@ -813,7 +840,7 @@ data ProfAuto
   | ProfAutoTop        -- ^ top-level functions annotated only
   | ProfAutoExports    -- ^ exported functions annotated only
   | ProfAutoCalls      -- ^ annotate call-sites
-  deriving (Enum)
+  deriving (Eq,Enum)
 
 data Settings = Settings {
   sTargetPlatform        :: Platform,    -- Filled in by SysTools
@@ -1002,9 +1029,15 @@ isNoLink :: GhcLink -> Bool
 isNoLink NoLink = True
 isNoLink _      = False
 
+data PackageArg = PackageArg String
+                | PackageIdArg String
+                | PackageKeyArg String
+  deriving (Eq, Show)
+
+type ModRenaming = Maybe [(String, String)]
+
 data PackageFlag
-  = ExposePackage   String
-  | ExposePackageId String
+  = ExposePackage   PackageArg ModRenaming
   | HidePackage     String
   | IgnorePackage   String
   | TrustPackage    String
@@ -1198,7 +1231,6 @@ wayOptl platform WayThreaded =
         -- the problems are our fault or theirs, but it seems that using the
         -- alternative 1:1 threading library libthr works around it:
         OSFreeBSD  -> ["-lthr"]
-        OSSolaris2 -> ["-lrt"]
         OSOpenBSD  -> ["-pthread"]
         OSNetBSD   -> ["-pthread"]
         _          -> []
@@ -1278,12 +1310,12 @@ initDynFlags dflags = do
  refRtldInfo <- newIORef Nothing
  refRtccInfo <- newIORef Nothing
  wrapperNum <- newIORef emptyModuleEnv
- canUseUnicodeQuotes <- do let enc = localeEncoding
-                               str = "‛’"
-                           (withCString enc str $ \cstr ->
-                                do str' <- peekCString enc cstr
-                                   return (str == str'))
-                               `catchIOError` \_ -> return False
+ canUseUnicode <- do let enc = localeEncoding
+                         str = "‘’"
+                     (withCString enc str $ \cstr ->
+                          do str' <- peekCString enc cstr
+                             return (str == str'))
+                         `catchIOError` \_ -> return False
  return dflags{
         canGenerateDynamicToo = refCanGenerateDynamicToo,
         nextTempSuffix = refNextTempSuffix,
@@ -1293,7 +1325,7 @@ initDynFlags dflags = do
         generatedDumps = refGeneratedDumps,
         llvmVersion    = refLlvmVersion,
         nextWrapperNum = wrapperNum,
-        useUnicodeQuotes = canUseUnicodeQuotes,
+        useUnicode    = canUseUnicode,
         rtldInfo      = refRtldInfo,
         rtccInfo      = refRtccInfo
         }
@@ -1335,7 +1367,7 @@ defaultDynFlags mySettings =
         ctxtStkDepth            = mAX_CONTEXT_REDUCTION_DEPTH,
         tyFunStkDepth           = mAX_TYPE_FUNCTION_REDUCTION_DEPTH,
 
-        thisPackage             = mainPackageId,
+        thisPackage             = mainPackageKey,
 
         objectDir               = Nothing,
         dylibInstallName        = Nothing,
@@ -1400,9 +1432,12 @@ defaultDynFlags mySettings =
         warningFlags = IntSet.fromList (map fromEnum standardWarnings),
         ghciScripts = [],
         language = Nothing,
-        safeHaskell = Sf_SafeInferred,
+        safeHaskell = Sf_None,
+        safeInfer   = True,
+        safeInferred = True,
         thOnLoc = noSrcSpan,
         newDerivOnLoc = noSrcSpan,
+        overlapInstLoc = noSrcSpan,
         pkgTrustOnLoc = noSrcSpan,
         warnSafeOnLoc = noSrcSpan,
         warnUnsafeOnLoc = noSrcSpan,
@@ -1432,7 +1467,7 @@ defaultDynFlags mySettings =
         flushErr = defaultFlushErr,
         pprUserLength = 5,
         pprCols = 100,
-        useUnicodeQuotes = False,
+        useUnicode = False,
         traceLevel = 1,
         profAuto = NoProfAuto,
         llvmVersion = panic "defaultDynFlags: No llvmVersion",
@@ -1446,7 +1481,11 @@ defaultDynFlags mySettings =
         avx512f = False,
         avx512pf = False,
         rtldInfo = panic "defaultDynFlags: no rtldInfo",
-        rtccInfo = panic "defaultDynFlags: no rtccInfo"
+        rtccInfo = panic "defaultDynFlags: no rtccInfo",
+
+        maxInlineAllocSize = 128,
+        maxInlineMemcpyInsns = 32,
+        maxInlineMemsetInsns = 32
       }
 
 defaultWays :: Settings -> [Way]
@@ -1605,6 +1644,7 @@ dopt f dflags = (fromEnum f `IntSet.member` dumpFlags dflags)
           enableIfVerbose Opt_D_dump_ticked                 = False
           enableIfVerbose Opt_D_dump_view_pattern_commoning = False
           enableIfVerbose Opt_D_dump_mod_cycles             = False
+          enableIfVerbose Opt_D_dump_mod_map                = False
           enableIfVerbose _                                 = True
 
 -- | Set a 'DumpFlag'
@@ -1664,6 +1704,9 @@ lang_set dflags lang =
             extensionFlags = flattenExtensionFlags lang (extensions dflags)
           }
 
+useUnicodeSyntax :: DynFlags -> Bool
+useUnicodeSyntax = xopt Opt_UnicodeSyntax
+
 -- | Set the Haskell language standard to use
 setLanguage :: Language -> DynP ()
 setLanguage l = upd (`lang_set` Just l)
@@ -1678,7 +1721,7 @@ packageTrustOn = gopt Opt_PackageTrust
 
 -- | Is Safe Haskell on in some way (including inference mode)
 safeHaskellOn :: DynFlags -> Bool
-safeHaskellOn dflags = safeHaskell dflags /= Sf_None
+safeHaskellOn dflags = safeHaskell dflags /= Sf_None || safeInferOn dflags
 
 -- | Is the Safe Haskell safe language in use
 safeLanguageOn :: DynFlags -> Bool
@@ -1686,7 +1729,7 @@ safeLanguageOn dflags = safeHaskell dflags == Sf_Safe
 
 -- | Is the Safe Haskell safe inference mode active
 safeInferOn :: DynFlags -> Bool
-safeInferOn dflags = safeHaskell dflags == Sf_SafeInferred
+safeInferOn = safeInfer
 
 -- | Test if Safe Imports are on in some form
 safeImportsOn :: DynFlags -> Bool
@@ -1700,7 +1743,11 @@ setSafeHaskell s = updM f
     where f dfs = do
               let sf = safeHaskell dfs
               safeM <- combineSafeFlags sf s
-              return $ dfs { safeHaskell = safeM }
+              return $ case (s == Sf_Safe || s == Sf_Unsafe) of
+                True  -> dfs { safeHaskell = safeM, safeInfer = False }
+                -- leave safe inferrence on in Trustworthy mode so we can warn
+                -- if it could have been inferred safe.
+                False -> dfs { safeHaskell = safeM }
 
 -- | Are all direct imports required to be safe for this Safe Haskell mode?
 -- Direct imports are when the code explicitly imports a module
@@ -1717,9 +1764,7 @@ safeImplicitImpsReq d = safeLanguageOn d
 -- want to export this functionality from the module but do want to export the
 -- type constructors.
 combineSafeFlags :: SafeHaskellMode -> SafeHaskellMode -> DynP SafeHaskellMode
-combineSafeFlags a b | a == Sf_SafeInferred = return b
-                     | b == Sf_SafeInferred = return a
-                     | a == Sf_None         = return b
+combineSafeFlags a b | a == Sf_None         = return b
                      | b == Sf_None         = return a
                      | a == b               = return a
                      | otherwise            = addErr errm >> return (panic errm)
@@ -1731,13 +1776,19 @@ combineSafeFlags a b | a == Sf_SafeInferred = return b
 --     * function to get srcspan that enabled the flag
 --     * function to test if the flag is on
 --     * function to turn the flag off
-unsafeFlags :: [(String, DynFlags -> SrcSpan, DynFlags -> Bool, DynFlags -> DynFlags)]
+unsafeFlags, unsafeFlagsForInfer
+  :: [(String, DynFlags -> SrcSpan, DynFlags -> Bool, DynFlags -> DynFlags)]
 unsafeFlags = [("-XGeneralizedNewtypeDeriving", newDerivOnLoc,
                    xopt Opt_GeneralizedNewtypeDeriving,
                    flip xopt_unset Opt_GeneralizedNewtypeDeriving),
                ("-XTemplateHaskell", thOnLoc,
                    xopt Opt_TemplateHaskell,
                    flip xopt_unset Opt_TemplateHaskell)]
+unsafeFlagsForInfer = unsafeFlags ++
+              -- TODO: Can we do better than this for inference?
+              [("-XOverlappingInstances", overlapInstLoc,
+                  xopt Opt_OverlappingInstances,
+                  flip xopt_unset Opt_OverlappingInstances)]
 
 -- | Retrieve the options corresponding to a particular @opt_*@ field in the correct order
 getOpts :: DynFlags             -- ^ 'DynFlags' to retrieve the options from
@@ -2019,43 +2070,41 @@ updateWays dflags
 -- The bool is to indicate if we are parsing command line flags (false means
 -- file pragma). This allows us to generate better warnings.
 safeFlagCheck :: Bool -> DynFlags -> (DynFlags, [Located String])
-safeFlagCheck _  dflags | not (safeLanguageOn dflags || safeInferOn dflags)
-                        = (dflags, [])
-
--- safe or safe-infer ON
-safeFlagCheck cmdl dflags =
-    case safeLanguageOn dflags of
-        True -> (dflags', warns)
+safeFlagCheck _ dflags | safeLanguageOn dflags = (dflagsUnset, warns)
+  where
+    -- Handle illegal flags under safe language.
+    (dflagsUnset, warns) = foldl check_method (dflags, []) unsafeFlags
 
-        -- throw error if -fpackage-trust by itself with no safe haskell flag
-        False | not cmdl && packageTrustOn dflags
-              -> (gopt_unset dflags' Opt_PackageTrust,
-                  [L (pkgTrustOnLoc dflags') $
-                      "-fpackage-trust ignored;" ++
-                      " must be specified with a Safe Haskell flag"]
-                  )
+    check_method (df, warns) (str,loc,test,fix)
+        | test df   = (fix df, warns ++ safeFailure (loc df) str)
+        | otherwise = (df, warns)
 
-        False | null warns && safeInfOk
-              -> (dflags', [])
+    safeFailure loc str
+       = [L loc $ str ++ " is not allowed in Safe Haskell; ignoring "
+           ++ str]
 
-              | otherwise
-              -> (dflags' { safeHaskell = Sf_None }, [])
-                -- Have we inferred Unsafe?
-                -- See Note [HscMain . Safe Haskell Inference]
-    where
-        -- TODO: Can we do better than this for inference?
-        safeInfOk = not $ xopt Opt_OverlappingInstances dflags
+safeFlagCheck cmdl dflags =
+  case (safeInferOn dflags) of
+    True | safeFlags -> (dflags', warn)
+    True             -> (dflags' { safeInferred = False }, warn)
+    False            -> (dflags', warn)
 
-        (dflags', warns) = foldl check_method (dflags, []) unsafeFlags
+  where
+    -- dynflags and warn for when -fpackage-trust by itself with no safe
+    -- haskell flag
+    (dflags', warn)
+      | safeHaskell dflags == Sf_None && not cmdl && packageTrustOn dflags
+      = (gopt_unset dflags Opt_PackageTrust, pkgWarnMsg)
+      | otherwise = (dflags, [])
 
-        check_method (df, warns) (str,loc,test,fix)
-            | test df   = (apFix fix df, warns ++ safeFailure (loc dflags) str)
-            | otherwise = (df, warns)
+    pkgWarnMsg = [L (pkgTrustOnLoc dflags') $
+                    "-fpackage-trust ignored;" ++
+                    " must be specified with a Safe Haskell flag"]
 
-        apFix f = if safeInferOn dflags then id else f
+    safeFlags = all (\(_,_,t,_) -> not $ t dflags) unsafeFlagsForInfer
+    -- Have we inferred Unsafe?
+    -- See Note [HscMain . Safe Haskell Inference]
 
-        safeFailure loc str
-           = [L loc $ str ++ " is not allowed in Safe Haskell; ignoring " ++ str]
 
 {- **********************************************************************
 %*                                                                      *
@@ -2144,7 +2193,6 @@ dynamic_flags = [
   , Flag "pgmP"           (hasArg setPgmP)
   , 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 -pgmm flag does nothing; it will be removed in a future GHC release"))
   , 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,[])})))
@@ -2159,7 +2207,6 @@ dynamic_flags = [
   , Flag "optP"           (hasArg addOptP)
   , Flag "optF"           (hasArg (\f -> alterSettings (\s -> s { sOpt_F   = f : sOpt_F s})))
   , Flag "optc"           (hasArg addOptc)
-  , Flag "optm"           (HasArg (\_ -> addWarn "The -optm flag does nothing; it will be removed in a future GHC release"))
   , Flag "opta"           (hasArg (\f -> alterSettings (\s -> s { sOpt_a   = f : sOpt_a s})))
   , Flag "optl"           (hasArg addOptl)
   , Flag "optwindres"     (hasArg (\f -> alterSettings (\s -> s { sOpt_windres = f : sOpt_windres s})))
@@ -2171,16 +2218,9 @@ dynamic_flags = [
 
         -------- ghc -M -----------------------------------------------------
   , Flag "dep-suffix"     (hasArg addDepSuffix)
-  , Flag "optdep-s"       (hasArgDF addDepSuffix "Use -dep-suffix instead")
   , Flag "dep-makefile"   (hasArg setDepMakefile)
-  , Flag "optdep-f"       (hasArgDF setDepMakefile "Use -dep-makefile instead")
-  , Flag "optdep-w"       (NoArg  (deprecate "doesn't do anything"))
   , Flag "include-pkg-deps"         (noArg (setDepIncludePkgDeps True))
-  , Flag "optdep--include-prelude"  (noArgDF (setDepIncludePkgDeps True) "Use -include-pkg-deps instead")
-  , Flag "optdep--include-pkg-deps" (noArgDF (setDepIncludePkgDeps True) "Use -include-pkg-deps instead")
   , Flag "exclude-module"           (hasArg addDepExcludeMod)
-  , Flag "optdep--exclude-module"   (hasArgDF addDepExcludeMod "Use -exclude-module instead")
-  , Flag "optdep-x"                 (hasArgDF addDepExcludeMod "Use -exclude-module instead")
 
         -------- Linking ----------------------------------------------------
   , Flag "no-link"            (noArg (\d -> d{ ghcLink=NoLink }))
@@ -2225,8 +2265,6 @@ dynamic_flags = [
   , Flag "keep-hc-files"    (NoArg (setGeneralFlag Opt_KeepHcFiles))
   , Flag "keep-s-file"      (NoArg (setGeneralFlag Opt_KeepSFiles))
   , Flag "keep-s-files"     (NoArg (setGeneralFlag Opt_KeepSFiles))
-  , Flag "keep-raw-s-file"  (NoArg (addWarn "The -keep-raw-s-file flag does nothing; it will be removed in a future GHC release"))
-  , Flag "keep-raw-s-files" (NoArg (addWarn "The -keep-raw-s-files flag does nothing; it will be removed in a future GHC release"))
   , Flag "keep-llvm-file"   (NoArg (do setObjTarget HscLlvm
                                        setGeneralFlag Opt_KeepLlvmFiles))
   , Flag "keep-llvm-files"  (NoArg (do setObjTarget HscLlvm
@@ -2322,6 +2360,7 @@ dynamic_flags = [
   , Flag "ddump-spec"              (setDumpFlag Opt_D_dump_spec)
   , Flag "ddump-prep"              (setDumpFlag Opt_D_dump_prep)
   , Flag "ddump-stg"               (setDumpFlag Opt_D_dump_stg)
+  , Flag "ddump-call-arity"        (setDumpFlag Opt_D_dump_call_arity)
   , Flag "ddump-stranal"           (setDumpFlag Opt_D_dump_stranal)
   , Flag "ddump-strsigs"           (setDumpFlag Opt_D_dump_strsigs)
   , Flag "ddump-tc"                (setDumpFlag Opt_D_dump_tc)
@@ -2350,6 +2389,7 @@ dynamic_flags = [
   , Flag "ddump-hpc"               (setDumpFlag Opt_D_dump_ticked) -- back compat
   , Flag "ddump-ticked"            (setDumpFlag Opt_D_dump_ticked)
   , Flag "ddump-mod-cycles"        (setDumpFlag Opt_D_dump_mod_cycles)
+  , Flag "ddump-mod-map"           (setDumpFlag Opt_D_dump_mod_map)
   , Flag "ddump-view-pattern-commoning" (setDumpFlag Opt_D_dump_view_pattern_commoning)
   , Flag "ddump-to-file"           (NoArg (setGeneralFlag Opt_DumpToFile))
   , Flag "ddump-hi-diffs"          (setDumpFlag Opt_D_dump_hi_diffs)
@@ -2362,12 +2402,10 @@ dynamic_flags = [
                                               setVerbosity $ Just 2))
   , Flag "dfaststring-stats"       (NoArg (setGeneralFlag Opt_D_faststring_stats))
   , Flag "dno-llvm-mangler"        (NoArg (setGeneralFlag Opt_NoLlvmMangler)) -- hidden flag
+  , Flag "ddump-debug"             (setDumpFlag Opt_D_dump_debug)
 
         ------ Machine dependant (-m<blah>) stuff ---------------------------
 
-  , Flag "monly-2-regs" (NoArg (addWarn "The -monly-2-regs flag does nothing; it will be removed in a future GHC release"))
-  , Flag "monly-3-regs" (NoArg (addWarn "The -monly-3-regs flag does nothing; it will be removed in a future GHC release"))
-  , Flag "monly-4-regs" (NoArg (addWarn "The -monly-4-regs flag does nothing; it will be removed in a future GHC release"))
   , Flag "msse"         (versionSuffix (\maj min d -> d{ sseVersion = Just (maj, min) }))
   , Flag "mavx"         (noArg (\d -> d{ avx = True }))
   , Flag "mavx2"        (noArg (\d -> d{ avx2 = True }))
@@ -2428,6 +2466,9 @@ dynamic_flags = [
   , Flag "fmax-worker-args" (intSuffix (\n d -> d {maxWorkerArgs = n}))
 
   , Flag "fghci-hist-size" (intSuffix (\n d -> d {ghciHistSize = n}))
+  , Flag "fmax-inline-alloc-size"      (intSuffix (\n d -> d{ maxInlineAllocSize = n }))
+  , Flag "fmax-inline-memcpy-insns"    (intSuffix (\n d -> d{ maxInlineMemcpyInsns = n }))
+  , Flag "fmax-inline-memset-insns"    (intSuffix (\n d -> d{ maxInlineMemsetInsns = n }))
 
         ------ Profiling ----------------------------------------------------
 
@@ -2464,9 +2505,14 @@ dynamic_flags = [
 
         ------ Safe Haskell flags -------------------------------------------
   , Flag "fpackage-trust"   (NoArg setPackageTrust)
-  , Flag "fno-safe-infer"   (NoArg (setSafeHaskell Sf_None))
+  , Flag "fno-safe-infer"   (noArg (\d -> d { safeInfer = False  } ))
   , Flag "fPIC"             (NoArg (setGeneralFlag Opt_PIC))
   , Flag "fno-PIC"          (NoArg (unSetGeneralFlag Opt_PIC))
+
+        ------ Debugging flags ----------------------------------------------
+  , Flag "g"                (NoArg (setGeneralFlag Opt_Debug))
+  , Flag "fsave-core"       (NoArg (setGeneralFlag Opt_DebugCore))
+
  ]
  ++ map (mkFlag turnOn  ""     setGeneralFlag  ) negatableFlags
  ++ map (mkFlag turnOff "no-"  unSetGeneralFlag) negatableFlags
@@ -2503,9 +2549,13 @@ package_flags = [
                                     removeUserPkgConf
                                     deprecate "Use -no-user-package-db instead")
 
-  , Flag "package-name"          (hasArg setPackageName)
+  , Flag "package-name"          (HasArg $ \name -> do
+                                    upd (setPackageKey name)
+                                    deprecate "Use -this-package-key instead")
+  , Flag "this-package-key"      (hasArg setPackageKey)
   , Flag "package-id"            (HasArg exposePackageId)
   , Flag "package"               (HasArg exposePackage)
+  , Flag "package-key"           (HasArg exposePackageKey)
   , Flag "hide-package"          (HasArg hidePackage)
   , Flag "hide-all-packages"     (NoArg (setGeneralFlag Opt_HideAllPackages))
   , Flag "ignore-package"        (HasArg ignorePackage)
@@ -2581,15 +2631,14 @@ fWarningFlags = [
   ( "warn-warnings-deprecations",       Opt_WarnWarningsDeprecations, nop ),
   ( "warn-deprecations",                Opt_WarnWarningsDeprecations, nop ),
   ( "warn-deprecated-flags",            Opt_WarnDeprecatedFlags, nop ),
-  ( "warn-amp",                         Opt_WarnAMP, nop ),
+  ( "warn-amp",                         Opt_WarnAMP,
+    \_ -> deprecate "it has no effect, and will be removed in GHC 7.12" ),
   ( "warn-orphans",                     Opt_WarnOrphans, nop ),
   ( "warn-identities",                  Opt_WarnIdentities, nop ),
   ( "warn-auto-orphans",                Opt_WarnAutoOrphans, nop ),
   ( "warn-tabs",                        Opt_WarnTabs, nop ),
   ( "warn-typed-holes",                 Opt_WarnTypedHoles, nop ),
   ( "warn-unrecognised-pragmas",        Opt_WarnUnrecognisedPragmas, nop ),
-  ( "warn-lazy-unlifted-bindings",      Opt_WarnLazyUnliftedBindings,
-    \_ -> deprecate "it has no effect, and will be removed in GHC 7.10" ),
   ( "warn-unused-do-bind",              Opt_WarnUnusedDoBind, nop ),
   ( "warn-wrong-do-bind",               Opt_WarnWrongDoBind, nop ),
   ( "warn-alternative-layout-rule-transitional", Opt_WarnAlternativeLayoutRuleTransitional, nop ),
@@ -2615,7 +2664,8 @@ dFlags = [
   ( "suppress-idinfo",                  Opt_SuppressIdInfo,             nop),
   ( "suppress-type-signatures",         Opt_SuppressTypeSignatures,     nop),
   ( "suppress-uniques",                 Opt_SuppressUniques,            nop),
-  ( "ppr-case-as-let",                  Opt_PprCaseAsLet,               nop)]
+  ( "ppr-case-as-let",                  Opt_PprCaseAsLet,               nop),
+  ( "ppr-ticks",                        Opt_PprShowTicks,               nop)]
 
 -- | These @-f\<blah\>@ flags can all be reversed with @-fno-\<blah\>@
 fFlags :: [FlagSpec GeneralFlag]
@@ -2623,6 +2673,7 @@ fFlags = [
   ( "error-spans",                      Opt_ErrorSpans, nop ),
   ( "print-explicit-foralls",           Opt_PrintExplicitForalls, nop ),
   ( "print-explicit-kinds",             Opt_PrintExplicitKinds, nop ),
+  ( "call-arity",                       Opt_CallArity, nop ),
   ( "strictness",                       Opt_Strictness, nop ),
   ( "late-dmd-anal",                    Opt_LateDmdAnal, nop ),
   ( "specialise",                       Opt_Specialise, nop ),
@@ -2635,6 +2686,7 @@ fFlags = [
   ( "pedantic-bottoms",                 Opt_PedanticBottoms, nop ),
   ( "ignore-interface-pragmas",         Opt_IgnoreInterfacePragmas, nop ),
   ( "omit-interface-pragmas",           Opt_OmitInterfacePragmas, nop ),
+  ( "write-interface",                  Opt_WriteInterface, nop ),
   ( "expose-all-unfoldings",            Opt_ExposeAllUnfoldings, nop ),
   ( "do-lambda-eta-expansion",          Opt_DoLambdaEtaExpansion, nop ),
   ( "ignore-asserts",                   Opt_IgnoreAsserts, nop ),
@@ -2654,8 +2706,6 @@ fFlags = [
   ( "break-on-error",                   Opt_BreakOnError, nop ),
   ( "print-evld-with-show",             Opt_PrintEvldWithShow, nop ),
   ( "print-bind-contents",              Opt_PrintBindContents, nop ),
-  ( "run-cps",                          Opt_RunCPS, nop ),
-  ( "run-cpsz",                         Opt_RunCPSZ, nop ),
   ( "vectorise",                        Opt_Vectorise, nop ),
   ( "vectorisation-avoidance",          Opt_VectorisationAvoidance, nop ),
   ( "regs-graph",                       Opt_RegsGraph, nop ),
@@ -2670,7 +2720,8 @@ fFlags = [
   ( "fun-to-thunk",                     Opt_FunToThunk, nop ),
   ( "gen-manifest",                     Opt_GenManifest, nop ),
   ( "embed-manifest",                   Opt_EmbedManifest, nop ),
-  ( "ext-core",                         Opt_EmitExternalCore, nop ),
+  ( "ext-core",                         Opt_EmitExternalCore,
+    \_ -> deprecate "it has no effect, and will be removed in GHC 7.12" ),
   ( "shared-implib",                    Opt_SharedImplib, nop ),
   ( "ghci-sandbox",                     Opt_GhciSandbox, nop ),
   ( "ghci-history",                     Opt_GhciHistory, nop ),
@@ -2854,13 +2905,17 @@ xFlags = [
   ( "FlexibleInstances",                Opt_FlexibleInstances, nop ),
   ( "ConstrainedClassMethods",          Opt_ConstrainedClassMethods, nop ),
   ( "MultiParamTypeClasses",            Opt_MultiParamTypeClasses, nop ),
-  ( "NullaryTypeClasses",               Opt_NullaryTypeClasses, nop ),
+  ( "NullaryTypeClasses",               Opt_NullaryTypeClasses,
+    deprecatedForExtension "MultiParamTypeClasses" ),
   ( "FunctionalDependencies",           Opt_FunctionalDependencies, nop ),
   ( "GeneralizedNewtypeDeriving",       Opt_GeneralizedNewtypeDeriving, setGenDeriving ),
-  ( "OverlappingInstances",             Opt_OverlappingInstances, nop ),
+  ( "OverlappingInstances",             Opt_OverlappingInstances, 
+    \ turn_on -> when turn_on
+               $ deprecate "instead use per-instance pragmas OVERLAPPING/OVERLAPPABLE/OVERLAPS" ),
   ( "UndecidableInstances",             Opt_UndecidableInstances, nop ),
   ( "IncoherentInstances",              Opt_IncoherentInstances, nop ),
   ( "PackageImports",                   Opt_PackageImports, nop ),
+  ( "BinaryLiterals",                   Opt_BinaryLiterals, nop ),
   ( "NegativeLiterals",                 Opt_NegativeLiterals, nop ),
   ( "EmptyCase",                        Opt_EmptyCase, nop ),
   ( "PatternSynonyms",                  Opt_PatternSynonyms, nop )
@@ -2945,6 +3000,9 @@ impliedFlags
     , (Opt_ImplicitParams, turnOn, Opt_FlexibleInstances)
 
     , (Opt_JavaScriptFFI, turnOn, Opt_InterruptibleFFI)
+    
+    , (Opt_DeriveTraversable, turnOn, Opt_DeriveFunctor)
+    , (Opt_DeriveTraversable, turnOn, Opt_DeriveFoldable)
   ]
 
 optLevelFlags :: [([Int], GeneralFlag)]
@@ -2957,6 +3015,7 @@ optLevelFlags
                                          --              in PrelRules
     , ([1,2],   Opt_DoEtaReduction)
     , ([1,2],   Opt_CaseMerge)
+    , ([1,2],   Opt_CallArity)
     , ([1,2],   Opt_Strictness)
     , ([1,2],   Opt_CSE)
     , ([1,2],   Opt_FullLaziness)
@@ -3001,7 +3060,6 @@ standardWarnings
     = [ Opt_WarnOverlappingPatterns,
         Opt_WarnWarningsDeprecations,
         Opt_WarnDeprecatedFlags,
-        Opt_WarnAMP,
         Opt_WarnTypedHoles,
         Opt_WarnUnrecognisedPragmas,
         Opt_WarnPointlessPragmas,
@@ -3172,16 +3230,9 @@ noArg fn = NoArg (upd fn)
 noArgM :: (DynFlags -> DynP DynFlags) -> OptKind (CmdLineP DynFlags)
 noArgM fn = NoArg (updM fn)
 
-noArgDF :: (DynFlags -> DynFlags) -> String -> OptKind (CmdLineP DynFlags)
-noArgDF fn deprec = NoArg (upd fn >> deprecate deprec)
-
 hasArg :: (String -> DynFlags -> DynFlags) -> OptKind (CmdLineP DynFlags)
 hasArg fn = HasArg (upd . fn)
 
-hasArgDF :: (String -> DynFlags -> DynFlags) -> String -> OptKind (CmdLineP DynFlags)
-hasArgDF fn deprec = HasArg (\s -> do upd (fn s)
-                                      deprecate deprec)
-
 sepArg :: (String -> DynFlags -> DynFlags) -> OptKind (CmdLineP DynFlags)
 sepArg fn = SepArg (upd . fn)
 
@@ -3315,11 +3366,39 @@ removeGlobalPkgConf = upd $ \s -> s { extraPkgConfs = filter isNotGlobal . extra
 clearPkgConf :: DynP ()
 clearPkgConf = upd $ \s -> s { extraPkgConfs = const [] }
 
-exposePackage, exposePackageId, hidePackage, ignorePackage,
+parsePackageFlag :: (String -> PackageArg) -- type of argument
+                 -> String                 -- string to parse
+                 -> PackageFlag
+parsePackageFlag constr str = case filter ((=="").snd) (readP_to_S parse str) of
+    [(r, "")] -> r
+    _ -> throwGhcException $ CmdLineError ("Can't parse package flag: " ++ str)
+  where parse = do
+            pkg <- munch1 (\c -> isAlphaNum c || c `elem` ":-_.")
+            (do _ <- tok $ R.char '('
+                rns <- tok $ sepBy parseItem (tok $ R.char ',')
+                _ <- tok $ R.char ')'
+                return (ExposePackage (constr pkg) (Just rns))
+              +++
+             return (ExposePackage (constr pkg) Nothing))
+        parseMod = munch1 (\c -> isAlphaNum c || c `elem` ".")
+        parseItem = do
+            orig <- tok $ parseMod
+            (do _ <- tok $ string "as"
+                new <- tok $ parseMod
+                return (orig, new)
+              +++
+             return (orig, orig))
+        tok m = skipSpaces >> m
+
+exposePackage, exposePackageId, exposePackageKey, hidePackage, ignorePackage,
         trustPackage, distrustPackage :: String -> DynP ()
 exposePackage p = upd (exposePackage' p)
 exposePackageId p =
-  upd (\s -> s{ packageFlags = ExposePackageId p : packageFlags s })
+  upd (\s -> s{ packageFlags =
+    parsePackageFlag PackageIdArg p : packageFlags s })
+exposePackageKey p =
+  upd (\s -> s{ packageFlags =
+    parsePackageFlag PackageKeyArg p : packageFlags s })
 hidePackage p =
   upd (\s -> s{ packageFlags = HidePackage p : packageFlags s })
 ignorePackage p =
@@ -3331,10 +3410,11 @@ distrustPackage p = exposePackage p >>
 
 exposePackage' :: String -> DynFlags -> DynFlags
 exposePackage' p dflags
-    = dflags { packageFlags = ExposePackage p : packageFlags dflags }
+    = dflags { packageFlags =
+            parsePackageFlag PackageArg p : packageFlags dflags }
 
-setPackageName :: String -> DynFlags -> DynFlags
-setPackageName p s =  s{ thisPackage = stringToPackageId p }
+setPackageKey :: String -> DynFlags -> DynFlags
+setPackageKey p s =  s{ thisPackage = stringToPackageKey p }
 
 -- If we're linking a binary, then only targets that produce object
 -- code are allowed (requests for other target types are ignored).
@@ -3386,10 +3466,10 @@ setMainIs arg
   | not (null main_fn) && isLower (head main_fn)
      -- The arg looked like "Foo.Bar.baz"
   = upd $ \d -> d{ mainFunIs = Just main_fn,
-                   mainModIs = mkModule mainPackageId (mkModuleName main_mod) }
+                   mainModIs = mkModule mainPackageKey (mkModuleName main_mod) }
 
   | isUpper (head arg)  -- The arg looked like "Foo" or "Foo.Bar"
-  = upd $ \d -> d{ mainModIs = mkModule mainPackageId (mkModuleName arg) }
+  = upd $ \d -> d{ mainModIs = mkModule mainPackageKey (mkModuleName arg) }
 
   | otherwise                   -- The arg looked like "baz"
   = upd $ \d -> d{ mainFunIs = Just arg }
@@ -3523,10 +3603,10 @@ picCCOpts dflags
           --     Don't generate "common" symbols - these are unwanted
           --     in dynamic libraries.
 
-       | gopt Opt_PIC dflags -> ["-fno-common", "-U __PIC__", "-D__PIC__"]
+       | gopt Opt_PIC dflags -> ["-fno-common", "-U__PIC__", "-D__PIC__"]
        | otherwise           -> ["-mdynamic-no-pic"]
       OSMinGW32 -- no -fPIC for Windows
-       | gopt Opt_PIC dflags -> ["-U __PIC__", "-D__PIC__"]
+       | gopt Opt_PIC dflags -> ["-U__PIC__", "-D__PIC__"]
        | otherwise           -> []
       _
       -- we need -fPIC for C files when we are compiling with -dynamic,
@@ -3535,12 +3615,12 @@ picCCOpts dflags
       -- objects, but can't without -fPIC.  See
       -- http://ghc.haskell.org/trac/ghc/wiki/Commentary/PositionIndependentCode
        | gopt Opt_PIC dflags || not (gopt Opt_Static dflags) ->
-          ["-fPIC", "-U __PIC__", "-D__PIC__"]
+          ["-fPIC", "-U__PIC__", "-D__PIC__"]
        | otherwise                             -> []
 
 picPOpts :: DynFlags -> [String]
 picPOpts dflags
- | gopt Opt_PIC dflags = ["-U __PIC__", "-D__PIC__"]
+ | gopt Opt_PIC dflags = ["-U__PIC__", "-D__PIC__"]
  | otherwise           = []
 
 -- -----------------------------------------------------------------------------
@@ -3576,6 +3656,8 @@ compilerInfo dflags
        ("RTS ways",                    cGhcRTSWays),
        ("Support dynamic-too",         if isWindows then "NO" else "YES"),
        ("Support parallel --make",     "YES"),
+       ("Support reexported-modules",  "YES"),
+       ("Uses package keys",           "YES"),
        ("Dynamic by default",          if dYNAMIC_BY_DEFAULT dflags
                                        then "YES" else "NO"),
        ("GHC Dynamic",                 if dynamicGhc
@@ -3749,6 +3831,8 @@ data LinkerInfo
 data CompilerInfo
    = GCC
    | Clang
+   | AppleClang
+   | AppleClang51
    | UnknownCC
    deriving Eq
 
diff --git a/compiler/main/DynFlags.hs-boot b/compiler/main/DynFlags.hs-boot
index 04ec5a4e7dd3..5cf21669bd10 100644
--- a/compiler/main/DynFlags.hs-boot
+++ b/compiler/main/DynFlags.hs-boot
@@ -9,4 +9,5 @@ targetPlatform       :: DynFlags -> Platform
 pprUserLength        :: DynFlags -> Int
 pprCols              :: DynFlags -> Int
 unsafeGlobalDynFlags :: DynFlags
-useUnicodeQuotes     :: DynFlags -> Bool
+useUnicode     :: DynFlags -> Bool
+useUnicodeSyntax     :: DynFlags -> Bool
diff --git a/compiler/main/DynamicLoading.hs b/compiler/main/DynamicLoading.hs
index ffafc7821672..046d13cee57e 100644
--- a/compiler/main/DynamicLoading.hs
+++ b/compiler/main/DynamicLoading.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE CPP, MagicHash #-}
+
 -- | Dynamically lookup up values from modules and loading them.
 module DynamicLoading (
 #ifdef GHCI
diff --git a/compiler/main/ErrUtils.lhs b/compiler/main/ErrUtils.lhs
index 12b6bad68aad..c43064e7f1e7 100644
--- a/compiler/main/ErrUtils.lhs
+++ b/compiler/main/ErrUtils.lhs
@@ -4,17 +4,21 @@
 \section[ErrsUtils]{Utilities for error reporting}
 
 \begin{code}
+{-# LANGUAGE CPP #-}
 
 module ErrUtils (
+        MsgDoc, 
+        Validity(..), andValid, allValid, isValid, getInvalids,
+
         ErrMsg, WarnMsg, Severity(..),
         Messages, ErrorMessages, WarningMessages,
         errMsgSpan, errMsgContext, errMsgShortDoc, errMsgExtraInfo,
-        MsgDoc, mkLocMessage, pprMessageBag, pprErrMsgBag, pprErrMsgBagWithLoc,
+        mkLocMessage, pprMessageBag, pprErrMsgBag, pprErrMsgBagWithLoc,
         pprLocErrMsg, makeIntoWarning,
-        
+
         errorsFound, emptyMessages, isEmptyMessages,
         mkErrMsg, mkPlainErrMsg, mkLongErrMsg, mkWarnMsg, mkPlainWarnMsg,
-        printBagOfErrors, 
+        printBagOfErrors,
         warnIsErrorMsg, mkLongWarnMsg,
 
         ghcExit,
@@ -45,7 +49,7 @@ import DynFlags
 
 import System.Directory
 import System.Exit      ( ExitCode(..), exitWith )
-import System.FilePath
+import System.FilePath  ( takeDirectory, (</>) )
 import Data.List
 import qualified Data.Set as Set
 import Data.IORef
@@ -55,6 +59,29 @@ import Control.Monad
 import Control.Monad.IO.Class
 import System.IO
 
+-------------------------
+type MsgDoc  = SDoc
+
+-------------------------
+data Validity
+  = IsValid            -- Everything is fine
+  | NotValid MsgDoc    -- A problem, and some indication of why
+
+isValid :: Validity -> Bool
+isValid IsValid       = True
+isValid (NotValid {}) = False
+
+andValid :: Validity -> Validity -> Validity
+andValid IsValid v = v
+andValid v _       = v
+
+allValid :: [Validity] -> Validity   -- If they aren't all valid, return the first
+allValid []       = IsValid
+allValid (v : vs) = v `andValid` allValid vs
+
+getInvalids :: [Validity] -> [MsgDoc]
+getInvalids vs = [d | NotValid d <- vs]
+
 -- -----------------------------------------------------------------------------
 -- Basic error messages: just render a message with a source location.
 
@@ -73,7 +100,6 @@ data ErrMsg = ErrMsg {
         -- The SrcSpan is used for sorting errors into line-number order
 
 type WarnMsg = ErrMsg
-type MsgDoc = SDoc
 
 data Severity
   = SevOutput
diff --git a/compiler/main/Finder.lhs b/compiler/main/Finder.lhs
index 60683b2289ea..f9c7e2eee02a 100644
--- a/compiler/main/Finder.lhs
+++ b/compiler/main/Finder.lhs
@@ -4,6 +4,8 @@
 \section[Finder]{Module Finder}
 
 \begin{code}
+{-# LANGUAGE CPP #-}
+
 module Finder (
     flushFinderCaches,
     FindResult(..),
@@ -41,13 +43,12 @@ import Maybes           ( expectJust )
 import Exception        ( evaluate )
 
 import Distribution.Text
-import Distribution.Package hiding (PackageId)
 import Data.IORef       ( IORef, writeIORef, readIORef, atomicModifyIORef )
 import System.Directory
 import System.FilePath
 import Control.Monad
-import Data.List        ( partition )
 import Data.Time
+import Data.List        ( foldl' )
 
 
 type FileExt = String   -- Filename extension
@@ -78,12 +79,12 @@ flushFinderCaches hsc_env = do
         fc_ref = hsc_FC hsc_env
         mlc_ref = hsc_MLC hsc_env
 
-flushModLocationCache :: PackageId -> IORef ModLocationCache -> IO ()
+flushModLocationCache :: PackageKey -> IORef ModLocationCache -> IO ()
 flushModLocationCache this_pkg ref = do
   atomicModifyIORef ref $ \fm -> (filterModuleEnv is_ext fm, ())
   _ <- evaluate =<< readIORef ref
   return ()
-  where is_ext mod _ | modulePackageId mod /= this_pkg = True
+  where is_ext mod _ | modulePackageKey mod /= this_pkg = True
                      | otherwise = False
 
 addToFinderCache :: IORef FinderCache -> ModuleName -> FindResult -> IO ()
@@ -146,7 +147,7 @@ findImportedModule hsc_env mod_name mb_pkg =
 findExactModule :: HscEnv -> Module -> IO FindResult
 findExactModule hsc_env mod =
     let dflags = hsc_dflags hsc_env
-    in if modulePackageId mod == thisPackage dflags
+    in if modulePackageKey mod == thisPackage dflags
        then findHomeModule hsc_env (moduleName mod)
        else findPackageModule hsc_env mod
 
@@ -188,41 +189,21 @@ homeSearchCache hsc_env mod_name do_this = do
 findExposedPackageModule :: HscEnv -> ModuleName -> Maybe FastString
                          -> IO FindResult
 findExposedPackageModule hsc_env mod_name mb_pkg
-        -- not found in any package:
-  = case lookupModuleWithSuggestions (hsc_dflags hsc_env) mod_name of
-       Left suggest -> return (NotFound { fr_paths = [], fr_pkg = Nothing
-                                        , fr_pkgs_hidden = []
-                                        , fr_mods_hidden = []
-                                        , fr_suggestions = suggest })
-       Right found
-         | null found_exposed   -- Found, but with no exposed copies
-          -> return (NotFound { fr_paths = [], fr_pkg = Nothing
-                              , fr_pkgs_hidden = pkg_hiddens
-                              , fr_mods_hidden = mod_hiddens
-                              , fr_suggestions = [] })
-
-         | [(pkg_conf,_)] <- found_exposed     -- Found uniquely
-         -> let pkgid = packageConfigId pkg_conf in
-            findPackageModule_ hsc_env (mkModule pkgid mod_name) pkg_conf
-
-         | otherwise           -- Found in more than one place
-         -> return (FoundMultiple (map (packageConfigId.fst) found_exposed))
-         where
-           for_this_pkg  = case mb_pkg of
-                             Nothing -> found
-                             Just p  -> filter ((`matches` p) . fst) found
-           found_exposed = filter is_exposed for_this_pkg
-           is_exposed (pkg_conf,exposed_mod) = exposed pkg_conf && exposed_mod
-
-           mod_hiddens = [ packageConfigId pkg_conf
-                         | (pkg_conf,False) <- found ]
-
-           pkg_hiddens = [ packageConfigId pkg_conf
-                         | (pkg_conf,_) <- found, not (exposed pkg_conf) ]
-
-           pkg_conf  `matches` pkg
-              = case packageName pkg_conf of
-                  PackageName n -> pkg == mkFastString n
+  = case lookupModuleWithSuggestions (hsc_dflags hsc_env) mod_name mb_pkg of
+     LookupFound m pkg_conf ->
+       findPackageModule_ hsc_env m pkg_conf
+     LookupMultiple rs ->
+       return (FoundMultiple rs)
+     LookupHidden pkg_hiddens mod_hiddens ->
+       return (NotFound{ fr_paths = [], fr_pkg = Nothing
+                       , fr_pkgs_hidden = map (modulePackageKey.fst) pkg_hiddens
+                       , fr_mods_hidden = map (modulePackageKey.fst) mod_hiddens
+                       , fr_suggestions = [] })
+     LookupNotFound suggest ->
+       return (NotFound{ fr_paths = [], fr_pkg = Nothing
+                       , fr_pkgs_hidden = []
+                       , fr_mods_hidden = []
+                       , fr_suggestions = suggest })
 
 modLocationCache :: HscEnv -> Module -> IO FindResult -> IO FindResult
 modLocationCache hsc_env mod do_this = do
@@ -293,15 +274,22 @@ findPackageModule :: HscEnv -> Module -> IO FindResult
 findPackageModule hsc_env mod = do
   let
         dflags = hsc_dflags hsc_env
-        pkg_id = modulePackageId mod
-        pkg_map = pkgIdMap (pkgState dflags)
+        pkg_id = modulePackageKey mod
   --
-  case lookupPackage pkg_map pkg_id of
+  case lookupPackage dflags pkg_id of
      Nothing -> return (NoPackage pkg_id)
      Just pkg_conf -> findPackageModule_ hsc_env mod pkg_conf
 
+-- | Look up the interface file associated with module @mod@.  This function
+-- requires a few invariants to be upheld: (1) the 'Module' in question must
+-- be the module identifier of the *original* implementation of a module,
+-- not a reexport (this invariant is upheld by @Packages.lhs@) and (2)
+-- the 'PackageConfig' must be consistent with the package key in the 'Module'.
+-- The redundancy is to avoid an extra lookup in the package state
+-- for the appropriate config.
 findPackageModule_ :: HscEnv -> Module -> PackageConfig -> IO FindResult
 findPackageModule_ hsc_env mod pkg_conf =
+  ASSERT( modulePackageKey mod == packageConfigId pkg_conf )
   modLocationCache hsc_env mod $
 
   -- special case for GHC.Prim; we won't find it in the filesystem.
@@ -371,7 +359,7 @@ searchPathExts paths mod exts
                 ]
 
     search [] = return (NotFound { fr_paths = map fst to_search
-                                 , fr_pkg   = Just (modulePackageId mod)
+                                 , fr_pkg   = Just (modulePackageKey mod)
                                  , fr_mods_hidden = [], fr_pkgs_hidden = []
                                  , fr_suggestions = [] })
 
@@ -432,8 +420,8 @@ mkHomeModLocation2 :: DynFlags
 mkHomeModLocation2 dflags mod src_basename ext = do
    let mod_basename = moduleNameSlashes mod
 
-   obj_fn  <- mkObjPath  dflags src_basename mod_basename
-   hi_fn   <- mkHiPath   dflags src_basename mod_basename
+       obj_fn = mkObjPath  dflags src_basename mod_basename
+       hi_fn  = mkHiPath   dflags src_basename mod_basename
 
    return (ModLocation{ ml_hs_file   = Just (src_basename <.> ext),
                         ml_hi_file   = hi_fn,
@@ -443,7 +431,7 @@ mkHiOnlyModLocation :: DynFlags -> Suffix -> FilePath -> String
                     -> IO ModLocation
 mkHiOnlyModLocation dflags hisuf path basename
  = do let full_basename = path </> basename
-      obj_fn  <- mkObjPath  dflags full_basename basename
+          obj_fn = mkObjPath  dflags full_basename basename
       return ModLocation{    ml_hs_file   = Nothing,
                              ml_hi_file   = full_basename <.> hisuf,
                                 -- Remove the .hi-boot suffix from
@@ -459,16 +447,15 @@ mkObjPath
   :: DynFlags
   -> FilePath           -- the filename of the source file, minus the extension
   -> String             -- the module name with dots replaced by slashes
-  -> IO FilePath
-mkObjPath dflags basename mod_basename
-  = do  let
+  -> FilePath
+mkObjPath dflags basename mod_basename = obj_basename <.> osuf
+  where
                 odir = objectDir dflags
                 osuf = objectSuf dflags
 
                 obj_basename | Just dir <- odir = dir </> mod_basename
                              | otherwise        = basename
 
-        return (obj_basename <.> osuf)
 
 -- | Constructs the filename of a .hi file for a given source file.
 -- Does /not/ check whether the .hi file exists
@@ -476,16 +463,15 @@ mkHiPath
   :: DynFlags
   -> FilePath           -- the filename of the source file, minus the extension
   -> String             -- the module name with dots replaced by slashes
-  -> IO FilePath
-mkHiPath dflags basename mod_basename
-  = do  let
+  -> FilePath
+mkHiPath dflags basename mod_basename = hi_basename <.> hisuf
+ where
                 hidir = hiDir dflags
                 hisuf = hiSuf dflags
 
                 hi_basename | Just dir <- hidir = dir </> mod_basename
                             | otherwise         = basename
 
-        return (hi_basename <.> hisuf)
 
 
 -- -----------------------------------------------------------------------------
@@ -548,18 +534,38 @@ cannotFindInterface = cantFindErr (sLit "Failed to load interface for")
 
 cantFindErr :: LitString -> LitString -> DynFlags -> ModuleName -> FindResult
             -> SDoc
-cantFindErr _ multiple_found _ mod_name (FoundMultiple pkgs)
+cantFindErr _ multiple_found _ mod_name (FoundMultiple mods)
+  | Just pkgs <- unambiguousPackages
   = hang (ptext multiple_found <+> quotes (ppr mod_name) <> colon) 2 (
        sep [ptext (sLit "it was found in multiple packages:"),
-                hsep (map (text.packageIdString) pkgs)]
+                hsep (map ppr pkgs) ]
     )
+  | otherwise
+  = hang (ptext multiple_found <+> quotes (ppr mod_name) <> colon) 2 (
+       vcat (map pprMod mods)
+    )
+  where
+    unambiguousPackages = foldl' unambiguousPackage (Just []) mods
+    unambiguousPackage (Just xs) (m, ModOrigin (Just _) _ _ _)
+        = Just (modulePackageKey m : xs)
+    unambiguousPackage _ _ = Nothing
+
+    pprMod (m, o) = ptext (sLit "it is bound as") <+> ppr m <+>
+                                ptext (sLit "by") <+> pprOrigin m o
+    pprOrigin _ ModHidden = panic "cantFindErr: bound by mod hidden"
+    pprOrigin m (ModOrigin e res _ f) = sep $ punctuate comma (
+      if e == Just True
+          then [ptext (sLit "package") <+> ppr (modulePackageKey m)]
+          else [] ++
+      map ((ptext (sLit "a reexport in package") <+>)
+                .ppr.packageConfigId) res ++
+      if f then [ptext (sLit "a package flag")] else []
+      )
+
 cantFindErr cannot_find _ dflags mod_name find_result
   = ptext cannot_find <+> quotes (ppr mod_name)
     $$ more_info
   where
-    pkg_map :: PackageConfigMap
-    pkg_map = pkgIdMap (pkgState dflags)
-
     more_info
       = case find_result of
             NoPackage pkg
@@ -615,7 +621,7 @@ cantFindErr cannot_find _ dflags mod_name find_result
         <> dot $$ cabal_pkg_hidden_hint pkg
     cabal_pkg_hidden_hint pkg
      | gopt Opt_BuildingCabalPackage dflags
-        = case simpleParse (packageIdString pkg) of
+        = case simpleParse (packageKeyString pkg) of
           Just pid ->
               ptext (sLit "Perhaps you need to add") <+>
               quotes (text (display (pkgName pid))) <+>
@@ -626,22 +632,40 @@ cantFindErr cannot_find _ dflags mod_name find_result
     mod_hidden pkg =
         ptext (sLit "it is a hidden module in the package") <+> quotes (ppr pkg)
 
-    pp_suggestions :: [Module] -> SDoc
+    pp_suggestions :: [ModuleSuggestion] -> SDoc
     pp_suggestions sugs
       | null sugs = empty
       | otherwise = hang (ptext (sLit "Perhaps you meant"))
-                       2 (vcat [ vcat (map pp_exp exposed_sugs)
-                               , vcat (map pp_hid hidden_sugs) ])
-      where
-        (exposed_sugs, hidden_sugs) = partition from_exposed_pkg sugs
-
-    from_exposed_pkg m = case lookupPackage pkg_map (modulePackageId m) of
-                            Just pkg_config -> exposed pkg_config
-                            Nothing         -> WARN( True, ppr m ) -- Should not happen
-                                               False
-
-    pp_exp mod = ppr (moduleName mod)
-                 <+> parens (ptext (sLit "from") <+> ppr (modulePackageId mod))
-    pp_hid mod = ppr (moduleName mod)
-                 <+> parens (ptext (sLit "needs flag -package") <+> ppr (modulePackageId mod))
+                       2 (vcat (map pp_sugg sugs))
+
+    -- NB: Prefer the *original* location, and then reexports, and then
+    -- package flags when making suggestions.  ToDo: if the original package
+    -- also has a reexport, prefer that one
+    pp_sugg (SuggestVisible m mod o) = ppr m <+> provenance o
+      where provenance ModHidden = empty
+            provenance (ModOrigin{ fromOrigPackage = e,
+                                   fromExposedReexport = res,
+                                   fromPackageFlag = f })
+              | Just True <- e
+                 = parens (ptext (sLit "from") <+> ppr (modulePackageKey mod))
+              | f && moduleName mod == m
+                 = parens (ptext (sLit "from") <+> ppr (modulePackageKey mod))
+              | (pkg:_) <- res
+                 = parens (ptext (sLit "from") <+> ppr (packageConfigId pkg)
+                    <> comma <+> ptext (sLit "reexporting") <+> ppr mod)
+              | f
+                 = parens (ptext (sLit "defined via package flags to be")
+                    <+> ppr mod)
+              | otherwise = empty
+    pp_sugg (SuggestHidden m mod o) = ppr m <+> provenance o
+      where provenance ModHidden =  empty
+            provenance (ModOrigin{ fromOrigPackage = e,
+                                   fromHiddenReexport = rhs })
+              | Just False <- e
+                 = parens (ptext (sLit "needs flag -package-key")
+                    <+> ppr (modulePackageKey mod))
+              | (pkg:_) <- rhs
+                 = parens (ptext (sLit "needs flag -package-key")
+                    <+> ppr (packageConfigId pkg))
+              | otherwise = empty
 \end{code}
diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs
index 6b2815a4eeb8..9ab52ebf1d87 100644
--- a/compiler/main/GHC.hs
+++ b/compiler/main/GHC.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE CPP, NondecreasingIndentation, ScopedTypeVariables #-}
+
 -- -----------------------------------------------------------------------------
 --
 -- (c) The University of Glasgow, 2005-2012
@@ -53,7 +55,6 @@ module GHC (
         -- ** Compiling to Core
         CoreModule(..),
         compileToCoreModule, compileToCoreSimplified,
-        compileCoreToObj,
 
         -- * Inspecting the module structure of the program
         ModuleGraph, ModSummary(..), ms_mod_name, ModLocation(..),
@@ -80,7 +81,7 @@ module GHC (
         SafeHaskellMode(..),
 
         -- * Querying the environment
-        packageDbModules,
+        -- packageDbModules,
 
         -- * Printing
         PrintUnqualified, alwaysQualify,
@@ -102,6 +103,7 @@ module GHC (
         parseName,
         RunResult(..),  
         runStmt, runStmtWithLocation, runDecls, runDeclsWithLocation,
+        runTcInteractive,   -- Desired by some clients (Trac #8878)
         parseImportDecl, SingleStep(..),
         resume,
         Resume(resumeStmt, resumeThreadId, resumeBreakInfo, resumeSpan,
@@ -131,10 +133,10 @@ module GHC (
         -- * Abstract syntax elements
 
         -- ** Packages
-        PackageId,
+        PackageKey,
 
         -- ** Modules
-        Module, mkModule, pprModule, moduleName, modulePackageId,
+        Module, mkModule, pprModule, moduleName, modulePackageKey,
         ModuleName, mkModuleName, moduleNameString,
 
         -- ** Names
@@ -257,8 +259,10 @@ module GHC (
 import ByteCodeInstr
 import BreakArray
 import InteractiveEval
+import TcRnDriver       ( runTcInteractive )
 #endif
 
+import PprTyThing       ( pprFamInst )
 import HscMain
 import GhcMake
 import DriverPipeline   ( compileOne' )
@@ -281,7 +285,7 @@ import DataCon
 import Name             hiding ( varName )
 import Avail
 import InstEnv
-import FamInstEnv
+import FamInstEnv ( FamInst )
 import SrcLoc
 import CoreSyn
 import TidyPgm
@@ -295,6 +299,7 @@ import Annotations
 import Module
 import UniqFM
 import Panic
+import Platform
 import Bag              ( unitBag )
 import ErrUtils
 import MonadUtils
@@ -307,7 +312,7 @@ import FastString
 import qualified Parser
 import Lexer
 
-import System.Directory ( doesFileExist, getCurrentDirectory )
+import System.Directory ( doesFileExist )
 import Data.Maybe
 import Data.List        ( find )
 import Data.Time
@@ -441,7 +446,7 @@ runGhcT mb_top_dir ghct = do
 -- reside.  More precisely, this should be the output of @ghc --print-libdir@
 -- of the version of GHC the module using this API is compiled with.  For
 -- portability, you should use the @ghc-paths@ package, available at
--- <http://hackage.haskell.org/cgi-bin/hackage-scripts/package/ghc-paths>.
+-- <http://hackage.haskell.org/package/ghc-paths>.
 
 initGhcMonad :: GhcMonad m => Maybe FilePath -> m ()
 initGhcMonad mb_top_dir
@@ -450,12 +455,45 @@ initGhcMonad mb_top_dir
                    ; initStaticOpts
                    ; mySettings <- initSysTools mb_top_dir
                    ; dflags <- initDynFlags (defaultDynFlags mySettings)
+                   ; checkBrokenTablesNextToCode dflags
                    ; setUnsafeGlobalDynFlags dflags
                       -- c.f. DynFlags.parseDynamicFlagsFull, which
                       -- creates DynFlags and sets the UnsafeGlobalDynFlags
                    ; newHscEnv dflags }
        ; setSession env }
 
+-- | The binutils linker on ARM emits unnecessary R_ARM_COPY relocations which
+-- breaks tables-next-to-code in dynamically linked modules. This
+-- check should be more selective but there is currently no released
+-- version where this bug is fixed.
+-- See https://sourceware.org/bugzilla/show_bug.cgi?id=16177 and
+-- https://ghc.haskell.org/trac/ghc/ticket/4210#comment:29
+checkBrokenTablesNextToCode :: MonadIO m => DynFlags -> m ()
+checkBrokenTablesNextToCode dflags
+  = do { broken <- checkBrokenTablesNextToCode' dflags
+       ; when broken
+         $ do { _ <- liftIO $ throwIO $ mkApiErr dflags invalidLdErr
+              ; fail "unsupported linker"
+              }
+       }
+  where
+    invalidLdErr = text "Tables-next-to-code not supported on ARM" <+>
+                   text "when using binutils ld (please see:" <+>
+                   text "https://sourceware.org/bugzilla/show_bug.cgi?id=16177)"
+
+checkBrokenTablesNextToCode' :: MonadIO m => DynFlags -> m Bool
+checkBrokenTablesNextToCode' dflags
+  | not (isARM arch)              = return False
+  | WayDyn `notElem` ways dflags  = return False
+  | not (tablesNextToCode dflags) = return False
+  | otherwise                     = do
+    linkerInfo <- liftIO $ getLinkerInfo dflags
+    case linkerInfo of
+      GnuLD _  -> return True
+      _        -> return False
+  where platform = targetPlatform dflags
+        arch = platformArch platform
+
 
 -- %************************************************************************
 -- %*                                                                      *
@@ -496,7 +534,7 @@ initGhcMonad mb_top_dir
 -- flags.  If you are not doing linking or doing static linking, you
 -- can ignore the list of packages returned.
 --
-setSessionDynFlags :: GhcMonad m => DynFlags -> m [PackageId]
+setSessionDynFlags :: GhcMonad m => DynFlags -> m [PackageKey]
 setSessionDynFlags dflags = do
   (dflags', preload) <- liftIO $ initPackages dflags
   modifySession $ \h -> h{ hsc_dflags = dflags'
@@ -505,7 +543,7 @@ setSessionDynFlags dflags = do
   return preload
 
 -- | Sets the program 'DynFlags'.
-setProgramDynFlags :: GhcMonad m => DynFlags -> m [PackageId]
+setProgramDynFlags :: GhcMonad m => DynFlags -> m [PackageKey]
 setProgramDynFlags dflags = do
   (dflags', preload) <- liftIO $ initPackages dflags
   modifySession $ \h -> h{ hsc_dflags = dflags' }
@@ -889,43 +927,6 @@ compileToCoreModule = compileCore False
 -- as to return simplified and tidied Core.
 compileToCoreSimplified :: GhcMonad m => FilePath -> m CoreModule
 compileToCoreSimplified = compileCore True
--- | Takes a CoreModule and compiles the bindings therein
--- to object code. The first argument is a bool flag indicating
--- whether to run the simplifier.
--- The resulting .o, .hi, and executable files, if any, are stored in the
--- current directory, and named according to the module name.
--- This has only so far been tested with a single self-contained module.
-compileCoreToObj :: GhcMonad m
-                 => Bool -> CoreModule -> FilePath -> FilePath -> m ()
-compileCoreToObj simplify cm@(CoreModule{ cm_module = mName })
-                 output_fn extCore_filename = do
-  dflags      <- getSessionDynFlags
-  currentTime <- liftIO $ getCurrentTime
-  cwd         <- liftIO $ getCurrentDirectory
-  modLocation <- liftIO $ mkHiOnlyModLocation dflags (hiSuf dflags) cwd
-                   ((moduleNameSlashes . moduleName) mName)
-
-  let modSum = ModSummary { ms_mod = mName,
-         ms_hsc_src = ExtCoreFile,
-         ms_location = modLocation,
-         -- By setting the object file timestamp to Nothing,
-         -- we always force recompilation, which is what we
-         -- want. (Thus it doesn't matter what the timestamp
-         -- for the (nonexistent) source file is.)
-         ms_hs_date = currentTime,
-         ms_obj_date = Nothing,
-         -- Only handling the single-module case for now, so no imports.
-         ms_srcimps = [],
-         ms_textual_imps = [],
-         -- No source file
-         ms_hspp_file = "",
-         ms_hspp_opts = dflags,
-         ms_hspp_buf = Nothing
-      }
-
-  hsc_env <- getSession
-  liftIO $ hscCompileCore hsc_env simplify (cm_safe cm) modSum (cm_binds cm) output_fn extCore_filename
-
 
 compileCore :: GhcMonad m => Bool -> FilePath -> m CoreModule
 compileCore simplify fn = do
@@ -1166,9 +1167,10 @@ getGRE = withSession $ \hsc_env-> return $ ic_rn_gbl_env (hsc_IC hsc_env)
 
 -- -----------------------------------------------------------------------------
 
+{- ToDo: Move the primary logic here to compiler/main/Packages.lhs
 -- | Return all /external/ modules available in the package database.
 -- Modules from the current session (i.e., from the 'HomePackageTable') are
--- not included.
+-- not included.  This includes module names which are reexported by packages.
 packageDbModules :: GhcMonad m =>
                     Bool  -- ^ Only consider exposed packages.
                  -> m [Module]
@@ -1176,10 +1178,13 @@ packageDbModules only_exposed = do
    dflags <- getSessionDynFlags
    let pkgs = eltsUFM (pkgIdMap (pkgState dflags))
    return $
-     [ mkModule pid modname | p <- pkgs
-                            , not only_exposed || exposed p
-                            , let pid = packageConfigId p
-                            , modname <- exposedModules p ]
+     [ mkModule pid modname
+     | p <- pkgs
+     , not only_exposed || exposed p
+     , let pid = packageConfigId p
+     , modname <- exposedModules p
+               ++ map exportName (reexportedModules p) ]
+               -}
 
 -- -----------------------------------------------------------------------------
 -- Misc exported utils
@@ -1300,7 +1305,7 @@ showRichTokenStream ts = go startLoc ts ""
 -- -----------------------------------------------------------------------------
 -- Interactive evaluation
 
--- | Takes a 'ModuleName' and possibly a 'PackageId', and consults the
+-- | Takes a 'ModuleName' and possibly a 'PackageKey', and consults the
 -- filesystem and package database to find the corresponding 'Module', 
 -- using the algorithm that is used for an @import@ declaration.
 findModule :: GhcMonad m => ModuleName -> Maybe FastString -> m Module
@@ -1310,7 +1315,7 @@ findModule mod_name maybe_pkg = withSession $ \hsc_env -> do
     this_pkg = thisPackage dflags
   --
   case maybe_pkg of
-    Just pkg | fsToPackageId pkg /= this_pkg && pkg /= fsLit "this" -> liftIO $ do
+    Just pkg | fsToPackageKey pkg /= this_pkg && pkg /= fsLit "this" -> liftIO $ do
       res <- findImportedModule hsc_env mod_name maybe_pkg
       case res of
         Found _ m -> return m
@@ -1322,7 +1327,7 @@ findModule mod_name maybe_pkg = withSession $ \hsc_env -> do
         Nothing -> liftIO $ do
            res <- findImportedModule hsc_env mod_name maybe_pkg
            case res of
-             Found loc m | modulePackageId m /= this_pkg -> return m
+             Found loc m | modulePackageKey m /= this_pkg -> return m
                          | otherwise -> modNotLoadedError dflags m loc
              err -> throwOneError $ noModError dflags noSrcSpan mod_name err
 
@@ -1367,7 +1372,7 @@ isModuleTrusted m = withSession $ \hsc_env ->
     liftIO $ hscCheckSafe hsc_env m noSrcSpan
 
 -- | Return if a module is trusted and the pkgs it depends on to be trusted.
-moduleTrustReqs :: GhcMonad m => Module -> m (Bool, [PackageId])
+moduleTrustReqs :: GhcMonad m => Module -> m (Bool, [PackageKey])
 moduleTrustReqs m = withSession $ \hsc_env ->
     liftIO $ hscGetSafe hsc_env m noSrcSpan
 
diff --git a/compiler/main/GhcMake.hs b/compiler/main/GhcMake.hs
index c8afd83beb1d..0c63203d4c63 100644
--- a/compiler/main/GhcMake.hs
+++ b/compiler/main/GhcMake.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE BangPatterns, CPP, NondecreasingIndentation, ScopedTypeVariables #-}
 {-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}
 -- NB: we specifically ignore deprecations. GHC 7.6 marks the .QSem module as
 -- deprecated, although it became un-deprecated later. As a result, using 7.6
@@ -46,7 +46,7 @@ import BasicTypes
 import Digraph
 import Exception        ( tryIO, gbracket, gfinally )
 import FastString
-import Maybes           ( expectJust, mapCatMaybes )
+import Maybes           ( expectJust )
 import MonadUtils       ( allM, MonadIO )
 import Outputable
 import Panic
@@ -63,6 +63,7 @@ import qualified Data.Set as Set
 import qualified FiniteMap as Map ( insertListWith )
 
 import Control.Concurrent ( forkIOWithUnmask, killThread )
+import qualified GHC.Conc as CC
 import Control.Concurrent.MVar
 import Control.Concurrent.QSem
 import Control.Exception
@@ -80,6 +81,11 @@ import System.IO.Error  ( isDoesNotExistError )
 
 import GHC.Conc ( getNumProcessors, getNumCapabilities, setNumCapabilities )
 
+label_self :: String -> IO ()
+label_self thread_name = do
+    self_tid <- CC.myThreadId
+    CC.labelThread self_tid thread_name
+
 -- -----------------------------------------------------------------------------
 -- Loading the program
 
@@ -744,10 +750,18 @@ parUpsweep n_jobs old_hpt stable_mods cleanup sccs = do
                          | ((ms,mvar,_),idx) <- comp_graph_w_idx ]
 
 
+    liftIO $ label_self "main --make thread"
     -- For each module in the module graph, spawn a worker thread that will
     -- compile this module.
     let { spawnWorkers = forM comp_graph_w_idx $ \((mod,!mvar,!log_queue),!mod_idx) ->
             forkIOWithUnmask $ \unmask -> do
+                liftIO $ label_self $ unwords
+                    [ "worker --make thread"
+                    , "for module"
+                    , show (moduleNameString (ms_mod_name mod))
+                    , "number"
+                    , show mod_idx
+                    ]
                 -- Replace the default log_action with one that writes each
                 -- message to the module's log_queue. The main thread will
                 -- deal with synchronously printing these messages.
@@ -1443,7 +1457,7 @@ moduleGraphNodes drop_hs_boot_nodes summaries = (graphFromEdgedVertices nodes, l
                 | otherwise          = HsBootFile
 
     out_edge_keys :: HscSource -> [ModuleName] -> [Int]
-    out_edge_keys hi_boot ms = mapCatMaybes (lookup_key hi_boot) ms
+    out_edge_keys hi_boot ms = mapMaybe (lookup_key hi_boot) ms
         -- If we want keep_hi_boot_nodes, then we do lookup_key with
         -- the IsBootInterface parameter True; else False
 
@@ -1786,7 +1800,7 @@ summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod)
                          just_found location mod
                 | otherwise ->
                         -- Drop external-pkg
-                        ASSERT(modulePackageId mod /= thisPackage dflags)
+                        ASSERT(modulePackageKey mod /= thisPackage dflags)
                         return Nothing
 
              err -> return $ Just $ Left $ noModError dflags loc wanted_mod err
diff --git a/compiler/main/GhcMonad.hs b/compiler/main/GhcMonad.hs
index 68b4e2b2a272..5fa6452d587f 100644
--- a/compiler/main/GhcMonad.hs
+++ b/compiler/main/GhcMonad.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE RankNTypes #-}
 {-# OPTIONS_GHC -funbox-strict-fields #-}
 -- -----------------------------------------------------------------------------
 --
diff --git a/compiler/main/HeaderInfo.hs b/compiler/main/HeaderInfo.hs
index a083f4fcd8c8..fcf235bd23f9 100644
--- a/compiler/main/HeaderInfo.hs
+++ b/compiler/main/HeaderInfo.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE CPP #-}
+
 -----------------------------------------------------------------------------
 --
 -- | Parsing the top of a Haskell source file to get its module name,
@@ -185,8 +187,8 @@ lazyGetToks dflags filename handle = do
        -- large module names (#5981)
      nextbuf <- hGetStringBufferBlock handle new_size
      if (len nextbuf == 0) then lazyLexBuf handle state True new_size else do
-     newbuf <- appendStringBuffers (buffer state) nextbuf
-     unsafeInterleaveIO $ lazyLexBuf handle state{buffer=newbuf} False new_size
+       newbuf <- appendStringBuffers (buffer state) nextbuf
+       unsafeInterleaveIO $ lazyLexBuf handle state{buffer=newbuf} False new_size
 
 
 getToks :: DynFlags -> FilePath -> StringBuffer -> [Located Token]
diff --git a/compiler/main/Hooks.lhs b/compiler/main/Hooks.lhs
index 3bd9643dc66f..63aaafa2a7f5 100644
--- a/compiler/main/Hooks.lhs
+++ b/compiler/main/Hooks.lhs
@@ -63,7 +63,7 @@ data Hooks = Hooks
   , tcForeignImportsHook   :: Maybe ([LForeignDecl Name] -> TcM ([Id], [LForeignDecl Id], Bag GlobalRdrElt))
   , tcForeignExportsHook   :: Maybe ([LForeignDecl Name] -> TcM (LHsBinds TcId, [LForeignDecl TcId], Bag GlobalRdrElt))
   , hscFrontendHook        :: Maybe (ModSummary -> Hsc TcGblEnv)
-  , hscCompileOneShotHook  :: Maybe (HscEnv -> FilePath -> ModSummary -> SourceModified -> IO HscStatus)
+  , hscCompileOneShotHook  :: Maybe (HscEnv -> ModSummary -> SourceModified -> IO HscStatus)
   , hscCompileCoreExprHook :: Maybe (HscEnv -> SrcSpan -> CoreExpr -> IO HValue)
   , ghcPrimIfaceHook       :: Maybe ModIface
   , runPhaseHook           :: Maybe (PhasePlus -> FilePath -> DynFlags -> CompPipeline (PhasePlus, FilePath))
diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs
index 04b0823db41c..d0a50d8e1378 100644
--- a/compiler/main/HscMain.hs
+++ b/compiler/main/HscMain.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE BangPatterns, CPP, MagicHash, NondecreasingIndentation #-}
+
 -------------------------------------------------------------------------------
 --
 -- | Main API for compiling plain Haskell source code.
@@ -146,7 +148,6 @@ import ErrUtils
 import Outputable
 import HscStats         ( ppSourceStats )
 import HscTypes
-import MkExternalCore   ( emitExternalCore )
 import FastString
 import UniqFM           ( emptyUFM )
 import UniqSupply
@@ -406,19 +407,20 @@ tcRnModule' hsc_env sum save_rn_syntax mod = do
 
     tcSafeOK <- liftIO $ readIORef (tcg_safeInfer tcg_res)
     dflags   <- getDynFlags
+    let allSafeOK = safeInferred dflags && tcSafeOK
 
-    -- end of the Safe Haskell line, how to respond to user?
-    if not (safeHaskellOn dflags) || (safeInferOn dflags && not tcSafeOK)
-        -- if safe haskell off or safe infer failed, wipe trust
-        then wipeTrust tcg_res emptyBag
+    -- end of the safe haskell line, how to respond to user?
+    if not (safeHaskellOn dflags) || (safeInferOn dflags && not allSafeOK)
+        -- if safe Haskell off or safe infer failed, mark unsafe
+        then markUnsafe tcg_res emptyBag
 
-        -- module safe, throw warning if needed
+        -- module (could be) safe, throw warning if needed
         else do
             tcg_res' <- hscCheckSafeImports tcg_res
             safe <- liftIO $ readIORef (tcg_safeInfer tcg_res')
             when (safe && wopt Opt_WarnSafe dflags)
-                 (logWarnings $ unitBag $
-                     mkPlainWarnMsg dflags (warnSafeOnLoc dflags) $ errSafe tcg_res')
+                 (logWarnings $ unitBag $ mkPlainWarnMsg dflags
+                     (warnSafeOnLoc dflags) $ errSafe tcg_res')
             return tcg_res'
   where
     pprMod t  = ppr $ moduleName $ tcg_mod t
@@ -516,8 +518,9 @@ genericHscCompileGetFrontendResult ::
                   -> (Int,Int)       -- (i,n) = module i of n (for msgs)
                   -> IO (Either ModIface (TcGblEnv, Maybe Fingerprint))
 
-genericHscCompileGetFrontendResult always_do_basic_recompilation_check m_tc_result
-                                   mHscMessage hsc_env mod_summary source_modified mb_old_iface mod_index
+genericHscCompileGetFrontendResult
+  always_do_basic_recompilation_check m_tc_result
+  mHscMessage hsc_env mod_summary source_modified mb_old_iface mod_index
     = do
 
     let msg what = case mHscMessage of
@@ -553,16 +556,19 @@ genericHscCompileGetFrontendResult always_do_basic_recompilation_check m_tc_resu
 
             case mb_checked_iface of
                 Just iface | not (recompileRequired recomp_reqd) ->
-                    -- If the module used TH splices when it was last compiled,
-                    -- then the recompilation check is not accurate enough (#481)
-                    -- and we must ignore it. However, if the module is stable
-                    -- (none of the modules it depends on, directly or indirectly,
-                    -- changed), then we *can* skip recompilation. This is why
-                    -- the SourceModified type contains SourceUnmodifiedAndStable,
-                    -- and it's pretty important: otherwise ghc --make would
-                    -- always recompile TH modules, even if nothing at all has
-                    -- changed. Stability is just the same check that make is
-                    -- doing for us in one-shot mode.
+                    -- If the module used TH splices when it was last
+                    -- compiled, then the recompilation check is not
+                    -- accurate enough (#481) and we must ignore
+                    -- it.  However, if the module is stable (none of
+                    -- the modules it depends on, directly or
+                    -- indirectly, changed), then we *can* skip
+                    -- recompilation. This is why the SourceModified
+                    -- type contains SourceUnmodifiedAndStable, and
+                    -- it's pretty important: otherwise ghc --make
+                    -- would always recompile TH modules, even if
+                    -- nothing at all has changed. Stability is just
+                    -- the same check that make is doing for us in
+                    -- one-shot mode.
                     case m_tc_result of
                     Nothing
                      | mi_used_th iface && not stable ->
@@ -580,31 +586,25 @@ genericHscFrontend mod_summary =
   getHooked hscFrontendHook genericHscFrontend' >>= ($ mod_summary)
 
 genericHscFrontend' :: ModSummary -> Hsc TcGblEnv
-genericHscFrontend' mod_summary
-    | ExtCoreFile <- ms_hsc_src mod_summary =
-        panic "GHC does not currently support reading External Core files"
-    | otherwise =
-        hscFileFrontEnd mod_summary
+genericHscFrontend' mod_summary = hscFileFrontEnd mod_summary
 
 --------------------------------------------------------------
 -- Compilers
 --------------------------------------------------------------
 
 hscCompileOneShot :: HscEnv
-                  -> FilePath
                   -> ModSummary
                   -> SourceModified
                   -> IO HscStatus
 hscCompileOneShot env =
   lookupHook hscCompileOneShotHook hscCompileOneShot' (hsc_dflags env) env
 
--- Compile Haskell, boot and extCore in OneShot mode.
+-- Compile Haskell/boot in OneShot mode.
 hscCompileOneShot' :: HscEnv
-                   -> FilePath
                    -> ModSummary
                    -> SourceModified
                    -> IO HscStatus
-hscCompileOneShot' hsc_env extCore_filename mod_summary src_changed
+hscCompileOneShot' hsc_env mod_summary src_changed
   = do
     -- One-shot mode needs a knot-tying mutable variable for interface
     -- files. See TcRnTypes.TcGblEnv.tcg_type_env_var.
@@ -624,7 +624,11 @@ hscCompileOneShot' hsc_env extCore_filename mod_summary src_changed
             guts0 <- hscDesugar' (ms_location mod_summary) tc_result
             dflags <- getDynFlags
             case hscTarget dflags of
-                HscNothing -> return HscNotGeneratingCode
+                HscNothing -> do
+                    when (gopt Opt_WriteInterface dflags) $ liftIO $ do
+                        (iface, changed, _details) <- hscSimpleIface hsc_env tc_result mb_old_hash
+                        hscWriteIface dflags iface changed mod_summary
+                    return HscNotGeneratingCode
                 _ ->
                     case ms_hsc_src mod_summary of
                     HsBootFile ->
@@ -633,7 +637,7 @@ hscCompileOneShot' hsc_env extCore_filename mod_summary src_changed
                            return HscUpdateBoot
                     _ ->
                         do guts <- hscSimplify' guts0
-                           (iface, changed, _details, cgguts) <- hscNormalIface' extCore_filename guts mb_old_hash
+                           (iface, changed, _details, cgguts) <- hscNormalIface' guts mb_old_hash
                            liftIO $ hscWriteIface dflags iface changed mod_summary
                            return $ HscRecomp cgguts mod_summary
 
@@ -770,16 +774,15 @@ hscCheckSafeImports tcg_env = do
     tcg_env' <- checkSafeImports dflags tcg_env
     case safeLanguageOn dflags of
         True -> do
-            -- we nuke user written RULES in -XSafe
+            -- XSafe: we nuke user written RULES
             logWarnings $ warns dflags (tcg_rules tcg_env')
             return tcg_env' { tcg_rules = [] }
         False
-              -- user defined RULES, so not safe or already unsafe
-            | safeInferOn dflags && not (null $ tcg_rules tcg_env') ||
-              safeHaskell dflags == Sf_None
-            -> wipeTrust tcg_env' $ warns dflags (tcg_rules tcg_env')
+              -- SafeInferred: user defined RULES, so not safe
+            | safeInferOn dflags && not (null $ tcg_rules tcg_env')
+            -> markUnsafe tcg_env' $ warns dflags (tcg_rules tcg_env')
 
-              -- trustworthy OR safe inferred with no RULES
+              -- Trustworthy OR SafeInferred: with no RULES
             | otherwise
             -> return tcg_env'
 
@@ -825,7 +828,7 @@ checkSafeImports dflags tcg_env
             True ->
                 -- did we fail safe inference or fail -XSafe?
                 case safeInferOn dflags of
-                    True  -> wipeTrust tcg_env errs
+                    True  -> markUnsafe tcg_env errs
                     False -> liftIO . throwIO . mkSrcErr $ errs
 
             -- All good matey!
@@ -839,14 +842,16 @@ checkSafeImports dflags tcg_env
     imp_info = tcg_imports tcg_env     -- ImportAvails
     imports  = imp_mods imp_info       -- ImportedMods
     imports' = moduleEnvToList imports -- (Module, [ImportedModsVal])
-    pkg_reqs = imp_trust_pkgs imp_info -- [PackageId]
+    pkg_reqs = imp_trust_pkgs imp_info -- [PackageKey]
 
     condense :: (Module, [ImportedModsVal]) -> Hsc (Module, SrcSpan, IsSafeImport)
     condense (_, [])   = panic "HscMain.condense: Pattern match failure!"
     condense (m, x:xs) = do (_,_,l,s) <- foldlM cond' x xs
                             -- we turn all imports into safe ones when
                             -- inference mode is on.
-                            let s' = if safeInferOn dflags then True else s
+                            let s' = if safeInferOn dflags &&
+                                        safeHaskell dflags == Sf_None
+                                        then True else s
                             return (m, l, s')
 
     -- ImportedModsVal = (ModuleName, Bool, SrcSpan, IsSafeImport)
@@ -876,7 +881,7 @@ hscCheckSafe hsc_env m l = runHsc hsc_env $ do
     return $ isEmptyBag errs
 
 -- | Return if a module is trusted and the pkgs it depends on to be trusted.
-hscGetSafe :: HscEnv -> Module -> SrcSpan -> IO (Bool, [PackageId])
+hscGetSafe :: HscEnv -> Module -> SrcSpan -> IO (Bool, [PackageKey])
 hscGetSafe hsc_env m l = runHsc hsc_env $ do
     dflags       <- getDynFlags
     (self, pkgs) <- hscCheckSafe' dflags m l
@@ -890,15 +895,15 @@ hscGetSafe hsc_env m l = runHsc hsc_env $ do
 -- Return (regardless of trusted or not) if the trust type requires the modules
 -- own package be trusted and a list of other packages required to be trusted
 -- (these later ones haven't been checked) but the own package trust has been.
-hscCheckSafe' :: DynFlags -> Module -> SrcSpan -> Hsc (Maybe PackageId, [PackageId])
+hscCheckSafe' :: DynFlags -> Module -> SrcSpan -> Hsc (Maybe PackageKey, [PackageKey])
 hscCheckSafe' dflags m l = do
     (tw, pkgs) <- isModSafe m l
     case tw of
         False              -> return (Nothing, pkgs)
         True | isHomePkg m -> return (Nothing, pkgs)
-             | otherwise   -> return (Just $ modulePackageId m, pkgs)
+             | otherwise   -> return (Just $ modulePackageKey m, pkgs)
   where
-    isModSafe :: Module -> SrcSpan -> Hsc (Bool, [PackageId])
+    isModSafe :: Module -> SrcSpan -> Hsc (Bool, [PackageKey])
     isModSafe m l = do
         iface <- lookup' m
         case iface of
@@ -912,7 +917,7 @@ hscCheckSafe' dflags m l = do
                 let trust = getSafeMode $ mi_trust iface'
                     trust_own_pkg = mi_trust_pkg iface'
                     -- check module is trusted
-                    safeM = trust `elem` [Sf_SafeInferred, Sf_Safe, Sf_Trustworthy]
+                    safeM = trust `elem` [Sf_Safe, Sf_Trustworthy]
                     -- check package is trusted
                     safeP = packageTrusted trust trust_own_pkg m
                     -- pkg trust reqs
@@ -927,13 +932,13 @@ hscCheckSafe' dflags m l = do
                     return (trust == Sf_Trustworthy, pkgRs)
 
                 where
-                    pkgTrustErr = unitBag $ mkPlainErrMsg dflags l $
+                    pkgTrustErr = unitBag $ mkErrMsg dflags l (pkgQual dflags) $
                         sep [ ppr (moduleName m)
                                 <> text ": Can't be safely imported!"
-                            , text "The package (" <> ppr (modulePackageId m)
+                            , text "The package (" <> ppr (modulePackageKey m)
                                 <> text ") the module resides in isn't trusted."
                             ]
-                    modTrustErr = unitBag $ mkPlainErrMsg dflags l $
+                    modTrustErr = unitBag $ mkErrMsg dflags l (pkgQual dflags) $
                         sep [ ppr (moduleName m)
                                 <> text ": Can't be safely imported!"
                             , text "The module itself isn't safe." ]
@@ -948,11 +953,9 @@ hscCheckSafe' dflags m l = do
     packageTrusted _ _ _
         | not (packageTrustOn dflags)      = True
     packageTrusted Sf_Safe         False _ = True
-    packageTrusted Sf_SafeInferred False _ = True
     packageTrusted _ _ m
         | isHomePkg m = True
-        | otherwise   = trusted $ getPackageDetails (pkgState dflags)
-                                                    (modulePackageId m)
+        | otherwise   = trusted $ getPackageDetails dflags (modulePackageKey m)
 
     lookup' :: Module -> Hsc (Maybe ModIface)
     lookup' m = do
@@ -976,11 +979,11 @@ hscCheckSafe' dflags m l = do
 
     isHomePkg :: Module -> Bool
     isHomePkg m
-        | thisPackage dflags == modulePackageId m = True
+        | thisPackage dflags == modulePackageKey m = True
         | otherwise                               = False
 
 -- | Check the list of packages are trusted.
-checkPkgTrust :: DynFlags -> [PackageId] -> Hsc ()
+checkPkgTrust :: DynFlags -> [PackageKey] -> Hsc ()
 checkPkgTrust dflags pkgs =
     case errors of
         [] -> return ()
@@ -988,19 +991,20 @@ checkPkgTrust dflags pkgs =
     where
         errors = catMaybes $ map go pkgs
         go pkg
-            | trusted $ getPackageDetails (pkgState dflags) pkg
+            | trusted $ getPackageDetails dflags pkg
             = Nothing
             | otherwise
-            = Just $ mkPlainErrMsg dflags noSrcSpan
+            = Just $ mkErrMsg dflags noSrcSpan (pkgQual dflags)
                    $ text "The package (" <> ppr pkg <> text ") is required" <>
                      text " to be trusted but it isn't!"
 
--- | Set module to unsafe and wipe trust information.
+-- | Set module to unsafe and (potentially) wipe trust information.
 --
 -- Make sure to call this method to set a module to inferred unsafe,
--- it should be a central and single failure method.
-wipeTrust :: TcGblEnv -> WarningMessages -> Hsc TcGblEnv
-wipeTrust tcg_env whyUnsafe = do
+-- it should be a central and single failure method. We only wipe the trust
+-- information when we aren't in a specific Safe Haskell mode.
+markUnsafe :: TcGblEnv -> WarningMessages -> Hsc TcGblEnv
+markUnsafe tcg_env whyUnsafe = do
     dflags <- getDynFlags
 
     when (wopt Opt_WarnUnsafe dflags)
@@ -1008,7 +1012,12 @@ wipeTrust tcg_env whyUnsafe = do
              mkPlainWarnMsg dflags (warnUnsafeOnLoc dflags) (whyUnsafe' dflags))
 
     liftIO $ writeIORef (tcg_safeInfer tcg_env) False
-    return $ tcg_env { tcg_imports = wiped_trust }
+    -- NOTE: Only wipe trust when not in an explicity safe haskell mode. Other
+    -- times inference may be on but we are in Trustworthy mode -- so we want
+    -- to record safe-inference failed but not wipe the trust dependencies.
+    case safeHaskell dflags == Sf_None of
+      True  -> return $ tcg_env { tcg_imports = wiped_trust }
+      False -> return tcg_env
 
   where
     wiped_trust   = (tcg_imports tcg_env) { imp_trust_pkgs = [] }
@@ -1018,7 +1027,7 @@ wipeTrust tcg_env whyUnsafe = do
                          , nest 4 $ (vcat $ badFlags df) $+$
                                     (vcat $ pprErrMsgBagWithLoc whyUnsafe)
                          ]
-    badFlags df   = concat $ map (badFlag df) unsafeFlags
+    badFlags df   = concat $ map (badFlag df) unsafeFlagsForInfer
     badFlag df (str,loc,on,_)
         | on df     = [mkLocMessage SevOutput (loc df) $
                             text str <+> text "is not allowed in Safe Haskell"]
@@ -1070,18 +1079,16 @@ hscSimpleIface' tc_result mb_old_iface = do
     return (new_iface, no_change, details)
 
 hscNormalIface :: HscEnv
-               -> FilePath
                -> ModGuts
                -> Maybe Fingerprint
                -> IO (ModIface, Bool, ModDetails, CgGuts)
-hscNormalIface hsc_env extCore_filename simpl_result mb_old_iface =
-    runHsc hsc_env $ hscNormalIface' extCore_filename simpl_result mb_old_iface
+hscNormalIface hsc_env simpl_result mb_old_iface =
+    runHsc hsc_env $ hscNormalIface' simpl_result mb_old_iface
 
-hscNormalIface' :: FilePath
-                -> ModGuts
+hscNormalIface' :: ModGuts
                 -> Maybe Fingerprint
                 -> Hsc (ModIface, Bool, ModDetails, CgGuts)
-hscNormalIface' extCore_filename simpl_result mb_old_iface = do
+hscNormalIface' simpl_result mb_old_iface = do
     hsc_env <- getHscEnv
     (cg_guts, details) <- {-# SCC "CoreTidy" #-}
                           liftIO $ tidyProgram hsc_env simpl_result
@@ -1096,11 +1103,6 @@ hscNormalIface' extCore_filename simpl_result mb_old_iface = do
            ioMsgMaybe $
                mkIface hsc_env mb_old_iface details simpl_result
 
-    -- Emit external core
-    -- This should definitely be here and not after CorePrep,
-    -- because CorePrep produces unqualified constructor wrapper declarations,
-    -- so its output isn't valid External Core (without some preprocessing).
-    liftIO $ emitExternalCore (hsc_dflags hsc_env) extCore_filename cg_guts
     liftIO $ dumpIfaceStats hsc_env
 
     -- Return the prepared code.
@@ -1147,7 +1149,7 @@ hscGenHardCode hsc_env cgguts mod_summary output_filename = do
         -- PREPARE FOR CODE GENERATION
         -- Do saturation and convert to A-normal form
         prepd_binds <- {-# SCC "CorePrep" #-}
-                       corePrepPgm dflags hsc_env core_binds data_tycons ;
+                       corePrepPgm hsc_env location core_binds data_tycons ;
         -----------------  Convert to STG ------------------
         (stg_binds, cost_centre_info)
             <- {-# SCC "CoreToStg" #-}
@@ -1158,8 +1160,15 @@ hscGenHardCode hsc_env cgguts mod_summary output_filename = do
 
         ------------------  Code generation ------------------
 
-        cmms <- {-# SCC "NewCodeGen" #-}
-                         tryNewCodeGen hsc_env this_mod data_tycons
+        -- The back-end is streamed: each top-level function goes
+        -- from Stg all the way to asm before dealing with the next
+        -- top-level function, so showPass isn't very useful here.
+        -- Hence we have one showPass for the whole backend, the
+        -- next showPass after this will be "Assembler".
+        showPass dflags "CodeGen"
+
+        cmms <- {-# SCC "StgCmm" #-}
+                         doCodeGen hsc_env this_mod data_tycons
                              cost_centre_info
                              stg_binds hpc_info
 
@@ -1203,7 +1212,7 @@ hscInteractive hsc_env cgguts mod_summary = do
     -- PREPARE FOR CODE GENERATION
     -- Do saturation and convert to A-normal form
     prepd_binds <- {-# SCC "CorePrep" #-}
-                   corePrepPgm dflags hsc_env core_binds data_tycons
+                   corePrepPgm hsc_env location core_binds data_tycons
     -----------------  Generate byte code ------------------
     comp_bc <- byteCodeGen dflags this_mod prepd_binds data_tycons mod_breaks
     ------------------ Create f-x-dynamic C-side stuff ---
@@ -1236,15 +1245,15 @@ hscCompileCmmFile hsc_env filename output_filename = runHsc hsc_env $ do
 
 -------------------- Stuff for new code gen ---------------------
 
-tryNewCodeGen   :: HscEnv -> Module -> [TyCon]
-                -> CollectedCCs
-                -> [StgBinding]
-                -> HpcInfo
-                -> IO (Stream IO CmmGroup ())
+doCodeGen   :: HscEnv -> Module -> [TyCon]
+            -> CollectedCCs
+            -> [StgBinding]
+            -> HpcInfo
+            -> IO (Stream IO CmmGroup ())
          -- Note we produce a 'Stream' of CmmGroups, so that the
          -- backend can be run incrementally.  Otherwise it generates all
          -- the C-- up front, which has a significant space cost.
-tryNewCodeGen hsc_env this_mod data_tycons
+doCodeGen hsc_env this_mod data_tycons
               cost_centre_info stg_binds hpc_info = do
     let dflags = hsc_dflags hsc_env
 
@@ -1357,11 +1366,7 @@ hscStmtWithLocation hsc_env0 stmt source linenumber =
         Just parsed_stmt -> do
             -- Rename and typecheck it
             hsc_env <- getHscEnv
-            let interactive_hsc_env = setInteractivePackage hsc_env
-                  -- Bindings created here belong to the interactive package
-                  -- See Note [The interactive package] in HscTypes
-                  -- (NB: maybe not necessary, since Stmts bind only Ids)
-            (ids, tc_expr, fix_env) <- ioMsgMaybe $ tcRnStmt interactive_hsc_env parsed_stmt
+            (ids, tc_expr, fix_env) <- ioMsgMaybe $ tcRnStmt hsc_env parsed_stmt
 
             -- Desugar it
             ds_expr <- ioMsgMaybe $ deSugarExpr hsc_env tc_expr
@@ -1369,7 +1374,7 @@ hscStmtWithLocation hsc_env0 stmt source linenumber =
             handleWarnings
 
             -- Then code-gen, and link it
-            -- It's important NOT to have package 'interactive' as thisPackageId
+            -- It's important NOT to have package 'interactive' as thisPackageKey
             -- for linking, else we try to link 'main' and can't find it.
             -- Whereas the linker already knows to ignore 'interactive'
             let  src_span     = srcLocSpan interactiveSrcLoc
@@ -1397,10 +1402,7 @@ hscDeclsWithLocation hsc_env0 str source linenumber =
 
     {- Rename and typecheck it -}
     hsc_env <- getHscEnv
-    let interactive_hsc_env = setInteractivePackage hsc_env
-            -- Bindings created here belong to the interactive package
-            -- See Note [The interactive package] in HscTypes
-    tc_gblenv <- ioMsgMaybe $ tcRnDeclsi interactive_hsc_env decls
+    tc_gblenv <- ioMsgMaybe $ tcRnDeclsi hsc_env decls
 
     {- Grab the new instances -}
     -- We grab the whole environment because of the overlapping that may have
@@ -1434,7 +1436,7 @@ hscDeclsWithLocation hsc_env0 str source linenumber =
     {- Prepare For Code Generation -}
     -- Do saturation and convert to A-normal form
     prepd_binds <- {-# SCC "CorePrep" #-}
-                    liftIO $ corePrepPgm dflags hsc_env core_binds data_tycons
+                    liftIO $ corePrepPgm hsc_env iNTERACTIVELoc core_binds data_tycons
 
     {- Generate byte code -}
     cbc <- liftIO $ byteCodeGen dflags this_mod
@@ -1540,11 +1542,11 @@ hscParseThingWithLocation source linenumber parser str
             return thing
 
 hscCompileCore :: HscEnv -> Bool -> SafeHaskellMode -> ModSummary
-               -> CoreProgram -> FilePath -> FilePath -> IO ()
-hscCompileCore hsc_env simplify safe_mode mod_summary binds output_filename extCore_filename
+               -> CoreProgram -> FilePath -> IO ()
+hscCompileCore hsc_env simplify safe_mode mod_summary binds output_filename
   = runHsc hsc_env $ do
         guts <- maybe_simplify (mkModGuts (ms_mod mod_summary) safe_mode binds)
-        (iface, changed, _details, cgguts) <- hscNormalIface' extCore_filename guts Nothing
+        (iface, changed, _details, cgguts) <- hscNormalIface' guts Nothing
         liftIO $ hscWriteIface (hsc_dflags hsc_env) iface changed mod_summary
         _ <- liftIO $ hscGenHardCode hsc_env cgguts mod_summary output_filename
         return ()
diff --git a/compiler/main/HscStats.hs b/compiler/main/HscStats.hs
index 715ee8130c91..4f901b1849c3 100644
--- a/compiler/main/HscStats.hs
+++ b/compiler/main/HscStats.hs
@@ -132,7 +132,7 @@ ppSourceStats short (L _ (HsModule _ exports imports ldecls _ _))
     class_info decl@(ClassDecl {})
         = (classops, addpr (sum3 (map count_bind methods)))
       where
-        methods = map (unLoc . snd) $ bagToList (tcdMeths decl)
+        methods = map unLoc $ bagToList (tcdMeths decl)
         (_, classops, _, _, _) = count_sigs (map unLoc (tcdSigs decl))
     class_info _ = (0,0)
 
@@ -147,7 +147,7 @@ ppSourceStats short (L _ (HsModule _ exports imports ldecls _ _))
                   (addpr (sum3 (map count_bind methods)),
                    ss, is, length ats, length adts)
       where
-        methods = map (unLoc . snd) $ bagToList inst_meths
+        methods = map unLoc $ bagToList inst_meths
 
     -- TODO: use Sum monoid
     addpr :: (Int,Int,Int) -> Int
diff --git a/compiler/main/HscTypes.lhs b/compiler/main/HscTypes.lhs
index b8ecc109d068..123b0777fcec 100644
--- a/compiler/main/HscTypes.lhs
+++ b/compiler/main/HscTypes.lhs
@@ -4,6 +4,7 @@
 \section[HscTypes]{Types for the per-module compiler}
 
 \begin{code}
+{-# LANGUAGE CPP, DeriveDataTypeable, ScopedTypeVariables #-}
 
 -- | Types for the per-module compiler
 module HscTypes (
@@ -53,6 +54,7 @@ module HscTypes (
         setInteractivePrintName, icInteractiveModule,
         InteractiveImport(..), setInteractivePackage,
         mkPrintUnqualified, pprModulePrefix,
+        mkQualPackage, mkQualModule, pkgQual,
 
         -- * Interfaces
         ModIface(..), mkIfaceWarnCache, mkIfaceHashCache, mkIfaceFixCache,
@@ -71,7 +73,7 @@ module HscTypes (
         TypeEnv, lookupType, lookupTypeHscEnv, mkTypeEnv, emptyTypeEnv,
         typeEnvFromEntities, mkTypeEnvWithImplicits,
         extendTypeEnv, extendTypeEnvList,
-        extendTypeEnvWithIds, extendTypeEnvWithPatSyns,
+        extendTypeEnvWithIds, 
         lookupTypeEnv,
         typeEnvElts, typeEnvTyCons, typeEnvIds, typeEnvPatSyns,
         typeEnvDataCons, typeEnvCoAxioms, typeEnvClasses,
@@ -442,7 +444,7 @@ instance Outputable TargetId where
 -- | Helps us find information about modules in the home package
 type HomePackageTable  = ModuleNameEnv HomeModInfo
         -- Domain = modules in the home package that have been fully compiled
-        -- "home" package name cached here for convenience
+        -- "home" package key cached here for convenience
 
 -- | Helps us find information about modules in the imported packages
 type PackageIfaceTable = ModuleEnv ModIface
@@ -633,26 +635,26 @@ type FinderCache = ModuleNameEnv FindResult
 data FindResult
   = Found ModLocation Module
         -- ^ The module was found
-  | NoPackage PackageId
+  | NoPackage PackageKey
         -- ^ The requested package was not found
-  | FoundMultiple [PackageId]
+  | FoundMultiple [(Module, ModuleOrigin)]
         -- ^ _Error_: both in multiple packages
 
         -- | Not found
   | NotFound
       { fr_paths       :: [FilePath]       -- Places where I looked
 
-      , fr_pkg         :: Maybe PackageId  -- Just p => module is in this package's
+      , fr_pkg         :: Maybe PackageKey  -- Just p => module is in this package's
                                            --           manifest, but couldn't find
                                            --           the .hi file
 
-      , fr_mods_hidden :: [PackageId]      -- Module is in these packages,
+      , fr_mods_hidden :: [PackageKey]      -- Module is in these packages,
                                            --   but the *module* is hidden
 
-      , fr_pkgs_hidden :: [PackageId]      -- Module is in these packages,
+      , fr_pkgs_hidden :: [PackageKey]      -- Module is in these packages,
                                            --   but the *package* is hidden
 
-      , fr_suggestions :: [Module]         -- Possible mis-spelled modules
+      , fr_suggestions :: [ModuleSuggestion] -- Possible mis-spelled modules
       }
 
 -- | Cache that remembers where we found a particular module.  Contains both
@@ -951,7 +953,8 @@ data ModDetails
         -- The next two fields are created by the typechecker
         md_exports   :: [AvailInfo],
         md_types     :: !TypeEnv,       -- ^ Local type environment for this particular module
-        md_insts     :: ![ClsInst],    -- ^ 'DFunId's for the instances in this module
+                                        -- Includes Ids, TyCons, PatSyns
+        md_insts     :: ![ClsInst],     -- ^ 'DFunId's for the instances in this module
         md_fam_insts :: ![FamInst],
         md_rules     :: ![CoreRule],    -- ^ Domain may include 'Id's from other modules
         md_anns      :: ![Annotation],  -- ^ Annotations present in this module: currently
@@ -993,8 +996,8 @@ data ModGuts
         mg_rdr_env   :: !GlobalRdrEnv,   -- ^ Top-level lexical environment
 
         -- These fields all describe the things **declared in this module**
-        mg_fix_env   :: !FixityEnv,      -- ^ Fixities declared in this module
-                                         -- ToDo: I'm unconvinced this is actually used anywhere
+        mg_fix_env   :: !FixityEnv,      -- ^ Fixities declared in this module.
+                                         -- Used for creating interface files.
         mg_tcs       :: ![TyCon],        -- ^ TyCons declared in this module
                                          -- (includes TyCons for classes)
         mg_insts     :: ![ClsInst],      -- ^ Class instances declared in this module
@@ -1065,7 +1068,7 @@ data CgGuts
                 -- as part of the code-gen of tycons
 
         cg_foreign   :: !ForeignStubs,   -- ^ Foreign export stubs
-        cg_dep_pkgs  :: ![PackageId],    -- ^ Dependent packages, used to
+        cg_dep_pkgs  :: ![PackageKey],    -- ^ Dependent packages, used to
                                          -- generate #includes for C code gen
         cg_hpc_info  :: !HpcInfo,        -- ^ Program coverage tick box information
         cg_modBreaks :: !ModBreaks       -- ^ Module breakpoints
@@ -1098,13 +1101,13 @@ appendStubC (ForeignStubs h c) c_code = ForeignStubs h (c $$ c_code)
 
 Note [The interactive package]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Type and class declarations at the command prompt are treated as if
-they were defined in modules
+Type, class, and value declarations at the command prompt are treated 
+as if they were defined in modules
    interactive:Ghci1
    interactive:Ghci2
    ...etc...
 with each bunch of declarations using a new module, all sharing a
-common package 'interactive' (see Module.interactivePackageId, and
+common package 'interactive' (see Module.interactivePackageKey, and
 PrelNames.mkInteractiveModule).
 
 This scheme deals well with shadowing.  For example:
@@ -1119,10 +1122,10 @@ shadowed by the second declaration.  But it has a respectable
 qualified name (Ghci1.T), and its source location says where it was
 defined.
 
-So the main invariant continues to hold, that in any session an original
-name M.T only refers to oe unique thing.  (In a previous iteration both
-the T's above were called :Interactive.T, albeit with different uniques,
-which gave rise to all sorts of trouble.)
+So the main invariant continues to hold, that in any session an
+original name M.T only refers to one unique thing.  (In a previous
+iteration both the T's above were called :Interactive.T, albeit with
+different uniques, which gave rise to all sorts of trouble.)
 
 The details are a bit tricky though:
 
@@ -1132,25 +1135,29 @@ The details are a bit tricky though:
  * ic_tythings contains only things from the 'interactive' package.
 
  * Module from the 'interactive' package (Ghci1, Ghci2 etc) never go
-   in the Home Package Table (HPT).  When you say :load, that's when
+   in the Home Package Table (HPT).  When you say :load, that's when we
    extend the HPT.
 
  * The 'thisPackage' field of DynFlags is *not* set to 'interactive'.
-   It stays as 'main' (or whatever -package-name says), and is the
+   It stays as 'main' (or whatever -this-package-key says), and is the
    package to which :load'ed modules are added to.
 
  * So how do we arrange that declarations at the command prompt get
-   to be in the 'interactive' package?  By setting 'thisPackage' just
-   before the typecheck/rename step for command-line processing;
-   see the calls to HscTypes.setInteractivePackage in
-   HscMain.hscDeclsWithLocation and hscStmtWithLocation.
+   to be in the 'interactive' package?  Simply by setting the tcg_mod
+   field of the TcGblEnv to "interactive:Ghci1".  This is done by the
+   call to initTc in initTcInteractive, initTcForLookup, which in 
+   turn get the module from it 'icInteractiveModule' field of the 
+   interactive context.
+
+   The 'thisPackage' field stays as 'main' (or whatever -this-package-key says.
 
  * The main trickiness is that the type environment (tcg_type_env and
-   fixity envt (tcg_fix_env) now contains entities from all the
-   GhciN modules together, rather than just a single module as is usually
-   the case.  So you can't use "nameIsLocalOrFrom" to decide whether
-   to look in the TcGblEnv vs the HPT/PTE.  This is a change, but not
-   a problem provided you know.
+   fixity envt (tcg_fix_env), and instances (tcg_insts, tcg_fam_insts)
+   now contains entities from all the interactive-package modules
+   (Ghci1, Ghci2, ...) together, rather than just a single module as
+   is usually the case.  So you can't use "nameIsLocalOrFrom" to
+   decide whether to look in the TcGblEnv vs the HPT/PTE.  This is a
+   change, but not a problem provided you know.
 
 
 Note [Interactively-bound Ids in GHCi]
@@ -1336,7 +1343,7 @@ extendInteractiveContext ictxt new_tythings
 setInteractivePackage :: HscEnv -> HscEnv
 -- Set the 'thisPackage' DynFlag to 'interactive'
 setInteractivePackage hsc_env
-   = hsc_env { hsc_dflags = (hsc_dflags hsc_env) { thisPackage = interactivePackageId } }
+   = hsc_env { hsc_dflags = (hsc_dflags hsc_env) { thisPackage = interactivePackageKey } }
 
 setInteractivePrintName :: InteractiveContext -> Name -> InteractiveContext
 setInteractivePrintName ic n = ic{ic_int_print = n}
@@ -1403,11 +1410,28 @@ exposed (say P2), so we use M.T for that, and P1:M.T for the other one.
 This is handled by the qual_mod component of PrintUnqualified, inside
 the (ppr mod) of case (3), in Name.pprModulePrefix
 
+Note [Printing package keys]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+In the old days, original names were tied to PackageIds, which directly
+corresponded to the entities that users wrote in Cabal files, and were perfectly
+suitable for printing when we need to disambiguate packages.  However, with
+PackageKey, the situation is different.  First, the key is not a human readable
+at all, so we need to consult the package database to find the appropriate
+PackageId to display.  Second, there may be multiple copies of a library visible
+with the same PackageId, in which case we need to disambiguate.  For now,
+we just emit the actual package key (which the user can go look up); however,
+another scheme is to (recursively) say which dependencies are different.
+
+NB: When we extend package keys to also have holes, we will have to disambiguate
+those as well.
+
 \begin{code}
 -- | Creates some functions that work out the best ways to format
--- names for the user according to a set of heuristics
+-- names for the user according to a set of heuristics.
 mkPrintUnqualified :: DynFlags -> GlobalRdrEnv -> PrintUnqualified
-mkPrintUnqualified dflags env = (qual_name, qual_mod)
+mkPrintUnqualified dflags env = QueryQualify qual_name
+                                             (mkQualModule dflags)
+                                             (mkQualPackage dflags)
   where
   qual_name mod occ
         | [gre] <- unqual_gres
@@ -1440,18 +1464,48 @@ mkPrintUnqualified dflags env = (qual_name, qual_mod)
     -- "import M" would resolve unambiguously to P:M.  (if P is the
     -- current package we can just assume it is unqualified).
 
-  qual_mod mod
-     | modulePackageId mod == thisPackage dflags = False
+-- | Creates a function for formatting modules based on two heuristics:
+-- (1) if the module is the current module, don't qualify, and (2) if there
+-- is only one exposed package which exports this module, don't qualify.
+mkQualModule :: DynFlags -> QueryQualifyModule
+mkQualModule dflags mod
+     | modulePackageKey mod == thisPackage dflags = False
 
-     | [pkgconfig] <- [pkg | (pkg,exposed_module) <- lookup,
-                             exposed pkg && exposed_module],
-       packageConfigId pkgconfig == modulePackageId mod
+     | [(_, pkgconfig)] <- lookup,
+       packageConfigId pkgconfig == modulePackageKey mod
         -- this says: we are given a module P:M, is there just one exposed package
         -- that exposes a module M, and is it package P?
      = False
 
      | otherwise = True
      where lookup = lookupModuleInAllPackages dflags (moduleName mod)
+
+-- | Creates a function for formatting packages based on two heuristics:
+-- (1) don't qualify if the package in question is "main", and (2) only qualify
+-- with a package key if the package ID would be ambiguous.
+mkQualPackage :: DynFlags -> QueryQualifyPackage
+mkQualPackage dflags pkg_key
+     | pkg_key == mainPackageKey
+        -- Skip the lookup if it's main, since it won't be in the package
+        -- database!
+     = False
+     | searchPackageId dflags pkgid `lengthIs` 1
+        -- this says: we are given a package pkg-0.1@MMM, are there only one
+        -- exposed packages whose package ID is pkg-0.1?
+     = False
+     | otherwise
+     = True
+     where pkg = fromMaybe (pprPanic "qual_pkg" (ftext (packageKeyFS pkg_key)))
+                    (lookupPackage dflags pkg_key)
+           pkgid = sourcePackageId pkg
+
+-- | A function which only qualifies package names if necessary; but
+-- qualifies all other identifiers.
+pkgQual :: DynFlags -> PrintUnqualified
+pkgQual dflags = alwaysQualify {
+        queryQualifyPackage = mkQualPackage dflags
+    }
+
 \end{code}
 
 
@@ -1480,7 +1534,7 @@ Examples:
     IfaceClass decl happens to use IfaceDecl recursively for the
     associated types, but that's irrelevant here.)
 
-  * Dictionary function Ids are not implict.
+  * Dictionary function Ids are not implicit.
 
   * Axioms for newtypes are implicit (same as above), but axioms
     for data/type family instances are *not* implicit (like DFunIds).
@@ -1501,15 +1555,17 @@ implicitTyThings :: TyThing -> [TyThing]
 implicitTyThings (AnId _)       = []
 implicitTyThings (ACoAxiom _cc) = []
 implicitTyThings (ATyCon tc)    = implicitTyConThings tc
-implicitTyThings (AConLike cl)  = case cl of
-    RealDataCon dc ->
-        -- For data cons add the worker and (possibly) wrapper
-        map AnId (dataConImplicitIds dc)
-    PatSynCon ps ->
-        -- For bidirectional pattern synonyms, add the wrapper
-        case patSynWrapper ps of
-            Nothing -> []
-            Just id -> [AnId id]
+implicitTyThings (AConLike cl)  = implicitConLikeThings cl
+
+implicitConLikeThings :: ConLike -> [TyThing]
+implicitConLikeThings (RealDataCon dc)
+  = map AnId (dataConImplicitIds dc)
+    -- For data cons add the worker and (possibly) wrapper
+
+implicitConLikeThings (PatSynCon {})
+  = []  -- Pattern synonyms have no implicit Ids; the wrapper and matcher
+        -- are not "implicit"; they are simply new top-level bindings,
+        -- and they have their own declaration in an interface fiel
 
 implicitClassThings :: Class -> [TyThing]
 implicitClassThings cl
@@ -1558,8 +1614,8 @@ implicitCoTyCon tc
 -- other declaration.
 isImplicitTyThing :: TyThing -> Bool
 isImplicitTyThing (AConLike cl) = case cl of
-    RealDataCon{}  -> True
-    PatSynCon ps   -> isImplicitId (patSynId ps)
+                                    RealDataCon {} -> True
+                                    PatSynCon {}   -> False
 isImplicitTyThing (AnId id)     = isImplicitId id
 isImplicitTyThing (ATyCon tc)   = isImplicitTyCon tc
 isImplicitTyThing (ACoAxiom ax) = isImplicitCoAxiom ax
@@ -1675,17 +1731,6 @@ extendTypeEnvList env things = foldl extendTypeEnv env things
 extendTypeEnvWithIds :: TypeEnv -> [Id] -> TypeEnv
 extendTypeEnvWithIds env ids
   = extendNameEnvList env [(getName id, AnId id) | id <- ids]
-
-extendTypeEnvWithPatSyns :: TypeEnv -> [PatSyn] -> TypeEnv
-extendTypeEnvWithPatSyns env patsyns
-  = extendNameEnvList env $ concatMap pat_syn_things patsyns
-  where
-    pat_syn_things :: PatSyn -> [(Name, TyThing)]
-    pat_syn_things ps = (getName ps, AConLike (PatSynCon ps)):
-                        case patSynWrapper ps of
-                            Just wrap_id -> [(getName wrap_id, AnId wrap_id)]
-                            Nothing -> []
-
 \end{code}
 
 \begin{code}
@@ -1908,7 +1953,7 @@ data Dependencies
                         -- I.e. modules that this one imports, or that are in the
                         --      dep_mods of those directly-imported modules
 
-         , dep_pkgs   :: [(PackageId, Bool)]
+         , dep_pkgs   :: [(PackageKey, Bool)]
                         -- ^ All packages transitively below this module
                         -- I.e. packages to which this module's direct imports belong,
                         --      or that are in the dep_pkgs of those modules
@@ -2204,37 +2249,50 @@ type ModuleGraph = [ModSummary]
 emptyMG :: ModuleGraph
 emptyMG = []
 
--- | A single node in a 'ModuleGraph. The nodes of the module graph are one of:
+-- | A single node in a 'ModuleGraph'. The nodes of the module graph
+-- are one of:
 --
 -- * A regular Haskell source module
---
 -- * A hi-boot source module
---
 -- * An external-core source module
+--
 data ModSummary
    = ModSummary {
-        ms_mod          :: Module,              -- ^ Identity of the module
-        ms_hsc_src      :: HscSource,           -- ^ The module source either plain Haskell, hs-boot or external core
-        ms_location     :: ModLocation,         -- ^ Location of the various files belonging to the module
-        ms_hs_date      :: UTCTime,             -- ^ Timestamp of source file
-        ms_obj_date     :: Maybe UTCTime,       -- ^ Timestamp of object, if we have one
-        ms_srcimps      :: [Located (ImportDecl RdrName)],      -- ^ Source imports of the module
-        ms_textual_imps :: [Located (ImportDecl RdrName)],      -- ^ Non-source imports of the module from the module *text*
-        ms_hspp_file    :: FilePath,            -- ^ Filename of preprocessed source file
-        ms_hspp_opts    :: DynFlags,            -- ^ Cached flags from @OPTIONS@, @INCLUDE@
-                                                -- and @LANGUAGE@ pragmas in the modules source code
-        ms_hspp_buf     :: Maybe StringBuffer   -- ^ The actual preprocessed source, if we have it
+        ms_mod          :: Module,
+          -- ^ Identity of the module
+        ms_hsc_src      :: HscSource,
+          -- ^ The module source either plain Haskell, hs-boot or external core
+        ms_location     :: ModLocation,
+          -- ^ Location of the various files belonging to the module
+        ms_hs_date      :: UTCTime,
+          -- ^ Timestamp of source file
+        ms_obj_date     :: Maybe UTCTime,
+          -- ^ Timestamp of object, if we have one
+        ms_srcimps      :: [Located (ImportDecl RdrName)],
+          -- ^ Source imports of the module
+        ms_textual_imps :: [Located (ImportDecl RdrName)],
+          -- ^ Non-source imports of the module from the module *text*
+        ms_hspp_file    :: FilePath,
+          -- ^ Filename of preprocessed source file
+        ms_hspp_opts    :: DynFlags,
+          -- ^ Cached flags from @OPTIONS@, @INCLUDE@ and @LANGUAGE@
+          -- pragmas in the modules source code
+        ms_hspp_buf     :: Maybe StringBuffer
+          -- ^ The actual preprocessed source, if we have it
      }
 
 ms_mod_name :: ModSummary -> ModuleName
 ms_mod_name = moduleName . ms_mod
 
 ms_imps :: ModSummary -> [Located (ImportDecl RdrName)]
-ms_imps ms = ms_textual_imps ms ++ map mk_additional_import (dynFlagDependencies (ms_hspp_opts ms))
+ms_imps ms =
+  ms_textual_imps ms ++
+  map mk_additional_import (dynFlagDependencies (ms_hspp_opts ms))
   where
-    -- This is a not-entirely-satisfactory means of creating an import that corresponds to an
-    -- import that did not occur in the program text, such as those induced by the use of
-    -- plugins (the -plgFoo flag)
+    -- This is a not-entirely-satisfactory means of creating an import
+    -- that corresponds to an import that did not occur in the program
+    -- text, such as those induced by the use of plugins (the -plgFoo
+    -- flag)
     mk_additional_import mod_nm = noLoc $ ImportDecl {
       ideclName      = noLoc mod_nm,
       ideclPkgQual   = Nothing,
@@ -2484,14 +2542,15 @@ trustInfoToNum it
             Sf_Unsafe       -> 1
             Sf_Trustworthy  -> 2
             Sf_Safe         -> 3
-            Sf_SafeInferred -> 4
 
 numToTrustInfo :: Word8 -> IfaceTrustInfo
 numToTrustInfo 0 = setSafeMode Sf_None
 numToTrustInfo 1 = setSafeMode Sf_Unsafe
 numToTrustInfo 2 = setSafeMode Sf_Trustworthy
 numToTrustInfo 3 = setSafeMode Sf_Safe
-numToTrustInfo 4 = setSafeMode Sf_SafeInferred
+numToTrustInfo 4 = setSafeMode Sf_Safe -- retained for backwards compat, used
+                                       -- to be Sf_SafeInfered but we no longer
+                                       -- differentiate.
 numToTrustInfo n = error $ "numToTrustInfo: bad input number! (" ++ show n ++ ")"
 
 instance Outputable IfaceTrustInfo where
@@ -2499,7 +2558,6 @@ instance Outputable IfaceTrustInfo where
     ppr (TrustInfo Sf_Unsafe)        = ptext $ sLit "unsafe"
     ppr (TrustInfo Sf_Trustworthy)   = ptext $ sLit "trustworthy"
     ppr (TrustInfo Sf_Safe)          = ptext $ sLit "safe"
-    ppr (TrustInfo Sf_SafeInferred)  = ptext $ sLit "safe-inferred"
 
 instance Binary IfaceTrustInfo where
     put_ bh iftrust = putByte bh $ trustInfoToNum iftrust
diff --git a/compiler/main/InteractiveEval.hs b/compiler/main/InteractiveEval.hs
index ede519982a90..d60cf56eba23 100644
--- a/compiler/main/InteractiveEval.hs
+++ b/compiler/main/InteractiveEval.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE CPP, MagicHash, NondecreasingIndentation, UnboxedTuples #-}
+
 -- -----------------------------------------------------------------------------
 --
 -- (c) The University of Glasgow, 2005-2007
@@ -877,7 +879,7 @@ getContext = withSession $ \HscEnv{ hsc_IC=ic } ->
 -- its full top-level scope available.
 moduleIsInterpreted :: GhcMonad m => Module -> m Bool
 moduleIsInterpreted modl = withSession $ \h ->
- if modulePackageId modl /= thisPackage (hsc_dflags h)
+ if modulePackageKey modl /= thisPackage (hsc_dflags h)
         then return False
         else case lookupUFM (hsc_HPT h) (moduleName modl) of
                 Just details       -> return (isJust (mi_globals (hm_iface details)))
diff --git a/compiler/main/InteractiveEvalTypes.hs b/compiler/main/InteractiveEvalTypes.hs
index e3324a39a15b..6ea1a2564866 100644
--- a/compiler/main/InteractiveEvalTypes.hs
+++ b/compiler/main/InteractiveEvalTypes.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE CPP #-}
+
 -- -----------------------------------------------------------------------------
 --
 -- (c) The University of Glasgow, 2005-2007
diff --git a/compiler/main/PackageConfig.hs b/compiler/main/PackageConfig.hs
index d34d9e1f5c5e..864980be9da5 100644
--- a/compiler/main/PackageConfig.hs
+++ b/compiler/main/PackageConfig.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE CPP #-}
+
 -- |
 -- Package configuration information: essentially the interface to Cabal, with
 -- some utilities
@@ -7,8 +9,8 @@
 module PackageConfig (
         -- $package_naming
 
-        -- * PackageId
-        mkPackageId, packageConfigId,
+        -- * PackageKey
+        mkPackageKey, packageConfigId,
 
         -- * The PackageConfig type: information about a package
         PackageConfig,
@@ -24,7 +26,8 @@ module PackageConfig (
 
 import Distribution.InstalledPackageInfo
 import Distribution.ModuleName
-import Distribution.Package hiding (PackageId)
+import Distribution.Package hiding (PackageKey, mkPackageKey)
+import qualified Distribution.Package as Cabal
 import Distribution.Text
 import Distribution.Version
 
@@ -41,36 +44,33 @@ defaultPackageConfig :: PackageConfig
 defaultPackageConfig = emptyInstalledPackageInfo
 
 -- -----------------------------------------------------------------------------
--- PackageId (package names with versions)
+-- PackageKey (package names, versions and dep hash)
 
 -- $package_naming
 -- #package_naming#
--- Mostly the compiler deals in terms of 'PackageName's, which don't
--- have the version suffix. This is so that we don't need to know the
--- version for the @-package-name@ flag, or know the versions of
--- wired-in packages like @base@ & @rts@. Versions are confined to the
--- package sub-system.
---
--- This means that in theory you could have multiple base packages installed
--- (for example), and switch between them using @-package@\/@-hide-package@.
---
--- A 'PackageId' is a string of the form @<pkg>-<version>@.
+-- Mostly the compiler deals in terms of 'PackageKey's, which are md5 hashes
+-- of a package ID, keys of its dependencies, and Cabal flags. You're expected
+-- to pass in the package key in the @-this-package-key@ flag. However, for
+-- wired-in packages like @base@ & @rts@, we don't necessarily know what the
+-- version is, so these are handled specially; see #wired_in_packages#.
 
--- | Turn a Cabal 'PackageIdentifier' into a GHC 'PackageId'
-mkPackageId :: PackageIdentifier -> PackageId
-mkPackageId = stringToPackageId . display
+-- | Turn a Cabal 'PackageIdentifier' into a GHC 'PackageKey'
+mkPackageKey :: Cabal.PackageKey -> PackageKey
+mkPackageKey = stringToPackageKey . display
 
--- | Get the GHC 'PackageId' right out of a Cabalish 'PackageConfig'
-packageConfigId :: PackageConfig -> PackageId
-packageConfigId = mkPackageId . sourcePackageId
+-- | Get the GHC 'PackageKey' right out of a Cabalish 'PackageConfig'
+packageConfigId :: PackageConfig -> PackageKey
+packageConfigId = mkPackageKey . packageKey
 
 -- | Turn a 'PackageConfig', which contains GHC 'Module.ModuleName's into a Cabal specific
 -- 'InstalledPackageInfo' which contains Cabal 'Distribution.ModuleName.ModuleName's
 packageConfigToInstalledPackageInfo :: PackageConfig -> InstalledPackageInfo
 packageConfigToInstalledPackageInfo
     (pkgconf@(InstalledPackageInfo { exposedModules = e,
+                                     reexportedModules = r,
                                      hiddenModules = h })) =
         pkgconf{ exposedModules = map convert e,
+                 reexportedModules = map (fmap convert) r,
                  hiddenModules  = map convert h }
     where convert :: Module.ModuleName -> Distribution.ModuleName.ModuleName
           convert = (expectJust "packageConfigToInstalledPackageInfo") . simpleParse . moduleNameString
@@ -80,7 +80,9 @@ packageConfigToInstalledPackageInfo
 installedPackageInfoToPackageConfig :: InstalledPackageInfo_ String -> PackageConfig
 installedPackageInfoToPackageConfig
     (pkgconf@(InstalledPackageInfo { exposedModules = e,
+                                     reexportedModules = r,
                                      hiddenModules = h })) =
         pkgconf{ exposedModules = map mkModuleName e,
+                 reexportedModules = map (fmap mkModuleName) r,
                  hiddenModules  = map mkModuleName h }
 
diff --git a/compiler/main/Packages.lhs b/compiler/main/Packages.lhs
index aefb5360edb5..78c8059046d5 100644
--- a/compiler/main/Packages.lhs
+++ b/compiler/main/Packages.lhs
@@ -2,19 +2,29 @@
 % (c) The University of Glasgow, 2006
 %
 \begin{code}
+{-# LANGUAGE CPP, ScopedTypeVariables #-}
+
 -- | Package manipulation
 module Packages (
         module PackageConfig,
 
-        -- * The PackageConfigMap
-        PackageConfigMap, emptyPackageConfigMap, lookupPackage,
-        extendPackageConfigMap, dumpPackages,
-
         -- * Reading the package config, and processing cmdline args
-        PackageState(..),
+        PackageState(preloadPackages),
         initPackages,
+
+        -- * Querying the package config
+        lookupPackage,
+        resolveInstalledPackageId,
+        searchPackageId,
+        dumpPackages,
+        simpleDumpPackages,
         getPackageDetails,
-        lookupModuleInAllPackages, lookupModuleWithSuggestions,
+        listVisibleModuleNames,
+        lookupModuleInAllPackages,
+        lookupModuleWithSuggestions,
+        LookupResult(..),
+        ModuleSuggestion(..),
+        ModuleOrigin(..),
 
         -- * Inspecting the set of packages in scope
         getPackageIncludePath,
@@ -27,8 +37,12 @@ module Packages (
 
         collectIncludeDirs, collectLibraryPaths, collectLinkOpts,
         packageHsLibs,
+        ModuleExport(..),
 
         -- * Utils
+        packageKeyPackageIdString,
+        pprFlag,
+        pprModuleMap,
         isDllName
     )
 where
@@ -49,10 +63,12 @@ import Maybes
 import System.Environment ( getEnv )
 import Distribution.InstalledPackageInfo
 import Distribution.InstalledPackageInfo.Binary
-import Distribution.Package hiding (PackageId,depends)
+import Distribution.Package hiding (depends, PackageKey, mkPackageKey)
+import Distribution.ModuleExport
 import FastString
 import ErrUtils         ( debugTraceMsg, putMsg, MsgDoc )
 import Exception
+import Unique
 
 import System.Directory
 import System.FilePath as FilePath
@@ -61,6 +77,7 @@ import Control.Monad
 import Data.Char (isSpace)
 import Data.List as List
 import Data.Map (Map)
+import Data.Monoid hiding ((<>))
 import qualified Data.Map as Map
 import qualified FiniteMap as Map
 import qualified Data.Set as Set
@@ -73,12 +90,18 @@ import qualified Data.Set as Set
 -- provide.
 --
 -- The package state is computed by 'initPackages', and kept in DynFlags.
+-- It is influenced by various package flags:
 --
---   * @-package <pkg>@ causes @<pkg>@ to become exposed, and all other packages
---      with the same name to become hidden.
+--   * @-package <pkg>@ and @-package-id <pkg>@ cause @<pkg>@ to become exposed.
+--     If @-hide-all-packages@ was not specified, these commands also cause
+--      all other packages with the same name to become hidden.
 --
 --   * @-hide-package <pkg>@ causes @<pkg>@ to become hidden.
 --
+--   * (there are a few more flags, check below for their semantics)
+--
+-- The package state has the following properties.
+--
 --   * Let @exposedPackages@ be the set of packages thus exposed.
 --     Let @depExposedPackages@ be the transitive closure from @exposedPackages@ of
 --     their dependencies.
@@ -107,39 +130,166 @@ import qualified Data.Set as Set
 -- When compiling A, we record in B's Module value whether it's
 -- in a different DLL, by setting the DLL flag.
 
-data PackageState = PackageState {
-  pkgIdMap              :: PackageConfigMap, -- PackageId   -> PackageConfig
-        -- The exposed flags are adjusted according to -package and
-        -- -hide-package flags, and -ignore-package removes packages.
-
-  preloadPackages      :: [PackageId],
-        -- The packages we're going to link in eagerly.  This list
-        -- should be in reverse dependency order; that is, a package
-        -- is always mentioned before the packages it depends on.
-
-  moduleToPkgConfAll    :: UniqFM [(PackageConfig,Bool)], -- ModuleEnv mapping
-        -- Derived from pkgIdMap.
-        -- Maps Module to (pkgconf,exposed), where pkgconf is the
-        -- PackageConfig for the package containing the module, and
-        -- exposed is True if the package exposes that module.
+-- | Given a module name, there may be multiple ways it came into scope,
+-- possibly simultaneously.  This data type tracks all the possible ways
+-- it could have come into scope.  Warning: don't use the record functions,
+-- they're partial!
+data ModuleOrigin =
+    -- | Module is hidden, and thus never will be available for import.
+    -- (But maybe the user didn't realize), so we'll still keep track
+    -- of these modules.)
+    ModHidden
+    -- | Module is public, and could have come from some places.
+  | ModOrigin {
+        -- | @Just False@ means that this module is in
+        -- someone's @exported-modules@ list, but that package is hidden;
+        -- @Just True@ means that it is available; @Nothing@ means neither
+        -- applies.
+        fromOrigPackage :: Maybe Bool
+        -- | Is the module available from a reexport of an exposed package?
+        -- There could be multiple.
+      , fromExposedReexport :: [PackageConfig]
+        -- | Is the module available from a reexport of a hidden package?
+      , fromHiddenReexport :: [PackageConfig]
+        -- | Did the module export come from a package flag? (ToDo: track
+        -- more information.
+      , fromPackageFlag :: Bool
+      }
+
+instance Outputable ModuleOrigin where
+    ppr ModHidden = text "hidden module"
+    ppr (ModOrigin e res rhs f) = sep (punctuate comma (
+        (case e of
+            Nothing -> []
+            Just False -> [text "hidden package"]
+            Just True -> [text "exposed package"]) ++
+        (if null res
+            then []
+            else [text "reexport by" <+>
+                    sep (map (ppr . packageConfigId) res)]) ++
+        (if null rhs
+            then []
+            else [text "hidden reexport by" <+>
+                    sep (map (ppr . packageConfigId) res)]) ++
+        (if f then [text "package flag"] else [])
+        ))
+
+-- | Smart constructor for a module which is in @exposed-modules@.  Takes
+-- as an argument whether or not the defining package is exposed.
+fromExposedModules :: Bool -> ModuleOrigin
+fromExposedModules e = ModOrigin (Just e) [] [] False
+
+-- | Smart constructor for a module which is in @reexported-modules@.  Takes
+-- as an argument whether or not the reexporting package is expsed, and
+-- also its 'PackageConfig'.
+fromReexportedModules :: Bool -> PackageConfig -> ModuleOrigin
+fromReexportedModules True pkg = ModOrigin Nothing [pkg] [] False
+fromReexportedModules False pkg = ModOrigin Nothing [] [pkg] False
+
+-- | Smart constructor for a module which was bound by a package flag.
+fromFlag :: ModuleOrigin
+fromFlag = ModOrigin Nothing [] [] True
+
+instance Monoid ModuleOrigin where
+    mempty = ModOrigin Nothing [] [] False
+    mappend (ModOrigin e res rhs f) (ModOrigin e' res' rhs' f') =
+        ModOrigin (g e e') (res ++ res') (rhs ++ rhs') (f || f')
+      where g (Just b) (Just b')
+                | b == b'   = Just b
+                | otherwise = panic "ModOrigin: package both exposed/hidden"
+            g Nothing x = x
+            g x Nothing = x
+    mappend _ _ = panic "ModOrigin: hidden module redefined"
+
+-- | Is the name from the import actually visible? (i.e. does it cause
+-- ambiguity, or is it only relevant when we're making suggestions?)
+originVisible :: ModuleOrigin -> Bool
+originVisible ModHidden = False
+originVisible (ModOrigin b res _ f) = b == Just True || not (null res) || f
+
+-- | Are there actually no providers for this module?  This will never occur
+-- except when we're filtering based on package imports.
+originEmpty :: ModuleOrigin -> Bool
+originEmpty (ModOrigin Nothing [] [] False) = True
+originEmpty _ = False
+
+-- | When we do a plain lookup (e.g. for an import), initially, all we want
+-- to know is if we can find it or not (and if we do and it's a reexport,
+-- what the real name is).  If the find fails, we'll want to investigate more
+-- to give a good error message.
+data SimpleModuleConf =
+    SModConf Module PackageConfig ModuleOrigin
+  | SModConfAmbiguous
+
+-- | 'UniqFM' map from 'ModuleName'
+type ModuleNameMap = UniqFM
+
+-- | 'UniqFM' map from 'PackageKey'
+type PackageKeyMap = UniqFM
+
+-- | 'UniqFM' map from 'PackageKey' to 'PackageConfig'
+type PackageConfigMap = PackageKeyMap PackageConfig
+
+-- | 'UniqFM' map from 'PackageKey' to (1) whether or not all modules which
+-- are exposed should be dumped into scope, (2) any custom renamings that
+-- should also be apply, and (3) what package name is associated with the
+-- key, if it might be hidden
+type VisibilityMap =
+    PackageKeyMap (Bool, [(ModuleName, ModuleName)], FastString)
+
+-- | Map from 'ModuleName' to 'Module' to all the origins of the bindings
+-- in scope.  The 'PackageConf' is not cached, mostly for convenience reasons
+-- (since this is the slow path, we'll just look it up again).
+type ModuleToPkgConfAll =
+    Map ModuleName (Map Module ModuleOrigin)
 
+data PackageState = PackageState {
+  -- | A mapping of 'PackageKey' to 'PackageConfig'.  This list is adjusted
+  -- so that only valid packages are here.  Currently, we also flip the
+  -- exposed/trusted bits based on package flags; however, the hope is to
+  -- stop doing that.
+  pkgIdMap              :: PackageConfigMap,
+
+  -- | The packages we're going to link in eagerly.  This list
+  -- should be in reverse dependency order; that is, a package
+  -- is always mentioned before the packages it depends on.
+  preloadPackages      :: [PackageKey],
+
+  -- | This is a simplified map from 'ModuleName' to original 'Module' and
+  -- package configuration providing it.
+  moduleToPkgConf       :: ModuleNameMap SimpleModuleConf,
+
+  -- | This is a full map from 'ModuleName' to all modules which may possibly
+  -- be providing it.  These providers may be hidden (but we'll still want
+  -- to report them in error messages), or it may be an ambiguous import.
+  moduleToPkgConfAll    :: ModuleToPkgConfAll,
+
+  -- | This is a map from 'InstalledPackageId' to 'PackageKey', since GHC
+  -- internally deals in package keys but the database may refer to installed
+  -- package IDs.
   installedPackageIdMap :: InstalledPackageIdMap
   }
 
--- | A PackageConfigMap maps a 'PackageId' to a 'PackageConfig'
-type PackageConfigMap = UniqFM PackageConfig
-
-type InstalledPackageIdMap = Map InstalledPackageId PackageId
-
+type InstalledPackageIdMap = Map InstalledPackageId PackageKey
 type InstalledPackageIndex = Map InstalledPackageId PackageConfig
 
+-- | Empty package configuration map
 emptyPackageConfigMap :: PackageConfigMap
 emptyPackageConfigMap = emptyUFM
 
--- | Find the package we know about with the given id (e.g. \"foo-1.0\"), if any
-lookupPackage :: PackageConfigMap -> PackageId -> Maybe PackageConfig
-lookupPackage = lookupUFM
+-- | Find the package we know about with the given key (e.g. @foo_HASH@), if any
+lookupPackage :: DynFlags -> PackageKey -> Maybe PackageConfig
+lookupPackage dflags = lookupPackage' (pkgIdMap (pkgState dflags))
+
+lookupPackage' :: PackageConfigMap -> PackageKey -> Maybe PackageConfig
+lookupPackage' = lookupUFM
 
+-- | Search for packages with a given package ID (e.g. \"foo-0.1\")
+searchPackageId :: DynFlags -> PackageId -> [PackageConfig]
+searchPackageId dflags pid = filter ((pid ==) . sourcePackageId)
+                               (listPackageConfigMap dflags)
+
+-- | Extends the package configuration map with a list of package configs.
 extendPackageConfigMap
    :: PackageConfigMap -> [PackageConfig] -> PackageConfigMap
 extendPackageConfigMap pkg_map new_pkgs
@@ -148,8 +298,20 @@ extendPackageConfigMap pkg_map new_pkgs
 
 -- | Looks up the package with the given id in the package state, panicing if it is
 -- not found
-getPackageDetails :: PackageState -> PackageId -> PackageConfig
-getPackageDetails ps pid = expectJust "getPackageDetails" (lookupPackage (pkgIdMap ps) pid)
+getPackageDetails :: DynFlags -> PackageKey -> PackageConfig
+getPackageDetails dflags pid =
+    expectJust "getPackageDetails" (lookupPackage dflags pid)
+
+-- | Get a list of entries from the package database.  NB: be careful with
+-- this function, it may not do what you expect it to.
+listPackageConfigMap :: DynFlags -> [PackageConfig]
+listPackageConfigMap dflags = eltsUFM (pkgIdMap (pkgState dflags))
+
+-- | Looks up a 'PackageKey' given an 'InstalledPackageId'
+resolveInstalledPackageId :: DynFlags -> InstalledPackageId -> PackageKey
+resolveInstalledPackageId dflags ipid =
+    expectJust "resolveInstalledPackageId"
+        (Map.lookup ipid (installedPackageIdMap (pkgState dflags)))
 
 -- ----------------------------------------------------------------------------
 -- Loading the package db files and building up the package state
@@ -167,7 +329,7 @@ getPackageDetails ps pid = expectJust "getPackageDetails" (lookupPackage (pkgIdM
 -- 'packageFlags' field of the 'DynFlags', and it will update the
 -- 'pkgState' in 'DynFlags' and return a list of packages to
 -- link in.
-initPackages :: DynFlags -> IO (DynFlags, [PackageId])
+initPackages :: DynFlags -> IO (DynFlags, [PackageKey])
 initPackages dflags = do
   pkg_db <- case pkgDatabase dflags of
                 Nothing -> readPackageConfigs dflags
@@ -249,17 +411,12 @@ readPackageConfig dflags conf_file = do
   return pkg_configs2
 
 setBatchPackageFlags :: DynFlags -> [PackageConfig] -> [PackageConfig]
-setBatchPackageFlags dflags pkgs = (maybeDistrustAll . maybeHideAll) pkgs
+setBatchPackageFlags dflags pkgs = maybeDistrustAll pkgs
   where
-    maybeHideAll pkgs'
-      | gopt Opt_HideAllPackages dflags = map hide pkgs'
-      | otherwise                       = pkgs'
-
     maybeDistrustAll pkgs'
       | gopt Opt_DistrustAllPackages dflags = map distrust pkgs'
       | otherwise                           = pkgs'
 
-    hide pkg = pkg{ exposed = False }
     distrust pkg = pkg{ trusted = False }
 
 -- TODO: This code is duplicated in utils/ghc-pkg/Main.hs
@@ -316,75 +473,88 @@ mungePackagePaths top_dir pkgroot pkg =
 -- Modify our copy of the package database based on a package flag
 -- (-package, -hide-package, -ignore-package).
 
+-- | A horrible hack, the problem is the package key we'll turn
+-- up here is going to get edited when we select the wired in
+-- packages, so preemptively pick up the right one.  Also, this elem
+-- test is slow.  The alternative is to change wired in packages first, but
+-- then we are no longer able to match against package keys e.g. from when
+-- a user passes in a package flag.
+calcKey :: PackageConfig -> PackageKey
+calcKey p | pk <- display (pkgName (sourcePackageId p))
+          , pk `elem` wired_in_pkgids
+                      = stringToPackageKey pk
+          | otherwise = packageConfigId p
+
 applyPackageFlag
    :: DynFlags
    -> UnusablePackages
-   -> [PackageConfig]           -- Initial database
+   -> ([PackageConfig], VisibilityMap)           -- Initial database
    -> PackageFlag               -- flag to apply
-   -> IO [PackageConfig]        -- new database
+   -> IO ([PackageConfig], VisibilityMap)        -- new database
 
-applyPackageFlag dflags unusable pkgs flag =
-  case flag of
-    ExposePackage str ->
-       case selectPackages (matchingStr str) pkgs unusable of
-         Left ps         -> packageFlagErr dflags flag ps
-         Right (p:ps,qs) -> return (p':ps')
-          where p' = p {exposed=True}
-                ps' = hideAll (pkgName (sourcePackageId p)) (ps++qs)
-         _ -> panic "applyPackageFlag"
+-- ToDo: Unfortunately, we still have to plumb the package config through,
+-- because Safe Haskell trust is still implemented by modifying the database.
+-- Eventually, track that separately and then axe @[PackageConfig]@ from
+-- this fold entirely
 
-    ExposePackageId str ->
-       case selectPackages (matchingId str) pkgs unusable of
+applyPackageFlag dflags unusable (pkgs, vm) flag =
+  case flag of
+    ExposePackage arg m_rns ->
+       case selectPackages (matching arg) pkgs unusable of
          Left ps         -> packageFlagErr dflags flag ps
-         Right (p:ps,qs) -> return (p':ps')
-          where p' = p {exposed=True}
-                ps' = hideAll (pkgName (sourcePackageId p)) (ps++qs)
+         Right (p:_,_) -> return (pkgs, vm')
+          where
+           n = fsPackageName p
+           vm' = addToUFM_C edit vm_cleared (calcKey p)
+                              (case m_rns of
+                                   Nothing   -> (True, [], n)
+                                   Just rns' -> (False, map convRn rns', n))
+           edit (b, rns, n) (b', rns', _) = (b || b', rns ++ rns', n)
+           convRn (a,b) = (mkModuleName a, mkModuleName b)
+           -- ToDo: ATM, -hide-all-packages implicitly triggers change in
+           -- behavior, maybe eventually make it toggleable with a separate
+           -- flag
+           vm_cleared | gopt Opt_HideAllPackages dflags = vm
+                      -- NB: -package foo-0.1 (Foo as Foo1) does NOT hide
+                      -- other versions of foo. Presence of renaming means
+                      -- user probably wanted both.
+                      | Just _ <- m_rns = vm
+                      | otherwise = filterUFM_Directly
+                            (\k (_,_,n') -> k == getUnique (calcKey p)
+                                                || n /= n') vm
          _ -> panic "applyPackageFlag"
 
     HidePackage str ->
        case selectPackages (matchingStr str) pkgs unusable of
          Left ps       -> packageFlagErr dflags flag ps
-         Right (ps,qs) -> return (map hide ps ++ qs)
-          where hide p = p {exposed=False}
+         Right (ps,_) -> return (pkgs, vm')
+          where vm' = delListFromUFM vm (map calcKey ps)
 
     -- we trust all matching packages. Maybe should only trust first one?
     -- and leave others the same or set them untrusted
     TrustPackage str ->
        case selectPackages (matchingStr str) pkgs unusable of
          Left ps       -> packageFlagErr dflags flag ps
-         Right (ps,qs) -> return (map trust ps ++ qs)
+         Right (ps,qs) -> return (map trust ps ++ qs, vm)
           where trust p = p {trusted=True}
 
     DistrustPackage str ->
        case selectPackages (matchingStr str) pkgs unusable of
          Left ps       -> packageFlagErr dflags flag ps
-         Right (ps,qs) -> return (map distrust ps ++ qs)
+         Right (ps,qs) -> return (map distrust ps ++ qs, vm)
           where distrust p = p {trusted=False}
 
-    _ -> panic "applyPackageFlag"
-
-   where
-        -- When a package is requested to be exposed, we hide all other
-        -- packages with the same name.
-        hideAll name ps = map maybe_hide ps
-          where maybe_hide p
-                   | pkgName (sourcePackageId p) == name = p {exposed=False}
-                   | otherwise                           = p
-
+    IgnorePackage _ -> panic "applyPackageFlag: IgnorePackage"
 
 selectPackages :: (PackageConfig -> Bool) -> [PackageConfig]
                -> UnusablePackages
                -> Either [(PackageConfig, UnusablePackageReason)]
                   ([PackageConfig], [PackageConfig])
 selectPackages matches pkgs unusable
-  = let
-        (ps,rest) = partition matches pkgs
-        reasons = [ (p, Map.lookup (installedPackageId p) unusable)
-                  | p <- ps ]
-    in
-    if all (isJust.snd) reasons
-       then Left  [ (p, reason) | (p,Just reason) <- reasons ]
-       else Right (sortByVersion [ p | (p,Nothing) <- reasons ], rest)
+  = let (ps,rest) = partition matches pkgs
+    in if null ps
+        then Left (filter (matches.fst) (Map.elems unusable))
+        else Right (sortByVersion ps, rest)
 
 -- A package named on the command line can either include the
 -- version, or just the name if it is unambiguous.
@@ -396,6 +566,14 @@ matchingStr str p
 matchingId :: String -> PackageConfig -> Bool
 matchingId str p =  InstalledPackageId str == installedPackageId p
 
+matchingKey :: String -> PackageConfig -> Bool
+matchingKey str p = str == display (packageKey p)
+
+matching :: PackageArg -> PackageConfig -> Bool
+matching (PackageArg str) = matchingStr str
+matching (PackageIdArg str) = matchingId str
+matching (PackageKeyArg str) = matchingKey str
+
 sortByVersion :: [InstalledPackageInfo_ m] -> [InstalledPackageInfo_ m]
 sortByVersion = sortBy (flip (comparing (pkgVersion.sourcePackageId)))
 
@@ -409,7 +587,8 @@ packageFlagErr :: DynFlags
 
 -- for missing DPH package we emit a more helpful error message, because
 -- this may be the result of using -fdph-par or -fdph-seq.
-packageFlagErr dflags (ExposePackage pkg) [] | is_dph_package pkg
+packageFlagErr dflags (ExposePackage (PackageArg pkg) _) []
+  | is_dph_package pkg
   = throwGhcExceptionIO (CmdLineError (showSDoc dflags $ dph_err))
   where dph_err = text "the " <> text pkg <> text " package is not installed."
                   $$ text "To install it: \"cabal install dph\"."
@@ -417,50 +596,37 @@ packageFlagErr dflags (ExposePackage pkg) [] | is_dph_package pkg
 
 packageFlagErr dflags flag reasons
   = throwGhcExceptionIO (CmdLineError (showSDoc dflags $ err))
-  where err = text "cannot satisfy " <> ppr_flag <>
+  where err = text "cannot satisfy " <> pprFlag flag <>
                 (if null reasons then empty else text ": ") $$
               nest 4 (ppr_reasons $$
+                      -- ToDo: this admonition seems a bit dodgy
                       text "(use -v for more information)")
-        ppr_flag = case flag of
-                     IgnorePackage p -> text "-ignore-package " <> text p
-                     HidePackage p   -> text "-hide-package " <> text p
-                     ExposePackage p -> text "-package " <> text p
-                     ExposePackageId p -> text "-package-id " <> text p
-                     TrustPackage p    -> text "-trust " <> text p
-                     DistrustPackage p -> text "-distrust " <> text p
         ppr_reasons = vcat (map ppr_reason reasons)
         ppr_reason (p, reason) = pprReason (pprIPkg p <+> text "is") reason
 
--- -----------------------------------------------------------------------------
--- Hide old versions of packages
-
---
--- hide all packages for which there is also a later version
--- that is already exposed.  This just makes it non-fatal to have two
--- versions of a package exposed, which can happen if you install a
--- later version of a package in the user database, for example.
---
-hideOldPackages :: DynFlags -> [PackageConfig] -> IO [PackageConfig]
-hideOldPackages dflags pkgs = mapM maybe_hide pkgs
-  where maybe_hide p
-           | not (exposed p) = return p
-           | (p' : _) <- later_versions = do
-                debugTraceMsg dflags 2 $
-                   (ptext (sLit "hiding package") <+> pprSPkg p <+>
-                    ptext (sLit "to avoid conflict with later version") <+>
-                    pprSPkg p')
-                return (p {exposed=False})
-           | otherwise = return p
-          where myname = pkgName (sourcePackageId p)
-                myversion = pkgVersion (sourcePackageId p)
-                later_versions = [ p | p <- pkgs, exposed p,
-                                       let pkg = sourcePackageId p,
-                                       pkgName pkg == myname,
-                                       pkgVersion pkg > myversion ]
+pprFlag :: PackageFlag -> SDoc
+pprFlag flag = case flag of
+    IgnorePackage p -> text "-ignore-package " <> text p
+    HidePackage p   -> text "-hide-package " <> text p
+    ExposePackage a rns -> ppr_arg a <> ppr_rns rns
+    TrustPackage p    -> text "-trust " <> text p
+    DistrustPackage p -> text "-distrust " <> text p
+  where ppr_arg arg = case arg of
+                     PackageArg    p -> text "-package " <> text p
+                     PackageIdArg  p -> text "-package-id " <> text p
+                     PackageKeyArg p -> text "-package-key " <> text p
+        ppr_rns Nothing = empty
+        ppr_rns (Just rns) = char '(' <> hsep (punctuate comma (map ppr_rn rns))
+                                      <> char ')'
+        ppr_rn (orig, new) | orig == new = text orig
+                           | otherwise = text orig <+> text "as" <+> text new
 
 -- -----------------------------------------------------------------------------
 -- Wired-in packages
 
+wired_in_pkgids :: [String]
+wired_in_pkgids = map packageKeyString wiredInPackageKeys
+
 findWiredInPackages
    :: DynFlags
    -> [PackageConfig]           -- database
@@ -472,16 +638,6 @@ findWiredInPackages dflags pkgs = do
   -- their canonical names (eg. base-1.0 ==> base).
   --
   let
-        wired_in_pkgids :: [String]
-        wired_in_pkgids = map packageIdString
-                          [ primPackageId,
-                            integerPackageId,
-                            basePackageId,
-                            rtsPackageId,
-                            thPackageId,
-                            dphSeqPackageId,
-                            dphParPackageId ]
-
         matches :: PackageConfig -> String -> Bool
         pc `matches` pid = display (pkgName (sourcePackageId pc)) == pid
 
@@ -491,9 +647,10 @@ findWiredInPackages dflags pkgs = do
         -- one.
         --
         -- When choosing which package to map to a wired-in package
-        -- name, we prefer exposed packages, and pick the latest
-        -- version.  To override the default choice, -hide-package
-        -- could be used to hide newer versions.
+        -- name, we pick the latest version (modern Cabal makes it difficult
+        -- to install multiple versions of wired-in packages, however!)
+        -- To override the default choice, -ignore-package could be used to
+        -- hide newer versions.
         --
         findWiredInPackage :: [PackageConfig] -> String
                            -> IO (Maybe InstalledPackageId)
@@ -540,7 +697,9 @@ findWiredInPackages dflags pkgs = do
         updateWiredInDependencies pkgs = map upd_pkg pkgs
           where upd_pkg p
                   | installedPackageId p `elem` wired_in_ids
-                  = p { sourcePackageId = (sourcePackageId p){ pkgVersion = Version [] [] } }
+                  = let pid = (sourcePackageId p) { pkgVersion = Version [] [] }
+                    in p { sourcePackageId = pid
+                         , packageKey = OldPackageKey pid }
                   | otherwise
                   = p
 
@@ -553,7 +712,8 @@ data UnusablePackageReason
   | MissingDependencies [InstalledPackageId]
   | ShadowedBy InstalledPackageId
 
-type UnusablePackages = Map InstalledPackageId UnusablePackageReason
+type UnusablePackages = Map InstalledPackageId
+                            (PackageConfig, UnusablePackageReason)
 
 pprReason :: SDoc -> UnusablePackageReason -> SDoc
 pprReason pref reason = case reason of
@@ -569,7 +729,7 @@ pprReason pref reason = case reason of
 reportUnusable :: DynFlags -> UnusablePackages -> IO ()
 reportUnusable dflags pkgs = mapM_ report (Map.toList pkgs)
   where
-    report (ipid, reason) =
+    report (ipid, (_, reason)) =
        debugTraceMsg dflags 2 $
          pprReason
            (ptext (sLit "package") <+>
@@ -589,7 +749,7 @@ findBroken pkgs = go [] Map.empty pkgs
    go avail ipids not_avail =
      case partitionWith (depsAvailable ipids) not_avail of
         ([], not_avail) ->
-            Map.fromList [ (installedPackageId p, MissingDependencies deps)
+            Map.fromList [ (installedPackageId p, (p, MissingDependencies deps))
                          | (p,deps) <- not_avail ]
         (new_avail, not_avail) ->
             go (new_avail ++ avail) new_ipids (map fst not_avail)
@@ -618,19 +778,20 @@ shadowPackages pkgs preferred
    in  Map.fromList shadowed
  where
  check (shadowed,pkgmap) pkg
-      | Just oldpkg <- lookupUFM pkgmap (packageConfigId pkg)
+      | Just oldpkg <- lookupUFM pkgmap pkgid
       , let
             ipid_new = installedPackageId pkg
             ipid_old = installedPackageId oldpkg
         --
       , ipid_old /= ipid_new
       = if ipid_old `elem` preferred
-           then ( (ipid_new, ShadowedBy ipid_old) : shadowed, pkgmap )
-           else ( (ipid_old, ShadowedBy ipid_new) : shadowed, pkgmap' )
+           then ((ipid_new, (pkg, ShadowedBy ipid_old)) : shadowed, pkgmap)
+           else ((ipid_old, (oldpkg, ShadowedBy ipid_new)) : shadowed, pkgmap')
       | otherwise
       = (shadowed, pkgmap')
       where
-        pkgmap' = addToUFM pkgmap (packageConfigId pkg) pkg
+        pkgid = mkFastString (display (sourcePackageId pkg))
+        pkgmap' = addToUFM pkgmap pkgid pkg
 
 -- -----------------------------------------------------------------------------
 
@@ -639,7 +800,7 @@ ignorePackages flags pkgs = Map.fromList (concatMap doit flags)
   where
   doit (IgnorePackage str) =
      case partition (matchingStr str) pkgs of
-         (ps, _) -> [ (installedPackageId p, IgnoredWithFlag)
+         (ps, _) -> [ (installedPackageId p, (p, IgnoredWithFlag))
                     | p <- ps ]
         -- missing package is not an error for -ignore-package,
         -- because a common usage is to -ignore-package P as
@@ -667,11 +828,11 @@ depClosure index ipids = closure Map.empty ipids
 mkPackageState
     :: DynFlags
     -> [PackageConfig]          -- initial database
-    -> [PackageId]              -- preloaded packages
-    -> PackageId                -- this package
+    -> [PackageKey]              -- preloaded packages
+    -> PackageKey                -- this package
     -> IO (PackageState,
-           [PackageId],         -- new packages to preload
-           PackageId) -- this package, might be modified if the current
+           [PackageKey],         -- new packages to preload
+           PackageKey) -- this package, might be modified if the current
                       -- package is a wired-in package.
 
 mkPackageState dflags pkgs0 preload0 this_package = do
@@ -682,12 +843,12 @@ mkPackageState dflags pkgs0 preload0 this_package = do
    1. P = transitive closure of packages selected by -package-id
 
    2. Apply shadowing.  When there are multiple packages with the same
-      sourcePackageId,
+      packageKey,
         * if one is in P, use that one
         * otherwise, use the one highest in the package stack
       [
-       rationale: we cannot use two packages with the same sourcePackageId
-       in the same program, because sourcePackageId is the symbol prefix.
+       rationale: we cannot use two packages with the same packageKey
+       in the same program, because packageKey is the symbol prefix.
        Hence we must select a consistent set of packages to use.  We have
        a default algorithm for doing this: packages higher in the stack
        shadow those lower down.  This default algorithm can be overriden
@@ -735,30 +896,64 @@ mkPackageState dflags pkgs0 preload0 this_package = do
 
       ipid_map = Map.fromList [ (installedPackageId p, p) | p <- pkgs0 ]
 
-      ipid_selected = depClosure ipid_map [ InstalledPackageId i
-                                          | ExposePackageId i <- flags ]
+      ipid_selected = depClosure ipid_map
+                                 [ InstalledPackageId i
+                                 | ExposePackage (PackageIdArg i) _ <- flags ]
 
       (ignore_flags, other_flags) = partition is_ignore flags
       is_ignore IgnorePackage{} = True
       is_ignore _ = False
 
       shadowed = shadowPackages pkgs0_unique ipid_selected
-
       ignored  = ignorePackages ignore_flags pkgs0_unique
 
-      pkgs0' = filter (not . (`Map.member` (Map.union shadowed ignored)) . installedPackageId) pkgs0_unique
+      isBroken = (`Map.member` (Map.union shadowed ignored)).installedPackageId
+      pkgs0' = filter (not . isBroken) pkgs0_unique
+
       broken   = findBroken pkgs0'
+
       unusable = shadowed `Map.union` ignored `Map.union` broken
+      pkgs1 = filter (not . (`Map.member` unusable) . installedPackageId) pkgs0'
 
   reportUnusable dflags unusable
 
+  --
+  -- Calculate the initial set of packages, prior to any package flags.
+  -- This set contains the latest version of all valid (not unusable) packages,
+  -- or is empty if we have -hide-all-packages
+  --
+  let preferLater pkg pkg' =
+        case comparing (pkgVersion.sourcePackageId) pkg pkg' of
+            GT -> pkg
+            _  -> pkg'
+      calcInitial m pkg = addToUFM_C preferLater m (fsPackageName pkg) pkg
+      initial = if gopt Opt_HideAllPackages dflags
+                    then emptyUFM
+                    else foldl' calcInitial emptyUFM pkgs1
+      vis_map0 = foldUFM (\p vm ->
+                            if exposed p
+                               then addToUFM vm (calcKey p)
+                                             (True, [], fsPackageName p)
+                               else vm)
+                         emptyUFM initial
+
   --
   -- Modify the package database according to the command-line flags
   -- (-package, -hide-package, -ignore-package, -hide-all-packages).
+  -- This needs to know about the unusable packages, since if a user tries
+  -- to enable an unusable package, we should let them know.
   --
-  pkgs1 <- foldM (applyPackageFlag dflags unusable) pkgs0_unique other_flags
-  let pkgs2 = filter (not . (`Map.member` unusable) . installedPackageId) pkgs1
+  (pkgs2, vis_map) <- foldM (applyPackageFlag dflags unusable)
+                            (pkgs1, vis_map0) other_flags
 
+  --
+  -- Sort out which packages are wired in. This has to be done last, since
+  -- it modifies the package keys of wired in packages, but when we process
+  -- package arguments we need to key against the old versions.
+  --
+  pkgs3 <- findWiredInPackages dflags pkgs2
+
+  --
   -- Here we build up a set of the packages mentioned in -package
   -- flags on the command line; these are called the "preload"
   -- packages.  we link these packages in eagerly.  The preload set
@@ -767,22 +962,15 @@ mkPackageState dflags pkgs0 preload0 this_package = do
   --
   let preload1 = [ installedPackageId p | f <- flags, p <- get_exposed f ]
 
-      get_exposed (ExposePackage   s)
-         = take 1 $ sortByVersion (filter (matchingStr s) pkgs2)
-         --  -package P means "the latest version of P" (#7030)
-      get_exposed (ExposePackageId s) = filter (matchingId  s) pkgs2
-      get_exposed _                   = []
+      get_exposed (ExposePackage a _) = take 1 . sortByVersion
+                                      . filter (matching a)
+                                      $ pkgs2
+      get_exposed _                 = []
 
-  -- hide packages that are subsumed by later versions
-  pkgs3 <- hideOldPackages dflags pkgs2
-
-  -- sort out which packages are wired in
-  pkgs4 <- findWiredInPackages dflags pkgs3
-
-  let pkg_db = extendPackageConfigMap emptyPackageConfigMap pkgs4
+  let pkg_db = extendPackageConfigMap emptyPackageConfigMap pkgs3
 
       ipid_map = Map.fromList [ (installedPackageId p, packageConfigId p)
-                              | p <- pkgs4 ]
+                              | p <- pkgs3 ]
 
       lookupIPID ipid@(InstalledPackageId str)
          | Just pid <- Map.lookup ipid ipid_map = return pid
@@ -794,7 +982,8 @@ mkPackageState dflags pkgs0 preload0 this_package = do
       -- add base & rts to the preload packages
       basicLinkedPackages
        | gopt Opt_AutoLinkPackages dflags
-          = filter (flip elemUFM pkg_db) [basePackageId, rtsPackageId]
+          = filter (flip elemUFM pkg_db)
+                [basePackageKey, rtsPackageKey]
        | otherwise = []
       -- but in any case remove the current package from the set of
       -- preloaded packages so that base/rts does not end up in the
@@ -806,36 +995,118 @@ mkPackageState dflags pkgs0 preload0 this_package = do
   dep_preload <- closeDeps dflags pkg_db ipid_map (zip preload3 (repeat Nothing))
   let new_dep_preload = filter (`notElem` preload0) dep_preload
 
-  let pstate = PackageState{ preloadPackages     = dep_preload,
-                             pkgIdMap            = pkg_db,
-                             moduleToPkgConfAll  = mkModuleMap pkg_db,
-                             installedPackageIdMap = ipid_map
-                           }
-
+  let pstate = PackageState{
+    preloadPackages     = dep_preload,
+    pkgIdMap            = pkg_db,
+    moduleToPkgConf     = mkModuleToPkgConf dflags pkg_db ipid_map vis_map,
+    moduleToPkgConfAll  = mkModuleToPkgConfAll dflags pkg_db ipid_map vis_map,
+    installedPackageIdMap = ipid_map
+    }
   return (pstate, new_dep_preload, this_package)
 
 
 -- -----------------------------------------------------------------------------
--- Make the mapping from module to package info
-
-mkModuleMap
-  :: PackageConfigMap
-  -> UniqFM [(PackageConfig, Bool)]
-mkModuleMap pkg_db = foldr extend_modmap emptyUFM pkgids
-  where
-        pkgids = map packageConfigId (eltsUFM pkg_db)
-
-        extend_modmap pkgid modmap =
-                addListToUFM_C (++) modmap
-                   ([(m, [(pkg, True)])  | m <- exposed_mods] ++
-                    [(m, [(pkg, False)]) | m <- hidden_mods])
-          where
-                pkg = expectJust "mkModuleMap" (lookupPackage pkg_db pkgid)
-                exposed_mods = exposedModules pkg
-                hidden_mods  = hiddenModules pkg
-
-pprSPkg :: PackageConfig -> SDoc
-pprSPkg p = text (display (sourcePackageId p))
+-- | Makes the mapping from module to package info
+
+-- | This function is generic; we instantiate it
+mkModuleToPkgConfGeneric
+  :: forall m e.
+     -- Empty map, e.g. the initial state of the output
+     m e
+     -- How to create an entry in the map based on the calculated information
+  -> (PackageKey -> ModuleName -> PackageConfig -> ModuleOrigin -> e)
+     -- How to override the origin of an entry (used for renaming)
+  -> (e -> ModuleOrigin -> e)
+     -- How to incorporate a list of entries into the map
+  -> (m e -> [(ModuleName, e)] -> m e)
+  -- The proper arguments
+  -> DynFlags
+  -> PackageConfigMap
+  -> InstalledPackageIdMap
+  -> VisibilityMap
+  -> m e
+mkModuleToPkgConfGeneric emptyMap sing setOrigins addListTo
+                         dflags pkg_db ipid_map vis_map =
+    foldl' extend_modmap emptyMap (eltsUFM pkg_db)
+ where
+  extend_modmap modmap pkg = addListTo modmap theBindings
+   where
+    theBindings :: [(ModuleName, e)]
+    theBindings | Just (b,rns,_) <- lookupUFM vis_map (packageConfigId pkg)
+                              = newBindings b rns
+                | otherwise   = newBindings False []
+
+    newBindings :: Bool -> [(ModuleName, ModuleName)] -> [(ModuleName, e)]
+    newBindings e rns  = es e ++ hiddens ++ map rnBinding rns
+
+    rnBinding :: (ModuleName, ModuleName) -> (ModuleName, e)
+    rnBinding (orig, new) = (new, setOrigins origEntry fromFlag)
+     where origEntry = case lookupUFM esmap orig of
+            Just r -> r
+            Nothing -> throwGhcException (CmdLineError (showSDoc dflags
+                        (text "package flag: could not find module name" <+>
+                            ppr orig <+> text "in package" <+> ppr pk)))
+
+    es :: Bool -> [(ModuleName, e)]
+    es e =
+     [(m, sing pk  m  pkg  (fromExposedModules e)) | m <- exposed_mods] ++
+     [(m, sing pk' m' pkg' (fromReexportedModules e pkg))
+     | ModuleExport{ exportName = m
+                   , exportCachedTrueOrig = Just (ipid', m')} <- reexported_mods
+     , let pk' = expectJust "mkModuleToPkgConf" (Map.lookup ipid' ipid_map)
+           pkg' = pkg_lookup pk' ]
+
+    esmap :: UniqFM e
+    esmap = listToUFM (es False) -- parameter here doesn't matter, orig will
+                                 -- be overwritten
+
+    hiddens = [(m, sing pk m pkg ModHidden) | m <- hidden_mods]
+
+    pk = packageConfigId pkg
+    pkg_lookup = expectJust "mkModuleToPkgConf" . lookupPackage' pkg_db
+
+    exposed_mods = exposedModules pkg
+    reexported_mods = reexportedModules pkg
+    hidden_mods = hiddenModules pkg
+
+-- | This is a quick and efficient module map, which only contains an entry
+-- if it is specified unambiguously.
+mkModuleToPkgConf
+  :: DynFlags
+  -> PackageConfigMap
+  -> InstalledPackageIdMap
+  -> VisibilityMap
+  -> ModuleNameMap SimpleModuleConf
+mkModuleToPkgConf =
+  mkModuleToPkgConfGeneric emptyMap sing setOrigins addListTo
+    where emptyMap = emptyUFM
+          sing pk m pkg = SModConf (mkModule pk m) pkg
+          -- NB: don't put hidden entries in the map, they're not valid!
+          addListTo m xs = addListToUFM_C merge m (filter isVisible xs)
+          isVisible (_, SModConf _ _ o) = originVisible o
+          isVisible (_, SModConfAmbiguous) = False
+          merge (SModConf m pkg o) (SModConf m' _ o')
+              | m == m' = SModConf m pkg (o `mappend` o')
+              | otherwise = SModConfAmbiguous
+          merge _ _ = SModConfAmbiguous
+          setOrigins (SModConf m pkg _) os = SModConf m pkg os
+          setOrigins SModConfAmbiguous _ = SModConfAmbiguous
+
+-- | This is a slow and complete map, which includes information about
+-- everything, including hidden modules
+mkModuleToPkgConfAll
+  :: DynFlags
+  -> PackageConfigMap
+  -> InstalledPackageIdMap
+  -> VisibilityMap
+  -> ModuleToPkgConfAll
+mkModuleToPkgConfAll =
+  mkModuleToPkgConfGeneric emptyMap sing setOrigins addListTo
+    where emptyMap = Map.empty
+          sing pk m _ = Map.singleton (mkModule pk m)
+          addListTo = foldl' merge
+          merge m (k, v) = Map.insertWith (Map.unionWith mappend) k v m
+          setOrigins m os = fmap (const os) m
 
 pprIPkg :: PackageConfig -> SDoc
 pprIPkg p = text (display (installedPackageId p))
@@ -852,7 +1123,7 @@ pprIPkg p = text (display (installedPackageId p))
 -- use.
 
 -- | Find all the include directories in these and the preload packages
-getPackageIncludePath :: DynFlags -> [PackageId] -> IO [String]
+getPackageIncludePath :: DynFlags -> [PackageKey] -> IO [String]
 getPackageIncludePath dflags pkgs =
   collectIncludeDirs `fmap` getPreloadPackagesAnd dflags pkgs
 
@@ -860,7 +1131,7 @@ collectIncludeDirs :: [PackageConfig] -> [FilePath]
 collectIncludeDirs ps = nub (filter notNull (concatMap includeDirs ps))
 
 -- | Find all the library paths in these and the preload packages
-getPackageLibraryPath :: DynFlags -> [PackageId] -> IO [String]
+getPackageLibraryPath :: DynFlags -> [PackageKey] -> IO [String]
 getPackageLibraryPath dflags pkgs =
   collectLibraryPaths `fmap` getPreloadPackagesAnd dflags pkgs
 
@@ -869,7 +1140,7 @@ collectLibraryPaths ps = nub (filter notNull (concatMap libraryDirs ps))
 
 -- | Find all the link options in these and the preload packages,
 -- returning (package hs lib options, extra library options, other flags)
-getPackageLinkOpts :: DynFlags -> [PackageId] -> IO ([String], [String], [String])
+getPackageLinkOpts :: DynFlags -> [PackageKey] -> IO ([String], [String], [String])
 getPackageLinkOpts dflags pkgs =
   collectLinkOpts dflags `fmap` getPreloadPackagesAnd dflags pkgs
 
@@ -917,19 +1188,19 @@ packageHsLibs dflags p = map (mkDynName . addSuffix) (hsLibraries p)
                     | otherwise = '_':t
 
 -- | Find all the C-compiler options in these and the preload packages
-getPackageExtraCcOpts :: DynFlags -> [PackageId] -> IO [String]
+getPackageExtraCcOpts :: DynFlags -> [PackageKey] -> IO [String]
 getPackageExtraCcOpts dflags pkgs = do
   ps <- getPreloadPackagesAnd dflags pkgs
   return (concatMap ccOptions ps)
 
 -- | Find all the package framework paths in these and the preload packages
-getPackageFrameworkPath  :: DynFlags -> [PackageId] -> IO [String]
+getPackageFrameworkPath  :: DynFlags -> [PackageKey] -> IO [String]
 getPackageFrameworkPath dflags pkgs = do
   ps <- getPreloadPackagesAnd dflags pkgs
   return (nub (filter notNull (concatMap frameworkDirs ps)))
 
 -- | Find all the package frameworks in these and the preload packages
-getPackageFrameworks  :: DynFlags -> [PackageId] -> IO [String]
+getPackageFrameworks  :: DynFlags -> [PackageKey] -> IO [String]
 getPackageFrameworks dflags pkgs = do
   ps <- getPreloadPackagesAnd dflags pkgs
   return (concatMap frameworks ps)
@@ -937,41 +1208,114 @@ getPackageFrameworks dflags pkgs = do
 -- -----------------------------------------------------------------------------
 -- Package Utils
 
--- | Takes a 'Module', and if the module is in a package returns
--- @(pkgconf, exposed)@ where pkgconf is the PackageConfig for that package,
--- and exposed is @True@ if the package exposes the module.
-lookupModuleInAllPackages :: DynFlags -> ModuleName -> [(PackageConfig,Bool)]
+-- | Takes a 'ModuleName', and if the module is in any package returns
+-- list of modules which take that name.
+lookupModuleInAllPackages :: DynFlags
+                          -> ModuleName
+                          -> [(Module, PackageConfig)]
 lookupModuleInAllPackages dflags m
-  = case lookupModuleWithSuggestions dflags m of
-      Right pbs -> pbs
-      Left  _   -> []
-
-lookupModuleWithSuggestions
-  :: DynFlags -> ModuleName
-  -> Either [Module] [(PackageConfig,Bool)]
-         -- Lookup module in all packages
-         -- Right pbs   =>   found in pbs
-         -- Left  ms    =>   not found; but here are sugestions
-lookupModuleWithSuggestions dflags m
-  = case lookupUFM (moduleToPkgConfAll pkg_state) m of
-        Nothing -> Left suggestions
-        Just ps -> Right ps
+  = case lookupModuleWithSuggestions dflags m Nothing of
+      LookupFound a b -> [(a,b)]
+      LookupMultiple rs -> map f rs
+        where f (m,_) = (m, expectJust "lookupModule" (lookupPackage dflags
+                                                         (modulePackageKey m)))
+      _ -> []
+
+-- | The result of performing a lookup
+data LookupResult =
+    -- | Found the module uniquely, nothing else to do
+    LookupFound Module PackageConfig
+    -- | Multiple modules with the same name in scope
+  | LookupMultiple [(Module, ModuleOrigin)]
+    -- | No modules found, but there were some hidden ones with
+    -- an exact name match.  First is due to package hidden, second
+    -- is due to module being hidden
+  | LookupHidden [(Module, ModuleOrigin)] [(Module, ModuleOrigin)]
+    -- | Nothing found, here are some suggested different names
+  | LookupNotFound [ModuleSuggestion] -- suggestions
+
+data ModuleSuggestion = SuggestVisible ModuleName Module ModuleOrigin
+                      | SuggestHidden ModuleName Module ModuleOrigin
+
+lookupModuleWithSuggestions :: DynFlags
+                            -> ModuleName
+                            -> Maybe FastString
+                            -> LookupResult
+lookupModuleWithSuggestions dflags m mb_pn
+  = case lookupUFM (moduleToPkgConf pkg_state) m of
+     Just (SModConf m pkg o) | matches mb_pn pkg o ->
+        ASSERT( originVisible o ) LookupFound m pkg
+     _ -> case Map.lookup m (moduleToPkgConfAll pkg_state) of
+        Nothing -> LookupNotFound suggestions
+        Just xs ->
+          case foldl' classify ([],[],[]) (Map.toList xs) of
+            ([], [], []) -> LookupNotFound suggestions
+            -- NB: Yes, we have to check this case too, since package qualified
+            -- imports could cause the main lookup to fail due to ambiguity,
+            -- but the second lookup to succeed.
+            (_, _, [(m, _)])             -> LookupFound m (mod_pkg m)
+            (_, _, exposed@(_:_))        -> LookupMultiple exposed
+            (hidden_pkg, hidden_mod, []) -> LookupHidden hidden_pkg hidden_mod
   where
+    classify (hidden_pkg, hidden_mod, exposed) (m, origin0) =
+      let origin = filterOrigin mb_pn (mod_pkg m) origin0
+          x = (m, origin)
+      in case origin of
+          ModHidden                  -> (hidden_pkg,   x:hidden_mod, exposed)
+          _ | originEmpty origin     -> (hidden_pkg,   hidden_mod,   exposed)
+            | originVisible origin   -> (hidden_pkg,   hidden_mod,   x:exposed)
+            | otherwise              -> (x:hidden_pkg, hidden_mod,   exposed)
+
+    pkg_lookup = expectJust "lookupModuleWithSuggestions" . lookupPackage dflags
     pkg_state = pkgState dflags
+    mod_pkg = pkg_lookup . modulePackageKey
+
+    matches Nothing _ _ = True -- shortcut for efficiency
+    matches mb_pn pkg o = originVisible (filterOrigin mb_pn pkg o)
+
+    -- Filters out origins which are not associated with the given package
+    -- qualifier.  No-op if there is no package qualifier.  Test if this
+    -- excluded all origins with 'originEmpty'.
+    filterOrigin :: Maybe FastString
+                 -> PackageConfig
+                 -> ModuleOrigin
+                 -> ModuleOrigin
+    filterOrigin Nothing _ o = o
+    filterOrigin (Just pn) pkg o =
+      case o of
+          ModHidden -> if go pkg then ModHidden else mempty
+          ModOrigin { fromOrigPackage = e, fromExposedReexport = res,
+                      fromHiddenReexport = rhs }
+            -> ModOrigin {
+                  fromOrigPackage = if go pkg then e else Nothing
+                , fromExposedReexport = filter go res
+                , fromHiddenReexport = filter go rhs
+                , fromPackageFlag = False -- always excluded
+                }
+      where go pkg = pn == fsPackageName pkg
+
     suggestions
       | gopt Opt_HelpfulErrors dflags =
            fuzzyLookup (moduleNameString m) all_mods
       | otherwise = []
 
-    all_mods :: [(String, Module)]     -- All modules
-    all_mods = [ (moduleNameString mod_nm, mkModule pkg_id mod_nm)
-               | pkg_config <- eltsUFM (pkgIdMap pkg_state)
-               , let pkg_id = packageConfigId pkg_config
-               , mod_nm <- exposedModules pkg_config ]
+    all_mods :: [(String, ModuleSuggestion)]     -- All modules
+    all_mods = sortBy (comparing fst) $
+        [ (moduleNameString m, suggestion)
+        | (m, e) <- Map.toList (moduleToPkgConfAll (pkgState dflags))
+        , suggestion <- map (getSuggestion m) (Map.toList e)
+        ]
+    getSuggestion name (mod, origin) =
+        (if originVisible origin then SuggestVisible else SuggestHidden)
+            name mod origin
+
+listVisibleModuleNames :: DynFlags -> [ModuleName]
+listVisibleModuleNames dflags =
+    Map.keys (moduleToPkgConfAll (pkgState dflags))
 
 -- | Find all the 'PackageConfig' in both the preload packages from 'DynFlags' and corresponding to the list of
 -- 'PackageConfig's
-getPreloadPackagesAnd :: DynFlags -> [PackageId] -> IO [PackageConfig]
+getPreloadPackagesAnd :: DynFlags -> [PackageKey] -> IO [PackageConfig]
 getPreloadPackagesAnd dflags pkgids =
   let
       state   = pkgState dflags
@@ -981,15 +1325,15 @@ getPreloadPackagesAnd dflags pkgids =
       pairs = zip pkgids (repeat Nothing)
   in do
   all_pkgs <- throwErr dflags (foldM (add_package pkg_map ipid_map) preload pairs)
-  return (map (getPackageDetails state) all_pkgs)
+  return (map (getPackageDetails dflags) all_pkgs)
 
 -- Takes a list of packages, and returns the list with dependencies included,
 -- in reverse dependency order (a package appears before those it depends on).
 closeDeps :: DynFlags
           -> PackageConfigMap
-          -> Map InstalledPackageId PackageId
-          -> [(PackageId, Maybe PackageId)]
-          -> IO [PackageId]
+          -> Map InstalledPackageId PackageKey
+          -> [(PackageKey, Maybe PackageKey)]
+          -> IO [PackageKey]
 closeDeps dflags pkg_map ipid_map ps
     = throwErr dflags (closeDepsErr pkg_map ipid_map ps)
 
@@ -1000,22 +1344,22 @@ throwErr dflags m
                 Succeeded r -> return r
 
 closeDepsErr :: PackageConfigMap
-             -> Map InstalledPackageId PackageId
-             -> [(PackageId,Maybe PackageId)]
-             -> MaybeErr MsgDoc [PackageId]
+             -> Map InstalledPackageId PackageKey
+             -> [(PackageKey,Maybe PackageKey)]
+             -> MaybeErr MsgDoc [PackageKey]
 closeDepsErr pkg_map ipid_map ps = foldM (add_package pkg_map ipid_map) [] ps
 
 -- internal helper
 add_package :: PackageConfigMap
-            -> Map InstalledPackageId PackageId
-            -> [PackageId]
-            -> (PackageId,Maybe PackageId)
-            -> MaybeErr MsgDoc [PackageId]
+            -> Map InstalledPackageId PackageKey
+            -> [PackageKey]
+            -> (PackageKey,Maybe PackageKey)
+            -> MaybeErr MsgDoc [PackageKey]
 add_package pkg_db ipid_map ps (p, mb_parent)
   | p `elem` ps = return ps     -- Check if we've already added this package
   | otherwise =
-      case lookupPackage pkg_db p of
-        Nothing -> Failed (missingPackageMsg (packageIdString p) <>
+      case lookupPackage' pkg_db p of
+        Nothing -> Failed (missingPackageMsg (packageKeyString p) <>
                            missingDependencyMsg mb_parent)
         Just pkg -> do
            -- Add the package's dependents also
@@ -1035,22 +1379,41 @@ missingPackageErr dflags p
 missingPackageMsg :: String -> SDoc
 missingPackageMsg p = ptext (sLit "unknown package:") <+> text p
 
-missingDependencyMsg :: Maybe PackageId -> SDoc
+missingDependencyMsg :: Maybe PackageKey -> SDoc
 missingDependencyMsg Nothing = empty
 missingDependencyMsg (Just parent)
-  = space <> parens (ptext (sLit "dependency of") <+> ftext (packageIdFS parent))
+  = space <> parens (ptext (sLit "dependency of") <+> ftext (packageKeyFS parent))
 
 -- -----------------------------------------------------------------------------
 
+packageKeyPackageIdString :: DynFlags -> PackageKey -> String
+packageKeyPackageIdString dflags pkg_key
+    | pkg_key == mainPackageKey = "main"
+    | otherwise = maybe "(unknown)"
+                      (display . sourcePackageId)
+                      (lookupPackage dflags pkg_key)
+
 -- | Will the 'Name' come from a dynamically linked library?
-isDllName :: DynFlags -> PackageId -> Module -> Name -> Bool
+isDllName :: DynFlags -> PackageKey -> Module -> Name -> Bool
 -- Despite the "dll", I think this function just means that
 -- the synbol comes from another dynamically-linked package,
 -- and applies on all platforms, not just Windows
-isDllName dflags this_pkg this_mod name
+isDllName dflags _this_pkg this_mod name
   | gopt Opt_Static dflags = False
   | Just mod <- nameModule_maybe name
-    = if modulePackageId mod /= this_pkg
+    -- Issue #8696 - when GHC is dynamically linked, it will attempt
+    -- to load the dynamic dependencies of object files at compile
+    -- time for things like QuasiQuotes or
+    -- TemplateHaskell. Unfortunately, this interacts badly with
+    -- intra-package linking, because we don't generate indirect
+    -- (dynamic) symbols for intra-package calls. This means that if a
+    -- module with an intra-package call is loaded without its
+    -- dependencies, then GHC fails to link. This is the cause of #
+    --
+    -- In the mean time, always force dynamic indirections to be
+    -- generated: when the module name isn't the module being
+    -- compiled, references are dynamic.
+    = if mod /= this_mod
       then True
       else case dllSplit dflags of
            Nothing -> False
@@ -1066,12 +1429,39 @@ isDllName dflags this_pkg this_mod name
 -- -----------------------------------------------------------------------------
 -- Displaying packages
 
--- | Show package info on console, if verbosity is >= 3
+-- | Show (very verbose) package info on console, if verbosity is >= 5
 dumpPackages :: DynFlags -> IO ()
-dumpPackages dflags
-  = do let pkg_map = pkgIdMap (pkgState dflags)
-       putMsg dflags $
-             vcat (map (text . showInstalledPackageInfo
+dumpPackages = dumpPackages' showInstalledPackageInfo
+
+dumpPackages' :: (InstalledPackageInfo -> String) -> DynFlags -> IO ()
+dumpPackages' showIPI dflags
+  = do putMsg dflags $
+             vcat (map (text . showIPI
                              . packageConfigToInstalledPackageInfo)
-                       (eltsUFM pkg_map))
+                       (listPackageConfigMap dflags))
+
+-- | Show simplified package info on console, if verbosity == 4.
+-- The idea is to only print package id, and any information that might
+-- be different from the package databases (exposure, trust)
+simpleDumpPackages :: DynFlags -> IO ()
+simpleDumpPackages = dumpPackages' showIPI
+    where showIPI ipi = let InstalledPackageId i = installedPackageId ipi
+                            e = if exposed ipi then "E" else " "
+                            t = if trusted ipi then "T" else " "
+                        in e ++ t ++ "  " ++ i
+
+-- | Show the mapping of modules to where they come from.
+pprModuleMap :: DynFlags -> SDoc
+pprModuleMap dflags =
+  vcat (map pprLine (Map.toList (moduleToPkgConfAll (pkgState dflags))))
+    where
+      pprLine (m,e) = ppr m $$ nest 50 (vcat (map (pprEntry m) (Map.toList e)))
+      pprEntry m (m',o)
+        | m == moduleName m' = ppr (modulePackageKey m') <+> parens (ppr o)
+        | otherwise = ppr m' <+> parens (ppr o)
+
+fsPackageName :: PackageConfig -> FastString
+fsPackageName pkg = case packageName (sourcePackageId pkg) of
+    PackageName n -> mkFastString n
+
 \end{code}
diff --git a/compiler/main/Packages.lhs-boot b/compiler/main/Packages.lhs-boot
index 3a1712e2da1c..3fd0fd542235 100644
--- a/compiler/main/Packages.lhs-boot
+++ b/compiler/main/Packages.lhs-boot
@@ -1,4 +1,8 @@
 \begin{code}
 module Packages where
+-- Well, this is kind of stupid...
+import {-# SOURCE #-} Module (PackageKey)
+import {-# SOURCE #-} DynFlags (DynFlags)
 data PackageState
+packageKeyPackageIdString :: DynFlags -> PackageKey -> String
 \end{code}
diff --git a/compiler/main/PlatformConstants.hs b/compiler/main/PlatformConstants.hs
index 03e146ca7c87..b2ca32be6819 100644
--- a/compiler/main/PlatformConstants.hs
+++ b/compiler/main/PlatformConstants.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE CPP #-}
+
 -------------------------------------------------------------------------------
 --
 -- | Platform constants
diff --git a/compiler/main/PprTyThing.hs b/compiler/main/PprTyThing.hs
index 27e739009dca..eed4671b67ac 100644
--- a/compiler/main/PprTyThing.hs
+++ b/compiler/main/PprTyThing.hs
@@ -6,67 +6,90 @@
 --
 -----------------------------------------------------------------------------
 
-{-# OPTIONS -fno-warn-tabs #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and
--- detab the module (please do the detabbing in a separate patch). See
---     http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
--- for details
-
+{-# LANGUAGE CPP #-}
 module PprTyThing (
-	pprTyThing,
-	pprTyThingInContext,
-	pprTyThingLoc,
-	pprTyThingInContextLoc,
-	pprTyThingHdr,
-  	pprTypeForUser
+        pprTyThing,
+        pprTyThingInContext,
+        pprTyThingLoc,
+        pprTyThingInContextLoc,
+        pprTyThingHdr,
+        pprTypeForUser,
+        pprFamInst
   ) where
 
+#include "HsVersions.h"
+
 import TypeRep ( TyThing(..) )
-import ConLike
-import DataCon
-import PatSyn
-import Id
-import TyCon
-import Class
-import Coercion( pprCoAxiom, pprCoAxBranch )
-import CoAxiom( CoAxiom(..), brListMap )
+import CoAxiom ( coAxiomTyCon )
 import HscTypes( tyThingParent_maybe )
-import HsBinds( pprPatSynSig )
-import Type( tidyTopType, tidyOpenType, splitForAllTys, funResultTy )
-import Kind( synTyConResKind )
-import TypeRep( pprTvBndrs, pprForAll, suppressKinds )
-import TysPrim( alphaTyVars )
+import MkIface ( tyThingToIfaceDecl )
+import Type ( tidyOpenType )
+import IfaceSyn ( pprIfaceDecl, ShowSub(..), ShowHowMuch(..) )
+import FamInstEnv( FamInst( .. ), FamFlavor(..) )
 import TcType
 import Name
 import VarEnv( emptyTidyEnv )
-import StaticFlags( opt_PprStyle_Debug )
-import DynFlags
 import Outputable
 import FastString
-import Data.Maybe
 
 -- -----------------------------------------------------------------------------
 -- Pretty-printing entities that we get from the GHC API
 
--- This should be a good source of sample code for using the GHC API to
--- inspect source code entities.
-
-type ShowSub = [Name]
---   []     <=> print all sub-components of the current thing
---   (n:ns) <=> print sub-component 'n' with ShowSub=ns
---              elide other sub-components to "..."
-showAll :: ShowSub
-showAll = []
+{-  Note [Pretty-printing TyThings]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+We pretty-print a TyThing by converting it to an IfaceDecl,
+and pretty-printing that (see ppr_ty_thing below).
+Here is why:
+
+* When pretty-printing (a type, say), the idiomatic solution is not to
+  "rename type variables on the fly", but rather to "tidy" the type
+  (which gives each variable a distinct print-name), and then
+  pretty-print it (without renaming). Separate the two
+  concerns. Functions like tidyType do this.
+
+* Alas, for type constructors, TyCon, tidying does not work well,
+  because a TyCon includes DataCons which include Types, which mention
+  TyCons. And tidying can't tidy a mutually recursive data structure
+  graph, only trees.
+
+* One alternative would be to ensure that TyCons get type variables
+  with distinct print-names. That's ok for type variables but less
+  easy for kind variables. Processing data type declarations is
+  already so complicated that I don't think it's sensible to add the
+  extra requirement that it generates only "pretty" types and kinds.
+
+*  One place the non-pretty names can show up is in GHCi. But another
+   is in interface files. Look at MkIface.tyThingToIfaceDecl which
+   converts a TyThing (i.e. TyCon, Class etc) to an IfaceDecl. And it
+   already does tidying as part of that conversion!  Why? Because
+   interface files contains fast-strings, not uniques, so the names
+   must at least be distinct.
+
+So if we convert to IfaceDecl, we get a nice tidy IfaceDecl, and can
+print that.  Of course, that means that pretty-printing IfaceDecls
+must be careful to display nice user-friendly results, but that's ok.
+
+See #7730, #8776 for details   -}
+
+--------------------
+-- | Pretty-prints a 'FamInst' (type/data family instance) with its defining location.
+pprFamInst :: FamInst -> SDoc
+--  * For data instances we go via pprTyThing of the represntational TyCon,
+--    because there is already much cleverness associated with printing
+--    data type declarations that I don't want to duplicate
+--  * For type instances we print directly here; there is no TyCon
+--    to give to pprTyThing
+--
+-- FamInstEnv.pprFamInst does a more quick-and-dirty job for internal purposes
 
-showSub :: NamedThing n => ShowSub -> n -> Bool
-showSub []    _     = True
-showSub (n:_) thing = n == getName thing
+pprFamInst (FamInst { fi_flavor = DataFamilyInst rep_tc })
+  = pprTyThingInContextLoc (ATyCon rep_tc)
 
-showSub_maybe :: NamedThing n => ShowSub -> n -> Maybe ShowSub
-showSub_maybe []     _     = Just []
-showSub_maybe (n:ns) thing = if n == getName thing then Just ns
-                                                   else Nothing
+pprFamInst (FamInst { fi_flavor = SynFamilyInst, fi_axiom = axiom
+                    , fi_tys = lhs_tys, fi_rhs = rhs })
+  = showWithLoc (pprDefinedAt (getName axiom)) $
+    hang (ptext (sLit "type instance") <+> pprTypeApp (coAxiomTyCon axiom) lhs_tys)
+       2 (equals <+> ppr rhs)
 
 ----------------------------
 -- | Pretty-prints a 'TyThing' with its defining location.
@@ -76,7 +99,13 @@ pprTyThingLoc tyThing
 
 -- | Pretty-prints a 'TyThing'.
 pprTyThing :: TyThing -> SDoc
-pprTyThing thing = ppr_ty_thing showAll thing
+pprTyThing = ppr_ty_thing False []
+
+-- | Pretty-prints the 'TyThing' header. For functions and data constructors
+-- the function is equivalent to 'pprTyThing' but for type constructors
+-- and classes it prints only the header part of the declaration.
+pprTyThingHdr :: TyThing -> SDoc
+pprTyThingHdr = ppr_ty_thing True []
 
 -- | Pretty-prints a 'TyThing' in context: that is, if the entity
 -- is a data constructor, record selector, or class method, then
@@ -87,8 +116,8 @@ pprTyThingInContext thing
   = go [] thing
   where
     go ss thing = case tyThingParent_maybe thing of
-                    Just parent -> go (getName thing : ss) parent
-                    Nothing     -> ppr_ty_thing ss thing
+                    Just parent -> go (getOccName thing : ss) parent
+                    Nothing     -> ppr_ty_thing False ss thing
 
 -- | Like 'pprTyThingInContext', but adds the defining location.
 pprTyThingInContextLoc :: TyThing -> SDoc
@@ -96,280 +125,49 @@ pprTyThingInContextLoc tyThing
   = showWithLoc (pprDefinedAt (getName tyThing))
                 (pprTyThingInContext tyThing)
 
--- | Pretty-prints the 'TyThing' header. For functions and data constructors
--- the function is equivalent to 'pprTyThing' but for type constructors
--- and classes it prints only the header part of the declaration.
-pprTyThingHdr :: TyThing -> SDoc
-pprTyThingHdr (AnId id)          = pprId         id
-pprTyThingHdr (AConLike conLike) = case conLike of
-    RealDataCon dataCon -> pprDataConSig dataCon
-    PatSynCon patSyn    -> pprPatSyn     patSyn
-pprTyThingHdr (ATyCon tyCon)     = pprTyConHdr   tyCon
-pprTyThingHdr (ACoAxiom ax)      = pprCoAxiom ax
-
 ------------------------
-ppr_ty_thing :: ShowSub -> TyThing -> SDoc
-ppr_ty_thing _  (AnId id)          = pprId         id
-ppr_ty_thing _  (AConLike conLike) = case conLike of
-    RealDataCon dataCon -> pprDataConSig dataCon
-    PatSynCon patSyn    -> pprPatSyn     patSyn
-ppr_ty_thing ss (ATyCon tyCon)     = pprTyCon      ss tyCon
-ppr_ty_thing _  (ACoAxiom ax)      = pprCoAxiom    ax
-
-pprTyConHdr :: TyCon -> SDoc
-pprTyConHdr tyCon
-  | Just (fam_tc, tys) <- tyConFamInst_maybe tyCon
-  = ptext keyword <+> ptext (sLit "instance") <+> pprTypeApp fam_tc tys
-  | Just cls <- tyConClass_maybe tyCon
-  = pprClassHdr cls
-  | otherwise
-  = sdocWithDynFlags $ \dflags ->
-    ptext keyword <+> opt_family <+> opt_stupid <+> ppr_bndr tyCon
-    <+> pprTvBndrs (suppressKinds dflags (tyConKind tyCon) vars)
-  where
-    vars | isPrimTyCon tyCon ||
-	   isFunTyCon tyCon = take (tyConArity tyCon) alphaTyVars
-	 | otherwise = tyConTyVars tyCon
-
-    keyword | isSynTyCon tyCon = sLit "type"
-            | isNewTyCon tyCon = sLit "newtype"
-            | otherwise            = sLit "data"
-
-    opt_family
-      | isFamilyTyCon tyCon = ptext (sLit "family")
-      | otherwise             = empty
-
-    opt_stupid 	-- The "stupid theta" part of the declaration
-	| isAlgTyCon tyCon = pprThetaArrowTy (tyConStupidTheta tyCon)
-	| otherwise	   = empty	-- Returns 'empty' if null theta
-
-pprDataConSig :: DataCon -> SDoc
-pprDataConSig dataCon
-  = ppr_bndr dataCon <+> dcolon <+> pprTypeForUser (dataConUserType dataCon)
-
-pprClassHdr :: Class -> SDoc
-pprClassHdr cls
-  = sdocWithDynFlags $ \dflags ->
-    ptext (sLit "class") <+>
-    sep [ pprThetaArrowTy (classSCTheta cls)
-        , ppr_bndr cls
-          <+> pprTvBndrs (suppressKinds dflags (tyConKind (classTyCon cls)) tvs)
-        , pprFundeps funDeps ]
+ppr_ty_thing :: Bool -> [OccName] -> TyThing -> SDoc
+-- We pretty-print 'TyThing' via 'IfaceDecl'
+-- See Note [Pretty-pringint TyThings]
+ppr_ty_thing hdr_only path ty_thing
+  = pprIfaceDecl ss (tyThingToIfaceDecl ty_thing)
   where
-     (tvs, funDeps) = classTvsFds cls
-
-pprId :: Var -> SDoc
-pprId ident
-  = hang (ppr_bndr ident <+> dcolon)
-	 2 (pprTypeForUser (idType ident))
-
-pprPatSyn :: PatSyn -> SDoc
-pprPatSyn patSyn
-  = pprPatSynSig ident is_bidir args (pprTypeForUser rhs_ty) prov req
-  where
-    ident = patSynId patSyn
-    is_bidir = isJust $ patSynWrapper patSyn
-
-    args = fmap pprParendType (patSynTyDetails patSyn)
-    prov = pprThetaOpt prov_theta
-    req = pprThetaOpt req_theta
-
-    pprThetaOpt [] = Nothing
-    pprThetaOpt theta = Just $ pprTheta theta
-
-    (_univ_tvs, _ex_tvs, (prov_theta, req_theta)) = patSynSig patSyn
-    rhs_ty = patSynType patSyn
+    ss = ShowSub { ss_how_much = how_much, ss_ppr_bndr = ppr_bndr }
+    how_much | hdr_only  = ShowHeader
+             | otherwise = ShowSome path
+    name    = getName ty_thing
+    ppr_bndr :: OccName -> SDoc
+    ppr_bndr | isBuiltInSyntax name
+             = ppr
+             | otherwise
+             = case nameModule_maybe name of
+                 Just mod -> \ occ -> getPprStyle $ \sty ->
+                                      pprModulePrefix sty mod occ <> ppr occ
+                 Nothing  -> WARN( True, ppr name ) ppr
+                 -- Nothing is unexpected here; TyThings have External names
 
 pprTypeForUser :: Type -> SDoc
 -- We do two things here.
 -- a) We tidy the type, regardless
--- b) If Opt_PrintExplicitForAlls is True, we discard the foralls
--- 	but we do so `deeply'
+-- b) Swizzle the foralls to the top, so that without
+--    -fprint-explicit-foralls we'll suppress all the foralls
 -- Prime example: a class op might have type
---	forall a. C a => forall b. Ord b => stuff
+--      forall a. C a => forall b. Ord b => stuff
 -- Then we want to display
---	(C a, Ord b) => stuff
+--      (C a, Ord b) => stuff
 pprTypeForUser ty
-  = sdocWithDynFlags $ \ dflags ->
-    if gopt Opt_PrintExplicitForalls dflags
-    then ppr tidy_ty
-    else ppr (mkPhiTy ctxt ty')
+  = pprSigmaType (mkSigmaTy tvs ctxt tau)
   where
-    (_, ctxt, ty') = tcSplitSigmaTy tidy_ty
-    (_, tidy_ty)   = tidyOpenType emptyTidyEnv ty
+    (tvs, ctxt, tau) = tcSplitSigmaTy tidy_ty
+    (_, tidy_ty)     = tidyOpenType emptyTidyEnv ty
      -- Often the types/kinds we print in ghci are fully generalised
      -- and have no free variables, but it turns out that we sometimes
      -- print un-generalised kinds (eg when doing :k T), so it's
      -- better to use tidyOpenType here
 
-pprTyCon :: ShowSub -> TyCon -> SDoc
-pprTyCon ss tyCon
-  | Just syn_rhs <- synTyConRhs_maybe tyCon
-  = case syn_rhs of
-      OpenSynFamilyTyCon    -> pp_tc_with_kind
-      BuiltInSynFamTyCon {} -> pp_tc_with_kind
-
-      ClosedSynFamilyTyCon (CoAxiom { co_ax_branches = branches })
-         -> hang closed_family_header
-              2  (vcat (brListMap (pprCoAxBranch tyCon) branches))
-
-      AbstractClosedSynFamilyTyCon
-         -> closed_family_header <+> ptext (sLit "..")
-
-      SynonymTyCon rhs_ty
-         -> hang (pprTyConHdr tyCon <+> equals)
-               2 (ppr rhs_ty)   -- Don't suppress foralls on RHS type!
-
-                                                 -- e.g. type T = forall a. a->a
-  | Just cls <- tyConClass_maybe tyCon
-  = (pp_roles (== Nominal)) $$ pprClass ss cls
-
-  | otherwise
-  = (pp_roles (== Representational)) $$ pprAlgTyCon ss tyCon
-
-  where
-      -- if, for each role, suppress_if role is True, then suppress the role
-      -- output
-    pp_roles :: (Role -> Bool) -> SDoc
-    pp_roles suppress_if
-      = sdocWithDynFlags $ \dflags ->
-        let roles = suppressKinds dflags (tyConKind tyCon) (tyConRoles tyCon)
-        in ppUnless (isFamInstTyCon tyCon || all suppress_if roles) $
-             -- Don't display roles for data family instances (yet)
-             -- See discussion on Trac #8672.
-           ptext (sLit "type role") <+> ppr tyCon <+> hsep (map ppr roles)
-
-    pp_tc_with_kind = vcat [ pp_roles (const True)
-                           , pprTyConHdr tyCon <+> dcolon
-                             <+> pprTypeForUser (synTyConResKind tyCon) ]
-    closed_family_header
-       = pp_tc_with_kind <+> ptext (sLit "where")
-
-pprAlgTyCon :: ShowSub -> TyCon -> SDoc
-pprAlgTyCon ss tyCon
-  | gadt      = pprTyConHdr tyCon <+> ptext (sLit "where") $$
-		   nest 2 (vcat (ppr_trim (map show_con datacons)))
-  | otherwise = hang (pprTyConHdr tyCon)
-    		   2 (add_bars (ppr_trim (map show_con datacons)))
-  where
-    datacons = tyConDataCons tyCon
-    gadt = any (not . isVanillaDataCon) datacons
-
-    ok_con dc = showSub ss dc || any (showSub ss) (dataConFieldLabels dc)
-    show_con dc
-      | ok_con dc = Just (pprDataConDecl ss gadt dc)
-      | otherwise = Nothing
-
-pprDataConDecl :: ShowSub -> Bool -> DataCon -> SDoc
-pprDataConDecl ss gadt_style dataCon
-  | not gadt_style = ppr_fields tys_w_strs
-  | otherwise      = ppr_bndr dataCon <+> dcolon <+>
-			sep [ pp_foralls, pprThetaArrowTy theta, pp_tau ]
-	-- Printing out the dataCon as a type signature, in GADT style
-  where
-    (forall_tvs, theta, tau) = tcSplitSigmaTy (dataConUserType dataCon)
-    (arg_tys, res_ty)        = tcSplitFunTys tau
-    labels     = dataConFieldLabels dataCon
-    stricts    = dataConStrictMarks dataCon
-    tys_w_strs = zip (map user_ify stricts) arg_tys
-    pp_foralls = sdocWithDynFlags $ \dflags ->
-                 ppWhen (gopt Opt_PrintExplicitForalls dflags)
-                        (pprForAll forall_tvs)
-
-    pp_tau = foldr add (ppr res_ty) tys_w_strs
-    add str_ty pp_ty = pprParendBangTy str_ty <+> arrow <+> pp_ty
-
-    pprParendBangTy (bang,ty) = ppr bang <> pprParendType ty
-    pprBangTy       (bang,ty) = ppr bang <> ppr ty
-
-    -- See Note [Printing bangs on data constructors]
-    user_ify :: HsBang -> HsBang
-    user_ify bang | opt_PprStyle_Debug = bang
-    user_ify HsStrict                  = HsUserBang Nothing     True
-    user_ify (HsUnpack {})             = HsUserBang (Just True) True
-    user_ify bang                      = bang
-
-    maybe_show_label (lbl,bty)
-	| showSub ss lbl = Just (ppr_bndr lbl <+> dcolon <+> pprBangTy bty)
-	| otherwise      = Nothing
-
-    ppr_fields [ty1, ty2]
-	| dataConIsInfix dataCon && null labels
-	= sep [pprParendBangTy ty1, pprInfixName dataCon, pprParendBangTy ty2]
-    ppr_fields fields
-	| null labels
-	= ppr_bndr dataCon <+> sep (map pprParendBangTy fields)
-	| otherwise
-	= ppr_bndr dataCon
-	  <+> (braces $ sep $ punctuate comma $ ppr_trim $
-               map maybe_show_label (zip labels fields))
-
-pprClass :: ShowSub -> Class -> SDoc
-pprClass ss cls
-  | null methods && null assoc_ts
-  = pprClassHdr cls
-  | otherwise
-  = vcat [ pprClassHdr cls <+> ptext (sLit "where")
-         , nest 2 (vcat $ ppr_trim $ 
-                   map show_at assoc_ts ++ map show_meth methods)]
-  where
-    methods  = classMethods cls
-    assoc_ts = classATs cls
-    show_meth id | showSub ss id  = Just (pprClassMethod id)
-	         | otherwise      = Nothing
-    show_at tc = case showSub_maybe ss tc of
-                      Just ss' -> Just (pprTyCon ss' tc)
-                      Nothing  -> Nothing
-
-pprClassMethod :: Id -> SDoc
-pprClassMethod id
-  = hang (ppr_bndr id <+> dcolon) 2 (pprTypeForUser op_ty)
-  where
-  -- Here's the magic incantation to strip off the dictionary
-  -- from the class op type.  Stolen from IfaceSyn.tyThingToIfaceDecl.
-  --
-  -- It's important to tidy it *before* splitting it up, so that if
-  -- we have	class C a b where
-  --	          op :: forall a. a -> b
-  -- then the inner forall on op gets renamed to a1, and we print
-  -- (when dropping foralls)
-  --		class C a b where
-  --		  op :: a1 -> b
-
-  tidy_sel_ty = tidyTopType (idType id)
-  (_sel_tyvars, rho_ty) = splitForAllTys tidy_sel_ty
-  op_ty = funResultTy rho_ty
-
-ppr_trim :: [Maybe SDoc] -> [SDoc]
--- Collapse a group of Nothings to a single "..."
-ppr_trim xs
-  = snd (foldr go (False, []) xs)
-  where
-    go (Just doc) (_,     so_far) = (False, doc : so_far)
-    go Nothing    (True,  so_far) = (True, so_far)
-    go Nothing    (False, so_far) = (True, ptext (sLit "...") : so_far)
-
-add_bars :: [SDoc] -> SDoc
-add_bars []      = empty
-add_bars [c]     = equals <+> c
-add_bars (c:cs)  = sep ((equals <+> c) : map (char '|' <+>) cs)
-
--- Wrap operators in ()
-ppr_bndr :: NamedThing a => a -> SDoc
-ppr_bndr a = parenSymOcc (getOccName a) (ppr (getName a))
-
 showWithLoc :: SDoc -> SDoc -> SDoc
 showWithLoc loc doc
     = hang doc 2 (char '\t' <> comment <+> loc)
-		-- The tab tries to make them line up a bit
+                -- The tab tries to make them line up a bit
   where
     comment = ptext (sLit "--")
-
-{-
-Note [Printing bangs on data constructors]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-For imported data constructors the dataConStrictMarks are the
-representation choices (see Note [Bangs on data constructor arguments]
-in DataCon.lhs). So we have to fiddle a little bit here to turn them
-back into user-printable form.
--}
diff --git a/compiler/main/StaticFlags.hs b/compiler/main/StaticFlags.hs
index 01dc3b7275ea..eb7ede00c6c2 100644
--- a/compiler/main/StaticFlags.hs
+++ b/compiler/main/StaticFlags.hs
@@ -1,4 +1,5 @@
-{-# OPTIONS -fno-cse #-}
+{-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -fno-cse #-}
 -- -fno-cse is needed for GLOBAL_VAR's to behave properly
 
 -----------------------------------------------------------------------------
diff --git a/compiler/main/SysTools.lhs b/compiler/main/SysTools.lhs
index 2150c6d59482..72fa19b3cca4 100644
--- a/compiler/main/SysTools.lhs
+++ b/compiler/main/SysTools.lhs
@@ -7,6 +7,8 @@
 -----------------------------------------------------------------------------
 
 \begin{code}
+{-# LANGUAGE CPP, ScopedTypeVariables #-}
+
 module SysTools (
         -- Initialisation
         initSysTools,
@@ -233,6 +235,8 @@ initSysTools mbMinusB
        -- to make that possible, so for now you can't.
        gcc_prog <- getSetting "C compiler command"
        gcc_args_str <- getSetting "C compiler flags"
+       cpp_prog <- getSetting "Haskell CPP command"
+       cpp_args_str <- getSetting "Haskell CPP flags"
        let unreg_gcc_args = if targetUnregisterised
                             then ["-DNO_REGS", "-DUSE_MINIINTERPRETER"]
                             else []
@@ -241,6 +245,7 @@ initSysTools mbMinusB
             | mkTablesNextToCode targetUnregisterised
                = ["-DTABLES_NEXT_TO_CODE"]
             | otherwise = []
+           cpp_args= map Option (words cpp_args_str)
            gcc_args = map Option (words gcc_args_str
                                ++ unreg_gcc_args
                                ++ tntc_gcc_args)
@@ -283,10 +288,7 @@ initSysTools mbMinusB
        -- 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_prog  = gcc_prog
-           cpp_args  = Option "-E"
-                     : map Option (words cRAWCPP_FLAGS)
-                    ++ gcc_args
+
 
        -- Other things being equal, as and ld are simply gcc
        gcc_link_args_str <- getSetting "C compiler link flags"
@@ -602,6 +604,42 @@ figureLlvmVersion dflags = do
                 return Nothing)
   return ver
 
+{- Note [Windows stack usage]
+
+See: Trac #8870 (and #8834 for related info)
+
+On Windows, occasionally we need to grow the stack. In order to do
+this, we would normally just bump the stack pointer - but there's a
+catch on Windows.
+
+If the stack pointer is bumped by more than a single page, then the
+pages between the initial pointer and the resulting location must be
+properly committed by the Windows virtual memory subsystem. This is
+only needed in the event we bump by more than one page (i.e 4097 bytes
+or more).
+
+Windows compilers solve this by emitting a call to a special function
+called _chkstk, which does this committing of the pages for you.
+
+The reason this was causing a segfault was because due to the fact the
+new code generator tends to generate larger functions, we needed more
+stack space in GHC itself. In the x86 codegen, we needed approximately
+~12kb of stack space in one go, which caused the process to segfault,
+as the intervening pages were not committed.
+
+In the future, we should do the same thing, to make the problem
+completely go away. In the mean time, we're using a workaround: we
+instruct the linker to specify the generated PE as having an initial
+reserved stack size of 8mb, as well as a initial *committed* stack
+size of 8mb. The default committed size was previously only 4k.
+
+Theoretically it's possible to still hit this problem if you request a
+stack bump of more than 8mb in one go. But the amount of code
+necessary is quite large, and 8mb "should be more than enough for
+anyone" right now (he said, before millions of lines of code cried out
+in terror).
+
+-}
 
 {- Note [Run-time linker info]
 
@@ -691,15 +729,20 @@ getLinkerInfo' dflags = do
                  -- that doesn't support --version. We can just assume that's
                  -- what we're using.
                  return $ DarwinLD []
-               OSiOS -> 
+               OSiOS ->
                  -- Ditto for iOS
                  return $ DarwinLD []
                OSMinGW32 ->
                  -- GHC doesn't support anything but GNU ld on Windows anyway.
                  -- Process creation is also fairly expensive on win32, so
                  -- we short-circuit here.
-                 return $ GnuLD $ map Option ["-Wl,--hash-size=31",
-                                              "-Wl,--reduce-memory-overheads"]
+                 return $ GnuLD $ map Option
+                   [ -- Reduce ld memory usage
+                     "-Wl,--hash-size=31"
+                   , "-Wl,--reduce-memory-overheads"
+                     -- Increase default stack, see
+                     -- Note [Windows stack usage]
+                   , "-Xlinker", "--stack=0x800000,0x800000" ]
                _ -> do
                  -- In practice, we use the compiler as the linker here. Pass
                  -- -Wl,--version to get linker version info.
@@ -745,12 +788,15 @@ getCompilerInfo' dflags = do
         -- Regular clang
         | any ("clang version" `isPrefixOf`) stde =
           return Clang
+        -- XCode 5.1 clang
+        | any ("Apple LLVM version 5.1" `isPrefixOf`) stde =
+          return AppleClang51
         -- XCode 5 clang
         | any ("Apple LLVM version" `isPrefixOf`) stde =
-          return Clang
+          return AppleClang
         -- XCode 4.1 clang
         | any ("Apple clang version" `isPrefixOf`) stde =
-          return Clang
+          return AppleClang
          -- Unknown linker.
         | otherwise = fail "invalid -v output, or compiler is unsupported"
 
@@ -763,10 +809,10 @@ getCompilerInfo' dflags = do
             )
             (\err -> do
                 debugTraceMsg dflags 2
-                    (text "Error (figuring out compiler information):" <+>
+                    (text "Error (figuring out C compiler information):" <+>
                      text (show err))
                 errorMsg dflags $ hang (text "Warning:") 9 $
-                  text "Couldn't figure out linker information!" $$
+                  text "Couldn't figure out C compiler information!" $$
                   text "Make sure you're using GNU gcc, or clang"
                 return UnknownCC)
   return info
@@ -779,7 +825,57 @@ runLink dflags args = do
       args1     = map Option (getOpts dflags opt_l)
       args2     = args0 ++ args1 ++ args ++ linkargs
   mb_env <- getGccEnv args2
-  runSomethingFiltered dflags id "Linker" p args2 mb_env
+  runSomethingFiltered dflags ld_filter "Linker" p args2 mb_env
+  where
+    ld_filter = case (platformOS (targetPlatform dflags)) of
+                  OSSolaris2 -> sunos_ld_filter
+                  _ -> id
+{-
+  SunOS/Solaris ld emits harmless warning messages about unresolved
+  symbols in case of compiling into shared library when we do not
+  link against all the required libs. That is the case of GHC which
+  does not link against RTS library explicitly in order to be able to
+  choose the library later based on binary application linking
+  parameters. The warnings look like:
+
+Undefined                       first referenced
+ symbol                             in file
+stg_ap_n_fast                       ./T2386_Lib.o
+stg_upd_frame_info                  ./T2386_Lib.o
+templatezmhaskell_LanguageziHaskellziTHziLib_litE_closure ./T2386_Lib.o
+templatezmhaskell_LanguageziHaskellziTHziLib_appE_closure ./T2386_Lib.o
+templatezmhaskell_LanguageziHaskellziTHziLib_conE_closure ./T2386_Lib.o
+templatezmhaskell_LanguageziHaskellziTHziSyntax_mkNameGzud_closure ./T2386_Lib.o
+newCAF                              ./T2386_Lib.o
+stg_bh_upd_frame_info               ./T2386_Lib.o
+stg_ap_ppp_fast                     ./T2386_Lib.o
+templatezmhaskell_LanguageziHaskellziTHziLib_stringL_closure ./T2386_Lib.o
+stg_ap_p_fast                       ./T2386_Lib.o
+stg_ap_pp_fast                      ./T2386_Lib.o
+ld: warning: symbol referencing errors
+
+  this is actually coming from T2386 testcase. The emitting of those
+  warnings is also a reason why so many TH testcases fail on Solaris.
+
+  Following filter code is SunOS/Solaris linker specific and should
+  filter out only linker warnings. Please note that the logic is a
+  little bit more complex due to the simple reason that we need to preserve
+  any other linker emitted messages. If there are any. Simply speaking
+  if we see "Undefined" and later "ld: warning:..." then we omit all
+  text between (including) the marks. Otherwise we copy the whole output.
+-}
+    sunos_ld_filter :: String -> String
+    sunos_ld_filter = unlines . sunos_ld_filter' . lines
+    sunos_ld_filter' x = if (undefined_found x && ld_warning_found x)
+                         then (ld_prefix x) ++ (ld_postfix x)
+                         else x
+    breakStartsWith x y = break (isPrefixOf x) y
+    ld_prefix = fst . breakStartsWith "Undefined"
+    undefined_found = not . null . snd . breakStartsWith "Undefined"
+    ld_warn_break = breakStartsWith "ld: warning: symbol referencing errors"
+    ld_postfix = tail . snd . ld_warn_break
+    ld_warning_found = not . null . snd . ld_warn_break
+
 
 runLibtool :: DynFlags -> [Option] -> IO ()
 runLibtool dflags args = do
@@ -1270,7 +1366,7 @@ linesPlatform xs =
 
 #endif
 
-linkDynLib :: DynFlags -> [String] -> [PackageId] -> IO ()
+linkDynLib :: DynFlags -> [String] -> [PackageKey] -> IO ()
 linkDynLib dflags0 o_files dep_packages
  = do
     let -- This is a rather ugly hack to fix dynamically linked
@@ -1293,7 +1389,8 @@ linkDynLib dflags0 o_files dep_packages
     let pkg_lib_paths = collectLibraryPaths pkgs
     let pkg_lib_path_opts = concatMap get_pkg_lib_path_opts pkg_lib_paths
         get_pkg_lib_path_opts l
-         | osElfTarget (platformOS (targetPlatform dflags)) &&
+         | ( osElfTarget (platformOS (targetPlatform dflags)) ||
+             osMachOTarget (platformOS (targetPlatform dflags)) ) &&
            dynLibLoader dflags == SystemDependent &&
            not (gopt Opt_Static dflags)
             = ["-L" ++ l, "-Wl,-rpath", "-Wl," ++ l]
@@ -1315,7 +1412,7 @@ linkDynLib dflags0 o_files dep_packages
                       OSMinGW32 ->
                           pkgs
                       _ ->
-                          filter ((/= rtsPackageId) . packageConfigId) pkgs
+                          filter ((/= rtsPackageKey) . packageConfigId) pkgs
     let pkg_link_opts = let (package_hs_libs, extra_libs, other_flags) = collectLinkOpts dflags pkgs_no_rts
                         in  package_hs_libs ++ extra_libs ++ other_flags
 
@@ -1390,9 +1487,7 @@ linkDynLib dflags0 o_files dep_packages
 
             instName <- case dylibInstallName dflags of
                 Just n -> return n
-                Nothing -> do
-                    pwd <- getCurrentDirectory
-                    return $ pwd `combine` output_fn
+                Nothing -> return $ "@rpath" `combine` (takeFileName output_fn)
             runLink dflags (
                     map Option verbFlags
                  ++ [ Option "-dynamiclib"
@@ -1419,7 +1514,7 @@ linkDynLib dflags0 o_files dep_packages
             -------------------------------------------------------------------
 
             let output_fn = case o_file of { Just s -> s; Nothing -> "a.out"; }
-            let buildingRts = thisPackage dflags == rtsPackageId
+            let buildingRts = thisPackage dflags == rtsPackageKey
             let bsymbolicFlag = if buildingRts
                                 then -- -Bsymbolic breaks the way we implement
                                      -- hooks in the RTS
diff --git a/compiler/main/TidyPgm.lhs b/compiler/main/TidyPgm.lhs
index 7ab6d569bcd0..d5ae7110fe8d 100644
--- a/compiler/main/TidyPgm.lhs
+++ b/compiler/main/TidyPgm.lhs
@@ -4,6 +4,8 @@
 \section{Tidying up Core}
 
 \begin{code}
+{-# LANGUAGE BangPatterns, CPP #-}
+
 module TidyPgm (
        mkBootModDetailsTc, tidyProgram, globaliseAndTidyId
    ) where
@@ -21,11 +23,14 @@ import CorePrep
 import CoreUtils
 import Literal
 import Rules
+import PatSyn
+import ConLike
 import CoreArity        ( exprArity, exprBotStrictness_maybe )
 import VarEnv
 import VarSet
 import Var
 import Id
+import MkId             ( mkDictSelRhs )
 import IdInfo
 import InstEnv
 import FamInstEnv
@@ -56,9 +61,15 @@ import FastString
 import qualified ErrUtils as Err
 
 import Control.Monad
+import qualified Data.ByteString.Char8 as BS
 import Data.Function
 import Data.List        ( sortBy )
-import Data.IORef       ( atomicModifyIORef )
+import qualified Data.Map as Map
+import Data.IORef       ( atomicModifyIORef, readIORef )
+import Data.Set         ( elems )
+import System.IO
+import System.FilePath
+import System.Directory
 \end{code}
 
 
@@ -129,18 +140,20 @@ mkBootModDetailsTc hsc_env
         TcGblEnv{ tcg_exports   = exports,
                   tcg_type_env  = type_env, -- just for the Ids
                   tcg_tcs       = tcs,
+                  tcg_patsyns   = pat_syns,
                   tcg_insts     = insts,
                   tcg_fam_insts = fam_insts
                 }
   = do  { let dflags = hsc_dflags hsc_env
         ; showPass dflags CoreTidy
 
-        ; let { insts'     = map (tidyClsInstDFun globaliseAndTidyId) insts
-              ; dfun_ids   = map instanceDFunId insts'
+        ; let { insts'      = map (tidyClsInstDFun globaliseAndTidyId) insts
+              ; pat_syns'   = map (tidyPatSynIds   globaliseAndTidyId) pat_syns
+              ; dfun_ids    = map instanceDFunId insts'
+              ; pat_syn_ids = concatMap patSynIds pat_syns'
               ; type_env1  = mkBootTypeEnv (availsToNameSet exports)
-                                (typeEnvIds type_env) tcs fam_insts
-              ; type_env2  = extendTypeEnvWithPatSyns type_env1 (typeEnvPatSyns type_env)
-              ; type_env'  = extendTypeEnvWithIds type_env2 dfun_ids
+                                           (typeEnvIds type_env) tcs fam_insts
+              ; type_env'  = extendTypeEnvWithIds type_env1 (pat_syn_ids ++ dfun_ids)
               }
         ; return (ModDetails { md_types     = type_env'
                              , md_insts     = insts'
@@ -333,19 +346,13 @@ tidyProgram hsc_env  (ModGuts { mg_module    = mod
 
         ; let { final_ids  = [ id | id <- bindersOfBinds tidy_binds,
                                     isExternalName (idName id)]
-              ; final_patsyns = filter (isExternalName . getName) patsyns
-
-              ; type_env' = extendTypeEnvWithIds type_env final_ids
-              ; type_env'' = extendTypeEnvWithPatSyns type_env' final_patsyns
-
-              ; tidy_type_env = tidyTypeEnv omit_prags type_env''
+              ; type_env1  = extendTypeEnvWithIds type_env final_ids
 
-              ; tidy_insts    = map (tidyClsInstDFun (lookup_dfun tidy_type_env)) insts
-                -- A DFunId will have a binding in tidy_binds, and so
-                -- will now be in final_env, replete with IdInfo
-                -- Its name will be unchanged since it was born, but
-                -- we want Global, IdInfo-rich (or not) DFunId in the
-                -- tidy_insts
+              ; tidy_insts = map (tidyClsInstDFun (lookup_aux_id tidy_type_env)) insts
+                -- A DFunId will have a binding in tidy_binds, and so will now be in
+                -- tidy_type_env, replete with IdInfo.  Its name will be unchanged since
+                -- it was born, but we want Global, IdInfo-rich (or not) DFunId in the
+                -- tidy_insts.  Similarly the Ids inside a PatSyn.
 
               ; tidy_rules = tidyRules tidy_env ext_rules
                 -- You might worry that the tidy_env contains IdInfo-rich stuff
@@ -354,6 +361,16 @@ tidyProgram hsc_env  (ModGuts { mg_module    = mod
 
               ; tidy_vect_info = tidyVectInfo tidy_env vect_info
 
+                -- Tidy the Ids inside each PatSyn, very similarly to DFunIds
+                -- and then override the PatSyns in the type_env with the new tidy ones
+                -- This is really the only reason we keep mg_patsyns at all; otherwise
+                -- they could just stay in type_env
+              ; tidy_patsyns = map (tidyPatSynIds (lookup_aux_id tidy_type_env)) patsyns
+              ; type_env2    = extendTypeEnvList type_env1
+                                    [AConLike (PatSynCon ps) | ps <- tidy_patsyns ]
+
+              ; tidy_type_env = tidyTypeEnv omit_prags type_env2
+
               -- See Note [Injecting implicit bindings]
               ; all_tidy_binds = implicit_binds ++ tidy_binds
 
@@ -377,6 +394,13 @@ tidyProgram hsc_env  (ModGuts { mg_module    = mod
               (showSDoc dflags (ppr CoreTidy <+> ptext (sLit "rules")))
               (pprRulesForUser tidy_rules)
 
+           -- When dumping to files, we might have markers in there
+           -- that we ought to convert into annotations of the Core tree
+           -- so debug info can refer to it.
+        ; final_binds <- if (gopt Opt_DumpToFile dflags)
+                         then extractDumpMarkers dflags all_tidy_binds
+                         else return all_tidy_binds
+
           -- Print one-line size info
         ; let cs = coreBindsStats tidy_binds
         ; when (dopt Opt_D_dump_core_stats dflags)
@@ -389,7 +413,7 @@ tidyProgram hsc_env  (ModGuts { mg_module    = mod
 
         ; return (CgGuts { cg_module   = mod,
                            cg_tycons   = alg_tycons,
-                           cg_binds    = all_tidy_binds,
+                           cg_binds    = final_binds,
                            cg_foreign  = foreign_stubs,
                            cg_dep_pkgs = map fst $ dep_pkgs deps,
                            cg_hpc_info = hpc_info,
@@ -405,11 +429,11 @@ tidyProgram hsc_env  (ModGuts { mg_module    = mod
                               })
         }
 
-lookup_dfun :: TypeEnv -> Var -> Id
-lookup_dfun type_env dfun_id
-  = case lookupTypeEnv type_env (idName dfun_id) of
-        Just (AnId dfun_id') -> dfun_id'
-        _other -> pprPanic "lookup_dfun" (ppr dfun_id)
+lookup_aux_id :: TypeEnv -> Var -> Id
+lookup_aux_id type_env id
+  = case lookupTypeEnv type_env (idName id) of
+        Just (AnId id') -> id'
+        _other          -> pprPanic "lookup_axu_id" (ppr id)
 
 --------------------------
 tidyTypeEnv :: Bool       -- Compiling without -O, so omit prags
@@ -517,7 +541,7 @@ of exceptions, and finally I gave up the battle:
 
 Note [Injecting implicit bindings]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-We inject the implict bindings right at the end, in CoreTidy.
+We inject the implicit bindings right at the end, in CoreTidy.
 Some of these bindings, notably record selectors, are not
 constructed in an optimised form.  E.g. record selector for
         data T = MkT { x :: {-# UNPACK #-} !Int }
@@ -559,14 +583,16 @@ Oh: two other reasons for injecting them late:
 There is one sort of implicit binding that is injected still later,
 namely those for data constructor workers. Reason (I think): it's
 really just a code generation trick.... binding itself makes no sense.
-See CorePrep Note [Data constructor workers].
+See Note [Data constructor workers] in CorePrep.
 
 \begin{code}
 getTyConImplicitBinds :: TyCon -> [CoreBind]
-getTyConImplicitBinds tc = map get_defn (mapCatMaybes dataConWrapId_maybe (tyConDataCons tc))
+getTyConImplicitBinds tc = map get_defn (mapMaybe dataConWrapId_maybe (tyConDataCons tc))
 
 getClassImplicitBinds :: Class -> [CoreBind]
-getClassImplicitBinds cls = map get_defn (classAllSelIds cls)
+getClassImplicitBinds cls
+  = [ NonRec op (mkDictSelRhs cls val_index)
+    | (op, val_index) <- classAllSelIds cls `zip` [0..] ]
 
 get_defn :: Id -> CoreBind
 get_defn id = NonRec id (unfoldingTemplate (realIdUnfolding id))
@@ -1006,7 +1032,7 @@ tidyTopBinds hsc_env this_mod unfold_env init_occ_env binds
 
 ------------------------
 tidyTopBind  :: DynFlags
-             -> PackageId
+             -> PackageKey
              -> Module
              -> Id
              -> UnfoldEnv
@@ -1176,7 +1202,7 @@ it as a CAF.  In these cases however, we would need to use an additional
 CAF list to keep track of non-collectable CAFs.
 
 \begin{code}
-hasCafRefs :: DynFlags -> PackageId -> Module
+hasCafRefs :: DynFlags -> PackageKey -> Module
            -> (Id, VarEnv Var) -> Arity -> CoreExpr
            -> CafInfo
 hasCafRefs dflags this_pkg this_mod p arity expr
@@ -1225,6 +1251,87 @@ cafRefsV (_, p) id
 fastOr :: FastBool -> (a -> FastBool) -> a -> FastBool
 -- hack for lazy-or over FastBool.
 fastOr a f x = fastBool (isFastTrue a || isFastTrue (f x))
+
+--------------------------
+
+extractDumpMarkers :: DynFlags -> CoreProgram -> IO CoreProgram
+extractDumpMarkers dflags binds = do
+  dumps <- readIORef $ generatedDumps dflags
+  let extract binds file = do
+        marks <- extractDumpMarkersFile file
+        return $ map (annotateMarkers dflags marks file) binds
+  foldlM extract binds (elems dumps)
+
+extractDumpMarkersFile :: FilePath -> IO (Map.Map String Int)
+extractDumpMarkersFile dumpFile = do
+  (tmpFile, hout) <- openTempFile (takeDirectory dumpFile) (takeFileName dumpFile)
+
+  -- Open dump file, extract the markers
+  hin <- openFile dumpFile ReadMode
+  let extractMarkers n marks = do
+        end <- hIsEOF hin
+        if end then return marks else do
+          line <- BS.hGetLine hin
+          marks' <- extractMarksLine line n marks
+          hPutChar hout '\n'
+          extractMarkers (n+1) marks'
+      markStart = BS.pack "ann<#"
+      markEnd = BS.pack "#>"
+      extractMarksLine line n marks = do
+        -- Look for annotation start, output everything up to that point
+        let (pre,match) = BS.breakSubstring markStart line
+        BS.hPutStr hout pre
+        case () of
+          _ | BS.null match  -> return marks
+                -- If the marker is within a quote, we jump over
+                -- it. This is really more a band-aid, as it's just
+                -- fixing one of the more obvious problems we might
+                -- run into trying to naively "parse" an undefined
+                -- format like this.
+            | openQuotes pre -> case BS.break (== '"') match of
+                (quoted, rest)
+                  | BS.null rest -> BS.hPutStrLn hout quoted >> return marks
+                  | otherwise    -> do BS.hPutStr hout quoted
+                                       hPutChar hout '"'
+                                       extractMarksLine (BS.tail rest) n marks
+            | (body, rest) <- BS.breakSubstring markEnd (BS.drop (BS.length markStart) match) ->
+                let !marks' = Map.insert (BS.unpack body) n marks
+                in extractMarksLine (BS.drop (BS.length markEnd) rest) n marks'
+      openQuotes = BS.foldr' (\x -> if x == '"' then not else id) False
+  marks <- extractMarkers 1 Map.empty
+
+  -- Close files, replace old file with stripped one
+  hClose hin
+  hClose hout
+  renameFile tmpFile dumpFile
+  return $! marks
+
+annotateMarkers :: DynFlags -> Map.Map String Int -> FilePath -> CoreBind -> CoreBind
+annotateMarkers dflags marks file = annotBind
+  where annotBind (NonRec b e)    = NonRec b $ annot b $ annotExpr e
+        annotBind (Rec bs)        = Rec $ map (\(b, e) -> (b, annot b $ annotExpr e)) bs
+
+        annotExpr (App e1 e2)     = App (annotExpr e1) (annotExpr e2)
+        annotExpr (Lam b e)       = Lam b $ annot b $ annotExpr e
+        annotExpr (Let bs e)      = Let (annotBind bs) (annotExpr e)
+        annotExpr (Case e b t as) = Case (annotExpr e) b t $ map (annotAlt b) as
+        annotExpr (Cast e c)      = Cast (annotExpr e) c
+        annotExpr (Tick t e)      = Tick t (annotExpr e)
+        annotExpr other           = other
+
+        annotAlt b (con, bs, e)   = (con, bs, annot (b, con) $ annotExpr e)
+
+        fileFS = mkFastString file
+        mkSpan n = realSrcLocSpan (mkRealSrcLoc fileFS n 1)
+
+        annot name expr =
+          let nameStr = showSDocDump dflags (ppr name)
+          in case Map.lookup nameStr marks of
+            Just n  -> let ann (Lam b e) = Lam b (ann e)
+                           ann other     = Tick (SourceNote (mkSpan n) nameStr) other
+                        in ann expr
+            Nothing -> expr
+
 \end{code}
 
 
diff --git a/compiler/nativeGen/AsmCodeGen.lhs b/compiler/nativeGen/AsmCodeGen.lhs
index caae4b14093b..b1f12f5e051f 100644
--- a/compiler/nativeGen/AsmCodeGen.lhs
+++ b/compiler/nativeGen/AsmCodeGen.lhs
@@ -7,7 +7,8 @@
 -- -----------------------------------------------------------------------------
 
 \begin{code}
-{-# LANGUAGE GADTs #-}
+{-# LANGUAGE BangPatterns, CPP, GADTs, ScopedTypeVariables, UnboxedTuples #-}
+
 module AsmCodeGen ( nativeCodeGen ) where
 
 #include "HsVersions.h"
@@ -47,6 +48,8 @@ import Instruction
 import PIC
 import Reg
 import NCGMonad
+import Dwarf
+import Debug
 
 import BlockId
 import CgUtils          ( fixStgRegisters )
@@ -152,20 +155,21 @@ data NcgImpl statics instr jumpDest = NcgImpl {
     }
 
 --------------------
-nativeCodeGen :: DynFlags -> Module -> Handle -> UniqSupply
+nativeCodeGen :: DynFlags -> Module -> ModLocation -> Handle -> UniqSupply
               -> Stream IO RawCmmGroup ()
               -> IO UniqSupply
-nativeCodeGen dflags this_mod h us cmms
+nativeCodeGen dflags this_mod modLoc h us cmms
  = let platform = targetPlatform dflags
        nCG' :: (Outputable statics, Outputable instr, Instruction instr)
             => NcgImpl statics instr jumpDest -> IO UniqSupply
-       nCG' ncgImpl = nativeCodeGen' dflags this_mod ncgImpl h us cmms
+       nCG' ncgImpl = nativeCodeGen' dflags this_mod modLoc ncgImpl h us cmms
    in case platformArch platform of
       ArchX86     -> nCG' (x86NcgImpl    dflags)
       ArchX86_64  -> nCG' (x86_64NcgImpl dflags)
       ArchPPC     -> nCG' (ppcNcgImpl    dflags)
       ArchSPARC   -> nCG' (sparcNcgImpl  dflags)
       ArchARM {}  -> panic "nativeCodeGen: No NCG for ARM"
+      ArchARM64   -> panic "nativeCodeGen: No NCG for ARM64"
       ArchPPC_64  -> panic "nativeCodeGen: No NCG for PPC 64"
       ArchAlpha   -> panic "nativeCodeGen: No NCG for Alpha"
       ArchMipseb  -> panic "nativeCodeGen: No NCG for mipseb"
@@ -253,55 +257,48 @@ type NativeGenAcc statics instr
         = ([[CLabel]],
            [([NatCmmDecl statics instr],
              Maybe [Color.RegAllocStats statics instr],
-             Maybe [Linear.RegAllocStats])])
+             Maybe [Linear.RegAllocStats])],
+           [DebugBlock],
+           DwarfFiles)
 
 nativeCodeGen' :: (Outputable statics, Outputable instr, Instruction instr)
                => DynFlags
-               -> Module
+               -> Module -> ModLocation
                -> NcgImpl statics instr jumpDest
                -> Handle
                -> UniqSupply
                -> Stream IO RawCmmGroup ()
                -> IO UniqSupply
-nativeCodeGen' dflags this_mod ncgImpl h us cmms
+nativeCodeGen' dflags this_mod modLoc ncgImpl h us cmms
  = do
-        let split_cmms  = Stream.map add_split cmms
         -- BufHandle is a performance hack.  We could hide it inside
         -- Pretty if it weren't for the fact that we do lots of little
         -- printDocs here (in order to do codegen in constant space).
         bufh <- newBufHandle h
-        (ngs, us') <- cmmNativeGenStream dflags this_mod ncgImpl bufh us split_cmms ([], [])
-        finishNativeGen dflags ncgImpl bufh ngs
-
-        return us'
-
- where  add_split tops
-                | gopt Opt_SplitObjs dflags = split_marker : tops
-                | otherwise                 = tops
-
-        split_marker = CmmProc mapEmpty mkSplitMarkerLabel []
-                               (ofBlockList (panic "split_marker_entry") [])
-
+        (ngs, us') <- cmmNativeGenStream dflags this_mod modLoc ncgImpl bufh us cmms ([], [], [], emptyUFM)
+        finishNativeGen dflags modLoc bufh us' ngs
 
 finishNativeGen :: Instruction instr
                 => DynFlags
-                -> NcgImpl statics instr jumpDest
+                -> ModLocation
                 -> BufHandle
+                -> UniqSupply
                 -> NativeGenAcc statics instr
-                -> IO ()
-finishNativeGen dflags ncgImpl bufh@(BufHandle _ _ h) (imports, prof)
+                -> IO UniqSupply
+finishNativeGen dflags modLoc bufh@(BufHandle _ _ h) us (imports, prof, debugs, _)
  = do
+        -- Write debug data and finish
+        let emitDwarf = gopt Opt_Debug dflags && not (gopt Opt_SplitObjs dflags)
+        us' <- if not emitDwarf then return us else do
+          (dwarf, us') <- dwarfGen dflags modLoc us debugs
+          emitNativeCode dflags bufh dwarf
+          return us'
         bFlush bufh
 
         let platform = targetPlatform dflags
         let (native, colorStats, linearStats)
                 = unzip3 prof
 
-        -- dump native code
-        dumpIfSet_dyn dflags
-                Opt_D_dump_asm "Asm code"
-                (vcat $ map (pprNatCmmDecl ncgImpl) $ concat native)
-
         -- dump global NCG stats for graph coloring allocator
         (case concat $ catMaybes colorStats of
           []    -> return ()
@@ -335,10 +332,11 @@ finishNativeGen dflags ncgImpl bufh@(BufHandle _ _ h) (imports, prof)
         Pretty.printDoc Pretty.LeftMode (pprCols dflags) h
                 $ withPprStyleDoc dflags (mkCodeStyle AsmStyle)
                 $ makeImportsDoc dflags (concat imports)
+        return us'
 
 cmmNativeGenStream :: (Outputable statics, Outputable instr, Instruction instr)
               => DynFlags
-              -> Module
+              -> Module -> ModLocation
               -> NcgImpl statics instr jumpDest
               -> BufHandle
               -> UniqSupply
@@ -346,78 +344,127 @@ cmmNativeGenStream :: (Outputable statics, Outputable instr, Instruction instr)
               -> NativeGenAcc statics instr
               -> IO (NativeGenAcc statics instr, UniqSupply)
 
-cmmNativeGenStream dflags this_mod ncgImpl h us cmm_stream ngs@(impAcc, profAcc)
+cmmNativeGenStream dflags this_mod modLoc ncgImpl h us cmm_stream ngs@(impAcc, profAcc, dbgs, fileIds)
  = do r <- Stream.runStream cmm_stream
       case r of
           Left () ->
-              return ((reverse impAcc, reverse profAcc) , us)
+              return ((reverse impAcc, reverse profAcc, dbgs, fileIds) , us)
           Right (cmms, cmm_stream') -> do
-              (ngs',us') <- cmmNativeGens dflags this_mod ncgImpl h us cmms ngs 0
-              cmmNativeGenStream dflags this_mod ncgImpl h us' cmm_stream' ngs'
+
+              -- Generate debug information
+              let debugFlag = gopt Opt_Debug dflags
+                  ndbgs | debugFlag = cmmDebugGen modLoc cmms
+                        | otherwise = []
+                  dbgMap = debugToMap ndbgs
+
+              -- Insert split marker, generate native code
+              let splitFlag = gopt Opt_SplitObjs dflags
+                  cmms' | splitFlag  = split_marker : cmms
+                        | otherwise  = cmms
+              ((impAcc', profAcc', dbgs', fileIds'), us')
+                 <- cmmNativeGens dflags this_mod modLoc ncgImpl h dbgMap us cmms' ngs 0
+
+              -- Link native code information into debug blocks
+              let nats = map (\(ns, _, _) -> ns) profAcc'
+                  !ldbgs = cmmDebugLink isMetaInstr (concat nats) ndbgs
+              dumpIfSet_dyn dflags Opt_D_dump_debug "Debug Infos" (vcat $ map ppr ldbgs)
+
+              -- Emit & clear DWARF information when generating split
+              -- object files, as we need it to land in the same object file
+              (dbgs'', fileIds'', us'') <-
+                if debugFlag && splitFlag
+                then do (dwarf, us'') <- dwarfGen dflags modLoc us ldbgs
+                        emitNativeCode dflags h dwarf
+                        return ([], emptyUFM, us'')
+                else return (dbgs' ++ ldbgs, fileIds', us')
+
+              -- Strip references to native code unless we want to dump it later
+              let dumpFlag = dopt Opt_D_dump_asm_stats dflags
+                  profAcc'' | dumpFlag  = profAcc'
+                            | otherwise = map (\(_, a, b) -> ([], a, b)) profAcc'
+              seqList profAcc'' $ seqList dbgs'' $
+                cmmNativeGenStream dflags this_mod modLoc ncgImpl h us'' cmm_stream'
+                  (impAcc', profAcc'', dbgs'', fileIds'')
+
+  where split_marker = CmmProc mapEmpty mkSplitMarkerLabel []
+                               (ofBlockList (panic "split_marker_entry") [])
 
 -- | Do native code generation on all these cmms.
 --
 cmmNativeGens :: (Outputable statics, Outputable instr, Instruction instr)
               => DynFlags
-              -> Module
+              -> Module -> ModLocation
               -> NcgImpl statics instr jumpDest
               -> BufHandle
+              -> LabelMap DebugBlock
               -> UniqSupply
               -> [RawCmmDecl]
               -> NativeGenAcc statics instr
               -> Int
               -> IO (NativeGenAcc statics instr, UniqSupply)
 
-cmmNativeGens _ _ _ _ us [] ngs _
+cmmNativeGens _ _ _ _ _ _ us [] ngs _
         = return (ngs, us)
 
-cmmNativeGens dflags this_mod ncgImpl h us (cmm : cmms) (impAcc, profAcc) count
+cmmNativeGens dflags this_mod modLoc ncgImpl h dbgMap us (cmm : cmms) (impAcc, profAcc, debugs, fileIds) count
  = do
-        (us', native, imports, colorStats, linearStats)
-                <- {-# SCC "cmmNativeGen" #-} cmmNativeGen dflags this_mod ncgImpl us cmm count
+        (us', fileIds', native, imports, colorStats, linearStats)
+                <- {-# SCC "cmmNativeGen" #-} cmmNativeGen dflags this_mod modLoc ncgImpl us fileIds dbgMap cmm count
 
-        {-# SCC "pprNativeCode" #-} Pretty.bufLeftRender h
-                $ withPprStyleDoc dflags (mkCodeStyle AsmStyle)
-                $ vcat $ map (pprNatCmmDecl ncgImpl) native
+        let newFileIds = fileIds' `minusUFM` fileIds
+            pprDecl (f,n) = ptext (sLit "\t.file ") <> ppr n <+> doubleQuotes (ftext f)
 
-        let !lsPprNative =
-                if  dopt Opt_D_dump_asm       dflags
-                 || dopt Opt_D_dump_asm_stats dflags
-                        then native
-                        else []
+        emitNativeCode dflags h $ vcat $
+          map pprDecl (eltsUFM newFileIds) ++
+          map (pprNatCmmDecl ncgImpl) native
 
         let !count' = count + 1
 
         -- force evaluation all this stuff to avoid space leaks
         {-# SCC "seqString" #-} evaluate $ seqString (showSDoc dflags $ vcat $ map ppr imports)
 
-        cmmNativeGens dflags this_mod ncgImpl h
+        cmmNativeGens dflags this_mod modLoc ncgImpl h dbgMap
             us' cmms ((imports : impAcc),
-                      ((lsPprNative, colorStats, linearStats) : profAcc))
+                      ((native, colorStats, linearStats) : profAcc),
+                      debugs, fileIds')
                      count'
 
  where  seqString []            = ()
         seqString (x:xs)        = x `seq` seqString xs
 
 
+emitNativeCode :: DynFlags -> BufHandle -> SDoc -> IO ()
+emitNativeCode dflags h sdoc = do
+
+        {-# SCC "pprNativeCode" #-} Pretty.bufLeftRender h
+                $ withPprStyleDoc dflags (mkCodeStyle AsmStyle) sdoc
+
+        -- dump native code
+        dumpIfSet_dyn dflags
+                Opt_D_dump_asm "Asm code"
+                sdoc
+
 -- | Complete native code generation phase for a single top-level chunk of Cmm.
 --      Dumping the output of each stage along the way.
 --      Global conflict graph and NGC stats
 cmmNativeGen
         :: (Outputable statics, Outputable instr, Instruction instr)
     => DynFlags
-    -> Module
+    -> Module -> ModLocation
     -> NcgImpl statics instr jumpDest
         -> UniqSupply
+        -> DwarfFiles
+        -> LabelMap DebugBlock
         -> RawCmmDecl                                   -- ^ the cmm to generate code for
         -> Int                                          -- ^ sequence number of this top thing
         -> IO   ( UniqSupply
+                , DwarfFiles
                 , [NatCmmDecl statics instr]                -- native code
                 , [CLabel]                                  -- things imported by this cmm
                 , Maybe [Color.RegAllocStats statics instr] -- stats for the coloring register allocator
                 , Maybe [Linear.RegAllocStats])             -- stats for the linear register allocators
 
-cmmNativeGen dflags this_mod ncgImpl us cmm count
+cmmNativeGen dflags this_mod modLoc ncgImpl us fileIds dbgMap cmm count
  = do
         let platform = targetPlatform dflags
 
@@ -436,9 +483,9 @@ cmmNativeGen dflags this_mod ncgImpl us cmm count
                 (pprCmmGroup [opt_cmm])
 
         -- generate native code from cmm
-        let ((native, lastMinuteImports), usGen) =
+        let ((native, lastMinuteImports, fileIds'), usGen) =
                 {-# SCC "genMachCode" #-}
-                initUs us $ genMachCode dflags this_mod (cmmTopCodeGen ncgImpl) opt_cmm
+                initUs us $ genMachCode dflags this_mod modLoc (cmmTopCodeGen ncgImpl) fileIds dbgMap opt_cmm
 
         dumpIfSet_dyn dflags
                 Opt_D_dump_asm_native "Native code"
@@ -569,6 +616,7 @@ cmmNativeGen dflags this_mod ncgImpl us cmm count
                 (vcat $ map (pprNatCmmDecl ncgImpl) expanded)
 
         return  ( usAlloc
+                , fileIds'
                 , expanded
                 , lastMinuteImports ++ imports
                 , ppr_raStatsColor
@@ -604,7 +652,7 @@ makeImportsDoc dflags imports
              then text ".section .note.GNU-stack,\"\",@progbits"
              else empty)
             $$
-                -- And just because every other compiler does, lets stick in
+                -- And just because every other compiler does, let's stick in
                 -- an identifier directive: .ident "GHC x.y.z"
             (if platformHasIdentDirective platform
              then let compilerIdent = text "GHC" <+> text cProjectVersion
@@ -824,21 +872,24 @@ apply_mapping ncgImpl ufm (CmmProc info lbl live (ListGraph blocks))
 
 genMachCode
         :: DynFlags
-        -> Module
+        -> Module -> ModLocation
         -> (RawCmmDecl -> NatM [NatCmmDecl statics instr])
+        -> DwarfFiles
+        -> LabelMap DebugBlock
         -> RawCmmDecl
         -> UniqSM
                 ( [NatCmmDecl statics instr]
-                , [CLabel])
+                , [CLabel]
+                , DwarfFiles)
 
-genMachCode dflags this_mod cmmTopCodeGen cmm_top
+genMachCode dflags this_mod modLoc cmmTopCodeGen fileIds dbgMap cmm_top
   = do  { initial_us <- getUs
-        ; let initial_st           = mkNatM_State initial_us 0 dflags this_mod
+        ; let initial_st           = mkNatM_State initial_us 0 dflags this_mod modLoc fileIds dbgMap
               (new_tops, final_st) = initNat initial_st (cmmTopCodeGen cmm_top)
               final_delta          = natm_delta final_st
               final_imports        = natm_imports final_st
         ; if   final_delta == 0
-          then return (new_tops, final_imports)
+          then return (new_tops, final_imports, natm_fileid final_st)
           else pprPanic "genMachCode: nonzero final delta" (int final_delta)
     }
 
@@ -1023,15 +1074,15 @@ cmmExprNative referenceKind expr = do
         CmmReg (CmmGlobal EagerBlackholeInfo)
           | arch == ArchPPC && not (gopt Opt_PIC dflags)
           -> cmmExprNative referenceKind $
-             CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageId (fsLit "__stg_EAGER_BLACKHOLE_info")))
+             CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageKey (fsLit "__stg_EAGER_BLACKHOLE_info")))
         CmmReg (CmmGlobal GCEnter1)
           | arch == ArchPPC && not (gopt Opt_PIC dflags)
           -> cmmExprNative referenceKind $
-             CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageId (fsLit "__stg_gc_enter_1")))
+             CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageKey (fsLit "__stg_gc_enter_1")))
         CmmReg (CmmGlobal GCFun)
           | arch == ArchPPC && not (gopt Opt_PIC dflags)
           -> cmmExprNative referenceKind $
-             CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageId (fsLit "__stg_gc_fun")))
+             CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageKey (fsLit "__stg_gc_fun")))
 
         other
            -> return other
diff --git a/compiler/nativeGen/CPrim.hs b/compiler/nativeGen/CPrim.hs
index a6f4cab7bd45..c52fe10b13d7 100644
--- a/compiler/nativeGen/CPrim.hs
+++ b/compiler/nativeGen/CPrim.hs
@@ -1,11 +1,18 @@
 -- | Generating C symbol names emitted by the compiler.
 module CPrim
-    ( popCntLabel
+    ( atomicReadLabel
+    , atomicWriteLabel
+    , atomicRMWLabel
+    , cmpxchgLabel
+    , popCntLabel
     , bSwapLabel
+    , clzLabel
+    , ctzLabel
     , word2FloatLabel
     ) where
 
 import CmmType
+import CmmMachOp
 import Outputable
 
 popCntLabel :: Width -> String
@@ -25,9 +32,70 @@ bSwapLabel w = "hs_bswap" ++ pprWidth w
     pprWidth W64 = "64"
     pprWidth w   = pprPanic "bSwapLabel: Unsupported word width " (ppr w)
 
+clzLabel :: Width -> String
+clzLabel w = "hs_clz" ++ pprWidth w
+  where
+    pprWidth W8  = "8"
+    pprWidth W16 = "16"
+    pprWidth W32 = "32"
+    pprWidth W64 = "64"
+    pprWidth w   = pprPanic "clzLabel: Unsupported word width " (ppr w)
+
+ctzLabel :: Width -> String
+ctzLabel w = "hs_ctz" ++ pprWidth w
+  where
+    pprWidth W8  = "8"
+    pprWidth W16 = "16"
+    pprWidth W32 = "32"
+    pprWidth W64 = "64"
+    pprWidth w   = pprPanic "ctzLabel: Unsupported word width " (ppr w)
+
 word2FloatLabel :: Width -> String
 word2FloatLabel w = "hs_word2float" ++ pprWidth w
   where
     pprWidth W32 = "32"
     pprWidth W64 = "64"
     pprWidth w   = pprPanic "word2FloatLabel: Unsupported word width " (ppr w)
+
+atomicRMWLabel :: Width -> AtomicMachOp -> String
+atomicRMWLabel w amop = "hs_atomic_" ++ pprFunName amop ++ pprWidth w
+  where
+    pprWidth W8  = "8"
+    pprWidth W16 = "16"
+    pprWidth W32 = "32"
+    pprWidth W64 = "64"
+    pprWidth w   = pprPanic "atomicRMWLabel: Unsupported word width " (ppr w)
+
+    pprFunName AMO_Add  = "add"
+    pprFunName AMO_Sub  = "sub"
+    pprFunName AMO_And  = "and"
+    pprFunName AMO_Nand = "nand"
+    pprFunName AMO_Or   = "or"
+    pprFunName AMO_Xor  = "xor"
+
+cmpxchgLabel :: Width -> String
+cmpxchgLabel w = "hs_cmpxchg" ++ pprWidth w
+  where
+    pprWidth W8  = "8"
+    pprWidth W16 = "16"
+    pprWidth W32 = "32"
+    pprWidth W64 = "64"
+    pprWidth w   = pprPanic "cmpxchgLabel: Unsupported word width " (ppr w)
+
+atomicReadLabel :: Width -> String
+atomicReadLabel w = "hs_atomicread" ++ pprWidth w
+  where
+    pprWidth W8  = "8"
+    pprWidth W16 = "16"
+    pprWidth W32 = "32"
+    pprWidth W64 = "64"
+    pprWidth w   = pprPanic "atomicReadLabel: Unsupported word width " (ppr w)
+
+atomicWriteLabel :: Width -> String
+atomicWriteLabel w = "hs_atomicwrite" ++ pprWidth w
+  where
+    pprWidth W8  = "8"
+    pprWidth W16 = "16"
+    pprWidth W32 = "32"
+    pprWidth W64 = "64"
+    pprWidth w   = pprPanic "atomicWriteLabel: Unsupported word width " (ppr w)
diff --git a/compiler/nativeGen/Dwarf.hs b/compiler/nativeGen/Dwarf.hs
new file mode 100644
index 000000000000..8ab6c6e7559a
--- /dev/null
+++ b/compiler/nativeGen/Dwarf.hs
@@ -0,0 +1,164 @@
+
+module Dwarf (
+  dwarfGen
+  ) where
+
+import CLabel
+import CmmExpr         ( GlobalReg(..) )
+import Config          ( cProjectName, cProjectVersion )
+import CoreSyn         ( Tickish(..) )
+import Debug
+import DynFlags
+import FastString
+import Module
+import Outputable
+import Platform
+import Unique
+import UniqSupply
+
+import Dwarf.Constants
+import Dwarf.Types
+
+import Data.Maybe
+import Data.List        ( sortBy )
+import Data.Ord         ( comparing )
+import qualified Data.Map as Map
+import System.FilePath
+import System.Directory ( getCurrentDirectory )
+
+import qualified Compiler.Hoopl as H
+
+-- | Generate DWARF/debug information
+dwarfGen :: DynFlags -> ModLocation -> UniqSupply -> [DebugBlock]
+            -> IO (SDoc, UniqSupply)
+dwarfGen df modLoc us blocks = do
+
+  -- Convert debug data structures to DWARF info records
+  let procs = debugSplitProcs blocks
+  compPath <- getCurrentDirectory
+  let dwarfUnit = DwarfCompileUnit
+        { dwChildren = map (procToDwarf df) procs
+        , dwName = fromMaybe "" (ml_hs_file modLoc)
+        , dwCompDir = addTrailingPathSeparator compPath
+        , dwProducer = cProjectName ++ " " ++ cProjectVersion
+        , dwLineLabel = dwarfLineLabel
+        }
+
+  -- Check whether we have any source code information, so we do not
+  -- end up writing a pointer to an empty .debug_line section
+  -- (dsymutil on Mac Os gets confused by this).
+  let haveSrcIn blk = isJust (dblSourceTick blk) && isJust (dblPosition blk)
+                      || any haveSrcIn (dblBlocks blk)
+      haveSrc = any haveSrcIn procs
+
+  -- .debug_abbrev section: Declare the format we're using
+  let abbrevSct = pprAbbrevDecls haveSrc
+
+  -- .debug_info section: Information records on procedures and blocks
+  let (unitU, us') = takeUniqFromSupply us
+      infoSct = vcat [ dwarfInfoSection
+                     , compileUnitHeader unitU
+                     , pprDwarfInfo haveSrc dwarfUnit
+                     , compileUnitFooter unitU
+                     ]
+
+  -- .debug_line section: Generated mainly by the assembler, but we need to label it
+  let lineSct = dwarfLineSection $$
+                ptext dwarfLineLabel <> colon
+
+  -- .debug_frame section: Information about the layout of the GHC stack
+  let (framesU, us'') = takeUniqFromSupply us'
+      frameSct = dwarfFrameSection $$
+                 ptext dwarfFrameLabel <> colon $$
+                 pprDwarfFrame (debugFrame framesU procs)
+
+  -- .debug_ghc section: debug data in eventlog format (GHC-specific, obviously)
+  evData <- writeDebugToEventlog df modLoc blocks
+  let ghcSct = dwarfGhcSection $$
+               pprBuffer evData
+
+  return (infoSct $$ abbrevSct $$ lineSct $$ frameSct $$ ghcSct, us'')
+
+-- | Header for a compilation unit, establishing global format
+-- parameters
+compileUnitHeader :: Unique -> SDoc
+compileUnitHeader unitU = sdocWithPlatform $ \plat ->
+  let cuLabel = mkAsmTempLabel unitU
+      length = ppr (mkAsmTempEndLabel cuLabel) <> char '-' <> ppr cuLabel
+  in vcat [ ptext (sLit "\t.long ") <> length  -- compilation unit size
+          , ppr cuLabel <> colon
+          , ptext (sLit "\t.word 3")           -- DWARF version
+          , pprDwWord (ptext dwarfAbbrevLabel <> char '-' <>
+                       ptext dwarfAbbrevLabel) -- pointer to our abbrevs
+          , ptext (sLit "\t.byte ") <> ppr (platformWordSize plat) -- word size
+          ]
+
+-- | Compilation unit footer, mainly establishing size of debug sections
+compileUnitFooter :: Unique -> SDoc
+compileUnitFooter unitU =
+  let cuEndLabel = mkAsmTempEndLabel $ mkAsmTempLabel unitU
+  in ppr cuEndLabel <> colon
+
+-- | Splits the blocks by procedures. In the result all nested blocks
+-- will come from the same procedure as the top-level block.
+debugSplitProcs :: [DebugBlock] -> [DebugBlock]
+debugSplitProcs b = concat $ H.mapElems $ mapMerges $ map split b
+  where mapMerges = foldr (H.mapUnionWithKey (const (++))) H.mapEmpty
+        split :: DebugBlock -> H.LabelMap [DebugBlock]
+        split blk = H.mapInsert (dblProcedure blk) [blk {dblBlocks = own_blks}] blks
+          where own_blks = fromMaybe [] $ H.mapLookup (dblProcedure blk) blks
+                blks = mapMerges $ map split $ dblBlocks blk
+        -- Note we are invalidating the tick tree here. We could fix
+        -- it - but then again we don't actually care about dblTicks here.
+
+-- | Generate DWARF info for a procedure debug block
+procToDwarf :: DynFlags -> DebugBlock -> DwarfInfo
+procToDwarf df prc
+  = DwarfSubprogram { dwChildren = foldr blockToDwarf [] $ dblBlocks prc
+                    , dwName     = case dblSourceTick prc of
+                         Just s@SourceNote{} -> sourceName s
+                         _otherwise          -> showSDocDump df $ ppr $ dblLabel prc
+                    , dwLabel    = dblCLabel prc
+                    }
+
+blockToDwarf :: DebugBlock -> [DwarfInfo] -> [DwarfInfo]
+blockToDwarf blk dws
+  | isJust (dblPosition blk)  = dw : dws
+  | otherwise                 = nested ++ dws -- block was optimized out, flatten
+  where nested = foldr blockToDwarf [] $ dblBlocks blk
+        dw = DwarfBlock { dwChildren = nested
+                        , dwLabel    = dblCLabel blk
+                        , dwMarker   = mkAsmTempLabel (dblLabel blk)
+                        }
+
+-- | Generates the data for the debug frame section, which encodes the
+-- desired stack unwind behaviour for the debugger
+debugFrame :: Unique -> [DebugBlock] -> DwarfFrame
+debugFrame u procs
+  = DwarfFrame { dwCieLabel = mkAsmTempLabel u
+               , dwCieInit  = initUws
+               , dwCieProcs = map (procToFrame initUws) procs
+               }
+  where initUws = Map.fromList [(Sp, UwReg Sp 0)]
+
+-- | Generates unwind information for a procedure debug block
+procToFrame :: UnwindTable -> DebugBlock -> DwarfFrameProc
+procToFrame initUws blk
+  = DwarfFrameProc { dwFdeProc    = dblCLabel blk
+                   , dwFdeHasInfo = dblHasInfoTbl blk
+                   , dwFdeBlocks  = map (uncurry blockToFrame) blockUws
+                   }
+  where blockUws :: [(DebugBlock, UnwindTable)]
+        blockUws = map snd $ sortBy (comparing fst) $ flatten initUws blk
+        flatten uws0 b@DebugBlock{dblPosition=pos, dblUnwind=uws, dblBlocks=blocks }
+          | Just p <- pos  = (p, (b, uws')):nested
+          | otherwise      = nested -- block was optimized out
+          where uws'   = uws `Map.union` uws0
+                nested = concatMap (flatten uws') blocks
+
+blockToFrame :: DebugBlock -> UnwindTable -> DwarfFrameBlock
+blockToFrame blk uws
+  = DwarfFrameBlock { dwFdeBlock      = mkAsmTempLabel $ dblLabel blk
+                    , dwFdeBlkHasInfo = dblHasInfoTbl blk
+                    , dwFdeUnwind     = uws
+                    }
diff --git a/compiler/nativeGen/Dwarf/Constants.hs b/compiler/nativeGen/Dwarf/Constants.hs
new file mode 100644
index 000000000000..8a4fde415bd5
--- /dev/null
+++ b/compiler/nativeGen/Dwarf/Constants.hs
@@ -0,0 +1,193 @@
+
+-- | Constants describing the DWARF format. Most of this simply
+-- mirrors /usr/include/dwarf.h.
+
+module Dwarf.Constants where
+
+import FastString
+import Outputable
+import Platform
+
+import Reg
+import X86.Regs
+
+import Data.Word
+
+-- | Language ID used for Haskell.
+dW_LANG_Haskell :: Word
+dW_LANG_Haskell = 0x18
+  -- Thanks to Nathan Howell for getting us our very own language ID!
+
+-- | Dwarf tags
+dW_TAG_compile_unit, dW_TAG_subroutine_type,
+  dW_TAG_file_type, dW_TAG_subprogram, dW_TAG_lexical_block,
+  dW_TAG_base_type, dW_TAG_structure_type, dW_TAG_pointer_type,
+  dW_TAG_array_type, dW_TAG_subrange_type, dW_TAG_typedef,
+  dW_TAG_variable, dW_TAG_arg_variable, dW_TAG_auto_variable :: Word
+dW_TAG_array_type      = 1
+dW_TAG_lexical_block   = 11
+dW_TAG_pointer_type    = 15
+dW_TAG_compile_unit    = 17
+dW_TAG_structure_type  = 19
+dW_TAG_typedef         = 22
+dW_TAG_subroutine_type = 32
+dW_TAG_subrange_type   = 33
+dW_TAG_base_type       = 36
+dW_TAG_file_type       = 41
+dW_TAG_subprogram      = 46
+dW_TAG_variable        = 52
+dW_TAG_auto_variable   = 256
+dW_TAG_arg_variable    = 257
+
+-- | Dwarf attributes
+dW_AT_name, dW_AT_stmt_list, dW_AT_low_pc, dW_AT_high_pc, dW_AT_language,
+  dW_AT_comp_dir, dW_AT_producer, dW_AT_external, dW_AT_frame_base,
+  dW_AT_MIPS_linkage_name :: Word
+dW_AT_name              = 0x03
+dW_AT_stmt_list         = 0x10
+dW_AT_low_pc            = 0x11
+dW_AT_high_pc           = 0x12
+dW_AT_language          = 0x13
+dW_AT_comp_dir          = 0x1b
+dW_AT_producer          = 0x25
+dW_AT_external          = 0x3f
+dW_AT_frame_base        = 0x40
+dW_AT_MIPS_linkage_name = 0x2007
+
+-- | Abbrev declaration
+dW_CHILDREN_no, dW_CHILDREN_yes :: Word8
+dW_CHILDREN_no  = 0
+dW_CHILDREN_yes = 1
+
+dW_FORM_addr, dW_FORM_data4, dW_FORM_string, dW_FORM_flag,
+  dW_FORM_block1, dW_FORM_ref4 :: Word
+dW_FORM_addr   = 0x01
+dW_FORM_data4  = 0x06
+dW_FORM_string = 0x08
+dW_FORM_flag   = 0x0c
+dW_FORM_block1 = 0x0a
+dW_FORM_ref4   = 0x13
+
+-- | Dwarf native types
+dW_ATE_address, dW_ATE_boolean, dW_ATE_float, dW_ATE_signed,
+  dW_ATE_signed_char, dW_ATE_unsigned, dW_ATE_unsigned_char :: Word
+dW_ATE_address       = 1
+dW_ATE_boolean       = 2
+dW_ATE_float         = 4
+dW_ATE_signed        = 5
+dW_ATE_signed_char   = 6
+dW_ATE_unsigned      = 7
+dW_ATE_unsigned_char = 8
+
+-- | Call frame information
+dW_CFA_set_loc, dW_CFA_undefined, dW_CFA_same_value,
+  dW_CFA_def_cfa, dW_CFA_def_cfa_offset, dW_CFA_def_cfa_expression,
+  dW_CFA_expression, dW_CFA_offset_extended_sf, dW_CFA_def_cfa_offset_sf,
+  dW_CFA_def_cfa_sf, dW_CFA_val_offset, dW_CFA_val_expression,
+  dW_CFA_offset :: Word8
+dW_CFA_set_loc            = 0x01
+dW_CFA_undefined          = 0x07
+dW_CFA_same_value         = 0x08
+dW_CFA_def_cfa            = 0x0c
+dW_CFA_def_cfa_offset     = 0x0e
+dW_CFA_def_cfa_expression = 0x0f
+dW_CFA_expression         = 0x10
+dW_CFA_offset_extended_sf = 0x11
+dW_CFA_def_cfa_sf         = 0x12
+dW_CFA_def_cfa_offset_sf  = 0x13
+dW_CFA_val_offset         = 0x14
+dW_CFA_val_expression     = 0x16
+dW_CFA_offset             = 0x80
+
+-- | Operations
+dW_OP_deref, dW_OP_consts,
+  dW_OP_minus, dW_OP_mul, dW_OP_plus,
+  dW_OP_lit0, dW_OP_breg0, dW_OP_call_frame_cfa :: Word8
+dW_OP_deref          = 0x06
+dW_OP_consts         = 0x11
+dW_OP_minus          = 0x1c
+dW_OP_mul            = 0x1e
+dW_OP_plus           = 0x22
+dW_OP_lit0           = 0x30
+dW_OP_breg0          = 0x70
+dW_OP_call_frame_cfa = 0x9c
+
+-- | Dwarf section declarations
+dwarfInfoSection, dwarfAbbrevSection, dwarfLineSection,
+  dwarfFrameSection, dwarfGhcSection :: SDoc
+dwarfInfoSection   = dwarfSection "info"
+dwarfAbbrevSection = dwarfSection "abbrev"
+dwarfLineSection   = dwarfSection "line"
+dwarfFrameSection  = dwarfSection "frame"
+dwarfGhcSection    = dwarfSection "ghc"
+
+dwarfSection :: String -> SDoc
+dwarfSection name = sdocWithPlatform $ \plat ->
+  case platformOS plat of
+    OSDarwin -> ftext $ mkFastString $ ".section __DWARF,__debug_" ++ name ++ ",regular,debug"
+    _other   -> ftext $ mkFastString $ ".section .debug_" ++ name ++ ",\"\",@progbits"
+
+-- | Dwarf section labels
+dwarfInfoLabel, dwarfAbbrevLabel, dwarfLineLabel, dwarfFrameLabel :: LitString
+dwarfInfoLabel   = sLit ".Lsection_info"
+dwarfAbbrevLabel = sLit ".Lsection_abbrev"
+dwarfLineLabel   = sLit ".Lsection_line"
+dwarfFrameLabel  = sLit ".Lsection_frame"
+
+-- | Mapping of registers to DWARF register numbers
+dwarfRegNo :: Platform -> Reg -> Word8
+dwarfRegNo p r = case platformArch p of
+  ArchX86
+    | r == eax  -> 0
+    | r == ecx  -> 1  -- yes, no typo
+    | r == edx  -> 2
+    | r == ebx  -> 3
+    | r == esp  -> 4
+    | r == ebp  -> 5
+    | r == esi  -> 6
+    | r == edi  -> 7
+  ArchX86_64
+    | r == rax  -> 0
+    | r == rdx  -> 1 -- this neither. The order GCC allocates registers in?
+    | r == rcx  -> 2
+    | r == rbx  -> 3
+    | r == rsi  -> 4
+    | r == rdi  -> 5
+    | r == rbp  -> 6
+    | r == rsp  -> 7
+    | r == r8   -> 8
+    | r == r9   -> 9
+    | r == r10  -> 10
+    | r == r11  -> 11
+    | r == r12  -> 12
+    | r == r13  -> 13
+    | r == r14  -> 14
+    | r == r15  -> 15
+    | r == xmm0 -> 17
+    | r == xmm1 -> 18
+    | r == xmm2 -> 19
+    | r == xmm3 -> 20
+    | r == xmm4 -> 21
+    | r == xmm5 -> 22
+    | r == xmm6 -> 23
+    | r == xmm7 -> 24
+    | r == xmm8 -> 25
+    | r == xmm9 -> 26
+    | r == xmm10 -> 27
+    | r == xmm11 -> 28
+    | r == xmm12 -> 29
+    | r == xmm13 -> 30
+    | r == xmm14 -> 31
+    | r == xmm15 -> 32
+  _other         -> error "dwarfRegNo: Unsupported platform or unknown register!"
+
+-- | Virtual register number to use for return address.
+dwarfReturnRegNo :: Platform -> Word8
+dwarfReturnRegNo p
+  -- We "overwrite" IP with our pseudo register - that makes sense, as
+  -- when using this mechanism gdb already knows the IP anyway. Clang
+  -- does this too, so it must be safe.
+  = case platformArch p of
+    ArchX86    -> 8  -- eip
+    ArchX86_64 -> 16 -- rip
+    _other     -> error "dwarfReturnRegNo: Unsupported platform!"
diff --git a/compiler/nativeGen/Dwarf/Types.hs b/compiler/nativeGen/Dwarf/Types.hs
new file mode 100644
index 000000000000..992569109d7b
--- /dev/null
+++ b/compiler/nativeGen/Dwarf/Types.hs
@@ -0,0 +1,446 @@
+
+module Dwarf.Types
+  ( -- * Dwarf information
+    DwarfInfo(..)
+  , pprDwarfInfo
+  , pprAbbrevDecls
+    -- * Dwarf frame
+  , DwarfFrame(..), DwarfFrameProc(..), DwarfFrameBlock(..)
+  , pprDwarfFrame
+    -- * Utilities
+  , pprByte
+  , pprData4'
+  , pprDwWord
+  , pprWord
+  , pprLEBWord
+  , pprLEBInt
+  , wordAlign
+  , pprBuffer
+  )
+  where
+
+import Binary
+import Debug
+import CLabel
+import CmmExpr         ( GlobalReg(..) )
+import FastString
+import Outputable
+import Platform
+import Reg
+
+import Dwarf.Constants
+
+import Data.Bits
+import Data.List ( mapAccumL )
+import qualified Data.Map as Map
+import Data.Word
+import Data.Char
+
+import CodeGen.Platform
+
+import Foreign
+
+import qualified System.IO.Unsafe as Unsafe
+
+-- | Individual dwarf records
+data DwarfInfo
+  = DwarfCompileUnit { dwChildren :: [DwarfInfo]
+                     , dwName :: String
+                     , dwProducer :: String
+                     , dwCompDir :: String
+                     , dwLineLabel :: LitString }
+  | DwarfSubprogram { dwChildren :: [DwarfInfo]
+                    , dwName :: String
+                    , dwLabel :: CLabel }
+  | DwarfBlock { dwChildren :: [DwarfInfo]
+               , dwLabel :: CLabel
+               , dwMarker :: CLabel }
+
+-- | Abbreviation codes used in dwarf file
+data DwarfAbbrev
+  = DwAbbrNull          -- ^ Pseudo, used for marking the end of lists
+  | DwAbbrCompileUnit
+  | DwAbbrSubprogram
+  | DwAbbrBlock
+  deriving (Eq, Enum)
+
+-- | Gives code to use in binary represenation.
+abbrevToCode :: DwarfAbbrev -> Word
+abbrevToCode = fromIntegral . fromEnum
+
+-- | Abbreviation declaration. This explains the binary encoding we
+-- use for representing @DwarfInfo@.
+pprAbbrevDecls :: Bool -> SDoc
+pprAbbrevDecls haveDebugLine =
+  let mkAbbrev abbr tag chld flds =
+        let fld (tag, form) = pprLEBWord tag $$ pprLEBWord form
+        in pprLEBWord (abbrevToCode abbr) $$ pprLEBWord tag $$ pprByte chld $$
+           vcat (map fld flds) $$ pprByte 0 $$ pprByte 0
+  in dwarfAbbrevSection $$
+     ptext dwarfAbbrevLabel <> colon $$
+     mkAbbrev DwAbbrCompileUnit dW_TAG_compile_unit dW_CHILDREN_yes
+       ([ (dW_AT_name, dW_FORM_string)
+       , (dW_AT_producer, dW_FORM_string)
+       , (dW_AT_language, dW_FORM_data4)
+       , (dW_AT_comp_dir, dW_FORM_string)
+       ] ++
+       (if haveDebugLine
+        then [ (dW_AT_stmt_list, dW_FORM_data4) ]
+        else [])) $$
+     mkAbbrev DwAbbrSubprogram dW_TAG_subprogram dW_CHILDREN_yes
+       [ (dW_AT_name, dW_FORM_string)
+       , (dW_AT_MIPS_linkage_name, dW_FORM_string)
+       , (dW_AT_external, dW_FORM_flag)
+       , (dW_AT_low_pc, dW_FORM_addr)
+       , (dW_AT_high_pc, dW_FORM_addr)
+       , (dW_AT_frame_base, dW_FORM_block1)
+       ] $$
+     mkAbbrev DwAbbrBlock dW_TAG_lexical_block dW_CHILDREN_yes
+       [ (dW_AT_name, dW_FORM_string)
+       , (dW_AT_low_pc, dW_FORM_addr)
+       , (dW_AT_high_pc, dW_FORM_addr)
+       ]
+
+pprAbbrev :: DwarfAbbrev -> SDoc
+pprAbbrev = pprLEBWord . abbrevToCode
+
+pprString' :: SDoc -> SDoc
+pprString' str = ptext (sLit "\t.asciz \"") <> str <> char '"'
+
+pprString :: String -> SDoc
+pprString = pprString' . hcat . map escape
+  where escape '\\' = ptext (sLit "\\\\")
+        escape '\"' = ptext (sLit "\\\"")
+        escape '\n' = ptext (sLit "\\n")
+        escape c    | isAscii c && isPrint c && c /= '?' -- silence trigraph warnings
+                    = char c
+                    | otherwise
+                    = let ch = ord c
+                      in char '\\' <>
+                         char (intToDigit (ch `div` 64)) <>
+                         char (intToDigit ((ch `div` 8) `mod` 8)) <>
+                         char (intToDigit (ch `mod` 8))
+
+pprData4' :: SDoc -> SDoc
+pprData4' x = ptext (sLit "\t.long ") <> x
+
+pprData4 :: Word -> SDoc
+pprData4 = pprData4' . ppr
+
+pprDwWord :: SDoc -> SDoc
+pprDwWord = pprData4'
+
+-- | Machine-dependent word directive
+pprWord :: SDoc -> SDoc
+pprWord s = (<> s) . sdocWithPlatform $ \plat ->
+  case platformWordSize plat of
+    4 -> ptext (sLit "\t.long ")
+    8 -> ptext (sLit "\t.quad ")
+    n -> panic $ "pprWord: Unsupported target platform word length " ++ show n ++ "!"
+
+pprFlag :: Bool -> SDoc
+pprFlag True  = ptext (sLit "\t.byte 0xff")
+pprFlag False = ptext (sLit "\t.byte 0")
+
+pprDwarfInfo :: Bool -> DwarfInfo -> SDoc
+pprDwarfInfo haveSrc d
+  = pprDwarfInfoOpen haveSrc d $$
+    vcat (map (pprDwarfInfo haveSrc) (dwChildren d)) $$
+    pprDwarfInfoClose
+
+-- | Prints assembler data corresponding to DWARF info records. Note
+-- that the binary format of this is paramterized in @abbrevDecls@ and
+-- has to be kept in synch.
+pprDwarfInfoOpen :: Bool -> DwarfInfo -> SDoc
+pprDwarfInfoOpen haveSrc (DwarfCompileUnit _ name producer compDir lineLbl) =
+  pprAbbrev DwAbbrCompileUnit
+  $$ pprString name
+  $$ pprString producer
+  $$ pprData4 dW_LANG_Haskell
+  $$ pprString compDir
+  $$ if haveSrc
+     then pprData4' (ptext lineLbl <> char '-' <> ptext dwarfLineLabel)
+     else empty
+pprDwarfInfoOpen _ (DwarfSubprogram _ name label) = sdocWithDynFlags $ \df ->
+  pprAbbrev DwAbbrSubprogram
+  $$ pprString name
+  $$ pprString (renderWithStyle df (ppr label) (mkCodeStyle CStyle))
+  $$ pprFlag (externallyVisibleCLabel label)
+  $$ pprWord (ppr label)
+  $$ pprWord (ppr $ mkAsmTempEndLabel label)
+  $$ pprByte 1
+  $$ pprByte dW_OP_call_frame_cfa
+pprDwarfInfoOpen _ (DwarfBlock _ label marker) = sdocWithDynFlags $ \df ->
+  pprAbbrev DwAbbrBlock
+  $$ pprString (renderWithStyle df (ppr label) (mkCodeStyle CStyle))
+  $$ pprWord (ppr marker)
+  $$ pprWord (ppr $ mkAsmTempEndLabel marker)
+
+pprDwarfInfoClose :: SDoc
+pprDwarfInfoClose = pprAbbrev DwAbbrNull
+
+-- | Generate code for emitting the given buffer. Will take care to
+-- escape it appropriatly.
+pprBuffer :: (Int, ForeignPtr Word8) -> SDoc
+pprBuffer (len, buf) = Unsafe.unsafePerformIO $ do
+
+  -- As we output a string, we need to do escaping. We approximate
+  -- here that the escaped string will have double the size of the
+  -- original buffer. That should be plenty of space given the fact
+  -- that we expect to be converting a lot of text.
+  bh <- openBinMem (len * 2)
+  let go p q | p == q    = return ()
+             | otherwise = peek p >>= escape . fromIntegral >> go (p `plusPtr` 1) q
+      escape c
+        | c == ord '\\'  = putB '\\' >> putB '\\'
+        | c == ord '\"'  = putB '\\' >> putB '"'
+        | c == ord '\n'  = putB '\\' >> putB 'n'
+        | c == ord '?'   = putB '\\' >> putB '?' -- silence trigraph warnings
+        | isAscii (chr c) && isPrint (chr c)
+                         = putByte bh (fromIntegral c)
+        | otherwise      = do putB '\\'
+                              putB $ intToDigit (c `div` 64)
+                              putB $ intToDigit ((c `div` 8) `mod` 8)
+                              putB $ intToDigit (c `mod` 8)
+      putB :: Char -> IO ()
+      putB = putByte bh . fromIntegral . ord
+      {-# INLINE putB #-}
+  withForeignPtr buf $ \p ->
+    go p (p `plusPtr` len)
+
+  -- Pack result into a string
+  (elen, ebuf) <- getBinMemBuf bh
+  buf <- withForeignPtr ebuf $ \p -> mkFastStringForeignPtr p ebuf elen
+
+  return $ ptext (sLit "\t.ascii ") <> doubleQuotes (ftext buf)
+
+-- | Information about unwind instructions for a procedure. This
+-- corresponds to a "Common Information Entry" (CIE) in DWARF.
+data DwarfFrame
+  = DwarfFrame
+    { dwCieLabel :: CLabel
+    , dwCieInit  :: UnwindTable
+    , dwCieProcs :: [DwarfFrameProc]
+    }
+
+-- | Unwind instructions for an individual procedure. Corresponds to a
+-- "Frame Description Entry" (FDE) in DWARF.
+data DwarfFrameProc
+  = DwarfFrameProc
+    { dwFdeProc    :: CLabel
+    , dwFdeHasInfo :: Bool
+    , dwFdeBlocks  :: [DwarfFrameBlock] -- ^ List of blocks. Order must match asm!
+    }
+
+-- | Unwind instructions for a block. Will become part of the
+-- containing FDE.
+data DwarfFrameBlock
+  = DwarfFrameBlock
+    { dwFdeBlock      :: CLabel
+    , dwFdeBlkHasInfo :: Bool
+    , dwFdeUnwind     :: UnwindTable
+    }
+
+-- | Header for the .debug_frame section. Here we emit the "Common
+-- Information Entry" record that etablishes general call frame
+-- parameters and the default stack layout.
+pprDwarfFrame :: DwarfFrame -> SDoc
+pprDwarfFrame DwarfFrame{ dwCieLabel=cieLabel, dwCieInit=cieInit, dwCieProcs=procs }
+  = sdocWithPlatform $ \plat ->
+    let cieStartLabel= mkAsmTempDerivedLabel cieLabel (fsLit "_start")
+        cieEndLabel = mkAsmTempEndLabel cieLabel
+        length      = ppr cieEndLabel <> char '-' <> ppr cieStartLabel
+        spReg       = dwarfGlobalRegNo plat Sp
+        retReg      = dwarfReturnRegNo plat
+        wordSize    = platformWordSize plat
+        pprInit (g, uw) = pprSetUnwind plat g (Nothing, uw)
+    in vcat [ ppr cieLabel <> colon
+            , pprData4' length -- Length of CIE
+            , ppr cieStartLabel <> colon
+            , pprData4' (ptext (sLit "-1"))
+                               -- Common Information Entry marker (-1 = 0xf..f)
+            , pprByte 3        -- CIE version (we require DWARF 3)
+            , pprByte 0        -- Augmentation (none)
+            , pprByte 1        -- Code offset multiplicator
+            , pprByte (128-fromIntegral wordSize)
+                               -- Data offset multiplicator
+                               -- (stacks grow downwards => "-w" in signed LEB128)
+            , pprByte retReg   -- virtual register holding return address
+            ] $$
+       -- Initial unwind table
+       vcat (map pprInit $ Map.toList cieInit) $$
+       vcat [ -- RET = *CFA
+              pprByte (dW_CFA_offset+retReg)
+            , pprByte 0
+
+              -- Sp' = CFA
+              -- (we need to set this manually as our Sp register is
+              -- often not the architecture's default stack register)
+            , pprByte dW_CFA_val_offset
+            , pprLEBWord (fromIntegral spReg)
+            , pprLEBWord 0
+            ] $$
+       wordAlign $$
+       ppr cieEndLabel <> colon $$
+       -- Procedure unwind tables
+       vcat (map (pprFrameProc cieLabel cieInit) procs)
+
+-- | Writes a "Frame Description Entry" for a procedure. This consists
+-- mainly of referencing the CIE and writing state machine
+-- instructions to describe how the frame base (CFA) changes.
+pprFrameProc :: CLabel -> UnwindTable -> DwarfFrameProc -> SDoc
+pprFrameProc frameLbl initUw (DwarfFrameProc procLbl hasInfo blocks)
+  = let fdeLabel    = mkAsmTempDerivedLabel procLbl (fsLit "_fde")
+        fdeEndLabel = mkAsmTempDerivedLabel procLbl (fsLit "_fde_end")
+        procEnd     = mkAsmTempEndLabel procLbl
+        ifInfo str  = if hasInfo then text str else empty -- see [Note: Info Offset]
+    in vcat [ pprData4' (ppr fdeEndLabel <> char '-' <> ppr fdeLabel)
+            , ppr fdeLabel <> colon
+            , pprData4' (ppr frameLbl <> char '-' <>
+                         ptext dwarfFrameLabel)    -- Reference to CIE
+            , pprWord (ppr procLbl <> ifInfo "-1") -- Code pointer
+            , pprWord (ppr procEnd <> char '-' <>
+                       ppr procLbl <> ifInfo "+1") -- Block byte length
+            ] $$
+       vcat (snd $ mapAccumL pprFrameBlock initUw blocks) $$
+       wordAlign $$
+       ppr fdeEndLabel <> colon
+
+-- | Generates unwind information for a block. We only generate
+-- instructions where unwind information actually changes. This small
+-- optimisations saves a lot of space, as subsequent blocks often have
+-- the same unwind information.
+pprFrameBlock :: UnwindTable -> DwarfFrameBlock -> (UnwindTable, SDoc)
+pprFrameBlock oldUws (DwarfFrameBlock blockLbl hasInfo uws)
+  | uws == oldUws
+  = (oldUws, empty)
+  | otherwise
+  = (,) uws $ sdocWithPlatform $ \plat ->
+    let lbl = ppr blockLbl <> if hasInfo then text "-1" else empty -- see [Note: Info Offset]
+        isChanged g v | old == Just v  = Nothing
+                      | otherwise      = Just (old, v)
+                      where old = Map.lookup g oldUws
+        changed = Map.toList $ Map.mapMaybeWithKey isChanged uws
+        died    = Map.toList $ Map.difference oldUws uws
+    in pprByte dW_CFA_set_loc $$ pprWord lbl $$
+       vcat (map (uncurry $ pprSetUnwind plat) changed) $$
+       vcat (map (pprUndefUnwind plat . fst) died)
+
+-- [Note: Info Offset]
+--
+-- GDB was pretty much written with C-like programs in mind, and as a
+-- result they assume that once you have a return address, it is a
+-- good idea to look at (PC-1) to unwind further - as that's where the
+-- "call" instruction is supposed to be.
+--
+-- Now on one hand, code generated by GHC looks nothing like what GDB
+-- expects, and in fact going up from a return pointer is guaranteed
+-- to land us inside an info table! On the other hand, that actually
+-- gives us some wiggle room, as we expect IP to never *actually* end
+-- up inside the info table, so we can "cheat" by putting whatever GDB
+-- expects to see there. This is probably pretty safe, as GDB cannot
+-- assume (PC-1) to be a valid code pointer in the first place - and I
+-- have seen no code trying to correct this.
+--
+-- Note that this will not prevent GDB from failing to look-up the
+-- correct function name for the frame, as that uses the symbol table,
+-- which we can not manipulate as easily.
+
+dwarfGlobalRegNo :: Platform -> GlobalReg -> Word8
+dwarfGlobalRegNo plat = maybe 0 (dwarfRegNo plat . RegReal) . globalRegMaybe plat
+
+-- | Generate code for setting the unwind information for a register,
+-- optimized using its known old value in the table. Note that "Sp" is
+-- special: We see it as synonym for the CFA.
+pprSetUnwind :: Platform -> GlobalReg -> (Maybe UnwindExpr, UnwindExpr) -> SDoc
+pprSetUnwind _    Sp (Just (UwReg s _), UwReg s' o') | s == s'
+  = if o' >= 0
+    then pprByte dW_CFA_def_cfa_offset $$ pprLEBWord (fromIntegral o')
+    else pprByte dW_CFA_def_cfa_offset_sf $$ pprLEBInt o'
+pprSetUnwind plat Sp (_, UwReg s' o')
+  = if o' >= 0
+    then pprByte dW_CFA_def_cfa $$
+         pprLEBWord (fromIntegral $ dwarfGlobalRegNo plat s') $$
+         pprLEBWord (fromIntegral o')
+    else pprByte dW_CFA_def_cfa_sf $$
+         pprLEBWord (fromIntegral $ dwarfGlobalRegNo plat s') $$
+         pprLEBInt o'
+pprSetUnwind _    Sp (_, uw)
+  = pprByte dW_CFA_def_cfa_expression $$ pprUnwindExpr False uw
+pprSetUnwind plat g  (_, UwDeref (UwReg Sp o))
+  | o < 0 && ((-o) `mod` platformWordSize plat) == 0 -- expected case
+  = pprByte (dW_CFA_offset + dwarfGlobalRegNo plat g) $$
+    pprLEBWord (fromIntegral ((-o) `div` platformWordSize plat))
+  | otherwise
+  = pprByte dW_CFA_offset_extended_sf $$
+    pprLEBWord (fromIntegral (dwarfGlobalRegNo plat g)) $$
+    pprLEBInt o
+pprSetUnwind plat g  (_, UwDeref uw)
+  = pprByte dW_CFA_expression $$
+    pprLEBWord (fromIntegral (dwarfGlobalRegNo plat g)) $$
+    pprUnwindExpr True uw
+pprSetUnwind plat g  (_, uw)
+  = pprByte dW_CFA_val_expression $$
+    pprLEBWord (fromIntegral (dwarfGlobalRegNo plat g)) $$
+    pprUnwindExpr True uw
+
+-- | Generates a DWARF expression for the given unwind expression. If
+-- @spIsCFA@ is true, we see @Sp@ as the frame base CFA where it gets
+-- mentioned.
+pprUnwindExpr :: Bool -> UnwindExpr -> SDoc
+pprUnwindExpr spIsCFA expr
+  = sdocWithPlatform $ \plat ->
+    let ppr (UwConst i)
+          | i >= 0 && i < 32 = pprByte (dW_OP_lit0 + fromIntegral i)
+          | otherwise        = pprByte dW_OP_consts $$ pprLEBInt i -- the lazy way
+        ppr (UwReg Sp i) | spIsCFA
+                             = if i == 0
+                               then pprByte dW_OP_call_frame_cfa
+                               else ppr (UwPlus (UwReg Sp 0) (UwConst i))
+        ppr (UwReg g i)      = pprByte (dW_OP_breg0 + fromIntegral (dwarfGlobalRegNo plat g)) $$
+                               pprLEBInt i
+        ppr (UwDeref u)      = ppr u $$ pprByte dW_OP_deref
+        ppr (UwPlus u1 u2)   = ppr u1 $$ ppr u2 $$ pprByte dW_OP_plus
+        ppr (UwMinus u1 u2)  = ppr u1 $$ ppr u2 $$ pprByte dW_OP_minus
+        ppr (UwTimes u1 u2)  = ppr u1 $$ ppr u2 $$ pprByte dW_OP_mul
+    in ptext (sLit "\t.byte 1f-.-1") $$
+       ppr expr $$
+       ptext (sLit "1:")
+
+-- | Generate code for re-setting the unwind information for a
+-- register to "undefined"
+pprUndefUnwind :: Platform -> GlobalReg -> SDoc
+pprUndefUnwind _    Sp = panic "pprUndefUnwind Sp" -- should never happen
+pprUndefUnwind plat g  = pprByte dW_CFA_undefined $$
+                         pprLEBWord (fromIntegral $ dwarfGlobalRegNo plat g)
+
+
+
+wordAlign :: SDoc
+wordAlign = sdocWithPlatform $ \plat ->
+  ptext (sLit "\t.align ") <> case platformOS plat of
+    OSDarwin -> case platformWordSize plat of
+      8      -> text "3"
+      4      -> text "2"
+      _other -> error "wordAlign: Unsupported word size!"
+    _other   -> ppr (platformWordSize plat)
+
+pprByte :: Word8 -> SDoc
+pprByte x = ptext (sLit "\t.byte ") <> ppr (fromIntegral x :: Word)
+
+-- | Prints a number in "little endian base 128" format. The idea is
+-- to optimize for small numbers by stopping once all further bytes
+-- would be 0. The highest bit in every byte signals whether there
+-- are further bytes to read.
+pprLEBWord :: Word -> SDoc
+pprLEBWord x | x < 128   = pprByte (fromIntegral x)
+             | otherwise = pprByte (fromIntegral $ 128 .|. (x .&. 127)) $$
+                           pprLEBWord (x `shiftR` 7)
+
+-- | Same as @pprLEBWord@, but for a signed number
+pprLEBInt :: Int -> SDoc
+pprLEBInt x | x >= -64 && x < 64
+                        = pprByte (fromIntegral (x .&. 127))
+            | otherwise = pprByte (fromIntegral $ 128 .|. (x .&. 127)) $$
+                          pprLEBInt (x `shiftR` 7)
+
diff --git a/compiler/nativeGen/NCGMonad.hs b/compiler/nativeGen/NCGMonad.hs
index 3ee3af2ea94d..3af3d3d36ff8 100644
--- a/compiler/nativeGen/NCGMonad.hs
+++ b/compiler/nativeGen/NCGMonad.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE CPP #-}
+
 -- -----------------------------------------------------------------------------
 --
 -- (c) The University of Glasgow 1993-2004
@@ -23,7 +25,12 @@ module NCGMonad (
         getNewRegPairNat,
         getPicBaseMaybeNat,
         getPicBaseNat,
-        getDynFlags
+        getDynFlags,
+        getModLoc,
+        getFileId,
+        getDebugBlock,
+
+        DwarfFiles
 )
 
 where
@@ -36,6 +43,9 @@ import TargetReg
 
 import BlockId
 import CLabel           ( CLabel, mkAsmTempLabel )
+import Debug
+import FastString       ( FastString )
+import UniqFM
 import UniqSupply
 import Unique           ( Unique )
 import DynFlags
@@ -44,6 +54,8 @@ import Module
 import Control.Monad    ( liftM, ap )
 import Control.Applicative ( Applicative(..) )
 
+import Compiler.Hoopl   ( LabelMap, Label )
+
 data NatM_State
         = NatM_State {
                 natm_us          :: UniqSupply,
@@ -51,15 +63,20 @@ data NatM_State
                 natm_imports     :: [(CLabel)],
                 natm_pic         :: Maybe Reg,
                 natm_dflags      :: DynFlags,
-                natm_this_module :: Module
+                natm_this_module :: Module,
+                natm_modloc      :: ModLocation,
+                natm_fileid      :: DwarfFiles,
+                natm_debug_map   :: LabelMap DebugBlock
         }
 
+type DwarfFiles = UniqFM (FastString, Int)
+
 newtype NatM result = NatM (NatM_State -> (result, NatM_State))
 
 unNat :: NatM a -> NatM_State -> (a, NatM_State)
 unNat (NatM a) = a
 
-mkNatM_State :: UniqSupply -> Int -> DynFlags -> Module -> NatM_State
+mkNatM_State :: UniqSupply -> Int -> DynFlags -> Module -> ModLocation -> DwarfFiles -> LabelMap DebugBlock -> NatM_State
 mkNatM_State us delta dflags this_mod
         = NatM_State us delta [] Nothing dflags this_mod
 
@@ -170,3 +187,18 @@ getPicBaseNat rep
                  -> do
                         reg <- getNewRegNat rep
                         NatM (\state -> (reg, state { natm_pic = Just reg }))
+
+getModLoc :: NatM ModLocation
+getModLoc
+        = NatM $ \ st -> (natm_modloc st, st)
+
+getFileId :: FastString -> NatM Int
+getFileId f = NatM $ \st ->
+  case lookupUFM (natm_fileid st) f of
+    Just (_,n) -> (n, st)
+    Nothing    -> let n = 1 + sizeUFM (natm_fileid st)
+                      fids = addToUFM (natm_fileid st) f (f,n)
+                  in n `seq` fids `seq` (n, st { natm_fileid = fids  })
+
+getDebugBlock :: Label -> NatM (Maybe DebugBlock)
+getDebugBlock l = NatM $ \st -> (mapLookup l (natm_debug_map st), st)
diff --git a/compiler/nativeGen/PIC.hs b/compiler/nativeGen/PIC.hs
index f988bf73c77c..9b5c080b5b03 100644
--- a/compiler/nativeGen/PIC.hs
+++ b/compiler/nativeGen/PIC.hs
@@ -728,9 +728,10 @@ initializePicBase_ppc ArchPPC os picReg
 
             fetchPC (BasicBlock bID insns) =
               BasicBlock bID (PPC.FETCHPC picReg
+                              : PPC.ADDIS tmp picReg (PPC.HI offsetToOffset)
                               : PPC.LD PPC.archWordSize tmp
-                                   (PPC.AddrRegImm picReg offsetToOffset)
-                              : PPC.ADD picReg picReg (PPC.RIReg tmp)
+                                   (PPC.AddrRegImm tmp (PPC.LO offsetToOffset))
+                              : PPC.ADD picReg picReg (PPC.RIReg picReg)
                               : insns)
 
         return (CmmProc info lab live (ListGraph blocks') : gotOffset : statics)
diff --git a/compiler/nativeGen/PPC/CodeGen.hs b/compiler/nativeGen/PPC/CodeGen.hs
index 3f0e7632f8ef..f4203c6f1b2b 100644
--- a/compiler/nativeGen/PPC/CodeGen.hs
+++ b/compiler/nativeGen/PPC/CodeGen.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP, GADTs #-}
 
 -----------------------------------------------------------------------------
 --
@@ -12,7 +13,6 @@
 -- (c) the #if blah_TARGET_ARCH} things, the
 -- structure should not be too overwhelming.
 
-{-# LANGUAGE GADTs #-}
 module PPC.CodeGen (
         cmmTopCodeGen,
         generateJumpTableForInstr,
@@ -95,7 +95,8 @@ basicBlockCodeGen
                 , [NatCmmDecl CmmStatics Instr])
 
 basicBlockCodeGen block = do
-  let (CmmEntry id, nodes, tail)  = blockSplit block
+  let (_, nodes, tail)  = blockSplit block
+      id = entryLabel block
       stmts = blockToList nodes
   mid_instrs <- stmtsToInstrs stmts
   tail_instrs <- stmtToInstrs tail
@@ -125,6 +126,8 @@ stmtToInstrs stmt = do
   dflags <- getDynFlags
   case stmt of
     CmmComment s   -> return (unitOL (COMMENT s))
+    CmmTick {}     -> return nilOL
+    CmmUnwind {}   -> return nilOL
 
     CmmAssign reg src
       | isFloatType ty -> assignReg_FltCode size reg src
@@ -813,15 +816,6 @@ genBranch = return . toOL . mkJumpInstr
 Conditional jumps are always to local labels, so we can use branch
 instructions.  We peek at the arguments to decide what kind of
 comparison to do.
-
-SPARC: First, we have to ensure that the condition codes are set
-according to the supplied comparison operation.  We generate slightly
-different code for floating point comparisons, because a floating
-point operation cannot directly precede a @BF@.  We assume the worst
-and fill that slot with a @NOP@.
-
-SPARC: Do not fill the delay slots here; you will confuse the register
-allocator.
 -}
 
 
@@ -1160,6 +1154,12 @@ genCCall' dflags gcp target dest_regs args0
 
                     MO_BSwap w   -> (fsLit $ bSwapLabel w, False)
                     MO_PopCnt w  -> (fsLit $ popCntLabel w, False)
+                    MO_Clz w     -> (fsLit $ clzLabel w, False)
+                    MO_Ctz w     -> (fsLit $ ctzLabel w, False)
+                    MO_AtomicRMW w amop -> (fsLit $ atomicRMWLabel w amop, False)
+                    MO_Cmpxchg w -> (fsLit $ cmpxchgLabel w, False)
+                    MO_AtomicRead w  -> (fsLit $ atomicReadLabel w, False)
+                    MO_AtomicWrite w -> (fsLit $ atomicWriteLabel w, False)
 
                     MO_S_QuotRem {}  -> unsupported
                     MO_U_QuotRem {}  -> unsupported
diff --git a/compiler/nativeGen/PPC/Cond.hs b/compiler/nativeGen/PPC/Cond.hs
index b8c5208c660b..0e4b1fd7014e 100644
--- a/compiler/nativeGen/PPC/Cond.hs
+++ b/compiler/nativeGen/PPC/Cond.hs
@@ -1,17 +1,9 @@
-
-{-# OPTIONS -fno-warn-tabs #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and
--- detab the module (please do the detabbing in a separate patch). See
---     http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
--- for details
-
 module PPC.Cond (
-	Cond(..),
-	condNegate,
-	condUnsigned,
-	condToSigned,
-	condToUnsigned,
+        Cond(..),
+        condNegate,
+        condUnsigned,
+        condToSigned,
+        condToUnsigned,
 )
 
 where
@@ -19,18 +11,18 @@ where
 import Panic
 
 data Cond
-	= ALWAYS
-	| EQQ
-	| GE
-	| GEU
-	| GTT
-	| GU
-	| LE
-	| LEU
-	| LTT
-	| LU
-	| NE
-	deriving Eq
+        = ALWAYS
+        | EQQ
+        | GE
+        | GEU
+        | GTT
+        | GU
+        | LE
+        | LEU
+        | LTT
+        | LU
+        | NE
+        deriving Eq
 
 
 condNegate :: Cond -> Cond
diff --git a/compiler/nativeGen/PPC/Instr.hs b/compiler/nativeGen/PPC/Instr.hs
index ddb9c51c7bbf..3756c649bbf8 100644
--- a/compiler/nativeGen/PPC/Instr.hs
+++ b/compiler/nativeGen/PPC/Instr.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE CPP #-}
+
 -----------------------------------------------------------------------------
 --
 -- Machine-dependent assembly language
diff --git a/compiler/nativeGen/PPC/RegInfo.hs b/compiler/nativeGen/PPC/RegInfo.hs
index 8b35d875736a..c4724d4193ea 100644
--- a/compiler/nativeGen/PPC/RegInfo.hs
+++ b/compiler/nativeGen/PPC/RegInfo.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE CPP #-}
+
 -----------------------------------------------------------------------------
 --
 -- Machine-specific parts of the register allocator
@@ -5,20 +7,12 @@
 -- (c) The University of Glasgow 1996-2004
 --
 -----------------------------------------------------------------------------
-
-{-# OPTIONS -fno-warn-tabs #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and
--- detab the module (please do the detabbing in a separate patch). See
---     http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
--- for details
-
 module PPC.RegInfo (
         JumpDest( DestBlockId ), getJumpDestBlockId,
-	canShortcut, 
-	shortcutJump, 
+        canShortcut,
+        shortcutJump,
 
-	shortcutStatics
+        shortcutStatics
 )
 
 where
@@ -68,14 +62,13 @@ shortcutStatic fn (CmmStaticLit (CmmLabelDiffOff lbl1 lbl2 off))
 shortcutStatic _ other_static
         = other_static
 
-shortBlockId 
-	:: (BlockId -> Maybe JumpDest)
-	-> BlockId
-	-> CLabel
+shortBlockId
+        :: (BlockId -> Maybe JumpDest)
+        -> BlockId
+        -> CLabel
 
 shortBlockId fn blockid =
    case fn blockid of
       Nothing -> mkAsmTempLabel uq
       Just (DestBlockId blockid')  -> shortBlockId fn blockid'
    where uq = getUnique blockid
-
diff --git a/compiler/nativeGen/PPC/Regs.hs b/compiler/nativeGen/PPC/Regs.hs
index f92351bd22a0..0f636bf64c16 100644
--- a/compiler/nativeGen/PPC/Regs.hs
+++ b/compiler/nativeGen/PPC/Regs.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE CPP #-}
+
 -- -----------------------------------------------------------------------------
 --
 -- (c) The University of Glasgow 1994-2004
diff --git a/compiler/nativeGen/Reg.hs b/compiler/nativeGen/Reg.hs
index fee74be35513..862306f0bba9 100644
--- a/compiler/nativeGen/Reg.hs
+++ b/compiler/nativeGen/Reg.hs
@@ -1,36 +1,27 @@
-
 -- | An architecture independent description of a register.
---	This needs to stay architecture independent because it is used
---	by NCGMonad and the register allocators, which are shared
---	by all architectures.
+--      This needs to stay architecture independent because it is used
+--      by NCGMonad and the register allocators, which are shared
+--      by all architectures.
 --
-
-{-# OPTIONS -fno-warn-tabs #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and
--- detab the module (please do the detabbing in a separate patch). See
---     http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
--- for details
-
 module Reg (
-	RegNo,
-	Reg(..),
-	regPair,
-	regSingle,
-	isRealReg,	takeRealReg,
-	isVirtualReg,	takeVirtualReg,
-	
-	VirtualReg(..),
-	renameVirtualReg,
-	classOfVirtualReg,
-	getHiVirtualRegFromLo,
-	getHiVRegFromLo,
-
-	RealReg(..),
-	regNosOfRealReg,
-	realRegsAlias,
-	
-	liftPatchFnToRegReg
+        RegNo,
+        Reg(..),
+        regPair,
+        regSingle,
+        isRealReg,      takeRealReg,
+        isVirtualReg,   takeVirtualReg,
+
+        VirtualReg(..),
+        renameVirtualReg,
+        classOfVirtualReg,
+        getHiVirtualRegFromLo,
+        getHiVRegFromLo,
+
+        RealReg(..),
+        regNosOfRealReg,
+        realRegsAlias,
+
+        liftPatchFnToRegReg
 )
 
 where
@@ -41,68 +32,68 @@ import RegClass
 import Data.List
 
 -- | An identifier for a primitive real machine register.
-type RegNo 
-	= Int
+type RegNo
+        = Int
 
 -- VirtualRegs are virtual registers.  The register allocator will
--- 	eventually have to map them into RealRegs, or into spill slots.
+--      eventually have to map them into RealRegs, or into spill slots.
 --
--- 	VirtualRegs are allocated on the fly, usually to represent a single
--- 	value in the abstract assembly code (i.e. dynamic registers are
--- 	usually single assignment).  
+--      VirtualRegs are allocated on the fly, usually to represent a single
+--      value in the abstract assembly code (i.e. dynamic registers are
+--      usually single assignment).
 --
---	The  single assignment restriction isn't necessary to get correct code,
--- 	although a better register allocation will result if single
--- 	assignment is used -- because the allocator maps a VirtualReg into
--- 	a single RealReg, even if the VirtualReg has multiple live ranges.
+--      The  single assignment restriction isn't necessary to get correct code,
+--      although a better register allocation will result if single
+--      assignment is used -- because the allocator maps a VirtualReg into
+--      a single RealReg, even if the VirtualReg has multiple live ranges.
 --
--- 	Virtual regs can be of either class, so that info is attached.
+--      Virtual regs can be of either class, so that info is attached.
 --
 data VirtualReg
-	= VirtualRegI  {-# UNPACK #-} !Unique
-	| VirtualRegHi {-# UNPACK #-} !Unique  -- High part of 2-word register
-	| VirtualRegF  {-# UNPACK #-} !Unique
-	| VirtualRegD  {-# UNPACK #-} !Unique
-	| VirtualRegSSE {-# UNPACK #-} !Unique
-	deriving (Eq, Show, Ord)
+        = VirtualRegI  {-# UNPACK #-} !Unique
+        | VirtualRegHi {-# UNPACK #-} !Unique  -- High part of 2-word register
+        | VirtualRegF  {-# UNPACK #-} !Unique
+        | VirtualRegD  {-# UNPACK #-} !Unique
+        | VirtualRegSSE {-# UNPACK #-} !Unique
+        deriving (Eq, Show, Ord)
 
 instance Uniquable VirtualReg where
-	getUnique reg
-	 = case reg of
-	 	VirtualRegI u	-> u
-		VirtualRegHi u	-> u
-		VirtualRegF u	-> u
-		VirtualRegD u	-> u
-		VirtualRegSSE u	-> u
+        getUnique reg
+         = case reg of
+                VirtualRegI u   -> u
+                VirtualRegHi u  -> u
+                VirtualRegF u   -> u
+                VirtualRegD u   -> u
+                VirtualRegSSE u -> u
 
 instance Outputable VirtualReg where
-	ppr reg
-	 = case reg of
-		VirtualRegI  u  -> text "%vI_" 	<> pprUnique u
-		VirtualRegHi u  -> text "%vHi_" <> pprUnique u
-		VirtualRegF  u  -> text "%vF_" 	<> pprUnique u
-		VirtualRegD  u  -> text "%vD_" 	<> pprUnique u
-		VirtualRegSSE u -> text "%vSSE_" <> pprUnique u
+        ppr reg
+         = case reg of
+                VirtualRegI  u  -> text "%vI_"  <> pprUnique u
+                VirtualRegHi u  -> text "%vHi_" <> pprUnique u
+                VirtualRegF  u  -> text "%vF_"  <> pprUnique u
+                VirtualRegD  u  -> text "%vD_"  <> pprUnique u
+                VirtualRegSSE u -> text "%vSSE_" <> pprUnique u
 
 
 renameVirtualReg :: Unique -> VirtualReg -> VirtualReg
 renameVirtualReg u r
  = case r of
-	VirtualRegI _	-> VirtualRegI  u
-	VirtualRegHi _	-> VirtualRegHi u
-	VirtualRegF _	-> VirtualRegF  u
-	VirtualRegD _	-> VirtualRegD  u
-	VirtualRegSSE _	-> VirtualRegSSE u
+        VirtualRegI _   -> VirtualRegI  u
+        VirtualRegHi _  -> VirtualRegHi u
+        VirtualRegF _   -> VirtualRegF  u
+        VirtualRegD _   -> VirtualRegD  u
+        VirtualRegSSE _ -> VirtualRegSSE u
 
 
 classOfVirtualReg :: VirtualReg -> RegClass
 classOfVirtualReg vr
  = case vr of
- 	VirtualRegI{}	-> RcInteger
-	VirtualRegHi{}	-> RcInteger
-	VirtualRegF{}	-> RcFloat
-	VirtualRegD{}	-> RcDouble
-	VirtualRegSSE{}	-> RcDoubleSSE
+        VirtualRegI{}   -> RcInteger
+        VirtualRegHi{}  -> RcInteger
+        VirtualRegF{}   -> RcFloat
+        VirtualRegD{}   -> RcDouble
+        VirtualRegSSE{} -> RcDoubleSSE
 
 
 -- Determine the upper-half vreg for a 64-bit quantity on a 32-bit platform
@@ -111,118 +102,116 @@ classOfVirtualReg vr
 getHiVirtualRegFromLo :: VirtualReg -> VirtualReg
 getHiVirtualRegFromLo reg
  = case reg of
-	-- makes a pseudo-unique with tag 'H'
- 	VirtualRegI u	-> VirtualRegHi (newTagUnique u 'H') 
-	_		-> panic "Reg.getHiVirtualRegFromLo"
+        -- makes a pseudo-unique with tag 'H'
+        VirtualRegI u   -> VirtualRegHi (newTagUnique u 'H')
+        _               -> panic "Reg.getHiVirtualRegFromLo"
 
 getHiVRegFromLo :: Reg -> Reg
 getHiVRegFromLo reg
  = case reg of
- 	RegVirtual  vr	-> RegVirtual (getHiVirtualRegFromLo vr)
-	RegReal _	-> panic "Reg.getHiVRegFromLo"
- 	
+        RegVirtual  vr  -> RegVirtual (getHiVirtualRegFromLo vr)
+        RegReal _       -> panic "Reg.getHiVRegFromLo"
+
 
 ------------------------------------------------------------------------------------
 -- | RealRegs are machine regs which are available for allocation, in
--- 	the usual way.  We know what class they are, because that's part of
--- 	the processor's architecture.
+--      the usual way.  We know what class they are, because that's part of
+--      the processor's architecture.
 --
--- 	RealRegPairs are pairs of real registers that are allocated together
---	to hold a larger value, such as with Double regs on SPARC.
+--      RealRegPairs are pairs of real registers that are allocated together
+--      to hold a larger value, such as with Double regs on SPARC.
 --
 data RealReg
-	= RealRegSingle	{-# UNPACK #-} !RegNo
-	| RealRegPair	{-# UNPACK #-} !RegNo {-# UNPACK #-} !RegNo
-	deriving (Eq, Show, Ord)
+        = RealRegSingle {-# UNPACK #-} !RegNo
+        | RealRegPair   {-# UNPACK #-} !RegNo {-# UNPACK #-} !RegNo
+        deriving (Eq, Show, Ord)
 
 instance Uniquable RealReg where
-	getUnique reg
-	 = case reg of
-	 	RealRegSingle i		-> mkRegSingleUnique i
-		RealRegPair r1 r2	-> mkRegPairUnique (r1 * 65536 + r2)
+        getUnique reg
+         = case reg of
+                RealRegSingle i         -> mkRegSingleUnique i
+                RealRegPair r1 r2       -> mkRegPairUnique (r1 * 65536 + r2)
 
 instance Outputable RealReg where
-	ppr reg
-	 = case reg of
-	 	RealRegSingle i		-> text "%r" 	<> int i
-		RealRegPair r1 r2	-> text "%r(" <> int r1 <> text "|" <> int r2 <> text ")"
+        ppr reg
+         = case reg of
+                RealRegSingle i         -> text "%r"    <> int i
+                RealRegPair r1 r2       -> text "%r(" <> int r1 <> text "|" <> int r2 <> text ")"
 
 regNosOfRealReg :: RealReg -> [RegNo]
 regNosOfRealReg rr
  = case rr of
- 	RealRegSingle r1	-> [r1]
-	RealRegPair   r1 r2	-> [r1, r2]
-	
+        RealRegSingle r1        -> [r1]
+        RealRegPair   r1 r2     -> [r1, r2]
+
 
 realRegsAlias :: RealReg -> RealReg -> Bool
 realRegsAlias rr1 rr2
-	= not $ null $ intersect (regNosOfRealReg rr1) (regNosOfRealReg rr2)
+        = not $ null $ intersect (regNosOfRealReg rr1) (regNosOfRealReg rr2)
 
 --------------------------------------------------------------------------------
 -- | A register, either virtual or real
 data Reg
-	= RegVirtual !VirtualReg
-	| RegReal    !RealReg
-	deriving (Eq, Ord)
+        = RegVirtual !VirtualReg
+        | RegReal    !RealReg
+        deriving (Eq, Ord)
 
 regSingle :: RegNo -> Reg
-regSingle regNo		= RegReal $ RealRegSingle regNo
+regSingle regNo         = RegReal $ RealRegSingle regNo
 
 regPair :: RegNo -> RegNo -> Reg
-regPair regNo1 regNo2	= RegReal $ RealRegPair regNo1 regNo2
+regPair regNo1 regNo2   = RegReal $ RealRegPair regNo1 regNo2
 
 
--- We like to have Uniques for Reg so that we can make UniqFM and UniqSets 
+-- We like to have Uniques for Reg so that we can make UniqFM and UniqSets
 -- in the register allocator.
 instance Uniquable Reg where
-	getUnique reg
-	 = case reg of
-	 	RegVirtual vr	-> getUnique vr
-		RegReal    rr	-> getUnique rr
-	
+        getUnique reg
+         = case reg of
+                RegVirtual vr   -> getUnique vr
+                RegReal    rr   -> getUnique rr
+
 -- | Print a reg in a generic manner
---	If you want the architecture specific names, then use the pprReg 
---	function from the appropriate Ppr module.
+--      If you want the architecture specific names, then use the pprReg
+--      function from the appropriate Ppr module.
 instance Outputable Reg where
-	ppr reg
-	 = case reg of
-	 	RegVirtual vr	-> ppr vr
-		RegReal    rr	-> ppr rr
+        ppr reg
+         = case reg of
+                RegVirtual vr   -> ppr vr
+                RegReal    rr   -> ppr rr
 
 
 isRealReg :: Reg -> Bool
-isRealReg reg 
+isRealReg reg
  = case reg of
- 	RegReal _	-> True
-	RegVirtual _	-> False
+        RegReal _       -> True
+        RegVirtual _    -> False
 
 takeRealReg :: Reg -> Maybe RealReg
 takeRealReg reg
  = case reg of
- 	RegReal rr	-> Just rr
-	_		-> Nothing
+        RegReal rr      -> Just rr
+        _               -> Nothing
 
 
 isVirtualReg :: Reg -> Bool
 isVirtualReg reg
  = case reg of
- 	RegReal _	-> False
-	RegVirtual _	-> True
+        RegReal _       -> False
+        RegVirtual _    -> True
 
 takeVirtualReg :: Reg -> Maybe VirtualReg
 takeVirtualReg reg
  = case reg of
- 	RegReal _	-> Nothing
-	RegVirtual vr	-> Just vr
+        RegReal _       -> Nothing
+        RegVirtual vr   -> Just vr
 
 
 -- | The patch function supplied by the allocator maps VirtualReg to RealReg
---	regs, but sometimes we want to apply it to plain old Reg.
+--      regs, but sometimes we want to apply it to plain old Reg.
 --
 liftPatchFnToRegReg  :: (VirtualReg -> RealReg) -> (Reg -> Reg)
 liftPatchFnToRegReg patchF reg
  = case reg of
- 	RegVirtual vr	-> RegReal (patchF vr)
-	RegReal _	-> reg
-	
-
+        RegVirtual vr   -> RegReal (patchF vr)
+        RegReal _       -> reg
diff --git a/compiler/nativeGen/RegAlloc/Graph/Main.hs b/compiler/nativeGen/RegAlloc/Graph/Main.hs
index dbaf5098ceb8..05db68dd463e 100644
--- a/compiler/nativeGen/RegAlloc/Graph/Main.hs
+++ b/compiler/nativeGen/RegAlloc/Graph/Main.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+
 -- | Graph coloring register allocator.
 module RegAlloc.Graph.Main (
         regAlloc
diff --git a/compiler/nativeGen/RegAlloc/Graph/Stats.hs b/compiler/nativeGen/RegAlloc/Graph/Stats.hs
index 7bc842d1c9d3..8fada96ee25b 100644
--- a/compiler/nativeGen/RegAlloc/Graph/Stats.hs
+++ b/compiler/nativeGen/RegAlloc/Graph/Stats.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE BangPatterns, CPP #-}
 
 -- | Carries interesting info for debugging / profiling of the
 --   graph coloring register allocator.
diff --git a/compiler/nativeGen/RegAlloc/Graph/TrivColorable.hs b/compiler/nativeGen/RegAlloc/Graph/TrivColorable.hs
index df3c7d6d41f2..eba2e4314995 100644
--- a/compiler/nativeGen/RegAlloc/Graph/TrivColorable.hs
+++ b/compiler/nativeGen/RegAlloc/Graph/TrivColorable.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE BangPatterns, CPP #-}
 
 module RegAlloc.Graph.TrivColorable (
         trivColorable,
@@ -30,7 +30,7 @@ import Panic
 --              (which are disjoint) ie. x86, x86_64 and ppc
 --
 --      The number of allocatable regs is hard coded in here so we can do
---              a fast comparision in trivColorable.
+--              a fast comparison in trivColorable.
 --
 --      It's ok if these numbers are _less_ than the actual number of free
 --              regs, but they can't be more or the register conflict
@@ -113,6 +113,7 @@ trivColorable platform virtualRegSqueeze realRegSqueeze RcInteger conflicts excl
                             ArchSPARC     -> 14
                             ArchPPC_64    -> panic "trivColorable ArchPPC_64"
                             ArchARM _ _ _ -> panic "trivColorable ArchARM"
+                            ArchARM64     -> panic "trivColorable ArchARM64"
                             ArchAlpha     -> panic "trivColorable ArchAlpha"
                             ArchMipseb    -> panic "trivColorable ArchMipseb"
                             ArchMipsel    -> panic "trivColorable ArchMipsel"
@@ -137,6 +138,7 @@ trivColorable platform virtualRegSqueeze realRegSqueeze RcFloat conflicts exclus
                             ArchSPARC     -> 22
                             ArchPPC_64    -> panic "trivColorable ArchPPC_64"
                             ArchARM _ _ _ -> panic "trivColorable ArchARM"
+                            ArchARM64     -> panic "trivColorable ArchARM64"
                             ArchAlpha     -> panic "trivColorable ArchAlpha"
                             ArchMipseb    -> panic "trivColorable ArchMipseb"
                             ArchMipsel    -> panic "trivColorable ArchMipsel"
@@ -161,6 +163,7 @@ trivColorable platform virtualRegSqueeze realRegSqueeze RcDouble conflicts exclu
                             ArchSPARC     -> 11
                             ArchPPC_64    -> panic "trivColorable ArchPPC_64"
                             ArchARM _ _ _ -> panic "trivColorable ArchARM"
+                            ArchARM64     -> panic "trivColorable ArchARM64"
                             ArchAlpha     -> panic "trivColorable ArchAlpha"
                             ArchMipseb    -> panic "trivColorable ArchMipseb"
                             ArchMipsel    -> panic "trivColorable ArchMipsel"
@@ -185,6 +188,7 @@ trivColorable platform virtualRegSqueeze realRegSqueeze RcDoubleSSE conflicts ex
                             ArchSPARC     -> 0
                             ArchPPC_64    -> panic "trivColorable ArchPPC_64"
                             ArchARM _ _ _ -> panic "trivColorable ArchARM"
+                            ArchARM64     -> panic "trivColorable ArchARM64"
                             ArchAlpha     -> panic "trivColorable ArchAlpha"
                             ArchMipseb    -> panic "trivColorable ArchMipseb"
                             ArchMipsel    -> panic "trivColorable ArchMipsel"
diff --git a/compiler/nativeGen/RegAlloc/Linear/FreeRegs.hs b/compiler/nativeGen/RegAlloc/Linear/FreeRegs.hs
index 557d713fe36f..a1a00ba5829f 100644
--- a/compiler/nativeGen/RegAlloc/Linear/FreeRegs.hs
+++ b/compiler/nativeGen/RegAlloc/Linear/FreeRegs.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 
 module RegAlloc.Linear.FreeRegs (
     FR(..),
@@ -74,6 +75,7 @@ maxSpillSlots dflags
                 ArchPPC       -> PPC.Instr.maxSpillSlots dflags
                 ArchSPARC     -> SPARC.Instr.maxSpillSlots dflags
                 ArchARM _ _ _ -> panic "maxSpillSlots ArchARM"
+                ArchARM64     -> panic "maxSpillSlots ArchARM64"
                 ArchPPC_64    -> panic "maxSpillSlots ArchPPC_64"
                 ArchAlpha     -> panic "maxSpillSlots ArchAlpha"
                 ArchMipseb    -> panic "maxSpillSlots ArchMipseb"
diff --git a/compiler/nativeGen/RegAlloc/Linear/Main.hs b/compiler/nativeGen/RegAlloc/Linear/Main.hs
index 6ac19dad40c7..9b4fe7b8a047 100644
--- a/compiler/nativeGen/RegAlloc/Linear/Main.hs
+++ b/compiler/nativeGen/RegAlloc/Linear/Main.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE CPP, ScopedTypeVariables #-}
+
 -----------------------------------------------------------------------------
 --
 -- The register allocator
@@ -156,11 +158,11 @@ regAlloc _ (CmmProc (LiveInfo info _ _ _) lbl live [])
                  , Nothing )
 
 regAlloc dflags (CmmProc static lbl live sccs)
-        | LiveInfo info (Just first_id) (Just block_live) _     <- static
+        | LiveInfo info entry_ids@(first_id:_) (Just block_live) _ <- static
         = do
                 -- do register allocation on each component.
                 (final_blocks, stats, stack_use)
-                        <- linearRegAlloc dflags first_id block_live sccs
+                        <- linearRegAlloc dflags entry_ids block_live sccs
 
                 -- make sure the block that was first in the input list
                 --      stays at the front of the output
@@ -194,45 +196,50 @@ regAlloc _ (CmmProc _ _ _ _)
 linearRegAlloc
         :: (Outputable instr, Instruction instr)
         => DynFlags
-        -> BlockId                      -- ^ the first block
-        -> BlockMap RegSet              -- ^ live regs on entry to each basic block
-        -> [SCC (LiveBasicBlock instr)] -- ^ instructions annotated with "deaths"
+        -> [BlockId] -- ^ entry points
+        -> BlockMap RegSet
+              -- ^ live regs on entry to each basic block
+        -> [SCC (LiveBasicBlock instr)]
+              -- ^ instructions annotated with "deaths"
         -> UniqSM ([NatBasicBlock instr], RegAllocStats, Int)
 
-linearRegAlloc dflags first_id block_live sccs
- = let platform = targetPlatform dflags
-   in case platformArch platform of
-      ArchX86       -> linearRegAlloc' dflags (frInitFreeRegs platform :: X86.FreeRegs)    first_id block_live sccs
-      ArchX86_64    -> linearRegAlloc' dflags (frInitFreeRegs platform :: X86_64.FreeRegs) first_id block_live sccs
-      ArchSPARC     -> linearRegAlloc' dflags (frInitFreeRegs platform :: SPARC.FreeRegs)  first_id block_live sccs
-      ArchPPC       -> linearRegAlloc' dflags (frInitFreeRegs platform :: PPC.FreeRegs)    first_id block_live sccs
-      ArchARM _ _ _ -> panic "linearRegAlloc ArchARM"
-      ArchPPC_64    -> panic "linearRegAlloc ArchPPC_64"
-      ArchAlpha     -> panic "linearRegAlloc ArchAlpha"
-      ArchMipseb    -> panic "linearRegAlloc ArchMipseb"
-      ArchMipsel    -> panic "linearRegAlloc ArchMipsel"
+linearRegAlloc dflags entry_ids block_live sccs
+ = case platformArch platform of
+      ArchX86        -> go $ (frInitFreeRegs platform :: X86.FreeRegs)
+      ArchX86_64     -> go $ (frInitFreeRegs platform :: X86_64.FreeRegs)
+      ArchSPARC      -> go $ (frInitFreeRegs platform :: SPARC.FreeRegs)
+      ArchPPC        -> go $ (frInitFreeRegs platform :: PPC.FreeRegs)
+      ArchARM _ _ _  -> panic "linearRegAlloc ArchARM"
+      ArchARM64      -> panic "linearRegAlloc ArchARM64"
+      ArchPPC_64     -> panic "linearRegAlloc ArchPPC_64"
+      ArchAlpha      -> panic "linearRegAlloc ArchAlpha"
+      ArchMipseb     -> panic "linearRegAlloc ArchMipseb"
+      ArchMipsel     -> panic "linearRegAlloc ArchMipsel"
       ArchJavaScript -> panic "linearRegAlloc ArchJavaScript"
-      ArchUnknown   -> panic "linearRegAlloc ArchUnknown"
+      ArchUnknown    -> panic "linearRegAlloc ArchUnknown"
+ where
+  go f = linearRegAlloc' dflags f entry_ids block_live sccs
+  platform = targetPlatform dflags
 
 linearRegAlloc'
         :: (FR freeRegs, Outputable instr, Instruction instr)
         => DynFlags
         -> freeRegs
-        -> BlockId                      -- ^ the first block
+        -> [BlockId]                    -- ^ entry points
         -> BlockMap RegSet              -- ^ live regs on entry to each basic block
         -> [SCC (LiveBasicBlock instr)] -- ^ instructions annotated with "deaths"
         -> UniqSM ([NatBasicBlock instr], RegAllocStats, Int)
 
-linearRegAlloc' dflags initFreeRegs first_id block_live sccs
+linearRegAlloc' dflags initFreeRegs entry_ids block_live sccs
  = do   us      <- getUs
         let (_, stack, stats, blocks) =
                 runR dflags emptyBlockMap initFreeRegs emptyRegMap (emptyStackMap dflags) us
-                    $ linearRA_SCCs first_id block_live [] sccs
+                    $ linearRA_SCCs entry_ids block_live [] sccs
         return  (blocks, stats, getStackUse stack)
 
 
 linearRA_SCCs :: (FR freeRegs, Instruction instr, Outputable instr)
-              => BlockId
+              => [BlockId]
               -> BlockMap RegSet
               -> [NatBasicBlock instr]
               -> [SCC (LiveBasicBlock instr)]
@@ -241,16 +248,16 @@ linearRA_SCCs :: (FR freeRegs, Instruction instr, Outputable instr)
 linearRA_SCCs _ _ blocksAcc []
         = return $ reverse blocksAcc
 
-linearRA_SCCs first_id block_live blocksAcc (AcyclicSCC block : sccs)
+linearRA_SCCs entry_ids block_live blocksAcc (AcyclicSCC block : sccs)
  = do   blocks' <- processBlock block_live block
-        linearRA_SCCs first_id block_live
+        linearRA_SCCs entry_ids block_live
                 ((reverse blocks') ++ blocksAcc)
                 sccs
 
-linearRA_SCCs first_id block_live blocksAcc (CyclicSCC blocks : sccs)
+linearRA_SCCs entry_ids block_live blocksAcc (CyclicSCC blocks : sccs)
  = do
-        blockss' <- process first_id block_live blocks [] (return []) False
-        linearRA_SCCs first_id block_live
+        blockss' <- process entry_ids block_live blocks [] (return []) False
+        linearRA_SCCs entry_ids block_live
                 (reverse (concat blockss') ++ blocksAcc)
                 sccs
 
@@ -267,7 +274,7 @@ linearRA_SCCs first_id block_live blocksAcc (CyclicSCC blocks : sccs)
 -}
 
 process :: (FR freeRegs, Instruction instr, Outputable instr)
-        => BlockId
+        => [BlockId]
         -> BlockMap RegSet
         -> [GenBasicBlock (LiveInstr instr)]
         -> [GenBasicBlock (LiveInstr instr)]
@@ -278,7 +285,7 @@ process :: (FR freeRegs, Instruction instr, Outputable instr)
 process _ _ [] []         accum _
         = return $ reverse accum
 
-process first_id block_live [] next_round accum madeProgress
+process entry_ids block_live [] next_round accum madeProgress
         | not madeProgress
 
           {- BUGS: There are so many unreachable blocks in the code the warnings are overwhelming.
@@ -288,22 +295,22 @@ process first_id block_live [] next_round accum madeProgress
         = return $ reverse accum
 
         | otherwise
-        = process first_id block_live
+        = process entry_ids block_live
                   next_round [] accum False
 
-process first_id block_live (b@(BasicBlock id _) : blocks)
+process entry_ids block_live (b@(BasicBlock id _) : blocks)
         next_round accum madeProgress
  = do
         block_assig <- getBlockAssigR
 
         if isJust (mapLookup id block_assig)
-             || id == first_id
+             || id `elem` entry_ids
          then do
                 b'  <- processBlock block_live b
-                process first_id block_live blocks
+                process entry_ids block_live blocks
                         next_round (b' : accum) True
 
-         else   process first_id block_live blocks
+         else   process entry_ids block_live blocks
                         (b : next_round) accum madeProgress
 
 
@@ -394,9 +401,9 @@ raInsn _     new_instrs _ (LiveInstr ii Nothing)
         = do    setDeltaR n
                 return (new_instrs, [])
 
-raInsn _     new_instrs _ (LiveInstr ii Nothing)
+raInsn _     new_instrs _ (LiveInstr ii@(Instr i) Nothing)
         | isMetaInstr ii
-        = return (new_instrs, [])
+        = return (i : new_instrs, [])
 
 
 raInsn block_live new_instrs id (LiveInstr (Instr instr) (Just live))
diff --git a/compiler/nativeGen/RegAlloc/Linear/PPC/FreeRegs.hs b/compiler/nativeGen/RegAlloc/Linear/PPC/FreeRegs.hs
index 0bdb49fb2ee5..b76fe79d7dbb 100644
--- a/compiler/nativeGen/RegAlloc/Linear/PPC/FreeRegs.hs
+++ b/compiler/nativeGen/RegAlloc/Linear/PPC/FreeRegs.hs
@@ -1,4 +1,3 @@
-
 -- | Free regs map for PowerPC
 module RegAlloc.Linear.PPC.FreeRegs
 where
diff --git a/compiler/nativeGen/RegAlloc/Linear/State.hs b/compiler/nativeGen/RegAlloc/Linear/State.hs
index dc499c9c1f62..39b5777ef32e 100644
--- a/compiler/nativeGen/RegAlloc/Linear/State.hs
+++ b/compiler/nativeGen/RegAlloc/Linear/State.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE UnboxedTuples #-}
+
 -- | State monad for the linear register allocator.
 
 --      Here we keep all the state that the register allocator keeps track
diff --git a/compiler/nativeGen/RegAlloc/Liveness.hs b/compiler/nativeGen/RegAlloc/Liveness.hs
index 6dd4cec0de5b..d7fd8bdcb40b 100644
--- a/compiler/nativeGen/RegAlloc/Liveness.hs
+++ b/compiler/nativeGen/RegAlloc/Liveness.hs
@@ -1,3 +1,8 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeFamilies #-}
+
 -----------------------------------------------------------------------------
 --
 -- The register liveness determinator
@@ -5,6 +10,7 @@
 -- (c) The University of Glasgow 2004-2013
 --
 -----------------------------------------------------------------------------
+
 module RegAlloc.Liveness (
         RegSet,
         RegMap, emptyRegMap,
@@ -163,10 +169,11 @@ data Liveness
 -- | Stash regs live on entry to each basic block in the info part of the cmm code.
 data LiveInfo
         = LiveInfo
-                (BlockEnv CmmStatics)                   -- cmm info table static stuff
-                (Maybe BlockId)                         -- id of the first block
-                (Maybe (BlockMap RegSet))               -- argument locals live on entry to this block
-                (Map BlockId (Set Int))                 -- stack slots live on entry to this block
+                (BlockEnv CmmStatics)     -- cmm info table static stuff
+                [BlockId]                 -- entry points (first one is the
+                                          -- entry point for the proc).
+                (Maybe (BlockMap RegSet)) -- argument locals live on entry to this block
+                (Map BlockId (Set Int))   -- stack slots live on entry to this block
 
 
 -- | A basic block with liveness information.
@@ -217,9 +224,9 @@ instance Outputable instr
                  | otherwise            = name <> (hcat $ punctuate space $ map ppr $ uniqSetToList regs)
 
 instance Outputable LiveInfo where
-    ppr (LiveInfo mb_static firstId liveVRegsOnEntry liveSlotsOnEntry)
+    ppr (LiveInfo mb_static entryIds liveVRegsOnEntry liveSlotsOnEntry)
         =  (ppr mb_static)
-        $$ text "# firstId          = " <> ppr firstId
+        $$ text "# entryIds         = " <> ppr entryIds
         $$ text "# liveVRegsOnEntry = " <> ppr liveVRegsOnEntry
         $$ text "# liveSlotsOnEntry = " <> text (show liveSlotsOnEntry)
 
@@ -474,7 +481,7 @@ stripLive dflags live
  where  stripCmm :: (Outputable statics, Outputable instr, Instruction instr)
                  => LiveCmmDecl statics instr -> NatCmmDecl statics instr
         stripCmm (CmmData sec ds)       = CmmData sec ds
-        stripCmm (CmmProc (LiveInfo info (Just first_id) _ _) label live sccs)
+        stripCmm (CmmProc (LiveInfo info (first_id:_) _ _) label live sccs)
          = let  final_blocks    = flattenSCCs sccs
 
                 -- make sure the block that was first in the input list
@@ -487,7 +494,7 @@ stripLive dflags live
                           (ListGraph $ map (stripLiveBlock dflags) $ first' : rest')
 
         -- procs used for stg_split_markers don't contain any blocks, and have no first_id.
-        stripCmm (CmmProc (LiveInfo info Nothing _ _) label live [])
+        stripCmm (CmmProc (LiveInfo info [] _ _) label live [])
          =      CmmProc info label live (ListGraph [])
 
         -- If the proc has blocks but we don't know what the first one was, then we're dead.
@@ -635,16 +642,19 @@ natCmmTopToLive (CmmData i d)
         = CmmData i d
 
 natCmmTopToLive (CmmProc info lbl live (ListGraph []))
-        = CmmProc (LiveInfo info Nothing Nothing Map.empty) lbl live []
+        = CmmProc (LiveInfo info [] Nothing Map.empty) lbl live []
 
 natCmmTopToLive proc@(CmmProc info lbl live (ListGraph blocks@(first : _)))
  = let  first_id        = blockId first
-        sccs            = sccBlocks blocks (entryBlocks proc)
+        all_entry_ids   = entryBlocks proc
+        sccs            = sccBlocks blocks all_entry_ids
+        entry_ids       = filter (/= first_id) all_entry_ids
         sccsLive        = map (fmap (\(BasicBlock l instrs) ->
                                         BasicBlock l (map (\i -> LiveInstr (Instr i) Nothing) instrs)))
                         $ sccs
 
-   in   CmmProc (LiveInfo info (Just first_id) Nothing Map.empty) lbl live sccsLive
+   in   CmmProc (LiveInfo info (first_id : entry_ids) Nothing Map.empty)
+                lbl live sccsLive
 
 
 --
@@ -665,14 +675,20 @@ sccBlocks
 
 sccBlocks blocks entries = map (fmap get_node) sccs
   where
-        sccs = stronglyConnCompFromG graph roots
-
-        graph = graphFromEdgedVertices nodes
-
         -- nodes :: [(NatBasicBlock instr, Unique, [Unique])]
         nodes = [ (block, id, getOutEdges instrs)
                 | block@(BasicBlock id instrs) <- blocks ]
 
+        g1 = graphFromEdgedVertices nodes
+
+        reachable :: BlockSet
+        reachable = setFromList [ id | (_,id,_) <- reachablesG g1 roots ]
+
+        g2 = graphFromEdgedVertices [ node | node@(_,id,_) <- nodes
+                                           , id `setMember` reachable ]
+
+        sccs = stronglyConnCompG g2
+
         get_node (n, _, _) = n
 
         getOutEdges :: Instruction instr => [instr] -> [BlockId]
diff --git a/compiler/nativeGen/RegClass.hs b/compiler/nativeGen/RegClass.hs
index 7ccc0c1bec93..0c793173cbc0 100644
--- a/compiler/nativeGen/RegClass.hs
+++ b/compiler/nativeGen/RegClass.hs
@@ -1,41 +1,33 @@
-{-# OPTIONS -fno-warn-tabs #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and
--- detab the module (please do the detabbing in a separate patch). See
---     http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
--- for details
-
-
 -- | An architecture independent description of a register's class.
-module RegClass 
-	( RegClass (..) )
+module RegClass
+        ( RegClass (..) )
 
 where
 
-import	Outputable
-import	Unique
+import  Outputable
+import  Unique
 
 
--- | The class of a register. 
---	Used in the register allocator.
---	We treat all registers in a class as being interchangable.
+-- | The class of a register.
+--      Used in the register allocator.
+--      We treat all registers in a class as being interchangable.
 --
-data RegClass 
-	= RcInteger 
-	| RcFloat
-	| RcDouble
-	| RcDoubleSSE -- x86 only: the SSE regs are a separate class
-	deriving Eq
+data RegClass
+        = RcInteger
+        | RcFloat
+        | RcDouble
+        | RcDoubleSSE -- x86 only: the SSE regs are a separate class
+        deriving Eq
 
 
 instance Uniquable RegClass where
-    getUnique RcInteger	= mkRegClassUnique 0
-    getUnique RcFloat	= mkRegClassUnique 1
-    getUnique RcDouble	= mkRegClassUnique 2
+    getUnique RcInteger = mkRegClassUnique 0
+    getUnique RcFloat   = mkRegClassUnique 1
+    getUnique RcDouble  = mkRegClassUnique 2
     getUnique RcDoubleSSE = mkRegClassUnique 3
 
 instance Outputable RegClass where
-    ppr RcInteger	= Outputable.text "I"
-    ppr RcFloat		= Outputable.text "F"
-    ppr RcDouble	= Outputable.text "D"
-    ppr RcDoubleSSE	= Outputable.text "S"
+    ppr RcInteger       = Outputable.text "I"
+    ppr RcFloat         = Outputable.text "F"
+    ppr RcDouble        = Outputable.text "D"
+    ppr RcDoubleSSE     = Outputable.text "S"
diff --git a/compiler/nativeGen/SPARC/CodeGen.hs b/compiler/nativeGen/SPARC/CodeGen.hs
index 5d65b427e13a..6854479cf1aa 100644
--- a/compiler/nativeGen/SPARC/CodeGen.hs
+++ b/compiler/nativeGen/SPARC/CodeGen.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE CPP #-}
+
 -----------------------------------------------------------------------------
 --
 -- Generating machine code (instruction selection)
@@ -85,7 +87,8 @@ basicBlockCodeGen :: CmmBlock
                           , [NatCmmDecl CmmStatics Instr])
 
 basicBlockCodeGen block = do
-  let (CmmEntry id, nodes, tail)  = blockSplit block
+  let (_, nodes, tail)  = blockSplit block
+      id = entryLabel block
       stmts = blockToList nodes
   mid_instrs <- stmtsToInstrs stmts
   tail_instrs <- stmtToInstrs tail
@@ -123,6 +126,8 @@ stmtToInstrs stmt = do
   dflags <- getDynFlags
   case stmt of
     CmmComment s   -> return (unitOL (COMMENT s))
+    CmmTick {}     -> return nilOL
+    CmmUnwind {}   -> return nilOL
 
     CmmAssign reg src
       | isFloatType ty  -> assignReg_FltCode size reg src
@@ -652,6 +657,12 @@ outOfLineMachOp_table mop
 
         MO_BSwap w   -> fsLit $ bSwapLabel w
         MO_PopCnt w  -> fsLit $ popCntLabel w
+        MO_Clz w     -> fsLit $ clzLabel w
+        MO_Ctz w     -> fsLit $ ctzLabel w
+        MO_AtomicRMW w amop -> fsLit $ atomicRMWLabel w amop
+        MO_Cmpxchg w -> fsLit $ cmpxchgLabel w
+        MO_AtomicRead w -> fsLit $ atomicReadLabel w
+        MO_AtomicWrite w -> fsLit $ atomicWriteLabel w
 
         MO_S_QuotRem {}  -> unsupported
         MO_U_QuotRem {}  -> unsupported
diff --git a/compiler/nativeGen/SPARC/CodeGen/Amode.hs b/compiler/nativeGen/SPARC/CodeGen/Amode.hs
index 324eda94e75e..8d9a303f2f4e 100644
--- a/compiler/nativeGen/SPARC/CodeGen/Amode.hs
+++ b/compiler/nativeGen/SPARC/CodeGen/Amode.hs
@@ -1,13 +1,5 @@
-
-{-# OPTIONS -fno-warn-tabs #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and
--- detab the module (please do the detabbing in a separate patch). See
---     http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
--- for details
-
 module SPARC.CodeGen.Amode (
-	getAmode
+        getAmode
 )
 
 where
@@ -28,11 +20,11 @@ import OrdList
 
 
 -- | Generate code to reference a memory address.
-getAmode 
-	:: CmmExpr 	-- ^ expr producing an address
-	-> NatM Amode
+getAmode
+        :: CmmExpr      -- ^ expr producing an address
+        -> NatM Amode
 
-getAmode tree@(CmmRegOff _ _) 
+getAmode tree@(CmmRegOff _ _)
     = do dflags <- getDynFlags
          getAmode (mangleIndexTree dflags tree)
 
@@ -50,7 +42,7 @@ getAmode (CmmMachOp (MO_Add _) [x, CmmLit (CmmInt i _)])
   = do
        (reg, code) <- getSomeReg x
        let
-     	 off  = ImmInt (fromInteger i)
+         off  = ImmInt (fromInteger i)
        return (Amode (AddrRegImm reg off) code)
 
 getAmode (CmmMachOp (MO_Add _) [x, y])
@@ -58,23 +50,23 @@ getAmode (CmmMachOp (MO_Add _) [x, y])
     (regX, codeX) <- getSomeReg x
     (regY, codeY) <- getSomeReg y
     let
-    	code = codeX `appOL` codeY
+        code = codeX `appOL` codeY
     return (Amode (AddrRegReg regX regY) code)
 
 getAmode (CmmLit lit)
   = do
-	let imm__2	= litToImm lit
-	tmp1 	<- getNewRegNat II32
-	tmp2	<- getNewRegNat II32
+        let imm__2      = litToImm lit
+        tmp1    <- getNewRegNat II32
+        tmp2    <- getNewRegNat II32
+
+        let code = toOL [ SETHI (HI imm__2) tmp1
+                        , OR    False tmp1 (RIImm (LO imm__2)) tmp2]
 
-	let code = toOL	[ SETHI (HI imm__2) tmp1
-			, OR    False tmp1 (RIImm (LO imm__2)) tmp2]
-		
-	return (Amode (AddrRegReg tmp2 g0) code)
+        return (Amode (AddrRegReg tmp2 g0) code)
 
 getAmode other
   = do
        (reg, code) <- getSomeReg other
        let
-    	    off  = ImmInt 0
+            off  = ImmInt 0
        return (Amode (AddrRegImm reg off) code)
diff --git a/compiler/nativeGen/SPARC/CodeGen/Base.hs b/compiler/nativeGen/SPARC/CodeGen/Base.hs
index 03b31e016a4d..270fd699b009 100644
--- a/compiler/nativeGen/SPARC/CodeGen/Base.hs
+++ b/compiler/nativeGen/SPARC/CodeGen/Base.hs
@@ -1,22 +1,14 @@
+module SPARC.CodeGen.Base (
+        InstrBlock,
+        CondCode(..),
+        ChildCode64(..),
+        Amode(..),
 
-{-# OPTIONS -fno-warn-tabs #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and
--- detab the module (please do the detabbing in a separate patch). See
---     http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
--- for details
+        Register(..),
+        setSizeOfRegister,
 
-module SPARC.CodeGen.Base (
-	InstrBlock,
-	CondCode(..),
-	ChildCode64(..),
-	Amode(..),
-
-	Register(..),
-	setSizeOfRegister,
-	
-	getRegisterReg,
-	mangleIndexTree
+        getRegisterReg,
+        mangleIndexTree
 )
 
 where
@@ -39,63 +31,63 @@ import OrdList
 
 --------------------------------------------------------------------------------
 -- | 'InstrBlock's are the insn sequences generated by the insn selectors.
--- 	They are really trees of insns to facilitate fast appending, where a
--- 	left-to-right traversal yields the insns in the correct	order.
+--      They are really trees of insns to facilitate fast appending, where a
+--      left-to-right traversal yields the insns in the correct order.
 --
-type InstrBlock 
-	= OrdList Instr
+type InstrBlock
+        = OrdList Instr
 
 
 -- | Condition codes passed up the tree.
 --
-data CondCode 	
-	= CondCode Bool Cond InstrBlock
+data CondCode
+        = CondCode Bool Cond InstrBlock
 
 
 -- | a.k.a "Register64"
---	Reg is the lower 32-bit temporary which contains the result. 
---	Use getHiVRegFromLo to find the other VRegUnique.  
+--      Reg is the lower 32-bit temporary which contains the result.
+--      Use getHiVRegFromLo to find the other VRegUnique.
 --
---	Rules of this simplified insn selection game are therefore that
---	the returned Reg may be modified
+--      Rules of this simplified insn selection game are therefore that
+--      the returned Reg may be modified
 --
-data ChildCode64 	
-   = ChildCode64 
+data ChildCode64
+   = ChildCode64
         InstrBlock
-        Reg	 	
+        Reg
 
 
 -- | Holds code that references a memory address.
-data Amode 
-	= Amode 
-		-- the AddrMode we can use in the instruction 
-		--	that does the real load\/store.
-		AddrMode 	
+data Amode
+        = Amode
+                -- the AddrMode we can use in the instruction
+                --      that does the real load\/store.
+                AddrMode
 
-		-- other setup code we have to run first before we can use the
-		--	above AddrMode.
-		InstrBlock	
+                -- other setup code we have to run first before we can use the
+                --      above AddrMode.
+                InstrBlock
 
 
 
 --------------------------------------------------------------------------------
 -- | Code to produce a result into a register.
---	If the result must go in a specific register, it comes out as Fixed.
---	Otherwise, the parent can decide which register to put it in.
+--      If the result must go in a specific register, it comes out as Fixed.
+--      Otherwise, the parent can decide which register to put it in.
 --
 data Register
-	= Fixed	Size Reg InstrBlock
-	| Any	Size (Reg -> InstrBlock)
+        = Fixed Size Reg InstrBlock
+        | Any   Size (Reg -> InstrBlock)
 
 
 -- | Change the size field in a Register.
 setSizeOfRegister
-	:: Register -> Size -> Register
+        :: Register -> Size -> Register
 
 setSizeOfRegister reg size
  = case reg of
- 	Fixed _ reg code 	-> Fixed size reg code
-	Any _ codefn     	-> Any   size codefn
+        Fixed _ reg code        -> Fixed size reg code
+        Any _ codefn            -> Any   size codefn
 
 
 --------------------------------------------------------------------------------
@@ -103,7 +95,7 @@ setSizeOfRegister reg size
 getRegisterReg :: Platform -> CmmReg -> Reg
 
 getRegisterReg _ (CmmLocal (LocalReg u pk))
-  	= RegVirtual $ mkVirtualReg u (cmmTypeSize pk)
+        = RegVirtual $ mkVirtualReg u (cmmTypeSize pk)
 
 getRegisterReg platform (CmmGlobal mid)
   = case globalRegMaybe platform mid of
@@ -118,12 +110,8 @@ getRegisterReg platform (CmmGlobal mid)
 mangleIndexTree :: DynFlags -> CmmExpr -> CmmExpr
 
 mangleIndexTree dflags (CmmRegOff reg off)
-	= CmmMachOp (MO_Add width) [CmmReg reg, CmmLit (CmmInt (fromIntegral off) width)]
-	where width = typeWidth (cmmRegType dflags reg)
+        = CmmMachOp (MO_Add width) [CmmReg reg, CmmLit (CmmInt (fromIntegral off) width)]
+        where width = typeWidth (cmmRegType dflags reg)
 
 mangleIndexTree _ _
-	= panic "SPARC.CodeGen.Base.mangleIndexTree: no match"
-
-
-
-
+        = panic "SPARC.CodeGen.Base.mangleIndexTree: no match"
diff --git a/compiler/nativeGen/SPARC/CodeGen/CondCode.hs b/compiler/nativeGen/SPARC/CodeGen/CondCode.hs
index 375a9e1b3390..cb10830f465d 100644
--- a/compiler/nativeGen/SPARC/CodeGen/CondCode.hs
+++ b/compiler/nativeGen/SPARC/CodeGen/CondCode.hs
@@ -1,15 +1,7 @@
-
-{-# OPTIONS -fno-warn-tabs #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and
--- detab the module (please do the detabbing in a separate patch). See
---     http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
--- for details
-
 module SPARC.CodeGen.CondCode (
-	getCondCode,
-	condIntCode,
-	condFltCode
+        getCondCode,
+        condIntCode,
+        condFltCode
 )
 
 where
@@ -32,7 +24,7 @@ import Outputable
 
 getCondCode :: CmmExpr -> NatM CondCode
 getCondCode (CmmMachOp mop [x, y])
-  = 
+  =
     case mop of
       MO_F_Eq W32 -> condFltCode EQQ x y
       MO_F_Ne W32 -> condFltCode NE  x y
@@ -86,8 +78,8 @@ condIntCode cond x y = do
     (src1, code1) <- getSomeReg x
     (src2, code2) <- getSomeReg y
     let
-	code__2 = code1 `appOL` code2 `snocOL`
-    	    	  SUB False True src1 (RIReg src2) g0
+        code__2 = code1 `appOL` code2 `snocOL`
+                  SUB False True src1 (RIReg src2) g0
     return (CondCode False cond code__2)
 
 
@@ -98,19 +90,19 @@ condFltCode cond x y = do
     (src2, code2) <- getSomeReg y
     tmp <- getNewRegNat FF64
     let
-   	promote x = FxTOy FF32 FF64 x tmp
-
-    	pk1   = cmmExprType dflags x
-    	pk2   = cmmExprType dflags y
-
-    	code__2 =
-		if pk1 `cmmEqType` pk2 then
-    	            code1 `appOL` code2 `snocOL`
-    	    	    FCMP True (cmmTypeSize pk1) src1 src2
-    	    	else if typeWidth pk1 == W32 then
-    	    	    code1 `snocOL` promote src1 `appOL` code2 `snocOL`
-    	    	    FCMP True FF64 tmp src2
-    	    	else
-    	    	    code1 `appOL` code2 `snocOL` promote src2 `snocOL`
-    	    	    FCMP True FF64 src1 tmp
+        promote x = FxTOy FF32 FF64 x tmp
+
+        pk1   = cmmExprType dflags x
+        pk2   = cmmExprType dflags y
+
+        code__2 =
+                if pk1 `cmmEqType` pk2 then
+                    code1 `appOL` code2 `snocOL`
+                    FCMP True (cmmTypeSize pk1) src1 src2
+                else if typeWidth pk1 == W32 then
+                    code1 `snocOL` promote src1 `appOL` code2 `snocOL`
+                    FCMP True FF64 tmp src2
+                else
+                    code1 `appOL` code2 `snocOL` promote src2 `snocOL`
+                    FCMP True FF64 src1 tmp
     return (CondCode True cond code__2)
diff --git a/compiler/nativeGen/SPARC/CodeGen/Expand.hs b/compiler/nativeGen/SPARC/CodeGen/Expand.hs
index 03f571c20bb7..1d4d1379a58f 100644
--- a/compiler/nativeGen/SPARC/CodeGen/Expand.hs
+++ b/compiler/nativeGen/SPARC/CodeGen/Expand.hs
@@ -1,14 +1,6 @@
-
-{-# OPTIONS -fno-warn-tabs #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and
--- detab the module (please do the detabbing in a separate patch). See
---     http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
--- for details
-
 -- | Expand out synthetic instructions into single machine instrs.
 module SPARC.CodeGen.Expand (
-	expandTop
+        expandTop
 )
 
 where
@@ -17,7 +9,7 @@ import SPARC.Instr
 import SPARC.Imm
 import SPARC.AddrMode
 import SPARC.Regs
-import SPARC.Ppr	()
+import SPARC.Ppr        ()
 import Instruction
 import Reg
 import Size
@@ -30,139 +22,132 @@ import OrdList
 -- | Expand out synthetic instructions in this top level thing
 expandTop :: NatCmmDecl CmmStatics Instr -> NatCmmDecl CmmStatics Instr
 expandTop top@(CmmData{})
-	= top
+        = top
 
 expandTop (CmmProc info lbl live (ListGraph blocks))
-	= CmmProc info lbl live (ListGraph $ map expandBlock blocks)
+        = CmmProc info lbl live (ListGraph $ map expandBlock blocks)
 
 
 -- | Expand out synthetic instructions in this block
 expandBlock :: NatBasicBlock Instr -> NatBasicBlock Instr
 
 expandBlock (BasicBlock label instrs)
- = let	instrs_ol	= expandBlockInstrs instrs
- 	instrs'		= fromOL instrs_ol
-   in	BasicBlock label instrs'
+ = let  instrs_ol       = expandBlockInstrs instrs
+        instrs'         = fromOL instrs_ol
+   in   BasicBlock label instrs'
 
 
 -- | Expand out some instructions
 expandBlockInstrs :: [Instr] -> OrdList Instr
-expandBlockInstrs []	= nilOL
-	
+expandBlockInstrs []    = nilOL
+
 expandBlockInstrs (ii:is)
- = let	ii_doubleRegs	= remapRegPair ii
-	is_misaligned	= expandMisalignedDoubles ii_doubleRegs
+ = let  ii_doubleRegs   = remapRegPair ii
+        is_misaligned   = expandMisalignedDoubles ii_doubleRegs
+
+   in   is_misaligned `appOL` expandBlockInstrs is
 
-   in	is_misaligned `appOL` expandBlockInstrs is
-   
 
 
 -- | In the SPARC instruction set the FP register pairs that are used
---	to hold 64 bit floats are refered to by just the first reg 
---	of the pair. Remap our internal reg pairs to the appropriate reg.
+--      to hold 64 bit floats are refered to by just the first reg
+--      of the pair. Remap our internal reg pairs to the appropriate reg.
 --
---	For example:
---	    ldd [%l1], (%f0 | %f1)
+--      For example:
+--          ldd [%l1], (%f0 | %f1)
 --
---	gets mapped to
---	    ldd [$l1], %f0
+--      gets mapped to
+--          ldd [$l1], %f0
 --
 remapRegPair :: Instr -> Instr
 remapRegPair instr
- = let	patchF reg
- 	 = case reg of
-	 	RegReal (RealRegSingle _) 	
-			-> reg
+ = let  patchF reg
+         = case reg of
+                RegReal (RealRegSingle _)
+                        -> reg
 
-		RegReal (RealRegPair r1 r2)	
+                RegReal (RealRegPair r1 r2)
 
-			-- sanity checking
-		 	| r1 	     >= 32
-			, r1 	     <= 63
-			, r1 `mod` 2 == 0	
-			, r2         == r1 + 1	
-			-> RegReal (RealRegSingle r1)
+                        -- sanity checking
+                        | r1         >= 32
+                        , r1         <= 63
+                        , r1 `mod` 2 == 0
+                        , r2         == r1 + 1
+                        -> RegReal (RealRegSingle r1)
 
-			| otherwise		
-			-> pprPanic "SPARC.CodeGen.Expand: not remapping dodgy looking reg pair " (ppr reg)
+                        | otherwise
+                        -> pprPanic "SPARC.CodeGen.Expand: not remapping dodgy looking reg pair " (ppr reg)
 
-		RegVirtual _
-			-> pprPanic "SPARC.CodeGen.Expand: not remapping virtual reg " (ppr reg)
-			
-   in	patchRegsOfInstr instr patchF
+                RegVirtual _
+                        -> pprPanic "SPARC.CodeGen.Expand: not remapping virtual reg " (ppr reg)
+
+   in   patchRegsOfInstr instr patchF
 
 
 
 
 -- Expand out 64 bit load/stores into individual instructions to handle
---	possible double alignment problems.
+--      possible double alignment problems.
 --
---	TODO: 	It'd be better to use a scratch reg instead of the add/sub thing.
---		We might be able to do this faster if we use the UA2007 instr set
---		instead of restricting ourselves to SPARC V9.
+--      TODO:   It'd be better to use a scratch reg instead of the add/sub thing.
+--              We might be able to do this faster if we use the UA2007 instr set
+--              instead of restricting ourselves to SPARC V9.
 --
 expandMisalignedDoubles :: Instr -> OrdList Instr
 expandMisalignedDoubles instr
 
-	-- Translate to:
-	--    add g1,g2,g1
-	--    ld  [g1],%fn
-	--    ld  [g1+4],%f(n+1)
-	--    sub g1,g2,g1           -- to restore g1
- 	| LD FF64 (AddrRegReg r1 r2) fReg	<- instr
-	= 	toOL	[ ADD False False r1 (RIReg r2) r1
-			, LD  FF32  (AddrRegReg r1 g0) 		fReg
-			, LD  FF32  (AddrRegImm r1 (ImmInt 4))	(fRegHi fReg)
-			, SUB False False r1 (RIReg r2) r1 ]
-
-	-- Translate to
-	--    ld  [addr],%fn
-	--    ld  [addr+4],%f(n+1)
-	| LD FF64 addr fReg			<- instr
-	= let	Just addr'	= addrOffset addr 4
-	  in	toOL	[ LD  FF32  addr	fReg
-	  		, LD  FF32  addr'	(fRegHi fReg) ]
-
-	-- Translate to:
-	--    add g1,g2,g1
-	--    st  %fn,[g1]
-	--    st  %f(n+1),[g1+4]
-	--    sub g1,g2,g1           -- to restore g1
-	| ST FF64 fReg (AddrRegReg r1 r2)	<- instr
-	= 	toOL	[ ADD False False r1 (RIReg r2) r1
-			, ST  FF32  fReg           (AddrRegReg r1 g0) 		
-			, ST  FF32  (fRegHi fReg)  (AddrRegImm r1 (ImmInt 4))	
-			, SUB False False r1 (RIReg r2) r1 ]
-
-	-- Translate to
-	--    ld  [addr],%fn
-	--    ld  [addr+4],%f(n+1)
-	| ST FF64 fReg addr			<- instr
-	= let	Just addr'	= addrOffset addr 4
-	  in	toOL	[ ST  FF32  fReg           addr	
-	  		, ST  FF32  (fRegHi fReg)  addr'	 ]
-
-	-- some other instr
-	| otherwise
-	= unitOL instr
-
-
-
--- | The the high partner for this float reg.	
+        -- Translate to:
+        --    add g1,g2,g1
+        --    ld  [g1],%fn
+        --    ld  [g1+4],%f(n+1)
+        --    sub g1,g2,g1           -- to restore g1
+        | LD FF64 (AddrRegReg r1 r2) fReg       <- instr
+        =       toOL    [ ADD False False r1 (RIReg r2) r1
+                        , LD  FF32  (AddrRegReg r1 g0)          fReg
+                        , LD  FF32  (AddrRegImm r1 (ImmInt 4))  (fRegHi fReg)
+                        , SUB False False r1 (RIReg r2) r1 ]
+
+        -- Translate to
+        --    ld  [addr],%fn
+        --    ld  [addr+4],%f(n+1)
+        | LD FF64 addr fReg                     <- instr
+        = let   Just addr'      = addrOffset addr 4
+          in    toOL    [ LD  FF32  addr        fReg
+                        , LD  FF32  addr'       (fRegHi fReg) ]
+
+        -- Translate to:
+        --    add g1,g2,g1
+        --    st  %fn,[g1]
+        --    st  %f(n+1),[g1+4]
+        --    sub g1,g2,g1           -- to restore g1
+        | ST FF64 fReg (AddrRegReg r1 r2)       <- instr
+        =       toOL    [ ADD False False r1 (RIReg r2) r1
+                        , ST  FF32  fReg           (AddrRegReg r1 g0)
+                        , ST  FF32  (fRegHi fReg)  (AddrRegImm r1 (ImmInt 4))
+                        , SUB False False r1 (RIReg r2) r1 ]
+
+        -- Translate to
+        --    ld  [addr],%fn
+        --    ld  [addr+4],%f(n+1)
+        | ST FF64 fReg addr                     <- instr
+        = let   Just addr'      = addrOffset addr 4
+          in    toOL    [ ST  FF32  fReg           addr
+                        , ST  FF32  (fRegHi fReg)  addr'         ]
+
+        -- some other instr
+        | otherwise
+        = unitOL instr
+
+
+
+-- | The the high partner for this float reg.
 fRegHi :: Reg -> Reg
 fRegHi (RegReal (RealRegSingle r1))
-	| r1		>= 32
-	, r1		<= 63
-	, r1 `mod` 2 == 0
-	= (RegReal $ RealRegSingle (r1 + 1))
-	
+        | r1            >= 32
+        , r1            <= 63
+        , r1 `mod` 2 == 0
+        = (RegReal $ RealRegSingle (r1 + 1))
+
 -- Can't take high partner for non-low reg.
 fRegHi reg
-	= pprPanic "SPARC.CodeGen.Expand: can't take fRegHi from " (ppr reg)
-	
-	
-	
-	
-	
-
-
+        = pprPanic "SPARC.CodeGen.Expand: can't take fRegHi from " (ppr reg)
diff --git a/compiler/nativeGen/SPARC/CodeGen/Gen32.hs b/compiler/nativeGen/SPARC/CodeGen/Gen32.hs
index 43b792a840dc..90fb41870db4 100644
--- a/compiler/nativeGen/SPARC/CodeGen/Gen32.hs
+++ b/compiler/nativeGen/SPARC/CodeGen/Gen32.hs
@@ -1,15 +1,7 @@
-
-{-# OPTIONS -fno-warn-tabs #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and
--- detab the module (please do the detabbing in a separate patch). See
---     http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
--- for details
-
 -- | Evaluation of 32 bit values.
 module SPARC.CodeGen.Gen32 (
-	getSomeReg,
-	getRegister
+        getSomeReg,
+        getRegister
 )
 
 where
@@ -37,16 +29,16 @@ import OrdList
 import Outputable
 
 -- | The dual to getAnyReg: compute an expression into a register, but
--- 	we don't mind which one it is.
+--      we don't mind which one it is.
 getSomeReg :: CmmExpr -> NatM (Reg, InstrBlock)
 getSomeReg expr = do
   r <- getRegister expr
   case r of
     Any rep code -> do
-	tmp <- getNewRegNat rep
-	return (tmp, code tmp)
-    Fixed _ reg code -> 
-	return (reg, code)
+        tmp <- getNewRegNat rep
+        return (tmp, code tmp)
+    Fixed _ reg code ->
+        return (reg, code)
 
 
 
@@ -54,13 +46,13 @@ getSomeReg expr = do
 --
 getRegister :: CmmExpr -> NatM Register
 
-getRegister (CmmReg reg) 
+getRegister (CmmReg reg)
   = do dflags <- getDynFlags
        let platform = targetPlatform dflags
        return (Fixed (cmmTypeSize (cmmRegType dflags reg))
                      (getRegisterReg platform reg) nilOL)
 
-getRegister tree@(CmmRegOff _ _) 
+getRegister tree@(CmmRegOff _ _)
   = do dflags <- getDynFlags
        getRegister (mangleIndexTree dflags tree)
 
@@ -80,12 +72,12 @@ getRegister (CmmMachOp (MO_UU_Conv W64 W32) [x]) = do
 
 getRegister (CmmMachOp (MO_SS_Conv W64 W32) [x]) = do
   ChildCode64 code rlo <- iselExpr64 x
-  return $ Fixed II32 rlo code       
+  return $ Fixed II32 rlo code
 
 
 -- Load a literal float into a float register.
---	The actual literal is stored in a new data area, and we load it 
---	at runtime.
+--      The actual literal is stored in a new data area, and we load it
+--      at runtime.
 getRegister (CmmLit (CmmFloat f W32)) = do
 
     -- a label for the new data area
@@ -93,13 +85,13 @@ getRegister (CmmLit (CmmFloat f W32)) = do
     tmp <- getNewRegNat II32
 
     let code dst = toOL [
-            -- the data area         
-	    LDATA ReadOnlyData $ Statics lbl
-			 [CmmStaticLit (CmmFloat f W32)],
+            -- the data area
+            LDATA ReadOnlyData $ Statics lbl
+                         [CmmStaticLit (CmmFloat f W32)],
 
             -- load the literal
-	    SETHI (HI (ImmCLbl lbl)) tmp,
-	    LD II32 (AddrRegImm tmp (LO (ImmCLbl lbl))) dst] 
+            SETHI (HI (ImmCLbl lbl)) tmp,
+            LD II32 (AddrRegImm tmp (LO (ImmCLbl lbl))) dst]
 
     return (Any FF32 code)
 
@@ -107,342 +99,342 @@ getRegister (CmmLit (CmmFloat d W64)) = do
     lbl <- getNewLabelNat
     tmp <- getNewRegNat II32
     let code dst = toOL [
-	    LDATA ReadOnlyData $ Statics lbl
-			 [CmmStaticLit (CmmFloat d W64)],
-	    SETHI (HI (ImmCLbl lbl)) tmp,
-	    LD II64 (AddrRegImm tmp (LO (ImmCLbl lbl))) dst] 
+            LDATA ReadOnlyData $ Statics lbl
+                         [CmmStaticLit (CmmFloat d W64)],
+            SETHI (HI (ImmCLbl lbl)) tmp,
+            LD II64 (AddrRegImm tmp (LO (ImmCLbl lbl))) dst]
     return (Any FF64 code)
 
 
 -- Unary machine ops
 getRegister (CmmMachOp mop [x])
   = case mop of
-	-- Floating point negation -------------------------
-	MO_F_Neg W32		-> trivialUFCode FF32 (FNEG FF32) x
-	MO_F_Neg W64		-> trivialUFCode FF64 (FNEG FF64) x
+        -- Floating point negation -------------------------
+        MO_F_Neg W32            -> trivialUFCode FF32 (FNEG FF32) x
+        MO_F_Neg W64            -> trivialUFCode FF64 (FNEG FF64) x
 
 
-	-- Integer negation --------------------------------
-	MO_S_Neg rep		-> trivialUCode (intSize rep) (SUB False False g0) x
-	MO_Not rep		-> trivialUCode (intSize rep) (XNOR False g0) x
+        -- Integer negation --------------------------------
+        MO_S_Neg rep            -> trivialUCode (intSize rep) (SUB False False g0) x
+        MO_Not rep              -> trivialUCode (intSize rep) (XNOR False g0) x
 
 
-	-- Float word size conversion ----------------------
-	MO_FF_Conv W64 W32	-> coerceDbl2Flt x
-	MO_FF_Conv W32 W64	-> coerceFlt2Dbl x
+        -- Float word size conversion ----------------------
+        MO_FF_Conv W64 W32      -> coerceDbl2Flt x
+        MO_FF_Conv W32 W64      -> coerceFlt2Dbl x
 
 
-	-- Float <-> Signed Int conversion -----------------
-	MO_FS_Conv from to 	-> coerceFP2Int from to x
-	MO_SF_Conv from to 	-> coerceInt2FP from to x
+        -- Float <-> Signed Int conversion -----------------
+        MO_FS_Conv from to      -> coerceFP2Int from to x
+        MO_SF_Conv from to      -> coerceInt2FP from to x
 
 
-	-- Unsigned integer word size conversions ----------
+        -- Unsigned integer word size conversions ----------
 
-	-- If it's the same size, then nothing needs to be done.
-	MO_UU_Conv from to
-	 | from == to    	-> conversionNop (intSize to)  x
+        -- If it's the same size, then nothing needs to be done.
+        MO_UU_Conv from to
+         | from == to           -> conversionNop (intSize to)  x
 
-	-- To narrow an unsigned word, mask out the high bits to simulate what would 
-	--	happen if we copied the value into a smaller register.
-	MO_UU_Conv W16 W8	-> trivialCode W8  (AND False) x (CmmLit (CmmInt 255 W8))
-	MO_UU_Conv W32 W8	-> trivialCode W8  (AND False) x (CmmLit (CmmInt 255 W8))
+        -- To narrow an unsigned word, mask out the high bits to simulate what would
+        --      happen if we copied the value into a smaller register.
+        MO_UU_Conv W16 W8       -> trivialCode W8  (AND False) x (CmmLit (CmmInt 255 W8))
+        MO_UU_Conv W32 W8       -> trivialCode W8  (AND False) x (CmmLit (CmmInt 255 W8))
 
-	-- for narrowing 32 bit to 16 bit, don't use a literal mask value like the W16->W8
-	--	case because the only way we can load it is via SETHI, which needs 2 ops.
-	--	Do some shifts to chop out the high bits instead.
-	MO_UU_Conv W32 W16	
-	 -> do	tmpReg		<- getNewRegNat II32
-		(xReg, xCode)	<- getSomeReg x
-	 	let code dst
-			=  	xCode
-			`appOL` toOL
-				[ SLL xReg   (RIImm $ ImmInt 16) tmpReg
-				, SRL tmpReg (RIImm $ ImmInt 16) dst]
-				
-		return	$ Any II32 code
-			
-		--	 trivialCode W16 (AND False) x (CmmLit (CmmInt 65535 W16))
+        -- for narrowing 32 bit to 16 bit, don't use a literal mask value like the W16->W8
+        --      case because the only way we can load it is via SETHI, which needs 2 ops.
+        --      Do some shifts to chop out the high bits instead.
+        MO_UU_Conv W32 W16
+         -> do  tmpReg          <- getNewRegNat II32
+                (xReg, xCode)   <- getSomeReg x
+                let code dst
+                        =       xCode
+                        `appOL` toOL
+                                [ SLL xReg   (RIImm $ ImmInt 16) tmpReg
+                                , SRL tmpReg (RIImm $ ImmInt 16) dst]
 
-	-- To widen an unsigned word we don't have to do anything.
-	--	Just leave it in the same register and mark the result as the new size.
-	MO_UU_Conv W8  W16	-> conversionNop (intSize W16)  x
-	MO_UU_Conv W8  W32	-> conversionNop (intSize W32)  x
-	MO_UU_Conv W16 W32	-> conversionNop (intSize W32)  x
+                return  $ Any II32 code
 
+                --       trivialCode W16 (AND False) x (CmmLit (CmmInt 65535 W16))
 
-	-- Signed integer word size conversions ------------
+        -- To widen an unsigned word we don't have to do anything.
+        --      Just leave it in the same register and mark the result as the new size.
+        MO_UU_Conv W8  W16      -> conversionNop (intSize W16)  x
+        MO_UU_Conv W8  W32      -> conversionNop (intSize W32)  x
+        MO_UU_Conv W16 W32      -> conversionNop (intSize W32)  x
 
-	-- Mask out high bits when narrowing them
-	MO_SS_Conv W16 W8	-> trivialCode W8  (AND False) x (CmmLit (CmmInt 255 W8))
-	MO_SS_Conv W32 W8	-> trivialCode W8  (AND False) x (CmmLit (CmmInt 255 W8))
-	MO_SS_Conv W32 W16	-> trivialCode W16 (AND False) x (CmmLit (CmmInt 65535 W16))
 
-	-- Sign extend signed words when widening them.
-	MO_SS_Conv W8  W16	-> integerExtend W8  W16 x
-	MO_SS_Conv W8  W32	-> integerExtend W8  W32 x
-	MO_SS_Conv W16 W32	-> integerExtend W16 W32 x
+        -- Signed integer word size conversions ------------
 
-	_ 		  	-> panic ("Unknown unary mach op: " ++ show mop)
+        -- Mask out high bits when narrowing them
+        MO_SS_Conv W16 W8       -> trivialCode W8  (AND False) x (CmmLit (CmmInt 255 W8))
+        MO_SS_Conv W32 W8       -> trivialCode W8  (AND False) x (CmmLit (CmmInt 255 W8))
+        MO_SS_Conv W32 W16      -> trivialCode W16 (AND False) x (CmmLit (CmmInt 65535 W16))
+
+        -- Sign extend signed words when widening them.
+        MO_SS_Conv W8  W16      -> integerExtend W8  W16 x
+        MO_SS_Conv W8  W32      -> integerExtend W8  W32 x
+        MO_SS_Conv W16 W32      -> integerExtend W16 W32 x
+
+        _                       -> panic ("Unknown unary mach op: " ++ show mop)
 
 
 -- Binary machine ops
-getRegister (CmmMachOp mop [x, y]) 
+getRegister (CmmMachOp mop [x, y])
   = case mop of
-      MO_Eq _ 		-> condIntReg EQQ x y
-      MO_Ne _ 		-> condIntReg NE x y
-
-      MO_S_Gt _		-> condIntReg GTT x y
-      MO_S_Ge _		-> condIntReg GE x y
-      MO_S_Lt _		-> condIntReg LTT x y
-      MO_S_Le _		-> condIntReg LE x y
-	      
-      MO_U_Gt W32  	-> condIntReg GU  x y
-      MO_U_Ge W32  	-> condIntReg GEU x y
-      MO_U_Lt W32  	-> condIntReg LU  x y
-      MO_U_Le W32  	-> condIntReg LEU x y
-
-      MO_U_Gt W16 	-> condIntReg GU  x y
-      MO_U_Ge W16	-> condIntReg GEU x y
-      MO_U_Lt W16 	-> condIntReg LU  x y
-      MO_U_Le W16 	-> condIntReg LEU x y
-
-      MO_Add W32 	-> trivialCode W32 (ADD False False) x y
-      MO_Sub W32 	-> trivialCode W32 (SUB False False) x y
+      MO_Eq _           -> condIntReg EQQ x y
+      MO_Ne _           -> condIntReg NE x y
+
+      MO_S_Gt _         -> condIntReg GTT x y
+      MO_S_Ge _         -> condIntReg GE x y
+      MO_S_Lt _         -> condIntReg LTT x y
+      MO_S_Le _         -> condIntReg LE x y
+
+      MO_U_Gt W32       -> condIntReg GU  x y
+      MO_U_Ge W32       -> condIntReg GEU x y
+      MO_U_Lt W32       -> condIntReg LU  x y
+      MO_U_Le W32       -> condIntReg LEU x y
+
+      MO_U_Gt W16       -> condIntReg GU  x y
+      MO_U_Ge W16       -> condIntReg GEU x y
+      MO_U_Lt W16       -> condIntReg LU  x y
+      MO_U_Le W16       -> condIntReg LEU x y
+
+      MO_Add W32        -> trivialCode W32 (ADD False False) x y
+      MO_Sub W32        -> trivialCode W32 (SUB False False) x y
 
       MO_S_MulMayOflo rep -> imulMayOflo rep x y
 
-      MO_S_Quot W32 	-> idiv True  False x y
-      MO_U_Quot W32 	-> idiv False False x y
-       
-      MO_S_Rem  W32	-> irem True  x y
-      MO_U_Rem	W32	-> irem False x y
-       
-      MO_F_Eq _ 	-> condFltReg EQQ x y
-      MO_F_Ne _ 	-> condFltReg NE x y
+      MO_S_Quot W32     -> idiv True  False x y
+      MO_U_Quot W32     -> idiv False False x y
+
+      MO_S_Rem  W32     -> irem True  x y
+      MO_U_Rem  W32     -> irem False x y
+
+      MO_F_Eq _         -> condFltReg EQQ x y
+      MO_F_Ne _         -> condFltReg NE x y
 
-      MO_F_Gt _ 	-> condFltReg GTT x y
-      MO_F_Ge _ 	-> condFltReg GE x y 
-      MO_F_Lt _ 	-> condFltReg LTT x y
-      MO_F_Le _ 	-> condFltReg LE x y
+      MO_F_Gt _         -> condFltReg GTT x y
+      MO_F_Ge _         -> condFltReg GE x y
+      MO_F_Lt _         -> condFltReg LTT x y
+      MO_F_Le _         -> condFltReg LE x y
 
-      MO_F_Add  w	-> trivialFCode w FADD x y
-      MO_F_Sub  w  	-> trivialFCode w FSUB x y
-      MO_F_Mul  w  	-> trivialFCode w FMUL x y
-      MO_F_Quot w  	-> trivialFCode w FDIV x y
+      MO_F_Add  w       -> trivialFCode w FADD x y
+      MO_F_Sub  w       -> trivialFCode w FSUB x y
+      MO_F_Mul  w       -> trivialFCode w FMUL x y
+      MO_F_Quot w       -> trivialFCode w FDIV x y
 
-      MO_And rep   	-> trivialCode rep (AND False) x y
-      MO_Or  rep    	-> trivialCode rep (OR  False) x y
-      MO_Xor rep   	-> trivialCode rep (XOR False) x y
+      MO_And rep        -> trivialCode rep (AND False) x y
+      MO_Or  rep        -> trivialCode rep (OR  False) x y
+      MO_Xor rep        -> trivialCode rep (XOR False) x y
 
-      MO_Mul rep 	-> trivialCode rep (SMUL False) x y
+      MO_Mul rep        -> trivialCode rep (SMUL False) x y
 
-      MO_Shl rep   	-> trivialCode rep SLL  x y
-      MO_U_Shr rep   	-> trivialCode rep SRL x y
-      MO_S_Shr rep   	-> trivialCode rep SRA x y
+      MO_Shl rep        -> trivialCode rep SLL  x y
+      MO_U_Shr rep      -> trivialCode rep SRL x y
+      MO_S_Shr rep      -> trivialCode rep SRA x y
 
-      _			-> pprPanic "getRegister(sparc) - binary CmmMachOp (1)" (pprMachOp mop)
+      _                 -> pprPanic "getRegister(sparc) - binary CmmMachOp (1)" (pprMachOp mop)
   where
 
 
 getRegister (CmmLoad mem pk) = do
     Amode src code <- getAmode mem
     let
-	code__2 dst 	= code `snocOL` LD (cmmTypeSize pk) src dst
+        code__2 dst     = code `snocOL` LD (cmmTypeSize pk) src dst
     return (Any (cmmTypeSize pk) code__2)
 
 getRegister (CmmLit (CmmInt i _))
   | fits13Bits i
   = let
-    	src = ImmInt (fromInteger i)
-    	code dst = unitOL (OR False g0 (RIImm src) dst)
+        src = ImmInt (fromInteger i)
+        code dst = unitOL (OR False g0 (RIImm src) dst)
     in
-    	return (Any II32 code)
+        return (Any II32 code)
 
 getRegister (CmmLit lit)
   = let imm = litToImm lit
-    	code dst = toOL [
-    	    SETHI (HI imm) dst,
-    	    OR False dst (RIImm (LO imm)) dst]
+        code dst = toOL [
+            SETHI (HI imm) dst,
+            OR False dst (RIImm (LO imm)) dst]
     in return (Any II32 code)
 
 
 getRegister _
-	= panic "SPARC.CodeGen.Gen32.getRegister: no match"
+        = panic "SPARC.CodeGen.Gen32.getRegister: no match"
 
 
 -- | sign extend and widen
-integerExtend 
-	:: Width 		-- ^ width of source expression
-	-> Width 		-- ^ width of result
-	-> CmmExpr 		-- ^ source expression
-	-> NatM Register	
+integerExtend
+        :: Width                -- ^ width of source expression
+        -> Width                -- ^ width of result
+        -> CmmExpr              -- ^ source expression
+        -> NatM Register
 
 integerExtend from to expr
- = do	-- load the expr into some register
- 	(reg, e_code) 	<- getSomeReg expr
-	tmp		<- getNewRegNat II32
-	let bitCount
-		= case (from, to) of
-			(W8,  W32)	-> 24
-			(W16, W32)	-> 16
-			(W8,  W16)	-> 24
-			_		-> panic "SPARC.CodeGen.Gen32: no match"
- 	let code dst
-		= e_code 	
-
-		-- local shift word left to load the sign bit
-		`snocOL`  SLL reg (RIImm (ImmInt bitCount)) tmp
-			
-		-- arithmetic shift right to sign extend
-		`snocOL`  SRA tmp (RIImm (ImmInt bitCount)) dst
-			
-	return (Any (intSize to) code)
-				
+ = do   -- load the expr into some register
+        (reg, e_code)   <- getSomeReg expr
+        tmp             <- getNewRegNat II32
+        let bitCount
+                = case (from, to) of
+                        (W8,  W32)      -> 24
+                        (W16, W32)      -> 16
+                        (W8,  W16)      -> 24
+                        _               -> panic "SPARC.CodeGen.Gen32: no match"
+        let code dst
+                = e_code
+
+                -- local shift word left to load the sign bit
+                `snocOL`  SLL reg (RIImm (ImmInt bitCount)) tmp
+
+                -- arithmetic shift right to sign extend
+                `snocOL`  SRA tmp (RIImm (ImmInt bitCount)) dst
+
+        return (Any (intSize to) code)
+
 
 -- | For nop word format conversions we set the resulting value to have the
---	required size, but don't need to generate any actual code.
+--      required size, but don't need to generate any actual code.
 --
 conversionNop
-	:: Size -> CmmExpr -> NatM Register
+        :: Size -> CmmExpr -> NatM Register
 
 conversionNop new_rep expr
- = do	e_code <- getRegister expr
-	return (setSizeOfRegister e_code new_rep)
+ = do   e_code <- getRegister expr
+        return (setSizeOfRegister e_code new_rep)
 
 
 
 -- | Generate an integer division instruction.
 idiv :: Bool -> Bool -> CmmExpr -> CmmExpr -> NatM Register
-	
--- For unsigned division with a 32 bit numerator, 
---		we can just clear the Y register.
-idiv False cc x y 
+
+-- For unsigned division with a 32 bit numerator,
+--              we can just clear the Y register.
+idiv False cc x y
  = do
-	(a_reg, a_code)		<- getSomeReg x
-       	(b_reg, b_code)		<- getSomeReg y
-	
-	let code dst
-		= 	a_code 
-		`appOL`	b_code  
-		`appOL`	toOL
-			[ WRY  g0 g0
-			, UDIV cc a_reg (RIReg b_reg) dst]
-			
-	return (Any II32 code)
-    	
+        (a_reg, a_code)         <- getSomeReg x
+        (b_reg, b_code)         <- getSomeReg y
+
+        let code dst
+                =       a_code
+                `appOL` b_code
+                `appOL` toOL
+                        [ WRY  g0 g0
+                        , UDIV cc a_reg (RIReg b_reg) dst]
+
+        return (Any II32 code)
+
 
 -- For _signed_ division with a 32 bit numerator,
---		we have to sign extend the numerator into the Y register.
-idiv True cc x y 
+--              we have to sign extend the numerator into the Y register.
+idiv True cc x y
  = do
-	(a_reg, a_code)		<- getSomeReg x
-       	(b_reg, b_code)		<- getSomeReg y
-	
-	tmp			<- getNewRegNat II32
-	
-	let code dst
-		= 	a_code 
-		`appOL`	b_code  
-		`appOL`	toOL
-			[ SRA  a_reg (RIImm (ImmInt 16)) tmp		-- sign extend
-			, SRA  tmp   (RIImm (ImmInt 16)) tmp
-
-			, WRY  tmp g0				
-			, SDIV cc a_reg (RIReg b_reg) dst]
-			
-	return (Any II32 code)
+        (a_reg, a_code)         <- getSomeReg x
+        (b_reg, b_code)         <- getSomeReg y
+
+        tmp                     <- getNewRegNat II32
+
+        let code dst
+                =       a_code
+                `appOL` b_code
+                `appOL` toOL
+                        [ SRA  a_reg (RIImm (ImmInt 16)) tmp            -- sign extend
+                        , SRA  tmp   (RIImm (ImmInt 16)) tmp
+
+                        , WRY  tmp g0
+                        , SDIV cc a_reg (RIReg b_reg) dst]
+
+        return (Any II32 code)
 
 
 -- | Do an integer remainder.
 --
---	 NOTE:	The SPARC v8 architecture manual says that integer division
---		instructions _may_ generate a remainder, depending on the implementation.
---		If so it is _recommended_ that the remainder is placed in the Y register.
+--       NOTE:  The SPARC v8 architecture manual says that integer division
+--              instructions _may_ generate a remainder, depending on the implementation.
+--              If so it is _recommended_ that the remainder is placed in the Y register.
 --
 --          The UltraSparc 2007 manual says Y is _undefined_ after division.
 --
---		The SPARC T2 doesn't store the remainder, not sure about the others. 
---		It's probably best not to worry about it, and just generate our own
---		remainders. 
+--              The SPARC T2 doesn't store the remainder, not sure about the others.
+--              It's probably best not to worry about it, and just generate our own
+--              remainders.
 --
 irem :: Bool -> CmmExpr -> CmmExpr -> NatM Register
 
--- For unsigned operands: 
---		Division is between a 64 bit numerator and a 32 bit denominator, 
---		so we still have to clear the Y register.
-irem False x y 
+-- For unsigned operands:
+--              Division is between a 64 bit numerator and a 32 bit denominator,
+--              so we still have to clear the Y register.
+irem False x y
  = do
-    	(a_reg, a_code)	<- getSomeReg x
-	(b_reg, b_code)	<- getSomeReg y
+        (a_reg, a_code) <- getSomeReg x
+        (b_reg, b_code) <- getSomeReg y
+
+        tmp_reg         <- getNewRegNat II32
 
-	tmp_reg		<- getNewRegNat II32
+        let code dst
+                =       a_code
+                `appOL` b_code
+                `appOL` toOL
+                        [ WRY   g0 g0
+                        , UDIV  False         a_reg (RIReg b_reg) tmp_reg
+                        , UMUL  False       tmp_reg (RIReg b_reg) tmp_reg
+                        , SUB   False False   a_reg (RIReg tmp_reg) dst]
+
+        return  (Any II32 code)
 
-	let code dst
-		= 	a_code
-		`appOL`	b_code
-		`appOL`	toOL
-			[ WRY	g0 g0
-			, UDIV  False         a_reg (RIReg b_reg) tmp_reg
-			, UMUL  False       tmp_reg (RIReg b_reg) tmp_reg
-			, SUB   False False   a_reg (RIReg tmp_reg) dst]
-    
-    	return	(Any II32 code)
 
-    
 
 -- For signed operands:
---		Make sure to sign extend into the Y register, or the remainder
---		will have the wrong sign when the numerator is negative.
+--              Make sure to sign extend into the Y register, or the remainder
+--              will have the wrong sign when the numerator is negative.
 --
---	TODO:	When sign extending, GCC only shifts the a_reg right by 17 bits,
---		not the full 32. Not sure why this is, something to do with overflow?
---		If anyone cares enough about the speed of signed remainder they
---		can work it out themselves (then tell me). -- BL 2009/01/20
-irem True x y 
+--      TODO:   When sign extending, GCC only shifts the a_reg right by 17 bits,
+--              not the full 32. Not sure why this is, something to do with overflow?
+--              If anyone cares enough about the speed of signed remainder they
+--              can work it out themselves (then tell me). -- BL 2009/01/20
+irem True x y
  = do
-    	(a_reg, a_code)	<- getSomeReg x
-	(b_reg, b_code)	<- getSomeReg y
-	
-	tmp1_reg	<- getNewRegNat II32
-	tmp2_reg	<- getNewRegNat II32
-		
-	let code dst
-		=	a_code
-		`appOL`	b_code
-		`appOL`	toOL
-			[ SRA	a_reg      (RIImm (ImmInt 16)) tmp1_reg	-- sign extend
-			, SRA	tmp1_reg   (RIImm (ImmInt 16)) tmp1_reg	-- sign extend
-			, WRY	tmp1_reg g0
-
-			, SDIV  False          a_reg (RIReg b_reg)    tmp2_reg	
-			, SMUL  False       tmp2_reg (RIReg b_reg)    tmp2_reg
-			, SUB   False False    a_reg (RIReg tmp2_reg) dst]
-			
-	return (Any II32 code)
-   
+        (a_reg, a_code) <- getSomeReg x
+        (b_reg, b_code) <- getSomeReg y
+
+        tmp1_reg        <- getNewRegNat II32
+        tmp2_reg        <- getNewRegNat II32
+
+        let code dst
+                =       a_code
+                `appOL` b_code
+                `appOL` toOL
+                        [ SRA   a_reg      (RIImm (ImmInt 16)) tmp1_reg -- sign extend
+                        , SRA   tmp1_reg   (RIImm (ImmInt 16)) tmp1_reg -- sign extend
+                        , WRY   tmp1_reg g0
+
+                        , SDIV  False          a_reg (RIReg b_reg)    tmp2_reg
+                        , SMUL  False       tmp2_reg (RIReg b_reg)    tmp2_reg
+                        , SUB   False False    a_reg (RIReg tmp2_reg) dst]
+
+        return (Any II32 code)
+
 
 imulMayOflo :: Width -> CmmExpr -> CmmExpr -> NatM Register
-imulMayOflo rep a b 
+imulMayOflo rep a b
  = do
-	(a_reg, a_code) <- getSomeReg a
-	(b_reg, b_code) <- getSomeReg b
-	res_lo <- getNewRegNat II32
-	res_hi <- getNewRegNat II32
-
-	let shift_amt  = case rep of
-			  W32 -> 31
-			  W64 -> 63
-			  _ -> panic "shift_amt"
-	
-	let code dst = a_code `appOL` b_code `appOL`
+        (a_reg, a_code) <- getSomeReg a
+        (b_reg, b_code) <- getSomeReg b
+        res_lo <- getNewRegNat II32
+        res_hi <- getNewRegNat II32
+
+        let shift_amt  = case rep of
+                          W32 -> 31
+                          W64 -> 63
+                          _ -> panic "shift_amt"
+
+        let code dst = a_code `appOL` b_code `appOL`
                        toOL [
                            SMUL False a_reg (RIReg b_reg) res_lo,
                            RDY res_hi,
                            SRA res_lo (RIImm (ImmInt shift_amt)) res_lo,
                            SUB False False res_lo (RIReg res_hi) dst
                         ]
-	return (Any II32 code)
+        return (Any II32 code)
 
 
 -- -----------------------------------------------------------------------------
@@ -458,19 +450,19 @@ imulMayOflo rep a b
 -- have handled the constant-folding.
 
 trivialCode
-	:: Width
-	-> (Reg -> RI -> Reg -> Instr)
-	-> CmmExpr
-	-> CmmExpr
-	-> NatM Register
-	
+        :: Width
+        -> (Reg -> RI -> Reg -> Instr)
+        -> CmmExpr
+        -> CmmExpr
+        -> NatM Register
+
 trivialCode _ instr x (CmmLit (CmmInt y _))
   | fits13Bits y
   = do
       (src1, code) <- getSomeReg x
       let
-    	src2 = ImmInt (fromInteger y)
-    	code__2 dst = code `snocOL` instr src1 (RIImm src2) dst
+        src2 = ImmInt (fromInteger y)
+        code__2 dst = code `snocOL` instr src1 (RIImm src2) dst
       return (Any II32 code__2)
 
 
@@ -478,17 +470,17 @@ trivialCode _ instr x y = do
     (src1, code1) <- getSomeReg x
     (src2, code2) <- getSomeReg y
     let
-    	code__2 dst = code1 `appOL` code2 `snocOL`
-    	    	      instr src1 (RIReg src2) dst
+        code__2 dst = code1 `appOL` code2 `snocOL`
+                      instr src1 (RIReg src2) dst
     return (Any II32 code__2)
 
 
-trivialFCode 
-	:: Width
-	-> (Size -> Reg -> Reg -> Reg -> Instr)
-	-> CmmExpr
-	-> CmmExpr
-	-> NatM Register
+trivialFCode
+        :: Width
+        -> (Size -> Reg -> Reg -> Reg -> Instr)
+        -> CmmExpr
+        -> CmmExpr
+        -> NatM Register
 
 trivialFCode pk instr x y = do
     dflags <- getDynFlags
@@ -496,49 +488,49 @@ trivialFCode pk instr x y = do
     (src2, code2) <- getSomeReg y
     tmp <- getNewRegNat FF64
     let
-    	promote x = FxTOy FF32 FF64 x tmp
+        promote x = FxTOy FF32 FF64 x tmp
 
-    	pk1   = cmmExprType dflags x
-    	pk2   = cmmExprType dflags y
+        pk1   = cmmExprType dflags x
+        pk2   = cmmExprType dflags y
 
-    	code__2 dst =
-    	    	if pk1 `cmmEqType` pk2 then
-    	            code1 `appOL` code2 `snocOL`
-    	    	    instr (floatSize pk) src1 src2 dst
-    	    	else if typeWidth pk1 == W32 then
-    	    	    code1 `snocOL` promote src1 `appOL` code2 `snocOL`
-    	    	    instr FF64 tmp src2 dst
-    	    	else
-    	    	    code1 `appOL` code2 `snocOL` promote src2 `snocOL`
-    	    	    instr FF64 src1 tmp dst
-    return (Any (cmmTypeSize $ if pk1 `cmmEqType` pk2 then pk1 else cmmFloat W64) 
-    		code__2)
+        code__2 dst =
+                if pk1 `cmmEqType` pk2 then
+                    code1 `appOL` code2 `snocOL`
+                    instr (floatSize pk) src1 src2 dst
+                else if typeWidth pk1 == W32 then
+                    code1 `snocOL` promote src1 `appOL` code2 `snocOL`
+                    instr FF64 tmp src2 dst
+                else
+                    code1 `appOL` code2 `snocOL` promote src2 `snocOL`
+                    instr FF64 src1 tmp dst
+    return (Any (cmmTypeSize $ if pk1 `cmmEqType` pk2 then pk1 else cmmFloat W64)
+                code__2)
 
 
 
 trivialUCode
-	:: Size
-	-> (RI -> Reg -> Instr)
-	-> CmmExpr
-	-> NatM Register
-	
+        :: Size
+        -> (RI -> Reg -> Instr)
+        -> CmmExpr
+        -> NatM Register
+
 trivialUCode size instr x = do
     (src, code) <- getSomeReg x
     let
-    	code__2 dst = code `snocOL` instr (RIReg src) dst
+        code__2 dst = code `snocOL` instr (RIReg src) dst
     return (Any size code__2)
 
 
-trivialUFCode 
-	:: Size
-	-> (Reg -> Reg -> Instr)
-	-> CmmExpr
-	-> NatM Register 
-	
+trivialUFCode
+        :: Size
+        -> (Reg -> Reg -> Instr)
+        -> CmmExpr
+        -> NatM Register
+
 trivialUFCode pk instr x = do
     (src, code) <- getSomeReg x
     let
-    	code__2 dst = code `snocOL` instr src dst
+        code__2 dst = code `snocOL` instr src dst
     return (Any pk code__2)
 
 
@@ -551,10 +543,10 @@ coerceInt2FP :: Width -> Width -> CmmExpr -> NatM Register
 coerceInt2FP width1 width2 x = do
     (src, code) <- getSomeReg x
     let
-    	code__2 dst = code `appOL` toOL [
-    	    ST (intSize width1) src (spRel (-2)),
-    	    LD (intSize width1) (spRel (-2)) dst,
-    	    FxTOy (intSize width1) (floatSize width2) dst dst]
+        code__2 dst = code `appOL` toOL [
+            ST (intSize width1) src (spRel (-2)),
+            LD (intSize width1) (spRel (-2)) dst,
+            FxTOy (intSize width1) (floatSize width2) dst dst]
     return (Any (floatSize $ width2) code__2)
 
 
@@ -562,37 +554,37 @@ coerceInt2FP width1 width2 x = do
 -- | Coerce a floating point value to integer
 --
 --   NOTE: On sparc v9 there are no instructions to move a value from an
---	   FP register directly to an int register, so we have to use a load/store.
+--         FP register directly to an int register, so we have to use a load/store.
 --
 coerceFP2Int :: Width -> Width -> CmmExpr -> NatM Register
-coerceFP2Int width1 width2 x 
- = do	let fsize1	= floatSize width1
-	    fsize2	= floatSize width2
-	
-            isize2	= intSize   width2
+coerceFP2Int width1 width2 x
+ = do   let fsize1      = floatSize width1
+            fsize2      = floatSize width2
+
+            isize2      = intSize   width2
+
+        (fsrc, code)    <- getSomeReg x
+        fdst            <- getNewRegNat fsize2
 
-	(fsrc, code)	<- getSomeReg x
-	fdst		<- getNewRegNat fsize2
-    
-	let code2 dst	
-		= 	code
-		`appOL` toOL
-			-- convert float to int format, leaving it in a float reg.
-			[ FxTOy fsize1 isize2 fsrc fdst
+        let code2 dst
+                =       code
+                `appOL` toOL
+                        -- convert float to int format, leaving it in a float reg.
+                        [ FxTOy fsize1 isize2 fsrc fdst
 
-			-- store the int into mem, then load it back to move
-			--	it into an actual int reg.
-			, ST    fsize2 fdst (spRel (-2))
-			, LD	isize2 (spRel (-2)) dst]
+                        -- store the int into mem, then load it back to move
+                        --      it into an actual int reg.
+                        , ST    fsize2 fdst (spRel (-2))
+                        , LD    isize2 (spRel (-2)) dst]
 
-	return (Any isize2 code2)
+        return (Any isize2 code2)
 
 
 -- | Coerce a double precision floating point value to single precision.
 coerceDbl2Flt :: CmmExpr -> NatM Register
 coerceDbl2Flt x = do
     (src, code) <- getSomeReg x
-    return (Any FF32 (\dst -> code `snocOL` FxTOy FF64 FF32 src dst)) 
+    return (Any FF32 (\dst -> code `snocOL` FxTOy FF64 FF32 src dst))
 
 
 -- | Coerce a single precision floating point value to double precision
@@ -606,45 +598,45 @@ coerceFlt2Dbl x = do
 
 -- Condition Codes -------------------------------------------------------------
 --
--- Evaluate a comparision, and get the result into a register.
--- 
+-- Evaluate a comparison, and get the result into a register.
+--
 -- Do not fill the delay slots here. you will confuse the register allocator.
 --
 condIntReg :: Cond -> CmmExpr -> CmmExpr -> NatM Register
 condIntReg EQQ x (CmmLit (CmmInt 0 _)) = do
     (src, code) <- getSomeReg x
     let
-	code__2 dst = code `appOL` toOL [
-    	    SUB False True g0 (RIReg src) g0,
-    	    SUB True False g0 (RIImm (ImmInt (-1))) dst]
+        code__2 dst = code `appOL` toOL [
+            SUB False True g0 (RIReg src) g0,
+            SUB True False g0 (RIImm (ImmInt (-1))) dst]
     return (Any II32 code__2)
 
 condIntReg EQQ x y = do
     (src1, code1) <- getSomeReg x
     (src2, code2) <- getSomeReg y
     let
-    	code__2 dst = code1 `appOL` code2 `appOL` toOL [
-    	    XOR False src1 (RIReg src2) dst,
-    	    SUB False True g0 (RIReg dst) g0,
-    	    SUB True False g0 (RIImm (ImmInt (-1))) dst]
+        code__2 dst = code1 `appOL` code2 `appOL` toOL [
+            XOR False src1 (RIReg src2) dst,
+            SUB False True g0 (RIReg dst) g0,
+            SUB True False g0 (RIImm (ImmInt (-1))) dst]
     return (Any II32 code__2)
 
 condIntReg NE x (CmmLit (CmmInt 0 _)) = do
     (src, code) <- getSomeReg x
     let
-    	code__2 dst = code `appOL` toOL [
-    	    SUB False True g0 (RIReg src) g0,
-    	    ADD True False g0 (RIImm (ImmInt 0)) dst]
+        code__2 dst = code `appOL` toOL [
+            SUB False True g0 (RIReg src) g0,
+            ADD True False g0 (RIImm (ImmInt 0)) dst]
     return (Any II32 code__2)
 
 condIntReg NE x y = do
     (src1, code1) <- getSomeReg x
     (src2, code2) <- getSomeReg y
     let
-	code__2 dst = code1 `appOL` code2 `appOL` toOL [
-    	    XOR False src1 (RIReg src2) dst,
-    	    SUB False True g0 (RIReg dst) g0,
-    	    ADD True False g0 (RIImm (ImmInt 0)) dst]
+        code__2 dst = code1 `appOL` code2 `appOL` toOL [
+            XOR False src1 (RIReg src2) dst,
+            SUB False True g0 (RIReg dst) g0,
+            ADD True False g0 (RIImm (ImmInt 0)) dst]
     return (Any II32 code__2)
 
 condIntReg cond x y = do
@@ -652,22 +644,22 @@ condIntReg cond x y = do
     bid2 <- liftM (\a -> seq a a) getBlockIdNat
     CondCode _ cond cond_code <- condIntCode cond x y
     let
-	code__2 dst 
-	 =	cond_code 
-	  `appOL` toOL 
-		[ BI cond False bid1
-		, NOP
+        code__2 dst
+         =      cond_code
+          `appOL` toOL
+                [ BI cond False bid1
+                , NOP
 
-		, OR False g0 (RIImm (ImmInt 0)) dst
-		, BI ALWAYS False bid2
-		, NOP
+                , OR False g0 (RIImm (ImmInt 0)) dst
+                , BI ALWAYS False bid2
+                , NOP
 
-		, NEWBLOCK bid1
-		, OR False g0 (RIImm (ImmInt 1)) dst
-		, BI ALWAYS False bid2
-		, NOP
+                , NEWBLOCK bid1
+                , OR False g0 (RIImm (ImmInt 1)) dst
+                , BI ALWAYS False bid2
+                , NOP
 
-		, NEWBLOCK bid2]
+                , NEWBLOCK bid2]
 
     return (Any II32 code__2)
 
@@ -679,26 +671,22 @@ condFltReg cond x y = do
 
     CondCode _ cond cond_code <- condFltCode cond x y
     let
-    	code__2 dst 
-	 = 	cond_code 
-	  `appOL` toOL 
-	  	[ NOP
-		, BF cond False bid1
-		, NOP
+        code__2 dst
+         =      cond_code
+          `appOL` toOL
+                [ NOP
+                , BF cond False bid1
+                , NOP
 
-		, OR False g0 (RIImm (ImmInt 0)) dst
-		, BI ALWAYS False bid2
-		, NOP
+                , OR False g0 (RIImm (ImmInt 0)) dst
+                , BI ALWAYS False bid2
+                , NOP
 
-		, NEWBLOCK bid1
-		, OR False g0 (RIImm (ImmInt 1)) dst
-		, BI ALWAYS False bid2
-		, NOP
+                , NEWBLOCK bid1
+                , OR False g0 (RIImm (ImmInt 1)) dst
+                , BI ALWAYS False bid2
+                , NOP
 
-		, NEWBLOCK bid2 ]
+                , NEWBLOCK bid2 ]
 
     return (Any II32 code__2)
-
-
-
-
diff --git a/compiler/nativeGen/SPARC/CodeGen/Sanity.hs b/compiler/nativeGen/SPARC/CodeGen/Sanity.hs
index d4cdaf2b1672..81641326f2aa 100644
--- a/compiler/nativeGen/SPARC/CodeGen/Sanity.hs
+++ b/compiler/nativeGen/SPARC/CodeGen/Sanity.hs
@@ -1,22 +1,13 @@
-
-{-# OPTIONS -fno-warn-tabs #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and
--- detab the module (please do the detabbing in a separate patch). See
---     http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
--- for details
-
--- | One ounce of sanity checking is worth 10000000000000000 ounces 
---	of staring blindly at assembly code trying to find the problem..
---
+-- | One ounce of sanity checking is worth 10000000000000000 ounces
+-- of staring blindly at assembly code trying to find the problem..
 module SPARC.CodeGen.Sanity (
-	checkBlock
+        checkBlock
 )
 
 where
 
 import SPARC.Instr
-import SPARC.Ppr	()
+import SPARC.Ppr        ()
 import Instruction
 
 import Cmm
@@ -31,48 +22,46 @@ checkBlock :: CmmBlock
            -> NatBasicBlock Instr
 
 checkBlock cmm block@(BasicBlock _ instrs)
-	| checkBlockInstrs instrs
-	= block
-	
-	| otherwise
-	= pprPanic 
-		("SPARC.CodeGen: bad block\n")
-		( vcat	[ text " -- cmm -----------------\n"
-			, ppr cmm
-			, text " -- native code ---------\n"
-			, ppr block ])
+        | checkBlockInstrs instrs
+        = block
+
+        | otherwise
+        = pprPanic
+                ("SPARC.CodeGen: bad block\n")
+                ( vcat  [ text " -- cmm -----------------\n"
+                        , ppr cmm
+                        , text " -- native code ---------\n"
+                        , ppr block ])
 
 
 checkBlockInstrs :: [Instr] -> Bool
 checkBlockInstrs ii
 
-	-- An unconditional jumps end the block.
-	--	There must be an unconditional jump in the block, otherwise
-	--	the register liveness determinator will get the liveness
-	--	information wrong. 
-	--
-	--	If the block ends with a cmm call that never returns
-	--	then there can be unreachable instructions after the jump,
-	--	but we don't mind here.
-	--
-	| instr : NOP : _	<- ii 
-	, isUnconditionalJump instr
-	= True
-	
-	-- All jumps must have a NOP in their branch delay slot.
-	--	The liveness determinator and register allocators aren't smart
-	--	enough to handle branch delay slots.
-	--
-	| instr : NOP : is	<- ii
-	, isJumpishInstr instr
-	= checkBlockInstrs is
-
-	-- keep checking
-	| _:i2:is		<- ii
-	= checkBlockInstrs (i2:is)
-
-	-- this block is no good	
-	| otherwise
-	= False
-
-
+        -- An unconditional jumps end the block.
+        --      There must be an unconditional jump in the block, otherwise
+        --      the register liveness determinator will get the liveness
+        --      information wrong.
+        --
+        --      If the block ends with a cmm call that never returns
+        --      then there can be unreachable instructions after the jump,
+        --      but we don't mind here.
+        --
+        | instr : NOP : _       <- ii
+        , isUnconditionalJump instr
+        = True
+
+        -- All jumps must have a NOP in their branch delay slot.
+        --      The liveness determinator and register allocators aren't smart
+        --      enough to handle branch delay slots.
+        --
+        | instr : NOP : is      <- ii
+        , isJumpishInstr instr
+        = checkBlockInstrs is
+
+        -- keep checking
+        | _:i2:is               <- ii
+        = checkBlockInstrs (i2:is)
+
+        -- this block is no good
+        | otherwise
+        = False
diff --git a/compiler/nativeGen/SPARC/Cond.hs b/compiler/nativeGen/SPARC/Cond.hs
index b8919a72a2a7..da41457950e5 100644
--- a/compiler/nativeGen/SPARC/Cond.hs
+++ b/compiler/nativeGen/SPARC/Cond.hs
@@ -1,39 +1,31 @@
-
-{-# OPTIONS -fno-warn-tabs #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and
--- detab the module (please do the detabbing in a separate patch). See
---     http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
--- for details
-
 module SPARC.Cond (
-	Cond(..),
-	condUnsigned,
-	condToSigned,
-	condToUnsigned
+        Cond(..),
+        condUnsigned,
+        condToSigned,
+        condToUnsigned
 )
 
 where
 
 -- | Branch condition codes.
 data Cond
-	= ALWAYS
-	| EQQ
-	| GE
-	| GEU
-	| GTT
-	| GU
-	| LE
-	| LEU
-	| LTT
-	| LU
-	| NE
-	| NEG
-	| NEVER
-	| POS
-	| VC
-	| VS
-	deriving Eq
+        = ALWAYS
+        | EQQ
+        | GE
+        | GEU
+        | GTT
+        | GU
+        | LE
+        | LEU
+        | LTT
+        | LU
+        | NE
+        | NEG
+        | NEVER
+        | POS
+        | VC
+        | VS
+        deriving Eq
 
 
 condUnsigned :: Cond -> Bool
diff --git a/compiler/nativeGen/SPARC/Imm.hs b/compiler/nativeGen/SPARC/Imm.hs
index 4c2bb5a4814e..cb53ba411c6e 100644
--- a/compiler/nativeGen/SPARC/Imm.hs
+++ b/compiler/nativeGen/SPARC/Imm.hs
@@ -1,16 +1,8 @@
-
-{-# OPTIONS -fno-warn-tabs #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and
--- detab the module (please do the detabbing in a separate patch). See
---     http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
--- for details
-
 module SPARC.Imm (
-	-- immediate values
-	Imm(..),
-	strImmLit,
-	litToImm
+        -- immediate values
+        Imm(..),
+        strImmLit,
+        litToImm
 )
 
 where
@@ -21,29 +13,29 @@ import CLabel
 import Outputable
 
 -- | An immediate value.
---	Not all of these are directly representable by the machine. 
---	Things like ImmLit are slurped out and put in a data segment instead.
+--      Not all of these are directly representable by the machine.
+--      Things like ImmLit are slurped out and put in a data segment instead.
 --
 data Imm
-	= ImmInt	Int
+        = ImmInt        Int
 
-	-- Sigh.
-	| ImmInteger	Integer	    
+        -- Sigh.
+        | ImmInteger    Integer
 
-	-- AbstractC Label (with baggage)
-	| ImmCLbl	CLabel	    
+        -- AbstractC Label (with baggage)
+        | ImmCLbl       CLabel
 
-	-- Simple string
-	| ImmLit	SDoc
-	| ImmIndex	CLabel Int
-	| ImmFloat	Rational
-	| ImmDouble	Rational
+        -- Simple string
+        | ImmLit        SDoc
+        | ImmIndex      CLabel Int
+        | ImmFloat      Rational
+        | ImmDouble     Rational
 
-	| ImmConstantSum  Imm Imm
-	| ImmConstantDiff Imm Imm
+        | ImmConstantSum  Imm Imm
+        | ImmConstantDiff Imm Imm
 
-	| LO 	Imm		   
-	| HI 	Imm
+        | LO    Imm
+        | HI    Imm
 
 
 -- | Create a ImmLit containing this string.
@@ -52,24 +44,22 @@ strImmLit s = ImmLit (text s)
 
 
 -- | Convert a CmmLit to an Imm.
--- 	Narrow to the width: a CmmInt might be out of
--- 	range, but we assume that ImmInteger only contains
--- 	in-range values.  A signed value should be fine here.
+--      Narrow to the width: a CmmInt might be out of
+--      range, but we assume that ImmInteger only contains
+--      in-range values.  A signed value should be fine here.
 --
 litToImm :: CmmLit -> Imm
 litToImm lit
  = case lit of
- 	CmmInt i w		-> ImmInteger (narrowS w i)
-	CmmFloat f W32		-> ImmFloat f
-	CmmFloat f W64		-> ImmDouble f
-	CmmLabel l		-> ImmCLbl l
-	CmmLabelOff l off	-> ImmIndex l off
+        CmmInt i w              -> ImmInteger (narrowS w i)
+        CmmFloat f W32          -> ImmFloat f
+        CmmFloat f W64          -> ImmDouble f
+        CmmLabel l              -> ImmCLbl l
+        CmmLabelOff l off       -> ImmIndex l off
 
-	CmmLabelDiffOff l1 l2 off
-	 -> ImmConstantSum
-		(ImmConstantDiff (ImmCLbl l1) (ImmCLbl l2))
-		(ImmInt off)
+        CmmLabelDiffOff l1 l2 off
+         -> ImmConstantSum
+                (ImmConstantDiff (ImmCLbl l1) (ImmCLbl l2))
+                (ImmInt off)
 
         _               -> panic "SPARC.Regs.litToImm: no match"
-
-
diff --git a/compiler/nativeGen/SPARC/Instr.hs b/compiler/nativeGen/SPARC/Instr.hs
index 601e04787a54..fb8cc0cadc2c 100644
--- a/compiler/nativeGen/SPARC/Instr.hs
+++ b/compiler/nativeGen/SPARC/Instr.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE CPP #-}
+
 -----------------------------------------------------------------------------
 --
 -- Machine-dependent assembly language
@@ -5,28 +7,20 @@
 -- (c) The University of Glasgow 1993-2004
 --
 -----------------------------------------------------------------------------
-
-{-# OPTIONS -fno-warn-tabs #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and
--- detab the module (please do the detabbing in a separate patch). See
---     http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
--- for details
-
 #include "HsVersions.h"
 #include "nativeGen/NCG.h"
 
 module SPARC.Instr (
-	RI(..),
-	riZero,
-
-	fpRelEA,
-	moveSp,
-	
-	isUnconditionalJump,
-	
-	Instr(..),
-	maxSpillSlots
+        RI(..),
+        riZero,
+
+        fpRelEA,
+        moveSp,
+
+        isUnconditionalJump,
+
+        Instr(..),
+        maxSpillSlots
 )
 
 where
@@ -55,23 +49,23 @@ import Platform
 
 
 -- | Register or immediate
-data RI 
-	= RIReg Reg
-	| RIImm Imm
+data RI
+        = RIReg Reg
+        | RIImm Imm
 
 -- | Check if a RI represents a zero value.
---  	- a literal zero
---	- register %g0, which is always zero.
+--      - a literal zero
+--      - register %g0, which is always zero.
 --
-riZero :: RI -> Bool	
-riZero (RIImm (ImmInt 0))			= True
-riZero (RIImm (ImmInteger 0))			= True
-riZero (RIReg (RegReal (RealRegSingle 0)))	= True
-riZero _					= False
+riZero :: RI -> Bool
+riZero (RIImm (ImmInt 0))                       = True
+riZero (RIImm (ImmInteger 0))                   = True
+riZero (RIReg (RegReal (RealRegSingle 0)))      = True
+riZero _                                        = False
 
 
 -- | Calculate the effective address which would be used by the
--- 	corresponding fpRel sequence. 
+--      corresponding fpRel sequence.
 fpRelEA :: Int -> Reg -> Instr
 fpRelEA n dst
    = ADD False False fp (RIImm (ImmInt (n * wordLength))) dst
@@ -86,294 +80,294 @@ moveSp n
 isUnconditionalJump :: Instr -> Bool
 isUnconditionalJump ii
  = case ii of
- 	CALL{}		-> True
-	JMP{}		-> True
-	JMP_TBL{}	-> True
-	BI ALWAYS _ _	-> True
-	BF ALWAYS _ _ 	-> True
-	_		-> False
+        CALL{}          -> True
+        JMP{}           -> True
+        JMP_TBL{}       -> True
+        BI ALWAYS _ _   -> True
+        BF ALWAYS _ _   -> True
+        _               -> False
 
 
 -- | instance for sparc instruction set
 instance Instruction Instr where
-	regUsageOfInstr		= sparc_regUsageOfInstr
-	patchRegsOfInstr	= sparc_patchRegsOfInstr
-	isJumpishInstr		= sparc_isJumpishInstr
-	jumpDestsOfInstr	= sparc_jumpDestsOfInstr
-	patchJumpInstr		= sparc_patchJumpInstr
-	mkSpillInstr		= sparc_mkSpillInstr
-	mkLoadInstr		= sparc_mkLoadInstr
-	takeDeltaInstr		= sparc_takeDeltaInstr
-	isMetaInstr		= sparc_isMetaInstr
-	mkRegRegMoveInstr	= sparc_mkRegRegMoveInstr
-	takeRegRegMoveInstr	= sparc_takeRegRegMoveInstr
-	mkJumpInstr		= sparc_mkJumpInstr
+        regUsageOfInstr         = sparc_regUsageOfInstr
+        patchRegsOfInstr        = sparc_patchRegsOfInstr
+        isJumpishInstr          = sparc_isJumpishInstr
+        jumpDestsOfInstr        = sparc_jumpDestsOfInstr
+        patchJumpInstr          = sparc_patchJumpInstr
+        mkSpillInstr            = sparc_mkSpillInstr
+        mkLoadInstr             = sparc_mkLoadInstr
+        takeDeltaInstr          = sparc_takeDeltaInstr
+        isMetaInstr             = sparc_isMetaInstr
+        mkRegRegMoveInstr       = sparc_mkRegRegMoveInstr
+        takeRegRegMoveInstr     = sparc_takeRegRegMoveInstr
+        mkJumpInstr             = sparc_mkJumpInstr
         mkStackAllocInstr       = panic "no sparc_mkStackAllocInstr"
         mkStackDeallocInstr     = panic "no sparc_mkStackDeallocInstr"
 
 
 -- | SPARC instruction set.
---	Not complete. This is only the ones we need.
+--      Not complete. This is only the ones we need.
 --
 data Instr
 
-	-- meta ops --------------------------------------------------
-	-- comment pseudo-op
-	= COMMENT FastString		
-
-	-- some static data spat out during code generation.
-	-- Will be extracted before pretty-printing.
-	| LDATA   Section CmmStatics	
-
-	-- Start a new basic block.  Useful during codegen, removed later.
-	-- Preceding instruction should be a jump, as per the invariants
-	-- for a BasicBlock (see Cmm).
-	| NEWBLOCK BlockId		
-
-	-- specify current stack offset for benefit of subsequent passes.
-	| DELTA   Int
-
-	-- real instrs -----------------------------------------------
-	-- Loads and stores.
-	| LD		Size AddrMode Reg 		-- size, src, dst
-	| ST		Size Reg AddrMode 		-- size, src, dst
-
-	-- Int Arithmetic.
-	--	x:   add/sub with carry bit. 
-	--		In SPARC V9 addx and friends were renamed addc. 
-	--
-	--	cc:  modify condition codes
-	-- 
-	| ADD		Bool Bool Reg RI Reg 		-- x?, cc?, src1, src2, dst
-	| SUB		Bool Bool Reg RI Reg 		-- x?, cc?, src1, src2, dst
-
-	| UMUL		Bool Reg RI Reg 		--     cc?, src1, src2, dst
-	| SMUL	        Bool Reg RI Reg 		--     cc?, src1, src2, dst
-
-
-	-- The SPARC divide instructions perform 64bit by 32bit division
-	--   The Y register is xored into the first operand.
-
-	--   On _some implementations_ the Y register is overwritten by
-	--   the remainder, so we have to make sure it is 0 each time.
-
-	--   dst <- ((Y `shiftL` 32) `or` src1) `div` src2
-	| UDIV          Bool Reg RI Reg 		--     cc?, src1, src2, dst
-	| SDIV          Bool Reg RI Reg 		--     cc?, src1, src2, dst
-
- 	| RDY           Reg                  		-- move contents of Y register to reg
-	| WRY           Reg  Reg             		-- Y <- src1 `xor` src2
-	
-	-- Logic operations.
-	| AND		Bool Reg RI Reg 		-- cc?, src1, src2, dst
-	| ANDN		Bool Reg RI Reg 		-- cc?, src1, src2, dst
-	| OR		Bool Reg RI Reg 		-- cc?, src1, src2, dst
-	| ORN		Bool Reg RI Reg 		-- cc?, src1, src2, dst
-	| XOR		Bool Reg RI Reg 		-- cc?, src1, src2, dst
-	| XNOR		Bool Reg RI Reg 		-- cc?, src1, src2, dst
-	| SLL		Reg RI Reg 			-- src1, src2, dst
-	| SRL		Reg RI Reg 			-- src1, src2, dst
-	| SRA		Reg RI Reg 			-- src1, src2, dst
-
-	-- Load immediates.
-	| SETHI		Imm Reg 			-- src, dst
-
-	-- Do nothing.
-	-- Implemented by the assembler as SETHI 0, %g0, but worth an alias
-	| NOP						
-
-	-- Float Arithmetic.
-	-- Note that we cheat by treating F{ABS,MOV,NEG} of doubles as single
-	-- instructions right up until we spit them out.
-	--
-	| FABS		Size Reg Reg	   		-- src dst
-	| FADD		Size Reg Reg Reg  		-- src1, src2, dst
-	| FCMP		Bool Size Reg Reg 		-- exception?, src1, src2, dst
-	| FDIV		Size Reg Reg Reg 		-- src1, src2, dst
-	| FMOV		Size Reg Reg     		-- src, dst
-	| FMUL		Size Reg Reg Reg 		-- src1, src2, dst
- 	| FNEG		Size Reg Reg     		-- src, dst
-	| FSQRT		Size Reg Reg     		-- src, dst
-	| FSUB		Size Reg Reg Reg 		-- src1, src2, dst
-	| FxTOy		Size Size Reg Reg 		-- src, dst
-
-	-- Jumping around.
-	| BI		Cond Bool BlockId 		-- cond, annul?, target
-	| BF		Cond Bool BlockId 		-- cond, annul?, target
-
-	| JMP		AddrMode     			-- target
-
-	-- 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 [Maybe BlockId] CLabel
-
-	| CALL		(Either Imm Reg) Int Bool 	-- target, args, terminal
+        -- meta ops --------------------------------------------------
+        -- comment pseudo-op
+        = COMMENT FastString
+
+        -- some static data spat out during code generation.
+        -- Will be extracted before pretty-printing.
+        | LDATA   Section CmmStatics
+
+        -- Start a new basic block.  Useful during codegen, removed later.
+        -- Preceding instruction should be a jump, as per the invariants
+        -- for a BasicBlock (see Cmm).
+        | NEWBLOCK BlockId
+
+        -- specify current stack offset for benefit of subsequent passes.
+        | DELTA   Int
+
+        -- real instrs -----------------------------------------------
+        -- Loads and stores.
+        | LD            Size AddrMode Reg               -- size, src, dst
+        | ST            Size Reg AddrMode               -- size, src, dst
+
+        -- Int Arithmetic.
+        --      x:   add/sub with carry bit.
+        --              In SPARC V9 addx and friends were renamed addc.
+        --
+        --      cc:  modify condition codes
+        --
+        | ADD           Bool Bool Reg RI Reg            -- x?, cc?, src1, src2, dst
+        | SUB           Bool Bool Reg RI Reg            -- x?, cc?, src1, src2, dst
+
+        | UMUL          Bool Reg RI Reg                 --     cc?, src1, src2, dst
+        | SMUL          Bool Reg RI Reg                 --     cc?, src1, src2, dst
+
+
+        -- The SPARC divide instructions perform 64bit by 32bit division
+        --   The Y register is xored into the first operand.
+
+        --   On _some implementations_ the Y register is overwritten by
+        --   the remainder, so we have to make sure it is 0 each time.
+
+        --   dst <- ((Y `shiftL` 32) `or` src1) `div` src2
+        | UDIV          Bool Reg RI Reg                 --     cc?, src1, src2, dst
+        | SDIV          Bool Reg RI Reg                 --     cc?, src1, src2, dst
+
+        | RDY           Reg                             -- move contents of Y register to reg
+        | WRY           Reg  Reg                        -- Y <- src1 `xor` src2
+
+        -- Logic operations.
+        | AND           Bool Reg RI Reg                 -- cc?, src1, src2, dst
+        | ANDN          Bool Reg RI Reg                 -- cc?, src1, src2, dst
+        | OR            Bool Reg RI Reg                 -- cc?, src1, src2, dst
+        | ORN           Bool Reg RI Reg                 -- cc?, src1, src2, dst
+        | XOR           Bool Reg RI Reg                 -- cc?, src1, src2, dst
+        | XNOR          Bool Reg RI Reg                 -- cc?, src1, src2, dst
+        | SLL           Reg RI Reg                      -- src1, src2, dst
+        | SRL           Reg RI Reg                      -- src1, src2, dst
+        | SRA           Reg RI Reg                      -- src1, src2, dst
+
+        -- Load immediates.
+        | SETHI         Imm Reg                         -- src, dst
+
+        -- Do nothing.
+        -- Implemented by the assembler as SETHI 0, %g0, but worth an alias
+        | NOP
+
+        -- Float Arithmetic.
+        -- Note that we cheat by treating F{ABS,MOV,NEG} of doubles as single
+        -- instructions right up until we spit them out.
+        --
+        | FABS          Size Reg Reg                    -- src dst
+        | FADD          Size Reg Reg Reg                -- src1, src2, dst
+        | FCMP          Bool Size Reg Reg               -- exception?, src1, src2, dst
+        | FDIV          Size Reg Reg Reg                -- src1, src2, dst
+        | FMOV          Size Reg Reg                    -- src, dst
+        | FMUL          Size Reg Reg Reg                -- src1, src2, dst
+        | FNEG          Size Reg Reg                    -- src, dst
+        | FSQRT         Size Reg Reg                    -- src, dst
+        | FSUB          Size Reg Reg Reg                -- src1, src2, dst
+        | FxTOy         Size Size Reg Reg               -- src, dst
+
+        -- Jumping around.
+        | BI            Cond Bool BlockId               -- cond, annul?, target
+        | BF            Cond Bool BlockId               -- cond, annul?, target
+
+        | JMP           AddrMode                        -- target
+
+        -- 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 [Maybe BlockId] CLabel
+
+        | CALL          (Either Imm Reg) Int Bool       -- target, args, terminal
 
 
 -- | regUsage returns the sets of src and destination registers used
--- 	by a particular instruction.  Machine registers that are
--- 	pre-allocated to stgRegs are filtered out, because they are
--- 	uninteresting from a register allocation standpoint.  (We wouldn't
--- 	want them to end up on the free list!)  As far as we are concerned,
--- 	the fixed registers simply don't exist (for allocation purposes,
--- 	anyway).
-
--- 	regUsage doesn't need to do any trickery for jumps and such.  Just
--- 	state precisely the regs read and written by that insn.  The
--- 	consequences of control flow transfers, as far as register
--- 	allocation goes, are taken care of by the register allocator.
+--      by a particular instruction.  Machine registers that are
+--      pre-allocated to stgRegs are filtered out, because they are
+--      uninteresting from a register allocation standpoint.  (We wouldn't
+--      want them to end up on the free list!)  As far as we are concerned,
+--      the fixed registers simply don't exist (for allocation purposes,
+--      anyway).
+
+--      regUsage doesn't need to do any trickery for jumps and such.  Just
+--      state precisely the regs read and written by that insn.  The
+--      consequences of control flow transfers, as far as register
+--      allocation goes, are taken care of by the register allocator.
 --
 sparc_regUsageOfInstr :: Platform -> Instr -> RegUsage
 sparc_regUsageOfInstr platform instr
  = case instr of
-    LD    _ addr reg  		-> usage (regAddr addr, 	[reg])
-    ST    _ reg addr  		-> usage (reg : regAddr addr, 	[])
-    ADD   _ _ r1 ar r2		-> usage (r1 : regRI ar, 	[r2])
-    SUB   _ _ r1 ar r2		-> usage (r1 : regRI ar, 	[r2])
-    UMUL    _ r1 ar r2		-> usage (r1 : regRI ar, 	[r2])
-    SMUL    _ r1 ar r2		-> usage (r1 : regRI ar, 	[r2])
-    UDIV    _ r1 ar r2		-> usage (r1 : regRI ar, 	[r2])
-    SDIV    _ r1 ar r2		-> usage (r1 : regRI ar, 	[r2])
-    RDY       rd           	-> usage ([], 		 	[rd])
-    WRY       r1 r2        	-> usage ([r1, r2], 	 	[])
-    AND     _ r1 ar r2  	-> usage (r1 : regRI ar, 	[r2])
-    ANDN    _ r1 ar r2 		-> usage (r1 : regRI ar, 	[r2])
-    OR      _ r1 ar r2   	-> usage (r1 : regRI ar, 	[r2])
-    ORN     _ r1 ar r2  	-> usage (r1 : regRI ar, 	[r2])
-    XOR     _ r1 ar r2  	-> usage (r1 : regRI ar, 	[r2])
-    XNOR    _ r1 ar r2 		-> usage (r1 : regRI ar, 	[r2])
-    SLL       r1 ar r2    	-> usage (r1 : regRI ar, 	[r2])
-    SRL       r1 ar r2    	-> usage (r1 : regRI ar,	[r2])
-    SRA       r1 ar r2    	-> usage (r1 : regRI ar, 	[r2])
-    SETHI   _ reg   		-> usage ([], 			[reg])
-    FABS    _ r1 r2    		-> usage ([r1], 		[r2])
-    FADD    _ r1 r2 r3 		-> usage ([r1, r2],		[r3])
-    FCMP    _ _  r1 r2  	-> usage ([r1, r2], 		[])
-    FDIV    _ r1 r2 r3 		-> usage ([r1, r2], 		[r3])
-    FMOV    _ r1 r2    		-> usage ([r1],			[r2])
-    FMUL    _ r1 r2 r3 		-> usage ([r1, r2],	 	[r3])
-    FNEG    _ r1 r2    		-> usage ([r1], 		[r2])
-    FSQRT   _ r1 r2   		-> usage ([r1], 		[r2])
-    FSUB    _ r1 r2 r3 		-> usage ([r1, r2], 		[r3])
-    FxTOy   _ _  r1 r2 		-> usage ([r1], 		[r2])
-
-    JMP     addr 		-> usage (regAddr addr, [])
-    JMP_TBL addr _ _    	-> usage (regAddr addr, [])
-
-    CALL  (Left _  )  _ True  	-> noUsage
-    CALL  (Left _  )  n False 	-> usage (argRegs n, callClobberedRegs)
-    CALL  (Right reg) _ True  	-> usage ([reg], [])
-    CALL  (Right reg) n False 	-> usage (reg : (argRegs n), callClobberedRegs)
-    _ 	    	    		-> noUsage
+    LD    _ addr reg            -> usage (regAddr addr,         [reg])
+    ST    _ reg addr            -> usage (reg : regAddr addr,   [])
+    ADD   _ _ r1 ar r2          -> usage (r1 : regRI ar,        [r2])
+    SUB   _ _ r1 ar r2          -> usage (r1 : regRI ar,        [r2])
+    UMUL    _ r1 ar r2          -> usage (r1 : regRI ar,        [r2])
+    SMUL    _ r1 ar r2          -> usage (r1 : regRI ar,        [r2])
+    UDIV    _ r1 ar r2          -> usage (r1 : regRI ar,        [r2])
+    SDIV    _ r1 ar r2          -> usage (r1 : regRI ar,        [r2])
+    RDY       rd                -> usage ([],                   [rd])
+    WRY       r1 r2             -> usage ([r1, r2],             [])
+    AND     _ r1 ar r2          -> usage (r1 : regRI ar,        [r2])
+    ANDN    _ r1 ar r2          -> usage (r1 : regRI ar,        [r2])
+    OR      _ r1 ar r2          -> usage (r1 : regRI ar,        [r2])
+    ORN     _ r1 ar r2          -> usage (r1 : regRI ar,        [r2])
+    XOR     _ r1 ar r2          -> usage (r1 : regRI ar,        [r2])
+    XNOR    _ r1 ar r2          -> usage (r1 : regRI ar,        [r2])
+    SLL       r1 ar r2          -> usage (r1 : regRI ar,        [r2])
+    SRL       r1 ar r2          -> usage (r1 : regRI ar,        [r2])
+    SRA       r1 ar r2          -> usage (r1 : regRI ar,        [r2])
+    SETHI   _ reg               -> usage ([],                   [reg])
+    FABS    _ r1 r2             -> usage ([r1],                 [r2])
+    FADD    _ r1 r2 r3          -> usage ([r1, r2],             [r3])
+    FCMP    _ _  r1 r2          -> usage ([r1, r2],             [])
+    FDIV    _ r1 r2 r3          -> usage ([r1, r2],             [r3])
+    FMOV    _ r1 r2             -> usage ([r1],                 [r2])
+    FMUL    _ r1 r2 r3          -> usage ([r1, r2],             [r3])
+    FNEG    _ r1 r2             -> usage ([r1],                 [r2])
+    FSQRT   _ r1 r2             -> usage ([r1],                 [r2])
+    FSUB    _ r1 r2 r3          -> usage ([r1, r2],             [r3])
+    FxTOy   _ _  r1 r2          -> usage ([r1],                 [r2])
+
+    JMP     addr                -> usage (regAddr addr, [])
+    JMP_TBL addr _ _            -> usage (regAddr addr, [])
+
+    CALL  (Left _  )  _ True    -> noUsage
+    CALL  (Left _  )  n False   -> usage (argRegs n, callClobberedRegs)
+    CALL  (Right reg) _ True    -> usage ([reg], [])
+    CALL  (Right reg) n False   -> usage (reg : (argRegs n), callClobberedRegs)
+    _                           -> noUsage
 
   where
-    usage (src, dst) 
+    usage (src, dst)
      = RU (filter (interesting platform) src)
           (filter (interesting platform) dst)
 
-    regAddr (AddrRegReg r1 r2)	= [r1, r2]
-    regAddr (AddrRegImm r1 _)	= [r1]
+    regAddr (AddrRegReg r1 r2)  = [r1, r2]
+    regAddr (AddrRegImm r1 _)   = [r1]
 
-    regRI (RIReg r)		= [r]
-    regRI  _			= []
+    regRI (RIReg r)             = [r]
+    regRI  _                    = []
 
 
--- | Interesting regs are virtuals, or ones that are allocatable 
---	by the register allocator.
+-- | Interesting regs are virtuals, or ones that are allocatable
+--      by the register allocator.
 interesting :: Platform -> Reg -> Bool
 interesting platform reg
  = case reg of
-	RegVirtual _			-> True
-	RegReal (RealRegSingle r1)	-> isFastTrue (freeReg platform r1)
-	RegReal (RealRegPair r1 _)	-> isFastTrue (freeReg platform r1)
+        RegVirtual _                    -> True
+        RegReal (RealRegSingle r1)      -> isFastTrue (freeReg platform r1)
+        RegReal (RealRegPair r1 _)      -> isFastTrue (freeReg platform r1)
 
 
 
 -- | Apply a given mapping to tall the register references in this instruction.
 sparc_patchRegsOfInstr :: Instr -> (Reg -> Reg) -> Instr
 sparc_patchRegsOfInstr instr env = case instr of
-    LD    sz addr reg   	-> LD sz (fixAddr addr) (env reg)
-    ST    sz reg addr   	-> ST sz (env reg) (fixAddr addr)
-
-    ADD   x cc r1 ar r2 	-> ADD   x cc  (env r1) (fixRI ar) (env r2)
-    SUB   x cc r1 ar r2	 	-> SUB   x cc  (env r1) (fixRI ar) (env r2)
-    UMUL    cc r1 ar r2		-> UMUL    cc  (env r1) (fixRI ar) (env r2)
-    SMUL    cc r1 ar r2		-> SMUL    cc  (env r1) (fixRI ar) (env r2)
-    UDIV    cc r1 ar r2		-> UDIV    cc  (env r1) (fixRI ar) (env r2)
-    SDIV    cc r1 ar r2		-> SDIV    cc  (env r1) (fixRI ar) (env r2)
-    RDY   rd            	-> RDY         (env rd)
-    WRY   r1 r2			-> WRY         (env r1) (env r2)
-    AND   b r1 ar r2   	 	-> AND   b     (env r1) (fixRI ar) (env r2)
-    ANDN  b r1 ar r2    	-> ANDN  b     (env r1) (fixRI ar) (env r2)
-    OR    b r1 ar r2   		-> OR    b     (env r1) (fixRI ar) (env r2)
-    ORN   b r1 ar r2    	-> ORN   b     (env r1) (fixRI ar) (env r2)
-    XOR   b r1 ar r2    	-> XOR   b     (env r1) (fixRI ar) (env r2)
-    XNOR  b r1 ar r2    	-> XNOR  b     (env r1) (fixRI ar) (env r2)
-    SLL   r1 ar r2      	-> SLL         (env r1) (fixRI ar) (env r2)
-    SRL   r1 ar r2      	-> SRL         (env r1) (fixRI ar) (env r2)
-    SRA   r1 ar r2      	-> SRA         (env r1) (fixRI ar) (env r2)
-
-    SETHI imm reg       	-> SETHI imm (env reg)
-
-    FABS  s r1 r2       	-> FABS    s   (env r1) (env r2)
-    FADD  s r1 r2 r3    	-> FADD    s   (env r1) (env r2) (env r3)
-    FCMP  e s r1 r2     	-> FCMP e  s   (env r1) (env r2)
-    FDIV  s r1 r2 r3    	-> FDIV    s   (env r1) (env r2) (env r3)
-    FMOV  s r1 r2       	-> FMOV    s   (env r1) (env r2)
-    FMUL  s r1 r2 r3    	-> FMUL    s   (env r1) (env r2) (env r3)
-    FNEG  s r1 r2       	-> FNEG    s   (env r1) (env r2)
-    FSQRT s r1 r2       	-> FSQRT   s   (env r1) (env r2)
-    FSUB  s r1 r2 r3   	 	-> FSUB    s   (env r1) (env r2) (env r3)
-    FxTOy s1 s2 r1 r2   	-> FxTOy s1 s2 (env r1) (env r2)
-
-    JMP     addr        	-> JMP     (fixAddr addr)
-    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
-    _ 				-> instr
+    LD    sz addr reg           -> LD sz (fixAddr addr) (env reg)
+    ST    sz reg addr           -> ST sz (env reg) (fixAddr addr)
+
+    ADD   x cc r1 ar r2         -> ADD   x cc  (env r1) (fixRI ar) (env r2)
+    SUB   x cc r1 ar r2         -> SUB   x cc  (env r1) (fixRI ar) (env r2)
+    UMUL    cc r1 ar r2         -> UMUL    cc  (env r1) (fixRI ar) (env r2)
+    SMUL    cc r1 ar r2         -> SMUL    cc  (env r1) (fixRI ar) (env r2)
+    UDIV    cc r1 ar r2         -> UDIV    cc  (env r1) (fixRI ar) (env r2)
+    SDIV    cc r1 ar r2         -> SDIV    cc  (env r1) (fixRI ar) (env r2)
+    RDY   rd                    -> RDY         (env rd)
+    WRY   r1 r2                 -> WRY         (env r1) (env r2)
+    AND   b r1 ar r2            -> AND   b     (env r1) (fixRI ar) (env r2)
+    ANDN  b r1 ar r2            -> ANDN  b     (env r1) (fixRI ar) (env r2)
+    OR    b r1 ar r2            -> OR    b     (env r1) (fixRI ar) (env r2)
+    ORN   b r1 ar r2            -> ORN   b     (env r1) (fixRI ar) (env r2)
+    XOR   b r1 ar r2            -> XOR   b     (env r1) (fixRI ar) (env r2)
+    XNOR  b r1 ar r2            -> XNOR  b     (env r1) (fixRI ar) (env r2)
+    SLL   r1 ar r2              -> SLL         (env r1) (fixRI ar) (env r2)
+    SRL   r1 ar r2              -> SRL         (env r1) (fixRI ar) (env r2)
+    SRA   r1 ar r2              -> SRA         (env r1) (fixRI ar) (env r2)
+
+    SETHI imm reg               -> SETHI imm (env reg)
+
+    FABS  s r1 r2               -> FABS    s   (env r1) (env r2)
+    FADD  s r1 r2 r3            -> FADD    s   (env r1) (env r2) (env r3)
+    FCMP  e s r1 r2             -> FCMP e  s   (env r1) (env r2)
+    FDIV  s r1 r2 r3            -> FDIV    s   (env r1) (env r2) (env r3)
+    FMOV  s r1 r2               -> FMOV    s   (env r1) (env r2)
+    FMUL  s r1 r2 r3            -> FMUL    s   (env r1) (env r2) (env r3)
+    FNEG  s r1 r2               -> FNEG    s   (env r1) (env r2)
+    FSQRT s r1 r2               -> FSQRT   s   (env r1) (env r2)
+    FSUB  s r1 r2 r3            -> FSUB    s   (env r1) (env r2) (env r3)
+    FxTOy s1 s2 r1 r2           -> FxTOy s1 s2 (env r1) (env r2)
+
+    JMP     addr                -> JMP     (fixAddr addr)
+    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
+    _                           -> instr
 
   where
-    fixAddr (AddrRegReg r1 r2) 	= AddrRegReg   (env r1) (env r2)
-    fixAddr (AddrRegImm r1 i)  	= AddrRegImm   (env r1) i
+    fixAddr (AddrRegReg r1 r2)  = AddrRegReg   (env r1) (env r2)
+    fixAddr (AddrRegImm r1 i)   = AddrRegImm   (env r1) i
 
-    fixRI (RIReg r) 		= RIReg (env r)
-    fixRI other			= other
+    fixRI (RIReg r)             = RIReg (env r)
+    fixRI other                 = other
 
 
 --------------------------------------------------------------------------------
 sparc_isJumpishInstr :: Instr -> Bool
 sparc_isJumpishInstr instr
  = case instr of
-	BI{}		-> True
-	BF{}		-> True
-	JMP{}		-> True
-	JMP_TBL{}	-> True
-	CALL{}		-> True
-	_		-> False
+        BI{}            -> True
+        BF{}            -> True
+        JMP{}           -> True
+        JMP_TBL{}       -> True
+        CALL{}          -> True
+        _               -> False
 
 sparc_jumpDestsOfInstr :: Instr -> [BlockId]
 sparc_jumpDestsOfInstr insn
   = case insn of
-	BI   _ _ id	-> [id]
-	BF   _ _ id	-> [id]
-	JMP_TBL _ ids _	-> [id | Just id <- ids]
-	_		-> []
+        BI   _ _ id     -> [id]
+        BF   _ _ id     -> [id]
+        JMP_TBL _ ids _ -> [id | Just id <- ids]
+        _               -> []
 
 
 sparc_patchJumpInstr :: Instr -> (BlockId -> BlockId) -> Instr
 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
+        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
 
 
 --------------------------------------------------------------------------------
 -- | Make a spill instruction.
--- 	On SPARC we spill below frame pointer leaving 2 words/spill
+--      On SPARC we spill below frame pointer leaving 2 words/spill
 sparc_mkSpillInstr
     :: DynFlags
     -> Reg      -- ^ register to spill
@@ -385,12 +379,12 @@ sparc_mkSpillInstr dflags reg _ slot
  = let  platform = targetPlatform dflags
         off      = spillSlotToOffset dflags slot
         off_w    = 1 + (off `div` 4)
-        sz 	= case targetClassOfReg platform reg of
-			RcInteger -> II32
-			RcFloat   -> FF32
-			RcDouble  -> FF64
-			_         -> panic "sparc_mkSpillInstr"
-		
+        sz      = case targetClassOfReg platform reg of
+                        RcInteger -> II32
+                        RcFloat   -> FF32
+                        RcDouble  -> FF64
+                        _         -> panic "sparc_mkSpillInstr"
+
     in ST sz reg (fpRel (negate off_w))
 
 
@@ -405,12 +399,12 @@ sparc_mkLoadInstr
 sparc_mkLoadInstr dflags reg _ slot
   = let platform = targetPlatform dflags
         off      = spillSlotToOffset dflags slot
-	off_w	= 1 + (off `div` 4)
-        sz	= case targetClassOfReg platform reg of
-			RcInteger -> II32
-			RcFloat   -> FF32
-			RcDouble  -> FF64
-			_         -> panic "sparc_mkLoadInstr"
+        off_w   = 1 + (off `div` 4)
+        sz      = case targetClassOfReg platform reg of
+                        RcInteger -> II32
+                        RcFloat   -> FF32
+                        RcDouble  -> FF64
+                        _         -> panic "sparc_mkLoadInstr"
 
         in LD sz (fpRel (- off_w)) reg
 
@@ -418,32 +412,32 @@ sparc_mkLoadInstr dflags reg _ slot
 --------------------------------------------------------------------------------
 -- | See if this instruction is telling us the current C stack delta
 sparc_takeDeltaInstr
-	:: Instr
-	-> Maybe Int
-	
+        :: Instr
+        -> Maybe Int
+
 sparc_takeDeltaInstr instr
  = case instr of
- 	DELTA i		-> Just i
-	_		-> Nothing
+        DELTA i         -> Just i
+        _               -> Nothing
 
 
 sparc_isMetaInstr
-	:: Instr
-	-> Bool
-	
+        :: Instr
+        -> Bool
+
 sparc_isMetaInstr instr
  = case instr of
- 	COMMENT{}	-> True
-	LDATA{}		-> True
-	NEWBLOCK{}	-> True
-	DELTA{}		-> True
-	_		-> False
-	
+        COMMENT{}       -> True
+        LDATA{}         -> True
+        NEWBLOCK{}      -> True
+        DELTA{}         -> True
+        _               -> False
+
 
 -- | Make a reg-reg move instruction.
---	On SPARC v8 there are no instructions to move directly between
---	floating point and integer regs. If we need to do that then we
---	have to go via memory.
+--      On SPARC v8 there are no instructions to move directly between
+--      floating point and integer regs. If we need to do that then we
+--      have to go via memory.
 --
 sparc_mkRegRegMoveInstr
     :: Platform
@@ -452,40 +446,39 @@ sparc_mkRegRegMoveInstr
     -> Instr
 
 sparc_mkRegRegMoveInstr platform src dst
-	| srcClass	<- targetClassOfReg platform src
-	, dstClass	<- targetClassOfReg platform dst
-	, srcClass == dstClass
-	= case srcClass of
-		RcInteger -> ADD  False False src (RIReg g0) dst
-		RcDouble  -> FMOV FF64 src dst
-		RcFloat   -> FMOV FF32 src dst
+        | srcClass      <- targetClassOfReg platform src
+        , dstClass      <- targetClassOfReg platform dst
+        , srcClass == dstClass
+        = case srcClass of
+                RcInteger -> ADD  False False src (RIReg g0) dst
+                RcDouble  -> FMOV FF64 src dst
+                RcFloat   -> FMOV FF32 src dst
                 _         -> panic "sparc_mkRegRegMoveInstr"
-	
-	| otherwise
-	= panic "SPARC.Instr.mkRegRegMoveInstr: classes of src and dest not the same"
+
+        | otherwise
+        = panic "SPARC.Instr.mkRegRegMoveInstr: classes of src and dest not the same"
 
 
 -- | Check whether an instruction represents a reg-reg move.
--- 	The register allocator attempts to eliminate reg->reg moves whenever it can,
--- 	by assigning the src and dest temporaries to the same real register.
+--      The register allocator attempts to eliminate reg->reg moves whenever it can,
+--      by assigning the src and dest temporaries to the same real register.
 --
 sparc_takeRegRegMoveInstr :: Instr -> Maybe (Reg,Reg)
 sparc_takeRegRegMoveInstr instr
  = case instr of
- 	ADD False False src (RIReg src2) dst
-	 | g0 == src2		-> Just (src, dst)
+        ADD False False src (RIReg src2) dst
+         | g0 == src2           -> Just (src, dst)
 
-	FMOV FF64 src dst	-> Just (src, dst)
-	FMOV FF32  src dst	-> Just (src, dst)
-	_			-> Nothing
+        FMOV FF64 src dst       -> Just (src, dst)
+        FMOV FF32  src dst      -> Just (src, dst)
+        _                       -> Nothing
 
 
 -- | Make an unconditional branch instruction.
 sparc_mkJumpInstr
-	:: BlockId
-	-> [Instr]
-
-sparc_mkJumpInstr id 
- = 	 [BI ALWAYS False id
-	, NOP]			-- fill the branch delay slot.
+        :: BlockId
+        -> [Instr]
 
+sparc_mkJumpInstr id
+ =       [BI ALWAYS False id
+        , NOP]                  -- fill the branch delay slot.
diff --git a/compiler/nativeGen/SPARC/Ppr.hs b/compiler/nativeGen/SPARC/Ppr.hs
index 601b5288a0d9..654179e0770c 100644
--- a/compiler/nativeGen/SPARC/Ppr.hs
+++ b/compiler/nativeGen/SPARC/Ppr.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE CPP #-}
+
 -----------------------------------------------------------------------------
 --
 -- Pretty-printing assembly language
diff --git a/compiler/nativeGen/SPARC/Regs.hs b/compiler/nativeGen/SPARC/Regs.hs
index 55b6ac9156e2..394389c4bf8e 100644
--- a/compiler/nativeGen/SPARC/Regs.hs
+++ b/compiler/nativeGen/SPARC/Regs.hs
@@ -1,39 +1,32 @@
 -- -----------------------------------------------------------------------------
 --
 -- (c) The University of Glasgow 1994-2004
--- 
+--
 -- -----------------------------------------------------------------------------
 
-{-# OPTIONS -fno-warn-tabs #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and
--- detab the module (please do the detabbing in a separate patch). See
---     http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
--- for details
-
 module SPARC.Regs (
-	-- registers
-	showReg,
-	virtualRegSqueeze,
-	realRegSqueeze,
-	classOfRealReg,
-	allRealRegs,
-
-	-- machine specific info
-	gReg, iReg, lReg, oReg, fReg,
-	fp, sp, g0, g1, g2, o0, o1, f0, f1, f6, f8, f22, f26, f27,
-
-	-- allocatable
-	allocatableRegs,
-
-	-- args
-	argRegs, 
-	allArgRegs, 
-	callClobberedRegs,
-
-	-- 
-	mkVirtualReg,
-	regDotColor
+        -- registers
+        showReg,
+        virtualRegSqueeze,
+        realRegSqueeze,
+        classOfRealReg,
+        allRealRegs,
+
+        -- machine specific info
+        gReg, iReg, lReg, oReg, fReg,
+        fp, sp, g0, g1, g2, o0, o1, f0, f1, f6, f8, f22, f26, f27,
+
+        -- allocatable
+        allocatableRegs,
+
+        -- args
+        argRegs,
+        allArgRegs,
+        callClobberedRegs,
+
+        --
+        mkVirtualReg,
+        regDotColor
 )
 
 where
@@ -50,65 +43,65 @@ import FastTypes
 import FastBool
 
 {-
-	The SPARC has 64 registers of interest; 32 integer registers and 32
-	floating point registers.  The mapping of STG registers to SPARC
-	machine registers is defined in StgRegs.h.  We are, of course,
-	prepared for any eventuality.
-
-	The whole fp-register pairing thing on sparcs is a huge nuisance.  See
-	includes/stg/MachRegs.h for a description of what's going on
-	here.
+        The SPARC has 64 registers of interest; 32 integer registers and 32
+        floating point registers.  The mapping of STG registers to SPARC
+        machine registers is defined in StgRegs.h.  We are, of course,
+        prepared for any eventuality.
+
+        The whole fp-register pairing thing on sparcs is a huge nuisance.  See
+        includes/stg/MachRegs.h for a description of what's going on
+        here.
 -}
 
 
 -- | Get the standard name for the register with this number.
 showReg :: RegNo -> String
 showReg n
-	| n >= 0  && n < 8   = "%g" ++ show n
-	| n >= 8  && n < 16  = "%o" ++ show (n-8)
-	| n >= 16 && n < 24  = "%l" ++ show (n-16)
-	| n >= 24 && n < 32  = "%i" ++ show (n-24)
-	| n >= 32 && n < 64  = "%f" ++ show (n-32)
-	| otherwise          = panic "SPARC.Regs.showReg: unknown sparc register"
+        | n >= 0  && n < 8   = "%g" ++ show n
+        | n >= 8  && n < 16  = "%o" ++ show (n-8)
+        | n >= 16 && n < 24  = "%l" ++ show (n-16)
+        | n >= 24 && n < 32  = "%i" ++ show (n-24)
+        | n >= 32 && n < 64  = "%f" ++ show (n-32)
+        | otherwise          = panic "SPARC.Regs.showReg: unknown sparc register"
 
 
 -- Get the register class of a certain real reg
 classOfRealReg :: RealReg -> RegClass
 classOfRealReg reg
  = case reg of
- 	RealRegSingle i
-		| i < 32	-> RcInteger
-		| otherwise	-> RcFloat
-		
-	RealRegPair{}		-> RcDouble
+        RealRegSingle i
+                | i < 32        -> RcInteger
+                | otherwise     -> RcFloat
+
+        RealRegPair{}           -> RcDouble
 
 
 -- | regSqueeze_class reg
---	Calculuate the maximum number of register colors that could be
---	denied to a node of this class due to having this reg 
---	as a neighbour.
+--      Calculuate the maximum number of register colors that could be
+--      denied to a node of this class due to having this reg
+--      as a neighbour.
 --
 {-# INLINE virtualRegSqueeze #-}
 virtualRegSqueeze :: RegClass -> VirtualReg -> FastInt
 
 virtualRegSqueeze cls vr
  = case cls of
- 	RcInteger
-	 -> case vr of
-	 	VirtualRegI{}		-> _ILIT(1)
-		VirtualRegHi{}		-> _ILIT(1)
+        RcInteger
+         -> case vr of
+                VirtualRegI{}           -> _ILIT(1)
+                VirtualRegHi{}          -> _ILIT(1)
                 _other                  -> _ILIT(0)
 
-	RcFloat
-	 -> case vr of
-		VirtualRegF{}		-> _ILIT(1)
-		VirtualRegD{}		-> _ILIT(2)
+        RcFloat
+         -> case vr of
+                VirtualRegF{}           -> _ILIT(1)
+                VirtualRegD{}           -> _ILIT(2)
                 _other                  -> _ILIT(0)
 
-	RcDouble
-	 -> case vr of
-		VirtualRegF{}		-> _ILIT(1)
-		VirtualRegD{}		-> _ILIT(1)
+        RcDouble
+         -> case vr of
+                VirtualRegF{}           -> _ILIT(1)
+                VirtualRegD{}           -> _ILIT(1)
                 _other                  -> _ILIT(0)
 
         _other -> _ILIT(0)
@@ -118,48 +111,48 @@ realRegSqueeze :: RegClass -> RealReg -> FastInt
 
 realRegSqueeze cls rr
  = case cls of
- 	RcInteger
-	 -> case rr of
-	 	RealRegSingle regNo
-			| regNo	< 32	-> _ILIT(1)
-			| otherwise	-> _ILIT(0)
-			
-		RealRegPair{}		-> _ILIT(0)
-
-	RcFloat
-	 -> case rr of
-	 	RealRegSingle regNo
-			| regNo	< 32	-> _ILIT(0)
-			| otherwise	-> _ILIT(1)
-			
-		RealRegPair{}		-> _ILIT(2)
-
-	RcDouble
-	 -> case rr of
-	 	RealRegSingle regNo
-			| regNo	< 32	-> _ILIT(0)
-			| otherwise	-> _ILIT(1)
-			
-		RealRegPair{}		-> _ILIT(1)
-	 		 	 	
+        RcInteger
+         -> case rr of
+                RealRegSingle regNo
+                        | regNo < 32    -> _ILIT(1)
+                        | otherwise     -> _ILIT(0)
+
+                RealRegPair{}           -> _ILIT(0)
+
+        RcFloat
+         -> case rr of
+                RealRegSingle regNo
+                        | regNo < 32    -> _ILIT(0)
+                        | otherwise     -> _ILIT(1)
+
+                RealRegPair{}           -> _ILIT(2)
+
+        RcDouble
+         -> case rr of
+                RealRegSingle regNo
+                        | regNo < 32    -> _ILIT(0)
+                        | otherwise     -> _ILIT(1)
+
+                RealRegPair{}           -> _ILIT(1)
+
         _other -> _ILIT(0)
- 	
--- | All the allocatable registers in the machine, 
---	including register pairs.
+
+-- | All the allocatable registers in the machine,
+--      including register pairs.
 allRealRegs :: [RealReg]
-allRealRegs  
-	=  [ (RealRegSingle i)		| i <- [0..63] ]
-	++ [ (RealRegPair   i (i+1))	| i <- [32, 34 .. 62 ] ]
+allRealRegs
+        =  [ (RealRegSingle i)          | i <- [0..63] ]
+        ++ [ (RealRegPair   i (i+1))    | i <- [32, 34 .. 62 ] ]
 
 
 -- | Get the regno for this sort of reg
 gReg, lReg, iReg, oReg, fReg :: Int -> RegNo
 
-gReg x	= x		-- global regs
-oReg x	= (8 + x)	-- output regs
-lReg x	= (16 + x)	-- local regs
-iReg x	= (24 + x)	-- input regs
-fReg x	= (32 + x)	-- float regs
+gReg x  = x             -- global regs
+oReg x  = (8 + x)       -- output regs
+lReg x  = (16 + x)      -- local regs
+iReg x  = (24 + x)      -- input regs
+fReg x  = (32 + x)      -- float regs
 
 
 -- | Some specific regs used by the code generator.
@@ -187,88 +180,87 @@ f1  = RegReal (RealRegSingle (fReg 1))
 -- | Produce the second-half-of-a-double register given the first half.
 {-
 fPair :: Reg -> Maybe Reg
-fPair (RealReg n) 
-	| n >= 32 && n `mod` 2 == 0  = Just (RealReg (n+1))
+fPair (RealReg n)
+        | n >= 32 && n `mod` 2 == 0  = Just (RealReg (n+1))
 
 fPair (VirtualRegD u)
-	= Just (VirtualRegHi u)
+        = Just (VirtualRegHi u)
 
 fPair reg
-	= trace ("MachInstrs.fPair: can't get high half of supposed double reg " ++ showPpr reg)
-		Nothing
+        = trace ("MachInstrs.fPair: can't get high half of supposed double reg " ++ showPpr reg)
+                Nothing
 -}
 
 
--- | All the regs that the register allocator can allocate to, 
---	with the the fixed use regs removed.
--- 
+-- | All the regs that the register allocator can allocate to,
+--      with the the fixed use regs removed.
+--
 allocatableRegs :: [RealReg]
 allocatableRegs
-   = let isFree rr 
-   	   = case rr of
-	   	RealRegSingle r		
-			-> isFastTrue (freeReg r)
+   = let isFree rr
+           = case rr of
+                RealRegSingle r
+                        -> isFastTrue (freeReg r)
 
-		RealRegPair   r1 r2	
-			-> isFastTrue (freeReg r1) 
-			&& isFastTrue (freeReg r2)
+                RealRegPair   r1 r2
+                        -> isFastTrue (freeReg r1)
+                        && isFastTrue (freeReg r2)
 
-     in	filter isFree allRealRegs
+     in filter isFree allRealRegs
 
 
--- | The registers to place arguments for function calls, 
---	for some number of arguments.
+-- | The registers to place arguments for function calls,
+--      for some number of arguments.
 --
 argRegs :: RegNo -> [Reg]
 argRegs r
  = case r of
- 	0	-> []
-	1	-> map (RegReal . RealRegSingle . oReg) [0]
-	2	-> map (RegReal . RealRegSingle . oReg) [0,1]
-	3	-> map (RegReal . RealRegSingle . oReg) [0,1,2]
-	4	-> map (RegReal . RealRegSingle . oReg) [0,1,2,3]
-	5	-> map (RegReal . RealRegSingle . oReg) [0,1,2,3,4]
-	6	-> map (RegReal . RealRegSingle . oReg) [0,1,2,3,4,5]
-	_	-> panic "MachRegs.argRegs(sparc): don't know about >6 arguments!"
+        0       -> []
+        1       -> map (RegReal . RealRegSingle . oReg) [0]
+        2       -> map (RegReal . RealRegSingle . oReg) [0,1]
+        3       -> map (RegReal . RealRegSingle . oReg) [0,1,2]
+        4       -> map (RegReal . RealRegSingle . oReg) [0,1,2,3]
+        5       -> map (RegReal . RealRegSingle . oReg) [0,1,2,3,4]
+        6       -> map (RegReal . RealRegSingle . oReg) [0,1,2,3,4,5]
+        _       -> panic "MachRegs.argRegs(sparc): don't know about >6 arguments!"
 
 
 -- | All all the regs that could possibly be returned by argRegs
 --
 allArgRegs :: [Reg]
-allArgRegs 
-	= map (RegReal . RealRegSingle) [oReg i | i <- [0..5]]
+allArgRegs
+        = map (RegReal . RealRegSingle) [oReg i | i <- [0..5]]
 
 
--- These are the regs that we cannot assume stay alive over a C call.  
---	TODO: Why can we assume that o6 isn't clobbered? -- BL 2009/02
+-- These are the regs that we cannot assume stay alive over a C call.
+--      TODO: Why can we assume that o6 isn't clobbered? -- BL 2009/02
 --
 callClobberedRegs :: [Reg]
 callClobberedRegs
-	= map (RegReal . RealRegSingle)
-	        (  oReg 7 :
-	          [oReg i | i <- [0..5]] ++
-	          [gReg i | i <- [1..7]] ++
-	          [fReg i | i <- [0..31]] )
+        = map (RegReal . RealRegSingle)
+                (  oReg 7 :
+                  [oReg i | i <- [0..5]] ++
+                  [gReg i | i <- [1..7]] ++
+                  [fReg i | i <- [0..31]] )
 
 
 
 -- | Make a virtual reg with this size.
 mkVirtualReg :: Unique -> Size -> VirtualReg
 mkVirtualReg u size
-	| not (isFloatSize size) 
-	= VirtualRegI u
+        | not (isFloatSize size)
+        = VirtualRegI u
 
-	| otherwise
-	= case size of
-		FF32    -> VirtualRegF u
-		FF64	-> VirtualRegD u
-		_ 	-> panic "mkVReg"
+        | otherwise
+        = case size of
+                FF32    -> VirtualRegF u
+                FF64    -> VirtualRegD u
+                _       -> panic "mkVReg"
 
 
 regDotColor :: RealReg -> SDoc
 regDotColor reg
  = case classOfRealReg reg of
- 	RcInteger	-> text "blue"
-	RcFloat		-> text "red"
-	_other          -> text "green"
-
+        RcInteger       -> text "blue"
+        RcFloat         -> text "red"
+        _other          -> text "green"
diff --git a/compiler/nativeGen/SPARC/ShortcutJump.hs b/compiler/nativeGen/SPARC/ShortcutJump.hs
index 7f978c17c509..123a345130f0 100644
--- a/compiler/nativeGen/SPARC/ShortcutJump.hs
+++ b/compiler/nativeGen/SPARC/ShortcutJump.hs
@@ -1,17 +1,9 @@
-
-{-# OPTIONS -fno-warn-tabs #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and
--- detab the module (please do the detabbing in a separate patch). See
---     http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
--- for details
-
 module SPARC.ShortcutJump (
-	JumpDest(..), getJumpDestBlockId,
-	canShortcut,
-	shortcutJump,
-	shortcutStatics,
-	shortBlockId
+        JumpDest(..), getJumpDestBlockId,
+        canShortcut,
+        shortcutJump,
+        shortcutStatics,
+        shortBlockId
 )
 
 where
@@ -28,9 +20,9 @@ import Unique
 
 
 
-data JumpDest 
-	= DestBlockId BlockId 
-	| DestImm Imm
+data JumpDest
+        = DestBlockId BlockId
+        | DestImm Imm
 
 getJumpDestBlockId :: JumpDest -> Maybe BlockId
 getJumpDestBlockId (DestBlockId bid) = Just bid
@@ -59,9 +51,9 @@ shortcutLabel fn lab
 
 shortcutStatic :: (BlockId -> Maybe JumpDest) -> CmmStatic -> CmmStatic
 shortcutStatic fn (CmmStaticLit (CmmLabel lab))
-	= CmmStaticLit (CmmLabel (shortcutLabel fn lab))
+        = CmmStaticLit (CmmLabel (shortcutLabel fn lab))
 shortcutStatic fn (CmmStaticLit (CmmLabelDiffOff lbl1 lbl2 off))
-	= CmmStaticLit (CmmLabelDiffOff (shortcutLabel fn lbl1) lbl2 off)
+        = CmmStaticLit (CmmLabelDiffOff (shortcutLabel fn lbl1) lbl2 off)
 -- slightly dodgy, we're ignoring the second label, but this
 -- works with the way we use CmmLabelDiffOff for jump tables now.
 shortcutStatic _ other_static
@@ -75,6 +67,3 @@ shortBlockId fn blockid =
       Just (DestBlockId blockid')  -> shortBlockId fn blockid'
       Just (DestImm (ImmCLbl lbl)) -> lbl
       _other -> panic "shortBlockId"
-
-
-
diff --git a/compiler/nativeGen/SPARC/Stack.hs b/compiler/nativeGen/SPARC/Stack.hs
index 4a6f4c1335d9..629b18789f10 100644
--- a/compiler/nativeGen/SPARC/Stack.hs
+++ b/compiler/nativeGen/SPARC/Stack.hs
@@ -1,16 +1,8 @@
-
-{-# OPTIONS -fno-warn-tabs #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and
--- detab the module (please do the detabbing in a separate patch). See
---     http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
--- for details
-
 module SPARC.Stack (
-	spRel,
-	fpRel,
-	spillSlotToOffset,
-	maxSpillSlots
+        spRel,
+        fpRel,
+        spillSlotToOffset,
+        maxSpillSlots
 )
 
 where
@@ -24,43 +16,42 @@ import DynFlags
 import Outputable
 
 -- | Get an AddrMode relative to the address in sp.
---	This gives us a stack relative addressing mode for volatile
--- 	temporaries and for excess call arguments.  
+--      This gives us a stack relative addressing mode for volatile
+--      temporaries and for excess call arguments.
 --
-spRel :: Int		-- ^ stack offset in words, positive or negative
+spRel :: Int            -- ^ stack offset in words, positive or negative
       -> AddrMode
 
-spRel n	= AddrRegImm sp (ImmInt (n * wordLength))
+spRel n = AddrRegImm sp (ImmInt (n * wordLength))
 
 
 -- | Get an address relative to the frame pointer.
---	This doesn't work work for offsets greater than 13 bits; we just hope for the best
+--      This doesn't work work for offsets greater than 13 bits; we just hope for the best
 --
 fpRel :: Int -> AddrMode
 fpRel n
-	= AddrRegImm fp (ImmInt (n * wordLength))
+        = AddrRegImm fp (ImmInt (n * wordLength))
 
 
 -- | Convert a spill slot number to a *byte* offset, with no sign.
 --
 spillSlotToOffset :: DynFlags -> Int -> Int
 spillSlotToOffset dflags slot
-	| slot >= 0 && slot < maxSpillSlots dflags
-	= 64 + spillSlotSize * slot
+        | slot >= 0 && slot < maxSpillSlots dflags
+        = 64 + spillSlotSize * slot
 
-	| otherwise
-	= pprPanic "spillSlotToOffset:" 
-	              (   text "invalid spill location: " <> int slot
-		      $$  text "maxSpillSlots:          " <> int (maxSpillSlots dflags))
+        | otherwise
+        = pprPanic "spillSlotToOffset:"
+                      (   text "invalid spill location: " <> int slot
+                      $$  text "maxSpillSlots:          " <> int (maxSpillSlots dflags))
 
 
 -- | The maximum number of spill slots available on the C stack.
---	If we use up all of the slots, then we're screwed.
+--      If we use up all of the slots, then we're screwed.
 --
---	Why do we reserve 64 bytes, instead of using the whole thing??
---		-- BL 2009/02/15
+--      Why do we reserve 64 bytes, instead of using the whole thing??
+--              -- BL 2009/02/15
 --
 maxSpillSlots :: DynFlags -> Int
 maxSpillSlots dflags
-	= ((spillAreaLength dflags - 64) `div` spillSlotSize) - 1
-
+        = ((spillAreaLength dflags - 64) `div` spillSlotSize) - 1
diff --git a/compiler/nativeGen/Size.hs b/compiler/nativeGen/Size.hs
index 45a39645cc2b..8fe590f1e94a 100644
--- a/compiler/nativeGen/Size.hs
+++ b/compiler/nativeGen/Size.hs
@@ -1,22 +1,15 @@
-{-# OPTIONS -fno-warn-tabs #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and
--- detab the module (please do the detabbing in a separate patch). See
---     http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
--- for details
-
 -- | Sizes on this architecture
--- 	A Size is a combination of width and class
--- 
--- 	TODO: 	Rename this to "Format" instead of "Size" to reflect
---		the fact that it represents floating point vs integer.
+--      A Size is a combination of width and class
+--
+--      TODO:   Rename this to "Format" instead of "Size" to reflect
+--              the fact that it represents floating point vs integer.
 --
---	TODO: 	Signed vs unsigned?
+--      TODO:   Signed vs unsigned?
 --
---	TODO:	This module is currenly shared by all architectures because
---		NCGMonad need to know about it to make a VReg. It would be better
---		to have architecture specific formats, and do the overloading
---		properly. eg SPARC doesn't care about FF80.
+--      TODO:   This module is currenly shared by all architectures because
+--              NCGMonad need to know about it to make a VReg. It would be better
+--              to have architecture specific formats, and do the overloading
+--              properly. eg SPARC doesn't care about FF80.
 --
 module Size (
     Size(..),
@@ -37,76 +30,76 @@ import Outputable
 -- significance, here in the native code generator.  You can change it
 -- without global consequences.
 --
--- A major use is as an opcode qualifier; thus the opcode 
---	mov.l a b
--- might be encoded 
--- 	MOV II32 a b
+-- A major use is as an opcode qualifier; thus the opcode
+--      mov.l a b
+-- might be encoded
+--      MOV II32 a b
 -- where the Size field encodes the ".l" part.
 
 -- ToDo: it's not clear to me that we need separate signed-vs-unsigned sizes
--- 	  here.  I've removed them from the x86 version, we'll see what happens --SDM
+--        here.  I've removed them from the x86 version, we'll see what happens --SDM
 
 -- ToDo: quite a few occurrences of Size could usefully be replaced by Width
 
 data Size
-	= II8 
-	| II16 
-	| II32 
-	| II64 
-	| FF32 
-	| FF64 
-	| FF80
-	deriving (Show, Eq)
+        = II8
+        | II16
+        | II32
+        | II64
+        | FF32
+        | FF64
+        | FF80
+        deriving (Show, Eq)
 
 
 -- | Get the integer size of this width.
 intSize :: Width -> Size
 intSize width
  = case width of
- 	W8 	-> II8
-	W16	-> II16
-	W32	-> II32
-	W64 	-> II64
-	other	-> pprPanic "Size.intSize" (ppr other)
+        W8      -> II8
+        W16     -> II16
+        W32     -> II32
+        W64     -> II64
+        other   -> pprPanic "Size.intSize" (ppr other)
 
 
 -- | Get the float size of this width.
 floatSize :: Width -> Size
 floatSize width
  = case width of
- 	W32	-> FF32
-	W64	-> FF64
-	other 	-> pprPanic "Size.floatSize" (ppr other)
+        W32     -> FF32
+        W64     -> FF64
+        other   -> pprPanic "Size.floatSize" (ppr other)
 
 
 -- | Check if a size represents a floating point value.
 isFloatSize :: Size -> Bool
 isFloatSize size
  = case size of
- 	FF32	-> True
-	FF64	-> True
-	FF80	-> True
-	_	-> False
+        FF32    -> True
+        FF64    -> True
+        FF80    -> True
+        _       -> False
 
 
 -- | Convert a Cmm type to a Size.
 cmmTypeSize :: CmmType -> Size
-cmmTypeSize ty 
-	| isFloatType ty	= floatSize (typeWidth ty)
-	| otherwise		= intSize (typeWidth ty)
+cmmTypeSize ty
+        | isFloatType ty        = floatSize (typeWidth ty)
+        | otherwise             = intSize (typeWidth ty)
 
 
 -- | Get the Width of a Size.
 sizeToWidth :: Size -> Width
 sizeToWidth size
  = case size of
- 	II8		-> W8
-	II16		-> W16
-	II32		-> W32
-	II64		-> W64
-	FF32		-> W32
-	FF64		-> W64
-	FF80		-> W80
+        II8             -> W8
+        II16            -> W16
+        II32            -> W32
+        II64            -> W64
+        FF32            -> W32
+        FF64            -> W64
+        FF80            -> W80
 
 sizeInBytes :: Size -> Int
 sizeInBytes = widthInBytes . sizeToWidth
diff --git a/compiler/nativeGen/TargetReg.hs b/compiler/nativeGen/TargetReg.hs
index 09c774f4d575..96c17777950d 100644
--- a/compiler/nativeGen/TargetReg.hs
+++ b/compiler/nativeGen/TargetReg.hs
@@ -1,28 +1,20 @@
-
-{-# OPTIONS -fno-warn-tabs #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and
--- detab the module (please do the detabbing in a separate patch). See
---     http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
--- for details
-
+{-# LANGUAGE CPP #-}
 -- | Hard wired things related to registers.
---	This is module is preventing the native code generator being able to 
---	emit code for non-host architectures.
+--      This is module is preventing the native code generator being able to
+--      emit code for non-host architectures.
 --
---	TODO: Do a better job of the overloading, and eliminate this module.
---	We'd probably do better with a Register type class, and hook this to 
---	Instruction somehow.
+--      TODO: Do a better job of the overloading, and eliminate this module.
+--      We'd probably do better with a Register type class, and hook this to
+--      Instruction somehow.
 --
---	TODO: We should also make arch specific versions of RegAlloc.Graph.TrivColorable
-
+--      TODO: We should also make arch specific versions of RegAlloc.Graph.TrivColorable
 module TargetReg (
-	targetVirtualRegSqueeze,
-	targetRealRegSqueeze,
-	targetClassOfRealReg,
-	targetMkVirtualReg,
-	targetRegDotColor,
-	targetClassOfReg
+        targetVirtualRegSqueeze,
+        targetRealRegSqueeze,
+        targetClassOfRealReg,
+        targetMkVirtualReg,
+        targetRegDotColor,
+        targetClassOfReg
 )
 
 where
@@ -54,6 +46,7 @@ targetVirtualRegSqueeze platform
       ArchSPARC     -> SPARC.virtualRegSqueeze
       ArchPPC_64    -> panic "targetVirtualRegSqueeze ArchPPC_64"
       ArchARM _ _ _ -> panic "targetVirtualRegSqueeze ArchARM"
+      ArchARM64     -> panic "targetVirtualRegSqueeze ArchARM64"
       ArchAlpha     -> panic "targetVirtualRegSqueeze ArchAlpha"
       ArchMipseb    -> panic "targetVirtualRegSqueeze ArchMipseb"
       ArchMipsel    -> panic "targetVirtualRegSqueeze ArchMipsel"
@@ -70,6 +63,7 @@ targetRealRegSqueeze platform
       ArchSPARC     -> SPARC.realRegSqueeze
       ArchPPC_64    -> panic "targetRealRegSqueeze ArchPPC_64"
       ArchARM _ _ _ -> panic "targetRealRegSqueeze ArchARM"
+      ArchARM64     -> panic "targetRealRegSqueeze ArchARM64"
       ArchAlpha     -> panic "targetRealRegSqueeze ArchAlpha"
       ArchMipseb    -> panic "targetRealRegSqueeze ArchMipseb"
       ArchMipsel    -> panic "targetRealRegSqueeze ArchMipsel"
@@ -85,6 +79,7 @@ targetClassOfRealReg platform
       ArchSPARC     -> SPARC.classOfRealReg
       ArchPPC_64    -> panic "targetClassOfRealReg ArchPPC_64"
       ArchARM _ _ _ -> panic "targetClassOfRealReg ArchARM"
+      ArchARM64     -> panic "targetClassOfRealReg ArchARM64"
       ArchAlpha     -> panic "targetClassOfRealReg ArchAlpha"
       ArchMipseb    -> panic "targetClassOfRealReg ArchMipseb"
       ArchMipsel    -> panic "targetClassOfRealReg ArchMipsel"
@@ -100,6 +95,7 @@ targetMkVirtualReg platform
       ArchSPARC     -> SPARC.mkVirtualReg
       ArchPPC_64    -> panic "targetMkVirtualReg ArchPPC_64"
       ArchARM _ _ _ -> panic "targetMkVirtualReg ArchARM"
+      ArchARM64     -> panic "targetMkVirtualReg ArchARM64"
       ArchAlpha     -> panic "targetMkVirtualReg ArchAlpha"
       ArchMipseb    -> panic "targetMkVirtualReg ArchMipseb"
       ArchMipsel    -> panic "targetMkVirtualReg ArchMipsel"
@@ -115,6 +111,7 @@ targetRegDotColor platform
       ArchSPARC     -> SPARC.regDotColor
       ArchPPC_64    -> panic "targetRegDotColor ArchPPC_64"
       ArchARM _ _ _ -> panic "targetRegDotColor ArchARM"
+      ArchARM64     -> panic "targetRegDotColor ArchARM64"
       ArchAlpha     -> panic "targetRegDotColor ArchAlpha"
       ArchMipseb    -> panic "targetRegDotColor ArchMipseb"
       ArchMipsel    -> panic "targetRegDotColor ArchMipsel"
@@ -127,5 +124,3 @@ targetClassOfReg platform reg
  = case reg of
    RegVirtual vr -> classOfVirtualReg vr
    RegReal rr -> targetClassOfRealReg platform rr
-
-
diff --git a/compiler/nativeGen/X86/CodeGen.hs b/compiler/nativeGen/X86/CodeGen.hs
index 2456688744dd..d95a14c31cc0 100644
--- a/compiler/nativeGen/X86/CodeGen.hs
+++ b/compiler/nativeGen/X86/CodeGen.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE CPP, GADTs, NondecreasingIndentation #-}
+
 -----------------------------------------------------------------------------
 --
 -- Generating machine code (instruction selection)
@@ -10,7 +12,6 @@
 -- (a) the sectioning, and (b) the type signatures, the
 -- structure should not be too overwhelming.
 
-{-# LANGUAGE GADTs #-}
 module X86.CodeGen (
         cmmTopCodeGen,
         generateJumpTableForInstr,
@@ -30,6 +31,7 @@ import X86.Regs
 import X86.RegInfo
 import CodeGen.Platform
 import CPrim
+import Debug            ( DebugBlock(..) )
 import Instruction
 import PIC
 import NCGMonad
@@ -40,12 +42,14 @@ import Platform
 -- Our intermediate code:
 import BasicTypes
 import BlockId
-import Module           ( primPackageId )
+import Module           ( primPackageKey )
 import PprCmm           ()
 import CmmUtils
 import Cmm
 import Hoopl
 import CLabel
+import CoreSyn          ( Tickish(..) )
+import SrcLoc           ( srcSpanFile, srcSpanStartLine, srcSpanStartCol )
 
 -- The rest:
 import ForeignCall      ( CCallConv(..) )
@@ -110,11 +114,19 @@ basicBlockCodeGen
                 , [NatCmmDecl (Alignment, CmmStatics) Instr])
 
 basicBlockCodeGen block = do
-  let (CmmEntry id, nodes, tail)  = blockSplit block
+  let (_, nodes, tail)  = blockSplit block
+      id = entryLabel block
       stmts = blockToList nodes
+  -- Generate location directive
+  dbg <- getDebugBlock (entryLabel block)
+  loc_instrs <- case dblSourceTick =<< dbg of
+    Just (SourceNote span name)
+      -> do fileId <- getFileId (srcSpanFile span)
+            return $ unitOL $ LOCATION fileId (srcSpanStartLine span) (srcSpanStartCol span) name
+    _ -> return nilOL
   mid_instrs <- stmtsToInstrs stmts
   tail_instrs <- stmtToInstrs tail
-  let instrs = mid_instrs `appOL` tail_instrs
+  let instrs = loc_instrs `appOL` mid_instrs `appOL` tail_instrs
   -- code generation may introduce new basic block boundaries, which
   -- are indicated by the NEWBLOCK instruction.  We must split up the
   -- instruction stream into basic blocks again.  Also, we extract
@@ -143,6 +155,8 @@ stmtToInstrs stmt = do
   is32Bit <- is32BitPlatform
   case stmt of
     CmmComment s   -> return (unitOL (COMMENT s))
+    CmmTick {}     -> return nilOL
+    CmmUnwind {}   -> return nilOL
 
     CmmAssign reg src
       | isFloatType ty         -> assignReg_FltCode size reg src
@@ -159,7 +173,7 @@ stmtToInstrs stmt = do
               size = cmmTypeSize ty
 
     CmmUnsafeForeignCall target result_regs args
-       -> genCCall is32Bit target result_regs args
+       -> genCCall dflags is32Bit target result_regs args
 
     CmmBranch id          -> genBranch id
     CmmCondBranch arg true false -> do b1 <- genCondJump true arg
@@ -804,6 +818,8 @@ getRegister' _ is32Bit (CmmMachOp mop [x, y]) = do -- dyadic MachOps
         | is32BitInteger y = add_int rep x y
     add_code rep x y = trivialCode rep (ADD size) (Just (ADD size)) x y
       where size = intSize rep
+    -- TODO: There are other interesting patterns we want to replace
+    --     with a LEA, e.g. `(x + offset) + (y << shift)`.
 
     --------------------
     sub_code :: Width -> CmmExpr -> CmmExpr -> NatM Register
@@ -1024,6 +1040,13 @@ getAmode' is32Bit (CmmMachOp (MO_Add rep) [a@(CmmMachOp (MO_Shl _) _),
                                   b@(CmmLit _)])
   = getAmode' is32Bit (CmmMachOp (MO_Add rep) [b,a])
 
+-- Matches: (x + offset) + (y << shift)
+getAmode' _ (CmmMachOp (MO_Add _) [CmmRegOff x offset,
+                                   CmmMachOp (MO_Shl _)
+                                        [y, CmmLit (CmmInt shift _)]])
+  | shift == 0 || shift == 1 || shift == 2 || shift == 3
+  = x86_complex_amode (CmmReg x) y shift (fromIntegral offset)
+
 getAmode' _ (CmmMachOp (MO_Add _) [x, CmmMachOp (MO_Shl _)
                                         [y, CmmLit (CmmInt shift _)]])
   | shift == 0 || shift == 1 || shift == 2 || shift == 3
@@ -1047,6 +1070,18 @@ getAmode' _ expr = do
   (reg,code) <- getSomeReg expr
   return (Amode (AddrBaseIndex (EABaseReg reg) EAIndexNone (ImmInt 0)) code)
 
+-- | Like 'getAmode', but on 32-bit use simple register addressing
+-- (i.e. no index register). This stops us from running out of
+-- registers on x86 when using instructions such as cmpxchg, which can
+-- use up to three virtual registers and one fixed register.
+getSimpleAmode :: DynFlags -> Bool -> CmmExpr -> NatM Amode
+getSimpleAmode dflags is32Bit addr
+    | is32Bit = do
+        addr_code <- getAnyReg addr
+        addr_r <- getNewRegNat (intSize (wordWidth dflags))
+        let amode = AddrBaseIndex (EABaseReg addr_r) EAIndexNone (ImmInt 0)
+        return $! Amode amode (addr_code addr_r)
+    | otherwise = getAmode addr
 
 x86_complex_amode :: CmmExpr -> CmmExpr -> Integer -> Integer -> NatM Amode
 x86_complex_amode base index shift offset
@@ -1559,7 +1594,8 @@ genCondJump id bool = do
 -- register allocator.
 
 genCCall
-    :: Bool                     -- 32 bit platform?
+    :: DynFlags
+    -> Bool                     -- 32 bit platform?
     -> ForeignTarget            -- function to call
     -> [CmmFormal]        -- where to put the result
     -> [CmmActual]        -- arguments (of mixed type)
@@ -1570,21 +1606,27 @@ genCCall
 -- Unroll memcpy calls if the source and destination pointers are at
 -- least DWORD aligned and the number of bytes to copy isn't too
 -- large.  Otherwise, call C's memcpy.
-genCCall is32Bit (PrimTarget MO_Memcpy) _
+genCCall dflags is32Bit (PrimTarget MO_Memcpy) _
          [dst, src,
           (CmmLit (CmmInt n _)),
           (CmmLit (CmmInt align _))]
-    | n <= maxInlineSizeThreshold && align .&. 3 == 0 = do
+    | fromInteger insns <= maxInlineMemcpyInsns dflags && align .&. 3 == 0 = do
         code_dst <- getAnyReg dst
         dst_r <- getNewRegNat size
         code_src <- getAnyReg src
         src_r <- getNewRegNat size
         tmp_r <- getNewRegNat size
         return $ code_dst dst_r `appOL` code_src src_r `appOL`
-            go dst_r src_r tmp_r n
+            go dst_r src_r tmp_r (fromInteger n)
   where
+    -- The number of instructions we will generate (approx). We need 2
+    -- instructions per move.
+    insns = 2 * ((n + sizeBytes - 1) `div` sizeBytes)
+
     size = if align .&. 4 /= 0 then II32 else (archWordSize is32Bit)
 
+    -- The size of each move, in bytes.
+    sizeBytes :: Integer
     sizeBytes = fromIntegral (sizeInBytes size)
 
     go :: Reg -> Reg -> Reg -> Integer -> OrdList Instr
@@ -1613,15 +1655,15 @@ genCCall is32Bit (PrimTarget MO_Memcpy) _
         dst_addr = AddrBaseIndex (EABaseReg dst) EAIndexNone
                    (ImmInteger (n - i))
 
-genCCall _ (PrimTarget MO_Memset) _
+genCCall dflags _ (PrimTarget MO_Memset) _
          [dst,
           CmmLit (CmmInt c _),
           CmmLit (CmmInt n _),
           CmmLit (CmmInt align _)]
-    | n <= maxInlineSizeThreshold && align .&. 3 == 0 = do
+    | fromInteger insns <= maxInlineMemsetInsns dflags && align .&. 3 == 0 = do
         code_dst <- getAnyReg dst
         dst_r <- getNewRegNat size
-        return $ code_dst dst_r `appOL` go dst_r n
+        return $ code_dst dst_r `appOL` go dst_r (fromInteger n)
   where
     (size, val) = case align .&. 3 of
         2 -> (II16, c2)
@@ -1630,6 +1672,12 @@ genCCall _ (PrimTarget MO_Memset) _
     c2 = c `shiftL` 8 .|. c
     c4 = c2 `shiftL` 16 .|. c2
 
+    -- The number of instructions we will generate (approx). We need 1
+    -- instructions per move.
+    insns = (n + sizeBytes - 1) `div` sizeBytes
+
+    -- The size of each move, in bytes.
+    sizeBytes :: Integer
     sizeBytes = fromIntegral (sizeInBytes size)
 
     go :: Reg -> Integer -> OrdList Instr
@@ -1652,13 +1700,13 @@ genCCall _ (PrimTarget MO_Memset) _
         dst_addr = AddrBaseIndex (EABaseReg dst) EAIndexNone
                    (ImmInteger (n - i))
 
-genCCall _ (PrimTarget MO_WriteBarrier) _ _ = return nilOL
+genCCall _ _ (PrimTarget MO_WriteBarrier) _ _ = return nilOL
         -- write barrier compiles to no code on x86/x86-64;
         -- we keep it this long in order to prevent earlier optimisations.
 
-genCCall _ (PrimTarget MO_Touch) _ _ = return nilOL
+genCCall _ _ (PrimTarget MO_Touch) _ _ = return nilOL
 
-genCCall is32bit (PrimTarget (MO_Prefetch_Data n )) _  [src] =
+genCCall _ is32bit (PrimTarget (MO_Prefetch_Data n )) _  [src] =
         case n of
             0 -> genPrefetch src $ PREFETCH NTA  size
             1 -> genPrefetch src $ PREFETCH Lvl2 size
@@ -1679,8 +1727,7 @@ genCCall is32bit (PrimTarget (MO_Prefetch_Data n )) _  [src] =
                               ((AddrBaseIndex (EABaseReg src_r )   EAIndexNone (ImmInt 0))))  ))
                   -- prefetch always takes an address
 
-genCCall is32Bit (PrimTarget (MO_BSwap width)) [dst] [src] = do
-    dflags <- getDynFlags
+genCCall dflags is32Bit (PrimTarget (MO_BSwap width)) [dst] [src] = do
     let platform = targetPlatform dflags
     let dst_r = getRegisterReg platform False (CmmLocal dst)
     case width of
@@ -1702,54 +1749,201 @@ genCCall is32Bit (PrimTarget (MO_BSwap width)) [dst] [src] = do
   where
     size = intSize width
 
-genCCall is32Bit (PrimTarget (MO_PopCnt width)) dest_regs@[dst]
+genCCall dflags is32Bit (PrimTarget (MO_PopCnt width)) dest_regs@[dst]
          args@[src] = do
     sse4_2 <- sse4_2Enabled
-    dflags <- getDynFlags
     let platform = targetPlatform dflags
     if sse4_2
         then do code_src <- getAnyReg src
                 src_r <- getNewRegNat size
+                let dst_r = getRegisterReg platform False (CmmLocal dst)
                 return $ code_src src_r `appOL`
                     (if width == W8 then
                          -- The POPCNT instruction doesn't take a r/m8
                          unitOL (MOVZxL II8 (OpReg src_r) (OpReg src_r)) `appOL`
-                         unitOL (POPCNT II16 (OpReg src_r)
-                                 (getRegisterReg platform False (CmmLocal dst)))
+                         unitOL (POPCNT II16 (OpReg src_r) dst_r)
                      else
-                         unitOL (POPCNT size (OpReg src_r)
-                                 (getRegisterReg platform False (CmmLocal dst))))
+                         unitOL (POPCNT size (OpReg src_r) dst_r)) `appOL`
+                    (if width == W8 || width == W16 then
+                         -- We used a 16-bit destination register above,
+                         -- so zero-extend
+                         unitOL (MOVZxL II16 (OpReg dst_r) (OpReg dst_r))
+                     else nilOL)
         else do
             targetExpr <- cmmMakeDynamicReference dflags
                           CallReference lbl
             let target = ForeignTarget targetExpr (ForeignConvention CCallConv
                                                            [NoHint] [NoHint]
                                                            CmmMayReturn)
-            genCCall is32Bit target dest_regs args
+            genCCall dflags is32Bit target dest_regs args
   where
     size = intSize width
-    lbl = mkCmmCodeLabel primPackageId (fsLit (popCntLabel width))
+    lbl = mkCmmCodeLabel primPackageKey (fsLit (popCntLabel width))
 
-genCCall is32Bit (PrimTarget (MO_UF_Conv width)) dest_regs args = do
-    dflags <- getDynFlags
+genCCall dflags is32Bit (PrimTarget (MO_Clz width)) dest_regs@[dst] args@[src]
+  | is32Bit && width == W64 = do
+    -- Fallback to `hs_clz64` on i386
+    targetExpr <- cmmMakeDynamicReference dflags CallReference lbl
+    let target = ForeignTarget targetExpr (ForeignConvention CCallConv
+                                           [NoHint] [NoHint]
+                                           CmmMayReturn)
+    genCCall dflags is32Bit target dest_regs args
+
+  | otherwise = do
+    code_src <- getAnyReg src
+    src_r <- getNewRegNat size
+    tmp_r <- getNewRegNat size
+    let dst_r = getRegisterReg platform False (CmmLocal dst)
+
+    -- The following insn sequence makes sure 'clz 0' has a defined value.
+    -- starting with Haswell, one could use the LZCNT insn instead.
+    return $ code_src src_r `appOL` toOL
+             ([ MOVZxL  II8  (OpReg src_r) (OpReg src_r) | width == W8 ] ++
+              [ BSR     size (OpReg src_r) tmp_r
+              , MOV     II32 (OpImm (ImmInt (2*bw-1))) (OpReg dst_r)
+              , CMOV NE size (OpReg tmp_r) dst_r
+              , XOR     size (OpImm (ImmInt (bw-1))) (OpReg dst_r)
+              ]) -- NB: We don't need to zero-extend the result for the
+                 -- W8/W16 cases because the 'MOV' insn already
+                 -- took care of implicitly clearing the upper bits
+  where
+    bw = widthInBits width
+    platform = targetPlatform dflags
+    size = if width == W8 then II16 else intSize width
+    lbl = mkCmmCodeLabel primPackageKey (fsLit (clzLabel width))
+
+genCCall dflags is32Bit (PrimTarget (MO_Ctz width)) dest_regs@[dst] args@[src]
+  | is32Bit, width == W64 = do
+    -- Fallback to `hs_ctz64` on i386
+    targetExpr <- cmmMakeDynamicReference dflags CallReference lbl
+    let target = ForeignTarget targetExpr (ForeignConvention CCallConv
+                                           [NoHint] [NoHint]
+                                           CmmMayReturn)
+    genCCall dflags is32Bit target dest_regs args
+
+  | otherwise = do
+    code_src <- getAnyReg src
+    src_r <- getNewRegNat size
+    tmp_r <- getNewRegNat size
+    let dst_r = getRegisterReg platform False (CmmLocal dst)
+
+    -- The following insn sequence makes sure 'ctz 0' has a defined value.
+    -- starting with Haswell, one could use the TZCNT insn instead.
+    return $ code_src src_r `appOL` toOL
+             ([ MOVZxL  II8  (OpReg src_r) (OpReg src_r) | width == W8 ] ++
+              [ BSF     size (OpReg src_r) tmp_r
+              , MOV     II32 (OpImm (ImmInt bw)) (OpReg dst_r)
+              , CMOV NE size (OpReg tmp_r) dst_r
+              ]) -- NB: We don't need to zero-extend the result for the
+                 -- W8/W16 cases because the 'MOV' insn already
+                 -- took care of implicitly clearing the upper bits
+  where
+    bw = widthInBits width
+    platform = targetPlatform dflags
+    size = if width == W8 then II16 else intSize width
+    lbl = mkCmmCodeLabel primPackageKey (fsLit (ctzLabel width))
+
+genCCall dflags is32Bit (PrimTarget (MO_UF_Conv width)) dest_regs args = do
     targetExpr <- cmmMakeDynamicReference dflags
                   CallReference lbl
     let target = ForeignTarget targetExpr (ForeignConvention CCallConv
                                            [NoHint] [NoHint]
                                            CmmMayReturn)
-    genCCall is32Bit target dest_regs args
+    genCCall dflags is32Bit target dest_regs args
+  where
+    lbl = mkCmmCodeLabel primPackageKey (fsLit (word2FloatLabel width))
+
+genCCall dflags is32Bit (PrimTarget (MO_AtomicRMW width amop)) [dst] [addr, n] = do
+    Amode amode addr_code <-
+        if amop `elem` [AMO_Add, AMO_Sub]
+        then getAmode addr
+        else getSimpleAmode dflags is32Bit addr  -- See genCCall for MO_Cmpxchg
+    arg <- getNewRegNat size
+    arg_code <- getAnyReg n
+    use_sse2 <- sse2Enabled
+    let platform = targetPlatform dflags
+        dst_r    = getRegisterReg platform use_sse2 (CmmLocal dst)
+    code <- op_code dst_r arg amode
+    return $ addr_code `appOL` arg_code arg `appOL` code
   where
-    lbl = mkCmmCodeLabel primPackageId (fsLit (word2FloatLabel width))
+    -- Code for the operation
+    op_code :: Reg       -- Destination reg
+            -> Reg       -- Register containing argument
+            -> AddrMode  -- Address of location to mutate
+            -> NatM (OrdList Instr)
+    op_code dst_r arg amode = case amop of
+        -- In the common case where dst_r is a virtual register the
+        -- final move should go away, because it's the last use of arg
+        -- and the first use of dst_r.
+        AMO_Add  -> return $ toOL [ LOCK (XADD size (OpReg arg) (OpAddr amode))
+                                  , MOV size (OpReg arg) (OpReg dst_r)
+                                  ]
+        AMO_Sub  -> return $ toOL [ NEGI size (OpReg arg)
+                                  , LOCK (XADD size (OpReg arg) (OpAddr amode))
+                                  , MOV size (OpReg arg) (OpReg dst_r)
+                                  ]
+        AMO_And  -> cmpxchg_code (\ src dst -> unitOL $ AND size src dst)
+        AMO_Nand -> cmpxchg_code (\ src dst -> toOL [ AND size src dst
+                                                    , NOT size dst
+                                                    ])
+        AMO_Or   -> cmpxchg_code (\ src dst -> unitOL $ OR size src dst)
+        AMO_Xor  -> cmpxchg_code (\ src dst -> unitOL $ XOR size src dst)
+      where
+        -- Simulate operation that lacks a dedicated instruction using
+        -- cmpxchg.
+        cmpxchg_code :: (Operand -> Operand -> OrdList Instr)
+                     -> NatM (OrdList Instr)
+        cmpxchg_code instrs = do
+            lbl <- getBlockIdNat
+            tmp <- getNewRegNat size
+            return $ toOL
+                [ MOV size (OpAddr amode) (OpReg eax)
+                , JXX ALWAYS lbl
+                , NEWBLOCK lbl
+                  -- Keep old value so we can return it:
+                , MOV size (OpReg eax) (OpReg dst_r)
+                , MOV size (OpReg eax) (OpReg tmp)
+                ]
+                `appOL` instrs (OpReg arg) (OpReg tmp) `appOL` toOL
+                [ LOCK (CMPXCHG size (OpReg tmp) (OpAddr amode))
+                , JXX NE lbl
+                ]
 
-genCCall is32Bit target dest_regs args
- | is32Bit   = genCCall32 target dest_regs args
- | otherwise = genCCall64 target dest_regs args
+    size = intSize width
 
-genCCall32 :: ForeignTarget            -- function to call
-           -> [CmmFormal]        -- where to put the result
-           -> [CmmActual]        -- arguments (of mixed type)
-           -> NatM InstrBlock
-genCCall32 target dest_regs args = do
+genCCall dflags _ (PrimTarget (MO_AtomicRead width)) [dst] [addr] = do
+  load_code <- intLoadCode (MOV (intSize width)) addr
+  let platform = targetPlatform dflags
+  use_sse2 <- sse2Enabled
+  return (load_code (getRegisterReg platform use_sse2 (CmmLocal dst)))
+
+genCCall _ _ (PrimTarget (MO_AtomicWrite width)) [] [addr, val] = do
+    code <- assignMem_IntCode (intSize width) addr val
+    return $ code `snocOL` MFENCE
+
+genCCall dflags is32Bit (PrimTarget (MO_Cmpxchg width)) [dst] [addr, old, new] = do
+    -- On x86 we don't have enough registers to use cmpxchg with a
+    -- complicated addressing mode, so on that architecture we
+    -- pre-compute the address first.
+    Amode amode addr_code <- getSimpleAmode dflags is32Bit addr
+    newval <- getNewRegNat size
+    newval_code <- getAnyReg new
+    oldval <- getNewRegNat size
+    oldval_code <- getAnyReg old
+    use_sse2 <- sse2Enabled
+    let platform = targetPlatform dflags
+        dst_r    = getRegisterReg platform use_sse2 (CmmLocal dst)
+        code     = toOL
+                   [ MOV size (OpReg oldval) (OpReg eax)
+                   , LOCK (CMPXCHG size (OpReg newval) (OpAddr amode))
+                   , MOV size (OpReg eax) (OpReg dst_r)
+                   ]
+    return $ addr_code `appOL` newval_code newval `appOL` oldval_code oldval
+        `appOL` code
+  where
+    size = intSize width
+
+genCCall _ is32Bit target dest_regs args = do
   dflags <- getDynFlags
   let platform = targetPlatform dflags
   case (target, dest_regs) of
@@ -1757,7 +1951,9 @@ genCCall32 target dest_regs args = do
     (PrimTarget op, []) ->
         outOfLineCmmOp op Nothing args
     -- we only cope with a single result for foreign calls
-    (PrimTarget op, [r]) -> do
+    (PrimTarget op, [r])
+      | not is32Bit -> outOfLineCmmOp op (Just r) args
+      | otherwise -> do
         l1 <- getNewLabelNat
         l2 <- getNewLabelNat
         sse2 <- sse2Enabled
@@ -1786,7 +1982,7 @@ genCCall32 target dest_regs args = do
                    return (any (getRegisterReg platform False (CmmLocal r)))
 
         actuallyInlineFloatOp _ _ args
-              = panic $ "genCCall32.actuallyInlineFloatOp: bad number of arguments! ("
+              = panic $ "genCCall.actuallyInlineFloatOp: bad number of arguments! ("
                       ++ show (length args) ++ ")"
 
     (PrimTarget (MO_S_QuotRem  width), _) -> divOp1 platform True  width dest_regs args
@@ -1796,15 +1992,16 @@ genCCall32 target dest_regs args = do
         case args of
         [arg_x, arg_y] ->
             do hCode <- getAnyReg (CmmLit (CmmInt 0 width))
-               lCode <- getAnyReg (CmmMachOp (MO_Add width) [arg_x, arg_y])
                let size = intSize width
-                   reg_l = getRegisterReg platform True (CmmLocal res_l)
+               lCode <- anyReg =<< trivialCode width (ADD_CC size)
+                                     (Just (ADD_CC size)) arg_x arg_y
+               let reg_l = getRegisterReg platform True (CmmLocal res_l)
                    reg_h = getRegisterReg platform True (CmmLocal res_h)
                    code = hCode reg_h `appOL`
                           lCode reg_l `snocOL`
                           ADC size (OpImm (ImmInteger 0)) (OpReg reg_h)
                return code
-        _ -> panic "genCCall32: Wrong number of arguments/results for add2"
+        _ -> panic "genCCall: Wrong number of arguments/results for add2"
     (PrimTarget (MO_U_Mul2 width), [res_h, res_l]) ->
         case args of
         [arg_x, arg_y] ->
@@ -1819,18 +2016,20 @@ genCCall32 target dest_regs args = do
                                 MOV size (OpReg rdx) (OpReg reg_h),
                                 MOV size (OpReg rax) (OpReg reg_l)]
                return code
-        _ -> panic "genCCall32: Wrong number of arguments/results for add2"
+        _ -> panic "genCCall: Wrong number of arguments/results for add2"
 
-    _ -> genCCall32' dflags target dest_regs args
+    _ -> if is32Bit
+         then genCCall32' dflags target dest_regs args
+         else genCCall64' dflags target dest_regs args
 
   where divOp1 platform signed width results [arg_x, arg_y]
             = divOp platform signed width results Nothing arg_x arg_y
         divOp1 _ _ _ _ _
-            = panic "genCCall32: Wrong number of arguments for divOp1"
+            = panic "genCCall: Wrong number of arguments for divOp1"
         divOp2 platform signed width results [arg_x_high, arg_x_low, arg_y]
             = divOp platform signed width results (Just arg_x_high) arg_x_low arg_y
         divOp2 _ _ _ _ _
-            = panic "genCCall64: Wrong number of arguments for divOp2"
+            = panic "genCCall: Wrong number of arguments for divOp2"
         divOp platform signed width [res_q, res_r]
               m_arg_x_high arg_x_low arg_y
             = do let size = intSize width
@@ -1854,7 +2053,7 @@ genCCall32 target dest_regs args = do
                                 MOV size (OpReg rax) (OpReg reg_q),
                                 MOV size (OpReg rdx) (OpReg reg_r)]
         divOp _ _ _ _ _ _ _
-            = panic "genCCall32: Wrong number of results for divOp"
+            = panic "genCCall: Wrong number of results for divOp"
 
 genCCall32' :: DynFlags
             -> ForeignTarget            -- function to call
@@ -2009,90 +2208,6 @@ genCCall32' dflags target dest_regs args = do
              arg_ty = cmmExprType dflags arg
              size = arg_size arg_ty -- Byte size
 
-genCCall64 :: ForeignTarget            -- function to call
-           -> [CmmFormal]        -- where to put the result
-           -> [CmmActual]        -- arguments (of mixed type)
-           -> NatM InstrBlock
-genCCall64 target dest_regs args = do
-  dflags <- getDynFlags
-  let platform = targetPlatform dflags
-  case (target, dest_regs) of
-
-    (PrimTarget op, []) ->
-        -- void return type prim op
-        outOfLineCmmOp op Nothing args
-
-    (PrimTarget op, [res]) ->
-        -- we only cope with a single result for foreign calls
-        outOfLineCmmOp op (Just res) args
-
-    (PrimTarget (MO_S_QuotRem  width), _) -> divOp1 platform True  width dest_regs args
-    (PrimTarget (MO_U_QuotRem  width), _) -> divOp1 platform False width dest_regs args
-    (PrimTarget (MO_U_QuotRem2 width), _) -> divOp2 platform False width dest_regs args
-    (PrimTarget (MO_Add2 width), [res_h, res_l]) ->
-        case args of
-        [arg_x, arg_y] ->
-            do hCode <- getAnyReg (CmmLit (CmmInt 0 width))
-               lCode <- getAnyReg (CmmMachOp (MO_Add width) [arg_x, arg_y])
-               let size = intSize width
-                   reg_l = getRegisterReg platform True (CmmLocal res_l)
-                   reg_h = getRegisterReg platform True (CmmLocal res_h)
-                   code = hCode reg_h `appOL`
-                          lCode reg_l `snocOL`
-                          ADC size (OpImm (ImmInteger 0)) (OpReg reg_h)
-               return code
-        _ -> panic "genCCall64: Wrong number of arguments/results for add2"
-    (PrimTarget (MO_U_Mul2 width), [res_h, res_l]) ->
-        case args of
-        [arg_x, arg_y] ->
-            do (y_reg, y_code) <- getRegOrMem arg_y
-               x_code <- getAnyReg arg_x
-               let size = intSize width
-                   reg_h = getRegisterReg platform True (CmmLocal res_h)
-                   reg_l = getRegisterReg platform True (CmmLocal res_l)
-                   code = y_code `appOL`
-                          x_code rax `appOL`
-                          toOL [MUL2 size y_reg,
-                                MOV size (OpReg rdx) (OpReg reg_h),
-                                MOV size (OpReg rax) (OpReg reg_l)]
-               return code
-        _ -> panic "genCCall64: Wrong number of arguments/results for add2"
-
-    _ ->
-        do dflags <- getDynFlags
-           genCCall64' dflags target dest_regs args
-
-  where divOp1 platform signed width results [arg_x, arg_y]
-            = divOp platform signed width results Nothing arg_x arg_y
-        divOp1 _ _ _ _ _
-            = panic "genCCall64: Wrong number of arguments for divOp1"
-        divOp2 platform signed width results [arg_x_high, arg_x_low, arg_y]
-            = divOp platform signed width results (Just arg_x_high) arg_x_low arg_y
-        divOp2 _ _ _ _ _
-            = panic "genCCall64: Wrong number of arguments for divOp2"
-        divOp platform signed width [res_q, res_r]
-              m_arg_x_high arg_x_low arg_y
-            = do let size = intSize width
-                     reg_q = getRegisterReg platform True (CmmLocal res_q)
-                     reg_r = getRegisterReg platform True (CmmLocal res_r)
-                     widen | signed    = CLTD size
-                           | otherwise = XOR size (OpReg rdx) (OpReg rdx)
-                     instr | signed    = IDIV
-                           | otherwise = DIV
-                 (y_reg, y_code) <- getRegOrMem arg_y
-                 x_low_code <- getAnyReg arg_x_low
-                 x_high_code <- case m_arg_x_high of
-                                Just arg_x_high -> getAnyReg arg_x_high
-                                Nothing -> return $ const $ unitOL widen
-                 return $ y_code `appOL`
-                          x_low_code rax `appOL`
-                          x_high_code rdx `appOL`
-                          toOL [instr size y_reg,
-                                MOV size (OpReg rax) (OpReg reg_q),
-                                MOV size (OpReg rdx) (OpReg reg_r)]
-        divOp _ _ _ _ _ _ _
-            = panic "genCCall64: Wrong number of results for divOp"
-
 genCCall64' :: DynFlags
             -> ForeignTarget            -- function to call
             -> [CmmFormal]        -- where to put the result
@@ -2304,12 +2419,6 @@ maybePromoteCArg dflags wto arg
  where
    wfrom = cmmExprWidth dflags arg
 
--- | We're willing to inline and unroll memcpy/memset calls that touch
--- at most these many bytes.  This threshold is the same as the one
--- used by GCC and LLVM.
-maxInlineSizeThreshold :: Integer
-maxInlineSizeThreshold = 128
-
 outOfLineCmmOp :: CallishMachOp -> Maybe CmmFormal -> [CmmActual] -> NatM InstrBlock
 outOfLineCmmOp mop res args
   = do
@@ -2370,6 +2479,13 @@ outOfLineCmmOp mop res args
 
               MO_PopCnt _  -> fsLit "popcnt"
               MO_BSwap _   -> fsLit "bswap"
+              MO_Clz w     -> fsLit $ clzLabel w
+              MO_Ctz w     -> fsLit $ ctzLabel w
+
+              MO_AtomicRMW _ _ -> fsLit "atomicrmw"
+              MO_AtomicRead _  -> fsLit "atomicread"
+              MO_AtomicWrite _ -> fsLit "atomicwrite"
+              MO_Cmpxchg _     -> fsLit "cmpxchg"
 
               MO_UF_Conv _ -> unsupported
 
diff --git a/compiler/nativeGen/X86/Instr.hs b/compiler/nativeGen/X86/Instr.hs
index d10591e37f8e..a6e63f7d52f7 100644
--- a/compiler/nativeGen/X86/Instr.hs
+++ b/compiler/nativeGen/X86/Instr.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE CPP, TypeFamilies #-}
+
 -----------------------------------------------------------------------------
 --
 -- Machine-dependent assembly language
@@ -6,15 +8,15 @@
 --
 -----------------------------------------------------------------------------
 
-#include "HsVersions.h"
-#include "nativeGen/NCG.h"
-
 module X86.Instr (Instr(..), Operand(..), PrefetchVariant(..), JumpDest,
                   getJumpDestBlockId, canShortcut, shortcutStatics,
                   shortcutJump, i386_insert_ffrees, allocMoreStack,
                   maxSpillSlots, archWordSize)
 where
 
+#include "HsVersions.h"
+#include "nativeGen/NCG.h"
+
 import X86.Cond
 import X86.Regs
 import Instruction
@@ -163,6 +165,9 @@ data Instr
         -- comment pseudo-op
         = COMMENT FastString
 
+        -- location pseudo-op (file, line, col, name)
+        | LOCATION Int Int Int String
+
         -- some static data spat out during code
         -- generation.  Will be extracted before
         -- pretty-printing.
@@ -180,6 +185,7 @@ data Instr
 
         -- Moves.
         | MOV         Size Operand Operand
+        | CMOV   Cond Size Operand Reg
         | MOVZxL      Size Operand Operand -- size is the size of operand 1
         | MOVSxL      Size Operand Operand -- size is the size of operand 1
         -- x86_64 note: plain mov into a 32-bit register always zero-extends
@@ -202,6 +208,12 @@ data Instr
         | DIV         Size Operand              -- eax := eax:edx/op, edx := eax:edx%op
         | IDIV        Size Operand              -- ditto, but signed
 
+        -- Int Arithmetic, where the effects on the condition register
+        -- are important. Used in specialized sequences such as MO_Add2.
+        -- Do not rewrite these instructions to "equivalent" ones that
+        -- have different effect on the condition register! (See #9013.)
+        | ADD_CC      Size Operand Operand
+
         -- Simple bit-twiddling.
         | AND         Size Operand Operand
         | OR          Size Operand Operand
@@ -318,13 +330,20 @@ data Instr
                                  --       call 1f
                                  -- 1:    popl %reg
 
-    -- SSE4.2
-        | POPCNT      Size Operand Reg -- src, dst
+    -- bit counting instructions
+        | POPCNT      Size Operand Reg -- [SSE4.2] count number of bits set to 1
+        | BSF         Size Operand Reg -- bit scan forward
+        | BSR         Size Operand Reg -- bit scan reverse
 
     -- prefetch
         | PREFETCH  PrefetchVariant Size Operand -- prefetch Variant, addr size, address to prefetch
                                         -- variant can be NTA, Lvl0, Lvl1, or Lvl2
 
+        | LOCK        Instr -- lock prefix
+        | XADD        Size Operand Operand  -- src (r), dst (r/m)
+        | CMPXCHG     Size Operand Operand  -- src (r), dst (r/m), eax implicit
+        | MFENCE
+
 data PrefetchVariant = NTA | Lvl0 | Lvl1 | Lvl2
 
 
@@ -335,10 +354,13 @@ data Operand
 
 
 
+-- | Returns which registers are read and written as a (read, written)
+-- pair.
 x86_regUsageOfInstr :: Platform -> Instr -> RegUsage
 x86_regUsageOfInstr platform instr
  = case instr of
     MOV    _ src dst    -> usageRW src dst
+    CMOV _ _ src dst    -> mkRU (use_R src [dst]) [dst]
     MOVZxL _ src dst    -> usageRW src dst
     MOVSxL _ src dst    -> usageRW src dst
     LEA    _ src dst    -> usageRW src dst
@@ -351,6 +373,7 @@ x86_regUsageOfInstr platform instr
     MUL2   _ src        -> mkRU (eax:use_R src []) [eax,edx]
     DIV    _ op -> mkRU (eax:edx:use_R op []) [eax,edx]
     IDIV   _ op -> mkRU (eax:edx:use_R op []) [eax,edx]
+    ADD_CC _ src dst    -> usageRM src dst
     AND    _ src dst    -> usageRM src dst
     OR     _ src dst    -> usageRM src dst
 
@@ -420,16 +443,31 @@ x86_regUsageOfInstr platform instr
     FETCHPC  reg        -> mkRU [] [reg]
 
     COMMENT _           -> noUsage
+    LOCATION{}          -> noUsage
     DELTA   _           -> noUsage
 
     POPCNT _ src dst -> mkRU (use_R src []) [dst]
+    BSF    _ src dst -> mkRU (use_R src []) [dst]
+    BSR    _ src dst -> mkRU (use_R src []) [dst]
 
     -- note: might be a better way to do this
     PREFETCH _  _ src -> mkRU (use_R src []) []
+    LOCK i              -> x86_regUsageOfInstr platform i
+    XADD _ src dst      -> usageMM src dst
+    CMPXCHG _ src dst   -> usageRMM src dst (OpReg eax)
+    MFENCE -> noUsage
 
     _other              -> panic "regUsage: unrecognised instr"
-
  where
+    -- # Definitions
+    --
+    -- Written: If the operand is a register, it's written. If it's an
+    -- address, registers mentioned in the address are read.
+    --
+    -- Modified: If the operand is a register, it's both read and
+    -- written. If it's an address, registers mentioned in the address
+    -- are read.
+
     -- 2 operand form; first operand Read; second Written
     usageRW :: Operand -> Operand -> RegUsage
     usageRW op (OpReg reg)      = mkRU (use_R op []) [reg]
@@ -442,6 +480,18 @@ x86_regUsageOfInstr platform instr
     usageRM op (OpAddr ea)      = mkRUR (use_R op $! use_EA ea [])
     usageRM _ _                 = panic "X86.RegInfo.usageRM: no match"
 
+    -- 2 operand form; first operand Modified; second Modified
+    usageMM :: Operand -> Operand -> RegUsage
+    usageMM (OpReg src) (OpReg dst) = mkRU [src, dst] [src, dst]
+    usageMM (OpReg src) (OpAddr ea) = mkRU (use_EA ea [src]) [src]
+    usageMM _ _                     = panic "X86.RegInfo.usageMM: no match"
+
+    -- 3 operand form; first operand Read; second Modified; third Modified
+    usageRMM :: Operand -> Operand -> Operand -> RegUsage
+    usageRMM (OpReg src) (OpReg dst) (OpReg reg) = mkRU [src, dst, reg] [dst, reg]
+    usageRMM (OpReg src) (OpAddr ea) (OpReg reg) = mkRU (use_EA ea [src, reg]) [reg]
+    usageRMM _ _ _                               = panic "X86.RegInfo.usageRMM: no match"
+
     -- 1 operand form; operand Modified
     usageM :: Operand -> RegUsage
     usageM (OpReg reg)          = mkRU [reg] [reg]
@@ -474,6 +524,7 @@ x86_regUsageOfInstr platform instr
         where src' = filter (interesting platform) src
               dst' = filter (interesting platform) dst
 
+-- | Is this register interesting for the register allocator?
 interesting :: Platform -> Reg -> Bool
 interesting _        (RegVirtual _)              = True
 interesting platform (RegReal (RealRegSingle i)) = isFastTrue (freeReg platform i)
@@ -481,10 +532,13 @@ interesting _        (RegReal (RealRegPair{}))   = panic "X86.interesting: no re
 
 
 
+-- | Applies the supplied function to all registers in instructions.
+-- Typically used to change virtual registers to real registers.
 x86_patchRegsOfInstr :: Instr -> (Reg -> Reg) -> Instr
 x86_patchRegsOfInstr instr env
  = case instr of
     MOV  sz src dst     -> patch2 (MOV  sz) src dst
+    CMOV cc sz src dst  -> CMOV cc sz (patchOp src) (env dst)
     MOVZxL sz src dst   -> patch2 (MOVZxL sz) src dst
     MOVSxL sz src dst   -> patch2 (MOVSxL sz) src dst
     LEA  sz src dst     -> patch2 (LEA  sz) src dst
@@ -497,6 +551,7 @@ x86_patchRegsOfInstr instr env
     MUL2 sz src         -> patch1 (MUL2 sz) src
     IDIV sz op          -> patch1 (IDIV sz) op
     DIV sz op           -> patch1 (DIV sz) op
+    ADD_CC sz src dst   -> patch2 (ADD_CC sz) src dst
     AND  sz src dst     -> patch2 (AND  sz) src dst
     OR   sz src dst     -> patch2 (OR   sz) src dst
     XOR  sz src dst     -> patch2 (XOR  sz) src dst
@@ -559,6 +614,7 @@ x86_patchRegsOfInstr instr env
 
     NOP                 -> instr
     COMMENT _           -> instr
+    LOCATION {}         -> instr
     DELTA _             -> instr
 
     JXX _ _             -> instr
@@ -566,9 +622,16 @@ x86_patchRegsOfInstr instr env
     CLTD _              -> instr
 
     POPCNT sz src dst -> POPCNT sz (patchOp src) (env dst)
+    BSF    sz src dst -> BSF    sz (patchOp src) (env dst)
+    BSR    sz src dst -> BSR    sz (patchOp src) (env dst)
 
     PREFETCH lvl size src -> PREFETCH lvl size (patchOp src)
 
+    LOCK i              -> LOCK (x86_patchRegsOfInstr i env)
+    XADD sz src dst     -> patch2 (XADD sz) src dst
+    CMPXCHG sz src dst  -> patch2 (CMPXCHG sz) src dst
+    MFENCE              -> instr
+
     _other              -> panic "patchRegs: unrecognised instr"
 
   where
@@ -712,6 +775,7 @@ x86_isMetaInstr
 x86_isMetaInstr instr
  = case instr of
         COMMENT{}       -> True
+        LOCATION{}      -> True
         LDATA{}         -> True
         NEWBLOCK{}      -> True
         DELTA{}         -> True
@@ -788,7 +852,7 @@ i386_insert_ffrees
         -> [GenBasicBlock Instr]
 
 i386_insert_ffrees blocks
-   | or (map (any is_G_instr) [ instrs | BasicBlock _ instrs <- blocks ])
+   | any (any is_G_instr) [ instrs | BasicBlock _ instrs <- blocks ]
    = map insertGFREEs blocks
    | otherwise
    = blocks
diff --git a/compiler/nativeGen/X86/Ppr.hs b/compiler/nativeGen/X86/Ppr.hs
index f38a04d06935..b35a1b3d2766 100644
--- a/compiler/nativeGen/X86/Ppr.hs
+++ b/compiler/nativeGen/X86/Ppr.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE CPP #-}
+
 -----------------------------------------------------------------------------
 --
 -- Pretty-printing assembly language
@@ -63,6 +65,7 @@ pprNatCmmDecl proc@(CmmProc top_info lbl _ (ListGraph blocks)) =
            pprSectionHeader Text $$
            pprLabel lbl $$ -- blocks guaranteed not null, so label needed
            vcat (map (pprBasicBlock top_info) blocks) $$
+           ppr (mkAsmTempEndLabel lbl) <> char ':' $$
            pprSizeDecl lbl
 
     Just (Statics info_lbl _) ->
@@ -87,6 +90,7 @@ pprNatCmmDecl proc@(CmmProc top_info lbl _ (ListGraph blocks)) =
                   <+> char '-'
                   <+> ppr (mkDeadStripPreventer info_lbl)
              else empty) $$
+      ppr (mkAsmTempEndLabel info_lbl) <> char ':' $$
       pprSizeDecl info_lbl
 
 -- | Output the ELF .size directive.
@@ -101,15 +105,23 @@ pprSizeDecl lbl
 pprBasicBlock :: BlockEnv CmmStatics -> NatBasicBlock Instr -> SDoc
 pprBasicBlock info_env (BasicBlock blockid instrs)
   = maybe_infotable $$
-    pprLabel (mkAsmTempLabel (getUnique blockid)) $$
-    vcat (map pprInstr instrs)
+    pprLabel asmLbl $$
+    vcat (map pprInstr instrs) $$
+    ppr (mkAsmTempEndLabel asmLbl) <> char ':'
   where
+    asmLbl = mkAsmTempLabel (getUnique blockid)
     maybe_infotable = case mapLookup blockid info_env of
        Nothing   -> empty
        Just (Statics info_lbl info) ->
            pprSectionHeader Text $$
+           infoTableLoc $$
            vcat (map pprData info) $$
            pprLabel info_lbl
+    -- Make sure the info table has the right .loc for the block
+    -- coming right after it. See [Note: Info Offset]
+    infoTableLoc = case instrs of
+      (l@LOCATION{} : _) -> pprInstr l
+      _other             -> empty
 
 pprDatas :: (Alignment, CmmStatics) -> SDoc
 pprDatas (align, (Statics lbl dats))
@@ -489,6 +501,11 @@ pprInstr (COMMENT _) = empty -- nuke 'em
 {-
 pprInstr (COMMENT s) = ptext (sLit "# ") <> ftext s
 -}
+
+pprInstr (LOCATION file line col name)
+   = ptext (sLit "\t.loc ") <> ppr file <+> ppr line <+> ppr col <>
+     ptext (sLit " /* ") <> text name <> ptext (sLit " */")
+
 pprInstr (DELTA d)
    = pprInstr (COMMENT (mkFastString ("\tdelta = " ++ show d)))
 
@@ -519,6 +536,9 @@ pprInstr (RELOAD slot reg)
 pprInstr (MOV size src dst)
   = pprSizeOpOp (sLit "mov") size src dst
 
+pprInstr (CMOV cc size src dst)
+  = pprCondOpReg (sLit "cmov") size cc src dst
+
 pprInstr (MOVZxL II32 src dst) = pprSizeOpOp (sLit "mov") II32 src dst
         -- 32-to-64 bit zero extension on x86_64 is accomplished by a simple
         -- movl.  But we represent it as a MOVZxL instruction, because
@@ -561,6 +581,9 @@ pprInstr (ADC size src dst)
 pprInstr (SUB size src dst) = pprSizeOpOp (sLit "sub") size src dst
 pprInstr (IMUL size op1 op2) = pprSizeOpOp (sLit "imul") size op1 op2
 
+pprInstr (ADD_CC size src dst)
+  = pprSizeOpOp (sLit "add") size src dst
+
 {- A hack.  The Intel documentation says that "The two and three
    operand forms [of IMUL] may also be used with unsigned operands
    because the lower half of the product is the same regardless if
@@ -576,6 +599,8 @@ pprInstr (XOR FF64 src dst) = pprOpOp (sLit "xorpd") FF64 src dst
 pprInstr (XOR size src dst) = pprSizeOpOp (sLit "xor")  size src dst
 
 pprInstr (POPCNT size src dst) = pprOpOp (sLit "popcnt") size src (OpReg dst)
+pprInstr (BSF size src dst)    = pprOpOp (sLit "bsf")    size src (OpReg dst)
+pprInstr (BSR size src dst)    = pprOpOp (sLit "bsr")    size src (OpReg dst)
 
 pprInstr (PREFETCH NTA size src ) =  pprSizeOp_ (sLit "prefetchnta") size src
 pprInstr (PREFETCH Lvl0 size src) = pprSizeOp_ (sLit "prefetcht0") size src
@@ -884,6 +909,16 @@ pprInstr GFREE
             ptext (sLit "\tffree %st(4) ;ffree %st(5)")
           ]
 
+-- Atomics
+
+pprInstr (LOCK i) = ptext (sLit "\tlock") $$ pprInstr i
+
+pprInstr MFENCE = ptext (sLit "\tmfence")
+
+pprInstr (XADD size src dst) = pprSizeOpOp (sLit "xadd") size src dst
+
+pprInstr (CMPXCHG size src dst) = pprSizeOpOp (sLit "cmpxchg") size src dst
+
 pprInstr _
         = panic "X86.Ppr.pprInstr: no match"
 
@@ -1104,6 +1139,18 @@ pprSizeOpReg name size op1 reg2
         pprReg (archWordSize (target32Bit platform)) reg2
     ]
 
+pprCondOpReg :: LitString -> Size -> Cond -> Operand -> Reg -> SDoc
+pprCondOpReg name size cond op1 reg2
+  = hcat [
+        char '\t',
+        ptext name,
+        pprCond cond,
+        space,
+        pprOperand size op1,
+        comma,
+        pprReg size reg2
+    ]
+
 pprCondRegReg :: LitString -> Size -> Cond -> Reg -> Reg -> SDoc
 pprCondRegReg name size cond reg1 reg2
   = hcat [
diff --git a/compiler/nativeGen/X86/RegInfo.hs b/compiler/nativeGen/X86/RegInfo.hs
index 8c63933c5bc2..39535634d734 100644
--- a/compiler/nativeGen/X86/RegInfo.hs
+++ b/compiler/nativeGen/X86/RegInfo.hs
@@ -1,14 +1,7 @@
-
-{-# OPTIONS -fno-warn-tabs #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and
--- detab the module (please do the detabbing in a separate patch). See
---     http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
--- for details
-
+{-# LANGUAGE CPP #-}
 module X86.RegInfo (
-	mkVirtualReg,
-	regDotColor
+        mkVirtualReg,
+        regDotColor
 )
 
 where
@@ -30,9 +23,9 @@ import X86.Regs
 mkVirtualReg :: Unique -> Size -> VirtualReg
 mkVirtualReg u size
    = case size of
-        FF32	-> VirtualRegSSE u
-        FF64	-> VirtualRegSSE u
-        FF80	-> VirtualRegD   u
+        FF32    -> VirtualRegSSE u
+        FF64    -> VirtualRegSSE u
+        FF80    -> VirtualRegD   u
         _other  -> VirtualRegI   u
 
 regDotColor :: Platform -> RealReg -> SDoc
@@ -65,11 +58,10 @@ normalRegColors platform
 fpRegColors :: [(Reg,String)]
 fpRegColors =
         [ (fake0, "#ff00ff")
-	, (fake1, "#ff00aa")
-	, (fake2, "#aa00ff")
-	, (fake3, "#aa00aa")
-	, (fake4, "#ff0055")
-	, (fake5, "#5500ff") ]
-
-	++ zip (map regSingle [24..39]) (repeat "red")
+        , (fake1, "#ff00aa")
+        , (fake2, "#aa00ff")
+        , (fake3, "#aa00aa")
+        , (fake4, "#ff0055")
+        , (fake5, "#5500ff") ]
 
+        ++ zip (map regSingle [24..39]) (repeat "red")
diff --git a/compiler/nativeGen/X86/Regs.hs b/compiler/nativeGen/X86/Regs.hs
index b5139c92bf11..4162e2b703f3 100644
--- a/compiler/nativeGen/X86/Regs.hs
+++ b/compiler/nativeGen/X86/Regs.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE CPP #-}
+
 module X86.Regs (
         -- squeese functions for the graph allocator
         virtualRegSqueeze,
@@ -403,6 +405,9 @@ callClobberedRegs       :: Platform -> [Reg]
 -- caller-saves registers
 callClobberedRegs platform
  | target32Bit platform = [eax,ecx,edx] ++ map regSingle (floatregnos platform)
+ | platformOS platform == OSMinGW32
+   = [rax,rcx,rdx,r8,r9,r10,r11]
+   ++ map regSingle (floatregnos platform)
  | otherwise
     -- all xmm regs are caller-saves
     -- caller-saves registers
diff --git a/compiler/parser/Ctype.lhs b/compiler/parser/Ctype.lhs
index b5173b2612af..7233f50e7f3c 100644
--- a/compiler/parser/Ctype.lhs
+++ b/compiler/parser/Ctype.lhs
@@ -1,32 +1,26 @@
 Character classification
 
 \begin{code}
-{-# OPTIONS -fno-warn-tabs #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and
--- detab the module (please do the detabbing in a separate patch). See
---     http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
--- for details
-
+{-# LANGUAGE CPP #-}
 module Ctype
-	( is_ident	-- Char# -> Bool
-	, is_symbol	-- Char# -> Bool
-	, is_any	-- Char# -> Bool
-	, is_space	-- Char# -> Bool
-	, is_lower	-- Char# -> Bool
-	, is_upper	-- Char# -> Bool
-	, is_digit	-- Char# -> Bool
-	, is_alphanum   -- Char# -> Bool
-
-	, is_decdigit, is_hexdigit, is_octdigit
-	, hexDigit, octDecDigit
-	) where
+        ( is_ident      -- Char# -> Bool
+        , is_symbol     -- Char# -> Bool
+        , is_any        -- Char# -> Bool
+        , is_space      -- Char# -> Bool
+        , is_lower      -- Char# -> Bool
+        , is_upper      -- Char# -> Bool
+        , is_digit      -- Char# -> Bool
+        , is_alphanum   -- Char# -> Bool
+
+        , is_decdigit, is_hexdigit, is_octdigit, is_bindigit
+        , hexDigit, octDecDigit
+        ) where
 
 #include "HsVersions.h"
 
-import Data.Int		( Int32 )
-import Data.Bits	( Bits((.&.)) )
-import Data.Char	( ord, chr )
+import Data.Int         ( Int32 )
+import Data.Bits        ( Bits((.&.)) )
+import Data.Char        ( ord, chr )
 import Panic
 \end{code}
 
@@ -75,17 +69,20 @@ octDecDigit c = ord c - ord '0'
 
 is_decdigit :: Char -> Bool
 is_decdigit c
-	=  c >= '0' && c <= '9'
+        =  c >= '0' && c <= '9'
 
 is_hexdigit :: Char -> Bool
 is_hexdigit c
-	=  is_decdigit c 
-	|| (c >= 'a' && c <= 'f')
-	|| (c >= 'A' && c <= 'F')
+        =  is_decdigit c
+        || (c >= 'a' && c <= 'f')
+        || (c >= 'A' && c <= 'F')
 
 is_octdigit :: Char -> Bool
 is_octdigit c = c >= '0' && c <= '7'
 
+is_bindigit :: Char -> Bool
+is_bindigit c = c == '0' || c == '1'
+
 to_lower :: Char -> Char
 to_lower c
   | c >=  'A' && c <= 'Z' = chr (ord c - (ord 'A' - ord 'a'))
@@ -108,7 +105,7 @@ charType c = case c of
    '\7'   -> 0                         -- \007
    '\8'   -> 0                         -- \010
    '\9'   -> cSpace                    -- \t  (not allowed in strings, so !cAny)
-   '\10'  -> cSpace	               -- \n  (ditto)
+   '\10'  -> cSpace                    -- \n  (ditto)
    '\11'  -> cSpace                    -- \v  (ditto)
    '\12'  -> cSpace                    -- \f  (ditto)
    '\13'  -> cSpace                    --  ^M (ditto)
diff --git a/compiler/parser/LexCore.hs b/compiler/parser/LexCore.hs
deleted file mode 100644
index 861fffb7f676..000000000000
--- a/compiler/parser/LexCore.hs
+++ /dev/null
@@ -1,115 +0,0 @@
-module LexCore where
-
-import ParserCoreUtils
-import Panic
-import Data.Char
-import Numeric
-
-isNameChar :: Char -> Bool
-isNameChar c = isAlpha c || isDigit c || (c == '_') || (c == '\'')
-               || (c == '$') || (c == '-') || (c == '.')
-
-isKeywordChar :: Char -> Bool
-isKeywordChar c = isAlpha c || (c == '_')
-
-lexer :: (Token -> P a) -> P a
-lexer cont []           = cont TKEOF []
-lexer cont ('\n':cs)    = \line -> lexer cont cs (line+1)
-lexer cont ('-':'>':cs) = cont TKrarrow cs
-
-lexer cont (c:cs)
-      | isSpace c               = lexer cont cs
-      | isLower c || (c == '_') = lexName cont TKname (c:cs)
-      | isUpper c               = lexName cont TKcname (c:cs)
-      | isDigit c || (c == '-') = lexNum cont (c:cs)
-
-lexer cont ('%':cs)     = lexKeyword cont cs
-lexer cont ('\'':cs)    = lexChar cont cs
-lexer cont ('\"':cs)    = lexString [] cont cs
-lexer cont ('#':cs)     = cont TKhash cs
-lexer cont ('(':cs)     = cont TKoparen cs
-lexer cont (')':cs)     = cont TKcparen cs
-lexer cont ('{':cs)     = cont TKobrace cs
-lexer cont ('}':cs)     = cont TKcbrace cs
-lexer cont ('=':cs)     = cont TKeq cs
-lexer cont (':':'=':':':cs) = cont TKcoloneqcolon cs
-lexer cont (':':':':cs) = cont TKcoloncolon cs
-lexer cont ('*':cs)     = cont TKstar cs
-lexer cont ('.':cs)     = cont TKdot cs
-lexer cont ('\\':cs)    = cont TKlambda cs
-lexer cont ('@':cs)     = cont TKat cs
-lexer cont ('?':cs)     = cont TKquestion cs
-lexer cont (';':cs)     = cont TKsemicolon cs
--- 20060420 GHC spits out constructors with colon in them nowadays. jds
--- 20061103 but it's easier to parse if we split on the colon, and treat them
--- as several tokens
-lexer cont (':':cs)     = cont TKcolon cs
--- 20060420 Likewise does it create identifiers starting with dollar. jds
-lexer cont ('$':cs)     = lexName cont TKname ('$':cs)
-lexer _    (c:_)        = failP "invalid character" [c]
-
-lexChar :: (Token -> String -> Int -> ParseResult a) -> String -> Int
-        -> ParseResult a
-lexChar cont ('\\':'x':h1:h0:'\'':cs)
-    | isHexEscape [h1,h0] = cont (TKchar (hexToChar h1 h0)) cs
-lexChar _    ('\\':cs)    = failP "invalid char character" ('\\':(take 10 cs))
-lexChar _    ('\'':_)     = failP "invalid char character" ['\'']
-lexChar _    ('\"':_)     = failP "invalid char character" ['\"']
-lexChar cont (c:'\'':cs)  = cont (TKchar c) cs
-lexChar _    cs           = panic ("lexChar: " ++ show cs)
-
-lexString :: String -> (Token -> [Char] -> Int -> ParseResult a)
-          -> String -> Int -> ParseResult a
-lexString s cont ('\\':'x':h1:h0:cs)
-    | isHexEscape [h1,h0]  = lexString (s++[hexToChar h1 h0]) cont cs
-lexString _ _    ('\\':_)  = failP "invalid string character" ['\\']
-lexString _ _    ('\'':_)  = failP "invalid string character" ['\'']
-lexString s cont ('\"':cs) = cont (TKstring s) cs
-lexString s cont (c:cs)    = lexString (s++[c]) cont cs
-lexString _ _    []        = panic "lexString []"
-
-isHexEscape :: String -> Bool
-isHexEscape = all (\c -> isHexDigit c && (isDigit c || isLower c))
-
-hexToChar :: Char -> Char -> Char
-hexToChar h1 h0 = chr (digitToInt h1 * 16 + digitToInt h0)
-
-lexNum :: (Token -> String -> a) -> String -> a
-lexNum cont cs =
-  case cs of
-     ('-':cs) -> f (-1) cs
-     _        -> f 1 cs
- where f sgn cs =
-         case span isDigit cs of
-          (digits,'.':c:rest)
-                | isDigit c -> cont (TKrational (fromInteger sgn * r)) rest'
-                where ((r,rest'):_) = readFloat (digits ++ ('.':c:rest))
-                -- When reading a floating-point number, which is
-                -- a bit complicated, use the standard library function
-                -- "readFloat"
-          (digits,rest) -> cont (TKinteger (sgn * (read digits))) rest
-
-lexName :: (a -> String -> b) -> (String -> a) -> String -> b
-lexName cont cstr cs = cont (cstr name) rest
-   where (name,rest) = span isNameChar cs
-
-lexKeyword :: (Token -> [Char] -> Int -> ParseResult a) -> String -> Int
-           -> ParseResult a
-lexKeyword cont cs =
-   case span isKeywordChar cs of
-      ("module",rest) -> cont TKmodule rest
-      ("data",rest)  -> cont TKdata rest
-      ("newtype",rest) -> cont TKnewtype rest
-      ("forall",rest) -> cont TKforall rest
-      ("rec",rest) -> cont TKrec rest
-      ("let",rest) -> cont TKlet rest
-      ("in",rest) -> cont TKin rest
-      ("case",rest) -> cont TKcase rest
-      ("of",rest) -> cont TKof rest
-      ("cast",rest) -> cont TKcast rest
-      ("note",rest) -> cont TKnote rest
-      ("external",rest) -> cont TKexternal rest
-      ("local",rest) -> cont TKlocal rest
-      ("_",rest) -> cont TKwild rest
-      _ -> failP "invalid keyword" ('%':cs)
-
diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x
index 3d02393d170c..88a0f07d9041 100644
--- a/compiler/parser/Lexer.x
+++ b/compiler/parser/Lexer.x
@@ -117,6 +117,7 @@ $small     = [$ascsmall $unismall \_]
 $unigraphic = \x06 -- Trick Alex into handling Unicode. See alexGetChar.
 $graphic   = [$small $large $symbol $digit $special $unigraphic \:\"\']
 
+$binit     = 0-1
 $octit     = 0-7
 $hexit     = [$decdigit A-F a-f]
 $symchar   = [$symbol \:]
@@ -134,6 +135,7 @@ $docsym    = [\| \^ \* \$]
 @consym    = \: $symchar*
 
 @decimal     = $decdigit+
+@binary      = $binit+
 @octal       = $octit+
 @hexadecimal = $hexit+
 @exponent    = [eE] [\-\+]? @decimal
@@ -401,9 +403,12 @@ $tab+         { warn Opt_WarnTabs (text "Tab character") }
 <0> {
   -- Normal integral literals (:: Num a => a, from Integer)
   @decimal                                                               { tok_num positive 0 0 decimal }
+  0[bB] @binary                / { ifExtension binaryLiteralsEnabled }   { tok_num positive 2 2 binary }
   0[oO] @octal                                                           { tok_num positive 2 2 octal }
   0[xX] @hexadecimal                                                     { tok_num positive 2 2 hexadecimal }
   @negative @decimal           / { ifExtension negativeLiteralsEnabled } { tok_num negative 1 1 decimal }
+  @negative 0[bB] @binary      / { ifExtension negativeLiteralsEnabled `alexAndPred`
+                                   ifExtension binaryLiteralsEnabled }   { tok_num negative 3 3 binary }
   @negative 0[oO] @octal       / { ifExtension negativeLiteralsEnabled } { tok_num negative 3 3 octal }
   @negative 0[xX] @hexadecimal / { ifExtension negativeLiteralsEnabled } { tok_num negative 3 3 hexadecimal }
 
@@ -417,13 +422,19 @@ $tab+         { warn Opt_WarnTabs (text "Tab character") }
   -- It's simpler (and faster?) to give separate cases to the negatives,
   -- especially considering octal/hexadecimal prefixes.
   @decimal                     \# / { ifExtension magicHashEnabled } { tok_primint positive 0 1 decimal }
+  0[bB] @binary                \# / { ifExtension magicHashEnabled `alexAndPred`
+                                      ifExtension binaryLiteralsEnabled } { tok_primint positive 2 3 binary }
   0[oO] @octal                 \# / { ifExtension magicHashEnabled } { tok_primint positive 2 3 octal }
   0[xX] @hexadecimal           \# / { ifExtension magicHashEnabled } { tok_primint positive 2 3 hexadecimal }
   @negative @decimal           \# / { ifExtension magicHashEnabled } { tok_primint negative 1 2 decimal }
+  @negative 0[bB] @binary      \# / { ifExtension magicHashEnabled `alexAndPred`
+                                      ifExtension binaryLiteralsEnabled } { tok_primint negative 3 4 binary }
   @negative 0[oO] @octal       \# / { ifExtension magicHashEnabled } { tok_primint negative 3 4 octal }
   @negative 0[xX] @hexadecimal \# / { ifExtension magicHashEnabled } { tok_primint negative 3 4 hexadecimal }
 
   @decimal                     \# \# / { ifExtension magicHashEnabled } { tok_primword 0 2 decimal }
+  0[bB] @binary                \# \# / { ifExtension magicHashEnabled `alexAndPred`
+                                         ifExtension binaryLiteralsEnabled } { tok_primword 2 4 binary }
   0[oO] @octal                 \# \# / { ifExtension magicHashEnabled } { tok_primword 2 4 octal }
   0[xX] @hexadecimal           \# \# / { ifExtension magicHashEnabled } { tok_primword 2 4 hexadecimal }
 
@@ -516,6 +527,10 @@ data Token
   | ITvect_scalar_prag
   | ITnovect_prag
   | ITminimal_prag
+  | IToverlappable_prag         -- instance overlap mode
+  | IToverlapping_prag          -- instance overlap mode
+  | IToverlaps_prag             -- instance overlap mode
+  | ITincoherent_prag           -- instance overlap mode
   | ITctype
 
   | ITdotdot                    -- reserved symbols
@@ -635,7 +650,7 @@ data Token
 -- facilitates using a keyword in two different extensions that can be
 -- activated independently)
 --
-reservedWordsFM :: UniqFM (Token, Int)
+reservedWordsFM :: UniqFM (Token, ExtsBitmap)
 reservedWordsFM = listToUFM $
     map (\(x, y, z) -> (mkFastString x, (y, z)))
         [( "_",              ITunderscore,    0 ),
@@ -664,34 +679,34 @@ reservedWordsFM = listToUFM $
          ( "type",           ITtype,          0 ),
          ( "where",          ITwhere,         0 ),
 
-         ( "forall",         ITforall,        bit explicitForallBit .|.
-                                              bit inRulePragBit),
-         ( "mdo",            ITmdo,           bit recursiveDoBit),
+         ( "forall",         ITforall,        xbit ExplicitForallBit .|.
+                                              xbit InRulePragBit),
+         ( "mdo",            ITmdo,           xbit RecursiveDoBit),
              -- See Note [Lexing type pseudo-keywords]
          ( "family",         ITfamily,        0 ),
          ( "role",           ITrole,          0 ),
-         ( "pattern",        ITpattern,       bit patternSynonymsBit),
-         ( "group",          ITgroup,         bit transformComprehensionsBit),
-         ( "by",             ITby,            bit transformComprehensionsBit),
-         ( "using",          ITusing,         bit transformComprehensionsBit),
-
-         ( "foreign",        ITforeign,       bit ffiBit),
-         ( "export",         ITexport,        bit ffiBit),
-         ( "label",          ITlabel,         bit ffiBit),
-         ( "dynamic",        ITdynamic,       bit ffiBit),
-         ( "safe",           ITsafe,          bit ffiBit .|.
-                                              bit safeHaskellBit),
-         ( "interruptible",  ITinterruptible, bit interruptibleFfiBit),
-         ( "unsafe",         ITunsafe,        bit ffiBit),
-         ( "stdcall",        ITstdcallconv,   bit ffiBit),
-         ( "ccall",          ITccallconv,     bit ffiBit),
-         ( "capi",           ITcapiconv,      bit cApiFfiBit),
-         ( "prim",           ITprimcallconv,  bit ffiBit),
-         ( "javascript",     ITjavascriptcallconv, bit ffiBit),
-
-         ( "rec",            ITrec,           bit arrowsBit .|.
-                                              bit recursiveDoBit),
-         ( "proc",           ITproc,          bit arrowsBit)
+         ( "pattern",        ITpattern,       xbit PatternSynonymsBit),
+         ( "group",          ITgroup,         xbit TransformComprehensionsBit),
+         ( "by",             ITby,            xbit TransformComprehensionsBit),
+         ( "using",          ITusing,         xbit TransformComprehensionsBit),
+
+         ( "foreign",        ITforeign,       xbit FfiBit),
+         ( "export",         ITexport,        xbit FfiBit),
+         ( "label",          ITlabel,         xbit FfiBit),
+         ( "dynamic",        ITdynamic,       xbit FfiBit),
+         ( "safe",           ITsafe,          xbit FfiBit .|.
+                                              xbit SafeHaskellBit),
+         ( "interruptible",  ITinterruptible, xbit InterruptibleFfiBit),
+         ( "unsafe",         ITunsafe,        xbit FfiBit),
+         ( "stdcall",        ITstdcallconv,   xbit FfiBit),
+         ( "ccall",          ITccallconv,     xbit FfiBit),
+         ( "capi",           ITcapiconv,      xbit CApiFfiBit),
+         ( "prim",           ITprimcallconv,  xbit FfiBit),
+         ( "javascript",     ITjavascriptcallconv, xbit FfiBit),
+
+         ( "rec",            ITrec,           xbit ArrowsBit .|.
+                                              xbit RecursiveDoBit),
+         ( "proc",           ITproc,          xbit ArrowsBit)
      ]
 
 {-----------------------------------
@@ -711,7 +726,7 @@ Also, note that these are included in the `varid` production in the parser --
 a key detail to make all this work.
 -------------------------------------}
 
-reservedSymsFM :: UniqFM (Token, Int -> Bool)
+reservedSymsFM :: UniqFM (Token, ExtsBitmap -> Bool)
 reservedSymsFM = listToUFM $
     map (\ (x,y,z) -> (mkFastString x,(y,z)))
       [ ("..",  ITdotdot,   always)
@@ -822,11 +837,11 @@ nextCharIs buf p = not (atEnd buf) && p (currentChar buf)
 nextCharIsNot :: StringBuffer -> (Char -> Bool) -> Bool
 nextCharIsNot buf p = not (nextCharIs buf p)
 
-notFollowedBy :: Char -> AlexAccPred Int
+notFollowedBy :: Char -> AlexAccPred ExtsBitmap
 notFollowedBy char _ _ _ (AI _ buf)
   = nextCharIsNot buf (== char)
 
-notFollowedBySymbol :: AlexAccPred Int
+notFollowedBySymbol :: AlexAccPred ExtsBitmap
 notFollowedBySymbol _ _ _ (AI _ buf)
   = nextCharIsNot buf (`elem` "!#$%&*+./<=>?@\\^|-~")
 
@@ -835,7 +850,7 @@ notFollowedBySymbol _ _ _ (AI _ buf)
 -- maximal munch, but not always, because the nested comment rule is
 -- valid in all states, but the doc-comment rules are only valid in
 -- the non-layout states.
-isNormalComment :: AlexAccPred Int
+isNormalComment :: AlexAccPred ExtsBitmap
 isNormalComment bits _ _ (AI _ buf)
   | haddockEnabled bits = notFollowedByDocOrPragma
   | otherwise           = nextCharIsNot buf (== '#')
@@ -849,10 +864,10 @@ afterOptionalSpace buf p
       then p (snd (nextChar buf))
       else p buf
 
-atEOL :: AlexAccPred Int
+atEOL :: AlexAccPred ExtsBitmap
 atEOL _ _ _ (AI _ buf) = atEnd buf || currentChar buf == '\n'
 
-ifExtension :: (Int -> Bool) -> AlexAccPred Int
+ifExtension :: (ExtsBitmap -> Bool) -> AlexAccPred ExtsBitmap
 ifExtension pred bits _ _ _ = pred bits
 
 multiline_doc_comment :: Action
@@ -954,12 +969,12 @@ withLexedDocType lexDocComment = do
 -- off again at the end of the pragma.
 rulePrag :: Action
 rulePrag span _buf _len = do
-  setExts (.|. bit inRulePragBit)
+  setExts (.|. xbit InRulePragBit)
   return (L span ITrules_prag)
 
 endPrag :: Action
 endPrag span _buf _len = do
-  setExts (.&. complement (bit inRulePragBit))
+  setExts (.&. complement (xbit InRulePragBit))
   return (L span ITclose_prag)
 
 -- docCommentEnd
@@ -1112,6 +1127,7 @@ positive = id
 negative = negate
 decimal, octal, hexadecimal :: (Integer, Char -> Int)
 decimal = (10,octDecDigit)
+binary = (2,octDecDigit)
 octal = (8,octDecDigit)
 hexadecimal = (16,hexDigit)
 
@@ -1410,6 +1426,7 @@ lex_escape = do
 
         'x'   -> readNum is_hexdigit 16 hexDigit
         'o'   -> readNum is_octdigit  8 octDecDigit
+        'b'   -> readNum is_bindigit  2 octDecDigit
         x | is_decdigit x -> readNum2 is_decdigit 10 octDecDigit (octDecDigit x)
 
         c1 ->  do
@@ -1592,7 +1609,7 @@ data PState = PState {
         last_loc   :: RealSrcSpan, -- pos of previous token
         last_len   :: !Int,        -- len of previous token
         loc        :: RealSrcLoc,  -- current loc (end of prev token + 1)
-        extsBitmap :: !Int,        -- bitmap that determines permitted
+        extsBitmap :: !ExtsBitmap,    -- bitmap that determines permitted
                                    -- extensions
         context    :: [LayoutContext],
         lex_state  :: [Int],
@@ -1664,18 +1681,18 @@ getPState = P $ \s -> POk s s
 instance HasDynFlags P where
     getDynFlags = P $ \s -> POk s (dflags s)
 
-withThisPackage :: (PackageId -> a) -> P a
+withThisPackage :: (PackageKey -> a) -> P a
 withThisPackage f
  = do pkg <- liftM thisPackage getDynFlags
       return $ f pkg
 
-extension :: (Int -> Bool) -> P Bool
+extension :: (ExtsBitmap -> Bool) -> P Bool
 extension p = P $ \s -> POk s (p $! extsBitmap s)
 
-getExts :: P Int
+getExts :: P ExtsBitmap
 getExts = P $ \s -> POk s (extsBitmap s)
 
-setExts :: (Int -> Int) -> P ()
+setExts :: (ExtsBitmap -> ExtsBitmap) -> P ()
 setExts f = P $ \s -> POk s{ extsBitmap = f (extsBitmap s) } ()
 
 setSrcLoc :: RealSrcLoc -> P ()
@@ -1855,130 +1872,110 @@ setAlrExpectingOCurly b = P $ \s -> POk (s {alr_expecting_ocurly = b}) ()
 
 -- for reasons of efficiency, flags indicating language extensions (eg,
 -- -fglasgow-exts or -XParallelArrays) are represented by a bitmap
--- stored in an unboxed Int
-
-ffiBit :: Int
-ffiBit= 0
-interruptibleFfiBit :: Int
-interruptibleFfiBit = 1
-cApiFfiBit :: Int
-cApiFfiBit = 2
-parrBit :: Int
-parrBit = 3
-arrowsBit :: Int
-arrowsBit  = 4
-thBit :: Int
-thBit = 5
-ipBit :: Int
-ipBit = 6
-explicitForallBit :: Int
-explicitForallBit = 7 -- the 'forall' keyword and '.' symbol
-bangPatBit :: Int
-bangPatBit = 8  -- Tells the parser to understand bang-patterns
-                -- (doesn't affect the lexer)
-patternSynonymsBit :: Int
-patternSynonymsBit = 9 -- pattern synonyms
-haddockBit :: Int
-haddockBit = 10 -- Lex and parse Haddock comments
-magicHashBit :: Int
-magicHashBit = 11 -- "#" in both functions and operators
-kindSigsBit :: Int
-kindSigsBit = 12 -- Kind signatures on type variables
-recursiveDoBit :: Int
-recursiveDoBit = 13 -- mdo
-unicodeSyntaxBit :: Int
-unicodeSyntaxBit = 14 -- the forall symbol, arrow symbols, etc
-unboxedTuplesBit :: Int
-unboxedTuplesBit = 15 -- (# and #)
-datatypeContextsBit :: Int
-datatypeContextsBit = 16
-transformComprehensionsBit :: Int
-transformComprehensionsBit = 17
-qqBit :: Int
-qqBit = 18 -- enable quasiquoting
-inRulePragBit :: Int
-inRulePragBit = 19
-rawTokenStreamBit :: Int
-rawTokenStreamBit = 20 -- producing a token stream with all comments included
-sccProfilingOnBit :: Int
-sccProfilingOnBit = 21
-hpcBit :: Int
-hpcBit = 22
-alternativeLayoutRuleBit :: Int
-alternativeLayoutRuleBit = 23
-relaxedLayoutBit :: Int
-relaxedLayoutBit = 24
-nondecreasingIndentationBit :: Int
-nondecreasingIndentationBit = 25
-safeHaskellBit :: Int
-safeHaskellBit = 26
-traditionalRecordSyntaxBit :: Int
-traditionalRecordSyntaxBit = 27
-typeLiteralsBit :: Int
-typeLiteralsBit = 28
-explicitNamespacesBit :: Int
-explicitNamespacesBit = 29
-lambdaCaseBit :: Int
-lambdaCaseBit = 30
-negativeLiteralsBit :: Int
-negativeLiteralsBit = 31
-
-
-always :: Int -> Bool
+-- stored in an unboxed Word64
+type ExtsBitmap = Word64
+
+xbit :: ExtBits -> ExtsBitmap
+xbit = bit . fromEnum
+
+xtest :: ExtBits -> ExtsBitmap -> Bool
+xtest ext xmap = testBit xmap (fromEnum ext)
+
+data ExtBits
+  = FfiBit
+  | InterruptibleFfiBit
+  | CApiFfiBit
+  | ParrBit
+  | ArrowsBit
+  | ThBit
+  | IpBit
+  | ExplicitForallBit -- the 'forall' keyword and '.' symbol
+  | BangPatBit -- Tells the parser to understand bang-patterns
+               -- (doesn't affect the lexer)
+  | PatternSynonymsBit -- pattern synonyms
+  | HaddockBit-- Lex and parse Haddock comments
+  | MagicHashBit -- "#" in both functions and operators
+  | KindSigsBit -- Kind signatures on type variables
+  | RecursiveDoBit -- mdo
+  | UnicodeSyntaxBit -- the forall symbol, arrow symbols, etc
+  | UnboxedTuplesBit -- (# and #)
+  | DatatypeContextsBit
+  | TransformComprehensionsBit
+  | QqBit -- enable quasiquoting
+  | InRulePragBit
+  | RawTokenStreamBit -- producing a token stream with all comments included
+  | SccProfilingOnBit
+  | HpcBit
+  | AlternativeLayoutRuleBit
+  | RelaxedLayoutBit
+  | NondecreasingIndentationBit
+  | SafeHaskellBit
+  | TraditionalRecordSyntaxBit
+  | TypeLiteralsBit
+  | ExplicitNamespacesBit
+  | LambdaCaseBit
+  | BinaryLiteralsBit
+  | NegativeLiteralsBit
+  deriving Enum
+
+
+always :: ExtsBitmap -> Bool
 always           _     = True
-parrEnabled :: Int -> Bool
-parrEnabled      flags = testBit flags parrBit
-arrowsEnabled :: Int -> Bool
-arrowsEnabled    flags = testBit flags arrowsBit
-thEnabled :: Int -> Bool
-thEnabled        flags = testBit flags thBit
-ipEnabled :: Int -> Bool
-ipEnabled        flags = testBit flags ipBit
-explicitForallEnabled :: Int -> Bool
-explicitForallEnabled flags = testBit flags explicitForallBit
-bangPatEnabled :: Int -> Bool
-bangPatEnabled   flags = testBit flags bangPatBit
-haddockEnabled :: Int -> Bool
-haddockEnabled   flags = testBit flags haddockBit
-magicHashEnabled :: Int -> Bool
-magicHashEnabled flags = testBit flags magicHashBit
--- kindSigsEnabled :: Int -> Bool
--- kindSigsEnabled  flags = testBit flags kindSigsBit
-unicodeSyntaxEnabled :: Int -> Bool
-unicodeSyntaxEnabled flags = testBit flags unicodeSyntaxBit
-unboxedTuplesEnabled :: Int -> Bool
-unboxedTuplesEnabled flags = testBit flags unboxedTuplesBit
-datatypeContextsEnabled :: Int -> Bool
-datatypeContextsEnabled flags = testBit flags datatypeContextsBit
-qqEnabled :: Int -> Bool
-qqEnabled        flags = testBit flags qqBit
-inRulePrag :: Int -> Bool
-inRulePrag       flags = testBit flags inRulePragBit
-rawTokenStreamEnabled :: Int -> Bool
-rawTokenStreamEnabled flags = testBit flags rawTokenStreamBit
-alternativeLayoutRule :: Int -> Bool
-alternativeLayoutRule flags = testBit flags alternativeLayoutRuleBit
-hpcEnabled :: Int -> Bool
-hpcEnabled flags = testBit flags hpcBit
-relaxedLayout :: Int -> Bool
-relaxedLayout flags = testBit flags relaxedLayoutBit
-nondecreasingIndentation :: Int -> Bool
-nondecreasingIndentation flags = testBit flags nondecreasingIndentationBit
-sccProfilingOn :: Int -> Bool
-sccProfilingOn flags = testBit flags sccProfilingOnBit
-traditionalRecordSyntaxEnabled :: Int -> Bool
-traditionalRecordSyntaxEnabled flags = testBit flags traditionalRecordSyntaxBit
-typeLiteralsEnabled :: Int -> Bool
-typeLiteralsEnabled flags = testBit flags typeLiteralsBit
-
-explicitNamespacesEnabled :: Int -> Bool
-explicitNamespacesEnabled flags = testBit flags explicitNamespacesBit
-lambdaCaseEnabled :: Int -> Bool
-lambdaCaseEnabled flags = testBit flags lambdaCaseBit
-negativeLiteralsEnabled :: Int -> Bool
-negativeLiteralsEnabled flags = testBit flags negativeLiteralsBit
-patternSynonymsEnabled :: Int -> Bool
-patternSynonymsEnabled flags = testBit flags patternSynonymsBit
+parrEnabled :: ExtsBitmap -> Bool
+parrEnabled = xtest ParrBit
+arrowsEnabled :: ExtsBitmap -> Bool
+arrowsEnabled = xtest ArrowsBit
+thEnabled :: ExtsBitmap -> Bool
+thEnabled = xtest ThBit
+ipEnabled :: ExtsBitmap -> Bool
+ipEnabled = xtest IpBit
+explicitForallEnabled :: ExtsBitmap -> Bool
+explicitForallEnabled = xtest ExplicitForallBit
+bangPatEnabled :: ExtsBitmap -> Bool
+bangPatEnabled = xtest BangPatBit
+haddockEnabled :: ExtsBitmap -> Bool
+haddockEnabled = xtest HaddockBit
+magicHashEnabled :: ExtsBitmap -> Bool
+magicHashEnabled = xtest MagicHashBit
+-- kindSigsEnabled :: ExtsBitmap -> Bool
+-- kindSigsEnabled = xtest KindSigsBit
+unicodeSyntaxEnabled :: ExtsBitmap -> Bool
+unicodeSyntaxEnabled = xtest UnicodeSyntaxBit
+unboxedTuplesEnabled :: ExtsBitmap -> Bool
+unboxedTuplesEnabled = xtest UnboxedTuplesBit
+datatypeContextsEnabled :: ExtsBitmap -> Bool
+datatypeContextsEnabled = xtest DatatypeContextsBit
+qqEnabled :: ExtsBitmap -> Bool
+qqEnabled = xtest QqBit
+inRulePrag :: ExtsBitmap -> Bool
+inRulePrag = xtest InRulePragBit
+rawTokenStreamEnabled :: ExtsBitmap -> Bool
+rawTokenStreamEnabled = xtest RawTokenStreamBit
+alternativeLayoutRule :: ExtsBitmap -> Bool
+alternativeLayoutRule = xtest AlternativeLayoutRuleBit
+hpcEnabled :: ExtsBitmap -> Bool
+hpcEnabled = xtest HpcBit
+relaxedLayout :: ExtsBitmap -> Bool
+relaxedLayout = xtest RelaxedLayoutBit
+nondecreasingIndentation :: ExtsBitmap -> Bool
+nondecreasingIndentation = xtest NondecreasingIndentationBit
+sccProfilingOn :: ExtsBitmap -> Bool
+sccProfilingOn = xtest SccProfilingOnBit
+traditionalRecordSyntaxEnabled :: ExtsBitmap -> Bool
+traditionalRecordSyntaxEnabled = xtest TraditionalRecordSyntaxBit
+typeLiteralsEnabled :: ExtsBitmap -> Bool
+typeLiteralsEnabled = xtest TypeLiteralsBit
+
+explicitNamespacesEnabled :: ExtsBitmap -> Bool
+explicitNamespacesEnabled = xtest ExplicitNamespacesBit
+lambdaCaseEnabled :: ExtsBitmap -> Bool
+lambdaCaseEnabled = xtest LambdaCaseBit
+binaryLiteralsEnabled :: ExtsBitmap -> Bool
+binaryLiteralsEnabled = xtest BinaryLiteralsBit
+negativeLiteralsEnabled :: ExtsBitmap -> Bool
+negativeLiteralsEnabled = xtest NegativeLiteralsBit
+patternSynonymsEnabled :: ExtsBitmap -> Bool
+patternSynonymsEnabled = xtest PatternSynonymsBit
 
 -- PState for parsing options pragmas
 --
@@ -1999,7 +1996,7 @@ mkPState flags buf loc =
       last_loc      = mkRealSrcSpan loc loc,
       last_len      = 0,
       loc           = loc,
-      extsBitmap    = fromIntegral bitmap,
+      extsBitmap    = bitmap,
       context       = [],
       lex_state     = [bol, 0],
       srcfiles      = [],
@@ -2011,41 +2008,42 @@ mkPState flags buf loc =
       alr_justClosedExplicitLetBlock = False
     }
     where
-      bitmap =     ffiBit                      `setBitIf` xopt Opt_ForeignFunctionInterface flags
-               .|. interruptibleFfiBit         `setBitIf` xopt Opt_InterruptibleFFI         flags
-               .|. cApiFfiBit                  `setBitIf` xopt Opt_CApiFFI                  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
-               .|. haddockBit                  `setBitIf` gopt Opt_Haddock                  flags
-               .|. magicHashBit                `setBitIf` xopt Opt_MagicHash                flags
-               .|. kindSigsBit                 `setBitIf` xopt Opt_KindSignatures           flags
-               .|. recursiveDoBit              `setBitIf` xopt Opt_RecursiveDo              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
-               .|. transformComprehensionsBit  `setBitIf` xopt Opt_MonadComprehensions      flags
-               .|. rawTokenStreamBit           `setBitIf` gopt Opt_KeepRawTokenStream       flags
-               .|. hpcBit                      `setBitIf` gopt Opt_Hpc                      flags
-               .|. alternativeLayoutRuleBit    `setBitIf` xopt Opt_AlternativeLayoutRule    flags
-               .|. relaxedLayoutBit            `setBitIf` xopt Opt_RelaxedLayout            flags
-               .|. sccProfilingOnBit           `setBitIf` gopt Opt_SccProfilingOn           flags
-               .|. nondecreasingIndentationBit `setBitIf` xopt Opt_NondecreasingIndentation flags
-               .|. safeHaskellBit              `setBitIf` safeImportsOn                     flags
-               .|. traditionalRecordSyntaxBit  `setBitIf` xopt Opt_TraditionalRecordSyntax  flags
-               .|. typeLiteralsBit             `setBitIf` xopt Opt_DataKinds flags
-               .|. explicitNamespacesBit       `setBitIf` xopt Opt_ExplicitNamespaces flags
-               .|. lambdaCaseBit               `setBitIf` xopt Opt_LambdaCase               flags
-               .|. negativeLiteralsBit         `setBitIf` xopt Opt_NegativeLiterals         flags
-               .|. patternSynonymsBit          `setBitIf` xopt Opt_PatternSynonyms          flags
+      bitmap =     FfiBit                      `setBitIf` xopt Opt_ForeignFunctionInterface flags
+               .|. InterruptibleFfiBit         `setBitIf` xopt Opt_InterruptibleFFI         flags
+               .|. CApiFfiBit                  `setBitIf` xopt Opt_CApiFFI                  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
+               .|. HaddockBit                  `setBitIf` gopt Opt_Haddock                  flags
+               .|. MagicHashBit                `setBitIf` xopt Opt_MagicHash                flags
+               .|. KindSigsBit                 `setBitIf` xopt Opt_KindSignatures           flags
+               .|. RecursiveDoBit              `setBitIf` xopt Opt_RecursiveDo              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
+               .|. TransformComprehensionsBit  `setBitIf` xopt Opt_MonadComprehensions      flags
+               .|. RawTokenStreamBit           `setBitIf` gopt Opt_KeepRawTokenStream       flags
+               .|. HpcBit                      `setBitIf` gopt Opt_Hpc                      flags
+               .|. AlternativeLayoutRuleBit    `setBitIf` xopt Opt_AlternativeLayoutRule    flags
+               .|. RelaxedLayoutBit            `setBitIf` xopt Opt_RelaxedLayout            flags
+               .|. SccProfilingOnBit           `setBitIf` gopt Opt_SccProfilingOn           flags
+               .|. NondecreasingIndentationBit `setBitIf` xopt Opt_NondecreasingIndentation flags
+               .|. SafeHaskellBit              `setBitIf` safeImportsOn                     flags
+               .|. TraditionalRecordSyntaxBit  `setBitIf` xopt Opt_TraditionalRecordSyntax  flags
+               .|. TypeLiteralsBit             `setBitIf` xopt Opt_DataKinds flags
+               .|. ExplicitNamespacesBit       `setBitIf` xopt Opt_ExplicitNamespaces flags
+               .|. LambdaCaseBit               `setBitIf` xopt Opt_LambdaCase               flags
+               .|. BinaryLiteralsBit           `setBitIf` xopt Opt_BinaryLiterals           flags
+               .|. NegativeLiteralsBit         `setBitIf` xopt Opt_NegativeLiterals         flags
+               .|. PatternSynonymsBit          `setBitIf` xopt Opt_PatternSynonyms          flags
       --
-      setBitIf :: Int -> Bool -> Int
-      b `setBitIf` cond | cond      = bit b
+      setBitIf :: ExtBits -> Bool -> ExtsBitmap
+      b `setBitIf` cond | cond      = xbit b
                         | otherwise = 0
 
 addWarning :: WarningFlag -> SrcSpan -> SDoc -> P ()
@@ -2434,6 +2432,10 @@ oneWordPrags = Map.fromList([("rules", rulePrag),
                            ("vectorize", token ITvect_prag),
                            ("novectorize", token ITnovect_prag),
                            ("minimal", token ITminimal_prag),
+                           ("overlaps", token IToverlaps_prag),
+                           ("overlappable", token IToverlappable_prag),
+                           ("overlapping", token IToverlapping_prag),
+                           ("incoherent", token ITincoherent_prag),
                            ("ctype", token ITctype)])
 
 twoWordPrags = Map.fromList([("inline conlike", token (ITinline_prag Inline ConLike)),
@@ -2447,7 +2449,7 @@ dispatch_pragmas prags span buf len = case Map.lookup (clean_pragma (lexemeToStr
                                        Just found -> found span buf len
                                        Nothing -> lexError "unknown pragma"
 
-known_pragma :: Map String Action -> AlexAccPred Int
+known_pragma :: Map String Action -> AlexAccPred ExtsBitmap
 known_pragma prags _ (AI _ startbuf) _ (AI _ curbuf)
  = isKnown && nextCharIsNot curbuf pragmaNameChar
     where l = lexemeToString startbuf (byteDiff startbuf curbuf)
diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp
index 1715f6cc2f6d..72dfc88fa610 100644
--- a/compiler/parser/Parser.y.pp
+++ b/compiler/parser/Parser.y.pp
@@ -16,8 +16,25 @@
 --     http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
 -- for details
 
-module Parser ( parseModule, parseStmt, parseIdentifier, parseType,
-                parseHeader ) where
+-- | This module provides the generated Happy parser for Haskell. It exports
+-- a number of parsers which may be used in any library that uses the GHC API.
+-- A common usage pattern is to initialize the parser state with a given string
+-- and then parse that string:
+--
+-- @
+--     runParser :: DynFlags -> String -> P a -> ParseResult a
+--     runParser flags str parser = unP parser parseState
+--     where
+--       filename = "\<interactive\>"
+--       location = mkRealSrcLoc (mkFastString filename) 1 1
+--       buffer = stringToStringBuffer str
+--       parseState = mkPState flags buffer location in
+-- @
+module Parser (parseModule, parseImport, parseStatement,
+               parseDeclaration, parseExpression, parseTypeSignature,
+               parseFullStmt, parseStmt, parseIdentifier,
+               parseType, parseHeader) where
+
 
 import HsSyn
 import RdrHsSyn
@@ -269,6 +286,10 @@
  '{-# NOVECTORISE'        { L _ ITnovect_prag }
  '{-# MINIMAL'            { L _ ITminimal_prag }
  '{-# CTYPE'              { L _ ITctype }
+ '{-# OVERLAPPING'        { L _ IToverlapping_prag }
+ '{-# OVERLAPPABLE'       { L _ IToverlappable_prag }
+ '{-# OVERLAPS'           { L _ IToverlaps_prag }
+ '{-# INCOHERENT'         { L _ ITincoherent_prag }
  '#-}'                                          { L _ ITclose_prag }
 
  '..'           { L _ ITdotdot }                        -- reserved symbols
@@ -360,12 +381,20 @@
 
 %monad { P } { >>= } { return }
 %lexer { lexer } { L _ ITeof }
+%tokentype { (Located Token) }
+
+-- Exported parsers
 %name parseModule module
+%name parseImport importdecl
+%name parseStatement stmt
+%name parseDeclaration topdecl
+%name parseExpression exp
+%name parseTypeSignature sigdecl
+%name parseFullStmt   stmt
 %name parseStmt   maybe_stmt
 %name parseIdentifier  identifier
 %name parseType ctype
 %partial parseHeader header
-%tokentype { (Located Token) }
 %%
 
 -----------------------------------------------------------------------------
@@ -654,12 +683,13 @@
                 {% mkFamDecl (comb3 $1 $2 $4) DataFamily $3 (unLoc $4) }
 
 inst_decl :: { LInstDecl RdrName }
-        : 'instance' inst_type where_inst
-                 { let (binds, sigs, _, ats, adts, _) = cvBindsAndSigs (unLoc $3) in
-                   let cid = ClsInstDecl { cid_poly_ty = $2, cid_binds = binds
+        : 'instance' overlap_pragma inst_type where_inst
+                 { let (binds, sigs, _, ats, adts, _) = cvBindsAndSigs (unLoc $4) in
+                   let cid = ClsInstDecl { cid_poly_ty = $3, cid_binds = binds
                                          , cid_sigs = sigs, cid_tyfam_insts = ats
+                                         , cid_overlap_mode = $2
                                          , cid_datafam_insts = adts }
-                   in L (comb3 $1 $2 $3) (ClsInstD { cid_inst = cid }) }
+                   in L (comb3 $1 $3 $4) (ClsInstD { cid_inst = cid }) }
 
            -- type instance declarations
         | 'type' 'instance' ty_fam_inst_eqn
@@ -677,6 +707,14 @@
                 {% mkDataFamInst (comb4 $1 $4 $6 $7) (unLoc $1) $3 $4
                                      (unLoc $5) (unLoc $6) (unLoc $7) }
 
+overlap_pragma :: { Maybe OverlapMode }
+  : '{-# OVERLAPPABLE'    '#-}' { Just Overlappable }
+  | '{-# OVERLAPPING'     '#-}' { Just Overlapping }
+  | '{-# OVERLAPS'        '#-}' { Just Overlaps }
+  | '{-# INCOHERENT'      '#-}' { Just Incoherent }
+  | {- empty -}                 { Nothing }
+
+
 -- Closed type families
 
 where_type_family :: { Located (FamilyInfo RdrName) }
@@ -783,7 +821,7 @@
 
 -- Glasgow extension: stand-alone deriving declarations
 stand_alone_deriving :: { LDerivDecl RdrName }
-        : 'deriving' 'instance' inst_type { LL (DerivDecl $3) }
+  : 'deriving' 'instance' overlap_pragma inst_type { LL (DerivDecl $4 $3) }
 
 -----------------------------------------------------------------------------
 -- Role annotations
@@ -810,17 +848,29 @@
 
 -- Glasgow extension: pattern synonyms
 pattern_synonym_decl :: { LHsDecl RdrName }
-        : 'pattern' con vars0 patsyn_token pat { LL . ValD $ mkPatSynBind $2 (PrefixPatSyn $3) $5 $4 }
-        | 'pattern' varid conop varid patsyn_token pat { LL . ValD $ mkPatSynBind $3 (InfixPatSyn $2 $4) $6 $5 }
+        : 'pattern' pat '=' pat
+            {% do { (name, args) <- splitPatSyn $2
+                  ; return $ LL . ValD $ mkPatSynBind name args $4 ImplicitBidirectional
+                  }}
+        | 'pattern' pat '<-' pat
+            {% do { (name, args) <- splitPatSyn $2
+                  ; return $ LL . ValD $ mkPatSynBind name args $4 Unidirectional
+                  }}
+        | 'pattern' pat '<-' pat where_decls
+            {% do { (name, args) <- splitPatSyn $2
+                  ; mg <- toPatSynMatchGroup name $5
+                  ; return $ LL . ValD $
+                    mkPatSynBind name args $4 (ExplicitBidirectional mg)
+                  }}
+
+where_decls :: { Located (OrdList (LHsDecl RdrName)) }
+        : 'where' '{' decls '}'       { $3 }
+        | 'where' vocurly decls close { $3 }
 
 vars0 :: { [Located RdrName] }
         : {- empty -}                 { [] }
         | varid vars0                 { $1 : $2 }
 
-patsyn_token :: { HsPatSynDir RdrName }
-        : '<-' { Unidirectional }
-        | '='  { ImplicitBidirectional }
-
 -----------------------------------------------------------------------------
 -- Nested declarations
 
@@ -1041,7 +1091,7 @@
         : ctypedoc                      { L1 (mkImplicitHsForAllTy (noLoc []) $1) }
         -- Wrap an Implicit forall if there isn't one there already
 
-sig_vars :: { Located [Located RdrName] }
+sig_vars :: { Located [Located RdrName] }  -- Returned in reversed order
          : sig_vars ',' var             { LL ($3 : unLoc $1) }
          | var                          { L1 [$1] }
 
@@ -1151,10 +1201,11 @@
         | TH_ID_SPLICE                   { LL $ mkHsSpliceTy $ L1 $ HsVar $
                                            mkUnqual varName (getTH_ID_SPLICE $1) }
                                                       -- see Note [Promotion] for the followings
-        | SIMPLEQUOTE qconid                          { LL $ HsTyVar $ unLoc $2 }
-        | SIMPLEQUOTE  '(' ')'                        { LL $ HsTyVar $ getRdrName unitDataCon }
+        | SIMPLEQUOTE qcon                            { LL $ HsTyVar $ unLoc $2 }
         | SIMPLEQUOTE  '(' ctype ',' comma_types1 ')' { LL $ HsExplicitTupleTy [] ($3 : $5) }
         | SIMPLEQUOTE  '[' comma_types0 ']'           { LL $ HsExplicitListTy placeHolderKind $3 }
+        | SIMPLEQUOTE var                             { LL $ HsTyVar $ unLoc $2 }
+
         | '[' ctype ',' comma_types1 ']'              { LL $ HsExplicitListTy placeHolderKind ($2 : $4) }
         | INTEGER            {% mkTyLit $ LL $ HsNumTy $ getINTEGER $1 }
         | STRING             {% mkTyLit $ LL $ HsStrTy $ getSTRING  $1 }
@@ -1422,7 +1473,7 @@
                         {% do s <- checkValSig $1 $3
                         ; return (LL $ unitOL (LL $ SigD s)) }
         | var ',' sig_vars '::' sigtypedoc
-                                { LL $ toOL [ LL $ SigD (TypeSig ($1 : unLoc $3) $5) ] }
+                                { LL $ toOL [ LL $ SigD (TypeSig ($1 : reverse (unLoc $3)) $5) ] }
         | infix prec ops        { LL $ toOL [ LL $ SigD (FixSig (FixitySig n (Fixity $2 (unLoc $1))))
                                              | n <- unLoc $3 ] }
         | '{-# INLINE' activation qvar '#-}'
@@ -1475,18 +1526,18 @@
 
 exp10 :: { LHsExpr RdrName }
         : '\\' apat apats opt_asig '->' exp
-                        { LL $ HsLam (mkMatchGroup [LL $ Match ($2:$3) $4
+                        { LL $ HsLam (mkMatchGroup FromSource [LL $ Match ($2:$3) $4
                                                                 (unguardedGRHSs $6)
-                                                            ]) }
+                                                              ]) }
         | 'let' binds 'in' exp                  { LL $ HsLet (unLoc $2) $4 }
         | '\\' 'lcase' altslist
-            { LL $ HsLamCase placeHolderType (mkMatchGroup (unLoc $3)) }
+            { LL $ HsLamCase placeHolderType (mkMatchGroup FromSource (unLoc $3)) }
         | 'if' exp optSemi 'then' exp optSemi 'else' exp
                                         {% checkDoAndIfThenElse $2 $3 $5 $6 $8 >>
                                            return (LL $ mkHsIf $2 $5 $8) }
         | 'if' ifgdpats                 {% hintMultiWayIf (getLoc $1) >>
                                            return (LL $ HsMultiIf placeHolderType (reverse $ unLoc $2)) }
-        | 'case' exp 'of' altslist              { LL $ HsCase $2 (mkMatchGroup (unLoc $4)) }
+        | 'case' exp 'of' altslist              { LL $ HsCase $2 (mkMatchGroup FromSource (unLoc $4)) }
         | '-' fexp                              { LL $ NegApp $2 noSyntaxExpr }
 
         | 'do' stmtlist                 { L (comb2 $1 $2) (mkHsDo DoExpr  (unLoc $2)) }
diff --git a/compiler/parser/ParserCore.y b/compiler/parser/ParserCore.y
deleted file mode 100644
index 4e7f48c6fce6..000000000000
--- a/compiler/parser/ParserCore.y
+++ /dev/null
@@ -1,397 +0,0 @@
-{
-{-# LANGUAGE BangPatterns #-} -- required for versions of Happy before 1.18.6
-{-# OPTIONS -Wwarn -w #-}
--- 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://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
--- for details
-
-module ParserCore ( parseCore ) where
-
-import IfaceSyn
-import ForeignCall
-import RdrHsSyn
-import HsSyn hiding (toHsType, toHsKind)
-import RdrName
-import OccName
-import TypeRep ( TyThing(..) )
-import Type ( Kind,
-              liftedTypeKindTyCon, openTypeKindTyCon, unliftedTypeKindTyCon,
-              mkTyConApp
-            )
-import Kind( mkArrowKind )
-import Name( Name, nameOccName, nameModule, mkExternalName, wiredInNameTyThing_maybe )
-import Module
-import ParserCoreUtils
-import LexCore
-import Literal
-import SrcLoc
-import PrelNames
-import TysPrim
-import TyCon ( TyCon, tyConName )
-import FastString
-import Outputable
-import Data.Char
-import Unique
-
-#include "../HsVersions.h"
-
-}
-
-%name parseCore
-%expect 0
-%tokentype { Token }
-
-%token
- '%module'	{ TKmodule }
- '%data'	{ TKdata }
- '%newtype'	{ TKnewtype }
- '%forall'	{ TKforall }
- '%rec'		{ TKrec }
- '%let'		{ TKlet }
- '%in'		{ TKin }
- '%case'	{ TKcase }
- '%of'		{ TKof }
- '%cast'	{ TKcast }
- '%note'	{ TKnote }
- '%external'	{ TKexternal }
- '%local'	{ TKlocal }
- '%_'		{ TKwild }
- '('		{ TKoparen }
- ')'		{ TKcparen }
- '{'		{ TKobrace }
- '}'		{ TKcbrace }
- '#' 		{ TKhash}
- '='		{ TKeq }
- ':'		{ TKcolon }
- '::'		{ TKcoloncolon }
- ':=:'		{ TKcoloneqcolon }
- '*'		{ TKstar }
- '->'		{ TKrarrow }
- '\\'		{ TKlambda}
- '@'		{ TKat }
- '.'		{ TKdot }
- '?'		{ TKquestion}
- ';'            { TKsemicolon }
- NAME		{ TKname $$ }
- CNAME 		{ TKcname $$ }
- INTEGER	{ TKinteger $$ }
- RATIONAL	{ TKrational $$ }
- STRING		{ TKstring $$ }
- CHAR		{ TKchar $$ }
-
-%monad { P } { thenP } { returnP }
-%lexer { lexer } { TKEOF }
-
-%%
-
-module	:: { HsExtCore RdrName }
-	-- : '%module' modid tdefs vdefgs	{ HsExtCore $2 $3 $4 }
-	: '%module' modid tdefs vdefgs	{ HsExtCore $2 [] [] }
-
-
--------------------------------------------------------------
---     Names: the trickiest bit in here
-
--- A name of the form A.B.C could be:
---   module A.B.C
---   dcon C in module A.B
---   tcon C in module A.B
-modid	:: { Module }
-	: NAME ':' mparts		{ undefined }
-
-q_dc_name :: { Name }
-	  : NAME ':' mparts		{ undefined }
-
-q_tc_name :: { Name }
- 	  : NAME ':' mparts		{ undefined }
-
-q_var_occ :: { Name }
-          : NAME ':' vparts             { undefined }
-
-mparts	:: { [String] }
-	: CNAME				{ [$1] }
-	| CNAME '.' mparts		{ $1:$3 }
-
-vparts  :: { [String] }
-        : var_occ                       { [$1] }
-        | CNAME '.' vparts              { $1:$3 }
-
--------------------------------------------------------------
---     Type and newtype declarations are in HsSyn syntax
-
-tdefs	:: { [TyClDecl RdrName] }
-	: {- empty -}	{[]}
-	| tdef tdefs	{$1:$2}
-
-tdef	:: { TyClDecl RdrName }
-	: '%data' q_tc_name tv_bndrs '=' '{' cons '}' ';'
-	{ DataDecl { tcdLName = noLoc (ifaceExtRdrName $2)
-                   , tcdTyVars = mkHsQTvs (map toHsTvBndr $3)
-                   , tcdDataDefn = HsDataDefn { dd_ND = DataType, dd_ctxt = noLoc [] 
-     	                                      , dd_kindSig = Nothing
-                                              , dd_cons = $6, dd_derivs = Nothing } } }
-	| '%newtype' q_tc_name tv_bndrs trep ';'
-	{ let tc_rdr = ifaceExtRdrName $2 in
-          DataDecl { tcdLName = noLoc tc_rdr
-	           , tcdTyVars = mkHsQTvs (map toHsTvBndr $3)
-                   , tcdDataDefn = HsDataDefn { dd_ND = NewType, dd_ctxt = noLoc []
-		                              , dd_kindSig = Nothing
-                                              , dd_cons = $4 (rdrNameOcc tc_rdr), dd_derivs = Nothing } } }
-
--- For a newtype we have to invent a fake data constructor name
--- It doesn't matter what it is, because it won't be used
-trep    :: { OccName -> [LConDecl RdrName] }
-        : {- empty -}   { (\ tc_occ -> []) }
-        | '=' ty        { (\ tc_occ -> let { dc_name  = mkRdrUnqual (setOccNameSpace dataName tc_occ) ;
-			                     con_info = PrefixCon [toHsType $2] }
-			                in [noLoc $ mkSimpleConDecl (noLoc dc_name) []
-					               (noLoc []) con_info]) }
-
-cons	:: { [LConDecl RdrName] }
-	: {- empty -}	{ [] } -- 20060420 Empty data types allowed. jds
-        | con           { [$1] }
-	| con ';' cons	{ $1:$3 }
-
-con	:: { LConDecl RdrName }
-	: d_pat_occ attv_bndrs hs_atys 
-		{ noLoc $ mkSimpleConDecl (noLoc (mkRdrUnqual $1)) $2 (noLoc []) (PrefixCon $3) }
--- ToDo: parse record-style declarations
-
-attv_bndrs :: { [LHsTyVarBndr RdrName] }
-	: {- empty -} 	         { [] }
-	| '@' tv_bndr attv_bndrs {  toHsTvBndr $2 : $3 }
-
-hs_atys :: { [LHsType RdrName] }
-         : atys               { map toHsType $1 }
-
-
----------------------------------------
---                 Types
----------------------------------------
-
-atys	:: { [IfaceType] }
-	: {- empty -}   { [] }
-	| aty atys      { $1:$2 }
-
-aty	:: { IfaceType }
-	: fs_var_occ { IfaceTyVar $1 }
-	| q_tc_name  { IfaceTyConApp (IfaceTc $1) [] }
-	| '(' ty ')' { $2 }
-
-bty	:: { IfaceType }
-	: fs_var_occ atys { foldl IfaceAppTy (IfaceTyVar $1) $2 }
-        | q_var_occ atys  { undefined }
-        | q_tc_name atys  { IfaceTyConApp (IfaceTc $1) $2 }
-        | '(' ty ')' { $2 }
-
-ty	:: { IfaceType }
-	: bty	                     { $1 }
-	| bty '->' ty                { IfaceFunTy $1 $3 }
-	| '%forall' tv_bndrs '.' ty  { foldr IfaceForAllTy $4 $2 }
-
-----------------------------------------------
---        Bindings are in Iface syntax
-
-vdefgs	:: { [IfaceBinding] }
-	: {- empty -}	        { [] }
-	| let_bind ';' vdefgs	{ $1 : $3 }
-
-let_bind :: { IfaceBinding }
-	: '%rec' '{' vdefs1 '}' { IfaceRec $3 } -- Can be empty. Do we care?
-	|  vdef                 { let (b,r) = $1
-				  in IfaceNonRec b r }
-
-vdefs1	:: { [(IfaceLetBndr, IfaceExpr)] }
-	: vdef  	        { [$1] }
-	| vdef ';' vdefs1       { $1:$3 }
-
-vdef	:: { (IfaceLetBndr, IfaceExpr) }
-	: fs_var_occ '::' ty '=' exp { (IfLetBndr $1 $3 NoInfo, $5) }
-        | '%local' vdef              { $2 }
-
-  -- NB: qd_occ includes data constructors, because
-  --     we allow data-constructor wrappers at top level
-  -- But we discard the module name, because it must be the
-  -- same as the module being compiled, and Iface syntax only
-  -- has OccNames in binding positions. Ah, but it has Names now!
-
----------------------------------------
---  Binders
-bndr	:: { IfaceBndr }
-        : '@' tv_bndr 	{ IfaceTvBndr $2 }
-	| id_bndr	{ IfaceIdBndr $1 }
-
-bndrs 	:: { [IfaceBndr] }
-	: bndr		{ [$1] }
-	| bndr bndrs	{ $1:$2 }
-
-id_bndr	:: { IfaceIdBndr }
-	: '(' fs_var_occ '::' ty ')'	{ ($2,$4) }
-
-tv_bndr	:: { IfaceTvBndr }
-	:  fs_var_occ                    { ($1, ifaceLiftedTypeKind) }
-	|  '(' fs_var_occ '::' akind ')' { ($2, $4) }
-
-tv_bndrs 	:: { [IfaceTvBndr] }
-	: {- empty -}	{ [] }
-	| tv_bndr tv_bndrs	{ $1:$2 }
-
-akind	:: { IfaceKind }
-	: '*' 		   { ifaceLiftedTypeKind }	
-	| '#'		   { ifaceUnliftedTypeKind }
-	| '?'		   { ifaceOpenTypeKind }
-        | '(' kind ')'	   { $2 }
-
-kind 	:: { IfaceKind }
-	: akind 	   { $1 }
-	| akind '->' kind  { ifaceArrow $1 $3 }
-
------------------------------------------
---             Expressions
-
-aexp    :: { IfaceExpr }
-	: fs_var_occ    { IfaceLcl $1 }
-        | q_var_occ    	{ IfaceExt $1 }
-	| q_dc_name	{ IfaceExt $1 }
-	| lit		{ IfaceLit $1 }
-	| '(' exp ')' 	{ $2 }
-
-fexp	:: { IfaceExpr }
-	: fexp aexp	{ IfaceApp $1 $2 }
-	| fexp '@' aty	{ IfaceApp $1 (IfaceType $3) }
-	| aexp		{ $1 }
-
-exp	:: { IfaceExpr }
-	: fexp		              { $1 }
-	| '\\' bndrs '->' exp 	      { foldr IfaceLam $4 $2 }
-	| '%let' let_bind '%in' exp   { IfaceLet $2 $4 }
--- gaw 2004
-	| '%case' '(' ty ')' aexp '%of' id_bndr
-	  '{' alts1 '}'		      { IfaceCase $5 (fst $7) $9 }
--- The following line is broken and is hard to fix. Not fixing now
--- because this whole parser is bitrotten anyway.
--- Richard Eisenberg, July 2013
---        | '%cast' aexp aty { IfaceCast $2 $3 }
--- No InlineMe any more
--- 	| '%note' STRING exp 	   
---	    { case $2 of
---	       --"SCC"      -> IfaceNote (IfaceSCC "scc") $3
---	       "InlineMe"   -> IfaceNote IfaceInlineMe $3
---            }
-        | '%external' STRING aty   { IfaceFCall (ForeignCall.CCall 
-                                                    (CCallSpec (StaticTarget (mkFastString $2) Nothing True) 
-                                                               CCallConv PlaySafe)) 
-                                                 $3 }
-
-alts1	:: { [IfaceAlt] }
-	: alt		{ [$1] }
-	| alt ';' alts1	{ $1:$3 }
-
-alt	:: { IfaceAlt }
-	: q_dc_name bndrs '->' exp 
-		{ (IfaceDataAlt $1, map ifaceBndrName $2, $4) } 
-                       -- The external syntax currently includes the types of the
-		       -- the args, but they aren't needed internally
-                       -- Nor is the module qualifier
-	| q_dc_name '->' exp 
-		{ (IfaceDataAlt $1, [], $3) } 
-	| lit '->' exp
-		{ (IfaceLitAlt $1, [], $3) }
-	| '%_' '->' exp
-		{ (IfaceDefault, [], $3) }
-
-lit	:: { Literal }
-	: '(' INTEGER '::' aty ')'	{ convIntLit $2 $4 }
-	| '(' RATIONAL '::' aty ')'	{ convRatLit $2 $4 }
-	| '(' CHAR '::' aty ')'		{ MachChar $2 }
-	| '(' STRING '::' aty ')'	{ MachStr (fastStringToByteString (mkFastString $2)) }
-
-fs_var_occ	:: { FastString }
-		: NAME	{ mkFastString $1 }
-
-var_occ	:: { String }
-	: NAME	{ $1 }
-
-
--- Data constructor in a pattern or data type declaration; use the dataName, 
--- because that's what we expect in Core case patterns
-d_pat_occ :: { OccName }
-        : CNAME      { mkOccName dataName $1 }
-
-{
-
-ifaceKind kc = IfaceTyConApp kc []
-
-ifaceBndrName (IfaceIdBndr (n,_)) = n
-ifaceBndrName (IfaceTvBndr (n,_)) = n
-
-convIntLit :: Integer -> IfaceType -> Literal
-convIntLit i (IfaceTyConApp tc [])
-  | tc `eqTc` intPrimTyCon  = MachInt  i  
-  | tc `eqTc` wordPrimTyCon = MachWord i
-  | tc `eqTc` charPrimTyCon = MachChar (chr (fromInteger i))
-  | tc `eqTc` addrPrimTyCon && i == 0 = MachNullAddr
-convIntLit i aty
-  = pprPanic "Unknown integer literal type" (ppr aty)
-
-convRatLit :: Rational -> IfaceType -> Literal
-convRatLit r (IfaceTyConApp tc [])
-  | tc `eqTc` floatPrimTyCon  = MachFloat  r
-  | tc `eqTc` doublePrimTyCon = MachDouble r
-convRatLit i aty
-  = pprPanic "Unknown rational literal type" (ppr aty)
-
-eqTc :: IfaceTyCon -> TyCon -> Bool   -- Ugh!
-eqTc (IfaceTc name) tycon = name == tyConName tycon
-
--- Tiresomely, we have to generate both HsTypes (in type/class decls) 
--- and IfaceTypes (in Core expressions).  So we parse them as IfaceTypes,
--- and convert to HsTypes here.  But the IfaceTypes we can see here
--- are very limited (see the productions for 'ty'), so the translation
--- isn't hard
-toHsType :: IfaceType -> LHsType RdrName
-toHsType (IfaceTyVar v)        		 = noLoc $ HsTyVar (mkRdrUnqual (mkTyVarOccFS v))
-toHsType (IfaceAppTy t1 t2)    		 = noLoc $ HsAppTy (toHsType t1) (toHsType t2)
-toHsType (IfaceFunTy t1 t2)    		 = noLoc $ HsFunTy (toHsType t1) (toHsType t2)
-toHsType (IfaceTyConApp (IfaceTc tc) ts) = foldl mkHsAppTy (noLoc $ HsTyVar (ifaceExtRdrName tc)) (map toHsType ts) 
-toHsType (IfaceForAllTy tv t)            = add_forall (toHsTvBndr tv) (toHsType t)
-
--- Only a limited form of kind will be encountered... hopefully
-toHsKind :: IfaceKind -> LHsKind RdrName
--- IA0_NOTE: Shouldn't we add kind variables?
-toHsKind (IfaceFunTy ifK1 ifK2)  = noLoc $ HsFunTy (toHsKind ifK1) (toHsKind ifK2)
-toHsKind (IfaceTyConApp ifKc []) = noLoc $ HsTyVar (nameRdrName (tyConName (toKindTc ifKc)))
-toHsKind other                   = pprPanic "toHsKind" (ppr other)
-
-toKindTc :: IfaceTyCon -> TyCon
-toKindTc (IfaceTc n) | Just (ATyCon tc) <- wiredInNameTyThing_maybe n = tc
-toKindTc other = pprPanic "toKindTc" (ppr other)
-
-ifaceTcType ifTc = IfaceTyConApp ifTc []
-
-ifaceLiftedTypeKind   = ifaceTcType (IfaceTc liftedTypeKindTyConName)
-ifaceOpenTypeKind     = ifaceTcType (IfaceTc openTypeKindTyConName)
-ifaceUnliftedTypeKind = ifaceTcType (IfaceTc unliftedTypeKindTyConName)
-
-ifaceArrow ifT1 ifT2 = IfaceFunTy ifT1 ifT2
-
-toHsTvBndr :: IfaceTvBndr -> LHsTyVarBndr RdrName
-toHsTvBndr (tv,k) = noLoc $ KindedTyVar (mkRdrUnqual (mkTyVarOccFS tv)) bsig
-                  where
-                    bsig = toHsKind k
-
-ifaceExtRdrName :: Name -> RdrName
-ifaceExtRdrName name = mkOrig (nameModule name) (nameOccName name)
-ifaceExtRdrName other = pprPanic "ParserCore.ifaceExtRdrName" (ppr other)
-
-add_forall tv (L _ (HsForAllTy exp tvs cxt t))
-  = noLoc $ HsForAllTy exp (mkHsQTvs (tv : hsQTvBndrs tvs)) cxt t
-add_forall tv t
-  = noLoc $ HsForAllTy Explicit (mkHsQTvs [tv]) (noLoc []) t
-  
-happyError :: P a 
-happyError s l = failP (show l ++ ": Parse error\n") (take 100 s) l
-}
-
diff --git a/compiler/parser/ParserCoreUtils.hs b/compiler/parser/ParserCoreUtils.hs
deleted file mode 100644
index 8f67d962396d..000000000000
--- a/compiler/parser/ParserCoreUtils.hs
+++ /dev/null
@@ -1,77 +0,0 @@
-module ParserCoreUtils where
-
-import Exception
-import System.IO
-
-data ParseResult a = OkP a | FailP String
-type P a = String -> Int -> ParseResult a
-
-thenP :: P a -> (a -> P b) -> P b
-m `thenP`  k = \ s l -> 
-  case m s l of 
-    OkP a -> k a s l
-    FailP s -> FailP s
-
-returnP :: a -> P a
-returnP m _ _ = OkP m
-
-failP :: String -> P a
-failP s s' _ = FailP (s ++ ":" ++ s')
-
-getCoreModuleName :: FilePath -> IO String
-getCoreModuleName fpath = 
-   catchIO (do
-     h  <- openFile fpath ReadMode
-     ls <- hGetContents h
-     let mo = findMod (words ls)
-      -- make sure we close up the file right away.
-     (length mo) `seq` return ()
-     hClose h
-     return mo)
-    (\ _ -> return "Main")
- where
-   findMod [] = "Main"
-   -- TODO: this should just return the module name, without the package name
-   findMod ("%module":m:_) = m
-   findMod (_:xs) = findMod xs
-
-
-data Token =
-   TKmodule
- | TKdata
- | TKnewtype
- | TKforall
- | TKrec
- | TKlet
- | TKin
- | TKcase
- | TKof
- | TKcast
- | TKnote
- | TKexternal
- | TKlocal
- | TKwild
- | TKoparen
- | TKcparen
- | TKobrace
- | TKcbrace
- | TKhash
- | TKeq
- | TKcolon
- | TKcoloncolon
- | TKcoloneqcolon
- | TKstar
- | TKrarrow
- | TKlambda
- | TKat
- | TKdot
- | TKquestion
- | TKsemicolon
- | TKname String
- | TKcname String
- | TKinteger Integer
- | TKrational Rational
- | TKstring String
- | TKchar Char
- | TKEOF
-
diff --git a/compiler/parser/RdrHsSyn.lhs b/compiler/parser/RdrHsSyn.lhs
index b1e177a3a9cb..84a284f0abe5 100644
--- a/compiler/parser/RdrHsSyn.lhs
+++ b/compiler/parser/RdrHsSyn.lhs
@@ -4,6 +4,8 @@ o%
 Functions over HsSyn specialised to RdrName.
 
 \begin{code}
+{-# LANGUAGE CPP #-}
+
 module RdrHsSyn (
         mkHsOpApp,
         mkHsIntegral, mkHsFractional, mkHsIsString,
@@ -15,6 +17,7 @@ module RdrHsSyn (
         mkTyFamInst, 
         mkFamDecl, 
         splitCon, mkInlinePragma,
+        splitPatSyn, toPatSynMatchGroup,
         mkRecConstrOrUpdate, -- HsExp -> [HsFieldUpdate] -> P HsExp
         mkTyLit,
         mkTyClD, mkInstD,
@@ -32,6 +35,7 @@ module RdrHsSyn (
         mkGadtDecl,          -- [Located RdrName] -> LHsType RdrName -> ConDecl RdrName
         mkSimpleConDecl,
         mkDeprecatedGadtRecordDecl,
+        mkATDefault,
 
         -- Bunch of functions in the parser monad for
         -- checking and constructing values
@@ -71,7 +75,7 @@ import TysWiredIn       ( unitTyCon, unitDataCon )
 import ForeignCall
 import OccName          ( srcDataName, varName, isDataOcc, isTcOcc,
                           occNameString )
-import PrelNames        ( forall_tv_RDR )
+import PrelNames        ( forall_tv_RDR, allNameStrings )
 import DynFlags
 import SrcLoc
 import OrdList          ( OrdList, fromOL )
@@ -122,16 +126,31 @@ mkClassDecl :: SrcSpan
             -> P (LTyClDecl RdrName)
 
 mkClassDecl loc (L _ (mcxt, tycl_hdr)) fds where_cls
-  = do { let (binds, sigs, ats, at_defs, _, docs) = cvBindsAndSigs (unLoc where_cls)
+  = do { let (binds, sigs, ats, at_insts, _, docs) = cvBindsAndSigs (unLoc where_cls)
              cxt = fromMaybe (noLoc []) mcxt
        ; (cls, tparams) <- checkTyClHdr tycl_hdr
-       ; tyvars <- checkTyVars (ptext (sLit "class")) whereDots
-                               cls tparams      -- Only type vars allowed
+       ; tyvars <- checkTyVarsP (ptext (sLit "class")) whereDots cls tparams
+       ; at_defs <- mapM (eitherToP . mkATDefault) at_insts
        ; return (L loc (ClassDecl { tcdCtxt = cxt, tcdLName = cls, tcdTyVars = tyvars,
                                     tcdFDs = unLoc fds, tcdSigs = sigs, tcdMeths = binds,
                                     tcdATs = ats, tcdATDefs = at_defs, tcdDocs  = docs,
                                     tcdFVs = placeHolderNames })) }
 
+mkATDefault :: LTyFamInstDecl RdrName
+            -> Either (SrcSpan, SDoc) (LTyFamDefltEqn RdrName)
+-- Take a type-family instance declaration and turn it into
+-- a type-family default equation for a class declaration
+-- We parse things as the former and use this function to convert to the latter
+-- 
+-- We use the Either monad because this also called 
+-- from Convert.hs
+mkATDefault (L loc (TyFamInstDecl { tfid_eqn = L _ e }))
+      | TyFamEqn { tfe_tycon = tc, tfe_pats = pats, tfe_rhs = rhs } <- e
+      = do { tvs <- checkTyVars (ptext (sLit "default")) equalsDots tc (hswb_cts pats)
+           ; return (L loc (TyFamEqn { tfe_tycon = tc
+                                     , tfe_pats = tvs
+                                     , tfe_rhs = rhs })) }
+
 mkTyData :: SrcSpan
          -> NewOrData
          -> Maybe CType
@@ -142,7 +161,7 @@ mkTyData :: SrcSpan
          -> P (LTyClDecl RdrName)
 mkTyData loc new_or_data cType (L _ (mcxt, tycl_hdr)) ksig data_cons maybe_deriv
   = do { (tc, tparams) <- checkTyClHdr tycl_hdr
-       ; tyvars <- checkTyVars (ppr new_or_data) equalsDots tc tparams
+       ; tyvars <- checkTyVarsP (ppr new_or_data) equalsDots tc tparams
        ; defn <- mkDataDefn new_or_data cType mcxt ksig data_cons maybe_deriv
        ; return (L loc (DataDecl { tcdLName = tc, tcdTyVars = tyvars,
                                    tcdDataDefn = defn,
@@ -170,7 +189,7 @@ mkTySynonym :: SrcSpan
             -> P (LTyClDecl RdrName)
 mkTySynonym loc lhs rhs
   = do { (tc, tparams) <- checkTyClHdr lhs
-       ; tyvars <- checkTyVars (ptext (sLit "type")) equalsDots tc tparams
+       ; tyvars <- checkTyVarsP (ptext (sLit "type")) equalsDots tc tparams
        ; return (L loc (SynDecl { tcdLName = tc, tcdTyVars = tyvars
                                 , tcdRhs = rhs, tcdFVs = placeHolderNames })) }
 
@@ -179,9 +198,9 @@ mkTyFamInstEqn :: LHsType RdrName
                -> P (TyFamInstEqn RdrName)
 mkTyFamInstEqn lhs rhs
   = do { (tc, tparams) <- checkTyClHdr lhs
-       ; return (TyFamInstEqn { tfie_tycon = tc
-                              , tfie_pats  = mkHsWithBndrs tparams
-                              , tfie_rhs   = rhs }) }
+       ; return (TyFamEqn { tfe_tycon = tc
+                          , tfe_pats  = mkHsWithBndrs tparams
+                          , tfe_rhs   = rhs }) }
 
 mkDataFamInst :: SrcSpan
          -> NewOrData
@@ -212,7 +231,7 @@ mkFamDecl :: SrcSpan
           -> P (LTyClDecl RdrName)
 mkFamDecl loc info lhs ksig
   = do { (tc, tparams) <- checkTyClHdr lhs
-       ; tyvars <- checkTyVars (ppr info) equals_or_where tc tparams
+       ; tyvars <- checkTyVarsP (ppr info) equals_or_where tc tparams
        ; return (L loc (FamDecl (FamilyDecl { fdInfo = info, fdLName = tc
                                             , fdTyVars = tyvars, fdKindSig = ksig }))) }
   where
@@ -315,7 +334,7 @@ cvBindsAndSigs  fb = go (fromOL fb)
     go []                  = (emptyBag, [], [], [], [], [])
     go (L l (SigD s) : ds) = (bs, L l s : ss, ts, tfis, dfis, docs)
                            where (bs, ss, ts, tfis, dfis, docs) = go ds
-    go (L l (ValD b) : ds) = ((FromSource, b') `consBag` bs, ss, ts, tfis, dfis, docs)
+    go (L l (ValD b) : ds) = (b' `consBag` bs, ss, ts, tfis, dfis, docs)
                            where (b', ds')    = getMonoBind (L l b) ds
                                  (bs, ss, ts, tfis, dfis, docs) = go ds'
     go (L l (TyClD (FamDecl t)) : ds) = (bs, ss, L l t : ts, tfis, dfis, docs)
@@ -410,6 +429,56 @@ splitCon ty
    mk_rest [L _ (HsRecTy flds)] = RecCon flds
    mk_rest ts                   = PrefixCon ts
 
+splitPatSyn :: LPat RdrName
+      -> P (Located RdrName, HsPatSynDetails (Located RdrName))
+splitPatSyn (L _ (ParPat pat)) = splitPatSyn pat
+splitPatSyn pat@(L loc (ConPatIn con details)) = do
+    details' <- case details of
+        PrefixCon pats     -> liftM PrefixPatSyn (mapM patVar pats)
+        InfixCon pat1 pat2 -> liftM2 InfixPatSyn (patVar pat1) (patVar pat2)
+        RecCon{}           -> recordPatSynErr loc pat
+    return (con, details')
+  where
+    patVar :: LPat RdrName -> P (Located RdrName)
+    patVar (L loc (VarPat v))   = return $ L loc v
+    patVar (L _   (ParPat pat)) = patVar pat
+    patVar (L loc pat)          = parseErrorSDoc loc $
+                                  text "Pattern synonym arguments must be variable names:" $$
+                                  ppr pat
+splitPatSyn pat@(L loc _) = parseErrorSDoc loc $
+                            text "invalid pattern synonym declaration:" $$ ppr pat
+
+recordPatSynErr :: SrcSpan -> LPat RdrName -> P a
+recordPatSynErr loc pat =
+    parseErrorSDoc loc $
+    text "record syntax not supported for pattern synonym declarations:" $$
+    ppr pat
+
+toPatSynMatchGroup :: Located RdrName -> Located (OrdList (LHsDecl RdrName)) -> P (MatchGroup RdrName (LHsExpr RdrName))
+toPatSynMatchGroup (L _ patsyn_name) (L _ decls) =
+    do { matches <- mapM fromDecl (fromOL decls)
+       ; return $ mkMatchGroup FromSource matches }
+  where
+    fromDecl (L loc decl@(ValD (PatBind pat@(L _ (ConPatIn (L _ name) details)) rhs _ _ _))) =
+        do { unless (name == patsyn_name) $
+               wrongNameBindingErr loc decl
+           ; match <- case details of
+               PrefixCon pats -> return $ Match pats Nothing rhs
+               InfixCon pat1 pat2 -> return $ Match [pat1, pat2] Nothing rhs
+               RecCon{} -> recordPatSynErr loc pat
+           ; return $ L loc match }
+    fromDecl (L loc decl) = extraDeclErr loc decl
+
+    extraDeclErr loc decl =
+        parseErrorSDoc loc $
+        text "pattern synonym 'where' clause must contain a single binding:" $$
+        ppr decl
+
+    wrongNameBindingErr loc decl =
+        parseErrorSDoc loc $
+        text "pattern synonym 'where' clause must bind the pattern synonym's name" <+>
+        quotes (ppr patsyn_name) $$ ppr decl
+
 mkDeprecatedGadtRecordDecl :: SrcSpan
                            -> Located RdrName
                            -> [ConDeclField RdrName]
@@ -500,26 +569,42 @@ we can bring x,y into scope.  So:
    * For RecCon we do not
 
 \begin{code}
-checkTyVars :: SDoc -> SDoc -> Located RdrName -> [LHsType RdrName] -> P (LHsTyVarBndrs RdrName)
+checkTyVarsP :: SDoc -> SDoc -> Located RdrName -> [LHsType RdrName] -> P (LHsTyVarBndrs RdrName)
+-- Same as checkTyVars, but in the P monad
+checkTyVarsP pp_what equals_or_where tc tparms 
+  = eitherToP $ checkTyVars pp_what equals_or_where tc tparms 
+
+eitherToP :: Either (SrcSpan, SDoc) a -> P a
+-- Adapts the Either monad to the P monad
+eitherToP (Left (loc, doc)) = parseErrorSDoc loc doc
+eitherToP (Right thing)     = return thing
+checkTyVars :: SDoc -> SDoc -> Located RdrName -> [LHsType RdrName] 
+            -> Either (SrcSpan, SDoc) (LHsTyVarBndrs RdrName)
 -- Check whether the given list of type parameters are all type variables
--- (possibly with a kind signature).
-checkTyVars pp_what equals_or_where tc tparms = do { tvs <- mapM chk tparms
-                                 ; return (mkHsQTvs tvs) }
+-- (possibly with a kind signature)
+-- We use the Either monad because it's also called (via mkATDefault) from
+-- Convert.hs
+checkTyVars pp_what equals_or_where tc tparms 
+  = do { tvs <- mapM chk tparms
+       ; return (mkHsQTvs tvs) }
   where
+        
         -- Check that the name space is correct!
     chk (L l (HsKindSig (L _ (HsTyVar tv)) k))
         | isRdrTyVar tv    = return (L l (KindedTyVar tv k))
     chk (L l (HsTyVar tv))
         | isRdrTyVar tv    = return (L l (UserTyVar tv))
-    chk t@(L l _)
-        = parseErrorSDoc l $
-          vcat [ ptext (sLit "Unexpected type") <+> quotes (ppr t)
-               , ptext (sLit "In the") <+> pp_what <+> ptext (sLit "declaration for") <+> quotes (ppr tc)
-               , vcat[ (ptext (sLit "A") <+> pp_what <+> ptext (sLit "declaration should have form"))
-                     , nest 2 (pp_what <+> ppr tc <+> ptext (sLit "a b c")
-                               <+> equals_or_where) ] ]
+    chk t@(L loc _)
+        = Left (loc, 
+                vcat [ ptext (sLit "Unexpected type") <+> quotes (ppr t)
+                     , ptext (sLit "In the") <+> pp_what <+> ptext (sLit "declaration for") <+> quotes (ppr tc)
+                     , vcat[ (ptext (sLit "A") <+> pp_what <+> ptext (sLit "declaration should have form"))
+                     , nest 2 (pp_what <+> ppr tc 
+                                       <+> hsep (map text (takeList tparms allNameStrings))
+                                       <+> equals_or_where) ] ])
 
 whereDots, equalsDots :: SDoc
+-- Second argument to checkTyVars
 whereDots  = ptext (sLit "where ...")
 equalsDots = ptext (sLit "= ...")
 
@@ -666,7 +751,7 @@ checkAPat msg loc e0 = do
 
    ExplicitTuple es b
      | all tupArgPresent es  -> do ps <- mapM (checkLPat msg) [e | Present e <- es]
-                                   return (TuplePat ps b placeHolderType)
+                                   return (TuplePat ps b [])
      | otherwise -> parseErrorSDoc loc (text "Illegal tuple section in pattern:" $$ ppr e0)
 
    RecordCon c _ (HsRecFields fs dd)
@@ -735,7 +820,7 @@ checkFunBind msg lhs_loc fun is_infix pats opt_sig (L rhs_span grhss)
 makeFunBind :: Located id -> Bool -> [LMatch id (LHsExpr id)] -> HsBind id
 -- Like HsUtils.mkFunBind, but we need to be able to set the fixity too
 makeFunBind fn is_infix ms
-  = FunBind { fun_id = fn, fun_infix = is_infix, fun_matches = mkMatchGroup ms,
+  = FunBind { fun_id = fn, fun_infix = is_infix, fun_matches = mkMatchGroup FromSource ms,
               fun_co_fn = idHsWrapper, bind_fvs = placeHolderNames, fun_tick = Nothing }
 
 checkPatBind :: SDoc
diff --git a/compiler/parser/cutils.c b/compiler/parser/cutils.c
index c42ec9e3cec8..d714a0cb2ae7 100644
--- a/compiler/parser/cutils.c
+++ b/compiler/parser/cutils.c
@@ -37,7 +37,7 @@ ghc_memcmp_off( HsPtr a1, HsInt i, HsPtr a2, HsInt len )
 }
 
 void
-enableTimingStats( void )	/* called from the driver */
+enableTimingStats( void )       /* called from the driver */
 {
     RtsFlags.GcFlags.giveStats = ONELINE_GC_STATS;
 }
@@ -47,9 +47,7 @@ setHeapSize( HsInt size )
 {
     RtsFlags.GcFlags.heapSizeSuggestion = size / BLOCK_SIZE;
     if (RtsFlags.GcFlags.maxHeapSize != 0 &&
-	RtsFlags.GcFlags.heapSizeSuggestion > RtsFlags.GcFlags.maxHeapSize) {
-	RtsFlags.GcFlags.maxHeapSize = RtsFlags.GcFlags.heapSizeSuggestion;
+        RtsFlags.GcFlags.heapSizeSuggestion > RtsFlags.GcFlags.maxHeapSize) {
+        RtsFlags.GcFlags.maxHeapSize = RtsFlags.GcFlags.heapSizeSuggestion;
     }
 }
-
-
diff --git a/compiler/prelude/ForeignCall.lhs b/compiler/prelude/ForeignCall.lhs
index 5072908e6af3..232f69f67f61 100644
--- a/compiler/prelude/ForeignCall.lhs
+++ b/compiler/prelude/ForeignCall.lhs
@@ -117,7 +117,7 @@ data CCallTarget
   = StaticTarget
         CLabelString                    -- C-land name of label.
 
-        (Maybe PackageId)               -- What package the function is in.
+        (Maybe PackageKey)              -- What package the function is in.
                                         -- If Nothing, then it's taken to be in the current package.
                                         -- Note: This information is only used for PrimCalls on Windows.
                                         --       See CLabel.labelDynamic and CoreToStg.coreToStgApp
diff --git a/compiler/prelude/PrelInfo.lhs b/compiler/prelude/PrelInfo.lhs
index bfcea1c039e1..eaefff236406 100644
--- a/compiler/prelude/PrelInfo.lhs
+++ b/compiler/prelude/PrelInfo.lhs
@@ -4,13 +4,7 @@
 \section[PrelInfo]{The @PrelInfo@ interface to the compiler's prelude knowledge}
 
 \begin{code}
-{-# OPTIONS -fno-warn-tabs #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and
--- detab the module (please do the detabbing in a separate patch). See
---     http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
--- for details
-
+{-# LANGUAGE CPP #-}
 module PrelInfo (
         wiredInIds, ghcPrimIds,
         primOpRules, builtinRules,
@@ -18,7 +12,7 @@ module PrelInfo (
         ghcPrimExports,
         wiredInThings, basicKnownKeyNames,
         primOpId,
-        
+
         -- Random other things
         maybeCharLikeCon, maybeIntLikeCon,
 
@@ -48,9 +42,9 @@ import Data.Array
 \end{code}
 
 %************************************************************************
-%*									*
+%*                                                                      *
 \subsection[builtinNameInfo]{Lookup built-in names}
-%*									*
+%*                                                                      *
 %************************************************************************
 
 Notes about wired in things
@@ -58,13 +52,13 @@ Notes about wired in things
 * Wired-in things are Ids\/TyCons that are completely known to the compiler.
   They are global values in GHC, (e.g.  listTyCon :: TyCon).
 
-* A wired in Name contains the thing itself inside the Name: 
-	see Name.wiredInNameTyThing_maybe
-  (E.g. listTyConName contains listTyCon. 
+* A wired in Name contains the thing itself inside the Name:
+        see Name.wiredInNameTyThing_maybe
+  (E.g. listTyConName contains listTyCon.
 
 * The name cache is initialised with (the names of) all wired-in things
 
-* The type checker sees if the Name is wired in before looking up 
+* The type checker sees if the Name is wired in before looking up
   the name in the type environment.  So the type envt itself contains
   no wired in things.
 
@@ -77,17 +71,17 @@ wiredInThings :: [TyThing]
 -- This list is used only to initialise HscMain.knownKeyNames
 -- to ensure that when you say "Prelude.map" in your source code, you
 -- get a Name with the correct known key (See Note [Known-key names])
-wiredInThings		
+wiredInThings
   = concat
-    [		-- Wired in TyCons and their implicit Ids
-	  tycon_things
-	, concatMap implicitTyThings tycon_things
+    [           -- Wired in TyCons and their implicit Ids
+          tycon_things
+        , concatMap implicitTyThings tycon_things
 
-		-- Wired in Ids
-	, map AnId wiredInIds
+                -- Wired in Ids
+        , map AnId wiredInIds
 
-		-- PrimOps
-	, map (AnId . primOpId) allThePrimOps
+                -- PrimOps
+        , map (AnId . primOpId) allThePrimOps
     ]
   where
     tycon_things = map ATyCon ([funTyCon] ++ primTyCons ++ wiredInTyCons
@@ -99,16 +93,16 @@ sense of them in interface pragmas. It's cool, though they all have
 "non-standard" names, so they won't get past the parser in user code.
 
 %************************************************************************
-%*									*
-		PrimOpIds
-%*									*
+%*                                                                      *
+                PrimOpIds
+%*                                                                      *
 %************************************************************************
 
 \begin{code}
-primOpIds :: Array Int Id	
+primOpIds :: Array Int Id
 -- A cache of the PrimOp Ids, indexed by PrimOp tag
-primOpIds = array (1,maxPrimOpTag) [ (primOpTag op, mkPrimOpId op) 
-				   | op <- allThePrimOps ]
+primOpIds = array (1,maxPrimOpTag) [ (primOpTag op, mkPrimOpId op)
+                                   | op <- allThePrimOps ]
 
 primOpId :: PrimOp -> Id
 primOpId op = primOpIds ! primOpTag op
@@ -116,12 +110,12 @@ primOpId op = primOpIds ! primOpTag op
 
 
 %************************************************************************
-%*									*
+%*                                                                      *
 \subsection{Export lists for pseudo-modules (GHC.Prim)}
-%*									*
+%*                                                                      *
 %************************************************************************
 
-GHC.Prim "exports" all the primops and primitive types, some 
+GHC.Prim "exports" all the primops and primitive types, some
 wired-in Ids.
 
 \begin{code}
@@ -129,15 +123,16 @@ ghcPrimExports :: [IfaceExport]
 ghcPrimExports
  = map (Avail . idName) ghcPrimIds ++
    map (Avail . idName . primOpId) allThePrimOps ++
-   [ AvailTC n [n] 
-   | tc <- funTyCon : coercibleTyCon : primTyCons, let n = tyConName tc  ]
+   [ AvailTC n [n]
+   | tc <- funTyCon : primTyCons, let n = tyConName tc  ]
 \end{code}
 
 
+
 %************************************************************************
-%*									*
+%*                                                                      *
 \subsection{Built-in keys}
-%*									*
+%*                                                                      *
 %************************************************************************
 
 ToDo: make it do the ``like'' part properly (as in 0.26 and before).
@@ -150,9 +145,9 @@ maybeIntLikeCon  con = con `hasKey` intDataConKey
 
 
 %************************************************************************
-%*									*
+%*                                                                      *
 \subsection{Class predicates}
-%*									*
+%*                                                                      *
 %************************************************************************
 
 \begin{code}
diff --git a/compiler/prelude/PrelNames.lhs b/compiler/prelude/PrelNames.lhs
index 3f00c6242c7c..5757ba123428 100644
--- a/compiler/prelude/PrelNames.lhs
+++ b/compiler/prelude/PrelNames.lhs
@@ -37,56 +37,73 @@ Nota Bene: all Names defined in here should come from the base package
 
 Note [Known-key names]
 ~~~~~~~~~~~~~~~~~~~~~~
+It is *very* important that the compiler gives wired-in things and
+things with "known-key" names the correct Uniques wherever they
+occur. We have to be careful about this in exactly two places:
 
-It is *very* important that the compiler gives wired-in things and things with "known-key" names
-the correct Uniques wherever they occur. We have to be careful about this in exactly two places:
+  1. When we parse some source code, renaming the AST better yield an
+     AST whose Names have the correct uniques
 
-  1. When we parse some source code, renaming the AST better yield an AST whose Names have the
-     correct uniques
-
-  2. When we read an interface file, the read-in gubbins better have the right uniques
+  2. When we read an interface file, the read-in gubbins better have
+     the right uniques
 
 This is accomplished through a combination of mechanisms:
 
-  1. When parsing source code, the RdrName-decorated AST has some RdrNames which are Exact. These are
-     wired-in RdrNames where the we could directly tell from the parsed syntax what Name to use. For
-     example, when we parse a [] in a type we can just insert an Exact RdrName Name with the listTyConKey.
-
-     Currently, I believe this is just an optimisation: it would be equally valid to just output Orig
-     RdrNames that correctly record the module etc we expect the final Name to come from. However,
-     were we to eliminate isTupleOcc_maybe it would become essential (see point 3).
-
-  2. The knownKeyNames (which consist of the basicKnownKeyNames from the module, and those names reachable
-     via the wired-in stuff from TysWiredIn) are used to initialise the "original name cache" in IfaceEnv.
-     This initialization ensures that when the type checker or renamer (both of which use IfaceEnv) look up
-     an original name (i.e. a pair of a Module and an OccName) for a known-key name they get the correct Unique.
+  1. When parsing source code, the RdrName-decorated AST has some
+     RdrNames which are Exact. These are wired-in RdrNames where the
+     we could directly tell from the parsed syntax what Name to
+     use. For example, when we parse a [] in a type we can just insert
+     an Exact RdrName Name with the listTyConKey.
+
+     Currently, I believe this is just an optimisation: it would be
+     equally valid to just output Orig RdrNames that correctly record
+     the module etc we expect the final Name to come from. However,
+     were we to eliminate isBuiltInOcc_maybe it would become essential
+     (see point 3).
+
+  2. The knownKeyNames (which consist of the basicKnownKeyNames from
+     the module, and those names reachable via the wired-in stuff from
+     TysWiredIn) are used to initialise the "OrigNameCache" in
+     IfaceEnv.  This initialization ensures that when the type checker
+     or renamer (both of which use IfaceEnv) look up an original name
+     (i.e. a pair of a Module and an OccName) for a known-key name
+     they get the correct Unique.
+
+     This is the most important mechanism for ensuring that known-key
+     stuff gets the right Unique, and is why it is so important to
+     place your known-key names in the appropriate lists.
+
+  3. For "infinite families" of known-key names (i.e. tuples), we have
+     to be extra careful. Because there are an infinite number of
+     these things, we cannot add them to the list of known-key names
+     used to initialise the OrigNameCache. Instead, we have to
+     rely on never having to look them up in that cache.
 
-     This is the most important mechanism for ensuring that known-key stuff gets the right Unique, and is why
-     it is so important to place your known-key names in the appropriate lists.
+     This is accomplished through a variety of mechanisms:
 
-  3. For "infinite families" of known-key names (i.e. tuples, Any tycons and implicit parameter TyCons), we
-     have to be extra careful. Because there are an infinite number of these things, we cannot add them to
-     the list of known-key names used to initialise the original name cache. Instead, we have to rely on
-     never having to look them up in that cache.
+       a) The parser recognises them specially and generates an 
+          Exact Name (hence not looked up in the orig-name cache)
 
-     This is accomplished through a variety of mechanisms:
+       b) The known infinite families of names are specially
+          serialised by BinIface.putName, with that special treatment
+          detected when we read back to ensure that we get back to the
+          correct uniques.
 
-       a) The known infinite families of names are specially serialised by BinIface.putName, with that special treatment
-          detected when we read back to ensure that we get back to the correct uniques.
+       Most of the infinite families cannot occur in source code,
+       so mechanisms (a,b) sufficies to ensure that they always have
+       the right Unique. In particular, implicit param TyCon names,
+       constraint tuples and Any TyCons cannot be mentioned by the
+       user.
 
-       b) Most of the infinite families cannot occur in source code, so mechanism a) sufficies to ensure that they
-          always have the right Unique. In particular, implicit param TyCon names, constraint tuples and Any TyCons
-          cannot be mentioned by the user.
+       c) IfaceEnv.lookupOrigNameCache uses isBuiltInOcc_maybe to map
+          built-in syntax directly onto the corresponding name, rather
+          than trying to find it in the original-name cache.
 
-       c) Tuple TyCon/DataCon names have a special hack (isTupleOcc_maybe) that is used by the original name cache
-          lookup routine to detect tuple names and give them the right Unique. You might think that this is unnecessary
-          because tuple TyCon/DataCons are parsed as Exact RdrNames and *don't* appear as original names in interface files
-          (because serialization gives them special treatment), so we will never look them up in the original name cache.
+          See also Note [Built-in syntax and the OrigNameCache]
 
-          However, there is a subtle reason why this is not the case: if you use setRdrNameSpace on an Exact RdrName
-          it may be turned into an Orig RdrName. So if the original name was an Exact tuple Name we might end up with
-          an Orig instead, which *will* lead to an original name cache query.
 \begin{code}
+{-# LANGUAGE CPP #-}
+
 module PrelNames (
         Unique, Uniquable(..), hasKey,  -- Re-exported for convenience
 
@@ -111,6 +128,19 @@ import FastString
 \end{code}
 
 
+%************************************************************************
+%*                                                                      *
+     allNameStrings
+%*                                                                      *
+%************************************************************************
+
+\begin{code}
+allNameStrings :: [String]
+-- Infinite list of a,b,c...z, aa, ab, ac, ... etc
+allNameStrings = [ c:cs | cs <- "" : allNameStrings, c <- ['a'..'z'] ] 
+\end{code}
+
+
 %************************************************************************
 %*                                                                      *
 \subsection{Local Names}
@@ -250,8 +280,6 @@ basicKnownKeyNames
         concatName, filterName, mapName,
         zipName, foldrName, buildName, augmentName, appendName,
 
-        dollarName,         -- The ($) apply function
-
         -- FFI primitive types that are not wired-in.
         stablePtrTyConName, ptrTyConName, funPtrTyConName,
         int8TyConName, int16TyConName, int32TyConName, int64TyConName,
@@ -355,7 +383,7 @@ genericTyConNames = [
 pRELUDE :: Module
 pRELUDE         = mkBaseModule_ pRELUDE_NAME
 
-gHC_PRIM, gHC_TYPES, gHC_GENERICS, gHC_MAGIC, gHC_COERCIBLE,
+gHC_PRIM, gHC_TYPES, gHC_GENERICS, gHC_MAGIC,
     gHC_CLASSES, gHC_BASE, gHC_ENUM, gHC_GHCI, gHC_CSTRING,
     gHC_SHOW, gHC_READ, gHC_NUM, gHC_INTEGER_TYPE, gHC_LIST,
     gHC_TUPLE, dATA_TUPLE, dATA_EITHER, dATA_STRING, dATA_FOLDABLE, dATA_TRAVERSABLE, dATA_MONOID,
@@ -372,7 +400,6 @@ gHC_TYPES       = mkPrimModule (fsLit "GHC.Types")
 gHC_MAGIC       = mkPrimModule (fsLit "GHC.Magic")
 gHC_CSTRING     = mkPrimModule (fsLit "GHC.CString")
 gHC_CLASSES     = mkPrimModule (fsLit "GHC.Classes")
-gHC_COERCIBLE   = mkPrimModule (fsLit "GHC.Coercible")
 
 gHC_BASE        = mkBaseModule (fsLit "GHC.Base")
 gHC_ENUM        = mkBaseModule (fsLit "GHC.Enum")
@@ -434,7 +461,7 @@ rOOT_MAIN       = mkMainModule (fsLit ":Main") -- Root module for initialisation
 
 mkInteractiveModule :: Int -> Module
 -- (mkInteractiveMoudule 9) makes module 'interactive:M9'
-mkInteractiveModule n = mkModule interactivePackageId (mkModuleName ("Ghci" ++ show n))
+mkInteractiveModule n = mkModule interactivePackageKey (mkModuleName ("Ghci" ++ show n))
 
 pRELUDE_NAME, mAIN_NAME :: ModuleName
 pRELUDE_NAME   = mkModuleNameFS (fsLit "Prelude")
@@ -445,28 +472,28 @@ dATA_ARRAY_PARALLEL_NAME      = mkModuleNameFS (fsLit "Data.Array.Parallel")
 dATA_ARRAY_PARALLEL_PRIM_NAME = mkModuleNameFS (fsLit "Data.Array.Parallel.Prim")
 
 mkPrimModule :: FastString -> Module
-mkPrimModule m = mkModule primPackageId (mkModuleNameFS m)
+mkPrimModule m = mkModule primPackageKey (mkModuleNameFS m)
 
 mkIntegerModule :: FastString -> Module
-mkIntegerModule m = mkModule integerPackageId (mkModuleNameFS m)
+mkIntegerModule m = mkModule integerPackageKey (mkModuleNameFS m)
 
 mkBaseModule :: FastString -> Module
-mkBaseModule m = mkModule basePackageId (mkModuleNameFS m)
+mkBaseModule m = mkModule basePackageKey (mkModuleNameFS m)
 
 mkBaseModule_ :: ModuleName -> Module
-mkBaseModule_ m = mkModule basePackageId m
+mkBaseModule_ m = mkModule basePackageKey m
 
 mkThisGhcModule :: FastString -> Module
-mkThisGhcModule m = mkModule thisGhcPackageId (mkModuleNameFS m)
+mkThisGhcModule m = mkModule thisGhcPackageKey (mkModuleNameFS m)
 
 mkThisGhcModule_ :: ModuleName -> Module
-mkThisGhcModule_ m = mkModule thisGhcPackageId m
+mkThisGhcModule_ m = mkModule thisGhcPackageKey m
 
 mkMainModule :: FastString -> Module
-mkMainModule m = mkModule mainPackageId (mkModuleNameFS m)
+mkMainModule m = mkModule mainPackageKey (mkModuleNameFS m)
 
 mkMainModule_ :: ModuleName -> Module
-mkMainModule_ m = mkModule mainPackageId m
+mkMainModule_ m = mkModule mainPackageKey m
 \end{code}
 
 %************************************************************************
@@ -476,10 +503,10 @@ mkMainModule_ m = mkModule mainPackageId m
 %************************************************************************
 
 \begin{code}
-mkTupleModule :: TupleSort -> Arity -> Module
-mkTupleModule BoxedTuple   _ = gHC_TUPLE
-mkTupleModule ConstraintTuple    _ = gHC_TUPLE
-mkTupleModule UnboxedTuple _ = gHC_PRIM
+mkTupleModule :: TupleSort -> Module
+mkTupleModule BoxedTuple      = gHC_TUPLE
+mkTupleModule ConstraintTuple = gHC_TUPLE
+mkTupleModule UnboxedTuple    = gHC_PRIM
 \end{code}
 
 
@@ -805,20 +832,20 @@ inlineIdName            = varQual gHC_MAGIC (fsLit "inline") inlineIdKey
 
 -- Base classes (Eq, Ord, Functor)
 fmapName, eqClassName, eqName, ordClassName, geName, functorClassName :: Name
-eqClassName       = clsQual  gHC_CLASSES (fsLit "Eq")      eqClassKey
-eqName            = methName gHC_CLASSES (fsLit "==")      eqClassOpKey
-ordClassName      = clsQual  gHC_CLASSES (fsLit "Ord")     ordClassKey
-geName            = methName gHC_CLASSES (fsLit ">=")      geClassOpKey
-functorClassName  = clsQual  gHC_BASE (fsLit "Functor") functorClassKey
-fmapName          = methName gHC_BASE (fsLit "fmap")    fmapClassOpKey
+eqClassName       = clsQual gHC_CLASSES (fsLit "Eq")      eqClassKey
+eqName            = varQual gHC_CLASSES (fsLit "==")      eqClassOpKey
+ordClassName      = clsQual gHC_CLASSES (fsLit "Ord")     ordClassKey
+geName            = varQual gHC_CLASSES (fsLit ">=")      geClassOpKey
+functorClassName  = clsQual gHC_BASE    (fsLit "Functor") functorClassKey
+fmapName          = varQual gHC_BASE    (fsLit "fmap")    fmapClassOpKey
 
 -- Class Monad
 monadClassName, thenMName, bindMName, returnMName, failMName :: Name
-monadClassName     = clsQual  gHC_BASE (fsLit "Monad")  monadClassKey
-thenMName          = methName gHC_BASE (fsLit ">>")     thenMClassOpKey
-bindMName          = methName gHC_BASE (fsLit ">>=")    bindMClassOpKey
-returnMName        = methName gHC_BASE (fsLit "return") returnMClassOpKey
-failMName          = methName gHC_BASE (fsLit "fail")   failMClassOpKey
+monadClassName     = clsQual gHC_BASE (fsLit "Monad")  monadClassKey
+thenMName          = varQual gHC_BASE (fsLit ">>")     thenMClassOpKey
+bindMName          = varQual gHC_BASE (fsLit ">>=")    bindMClassOpKey
+returnMName        = varQual gHC_BASE (fsLit "return") returnMClassOpKey
+failMName          = varQual gHC_BASE (fsLit "fail")   failMClassOpKey
 
 -- Classes (Applicative, Foldable, Traversable)
 applicativeClassName, foldableClassName, traversableClassName :: Name
@@ -831,10 +858,10 @@ traversableClassName  = clsQual  dATA_TRAVERSABLE    (fsLit "Traversable") trave
 -- AMP additions
 
 joinMName,  apAName, pureAName, alternativeClassName :: Name
-joinMName            = methName mONAD               (fsLit "join")        joinMIdKey
-apAName              = methName cONTROL_APPLICATIVE (fsLit "<*>")         apAClassOpKey
-pureAName            = methName cONTROL_APPLICATIVE (fsLit "pure")        pureAClassOpKey
-alternativeClassName = clsQual  cONTROL_APPLICATIVE (fsLit "Alternative") alternativeClassKey
+joinMName            = varQual mONAD               (fsLit "join")        joinMIdKey
+apAName              = varQual cONTROL_APPLICATIVE (fsLit "<*>")         apAClassOpKey
+pureAName            = varQual cONTROL_APPLICATIVE (fsLit "pure")        pureAClassOpKey
+alternativeClassName = clsQual cONTROL_APPLICATIVE (fsLit "Alternative") alternativeClassKey
 
 joinMIdKey, apAClassOpKey, pureAClassOpKey, alternativeClassKey :: Unique
 joinMIdKey          = mkPreludeMiscIdUnique 750
@@ -851,20 +878,19 @@ groupWithName = varQual gHC_EXTS (fsLit "groupWith") groupWithIdKey
 fromStringName, otherwiseIdName, foldrName, buildName, augmentName,
     mapName, appendName, assertName,
     breakpointName, breakpointCondName, breakpointAutoName,
-    dollarName, opaqueTyConName :: Name
-fromStringName = methName dATA_STRING (fsLit "fromString") fromStringClassOpKey
+    opaqueTyConName :: Name
+fromStringName = varQual dATA_STRING (fsLit "fromString") fromStringClassOpKey
 otherwiseIdName   = varQual gHC_BASE (fsLit "otherwise")  otherwiseIdKey
 foldrName         = varQual gHC_BASE (fsLit "foldr")      foldrIdKey
 buildName         = varQual gHC_BASE (fsLit "build")      buildIdKey
 augmentName       = varQual gHC_BASE (fsLit "augment")    augmentIdKey
 mapName           = varQual gHC_BASE (fsLit "map")        mapIdKey
 appendName        = varQual gHC_BASE (fsLit "++")         appendIdKey
-dollarName        = varQual gHC_BASE (fsLit "$")          dollarIdKey
 assertName        = varQual gHC_BASE (fsLit "assert")     assertIdKey
 breakpointName    = varQual gHC_BASE (fsLit "breakpoint") breakpointIdKey
 breakpointCondName= varQual gHC_BASE (fsLit "breakpointCond") breakpointCondIdKey
 breakpointAutoName= varQual gHC_BASE (fsLit "breakpointAuto") breakpointAutoIdKey
-opaqueTyConName   = tcQual  gHC_BASE (fsLit "Opaque")   opaqueTyConKey
+opaqueTyConName   = tcQual  gHC_BASE (fsLit "Opaque")     opaqueTyConKey
 
 breakpointJumpName :: Name
 breakpointJumpName
@@ -892,10 +918,10 @@ sndName           = varQual dATA_TUPLE (fsLit "snd") sndIdKey
 
 -- Module GHC.Num
 numClassName, fromIntegerName, minusName, negateName :: Name
-numClassName      = clsQual  gHC_NUM (fsLit "Num") numClassKey
-fromIntegerName   = methName gHC_NUM (fsLit "fromInteger") fromIntegerClassOpKey
-minusName         = methName gHC_NUM (fsLit "-") minusClassOpKey
-negateName        = methName gHC_NUM (fsLit "negate") negateClassOpKey
+numClassName      = clsQual gHC_NUM (fsLit "Num")         numClassKey
+fromIntegerName   = varQual gHC_NUM (fsLit "fromInteger") fromIntegerClassOpKey
+minusName         = varQual gHC_NUM (fsLit "-")           minusClassOpKey
+negateName        = varQual gHC_NUM (fsLit "negate")      negateClassOpKey
 
 integerTyConName, mkIntegerName,
     integerToWord64Name, integerToInt64Name,
@@ -962,23 +988,23 @@ rationalTyConName, ratioTyConName, ratioDataConName, realClassName,
     integralClassName, realFracClassName, fractionalClassName,
     fromRationalName, toIntegerName, toRationalName, fromIntegralName,
     realToFracName :: Name
-rationalTyConName   = tcQual  gHC_REAL (fsLit "Rational") rationalTyConKey
-ratioTyConName      = tcQual  gHC_REAL (fsLit "Ratio") ratioTyConKey
-ratioDataConName    = conName gHC_REAL (fsLit ":%") ratioDataConKey
-realClassName       = clsQual gHC_REAL (fsLit "Real") realClassKey
-integralClassName   = clsQual gHC_REAL (fsLit "Integral") integralClassKey
-realFracClassName   = clsQual gHC_REAL (fsLit "RealFrac") realFracClassKey
-fractionalClassName = clsQual gHC_REAL (fsLit "Fractional") fractionalClassKey
-fromRationalName    = methName gHC_REAL (fsLit "fromRational") fromRationalClassOpKey
-toIntegerName       = methName gHC_REAL (fsLit "toInteger") toIntegerClassOpKey
-toRationalName      = methName gHC_REAL (fsLit "toRational") toRationalClassOpKey
-fromIntegralName    = varQual  gHC_REAL (fsLit "fromIntegral") fromIntegralIdKey
-realToFracName      = varQual  gHC_REAL (fsLit "realToFrac") realToFracIdKey
+rationalTyConName   = tcQual  gHC_REAL (fsLit "Rational")     rationalTyConKey
+ratioTyConName      = tcQual  gHC_REAL (fsLit "Ratio")        ratioTyConKey
+ratioDataConName    = conName gHC_REAL (fsLit ":%")           ratioDataConKey
+realClassName       = clsQual gHC_REAL (fsLit "Real")         realClassKey
+integralClassName   = clsQual gHC_REAL (fsLit "Integral")     integralClassKey
+realFracClassName   = clsQual gHC_REAL (fsLit "RealFrac")     realFracClassKey
+fractionalClassName = clsQual gHC_REAL (fsLit "Fractional")   fractionalClassKey
+fromRationalName    = varQual gHC_REAL (fsLit "fromRational") fromRationalClassOpKey
+toIntegerName       = varQual gHC_REAL (fsLit "toInteger")    toIntegerClassOpKey
+toRationalName      = varQual gHC_REAL (fsLit "toRational")   toRationalClassOpKey
+fromIntegralName    = varQual  gHC_REAL (fsLit "fromIntegral")fromIntegralIdKey
+realToFracName      = varQual  gHC_REAL (fsLit "realToFrac")  realToFracIdKey
 
 -- PrelFloat classes
 floatingClassName, realFloatClassName :: Name
-floatingClassName  = clsQual  gHC_FLOAT (fsLit "Floating") floatingClassKey
-realFloatClassName = clsQual  gHC_FLOAT (fsLit "RealFloat") realFloatClassKey
+floatingClassName  = clsQual gHC_FLOAT (fsLit "Floating")  floatingClassKey
+realFloatClassName = clsQual gHC_FLOAT (fsLit "RealFloat") realFloatClassKey
 
 -- other GHC.Float functions
 rationalToFloatName, rationalToDoubleName :: Name
@@ -994,7 +1020,7 @@ typeableClassName,
     oldTypeableClassName, oldTypeable1ClassName, oldTypeable2ClassName,
     oldTypeable3ClassName, oldTypeable4ClassName, oldTypeable5ClassName,
     oldTypeable6ClassName, oldTypeable7ClassName :: Name
-typeableClassName  = clsQual tYPEABLE_INTERNAL (fsLit "Typeable")  typeableClassKey
+typeableClassName     = clsQual tYPEABLE_INTERNAL    (fsLit "Typeable")  typeableClassKey
 oldTypeableClassName  = clsQual oLDTYPEABLE_INTERNAL (fsLit "Typeable")  oldTypeableClassKey
 oldTypeable1ClassName = clsQual oLDTYPEABLE_INTERNAL (fsLit "Typeable1") oldTypeable1ClassKey
 oldTypeable2ClassName = clsQual oLDTYPEABLE_INTERNAL (fsLit "Typeable2") oldTypeable2ClassKey
@@ -1020,33 +1046,33 @@ assertErrorName   = varQual gHC_IO_Exception (fsLit "assertError") assertErrorId
 -- Enum module (Enum, Bounded)
 enumClassName, enumFromName, enumFromToName, enumFromThenName,
     enumFromThenToName, boundedClassName :: Name
-enumClassName      = clsQual gHC_ENUM (fsLit "Enum") enumClassKey
-enumFromName       = methName gHC_ENUM (fsLit "enumFrom") enumFromClassOpKey
-enumFromToName     = methName gHC_ENUM (fsLit "enumFromTo") enumFromToClassOpKey
-enumFromThenName   = methName gHC_ENUM (fsLit "enumFromThen") enumFromThenClassOpKey
-enumFromThenToName = methName gHC_ENUM (fsLit "enumFromThenTo") enumFromThenToClassOpKey
-boundedClassName   = clsQual gHC_ENUM (fsLit "Bounded") boundedClassKey
+enumClassName      = clsQual gHC_ENUM (fsLit "Enum")           enumClassKey
+enumFromName       = varQual gHC_ENUM (fsLit "enumFrom")       enumFromClassOpKey
+enumFromToName     = varQual gHC_ENUM (fsLit "enumFromTo")     enumFromToClassOpKey
+enumFromThenName   = varQual gHC_ENUM (fsLit "enumFromThen")   enumFromThenClassOpKey
+enumFromThenToName = varQual gHC_ENUM (fsLit "enumFromThenTo") enumFromThenToClassOpKey
+boundedClassName   = clsQual gHC_ENUM (fsLit "Bounded")        boundedClassKey
 
 -- List functions
 concatName, filterName, zipName :: Name
 concatName        = varQual gHC_LIST (fsLit "concat") concatIdKey
 filterName        = varQual gHC_LIST (fsLit "filter") filterIdKey
-zipName           = varQual gHC_LIST (fsLit "zip") zipIdKey
+zipName           = varQual gHC_LIST (fsLit "zip")    zipIdKey
 
 -- Overloaded lists
 isListClassName, fromListName, fromListNName, toListName :: Name
-isListClassName = clsQual gHC_EXTS (fsLit "IsList") isListClassKey
-fromListName = methName gHC_EXTS (fsLit "fromList") fromListClassOpKey
-fromListNName = methName gHC_EXTS (fsLit "fromListN") fromListNClassOpKey
-toListName = methName gHC_EXTS (fsLit "toList") toListClassOpKey
+isListClassName = clsQual gHC_EXTS (fsLit "IsList")    isListClassKey
+fromListName    = varQual gHC_EXTS (fsLit "fromList")  fromListClassOpKey
+fromListNName   = varQual gHC_EXTS (fsLit "fromListN") fromListNClassOpKey
+toListName      = varQual gHC_EXTS (fsLit "toList")    toListClassOpKey
 
 -- Class Show
 showClassName :: Name
-showClassName     = clsQual gHC_SHOW (fsLit "Show")       showClassKey
+showClassName   = clsQual gHC_SHOW (fsLit "Show")      showClassKey
 
 -- Class Read
 readClassName :: Name
-readClassName      = clsQual gHC_READ (fsLit "Read") readClassKey
+readClassName   = clsQual gHC_READ (fsLit "Read")      readClassKey
 
 -- Classes Generic and Generic1, Datatype, Constructor and Selector
 genClassName, gen1ClassName, datatypeClassName, constructorClassName,
@@ -1054,24 +1080,27 @@ genClassName, gen1ClassName, datatypeClassName, constructorClassName,
 genClassName  = clsQual gHC_GENERICS (fsLit "Generic")  genClassKey
 gen1ClassName = clsQual gHC_GENERICS (fsLit "Generic1") gen1ClassKey
 
-datatypeClassName = clsQual gHC_GENERICS (fsLit "Datatype") datatypeClassKey
+datatypeClassName    = clsQual gHC_GENERICS (fsLit "Datatype")    datatypeClassKey
 constructorClassName = clsQual gHC_GENERICS (fsLit "Constructor") constructorClassKey
-selectorClassName = clsQual gHC_GENERICS (fsLit "Selector") selectorClassKey
+selectorClassName    = clsQual gHC_GENERICS (fsLit "Selector")    selectorClassKey
+
+genericClassNames :: [Name]
+genericClassNames = [genClassName, gen1ClassName]
 
 -- GHCi things
 ghciIoClassName, ghciStepIoMName :: Name
 ghciIoClassName = clsQual gHC_GHCI (fsLit "GHCiSandboxIO") ghciIoClassKey
-ghciStepIoMName = methName gHC_GHCI (fsLit "ghciStepIO") ghciStepIoMClassOpKey
+ghciStepIoMName = varQual gHC_GHCI (fsLit "ghciStepIO") ghciStepIoMClassOpKey
 
 -- IO things
 ioTyConName, ioDataConName, thenIOName, bindIOName, returnIOName,
     failIOName :: Name
-ioTyConName       = tcQual  gHC_TYPES (fsLit "IO") ioTyConKey
-ioDataConName     = conName gHC_TYPES (fsLit "IO") ioDataConKey
-thenIOName        = varQual gHC_BASE (fsLit "thenIO") thenIOIdKey
-bindIOName        = varQual gHC_BASE (fsLit "bindIO") bindIOIdKey
-returnIOName      = varQual gHC_BASE (fsLit "returnIO") returnIOIdKey
-failIOName        = varQual gHC_IO (fsLit "failIO") failIOIdKey
+ioTyConName       = tcQual  gHC_TYPES (fsLit "IO")       ioTyConKey
+ioDataConName     = conName gHC_TYPES (fsLit "IO")       ioDataConKey
+thenIOName        = varQual gHC_BASE  (fsLit "thenIO")   thenIOIdKey
+bindIOName        = varQual gHC_BASE  (fsLit "bindIO")   bindIOIdKey
+returnIOName      = varQual gHC_BASE  (fsLit "returnIO") returnIOIdKey
+failIOName        = varQual gHC_IO    (fsLit "failIO")   failIOIdKey
 
 -- IO things
 printName :: Name
@@ -1079,7 +1108,7 @@ printName         = varQual sYSTEM_IO (fsLit "print") printIdKey
 
 -- Int, Word, and Addr things
 int8TyConName, int16TyConName, int32TyConName, int64TyConName :: Name
-int8TyConName     = tcQual gHC_INT  (fsLit "Int8") int8TyConKey
+int8TyConName     = tcQual gHC_INT  (fsLit "Int8")  int8TyConKey
 int16TyConName    = tcQual gHC_INT  (fsLit "Int16") int16TyConKey
 int32TyConName    = tcQual gHC_INT  (fsLit "Int32") int32TyConKey
 int64TyConName    = tcQual gHC_INT  (fsLit "Int64") int64TyConKey
@@ -1093,12 +1122,12 @@ word64TyConName   = tcQual  gHC_WORD (fsLit "Word64") word64TyConKey
 
 -- PrelPtr module
 ptrTyConName, funPtrTyConName :: Name
-ptrTyConName      = tcQual   gHC_PTR (fsLit "Ptr") ptrTyConKey
+ptrTyConName      = tcQual   gHC_PTR (fsLit "Ptr")    ptrTyConKey
 funPtrTyConName   = tcQual   gHC_PTR (fsLit "FunPtr") funPtrTyConKey
 
 -- Foreign objects and weak pointers
 stablePtrTyConName, newStablePtrName :: Name
-stablePtrTyConName    = tcQual   gHC_STABLE (fsLit "StablePtr") stablePtrTyConKey
+stablePtrTyConName    = tcQual   gHC_STABLE (fsLit "StablePtr")    stablePtrTyConKey
 newStablePtrName      = varQual  gHC_STABLE (fsLit "newStablePtr") newStablePtrIdKey
 
 -- PrelST module
@@ -1108,21 +1137,21 @@ runSTRepName       = varQual gHC_ST  (fsLit "runSTRep") runSTRepIdKey
 -- Recursive-do notation
 monadFixClassName, mfixName :: Name
 monadFixClassName  = clsQual mONAD_FIX (fsLit "MonadFix") monadFixClassKey
-mfixName           = methName mONAD_FIX (fsLit "mfix") mfixIdKey
+mfixName           = varQual mONAD_FIX (fsLit "mfix")     mfixIdKey
 
 -- Arrow notation
 arrAName, composeAName, firstAName, appAName, choiceAName, loopAName :: Name
-arrAName           = varQual aRROW (fsLit "arr")          arrAIdKey
+arrAName           = varQual aRROW (fsLit "arr")       arrAIdKey
 composeAName       = varQual gHC_DESUGAR (fsLit ">>>") composeAIdKey
-firstAName         = varQual aRROW (fsLit "first") firstAIdKey
-appAName           = varQual aRROW (fsLit "app")          appAIdKey
-choiceAName        = varQual aRROW (fsLit "|||")          choiceAIdKey
-loopAName          = varQual aRROW (fsLit "loop")  loopAIdKey
+firstAName         = varQual aRROW (fsLit "first")     firstAIdKey
+appAName           = varQual aRROW (fsLit "app")       appAIdKey
+choiceAName        = varQual aRROW (fsLit "|||")       choiceAIdKey
+loopAName          = varQual aRROW (fsLit "loop")      loopAIdKey
 
 -- Monad comprehensions
 guardMName, liftMName, mzipName :: Name
-guardMName         = varQual mONAD (fsLit "guard") guardMIdKey
-liftMName          = varQual mONAD (fsLit "liftM") liftMIdKey
+guardMName         = varQual mONAD (fsLit "guard")    guardMIdKey
+liftMName          = varQual mONAD (fsLit "liftM")    liftMIdKey
 mzipName           = varQual mONAD_ZIP (fsLit "mzip") mzipIdKey
 
 
@@ -1133,9 +1162,9 @@ toAnnotationWrapperName = varQual gHC_DESUGAR (fsLit "toAnnotationWrapper") toAn
 -- Other classes, needed for type defaulting
 monadPlusClassName, randomClassName, randomGenClassName,
     isStringClassName :: Name
-monadPlusClassName  = clsQual mONAD (fsLit "MonadPlus")  monadPlusClassKey
-randomClassName     = clsQual rANDOM (fsLit "Random")    randomClassKey
-randomGenClassName  = clsQual rANDOM (fsLit "RandomGen") randomGenClassKey
+monadPlusClassName  = clsQual mONAD (fsLit "MonadPlus")      monadPlusClassKey
+randomClassName     = clsQual rANDOM (fsLit "Random")        randomClassKey
+randomGenClassName  = clsQual rANDOM (fsLit "RandomGen")     randomGenClassKey
 isStringClassName   = clsQual dATA_STRING (fsLit "IsString") isStringClassKey
 
 -- Type-level naturals
@@ -1191,10 +1220,6 @@ mk_known_key_name space modu str unique
 conName :: Module -> FastString -> Unique -> Name
 conName modu occ unique
   = mkExternalName unique modu (mkOccNameFS dataName occ) noSrcSpan
-
-methName :: Module -> FastString -> Unique -> Name
-methName modu occ unique
-  = mkExternalName unique modu (mkVarOccFS occ) noSrcSpan
 \end{code}
 
 %************************************************************************
@@ -1303,12 +1328,13 @@ addrPrimTyConKey, arrayPrimTyConKey, arrayArrayPrimTyConKey, boolTyConKey, byteA
     floatPrimTyConKey, floatTyConKey, funTyConKey, intPrimTyConKey,
     intTyConKey, int8TyConKey, int16TyConKey, int32PrimTyConKey,
     int32TyConKey, int64PrimTyConKey, int64TyConKey,
-    integerTyConKey, digitsTyConKey,
+    integerTyConKey,
     listTyConKey, foreignObjPrimTyConKey, weakPrimTyConKey,
     mutableArrayPrimTyConKey, mutableArrayArrayPrimTyConKey, mutableByteArrayPrimTyConKey,
     orderingTyConKey, mVarPrimTyConKey, ratioTyConKey, rationalTyConKey,
     realWorldTyConKey, stablePtrPrimTyConKey, stablePtrTyConKey,
-    anyTyConKey, eqTyConKey :: Unique
+    anyTyConKey, eqTyConKey, smallArrayPrimTyConKey,
+    smallMutableArrayPrimTyConKey :: Unique
 addrPrimTyConKey                        = mkPreludeTyConUnique  1
 arrayPrimTyConKey                       = mkPreludeTyConUnique  3
 boolTyConKey                            = mkPreludeTyConUnique  4
@@ -1329,7 +1355,7 @@ int32TyConKey                           = mkPreludeTyConUnique 19
 int64PrimTyConKey                       = mkPreludeTyConUnique 20
 int64TyConKey                           = mkPreludeTyConUnique 21
 integerTyConKey                         = mkPreludeTyConUnique 22
-digitsTyConKey                          = mkPreludeTyConUnique 23
+
 listTyConKey                            = mkPreludeTyConUnique 24
 foreignObjPrimTyConKey                  = mkPreludeTyConUnique 25
 weakPrimTyConKey                        = mkPreludeTyConUnique 27
@@ -1475,6 +1501,7 @@ rep1TyConKey = mkPreludeTyConUnique 156
 typeNatKindConNameKey, typeSymbolKindConNameKey,
   typeNatAddTyFamNameKey, typeNatMulTyFamNameKey, typeNatExpTyFamNameKey,
   typeNatLeqTyFamNameKey, typeNatSubTyFamNameKey
+  , typeSymbolCmpTyFamNameKey, typeNatCmpTyFamNameKey
   :: Unique
 typeNatKindConNameKey     = mkPreludeTyConUnique 160
 typeSymbolKindConNameKey  = mkPreludeTyConUnique 161
@@ -1483,6 +1510,8 @@ typeNatMulTyFamNameKey    = mkPreludeTyConUnique 163
 typeNatExpTyFamNameKey    = mkPreludeTyConUnique 164
 typeNatLeqTyFamNameKey    = mkPreludeTyConUnique 165
 typeNatSubTyFamNameKey    = mkPreludeTyConUnique 166
+typeSymbolCmpTyFamNameKey = mkPreludeTyConUnique 167
+typeNatCmpTyFamNameKey    = mkPreludeTyConUnique 168
 
 ntTyConKey:: Unique
 ntTyConKey = mkPreludeTyConUnique 174
@@ -1495,6 +1524,9 @@ proxyPrimTyConKey = mkPreludeTyConUnique 176
 specTyConKey :: Unique
 specTyConKey = mkPreludeTyConUnique 177
 
+smallArrayPrimTyConKey        = mkPreludeTyConUnique  178
+smallMutableArrayPrimTyConKey = mkPreludeTyConUnique  179
+
 ---------------- Template Haskell -------------------
 --      USES TyConUniques 200-299
 -----------------------------------------------------
diff --git a/compiler/prelude/PrelRules.lhs b/compiler/prelude/PrelRules.lhs
index 11367edfecd2..d2e648f38247 100644
--- a/compiler/prelude/PrelRules.lhs
+++ b/compiler/prelude/PrelRules.lhs
@@ -12,8 +12,8 @@ ToDo:
    (i1 + i2) only if it results in a valid Float.
 
 \begin{code}
-{-# LANGUAGE RankNTypes #-}
-{-# OPTIONS -optc-DNON_POSIX_SOURCE #-}
+{-# LANGUAGE CPP, RankNTypes #-}
+{-# OPTIONS_GHC -optc-DNON_POSIX_SOURCE #-}
 
 module PrelRules ( primOpRules, builtinRules ) where
 
@@ -111,6 +111,8 @@ primOpRules nm OrIOp       = mkPrimOpRule nm 2 [ binaryLit (intOp2 (.|.))
 primOpRules nm XorIOp      = mkPrimOpRule nm 2 [ binaryLit (intOp2 xor)
                                                , identityDynFlags zeroi
                                                , equalArgs >> retLit zeroi ]
+primOpRules nm NotIOp      = mkPrimOpRule nm 1 [ unaryLit complementOp
+                                               , inversePrimOp NotIOp ]
 primOpRules nm IntNegOp    = mkPrimOpRule nm 1 [ unaryLit negOp
                                                , inversePrimOp IntNegOp ]
 primOpRules nm ISllOp      = mkPrimOpRule nm 2 [ binaryLit (intOp2 Bits.shiftL)
@@ -141,6 +143,8 @@ primOpRules nm OrOp        = mkPrimOpRule nm 2 [ binaryLit (wordOp2 (.|.))
 primOpRules nm XorOp       = mkPrimOpRule nm 2 [ binaryLit (wordOp2 xor)
                                                , identityDynFlags zerow
                                                , equalArgs >> retLit zerow ]
+primOpRules nm NotOp       = mkPrimOpRule nm 1 [ unaryLit complementOp
+                                               , inversePrimOp NotOp ]
 primOpRules nm SllOp       = mkPrimOpRule nm 2 [ wordShiftRule Bits.shiftL ]
 primOpRules nm SrlOp       = mkPrimOpRule nm 2 [ wordShiftRule shiftRightLogical ]
 
@@ -345,6 +349,11 @@ negOp dflags (MachDouble d)   = Just (mkDoubleVal dflags (-d))
 negOp dflags (MachInt i)      = intResult dflags (-i)
 negOp _      _                = Nothing
 
+complementOp :: DynFlags -> Literal -> Maybe CoreExpr  -- Binary complement
+complementOp dflags (MachWord i) = wordResult dflags (complement i)
+complementOp dflags (MachInt i)  = intResult  dflags (complement i)
+complementOp _      _            = Nothing
+
 --------------------------
 intOp2 :: (Integral a, Integral b)
        => (a -> b -> Integer)
diff --git a/compiler/prelude/PrimOp.lhs b/compiler/prelude/PrimOp.lhs
index 12f71c22303d..198078bc9f4e 100644
--- a/compiler/prelude/PrimOp.lhs
+++ b/compiler/prelude/PrimOp.lhs
@@ -4,6 +4,8 @@
 \section[PrimOp]{Primitive operations (machine-level)}
 
 \begin{code}
+{-# LANGUAGE CPP #-}
+
 module PrimOp (
         PrimOp(..), PrimOpVecCat(..), allThePrimOps,
         primOpType, primOpSig,
@@ -38,7 +40,7 @@ import Unique           ( Unique, mkPrimOpIdUnique )
 import Outputable
 import FastTypes
 import FastString
-import Module           ( PackageId )
+import Module           ( PackageKey )
 \end{code}
 
 %************************************************************************
@@ -327,27 +329,89 @@ Note [PrimOp can_fail and has_side_effects]
 Both can_fail and has_side_effects mean that the primop has
 some effect that is not captured entirely by its result value.
 
-   ----------  has_side_effects ---------------------
-   Has some imperative side effect, perhaps on the world (I/O),
-   or perhaps on some mutable data structure (writeIORef).
-   Generally speaking all such primops have a type like
-      State -> input -> (State, output)
-   so the state token guarantees ordering, and also ensures
-   that the primop is executed even if 'output' is discarded.
-
-   ----------  can_fail ----------------------------
-   Can fail with a seg-fault or divide-by-zero error on some elements
-   of its input domain.  Main examples:
-      division (fails on zero demoninator
-      array indexing (fails if the index is out of bounds)
-   However (ASSUMPTION), these can_fail primops are ALWAYS surrounded
-   with a test that checks for the bad cases.  
-
-Consequences:
-
-* You can discard a can_fail primop, or float it _inwards_.
-  But you cannot float it _outwards_, lest you escape the
-  dynamic scope of the test.  Example:
+----------  has_side_effects ---------------------
+A primop "has_side_effects" if it has some *write* effect, visible
+elsewhere
+    - writing to the world (I/O)
+    - writing to a mutable data structure (writeIORef)
+    - throwing a synchronous Haskell exception
+
+Often such primops have a type like
+   State -> input -> (State, output)
+so the state token guarantees ordering.  In general we rely *only* on
+data dependencies of the state token to enforce write-effect ordering
+
+ * NB1: if you inline unsafePerformIO, you may end up with
+   side-effecting ops whose 'state' output is discarded.
+   And programmers may do that by hand; see Trac #9390.
+   That is why we (conservatively) do not discard write-effecting
+   primops even if both their state and result is discarded.
+
+ * NB2: We consider primops, such as raiseIO#, that can raise a
+   (Haskell) synchronous exception to "have_side_effects" but not
+   "can_fail".  We must be careful about not discarding such things;
+   see the paper "A semantics for imprecise exceptions".
+
+ * NB3: *Read* effects (like reading an IORef) don't count here,
+   because it doesn't matter if we don't do them, or do them more than
+   once.  *Sequencing* is maintained by the data dependency of the state
+   token.
+
+----------  can_fail ----------------------------
+A primop "can_fail" if it can fail with an *unchecked* exception on
+some elements of its input domain. Main examples:
+   division (fails on zero demoninator)
+   array indexing (fails if the index is out of bounds)
+
+An "unchecked exception" is one that is an outright error, (not
+turned into a Haskell exception,) such as seg-fault or
+divide-by-zero error.  Such can_fail primops are ALWAYS surrounded
+with a test that checks for the bad cases, but we need to be
+very careful about code motion that might move it out of
+the scope of the test.
+
+Note [Transformations affected by can_fail and has_side_effects]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+The can_fail and has_side_effects properties have the following effect
+on program transformations.  Summary table is followed by details.
+
+            can_fail     has_side_effects
+Discard        NO            NO
+Float in       YES           YES
+Float out      NO            NO
+Duplicate      YES           NO
+
+* Discarding.   case (a `op` b) of _ -> rhs  ===>   rhs
+  You should not discard a has_side_effects primop; e.g.
+     case (writeIntArray# a i v s of (# _, _ #) -> True
+  Arguably you should be able to discard this, since the
+  returned stat token is not used, but that relies on NEVER
+  inlining unsafePerformIO, and programmers sometimes write
+  this kind of stuff by hand (Trac #9390).  So we (conservatively)
+  never discard a has_side_effects primop.
+
+  However, it's fine to discard a can_fail primop.  For example
+     case (indexIntArray# a i) of _ -> True
+  We can discard indexIntArray#; it has can_fail, but not
+  has_side_effects; see Trac #5658 which was all about this.
+  Notice that indexIntArray# is (in a more general handling of
+  effects) read effect, but we don't care about that here, and
+  treat read effects as *not* has_side_effects.
+
+  Similarly (a `/#` b) can be discarded.  It can seg-fault or
+  cause a hardware exception, but not a synchronous Haskell
+  exception.
+
+
+
+  Synchronous Haskell exceptions, e.g. from raiseIO#, are treated
+  as has_side_effects and hence are not discarded.
+
+* Float in.  You can float a can_fail or has_side_effects primop
+  *inwards*, but not inside a lambda (see Duplication below).
+
+* Float out.  You must not float a can_fail primop *outwards* lest
+  you escape the dynamic scope of the test.  Example:
       case d ># 0# of
         True  -> case x /# d of r -> r +# 1
         False -> 0
@@ -357,25 +421,21 @@ Consequences:
         True  -> r +# 1
         False -> 0
 
-* I believe that exactly the same rules apply to a has_side_effects
-  primop; you can discard it (remember, the state token will keep
-  it alive if necessary), or float it in, but not float it out.
-
-  Example of the latter
-       if blah then let! s1 = writeMutVar s0 v True in s1
+  Nor can you float out a has_side_effects primop.  For example:
+       if blah then case writeMutVar# v True s0 of (# s1 #) -> s1
                else s0
-  Notice that s0 is mentioned in both branches of the 'if', but 
+  Notice that s0 is mentioned in both branches of the 'if', but
   only one of these two will actually be consumed.  But if we
   float out to
-      let! s1 = writeMutVar s0 v True
-      in if blah then s1 else s0
+      case writeMutVar# v True s0 of (# s1 #) ->
+      if blah then s1 else s0
   the writeMutVar will be performed in both branches, which is
   utterly wrong.
 
-* You cannot duplicate a has_side_effect primop.  You might wonder
-  how this can occur given the state token threading, but just look
-  at Control.Monad.ST.Lazy.Imp.strictToLazy!  We get something like
-  this
+* Duplication.  You cannot duplicate a has_side_effect primop.  You
+  might wonder how this can occur given the state token threading, but
+  just look at Control.Monad.ST.Lazy.Imp.strictToLazy!  We get
+  something like this
         p = case readMutVar# s v of
               (# s', r #) -> (S# s', r)
         s' = case p of (s', r) -> s'
@@ -383,28 +443,28 @@ Consequences:
 
   (All these bindings are boxed.)  If we inline p at its two call
   sites, we get a catastrophe: because the read is performed once when
-  s' is demanded, and once when 'r' is demanded, which may be much 
+  s' is demanded, and once when 'r' is demanded, which may be much
   later.  Utterly wrong.  Trac #3207 is real example of this happening.
 
-  However, it's fine to duplicate a can_fail primop.  That is
-  the difference between can_fail and has_side_effects.
+  However, it's fine to duplicate a can_fail primop.  That is really
+  the only difference between can_fail and has_side_effects.
 
-            can_fail     has_side_effects
-Discard        YES           YES
-Float in       YES           YES
-Float out      NO            NO
-Duplicate      YES           NO
+Note [Implementation: how can_fail/has_side_effects affect transformations]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+How do we ensure that that floating/duplication/discarding are done right
+in the simplifier?
 
-How do we achieve these effects?
+Two main predicates on primpops test these flags:
+  primOpOkForSideEffects <=> not has_side_effects
+  primOpOkForSpeculation <=> not (has_side_effects || can_fail)
 
-Note [primOpOkForSpeculation]
   * The "no-float-out" thing is achieved by ensuring that we never
     let-bind a can_fail or has_side_effects primop.  The RHS of a
     let-binding (which can float in and out freely) satisfies
-    exprOkForSpeculation.  And exprOkForSpeculation is false of
-    can_fail and no_side_effect.
+    exprOkForSpeculation; this is the let/app invariant.  And
+    exprOkForSpeculation is false of can_fail and has_side_effects.
 
-  * So can_fail and no_side_effect primops will appear only as the
+  * So can_fail and has_side_effects primops will appear only as the
     scrutinees of cases, and that's why the FloatIn pass is capable
     of floating case bindings inwards.
 
@@ -420,10 +480,14 @@ primOpCanFail :: PrimOp -> Bool
 #include "primop-can-fail.hs-incl"
 
 primOpOkForSpeculation :: PrimOp -> Bool
-  -- See Note [primOpOkForSpeculation and primOpOkForFloatOut]
+  -- See Note [PrimOp can_fail and has_side_effects]
   -- See comments with CoreUtils.exprOkForSpeculation
+  -- primOpOkForSpeculation => primOpOkForSideEffects
 primOpOkForSpeculation op
-  = not (primOpHasSideEffects op || primOpOutOfLine op || primOpCanFail op)
+  =  primOpOkForSideEffects op
+  && not (primOpOutOfLine op || primOpCanFail op)
+    -- I think the "out of line" test is because out of line things can
+    -- be expensive (eg sine, cosine), and so we may not want to speculate them
 
 primOpOkForSideEffects :: PrimOp -> Bool
 primOpOkForSideEffects op
@@ -441,6 +505,7 @@ behaviour of 'seq' for primops that can fail, so we don't treat them as cheap.
 
 \begin{code}
 primOpIsCheap :: PrimOp -> Bool
+-- See Note [PrimOp can_fail and has_side_effects]
 primOpIsCheap op = primOpOkForSpeculation op
 -- In March 2001, we changed this to
 --      primOpIsCheap op = False
@@ -585,7 +650,7 @@ pprPrimOp other_op = pprOccName (primOpOcc other_op)
 %************************************************************************
 
 \begin{code}
-data PrimCall = PrimCall CLabelString PackageId
+data PrimCall = PrimCall CLabelString PackageKey
 
 instance Outputable PrimCall where
   ppr (PrimCall lbl pkgId)
diff --git a/compiler/prelude/TysPrim.lhs b/compiler/prelude/TysPrim.lhs
index bbe5aba119dd..de151fd92f5c 100644
--- a/compiler/prelude/TysPrim.lhs
+++ b/compiler/prelude/TysPrim.lhs
@@ -6,7 +6,8 @@
 \section[TysPrim]{Wired-in knowledge about primitive types}
 
 \begin{code}
-{-# OPTIONS -fno-warn-tabs #-}
+{-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
 -- The above warning supression flag is a temporary kludge.
 -- While working on this module you are encouraged to remove it and
 -- detab the module (please do the detabbing in a separate patch). See
@@ -54,9 +55,11 @@ module TysPrim(
 	arrayPrimTyCon,	mkArrayPrimTy, 
 	byteArrayPrimTyCon,	byteArrayPrimTy,
 	arrayArrayPrimTyCon, mkArrayArrayPrimTy, 
+	smallArrayPrimTyCon, mkSmallArrayPrimTy,
 	mutableArrayPrimTyCon, mkMutableArrayPrimTy,
 	mutableByteArrayPrimTyCon, mkMutableByteArrayPrimTy,
 	mutableArrayArrayPrimTyCon, mkMutableArrayArrayPrimTy,
+	smallMutableArrayPrimTyCon, mkSmallMutableArrayPrimTy,
 	mutVarPrimTyCon, mkMutVarPrimTy,
 
 	mVarPrimTyCon,			mkMVarPrimTy,	
@@ -111,6 +114,7 @@ primTyCons
     , arrayPrimTyCon
     , byteArrayPrimTyCon
     , arrayArrayPrimTyCon
+    , smallArrayPrimTyCon
     , charPrimTyCon
     , doublePrimTyCon
     , floatPrimTyCon
@@ -122,6 +126,7 @@ primTyCons
     , mutableArrayPrimTyCon
     , mutableByteArrayPrimTyCon
     , mutableArrayArrayPrimTyCon
+    , smallMutableArrayPrimTyCon
     , mVarPrimTyCon
     , tVarPrimTyCon
     , mutVarPrimTyCon
@@ -154,9 +159,17 @@ mkPrimTc fs unique tycon
   = mkWiredInName gHC_PRIM (mkTcOccFS fs) 
 		  unique
 		  (ATyCon tycon)	-- Relevant TyCon
-		  UserSyntax		-- None are built-in syntax
+		  UserSyntax
 
-charPrimTyConName, intPrimTyConName, int32PrimTyConName, int64PrimTyConName, wordPrimTyConName, word32PrimTyConName, word64PrimTyConName, addrPrimTyConName, floatPrimTyConName, doublePrimTyConName, statePrimTyConName, proxyPrimTyConName, realWorldTyConName, arrayPrimTyConName, arrayArrayPrimTyConName, byteArrayPrimTyConName, mutableArrayPrimTyConName, mutableByteArrayPrimTyConName, mutableArrayArrayPrimTyConName, mutVarPrimTyConName, mVarPrimTyConName, tVarPrimTyConName, stablePtrPrimTyConName, stableNamePrimTyConName, bcoPrimTyConName, weakPrimTyConName, threadIdPrimTyConName, eqPrimTyConName, eqReprPrimTyConName, voidPrimTyConName :: Name
+mkBuiltInPrimTc :: FastString -> Unique -> TyCon -> Name
+mkBuiltInPrimTc fs unique tycon
+  = mkWiredInName gHC_PRIM (mkTcOccFS fs) 
+		  unique
+		  (ATyCon tycon)	-- Relevant TyCon
+		  BuiltInSyntax
+
+
+charPrimTyConName, intPrimTyConName, int32PrimTyConName, int64PrimTyConName, wordPrimTyConName, word32PrimTyConName, word64PrimTyConName, addrPrimTyConName, floatPrimTyConName, doublePrimTyConName, statePrimTyConName, proxyPrimTyConName, realWorldTyConName, arrayPrimTyConName, arrayArrayPrimTyConName, smallArrayPrimTyConName, byteArrayPrimTyConName, mutableArrayPrimTyConName, mutableByteArrayPrimTyConName, mutableArrayArrayPrimTyConName, smallMutableArrayPrimTyConName, mutVarPrimTyConName, mVarPrimTyConName, tVarPrimTyConName, stablePtrPrimTyConName, stableNamePrimTyConName, bcoPrimTyConName, weakPrimTyConName, threadIdPrimTyConName, eqPrimTyConName, eqReprPrimTyConName, voidPrimTyConName :: Name
 charPrimTyConName    	      = mkPrimTc (fsLit "Char#") charPrimTyConKey charPrimTyCon
 intPrimTyConName     	      = mkPrimTc (fsLit "Int#") intPrimTyConKey  intPrimTyCon
 int32PrimTyConName	      = mkPrimTc (fsLit "Int32#") int32PrimTyConKey int32PrimTyCon
@@ -171,14 +184,16 @@ statePrimTyConName            = mkPrimTc (fsLit "State#") statePrimTyConKey stat
 voidPrimTyConName             = mkPrimTc (fsLit "Void#") voidPrimTyConKey voidPrimTyCon
 proxyPrimTyConName            = mkPrimTc (fsLit "Proxy#") proxyPrimTyConKey proxyPrimTyCon
 eqPrimTyConName               = mkPrimTc (fsLit "~#") eqPrimTyConKey eqPrimTyCon
-eqReprPrimTyConName           = mkPrimTc (fsLit "~R#") eqReprPrimTyConKey eqReprPrimTyCon
+eqReprPrimTyConName           = mkBuiltInPrimTc (fsLit "~R#") eqReprPrimTyConKey eqReprPrimTyCon
 realWorldTyConName            = mkPrimTc (fsLit "RealWorld") realWorldTyConKey realWorldTyCon
 arrayPrimTyConName   	      = mkPrimTc (fsLit "Array#") arrayPrimTyConKey arrayPrimTyCon
 byteArrayPrimTyConName	      = mkPrimTc (fsLit "ByteArray#") byteArrayPrimTyConKey byteArrayPrimTyCon
 arrayArrayPrimTyConName   	  = mkPrimTc (fsLit "ArrayArray#") arrayArrayPrimTyConKey arrayArrayPrimTyCon
+smallArrayPrimTyConName       = mkPrimTc (fsLit "SmallArray#") smallArrayPrimTyConKey smallArrayPrimTyCon
 mutableArrayPrimTyConName     = mkPrimTc (fsLit "MutableArray#") mutableArrayPrimTyConKey mutableArrayPrimTyCon
 mutableByteArrayPrimTyConName = mkPrimTc (fsLit "MutableByteArray#") mutableByteArrayPrimTyConKey mutableByteArrayPrimTyCon
 mutableArrayArrayPrimTyConName= mkPrimTc (fsLit "MutableArrayArray#") mutableArrayArrayPrimTyConKey mutableArrayArrayPrimTyCon
+smallMutableArrayPrimTyConName= mkPrimTc (fsLit "SmallMutableArray#") smallMutableArrayPrimTyConKey smallMutableArrayPrimTyCon
 mutVarPrimTyConName	      = mkPrimTc (fsLit "MutVar#") mutVarPrimTyConKey mutVarPrimTyCon
 mVarPrimTyConName	      = mkPrimTc (fsLit "MVar#") mVarPrimTyConKey mVarPrimTyCon
 tVarPrimTyConName	      = mkPrimTc (fsLit "TVar#") tVarPrimTyConKey tVarPrimTyCon
@@ -538,13 +553,16 @@ defined in \tr{TysWiredIn.lhs}, not here.
 
 \begin{code}
 arrayPrimTyCon, mutableArrayPrimTyCon, mutableByteArrayPrimTyCon,
-    byteArrayPrimTyCon, arrayArrayPrimTyCon, mutableArrayArrayPrimTyCon :: TyCon
+    byteArrayPrimTyCon, arrayArrayPrimTyCon, mutableArrayArrayPrimTyCon,
+    smallArrayPrimTyCon, smallMutableArrayPrimTyCon :: TyCon
 arrayPrimTyCon             = pcPrimTyCon arrayPrimTyConName             [Representational] PtrRep
 mutableArrayPrimTyCon      = pcPrimTyCon  mutableArrayPrimTyConName     [Nominal, Representational] PtrRep
 mutableByteArrayPrimTyCon  = pcPrimTyCon mutableByteArrayPrimTyConName  [Nominal] PtrRep
 byteArrayPrimTyCon         = pcPrimTyCon0 byteArrayPrimTyConName        PtrRep
 arrayArrayPrimTyCon        = pcPrimTyCon0 arrayArrayPrimTyConName       PtrRep
 mutableArrayArrayPrimTyCon = pcPrimTyCon mutableArrayArrayPrimTyConName [Nominal] PtrRep
+smallArrayPrimTyCon        = pcPrimTyCon smallArrayPrimTyConName        [Representational] PtrRep
+smallMutableArrayPrimTyCon = pcPrimTyCon smallMutableArrayPrimTyConName [Nominal, Representational] PtrRep
 
 mkArrayPrimTy :: Type -> Type
 mkArrayPrimTy elt    	    = TyConApp arrayPrimTyCon [elt]
@@ -552,12 +570,16 @@ byteArrayPrimTy :: Type
 byteArrayPrimTy	    	    = mkTyConTy byteArrayPrimTyCon
 mkArrayArrayPrimTy :: Type
 mkArrayArrayPrimTy = mkTyConTy arrayArrayPrimTyCon
+mkSmallArrayPrimTy :: Type -> Type
+mkSmallArrayPrimTy elt = TyConApp smallArrayPrimTyCon [elt]
 mkMutableArrayPrimTy :: Type -> Type -> Type
 mkMutableArrayPrimTy s elt  = TyConApp mutableArrayPrimTyCon [s, elt]
 mkMutableByteArrayPrimTy :: Type -> Type
 mkMutableByteArrayPrimTy s  = TyConApp mutableByteArrayPrimTyCon [s]
 mkMutableArrayArrayPrimTy :: Type -> Type
 mkMutableArrayArrayPrimTy s = TyConApp mutableArrayArrayPrimTyCon [s]
+mkSmallMutableArrayPrimTy :: Type -> Type -> Type
+mkSmallMutableArrayPrimTy s elt = TyConApp smallMutableArrayPrimTyCon [s, elt]
 \end{code}
 
 %************************************************************************
@@ -687,7 +709,7 @@ threadIdPrimTyCon = pcPrimTyCon0 threadIdPrimTyConName PtrRep
 
 Note [Any types]
 ~~~~~~~~~~~~~~~~
-The type constructor Any of kind forall k. k -> k has these properties:
+The type constructor Any of kind forall k. k has these properties:
 
   * It is defined in module GHC.Prim, and exported so that it is 
     available to users.  For this reason it's treated like any other 
@@ -700,7 +722,7 @@ The type constructor Any of kind forall k. k -> k has these properties:
              g :: ty ~ (Fst ty, Snd ty)
     If Any was a *data* type, then we'd get inconsistency because 'ty'
     could be (Any '(k1,k2)) and then we'd have an equality with Any on
-    one side and '(,) on the other
+    one side and '(,) on the other. See also #9097.
 
   * It is lifted, and hence represented by a pointer
 
@@ -757,20 +779,12 @@ anyTy :: Type
 anyTy = mkTyConTy anyTyCon
 
 anyTyCon :: TyCon
-anyTyCon = mkLiftedPrimTyCon anyTyConName kind [Nominal] PtrRep
-  where kind = ForAllTy kKiVar (mkTyVarTy kKiVar)
-
-{-   Can't do this yet without messing up kind proxies
--- RAE: I think you can now.
-anyTyCon :: TyCon
-anyTyCon = mkSynTyCon anyTyConName kind [kKiVar] 
+anyTyCon = mkSynTyCon anyTyConName kind [kKiVar] [Nominal]
                       syn_rhs
                       NoParentTyCon
   where 
     kind = ForAllTy kKiVar (mkTyVarTy kKiVar)
-    syn_rhs = SynFamilyTyCon { synf_open = False, synf_injective = True }
-                  -- NB Closed, injective
--}
+    syn_rhs = AbstractClosedSynFamilyTyCon
 
 anyTypeOfKind :: Kind -> Type
 anyTypeOfKind kind = TyConApp anyTyCon [kind]
diff --git a/compiler/prelude/TysWiredIn.lhs b/compiler/prelude/TysWiredIn.lhs
index bf1907d161e0..4586b90cb227 100644
--- a/compiler/prelude/TysWiredIn.lhs
+++ b/compiler/prelude/TysWiredIn.lhs
@@ -4,11 +4,13 @@
 \section[TysWiredIn]{Wired-in knowledge about {\em non-primitive} types}
 
 \begin{code}
+{-# LANGUAGE CPP #-}
+
 -- | This module is about types that can be defined in Haskell, but which
 --   must be wired into the compiler nonetheless.  C.f module TysPrim
 module TysWiredIn (
         -- * All wired in things
-        wiredInTyCons,
+        wiredInTyCons, isBuiltInOcc_maybe,
 
         -- * Bool
         boolTy, boolTyCon, boolTyCon_RDR, boolTyConName,
@@ -20,6 +22,8 @@ module TysWiredIn (
         ltDataCon, ltDataConId,
         eqDataCon, eqDataConId,
         gtDataCon, gtDataConId,
+        promotedOrderingTyCon,
+        promotedLTDataCon, promotedEQDataCon, promotedGTDataCon,
 
         -- * Char
         charTyCon, charDataCon, charTyCon_RDR,
@@ -174,10 +178,12 @@ mkWiredInDataConName built_in modu fs unique datacon
                   (AConLike (RealDataCon datacon))    -- Relevant DataCon
                   built_in
 
+-- See Note [Kind-changing of (~) and Coercible]
 eqTyConName, eqBoxDataConName :: Name
 eqTyConName      = mkWiredInTyConName   BuiltInSyntax gHC_TYPES (fsLit "~")   eqTyConKey      eqTyCon
 eqBoxDataConName = mkWiredInDataConName UserSyntax    gHC_TYPES (fsLit "Eq#") eqBoxDataConKey eqBoxDataCon
 
+-- See Note [Kind-changing of (~) and Coercible]
 coercibleTyConName, coercibleDataConName :: Name
 coercibleTyConName   = mkWiredInTyConName   UserSyntax gHC_TYPES (fsLit "Coercible")  coercibleTyConKey   coercibleTyCon
 coercibleDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "MkCoercible") coercibleDataConKey coercibleDataCon
@@ -329,11 +335,11 @@ typeSymbolKind = TyConApp (promoteTyCon typeSymbolKindCon) []
 
 %************************************************************************
 %*                                                                      *
-\subsection[TysWiredIn-tuples]{The tuple types}
+                Stuff for dealing with tuples
 %*                                                                      *
 %************************************************************************
 
-Note [How tuples work]
+Note [How tuples work]  See also Note [Known-key names] in PrelNames
 ~~~~~~~~~~~~~~~~~~~~~~
 * There are three families of tuple TyCons and corresponding
   DataCons, (boxed, unboxed, and constraint tuples), expressed by the
@@ -352,6 +358,68 @@ Note [How tuples work]
   are not serialised into interface files using OccNames at all.
 
 \begin{code}
+isBuiltInOcc_maybe :: OccName -> Maybe Name
+-- Built in syntax isn't "in scope" so these OccNames 
+-- map to wired-in Names with BuiltInSyntax
+isBuiltInOcc_maybe occ
+  = case occNameString occ of
+        "[]"             -> choose_ns listTyCon nilDataCon
+        ":"              -> Just consDataConName
+        "[::]"           -> Just parrTyConName
+        "(##)"           -> choose_ns unboxedUnitTyCon unboxedUnitDataCon
+        "()"             -> choose_ns unitTyCon        unitDataCon
+        '(':'#':',':rest -> parse_tuple UnboxedTuple 2 rest
+        '(':',':rest     -> parse_tuple BoxedTuple   2 rest
+        _other           -> Nothing
+  where
+    ns = occNameSpace occ
+
+    parse_tuple sort n rest
+      | (',' : rest2) <- rest   = parse_tuple sort (n+1) rest2
+      | tail_matches sort rest  = choose_ns (tupleTyCon sort n)
+                                            (tupleCon   sort n)
+      | otherwise               = Nothing
+
+    tail_matches BoxedTuple   ")"  = True
+    tail_matches UnboxedTuple "#)" = True
+    tail_matches _            _    = False
+  
+    choose_ns tc dc
+      | isTcClsNameSpace ns   = Just (getName tc)
+      | isDataConNameSpace ns = Just (getName dc)
+      | otherwise             = Just (getName (dataConWorkId dc))
+
+mkTupleOcc :: NameSpace -> TupleSort -> Arity -> OccName
+mkTupleOcc ns sort ar = mkOccName ns str
+  where
+    -- No need to cache these, the caching is done in mk_tuple
+    str = case sort of
+                UnboxedTuple    -> '(' : '#' : commas ++ "#)"
+                BoxedTuple      -> '(' : commas ++ ")"
+                ConstraintTuple -> '(' : commas ++ ")"
+
+    commas = take (ar-1) (repeat ',')
+
+    -- Cute hack: we reuse the standard tuple OccNames (and hence code)
+    -- for fact tuples, but give them different Uniques so they are not equal.
+    --
+    -- You might think that this will go wrong because isBuiltInOcc_maybe won't
+    -- be able to tell the difference between boxed tuples and constraint tuples. BUT:
+    --  1. Constraint tuples never occur directly in user code, so it doesn't matter
+    --     that we can't detect them in Orig OccNames originating from the user
+    --     programs (or those built by setRdrNameSpace used on an Exact tuple Name)
+    --  2. Interface files have a special representation for tuple *occurrences*
+    --     in IfaceTyCons, their workers (in IfaceSyn) and their DataCons (in case
+    --     alternatives). Thus we don't rely on the OccName to figure out what kind
+    --     of tuple an occurrence was trying to use in these situations.
+    --  3. We *don't* represent tuple data type declarations specially, so those
+    --     are still turned into wired-in names via isBuiltInOcc_maybe. But that's OK
+    --     because we don't actually need to declare constraint tuples thanks to this hack.
+    --
+    -- So basically any OccName like (,,) flowing to isBuiltInOcc_maybe will always
+    -- refer to the standard boxed tuple. Cool :-)
+
+
 tupleTyCon :: TupleSort -> Arity -> TyCon
 tupleTyCon sort i | i > mAX_TUPLE_SIZE = fst (mk_tuple sort i)  -- Build one specially
 tupleTyCon BoxedTuple   i = fst (boxedTupleArr   ! i)
@@ -384,7 +452,7 @@ mk_tuple sort arity = (tycon, tuple_con)
           UnboxedTuple    -> Nothing
           ConstraintTuple -> Nothing
 
-        modu    = mkTupleModule sort arity
+        modu    = mkTupleModule sort
         tc_name = mkWiredInName modu (mkTupleOcc tcName sort arity) tc_uniq
                                 (ATyCon tycon) BuiltInSyntax
         tc_kind = mkArrowKinds (map tyVarKind tyvars) res_kind
@@ -831,5 +899,19 @@ promotedTrueDataCon   = promoteDataCon trueDataCon
 promotedFalseDataCon  = promoteDataCon falseDataCon
 \end{code}
 
+Promoted Ordering
+
+\begin{code}
+promotedOrderingTyCon
+  , promotedLTDataCon
+  , promotedEQDataCon
+  , promotedGTDataCon
+  :: TyCon
+promotedOrderingTyCon = promoteTyCon orderingTyCon
+promotedLTDataCon     = promoteDataCon ltDataCon
+promotedEQDataCon     = promoteDataCon eqDataCon
+promotedGTDataCon     = promoteDataCon gtDataCon
+\end{code}
+
 
 
diff --git a/compiler/prelude/primops.txt.pp b/compiler/prelude/primops.txt.pp
index 36eec67b7d95..d5566fe3630d 100644
--- a/compiler/prelude/primops.txt.pp
+++ b/compiler/prelude/primops.txt.pp
@@ -247,13 +247,19 @@
 
 primop   IntNegOp    "negateInt#"    Monadic   Int# -> Int#
 primop   IntAddCOp   "addIntC#"    GenPrimOp   Int# -> Int# -> (# Int#, Int# #)
-	 {Add with carry.  First member of result is (wrapped) sum;
-          second member is 0 iff no overflow occured.}
+         {Add signed integers reporting overflow.
+          First member of result is the sum truncated to an {\tt Int#};
+          second member is zero if the true sum fits in an {\tt Int#},
+          nonzero if overflow occurred (the sum is either too large
+          or too small to fit in an {\tt Int#}).}
    with code_size = 2
 
 primop   IntSubCOp   "subIntC#"    GenPrimOp   Int# -> Int# -> (# Int#, Int# #)
-	 {Subtract with carry.  First member of result is (wrapped) difference;
-          second member is 0 iff no overflow occured.}
+         {Subtract signed integers reporting overflow.
+          First member of result is the difference truncated to an {\tt Int#};
+          second member is zero if the true difference fits in an {\tt Int#},
+          nonzero if overflow occurred (the difference is either too large
+          or too small to fit in an {\tt Int#}).}
    with code_size = 2
 
 primop   IntGtOp  ">#"   Compare   Int# -> Int# -> Int#
@@ -380,6 +386,28 @@
 primop   PopCntOp   "popCnt#"   Monadic   Word# -> Word#
     {Count the number of set bits in a word.}
 
+primop   Clz8Op   "clz8#" Monadic   Word# -> Word#
+    {Count leading zeros in the lower 8 bits of a word.}
+primop   Clz16Op   "clz16#" Monadic   Word# -> Word#
+    {Count leading zeros in the lower 16 bits of a word.}
+primop   Clz32Op   "clz32#" Monadic   Word# -> Word#
+    {Count leading zeros in the lower 32 bits of a word.}
+primop   Clz64Op   "clz64#" GenPrimOp WORD64 -> Word#
+    {Count leading zeros in a 64-bit word.}
+primop   ClzOp     "clz#"   Monadic   Word# -> Word#
+    {Count leading zeros in a word.}
+
+primop   Ctz8Op   "ctz8#"  Monadic   Word# -> Word#
+    {Count trailing zeros in the lower 8 bits of a word.}
+primop   Ctz16Op   "ctz16#" Monadic   Word# -> Word#
+    {Count trailing zeros in the lower 16 bits of a word.}
+primop   Ctz32Op   "ctz32#" Monadic   Word# -> Word#
+    {Count trailing zeros in the lower 32 bits of a word.}
+primop   Ctz64Op   "ctz64#" GenPrimOp WORD64 -> Word#
+    {Count trailing zeros in a 64-bit word.}
+primop   CtzOp     "ctz#"   Monadic   Word# -> Word#
+    {Count trailing zeros in a word.}
+
 primop   BSwap16Op   "byteSwap16#"   Monadic   Word# -> Word#
     {Swap bytes in the lower 16 bits of a word. The higher bytes are undefined. }
 primop   BSwap32Op   "byteSwap32#"   Monadic   Word# -> Word#
@@ -762,54 +790,74 @@
 
 primop  CopyArrayOp "copyArray#" GenPrimOp
   Array# a -> Int# -> MutableArray# s a -> Int# -> Int# -> State# s -> State# s
-  {Copy a range of the Array# to the specified region in the MutableArray#.
-   Both arrays must fully contain the specified ranges, but this is not checked.
-   The two arrays must not be the same array in different states, but this is not checked either.}
+  {Given a source array, an offset into the source array, a
+   destination array, an offset into the destination array, and a
+   number of elements to copy, copy the elements from the source array
+   to the destination array. Both arrays must fully contain the
+   specified ranges, but this is not checked. The two arrays must not
+   be the same array in different states, but this is not checked
+   either.}
   with
+  out_of_line      = True
   has_side_effects = True
   can_fail         = True
-  code_size = { primOpCodeSizeForeignCall + 4 }
 
 primop  CopyMutableArrayOp "copyMutableArray#" GenPrimOp
   MutableArray# s a -> Int# -> MutableArray# s a -> Int# -> Int# -> State# s -> State# s
-  {Copy a range of the first MutableArray# to the specified region in the second MutableArray#.
-   Both arrays must fully contain the specified ranges, but this is not checked.}
+  {Given a source array, an offset into the source array, a
+   destination array, an offset into the destination array, and a
+   number of elements to copy, copy the elements from the source array
+   to the destination array. The source and destination arrays can
+   refer to the same array. Both arrays must fully contain the
+   specified ranges, but this is not checked.}
   with
+  out_of_line      = True
   has_side_effects = True
   can_fail         = True
-  code_size = { primOpCodeSizeForeignCall + 4 }
 
 primop  CloneArrayOp "cloneArray#" GenPrimOp
   Array# a -> Int# -> Int# -> Array# a
-  {Return a newly allocated Array# with the specified subrange of the provided Array#.
-   The provided Array# should contain the full subrange specified by the two Int#s, but this is not checked.}
+  {Given a source array, an offset into the source array, and a number
+   of elements to copy, create a new array with the elements from the
+   source array. The provided array must fully contain the specified
+   range, but this is not checked.}
   with
+  out_of_line      = True
   has_side_effects = True
-  code_size = { primOpCodeSizeForeignCall + 4 }
+  can_fail         = True
 
 primop  CloneMutableArrayOp "cloneMutableArray#" GenPrimOp
   MutableArray# s a -> Int# -> Int# -> State# s -> (# State# s, MutableArray# s a #)
-  {Return a newly allocated Array# with the specified subrange of the provided Array#.
-   The provided MutableArray# should contain the full subrange specified by the two Int#s, but this is not checked.}
+  {Given a source array, an offset into the source array, and a number
+   of elements to copy, create a new array with the elements from the
+   source array. The provided array must fully contain the specified
+   range, but this is not checked.}
   with
+  out_of_line      = True
   has_side_effects = True
-  code_size = { primOpCodeSizeForeignCall + 4 }
+  can_fail         = True
 
 primop  FreezeArrayOp "freezeArray#" GenPrimOp
   MutableArray# s a -> Int# -> Int# -> State# s -> (# State# s, Array# a #)
-  {Return a newly allocated Array# with the specified subrange of the provided MutableArray#.
-   The provided MutableArray# should contain the full subrange specified by the two Int#s, but this is not checked.}
+  {Given a source array, an offset into the source array, and a number
+   of elements to copy, create a new array with the elements from the
+   source array. The provided array must fully contain the specified
+   range, but this is not checked.}
   with
+  out_of_line      = True
   has_side_effects = True
-  code_size = { primOpCodeSizeForeignCall + 4 }
+  can_fail         = True
 
 primop  ThawArrayOp "thawArray#" GenPrimOp
   Array# a -> Int# -> Int# -> State# s -> (# State# s, MutableArray# s a #)
-  {Return a newly allocated Array# with the specified subrange of the provided MutableArray#.
-   The provided Array# should contain the full subrange specified by the two Int#s, but this is not checked.}
+  {Given a source array, an offset into the source array, and a number
+   of elements to copy, create a new array with the elements from the
+   source array. The provided array must fully contain the specified
+   range, but this is not checked.}
   with
+  out_of_line      = True
   has_side_effects = True
-  code_size = { primOpCodeSizeForeignCall + 4 }
+  can_fail         = True
 
 primop CasArrayOp  "casArray#" GenPrimOp
    MutableArray# s a -> Int# -> a -> a -> State# s -> (# State# s, Int#, a #)
@@ -819,6 +867,168 @@
    has_side_effects = True
 
 
+------------------------------------------------------------------------
+section "Small Arrays"
+
+	{Operations on {\tt SmallArray\#}. A {\tt SmallArray\#} works
+         just like an {\tt Array\#}, but with different space use and
+         performance characteristics (that are often useful with small
+         arrays). The {\tt SmallArray\#} and {\tt SmallMutableArray#}
+         lack a `card table'. The purpose of a card table is to avoid
+         having to scan every element of the array on each GC by
+         keeping track of which elements have changed since the last GC
+         and only scanning those that have changed. So the consequence
+         of there being no card table is that the representation is
+         somewhat smaller and the writes are somewhat faster (because
+         the card table does not need to be updated). The disadvantage
+         of course is that for a {\tt SmallMutableArray#} the whole
+         array has to be scanned on each GC. Thus it is best suited for
+         use cases where the mutable array is not long lived, e.g.
+         where a mutable array is initialised quickly and then frozen
+         to become an immutable {\tt SmallArray\#}.
+        }
+
+------------------------------------------------------------------------
+
+primtype SmallArray# a
+
+primtype SmallMutableArray# s a
+
+primop  NewSmallArrayOp "newSmallArray#" GenPrimOp
+   Int# -> a -> State# s -> (# State# s, SmallMutableArray# s a #)
+   {Create a new mutable array with the specified number of elements,
+    in the specified state thread,
+    with each element containing the specified initial value.}
+   with
+   out_of_line = True
+   has_side_effects = True
+
+primop  SameSmallMutableArrayOp "sameSmallMutableArray#" GenPrimOp
+   SmallMutableArray# s a -> SmallMutableArray# s a -> Int#
+
+primop  ReadSmallArrayOp "readSmallArray#" GenPrimOp
+   SmallMutableArray# s a -> Int# -> State# s -> (# State# s, a #)
+   {Read from specified index of mutable array. Result is not yet evaluated.}
+   with
+   has_side_effects = True
+   can_fail         = True
+
+primop  WriteSmallArrayOp "writeSmallArray#" GenPrimOp
+   SmallMutableArray# s a -> Int# -> a -> State# s -> State# s
+   {Write to specified index of mutable array.}
+   with
+   has_side_effects = True
+   can_fail         = True
+
+primop  SizeofSmallArrayOp "sizeofSmallArray#" GenPrimOp
+   SmallArray# a -> Int#
+   {Return the number of elements in the array.}
+
+primop  SizeofSmallMutableArrayOp "sizeofSmallMutableArray#" GenPrimOp
+   SmallMutableArray# s a -> Int#
+   {Return the number of elements in the array.}
+
+primop  IndexSmallArrayOp "indexSmallArray#" GenPrimOp
+   SmallArray# a -> Int# -> (# a #)
+   {Read from specified index of immutable array. Result is packaged into
+    an unboxed singleton; the result itself is not yet evaluated.}
+   with
+   can_fail         = True
+
+primop  UnsafeFreezeSmallArrayOp "unsafeFreezeSmallArray#" GenPrimOp
+   SmallMutableArray# s a -> State# s -> (# State# s, SmallArray# a #)
+   {Make a mutable array immutable, without copying.}
+   with
+   has_side_effects = True
+
+primop  UnsafeThawSmallArrayOp  "unsafeThawSmallArray#" GenPrimOp
+   SmallArray# a -> State# s -> (# State# s, SmallMutableArray# s a #)
+   {Make an immutable array mutable, without copying.}
+   with
+   out_of_line = True
+   has_side_effects = True
+
+-- The code_size is only correct for the case when the copy family of
+-- primops aren't inlined. It would be nice to keep track of both.
+
+primop  CopySmallArrayOp "copySmallArray#" GenPrimOp
+  SmallArray# a -> Int# -> SmallMutableArray# s a -> Int# -> Int# -> State# s -> State# s
+  {Given a source array, an offset into the source array, a
+   destination array, an offset into the destination array, and a
+   number of elements to copy, copy the elements from the source array
+   to the destination array. Both arrays must fully contain the
+   specified ranges, but this is not checked. The two arrays must not
+   be the same array in different states, but this is not checked
+   either.}
+  with
+  out_of_line      = True
+  has_side_effects = True
+  can_fail         = True
+
+primop  CopySmallMutableArrayOp "copySmallMutableArray#" GenPrimOp
+  SmallMutableArray# s a -> Int# -> SmallMutableArray# s a -> Int# -> Int# -> State# s -> State# s
+  {Given a source array, an offset into the source array, a
+   destination array, an offset into the destination array, and a
+   number of elements to copy, copy the elements from the source array
+   to the destination array. The source and destination arrays can
+   refer to the same array. Both arrays must fully contain the
+   specified ranges, but this is not checked.}
+  with
+  out_of_line      = True
+  has_side_effects = True
+  can_fail         = True
+
+primop  CloneSmallArrayOp "cloneSmallArray#" GenPrimOp
+  SmallArray# a -> Int# -> Int# -> SmallArray# a
+  {Given a source array, an offset into the source array, and a number
+   of elements to copy, create a new array with the elements from the
+   source array. The provided array must fully contain the specified
+   range, but this is not checked.}
+  with
+  out_of_line      = True
+  has_side_effects = True
+  can_fail         = True
+
+primop  CloneSmallMutableArrayOp "cloneSmallMutableArray#" GenPrimOp
+  SmallMutableArray# s a -> Int# -> Int# -> State# s -> (# State# s, SmallMutableArray# s a #)
+  {Given a source array, an offset into the source array, and a number
+   of elements to copy, create a new array with the elements from the
+   source array. The provided array must fully contain the specified
+   range, but this is not checked.}
+  with
+  out_of_line      = True
+  has_side_effects = True
+  can_fail         = True
+
+primop  FreezeSmallArrayOp "freezeSmallArray#" GenPrimOp
+  SmallMutableArray# s a -> Int# -> Int# -> State# s -> (# State# s, SmallArray# a #)
+  {Given a source array, an offset into the source array, and a number
+   of elements to copy, create a new array with the elements from the
+   source array. The provided array must fully contain the specified
+   range, but this is not checked.}
+  with
+  out_of_line      = True
+  has_side_effects = True
+  can_fail         = True
+
+primop  ThawSmallArrayOp "thawSmallArray#" GenPrimOp
+  SmallArray# a -> Int# -> Int# -> State# s -> (# State# s, SmallMutableArray# s a #)
+  {Given a source array, an offset into the source array, and a number
+   of elements to copy, create a new array with the elements from the
+   source array. The provided array must fully contain the specified
+   range, but this is not checked.}
+  with
+  out_of_line      = True
+  has_side_effects = True
+  can_fail         = True
+
+primop CasSmallArrayOp  "casSmallArray#" GenPrimOp
+   SmallMutableArray# s a -> Int# -> a -> a -> State# s -> (# State# s, Int#, a #)
+   {Unsafe, machine-level atomic compare and swap on an element within an array.}
+   with
+   out_of_line = True
+   has_side_effects = True
+
 ------------------------------------------------------------------------
 section "Byte Arrays"
 	{Operations on {\tt ByteArray\#}. A {\tt ByteArray\#} is a just a region of
@@ -864,6 +1074,30 @@
 primop  SameMutableByteArrayOp "sameMutableByteArray#" GenPrimOp
    MutableByteArray# s -> MutableByteArray# s -> Int#
 
+primop  ShrinkMutableByteArrayOp_Char "shrinkMutableByteArray#" GenPrimOp
+   MutableByteArray# s -> Int# -> State# s -> State# s
+   {Shrink mutable byte array to new specified size (in bytes), in
+    the specified state thread. The new size argument must be less than or
+    equal to the current size as reported by {\tt sizeofMutableArray\#}.}
+   with out_of_line = True
+        has_side_effects = True
+
+primop  ResizeMutableByteArrayOp_Char "resizeMutableByteArray#" GenPrimOp
+   MutableByteArray# s -> Int# -> State# s -> (# State# s,MutableByteArray# s #)
+   {Resize (unpinned) mutable byte array to new specified size (in bytes).
+    The returned {\tt MutableByteArray\#} is either the original
+    {\tt MutableByteArray\#} resized in-place or, if not possible, a newly
+    allocated (unpinned) {\tt MutableByteArray\#} (with the original content
+    copied over).
+
+    To avoid undefined behaviour, the original {\tt MutableByteArray\#} shall
+    not be accessed anymore after a {\tt resizeMutableByteArray\#} has been
+    performed.  Moreover, no reference to the old one should be kept in order
+    to allow garbage collection of the original {\tt MutableByteArray\#} in
+    case a new {\tt MutableByteArray\#} had to be allocated.}
+   with out_of_line = True
+        has_side_effects = True
+
 primop  UnsafeFreezeByteArrayOp "unsafeFreezeByteArray#" GenPrimOp
    MutableByteArray# s -> State# s -> (# State# s, ByteArray# #)
    {Make a mutable byte array immutable, without copying.}
@@ -914,34 +1148,42 @@
 
 primop IndexByteArrayOp_Int8 "indexInt8Array#" GenPrimOp
    ByteArray# -> Int# -> Int#
+   {Read 8-bit integer; offset in bytes.}
    with can_fail = True
 
 primop IndexByteArrayOp_Int16 "indexInt16Array#" GenPrimOp
    ByteArray# -> Int# -> Int#
+   {Read 16-bit integer; offset in 16-bit words.}
    with can_fail = True
 
 primop IndexByteArrayOp_Int32 "indexInt32Array#" GenPrimOp
    ByteArray# -> Int# -> INT32
+   {Read 32-bit integer; offset in 32-bit words.}
    with can_fail = True
 
 primop IndexByteArrayOp_Int64 "indexInt64Array#" GenPrimOp
    ByteArray# -> Int# -> INT64
+   {Read 64-bit integer; offset in 64-bit words.}
    with can_fail = True
 
 primop IndexByteArrayOp_Word8 "indexWord8Array#" GenPrimOp
    ByteArray# -> Int# -> Word#
+   {Read 8-bit word; offset in bytes.}
    with can_fail = True
 
 primop IndexByteArrayOp_Word16 "indexWord16Array#" GenPrimOp
    ByteArray# -> Int# -> Word#
+   {Read 16-bit word; offset in 16-bit words.}
    with can_fail = True
 
 primop IndexByteArrayOp_Word32 "indexWord32Array#" GenPrimOp
    ByteArray# -> Int# -> WORD32
+   {Read 32-bit word; offset in 32-bit words.}
    with can_fail = True
 
 primop IndexByteArrayOp_Word64 "indexWord64Array#" GenPrimOp
    ByteArray# -> Int# -> WORD64
+   {Read 64-bit word; offset in 64-bit words.}
    with can_fail = True
 
 primop  ReadByteArrayOp_Char "readCharArray#" GenPrimOp
@@ -958,11 +1200,13 @@
 
 primop  ReadByteArrayOp_Int "readIntArray#" GenPrimOp
    MutableByteArray# s -> Int# -> State# s -> (# State# s, Int# #)
+   {Read intger; offset in words.}
    with has_side_effects = True
         can_fail = True
 
 primop  ReadByteArrayOp_Word "readWordArray#" GenPrimOp
    MutableByteArray# s -> Int# -> State# s -> (# State# s, Word# #)
+   {Read word; offset in words.}
    with has_side_effects = True
         can_fail = True
 
@@ -1171,19 +1415,79 @@
   code_size = { primOpCodeSizeForeignCall + 4 }
   can_fail = True
 
+-- Atomic operations
+
+primop  AtomicReadByteArrayOp_Int "atomicReadIntArray#" GenPrimOp
+   MutableByteArray# s -> Int# -> State# s -> (# State# s, Int# #)
+   {Given an array and an offset in Int units, read an element. The
+    index is assumed to be in bounds. Implies a full memory barrier.}
+   with has_side_effects = True
+        can_fail = True
+
+primop  AtomicWriteByteArrayOp_Int "atomicWriteIntArray#" GenPrimOp
+   MutableByteArray# s -> Int# -> Int# -> State# s -> State# s
+   {Given an array and an offset in Int units, write an element. The
+    index is assumed to be in bounds. Implies a full memory barrier.}
+   with has_side_effects = True
+        can_fail = True
+
 primop CasByteArrayOp_Int "casIntArray#" GenPrimOp
    MutableByteArray# s -> Int# -> Int# -> Int# -> State# s -> (# State# s, Int# #)
-   {Machine-level atomic compare and swap on a word within a ByteArray.}
-   with
-   out_of_line = True
-   has_side_effects = True
+   {Given an array, an offset in Int units, the expected old value, and
+    the new value, perform an atomic compare and swap i.e. write the new
+    value if the current value matches the provided old value. Returns
+    the value of the element before the operation. Implies a full memory
+    barrier.}
+   with has_side_effects = True
+        can_fail = True
 
 primop FetchAddByteArrayOp_Int "fetchAddIntArray#" GenPrimOp
    MutableByteArray# s -> Int# -> Int# -> State# s -> (# State# s, Int# #)
-   {Machine-level word-sized fetch-and-add within a ByteArray.}
-   with
-   out_of_line = True
-   has_side_effects = True
+   {Given an array, and offset in Int units, and a value to add,
+    atomically add the value to the element. Returns the value of the
+    element before the operation. Implies a full memory barrier.}
+   with has_side_effects = True
+        can_fail = True
+
+primop FetchSubByteArrayOp_Int "fetchSubIntArray#" GenPrimOp
+   MutableByteArray# s -> Int# -> Int# -> State# s -> (# State# s, Int# #)
+   {Given an array, and offset in Int units, and a value to subtract,
+    atomically substract the value to the element. Returns the value of
+    the element before the operation. Implies a full memory barrier.}
+   with has_side_effects = True
+        can_fail = True
+
+primop FetchAndByteArrayOp_Int "fetchAndIntArray#" GenPrimOp
+   MutableByteArray# s -> Int# -> Int# -> State# s -> (# State# s, Int# #)
+   {Given an array, and offset in Int units, and a value to AND,
+    atomically AND the value to the element. Returns the value of the
+    element before the operation. Implies a full memory barrier.}
+   with has_side_effects = True
+        can_fail = True
+
+primop FetchNandByteArrayOp_Int "fetchNandIntArray#" GenPrimOp
+   MutableByteArray# s -> Int# -> Int# -> State# s -> (# State# s, Int# #)
+   {Given an array, and offset in Int units, and a value to NAND,
+    atomically NAND the value to the element. Returns the value of the
+    element before the operation. Implies a full memory barrier.}
+   with has_side_effects = True
+        can_fail = True
+
+primop FetchOrByteArrayOp_Int "fetchOrIntArray#" GenPrimOp
+   MutableByteArray# s -> Int# -> Int# -> State# s -> (# State# s, Int# #)
+   {Given an array, and offset in Int units, and a value to OR,
+    atomically OR the value to the element. Returns the value of the
+    element before the operation. Implies a full memory barrier.}
+   with has_side_effects = True
+        can_fail = True
+
+primop FetchXorByteArrayOp_Int "fetchXorIntArray#" GenPrimOp
+   MutableByteArray# s -> Int# -> Int# -> State# s -> (# State# s, Int# #)
+   {Given an array, and offset in Int units, and a value to XOR,
+    atomically XOR the value to the element. Returns the value of the
+    element before the operation. Implies a full memory barrier.}
+   with has_side_effects = True
+        can_fail = True
 
 
 ------------------------------------------------------------------------
@@ -1279,9 +1583,9 @@
    Both arrays must fully contain the specified ranges, but this is not checked.
    The two arrays must not be the same array in different states, but this is not checked either.}
   with
+  out_of_line      = True
   has_side_effects = True
-  can_fail = True
-  code_size = { primOpCodeSizeForeignCall }
+  can_fail         = True
 
 primop  CopyMutableArrayArrayOp "copyMutableArrayArray#" GenPrimOp
   MutableArrayArray# s -> Int# -> MutableArrayArray# s -> Int# -> Int# -> State# s -> State# s
@@ -1289,9 +1593,9 @@
    MutableArrayArray#.
    Both arrays must fully contain the specified ranges, but this is not checked.}
   with
+  out_of_line      = True
   has_side_effects = True
-  code_size = { primOpCodeSizeForeignCall }
-  can_fail = True
+  can_fail         = True
 
 ------------------------------------------------------------------------
 section "Addr#"
@@ -1629,6 +1933,11 @@
    strictness  = { \ _arity -> mkClosedStrictSig [topDmd] botRes }
       -- NB: result is bottom
    out_of_line = True
+   has_side_effects = True
+     -- raise# certainly throws a Haskell exception and hence has_side_effects
+     -- It doesn't actually make much difference because the fact that it
+     -- returns bottom independently ensures that we are careful not to discard
+     -- it.  But still, it's better to say the Right Thing.
 
 -- raiseIO# needs to be a primop, because exceptions in the IO monad
 -- must be *precise* - we don't want the strictness analyser turning
@@ -2245,7 +2554,7 @@
    { Evaluates its first argument to head normal form, and then returns its second
 	argument as the result. }
 
-primtype Any k
+primtype Any
 	{ The type constructor {\tt Any} is type to which you can unsafely coerce any
 	lifted type, and back.
 
@@ -2270,8 +2579,11 @@
 
 	{\tt length (Any *) ([] (Any *))}
 
-        Note that {\tt Any} is kind polymorphic, and takes a kind {\tt k} as its
-        first argument. The kind of {\tt Any} is thus {\tt forall k. k -> k}.}
+        Above, we print kinds explicitly, as if with
+        {\tt -fprint-explicit-kinds}.
+
+        Note that {\tt Any} is kind polymorphic; its kind is thus
+        {\tt forall k. k}.}
 
 primtype AnyK
         { The kind {\tt AnyK} is the kind level counterpart to {\tt Any}. In a
@@ -2364,49 +2676,6 @@
      concrete types.
    }
 
-primclass Coercible a b
-   { This two-parameter class has instances for types {\tt a} and {\tt b} if
-     the compiler can infer that they have the same representation. This class
-     does not have regular instances; instead they are created on-the-fly during
-     type-checking. Trying to manually declare an instance of {\tt Coercible}
-     is an error.
-
-     Nevertheless one can pretend that the following three kinds of instances
-     exist. First, as a trivial base-case:
-
-     {\tt instance a a}
-
-     Furthermore, for every type constructor there is
-     an instance that allows to coerce under the type constructor. For
-     example, let {\tt D} be a prototypical type constructor ({\tt data} or {\tt
-     newtype}) with three type arguments, which have roles Nominal,
-     Representational resp. Phantom. Then there is an instance of the form
-
-     {\tt instance Coercible b b' => Coercible (D a b c) (D a b' c')}
-
-     Note that the nominal type arguments are equal, the representational type
-     arguments can differ, but need to have a {\tt Coercible} instance
-     themself, and the phantom type arguments can be changed arbitrarily.
-
-     In SafeHaskell code, this instance is only usable if the constructors of
-     every type constructor used in the definition of {\tt D} (including
-     those of {\tt D} itself) are in scope.
-
-     The third kind of instance exists for every {\tt newtype NT = MkNT T} and
-     comes in two variants, namely
-
-     {\tt instance Coercible a T => Coercible a NT}
-
-     {\tt instance Coercible T b => Coercible NT b}
-
-     This instance is only usable if the constructor {\tt MkNT} is in scope.
-
-     If, as a library author of a type constructor like {\tt Set a}, you
-     want to prevent a user of your module to write
-     {\tt coerce :: Set T -> Set NT},
-     you need to set the role of {\tt Set}'s type parameter to Nominal.
-   }
-
 ------------------------------------------------------------------------
 section "SIMD Vectors"
 	{Operations on SIMD vectors.}
diff --git a/compiler/profiling/CostCentre.lhs b/compiler/profiling/CostCentre.lhs
index fffd6462b24f..8a6ed044fb54 100644
--- a/compiler/profiling/CostCentre.lhs
+++ b/compiler/profiling/CostCentre.lhs
@@ -1,32 +1,24 @@
 \begin{code}
-{-# OPTIONS -fno-warn-tabs #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and
--- detab the module (please do the detabbing in a separate patch). See
---     http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
--- for details
-
 {-# LANGUAGE BangPatterns, DeriveDataTypeable #-}
-
 module CostCentre (
         CostCentre(..), CcName, IsCafCC(..),
-		-- All abstract except to friend: ParseIface.y
+                -- All abstract except to friend: ParseIface.y
 
-	CostCentreStack,
-	CollectedCCs,
+        CostCentreStack,
+        CollectedCCs,
         noCCS, currentCCS, dontCareCCS,
         noCCSAttached, isCurrentCCS,
         maybeSingletonCCS,
 
-	mkUserCC, mkAutoCC, mkAllCafsCC, 
+        mkUserCC, mkAutoCC, mkAllCafsCC,
         mkSingletonCCS,
         isCafCCS, isCafCC, isSccCountCC, sccAbleCC, ccFromThisModule,
 
-	pprCostCentreCore,
+        pprCostCentreCore,
         costCentreUserName, costCentreUserNameFS,
         costCentreSrcSpan,
 
-	cmpCostCentre	-- used for removing dups in a list
+        cmpCostCentre   -- used for removing dups in a list
     ) where
 
 import Binary
@@ -34,7 +26,7 @@ import Var
 import Name
 import Module
 import Unique
-import Outputable	
+import Outputable
 import FastTypes
 import SrcLoc
 import FastString
@@ -46,7 +38,7 @@ import Data.Data
 -- Cost Centres
 
 -- | A Cost Centre is a single @{-# SCC #-}@ annotation.
- 
+
 data CostCentre
   = NormalCC {
                 cc_key  :: {-# UNPACK #-} !Int,
@@ -66,7 +58,7 @@ data CostCentre
                 cc_is_caf  :: IsCafCC   -- see below
     }
 
-  | AllCafsCC {	
+  | AllCafsCC {
                 cc_mod  :: Module,      -- Name of module defining this CC.
                 cc_loc  :: SrcSpan
     }
@@ -79,10 +71,10 @@ data IsCafCC = NotCafCC | CafCC
 
 
 instance Eq CostCentre where
-	c1 == c2 = case c1 `cmpCostCentre` c2 of { EQ -> True; _ -> False }
+        c1 == c2 = case c1 `cmpCostCentre` c2 of { EQ -> True; _ -> False }
 
 instance Ord CostCentre where
-	compare = cmpCostCentre
+        compare = cmpCostCentre
 
 cmpCostCentre :: CostCentre -> CostCentre -> Ordering
 
@@ -96,8 +88,8 @@ cmpCostCentre NormalCC {cc_key = n1, cc_mod =  m1}
 
 cmpCostCentre other_1 other_2
   = let
-	!tag1 = tag_CC other_1
-	!tag2 = tag_CC other_2
+        !tag1 = tag_CC other_1
+        !tag2 = tag_CC other_2
     in
     if tag1 <# tag2 then LT else GT
   where
@@ -143,7 +135,7 @@ mkAutoCC id mod is_caf
                cc_loc = nameSrcSpan (getName id),
                cc_is_caf = is_caf
     }
-  where 
+  where
         name = getName id
         -- beware: only external names are guaranteed to have unique
         -- Occnames.  If the name is not external, we must append its
@@ -161,28 +153,28 @@ mkAllCafsCC m loc = AllCafsCC { cc_mod = m, cc_loc = loc }
 
 -- | A Cost Centre Stack is something that can be attached to a closure.
 -- This is either:
--- 	
+--
 --      * the current cost centre stack (CCCS)
 --      * a pre-defined cost centre stack (there are several
--- 	  pre-defined CCSs, see below).
+--        pre-defined CCSs, see below).
 
 data CostCentreStack
   = NoCCS
 
-  | CurrentCCS		-- Pinned on a let(rec)-bound 
-			-- thunk/function/constructor, this says that the 
-			-- cost centre to be attached to the object, when it 
-			-- is allocated, is whatever is in the 
-			-- current-cost-centre-stack register.
+  | CurrentCCS          -- Pinned on a let(rec)-bound
+                        -- thunk/function/constructor, this says that the
+                        -- cost centre to be attached to the object, when it
+                        -- is allocated, is whatever is in the
+                        -- current-cost-centre-stack register.
 
   | DontCareCCS         -- We need a CCS to stick in static closures
-			-- (for data), but we *don't* expect them to
-			-- accumulate any costs.  But we still need
-			-- the placeholder.  This CCS is it.
+                        -- (for data), but we *don't* expect them to
+                        -- accumulate any costs.  But we still need
+                        -- the placeholder.  This CCS is it.
 
   | SingletonCCS CostCentre
 
-  deriving (Eq, Ord)	-- needed for Ord on CLabel
+  deriving (Eq, Ord)    -- needed for Ord on CLabel
 
 
 -- synonym for triple which describes the cost centre info in the generated
@@ -196,7 +188,7 @@ type CollectedCCs
 
 noCCS, currentCCS, dontCareCCS :: CostCentreStack
 
-noCCS 			= NoCCS
+noCCS                   = NoCCS
 currentCCS              = CurrentCCS
 dontCareCCS             = DontCareCCS
 
@@ -204,20 +196,20 @@ dontCareCCS             = DontCareCCS
 -- Predicates on Cost-Centre Stacks
 
 noCCSAttached :: CostCentreStack -> Bool
-noCCSAttached NoCCS			= True
-noCCSAttached _				= False
+noCCSAttached NoCCS                     = True
+noCCSAttached _                         = False
 
 isCurrentCCS :: CostCentreStack -> Bool
-isCurrentCCS CurrentCCS			= True
-isCurrentCCS _	      			= False
+isCurrentCCS CurrentCCS                 = True
+isCurrentCCS _                          = False
 
 isCafCCS :: CostCentreStack -> Bool
 isCafCCS (SingletonCCS cc)              = isCafCC cc
-isCafCCS _				= False
+isCafCCS _                              = False
 
 maybeSingletonCCS :: CostCentreStack -> Maybe CostCentre
 maybeSingletonCCS (SingletonCCS cc)     = Just cc
-maybeSingletonCCS _			= Nothing
+maybeSingletonCCS _                     = Nothing
 
 mkSingletonCCS :: CostCentre -> CostCentreStack
 mkSingletonCCS cc = SingletonCCS cc
@@ -230,31 +222,31 @@ mkSingletonCCS cc = SingletonCCS cc
 -- expression.
 
 instance Outputable CostCentreStack where
-  ppr NoCCS		= ptext (sLit "NO_CCS")
-  ppr CurrentCCS	= ptext (sLit "CCCS")
+  ppr NoCCS             = ptext (sLit "NO_CCS")
+  ppr CurrentCCS        = ptext (sLit "CCCS")
   ppr DontCareCCS       = ptext (sLit "CCS_DONT_CARE")
   ppr (SingletonCCS cc) = ppr cc <> ptext (sLit "_ccs")
 
 
 -----------------------------------------------------------------------------
 -- Printing Cost Centres
--- 
+--
 -- There are several different ways in which we might want to print a
 -- cost centre:
--- 
--- 	- the name of the cost centre, for profiling output (a C string)
--- 	- the label, i.e. C label for cost centre in .hc file.
--- 	- the debugging name, for output in -ddump things
--- 	- the interface name, for printing in _scc_ exprs in iface files.
--- 
+--
+--      - the name of the cost centre, for profiling output (a C string)
+--      - the label, i.e. C label for cost centre in .hc file.
+--      - the debugging name, for output in -ddump things
+--      - the interface name, for printing in _scc_ exprs in iface files.
+--
 -- The last 3 are derived from costCentreStr below.  The first is given
 -- by costCentreName.
 
 instance Outputable CostCentre where
   ppr cc = getPprStyle $ \ sty ->
-	   if codeStyle sty
-  	   then ppCostCentreLbl cc
-	   else text (costCentreUserName cc)
+           if codeStyle sty
+           then ppCostCentreLbl cc
+           else text (costCentreUserName cc)
 
 -- Printing in Core
 pprCostCentreCore :: CostCentre -> SDoc
@@ -281,7 +273,7 @@ ppCostCentreLbl (NormalCC {cc_key = k, cc_name = n, cc_mod = m,
   = ppr m <> char '_' <> ztext (zEncodeFS n) <> char '_' <>
         case is_caf of { CafCC -> ptext (sLit "CAF"); _ -> ppr (mkUniqueGrimily k)} <> text "_cc"
 
--- This is the name to go in the user-displayed string, 
+-- This is the name to go in the user-displayed string,
 -- recorded in the cost centre declaration
 costCentreUserName :: CostCentre -> String
 costCentreUserName = unpackFS . costCentreUserNameFS
diff --git a/compiler/profiling/SCCfinal.lhs b/compiler/profiling/SCCfinal.lhs
index fdcf7447ebb5..78e314ba60de 100644
--- a/compiler/profiling/SCCfinal.lhs
+++ b/compiler/profiling/SCCfinal.lhs
@@ -2,6 +2,8 @@
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
 \begin{code}
+{-# LANGUAGE CPP #-}
+
 -----------------------------------------------------------------------------
 -- Modify and collect code generation for final STG program
 
@@ -32,6 +34,7 @@ import UniqSupply       ( UniqSupply )
 import ListSetOps       ( removeDups )
 import Outputable
 import DynFlags
+import CoreSyn          ( Tickish(..) )
 import FastString
 import SrcLoc
 import Util
@@ -93,7 +96,7 @@ stgMassageForProfiling dflags mod_name _us stg_binds
     do_top_rhs :: Id -> StgRhs -> MassageM StgRhs
 
     do_top_rhs _ (StgRhsClosure _ _ _ _ _ []
-                     (StgSCC _cc False{-not tick-} _push (StgConApp con args)))
+                     (StgTick (ProfNote _cc False{-not tick-} _push) (StgConApp con args)))
       | not (isDllConApp dflags mod_name con args)
         -- Trivial _scc_ around nothing but static data
         -- Eliminate _scc_ ... and turn into StgRhsCon
@@ -146,10 +149,14 @@ stgMassageForProfiling dflags mod_name _us stg_binds
     do_expr (StgOpApp con args res_ty)
       = return (StgOpApp con args res_ty)
 
-    do_expr (StgSCC cc tick push expr) = do -- Ha, we found a cost centre!
+    do_expr (StgTick note@(ProfNote cc _ _) expr) = do -- Ha, we found a cost centre!
         collectCC cc
         expr' <- do_expr expr
-        return (StgSCC cc tick push expr')
+        return (StgTick note expr')
+
+    do_expr (StgTick ti expr) = do
+        expr' <- do_expr expr
+        return (StgTick ti expr')
 
     do_expr (StgCase expr fv1 fv2 bndr srt alt_type alts) = do
         expr' <- do_expr expr
@@ -168,10 +175,6 @@ stgMassageForProfiling dflags mod_name _us stg_binds
           (b,e) <- do_let b e
           return (StgLetNoEscape lvs1 lvs2 b e)
 
-    do_expr (StgTick m n expr) = do
-          expr' <- do_expr expr
-          return (StgTick m n expr')
-
     do_expr other = pprPanic "SCCfinal.do_expr" (ppr other)
 
     ----------------------------------
@@ -201,7 +204,7 @@ stgMassageForProfiling dflags mod_name _us stg_binds
         -- We should really attach (PushCC cc CurrentCCS) to the rhs,
         -- but need to reinstate PushCC for that.
     do_rhs (StgRhsClosure _closure_cc _bi _fv _u _srt []
-               (StgSCC cc False{-not tick-} _push (StgConApp con args)))
+               (StgTick (ProfNote cc False{-not tick-} _push) (StgConApp con args)))
       = do collectCC cc
            return (StgRhsCon currentCCS con args)
 
diff --git a/compiler/rename/RnBinds.lhs b/compiler/rename/RnBinds.lhs
index ed1343f23d42..0f9f44aed6c7 100644
--- a/compiler/rename/RnBinds.lhs
+++ b/compiler/rename/RnBinds.lhs
@@ -9,7 +9,7 @@ type-synonym declarations; those cannot be done at this stage because
 they may be affected by renaming (which isn't fully worked out yet).
 
 \begin{code}
-{-# OPTIONS -fno-warn-tabs #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
 -- The above warning supression flag is a temporary kludge.
 -- While working on this module you are encouraged to remove it and
 -- detab the module (please do the detabbing in a separate patch). See
@@ -47,7 +47,7 @@ import NameSet
 import RdrName          ( RdrName, rdrNameOcc )
 import SrcLoc
 import ListSetOps	( findDupsEq )
-import BasicTypes	( RecFlag(..), Origin )
+import BasicTypes	( RecFlag(..) )
 import Digraph		( SCC(..) )
 import Bag
 import Outputable
@@ -275,7 +275,7 @@ rnValBindsLHS :: NameMaker
               -> HsValBinds RdrName
               -> RnM (HsValBindsLR Name RdrName)
 rnValBindsLHS topP (ValBindsIn mbinds sigs)
-  = do { mbinds' <- mapBagM (wrapOriginLocM (rnBindLHS topP doc)) mbinds
+  = do { mbinds' <- mapBagM (wrapLocM (rnBindLHS topP doc)) mbinds
        ; return $ ValBindsIn mbinds' sigs }
   where
     bndrs = collectHsBindsBinders mbinds
@@ -433,20 +433,27 @@ rnBindLHS name_maker _ bind@(FunBind { fun_id = name@(L nameLoc _) })
   = do { newname <- applyNameMaker name_maker name
        ; return (bind { fun_id = L nameLoc newname }) } 
 
-rnBindLHS name_maker _ bind@(PatSynBind{ patsyn_id = rdrname@(L nameLoc _) })
-  = do { addLocM checkConName rdrname
+rnBindLHS name_maker _ (PatSynBind psb@PSB{ psb_id = rdrname@(L nameLoc _) })
+  = do { unless (isTopRecNameMaker name_maker) $
+           addErr localPatternSynonymErr
+       ; addLocM checkConName rdrname
        ; name <- applyNameMaker name_maker rdrname
-       ; return (bind{ patsyn_id = L nameLoc name }) }
+       ; return (PatSynBind psb{ psb_id = L nameLoc name }) }
+  where
+    localPatternSynonymErr :: SDoc
+    localPatternSynonymErr
+      = hang (ptext (sLit "Illegal pattern synonym declaration"))
+           2 (ptext (sLit "Pattern synonym declarations are only valid in the top-level scope"))
 
 rnBindLHS _ _ b = pprPanic "rnBindHS" (ppr b)
 
 rnLBind :: (Name -> [Name])		-- Signature tyvar function
-        -> (Origin, LHsBindLR Name RdrName)
-        -> RnM ((Origin, LHsBind Name), [Name], Uses)
-rnLBind sig_fn (origin, (L loc bind))
+        -> LHsBindLR Name RdrName
+        -> RnM (LHsBind Name, [Name], Uses)
+rnLBind sig_fn (L loc bind)
   = setSrcSpan loc $
     do { (bind', bndrs, dus) <- rnBind sig_fn bind
-       ; return ((origin, L loc bind'), bndrs, dus) }
+       ; return (L loc bind', bndrs, dus) }
 
 -- assumes the left-hands-side vars are in scope
 rnBind :: (Name -> [Name])		-- Signature tyvar function
@@ -469,8 +476,9 @@ rnBind _ bind@(PatBind { pat_lhs = pat
               bndrs = collectPatBinders pat
               bind' = bind { pat_rhs  = grhss', bind_fvs = fvs' }
               is_wild_pat = case pat of
-                              L _ (WildPat {}) -> True
-                              _                -> False
+                              L _ (WildPat {})                 -> True
+                              L _ (BangPat (L _ (WildPat {}))) -> True -- #9127
+                              _                                -> False
 
         -- Warn if the pattern binds no variables, except for the
         -- entirely-explicit idiom    _ = rhs
@@ -507,15 +515,37 @@ rnBind sig_fn bind@(FunBind { fun_id = name
 		  [plain_name], rhs_fvs)
       }
 
-rnBind _sig_fn bind@(PatSynBind { patsyn_id = L _ name
-                                , patsyn_args = details
-                                , patsyn_def = pat
-                                , patsyn_dir = dir })
+rnBind sig_fn (PatSynBind bind)
+  = do  { (bind', name, fvs) <- rnPatSynBind sig_fn bind
+        ; return (PatSynBind bind', name, fvs) }
+
+rnBind _ b = pprPanic "rnBind" (ppr b)
+
+{-
+Note [Free-variable space leak]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+We have
+    fvs' = trim fvs
+and we seq fvs' before turning it as part of a record.
+
+The reason is that trim is sometimes something like
+    \xs -> intersectNameSet (mkNameSet bound_names) xs
+and we don't want to retain the list bound_names. This showed up in
+trac ticket #1136.
+-}
+
+rnPatSynBind :: (Name -> [Name])		-- Signature tyvar function
+             -> PatSynBind Name RdrName
+             -> RnM (PatSynBind Name Name, [Name], Uses)
+rnPatSynBind _sig_fn bind@(PSB { psb_id = L _ name
+                               , psb_args = details
+                               , psb_def = pat
+                               , psb_dir = dir })
        -- invariant: no free vars here when it's a FunBind
   = do	{ pattern_synonym_ok <- xoptM Opt_PatternSynonyms
         ; unless pattern_synonym_ok (addErr patternSynonymErr)
 
-        ; ((pat', details'), fvs) <- rnPat PatSyn pat $ \pat' -> do
+        ; ((pat', details'), fvs1) <- rnPat PatSyn pat $ \pat' -> do
          -- We check the 'RdrName's instead of the 'Name's
          -- so that the binding locations are reported
          -- from the left-hand side
@@ -531,23 +561,28 @@ rnBind _sig_fn bind@(PatSynBind { patsyn_id = L _ name
                       -- ; checkPrecMatch -- TODO
                       ; return (InfixPatSyn name1 name2, mkFVs (map unLoc [name1, name2])) }
         ; return ((pat', details'), fvs) }
-        ; dir' <- case dir of
-            Unidirectional -> return Unidirectional
-            ImplicitBidirectional -> return ImplicitBidirectional
+        ; (dir', fvs2) <- case dir of
+            Unidirectional -> return (Unidirectional, emptyFVs)
+            ImplicitBidirectional -> return (ImplicitBidirectional, emptyFVs)
+            ExplicitBidirectional mg ->
+                do { (mg', fvs) <- rnMatchGroup PatSyn rnLExpr mg
+                   ; return (ExplicitBidirectional mg', fvs) }
 
         ; mod <- getModule
-        ; let fvs' = filterNameSet (nameIsLocalOrFrom mod) fvs
+        ; let fvs = fvs1 `plusFV` fvs2
+              fvs' = filterNameSet (nameIsLocalOrFrom mod) fvs
 	        -- Keep locally-defined Names
 		-- As well as dependency analysis, we need these for the
 		-- MonoLocalBinds test in TcBinds.decideGeneralisationPlan
 
-        ; let bind' = bind{ patsyn_args = details'
-                          , patsyn_def = pat'
-                          , patsyn_dir = dir'
-                          , bind_fvs = fvs' }
+        ; let bind' = bind{ psb_args = details'
+                          , psb_def = pat'
+                          , psb_dir = dir'
+                          , psb_fvs = fvs' }
 
         ; fvs' `seq` -- See Note [Free-variable space leak]
-          return (bind', [name], fvs)
+          return (bind', [name], fvs1)
+          -- See Note [Pattern synonym wrappers don't yield dependencies]
       }
   where
     lookupVar = wrapLocM lookupOccRn
@@ -557,24 +592,38 @@ rnBind _sig_fn bind@(PatSynBind { patsyn_id = L _ name
       = hang (ptext (sLit "Illegal pattern synonym declaration"))
            2 (ptext (sLit "Use -XPatternSynonyms to enable this extension"))
 
+{-
+Note [Pattern synonym wrappers don't yield dependencies]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
-rnBind _ b = pprPanic "rnBind" (ppr b)
+When renaming a pattern synonym that has an explicit wrapper,
+references in the wrapper definition should not be used when
+calculating dependencies. For example, consider the following pattern
+synonym definition:
 
-{-
-Note [Free-variable space leak]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-We have
-    fvs' = trim fvs
-and we seq fvs' before turning it as part of a record.
+pattern P x <- C1 x where
+  P x = f (C1 x)
+
+f (P x) = C2 x
+
+In this case, 'P' needs to be typechecked in two passes:
+
+1. Typecheck the pattern definition of 'P', which fully determines the
+type of 'P'. This step doesn't require knowing anything about 'f',
+since the wrapper definition is not looked at.
+
+2. Typecheck the wrapper definition, which needs the typechecked
+definition of 'f' to be in scope.
+
+This behaviour is implemented in 'tcValBinds', but it crucially
+depends on 'P' not being put in a recursive group with 'f' (which
+would make it look like a recursive pattern synonym a la 'pattern P =
+P' which is unsound and rejected).
 
-The reason is that trim is sometimes something like
-    \xs -> intersectNameSet (mkNameSet bound_names) xs
-and we don't want to retain the list bound_names. This showed up in
-trac ticket #1136.
 -}
 
 ---------------------
-depAnalBinds :: Bag ((Origin, LHsBind Name), [Name], Uses)
+depAnalBinds :: Bag (LHsBind Name, [Name], Uses)
 	     -> ([(RecFlag, LHsBinds Name)], DefUses)
 -- Dependency analysis; this is important so that 
 -- unused-binding reporting is accurate
@@ -659,10 +708,9 @@ rnMethodBinds cls sig_fn binds
        ; foldlM do_one (emptyBag, emptyFVs) (bagToList binds) }
   where 
     meth_names  = collectMethodBinders binds
-    do_one (binds,fvs) (origin,bind)
+    do_one (binds,fvs) bind
        = do { (bind', fvs_bind) <- rnMethodBind cls sig_fn bind
-            ; let bind'' = mapBag (\bind -> (origin,bind)) bind'
-	    ; return (binds `unionBags` bind'', fvs_bind `plusFV` fvs) }
+	    ; return (binds `unionBags` bind', fvs_bind `plusFV` fvs) }
 
 rnMethodBind :: Name
 	      -> (Name -> [Name])
@@ -670,7 +718,7 @@ rnMethodBind :: Name
 	      -> RnM (Bag (LHsBindLR Name Name), FreeVars)
 rnMethodBind cls sig_fn 
              (L loc bind@(FunBind { fun_id = name, fun_infix = is_infix 
-				  , fun_matches = MG { mg_alts = matches } }))
+				  , fun_matches = MG { mg_alts = matches, mg_origin = origin } }))
   = setSrcSpan loc $ do
     sel_name <- wrapLocM (lookupInstDeclBndr cls (ptext (sLit "method"))) name
     let plain_name = unLoc sel_name
@@ -678,7 +726,7 @@ rnMethodBind cls sig_fn
 
     (new_matches, fvs) <- bindSigTyVarsFV (sig_fn plain_name) $
                           mapFvRn (rnMatch (FunRhs plain_name is_infix) rnLExpr) matches
-    let new_group = mkMatchGroup new_matches
+    let new_group = mkMatchGroup origin new_matches
 
     when is_infix $ checkPrecMatch plain_name new_group
     return (unitBag (L loc (bind { fun_id      = sel_name 
@@ -882,11 +930,11 @@ rnMatchGroup :: Outputable (body RdrName) => HsMatchContext Name
              -> (Located (body RdrName) -> RnM (Located (body Name), FreeVars))
              -> MatchGroup RdrName (Located (body RdrName))
              -> RnM (MatchGroup Name (Located (body Name)), FreeVars)
-rnMatchGroup ctxt rnBody (MG { mg_alts = ms }) 
+rnMatchGroup ctxt rnBody (MG { mg_alts = ms, mg_origin = origin }) 
   = do { empty_case_ok <- xoptM Opt_EmptyCase
        ; when (null ms && not empty_case_ok) (addErr (emptyCaseErr ctxt))
        ; (new_ms, ms_fvs) <- mapFvRn (rnMatch ctxt rnBody) ms
-       ; return (mkMatchGroup new_ms, ms_fvs) }
+       ; return (mkMatchGroup origin new_ms, ms_fvs) }
 
 rnMatch :: Outputable (body RdrName) => HsMatchContext Name
         -> (Located (body RdrName) -> RnM (Located (body Name), FreeVars))
diff --git a/compiler/rename/RnEnv.lhs b/compiler/rename/RnEnv.lhs
index f0d184097022..f333a239a195 100644
--- a/compiler/rename/RnEnv.lhs
+++ b/compiler/rename/RnEnv.lhs
@@ -4,6 +4,8 @@
 \section[RnEnv]{Environment manipulation for the renamer monad}
 
 \begin{code}
+{-# LANGUAGE CPP #-}
+
 module RnEnv (
         newTopSrcBinder,
         lookupLocatedTopBndrRn, lookupTopBndrRn,
@@ -38,10 +40,7 @@ module RnEnv (
         warnUnusedMatches,
         warnUnusedTopBinds, warnUnusedLocalBinds,
         dataTcOccs, kindSigErr, perhapsForallMsg,
-        HsDocContext(..), docOfHsDocContext, 
-
-        -- FsEnv
-        FastStringEnv, emptyFsEnv, lookupFsEnv, extendFsEnv, mkFsEnv
+        HsDocContext(..), docOfHsDocContext
     ) where
 
 #include "HsVersions.h"
@@ -59,7 +58,6 @@ import NameSet
 import NameEnv
 import Avail
 import Module
-import UniqFM
 import ConLike
 import DataCon          ( dataConFieldLabels, dataConTyCon )
 import TyCon            ( isTupleTyCon, tyConArity )
@@ -270,14 +268,29 @@ lookupExactOcc name
                        ; return name
                        }
 
-           [gre] -> return (gre_name gre)
-           _     -> pprPanic "lookupExactOcc" (ppr name $$ ppr gres) }
+           [gre]   -> return (gre_name gre)
+           (gre:_) -> do {addErr dup_nm_err
+                         ; return (gre_name gre)
+                         }
+           -- We can get more than one GRE here, if there are multiple 
+           -- bindings for the same name. Sometimes they are caught later
+           -- by findLocalDupsRdrEnv, like in this example (Trac #8932):
+           --    $( [d| foo :: a->a; foo x = x |])
+           --    foo = True
+           -- But when the names are totally identical, we panic (Trac #7241):
+           --    $(newName "Foo" >>= \o -> return [DataD [] o [] [RecC o []] [''Show]])
+           -- So, let's emit an error here, even if it will lead to duplication in some cases.
+       }
 
   where
     exact_nm_err = hang (ptext (sLit "The exact Name") <+> quotes (ppr name) <+> ptext (sLit "is not in scope"))
                       2 (vcat [ ptext (sLit "Probable cause: you used a unique Template Haskell name (NameU), ")
                               , ptext (sLit "perhaps via newName, but did not bind it")
                               , ptext (sLit "If that's it, then -ddump-splices might be useful") ])
+    dup_nm_err   = hang (ptext (sLit "Duplicate exact Name") <+> quotes (ppr $ nameOccName name))
+                      2 (vcat [ ptext (sLit "Probable cause: you used a unique Template Haskell name (NameU), ")
+                              , ptext (sLit "perhaps via newName, but bound it multiple times")
+                              , ptext (sLit "If that's it, then -ddump-splices might be useful") ])
 
 -----------------------------------------------
 lookupInstDeclBndr :: Name -> SDoc -> RdrName -> RnM Name
@@ -830,7 +843,7 @@ as if there was an "import qualified M" declaration for every
 module.
 
 If we fail we just return Nothing, rather than bleating
-about "attempting to use module ‛D’ (./D.hs) which is not loaded"
+about "attempting to use module ‘D’ (./D.hs) which is not loaded"
 which is what loadSrcInterface does.
 
 Note [Safe Haskell and GHCi]
@@ -1071,20 +1084,6 @@ The extended lookup is also used in other places, like resolution of
 deprecation declarations, and lookup of names in GHCi.
 
 \begin{code}
---------------------------------
-type FastStringEnv a = UniqFM a         -- Keyed by FastString
-
-
-emptyFsEnv  :: FastStringEnv a
-lookupFsEnv :: FastStringEnv a -> FastString -> Maybe a
-extendFsEnv :: FastStringEnv a -> FastString -> a -> FastStringEnv a
-mkFsEnv     :: [(FastString,a)] -> FastStringEnv a
-
-emptyFsEnv  = emptyUFM
-lookupFsEnv = lookupUFM
-extendFsEnv = addToUFM
-mkFsEnv     = listToUFM
-
 --------------------------------
 type MiniFixityEnv = FastStringEnv (Located Fixity)
         -- Mini fixity env for the names we're about
@@ -1103,7 +1102,7 @@ type MiniFixityEnv = FastStringEnv (Located Fixity)
 
 addLocalFixities :: MiniFixityEnv -> [Name] -> RnM a -> RnM a
 addLocalFixities mini_fix_env names thing_inside
-  = extendFixityEnv (mapCatMaybes find_fixity names) thing_inside
+  = extendFixityEnv (mapMaybe find_fixity names) thing_inside
   where
     find_fixity name
       = case lookupFsEnv mini_fix_env (occNameFS occ) of
@@ -1453,7 +1452,7 @@ unknownNameSuggestErr where_look tried_rdr_name
              all_possibilities
                 =  [ (showPpr dflags r, (r, Left loc))
                    | (r,loc) <- local_possibilities local_env ]
-                ++ [ (showPpr dflags r, rp) | (r,rp) <- global_possibilities global_env ]
+                ++ [ (showPpr dflags r, rp) | (r, rp) <- global_possibilities global_env ]
 
              suggest = fuzzyLookup (showPpr dflags tried_rdr_name) all_possibilities
              perhaps = ptext (sLit "Perhaps you meant")
@@ -1465,19 +1464,24 @@ unknownNameSuggestErr where_look tried_rdr_name
        ; return extra_err }
   where
     pp_item :: (RdrName, HowInScope) -> SDoc
-    pp_item (rdr, Left loc) = quotes (ppr rdr) <+> loc' -- Locally defined
+    pp_item (rdr, Left loc) = pp_ns rdr <+> quotes (ppr rdr) <+> loc' -- Locally defined
         where loc' = case loc of
                      UnhelpfulSpan l -> parens (ppr l)
                      RealSrcSpan l -> parens (ptext (sLit "line") <+> int (srcSpanStartLine l))
-    pp_item (rdr, Right is) = quotes (ppr rdr) <+>   -- Imported
+    pp_item (rdr, Right is) = pp_ns rdr <+> quotes (ppr rdr) <+>   -- Imported
                               parens (ptext (sLit "imported from") <+> ppr (is_mod is))
 
+    pp_ns :: RdrName -> SDoc
+    pp_ns rdr | ns /= tried_ns = pprNameSpace ns
+              | otherwise      = empty
+      where ns = rdrNameSpace rdr
+
     tried_occ     = rdrNameOcc tried_rdr_name
     tried_is_sym  = isSymOcc tried_occ
     tried_ns      = occNameSpace tried_occ
     tried_is_qual = isQual tried_rdr_name
 
-    correct_name_space occ =  occNameSpace occ == tried_ns
+    correct_name_space occ =  nameSpacesRelated (occNameSpace occ) tried_ns
                            && isSymOcc occ == tried_is_sym
         -- Treat operator and non-operators as non-matching
         -- This heuristic avoids things like
diff --git a/compiler/rename/RnExpr.lhs b/compiler/rename/RnExpr.lhs
index 01e8a4492d7c..697303f276e8 100644
--- a/compiler/rename/RnExpr.lhs
+++ b/compiler/rename/RnExpr.lhs
@@ -10,6 +10,8 @@ general, all of these functions return a renamed thing, and a set of
 free variables.
 
 \begin{code}
+{-# LANGUAGE CPP, ScopedTypeVariables #-}
+
 module RnExpr (
         rnLExpr, rnExpr, rnStmts
    ) where
@@ -38,6 +40,7 @@ import UniqSet
 import Data.List
 import Util
 import ListSetOps       ( removeDups )
+import ErrUtils
 import Outputable
 import SrcLoc
 import FastString
@@ -45,16 +48,6 @@ import Control.Monad
 import TysWiredIn       ( nilDataConName )
 \end{code}
 
-
-\begin{code}
--- XXX
-thenM :: Monad a => a b -> (b -> a c) -> a c
-thenM = (>>=)
-
-thenM_ :: Monad a => a b -> a c -> a c
-thenM_ = (>>)
-\end{code}
-
 %************************************************************************
 %*                                                                      *
 \subsubsection{Expressions}
@@ -66,16 +59,13 @@ rnExprs :: [LHsExpr RdrName] -> RnM ([LHsExpr Name], FreeVars)
 rnExprs ls = rnExprs' ls emptyUniqSet
  where
   rnExprs' [] acc = return ([], acc)
-  rnExprs' (expr:exprs) acc
-   = rnLExpr expr               `thenM` \ (expr', fvExpr) ->
-
+  rnExprs' (expr:exprs) acc =
+   do { (expr', fvExpr) <- rnLExpr expr
         -- Now we do a "seq" on the free vars because typically it's small
         -- or empty, especially in very long lists of constants
-    let
-        acc' = acc `plusFV` fvExpr
-    in
-    acc' `seq` rnExprs' exprs acc' `thenM` \ (exprs', fvExprs) ->
-    return (expr':exprs', fvExprs)
+      ; let  acc' = acc `plusFV` fvExpr
+      ; (exprs', fvExprs) <- acc' `seq` rnExprs' exprs acc'
+      ; return (expr':exprs', fvExprs) }
 \end{code}
 
 Variables. We look up the variable and return the resulting name.
@@ -120,27 +110,25 @@ rnExpr (HsIPVar v)
   = return (HsIPVar v, emptyFVs)
 
 rnExpr (HsLit lit@(HsString s))
-  = do {
-         opt_OverloadedStrings <- xoptM Opt_OverloadedStrings
+  = do { opt_OverloadedStrings <- xoptM Opt_OverloadedStrings
        ; if opt_OverloadedStrings then
             rnExpr (HsOverLit (mkHsIsString s placeHolderType))
-         else -- Same as below
-            rnLit lit           `thenM_`
-            return (HsLit lit, emptyFVs)
-       }
+         else do {
+            ; rnLit lit
+            ; return (HsLit lit, emptyFVs) } }
 
 rnExpr (HsLit lit)
-  = rnLit lit           `thenM_`
-    return (HsLit lit, emptyFVs)
+  = do { rnLit lit
+       ; return (HsLit lit, emptyFVs) }
 
 rnExpr (HsOverLit lit)
-  = rnOverLit lit               `thenM` \ (lit', fvs) ->
-    return (HsOverLit lit', fvs)
+  = do { (lit', fvs) <- rnOverLit lit
+       ; return (HsOverLit lit', fvs) }
 
 rnExpr (HsApp fun arg)
-  = rnLExpr fun         `thenM` \ (fun',fvFun) ->
-    rnLExpr arg         `thenM` \ (arg',fvArg) ->
-    return (HsApp fun' arg', fvFun `plusFV` fvArg)
+  = do { (fun',fvFun) <- rnLExpr fun
+       ; (arg',fvArg) <- rnLExpr arg
+       ; return (HsApp fun' arg', fvFun `plusFV` fvArg) }
 
 rnExpr (OpApp e1 (L op_loc (HsVar op_rdr)) _ e2)
   = do  { (e1', fv_e1) <- rnLExpr e1
@@ -163,10 +151,10 @@ rnExpr (OpApp _ other_op _ _)
                    , ptext (sLit "(Probably resulting from a Template Haskell splice)") ])
 
 rnExpr (NegApp e _)
-  = rnLExpr e                   `thenM` \ (e', fv_e) ->
-    lookupSyntaxName negateName `thenM` \ (neg_name, fv_neg) ->
-    mkNegAppRn e' neg_name      `thenM` \ final_e ->
-    return (final_e, fv_e `plusFV` fv_neg)
+  = do { (e', fv_e)         <- rnLExpr e
+       ; (neg_name, fv_neg) <- lookupSyntaxName negateName
+       ; final_e            <- mkNegAppRn e' neg_name
+       ; return (final_e, fv_e `plusFV` fv_neg) }
 
 ------------------------------------------
 -- Template Haskell extensions
@@ -178,10 +166,10 @@ rnExpr (HsSpliceE is_typed splice) = rnSpliceExpr is_typed splice
 
 
 rnExpr (HsQuasiQuoteE qq)
-  = runQuasiQuoteExpr qq        `thenM` \ lexpr' ->
-    -- Wrap the result of the quasi-quoter in parens so that we don't
-    -- lose the outermost location set by runQuasiQuote (#7918) 
-    rnExpr (HsPar lexpr')
+  = do { lexpr' <- runQuasiQuoteExpr qq
+         -- Wrap the result of the quasi-quoter in parens so that we don't
+         -- lose the outermost location set by runQuasiQuote (#7918)
+       ; rnExpr (HsPar lexpr') }
 
 ---------------------------------------------
 --      Sections
@@ -205,33 +193,33 @@ rnExpr expr@(SectionR {})
 
 ---------------------------------------------
 rnExpr (HsCoreAnn ann expr)
-  = rnLExpr expr `thenM` \ (expr', fvs_expr) ->
-    return (HsCoreAnn ann expr', fvs_expr)
+  = do { (expr', fvs_expr) <- rnLExpr expr
+       ; return (HsCoreAnn ann expr', fvs_expr) }
 
 rnExpr (HsSCC lbl expr)
-  = rnLExpr expr                `thenM` \ (expr', fvs_expr) ->
-    return (HsSCC lbl expr', fvs_expr)
+  = do { (expr', fvs_expr) <- rnLExpr expr
+       ; return (HsSCC lbl expr', fvs_expr) }
 rnExpr (HsTickPragma info expr)
-  = rnLExpr expr                `thenM` \ (expr', fvs_expr) ->
-    return (HsTickPragma info expr', fvs_expr)
+  = do { (expr', fvs_expr) <- rnLExpr expr
+       ; return (HsTickPragma info expr', fvs_expr) }
 
 rnExpr (HsLam matches)
-  = rnMatchGroup LambdaExpr rnLExpr matches     `thenM` \ (matches', fvMatch) ->
-    return (HsLam matches', fvMatch)
+  = do { (matches', fvMatch) <- rnMatchGroup LambdaExpr rnLExpr matches
+       ; return (HsLam matches', fvMatch) }
 
 rnExpr (HsLamCase arg matches)
-  = rnMatchGroup CaseAlt rnLExpr matches        `thenM` \ (matches', fvs_ms) ->
-    return (HsLamCase arg matches', fvs_ms)
+  = do { (matches', fvs_ms) <- rnMatchGroup CaseAlt rnLExpr matches
+       ; return (HsLamCase arg matches', fvs_ms) }
 
 rnExpr (HsCase expr matches)
-  = rnLExpr expr                                `thenM` \ (new_expr, e_fvs) ->
-    rnMatchGroup CaseAlt rnLExpr matches        `thenM` \ (new_matches, ms_fvs) ->
-    return (HsCase new_expr new_matches, e_fvs `plusFV` ms_fvs)
+  = do { (new_expr, e_fvs) <- rnLExpr expr
+       ; (new_matches, ms_fvs) <- rnMatchGroup CaseAlt rnLExpr matches
+       ; return (HsCase new_expr new_matches, e_fvs `plusFV` ms_fvs) }
 
 rnExpr (HsLet binds expr)
-  = rnLocalBindsAndThen binds           $ \ binds' ->
-    rnLExpr expr                         `thenM` \ (expr',fvExpr) ->
-    return (HsLet binds' expr', fvExpr)
+  = rnLocalBindsAndThen binds $ \binds' -> do
+      { (expr',fvExpr) <- rnLExpr expr
+      ; return (HsLet binds' expr', fvExpr) }
 
 rnExpr (HsDo do_or_lc stmts _)
   = do  { ((stmts', _), fvs) <- rnStmts do_or_lc rnLExpr stmts (\ _ -> return ((), emptyFVs))
@@ -248,8 +236,8 @@ rnExpr (ExplicitList _ _  exps)
             return  (ExplicitList placeHolderType Nothing exps', fvs) }
 
 rnExpr (ExplicitPArr _ exps)
-  = rnExprs exps                        `thenM` \ (exps', fvs) ->
-    return  (ExplicitPArr placeHolderType exps', fvs)
+  = do { (exps', fvs) <- rnExprs exps
+       ; return  (ExplicitPArr placeHolderType exps', fvs) }
 
 rnExpr (ExplicitTuple tup_args boxity)
   = do { checkTupleSection tup_args
@@ -290,8 +278,8 @@ rnExpr (HsMultiIf ty alts)
        ; return (HsMultiIf ty alts', fvs) }
 
 rnExpr (HsType a)
-  = rnLHsType HsTypeCtx a       `thenM` \ (t, fvT) ->
-    return (HsType t, fvT)
+  = do { (t, fvT) <- rnLHsType HsTypeCtx a
+       ; return (HsType t, fvT) }
 
 rnExpr (ArithSeq _ _ seq)
   = do { opt_OverloadedLists <- xoptM Opt_OverloadedLists
@@ -304,8 +292,8 @@ rnExpr (ArithSeq _ _ seq)
             return (ArithSeq noPostTcExpr Nothing new_seq, fvs) }
 
 rnExpr (PArrSeq _ seq)
-  = rnArithSeq seq       `thenM` \ (new_seq, fvs) ->
-    return (PArrSeq noPostTcExpr new_seq, fvs)
+  = do { (new_seq, fvs) <- rnArithSeq seq
+       ; return (PArrSeq noPostTcExpr new_seq, fvs) }
 \end{code}
 
 These three are pattern syntax appearing in expressions.
@@ -332,9 +320,9 @@ rnExpr e@(ELazyPat {}) = patSynErr e
 \begin{code}
 rnExpr (HsProc pat body)
   = newArrowScope $
-    rnPat ProcExpr pat $ \ pat' ->
-    rnCmdTop body                `thenM` \ (body',fvBody) ->
-    return (HsProc pat' body', fvBody)
+    rnPat ProcExpr pat $ \ pat' -> do
+      { (body',fvBody) <- rnCmdTop body
+      ; return (HsProc pat' body', fvBody) }
 
 -- Ideally, these would be done in parsing, but to keep parsing simple, we do it here.
 rnExpr e@(HsArrApp {})  = arrowFail e
@@ -402,9 +390,9 @@ rnHsRecBinds ctxt rec_binds@(HsRecFields { rec_dotdot = dd })
 rnCmdArgs :: [LHsCmdTop RdrName] -> RnM ([LHsCmdTop Name], FreeVars)
 rnCmdArgs [] = return ([], emptyFVs)
 rnCmdArgs (arg:args)
-  = rnCmdTop arg        `thenM` \ (arg',fvArg) ->
-    rnCmdArgs args      `thenM` \ (args',fvArgs) ->
-    return (arg':args', fvArg `plusFV` fvArgs)
+  = do { (arg',fvArg) <- rnCmdTop arg
+       ; (args',fvArgs) <- rnCmdArgs args
+       ; return (arg':args', fvArg `plusFV` fvArgs) }
 
 rnCmdTop :: LHsCmdTop RdrName -> RnM (LHsCmdTop Name, FreeVars)
 rnCmdTop = wrapLocFstM rnCmdTop'
@@ -425,10 +413,10 @@ rnLCmd = wrapLocFstM rnCmd
 rnCmd :: HsCmd RdrName -> RnM (HsCmd Name, FreeVars)
 
 rnCmd (HsCmdArrApp arrow arg _ ho rtl)
-  = select_arrow_scope (rnLExpr arrow)  `thenM` \ (arrow',fvArrow) ->
-    rnLExpr arg                         `thenM` \ (arg',fvArg) ->
-    return (HsCmdArrApp arrow' arg' placeHolderType ho rtl,
-             fvArrow `plusFV` fvArg)
+  = do { (arrow',fvArrow) <- select_arrow_scope (rnLExpr arrow)
+       ; (arg',fvArg) <- rnLExpr arg
+       ; return (HsCmdArrApp arrow' arg' placeHolderType ho rtl,
+                 fvArrow `plusFV` fvArg) }
   where
     select_arrow_scope tc = case ho of
         HsHigherOrderApp -> tc
@@ -441,42 +429,37 @@ rnCmd (HsCmdArrApp arrow arg _ ho rtl)
 
 -- infix form
 rnCmd (HsCmdArrForm op (Just _) [arg1, arg2])
-  = escapeArrowScope (rnLExpr op)
-                        `thenM` \ (op',fv_op) ->
-    let L _ (HsVar op_name) = op' in
-    rnCmdTop arg1       `thenM` \ (arg1',fv_arg1) ->
-    rnCmdTop arg2       `thenM` \ (arg2',fv_arg2) ->
-
+  = do { (op',fv_op) <- escapeArrowScope (rnLExpr op)
+       ; let L _ (HsVar op_name) = op'
+       ; (arg1',fv_arg1) <- rnCmdTop arg1
+       ; (arg2',fv_arg2) <- rnCmdTop arg2
         -- Deal with fixity
-
-    lookupFixityRn op_name              `thenM` \ fixity ->
-    mkOpFormRn arg1' op' fixity arg2'   `thenM` \ final_e ->
-
-    return (final_e,
-              fv_arg1 `plusFV` fv_op `plusFV` fv_arg2)
+       ; fixity <- lookupFixityRn op_name
+       ; final_e <- mkOpFormRn arg1' op' fixity arg2'
+       ; return (final_e, fv_arg1 `plusFV` fv_op `plusFV` fv_arg2) }
 
 rnCmd (HsCmdArrForm op fixity cmds)
-  = escapeArrowScope (rnLExpr op)       `thenM` \ (op',fvOp) ->
-    rnCmdArgs cmds                      `thenM` \ (cmds',fvCmds) ->
-    return (HsCmdArrForm op' fixity cmds', fvOp `plusFV` fvCmds)
+  = do { (op',fvOp) <- escapeArrowScope (rnLExpr op)
+       ; (cmds',fvCmds) <- rnCmdArgs cmds
+       ; return (HsCmdArrForm op' fixity cmds', fvOp `plusFV` fvCmds) }
 
 rnCmd (HsCmdApp fun arg)
-  = rnLCmd  fun         `thenM` \ (fun',fvFun) ->
-    rnLExpr arg         `thenM` \ (arg',fvArg) ->
-    return (HsCmdApp fun' arg', fvFun `plusFV` fvArg)
+  = do { (fun',fvFun) <- rnLCmd  fun
+       ; (arg',fvArg) <- rnLExpr arg
+       ; return (HsCmdApp fun' arg', fvFun `plusFV` fvArg) }
 
 rnCmd (HsCmdLam matches)
-  = rnMatchGroup LambdaExpr rnLCmd matches     `thenM` \ (matches', fvMatch) ->
-    return (HsCmdLam matches', fvMatch)
+  = do { (matches', fvMatch) <- rnMatchGroup LambdaExpr rnLCmd matches
+       ; return (HsCmdLam matches', fvMatch) }
 
 rnCmd (HsCmdPar e)
   = do  { (e', fvs_e) <- rnLCmd e
         ; return (HsCmdPar e', fvs_e) }
 
 rnCmd (HsCmdCase expr matches)
-  = rnLExpr expr                        `thenM` \ (new_expr, e_fvs) ->
-    rnMatchGroup CaseAlt rnLCmd matches `thenM` \ (new_matches, ms_fvs) ->
-    return (HsCmdCase new_expr new_matches, e_fvs `plusFV` ms_fvs)
+  = do { (new_expr, e_fvs) <- rnLExpr expr
+       ; (new_matches, ms_fvs) <- rnMatchGroup CaseAlt rnLCmd matches
+       ; return (HsCmdCase new_expr new_matches, e_fvs `plusFV` ms_fvs) }
 
 rnCmd (HsCmdIf _ p b1 b2)
   = do { (p', fvP) <- rnLExpr p
@@ -486,9 +469,9 @@ rnCmd (HsCmdIf _ p b1 b2)
        ; return (HsCmdIf mb_ite p' b1' b2', plusFVs [fvITE, fvP, fvB1, fvB2]) }
 
 rnCmd (HsCmdLet binds cmd)
-  = rnLocalBindsAndThen binds           $ \ binds' ->
-    rnLCmd cmd                         `thenM` \ (cmd',fvExpr) ->
-    return (HsCmdLet binds' cmd', fvExpr)
+  = rnLocalBindsAndThen binds $ \ binds' -> do
+      { (cmd',fvExpr) <- rnLCmd cmd
+      ; return (HsCmdLet binds' cmd', fvExpr) }
 
 rnCmd (HsCmdDo stmts _)
   = do  { ((stmts', _), fvs) <- rnStmts ArrowExpr rnLCmd stmts (\ _ -> return ((), emptyFVs))
@@ -578,25 +561,25 @@ methodNamesStmt (TransStmt {})                   = emptyFVs
 \begin{code}
 rnArithSeq :: ArithSeqInfo RdrName -> RnM (ArithSeqInfo Name, FreeVars)
 rnArithSeq (From expr)
- = rnLExpr expr         `thenM` \ (expr', fvExpr) ->
-   return (From expr', fvExpr)
+ = do { (expr', fvExpr) <- rnLExpr expr
+      ; return (From expr', fvExpr) }
 
 rnArithSeq (FromThen expr1 expr2)
- = rnLExpr expr1        `thenM` \ (expr1', fvExpr1) ->
-   rnLExpr expr2        `thenM` \ (expr2', fvExpr2) ->
-   return (FromThen expr1' expr2', fvExpr1 `plusFV` fvExpr2)
+ = do { (expr1', fvExpr1) <- rnLExpr expr1
+      ; (expr2', fvExpr2) <- rnLExpr expr2
+      ; return (FromThen expr1' expr2', fvExpr1 `plusFV` fvExpr2) }
 
 rnArithSeq (FromTo expr1 expr2)
- = rnLExpr expr1        `thenM` \ (expr1', fvExpr1) ->
-   rnLExpr expr2        `thenM` \ (expr2', fvExpr2) ->
-   return (FromTo expr1' expr2', fvExpr1 `plusFV` fvExpr2)
+ = do { (expr1', fvExpr1) <- rnLExpr expr1
+      ; (expr2', fvExpr2) <- rnLExpr expr2
+      ; return (FromTo expr1' expr2', fvExpr1 `plusFV` fvExpr2) }
 
 rnArithSeq (FromThenTo expr1 expr2 expr3)
- = rnLExpr expr1        `thenM` \ (expr1', fvExpr1) ->
-   rnLExpr expr2        `thenM` \ (expr2', fvExpr2) ->
-   rnLExpr expr3        `thenM` \ (expr3', fvExpr3) ->
-   return (FromThenTo expr1' expr2' expr3',
-            plusFVs [fvExpr1, fvExpr2, fvExpr3])
+ = do { (expr1', fvExpr1) <- rnLExpr expr1
+      ; (expr2', fvExpr2) <- rnLExpr expr2
+      ; (expr3', fvExpr3) <- rnLExpr expr3
+      ; return (FromThenTo expr1' expr2' expr3',
+                plusFVs [fvExpr1, fvExpr2, fvExpr3]) }
 \end{code}
 
 %************************************************************************
@@ -959,21 +942,19 @@ rn_rec_stmt rnBody _ (L loc (LastStmt body _)) _
                    L loc (LastStmt body' ret_op))] }
 
 rn_rec_stmt rnBody _ (L loc (BodyStmt body _ _ _)) _
-  = rnBody body `thenM` \ (body', fvs) ->
-    lookupSyntaxName thenMName  `thenM` \ (then_op, fvs1) ->
-    return [(emptyNameSet, fvs `plusFV` fvs1, emptyNameSet,
-              L loc (BodyStmt body' then_op noSyntaxExpr placeHolderType))]
+  = do { (body', fvs) <- rnBody body
+       ; (then_op, fvs1) <- lookupSyntaxName thenMName
+       ; return [(emptyNameSet, fvs `plusFV` fvs1, emptyNameSet,
+                 L loc (BodyStmt body' then_op noSyntaxExpr placeHolderType))] }
 
 rn_rec_stmt rnBody _ (L loc (BindStmt pat' body _ _)) fv_pat
-  = rnBody body         `thenM` \ (body', fv_expr) ->
-    lookupSyntaxName bindMName  `thenM` \ (bind_op, fvs1) ->
-    lookupSyntaxName failMName  `thenM` \ (fail_op, fvs2) ->
-    let
-        bndrs = mkNameSet (collectPatBinders pat')
-        fvs   = fv_expr `plusFV` fv_pat `plusFV` fvs1 `plusFV` fvs2
-    in
-    return [(bndrs, fvs, bndrs `intersectNameSet` fvs,
-              L loc (BindStmt pat' body' bind_op fail_op))]
+  = do { (body', fv_expr) <- rnBody body
+       ; (bind_op, fvs1) <- lookupSyntaxName bindMName
+       ; (fail_op, fvs2) <- lookupSyntaxName failMName
+       ; let bndrs = mkNameSet (collectPatBinders pat')
+             fvs   = fv_expr `plusFV` fv_pat `plusFV` fvs1 `plusFV` fvs2
+       ; return [(bndrs, fvs, bndrs `intersectNameSet` fvs,
+                  L loc (BindStmt pat' body' bind_op fail_op))] }
 
 rn_rec_stmt _ _ (L _ (LetStmt binds@(HsIPBinds _))) _
   = failWith (badIpBinds (ptext (sLit "an mdo expression")) binds)
@@ -1003,9 +984,9 @@ rn_rec_stmts :: Outputable (body RdrName) =>
              -> [Name]
              -> [(LStmtLR Name RdrName (Located (body RdrName)), FreeVars)]
              -> RnM [Segment (LStmt Name (Located (body Name)))]
-rn_rec_stmts rnBody bndrs stmts =
-    mapM (uncurry (rn_rec_stmt rnBody bndrs)) stmts     `thenM` \ segs_s ->
-    return (concat segs_s)
+rn_rec_stmts rnBody bndrs stmts
+  = do { segs_s <- mapM (uncurry (rn_rec_stmt rnBody bndrs)) stmts
+       ; return (concat segs_s) }
 
 ---------------------------------------------
 segmentRecStmts :: HsStmtContext Name 
@@ -1245,8 +1226,8 @@ checkStmt :: HsStmtContext Name
 checkStmt ctxt (L _ stmt)
   = do { dflags <- getDynFlags
        ; case okStmt dflags ctxt stmt of
-           Nothing    -> return ()
-           Just extra -> addErr (msg $$ extra) }
+           IsValid        -> return ()
+           NotValid extra -> addErr (msg $$ extra) }
   where
    msg = sep [ ptext (sLit "Unexpected") <+> pprStmtCat stmt <+> ptext (sLit "statement")
              , ptext (sLit "in") <+> pprAStmtContext ctxt ]
@@ -1261,13 +1242,12 @@ pprStmtCat (RecStmt {})       = ptext (sLit "rec")
 pprStmtCat (ParStmt {})       = ptext (sLit "parallel")
 
 ------------
-isOK, notOK :: Maybe SDoc
-isOK  = Nothing
-notOK = Just empty
+emptyInvalid :: Validity  -- Payload is the empty document
+emptyInvalid = NotValid empty
 
 okStmt, okDoStmt, okCompStmt, okParStmt, okPArrStmt
    :: DynFlags -> HsStmtContext Name
-   -> Stmt RdrName (Located (body RdrName)) -> Maybe SDoc
+   -> Stmt RdrName (Located (body RdrName)) -> Validity
 -- Return Nothing if OK, (Just extra) if not ok
 -- The "extra" is an SDoc that is appended to an generic error message
 
@@ -1285,59 +1265,59 @@ okStmt dflags ctxt stmt
       TransStmtCtxt ctxt -> okStmt dflags ctxt stmt
 
 -------------
-okPatGuardStmt :: Stmt RdrName (Located (body RdrName)) -> Maybe SDoc
+okPatGuardStmt :: Stmt RdrName (Located (body RdrName)) -> Validity
 okPatGuardStmt stmt
   = case stmt of
-      BodyStmt {} -> isOK
-      BindStmt {} -> isOK
-      LetStmt {}  -> isOK
-      _           -> notOK
+      BodyStmt {} -> IsValid
+      BindStmt {} -> IsValid
+      LetStmt {}  -> IsValid
+      _           -> emptyInvalid
 
 -------------
 okParStmt dflags ctxt stmt
   = case stmt of
-      LetStmt (HsIPBinds {}) -> notOK
+      LetStmt (HsIPBinds {}) -> emptyInvalid
       _                      -> okStmt dflags ctxt stmt
 
 ----------------
 okDoStmt dflags ctxt stmt
   = case stmt of
        RecStmt {}
-         | Opt_RecursiveDo `xopt` dflags -> isOK
-         | ArrowExpr <- ctxt -> isOK    -- Arrows allows 'rec'
-         | otherwise         -> Just (ptext (sLit "Use RecursiveDo"))
-       BindStmt {} -> isOK
-       LetStmt {}  -> isOK
-       BodyStmt {} -> isOK
-       _           -> notOK
+         | Opt_RecursiveDo `xopt` dflags -> IsValid
+         | ArrowExpr <- ctxt -> IsValid    -- Arrows allows 'rec'
+         | otherwise         -> NotValid (ptext (sLit "Use RecursiveDo"))
+       BindStmt {} -> IsValid
+       LetStmt {}  -> IsValid
+       BodyStmt {} -> IsValid
+       _           -> emptyInvalid
 
 ----------------
 okCompStmt dflags _ stmt
   = case stmt of
-       BindStmt {} -> isOK
-       LetStmt {}  -> isOK
-       BodyStmt {} -> isOK
+       BindStmt {} -> IsValid
+       LetStmt {}  -> IsValid
+       BodyStmt {} -> IsValid
        ParStmt {}
-         | Opt_ParallelListComp `xopt` dflags -> isOK
-         | otherwise -> Just (ptext (sLit "Use ParallelListComp"))
+         | Opt_ParallelListComp `xopt` dflags -> IsValid
+         | otherwise -> NotValid (ptext (sLit "Use ParallelListComp"))
        TransStmt {}
-         | Opt_TransformListComp `xopt` dflags -> isOK
-         | otherwise -> Just (ptext (sLit "Use TransformListComp"))
-       RecStmt {}  -> notOK
-       LastStmt {} -> notOK  -- Should not happen (dealt with by checkLastStmt)
+         | Opt_TransformListComp `xopt` dflags -> IsValid
+         | otherwise -> NotValid (ptext (sLit "Use TransformListComp"))
+       RecStmt {}  -> emptyInvalid
+       LastStmt {} -> emptyInvalid  -- Should not happen (dealt with by checkLastStmt)
 
 ----------------
 okPArrStmt dflags _ stmt
   = case stmt of
-       BindStmt {} -> isOK
-       LetStmt {}  -> isOK
-       BodyStmt {} -> isOK
+       BindStmt {} -> IsValid
+       LetStmt {}  -> IsValid
+       BodyStmt {} -> IsValid
        ParStmt {}
-         | Opt_ParallelListComp `xopt` dflags -> isOK
-         | otherwise -> Just (ptext (sLit "Use ParallelListComp"))
-       TransStmt {} -> notOK
-       RecStmt {}   -> notOK
-       LastStmt {}  -> notOK  -- Should not happen (dealt with by checkLastStmt)
+         | Opt_ParallelListComp `xopt` dflags -> IsValid
+         | otherwise -> NotValid (ptext (sLit "Use ParallelListComp"))
+       TransStmt {} -> emptyInvalid
+       RecStmt {}   -> emptyInvalid
+       LastStmt {}  -> emptyInvalid  -- Should not happen (dealt with by checkLastStmt)
 
 ---------
 checkTupleSection :: [HsTupArg RdrName] -> RnM ()
diff --git a/compiler/rename/RnNames.lhs b/compiler/rename/RnNames.lhs
index 56ee969aed2b..5071828e4d87 100644
--- a/compiler/rename/RnNames.lhs
+++ b/compiler/rename/RnNames.lhs
@@ -4,6 +4,8 @@
 \section[RnNames]{Extracting imported and top-level names in scope}
 
 \begin{code}
+{-# LANGUAGE CPP, NondecreasingIndentation #-}
+
 module RnNames (
         rnImports, getLocalNonValBinders,
         rnExports, extendGlobalRdrEnvRn,
@@ -257,7 +259,7 @@ rnImportDecl this_mod
                               imp_mod : dep_finsts deps
                | otherwise  = dep_finsts deps
 
-        pkg = modulePackageId (mi_module iface)
+        pkg = modulePackageKey (mi_module iface)
 
         -- Does this import mean we now require our own pkg
         -- to be trusted? See Note [Trust Own Package]
@@ -572,6 +574,29 @@ the environment, and then process the type instances.
 @filterImports@ takes the @ExportEnv@ telling what the imported module makes
 available, and filters it through the import spec (if any).
 
+Note [Dealing with imports]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~
+For import M( ies ), we take the mi_exports of M, and make 
+   imp_occ_env :: OccEnv (Name, AvailInfo, Maybe Name) 
+One entry for each Name that M exports; the AvailInfo describes just
+that Name.   
+
+The situation is made more complicated by associated types. E.g.
+   module M where
+     class    C a    where { data T a }
+     instance C Int  where { data T Int = T1 | T2 }
+     instance C Bool where { data T Int = T3 }
+Then M's export_avails are (recall the AvailTC invariant from Avails.hs)
+  C(C,T), T(T,T1,T2,T3)
+Notice that T appears *twice*, once as a child and once as a parent.
+From this we construct the imp_occ_env
+   C  -> (C,  C(C,T),        Nothing
+   T  -> (T,  T(T,T1,T2,T3), Just C)
+   T1 -> (T1, T(T1,T2,T3),   Nothing)   -- similarly T2,T3
+
+Note that the imp_occ_env will have entries for data constructors too,
+although we never look up data constructors.
+
 \begin{code}
 filterImports :: ModIface
               -> ImpDeclSpec                    -- The span for the entire import decl
@@ -605,34 +630,22 @@ filterImports iface decl_spec (Just (want_hiding, import_items))
   where
     all_avails = mi_exports iface
 
-        -- This environment is how we map names mentioned in the import
-        -- list to the actual Name they correspond to, and the name family
-        -- that the Name belongs to (the AvailInfo).  The situation is
-        -- complicated by associated families, which introduce a three-level
-        -- hierachy, where class = grand parent, assoc family = parent, and
-        -- data constructors = children.  The occ_env entries for associated
-        -- families needs to capture all this information; hence, we have the
-        -- third component of the environment that gives the class name (=
-        -- grand parent) in case of associated families.
-        --
-        -- This env will have entries for data constructors too,
-        -- they won't make any difference because naked entities like T
-        -- in an import list map to TcOccs, not VarOccs.
-    occ_env :: OccEnv (Name,        -- the name
-                       AvailInfo,   -- the export item providing the name
-                       Maybe Name)  -- the parent of associated types
-    occ_env = mkOccEnv_C combine [ (nameOccName n, (n, a, Nothing))
-                                 | a <- all_avails, n <- availNames a]
+        -- See Note [Dealing with imports]
+    imp_occ_env :: OccEnv (Name,        -- the name
+                           AvailInfo,   -- the export item providing the name
+                           Maybe Name)  -- the parent of associated types
+    imp_occ_env = mkOccEnv_C combine [ (nameOccName n, (n, a, Nothing))
+                                     | a <- all_avails, n <- availNames a]
       where
-        -- we know that (1) there are at most 2 entries for one name, (2) their
-        -- first component is identical, (3) they are for tys/cls, and (4) one
-        -- entry has the name in its parent position (the other doesn't)
-        combine (name, AvailTC p1 subs1, Nothing)
-                (_   , AvailTC p2 subs2, Nothing)
-          = let
-              (parent, subs) = if p1 == name then (p2, subs1) else (p1, subs2)
-            in
-            (name, AvailTC name subs, Just parent)
+        -- See example in Note [Dealing with imports]
+        -- 'combine' is only called for associated types which appear twice
+        -- in the all_avails. In the example, we combine
+        --    T(T,T1,T2,T3) and C(C,T)  to give   (T, T(T,T1,T2,T3), Just C)
+        combine (name1, a1@(AvailTC p1 _), mp1)
+                (name2, a2@(AvailTC p2 _), mp2)
+          = ASSERT( name1 == name2 && isNothing mp1 && isNothing mp2 )
+            if p1 == name1 then (name1, a1, Just p2)
+                           else (name1, a2, Just p1)
         combine x y = pprPanic "filterImports/combine" (ppr x $$ ppr y)
 
     lookup_name :: RdrName -> IELookupM (Name, AvailInfo, Maybe Name)
@@ -640,7 +653,7 @@ filterImports iface decl_spec (Just (want_hiding, import_items))
                     | Just succ <- mb_success = return succ
                     | otherwise               = failLookupWith BadImport
       where
-        mb_success = lookupOccEnv occ_env (rdrNameOcc rdr)
+        mb_success = lookupOccEnv imp_occ_env (rdrNameOcc rdr)
 
     lookup_lie :: LIE RdrName -> TcRn [(LIE Name, AvailInfo)]
     lookup_lie (L loc ieRdr)
@@ -677,7 +690,7 @@ filterImports iface decl_spec (Just (want_hiding, import_items))
         -- type/class and a data constructor.  Moreover, when we import
         -- data constructors of an associated family, we need separate
         -- AvailInfos for the data constructors and the family (as they have
-        -- different parents).  See the discussion at occ_env.
+        -- different parents).  See Note [Dealing with imports]
     lookup_ie :: IE RdrName -> IELookupM ([(IE Name, AvailInfo)], [IELookupWarning])
     lookup_ie ie = handle_bad_import $ do
       case ie of
@@ -713,11 +726,16 @@ filterImports iface decl_spec (Just (want_hiding, import_items))
             -> do nameAvail <- lookup_name tc
                   return ([mkIEThingAbs nameAvail], [])
 
-        IEThingWith tc ns -> do
-           (name, AvailTC _ subnames, mb_parent) <- lookup_name tc
+        IEThingWith rdr_tc rdr_ns -> do
+           (name, AvailTC _ ns, mb_parent) <- lookup_name rdr_tc
 
            -- Look up the children in the sub-names of the parent
-           let mb_children = lookupChildren subnames ns
+           let subnames = case ns of   -- The tc is first in ns, 
+                            [] -> []   -- if it is there at all
+                                       -- See the AvailTC Invariant in Avail.hs
+                            (n1:ns1) | n1 == name -> ns1
+                                     | otherwise  -> ns
+               mb_children = lookupChildren subnames rdr_ns
 
            children <- if any isNothing mb_children
                        then failLookupWith BadImport
@@ -1285,11 +1303,14 @@ type ImportDeclUsage
 warnUnusedImportDecls :: TcGblEnv -> RnM ()
 warnUnusedImportDecls gbl_env
   = do { uses <- readMutVar (tcg_used_rdrnames gbl_env)
-       ; let imports = filter explicit_import (tcg_rn_imports gbl_env)
+       ; let user_imports = filterOut (ideclImplicit . unLoc) (tcg_rn_imports gbl_env)
+                            -- This whole function deals only with *user* imports
+                            -- both for warning about unnecessary ones, and for
+                            -- deciding the minimal ones
              rdr_env = tcg_rdr_env gbl_env
 
        ; let usage :: [ImportDeclUsage]
-             usage = findImportUsage imports rdr_env (Set.elems uses)
+             usage = findImportUsage user_imports rdr_env (Set.elems uses)
 
        ; traceRn (vcat [ ptext (sLit "Uses:") <+> ppr (Set.elems uses)
                        , ptext (sLit "Import usage") <+> ppr usage])
@@ -1298,10 +1319,6 @@ warnUnusedImportDecls gbl_env
 
        ; whenGOptM Opt_D_dump_minimal_imports $
          printMinimalImports usage }
-  where
-    explicit_import (L _ decl) = not (ideclImplicit decl)
-        -- Filter out the implicit Prelude import
-        -- which we do not want to bleat about
 \end{code}
 
 
@@ -1417,6 +1434,11 @@ warnUnusedImport :: ImportDeclUsage -> RnM ()
 warnUnusedImport (L loc decl, used, unused)
   | Just (False,[]) <- ideclHiding decl
                 = return ()            -- Do not warn for 'import M()'
+
+  | Just (True, hides) <- ideclHiding decl
+  , not (null hides)
+  , pRELUDE_NAME == unLoc (ideclName decl)
+                = return ()            -- Note [Do not warn about Prelude hiding]
   | null used   = addWarnAt loc msg1   -- Nothing used; drop entire decl
   | null unused = return ()            -- Everything imported is used; nop
   | otherwise   = addWarnAt loc msg2   -- Some imports are unused
@@ -1436,6 +1458,19 @@ warnUnusedImport (L loc decl, used, unused)
     pp_not_used = text "is redundant"
 \end{code}
 
+Note [Do not warn about Prelude hiding]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+We do not warn about
+   import Prelude hiding( x, y )
+because even if nothing else from Prelude is used, it may be essential to hide
+x,y to avoid name-shadowing warnings.  Example (Trac #9061)
+   import Prelude hiding( log )
+   f x = log where log = ()
+
+
+
+Note [Printing minimal imports]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 To print the minimal imports we walk over the user-supplied import
 decls, and simply trim their import lists.  NB that
 
@@ -1446,6 +1481,7 @@ decls, and simply trim their import lists.  NB that
 
 \begin{code}
 printMinimalImports :: [ImportDeclUsage] -> RnM ()
+-- See Note [Printing minimal imports]
 printMinimalImports imports_w_usage
   = do { imports' <- mapM mk_minimal imports_w_usage
        ; this_mod <- getModule
diff --git a/compiler/rename/RnPat.lhs b/compiler/rename/RnPat.lhs
index 3fde563cd346..48fffce3740c 100644
--- a/compiler/rename/RnPat.lhs
+++ b/compiler/rename/RnPat.lhs
@@ -10,19 +10,15 @@ general, all of these functions return a renamed thing, and a set of
 free variables.
 
 \begin{code}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and
--- detab the module (please do the detabbing in a separate patch). See
---     http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
--- for details
+{-# LANGUAGE CPP, RankNTypes, ScopedTypeVariables #-}
 
-{-# LANGUAGE ScopedTypeVariables #-}
 module RnPat (-- main entry points
               rnPat, rnPats, rnBindPat, rnPatAndThen,
 
               NameMaker, applyNameMaker,     -- a utility for making names:
               localRecNameMaker, topRecNameMaker,  --   sometimes we want to make local names,
                                              --   sometimes we want to make top (qualified) names.
+              isTopRecNameMaker,
 
               rnHsRecFields1, HsRecFieldContext(..),
 
@@ -193,6 +189,10 @@ data NameMaker
 topRecNameMaker :: MiniFixityEnv -> NameMaker
 topRecNameMaker fix_env = LetMk TopLevel fix_env
 
+isTopRecNameMaker :: NameMaker -> Bool
+isTopRecNameMaker (LetMk TopLevel _) = True
+isTopRecNameMaker _ = False
+
 localRecNameMaker :: MiniFixityEnv -> NameMaker
 localRecNameMaker fix_env = LetMk NotTopLevel fix_env 
 
@@ -434,7 +434,7 @@ rnPatAndThen mk (PArrPat pats _)
 rnPatAndThen mk (TuplePat pats boxed _)
   = do { liftCps $ checkTupSize (length pats)
        ; pats' <- rnLPatsAndThen mk pats
-       ; return (TuplePat pats' boxed placeHolderType) }
+       ; return (TuplePat pats' boxed []) }
 
 rnPatAndThen _ (SplicePat splice)
   = do { -- XXX How to deal with free variables?
diff --git a/compiler/rename/RnSource.lhs b/compiler/rename/RnSource.lhs
index c726d554fcb7..a3bd38a3ec35 100644
--- a/compiler/rename/RnSource.lhs
+++ b/compiler/rename/RnSource.lhs
@@ -4,6 +4,8 @@
 \section[RnSource]{Main pass of renamer}
 
 \begin{code}
+{-# LANGUAGE CPP, ScopedTypeVariables #-}
+
 module RnSource (
         rnSrcDecls, addTcgDUs, rnTyClDecls, findSplice
     ) where
@@ -35,7 +37,7 @@ import NameEnv
 import Avail
 import Outputable
 import Bag
-import BasicTypes       ( RuleName, Origin(..) )
+import BasicTypes       ( RuleName )
 import FastString
 import SrcLoc
 import DynFlags
@@ -382,8 +384,8 @@ rnHsForeignDecl (ForeignImport name ty _ spec)
        ; (ty', fvs) <- rnLHsType (ForeignDeclCtx name) ty
 
         -- Mark any PackageTarget style imports as coming from the current package
-       ; let packageId = thisPackage $ hsc_dflags topEnv
-             spec'     = patchForeignImport packageId spec
+       ; let packageKey = thisPackage $ hsc_dflags topEnv
+             spec'      = patchForeignImport packageKey spec
 
        ; return (ForeignImport name' ty' noForeignImportCoercionYet spec', fvs) }
 
@@ -400,20 +402,20 @@ rnHsForeignDecl (ForeignExport name ty _ spec)
 --      package, so if they get inlined across a package boundry we'll still
 --      know where they're from.
 --
-patchForeignImport :: PackageId -> ForeignImport -> ForeignImport
-patchForeignImport packageId (CImport cconv safety fs spec)
-        = CImport cconv safety fs (patchCImportSpec packageId spec)
+patchForeignImport :: PackageKey -> ForeignImport -> ForeignImport
+patchForeignImport packageKey (CImport cconv safety fs spec)
+        = CImport cconv safety fs (patchCImportSpec packageKey spec)
 
-patchCImportSpec :: PackageId -> CImportSpec -> CImportSpec
-patchCImportSpec packageId spec
+patchCImportSpec :: PackageKey -> CImportSpec -> CImportSpec
+patchCImportSpec packageKey spec
  = case spec of
-        CFunction callTarget    -> CFunction $ patchCCallTarget packageId callTarget
+        CFunction callTarget    -> CFunction $ patchCCallTarget packageKey callTarget
         _                       -> spec
 
-patchCCallTarget :: PackageId -> CCallTarget -> CCallTarget
-patchCCallTarget packageId callTarget =
+patchCCallTarget :: PackageKey -> CCallTarget -> CCallTarget
+patchCCallTarget packageKey callTarget =
   case callTarget of
-  StaticTarget label Nothing isFun -> StaticTarget label (Just packageId) isFun
+  StaticTarget label Nothing isFun -> StaticTarget label (Just packageKey) isFun
   _                                -> callTarget
 
 
@@ -443,12 +445,14 @@ rnSrcInstDecl (ClsInstD { cid_inst = cid })
 rnClsInstDecl :: ClsInstDecl RdrName -> RnM (ClsInstDecl Name, FreeVars)
 rnClsInstDecl (ClsInstDecl { cid_poly_ty = inst_ty, cid_binds = mbinds
                            , cid_sigs = uprags, cid_tyfam_insts = ats
+                           , cid_overlap_mode = oflag
                            , cid_datafam_insts = adts })
         -- Used for both source and interface file decls
   = do { (inst_ty', inst_fvs) <- rnLHsInstType (text "In an instance declaration") inst_ty
        ; case splitLHsInstDeclTy_maybe inst_ty' of {
            Nothing -> return (ClsInstDecl { cid_poly_ty = inst_ty', cid_binds = emptyLHsBinds
                                           , cid_sigs = [], cid_tyfam_insts = []
+                                          , cid_overlap_mode = oflag
                                           , cid_datafam_insts = [] }
                              , inst_fvs) ;
            Just (inst_tyvars, _, L _ cls,_) ->
@@ -461,7 +465,7 @@ rnClsInstDecl (ClsInstDecl { cid_poly_ty = inst_ty, cid_binds = mbinds
        ; traceRn (text "rnSrcInstDecl"  <+> ppr inst_ty' $$ ppr inst_tyvars $$ ppr ktv_names)
        ; ((ats', adts', other_sigs'), more_fvs) 
              <- extendTyVarEnvFVRn ktv_names $
-                do { (ats', at_fvs) <- rnATInstDecls rnTyFamInstDecl cls inst_tyvars ats
+                do { (ats',  at_fvs)  <- rnATInstDecls rnTyFamInstDecl cls inst_tyvars ats
                    ; (adts', adt_fvs) <- rnATInstDecls rnDataFamInstDecl cls inst_tyvars adts
                    ; (other_sigs', sig_fvs) <- renameSigs (InstDeclCtxt cls) other_sigs
                    ; return ( (ats', adts', other_sigs')
@@ -491,6 +495,7 @@ rnClsInstDecl (ClsInstDecl { cid_poly_ty = inst_ty, cid_binds = mbinds
                           `plusFV` inst_fvs
        ; return (ClsInstDecl { cid_poly_ty = inst_ty', cid_binds = mbinds'
                              , cid_sigs = uprags', cid_tyfam_insts = ats'
+                             , cid_overlap_mode = oflag
                              , cid_datafam_insts = adts' },
                  all_fvs) } } }
              -- We return the renamed associated data type declarations so
@@ -559,14 +564,29 @@ rnTyFamInstDecl mb_cls (TyFamInstDecl { tfid_eqn = L loc eqn })
 rnTyFamInstEqn :: Maybe (Name, [Name])
                -> TyFamInstEqn RdrName
                -> RnM (TyFamInstEqn Name, FreeVars)
-rnTyFamInstEqn mb_cls (TyFamInstEqn { tfie_tycon = tycon
-                                    , tfie_pats  = HsWB { hswb_cts = pats }
-                                    , tfie_rhs   = rhs })
+rnTyFamInstEqn mb_cls (TyFamEqn { tfe_tycon = tycon
+                                , tfe_pats  = HsWB { hswb_cts = pats }
+                                , tfe_rhs   = rhs })
   = do { (tycon', pats', rhs', fvs) <-
            rnFamInstDecl (TySynCtx tycon) mb_cls tycon pats rhs rnTySyn
-       ; return (TyFamInstEqn { tfie_tycon = tycon'
-                              , tfie_pats  = pats'
-                              , tfie_rhs   = rhs' }, fvs) }
+       ; return (TyFamEqn { tfe_tycon = tycon'
+                          , tfe_pats  = pats'
+                          , tfe_rhs   = rhs' }, fvs) }
+
+rnTyFamDefltEqn :: Name
+                -> TyFamDefltEqn RdrName
+                -> RnM (TyFamDefltEqn Name, FreeVars)
+rnTyFamDefltEqn cls (TyFamEqn { tfe_tycon = tycon
+                              , tfe_pats  = tyvars
+                              , tfe_rhs   = rhs })
+  = bindHsTyVars ctx (Just cls) [] tyvars $ \ tyvars' ->
+    do { tycon'      <- lookupFamInstName (Just cls) tycon
+       ; (rhs', fvs) <- rnLHsType ctx rhs
+       ; return (TyFamEqn { tfe_tycon = tycon'
+                          , tfe_pats  = tyvars'
+                          , tfe_rhs   = rhs' }, fvs) }
+  where
+    ctx = TyFamilyCtx tycon
 
 rnDataFamInstDecl :: Maybe (Name, [Name])
                   -> DataFamInstDecl RdrName
@@ -585,7 +605,7 @@ rnDataFamInstDecl mb_cls (DataFamInstDecl { dfid_tycon = tycon
 Renaming of the associated types in instances.
 
 \begin{code}
--- rename associated type family decl in class
+-- Rename associated type family decl in class
 rnATDecls :: Name      -- Class
           -> [LFamilyDecl RdrName] 
           -> RnM ([LFamilyDecl Name], FreeVars)
@@ -635,11 +655,11 @@ extendTyVarEnvForMethodBinds ktv_names thing_inside
 
 \begin{code}
 rnSrcDerivDecl :: DerivDecl RdrName -> RnM (DerivDecl Name, FreeVars)
-rnSrcDerivDecl (DerivDecl ty)
+rnSrcDerivDecl (DerivDecl ty overlap)
   = do { standalone_deriv_ok <- xoptM Opt_StandaloneDeriving
        ; unless standalone_deriv_ok (addErr standaloneDerivErr)
        ; (ty', fvs) <- rnLHsInstType (text "In a deriving declaration") ty
-       ; return (DerivDecl ty', fvs) }
+       ; return (DerivDecl ty' overlap, fvs) }
 
 standaloneDerivErr :: SDoc
 standaloneDerivErr
@@ -863,10 +883,10 @@ packages, it is safe not to add the dependencies on the .hs-boot stuff to B2.
 See also Note [Grouping of type and class declarations] in TcTyClsDecls.
 
 \begin{code}
-isInPackage :: PackageId -> Name -> Bool
+isInPackage :: PackageKey -> Name -> Bool
 isInPackage pkgId nm = case nameModule_maybe nm of
                          Nothing -> False
-                         Just m  -> pkgId == modulePackageId m
+                         Just m  -> pkgId == modulePackageKey m
 -- We use nameModule_maybe because we might be in a TH splice, in which case
 -- there is no module name. In that case we cannot have mutual dependencies,
 -- so it's fine to return False here.
@@ -936,7 +956,7 @@ rnTyClDecl (SynDecl { tcdLName = tycon, tcdTyVars = tyvars, tcdRhs = rhs })
                                     do { (rhs', fvs) <- rnTySyn doc rhs
                                        ; return ((tyvars', rhs'), fvs) }
        ; return (SynDecl { tcdLName = tycon', tcdTyVars = tyvars'
-                        , tcdRhs = rhs', tcdFVs = fvs }, fvs) }
+                         , tcdRhs = rhs', tcdFVs = fvs }, fvs) }
 
 -- "data", "newtype" declarations
 -- both top level and (for an associated type) in an instance decl
@@ -961,20 +981,20 @@ rnTyClDecl (ClassDecl {tcdCtxt = context, tcdLName = lcls,
                         -- kind signatures on the tyvars
 
         -- Tyvars scope over superclass context and method signatures
-        ; ((tyvars', context', fds', ats', at_defs', sigs'), stuff_fvs)
+        ; ((tyvars', context', fds', ats', sigs'), stuff_fvs)
             <- bindHsTyVars cls_doc Nothing kvs tyvars $ \ tyvars' -> do
                   -- Checks for distinct tyvars
              { (context', cxt_fvs) <- rnContext cls_doc context
-             ; fds'  <- rnFds (docOfHsDocContext cls_doc) fds
+             ; fds'  <- rnFds fds
                          -- The fundeps have no free variables
              ; (ats',     fv_ats)     <- rnATDecls cls' ats
-             ; (at_defs', fv_at_defs) <- rnATInstDecls rnTyFamInstDecl cls' tyvars' at_defs
              ; (sigs', sig_fvs) <- renameSigs (ClsDeclCtxt cls') sigs
              ; let fvs = cxt_fvs     `plusFV`
                          sig_fvs     `plusFV`
-                         fv_ats      `plusFV`
-                         fv_at_defs
-             ; return ((tyvars', context', fds', ats', at_defs', sigs'), fvs) }
+                         fv_ats
+             ; return ((tyvars', context', fds', ats', sigs'), fvs) }
+
+        ; (at_defs', fv_at_defs) <- rnList (rnTyFamDefltEqn cls') at_defs
 
         -- No need to check for duplicate associated type decls
         -- since that is done by RnNames.extendGlobalRdrEnvRn
@@ -1006,7 +1026,7 @@ rnTyClDecl (ClassDecl {tcdCtxt = context, tcdLName = lcls,
   -- Haddock docs
         ; docs' <- mapM (wrapLocM rnDocDecl) docs
 
-        ; let all_fvs = meth_fvs `plusFV` stuff_fvs
+        ; let all_fvs = meth_fvs `plusFV` stuff_fvs `plusFV` fv_at_defs
         ; return (ClassDecl { tcdCtxt = context', tcdLName = lcls',
                               tcdTyVars = tyvars', tcdFDs = fds', tcdSigs = sigs',
                               tcdMeths = mbinds', tcdATs = ats', tcdATDefs = at_defs',
@@ -1404,21 +1424,20 @@ extendRecordFieldEnv tycl_decls inst_decls
 %*********************************************************
 
 \begin{code}
-rnFds :: SDoc -> [Located (FunDep RdrName)] -> RnM [Located (FunDep Name)]
-
-rnFds doc fds
+rnFds :: [Located (FunDep RdrName)] -> RnM [Located (FunDep Name)]
+rnFds fds
   = mapM (wrapLocM rn_fds) fds
   where
     rn_fds (tys1, tys2)
-      = do { tys1' <- rnHsTyVars doc tys1
-           ; tys2' <- rnHsTyVars doc tys2
+      = do { tys1' <- rnHsTyVars tys1
+           ; tys2' <- rnHsTyVars tys2
            ; return (tys1', tys2') }
 
-rnHsTyVars :: SDoc -> [RdrName] -> RnM [Name]
-rnHsTyVars doc tvs  = mapM (rnHsTyVar doc) tvs
+rnHsTyVars :: [RdrName] -> RnM [Name]
+rnHsTyVars tvs  = mapM rnHsTyVar tvs
 
-rnHsTyVar :: SDoc -> RdrName -> RnM Name
-rnHsTyVar _doc tyvar = lookupOccRn tyvar
+rnHsTyVar :: RdrName -> RnM Name
+rnHsTyVar tyvar = lookupOccRn tyvar
 \end{code}
 
 
@@ -1518,7 +1537,7 @@ add_role_annot d (tycls@(TyClGroup { group_roles = roles }) : rest)
   = tycls { group_roles = d : roles } : rest
 
 add_bind :: LHsBind a -> HsValBinds a -> HsValBinds a
-add_bind b (ValBindsIn bs sigs) = ValBindsIn (bs `snocBag` (FromSource, b)) sigs
+add_bind b (ValBindsIn bs sigs) = ValBindsIn (bs `snocBag` b) sigs
 add_bind _ (ValBindsOut {})     = panic "RdrHsSyn:add_bind"
 
 add_sig :: LSig a -> HsValBinds a -> HsValBinds a
diff --git a/compiler/rename/RnSplice.lhs b/compiler/rename/RnSplice.lhs
index e0614d42488f..3c0c145e6b85 100644
--- a/compiler/rename/RnSplice.lhs
+++ b/compiler/rename/RnSplice.lhs
@@ -1,4 +1,6 @@
 \begin{code}
+{-# LANGUAGE CPP #-}
+
 module RnSplice (
         rnTopSpliceDecls,
         rnSpliceType, rnSpliceExpr, rnSplicePat, rnSpliceDecl,
diff --git a/compiler/rename/RnTypes.lhs b/compiler/rename/RnTypes.lhs
index 23c54c3bed9b..2f9bfdd65381 100644
--- a/compiler/rename/RnTypes.lhs
+++ b/compiler/rename/RnTypes.lhs
@@ -4,6 +4,8 @@
 \section[RnSource]{Main pass of renamer}
 
 \begin{code}
+{-# LANGUAGE CPP #-}
+
 module RnTypes (
         -- Type related stuff
         rnHsType, rnLHsType, rnLHsTypes, rnContext,
@@ -360,8 +362,9 @@ bindHsTyVars doc mb_assoc kv_bndrs tv_bndrs thing_inside
              kvs_from_tv_bndrs = [ kv | L _ (KindedTyVar _ kind) <- tvs
                                  , let (_, kvs) = extractHsTyRdrTyVars kind
                                  , kv <- kvs ]
-             all_kvs = filterOut (`elemLocalRdrEnv` rdr_env) $
-                       nub (kv_bndrs ++ kvs_from_tv_bndrs)
+             all_kvs' = nub (kv_bndrs ++ kvs_from_tv_bndrs)
+             all_kvs  = filterOut (`elemLocalRdrEnv` rdr_env) all_kvs'
+
              overlap_kvs = [ kv | kv <- all_kvs, any ((==) kv . hsLTyVarName) tvs ]
                 -- These variables appear both as kind and type variables
                 -- in the same declaration; eg  type family  T (x :: *) (y :: x)
@@ -395,8 +398,12 @@ bindHsTyVars doc mb_assoc kv_bndrs tv_bndrs thing_inside
 
        ; (tv_bndrs', fvs1) <- mapFvRn rn_tv_bndr tvs
        ; (res, fvs2) <- bindLocalNamesFV (map hsLTyVarName tv_bndrs') $
-                        do { env <- getLocalRdrEnv
-                           ; traceRn (text "bhtv" <+> (ppr tvs $$ ppr all_kvs $$ ppr env))
+                        do { inner_rdr_env <- getLocalRdrEnv
+                           ; traceRn (text "bhtv" <+> vcat
+                                 [ ppr tvs, ppr kv_bndrs, ppr kvs_from_tv_bndrs
+                                 , ppr $ map (`elemLocalRdrEnv` rdr_env) all_kvs'
+                                 , ppr $ map (getUnique . rdrNameOcc) all_kvs'
+                                 , ppr all_kvs, ppr rdr_env, ppr inner_rdr_env ])
                            ; thing_inside (HsQTvs { hsq_tvs = tv_bndrs', hsq_kvs = kv_names }) }
        ; return (res, fvs1 `plusFV` fvs2) } }
 
diff --git a/compiler/simplCore/CSE.lhs b/compiler/simplCore/CSE.lhs
index 691f883d02a2..5330029063a5 100644
--- a/compiler/simplCore/CSE.lhs
+++ b/compiler/simplCore/CSE.lhs
@@ -4,6 +4,8 @@
 \section{Common subexpression}
 
 \begin{code}
+{-# LANGUAGE CPP #-}
+
 module CSE (cseProgram) where
 
 #include "HsVersions.h"
@@ -12,7 +14,8 @@ import CoreSubst
 import Var              ( Var )
 import Id               ( Id, idType, idInlineActivation, zapIdOccInfo )
 import CoreUtils        ( mkAltExpr
-                        , exprIsTrivial)
+                        , exprIsTrivial
+                        , stripTicks, mkTick)
 import Type             ( tyConAppArgs )
 import CoreSyn
 import Outputable
@@ -185,9 +188,9 @@ cseBind env (Rec pairs)
 
 cseRhs :: CSEnv -> (OutBndr, InExpr) -> (CSEnv, OutExpr)
 cseRhs env (id',rhs)
-  = case lookupCSEnv env rhs' of
+  = case lookupCSEnv env rhs'' of
         Nothing -> (extendCSEnv env rhs' id', rhs')
-        Just id -> (extendCSSubst env id' id, Var id)
+        Just id -> (extendCSSubst env id' id, foldr mkTick (Var id) ticks)
           -- In the Just case, we have
           --        x = rhs
           --        ...
@@ -200,14 +203,17 @@ cseRhs env (id',rhs)
     rhs' | isAlwaysActive (idInlineActivation id') = cseExpr env rhs
          | otherwise                               = rhs
                 -- See Note [CSE for INLINE and NOINLINE]
+    (ticks, rhs'') = stripTicks tickishFloatable rhs'
+
 
 tryForCSE :: CSEnv -> InExpr -> OutExpr
 tryForCSE env expr
-  | exprIsTrivial expr'                   = expr'       -- No point
-  | Just smaller <- lookupCSEnv env expr' = Var smaller
-  | otherwise                             = expr'
+  | exprIsTrivial expr'                    = expr'       -- No point
+  | Just smaller <- lookupCSEnv env expr'' = foldr mkTick (Var smaller) ticks
+  | otherwise                              = expr'
   where
     expr' = cseExpr env expr
+    (ticks, expr'') = stripTicks tickishFloatable expr'
 
 cseExpr :: CSEnv -> InExpr -> OutExpr
 cseExpr env (Type t)               = Type (substTy (csEnvSubst env) t)
@@ -293,10 +299,15 @@ lookupCSEnv (CS { cs_map = csmap }) expr
   = case lookupCoreMap csmap expr of
       Just (_,e) -> Just e
       Nothing    -> Nothing
+    -- We don't want to lose the source notes when a common sub
+    -- expression gets eliminated. Hence we push all (!) of them on
+    -- top of the replaced sub-expression. This is probably not too
+    -- useful in practice, but upholds our semantics.
 
 extendCSEnv :: CSEnv -> OutExpr -> Id -> CSEnv
 extendCSEnv cse expr id
-  = cse { cs_map = extendCoreMap (cs_map cse) expr (expr,id) }
+  = cse { cs_map = extendCoreMap (cs_map cse) sexpr (sexpr,id) }
+  where (_, sexpr) = stripTicks tickishFloatable expr
 
 csEnvSubst :: CSEnv -> Subst
 csEnvSubst = cs_subst
diff --git a/compiler/simplCore/CallArity.hs b/compiler/simplCore/CallArity.hs
new file mode 100644
index 000000000000..9dcb61639778
--- /dev/null
+++ b/compiler/simplCore/CallArity.hs
@@ -0,0 +1,667 @@
+--
+-- Copyright (c) 2014 Joachim Breitner
+--
+
+module CallArity
+    ( callArityAnalProgram
+    , callArityRHS -- for testing
+    ) where
+
+import VarSet
+import VarEnv
+import DynFlags ( DynFlags )
+
+import BasicTypes
+import CoreSyn
+import Id
+import CoreArity ( typeArity )
+import CoreUtils ( exprIsHNF )
+--import Outputable
+import UnVarGraph
+
+import Control.Arrow ( first, second )
+
+
+{-
+%************************************************************************
+%*									*
+              Call Arity Analyis
+%*									*
+%************************************************************************
+
+Note [Call Arity: The goal]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+The goal of this analysis is to find out if we can eta-expand a local function,
+based on how it is being called. The motivating example is code this this,
+which comes up when we implement foldl using foldr, and do list fusion:
+
+    let go = \x -> let d = case ... of
+                              False -> go (x+1)
+                              True  -> id
+                   in \z -> d (x + z)
+    in go 1 0
+
+If we do not eta-expand `go` to have arity 2, we are going to allocate a lot of
+partial function applications, which would be bad.
+
+The function `go` has a type of arity two, but only one lambda is manifest.
+Further more, an analysis that only looks at the RHS of go cannot be sufficient
+to eta-expand go: If `go` is ever called with one argument (and the result used
+multiple times), we would be doing the work in `...` multiple times.
+
+So `callArityAnalProgram` looks at the whole let expression to figure out if
+all calls are nice, i.e. have a high enough arity. It then stores the result in
+the `calledArity` field of the `IdInfo` of `go`, which the next simplifier
+phase will eta-expand.
+
+The specification of the `calledArity` field is:
+
+    No work will be lost if you eta-expand me to the arity in `calledArity`.
+
+What we want to know for a variable
+-----------------------------------
+
+For every let-bound variable we'd like to know:
+  1. A lower bound on the arity of all calls to the variable, and
+  2. whether the variable is being called at most once or possible multiple
+     times.
+
+It is always ok to lower the arity, or pretend that there are multiple calls.
+In particular, "Minimum arity 0 and possible called multiple times" is always
+correct.
+
+
+What we want to know from an expression
+---------------------------------------
+
+In order to obtain that information for variables, we analyize expression and
+obtain bits of information:
+
+ I.  The arity analysis:
+     For every variable, whether it is absent, or called,
+     and if called, which what arity.
+
+ II. The Co-Called analysis:
+     For every two variables, whether there is a possibility that both are being
+     called.
+     We obtain as a special case: For every variables, whether there is a
+     possibility that it is being called twice.
+
+For efficiency reasons, we gather this information only for a set of
+*interesting variables*, to avoid spending time on, e.g., variables from pattern matches.
+
+The two analysis are not completely independent, as a higher arity can improve
+the information about what variables are being called once or multiple times.
+
+Note [Analysis I: The arity analyis]
+------------------------------------
+
+The arity analysis is quite straight forward: The information about an
+expression is an
+    VarEnv Arity
+where absent variables are bound to Nothing and otherwise to a lower bound to
+their arity.
+
+When we analyize an expression, we analyize it with a given context arity.
+Lambdas decrease and applications increase the incoming arity. Analysizing a
+variable will put that arity in the environment. In lets or cases all the
+results from the various subexpressions are lubed, which takes the point-wise
+minimum (considering Nothing an infinity).
+
+
+Note [Analysis II: The Co-Called analysis]
+------------------------------------------
+
+The second part is more sophisticated. For reasons explained below, it is not
+sufficient to simply know how often an expression evalutes a variable. Instead
+we need to know which variables are possibly called together.
+
+The data structure here is an undirected graph of variables, which is provided
+by the abstract
+    UnVarGraph
+
+It is safe to return a larger graph, i.e. one with more edges. The worst case
+(i.e. the least useful and always correct result) is the complete graph on all
+free variables, which means that anything can be called together with anything
+(including itself).
+
+Notation for the following:
+C(e)  is the co-called result for e.
+G�∪G₂ is the union of two graphs
+fv    is the set of free variables (conveniently the domain of the arity analysis result)
+S�×S₂ is the complete bipartite graph { {a,b} | a ∈ S�, b ∈ S₂ }
+S²    is the complete graph on the set of variables S, S² = S×S
+C'(e) is a variant for bound expression:
+      If e is called at most once, or it is and stays a thunk (after the analysis),
+      it is simply C(e). Otherwise, the expression can be called multiple times
+      and we return (fv e)²
+
+The interesting cases of the analysis:
+ * Var v:
+   No other variables are being called.
+   Return {} (the empty graph)
+ * Lambda v e, under arity 0:
+   This means that e can be evaluated many times and we cannot get
+   any useful co-call information.
+   Return (fv e)²
+ * Case alternatives alt�,alt₂,...:
+   Only one can be execuded, so
+   Return (alt� ∪ alt₂ ∪...)
+ * App e� e₂ (and analogously Case scrut alts):
+   We get the results from both sides. Additionally, anything called by e� can
+   possibly called with anything from eâ‚‚.
+   Return: C(e�) ∪ C(e₂) ∪ (fv e�) × (fv e₂)
+ * Let v = rhs in body:
+   In addition to the results from the subexpressions, add all co-calls from
+   everything that the body calls together with v to everthing that is called
+   by v.
+   Return: C'(rhs) ∪ C(body) ∪ (fv rhs) × {v'| {v,v'} ∈ C(body)}
+ * Letrec v� = rhs� ... vₙ = rhsₙ in body
+   Tricky.
+   We assume that it is really mutually recursive, i.e. that every variable
+   calls one of the others, and that this is strongly connected (otherwise we
+   return an over-approximation, so that's ok), see note [Recursion and fixpointing].
+
+   Let V = {v�,...vₙ}.
+   Assume that the vs have been analysed with an incoming demand and
+   cardinality consistent with the final result (this is the fixed-pointing).
+   Again we can use the results from all subexpressions.
+   In addition, for every variable váµ¢, we need to find out what it is called
+   with (call this set Sáµ¢). There are two cases:
+    * If váµ¢ is a function, we need to go through all right-hand-sides and bodies,
+      and collect every variable that is called together with any variable from V:
+      Sᵢ = {v' | j ∈ {1,...,n},      {v',vⱼ} ∈ C'(rhs�) ∪ ... ∪ C'(rhsₙ) ∪ C(body) }
+    * If váµ¢ is a thunk, then its rhs is evaluated only once, so we need to
+      exclude it from this set:
+      Sᵢ = {v' | j ∈ {1,...,n}, j≠i, {v',vⱼ} ∈ C'(rhs�) ∪ ... ∪ C'(rhsₙ) ∪ C(body) }
+   Finally, combine all this:
+   Return: C(body) ∪
+           C'(rhs�) ∪ ... ∪ C'(rhsₙ) ∪
+           (fv rhs�) × S�) ∪ ... ∪ (fv rhsₙ) × Sₙ)
+
+Using the result: Eta-Expansion
+-------------------------------
+
+We use the result of these two analyses to decide whether we can eta-expand the
+rhs of a let-bound variable.
+
+If the variable is already a function (exprIsHNF), and all calls to the
+variables have a higher arity than the current manifest arity (i.e. the number
+of lambdas), expand.
+
+If the variable is a thunk we must be careful: Eta-Expansion will prevent
+sharing of work, so this is only safe if there is at most one call to the
+function. Therefore, we check whether {v,v} ∈ G.
+
+    Example:
+
+        let n = case .. of .. -- A thunk!
+        in n 0 + n 1
+
+    vs.
+
+        let n = case .. of ..
+        in case .. of T -> n 0
+                      F -> n 1
+
+    We are only allowed to eta-expand `n` if it is going to be called at most
+    once in the body of the outer let. So we need to know, for each variable
+    individually, that it is going to be called at most once.
+
+
+Why the co-call graph?
+----------------------
+
+Why is it not sufficient to simply remember which variables are called once and
+which are called multiple times? It would be in the previous example, but consider
+
+        let n = case .. of ..
+        in case .. of
+            True -> let go = \y -> case .. of
+                                     True -> go (y + n 1)
+                                     False > n
+                    in go 1
+            False -> n
+
+vs.
+
+        let n = case .. of ..
+        in case .. of
+            True -> let go = \y -> case .. of
+                                     True -> go (y+1)
+                                     False > n
+                    in go 1
+            False -> n
+
+In both cases, the body and the rhs of the inner let call n at most once.
+But only in the second case that holds for the whole expression! The
+crucial difference is that in the first case, the rhs of `go` can call
+*both* `go` and `n`, and hence can call `n` multiple times as it recurses,
+while in the second case find out that `go` and `n` are not called together.
+
+
+Why co-call information for functions?
+--------------------------------------
+
+Although for eta-expansion we need the information only for thunks, we still
+need to know whether functions are being called once or multiple times, and
+together with what other functions.
+
+    Example:
+
+        let n = case .. of ..
+            f x = n (x+1)
+        in f 1 + f 2
+
+    vs.
+
+        let n = case .. of ..
+            f x = n (x+1)
+        in case .. of T -> f 0
+                      F -> f 1
+
+    Here, the body of f calls n exactly once, but f itself is being called
+    multiple times, so eta-expansion is not allowed.
+
+
+Note [Analysis type signature]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+The work-hourse of the analysis is the function `callArityAnal`, with the
+following type:
+
+    type CallArityRes = (UnVarGraph, VarEnv Arity)
+    callArityAnal ::
+        Arity ->  -- The arity this expression is called with
+        VarSet -> -- The set of interesting variables
+        CoreExpr ->  -- The expression to analyse
+        (CallArityRes, CoreExpr)
+
+and the following specification:
+
+  ((coCalls, callArityEnv), expr') = callArityEnv arity interestingIds expr
+
+                            <=>
+
+  Assume the expression `expr` is being passed `arity` arguments. Then it holds that
+    * The domain of `callArityEnv` is a subset of `interestingIds`.
+    * Any variable from `interestingIds` that is not mentioned in the `callArityEnv`
+      is absent, i.e. not called at all.
+    * Every call from `expr` to a variable bound to n in `callArityEnv` has at
+      least n value arguments.
+    * For two interesting variables `v1` and `v2`, they are not adjacent in `coCalls`,
+      then in no execution of `expr` both are being called.
+  Furthermore, expr' is expr with the callArity field of the `IdInfo` updated.
+
+
+Note [Which variables are interesting]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+The analysis would quickly become prohibitive expensive if we would analyse all
+variables; for most variables we simply do not care about how often they are
+called, i.e. variables bound in a pattern match. So interesting are variables that are
+ * top-level or let bound
+ * and possibly functions (typeArity > 0)
+
+Note [Information about boring variables]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+If we decide that the variable bound in `let x = e1 in e2` is not interesting,
+the analysis of `e2` will not report anything about `x`. To ensure that
+`callArityBind` does still do the right thing we have to extend the result from
+`e2` with a safe approximation.
+
+This is done using `fakeBoringCalls` and has the effect of analysing
+   x `seq` x `seq` e2
+instead, i.e. with `both` the result from `e2` with the most conservative
+result about the uninteresting value.
+
+Note [Recursion and fixpointing]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+For a mutually recursive let, we begin by
+ 1. analysing the body, using the same incoming arity as for the whole expression.
+ 2. Then we iterate, memoizing for each of the bound variables the last
+    analysis call, i.e. incoming arity, whether it is called once, and the CallArityRes.
+ 3. We combine the analysis result from the body and the memoized results for
+    the arguments (if already present).
+ 4. For each variable, we find out the incoming arity and whether it is called
+    once, based on the the current analysis result. If this differs from the
+    memoized results, we re-analyse the rhs and update the memoized table.
+ 5. If nothing had to be reanalized, we are done.
+    Otherwise, repeat from step 3.
+
+
+Note [Thunks in recursive groups]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+We never eta-expand a thunk in a recursive group, on the grounds that if it is
+part of a recursive group, then it will be called multipe times.
+
+This is not necessarily true, e.g.  it would be safe to eta-expand t2 (but not
+t1) in the follwing code:
+
+  let go x = t1
+      t1 = if ... then t2 else ...
+      t2 = if ... then go 1 else ...
+  in go 0
+
+Detecting this would reqiure finding out what variables are only ever called
+from thunks. While this is certainly possible, we yet have to see this to be
+relevant in the wild.
+
+
+Note [Analysing top-level binds]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+We can eta-expand top-level-binds if they are not exported, as we see all calls
+to them. The plan is as follows: Treat the top-level binds as nested lets around
+a body representing “all external calls�, which returns a pessimistic
+CallArityRes (the co-call graph is the complete graph, all arityies 0).
+
+-}
+
+-- Main entry point
+
+callArityAnalProgram :: DynFlags -> CoreProgram -> CoreProgram
+callArityAnalProgram _dflags binds = binds'
+  where
+    (_, binds') = callArityTopLvl [] emptyVarSet binds
+
+-- See Note [Analysing top-level-binds]
+callArityTopLvl :: [Var] -> VarSet -> [CoreBind] -> (CallArityRes, [CoreBind])
+callArityTopLvl exported _ []
+    = ( calledMultipleTimes $ (emptyUnVarGraph, mkVarEnv $ [(v, 0) | v <- exported])
+      , [] )
+callArityTopLvl exported int1 (b:bs)
+    = (ae2, b':bs')
+  where
+    int2 = bindersOf b
+    exported' = filter isExportedId int2 ++ exported
+    int' = int1 `addInterestingBinds` b
+    (ae1, bs') = callArityTopLvl exported' int' bs
+    ae1' = fakeBoringCalls int' b ae1 -- See Note [Information about boring variables]
+    (ae2, b')  = callArityBind ae1' int1 b
+
+
+callArityRHS :: CoreExpr -> CoreExpr
+callArityRHS = snd . callArityAnal 0 emptyVarSet
+
+-- The main analysis function. See Note [Analysis type signature]
+callArityAnal ::
+    Arity ->  -- The arity this expression is called with
+    VarSet -> -- The set of interesting variables
+    CoreExpr ->  -- The expression to analyse
+    (CallArityRes, CoreExpr)
+        -- How this expression uses its interesting variables
+        -- and the expression with IdInfo updated
+
+-- The trivial base cases
+callArityAnal _     _   e@(Lit _)
+    = (emptyArityRes, e)
+callArityAnal _     _   e@(Type _)
+    = (emptyArityRes, e)
+callArityAnal _     _   e@(Coercion _)
+    = (emptyArityRes, e)
+-- The transparent cases
+callArityAnal arity int (Tick t e)
+    = second (Tick t) $ callArityAnal arity int e
+callArityAnal arity int (Cast e co)
+    = second (\e -> Cast e co) $ callArityAnal arity int e
+
+-- The interesting case: Variables, Lambdas, Lets, Applications, Cases
+callArityAnal arity int e@(Var v)
+    | v `elemVarSet` int
+    = (unitArityRes v arity, e)
+    | otherwise
+    = (emptyArityRes, e)
+
+-- Non-value lambdas are ignored
+callArityAnal arity int (Lam v e) | not (isId v)
+    = second (Lam v) $ callArityAnal arity (int `delVarSet` v) e
+
+-- We have a lambda that may be called multiple times, so its free variables
+-- can all be co-called.
+callArityAnal 0     int (Lam v e)
+    = (ae', Lam v e')
+  where
+    (ae, e') = callArityAnal 0 (int `delVarSet` v) e
+    ae' = calledMultipleTimes ae
+-- We have a lambda that we are calling. decrease arity.
+callArityAnal arity int (Lam v e)
+    = (ae, Lam v e')
+  where
+    (ae, e') = callArityAnal (arity - 1) (int `delVarSet` v) e
+
+-- Application. Increase arity for the called expresion, nothing to know about
+-- the second
+callArityAnal arity int (App e (Type t))
+    = second (\e -> App e (Type t)) $ callArityAnal arity int e
+callArityAnal arity int (App e1 e2)
+    = (final_ae, App e1' e2')
+  where
+    (ae1, e1') = callArityAnal (arity + 1) int e1
+    (ae2, e2') = callArityAnal 0           int e2
+    -- See Note [Case and App: Which side to take?]
+    final_ae = ae1 `both` ae2
+
+-- Case expression.
+callArityAnal arity int (Case scrut bndr ty alts)
+    = -- pprTrace "callArityAnal:Case"
+      --          (vcat [ppr scrut, ppr final_ae])
+      (final_ae, Case scrut' bndr ty alts')
+  where
+    (alt_aes, alts') = unzip $ map go alts
+    go (dc, bndrs, e) = let (ae, e') = callArityAnal arity int e
+                        in  (ae, (dc, bndrs, e'))
+    alt_ae = lubRess alt_aes
+    (scrut_ae, scrut') = callArityAnal 0 int scrut
+    -- See Note [Case and App: Which side to take?]
+    final_ae = scrut_ae `both` alt_ae
+
+-- For lets, use callArityBind
+callArityAnal arity int (Let bind e)
+  = -- pprTrace "callArityAnal:Let"
+    --          (vcat [ppr v, ppr arity, ppr n, ppr final_ae ])
+    (final_ae, Let bind' e')
+  where
+    int_body = int `addInterestingBinds` bind
+    (ae_body, e') = callArityAnal arity int_body e
+    ae_body' = fakeBoringCalls int_body bind ae_body -- See Note [Information about boring variables]
+    (final_ae, bind') = callArityBind ae_body' int bind
+
+-- Which bindings should we look at?
+-- See Note [Which variables are interesting]
+interestingBinds :: CoreBind -> [Var]
+interestingBinds = filter go . bindersOf
+  where go v = 0 < length (typeArity (idType v))
+
+addInterestingBinds :: VarSet -> CoreBind -> VarSet
+addInterestingBinds int bind
+    = int `delVarSetList`    bindersOf bind -- Possible shadowing
+          `extendVarSetList` interestingBinds bind
+
+-- For every boring variable in the binder, add a safe approximation
+-- See Note [Information about boring variables]
+fakeBoringCalls :: VarSet -> CoreBind -> CallArityRes -> CallArityRes
+fakeBoringCalls int bind res = boring `both` res
+  where
+    boring = calledMultipleTimes $
+        ( emptyUnVarGraph
+        ,  mkVarEnv [ (v, 0) | v <- bindersOf bind, not (v `elemVarSet` int)])
+
+
+-- Used for both local and top-level binds
+-- First argument is the demand from the body
+callArityBind :: CallArityRes -> VarSet -> CoreBind -> (CallArityRes, CoreBind)
+-- Non-recursive let
+callArityBind ae_body int (NonRec v rhs)
+  | otherwise
+  = -- pprTrace "callArityBind:NonRec"
+    --          (vcat [ppr v, ppr ae_body, ppr int, ppr ae_rhs, ppr safe_arity])
+    (final_ae, NonRec v' rhs')
+  where
+    is_thunk = not (exprIsHNF rhs)
+
+    (arity, called_once)  = lookupCallArityRes ae_body v
+    safe_arity | called_once = arity
+               | is_thunk    = 0      -- A thunk! Do not eta-expand
+               | otherwise   = arity
+    (ae_rhs, rhs') = callArityAnal safe_arity int rhs
+
+    ae_rhs'| called_once     = ae_rhs
+           | safe_arity == 0 = ae_rhs -- If it is not a function, its body is evaluated only once
+           | otherwise       = calledMultipleTimes ae_rhs
+
+    final_ae = callArityNonRecEnv v ae_rhs' ae_body
+    v' = v `setIdCallArity` safe_arity
+
+
+
+-- Recursive let. See Note [Recursion and fixpointing]
+callArityBind ae_body int b@(Rec binds)
+  = -- pprTrace "callArityBind:Rec"
+    --           (vcat [ppr (Rec binds'), ppr ae_body, ppr int, ppr ae_rhs]) $
+    (final_ae, Rec binds')
+  where
+    int_body = int `addInterestingBinds` b
+    (ae_rhs, binds') = fix initial_binds
+    final_ae = bindersOf b `resDelList` ae_rhs
+
+    initial_binds = [(i,Nothing,e) | (i,e) <- binds]
+
+    fix :: [(Id, Maybe (Bool, Arity, CallArityRes), CoreExpr)] -> (CallArityRes, [(Id, CoreExpr)])
+    fix ann_binds
+        | -- pprTrace "callArityBind:fix" (vcat [ppr ann_binds, ppr any_change, ppr ae]) $
+          any_change
+        = fix ann_binds'
+        | otherwise
+        = (ae, map (\(i, _, e) -> (i, e)) ann_binds')
+      where
+        aes_old = [ (i,ae) | (i, Just (_,_,ae), _) <- ann_binds ]
+        ae = callArityRecEnv aes_old ae_body
+
+        rerun (i, mbLastRun, rhs)
+            | i `elemVarSet` int_body && not (i `elemUnVarSet` domRes ae)
+            -- No call to this yet, so do nothing
+            = (False, (i, Nothing, rhs))
+
+            | Just (old_called_once, old_arity, _) <- mbLastRun
+            , called_once == old_called_once
+            , new_arity == old_arity
+            -- No change, no need to re-analize
+            = (False, (i, mbLastRun, rhs))
+
+            | otherwise
+            -- We previously analized this with a different arity (or not at all)
+            = let is_thunk = not (exprIsHNF rhs)
+
+                  safe_arity | is_thunk    = 0  -- See Note [Thunks in recursive groups]
+                             | otherwise   = new_arity
+
+                  (ae_rhs, rhs') = callArityAnal safe_arity int_body rhs
+
+                  ae_rhs' | called_once     = ae_rhs
+                          | safe_arity == 0 = ae_rhs -- If it is not a function, its body is evaluated only once
+                          | otherwise       = calledMultipleTimes ae_rhs
+
+              in (True, (i `setIdCallArity` safe_arity, Just (called_once, new_arity, ae_rhs'), rhs'))
+          where
+            (new_arity, called_once)  = lookupCallArityRes ae i
+
+        (changes, ann_binds') = unzip $ map rerun ann_binds
+        any_change = or changes
+
+-- Combining the results from body and rhs, non-recursive case
+-- See Note [Analysis II: The Co-Called analysis]
+callArityNonRecEnv :: Var -> CallArityRes -> CallArityRes -> CallArityRes
+callArityNonRecEnv v ae_rhs ae_body
+    = addCrossCoCalls called_by_v called_with_v $ ae_rhs `lubRes` resDel v ae_body
+  where
+    called_by_v = domRes ae_rhs
+    called_with_v = calledWith ae_body v `delUnVarSet` v
+
+-- Combining the results from body and rhs, (mutually) recursive case
+-- See Note [Analysis II: The Co-Called analysis]
+callArityRecEnv :: [(Var, CallArityRes)] -> CallArityRes -> CallArityRes
+callArityRecEnv ae_rhss ae_body
+    = -- pprTrace "callArityRecEnv" (vcat [ppr ae_rhss, ppr ae_body, ppr ae_new])
+      ae_new
+  where
+    vars = map fst ae_rhss
+
+    ae_combined = lubRess (map snd ae_rhss) `lubRes` ae_body
+
+    cross_calls = unionUnVarGraphs $ map cross_call ae_rhss
+    cross_call (v, ae_rhs) = completeBipartiteGraph called_by_v called_with_v
+      where
+        is_thunk = idCallArity v == 0
+        -- What rhs are relevant as happening before (or after) calling v?
+        --    If v is a thunk, everything from all the _other_ variables
+        --    If v is not a thunk, everything can happen.
+        ae_before_v | is_thunk  = lubRess (map snd $ filter ((/= v) . fst) ae_rhss) `lubRes` ae_body
+                    | otherwise = ae_combined
+        -- What do we want to know from these?
+        -- Which calls can happen next to any recursive call.
+        called_with_v
+            = unionUnVarSets $ map (calledWith ae_before_v) vars
+        called_by_v = domRes ae_rhs
+
+    ae_new = first (cross_calls `unionUnVarGraph`) ae_combined
+
+---------------------------------------
+-- Functions related to CallArityRes --
+---------------------------------------
+
+-- Result type for the two analyses.
+-- See Note [Analysis I: The arity analyis]
+-- and Note [Analysis II: The Co-Called analysis]
+type CallArityRes = (UnVarGraph, VarEnv Arity)
+
+emptyArityRes :: CallArityRes
+emptyArityRes = (emptyUnVarGraph, emptyVarEnv)
+
+unitArityRes :: Var -> Arity -> CallArityRes
+unitArityRes v arity = (emptyUnVarGraph, unitVarEnv v arity)
+
+resDelList :: [Var] -> CallArityRes -> CallArityRes
+resDelList vs ae = foldr resDel ae vs
+
+resDel :: Var -> CallArityRes -> CallArityRes
+resDel v (g, ae) = (g `delNode` v, ae `delVarEnv` v)
+
+domRes :: CallArityRes -> UnVarSet
+domRes (_, ae) = varEnvDom ae
+
+-- In the result, find out the minimum arity and whether the variable is called
+-- at most once.
+lookupCallArityRes :: CallArityRes -> Var -> (Arity, Bool)
+lookupCallArityRes (g, ae) v
+    = case lookupVarEnv ae v of
+        Just a -> (a, not (v `elemUnVarSet` (neighbors g v)))
+        Nothing -> (0, False)
+
+calledWith :: CallArityRes -> Var -> UnVarSet
+calledWith (g, _) v = neighbors g v
+
+addCrossCoCalls :: UnVarSet -> UnVarSet -> CallArityRes -> CallArityRes
+addCrossCoCalls set1 set2 = first (completeBipartiteGraph set1 set2 `unionUnVarGraph`)
+
+-- Replaces the co-call graph by a complete graph (i.e. no information)
+calledMultipleTimes :: CallArityRes -> CallArityRes
+calledMultipleTimes res = first (const (completeGraph (domRes res))) res
+
+-- Used for application and cases
+both :: CallArityRes -> CallArityRes -> CallArityRes
+both r1 r2 = addCrossCoCalls (domRes r1) (domRes r2) $ r1 `lubRes` r2
+
+-- Used when combining results from alternative cases; take the minimum
+lubRes :: CallArityRes -> CallArityRes -> CallArityRes
+lubRes (g1, ae1) (g2, ae2) = (g1 `unionUnVarGraph` g2, ae1 `lubArityEnv` ae2)
+
+lubArityEnv :: VarEnv Arity -> VarEnv Arity -> VarEnv Arity
+lubArityEnv = plusVarEnv_C min
+
+lubRess :: [CallArityRes] -> CallArityRes
+lubRess = foldl lubRes emptyArityRes
diff --git a/compiler/simplCore/CoreMonad.lhs b/compiler/simplCore/CoreMonad.lhs
index 7f45850d388f..c06036044d04 100644
--- a/compiler/simplCore/CoreMonad.lhs
+++ b/compiler/simplCore/CoreMonad.lhs
@@ -4,15 +4,14 @@
 \section[CoreMonad]{The core pipeline monad}
 
 \begin{code}
-{-# OPTIONS -fno-warn-tabs #-}
+{-# LANGUAGE CPP, UndecidableInstances #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
 -- The above warning supression flag is a temporary kludge.
 -- While working on this module you are encouraged to remove it and
 -- detab the module (please do the detabbing in a separate patch). See
 --     http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
 -- for details
 
-{-# LANGUAGE UndecidableInstances #-}
-
 module CoreMonad (
     -- * Configuration of the core-to-core passes
     CoreToDo(..), runWhen, runMaybe,
@@ -305,6 +304,7 @@ data CoreToDo           -- These are diff core-to-core passes,
   | CoreLiberateCase
   | CoreDoPrintCore
   | CoreDoStaticArgs
+  | CoreDoCallArity
   | CoreDoStrictness
   | CoreDoWorkerWrapper
   | CoreDoSpecialising
@@ -333,6 +333,7 @@ coreDumpFlag CoreDoFloatInwards       = Just Opt_D_verbose_core2core
 coreDumpFlag (CoreDoFloatOutwards {}) = Just Opt_D_verbose_core2core
 coreDumpFlag CoreLiberateCase         = Just Opt_D_verbose_core2core
 coreDumpFlag CoreDoStaticArgs 	      = Just Opt_D_verbose_core2core
+coreDumpFlag CoreDoCallArity 	      = Just Opt_D_dump_call_arity
 coreDumpFlag CoreDoStrictness 	      = Just Opt_D_dump_stranal
 coreDumpFlag CoreDoWorkerWrapper      = Just Opt_D_dump_worker_wrapper
 coreDumpFlag CoreDoSpecialising       = Just Opt_D_dump_spec
@@ -356,6 +357,7 @@ instance Outputable CoreToDo where
   ppr (CoreDoFloatOutwards f)  = ptext (sLit "Float out") <> parens (ppr f)
   ppr CoreLiberateCase         = ptext (sLit "Liberate case")
   ppr CoreDoStaticArgs 	       = ptext (sLit "Static argument")
+  ppr CoreDoCallArity	       = ptext (sLit "Called arity analysis")
   ppr CoreDoStrictness 	       = ptext (sLit "Demand analysis")
   ppr CoreDoWorkerWrapper      = ptext (sLit "Worker Wrapper binds")
   ppr CoreDoSpecialising       = ptext (sLit "Specialise")
diff --git a/compiler/simplCore/FloatIn.lhs b/compiler/simplCore/FloatIn.lhs
index 8a35749c6775..2b7ee5c6d39c 100644
--- a/compiler/simplCore/FloatIn.lhs
+++ b/compiler/simplCore/FloatIn.lhs
@@ -12,7 +12,8 @@ case, so that we don't allocate things, save them on the stack, and
 then discover that they aren't needed in the chosen branch.
 
 \begin{code}
-{-# OPTIONS -fno-warn-tabs #-}
+{-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
 -- The above warning supression flag is a temporary kludge.
 -- While working on this module you are encouraged to remove it and
 -- detab the module (please do the detabbing in a separate patch). See
@@ -25,16 +26,17 @@ module FloatIn ( floatInwards ) where
 
 import CoreSyn
 import MkCore
-import CoreUtils	( exprIsDupable, exprIsExpandable, exprOkForSideEffects )
+import CoreUtils	( exprIsDupable, exprIsExpandable, exprType, exprOkForSideEffects )
 import CoreFVs		( CoreExprWithFVs, freeVars, freeVarsOf, idRuleAndUnfoldingVars )
 import Id		( isOneShotBndr, idType )
 import Var
-import Type		( isUnLiftedType )
+import Type		( Type, isUnLiftedType, splitFunTy, applyTy )
 import VarSet
 import Util
 import UniqFM
 import DynFlags
 import Outputable
+import Data.List( mapAccumL )
 \end{code}
 
 Top-level interface function, @floatInwards@.  Note that we do not
@@ -154,18 +156,42 @@ need to get at all the arguments.  The next simplifier run will
 pull out any silly ones.
 
 \begin{code}
-fiExpr dflags to_drop (_,AnnApp fun arg@(arg_fvs, ann_arg))
-  | noFloatIntoRhs ann_arg  = wrapFloats drop_here $ wrapFloats arg_drop $
-                              App (fiExpr dflags fun_drop fun) (fiExpr dflags [] arg)
-       -- It's inconvenient to test for an unlifted arg here,
-       -- and it really doesn't matter if we float into one
-  | otherwise               = wrapFloats drop_here $
-                              App (fiExpr dflags fun_drop fun) (fiExpr dflags arg_drop arg)
+fiExpr dflags to_drop ann_expr@(_,AnnApp {})
+  = wrapFloats drop_here $ wrapFloats extra_drop $
+    mkApps (fiExpr dflags fun_drop ann_fun)
+           (zipWith (fiExpr dflags) arg_drops ann_args)
   where
-    [drop_here, fun_drop, arg_drop] 
-      = sepBindsByDropPoint dflags False [freeVarsOf fun, arg_fvs] to_drop
+    (ann_fun@(fun_fvs, _), ann_args) = collectAnnArgs ann_expr
+    fun_ty = exprType (deAnnotate ann_fun)
+    ((_,extra_fvs), arg_fvs) = mapAccumL mk_arg_fvs (fun_ty, emptyVarSet) ann_args
+
+    -- All this faffing about is so that we can get hold of
+    -- the types of the arguments, to pass to noFloatIntoRhs
+    mk_arg_fvs :: (Type, FreeVarSet) -> CoreExprWithFVs -> ((Type, FreeVarSet), FreeVarSet)
+    mk_arg_fvs (fun_ty, extra_fvs) (_, AnnType ty)
+      = ((applyTy fun_ty ty, extra_fvs), emptyVarSet)
+
+    mk_arg_fvs (fun_ty, extra_fvs) (arg_fvs, ann_arg)
+      | noFloatIntoRhs ann_arg arg_ty
+      = ((res_ty, extra_fvs `unionVarSet` arg_fvs), emptyVarSet)
+      | otherwise
+      = ((res_ty, extra_fvs), arg_fvs)
+      where
+       (arg_ty, res_ty) = splitFunTy fun_ty
+
+    drop_here : extra_drop : fun_drop : arg_drops
+      = sepBindsByDropPoint dflags False (extra_fvs : fun_fvs : arg_fvs) to_drop
 \end{code}
 
+Note [Do not destroy the let/app invariant]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Watch out for
+   f (x +# y)
+We don't want to float bindings into here
+   f (case ... of { x -> x +# y })
+because that might destroy the let/app invariant, which requires
+unlifted function arguments to be ok-for-speculation.
+
 Note [Floating in past a lambda group]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 * We must be careful about floating inside inside a value lambda.  
@@ -224,12 +250,12 @@ We don't float lets inwards past an SCC.
 
 \begin{code}
 fiExpr dflags to_drop (_, AnnTick tickish expr)
-  | tickishScoped tickish
-  =     -- Wimp out for now - we could push values in
-    wrapFloats to_drop (Tick tickish (fiExpr dflags [] expr))
-
-  | otherwise
+  | tickish `tickishScopesLike` SoftScope
   = Tick tickish (fiExpr dflags to_drop expr)
+
+  | otherwise -- Wimp out for now - we could push values in
+  = wrapFloats to_drop (Tick tickish (fiExpr dflags [] expr))
+
 \end{code}
 
 For @Lets@, the possible ``drop points'' for the \tr{to_drop}
@@ -274,8 +300,8 @@ arrange to dump bindings that bind extra_fvs before the entire let.
 
 Note [extra_fvs (2): free variables of rules]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Consider 
-  let x{rule mentioning y} = rhs in body 
+Consider
+  let x{rule mentioning y} = rhs in body
 Here y is not free in rhs or body; but we still want to dump bindings
 that bind y outside the let.  So we augment extra_fvs with the
 idRuleAndUnfoldingVars of x.  No need for type variables, hence not using
@@ -287,11 +313,11 @@ fiExpr dflags to_drop (_,AnnLet (AnnNonRec id rhs@(rhs_fvs, ann_rhs)) body)
   = fiExpr dflags new_to_drop body
   where
     body_fvs = freeVarsOf body `delVarSet` id
+    rhs_ty = idType id
 
     rule_fvs = idRuleAndUnfoldingVars id	-- See Note [extra_fvs (2): free variables of rules]
-    extra_fvs | noFloatIntoRhs ann_rhs
-	      || isUnLiftedType (idType id) = rule_fvs `unionVarSet` rhs_fvs
-	      | otherwise		    = rule_fvs
+    extra_fvs | noFloatIntoRhs ann_rhs rhs_ty = rule_fvs `unionVarSet` rhs_fvs
+	      | otherwise		      = rule_fvs
 	-- See Note [extra_fvs (1): avoid floating into RHS]
 	-- No point in floating in only to float straight out again
 	-- Ditto ok-for-speculation unlifted RHSs
@@ -321,7 +347,7 @@ fiExpr dflags to_drop (_,AnnLet (AnnRec bindings) body)
     rule_fvs = foldr (unionVarSet . idRuleAndUnfoldingVars) emptyVarSet ids
     extra_fvs = rule_fvs `unionVarSet` 
 		unionVarSets [ fvs | (fvs, rhs) <- rhss
-			     , noFloatIntoRhs rhs ]
+			     , noFloatIntoExpr rhs ]
 
     (shared_binds:extra_binds:body_binds:rhss_binds) 
 	= sepBindsByDropPoint dflags False (extra_fvs:body_fvs:rhss_fvs) to_drop
@@ -363,6 +389,7 @@ floating in cases with a single alternative that may bind values.
 fiExpr dflags to_drop (_, AnnCase scrut case_bndr _ [(con,alt_bndrs,rhs)])
   | isUnLiftedType (idType case_bndr)
   , exprOkForSideEffects (deAnnotate scrut)
+      -- See PrimOp, Note [PrimOp can_fail and has_side_effects]
   = wrapFloats shared_binds $
     fiExpr dflags (case_float : rhs_binds) rhs
   where
@@ -402,8 +429,15 @@ okToFloatInside bndrs = all ok bndrs
     ok b = not (isId b) || isOneShotBndr b
     -- Push the floats inside there are no non-one-shot value binders
 
-noFloatIntoRhs :: AnnExpr' Var (UniqFM Var) -> Bool
-noFloatIntoRhs (AnnLam bndr e) 
+noFloatIntoRhs :: AnnExpr' Var (UniqFM Var) -> Type -> Bool
+-- ^ True if it's a bad idea to float bindings into this RHS
+-- Preconditio:  rhs :: rhs_ty
+noFloatIntoRhs rhs rhs_ty
+  =  isUnLiftedType rhs_ty   -- See Note [Do not destroy the let/app invariant]
+  || noFloatIntoExpr rhs
+
+noFloatIntoExpr :: AnnExpr' Var (UniqFM Var) -> Bool
+noFloatIntoExpr (AnnLam bndr e)
    = not (okToFloatInside (bndr:bndrs))
      -- NB: Must line up with fiExpr (AnnLam...); see Trac #7088
    where
@@ -417,7 +451,7 @@ noFloatIntoRhs (AnnLam bndr e)
 	-- boxing constructor into it, else we box it every time which is very bad
 	-- news indeed.
 
-noFloatIntoRhs rhs = exprIsExpandable (deAnnotate' rhs)	
+noFloatIntoExpr rhs = exprIsExpandable (deAnnotate' rhs)
        -- We'd just float right back out again...
        -- Should match the test in SimplEnv.doFloatFromRhs
 \end{code}
diff --git a/compiler/simplCore/FloatOut.lhs b/compiler/simplCore/FloatOut.lhs
index fbe8a3eb8a16..f66dbe306e3b 100644
--- a/compiler/simplCore/FloatOut.lhs
+++ b/compiler/simplCore/FloatOut.lhs
@@ -6,8 +6,9 @@
 ``Long-distance'' floating of bindings towards the top level.
 
 \begin{code}
+{-# LANGUAGE CPP #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
-{-# OPTIONS -fno-warn-tabs #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
 -- The above warning supression flag is a temporary kludge.
 -- While working on this module you are encouraged to remove it and
 -- detab the module (please do the detabbing in a separate patch). See
@@ -285,18 +286,20 @@ floatExpr lam@(Lam (TB _ lam_spec) _)
     (add_to_stats fs floats, floats, mkLams bndrs body') }
 
 floatExpr (Tick tickish expr)
-  | tickishScoped tickish
+  | tickish `tickishScopesLike` SoftScope -- not scoped, can just float
   = case (floatExpr expr)    of { (fs, floating_defns, expr') ->
-    let
-	-- Annotate bindings floated outwards past an scc expression
-	-- with the cc.  We mark that cc as "duplicated", though.
+    (fs, floating_defns, Tick tickish expr') }
+
+  | not (tickishCounts tickish) || tickishCanSplit tickish
+  = case (floatExpr expr)    of { (fs, floating_defns, expr') ->
+    let -- Annotate bindings floated outwards past an scc expression
+        -- with the cc.  We mark that cc as "duplicated", though.
         annotated_defns = wrapTick (mkNoCount tickish) floating_defns
     in
     (fs, annotated_defns, Tick tickish expr') }
 
-  | otherwise  -- not scoped, can just float
-  = case (floatExpr expr)    of { (fs, floating_defns, expr') ->
-    (fs, floating_defns, Tick tickish expr') }
+  | otherwise
+  = pprPanic "floatExpr tick" (ppr tickish)
 
 floatExpr (Cast expr co)
   = case (floatExpr expr) of { (fs, floating_defns, expr') ->
@@ -457,11 +460,6 @@ data FloatBinds  = FB !(Bag FloatLet)	   	-- Destined for top level
      		      !MajorEnv 		-- Levels other than top
      -- See Note [Representation of FloatBinds]
 
-instance Outputable FloatBind where
-  ppr (FloatLet b) = ptext (sLit "LET") <+> ppr b
-  ppr (FloatCase e b c bs) = hang (ptext (sLit "CASE") <+> ppr e <+> ptext (sLit "of") <+> ppr b)
-                                2 (ppr c <+> ppr bs)
-
 instance Outputable FloatBinds where
   ppr (FB fbs defs) 
       = ptext (sLit "FB") <+> (braces $ vcat
diff --git a/compiler/simplCore/LiberateCase.lhs b/compiler/simplCore/LiberateCase.lhs
index a89396b7827b..2593ab159cdb 100644
--- a/compiler/simplCore/LiberateCase.lhs
+++ b/compiler/simplCore/LiberateCase.lhs
@@ -4,7 +4,8 @@
 \section[LiberateCase]{Unroll recursion to allow evals to be lifted from a loop}
 
 \begin{code}
-{-# OPTIONS -fno-warn-tabs #-}
+{-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
 -- The above warning supression flag is a temporary kludge.
 -- While working on this module you are encouraged to remove it and
 -- detab the module (please do the detabbing in a separate patch). See
diff --git a/compiler/simplCore/OccurAnal.lhs b/compiler/simplCore/OccurAnal.lhs
index 2487787c8dba..ddda37f9f3e0 100644
--- a/compiler/simplCore/OccurAnal.lhs
+++ b/compiler/simplCore/OccurAnal.lhs
@@ -12,7 +12,8 @@ The occurrence analyser re-typechecks a core expression, returning a new
 core expression with (hopefully) improved usage information.
 
 \begin{code}
-{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE CPP, BangPatterns #-}
+
 module OccurAnal (
         occurAnalysePgm, occurAnalyseExpr, occurAnalyseExpr_NoBinderSwap
     ) where
@@ -21,7 +22,8 @@ module OccurAnal (
 
 import CoreSyn
 import CoreFVs
-import CoreUtils        ( exprIsTrivial, isDefaultAlt, isExpandableApp )
+import CoreUtils        ( exprIsTrivial, isDefaultAlt, isExpandableApp,
+                          stripTicksTop )
 import Id
 import Name( localiseName )
 import BasicTypes
@@ -40,6 +42,7 @@ import Util
 import Outputable
 import FastString
 import Data.List
+import Control.Arrow    ( second )
 \end{code}
 
 
@@ -1181,18 +1184,19 @@ we can sort them into the right place when doing dependency analysis.
 
 \begin{code}
 occAnal env (Tick tickish body)
+  | tickish `tickishScopesLike` SoftScope
+  = (usage, Tick tickish body')
+
   | Breakpoint _ ids <- tickish
-  = (mapVarEnv markInsideSCC usage
-         +++ mkVarEnv (zip ids (repeat NoOccInfo)), Tick tickish body')
+  = (usage_lam +++ mkVarEnv (zip ids (repeat NoOccInfo)), Tick tickish body')
     -- never substitute for any of the Ids in a Breakpoint
 
-  | tickishScoped tickish
-  = (mapVarEnv markInsideSCC usage, Tick tickish body')
-
   | otherwise
-  = (usage, Tick tickish body')
+  = (usage_lam, Tick tickish body')
   where
     !(usage,body') = occAnal env body
+    -- for a non-soft tick scope, we can inline lambdas only
+    usage_lam = mapVarEnv markInsideLam usage
 
 occAnal env (Cast expr co)
   = case occAnal env expr of { (usage, expr') ->
@@ -1204,6 +1208,7 @@ occAnal env (Cast expr co)
         -- then mark y as 'Many' so that we don't
         -- immediately inline y again.
     }
+
 \end{code}
 
 \begin{code}
@@ -1275,6 +1280,13 @@ occAnal env (Case scrut bndr ty alts)
         = (mkOneOcc env v True, Var v)  -- The 'True' says that the variable occurs
                                         -- in an interesting context; the case has
                                         -- at least one non-default alternative
+    occ_anal_scrut (Tick t e) alts
+        | t `tickishScopesLike` SoftScope
+          -- No reason to not look through all ticks here, but only
+          -- for soft-scoped ticks we can do so without having to
+          -- update returned occurance info (see occAnal)
+        = second (Tick t) $ occ_anal_scrut e alts
+
     occ_anal_scrut scrut _alts
         = occAnal (vanillaCtxt env) scrut    -- No need for rhsCtxt
 
@@ -1729,7 +1741,7 @@ mkAltEnv :: OccEnv -> CoreExpr -> Id -> (OccEnv, Maybe (Id, CoreExpr))
 --                  c) returns a proxy mapping, binding the scrutinee
 --                     to the case binder, if possible
 mkAltEnv env@(OccEnv { occ_gbl_scrut = pe }) scrut case_bndr
-  = case scrut of
+  = case snd (stripTicksTop (const True) scrut) of
       Var v           -> add_scrut v case_bndr'
       Cast (Var v) co -> add_scrut v (Cast case_bndr' (mkSymCo co))
                           -- See Note [Case of cast]
@@ -1843,13 +1855,10 @@ mkOneOcc env id int_cxt
   | otherwise
   = emptyDetails
 
-markMany, markInsideLam, markInsideSCC :: OccInfo -> OccInfo
+markMany, markInsideLam :: OccInfo -> OccInfo
 
 markMany _  = NoOccInfo
 
-markInsideSCC occ = markInsideLam occ
-  -- inside an SCC, we can inline lambdas only.
-
 markInsideLam (OneOcc _ one_br int_cxt) = OneOcc True one_br int_cxt
 markInsideLam occ                       = occ
 
diff --git a/compiler/simplCore/SAT.lhs b/compiler/simplCore/SAT.lhs
index bc1ce42cd628..92ebdfe389a5 100644
--- a/compiler/simplCore/SAT.lhs
+++ b/compiler/simplCore/SAT.lhs
@@ -49,7 +49,8 @@ essential to make this work well!
 
 
 \begin{code}
-{-# OPTIONS -fno-warn-tabs #-}
+{-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
 -- The above warning supression flag is a temporary kludge.
 -- While working on this module you are encouraged to remove it and
 -- detab the module (please do the detabbing in a separate patch). See
diff --git a/compiler/simplCore/SetLevels.lhs b/compiler/simplCore/SetLevels.lhs
index 7bcc53f6dec3..ff55e9964877 100644
--- a/compiler/simplCore/SetLevels.lhs
+++ b/compiler/simplCore/SetLevels.lhs
@@ -42,7 +42,8 @@
   the scrutinee of the case, and we can inline it.  
 
 \begin{code}
-{-# OPTIONS -fno-warn-tabs #-}
+{-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
 -- The above warning supression flag is a temporary kludge.
 -- While working on this module you are encouraged to remove it and
 -- detab the module (please do the detabbing in a separate patch). See
@@ -63,28 +64,27 @@ module SetLevels (
 
 import CoreSyn
 import CoreMonad	( FloatOutSwitches(..) )
-import CoreUtils	( exprType, exprOkForSpeculation )
+import CoreUtils	( exprType, exprOkForSpeculation, exprIsBottom )
 import CoreArity	( exprBotStrictness_maybe )
 import CoreFVs		-- all of it
 import Coercion         ( isCoVar )
-import CoreSubst	( Subst, emptySubst, extendInScope, substBndr, substRecBndrs,
-			  extendIdSubst, extendSubstWithVar, cloneBndr, 
-                          cloneRecIdBndrs, substTy, substCo )
-import MkCore           ( sortQuantVars ) 
+import CoreSubst	( Subst, emptySubst, substBndrs, substRecBndrs,
+			  extendIdSubst, extendSubstWithVar, cloneBndrs,
+                          cloneRecIdBndrs, substTy, substCo, substVarSet )
+import MkCore           ( sortQuantVars )
 import Id
 import IdInfo
 import Var
 import VarSet
 import VarEnv
 import Literal		( litIsTrivial )
-import Demand           ( StrictSig, increaseStrictSigArity )
+import Demand           ( StrictSig )
 import Name		( getOccName, mkSystemVarName )
 import OccName		( occNameString )
 import Type		( isUnLiftedType, Type, mkPiTypes )
-import BasicTypes	( Arity )
+import BasicTypes	( Arity, RecFlag(..) )
 import UniqSupply
 import Util
-import MonadUtils
 import Outputable
 import FastString
 \end{code}
@@ -235,16 +235,14 @@ setLevels float_lams binds us
 
 lvlTopBind :: LevelEnv -> Bind Id -> LvlM (LevelledBind, LevelEnv)
 lvlTopBind env (NonRec bndr rhs)
-  = do rhs' <- lvlExpr tOP_LEVEL env (freeVars rhs)
-       let  bndr' = TB bndr (StayPut tOP_LEVEL)
-            env'  = extendLvlEnv env [bndr']
-       return (NonRec bndr' rhs', env')
+  = do { rhs' <- lvlExpr env (freeVars rhs)
+       ; let (env', [bndr']) = substAndLvlBndrs NonRecursive env tOP_LEVEL [bndr]
+       ; return (NonRec bndr' rhs', env') }
 
 lvlTopBind env (Rec pairs)
   = do let (bndrs,rhss) = unzip pairs
-           bndrs' = [TB b (StayPut tOP_LEVEL) | b <- bndrs]
-           env'   = extendLvlEnv env bndrs'
-       rhss' <- mapM (lvlExpr tOP_LEVEL env' . freeVars) rhss
+           (env', bndrs') = substAndLvlBndrs Recursive env tOP_LEVEL bndrs
+       rhss' <- mapM (lvlExpr env' . freeVars) rhss
        return (Rec (bndrs' `zip` rhss'), env')
 \end{code}
 
@@ -255,9 +253,8 @@ lvlTopBind env (Rec pairs)
 %************************************************************************
 
 \begin{code}
-lvlExpr :: Level		-- ctxt_lvl: Level of enclosing expression
-	-> LevelEnv		-- Level of in-scope names/tyvars
-	-> CoreExprWithFVs	-- input expression
+lvlExpr :: LevelEnv		-- Context
+	-> CoreExprWithFVs	-- Input expression
 	-> LvlM LevelledExpr	-- Result expression
 \end{code}
 
@@ -277,12 +274,20 @@ don't want @lvlExpr@ to turn the scrutinee of the @case@ into an MFE
 If there were another lambda in @r@'s rhs, it would get level-2 as well.
 
 \begin{code}
-lvlExpr _ env (_, AnnType ty) = return (Type (substTy (le_subst env) ty))
-lvlExpr _ env (_, AnnCoercion co) = return (Coercion (substCo (le_subst env) co))
-lvlExpr _ env (_, AnnVar v)   = return (lookupVar env v)
-lvlExpr _ _   (_, AnnLit lit) = return (Lit lit)
+lvlExpr env (_, AnnType ty)     = return (Type (substTy (le_subst env) ty))
+lvlExpr env (_, AnnCoercion co) = return (Coercion (substCo (le_subst env) co))
+lvlExpr env (_, AnnVar v)       = return (lookupVar env v)
+lvlExpr _   (_, AnnLit lit)     = return (Lit lit)
+
+lvlExpr env (_, AnnCast expr (_, co)) = do
+    expr' <- lvlExpr env expr
+    return (Cast expr' (substCo (le_subst env) co))
+
+lvlExpr env (_, AnnTick tickish expr) = do
+    expr' <- lvlExpr env expr
+    return (Tick tickish expr')
 
-lvlExpr ctxt_lvl env expr@(_, AnnApp _ _) = do
+lvlExpr env expr@(_, AnnApp _ _) = do
     let
       (fun, args) = collectAnnArgs expr
     --
@@ -296,8 +301,8 @@ lvlExpr ctxt_lvl env expr@(_, AnnApp _ _) = do
                       arity > 0 && arity < n_val_args ->
         do
          let (lapp, rargs) = left (n_val_args - arity) expr []
-         rargs' <- mapM (lvlMFE False ctxt_lvl env) rargs
-         lapp' <- lvlMFE False ctxt_lvl env lapp
+         rargs' <- mapM (lvlMFE False env) rargs
+         lapp' <- lvlMFE False env lapp
          return (foldl App lapp' rargs')
         where
          n_val_args = count (isValArg . deAnnotate) args
@@ -315,32 +320,24 @@ lvlExpr ctxt_lvl env expr@(_, AnnApp _ _) = do
          -- No PAPs that we can float: just carry on with the
          -- arguments and the function.
       _otherwise -> do
-         args' <- mapM (lvlMFE False ctxt_lvl env) args
-         fun'  <- lvlExpr ctxt_lvl env fun
+         args' <- mapM (lvlMFE False env) args
+         fun'  <- lvlExpr env fun
          return (foldl App fun' args')
 
-lvlExpr ctxt_lvl env (_, AnnTick tickish expr) = do
-    expr' <- lvlExpr ctxt_lvl env expr
-    return (Tick tickish expr')
-
-lvlExpr ctxt_lvl env (_, AnnCast expr (_, co)) = do
-    expr' <- lvlExpr ctxt_lvl env expr
-    return (Cast expr' (substCo (le_subst env) co))
-
 -- We don't split adjacent lambdas.  That is, given
 --	\x y -> (x+1,y)
--- we don't float to give 
+-- we don't float to give
 --	\x -> let v = x+y in \y -> (v,y)
 -- Why not?  Because partial applications are fairly rare, and splitting
 -- lambdas makes them more expensive.
 
-lvlExpr ctxt_lvl env expr@(_, AnnLam {}) = do
-    new_body <- lvlMFE True new_lvl new_env body
-    return (mkLams new_bndrs new_body)
-  where 
+lvlExpr env expr@(_, AnnLam {})
+  = do { new_body <- lvlMFE True new_env body
+       ; return (mkLams new_bndrs new_body) }
+  where
     (bndrs, body)	 = collectAnnBndrs expr
-    (new_lvl, new_bndrs) = lvlLamBndrs ctxt_lvl bndrs
-    new_env 		 = extendLvlEnv env new_bndrs
+    (env1, bndrs1)       = substBndrsSL NonRecursive env bndrs
+    (new_env, new_bndrs) = lvlLamBndrs env1 (le_ctxt_lvl env) bndrs1
 	-- At one time we called a special verion of collectBinders,
 	-- which ignored coercions, because we don't want to split
 	-- a lambda like this (\x -> coerce t (\s -> ...))
@@ -348,55 +345,52 @@ lvlExpr ctxt_lvl env expr@(_, AnnLam {}) = do
 	-- but not nearly so much now non-recursive newtypes are transparent.
 	-- [See SetLevels rev 1.50 for a version with this approach.]
 
-lvlExpr ctxt_lvl env (_, AnnLet bind body) = do
-    (bind', new_lvl, new_env) <- lvlBind ctxt_lvl env bind
-    body' <- lvlExpr new_lvl new_env body
-    return (Let bind' body')
+lvlExpr env (_, AnnLet bind body)
+  = do { (bind', new_env) <- lvlBind env bind
+       ; body' <- lvlExpr new_env body
+       ; return (Let bind' body') }
 
-lvlExpr ctxt_lvl env (_, AnnCase scrut@(scrut_fvs,_) case_bndr ty alts)
-  = do { scrut' <- lvlMFE True ctxt_lvl env scrut
-       ; lvlCase ctxt_lvl env scrut_fvs scrut' case_bndr ty alts }
+lvlExpr env (_, AnnCase scrut@(scrut_fvs,_) case_bndr ty alts)
+  = do { scrut' <- lvlMFE True env scrut
+       ; lvlCase env scrut_fvs scrut' case_bndr ty alts }
 
 -------------------------------------------
-lvlCase :: Level		-- ctxt_lvl: Level of enclosing expression
-	-> LevelEnv		-- Level of in-scope names/tyvars
+lvlCase :: LevelEnv		-- Level of in-scope names/tyvars
         -> VarSet		-- Free vars of input scrutinee
         -> LevelledExpr		-- Processed scrutinee
 	-> Id -> Type		-- Case binder and result type
 	-> [AnnAlt Id VarSet]	-- Input alternatives
 	-> LvlM LevelledExpr	-- Result expression
-lvlCase ctxt_lvl env scrut_fvs scrut' case_bndr ty alts
-  | [(con@(DataAlt {}), bs, rhs)] <- alts
+lvlCase env scrut_fvs scrut' case_bndr ty alts
+  | [(con@(DataAlt {}), bs, body)] <- alts
   , exprOkForSpeculation scrut'	  -- See Note [Check the output scrutinee for okForSpec]
   , not (isTopLvl dest_lvl)	  -- Can't have top-level cases
   =     -- See Note [Floating cases]
     	-- Always float the case if possible
   	-- Unlike lets we don't insist that it escapes a value lambda
-    do { (rhs_env, (case_bndr':bs')) <- cloneVars env (case_bndr:bs) dest_lvl
+    do { (rhs_env, (case_bndr':bs')) <- cloneVars NonRecursive env dest_lvl (case_bndr:bs)
        	 	   -- We don't need to use extendCaseBndrLvlEnv here
 		   -- because we are floating the case outwards so
 		   -- no need to do the binder-swap thing
-       ; rhs' <- lvlMFE True ctxt_lvl rhs_env rhs
-       ; let alt' = (con, [TB b (StayPut dest_lvl) | b <- bs'], rhs')
+       ; body' <- lvlMFE True rhs_env body
+       ; let alt' = (con, [TB b (StayPut dest_lvl) | b <- bs'], body')
        ; return (Case scrut' (TB case_bndr' (FloatMe dest_lvl)) ty [alt']) }
 
   | otherwise	  -- Stays put
-  = do { let case_bndr' = TB case_bndr bndr_spec
-             alts_env   = extendCaseBndrLvlEnv env scrut' case_bndr'
+  = do { let (alts_env1, [case_bndr']) = substAndLvlBndrs NonRecursive env incd_lvl [case_bndr]
+             alts_env = extendCaseBndrEnv alts_env1 case_bndr scrut'
        ; alts' <- mapM (lvl_alt alts_env) alts
        ; return (Case scrut' case_bndr' ty alts') }
   where
-      incd_lvl  = incMinorLvl ctxt_lvl
-      bndr_spec = StayPut incd_lvl
+      incd_lvl = incMinorLvl (le_ctxt_lvl env)
       dest_lvl = maxFvLevel (const True) env scrut_fvs
    	      -- Don't abstact over type variables, hence const True
 
       lvl_alt alts_env (con, bs, rhs)
-        = do { rhs' <- lvlMFE True incd_lvl new_env rhs
+        = do { rhs' <- lvlMFE True new_env rhs
              ; return (con, bs', rhs') }
         where
-          bs'     = [ TB b bndr_spec | b <- bs ]
-          new_env = extendLvlEnv alts_env bs'
+          (new_env, bs') = substAndLvlBndrs NonRecursive alts_env incd_lvl bs
 \end{code}
 
 Note [Floating cases]
@@ -445,56 +439,55 @@ That's why we apply exprOkForSpeculation to scrut' and not to scrut.
 
 \begin{code}
 lvlMFE ::  Bool			-- True <=> strict context [body of case or let]
-	-> Level		-- Level of innermost enclosing lambda/tylam
 	-> LevelEnv		-- Level of in-scope names/tyvars
 	-> CoreExprWithFVs	-- input expression
 	-> LvlM LevelledExpr	-- Result expression
 -- lvlMFE is just like lvlExpr, except that it might let-bind
 -- the expression, so that it can itself be floated.
 
-lvlMFE _ _ env (_, AnnType ty)
+lvlMFE _ env (_, AnnType ty)
   = return (Type (substTy (le_subst env) ty))
 
 -- No point in floating out an expression wrapped in a coercion or note
 -- If we do we'll transform  lvl = e |> co 
 --			 to  lvl' = e; lvl = lvl' |> co
 -- and then inline lvl.  Better just to float out the payload.
-lvlMFE strict_ctxt ctxt_lvl env (_, AnnTick t e)
-  = do { e' <- lvlMFE strict_ctxt ctxt_lvl env e
+lvlMFE strict_ctxt env (_, AnnTick t e)
+  = do { e' <- lvlMFE strict_ctxt env e
        ; return (Tick t e') }
 
-lvlMFE strict_ctxt ctxt_lvl env (_, AnnCast e (_, co))
-  = do	{ e' <- lvlMFE strict_ctxt ctxt_lvl env e
+lvlMFE strict_ctxt env (_, AnnCast e (_, co))
+  = do	{ e' <- lvlMFE strict_ctxt env e
 	; return (Cast e' (substCo (le_subst env) co)) }
 
 -- Note [Case MFEs]
-lvlMFE True ctxt_lvl env e@(_, AnnCase {})
-  = lvlExpr ctxt_lvl env e     -- Don't share cases
-
-lvlMFE strict_ctxt ctxt_lvl env ann_expr@(fvs, _)
-  |  isUnLiftedType ty		-- Can't let-bind it; see Note [Unlifted MFEs]
-     		    		-- This includes coercions, which we don't
-				-- want to float anyway
+lvlMFE True env e@(_, AnnCase {})
+  = lvlExpr env e     -- Don't share cases
+
+lvlMFE strict_ctxt env ann_expr@(fvs, _)
+  |  isUnLiftedType (exprType expr)
+         -- Can't let-bind it; see Note [Unlifted MFEs]
+         -- This includes coercions, which we don't want to float anyway
+         -- NB: no need to substitute cos isUnLiftedType doesn't change
   || notWorthFloating ann_expr abs_vars
   || not float_me
   = 	-- Don't float it out
-    lvlExpr ctxt_lvl env ann_expr
+    lvlExpr env ann_expr
 
   | otherwise	-- Float it out!
-  = do expr' <- lvlFloatRhs abs_vars dest_lvl env ann_expr
-       var <- newLvlVar abs_vars ty mb_bot
-       return (Let (NonRec (TB var (FloatMe dest_lvl)) expr') 
-                   (mkVarApps (Var var) abs_vars))
+  = do { expr' <- lvlFloatRhs abs_vars dest_lvl env ann_expr
+       ; var   <- newLvlVar expr' is_bot
+       ; return (Let (NonRec (TB var (FloatMe dest_lvl)) expr')
+                     (mkVarApps (Var var) abs_vars)) }
   where
     expr     = deAnnotate ann_expr
-    ty       = exprType expr
-    mb_bot   = exprBotStrictness_maybe expr
-    dest_lvl = destLevel env fvs (isFunction ann_expr) mb_bot
+    is_bot   = exprIsBottom expr      -- Note [Bottoming floats]
+    dest_lvl = destLevel env fvs (isFunction ann_expr) is_bot
     abs_vars = abstractVars dest_lvl env fvs
 
 	-- A decision to float entails let-binding this thing, and we only do 
 	-- that if we'll escape a value lambda, or will go to the top level.
-    float_me = dest_lvl `ltMajLvl` ctxt_lvl		-- Escapes a value lambda
+    float_me = dest_lvl `ltMajLvl` (le_ctxt_lvl env)	-- Escapes a value lambda
     	     	-- OLD CODE: not (exprIsCheap expr) || isTopLvl dest_lvl
 		-- 	     see Note [Escaping a value lambda]
 
@@ -542,9 +535,15 @@ Then we'd like to abstact over 'x' can float the whole arg of g:
 See Maessen's paper 1999 "Bottom extraction: factoring error handling out
 of functional programs" (unpublished I think).
 
-When we do this, we set the strictness and arity of the new bottoming 
-Id, so that it's properly exposed as such in the interface file, even if
-this is all happening after strictness analysis.  
+When we do this, we set the strictness and arity of the new bottoming
+Id, *immediately*, for two reasons:
+
+  * To prevent the abstracted thing being immediately inlined back in again
+    via preInlineUnconditionally.  The latter has a test for bottoming Ids
+    to stop inlining them, so we'd better make sure it *is* a bottoming Id!
+
+  * So that it's properly exposed as such in the interface file, even if
+    this is all happening after strictness analysis.
 
 Note [Bottoming floats: eta expansion] c.f Note [Bottoming floats]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -563,9 +562,11 @@ Doesn't change any other allocation at all.
 
 \begin{code}
 annotateBotStr :: Id -> Maybe (Arity, StrictSig) -> Id
+-- See Note [Bottoming floats] for why we want to add
+-- bottoming information right now
 annotateBotStr id Nothing            = id
 annotateBotStr id (Just (arity, sig)) = id `setIdArity` arity
-     		                              `setIdStrictness` sig
+                                           `setIdStrictness` sig
 
 notWorthFloating :: CoreExprWithFVs -> [Var] -> Bool
 -- Returns True if the expression would be replaced by
@@ -585,6 +586,8 @@ notWorthFloating e abs_vars
     go (_, AnnVar {}) n    = n >= 0
     go (_, AnnLit lit) n   = ASSERT( n==0 ) 
                              litIsTrivial lit	-- Note [Floating literals]
+    go (_, AnnTick t e) n  | not (tickishIsCode t)
+                           = go e n
     go (_, AnnCast e _)  n = go e n
     go (_, AnnApp e arg) n 
        | (_, AnnType {}) <- arg = go e n
@@ -664,102 +667,95 @@ OLD comment was:
 The binding stuff works for top level too.
 
 \begin{code}
-lvlBind :: Level		-- Context level; might be Top even for bindings 
-				-- nested in the RHS of a top level binding
-	-> LevelEnv
+lvlBind :: LevelEnv
 	-> CoreBindWithFVs
-	-> LvlM (LevelledBind, Level, LevelEnv)
+	-> LvlM (LevelledBind, LevelEnv)
 
-lvlBind ctxt_lvl env (AnnNonRec bndr rhs@(rhs_fvs,_))
+lvlBind env (AnnNonRec bndr rhs@(rhs_fvs,_))
   | isTyVar bndr    -- Don't do anything for TyVar binders
 	            --   (simplifier gets rid of them pronto)
   || isCoVar bndr   -- Difficult to fix up CoVar occurrences (see extendPolyLvlEnv)
                     -- so we will ignore this case for now
-  || not (profitableFloat ctxt_lvl dest_lvl)
+  || not (profitableFloat env dest_lvl)
   || (isTopLvl dest_lvl && isUnLiftedType (idType bndr))
 	  -- We can't float an unlifted binding to top level, so we don't 
 	  -- float it at all.  It's a bit brutal, but unlifted bindings 
 	  -- aren't expensive either
   = -- No float
-    do rhs' <- lvlExpr ctxt_lvl env rhs
-       let  (env', bndr') = substLetBndrNonRec env bndr bind_lvl
-            bind_lvl      = incMinorLvl ctxt_lvl
-            tagged_bndr   = TB bndr' (StayPut bind_lvl)
-       return (NonRec tagged_bndr rhs', bind_lvl, env')
+    do { rhs' <- lvlExpr env rhs
+       ; let  bind_lvl        = incMinorLvl (le_ctxt_lvl env)
+              (env', [bndr']) = substAndLvlBndrs NonRecursive env bind_lvl [bndr]
+       ; return (NonRec bndr' rhs', env') }
 
   -- Otherwise we are going to float
   | null abs_vars
-  = do  -- No type abstraction; clone existing binder
-       rhs' <- lvlExpr dest_lvl env rhs
-       (env', bndr') <- cloneVar env bndr dest_lvl
-       return (NonRec (TB bndr' (FloatMe dest_lvl)) rhs', ctxt_lvl, env') 
+  = do {  -- No type abstraction; clone existing binder
+         rhs' <- lvlExpr (setCtxtLvl env dest_lvl) rhs
+       ; (env', [bndr']) <- cloneVars NonRecursive env dest_lvl [bndr]
+       ; return (NonRec (TB bndr' (FloatMe dest_lvl)) rhs', env') }
 
   | otherwise
-  = do  -- Yes, type abstraction; create a new binder, extend substitution, etc
-       rhs' <- lvlFloatRhs abs_vars dest_lvl env rhs
-       (env', [bndr']) <- newPolyBndrs dest_lvl env abs_vars [bndr_w_str]
-       return (NonRec (TB bndr' (FloatMe dest_lvl)) rhs', ctxt_lvl, env')
+  = do {  -- Yes, type abstraction; create a new binder, extend substitution, etc
+         rhs' <- lvlFloatRhs abs_vars dest_lvl env rhs
+       ; (env', [bndr']) <- newPolyBndrs dest_lvl env abs_vars [bndr]
+       ; return (NonRec (TB bndr' (FloatMe dest_lvl)) rhs', env') }
 
   where
     bind_fvs   = rhs_fvs `unionVarSet` idFreeVars bndr
     abs_vars   = abstractVars dest_lvl env bind_fvs
-    dest_lvl   = destLevel env bind_fvs (isFunction rhs) mb_bot
-    mb_bot     = exprBotStrictness_maybe (deAnnotate rhs)
-    bndr_w_str = annotateBotStr bndr mb_bot
-
-lvlBind ctxt_lvl env (AnnRec pairs)
-  | not (profitableFloat ctxt_lvl dest_lvl)
-  = do let bind_lvl = incMinorLvl ctxt_lvl
-           (env', bndrs') = substLetBndrsRec env bndrs bind_lvl
-           tagged_bndrs = [ TB bndr' (StayPut bind_lvl) 
-                          | bndr' <- bndrs' ] 
-       rhss' <- mapM (lvlExpr bind_lvl env') rhss
-       return (Rec (tagged_bndrs `zip` rhss'), bind_lvl, env')
-
-  | null abs_vars 
-  = do (new_env, new_bndrs) <- cloneRecVars env bndrs dest_lvl
-       new_rhss <- mapM (lvlExpr ctxt_lvl new_env) rhss
-       return ( Rec ([TB b (FloatMe dest_lvl) | b <- new_bndrs] `zip` new_rhss)
-              , ctxt_lvl, new_env)
+    dest_lvl   = destLevel env bind_fvs (isFunction rhs) is_bot
+    is_bot     = exprIsBottom (deAnnotate rhs)
+
+lvlBind env (AnnRec pairs)
+  | not (profitableFloat env dest_lvl)
+  = do { let bind_lvl = incMinorLvl (le_ctxt_lvl env)
+             (env', bndrs') = substAndLvlBndrs Recursive env bind_lvl bndrs
+       ; rhss' <- mapM (lvlExpr env') rhss
+       ; return (Rec (bndrs' `zip` rhss'), env') }
+
+  | null abs_vars
+  = do { (new_env, new_bndrs) <- cloneVars Recursive env dest_lvl bndrs
+       ; new_rhss <- mapM (lvlExpr (setCtxtLvl new_env dest_lvl)) rhss
+       ; return ( Rec ([TB b (FloatMe dest_lvl) | b <- new_bndrs] `zip` new_rhss)
+                , new_env) }
 
 -- ToDo: when enabling the floatLambda stuff,
 --       I think we want to stop doing this
-  | isSingleton pairs && count isId abs_vars > 1
+  | [(bndr,rhs)] <- pairs
+  , count isId abs_vars > 1
   = do	-- Special case for self recursion where there are
-	-- several variables carried around: build a local loop:	
+	-- several variables carried around: build a local loop:
 	--	poly_f = \abs_vars. \lam_vars . letrec f = \lam_vars. rhs in f lam_vars
 	-- This just makes the closures a bit smaller.  If we don't do
 	-- this, allocation rises significantly on some programs
 	--
 	-- We could elaborate it for the case where there are several
 	-- mutually functions, but it's quite a bit more complicated
-	-- 
+	--
 	-- This all seems a bit ad hoc -- sigh
+    let (rhs_env, abs_vars_w_lvls) = lvlLamBndrs env dest_lvl abs_vars
+        rhs_lvl = le_ctxt_lvl rhs_env
+
+    (rhs_env', [new_bndr]) <- cloneVars Recursive rhs_env rhs_lvl [bndr]
     let
-        (bndr,rhs) = head pairs
-        (rhs_lvl, abs_vars_w_lvls) = lvlLamBndrs dest_lvl abs_vars
-        rhs_env = extendLvlEnv env abs_vars_w_lvls
-    (rhs_env', new_bndr) <- cloneVar rhs_env bndr rhs_lvl
-    let
-        (lam_bndrs, rhs_body)     = collectAnnBndrs rhs
-        (body_lvl, new_lam_bndrs) = lvlLamBndrs rhs_lvl lam_bndrs
-        body_env                  = extendLvlEnv rhs_env' new_lam_bndrs
-    new_rhs_body <- lvlExpr body_lvl body_env rhs_body
+        (lam_bndrs, rhs_body)   = collectAnnBndrs rhs
+        (body_env1, lam_bndrs1) = substBndrsSL NonRecursive rhs_env' lam_bndrs
+        (body_env2, lam_bndrs2) = lvlLamBndrs body_env1 rhs_lvl lam_bndrs1
+    new_rhs_body <- lvlExpr body_env2 rhs_body
     (poly_env, [poly_bndr]) <- newPolyBndrs dest_lvl env abs_vars [bndr]
-    return (Rec [(TB poly_bndr (FloatMe dest_lvl) 
+    return (Rec [(TB poly_bndr (FloatMe dest_lvl)
                	 , mkLams abs_vars_w_lvls $
-               	   mkLams new_lam_bndrs $
+               	   mkLams lam_bndrs2 $
                	   Let (Rec [( TB new_bndr (StayPut rhs_lvl)
-               	             , mkLams new_lam_bndrs new_rhs_body)]) 
-               	       (mkVarApps (Var new_bndr) lam_bndrs))]
-           , ctxt_lvl
+               	             , mkLams lam_bndrs2 new_rhs_body)])
+               	       (mkVarApps (Var new_bndr) lam_bndrs1))]
            , poly_env)
 
-  | otherwise = do  -- Non-null abs_vars
-    (new_env, new_bndrs) <- newPolyBndrs dest_lvl env abs_vars bndrs
-    new_rhss <- mapM (lvlFloatRhs abs_vars dest_lvl new_env) rhss
-    return ( Rec ([TB b (FloatMe dest_lvl) | b <- new_bndrs] `zip` new_rhss)
-           , ctxt_lvl, new_env)
+  | otherwise  -- Non-null abs_vars
+  = do { (new_env, new_bndrs) <- newPolyBndrs dest_lvl env abs_vars bndrs
+       ; new_rhss <- mapM (lvlFloatRhs abs_vars dest_lvl new_env) rhss
+       ; return ( Rec ([TB b (FloatMe dest_lvl) | b <- new_bndrs] `zip` new_rhss)
+                , new_env) }
 
   where
     (bndrs,rhss) = unzip pairs
@@ -770,25 +766,24 @@ lvlBind ctxt_lvl env (AnnRec pairs)
 	       `minusVarSet`
 	       mkVarSet bndrs
 
-    dest_lvl = destLevel env bind_fvs (all isFunction rhss) Nothing
+    dest_lvl = destLevel env bind_fvs (all isFunction rhss) False
     abs_vars = abstractVars dest_lvl env bind_fvs
 
-profitableFloat :: Level -> Level -> Bool
-profitableFloat ctxt_lvl dest_lvl
-  =  (dest_lvl `ltMajLvl` ctxt_lvl)	-- Escapes a value lambda
-  || isTopLvl dest_lvl    		-- Going all the way to top level
+profitableFloat :: LevelEnv -> Level -> Bool
+profitableFloat env dest_lvl
+  =  (dest_lvl `ltMajLvl` le_ctxt_lvl env)  -- Escapes a value lambda
+  || isTopLvl dest_lvl    		    -- Going all the way to top level
 
 ----------------------------------------------------
 -- Three help functions for the type-abstraction case
 
-lvlFloatRhs :: [CoreBndr] -> Level -> LevelEnv -> CoreExprWithFVs
+lvlFloatRhs :: [OutVar] -> Level -> LevelEnv -> CoreExprWithFVs
             -> UniqSM (Expr LevelledBndr)
-lvlFloatRhs abs_vars dest_lvl env rhs = do
-    rhs' <- lvlExpr rhs_lvl rhs_env rhs
-    return (mkLams abs_vars_w_lvls rhs')
+lvlFloatRhs abs_vars dest_lvl env rhs
+  = do { rhs' <- lvlExpr rhs_env rhs
+       ; return (mkLams abs_vars_w_lvls rhs') }
   where
-    (rhs_lvl, abs_vars_w_lvls) = lvlLamBndrs dest_lvl abs_vars
-    rhs_env = extendLvlEnv env abs_vars_w_lvls
+    (rhs_env, abs_vars_w_lvls) = lvlLamBndrs env dest_lvl abs_vars
 \end{code}
 
 
@@ -799,18 +794,27 @@ lvlFloatRhs abs_vars dest_lvl env rhs = do
 %************************************************************************
 
 \begin{code}
-lvlLamBndrs :: Level -> [CoreBndr] -> (Level, [LevelledBndr])
+substAndLvlBndrs :: RecFlag -> LevelEnv -> Level -> [InVar] -> (LevelEnv, [LevelledBndr])
+substAndLvlBndrs is_rec env lvl bndrs
+  = lvlBndrs subst_env lvl subst_bndrs
+  where
+    (subst_env, subst_bndrs) = substBndrsSL is_rec env bndrs
+
+substBndrsSL :: RecFlag -> LevelEnv -> [InVar] -> (LevelEnv, [OutVar])
+-- So named only to avoid the name clash with CoreSubst.substBndrs
+substBndrsSL is_rec env@(LE { le_subst = subst, le_env = id_env }) bndrs
+  = ( env { le_subst    = subst'
+          , le_env      = foldl add_id  id_env (bndrs `zip` bndrs') }
+    , bndrs')
+  where
+    (subst', bndrs') = case is_rec of
+                         NonRecursive -> substBndrs    subst bndrs
+                         Recursive    -> substRecBndrs subst bndrs
+
+lvlLamBndrs :: LevelEnv -> Level -> [OutVar] -> (LevelEnv, [LevelledBndr])
 -- Compute the levels for the binders of a lambda group
--- The binders returned are exactly the same as the ones passed,
--- but they are now paired with a level
-lvlLamBndrs lvl [] 
-  = (lvl, [])
-
-lvlLamBndrs lvl bndrs
-  = (new_lvl, [TB bndr (StayPut new_lvl) | bndr <- bndrs])
-  -- All the new binders get the same level, because
-  -- any floating binding is either going to float past 
-  -- all or none.  We never separate binders
+lvlLamBndrs env lvl bndrs
+  = lvlBndrs env new_lvl bndrs
   where
     new_lvl | any is_major bndrs = incMajorLvl lvl
             | otherwise          = incMinorLvl lvl
@@ -818,16 +822,37 @@ lvlLamBndrs lvl bndrs
     is_major bndr = isId bndr && not (isProbablyOneShotLambda bndr)
        -- The "probably" part says "don't float things out of a
        -- probable one-shot lambda"
+
+
+lvlBndrs :: LevelEnv -> Level -> [CoreBndr] -> (LevelEnv, [LevelledBndr])
+-- The binders returned are exactly the same as the ones passed,
+-- apart from applying the substitution, but they are now paired
+-- with a (StayPut level)
+--
+-- The returned envt has ctxt_lvl updated to the new_lvl
+--
+-- All the new binders get the same level, because
+-- any floating binding is either going to float past
+-- all or none.  We never separate binders.
+lvlBndrs env@(LE { le_lvl_env = lvl_env }) new_lvl bndrs
+  = ( env { le_ctxt_lvl = new_lvl
+          , le_lvl_env  = foldl add_lvl lvl_env bndrs }
+    , lvld_bndrs)
+  where
+    lvld_bndrs    = [TB bndr (StayPut new_lvl) | bndr <- bndrs]
+    add_lvl env v = extendVarEnv env v new_lvl
 \end{code}
 
 \begin{code}
   -- Destination level is the max Id level of the expression
   -- (We'll abstract the type variables, if any.)
-destLevel :: LevelEnv -> VarSet -> Bool -> 
-             Maybe (Arity, StrictSig) -> Level
-destLevel env fvs is_function mb_bot
-  | Just {} <- mb_bot = tOP_LEVEL	-- Send bottoming bindings to the top 
-					-- regardless; see Note [Bottoming floats]
+destLevel :: LevelEnv -> VarSet
+          -> Bool   -- True <=> is function
+          -> Bool   -- True <=> is bottom
+          -> Level
+destLevel env fvs is_function is_bot
+  | is_bot = tOP_LEVEL	-- Send bottoming bindings to the top
+			-- regardless; see Note [Bottoming floats]
   | Just n_args <- floatLams env
   , n_args > 0	-- n=0 case handled uniformly by the 'otherwise' case
   , is_function
@@ -874,17 +899,22 @@ countFreeIds = foldVarSet add 0
 %************************************************************************
 
 \begin{code}
-data LevelEnv 
+type InVar  = Var   -- Pre  cloning
+type InId   = Id    -- Pre  cloning
+type OutVar = Var   -- Post cloning
+type OutId  = Id    -- Post cloning
+
+data LevelEnv
   = LE { le_switches :: FloatOutSwitches
+       , le_ctxt_lvl :: Level           -- The current level
        , le_lvl_env  :: VarEnv Level	-- Domain is *post-cloned* TyVars and Ids
-       , le_subst    :: Subst 		-- Domain is pre-cloned Ids; tracks the in-scope set
-					-- 	so that substitution is capture-avoiding
+       , le_subst    :: Subst 		-- Domain is pre-cloned TyVars and Ids
                                         -- The Id -> CoreExpr in the Subst is ignored
-                                        -- (since we want to substitute in LevelledExpr
-                                        -- instead) but we do use the Co/TyVar substs
-       , le_env      :: IdEnv ([Var], LevelledExpr)	-- Domain is pre-cloned Ids
+                                        -- (since we want to substitute a LevelledExpr for
+                                        -- an Id via le_env) but we do use the Co/TyVar substs
+       , le_env      :: IdEnv ([OutVar], LevelledExpr)	-- Domain is pre-cloned Ids
     }
-	-- We clone let-bound variables so that they are still
+	-- We clone let- and case-bound variables so that they are still
 	-- distinct when floated out; hence the le_subst/le_env.
         -- (see point 3 of the module overview comment).
 	-- We also use these envs when making a variable polymorphic
@@ -906,9 +936,12 @@ data LevelEnv
 	-- The domain of the le_lvl_env is the *post-cloned* Ids
 
 initialEnv :: FloatOutSwitches -> LevelEnv
-initialEnv float_lams 
-  = LE { le_switches = float_lams, le_lvl_env = emptyVarEnv
-       , le_subst = emptySubst, le_env = emptyVarEnv }
+initialEnv float_lams
+  = LE { le_switches = float_lams
+       , le_ctxt_lvl = tOP_LEVEL
+       , le_lvl_env = emptyVarEnv
+       , le_subst = emptySubst
+       , le_env = emptyVarEnv }
 
 floatLams :: LevelEnv -> Maybe Int
 floatLams le = floatOutLambdas (le_switches le)
@@ -919,67 +952,20 @@ floatConsts le = floatOutConstants (le_switches le)
 floatPAPs :: LevelEnv -> Bool
 floatPAPs le = floatOutPartialApplications (le_switches le)
 
-extendLvlEnv :: LevelEnv -> [LevelledBndr] -> LevelEnv
--- Used when *not* cloning
-extendLvlEnv le@(LE { le_lvl_env = lvl_env, le_subst = subst, le_env = id_env }) 
-             prs
-  = le { le_lvl_env = foldl add_lvl lvl_env prs
-       , le_subst   = foldl del_subst subst prs
-       , le_env     = foldl del_id id_env prs }
-  where
-    add_lvl   env (TB v s) = extendVarEnv env v (floatSpecLevel s)
-    del_subst env (TB v _) = extendInScope env v
-    del_id    env (TB v _) = delVarEnv env v
-  -- We must remove any clone for this variable name in case of
-  -- shadowing.  This bit me in the following case
-  -- (in nofib/real/gg/Spark.hs):
-  -- 
-  --   case ds of wild {
-  --     ... -> case e of wild {
-  --              ... -> ... wild ...
-  --            }
-  --   }
-  -- 
-  -- The inside occurrence of @wild@ was being replaced with @ds@,
-  -- incorrectly, because the SubstEnv was still lying around.  Ouch!
-  -- KSW 2000-07.
+setCtxtLvl :: LevelEnv -> Level -> LevelEnv
+setCtxtLvl env lvl = env { le_ctxt_lvl = lvl }
 
 -- extendCaseBndrLvlEnv adds the mapping case-bndr->scrut-var if it can
 -- (see point 4 of the module overview comment)
-extendCaseBndrLvlEnv :: LevelEnv -> Expr LevelledBndr
-                     -> LevelledBndr -> LevelEnv
-extendCaseBndrLvlEnv le@(LE { le_subst = subst, le_env = id_env }) 
-                     (Var scrut_var) (TB case_bndr _)
+extendCaseBndrEnv :: LevelEnv
+                  -> Id                 -- Pre-cloned case binder
+                  -> Expr LevelledBndr  -- Post-cloned scrutinee
+                  -> LevelEnv
+extendCaseBndrEnv le@(LE { le_subst = subst, le_env = id_env })
+                  case_bndr (Var scrut_var)
   = le { le_subst   = extendSubstWithVar subst case_bndr scrut_var
-       , le_env     = extendVarEnv id_env case_bndr ([scrut_var], ASSERT(not (isCoVar scrut_var)) Var scrut_var) }
-     
-extendCaseBndrLvlEnv env _scrut case_bndr
-  = extendLvlEnv env [case_bndr]
-
-extendPolyLvlEnv :: Level -> LevelEnv -> [Var] -> [(Var {- :: t -}, Var {- :: mkPiTypes abs_vars t -})] -> LevelEnv
-extendPolyLvlEnv dest_lvl 
-                 le@(LE { le_lvl_env = lvl_env, le_subst = subst, le_env = id_env }) 
-                 abs_vars bndr_pairs
-   = ASSERT( all (not . isCoVar . fst) bndr_pairs ) -- What would we add to the CoSubst in this case. No easy answer, so avoid floating 
-    le { le_lvl_env = foldl add_lvl   lvl_env bndr_pairs
-       , le_subst   = foldl add_subst subst   bndr_pairs
-       , le_env     = foldl add_id    id_env  bndr_pairs }
-  where
-     add_lvl   env (_, v') = extendVarEnv env v' dest_lvl
-     add_subst env (v, v') = extendIdSubst env v (mkVarApps (Var v') abs_vars)
-     add_id    env (v, v') = extendVarEnv env v ((v':abs_vars), mkVarApps (Var v') abs_vars)
-
-extendCloneLvlEnv :: Level -> LevelEnv -> Subst -> [(Var, Var)] -> LevelEnv
-extendCloneLvlEnv lvl le@(LE { le_lvl_env = lvl_env, le_env = id_env }) 
-                  new_subst bndr_pairs
-  = le { le_lvl_env = foldl add_lvl lvl_env bndr_pairs
-       , le_subst   = new_subst
-       , le_env     = foldl add_id  id_env  bndr_pairs }
-  where
-     add_lvl env (_, v_cloned) = extendVarEnv env v_cloned lvl
-     add_id  env (v, v_cloned) = if isTyVar v
-                                 then delVarEnv    env v
-                                 else extendVarEnv env v ([v_cloned], ASSERT(not (isCoVar v_cloned)) Var v_cloned)
+       , le_env     = add_id id_env (case_bndr, scrut_var) }
+extendCaseBndrEnv env _ _ = env
 
 maxFvLevel :: (Var -> Bool) -> LevelEnv -> VarSet -> Level
 maxFvLevel max_me (LE { le_lvl_env = lvl_env, le_env = id_env }) var_set
@@ -1001,17 +987,17 @@ lookupVar le v = case lookupVarEnv (le_env le) v of
 		    Just (_, expr) -> expr
 		    _              -> Var v
 
-abstractVars :: Level -> LevelEnv -> VarSet -> [Var]
+abstractVars :: Level -> LevelEnv -> VarSet -> [OutVar]
 	-- Find the variables in fvs, free vars of the target expresion,
 	-- whose level is greater than the destination level
 	-- These are the ones we are going to abstract out
-abstractVars dest_lvl (LE { le_lvl_env = lvl_env, le_env = id_env }) fvs
+abstractVars dest_lvl (LE { le_subst = subst, le_lvl_env = lvl_env }) in_fvs
   = map zap $ uniq $ sortQuantVars
-	[var | fv <- varSetElems fvs
-	     , var <- varSetElems (absVarsOf id_env fv)
-	     , abstract_me var ]
+    [out_var | out_fv  <- varSetElems (substVarSet subst in_fvs)
+	     , out_var <- varSetElems (close out_fv)
+	     , abstract_me out_var ]
 	-- NB: it's important to call abstract_me only on the OutIds the
-	-- come from absVarsOf (not on fv, which is an InId)
+	-- come from substVarSet (not on fv, which is an InId)
   where
     uniq :: [Var] -> [Var]
 	-- Remove adjacent duplicates; the sort will have brought them together
@@ -1031,21 +1017,8 @@ abstractVars dest_lvl (LE { le_lvl_env = lvl_env, le_env = id_env }) fvs
 		     setIdInfo v vanillaIdInfo
 	  | otherwise = v
 
-absVarsOf :: IdEnv ([Var], LevelledExpr) -> Var -> VarSet
-	-- If f is free in the expression, and f maps to poly_f a b c in the
-	-- current substitution, then we must report a b c as candidate type
-	-- variables
-	--
-	-- Also, if x::a is an abstracted variable, then so is a; that is,
-	-- we must look in x's type. What's more, if a mentions kind variables,
-	-- we must also return those.
-absVarsOf id_env v 
-  | isId v, Just (abs_vars, _) <- lookupVarEnv id_env v
-  = foldr (unionVarSet . close) emptyVarSet abs_vars
-  | otherwise
-  = close v
-  where
-    close :: Var -> VarSet  -- Result include the input variable itself
+    close :: Var -> VarSet  -- Close over variables free in the type
+                            -- Result includes the input variable itself
     close v = foldVarSet (unionVarSet . close)
                          (unitVarSet v)
                          (varTypeTyVars v)
@@ -1060,84 +1033,76 @@ initLvl = initUs_
 
 
 \begin{code}
-newPolyBndrs :: Level -> LevelEnv -> [Var] -> [Id] -> UniqSM (LevelEnv, [Id])
-newPolyBndrs dest_lvl env abs_vars bndrs = do
-    uniqs <- getUniquesM
-    let new_bndrs = zipWith mk_poly_bndr bndrs uniqs
-    return (extendPolyLvlEnv dest_lvl env abs_vars (bndrs `zip` new_bndrs), new_bndrs)
+newPolyBndrs :: Level -> LevelEnv -> [OutVar] -> [InId] -> UniqSM (LevelEnv, [OutId])
+-- The envt is extended to bind the new bndrs to dest_lvl, but
+-- the ctxt_lvl is unaffected
+newPolyBndrs dest_lvl
+             env@(LE { le_lvl_env = lvl_env, le_subst = subst, le_env = id_env })
+             abs_vars bndrs
+ = ASSERT( all (not . isCoVar) bndrs )   -- What would we add to the CoSubst in this case. No easy answer.
+   do { uniqs <- getUniquesM
+      ; let new_bndrs = zipWith mk_poly_bndr bndrs uniqs
+            bndr_prs  = bndrs `zip` new_bndrs
+            env' = env { le_lvl_env = foldl add_lvl   lvl_env new_bndrs
+                       , le_subst   = foldl add_subst subst   bndr_prs
+                       , le_env     = foldl add_id    id_env  bndr_prs }
+      ; return (env', new_bndrs) }
   where
+    add_lvl   env v' = extendVarEnv env v' dest_lvl
+    add_subst env (v, v') = extendIdSubst env v (mkVarApps (Var v') abs_vars)
+    add_id    env (v, v') = extendVarEnv env v ((v':abs_vars), mkVarApps (Var v') abs_vars)
+
     mk_poly_bndr bndr uniq = transferPolyIdInfo bndr abs_vars $ 	-- Note [transferPolyIdInfo] in Id.lhs
 			     mkSysLocal (mkFastString str) uniq poly_ty
 			   where
 			     str     = "poly_" ++ occNameString (getOccName bndr)
-			     poly_ty = mkPiTypes abs_vars (idType bndr)
+			     poly_ty = mkPiTypes abs_vars (substTy subst (idType bndr))
 
-newLvlVar :: [CoreBndr] -> Type 	-- Abstract wrt these bndrs
-	  -> Maybe (Arity, StrictSig)   -- Note [Bottoming floats]
+newLvlVar :: LevelledExpr        -- The RHS of the new binding
+          -> Bool                -- Whether it is bottom
 	  -> LvlM Id
-newLvlVar vars body_ty mb_bot
+newLvlVar lvld_rhs is_bot
   = do { uniq <- getUniqueM
-       ; return (mkLocalIdWithInfo (mk_name uniq) (mkPiTypes vars body_ty) info) }
+       ; return (add_bot_info (mkLocalId (mk_name uniq) rhs_ty)) }
   where
+    add_bot_info var  -- We could call annotateBotStr always, but the is_bot
+                      -- flag just tells us when we don't need to do so
+       | is_bot    = annotateBotStr var (exprBotStrictness_maybe de_tagged_rhs)
+       | otherwise = var
+    de_tagged_rhs = deTagExpr lvld_rhs
+    rhs_ty = exprType de_tagged_rhs
     mk_name uniq = mkSystemVarName uniq (mkFastString "lvl")
-    arity = count isId vars
-    info = case mb_bot of
-		Nothing               -> vanillaIdInfo
-		Just (bot_arity, sig) -> 
-                     vanillaIdInfo 
-		    `setArityInfo`      (arity + bot_arity)
-		    `setStrictnessInfo` (increaseStrictSigArity arity sig)
-    
--- The deeply tiresome thing is that we have to apply the substitution
--- to the rules inside each Id.  Grr.  But it matters.
-
-substLetBndrNonRec :: LevelEnv -> Id -> Level -> (LevelEnv, Id)
-substLetBndrNonRec 
-    le@(LE { le_lvl_env = lvl_env, le_subst = subst, le_env = id_env }) 
-    bndr bind_lvl
-  = ASSERT( isId bndr )
-    (env', bndr' )
-  where
-    (subst', bndr') = substBndr subst bndr
-    env'	    = le { le_lvl_env = extendVarEnv lvl_env bndr bind_lvl
-                         , le_subst = subst'
-                         , le_env = delVarEnv id_env bndr }
-
-substLetBndrsRec :: LevelEnv -> [Id] -> Level -> (LevelEnv, [Id])
-substLetBndrsRec 
-    le@(LE { le_lvl_env = lvl_env, le_subst = subst, le_env = id_env }) 
-    bndrs bind_lvl
-  = ASSERT( all isId bndrs )
-    (env', bndrs')
+
+cloneVars :: RecFlag -> LevelEnv -> Level -> [Var] -> LvlM (LevelEnv, [Var])
+-- Works for Ids, TyVars and CoVars
+-- The dest_lvl is attributed to the binders in the new env,
+-- but cloneVars doesn't affect the ctxt_lvl of the incoming env
+cloneVars is_rec
+          env@(LE { le_subst = subst, le_lvl_env = lvl_env, le_env = id_env })
+          dest_lvl vs
+  = do { us <- getUniqueSupplyM
+       ; let (subst', vs1) = case is_rec of
+                               NonRecursive -> cloneBndrs      subst us vs
+                               Recursive    -> cloneRecIdBndrs subst us vs
+      	     vs2  = map zap_demand_info vs1  -- See Note [Zapping the demand info]
+             prs  = vs `zip` vs2
+      	     env' = env { le_lvl_env = foldl add_lvl lvl_env vs2
+                        , le_subst   = subst'
+                        , le_env     = foldl add_id id_env prs }
+
+       ; return (env', vs2) }
   where
-    (subst', bndrs') = substRecBndrs subst bndrs
-    env'	     = le { le_lvl_env = extendVarEnvList lvl_env [(b,bind_lvl) | b <- bndrs]
-                          , le_subst = subst'
-                          , le_env = delVarEnvList id_env bndrs }
-
-cloneVar :: LevelEnv -> Var -> Level -> LvlM (LevelEnv, Var)
-cloneVar env v dest_lvl -- Works for Ids, TyVars and CoVars
-  = do { u <- getUniqueM
-       ; let (subst', v1) = cloneBndr (le_subst env) u v
-      	     v2     	  = if isId v1 
-                            then zapDemandIdInfo v1  
-                            else v1
-      	     env'	  = extendCloneLvlEnv dest_lvl env subst' [(v,v2)]
-       ; return (env', v2) }
-
-cloneVars :: LevelEnv -> [Var] -> Level -> LvlM (LevelEnv, [Var])
-cloneVars env vs dest_lvl = mapAccumLM (\env v -> cloneVar env v dest_lvl) env vs
-
-cloneRecVars :: LevelEnv -> [Id] -> Level -> LvlM (LevelEnv, [Id])
-cloneRecVars env vs dest_lvl -- Works for CoVars too (since cloneRecIdBndrs does)
-  = ASSERT( all isId vs ) do
-    us <- getUniqueSupplyM
-    let
-      (subst', vs1) = cloneRecIdBndrs (le_subst env) us vs
-      -- Note [Zapping the demand info]
-      vs2	    = map zapDemandIdInfo vs1  
-      env'	    = extendCloneLvlEnv dest_lvl env subst' (vs `zip` vs2)
-    return (env', vs2)
+     add_lvl env v_cloned = extendVarEnv env v_cloned dest_lvl
+
+add_id :: IdEnv ([Var], LevelledExpr) -> (Var, Var) -> IdEnv ([Var], LevelledExpr)
+add_id id_env (v, v1)
+  | isTyVar v = delVarEnv    id_env v
+  | otherwise = extendVarEnv id_env v ([v1], ASSERT(not (isCoVar v1)) Var v1)
+
+zap_demand_info :: Var -> Var
+zap_demand_info v
+  | isId v    = zapDemandIdInfo v
+  | otherwise = v
 \end{code}
 
 Note [Zapping the demand info]
@@ -1149,4 +1114,3 @@ binding site.  Eg
    f x = let v = 3*4 in v+x
 Here v is strict; but if we float v to top level, it isn't any more.
 
-	
diff --git a/compiler/simplCore/SimplCore.lhs b/compiler/simplCore/SimplCore.lhs
index c487c984919f..59b39a9c60d7 100644
--- a/compiler/simplCore/SimplCore.lhs
+++ b/compiler/simplCore/SimplCore.lhs
@@ -4,6 +4,8 @@
 \section[SimplCore]{Driver for simplifying @Core@ programs}
 
 \begin{code}
+{-# LANGUAGE CPP #-}
+
 module SimplCore ( core2core, simplifyExpr ) where
 
 #include "HsVersions.h"
@@ -37,6 +39,7 @@ import SAT              ( doStaticArgs )
 import Specialise       ( specProgram)
 import SpecConstr       ( specConstrProgram)
 import DmdAnal          ( dmdAnalProgram )
+import CallArity        ( callArityAnalProgram )
 import WorkWrap         ( wwTopBinds )
 import Vectorise        ( vectorise )
 import FastString
@@ -114,6 +117,7 @@ getCoreToDo dflags
     phases        = simplPhases        dflags
     max_iter      = maxSimplIterations dflags
     rule_check    = ruleCheck          dflags
+    call_arity    = gopt Opt_CallArity                    dflags
     strictness    = gopt Opt_Strictness                   dflags
     full_laziness = gopt Opt_FullLaziness                 dflags
     do_specialise = gopt Opt_Specialise                   dflags
@@ -258,6 +262,11 @@ getCoreToDo dflags
                 -- Don't stop now!
         simpl_phase 0 ["main"] (max max_iter 3),
 
+        runWhen call_arity $ CoreDoPasses
+            [ CoreDoCallArity
+            , simpl_phase 0 ["post-call-arity"] max_iter
+            ],
+
         runWhen strictness demand_analyser,
 
         runWhen full_laziness $
@@ -396,6 +405,9 @@ doCorePass (CoreDoFloatOutwards f)   = {-# SCC "FloatOutwards" #-}
 doCorePass CoreDoStaticArgs          = {-# SCC "StaticArgs" #-}
                                        doPassU doStaticArgs
 
+doCorePass CoreDoCallArity           = {-# SCC "CallArity" #-}
+                                       doPassD callArityAnalProgram
+
 doCorePass CoreDoStrictness          = {-# SCC "NewStranal" #-}
                                        doPassDFM dmdAnalProgram
 
diff --git a/compiler/simplCore/SimplEnv.lhs b/compiler/simplCore/SimplEnv.lhs
index 5f1013def893..71021a0179c8 100644
--- a/compiler/simplCore/SimplEnv.lhs
+++ b/compiler/simplCore/SimplEnv.lhs
@@ -4,6 +4,8 @@
 \section[SimplMonad]{The simplifier Monad}
 
 \begin{code}
+{-# LANGUAGE CPP #-}
+
 module SimplEnv (
         InId, InBind, InExpr, InAlt, InArg, InType, InBndr, InVar,
         OutId, OutTyVar, OutBind, OutExpr, OutAlt, OutArg, OutType, OutBndr, OutVar,
@@ -29,8 +31,8 @@ module SimplEnv (
 
         -- Floats
         Floats, emptyFloats, isEmptyFloats, addNonRec, addFloats, extendFloats,
-        wrapFloats, floatBinds, setFloats, zapFloats, addRecFloats,
-        doFloatFromRhs, getFloatBinds, getFloats, mapFloats
+        wrapFloats, setFloats, zapFloats, addRecFloats, mapFloats,
+        doFloatFromRhs, getFloatBinds
     ) where
 
 #include "HsVersions.h"
@@ -45,7 +47,7 @@ import VarEnv
 import VarSet
 import OrdList
 import Id
-import MkCore
+import MkCore                   ( mkWildValBinder )
 import TysWiredIn
 import qualified CoreSubst
 import qualified Type
@@ -342,15 +344,21 @@ Note [Simplifier floats]
 ~~~~~~~~~~~~~~~~~~~~~~~~~
 The Floats is a bunch of bindings, classified by a FloatFlag.
 
+* All of them satisfy the let/app invariant
+
+Examples
+
   NonRec x (y:ys)       FltLifted
   Rec [(x,rhs)]         FltLifted
 
+  NonRec x* (p:q)       FltOKSpec   -- RHS is WHNF.  Question: why not FltLifted?
   NonRec x# (y +# 3)    FltOkSpec   -- Unboxed, but ok-for-spec'n
 
-  NonRec x# (a /# b)    FltCareful
   NonRec x* (f y)       FltCareful  -- Strict binding; might fail or diverge
-  NonRec x# (f y)       FltCareful  -- Unboxed binding: might fail or diverge
-                                    --  (where f :: Int -> Int#)
+
+Can't happen:
+  NonRec x# (a /# b)    -- Might fail; does not satisfy let/app
+  NonRec x# (f y)       -- Might diverge; does not satisfy let/app
 
 \begin{code}
 data Floats = Floats (OrdList OutBind) FloatFlag
@@ -386,13 +394,6 @@ andFF FltOkSpec  FltCareful = FltCareful
 andFF FltOkSpec  _          = FltOkSpec
 andFF FltLifted  flt        = flt
 
-classifyFF :: CoreBind -> FloatFlag
-classifyFF (Rec _) = FltLifted
-classifyFF (NonRec bndr rhs)
-  | not (isStrictId bndr)    = FltLifted
-  | exprOkForSpeculation rhs = FltOkSpec
-  | otherwise                = FltCareful
-
 doFloatFromRhs :: TopLevelFlag -> RecFlag -> Bool -> OutExpr -> SimplEnv -> Bool
 -- If you change this function look also at FloatIn.noFloatFromRhs
 doFloatFromRhs lvl rec str rhs (SimplEnv {seFloats = Floats fs ff})
@@ -421,8 +422,16 @@ emptyFloats :: Floats
 emptyFloats = Floats nilOL FltLifted
 
 unitFloat :: OutBind -> Floats
--- A single-binding float
-unitFloat bind = Floats (unitOL bind) (classifyFF bind)
+-- This key function constructs a singleton float with the right form
+unitFloat bind = Floats (unitOL bind) (flag bind)
+  where
+    flag (Rec {})                = FltLifted
+    flag (NonRec bndr rhs)
+      | not (isStrictId bndr)    = FltLifted
+      | exprOkForSpeculation rhs = FltOkSpec  -- Unlifted, and lifted but ok-for-spec (eg HNF)
+      | otherwise                = ASSERT2( not (isUnLiftedType (idType bndr)), ppr bndr )
+                                   FltCareful
+      -- Unlifted binders can only be let-bound if exprOkForSpeculation holds
 
 addNonRec :: SimplEnv -> OutId -> OutExpr -> SimplEnv
 -- Add a non-recursive binding and extend the in-scope set
@@ -435,13 +444,6 @@ addNonRec env id rhs
     env { seFloats = seFloats env `addFlts` unitFloat (NonRec id rhs),
           seInScope = extendInScopeSet (seInScope env) id }
 
-mapFloats :: SimplEnv -> ((Id,CoreExpr) -> (Id,CoreExpr)) -> SimplEnv
-mapFloats env@SimplEnv { seFloats = Floats fs ff } fun
-   = env { seFloats = Floats (mapOL app fs) ff }
-   where
-     app (NonRec b e) = case fun (b,e) of (b',e') -> NonRec b' e'
-     app (Rec bs)     = Rec (map fun bs)
-
 extendFloats :: SimplEnv -> OutBind -> SimplEnv
 -- Add these bindings to the floats, and extend the in-scope env too
 extendFloats env bind
@@ -475,32 +477,31 @@ addRecFloats env1 env2@(SimplEnv {seFloats = Floats bs ff})
     env2 {seFloats = seFloats env1 `addFlts` unitFloat (Rec (flattenBinds (fromOL bs)))}
 
 wrapFloats :: SimplEnv -> OutExpr -> OutExpr
-wrapFloats env expr = wrapFlts (seFloats env) expr
-
-wrapFlts :: Floats -> OutExpr -> OutExpr
--- Wrap the floats around the expression, using case-binding where necessary
-wrapFlts (Floats bs _) body = foldrOL wrap body bs
-  where
-    wrap (Rec prs)    body = Let (Rec prs) body
-    wrap (NonRec b r) body = bindNonRec b r body
+-- Wrap the floats around the expression; they should all
+-- satisfy the let/app invariant, so mkLets should do the job just fine
+wrapFloats (SimplEnv {seFloats = Floats bs _}) body
+  = foldrOL Let body bs
 
 getFloatBinds :: SimplEnv -> [CoreBind]
-getFloatBinds env = floatBinds (seFloats env)
-
-getFloats :: SimplEnv -> Floats
-getFloats env = seFloats env
+getFloatBinds (SimplEnv {seFloats = Floats bs _})
+  = fromOL bs
 
 isEmptyFloats :: SimplEnv -> Bool
-isEmptyFloats env = isEmptyFlts (seFloats env)
+isEmptyFloats (SimplEnv {seFloats = Floats bs _})
+  = isNilOL bs
 
-isEmptyFlts :: Floats -> Bool
-isEmptyFlts (Floats bs _) = isNilOL bs
+-- mapFloats commented out: used only in a commented-out bit of Simplify,
+-- concerning ticks
+--
+mapFloats :: SimplEnv -> ((Id,CoreExpr) -> (Id,CoreExpr)) -> SimplEnv
+mapFloats env@SimplEnv { seFloats = Floats fs ff } fun
+   = env { seFloats = Floats (mapOL app fs) ff }
+   where
+    app (NonRec b e) = case fun (b,e) of (b',e') -> NonRec b' e'
+    app (Rec bs)     = Rec (map fun bs)
 
-floatBinds :: Floats -> [OutBind]
-floatBinds (Floats bs _) = fromOL bs
 \end{code}
 
-
 %************************************************************************
 %*                                                                      *
                 Substitution of Vars
diff --git a/compiler/simplCore/SimplUtils.lhs b/compiler/simplCore/SimplUtils.lhs
index 6c7dcc204218..b2b8ea91893b 100644
--- a/compiler/simplCore/SimplUtils.lhs
+++ b/compiler/simplCore/SimplUtils.lhs
@@ -4,6 +4,8 @@
 \section[SimplUtils]{The simplifier utilities}
 
 \begin{code}
+{-# LANGUAGE CPP #-}
+
 module SimplUtils (
         -- Rebuilding
         mkLam, mkCase, prepareAlts, tryEtaExpandRhs,
@@ -60,6 +62,7 @@ import FastString
 import Pair
 
 import Control.Monad    ( when )
+import Data.List        ( partition )
 \end{code}
 
 
@@ -852,6 +855,10 @@ the former.
 
 \begin{code}
 preInlineUnconditionally :: DynFlags -> SimplEnv -> TopLevelFlag -> InId -> InExpr -> Bool
+-- Precondition: rhs satisfies the let/app invariant
+-- See Note [CoreSyn let/app invariant] in CoreSyn
+-- Reason: we don't want to inline single uses, or discard dead bindings,
+--         for unlifted, side-effect-full bindings
 preInlineUnconditionally dflags env top_lvl bndr rhs
   | not active                               = False
   | isStableUnfolding (idUnfolding bndr)     = False -- Note [InlineRule and preInlineUnconditionally]
@@ -894,6 +901,7 @@ preInlineUnconditionally dflags env top_lvl bndr rhs
         -- Sadly, not quite the same as exprIsHNF.
     canInlineInLam (Lit _)              = True
     canInlineInLam (Lam b e)            = isRuntimeVar b || canInlineInLam e
+    canInlineInLam (Tick t e)           = not (tickishIsCode t) && canInlineInLam e
     canInlineInLam _                    = False
       -- not ticks.  Counting ticks cannot be duplicated, and non-counting
       -- ticks around a Lam will disappear anyway.
@@ -961,6 +969,10 @@ postInlineUnconditionally
     -> OutExpr
     -> Unfolding
     -> Bool
+-- Precondition: rhs satisfies the let/app invariant
+-- See Note [CoreSyn let/app invariant] in CoreSyn
+-- Reason: we don't want to inline single uses, or discard dead bindings,
+--         for unlifted, side-effect-full bindings
 postInlineUnconditionally dflags env top_lvl bndr occ_info rhs unfolding
   | not active                  = False
   | isWeakLoopBreaker occ_info  = False -- If it's a loop-breaker of any kind, don't inline
@@ -1190,15 +1202,14 @@ because the latter is not well-kinded.
 \begin{code}
 tryEtaExpandRhs :: SimplEnv -> OutId -> OutExpr -> SimplM (Arity, OutExpr)
 -- See Note [Eta-expanding at let bindings]
--- and Note [Eta expansion to manifest arity]
 tryEtaExpandRhs env bndr rhs
   = do { dflags <- getDynFlags
        ; (new_arity, new_rhs) <- try_expand dflags
 
-       ; WARN( new_arity < old_arity || new_arity < _dmd_arity,
-               (ptext (sLit "Arity decrease:") <+> (ppr bndr <+> ppr old_arity
-                <+> ppr new_arity <+> ppr _dmd_arity) $$ ppr new_rhs) )
-                        -- Note [Arity decrease]
+       ; WARN( new_arity < old_id_arity,
+               (ptext (sLit "Arity decrease:") <+> (ppr bndr <+> ppr old_id_arity
+                <+> ppr old_arity <+> ppr new_arity) $$ ppr new_rhs) )
+                        -- Note [Arity decrease] in Simplify
          return (new_arity, new_rhs) }
   where
     try_expand dflags
@@ -1206,16 +1217,17 @@ tryEtaExpandRhs env bndr rhs
       = return (exprArity rhs, rhs)
 
       | sm_eta_expand (getMode env)      -- Provided eta-expansion is on
-      , let new_arity = findRhsArity dflags bndr rhs old_arity
-      , new_arity > manifest_arity      -- And the curent manifest arity isn't enough
+      , let new_arity1 = findRhsArity dflags bndr rhs old_arity
+            new_arity2 = idCallArity bndr
+            new_arity  = max new_arity1 new_arity2
+      , new_arity > old_arity      -- And the current manifest arity isn't enough
       = do { tick (EtaExpansion bndr)
            ; return (new_arity, etaExpand new_arity rhs) }
       | otherwise
-      = return (manifest_arity, rhs)
+      = return (old_arity, rhs)
 
-    manifest_arity = manifestArity rhs
-    old_arity  = idArity bndr
-    _dmd_arity = length $ fst $ splitStrictSig $ idStrictness bndr
+    old_arity    = exprArity rhs -- See Note [Do not expand eta-expand PAPs]
+    old_id_arity = idArity bndr
 \end{code}
 
 Note [Eta-expanding at let bindings]
@@ -1224,7 +1236,7 @@ We now eta expand at let-bindings, which is where the payoff comes.
 The most significant thing is that we can do a simple arity analysis
 (in CoreArity.findRhsArity), which we can't do for free-floating lambdas
 
-One useful consequence is this example:
+One useful consequence of not eta-expanding lambdas is this example:
    genMap :: C a => ...
    {-# INLINE genMap #-}
    genMap f xs = ...
@@ -1234,7 +1246,7 @@ One useful consequence is this example:
    myMap = genMap
 
 Notice that 'genMap' should only inline if applied to two arguments.
-In the InlineRule for myMap we'll have the unfolding
+In the stable unfolding for myMap we'll have the unfolding
     (\d -> genMap Int (..d..))
 We do not want to eta-expand to
     (\d f xs -> genMap Int (..d..) f xs)
@@ -1242,6 +1254,29 @@ because then 'genMap' will inline, and it really shouldn't: at least
 as far as the programmer is concerned, it's not applied to two
 arguments!
 
+Note [Do not eta-expand PAPs]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+We used to have old_arity = manifestArity rhs, which meant that we
+would eta-expand even PAPs.  But this gives no particular advantage,
+and can lead to a massive blow-up in code size, exhibited by Trac #9020.  
+Suppose we have a PAP
+    foo :: IO ()
+    foo = returnIO ()
+Then we can eta-expand do
+    foo = (\eta. (returnIO () |> sym g) eta) |> g
+where
+    g :: IO () ~ State# RealWorld -> (# State# RealWorld, () #)
+
+But there is really no point in doing this, and it generates masses of
+coercions and whatnot that eventually disappear again. For T9020, GHC
+allocated 6.6G beore, and 0.8G afterwards; and residency dropped from
+1.8G to 45M.
+
+But note that this won't eta-expand, say
+  f = \g -> map g
+Does it matter not eta-expanding such functions?  I'm not sure.  Perhaps
+strictness analysis will have less to bite on?
+
 
 %************************************************************************
 %*                                                                      *
@@ -1553,10 +1588,12 @@ combineIdenticalAlts case_bndr ((_con1,bndrs1,rhs1) : con_alts)
   | all isDeadBinder bndrs1                     -- Remember the default
   , length filtered_alts < length con_alts      -- alternative comes first
   = do  { tick (AltMerge case_bndr)
-        ; return ((DEFAULT, [], rhs1) : filtered_alts) }
+        ; return ((DEFAULT, [], mkTicks (concat tickss) rhs1) : filtered_alts) }
   where
-    filtered_alts = filterOut identical_to_alt1 con_alts
-    identical_to_alt1 (_con,bndrs,rhs) = all isDeadBinder bndrs && rhs `cheapEqExpr` rhs1
+    (eliminated_alts, filtered_alts) = partition identical_to_alt1 con_alts
+    cheapEqTicked = cheapEqExpr' tickishFloatable
+    identical_to_alt1 (_con,bndrs,rhs) = all isDeadBinder bndrs && rhs `cheapEqTicked` rhs1
+    tickss = map (fst . stripTicks tickishFloatable . thirdOf3) eliminated_alts
 
 combineIdenticalAlts _ alts = return alts
 \end{code}
@@ -1610,7 +1647,8 @@ mkCase, mkCase1, mkCase2
 
 mkCase dflags scrut outer_bndr alts_ty ((DEFAULT, _, deflt_rhs) : outer_alts)
   | gopt Opt_CaseMerge dflags
-  , Case (Var inner_scrut_var) inner_bndr _ inner_alts <- deflt_rhs
+  , (ticks, Case (Var inner_scrut_var) inner_bndr _ inner_alts)
+       <- stripTicksTop tickishFloatable deflt_rhs
   , inner_scrut_var == outer_bndr
   = do  { tick (CaseMerge outer_bndr)
 
@@ -1634,7 +1672,8 @@ mkCase dflags scrut outer_bndr alts_ty ((DEFAULT, _, deflt_rhs) : outer_alts)
                 -- When we merge, we must ensure that e1 takes
                 -- precedence over e2 as the value for A!
 
-        ; mkCase1 dflags scrut outer_bndr alts_ty merged_alts
+        ; fmap (mkTicks ticks) $
+          mkCase1 dflags scrut outer_bndr alts_ty merged_alts
         }
         -- Warning: don't call mkCase recursively!
         -- Firstly, there's no point, because inner alts have already had
@@ -1649,10 +1688,13 @@ mkCase dflags scrut bndr alts_ty alts = mkCase1 dflags scrut bndr alts_ty alts
 --------------------------------------------------
 
 mkCase1 _dflags scrut case_bndr _ alts@((_,_,rhs1) : _)      -- Identity case
-  | all identity_alt alts
+  | all identity_alt alts'
   = do { tick (CaseIdentity case_bndr)
-       ; return (re_cast scrut rhs1) }
+       ; return (mkTicks (concat tickss) $
+                 re_cast scrut rhs1) }
   where
+    tickss = map (fst . stripTicksTop tickishFloatable . thirdOf3) alts
+    alts' = map (third3 (snd . stripTicksTop tickishFloatable)) alts
     identity_alt (con, args, rhs) = check_eq rhs con args
 
     check_eq (Cast rhs co) con args         = not (any (`elemVarSet` tyCoVarsOfCo co) args)
diff --git a/compiler/simplCore/Simplify.lhs b/compiler/simplCore/Simplify.lhs
index 3873ed3c822b..d75a5a06c81f 100644
--- a/compiler/simplCore/Simplify.lhs
+++ b/compiler/simplCore/Simplify.lhs
@@ -4,6 +4,8 @@
 \section[Simplify]{The main module of the simplifier}
 
 \begin{code}
+{-# LANGUAGE CPP #-}
+
 module Simplify ( simplTopBinds, simplExpr ) where
 
 #include "HsVersions.h"
@@ -28,7 +30,7 @@ import DataCon          ( DataCon, dataConWorkId, dataConRepStrictness
 --import TyCon            ( isEnumerationTyCon ) -- temporalily commented out. See #8326
 import CoreMonad        ( Tick(..), SimplifierMode(..) )
 import CoreSyn
-import Demand           ( StrictSig(..), dmdTypeDepth )
+import Demand           ( StrictSig(..), dmdTypeDepth, isStrictDmd )
 import PprCore          ( pprParendExpr, pprCoreExpr )
 import CoreUnfold
 import CoreUtils
@@ -219,9 +221,7 @@ simplTopBinds env0 binds0
                 -- It's rather as if the top-level binders were imported.
                 -- See note [Glomming] in OccurAnal.
         ; env1 <- simplRecBndrs env0 (bindersOfBinds binds0)
-        ; dflags <- getDynFlags
-        ; let dump_flag = dopt Opt_D_verbose_core2core dflags
-        ; env2 <- simpl_binds dump_flag env1 binds0
+        ; env2 <- simpl_binds env1 binds0
         ; freeTick SimplifierDone
         ; return env2 }
   where
@@ -229,16 +229,10 @@ simplTopBinds env0 binds0
         -- they should have their fragile IdInfo zapped (notably occurrence info)
         -- That's why we run down binds and bndrs' simultaneously.
         --
-        -- The dump-flag emits a trace for each top-level binding, which
-        -- helps to locate the tracing for inlining and rule firing
-    simpl_binds :: Bool -> SimplEnv -> [InBind] -> SimplM SimplEnv
-    simpl_binds _    env []           = return env
-    simpl_binds dump env (bind:binds) = do { env' <- trace_bind dump bind $
-                                                     simpl_bind env bind
-                                           ; simpl_binds dump env' binds }
-
-    trace_bind True  bind = pprTrace "SimplBind" (ppr (bindersOf bind))
-    trace_bind False _    = \x -> x
+    simpl_binds :: SimplEnv -> [InBind] -> SimplM SimplEnv
+    simpl_binds env []           = return env
+    simpl_binds env (bind:binds) = do { env' <- simpl_bind env bind
+                                      ; simpl_binds env' binds }
 
     simpl_bind env (Rec pairs)  = simplRecBind      env  TopLevel pairs
     simpl_bind env (NonRec b r) = simplRecOrTopPair env' TopLevel NonRecursive b b' r
@@ -293,12 +287,21 @@ simplRecOrTopPair :: SimplEnv
                   -> SimplM SimplEnv    -- Returns an env that includes the binding
 
 simplRecOrTopPair env top_lvl is_rec old_bndr new_bndr rhs
-  = do dflags <- getDynFlags
-       -- Check for unconditional inline
-       if preInlineUnconditionally dflags env top_lvl old_bndr rhs
+  = do { dflags <- getDynFlags
+       ; trace_bind dflags $
+           if preInlineUnconditionally dflags env top_lvl old_bndr rhs
+                    -- Check for unconditional inline
            then do tick (PreInlineUnconditionally old_bndr)
                    return (extendIdSubst env old_bndr (mkContEx env rhs))
-           else simplLazyBind env top_lvl is_rec old_bndr new_bndr rhs env
+           else simplLazyBind env top_lvl is_rec old_bndr new_bndr rhs env }
+  where
+    trace_bind dflags thing_inside
+      | not (dopt Opt_D_verbose_core2core dflags)
+      = thing_inside
+      | otherwise
+      = pprTrace "SimplBind" (ppr old_bndr) thing_inside
+        -- trace_bind emits a trace for each top-level binding, which
+        -- helps to locate the tracing for inlining and rule firing
 \end{code}
 
 
@@ -323,19 +326,21 @@ simplLazyBind :: SimplEnv
                                         -- The OutId has IdInfo, except arity, unfolding
               -> InExpr -> SimplEnv     -- The RHS and its environment
               -> SimplM SimplEnv
-
+-- Precondition: rhs obeys the let/app invariant
 simplLazyBind env top_lvl is_rec bndr bndr1 rhs rhs_se
   = -- pprTrace "simplLazyBind" ((ppr bndr <+> ppr bndr1) $$ ppr rhs $$ ppr (seIdSubst rhs_se)) $
     do  { let   rhs_env     = rhs_se `setInScope` env
                 (tvs, body) = case collectTyBinders rhs of
                                 (tvs, body) | not_lam body -> (tvs,body)
                                             | otherwise    -> ([], rhs)
-                not_lam (Lam _ _) = False
-                not_lam _         = True
+                not_lam (Lam _ _)  = False
+                not_lam (Tick t e) | not (tickishFloatable t)
+                                   = not_lam e -- eta-reduction could float: ignore
+                not_lam _          = True
                         -- Do not do the "abstract tyyvar" thing if there's
                         -- a lambda inside, because it defeats eta-reduction
                         --    f = /\a. \x. g a x
-                        -- should eta-reduce
+                        -- should eta-reduce.
 
 
         ; (body_env, tvs') <- simplBinders rhs_env tvs
@@ -375,11 +380,12 @@ simplNonRecX :: SimplEnv
              -> InId            -- Old binder
              -> OutExpr         -- Simplified RHS
              -> SimplM SimplEnv
-
+-- Precondition: rhs satisfies the let/app invariant
 simplNonRecX env bndr new_rhs
   | isDeadBinder bndr   -- Not uncommon; e.g. case (a,b) of c { (p,q) -> p }
-  = return env          --               Here c is dead, and we avoid creating
-                        --               the binding c = (a,b)
+  = return env    --  Here c is dead, and we avoid creating
+                  --   the binding c = (a,b)
+
   | Coercion co <- new_rhs
   = return (extendCvSubst env bndr co)
 
@@ -394,6 +400,8 @@ completeNonRecX :: TopLevelFlag -> SimplEnv
                 -> OutId                -- New binder
                 -> OutExpr              -- Simplified RHS
                 -> SimplM SimplEnv
+-- Precondition: rhs satisfies the let/app invariant
+--               See Note [CoreSyn let/app invariant] in CoreSyn
 
 completeNonRecX top_lvl env is_strict old_bndr new_bndr new_rhs
   = do  { (env1, rhs1) <- prepareRhs top_lvl (zapFloats env) new_bndr new_rhs
@@ -483,6 +491,20 @@ prepareRhs top_lvl env0 _ rhs0
                         -- The definition of is_exp should match that in
                         -- OccurAnal.occAnalApp
 
+    go n_val_args env (Tick t rhs)
+        -- We want to be able to float bindings past this
+        -- tick. Non-scoping ticks don't care.
+        | tickishScoped t == NoScope
+        = do { (is_exp, env', rhs') <- go n_val_args env rhs
+             ; return (is_exp, env', Tick t rhs') }
+        -- On the other hand, for scoping ticks we need to be able to
+        -- copy them on the floats, which in turn is only allowed if
+        -- we can obtain non-counting ticks.
+        | not (tickishCounts t) || tickishCanSplit t
+        = do { (is_exp, env', rhs') <- go n_val_args env rhs
+             ; let tickIt (id, expr) = (id, mkTick (mkNoCount t) expr)
+             ; return (is_exp, mapFloats env' tickIt, Tick t rhs') }
+
     go _ env other
         = return (False, env, other)
 \end{code}
@@ -641,7 +663,8 @@ completeBind :: SimplEnv
 -- completeBind may choose to do its work
 --      * by extending the substitution (e.g. let x = y in ...)
 --      * or by adding to the floats in the envt
-
+--
+-- Precondition: rhs obeys the let/app invariant
 completeBind env top_lvl old_bndr new_bndr new_rhs
  | isCoVar old_bndr
  = case new_rhs of
@@ -730,53 +753,51 @@ simplUnfolding :: SimplEnv-> TopLevelFlag
                -> OutExpr
                -> Unfolding -> SimplM Unfolding
 -- Note [Setting the new unfolding]
-simplUnfolding env _ _ _ df@(DFunUnfolding { df_bndrs = bndrs, df_args = args })
-  = do { (env', bndrs') <- simplBinders env bndrs
-       ; args' <- mapM (simplExpr env') args
-       ; return (df { df_bndrs = bndrs', df_args  = args' }) }
-
-simplUnfolding env top_lvl id _
-    (CoreUnfolding { uf_tmpl = expr, uf_arity = arity
-                   , uf_src = src, uf_guidance = guide })
-  | isStableSource src
-  = do { expr' <- simplExpr rule_env expr
-       ; let is_top_lvl = isTopLevel top_lvl
-       ; case guide of
-           UnfWhen sat_ok _    -- Happens for INLINE things
-              -> let guide' = UnfWhen sat_ok (inlineBoringOk expr')
-                     -- Refresh the boring-ok flag, in case expr'
-                     -- has got small. This happens, notably in the inlinings
-                     -- for dfuns for single-method classes; see
-                     -- Note [Single-method classes] in TcInstDcls.
-                     -- A test case is Trac #4138
-                 in return (mkCoreUnfolding src is_top_lvl expr' arity guide')
-                 -- See Note [Top-level flag on inline rules] in CoreUnfold
-
-           _other              -- Happens for INLINABLE things
-              -> let bottoming = isBottomingId id
-                 in bottoming `seq` -- See Note [Force bottoming field]
-                    do dflags <- getDynFlags
-                       return (mkUnfolding dflags src is_top_lvl bottoming expr')
+simplUnfolding env top_lvl id new_rhs unf
+  = case unf of
+      DFunUnfolding { df_bndrs = bndrs, df_con = con, df_args = args }
+        -> do { (env', bndrs') <- simplBinders rule_env bndrs
+              ; args' <- mapM (simplExpr env') args
+              ; return (mkDFunUnfolding bndrs' con args') }
+
+      CoreUnfolding { uf_tmpl = expr, uf_arity = arity
+                    , uf_src = src, uf_guidance = guide }
+        | isStableSource src
+        -> do { expr' <- simplExpr rule_env expr
+              ; case guide of
+                  UnfWhen sat_ok _    -- Happens for INLINE things
+                     -> let guide' = UnfWhen sat_ok (inlineBoringOk expr')
+                        -- Refresh the boring-ok flag, in case expr'
+                        -- has got small. This happens, notably in the inlinings
+                        -- for dfuns for single-method classes; see
+                        -- Note [Single-method classes] in TcInstDcls.
+                        -- A test case is Trac #4138
+                        in return (mkCoreUnfolding src is_top_lvl expr' arity guide')
+                            -- See Note [Top-level flag on inline rules] in CoreUnfold
+
+                  _other              -- Happens for INLINABLE things
+                     -> bottoming `seq` -- See Note [Force bottoming field]
+                        do { dflags <- getDynFlags
+                           ; return (mkUnfolding dflags src is_top_lvl bottoming expr') } }
                 -- If the guidance is UnfIfGoodArgs, this is an INLINABLE
                 -- unfolding, and we need to make sure the guidance is kept up
                 -- to date with respect to any changes in the unfolding.
-       }
+
+      _other -> bottoming `seq`  -- See Note [Force bottoming field]
+                do { dflags <- getDynFlags
+                   ; return (mkUnfolding dflags InlineRhs is_top_lvl bottoming new_rhs) }
+                     -- We make an  unfolding *even for loop-breakers*.
+                     -- Reason: (a) It might be useful to know that they are WHNF
+                     --         (b) In TidyPgm we currently assume that, if we want to
+                     --             expose the unfolding then indeed we *have* an unfolding
+                     --             to expose.  (We could instead use the RHS, but currently
+                     --             we don't.)  The simple thing is always to have one.
   where
+    bottoming = isBottomingId id
+    is_top_lvl = isTopLevel top_lvl
     act      = idInlineActivation id
     rule_env = updMode (updModeForInlineRules act) env
                -- See Note [Simplifying inside InlineRules] in SimplUtils
-
-simplUnfolding _ top_lvl id new_rhs _
-  = let bottoming = isBottomingId id
-    in bottoming `seq`  -- See Note [Force bottoming field]
-       do dflags <- getDynFlags
-          return (mkUnfolding dflags InlineRhs (isTopLevel top_lvl) bottoming new_rhs)
-          -- We make an  unfolding *even for loop-breakers*.
-          -- Reason: (a) It might be useful to know that they are WHNF
-          --         (b) In TidyPgm we currently assume that, if we want to
-          --             expose the unfolding then indeed we *have* an unfolding
-          --             to expose.  (We could instead use the RHS, but currently
-          --             we don't.)  The simple thing is always to have one.
 \end{code}
 
 Note [Force bottoming field]
@@ -1024,58 +1045,50 @@ simplTick env tickish expr cont
 --  | tickishScoped tickish && not (tickishCounts tickish)
 --  = simplExprF env expr (TickIt tickish cont)
 
-  -- For non-scoped ticks, we push the continuation inside the
-  -- tick.  This has the effect of moving the tick to the outside of a
-  -- case or application context, allowing the normal case and
-  -- application optimisations to fire.
-  | not (tickishScoped tickish)
+  -- For unscoped or soft-scoped ticks, we are allowed to float in new
+  -- cost, so we simply push the continuation inside the tick.  This
+  -- has the effect of moving the tick to the outside of a case or
+  -- application context, allowing the normal case and application
+  -- optimisations to fire.
+  | tickish `tickishScopesLike` SoftScope
   = do { (env', expr') <- simplExprF env expr cont
        ; return (env', mkTick tickish expr')
        }
 
-  -- For breakpoints, we cannot do any floating of bindings around the
-  -- tick, because breakpoints cannot be split into tick/scope pairs.
-  | not (tickishCanSplit tickish)
-  = no_floating_past_tick
-
-  | interesting_cont, Just expr' <- push_tick_inside tickish expr
-    -- see Note [case-of-scc-of-case]
+  -- Push tick inside if the context looks like this will allow us to
+  -- do a case-of-case - see Note [case-of-scc-of-case]
+  | interesting_cont, Just expr' <- push_tick_inside
   = simplExprF env expr' cont
 
+  -- We don't want to move the tick, but we might still want to allow
+  -- floats to pass through with appropriate wrapping (or not, see
+  -- wrap_floats below)
+  --- | not (tickishCounts tickish) || tickishCanSplit tickish
+  -- = wrap_floats
+
   | otherwise
-  = no_floating_past_tick -- was: wrap_floats, see below
+  = no_floating_past_tick
 
  where
   interesting_cont = case cont of
                         Select {} -> True
                         _ -> False
 
-  push_tick_inside t expr0
-       = ASSERT(tickishScoped t)
-         case expr0 of
-           Tick t' expr
-              -- scc t (tick t' E)
-              --   Pull the tick to the outside
-              -- This one is important for #5363
-              | not (tickishScoped t')
-                 -> Just (Tick t' (Tick t expr))
-
-              -- scc t (scc t' E)
-              --   Try to push t' into E first, and if that works,
-              --   try to push t in again
-              | Just expr' <- push_tick_inside t' expr
-                 -> push_tick_inside t expr'
-
-              | otherwise -> Nothing
-
-           Case scrut bndr ty alts
-              | not (tickishCanSplit t) -> Nothing
-              | otherwise -> Just (Case (mkTick t scrut) bndr ty alts')
-             where t_scope = mkNoCount t -- drop the tick on the dup'd ones
-                   alts'   = [ (c,bs, mkTick t_scope e) | (c,bs,e) <- alts]
-
-           _other -> Nothing
-    where
+  -- Try to push tick inside a case, see Note [case-of-scc-of-case].
+  push_tick_inside =
+    case expr0 of
+      Case scrut bndr ty alts
+             -> Just $ Case (tickScrut scrut) bndr ty (map tickAlt alts)
+      _other -> Nothing
+   where (ticks, expr0) = stripTicksTop movable (Tick tickish expr)
+         movable t      = not (tickishCounts t) ||
+                          t `tickishScopesLike` NoScope ||
+                          tickishCanSplit t
+         tickScrut e    = foldr mkTick e ticks
+         -- Alternatives get annotated with all ticks that scope in some way,
+         -- but we don't want to count entries.
+         tickAlt (c,bs,e) = (c,bs, foldr mkTick e ts_scope)
+         ts_scope         = map mkNoCount $ filter (not . (`tickishScopesLike` NoScope)) ticks
 
   no_floating_past_tick =
     do { let (inc,outc) = splitCont cont
@@ -1176,6 +1189,8 @@ rebuild env expr cont
       Select _ bndr alts se cont    -> rebuildCase (se `setFloats` env) expr bndr alts cont
       StrictArg info _ cont         -> rebuildCall env (info `addArgTo` expr) cont
       StrictBind b bs body se cont  -> do { env' <- simplNonRecX (se `setFloats` env) b expr
+                                               -- expr satisfies let/app since it started life
+                                               -- in a call to simplNonRecE
                                           ; simplLam env' bs body cont }
       ApplyTo dup_flag arg se cont  -- See Note [Avoid redundant simplification]
         | isSimplified dup_flag     -> rebuild env (App expr arg) cont
@@ -1326,6 +1341,9 @@ simplNonRecE :: SimplEnv
 -- It deals with strict bindings, via the StrictBind continuation,
 -- which may abort the whole process
 --
+-- Precondition: rhs satisfies the let/app invariant
+--               Note [CoreSyn let/app invariant] in CoreSyn
+--
 -- The "body" of the binding comes as a pair of ([InId],InExpr)
 -- representing a lambda; so we recurse back to simplLam
 -- Why?  Because of the binder-occ-info-zapping done before
@@ -1341,22 +1359,21 @@ simplNonRecE env bndr (Type ty_arg, rhs_se) (bndrs, body) cont
 simplNonRecE env bndr (rhs, rhs_se) (bndrs, body) cont
   = do dflags <- getDynFlags
        case () of
-         _
-          | preInlineUnconditionally dflags env NotTopLevel bndr rhs ->
-            do  { tick (PreInlineUnconditionally bndr)
-                ; -- pprTrace "preInlineUncond" (ppr bndr <+> ppr rhs) $
+         _ | preInlineUnconditionally dflags env NotTopLevel bndr rhs
+           -> do { tick (PreInlineUnconditionally bndr)
+                 ; -- pprTrace "preInlineUncond" (ppr bndr <+> ppr rhs) $
                   simplLam (extendIdSubst env bndr (mkContEx rhs_se rhs)) bndrs body cont }
 
-          | isStrictId bndr ->           -- Includes coercions
-            do  { simplExprF (rhs_se `setFloats` env) rhs
-                             (StrictBind bndr bndrs body env cont) }
+           | isStrictId bndr          -- Includes coercions
+           -> simplExprF (rhs_se `setFloats` env) rhs
+                         (StrictBind bndr bndrs body env cont)
 
-          | otherwise ->
-            ASSERT( not (isTyVar bndr) )
-            do  { (env1, bndr1) <- simplNonRecBndr env bndr
-                ; let (env2, bndr2) = addBndrRules env1 bndr bndr1
-                ; env3 <- simplLazyBind env2 NotTopLevel NonRecursive bndr bndr2 rhs rhs_se
-                ; simplLam env3 bndrs body cont }
+           | otherwise
+           -> ASSERT( not (isTyVar bndr) )
+              do { (env1, bndr1) <- simplNonRecBndr env bndr
+                 ; let (env2, bndr2) = addBndrRules env1 bndr bndr1
+                 ; env3 <- simplLazyBind env2 NotTopLevel NonRecursive bndr bndr2 rhs rhs_se
+                 ; simplLam env3 bndrs body cont }
 \end{code}
 
 %************************************************************************
@@ -1699,26 +1716,36 @@ This includes things like (==# a# b#)::Bool so that we simplify
 to just
       x
 This particular example shows up in default methods for
-comparision operations (e.g. in (>=) for Int.Int32)
+comparison operations (e.g. in (>=) for Int.Int32)
 
 Note [Case elimination: lifted case]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-We also make sure that we deal with this very common case,
-where x has a lifted type:
+If a case over a lifted type has a single alternative, and is being used
+as a strict 'let' (all isDeadBinder bndrs), we may want to do this
+transformation:
 
-        case e of
-          x -> ...x...
+    case e of r       ===>   let r = e in ...r...
+      _ -> ...r...
 
-Here we are using the case as a strict let; if x is used only once
-then we want to inline it.  We have to be careful that this doesn't
-make the program terminate when it would have diverged before, so we
-check that
         (a) 'e' is already evaluated (it may so if e is a variable)
-            Specifically we check (exprIsHNF e)
+            Specifically we check (exprIsHNF e).  In this case
+            we can just allocate the WHNF directly with a let.
 or
         (b) 'x' is not used at all and e is ok-for-speculation
+             The ok-for-spec bit checks that we don't lose any
+             exceptions or divergence.
+
+             NB: it'd be *sound* to switch from case to let if the
+             scrutinee was not yet WHNF but was guaranteed to
+             converge; but sticking with case means we won't build a
+             thunk
+
+or
+        (c) 'x' is used strictly in the body, and 'e' is a variable
+            Then we can just substitute 'e' for 'x' in the body.
+            See Note [Eliminating redundant seqs]
 
-For the (b), consider
+For (b), the "not used at all" test is important.  Consider
    case (case a ># b of { True -> (p,q); False -> (q,p) }) of
      r -> blah
 The scrutinee is ok-for-speculation (it looks inside cases), but we do
@@ -1727,33 +1754,42 @@ not want to transform to
    in blah
 because that builds an unnecessary thunk.
 
-Note [Case binder next]
-~~~~~~~~~~~~~~~~~~~~~~~
-If we have
-   case e of f { _ -> f e1 e2 }
-then we can safely do CaseElim.   The main criterion is that the
-case-binder is evaluated *next*.  Previously we just asked that
-the case-binder is used strictly; but that can change
+Note [Eliminating redundant seqs]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+If we have this:
+   case x of r { _ -> ..r.. }
+where 'r' is used strictly in (..r..), the case is effectively a 'seq'
+on 'x', but since 'r' is used strictly anyway, we can safely transform to
+   (...x...)
+
+Note that this can change the error behaviour.  For example, we might
+transform
     case x of { _ -> error "bad" }
     --> error "bad"
-which is very puzzling if 'x' is later bound to (error "good").
-Where the order of evaluation is specified (via seq or case)
-we should respect it.
+which is might be puzzling if 'x' currently lambda-bound, but later gets
+let-bound to (error "good").
+
+Nevertheless, the paper "A semantics for imprecise exceptions" allows
+this transformation. If you want to fix the evaluation order, use
+'pseq'.  See Trac #8900 for an example where the loss of this
+transformation bit us in practice. 
+
 See also Note [Empty case alternatives] in CoreSyn.
 
-So instead we use case_bndr_evald_next to see when f is the *next*
-thing to be eval'd.  This came up when fixing Trac #7542.
-See also Note [Eta reduction of an eval'd function] in CoreUtils.
+Just for reference, the original code (added Jan 13) looked like this:
+     || case_bndr_evald_next rhs
+
+    case_bndr_evald_next :: CoreExpr -> Bool
+      -- See Note [Case binder next]
+    case_bndr_evald_next (Var v)         = v == case_bndr
+    case_bndr_evald_next (Cast e _)      = case_bndr_evald_next e
+    case_bndr_evald_next (App e _)       = case_bndr_evald_next e
+    case_bndr_evald_next (Case e _ _ _)  = case_bndr_evald_next e
+    case_bndr_evald_next _               = False
 
-  For reference, the old code was an extra disjunct in elim_lifted
-       || (strict_case_bndr && scrut_is_var scrut)
-      strict_case_bndr = isStrictDmd (idDemandInfo case_bndr)
-      scrut_is_var (Cast s _) = scrut_is_var s
-      scrut_is_var (Var _)    = True
-      scrut_is_var _          = False
+(This came up when fixing Trac #7542. See also Note [Eta reduction of
+an eval'd function] in CoreUtils.)
 
-      -- True if evaluation of the case_bndr is the next
-      -- thing to be eval'd.  Then dropping the case
 
 Note [Case elimination: unlifted case]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -1849,6 +1885,8 @@ rebuildCase env scrut case_bndr alts cont
   where
     simple_rhs bs rhs = ASSERT( null bs )
                         do { env' <- simplNonRecX env case_bndr scrut
+                               -- scrut is a constructor application,
+                               -- hence satisfies let/app invariant
                            ; simplExprF env' rhs cont }
 
 
@@ -1856,58 +1894,41 @@ rebuildCase env scrut case_bndr alts cont
 --      2. Eliminate the case if scrutinee is evaluated
 --------------------------------------------------
 
-rebuildCase env scrut case_bndr [(_, bndrs, rhs)] cont
+rebuildCase env scrut case_bndr alts@[(_, bndrs, rhs)] cont
   -- See if we can get rid of the case altogether
   -- See Note [Case elimination]
   -- mkCase made sure that if all the alternatives are equal,
   -- then there is now only one (DEFAULT) rhs
- | all isDeadBinder bndrs       -- bndrs are [InId]
-
- , if isUnLiftedType (idType case_bndr)
-   then elim_unlifted        -- Satisfy the let-binding invariant
-   else elim_lifted
-  = do  { -- pprTrace "case elim" (vcat [ppr case_bndr, ppr (exprIsHNF scrut),
-          --                            ppr ok_for_spec,
-          --                            ppr scrut]) $
-          tick (CaseElim case_bndr)
-        ; env' <- simplNonRecX env case_bndr scrut
-          -- If case_bndr is dead, simplNonRecX will discard
-        ; simplExprF env' rhs cont }
-  where
-    elim_lifted   -- See Note [Case elimination: lifted case]
-      = exprIsHNF scrut
-     || (is_plain_seq && ok_for_spec)
-              -- Note: not the same as exprIsHNF
-     || case_bndr_evald_next rhs
-
-    elim_unlifted
-      | is_plain_seq = exprOkForSideEffects scrut
-            -- The entire case is dead, so we can drop it,
-            -- _unless_ the scrutinee has side effects
-      | otherwise    = ok_for_spec
-            -- The case-binder is alive, but we may be able
-            -- turn the case into a let, if the expression is ok-for-spec
-            -- See Note [Case elimination: unlifted case]
-
-    ok_for_spec      = exprOkForSpeculation scrut
-    is_plain_seq     = isDeadBinder case_bndr -- Evaluation *only* for effect
 
-    case_bndr_evald_next :: CoreExpr -> Bool
-      -- See Note [Case binder next]
-    case_bndr_evald_next (Var v)         = v == case_bndr
-    case_bndr_evald_next (Cast e _)      = case_bndr_evald_next e
-    case_bndr_evald_next (App e _)       = case_bndr_evald_next e
-    case_bndr_evald_next (Case e _ _ _)  = case_bndr_evald_next e
-    case_bndr_evald_next _               = False
-      -- Could add a case for Let,
-      -- but I'm worried it could become expensive
-
---------------------------------------------------
---      3. Try seq rules; see Note [User-defined RULES for seq] in MkId
---------------------------------------------------
-
-rebuildCase env scrut case_bndr alts@[(_, bndrs, rhs)] cont
-  | all isDeadBinder (case_bndr : bndrs)  -- So this is just 'seq'
+  -- 2a.  Dropping the case altogether, if
+  --      a) it binds nothing (so it's really just a 'seq')
+  --      b) evaluating the scrutinee has no side effects
+  | is_plain_seq
+  , exprOkForSideEffects scrut
+          -- The entire case is dead, so we can drop it
+          -- if the scrutinee converges without having imperative
+          -- side effects or raising a Haskell exception
+          -- See Note [PrimOp can_fail and has_side_effects] in PrimOp
+   = simplExprF env rhs cont
+
+  -- 2b.  Turn the case into a let, if
+  --      a) it binds only the case-binder
+  --      b) unlifted case: the scrutinee is ok-for-speculation
+  --           lifted case: the scrutinee is in HNF (or will later be demanded)
+  | all_dead_bndrs
+  , if is_unlifted
+    then exprOkForSpeculation scrut  -- See Note [Case elimination: unlifted case]
+    else exprIsHNF scrut             -- See Note [Case elimination: lifted case]
+      || scrut_is_demanded_var scrut
+  = do { tick (CaseElim case_bndr)
+       ; env' <- simplNonRecX env case_bndr scrut
+       ; simplExprF env' rhs cont }
+
+  -- 2c. Try the seq rules if
+  --     a) it binds only the case binder
+  --     b) a rule for seq applies
+  -- See Note [User-defined RULES for seq] in MkId
+  | is_plain_seq
   = do { let rhs' = substExpr (text "rebuild-case") env rhs
              env' = zapSubstEnv env
              out_args = [Type (substTy env (idType case_bndr)),
@@ -1919,6 +1940,17 @@ rebuildCase env scrut case_bndr alts@[(_, bndrs, rhs)] cont
        ; case mb_rule of
            Just (rule_rhs, cont') -> simplExprF env' rule_rhs cont'
            Nothing                -> reallyRebuildCase env scrut case_bndr alts cont }
+  where
+    is_unlifted        = isUnLiftedType (idType case_bndr)
+    all_dead_bndrs     = all isDeadBinder bndrs       -- bndrs are [InId]
+    is_plain_seq       = all_dead_bndrs && isDeadBinder case_bndr -- Evaluation *only* for effect
+
+    scrut_is_demanded_var :: CoreExpr -> Bool
+            -- See Note [Eliminating redundant seqs]
+    scrut_is_demanded_var (Cast s _) = scrut_is_demanded_var s
+    scrut_is_demanded_var (Var _)    = isStrictDmd (idDemandInfo case_bndr)
+    scrut_is_demanded_var _          = False
+
 
 rebuildCase env scrut case_bndr alts cont
   = reallyRebuildCase env scrut case_bndr alts cont
@@ -2255,7 +2287,7 @@ knownCon env scrut dc dc_ty_args dc_args bndr bs rhs cont
              -- it via postInlineUnconditionally.
              -- Nevertheless we must keep it if the case-binder is alive,
              -- because it may be used in the con_app.  See Note [knownCon occ info]
-           ; env'' <- simplNonRecX env' b' arg
+           ; env'' <- simplNonRecX env' b' arg  -- arg satisfies let/app invariant
            ; bind_args env'' bs' args }
 
     bind_args _ _ _ =
diff --git a/compiler/simplStg/SimplStg.lhs b/compiler/simplStg/SimplStg.lhs
index c43b6526b5fc..4d33e3392eb9 100644
--- a/compiler/simplStg/SimplStg.lhs
+++ b/compiler/simplStg/SimplStg.lhs
@@ -4,6 +4,8 @@
 \section[SimplStg]{Driver for simplifying @STG@ programs}
 
 \begin{code}
+{-# LANGUAGE CPP #-}
+
 module SimplStg ( stg2stg ) where
 
 #include "HsVersions.h"
diff --git a/compiler/simplStg/StgStats.lhs b/compiler/simplStg/StgStats.lhs
index 542449546890..9bfe12442f82 100644
--- a/compiler/simplStg/StgStats.lhs
+++ b/compiler/simplStg/StgStats.lhs
@@ -21,6 +21,8 @@ The program gather statistics about
 \end{enumerate}
 
 \begin{code}
+{-# LANGUAGE CPP #-}
+
 module StgStats ( showStgStats ) where
 
 #include "HsVersions.h"
@@ -153,8 +155,7 @@ statExpr (StgApp _ _)     = countOne Applications
 statExpr (StgLit _)       = countOne Literals
 statExpr (StgConApp _ _)  = countOne ConstructorApps
 statExpr (StgOpApp _ _ _) = countOne PrimitiveApps
-statExpr (StgSCC _ _ _ e) = statExpr e
-statExpr (StgTick _ _ e)  = statExpr e
+statExpr (StgTick _ e)    = statExpr e
 
 statExpr (StgLetNoEscape _ _ binds body)
   = statBinding False{-not top-level-} binds    `combineSE`
diff --git a/compiler/simplStg/UnariseStg.lhs b/compiler/simplStg/UnariseStg.lhs
index b1717ad12064..535918ea7bda 100644
--- a/compiler/simplStg/UnariseStg.lhs
+++ b/compiler/simplStg/UnariseStg.lhs
@@ -27,6 +27,8 @@ which is the Arity taking into account any expanded arguments, and corresponds t
 the number of (possibly-void) *registers* arguments will arrive in.
 
 \begin{code}
+{-# LANGUAGE CPP #-}
+
 module UnariseStg (unarise) where
 
 #include "HsVersions.h"
@@ -128,10 +130,8 @@ unariseExpr us rho (StgLetNoEscape live_in_let live_in_bind bind e)
   where 
     (us1, us2) = splitUniqSupply us
 
-unariseExpr us rho (StgSCC cc bump_entry push_cc e)
-  = StgSCC cc bump_entry push_cc (unariseExpr us rho e)
-unariseExpr us rho (StgTick mod tick_n e)
-  = StgTick mod tick_n (unariseExpr us rho e)
+unariseExpr us rho (StgTick tick e)
+  = StgTick tick (unariseExpr us rho e)
 
 ------------------------
 unariseAlts :: UniqSupply -> UnariseEnv -> AltType -> Id -> RepType -> [StgAlt] -> (AltType, [StgAlt])
diff --git a/compiler/specialise/Rules.lhs b/compiler/specialise/Rules.lhs
index b88888c96c93..084fc71f177c 100644
--- a/compiler/specialise/Rules.lhs
+++ b/compiler/specialise/Rules.lhs
@@ -4,6 +4,8 @@
 \section[CoreRules]{Transformation rules}
 
 \begin{code}
+{-# LANGUAGE CPP #-}
+
 -- | Functions for collecting together and applying rewrite rules to a module.
 -- The 'CoreRule' datatype itself is declared elsewhere.
 module Rules (
@@ -33,7 +35,7 @@ import CoreSyn          -- All of it
 import CoreSubst
 import OccurAnal        ( occurAnalyseExpr )
 import CoreFVs          ( exprFreeVars, exprsFreeVars, bindFreeVars, rulesFreeVars )
-import CoreUtils        ( exprType, eqExpr )
+import CoreUtils        ( exprType, eqExpr, mkTick, stripTicksTop )
 import PprCore          ( pprRules )
 import Type             ( Type )
 import TcType           ( tcSplitTyConApp_maybe )
@@ -192,6 +194,8 @@ roughTopName (App f _) = roughTopName f
 roughTopName (Var f)   | isGlobalId f   -- Note [Care with roughTopName]
                        , isDataConWorkId f || idArity f > 0
                        = Just (idName f)
+roughTopName (Tick t e) | tickishFloatable t
+                        = roughTopName e
 roughTopName _ = Nothing
 
 ruleCantMatch :: [Maybe Name] -> [Maybe Name] -> Bool
@@ -474,8 +478,10 @@ matchRule :: DynFlags -> InScopeEnv -> (Activation -> Bool)
 matchRule dflags rule_env _is_active fn args _rough_args
           (BuiltinRule { ru_try = match_fn })
 -- Built-in rules can't be switched off, it seems
-  = case match_fn dflags rule_env fn args of
-        Just expr -> Just expr
+  = let -- See Note [Tick annotations in RULE matching]
+        (tickss, args') = unzip $ map (stripTicksTop tickishFloatable) args
+    in case match_fn dflags rule_env fn args' of
+        Just expr -> Just $ foldr mkTick expr (concat tickss)
         Nothing   -> Nothing
 
 matchRule _ in_scope is_active _ args rough_args
@@ -578,6 +584,9 @@ data RuleMatchEnv
        , rv_unf :: IdUnfoldingFun
        }
 
+rvInScopeEnv :: RuleMatchEnv -> InScopeEnv
+rvInScopeEnv renv = (rnInScopeSet (rv_lcl renv), rv_unf renv)
+
 data RuleSubst = RS { rs_tv_subst :: TvSubstEnv   -- Range is the
                     , rs_id_subst :: IdSubstEnv   --   template variables
                     , rs_binds    :: BindWrapper  -- Floated bindings
@@ -607,6 +616,12 @@ match :: RuleMatchEnv
       -> CoreExpr               -- Target
       -> Maybe RuleSubst
 
+-- We look through certain ticks. See note [Tick annotations in RULE matching]
+match renv subst e1 (Tick t e2)
+  | tickishFloatable t
+  = match renv subst' e1 e2
+  where subst' = subst { rs_binds = rs_binds subst . mkTick t }
+
 -- See the notes with Unify.match, which matches types
 -- Everything is very similar for terms
 
@@ -638,7 +653,8 @@ match renv subst e1 (Var v2)      -- Note [Expanding variables]
         -- because of the not-inRnEnvR
 
 match renv subst e1 (Let bind e2)
-  | okToFloat (rv_lcl renv) (bindFreeVars bind)        -- See Note [Matching lets]
+  | -- pprTrace "match:Let" (vcat [ppr bind, ppr $ okToFloat (rv_lcl renv) (bindFreeVars bind)]) $
+    okToFloat (rv_lcl renv) (bindFreeVars bind)        -- See Note [Matching lets]
   = match (renv { rv_fltR = flt_subst' })
           (subst { rs_binds = rs_binds subst . Let bind'
                  , rs_bndrs = extendVarSetList (rs_bndrs subst) new_bndrs })
@@ -671,30 +687,11 @@ match renv subst (App f1 a1) (App f2 a2)
   = do  { subst' <- match renv subst f1 f2
         ; match renv subst' a1 a2 }
 
-match renv subst (Lam x1 e1) (Lam x2 e2)
-  = match renv' subst e1 e2
-  where
-    renv' = renv { rv_lcl = rnBndr2 (rv_lcl renv) x1 x2
-                 , rv_fltR = delBndr (rv_fltR renv) x2 }
-
--- This rule does eta expansion
---              (\x.M)  ~  N    iff     M  ~  N x
--- It's important that this is *after* the let rule,
--- so that      (\x.M)  ~  (let y = e in \y.N)
--- does the let thing, and then gets the lam/lam rule above
 match renv subst (Lam x1 e1) e2
-  = match renv' subst e1 (App e2 (varToCoreExpr new_x))
-  where
-    (rn_env', new_x) = rnEtaL (rv_lcl renv) x1
-    renv' = renv { rv_lcl = rn_env' }
-
--- Eta expansion the other way
---      M  ~  (\y.N)    iff   M y     ~  N
-match renv subst e1 (Lam x2 e2)
-  = match renv' subst (App e1 (varToCoreExpr new_x)) e2
-  where
-    (rn_env', new_x) = rnEtaR (rv_lcl renv) x2
-    renv' = renv { rv_lcl = rn_env' }
+  | Just (x2, e2) <- exprIsLambda_maybe (rvInScopeEnv renv) e2
+  = let renv' = renv { rv_lcl = rnBndr2 (rv_lcl renv) x1 x2
+                     , rv_fltR = delBndr (rv_fltR renv) x2 }
+    in  match renv' subst e1 e2
 
 match renv subst (Case e1 x1 ty1 alts1) (Case e2 x2 ty2 alts2)
   = do  { subst1 <- match_ty renv subst ty1 ty2
@@ -729,9 +726,28 @@ match_co renv subst (Refl r1 ty1) co
        Refl r2 ty2
          | r1 == r2 -> match_ty renv subst ty1 ty2
        _            -> Nothing
-match_co _ _ co1 _
-  = pprTrace "match_co: needs more cases" (ppr co1) Nothing
-    -- Currently just deals with CoVarCo and Refl
+match_co renv subst (TyConAppCo r1 tc1 cos1) co2
+  = case co2 of
+       TyConAppCo r2 tc2 cos2
+         | r1 == r2 && tc1 == tc2
+         -> match_cos renv subst cos1 cos2
+       _ -> Nothing
+match_co _ _ co1 co2
+  = pprTrace "match_co: needs more cases" (ppr co1 $$ ppr co2) Nothing
+    -- Currently just deals with CoVarCo, TyConAppCo and Refl
+
+match_cos :: RuleMatchEnv
+         -> RuleSubst
+         -> [Coercion]
+         -> [Coercion]
+         -> Maybe RuleSubst
+match_cos renv subst (co1:cos1) (co2:cos2) =
+    case match_co renv subst co1 co2 of
+       Just subst' -> match_cos renv subst' cos1 cos2
+       Nothing -> Nothing
+match_cos _ subst [] [] = Just subst
+match_cos _ _ cos1 cos2 = pprTrace "match_cos: not same length" (ppr cos1 $$ ppr cos2) Nothing
+
 
 -------------
 rnMatchBndr2 :: RuleMatchEnv -> RuleSubst -> Var -> Var -> RuleMatchEnv
@@ -887,10 +903,17 @@ Hence, (a) the guard (not (isLocallyBoundR v2))
 
 Note [Tick annotations in RULE matching]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-We used to look through Notes in both template and expression being
-matched.  This would be incorrect for ticks, which we cannot discard,
-so we do not look through Ticks at all.  cf Note [Notes in call
-patterns] in SpecConstr
+
+We used to unconditionally look through Notes in both template and
+expression being matched. This is actually illegal for counting or
+cost-centre-scoped ticks, because we have no place to put them without
+changing entry counts and/or costs. So now we just fail the match in
+these cases.
+
+On the other hand, where we are allowed to insert new cost into the
+tick scope, we can float them upwards to the rule application site.
+
+cf Note [Notes in call patterns] in SpecConstr
 
 Note [Matching lets]
 ~~~~~~~~~~~~~~~~~~~~
@@ -998,6 +1021,7 @@ at all.
 That is why the 'lookupRnInScope' call in the (Var v2) case of 'match'
 is so important.
 
+
 %************************************************************************
 %*                                                                      *
                    Rule-check the program
diff --git a/compiler/specialise/SpecConstr.lhs b/compiler/specialise/SpecConstr.lhs
index 060c705cda4f..be68b131c557 100644
--- a/compiler/specialise/SpecConstr.lhs
+++ b/compiler/specialise/SpecConstr.lhs
@@ -9,6 +9,8 @@ ToDo [Oct 2013]
 \section[SpecConstr]{Specialise over constructors}
 
 \begin{code}
+{-# LANGUAGE CPP #-}
+
 module SpecConstr(
         specConstrProgram
 #ifdef GHCI
@@ -335,7 +337,7 @@ I wonder if SpecConstr couldn't be extended to handle this? After all,
 lambda is a sort of constructor for functions and perhaps it already
 has most of the necessary machinery?
 
-Furthermore, there's an immediate win, because you don't need to allocate the lamda
+Furthermore, there's an immediate win, because you don't need to allocate the lambda
 at the call site; and if perchance it's called in the recursive call, then you
 may avoid allocating it altogether.  Just like for constructors.
 
@@ -396,16 +398,19 @@ use the calls in the un-specialised RHS as seeds.  We call these
 
 Note [Top-level recursive groups]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-If all the bindings in a top-level recursive group are not exported,
-all the calls are in the rest of the top-level bindings.
-This means we can specialise with those call patterns instead of with the RHSs
-of the recursive group.
+If all the bindings in a top-level recursive group are local (not
+exported), then all the calls are in the rest of the top-level
+bindings.  This means we can specialise with those call patterns
+instead of with the RHSs of the recursive group.
+
+(Question: maybe we should *also* use calls in the rest of the
+top-level bindings as seeds?
 
-To get the call usage information, we work backwards through the top-level bindings
-so we see the usage before we get to the binding of the function.
-Before we can collect the usage though, we go through all the bindings and add them
-to the environment. This is necessary because usage is only tracked for functions
-in the environment.
+To get the call usage information, we work backwards through the
+top-level bindings so we see the usage before we get to the binding of
+the function.  Before we can collect the usage though, we go through
+all the bindings and add them to the environment. This is necessary
+because usage is only tracked for functions in the environment.
 
 The actual seeding of the specialisation is very similar to Note [Local recursive group].
 
@@ -880,7 +885,8 @@ extendCaseBndrs env scrut case_bndr con alt_bndrs
    = (env2, alt_bndrs')
  where
    live_case_bndr = not (isDeadBinder case_bndr)
-   env1 | Var v <- scrut = extendValEnv env v cval
+   env1 | Var v <- snd $ stripTicksTop (const True) scrut
+                         = extendValEnv env v cval
         | otherwise      = env  -- See Note [Add scrutinee to ValueEnv too]
    env2 | live_case_bndr = extendValEnv env1 case_bndr cval
         | otherwise      = env1
@@ -1323,16 +1329,14 @@ scTopBind env usage (Rec prs)
   = do  { (rhs_usgs, rhss')   <- mapAndUnzipM (scExpr env) rhss
         ; return (usage `combineUsage` (combineUsages rhs_usgs), Rec (bndrs `zip` rhss')) }
   | otherwise   -- Do specialisation
-  = do  { (rhs_usgs, rhs_infos) <- mapAndUnzipM (scRecRhs env) (bndrs `zip` rhss)
+  = do  { (rhs_usgs, rhs_infos) <- mapAndUnzipM (scRecRhs env) prs
         -- ; pprTrace "scTopBind" (ppr bndrs $$ ppr (map (lookupVarEnv (scu_calls usage)) bndrs)) (return ())
 
         -- Note [Top-level recursive groups]
-        ; let (usg,rest) = if   all (not . isExportedId) bndrs
-                           then -- pprTrace "scTopBind-T" (ppr bndrs $$ ppr (map (fmap (map snd) . lookupVarEnv (scu_calls usage)) bndrs))
-                                ( usage
-                                , [SI [] 0 (Just us) | us <- rhs_usgs] )
-                           else ( combineUsages rhs_usgs
-                                , [SI [] 0 Nothing   | _  <- rhs_usgs] )
+        ; let (usg,rest) | any isExportedId bndrs  -- Seed from RHSs
+                         = ( combineUsages rhs_usgs, [SI [] 0 Nothing   | _  <- rhs_usgs] )
+                         | otherwise               -- Seed from body only
+                         = ( usage,                  [SI [] 0 (Just us) | us <- rhs_usgs] )
 
         ; (usage', specs) <- specLoop (scForce env force_spec)
                                  (scu_calls usg) rhs_infos nullUsage rest
@@ -1446,11 +1450,6 @@ specialise env bind_calls (RI fn _ arg_bndrs body arg_occs)
   , notNull arg_bndrs           -- Only specialise functions
   , Just all_calls <- lookupVarEnv bind_calls fn
   = do  { (boring_call, pats) <- callsToPats env specs arg_occs all_calls
---      ; pprTrace "specialise" (vcat [ ppr fn <+> text "with" <+> int (length pats) <+> text "good patterns"
---                                      , text "arg_occs" <+> ppr arg_occs
---                                    , text "calls" <+> ppr all_calls
---                                    , text "good pats" <+> ppr pats])  $
---        return ()
 
                 -- Bale out if too many specialisations
         ; let n_pats      = length pats
@@ -1473,12 +1472,25 @@ specialise env bind_calls (RI fn _ arg_bndrs body arg_occs)
 
             _normal_case -> do {
 
-          let spec_env = decreaseSpecCount env n_pats
+--        ; if (not (null pats) || isJust mb_unspec) then
+--            pprTrace "specialise" (vcat [ ppr fn <+> text "with" <+> int (length pats) <+> text "good patterns"
+--                                        , text "mb_unspec" <+> ppr (isJust mb_unspec)
+--                                        , text "arg_occs" <+> ppr arg_occs
+--                                        , text "good pats" <+> ppr pats])  $
+--               return ()
+--          else return ()
+
+        ; let spec_env = decreaseSpecCount env n_pats
         ; (spec_usgs, new_specs) <- mapAndUnzipM (spec_one spec_env fn arg_bndrs body)
                                                  (pats `zip` [spec_count..])
                 -- See Note [Specialise original body]
 
         ; let spec_usg = combineUsages spec_usgs
+
+              -- If there were any boring calls among the seeds (= all_calls), then those
+              -- calls will call the un-specialised function.  So we should use the seeds
+              -- from the _unspecialised_ function's RHS, which are in mb_unspec, by returning
+              -- then in new_usg.
               (new_usg, mb_unspec')
                   = case mb_unspec of
                       Just rhs_usg | boring_call -> (spec_usg `combineUsage` rhs_usg, Nothing)
@@ -1906,6 +1918,10 @@ isValue env (Lam b e)
                   Nothing -> Nothing
   | otherwise = Just LambdaVal
 
+isValue env (Tick t e)
+  | not (tickishIsCode t)
+  = isValue env e
+
 isValue _env expr       -- Maybe it's a constructor application
   | (Var fun, args) <- collectArgs expr
   = case isDataConWorkId_maybe fun of
diff --git a/compiler/specialise/Specialise.lhs b/compiler/specialise/Specialise.lhs
index 3191ae946e79..baa5d1971fe0 100644
--- a/compiler/specialise/Specialise.lhs
+++ b/compiler/specialise/Specialise.lhs
@@ -4,6 +4,8 @@
 \section[Specialise]{Stamping out overloading, and (optionally) polymorphism}
 
 \begin{code}
+{-# LANGUAGE CPP #-}
+
 module Specialise ( specProgram ) where
 
 #include "HsVersions.h"
diff --git a/compiler/stgSyn/CoreToStg.lhs b/compiler/stgSyn/CoreToStg.lhs
index 2c4df6955f9a..ef0599bf2dab 100644
--- a/compiler/stgSyn/CoreToStg.lhs
+++ b/compiler/stgSyn/CoreToStg.lhs
@@ -1,4 +1,6 @@
 \begin{code}
+{-# LANGUAGE BangPatterns, CPP #-}
+
 --
 -- (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
 --
@@ -28,7 +30,6 @@ import DataCon
 import CostCentre       ( noCCS )
 import VarSet
 import VarEnv
-import Maybes           ( maybeToBool )
 import Module
 import Name             ( getOccName, isExternalName, nameOccName )
 import OccName          ( occNameString, occNameFS )
@@ -44,6 +45,7 @@ import ForeignCall
 import Demand           ( isSingleUsed )
 import PrimOp           ( PrimCall(..) )
 
+import Data.Maybe    (isJust)
 import Control.Monad (liftM, ap)
 
 -- Note [Live vs free]
@@ -316,28 +318,9 @@ mkTopStgRhs :: DynFlags -> Module -> FreeVarsInfo
             -> SRT -> Id -> StgBinderInfo -> StgExpr
             -> StgRhs
 
-mkTopStgRhs _ _ rhs_fvs srt _ binder_info (StgLam bndrs body)
-  = StgRhsClosure noCCS binder_info
-                  (getFVs rhs_fvs)
-                  ReEntrant
-                  srt
-                  bndrs body
-
-mkTopStgRhs dflags this_mod _ _ _ _ (StgConApp con args)
-  | not (isDllConApp dflags this_mod con args)  -- Dynamic StgConApps are updatable
-  = StgRhsCon noCCS con args
-
-mkTopStgRhs _ _ rhs_fvs srt bndr binder_info rhs
-  = StgRhsClosure noCCS binder_info
-                  (getFVs rhs_fvs)
-                  (getUpdateFlag bndr)
-                  srt
-                  [] rhs
-
-getUpdateFlag :: Id -> UpdateFlag
-getUpdateFlag bndr
-  = if isSingleUsed (idDemandInfo bndr)
-    then SingleEntry else Updatable
+mkTopStgRhs dflags this_mod = mkStgRhs' con_updateable
+        -- Dynamic StgConApps are updatable
+  where con_updateable con args = isDllConApp dflags this_mod con args
 
 -- ---------------------------------------------------------------------------
 -- Expressions
@@ -363,13 +346,13 @@ coreToStgExpr
 -- should have converted them all to a real core representation.
 coreToStgExpr (Lit (LitInteger {})) = panic "coreToStgExpr: LitInteger"
 coreToStgExpr (Lit l)      = return (StgLit l, emptyFVInfo, emptyVarSet)
-coreToStgExpr (Var v)      = coreToStgApp Nothing v               []
-coreToStgExpr (Coercion _) = coreToStgApp Nothing coercionTokenId []
+coreToStgExpr (Var v)      = coreToStgApp Nothing v               [] []
+coreToStgExpr (Coercion _) = coreToStgApp Nothing coercionTokenId [] []
 
 coreToStgExpr expr@(App _ _)
-  = coreToStgApp Nothing f args
+  = coreToStgApp Nothing f args ticks
   where
-    (f, args) = myCollectArgs expr
+    (f, args, ticks) = myCollectArgs expr
 
 coreToStgExpr expr@(Lam _ _)
   = let
@@ -386,16 +369,15 @@ coreToStgExpr expr@(Lam _ _)
 
     return (result_expr, fvs, escs)
 
-coreToStgExpr (Tick (HpcTick m n) expr)
-  = do (expr2, fvs, escs) <- coreToStgExpr expr
-       return (StgTick m n expr2, fvs, escs)
-
-coreToStgExpr (Tick (ProfNote cc tick push) expr)
-  = do (expr2, fvs, escs) <- coreToStgExpr expr
-       return (StgSCC cc tick push expr2, fvs, escs)
-
-coreToStgExpr (Tick Breakpoint{} _expr)
-  = panic "coreToStgExpr: breakpoint should not happen"
+coreToStgExpr (Tick tick expr)
+  = do !_ <- case tick of
+         HpcTick{}    -> return ()
+         ProfNote{}   -> return ()
+         SourceNote{} -> return ()
+         CoreNote{}   -> return ()
+         Breakpoint{} -> panic "coreToStgExpr: breakpoint should not happen"
+       (expr2, fvs, escs) <- coreToStgExpr expr
+       return (StgTick tick expr2, fvs, escs)
 
 coreToStgExpr (Cast expr _)
   = coreToStgExpr expr
@@ -540,11 +522,12 @@ coreToStgApp
                                         -- with specified update flag
         -> Id                           -- Function
         -> [CoreArg]                    -- Arguments
+        -> [Tickish Id]                 -- Debug ticks
         -> LneM (StgExpr, FreeVarsInfo, EscVarsSet)
 
 
-coreToStgApp _ f args = do
-    (args', args_fvs) <- coreToStgArgs args
+coreToStgApp _ f args ticks = do
+    (args', args_fvs, ticks') <- coreToStgArgs args
     how_bound <- lookupVarLne f
 
     let
@@ -606,17 +589,18 @@ coreToStgApp _ f args = do
                 FCallId call     -> ASSERT( saturated )
                                     StgOpApp (StgFCallOp call (idUnique f)) args' res_ty
 
-                TickBoxOpId {}   -> pprPanic "coreToStg TickBox" $ ppr (f,args')
                 _other           -> StgApp f args'
         fvs = fun_fvs  `unionFVInfo` args_fvs
         vars = fun_escs `unionVarSet` (getFVSet args_fvs)
                                 -- All the free vars of the args are disqualified
                                 -- from being let-no-escaped.
 
+        tapp = foldr StgTick app (ticks ++ ticks')
+
     -- Forcing these fixes a leak in the code generator, noticed while
     -- profiling for trac #4367
     app `seq` fvs `seq` seqVarSet vars `seq` return (
-        app,
+        tapp,
         fvs,
         vars
      )
@@ -628,24 +612,31 @@ coreToStgApp _ f args = do
 -- This is the guy that turns applications into A-normal form
 -- ---------------------------------------------------------------------------
 
-coreToStgArgs :: [CoreArg] -> LneM ([StgArg], FreeVarsInfo)
+coreToStgArgs :: [CoreArg] -> LneM ([StgArg], FreeVarsInfo, [Tickish Id])
 coreToStgArgs []
-  = return ([], emptyFVInfo)
+  = return ([], emptyFVInfo, [])
 
 coreToStgArgs (Type _ : args) = do     -- Type argument
-    (args', fvs) <- coreToStgArgs args
-    return (args', fvs)
+    (args', fvs, ts) <- coreToStgArgs args
+    return (args', fvs, ts)
 
 coreToStgArgs (Coercion _ : args)  -- Coercion argument; replace with place holder
-  = do { (args', fvs) <- coreToStgArgs args
-       ; return (StgVarArg coercionTokenId : args', fvs) }
+  = do { (args', fvs, ts) <- coreToStgArgs args
+       ; return (StgVarArg coercionTokenId : args', fvs, ts) }
+
+coreToStgArgs (Tick t e : args)
+  = ASSERT( not (tickishIsCode t) )
+    do { (args', fvs, ts) <- coreToStgArgs (e : args)
+       ; return (args', fvs, t:ts) }
 
 coreToStgArgs (arg : args) = do         -- Non-type argument
-    (stg_args, args_fvs) <- coreToStgArgs args
+    (stg_args, args_fvs, ticks) <- coreToStgArgs args
     (arg', arg_fvs, _escs) <- coreToStgExpr arg
     let
         fvs = args_fvs `unionFVInfo` arg_fvs
-        stg_arg = case arg' of
+
+        (aticks, arg'') = stripStgTicksTop tickishFloatable arg'
+        stg_arg = case arg'' of
                        StgApp v []      -> StgVarArg v
                        StgConApp con [] -> StgVarArg (dataConWorkId con)
                        StgLit lit       -> StgLitArg lit
@@ -673,7 +664,7 @@ coreToStgArgs (arg : args) = do         -- Non-type argument
         -- We also want to check if a pointer is cast to a non-ptr etc
 
     WARN( bad_args, ptext (sLit "Dangerous-looking argument. Probable cause: bad unsafeCoerce#") $$ ppr arg )
-     return (stg_arg : stg_args, fvs)
+     return (stg_arg : stg_args, fvs, ticks ++ aticks)
 
 
 -- ---------------------------------------------------------------------------
@@ -820,21 +811,31 @@ coreToStgRhs scope_fv_info binders (bndr, rhs) = do
     bndr_info = lookupFVInfo scope_fv_info bndr
 
 mkStgRhs :: FreeVarsInfo -> SRT -> Id -> StgBinderInfo -> StgExpr -> StgRhs
+mkStgRhs = mkStgRhs' con_updateable
+  where con_updateable _ _ = False
 
-mkStgRhs _ _ _ _ (StgConApp con args) = StgRhsCon noCCS con args
-
-mkStgRhs rhs_fvs srt _ binder_info (StgLam bndrs body)
+mkStgRhs' :: (DataCon -> [StgArg] -> Bool)
+            -> FreeVarsInfo -> SRT -> Id -> StgBinderInfo -> StgExpr -> StgRhs
+mkStgRhs' con_updateable rhs_fvs srt bndr binder_info rhs
+  | StgLam bndrs body <- rhs
   = StgRhsClosure noCCS binder_info
-                  (getFVs rhs_fvs)
-                  ReEntrant
-                  srt bndrs body
-
-mkStgRhs rhs_fvs srt bndr binder_info rhs
+                   (getFVs rhs_fvs)
+                   ReEntrant
+                   srt bndrs body
+  | StgConApp con args <- unticked_rhs
+  , not (con_updateable con args)
+  = StgRhsCon noCCS con args
+  | otherwise
   = StgRhsClosure noCCS binder_info
-                  (getFVs rhs_fvs)
-                  upd_flag srt [] rhs
-  where
-     upd_flag = getUpdateFlag bndr
+                   (getFVs rhs_fvs)
+                   upd_flag srt [] rhs
+ where
+
+    (_, unticked_rhs) = stripStgTicksTop (not . tickishIsCode) rhs
+
+    upd_flag | isSingleUsed (idDemandInfo bndr)  = SingleEntry
+             | otherwise                         = Updatable
+
   {-
     SDM: disabled.  Eval/Apply can't handle functions with arity zero very
     well; and making these into simple non-updatable thunks breaks other
@@ -1106,7 +1107,7 @@ minusFVBinder v fv = fv `delVarEnv` v
         -- c.f. CoreFVs.delBinderFV
 
 elementOfFVInfo :: Id -> FreeVarsInfo -> Bool
-elementOfFVInfo id fvs = maybeToBool (lookupVarEnv fvs id)
+elementOfFVInfo id fvs = isJust (lookupVarEnv fvs id)
 
 lookupFVInfo :: FreeVarsInfo -> Id -> StgBinderInfo
 -- Find how the given Id is used.
@@ -1159,26 +1160,23 @@ myCollectBinders expr
   = go [] expr
   where
     go bs (Lam b e)          = go (b:bs) e
-    go bs e@(Tick t e')
-        | tickishIsCode t    = (reverse bs, e)
-        | otherwise          = go bs e'
-        -- Ignore only non-code source annotations
     go bs (Cast e _)         = go bs e
     go bs e                  = (reverse bs, e)
 
-myCollectArgs :: CoreExpr -> (Id, [CoreArg])
+myCollectArgs :: CoreExpr -> (Id, [CoreArg], [Tickish Id])
         -- We assume that we only have variables
         -- in the function position by now
 myCollectArgs expr
-  = go expr []
+  = go expr [] []
   where
-    go (Var v)          as = (v, as)
-    go (App f a) as        = go f (a:as)
-    go (Tick _ _)     _  = pprPanic "CoreToStg.myCollectArgs" (ppr expr)
-    go (Cast e _)       as = go e as
-    go (Lam b e)        as
-       | isTyVar b         = go e as  -- Note [Collect args]
-    go _                _  = pprPanic "CoreToStg.myCollectArgs" (ppr expr)
+    go (Var v)          as ts = (v, as, ts)
+    go (App f a)        as ts = go f (a:as) ts
+    go (Tick t e)       as ts = ASSERT( all isTypeArg as )
+                                go e as (t:ts) -- ticks can appear inside type apps
+    go (Cast e _)       as ts = go e as ts
+    go (Lam b e)        as ts
+       | isTyVar b            = go e as ts -- Note [Collect args]
+    go _                _  _  = pprPanic "CoreToStg.myCollectArgs" (ppr expr)
 
 -- Note [Collect args]
 -- ~~~~~~~~~~~~~~~~~~~
@@ -1190,4 +1188,5 @@ stgArity :: Id -> HowBound -> Arity
 stgArity _ (LetBound _ arity) = arity
 stgArity f ImportBound        = idArity f
 stgArity _ LambdaBound        = 0
+
 \end{code}
diff --git a/compiler/stgSyn/StgLint.lhs b/compiler/stgSyn/StgLint.lhs
index 04349db3dfdf..6adde635eae5 100644
--- a/compiler/stgSyn/StgLint.lhs
+++ b/compiler/stgSyn/StgLint.lhs
@@ -4,6 +4,8 @@
 \section[StgLint]{A ``lint'' pass to check for Stg correctness}
 
 \begin{code}
+{-# LANGUAGE CPP #-}
+
 module StgLint ( lintStgBindings ) where
 
 import StgSyn
@@ -192,7 +194,7 @@ lintStgExpr (StgLetNoEscape _ _ binds body) = do
       addInScopeVars binders $
         lintStgExpr body
 
-lintStgExpr (StgSCC _ _ _ expr) = lintStgExpr expr
+lintStgExpr (StgTick _ expr) = lintStgExpr expr
 
 lintStgExpr (StgCase scrut _ _ bndr _ alts_type alts) = runMaybeT $ do
     _ <- MaybeT $ lintStgExpr scrut
@@ -215,8 +217,6 @@ lintStgExpr (StgCase scrut _ _ bndr _ alts_type alts) = runMaybeT $ do
                   where
                      bad_bndr = mkDefltMsg bndr tc
 
-lintStgExpr e = pprPanic "lintStgExpr" (ppr e)
-
 lintStgAlts :: [StgAlt]
             -> Type               -- Type of scrutinee
             -> LintM (Maybe Type) -- Just ty => type is accurage
diff --git a/compiler/stgSyn/StgSyn.lhs b/compiler/stgSyn/StgSyn.lhs
index 3fa8c68c1618..64840749da16 100644
--- a/compiler/stgSyn/StgSyn.lhs
+++ b/compiler/stgSyn/StgSyn.lhs
@@ -9,6 +9,7 @@ being one that happens to be ideally suited to spineless tagless code
 generation.
 
 \begin{code}
+{-# LANGUAGE CPP #-}
 
 module StgSyn (
         GenStgArg(..),
@@ -37,6 +38,7 @@ module StgSyn (
         stgBindHasCafRefs, stgArgHasCafRefs, stgRhsArity,
         isDllConApp,
         stgArgType,
+        stripStgTicksTop,
 
         pprStgBinding, pprStgBindings,
         pprStgLVs
@@ -45,8 +47,8 @@ module StgSyn (
 #include "HsVersions.h"
 
 import Bitmap
-import CoreSyn     ( AltCon )
-import CostCentre  ( CostCentreStack, CostCentre )
+import CoreSyn     ( AltCon, Tickish )
+import CostCentre  ( CostCentreStack )
 import DataCon
 import DynFlags
 import FastString
@@ -54,7 +56,7 @@ import ForeignCall ( ForeignCall )
 import Id
 import IdInfo      ( mayHaveCafRefs )
 import Literal     ( Literal, literalType )
-import Module
+import Module      ( Module )
 import Outputable
 import Packages    ( isDllName )
 import Platform
@@ -141,6 +143,14 @@ isAddrRep _       = False
 stgArgType :: StgArg -> Type
 stgArgType (StgVarArg v)   = idType v
 stgArgType (StgLitArg lit) = literalType lit
+
+
+-- | Strip ticks of a given type from an STG expression
+stripStgTicksTop :: (Tickish Id -> Bool) -> StgExpr -> ([Tickish Id], StgExpr)
+stripStgTicksTop p = go []
+   where go ts (StgTick t e) | p t = go (t:ts) e
+         go ts other               = (reverse ts, other)
+
 \end{code}
 
 %************************************************************************
@@ -360,34 +370,17 @@ And so the code for let(rec)-things:
 \end{code}
 
 %************************************************************************
-%*                                                                      *
-\subsubsection{@GenStgExpr@: @scc@ expressions}
-%*                                                                      *
-%************************************************************************
-
-For @scc@ expressions we introduce a new STG construct.
-
-\begin{code}
-  | StgSCC
-        CostCentre             -- label of SCC expression
-        !Bool                  -- bump the entry count?
-        !Bool                  -- push the cost centre?
-        (GenStgExpr bndr occ)  -- scc expression
-\end{code}
-
-%************************************************************************
-%*                                                                      *
-\subsubsection{@GenStgExpr@: @hpc@ expressions}
-%*                                                                      *
+%*									*
+\subsubsection{@GenStgExpr@: @hpc@, @scc@ and other debug annotations}
+%*									*
 %************************************************************************
 
 Finally for @hpc@ expressions we introduce a new STG construct.
 
 \begin{code}
   | StgTick
-        Module                 -- the module of the source of this tick
-        Int                    -- tick number
-        (GenStgExpr bndr occ)  -- sub expression
+    (Tickish bndr)
+    (GenStgExpr bndr occ)       -- sub expression
 
 -- END of GenStgExpr
 \end{code}
@@ -737,16 +730,12 @@ pprStgExpr (StgLetNoEscape lvs_whole lvs_rhss bind expr)
                              char ']'])))
                 2 (ppr expr)]
 
-pprStgExpr (StgSCC cc tick push expr)
-  = sep [ hsep [scc, ppr cc], pprStgExpr expr ]
-  where
-    scc | tick && push = ptext (sLit "_scc_")
-        | tick         = ptext (sLit "_tick_")
-        | otherwise    = ptext (sLit "_push_")
+pprStgExpr (StgTick tickish expr)
+  = sdocWithDynFlags $ \dflags ->
+    if gopt Opt_PprShowTicks dflags
+    then sep [ ppr tickish, pprStgExpr expr ]
+    else pprStgExpr expr
 
-pprStgExpr (StgTick m n expr)
-  = sep [ hsep [ptext (sLit "_tick_"),  pprModule m,text (show n)],
-          pprStgExpr expr ]
 
 pprStgExpr (StgCase expr lvs_whole lvs_rhss bndr srt alt_type alts)
   = sep [sep [ptext (sLit "case"),
diff --git a/compiler/stranal/DmdAnal.lhs b/compiler/stranal/DmdAnal.lhs
index e9a7ab488f71..a3b7c0b72ad2 100644
--- a/compiler/stranal/DmdAnal.lhs
+++ b/compiler/stranal/DmdAnal.lhs
@@ -7,15 +7,15 @@
 			-----------------
 
 \begin{code}
-{-# OPTIONS -fno-warn-tabs #-}
+{-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
 
 module DmdAnal ( dmdAnalProgram ) where
 
 #include "HsVersions.h"
 
-import Var		( isTyVar )
 import DynFlags
-import WwLib            ( deepSplitProductType_maybe )
+import WwLib            ( findTypeShape, deepSplitProductType_maybe )
 import Demand	-- All of it
 import CoreSyn
 import Outputable
@@ -26,11 +26,8 @@ import Data.List
 import DataCon
 import Id
 import CoreUtils	( exprIsHNF, exprType, exprIsTrivial )
--- import PprCore	
 import TyCon
-import Type		( eqType )
--- import Pair
--- import Coercion         ( coercionKind )
+import Type
 import FamInstEnv
 import Util
 import Maybes		( isJust )
@@ -118,26 +115,29 @@ dmdAnalStar :: AnalEnv
             -> Demand 	-- This one takes a *Demand*
             -> CoreExpr -> (BothDmdArg, CoreExpr)
 dmdAnalStar env dmd e 
-  | (cd, defer_and_use) <- toCleanDmd dmd
+  | (cd, defer_and_use) <- toCleanDmd dmd (exprType e)
   , (dmd_ty, e')        <- dmdAnal env cd e
   = (postProcessDmdTypeM defer_and_use dmd_ty, e')
 
 -- Main Demand Analsysis machinery
-dmdAnal :: AnalEnv
+dmdAnal, dmdAnal' :: AnalEnv
         -> CleanDemand 	       -- The main one takes a *CleanDemand*
         -> CoreExpr -> (DmdType, CoreExpr)
 
 -- The CleanDemand is always strict and not absent
 --    See Note [Ensure demand is strict]
 
-dmdAnal _ _ (Lit lit)     = (nopDmdType, Lit lit)
-dmdAnal _ _ (Type ty)     = (nopDmdType, Type ty)	-- Doesn't happen, in fact
-dmdAnal _ _ (Coercion co) = (nopDmdType, Coercion co)
+dmdAnal env d e = -- pprTrace "dmdAnal" (ppr d <+> ppr e) $
+                  dmdAnal' env d e
 
-dmdAnal env dmd (Var var)
+dmdAnal' _ _ (Lit lit)     = (nopDmdType, Lit lit)
+dmdAnal' _ _ (Type ty)     = (nopDmdType, Type ty)	-- Doesn't happen, in fact
+dmdAnal' _ _ (Coercion co) = (nopDmdType, Coercion co)
+
+dmdAnal' env dmd (Var var)
   = (dmdTransform env var dmd, Var var)
 
-dmdAnal env dmd (Cast e co)
+dmdAnal' env dmd (Cast e co)
   = (dmd_ty, Cast e' co)
   where
     (dmd_ty, e') = dmdAnal env dmd e
@@ -155,24 +155,24 @@ dmdAnal env dmd (Cast e co)
 	-- a fixpoint.  So revert to a vanilla Eval demand
 -}
 
-dmdAnal env dmd (Tick t e)
+dmdAnal' env dmd (Tick t e)
   = (dmd_ty, Tick t e')
   where
     (dmd_ty, e') = dmdAnal env dmd e
 
-dmdAnal env dmd (App fun (Type ty))
+dmdAnal' env dmd (App fun (Type ty))
   = (fun_ty, App fun' (Type ty))
   where
     (fun_ty, fun') = dmdAnal env dmd fun
 
-dmdAnal sigs dmd (App fun (Coercion co))
+dmdAnal' sigs dmd (App fun (Coercion co))
   = (fun_ty, App fun' (Coercion co))
   where
     (fun_ty, fun') = dmdAnal sigs dmd fun
 
 -- Lots of the other code is there to make this
 -- beautiful, compositional, application rule :-)
-dmdAnal env dmd (App fun arg)	-- Non-type arguments
+dmdAnal' env dmd (App fun arg)	-- Non-type arguments
   = let				-- [Type arg handled above]
         call_dmd          = mkCallDmd dmd
 	(fun_ty, fun') 	  = dmdAnal env call_dmd fun
@@ -190,7 +190,7 @@ dmdAnal env dmd (App fun arg)	-- Non-type arguments
     (res_ty `bothDmdType` arg_ty, App fun' arg')
 
 -- this is an anonymous lambda, since @dmdAnalRhs@ uses @collectBinders@
-dmdAnal env dmd (Lam var body)
+dmdAnal' env dmd (Lam var body)
   | isTyVar var
   = let 
 	(body_ty, body') = dmdAnal env dmd body
@@ -209,7 +209,7 @@ dmdAnal env dmd (Lam var body)
     in
     (postProcessUnsat defer_and_use lam_ty, Lam var' body')
 
-dmdAnal env dmd (Case scrut case_bndr ty [alt@(DataAlt dc, _, _)])
+dmdAnal' env dmd (Case scrut case_bndr ty [alt@(DataAlt dc, _, _)])
   -- Only one alternative with a product constructor
   | let tycon = dataConTyCon dc
   , isProductTyCon tycon 
@@ -267,7 +267,7 @@ dmdAnal env dmd (Case scrut case_bndr ty [alt@(DataAlt dc, _, _)])
 --                                   , text "res_ty" <+> ppr res_ty ]) $
     (res_ty, Case scrut' case_bndr' ty [alt'])
 
-dmdAnal env dmd (Case scrut case_bndr ty alts)
+dmdAnal' env dmd (Case scrut case_bndr ty alts)
   = let      -- Case expression with multiple alternatives
 	(alt_tys, alts')     = mapAndUnzip (dmdAnalAlt env dmd) alts
 	(scrut_ty, scrut')   = dmdAnal env cleanEvalDmd scrut
@@ -281,7 +281,7 @@ dmdAnal env dmd (Case scrut case_bndr ty alts)
 --                                   , text "res_ty" <+> ppr res_ty ]) $
     (res_ty, Case scrut' case_bndr' ty alts')
 
-dmdAnal env dmd (Let (NonRec id rhs) body)
+dmdAnal' env dmd (Let (NonRec id rhs) body)
   = (body_ty2, Let (NonRec id2 annotated_rhs) body')                    
   where
     (sig, lazy_fv, id1, rhs') = dmdAnalRhs NotTopLevel Nothing env id rhs
@@ -306,7 +306,7 @@ dmdAnal env dmd (Let (NonRec id rhs) body)
 	-- the vanilla call demand seem to be due to (b).  So we don't
 	-- bother to re-analyse the RHS.
 
-dmdAnal env dmd (Let (Rec pairs) body)
+dmdAnal' env dmd (Let (Rec pairs) body)
   = let
 	(env', lazy_fv, pairs') = dmdFix NotTopLevel env pairs
 	(body_ty, body')        = dmdAnal env' dmd body
@@ -489,8 +489,7 @@ dmdTransform :: AnalEnv		-- The strictness environment
 
 dmdTransform env var dmd
   | isDataConWorkId var		                 -- Data constructor
-  = dmdTransformDataConSig 
-       (idArity var) (idStrictness var) dmd
+  = dmdTransformDataConSig (idArity var) (idStrictness var) dmd
 
   | gopt Opt_DmdTxDictSel (ae_dflags env),
     Just _ <- isClassOpId_maybe var -- Dictionary component selector
@@ -595,9 +594,18 @@ dmdAnalRhs :: TopLevelFlag
 -- Process the RHS of the binding, add the strictness signature
 -- to the Id, and augment the environment with the signature as well.
 dmdAnalRhs top_lvl rec_flag env id rhs
-  | Just fn <- unpackTrivial rhs   -- See Note [Trivial right-hand sides]
+  | Just fn <- unpackTrivial rhs   -- See Note [Demand analysis for trivial right-hand sides]
   , let fn_str = getStrictness env fn
-  = (fn_str, emptyDmdEnv, set_idStrictness env id fn_str, rhs)
+        fn_fv | isLocalId fn = unitVarEnv fn topDmd
+              | otherwise    = emptyDmdEnv
+        -- Note [Remember to demand the function itself]
+        -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+        -- fn_fv: don't forget to produce a demand for fn itself
+        -- Lacking this caused Trac #9128
+        -- The demand is very conservative (topDmd), but that doesn't
+        -- matter; trivial bindings are usually inlined, so it only 
+        -- kicks in for top-level bindings and NOINLINE bindings
+  = (fn_str, fn_fv, set_idStrictness env id fn_str, rhs)
 
   | otherwise
   = (sig_ty, lazy_fv, id', mkLams bndrs' body')
@@ -640,7 +648,7 @@ dmdAnalRhs top_lvl rec_flag env id rhs
 unpackTrivial :: CoreExpr -> Maybe Id
 -- Returns (Just v) if the arg is really equal to v, modulo
 -- casts, type applications etc 
--- See Note [Trivial right-hand sides]
+-- See Note [Demand analysis for trivial right-hand sides]
 unpackTrivial (Var v)                 = Just v
 unpackTrivial (Cast e _)              = unpackTrivial e
 unpackTrivial (Lam v e) | isTyVar v   = unpackTrivial e
@@ -648,15 +656,23 @@ unpackTrivial (App e a) | isTypeArg a = unpackTrivial e
 unpackTrivial _                       = Nothing
 \end{code}
 
-Note [Trivial right-hand sides]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Note [Demand analysis for trivial right-hand sides]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 Consider
 	foo = plusInt |> co
 where plusInt is an arity-2 function with known strictness.  Clearly
 we want plusInt's strictness to propagate to foo!  But because it has
-no manifest lambdas, it won't do so automatically.  So we have a 
+no manifest lambdas, it won't do so automatically, and indeed 'co' might
+have type (Int->Int->Int) ~ T, so we *can't* eta-expand.  So we have a
 special case for right-hand sides that are "trivial", namely variables,
-casts, type applications, and the like. 
+casts, type applications, and the like.
+
+Note that this can mean that 'foo' has an arity that is smaller than that
+indicated by its demand info.  e.g. if co :: (Int->Int->Int) ~ T, then
+foo's arity will be zero (see Note [exprArity invariant] in CoreArity),
+but its demand signature will be that of plusInt. A small example is the
+test case of Trac #8963.
+
 
 Note [Product demands for function body]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -725,9 +741,8 @@ addLazyFVs dmd_ty lazy_fvs
 	-- call to f.  So we just get an L demand for x for g.
 \end{code}
 
-Note [do not strictify the argument dictionaries of a dfun]
+Note [Do not strictify the argument dictionaries of a dfun]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
 The typechecker can tie recursive knots involving dfuns, so we do the
 conservative thing and refrain from strictifying a dfun's argument
 dictionaries.
@@ -739,17 +754,10 @@ annotateBndr :: AnalEnv -> DmdType -> Var -> (DmdType, Var)
 -- according to the result demand of the provided demand type
 -- No effect on the argument demands
 annotateBndr env dmd_ty var
-  | isTyVar var = (dmd_ty, var)
-  | otherwise   = (dmd_ty', set_idDemandInfo env var dmd')
+  | isId var  = (dmd_ty', setIdDemandInfo var dmd)
+  | otherwise = (dmd_ty, var)
   where
-    (dmd_ty', dmd) = peelFV dmd_ty var
-
-    dmd' | gopt Opt_DictsStrict (ae_dflags env)
-             -- We never want to strictify a recursive let. At the moment
-             -- annotateBndr is only call for non-recursive lets; if that
-             -- changes, we need a RecFlag parameter and another guard here.
-         = strictifyDictDmd (idType var) dmd
-         | otherwise = dmd
+    (dmd_ty', dmd) = findBndrDmd env False dmd_ty var
 
 annotateBndrs :: AnalEnv -> DmdType -> [Var] -> (DmdType, [Var])
 annotateBndrs env = mapAccumR (annotateBndr env)
@@ -774,7 +782,7 @@ annotateLamIdBndr env arg_of_dfun dmd_ty one_shot id
 -- Only called for Ids
   = ASSERT( isId id )
     -- pprTrace "annLamBndr" (vcat [ppr id, ppr _dmd_ty]) $
-    (final_ty, setOneShotness one_shot (set_idDemandInfo env id dmd'))
+    (final_ty, setOneShotness one_shot (setIdDemandInfo id dmd))
   where
       -- Watch out!  See note [Lambda-bound unfoldings]
     final_ty = case maybeUnfoldingTemplate (idUnfolding id) of
@@ -784,13 +792,7 @@ annotateLamIdBndr env arg_of_dfun dmd_ty one_shot id
                              (unf_ty, _) = dmdAnalStar env dmd unf
 
     main_ty = addDemand dmd dmd_ty'
-    (dmd_ty', dmd) = peelFV dmd_ty id
-
-    dmd' | gopt Opt_DictsStrict (ae_dflags env),
-           -- see Note [do not strictify the argument dictionaries of a dfun]
-           not arg_of_dfun
-         = strictifyDictDmd (idType id) dmd
-         | otherwise = dmd
+    (dmd_ty', dmd) = findBndrDmd env arg_of_dfun dmd_ty id
 
 deleteFVs :: DmdType -> [Var] -> DmdType
 deleteFVs (DmdType fvs dmds res) bndrs
@@ -1076,18 +1078,39 @@ extendSigsWithLam :: AnalEnv -> Id -> AnalEnv
 -- Extend the AnalEnv when we meet a lambda binder
 extendSigsWithLam env id
   | isId id
-  , isStrictDmd (idDemandInfo id) || ae_virgin env  
+  , isStrictDmd (idDemandInfo id) || ae_virgin env
        -- See Note [Optimistic CPR in the "virgin" case]
        -- See Note [Initial CPR for strict binders]
   , Just (dc,_,_,_) <- deepSplitProductType_maybe (ae_fam_envs env) $ idType id
   = extendAnalEnv NotTopLevel env id (cprProdSig (dataConRepArity dc))
 
-  | otherwise 
+  | otherwise
   = env
 
-set_idDemandInfo :: AnalEnv -> Id -> Demand -> Id
-set_idDemandInfo env id dmd 
-  = setIdDemandInfo id (zapDemand (ae_dflags env) dmd)
+findBndrDmd :: AnalEnv -> Bool -> DmdType -> Id -> (DmdType, Demand)
+-- See Note [Trimming a demand to a type] in Demand.lhs
+findBndrDmd env arg_of_dfun dmd_ty id
+  = (dmd_ty', dmd')
+  where
+    dmd' = zapDemand (ae_dflags env) $
+           strictify $
+           trimToType starting_dmd (findTypeShape fam_envs id_ty)
+
+    (dmd_ty', starting_dmd) = peelFV dmd_ty id
+
+    id_ty = idType id
+
+    strictify dmd
+      | gopt Opt_DictsStrict (ae_dflags env)
+             -- We never want to strictify a recursive let. At the moment
+             -- annotateBndr is only call for non-recursive lets; if that
+             -- changes, we need a RecFlag parameter and another guard here.
+      , not arg_of_dfun -- See Note [Do not strictify the argument dictionaries of a dfun]
+      = strictifyDictDmd id_ty dmd
+      | otherwise
+      = dmd
+
+    fam_envs = ae_fam_envs env
 
 set_idStrictness :: AnalEnv -> Id -> StrictSig -> Id
 set_idStrictness env id sig
diff --git a/compiler/stranal/WorkWrap.lhs b/compiler/stranal/WorkWrap.lhs
index f5bc18b69ebe..5b9d0a3083c0 100644
--- a/compiler/stranal/WorkWrap.lhs
+++ b/compiler/stranal/WorkWrap.lhs
@@ -4,7 +4,8 @@
 \section[WorkWrap]{Worker/wrapper-generating back-end of strictness analyser}
 
 \begin{code}
-{-# OPTIONS -fno-warn-tabs #-}
+{-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
 -- The above warning supression flag is a temporary kludge.
 -- While working on this module you are encouraged to remove it and
 -- detab the module (please do the detabbing in a separate patch). See
@@ -259,16 +260,28 @@ tryWW dflags fam_envs is_rec fn_id rhs
 	-- Furthermore, don't even expose strictness info
   = return [ (fn_id, rhs) ]
 
+  | isStableUnfolding (realIdUnfolding fn_id)
+  = return [ (fn_id, rhs) ]
+      -- See Note [Don't w/w INLINE things]
+      -- and Note [Don't w/w INLINABLE things]
+      -- NB: use realIdUnfolding because we want to see the unfolding
+      --     even if it's a loop breaker!
+
+  | certainlyWillInline dflags (idUnfolding fn_id)
+  = let inline_rule = mkInlineUnfolding Nothing rhs
+    in  return [ (fn_id `setIdUnfolding` inline_rule, rhs) ]
+	-- Note [Don't w/w inline small non-loop-breaker things]
+	-- NB: use idUnfolding because we don't want to apply
+	--     this criterion to a loop breaker!
+
+  | is_fun
+  = splitFun dflags fam_envs new_fn_id fn_info wrap_dmds res_info rhs
+
+  | is_thunk                                   -- See Note [Thunk splitting]
+  = splitThunk dflags fam_envs is_rec new_fn_id rhs
+
   | otherwise
-  = do
-    let doSplit | is_fun    = splitFun dflags fam_envs new_fn_id fn_info wrap_dmds res_info rhs
-                | is_thunk  = splitThunk dflags fam_envs is_rec new_fn_id rhs
-	                                        -- See Note [Thunk splitting]
-                | otherwise = return Nothing
-    try <- doSplit
-    case try of
-        Nothing ->    return $ [ (new_fn_id, rhs) ]
-        Just binds -> checkSize dflags new_fn_id rhs binds
+  = return [ (new_fn_id, rhs) ]
 
   where
     fn_info	 = idInfo fn_id
@@ -291,29 +304,10 @@ tryWW dflags fam_envs is_rec fn_id rhs
     is_fun    = notNull wrap_dmds
     is_thunk  = not is_fun && not (exprIsHNF rhs)
 
----------------------
-checkSize :: DynFlags -> Id -> CoreExpr -> [(Id,CoreExpr)] -> UniqSM [(Id,CoreExpr)]
-checkSize dflags fn_id rhs thing_inside
-  | isStableUnfolding (realIdUnfolding fn_id)
-  = return [ (fn_id, rhs) ]
-      -- See Note [Don't w/w INLINE things]
-      -- and Note [Don't w/w INLINABLE things]
-      -- NB: use realIdUnfolding because we want to see the unfolding
-      --     even if it's a loop breaker!
-
-  | certainlyWillInline dflags (idUnfolding fn_id)
-  = return [ (fn_id `setIdUnfolding` inline_rule, rhs) ]
-	-- Note [Don't w/w inline small non-loop-breaker things]
-	-- NB: use idUnfolding because we don't want to apply
-	--     this criterion to a loop breaker!
-
-  | otherwise = return thing_inside
-  where
-    inline_rule = mkInlineUnfolding Nothing rhs
 
 ---------------------
 splitFun :: DynFlags -> FamInstEnvs -> Id -> IdInfo -> [Demand] -> DmdResult -> CoreExpr
-         -> UniqSM (Maybe [(Id, CoreExpr)])
+         -> UniqSM [(Id, CoreExpr)]
 splitFun dflags fam_envs fn_id fn_info wrap_dmds res_info rhs
   = WARN( not (wrap_dmds `lengthIs` arity), ppr fn_id <+> (ppr arity $$ ppr wrap_dmds $$ ppr res_info) ) do
     -- The arity should match the signature
@@ -361,12 +355,11 @@ splitFun dflags fam_envs fn_id fn_info wrap_dmds res_info rhs
 		              `setIdOccInfo` NoOccInfo
 			        -- Zap any loop-breaker-ness, to avoid bleating from Lint
 				-- about a loop breaker with an INLINE rule
-        return $ Just [(work_id, work_rhs), (wrap_id, wrap_rhs)]
+        return $ [(work_id, work_rhs), (wrap_id, wrap_rhs)]
             -- Worker first, because wrapper mentions it
             -- mkWwBodies has already built a wrap_rhs with an INLINE pragma wrapped around it
 
-      Nothing ->
-        return Nothing
+      Nothing -> return [(fn_id, rhs)]
   where
     fun_ty          = idType fn_id
     inl_prag        = inlinePragInfo fn_info
@@ -452,11 +445,11 @@ then the splitting will go deeper too.
 --     -->  x = let x = e in
 --              case x of (a,b) -> let x = (a,b)  in x
 
-splitThunk :: DynFlags -> FamInstEnvs -> RecFlag -> Var -> Expr Var -> UniqSM (Maybe [(Var, Expr Var)])
-splitThunk dflags fam_envs is_rec fn_id rhs = do
-    (useful,_, wrap_fn, work_fn) <- mkWWstr dflags fam_envs [fn_id]
-    let res = [ (fn_id, Let (NonRec fn_id rhs) (wrap_fn (work_fn (Var fn_id)))) ]
-    if useful then ASSERT2( isNonRec is_rec, ppr fn_id ) -- The thunk must be non-recursive
-                   return (Just res)
-              else return Nothing
+splitThunk :: DynFlags -> FamInstEnvs -> RecFlag -> Var -> Expr Var -> UniqSM [(Var, Expr Var)]
+splitThunk dflags fam_envs is_rec fn_id rhs
+  = do { (useful,_, wrap_fn, work_fn) <- mkWWstr dflags fam_envs [fn_id]
+       ; let res = [ (fn_id, Let (NonRec fn_id rhs) (wrap_fn (work_fn (Var fn_id)))) ]
+       ; if useful then ASSERT2( isNonRec is_rec, ppr fn_id ) -- The thunk must be non-recursive
+                   return res
+                   else return [(fn_id, rhs)] }
 \end{code}
diff --git a/compiler/stranal/WwLib.lhs b/compiler/stranal/WwLib.lhs
index 57937d696f45..7a9845b3d717 100644
--- a/compiler/stranal/WwLib.lhs
+++ b/compiler/stranal/WwLib.lhs
@@ -4,7 +4,11 @@
 \section[WwLib]{A library for the ``worker\/wrapper'' back-end to the strictness analyser}
 
 \begin{code}
-module WwLib ( mkWwBodies, mkWWstr, mkWorkerArgs, deepSplitProductType_maybe ) where
+{-# LANGUAGE CPP #-}
+
+module WwLib ( mkWwBodies, mkWWstr, mkWorkerArgs
+             , deepSplitProductType_maybe, findTypeShape
+ ) where
 
 #include "HsVersions.h"
 
@@ -506,6 +510,12 @@ match the number of constructor arguments; this happened in Trac #8037.
 If so, the worker/wrapper split doesn't work right and we get a Core Lint
 bug.  The fix here is simply to decline to do w/w if that happens.
 
+%************************************************************************
+%*                                                                      *
+         Type scrutiny that is specfic to demand analysis
+%*                                                                      *
+%************************************************************************
+
 \begin{code}
 deepSplitProductType_maybe :: FamInstEnvs -> Type -> Maybe (DataCon, [Type], [Type], Coercion)
 -- If    deepSplitProductType_maybe ty = Just (dc, tys, arg_tys, co)
@@ -529,9 +539,32 @@ deepSplitCprType_maybe fam_envs con_tag ty
   , Just (tc, tc_args) <- splitTyConApp_maybe ty1
   , isDataTyCon tc
   , let cons = tyConDataCons tc
-        con = ASSERT( cons `lengthAtLeast` con_tag ) cons !! (con_tag - fIRST_TAG)
+  , cons `lengthAtLeast` con_tag -- This might not be true if we import the
+                                 -- type constructor via a .hs-bool file (#8743)
+  , let con  = cons !! (con_tag - fIRST_TAG)
   = Just (con, tc_args, dataConInstArgTys con tc_args, co)
 deepSplitCprType_maybe _ _ _ = Nothing
+
+findTypeShape :: FamInstEnvs -> Type -> TypeShape
+-- Uncover the arrow and product shape of a type
+-- The data type TypeShape is defined in Demand
+-- See Note [Trimming a demand to a type] in Demand
+findTypeShape fam_envs ty
+  | Just (_, ty') <- splitForAllTy_maybe ty
+  = findTypeShape fam_envs ty'
+
+  | Just (tc, tc_args)  <- splitTyConApp_maybe ty
+  , Just con <- isDataProductTyCon_maybe tc
+  = TsProd (map (findTypeShape fam_envs) $ dataConInstArgTys con tc_args)
+
+  | Just (_, res) <- splitFunTy_maybe ty
+  = TsFun (findTypeShape fam_envs res)
+
+  | Just (_, ty') <- topNormaliseType_maybe fam_envs ty
+  = findTypeShape fam_envs ty'
+
+  | otherwise
+  = TsUnk
 \end{code}
 
 
@@ -701,7 +734,7 @@ mk_absent_let dflags arg
   where
     arg_ty  = idType arg
     abs_rhs = mkRuntimeErrorApp aBSENT_ERROR_ID arg_ty msg
-    msg     = showSDocDebug dflags (ppr arg <+> ppr (idType arg))
+    msg     = showSDoc dflags (ppr arg <+> ppr (idType arg))
 
 mk_seq_case :: Id -> CoreExpr -> CoreExpr
 mk_seq_case arg body = Case (Var arg) (sanitiseCaseBndr arg) (exprType body) [(DEFAULT, [], body)]
diff --git a/compiler/typecheck/FamInst.lhs b/compiler/typecheck/FamInst.lhs
index 88212415c44b..d0b2d0da5a9c 100644
--- a/compiler/typecheck/FamInst.lhs
+++ b/compiler/typecheck/FamInst.lhs
@@ -1,8 +1,8 @@
 The @FamInst@ type: family instance heads
 
 \begin{code}
-{-# LANGUAGE GADTs #-}
-{-# OPTIONS -fno-warn-tabs #-}
+{-# LANGUAGE CPP, GADTs #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
 -- The above warning supression flag is a temporary kludge.
 -- While working on this module you are encouraged to remove it and
 -- detab the module (please do the detabbing in a separate patch). See
@@ -60,7 +60,7 @@ newFamInst :: FamFlavor -> CoAxiom Unbranched -> TcRnIf gbl lcl FamInst
 -- Called from the vectoriser monad too, hence the rather general type
 newFamInst flavor axiom@(CoAxiom { co_ax_branches = FirstBranch branch
                                  , co_ax_tc = fam_tc })
-  = do { (subst, tvs') <- tcInstSkolTyVarsLoc loc tvs
+  = do { (subst, tvs') <- tcInstSigTyVarsLoc loc tvs
        ; return (FamInst { fi_fam      = fam_tc_name
                          , fi_flavor   = flavor
                          , fi_tcs      = roughMatchTcs lhs
@@ -217,9 +217,12 @@ tcLookupFamInst tycon tys
   | otherwise
   = do { instEnv <- tcGetFamInstEnvs
        ; let mb_match = lookupFamInstEnv instEnv tycon tys 
-       ; traceTc "lookupFamInst" ((ppr tycon <+> ppr tys) $$ 
-                                  pprTvBndrs (varSetElems (tyVarsOfTypes tys)) $$ 
-                                  ppr mb_match $$ ppr instEnv)
+       ; traceTc "lookupFamInst" $
+         vcat [ ppr tycon <+> ppr tys
+              , pprTvBndrs (varSetElems (tyVarsOfTypes tys))
+              , ppr mb_match
+              -- , ppr instEnv
+         ]
        ; case mb_match of
 	   [] -> return Nothing
 	   (match:_) 
@@ -297,8 +300,11 @@ checkForConflicts :: FamInstEnvs -> FamInst -> TcM Bool
 checkForConflicts inst_envs fam_inst
   = do { let conflicts = lookupFamInstEnvConflicts inst_envs fam_inst
              no_conflicts = null conflicts
-       ; traceTc "checkForConflicts" (ppr (map fim_instance conflicts) $$
-                                      ppr fam_inst $$ ppr inst_envs)
+       ; traceTc "checkForConflicts" $
+         vcat [ ppr (map fim_instance conflicts)
+              , ppr fam_inst
+              -- , ppr inst_envs
+         ]
        ; unless no_conflicts $ conflictInstErr fam_inst conflicts
        ; return no_conflicts }
 
diff --git a/compiler/typecheck/FunDeps.lhs b/compiler/typecheck/FunDeps.lhs
index 1dc96aa03721..5cfd22664ac4 100644
--- a/compiler/typecheck/FunDeps.lhs
+++ b/compiler/typecheck/FunDeps.lhs
@@ -8,6 +8,8 @@ FunDeps - functional dependencies
 It's better to read it as: "if we know these, then we're going to know these"
 
 \begin{code}
+{-# LANGUAGE CPP #-}
+
 module FunDeps (
         FDEq (..),
         Equation(..), pprEquation,
@@ -26,8 +28,8 @@ import Unify
 import InstEnv
 import VarSet
 import VarEnv
-import Maybes( firstJusts )
 import Outputable
+import ErrUtils( Validity(..), allValid )
 import Util
 import FastString
 
@@ -415,7 +417,7 @@ makes instance inference go into a loop, because it requires the constraint
 \begin{code}
 checkInstCoverage :: Bool   -- Be liberal
                   -> Class -> [PredType] -> [Type]
-                  -> Maybe SDoc
+                  -> Validity
 -- "be_liberal" flag says whether to use "liberal" coverage of
 --              See Note [Coverage Condition] below
 --
@@ -424,14 +426,14 @@ checkInstCoverage :: Bool   -- Be liberal
 --    Just msg => coverage problem described by msg
 
 checkInstCoverage be_liberal clas theta inst_taus
-  = firstJusts (map fundep_ok fds)
+  = allValid (map fundep_ok fds)
   where
     (tyvars, fds) = classTvsFds clas
     fundep_ok fd
        | if be_liberal then liberal_ok else conservative_ok
-       = Nothing
+       = IsValid
        | otherwise
-       = Just msg
+       = NotValid msg
        where
          (ls,rs) = instFD fd tyvars inst_taus
          ls_tvs = closeOverKinds (tyVarsOfTypes ls)  -- See Note [Closing over kinds in coverage]
@@ -559,7 +561,7 @@ if s1 matches
 \begin{code}
 checkFunDeps :: (InstEnv, InstEnv) -> ClsInst
              -> Maybe [ClsInst] -- Nothing  <=> ok
-                                        -- Just dfs <=> conflict with dfs
+                                -- Just dfs <=> conflict with dfs
 -- Check wheher adding DFunId would break functional-dependency constraints
 -- Used only for instance decls defined in the module being compiled
 checkFunDeps inst_envs ispec
diff --git a/compiler/typecheck/Inst.lhs b/compiler/typecheck/Inst.lhs
index e934984383a2..a27c0bd0f600 100644
--- a/compiler/typecheck/Inst.lhs
+++ b/compiler/typecheck/Inst.lhs
@@ -6,7 +6,8 @@
 The @Inst@ type: dictionaries or method instances
 
 \begin{code}
-{-# OPTIONS -fno-warn-tabs #-}
+{-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
 -- The above warning supression flag is a temporary kludge.
 -- While working on this module you are encouraged to remove it and
 -- detab the module (please do the detabbing in a separate patch). See
@@ -48,7 +49,6 @@ import TcMType
 import Type
 import Coercion ( Role(..) )
 import TcType
-import Unify
 import HscTypes
 import Id
 import Name
@@ -59,9 +59,9 @@ import PrelNames
 import SrcLoc
 import DynFlags
 import Bag
-import Maybes
 import Util
 import Outputable
+import Control.Monad( unless )
 import Data.List( mapAccumL )
 \end{code}
 
@@ -382,14 +382,15 @@ syntaxNameCtxt name orig ty tidy_env
 
 \begin{code}
 getOverlapFlag :: TcM OverlapFlag
-getOverlapFlag 
+getOverlapFlag
   = do  { dflags <- getDynFlags
         ; let overlap_ok    = xopt Opt_OverlappingInstances dflags
               incoherent_ok = xopt Opt_IncoherentInstances  dflags
-              safeOverlap   = safeLanguageOn dflags
-              overlap_flag | incoherent_ok = Incoherent safeOverlap
-                           | overlap_ok    = OverlapOk safeOverlap
-                           | otherwise     = NoOverlap safeOverlap
+              use x = OverlapFlag { isSafeOverlap = safeLanguageOn dflags
+                                  , overlapMode   = x }
+              overlap_flag | incoherent_ok = use Incoherent
+                           | overlap_ok    = use Overlaps
+                           | otherwise     = use NoOverlap
 
         ; return overlap_flag }
 
@@ -408,22 +409,24 @@ tcExtendLocalInstEnv :: [ClsInst] -> TcM a -> TcM a
 tcExtendLocalInstEnv dfuns thing_inside
  = do { traceDFuns dfuns
       ; env <- getGblEnv
-      ; inst_env' <- foldlM addLocalInst (tcg_inst_env env) dfuns
-      ; let env' = env { tcg_insts = dfuns ++ tcg_insts env,
-			 tcg_inst_env = inst_env' }
+      ; (inst_env', cls_insts') <- foldlM addLocalInst
+                                          (tcg_inst_env env, tcg_insts env)
+                                          dfuns
+      ; let env' = env { tcg_insts    = cls_insts'
+		       , tcg_inst_env = inst_env' }
       ; setGblEnv env' thing_inside }
 
-addLocalInst :: InstEnv -> ClsInst -> TcM InstEnv
--- Check that the proposed new instance is OK, 
+addLocalInst :: (InstEnv, [ClsInst]) -> ClsInst -> TcM (InstEnv, [ClsInst])
+-- Check that the proposed new instance is OK,
 -- and then add it to the home inst env
 -- If overwrite_inst, then we can overwrite a direct match
-addLocalInst home_ie ispec
+addLocalInst (home_ie, my_insts) ispec
    = do {
          -- Instantiate the dfun type so that we extend the instance
          -- envt with completely fresh template variables
          -- This is important because the template variables must
          -- not overlap with anything in the things being looked up
-         -- (since we do unification).  
+         -- (since we do unification).
              --
              -- We use tcInstSkolType because we don't want to allocate fresh
              --  *meta* type variables.
@@ -436,9 +439,23 @@ addLocalInst home_ie ispec
 
              -- Load imported instances, so that we report
              -- duplicates correctly
-           eps <- getEps
-         ; let inst_envs = (eps_inst_env eps, home_ie)
-               (tvs, cls, tys) = instanceHead ispec
+
+             -- 'matches'  are existing instance declarations that are less
+             --            specific than the new one
+             -- 'dups'     are those 'matches' that are equal to the new one
+         ; isGHCi <- getIsGHCi
+         ; eps    <- getEps
+         ; let (home_ie', my_insts')
+                 | isGHCi    = ( deleteFromInstEnv home_ie ispec
+                               , filterOut (identicalInstHead ispec) my_insts)
+                 | otherwise = (home_ie, my_insts)
+               -- If there is a home-package duplicate instance,
+               -- silently delete it
+
+               (_tvs, cls, tys) = instanceHead ispec
+               inst_envs       = (eps_inst_env eps, home_ie')
+               (matches, _, _) = lookupInstEnv inst_envs cls tys
+               dups            = filter (identicalInstHead ispec) (map fst matches)
 
              -- Check functional dependencies
          ; case checkFunDeps inst_envs ispec of
@@ -446,37 +463,17 @@ addLocalInst home_ie ispec
              Nothing    -> return ()
 
              -- Check for duplicate instance decls
-         ; let (matches, unifs, _) = lookupInstEnv inst_envs cls tys
-               dup_ispecs = [ dup_ispec 
-                            | (dup_ispec, _) <- matches
-                            , let dup_tys = is_tys dup_ispec
-                            , isJust (tcMatchTys (mkVarSet tvs) tys dup_tys)]
-                             
-             -- Find memebers of the match list which ispec itself matches.
-             -- If the match is 2-way, it's a duplicate
-             -- If it's a duplicate, but we can overwrite home package dups, then overwrite
-         ; isGHCi <- getIsGHCi
-         ; overlapFlag <- getOverlapFlag
-         ; case isGHCi of
-             False -> case dup_ispecs of
-                 dup : _ -> dupInstErr ispec dup >> return (extendInstEnv home_ie ispec)
-                 []      -> return (extendInstEnv home_ie ispec)
-             True  -> case (dup_ispecs, home_ie_matches, unifs, overlapFlag) of
-                 (_, _:_, _, _)      -> return (overwriteInstEnv home_ie ispec)
-                 (dup:_, [], _, _)   -> dupInstErr ispec dup >> return (extendInstEnv home_ie ispec)
-                 ([], _, u:_, NoOverlap _)    -> overlappingInstErr ispec u >> return (extendInstEnv home_ie ispec)
-                 _                   -> return (extendInstEnv home_ie ispec)
-               where (homematches, _) = lookupInstEnv' home_ie cls tys
-                     home_ie_matches = [ dup_ispec 
-                         | (dup_ispec, _) <- homematches
-                         , let dup_tys = is_tys dup_ispec
-                         , isJust (tcMatchTys (mkVarSet tvs) tys dup_tys)] }
+         ; unless (null dups) $
+           dupInstErr ispec (head dups)
+
+         ; return (extendInstEnv home_ie' ispec, ispec:my_insts') }
 
 traceDFuns :: [ClsInst] -> TcRn ()
 traceDFuns ispecs
   = traceTc "Adding instances:" (vcat (map pp ispecs))
   where
-    pp ispec = ppr (instanceDFunId ispec) <+> colon <+> ppr ispec
+    pp ispec = hang (ppr (instanceDFunId ispec) <+> colon)
+                  2 (ppr ispec)
 	-- Print the dfun name itself too
 
 funDepErr :: ClsInst -> [ClsInst] -> TcRn ()
@@ -489,11 +486,6 @@ dupInstErr ispec dup_ispec
   = addClsInstsErr (ptext (sLit "Duplicate instance declarations:"))
 	            [ispec, dup_ispec]
 
-overlappingInstErr :: ClsInst -> ClsInst -> TcRn ()
-overlappingInstErr ispec dup_ispec
-  = addClsInstsErr (ptext (sLit "Overlapping instance declarations:")) 
-                    [ispec, dup_ispec]
-
 addClsInstsErr :: SDoc -> [ClsInst] -> TcRn ()
 addClsInstsErr herald ispecs
   = setSrcSpan (getSrcSpan (head sorted)) $
diff --git a/compiler/typecheck/TcAnnotations.lhs b/compiler/typecheck/TcAnnotations.lhs
index e12552f419b8..cbd19cf8f33f 100644
--- a/compiler/typecheck/TcAnnotations.lhs
+++ b/compiler/typecheck/TcAnnotations.lhs
@@ -5,6 +5,8 @@
 \section[TcAnnotations]{Typechecking annotations}
 
 \begin{code}
+{-# LANGUAGE CPP #-}
+
 module TcAnnotations ( tcAnnotations, annCtxt ) where
 
 #ifdef GHCI
diff --git a/compiler/typecheck/TcArrows.lhs b/compiler/typecheck/TcArrows.lhs
index b427dd5409eb..eab894195666 100644
--- a/compiler/typecheck/TcArrows.lhs
+++ b/compiler/typecheck/TcArrows.lhs
@@ -5,16 +5,11 @@
 Typecheck arrow notation
 
 \begin{code}
-{-# OPTIONS -fno-warn-tabs #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and
--- detab the module (please do the detabbing in a separate patch). See
---     http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
--- for details
+{-# LANGUAGE RankNTypes #-}
 
 module TcArrows ( tcProc ) where
 
-import {-# SOURCE #-}	TcExpr( tcMonoExpr, tcInferRho, tcSyntaxOp, tcCheckId, tcPolyExpr )
+import {-# SOURCE #-}   TcExpr( tcMonoExpr, tcInferRho, tcSyntaxOp, tcCheckId, tcPolyExpr )
 
 import HsSyn
 import TcMatches
@@ -77,32 +72,32 @@ Note that
 
 
 %************************************************************************
-%*									*
-		Proc	
-%*									*
+%*                                                                      *
+                Proc    
+%*                                                                      *
 %************************************************************************
 
 \begin{code}
-tcProc :: InPat Name -> LHsCmdTop Name		-- proc pat -> expr
-       -> TcRhoType				-- Expected type of whole proc expression
+tcProc :: InPat Name -> LHsCmdTop Name          -- proc pat -> expr
+       -> TcRhoType                             -- Expected type of whole proc expression
        -> TcM (OutPat TcId, LHsCmdTop TcId, TcCoercion)
 
 tcProc pat cmd exp_ty
   = newArrowScope $
-    do	{ (co, (exp_ty1, res_ty)) <- matchExpectedAppTy exp_ty 
-	; (co1, (arr_ty, arg_ty)) <- matchExpectedAppTy exp_ty1
-	; let cmd_env = CmdEnv { cmd_arr = arr_ty }
+    do  { (co, (exp_ty1, res_ty)) <- matchExpectedAppTy exp_ty 
+        ; (co1, (arr_ty, arg_ty)) <- matchExpectedAppTy exp_ty1
+        ; let cmd_env = CmdEnv { cmd_arr = arr_ty }
         ; (pat', cmd') <- tcPat ProcExpr pat arg_ty $
-			  tcCmdTop cmd_env cmd (unitTy, res_ty)
+                          tcCmdTop cmd_env cmd (unitTy, res_ty)
         ; let res_co = mkTcTransCo co (mkTcAppCo co1 (mkTcNomReflCo res_ty))
         ; return (pat', cmd', res_co) }
 \end{code}
 
 
 %************************************************************************
-%*									*
-		Commands
-%*									*
+%*                                                                      *
+                Commands
+%*                                                                      *
 %************************************************************************
 
 \begin{code}
@@ -112,7 +107,7 @@ type CmdArgType = TcTauType                  -- carg_type, a nested tuple
 
 data CmdEnv
   = CmdEnv {
-	cmd_arr	:: TcType -- arrow type constructor, of kind *->*->*
+        cmd_arr :: TcType -- arrow type constructor, of kind *->*->*
     }
 
 mkCmdArrTy :: CmdEnv -> TcTauType -> TcTauType -> TcTauType
@@ -126,27 +121,27 @@ tcCmdTop :: CmdEnv
 
 tcCmdTop env (L loc (HsCmdTop cmd _ _ names)) cmd_ty@(cmd_stk, res_ty)
   = setSrcSpan loc $
-    do	{ cmd'   <- tcCmd env cmd cmd_ty
-	; names' <- mapM (tcSyntaxName ProcOrigin (cmd_arr env)) names
-	; return (L loc $ HsCmdTop cmd' cmd_stk res_ty names') }
+    do  { cmd'   <- tcCmd env cmd cmd_ty
+        ; names' <- mapM (tcSyntaxName ProcOrigin (cmd_arr env)) names
+        ; return (L loc $ HsCmdTop cmd' cmd_stk res_ty names') }
 ----------------------------------------
 tcCmd  :: CmdEnv -> LHsCmd Name -> CmdType -> TcM (LHsCmd TcId)
-	-- The main recursive function
+        -- The main recursive function
 tcCmd env (L loc cmd) res_ty
   = setSrcSpan loc $ do
-	{ cmd' <- tc_cmd env cmd res_ty
-	; return (L loc cmd') }
+        { cmd' <- tc_cmd env cmd res_ty
+        ; return (L loc cmd') }
 
 tc_cmd :: CmdEnv -> HsCmd Name  -> CmdType -> TcM (HsCmd TcId)
 tc_cmd env (HsCmdPar cmd) res_ty
-  = do	{ cmd' <- tcCmd env cmd res_ty
-	; return (HsCmdPar cmd') }
+  = do  { cmd' <- tcCmd env cmd res_ty
+        ; return (HsCmdPar cmd') }
 
 tc_cmd env (HsCmdLet binds (L body_loc body)) res_ty
-  = do	{ (binds', body') <- tcLocalBinds binds		$
-			     setSrcSpan body_loc 	$
-			     tc_cmd env body res_ty
-	; return (HsCmdLet binds' (L body_loc body')) }
+  = do  { (binds', body') <- tcLocalBinds binds         $
+                             setSrcSpan body_loc        $
+                             tc_cmd env body res_ty
+        ; return (HsCmdLet binds' (L body_loc body')) }
 
 tc_cmd env in_cmd@(HsCmdCase scrut matches) (stk, res_ty)
   = addErrCtxt (cmdCtxt in_cmd) $ do
@@ -166,25 +161,25 @@ tc_cmd env (HsCmdIf Nothing pred b1 b2) res_ty    -- Ordinary 'if'
     }
 
 tc_cmd env (HsCmdIf (Just fun) pred b1 b2) res_ty -- Rebindable syntax for if
-  = do 	{ pred_ty <- newFlexiTyVarTy openTypeKind
+  = do  { pred_ty <- newFlexiTyVarTy openTypeKind
         -- For arrows, need ifThenElse :: forall r. T -> r -> r -> r
         -- because we're going to apply it to the environment, not
         -- the return value.
         ; (_, [r_tv]) <- tcInstSkolTyVars [alphaTyVar]
-	; let r_ty = mkTyVarTy r_tv
+        ; let r_ty = mkTyVarTy r_tv
         ; let if_ty = mkFunTys [pred_ty, r_ty, r_ty] r_ty
         ; checkTc (not (r_tv `elemVarSet` tyVarsOfType pred_ty))
                   (ptext (sLit "Predicate type of `ifThenElse' depends on result type"))
-	; fun'  <- tcSyntaxOp IfOrigin fun if_ty
-  	; pred' <- tcMonoExpr pred pred_ty
-	; b1'   <- tcCmd env b1 res_ty
-	; b2'   <- tcCmd env b2 res_ty
+        ; fun'  <- tcSyntaxOp IfOrigin fun if_ty
+        ; pred' <- tcMonoExpr pred pred_ty
+        ; b1'   <- tcCmd env b1 res_ty
+        ; b2'   <- tcCmd env b2 res_ty
         ; return (HsCmdIf (Just fun') pred' b1' b2')
     }
 
 -------------------------------------------
--- 		Arrow application
---     	    (f -< a)   or   (f -<< a)
+--              Arrow application
+--          (f -< a)   or   (f -<< a)
 --
 --   D   |- fun :: a t1 t2
 --   D,G |- arg :: t1
@@ -199,16 +194,16 @@ tc_cmd env (HsCmdIf (Just fun) pred b1 b2) res_ty -- Rebindable syntax for if
 -- (plus -<< requires ArrowApply)
 
 tc_cmd env cmd@(HsCmdArrApp fun arg _ ho_app lr) (_, res_ty)
-  = addErrCtxt (cmdCtxt cmd)	$
+  = addErrCtxt (cmdCtxt cmd)    $
     do  { arg_ty <- newFlexiTyVarTy openTypeKind
-	; let fun_ty = mkCmdArrTy env arg_ty res_ty
-	; fun' <- select_arrow_scope (tcMonoExpr fun fun_ty)
+        ; let fun_ty = mkCmdArrTy env arg_ty res_ty
+        ; fun' <- select_arrow_scope (tcMonoExpr fun fun_ty)
              -- ToDo: There should be no need for the escapeArrowScope stuff
              -- See Note [Escaping the arrow scope] in TcRnTypes
 
-	; arg' <- tcMonoExpr arg arg_ty
+        ; arg' <- tcMonoExpr arg arg_ty
 
-	; return (HsCmdArrApp fun' arg' fun_ty ho_app lr) }
+        ; return (HsCmdArrApp fun' arg' fun_ty ho_app lr) }
   where
        -- Before type-checking f, use the environment of the enclosing
        -- proc for the (-<) case.  
@@ -219,7 +214,7 @@ tc_cmd env cmd@(HsCmdArrApp fun arg _ ho_app lr) (_, res_ty)
         HsFirstOrderApp  -> escapeArrowScope tc
 
 -------------------------------------------
--- 		Command application
+--              Command application
 --
 -- D,G |-  exp : t
 -- D;G |-a cmd : (t,stk) --> res
@@ -227,76 +222,76 @@ tc_cmd env cmd@(HsCmdArrApp fun arg _ ho_app lr) (_, res_ty)
 -- D;G |-a cmd exp : stk --> res
 
 tc_cmd env cmd@(HsCmdApp fun arg) (cmd_stk, res_ty)
-  = addErrCtxt (cmdCtxt cmd)	$
+  = addErrCtxt (cmdCtxt cmd)    $
     do  { arg_ty <- newFlexiTyVarTy openTypeKind
-	; fun'   <- tcCmd env fun (mkPairTy arg_ty cmd_stk, res_ty)
-	; arg'   <- tcMonoExpr arg arg_ty
-	; return (HsCmdApp fun' arg') }
+        ; fun'   <- tcCmd env fun (mkPairTy arg_ty cmd_stk, res_ty)
+        ; arg'   <- tcMonoExpr arg arg_ty
+        ; return (HsCmdApp fun' arg') }
 
 -------------------------------------------
--- 		Lambda
+--              Lambda
 --
 -- D;G,x:t |-a cmd : stk --> res
 -- ------------------------------
 -- D;G |-a (\x.cmd) : (t,stk) --> res
 
 tc_cmd env 
-       (HsCmdLam (MG { mg_alts = [L mtch_loc (match@(Match pats _maybe_rhs_sig grhss))] }))
+       (HsCmdLam (MG { mg_alts = [L mtch_loc (match@(Match pats _maybe_rhs_sig grhss))], mg_origin = origin }))
        (cmd_stk, res_ty)
-  = addErrCtxt (pprMatchInCtxt match_ctxt match)	$
-    do	{ (co, arg_tys, cmd_stk') <- matchExpectedCmdArgs n_pats cmd_stk
+  = addErrCtxt (pprMatchInCtxt match_ctxt match)        $
+    do  { (co, arg_tys, cmd_stk') <- matchExpectedCmdArgs n_pats cmd_stk
 
-		-- Check the patterns, and the GRHSs inside
-	; (pats', grhss') <- setSrcSpan mtch_loc		$
+                -- Check the patterns, and the GRHSs inside
+        ; (pats', grhss') <- setSrcSpan mtch_loc                $
                              tcPats LambdaExpr pats arg_tys     $
                              tc_grhss grhss cmd_stk' res_ty
 
-	; let match' = L mtch_loc (Match pats' Nothing grhss')
+        ; let match' = L mtch_loc (Match pats' Nothing grhss')
               arg_tys = map hsLPatType pats'
               cmd' = HsCmdLam (MG { mg_alts = [match'], mg_arg_tys = arg_tys
-                                  , mg_res_ty = res_ty })
-	; return (mkHsCmdCast co cmd') }
+                                  , mg_res_ty = res_ty, mg_origin = origin })
+        ; return (mkHsCmdCast co cmd') }
   where
     n_pats     = length pats
-    match_ctxt = (LambdaExpr :: HsMatchContext Name)	-- Maybe KappaExpr?
+    match_ctxt = (LambdaExpr :: HsMatchContext Name)    -- Maybe KappaExpr?
     pg_ctxt    = PatGuard match_ctxt
 
     tc_grhss (GRHSs grhss binds) stk_ty res_ty
-	= do { (binds', grhss') <- tcLocalBinds binds $
-				   mapM (wrapLocM (tc_grhs stk_ty res_ty)) grhss
-	     ; return (GRHSs grhss' binds') }
+        = do { (binds', grhss') <- tcLocalBinds binds $
+                                   mapM (wrapLocM (tc_grhs stk_ty res_ty)) grhss
+             ; return (GRHSs grhss' binds') }
 
     tc_grhs stk_ty res_ty (GRHS guards body)
-	= do { (guards', rhs') <- tcStmtsAndThen pg_ctxt tcGuardStmt guards res_ty $
-				  \ res_ty -> tcCmd env body (stk_ty, res_ty)
-	     ; return (GRHS guards' rhs') }
+        = do { (guards', rhs') <- tcStmtsAndThen pg_ctxt tcGuardStmt guards res_ty $
+                                  \ res_ty -> tcCmd env body (stk_ty, res_ty)
+             ; return (GRHS guards' rhs') }
 
 -------------------------------------------
--- 		Do notation
+--              Do notation
 
 tc_cmd env (HsCmdDo stmts _) (cmd_stk, res_ty)
-  = do 	{ co <- unifyType unitTy cmd_stk  -- Expecting empty argument stack
-	; stmts' <- tcStmts ArrowExpr (tcArrDoStmt env) stmts res_ty 
-	; return (mkHsCmdCast co (HsCmdDo stmts' res_ty)) }
+  = do  { co <- unifyType unitTy cmd_stk  -- Expecting empty argument stack
+        ; stmts' <- tcStmts ArrowExpr (tcArrDoStmt env) stmts res_ty 
+        ; return (mkHsCmdCast co (HsCmdDo stmts' res_ty)) }
 
 
 -----------------------------------------------------------------
---	Arrow ``forms''	      (| e c1 .. cn |)
+--      Arrow ``forms''       (| e c1 .. cn |)
 --
---	D; G |-a1 c1 : stk1 --> r1
---	...
---	D; G |-an cn : stkn --> rn
---	D |-  e :: forall e. a1 (e, stk1) t1
+--      D; G |-a1 c1 : stk1 --> r1
+--      ...
+--      D; G |-an cn : stkn --> rn
+--      D |-  e :: forall e. a1 (e, stk1) t1
 --                                ...
 --                        -> an (e, stkn) tn
 --                        -> a  (e, stk) t
---	e \not\in (stk, stk1, ..., stkm, t, t1, ..., tn)
---	----------------------------------------------
---	D; G |-a  (| e c1 ... cn |)  :  stk --> t
+--      e \not\in (stk, stk1, ..., stkm, t, t1, ..., tn)
+--      ----------------------------------------------
+--      D; G |-a  (| e c1 ... cn |)  :  stk --> t
 
-tc_cmd env cmd@(HsCmdArrForm expr fixity cmd_args) (cmd_stk, res_ty)	
-  = addErrCtxt (cmdCtxt cmd)	$
-    do	{ (cmd_args', cmd_tys) <- mapAndUnzipM tc_cmd_arg cmd_args
+tc_cmd env cmd@(HsCmdArrForm expr fixity cmd_args) (cmd_stk, res_ty)    
+  = addErrCtxt (cmdCtxt cmd)    $
+    do  { (cmd_args', cmd_tys) <- mapAndUnzipM tc_cmd_arg cmd_args
         ; let e_ty = mkForAllTy alphaTyVar $   -- We use alphaTyVar for 'w'
                      mkFunTys cmd_tys $
                      mkCmdArrTy env (mkPairTy alphaTy cmd_stk) res_ty
@@ -307,19 +302,19 @@ tc_cmd env cmd@(HsCmdArrForm expr fixity cmd_args) (cmd_stk, res_ty)
     tc_cmd_arg :: LHsCmdTop Name -> TcM (LHsCmdTop TcId, TcType)
     tc_cmd_arg cmd
        = do { arr_ty <- newFlexiTyVarTy arrowTyConKind
-	    ; stk_ty <- newFlexiTyVarTy liftedTypeKind
-	    ; res_ty <- newFlexiTyVarTy liftedTypeKind
-	    ; let env' = env { cmd_arr = arr_ty }
-	    ; cmd' <- tcCmdTop env' cmd (stk_ty, res_ty)
-	    ; return (cmd',  mkCmdArrTy env' (mkPairTy alphaTy stk_ty) res_ty) }
+            ; stk_ty <- newFlexiTyVarTy liftedTypeKind
+            ; res_ty <- newFlexiTyVarTy liftedTypeKind
+            ; let env' = env { cmd_arr = arr_ty }
+            ; cmd' <- tcCmdTop env' cmd (stk_ty, res_ty)
+            ; return (cmd',  mkCmdArrTy env' (mkPairTy alphaTy stk_ty) res_ty) }
 
 -----------------------------------------------------------------
---		Base case for illegal commands
+--              Base case for illegal commands
 -- This is where expressions that aren't commands get rejected
 
 tc_cmd _ cmd _
   = failWithTc (vcat [ptext (sLit "The expression"), nest 2 (ppr cmd), 
-		      ptext (sLit "was found where an arrow command was expected")])
+                      ptext (sLit "was found where an arrow command was expected")])
 
 
 matchExpectedCmdArgs :: Arity -> TcType -> TcM (TcCoercion, [TcType], TcType)
@@ -333,34 +328,34 @@ matchExpectedCmdArgs n ty
 
 
 %************************************************************************
-%*									*
-		Stmts
-%*									*
+%*                                                                      *
+                Stmts
+%*                                                                      *
 %************************************************************************
 
 \begin{code}
 --------------------------------
---	Mdo-notation
+--      Mdo-notation
 -- The distinctive features here are
---	(a) RecStmts, and
---	(b) no rebindable syntax
+--      (a) RecStmts, and
+--      (b) no rebindable syntax
 
 tcArrDoStmt :: CmdEnv -> TcCmdStmtChecker
 tcArrDoStmt env _ (LastStmt rhs _) res_ty thing_inside
-  = do	{ rhs' <- tcCmd env rhs (unitTy, res_ty)
-	; thing <- thing_inside (panic "tcArrDoStmt")
-	; return (LastStmt rhs' noSyntaxExpr, thing) }
+  = do  { rhs' <- tcCmd env rhs (unitTy, res_ty)
+        ; thing <- thing_inside (panic "tcArrDoStmt")
+        ; return (LastStmt rhs' noSyntaxExpr, thing) }
 
 tcArrDoStmt env _ (BodyStmt rhs _ _ _) res_ty thing_inside
-  = do	{ (rhs', elt_ty) <- tc_arr_rhs env rhs
-	; thing 	 <- thing_inside res_ty
-	; return (BodyStmt rhs' noSyntaxExpr noSyntaxExpr elt_ty, thing) }
+  = do  { (rhs', elt_ty) <- tc_arr_rhs env rhs
+        ; thing          <- thing_inside res_ty
+        ; return (BodyStmt rhs' noSyntaxExpr noSyntaxExpr elt_ty, thing) }
 
 tcArrDoStmt env ctxt (BindStmt pat rhs _ _) res_ty thing_inside
-  = do	{ (rhs', pat_ty) <- tc_arr_rhs env rhs
-	; (pat', thing)  <- tcPat (StmtCtxt ctxt) pat pat_ty $
+  = do  { (rhs', pat_ty) <- tc_arr_rhs env rhs
+        ; (pat', thing)  <- tcPat (StmtCtxt ctxt) pat pat_ty $
                             thing_inside res_ty
-	; return (BindStmt pat' rhs' noSyntaxExpr noSyntaxExpr, thing) }
+        ; return (BindStmt pat' rhs' noSyntaxExpr noSyntaxExpr, thing) }
 
 tcArrDoStmt env ctxt (RecStmt { recS_stmts = stmts, recS_later_ids = later_names
                             , recS_rec_ids = rec_names }) res_ty thing_inside
@@ -369,15 +364,15 @@ tcArrDoStmt env ctxt (RecStmt { recS_stmts = stmts, recS_later_ids = later_names
         ; let tup_ids = zipWith mkLocalId tup_names tup_elt_tys
         ; tcExtendIdEnv tup_ids $ do
         { (stmts', tup_rets)
-		<- tcStmtsAndThen ctxt (tcArrDoStmt env) stmts res_ty	$ \ _res_ty' ->
-			-- ToDo: res_ty not really right
+                <- tcStmtsAndThen ctxt (tcArrDoStmt env) stmts res_ty   $ \ _res_ty' ->
+                        -- ToDo: res_ty not really right
                    zipWithM tcCheckId tup_names tup_elt_tys
 
         ; thing <- thing_inside res_ty
-		-- NB:	The rec_ids for the recursive things 
-		-- 	already scope over this part. This binding may shadow
-		--	some of them with polymorphic things with the same Name
-		--	(see note [RecStmt] in HsExpr)
+                -- NB:  The rec_ids for the recursive things 
+                --      already scope over this part. This binding may shadow
+                --      some of them with polymorphic things with the same Name
+                --      (see note [RecStmt] in HsExpr)
 
         ; let rec_ids = takeList rec_names tup_ids
         ; later_ids <- tcLookupLocalIds later_names
@@ -390,22 +385,22 @@ tcArrDoStmt env ctxt (RecStmt { recS_stmts = stmts, recS_later_ids = later_names
                                , recS_later_rets = later_rets
                                , recS_rec_ids = rec_ids, recS_rec_rets = rec_rets
                                , recS_ret_ty = res_ty }, thing)
-	}}
+        }}
 
 tcArrDoStmt _ _ stmt _ _
   = pprPanic "tcArrDoStmt: unexpected Stmt" (ppr stmt)
 
 tc_arr_rhs :: CmdEnv -> LHsCmd Name -> TcM (LHsCmd TcId, TcType)
 tc_arr_rhs env rhs = do { ty <- newFlexiTyVarTy liftedTypeKind
-		        ; rhs' <- tcCmd env rhs (unitTy, ty)
-		        ; return (rhs', ty) }
+                        ; rhs' <- tcCmd env rhs (unitTy, ty)
+                        ; return (rhs', ty) }
 \end{code}
 
 
 %************************************************************************
-%*									*
-		Helpers
-%*									*
+%*                                                                      *
+                Helpers
+%*                                                                      *
 %************************************************************************
 
 
@@ -413,15 +408,15 @@ tc_arr_rhs env rhs = do { ty <- newFlexiTyVarTy liftedTypeKind
 mkPairTy :: Type -> Type -> Type
 mkPairTy t1 t2 = mkTyConApp pairTyCon [t1,t2]
 
-arrowTyConKind :: Kind		--  *->*->*
+arrowTyConKind :: Kind          --  *->*->*
 arrowTyConKind = mkArrowKinds [liftedTypeKind, liftedTypeKind] liftedTypeKind
 \end{code}
 
 
 %************************************************************************
-%*									*
-		Errors
-%*									*
+%*                                                                      *
+                Errors
+%*                                                                      *
 %************************************************************************
 
 \begin{code}
diff --git a/compiler/typecheck/TcBinds.lhs b/compiler/typecheck/TcBinds.lhs
index 47d45ae3187e..34db200ab6d7 100644
--- a/compiler/typecheck/TcBinds.lhs
+++ b/compiler/typecheck/TcBinds.lhs
@@ -5,16 +5,18 @@
 \section[TcBinds]{TcBinds}
 
 \begin{code}
+{-# LANGUAGE CPP, RankNTypes, ScopedTypeVariables #-}
+
 module TcBinds ( tcLocalBinds, tcTopBinds, tcRecSelBinds,
                  tcHsBootSigs, tcPolyCheck,
                  PragFun, tcSpecPrags, tcVectDecls, mkPragFun, 
                  TcSigInfo(..), TcSigFun, 
-                 instTcTySig, instTcTySigFromId,
+                 instTcTySig, instTcTySigFromId, findScopedTyVars,
                  badBootDeclErr ) where
 
 import {-# SOURCE #-} TcMatches ( tcGRHSsPat, tcMatchesFun )
 import {-# SOURCE #-} TcExpr  ( tcMonoExpr )
-import {-# SOURCE #-} TcPatSyn ( tcPatSynDecl )
+import {-# SOURCE #-} TcPatSyn ( tcPatSynDecl, tcPatSynWrapper )
 
 import DynFlags
 import HsSyn
@@ -37,6 +39,7 @@ import TysPrim
 import Id
 import Var
 import VarSet
+import VarEnv( TidyEnv )
 import Module
 import Name
 import NameSet
@@ -54,6 +57,7 @@ import FastString
 import Type(mkStrLitTy)
 import Class(classTyCon)
 import PrelNames(ipClassName)
+import TcValidity (checkValidType)
 
 import Control.Monad
 
@@ -270,6 +274,30 @@ time by defaulting.  No no no.
 However [Oct 10] this is all handled automatically by the 
 untouchable-range idea.
 
+Note [Placeholder PatSyn kinds]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Consider this (Trac #9161)
+
+  {-# LANGUAGE PatternSynonyms, DataKinds #-}
+  pattern A = ()
+  b :: A
+  b = undefined
+
+Here, the type signature for b mentions A.  But A is a pattern
+synonym, which is typechecked (for very good reasons; a view pattern
+in the RHS may mention a value binding) as part of a group of
+bindings.  It is entirely resonable to reject this, but to do so
+we need A to be in the kind environment when kind-checking the signature for B.
+
+Hence the tcExtendKindEnv2 patsyn_placeholder_kinds, which adds a binding
+    A -> AGlobal (AConLike (PatSynCon _|_))
+to the environment. Then TcHsType.tcTyVar will find A in the kind environment,
+and will give a 'wrongThingErr' as a result.  But the lookup of A won't fail.
+
+The _|_ (= panic "fakePatSynCon") works because the wrongThingErr call, in
+tcTyVar, doesn't look inside the TcTyThing.
+
+
 \begin{code}
 tcValBinds :: TopLevelFlag 
            -> [(RecFlag, LHsBinds Name)] -> [LSig Name]
@@ -277,19 +305,31 @@ tcValBinds :: TopLevelFlag
            -> TcM ([(RecFlag, LHsBinds TcId)], thing) 
 
 tcValBinds top_lvl binds sigs thing_inside
-  = do  {       -- Typecheck the signature
-          (poly_ids, sig_fn) <- tcTySigs sigs
+  = do  {  -- Typecheck the signature
+        ; (poly_ids, sig_fn) <- tcExtendKindEnv2 patsyn_placeholder_kinds $
+                                     -- See Note [Placeholder PatSyn kinds]
+                                tcTySigs sigs
 
         ; let prag_fn = mkPragFun sigs (foldr (unionBags . snd) emptyBag binds)
 
                 -- Extend the envt right away with all 
                 -- the Ids declared with type signatures
                 -- Use tcExtendIdEnv2 to avoid extending the TcIdBinder stack
-        ; (binds', thing) <- tcExtendIdEnv2 [(idName id, id) | id <- poly_ids] $
-                             tcBindGroups top_lvl sig_fn prag_fn 
-                                          binds thing_inside
-
-        ; return (binds', thing) }
+        ; tcExtendIdEnv2 [(idName id, id) | id <- poly_ids] $ do
+            { (binds', (extra_binds', thing)) <- tcBindGroups top_lvl sig_fn prag_fn binds $ do
+                   { thing <- thing_inside
+                     -- See Note [Pattern synonym wrappers don't yield dependencies]
+                   ; patsyn_wrappers <- mapM tcPatSynWrapper patsyns
+                   ; let extra_binds = [ (NonRecursive, wrapper) | wrapper <- patsyn_wrappers ]
+                   ; return (extra_binds, thing) }
+             ; return (binds' ++ extra_binds', thing) }}
+  where
+    patsyns
+      = [psb | (_, lbinds) <- binds, L _ (PatSynBind psb) <- bagToList lbinds]
+    patsyn_placeholder_kinds -- See Note [Placeholder PatSyn kinds]
+      = [(name, placeholder_patsyn_tything)| PSB{ psb_id = L _ name } <- patsyns ]
+    placeholder_patsyn_tything
+      = AGlobal $ AConLike $ PatSynCon $ panic "fakePatSynCon"
 
 ------------------------
 tcBindGroups :: TopLevelFlag -> TcSigFun -> PragFun
@@ -345,14 +385,14 @@ tc_group top_lvl sig_fn prag_fn (Recursive, binds) thing_inside
         ; return ([(Recursive, binds1)], thing) }
                 -- Rec them all together
   where
-    hasPatSyn = anyBag (isPatSyn . unLoc . snd) binds
+    hasPatSyn = anyBag (isPatSyn . unLoc) binds
     isPatSyn PatSynBind{} = True
     isPatSyn _ = False
 
-    sccs :: [SCC (Origin, LHsBind Name)]
+    sccs :: [SCC (LHsBind Name)]
     sccs = stronglyConnCompFromEdgedVertices (mkEdges sig_fn binds)
 
-    go :: [SCC (Origin, LHsBind Name)] -> TcM (LHsBinds TcId, [TcId], thing)
+    go :: [SCC (LHsBind Name)] -> TcM (LHsBinds TcId, [TcId], thing)
     go (scc:sccs) = do  { (binds1, ids1, closed) <- tc_scc scc
                         ; (binds2, ids2, thing)  <- tcExtendLetEnv top_lvl closed ids1 $ 
                                                     go sccs
@@ -368,7 +408,7 @@ recursivePatSynErr :: OutputableBndr name => LHsBinds name -> TcM a
 recursivePatSynErr binds
   = failWithTc $
     hang (ptext (sLit "Recursive pattern synonym definition with following bindings:"))
-       2 (vcat $ map (pprLBind . snd) . bagToList $ binds)
+       2 (vcat $ map pprLBind . bagToList $ binds)
   where
     pprLoc loc  = parens (ptext (sLit "defined at") <+> ppr loc)
     pprLBind (L loc bind) = pprWithCommas ppr (collectHsBindBinders bind) <+>
@@ -376,11 +416,10 @@ recursivePatSynErr binds
 
 tc_single :: forall thing.
             TopLevelFlag -> TcSigFun -> PragFun
-          -> (Origin, LHsBind Name) -> TcM thing
+          -> LHsBind Name -> TcM thing
           -> TcM (LHsBinds TcId, thing)
-tc_single _top_lvl _sig_fn _prag_fn (_, (L _ ps@PatSynBind{})) thing_inside
-  = do { (pat_syn, aux_binds) <-
-              tcPatSynDecl (patsyn_id ps) (patsyn_args ps) (patsyn_def ps) (patsyn_dir ps)
+tc_single _top_lvl _sig_fn _prag_fn (L _ (PatSynBind psb)) thing_inside
+  = do { (pat_syn, aux_binds) <- tcPatSynDecl psb
 
        ; let tything = AConLike (PatSynCon pat_syn)
              implicit_ids = (patSynMatcher pat_syn) :
@@ -400,12 +439,12 @@ tc_single top_lvl sig_fn prag_fn lbind thing_inside
           
 ------------------------
 mkEdges :: TcSigFun -> LHsBinds Name
-        -> [((Origin, LHsBind Name), BKey, [BKey])]
+        -> [(LHsBind Name, BKey, [BKey])]
 
 type BKey  = Int -- Just number off the bindings
 
 mkEdges sig_fn binds
-  = [ (bind, key, [key | n <- nameSetToList (bind_fvs (unLoc . snd $ bind)),
+  = [ (bind, key, [key | n <- nameSetToList (bind_fvs (unLoc bind)),
                          Just key <- [lookupNameEnv key_map n], no_sig n ])
     | (bind, key) <- keyd_binds
     ]
@@ -416,13 +455,13 @@ mkEdges sig_fn binds
     keyd_binds = bagToList binds `zip` [0::BKey ..]
 
     key_map :: NameEnv BKey     -- Which binding it comes from
-    key_map = mkNameEnv [(bndr, key) | ((_, L _ bind), key) <- keyd_binds
+    key_map = mkNameEnv [(bndr, key) | (L _ bind, key) <- keyd_binds
                                      , bndr <- bindersOfHsBind bind ]
 
 bindersOfHsBind :: HsBind Name -> [Name]
 bindersOfHsBind (PatBind { pat_lhs = pat })           = collectPatBinders pat
 bindersOfHsBind (FunBind { fun_id = L _ f })          = [f]
-bindersOfHsBind (PatSynBind { patsyn_id = L _ psyn }) = [psyn]
+bindersOfHsBind (PatSynBind PSB{ psb_id = L _ psyn }) = [psyn]
 bindersOfHsBind (AbsBinds {})                         = panic "bindersOfHsBind AbsBinds"
 bindersOfHsBind (VarBind {})                          = panic "bindersOfHsBind VarBind"
 
@@ -431,7 +470,7 @@ tcPolyBinds :: TopLevelFlag -> TcSigFun -> PragFun
             -> RecFlag       -- Whether the group is really recursive
             -> RecFlag       -- Whether it's recursive after breaking
                              -- dependencies based on type signatures
-            -> [(Origin, LHsBind Name)]
+            -> [LHsBind Name]
             -> TcM (LHsBinds TcId, [TcId], TopLevelFlag)
 
 -- Typechecks a single bunch of bindings all together, 
@@ -471,9 +510,8 @@ tcPolyBinds top_lvl sig_fn prag_fn rec_group rec_tc bind_list
 
     ; return result }
   where
-    bind_list' = map snd bind_list
-    binder_names = collectHsBindListBinders bind_list'
-    loc = foldr1 combineSrcSpans (map getLoc bind_list')
+    binder_names = collectHsBindListBinders bind_list
+    loc = foldr1 combineSrcSpans (map getLoc bind_list)
          -- The mbinds have been dependency analysed and 
          -- may no longer be adjacent; so find the narrowest
          -- span that includes them all
@@ -483,7 +521,7 @@ tcPolyNoGen     -- No generalisation whatsoever
   :: RecFlag       -- Whether it's recursive after breaking
                    -- dependencies based on type signatures
   -> PragFun -> TcSigFun
-  -> [(Origin, LHsBind Name)]
+  -> [LHsBind Name]
   -> TcM (LHsBinds TcId, [TcId], TopLevelFlag)
 
 tcPolyNoGen rec_tc prag_fn tc_sig_fn bind_list
@@ -508,7 +546,7 @@ tcPolyNoGen rec_tc prag_fn tc_sig_fn bind_list
 tcPolyCheck :: RecFlag       -- Whether it's recursive after breaking
                              -- dependencies based on type signatures
             -> PragFun -> TcSigInfo 
-            -> (Origin, LHsBind Name)
+            -> LHsBind Name
             -> TcM (LHsBinds TcId, [TcId], TopLevelFlag)
 -- There is just one binding, 
 --   it binds a single variable,
@@ -516,11 +554,11 @@ tcPolyCheck :: RecFlag       -- Whether it's recursive after breaking
 tcPolyCheck rec_tc prag_fn
             sig@(TcSigInfo { sig_id = poly_id, sig_tvs = tvs_w_scoped 
                            , sig_theta = theta, sig_tau = tau, sig_loc = loc })
-            bind@(origin, _)
+            bind
   = do { ev_vars <- newEvVars theta
        ; let skol_info = SigSkol (FunSigCtxt (idName poly_id)) (mkPhiTy theta tau)
              prag_sigs = prag_fn (idName poly_id)
-       ; tvs <- mapM (skolemiseSigTv . snd) tvs_w_scoped
+             tvs = map snd tvs_w_scoped
        ; (ev_binds, (binds', [mono_info])) 
             <- setSrcSpan loc $  
                checkConstraints skol_info tvs ev_vars $
@@ -541,7 +579,7 @@ tcPolyCheck rec_tc prag_fn
                         , abs_exports = [export], abs_binds = binds' }
              closed | isEmptyVarSet (tyVarsOfType (idType poly_id)) = TopLevel
                     | otherwise                                     = NotTopLevel
-       ; return (unitBag (origin, abs_bind), [poly_id], closed) }
+       ; return (unitBag abs_bind, [poly_id], closed) }
 
 ------------------
 tcPolyInfer 
@@ -550,7 +588,7 @@ tcPolyInfer
   -> PragFun -> TcSigFun 
   -> Bool         -- True <=> apply the monomorphism restriction
   -> Bool         -- True <=> free vars have closed types
-  -> [(Origin, LHsBind Name)]
+  -> [LHsBind Name]
   -> TcM (LHsBinds TcId, [TcId], TopLevelFlag)
 tcPolyInfer rec_tc prag_fn tc_sig_fn mono closed bind_list
   = do { ((binds', mono_infos), wanted)
@@ -559,12 +597,11 @@ tcPolyInfer rec_tc prag_fn tc_sig_fn mono closed bind_list
 
        ; let name_taus = [(name, idType mono_id) | (name, _, mono_id) <- mono_infos]
        ; traceTc "simplifyInfer call" (ppr name_taus $$ ppr wanted)
-       ; (qtvs, givens, mr_bites, ev_binds) <- 
-                          simplifyInfer closed mono name_taus wanted
+       ; (qtvs, givens, mr_bites, ev_binds)
+                 <- simplifyInfer closed mono name_taus wanted
 
-       ; theta <- zonkTcThetaType (map evVarPred givens)
+       ; theta   <- zonkTcThetaType (map evVarPred givens)
        ; exports <- checkNoErrs $ mapM (mkExport prag_fn qtvs theta) mono_infos
-
        ; loc <- getSrcSpanM
        ; let poly_ids = map abe_poly exports
              final_closed | closed && not mr_bites = TopLevel
@@ -576,10 +613,8 @@ tcPolyInfer rec_tc prag_fn tc_sig_fn mono closed bind_list
 
        ; traceTc "Binding:" (ppr final_closed $$
                              ppr (poly_ids `zip` map idType poly_ids))
-       ; return (unitBag (origin, abs_bind), poly_ids, final_closed) }
+       ; return (unitBag abs_bind, poly_ids, final_closed) }
          -- poly_ids are guaranteed zonked by mkExport
-  where
-    origin = if all isGenerated (map fst bind_list) then Generated else FromSource
 
 --------------
 mkExport :: PragFun
@@ -601,20 +636,12 @@ mkExport :: PragFun
 
 mkExport prag_fn qtvs theta (poly_name, mb_sig, mono_id)
   = do  { mono_ty <- zonkTcType (idType mono_id)
-        ; let poly_id  = case mb_sig of
-                           Nothing  -> mkLocalId poly_name inferred_poly_ty
-                           Just sig -> sig_id sig
-                -- poly_id has a zonked type
-
-              -- In the inference case (no signature) this stuff figures out
-              -- the right type variables and theta to quantify over
-              -- See Note [Impedence matching]
-              my_tvs2 = closeOverKinds (growThetaTyVars theta (tyVarsOfType mono_ty))
-                            -- Include kind variables!  Trac #7916
-              my_tvs   = filter (`elemVarSet` my_tvs2) qtvs   -- Maintain original order
-              my_theta = filter (quantifyPred my_tvs2) theta
-              inferred_poly_ty = mkSigmaTy my_tvs my_theta mono_ty
 
+        ; poly_id <- case mb_sig of
+                       Just sig -> return (sig_id sig)
+                       Nothing  -> mkInferredPolyId poly_name qtvs theta mono_ty
+
+        -- NB: poly_id has a zonked type
         ; poly_id <- addInlinePrags poly_id prag_sigs
         ; spec_prags <- tcSpecPrags poly_id prag_sigs
                 -- tcPrags requires a zonked poly_id
@@ -630,7 +657,7 @@ mkExport prag_fn qtvs theta (poly_name, mb_sig, mono_id)
         -- closed (unless we are doing NoMonoLocalBinds in which case all bets
         -- are off)
         -- See Note [Impedence matching]
-        ; (wrap, wanted) <- addErrCtxtM (mk_msg poly_id) $
+        ; (wrap, wanted) <- addErrCtxtM (mk_bind_msg inferred True poly_name (idType poly_id)) $
                             captureConstraints $
                             tcSubType origin sig_ctxt sel_poly_ty (idType poly_id)
         ; ev_binds <- simplifyTop wanted
@@ -641,24 +668,58 @@ mkExport prag_fn qtvs theta (poly_name, mb_sig, mono_id)
                       , abe_prags = SpecPrags spec_prags }) }
   where
     inferred = isNothing mb_sig
-
-    mk_msg poly_id tidy_env
-      = return (tidy_env', msg)
-      where
-        msg | inferred  = hang (ptext (sLit "When checking that") <+> pp_name)
-                             2 (ptext (sLit "has the inferred type") <+> pp_ty)
-                          $$ ptext (sLit "Probable cause: the inferred type is ambiguous")
-            | otherwise = hang (ptext (sLit "When checking that") <+> pp_name)
-                             2 (ptext (sLit "has the specified type") <+> pp_ty)
-        pp_name = quotes (ppr poly_name)
-        pp_ty   = quotes (ppr tidy_ty)
-        (tidy_env', tidy_ty) = tidyOpenType tidy_env (idType poly_id)
-
     prag_sigs = prag_fn poly_name
     origin    = AmbigOrigin sig_ctxt
     sig_ctxt  = InfSigCtxt poly_name
+
+mkInferredPolyId :: Name -> [TyVar] -> TcThetaType -> TcType -> TcM Id
+-- In the inference case (no signature) this stuff figures out
+-- the right type variables and theta to quantify over
+-- See Note [Validity of inferred types]
+mkInferredPolyId poly_name qtvs theta mono_ty
+  = addErrCtxtM (mk_bind_msg True False poly_name inferred_poly_ty) $
+    do { checkValidType (InfSigCtxt poly_name) inferred_poly_ty
+       ; return (mkLocalId poly_name inferred_poly_ty) }
+  where
+    my_tvs2 = closeOverKinds (growThetaTyVars theta (tyVarsOfType mono_ty))
+                  -- Include kind variables!  Trac #7916
+    my_tvs   = filter (`elemVarSet` my_tvs2) qtvs   -- Maintain original order
+    my_theta = filter (quantifyPred my_tvs2) theta
+    inferred_poly_ty = mkSigmaTy my_tvs my_theta mono_ty
+
+mk_bind_msg :: Bool -> Bool -> Name -> TcType -> TidyEnv -> TcM (TidyEnv, SDoc)
+mk_bind_msg inferred want_ambig poly_name poly_ty tidy_env
+ = return (tidy_env', msg)
+ where
+   msg = vcat [ ptext (sLit "When checking that") <+> quotes (ppr poly_name)
+                <+> ptext (sLit "has the") <+> what <+> ptext (sLit "type")
+              , nest 2 (ppr poly_name <+> dcolon <+> ppr tidy_ty)
+              , ppWhen want_ambig $
+                ptext (sLit "Probable cause: the inferred type is ambiguous") ]
+   what | inferred  = ptext (sLit "inferred")
+        | otherwise = ptext (sLit "specified")
+   (tidy_env', tidy_ty) = tidyOpenType tidy_env poly_ty
 \end{code}
 
+Note [Validity of inferred types]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+We need to check inferred type for validity, in case it uses language 
+extensions that are not turned on.  The principle is that if the user
+simply adds the inferred type to the program source, it'll compile fine.
+See #8883.
+
+Examples that might fail:
+ - an inferred theta that requires type equalities e.g. (F a ~ G b)
+                                or multi-parameter type classes
+ - an inferred type that includes unboxed tuples
+
+However we don't do the ambiguity check (checkValidType omits it for
+InfSigCtxt) because the impedence-matching stage, which follows 
+immediately, will do it and we don't want two error messages.
+Moreover, because of the impedence matching stage, the ambiguity-check
+suggestion of -XAllowAmbiguiousTypes will not work.
+
+
 Note [Impedence matching]
 ~~~~~~~~~~~~~~~~~~~~~~~~~
 Consider
@@ -704,7 +765,7 @@ type PragFun = Name -> [LSig Name]
 mkPragFun :: [LSig Name] -> LHsBinds Name -> PragFun
 mkPragFun sigs binds = \n -> lookupNameEnv prag_env n `orElse` []
   where
-    prs = mapCatMaybes get_sig sigs
+    prs = mapMaybe get_sig sigs
 
     get_sig :: LSig Name -> Maybe (Located Name, LSig Name)
     get_sig (L l (SpecSig nm ty inl)) = Just (nm, L l $ SpecSig  nm ty (add_arity nm inl))
@@ -723,7 +784,7 @@ mkPragFun sigs binds = \n -> lookupNameEnv prag_env n `orElse` []
 
     -- ar_env maps a local to the arity of its definition
     ar_env :: NameEnv Arity
-    ar_env = foldrBag (lhsBindArity . snd) emptyNameEnv binds
+    ar_env = foldrBag lhsBindArity emptyNameEnv binds
 
 lhsBindArity :: LHsBind Name -> NameEnv Arity -> NameEnv Arity
 lhsBindArity (L _ (FunBind { fun_id = id, fun_matches = ms })) env
@@ -739,7 +800,8 @@ tcSpecPrags :: Id -> [LSig Name]
 -- Pre-condition: the poly_id is zonked
 -- Reason: required by tcSubExp
 tcSpecPrags poly_id prag_sigs
-  = do { unless (null bad_sigs) warn_discarded_sigs
+  = do { traceTc "tcSpecPrags" (ppr poly_id <+> ppr spec_sigs)
+       ; unless (null bad_sigs) warn_discarded_sigs
        ; mapAndRecoverM (wrapLocM (tcSpec poly_id)) spec_sigs }
   where
     spec_sigs = filter isSpecLSig prag_sigs
@@ -777,7 +839,7 @@ tcSpec _ prag = pprPanic "tcSpec" (ppr prag)
 
 --------------
 tcImpPrags :: [LSig Name] -> TcM [LTcSpecPrag]
--- SPECIALISE pragamas for imported things
+-- SPECIALISE pragmas for imported things
 tcImpPrags prags
   = do { this_mod <- getModule
        ; dflags <- getDynFlags
@@ -992,12 +1054,12 @@ tcMonoBinds :: RecFlag  -- Whether the binding is recursive for typechecking pur
                         -- i.e. the binders are mentioned in their RHSs, and
                         --      we are not rescued by a type signature
             -> TcSigFun -> LetBndrSpec 
-            -> [(Origin, LHsBind Name)]
+            -> [LHsBind Name]
             -> TcM (LHsBinds TcId, [MonoBindInfo])
 
 tcMonoBinds is_rec sig_fn no_gen
-           [ (origin, L b_loc (FunBind { fun_id = L nm_loc name, fun_infix = inf, 
-                                         fun_matches = matches, bind_fvs = fvs }))]
+           [ L b_loc (FunBind { fun_id = L nm_loc name, fun_infix = inf,
+                                fun_matches = matches, bind_fvs = fvs })]
                              -- Single function binding, 
   | NonRecursive <- is_rec   -- ...binder isn't mentioned in RHS
   , Nothing <- sig_fn name   -- ...with no type signature
@@ -1015,17 +1077,16 @@ tcMonoBinds is_rec sig_fn no_gen
                                  -- type of the thing whose rhs we are type checking
                                tcMatchesFun name inf matches rhs_ty
 
-        ; return (unitBag (origin,
-                           L b_loc (FunBind { fun_id = L nm_loc mono_id, fun_infix = inf,
-                                              fun_matches = matches', bind_fvs = fvs,
-                                              fun_co_fn = co_fn, fun_tick = Nothing })),
+        ; return (unitBag $ L b_loc (FunBind { fun_id = L nm_loc mono_id, fun_infix = inf,
+                                               fun_matches = matches', bind_fvs = fvs,
+                                               fun_co_fn = co_fn, fun_tick = Nothing }),
                   [(name, Nothing, mono_id)]) }
 
 tcMonoBinds _ sig_fn no_gen binds
-  = do  { tc_binds <- mapM (wrapOriginLocM (tcLhs sig_fn no_gen)) binds
+  = do  { tc_binds <- mapM (wrapLocM (tcLhs sig_fn no_gen)) binds
 
         -- Bring the monomorphic Ids, into scope for the RHSs
-        ; let mono_info  = getMonoBindInfo (map snd tc_binds)
+        ; let mono_info  = getMonoBindInfo tc_binds
               rhs_id_env = [(name,mono_id) | (name, Nothing, mono_id) <- mono_info]
                     -- A monomorphic binding for each term variable that lacks 
                     -- a type sig.  (Ones with a sig are already in scope.)
@@ -1033,7 +1094,7 @@ tcMonoBinds _ sig_fn no_gen binds
         ; traceTc "tcMonoBinds" $ vcat [ ppr n <+> ppr id <+> ppr (idType id) 
                                        | (n,id) <- rhs_id_env]
         ; binds' <- tcExtendIdEnv2 rhs_id_env $ 
-                    mapM (wrapOriginLocM tcRhs) tc_binds
+                    mapM (wrapLocM tcRhs) tc_binds
         ; return (listToBag binds', mono_info) }
 
 ------------------------
@@ -1162,18 +1223,6 @@ However, we do *not* support this
         f :: forall a. a->a
         (f,g) = e
 
-Note [More instantiated than scoped]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-There may be more instantiated type variables than lexically-scoped 
-ones.  For example:
-        type T a = forall b. b -> (a,b)
-        f :: forall c. T c
-Here, the signature for f will have one scoped type variable, c,
-but two instantiated type variables, c' and b'.  
-
-We assume that the scoped ones are at the *front* of sig_tvs,
-and remember the names from the original HsForAllTy in the TcSigFun.
-
 Note [Signature skolems]
 ~~~~~~~~~~~~~~~~~~~~~~~~
 When instantiating a type signature, we do so with either skolems or
@@ -1248,45 +1297,28 @@ tcTySig _ = return []
 
 instTcTySigFromId :: SrcSpan -> Id -> TcM TcSigInfo
 instTcTySigFromId loc id
-  = do { (tvs, theta, tau) <- tcInstType inst_sig_tyvars (idType id)
+  = do { (tvs, theta, tau) <- tcInstType (tcInstSigTyVarsLoc loc)
+                                         (idType id)
        ; return (TcSigInfo { sig_id = id, sig_loc = loc
                            , sig_tvs = [(Nothing, tv) | tv <- tvs]
                            , sig_theta = theta, sig_tau = tau }) }
   where
     -- Hack: in an instance decl we use the selector id as
-    -- the template; but we do *not* want the SrcSpan on the Name of 
+    -- the template; but we do *not* want the SrcSpan on the Name of
     -- those type variables to refer to the class decl, rather to
-    -- the instance decl 
-    inst_sig_tyvars tvs = tcInstSigTyVars (map set_loc tvs)
-    set_loc tv = setTyVarName tv (mkInternalName (nameUnique n) (nameOccName n) loc)
-      where
-        n = tyVarName tv
+    -- the instance decl
 
 instTcTySig :: LHsType Name -> TcType    -- HsType and corresponding TcType
             -> Name -> TcM TcSigInfo
 instTcTySig hs_ty@(L loc _) sigma_ty name
   = do { (inst_tvs, theta, tau) <- tcInstType tcInstSigTyVars sigma_ty
-       ; return (TcSigInfo { sig_id = poly_id, sig_loc = loc
-                           , sig_tvs = zipEqual "instTcTySig" scoped_tvs inst_tvs
+       ; return (TcSigInfo { sig_id = mkLocalId name sigma_ty
+                           , sig_loc = loc
+                           , sig_tvs = findScopedTyVars hs_ty sigma_ty inst_tvs
                            , sig_theta = theta, sig_tau = tau }) }
-  where
-    poly_id      = mkLocalId name sigma_ty
-
-    scoped_names = hsExplicitTvs hs_ty
-    (sig_tvs,_)  = tcSplitForAllTys sigma_ty
-
-    scoped_tvs :: [Maybe Name]
-    scoped_tvs = mk_scoped scoped_names sig_tvs
-
-    mk_scoped :: [Name] -> [TyVar] -> [Maybe Name]
-    mk_scoped []     tvs      = [Nothing | _ <- tvs]
-    mk_scoped (n:ns) (tv:tvs) 
-           | n == tyVarName tv = Just n  : mk_scoped ns     tvs
-           | otherwise         = Nothing : mk_scoped (n:ns) tvs
-    mk_scoped (n:ns) [] = pprPanic "mk_scoped" (ppr name $$ ppr (n:ns) $$ ppr hs_ty $$ ppr sigma_ty)
 
 -------------------------------
-data GeneralisationPlan 
+data GeneralisationPlan
   = NoGen               -- No generalisation, no AbsBinds
 
   | InferGen            -- Implicit generalisation; there is an AbsBinds
@@ -1294,7 +1326,7 @@ data GeneralisationPlan
        Bool             --   True <=> bindings mention only variables with closed types
                         --            See Note [Bindings with closed types] in TcRnTypes
 
-  | CheckGen (Origin, LHsBind Name) TcSigInfo
+  | CheckGen (LHsBind Name) TcSigInfo
                         -- One binding with a signature
                         -- Explicit generalisation; there is an AbsBinds
 
@@ -1306,25 +1338,25 @@ instance Outputable GeneralisationPlan where
   ppr (InferGen b c) = ptext (sLit "InferGen") <+> ppr b <+> ppr c
   ppr (CheckGen _ s) = ptext (sLit "CheckGen") <+> ppr s
 
-decideGeneralisationPlan 
+decideGeneralisationPlan
    :: DynFlags -> TcTypeEnv -> [Name]
-   -> [(Origin, LHsBind Name)] -> TcSigFun -> GeneralisationPlan
+   -> [LHsBind Name] -> TcSigFun -> GeneralisationPlan
 decideGeneralisationPlan dflags type_env bndr_names lbinds sig_fn
-  | bang_pat_binds                                  = NoGen
+  | strict_pat_binds                                 = NoGen
   | Just (lbind, sig) <- one_funbind_with_sig lbinds = CheckGen lbind sig
-  | mono_local_binds                                = NoGen
-  | otherwise                                       = InferGen mono_restriction closed_flag
+  | mono_local_binds                                 = NoGen
+  | otherwise                                        = InferGen mono_restriction closed_flag
 
   where
     bndr_set = mkNameSet bndr_names
-    binds = map (unLoc . snd) lbinds
+    binds = map unLoc lbinds
 
-    bang_pat_binds = any isBangHsBind binds
-       -- Bang patterns must not be polymorphic,
-       -- because we are going to force them
-       -- See Trac #4498
+    strict_pat_binds = any isStrictHsBind binds
+       -- Strict patterns (top level bang or unboxed tuple) must not
+       -- be polymorphic, because we are going to force them
+       -- See Trac #4498, #8762
 
-    mono_restriction  = xopt Opt_MonomorphismRestriction dflags 
+    mono_restriction  = xopt Opt_MonomorphismRestriction dflags
                      && any restricted binds
 
     is_closed_ns :: NameSet -> Bool -> Bool
@@ -1333,7 +1365,7 @@ decideGeneralisationPlan dflags type_env bndr_names lbinds sig_fn
 
     is_closed_id :: Name -> Bool
     -- See Note [Bindings with closed types] in TcRnTypes
-    is_closed_id name 
+    is_closed_id name
       | name `elemNameSet` bndr_set
       = True              -- Ignore binders in this groups, of course
       | Just thing <- lookupNameEnv type_env name
@@ -1346,19 +1378,19 @@ decideGeneralisationPlan dflags type_env bndr_names lbinds sig_fn
       = WARN( isInternalName name, ppr name ) True
         -- The free-var set for a top level binding mentions
         -- imported things too, so that we can report unused imports
-        -- These won't be in the local type env.  
+        -- These won't be in the local type env.
         -- Ditto class method etc from the current module
-    
+
     closed_flag = foldr (is_closed_ns . bind_fvs) True binds
 
-    mono_local_binds = xopt Opt_MonoLocalBinds dflags 
+    mono_local_binds = xopt Opt_MonoLocalBinds dflags
                     && not closed_flag
 
     no_sig n = isNothing (sig_fn n)
 
     -- With OutsideIn, all nested bindings are monomorphic
     -- except a single function binding with a signature
-    one_funbind_with_sig [lbind@(_, L _ (FunBind { fun_id = v }))]
+    one_funbind_with_sig [lbind@(L _ (FunBind { fun_id = v }))]
       = case sig_fn (unLoc v) of
         Nothing -> Nothing
         Just sig -> Just (lbind, sig)
@@ -1380,78 +1412,77 @@ decideGeneralisationPlan dflags type_env bndr_names lbinds sig_fn
 
 -------------------
 checkStrictBinds :: TopLevelFlag -> RecFlag
-                 -> [(Origin, LHsBind Name)]
+                 -> [LHsBind Name]
                  -> LHsBinds TcId -> [Id]
                  -> TcM ()
 -- Check that non-overloaded unlifted bindings are
 --      a) non-recursive,
---      b) not top level, 
+--      b) not top level,
 --      c) not a multiple-binding group (more or less implied by (a))
 
 checkStrictBinds top_lvl rec_group orig_binds tc_binds poly_ids
-  | unlifted || bang_pat
+  | unlifted_bndrs || any_strict_pat   -- This binding group must be matched strictly
   = do  { checkTc (isNotTopLevel top_lvl)
-                  (strictBindErr "Top-level" unlifted orig_binds)
+                  (strictBindErr "Top-level" unlifted_bndrs orig_binds)
         ; checkTc (isNonRec rec_group)
-                  (strictBindErr "Recursive" unlifted orig_binds)
+                  (strictBindErr "Recursive" unlifted_bndrs orig_binds)
 
         ; checkTc (all is_monomorphic (bagToList tc_binds))
                   (polyBindErr orig_binds)
             -- data Ptr a = Ptr Addr#
             -- f x = let p@(Ptr y) = ... in ...
-            -- Here the binding for 'p' is polymorphic, but does 
+            -- Here the binding for 'p' is polymorphic, but does
             -- not mix with an unlifted binding for 'y'.  You should
             -- use a bang pattern.  Trac #6078.
-        
+
         ; checkTc (isSingleton orig_binds)
-                  (strictBindErr "Multiple" unlifted orig_binds)
-
-        -- Ensure that unlifted bindings which look lazy, like:
-        --   f x = let I# y = x
-        -- cause an error.
-        ; when lifted_pat $
-            checkTc bang_pat
-                 -- No outer bang, but it's a compound pattern
-                 -- E.g   (I# x#) = blah
-                 -- Warn about this, but not about
-                 --      x# = 4# +# 1#
-                 --      (# a, b #) = ...
-                 (unliftedMustBeBang orig_binds) }
+                  (strictBindErr "Multiple" unlifted_bndrs orig_binds)
+
+        -- Complain about a binding that looks lazy
+        --    e.g.    let I# y = x in ...
+        -- Remember, in checkStrictBinds we are going to do strict
+        -- matching, so (for software engineering reasons) we insist
+        -- that the strictness is manifest on each binding
+        -- However, lone (unboxed) variables are ok
+        ; checkTc (not any_pat_looks_lazy)
+                  (unliftedMustBeBang orig_binds) }
   | otherwise
   = traceTc "csb2" (ppr poly_ids) >>
     return ()
   where
-    unlifted    = any is_unlifted poly_ids
-    bang_pat    = any (isBangHsBind    . unLoc . snd) orig_binds
-    lifted_pat  = any (isLiftedPatBind . unLoc . snd) orig_binds
+    unlifted_bndrs     = any is_unlifted poly_ids
+    any_strict_pat     = any (isStrictHsBind   . unLoc) orig_binds
+    any_pat_looks_lazy = any (looksLazyPatBind . unLoc) orig_binds
 
     is_unlifted id = case tcSplitForAllTys (idType id) of
                        (_, rho) -> isUnLiftedType rho
 
-    is_monomorphic (_, (L _ (AbsBinds { abs_tvs = tvs, abs_ev_vars = evs })))
+    is_monomorphic (L _ (AbsBinds { abs_tvs = tvs, abs_ev_vars = evs }))
                      = null tvs && null evs
     is_monomorphic _ = True
 
-unliftedMustBeBang :: [(Origin, LHsBind Name)] -> SDoc
+unliftedMustBeBang :: [LHsBind Name] -> SDoc
 unliftedMustBeBang binds
   = hang (text "Pattern bindings containing unlifted types should use an outermost bang pattern:")
-       2 (vcat (map (ppr . snd) binds))
+       2 (vcat (map ppr binds))
 
-polyBindErr :: [(Origin, LHsBind Name)] -> SDoc
+polyBindErr :: [LHsBind Name] -> SDoc
 polyBindErr binds
   = hang (ptext (sLit "You can't mix polymorphic and unlifted bindings"))
-       2 (vcat [vcat (map (ppr . snd) binds), 
+       2 (vcat [vcat (map ppr binds), 
                 ptext (sLit "Probable fix: use a bang pattern")])
 
-strictBindErr :: String -> Bool -> [(Origin, LHsBind Name)] -> SDoc
-strictBindErr flavour unlifted binds
+strictBindErr :: String -> Bool -> [LHsBind Name] -> SDoc
+strictBindErr flavour unlifted_bndrs binds
   = hang (text flavour <+> msg <+> ptext (sLit "aren't allowed:")) 
-       2 (vcat (map (ppr . snd) binds))
+       2 (vcat (map ppr binds))
   where
-    msg | unlifted  = ptext (sLit "bindings for unlifted types")
-        | otherwise = ptext (sLit "bang-pattern bindings")
+    msg | unlifted_bndrs = ptext (sLit "bindings for unlifted types")
+        | otherwise      = ptext (sLit "bang-pattern or unboxed-tuple bindings")
 \end{code}
 
+Note [Binding scoped type variables]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
 %************************************************************************
 %*                                                                      *
diff --git a/compiler/typecheck/TcCanonical.lhs b/compiler/typecheck/TcCanonical.lhs
index 823b37fa1a58..d58d5db40fd0 100644
--- a/compiler/typecheck/TcCanonical.lhs
+++ b/compiler/typecheck/TcCanonical.lhs
@@ -1,4 +1,6 @@
 \begin{code}
+{-# LANGUAGE CPP #-}
+
 module TcCanonical(
     canonicalize, emitWorkNC,
     StopOrContinue (..)
@@ -385,22 +387,9 @@ canIrred old_ev
        ; case classifyPredType (ctEvPred new_ev) of
            ClassPred cls tys -> canClassNC new_ev cls tys
            TuplePred tys     -> canTuple   new_ev tys
-           EqPred ty1 ty2
-              | something_changed old_ty ty1 ty2 -> canEqNC new_ev ty1 ty2
-           _  -> continueWith $
-                 CIrredEvCan { cc_ev = new_ev } } } }
-  where
-    -- If the constraint was a kind-mis-matched equality, we must
-    -- retry canEqNC only if something has changed, otherwise we
-    -- get an infinite loop
-    something_changed old_ty new_ty1 new_ty2
-       | EqPred old_ty1 old_ty2 <- classifyPredType old_ty
-       = not (            new_ty1 `tcEqType`          old_ty1
-              && typeKind new_ty1 `tcEqKind` typeKind old_ty1
-              &&          new_ty2 `tcEqType`          old_ty2
-              && typeKind new_ty2 `tcEqKind` typeKind old_ty2)
-       | otherwise
-       = True
+           EqPred ty1 ty2    -> canEqNC new_ev ty1 ty2
+           _                 -> continueWith $
+                                CIrredEvCan { cc_ev = new_ev } } } }
 
 canHole :: CtEvidence -> OccName -> TcS StopOrContinue
 canHole ev occ
@@ -488,14 +477,6 @@ flatten :: FlattenMode
 --
 -- Postcondition: Coercion :: Xi ~ TcType
 
-flatten f ctxt ty
-  | Just ty' <- tcView ty
-  = do { (xi, co) <- flatten f ctxt ty'
-       ; if xi `tcEqType` ty' then return (ty,co) 
-                              else return (xi,co) }
-       -- Small tweak for better error messages
-       -- by preserving type synonyms where possible
-
 flatten _ _ xi@(LitTy {}) = return (xi, mkTcNomReflCo xi)
 
 flatten f ctxt (TyVarTy tv)
@@ -513,11 +494,21 @@ flatten f ctxt (FunTy ty1 ty2)
        ; return (mkFunTy xi1 xi2, mkTcFunCo Nominal co1 co2) }
 
 flatten f ctxt (TyConApp tc tys)
-  -- For a normal type constructor or data family application,
+
+  -- Expand type synonyms that mention type families 
+  -- on the RHS; see Note [Flattening synonyms]
+  | Just (tenv, rhs, tys') <- tcExpandTyCon_maybe tc tys
+  , any isSynFamilyTyCon (tyConsOfType rhs)
+  = flatten f ctxt (mkAppTys (substTy (mkTopTvSubst tenv) rhs) tys')
+
+  -- For * a normal data type application
+  --     * data family application
+  --     * type synonym application whose RHS does not mention type families
+  --             See Note [Flattening synonyms]
   -- we just recursively flatten the arguments.
   | not (isSynFamilyTyCon tc)
-    = do { (xis,cos) <- flattenMany f ctxt tys
-         ; return (mkTyConApp tc xis, mkTcTyConAppCo Nominal tc cos) }
+  = do { (xis,cos) <- flattenMany f ctxt tys
+       ; return (mkTyConApp tc xis, mkTcTyConAppCo Nominal tc cos) }
 
   -- Otherwise, it's a type function application, and we have to
   -- flatten it away as well, and generate a new given equality constraint
@@ -551,10 +542,28 @@ flatten _f ctxt ty@(ForAllTy {})
        ; return (mkForAllTys tvs rho', foldr mkTcForAllCo co tvs) }
 \end{code}
 
+Note [Flattening synonyms]
+~~~~~~~~~~~~~~~~~~~~~~~~~~
+Not expanding synonyms aggressively improves error messages, and
+keeps types smaller. But we need to take care.
+
+Suppose
+   type T a = a -> a
+and we want to flatten the type (T (F a)).  Then we can safely flatten
+the (F a) to a skolem, and return (T fsk).  We don't need to expand the
+synonym.  This works because TcTyConAppCo can deal with synonyms
+(unlike TyConAppCo), see Note [TcCoercions] in TcEvidence.
+
+But (Trac #8979) for
+   type T a = (F a, a)    where F is a type function
+we must expand the synonym in (say) T Int, to expose the type function
+to the flattener.
+
+
 Note [Flattening under a forall]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 Under a forall, we
-  (a) MUST apply the inert subsitution
+  (a) MUST apply the inert substitution
   (b) MUST NOT flatten type family applications
 Hence FMSubstOnly.
 
@@ -624,12 +633,14 @@ flattenTyVar f ctxt tv
   = do { mb_yes <- flattenTyVarOuter f ctxt tv
        ; case mb_yes of
            Left tv'         -> -- Done 
-                               return (ty, mkTcNomReflCo ty)
+                               do { traceTcS "flattenTyVar1" (ppr tv $$ ppr (tyVarKind tv'))
+                                  ; return (ty', mkTcNomReflCo ty') }
                             where
-                               ty = mkTyVarTy tv'
+                               ty' = mkTyVarTy tv'
 
            Right (ty1, co1) -> -- Recurse
                                do { (ty2, co2) <- flatten f ctxt ty1
+                                  ; traceTcS "flattenTyVar2" (ppr tv $$ ppr ty2)
                                   ; return (ty2, co2 `mkTcTransCo` co1) }
        }
 
@@ -732,7 +743,8 @@ canEvVarsCreated (ev : evs)
 emitWorkNC :: [CtEvidence] -> TcS ()
 emitWorkNC evs
   | null evs  = return ()
-  | otherwise = updWorkListTcS (extendWorkListCts (map mk_nc evs))
+  | otherwise = do { traceTcS "Emitting fresh work" (vcat (map ppr evs))
+                   ; updWorkListTcS (extendWorkListCts (map mk_nc evs)) }
   where
     mk_nc ev = mkNonCanonical ev
 
@@ -889,7 +901,8 @@ canDecomposableTyConApp ev tc1 tys1 tc2 tys2
     -- Fail straight away for better error messages
   = canEqFailure ev (mkTyConApp tc1 tys1) (mkTyConApp tc2 tys2)
   | otherwise
-  = canDecomposableTyConAppOK ev tc1 tys1 tys2
+  = do { traceTcS "canDecomposableTyConApp" (ppr ev $$ ppr tc1 $$ ppr tys1 $$ ppr tys2)
+       ; canDecomposableTyConAppOK ev tc1 tys1 tys2 }
 
 canDecomposableTyConAppOK :: CtEvidence
                           -> TyCon -> [TcType] -> [TcType]
@@ -1143,7 +1156,7 @@ canEqTyVar2 :: DynFlags
             -> TcS StopOrContinue
 -- LHS is an inert type variable, 
 -- and RHS is fully rewritten, but with type synonyms
--- preserved as must as possible
+-- preserved as much as possible
 
 canEqTyVar2 dflags ev swapped tv1 xi2 co2
   | Just tv2 <- getTyVar_maybe xi2
@@ -1173,6 +1186,9 @@ canEqTyVar2 dflags ev swapped tv1 xi2 co2
        ; case mb of
            Nothing     -> return ()
            Just new_ev -> emitInsoluble (mkNonCanonical new_ev)
+                          -- If we have a ~ [a], it is not canonical, and in particular
+                          -- we don't want to rewrite existing inerts with it, otherwise
+                          -- we'd risk divergence in the constraint solver
        ; return Stop }
   where
     xi1 = mkTyVarTy tv1
@@ -1214,7 +1230,7 @@ canEqTyVarTyVar ev swapped tv1 tv2 co2
                        -> continueWith (CTyEqCan { cc_ev = new_ev
                                                  , cc_tyvar = tv1, cc_rhs = xi2 })
                        | otherwise
-                       -> checkKind ev xi1 k1 xi2 k2 } 
+                       -> checkKind new_ev xi1 k1 xi2 k2 } 
   where
     reorient_me 
       | k1 `tcEqKind` k2    = tv2 `better_than` tv1
@@ -1241,20 +1257,21 @@ checkKind :: CtEvidence         -- t1~t2
 -- for the type equality; and continue with the kind equality constraint.
 -- When the latter is solved, it'll kick out the irreducible equality for
 -- a second attempt at solving
+--
+-- See Note [Equalities with incompatible kinds]
 
 checkKind new_ev s1 k1 s2 k2   -- See Note [Equalities with incompatible kinds]
   = ASSERT( isKind k1 && isKind k2 )
     do { traceTcS "canEqLeaf: incompatible kinds" (vcat [ppr k1, ppr k2])
 
-         -- Put the not-currently-soluble thing back onto the work list
-       ; updWorkListTcS $ extendWorkListNonEq $
-         CIrredEvCan { cc_ev = new_ev }
-
          -- Create a derived kind-equality, and solve it
-       ; mw <- newDerived kind_co_loc (mkEqPred k1 k2)
+       ; mw <- newDerived kind_co_loc (mkTcEqPred k1 k2)
        ; case mw of
-           Nothing  -> return Stop
-           Just kev -> canEqNC kev k1 k2 }
+           Nothing  -> return ()
+           Just kev -> emitWorkNC [kev]
+
+         -- Put the not-currently-soluble thing into the inert set
+       ; continueWith (CIrredEvCan { cc_ev = new_ev }) }
   where
     loc = ctev_loc new_ev
     kind_co_loc = setCtLocOrigin loc (KindEqOrigin s1 s2 (ctLocOrigin loc))
@@ -1294,8 +1311,8 @@ a well-kinded type ill-kinded; and that is bad (eg typeKind can crash, see
 Trac #7696).
 
 So instead for these ill-kinded equalities we generate a CIrredCan,
-which keeps it out of the way until a subsequent substitution (on kind
-variables, say) re-activates it.
+and put it in the inert set, which keeps it out of the way until a
+subsequent substitution (on kind variables, say) re-activates it.
 
 NB: it is important that the types s1,s2 are flattened and zonked
     so that their kinds k1, k2 are inert wrt the substitution.  That
@@ -1304,6 +1321,11 @@ NB: it is important that the types s1,s2 are flattened and zonked
     E.g. it is WRONG to make an irred (a:k1)~(b:k2)
          if we already have a substitution k1:=k2
 
+NB: it's important that the new CIrredCan goes in the inert set rather
+than back into the work list. We used to do the latter, but that led
+to an infinite loop when we encountered it again, and put it back in
+the work list again.
+
 See also Note [Kind orientation for CTyEqCan] and
          Note [Kind orientation for CFunEqCan] in TcRnTypes
 
diff --git a/compiler/typecheck/TcClassDcl.lhs b/compiler/typecheck/TcClassDcl.lhs
index f61f48e92aa6..be5a74f294ef 100644
--- a/compiler/typecheck/TcClassDcl.lhs
+++ b/compiler/typecheck/TcClassDcl.lhs
@@ -6,7 +6,8 @@
 Typechecking class declarations
 
 \begin{code}
-{-# OPTIONS -fno-warn-tabs #-}
+{-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
 -- The above warning supression flag is a temporary kludge.
 -- While working on this module you are encouraged to remove it and
 -- detab the module (please do the detabbing in a separate patch). See
@@ -121,7 +122,7 @@ tcClassSigs clas sigs def_methods
     vanilla_sigs = [L loc (nm,ty) | L loc (TypeSig    nm ty) <- sigs]
     gen_sigs     = [L loc (nm,ty) | L loc (GenericSig nm ty) <- sigs]
     dm_bind_names :: [Name]	-- These ones have a value binding in the class decl
-    dm_bind_names = [op | (_, L _ (FunBind {fun_id = L _ op})) <- bagToList def_methods]
+    dm_bind_names = [op | L _ (FunBind {fun_id = L _ op}) <- bagToList def_methods]
 
     tc_sig genop_env (op_names, op_hs_ty)
       = do { traceTc "ClsSig 1" (ppr op_names)
@@ -238,18 +239,18 @@ tcDefMeth clas tyvars this_dict binds_in hs_sig_fn prag_fn (sel_id, dm_info)
 ---------------
 tcInstanceMethodBody :: SkolemInfo -> [TcTyVar] -> [EvVar]
                      -> Id -> TcSigInfo
-          	     -> TcSpecPrags -> (Origin, LHsBind Name)
-          	     -> TcM (Origin, LHsBind Id)
+          	     -> TcSpecPrags -> LHsBind Name
+          	     -> TcM (LHsBind Id)
 tcInstanceMethodBody skol_info tyvars dfun_ev_vars
                      meth_id local_meth_sig
-		     specs (origin, (L loc bind))
+		     specs (L loc bind)
   = do	{ let local_meth_id = sig_id local_meth_sig
               lm_bind = L loc (bind { fun_id = L loc (idName local_meth_id) })
                              -- Substitute the local_meth_name for the binder
 			     -- NB: the binding is always a FunBind
 	; (ev_binds, (tc_bind, _, _)) 
                <- checkConstraints skol_info tyvars dfun_ev_vars $
-	          tcPolyCheck NonRecursive no_prag_fn local_meth_sig (origin, lm_bind)
+	          tcPolyCheck NonRecursive no_prag_fn local_meth_sig lm_bind
 
         ; let export = ABE { abe_wrap = idHsWrapper, abe_poly = meth_id
                            , abe_mono = local_meth_id, abe_prags = specs }
@@ -258,7 +259,7 @@ tcInstanceMethodBody skol_info tyvars dfun_ev_vars
                                    , abs_ev_binds = ev_binds
                                    , abs_binds = tc_bind }
 
-        ; return (origin, L loc full_bind) } 
+        ; return (L loc full_bind) } 
   where
     no_prag_fn  _ = []		-- No pragmas for local_meth_id; 
     		    		-- they are all for meth_id
@@ -326,14 +327,14 @@ lookupHsSig = lookupNameEnv
 ---------------------------
 findMethodBind	:: Name  	        -- Selector name
           	-> LHsBinds Name 	-- A group of bindings
-		-> Maybe ((Origin, LHsBind Name), SrcSpan)
+		-> Maybe (LHsBind Name, SrcSpan)
           	-- Returns the binding, and the binding 
                 -- site of the method binder
 findMethodBind sel_name binds
   = foldlBag mplus Nothing (mapBag f binds)
-  where 
-    f bind@(_, L _ (FunBind { fun_id = L bndr_loc op_name }))
-             | op_name == sel_name
+  where
+    f bind@(L _ (FunBind { fun_id = L bndr_loc op_name }))
+      | op_name == sel_name
     	     = Just (bind, bndr_loc)
     f _other = Nothing
 
@@ -341,8 +342,9 @@ findMethodBind sel_name binds
 findMinimalDef :: [LSig Name] -> Maybe ClassMinimalDef
 findMinimalDef = firstJusts . map toMinimalDef
   where
+    toMinimalDef :: LSig Name -> Maybe ClassMinimalDef
     toMinimalDef (L _ (MinimalSig bf)) = Just (fmap unLoc bf)
-    toMinimalDef _ = Nothing
+    toMinimalDef _                     = Nothing
 \end{code}
 
 Note [Polymorphic methods]
diff --git a/compiler/typecheck/TcDefaults.lhs b/compiler/typecheck/TcDefaults.lhs
index d05a9485f826..7b5bd27321e4 100644
--- a/compiler/typecheck/TcDefaults.lhs
+++ b/compiler/typecheck/TcDefaults.lhs
@@ -5,7 +5,7 @@
 \section[TcDefaults]{Typechecking \tr{default} declarations}
 
 \begin{code}
-{-# OPTIONS -fno-warn-tabs #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
 -- The above warning supression flag is a temporary kludge.
 -- While working on this module you are encouraged to remove it and
 -- detab the module (please do the detabbing in a separate patch). See
@@ -39,7 +39,7 @@ tcDefaults :: [LDefaultDecl Name]
 tcDefaults [] 
   = getDeclaredDefaultTys	-- No default declaration, so get the
 				-- default types from the envt; 
-				-- i.e. use the curent ones
+				-- i.e. use the current ones
 				-- (the caller will put them back there)
 	-- It's important not to return defaultDefaultTys here (which
 	-- we used to do) because in a TH program, tcDefaults [] is called
diff --git a/compiler/typecheck/TcDeriv.lhs b/compiler/typecheck/TcDeriv.lhs
index db79061e2f19..6812ac738756 100644
--- a/compiler/typecheck/TcDeriv.lhs
+++ b/compiler/typecheck/TcDeriv.lhs
@@ -6,6 +6,8 @@
 Handles @deriving@ clauses on @data@ declarations.
 
 \begin{code}
+{-# LANGUAGE CPP #-}
+
 module TcDeriv ( tcDeriving ) where
 
 #include "HsVersions.h"
@@ -18,7 +20,7 @@ import FamInst
 import TcErrors( reportAllUnsolved )
 import TcValidity( validDerivPred )
 import TcEnv
-import TcTyClsDecls( tcFamTyPats, tcAddDataFamInstCtxt )
+import TcTyClsDecls( tcFamTyPats, famTyConShape, tcAddDataFamInstCtxt, kcDataDefn )
 import TcClassDcl( tcAddDeclCtxt )      -- Small helper
 import TcGenDeriv                       -- Deriv stuff
 import TcGenGenerics
@@ -36,7 +38,7 @@ import RnSource   ( addTcgDUs )
 import HscTypes
 import Avail
 
-import Unify( tcMatchTy )
+import Unify( tcUnifyTy )
 import Id( idType )
 import Class
 import Type
@@ -60,7 +62,6 @@ import Outputable
 import FastString
 import Bag
 import Pair
-import BasicTypes (Origin(..))
 
 import Control.Monad
 import Data.List
@@ -85,13 +86,14 @@ Overall plan
 \begin{code}
 -- DerivSpec is purely  local to this module
 data DerivSpec theta = DS { ds_loc     :: SrcSpan
-                          , ds_name    :: Name
+                          , ds_name    :: Name           -- DFun name
                           , ds_tvs     :: [TyVar]
                           , ds_theta   :: theta
                           , ds_cls     :: Class
                           , ds_tys     :: [Type]
                           , ds_tc      :: TyCon
                           , ds_tc_args :: [Type]
+                          , ds_overlap :: Maybe OverlapMode
                           , ds_newtype :: Bool }
         -- This spec implies a dfun declaration of the form
         --       df :: forall tvs. theta => C tys
@@ -105,7 +107,7 @@ data DerivSpec theta = DS { ds_loc     :: SrcSpan
         -- the theta is either the given and final theta, in standalone deriving,
         -- or the not-yet-simplified list of constraints together with their origin
 
-        -- ds_newtype = True  <=> Newtype deriving
+        -- ds_newtype = True  <=> Generalised Newtype Deriving (GND)
         --              False <=> Vanilla deriving
 \end{code}
 
@@ -158,6 +160,10 @@ earlyDSLoc :: EarlyDerivSpec -> SrcSpan
 earlyDSLoc (InferTheta spec) = ds_loc spec
 earlyDSLoc (GivenTheta spec) = ds_loc spec
 
+earlyDSClass :: EarlyDerivSpec -> Class
+earlyDSClass (InferTheta spec) = ds_cls spec
+earlyDSClass (GivenTheta spec) = ds_cls spec
+
 splitEarlyDerivSpec :: [EarlyDerivSpec] -> ([DerivSpec ThetaOrigin], [DerivSpec ThetaType])
 splitEarlyDerivSpec [] = ([],[])
 splitEarlyDerivSpec (InferTheta spec : specs) =
@@ -437,7 +443,7 @@ commonAuxiliaries = foldM snoc ([], emptyBag) where
 
 renameDeriv :: Bool
             -> [InstInfo RdrName]
-            -> Bag ((Origin, LHsBind RdrName), LSig RdrName)
+            -> Bag (LHsBind RdrName, LSig RdrName)
             -> TcM (Bag (InstInfo Name), HsValBinds Name, DefUses)
 renameDeriv is_boot inst_infos bagBinds
   | is_boot     -- If we are compiling a hs-boot file, don't generate any derived bindings
@@ -469,11 +475,13 @@ renameDeriv is_boot inst_infos bagBinds
 
   where
     rn_inst_info :: InstInfo RdrName -> TcM (InstInfo Name, FreeVars)
-    rn_inst_info inst_info@(InstInfo { iSpec = inst
-                                     , iBinds = InstBindings
-                                                  { ib_binds = binds
-                                                  , ib_pragmas = sigs
-                                                  , ib_standalone_deriving = sa } })
+    rn_inst_info
+      inst_info@(InstInfo { iSpec = inst
+                          , iBinds = InstBindings
+                            { ib_binds = binds
+                            , ib_pragmas = sigs
+                            , ib_extensions = exts -- only for type-checking
+                            , ib_standalone_deriving = sa } })
         =       -- Bring the right type variables into
                 -- scope (yuk), and rename the method binds
            ASSERT( null sigs )
@@ -481,6 +489,7 @@ renameDeriv is_boot inst_infos bagBinds
            do { (rn_binds, fvs) <- rnMethodBinds (is_cls_nm inst) (\_ -> []) binds
               ; let binds' = InstBindings { ib_binds = rn_binds
                                            , ib_pragmas = []
+                                           , ib_extensions = exts
                                            , ib_standalone_deriving = sa }
               ; return (inst_info { iBinds = binds' }, fvs) }
         where
@@ -521,66 +530,60 @@ makeDerivSpecs :: Bool
                -> [LDerivDecl Name]
                -> TcM [EarlyDerivSpec]
 makeDerivSpecs is_boot tycl_decls inst_decls deriv_decls
-  = do  { eqns1 <- concatMapM (recoverM (return []) . deriveTyDecl)   tycl_decls
-        ; eqns2 <- concatMapM (recoverM (return []) . deriveInstDecl) inst_decls
-        ; eqns3 <- mapAndRecoverM deriveStandalone deriv_decls
-        ; let eqns = eqns1 ++ eqns2 ++ eqns3
+  = do  { eqns1 <- concatMapM (recoverM (return []) . deriveTyDecl)     tycl_decls
+        ; eqns2 <- concatMapM (recoverM (return []) . deriveInstDecl)   inst_decls
+        ; eqns3 <- concatMapM (recoverM (return []) . deriveStandalone) deriv_decls
 
         -- If AutoDeriveTypeable is set, we automatically add Typeable instances
         -- for every data type and type class declared in the module
-        ; isAutoTypeable <- xoptM Opt_AutoDeriveTypeable
-        ; let eqns4 = if isAutoTypeable then deriveTypeable tycl_decls eqns else []
-        ; eqns4' <- mapAndRecoverM deriveStandalone eqns4
-        ; let eqns' = eqns ++ eqns4'
+       ; auto_typeable <- xoptM Opt_AutoDeriveTypeable
+       ; eqns4 <- deriveAutoTypeable auto_typeable (eqns1 ++ eqns3) tycl_decls
+
+        ; let eqns = eqns1 ++ eqns2 ++ eqns3 ++ eqns4
 
         ; if is_boot then   -- No 'deriving' at all in hs-boot files
-              do { unless (null eqns') (add_deriv_err (head eqns'))
+              do { unless (null eqns) (add_deriv_err (head eqns))
                  ; return [] }
-          else return eqns' }
+          else return eqns }
   where
-    deriveTypeable :: [LTyClDecl Name] -> [EarlyDerivSpec] -> [LDerivDecl Name]
-    deriveTypeable tys dss =
-      [ L l (DerivDecl (L l (HsAppTy (noLoc (HsTyVar typeableClassName))
-                                     (L l (HsTyVar (tcdName t))))))
-      | L l t <- tys
-        -- Don't add Typeable instances for type synonyms and type families
-      , not (isSynDecl t), not (isTypeFamilyDecl t)
-        -- ... nor if the user has already given a deriving clause
-      , not (hasInstance (tcdName t) dss) ]
-
-    -- Check if an automatically generated DS for deriving Typeable should be
-    -- ommitted because the user had manually requested for an instance
-    hasInstance :: Name -> [EarlyDerivSpec] -> Bool
-    hasInstance n = any (\ds -> n == tyConName (earlyDSTyCon ds))
-
     add_deriv_err eqn
        = setSrcSpan (earlyDSLoc eqn) $
          addErr (hang (ptext (sLit "Deriving not permitted in hs-boot file"))
                     2 (ptext (sLit "Use an instance declaration instead")))
 
+deriveAutoTypeable :: Bool -> [EarlyDerivSpec] -> [LTyClDecl Name] -> TcM [EarlyDerivSpec]
+-- Runs over *all* TyCl declarations, including classes and data families
+-- i.e. not just data type decls
+deriveAutoTypeable auto_typeable done_specs tycl_decls
+  | not auto_typeable = return []
+  | otherwise         = do { cls <- tcLookupClass typeableClassName
+                           ; concatMapM (do_one cls) tycl_decls }
+  where
+    done_tcs = mkNameSet [ tyConName (earlyDSTyCon spec)
+                         | spec <- done_specs
+                         , className (earlyDSClass spec) == typeableClassName ]
+        -- Check if an automatically generated DS for deriving Typeable should be
+        -- ommitted because the user had manually requested an instance
+
+    do_one cls (L _ decl)
+      = do { tc <- tcLookupTyCon (tcdName decl)
+           ; if (isSynTyCon tc || tyConName tc `elemNameSet` done_tcs)
+                 -- Do not derive Typeable for type synonyms or type families
+             then return []
+             else mkPolyKindedTypeableEqn cls tc }
+
 ------------------------------------------------------------------
 deriveTyDecl :: LTyClDecl Name -> TcM [EarlyDerivSpec]
-deriveTyDecl (L _ decl@(DataDecl { tcdLName = L loc tc_name
+deriveTyDecl (L _ decl@(DataDecl { tcdLName = L _ tc_name
                                  , tcdDataDefn = HsDataDefn { dd_derivs = preds } }))
   = tcAddDeclCtxt decl $
     do { tc <- tcLookupTyCon tc_name
        ; let tvs  = tyConTyVars tc
              tys  = mkTyVarTys tvs
-             pdcs :: [LDerivDecl Name]
-             pdcs = [ L loc (DerivDecl (L loc (HsAppTy (noLoc (HsTyVar typeableClassName))
-                                       (L loc (HsTyVar (tyConName pdc))))))
-                    | Just pdc <- map promoteDataCon_maybe (tyConDataCons tc) ]
-        -- If AutoDeriveTypeable and DataKinds is set, we add Typeable instances
-        -- for every promoted data constructor of datatypes in this module
-       ; isAutoTypeable <- xoptM Opt_AutoDeriveTypeable
-       ; isDataKinds    <- xoptM Opt_DataKinds
-       ; prom_dcs_Typeable_instances <- if isAutoTypeable && isDataKinds
-                                        then mapM deriveStandalone pdcs
-                                        else return []
-       ; other_instances <- case preds of
-                              Just preds' -> mapM (deriveTyData tvs tc tys) preds'
-                              Nothing     -> return []
-       ; return (prom_dcs_Typeable_instances ++ other_instances) }
+
+       ; case preds of
+           Just preds' -> concatMapM (deriveTyData False tvs tc tys) preds'
+           Nothing     -> return [] }
 
 deriveTyDecl _ = return []
 
@@ -595,32 +598,49 @@ deriveInstDecl (L _ (ClsInstD { cid_inst = ClsInstDecl { cid_datafam_insts = fam
 ------------------------------------------------------------------
 deriveFamInst :: DataFamInstDecl Name -> TcM [EarlyDerivSpec]
 deriveFamInst decl@(DataFamInstDecl { dfid_tycon = L _ tc_name, dfid_pats = pats
-                                    , dfid_defn = HsDataDefn { dd_derivs = Just preds } })
+                                    , dfid_defn = defn@(HsDataDefn { dd_derivs = Just preds }) })
   = tcAddDataFamInstCtxt decl $
     do { fam_tc <- tcLookupTyCon tc_name
-       ; tcFamTyPats tc_name (tyConKind fam_tc) pats (\_ -> return ()) $
+       ; tcFamTyPats (famTyConShape fam_tc) pats (kcDataDefn defn) $
+             -- kcDataDefn defn: see Note [Finding the LHS patterns]
          \ tvs' pats' _ ->
-           mapM (deriveTyData tvs' fam_tc pats') preds }
-        -- Tiresomely we must figure out the "lhs", which is awkward for type families
-        -- E.g.   data T a b = .. deriving( Eq )
-        --          Here, the lhs is (T a b)
-        --        data instance TF Int b = ... deriving( Eq )
-        --          Here, the lhs is (TF Int b)
-        -- But if we just look up the tycon_name, we get is the *family*
-        -- tycon, but not pattern types -- they are in the *rep* tycon.
+           concatMapM (deriveTyData True tvs' fam_tc pats') preds }
 
 deriveFamInst _ = return []
+\end{code}
+
+Note [Finding the LHS patterns]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+When kind polymorphism is in play, we need to be careful.  Here is
+Trac #9359:
+  data Cmp a where
+    Sup :: Cmp a
+    V   :: a -> Cmp a
+
+  data family   CmpInterval (a :: Cmp k) (b :: Cmp k) :: *
+  data instance CmpInterval (V c) Sup = Starting c deriving( Show )
+
+So CmpInterval is kind-polymorphic, but the data instance is not
+   CmpInterval :: forall k. Cmp k -> Cmp k -> *
+   data instance CmpInterval * (V (c::*)) Sup = Starting c deriving( Show )
 
+Hence, when deriving the type patterns in deriveFamInst, we must kind
+check the RHS (the data constructor 'Starting c') as well as the LHS,
+so that we correctly see the instantiation to *.
+
+
+\begin{code}
 ------------------------------------------------------------------
-deriveStandalone :: LDerivDecl Name -> TcM EarlyDerivSpec
+deriveStandalone :: LDerivDecl Name -> TcM [EarlyDerivSpec]
 -- Standalone deriving declarations
 --  e.g.   deriving instance Show a => Show (T a)
 -- Rather like tcLocalInstDecl
-deriveStandalone (L loc (DerivDecl deriv_ty))
+deriveStandalone (L loc (DerivDecl deriv_ty overlap_mode))
   = setSrcSpan loc                   $
     addErrCtxt (standaloneCtxt deriv_ty)  $
     do { traceTc "Standalone deriving decl for" (ppr deriv_ty)
-       ; (tvs, theta, cls, inst_tys) <- tcHsInstHead TcType.InstDeclCtxt deriv_ty
+       ; (tvs, theta, cls, inst_tys) <- setXOptM Opt_DataKinds $ -- for polykinded typeable
+                                        tcHsInstHead TcType.InstDeclCtxt deriv_ty
        ; traceTc "Standalone deriving;" $ vcat
               [ text "tvs:" <+> ppr tvs
               , text "theta:" <+> ppr theta
@@ -637,25 +657,74 @@ deriveStandalone (L loc (DerivDecl deriv_ty))
               , text "type:" <+> ppr inst_ty ]
 
        ; case tcSplitTyConApp_maybe inst_ty of
-           Just (tycon, tc_args)
-              | className cls == typeableClassName || isAlgTyCon tycon
-              -> mkEqnHelp tvs cls cls_tys tycon tc_args (Just theta)
+           Just (tc, tc_args)
+              | className cls == typeableClassName  -- Works for algebraic TyCons
+                                                    -- _and_ data families
+              -> do { check_standalone_typeable theta tc tc_args
+                    ; mkPolyKindedTypeableEqn cls tc }
+
+              | isAlgTyCon tc  -- All other classes
+              -> do { spec <- mkEqnHelp overlap_mode tvs cls cls_tys tc tc_args (Just theta)
+                    ; return [spec] }
 
            _  -> -- Complain about functions, primitive types, etc,
                  -- except for the Typeable class
                  failWithTc $ derivingThingErr False cls cls_tys inst_ty $
                  ptext (sLit "The last argument of the instance must be a data or newtype application")
         }
+  where
+    check_standalone_typeable theta tc tc_args
+             -- We expect to see
+             --       deriving Typeable <kind> T
+             -- for some tycon T.  But if S is kind-polymorphic,
+             -- say (S :: forall k. k -> *), we might see
+             --       deriving Typable <kind> (S k)
+             --
+             -- But we should NOT see
+             --       deriving Typeable <kind> (T Int)
+             -- or    deriving Typeable <kind> (S *)   where S is kind-polymorphic
+             --
+             -- So all the tc_args should be distinct kind variables
+      | null theta
+      , allDistinctTyVars tc_args
+      , all is_kind_var tc_args
+      = return ()
+
+      | otherwise
+      = do { polykinds <- xoptM Opt_PolyKinds
+           ; failWith (mk_msg polykinds theta tc tc_args) }
+
+    is_kind_var tc_arg = case tcGetTyVar_maybe tc_arg of
+                           Just v  -> isKindVar v
+                           Nothing -> False
+
+    mk_msg polykinds theta tc tc_args
+      | not polykinds
+      , all isKind tc_args   -- Non-empty, all kinds, at least one not a kind variable
+      , null theta
+      = hang (ptext (sLit "To make a Typeable instance of poly-kinded")
+               <+> quotes (ppr tc) <> comma)
+           2 (ptext (sLit "use XPolyKinds"))
+
+      | otherwise
+      = hang (ptext (sLit "Derived Typeable instance must be of form"))
+           2 (ptext (sLit "deriving instance Typeable") <+> ppr tc)
+
 
 ------------------------------------------------------------------
-deriveTyData :: [TyVar] -> TyCon -> [Type]   -- LHS of data or data instance
+deriveTyData :: Bool                         -- False <=> data/newtype
+                                             -- True  <=> data/newtype *instance*
+             -> [TyVar] -> TyCon -> [Type]   -- LHS of data or data instance
+                                             --   Can be a data instance, hence [Type] args
              -> LHsType Name                 -- The deriving predicate
-             -> TcM EarlyDerivSpec
+             -> TcM [EarlyDerivSpec]
 -- The deriving clause of a data or newtype declaration
-deriveTyData tvs tc tc_args (L loc deriv_pred)
+-- I.e. not standalone deriving
+deriveTyData is_instance tvs tc tc_args (L loc deriv_pred)
   = setSrcSpan loc     $        -- Use the location of the 'deriving' item
-    do  { (deriv_tvs, cls, cls_tys) <- tcExtendTyVarEnv tvs $
-                                       tcHsDeriv deriv_pred
+    do  { (deriv_tvs, cls, cls_tys, cls_arg_kind)
+                <- tcExtendTyVarEnv tvs $
+                   tcHsDeriv deriv_pred
                 -- Deriving preds may (now) mention
                 -- the type variables for the type constructor, hence tcExtendTyVarenv
                 -- The "deriv_pred" is a LHsType to take account of the fact that for
@@ -665,43 +734,47 @@ deriveTyData tvs tc tc_args (L loc deriv_pred)
                 -- so the argument kind 'k' is not decomposable by splitKindFunTys
                 -- as is the case for all other derivable type classes
         ; if className cls == typeableClassName
-          then derivePolyKindedTypeable cls cls_tys tvs tc tc_args
-          else do {
-
-        -- Given data T a b c = ... deriving( C d ),
-        -- we want to drop type variables from T so that (C d (T a)) is well-kinded
-        ; let cls_tyvars     = classTyVars cls
-        ; checkTc (not (null cls_tyvars)) derivingNullaryErr
+          then derivePolyKindedTypeable is_instance cls cls_tys tvs tc tc_args
+          else
 
-        ; let kind            = tyVarKind (last cls_tyvars)
-              (arg_kinds, _)  = splitKindFunTys kind
+     do {  -- Given data T a b c = ... deriving( C d ),
+           -- we want to drop type variables from T so that (C d (T a)) is well-kinded
+          let (arg_kinds, _)  = splitKindFunTys cls_arg_kind
               n_args_to_drop  = length arg_kinds
               n_args_to_keep  = tyConArity tc - n_args_to_drop
               args_to_drop    = drop n_args_to_keep tc_args
               tc_args_to_keep = take n_args_to_keep tc_args
               inst_ty_kind    = typeKind (mkTyConApp tc tc_args_to_keep)
               dropped_tvs     = tyVarsOfTypes args_to_drop
-              tv_set          = mkVarSet tvs
-              mb_match        = tcMatchTy tv_set inst_ty_kind kind
-              Just subst      = mb_match   -- See Note [Match kinds in deriving]
 
-              final_tc_args   = substTys subst tc_args_to_keep
-              univ_tvs        = mkVarSet deriv_tvs `unionVarSet` tyVarsOfTypes final_tc_args
-
-        ; traceTc "derivTyData1" (vcat [ pprTvBndrs tvs, ppr tc, ppr tc_args
+              -- Match up the kinds, and apply the resulting kind substitution
+              -- to the types.  See Note [Unify kinds in deriving]
+              -- We are assuming the tycon tyvars and the class tyvars are distinct
+              mb_match        = tcUnifyTy inst_ty_kind cls_arg_kind
+              Just kind_subst = mb_match
+              (univ_kvs, univ_tvs) = partition isKindVar $ varSetElems $
+                                     mkVarSet deriv_tvs `unionVarSet`
+                                     tyVarsOfTypes tc_args_to_keep
+              univ_kvs'           = filter (`notElemTvSubst` kind_subst) univ_kvs
+              (subst', univ_tvs') = mapAccumL substTyVarBndr kind_subst univ_tvs
+              final_tc_args       = substTys subst' tc_args_to_keep
+              final_cls_tys       = substTys subst' cls_tys
+
+        ; traceTc "derivTyData1" (vcat [ pprTvBndrs tvs, ppr tc, ppr tc_args, ppr deriv_pred
                                        , pprTvBndrs (varSetElems $ tyVarsOfTypes tc_args)
                                        , ppr n_args_to_keep, ppr n_args_to_drop
-                                       , ppr inst_ty_kind, ppr kind, ppr mb_match ])
+                                       , ppr inst_ty_kind, ppr cls_arg_kind, ppr mb_match
+                                       , ppr final_tc_args, ppr final_cls_tys ])
 
         -- Check that the result really is well-kinded
         ; checkTc (n_args_to_keep >= 0 && isJust mb_match)
-                  (derivingKindErr tc cls cls_tys kind)
+                  (derivingKindErr tc cls cls_tys cls_arg_kind)
 
         ; traceTc "derivTyData2" (vcat [ ppr univ_tvs ])
 
-        ; checkTc (allDistinctTyVars args_to_drop &&            -- (a) and (b)
-                   univ_tvs `disjointVarSet` dropped_tvs)       -- (c)
-                  (derivingEtaErr cls cls_tys (mkTyConApp tc final_tc_args))
+        ; checkTc (allDistinctTyVars args_to_drop &&              -- (a) and (b)
+                   not (any (`elemVarSet` dropped_tvs) univ_tvs)) -- (c)
+                  (derivingEtaErr cls final_cls_tys (mkTyConApp tc final_tc_args))
                 -- Check that
                 --  (a) The args to drop are all type variables; eg reject:
                 --              data instance T a Int = .... deriving( Monad )
@@ -713,36 +786,32 @@ deriveTyData tvs tc tc_args (L loc deriv_pred)
                 --              newtype T a s = ... deriving( ST s )
                 --              newtype K a a = ... deriving( Monad )
 
-        ; mkEqnHelp (varSetElemsKvsFirst univ_tvs)
-                    cls cls_tys tc final_tc_args Nothing } }
+        ; spec <- mkEqnHelp Nothing (univ_kvs' ++ univ_tvs')
+                            cls final_cls_tys tc final_tc_args Nothing 
+        ; return [spec] } }
 
-derivePolyKindedTypeable :: Class -> [Type]
+derivePolyKindedTypeable :: Bool -> Class -> [Type]
                          -> [TyVar] -> TyCon -> [Type]
-                         -> TcM EarlyDerivSpec
-derivePolyKindedTypeable cls cls_tys _tvs tc tc_args
-  = do { checkTc (isSingleton cls_tys) $   -- Typeable k
+                         -> TcM [EarlyDerivSpec]
+-- The deriving( Typeable ) clause of a data/newtype decl
+-- I.e. not standalone deriving
+derivePolyKindedTypeable is_instance cls cls_tys _tvs tc tc_args
+  | is_instance
+  = failWith (sep [ ptext (sLit "Deriving Typeable is not allowed for family instances;")
+                  , ptext (sLit "derive Typeable for")
+                    <+> quotes (pprSourceTyCon tc)
+                    <+> ptext (sLit "alone") ])
+
+  | otherwise
+  = ASSERT( allDistinctTyVars tc_args )  -- Came from a data/newtype decl
+    do { checkTc (isSingleton cls_tys) $   -- Typeable k
          derivingThingErr False cls cls_tys (mkTyConApp tc tc_args)
                           (classArgsErr cls cls_tys)
 
-       -- Check that we have not said, for example
-       --       deriving Typeable (T Int)
-       -- or    deriving Typeable (S :: * -> *)     where S is kind-polymorphic
-       ; checkTc (allDistinctTyVars tc_args) $
-         derivingEtaErr cls cls_tys (mkTyConApp tc tc_kind_args)
-
-       ; mkEqnHelp kind_vars cls cls_tys tc tc_kind_args Nothing }
-  where
-    kind_vars    = kindVarsOnly tc_args
-    tc_kind_args = mkTyVarTys kind_vars
-
-    kindVarsOnly :: [Type] -> [KindVar]
-    kindVarsOnly [] = []
-    kindVarsOnly (t:ts) | Just v <- getTyVar_maybe t
-                        , isKindVar v = v : kindVarsOnly ts
-                        | otherwise   =     kindVarsOnly ts
+       ; mkPolyKindedTypeableEqn cls tc }
 \end{code}
 
-Note [Match kinds in deriving]
+Note [Unify kinds in deriving]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 Consider (Trac #8534)
     data T a b = MkT a deriving( Functor )
@@ -752,16 +821,55 @@ So T :: forall k. * -> k -> *.   We want to get
     instance Functor (T * (a:*)) where ...
 Notice the '*' argument to T.
 
-So we need to (a) drop arguments from (T a b) to match the number of
-arrows in the (last argument of the) class; and then match kind of the
-remaining type against the expected kind, to figur out how to
-instantiate T's kind arguments.  Hence we match 
-   kind( T k (a:k) ) ~ (* -> *)
-to find k:=*.  Tricky stuff.
+Moreover, as well as instantiating T's kind arguments, we may need to instantiate
+C's kind args.  Consider (Trac #8865):
+  newtype T a b = MkT (Either a b) deriving( Category )
+where
+  Category :: forall k. (k -> k -> *) -> Constraint
+We need to generate the instance
+  insatnce Category * (Either a) where ...
+Notice the '*' argument to Cagegory.
+
+So we need to
+ * drop arguments from (T a b) to match the number of
+   arrows in the (last argument of the) class;
+ * and then *unify* kind of the remaining type against the
+   expected kind, to figure out how to instantiate C's and T's
+   kind arguments.
+
+In the two examples,
+ * we unify   kind-of( T k (a:k) ) ~ kind-of( Functor )
+         i.e.      (k -> *) ~ (* -> *)   to find k:=*.
+         yielding  k:=*
+
+ * we unify   kind-of( Either ) ~ kind-of( Category )
+         i.e.      (* -> * -> *)  ~ (k -> k -> k)
+         yielding  k:=*
+
+Now we get a kind substitution.  We then need to:
+
+  1. Remove the substituted-out kind variables from the quantified kind vars
+
+  2. Apply the substitution to the kinds of quantified *type* vars
+     (and extend the substitution to reflect this change)
+
+  3. Apply that extended substitution to the non-dropped args (types and
+     kinds) of the type and class
+
+Forgetting step (2) caused Trac #8893:
+  data V a = V [a] deriving Functor
+  data P (x::k->*) (a:k) = P (x a) deriving Functor
+  data C (x::k->*) (a:k) = C (V (P x a)) deriving Functor
+
+When deriving Functor for P, we unify k to *, but we then want
+an instance   $df :: forall (x:*->*). Functor x => Functor (P * (x:*->*))
+and similarly for C.  Notice the modified kind of x, both at binding
+and occurrence sites.
 
 
 \begin{code}
-mkEqnHelp :: [TyVar]
+mkEqnHelp :: Maybe OverlapMode
+          -> [TyVar]
           -> Class -> [Type]
           -> TyCon -> [Type]
           -> DerivContext       -- Just    => context supplied (standalone deriving)
@@ -772,18 +880,12 @@ mkEqnHelp :: [TyVar]
 -- where the 'theta' is optional (that's the Maybe part)
 -- Assumes that this declaration is well-kinded
 
-mkEqnHelp tvs cls cls_tys tycon tc_args mtheta
+mkEqnHelp overlap_mode tvs cls cls_tys tycon tc_args mtheta
   | className cls `elem` oldTypeableClassNames
   = do { dflags <- getDynFlags
        ; case checkOldTypeableConditions (dflags, tycon, tc_args) of
-           Just err -> bale_out err
-           Nothing  -> mkOldTypeableEqn tvs cls tycon tc_args mtheta }
-
-  | className cls == typeableClassName  -- Polykinded Typeable
-  = do { dflags <- getDynFlags
-       ; case checkTypeableConditions (dflags, tycon, tc_args) of
-           Just err -> bale_out err
-           Nothing  -> mkPolyKindedTypeableEqn tvs cls tycon tc_args mtheta }
+           NotValid err -> bale_out err
+           IsValid      -> mkOldTypeableEqn tvs cls tycon tc_args mtheta }
 
   | otherwise
   = do { (rep_tc, rep_tc_args) <- lookup_data_fam tycon tc_args
@@ -814,10 +916,10 @@ mkEqnHelp tvs cls cls_tys tycon tc_args mtheta
 
        ; dflags <- getDynFlags
        ; if isDataTyCon rep_tc then
-            mkDataTypeEqn dflags tvs cls cls_tys
+            mkDataTypeEqn dflags overlap_mode tvs cls cls_tys
                           tycon tc_args rep_tc rep_tc_args mtheta
          else
-            mkNewTypeEqn dflags tvs cls cls_tys
+            mkNewTypeEqn dflags overlap_mode tvs cls cls_tys
                          tycon tc_args rep_tc rep_tc_args mtheta }
   where
      bale_out msg = failWithTc (derivingThingErr False cls cls_tys (mkTyConApp tycon tc_args) msg)
@@ -907,6 +1009,7 @@ See Note [Eta reduction for data family axioms] in TcInstDcls.
 
 \begin{code}
 mkDataTypeEqn :: DynFlags
+              -> Maybe OverlapMode
               -> [Var]                  -- Universally quantified type variables in the instance
               -> Class                  -- Class for which we need to derive an instance
               -> [Type]                 -- Other parameters to the class except the last
@@ -918,7 +1021,7 @@ mkDataTypeEqn :: DynFlags
               -> DerivContext        -- Context of the instance, for standalone deriving
               -> TcRn EarlyDerivSpec    -- Return 'Nothing' if error
 
-mkDataTypeEqn dflags tvs cls cls_tys
+mkDataTypeEqn dflags overlap_mode tvs cls cls_tys
               tycon tc_args rep_tc rep_tc_args mtheta
   = case checkSideConditions dflags mtheta cls cls_tys rep_tc rep_tc_args of
         -- NB: pass the *representation* tycon to checkSideConditions
@@ -926,13 +1029,13 @@ mkDataTypeEqn dflags tvs cls cls_tys
         NonDerivableClass       -> bale_out (nonStdErr cls)
         DerivableClassError msg -> bale_out msg
   where
-    go_for_it    = mk_data_eqn tvs cls tycon tc_args rep_tc rep_tc_args mtheta
+    go_for_it    = mk_data_eqn overlap_mode tvs cls tycon tc_args rep_tc rep_tc_args mtheta
     bale_out msg = failWithTc (derivingThingErr False cls cls_tys (mkTyConApp tycon tc_args) msg)
 
-mk_data_eqn :: [TyVar] -> Class
+mk_data_eqn :: Maybe OverlapMode -> [TyVar] -> Class
             -> TyCon -> [TcType] -> TyCon -> [TcType] -> DerivContext
             -> TcM EarlyDerivSpec
-mk_data_eqn tvs cls tycon tc_args rep_tc rep_tc_args mtheta
+mk_data_eqn overlap_mode tvs cls tycon tc_args rep_tc rep_tc_args mtheta
   = do loc                  <- getSrcSpanM
        dfun_name            <- new_dfun_name cls tycon
        case mtheta of
@@ -944,6 +1047,7 @@ mk_data_eqn tvs cls tycon tc_args rep_tc rep_tc_args mtheta
                    , ds_cls = cls, ds_tys = inst_tys
                    , ds_tc = rep_tc, ds_tc_args = rep_tc_args
                    , ds_theta = inferred_constraints
+                   , ds_overlap = overlap_mode
                    , ds_newtype = False }
         Just theta -> do -- Specified context
             return $ GivenTheta $ DS
@@ -952,6 +1056,7 @@ mk_data_eqn tvs cls tycon tc_args rep_tc rep_tc_args mtheta
                    , ds_cls = cls, ds_tys = inst_tys
                    , ds_tc = rep_tc, ds_tc_args = rep_tc_args
                    , ds_theta = theta
+                   , ds_overlap = overlap_mode
                    , ds_newtype = False }
   where
     inst_tys = [mkTyConApp tycon tc_args]
@@ -989,45 +1094,41 @@ mkOldTypeableEqn tvs cls tycon tc_args mtheta
                   DS { ds_loc = loc, ds_name = dfun_name, ds_tvs = []
                      , ds_cls = cls, ds_tys = [mkTyConApp tycon []]
                      , ds_tc = tycon, ds_tc_args = []
-                     , ds_theta = mtheta `orElse` [], ds_newtype = False })  }
+                     , ds_theta = mtheta `orElse` []
+                     , ds_overlap = Nothing -- Or, Just NoOverlap?
+                     , ds_newtype = False })  }
 
-mkPolyKindedTypeableEqn :: [TyVar] -> Class
-                        -> TyCon -> [TcType] -> DerivContext
-                        -> TcM EarlyDerivSpec
+mkPolyKindedTypeableEqn :: Class -> TyCon -> TcM [EarlyDerivSpec]
 -- We can arrive here from a 'deriving' clause
 -- or from standalone deriving
-mkPolyKindedTypeableEqn tvs cls tycon tc_args mtheta
-  = do  {    -- Check that we have not said, for example
-             --       deriving Typeable (T Int)
-             -- or    deriving Typeable (S :: * -> *)     where S is kind-polymorphic
-
-          polykinds <- xoptM Opt_PolyKinds
-        ; checkTc (all is_kind_var tc_args) (mk_msg polykinds)
-        ; dfun_name <- new_dfun_name cls tycon
-        ; loc <- getSrcSpanM
-        ; let tc_app = mkTyConApp tycon tc_args
-        ; return (GivenTheta $
-                  DS { ds_loc = loc, ds_name = dfun_name
-                     , ds_tvs = filter isKindVar tvs, ds_cls = cls
-                     , ds_tys = typeKind tc_app : [tc_app]
-                         -- Remember, Typeable :: forall k. k -> *
-                     , ds_tc = tycon, ds_tc_args = tc_args
-                     , ds_theta = mtheta `orElse` []  -- Context is empty for polykinded Typeable
-                     , ds_newtype = False })  }
+mkPolyKindedTypeableEqn cls tc
+  = do { dflags <- getDynFlags   -- It's awkward to re-used checkFlag here,
+       ; checkTc(xopt Opt_DeriveDataTypeable dflags) -- so we do a DIY job
+                (hang (ptext (sLit "Can't make a Typeable instance of") <+> quotes (ppr tc))
+                    2 (ptext (sLit "You need DeriveDataTypeable to derive Typeable instances")))
+
+       ; loc <- getSrcSpanM
+       ; let prom_dcs = mapMaybe promoteDataCon_maybe (tyConDataCons tc) 
+       ; mapM (mk_one loc) (tc : prom_dcs) }
   where
-    is_kind_var tc_arg = case tcGetTyVar_maybe tc_arg of
-                           Just v  -> isKindVar v
-                           Nothing -> False
-
-    mk_msg polykinds | not polykinds
-                     , all isKind tc_args   -- Non-empty, all kinds, at least one not a kind variable
-                     = hang (ptext (sLit "To make a Typeable instance of poly-kinded")
-                              <+> quotes (ppr tycon) <> comma)
-                          2 (ptext (sLit "use XPolyKinds"))
-                     | otherwise
-                     = ptext (sLit "Derived Typeable instance must be of form")
-                       <+> parens (ptext (sLit "Typeable") <+> ppr tycon)
-
+     mk_one loc tc = do { traceTc "mkPolyKindedTypeableEqn" (ppr tc)
+                        ; dfun_name <- new_dfun_name cls tc
+                        ; return $ GivenTheta $
+                          DS { ds_loc = loc, ds_name = dfun_name
+                             , ds_tvs = kvs, ds_cls = cls
+                             , ds_tys = [tc_app_kind, tc_app]
+                                 -- Remember, Typeable :: forall k. k -> *
+                                 -- so we must instantiate it appropiately
+                             , ds_tc = tc, ds_tc_args = tc_args
+                             , ds_theta = []  -- Context is empty for polykinded Typeable
+                             , ds_overlap = Nothing
+                               -- Perhaps this should be `Just NoOverlap`?
+
+                             , ds_newtype = False } }
+        where
+          (kvs,tc_app_kind) = splitForAllTys (tyConKind tc)
+          tc_args = mkTyVarTys kvs
+          tc_app  = mkTyConApp tc tc_args
 
 inferConstraints :: Class -> [TcType]
                  -> TyCon -> [TcType]
@@ -1046,21 +1147,23 @@ inferConstraints cls inst_tys rep_tc rep_tc_args
 
   | otherwise  -- The others are a bit more complicated
   = ASSERT2( equalLength rep_tc_tvs all_rep_tc_args, ppr cls <+> ppr rep_tc )
-    return (stupid_constraints ++ extra_constraints
-            ++ sc_constraints
-            ++ con_arg_constraints cls get_std_constrained_tys)
-
+    do { traceTc "inferConstraints" (vcat [ppr cls <+> ppr inst_tys, ppr arg_constraints])
+       ; return (stupid_constraints ++ extra_constraints
+                 ++ sc_constraints
+                 ++ arg_constraints) }
   where
+    arg_constraints = con_arg_constraints cls get_std_constrained_tys
+
        -- Constraints arising from the arguments of each constructor
     con_arg_constraints cls' get_constrained_tys
-      = [ mkPredOrigin (DerivOriginDC data_con arg_n) (mkClassPred cls' [arg_ty])
-        | data_con <- tyConDataCons rep_tc,
-          (arg_n, arg_ty) <-
-                ASSERT( isVanillaDataCon data_con )
-                zip [1..] $
-                get_constrained_tys $
-                dataConInstOrigArgTys data_con all_rep_tc_args,
-          not (isUnLiftedType arg_ty) ]
+      = [ mkPredOrigin (DerivOriginDC data_con arg_n) (mkClassPred cls' [inner_ty])
+        | data_con <- tyConDataCons rep_tc
+        , (arg_n, arg_ty) <- ASSERT( isVanillaDataCon data_con )
+                             zip [1..] $  -- ASSERT is precondition of dataConInstOrigArgTys
+                             dataConInstOrigArgTys data_con all_rep_tc_args
+        , not (isUnLiftedType arg_ty)
+        , inner_ty <- get_constrained_tys arg_ty ]
+
                 -- No constraints for unlifted types
                 -- See Note [Deriving and unboxed types]
 
@@ -1070,10 +1173,10 @@ inferConstraints cls inst_tys rep_tc rep_tc_args
                 -- (b) The rep_tc_args will be one short
     is_functor_like = getUnique cls `elem` functorLikeClassKeys
 
-    get_std_constrained_tys :: [Type] -> [Type]
-    get_std_constrained_tys tys
-        | is_functor_like = concatMap (deepSubtypesContaining last_tv) tys
-        | otherwise       = tys
+    get_std_constrained_tys :: Type -> [Type]
+    get_std_constrained_tys ty
+        | is_functor_like = deepSubtypesContaining last_tv ty
+        | otherwise       = [ty]
 
     rep_tc_tvs = tyConTyVars rep_tc
     last_tv = last rep_tc_tvs
@@ -1141,18 +1244,17 @@ checkSideConditions :: DynFlags -> DerivContext -> Class -> [TcType]
 checkSideConditions dflags mtheta cls cls_tys rep_tc rep_tc_args
   | Just cond <- sideConditions mtheta cls
   = case (cond (dflags, rep_tc, rep_tc_args)) of
-        Just err -> DerivableClassError err     -- Class-specific error
-        Nothing  | null cls_tys -> CanDerive    -- All derivable classes are unary, so
-                                                -- cls_tys (the type args other than last)
-                                                -- should be null
+        NotValid err -> DerivableClassError err  -- Class-specific error
+        IsValid  | null cls_tys -> CanDerive     -- All derivable classes are unary, so
+                                                 -- cls_tys (the type args other than last)
+                                                 -- should be null
                  | otherwise    -> DerivableClassError (classArgsErr cls cls_tys)  -- e.g. deriving( Eq s )
   | otherwise = NonDerivableClass       -- Not a standard class
 
 classArgsErr :: Class -> [Type] -> SDoc
 classArgsErr cls cls_tys = quotes (ppr (mkClassPred cls cls_tys)) <+> ptext (sLit "is not a class")
 
-checkTypeableConditions, checkOldTypeableConditions :: Condition
-checkTypeableConditions    = checkFlag Opt_DeriveDataTypeable `andCond` cond_TypeableOK
+checkOldTypeableConditions :: Condition
 checkOldTypeableConditions = checkFlag Opt_DeriveDataTypeable `andCond` cond_oldTypeableOK
 
 nonStdErr :: Class -> SDoc
@@ -1168,23 +1270,32 @@ sideConditions mtheta cls
   | cls_key == ixClassKey          = Just (cond_std `andCond` cond_enumOrProduct cls)
   | cls_key == boundedClassKey     = Just (cond_std `andCond` cond_enumOrProduct cls)
   | cls_key == dataClassKey        = Just (checkFlag Opt_DeriveDataTypeable `andCond`
-                                           cond_std `andCond` cond_args cls)
+                                           cond_std `andCond`
+                                           cond_args cls)
   | cls_key == functorClassKey     = Just (checkFlag Opt_DeriveFunctor `andCond`
-                                           cond_functorOK True)  -- NB: no cond_std!
+                                           cond_vanilla `andCond`
+                                           cond_functorOK True)
   | cls_key == foldableClassKey    = Just (checkFlag Opt_DeriveFoldable `andCond`
+                                           cond_vanilla `andCond`
                                            cond_functorOK False) -- Functor/Fold/Trav works ok for rank-n types
   | cls_key == traversableClassKey = Just (checkFlag Opt_DeriveTraversable `andCond`
+                                           cond_vanilla `andCond`
                                            cond_functorOK False)
-  | cls_key == genClassKey         = Just (cond_RepresentableOk `andCond`
-                                           checkFlag Opt_DeriveGeneric)
-  | cls_key == gen1ClassKey        = Just (cond_Representable1Ok `andCond`
-                                           checkFlag Opt_DeriveGeneric)
+  | cls_key == genClassKey         = Just (checkFlag Opt_DeriveGeneric `andCond`
+                                           cond_vanilla `andCond`
+                                           cond_RepresentableOk)
+  | cls_key == gen1ClassKey        = Just (checkFlag Opt_DeriveGeneric `andCond`
+                                           cond_vanilla `andCond`
+                                           cond_Representable1Ok)
   | otherwise = Nothing
   where
     cls_key = getUnique cls
-    cond_std = cond_stdOK mtheta
+    cond_std     = cond_stdOK mtheta False  -- Vanilla data constructors, at least one,
+                                            --    and monotype arguments
+    cond_vanilla = cond_stdOK mtheta True   -- Vanilla data constructors but
+                                            --   allow no data cons or polytype arguments
 
-type Condition = (DynFlags, TyCon, [Type]) -> Maybe SDoc
+type Condition = (DynFlags, TyCon, [Type]) -> Validity
         -- first Bool is whether or not we are allowed to derive Data and Typeable
         -- second Bool is whether or not we are allowed to derive Functor
         -- TyCon is the *representation* tycon if the data type is an indexed one
@@ -1193,37 +1304,42 @@ type Condition = (DynFlags, TyCon, [Type]) -> Maybe SDoc
 
 orCond :: Condition -> Condition -> Condition
 orCond c1 c2 tc
-  = case c1 tc of
-        Nothing -> Nothing          -- c1 succeeds
-        Just x  -> case c2 tc of    -- c1 fails
-                     Nothing -> Nothing
-                     Just y  -> Just (x $$ ptext (sLit "  or") $$ y)
-                                    -- Both fail
+  = case (c1 tc, c2 tc) of
+     (IsValid,    _)          -> IsValid    -- c1 succeeds
+     (_,          IsValid)    -> IsValid    -- c21 succeeds
+     (NotValid x, NotValid y) -> NotValid (x $$ ptext (sLit "  or") $$ y)
+                                            -- Both fail
 
 andCond :: Condition -> Condition -> Condition
-andCond c1 c2 tc = case c1 tc of
-                     Nothing -> c2 tc   -- c1 succeeds
-                     Just x  -> Just x  -- c1 fails
-
-cond_stdOK :: DerivContext -> Condition
-cond_stdOK (Just _) _
-  = Nothing     -- Don't check these conservative conditions for
+andCond c1 c2 tc = c1 tc `andValid` c2 tc
+
+cond_stdOK :: DerivContext -- Says whether this is standalone deriving or not;
+                           --     if standalone, we just say "yes, go for it"
+           -> Bool         -- True <=> permissive: allow higher rank
+                           --          args and no data constructors
+           -> Condition
+cond_stdOK (Just _) _ _
+  = IsValid     -- Don't check these conservative conditions for
                 -- standalone deriving; just generate the code
                 -- and let the typechecker handle the result
-cond_stdOK Nothing (_, rep_tc, _)
-  | null data_cons      = Just (no_cons_why rep_tc $$ suggestion)
-  | not (null con_whys) = Just (vcat con_whys $$ suggestion)
-  | otherwise           = Nothing
+cond_stdOK Nothing permissive (_, rep_tc, _)
+  | null data_cons
+  , not permissive      = NotValid (no_cons_why rep_tc $$ suggestion)
+  | not (null con_whys) = NotValid (vcat con_whys $$ suggestion)
+  | otherwise           = IsValid
   where
-    suggestion  = ptext (sLit "Possible fix: use a standalone deriving declaration instead")
-    data_cons   = tyConDataCons rep_tc
-    con_whys = mapCatMaybes check_con data_cons
+    suggestion = ptext (sLit "Possible fix: use a standalone deriving declaration instead")
+    data_cons  = tyConDataCons rep_tc
+    con_whys   = getInvalids (map check_con data_cons)
 
-    check_con :: DataCon -> Maybe SDoc
+    check_con :: DataCon -> Validity
     check_con con
-      | isVanillaDataCon con
-      , all isTauTy (dataConOrigArgTys con) = Nothing
-      | otherwise = Just (badCon con (ptext (sLit "must have a Haskell-98 type")))
+      | not (isVanillaDataCon con)
+      = NotValid (badCon con (ptext (sLit "has existentials or constraints in its type")))
+      | not (permissive || all isTauTy (dataConOrigArgTys con))
+      = NotValid (badCon con (ptext (sLit "has a higher-rank type")))
+      | otherwise
+      = IsValid
 
 no_cons_why :: TyCon -> SDoc
 no_cons_why rep_tc = quotes (pprSourceTyCon rep_tc) <+>
@@ -1241,12 +1357,12 @@ cond_enumOrProduct cls = cond_isEnumeration `orCond`
 
 cond_args :: Class -> Condition
 -- For some classes (eg Eq, Ord) we allow unlifted arg types
--- by generating specilaised code.  For others (eg Data) we don't.
+-- by generating specialised code.  For others (eg Data) we don't.
 cond_args cls (_, tc, _)
   = case bad_args of
-      []      -> Nothing
-      (ty:_) -> Just (hang (ptext (sLit "Don't know how to derive") <+> quotes (ppr cls))
-                         2 (ptext (sLit "for type") <+> quotes (ppr ty)))
+      []     -> IsValid
+      (ty:_) -> NotValid (hang (ptext (sLit "Don't know how to derive") <+> quotes (ppr cls))
+                             2 (ptext (sLit "for type") <+> quotes (ppr ty)))
   where
     bad_args = [ arg_ty | con <- tyConDataCons tc
                         , arg_ty <- dataConOrigArgTys con
@@ -1266,8 +1382,8 @@ cond_args cls (_, tc, _)
 
 cond_isEnumeration :: Condition
 cond_isEnumeration (_, rep_tc, _)
-  | isEnumerationTyCon rep_tc = Nothing
-  | otherwise                 = Just why
+  | isEnumerationTyCon rep_tc = IsValid
+  | otherwise                 = NotValid why
   where
     why = sep [ quotes (pprSourceTyCon rep_tc) <+>
                   ptext (sLit "must be an enumeration type")
@@ -1276,8 +1392,8 @@ cond_isEnumeration (_, rep_tc, _)
 
 cond_isProduct :: Condition
 cond_isProduct (_, rep_tc, _)
-  | isProductTyCon rep_tc = Nothing
-  | otherwise             = Just why
+  | isProductTyCon rep_tc = IsValid
+  | otherwise             = NotValid why
   where
     why = quotes (pprSourceTyCon rep_tc) <+>
           ptext (sLit "must have precisely one constructor")
@@ -1287,30 +1403,16 @@ cond_oldTypeableOK :: Condition
 -- Currently: (a) args all of kind *
 --            (b) 7 or fewer args
 cond_oldTypeableOK (_, tc, _)
-  | tyConArity tc > 7 = Just too_many
+  | tyConArity tc > 7 = NotValid too_many
   | not (all (isSubOpenTypeKind . tyVarKind) (tyConTyVars tc))
-                      = Just bad_kind
-  | otherwise         = Nothing
+                      = NotValid bad_kind
+  | otherwise         = IsValid
   where
     too_many = quotes (pprSourceTyCon tc) <+>
                ptext (sLit "must have 7 or fewer arguments")
     bad_kind = quotes (pprSourceTyCon tc) <+>
                ptext (sLit "must only have arguments of kind `*'")
 
-cond_TypeableOK :: Condition
--- Only not ok if it's a data instance
-cond_TypeableOK (_, tc, tc_args)
-  | isDataFamilyTyCon tc && not (null tc_args)
-  = Just no_families
-
-  | otherwise
-  = Nothing
-  where
-    no_families = sep [ ptext (sLit "Deriving Typeable is not allowed for family instances;")
-                      , ptext (sLit "derive Typeable for")
-                          <+> quotes (pprSourceTyCon tc)
-                          <+> ptext (sLit "alone") ]
-
 functorLikeClassKeys :: [Unique]
 functorLikeClassKeys = [functorClassKey, foldableClassKey, traversableClassKey]
 
@@ -1323,15 +1425,15 @@ cond_functorOK :: Bool -> Condition
 --            (e) no "stupid context" on data type
 cond_functorOK allowFunctions (_, rep_tc, _)
   | null tc_tvs
-  = Just (ptext (sLit "Data type") <+> quotes (ppr rep_tc)
-          <+> ptext (sLit "must have some type parameters"))
+  = NotValid (ptext (sLit "Data type") <+> quotes (ppr rep_tc)
+              <+> ptext (sLit "must have some type parameters"))
 
   | not (null bad_stupid_theta)
-  = Just (ptext (sLit "Data type") <+> quotes (ppr rep_tc)
-          <+> ptext (sLit "must not have a class context") <+> pprTheta bad_stupid_theta)
+  = NotValid (ptext (sLit "Data type") <+> quotes (ppr rep_tc)
+              <+> ptext (sLit "must not have a class context") <+> pprTheta bad_stupid_theta)
 
   | otherwise
-  = msum (map check_con data_cons)      -- msum picks the first 'Just', if any
+  = allValid (map check_con data_cons)
   where
     tc_tvs            = tyConTyVars rep_tc
     Just (_, last_tv) = snocView tc_tvs
@@ -1339,41 +1441,36 @@ cond_functorOK allowFunctions (_, rep_tc, _)
     is_bad pred       = last_tv `elemVarSet` tyVarsOfType pred
 
     data_cons = tyConDataCons rep_tc
-    check_con con = msum (check_vanilla con : foldDataConArgs (ft_check con) con)
-
-    check_vanilla :: DataCon -> Maybe SDoc
-    check_vanilla con | isVanillaDataCon con = Nothing
-                      | otherwise            = Just (badCon con existential)
-
-    ft_check :: DataCon -> FFoldType (Maybe SDoc)
-    ft_check con = FT { ft_triv = Nothing, ft_var = Nothing
-                      , ft_co_var = Just (badCon con covariant)
-                      , ft_fun = \x y -> if allowFunctions then x `mplus` y
-                                                           else Just (badCon con functions)
-                      , ft_tup = \_ xs  -> msum xs
+    check_con con = allValid (check_universal con : foldDataConArgs (ft_check con) con)
+
+    check_universal :: DataCon -> Validity
+    check_universal con
+      | Just tv <- getTyVar_maybe (last (tyConAppArgs (dataConOrigResTy con)))
+      , tv `elem` dataConUnivTyVars con
+      , not (tv `elemVarSet` tyVarsOfTypes (dataConTheta con))
+      = IsValid   -- See Note [Check that the type variable is truly universal]
+      | otherwise
+      = NotValid (badCon con existential)
+
+    ft_check :: DataCon -> FFoldType Validity
+    ft_check con = FT { ft_triv = IsValid, ft_var = IsValid
+                      , ft_co_var = NotValid (badCon con covariant)
+                      , ft_fun = \x y -> if allowFunctions then x `andValid` y
+                                                           else NotValid (badCon con functions)
+                      , ft_tup = \_ xs  -> allValid xs
                       , ft_ty_app = \_ x   -> x
-                      , ft_bad_app = Just (badCon con wrong_arg)
+                      , ft_bad_app = NotValid (badCon con wrong_arg)
                       , ft_forall = \_ x   -> x }
 
-    existential = ptext (sLit "must not have existential arguments")
+    existential = ptext (sLit "must be truly polymorphic in the last argument of the data type")
     covariant   = ptext (sLit "must not use the type variable in a function argument")
     functions   = ptext (sLit "must not contain function types")
     wrong_arg   = ptext (sLit "must use the type variable only as the last argument of a data type")
 
-allDistinctTyVars :: [KindOrType] -> Bool
-allDistinctTyVars tkvs = go emptyVarSet tkvs
-  where
-    go _      [] = True
-    go so_far (ty : tys)
-       = case getTyVar_maybe ty of
-             Nothing -> False
-             Just tv | tv `elemVarSet` so_far -> False
-                     | otherwise -> go (so_far `extendVarSet` tv) tys
-
 checkFlag :: ExtensionFlag -> Condition
 checkFlag flag (dflags, _, _)
-  | xopt flag dflags = Nothing
-  | otherwise        = Just why
+  | xopt flag dflags = IsValid
+  | otherwise        = NotValid why
   where
     why = ptext (sLit "You need ") <> text flag_str
           <+> ptext (sLit "to derive an instance for this class")
@@ -1417,6 +1514,28 @@ badCon :: DataCon -> SDoc -> SDoc
 badCon con msg = ptext (sLit "Constructor") <+> quotes (ppr con) <+> msg
 \end{code}
 
+Note [Check that the type variable is truly universal]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+For Functor, Foldable, Traversable, we must check that the *last argument*
+of the type constructor is used truly universally quantified.  Example
+
+   data T a b where
+     T1 :: a -> b -> T a b      -- Fine! Vanilla H-98
+     T2 :: b -> c -> T a b      -- Fine! Existential c, but we can still map over 'b'
+     T3 :: b -> T Int b         -- Fine! Constraint 'a', but 'b' is still polymorphic
+     T4 :: Ord b => b -> T a b  -- No!  'b' is constrained
+     T5 :: b -> T b b           -- No!  'b' is constrained
+     T6 :: T a (b,b)            -- No!  'b' is constrained
+
+Notice that only the first of these constructors is vanilla H-98. We only
+need to take care about the last argument (b in this case).  See Trac #8678.
+Eg. for T1-T3 we can write
+
+     fmap f (T1 a b) = T1 a (f b)
+     fmap f (T2 b c) = T2 (f b) c
+     fmap f (T3 x)   = T3 (f x)
+
+
 Note [Superclasses of derived instance]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 In general, a derived instance decl needs the superclasses of the derived
@@ -1449,14 +1568,15 @@ a context for the Data instances:
 %************************************************************************
 
 \begin{code}
-mkNewTypeEqn :: DynFlags -> [Var] -> Class
+mkNewTypeEqn :: DynFlags -> Maybe OverlapMode -> [Var] -> Class
              -> [Type] -> TyCon -> [Type] -> TyCon -> [Type]
              -> DerivContext
              -> TcRn EarlyDerivSpec
-mkNewTypeEqn dflags tvs
+mkNewTypeEqn dflags overlap_mode tvs
              cls cls_tys tycon tc_args rep_tycon rep_tc_args mtheta
 -- Want: instance (...) => cls (cls_tys ++ [tycon tc_args]) where ...
-  | might_derive_via_coercible && (newtype_deriving || std_class_via_coercible cls)
+  | ASSERT( length cls_tys + 1 == classArity cls )
+    might_derive_via_coercible && (newtype_deriving || std_class_via_coercible cls)
   = do traceTc "newtype deriving:" (ppr tycon <+> ppr rep_tys <+> ppr all_preds)
        dfun_name <- new_dfun_name cls tycon
        loc <- getSrcSpanM
@@ -1467,6 +1587,7 @@ mkNewTypeEqn dflags tvs
             , ds_cls = cls, ds_tys = inst_tys
             , ds_tc = rep_tycon, ds_tc_args = rep_tc_args
             , ds_theta = theta
+            , ds_overlap = overlap_mode
             , ds_newtype = True }
         Nothing -> return $ InferTheta $ DS
             { ds_loc = loc
@@ -1474,6 +1595,7 @@ mkNewTypeEqn dflags tvs
             , ds_cls = cls, ds_tys = inst_tys
             , ds_tc = rep_tycon, ds_tc_args = rep_tc_args
             , ds_theta = all_preds
+            , ds_overlap = overlap_mode
             , ds_newtype = True }
   | otherwise
   = case checkSideConditions dflags mtheta cls cls_tys rep_tycon rep_tc_args of
@@ -1487,7 +1609,7 @@ mkNewTypeEqn dflags tvs
         | otherwise                  -> bale_out non_std
   where
         newtype_deriving = xopt Opt_GeneralizedNewtypeDeriving dflags
-        go_for_it        = mk_data_eqn tvs cls tycon tc_args rep_tycon rep_tc_args mtheta
+        go_for_it        = mk_data_eqn overlap_mode tvs cls tycon tc_args rep_tycon rep_tc_args mtheta
         bale_out msg     = failWithTc (derivingThingErr newtype_deriving cls cls_tys inst_ty msg)
 
         non_std    = nonStdErr cls
@@ -1583,15 +1705,10 @@ mkNewTypeEqn dflags tvs
         -- See Note [Determining whether newtype-deriving is appropriate]
         might_derive_via_coercible
            =  not (non_coercible_class cls)
-           && arity_ok
            && eta_ok
            && ats_ok
 --         && not (isRecursiveTyCon tycon)      -- Note [Recursive newtypes]
 
-        arity_ok = length cls_tys + 1 == classArity cls
-                -- Well kinded; eg not: newtype T ... deriving( ST )
-                --                      because ST needs *2* type params
-
         -- Check that eta reduction is OK
         eta_ok = nt_eta_arity <= length rep_tc_args
                 -- The newtype can be eta-reduced to match the number
@@ -1607,13 +1724,10 @@ mkNewTypeEqn dflags tvs
                -- so for 'data' instance decls
 
         cant_derive_err
-           = vcat [ ppUnless arity_ok arity_msg
-                  , ppUnless eta_ok eta_msg
+           = vcat [ ppUnless eta_ok eta_msg
                   , ppUnless ats_ok ats_msg ]
-        arity_msg = quotes (ppr (mkClassPred cls cls_tys)) <+> ptext (sLit "does not have arity 1")
         eta_msg   = ptext (sLit "cannot eta-reduce the representation type enough")
         ats_msg   = ptext (sLit "the class has associated types")
-
 \end{code}
 
 Note [Recursive newtypes]
@@ -1953,12 +2067,14 @@ the renamer.  What a great hack!
 genInst :: Bool             -- True <=> standalone deriving
         -> OverlapFlag
         -> CommonAuxiliaries
-        -> DerivSpec ThetaType -> TcM (InstInfo RdrName, BagDerivStuff, Maybe Name)
-genInst standalone_deriv oflag comauxs
+        -> DerivSpec ThetaType 
+        -> TcM (InstInfo RdrName, BagDerivStuff, Maybe Name)
+genInst standalone_deriv default_oflag comauxs
         spec@(DS { ds_tvs = tvs, ds_tc = rep_tycon, ds_tc_args = rep_tc_args
                  , ds_theta = theta, ds_newtype = is_newtype, ds_tys = tys
-                 , ds_name = name, ds_cls = clas, ds_loc = loc })
-  | is_newtype
+                 , ds_overlap = overlap_mode
+                 , ds_name = dfun_name, ds_cls = clas, ds_loc = loc })
+  | is_newtype   -- See Note [Bindings for Generalised Newtype Deriving]
   = do { inst_spec <- mkInstance oflag theta spec
        ; traceTc "genInst/is_newtype" (vcat [ppr loc, ppr clas, ppr tvs, ppr tys, ppr rhs_ty])
        ; return ( InstInfo
@@ -1966,70 +2082,69 @@ genInst standalone_deriv oflag comauxs
                     , iBinds  = InstBindings
                         { ib_binds = gen_Newtype_binds loc clas tvs tys rhs_ty
                         , ib_pragmas = []
+                        , ib_extensions = [ Opt_ImpredicativeTypes
+                                          , Opt_RankNTypes ]
                         , ib_standalone_deriving = standalone_deriv } }
                 , emptyBag
                 , Just $ getName $ head $ tyConDataCons rep_tycon ) }
               -- See Note [Newtype deriving and unused constructors]
 
   | otherwise
-  = do { fix_env <- getFixityEnv
-       ; (meth_binds, deriv_stuff) <- genDerivStuff (getSrcSpan name)
-                                        fix_env clas name rep_tycon
+  = do { (meth_binds, deriv_stuff) <- genDerivStuff loc clas 
+                                        dfun_name rep_tycon
                                         (lookup rep_tycon comauxs)
        ; inst_spec <- mkInstance oflag theta spec
        ; let inst_info = InstInfo { iSpec   = inst_spec
                                   , iBinds  = InstBindings
                                                 { ib_binds = meth_binds
                                                 , ib_pragmas = []
+                                                , ib_extensions = []
                                                 , ib_standalone_deriving = standalone_deriv } }
        ; return ( inst_info, deriv_stuff, Nothing ) }
   where
+    oflag  = setOverlapModeMaybe default_oflag overlap_mode
     rhs_ty = newTyConInstRhs rep_tycon rep_tc_args
 
-genDerivStuff :: SrcSpan -> FixityEnv -> Class -> Name -> TyCon
+genDerivStuff :: SrcSpan -> Class -> Name -> TyCon
               -> Maybe CommonAuxiliary
               -> TcM (LHsBinds RdrName, BagDerivStuff)
-genDerivStuff loc fix_env clas name tycon comaux_maybe
-  | className clas `elem` oldTypeableClassNames
-  = do dflags <- getDynFlags
-       return (gen_old_Typeable_binds dflags loc tycon, emptyBag)
-
-  | className clas == typeableClassName
-  = do dflags <- getDynFlags
-       return (gen_Typeable_binds dflags loc tycon, emptyBag)
-
-  | ck `elem` [genClassKey, gen1ClassKey]   -- Special case because monadic
-  = let gk =  if ck == genClassKey then Gen0 else Gen1 -- TODO NSF: correctly identify when we're building Both instead of One
+genDerivStuff loc clas dfun_name tycon comaux_maybe
+  | let ck = classKey clas
+  , ck `elem` [genClassKey, gen1ClassKey]   -- Special case because monadic
+  = let gk = if ck == genClassKey then Gen0 else Gen1 
+        -- TODO NSF: correctly identify when we're building Both instead of One
         Just metaTyCons = comaux_maybe -- well-guarded by commonAuxiliaries and genInst
     in do
-      (binds, faminst) <- gen_Generic_binds gk tycon metaTyCons (nameModule name)
+      (binds, faminst) <- gen_Generic_binds gk tycon metaTyCons (nameModule dfun_name)
       return (binds, DerivFamInst faminst `consBag` emptyBag)
 
   | otherwise                      -- Non-monadic generators
   = do dflags <- getDynFlags
-       case assocMaybe (gen_list dflags) (getUnique clas) of
-        Just gen_fn -> return (gen_fn loc tycon)
-        Nothing     -> pprPanic "genDerivStuff: bad derived class" (ppr clas)
-  where
-    ck = classKey clas
-
-    gen_list :: DynFlags
-             -> [(Unique, SrcSpan -> TyCon -> (LHsBinds RdrName, BagDerivStuff))]
-    gen_list dflags
-             = [(eqClassKey, gen_Eq_binds)
-               ,(ordClassKey, gen_Ord_binds)
-               ,(enumClassKey, gen_Enum_binds)
-               ,(boundedClassKey, gen_Bounded_binds)
-               ,(ixClassKey, gen_Ix_binds)
-               ,(showClassKey, gen_Show_binds fix_env)
-               ,(readClassKey, gen_Read_binds fix_env)
-               ,(dataClassKey, gen_Data_binds dflags)
-               ,(functorClassKey, gen_Functor_binds)
-               ,(foldableClassKey, gen_Foldable_binds)
-               ,(traversableClassKey, gen_Traversable_binds)
-               ]
+       fix_env <- getFixityEnv
+       return (genDerivedBinds dflags fix_env clas loc tycon)
 \end{code}
 
+Note [Bindings for Generalised Newtype Deriving]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Consider 
+  class Eq a => C a where
+     f :: a -> a
+  newtype N a = MkN [a] deriving( C )
+  instance Eq (N a) where ...
+
+The 'deriving C' clause generates, in effect
+  instance (C [a], Eq a) => C (N a) where
+     f = coerce (f :: [a] -> [a])
+
+This generates a cast for each method, but allows the superclasse to
+be worked out in the usual way.  In this case the superclass (Eq (N
+a)) will be solved by the explicit Eq (N a) instance.  We do *not*
+create the superclasses by casting the superclass dictionaries for the
+representation type.
+
+See the paper "Safe zero-cost coercions for Hsakell".
+
+
 %************************************************************************
 %*                                                                      *
 \subsection[TcDeriv-taggery-Names]{What con2tag/tag2con functions are available?}
diff --git a/compiler/typecheck/TcEnv.lhs b/compiler/typecheck/TcEnv.lhs
index a2df33814071..f4c7c100634f 100644
--- a/compiler/typecheck/TcEnv.lhs
+++ b/compiler/typecheck/TcEnv.lhs
@@ -3,7 +3,9 @@
 %
 
 \begin{code}
+{-# LANGUAGE CPP, FlexibleInstances #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
+
 module TcEnv(
         TyThing(..), TcTyThing(..), TcId,
 
@@ -16,8 +18,8 @@ module TcEnv(
         tcExtendGlobalEnv, tcExtendGlobalEnvImplicit, setGlobalTypeEnv,
         tcExtendGlobalValEnv,
         tcLookupLocatedGlobal, tcLookupGlobal, 
-        tcLookupField, tcLookupTyCon, tcLookupClass, tcLookupDataCon,
-        tcLookupConLike,
+        tcLookupField, tcLookupTyCon, tcLookupClass,
+        tcLookupDataCon, tcLookupPatSyn, tcLookupConLike,
         tcLookupLocatedGlobalId, tcLookupLocatedTyCon,
         tcLookupLocatedClass, tcLookupInstance, tcLookupAxiom,
         
@@ -66,11 +68,13 @@ import TcIface
 import PrelNames
 import TysWiredIn
 import Id
+import IdInfo( IdDetails(VanillaId) )
 import Var
 import VarSet
 import RdrName
 import InstEnv
-import DataCon
+import DataCon ( DataCon )
+import PatSyn  ( PatSyn )
 import ConLike
 import TyCon
 import CoAxiom
@@ -157,6 +161,13 @@ tcLookupDataCon name = do
         AConLike (RealDataCon con) -> return con
         _                          -> wrongThingErr "data constructor" (AGlobal thing) name
 
+tcLookupPatSyn :: Name -> TcM PatSyn
+tcLookupPatSyn name = do
+    thing <- tcLookupGlobal name
+    case thing of
+        AConLike (PatSynCon ps) -> return ps
+        _                       -> wrongThingErr "pattern synonym" (AGlobal thing) name
+
 tcLookupConLike :: Name -> TcM ConLike
 tcLookupConLike name = do
     thing <- tcLookupGlobal name
@@ -715,6 +726,10 @@ data InstBindings a
       { ib_binds :: (LHsBinds a)  -- Bindings for the instance methods
       , ib_pragmas :: [LSig a]    -- User pragmas recorded for generating 
                                   -- specialised instances
+      , ib_extensions :: [ExtensionFlag] -- any extra extensions that should
+                                         -- be enabled when type-checking this
+                                         -- instance; needed for
+                                         -- GeneralizedNewtypeDeriving
                       
       , ib_standalone_deriving :: Bool
            -- True <=> This code came from a standalone deriving clause
@@ -797,7 +812,7 @@ mkStableIdFromString str sig_ty loc occ_wrapper = do
     name <- mkWrapperName "stable" str
     let occ = mkVarOccFS name :: OccName
         gnm = mkExternalName uniq mod (occ_wrapper occ) loc :: Name
-        id  = mkExportedLocalId gnm sig_ty :: Id
+        id  = mkExportedLocalId VanillaId gnm sig_ty :: Id
     return id
 
 mkStableIdFromName :: Name -> Type -> SrcSpan -> (OccName -> OccName) -> TcM TcId
@@ -812,7 +827,7 @@ mkWrapperName what nameBase
          thisMod <- getModule
          let -- Note [Generating fresh names for ccall wrapper]
              wrapperRef = nextWrapperNum dflags
-             pkg = packageIdString  (modulePackageId thisMod)
+             pkg = packageKeyString  (modulePackageKey thisMod)
              mod = moduleNameString (moduleName      thisMod)
          wrapperNum <- liftIO $ atomicModifyIORef wrapperRef $ \mod_env ->
              let num = lookupWithDefaultModuleEnv mod_env 0 thisMod
@@ -860,13 +875,16 @@ notFound name
                      ptext (sLit "is not in scope during type checking, but it passed the renamer"),
                      ptext (sLit "tcl_env of environment:") <+> ppr (tcl_env lcl_env)]
                        -- Take case: printing the whole gbl env can
-                       -- cause an infnite loop, in the case where we
+                       -- cause an infinite loop, in the case where we
                        -- are in the middle of a recursive TyCon/Class group;
                        -- so let's just not print it!  Getting a loop here is
                        -- very unhelpful, because it hides one compiler bug with another
        }
 
 wrongThingErr :: String -> TcTyThing -> Name -> TcM a
+-- It's important that this only calls pprTcTyThingCategory, which in 
+-- turn does not look at the details of the TcTyThing.
+-- See Note [Placeholder PatSyn kinds] in TcBinds
 wrongThingErr expected thing name
   = failWithTc (pprTcTyThingCategory thing <+> quotes (ppr name) <+> 
                 ptext (sLit "used as a") <+> text expected)
diff --git a/compiler/typecheck/TcErrors.lhs b/compiler/typecheck/TcErrors.lhs
index f105cdddfffd..c8f3d069972b 100644
--- a/compiler/typecheck/TcErrors.lhs
+++ b/compiler/typecheck/TcErrors.lhs
@@ -1,6 +1,6 @@
 \begin{code}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# OPTIONS -fno-warn-tabs #-}
+{-# LANGUAGE CPP, ScopedTypeVariables #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
 -- The above warning supression flag is a temporary kludge.
 -- While working on this module you are encouraged to remove it and
 -- detab the module (please do the detabbing in a separate patch). See
@@ -38,7 +38,6 @@ import Var
 import VarSet
 import VarEnv
 import Bag
-import Maybes
 import ErrUtils         ( ErrMsg, makeIntoWarning, pprLocErrMsg )
 import BasicTypes 
 import Util
@@ -47,7 +46,9 @@ import Outputable
 import SrcLoc
 import DynFlags
 import ListSetOps       ( equivClasses )
-import Data.List        ( partition, mapAccumL, zip4 )
+
+import Data.Maybe
+import Data.List        ( partition, mapAccumL, zip4, nub )
 \end{code}
 
 %************************************************************************
@@ -667,10 +668,11 @@ mkTyVarEqErr :: DynFlags -> ReportErrCtxt -> SDoc -> Ct
 -- tv1 and ty2 are already tidied
 mkTyVarEqErr dflags ctxt extra ct oriented tv1 ty2
   | isUserSkolem ctxt tv1   -- ty2 won't be a meta-tyvar, or else the thing would
-                            -- be oriented the other way round; see TcCanonical.reOrient
+                            -- be oriented the other way round;
+                            -- see TcCanonical.canEqTyVarTyVar
   || isSigTyVar tv1 && not (isTyVarTy ty2)
   = mkErrorMsg ctxt ct (vcat [ misMatchOrCND ctxt ct oriented ty1 ty2
-                             , extraTyVarInfo ctxt ty1 ty2
+                             , extraTyVarInfo ctxt tv1 ty2
                              , extra ])
 
   -- So tv is a meta tyvar (or started that way before we 
@@ -700,7 +702,7 @@ mkTyVarEqErr dflags ctxt extra ct oriented tv1 ty2
   , Implic { ic_skols = skols } <- implic
   , tv1 `elem` skols
   = mkErrorMsg ctxt ct (vcat [ misMatchMsg oriented ty1 ty2
-                             , extraTyVarInfo ctxt ty1 ty2
+                             , extraTyVarInfo ctxt tv1 ty2
                              , extra ])
 
   -- Check for skolem escape
@@ -727,14 +729,15 @@ mkTyVarEqErr dflags ctxt extra ct oriented tv1 ty2
   | (implic:_) <- cec_encl ctxt   -- Get the innermost context
   , Implic { ic_env = env, ic_given = given, ic_info = skol_info } <- implic
   = do { let msg = misMatchMsg oriented ty1 ty2
-             untch_extra 
+             untch_extra
                 = nest 2 $
                   sep [ quotes (ppr tv1) <+> ptext (sLit "is untouchable")
                       , nest 2 $ ptext (sLit "inside the constraints") <+> pprEvVarTheta given
                       , nest 2 $ ptext (sLit "bound by") <+> ppr skol_info
                       , nest 2 $ ptext (sLit "at") <+> ppr (tcl_loc env) ]
-             tv_extra = extraTyVarInfo ctxt ty1 ty2
-       ; mkErrorMsg ctxt ct (vcat [msg, untch_extra, tv_extra, extra]) }
+             tv_extra = extraTyVarInfo ctxt tv1 ty2
+             add_sig  = suggestAddSig ctxt ty1 ty2
+       ; mkErrorMsg ctxt ct (vcat [msg, untch_extra, tv_extra, add_sig, extra]) }
 
   | otherwise
   = reportEqErr ctxt extra ct oriented (mkTyVarTy tv1) ty2
@@ -791,7 +794,7 @@ misMatchOrCND ctxt ct oriented ty1 ty2
        -- or there is no context, don't report the context
   = misMatchMsg oriented ty1 ty2
   | otherwise      
-  = couldNotDeduce givens ([mkEqPred ty1 ty2], orig)
+  = couldNotDeduce givens ([mkTcEqPred ty1 ty2], orig)
   where
     givens = getUserGivens ctxt
     orig   = TypeEqOrigin { uo_actual = ty1, uo_expected = ty2 }
@@ -813,30 +816,46 @@ pp_givens givens
                 2 (sep [ ptext (sLit "bound by") <+> ppr skol_info
                        , ptext (sLit "at") <+> ppr loc])
 
-extraTyVarInfo :: ReportErrCtxt -> TcType -> TcType -> SDoc
--- Add on extra info about the types themselves
+extraTyVarInfo :: ReportErrCtxt -> TcTyVar -> TcType -> SDoc
+-- Add on extra info about skolem constants
 -- NB: The types themselves are already tidied
-extraTyVarInfo ctxt ty1 ty2
-  = nest 2 (extra1 $$ extra2)
+extraTyVarInfo ctxt tv1 ty2
+  = nest 2 (tv_extra tv1 $$ ty_extra ty2)
   where
-    extra1 = tyVarExtraInfoMsg (cec_encl ctxt) ty1
-    extra2 = tyVarExtraInfoMsg (cec_encl ctxt) ty2
-
-tyVarExtraInfoMsg :: [Implication] -> Type -> SDoc
--- Shows a bit of extra info about skolem constants
-tyVarExtraInfoMsg implics ty
-  | Just tv <- tcGetTyVar_maybe ty
-  , isTcTyVar tv, isSkolemTyVar tv
-  , let pp_tv = quotes (ppr tv)
- = case tcTyVarDetails tv of
-    SkolemTv {}   -> pp_tv <+> pprSkol (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
- 
+    implics = cec_encl ctxt
+    ty_extra ty = case tcGetTyVar_maybe ty of
+                    Just tv -> tv_extra tv
+                    Nothing -> empty
+
+    tv_extra tv | isTcTyVar tv, isSkolemTyVar tv
+                , let pp_tv = quotes (ppr tv)
+                = case tcTyVarDetails tv of
+                    SkolemTv {}   -> pp_tv <+> pprSkol (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
+
+suggestAddSig :: ReportErrCtxt -> TcType -> TcType -> SDoc
+-- See Note [Suggest adding a type signature]
+suggestAddSig ctxt ty1 ty2
+  | null inferred_bndrs
+  = empty
+  | [bndr] <- inferred_bndrs
+  = ptext (sLit "Possible fix: add a type signature for") <+> quotes (ppr bndr)
+  | otherwise
+  = ptext (sLit "Possible fix: add type signatures for some or all of") <+> (ppr inferred_bndrs)
+  where
+    inferred_bndrs = nub (get_inf ty1 ++ get_inf ty2)
+    get_inf ty | Just tv <- tcGetTyVar_maybe ty
+               , isTcTyVar tv, isSkolemTyVar tv
+               , InferSkol prs <- getSkolemInfo (cec_encl ctxt) tv
+               = map fst prs
+               | otherwise
+               = []
+
 kindErrorMsg :: TcType -> TcType -> SDoc   -- Types are already tidy
 kindErrorMsg ty1 ty2
   = vcat [ ptext (sLit "Kind incompatibility when matching types:")
@@ -884,7 +903,7 @@ sameOccExtra ty1 ty2
   , let n1 = tyConName tc1
         n2 = tyConName tc2
         same_occ = nameOccName n1                  == nameOccName n2
-        same_pkg = modulePackageId (nameModule n1) == modulePackageId (nameModule n2)
+        same_pkg = modulePackageKey (nameModule n1) == modulePackageKey (nameModule n2)
   , n1 /= n2   -- Different Names
   , same_occ   -- but same OccName
   = ptext (sLit "NB:") <+> (ppr_from same_pkg n1 $$ ppr_from same_pkg n2)
@@ -898,14 +917,31 @@ sameOccExtra ty1 ty2
       | otherwise  -- Imported things have an UnhelpfulSrcSpan
       = hang (quotes (ppr nm))
            2 (sep [ ptext (sLit "is defined in") <+> quotes (ppr (moduleName mod))
-                  , ppUnless (same_pkg || pkg == mainPackageId) $
+                  , ppUnless (same_pkg || pkg == mainPackageKey) $
                     nest 4 $ ptext (sLit "in package") <+> quotes (ppr pkg) ])
        where
-         pkg = modulePackageId mod
+         pkg = modulePackageKey mod
          mod = nameModule nm
          loc = nameSrcSpan nm
 \end{code}
 
+Note [Suggest adding a type signature]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+The OutsideIn algorithm rejects GADT programs that don't have a principal
+type, and indeed some that do.  Example:
+   data T a where
+     MkT :: Int -> T Int
+
+   f (MkT n) = n
+
+Does this have type f :: T a -> a, or f :: T a -> Int?
+The error that shows up tends to be an attempt to unify an
+untouchable type variable.  So suggestAddSig sees if the offending
+type variable is bound by an *inferred* signature, and suggests
+adding a declared signature instead.
+
+This initially came up in Trac #8968, concerning pattern synonyms.
+
 Note [Disambiguating (X ~ X) errors]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 See Trac #8278
@@ -995,9 +1031,8 @@ mk_dict_err ctxt (ct, (matches, unifiers, safe_haskell))
   = do { let (is_ambig, ambig_msg) = mkAmbigMsg ct
        ; (ctxt, binds_msg) <- relevantBindings True ctxt ct
        ; traceTc "mk_dict_err" (ppr ct $$ ppr is_ambig $$ ambig_msg)
-       ; safe_mod <- safeLanguageOn `fmap` getDynFlags
        ; rdr_env <- getGlobalRdrEnv
-       ; return (ctxt, cannot_resolve_msg safe_mod rdr_env is_ambig binds_msg ambig_msg) }
+       ; return (ctxt, cannot_resolve_msg rdr_env is_ambig binds_msg ambig_msg) }
 
   | not safe_haskell   -- Some matches => overlap errors
   = return (ctxt, overlap_msg)
@@ -1012,8 +1047,8 @@ mk_dict_err ctxt (ct, (matches, unifiers, safe_haskell))
     givens      = getUserGivens ctxt
     all_tyvars  = all isTyVarTy tys
 
-    cannot_resolve_msg safe_mod rdr_env has_ambig_tvs binds_msg ambig_msg
-      = vcat [ addArising orig (no_inst_msg $$ coercible_explanation safe_mod rdr_env)
+    cannot_resolve_msg rdr_env has_ambig_tvs binds_msg ambig_msg
+      = vcat [ addArising orig (no_inst_msg $$ coercible_explanation rdr_env)
              , vcat (pp_givens givens)
              , ppWhen (has_ambig_tvs && not (null unifiers && null givens))
                (vcat [ ambig_msg, binds_msg, potential_msg ])
@@ -1033,7 +1068,7 @@ mk_dict_err ctxt (ct, (matches, unifiers, safe_haskell))
 
     add_to_ctxt_fixes has_ambig_tvs
       | not has_ambig_tvs && all_tyvars
-      , (orig:origs) <- mapCatMaybes get_good_orig (cec_encl ctxt)
+      , (orig:origs) <- mapMaybe get_good_orig (cec_encl ctxt)
       = [sep [ ptext (sLit "add") <+> pprParendType pred
                <+> ptext (sLit "to the context of")
 	     , nest 2 $ ppr_skol orig $$ 
@@ -1052,8 +1087,9 @@ mk_dict_err ctxt (ct, (matches, unifiers, safe_haskell))
     no_inst_msg
       | clas == coercibleClass
       = let (ty1, ty2) = getEqPredTys pred
-        in ptext (sLit "Could not coerce from") <+> quotes (ppr ty1) <+>
-           ptext (sLit "to") <+> quotes (ppr ty2)
+        in sep [ ptext (sLit "Could not coerce from") <+> quotes (ppr ty1)
+               , nest 19 (ptext (sLit "to") <+> quotes (ppr ty2)) ]
+                 -- The nesting makes the types line up
       | null givens && null matches
       = ptext (sLit "No instance for")  <+> pprParendType pred
       | otherwise
@@ -1102,7 +1138,7 @@ mk_dict_err ctxt (ct, (matches, unifiers, safe_haskell))
             ispecs = [ispec | (ispec, _) <- matches]
 
             givens = getUserGivens ctxt
-            matching_givens = mapCatMaybes matchable givens
+            matching_givens = mapMaybe matchable givens
 
             matchable (evvars,skol_info,loc) 
               = case ev_vars_matching of
@@ -1138,27 +1174,12 @@ mk_dict_err ctxt (ct, (matches, unifiers, safe_haskell))
     -- This function tries to reconstruct why a "Coercible ty1 ty2" constraint
     -- is left over. Therefore its logic has to stay in sync with
     -- getCoericbleInst in TcInteract. See Note [Coercible Instances]
-    coercible_explanation safe_mod rdr_env
+    coercible_explanation rdr_env
       | clas /= coercibleClass = empty
       | Just (tc1,tyArgs1) <- splitTyConApp_maybe ty1,
         Just (tc2,tyArgs2) <- splitTyConApp_maybe ty2,
         tc1 == tc2
       = nest 2 $ vcat $
-          -- Only for safe haskell: First complain if tc is abstract, only if
-          -- not check if the type constructors therein are abstract
-          (if safe_mod
-           then case tyConAbstractMsg rdr_env tc1 empty of
-                    Just msg ->
-                       [ msg $$ ptext (sLit "as required in SafeHaskell mode") ]
-                    Nothing ->
-                       [ msg
-                       | tc <- tyConsOfTyCon tc1
-                       , Just msg <- return $
-                           tyConAbstractMsg rdr_env tc $
-                             parens $ ptext (sLit "used within") <+> quotes (ppr tc1)
-                       ]
-           else []
-          ) ++
           [ fsep [ hsep [ ptext $ sLit "because the", speakNth n, ptext $ sLit "type argument"]
                  , hsep [ ptext $ sLit "of", quotes (ppr tc1), ptext $ sLit "has role Nominal,"]
                  , ptext $ sLit "but the arguments"
@@ -1176,9 +1197,9 @@ mk_dict_err ctxt (ct, (matches, unifiers, safe_haskell))
         Just msg <- coercible_msg_for_tycon rdr_env tc
       = msg
       | otherwise
-      = nest 2 $ hsep [ ptext $ sLit "because", quotes (ppr ty1),
-                        ptext $ sLit "and", quotes (ppr ty2),
-                        ptext $ sLit "are different types." ]
+      = nest 2 $ sep [ ptext (sLit "because") <+> quotes (ppr ty1)
+                     , nest 4 (vcat [ ptext (sLit "and") <+> quotes (ppr ty2)
+                                    , ptext (sLit "are different types.") ]) ]
       where
         (ty1, ty2) = getEqPredTys pred
 
@@ -1268,29 +1289,51 @@ flattening any further.  After all, there can be no instance declarations
 that match such things.  And flattening under a for-all is problematic
 anyway; consider C (forall a. F a)
 
+Note [Suggest -fprint-explicit-kinds]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+It can be terribly confusing to get an error message like (Trac #9171)
+    Couldn't match expected type ‘GetParam Base (GetParam Base Int)’
+                with actual type ‘GetParam Base (GetParam Base Int)’
+The reason may be that the kinds don't match up.  Typically you'll get
+more useful information, but not when it's as a result of ambiguity.
+This test suggests -fprint-explicit-kinds when all the ambiguous type
+variables are kind variables.
+
 \begin{code}
 mkAmbigMsg :: Ct -> (Bool, SDoc)
 mkAmbigMsg ct
-  | isEmptyVarSet ambig_tv_set = (False, empty)
-  | otherwise                  = (True,  msg)
+  | null ambig_tkvs = (False, empty)
+  | otherwise       = (True,  msg)
   where
-    ambig_tv_set = filterVarSet isAmbiguousTyVar (tyVarsOfCt ct)
-    ambig_tvs = varSetElems ambig_tv_set
-    
-    is_or_are | isSingleton ambig_tvs = text "is"
-              | otherwise             = text "are"
-                 
-    msg | any isRuntimeUnkSkol ambig_tvs  -- See Note [Runtime skolems]
+    ambig_tkv_set = filterVarSet isAmbiguousTyVar (tyVarsOfCt ct)
+    ambig_tkvs    = varSetElems ambig_tkv_set
+    (ambig_kvs, ambig_tvs) = partition isKindVar ambig_tkvs
+
+    msg | any isRuntimeUnkSkol ambig_tkvs  -- See Note [Runtime skolems]
         =  vcat [ ptext (sLit "Cannot resolve unknown runtime type") <> plural ambig_tvs
                      <+> pprQuotedList ambig_tvs
                 , ptext (sLit "Use :print or :force to determine these types")]
-        | otherwise
-        = vcat [ text "The type variable" <> plural ambig_tvs
-                    <+> pprQuotedList ambig_tvs
-                    <+> is_or_are <+> text "ambiguous" ]
+
+        | not (null ambig_tvs)
+        = pp_ambig (ptext (sLit "type")) ambig_tvs
+
+        | otherwise  -- All ambiguous kind variabes; suggest -fprint-explicit-kinds
+        = vcat [ pp_ambig (ptext (sLit "kind")) ambig_kvs
+               , sdocWithDynFlags suggest_explicit_kinds ]
+
+    pp_ambig what tkvs
+      = ptext (sLit "The") <+> what <+> ptext (sLit "variable") <> plural tkvs
+        <+> pprQuotedList tkvs <+> is_or_are tkvs <+> ptext (sLit "ambiguous")
+
+    is_or_are [_] = text "is"
+    is_or_are _   = text "are"
+
+    suggest_explicit_kinds dflags  -- See Note [Suggest -fprint-explicit-kinds]
+      | gopt Opt_PrintExplicitKinds dflags = empty
+      | otherwise = ptext (sLit "Use -fprint-explicit-kinds to see the kind arguments")
 
 pprSkol :: SkolemInfo -> SrcLoc -> SDoc
-pprSkol UnkSkol   _ 
+pprSkol UnkSkol   _
   = ptext (sLit "is an unknown type variable")
 pprSkol skol_info tv_loc 
   = sep [ ptext (sLit "is a rigid type variable bound by"),
diff --git a/compiler/typecheck/TcEvidence.lhs b/compiler/typecheck/TcEvidence.lhs
index 3471b327fa73..7fc6194b8fe0 100644
--- a/compiler/typecheck/TcEvidence.lhs
+++ b/compiler/typecheck/TcEvidence.lhs
@@ -3,6 +3,8 @@
 %
 
 \begin{code}
+{-# LANGUAGE CPP, DeriveDataTypeable #-}
+
 module TcEvidence (
 
   -- HsWrapper
@@ -25,7 +27,7 @@ module TcEvidence (
   mkTcSymCo, mkTcTransCo, mkTcNthCo, mkTcLRCo, mkTcSubCo,
   mkTcAxiomRuleCo,
   tcCoercionKind, coVarsOfTcCo, isEqVar, mkTcCoVarCo, 
-  isTcReflCo, isTcReflCo_maybe, getTcCoVar_maybe,
+  isTcReflCo, getTcCoVar_maybe,
   tcCoercionRole, eqVarRole,
   coercionToTcCoercion
   ) where
@@ -82,7 +84,7 @@ differences
   * The kind of a TcCoercion is  t1 ~  t2  (resp. Coercible t1 t2)
              of a Coercion   is  t1 ~# t2  (resp. t1 ~#R t2)
 
-  * UnsafeCo aren't required, but we do have TcPhandomCo
+  * UnsafeCo aren't required, but we do have TcPhantomCo
 
   * Representation invariants are weaker:
      - we are allowed to have type synonyms in TcTyConAppCo
@@ -351,7 +353,7 @@ pprTcCo, pprParendTcCo :: TcCoercion -> SDoc
 pprTcCo       co = ppr_co TopPrec   co
 pprParendTcCo co = ppr_co TyConPrec co
 
-ppr_co :: Prec -> TcCoercion -> SDoc
+ppr_co :: TyPrec -> TcCoercion -> SDoc
 ppr_co _ (TcRefl r ty) = angleBrackets (ppr ty) <> ppr_role r
 
 ppr_co p co@(TcTyConAppCo _ tc [_,_])
@@ -404,7 +406,7 @@ ppr_role r = underscore <> pp_role
                     Representational -> char 'R'
                     Phantom          -> char 'P'
 
-ppr_fun_co :: Prec -> TcCoercion -> SDoc
+ppr_fun_co :: TyPrec -> TcCoercion -> SDoc
 ppr_fun_co p co = pprArrowChain p (split co)
   where
     split :: TcCoercion -> [SDoc]
@@ -413,7 +415,7 @@ ppr_fun_co p co = pprArrowChain p (split co)
       = ppr_co FunPrec arg : split res
     split co = [ppr_co TopPrec co]
 
-ppr_forall_co :: Prec -> TcCoercion -> SDoc
+ppr_forall_co :: TyPrec -> TcCoercion -> SDoc
 ppr_forall_co p ty
   = maybeParen p FunPrec $
     sep [pprForAll tvs, ppr_co TopPrec rho]
@@ -594,7 +596,7 @@ data EvTerm
                                  -- dictionaries, even though the former have no
                                  -- selector Id.  We count up from _0_
 
-  | EvLit EvLit       -- Dictionary for KnownNat and KnownLit classes.
+  | EvLit EvLit       -- Dictionary for KnownNat and KnownSymbol classes.
                       -- Note [KnownNat & KnownSymbol and EvLit]
 
   deriving( Data.Data, Data.Typeable)
@@ -651,7 +653,7 @@ Conclusion: a new wanted coercion variable should be made mutable.
 Note [KnownNat & KnownSymbol and EvLit]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 A part of the type-level literals implementation are the classes
-"KnownNat" and "KnownLit", which provide a "smart" constructor for
+"KnownNat" and "KnownSymbol", which provide a "smart" constructor for
 defining singleton values.  Here is the key stuff from GHC.TypeLits
 
   class KnownNat (n :: Nat) where
@@ -692,7 +694,7 @@ especialy when the `KnowNat` evidence is packaged up in an existential.
 
 The story for kind `Symbol` is analogous:
   * class KnownSymbol
-  * newypte SSymbol
+  * newtype SSymbol
   * Evidence: EvLit (EvStr n)
 
 
diff --git a/compiler/typecheck/TcExpr.lhs b/compiler/typecheck/TcExpr.lhs
index 409a23047114..7e6c495506d9 100644
--- a/compiler/typecheck/TcExpr.lhs
+++ b/compiler/typecheck/TcExpr.lhs
@@ -5,6 +5,8 @@ c%
 \section[TcExpr]{Typecheck an expression}
 
 \begin{code}
+{-# LANGUAGE CPP #-}
+
 module TcExpr ( tcPolyExpr, tcPolyExprNC, tcMonoExpr, tcMonoExprNC,
                 tcInferRho, tcInferRhoNC,
                 tcSyntaxOp, tcCheckId,
@@ -74,7 +76,7 @@ import qualified Data.Set as Set
 \begin{code}
 tcPolyExpr, tcPolyExprNC
          :: LHsExpr Name        -- Expression to type check
-         -> TcSigmaType         -- Expected type (could be a polytpye)
+         -> TcSigmaType         -- Expected type (could be a polytype)
          -> TcM (LHsExpr TcId)  -- Generalised expr with expected type
 
 -- tcPolyExpr is a convenient place (frequent but not too frequent)
@@ -200,7 +202,7 @@ tcExpr (HsIPVar x) res_ty
        ; ip_var <- emitWanted origin (mkClassPred ipClass [ip_name, ip_ty])
        ; tcWrapResult (fromDict ipClass ip_name ip_ty (HsVar ip_var)) ip_ty res_ty }
   where
-  -- Coerces a dictionry for `IP "x" t` into `t`.
+  -- Coerces a dictionary for `IP "x" t` into `t`.
   fromDict ipClass x ty =
     case unwrapNewTyCon_maybe (classTyCon ipClass) of
       Just (_,_,ax) -> HsWrap $ mkWpCast $ mkTcUnbranchedAxInstCo Representational ax [x,ty]
@@ -221,11 +223,14 @@ tcExpr e@(HsLamCase _ matches) res_ty
 tcExpr (ExprWithTySig expr sig_ty) res_ty
  = do { sig_tc_ty <- tcHsSigType ExprSigCtxt sig_ty
 
-      -- Remember to extend the lexical type-variable environment
       ; (gen_fn, expr')
             <- tcGen ExprSigCtxt sig_tc_ty $ \ skol_tvs res_ty ->
-               tcExtendTyVarEnv2 (hsExplicitTvs sig_ty `zip` skol_tvs) $
-                                -- See Note [More instantiated than scoped] in TcBinds
+
+                  -- Remember to extend the lexical type-variable environment
+                  -- See Note [More instantiated than scoped] in TcBinds
+               tcExtendTyVarEnv2 
+                  [(n,tv) | (Just n, tv) <- findScopedTyVars sig_ty sig_tc_ty skol_tvs] $
+
                tcMonoExprNC expr res_ty
 
       ; let inner_expr = ExprWithTySigOut (mkLHsWrap gen_fn expr') sig_ty
@@ -318,24 +323,25 @@ tcExpr (OpApp arg1 op fix arg2) res_ty
          -- arg1_ty = arg2_ty -> op_res_ty
          -- And arg2_ty maybe polymorphic; that's the point
 
-       -- Make sure that the argument and result types have kind '*'
+       -- Make sure that the argument type has kind '*'
        -- Eg we do not want to allow  (D#  $  4.0#)   Trac #5570
        --    (which gives a seg fault)
        -- We do this by unifying with a MetaTv; but of course
        -- it must allow foralls in the type it unifies with (hence PolyTv)!
+       --
+       -- The result type can have any kind (Trac #8739),
+       -- so we can just use res_ty
 
-       -- ($) :: forall ab. (a->b) -> a -> b
+       -- ($) :: forall (a:*) (b:Open). (a->b) -> a -> b
        ; a_ty <- newPolyFlexiTyVarTy
-       ; b_ty <- newPolyFlexiTyVarTy
        ; arg2' <- tcArg op (arg2, arg2_ty, 2)
 
-       ; co_res <- unifyType b_ty res_ty        -- b ~ res
-       ; co_a   <- unifyType arg2_ty   a_ty     -- arg2 ~ a
-       ; co_b   <- unifyType op_res_ty b_ty     -- op_res ~ b
+       ; co_a   <- unifyType arg2_ty   a_ty      -- arg2 ~ a
+       ; co_b   <- unifyType op_res_ty res_ty    -- op_res ~ res
        ; op_id  <- tcLookupId op_name
 
-       ; let op' = L loc (HsWrap (mkWpTyApps [a_ty, b_ty]) (HsVar op_id))
-       ; return $ mkHsWrapCo (co_res) $
+       ; let op' = L loc (HsWrap (mkWpTyApps [a_ty, res_ty]) (HsVar op_id))
+       ; return $
          OpApp (mkLHsWrapCo (mkTcFunCo Nominal co_a co_b) $
                 mkLHsWrapCo co_arg1 arg1')
                op' fix
@@ -494,7 +500,8 @@ for conditionals:
 to support expressions like this:
 
  ifThenElse :: Maybe a -> (a -> b) -> b -> b
- ifThenElse (Just a) f _ = f a  ifThenElse Nothing  _ e = e
+ ifThenElse (Just a) f _ = f a
+ ifThenElse Nothing  _ e = e
 
  example :: String
  example = if Just 2
@@ -558,7 +565,7 @@ Note that because MkT3 doesn't contain all the fields being updated,
 its RHS is simply an error, so it doesn't impose any type constraints.
 Hence the use of 'relevant_cont'.
 
-Note [Implict type sharing]
+Note [Implicit type sharing]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~
 We also take into account any "implicit" non-update fields.  For example
         data T a b where { MkT { f::a } :: T a a; ... }
@@ -744,7 +751,7 @@ tcExpr (RecordUpd record_expr rbinds _ _ _) res_ty
                                     -- Universally-quantified tyvars that
                                     -- appear in any of the *implicit*
                                     -- arguments to the constructor are fixed
-                                    -- See Note [Implict type sharing]
+                                    -- See Note [Implicit type sharing]
 
                             fixed_tys = [ty | (fld,ty) <- zip flds arg_tys
                                             , not (fld `elem` upd_fld_names)]
@@ -800,7 +807,7 @@ tcExpr (PArrSeq _ _) _
 
 \begin{code}
 tcExpr (HsSpliceE is_ty splice)  res_ty
-  = ASSERT( is_ty )   -- Untyped splices are expanced by the renamer
+  = ASSERT( is_ty )   -- Untyped splices are expanded by the renamer
    tcSpliceExpr splice res_ty
 
 tcExpr (HsBracket brack)         res_ty = tcTypedBracket   brack res_ty
@@ -959,7 +966,7 @@ tcInferFun fun
 
          -- Zonk the function type carefully, to expose any polymorphism
          -- E.g. (( \(x::forall a. a->a). blah ) e)
-         -- We can see the rank-2 type of the lambda in time to genrealise e
+         -- We can see the rank-2 type of the lambda in time to generalise e
        ; fun_ty' <- zonkTcType fun_ty
 
        ; (wrap, rho) <- deeplyInstantiate AppOrigin fun_ty'
diff --git a/compiler/typecheck/TcForeign.lhs b/compiler/typecheck/TcForeign.lhs
index 26af2c5ebfe0..303391fcddd1 100644
--- a/compiler/typecheck/TcForeign.lhs
+++ b/compiler/typecheck/TcForeign.lhs
@@ -12,6 +12,8 @@ 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}
+{-# LANGUAGE CPP #-}
+
 module TcForeign
         ( tcForeignImports
         , tcForeignExports
@@ -58,7 +60,6 @@ import SrcLoc
 import Bag
 import FastString
 import Hooks
-import BasicTypes (Origin(..))
 
 import Control.Monad
 \end{code}
@@ -93,6 +94,20 @@ parameters.
 Similarly, we don't need to look in AppTy's, because nothing headed by
 an AppTy will be marshalable.
 
+Note [FFI type roles]
+~~~~~~~~~~~~~~~~~~~~~
+The 'go' helper function within normaliseFfiType' always produces
+representational coercions. But, in the "children_only" case, we need to
+use these coercions in a TyConAppCo. Accordingly, the roles on the coercions
+must be twiddled to match the expectation of the enclosing TyCon. However,
+we cannot easily go from an R coercion to an N one, so we forbid N roles
+on FFI type constructors. Currently, only two such type constructors exist:
+IO and FunPtr. Thus, this is not an onerous burden.
+
+If we ever want to lift this restriction, we would need to make 'go' take
+the target role as a parameter. This wouldn't be hard, but it's a complication
+not yet necessary and so is not yet implemented.
+
 \begin{code}
 -- normaliseFfiType takes the type from an FFI declaration, and
 -- evaluates any type synonyms, type functions, and newtypes. However,
@@ -115,7 +130,8 @@ normaliseFfiType' env ty0 = go initRecTc ty0
         -- We don't want to look through the IO newtype, even if it is
         -- in scope, so we have a special case for it:
         | tc_key `elem` [ioTyConKey, funPtrTyConKey]
-                  -- Those *must* have R roles on their parameters!
+                  -- These *must not* have nominal roles on their parameters!
+                  -- See Note [FFI type roles]
         = children_only
 
         | isNewTyCon tc         -- Expand newtypes
@@ -142,10 +158,14 @@ normaliseFfiType' env ty0 = go initRecTc ty0
         = nothing -- see Note [Don't recur in normaliseFfiType']
         where
           tc_key = getUnique tc
-          children_only 
+          children_only
             = do xs <- mapM (go rec_nts) tys
                  let (cos, tys', gres) = unzip3 xs
-                 return ( mkTyConAppCo Representational tc cos
+                        -- the (repeat Representational) is because 'go' always
+                        -- returns R coercions
+                     cos' = zipWith3 downgradeRole (tyConRoles tc)
+                                     (repeat Representational) cos
+                 return ( mkTyConAppCo Representational tc cos'
                         , mkTyConApp tc tys', unionManyBags gres)
           nt_co  = mkUnbranchedAxInstCo Representational (newTyConCo tc) tys
           nt_rhs = newTyConInstRhs tc tys
@@ -230,7 +250,7 @@ tcFImport (L dloc fo@(ForeignImport (L nloc nm) hs_ty _ imp_decl))
                  -- 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
+       ; imp_decl' <- tcCheckFIType arg_tys res_ty imp_decl
           -- Can't use sig_ty here because sig_ty :: Type and
           -- we need HsType Id hence the undefined
        ; let fi_decl = ForeignImport (L nloc id) undefined (mkSymCo norm_co) imp_decl'
@@ -241,18 +261,18 @@ tcFImport d = pprPanic "tcFImport" (ppr d)
 
 ------------ Checking types for foreign import ----------------------
 \begin{code}
-tcCheckFIType :: Type -> [Type] -> Type -> ForeignImport -> TcM ForeignImport
+tcCheckFIType :: [Type] -> Type -> ForeignImport -> TcM ForeignImport
 
-tcCheckFIType sig_ty arg_tys res_ty (CImport cconv safety mh l@(CLabel _))
+tcCheckFIType arg_tys res_ty (CImport cconv safety mh l@(CLabel _))
   -- Foreign import label
   = do checkCg checkCOrAsmOrLlvmOrInterp
        -- NB check res_ty not sig_ty!
        --    In case sig_ty is (forall a. ForeignPtr a)
-       check (null arg_tys && isFFILabelTy res_ty) (illegalForeignLabelErr sig_ty)
+       check (isFFILabelTy (mkFunTys arg_tys res_ty)) (illegalForeignTyErr empty)
        cconv' <- checkCConv cconv
        return (CImport cconv' safety mh l)
 
-tcCheckFIType sig_ty arg_tys res_ty (CImport cconv safety mh CWrapper) = do
+tcCheckFIType arg_tys res_ty (CImport cconv safety mh 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) is accepted, too.
@@ -265,32 +285,32 @@ tcCheckFIType sig_ty arg_tys res_ty (CImport cconv safety mh CWrapper) = do
                         checkForeignRes mustBeIO checkSafe (isFFIDynTy arg1_ty) res_ty
                   where
                      (arg1_tys, res1_ty) = tcSplitFunTys arg1_ty
-        _ -> addErrTc (illegalForeignTyErr empty sig_ty)
+        _ -> addErrTc (illegalForeignTyErr empty (ptext (sLit "One argument expected")))
     return (CImport cconv' safety mh CWrapper)
 
-tcCheckFIType sig_ty arg_tys res_ty idecl@(CImport cconv safety mh (CFunction target))
+tcCheckFIType arg_tys res_ty idecl@(CImport cconv safety mh (CFunction target))
   | isDynamicTarget target = do -- Foreign import dynamic
       checkCg checkCOrAsmOrLlvmOrInterp
       cconv' <- checkCConv cconv
       case arg_tys of           -- The first arg must be Ptr or FunPtr
-        []                -> do
-          check False (illegalForeignTyErr empty sig_ty)
+        []                -> 
+          addErrTc (illegalForeignTyErr empty (ptext (sLit "At least one argument expected")))
         (arg1_ty:arg_tys) -> do
           dflags <- getDynFlags
           let curried_res_ty = foldr FunTy res_ty arg_tys
           check (isFFIDynTy curried_res_ty arg1_ty)
-                (illegalForeignTyErr argument arg1_ty)
+                (illegalForeignTyErr argument)
           checkForeignArgs (isFFIArgumentTy dflags safety) arg_tys
           checkForeignRes nonIOok checkSafe (isFFIImportResultTy dflags) res_ty
       return $ CImport cconv' safety mh (CFunction target)
   | cconv == PrimCallConv = do
       dflags <- getDynFlags
-      check (xopt Opt_GHCForeignImportPrim dflags)
-            (text "Use GHCForeignImportPrim to allow `foreign import prim'.")
+      checkTc (xopt Opt_GHCForeignImportPrim dflags)
+              (text "Use GHCForeignImportPrim to allow `foreign import prim'.")
       checkCg checkCOrAsmOrLlvmOrInterp
       checkCTarget target
-      check (playSafe safety)
-            (text "The safe/unsafe annotation should not be used with `foreign import prim'.")
+      checkTc (playSafe safety)
+              (text "The safe/unsafe annotation should not be used with `foreign import prim'.")
       checkForeignArgs (isFFIPrimArgumentTy dflags) arg_tys
       -- prim import result is more liberal, allows (#,,#)
       checkForeignRes nonIOok checkSafe (isFFIPrimResultTy dflags) res_ty
@@ -316,7 +336,7 @@ tcCheckFIType sig_ty arg_tys res_ty idecl@(CImport cconv safety mh (CFunction ta
 checkCTarget :: CCallTarget -> TcM ()
 checkCTarget (StaticTarget str _ _) = do
     checkCg checkCOrAsmOrLlvmOrInterp
-    check (isCLabelString str) (badCName str)
+    checkTc (isCLabelString str) (badCName str)
 
 checkCTarget DynamicTarget = panic "checkCTarget DynamicTarget"
 
@@ -351,7 +371,7 @@ tcForeignExports' decls
   where
    combine (binds, fs, gres1) (L loc fe) = do
        (b, f, gres2) <- setSrcSpan loc (tcFExport fe)
-       return ((FromSource, b) `consBag` binds, L loc f : fs, gres1 `unionBags` gres2)
+       return (b `consBag` binds, L loc f : fs, gres1 `unionBags` gres2)
 
 tcFExport :: ForeignDecl Name -> TcM (LHsBind Id, ForeignDecl Id, Bag GlobalRdrElt)
 tcFExport fo@(ForeignExport (L loc nm) hs_ty _ spec)
@@ -384,7 +404,7 @@ tcFExport d = pprPanic "tcFExport" (ppr d)
 tcCheckFEType :: Type -> ForeignExport -> TcM ForeignExport
 tcCheckFEType sig_ty (CExport (CExportStatic str cconv)) = do
     checkCg checkCOrAsmOrLlvm
-    check (isCLabelString str) (badCName str)
+    checkTc (isCLabelString str) (badCName str)
     cconv' <- checkCConv cconv
     checkForeignArgs isFFIExternalTy arg_tys
     checkForeignRes nonIOok noCheckSafe isFFIExportResultTy res_ty
@@ -406,9 +426,10 @@ tcCheckFEType sig_ty (CExport (CExportStatic str cconv)) = do
 
 \begin{code}
 ------------ Checking argument types for foreign import ----------------------
-checkForeignArgs :: (Type -> Bool) -> [Type] -> TcM ()
+checkForeignArgs :: (Type -> Validity) -> [Type] -> TcM ()
 checkForeignArgs pred tys = mapM_ go tys
-  where go ty = check (pred ty) (illegalForeignTyErr argument ty)
+  where
+    go ty = check (pred ty) (illegalForeignTyErr argument)
 
 ------------ Checking result types for foreign calls ----------------------
 -- | Check that the type has the form
@@ -419,32 +440,34 @@ checkForeignArgs pred tys = mapM_ go tys
 -- We also check that the Safe Haskell condition of FFI imports having
 -- results in the IO monad holds.
 --
-checkForeignRes :: Bool -> Bool -> (Type -> Bool) -> Type -> TcM ()
+checkForeignRes :: Bool -> Bool -> (Type -> Validity) -> Type -> TcM ()
 checkForeignRes non_io_result_ok check_safe pred_res_ty ty
-  = case tcSplitIOType_maybe ty of
-        -- Got an IO result type, that's always fine!
-        Just (_, res_ty) | pred_res_ty res_ty -> return ()
-
-        -- Case for non-IO result type with FFI Import
-        _ -> do
-            dflags <- getDynFlags
-            case (pred_res_ty ty && non_io_result_ok) of
-                -- handle normal typecheck fail, we want to handle this first and
-                -- only report safe haskell errors if the normal type check is OK.
-                False -> addErrTc $ illegalForeignTyErr result ty
+  | Just (_, res_ty) <- tcSplitIOType_maybe ty
+  =     -- Got an IO result type, that's always fine!
+     check (pred_res_ty res_ty) (illegalForeignTyErr result)
 
-                -- handle safe infer fail
-                _ | check_safe && safeInferOn dflags
-                    -> recordUnsafeInfer
+  -- Case for non-IO result type with FFI Import
+  | not non_io_result_ok
+  = addErrTc $ illegalForeignTyErr result (ptext (sLit "IO result type expected"))
 
-                -- handle safe language typecheck fail
-                _ | check_safe && safeLanguageOn dflags
-                    -> addErrTc $ illegalForeignTyErr result ty $+$ safeHsErr
+  | otherwise
+  = do { dflags <- getDynFlags
+       ; case pred_res_ty ty of
+                -- Handle normal typecheck fail, we want to handle this first and
+                -- only report safe haskell errors if the normal type check is OK.
+           NotValid msg -> addErrTc $ illegalForeignTyErr result msg
+
+           -- handle safe infer fail
+           _ | check_safe && safeInferOn dflags
+               -> recordUnsafeInfer
 
-                -- sucess! non-IO return is fine
-                _ -> return ()
+           -- handle safe language typecheck fail
+           _ | check_safe && safeLanguageOn dflags
+               -> addErrTc (illegalForeignTyErr result safeHsErr)
 
-  where 
+           -- sucess! non-IO return is fine
+           _ -> return () }
+  where
     safeHsErr = ptext $ sLit "Safe Haskell is on, all FFI imports must be in the IO monad"
 
 nonIOok, mustBeIO :: Bool
@@ -459,22 +482,22 @@ noCheckSafe = False
 Checking a supported backend is in use
 
 \begin{code}
-checkCOrAsmOrLlvm :: HscTarget -> Maybe SDoc
-checkCOrAsmOrLlvm HscC    = Nothing
-checkCOrAsmOrLlvm HscAsm  = Nothing
-checkCOrAsmOrLlvm HscLlvm = Nothing
+checkCOrAsmOrLlvm :: HscTarget -> Validity
+checkCOrAsmOrLlvm HscC    = IsValid
+checkCOrAsmOrLlvm HscAsm  = IsValid
+checkCOrAsmOrLlvm HscLlvm = IsValid
 checkCOrAsmOrLlvm _
-  = Just (text "requires unregisterised, llvm (-fllvm) or native code generation (-fasm)")
+  = NotValid (text "requires unregisterised, llvm (-fllvm) or native code generation (-fasm)")
 
-checkCOrAsmOrLlvmOrInterp :: HscTarget -> Maybe SDoc
-checkCOrAsmOrLlvmOrInterp HscC           = Nothing
-checkCOrAsmOrLlvmOrInterp HscAsm         = Nothing
-checkCOrAsmOrLlvmOrInterp HscLlvm        = Nothing
-checkCOrAsmOrLlvmOrInterp HscInterpreted = Nothing
+checkCOrAsmOrLlvmOrInterp :: HscTarget -> Validity
+checkCOrAsmOrLlvmOrInterp HscC           = IsValid
+checkCOrAsmOrLlvmOrInterp HscAsm         = IsValid
+checkCOrAsmOrLlvmOrInterp HscLlvm        = IsValid
+checkCOrAsmOrLlvmOrInterp HscInterpreted = IsValid
 checkCOrAsmOrLlvmOrInterp _
-  = Just (text "requires interpreted, unregisterised, llvm or native code generation")
+  = NotValid (text "requires interpreted, unregisterised, llvm or native code generation")
 
-checkCg :: (HscTarget -> Maybe SDoc) -> TcM ()
+checkCg :: (HscTarget -> Validity) -> TcM ()
 checkCg check = do
     dflags <- getDynFlags
     let target = hscTarget dflags
@@ -482,8 +505,8 @@ checkCg check = do
       HscNothing -> return ()
       _ ->
         case check target of
-          Nothing  -> return ()
-          Just err -> addErrTc (text "Illegal foreign declaration:" <+> err)
+          IsValid      -> return ()
+          NotValid err -> addErrTc (text "Illegal foreign declaration:" <+> err)
 \end{code}
 
 Calling conventions
@@ -512,20 +535,16 @@ checkCConv JavaScriptCallConv = do dflags <- getDynFlags
 Warnings
 
 \begin{code}
-check :: Bool -> MsgDoc -> TcM ()
-check True _       = return ()
-check _    the_err = addErrTc the_err
-
-illegalForeignLabelErr :: Type -> SDoc
-illegalForeignLabelErr ty
-  = vcat [ illegalForeignTyErr empty ty
-         , ptext (sLit "A foreign-imported address (via &foo) must have type (Ptr a) or (FunPtr a)") ]
-
-illegalForeignTyErr :: SDoc -> Type -> SDoc
-illegalForeignTyErr arg_or_res ty
-  = hang (hsep [ptext (sLit "Unacceptable"), arg_or_res,
-                ptext (sLit "type in foreign declaration:")])
-       2 (hsep [ppr ty])
+check :: Validity -> (MsgDoc -> MsgDoc) -> TcM ()
+check IsValid _             = return ()
+check (NotValid doc) err_fn = addErrTc (err_fn doc)
+
+illegalForeignTyErr :: SDoc -> SDoc -> SDoc
+illegalForeignTyErr arg_or_res extra
+  = hang msg 2 extra
+  where
+    msg = hsep [ ptext (sLit "Unacceptable"), arg_or_res
+               , ptext (sLit "type in foreign declaration:")]
 
 -- Used for 'arg_or_res' argument to illegalForeignTyErr
 argument, result :: SDoc
diff --git a/compiler/typecheck/TcGenDeriv.lhs b/compiler/typecheck/TcGenDeriv.lhs
index 3852106d7218..2967630da1a0 100644
--- a/compiler/typecheck/TcGenDeriv.lhs
+++ b/compiler/typecheck/TcGenDeriv.lhs
@@ -11,25 +11,14 @@ This module is nominally ``subordinate'' to @TcDeriv@, which is the
 This is where we do all the grimy bindings' generation.
 
 \begin{code}
-{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE CPP, ScopedTypeVariables #-}
 
 module TcGenDeriv (
         BagDerivStuff, DerivStuff(..),
 
-        gen_Bounded_binds,
-        gen_Enum_binds,
-        gen_Eq_binds,
-        gen_Ix_binds,
-        gen_Ord_binds,
-        gen_Read_binds,
-        gen_Show_binds,
-        gen_Data_binds,
-        gen_old_Typeable_binds, gen_Typeable_binds,
-        gen_Functor_binds,
+        genDerivedBinds, 
         FFoldType(..), functorLikeTraverse,
         deepSubtypesContaining, foldDataConArgs,
-        gen_Foldable_binds,
-        gen_Traversable_binds,
         mkCoerceClassMethEqn,
         gen_Newtype_binds,
         genAuxBinds,
@@ -75,6 +64,7 @@ import Bag
 import Fingerprint
 import TcEnv (InstInfo)
 
+import ListSetOps( assocMaybe )
 import Data.List ( partition, intersperse )
 \end{code}
 
@@ -97,10 +87,43 @@ data DerivStuff     -- Please add this auxiliary stuff
   | DerivFamInst (FamInst)             -- New type family instances
 
   -- New top-level auxiliary bindings
-  | DerivHsBind ((Origin, LHsBind RdrName), LSig RdrName) -- Also used for SYB
+  | DerivHsBind (LHsBind RdrName, LSig RdrName) -- Also used for SYB
   | DerivInst (InstInfo RdrName)                -- New, auxiliary instances
 \end{code}
 
+%************************************************************************
+%*                                                                      *
+                Top level function
+%*                                                                      *
+%************************************************************************
+
+\begin{code}
+genDerivedBinds :: DynFlags -> FixityEnv -> Class -> SrcSpan -> TyCon
+                -> (LHsBinds RdrName, BagDerivStuff)
+genDerivedBinds dflags fix_env clas loc tycon
+  | className clas `elem` oldTypeableClassNames
+  = gen_old_Typeable_binds dflags loc tycon
+
+  | Just gen_fn <- assocMaybe gen_list (getUnique clas)
+  = gen_fn loc tycon
+
+  | otherwise
+  = pprPanic "genDerivStuff: bad derived class" (ppr clas)
+  where
+    gen_list :: [(Unique, SrcSpan -> TyCon -> (LHsBinds RdrName, BagDerivStuff))]
+    gen_list = [ (eqClassKey,          gen_Eq_binds)
+               , (typeableClassKey,    gen_Typeable_binds dflags)
+               , (ordClassKey,         gen_Ord_binds)
+               , (enumClassKey,        gen_Enum_binds)
+               , (boundedClassKey,     gen_Bounded_binds)
+               , (ixClassKey,          gen_Ix_binds)
+               , (showClassKey,        gen_Show_binds fix_env)
+               , (readClassKey,        gen_Read_binds fix_env)
+               , (dataClassKey,        gen_Data_binds dflags)
+               , (functorClassKey,     gen_Functor_binds)
+               , (foldableClassKey,    gen_Foldable_binds)
+               , (traversableClassKey, gen_Traversable_binds) ]
+\end{code}
 
 %************************************************************************
 %*                                                                      *
@@ -276,7 +299,7 @@ Several special cases:
 Note [Do not rely on compare]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 It's a bad idea to define only 'compare', and build the other binary
-comparisions on top of it; see Trac #2130, #4019.  Reason: we don't
+comparisons on top of it; see Trac #2130, #4019.  Reason: we don't
 want to laboriously make a three-way comparison, only to extract a
 binary result, something like this:
      (>) (I# x) (I# y) = case <# x y of
@@ -360,7 +383,7 @@ gen_Ord_binds loc tycon
     (nullary_cons, non_nullary_cons) = partition isNullarySrcDataCon tycon_data_cons
 
 
-    mkOrdOp :: OrdOp -> (Origin, LHsBind RdrName)
+    mkOrdOp :: OrdOp -> LHsBind RdrName
     -- Returns a binding   op a b = ... compares a and b according to op ....
     mkOrdOp op = mk_easy_FunBind loc (ordMethRdr op) [a_Pat, b_Pat] (mkOrdOpRhs op)
 
@@ -1210,20 +1233,22 @@ we generate
 We are passed the Typeable2 class as well as T
 
 \begin{code}
-gen_old_Typeable_binds :: DynFlags -> SrcSpan -> TyCon -> LHsBinds RdrName
+gen_old_Typeable_binds :: DynFlags -> SrcSpan -> TyCon 
+                       -> (LHsBinds RdrName, BagDerivStuff)
 gen_old_Typeable_binds dflags loc tycon
-  = unitBag $
+  = ( unitBag $
         mk_easy_FunBind loc
                 (old_mk_typeOf_RDR tycon)   -- Name of appropriate type0f function
                 [nlWildPat]
                 (nlHsApps oldMkTyConApp_RDR [tycon_rep, nlList []])
+    , emptyBag )
   where
     tycon_name = tyConName tycon
     modl       = nameModule tycon_name
-    pkg        = modulePackageId modl
+    pkg        = modulePackageKey modl
 
     modl_fs    = moduleNameFS (moduleName modl)
-    pkg_fs     = packageIdFS pkg
+    pkg_fs     = packageKeyFS pkg
     name_fs    = occNameFS (nameOccName tycon_name)
 
     tycon_rep = nlHsApps oldMkTyCon_RDR
@@ -1270,17 +1295,19 @@ we generate
 We are passed the Typeable2 class as well as T
 
 \begin{code}
-gen_Typeable_binds :: DynFlags -> SrcSpan -> TyCon -> LHsBinds RdrName
+gen_Typeable_binds :: DynFlags -> SrcSpan -> TyCon 
+                   -> (LHsBinds RdrName, BagDerivStuff)
 gen_Typeable_binds dflags loc tycon
-  = unitBag $ mk_easy_FunBind loc typeRep_RDR [nlWildPat]
-              (nlHsApps mkTyConApp_RDR [tycon_rep, nlList []])
+  = ( unitBag $ mk_easy_FunBind loc typeRep_RDR [nlWildPat]
+                (nlHsApps mkTyConApp_RDR [tycon_rep, nlList []])
+    , emptyBag )
   where
     tycon_name = tyConName tycon
     modl       = nameModule tycon_name
-    pkg        = modulePackageId modl
+    pkg        = modulePackageKey modl
 
     modl_fs    = moduleNameFS (moduleName modl)
-    pkg_fs     = packageIdFS pkg
+    pkg_fs     = packageKeyFS pkg
     name_fs    = occNameFS (nameOccName tycon_name)
 
     tycon_rep = nlHsApps mkTyCon_RDR
@@ -1352,7 +1379,7 @@ gen_Data_binds dflags loc tycon
     n_cons     = length data_cons
     one_constr = n_cons == 1
 
-    genDataTyCon :: ((Origin, LHsBind RdrName), LSig RdrName)
+    genDataTyCon :: (LHsBind RdrName, LSig RdrName)
     genDataTyCon        --  $dT
       = (mkHsVarBind loc rdr_name rhs,
          L loc (TypeSig [L loc rdr_name] sig_ty))
@@ -1364,7 +1391,7 @@ gen_Data_binds dflags loc tycon
               `nlHsApp` nlHsLit (mkHsString (showSDocOneLine dflags (ppr tycon)))
               `nlHsApp` nlList constrs
 
-    genDataDataCon :: DataCon -> ((Origin, LHsBind RdrName), LSig RdrName)
+    genDataDataCon :: DataCon -> (LHsBind RdrName, LSig RdrName)
     genDataDataCon dc       --  $cT1 etc
       = (mkHsVarBind loc rdr_name rhs,
          L loc (TypeSig [L loc rdr_name] sig_ty))
@@ -1714,10 +1741,10 @@ foldDataConArgs :: FFoldType a -> DataCon -> [a]
 foldDataConArgs ft con
   = map (functorLikeTraverse tv ft) (dataConOrigArgTys con)
   where
-    tv = last (dataConUnivTyVars con)
-                    -- Argument to derive for, 'a in the above description
-                    -- The validity checks have ensured that con is
-                    -- a vanilla data constructor
+    Just tv = getTyVar_maybe (last (tyConAppArgs (dataConOrigResTy con)))
+        -- Argument to derive for, 'a in the above description
+        -- The validity and kind checks have ensured that
+        -- the Just will match and a::*
 
 -- Make a HsLam using a fresh variable from a State monad
 mkSimpleLam :: (LHsExpr id -> State [id] (LHsExpr id)) -> State [id] (LHsExpr id)
@@ -1943,7 +1970,7 @@ gen_Newtype_binds loc cls inst_tvs cls_tys rhs_ty
         (map (mkCoerceClassMethEqn cls inst_tvs cls_tys rhs_ty) (classMethods cls))
   where
     coerce_RDR = getRdrName coerceId
-    mk_bind :: Id -> Pair Type -> (Origin, LHsBind RdrName)
+    mk_bind :: Id -> Pair Type -> LHsBind RdrName
     mk_bind id (Pair tau_ty user_ty)
       = mkRdrFunBind (L loc meth_RDR) [mkSimpleMatch [] rhs_expr]
       where
@@ -1978,7 +2005,7 @@ The `tags' here start at zero, hence the @fIRST_TAG@ (currently one)
 fiddling around.
 
 \begin{code}
-genAuxBindSpec :: SrcSpan -> AuxBindSpec -> ((Origin, LHsBind RdrName), LSig RdrName)
+genAuxBindSpec :: SrcSpan -> AuxBindSpec -> (LHsBind RdrName, LSig RdrName)
 genAuxBindSpec loc (DerivCon2Tag tycon)
   = (mk_FunBind loc rdr_name eqns,
      L loc (TypeSig [L loc rdr_name] (L loc sig_ty)))
@@ -2024,7 +2051,7 @@ genAuxBindSpec loc (DerivMaxTag tycon)
                  data_cons -> toInteger ((length data_cons) - fIRST_TAG)
 
 type SeparateBagsDerivStuff = -- AuxBinds and SYB bindings
-                              ( Bag ((Origin, LHsBind RdrName), LSig RdrName)
+                              ( Bag (LHsBind RdrName, LSig RdrName)
                                 -- Extra bindings (used by Generic only)
                               , Bag TyCon   -- Extra top-level datatypes
                               , Bag (FamInst)           -- Extra family instances
@@ -2079,14 +2106,14 @@ mkParentType tc
 \begin{code}
 mk_FunBind :: SrcSpan -> RdrName
            -> [([LPat RdrName], LHsExpr RdrName)]
-           -> (Origin, LHsBind RdrName)
+           -> LHsBind RdrName
 mk_FunBind loc fun pats_and_exprs
   = mkRdrFunBind (L loc fun) matches
   where
     matches = [mkMatch p e emptyLocalBinds | (p,e) <-pats_and_exprs]
 
-mkRdrFunBind :: Located RdrName -> [LMatch RdrName (LHsExpr RdrName)] -> (Origin, LHsBind RdrName)
-mkRdrFunBind fun@(L loc fun_rdr) matches = (Generated, L loc (mkFunBind fun matches'))
+mkRdrFunBind :: Located RdrName -> [LMatch RdrName (LHsExpr RdrName)] -> LHsBind RdrName
+mkRdrFunBind fun@(L loc fun_rdr) matches = L loc (mkFunBind fun matches')
  where
    -- Catch-all eqn looks like
    --     fmap = error "Void fmap"
diff --git a/compiler/typecheck/TcGenGenerics.lhs b/compiler/typecheck/TcGenGenerics.lhs
index 564cd9ef9b2a..d4c39340535b 100644
--- a/compiler/typecheck/TcGenGenerics.lhs
+++ b/compiler/typecheck/TcGenGenerics.lhs
@@ -6,13 +6,7 @@ The deriving code for the Generic class
 (equivalent to the code in TcGenDeriv, for other classes)
 
 \begin{code}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# OPTIONS -fno-warn-tabs #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and
--- detab the module (please do the detabbing in a separate patch). See
---     http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
--- for details
+{-# LANGUAGE CPP, ScopedTypeVariables #-}
 
 
 module TcGenGenerics (canDoGenerics, canDoGenerics1,
@@ -42,11 +36,12 @@ import TcEnv
 import MkId
 import TcRnMonad
 import HscTypes
+import ErrUtils( Validity(..), andValid )
 import BuildTyCl
 import SrcLoc
 import Bag
 import VarSet (elemVarSet)
-import Outputable 
+import Outputable
 import FastString
 import Util
 
@@ -64,7 +59,7 @@ import Control.Monad (mplus,forM)
 For the generic representation we need to generate:
 \begin{itemize}
 \item A Generic instance
-\item A Rep type instance 
+\item A Rep type instance
 \item Many auxiliary datatypes and instances for them (for the meta-information)
 \end{itemize}
 
@@ -90,7 +85,7 @@ genGenericMetaTyCons tc mod =
 
         mkTyCon name = ASSERT( isExternalName name )
                        buildAlgTyCon name [] [] Nothing [] distinctAbstractTyConRhs
-                                          NonRecursive 
+                                          NonRecursive
                                           False          -- Not promotable
                                           False          -- Not GADT syntax
                                           NoParentTyCon
@@ -121,60 +116,63 @@ metaTyConsToDerivStuff tc metaDts =
       cClas <- tcLookupClass constructorClassName
       c_dfun_names <- sequence [ new_dfun_name cClas tc | _ <- metaC metaDts ]
       sClas <- tcLookupClass selectorClassName
-      s_dfun_names <- sequence (map sequence [ [ new_dfun_name sClas tc 
-                                               | _ <- x ] 
+      s_dfun_names <- sequence (map sequence [ [ new_dfun_name sClas tc
+                                               | _ <- x ]
                                              | x <- metaS metaDts ])
       fix_env <- getFixityEnv
 
       let
-        safeOverlap = safeLanguageOn dflags
         (dBinds,cBinds,sBinds) = mkBindsMetaD fix_env tc
-        mk_inst clas tc dfun_name 
+        mk_inst clas tc dfun_name
           = mkLocalInstance (mkDictFunId dfun_name [] [] clas tys)
-                            (NoOverlap safeOverlap)
+                            OverlapFlag { overlapMode   = NoOverlap
+                                        , isSafeOverlap = safeLanguageOn dflags }
                             [] clas tys
           where
             tys = [mkTyConTy tc]
-        
+
         -- Datatype
         d_metaTycon = metaD metaDts
         d_inst   = mk_inst dClas d_metaTycon d_dfun_name
         d_binds  = InstBindings { ib_binds = dBinds
                                 , ib_pragmas = []
+                                , ib_extensions = []
                                 , ib_standalone_deriving = False }
         d_mkInst = DerivInst (InstInfo { iSpec = d_inst, iBinds = d_binds })
-        
+
         -- Constructor
         c_metaTycons = metaC metaDts
         c_insts = [ mk_inst cClas c ds
                   | (c, ds) <- myZip1 c_metaTycons c_dfun_names ]
         c_binds = [ InstBindings { ib_binds = c
                                  , ib_pragmas = []
+                                 , ib_extensions = []
                                  , ib_standalone_deriving = False }
                   | c <- cBinds ]
         c_mkInst = [ DerivInst (InstInfo { iSpec = is, iBinds = bs })
                    | (is,bs) <- myZip1 c_insts c_binds ]
-        
+
         -- Selector
         s_metaTycons = metaS metaDts
         s_insts = map (map (\(s,ds) -> mk_inst sClas s ds))
                       (myZip2 s_metaTycons s_dfun_names)
         s_binds = [ [ InstBindings { ib_binds = s
                                    , ib_pragmas = []
+                                   , ib_extensions = []
                                    , ib_standalone_deriving = False }
                     | s <- ss ] | ss <- sBinds ]
         s_mkInst = map (map (\(is,bs) -> DerivInst (InstInfo { iSpec  = is
                                                              , iBinds = bs})))
                        (myZip2 s_insts s_binds)
-       
+
         myZip1 :: [a] -> [b] -> [(a,b)]
         myZip1 l1 l2 = ASSERT(length l1 == length l2) zip l1 l2
-        
+
         myZip2 :: [[a]] -> [[b]] -> [[(a,b)]]
         myZip2 l1 l2 =
           ASSERT(and (zipWith (>=) (map length l1) (map length l2)))
             [ zip x1 x2 | (x1,x2) <- zip l1 l2 ]
-        
+
       return $ mapBag DerivTyCon (metaTyCons2TyCons metaDts)
                `unionBags` listToBag (d_mkInst : c_mkInst ++ concat s_mkInst)
 \end{code}
@@ -186,14 +184,13 @@ metaTyConsToDerivStuff tc metaDts =
 %************************************************************************
 
 \begin{code}
-get_gen1_constrained_tys :: TyVar -> [Type] -> [Type]
+get_gen1_constrained_tys :: TyVar -> Type -> [Type]
 -- called by TcDeriv.inferConstraints; generates a list of types, each of which
 -- must be a Functor in order for the Generic1 instance to work.
-get_gen1_constrained_tys argVar =
-  concatMap $ argTyFold argVar $ ArgTyAlg {
-    ata_rec0 = const [],
-    ata_par1 = [], ata_rec1 = const [],
-    ata_comp = (:)}
+get_gen1_constrained_tys argVar
+  = argTyFold argVar $ ArgTyAlg { ata_rec0 = const []
+                                , ata_par1 = [], ata_rec1 = const []
+                                , ata_comp = (:) }
 
 {-
 
@@ -239,7 +236,7 @@ following constraints are satisfied.
 
 -}
 
-canDoGenerics :: TyCon -> [Type] -> Maybe SDoc
+canDoGenerics :: TyCon -> [Type] -> Validity
 -- canDoGenerics rep_tc tc_args determines if Generic/Rep can be derived for a
 -- type expression (rep_tc tc_arg0 tc_arg1 ... tc_argn).
 --
@@ -251,17 +248,17 @@ canDoGenerics tc tc_args
   = mergeErrors (
           -- Check (c) from Note [Requirements for deriving Generic and Rep].
               (if (not (null (tyConStupidTheta tc)))
-                then (Just (tc_name <+> text "must not have a datatype context"))
-                else Nothing) :
+                then (NotValid (tc_name <+> text "must not have a datatype context"))
+                else IsValid) :
           -- Check (a) from Note [Requirements for deriving Generic and Rep].
           --
           -- Data family indices can be instantiated; the `tc_args` here are
           -- the representation tycon args
               (if (all isTyVarTy (filterOut isKind tc_args))
-                then Nothing
-                else Just (tc_name <+> text "must not be instantiated;" <+>
-                           text "try deriving `" <> tc_name <+> tc_tys <>
-                           text "' instead"))
+                then IsValid
+                else NotValid (tc_name <+> text "must not be instantiated;" <+>
+                               text "try deriving `" <> tc_name <+> tc_tys <>
+                               text "' instead"))
           -- See comment below
             : (map bad_con (tyConDataCons tc)))
   where
@@ -279,28 +276,28 @@ canDoGenerics tc tc_args
         -- it relies on instantiating *polymorphic* sum and product types
         -- at the argument types of the constructors
     bad_con dc = if (any bad_arg_type (dataConOrigArgTys dc))
-                  then (Just (ppr dc <+> text "must not have unlifted or polymorphic arguments"))
+                  then (NotValid (ppr dc <+> text "must not have unlifted or polymorphic arguments"))
                   else (if (not (isVanillaDataCon dc))
-                          then (Just (ppr dc <+> text "must be a vanilla data constructor"))
-                          else Nothing)
+                          then (NotValid (ppr dc <+> text "must be a vanilla data constructor"))
+                          else IsValid)
 
-	-- Nor can we do the job if it's an existential data constructor,
-	-- Nor if the args are polymorphic types (I don't think)
+        -- Nor can we do the job if it's an existential data constructor,
+        -- Nor if the args are polymorphic types (I don't think)
     bad_arg_type ty = isUnLiftedType ty || not (isTauTy ty)
 
-mergeErrors :: [Maybe SDoc] -> Maybe SDoc
-mergeErrors []           = Nothing
-mergeErrors ((Just s):t) = case mergeErrors t of
-  Nothing -> Just s
-  Just s' -> Just (s <> text ", and" $$ s')
-mergeErrors (Nothing :t) = mergeErrors t
+mergeErrors :: [Validity] -> Validity
+mergeErrors []             = IsValid
+mergeErrors (NotValid s:t) = case mergeErrors t of
+  IsValid     -> NotValid s
+  NotValid s' -> NotValid (s <> text ", and" $$ s')
+mergeErrors (IsValid : t) = mergeErrors t
 
 -- A datatype used only inside of canDoGenerics1. It's the result of analysing
 -- a type term.
 data Check_for_CanDoGenerics1 = CCDG1
   { _ccdg1_hasParam :: Bool       -- does the parameter of interest occurs in
                                   -- this type?
-  , _ccdg1_errors   :: Maybe SDoc -- errors generated by this type
+  , _ccdg1_errors   :: Validity   -- errors generated by this type
   }
 
 {-
@@ -335,13 +332,13 @@ explicitly, even though foldDataConArgs is also doing this internally.
 -- are taken care of by the call to canDoGenerics.
 --
 -- It returns Nothing if deriving is possible. It returns (Just reason) if not.
-canDoGenerics1 :: TyCon -> [Type] -> Maybe SDoc
+canDoGenerics1 :: TyCon -> [Type] -> Validity
 canDoGenerics1 rep_tc tc_args =
-  canDoGenerics rep_tc tc_args `mplus` additionalChecks
+  canDoGenerics rep_tc tc_args `andValid` additionalChecks
   where
     additionalChecks
         -- check (f) from Note [Requirements for deriving Generic and Rep]
-      | null (tyConTyVars rep_tc) = Just $
+      | null (tyConTyVars rep_tc) = NotValid $
           ptext (sLit "Data type") <+> quotes (ppr rep_tc)
       <+> ptext (sLit "must have some type parameters")
 
@@ -349,19 +346,19 @@ canDoGenerics1 rep_tc tc_args =
 
     data_cons = tyConDataCons rep_tc
     check_con con = case check_vanilla con of
-      j@(Just _) -> [j]
-      Nothing -> _ccdg1_errors `map` foldDataConArgs (ft_check con) con
+      j@(NotValid {}) -> [j]
+      IsValid -> _ccdg1_errors `map` foldDataConArgs (ft_check con) con
 
     bad :: DataCon -> SDoc -> SDoc
     bad con msg = ptext (sLit "Constructor") <+> quotes (ppr con) <+> msg
 
-    check_vanilla :: DataCon -> Maybe SDoc
-    check_vanilla con | isVanillaDataCon con = Nothing
-                      | otherwise            = Just (bad con existential)
+    check_vanilla :: DataCon -> Validity
+    check_vanilla con | isVanillaDataCon con = IsValid
+                      | otherwise            = NotValid (bad con existential)
 
-    bmzero      = CCDG1 False Nothing
-    bmbad con s = CCDG1 True $ Just $ bad con s
-    bmplus (CCDG1 b1 m1) (CCDG1 b2 m2) = CCDG1 (b1 || b2) (mplus m1 m2)
+    bmzero      = CCDG1 False IsValid
+    bmbad con s = CCDG1 True $ NotValid $ bad con s
+    bmplus (CCDG1 b1 m1) (CCDG1 b2 m2) = CCDG1 (b1 || b2) (m1 `andValid` m2)
 
     -- check (g) from Note [degenerate use of FFoldType]
     ft_check :: DataCon -> FFoldType Check_for_CanDoGenerics1
@@ -389,7 +386,7 @@ canDoGenerics1 rep_tc tc_args =
       , ft_forall  = \_ body -> body -- polytypes are handled elsewhere
       }
       where
-        caseVar = CCDG1 True Nothing
+        caseVar = CCDG1 True IsValid
 
 
     existential = text "must not have existential arguments"
@@ -399,13 +396,13 @@ canDoGenerics1 rep_tc tc_args =
 \end{code}
 
 %************************************************************************
-%*									*
+%*                                                                      *
 \subsection{Generating the RHS of a generic default method}
-%*									*
+%*                                                                      *
 %************************************************************************
 
 \begin{code}
-type US = Int	-- Local unique supply, just a plain Int
+type US = Int   -- Local unique supply, just a plain Int
 type Alt = (LPat RdrName, LHsExpr RdrName)
 
 -- GenericKind serves to mark if a datatype derives Generic (Gen0) or
@@ -432,7 +429,7 @@ gk2gkDC Gen1_{} d = Gen1_DC $ last $ dataConUnivTyVars d
 
 -- Bindings for the Generic instance
 mkBindsRep :: GenericKind -> TyCon -> LHsBinds RdrName
-mkBindsRep gk tycon = 
+mkBindsRep gk tycon =
     unitBag (mkRdrFunBind (L loc from01_RDR) from_matches)
   `unionBags`
     unitBag (mkRdrFunBind (L loc to01_RDR) to_matches)
@@ -454,7 +451,7 @@ mkBindsRep gk tycon =
                   Gen1 -> ASSERT(length tyvars >= 1)
                           Gen1_ (last tyvars)
                     where tyvars = tyConTyVars tycon
-        
+
 --------------------------------------------------------------------------------
 -- The type synonym instance and synonym
 --       type instance Rep (D a b) = Rep_D a b
@@ -466,7 +463,7 @@ tc_mkRepFamInsts :: GenericKind     -- Gen0 or Gen1
                -> MetaTyCons      -- Metadata datatypes to refer to
                -> Module          -- Used as the location of the new RepTy
                -> TcM (FamInst)   -- Generated representation0 coercion
-tc_mkRepFamInsts gk tycon metaDts mod = 
+tc_mkRepFamInsts gk tycon metaDts mod =
        -- Consider the example input tycon `D`, where data D a b = D_ a
        -- Also consider `R:DInt`, where { data family D x y :: * -> *
        --                               ; data instance D Int a b = D_ a }
@@ -499,7 +496,7 @@ tc_mkRepFamInsts gk tycon metaDts mod =
 
        -- `repTy` = D1 ... (C1 ... (S1 ... (Rec0 a))) :: * -> *
      ; repTy <- tc_mkRepTy gk_ tycon metaDts
-    
+
        -- `rep_name` is a name we generate for the synonym
      ; rep_name <- let mkGen = case gk of Gen0 -> mkGenR; Gen1 -> mkGen1R
                    in newGlobalBinder mod (mkGen (nameOccName (tyConName tycon)))
@@ -582,10 +579,10 @@ tc_mkRepTy ::  -- Gen0_ or Gen1_, for Rep or Rep1
               -- The type to generate representation for
             -> TyCon
                -- Metadata datatypes to refer to
-            -> MetaTyCons 
+            -> MetaTyCons
                -- Generated representation0 type
             -> TcM Type
-tc_mkRepTy gk_ tycon metaDts = 
+tc_mkRepTy gk_ tycon metaDts =
   do
     d1    <- tcLookupTyCon d1TyConName
     c1    <- tcLookupTyCon c1TyConName
@@ -599,7 +596,7 @@ tc_mkRepTy gk_ tycon metaDts =
     plus  <- tcLookupTyCon sumTyConName
     times <- tcLookupTyCon prodTyConName
     comp  <- tcLookupTyCon compTyConName
-    
+
     let mkSum' a b = mkTyConApp plus  [a,b]
         mkProd a b = mkTyConApp times [a,b]
         mkComp a b = mkTyConApp comp  [a,b]
@@ -613,7 +610,7 @@ tc_mkRepTy gk_ tycon metaDts =
         mkS True  _ a = mkTyConApp s1 [mkTyConTy nS1, a]
         -- This field has a  label
         mkS False d a = mkTyConApp s1 [d, a]
-        
+
         -- Sums and products are done in the same way for both Rep and Rep1
         sumP [] = mkTyConTy v1
         sumP l  = ASSERT(length metaCTyCons == length l)
@@ -628,9 +625,9 @@ tc_mkRepTy gk_ tycon metaDts =
                         ASSERT(length l == length (metaSTyCons !! i))
                           foldBal mkProd [ arg d t b
                                          | (d,t) <- zip (metaSTyCons !! i) l ]
-        
+
         arg :: Type -> Type -> Bool -> Type
-        arg d t b = mkS b d $ case gk_ of 
+        arg d t b = mkS b d $ case gk_ of
             -- Here we previously used Par0 if t was a type variable, but we
             -- realized that we can't always guarantee that we are wrapping-up
             -- all type variables in Par0. So we decided to stop using Par0
@@ -643,40 +640,40 @@ tc_mkRepTy gk_ tycon metaDts =
             argPar argVar = argTyFold argVar $ ArgTyAlg
               {ata_rec0 = mkRec0, ata_par1 = mkPar1,
                ata_rec1 = mkRec1, ata_comp = mkComp}
-        
-       
+
+
         metaDTyCon  = mkTyConTy (metaD metaDts)
         metaCTyCons = map mkTyConTy (metaC metaDts)
         metaSTyCons = map (map mkTyConTy) (metaS metaDts)
-        
+
     return (mkD tycon)
 
 --------------------------------------------------------------------------------
 -- Meta-information
 --------------------------------------------------------------------------------
 
-data MetaTyCons = MetaTyCons { -- One meta datatype per dataype
+data MetaTyCons = MetaTyCons { -- One meta datatype per datatype
                                metaD :: TyCon
                                -- One meta datatype per constructor
                              , metaC :: [TyCon]
                                -- One meta datatype per selector per constructor
                              , metaS :: [[TyCon]] }
-                             
+
 instance Outputable MetaTyCons where
   ppr (MetaTyCons d c s) = ppr d $$ vcat (map ppr c) $$ vcat (map ppr (concat s))
-                                   
+
 metaTyCons2TyCons :: MetaTyCons -> Bag TyCon
 metaTyCons2TyCons (MetaTyCons d c s) = listToBag (d : c ++ concat s)
 
 
 -- Bindings for Datatype, Constructor, and Selector instances
-mkBindsMetaD :: FixityEnv -> TyCon 
+mkBindsMetaD :: FixityEnv -> TyCon
              -> ( LHsBinds RdrName      -- Datatype instance
                 , [LHsBinds RdrName]    -- Constructor instances
                 , [[LHsBinds RdrName]]) -- Selector instances
 mkBindsMetaD fix_env tycon = (dtBinds, allConBinds, allSelBinds)
       where
-        mkBag l = foldr1 unionBags 
+        mkBag l = foldr1 unionBags
                     [ unitBag (mkRdrFunBind (L loc name) matches)
                         | (name, matches) <- l ]
         dtBinds       = mkBag ( [ (datatypeName_RDR, dtName_matches)
@@ -714,7 +711,7 @@ mkBindsMetaD fix_env tycon = (dtBinds, allConBinds, allSelBinds)
 
         dtName_matches     = mkStringLHS . occNameString . nameOccName
                            $ tyConName_user
-        moduleName_matches = mkStringLHS . moduleNameString . moduleName 
+        moduleName_matches = mkStringLHS . moduleNameString . moduleName
                            . nameModule . tyConName $ tycon
         isNewtype_matches  = [mkSimpleHsAlt nlWildPat (nlHsVar true_RDR)]
 
@@ -775,10 +772,10 @@ mk1Sum gk_ us i n datacon = (from_alt, to_alt)
     us'          = us + n_args
 
     datacon_rdr  = getRdrName datacon
-    
+
     from_alt     = (nlConVarPat datacon_rdr datacon_vars, from_alt_rhs)
     from_alt_rhs = mkM1_E (genLR_E i n (mkProd_E gk_ us' datacon_varTys))
-    
+
     to_alt     = (mkM1_P (genLR_P i n (mkProd_P gk us' datacon_vars)), to_alt_rhs)
                  -- These M1s are meta-information for the datatype
     to_alt_rhs = case gk_ of
@@ -819,9 +816,9 @@ genLR_E i n e
 
 -- Build a product expression
 mkProd_E :: GenericKind_DC      -- Generic or Generic1?
-         -> US	            -- Base for unique names
+         -> US              -- Base for unique names
          -> [(RdrName, Type)] -- List of variables matched on the lhs and their types
-	 -> LHsExpr RdrName -- Resulting product expression
+         -> LHsExpr RdrName -- Resulting product expression
 mkProd_E _   _ []     = mkM1_E (nlHsVar u1DataCon_RDR)
 mkProd_E gk_ _ varTys = mkM1_E (foldBal prod appVars)
                      -- These M1s are meta-information for the constructor
@@ -845,9 +842,9 @@ wrapArg_E (Gen1_DC argVar) (var, ty) = mkM1_E $ converter ty `nlHsApp` nlHsVar v
 
 -- Build a product pattern
 mkProd_P :: GenericKind   -- Gen0 or Gen1
-         -> US		        -- Base for unique names
-	       -> [RdrName]     -- List of variables to match
-	       -> LPat RdrName  -- Resulting product pattern
+         -> US                  -- Base for unique names
+               -> [RdrName]     -- List of variables to match
+               -> LPat RdrName  -- Resulting product pattern
 mkProd_P _  _ []   = mkM1_P (nlNullaryConPat u1DataCon_RDR)
 mkProd_P gk _ vars = mkM1_P (foldBal prod appVars)
                      -- These M1s are meta-information for the constructor
diff --git a/compiler/typecheck/TcHsSyn.lhs b/compiler/typecheck/TcHsSyn.lhs
index 1c9ac57e8098..f4d5cf262cad 100644
--- a/compiler/typecheck/TcHsSyn.lhs
+++ b/compiler/typecheck/TcHsSyn.lhs
@@ -9,12 +9,15 @@ This module is an extension of @HsSyn@ syntax, for use in the type
 checker.
 
 \begin{code}
+{-# LANGUAGE CPP #-}
+
 module TcHsSyn (
         mkHsConApp, mkHsDictLet, mkHsApp,
         hsLitType, hsLPatType, hsPatType,
         mkHsAppTy, mkSimpleHsAlt,
         nlHsIntLit,
         shortCutLit, hsOverLitName,
+        conLikeResTy,
 
         -- re-exported from TcMonad
         TcId, TcIdSet,
@@ -38,7 +41,9 @@ import TcEvidence
 import TysPrim
 import TysWiredIn
 import Type
+import ConLike
 import DataCon
+import PatSyn( patSynInstResTy )
 import Name
 import NameSet
 import Var
@@ -80,14 +85,19 @@ hsPatType (ViewPat _ _ ty)            = ty
 hsPatType (ListPat _ ty Nothing)      = mkListTy ty
 hsPatType (ListPat _ _ (Just (ty,_))) = ty
 hsPatType (PArrPat _ ty)              = mkPArrTy ty
-hsPatType (TuplePat _ _ ty)           = ty
-hsPatType (ConPatOut { pat_ty = ty }) = ty
+hsPatType (TuplePat _ bx tys)         = mkTupleTy (boxityNormalTupleSort bx) tys
+hsPatType (ConPatOut { pat_con = L _ con, pat_arg_tys = tys }) 
+                                      = conLikeResTy con tys
 hsPatType (SigPatOut _ ty)            = ty
 hsPatType (NPat lit _ _)              = overLitType lit
 hsPatType (NPlusKPat id _ _ _)        = idType (unLoc id)
 hsPatType (CoPat _ _ ty)              = ty
 hsPatType p                           = pprPanic "hsPatType" (ppr p)
 
+conLikeResTy :: ConLike -> [Type] -> Type
+conLikeResTy (RealDataCon con) tys = mkTyConApp (dataConTyCon con) tys
+conLikeResTy (PatSynCon ps)    tys = patSynInstResTy ps tys
+
 hsLitType :: HsLit -> TcType
 hsLitType (HsChar _)       = charTy
 hsLitType (HsCharPrim _)   = charPrimTy
@@ -405,10 +415,8 @@ warnMissingSig msg id
 zonkMonoBinds :: ZonkEnv -> SigWarn -> LHsBinds TcId -> TcM (LHsBinds Id)
 zonkMonoBinds env sig_warn binds = mapBagM (zonk_lbind env sig_warn) binds
 
-zonk_lbind :: ZonkEnv -> SigWarn -> (Origin, LHsBind TcId) -> TcM (Origin, LHsBind Id)
-zonk_lbind env sig_warn (origin, lbind)
-  = do  { lbind' <- wrapLocM (zonk_bind env sig_warn) lbind
-        ; return (origin, lbind') }
+zonk_lbind :: ZonkEnv -> SigWarn -> LHsBind TcId -> TcM (LHsBind Id)
+zonk_lbind env sig_warn = wrapLocM (zonk_bind env sig_warn)
 
 zonk_bind :: ZonkEnv -> SigWarn -> HsBind TcId -> TcM (HsBind Id)
 zonk_bind env sig_warn bind@(PatBind { pat_lhs = pat, pat_rhs = grhss, pat_rhs_ty = ty})
@@ -460,18 +468,19 @@ zonk_bind env sig_warn (AbsBinds { abs_tvs = tyvars, abs_ev_vars = evs
                         , abe_mono = zonkIdOcc env mono_id
                         , abe_prags = new_prags })
 
-zonk_bind env _sig_warn bind@(PatSynBind { patsyn_id = L loc id
-                                         , patsyn_args = details
-                                         , patsyn_def = lpat
-                                         , patsyn_dir = dir })
+zonk_bind env _sig_warn (PatSynBind bind@(PSB { psb_id = L loc id
+                                              , psb_args = details
+                                              , psb_def = lpat
+                                              , psb_dir = dir }))
   = do { id' <- zonkIdBndr env id
        ; details' <- zonkPatSynDetails env details
        ;(env1, lpat') <- zonkPat env lpat
        ; (_env2, dir') <- zonkPatSynDir env1 dir
-       ; return (bind { patsyn_id = L loc id'
-                      , patsyn_args = details'
-                      , patsyn_def = lpat'
-                      , patsyn_dir = dir' }) }
+       ; return $ PatSynBind $
+                  bind { psb_id = L loc id'
+                       , psb_args = details'
+                       , psb_def = lpat'
+                       , psb_dir = dir' } }
 
 zonkPatSynDetails :: ZonkEnv
                   -> HsPatSynDetails (Located TcId)
@@ -481,6 +490,9 @@ zonkPatSynDetails env = traverse (wrapLocM $ zonkIdBndr env)
 zonkPatSynDir :: ZonkEnv -> HsPatSynDir TcId -> TcM (ZonkEnv, HsPatSynDir Id)
 zonkPatSynDir env Unidirectional = return (env, Unidirectional)
 zonkPatSynDir env ImplicitBidirectional = return (env, ImplicitBidirectional)
+zonkPatSynDir env (ExplicitBidirectional mg) = do
+    mg' <- zonkMatchGroup env zonkLExpr mg
+    return (env, ExplicitBidirectional mg')
 
 zonkSpecPrags :: ZonkEnv -> TcSpecPrags -> TcM TcSpecPrags
 zonkSpecPrags _   IsDefaultMethod = return IsDefaultMethod
@@ -506,11 +518,11 @@ zonkLTcSpecPrags env ps
 zonkMatchGroup :: ZonkEnv
                -> (ZonkEnv -> Located (body TcId) -> TcM (Located (body Id)))
                -> MatchGroup TcId (Located (body TcId)) -> TcM (MatchGroup Id (Located (body Id)))
-zonkMatchGroup env zBody (MG { mg_alts = ms, mg_arg_tys = arg_tys, mg_res_ty = res_ty })
+zonkMatchGroup env zBody (MG { mg_alts = ms, mg_arg_tys = arg_tys, mg_res_ty = res_ty, mg_origin = origin })
   = do  { ms' <- mapM (zonkMatch env zBody) ms
         ; arg_tys' <- zonkTcTypeToTypes env arg_tys
         ; res_ty'  <- zonkTcTypeToType env res_ty
-        ; return (MG { mg_alts = ms', mg_arg_tys = arg_tys', mg_res_ty = res_ty' }) }
+        ; return (MG { mg_alts = ms', mg_arg_tys = arg_tys', mg_res_ty = res_ty', mg_origin = origin }) }
 
 zonkMatch :: ZonkEnv
           -> (ZonkEnv -> Located (body TcId) -> TcM (Located (body Id)))
@@ -1027,16 +1039,16 @@ zonk_pat env (PArrPat pats ty)
         ; (env', pats') <- zonkPats env pats
         ; return (env', PArrPat pats' ty') }
 
-zonk_pat env (TuplePat pats boxed ty)
-  = do  { ty' <- zonkTcTypeToType env ty
+zonk_pat env (TuplePat pats boxed tys)
+  = do  { tys' <- mapM (zonkTcTypeToType env) tys
         ; (env', pats') <- zonkPats env pats
-        ; return (env', TuplePat pats' boxed ty') }
+        ; return (env', TuplePat pats' boxed tys') }
 
-zonk_pat env p@(ConPatOut { pat_ty = ty, pat_tvs = tyvars
+zonk_pat env p@(ConPatOut { pat_arg_tys = tys, pat_tvs = tyvars
                           , pat_dicts = evs, pat_binds = binds
                           , pat_args = args, pat_wrap = wrapper })
   = ASSERT( all isImmutableTyVar tyvars )
-    do  { new_ty <- zonkTcTypeToType env ty
+    do  { new_tys <- mapM (zonkTcTypeToType env) tys
         ; (env0, new_tyvars) <- zonkTyBndrsX env tyvars
           -- Must zonk the existential variables, because their
           -- /kind/ need potential zonking.
@@ -1045,7 +1057,7 @@ zonk_pat env p@(ConPatOut { pat_ty = ty, pat_tvs = tyvars
         ; (env2, new_binds) <- zonkTcEvBinds env1 binds
         ; (env3, new_wrapper) <- zonkCoFn env2 wrapper
         ; (env', new_args) <- zonkConStuff env3 args
-        ; return (env', p { pat_ty = new_ty,
+        ; return (env', p { pat_arg_tys = new_tys,
                             pat_tvs = new_tyvars,
                             pat_dicts = new_evs,
                             pat_binds = new_binds,
diff --git a/compiler/typecheck/TcHsType.lhs b/compiler/typecheck/TcHsType.lhs
index eed906898b7d..39c0acf2a6b1 100644
--- a/compiler/typecheck/TcHsType.lhs
+++ b/compiler/typecheck/TcHsType.lhs
@@ -5,7 +5,8 @@
 \section[TcMonoType]{Typechecking user-specified @MonoTypes@}
 
 \begin{code}
-{-# OPTIONS -fno-warn-tabs #-}
+{-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
 -- The above warning supression flag is a temporary kludge.
 -- While working on this module you are encouraged to remove it and
 -- detab the module (please do the detabbing in a separate patch). See
@@ -24,7 +25,6 @@ module TcHsType (
 
 		-- Kind-checking types
                 -- No kind generalisation, no checkValidType
-	KindCheckingStrategy(..), kcStrategy, kcStrategyFamDecl,
         kcHsTyVarBndrs, tcHsTyVarBndrs, 
         tcHsLiftedType, tcHsOpenType,
 	tcLHsType, tcCheckLHsType, 
@@ -53,6 +53,7 @@ import TcType
 import Type
 import TypeRep( Type(..) )  -- For the mkNakedXXX stuff
 import Kind
+import RdrName( lookupLocalRdrOcc )
 import Var
 import VarSet
 import TyCon
@@ -72,8 +73,9 @@ import Outputable
 import FastString
 import Util
 
+import Data.Maybe( isNothing )
 import Control.Monad ( unless, when, zipWithM )
-import PrelNames( ipClassName, funTyConKey )
+import PrelNames( ipClassName, funTyConKey, allNameStrings )
 \end{code}
 
 
@@ -207,18 +209,22 @@ tc_inst_head hs_ty
   = tc_hs_type hs_ty ekConstraint
 
 -----------------
-tcHsDeriv :: HsType Name -> TcM ([TyVar], Class, [Type])
--- Like tcHsSigTypeNC, but for the ...deriving( ty ) clause
-tcHsDeriv hs_ty 
-  = do { kind <- newMetaKindVar
-       ; ty   <- tcCheckHsTypeAndGen hs_ty kind
-                 -- Funny newtype deriving form
-                 -- 	forall a. C [a]
-                 -- where C has arity 2. Hence any-kinded result
-       ; ty   <- zonkSigType ty
+tcHsDeriv :: HsType Name -> TcM ([TyVar], Class, [Type], Kind)
+-- Like tcHsSigTypeNC, but for the ...deriving( C t1 ty2 ) clause
+-- Returns the C, [ty1, ty2, and the kind of C's *next* argument
+-- E.g.    class C (a::*) (b::k->k)
+--         data T a b = ... deriving( C Int )
+--    returns ([k], C, [k, Int],  k->k)
+-- Also checks that (C ty1 ty2 arg) :: Constraint
+-- if arg has a suitable kind
+tcHsDeriv hs_ty
+  = do { arg_kind <- newMetaKindVar
+       ; ty <- tcCheckHsTypeAndGen hs_ty (mkArrowKind arg_kind constraintKind)
+       ; ty       <- zonkSigType ty
+       ; arg_kind <- zonkSigType arg_kind
        ; let (tvs, pred) = splitForAllTys ty
        ; case getClassPredTys_maybe pred of
-           Just (cls, tys) -> return (tvs, cls, tys)
+           Just (cls, tys) -> return (tvs, cls, tys, arg_kind)
            Nothing -> failWithTc (ptext (sLit "Illegal deriving item") <+> quotes (ppr hs_ty)) }
 
 -- Used for 'VECTORISE [SCALAR] instance' declarations
@@ -389,13 +395,17 @@ tc_hs_type hs_ty@(HsAppTy ty1 ty2) exp_kind
     (fun_ty, arg_tys) = splitHsAppTys ty1 [ty2]
 
 --------- Foralls
-tc_hs_type hs_ty@(HsForAllTy _ hs_tvs context ty) exp_kind
-  = tcHsTyVarBndrs hs_tvs $ \ tvs' -> 
+tc_hs_type hs_ty@(HsForAllTy _ hs_tvs context ty) exp_kind@(EK exp_k _)
+  | isConstraintKind exp_k
+  = failWithTc (hang (ptext (sLit "Illegal constraint:")) 2 (ppr hs_ty))
+
+  | otherwise
+  = tcHsTyVarBndrs hs_tvs $ \ tvs' ->
     -- Do not kind-generalise here!  See Note [Kind generalisation]
     do { ctxt' <- tcHsContext context
        ; ty' <- if null (unLoc context) then  -- Plain forall, no context
                    tc_lhs_type ty exp_kind    -- Why exp_kind?  See Note [Body kind of forall]
-                else     
+                else
                    -- If there is a context, then this forall is really a
                    -- _function_, so the kind of the result really is *
                    -- The body kind (result of the function can be * or #, hence ekOpen
@@ -614,7 +624,6 @@ tcTyVar :: Name -> TcM (TcType, TcKind)
 tcTyVar name         -- Could be a tyvar, a tycon, or a datacon
   = do { traceTc "lk1" (ppr name)
        ; thing <- tcLookup name
-       ; traceTc "lk2" (ppr name <+> ppr thing)
        ; case thing of
            ATyVar _ tv 
               | isKindVar tv
@@ -724,17 +733,17 @@ mkNakedAppTys ty1                tys2 = foldl AppTy ty1 tys2
 
 zonkSigType :: TcType -> TcM TcType
 -- Zonk the result of type-checking a user-written type signature
--- It may have kind varaibles in it, but no meta type variables
+-- It may have kind variables in it, but no meta type variables
 -- Because of knot-typing (see Note [Zonking inside the knot])
--- it may need to establish the Type invariants; 
+-- it may need to establish the Type invariants;
 -- hence the use of mkTyConApp and mkAppTy
 zonkSigType ty
   = go ty
   where
     go (TyConApp tc tys) = do tys' <- mapM go tys
                               return (mkTyConApp tc tys')
-                -- Key point: establish Type invariants! 
-                -- See Note [Zonking inside the knot] 
+                -- Key point: establish Type invariants!
+                -- See Note [Zonking inside the knot]
 
     go (LitTy n)         = return (LitTy n)
 
@@ -892,181 +901,7 @@ addTypeCtxt (L _ ty) thing
 %*									*
 %************************************************************************
 
-Note [Kind-checking strategies]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-There are three main declarations that we have to kind check carefully in the
-presence of -XPolyKinds: classes, datatypes, and data/type families. They each
-have a different kind-checking strategy (labeled in the parentheses above each
-section). This should potentially be cleaned up in the future, but this is how
-it stands now (June 2013).
-
-Classes (ParametricKinds):
-  - kind-polymorphic by default
-  - each un-annotated type variable is given a fresh meta kind variable
-  - every explicit kind variable becomes a SigTv during inference
-  - no generalisation is done while kind-checking the recursive group
-
-  Taken together, this means that classes cannot participate in polymorphic
-  recursion. Thus, the following is not definable:
-
-  class Fugly (a :: k) where
-    foo :: forall (b :: k -> *). Fugly b => b a
-
-  But, because explicit kind variables are SigTvs, it is OK for the kind to
-  be forced to be the same kind that is used in a separate declaration. See
-  test case polykinds/T7020.hs.
-
-Datatypes:
-  Here we have two cases, whether or not a Full Kind Signature is provided.
-  A Full Kind Signature means that there is a top-level :: in the definition
-  of the datatype. For example:
-
-  data T1 :: k -> Bool -> * where ...         -- YES
-  data T2 (a :: k) :: Bool -> * where ...     -- YES
-  data T3 (a :: k) (b :: Bool) :: * where ... -- YES
-  data T4 (a :: k) (b :: Bool) where ...      -- NO
-
-  Kind signatures are not allowed on datatypes declared in the H98 style,
-  so those always have no Full Kind Signature.
-
-  Full Kind Signature (FullKindSignature):
-    - each un-annotated type variable defaults to *
-    - every explicit kind variable becomes a skolem during type inference
-    - these kind variables are generalised *before* kind-checking the group
-
-    With these rules, polymorphic recursion is possible. This is essentially
-    because of the generalisation step before kind-checking the group -- it
-    gives the kind-checker enough flexibility to supply the right kind arguments
-    to support polymorphic recursion.
-
-  no Full Kind Signature (ParametricKinds):
-    - kind-polymorphic by default
-    - each un-annotated type variable is given a fresh meta kind variable
-    - every explicit kind variable becomes a SigTv during inference
-    - no generalisation is done while kind-checking the recursive group
-
-    Thus, no polymorphic recursion in this case. See also Trac #6093 & #6049.
-
-Type families:
-  Here we have three cases: open top-level families, closed top-level families,
-  and open associated types. (There are no closed associated types, for good
-  reason.)
-
-  Open top-level families (FullKindSignature):
-    - All open top-level families are considered to have a Full Kind Signature
-    - All arguments and the result default to *
-    - All kind variables are skolems
-    - All kind variables are generalised before kind-checking the group
-
-    This behaviour supports kind-indexed type and data families, because we
-    need to have generalised before kind-checking for this to work. For example:
-
-    type family F (a :: k)
-    type instance F Int = Bool
-    type instance F Maybe = Char
-    type instance F (x :: * -> * -> *) = Double
-
-  Closed top-level families (NonParametricKinds):
-    - kind-monomorphic by default
-    - each un-annotated type variable is given a fresh meta kind variable
-    - every explicit kind variable becomes a skolem during inference
-    - all such skolems are generalised before kind-checking; other kind
-      variables are not generalised
-    - all unconstrained meta kind variables are defaulted to * at the
-      end of kind checking
-
-    This behaviour is to allow kind inference to occur in closed families, but
-    without becoming too polymorphic. For example:
-
-    type family F a where
-      F Int = Bool
-      F Bool = Char
-
-    We would want F to have kind * -> * from this definition, although something
-    like k1 -> k2 would be perfectly sound. The reason we want this restriction is
-    that it is better to have (F Maybe) be a kind error than simply stuck.
-
-    The kind inference gives us also
-
-    type family Not b where
-      Not False = True
-      Not True  = False
-
-    With an open family, the above would need kind annotations in its header.
-
-    The tricky case is
-
-    type family G a (b :: k) where
-      G Int Int    = False
-      G Bool Maybe = True
-
-    We want this to work. But, we also want (G Maybe Maybe) to be a kind error
-    (in the first argument). So, we need to generalise the skolem "k" but not
-    the meta kind variable associated with "a".
-
-  Associated families (FullKindSignature):
-    - Kind-monomorphic by default
-    - Result kind defaults to *
-    - Each type variable is either in the class header or not:
-      - Type variables in the class header are given the kind inherited from
-        the class header (and checked against an annotation, if any)
-      - Un-annotated type variables default to *
-    - Each kind variable mentioned in the class header becomes a SigTv during
-      kind inference.
-    - Each kind variable not mentioned in the class header becomes a skolem during
-      kind inference.
-    - Only the skolem kind variables are generalised before kind checking.
-
-    Here are some examples:
-    
-    class Foo1 a b where
-      type Bar1 (a :: k) (b :: k)
-
-    The kind of Foo1 will be k -> k -> Constraint. Kind annotations on associated
-    type declarations propagate to the header because the type variables in Bar1's
-    declaration inherit the (meta) kinds of the class header.
-
-    class Foo2 a where
-      type Bar2 a
-
-    The kind of Bar2 will be k -> *.
-
-    class Foo3 a where
-      type Bar3 a (b :: k)
-      meth :: Bar3 a Maybe -> ()
-
-    The kind of Bar3 will be k1 -> k2 -> *. This only kind-checks because the kind
-    of b is generalised before kind-checking.
-
-    class Foo4 a where
-      type Bar4 a b
-
-    Here, the kind of Bar4 will be k -> * -> *, because b is not mentioned in the
-    class header, so it defaults to *.
-
 \begin{code}
-data KindCheckingStrategy   -- See Note [Kind-checking strategies]
-  = ParametricKinds
-  | NonParametricKinds
-  | FullKindSignature
-  deriving (Eq)
-
--- determine the appropriate strategy for a decl
-kcStrategy :: TyClDecl Name -> KindCheckingStrategy
-kcStrategy d@(ForeignType {}) = pprPanic "kcStrategy" (ppr d)
-kcStrategy (FamDecl fam_decl)
-  = kcStrategyFamDecl fam_decl
-kcStrategy (SynDecl {})       = ParametricKinds
-kcStrategy (DataDecl { tcdDataDefn = HsDataDefn { dd_kindSig = m_ksig }})
-  | Just _ <- m_ksig            = FullKindSignature
-  | otherwise                   = ParametricKinds
-kcStrategy (ClassDecl {})     = ParametricKinds
-
--- if the ClosedTypeFamily has no equations, do the defaulting to *, etc.
-kcStrategyFamDecl :: FamilyDecl Name -> KindCheckingStrategy
-kcStrategyFamDecl (FamilyDecl { fdInfo = ClosedTypeFamily (_:_) }) = NonParametricKinds
-kcStrategyFamDecl _                                                = FullKindSignature
 
 mkKindSigVar :: Name -> TcM KindVar
 -- Use the specified name; don't clone it
@@ -1087,13 +922,17 @@ kcScopedKindVars kv_ns thing_inside
                      -- NB: use mutable signature variables
        ; tcExtendTyVarEnv2 (kv_ns `zip` kvs) thing_inside } 
 
-kcHsTyVarBndrs :: KindCheckingStrategy
+-- | Kind-check a 'LHsTyVarBndrs'. If the decl under consideration has a complete,
+-- user-supplied kind signature (CUSK), generalise the result. Used in 'getInitialKind'
+-- and in kind-checking. See also Note [Complete user-supplied kind signatures] in
+-- HsDecls.
+kcHsTyVarBndrs :: Bool    -- ^ True <=> the decl being checked has a CUSK
                -> LHsTyVarBndrs Name 
-	       -> TcM (Kind, r)   -- the result kind, possibly with other info
-	       -> TcM (Kind, r)
--- Used in getInitialKind
-kcHsTyVarBndrs strat (HsQTvs { hsq_kvs = kv_ns, hsq_tvs = hs_tvs }) thing_inside
-  = do { kvs <- if skolem_kvs
+	       -> TcM (Kind, r)   -- ^ the result kind, possibly with other info
+	       -> TcM (Kind, r)   -- ^ The full kind of the thing being declared,
+                                  -- with the other info
+kcHsTyVarBndrs cusk (HsQTvs { hsq_kvs = kv_ns, hsq_tvs = hs_tvs }) thing_inside
+  = do { kvs <- if cusk
                 then mapM mkKindSigVar kv_ns
                 else mapM (\n -> newSigTyVar n superKind) kv_ns
        ; tcExtendTyVarEnv2 (kv_ns `zip` kvs) $
@@ -1102,24 +941,18 @@ kcHsTyVarBndrs strat (HsQTvs { hsq_kvs = kv_ns, hsq_tvs = hs_tvs }) thing_inside
        ; let full_kind = mkArrowKinds (map snd nks) res_kind
              kvs       = filter (not . isMetaTyVar) $
                          varSetElems $ tyVarsOfType full_kind
-             gen_kind  = if generalise
+             gen_kind  = if cusk
                          then mkForAllTys kvs full_kind
                          else full_kind
        ; return (gen_kind, stuff) } }
   where
-    -- See Note [Kind-checking strategies]
-    (skolem_kvs, default_to_star, generalise) = case strat of
-          ParametricKinds    -> (False, False, False)
-          NonParametricKinds -> (True,  False, True)
-          FullKindSignature  -> (True,  True,  True)
-
     kc_hs_tv :: HsTyVarBndr Name -> TcM (Name, TcKind)
     kc_hs_tv (UserTyVar n)
       = do { mb_thing <- tcLookupLcl_maybe n
            ; kind <- case mb_thing of
-               	       Just (AThing k)     -> return k
-               	       _ | default_to_star -> return liftedTypeKind
-               	         | otherwise       -> newMetaKindVar
+               	       Just (AThing k) -> return k
+               	       _ | cusk        -> return liftedTypeKind
+               	         | otherwise   -> newMetaKindVar
            ; return (n, kind) }
     kc_hs_tv (KindedTyVar n k) 
       = do { kind <- tcLHsKind k
@@ -1249,7 +1082,11 @@ kcTyClTyVars :: Name -> LHsTyVarBndrs Name -> TcM a -> TcM a
 kcTyClTyVars name (HsQTvs { hsq_kvs = kvs, hsq_tvs = hs_tvs }) thing_inside
   = kcScopedKindVars kvs $
     do 	{ tc_kind <- kcLookupKind name
-	; let (arg_ks, _res_k) = splitKindFunTysN (length hs_tvs) tc_kind
+	; let (_, mono_kind)   = splitForAllTys tc_kind
+                     -- if we have a FullKindSignature, the tc_kind may already
+                     -- be generalized. The kvs get matched up while kind-checking
+                     -- the types in kc_tv, below
+              (arg_ks, _res_k) = splitKindFunTysN (length hs_tvs) mono_kind
                      -- There should be enough arrows, because
                      -- getInitialKinds used the tcdTyVars
         ; name_ks <- zipWithM kc_tv hs_tvs arg_ks
@@ -1297,6 +1134,11 @@ tcTyClTyVars tycon (HsQTvs { hsq_kvs = hs_kvs, hsq_tvs = hs_tvs }) thing_inside
        ; tvs <- zipWithM tc_hs_tv hs_tvs kinds
        ; tcExtendTyVarEnv tvs (thing_inside (kvs ++ tvs) res) }
   where
+    -- In the case of associated types, the renamer has
+    -- ensured that the names are in commmon
+    -- e.g.   class C a_29 where
+    --           type T b_30 a_29 :: *
+    -- Here the a_29 is shared
     tc_hs_tv (L _ (UserTyVar n))        kind = return (mkTyVar n kind)
     tc_hs_tv (L _ (KindedTyVar n hs_k)) kind = do { tc_kind <- tcLHsKind hs_k
                                                   ; checkKind kind tc_kind
@@ -1313,21 +1155,20 @@ tcDataKindSig kind
   = do	{ checkTc (isLiftedTypeKind res_kind) (badKindSig kind)
 	; span <- getSrcSpanM
 	; us   <- newUniqueSupply 
+        ; rdr_env <- getLocalRdrEnv
 	; let uniqs = uniqsFromSupply us
-	; return [ mk_tv span uniq str kind 
-		 | ((kind, str), uniq) <- arg_kinds `zip` dnames `zip` uniqs ] }
+              occs  = [ occ | str <- allNameStrings
+                            , let occ = mkOccName tvName str
+                            , isNothing (lookupLocalRdrOcc rdr_env occ) ]
+                 -- Note [Avoid name clashes for associated data types]
+
+	; return [ mk_tv span uniq occ kind 
+		 | ((kind, occ), uniq) <- arg_kinds `zip` occs `zip` uniqs ] }
   where
     (arg_kinds, res_kind) = splitKindFunTys kind
-    mk_tv loc uniq str kind = mkTyVar name kind
-	where
-	   name = mkInternalName uniq occ loc
-	   occ  = mkOccName tvName str
+    mk_tv loc uniq occ kind 
+      = mkTyVar (mkInternalName uniq occ loc) kind
 	  
-    dnames = map ('$' :) names	-- Note [Avoid name clashes for associated data types]
-
-    names :: [String]
-    names = [ c:cs | cs <- "" : names, c <- ['a'..'z'] ] 
-
 badKindSig :: Kind -> SDoc
 badKindSig kind 
  = hang (ptext (sLit "Kind signature on data type declaration has non-* return kind"))
@@ -1338,19 +1179,17 @@ Note [Avoid name clashes for associated data types]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 Consider    class C a b where
                data D b :: * -> *
-When typechecking the decl for D, we'll invent an extra type variable for D,
-to fill out its kind.  We *don't* want this type variable to be 'a', because
-in an .hi file we'd get
+When typechecking the decl for D, we'll invent an extra type variable
+for D, to fill out its kind.  Ideally we don't want this type variable
+to be 'a', because when pretty printing we'll get
             class C a b where
-               data D b a 
-which makes it look as if there are *two* type indices.  But there aren't!
-So we use $a instead, which cannot clash with a user-written type variable.
-Remember that type variable binders in interface files are just FastStrings,
-not proper Names.
-
-(The tidying phase can't help here because we don't tidy TyCons.  Another
-alternative would be to record the number of indexing parameters in the 
-interface file.)
+               data D b a0 
+(NB: the tidying happens in the conversion to IfaceSyn, which happens
+as part of pretty-printing a TyThing.)
+
+That's why we look in the LocalRdrEnv to see what's in scope. This is
+important only to get nice-looking output when doing ":info C" in GHCi.
+It isn't essential for correctness.
 
 
 %************************************************************************
diff --git a/compiler/typecheck/TcInstDcls.lhs b/compiler/typecheck/TcInstDcls.lhs
index 21af9a6e82d3..2b123ffab6d6 100644
--- a/compiler/typecheck/TcInstDcls.lhs
+++ b/compiler/typecheck/TcInstDcls.lhs
@@ -6,7 +6,8 @@
 TcInstDecls: Typechecking instance declarations
 
 \begin{code}
-{-# OPTIONS -fno-warn-tabs #-}
+{-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
 -- The above warning supression flag is a temporary kludge.
 -- While working on this module you are encouraged to remove it and
 -- detab the module (please do the detabbing in a separate patch). See
@@ -37,6 +38,7 @@ import TcDeriv
 import TcEnv
 import TcHsType
 import TcUnify
+import Coercion   ( pprCoAxiom )
 import MkCore     ( nO_METHOD_BINDING_ERROR_ID )
 import Type
 import TcEvidence
@@ -49,8 +51,8 @@ import VarEnv
 import VarSet 
 import CoreUnfold ( mkDFunUnfolding )
 import CoreSyn    ( Expr(Var, Type), CoreExpr, mkTyApps, mkVarApps )
-import PrelNames  ( tYPEABLE_INTERNAL, typeableClassName, oldTypeableClassNames )
-
+import PrelNames  ( tYPEABLE_INTERNAL, typeableClassName,
+                    oldTypeableClassNames, genericClassNames )
 import Bag
 import BasicTypes
 import DynFlags
@@ -68,6 +70,7 @@ import BooleanFormula ( isUnsatisfied, pprBooleanFormulaNice )
 
 import Control.Monad
 import Maybes     ( isNothing, isJust, whenIsJust )
+import Data.List  ( mapAccumL )
 \end{code}
 
 Typechecking instance declarations is done in two passes. The first
@@ -412,13 +415,17 @@ tcInstDecls1 tycl_decls inst_decls deriv_decls
        -- hand written instances of old Typeable as then unsafe casts could be
        -- performed. Derived instances are OK.
        ; dflags <- getDynFlags
-       ; when (safeLanguageOn dflags) $
-             mapM_ (\x -> when (typInstCheck x)
-                               (addErrAt (getSrcSpan $ iSpec x) typInstErr))
-                   local_infos
+       ; when (safeLanguageOn dflags) $ forM_ local_infos $ \x -> case x of
+             _ | typInstCheck x -> addErrAt (getSrcSpan $ iSpec x) (typInstErr x)
+             _ | genInstCheck x -> addErrAt (getSrcSpan $ iSpec x) (genInstErr x)
+             _ -> return ()
+
        -- As above but for Safe Inference mode.
-       ; when (safeInferOn dflags) $
-             mapM_ (\x -> when (typInstCheck x) recordUnsafeInfer) local_infos
+       ; when (safeInferOn dflags) $ forM_ local_infos $ \x -> case x of
+             _ | typInstCheck x -> recordUnsafeInfer
+             _ | genInstCheck x -> recordUnsafeInfer
+             _ | overlapCheck x -> recordUnsafeInfer
+             _ -> return ()
 
        ; return ( gbl_env
                 , bagToList deriv_inst_info ++ local_infos
@@ -439,8 +446,18 @@ tcInstDecls1 tycl_decls inst_decls deriv_decls
          else (typeableInsts, i:otherInsts)
 
     typInstCheck ty = is_cls_nm (iSpec ty) `elem` oldTypeableClassNames
-    typInstErr = ptext $ sLit $ "Can't create hand written instances of Typeable in Safe"
-                              ++ " Haskell! Can only derive them"
+    typInstErr i = hang (ptext (sLit $ "Typeable instances can only be "
+                            ++ "derived in Safe Haskell.") $+$ 
+                         ptext (sLit "Replace the following instance:"))
+                     2 (pprInstanceHdr (iSpec i))
+
+    overlapCheck ty = overlapMode (is_flag $ iSpec ty) `elem`
+                        [Overlappable, Overlapping, Overlaps]
+    genInstCheck ty = is_cls_nm (iSpec ty) `elem` genericClassNames
+    genInstErr i = hang (ptext (sLit $ "Generic instances can only be "
+                            ++ "derived in Safe Haskell.") $+$ 
+                         ptext (sLit "Replace the following instance:"))
+                     2 (pprInstanceHdr (iSpec i))
 
     instMsg i = hang (ptext (sLit $ "Typeable instances can only be derived; replace "
                                  ++ "the following instance:"))
@@ -504,6 +521,7 @@ tcLocalInstDecl (L loc (ClsInstD { cid_inst = decl }))
 tcClsInstDecl :: LClsInstDecl Name -> TcM ([InstInfo Name], [FamInst])
 tcClsInstDecl (L loc (ClsInstDecl { cid_poly_ty = poly_ty, cid_binds = binds
                                   , cid_sigs = uprags, cid_tyfam_insts = ats
+                                  , cid_overlap_mode = overlap_mode
                                   , cid_datafam_insts = adts }))
   = setSrcSpan loc                      $
     addErrCtxt (instDeclCtxt1 poly_ty)  $
@@ -525,44 +543,20 @@ tcClsInstDecl (L loc (ClsInstDecl { cid_poly_ty = poly_ty, cid_binds = binds
 
         -- Check for missing associated types and build them
         -- from their defaults (if available)
-        ; let defined_ats = mkNameSet $ map (tyFamInstDeclName . unLoc) ats
-              defined_adts = mkNameSet $ map (unLoc . dfid_tycon . unLoc) adts
-
-              mk_deflt_at_instances :: ClassATItem -> TcM [FamInst]
-              mk_deflt_at_instances (fam_tc, defs)
-                 -- User supplied instances ==> everything is OK
-                | tyConName fam_tc `elemNameSet` defined_ats
-                   || tyConName fam_tc `elemNameSet` defined_adts
-                = return []
-
-                 -- No defaults ==> generate a warning
-                | null defs
-                = do { warnMissingMethodOrAT "associated type" (tyConName fam_tc)
-                     ; return [] }
-
-                 -- No user instance, have defaults ==> instatiate them
-                 -- Example:   class C a where { type F a b :: *; type F a b = () }
-                 --            instance C [x]
-                 -- Then we want to generate the decl:   type F [x] b = ()
-                | otherwise 
-                = forM defs $ \(CoAxBranch { cab_lhs = pat_tys, cab_rhs = rhs }) ->
-                  do { let pat_tys' = substTys mini_subst pat_tys
-                           rhs'     = substTy  mini_subst rhs
-                           tv_set'  = tyVarsOfTypes pat_tys'
-                           tvs'     = varSetElems tv_set'
-                     ; rep_tc_name <- newFamInstTyConName (noLoc (tyConName fam_tc)) pat_tys'
-                     ; let axiom = mkSingleCoAxiom rep_tc_name tvs' fam_tc pat_tys' rhs'
-                     ; ASSERT( tyVarsOfType rhs' `subVarSet` tv_set' ) 
-                       newFamInst SynFamilyInst axiom }
-
-        ; tyfam_insts1 <- mapM mk_deflt_at_instances (classATItems clas)
+        ; let defined_ats = mkNameSet (map (tyFamInstDeclName . unLoc) ats)
+                            `unionNameSets` 
+                            mkNameSet (map (unLoc . dfid_tycon . unLoc) adts)
+        ; tyfam_insts1 <- mapM (tcATDefault mini_subst defined_ats) 
+                               (classATItems clas)
         
         -- Finally, construct the Core representation of the instance.
         -- (This no longer includes the associated types.)
         ; dfun_name <- newDFunName clas inst_tys (getLoc poly_ty)
                 -- Dfun location is that of instance *header*
 
-        ; overlap_flag <- getOverlapFlag
+        ; overlap_flag <-
+            do defaultOverlapFlag <- getOverlapFlag
+               return $ setOverlapModeMaybe defaultOverlapFlag overlap_mode
         ; (subst, tyvars') <- tcInstSkolTyVars tyvars
         ; let dfun  	= mkDictFunId dfun_name tyvars theta clas inst_tys
               ispec 	= mkLocalInstance dfun overlap_flag tyvars' clas (substTys subst inst_tys)
@@ -572,10 +566,53 @@ tcClsInstDecl (L loc (ClsInstDecl { cid_poly_ty = poly_ty, cid_binds = binds
                                    , iBinds = InstBindings
                                      { ib_binds = binds
                                      , ib_pragmas = uprags
+                                     , ib_extensions = []
                                      , ib_standalone_deriving = False } }
 
         ; return ( [inst_info], tyfam_insts0 ++ concat tyfam_insts1 ++ datafam_insts) }
 
+
+tcATDefault :: TvSubst -> NameSet -> ClassATItem -> TcM [FamInst]
+-- ^ Construct default instances for any associated types that
+-- aren't given a user definition
+-- Returns [] or singleton
+tcATDefault inst_subst defined_ats (ATI fam_tc defs)
+  -- User supplied instances ==> everything is OK
+  | tyConName fam_tc `elemNameSet` defined_ats
+  = return []
+
+  -- No user instance, have defaults ==> instatiate them
+   -- Example:   class C a where { type F a b :: *; type F a b = () }
+   --            instance C [x]
+   -- Then we want to generate the decl:   type F [x] b = ()
+  | Just rhs_ty <- defs
+  = do { let (subst', pat_tys') = mapAccumL subst_tv inst_subst
+                                            (tyConTyVars fam_tc)
+             rhs'     = substTy subst' rhs_ty
+             tv_set'  = tyVarsOfTypes pat_tys'
+             tvs'     = varSetElemsKvsFirst tv_set'
+       ; rep_tc_name <- newFamInstTyConName (noLoc (tyConName fam_tc)) pat_tys'
+       ; let axiom = mkSingleCoAxiom rep_tc_name tvs' fam_tc pat_tys' rhs'
+       ; traceTc "mk_deflt_at_instance" (vcat [ ppr fam_tc, ppr rhs_ty
+                                              , pprCoAxiom axiom ])
+       ; fam_inst <- ASSERT( tyVarsOfType rhs' `subVarSet` tv_set' ) 
+                     newFamInst SynFamilyInst axiom
+       ; return [fam_inst] }
+
+   -- No defaults ==> generate a warning
+  | otherwise  -- defs = Nothing
+  = do { warnMissingMethodOrAT "associated type" (tyConName fam_tc)
+       ; return [] }
+  where
+    subst_tv subst tc_tv 
+      | Just ty <- lookupVarEnv (getTvSubstEnv subst) tc_tv
+      = (subst, ty)
+      | otherwise
+      = (extendTvSubst subst tc_tv ty', ty')
+      where
+        ty' = mkTyVarTy (updateTyVarKind (substTy subst) tc_tv)
+                           
+
 --------------
 tcAssocTyDecl :: Class                   -- Class of associated type
               -> VarEnv Type             -- Instantiation of class TyVars
@@ -624,24 +661,22 @@ tcTyFamInstDecl :: Maybe (Class, VarEnv Type) -- the class & mini_env if applica
 tcTyFamInstDecl mb_clsinfo (L loc decl@(TyFamInstDecl { tfid_eqn = eqn }))
   = setSrcSpan loc           $
     tcAddTyFamInstCtxt decl  $
-    do { let fam_lname = tfie_tycon (unLoc eqn)
+    do { let fam_lname = tfe_tycon (unLoc eqn)
        ; fam_tc <- tcFamInstDeclCombined mb_clsinfo fam_lname
 
          -- (0) Check it's an open type family
-       ; checkTc (isFamilyTyCon fam_tc) (notFamily fam_tc)
-       ; checkTc (isSynTyCon fam_tc) (wrongKindOfFamily fam_tc)
-       ; checkTc (isOpenSynFamilyTyCon fam_tc)
-                 (notOpenFamily fam_tc)
+       ; checkTc (isFamilyTyCon fam_tc)        (notFamily fam_tc)
+       ; checkTc (isSynFamilyTyCon fam_tc)     (wrongKindOfFamily fam_tc)
+       ; checkTc (isOpenSynFamilyTyCon fam_tc) (notOpenFamily fam_tc)
 
          -- (1) do the work of verifying the synonym group
-       ; co_ax_branch <- tcSynFamInstDecl fam_tc decl
+       ; co_ax_branch <- tcTyFamInstEqn (famTyConShape fam_tc) eqn
 
          -- (2) check for validity
        ; checkValidTyFamInst mb_clsinfo fam_tc co_ax_branch
 
          -- (3) construct coercion axiom
-       ; rep_tc_name <- newFamInstAxiomName loc
-                                            (tyFamInstDeclName decl)
+       ; rep_tc_name <- newFamInstAxiomName loc (unLoc fam_lname)
                                             [co_ax_branch]
        ; let axiom = mkUnbranchedCoAxiom rep_tc_name fam_tc co_ax_branch
        ; newFamInst SynFamilyInst axiom }
@@ -664,7 +699,7 @@ tcDataFamInstDecl mb_clsinfo
        ; checkTc (isAlgTyCon fam_tc) (wrongKindOfFamily fam_tc)
 
          -- Kind check type patterns
-       ; tcFamTyPats (unLoc fam_tc_name) (tyConKind fam_tc) pats
+       ; tcFamTyPats (famTyConShape fam_tc) pats
                      (kcDataDefn defn) $ 
            \tvs' pats' res_kind -> do
 
@@ -679,7 +714,7 @@ tcDataFamInstDecl mb_clsinfo
        ; checkTc (isLiftedTypeKind res_kind) $ tooFewParmsErr (tyConArity fam_tc)
 
        ; stupid_theta <- tcHsContext ctxt
-       ; h98_syntax <- dataDeclChecks (tyConName fam_tc) new_or_data stupid_theta cons
+       ; gadt_syntax <- dataDeclChecks (tyConName fam_tc) new_or_data stupid_theta cons
 
          -- Construct representation tycon
        ; rep_tc_name <- newFamInstTyConName fam_tc_name pats'
@@ -702,7 +737,7 @@ tcDataFamInstDecl mb_clsinfo
                     rep_tc   = buildAlgTyCon rep_tc_name tvs' roles cType stupid_theta tc_rhs 
                                              Recursive 
                                              False      -- No promotable to the kind level
-                                             h98_syntax parent
+                                             gadt_syntax parent
                  -- We always assume that indexed types are recursive.  Why?
                  -- (1) Due to their open nature, we can never be sure that a
                  -- further instance might not introduce a new recursive
@@ -887,9 +922,9 @@ tcInstDecl2 (InstInfo { iSpec = ispec, iBinds = ibinds })
                                   , abs_ev_vars = dfun_ev_vars
                                   , abs_exports = [export]
                                   , abs_ev_binds = sc_binds
-                                  , abs_binds = unitBag (Generated, dict_bind) }
+                                  , abs_binds = unitBag dict_bind }
 
-       ; return (unitBag (Generated, L loc main_bind) `unionBags`
+       ; return (unitBag (L loc main_bind) `unionBags`
                  listToBag meth_binds)
        }
  where
@@ -1168,22 +1203,26 @@ tcInstanceMethods :: DFunId -> Class -> [TcTyVar]
                   -> ([Located TcSpecPrag], PragFun)
                   -> [(Id, DefMeth)]
                   -> InstBindings Name
-                  -> TcM ([Id], [(Origin, LHsBind Id)])
+                  -> TcM ([Id], [LHsBind Id])
         -- The returned inst_meth_ids all have types starting
         --      forall tvs. theta => ...
 tcInstanceMethods dfun_id clas tyvars dfun_ev_vars inst_tys
                   (spec_inst_prags, prag_fn)
                   op_items (InstBindings { ib_binds = binds
                                          , ib_pragmas = sigs
+                                         , ib_extensions = exts
                                          , ib_standalone_deriving
                                               = standalone_deriv })
   = do { traceTc "tcInstMeth" (ppr sigs $$ ppr binds)
        ; let hs_sig_fn = mkHsSigFun sigs
        ; checkMinimalDefinition
-       ; mapAndUnzipM (tc_item hs_sig_fn) op_items }
+       ; set_exts exts $ mapAndUnzipM (tc_item hs_sig_fn) op_items }
   where
+    set_exts :: [ExtensionFlag] -> TcM a -> TcM a
+    set_exts es thing = foldr setXOptM thing es
+    
     ----------------------
-    tc_item :: HsSigFun -> (Id, DefMeth) -> TcM (Id, (Origin, LHsBind Id))
+    tc_item :: HsSigFun -> (Id, DefMeth) -> TcM (Id, LHsBind Id)
     tc_item sig_fn (sel_id, dm_info)
       = case findMethodBind (idName sel_id) binds of
             Just (user_bind, bndr_loc) 
@@ -1192,10 +1231,10 @@ tcInstanceMethods dfun_id clas tyvars dfun_ev_vars inst_tys
                            ; tc_default sig_fn sel_id dm_info }
 
     ----------------------
-    tc_body :: HsSigFun -> Id -> Bool -> (Origin, LHsBind Name)
-            -> SrcSpan -> TcM (TcId, (Origin, LHsBind Id))
+    tc_body :: HsSigFun -> Id -> Bool -> LHsBind Name
+            -> SrcSpan -> TcM (TcId, LHsBind Id)
     tc_body sig_fn sel_id generated_code rn_bind bndr_loc
-      = add_meth_ctxt sel_id generated_code (snd rn_bind) $
+      = add_meth_ctxt sel_id generated_code rn_bind $
         do { traceTc "tc_item" (ppr sel_id <+> ppr (idType sel_id))
            ; (meth_id, local_meth_sig) <- setSrcSpan bndr_loc $
                                           mkMethIds sig_fn clas tyvars dfun_ev_vars
@@ -1211,12 +1250,12 @@ tcInstanceMethods dfun_id clas tyvars dfun_ev_vars inst_tys
            ; return (meth_id1, bind) }
 
     ----------------------
-    tc_default :: HsSigFun -> Id -> DefMeth -> TcM (TcId, (Origin, LHsBind Id))
+    tc_default :: HsSigFun -> Id -> DefMeth -> TcM (TcId, LHsBind Id)
 
     tc_default sig_fn sel_id (GenDefMeth dm_name)
       = do { meth_bind <- mkGenericDefMethBind clas inst_tys sel_id dm_name
            ; tc_body sig_fn sel_id False {- Not generated code? -} 
-                     (Generated, meth_bind) inst_loc }
+                     meth_bind inst_loc }
 
     tc_default sig_fn sel_id NoDefMeth     -- No default method at all
       = do { traceTc "tc_def: warn" (ppr sel_id)
@@ -1224,8 +1263,8 @@ tcInstanceMethods dfun_id clas tyvars dfun_ev_vars inst_tys
                                        inst_tys sel_id
            ; dflags <- getDynFlags
            ; return (meth_id,
-                     (Generated, mkVarBind meth_id $
-                                 mkLHsWrap lam_wrapper (error_rhs dflags))) }
+                     mkVarBind meth_id $
+                       mkLHsWrap lam_wrapper (error_rhs dflags)) }
       where
         error_rhs dflags = L inst_loc $ HsApp error_fun (error_msg dflags)
         error_fun    = L inst_loc $ wrapId (WpTyApp meth_tau) nO_METHOD_BINDING_ERROR_ID
@@ -1267,13 +1306,13 @@ tcInstanceMethods dfun_id clas tyvars dfun_ev_vars inst_tys
                  bind = AbsBinds { abs_tvs = tyvars, abs_ev_vars = dfun_ev_vars
                                  , abs_exports = [export]
                                  , abs_ev_binds = EvBinds (unitBag self_ev_bind)
-                                 , abs_binds    = unitBag (Generated, meth_bind) }
+                                 , abs_binds    = unitBag meth_bind }
              -- Default methods in an instance declaration can't have their own
              -- INLINE or SPECIALISE pragmas. It'd be possible to allow them, but
              -- currently they are rejected with
              --           "INLINE pragma lacks an accompanying binding"
 
-           ; return (meth_id1, (Generated, L inst_loc bind)) }
+           ; return (meth_id1, L inst_loc bind) }
 
     ----------------------
     mk_meth_spec_prags :: Id -> [LTcSpecPrag] -> TcSpecPrags
@@ -1324,7 +1363,7 @@ mkGenericDefMethBind clas inst_tys sel_id dm_name
 		   (vcat [ppr clas <+> ppr inst_tys,
 			  nest 2 (ppr sel_id <+> equals <+> ppr rhs)]))
 
-        ; return (noLoc $ mkTopFunBind (noLoc (idName sel_id))
+        ; return (noLoc $ mkTopFunBind Generated (noLoc (idName sel_id))
                                        [mkSimpleMatch [] rhs]) }
   where
     rhs = nlHsVar dm_name
diff --git a/compiler/typecheck/TcInteract.lhs b/compiler/typecheck/TcInteract.lhs
index 377cd2dbd812..33249f4b0400 100644
--- a/compiler/typecheck/TcInteract.lhs
+++ b/compiler/typecheck/TcInteract.lhs
@@ -1,4 +1,6 @@
 \begin{code}
+{-# LANGUAGE CPP #-}
+
 module TcInteract (
      solveInteractGiven,  -- Solves [EvVar],GivenLoc
      solveInteract,       -- Solves Cts
@@ -101,6 +103,7 @@ solveInteractGiven loc old_fsks givens
                                                      , ctev_loc = loc }
                           | ev_id <- givens ]
 
+    -- See Note [Given flatten-skolems] in TcSMonad
     fsk_bag = listToBag [ mkNonCanonical $ CtGiven { ctev_evtm = EvCoercion (mkTcNomReflCo tv_ty)
                                                    , ctev_pred = pred
                                                    , ctev_loc = loc }
@@ -750,12 +753,16 @@ kickOutRewritable :: CtEvidence   -- Flavour of the equality that is
                   -> InertCans
                   -> TcS (Int, InertCans)
 kickOutRewritable new_ev new_tv
-                  (IC { inert_eqs = tv_eqs
-                      , inert_dicts  = dictmap
-                      , inert_funeqs = funeqmap
-                      , inert_irreds = irreds
-                      , inert_insols = insols
-                      , inert_no_eqs = no_eqs })
+                  inert_cans@(IC { inert_eqs = tv_eqs
+                                 , inert_dicts  = dictmap
+                                 , inert_funeqs = funeqmap
+                                 , inert_irreds = irreds
+                                 , inert_insols = insols
+                                 , inert_no_eqs = no_eqs })
+  | new_tv `elemVarEnv` tv_eqs   -- Fast path: there is at least one equality for tv
+                                 -- so kick-out will do nothing
+  = return (0, inert_cans)
+  | otherwise
   = do { traceTcS "kickOutRewritable" $
             vcat [ text "tv = " <+> ppr new_tv
                  , ptext (sLit "Kicked out =") <+> ppr kicked_out]
@@ -1478,7 +1485,9 @@ doTopReactDict inerts fl cls xis
        = do { instEnvs <- getInstEnvs
             ; let fd_eqns = improveFromInstEnv instEnvs pred
             ; fd_work <- rewriteWithFunDeps fd_eqns loc
-            ; unless (null fd_work) (updWorkListTcS (extendWorkListEqs fd_work))
+            ; unless (null fd_work) $
+              do { traceTcS "Addig FD work" (ppr pred $$ vcat (map pprEquation fd_eqns) $$ ppr fd_work)
+                 ; updWorkListTcS (extendWorkListEqs fd_work) }
             ; return NoTopInt }
 
 --------------------
@@ -1830,7 +1839,7 @@ matchClassInst _ clas [ ty ] _
 
 matchClassInst _ clas [ _k, ty1, ty2 ] loc
   | clas == coercibleClass =  do
-      traceTcS "matchClassInst for" $ ppr clas <+> ppr ty1 <+> ppr ty2 <+> text "at depth" <+> ppr (ctLocDepth loc)
+      traceTcS "matchClassInst for" $ quotes (pprClassPred clas [ty1,ty2]) <+> text "at depth" <+> ppr (ctLocDepth loc)
       ev <- getCoercibleInst loc ty1 ty2
       traceTcS "matchClassInst returned" $ ppr ev
       return ev
@@ -1922,11 +1931,12 @@ getCoercibleInst loc ty1 ty2 = do
       -- Get some global stuff in scope, for nice pattern-guard based code in `go`
       rdr_env <- getGlobalRdrEnvTcS
       famenv <- getFamInstEnvs
-      safeMode <- safeLanguageOn `fmap` getDynFlags
-      go safeMode famenv rdr_env
+      go famenv rdr_env
   where
-  go :: Bool -> FamInstEnvs -> GlobalRdrEnv -> TcS LookupInstResult
-  go safeMode famenv rdr_env
+  go :: FamInstEnvs -> GlobalRdrEnv -> TcS LookupInstResult
+  go famenv rdr_env
+    -- Also see [Order of Coercible Instances]
+
     -- Coercible a a                             (see case 1 in [Coercible Instances])
     | ty1 `tcEqType` ty2
     = do return $ GenInst []
@@ -1942,15 +1952,36 @@ getCoercibleInst loc ty1 ty2 = do
        ev_term <- deferTcSForAllEq Representational loc (tvs1,body1) (tvs2,body2)
        return $ GenInst [] ev_term
 
-    -- Coercible (D ty1 ty2) (D ty1' ty2')       (see case 3 in [Coercible Instances])
+    -- Coercible NT a                            (see case 3 in [Coercible Instances])
+    | Just (tc,tyArgs) <- splitTyConApp_maybe ty1,
+      Just (concTy, ntCo) <- instNewTyConTF_maybe famenv tc tyArgs,
+      dataConsInScope rdr_env tc -- Do not look at all tyConsOfTyCon
+    = do markDataConsAsUsed rdr_env tc
+         ct_ev <- requestCoercible loc concTy ty2
+         local_var <- mkSysLocalM (fsLit "coev") $ mkCoerciblePred concTy ty2
+         let binds = EvBinds (unitBag (EvBind local_var (getEvTerm ct_ev)))
+             tcCo = TcLetCo binds $
+                            coercionToTcCoercion ntCo `mkTcTransCo` mkTcCoVarCo local_var
+         return $ GenInst (freshGoals [ct_ev]) (EvCoercion tcCo)
+
+    -- Coercible a NT                            (see case 3 in [Coercible Instances])
+    | Just (tc,tyArgs) <- splitTyConApp_maybe ty2,
+      Just (concTy, ntCo) <- instNewTyConTF_maybe famenv tc tyArgs,
+      dataConsInScope rdr_env tc -- Do not look at all tyConsOfTyCon
+    = do markDataConsAsUsed rdr_env tc
+         ct_ev <- requestCoercible loc ty1 concTy
+         local_var <- mkSysLocalM (fsLit "coev") $ mkCoerciblePred ty1 concTy
+         let binds = EvBinds (unitBag (EvBind local_var (getEvTerm ct_ev)))
+             tcCo = TcLetCo binds $
+                            mkTcCoVarCo local_var `mkTcTransCo` mkTcSymCo (coercionToTcCoercion ntCo)
+         return $ GenInst (freshGoals [ct_ev]) (EvCoercion tcCo)
+
+    -- Coercible (D ty1 ty2) (D ty1' ty2')       (see case 4 in [Coercible Instances])
     | Just (tc1,tyArgs1) <- splitTyConApp_maybe ty1,
       Just (tc2,tyArgs2) <- splitTyConApp_maybe ty2,
       tc1 == tc2,
-      nominalArgsAgree tc1 tyArgs1 tyArgs2,
-      not safeMode || all (dataConsInScope rdr_env) (tyConsOfTyCon tc1)
-    = do -- Mark all used data constructors as used
-         when safeMode $ mapM_ (markDataConsAsUsed rdr_env) (tyConsOfTyCon tc1)
-         -- We want evidence for all type arguments of role R
+      nominalArgsAgree tc1 tyArgs1 tyArgs2
+    = do -- We want evidence for all type arguments of role R
          arg_stuff <- forM (zip3 (tyConRoles tc1) tyArgs1 tyArgs2) $ \(r,ta1,ta2) ->
            case r of Nominal -> do
                           return
@@ -1976,30 +2007,6 @@ getCoercibleInst loc ty1 ty2 = do
              tcCo = TcLetCo binds (mkTcTyConAppCo Representational tc1 arg_cos)
          return $ GenInst (catMaybes arg_new) (EvCoercion tcCo)
 
-    -- Coercible NT a                            (see case 4 in [Coercible Instances])
-    | Just (tc,tyArgs) <- splitTyConApp_maybe ty1,
-      Just (concTy, ntCo) <- instNewTyConTF_maybe famenv tc tyArgs,
-      dataConsInScope rdr_env tc -- Do not look at all tyConsOfTyCon
-    = do markDataConsAsUsed rdr_env tc
-         ct_ev <- requestCoercible loc concTy ty2
-         local_var <- mkSysLocalM (fsLit "coev") $ mkCoerciblePred concTy ty2
-         let binds = EvBinds (unitBag (EvBind local_var (getEvTerm ct_ev)))
-             tcCo = TcLetCo binds $
-                            coercionToTcCoercion ntCo `mkTcTransCo` mkTcCoVarCo local_var
-         return $ GenInst (freshGoals [ct_ev]) (EvCoercion tcCo)
-
-    -- Coercible a NT                            (see case 4 in [Coercible Instances])
-    | Just (tc,tyArgs) <- splitTyConApp_maybe ty2,
-      Just (concTy, ntCo) <- instNewTyConTF_maybe famenv tc tyArgs,
-      dataConsInScope rdr_env tc -- Do not look at all tyConsOfTyCon
-    = do markDataConsAsUsed rdr_env tc
-         ct_ev <- requestCoercible loc ty1 concTy
-         local_var <- mkSysLocalM (fsLit "coev") $ mkCoerciblePred ty1 concTy
-         let binds = EvBinds (unitBag (EvBind local_var (getEvTerm ct_ev)))
-             tcCo = TcLetCo binds $
-                            mkTcCoVarCo local_var `mkTcTransCo` mkTcSymCo (coercionToTcCoercion ntCo)
-         return $ GenInst (freshGoals [ct_ev]) (EvCoercion tcCo)
-
     -- Cannot solve this one
     | otherwise
     = return NoInstance
@@ -2039,7 +2046,7 @@ Note [Coercible Instances]
 The class Coercible is special: There are no regular instances, and the user
 cannot even define them (it is listed as an `abstractClass` in TcValidity).
 Instead, the type checker will create instances and their evidence out of thin
-air, in getCoercibleInst. The following “instances� are present:
+air, in getCoercibleInst. The following "instances" are present:
 
  1. instance Coercible a a
     for any type a at any kind k.
@@ -2048,33 +2055,14 @@ air, in getCoercibleInst. The following “instances� are present:
     (which would be illegal to write like that in the source code, but we have
     it nevertheless).
 
-
- 3. instance (Coercible t1_r t1'_r, Coercible t2_r t2_r',...) =>
-       Coercible (C t1_r  t2_r  ... t1_p  t2_p  ... t1_n t2_n ...)
-                 (C t1_r' t2_r' ... t1_p' t2_p' ... t1_n t2_n ...)
-    for a type constructor C where
-     * the nominal type arguments are not changed,
-     * the phantom type arguments may change arbitrarily
-     * the representational type arguments are again Coercible
-
-    The type constructor can be used undersaturated; then the Coercible
-    instance is at a higher kind. This does not cause problems.
-
-    Furthermore in Safe Haskell code, we check that
-     * the data constructors of C are in scope and
-     * the data constructors of all type constructors used in the definition of
-     * C are in scope.
-       This is required as otherwise the previous check can be circumvented by
-       just adding a local data type around C.
-
- 4. instance Coercible r b => Coercible (NT t1 t2 ...) b
+ 3. instance Coercible r b => Coercible (NT t1 t2 ...) b
     instance Coercible a r => Coercible a (NT t1 t2 ...)
     for a newtype constructor NT (or data family instance that resolves to a
     newtype) where
      * r is the concrete type of NT, instantiated with the arguments t1 t2 ...
-     * the constructor of NT are in scope.
+     * the constructor of NT is in scope.
 
-    Again, the newtype TyCon can appear undersaturated, but only if it has
+    The newtype TyCon can appear undersaturated, but only if it has
     enough arguments to apply the newtype coercion (which is eta-reduced). Examples:
       newtype NT a = NT (Either a Int)
       Coercible (NT Int) (Either Int Int) -- ok
@@ -2082,12 +2070,24 @@ air, in getCoercibleInst. The following “instances� are present:
       newtype NT3 a b = NT3 (b -> a)
       Coercible (NT2 Int) (NT3 Int) -- cannot be derived
 
+ 4. instance (Coercible t1_r t1'_r, Coercible t2_r t2_r',...) =>
+       Coercible (C t1_r  t2_r  ... t1_p  t2_p  ... t1_n t2_n ...)
+                 (C t1_r' t2_r' ... t1_p' t2_p' ... t1_n t2_n ...)
+    for a type constructor C where
+     * the nominal type arguments are not changed,
+     * the phantom type arguments may change arbitrarily
+     * the representational type arguments are again Coercible
+
+    The type constructor can be used undersaturated; then the Coercible
+    instance is at a higher kind. This does not cause problems.
+
+
 The type checker generates evidence in the form of EvCoercion, but the
 TcCoercion therein has role Representational,  which are turned into Core
 coercions by dsEvTerm in DsBinds.
 
-The evidence for the first three instance is generated here by
-getCoercibleInst, for the second instance deferTcSForAllEq is used.
+The evidence for the second case is created by deferTcSForAllEq, for the other
+cases by getCoercibleInst.
 
 When the constraint cannot be solved, it is treated as any other unsolved
 constraint, i.e. it can turn up in an inferred type signature, or reported to
@@ -2096,6 +2096,33 @@ coercible_msg in TcErrors gives additional explanations of why GHC could not
 find a Coercible instance, so it duplicates some of the logic from
 getCoercibleInst (in negated form).
 
+Note [Order of Coercible Instances]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+At first glance, the order of the various coercible instances doesn't matter, as
+incoherence is no issue here: We do not care how the evidence is constructed,
+as long as it is.
+
+But because of role annotations, the order *can* matter:
+
+  newtype T a = MkT [a]
+  type role T nominal
+
+  type family F a
+  type instance F Int = Bool
+
+Here T's declared role is more restrictive than its inferred role
+(representational) would be.  If MkT is not in scope, so that the
+newtype-unwrapping instance is not available, then this coercible
+instance would fail:
+  Coercible (T Bool) (T (F Int)
+But MkT was in scope, *and* if we used it before decomposing on T,
+we'd unwrap the newtype (on both sides) to get
+  Coercible Bool (F Int)
+whic succeeds.
+
+So our current decision is to apply case 3 (newtype-unwrapping) first,
+followed by decomposition (case 4).  This is strictly more powerful 
+if the newtype constructor is in scope.  See Trac #9117 for a discussion.
 
 Note [Instance and Given overlap]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
diff --git a/compiler/typecheck/TcMType.lhs b/compiler/typecheck/TcMType.lhs
index a40a93df1605..65bc0b76533b 100644
--- a/compiler/typecheck/TcMType.lhs
+++ b/compiler/typecheck/TcMType.lhs
@@ -1,4 +1,4 @@
-%
+o%
 % (c) The University of Glasgow 2006
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
@@ -9,7 +9,8 @@ This module contains monadic operations over types that contain
 mutable type variables
 
 \begin{code}
-{-# OPTIONS -fno-warn-tabs #-}
+{-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
 -- The above warning supression flag is a temporary kludge.
 -- While working on this module you are encouraged to remove it and
 -- detab the module (please do the detabbing in a separate patch). See
@@ -40,23 +41,23 @@ module TcMType (
 
   --------------------------------
   -- Instantiation
-  tcInstTyVars, tcInstSigTyVars, newSigTyVar,
-  tcInstType, 
-  tcInstSkolTyVars, tcInstSkolTyVarsLoc, tcInstSuperSkolTyVars,
-  tcInstSkolTyVarsX, tcInstSuperSkolTyVarsX,
+  tcInstTyVars, newSigTyVar,
+  tcInstType,
+  tcInstSkolTyVars, tcInstSuperSkolTyVars,tcInstSuperSkolTyVarsX,
+  tcInstSigTyVarsLoc, tcInstSigTyVars,
   tcInstSkolTyVar, tcInstSkolType,
   tcSkolDFunType, tcSuperSkolTyVars,
 
   --------------------------------
   -- Zonking
   zonkTcPredType, 
-  skolemiseSigTv, skolemiseUnboundMetaTyVar,
+  skolemiseUnboundMetaTyVar,
   zonkTcTyVar, zonkTcTyVars, zonkTyVarsAndFV, zonkTcTypeAndFV,
   zonkQuantifiedTyVar, quantifyTyVars,
   zonkTcTyVarBndr, zonkTcType, zonkTcTypes, zonkTcThetaType, 
 
   zonkTcKind, defaultKindVarToStar,
-  zonkEvVar, zonkWC, zonkId, zonkCt, zonkCts, zonkSkolemInfo,
+  zonkEvVar, zonkWC, zonkFlats, zonkId, zonkCt, zonkCts, zonkSkolemInfo,
 
   tcGetGlobalTyVars, 
   ) where
@@ -238,9 +239,6 @@ tcInstSkolTyVar loc overlappable subst tyvar
 
 -- Wrappers
 -- we need to be able to do this from outside the TcM monad:
-tcInstSkolTyVarsLoc :: SrcSpan -> [TyVar] -> TcRnIf gbl lcl (TvSubst, [TcTyVar])
-tcInstSkolTyVarsLoc loc = mapAccumLM (tcInstSkolTyVar loc False) (mkTopTvSubst [])
-
 tcInstSkolTyVars :: [TyVar] -> TcM (TvSubst, [TcTyVar])
 tcInstSkolTyVars = tcInstSkolTyVarsX (mkTopTvSubst [])
 
@@ -255,29 +253,26 @@ tcInstSuperSkolTyVarsX subst = tcInstSkolTyVars' True  subst
 tcInstSkolTyVars' :: Bool -> TvSubst -> [TyVar] -> TcM (TvSubst, [TcTyVar])
 -- Precondition: tyvars should be ordered (kind vars first)
 -- see Note [Kind substitution when instantiating]
+-- Get the location from the monad; this is a complete freshening operation
 tcInstSkolTyVars' isSuperSkol subst tvs
   = do { loc <- getSrcSpanM
        ; mapAccumLM (tcInstSkolTyVar loc isSuperSkol) subst tvs }
 
+tcInstSigTyVarsLoc :: SrcSpan -> [TyVar] -> TcRnIf gbl lcl (TvSubst, [TcTyVar])
+-- We specify the location
+tcInstSigTyVarsLoc loc = mapAccumLM (tcInstSkolTyVar loc False) (mkTopTvSubst [])
+
+tcInstSigTyVars :: [TyVar] -> TcRnIf gbl lcl (TvSubst, [TcTyVar])
+-- Get the location from the TyVar itself, not the monad
+tcInstSigTyVars = mapAccumLM inst_tv (mkTopTvSubst [])
+  where
+    inst_tv subst tv = tcInstSkolTyVar (getSrcSpan tv) False subst tv
+
 tcInstSkolType :: TcType -> TcM ([TcTyVar], TcThetaType, TcType)
 -- Instantiate a type with fresh skolem constants
 -- Binding location comes from the monad
 tcInstSkolType ty = tcInstType tcInstSkolTyVars ty
 
-tcInstSigTyVars :: [TyVar] -> TcM (TvSubst, [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
--- Precondition: tyvars should be ordered (kind vars first)
--- see Note [Kind substitution when instantiating]
-tcInstSigTyVars = mapAccumLM tcInstSigTyVar (mkTopTvSubst [])
-	-- The tyvars are freshly made, by tcInstSigTyVar
-        -- So mkTopTvSubst [] is ok
-
-tcInstSigTyVar :: TvSubst -> TyVar -> TcM (TvSubst, TcTyVar)
-tcInstSigTyVar subst tv
-  = do { new_tv <- newSigTyVar (tyVarName tv) (substTy subst (tyVarKind tv))
-       ; return (extendTvSubst subst tv (mkTyVarTy new_tv), new_tv) }
-
 newSigTyVar :: Name -> Kind -> TcM TcTyVar
 newSigTyVar name kind
   = do { uniq <- newUnique
@@ -391,34 +386,34 @@ writeMetaTyVar tyvar ty
 
 --------------------
 writeMetaTyVarRef :: TcTyVar -> TcRef MetaDetails -> TcType -> TcM ()
--- Here the tyvar is for error checking only; 
+-- Here the tyvar is for error checking only;
 -- the ref cell must be for the same tyvar
 writeMetaTyVarRef tyvar ref ty
-  | not debugIsOn 
+  | not debugIsOn
   = do { traceTc "writeMetaTyVar" (ppr tyvar <+> text ":=" <+> ppr ty)
        ; writeMutVar ref (Indirect ty) }
 
 -- Everything from here on only happens if DEBUG is on
   | otherwise
-  = do { meta_details <- readMutVar ref; 
+  = do { meta_details <- readMutVar ref;
        -- Zonk kinds to allow the error check to work
-       ; zonked_tv_kind <- zonkTcKind tv_kind 
+       ; zonked_tv_kind <- zonkTcKind tv_kind
        ; zonked_ty_kind <- zonkTcKind ty_kind
 
        -- Check for double updates
-       ; ASSERT2( isFlexi meta_details, 
+       ; ASSERT2( isFlexi meta_details,
                   hang (text "Double update of meta tyvar")
                    2 (ppr tyvar $$ ppr meta_details) )
 
          traceTc "writeMetaTyVar" (ppr tyvar <+> text ":=" <+> ppr ty)
-       ; writeMutVar ref (Indirect ty) 
-       ; when (   not (isPredTy tv_kind) 
+       ; writeMutVar ref (Indirect ty)
+       ; when (   not (isPredTy tv_kind)
                     -- Don't check kinds for updates to coercion variables
                && not (zonked_ty_kind `tcIsSubKind` zonked_tv_kind))
        $ WARN( True, hang (text "Ill-kinded update to meta tyvar")
-                        2 (    ppr tyvar <+> text "::" <+> ppr tv_kind 
-                           <+> text ":=" 
-                           <+> ppr ty    <+> text "::" <+> ppr ty_kind) )
+                        2 (    ppr tyvar <+> text "::" <+> (ppr tv_kind $$ ppr zonked_tv_kind)
+                           <+> text ":="
+                           <+> ppr ty    <+> text "::" <+> (ppr ty_kind $$ ppr zonked_ty_kind) ) )
          (return ()) }
   where
     tv_kind = tyVarKind tyvar
@@ -598,17 +593,6 @@ skolemiseUnboundMetaTyVar tv details
 
         ; writeMetaTyVar tv (mkTyVarTy final_tv)
         ; return final_tv }
-
-skolemiseSigTv :: TcTyVar -> TcM TcTyVar
--- In TcBinds we create SigTvs for type signatures
--- but for singleton groups we want them to really be skolems
--- which do not unify with each other
-skolemiseSigTv tv  
-  = ASSERT2( isSigTyVar tv, ppr tv )
-    do { writeMetaTyVarRef tv (metaTvRef tv) (mkTyVarTy skol_tv)
-       ; return skol_tv }
-  where
-    skol_tv = setTcTyVarDetails tv (SkolemTv False)
 \end{code}
 
 Note [Zonking to Skolem]
diff --git a/compiler/typecheck/TcMatches.lhs b/compiler/typecheck/TcMatches.lhs
index 08ce7745d3c3..32b6d1e326e9 100644
--- a/compiler/typecheck/TcMatches.lhs
+++ b/compiler/typecheck/TcMatches.lhs
@@ -6,7 +6,8 @@
 TcMatches: Typecheck some @Matches@
 
 \begin{code}
-{-# OPTIONS -fno-warn-tabs #-}
+{-# LANGUAGE CPP, RankNTypes #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
 -- The above warning supression flag is a temporary kludge.
 -- While working on this module you are encouraged to remove it and
 -- detab the module (please do the detabbing in a separate patch). See
@@ -109,7 +110,7 @@ tcMatchesCase :: (Outputable (body Name)) =>
 
 tcMatchesCase ctxt scrut_ty matches res_ty
   | isEmptyMatchGroup matches   -- Allow empty case expressions
-  = return (MG { mg_alts = [], mg_arg_tys = [scrut_ty], mg_res_ty = res_ty }) 
+  = return (MG { mg_alts = [], mg_arg_tys = [scrut_ty], mg_res_ty = res_ty, mg_origin = mg_origin matches })
 
   | otherwise
   = tcMatches ctxt [scrut_ty] res_ty matches
@@ -180,10 +181,10 @@ data TcMatchCtxt body   -- c.f. TcStmtCtxt, also in this module
                  -> TcRhoType
                  -> TcM (Located (body TcId)) }
 
-tcMatches ctxt pat_tys rhs_ty (MG { mg_alts = matches })
+tcMatches ctxt pat_tys rhs_ty (MG { mg_alts = matches, mg_origin = origin })
   = ASSERT( not (null matches) )	-- Ensure that rhs_ty is filled in
     do	{ matches' <- mapM (tcMatch ctxt pat_tys rhs_ty) matches
-	; return (MG { mg_alts = matches', mg_arg_tys = pat_tys, mg_res_ty = rhs_ty }) }
+	; return (MG { mg_alts = matches', mg_arg_tys = pat_tys, mg_res_ty = rhs_ty, mg_origin = origin }) }
 
 -------------
 tcMatch :: (Outputable (body Name)) => TcMatchCtxt body
diff --git a/compiler/typecheck/TcPat.lhs b/compiler/typecheck/TcPat.lhs
index ab6d7bd40c42..cfc76d653818 100644
--- a/compiler/typecheck/TcPat.lhs
+++ b/compiler/typecheck/TcPat.lhs
@@ -6,14 +6,16 @@
 TcPat: Typechecking patterns
 
 \begin{code}
-{-# OPTIONS -fno-warn-tabs #-}
+{-# LANGUAGE CPP, RankNTypes #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
 -- The above warning supression flag is a temporary kludge.
 -- While working on this module you are encouraged to remove it and
 -- detab the module (please do the detabbing in a separate patch). See
 --     http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
 -- for details
 
-module TcPat ( tcLetPat, TcSigFun, TcSigInfo(..), TcPragFun 
+module TcPat ( tcLetPat, TcSigFun, TcPragFun
+             , TcSigInfo(..), findScopedTyVars
              , LetBndrSpec(..), addInlinePrags, warnPrags
              , tcPat, tcPats, newNoSigLetBndr
 	     , addDataConStupidTheta, badFieldCon, polyPatSig ) where
@@ -29,6 +31,7 @@ import Inst
 import Id
 import Var
 import Name
+import NameSet
 import TcEnv
 --import TcExpr
 import TcMType
@@ -146,8 +149,7 @@ data TcSigInfo
         sig_tvs    :: [(Maybe Name, TcTyVar)],    
                            -- Instantiated type and kind variables
                            -- Just n <=> this skolem is lexically in scope with name n
-                           -- See Note [Kind vars in sig_tvs]
-                     	   -- See Note [More instantiated than scoped] in TcBinds
+                           -- See Note [Binding scoped type variables]
 
         sig_theta  :: TcThetaType,  -- Instantiated theta
 
@@ -157,21 +159,56 @@ data TcSigInfo
         sig_loc    :: SrcSpan       -- The location of the signature
     }
 
+findScopedTyVars  -- See Note [Binding scoped type variables]
+  :: LHsType Name             -- The HsType
+  -> TcType                   -- The corresponding Type:
+                              --   uses same Names as the HsType
+  -> [TcTyVar]                -- The instantiated forall variables of the Type
+  -> [(Maybe Name, TcTyVar)]  -- In 1-1 correspondence with the instantiated vars
+findScopedTyVars hs_ty sig_ty inst_tvs
+  = zipWith find sig_tvs inst_tvs
+  where
+    find sig_tv inst_tv
+      | tv_name `elemNameSet` scoped_names = (Just tv_name, inst_tv)
+      | otherwise                          = (Nothing,      inst_tv)
+      where
+        tv_name = tyVarName sig_tv
+
+    scoped_names = mkNameSet (hsExplicitTvs hs_ty)
+    (sig_tvs,_)  = tcSplitForAllTys sig_ty
+
 instance Outputable TcSigInfo where
     ppr (TcSigInfo { sig_id = id, sig_tvs = tyvars, sig_theta = theta, sig_tau = tau})
         = ppr id <+> dcolon <+> vcat [ pprSigmaType (mkSigmaTy (map snd tyvars) theta tau)
                                      , ppr (map fst tyvars) ]
 \end{code}
 
-Note [Kind vars in sig_tvs]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~
-With kind polymorphism a signature like
-  f :: forall f a. f a -> f a
-may actuallly give rise to 
-  f :: forall k. forall (f::k -> *) (a:k). f a -> f a
-So the sig_tvs will be [k,f,a], but only f,a are scoped.
-So the scoped ones are not necessarily the *inital* ones!
-
+Note [Binding scoped type variables]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+The type variables *brought into lexical scope* by a type signature may
+be a subset of the *quantified type variables* of the signatures, for two reasons:
+
+* With kind polymorphism a signature like
+    f :: forall f a. f a -> f a
+  may actuallly give rise to
+    f :: forall k. forall (f::k -> *) (a:k). f a -> f a
+  So the sig_tvs will be [k,f,a], but only f,a are scoped.
+  NB: the scoped ones are not necessarily the *inital* ones!
+
+* Even aside from kind polymorphism, tere may be more instantiated
+  type variables than lexically-scoped ones.  For example:
+        type T a = forall b. b -> (a,b)
+        f :: forall c. T c
+  Here, the signature for f will have one scoped type variable, c,
+  but two instantiated type variables, c' and b'.
+
+The function findScopedTyVars takes
+  * hs_ty:    the original HsForAllTy
+  * sig_ty:   the corresponding Type (which is guaranteed to use the same Names
+              as the HsForAllTy)
+  * inst_tvs: the skolems instantiated from the forall's in sig_ty
+It returns a [(Maybe Name, TcTyVar)], in 1-1 correspondence with inst_tvs
+but with a (Just n) for the lexically scoped name of each in-scope tyvar.
 
 Note [sig_tau may be polymorphic]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -495,9 +532,9 @@ tc_pat penv (TuplePat pats boxity _) pat_ty thing_inside
 	-- so that we can experiment with lazy tuple-matching.
 	-- This is a pretty odd place to make the switch, but
 	-- it was easy to do.
-	; let pat_ty'          = mkTyConApp tc arg_tys
-                                     -- pat_ty /= pat_ty iff coi /= IdCo
-              unmangled_result = TuplePat pats' boxity pat_ty'
+	; let 
+              unmangled_result = TuplePat pats' boxity arg_tys
+                                 -- pat_ty /= pat_ty iff coi /= IdCo
 	      possibly_mangled_result
 	        | gopt Opt_IrrefutableTuples dflags &&
                   isBoxed boxity            = LazyPat (noLoc unmangled_result)
@@ -694,13 +731,14 @@ tcDataConPat penv (L con_span con_name) data_con pat_ty arg_pats thing_inside
                                (zipTopTvSubst univ_tvs ctxt_res_tys) ex_tvs
                      -- Get location from monad, not from ex_tvs
 
-        ; let pat_ty' = mkTyConApp tycon ctxt_res_tys
+        ; let -- pat_ty' = mkTyConApp tycon ctxt_res_tys
 	      -- pat_ty' is type of the actual constructor application
               -- pat_ty' /= pat_ty iff coi /= IdCo
-              
+
 	      arg_tys' = substTys tenv arg_tys
 
-        ; traceTc "tcConPat" (ppr con_name $$ ppr ex_tvs' $$ ppr pat_ty' $$ ppr arg_tys')
+        ; traceTc "tcConPat" (vcat [ ppr con_name, ppr univ_tvs, ppr ex_tvs, ppr eq_spec
+                                   , ppr ex_tvs', ppr ctxt_res_tys, ppr arg_tys' ])
 	; if null ex_tvs && null eq_spec && null theta
 	  then do { -- The common case; no class bindings etc 
                     -- (see Note [Arrows and patterns])
@@ -710,7 +748,7 @@ tcDataConPat penv (L con_span con_name) data_con pat_ty arg_pats thing_inside
 			            	      pat_tvs = [], pat_dicts = [], 
                                               pat_binds = emptyTcEvBinds,
 					      pat_args = arg_pats', 
-                                              pat_ty = pat_ty',
+                                              pat_arg_tys = ctxt_res_tys,
                                               pat_wrap = idHsWrapper }
 
 		  ; return (mkHsWrapPat wrap res_pat pat_ty, res) }
@@ -743,7 +781,7 @@ tcDataConPat penv (L con_span con_name) data_con pat_ty arg_pats thing_inside
 			            pat_dicts = given,
 			            pat_binds = ev_binds,
 			            pat_args  = arg_pats', 
-                                    pat_ty    = pat_ty',
+                                    pat_arg_tys = ctxt_res_tys,
                                     pat_wrap  = idHsWrapper }
 	; return (mkHsWrapPat wrap res_pat pat_ty, res)
 	} }
@@ -753,11 +791,9 @@ tcPatSynPat :: PatEnv -> Located Name -> PatSyn
 	    -> HsConPatDetails Name -> TcM a
 	    -> TcM (Pat TcId, a)
 tcPatSynPat penv (L con_span _) pat_syn pat_ty arg_pats thing_inside
-  = do	{ let (univ_tvs, ex_tvs, (prov_theta, req_theta)) = patSynSig pat_syn
-              arg_tys = patSynArgTys pat_syn
-              ty = patSynType pat_syn
+  = do	{ let (univ_tvs, ex_tvs, prov_theta, req_theta, arg_tys, ty) = patSynSig pat_syn
 
-        ; (_univ_tvs', inst_tys, subst) <- tcInstTyVars univ_tvs
+        ; (univ_tvs', inst_tys, subst) <- tcInstTyVars univ_tvs
 
 	; checkExistentials ex_tvs penv
         ; (tenv, ex_tvs') <- tcInstSuperSkolTyVarsX subst ex_tvs
@@ -777,14 +813,12 @@ tcPatSynPat penv (L con_span _) pat_syn pat_ty arg_pats thing_inside
 
         ; prov_dicts' <- newEvVars prov_theta'
 
-          {-
+        -- Using a pattern synonym requires the PatternSynonyms
+        -- language flag to keep consistent with #2905
         ; patsyns_on <- xoptM Opt_PatternSynonyms
 	; checkTc patsyns_on
                   (ptext (sLit "A pattern match on a pattern synonym requires PatternSynonyms"))
-		  -- Trac #2905 decided that a *pattern-match* of a GADT
-		  -- should require the GADT language flag.
-                  -- Re TypeFamilies see also #7156
--}
+
         ; let skol_info = case pe_ctxt penv of
                             LamPat mc -> PatSkol (PatSynCon pat_syn) mc
                             LetPat {} -> UnkSkol -- Doesn't matter
@@ -803,7 +837,7 @@ tcPatSynPat penv (L con_span _) pat_syn pat_ty arg_pats thing_inside
 			            pat_dicts = prov_dicts',
 			            pat_binds = ev_binds,
 			            pat_args  = arg_pats',
-                                    pat_ty    = ty',
+                                    pat_arg_tys = mkTyVarTys univ_tvs',
                                     pat_wrap  = req_wrap }
 	; return (mkHsWrapPat wrap res_pat pat_ty, res) }
 
diff --git a/compiler/typecheck/TcPatSyn.lhs b/compiler/typecheck/TcPatSyn.lhs
index a126f0f85f19..b5fbc295f52f 100644
--- a/compiler/typecheck/TcPatSyn.lhs
+++ b/compiler/typecheck/TcPatSyn.lhs
@@ -5,7 +5,9 @@
 \section[TcPatSyn]{Typechecking pattern synonym declarations}
 
 \begin{code}
-module TcPatSyn (tcPatSynDecl) where
+{-# LANGUAGE CPP #-}
+
+module TcPatSyn (tcPatSynDecl, tcPatSynWrapper) where
 
 import HsSyn
 import TcPat
@@ -16,13 +18,13 @@ import TysPrim
 import Name
 import SrcLoc
 import PatSyn
-import Maybes
 import NameSet
 import Panic
 import Outputable
 import FastString
 import Var
 import Id
+import IdInfo( IdDetails( VanillaId ) )
 import TcBinds
 import BasicTypes
 import TcSimplify
@@ -32,43 +34,43 @@ import Data.Monoid
 import Bag
 import TcEvidence
 import BuildTyCl
+import TypeRep
 
 #include "HsVersions.h"
 \end{code}
 
 \begin{code}
-tcPatSynDecl :: Located Name
-             -> HsPatSynDetails (Located Name)
-             -> LPat Name
-             -> HsPatSynDir Name
+tcPatSynDecl :: PatSynBind Name Name
              -> TcM (PatSyn, LHsBinds Id)
-tcPatSynDecl lname@(L _ name) details lpat dir
+tcPatSynDecl PSB{ psb_id = lname@(L _ name), psb_args = details,
+                  psb_def = lpat, psb_dir = dir }
   = do { traceTc "tcPatSynDecl {" $ ppr name $$ ppr lpat
+       ; tcCheckPatSynPat lpat
        ; pat_ty <- newFlexiTyVarTy openTypeKind
 
        ; let (arg_names, is_infix) = case details of
-                 PrefixPatSyn names -> (map unLoc names, False)
+                 PrefixPatSyn names      -> (map unLoc names, False)
                  InfixPatSyn name1 name2 -> (map unLoc [name1, name2], True)
-       ; ((lpat', args), wanted) <- captureConstraints $
-                                      tcPat PatSyn lpat pat_ty $ mapM tcLookupId arg_names
+       ; ((lpat', args), wanted) <- captureConstraints       $
+                                    tcPat PatSyn lpat pat_ty $
+                                    mapM tcLookupId arg_names
        ; let named_taus = (name, pat_ty):map (\arg -> (getName arg, varType arg)) args
 
        ; traceTc "tcPatSynDecl::wanted" (ppr named_taus $$ ppr wanted)
-       ; (qtvs, given_dicts, _mr_bites, ev_binds) <- simplifyInfer True False named_taus wanted
-       ; let req_dicts = given_dicts
+       ; (qtvs, req_dicts, _mr_bites, ev_binds) <- simplifyInfer True False named_taus wanted
 
        ; (ex_vars, prov_dicts) <- tcCollectEx lpat'
-       ; let univ_tvs = filter (not . (`elemVarSet` ex_vars)) qtvs
-             ex_tvs = varSetElems ex_vars
-
-       ; pat_ty <- zonkTcType pat_ty
-       ; args <- mapM zonkId args
+       ; let univ_tvs   = filter (not . (`elemVarSet` ex_vars)) qtvs
+             ex_tvs     = varSetElems ex_vars
+             prov_theta = map evVarPred prov_dicts
+             req_theta  = map evVarPred req_dicts
 
-       ; univ_tvs <- mapM zonkQuantifiedTyVar univ_tvs
-       ; let prov_theta = map evVarPred prov_dicts
-             req_theta = map evVarPred req_dicts
+       ; univ_tvs   <- mapM zonkQuantifiedTyVar univ_tvs
+       ; ex_tvs     <- mapM zonkQuantifiedTyVar ex_tvs
        ; prov_theta <- zonkTcThetaType prov_theta
-       ; req_theta <- zonkTcThetaType req_theta
+       ; req_theta  <- zonkTcThetaType req_theta
+       ; pat_ty     <- zonkTcType pat_ty
+       ; args       <- mapM zonkId args
 
        ; traceTc "tcPatSynDecl: ex" (ppr ex_tvs $$
                                      ppr prov_theta $$
@@ -91,19 +93,24 @@ tcPatSynDecl lname@(L _ name) details lpat dir
                                          prov_dicts req_dicts
                                          prov_theta req_theta
                                          pat_ty
-       ; m_wrapper <- tcPatSynWrapper lname lpat dir args
-                        univ_tvs ex_tvs theta pat_ty
-       ; let binds = matcher_bind `unionBags` maybe emptyBag snd m_wrapper
+
+       ; wrapper_id <- if isBidirectional dir
+                       then fmap Just $ mkPatSynWrapperId lname args univ_tvs ex_tvs theta pat_ty
+                       else return Nothing
 
        ; traceTc "tcPatSynDecl }" $ ppr name
        ; let patSyn = mkPatSyn name is_infix
-                        args
+                        (map varType args)
                         univ_tvs ex_tvs
                         prov_theta req_theta
                         pat_ty
-                        matcher_id (fmap fst m_wrapper)
-       ; return (patSyn, binds) }
+                        matcher_id wrapper_id
+       ; return (patSyn, matcher_bind) }
+
+\end{code}
 
+
+\begin{code}
 tcPatSynMatcher :: Located Name
                 -> LPat Id
                 -> [Var]
@@ -113,12 +120,18 @@ tcPatSynMatcher :: Located Name
                 -> ThetaType -> ThetaType
                 -> TcType
                 -> TcM (Id, LHsBinds Id)
+-- See Note [Matchers and wrappers for pattern synonyms] in PatSyn
 tcPatSynMatcher (L loc name) lpat args univ_tvs ex_tvs ev_binds prov_dicts req_dicts prov_theta req_theta pat_ty
   = do { res_tv <- zonkQuantifiedTyVar =<< newFlexiTyVar liftedTypeKind
-       ; (matcher_id, res_ty, cont_ty) <- mkPatSynMatcherId name args
-                                            univ_tvs ex_tvs
-                                            prov_theta req_theta
-                                            pat_ty res_tv
+       ; matcher_name <- newImplicitBinder name mkMatcherOcc
+       ; let res_ty = TyVarTy res_tv
+             cont_ty = mkSigmaTy ex_tvs prov_theta $
+                       mkFunTys (map varType args) res_ty
+
+       ; let matcher_tau = mkFunTys [pat_ty, cont_ty, res_ty] res_ty
+             matcher_sigma = mkSigmaTy (res_tv:univ_tvs) req_theta matcher_tau
+             matcher_id = mkExportedLocalId VanillaId matcher_name matcher_sigma
+
        ; traceTc "tcPatSynMatcher" (ppr name $$ ppr (idType matcher_id))
        ; let matcher_lid = L loc matcher_id
 
@@ -141,18 +154,21 @@ tcPatSynMatcher (L loc name) lpat args univ_tvs ex_tvs ev_binds prov_dicts req_d
                     MG{ mg_alts = cases
                       , mg_arg_tys = [pat_ty]
                       , mg_res_ty = res_ty
+                      , mg_origin = Generated
                       }
              body' = noLoc $
                      HsLam $
                      MG{ mg_alts = [mkSimpleMatch args body]
                        , mg_arg_tys = [pat_ty, cont_ty, res_ty]
                        , mg_res_ty = res_ty
+                       , mg_origin = Generated
                        }
 
              match = mkMatch [] (mkHsLams (res_tv:univ_tvs) req_dicts body') EmptyLocalBinds
              mg = MG{ mg_alts = [match]
                     , mg_arg_tys = []
                     , mg_res_ty = res_ty
+                    , mg_origin = Generated
                     }
 
        ; let bind = FunBind{ fun_id = matcher_lid
@@ -161,7 +177,7 @@ tcPatSynMatcher (L loc name) lpat args univ_tvs ex_tvs ev_binds prov_dicts req_d
                            , fun_co_fn = idHsWrapper
                            , bind_fvs = emptyNameSet
                            , fun_tick = Nothing }
-             matcher_bind = unitBag (Generated, noLoc bind)
+             matcher_bind = unitBag (noLoc bind)
 
        ; traceTc "tcPatSynMatcher" (ppr matcher_bind)
 
@@ -171,123 +187,195 @@ tcPatSynMatcher (L loc name) lpat args univ_tvs ex_tvs ev_binds prov_dicts req_d
         name <- newName . mkVarOccFS . fsLit $ s
         return $ mkLocalId name ty
 
-tcPatSynWrapper :: Located Name
-                -> LPat Name
-                -> HsPatSynDir Name
-                -> [Var]
-                -> [TyVar] -> [TyVar]
-                -> ThetaType
-                -> TcType
-                -> TcM (Maybe (Id, LHsBinds Id))
-tcPatSynWrapper lname lpat dir args univ_tvs ex_tvs theta pat_ty
-  = do { let argNames = mkNameSet (map Var.varName args)
-       ; m_expr <- runMaybeT $ tcPatToExpr argNames lpat
-       ; case (dir, m_expr) of
-           (Unidirectional, _) ->
-               return Nothing
-           (ImplicitBidirectional, Nothing) ->
-               cannotInvertPatSynErr (unLoc lpat)
-           (ImplicitBidirectional, Just lexpr) ->
-               fmap Just $ tc_pat_syn_wrapper_from_expr lname lexpr args univ_tvs ex_tvs theta pat_ty }
-
-tc_pat_syn_wrapper_from_expr :: Located Name
-                             -> LHsExpr Name
-                             -> [Var]
-                             -> [TyVar] -> [TyVar]
-                             -> ThetaType
-                             -> Type
-                             -> TcM (Id, LHsBinds Id)
-tc_pat_syn_wrapper_from_expr (L loc name) lexpr args univ_tvs ex_tvs theta pat_ty
+isBidirectional :: HsPatSynDir a -> Bool
+isBidirectional Unidirectional = False
+isBidirectional ImplicitBidirectional = True
+isBidirectional ExplicitBidirectional{} = True
+
+tcPatSynWrapper :: PatSynBind Name Name
+                -> TcM (LHsBinds Id)
+-- See Note [Matchers and wrappers for pattern synonyms] in PatSyn
+tcPatSynWrapper PSB{ psb_id = L loc name, psb_def = lpat, psb_dir = dir, psb_args = details }
+  = case dir of
+    Unidirectional -> return emptyBag
+    ImplicitBidirectional ->
+        do { wrapper_id <- tcLookupPatSynWrapper name
+           ; lexpr <- case tcPatToExpr (mkNameSet args) lpat of
+                  Nothing -> cannotInvertPatSynErr lpat
+                  Just lexpr -> return lexpr
+           ; let wrapper_args = map (noLoc . VarPat) args
+                 wrapper_lname = L (getLoc lpat) (idName wrapper_id)
+                 wrapper_match = mkMatch wrapper_args lexpr EmptyLocalBinds
+                 wrapper_bind = mkTopFunBind Generated wrapper_lname [wrapper_match]
+           ; mkPatSynWrapper wrapper_id wrapper_bind }
+    ExplicitBidirectional mg ->
+        do { wrapper_id <- tcLookupPatSynWrapper name
+           ; mkPatSynWrapper wrapper_id $
+               FunBind{ fun_id = L loc (idName wrapper_id)
+                      , fun_infix = False
+                      , fun_matches = mg
+                      , fun_co_fn = idHsWrapper
+                      , bind_fvs = placeHolderNames
+                      , fun_tick = Nothing }}
+  where
+    args = map unLoc $ case details of
+        PrefixPatSyn args -> args
+        InfixPatSyn arg1 arg2 -> [arg1, arg2]
+
+    tcLookupPatSynWrapper name
+      = do { patsyn <- tcLookupPatSyn name
+           ; case patSynWrapper patsyn of
+               Nothing -> panic "tcLookupPatSynWrapper"
+               Just wrapper_id -> return wrapper_id }
+
+mkPatSynWrapperId :: Located Name
+                  -> [Var] -> [TyVar] -> [TyVar] -> ThetaType -> Type
+                  -> TcM Id
+mkPatSynWrapperId (L _ name) args univ_tvs ex_tvs theta pat_ty
   = do { let qtvs = univ_tvs ++ ex_tvs
-       ; (subst, qtvs') <- tcInstSigTyVars qtvs
-       ; let theta' = substTheta subst theta
+       ; (subst, wrapper_tvs) <- tcInstSkolTyVars qtvs
+       ; let wrapper_theta = substTheta subst theta
              pat_ty' = substTy subst pat_ty
              args' = map (\arg -> setVarType arg $ substTy subst (varType arg)) args
-
-       ; wrapper_id <- mkPatSynWrapperId name args qtvs theta pat_ty
-       ; let wrapper_name = getName wrapper_id
-             wrapper_lname = L loc wrapper_name
-             -- (wrapper_tvs, wrapper_theta, wrapper_tau) = tcSplitSigmaTy (idType wrapper_id)
-             wrapper_tvs = qtvs'
-             wrapper_theta = theta'
              wrapper_tau = mkFunTys (map varType args') pat_ty'
+             wrapper_sigma = mkSigmaTy wrapper_tvs wrapper_theta wrapper_tau
 
-       ; let wrapper_args = map (noLoc . VarPat . Var.varName) args'
-             wrapper_match = mkMatch wrapper_args lexpr EmptyLocalBinds
-             bind = mkTopFunBind wrapper_lname [wrapper_match]
-             lbind = noLoc bind
-       ; let sig = TcSigInfo{ sig_id = wrapper_id
-                            , sig_tvs = map (\tv -> (Nothing, tv)) wrapper_tvs
-                            , sig_theta = wrapper_theta
-                            , sig_tau = wrapper_tau
-                            , sig_loc = loc
-                            }
-       ; (wrapper_binds, _, _) <- tcPolyCheck NonRecursive (const []) sig (Generated, lbind)
+       ; wrapper_name <- newImplicitBinder name mkDataConWrapperOcc
+       ; return $ mkExportedLocalId VanillaId wrapper_name wrapper_sigma }
+
+mkPatSynWrapper :: Id
+                -> HsBind Name
+                -> TcM (LHsBinds Id)
+mkPatSynWrapper wrapper_id bind
+  = do { (wrapper_binds, _, _) <- tcPolyCheck NonRecursive (const []) sig (noLoc bind)
        ; traceTc "tcPatSynDecl wrapper" $ ppr wrapper_binds
        ; traceTc "tcPatSynDecl wrapper type" $ ppr (varType wrapper_id)
-       ; return (wrapper_id, wrapper_binds) }
+       ; return wrapper_binds }
+  where
+    sig = TcSigInfo{ sig_id = wrapper_id
+                   , sig_tvs = map (\tv -> (Nothing, tv)) wrapper_tvs
+                   , sig_theta = wrapper_theta
+                   , sig_tau = wrapper_tau
+                   , sig_loc = noSrcSpan
+                   }
+    (wrapper_tvs, wrapper_theta, wrapper_tau) = tcSplitSigmaTy (idType wrapper_id)
+
+\end{code}
+
+Note [As-patterns in pattern synonym definitions]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+The rationale for rejecting as-patterns in pattern synonym definitions
+is that an as-pattern would introduce nonindependent pattern synonym
+arguments, e.g. given a pattern synonym like:
+
+        pattern K x y = x@(Just y)
 
-tcNothing :: MaybeT TcM a
-tcNothing = MaybeT (return Nothing)
+one could write a nonsensical function like
 
-withLoc :: (a -> MaybeT TcM b) -> Located a -> MaybeT TcM (Located b)
-withLoc fn (L loc x) = MaybeT $ setSrcSpan loc $
-    do { y <- runMaybeT $ fn x
-       ; return (fmap (L loc) y) }
+        f (K Nothing x) = ...
 
-tcPatToExpr :: NameSet -> LPat Name -> MaybeT TcM (LHsExpr Name)
+or
+        g (K (Just True) False) = ...
+
+\begin{code}
+tcCheckPatSynPat :: LPat Name -> TcM ()
+tcCheckPatSynPat = go
+  where
+    go :: LPat Name -> TcM ()
+    go = addLocM go1
+
+    go1 :: Pat Name -> TcM ()
+    go1   (ConPatIn _ info)   = mapM_ go (hsConPatArgs info)
+    go1   VarPat{}            = return ()
+    go1   WildPat{}           = return ()
+    go1 p@(AsPat _ _)         = asPatInPatSynErr p
+    go1   (LazyPat pat)       = go pat
+    go1   (ParPat pat)        = go pat
+    go1   (BangPat pat)       = go pat
+    go1   (PArrPat pats _)    = mapM_ go pats
+    go1   (ListPat pats _ _)  = mapM_ go pats
+    go1   (TuplePat pats _ _) = mapM_ go pats
+    go1   LitPat{}            = return ()
+    go1   NPat{}              = return ()
+    go1   (SigPatIn pat _)    = go pat
+    go1   (ViewPat _ pat _)   = go pat
+    go1 p@SplicePat{}         = thInPatSynErr p
+    go1 p@QuasiQuotePat{}     = thInPatSynErr p
+    go1 p@NPlusKPat{}         = nPlusKPatInPatSynErr p
+    go1   ConPatOut{}         = panic "ConPatOut in output of renamer"
+    go1   SigPatOut{}         = panic "SigPatOut in output of renamer"
+    go1   CoPat{}             = panic "CoPat in output of renamer"
+
+asPatInPatSynErr :: OutputableBndr name => Pat name -> TcM a
+asPatInPatSynErr pat
+  = failWithTc $
+    hang (ptext (sLit "Pattern synonym definition cannot contain as-patterns (@):"))
+       2 (ppr pat)
+
+thInPatSynErr :: OutputableBndr name => Pat name -> TcM a
+thInPatSynErr pat
+  = failWithTc $
+    hang (ptext (sLit "Pattern synonym definition cannot contain Template Haskell:"))
+       2 (ppr pat)
+
+nPlusKPatInPatSynErr :: OutputableBndr name => Pat name -> TcM a
+nPlusKPatInPatSynErr pat
+  = failWithTc $
+    hang (ptext (sLit "Pattern synonym definition cannot contain n+k-pattern:"))
+       2 (ppr pat)
+
+tcPatToExpr :: NameSet -> LPat Name -> Maybe (LHsExpr Name)
 tcPatToExpr lhsVars = go
   where
-    go :: LPat Name -> MaybeT TcM (LHsExpr Name)
+    go :: LPat Name -> Maybe (LHsExpr Name)
     go (L loc (ConPatIn conName info))
-      = MaybeT . setSrcSpan loc . runMaybeT $ do
+      = do
           { let con = L loc (HsVar (unLoc conName))
           ; exprs <- mapM go (hsConPatArgs info)
           ; return $ foldl (\x y -> L loc (HsApp x y)) con exprs }
-    go p = withLoc go1 p
+    go (L loc p) = fmap (L loc) $ go1 p
 
-    go1 :: Pat Name -> MaybeT TcM (HsExpr Name)
+    go1 :: Pat Name -> Maybe (HsExpr Name)
     go1   (VarPat var)
-      | var `elemNameSet` lhsVars  = return (HsVar var)
-      | otherwise                  = tcNothing
-    go1 p@(AsPat _ _)              = asPatInPatSynErr p
-    go1   (LazyPat pat)            = fmap HsPar (go pat)
-    go1   (ParPat pat)             = fmap HsPar (go pat)
-    go1   (BangPat pat)            = fmap HsPar (go pat)
+      | var `elemNameSet` lhsVars  = return $ HsVar var
+      | otherwise                  = Nothing
+    go1   (LazyPat pat)            = fmap HsPar $ go pat
+    go1   (ParPat pat)             = fmap HsPar $ go pat
+    go1   (BangPat pat)            = fmap HsPar $ go pat
     go1   (PArrPat pats ptt)
       = do { exprs <- mapM go pats
-           ; return (ExplicitPArr ptt exprs) }
+           ; return $ ExplicitPArr ptt exprs }
     go1   (ListPat pats ptt reb)
       = do { exprs <- mapM go pats
-           ; return (ExplicitList ptt (fmap snd reb) exprs) }
+           ; return $ ExplicitList ptt (fmap snd reb) exprs }
     go1   (TuplePat pats box _)
       = do { exprs <- mapM go pats
            ; return (ExplicitTuple (map Present exprs) box)
            }
-    go1   (LitPat lit)  = return (HsLit lit)
-    go1   (NPat n Nothing _)       = return (HsOverLit n)
-    go1   (NPat n (Just neg) _)    = return (noLoc neg `HsApp` noLoc (HsOverLit n))
+    go1   (LitPat lit)             = return $ HsLit lit
+    go1   (NPat n Nothing _)       = return $ HsOverLit n
+    go1   (NPat n (Just neg) _)    = return $ noLoc neg `HsApp` noLoc (HsOverLit n)
     go1   (SigPatIn pat (HsWB ty _ _))
       = do { expr <- go pat
-           ; return (ExprWithTySig expr ty) }
+           ; return $ ExprWithTySig expr ty }
     go1   (ConPatOut{})            = panic "ConPatOut in output of renamer"
     go1   (SigPatOut{})            = panic "SigPatOut in output of renamer"
     go1   (CoPat{})                = panic "CoPat in output of renamer"
-    go1   _                        = tcNothing
+    go1   _                        = Nothing
 
-asPatInPatSynErr :: OutputableBndr name => Pat name -> MaybeT TcM a
-asPatInPatSynErr pat
-  = MaybeT . failWithTc $
-    hang (ptext (sLit "Pattern synonym definition cannot contain as-patterns (@):"))
-       2 (ppr pat)
-
--- TODO: Highlight sub-pattern that causes the problem
-cannotInvertPatSynErr :: OutputableBndr name => Pat name -> TcM a
-cannotInvertPatSynErr pat
-  = failWithTc $
+cannotInvertPatSynErr :: OutputableBndr name => LPat name -> TcM a
+cannotInvertPatSynErr (L loc pat)
+  = setSrcSpan loc $ failWithTc $
     hang (ptext (sLit "Right-hand side of bidirectional pattern synonym cannot be used as an expression"))
        2 (ppr pat)
 
+-- Walk the whole pattern and for all ConPatOuts, collect the
+-- existentially-bound type variables and evidence binding variables.
+--
+-- These are used in computing the type of a pattern synonym and also
+-- in generating matcher functions, since success continuations need
+-- to be passed these pattern-bound evidences.
 tcCollectEx :: LPat Id -> TcM (TyVarSet, [EvVar])
 tcCollectEx = return . go
   where
diff --git a/compiler/typecheck/TcPatSyn.lhs-boot b/compiler/typecheck/TcPatSyn.lhs-boot
index d0420c0c31cc..700137c16c12 100644
--- a/compiler/typecheck/TcPatSyn.lhs-boot
+++ b/compiler/typecheck/TcPatSyn.lhs-boot
@@ -3,14 +3,13 @@ module TcPatSyn where
 
 import Name      ( Name )
 import Id        ( Id )
-import HsSyn     ( LPat, HsPatSynDetails, HsPatSynDir, LHsBinds )
+import HsSyn     ( PatSynBind, LHsBinds )
 import TcRnTypes ( TcM )
-import SrcLoc    ( Located )
 import PatSyn    ( PatSyn )
 
-tcPatSynDecl :: Located Name
-             -> HsPatSynDetails (Located Name)
-             -> LPat Name
-             -> HsPatSynDir Name
+tcPatSynDecl :: PatSynBind Name Name
              -> TcM (PatSyn, LHsBinds Id)
+
+tcPatSynWrapper :: PatSynBind Name Name
+                -> TcM (LHsBinds Id)
 \end{code}
diff --git a/compiler/typecheck/TcRnDriver.lhs b/compiler/typecheck/TcRnDriver.lhs
index dad2c67389e7..cd27e9d044fe 100644
--- a/compiler/typecheck/TcRnDriver.lhs
+++ b/compiler/typecheck/TcRnDriver.lhs
@@ -5,6 +5,8 @@
 \section[TcMovectle]{Typechecking a whole module}
 
 \begin{code}
+{-# LANGUAGE CPP, NondecreasingIndentation #-}
+
 module TcRnDriver (
 #ifdef GHCI
         tcRnStmt, tcRnExpr, tcRnType,
@@ -13,12 +15,12 @@ module TcRnDriver (
         getModuleInterface,
         tcRnDeclsi,
         isGHCiMonad,
+        runTcInteractive,    -- Used by GHC API clients (Trac #8878)
 #endif
         tcRnLookupName,
         tcRnGetInfo,
         tcRnModule, tcRnModuleTcRnM,
-        tcTopSrcDecls,
-        tcRnExtCore
+        tcTopSrcDecls
     ) where
 
 #ifdef GHCI
@@ -57,10 +59,9 @@ import LoadIface
 import RnNames
 import RnEnv
 import RnSource
-import PprCore
-import CoreSyn
 import ErrUtils
 import Id
+import IdInfo( IdDetails( VanillaId ) )
 import VarEnv
 import Module
 import UniqFM
@@ -78,14 +79,11 @@ import DataCon
 import Type
 import Class
 import CoAxiom
-import Inst     ( tcGetInstEnvs, tcGetInsts )
+import Inst     ( tcGetInstEnvs )
 import Annotations
 import Data.List ( sortBy )
-import Data.IORef ( readIORef )
 import Data.Ord
-#ifndef GHCI
-import BasicTypes ( Origin(..) )
-#else
+#ifdef GHCI
 import BasicTypes hiding( SuccessFlag(..) )
 import TcType   ( isUnitTy, isTauTy )
 import TcHsType
@@ -305,107 +303,6 @@ tcRnImports hsc_env import_decls
 \end{code}
 
 
-%************************************************************************
-%*                                                                      *
-        Type-checking external-core modules
-%*                                                                      *
-%************************************************************************
-
-\begin{code}
-tcRnExtCore :: HscEnv
-            -> HsExtCore RdrName
-            -> IO (Messages, Maybe ModGuts)
-        -- Nothing => some error occurred
-
-tcRnExtCore hsc_env (HsExtCore this_mod decls src_binds)
-        -- The decls are IfaceDecls; all names are original names
- = do { showPass (hsc_dflags hsc_env) "Renamer/typechecker" ;
-
-   initTc hsc_env ExtCoreFile False this_mod $ do {
-
-   let { ldecls  = map noLoc decls } ;
-
-       -- Bring the type and class decls into scope
-       -- ToDo: check that this doesn't need to extract the val binds.
-       --       It seems that only the type and class decls need to be in scope below because
-       --          (a) tcTyAndClassDecls doesn't need the val binds, and
-       --          (b) tcExtCoreBindings doesn't need anything
-       --              (in fact, it might not even need to be in the scope of
-       --               this tcg_env at all)
-   (tc_envs, _bndrs) <- getLocalNonValBinders emptyFsEnv {- no fixity decls -}
-                                              (mkFakeGroup ldecls) ;
-   setEnvs tc_envs $ do {
-
-   (rn_decls, _fvs) <- checkNoErrs $ rnTyClDecls [] [mkTyClGroup ldecls] ;
-   -- The empty list is for extra dependencies coming from .hs-boot files
-   -- See Note [Extra dependencies from .hs-boot files] in RnSource
-
-        -- Dump trace of renaming part
-   rnDump (ppr rn_decls) ;
-
-        -- Typecheck them all together so that
-        -- any mutually recursive types are done right
-        -- Just discard the auxiliary bindings; they are generated
-        -- only for Haskell source code, and should already be in Core
-   tcg_env   <- tcTyAndClassDecls emptyModDetails rn_decls ;
-   safe_mode <- liftIO $ finalSafeMode (hsc_dflags hsc_env) tcg_env ;
-   dep_files <- liftIO $ readIORef (tcg_dependent_files tcg_env) ;
-
-   setGblEnv tcg_env $ do {
-        -- Make the new type env available to stuff slurped from interface files
-
-        -- Now the core bindings
-   core_binds <- initIfaceExtCore (tcExtCoreBindings src_binds) ;
-
-
-        -- Wrap up
-   let {
-        bndrs      = bindersOfBinds core_binds ;
-        my_exports = map (Avail . idName) bndrs ;
-                -- ToDo: export the data types also?
-
-        mod_guts = ModGuts {    mg_module    = this_mod,
-                                mg_boot      = False,
-                                mg_used_names = emptyNameSet, -- ToDo: compute usage
-                                mg_used_th   = False,
-                                mg_dir_imps  = emptyModuleEnv, -- ??
-                                mg_deps      = noDependencies,  -- ??
-                                mg_exports   = my_exports,
-                                mg_tcs       = tcg_tcs tcg_env,
-                                mg_insts     = tcg_insts tcg_env,
-                                mg_fam_insts = tcg_fam_insts tcg_env,
-                                mg_inst_env  = tcg_inst_env tcg_env,
-                                mg_fam_inst_env = tcg_fam_inst_env tcg_env,
-                                mg_patsyns      = [], -- TODO
-                                mg_rules        = [],
-                                mg_vect_decls   = [],
-                                mg_anns         = [],
-                                mg_binds        = core_binds,
-
-                                -- Stubs
-                                mg_rdr_env      = emptyGlobalRdrEnv,
-                                mg_fix_env      = emptyFixityEnv,
-                                mg_warns        = NoWarnings,
-                                mg_foreign      = NoStubs,
-                                mg_hpc_info     = emptyHpcInfo False,
-                                mg_modBreaks    = emptyModBreaks,
-                                mg_vect_info    = noVectInfo,
-                                mg_safe_haskell = safe_mode,
-                                mg_trust_pkg    = False,
-                                mg_dependent_files = dep_files
-                            } } ;
-
-   tcCoreDump mod_guts ;
-
-   return mod_guts
-   }}}}
-
-mkFakeGroup :: [LTyClDecl a] -> HsGroup a
-mkFakeGroup decls -- Rather clumsy; lots of unused fields
-  = emptyRdrGroup { hs_tyclds = [mkTyClGroup decls] }
-\end{code}
-
-
 %************************************************************************
 %*                                                                      *
         Type-checking the top level of a module
@@ -648,12 +545,35 @@ checkHiBootIface
         tcg_env@(TcGblEnv { tcg_src = hs_src, tcg_binds = binds,
                             tcg_insts = local_insts,
                             tcg_type_env = local_type_env, tcg_exports = local_exports })
-        (ModDetails { md_insts = boot_insts, md_fam_insts = boot_fam_insts,
-                      md_types = boot_type_env, md_exports = boot_exports })
+        boot_details
   | isHsBoot hs_src     -- Current module is already a hs-boot file!
   = return tcg_env
 
   | otherwise
+  = do  { mb_dfun_prs <- checkHiBootIface' local_insts local_type_env
+                                           local_exports boot_details
+        ; let dfun_prs   = catMaybes mb_dfun_prs
+              boot_dfuns = map fst dfun_prs
+              dfun_binds = listToBag [ mkVarBind boot_dfun (nlHsVar dfun)
+                                     | (boot_dfun, dfun) <- dfun_prs ]
+              type_env'  = extendTypeEnvWithIds local_type_env boot_dfuns
+              tcg_env'   = tcg_env { tcg_binds = binds `unionBags` dfun_binds }
+
+        ; setGlobalTypeEnv tcg_env' type_env' }
+             -- Update the global type env *including* the knot-tied one
+             -- so that if the source module reads in an interface unfolding
+             -- mentioning one of the dfuns from the boot module, then it
+             -- can "see" that boot dfun.   See Trac #4003
+
+checkHiBootIface' :: [ClsInst] -> TypeEnv -> [AvailInfo]
+                  -> ModDetails -> TcM [Maybe (Id, Id)]
+-- Variant which doesn't require a full TcGblEnv; you could get the
+-- local components from another ModDetails.
+
+checkHiBootIface'
+        local_insts local_type_env local_exports
+        (ModDetails { md_insts = boot_insts, md_fam_insts = boot_fam_insts,
+                      md_types = boot_type_env, md_exports = boot_exports })
   = do  { traceTc "checkHiBootIface" $ vcat
              [ ppr boot_type_env, ppr boot_insts, ppr boot_exports]
 
@@ -670,19 +590,11 @@ checkHiBootIface
 
                 -- Check instance declarations
         ; mb_dfun_prs <- mapM check_inst boot_insts
-        ; let dfun_prs   = catMaybes mb_dfun_prs
-              boot_dfuns = map fst dfun_prs
-              dfun_binds = listToBag [ (Generated, mkVarBind boot_dfun (nlHsVar dfun))
-                                     | (boot_dfun, dfun) <- dfun_prs ]
-              type_env'  = extendTypeEnvWithIds local_type_env boot_dfuns
-              tcg_env'   = tcg_env { tcg_binds = binds `unionBags` dfun_binds }
 
         ; failIfErrsM
-        ; setGlobalTypeEnv tcg_env' type_env' }
-             -- Update the global type env *including* the knot-tied one
-             -- so that if the source module reads in an interface unfolding
-             -- mentioning one of the dfuns from the boot module, then it
-             -- can "see" that boot dfun.   See Trac #4003
+
+        ; return mb_dfun_prs }
+
   where
     check_export boot_avail     -- boot_avail is exported by the boot iface
       | name `elem` dfun_names = return ()
@@ -736,7 +648,7 @@ checkHiBootIface
         where
           boot_dfun = instanceDFunId boot_inst
           boot_inst_ty = idType boot_dfun
-          local_boot_dfun = Id.mkExportedLocalId (idName boot_dfun) boot_inst_ty
+          local_boot_dfun = Id.mkExportedLocalId VanillaId (idName boot_dfun) boot_inst_ty
 
 
 -- This has to compare the TyThing from the .hi-boot file to the TyThing
@@ -784,17 +696,14 @@ checkBootTyCon tc1 tc2
           (_, rho_ty2) = splitForAllTys (idType id2)
           op_ty2 = funResultTy rho_ty2
 
-       eqAT (tc1, def_ats1) (tc2, def_ats2)
+       eqAT (ATI tc1 def_ats1) (ATI tc2 def_ats2)
          = checkBootTyCon tc1 tc2 &&
-           eqListBy eqATDef def_ats1 def_ats2
+           eqATDef def_ats1 def_ats2
 
        -- Ignore the location of the defaults
-       eqATDef (CoAxBranch { cab_tvs = tvs1, cab_lhs =  ty_pats1, cab_rhs = ty1 })
-               (CoAxBranch { cab_tvs = tvs2, cab_lhs =  ty_pats2, cab_rhs = ty2 })
-         | Just env <- eqTyVarBndrs emptyRnEnv2 tvs1 tvs2
-         = eqListBy (eqTypeX env) ty_pats1 ty_pats2 &&
-           eqTypeX env ty1 ty2
-         | otherwise = False
+       eqATDef Nothing    Nothing    = True
+       eqATDef (Just ty1) (Just ty2) = eqTypeX env ty1 ty2
+       eqATDef _ _ = False           
 
        eqFD (as1,bs1) (as2,bs2) =
          eqListBy (eqTypeX env) (mkTyVarTys as1) (mkTyVarTys as2) &&
@@ -938,218 +847,6 @@ rnTopSrcDecls extra_deps group
 \end{code}
 
 
-%************************************************************************
-%*                                                                      *
-                AMP warnings
-     The functions defined here issue warnings according to
-     the 2013 Applicative-Monad proposal. (Trac #8004)
-%*                                                                      *
-%************************************************************************
-
-Note [No AMP warning with NoImplicitPrelude]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-If you have -XNoImplicitPrelude, then we suppress the AMP warnings.
-The AMP warnings need access to Monad, Applicative, etc, and they
-are defined in 'base'. If, when compiling package 'ghc-prim' (say),
-you try to load Monad (from 'base'), chaos results because 'base'
-depends on 'ghc-prim'.  See Note [Home module load error] in LoadIface,
-and Trac #8320.
-
-Using -XNoImplicitPrelude is a proxy for ensuring that all the
-'base' modules are below the home module in the dependency tree.
-
-\begin{code}
--- | Main entry point for generating AMP warnings
-tcAmpWarn :: TcM ()
-tcAmpWarn =
-    do { implicit_prel <- xoptM Opt_ImplicitPrelude
-       ; warnFlag <- woptM Opt_WarnAMP
-       ; when (warnFlag && implicit_prel) $ do {
-              -- See Note [No AMP warning with NoImplicitPrelude]
-
-         -- Monad without Applicative
-       ; tcAmpMissingParentClassWarn monadClassName
-                                     applicativeClassName
-
-         -- MonadPlus without Alternative
-       ; tcAmpMissingParentClassWarn monadPlusClassName
-                                     alternativeClassName
-
-         -- Custom local definitions of join/pure/<*>
-       ; mapM_ tcAmpFunctionWarn [joinMName, apAName, pureAName]
-    }}
-
-
-
--- | Warn on local definitions of names that would clash with Prelude versions,
---   i.e. join/pure/<*>
---
---   A name clashes if the following criteria are met:
---       1. It would is imported (unqualified) from Prelude
---       2. It is locally defined in the current module
---       3. It has the same literal name as the reference function
---       4. It is not identical to the reference function
-tcAmpFunctionWarn :: Name -- ^ Name to check, e.g. joinMName for join
-                  -> TcM ()
-tcAmpFunctionWarn name = do
-    { traceTc "tcAmpFunctionWarn/wouldBeImported" empty
-    -- Is the name imported (unqualified) from Prelude? (Point 4 above)
-    ; rnImports <- fmap (map unLoc . tcg_rn_imports) getGblEnv
-    -- (Note that this automatically handles -XNoImplicitPrelude, as Prelude
-    -- will not appear in rnImports automatically if it is set.)
-
-    -- Continue only the name is imported from Prelude
-    ; when (tcAmpImportViaPrelude name rnImports) $ do
-      -- Handle 2.-4.
-    { rdrElts <- fmap (concat . occEnvElts . tcg_rdr_env) getGblEnv
-
-    ; let clashes :: GlobalRdrElt -> Bool
-          clashes x = and [ gre_prov x == LocalDef
-                          , nameOccName (gre_name x) == nameOccName name
-                          , gre_name x /= name
-                          ]
-
-          -- List of all offending definitions
-          clashingElts :: [GlobalRdrElt]
-          clashingElts = filter clashes rdrElts
-
-    ; traceTc "tcAmpFunctionWarn/amp_prelude_functions"
-                (hang (ppr name) 4 (sep [ppr clashingElts]))
-
-    ; let warn_msg x = addWarnAt (nameSrcSpan $ gre_name x) . hsep $
-              [ ptext (sLit "Local definition of")
-              , quotes . ppr . nameOccName $ gre_name x
-              , ptext (sLit "clashes with a future Prelude name")
-              , ptext (sLit "- this will become an error in GHC 7.10,")
-              , ptext (sLit "under the Applicative-Monad Proposal.")
-              ]
-    ; mapM_ warn_msg clashingElts
-    }}
-
--- | Is the given name imported via Prelude?
---
---   This function makes sure that e.g. "import Prelude (map)" should silence
---   AMP warnings about "join" even when they are locally defined.
---
---   Possible scenarios:
---     a) Prelude is imported implicitly, issue warnings.
---     b) Prelude is imported explicitly, but without mentioning the name in
---        question. Issue no warnings.
---     c) Prelude is imported hiding the name in question. Issue no warnings.
---     d) Qualified import of Prelude, no warnings.
-tcAmpImportViaPrelude :: Name
-                      -> [ImportDecl Name]
-                      -> Bool
-tcAmpImportViaPrelude name = any importViaPrelude
-  where
-    isPrelude :: ImportDecl Name -> Bool
-    isPrelude imp = unLoc (ideclName imp) == pRELUDE_NAME
-
-    -- Implicit (Prelude) import?
-    isImplicit :: ImportDecl Name -> Bool
-    isImplicit = ideclImplicit
-
-    -- Unqualified import?
-    isUnqualified :: ImportDecl Name -> Bool
-    isUnqualified = not . ideclQualified
-
-    second :: (a -> b) -> (x, a) -> (x, b)
-    second f (x, y) = (x, f y)
-
-    -- List of explicitly imported (or hidden) Names from a single import.
-    --   Nothing -> No explicit imports
-    --   Just (False, <names>) -> Explicit import list of <names>
-    --   Just (True , <names>) -> Explicit hiding of <names>
-    importList :: ImportDecl Name -> Maybe (Bool, [Name])
-    importList = fmap (second (map (ieName . unLoc))) . ideclHiding
-
-    -- Check whether the given name would be imported (unqualified) from
-    -- an import declaration.
-    importViaPrelude :: ImportDecl Name -> Bool
-    importViaPrelude x = isPrelude x && isUnqualified x && or [
-        -- Whole Prelude imported -> potential clash
-          isImplicit x
-        -- Explicit import/hiding list, if applicable
-        , case importList x of
-            Just (False, explicit) -> nameOccName name `elem`    map nameOccName explicit
-            Just (True , hidden  ) -> nameOccName name `notElem` map nameOccName hidden
-            Nothing                -> False
-        ]
-
--- | Issue a warning for instance definitions lacking a should-be parent class.
---   Used for Monad without Applicative and MonadPlus without Alternative.
-tcAmpMissingParentClassWarn :: Name -- ^ Class instance is defined for
-                            -> Name -- ^ Class it should also be instance of
-                            -> TcM ()
-
--- Notation: is* is for classes the type is an instance of, should* for those
---           that it should also be an instance of based on the corresponding
---           is*.
---           Example: in case of Applicative/Monad: is = Monad,
---                                                  should = Applicative
-tcAmpMissingParentClassWarn isName shouldName
-  = do { isClass'     <- tcLookupClass_maybe isName
-       ; shouldClass' <- tcLookupClass_maybe shouldName
-       ; case (isClass', shouldClass') of
-              (Just isClass, Just shouldClass) -> do
-                  { localInstances <- tcGetInsts
-                  ; let isInstance m = is_cls m == isClass
-                        isInsts = filter isInstance localInstances
-                  ; traceTc "tcAmpMissingParentClassWarn/isInsts" (ppr isInsts)
-                  ; forM_ isInsts $ checkShouldInst isClass shouldClass
-                  }
-              _ -> return ()
-       }
-  where
-    -- Checks whether the desired superclass exists in a given environment.
-    checkShouldInst :: Class   -- ^ Class of existing instance
-                    -> Class   -- ^ Class there should be an instance of
-                    -> ClsInst -- ^ Existing instance
-                    -> TcM ()
-    checkShouldInst isClass shouldClass isInst
-      = do { instEnv <- tcGetInstEnvs
-           ; let (instanceMatches, shouldInsts, _)
-                    = lookupInstEnv instEnv shouldClass (is_tys isInst)
-
-           ; traceTc "tcAmpMissingParentClassWarn/checkShouldInst"
-                     (hang (ppr isInst) 4
-                         (sep [ppr instanceMatches, ppr shouldInsts]))
-
-           -- "<location>: Warning: <type> is an instance of <is> but not <should>"
-           -- e.g. "Foo is an instance of Monad but not Applicative"
-           ; let instLoc = srcLocSpan . nameSrcLoc $ getName isInst
-                 warnMsg (Just name:_) =
-                      addWarnAt instLoc . hsep $
-                           [ quotes (ppr $ nameOccName name)
-                           , ptext (sLit "is an instance of")
-                           , ppr . nameOccName $ className isClass
-                           , ptext (sLit "but not")
-                           , ppr . nameOccName $ className shouldClass
-                           , ptext (sLit "- this will become an error in GHC 7.10,")
-                           , ptext (sLit "under the Applicative-Monad Proposal.")
-                           ]
-                 warnMsg _ = return ()
-           ; when (null shouldInsts && null instanceMatches) $
-                  warnMsg (is_tcs isInst)
-           }
-
-
--- | Looks up a class, returning Nothing on failure. Similar to
---   TcEnv.tcLookupClass, but does not issue any error messages.
---
--- In particular, it may be called by the AMP check on, say, 
--- Control.Applicative.Applicative, well before Control.Applicative 
--- has been compiled.  In this case we just return Nothing, and the
--- AMP test is silently dropped.
-tcLookupClass_maybe :: Name -> TcM (Maybe Class)
-tcLookupClass_maybe name
-  = do { mb_thing <- tcLookupImported_maybe name
-       ; case mb_thing of
-            Succeeded (ATyCon tc) | Just cls <- tyConClass_maybe tc -> return (Just cls)
-            _ -> return Nothing }
-\end{code}
-
-
 %************************************************************************
 %*                                                                      *
                 tcTopSrcDecls
@@ -1183,7 +880,6 @@ tcTopSrcDecls boot_details
 
                 -- Generate Applicative/Monad proposal (AMP) warnings
         traceTc "Tc3b" empty ;
-        tcAmpWarn ;
 
                 -- Foreign import declarations next.
         traceTc "Tc4" empty ;
@@ -1362,7 +1058,7 @@ check_main dflags tcg_env
         ; let { root_main_name =  mkExternalName rootMainKey rOOT_MAIN
                                    (mkVarOccFS (fsLit "main"))
                                    (getSrcSpan main_name)
-              ; root_main_id = Id.mkExportedLocalId root_main_name
+              ; root_main_id = Id.mkExportedLocalId VanillaId root_main_name
                                                     (mkTyConApp ioTyCon [res_ty])
               ; co  = mkWpTyApps [res_ty]
               ; rhs = nlHsApp (mkLHsWrap co (nlHsVar run_main_id)) main_expr
@@ -1370,7 +1066,7 @@ check_main dflags tcg_env
 
         ; return (tcg_env { tcg_main  = Just main_name,
                             tcg_binds = tcg_binds tcg_env
-                                        `snocBag` (Generated, main_bind),
+                                        `snocBag` main_bind,
                             tcg_dus   = tcg_dus tcg_env
                                         `plusDU` usesOnly (unitFV main_name)
                         -- Record the use of 'main', so that we don't
@@ -1605,14 +1301,14 @@ tcUserStmt (L loc (BodyStmt expr _ _ _))
         ; let fresh_it  = itName uniq loc
               matches   = [mkMatch [] rn_expr emptyLocalBinds]
               -- [it = expr]
-              the_bind  = L loc $ (mkTopFunBind (L loc fresh_it) matches) { bind_fvs = fvs }
+              the_bind  = L loc $ (mkTopFunBind FromSource (L loc fresh_it) matches) { bind_fvs = fvs }
                           -- Care here!  In GHCi the expression might have
                           -- free variables, and they in turn may have free type variables
                           -- (if we are at a breakpoint, say).  We must put those free vars
 
               -- [let it = expr]
               let_stmt  = L loc $ LetStmt $ HsValBinds $
-                          ValBindsOut [(NonRecursive,unitBag (FromSource, the_bind))] []
+                          ValBindsOut [(NonRecursive,unitBag the_bind)] []
 
               -- [it <- e]
               bind_stmt = L loc $ BindStmt (L loc (VarPat fresh_it))
@@ -2042,7 +1738,7 @@ loadUnqualIfaces hsc_env ictxt
                   , let name = gre_name gre
                   , not (isInternalName name)
                   , let mod = nameModule name
-                  , not (modulePackageId mod == this_pkg || isInteractiveModule mod)
+                  , not (modulePackageKey mod == this_pkg || isInteractiveModule mod)
                       -- Don't attempt to load an interface for stuff
                       -- from the command line, or from the home package
                   , isTcOcc (nameOccName name)   -- Types and classes only
@@ -2078,17 +1774,6 @@ tcDump env
         -- NB: foreign x-d's have undefined's in their types;
         --     hence can't show the tc_fords
 
-tcCoreDump :: ModGuts -> TcM ()
-tcCoreDump mod_guts
- = do { dflags <- getDynFlags ;
-        when (dopt Opt_D_dump_types dflags || dopt Opt_D_dump_tc dflags)
-             (dumpTcRn (pprModGuts mod_guts)) ;
-
-        -- Dump bindings if -ddump-tc
-        dumpOptTcRn Opt_D_dump_tc (mkDumpDoc "Typechecker" full_dump) }
-  where
-    full_dump = pprCoreBindings (mg_binds mod_guts)
-
 -- It's unpleasant having both pprModGuts and pprModDetails here
 pprTcGblEnv :: TcGblEnv -> SDoc
 pprTcGblEnv (TcGblEnv { tcg_type_env  = type_env,
@@ -2106,7 +1791,7 @@ pprTcGblEnv (TcGblEnv { tcg_type_env  = type_env,
          , ptext (sLit "Dependent modules:") <+>
                 ppr (sortBy cmp_mp $ eltsUFM (imp_dep_mods imports))
          , ptext (sLit "Dependent packages:") <+>
-                ppr (sortBy stablePackageIdCmp $ imp_dep_pkgs imports)]
+                ppr (sortBy stablePackageKeyCmp $ imp_dep_pkgs imports)]
   where         -- The two uses of sortBy are just to reduce unnecessary
                 -- wobbling in testsuite output
     cmp_mp (mod_name1, is_boot1) (mod_name2, is_boot2)
@@ -2114,12 +1799,6 @@ pprTcGblEnv (TcGblEnv { tcg_type_env  = type_env,
                   `thenCmp`
           (is_boot1 `compare` is_boot2)
 
-pprModGuts :: ModGuts -> SDoc
-pprModGuts (ModGuts { mg_tcs = tcs
-                    , mg_rules = rules })
-  = vcat [ ppr_types [] (mkTypeEnv (map ATyCon tcs)),
-           ppr_rules rules ]
-
 ppr_types :: [ClsInst] -> TypeEnv -> SDoc
 ppr_types insts type_env
   = text "TYPE SIGNATURES" $$ nest 2 (ppr_sigs ids)
@@ -2170,13 +1849,5 @@ ppr_tydecls tycons
         -- Print type constructor info; sort by OccName
   = vcat (map ppr_tycon (sortBy (comparing getOccName) tycons))
   where
-    ppr_tycon tycon = vcat [ ppr (tyConName tycon) <+> dcolon <+> ppr (tyConKind tycon)
-                              -- Temporarily print the kind signature too
-                           , ppr (tyThingToIfaceDecl (ATyCon tycon)) ]
-
-ppr_rules :: [CoreRule] -> SDoc
-ppr_rules [] = empty
-ppr_rules rs = vcat [ptext (sLit "{-# RULES"),
-                      nest 2 (pprRules rs),
-                      ptext (sLit "#-}")]
+    ppr_tycon tycon = vcat [ ppr (tyThingToIfaceDecl (ATyCon tycon)) ]
 \end{code}
diff --git a/compiler/typecheck/TcRnMonad.lhs b/compiler/typecheck/TcRnMonad.lhs
index b3d37f61780e..9dbc4206a551 100644
--- a/compiler/typecheck/TcRnMonad.lhs
+++ b/compiler/typecheck/TcRnMonad.lhs
@@ -5,7 +5,9 @@
 Functions for working with the typechecker environment (setters, getters...).
 
 \begin{code}
+{-# LANGUAGE CPP, ExplicitForAll, FlexibleInstances #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
+
 module TcRnMonad(
         module TcRnMonad,
         module TcRnTypes,
@@ -24,7 +26,6 @@ import Module
 import RdrName
 import Name
 import Type
-import Kind ( isSuperKind )
 
 import TcType
 import InstEnv
@@ -49,7 +50,7 @@ import FastString
 import Panic
 import Util
 import Annotations
-import BasicTypes( TopLevelFlag, Origin )
+import BasicTypes( TopLevelFlag )
 
 import Control.Exception
 import Data.IORef
@@ -588,11 +589,6 @@ addLocM fn (L loc a) = setSrcSpan loc $ fn a
 wrapLocM :: (a -> TcM b) -> Located a -> TcM (Located b)
 wrapLocM fn (L loc a) = setSrcSpan loc $ do b <- fn a; return (L loc b)
 
-wrapOriginLocM :: (a -> TcM r) -> (Origin, Located a) -> TcM (Origin, Located r)
-wrapOriginLocM fn (origin, lbind)
-  = do  { lbind' <- wrapLocM fn lbind
-        ; return (origin, lbind') }
-
 wrapLocFstM :: (a -> TcM (b,c)) -> Located a -> TcM (Located b, c)
 wrapLocFstM fn (L loc a) =
   setSrcSpan loc $ do
@@ -1136,10 +1132,6 @@ setUntouchables untch thing_inside
 
 isTouchableTcM :: TcTyVar -> TcM Bool
 isTouchableTcM tv
-    -- Kind variables are always touchable
-  | isSuperKind (tyVarKind tv) 
-  = return False
-  | otherwise 
   = do { env <- getLclEnv
        ; return (isTouchableMetaTyVar (tcl_untch env) tv) }
 
@@ -1213,9 +1205,10 @@ recordUnsafeInfer = getGblEnv >>= \env -> writeTcRef (tcg_safeInfer env) False
 finalSafeMode :: DynFlags -> TcGblEnv -> IO SafeHaskellMode
 finalSafeMode dflags tcg_env = do
     safeInf <- readIORef (tcg_safeInfer tcg_env)
-    return $ if safeInferOn dflags && not safeInf
-        then Sf_None
-        else safeHaskell dflags
+    return $ case safeHaskell dflags of
+        Sf_None | safeInferOn dflags && safeInf -> Sf_Safe
+                | otherwise                     -> Sf_None
+        s -> s
 \end{code}
 
 
@@ -1255,17 +1248,6 @@ initIfaceTcRn thing_inside
               ; get_type_env = readTcRef (tcg_type_env_var tcg_env) }
         ; setEnvs (if_env, ()) thing_inside }
 
-initIfaceExtCore :: IfL a -> TcRn a
-initIfaceExtCore thing_inside
-  = do  { tcg_env <- getGblEnv
-        ; let { mod = tcg_mod tcg_env
-              ; doc = ptext (sLit "External Core file for") <+> quotes (ppr mod)
-              ; if_env = IfGblEnv {
-                        if_rec_types = Just (mod, return (tcg_type_env tcg_env)) }
-              ; if_lenv = mkIfLclEnv mod doc
-          }
-        ; setEnvs (if_env, if_lenv) thing_inside }
-
 initIfaceCheck :: HscEnv -> IfG a -> IO a
 -- Used when checking the up-to-date-ness of the old Iface
 -- Initialise the environment with no useful info at all
diff --git a/compiler/typecheck/TcRnTypes.lhs b/compiler/typecheck/TcRnTypes.lhs
index 44dc3faa1e67..f46bdfd2d9b5 100644
--- a/compiler/typecheck/TcRnTypes.lhs
+++ b/compiler/typecheck/TcRnTypes.lhs
@@ -16,6 +16,8 @@ For state that is global and should be returned at the end (e.g not part
 of the stack mechanism), you should use an TcRef (= IORef) to store them.
 
 \begin{code}
+{-# LANGUAGE CPP #-}
+
 module TcRnTypes(
         TcRnIf, TcRn, TcM, RnM, IfM, IfL, IfG, -- The monad is opaque outside this module
         TcRef,
@@ -92,7 +94,7 @@ import Class    ( Class )
 import TyCon    ( TyCon )
 import ConLike  ( ConLike(..) )
 import DataCon  ( DataCon, dataConUserType, dataConOrigArgTys )
-import PatSyn   ( PatSyn, patSynId )
+import PatSyn   ( PatSyn, patSynType )
 import TcType
 import Annotations
 import InstEnv
@@ -294,7 +296,7 @@ data TcGblEnv
           -- ^ Allows us to choose unique DFun names.
 
         -- The next fields accumulate the payload of the module
-        -- The binds, rules and foreign-decl fiels are collected
+        -- The binds, rules and foreign-decl fields are collected
         -- initially in un-zonked form and are finally zonked in tcRnSrcDecls
 
         tcg_rn_exports :: Maybe [Located (IE Name)],
@@ -323,6 +325,9 @@ data TcGblEnv
 #endif /* GHCI */
 
         tcg_ev_binds  :: Bag EvBind,        -- Top-level evidence bindings
+
+        -- Things defined in this module, or (in GHCi) in the interactive package
+        --   For the latter, see Note [The interactive package] in HscTypes
         tcg_binds     :: LHsBinds Id,       -- Value bindings in this module
         tcg_sigs      :: NameSet,           -- ...Top-level names that *lack* a signature
         tcg_imp_specs :: [LTcSpecPrag],     -- ...SPECIALISE prags for imported Ids
@@ -804,17 +809,17 @@ data ImportAvails
           -- compiling M might not need to consult X.hi, but X
           -- is still listed in M's dependencies.
 
-        imp_dep_pkgs :: [PackageId],
+        imp_dep_pkgs :: [PackageKey],
           -- ^ Packages needed by the module being compiled, whether directly,
           -- or via other modules in this package, or via modules imported
           -- from other packages.
 
-        imp_trust_pkgs :: [PackageId],
+        imp_trust_pkgs :: [PackageKey],
           -- ^ This is strictly a subset of imp_dep_pkgs and records the
           -- packages the current module needs to trust for Safe Haskell
           -- compilation to succeed. A package is required to be trusted if
           -- we are dependent on a trustworthy module in that package.
-          -- While perhaps making imp_dep_pkgs a tuple of (PackageId, Bool)
+          -- While perhaps making imp_dep_pkgs a tuple of (PackageKey, Bool)
           -- where True for the bool indicates the package is required to be
           -- trusted is the more logical  design, doing so complicates a lot
           -- of code not concerned with Safe Haskell.
@@ -1282,6 +1287,8 @@ data Implication
 
       ic_fsks  :: [TcTyVar],     -- Extra flatten-skolems introduced by
                                  -- by flattening the givens
+                                 -- See Note [Given flatten-skolems]
+
       ic_no_eqs :: Bool,         -- True  <=> ic_givens have no equalities, for sure
                                  -- False <=> ic_givens might have equalities
 
@@ -1741,11 +1748,14 @@ pprSkolInfo ArrowSkol       = ptext (sLit "the arrow form")
 pprSkolInfo (PatSkol cl mc) = case cl of
     RealDataCon dc -> sep [ ptext (sLit "a pattern with constructor")
                           , nest 2 $ ppr dc <+> dcolon
-                            <+> ppr (dataConUserType dc) <> comma
+                            <+> pprType (dataConUserType dc) <> comma
+                            -- pprType prints forall's regardless of -fprint-explict-foralls
+                            -- which is what we want here, since we might be saying
+                            -- type variable 't' is bound by ...
                           , ptext (sLit "in") <+> pprMatchContext mc ]
     PatSynCon ps -> sep [ ptext (sLit "a pattern with pattern synonym")
                         , nest 2 $ ppr ps <+> dcolon
-                          <+> ppr (varType (patSynId ps)) <> comma
+                          <+> pprType (patSynType ps) <> comma
                         , ptext (sLit "in") <+> pprMatchContext mc ]
 pprSkolInfo (InferSkol ids) = sep [ ptext (sLit "the inferred type of")
                                   , vcat [ ppr name <+> dcolon <+> ppr ty
@@ -1850,9 +1860,9 @@ pprO (DerivOriginDC dc n)  = hsep [ ptext (sLit "the"), speakNth n,
                                     parens (ptext (sLit "type") <+> quotes (ppr ty)) ]
     where ty = dataConOrigArgTys dc !! (n-1)
 pprO (DerivOriginCoerce meth ty1 ty2)
-                           = fsep [ ptext (sLit "the coercion"), ptext (sLit "of the method")
-                                  , quotes (ppr meth), ptext (sLit "from type"), quotes (ppr ty1)
-                                  , ptext (sLit "to type"), quotes (ppr ty2) ]
+                           = sep [ ptext (sLit "the coercion of the method") <+> quotes (ppr meth)
+                                 , ptext (sLit "from type") <+> quotes (ppr ty1)
+                                 , nest 2 (ptext (sLit "to type") <+> quotes (ppr ty2)) ]
 pprO StandAloneDerivOrigin = ptext (sLit "a 'deriving' declaration")
 pprO DefaultOrigin         = ptext (sLit "a 'default' declaration")
 pprO DoOrigin              = ptext (sLit "a do statement")
diff --git a/compiler/typecheck/TcRules.lhs b/compiler/typecheck/TcRules.lhs
index c2f3b6b30237..47b38f114bcc 100644
--- a/compiler/typecheck/TcRules.lhs
+++ b/compiler/typecheck/TcRules.lhs
@@ -6,7 +6,7 @@
 TcRules: Typechecking transformation rules
 
 \begin{code}
-{-# OPTIONS -fno-warn-tabs #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
 -- The above warning supression flag is a temporary kludge.
 -- While working on this module you are encouraged to remove it and
 -- detab the module (please do the detabbing in a separate patch). See
diff --git a/compiler/typecheck/TcSMonad.lhs b/compiler/typecheck/TcSMonad.lhs
index 634e926a5ee9..9891f777950b 100644
--- a/compiler/typecheck/TcSMonad.lhs
+++ b/compiler/typecheck/TcSMonad.lhs
@@ -1,4 +1,6 @@
 \begin{code}
+{-# LANGUAGE CPP, TypeFamilies #-}
+
 -- Type definitions for the constraint solver
 module TcSMonad (
 
@@ -134,7 +136,7 @@ import TcRnTypes
 import BasicTypes
 import Unique
 import UniqFM
-import Maybes ( orElse, catMaybes, firstJust )
+import Maybes ( orElse, catMaybes, firstJusts )
 import Pair ( pSnd )
 
 import TrieMap
@@ -457,6 +459,7 @@ data InertSet
 
        , inert_fsks :: [TcTyVar]  -- Rigid flatten-skolems (arising from givens)
                                   -- allocated in this local scope
+                                  -- See Note [Given flatten-skolems]
 
        , inert_solved_funeqs :: FunEqMap (CtEvidence, TcType)
               -- See Note [Type family equations]
@@ -474,8 +477,29 @@ data InertSet
               -- - Stored not necessarily as fully rewritten
               --   (ToDo: rewrite lazily when we lookup)
        }
+\end{code}
 
+Note [Given flatten-skolems]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Suppose we simplify the implication
+    forall b. C (F a) b => (C (F a) beta, blah)
+We'll flatten the givens, introducing a flatten-skolem, so the
+givens effectively look like
+    (C fsk b, F a ~ fsk)
+Then we simplify the wanteds, transforming (C (F a) beta) to (C fsk beta).
+Now, if we don't solve that wanted, we'll put it back into the residual
+implication.  But where is fsk bound?
+
+We solve this by recording the given flatten-skolems in the implication
+(the ic_fsks field), so it's as if we change the implication to
+    forall b, fsk. (C fsk b, F a ~ fsk) => (C fsk beta, blah)
+
+We don't need to explicitly record the (F a ~ fsk) constraint in the implication
+because we can recover it from inside the fsk TyVar itself.  But we do need
+to treat that (F a ~ fsk) as a new given.  See the fsk_bag stuff in
+TcInteract.solveInteractGiven.
 
+\begin{code}
 instance Outputable InertCans where
   ppr ics = vcat [ ptext (sLit "Equalities:")
                    <+> vcat (map ppr (varEnvElts (inert_eqs ics)))
@@ -502,9 +526,9 @@ emptyInert
                          , inert_funeqs  = emptyFunEqs
                          , inert_irreds  = emptyCts
                          , inert_insols  = emptyCts
-                         , inert_no_eqs  = True
+                         , inert_no_eqs  = True  -- See Note [inert_fsks and inert_no_eqs]
                          }
-       , inert_fsks          = []
+       , inert_fsks          = []  -- See Note [inert_fsks and inert_no_eqs]
        , inert_flat_cache    = emptyFunEqs
        , inert_solved_funeqs = emptyFunEqs
        , inert_solved_dicts  = emptyDictMap }
@@ -517,10 +541,12 @@ addInertCan ics item@(CTyEqCan { cc_ev = ev })
                               (inert_eqs ics)
                               (cc_tyvar item) [item]
         , inert_no_eqs = isFlatSkolEv ev && inert_no_eqs ics }
+    -- See Note [When does an implication have given equalities?] in TcSimplify
 
 addInertCan ics item@(CFunEqCan { cc_fun = tc, cc_tyargs = tys, cc_ev = ev })
   = ics { inert_funeqs = addFunEq (inert_funeqs ics) tc tys item
         , inert_no_eqs = isFlatSkolEv ev && inert_no_eqs ics }
+    -- See Note [When does an implication have given equalities?] in TcSimplify
 
 addInertCan ics item@(CIrredEvCan {})
   = ics { inert_irreds = inert_irreds ics `Bag.snocBag` item
@@ -597,7 +623,7 @@ prepareInertsForImplications is
            , inert_irreds  = Bag.filterBag isGivenCt irreds
            , inert_dicts   = filterDicts isGivenCt dicts
            , inert_insols  = emptyCts
-           , inert_no_eqs  = True  -- Ready for each implication
+           , inert_no_eqs  = True  -- See Note [inert_fsks and inert_no_eqs]
            }
 
     is_given_eq :: [Ct] -> Bool
@@ -723,9 +749,9 @@ lookupFlatEqn fam_tc tys
   = do { IS { inert_solved_funeqs = solved_funeqs
             , inert_flat_cache = flat_cache
             , inert_cans = IC { inert_funeqs = inert_funeqs } } <- getTcSInerts
-       ; return (findFunEq solved_funeqs fam_tc tys  `firstJust`
-                 lookup_inerts inert_funeqs          `firstJust`
-                 findFunEq flat_cache fam_tc tys) }
+       ; return (firstJusts [findFunEq solved_funeqs fam_tc tys,
+                             lookup_inerts inert_funeqs,
+                             findFunEq flat_cache fam_tc tys]) }
   where
     lookup_inerts inert_funeqs
       | (ct:_) <- findFunEqs inert_funeqs fam_tc tys
@@ -1121,8 +1147,8 @@ nestImplicTcS ref inner_untch inerts (TcS thing_inside)
                                , tcs_ty_binds    = ty_binds
                                , tcs_count       = count
                                , tcs_inerts      = new_inert_var
-                               , tcs_worklist    = panic "nextImplicTcS: worklist"
-                               , tcs_implics     = panic "nextImplicTcS: implics"
+                               , tcs_worklist    = panic "nestImplicTcS: worklist"
+                               , tcs_implics     = panic "nestImplicTcS: implics"
                                -- NB: Both these are initialised by withWorkList
                                }
        ; res <- TcM.setUntouchables inner_untch $
@@ -1150,8 +1176,8 @@ nestTcS (TcS thing_inside)
     do { inerts <- TcM.readTcRef inerts_var
        ; new_inert_var <- TcM.newTcRef inerts
        ; let nest_env = env { tcs_inerts   = new_inert_var
-                            , tcs_worklist = panic "nextImplicTcS: worklist"
-                            , tcs_implics  = panic "nextImplicTcS: implics" }
+                            , tcs_worklist = panic "nestTcS: worklist"
+                            , tcs_implics  = panic "nestTcS: implics" }
        ; thing_inside nest_env }
 
 tryTcS :: TcS a -> TcS a
@@ -1169,8 +1195,8 @@ tryTcS (TcS thing_inside)
        ; let nest_env = env { tcs_ev_binds = ev_binds_var
                             , tcs_ty_binds = ty_binds_var
                             , tcs_inerts   = is_var
-                            , tcs_worklist = panic "nextImplicTcS: worklist"
-                            , tcs_implics  = panic "nextImplicTcS: implics" }
+                            , tcs_worklist = panic "tryTcS: worklist"
+                            , tcs_implics  = panic "tryTcS: implics" }
        ; thing_inside nest_env }
 
 -- Getters and setters of TcEnv fields
@@ -1253,19 +1279,35 @@ getUntouchables :: TcS Untouchables
 getUntouchables = wrapTcS TcM.getUntouchables
 
 getGivenInfo :: TcS a -> TcS (Bool, [TcTyVar], a)
--- Run thing_inside, returning info on
---  a) whether we got any new equalities
---  b) which new (given) flatten skolems were generated
+-- See Note [inert_fsks and inert_no_eqs]
 getGivenInfo thing_inside
-  = do { updInertTcS reset_vars
-       ; res <- thing_inside
-       ; is  <- getTcSInerts
+  = do { updInertTcS reset_vars  -- Set inert_fsks and inert_no_eqs to initial values
+       ; res <- thing_inside     -- Run thing_inside
+       ; is  <- getTcSInerts     -- Get new values of inert_fsks and inert_no_eqs
        ; return (inert_no_eqs (inert_cans is), inert_fsks is, res) }
   where
     reset_vars :: InertSet -> InertSet
     reset_vars is = is { inert_cans = (inert_cans is) { inert_no_eqs = True }
                        , inert_fsks = [] }
+\end{code}
+
+Note [inert_fsks and inert_no_eqs]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+The function getGivenInfo runs thing_inside to see what new flatten-skolems
+and equalities are generated by thing_inside.  To that end,
+ * it initialises inert_fsks, inert_no_eqs
+ * runs thing_inside
+ * reads out inert_fsks, inert_no_eqs
+This is the only place where it matters what inert_fsks and inert_no_eqs
+are initialised to.  In other places (eg emptyIntert), we need to set them
+to something (because they are strict) but they will never be looked at.
+
+See Note [When does an implication have given equalities?] in TcSimplify
+for more details about inert_no_eqs.
 
+See Note [Given flatten-skolems] for more details about inert_fsks.
+
+\begin{code}
 getTcSTyBinds :: TcS (IORef (Bool, TyVarEnv (TcTyVar, TcType)))
 getTcSTyBinds = TcS (return . tcs_ty_binds)
 
@@ -1350,7 +1392,7 @@ checkWellStagedDFun pred dfun_id loc
     bind_lvl = TcM.topIdLvl dfun_id
 
 pprEq :: TcType -> TcType -> SDoc
-pprEq ty1 ty2 = pprType $ mkEqPred ty1 ty2
+pprEq ty1 ty2 = pprParendType ty1 <+> char '~' <+> pprParendType ty2
 
 isTouchableMetaTyVarTcS :: TcTyVar -> TcS Bool
 isTouchableMetaTyVarTcS tv
@@ -1516,6 +1558,8 @@ data XEvTerm
   = XEvTerm { ev_preds  :: [PredType]           -- New predicate types
             , ev_comp   :: [EvTerm] -> EvTerm   -- How to compose evidence
             , ev_decomp :: EvTerm -> [EvTerm]   -- How to decompose evidence
+            -- In both ev_comp and ev_decomp, the [EvTerm] is 1-1 with ev_preds
+            -- and each EvTerm has type of the corresponding EvPred
             }
 
 data MaybeNew = Fresh CtEvidence | Cached EvTerm
@@ -1602,16 +1646,16 @@ Note [xCFlavor]
 ~~~~~~~~~~~~~~~
 A call might look like this:
 
-    xCtFlavor ev subgoal-preds evidence-transformer
+    xCtEvidence ev evidence-transformer
 
-  ev is Given   => use ev_decomp to create new Givens for subgoal-preds,
+  ev is Given   => use ev_decomp to create new Givens for ev_preds,
                    and return them
 
-  ev is Wanted  => create new wanteds for subgoal-preds,
+  ev is Wanted  => create new wanteds for ev_preds,
                    use ev_comp to bind ev,
                    return fresh wanteds (ie ones not cached in inert_cans or solved)
 
-  ev is Derived => create new deriveds for subgoal-preds
+  ev is Derived => create new deriveds for ev_preds
                       (unless cached in inert_cans or solved)
 
 Note: The [CtEvidence] returned is a subset of the subgoal-preds passed in
@@ -1638,14 +1682,10 @@ See Note [Coercion evidence terms] in TcEvidence.
 
 Note [Do not create Given kind equalities]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-We do not want to create a Given like
+We do not want to create a Given kind equality like
 
-     kv ~ k            -- kv is a skolem kind variable
-                       -- Reason we don't yet support non-Refl kind equalities
-
-or   t1::k1 ~ t2::k2   -- k1 and k2 are un-equal kinds
-                       -- Reason: (~) is kind-uniform at the moment, and
-                       -- k1/k2 may be distinct kind skolems
+   [G]  kv ~ k   -- kv is a skolem kind variable
+                 -- Reason we don't yet support non-Refl kind equalities
 
 This showed up in Trac #8566, where we had a data type
    data I (u :: U *) (r :: [*]) :: * where
@@ -1656,16 +1696,26 @@ so A has type
         (u ~ AA * k t as) => I u r
 
 There is no direct kind equality, but in a pattern match where 'u' is
-instantiated to, say, (AA * kk t1 as1), we'd decompose to get
+instantiated to, say, (AA * kk (t1:kk) as1), we'd decompose to get
    k ~ kk, t ~ t1, as ~ as1
-This is bad.  We "fix" this by simply ignoring
-  *     the Given kind equality
-  * AND the Given type equality (t:k1) ~ (t1:kk)
-
+This is bad.  We "fix" this by simply ignoring the Given kind equality
 But the Right Thing is to add kind equalities!
 
+But note (Trac #8705) that we *do* create Given (non-canonical) equalities
+with un-equal kinds, e.g.
+   [G]  t1::k1 ~ t2::k2   -- k1 and k2 are un-equal kinds
+Reason: k1 or k2 might be unification variables that have already been
+unified (at this point we have not canonicalised the types), so we want
+to emit this t1~t2 as a (non-canonical) Given in the work-list. If k1/k2 
+have been unified, we'll find that when we canonicalise it, and the 
+t1~t2 information may be crucial (Trac #8705 is an example).
+
+If it turns out that k1 and k2 are really un-equal, then it'll end up
+as an Irreducible (see Note [Equalities with incompatible kinds] in
+TcCanonical), and will do no harm.
+
 \begin{code}
-xCtEvidence :: CtEvidence            -- Original flavor
+xCtEvidence :: CtEvidence            -- Original evidence
             -> XEvTerm               -- Instructions about how to manipulate evidence
             -> TcS [CtEvidence]
 
@@ -1677,8 +1727,8 @@ xCtEvidence (CtGiven { ctev_evtm = tm, ctev_loc = loc })
   where
     -- See Note [Do not create Given kind equalities]
     bad_given_pred (pred_ty, _)
-      | EqPred t1 t2 <- classifyPredType pred_ty
-      = isKind t1 || not (typeKind t1 `tcEqKind` typeKind t2)
+      | EqPred t1 _ <- classifyPredType pred_ty
+      = isKind t1
       | otherwise
       = False
 
@@ -1718,7 +1768,18 @@ Main purpose: create new evidence for new_pred;
 
         Given           Already in inert               Nothing
                         Not                            Just new_evidence
--}
+
+Note [Rewriting with Refl]
+~~~~~~~~~~~~~~~~~~~~~~~~~~
+If the coercion is just reflexivity then you may re-use the same
+variable.  But be careful!  Although the coercion is Refl, new_pred
+may reflect the result of unification alpha := ty, so new_pred might
+not _look_ the same as old_pred, and it's vital to proceed from now on
+using new_pred.
+
+The flattener preserves type synonyms, so they should appear in new_pred
+as well as in old_pred; that is important for good error messages.
+ -}
 
 
 rewriteEvidence (CtDerived { ctev_loc = loc }) new_pred _co
@@ -1732,15 +1793,8 @@ rewriteEvidence (CtDerived { ctev_loc = loc }) new_pred _co
     newDerived loc new_pred
 
 rewriteEvidence old_ev new_pred co
-  | isTcReflCo co -- If just reflexivity then you may re-use the same variable
-  = return (Just (if ctEvPred old_ev `tcEqType` new_pred
-                  then old_ev
-                  else old_ev { ctev_pred = new_pred }))
-       -- Even if the coercion is Refl, it might reflect the result of unification alpha := ty
-       -- so old_pred and new_pred might not *look* the same, and it's vital to proceed from
-       -- now on using new_pred.
-       -- However, if they *do* look the same, we'd prefer to stick with old_pred
-       -- then retain the old type, so that error messages come out mentioning synonyms
+  | isTcReflCo co -- See Note [Rewriting with Refl]
+  = return (Just (old_ev { ctev_pred = new_pred }))
 
 rewriteEvidence (CtGiven { ctev_evtm = old_tm , ctev_loc = loc }) new_pred co
   = do { new_ev <- newGivenEvVar loc (new_pred, new_tm)  -- See Note [Bind new Givens immediately]
@@ -1780,15 +1834,12 @@ rewriteEqEvidence :: CtEvidence         -- Old evidence :: olhs ~ orhs (not swap
 -- It's all a form of rewwriteEvidence, specialised for equalities
 rewriteEqEvidence old_ev swapped nlhs nrhs lhs_co rhs_co
   | CtDerived { ctev_loc = loc } <- old_ev
-  = newDerived loc (mkEqPred nlhs nrhs)
+  = newDerived loc (mkTcEqPred nlhs nrhs)
 
   | NotSwapped <- swapped
-  , isTcReflCo lhs_co
+  , isTcReflCo lhs_co      -- See Note [Rewriting with Refl]
   , isTcReflCo rhs_co
-  , let new_pred = mkTcEqPred nlhs nrhs
-  = return (Just (if ctEvPred old_ev `tcEqType` new_pred
-                  then old_ev
-                  else old_ev { ctev_pred = new_pred }))
+  = return (Just (old_ev { ctev_pred = new_pred }))
 
   | CtGiven { ctev_evtm = old_tm , ctev_loc = loc } <- old_ev
   = do { let new_tm = EvCoercion (lhs_co 
@@ -1810,7 +1861,7 @@ rewriteEqEvidence old_ev swapped nlhs nrhs lhs_co rhs_co
   | otherwise
   = panic "rewriteEvidence"
   where
-    new_pred = mkEqPred nlhs nrhs
+    new_pred = mkTcEqPred nlhs nrhs
 
 maybeSym :: SwapFlag -> TcCoercion -> TcCoercion 
 maybeSym IsSwapped  co = mkTcSymCo co
diff --git a/compiler/typecheck/TcSimplify.lhs b/compiler/typecheck/TcSimplify.lhs
index 0fdd2ba3f5c5..dde5902ccc9c 100644
--- a/compiler/typecheck/TcSimplify.lhs
+++ b/compiler/typecheck/TcSimplify.lhs
@@ -1,4 +1,6 @@
 \begin{code}
+{-# LANGUAGE CPP #-}
+
 module TcSimplify(
        simplifyInfer, quantifyPred,
        simplifyAmbiguityCheck,
@@ -16,7 +18,7 @@ import TcMType as TcM
 import TcType
 import TcSMonad as TcS
 import TcInteract
-import Kind     ( defaultKind_maybe )
+import Kind     ( isKind, defaultKind_maybe )
 import Inst
 import FunDeps  ( growThetaTyVars )
 import Type     ( classifyPredType, PredTree(..), getClassPredTys_maybe )
@@ -95,10 +97,9 @@ simpl_top wanteds
 
     try_class_defaulting :: WantedConstraints -> TcS WantedConstraints
     try_class_defaulting wc
-      | isEmptyWC wc || insolubleWC wc
-      = return wc  -- Don't do type-class defaulting if there are insolubles
-                   -- Doing so is not going to solve the insolubles
-      | otherwise
+      | isEmptyWC wc  
+      = return wc
+      | otherwise  -- See Note [When to do type-class defaulting]
       = do { something_happened <- applyDefaultingRules (approximateWC wc)
                                    -- See Note [Top-level Defaulting Plan]
            ; if something_happened
@@ -107,6 +108,33 @@ simpl_top wanteds
              else return wc }
 \end{code}
 
+Note [When to do type-class defaulting]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+In GHC 7.6 and 7.8.2, we did type-class defaulting only if insolubleWC
+was false, on the grounds that defaulting can't help solve insoluble
+constraints.  But if we *don't* do defaulting we may report a whole
+lot of errors that would be solved by defaulting; these errors are
+quite spurious because fixing the single insoluble error means that
+defaulting happens again, which makes all the other errors go away.
+This is jolly confusing: Trac #9033.
+
+So it seems better to always do type-class defaulting.
+
+However, always doing defaulting does mean that we'll do it in
+situations like this (Trac #5934):
+   run :: (forall s. GenST s) -> Int
+   run = fromInteger 0 
+We don't unify the return type of fromInteger with the given function
+type, because the latter involves foralls.  So we're left with
+    (Num alpha, alpha ~ (forall s. GenST s) -> Int)
+Now we do defaulting, get alpha := Integer, and report that we can't 
+match Integer with (forall s. GenST s) -> Int.  That's not totally 
+stupid, but perhaps a little strange.
+
+Another potential alternative would be to suppress *all* non-insoluble
+errors if there are *any* insoluble errors, anywhere, but that seems
+too drastic.
+
 Note [Must simplify after defaulting]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 We may have a deeply buried constraint
@@ -253,39 +281,50 @@ simplifyInfer _top_lvl apply_mr name_taus wanteds
        ; ev_binds_var <- newTcEvBinds
        ; wanted_transformed_incl_derivs
                <- solveWantedsTcMWithEvBinds ev_binds_var wanteds solve_wanteds
-                               -- Post: wanted_transformed are zonked
+                  -- Post: wanted_transformed_incl_derivs are zonked
 
               -- Step 4) Candidates for quantification are an approximation of wanted_transformed
               -- NB: Already the fixpoint of any unifications that may have happened
               -- NB: We do not do any defaulting when inferring a type, this can lead
               -- to less polymorphic types, see Note [Default while Inferring]
 
-              -- Step 5) Minimize the quantification candidates
-              -- Step 6) Final candidates for quantification
-              -- We discard bindings, insolubles etc, because all we are
-              -- care aout it
-
        ; tc_lcl_env <- TcRnMonad.getLclEnv
        ; let untch = tcl_untch tc_lcl_env
              wanted_transformed = dropDerivedWC wanted_transformed_incl_derivs
        ; quant_pred_candidates   -- Fully zonked
            <- if insolubleWC wanted_transformed_incl_derivs
               then return []   -- See Note [Quantification with errors]
-                               -- NB: must include derived errors
-              else do { gbl_tvs <- tcGetGlobalTyVars
-                      ; let quant_cand = approximateWC wanted_transformed
+                               -- NB: must include derived errors in this test, 
+                               --     hence "incl_derivs"
+
+              else do { let quant_cand = approximateWC wanted_transformed
                             meta_tvs   = filter isMetaTyVar (varSetElems (tyVarsOfCts quant_cand))
-                      ; ((flats, _insols), _extra_binds) <- runTcS $
+                      ; gbl_tvs <- tcGetGlobalTyVars
+                      ; null_ev_binds_var <- newTcEvBinds
+                            -- Miminise quant_cand.  We are not interested in any evidence
+                            -- produced, because we are going to simplify wanted_transformed
+                            -- again later. All we want here is the predicates over which to
+                            -- quantify.  
+                            --
+                            -- If any meta-tyvar unifications take place (unlikely), we'll
+                            -- pick that up later.
+
+                      ; (flats, _insols) <- runTcSWithEvBinds null_ev_binds_var $
                         do { mapM_ (promoteAndDefaultTyVar untch gbl_tvs) meta_tvs
                                  -- See Note [Promote _and_ default when inferring]
                            ; _implics <- solveInteract quant_cand
                            ; getInertUnsolved }
-                      ; return (map ctPred $ filter isWantedCt (bagToList flats)) }
-                   -- NB: Dimitrios is slightly worried that we will get
-                   -- family equalities (F Int ~ alpha) in the quantification
-                   -- candidates, as we have performed no further unflattening
-                   -- at this point. Nothing bad, but inferred contexts might
-                   -- look complicated.
+
+                      ; flats' <- zonkFlats null_ev_binds_var untch $
+                                  filterBag isWantedCt flats
+                           -- The quant_cand were already fully zonked, so this zonkFlats
+                           -- really only unflattens the flattening that solveInteract
+                           -- may have done (Trac #8889).  
+                           -- E.g. quant_cand = F a, where F :: * -> Constraint
+                           --      We'll flatten to   (alpha, F a ~ alpha)
+                           -- fail to make any further progress and must unflatten again 
+
+                      ; return (map ctPred $ bagToList flats') }
 
        -- NB: quant_pred_candidates is already the fixpoint of any
        --     unifications that may have happened
@@ -326,6 +365,7 @@ simplifyInfer _top_lvl apply_mr name_taus wanteds
 
       {     -- Step 7) Emit an implication
          let minimal_flat_preds = mkMinimalBySCs bound
+                  -- See Note [Minimize by Superclasses]
              skol_info = InferSkol [ (name, mkSigmaTy [] minimal_flat_preds ty)
                                    | (name, ty) <- name_taus ]
                         -- Don't add the quantified variables here, because
@@ -481,11 +521,11 @@ This only half-works, but then let-generalisation only half-works.
 *                                                                                 *
 ***********************************************************************************
 
-See note [Simplifying RULE consraints] in TcRule
+See note [Simplifying RULE constraints] in TcRule
 
-Note [RULE quanfification over equalities]
+Note [RULE quantification over equalities]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Decideing which equalities to quantify over is tricky:
+Deciding which equalities to quantify over is tricky:
  * We do not want to quantify over insoluble equalities (Int ~ Bool)
     (a) because we prefer to report a LHS type error
     (b) because if such things end up in 'givens' we get a bogus
@@ -803,39 +843,6 @@ Consider floated_eqs (all wanted or derived):
     simpl_loop.  So we iterate if there any of these
 
 \begin{code}
-floatEqualities :: [TcTyVar] -> Bool -> WantedConstraints
-                -> TcS (Cts, WantedConstraints)
--- Post: The returned floated constraints (Cts) are only Wanted or Derived
--- and come from the input wanted ev vars or deriveds
--- Also performs some unifications, adding to monadically-carried ty_binds
--- These will be used when processing floated_eqs later
-floatEqualities skols no_given_eqs wanteds@(WC { wc_flat = flats })
-  | not no_given_eqs  -- There are some given equalities, so don't float
-  = return (emptyBag, wanteds)   -- Note [Float Equalities out of Implications]
-  | otherwise
-  = do { let (float_eqs, remaining_flats) = partitionBag is_floatable flats
-       ; untch <- TcS.getUntouchables
-       ; mapM_ (promoteTyVar untch) (varSetElems (tyVarsOfCts float_eqs))
-             -- See Note [Promoting unification variables]
-       ; ty_binds <- getTcSTyBindsMap
-       ; traceTcS "floatEqualities" (vcat [ text "Flats =" <+> ppr flats
-                                          , text "Floated eqs =" <+> ppr float_eqs
-                                          , text "Ty binds =" <+> ppr ty_binds])
-       ; return (float_eqs, wanteds { wc_flat = remaining_flats }) }
-  where
-      -- See Note [Float equalities from under a skolem binding]
-    skol_set = fixVarSet mk_next (mkVarSet skols)
-    mk_next tvs = foldrBag grow_one tvs flats
-    grow_one (CFunEqCan { cc_tyargs = xis, cc_rhs = rhs }) tvs
-       | intersectsVarSet tvs (tyVarsOfTypes xis)
-       = tvs `unionVarSet` tyVarsOfType rhs
-    grow_one _ tvs = tvs
-
-    is_floatable :: Ct -> Bool
-    is_floatable ct = isEqPred pred && skol_set `disjointVarSet` tyVarsOfType pred
-       where
-         pred = ctPred ct
-
 promoteTyVar :: Untouchables -> TcTyVar  -> TcS ()
 -- When we float a constraint out of an implication we must restore
 -- invariant (MetaTvInv) in Note [Untouchable type variables] in TcType
@@ -996,6 +1003,80 @@ should!  If we don't solve the constraint, we'll stupidly quantify over
 (b:*) instead of (a:OpenKind), which can lead to disaster; see Trac #7332.
 Trac #7641 is a simpler example.
 
+Note [Promoting unification variables]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+When we float an equality out of an implication we must "promote" free
+unification variables of the equality, in order to maintain Invariant
+(MetaTvInv) from Note [Untouchable type variables] in TcType.  for the
+leftover implication.
+
+This is absolutely necessary. Consider the following example. We start
+with two implications and a class with a functional dependency.
+
+    class C x y | x -> y
+    instance C [a] [a]
+
+    (I1)      [untch=beta]forall b. 0 => F Int ~ [beta]
+    (I2)      [untch=beta]forall c. 0 => F Int ~ [[alpha]] /\ C beta [c]
+
+We float (F Int ~ [beta]) out of I1, and we float (F Int ~ [[alpha]]) out of I2.
+They may react to yield that (beta := [alpha]) which can then be pushed inwards
+the leftover of I2 to get (C [alpha] [a]) which, using the FunDep, will mean that
+(alpha := a). In the end we will have the skolem 'b' escaping in the untouchable
+beta! Concrete example is in indexed_types/should_fail/ExtraTcsUntch.hs:
+
+    class C x y | x -> y where
+     op :: x -> y -> ()
+
+    instance C [a] [a]
+
+    type family F a :: *
+
+    h :: F Int -> ()
+    h = undefined
+
+    data TEx where
+      TEx :: a -> TEx
+
+
+    f (x::beta) =
+        let g1 :: forall b. b -> ()
+            g1 _ = h [x]
+            g2 z = case z of TEx y -> (h [[undefined]], op x [y])
+        in (g1 '3', g2 undefined)
+
+
+
+Note [Solving Family Equations]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+After we are done with simplification we may be left with constraints of the form:
+     [Wanted] F xis ~ beta
+If 'beta' is a touchable unification variable not already bound in the TyBinds
+then we'd like to create a binding for it, effectively "defaulting" it to be 'F xis'.
+
+When is it ok to do so?
+    1) 'beta' must not already be defaulted to something. Example:
+
+           [Wanted] F Int  ~ beta   <~ Will default [beta := F Int]
+           [Wanted] F Char ~ beta   <~ Already defaulted, can't default again. We
+                                       have to report this as unsolved.
+
+    2) However, we must still do an occurs check when defaulting (F xis ~ beta), to
+       set [beta := F xis] only if beta is not among the free variables of xis.
+
+    3) Notice that 'beta' can't be bound in ty binds already because we rewrite RHS
+       of type family equations. See Inert Set invariants in TcInteract.
+
+This solving is now happening during zonking, see Note [Unflattening while zonking]
+in TcMType.
+
+
+*********************************************************************************
+*                                                                               *
+*                          Floating equalities                                  *
+*                                                                               *
+*********************************************************************************
+
 Note [Float Equalities out of Implications]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 For ordinary pattern matches (including existentials) we float
@@ -1041,8 +1122,59 @@ Consequence: classes with functional dependencies don't matter (since there is
 no evidence for a fundep equality), but equality superclasses do matter (since
 they carry evidence).
 
+\begin{code}
+floatEqualities :: [TcTyVar] -> Bool -> WantedConstraints
+                -> TcS (Cts, WantedConstraints)
+-- Main idea: see Note [Float Equalities out of Implications]
+--
+-- Post: The returned floated constraints (Cts) are only Wanted or Derived
+-- and come from the input wanted ev vars or deriveds
+-- Also performs some unifications (via promoteTyVar), adding to
+-- monadically-carried ty_binds. These will be used when processing 
+-- floated_eqs later
+--
+-- Subtleties: Note [Float equalities from under a skolem binding]
+--             Note [Skolem escape]
+floatEqualities skols no_given_eqs wanteds@(WC { wc_flat = flats })
+  | not no_given_eqs  -- There are some given equalities, so don't float
+  = return (emptyBag, wanteds)   -- Note [Float Equalities out of Implications]
+  | otherwise
+  = do { let (float_eqs, remaining_flats) = partitionBag is_floatable flats
+       ; untch <- TcS.getUntouchables
+       ; mapM_ (promoteTyVar untch) (varSetElems (tyVarsOfCts float_eqs))
+             -- See Note [Promoting unification variables]
+       ; ty_binds <- getTcSTyBindsMap
+       ; traceTcS "floatEqualities" (vcat [ text "Skols =" <+> ppr skols
+                                          , text "Flats =" <+> ppr flats
+                                          , text "Skol set =" <+> ppr skol_set
+                                          , text "Floated eqs =" <+> ppr float_eqs
+                                          , text "Ty binds =" <+> ppr ty_binds])
+       ; return (float_eqs, wanteds { wc_flat = remaining_flats }) }
+  where
+    is_floatable :: Ct -> Bool
+    is_floatable ct
+       = case classifyPredType (ctPred ct) of
+            EqPred ty1 ty2 -> skol_set `disjointVarSet` tyVarsOfType ty1
+                           && skol_set `disjointVarSet` tyVarsOfType ty2
+            _ -> False
+
+    skol_set = fixVarSet mk_next (mkVarSet skols)
+    mk_next tvs = foldr grow_one tvs flat_eqs
+    flat_eqs :: [(TcTyVarSet, TcTyVarSet)]
+    flat_eqs = [ (tyVarsOfType ty1, tyVarsOfType ty2)
+               | EqPred ty1 ty2 <- map (classifyPredType . ctPred) (bagToList flats)]
+    grow_one (tvs1,tvs2) tvs
+      | intersectsVarSet tvs tvs1 = tvs `unionVarSet` tvs2
+      | intersectsVarSet tvs tvs2 = tvs `unionVarSet` tvs2
+      | otherwise                 = tvs
+\end{code}
+
 Note [When does an implication have given equalities?]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+     NB: This note is mainly referred to from TcSMonad
+         but it relates to floating equalities, so I've
+         left it here
+
 Consider an implication
    beta => alpha ~ Int
 where beta is a unification variable that has already been unified
@@ -1084,118 +1216,97 @@ An alternative we considered was to
     equalities mentions any of the ic_givens of this implication.
 This seems like the Right Thing, but it's more code, and more work
 at runtime, so we are using the FlatSkolOrigin idea intead. It's less
-obvious that it works, but I htink it does, and it's simple and efficient.
-
+obvious that it works, but I think it does, and it's simple and efficient.
 
 Note [Float equalities from under a skolem binding]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-You might worry about skolem escape with all this floating.
-For example, consider
-    [2] forall a. (a ~ F beta[2] delta,
-                   Maybe beta[2] ~ gamma[1])
-
-The (Maybe beta ~ gamma) doesn't mention 'a', so we float it, and
-solve with gamma := beta. But what if later delta:=Int, and
-  F b Int = b.
-Then we'd get a ~ beta[2], and solve to get beta:=a, and now the
-skolem has escaped!
-
-But it's ok: when we float (Maybe beta[2] ~ gamma[1]), we promote beta[2]
-to beta[1], and that means the (a ~ beta[1]) will be stuck, as it should be.
-
-Previously we tried to "grow" the skol_set with the constraints, to get
-all the tyvars that could *conceivably* unify with the skolems, but that
-was far too conservative (Trac #7804). Example: this should be fine:
-    f :: (forall a. a -> Proxy x -> Proxy (F x)) -> Int
-    f = error "Urk" :: (forall a. a -> Proxy x -> Proxy (F x)) -> Int
-
-BUT (sigh) we have to be careful.  Here are some edge cases:
+Which of the flat equalities can we float out?  Obviously, only
+ones that don't mention the skolem-bound variables.  But that is
+over-eager. Consider
+   [2] forall a. F a beta[1] ~ gamma[2], G beta[1] gamma[2] ~ Int
+The second constraint doesn't mention 'a'.  But if we float it
+we'll promote gamma to gamma'[1].  Now suppose that we learn that
+beta := Bool, and F a Bool = a, and G Bool _ = Int.  Then we'll
+we left with the constraint
+   [2] forall a. a ~ gamma'[1]
+which is insoluble because gamma became untouchable.
+
+Solution: only promote a constraint if its free variables cannot
+possibly be connected with the skolems.  Procedurally, start with
+the skolems and "grow" that set as follows:
+  * For each flat equality F ts ~ s, or tv ~ s,
+    if the current set intersects with the LHS of the equality,
+       add the free vars of the RHS, and vice versa
+That gives us a grown skolem set.  Now float an equality if its free
+vars don't intersect the grown skolem set.
+
+This seems very ad hoc (sigh).  But here are some tricky edge cases:
 
 a)    [2]forall a. (F a delta[1] ~ beta[2],   delta[1] ~ Maybe beta[2])
-b)    [2]forall a. (F b ty ~ beta[2],         G beta[2] ~ gamma[2])
+b1)   [2]forall a. (F a ty ~ beta[2],         G beta[2] ~ gamma[2])
+b2)   [2]forall a. (a ~ beta[2],              G beta[2] ~ gamma[2])
 c)    [2]forall a. (F a ty ~ beta[2],         delta[1] ~ Maybe beta[2])
+d)    [2]forall a. (gamma[1] ~ Tree beta[2],  F ty ~ beta[2])
 
 In (a) we *must* float out the second equality,
        else we can't solve at all (Trac #7804).
 
-In (b) we *must not* float out the second equality.
-       It will ultimately be solved (by flattening) in situ, but if we
-       float it we'll promote beta,gamma, and render the first equality insoluble.
+In (b1, b2) we *must not* float out the second equality.
+       It will ultimately be solved (by flattening) in situ, but if we float
+       it we'll promote beta,gamma, and render the first equality insoluble.
+
+       Trac #9316 was an example of (b2).  You may wonder why (a ~ beta[2]) isn't
+       solved; in #9316 it wasn't solved because (a:*) and (beta:kappa[1]), so the
+       equality was kind-mismatched, and hence was a CIrredEvCan.  There was
+       another equality alongside, (kappa[1] ~ *).  We must first float *that*
+       one out and *then* we can solve (a ~ beta).
 
 In (c) it would be OK to float the second equality but better not to.
        If we flatten we see (delta[1] ~ Maybe (F a ty)), which is a
-       skolem-escape problem.  If we float the secodn equality we'll
+       skolem-escape problem.  If we float the second equality we'll
        end up with (F a ty ~ beta'[1]), which is a less explicable error.
 
-Hence we start with the skolems, grow them by the CFunEqCans, and
-float ones that don't mention the grown variables.  Seems very ad hoc.
-
-Note [Promoting unification variables]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-When we float an equality out of an implication we must "promote" free
-unification variables of the equality, in order to maintain Invariant
-(MetaTvInv) from Note [Untouchable type variables] in TcType.  for the
-leftover implication.
-
-This is absolutely necessary. Consider the following example. We start
-with two implications and a class with a functional dependency.
-
-    class C x y | x -> y
-    instance C [a] [a]
-
-    (I1)      [untch=beta]forall b. 0 => F Int ~ [beta]
-    (I2)      [untch=beta]forall c. 0 => F Int ~ [[alpha]] /\ C beta [c]
-
-We float (F Int ~ [beta]) out of I1, and we float (F Int ~ [[alpha]]) out of I2.
-They may react to yield that (beta := [alpha]) which can then be pushed inwards
-the leftover of I2 to get (C [alpha] [a]) which, using the FunDep, will mean that
-(alpha := a). In the end we will have the skolem 'b' escaping in the untouchable
-beta! Concrete example is in indexed_types/should_fail/ExtraTcsUntch.hs:
-
-    class C x y | x -> y where
-     op :: x -> y -> ()
-
-    instance C [a] [a]
+In (d) we must float the first equality, so that we can unify gamma.
+       But that promotes beta, so we must float the second equality too,
+       Trac #7196 exhibits this case
 
-    type family F a :: *
+Some notes
 
-    h :: F Int -> ()
-    h = undefined
+* When "growing", do not simply take the free vars of the predicate!
+  Example    [2]forall a.  (a:* ~ beta[2]:kappa[1]), (kappa[1] ~ *)
+  We must float the second, and we must not float the first.
+  But the first actually looks like ((~) kappa a beta), so if we just
+  look at its free variables we'll see {a,kappa,beta), and that might
+  make us think kappa should be in the grown skol set.
 
-    data TEx where
-      TEx :: a -> TEx
+  (In any case, the kind argument for a kind-mis-matched equality like
+   this one doesn't really make sense anyway.)
 
+  That's why we use classifyPred when growing.
 
-    f (x::beta) =
-        let g1 :: forall b. b -> ()
-            g1 _ = h [x]
-            g2 z = case z of TEx y -> (h [[undefined]], op x [y])
-        in (g1 '3', g2 undefined)
-
-
-
-Note [Solving Family Equations]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-After we are done with simplification we may be left with constraints of the form:
-     [Wanted] F xis ~ beta
-If 'beta' is a touchable unification variable not already bound in the TyBinds
-then we'd like to create a binding for it, effectively "defaulting" it to be 'F xis'.
-
-When is it ok to do so?
-    1) 'beta' must not already be defaulted to something. Example:
+* Previously we tried to "grow" the skol_set with *all* the
+  constraints (not just equalities), to get all the tyvars that could
+  *conceivably* unify with the skolems, but that was far too
+  conservative (Trac #7804). Example: this should be fine:
+    f :: (forall a. a -> Proxy x -> Proxy (F x)) -> Int
+    f = error "Urk" :: (forall a. a -> Proxy x -> Proxy (F x)) -> Int
 
-           [Wanted] F Int  ~ beta   <~ Will default [beta := F Int]
-           [Wanted] F Char ~ beta   <~ Already defaulted, can't default again. We
-                                       have to report this as unsolved.
 
-    2) However, we must still do an occurs check when defaulting (F xis ~ beta), to
-       set [beta := F xis] only if beta is not among the free variables of xis.
+Note [Skolem escape]
+~~~~~~~~~~~~~~~~~~~~
+You might worry about skolem escape with all this floating.
+For example, consider
+    [2] forall a. (a ~ F beta[2] delta,
+                   Maybe beta[2] ~ gamma[1])
 
-    3) Notice that 'beta' can't be bound in ty binds already because we rewrite RHS
-       of type family equations. See Inert Set invariants in TcInteract.
+The (Maybe beta ~ gamma) doesn't mention 'a', so we float it, and
+solve with gamma := beta. But what if later delta:=Int, and
+  F b Int = b.
+Then we'd get a ~ beta[2], and solve to get beta:=a, and now the
+skolem has escaped!
 
-This solving is now happening during zonking, see Note [Unflattening while zonking]
-in TcMType.
+But it's ok: when we float (Maybe beta[2] ~ gamma[1]), we promote beta[2]
+to beta[1], and that means the (a ~ beta[1]) will be stuck, as it should be.
 
 
 *********************************************************************************
@@ -1237,16 +1348,22 @@ findDefaultableGroups
     -> Cts              -- Unsolved (wanted or derived)
     -> [[(Ct,Class,TcTyVar)]]
 findDefaultableGroups (default_tys, (ovl_strings, extended_defaults)) wanteds
-  | null default_tys             = []
-  | otherwise = filter is_defaultable_group (equivClasses cmp_tv unaries)
+  | null default_tys = []
+  | otherwise        = defaultable_groups
   where
+    defaultable_groups = filter is_defaultable_group groups
+    groups             = equivClasses cmp_tv unaries
     unaries     :: [(Ct, Class, TcTyVar)]  -- (C tv) constraints
     non_unaries :: [Ct]             -- and *other* constraints
 
     (unaries, non_unaries) = partitionWith find_unary (bagToList wanteds)
         -- Finds unary type-class constraints
+        -- But take account of polykinded classes like Typeable,
+        -- which may look like (Typeable * (a:*))   (Trac #8931)
     find_unary cc
-        | Just (cls,[ty]) <- getClassPredTys_maybe (ctPred cc)
+        | Just (cls,tys)   <- getClassPredTys_maybe (ctPred cc)
+        , Just (kinds, ty) <- snocView tys
+        , all isKind kinds
         , Just tv <- tcGetTyVar_maybe ty
         , isMetaTyVar tv  -- We might have runtime-skolems in GHCi, and
                           -- we definitely don't want to try to assign to those!
diff --git a/compiler/typecheck/TcSplice.lhs b/compiler/typecheck/TcSplice.lhs
index b7e26997c6d3..bb6af8cb95c2 100644
--- a/compiler/typecheck/TcSplice.lhs
+++ b/compiler/typecheck/TcSplice.lhs
@@ -7,8 +7,9 @@ TcSplice: Template Haskell splices
 
 
 \begin{code}
-{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE CPP, FlexibleInstances, MagicHash, ScopedTypeVariables #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
+
 module TcSplice(
      -- These functions are defined in stage1 and stage2
      -- The raise civilised errors in stage1
@@ -70,6 +71,7 @@ import Class
 import Inst
 import TyCon
 import CoAxiom
+import PatSyn ( patSynName )
 import ConLike
 import DataCon
 import TcEvidence( TcEvBinds(..) )
@@ -342,7 +344,7 @@ tcTypedBracket brack@(TExpBr expr) res_ty
        -- Throw away the typechecked expression but return its type.
        -- We'll typecheck it again when we splice it in somewhere
        ; (_tc_expr, expr_ty) <- setStage (Brack cur_stage (TcPending ps_ref lie_var)) $
-                                tcInferRhoNC expr 
+                                tcInferRhoNC expr
                                 -- NC for no context; tcBracket does that
 
        ; meta_ty <- tcTExpTy expr_ty
@@ -844,6 +846,12 @@ like that.  Here's how it's processed:
     (qReport True s) by using addErr to add an error message to the bag of errors.
     The 'fail' in TcM raises an IOEnvFailure exception
 
+ * 'qReport' forces the message to ensure any exception hidden in unevaluated
+   thunk doesn't get into the bag of errors. Otherwise the following splice
+   will triger panic (Trac #8987):
+        $(fail undefined)
+   See also Note [Concealed TH exceptions]
+
   * So, when running a splice, we catch all exceptions; then for
         - an IOEnvFailure exception, we assume the error is already
                 in the error-bag (above)
@@ -874,8 +882,10 @@ instance TH.Quasi (IOEnv (Env TcGblEnv TcLclEnv)) where
                   ; let i = getKey u
                   ; return (TH.mkNameU s i) }
 
-  qReport True msg  = addErr  (text msg)
-  qReport False msg = addWarn (text msg)
+  -- 'msg' is forced to ensure exceptions don't escape,
+  -- see Note [Exceptions in TH]
+  qReport True msg  = seqList msg $ addErr  (text msg)
+  qReport False msg = seqList msg $ addWarn (text msg)
 
   qLocation = do { m <- getModule
                  ; l <- getSrcSpanM
@@ -885,7 +895,7 @@ instance TH.Quasi (IOEnv (Env TcGblEnv TcLclEnv)) where
                         RealSrcSpan s -> return s
                  ; return (TH.Loc { TH.loc_filename = unpackFS (srcSpanFile r)
                                   , TH.loc_module   = moduleNameString (moduleName m)
-                                  , TH.loc_package  = packageIdString (modulePackageId m)
+                                  , TH.loc_package  = packageKeyString (modulePackageKey m)
                                   , TH.loc_start = (srcSpanStartLine r, srcSpanStartCol r)
                                   , TH.loc_end = (srcSpanEndLine   r, srcSpanEndCol   r) }) }
 
@@ -1015,7 +1025,7 @@ reifyInstances th_nm th_tys
                      ; let matches = lookupFamInstEnv inst_envs tc tys
                      ; traceTc "reifyInstances2" (ppr matches)
                      ; mapM (reifyFamilyInstance . fim_instance) matches }
-            _  -> bale_out (hang (ptext (sLit "reifyInstances:") <+> quotes (ppr ty)) 
+            _  -> bale_out (hang (ptext (sLit "reifyInstances:") <+> quotes (ppr ty))
                                2 (ptext (sLit "is not a class constraint or type family application"))) }
   where
     doc = ClassInstanceCtx
@@ -1173,6 +1183,8 @@ reifyThing (AGlobal (AConLike (RealDataCon dc)))
         ; return (TH.DataConI (reifyName name) ty
                               (reifyName (dataConOrigTyCon dc)) fix)
         }
+reifyThing (AGlobal (AConLike (PatSynCon ps)))
+  = noTH (sLit "pattern synonyms") (ppr $ patSynName ps)
 
 reifyThing (ATcId {tct_id = id})
   = do  { ty1 <- zonkTcType (idType id) -- Make use of all the info we have, even
@@ -1191,7 +1203,8 @@ reifyThing thing = pprPanic "reifyThing" (pprTcTyThingCategory thing)
 -------------------------------------------
 reifyAxBranch :: CoAxBranch -> TcM TH.TySynEqn
 reifyAxBranch (CoAxBranch { cab_lhs = args, cab_rhs = rhs })
-  = do { args' <- mapM reifyType args
+            -- remove kind patterns (#8884)
+  = do { args' <- mapM reifyType (filter (not . isKind) args)
        ; rhs'  <- reifyType rhs
        ; return (TH.TySynEqn args' rhs') }
 
@@ -1207,10 +1220,15 @@ reifyTyCon tc
   = return (TH.PrimTyConI (reifyName tc) (tyConArity tc) (isUnLiftedTyCon tc))
 
   | isFamilyTyCon tc
-  = do { let tvs     = tyConTyVars tc
-             kind    = tyConKind tc
-       ; kind' <- if isLiftedTypeKind kind then return Nothing
-                  else fmap Just (reifyKind kind)
+  = do { let tvs      = tyConTyVars tc
+             kind     = tyConKind tc
+
+             -- we need the *result kind* (see #8884)
+             (kvs, mono_kind) = splitForAllTys kind
+                                -- tyConArity includes *kind* params
+             (_, res_kind)    = splitKindFunTysN (tyConArity tc - length kvs)
+                                                 mono_kind
+       ; kind' <- fmap Just (reifyKind res_kind)
 
        ; tvs' <- reifyTyVars tvs
        ; flav' <- reifyFamFlavour tc
@@ -1306,13 +1324,14 @@ reifyClassInstance i
 
 ------------------------------
 reifyFamilyInstance :: FamInst -> TcM TH.Dec
-reifyFamilyInstance (FamInst { fi_flavor = flavor 
+reifyFamilyInstance (FamInst { fi_flavor = flavor
                              , fi_fam = fam
                              , fi_tys = lhs
                              , fi_rhs = rhs })
   = case flavor of
       SynFamilyInst ->
-        do { th_lhs <- reifyTypes lhs
+               -- remove kind patterns (#8884)
+        do { th_lhs <- reifyTypes (filter (not . isKind) lhs)
            ; th_rhs <- reifyType  rhs
            ; return (TH.TySynInstD (reifyName fam) (TH.TySynEqn th_lhs th_rhs)) }
 
@@ -1396,7 +1415,7 @@ reifyFamFlavour tc
   | Just ax <- isClosedSynFamilyTyCon_maybe tc
   = do { eqns <- brListMapM reifyAxBranch $ coAxiomBranches ax
        ; return $ Right eqns }
-                   
+
   | otherwise
   = panic "TcSplice.reifyFamFlavour: not a type family"
 
@@ -1423,6 +1442,7 @@ reify_tc_app tc tys
          | tc `hasKey` listTyConKey   = TH.ListT
          | tc `hasKey` nilDataConKey  = TH.PromotedNilT
          | tc `hasKey` consDataConKey = TH.PromotedConsT
+         | tc `hasKey` eqTyConKey     = TH.EqualityT
          | otherwise                  = TH.ConT (reifyName tc)
     removeKinds :: Kind -> [TypeRep.Type] -> [TypeRep.Type]
     removeKinds (FunTy k1 k2) (h:t)
@@ -1438,17 +1458,7 @@ reifyPred ty
   -- We could reify the implicit paramter as a class but it seems
   -- nicer to support them properly...
   | isIPPred ty = noTH (sLit "implicit parameters") (ppr ty)
-  | otherwise
-   = case classifyPredType ty of
-  ClassPred cls tys -> do { tys' <- reifyTypes tys 
-                          ; return $ TH.ClassP (reifyName cls) tys' }
-  EqPred ty1 ty2    -> do { ty1' <- reifyType ty1
-                          ; ty2' <- reifyType ty2
-                          ; return $ TH.EqualP ty1' ty2'
-                          }
-  TuplePred _ -> noTH (sLit "tuple predicates") (ppr ty)
-  IrredPred _ -> noTH (sLit "irreducible predicates") (ppr ty)
-
+  | otherwise   = reifyType ty
 
 ------------------------------
 reifyName :: NamedThing n => n -> TH.Name
@@ -1462,7 +1472,7 @@ reifyName thing
   where
     name    = getName thing
     mod     = ASSERT( isExternalName name ) nameModule name
-    pkg_str = packageIdString (modulePackageId mod)
+    pkg_str = packageKeyString (modulePackageKey mod)
     mod_str = moduleNameString (moduleName mod)
     occ_str = occNameString occ
     occ     = nameOccName name
@@ -1495,26 +1505,27 @@ lookupThAnnLookup :: TH.AnnLookup -> TcM CoreAnnTarget
 lookupThAnnLookup (TH.AnnLookupName th_nm) = fmap NamedTarget (lookupThName th_nm)
 lookupThAnnLookup (TH.AnnLookupModule (TH.Module pn mn))
   = return $ ModuleTarget $
-    mkModule (stringToPackageId $ TH.pkgString pn) (mkModuleName $ TH.modString mn)
+    mkModule (stringToPackageKey $ TH.pkgString pn) (mkModuleName $ TH.modString mn)
 
 reifyAnnotations :: Data a => TH.AnnLookup -> TcM [a]
-reifyAnnotations th_nm
-  = do { name <- lookupThAnnLookup th_nm
-       ; eps <- getEps
+reifyAnnotations th_name
+  = do { name <- lookupThAnnLookup th_name
+       ; topEnv <- getTopEnv
+       ; epsHptAnns <- liftIO $ prepareAnnotations topEnv Nothing
        ; tcg <- getGblEnv
-       ; let epsAnns = findAnns deserializeWithData (eps_ann_env eps) name
-       ; let envAnns = findAnns deserializeWithData (tcg_ann_env tcg) name
-       ; return (envAnns ++ epsAnns) }
+       ; let selectedEpsHptAnns = findAnns deserializeWithData epsHptAnns name
+       ; let selectedTcgAnns = findAnns deserializeWithData (tcg_ann_env tcg) name
+       ; return (selectedEpsHptAnns ++ selectedTcgAnns) }
 
 ------------------------------
 modToTHMod :: Module -> TH.Module
-modToTHMod m = TH.Module (TH.PkgName $ packageIdString  $ modulePackageId m)
+modToTHMod m = TH.Module (TH.PkgName $ packageKeyString  $ modulePackageKey m)
                          (TH.ModName $ moduleNameString $ moduleName m)
 
 reifyModule :: TH.Module -> TcM TH.ModuleInfo
 reifyModule (TH.Module (TH.PkgName pkgString) (TH.ModName mString)) = do
   this_mod <- getModule
-  let reifMod = mkModule (stringToPackageId pkgString) (mkModuleName mString)
+  let reifMod = mkModule (stringToPackageKey pkgString) (mkModuleName mString)
   if (reifMod == this_mod) then reifyThisModule else reifyFromIface reifMod
     where
       reifyThisModule = do
@@ -1524,10 +1535,10 @@ reifyModule (TH.Module (TH.PkgName pkgString) (TH.ModName mString)) = do
       reifyFromIface reifMod = do
         iface <- loadInterfaceForModule (ptext (sLit "reifying module from TH for") <+> ppr reifMod) reifMod
         let usages = [modToTHMod m | usage <- mi_usages iface,
-                                     Just m <- [usageToModule (modulePackageId reifMod) usage] ]
+                                     Just m <- [usageToModule (modulePackageKey reifMod) usage] ]
         return $ TH.ModuleInfo usages
 
-      usageToModule :: PackageId -> Usage -> Maybe Module
+      usageToModule :: PackageKey -> Usage -> Maybe Module
       usageToModule _ (UsageFile {}) = Nothing
       usageToModule this_pkg (UsageHomeModule { usg_mod_name = mn }) = Just $ mkModule this_pkg mn
       usageToModule _ (UsagePackageModule { usg_mod = m }) = Just m
@@ -1562,4 +1573,4 @@ will appear in TH syntax like this
 
 \begin{code}
 #endif  /* GHCI */
-\end{code}
\ No newline at end of file
+\end{code}
diff --git a/compiler/typecheck/TcSplice.lhs-boot b/compiler/typecheck/TcSplice.lhs-boot
index c496aed798da..fd19dee7dacf 100644
--- a/compiler/typecheck/TcSplice.lhs-boot
+++ b/compiler/typecheck/TcSplice.lhs-boot
@@ -1,9 +1,10 @@
 \begin{code}
+{-# LANGUAGE CPP #-}
+
 module TcSplice where
 import HsSyn    ( HsSplice, HsBracket, HsQuasiQuote,
                   HsExpr, LHsType, LHsExpr, LPat, LHsDecl )
 import HsExpr   ( PendingRnSplice )
-import Id       ( Id )
 import Name     ( Name )
 import RdrName  ( RdrName )
 import TcRnTypes( TcM, TcId )
@@ -11,6 +12,7 @@ import TcType   ( TcRhoType )
 import Annotations ( Annotation, CoreAnnTarget )
 
 #ifdef GHCI
+import Id       ( Id )
 import qualified Language.Haskell.TH as TH
 #endif
 
@@ -26,20 +28,20 @@ tcTypedBracket :: HsBracket Name
                -> TcRhoType
                -> TcM (HsExpr TcId)
 
-tcTopSpliceExpr :: Bool -> TcM (LHsExpr Id) -> TcM (LHsExpr Id)
-
 runQuasiQuoteDecl :: HsQuasiQuote RdrName -> TcM [LHsDecl RdrName]
 runQuasiQuoteExpr :: HsQuasiQuote RdrName -> TcM (LHsExpr RdrName)
 runQuasiQuoteType :: HsQuasiQuote RdrName -> TcM (LHsType RdrName)
 runQuasiQuotePat  :: HsQuasiQuote RdrName -> TcM (LPat RdrName)
 runAnnotation     :: CoreAnnTarget -> LHsExpr Name -> TcM Annotation
 
+#ifdef GHCI
+tcTopSpliceExpr :: Bool -> TcM (LHsExpr Id) -> TcM (LHsExpr Id)
+
 runMetaE :: LHsExpr Id -> TcM (LHsExpr RdrName)
 runMetaP :: LHsExpr Id -> TcM (LPat RdrName)
 runMetaT :: LHsExpr Id  -> TcM (LHsType RdrName)
 runMetaD :: LHsExpr Id -> TcM [LHsDecl RdrName]
 
-#ifdef GHCI
 lookupThName_maybe :: TH.Name -> TcM (Maybe Name)
 runQuasi :: TH.Q a -> TcM a
 #endif
diff --git a/compiler/typecheck/TcTyClsDecls.lhs b/compiler/typecheck/TcTyClsDecls.lhs
index 1fbdbb22bebd..6dcbaffef8b4 100644
--- a/compiler/typecheck/TcTyClsDecls.lhs
+++ b/compiler/typecheck/TcTyClsDecls.lhs
@@ -6,7 +6,7 @@
 TcTyClsDecls: Typecheck type and class declarations
 
 \begin{code}
-{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE CPP, TupleSections #-}
 
 module TcTyClsDecls (
         tcTyAndClassDecls, tcAddImplicits,
@@ -14,7 +14,7 @@ module TcTyClsDecls (
         -- Functions used by TcInstDcls to check
         -- data/type family instance declarations
         kcDataDefn, tcConDecls, dataDeclChecks, checkValidTyCon,
-        tcSynFamInstDecl, tcFamTyPats,
+        tcFamTyPats, tcTyFamInstEqn, famTyConShape,
         tcAddTyFamInstCtxt, tcAddDataFamInstCtxt,
         wrongKindOfFamily, dataConCtxt, badDataConTyCon
     ) where
@@ -354,7 +354,6 @@ getInitialKinds decls
     do { pairss <- mapM (addLocM getInitialKind) decls
        ; return (concat pairss) }
 
--- See Note [Kind-checking strategies] in TcHsType
 getInitialKind :: TyClDecl Name -> TcM [(Name, TcTyThing)]
 -- Allocate a fresh kind variable for each TyCon and Class
 -- For each tycon, return   (tc, AThing k)
@@ -375,7 +374,7 @@ getInitialKind :: TyClDecl Name -> TcM [(Name, TcTyThing)]
 
 getInitialKind decl@(ClassDecl { tcdLName = L _ name, tcdTyVars = ktvs, tcdATs = ats })
   = do { (cl_kind, inner_prs) <-
-           kcHsTyVarBndrs (kcStrategy decl) ktvs $
+           kcHsTyVarBndrs (hsDeclHasCusk decl) ktvs $
            do { inner_prs <- getFamDeclInitialKinds ats
               ; return (constraintKind, inner_prs) }
        ; let main_pr = (name, AThing cl_kind)
@@ -386,7 +385,7 @@ getInitialKind decl@(DataDecl { tcdLName = L _ name
                                 , tcdDataDefn = HsDataDefn { dd_kindSig = m_sig
                                                            , dd_cons = cons } })
   = do { (decl_kind, _) <-
-           kcHsTyVarBndrs (kcStrategy decl) ktvs $
+           kcHsTyVarBndrs (hsDeclHasCusk decl) ktvs $
            do { res_k <- case m_sig of
                            Just ksig -> tcLHsKind ksig
                            Nothing   -> return liftedTypeKind
@@ -418,16 +417,14 @@ getFamDeclInitialKind decl@(FamilyDecl { fdLName = L _ name
                                        , fdTyVars = ktvs
                                        , fdKindSig = ksig })
   = do { (fam_kind, _) <-
-           kcHsTyVarBndrs (kcStrategyFamDecl decl) ktvs $
+           kcHsTyVarBndrs (famDeclHasCusk decl) ktvs $
            do { res_k <- case ksig of
                            Just k  -> tcLHsKind k
                            Nothing
-                             | defaultResToStar -> return liftedTypeKind
-                             | otherwise        -> newMetaKindVar
+                             | famDeclHasCusk decl -> return liftedTypeKind
+                             | otherwise           -> newMetaKindVar
               ; return (res_k, ()) }
        ; return [ (name, AThing fam_kind) ] }
-  where
-    defaultResToStar = (kcStrategyFamDecl decl == FullKindSignature)
 
 ----------------
 kcSynDecls :: [SCC (LTyClDecl Name)]
@@ -451,7 +448,7 @@ kcSynDecl decl@(SynDecl { tcdTyVars = hs_tvs, tcdLName = L _ name
   -- Returns a possibly-unzonked kind
   = tcAddDeclCtxt decl $
     do { (syn_kind, _) <-
-           kcHsTyVarBndrs (kcStrategy decl) hs_tvs $
+           kcHsTyVarBndrs (hsDeclHasCusk decl) hs_tvs $
            do { traceTc "kcd1" (ppr name <+> brackets (ppr hs_tvs))
               ; (_, rhs_kind) <- tcLHsType rhs
               ; traceTc "kcd2" (ppr name)
@@ -502,10 +499,12 @@ kcTyClDecl (ForeignType {}) = return ()
 
 -- closed type families look at their equations, but other families don't
 -- do anything here
-kcTyClDecl (FamDecl (FamilyDecl { fdLName = L _ fam_tc_name
-                                , fdInfo = ClosedTypeFamily eqns }))
-  = do { k <- kcLookupKind fam_tc_name
-       ; mapM_ (kcTyFamInstEqn fam_tc_name k) eqns }
+kcTyClDecl (FamDecl (FamilyDecl { fdLName  = L _ fam_tc_name
+                                , fdTyVars = hs_tvs
+                                , fdInfo   = ClosedTypeFamily eqns }))
+  = do { tc_kind <- kcLookupKind fam_tc_name
+       ; let fam_tc_shape = ( fam_tc_name, length (hsQTvBndrs hs_tvs), tc_kind)
+       ; mapM_ (kcTyFamInstEqn fam_tc_shape) eqns }
 kcTyClDecl (FamDecl {})    = return ()
 
 -------------------
@@ -514,7 +513,10 @@ kcConDecl (ConDecl { con_name = name, con_qvars = ex_tvs
                    , con_cxt = ex_ctxt, con_details = details
                    , con_res = res })
   = addErrCtxt (dataConCtxt name) $
-    do { _ <- kcHsTyVarBndrs ParametricKinds ex_tvs $
+         -- the 'False' says that the existentials don't have a CUSK, as the
+         -- concept doesn't really apply here. We just need to bring the variables
+         -- into scope!
+    do { _ <- kcHsTyVarBndrs False ex_tvs $
               do { _ <- tcHsContext ex_ctxt
                  ; mapM_ (tcHsOpenType . getBangType) (hsConDeclArgTys details)
                  ; _ <- tcConRes res
@@ -638,13 +640,13 @@ tcTyClDecl1 _parent rec_info
                ; (sig_stuff, gen_dm_env) <- tcClassSigs class_name sigs meths
                ; at_stuff <- tcClassATs class_name (AssocFamilyTyCon clas) ats at_defs
                ; mindef <- tcClassMinimalDef class_name sigs sig_stuff
-               ; clas <- buildClass False {- Must include unfoldings for selectors -}
+               ; clas <- buildClass
                             class_name tvs' roles ctxt' fds' at_stuff
                             sig_stuff mindef tc_isrec
                ; traceTc "tcClassDecl" (ppr fundeps $$ ppr tvs' $$ ppr fds')
                ; return (clas, tvs', gen_dm_env) }
 
-       ; let { gen_dm_ids = [ AnId (mkExportedLocalId gen_dm_name gen_dm_ty)
+       ; let { gen_dm_ids = [ AnId (mkExportedLocalId VanillaId gen_dm_name gen_dm_ty)
                             | (sel_id, GenDefMeth gen_dm_name) <- classOpItems clas
                             , let gen_dm_tau = expectJust "tcTyClDecl1" $
                                                lookupNameEnv gen_dm_env (idName sel_id)
@@ -699,14 +701,11 @@ tcFamDecl1 parent
 
        ; checkFamFlag tc_name -- make sure we have -XTypeFamilies
 
-         -- check to make sure all the names used in the equations are
-         -- consistent
-       ; let names = map (tfie_tycon . unLoc) eqns
-       ; tcSynFamInstNames lname names
-
-         -- process the equations, creating CoAxBranches
-       ; tycon_kind <- kcLookupKind tc_name
-       ; branches <- mapM (tcTyFamInstEqn tc_name tycon_kind) eqns
+         -- Process the equations, creating CoAxBranches
+       ; tc_kind <- kcLookupKind tc_name
+       ; let fam_tc_shape = (tc_name, length (hsQTvBndrs tvs), tc_kind) 
+     
+       ; branches <- mapM (tcTyFamInstEqn fam_tc_shape) eqns
 
          -- we need the tycon that we will be creating, but it's in scope.
          -- just look it up.
@@ -780,7 +779,8 @@ tcDataDefn rec_info tc_name tvs kind
   = do { extra_tvs <- tcDataKindSig kind
        ; let final_tvs  = tvs ++ extra_tvs
              roles      = rti_roles rec_info tc_name
-       ; stupid_theta <- tcHsContext ctxt
+       ; stupid_tc_theta <- tcHsContext ctxt
+       ; stupid_theta    <- zonkTcTypeToTypes emptyZonkEnv stupid_tc_theta
        ; kind_signatures <- xoptM Opt_KindSignatures
        ; is_boot         <- tcIsHsBoot  -- Are we compiling an hs-boot file?
 
@@ -792,7 +792,7 @@ tcDataDefn rec_info tc_name tvs kind
                            ; checkKind kind tc_kind
                            ; return () }
 
-       ; h98_syntax <- dataDeclChecks tc_name new_or_data stupid_theta cons
+       ; gadt_syntax <- dataDeclChecks tc_name new_or_data stupid_theta cons
 
        ; tycon <- fixM $ \ tycon -> do
              { let res_ty = mkTyConApp tycon (mkTyVarTys final_tvs)
@@ -807,7 +807,7 @@ tcDataDefn rec_info tc_name tvs kind
              ; return (buildAlgTyCon tc_name final_tvs roles cType stupid_theta tc_rhs
                                      (rti_is_rec rec_info tc_name)
                                      (rti_promotable rec_info)
-                                     (not h98_syntax) NoParentTyCon) }
+                                     gadt_syntax NoParentTyCon) }
        ; return [ATyCon tycon] }
 \end{code}
 
@@ -835,76 +835,90 @@ Note that:
   - We can get default definitions only for type families, not data families
 
 \begin{code}
-tcClassATs :: Name             -- The class name (not knot-tied)
-           -> TyConParent      -- The class parent of this associated type
-           -> [LFamilyDecl Name] -- Associated types.
-           -> [LTyFamInstDecl Name] -- Associated type defaults.
+tcClassATs :: Name                  -- The class name (not knot-tied)
+           -> TyConParent           -- The class parent of this associated type
+           -> [LFamilyDecl Name]    -- Associated types.
+           -> [LTyFamDefltEqn Name] -- Associated type defaults.
            -> TcM [ClassATItem]
 tcClassATs class_name parent ats at_defs
   = do {  -- Complain about associated type defaults for non associated-types
          sequence_ [ failWithTc (badATErr class_name n)
-                   | n <- map (tyFamInstDeclName . unLoc) at_defs
+                   | n <- map at_def_tycon at_defs
                    , not (n `elemNameSet` at_names) ]
        ; mapM tc_at ats }
   where
-    at_names = mkNameSet (map (unLoc . fdLName . unLoc) ats)
+    at_def_tycon :: LTyFamDefltEqn Name -> Name
+    at_def_tycon (L _ eqn) = unLoc (tfe_tycon eqn)
+
+    at_fam_name :: LFamilyDecl Name -> Name
+    at_fam_name (L _ decl) = unLoc (fdLName decl)
+
+    at_names = mkNameSet (map at_fam_name ats)
 
-    at_defs_map :: NameEnv [LTyFamInstDecl Name]
+    at_defs_map :: NameEnv [LTyFamDefltEqn Name]
     -- Maps an AT in 'ats' to a list of all its default defs in 'at_defs'
     at_defs_map = foldr (\at_def nenv -> extendNameEnv_C (++) nenv
-                                          (tyFamInstDeclName (unLoc at_def)) [at_def])
+                                          (at_def_tycon at_def) [at_def])
                         emptyNameEnv at_defs
 
     tc_at at = do { [ATyCon fam_tc] <- addLocM (tcFamDecl1 parent) at
-                  ; let at_defs = lookupNameEnv at_defs_map (unLoc $ fdLName $ unLoc at)
-                                        `orElse` []
-                  ; atd <- mapM (tcDefaultAssocDecl fam_tc) at_defs
-                  ; return (fam_tc, atd) }
+                  ; let at_defs = lookupNameEnv at_defs_map (at_fam_name at)
+                                  `orElse` []
+                  ; atd <- tcDefaultAssocDecl fam_tc at_defs
+                  ; return (ATI fam_tc atd) }
 
 -------------------------
-tcDefaultAssocDecl :: TyCon                -- ^ Family TyCon
-                   -> LTyFamInstDecl Name  -- ^ RHS
-                   -> TcM CoAxBranch       -- ^ Type checked RHS and free TyVars
-tcDefaultAssocDecl fam_tc (L loc decl)
+tcDefaultAssocDecl :: TyCon                  -- ^ Family TyCon
+                   -> [LTyFamDefltEqn Name]  -- ^ Defaults
+                   -> TcM (Maybe Type)       -- ^ Type checked RHS
+tcDefaultAssocDecl _ []
+  = return Nothing  -- No default declaration
+
+tcDefaultAssocDecl _ (d1:_:_)
+  = failWithTc (ptext (sLit "More than one default declaration for") 
+                <+> ppr (tfe_tycon (unLoc d1)))
+
+tcDefaultAssocDecl fam_tc [L loc (TyFamEqn { tfe_tycon = L _ tc_name
+                                           , tfe_pats = hs_tvs
+                                           , tfe_rhs = rhs })]
   = setSrcSpan loc $
-    tcAddTyFamInstCtxt decl $
-    do { traceTc "tcDefaultAssocDecl" (ppr decl)
-       ; tcSynFamInstDecl fam_tc decl }
+    tcAddFamInstCtxt (ptext (sLit "default type instance")) tc_name $
+    tcTyClTyVars tc_name hs_tvs $ \ tvs rhs_kind ->
+    do { traceTc "tcDefaultAssocDecl" (ppr tc_name)
+       ; checkTc (isSynFamilyTyCon fam_tc) (wrongKindOfFamily fam_tc)
+       ; let (fam_name, fam_pat_arity, _) = famTyConShape fam_tc
+       ; ASSERT( fam_name == tc_name )
+         checkTc (length (hsQTvBndrs hs_tvs) == fam_pat_arity)
+                 (wrongNumberOfParmsErr fam_pat_arity)
+       ; rhs_ty <- tcCheckLHsType rhs rhs_kind
+       ; rhs_ty <- zonkTcTypeToType emptyZonkEnv rhs_ty
+       ; let fam_tc_tvs = tyConTyVars fam_tc
+             subst = zipTopTvSubst tvs (mkTyVarTys fam_tc_tvs)
+       ; return ( ASSERT( equalLength fam_tc_tvs tvs )
+                  Just (substTy subst rhs_ty) ) }
     -- We check for well-formedness and validity later, in checkValidClass
 
 -------------------------
-tcSynFamInstDecl :: TyCon -> TyFamInstDecl Name -> TcM CoAxBranch
--- Placed here because type family instances appear as
--- default decls in class declarations
-tcSynFamInstDecl fam_tc (TyFamInstDecl { tfid_eqn = eqn })
-  = do { checkTc (isSynTyCon fam_tc) (wrongKindOfFamily fam_tc)
-       ; tcTyFamInstEqn (tyConName fam_tc) (tyConKind fam_tc) eqn }
-
--- Checks to make sure that all the names in an instance group are the same
-tcSynFamInstNames :: Located Name -> [Located Name] -> TcM ()
-tcSynFamInstNames (L _ first) names
-  = do { let badNames = filter ((/= first) . unLoc) names
-       ; mapM_ (failLocated (wrongNamesInInstGroup first)) badNames }
-  where
-    failLocated :: (Name -> SDoc) -> Located Name -> TcM ()
-    failLocated msg_fun (L loc name)
-      = setSrcSpan loc $
-        failWithTc (msg_fun name)
-
-kcTyFamInstEqn :: Name -> Kind -> LTyFamInstEqn Name -> TcM ()
-kcTyFamInstEqn fam_tc_name kind
-    (L loc (TyFamInstEqn { tfie_pats = pats, tfie_rhs = hs_ty }))
+kcTyFamInstEqn :: FamTyConShape -> LTyFamInstEqn Name -> TcM ()
+kcTyFamInstEqn fam_tc_shape
+    (L loc (TyFamEqn { tfe_pats = pats, tfe_rhs = hs_ty }))
   = setSrcSpan loc $
     discardResult $
-    tc_fam_ty_pats fam_tc_name kind pats (discardResult . (tcCheckLHsType hs_ty))
-
-tcTyFamInstEqn :: Name -> Kind -> LTyFamInstEqn Name -> TcM CoAxBranch
-tcTyFamInstEqn fam_tc_name kind
-    (L loc (TyFamInstEqn { tfie_pats = pats, tfie_rhs = hs_ty }))
+    tc_fam_ty_pats fam_tc_shape pats (discardResult . (tcCheckLHsType hs_ty))
+
+tcTyFamInstEqn :: FamTyConShape -> LTyFamInstEqn Name -> TcM CoAxBranch
+-- Needs to be here, not in TcInstDcls, because closed families
+-- (typechecked here) have TyFamInstEqns
+tcTyFamInstEqn fam_tc_shape@(fam_tc_name,_,_)
+    (L loc (TyFamEqn { tfe_tycon = L _ eqn_tc_name
+                     , tfe_pats = pats
+                     , tfe_rhs = hs_ty }))
   = setSrcSpan loc $
-    tcFamTyPats fam_tc_name kind pats (discardResult . (tcCheckLHsType hs_ty)) $
+    tcFamTyPats fam_tc_shape pats (discardResult . (tcCheckLHsType hs_ty)) $
        \tvs' pats' res_kind ->
-    do { rhs_ty <- tcCheckLHsType hs_ty res_kind
+    do { checkTc (fam_tc_name == eqn_tc_name) 
+                 (wrongTyFamName fam_tc_name eqn_tc_name)
+       ; rhs_ty <- tcCheckLHsType hs_ty res_kind
        ; rhs_ty <- zonkTcTypeToType emptyZonkEnv rhs_ty
        ; traceTc "tcTyFamInstEqn" (ppr fam_tc_name <+> ppr tvs')
           -- don't print out the pats here, as they might be zonked inside the knot
@@ -946,6 +960,19 @@ type families.
 tcFamTyPats type checks the patterns, zonks, and then calls thing_inside
 to generate a desugaring. It is used during type-checking (not kind-checking).
 
+Note [Type-checking type patterns]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+When typechecking the patterns of a family instance declaration, we can't
+rely on using the family TyCon, because this is sometimes called
+from within a type-checking knot. (Specifically for closed type families.)
+The type FamTyConShape gives just enough information to do the job.
+
+The "arity" field of FamTyConShape is the *visible* arity of the family
+type constructor, i.e. what the users sees and writes, not including kind
+arguments.
+
+See also Note [tc_fam_ty_pats vs tcFamTyPats]
+
 Note [Failing early in kcDataDefn]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 We need to use checkNoErrs when calling kcConDecl. This is because kcConDecl
@@ -960,15 +987,18 @@ two bad things could happen:
 
 \begin{code}
 -----------------
--- Note that we can't use the family TyCon, because this is sometimes called
--- from within a type-checking knot. So, we ask our callers to do a little more
--- work.
--- See Note [tc_fam_ty_pats vs tcFamTyPats]
-tc_fam_ty_pats :: Name -- of the family TyCon
-               -> Kind -- of the family TyCon
+type FamTyConShape = (Name, Arity, Kind) -- See Note [Type-checking type patterns]
+
+famTyConShape :: TyCon -> FamTyConShape
+famTyConShape fam_tc
+  = ( tyConName fam_tc
+    , length (filterOut isKindVar (tyConTyVars fam_tc))
+    , tyConKind fam_tc )
+
+tc_fam_ty_pats :: FamTyConShape
                -> HsWithBndrs [LHsType Name] -- Patterns
-               -> (TcKind -> TcM ())       -- Kind checker for RHS
-                                           -- result is ignored
+               -> (TcKind -> TcM ())         -- Kind checker for RHS
+                                             -- result is ignored
                -> TcM ([Kind], [Type], Kind)
 -- Check the type patterns of a type or data family instance
 --     type instance F <pat1> <pat2> = <type>
@@ -981,7 +1011,7 @@ tc_fam_ty_pats :: Name -- of the family TyCon
 -- In that case, the type variable 'a' will *already be in scope*
 -- (and, if C is poly-kinded, so will its kind parameter).
 
-tc_fam_ty_pats fam_tc_name kind
+tc_fam_ty_pats (name, arity, kind)
                (HsWB { hswb_cts = arg_pats, hswb_kvs = kvars, hswb_tvs = tvars })
                kind_checker
   = do { let (fam_kvs, fam_body) = splitForAllTys kind
@@ -993,9 +1023,8 @@ tc_fam_ty_pats fam_tc_name kind
          -- Note that we don't have enough information at hand to do a full check,
          -- as that requires the full declared arity of the family, which isn't
          -- nearby.
-       ; let max_args = length (fst $ splitKindFunTys fam_body)
-       ; checkTc (length arg_pats <= max_args) $
-           wrongNumberOfParmsErrTooMany max_args
+       ; checkTc (length arg_pats == arity) $
+         wrongNumberOfParmsErr arity
 
          -- Instantiate with meta kind vars
        ; fam_arg_kinds <- mapM (const newMetaKindVar) fam_kvs
@@ -1010,20 +1039,21 @@ tc_fam_ty_pats fam_tc_name kind
          -- See Note [Quantifying over family patterns]
        ; typats <- tcHsTyVarBndrs hs_tvs $ \ _ ->
                    do { kind_checker res_kind
-                      ; tcHsArgTys (quotes (ppr fam_tc_name)) arg_pats arg_kinds }
+                      ; tcHsArgTys (quotes (ppr name)) arg_pats arg_kinds }
 
        ; return (fam_arg_kinds, typats, res_kind) }
 
 -- See Note [tc_fam_ty_pats vs tcFamTyPats]
-tcFamTyPats :: Name -- of the family ToCon
-            -> Kind -- of the family TyCon
+tcFamTyPats :: FamTyConShape
             -> HsWithBndrs [LHsType Name] -- patterns
             -> (TcKind -> TcM ())         -- kind-checker for RHS
-            -> ([TKVar] -> [TcType] -> Kind -> TcM a)
+            -> ([TKVar]              -- Kind and type variables
+                -> [TcType]          -- Kind and type arguments
+                -> Kind -> TcM a)
             -> TcM a
-tcFamTyPats fam_tc_name kind pats kind_checker thing_inside
+tcFamTyPats fam_shape@(name,_,_) pats kind_checker thing_inside
   = do { (fam_arg_kinds, typats, res_kind)
-            <- tc_fam_ty_pats fam_tc_name kind pats kind_checker
+            <- tc_fam_ty_pats fam_shape pats kind_checker
        ; let all_args = fam_arg_kinds ++ typats
 
             -- Find free variables (after zonking) and turn
@@ -1037,7 +1067,7 @@ tcFamTyPats fam_tc_name kind pats kind_checker thing_inside
        ; all_args'    <- zonkTcTypeToTypes ze all_args
        ; res_kind'    <- zonkTcTypeToType  ze res_kind
 
-       ; traceTc "tcFamTyPats" (ppr fam_tc_name)
+       ; traceTc "tcFamTyPats" (ppr name)
             -- don't print out too much, as we might be in the knot
        ; tcExtendTyVarEnv qtkvs' $
          thing_inside qtkvs' all_args' res_kind' }
@@ -1098,11 +1128,11 @@ dataDeclChecks :: Name -> NewOrData -> ThetaType -> [LConDecl Name] -> TcM Bool
 dataDeclChecks tc_name new_or_data stupid_theta cons
   = do {   -- Check that we don't use GADT syntax in H98 world
          gadtSyntax_ok <- xoptM Opt_GADTSyntax
-       ; let h98_syntax = consUseH98Syntax cons
-       ; checkTc (gadtSyntax_ok || h98_syntax) (badGadtDecl tc_name)
+       ; let gadt_syntax = consUseGadtSyntax cons
+       ; checkTc (gadtSyntax_ok || not gadt_syntax) (badGadtDecl tc_name)
 
            -- Check that the stupid theta is empty for a GADT-style declaration
-       ; checkTc (null stupid_theta || h98_syntax) (badStupidTheta tc_name)
+       ; checkTc (null stupid_theta || not gadt_syntax) (badStupidTheta tc_name)
 
          -- Check that a newtype has exactly one constructor
          -- Do this before checking for empty data decls, so that
@@ -1116,13 +1146,13 @@ dataDeclChecks tc_name new_or_data stupid_theta cons
        ; is_boot <- tcIsHsBoot  -- Are we compiling an hs-boot file?
        ; checkTc (not (null cons) || empty_data_decls || is_boot)
                  (emptyConDeclsErr tc_name)
-       ; return h98_syntax }
+       ; return gadt_syntax }
 
 
 -----------------------------------
-consUseH98Syntax :: [LConDecl a] -> Bool
-consUseH98Syntax (L _ (ConDecl { con_res = ResTyGADT _ }) : _) = False
-consUseH98Syntax _                                             = True
+consUseGadtSyntax :: [LConDecl a] -> Bool
+consUseGadtSyntax (L _ (ConDecl { con_res = ResTyGADT _ }) : _) = True
+consUseGadtSyntax _                                             = False
                  -- All constructors have same shape
 
 -----------------------------------
@@ -1153,7 +1183,7 @@ tcConDecl new_or_data rep_tycon tmpl_tvs res_tmpl        -- Data types
                        (arg_tys, stricts)           = unzip btys
                  ; return (ctxt, arg_tys, res_ty, is_infix, field_lbls, stricts) }
 
-             -- Generalise the kind variables (returning quantifed TcKindVars)
+             -- Generalise the kind variables (returning quantified TcKindVars)
              -- and quantify the type variables (substituting their kinds)
              -- REMEMBER: 'tkvs' are:
              --    ResTyH98:  the *existential* type variables only
@@ -1339,10 +1369,24 @@ since GADTs are not kind indexed.
 Validity checking is done once the mutually-recursive knot has been
 tied, so we can look at things freely.
 
+Note [Abort when superclass cycle is detected]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+We must avoid doing the ambiguity check when there are already errors accumulated.
+This is because one of the errors may be a superclass cycle, and superclass cycles
+cause canonicalization to loop. Here is a representative example:
+
+  class D a => C a where
+    meth :: D a => ()
+  class C a => D a
+
+This fixes Trac #9415.
+
 \begin{code}
 checkClassCycleErrs :: Class -> TcM ()
 checkClassCycleErrs cls
-  = unless (null cls_cycles) $ mapM_ recClsErr cls_cycles
+  = unless (null cls_cycles) $
+    do { mapM_ recClsErr cls_cycles
+       ; failM }  -- See Note [Abort when superclass cycle is detected]
   where cls_cycles = calcClassCycles cls
 
 checkValidTyCl :: TyThing -> TcM ()
@@ -1463,8 +1507,8 @@ checkValidClosedCoAxiom (CoAxiom { co_ax_branches = branches, co_ax_tc = tc })
                -- ones and hence is inaccessible
      check_accessibility prev_branches cur_branch
        = do { when (cur_branch `isDominatedBy` prev_branches) $
-              setSrcSpan (coAxBranchSpan cur_branch) $
-              addErrTc $ inaccessibleCoAxBranch tc cur_branch
+              addWarnAt (coAxBranchSpan cur_branch) $
+              inaccessibleCoAxBranch tc cur_branch
             ; return (cur_branch : prev_branches) }
 
 checkFieldCompat :: Name -> DataCon -> DataCon -> TyVarSet
@@ -1481,16 +1525,19 @@ checkValidDataCon :: DynFlags -> Bool -> TyCon -> DataCon -> TcM ()
 checkValidDataCon dflags existential_ok tc con
   = setSrcSpan (srcLocSpan (getSrcLoc con))     $
     addErrCtxt (dataConCtxt con)                $
-    do  { traceTc "checkValidDataCon" (ppr con $$ ppr tc)
-
-          -- Check that the return type of the data constructor
+    do  { -- Check that the return type of the data constructor
           -- matches the type constructor; eg reject this:
           --   data T a where { MkT :: Bogus a }
           -- c.f. Note [Check role annotations in a second pass]
           --  and Note [Checking GADT return types]
-        ; let tc_tvs = tyConTyVars tc
+          let tc_tvs = tyConTyVars tc
               res_ty_tmpl = mkFamilyTyConApp tc (mkTyVarTys tc_tvs)
               orig_res_ty = dataConOrigResTy con
+        ; traceTc "checkValidDataCon" (vcat
+              [ ppr con, ppr tc, ppr tc_tvs
+              , ppr res_ty_tmpl <+> dcolon <+> ppr (typeKind res_ty_tmpl)
+              , ppr orig_res_ty <+> dcolon <+> ppr (typeKind orig_res_ty)])
+
         ; checkTc (isJust (tcMatchTy (mkVarSet tc_tvs)
                                      res_ty_tmpl
                                      orig_res_ty))
@@ -1578,16 +1625,19 @@ checkValidClass cls
         ; nullary_type_classes <- xoptM Opt_NullaryTypeClasses
         ; fundep_classes <- xoptM Opt_FunctionalDependencies
 
-        -- Check that the class is unary, unless multiparameter or
-        -- nullary type classes are enabled
-        ; checkTc (nullary_type_classes || notNull tyvars) (nullaryClassErr cls)
-        ; checkTc (multi_param_type_classes || arity <= 1) (classArityErr cls)
+        -- Check that the class is unary, unless multiparameter type classes
+        -- are enabled; also recognize deprecated nullary type classes
+        -- extension (subsumed by multiparameter type classes, Trac #8993)
+        ; checkTc (multi_param_type_classes || arity == 1 ||
+                    (nullary_type_classes && arity == 0))
+                  (classArityErr arity cls)
         ; checkTc (fundep_classes || null fundeps) (classFunDepsErr cls)
 
         -- Check the super-classes
         ; checkValidTheta (ClassSCCtxt (className cls)) theta
 
           -- Now check for cyclic superclasses
+          -- If there are superclass cycles, checkClassCycleErrs bails.
         ; checkClassCycleErrs cls
 
         -- Check the class operations
@@ -1618,7 +1668,7 @@ checkValidClass cls
                 -- since there is no possible ambiguity
         ; let grown_tyvars = growThetaTyVars theta (mkVarSet tyvars)
         ; checkTc (arity == 0 || tyVarsOfType tau `intersectsVarSet` grown_tyvars)
-                  (noClassTyVarErr cls sel_id)
+                  (noClassTyVarErr cls (ptext (sLit "class method") <+> quotes (ppr sel_id)))
 
         ; case dm of
             GenDefMeth dm_name -> do { dm_id <- tcLookupId dm_name
@@ -1640,11 +1690,10 @@ checkValidClass cls
                 -- in the context of a for-all must mention at least one quantified
                 -- type variable.  What a mess!
 
-    check_at_defs (fam_tc, defs)
-      = tcAddDefaultAssocDeclCtxt (tyConName fam_tc) $
-        mapM_ (checkValidTyFamInst mb_clsinfo fam_tc) defs
-
-    mb_clsinfo = Just (cls, mkVarEnv [ (tv, mkTyVarTy tv) | tv <- tyvars ])
+    check_at_defs (ATI fam_tc _)
+      = do { traceTc "check-at" (ppr fam_tc $$ ppr (tyConTyVars fam_tc) $$ ppr tyvars)
+           ; checkTc (any (`elem` tyvars) (tyConTyVars fam_tc)) 
+                     (noClassTyVarErr cls (ptext (sLit "associated type") <+> quotes (ppr fam_tc))) }
 
 checkFamFlag :: Name -> TcM ()
 -- Check that we don't use families without -XTypeFamilies
@@ -1669,9 +1718,9 @@ checkValidRoleAnnots :: RoleAnnots -> TyThing -> TcM ()
 checkValidRoleAnnots role_annots thing
   = case thing of
     { ATyCon tc
-        | isSynTyCon tc    -> check_no_roles
-        | isFamilyTyCon tc -> check_no_roles
-        | isAlgTyCon tc    -> check_roles
+        | isTypeSynonymTyCon tc -> check_no_roles
+        | isFamilyTyCon tc      -> check_no_roles
+        | isAlgTyCon tc         -> check_roles
         where
           name                   = tyConName tc
 
@@ -1694,6 +1743,15 @@ checkValidRoleAnnots role_annots thing
                 ; checkTc (type_vars `equalLength` the_role_annots)
                           (wrongNumberOfRoles type_vars decl)
                 ; _ <- zipWith3M checkRoleAnnot type_vars the_role_annots type_roles
+                -- Representational or phantom roles for class parameters
+                -- quickly lead to incoherence. So, we require
+                -- IncoherentInstances to have them. See #8773.
+                ; incoherent_roles_ok <- xoptM Opt_IncoherentInstances
+                ; checkTc (  incoherent_roles_ok
+                          || (not $ isClassTyCon tc)
+                          || (all (== Nominal) type_roles))
+                          incoherentRoles
+                  
                 ; lint <- goptM Opt_DoCoreLinting
                 ; when lint $ checkValidRoles tc }
 
@@ -1786,7 +1844,7 @@ checkValidRoles tc
 mkDefaultMethodIds :: [TyThing] -> [Id]
 -- See Note [Default method Ids and Template Haskell]
 mkDefaultMethodIds things
-  = [ mkExportedLocalId dm_name (idType sel_id)
+  = [ mkExportedLocalId VanillaId dm_name (idType sel_id)
     | ATyCon tc <- things
     , Just cls <- [tyConClass_maybe tc]
     , (sel_id, DefMeth dm_name) <- classOpItems cls ]
@@ -1823,11 +1881,10 @@ mkRecSelBinds tycons
 
 mkRecSelBind :: (TyCon, FieldLabel) -> (LSig Name, LHsBinds Name)
 mkRecSelBind (tycon, sel_name)
-  = (L loc (IdSig sel_id), unitBag (Generated, L loc sel_bind))
+  = (L loc (IdSig sel_id), unitBag (L loc sel_bind))
   where
     loc    = getSrcSpan sel_name
-    sel_id = Var.mkExportedLocalVar rec_details sel_name
-                                    sel_ty vanillaIdInfo
+    sel_id = mkExportedLocalId rec_details sel_name sel_ty
     rec_details = RecSelId { sel_tycon = tycon, sel_naughty = is_naughty }
 
     -- Find a representative constructor, con1
@@ -1852,8 +1909,10 @@ mkRecSelBind (tycon, sel_name)
     -- Make the binding: sel (C2 { fld = x }) = x
     --                   sel (C7 { fld = x }) = x
     --    where cons_w_field = [C2,C7]
-    sel_bind | is_naughty = mkTopFunBind sel_lname [mkSimpleMatch [] unit_rhs]
-             | otherwise  = mkTopFunBind sel_lname (map mk_match cons_w_field ++ deflt)
+    sel_bind = mkTopFunBind Generated sel_lname alts
+      where
+        alts | is_naughty = [mkSimpleMatch [] unit_rhs]
+             | otherwise =  map mk_match cons_w_field ++ deflt
     mk_match con = mkSimpleMatch [L loc (mk_sel_pat con)]
                                  (L loc (HsVar field_var))
     mk_sel_pat con = ConPatIn (L loc (getName con)) (RecCon rec_fields)
@@ -1991,13 +2050,6 @@ gotten by appying the eq_spec to the univ_tvs of the data con.
 %************************************************************************
 
 \begin{code}
-tcAddDefaultAssocDeclCtxt :: Name -> TcM a -> TcM a
-tcAddDefaultAssocDeclCtxt name thing_inside
-  = addErrCtxt ctxt thing_inside
-  where
-     ctxt = hsep [ptext (sLit "In the type synonym instance default declaration for"),
-                  quotes (ppr name)]
-
 tcAddTyFamInstCtxt :: TyFamInstDecl Name -> TcM a -> TcM a
 tcAddTyFamInstCtxt decl
   = tcAddFamInstCtxt (ptext (sLit "type instance")) (tyFamInstDeclName decl)
@@ -2040,26 +2092,26 @@ classOpCtxt :: Var -> Type -> SDoc
 classOpCtxt sel_id tau = sep [ptext (sLit "When checking the class method:"),
                               nest 2 (pprPrefixOcc sel_id <+> dcolon <+> ppr tau)]
 
-nullaryClassErr :: Class -> SDoc
-nullaryClassErr cls
-  = vcat [ptext (sLit "No parameters for class") <+> quotes (ppr cls),
-          parens (ptext (sLit "Use NullaryTypeClasses to allow no-parameter classes"))]
-
-classArityErr :: Class -> SDoc
-classArityErr cls
-  = vcat [ptext (sLit "Too many parameters for class") <+> quotes (ppr cls),
-          parens (ptext (sLit "Use MultiParamTypeClasses to allow multi-parameter classes"))]
+classArityErr :: Int -> Class -> SDoc
+classArityErr n cls
+    | n == 0 = mkErr "No" "no-parameter"
+    | otherwise = mkErr "Too many" "multi-parameter"
+  where
+    mkErr howMany allowWhat =
+        vcat [ptext (sLit $ howMany ++ " parameters for class") <+> quotes (ppr cls),
+              parens (ptext (sLit $ "Use MultiParamTypeClasses to allow "
+                                    ++ allowWhat ++ " classes"))]
 
 classFunDepsErr :: Class -> SDoc
 classFunDepsErr cls
   = vcat [ptext (sLit "Fundeps in class") <+> quotes (ppr cls),
           parens (ptext (sLit "Use FunctionalDependencies to allow fundeps"))]
 
-noClassTyVarErr :: Class -> Var -> SDoc
-noClassTyVarErr clas op
-  = sep [ptext (sLit "The class method") <+> quotes (ppr op),
-         ptext (sLit "mentions none of the type variables of the class") <+>
-                ppr clas <+> hsep (map ppr (classTyVars clas))]
+noClassTyVarErr :: Class -> SDoc -> SDoc
+noClassTyVarErr clas what
+  = sep [ptext (sLit "The") <+> what,
+         ptext (sLit "mentions none of the type or kind variables of the class") <+>
+                quotes (ppr clas <+> hsep (map ppr (classTyVars clas)))]
 
 recSynErr :: [LTyClDecl Name] -> TcRn ()
 recSynErr syn_decls
@@ -2138,20 +2190,20 @@ wrongKindOfFamily family
                  | isAlgTyCon family = ptext (sLit "data type")
                  | otherwise = pprPanic "wrongKindOfFamily" (ppr family)
 
-wrongNumberOfParmsErrTooMany :: Arity -> SDoc
-wrongNumberOfParmsErrTooMany max_args
-  = ptext (sLit "Number of parameters must match family declaration; expected no more than")
+wrongNumberOfParmsErr :: Arity -> SDoc
+wrongNumberOfParmsErr max_args
+  = ptext (sLit "Number of parameters must match family declaration; expected")
     <+> ppr max_args
 
-wrongNamesInInstGroup :: Name -> Name -> SDoc
-wrongNamesInInstGroup first cur
-  = ptext (sLit "Mismatched type names in closed type family declaration.") $$
-    ptext (sLit "First name was") <+>
-    (ppr first) <> (ptext (sLit "; this one is")) <+> (ppr cur)
+wrongTyFamName :: Name -> Name -> SDoc
+wrongTyFamName fam_tc_name eqn_tc_name
+  = hang (ptext (sLit "Mismatched type name in type family instance."))
+       2 (vcat [ ptext (sLit "Expected:") <+> ppr fam_tc_name
+               , ptext (sLit "  Actual:") <+> ppr eqn_tc_name ])
 
 inaccessibleCoAxBranch :: TyCon -> CoAxBranch -> SDoc
 inaccessibleCoAxBranch tc fi
-  = ptext (sLit "Inaccessible family instance equation:") $$
+  = ptext (sLit "Overlapped type family instance equation:") $$
       (pprCoAxBranch tc fi)
 
 badRoleAnnot :: Name -> Role -> Role -> SDoc
@@ -2180,6 +2232,11 @@ needXRoleAnnotations tc
   = ptext (sLit "Illegal role annotation for") <+> ppr tc <> char ';' $$
     ptext (sLit "did you intend to use RoleAnnotations?")
 
+incoherentRoles :: SDoc
+incoherentRoles = (text "Roles other than" <+> quotes (text "nominal") <+>
+                   text "for class parameters can lead to incoherence.") $$
+                  (text "Use IncoherentInstances to allow this; bad role found")
+
 addTyThingCtxt :: TyThing -> TcM a -> TcM a
 addTyThingCtxt thing
   = addErrCtxt ctxt
@@ -2187,12 +2244,12 @@ addTyThingCtxt thing
     name = getName thing
     flav = case thing of
              ATyCon tc
-                | isClassTyCon tc      -> ptext (sLit "class")
-                | isSynFamilyTyCon tc  -> ptext (sLit "type family")
-                | isDataFamilyTyCon tc -> ptext (sLit "data family")
-                | isSynTyCon tc        -> ptext (sLit "type")
-                | isNewTyCon tc        -> ptext (sLit "newtype")
-                | isDataTyCon tc       -> ptext (sLit "data")
+                | isClassTyCon tc       -> ptext (sLit "class")
+                | isSynFamilyTyCon tc   -> ptext (sLit "type family")
+                | isDataFamilyTyCon tc  -> ptext (sLit "data family")
+                | isTypeSynonymTyCon tc -> ptext (sLit "type")
+                | isNewTyCon tc         -> ptext (sLit "newtype")
+                | isDataTyCon tc        -> ptext (sLit "data")
 
              _ -> pprTrace "addTyThingCtxt strange" (ppr thing)
                   empty
diff --git a/compiler/typecheck/TcTyDecls.lhs b/compiler/typecheck/TcTyDecls.lhs
index dbecf0a75402..262aa519b32a 100644
--- a/compiler/typecheck/TcTyDecls.lhs
+++ b/compiler/typecheck/TcTyDecls.lhs
@@ -9,7 +9,8 @@ This stuff is only used for source-code decls; it's recorded in interface
 files for imported data types.
 
 \begin{code}
-{-# OPTIONS -fno-warn-tabs #-}
+{-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
 -- The above warning supression flag is a temporary kludge.
 -- While working on this module you are encouraged to remove it and
 -- detab the module (please do the detabbing in a separate patch). See
@@ -120,7 +121,7 @@ synTyConsOfType ty
 mkSynEdges :: [LTyClDecl Name] -> [(LTyClDecl Name, Name, [Name])]
 mkSynEdges syn_decls = [ (ldecl, name, nameSetToList fvs)
                        | ldecl@(L _ (SynDecl { tcdLName = L _ name
-                                            , tcdFVs = fvs })) <- syn_decls ]
+                                             , tcdFVs = fvs })) <- syn_decls ]
 
 calcSynCycles :: [LTyClDecl Name] -> [SCC (LTyClDecl Name)]
 calcSynCycles = stronglyConnCompFromEdgedVertices . mkSynEdges
@@ -263,7 +264,7 @@ this for all newtypes, we'd get infinite types.  So we figure out for
 each newtype whether it is "recursive", and add a coercion if so.  In
 effect, we are trying to "cut the loops" by identifying a loop-breaker.
 
-2.  Avoid infinite unboxing.  This is nothing to do with newtypes.
+2.  Avoid infinite unboxing.  This has nothing to do with newtypes.
 Suppose we have
         data T = MkT Int T
         f (MkT x t) = f t
@@ -371,7 +372,7 @@ calcRecFlags boot_details is_boot mrole_env tyclss
         , rti_is_rec     = is_rec }
   where
     rec_tycon_names = mkNameSet (map tyConName all_tycons)
-    all_tycons = mapCatMaybes getTyCon tyclss
+    all_tycons = mapMaybe getTyCon tyclss
                    -- Recursion of newtypes/data types can happen via
                    -- the class TyCon, so tyclss includes the class tycons
 
@@ -672,10 +673,10 @@ initialRoleEnv is_boot annots = extendNameEnvList emptyNameEnv .
 
 initialRoleEnv1 :: Bool -> RoleAnnots -> TyCon -> (Name, [Role])
 initialRoleEnv1 is_boot annots_env tc
-  | isFamilyTyCon tc = (name, map (const Nominal) tyvars)
-  |  isAlgTyCon tc
-  || isSynTyCon tc   = (name, default_roles)
-  | otherwise        = pprPanic "initialRoleEnv1" (ppr tc)
+  | isFamilyTyCon tc      = (name, map (const Nominal) tyvars)
+  | isAlgTyCon tc         = (name, default_roles)
+  | isTypeSynonymTyCon tc = (name, default_roles)
+  | otherwise             = pprPanic "initialRoleEnv1" (ppr tc)
   where name         = tyConName tc
         tyvars       = tyConTyVars tc
         (kvs, tvs)   = span isKindVar tyvars
@@ -709,6 +710,8 @@ irTyCon tc
        ; unless (all (== Nominal) old_roles) $  -- also catches data families,
                                                 -- which don't want or need role inference
     do { whenIsJust (tyConClass_maybe tc) (irClass tc_name)
+       ; addRoleInferenceInfo tc_name (tyConTyVars tc) $
+         mapM_ (irType emptyVarSet) (tyConStupidTheta tc)  -- See #8958
        ; mapM_ (irDataCon tc_name) (visibleDataCons $ algTyConRhs tc) }}
 
   | Just (SynonymTyCon ty) <- synTyConRhs_maybe tc
@@ -778,7 +781,7 @@ lookupRoles tc
            Just roles -> return roles
            Nothing    -> return $ tyConRoles tc }
 
--- tries to update a role; won't even update a role "downwards"
+-- tries to update a role; won't ever update a role "downwards"
 updateRole :: Role -> TyVar -> RoleM ()
 updateRole role tv
   = do { var_ns <- getVarNs
diff --git a/compiler/typecheck/TcType.lhs b/compiler/typecheck/TcType.lhs
index 55c37b9506c8..f12ec9d6d541 100644
--- a/compiler/typecheck/TcType.lhs
+++ b/compiler/typecheck/TcType.lhs
@@ -15,6 +15,8 @@ The "tc" prefix is for "TypeChecker", because the type checker
 is the principal client.
 
 \begin{code}
+{-# LANGUAGE CPP #-}
+
 module TcType (
   --------------------------------
   -- Types
@@ -93,8 +95,6 @@ module TcType (
   isFFIPrimArgumentTy, -- :: DynFlags -> Type -> Bool
   isFFIPrimResultTy,   -- :: DynFlags -> Type -> Bool
   isFFILabelTy,        -- :: Type -> Bool
-  isFFIDotnetTy,       -- :: DynFlags -> Type -> Bool
-  isFFIDotnetObjTy,    -- :: Type -> Bool
   isFFITy,             -- :: Type -> Bool
   isFunPtrTy,          -- :: Type -> Bool
   tcSplitIOType_maybe, -- :: Type -> Maybe Type
@@ -173,6 +173,7 @@ import Maybes
 import ListSetOps
 import Outputable
 import FastString
+import ErrUtils( Validity(..), isValid )
 
 import Data.IORef
 import Control.Monad (liftM, ap)
@@ -245,34 +246,23 @@ checking.  It's attached to mutable type variables only.
 It's knot-tied back to Var.lhs.  There is no reason in principle
 why Var.lhs shouldn't actually have the definition, but it "belongs" here.
 
-
 Note [Signature skolems]
 ~~~~~~~~~~~~~~~~~~~~~~~~
 Consider this
 
-  x :: [a]
-  y :: b
-  (x,y,z) = ([y,z], z, head x)
-
-Here, x and y have type sigs, which go into the environment.  We used to
-instantiate their types with skolem constants, and push those types into
-the RHS, so we'd typecheck the RHS with type
-        ( [a*], b*, c )
-where a*, b* are skolem constants, and c is an ordinary meta type varible.
-
-The trouble is that the occurrences of z in the RHS force a* and b* to
-be the *same*, so we can't make them into skolem constants that don't unify
-with each other.  Alas.
+  f :: forall a. [a] -> Int
+  f (x::b : xs) = 3
 
-One solution would be insist that in the above defn the programmer uses
-the same type variable in both type signatures.  But that takes explanation.
-
-The alternative (currently implemented) is to have a special kind of skolem
-constant, SigTv, which can unify with other SigTvs.  These are *not* treated
-as rigid for the purposes of GADTs.  And they are used *only* for pattern
-bindings and mutually recursive function bindings.  See the function
-TcBinds.tcInstSig, and its use_skols parameter.
+Here 'b' is a lexically scoped type variable, but it turns out to be
+the same as the skolem 'a'.  So we have a special kind of skolem
+constant, SigTv, which can unify with other SigTvs. They are used
+*only* for pattern type signatures.
 
+Similarly consider
+  data T (a:k1) = MkT (S a)
+  data S (b:k2) = MkS (T b)
+When doing kind inference on {S,T} we don't want *skolems* for k1,k2,
+because they end up unifying; we want those SigTvs again.
 
 \begin{code}
 -- A TyVarDetails is inside a TyVar
@@ -489,7 +479,7 @@ pprTcTyVarDetails (MetaTv { mtv_info = info, mtv_untch = untch })
 pprUserTypeCtxt :: UserTypeCtxt -> SDoc
 pprUserTypeCtxt (InfSigCtxt n)    = ptext (sLit "the inferred type for") <+> quotes (ppr n)
 pprUserTypeCtxt (FunSigCtxt n)    = ptext (sLit "the type signature for") <+> quotes (ppr n)
-pprUserTypeCtxt (RuleSigCtxt n)    = ptext (sLit "a RULE for") <+> quotes (ppr n)
+pprUserTypeCtxt (RuleSigCtxt n)   = ptext (sLit "a RULE for") <+> quotes (ppr n)
 pprUserTypeCtxt ExprSigCtxt       = ptext (sLit "an expression type signature")
 pprUserTypeCtxt (ConArgCtxt c)    = ptext (sLit "the type of the constructor") <+> quotes (ppr c)
 pprUserTypeCtxt (TySynCtxt c)     = ptext (sLit "the RHS of the type synonym") <+> quotes (ppr c)
@@ -745,7 +735,7 @@ mkTcEqPred :: TcType -> TcType -> Type
 mkTcEqPred ty1 ty2
   = mkTyConApp eqTyCon [k, ty1, ty2]
   where
-    k = defaultKind (typeKind ty1)
+    k = typeKind ty1
 \end{code}
 
 @isTauTy@ tests for nested for-alls.  It should not be called on a boxy type.
@@ -945,7 +935,7 @@ tcGetTyVar :: String -> Type -> TyVar
 tcGetTyVar msg ty = expectJust msg (tcGetTyVar_maybe ty)
 
 tcIsTyVarTy :: Type -> Bool
-tcIsTyVarTy ty = maybeToBool (tcGetTyVar_maybe ty)
+tcIsTyVarTy ty = isJust (tcGetTyVar_maybe ty)
 
 -----------------------
 tcSplitDFunTy :: Type -> ([TyVar], [Type], Class, [Type])
@@ -972,7 +962,7 @@ tcInstHeadTyNotSynonym :: Type -> Bool
 -- are transparent, so we need a special function here
 tcInstHeadTyNotSynonym ty
   = case ty of
-        TyConApp tc _ -> not (isSynTyCon tc)
+        TyConApp tc _ -> not (isTypeSynonymTyCon tc)
         _ -> True
 
 tcInstHeadTyAppAllTyVars :: Type -> Bool
@@ -992,7 +982,7 @@ tcInstHeadTyAppAllTyVars ty
         -- and that each is distinct
     ok tys = equalLength tvs tys && hasNoDups tvs
            where
-             tvs = mapCatMaybes get_tv tys
+             tvs = mapMaybe get_tv tys
 
     get_tv (TyVarTy tv)  = Just tv      -- through synonyms
     get_tv _             = Nothing
@@ -1018,7 +1008,8 @@ tcEqType ty1 ty2
                  | Just t2' <- tcView t2 = go env t1 t2'
     go env (TyVarTy tv1)       (TyVarTy tv2)     = rnOccL env tv1 == rnOccR env tv2
     go _   (LitTy lit1)        (LitTy lit2)      = lit1 == lit2
-    go env (ForAllTy tv1 t1)   (ForAllTy tv2 t2) = go (rnBndr2 env tv1 tv2) t1 t2
+    go env (ForAllTy tv1 t1)   (ForAllTy tv2 t2) = go env (tyVarKind tv1) (tyVarKind tv2)
+                                                && go (rnBndr2 env tv1 tv2) t1 t2
     go env (AppTy s1 t1)       (AppTy s2 t2)     = go env s1 s2 && go env t1 t2
     go env (FunTy s1 t1)       (FunTy s2 t2)     = go env s1 s2 && go env t1 t2
     go env (TyConApp tc1 ts1) (TyConApp tc2 ts2) = (tc1 == tc2) && gos env ts1 ts2
@@ -1037,7 +1028,8 @@ pickyEqType ty1 ty2
     init_env = mkRnEnv2 (mkInScopeSet (tyVarsOfType ty1 `unionVarSet` tyVarsOfType ty2))
     go env (TyVarTy tv1)       (TyVarTy tv2)     = rnOccL env tv1 == rnOccR env tv2
     go _   (LitTy lit1)        (LitTy lit2)      = lit1 == lit2
-    go env (ForAllTy tv1 t1)   (ForAllTy tv2 t2) = go (rnBndr2 env tv1 tv2) t1 t2
+    go env (ForAllTy tv1 t1)   (ForAllTy tv2 t2) = go env (tyVarKind tv1) (tyVarKind tv2)
+                                                && go (rnBndr2 env tv1 tv2) t1 t2
     go env (AppTy s1 t1)       (AppTy s2 t2)     = go env s1 s2 && go env t1 t2
     go env (FunTy s1 t1)       (FunTy s2 t2)     = go env s1 s2 && go env t1 t2
     go env (TyConApp tc1 ts1) (TyConApp tc2 ts2) = (tc1 == tc2) && gos env ts1 ts2
@@ -1427,25 +1419,25 @@ tcSplitIOType_maybe ty
 
 isFFITy :: Type -> Bool
 -- True for any TyCon that can possibly be an arg or result of an FFI call
-isFFITy ty = checkRepTyCon legalFFITyCon ty
+isFFITy ty = isValid (checkRepTyCon legalFFITyCon ty empty)
 
-isFFIArgumentTy :: DynFlags -> Safety -> Type -> Bool
+isFFIArgumentTy :: DynFlags -> Safety -> Type -> Validity
 -- Checks for valid argument type for a 'foreign import'
 isFFIArgumentTy dflags safety ty
-   = checkRepTyCon (legalOutgoingTyCon dflags safety) ty
+   = checkRepTyCon (legalOutgoingTyCon dflags safety) ty empty
 
-isFFIExternalTy :: Type -> Bool
+isFFIExternalTy :: Type -> Validity
 -- Types that are allowed as arguments of a 'foreign export'
-isFFIExternalTy ty = checkRepTyCon legalFEArgTyCon ty
+isFFIExternalTy ty = checkRepTyCon legalFEArgTyCon ty empty
 
-isFFIImportResultTy :: DynFlags -> Type -> Bool
+isFFIImportResultTy :: DynFlags -> Type -> Validity
 isFFIImportResultTy dflags ty
-  = checkRepTyCon (legalFIResultTyCon dflags) ty
+  = checkRepTyCon (legalFIResultTyCon dflags) ty empty
 
-isFFIExportResultTy :: Type -> Bool
-isFFIExportResultTy ty = checkRepTyCon legalFEResultTyCon ty
+isFFIExportResultTy :: Type -> Validity
+isFFIExportResultTy ty = checkRepTyCon legalFEResultTyCon ty empty
 
-isFFIDynTy :: Type -> Type -> Bool
+isFFIDynTy :: Type -> Type -> Validity
 -- The type in a foreign import dynamic must be Ptr, FunPtr, or a newtype of
 -- either, and the wrapped function type must be equal to the given type.
 -- We assume that all types have been run through normalizeFfiType, so we don't
@@ -1457,60 +1449,54 @@ isFFIDynTy expected ty
     | Just (tc, [ty']) <- splitTyConApp_maybe ty
     , tyConUnique tc `elem` [ptrTyConKey, funPtrTyConKey]
     , eqType ty' expected
-    = True
+    = IsValid
     | otherwise
-    = False
+    = NotValid (vcat [ ptext (sLit "Expected: Ptr/FunPtr") <+> pprParendType expected <> comma
+                     , ptext (sLit "  Actual:") <+> ppr ty ])
 
-isFFILabelTy :: Type -> Bool
+isFFILabelTy :: Type -> Validity
 -- The type of a foreign label must be Ptr, FunPtr, or a newtype of either.
-isFFILabelTy = checkRepTyConKey [ptrTyConKey, funPtrTyConKey]
+isFFILabelTy ty = checkRepTyCon ok ty extra
+  where
+    ok tc = tc `hasKey` funPtrTyConKey || tc `hasKey` ptrTyConKey 
+    extra = ptext (sLit "A foreign-imported address (via &foo) must have type (Ptr a) or (FunPtr a)")
 
-isFFIPrimArgumentTy :: DynFlags -> Type -> Bool
+isFFIPrimArgumentTy :: DynFlags -> Type -> Validity
 -- Checks for valid argument type for a 'foreign import prim'
 -- Currently they must all be simple unlifted types, or the well-known type
 -- Any, which can be used to pass the address to a Haskell object on the heap to
 -- the foreign function.
 isFFIPrimArgumentTy dflags ty
-   = isAnyTy ty || checkRepTyCon (legalFIPrimArgTyCon dflags) ty
+  | isAnyTy ty = IsValid
+  | otherwise  = checkRepTyCon (legalFIPrimArgTyCon dflags) ty empty
 
-isFFIPrimResultTy :: DynFlags -> Type -> Bool
+isFFIPrimResultTy :: DynFlags -> Type -> Validity
 -- Checks for valid result type for a 'foreign import prim'
 -- Currently it must be an unlifted type, including unboxed tuples.
 isFFIPrimResultTy dflags ty
-   = checkRepTyCon (legalFIPrimResultTyCon dflags) ty
-
-isFFIDotnetTy :: DynFlags -> Type -> Bool
-isFFIDotnetTy dflags ty
-  = checkRepTyCon (\ tc -> (legalFIResultTyCon dflags tc ||
-                           isFFIDotnetObjTy ty || isStringTy ty)) ty
-        -- NB: isStringTy used to look through newtypes, but
-        --     it no longer does so.  May need to adjust isFFIDotNetTy
-        --     if we do want to look through newtypes.
-
-isFFIDotnetObjTy :: Type -> Bool
-isFFIDotnetObjTy ty
-  = checkRepTyCon check_tc t_ty
-  where
-   (_, t_ty) = tcSplitForAllTys ty
-   check_tc tc = getName tc == objectTyConName
+   = checkRepTyCon (legalFIPrimResultTyCon dflags) ty empty
 
 isFunPtrTy :: Type -> Bool
-isFunPtrTy = checkRepTyConKey [funPtrTyConKey]
+isFunPtrTy ty = isValid (checkRepTyCon (`hasKey` funPtrTyConKey) ty empty)
 
 -- normaliseFfiType gets run before checkRepTyCon, so we don't
 -- need to worry about looking through newtypes or type functions
 -- here; that's already been taken care of.
-checkRepTyCon :: (TyCon -> Bool) -> Type -> Bool
-checkRepTyCon check_tc ty
-    | Just (tc, _) <- splitTyConApp_maybe ty
-    = check_tc tc
-    | otherwise
-    = False
-
-checkRepTyConKey :: [Unique] -> Type -> Bool
--- Like checkRepTyCon, but just looks at the TyCon key
-checkRepTyConKey keys
-  = checkRepTyCon (\tc -> tyConUnique tc `elem` keys)
+checkRepTyCon :: (TyCon -> Bool) -> Type -> SDoc -> Validity
+checkRepTyCon check_tc ty extra
+  = case splitTyConApp_maybe ty of
+      Just (tc, tys)
+        | isNewTyCon tc -> NotValid (hang msg 2 (mk_nt_reason tc tys $$ nt_fix))
+        | check_tc tc   -> IsValid
+        | otherwise     -> NotValid (msg $$ extra)
+      Nothing -> NotValid (quotes (ppr ty) <+> ptext (sLit "is not a data type") $$ extra)
+  where
+    msg = quotes (ppr ty) <+> ptext (sLit "cannot be marshalled in a foreign call")
+    mk_nt_reason tc tys
+      | null tys  = ptext (sLit "because its data construtor is not in scope")
+      | otherwise = ptext (sLit "because the data construtor for")
+                    <+> quotes (ppr tc) <+> ptext (sLit "is not in scope")
+    nt_fix = ptext (sLit "Possible fix: import the data constructor to bring it into scope")
 \end{code}
 
 Note [Foreign import dynamic]
@@ -1557,21 +1543,25 @@ legalOutgoingTyCon dflags _ tc
 legalFFITyCon :: TyCon -> Bool
 -- True for any TyCon that can possibly be an arg or result of an FFI call
 legalFFITyCon tc
-  = isUnLiftedTyCon tc || boxedMarshalableTyCon tc || tc == unitTyCon
+  | isUnLiftedTyCon tc = True
+  | tc == unitTyCon    = True
+  | otherwise          = boxedMarshalableTyCon tc
 
 marshalableTyCon :: DynFlags -> TyCon -> Bool
 marshalableTyCon dflags tc
-  =  (xopt Opt_UnliftedFFITypes dflags
+  |  (xopt Opt_UnliftedFFITypes dflags
       && isUnLiftedTyCon tc
       && not (isUnboxedTupleTyCon tc)
       && case tyConPrimRep tc of        -- Note [Marshalling VoidRep]
            VoidRep -> False
            _       -> True)
-  || boxedMarshalableTyCon tc
+  = True
+  | otherwise
+  = boxedMarshalableTyCon tc
 
 boxedMarshalableTyCon :: TyCon -> Bool
 boxedMarshalableTyCon tc
-   = getUnique tc `elem` [ intTyConKey, int8TyConKey, int16TyConKey
+   | getUnique tc `elem` [ intTyConKey, int8TyConKey, int16TyConKey
                          , int32TyConKey, int64TyConKey
                          , wordTyConKey, word8TyConKey, word16TyConKey
                          , word32TyConKey, word64TyConKey
@@ -1581,26 +1571,35 @@ boxedMarshalableTyCon tc
                          , stablePtrTyConKey
                          , boolTyConKey
                          ]
+  = True
+
+  | otherwise = False
 
 legalFIPrimArgTyCon :: DynFlags -> TyCon -> Bool
 -- Check args of 'foreign import prim', only allow simple unlifted types.
 -- Strictly speaking it is unnecessary to ban unboxed tuples here since
 -- currently they're of the wrong kind to use in function args anyway.
 legalFIPrimArgTyCon dflags tc
-  = xopt Opt_UnliftedFFITypes dflags
+  | xopt Opt_UnliftedFFITypes dflags
     && isUnLiftedTyCon tc
     && not (isUnboxedTupleTyCon tc)
+  = True
+  | otherwise
+  = False
 
 legalFIPrimResultTyCon :: DynFlags -> TyCon -> Bool
 -- Check result type of 'foreign import prim'. Allow simple unlifted
 -- types and also unboxed tuple result types '... -> (# , , #)'
 legalFIPrimResultTyCon dflags tc
-  = xopt Opt_UnliftedFFITypes dflags
+  | xopt Opt_UnliftedFFITypes dflags
     && isUnLiftedTyCon tc
     && (isUnboxedTupleTyCon tc
         || case tyConPrimRep tc of      -- Note [Marshalling VoidRep]
            VoidRep -> False
            _       -> True)
+  = True
+  | otherwise
+  = False
 \end{code}
 
 Note [Marshalling VoidRep]
diff --git a/compiler/typecheck/TcTypeNats.hs b/compiler/typecheck/TcTypeNats.hs
index c19164bf4b04..37fc6e0cdbcd 100644
--- a/compiler/typecheck/TcTypeNats.hs
+++ b/compiler/typecheck/TcTypeNats.hs
@@ -12,9 +12,14 @@ import Coercion   ( Role(..) )
 import TcRnTypes  ( Xi )
 import CoAxiom    ( CoAxiomRule(..), BuiltInSynFamily(..) )
 import Name       ( Name, BuiltInSyntax(..) )
-import TysWiredIn ( typeNatKind, mkWiredInTyConName
+import TysWiredIn ( typeNatKind, typeSymbolKind
+                  , mkWiredInTyConName
                   , promotedBoolTyCon
                   , promotedFalseDataCon, promotedTrueDataCon
+                  , promotedOrderingTyCon
+                  , promotedLTDataCon
+                  , promotedEQDataCon
+                  , promotedGTDataCon
                   )
 import TysPrim    ( tyVarList, mkArrowKinds )
 import PrelNames  ( gHC_TYPELITS
@@ -23,6 +28,8 @@ import PrelNames  ( gHC_TYPELITS
                   , typeNatExpTyFamNameKey
                   , typeNatLeqTyFamNameKey
                   , typeNatSubTyFamNameKey
+                  , typeNatCmpTyFamNameKey
+                  , typeSymbolCmpTyFamNameKey
                   )
 import FastString ( FastString, fsLit )
 import qualified Data.Map as Map
@@ -39,6 +46,8 @@ typeNatTyCons =
   , typeNatExpTyCon
   , typeNatLeqTyCon
   , typeNatSubTyCon
+  , typeNatCmpTyCon
+  , typeSymbolCmpTyCon
   ]
 
 typeNatAddTyCon :: TyCon
@@ -103,6 +112,45 @@ typeNatLeqTyCon =
     , sfInteractInert = interactInertLeq
     }
 
+typeNatCmpTyCon :: TyCon
+typeNatCmpTyCon =
+  mkSynTyCon name
+    (mkArrowKinds [ typeNatKind, typeNatKind ] orderingKind)
+    (take 2 $ tyVarList typeNatKind)
+    [Nominal,Nominal]
+    (BuiltInSynFamTyCon ops)
+    NoParentTyCon
+
+  where
+  name = mkWiredInTyConName UserSyntax gHC_TYPELITS (fsLit "CmpNat")
+                typeNatCmpTyFamNameKey typeNatCmpTyCon
+  ops = BuiltInSynFamily
+    { sfMatchFam      = matchFamCmpNat
+    , sfInteractTop   = interactTopCmpNat
+    , sfInteractInert = \_ _ _ _ -> []
+    }
+
+typeSymbolCmpTyCon :: TyCon
+typeSymbolCmpTyCon =
+  mkSynTyCon name
+    (mkArrowKinds [ typeSymbolKind, typeSymbolKind ] orderingKind)
+    (take 2 $ tyVarList typeSymbolKind)
+    [Nominal,Nominal]
+    (BuiltInSynFamTyCon ops)
+    NoParentTyCon
+
+  where
+  name = mkWiredInTyConName UserSyntax gHC_TYPELITS (fsLit "CmpSymbol")
+                typeSymbolCmpTyFamNameKey typeSymbolCmpTyCon
+  ops = BuiltInSynFamily
+    { sfMatchFam      = matchFamCmpSymbol
+    , sfInteractTop   = interactTopCmpSymbol
+    , sfInteractInert = \_ _ _ _ -> []
+    }
+
+
+
+
 
 -- Make a binary built-in constructor of kind: Nat -> Nat -> Nat
 mkTypeNatFunTyCon2 :: Name -> BuiltInSynFamily -> TyCon
@@ -127,6 +175,8 @@ axAddDef
   , axMulDef
   , axExpDef
   , axLeqDef
+  , axCmpNatDef
+  , axCmpSymbolDef
   , axAdd0L
   , axAdd0R
   , axMul0L
@@ -137,6 +187,8 @@ axAddDef
   , axExp0R
   , axExp1R
   , axLeqRefl
+  , axCmpNatRefl
+  , axCmpSymbolRefl
   , axLeq0L
   , axSubDef
   , axSub0R
@@ -154,6 +206,25 @@ axExpDef = mkBinAxiom "ExpDef" typeNatExpTyCon $
 axLeqDef = mkBinAxiom "LeqDef" typeNatLeqTyCon $
               \x y -> Just $ bool (x <= y)
 
+axCmpNatDef   = mkBinAxiom "CmpNatDef" typeNatCmpTyCon
+              $ \x y -> Just $ ordering (compare x y)
+
+axCmpSymbolDef =
+  CoAxiomRule
+    { coaxrName      = fsLit "CmpSymbolDef"
+    , coaxrTypeArity = 2
+    , coaxrAsmpRoles = []
+    , coaxrRole      = Nominal
+    , coaxrProves    = \ts cs ->
+        case (ts,cs) of
+          ([s,t],[]) ->
+            do x <- isStrLitTy s
+               y <- isStrLitTy t
+               return (mkTyConApp typeSymbolCmpTyCon [s,t] ===
+                      ordering (compare x y))
+          _ -> Nothing
+    }
+
 axSubDef = mkBinAxiom "SubDef" typeNatSubTyCon $
               \x y -> fmap num (minus x y)
 
@@ -168,6 +239,10 @@ axExp1L     = mkAxiom1 "Exp1L"    $ \t -> (num 1 .^. t) === num 1
 axExp0R     = mkAxiom1 "Exp0R"    $ \t -> (t .^. num 0) === num 1
 axExp1R     = mkAxiom1 "Exp1R"    $ \t -> (t .^. num 1) === t
 axLeqRefl   = mkAxiom1 "LeqRefl"  $ \t -> (t <== t) === bool True
+axCmpNatRefl    = mkAxiom1 "CmpNatRefl"
+                $ \t -> (cmpNat t t) === ordering EQ
+axCmpSymbolRefl = mkAxiom1 "CmpSymbolRefl"
+                $ \t -> (cmpSymbol t t) === ordering EQ
 axLeq0L     = mkAxiom1 "Leq0L"    $ \t -> (num 0 <== t) === bool True
 
 typeNatCoAxiomRules :: Map.Map FastString CoAxiomRule
@@ -176,6 +251,8 @@ typeNatCoAxiomRules = Map.fromList $ map (\x -> (coaxrName x, x))
   , axMulDef
   , axExpDef
   , axLeqDef
+  , axCmpNatDef
+  , axCmpSymbolDef
   , axAdd0L
   , axAdd0R
   , axMul0L
@@ -186,6 +263,8 @@ typeNatCoAxiomRules = Map.fromList $ map (\x -> (coaxrName x, x))
   , axExp0R
   , axExp1R
   , axLeqRefl
+  , axCmpNatRefl
+  , axCmpSymbolRefl
   , axLeq0L
   , axSubDef
   ]
@@ -211,6 +290,12 @@ s .^. t = mkTyConApp typeNatExpTyCon [s,t]
 (<==) :: Type -> Type -> Type
 s <== t = mkTyConApp typeNatLeqTyCon [s,t]
 
+cmpNat :: Type -> Type -> Type
+cmpNat s t = mkTyConApp typeNatCmpTyCon [s,t]
+
+cmpSymbol :: Type -> Type -> Type
+cmpSymbol s t = mkTyConApp typeSymbolCmpTyCon [s,t]
+
 (===) :: Type -> Type -> Pair Type
 x === y = Pair x y
 
@@ -232,6 +317,25 @@ isBoolLitTy tc =
          | tc == promotedTrueDataCon  -> return True
          | otherwise                   -> Nothing
 
+orderingKind :: Kind
+orderingKind = mkTyConApp promotedOrderingTyCon []
+
+ordering :: Ordering -> Type
+ordering o =
+  case o of
+    LT -> mkTyConApp promotedLTDataCon []
+    EQ -> mkTyConApp promotedEQDataCon []
+    GT -> mkTyConApp promotedGTDataCon []
+
+isOrderingLitTy :: Type -> Maybe Ordering
+isOrderingLitTy tc =
+  do (tc1,[]) <- splitTyConApp_maybe tc
+     case () of
+       _ | tc1 == promotedLTDataCon -> return LT
+         | tc1 == promotedEQDataCon -> return EQ
+         | tc1 == promotedGTDataCon -> return GT
+         | otherwise                -> Nothing
+
 known :: (Integer -> Bool) -> TcType -> Bool
 known p x = case isNumLitTy x of
               Just a  -> p a
@@ -258,6 +362,8 @@ mkBinAxiom str tc f =
           _ -> Nothing
     }
 
+
+
 mkAxiom1 :: String -> (Type -> Pair Type) -> CoAxiomRule
 mkAxiom1 str f =
   CoAxiomRule
@@ -328,6 +434,25 @@ matchFamLeq [s,t]
         mbY = isNumLitTy t
 matchFamLeq _ = Nothing
 
+matchFamCmpNat :: [Type] -> Maybe (CoAxiomRule, [Type], Type)
+matchFamCmpNat [s,t]
+  | Just x <- mbX, Just y <- mbY =
+    Just (axCmpNatDef, [s,t], ordering (compare x y))
+  | tcEqType s t = Just (axCmpNatRefl, [s], ordering EQ)
+  where mbX = isNumLitTy s
+        mbY = isNumLitTy t
+matchFamCmpNat _ = Nothing
+
+matchFamCmpSymbol :: [Type] -> Maybe (CoAxiomRule, [Type], Type)
+matchFamCmpSymbol [s,t]
+  | Just x <- mbX, Just y <- mbY =
+    Just (axCmpSymbolDef, [s,t], ordering (compare x y))
+  | tcEqType s t = Just (axCmpSymbolRefl, [s], ordering EQ)
+  where mbX = isStrLitTy s
+        mbY = isStrLitTy t
+matchFamCmpSymbol _ = Nothing
+
+
 {-------------------------------------------------------------------------------
 Interact with axioms
 -------------------------------------------------------------------------------}
@@ -415,6 +540,17 @@ interactTopLeq [s,t] r
   mbZ = isBoolLitTy r
 interactTopLeq _ _ = []
 
+interactTopCmpNat :: [Xi] -> Xi -> [Pair Type]
+interactTopCmpNat [s,t] r
+  | Just EQ <- isOrderingLitTy r = [ s === t ]
+interactTopCmpNat _ _ = []
+
+interactTopCmpSymbol :: [Xi] -> Xi -> [Pair Type]
+interactTopCmpSymbol [s,t] r
+  | Just EQ <- isOrderingLitTy r = [ s === t ]
+interactTopCmpSymbol _ _ = []
+
+
 
 
 {-------------------------------------------------------------------------------
@@ -466,6 +602,10 @@ interactInertLeq _ _ _ _ = []
 
 
 
+
+
+
+
 {- -----------------------------------------------------------------------------
 These inverse functions are used for simplifying propositions using
 concrete natural numbers.
diff --git a/compiler/typecheck/TcUnify.lhs b/compiler/typecheck/TcUnify.lhs
index 94b6aebeb543..ef06ddd2634c 100644
--- a/compiler/typecheck/TcUnify.lhs
+++ b/compiler/typecheck/TcUnify.lhs
@@ -6,7 +6,8 @@
 Type subsumption and unification
 
 \begin{code}
-{-# OPTIONS -fno-warn-tabs #-}
+{-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
 -- The above warning supression flag is a temporary kludge.
 -- While working on this module you are encouraged to remove it and
 -- detab the module (please do the detabbing in a separate patch). See
@@ -824,8 +825,8 @@ uUnfilledVars origin swapped tv1 details1 tv2 details2
 	   -- k1 = k2, so we are free to update either way
            (EQ, MetaTv { mtv_info = i1, mtv_ref = ref1 }, 
                 MetaTv { mtv_info = i2, mtv_ref = ref2 })
-                | nicer_to_update_tv1 i1 i2 -> updateMeta tv1 ref1 ty2
-                | otherwise                 -> updateMeta tv2 ref2 ty1
+                | nicer_to_update_tv1 tv1 i1 i2 -> updateMeta tv1 ref1 ty2
+                | otherwise                     -> updateMeta tv2 ref2 ty1
            (EQ, MetaTv { mtv_ref = ref1 }, _) -> updateMeta tv1 ref1 ty2
            (EQ, _, MetaTv { mtv_ref = ref2 }) -> updateMeta tv2 ref2 ty1
 
@@ -838,9 +839,10 @@ 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 _         _ = isSystemName (Var.varName tv1)
+nicer_to_update_tv1 :: TcTyVar -> MetaInfo -> MetaInfo -> Bool
+nicer_to_update_tv1 _   _     SigTv = True
+nicer_to_update_tv1 _   SigTv _     = False
+nicer_to_update_tv1 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
         -- instantiating a polymorphic function with a user-written
@@ -1069,6 +1071,31 @@ one of argTypeKind or openTypeKind.
 The situation is different in the core of the compiler, where we are perfectly
 happy to have types of kind Constraint on either end of an arrow.
 
+Note [Kind variables can be untouchable]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+We must use the careful function lookupTcTyVar to see if a kind
+variable is filled or unifiable.  It checks for touchablity, and kind
+variables can certainly be untouchable --- for example the variable
+might be bound outside an enclosing existental pattern match that
+binds an inner kind variable, which we don't want ot escape outside.
+
+This, or something closely related, was teh cause of Trac #8985.
+
+Note [Unifying kind variables]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Rather hackily, kind variables can be TyVars not just TcTyVars.
+Main reason is in
+   data instance T (D (x :: k)) = ...con-decls...
+Here we bring into scope a kind variable 'k', and use it in the
+con-decls.  BUT the con-decls will be finished and frozen, and
+are not amenable to subsequent substitution, so it makes sense
+to have the *final* kind-variable (a KindVar, not a TcKindVar) in
+scope.  So at least during kind unification we can encounter a
+KindVar.
+
+Hence the isTcTyVar tests before calling lookupTcTyVar.
+
+
 \begin{code}
 matchExpectedFunKind :: TcKind -> TcM (Maybe (TcKind, TcKind))
 -- Like unifyFunTy, but does not fail; instead just returns Nothing
@@ -1117,37 +1144,66 @@ unifyKindX (TyConApp kc1 []) (TyConApp kc2 [])
 unifyKindX k1 k2 = unifyKindEq k1 k2
   -- In all other cases, let unifyKindEq do the work
 
+-------------------
 uKVar :: SwapFlag -> (TcKind -> TcKind -> TcM (Maybe Ordering))
       -> MetaKindVar -> TcKind -> TcM (Maybe Ordering)
 uKVar swapped unify_kind kv1 k2
-  | isTcTyVar kv1, isMetaTyVar kv1       -- See Note [Unifying kind variables]
-  = do  { mb_k1 <- readMetaTyVar kv1
-        ; case mb_k1 of
-            Flexi -> uUnboundKVar kv1 k2
-            Indirect k1 -> unSwap swapped unify_kind k1 k2 }
-  | TyVarTy kv2 <- k2, kv1 == kv2 
+  | isTcTyVar kv1
+  = do { lookup_res <- lookupTcTyVar kv1  -- See Note [Kind variables can be untouchable]
+       ; case lookup_res of
+           Filled k1    -> unSwap swapped unify_kind k1 k2
+           Unfilled ds1 -> uUnfilledKVar kv1 ds1 k2 }
+
+  | otherwise   -- See Note [Unifying kind variables]
+  = uUnfilledKVar kv1 vanillaSkolemTv k2
+
+-------------------
+uUnfilledKVar :: MetaKindVar -> TcTyVarDetails -> TcKind -> TcM (Maybe Ordering)
+uUnfilledKVar kv1 ds1 (TyVarTy kv2)
+  | kv1 == kv2
   = return (Just EQ)
 
-  | TyVarTy kv2 <- k2, isTcTyVar kv2, isMetaTyVar kv2
-  = uKVar (flipSwap swapped) unify_kind kv2 (TyVarTy kv1)
+  | isTcTyVar kv2
+  = do { lookup_res <- lookupTcTyVar kv2
+       ; case lookup_res of
+           Filled k2    -> uUnfilledKVar  kv1 ds1 k2
+           Unfilled ds2 -> uUnfilledKVars kv1 ds1 kv2 ds2 }
 
-  | otherwise 
-  = return Nothing
+  | otherwise  -- See Note [Unifying kind variables]
+  = uUnfilledKVars kv1 ds1 kv2 vanillaSkolemTv
 
-{- Note [Unifying kind variables]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Rather hackily, kind variables can be TyVars not just TcTyVars.
-Main reason is in 
-   data instance T (D (x :: k)) = ...con-decls...
-Here we bring into scope a kind variable 'k', and use it in the 
-con-decls.  BUT the con-decls will be finished and frozen, and
-are not amenable to subsequent substitution, so it makes sense
-to have the *final* kind-variable (a KindVar, not a TcKindVar) in 
-scope.  So at least during kind unification we can encounter a
-KindVar. 
-
-Hence the isTcTyVar tests before using isMetaTyVar.
--}
+uUnfilledKVar kv1 ds1 non_var_k2
+  = case ds1 of
+      MetaTv { mtv_info = SigTv }
+        -> return Nothing
+      MetaTv { mtv_ref = ref1 }
+        -> do { k2a <- zonkTcKind non_var_k2
+              ; let k2b = defaultKind k2a
+                     -- MetaKindVars must be bound only to simple kinds
+
+              ; dflags <- getDynFlags
+              ; case occurCheckExpand dflags kv1 k2b of
+                   OC_OK k2c -> do { writeMetaTyVarRef kv1 ref1 k2c; return (Just EQ) }
+                   _         -> return Nothing }
+      _ -> return Nothing
+
+-------------------
+uUnfilledKVars :: MetaKindVar -> TcTyVarDetails
+               -> MetaKindVar -> TcTyVarDetails
+               -> TcM (Maybe Ordering)
+-- kv1 /= kv2
+uUnfilledKVars kv1 ds1 kv2 ds2
+  = case (ds1, ds2) of
+      (MetaTv { mtv_info = i1, mtv_ref = r1 },
+       MetaTv { mtv_info = i2, mtv_ref = r2 })
+              | nicer_to_update_tv1 kv1 i1 i2 -> do_update kv1 r1 kv2
+              | otherwise                     -> do_update kv2 r2 kv1
+      (MetaTv { mtv_ref = r1 }, _) -> do_update kv1 r1 kv2
+      (_, MetaTv { mtv_ref = r2 }) -> do_update kv2 r2 kv1
+      _ -> return Nothing
+  where
+    do_update kv1 r1 kv2
+      = do { writeMetaTyVarRef kv1 r1 (mkTyVarTy kv2); return (Just EQ) }
 
 ---------------------------
 unifyKindEq :: TcKind -> TcKind -> TcM (Maybe Ordering)
@@ -1159,41 +1215,16 @@ unifyKindEq k1 (TyVarTy kv2) = uKVar IsSwapped  unifyKindEq kv2 k1
 unifyKindEq (FunTy a1 r1) (FunTy a2 r2)
   = do { mb1 <- unifyKindEq a1 a2; mb2 <- unifyKindEq r1 r2
        ; return (if isJust mb1 && isJust mb2 then Just EQ else Nothing) }
-  
+
 unifyKindEq (TyConApp kc1 k1s) (TyConApp kc2 k2s)
   | kc1 == kc2
   = ASSERT(length k1s == length k2s)
-       -- Should succeed since the kind constructors are the same, 
+       -- Should succeed since the kind constructors are the same,
        -- and the kinds are sort-checked, thus fully applied
     do { mb_eqs <- zipWithM unifyKindEq k1s k2s
-       ; return (if all isJust mb_eqs 
-                 then Just EQ 
+       ; return (if all isJust mb_eqs
+                 then Just EQ
                  else Nothing) }
 
 unifyKindEq _ _ = return Nothing
-
-----------------
-uUnboundKVar :: MetaKindVar -> TcKind -> TcM (Maybe Ordering)
-uUnboundKVar kv1 k2@(TyVarTy kv2)
-  | kv1 == kv2 = return (Just EQ)
-  | isTcTyVar kv2, isMetaTyVar kv2   -- Distinct kind variables
-  = do  { mb_k2 <- readMetaTyVar kv2
-        ; case mb_k2 of
-            Indirect k2 -> uUnboundKVar kv1 k2
-            Flexi       -> do { writeMetaTyVar kv1 k2; return (Just EQ) } }
-  | otherwise 
-  = do { writeMetaTyVar kv1 k2; return (Just EQ) }
-
-uUnboundKVar kv1 non_var_k2
-  | isSigTyVar kv1
-  = return Nothing
-  | otherwise
-  = do { k2a <- zonkTcKind non_var_k2
-       ; let k2b = defaultKind k2a
-                -- MetaKindVars must be bound only to simple kinds
-
-       ; dflags <- getDynFlags 
-       ; case occurCheckExpand dflags kv1 k2b of
-           OC_OK k2c -> do { writeMetaTyVar kv1 k2c; return (Just EQ) }
-           _         -> return Nothing }
 \end{code}
diff --git a/compiler/typecheck/TcValidity.lhs b/compiler/typecheck/TcValidity.lhs
index 20547bc51e04..f8357825a78e 100644
--- a/compiler/typecheck/TcValidity.lhs
+++ b/compiler/typecheck/TcValidity.lhs
@@ -4,6 +4,8 @@
 %
 
 \begin{code}
+{-# LANGUAGE CPP #-}
+
 module TcValidity (
   Rank, UserTypeCtxt(..), checkValidType, checkValidMonoType,
   expectedKindInCtxt, 
@@ -38,17 +40,15 @@ import Name
 import VarEnv
 import VarSet
 import ErrUtils
-import PrelNames
 import DynFlags
 import Util
-import Maybes
 import ListSetOps
 import SrcLoc
 import Outputable
 import FastString
-import BasicTypes ( Arity )
 
 import Control.Monad
+import Data.Maybe
 import Data.List        ( (\\) )
 \end{code}
  
@@ -68,13 +68,21 @@ checkAmbiguity ctxt ty
                         -- Then :k T should work in GHCi, not complain that
                         -- (T k) is ambiguous!
 
+  | InfSigCtxt {} <- ctxt  -- See Note [Validity of inferred types] in TcBinds
+  = return () 
+
   | otherwise
   = do { traceTc "Ambiguity check for" (ppr ty)
-       ; (subst, _tvs) <- tcInstSkolTyVars (varSetElems (tyVarsOfType ty))
+       ; let free_tkvs = varSetElemsKvsFirst (closeOverKinds (tyVarsOfType ty))
+       ; (subst, _tvs) <- tcInstSkolTyVars free_tkvs
        ; let ty' = substTy subst ty
-              -- The type might have free TyVars,
-              -- so we skolemise them as TcTyVars
+              -- The type might have free TyVars, esp when the ambiguity check
+              -- happens during a call to checkValidType,
+              -- so we skolemise them as TcTyVars.
               -- Tiresome; but the type inference engine expects TcTyVars
+              -- NB: The free tyvar might be (a::k), so k is also free
+              --     and we must skolemise it as well. Hence closeOverKinds.
+              --     (Trac #9222)
 
          -- Solve the constraints eagerly because an ambiguous type
          -- can cause a cascade of further errors.  Since the free
@@ -286,7 +294,7 @@ check_type ctxt rank (AppTy ty1 ty2)
         ; check_arg_type ctxt rank ty2 }
 
 check_type ctxt rank ty@(TyConApp tc tys)
-  | isSynTyCon tc          = check_syn_tc_app ctxt rank ty tc tys
+  | isTypeSynonymTyCon tc  = check_syn_tc_app ctxt rank ty tc tys
   | isUnboxedTupleTyCon tc = check_ubx_tuple  ctxt      ty    tys
   | otherwise              = mapM_ (check_arg_type ctxt rank) tys
 
@@ -436,9 +444,21 @@ If we do both, we get exponential behaviour!!
 %*                                                                      *
 %************************************************************************
 
+Note [Implicit parameters in instance decls]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Implicit parameters _only_ allowed in type signatures; not in instance
+decls, superclasses etc. The reason for not allowing implicit params in
+instances is a bit subtle.  If we allowed
+  instance (?x::Int, Eq a) => Foo [a] where ...
+then when we saw
+     (e :: (?x::Int) => t)
+it would be unclear how to discharge all the potential uses of the ?x
+in e.  For example, a constraint Foo [Int] might come out of e, and
+applying the instance decl would show up two uses of ?x.  Trac #8912.
+
 \begin{code}
 checkValidTheta :: UserTypeCtxt -> ThetaType -> TcM ()
-checkValidTheta ctxt theta 
+checkValidTheta ctxt theta
   = addErrCtxt (checkThetaCtxt ctxt theta) (check_valid_theta ctxt theta)
 
 -------------------------
@@ -460,36 +480,21 @@ check_pred_ty :: DynFlags -> UserTypeCtxt -> PredType -> TcM ()
 -- type synonyms have been checked at their definition site
 
 check_pred_ty dflags ctxt pred
-  | Just (tc,tys) <- tcSplitTyConApp_maybe pred
-  = case () of 
-      _ | Just cls <- tyConClass_maybe tc
-        -> check_class_pred dflags ctxt cls tys
-
-        | tc `hasKey` eqTyConKey
-        , let [_, ty1, ty2] = tys
-        -> check_eq_pred dflags ctxt ty1 ty2
-
-        | isTupleTyCon tc
-        -> check_tuple_pred dflags ctxt pred tys
-  
-        | otherwise   -- X t1 t2, where X is presumably a
-                      -- type/data family returning ConstraintKind
-        -> check_irred_pred dflags ctxt pred tys
-
-  | (TyVarTy _, arg_tys) <- tcSplitAppTys pred
-  = check_irred_pred dflags ctxt pred arg_tys
-
-  | otherwise
-  = badPred pred
+  = case classifyPredType pred of
+      ClassPred cls tys -> check_class_pred dflags ctxt pred cls tys
+      EqPred ty1 ty2    -> check_eq_pred    dflags ctxt pred ty1 ty2
+      TuplePred tys     -> check_tuple_pred dflags ctxt pred tys
+      IrredPred _       -> check_irred_pred dflags ctxt pred
 
-badPred :: PredType -> TcM ()
-badPred pred = failWithTc (ptext (sLit "Malformed predicate") <+> quotes (ppr pred))
 
-check_class_pred :: DynFlags -> UserTypeCtxt -> Class -> [TcType] -> TcM ()
-check_class_pred dflags ctxt cls tys
+check_class_pred :: DynFlags -> UserTypeCtxt -> PredType -> Class -> [TcType] -> TcM ()
+check_class_pred dflags ctxt pred cls tys
   = do {        -- Class predicates are valid in all contexts
        ; checkTc (arity == n_tys) arity_err
 
+       ; checkTc (not (isIPClass cls) || okIPCtxt ctxt)
+                 (badIPPred pred)
+
                 -- Check the form of the argument types
        ; mapM_ checkValidMonoType tys
        ; checkTc (check_class_pred_tys dflags ctxt tys)
@@ -502,13 +507,23 @@ check_class_pred dflags ctxt cls tys
     arity_err  = arityErr "Class" class_name arity n_tys
     how_to_allow = parens (ptext (sLit "Use FlexibleContexts to permit this"))
 
+okIPCtxt :: UserTypeCtxt -> Bool
+  -- See Note [Implicit parameters in instance decls]
+okIPCtxt (ClassSCCtxt {})  = False
+okIPCtxt (InstDeclCtxt {}) = False
+okIPCtxt (SpecInstCtxt {}) = False
+okIPCtxt _                 = True
+
+badIPPred :: PredType -> SDoc
+badIPPred pred = ptext (sLit "Illegal implicit parameter") <+> quotes (ppr pred)
+
 
-check_eq_pred :: DynFlags -> UserTypeCtxt -> TcType -> TcType -> TcM ()
-check_eq_pred dflags _ctxt ty1 ty2
+check_eq_pred :: DynFlags -> UserTypeCtxt -> PredType -> TcType -> TcType -> TcM ()
+check_eq_pred dflags _ctxt pred ty1 ty2
   = do {        -- Equational constraints are valid in all contexts if type
                 -- families are permitted
        ; checkTc (xopt Opt_TypeFamilies dflags || xopt Opt_GADTs dflags) 
-                 (eqPredTyErr (mkEqPred ty1 ty2))
+                 (eqPredTyErr pred)
 
                 -- Check the form of the argument types
        ; checkValidMonoType ty1
@@ -523,8 +538,8 @@ check_tuple_pred dflags ctxt pred ts
     -- This case will not normally be executed because 
     -- without -XConstraintKinds tuple types are only kind-checked as *
 
-check_irred_pred :: DynFlags -> UserTypeCtxt -> PredType -> [TcType] -> TcM ()
-check_irred_pred dflags ctxt pred arg_tys
+check_irred_pred :: DynFlags -> UserTypeCtxt -> PredType -> TcM ()
+check_irred_pred dflags ctxt pred
     -- The predicate looks like (X t1 t2) or (x t1 t2) :: Constraint
     -- But X is not a synonym; that's been expanded already
     --
@@ -541,9 +556,9 @@ check_irred_pred dflags ctxt pred arg_tys
     --
     -- It is equally dangerous to allow them in instance heads because in that case the
     -- Paterson conditions may not detect duplication of a type variable or size change.
-  = do { checkTc (xopt Opt_ConstraintKinds dflags)
+  = do { checkValidMonoType pred
+       ; checkTc (xopt Opt_ConstraintKinds dflags)
                  (predIrredErr pred)
-       ; mapM_ checkValidMonoType arg_tys
        ; unless (xopt Opt_UndecidableInstances dflags) $
                  -- Make sure it is OK to have an irred pred in this context
          checkTc (case ctxt of ClassSCCtxt _ -> False; InstDeclCtxt -> False; _ -> True)
@@ -644,7 +659,7 @@ unambiguous. See Note [Impedence matching] in TcBinds.
 This test is very conveniently implemented by calling
     tcSubType <type> <type>
 This neatly takes account of the functional dependecy stuff above, 
-and implict parameter (see Note [Implicit parameters and ambiguity]).
+and implicit parameter (see Note [Implicit parameters and ambiguity]).
 
 What about this, though?
    g :: C [a] => Int
@@ -759,11 +774,10 @@ checkValidInstHead ctxt clas cls_args
             ; checkTc (xopt Opt_FlexibleInstances dflags ||
                        all tcInstHeadTyAppAllTyVars ty_args)
                  (instTypeErr clas cls_args head_type_args_tyvars_msg)
-            ; checkTc (xopt Opt_NullaryTypeClasses dflags ||
-                       not (null ty_args))
-                 (instTypeErr clas cls_args head_no_type_msg)
             ; checkTc (xopt Opt_MultiParamTypeClasses dflags ||
-                       length ty_args <= 1)  -- Only count type arguments
+                       length ty_args == 1 ||  -- Only count type arguments
+                       (xopt Opt_NullaryTypeClasses dflags &&
+                        null ty_args))
                  (instTypeErr clas cls_args head_one_type_msg) }
 
          -- May not contain type family applications
@@ -793,11 +807,7 @@ checkValidInstHead ctxt clas cls_args
 
     head_one_type_msg = parens (
                 text "Only one type can be given in an instance head." $$
-                text "Use MultiParamTypeClasses if you want to allow more.")
-
-    head_no_type_msg = parens (
-                text "No parameters in the instance head." $$
-                text "Use NullaryTypeClasses if you want to allow this.")
+                text "Use MultiParamTypeClasses if you want to allow more, or zero.")
 
     abstract_class_msg =
                 text "The class is abstract, manual instances are not permitted."
@@ -869,8 +879,8 @@ checkValidInstance ctxt hs_type ty
           else checkInstTermination inst_tys theta
 
         ; case (checkInstCoverage undecidable_ok clas theta inst_tys) of
-            Nothing  -> return ()   -- Check succeeded
-            Just msg -> addErrTc (instTypeErr clas inst_tys msg)
+            IsValid  -> return ()   -- Check succeeded
+            NotValid msg -> addErrTc (instTypeErr clas inst_tys msg)
                   
         ; return (tvs, theta, clas, inst_tys) } 
 
@@ -1104,7 +1114,14 @@ checkValidTyFamInst mb_clsinfo fam_tc
   = setSrcSpan loc $ 
     do { checkValidFamPats fam_tc tvs typats
 
-         -- The right-hand side is a tau type
+         -- The argument patterns, and RHS, are all boxed tau types
+         -- E.g  Reject type family F (a :: k1) :: k2
+         --             type instance F (forall a. a->a) = ...
+         --             type instance F Int#             = ...
+         --             type instance F Int              = forall a. a->a
+         --             type instance F Int              = Int#
+         -- See Trac #9357
+       ; mapM_ checkValidMonoType typats
        ; checkValidMonoType rhs
 
          -- We have a decidable instance unless otherwise permitted
@@ -1124,7 +1141,7 @@ checkFamInstRhs :: [Type]                  -- lhs
                 -> [(TyCon, [Type])]       -- type family instances
                 -> [MsgDoc]
 checkFamInstRhs lhsTys famInsts
-  = mapCatMaybes check famInsts
+  = mapMaybe check famInsts
   where
    size = sizeTypes lhsTys
    fvs  = fvTypes lhsTys
@@ -1154,26 +1171,18 @@ checkValidFamPats :: TyCon -> [TyVar] -> [Type] -> TcM ()
 --         type instance F (T a) = a
 -- c) Have the right number of patterns
 checkValidFamPats fam_tc tvs ty_pats
-  = do { -- A family instance must have exactly the same number of type
-         -- parameters as the family declaration.  You can't write
-         --     type family F a :: * -> *
-         --     type instance F Int y = y
-         -- because then the type (F Int) would be like (\y.y)
-         checkTc (length ty_pats == fam_arity) $
-           wrongNumberOfParmsErr (fam_arity - length fam_kvs) -- report only types
-       ; mapM_ checkTyFamFreeness ty_pats
+  = ASSERT( length ty_pats == tyConArity fam_tc )
+      -- A family instance must have exactly the same number of type
+      -- parameters as the family declaration.  You can't write
+      --     type family F a :: * -> *
+      --     type instance F Int y = y
+      -- because then the type (F Int) would be like (\y.y)
+      -- But this is checked at the time the axiom is created
+    do { mapM_ checkTyFamFreeness ty_pats
        ; let unbound_tvs = filterOut (`elemVarSet` exactTyVarsOfTypes ty_pats) tvs
        ; checkTc (null unbound_tvs) (famPatErr fam_tc unbound_tvs ty_pats) }
-  where fam_arity    = tyConArity fam_tc
-        (fam_kvs, _) = splitForAllTys (tyConKind fam_tc)
-
-wrongNumberOfParmsErr :: Arity -> SDoc
-wrongNumberOfParmsErr exp_arity
-  = ptext (sLit "Number of parameters must match family declaration; expected")
-    <+> ppr exp_arity
 
 -- Ensure that no type family instances occur in a type.
---
 checkTyFamFreeness :: Type -> TcM ()
 checkTyFamFreeness ty
   = checkTc (isTyFamFree ty) $
diff --git a/compiler/types/Class.lhs b/compiler/types/Class.lhs
index 2d145683bf1b..9863b8d98f57 100644
--- a/compiler/types/Class.lhs
+++ b/compiler/types/Class.lhs
@@ -6,7 +6,8 @@
 The @Class@ datatype
 
 \begin{code}
-{-# OPTIONS -fno-warn-tabs #-}
+{-# LANGUAGE CPP, DeriveDataTypeable #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
 -- The above warning supression flag is a temporary kludge.
 -- While working on this module you are encouraged to remove it and
 -- detab the module (please do the detabbing in a separate patch). See
@@ -16,7 +17,7 @@ The @Class@ datatype
 module Class (
 	Class,
         ClassOpItem, DefMeth (..),
-        ClassATItem,
+        ClassATItem(..),
         ClassMinimalDef,
 	defMethSpecOfDefMeth,
 
@@ -31,8 +32,7 @@ module Class (
 #include "HsVersions.h"
 
 import {-# SOURCE #-} TyCon	( TyCon, tyConName, tyConUnique )
-import {-# SOURCE #-} TypeRep	( PredType )
-import CoAxiom
+import {-# SOURCE #-} TypeRep	( Type, PredType )
 import Var
 import Name
 import BasicTypes
@@ -99,10 +99,10 @@ data DefMeth = NoDefMeth 		-- No default method
 	     | GenDefMeth Name 		-- A generic default method
              deriving Eq
 
-type ClassATItem = (TyCon,           -- See Note [Associated type tyvar names]
-                    [CoAxBranch])    -- Default associated types from these templates 
-  -- We can have more than one default per type; see
-  -- Note [Associated type defaults] in TcTyClsDecls
+data ClassATItem
+  = ATI TyCon         -- See Note [Associated type tyvar names]
+        (Maybe Type)  -- Default associated type (if any) from this template
+                      -- Note [Associated type defaults]
 
 type ClassMinimalDef = BooleanFormula Name -- Required methods
 
@@ -114,9 +114,39 @@ defMethSpecOfDefMeth meth
 	NoDefMeth	-> NoDM
 	DefMeth _	-> VanillaDM
 	GenDefMeth _	-> GenericDM
-
 \end{code}
 
+Note [Associated type defaults]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+The following is an example of associated type defaults:
+   class C a where
+     data D a r
+
+     type F x a b :: *
+     type F p q r = (p,q)->r    -- Default
+
+Note that
+
+ * The TyCons for the associated types *share type variables* with the
+   class, so that we can tell which argument positions should be
+   instantiated in an instance decl.  (The first for 'D', the second
+   for 'F'.)
+
+ * We can have default definitions only for *type* families,
+   not data families
+
+ * In the default decl, the "patterns" should all be type variables,
+   but (in the source language) they don't need to be the same as in
+   the 'type' decl signature or the class.  It's more like a
+   free-standing 'type instance' declaration.
+
+ * HOWEVER, in the internal ClassATItem we rename the RHS to match the
+   tyConTyVars of the family TyCon.  So in the example above we'd get
+   a ClassATItem of
+        ATI F ((x,a) -> b)
+   So the tyConTyVars of the family TyCon bind the free vars of
+   the default Type rhs
+
 The @mkClass@ function fills in the indirect superclasses.
 
 \begin{code}
@@ -197,7 +227,7 @@ classOpItems = classOpStuff
 
 classATs :: Class -> [TyCon]
 classATs (Class { classATStuff = at_stuff })
-  = [tc | (tc, _) <- at_stuff]
+  = [tc | ATI tc _ <- at_stuff]
 
 classATItems :: Class -> [ClassATItem]
 classATItems = classATStuff
diff --git a/compiler/types/CoAxiom.lhs b/compiler/types/CoAxiom.lhs
index a0a497483122..06b74a43f013 100644
--- a/compiler/types/CoAxiom.lhs
+++ b/compiler/types/CoAxiom.lhs
@@ -4,7 +4,7 @@
 
 \begin{code}
 
-{-# LANGUAGE GADTs, ScopedTypeVariables #-}
+{-# LANGUAGE CPP, DeriveDataTypeable, GADTs, ScopedTypeVariables #-}
 
 -- | Module for coercion axioms, used to represent type family instances
 -- and newtypes
@@ -327,6 +327,7 @@ isImplicitCoAxiom = co_ax_implicit
 coAxBranchIncomps :: CoAxBranch -> [CoAxBranch]
 coAxBranchIncomps = cab_incomps
 
+-- See Note [Compatibility checking] in FamInstEnv
 placeHolderIncomps :: [CoAxBranch]
 placeHolderIncomps = panic "placeHolderIncomps"
 
diff --git a/compiler/types/Coercion.lhs b/compiler/types/Coercion.lhs
index af2b2fa4838a..38f38ed50b12 100644
--- a/compiler/types/Coercion.lhs
+++ b/compiler/types/Coercion.lhs
@@ -3,6 +3,8 @@
 %
 
 \begin{code}
+{-# LANGUAGE CPP, DeriveDataTypeable #-}
+
 -- | Module for (a) type kinds and (b) type coercions,
 -- as used in System FC. See 'CoreSyn.Expr' for
 -- more on System FC and how coercions fit into it.
@@ -16,7 +18,7 @@ module Coercion (
         -- ** Functions over coercions
         coVarKind, coVarRole,
         coercionType, coercionKind, coercionKinds, isReflCo,
-        isReflCo_maybe, coercionRole,
+        isReflCo_maybe, coercionRole, coercionKindRole,
         mkCoercionType,
 
         -- ** Constructing coercions
@@ -27,7 +29,7 @@ module Coercion (
         mkSymCo, mkTransCo, mkNthCo, mkNthCoRole, mkLRCo,
         mkInstCo, mkAppCo, mkAppCoFlexible, mkTyConAppCo, mkFunCo,
         mkForAllCo, mkUnsafeCo, mkUnivCo, mkSubCo, mkPhantomCo,
-        mkNewTypeCo, maybeSubCo, maybeSubCo2,
+        mkNewTypeCo, downgradeRole,
         mkAxiomRuleCo,
 
         -- ** Decomposition
@@ -38,7 +40,7 @@ module Coercion (
         splitAppCo_maybe,
         splitForAllCo_maybe,
         nthRole, tyConRolesX,
-        nextRole,
+        nextRole, setNominalRole_maybe,
 
         -- ** Coercion variables
         mkCoVar, isCoVar, isCoVarType, coVarName, setCoVarName, setCoVarUnique,
@@ -102,8 +104,10 @@ import PrelNames        ( funTyConKey, eqPrimTyConKey, eqReprPrimTyConKey )
 import Control.Applicative
 import Data.Traversable (traverse, sequenceA)
 import FastString
+import ListSetOps
 
 import qualified Data.Data as Data hiding ( TyCon )
+import Control.Arrow ( first )
 \end{code}
 
 %************************************************************************
@@ -632,7 +636,7 @@ pprCo, pprParendCo :: Coercion -> SDoc
 pprCo       co = ppr_co TopPrec   co
 pprParendCo co = ppr_co TyConPrec co
 
-ppr_co :: Prec -> Coercion -> SDoc
+ppr_co :: TyPrec -> Coercion -> SDoc
 ppr_co _ (Refl r ty) = angleBrackets (ppr ty) <> ppr_role r
 
 ppr_co p co@(TyConAppCo _ tc [_,_])
@@ -695,7 +699,7 @@ instance Outputable LeftOrRight where
   ppr CLeft    = ptext (sLit "Left")
   ppr CRight   = ptext (sLit "Right")
 
-ppr_fun_co :: Prec -> Coercion -> SDoc
+ppr_fun_co :: TyPrec -> Coercion -> SDoc
 ppr_fun_co p co = pprArrowChain p (split co)
   where
     split :: Coercion -> [SDoc]
@@ -704,7 +708,7 @@ ppr_fun_co p co = pprArrowChain p (split co)
       = ppr_co FunPrec arg : split res
     split co = [ppr_co TopPrec co]
 
-ppr_forall_co :: Prec -> Coercion -> SDoc
+ppr_forall_co :: TyPrec -> Coercion -> SDoc
 ppr_forall_co p ty
   = maybeParen p FunPrec $
     sep [pprForAll tvs, ppr_co TopPrec rho]
@@ -724,7 +728,7 @@ pprCoAxBranch :: TyCon -> CoAxBranch -> SDoc
 pprCoAxBranch fam_tc (CoAxBranch { cab_tvs = tvs
                                  , cab_lhs = lhs
                                  , cab_rhs = rhs })
-  = hang (ifPprDebug (pprForAll tvs))
+  = hang (pprUserForAll tvs)
        2 (hang (pprTypeApp fam_tc lhs) 2 (equals <+> (ppr rhs)))
 
 pprCoAxBranchHdr :: CoAxiom br -> BranchIndex -> SDoc
@@ -770,7 +774,7 @@ splitAppCo_maybe (AppCo co1 co2) = Just (co1, co2)
 splitAppCo_maybe (TyConAppCo r tc cos)
   | isDecomposableTyCon tc || cos `lengthExceeds` tyConArity tc
   , Just (cos', co') <- snocView cos
-  , Just co'' <- unSubCo_maybe co'
+  , Just co'' <- setNominalRole_maybe co'
   = Just (mkTyConAppCo r tc cos', co'') -- Never create unsaturated type family apps!
        -- Use mkTyConAppCo to preserve the invariant
        --  that identity coercions are always represented by Refl
@@ -829,6 +833,55 @@ isReflCo_maybe _                 = Nothing
 %*                                                                      *
 %************************************************************************
 
+Note [Role twiddling functions]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+There are a plethora of functions for twiddling roles:
+
+mkSubCo: Requires a nominal input coercion and always produces a
+representational output. This is used when you (the programmer) are sure you
+know exactly that role you have and what you want.
+
+setRole_maybe: This function takes both the input role and the output role
+as parameters. (The *output* role comes first!) It can only *downgrade* a
+role -- that is, change it from N to R or P, or from R to P. This one-way
+behavior is why there is the "_maybe". If an upgrade is requested, this
+function produces Nothing. This is used when you need to change the role of a
+coercion, but you're not sure (as you're writing the code) of which roles are
+involved.
+
+This function could have been written using coercionRole to ascertain the role
+of the input. But, that function is recursive, and the caller of setRole_maybe
+often knows the input role. So, this is more efficient.
+
+downgradeRole: This is just like setRole_maybe, but it panics if the conversion
+isn't a downgrade.
+
+setNominalRole_maybe: This is the only function that can *upgrade* a coercion. The result
+(if it exists) is always Nominal. The input can be at any role. It works on a
+"best effort" basis, as it should never be strictly necessary to upgrade a coercion
+during compilation. It is currently only used within GHC in splitAppCo_maybe. In order
+to be a proper inverse of mkAppCo, the second coercion that splitAppCo_maybe returns
+must be nominal. But, it's conceivable that splitAppCo_maybe is operating over a
+TyConAppCo that uses a representational coercion. Hence the need for setNominalRole_maybe.
+splitAppCo_maybe, in turn, is used only within coercion optimization -- thus, it is
+not absolutely critical that setNominalRole_maybe be complete.
+
+Note that setNominalRole_maybe will never upgrade a phantom UnivCo. Phantom
+UnivCos are perfectly type-safe, whereas representational and nominal ones are
+not. Indeed, `unsafeCoerce` is implemented via a representational UnivCo.
+(Nominal ones are no worse than representational ones, so this function *will*
+change a UnivCo Representational to a UnivCo Nominal.)
+
+Conal Elliott also came across a need for this function while working with the GHC
+API, as he was decomposing Core casts. The Core casts use representational coercions,
+as they must, but his use case required nominal coercions (he was building a GADT).
+So, that's why this function is exported from this module.
+
+One might ask: shouldn't setRole_maybe just use setNominalRole_maybe as appropriate?
+I (Richard E.) have decided not to do this, because upgrading a role is bizarre and
+a caller should have to ask for this behavior explicitly.
+
 \begin{code}
 mkCoVarCo :: CoVar -> Coercion
 -- cv :: s ~# t
@@ -845,9 +898,9 @@ mkAxInstCo :: Role -> CoAxiom br -> BranchIndex -> [Type] -> Coercion
 -- mkAxInstCo can legitimately be called over-staturated;
 -- i.e. with more type arguments than the coercion requires
 mkAxInstCo role ax index tys
-  | arity == n_tys = maybeSubCo2 role ax_role $ AxiomInstCo ax_br index rtys
+  | arity == n_tys = downgradeRole role ax_role $ AxiomInstCo ax_br index rtys
   | otherwise      = ASSERT( arity < n_tys )
-                     maybeSubCo2 role ax_role $
+                     downgradeRole role ax_role $
                      foldl AppCo (AxiomInstCo ax_br index (take arity rtys))
                                  (drop arity rtys)
   where
@@ -899,10 +952,12 @@ mkAppCo co1 co2 = mkAppCoFlexible co1 Nominal co2
 mkAppCoFlexible :: Coercion -> Role -> Coercion -> Coercion
 mkAppCoFlexible (Refl r ty1) _ (Refl _ ty2)
   = Refl r (mkAppTy ty1 ty2)
-mkAppCoFlexible (Refl r (TyConApp tc tys)) r2 co2
+mkAppCoFlexible (Refl r ty1) r2 co2
+  | Just (tc, tys) <- splitTyConApp_maybe ty1
+    -- Expand type synonyms; a TyConAppCo can't have a type synonym (Trac #9102)
   = TyConAppCo r tc (zip_roles (tyConRolesX r tc) tys)
   where
-    zip_roles (r1:_)  []        = [maybeSubCo2 r1 r2 co2]
+    zip_roles (r1:_)  []        = [downgradeRole r1 r2 co2]
     zip_roles (r1:rs) (ty1:tys) = mkReflCo r1 ty1 : zip_roles rs tys
     zip_roles _       _         = panic "zip_roles" -- but the roles are infinite...
 mkAppCoFlexible (TyConAppCo r tc cos) r2 co
@@ -911,7 +966,7 @@ mkAppCoFlexible (TyConAppCo r tc cos) r2 co
                           TyConAppCo Nominal tc (cos ++ [co])
       Representational -> TyConAppCo Representational tc (cos ++ [co'])
         where new_role = (tyConRolesX Representational tc) !! (length cos)
-              co'      = maybeSubCo2 new_role r2 co
+              co'      = downgradeRole new_role r2 co
       Phantom          -> TyConAppCo Phantom tc (cos ++ [mkPhantomCo co])
 
 mkAppCoFlexible co1 _r2 co2 = ASSERT( _r2 == Nominal )
@@ -970,7 +1025,7 @@ mkTransCo co1 co2      = TransCo co1 co2
 -- sure this request is reasonable
 mkNthCoRole :: Role -> Int -> Coercion -> Coercion
 mkNthCoRole role n co
-  = maybeSubCo2 role nth_role $ nth_co
+  = downgradeRole role nth_role $ nth_co
   where
     nth_co = mkNthCo n co
     nth_role = coercionRole nth_co
@@ -999,10 +1054,9 @@ ok_tc_app ty n = case splitTyConApp_maybe ty of
 mkInstCo :: Coercion -> Type -> Coercion
 mkInstCo co ty = InstCo co ty
 
--- | Manufacture a coercion from thin air. Needless to say, this is
---   not usually safe, but it is used when we know we are dealing with
---   bottom, which is one case in which it is safe.  This is also used
---   to implement the @unsafeCoerce#@ primitive.  Optimise by pushing
+-- | Manufacture an unsafe coercion from thin air.
+--   Currently (May 14) this is used only to implement the
+--   @unsafeCoerce#@ primitive.  Optimise by pushing
 --   down through type constructors.
 mkUnsafeCo :: Type -> Type -> Coercion
 mkUnsafeCo = mkUnivCo Representational
@@ -1015,7 +1069,7 @@ mkUnivCo role ty1 ty2
 mkAxiomRuleCo :: CoAxiomRule -> [Type] -> [Coercion] -> Coercion
 mkAxiomRuleCo = AxiomRuleCo
 
--- input coercion is Nominal
+-- input coercion is Nominal; see also Note [Role twiddling functions]
 mkSubCo :: Coercion -> Coercion
 mkSubCo (Refl Nominal ty) = Refl Representational ty
 mkSubCo (TyConAppCo Nominal tc cos)
@@ -1024,44 +1078,51 @@ mkSubCo (UnivCo Nominal ty1 ty2) = UnivCo Representational ty1 ty2
 mkSubCo co = ASSERT2( coercionRole co == Nominal, ppr co <+> ppr (coercionRole co) )
              SubCo co
 
-
--- takes a Nominal coercion and possibly casts it into a Representational one
-maybeSubCo :: Role -> Coercion -> Coercion
-maybeSubCo Nominal          = id
-maybeSubCo Representational = mkSubCo
-maybeSubCo Phantom          = pprPanic "maybeSubCo Phantom" . ppr
-
-maybeSubCo2_maybe :: Role   -- desired role
-                  -> Role   -- current role
-                  -> Coercion -> Maybe Coercion
-maybeSubCo2_maybe Representational Nominal = Just . mkSubCo
-maybeSubCo2_maybe Nominal Representational = const Nothing
-maybeSubCo2_maybe Phantom Phantom          = Just
-maybeSubCo2_maybe Phantom _                = Just . mkPhantomCo
-maybeSubCo2_maybe _ Phantom                = const Nothing
-maybeSubCo2_maybe _ _                      = Just
-
-maybeSubCo2 :: Role  -- desired role
-            -> Role  -- current role
-            -> Coercion -> Coercion
-maybeSubCo2 r1 r2 co
-  = case maybeSubCo2_maybe r1 r2 co of
+-- only *downgrades* a role. See Note [Role twiddling functions]
+setRole_maybe :: Role   -- desired role
+              -> Role   -- current role
+              -> Coercion -> Maybe Coercion
+setRole_maybe Representational Nominal = Just . mkSubCo
+setRole_maybe Nominal Representational = const Nothing
+setRole_maybe Phantom Phantom          = Just
+setRole_maybe Phantom _                = Just . mkPhantomCo
+setRole_maybe _ Phantom                = const Nothing
+setRole_maybe _ _                      = Just
+
+-- panics if the requested conversion is not a downgrade.
+-- See also Note [Role twiddling functions]
+downgradeRole :: Role  -- desired role
+              -> Role  -- current role
+              -> Coercion -> Coercion
+downgradeRole r1 r2 co
+  = case setRole_maybe r1 r2 co of
       Just co' -> co'
-      Nothing  -> pprPanic "maybeSubCo2" (ppr co)
-
--- if co is Nominal, returns it; otherwise, unwraps a SubCo; otherwise, fails
-unSubCo_maybe :: Coercion -> Maybe Coercion
-unSubCo_maybe (SubCo co)  = Just co
-unSubCo_maybe (Refl _ ty) = Just $ Refl Nominal ty
-unSubCo_maybe (TyConAppCo Representational tc cos)
-  = do { cos' <- mapM unSubCo_maybe cos
+      Nothing  -> pprPanic "downgradeRole" (ppr co)
+
+-- Converts a coercion to be nominal, if possible.
+-- See also Note [Role twiddling functions]
+setNominalRole_maybe :: Coercion -> Maybe Coercion
+setNominalRole_maybe co
+  | Nominal <- coercionRole co = Just co
+setNominalRole_maybe (SubCo co)  = Just co
+setNominalRole_maybe (Refl _ ty) = Just $ Refl Nominal ty
+setNominalRole_maybe (TyConAppCo Representational tc coes)
+  = do { cos' <- mapM setNominalRole_maybe coes
        ; return $ TyConAppCo Nominal tc cos' }
-unSubCo_maybe (UnivCo Representational ty1 ty2) = Just $ UnivCo Nominal ty1 ty2
+setNominalRole_maybe (UnivCo Representational ty1 ty2) = Just $ UnivCo Nominal ty1 ty2
   -- We do *not* promote UnivCo Phantom, as that's unsafe.
   -- UnivCo Nominal is no more unsafe than UnivCo Representational
-unSubCo_maybe co
-  | Nominal <- coercionRole co = Just co
-unSubCo_maybe _ = Nothing
+setNominalRole_maybe (TransCo co1 co2)
+  = TransCo <$> setNominalRole_maybe co1 <*> setNominalRole_maybe co2
+setNominalRole_maybe (AppCo co1 co2)
+  = AppCo <$> setNominalRole_maybe co1 <*> pure co2
+setNominalRole_maybe (ForAllCo tv co)
+  = ForAllCo tv <$> setNominalRole_maybe co
+setNominalRole_maybe (NthCo n co)
+  = NthCo n <$> setNominalRole_maybe co
+setNominalRole_maybe (InstCo co ty)
+  = InstCo <$> setNominalRole_maybe co <*> pure ty
+setNominalRole_maybe _ = Nothing
 
 -- takes any coercion and turns it into a Phantom coercion
 mkPhantomCo :: Coercion -> Coercion
@@ -1556,7 +1617,7 @@ failing for reason 2) is fine. matchAxiom is trying to find a set of coercions
 that match, but it may fail, and this is healthy behavior. Bottom line: if
 you find that liftCoSubst is doing weird things (like leaving out-of-scope
 variables lying around), disable coercion optimization (bypassing matchAxiom)
-and use maybeSubCo2 instead of maybeSubCo2_maybe. The panic will then happen,
+and use downgradeRole instead of setRole_maybe. The panic will then happen,
 and you may learn something useful.
 
 \begin{code}
@@ -1566,7 +1627,7 @@ liftCoSubstTyVar (LCS _ cenv) r tv
   = do { co <- lookupVarEnv cenv tv
        ; let co_role = coercionRole co   -- could theoretically take this as
                                          -- a parameter, but painful
-       ; maybeSubCo2_maybe r co_role co } -- see Note [liftCoSubstTyVar]
+       ; setRole_maybe r co_role co } -- see Note [liftCoSubstTyVar]
 
 liftCoSubstTyVarBndr :: LiftCoSubst -> TyVar -> (LiftCoSubst, TyVar)
 liftCoSubstTyVarBndr subst@(LCS in_scope cenv) old_var
@@ -1733,10 +1794,23 @@ seqCos (co:cos) = seqCo co `seq` seqCos cos
 %*                                                                      *
 %************************************************************************
 
+Note [Computing a coercion kind and role]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+To compute a coercion's kind is straightforward: see coercionKind.
+But to compute a coercion's role, in the case for NthCo we need
+its kind as well.  So if we have two separate functions (one for kinds
+and one for roles) we can get exponentially bad behaviour, since each
+NthCo node makes a separate call to coercionKind, which traverses the
+sub-tree again.  This was part of the problem in Trac #9233.
+
+Solution: compute both together; hence coercionKindRole.  We keep a
+separate coercionKind function because it's a bit more efficient if
+the kind is all you want.
+
 \begin{code}
 coercionType :: Coercion -> Type
-coercionType co = case coercionKind co of
-                    Pair ty1 ty2 -> mkCoercionType (coercionRole co) ty1 ty2
+coercionType co = case coercionKindRole co of
+                    (Pair ty1 ty2, r) -> mkCoercionType r ty1 ty2
 
 ------------------
 -- | If it is the case that
@@ -1768,11 +1842,10 @@ coercionKind co = go co
     go (InstCo aco ty)       = go_app aco [ty]
     go (SubCo co)            = go co
     go (AxiomRuleCo ax tys cos) =
-      case coaxrProves ax tys (map coercionKind cos) of
+      case coaxrProves ax tys (map go cos) of
         Just res -> res
         Nothing  -> panic "coercionKind: Malformed coercion"
 
-
     go_app :: Coercion -> [Type] -> Pair Type
     -- Collect up all the arguments and apply all at once
     -- See Note [Nested InstCos]
@@ -1783,25 +1856,54 @@ coercionKind co = go co
 coercionKinds :: [Coercion] -> Pair [Type]
 coercionKinds tys = sequenceA $ map coercionKind tys
 
-coercionRole :: Coercion -> Role
-coercionRole = go
+-- | Get a coercion's kind and role.
+-- Why both at once?  See Note [Computing a coercion kind and role]
+coercionKindRole :: Coercion -> (Pair Type, Role)
+coercionKindRole = go
   where
-    go (Refl r _)           = r
-    go (TyConAppCo r _ _)   = r
-    go (AppCo co _)         = go co
-    go (ForAllCo _ co)      = go co
-    go (CoVarCo cv)         = coVarRole cv
-    go (AxiomInstCo ax _ _) = coAxiomRole ax
-    go (UnivCo r _ _)       = r
-    go (SymCo co)           = go co
-    go (TransCo co1 _)      = go co1 -- same as go co2
-    go (NthCo n co)         = let Pair ty1 _ = coercionKind co
-                                  (tc, _) = splitTyConApp ty1
-                              in nthRole (coercionRole co) tc n
-    go (LRCo _ _)           = Nominal
-    go (InstCo co _)        = go co
-    go (SubCo _)            = Representational
-    go (AxiomRuleCo c _ _)  = coaxrRole c
+    go (Refl r ty) = (Pair ty ty, r)
+    go (TyConAppCo r tc cos)
+      = (mkTyConApp tc <$> (sequenceA $ map coercionKind cos), r)
+    go (AppCo co1 co2)
+      = let (tys1, r1) = go co1 in
+        (mkAppTy <$> tys1 <*> coercionKind co2, r1)
+    go (ForAllCo tv co)
+      = let (tys, r) = go co in
+        (mkForAllTy tv <$> tys, r)
+    go (CoVarCo cv) = (toPair $ coVarKind cv, coVarRole cv)
+    go co@(AxiomInstCo ax _ _) = (coercionKind co, coAxiomRole ax)
+    go (UnivCo r ty1 ty2) = (Pair ty1 ty2, r)
+    go (SymCo co) = first swap $ go co
+    go (TransCo co1 co2)
+      = let (tys1, r) = go co1 in
+        (Pair (pFst tys1) (pSnd $ coercionKind co2), r)
+    go (NthCo d co)
+      = let (Pair t1 t2, r) = go co
+            (tc1,  args1) = splitTyConApp t1
+            (_tc2, args2) = splitTyConApp t2
+        in
+        ASSERT( tc1 == _tc2 )
+        ((`getNth` d) <$> Pair args1 args2, nthRole r tc1 d)
+    go co@(LRCo {}) = (coercionKind co, Nominal)
+    go (InstCo co ty) = go_app co [ty]
+    go (SubCo co) = (coercionKind co, Representational)
+    go co@(AxiomRuleCo ax _ _) = (coercionKind co, coaxrRole ax)
+
+    go_app :: Coercion -> [Type] -> (Pair Type, Role)
+    -- Collect up all the arguments and apply all at once
+    -- See Note [Nested InstCos]
+    go_app (InstCo co ty) tys = go_app co (ty:tys)
+    go_app co             tys
+      = let (pair, r) = go co in
+        ((`applyTys` tys) <$> pair, r)
+
+-- | Retrieve the role from a coercion.
+coercionRole :: Coercion -> Role
+coercionRole = snd . coercionKindRole
+  -- There's not a better way to do this, because NthCo needs the *kind*
+  -- and role of its argument. Luckily, laziness should generally avoid
+  -- the need for computing kinds in other cases.
+
 \end{code}
 
 Note [Nested InstCos]
diff --git a/compiler/types/FamInstEnv.lhs b/compiler/types/FamInstEnv.lhs
index c17668bbb570..1308984f4f68 100644
--- a/compiler/types/FamInstEnv.lhs
+++ b/compiler/types/FamInstEnv.lhs
@@ -5,13 +5,12 @@
 FamInstEnv: Type checked family instance declarations
 
 \begin{code}
-
-{-# LANGUAGE GADTs #-}
+{-# LANGUAGE CPP, GADTs #-}
 
 module FamInstEnv (
         FamInst(..), FamFlavor(..), famInstAxiom, famInstTyCon, famInstRHS,
         famInstsRepTyCons, famInstRepTyCon_maybe, dataFamInstRepTyCon,
-        pprFamInst, pprFamInstHdr, pprFamInsts,
+        pprFamInst, pprFamInsts,
         mkImportedFamInst,
 
         FamInstEnvs, FamInstEnv, emptyFamInstEnv, emptyFamInstEnvs,
@@ -47,7 +46,6 @@ import Coercion
 import CoAxiom
 import VarSet
 import VarEnv
-import Module( isInteractiveModule )
 import Name
 import UniqFM
 import Outputable
@@ -167,12 +165,13 @@ instance Outputable FamInst where
    ppr = pprFamInst
 
 -- Prints the FamInst as a family instance declaration
+-- NB: FamInstEnv.pprFamInst is used only for internal, debug printing
+--     See pprTyThing.pprFamInst for printing for the user
 pprFamInst :: FamInst -> SDoc
 pprFamInst famInst
   = hang (pprFamInstHdr famInst)
        2 (vcat [ ifPprDebug (ptext (sLit "Coercion axiom:") <+> ppr ax)
-               , ifPprDebug (ptext (sLit "RHS:") <+> ppr (famInstRHS famInst))
-               , ptext (sLit "--") <+> pprDefinedAt (getName famInst)])
+               , ifPprDebug (ptext (sLit "RHS:") <+> ppr (famInstRHS famInst)) ])
   where
     ax = fi_axiom famInst
 
@@ -199,6 +198,9 @@ pprFamInstHdr fi@(FamInst {fi_flavor = flavor})
               else pprTypeApp fam_tc (etad_lhs_tys ++ mkTyVarTys extra_tvs)
                      -- Without -dppr-debug, eta-expand
                      -- See Trac #8674
+                     -- (This is probably over the top now that we use this
+                     --  only for internal debug printing; PprTyThing.pprFamInst
+                     --  is used for user-level printing.)
             | otherwise
             = vanilla_pp_head
 
@@ -378,23 +380,21 @@ identicalFamInst :: FamInst -> FamInst -> Bool
 -- Same LHS, *and* both instances are on the interactive command line
 -- Used for overriding in GHCi
 identicalFamInst (FamInst { fi_axiom = ax1 }) (FamInst { fi_axiom = ax2 })
-  =  isInteractiveModule (nameModule (coAxiomName ax1))
-  && isInteractiveModule (nameModule (coAxiomName ax2))
-  && coAxiomTyCon ax1 == coAxiomTyCon ax2
+  =  coAxiomTyCon ax1 == coAxiomTyCon ax2
   && brListLength brs1 == brListLength brs2
-  && and (brListZipWith identical_ax_branch brs1 brs2)
-  where brs1 = coAxiomBranches ax1
-        brs2 = coAxiomBranches ax2
-        identical_ax_branch br1 br2
-          = length tvs1 == length tvs2
-            && length lhs1 == length lhs2
-            && and (zipWith (eqTypeX rn_env) lhs1 lhs2)
-          where
-            tvs1 = coAxBranchTyVars br1
-            tvs2 = coAxBranchTyVars br2
-            lhs1 = coAxBranchLHS br1
-            lhs2 = coAxBranchLHS br2
-            rn_env = rnBndrs2 (mkRnEnv2 emptyInScopeSet) tvs1 tvs2
+  && and (brListZipWith identical_branch brs1 brs2)
+  where
+    brs1 = coAxiomBranches ax1
+    brs2 = coAxiomBranches ax2
+
+    identical_branch br1 br2
+      =  isJust (tcMatchTys tvs1 lhs1 lhs2)
+      && isJust (tcMatchTys tvs2 lhs2 lhs1)
+      where
+        tvs1 = mkVarSet (coAxBranchTyVars br1)
+        tvs2 = mkVarSet (coAxBranchTyVars br2)
+        lhs1 = coAxBranchLHS br1
+        lhs2 = coAxBranchLHS br2
 \end{code}
 
 %************************************************************************
@@ -439,7 +439,7 @@ only when we can be sure that 'a' is not Int.
 To achieve this, after finding a possible match within the equations, we have to
 go back to all previous equations and check that, under the
 substitution induced by the match, other branches are surely apart. (See
-[Apartness].) This is similar to what happens with class
+Note [Apartness].) This is similar to what happens with class
 instance selection, when we need to guarantee that there is only a match and
 no unifiers. The exact algorithm is different here because the the
 potentially-overlapping group is closed.
@@ -475,6 +475,7 @@ irrelevant (clause 1 of compatible) or benign (clause 2 of compatible).
 
 \begin{code}
 
+-- See Note [Compatibility]
 compatibleBranches :: CoAxBranch -> CoAxBranch -> Bool
 compatibleBranches (CoAxBranch { cab_lhs = lhs1, cab_rhs = rhs1 })
                    (CoAxBranch { cab_lhs = lhs2, cab_rhs = rhs2 })
@@ -487,6 +488,7 @@ compatibleBranches (CoAxBranch { cab_lhs = lhs1, cab_rhs = rhs1 })
 
 -- takes a CoAxiom with unknown branch incompatibilities and computes
 -- the compatibilities
+-- See Note [Storing compatibility] in CoAxiom
 computeAxiomIncomps :: CoAxiom br -> CoAxiom br
 computeAxiomIncomps ax@(CoAxiom { co_ax_branches = branches })
   = ax { co_ax_branches = go [] branches }
@@ -639,7 +641,7 @@ lookupFamInstEnvConflicts envs fam_inst@(FamInst { fi_axiom = new_axiom })
                   (ppr tpl_tvs <+> ppr tpl_tys) )
                 -- Unification will break badly if the variables overlap
                 -- They shouldn't because we allocate separate uniques for them
-         if compatibleBranches (coAxiomSingleBranch old_axiom) (new_branch)
+         if compatibleBranches (coAxiomSingleBranch old_axiom) new_branch
            then Nothing
            else Just noSubst
       -- Note [Family instance overlap conflicts]
@@ -667,7 +669,7 @@ Note [Family instance overlap conflicts]
 -- Might be a one-way match or a unifier
 type MatchFun =  FamInst                -- The FamInst template
               -> TyVarSet -> [Type]     --   fi_tvs, fi_tys of that FamInst
-              -> [Type]                         -- Target to match against
+              -> [Type]                 -- Target to match against
               -> Maybe TvSubst
 
 lookup_fam_inst_env'          -- The worker, local to this module
@@ -727,9 +729,9 @@ lookup_fam_inst_env           -- The worker, local to this module
 
 -- Precondition: the tycon is saturated (or over-saturated)
 
-lookup_fam_inst_env match_fun (pkg_ie, home_ie) fam tys =
-    lookup_fam_inst_env' match_fun home_ie fam tys ++
-    lookup_fam_inst_env' match_fun pkg_ie  fam tys
+lookup_fam_inst_env match_fun (pkg_ie, home_ie) fam tys
+  =  lookup_fam_inst_env' match_fun home_ie fam tys
+  ++ lookup_fam_inst_env' match_fun pkg_ie  fam tys
 
 \end{code}
 
@@ -745,16 +747,18 @@ which you can't do in Haskell!):
 
 Then looking up (F (Int,Bool) Char) will return a FamInstMatch
      (FPair, [Int,Bool,Char])
-
 The "extra" type argument [Char] just stays on the end.
 
-Because of eta-reduction of data family instances (see
-Note [Eta reduction for data family axioms] in TcInstDecls), we must
-handle data families and type families separately here. All instances
-of a type family must have the same arity, so we can precompute the split
-between the match_tys and the overflow tys. This is done in pre_rough_split_tys.
-For data instances, though, we need to re-split for each instance, because
-the breakdown might be different.
+We handle data families and type families separately here:
+
+ * For type families, all instances of a type family must have the
+   same arity, so we can precompute the split between the match_tys
+   and the overflow tys. This is done in pre_rough_split_tys.
+
+ * For data family instances, though, we need to re-split for each
+   instance, because the breakdown might be different for each
+   instance.  Why?  Because of eta reduction; see Note [Eta reduction
+   for data family axioms]
 
 \begin{code}
 
@@ -957,9 +961,9 @@ normaliseTcApp env role tc tys
 
   | otherwise   -- No unique matching family instance exists;
                 -- we do not do anything
-  = (Refl role ty, ty)
-  where
-    ty = mkTyConApp tc tys
+  = let (co, ntys) = normaliseTcArgs env role tc tys in
+    (co, mkTyConApp tc ntys)
+    
 
 ---------------
 normaliseTcArgs :: FamInstEnvs            -- environment with family instances
diff --git a/compiler/types/InstEnv.lhs b/compiler/types/InstEnv.lhs
index 826537db17bb..708fef1cfe87 100644
--- a/compiler/types/InstEnv.lhs
+++ b/compiler/types/InstEnv.lhs
@@ -7,13 +7,16 @@
 The bits common to TcInstDcls and TcDeriv.
 
 \begin{code}
+{-# LANGUAGE CPP, DeriveDataTypeable #-}
+
 module InstEnv (
-        DFunId, OverlapFlag(..), InstMatch, ClsInstLookupResult,
-        ClsInst(..), DFunInstType, pprInstance, pprInstanceHdr, pprInstances, 
+        DFunId, InstMatch, ClsInstLookupResult,
+        OverlapFlag(..), OverlapMode(..), setOverlapModeMaybe,
+        ClsInst(..), DFunInstType, pprInstance, pprInstanceHdr, pprInstances,
         instanceHead, instanceSig, mkLocalInstance, mkImportedInstance,
         instanceDFunId, tidyClsInstDFun, instanceRoughTcs,
 
-        InstEnv, emptyInstEnv, extendInstEnv, overwriteInstEnv, 
+        InstEnv, emptyInstEnv, extendInstEnv, deleteFromInstEnv, identicalInstHead, 
         extendInstEnvList, lookupUniqueInstEnv, lookupInstEnv', lookupInstEnv, instEnvElts,
         classInstances, orphNamesOfClsInst, instanceBindFun,
         instanceCantMatch, roughMatchTcs
@@ -157,22 +160,21 @@ pprInstance :: ClsInst -> SDoc
 -- Prints the ClsInst as an instance declaration
 pprInstance ispec
   = hang (pprInstanceHdr ispec)
-        2 (ptext (sLit "--") <+> pprDefinedAt (getName ispec))
+        2 (vcat [ ptext (sLit "--") <+> pprDefinedAt (getName ispec)
+                , ifPprDebug (ppr (is_dfun ispec)) ])
 
 -- * pprInstanceHdr is used in VStudio to populate the ClassView tree
 pprInstanceHdr :: ClsInst -> SDoc
 -- Prints the ClsInst as an instance declaration
 pprInstanceHdr (ClsInst { is_flag = flag, is_dfun = dfun })
   = getPprStyle $ \ sty ->
-    let theta_to_print
-          | debugStyle sty = theta
-          | otherwise = drop (dfunNSilent dfun) theta
+    let dfun_ty = idType dfun
+        (tvs, theta, res_ty) = tcSplitSigmaTy dfun_ty
+        theta_to_print = drop (dfunNSilent dfun) theta
           -- See Note [Silent superclass arguments] in TcInstDcls
-    in ptext (sLit "instance") <+> ppr flag
-       <+> sep [pprThetaArrowTy theta_to_print, ppr res_ty]
-  where
-    (_, theta, res_ty) = tcSplitSigmaTy (idType dfun)
-       -- Print without the for-all, which the programmer doesn't write
+        ty_to_print | debugStyle sty = dfun_ty
+                    | otherwise      = mkSigmaTy tvs theta_to_print res_ty
+    in ptext (sLit "instance") <+> ppr flag <+> pprSigmaType ty_to_print
 
 pprInstances :: [ClsInst] -> SDoc
 pprInstances ispecs = vcat (map pprInstance ispecs)
@@ -419,26 +421,22 @@ extendInstEnv inst_env ins_item@(ClsInst { is_cls_nm = cls_nm })
   where
     add (ClsIE cur_insts) _ = ClsIE (ins_item : cur_insts)
 
-overwriteInstEnv :: InstEnv -> ClsInst -> InstEnv
-overwriteInstEnv inst_env ins_item@(ClsInst { is_cls_nm = cls_nm, is_tys = tys })
-  = addToUFM_C add inst_env cls_nm (ClsIE [ins_item])
+deleteFromInstEnv :: InstEnv -> ClsInst -> InstEnv
+deleteFromInstEnv inst_env ins_item@(ClsInst { is_cls_nm = cls_nm })
+  = adjustUFM adjust inst_env cls_nm
   where
-    add (ClsIE cur_insts) _ = ClsIE (replaceInst cur_insts)
-    
-    rough_tcs  = roughMatchTcs tys
-    replaceInst [] = [ins_item]
-    replaceInst (item@(ClsInst { is_tcs = mb_tcs,  is_tvs = tpl_tvs 
-                               , is_tys = tpl_tys }) : rest)
-    -- Fast check for no match, uses the "rough match" fields
-      | instanceCantMatch rough_tcs mb_tcs
-      = item : replaceInst rest
-
-      | let tpl_tv_set = mkVarSet tpl_tvs
-      , Just _ <- tcMatchTys tpl_tv_set tpl_tys tys
-      = ins_item : rest
-
-      | otherwise
-      = item : replaceInst rest
+    adjust (ClsIE items) = ClsIE (filterOut (identicalInstHead ins_item) items)
+
+identicalInstHead :: ClsInst -> ClsInst -> Bool
+-- ^ True when when the instance heads are the same
+-- e.g.  both are   Eq [(a,b)]
+-- Obviously should be insenstive to alpha-renaming
+identicalInstHead (ClsInst { is_cls_nm = cls_nm1, is_tcs = rough1, is_tvs = tvs1, is_tys = tys1 })
+                  (ClsInst { is_cls_nm = cls_nm2, is_tcs = rough2, is_tvs = tvs2, is_tys = tys2 })
+  =  cls_nm1 == cls_nm2
+  && not (instanceCantMatch rough1 rough2)  -- Fast check for no match, uses the "rough match" fields
+  && isJust (tcMatchTys (mkVarSet tvs1) tys1 tys2)
+  && isJust (tcMatchTys (mkVarSet tvs2) tys2 tys1)
 \end{code}
 
 
@@ -452,6 +450,54 @@ overwriteInstEnv inst_env ins_item@(ClsInst { is_cls_nm = cls_nm, is_tys = tys }
 the env is kept ordered, the first match must be the only one.  The
 thing we are looking up can have an arbitrary "flexi" part.
 
+Note [Rules for instance lookup]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+These functions implement the carefully-written rules in the user
+manual section on "overlapping instances". At risk of duplication,
+here are the rules.  If the rules change, change this text and the
+user manual simultaneously.  The link may be this:
+http://www.haskell.org/ghc/docs/latest/html/users_guide/type-class-extensions.html#instance-overlap
+
+The willingness to be overlapped or incoherent is a property of the
+instance declaration itself, controlled as follows:
+
+ * An instance is "incoherent"
+   if it has an INCOHERENT pragma, or
+   if it appears in a module compiled with -XIncoherentInstances.
+
+ * An instance is "overlappable"
+   if it has an OVERLAPPABLE or OVERLAPS pragma, or
+   if it appears in a module compiled with -XOverlappingInstances, or
+   if the instance is incoherent.
+
+ * An instance is "overlapping"
+   if it has an OVERLAPPING or OVERLAPS pragma, or
+   if it appears in a module compiled with -XOverlappingInstances, or
+   if the instance is incoherent.
+     compiled with -XOverlappingInstances.
+
+Now suppose that, in some client module, we are searching for an instance
+of the target constraint (C ty1 .. tyn). The search works like this.
+
+ * Find all instances I that match the target constraint; that is, the
+   target constraint is a substitution instance of I. These instance
+   declarations are the candidates.
+
+ * Find all non-candidate instances that unify with the target
+   constraint. Such non-candidates instances might match when the
+   target constraint is further instantiated. If all of them are
+   incoherent, proceed; if not, the search fails.
+
+ * Eliminate any candidate IX for which both of the following hold:
+   * There is another candidate IY that is strictly more specific;
+     that is, IY is a substitution instance of IX but not vice versa.
+
+   * Either IX is overlappable or IY is overlapping.
+
+ * If only one candidate remains, pick it. Otherwise if all remaining
+   candidates are incoherent, pick an arbitrary candidate. Otherwise fail.
+
+
 \begin{code}
 type DFunInstType = Maybe Type
         -- Just ty   => Instantiate with this type
@@ -535,8 +581,8 @@ lookupInstEnv' ie cls tys
       = find ((item, map (lookup_tv subst) tpl_tvs) : ms) us rest
 
         -- Does not match, so next check whether the things unify
-        -- See Note [Overlapping instances] and Note [Incoherent Instances]
-      | Incoherent _ <- oflag
+        -- See Note [Overlapping instances] and Note [Incoherent instances]
+      | Incoherent <- overlapMode oflag
       = find ms us rest
 
       | otherwise
@@ -565,23 +611,30 @@ lookupInstEnv' ie cls tys
 lookupInstEnv :: (InstEnv, InstEnv)     -- External and home package inst-env
               -> Class -> [Type]   -- What we are looking for
               -> ClsInstLookupResult
- 
+-- ^ See Note [Rules for instance lookup]
 lookupInstEnv (pkg_ie, home_ie) cls tys
-  = (safe_matches, all_unifs, safe_fail)
+  = (final_matches, final_unifs, safe_fail)
   where
     (home_matches, home_unifs) = lookupInstEnv' home_ie cls tys
     (pkg_matches,  pkg_unifs)  = lookupInstEnv' pkg_ie  cls tys
     all_matches = home_matches ++ pkg_matches
     all_unifs   = home_unifs   ++ pkg_unifs
     pruned_matches = foldr insert_overlapping [] all_matches
-    (safe_matches, safe_fail) = if length pruned_matches == 1 
-                        then check_safe (head pruned_matches) all_matches
-                        else (pruned_matches, False)
         -- Even if the unifs is non-empty (an error situation)
         -- we still prune the matches, so that the error message isn't
         -- misleading (complaining of multiple matches when some should be
         -- overlapped away)
 
+    (final_matches, safe_fail)
+       = case pruned_matches of
+           [match] -> check_safe match all_matches
+           _       -> (pruned_matches, False)
+
+    -- If the selected match is incoherent, discard all unifiers
+    final_unifs = case final_matches of
+                    (m:_) | is_incoherent m -> []
+                    _ -> all_unifs
+
     -- NOTE [Safe Haskell isSafeOverlap]
     -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
     -- We restrict code compiled in 'Safe' mode from overriding code
@@ -605,7 +658,7 @@ lookupInstEnv (pkg_ie, home_ie) cls tys
                 if inSameMod x
                     then go bad unchecked
                     else go (i:bad) unchecked
-            
+
             inSameMod b =
                 let na = getName $ getName inst
                     la = isInternalName na
@@ -614,64 +667,72 @@ lookupInstEnv (pkg_ie, home_ie) cls tys
                 in (la && lb) || (nameModule na == nameModule nb)
 
 ---------------
+is_incoherent :: InstMatch -> Bool
+is_incoherent (inst, _) = overlapMode (is_flag inst) == Incoherent
+
 ---------------
 insert_overlapping :: InstMatch -> [InstMatch] -> [InstMatch]
--- Add a new solution, knocking out strictly less specific ones
+-- ^ Add a new solution, knocking out strictly less specific ones
+-- See Note [Rules for instance lookup]
 insert_overlapping new_item [] = [new_item]
-insert_overlapping new_item (item:items)
-  | new_beats_old && old_beats_new = item : insert_overlapping new_item items
-        -- Duplicate => keep both for error report
-  | new_beats_old = insert_overlapping new_item items
-        -- Keep new one
-  | old_beats_new = item : items
-        -- Keep old one
-  | incoherent new_item = item : items -- note [Incoherent instances]
-        -- Keep old one
-  | incoherent item = new_item : items
-        -- Keep new one
-  | otherwise     = item : insert_overlapping new_item items
-        -- Keep both
+insert_overlapping new_item (old_item : old_items)
+  | new_beats_old        -- New strictly overrides old
+  , not old_beats_new
+  , new_item `can_override` old_item
+  = insert_overlapping new_item old_items
+
+  | old_beats_new        -- Old strictly overrides new
+  , not new_beats_old
+  , old_item `can_override` new_item
+  = old_item : old_items
+
+  -- Discard incoherent instances; see Note [Incoherent instances]
+  | is_incoherent old_item       -- Old is incoherent; discard it
+  = insert_overlapping new_item old_items
+  | is_incoherent new_item       -- New is incoherent; discard it
+  = old_item : old_items
+
+  -- Equal or incomparable, and neither is incoherent; keep both
+  | otherwise
+  = old_item : insert_overlapping new_item old_items
   where
-    new_beats_old = new_item `beats` item
-    old_beats_new = item `beats` new_item
-
-    incoherent (inst, _) = case is_flag inst of Incoherent _ -> True
-                                                _            -> False
-
-    (instA, _) `beats` (instB, _)
-          = overlap_ok && 
-            isJust (tcMatchTys (mkVarSet (is_tvs instB)) (is_tys instB) (is_tys instA))
-                    -- A beats B if A is more specific than B,
-                    -- (ie. if B can be instantiated to match A)
-                    -- and overlap is permitted
-          where
-            -- Overlap permitted if *either* instance permits overlap
-            -- This is a change (Trac #3877, Dec 10). It used to
-            -- require that instB (the less specific one) permitted overlap.
-            overlap_ok = case (is_flag instA, is_flag instB) of
-                              (NoOverlap _, NoOverlap _) -> False
-                              _                          -> True
+
+    new_beats_old = new_item `more_specific_than` old_item
+    old_beats_new = old_item `more_specific_than` new_item
+
+    -- `instB` can be instantiated to match `instA`
+    -- or the two are equal
+    (instA,_) `more_specific_than` (instB,_)
+      = isJust (tcMatchTys (mkVarSet (is_tvs instB))
+               (is_tys instB) (is_tys instA))
+
+    (instA, _) `can_override` (instB, _)
+       =  hasOverlappingFlag  (overlapMode (is_flag instA))
+       || hasOverlappableFlag (overlapMode (is_flag instB))
+       -- Overlap permitted if either the more specific instance
+       -- is marked as overlapping, or the more general one is
+       -- marked as overlappable.
+       -- Latest change described in: Trac #9242.
+       -- Previous change: Trac #3877, Dec 10.
 \end{code}
 
 Note [Incoherent instances]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-For some classes, the choise of a particular instance does not matter, any one
+For some classes, the choice of a particular instance does not matter, any one
 is good. E.g. consider
 
         class D a b where { opD :: a -> b -> String }
         instance D Int b where ...
         instance D a Int where ...
 
-        g (x::Int) = opD x x
+        g (x::Int) = opD x x  -- Wanted: D Int Int
 
 For such classes this should work (without having to add an "instance D Int
 Int", and using -XOverlappingInstances, which would then work). This is what
 -XIncoherentInstances is for: Telling GHC "I don't care which instance you use;
 if you can use one, use it."
 
-
-Should this logic only work when all candidates have the incoherent flag, or
+Should this logic only work when *all* candidates have the incoherent flag, or
 even when all but one have it? The right choice is the latter, which can be
 justified by comparing the behaviour with how -XIncoherentInstances worked when
 it was only about the unify-check (note [Overlapping instances]):
@@ -682,7 +743,7 @@ Example:
         instance [incoherent] [Int] b c
         instance [incoherent] C a Int c
 Thanks to the incoherent flags,
-        foo :: ([a],b,Int)
+        [Wanted]  C [a] b Int
 works: Only instance one matches, the others just unify, but are marked
 incoherent.
 
diff --git a/compiler/types/Kind.lhs b/compiler/types/Kind.lhs
index 793aa4a761db..04982825ac00 100644
--- a/compiler/types/Kind.lhs
+++ b/compiler/types/Kind.lhs
@@ -3,19 +3,13 @@
 %
 
 \begin{code}
-{-# OPTIONS -fno-warn-tabs #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and
--- detab the module (please do the detabbing in a separate patch). See
---     http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
--- for details
-
+{-# LANGUAGE CPP #-}
 module Kind (
         -- * Main data type
         SuperKind, Kind, typeKind,
 
-	-- Kinds
-	anyKind, liftedTypeKind, unliftedTypeKind, openTypeKind, constraintKind,
+        -- Kinds
+        anyKind, liftedTypeKind, unliftedTypeKind, openTypeKind, constraintKind,
         mkArrowKind, mkArrowKinds,
 
         -- Kind constructors...
@@ -23,9 +17,9 @@ module Kind (
         unliftedTypeKindTyCon, constraintKindTyCon,
 
         -- Super Kinds
-	superKind, superKindTyCon, 
-        
-	pprKind, pprParendKind,
+        superKind, superKindTyCon,
+
+        pprKind, pprParendKind,
 
         -- ** Deconstructing Kinds
         kindAppResult, synTyConResKind,
@@ -41,7 +35,7 @@ module Kind (
         okArrowArgKind, okArrowResultKind,
 
         isSubOpenTypeKind, isSubOpenTypeKindKey,
-        isSubKind, isSubKindCon, 
+        isSubKind, isSubKindCon,
         tcIsSubKind, tcIsSubKindCon,
         defaultKind, defaultKind_maybe,
 
@@ -62,48 +56,54 @@ import PrelNames
 import Outputable
 import Maybes( orElse )
 import Util
+import FastString
 \end{code}
 
 %************************************************************************
-%*									*
-	Functions over Kinds		
-%*									*
+%*                                                                      *
+        Functions over Kinds
+%*                                                                      *
 %************************************************************************
 
 Note [Kind Constraint and kind *]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 The kind Constraint is the kind of classes and other type constraints.
-The special thing about types of kind Constraint is that 
+The special thing about types of kind Constraint is that
  * They are displayed with double arrow:
      f :: Ord a => a -> a
  * They are implicitly instantiated at call sites; so the type inference
    engine inserts an extra argument of type (Ord a) at every call site
    to f.
 
-However, once type inference is over, there is *no* distinction between 
+However, once type inference is over, there is *no* distinction between
 Constraint and *.  Indeed we can have coercions between the two. Consider
    class C a where
      op :: a -> a
-For this single-method class we may generate a newtype, which in turn 
+For this single-method class we may generate a newtype, which in turn
 generates an axiom witnessing
     Ord a ~ (a -> a)
 so on the left we have Constraint, and on the right we have *.
 See Trac #7451.
 
 Bottom line: although '*' and 'Constraint' are distinct TyCons, with
-distinct uniques, they are treated as equal at all times except 
+distinct uniques, they are treated as equal at all times except
 during type inference.  Hence cmpTc treats them as equal.
 
 \begin{code}
 -- | Essentially 'funResultTy' on kinds handling pi-types too
-kindFunResult :: Kind -> KindOrType -> Kind
-kindFunResult (FunTy _ res) _ = res
-kindFunResult (ForAllTy kv res) arg = substKiWith [kv] [arg] res
-kindFunResult k _ = pprPanic "kindFunResult" (ppr k)
-
-kindAppResult :: Kind -> [Type] -> Kind
-kindAppResult k []     = k
-kindAppResult k (a:as) = kindAppResult (kindFunResult k a) as
+kindFunResult :: SDoc -> Kind -> KindOrType -> Kind
+kindFunResult _ (FunTy _ res)     _   = res
+kindFunResult _ (ForAllTy kv res) arg = substKiWith [kv] [arg] res
+#ifdef DEBUG
+kindFunResult doc k _ = pprPanic "kindFunResult" (ppr k $$ doc)
+#else
+-- Without DEBUG, doc becomes an unsed arg, and will be optimised away
+kindFunResult _ _ _ = panic "kindFunResult"
+#endif
+
+kindAppResult :: SDoc -> Kind -> [Type] -> Kind
+kindAppResult _   k []     = k
+kindAppResult doc k (a:as) = kindAppResult doc (kindFunResult doc k a) as
 
 -- | Essentially 'splitFunTys' on kinds
 splitKindFunTys :: Kind -> ([Kind],Kind)
@@ -122,12 +122,13 @@ splitKindFunTysN n (FunTy a r) = case splitKindFunTysN (n-1) r of
                                    (as, k) -> (a:as, k)
 splitKindFunTysN n k = pprPanic "splitKindFunTysN" (ppr n <+> ppr k)
 
--- | Find the result 'Kind' of a type synonym, 
+-- | Find the result 'Kind' of a type synonym,
 -- after applying it to its 'arity' number of type variables
--- Actually this function works fine on data types too, 
+-- Actually this function works fine on data types too,
 -- but they'd always return '*', so we never need to ask
 synTyConResKind :: TyCon -> Kind
-synTyConResKind tycon = kindAppResult (tyConKind tycon) (map mkTyVarTy (tyConTyVars tycon))
+synTyConResKind tycon = kindAppResult (ptext (sLit "synTyConResKind") <+> ppr tycon)
+                                      (tyConKind tycon) (map mkTyVarTy (tyConTyVars tycon))
 
 -- | See "Type#kind_subtyping" for details of the distinction between these 'Kind's
 isOpenTypeKind, isUnliftedTypeKind,
@@ -204,7 +205,7 @@ isSubOpenTypeKindKey uniq
   || uniq == constraintKindTyConKey  -- Needed for error (Num a) "blah"
                                      -- and so that (Ord a -> Eq a) is well-kinded
                                      -- and so that (# Eq a, Ord b #) is well-kinded
-                              	     -- See Note [Kind Constraint and kind *]
+                                     -- See Note [Kind Constraint and kind *]
 
 -- | Is this a kind (i.e. a type-of-types)?
 isKind :: Kind -> Bool
@@ -235,7 +236,7 @@ isSubKindCon :: TyCon -> TyCon -> Bool
 -- See Note [GHC Formalism] in coreSyn/CoreLint.lhs
 isSubKindCon kc1 kc2
   | kc1 == kc2              = True
-  | isOpenTypeKindCon kc2   = isSubOpenTypeKindCon kc1 
+  | isOpenTypeKindCon kc2   = isSubOpenTypeKindCon kc1
   | isConstraintKindCon kc1 = isLiftedTypeKindCon kc2
   | isLiftedTypeKindCon kc1 = isConstraintKindCon kc2
     -- See Note [Kind Constraint and kind *]
@@ -279,11 +280,11 @@ defaultKind_maybe :: Kind -> Maybe Kind
 -- simple (* or *->* etc).  So generic type variables (other than
 -- built-in constants like 'error') always have simple kinds.  This is important;
 -- consider
---	f x = True
+--      f x = True
 -- We want f to get type
---	f :: forall (a::*). a -> Bool
--- Not 
---	f :: forall (a::ArgKind). a -> Bool
+--      f :: forall (a::*). a -> Bool
+-- Not
+--      f :: forall (a::ArgKind). a -> Bool
 -- because that would allow a call like (f 3#) as well as (f True),
 -- and the calling conventions differ.
 -- This defaulting is done in TcMType.zonkTcTyVarBndr.
diff --git a/compiler/types/OptCoercion.lhs b/compiler/types/OptCoercion.lhs
index ebc2cbea5c3e..6eccf4258889 100644
--- a/compiler/types/OptCoercion.lhs
+++ b/compiler/types/OptCoercion.lhs
@@ -3,7 +3,8 @@
 %
 
 \begin{code}
-{-# OPTIONS -fno-warn-tabs #-}
+{-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
 -- The above warning supression flag is a temporary kludge.
 -- While working on this module you are encouraged to remove it and
 -- detab the module (please do the detabbing in a separate patch). See
@@ -26,12 +27,12 @@ import VarEnv
 import StaticFlags	( opt_NoOptCoercion )
 import Outputable
 import Pair
-import Maybes
 import FastString
 import Util
 import Unify
 import ListSetOps
 import InstEnv
+import Control.Monad   ( zipWithM )
 \end{code}
 
 %************************************************************************
@@ -57,13 +58,29 @@ because now the co_B1 (which is really free) has been captured, and
 subsequent substitutions will go wrong.  That's why we can't use
 mkCoPredTy in the ForAll case, where this note appears.  
 
+Note [Optimising coercion optimisation]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Looking up a coercion's role or kind is linear in the size of the
+coercion. Thus, doing this repeatedly during the recursive descent
+of coercion optimisation is disastrous. We must be careful to avoid
+doing this if at all possible.
+
+Because it is generally easy to know a coercion's components' roles
+from the role of the outer coercion, we pass down the known role of
+the input in the algorithm below. We also keep functions opt_co2
+and opt_co3 separate from opt_co4, so that the former two do Phantom
+checks that opt_co4 can avoid. This is a big win because Phantom coercions
+rarely appear within non-phantom coercions -- only in some TyConAppCos
+and some AxiomInstCos. We handle these cases specially by calling
+opt_co2.
+
 \begin{code}
 optCoercion :: CvSubst -> Coercion -> NormalCo
 -- ^ optCoercion applies a substitution to a coercion, 
 --   *and* optimises it to reduce its size
 optCoercion env co 
   | opt_NoOptCoercion = substCo env co
-  | otherwise         = opt_co env False Nothing co
+  | otherwise         = opt_co1 env False co
 
 type NormalCo = Coercion
   -- Invariants: 
@@ -74,20 +91,24 @@ type NormalCo = Coercion
 
 type NormalNonIdCo = NormalCo  -- Extra invariant: not the identity
 
-opt_co, opt_co' :: CvSubst
-       		-> Bool	       -- True <=> return (sym co)
-                -> Maybe Role  -- Nothing <=> don't change; otherwise, change
-                               -- INVARIANT: the change is always a *downgrade*
-       		-> Coercion
-       		-> NormalCo	
-opt_co = opt_co' 
+-- | Do we apply a @sym@ to the result?
+type SymFlag = Bool
+
+-- | Do we force the result to be representational?
+type ReprFlag = Bool
+
+-- | Optimize a coercion, making no assumptions.
+opt_co1 :: CvSubst
+        -> SymFlag
+        -> Coercion -> NormalCo
+opt_co1 env sym co = opt_co2 env sym (coercionRole co) co
 {-
 opt_co env sym co
  = pprTrace "opt_co {" (ppr sym <+> ppr co $$ ppr env) $
    co1 `seq`
    pprTrace "opt_co done }" (ppr co1) $
-   (WARN( not same_co_kind, ppr co  <+> dcolon <+> pprEqPred (Pair s1 t1)
-                         $$ ppr co1 <+> dcolon <+> pprEqPred (Pair s2 t2) )
+   (WARN( not same_co_kind, ppr co  <+> dcolon <+> ppr (coercionType co)
+                         $$ ppr co1 <+> dcolon <+> ppr (coercionType co1) )
     WARN( not (coreEqCoercion co1 simple_result),
            (text "env=" <+> ppr env) $$
            (text "input=" <+> ppr co) $$
@@ -106,111 +127,123 @@ opt_co env sym co
                  | otherwise = substCo env co
 -}
 
-opt_co' env _   mrole (Refl r ty) = Refl (mrole `orElse` r) (substTy env ty)
-opt_co' env sym mrole co
-  |  mrole == Just Phantom 
-  || coercionRole co == Phantom
-  , Pair ty1 ty2 <- coercionKind co
-  = if sym
-    then opt_univ env Phantom ty2 ty1
-    else opt_univ env Phantom ty1 ty2
-
-opt_co' env sym mrole (SymCo co)  = opt_co env (not sym) mrole co
-opt_co' env sym mrole (TyConAppCo r tc cos)
-  = case mrole of
-      Nothing -> mkTyConAppCo r  tc (map (opt_co env sym Nothing) cos)
-      Just r' -> mkTyConAppCo r' tc (zipWith (opt_co env sym)
-                                             (map Just (tyConRolesX r' tc)) cos)
-opt_co' env sym mrole (AppCo co1 co2) = mkAppCo (opt_co env sym mrole   co1)
-                                                (opt_co env sym Nothing co2)
-opt_co' env sym mrole (ForAllCo tv co)
+-- See Note [Optimising coercion optimisation]
+-- | Optimize a coercion, knowing the coercion's role. No other assumptions.
+opt_co2 :: CvSubst
+        -> SymFlag
+        -> Role   -- ^ The role of the input coercion
+        -> Coercion -> NormalCo
+opt_co2 env sym Phantom co = opt_phantom env sym co
+opt_co2 env sym r       co = opt_co3 env sym Nothing r co
+
+-- See Note [Optimising coercion optimisation]
+-- | Optimize a coercion, knowing the coercion's non-Phantom role.
+opt_co3 :: CvSubst -> SymFlag -> Maybe Role -> Role -> Coercion -> NormalCo
+opt_co3 env sym (Just Phantom) _ co = opt_phantom env sym co
+opt_co3 env sym (Just Representational) r co = opt_co4 env sym True  r co
+  -- if mrole is Just Nominal, that can't be a downgrade, so we can ignore
+opt_co3 env sym _                       r co = opt_co4 env sym False r co
+
+
+-- See Note [Optimising coercion optimisation]
+-- | Optimize a non-phantom coercion.
+opt_co4 :: CvSubst -> SymFlag -> ReprFlag -> Role -> Coercion -> NormalCo
+
+opt_co4 env _   rep r (Refl _r ty)
+  = ASSERT( r == _r )
+    Refl (chooseRole rep r) (substTy env ty)
+
+opt_co4 env sym rep r (SymCo co)  = opt_co4 env (not sym) rep r co
+
+opt_co4 env sym rep r g@(TyConAppCo _r tc cos)
+  = ASSERT( r == _r )
+    case (rep, r) of
+      (True, Nominal) ->
+        mkTyConAppCo Representational tc
+                     (zipWith3 (opt_co3 env sym)
+                               (map Just (tyConRolesX Representational tc))
+                               (repeat Nominal)
+                               cos)
+      (False, Nominal) ->
+        mkTyConAppCo Nominal tc (map (opt_co4 env sym False Nominal) cos)
+      (_, Representational) ->
+                      -- must use opt_co2 here, because some roles may be P
+                      -- See Note [Optimising coercion optimisation]
+        mkTyConAppCo r tc (zipWith (opt_co2 env sym)
+                                   (tyConRolesX r tc)  -- the current roles
+                                   cos)
+      (_, Phantom) -> pprPanic "opt_co4 sees a phantom!" (ppr g)
+
+opt_co4 env sym rep r (AppCo co1 co2) = mkAppCo (opt_co4 env sym rep r co1)
+                                                (opt_co4 env sym False Nominal co2)
+opt_co4 env sym rep r (ForAllCo tv co)
   = case substTyVarBndr env tv of
-      (env', tv') -> mkForAllCo tv' (opt_co env' sym mrole co)
+      (env', tv') -> mkForAllCo tv' (opt_co4 env' sym rep r co)
      -- Use the "mk" functions to check for nested Refls
 
-opt_co' env sym mrole (CoVarCo cv)
+opt_co4 env sym rep r (CoVarCo cv)
   | Just co <- lookupCoVar env cv
-  = opt_co (zapCvSubstEnv env) sym mrole co
+  = opt_co4 (zapCvSubstEnv env) sym rep r co
 
   | Just cv1 <- lookupInScope (getCvInScope env) cv
-  = ASSERT( isCoVar cv1 ) wrapRole mrole cv_role $ wrapSym sym (CoVarCo cv1)
+  = ASSERT( isCoVar cv1 ) wrapRole rep r $ wrapSym sym (CoVarCo cv1)
                 -- cv1 might have a substituted kind!
 
   | otherwise = WARN( True, ptext (sLit "opt_co: not in scope:") <+> ppr cv $$ ppr env)
                 ASSERT( isCoVar cv )
-                wrapRole mrole cv_role $ wrapSym sym (CoVarCo cv)
-  where cv_role = coVarRole cv
+                wrapRole rep r $ wrapSym sym (CoVarCo cv)
 
-opt_co' env sym mrole (AxiomInstCo con ind cos)
+opt_co4 env sym rep r (AxiomInstCo con ind cos)
     -- Do *not* push sym inside top-level axioms
     -- e.g. if g is a top-level axiom
     --   g a : f a ~ a
     -- then (sym (g ty)) /= g (sym ty) !!
-  = wrapRole mrole (coAxiomRole con) $
+  = ASSERT( r == coAxiomRole con )
+    wrapRole rep (coAxiomRole con) $
     wrapSym sym $
-    AxiomInstCo con ind (map (opt_co env False Nothing) cos)
+                       -- some sub-cos might be P: use opt_co2
+                       -- See Note [Optimising coercion optimisation]
+    AxiomInstCo con ind (zipWith (opt_co2 env False)
+                                 (coAxBranchRoles (coAxiomNthBranch con ind))
+                                 cos)
       -- Note that the_co does *not* have sym pushed into it
 
-opt_co' env sym mrole (UnivCo r oty1 oty2)
-  = opt_univ env role a b
+opt_co4 env sym rep r (UnivCo _r oty1 oty2)
+  = ASSERT( r == _r )
+    opt_univ env (chooseRole rep r) a b
   where
     (a,b) = if sym then (oty2,oty1) else (oty1,oty2)
-    role = mrole `orElse` r
 
-opt_co' env sym mrole (TransCo co1 co2)
-  | sym       = opt_trans in_scope opt_co2 opt_co1   -- sym (g `o` h) = sym h `o` sym g
-  | otherwise = opt_trans in_scope opt_co1 opt_co2
+opt_co4 env sym rep r (TransCo co1 co2)
+                      -- sym (g `o` h) = sym h `o` sym g
+  | sym       = opt_trans in_scope co2' co1'
+  | otherwise = opt_trans in_scope co1' co2'
   where
-    opt_co1 = opt_co env sym mrole co1
-    opt_co2 = opt_co env sym mrole co2
+    co1' = opt_co4 env sym rep r co1
+    co2' = opt_co4 env sym rep r co2
     in_scope = getCvInScope env
 
--- NthCo roles are fiddly!
-opt_co' env sym mrole (NthCo n (TyConAppCo _ _ cos))
-  = opt_co env sym mrole (getNth cos n)
-opt_co' env sym mrole (NthCo n co)
-  | TyConAppCo _ _tc cos <- co'
-  , isDecomposableTyCon tc   -- Not synonym families
-  = ASSERT( n < length cos )
-    ASSERT( _tc == tc )
-    let resultCo = cos !! n
-        resultRole = coercionRole resultCo in
-    case (mrole, resultRole) of
-        -- if we just need an R coercion, try to propagate the SubCo again:
-      (Just Representational, Nominal) -> opt_co (zapCvSubstEnv env) False mrole resultCo
-      _                                -> resultCo
-
-  | otherwise
-  = wrap_role $ NthCo n co'
-
-  where
-    wrap_role wrapped = wrapRole mrole (coercionRole wrapped) wrapped
-
-    tc = tyConAppTyCon $ pFst $ coercionKind co
-    co' = opt_co env sym mrole' co
-    mrole' = case mrole of
-               Just Representational
-                 | Representational <- nthRole Representational tc n
-                 -> Just Representational
-               _ -> Nothing
+opt_co4 env sym rep r co@(NthCo {}) = opt_nth_co env sym rep r co
 
-opt_co' env sym mrole (LRCo lr co)
+opt_co4 env sym rep r (LRCo lr co)
   | Just pr_co <- splitAppCo_maybe co
-  = opt_co env sym mrole (pickLR lr pr_co)
+  = ASSERT( r == Nominal )
+    opt_co4 env sym rep Nominal (pickLR lr pr_co)
   | Just pr_co <- splitAppCo_maybe co'
-  = if mrole == Just Representational
-    then opt_co (zapCvSubstEnv env) False mrole (pickLR lr pr_co)
+  = ASSERT( r == Nominal )
+    if rep
+    then opt_co4 (zapCvSubstEnv env) False True Nominal (pickLR lr pr_co)
     else pickLR lr pr_co
   | otherwise
-  = wrapRole mrole Nominal $ LRCo lr co'
+  = wrapRole rep Nominal $ LRCo lr co'
   where
-    co' = opt_co env sym Nothing co
+    co' = opt_co4 env sym False Nominal co
 
-opt_co' env sym mrole (InstCo co ty)
+opt_co4 env sym rep r (InstCo co ty)
     -- See if the first arg is already a forall
     -- ...then we can just extend the current substitution
   | Just (tv, co_body) <- splitForAllCo_maybe co
-  = opt_co (extendTvSubst env tv ty') sym mrole co_body
+  = opt_co4 (extendTvSubst env tv ty') sym rep r co_body
 
      -- See if it is a forall after optimization
      -- If so, do an inefficient one-variable substitution
@@ -219,22 +252,34 @@ opt_co' env sym mrole (InstCo co ty)
 
   | otherwise = InstCo co' ty'
   where
-    co' = opt_co env sym mrole co
+    co' = opt_co4 env sym rep r co
     ty' = substTy env ty
 
-opt_co' env sym _ (SubCo co) = opt_co env sym (Just Representational) co
+opt_co4 env sym _ r (SubCo co)
+  = ASSERT( r == Representational )
+    opt_co4 env sym True Nominal co
 
 -- XXX: We could add another field to CoAxiomRule that
 -- would allow us to do custom simplifications.
-opt_co' env sym mrole (AxiomRuleCo co ts cs) =
-  wrapRole mrole (coaxrRole co) $
+opt_co4 env sym rep r (AxiomRuleCo co ts cs)
+  = ASSERT( r == coaxrRole co )
+    wrapRole rep r $
     wrapSym sym $
     AxiomRuleCo co (map (substTy env) ts)
-                   (zipWith (opt_co env False) (map Just (coaxrAsmpRoles co)) cs)
-
+                   (zipWith (opt_co2 env False) (coaxrAsmpRoles co) cs)
 
 
 -------------
+-- | Optimize a phantom coercion. The input coercion may not necessarily
+-- be a phantom, but the output sure will be.
+opt_phantom :: CvSubst -> SymFlag -> Coercion -> NormalCo
+opt_phantom env sym co
+  = if sym
+    then opt_univ env Phantom ty2 ty1
+    else opt_univ env Phantom ty1 ty2
+  where
+    Pair ty1 ty2 = coercionKind co
+
 opt_univ :: CvSubst -> Role -> Type -> Type -> Coercion
 opt_univ env role oty1 oty2
   | Just (tc1, tys1) <- splitTyConApp_maybe oty1
@@ -260,6 +305,45 @@ opt_univ env role oty1 oty2
   | otherwise
   = mkUnivCo role (substTy env oty1) (substTy env oty2)
 
+-------------
+-- NthCo must be handled separately, because it's the one case where we can't
+-- tell quickly what the component coercion's role is from the containing
+-- coercion. To avoid repeated coercionRole calls as opt_co1 calls opt_co2,
+-- we just look for nested NthCo's, which can happen in practice.
+opt_nth_co :: CvSubst -> SymFlag -> ReprFlag -> Role -> Coercion -> NormalCo
+opt_nth_co env sym rep r = go []
+  where
+    go ns (NthCo n co) = go (n:ns) co
+      -- previous versions checked if the tycon is decomposable. This
+      -- is redundant, because a non-decomposable tycon under an NthCo
+      -- is entirely bogus. See docs/core-spec/core-spec.pdf.
+    go ns co
+      = opt_nths ns co
+
+      -- input coercion is *not* yet sym'd or opt'd
+    opt_nths [] co = opt_co4 env sym rep r co
+    opt_nths (n:ns) (TyConAppCo _ _ cos) = opt_nths ns (cos `getNth` n)
+
+      -- here, the co isn't a TyConAppCo, so we opt it, hoping to get
+      -- a TyConAppCo as output. We don't know the role, so we use
+      -- opt_co1. This is slightly annoying, because opt_co1 will call
+      -- coercionRole, but as long as we don't have a long chain of
+      -- NthCo's interspersed with some other coercion former, we should
+      -- be OK.
+    opt_nths ns co = opt_nths' ns (opt_co1 env sym co)
+
+      -- input coercion *is* sym'd and opt'd
+    opt_nths' [] co
+      = if rep && (r == Nominal)
+            -- propagate the SubCo:
+        then opt_co4 (zapCvSubstEnv env) False True r co
+        else co
+    opt_nths' (n:ns) (TyConAppCo _ _ cos) = opt_nths' ns (cos `getNth` n)
+    opt_nths' ns co = wrapRole rep r (mk_nths ns co)
+
+    mk_nths [] co = co
+    mk_nths (n:ns) co = mk_nths ns (mkNthCo n co)
+
 -------------
 opt_transList :: InScopeSet -> [NormalCo] -> [NormalCo] -> [NormalCo]
 opt_transList is = zipWith (opt_trans is)
@@ -425,11 +509,11 @@ opt_trans_rule is co1 co2
     role = coercionRole co1 -- should be the same as coercionRole co2!
 
 opt_trans_rule _ co1 co2	-- Identity rule
-  | Pair ty1 _ <- coercionKind co1
+  | (Pair ty1 _, r) <- coercionKindRole co1
   , Pair _ ty2 <- coercionKind co2
   , ty1 `eqType` ty2
   = fireTransRule "RedTypeDirRefl" co1 co2 $
-    Refl (coercionRole co1) ty2
+    Refl r ty2
 
 opt_trans_rule _ _ _ = Nothing
 
@@ -492,16 +576,24 @@ checkAxInstCo (AxiomInstCo ax ind cos)
 checkAxInstCo _ = Nothing
 
 -----------
-wrapSym :: Bool -> Coercion -> Coercion
+wrapSym :: SymFlag -> Coercion -> Coercion
 wrapSym sym co | sym       = SymCo co
                | otherwise = co
 
-wrapRole :: Maybe Role   -- desired
-         -> Role         -- current
+-- | Conditionally set a role to be representational
+wrapRole :: ReprFlag
+         -> Role         -- ^ current role
          -> Coercion -> Coercion
-wrapRole Nothing        _       = id
-wrapRole (Just desired) current = maybeSubCo2 desired current
-
+wrapRole False _       = id
+wrapRole True  current = downgradeRole Representational current
+
+-- | If we require a representational role, return that. Otherwise,
+-- return the "default" role provided.
+chooseRole :: ReprFlag
+           -> Role    -- ^ "default" role
+           -> Role
+chooseRole True _ = Representational
+chooseRole _    r = r
 -----------
 -- takes two tyvars and builds env'ts to map them to the same tyvar
 substTyVarBndr2 :: CvSubst -> TyVar -> TyVar
@@ -534,7 +626,7 @@ matchAxiom sym ax@(CoAxiom { co_ax_tc = tc }) ind co
                     , cab_rhs   = rhs }) = coAxiomNthBranch ax ind in
     case liftCoMatch (mkVarSet qtvs) (if sym then (mkTyConApp tc lhs) else rhs) co of
       Nothing    -> Nothing
-      Just subst -> allMaybes (zipWith (liftCoSubstTyVar subst) roles qtvs)
+      Just subst -> zipWithM (liftCoSubstTyVar subst) roles qtvs
 
 -------------
 compatible_co :: Coercion -> Coercion -> Bool
@@ -568,8 +660,7 @@ etaAppCo_maybe :: Coercion -> Maybe (Coercion,Coercion)
 etaAppCo_maybe co
   | Just (co1,co2) <- splitAppCo_maybe co
   = Just (co1,co2)
-  | Nominal <- coercionRole co
-  , Pair ty1 ty2 <- coercionKind co
+  | (Pair ty1 ty2, Nominal) <- coercionKindRole co
   , Just (_,t1) <- splitAppTy_maybe ty1
   , Just (_,t2) <- splitAppTy_maybe ty2
   , typeKind t1 `eqType` typeKind t2      -- Note [Eta for AppCo]
diff --git a/compiler/types/TyCon.lhs b/compiler/types/TyCon.lhs
index bb489b33e1b3..65b5645d7419 100644
--- a/compiler/types/TyCon.lhs
+++ b/compiler/types/TyCon.lhs
@@ -6,6 +6,7 @@
 The @TyCon@ datatype
 
 \begin{code}
+{-# LANGUAGE CPP, DeriveDataTypeable #-}
 
 module TyCon(
         -- * Main TyCon data types
@@ -34,14 +35,13 @@ module TyCon(
         isFunTyCon,
         isPrimTyCon,
         isTupleTyCon, isUnboxedTupleTyCon, isBoxedTupleTyCon,
-        isSynTyCon, 
+        isSynTyCon, isTypeSynonymTyCon,
         isDecomposableTyCon,
         isForeignTyCon, 
         isPromotedDataCon, isPromotedTyCon,
         isPromotedDataCon_maybe, isPromotedTyCon_maybe,
         promotableTyCon_maybe, promoteTyCon,
 
-        isInjectiveTyCon,
         isDataTyCon, isProductTyCon, isDataProductTyCon_maybe,
         isEnumerationTyCon,
         isNewTyCon, isAbstractTyCon,
@@ -183,6 +183,9 @@ See also Note [Wrappers for data instance tycons] in MkId.lhs
   It has an AlgTyConParent of
         FamInstTyCon T [Int] ax_ti
 
+* The axiom ax_ti may be eta-reduced; see
+  Note [Eta reduction for data family axioms] in TcInstDcls
+
 * The data contructor T2 has a wrapper (which is what the
   source-level "T2" invokes):
 
@@ -576,11 +579,14 @@ data TyConParent
   --  3) A 'CoTyCon' identifying the representation
   --  type with the type instance family
   | FamInstTyCon          -- See Note [Data type families]
-        (CoAxiom Unbranched)  -- The coercion constructor,
-                              -- always of kind   T ty1 ty2 ~ R:T a b c
-                              -- where T is the family TyCon,
-                              -- and R:T is the representation TyCon (ie this one)
-                              -- and a,b,c are the tyConTyVars of this TyCon
+        (CoAxiom Unbranched)  -- The coercion axiom.
+               -- Generally of kind   T ty1 ty2 ~ R:T a b c
+               -- where T is the family TyCon,
+               -- and R:T is the representation TyCon (ie this one)
+               -- and a,b,c are the tyConTyVars of this TyCon
+               --
+               -- BUT may be eta-reduced; see TcInstDcls
+               --     Note [Eta reduction for data family axioms]
 
           -- Cached fields of the CoAxiom, but adjusted to
           -- use the tyConTyVars of this TyCon
@@ -722,7 +728,7 @@ which encodes as (TyConApp instCoercionTyCon [TyConApp CoT [], s])
 Note [Newtype eta]
 ~~~~~~~~~~~~~~~~~~
 Consider
-        newtype Parser a = MkParser (IO a) derriving( Monad )
+        newtype Parser a = MkParser (IO a) deriving Monad
 Are these two types equal (to Core)?
         Monad Parser
         Monad IO
@@ -1187,11 +1193,17 @@ isDataProductTyCon_maybe (TupleTyCon { dataCon = con })
   = Just con
 isDataProductTyCon_maybe _ = Nothing
 
--- | Is this a 'TyCon' representing a type synonym (@type@)?
+-- | Is this a 'TyCon' representing a regular H98 type synonym (@type@)?
+isTypeSynonymTyCon :: TyCon -> Bool
+isTypeSynonymTyCon (SynTyCon { synTcRhs = SynonymTyCon {} }) = True
+isTypeSynonymTyCon _ = False
+
+-- | Is this 'TyCon' a type synonym or type family?
 isSynTyCon :: TyCon -> Bool
 isSynTyCon (SynTyCon {}) = True
 isSynTyCon _             = False
 
+
 -- As for newtypes, it is in some contexts important to distinguish between
 -- closed synonyms and synonym families, as synonym families have no unique
 -- right hand side to which a synonym family application can expand.
@@ -1199,7 +1211,14 @@ isSynTyCon _             = False
 
 isDecomposableTyCon :: TyCon -> Bool
 -- True iff we can decompose (T a b c) into ((T a b) c)
+--   I.e. is it injective?
 -- Specifically NOT true of synonyms (open and otherwise)
+-- Ultimately we may have injective associated types
+-- in which case this test will become more interesting
+--
+-- It'd be unusual to call isDecomposableTyCon on a regular H98
+-- type synonym, because you should probably have expanded it first
+-- But regardless, it's not decomposable
 isDecomposableTyCon (SynTyCon {}) = False
 isDecomposableTyCon _other        = True
 
@@ -1259,17 +1278,6 @@ isDataFamilyTyCon :: TyCon -> Bool
 isDataFamilyTyCon (AlgTyCon {algTcRhs = DataFamilyTyCon {}}) = True
 isDataFamilyTyCon _ = False
 
--- | Injective 'TyCon's can be decomposed, so that
---     T ty1 ~ T ty2  =>  ty1 ~ ty2
-isInjectiveTyCon :: TyCon -> Bool
-isInjectiveTyCon tc = not (isSynTyCon tc)
-        -- Ultimately we may have injective associated types
-        -- in which case this test will become more interesting
-        --
-        -- It'd be unusual to call isInjectiveTyCon on a regular H98
-        -- type synonym, because you should probably have expanded it first
-        -- But regardless, it's not injective!
-
 -- | Are we able to extract informationa 'TyVar' to class argument list
 -- mappping from a given 'TyCon'?
 isTyConAssoc :: TyCon -> Bool
@@ -1370,13 +1378,15 @@ isPromotedDataCon_maybe _ = Nothing
 -- * Family instances are /not/ implicit as they represent the instance body
 --   (similar to a @dfun@ does that for a class instance).
 isImplicitTyCon :: TyCon -> Bool
-isImplicitTyCon tycon
-  | isTyConAssoc tycon = True
-  | isSynTyCon tycon   = False
-  | isAlgTyCon tycon   = isTupleTyCon tycon
-  | otherwise          = True
-        -- 'otherwise' catches: FunTyCon, PrimTyCon,
-        -- PromotedDataCon, PomotedTypeTyCon
+isImplicitTyCon (FunTyCon {})        = True
+isImplicitTyCon (TupleTyCon {})      = True
+isImplicitTyCon (PrimTyCon {})       = True
+isImplicitTyCon (PromotedDataCon {}) = True
+isImplicitTyCon (PromotedTyCon {})   = True
+isImplicitTyCon (AlgTyCon { algTcParent = AssocFamilyTyCon {} }) = True
+isImplicitTyCon (AlgTyCon {})                                    = False
+isImplicitTyCon (SynTyCon { synTcParent = AssocFamilyTyCon {} }) = True
+isImplicitTyCon (SynTyCon {})                                    = False
 
 tyConCType_maybe :: TyCon -> Maybe CType
 tyConCType_maybe tc@(AlgTyCon {}) = tyConCType tc
diff --git a/compiler/types/Type.lhs b/compiler/types/Type.lhs
index 0abe463f189b..ad9e8b517c12 100644
--- a/compiler/types/Type.lhs
+++ b/compiler/types/Type.lhs
@@ -6,6 +6,7 @@
 Type - public interface
 
 \begin{code}
+{-# LANGUAGE CPP #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
 -- | Main functions for manipulating types and type-related things
@@ -35,7 +36,7 @@ module Type (
 
         mkForAllTy, mkForAllTys, splitForAllTy_maybe, splitForAllTys,
         mkPiKinds, mkPiType, mkPiTypes,
-        applyTy, applyTys, applyTysD, isForAllTy, dropForAlls,
+        applyTy, applyTys, applyTysD, dropForAlls,
 
         mkNumLitTy, isNumLitTy,
         mkStrLitTy, isStrLitTy,
@@ -50,7 +51,7 @@ module Type (
         isDictLikeTy,
         mkEqPred, mkCoerciblePred, mkPrimEqPred, mkReprPrimEqPred,
         mkClassPred,
-        noParenPred, isClassPred, isEqPred,
+        isClassPred, isEqPred,
         isIPPred, isIPPred_maybe, isIPTyCon, isIPClass,
 
         -- Deconstructing predicate types
@@ -62,7 +63,7 @@ module Type (
         funTyCon,
 
         -- ** Predicates on types
-        isTypeVar, isKindVar,
+        isTypeVar, isKindVar, allDistinctTyVars, isForAllTy,
         isTyVarTy, isFunTy, isDictTy, isPredTy, isVoidTy,
 
         -- (Lifting and boxity)
@@ -128,9 +129,10 @@ module Type (
 
         -- * Pretty-printing
         pprType, pprParendType, pprTypeApp, pprTyThingCategory, pprTyThing,
-        pprTvBndr, pprTvBndrs, pprForAll, pprSigmaType,
-        pprEqPred, pprTheta, pprThetaArrowTy, pprClassPred,
+        pprTvBndr, pprTvBndrs, pprForAll, pprUserForAll, pprSigmaType,
+        pprTheta, pprThetaArrowTy, pprClassPred,
         pprKind, pprParendKind, pprSourceTyCon,
+        TyPrec(..), maybeParen,
 
         -- * Tidying type related things up for printing
         tidyType,      tidyTypes,
@@ -321,6 +323,15 @@ getTyVar_maybe ty | Just ty' <- coreView ty = getTyVar_maybe ty'
 getTyVar_maybe (TyVarTy tv)                 = Just tv
 getTyVar_maybe _                            = Nothing
 
+allDistinctTyVars :: [KindOrType] -> Bool
+allDistinctTyVars tkvs = go emptyVarSet tkvs
+  where
+    go _      [] = True
+    go so_far (ty : tys)
+       = case getTyVar_maybe ty of
+             Nothing -> False
+             Just tv | tv `elemVarSet` so_far -> False
+                     | otherwise -> go (so_far `extendVarSet` tv) tys
 \end{code}
 
 
@@ -813,7 +824,7 @@ applyTysD doc orig_fun_ty arg_tys
   = substTyWith (take n_args tvs) arg_tys
                 (mkForAllTys (drop n_args tvs) rho_ty)
   | otherwise           -- Too many type args
-  = ASSERT2( n_tvs > 0, doc $$ ppr orig_fun_ty )        -- Zero case gives infnite loop!
+  = ASSERT2( n_tvs > 0, doc $$ ppr orig_fun_ty )        -- Zero case gives infinite loop!
     applyTysD doc (substTyWith tvs (take n_tvs arg_tys) rho_ty)
                   (drop n_tvs arg_tys)
   where
@@ -832,13 +843,6 @@ applyTysD doc orig_fun_ty arg_tys
 Predicates on PredType
 
 \begin{code}
-noParenPred :: PredType -> Bool
--- A predicate that can appear without parens before a "=>"
---       C a => a -> a
---       a~b => a -> b
--- But   (?x::Int) => Int -> Int
-noParenPred p = not (isIPPred p) && isClassPred p || isEqPred p
-
 isPredTy :: Type -> Bool
   -- NB: isPredTy is used when printing types, which can happen in debug printing
   --     during type checking of not-fully-zonked types.  So it's not cool to say
@@ -1179,7 +1183,7 @@ seqTypes (ty:tys) = seqType ty `seq` seqTypes tys
 
 %************************************************************************
 %*                                                                      *
-                Comparision for types
+                Comparison for types
         (We don't use instances so that we know where it happens)
 %*                                                                      *
 %************************************************************************
@@ -1365,7 +1369,7 @@ emptyTvSubst :: TvSubst
 emptyTvSubst = TvSubst emptyInScopeSet emptyTvSubstEnv
 
 isEmptyTvSubst :: TvSubst -> Bool
-         -- See Note [Extending the TvSubstEnv]
+         -- See Note [Extending the TvSubstEnv] in TypeRep
 isEmptyTvSubst (TvSubst _ tenv) = isEmptyVarEnv tenv
 
 mkTvSubst :: InScopeSet -> TvSubstEnv -> TvSubst
@@ -1559,7 +1563,7 @@ subst_ty subst ty
 substTyVar :: TvSubst -> TyVar  -> Type
 substTyVar (TvSubst _ tenv) tv
   | Just ty  <- lookupVarEnv tenv tv      = ty  -- See Note [Apply Once]
-  | otherwise = ASSERT( isTyVar tv ) TyVarTy tv
+  | otherwise = ASSERT( isTyVar tv ) TyVarTy tv --     in TypeRep
   -- We do not require that the tyvar is in scope
   -- Reason: we do quite a bit of (substTyWith [tv] [ty] tau)
   -- and it's a nuisance to bring all the free vars of tau into
@@ -1570,7 +1574,7 @@ substTyVars :: TvSubst -> [TyVar] -> [Type]
 substTyVars subst tvs = map (substTyVar subst) tvs
 
 lookupTyVar :: TvSubst -> TyVar  -> Maybe Type
-        -- See Note [Extending the TvSubst]
+        -- See Note [Extending the TvSubst] in TypeRep
 lookupTyVar (TvSubst _ tenv) tv = lookupVarEnv tenv tv
 
 substTyVarBndr :: TvSubst -> TyVar -> (TvSubst, TyVar)
@@ -1589,7 +1593,7 @@ substTyVarBndr subst@(TvSubst in_scope tenv) old_var
     no_change = no_kind_change && (new_var == old_var)
         -- no_change means that the new_var is identical in
         -- all respects to the old_var (same unique, same kind)
-        -- See Note [Extending the TvSubst]
+        -- See Note [Extending the TvSubst] in TypeRep
         --
         -- In that case we don't need to extend the substitution
         -- to map old to new.  But instead we must zap any
@@ -1635,26 +1639,31 @@ type SimpleKind = Kind
 
 \begin{code}
 typeKind :: Type -> Kind
-typeKind (TyConApp tc tys)
-  | isPromotedTyCon tc
-  = ASSERT( tyConArity tc == length tys ) superKind
-  | otherwise
-  = kindAppResult (tyConKind tc) tys
-
-typeKind (AppTy fun arg)      = kindAppResult (typeKind fun) [arg]
-typeKind (LitTy l)            = typeLiteralKind l
-typeKind (ForAllTy _ ty)      = typeKind ty
-typeKind (TyVarTy tyvar)      = tyVarKind tyvar
-typeKind _ty@(FunTy _arg res)
-    -- Hack alert.  The kind of (Int -> Int#) is liftedTypeKind (*),
-    --              not unliftedTypKind (#)
-    -- The only things that can be after a function arrow are
-    --   (a) types (of kind openTypeKind or its sub-kinds)
-    --   (b) kinds (of super-kind TY) (e.g. * -> (* -> *))
-    | isSuperKind k         = k
-    | otherwise             = ASSERT2( isSubOpenTypeKind k, ppr _ty $$ ppr k ) liftedTypeKind
-    where
-      k = typeKind res
+typeKind orig_ty = go orig_ty
+  where
+    
+    go ty@(TyConApp tc tys)
+      | isPromotedTyCon tc
+      = ASSERT( tyConArity tc == length tys ) superKind
+      | otherwise
+      = kindAppResult (ptext (sLit "typeKind 1") <+> ppr ty $$ ppr orig_ty)
+                      (tyConKind tc) tys
+
+    go ty@(AppTy fun arg)   = kindAppResult (ptext (sLit "typeKind 2") <+> ppr ty $$ ppr orig_ty)
+                                            (go fun) [arg]
+    go (LitTy l)            = typeLiteralKind l
+    go (ForAllTy _ ty)      = go ty
+    go (TyVarTy tyvar)      = tyVarKind tyvar
+    go _ty@(FunTy _arg res)
+        -- Hack alert.  The kind of (Int -> Int#) is liftedTypeKind (*),
+        --              not unliftedTypeKind (#)
+        -- The only things that can be after a function arrow are
+        --   (a) types (of kind openTypeKind or its sub-kinds)
+        --   (b) kinds (of super-kind TY) (e.g. * -> (* -> *))
+        | isSuperKind k         = k
+        | otherwise             = ASSERT2( isSubOpenTypeKind k, ppr _ty $$ ppr k ) liftedTypeKind
+        where
+          k = go res
 
 typeLiteralKind :: TyLit -> Kind
 typeLiteralKind l =
diff --git a/compiler/types/Type.lhs-boot b/compiler/types/Type.lhs-boot
index c2d2dec09380..ff9db3e28c37 100644
--- a/compiler/types/Type.lhs-boot
+++ b/compiler/types/Type.lhs-boot
@@ -3,7 +3,6 @@ module Type where
 import {-# SOURCE #-} TypeRep( Type, Kind )
 import Var
 
-noParenPred :: Type -> Bool
 isPredTy :: Type -> Bool
 
 typeKind :: Type -> Kind
diff --git a/compiler/types/TypeRep.lhs b/compiler/types/TypeRep.lhs
index 906989a718e2..c8b20e8d9335 100644
--- a/compiler/types/TypeRep.lhs
+++ b/compiler/types/TypeRep.lhs
@@ -15,16 +15,16 @@ Note [The Type-related module hierarchy]
   Coercion imports Type
 
 \begin{code}
-{-# OPTIONS -fno-warn-tabs #-}
+{-# LANGUAGE CPP, DeriveDataTypeable, DeriveFunctor, DeriveFoldable, DeriveTraversable #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
 -- The above warning supression flag is a temporary kludge.
 -- While working on this module you are encouraged to remove it and
 -- detab the module (please do the detabbing in a separate patch). See
 --     http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
 -- for details
-
--- We expose the relevant stuff from this module via the Type module
 {-# OPTIONS_HADDOCK hide #-}
-{-# LANGUAGE DeriveDataTypeable, DeriveFunctor, DeriveFoldable, DeriveTraversable #-}
+-- We expose the relevant stuff from this module via the Type module
+
 module TypeRep (
 	TyThing(..),
 	Type(..),
@@ -39,9 +39,10 @@ module TypeRep (
         -- Pretty-printing
 	pprType, pprParendType, pprTypeApp, pprTvBndr, pprTvBndrs,
 	pprTyThing, pprTyThingCategory, pprSigmaType,
-	pprEqPred, pprTheta, pprForAll, pprThetaArrowTy, pprClassPred,
+	pprTheta, pprForAll, pprUserForAll,
+        pprThetaArrowTy, pprClassPred,
         pprKind, pprParendKind, pprTyLit, suppressKinds,
-	Prec(..), maybeParen, pprTcApp, 
+	TyPrec(..), maybeParen, pprTcApp, 
         pprPrefixApp, pprArrowChain, ppr_type,
 
         -- Free variables
@@ -65,7 +66,7 @@ module TypeRep (
 
 import {-# SOURCE #-} DataCon( dataConTyCon )
 import ConLike ( ConLike(..) )
-import {-# SOURCE #-} Type( noParenPred, isPredTy ) -- Transitively pulls in a LOT of stuff, better to break the loop
+import {-# SOURCE #-} Type( isPredTy ) -- Transitively pulls in a LOT of stuff, better to break the loop
 
 -- friends:
 import Var
@@ -81,7 +82,6 @@ import CoAxiom
 import PrelNames
 import Outputable
 import FastString
-import Pair
 import Util
 import DynFlags
 
@@ -415,7 +415,7 @@ instance NamedThing TyThing where	-- Can't put this with the type
 -- 2. In particular, the /kind/ of the type variables in 
 -- the in-scope set is not relevant
 --
--- 3. The substition is only applied ONCE! This is because
+-- 3. The substitution is only applied ONCE! This is because
 -- in general such application will not reached a fixed point.
 data TvSubst 		
   = TvSubst InScopeSet 	-- The in-scope type and kind variables
@@ -423,7 +423,7 @@ data TvSubst
 	-- See Note [Apply Once]
 	-- and Note [Extending the TvSubstEnv]
 
--- | A substitition of 'Type's for 'TyVar's
+-- | A substitution of 'Type's for 'TyVar's
 --                 and 'Kind's for 'KindVar's
 type TvSubstEnv = TyVarEnv Type
 	-- A TvSubstEnv is used both inside a TvSubst (with the apply-once
@@ -439,10 +439,10 @@ We use TvSubsts to instantiate things, and we might instantiate
 	forall a b. ty
 \with the types
 	[a, b], or [b, a].
-So the substition might go [a->b, b->a].  A similar situation arises in Core
+So the substitution might go [a->b, b->a].  A similar situation arises in Core
 when we find a beta redex like
 	(/\ a /\ b -> e) b a
-Then we also end up with a substition that permutes type variables. Other
+Then we also end up with a substitution that permutes type variables. Other
 variations happen to; for example [a -> (a, b)].  
 
 	***************************************************
@@ -491,13 +491,31 @@ defined to use this.  @pprParendType@ is the same, except it puts
 parens around the type, except for the atomic cases.  @pprParendType@
 works just by setting the initial context precedence very high.
 
+Note [Precedence in types]
+~~~~~~~~~~~~~~~~~~~~~~~~~~
+We don't keep the fixity of type operators in the operator. So the pretty printer
+operates the following precedene structre:
+   Type constructor application   binds more tightly than
+   Oerator applications           which bind more tightly than
+   Function arrow
+
+So we might see  a :+: T b -> c
+meaning          (a :+: (T b)) -> c
+
+Maybe operator applications should bind a bit less tightly?
+
+Anyway, that's the current story, and it is used consistently for Type and HsType
+
 \begin{code}
-data Prec = TopPrec 	-- No parens
-	  | FunPrec 	-- Function args; no parens for tycon apps
-	  | TyConPrec 	-- Tycon args; no parens for atomic
-	  deriving( Eq, Ord )
+data TyPrec   -- See Note [Prededence in types]
+
+  = TopPrec         -- No parens
+  | FunPrec         -- Function args; no parens for tycon apps
+  | TyOpPrec        -- Infix operator
+  | TyConPrec       -- Tycon args; no parens for atomic
+  deriving( Eq, Ord )
 
-maybeParen :: Prec -> Prec -> SDoc -> SDoc
+maybeParen :: TyPrec -> TyPrec -> SDoc -> SDoc
 maybeParen ctxt_prec inner_prec pretty
   | ctxt_prec < inner_prec = pretty
   | otherwise		   = parens pretty
@@ -514,18 +532,6 @@ pprKind, pprParendKind :: Kind -> SDoc
 pprKind       = pprType
 pprParendKind = pprParendType
 
-------------------
-pprEqPred :: Pair Type -> SDoc
--- NB: Maybe move to Coercion? It's only called after coercionKind anyway. 
-pprEqPred (Pair ty1 ty2) 
-  = sep [ ppr_type FunPrec ty1
-        , nest 2 (ptext (sLit "~#"))
-        , ppr_type FunPrec ty2]
-    -- Precedence looks like (->) so that we get
-    --    Maybe a ~ Bool
-    --    (a->a) ~ Bool
-    -- Note parens on the latter!
-
 ------------
 pprClassPred :: Class -> [Type] -> SDoc
 pprClassPred clas tys = pprTypeApp (classTyCon clas) tys
@@ -536,10 +542,9 @@ pprTheta :: ThetaType -> SDoc
 pprTheta theta  = parens (sep (punctuate comma (map (ppr_type TopPrec) theta)))
 
 pprThetaArrowTy :: ThetaType -> SDoc
-pprThetaArrowTy []      = empty
-pprThetaArrowTy [pred]
-      | noParenPred pred = ppr_type TopPrec pred <+> darrow
-pprThetaArrowTy preds   = parens (fsep (punctuate comma (map (ppr_type TopPrec) preds)))
+pprThetaArrowTy []     = empty
+pprThetaArrowTy [pred] = ppr_type FunPrec pred <+> darrow
+pprThetaArrowTy preds  = parens (fsep (punctuate comma (map (ppr_type TopPrec) preds)))
                             <+> darrow
     -- Notice 'fsep' here rather that 'sep', so that
     -- type contexts don't get displayed in a giant column
@@ -573,15 +578,9 @@ instance Outputable TyLit where
 ------------------
 	-- OK, here's the main printer
 
-ppr_type :: Prec -> Type -> SDoc
+ppr_type :: TyPrec -> Type -> SDoc
 ppr_type _ (TyVarTy tv)	      = ppr_tvar tv
-
-ppr_type _ (TyConApp tc [LitTy (StrTyLit n),ty])
-  | tc `hasKey` ipClassNameKey
-  = char '?' <> ftext n <> ptext (sLit "::") <> ppr_type TopPrec ty
-
 ppr_type p (TyConApp tc tys)  = pprTyTcApp p tc tys
-
 ppr_type p (LitTy l)          = ppr_tylit p l
 ppr_type p ty@(ForAllTy {})   = ppr_forall_type p ty
 
@@ -600,15 +599,17 @@ ppr_type p fun_ty@(FunTy ty1 ty2)
     ppr_fun_tail other_ty = [ppr_type TopPrec other_ty]
 
 
-ppr_forall_type :: Prec -> Type -> SDoc
+ppr_forall_type :: TyPrec -> Type -> SDoc
 ppr_forall_type p ty
   = maybeParen p FunPrec $ ppr_sigma_type True ty
+    -- True <=> we always print the foralls on *nested* quantifiers
+    -- Opt_PrintExplicitForalls only affects top-level quantifiers
 
 ppr_tvar :: TyVar -> SDoc
 ppr_tvar tv  -- Note [Infix type variables]
   = parenSymOcc (getOccName tv) (ppr tv)
 
-ppr_tylit :: Prec -> TyLit -> SDoc
+ppr_tylit :: TyPrec -> TyLit -> SDoc
 ppr_tylit _ tl =
   case tl of
     NumTyLit n -> integer n
@@ -616,34 +617,38 @@ ppr_tylit _ tl =
 
 -------------------
 ppr_sigma_type :: Bool -> Type -> SDoc
--- Bool <=> Show the foralls
-ppr_sigma_type show_foralls ty
-  = sdocWithDynFlags $ \ dflags -> 
-    let filtered_tvs | gopt Opt_PrintExplicitKinds dflags 
-                     = tvs
-                     | otherwise
-                     = filterOut isKindVar tvs
-    in sep [ ppWhen show_foralls (pprForAll filtered_tvs)
-           , pprThetaArrowTy ctxt
-           , pprType tau ]
+-- Bool <=> Show the foralls unconditionally
+ppr_sigma_type show_foralls_unconditionally ty
+  = sep [ if   show_foralls_unconditionally
+          then pprForAll tvs
+          else pprUserForAll tvs
+        , pprThetaArrowTy ctxt
+        , pprType tau ]
   where
     (tvs,  rho) = split1 [] ty
     (ctxt, tau) = split2 [] rho
 
     split1 tvs (ForAllTy tv ty) = split1 (tv:tvs) ty
-    split1 tvs ty          = (reverse tvs, ty)
- 
+    split1 tvs ty               = (reverse tvs, ty)
+
     split2 ps (ty1 `FunTy` ty2) | isPredTy ty1 = split2 (ty1:ps) ty2
     split2 ps ty                               = (reverse ps, ty)
 
-
 pprSigmaType :: Type -> SDoc
-pprSigmaType ty = sdocWithDynFlags $ \dflags ->
-                  ppr_sigma_type (gopt Opt_PrintExplicitForalls dflags) ty
+pprSigmaType ty = ppr_sigma_type False ty
+
+pprUserForAll :: [TyVar] -> SDoc
+-- Print a user-level forall; see Note [WHen to print foralls]
+pprUserForAll tvs
+  = sdocWithDynFlags $ \dflags ->
+    ppWhen (any tv_has_kind_var tvs || gopt Opt_PrintExplicitForalls dflags) $
+    pprForAll tvs
+  where
+    tv_has_kind_var tv = not (isEmptyVarSet (tyVarsOfType (tyVarKind tv)))
 
 pprForAll :: [TyVar] -> SDoc
 pprForAll []  = empty
-pprForAll tvs = ptext (sLit "forall") <+> pprTvBndrs tvs <> dot
+pprForAll tvs = forAllLit <+> pprTvBndrs tvs <> dot
 
 pprTvBndrs :: [TyVar] -> SDoc
 pprTvBndrs tvs = sep (map pprTvBndr tvs)
@@ -656,6 +661,24 @@ pprTvBndr tv
 	       kind = tyVarKind tv
 \end{code}
 
+Note [When to print foralls]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Mostly we want to print top-level foralls when (and only when) the user specifies
+-fprint-explicit-foralls.  But when kind polymorphism is at work, that suppresses
+too much information; see Trac #9018.
+
+So I'm trying out this rule: print explicit foralls if
+  a) User specifies -fprint-explicit-foralls, or
+  b) Any of the quantified type variables has a kind 
+     that mentions a kind variable
+
+This catches common situations, such as a type siguature
+     f :: m a
+which means
+      f :: forall k. forall (m :: k->*) (a :: k). m a
+We really want to see both the "forall k" and the kind signatures
+on m and a.  The latter comes from pprTvBndr.
+
 Note [Infix type variables]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~
 With TypeOperators you can say
@@ -680,10 +703,15 @@ pprTypeApp tc tys = pprTyTcApp TopPrec tc tys
         -- We have to use ppr on the TyCon (not its name)
         -- so that we get promotion quotes in the right place
 
-pprTyTcApp :: Prec -> TyCon -> [Type] -> SDoc
+pprTyTcApp :: TyPrec -> TyCon -> [Type] -> SDoc
 -- Used for types only; so that we can make a
 -- special case for type-level lists
 pprTyTcApp p tc tys
+  | tc `hasKey` ipClassNameKey
+  , [LitTy (StrTyLit n),ty] <- tys
+  = maybeParen p FunPrec $
+    char '?' <> ftext n <> ptext (sLit "::") <> ppr_type TopPrec ty
+
   | tc `hasKey` consDataConKey
   , [_kind,ty1,ty2] <- tys
   = sdocWithDynFlags $ \dflags ->
@@ -693,7 +721,7 @@ pprTyTcApp p tc tys
   | otherwise
   = pprTcApp p ppr_type tc tys
 
-pprTcApp :: Prec -> (Prec -> a -> SDoc) -> TyCon -> [a] -> SDoc
+pprTcApp :: TyPrec -> (TyPrec -> a -> SDoc) -> TyCon -> [a] -> SDoc
 -- Used for both types and coercions, hence polymorphism
 pprTcApp _ pp tc [ty]
   | tc `hasKey` listTyConKey = pprPromotionQuote tc <> brackets   (pp TopPrec ty)
@@ -717,7 +745,7 @@ pprTcApp p pp tc tys
   | otherwise
   = sdocWithDynFlags (pprTcApp_help p pp tc tys)
 
-pprTcApp_help :: Prec -> (Prec -> a -> SDoc) -> TyCon -> [a] -> DynFlags -> SDoc
+pprTcApp_help :: TyPrec -> (TyPrec -> a -> SDoc) -> TyCon -> [a] -> DynFlags -> SDoc
 -- This one has accss to the DynFlags
 pprTcApp_help p pp tc tys dflags
   | not (isSymOcc (nameOccName (tyConName tc)))
@@ -740,6 +768,7 @@ pprTcApp_help p pp tc tys dflags
 suppressKinds :: DynFlags -> Kind -> [a] -> [a]
 -- Given the kind of a TyCon, and the args to which it is applied,
 -- suppress the args that are kind args
+-- C.f. Note [Suppressing kinds] in IfaceType
 suppressKinds dflags kind xs
   | gopt Opt_PrintExplicitKinds dflags = xs
   | otherwise                          = suppress kind xs
@@ -749,7 +778,7 @@ suppressKinds dflags kind xs
     suppress _                 xs       = xs
 
 ----------------
-pprTyList :: Prec -> Type -> Type -> SDoc
+pprTyList :: TyPrec -> Type -> Type -> SDoc
 -- Given a type-level list (t1 ': t2), see if we can print 
 -- it in list notation [t1, ...].  
 pprTyList p ty1 ty2
@@ -773,19 +802,19 @@ pprTyList p ty1 ty2
     gather ty = ([], Just ty)
 
 ----------------
-pprInfixApp :: Prec -> (Prec -> a -> SDoc) -> SDoc -> a -> a -> SDoc
+pprInfixApp :: TyPrec -> (TyPrec -> a -> SDoc) -> SDoc -> a -> a -> SDoc
 pprInfixApp p pp pp_tc ty1 ty2
-  = maybeParen p FunPrec $
-    sep [pp FunPrec ty1, pprInfixVar True pp_tc <+> pp FunPrec ty2]
+  = maybeParen p TyOpPrec $
+    sep [pp TyOpPrec ty1, pprInfixVar True pp_tc <+> pp TyOpPrec ty2]
 
-pprPrefixApp :: Prec -> SDoc -> [SDoc] -> SDoc
+pprPrefixApp :: TyPrec -> SDoc -> [SDoc] -> SDoc
 pprPrefixApp p pp_fun pp_tys 
   | null pp_tys = pp_fun
   | otherwise   = maybeParen p TyConPrec $
                   hang pp_fun 2 (sep pp_tys)
 
 ----------------
-pprArrowChain :: Prec -> [SDoc] -> SDoc
+pprArrowChain :: TyPrec -> [SDoc] -> SDoc
 -- pprArrowChain p [a,b,c]  generates   a -> b -> c
 pprArrowChain _ []         = empty
 pprArrowChain p (arg:args) = maybeParen p FunPrec $
diff --git a/compiler/types/Unify.lhs b/compiler/types/Unify.lhs
index 8d1beb6b1dea..1eb1c2b87210 100644
--- a/compiler/types/Unify.lhs
+++ b/compiler/types/Unify.lhs
@@ -3,7 +3,8 @@
 %
 
 \begin{code}
-{-# OPTIONS -fno-warn-tabs #-}
+{-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
 -- The above warning supression flag is a temporary kludge.
 -- While working on this module you are encouraged to remove it and
 -- detab the module (please do the detabbing in a separate patch). See
@@ -22,8 +23,7 @@ module Unify (
 	typesCantMatch,
 
         -- Side-effect free unification
-        tcUnifyTys, BindFlag(..),
-        niFixTvSubst, niSubstTvSet,
+        tcUnifyTy, tcUnifyTys, BindFlag(..),
 
         UnifyResultM(..), UnifyResult, tcUnifyTysFG
 
@@ -205,6 +205,8 @@ match _ subst (LitTy x) (LitTy y) | x == y  = return subst
 match _ _ _ _
   = Nothing
 
+
+
 --------------
 match_kind :: MatchEnv -> TvSubstEnv -> Kind -> Kind -> Maybe TvSubstEnv
 -- Match the kind of the template tyvar with the kind of Type
@@ -416,18 +418,45 @@ substituted, we can't properly unify the types. But, that skolem variable
 may later be instantiated with a unifyable type. So, we return maybeApart
 in these cases.
 
+Note [Lists of different lengths are MaybeApart]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+It is unusual to call tcUnifyTys or tcUnifyTysFG with lists of different
+lengths. The place where we know this can happen is from compatibleBranches in
+FamInstEnv, when checking data family instances. Data family instances may be
+eta-reduced; see Note [Eta reduction for data family axioms] in TcInstDcls.
+
+We wish to say that
+
+  D :: * -> * -> *
+  axDF1 :: D Int ~ DFInst1
+  axDF2 :: D Int Bool ~ DFInst2
+
+overlap. If we conclude that lists of different lengths are SurelyApart, then
+it will look like these do *not* overlap, causing disaster. See Trac #9371.
+
+In usages of tcUnifyTys outside of family instances, we always use tcUnifyTys,
+which can't tell the difference between MaybeApart and SurelyApart, so those
+usages won't notice this design choice.
+
 \begin{code}
+tcUnifyTy :: Type -> Type       -- All tyvars are bindable
+	  -> Maybe TvSubst	-- A regular one-shot (idempotent) substitution
+-- Simple unification of two types; all type variables are bindable
+tcUnifyTy ty1 ty2
+  = case initUM (const BindMe) (unify emptyTvSubstEnv ty1 ty2) of
+      Unifiable subst_env -> Just (niFixTvSubst subst_env)
+      _other              -> Nothing
+
+-----------------
 tcUnifyTys :: (TyVar -> BindFlag)
 	   -> [Type] -> [Type]
 	   -> Maybe TvSubst	-- A regular one-shot (idempotent) substitution
 -- The two types may have common type variables, and indeed do so in the
 -- second call to tcUnifyTys in FunDeps.checkClsFD
---
 tcUnifyTys bind_fn tys1 tys2
-  | Unifiable subst <- tcUnifyTysFG bind_fn tys1 tys2
-  = Just subst
-  | otherwise
-  = Nothing
+  = case tcUnifyTysFG bind_fn tys1 tys2 of
+      Unifiable subst -> Just subst
+      _               -> Nothing
 
 -- This type does double-duty. It is used in the UM (unifier monad) and to
 -- return the final result. See Note [Fine-grained unification]
@@ -463,19 +492,52 @@ During unification we use a TvSubstEnv that is
   (a) non-idempotent
   (b) loop-free; ie repeatedly applying it yields a fixed point
 
+Note [Finding the substitution fixpoint]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Finding the fixpoint of a non-idempotent substitution arising from a
+unification is harder than it looks, because of kinds.  Consider
+   T k (H k (f:k)) ~ T * (g:*)
+If we unify, we get the substitution
+   [ k -> *
+   , g -> H k (f:k) ]
+To make it idempotent we don't want to get just
+   [ k -> *
+   , g -> H * (f:k) ]
+We also want to substitute inside f's kind, to get
+   [ k -> *
+   , g -> H k (f:*) ]
+If we don't do this, we may apply the substitition to something,
+and get an ill-formed type, i.e. one where typeKind will fail.
+This happened, for example, in Trac #9106.
+
+This is the reason for extending env with [f:k -> f:*], in the
+definition of env' in niFixTvSubst
+
 \begin{code}
 niFixTvSubst :: TvSubstEnv -> TvSubst
 -- Find the idempotent fixed point of the non-idempotent substitution
+-- See Note [Finding the substitution fixpoint]
 -- ToDo: use laziness instead of iteration?
 niFixTvSubst env = f env
   where
-    f e | not_fixpoint = f (mapVarEnv (substTy subst) e)
-        | otherwise    = subst
+    f env | not_fixpoint = f (mapVarEnv (substTy subst') env)
+          | otherwise    = subst
         where
-          range_tvs    = foldVarEnv (unionVarSet . tyVarsOfType) emptyVarSet e
-          subst        = mkTvSubst (mkInScopeSet range_tvs) e 
-          not_fixpoint = foldVarSet ((||) . in_domain) False range_tvs
-          in_domain tv = tv `elemVarEnv` e
+          not_fixpoint  = foldVarSet ((||) . in_domain) False all_range_tvs
+          in_domain tv  = tv `elemVarEnv` env
+
+          range_tvs     = foldVarEnv (unionVarSet . tyVarsOfType) emptyVarSet env
+          all_range_tvs = closeOverKinds range_tvs
+          subst         = mkTvSubst (mkInScopeSet all_range_tvs) env
+
+             -- env' extends env by replacing any free type with 
+             -- that same tyvar with a substituted kind
+             -- See note [Finding the substitution fixpoint]
+          env'          = extendVarEnvList env [ (rtv, mkTyVarTy $ setTyVarKind rtv $
+                                                       substTy subst $ tyVarKind rtv)
+                                               | rtv <- varSetElems range_tvs
+                                               , not (in_domain rtv) ]
+          subst'        = mkTvSubst (mkInScopeSet all_range_tvs) env'
 
 niSubstTvSet :: TvSubstEnv -> TyVarSet -> TyVarSet
 -- Apply the non-idempotent substitution to a set of type variables,
@@ -551,7 +613,7 @@ unifyList subst orig_xs orig_ys
     go subst []     []     = return subst
     go subst (x:xs) (y:ys) = do { subst' <- unify subst x y
 				; go subst' xs ys }
-    go _ _ _ = surelyApart
+    go subst _ _ = maybeApart subst  -- See Note [Lists of different lengths are MaybeApart]
 
 ---------------------------------
 uVar :: TvSubstEnv	-- An existing substitution to extend
@@ -613,6 +675,7 @@ uUnrefined subst tv1 ty2 ty2'	-- ty2 is not a type variable
                                         -- See Note [Fine-grained unification]
   | otherwise
   = do { subst' <- unify subst k1 k2
+       -- Note [Kinds Containing Only Literals]
        ; bindTv subst' tv1 ty2 }	-- Bind tyvar to the synonym if poss
   where
     k1 = tyVarKind tv1
@@ -670,9 +733,9 @@ instance Monad UM where
                                other        -> other
                            SurelyApart -> SurelyApart)
 
-initUM :: (TyVar -> BindFlag) -> UM TvSubst -> UnifyResult
+initUM :: (TyVar -> BindFlag) -> UM a -> UnifyResultM a
 initUM badtvs um = unUM um badtvs
-    
+
 tvBindFlag :: TyVar -> UM BindFlag
 tvBindFlag tv = UM (\tv_fn -> Unifiable (tv_fn tv))
 
diff --git a/compiler/utils/Bag.lhs b/compiler/utils/Bag.lhs
index 2d823e46bbe0..65c5b39df17d 100644
--- a/compiler/utils/Bag.lhs
+++ b/compiler/utils/Bag.lhs
@@ -6,6 +6,8 @@
 Bag: an unordered collection with duplicates
 
 \begin{code}
+{-# LANGUAGE DeriveDataTypeable, ScopedTypeVariables #-}
+
 module Bag (
         Bag, -- abstract type
 
diff --git a/compiler/utils/Binary.hs b/compiler/utils/Binary.hs
index 332bfc8e0cc6..bd194b0fde47 100644
--- a/compiler/utils/Binary.hs
+++ b/compiler/utils/Binary.hs
@@ -1,4 +1,4 @@
-{-# OPTIONS -cpp #-}
+{-# LANGUAGE CPP, MagicHash, UnboxedTuples #-}
 {-# OPTIONS_GHC -O -funbox-strict-fields #-}
 -- We always optimise this, otherwise performance of a non-optimised
 -- compiler is severely affected
@@ -27,9 +27,11 @@ module Binary
    seekBy,
    tellBin,
    castBin,
+   diffBin,
 
    writeBinMem,
    readBinMem,
+   getBinMemBuf,
 
    fingerprintBinMem,
    computeFingerprint,
@@ -124,6 +126,9 @@ newtype Bin a = BinPtr Int
 castBin :: Bin a -> Bin b
 castBin (BinPtr i) = BinPtr i
 
+diffBin :: Bin a -> Bin a -> Int
+diffBin (BinPtr i) (BinPtr j) = i - j
+
 ---------------------------------------------------------------
 -- class Binary
 ---------------------------------------------------------------
@@ -208,6 +213,12 @@ readBinMem filename = do
   writeFastMutInt sz_r filesize
   return (BinMem noUserData ix_r sz_r arr_r)
 
+getBinMemBuf :: BinHandle -> IO (Int, ForeignPtr Word8)
+getBinMemBuf (BinMem _ ix_r _ arr_r) = do
+  arr <- readIORef arr_r
+  ix  <- readFastMutInt ix_r
+  return (ix, arr)
+
 fingerprintBinMem :: BinHandle -> IO Fingerprint
 fingerprintBinMem (BinMem _ ix_r _ arr_r) = do
   arr <- readIORef arr_r
@@ -707,14 +718,13 @@ getBS bh = do
   l <- get bh
   fp <- mallocForeignPtrBytes l
   withForeignPtr fp $ \ptr -> do
-  let
-        go n | n == l = return $ BS.fromForeignPtr fp 0 l
+    let go n | n == l = return $ BS.fromForeignPtr fp 0 l
              | otherwise = do
                 b <- getByte bh
                 pokeElemOff ptr n b
                 go (n+1)
-  --
-  go 0
+    --
+    go 0
 
 instance Binary ByteString where
   put_ bh f = putBS bh f
@@ -834,18 +844,30 @@ instance Binary RecFlag where
               0 -> do return Recursive
               _ -> do return NonRecursive
 
-instance Binary OverlapFlag where
-    put_ bh (NoOverlap  b) = putByte bh 0 >> put_ bh b
-    put_ bh (OverlapOk  b) = putByte bh 1 >> put_ bh b
-    put_ bh (Incoherent b) = putByte bh 2 >> put_ bh b
+instance Binary OverlapMode where
+    put_ bh NoOverlap     = putByte bh 0
+    put_ bh Overlaps      = putByte bh 1
+    put_ bh Incoherent    = putByte bh 2
+    put_ bh Overlapping   = putByte bh 3
+    put_ bh Overlappable  = putByte bh 4
     get bh = do
         h <- getByte bh
-        b <- get bh
         case h of
-            0 -> return $ NoOverlap b
-            1 -> return $ OverlapOk b
-            2 -> return $ Incoherent b
-            _ -> panic ("get OverlapFlag " ++ show h)
+            0 -> return NoOverlap
+            1 -> return Overlaps
+            2 -> return Incoherent
+            3 -> return Overlapping
+            4 -> return Overlappable
+            _ -> panic ("get OverlapMode" ++ show h)
+
+
+instance Binary OverlapFlag where
+    put_ bh flag = do put_ bh (overlapMode flag)
+                      put_ bh (isSafeOverlap flag)
+    get bh = do
+        h <- get bh
+        b <- get bh
+        return OverlapFlag { overlapMode = h, isSafeOverlap = b }
 
 instance Binary FixityDirection where
     put_ bh InfixL = do
diff --git a/compiler/utils/BufWrite.hs b/compiler/utils/BufWrite.hs
index f85ea8e792e0..7eba0753fe62 100644
--- a/compiler/utils/BufWrite.hs
+++ b/compiler/utils/BufWrite.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE CPP #-}
+
 -----------------------------------------------------------------------------
 --
 -- Fast write-buffered Handles
@@ -10,7 +12,7 @@
 --
 -----------------------------------------------------------------------------
 
-{-# OPTIONS -fno-warn-tabs #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
 -- The above warning supression flag is a temporary kludge.
 -- While working on this module you are encouraged to remove it and
 -- detab the module (please do the detabbing in a separate patch). See
diff --git a/compiler/utils/Digraph.lhs b/compiler/utils/Digraph.lhs
index cc684303b63d..35782bac6e49 100644
--- a/compiler/utils/Digraph.lhs
+++ b/compiler/utils/Digraph.lhs
@@ -3,28 +3,21 @@
 %
 
 \begin{code}
-{-# OPTIONS -fno-warn-tabs #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and
--- detab the module (please do the detabbing in a separate patch). See
---     http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
--- for details
-
-{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE CPP, ScopedTypeVariables #-}
 module Digraph(
         Graph, graphFromVerticesAndAdjacency, graphFromEdgedVertices,
 
         SCC(..), Node, flattenSCC, flattenSCCs,
-        stronglyConnCompG, stronglyConnCompFromG,
+        stronglyConnCompG,
         topologicalSortG, dfsTopSortG,
         verticesG, edgesG, hasVertexG,
-        reachableG, transposeG,
+        reachableG, reachablesG, transposeG,
         outdegreeG, indegreeG,
         vertexGroupsG, emptyG,
         componentsG,
 
         findCycle,
-  
+
         -- For backwards compatability with the simpler version of Digraph
         stronglyConnCompFromEdgedVertices, stronglyConnCompFromEdgedVerticesR,
 
@@ -77,14 +70,14 @@ Note [Nodes, keys, vertices]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  * A 'node' is a big blob of client-stuff
 
- * Each 'node' has a unique (client) 'key', but the latter 
-	is in Ord and has fast comparison
+ * Each 'node' has a unique (client) 'key', but the latter
+        is in Ord and has fast comparison
 
  * Digraph then maps each 'key' to a Vertex (Int) which is
-  	arranged densely in 0.n
+        arranged densely in 0.n
 
 \begin{code}
-data Graph node = Graph { 
+data Graph node = Graph {
     gr_int_graph      :: IntGraph,
     gr_vertex_to_node :: Vertex -> node,
     gr_node_to_vertex :: node -> Maybe Vertex
@@ -92,12 +85,12 @@ data Graph node = Graph {
 
 data Edge node = Edge node node
 
-type Node key payload = (payload, key, [key])	
+type Node key payload = (payload, key, [key])
      -- The payload is user data, just carried around in this module
      -- The keys are ordered
-     -- The [key] are the dependencies of the node; 
+     -- The [key] are the dependencies of the node;
      --    it's ok to have extra keys in the dependencies that
-     --	   are not the key of any Node in the graph
+     --    are not the key of any Node in the graph
 
 emptyGraph :: Graph a
 emptyGraph = Graph (array (1, 0) []) (error "emptyGraph") (const Nothing)
@@ -105,7 +98,7 @@ emptyGraph = Graph (array (1, 0) []) (error "emptyGraph") (const Nothing)
 graphFromVerticesAndAdjacency
         :: Ord key
         => [(node, key)]
-        -> [(key, key)]  -- First component is source vertex key, 
+        -> [(key, key)]  -- First component is source vertex key,
                          -- second is target vertex key (thing depended on)
                          -- Unlike the other interface I insist they correspond to
                          -- actual vertices because the alternative hides bugs. I can't
@@ -115,7 +108,7 @@ graphFromVerticesAndAdjacency []       _     = emptyGraph
 graphFromVerticesAndAdjacency vertices edges = Graph graph vertex_node (key_vertex . key_extractor)
   where key_extractor = snd
         (bounds, vertex_node, key_vertex, _) = reduceNodesIntoVertices vertices key_extractor
-        key_vertex_pair (a, b) = (expectJust "graphFromVerticesAndAdjacency" $ key_vertex a, 
+        key_vertex_pair (a, b) = (expectJust "graphFromVerticesAndAdjacency" $ key_vertex a,
                                   expectJust "graphFromVerticesAndAdjacency" $ key_vertex b)
         reduced_edges = map key_vertex_pair edges
         graph = buildG bounds reduced_edges
@@ -132,10 +125,10 @@ graphFromEdgedVertices edged_vertices = Graph graph vertex_fn (key_vertex . key_
         (bounds, vertex_fn, key_vertex, numbered_nodes) = reduceNodesIntoVertices edged_vertices key_extractor
         graph = array bounds [(v, mapMaybe key_vertex ks) | (v, (_, _, ks)) <- numbered_nodes]
 
-reduceNodesIntoVertices 
-        :: Ord key 
-        => [node] 
-        -> (node -> key) 
+reduceNodesIntoVertices
+        :: Ord key
+        => [node]
+        -> (node -> key)
         -> (Bounds, Vertex -> node, key -> Maybe Vertex, [(Int, node)])
 reduceNodesIntoVertices nodes key_extractor = (bounds, (!) vertex_map, key_vertex, numbered_nodes)
   where
@@ -168,18 +161,18 @@ reduceNodesIntoVertices nodes key_extractor = (bounds, (!) vertex_map, key_verte
 
 \begin{code}
 type WorkItem key payload
-  = (Node key payload,	-- Tip of the path
-     [payload])	  	-- Rest of the path; 
-     			--  [a,b,c] means c depends on b, b depends on a
+  = (Node key payload,  -- Tip of the path
+     [payload])         -- Rest of the path;
+                        --  [a,b,c] means c depends on b, b depends on a
 
 -- | Find a reasonably short cycle a->b->c->a, in a strongly
 -- connected component.  The input nodes are presumed to be
 -- a SCC, so you can start anywhere.
-findCycle :: forall payload key. Ord key 
+findCycle :: forall payload key. Ord key
           => [Node key payload]     -- The nodes.  The dependencies can
-	     	     	  	    -- contain extra keys, which are ignored
-	  -> Maybe [payload]        -- A cycle, starting with node
-	     			    -- so each depends on the next
+                                    -- contain extra keys, which are ignored
+          -> Maybe [payload]        -- A cycle, starting with node
+                                    -- so each depends on the next
 findCycle graph
   = go Set.empty (new_work root_deps []) []
   where
@@ -189,29 +182,29 @@ findCycle graph
     -- Find the node with fewest dependencies among the SCC modules
     -- This is just a heuristic to find some plausible root module
     root :: Node key payload
-    root = fst (minWith snd [ (node, count (`Map.member` env) deps) 
+    root = fst (minWith snd [ (node, count (`Map.member` env) deps)
                             | node@(_,_,deps) <- graph ])
     (root_payload,root_key,root_deps) = root
 
 
     -- 'go' implements Dijkstra's algorithm, more or less
-    go :: Set.Set key	-- Visited
-       -> [WorkItem key payload]	-- Work list, items length n
-       -> [WorkItem key payload]	-- Work list, items length n+1
-       -> Maybe [payload]		-- Returned cycle
+    go :: Set.Set key   -- Visited
+       -> [WorkItem key payload]        -- Work list, items length n
+       -> [WorkItem key payload]        -- Work list, items length n+1
+       -> Maybe [payload]               -- Returned cycle
        -- Invariant: in a call (go visited ps qs),
        --            visited = union (map tail (ps ++ qs))
 
-    go _       [] [] = Nothing	-- No cycles
+    go _       [] [] = Nothing  -- No cycles
     go visited [] qs = go visited qs []
-    go visited (((payload,key,deps), path) : ps) qs 
+    go visited (((payload,key,deps), path) : ps) qs
        | key == root_key           = Just (root_payload : reverse path)
        | key `Set.member` visited  = go visited ps qs
        | key `Map.notMember` env   = go visited ps qs
        | otherwise                 = go (Set.insert key visited)
                                         ps (new_qs ++ qs)
        where
-	 new_qs = new_work deps (payload : path)
+         new_qs = new_work deps (payload : path)
 
     new_work :: [key] -> [payload] -> [WorkItem key payload]
     new_work deps path = [ (n, path) | Just n <- map (`Map.lookup` env) deps ]
@@ -250,7 +243,7 @@ instance Outputable a => Outputable (SCC a) where
 %************************************************************************
 
 Note: the components are returned topologically sorted: later components
-depend on earlier ones, but not vice versa i.e. later components only have 
+depend on earlier ones, but not vice versa i.e. later components only have
 edges going from them to earlier ones.
 
 \begin{code}
@@ -258,14 +251,6 @@ stronglyConnCompG :: Graph node -> [SCC node]
 stronglyConnCompG graph = decodeSccs graph forest
   where forest = {-# SCC "Digraph.scc" #-} scc (gr_int_graph graph)
 
--- Find the set of strongly connected components starting from the
--- given roots.  This is a good way to discard unreachable nodes at
--- the same time as computing SCCs.
-stronglyConnCompFromG :: Graph node -> [node] -> [SCC node]
-stronglyConnCompFromG graph roots = decodeSccs graph forest
-  where forest = {-# SCC "Digraph.scc" #-} sccFrom (gr_int_graph graph) vs
-        vs = [ v | Just v <- map (gr_node_to_vertex graph) roots ]
-
 decodeSccs :: Graph node -> Forest Vertex -> [SCC node]
 decodeSccs Graph { gr_int_graph = graph, gr_vertex_to_node = vertex_fn } forest
   = map decode forest
@@ -315,7 +300,13 @@ dfsTopSortG graph =
 reachableG :: Graph node -> node -> [node]
 reachableG graph from = map (gr_vertex_to_node graph) result
   where from_vertex = expectJust "reachableG" (gr_node_to_vertex graph from)
-        result = {-# SCC "Digraph.reachable" #-} reachable (gr_int_graph graph) from_vertex
+        result = {-# SCC "Digraph.reachable" #-} reachable (gr_int_graph graph) [from_vertex]
+
+reachablesG :: Graph node -> [node] -> [node]
+reachablesG graph froms = map (gr_vertex_to_node graph) result
+  where result = {-# SCC "Digraph.reachable" #-}
+                 reachable (gr_int_graph graph) vs
+        vs = [ v | Just v <- map (gr_node_to_vertex graph) froms ]
 
 hasVertexG :: Graph node -> node -> Bool
 hasVertexG graph node = isJust $ gr_node_to_vertex graph node
@@ -548,9 +539,6 @@ postorderF ts = foldr (.) id $ map postorder ts
 postOrd :: IntGraph -> [Vertex]
 postOrd g = postorderF (dff g) []
 
-postOrdFrom :: IntGraph -> [Vertex] -> [Vertex]
-postOrdFrom g vs = postorderF (dfs g vs) []
-
 topSort :: IntGraph -> [Vertex]
 topSort = reverse . postOrd
 \end{code}
@@ -574,9 +562,6 @@ undirected g  = buildG (bounds g) (edges g ++ reverseE g)
 \begin{code}
 scc  :: IntGraph -> Forest Vertex
 scc g = dfs g (reverse (postOrd (transpose g)))
-
-sccFrom  :: IntGraph -> [Vertex] -> Forest Vertex
-sccFrom g vs = reverse (dfs (transpose g) (reverse (postOrdFrom g vs)))
 \end{code}
 
 ------------------------------------------------------------
@@ -602,11 +587,11 @@ forward g tree pre = mapT select g
 ------------------------------------------------------------
 
 \begin{code}
-reachable    :: IntGraph -> Vertex -> [Vertex]
-reachable g v = preorderF (dfs g [v])
+reachable    :: IntGraph -> [Vertex] -> [Vertex]
+reachable g vs = preorderF (dfs g vs)
 
 path         :: IntGraph -> Vertex -> Vertex -> Bool
-path g v w    = w `elem` (reachable g v)
+path g v w    = w `elem` (reachable g [v])
 \end{code}
 
 ------------------------------------------------------------
@@ -664,18 +649,18 @@ noOutEdges g = [ v | v <- vertices g, null (g!v)]
 
 vertexGroupsS :: Set s -> IntGraph -> [Vertex] -> ST s [[Vertex]]
 vertexGroupsS provided g to_provide
-  = if null to_provide 
-    then do { 
+  = if null to_provide
+    then do {
           all_provided <- allM (provided `contains`) (vertices g)
         ; if all_provided
           then return []
-          else error "vertexGroup: cyclic graph" 
+          else error "vertexGroup: cyclic graph"
         }
-    else do { 
+    else do {
           mapM_ (include provided) to_provide
         ; to_provide' <- filterM (vertexReady provided g) (vertices g)
         ; rest <- vertexGroupsS provided g to_provide'
-        ; return $ to_provide : rest 
+        ; return $ to_provide : rest
         }
 
 vertexReady :: Set s -> IntGraph -> Vertex -> ST s Bool
diff --git a/compiler/utils/Encoding.hs b/compiler/utils/Encoding.hs
index c4a669c1341c..115703fc69d6 100644
--- a/compiler/utils/Encoding.hs
+++ b/compiler/utils/Encoding.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE BangPatterns, CPP, MagicHash, UnboxedTuples #-}
 {-# OPTIONS_GHC -O #-}
 -- We always optimise this, otherwise performance of a non-optimised
 -- compiler is severely affected
diff --git a/compiler/utils/ExtsCompat46.hs b/compiler/utils/ExtsCompat46.hs
index da0e67ab932d..a33fef57d8f6 100644
--- a/compiler/utils/ExtsCompat46.hs
+++ b/compiler/utils/ExtsCompat46.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE BangPatterns, CPP #-}
+{-# LANGUAGE BangPatterns, CPP, MagicHash #-}
 
 -----------------------------------------------------------------------------
 -- |
diff --git a/compiler/utils/FastBool.lhs b/compiler/utils/FastBool.lhs
index 32cb7aef3a58..9558da7079cb 100644
--- a/compiler/utils/FastBool.lhs
+++ b/compiler/utils/FastBool.lhs
@@ -4,6 +4,8 @@
 \section{Fast booleans}
 
 \begin{code}
+{-# LANGUAGE CPP, MagicHash #-}
+
 module FastBool (
     --fastBool could be called bBox; isFastTrue, bUnbox; but they're not
     FastBool, fastBool, isFastTrue, fastOr, fastAnd
diff --git a/compiler/utils/FastFunctions.lhs b/compiler/utils/FastFunctions.lhs
index b1dacdcd9bc1..457fcc9c9338 100644
--- a/compiler/utils/FastFunctions.lhs
+++ b/compiler/utils/FastFunctions.lhs
@@ -4,6 +4,7 @@ Z%
 \section{Fast functions}
 
 \begin{code}
+{-# LANGUAGE CPP, MagicHash, UnboxedTuples #-}
 
 module FastFunctions (
     unsafeChr, inlinePerformIO, unsafeDupableInterleaveIO,
diff --git a/compiler/utils/FastMutInt.lhs b/compiler/utils/FastMutInt.lhs
index 7156cdc9fb0e..0f0ca78e144c 100644
--- a/compiler/utils/FastMutInt.lhs
+++ b/compiler/utils/FastMutInt.lhs
@@ -1,6 +1,5 @@
 \begin{code}
-{-# LANGUAGE BangPatterns #-}
-{-# OPTIONS -cpp #-}
+{-# LANGUAGE CPP, BangPatterns, MagicHash, UnboxedTuples #-}
 {-# OPTIONS_GHC -O #-}
 -- We always optimise this, otherwise performance of a non-optimised
 -- compiler is severely affected
diff --git a/compiler/utils/FastString.lhs b/compiler/utils/FastString.lhs
index a4908b58c142..157e5f08b04a 100644
--- a/compiler/utils/FastString.lhs
+++ b/compiler/utils/FastString.lhs
@@ -2,7 +2,7 @@
 % (c) The University of Glasgow, 1997-2006
 %
 \begin{code}
-{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE BangPatterns, CPP, DeriveDataTypeable, MagicHash, UnboxedTuples #-}
 {-# OPTIONS_GHC -O -funbox-strict-fields #-}
 -- We always optimise this, otherwise performance of a non-optimised
 -- compiler is severely affected
@@ -10,18 +10,20 @@
 -- |
 -- There are two principal string types used internally by GHC:
 --
--- 'FastString':
---               * A compact, hash-consed, representation of character strings.
---               * Comparison is O(1), and you can get a 'Unique.Unique' from them.
---               * Generated by 'fsLit'.
---               * Turn into 'Outputable.SDoc' with 'Outputable.ftext'.
+-- ['FastString']
 --
--- 'LitString':
---               * Just a wrapper for the @Addr#@ of a C string (@Ptr CChar@).
---               * Practically no operations.
---               * Outputing them is fast.
---               * Generated by 'sLit'.
---               * Turn into 'Outputable.SDoc' with 'Outputable.ptext'
+--   * A compact, hash-consed, representation of character strings.
+--   * Comparison is O(1), and you can get a 'Unique.Unique' from them.
+--   * Generated by 'fsLit'.
+--   * Turn into 'Outputable.SDoc' with 'Outputable.ftext'.
+--
+-- ['LitString']
+--
+--   * Just a wrapper for the @Addr#@ of a C string (@Ptr CChar@).
+--   * Practically no operations.
+--   * Outputing them is fast.
+--   * Generated by 'sLit'.
+--   * Turn into 'Outputable.SDoc' with 'Outputable.ptext'
 --
 -- Use 'LitString' unless you want the facilities of 'FastString'.
 module FastString
@@ -237,7 +239,7 @@ data FastStringTable =
 string_table :: FastStringTable
 {-# NOINLINE string_table #-}
 string_table = unsafePerformIO $ do
-  uid <- newIORef 0
+  uid <- newIORef 603979776 -- ord '$' * 0x01000000
   tab <- IO $ \s1# -> case newArray# hASH_TBL_SIZE_UNBOXED (panic "string_table") s1# of
                           (# s2#, arr# #) ->
                               (# s2#, FastStringTable uid arr# #)
diff --git a/compiler/utils/FastTypes.lhs b/compiler/utils/FastTypes.lhs
index 0ef10ade561e..36d8e4c4fd7c 100644
--- a/compiler/utils/FastTypes.lhs
+++ b/compiler/utils/FastTypes.lhs
@@ -4,6 +4,7 @@
 \section{Fast integers, etc... booleans moved to FastBool for using panic}
 
 \begin{code}
+{-# LANGUAGE CPP, MagicHash #-}
 
 --Even if the optimizer could handle boxed arithmetic equally well,
 --this helps automatically check the sources to make sure that
diff --git a/compiler/utils/Fingerprint.hsc b/compiler/utils/Fingerprint.hsc
index 9a55e385b3da..464337b7a913 100644
--- a/compiler/utils/Fingerprint.hsc
+++ b/compiler/utils/Fingerprint.hsc
@@ -1,3 +1,5 @@
+{-# LANGUAGE CPP #-}
+
 -- ----------------------------------------------------------------------------
 --
 --  (c) The University of Glasgow 2006
diff --git a/compiler/utils/GraphBase.hs b/compiler/utils/GraphBase.hs
index 8cb3acee718c..2aa16ae99e18 100644
--- a/compiler/utils/GraphBase.hs
+++ b/compiler/utils/GraphBase.hs
@@ -1,7 +1,7 @@
 
 -- | Types for the general graph colorer.
 
-{-# OPTIONS -fno-warn-tabs #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
 -- The above warning supression flag is a temporary kludge.
 -- While working on this module you are encouraged to remove it and
 -- detab the module (please do the detabbing in a separate patch). See
diff --git a/compiler/utils/GraphPpr.hs b/compiler/utils/GraphPpr.hs
index a896bbbf63b4..2682c7347e6b 100644
--- a/compiler/utils/GraphPpr.hs
+++ b/compiler/utils/GraphPpr.hs
@@ -1,7 +1,7 @@
 
 -- | Pretty printing of graphs.
 
-{-# OPTIONS -fno-warn-tabs #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
 -- The above warning supression flag is a temporary kludge.
 -- While working on this module you are encouraged to remove it and
 -- detab the module (please do the detabbing in a separate patch). See
diff --git a/compiler/utils/IOEnv.hs b/compiler/utils/IOEnv.hs
index 6885bbd12795..1db15537c7dd 100644
--- a/compiler/utils/IOEnv.hs
+++ b/compiler/utils/IOEnv.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE DeriveDataTypeable, UndecidableInstances #-}
+
 --
 -- (c) The University of Glasgow 2002-2006
 --
@@ -7,7 +9,6 @@
 -- as its in the IO monad, mutable references can be used
 -- for updating state.
 --
-{-# LANGUAGE UndecidableInstances #-}
 
 module IOEnv (
         IOEnv, -- Instance of Monad
diff --git a/compiler/utils/ListSetOps.lhs b/compiler/utils/ListSetOps.lhs
index 5ad402d0815f..6247dc67f620 100644
--- a/compiler/utils/ListSetOps.lhs
+++ b/compiler/utils/ListSetOps.lhs
@@ -5,6 +5,7 @@
 \section[ListSetOps]{Set-like operations on lists}
 
 \begin{code}
+{-# LANGUAGE CPP #-}
 
 module ListSetOps (
         unionLists, minusList, insertList,
diff --git a/compiler/utils/Maybes.lhs b/compiler/utils/Maybes.lhs
index 3c943bd22452..d9e1762a2f07 100644
--- a/compiler/utils/Maybes.lhs
+++ b/compiler/utils/Maybes.lhs
@@ -11,12 +11,9 @@ module Maybes (
         failME, isSuccess,
 
         orElse,
-        mapCatMaybes,
-        allMaybes,
         firstJust, firstJusts,
         whenIsJust,
         expectJust,
-        maybeToBool,
 
         MaybeT(..)
     ) where
@@ -34,53 +31,26 @@ infixr 4 `orElse`
 %************************************************************************
 
 \begin{code}
-maybeToBool :: Maybe a -> Bool
-maybeToBool Nothing  = False
-maybeToBool (Just _) = True
-
--- | Collects a list of @Justs@ into a single @Just@, returning @Nothing@ if
--- there are any @Nothings@.
-allMaybes :: [Maybe a] -> Maybe [a]
-allMaybes [] = Just []
-allMaybes (Nothing : _)  = Nothing
-allMaybes (Just x  : ms) = case allMaybes ms of
-                           Nothing -> Nothing
-                           Just xs -> Just (x:xs)
-
 firstJust :: Maybe a -> Maybe a -> Maybe a
-firstJust (Just a) _ = Just a
-firstJust Nothing  b = b
+firstJust a b = firstJusts [a, b]
 
 -- | Takes a list of @Maybes@ and returns the first @Just@ if there is one, or
 -- @Nothing@ otherwise.
 firstJusts :: [Maybe a] -> Maybe a
-firstJusts = foldr firstJust Nothing
-\end{code}
+firstJusts = msum
 
-\begin{code}
 expectJust :: String -> Maybe a -> a
 {-# INLINE expectJust #-}
 expectJust _   (Just x) = x
 expectJust err Nothing  = error ("expectJust " ++ err)
-\end{code}
-
-\begin{code}
-mapCatMaybes :: (a -> Maybe b) -> [a] -> [b]
-mapCatMaybes _ [] = []
-mapCatMaybes f (x:xs) = case f x of
-                        Just y  -> y : mapCatMaybes f xs
-                        Nothing -> mapCatMaybes f xs
 
 whenIsJust :: Monad m => Maybe a -> (a -> m ()) -> m ()
 whenIsJust (Just x) f = f x
 whenIsJust Nothing  _ = return ()
-\end{code}
 
-\begin{code}
--- | flipped version of @fromMaybe@.
+-- | Flipped version of @fromMaybe@, useful for chaining.
 orElse :: Maybe a -> a -> a
-(Just x) `orElse` _ = x
-Nothing  `orElse` y = y
+orElse = flip fromMaybe
 \end{code}
 
 %************************************************************************
diff --git a/compiler/utils/OrdList.lhs b/compiler/utils/OrdList.lhs
index d1d8708dd355..4cbb57b2ff7e 100644
--- a/compiler/utils/OrdList.lhs
+++ b/compiler/utils/OrdList.lhs
@@ -15,6 +15,10 @@ module OrdList (
         mapOL, fromOL, toOL, foldrOL, foldlOL
 ) where
 
+import Outputable
+
+import Data.Monoid
+
 infixl 5  `appOL`
 infixl 5  `snocOL`
 infixr 5  `consOL`
@@ -28,6 +32,13 @@ data OrdList a
   | Two (OrdList a) -- Invariant: non-empty
         (OrdList a) -- Invariant: non-empty
 
+instance Outputable a => Outputable (OrdList a) where
+  ppr ol = ppr (fromOL ol)  -- Convert to list and print that
+
+instance Monoid (OrdList a) where
+  mempty = nilOL
+  mappend = appOL
+  mconcat = concatOL
 
 nilOL    :: OrdList a
 isNilOL  :: OrdList a -> Bool
diff --git a/compiler/utils/Outputable.lhs b/compiler/utils/Outputable.lhs
index 8a12670d50ab..c1adf934e16b 100644
--- a/compiler/utils/Outputable.lhs
+++ b/compiler/utils/Outputable.lhs
@@ -22,11 +22,12 @@ module Outputable (
         char,
         text, ftext, ptext, ztext,
         int, intWithCommas, integer, float, double, rational,
-        parens, cparen, brackets, braces, quotes, quote, 
+        parens, cparen, brackets, braces, quotes, quote,
         doubleQuotes, angleBrackets, paBrackets,
-        semi, comma, colon, dcolon, space, equals, dot, arrow, darrow,
+        semi, comma, colon, dcolon, space, equals, dot,
+        arrow, larrow, darrow, arrowt, larrowt, arrowtt, larrowtt,
         lparen, rparen, lbrack, rbrack, lbrace, rbrace, underscore,
-        blankLine,
+        blankLine, forAllLit,
         (<>), (<+>), hcat, hsep,
         ($$), ($+$), vcat,
         sep, cat,
@@ -52,17 +53,20 @@ module Outputable (
         -- * Controlling the style in which output is printed
         BindingSite(..),
 
-        PprStyle, CodeStyle(..), PrintUnqualified,
+        PprStyle, CodeStyle(..), PrintUnqualified(..),
+        QueryQualifyName, QueryQualifyModule, QueryQualifyPackage,
+        reallyAlwaysQualify, reallyAlwaysQualifyNames,
         alwaysQualify, alwaysQualifyNames, alwaysQualifyModules,
         neverQualify, neverQualifyNames, neverQualifyModules,
-        QualifyName(..),
+        QualifyName(..), queryQual,
         sdocWithDynFlags, sdocWithPlatform,
         getPprStyle, withPprStyle, withPprStyleDoc,
         pprDeeper, pprDeeperList, pprSetDepth,
         codeStyle, userStyle, debugStyle, dumpStyle, asmStyle,
-        ifPprDebug, qualName, qualModule,
-        mkErrStyle, defaultErrStyle, defaultDumpStyle, defaultUserStyle,
-        mkUserStyle, cmdlineParserStyle, Depth(..),
+        ifPprDebug, qualName, qualModule, qualPackage,
+        mkErrStyle, defaultErrStyle, defaultDumpStyle, lineAnnotatedDumpStyle,
+        defaultUserStyle, mkUserStyle, cmdlineParserStyle, Depth(..),
+        pprAnnotate,
 
         -- * Error handling and debugging utilities
         pprPanic, pprSorry, assertPprPanic, pprPanicFastInt, pprPgmError,
@@ -73,9 +77,9 @@ module Outputable (
 
 import {-# SOURCE #-}   DynFlags( DynFlags,
                                   targetPlatform, pprUserLength, pprCols,
-                                  useUnicodeQuotes,
+                                  useUnicode, useUnicodeSyntax,
                                   unsafeGlobalDynFlags )
-import {-# SOURCE #-}   Module( Module, ModuleName, moduleName )
+import {-# SOURCE #-}   Module( PackageKey, Module, ModuleName, moduleName )
 import {-# SOURCE #-}   OccName( OccName )
 import {-# SOURCE #-}   StaticFlags( opt_PprStyle_Debug, opt_NoDebugOutput )
 
@@ -125,10 +129,13 @@ data PprStyle
   | PprCode CodeStyle
                 -- Print code; either C or assembler
 
-  | PprDump     -- For -ddump-foo; less verbose than PprDebug.
+  | PprDump Bool -- For -ddump-foo; less verbose than PprDebug.
                 -- Does not assume tidied code: non-external names
                 -- are printed with uniques.
 
+                -- Parameter governs whether to generate markers
+                -- for finding line number information later
+
   | PprDebug    -- Full debugging output
 
 data CodeStyle = CStyle         -- The format of labels differs for C and assembler
@@ -141,12 +148,15 @@ data Depth = AllTheWay
 -- -----------------------------------------------------------------------------
 -- Printing original names
 
--- When printing code that contains original names, we need to map the
+-- | When printing code that contains original names, we need to map the
 -- original names back to something the user understands.  This is the
--- purpose of the pair of functions that gets passed around
+-- purpose of the triple of functions that gets passed around
 -- when rendering 'SDoc'.
-
-type PrintUnqualified = (QueryQualifyName, QueryQualifyModule)
+data PrintUnqualified = QueryQualify {
+    queryQualifyName    :: QueryQualifyName,
+    queryQualifyModule  :: QueryQualifyModule,
+    queryQualifyPackage :: QueryQualifyPackage
+}
 
 -- | given an /original/ name, this function tells you which module
 -- name it should be qualified with when printing for the user, if
@@ -160,6 +170,9 @@ type QueryQualifyName = Module -> OccName -> QualifyName
 -- a package name to disambiguate it.
 type QueryQualifyModule = Module -> Bool
 
+-- | For a given package, we need to know whether to print it with
+-- the package key to disambiguate it.
+type QueryQualifyPackage = PackageKey -> Bool
 
 -- See Note [Printing original names] in HscTypes
 data QualifyName                        -- given P:M.T
@@ -172,6 +185,10 @@ data QualifyName                        -- given P:M.T
                 -- it is not in scope at all, and M.T is already bound in the
                 -- current scope, so we must refer to it as "P:M.T"
 
+reallyAlwaysQualifyNames :: QueryQualifyName
+reallyAlwaysQualifyNames _ _ = NameNotInScope2
+
+-- | NB: This won't ever show package IDs
 alwaysQualifyNames :: QueryQualifyName
 alwaysQualifyNames m _ = NameQual (moduleName m)
 
@@ -184,37 +201,53 @@ alwaysQualifyModules _ = True
 neverQualifyModules :: QueryQualifyModule
 neverQualifyModules _ = False
 
-alwaysQualify, neverQualify :: PrintUnqualified
-alwaysQualify = (alwaysQualifyNames, alwaysQualifyModules)
-neverQualify  = (neverQualifyNames,  neverQualifyModules)
+alwaysQualifyPackages :: QueryQualifyPackage
+alwaysQualifyPackages _ = True
+
+neverQualifyPackages :: QueryQualifyPackage
+neverQualifyPackages _ = False
+
+reallyAlwaysQualify, alwaysQualify, neverQualify :: PrintUnqualified
+reallyAlwaysQualify
+              = QueryQualify reallyAlwaysQualifyNames
+                             alwaysQualifyModules
+                             alwaysQualifyPackages
+alwaysQualify = QueryQualify alwaysQualifyNames
+                             alwaysQualifyModules
+                             alwaysQualifyPackages
+neverQualify  = QueryQualify neverQualifyNames
+                             neverQualifyModules
+                             neverQualifyPackages
 
 defaultUserStyle, defaultDumpStyle :: PprStyle
 
-defaultUserStyle = mkUserStyle alwaysQualify AllTheWay
+defaultUserStyle = mkUserStyle neverQualify AllTheWay
+ -- Print without qualifiers to reduce verbosity, unless -dppr-debug
 
 defaultDumpStyle |  opt_PprStyle_Debug = PprDebug
-                 |  otherwise          = PprDump
+                 |  otherwise          = PprDump False
 
--- | Style for printing error messages
-mkErrStyle :: DynFlags -> PrintUnqualified -> PprStyle
-mkErrStyle dflags qual = mkUserStyle qual (PartWay (pprUserLength dflags))
+lineAnnotatedDumpStyle :: PprStyle
+lineAnnotatedDumpStyle = PprDump True
 
 defaultErrStyle :: DynFlags -> PprStyle
--- Default style for error messages
+-- Default style for error messages, when we don't know PrintUnqualified
 -- It's a bit of a hack because it doesn't take into account what's in scope
 -- Only used for desugarer warnings, and typechecker errors in interface sigs
-defaultErrStyle dflags = mkUserStyle alwaysQualify depth
-    where depth = if opt_PprStyle_Debug
-                  then AllTheWay
-                  else PartWay (pprUserLength dflags)
+-- NB that -dppr-debug will still get into PprDebug style
+defaultErrStyle dflags = mkErrStyle dflags neverQualify
+
+-- | Style for printing error messages
+mkErrStyle :: DynFlags -> PrintUnqualified -> PprStyle
+mkErrStyle dflags qual = mkUserStyle qual (PartWay (pprUserLength dflags))
+
+cmdlineParserStyle :: PprStyle
+cmdlineParserStyle = mkUserStyle alwaysQualify AllTheWay
 
 mkUserStyle :: PrintUnqualified -> Depth -> PprStyle
 mkUserStyle unqual depth
    | opt_PprStyle_Debug = PprDebug
    | otherwise          = PprUser unqual depth
-
-cmdlineParserStyle :: PprStyle
-cmdlineParserStyle = PprUser alwaysQualify AllTheWay
 \end{code}
 
 Orthogonal to the above printing styles are (possibly) some
@@ -297,13 +330,22 @@ sdocWithPlatform f = sdocWithDynFlags (f . targetPlatform)
 
 \begin{code}
 qualName :: PprStyle -> QueryQualifyName
-qualName (PprUser (qual_name,_) _)  mod occ = qual_name mod occ
+qualName (PprUser q _)  mod occ = queryQualifyName q mod occ
 qualName _other                     mod _   = NameQual (moduleName mod)
 
 qualModule :: PprStyle -> QueryQualifyModule
-qualModule (PprUser (_,qual_mod) _)  m = qual_mod m
+qualModule (PprUser q _)  m = queryQualifyModule q m
 qualModule _other                   _m = True
 
+qualPackage :: PprStyle -> QueryQualifyPackage
+qualPackage (PprUser q _)  m = queryQualifyPackage q m
+qualPackage _other                   _m = True
+
+queryQual :: PprStyle -> PrintUnqualified
+queryQual s = QueryQualify (qualName s)
+                           (qualModule s)
+                           (qualPackage s)
+
 codeStyle :: PprStyle -> Bool
 codeStyle (PprCode _)     = True
 codeStyle _               = False
@@ -313,8 +355,8 @@ asmStyle (PprCode AsmStyle)  = True
 asmStyle _other              = False
 
 dumpStyle :: PprStyle -> Bool
-dumpStyle PprDump = True
-dumpStyle _other  = False
+dumpStyle (PprDump _) = True
+dumpStyle _other      = False
 
 debugStyle :: PprStyle -> Bool
 debugStyle PprDebug = True
@@ -398,7 +440,7 @@ showSDocDebug dflags d = renderWithStyle dflags d PprDebug
 showSDocDumpOneLine :: DynFlags -> SDoc -> String
 showSDocDumpOneLine dflags d
  = Pretty.showDoc OneLineMode irrelevantNCols $
-   runSDoc d (initSDocContext dflags PprDump)
+   runSDoc d (initSDocContext dflags (PprDump False))
 
 showPpr :: Outputable a => DynFlags -> a -> String
 showPpr dflags thing = showSDoc dflags (ppr thing)
@@ -459,8 +501,8 @@ cparen b d     = SDoc $ Pretty.cparen b . runSDoc d
 -- so that we don't get `foo''.  Instead we just have foo'.
 quotes d =
       sdocWithDynFlags $ \dflags ->
-      if useUnicodeQuotes dflags
-      then char '‛' <> d <> char '’'
+      if useUnicode dflags
+      then char '‘' <> d <> char '’'
       else SDoc $ \sty ->
            let pp_d = runSDoc d sty
                str  = show pp_d
@@ -469,13 +511,19 @@ quotes d =
              ('\'' : _, _)       -> pp_d
              _other              -> Pretty.quotes pp_d
 
-semi, comma, colon, equals, space, dcolon, arrow, underscore, dot :: SDoc
-darrow, lparen, rparen, lbrack, rbrack, lbrace, rbrace, blankLine :: SDoc
+semi, comma, colon, equals, space, dcolon, underscore, dot :: SDoc
+arrow, larrow, darrow, arrowt, larrowt, arrowtt, larrowtt :: SDoc
+lparen, rparen, lbrack, rbrack, lbrace, rbrace, blankLine :: SDoc
 
 blankLine  = docToSDoc $ Pretty.ptext (sLit "")
-dcolon     = docToSDoc $ Pretty.ptext (sLit "::")
-arrow      = docToSDoc $ Pretty.ptext (sLit "->")
-darrow     = docToSDoc $ Pretty.ptext (sLit "=>")
+dcolon     = unicodeSyntax (char '∷') (docToSDoc $ Pretty.ptext (sLit "::"))
+arrow      = unicodeSyntax (char '→') (docToSDoc $ Pretty.ptext (sLit "->"))
+larrow     = unicodeSyntax (char '�') (docToSDoc $ Pretty.ptext (sLit "<-"))
+darrow     = unicodeSyntax (char '⇒') (docToSDoc $ Pretty.ptext (sLit "=>"))
+arrowt     = unicodeSyntax (char '↣') (docToSDoc $ Pretty.ptext (sLit ">-"))
+larrowt    = unicodeSyntax (char '↢') (docToSDoc $ Pretty.ptext (sLit "-<"))
+arrowtt    = unicodeSyntax (char '⤜') (docToSDoc $ Pretty.ptext (sLit ">>-"))
+larrowtt   = unicodeSyntax (char '⤛') (docToSDoc $ Pretty.ptext (sLit "-<<"))
 semi       = docToSDoc $ Pretty.semi
 comma      = docToSDoc $ Pretty.comma
 colon      = docToSDoc $ Pretty.colon
@@ -490,6 +538,15 @@ rbrack     = docToSDoc $ Pretty.rbrack
 lbrace     = docToSDoc $ Pretty.lbrace
 rbrace     = docToSDoc $ Pretty.rbrace
 
+forAllLit :: SDoc
+forAllLit = unicodeSyntax (char '∀') (ptext (sLit "forall"))
+
+unicodeSyntax :: SDoc -> SDoc -> SDoc
+unicodeSyntax unicode plain = sdocWithDynFlags $ \dflags ->
+    if useUnicode dflags && useUnicodeSyntax dflags
+    then unicode
+    else plain
+
 nest :: Int -> SDoc -> SDoc
 -- ^ Indent 'SDoc' some specified amount
 (<>) :: SDoc -> SDoc -> SDoc
@@ -924,6 +981,16 @@ isOrAre _   = ptext (sLit "are")
 \end{code}
 
 
+\begin{code}
+
+pprAnnotate :: String -> SDoc -> SDoc
+pprAnnotate name sdoc = SDoc $ \ctx ->
+    case sdocStyle ctx of
+      PprDump True -> Pretty.zeroWidthText name Pretty.<> runSDoc sdoc ctx
+      _other       -> runSDoc sdoc ctx
+
+\end{code}
+
 %************************************************************************
 %*                                                                      *
 \subsection{Error handling}
@@ -979,7 +1046,7 @@ assertPprPanic file line msg
 
 pprDebugAndThen :: DynFlags -> (String -> a) -> String -> SDoc -> a
 pprDebugAndThen dflags cont heading pretty_msg
- = cont (showSDocDebug dflags doc)
+ = cont (showSDoc dflags doc)
  where
      doc = sep [text heading, nest 4 pretty_msg]
 \end{code}
diff --git a/compiler/utils/Pair.lhs b/compiler/utils/Pair.lhs
index 9e847d695055..ca7c2a7f8e3f 100644
--- a/compiler/utils/Pair.lhs
+++ b/compiler/utils/Pair.lhs
@@ -3,6 +3,8 @@ A simple homogeneous pair type with useful Functor, Applicative, and
 Traversable instances.
 
 \begin{code}
+{-# LANGUAGE CPP #-}
+
 module Pair ( Pair(..), unPair, toPair, swap ) where
 
 #include "HsVersions.h"
diff --git a/compiler/utils/Panic.lhs b/compiler/utils/Panic.lhs
index fc04668ae16a..583174b201b8 100644
--- a/compiler/utils/Panic.lhs
+++ b/compiler/utils/Panic.lhs
@@ -8,6 +8,8 @@ It's hard to put these functions anywhere else without causing
 some unnecessary loops in the module dependency graph.
 
 \begin{code}
+{-# LANGUAGE CPP, DeriveDataTypeable, ScopedTypeVariables #-}
+
 module Panic (
      GhcException(..), showGhcException,
      throwGhcException, throwGhcExceptionIO,
diff --git a/compiler/utils/Platform.hs b/compiler/utils/Platform.hs
index f69bb4cdf65e..ca8f0de862ef 100644
--- a/compiler/utils/Platform.hs
+++ b/compiler/utils/Platform.hs
@@ -12,6 +12,7 @@ module Platform (
         target32Bit,
         isARM,
         osElfTarget,
+        osMachOTarget,
         platformUsesFrameworks,
         platformBinariesAreStaticLibs,
 )
@@ -51,6 +52,7 @@ data Arch
           , armISAExt :: [ArmISAExt]
           , armABI    :: ArmABI
           }
+        | ArchARM64
         | ArchAlpha
         | ArchMipseb
         | ArchMipsel
@@ -129,6 +131,11 @@ osElfTarget OSUnknown   = False
  -- portability, otherwise we have to answer this question for every
  -- new platform we compile on (even unreg).
 
+-- | This predicate tells us whether the OS support Mach-O shared libraries.
+osMachOTarget :: OS -> Bool
+osMachOTarget OSDarwin = True
+osMachOTarget _ = False
+
 osUsesFrameworks :: OS -> Bool
 osUsesFrameworks OSDarwin = True
 osUsesFrameworks OSiOS    = True
diff --git a/compiler/utils/Pretty.lhs b/compiler/utils/Pretty.lhs
index fb7fe2b7fb66..f6a5a44e2ee7 100644
--- a/compiler/utils/Pretty.lhs
+++ b/compiler/utils/Pretty.lhs
@@ -152,7 +152,7 @@ Relative to John's original paper, there are the following new features:
 
 
 \begin{code}
-{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE BangPatterns, CPP, MagicHash #-}
 
 module Pretty (
         Doc,            -- Abstract
diff --git a/compiler/utils/Serialized.hs b/compiler/utils/Serialized.hs
index 902d2feea06c..b1576a087f60 100644
--- a/compiler/utils/Serialized.hs
+++ b/compiler/utils/Serialized.hs
@@ -1,9 +1,10 @@
+{-# LANGUAGE CPP, RankNTypes, ScopedTypeVariables #-}
+
 --
 -- (c) The University of Glasgow 2002-2006
 --
 -- Serialized values
 
-{-# LANGUAGE ScopedTypeVariables #-}
 module Serialized (
     -- * Main Serialized data type
     Serialized,
diff --git a/compiler/utils/State.hs b/compiler/utils/State.hs
index 0b6a2855627d..216034fdbf36 100644
--- a/compiler/utils/State.hs
+++ b/compiler/utils/State.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE UnboxedTuples #-}
 
 module State (module State, mapAccumLM {- XXX hack -}) where
 
diff --git a/compiler/utils/StringBuffer.lhs b/compiler/utils/StringBuffer.lhs
index 46cce5864d1b..a54f45ffff9e 100644
--- a/compiler/utils/StringBuffer.lhs
+++ b/compiler/utils/StringBuffer.lhs
@@ -6,7 +6,7 @@
 Buffers for scanning string input stored in external arrays.
 
 \begin{code}
-{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE BangPatterns, CPP, MagicHash, UnboxedTuples #-}
 {-# OPTIONS_GHC -O -funbox-strict-fields #-}
 -- We always optimise this, otherwise performance of a non-optimised
 -- compiler is severely affected
diff --git a/compiler/utils/UnVarGraph.hs b/compiler/utils/UnVarGraph.hs
new file mode 100644
index 000000000000..228f3b5220bb
--- /dev/null
+++ b/compiler/utils/UnVarGraph.hs
@@ -0,0 +1,136 @@
+{-
+
+Copyright (c) 2014 Joachim Breitner
+
+A data structure for undirected graphs of variables
+(or in plain terms: Sets of unordered pairs of numbers)
+
+
+This is very specifically tailored for the use in CallArity. In particular it
+stores the graph as a union of complete and complete bipartite graph, which
+would be very expensive to store as sets of edges or as adjanceny lists.
+
+It does not normalize the graphs. This means that g `unionUnVarGraph` g is
+equal to g, but twice as expensive and large.
+
+-}
+module UnVarGraph
+    ( UnVarSet
+    , emptyUnVarSet, mkUnVarSet, varEnvDom, unionUnVarSet, unionUnVarSets
+    , delUnVarSet
+    , elemUnVarSet, isEmptyUnVarSet
+    , UnVarGraph
+    , emptyUnVarGraph
+    , unionUnVarGraph, unionUnVarGraphs
+    , completeGraph, completeBipartiteGraph
+    , neighbors
+    , delNode
+    ) where
+
+import Id
+import VarEnv
+import UniqFM
+import Outputable
+import Data.List
+import Bag
+import Unique
+
+import qualified Data.IntSet as S
+
+-- We need a type for sets of variables (UnVarSet).
+-- We do not use VarSet, because for that we need to have the actual variable
+-- at hand, and we do not have that when we turn the domain of a VarEnv into a UnVarSet.
+-- Therefore, use a IntSet directly (which is likely also a bit more efficient).
+
+-- Set of uniques, i.e. for adjancet nodes
+newtype UnVarSet = UnVarSet (S.IntSet)
+    deriving Eq
+
+k :: Var -> Int
+k v = getKey (getUnique v)
+
+emptyUnVarSet :: UnVarSet
+emptyUnVarSet = UnVarSet S.empty
+
+elemUnVarSet :: Var -> UnVarSet -> Bool
+elemUnVarSet v (UnVarSet s) = k v `S.member` s
+
+
+isEmptyUnVarSet :: UnVarSet -> Bool
+isEmptyUnVarSet (UnVarSet s) = S.null s
+
+delUnVarSet :: UnVarSet -> Var -> UnVarSet
+delUnVarSet (UnVarSet s) v = UnVarSet $ k v `S.delete` s
+
+mkUnVarSet :: [Var] -> UnVarSet
+mkUnVarSet vs = UnVarSet $ S.fromList $ map k vs
+
+varEnvDom :: VarEnv a -> UnVarSet
+varEnvDom ae = UnVarSet $ ufmToSet_Directly ae
+
+unionUnVarSet :: UnVarSet -> UnVarSet -> UnVarSet
+unionUnVarSet (UnVarSet set1) (UnVarSet set2) = UnVarSet (set1 `S.union` set2)
+
+unionUnVarSets :: [UnVarSet] -> UnVarSet
+unionUnVarSets = foldr unionUnVarSet emptyUnVarSet
+
+instance Outputable UnVarSet where
+    ppr (UnVarSet s) = braces $
+        hcat $ punctuate comma [ ppr (getUnique i) | i <- S.toList s]
+
+
+-- The graph type. A list of complete bipartite graphs
+data Gen = CBPG UnVarSet UnVarSet -- complete bipartite
+         | CG   UnVarSet          -- complete
+newtype UnVarGraph = UnVarGraph (Bag Gen)
+
+emptyUnVarGraph :: UnVarGraph
+emptyUnVarGraph = UnVarGraph emptyBag
+
+unionUnVarGraph :: UnVarGraph -> UnVarGraph -> UnVarGraph
+{-
+Premature optimisation, it seems.
+unionUnVarGraph (UnVarGraph [CBPG s1 s2]) (UnVarGraph [CG s3, CG s4])
+    | s1 == s3 && s2 == s4
+    = pprTrace "unionUnVarGraph fired" empty $
+      completeGraph (s1 `unionUnVarSet` s2)
+unionUnVarGraph (UnVarGraph [CBPG s1 s2]) (UnVarGraph [CG s3, CG s4])
+    | s2 == s3 && s1 == s4
+    = pprTrace "unionUnVarGraph fired2" empty $
+      completeGraph (s1 `unionUnVarSet` s2)
+-}
+unionUnVarGraph (UnVarGraph g1) (UnVarGraph g2)
+    = -- pprTrace "unionUnVarGraph" (ppr (length g1, length g2)) $
+      UnVarGraph (g1 `unionBags` g2)
+
+unionUnVarGraphs :: [UnVarGraph] -> UnVarGraph
+unionUnVarGraphs = foldl' unionUnVarGraph emptyUnVarGraph
+
+-- completeBipartiteGraph A B = { {a,b} | a ∈ A, b ∈ B }
+completeBipartiteGraph :: UnVarSet -> UnVarSet -> UnVarGraph
+completeBipartiteGraph s1 s2 = prune $ UnVarGraph $ unitBag $ CBPG s1 s2
+
+completeGraph :: UnVarSet -> UnVarGraph
+completeGraph s = prune $ UnVarGraph $ unitBag $ CG s
+
+neighbors :: UnVarGraph -> Var -> UnVarSet
+neighbors (UnVarGraph g) v = unionUnVarSets $ concatMap go $ bagToList g
+  where go (CG s)       = (if v `elemUnVarSet` s then [s] else [])
+        go (CBPG s1 s2) = (if v `elemUnVarSet` s1 then [s2] else []) ++
+                          (if v `elemUnVarSet` s2 then [s1] else [])
+
+delNode :: UnVarGraph -> Var -> UnVarGraph
+delNode (UnVarGraph g) v = prune $ UnVarGraph $ mapBag go g
+  where go (CG s)       = CG (s `delUnVarSet` v)
+        go (CBPG s1 s2) = CBPG (s1 `delUnVarSet` v) (s2 `delUnVarSet` v)
+
+prune :: UnVarGraph -> UnVarGraph
+prune (UnVarGraph g) = UnVarGraph $ filterBag go g
+  where go (CG s)       = not (isEmptyUnVarSet s)
+        go (CBPG s1 s2) = not (isEmptyUnVarSet s1) && not (isEmptyUnVarSet s2)
+
+instance Outputable Gen where
+    ppr (CG s)       = ppr s  <> char '²'
+    ppr (CBPG s1 s2) = ppr s1 <+> char 'x' <+> ppr s2
+instance Outputable UnVarGraph where
+    ppr (UnVarGraph g) = ppr g
diff --git a/compiler/utils/UniqFM.lhs b/compiler/utils/UniqFM.lhs
index 52cd3dd7915e..d8e08f599ab1 100644
--- a/compiler/utils/UniqFM.lhs
+++ b/compiler/utils/UniqFM.lhs
@@ -20,9 +20,9 @@ and ``addToUFM\_C'' and ``Data.IntMap.insertWith'' differ in the order
 of arguments of combining function.
 
 \begin{code}
-{-# LANGUAGE DeriveTraversable, GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE DeriveTraversable, DeriveDataTypeable, GeneralizedNewtypeDeriving #-}
+{-# OPTIONS_GHC -Wall #-}
 
-{-# OPTIONS -Wall #-}
 module UniqFM (
         -- * Unique-keyed mappings
         UniqFM,       -- abstract type
@@ -58,10 +58,12 @@ module UniqFM (
         lookupUFM, lookupUFM_Directly,
         lookupWithDefaultUFM, lookupWithDefaultUFM_Directly,
         eltsUFM, keysUFM, splitUFM,
+        ufmToSet_Directly,
         ufmToList,
-        joinUFM
+        joinUFM, pprUniqFM
     ) where
 
+import FastString
 import Unique           ( Uniquable(..), Unique, getKey )
 import Outputable
 
@@ -69,6 +71,7 @@ import Compiler.Hoopl   hiding (Unique)
 
 import Data.Function (on)
 import qualified Data.IntMap as M
+import qualified Data.IntSet as S
 import qualified Data.Foldable as Foldable
 import qualified Data.Traversable as Traversable
 import Data.Typeable
@@ -180,6 +183,7 @@ lookupWithDefaultUFM_Directly
                 :: UniqFM elt -> elt -> Unique -> elt
 keysUFM         :: UniqFM elt -> [Unique]       -- Get the keys
 eltsUFM         :: UniqFM elt -> [elt]
+ufmToSet_Directly :: UniqFM elt -> S.IntSet
 ufmToList       :: UniqFM elt -> [(Unique, elt)]
 
 \end{code}
@@ -293,6 +297,7 @@ lookupWithDefaultUFM (UFM m) v k = M.findWithDefault v (getKey $ getUnique k) m
 lookupWithDefaultUFM_Directly (UFM m) v u = M.findWithDefault v (getKey u) m
 keysUFM (UFM m) = map getUnique $ M.keys m
 eltsUFM (UFM m) = M.elems m
+ufmToSet_Directly (UFM m) = M.keysSet m
 ufmToList (UFM m) = map (\(k, v) -> (getUnique k, v)) $ M.toList m
 
 -- Hoopl
@@ -315,5 +320,11 @@ joinUFM eltJoin l (OldFact old) (NewFact new) = foldUFM_Directly add (NoChange,
 
 \begin{code}
 instance Outputable a => Outputable (UniqFM a) where
-    ppr ufm = ppr (ufmToList ufm)
+    ppr ufm = pprUniqFM ppr ufm
+
+pprUniqFM :: (a -> SDoc) -> UniqFM a -> SDoc
+pprUniqFM ppr_elt ufm
+  = brackets $ fsep $ punctuate comma $
+    [ ppr uq <+> ptext (sLit ":->") <+> ppr_elt elt
+    | (uq, elt) <- ufmToList ufm ]
 \end{code}
diff --git a/compiler/utils/Util.lhs b/compiler/utils/Util.lhs
index 5c82c757aa5b..2dcc73fd890d 100644
--- a/compiler/utils/Util.lhs
+++ b/compiler/utils/Util.lhs
@@ -3,6 +3,7 @@
 %
 
 \begin{code}
+{-# LANGUAGE CPP #-}
 
 -- | Highly random utility functions
 --
@@ -46,7 +47,7 @@ module Util (
         nTimes,
 
         -- * Sorting
-        sortWith, minWith,
+        sortWith, minWith, nubSort,
 
         -- * Comparisons
         isEqual, eqListBy, eqMaybeBy,
@@ -125,6 +126,7 @@ import Data.Ord         ( comparing )
 import Data.Bits
 import Data.Word
 import qualified Data.IntMap as IM
+import qualified Data.Set as Set
 
 import Data.Time
 #if __GLASGOW_HASKELL__ < 705
@@ -489,6 +491,9 @@ sortWith get_key xs = sortBy (comparing get_key) xs
 minWith :: Ord b => (a -> b) -> [a] -> a
 minWith get_key xs = ASSERT( not (null xs) )
                      head (sortWith get_key xs)
+
+nubSort :: Ord a => [a] -> [a]
+nubSort = Set.toAscList . Set.fromList
 \end{code}
 
 %************************************************************************
diff --git a/compiler/vectorise/Vectorise.hs b/compiler/vectorise/Vectorise.hs
index 012ae37039cf..38bd55482a39 100644
--- a/compiler/vectorise/Vectorise.hs
+++ b/compiler/vectorise/Vectorise.hs
@@ -351,6 +351,6 @@ tryConvert var vect_var rhs
   = fromVect (idType var) (Var vect_var) 
     `orElseErrV` 
     do 
-    { emitVt "  Could NOT call vectorised from original version" $ ppr var
+    { emitVt "  Could NOT call vectorised from original version" $ ppr var <+> dcolon <+> ppr (idType var)
     ; return rhs
     }
diff --git a/compiler/vectorise/Vectorise/Exp.hs b/compiler/vectorise/Vectorise/Exp.hs
index fb0c14861067..6adb9ec435d5 100644
--- a/compiler/vectorise/Vectorise/Exp.hs
+++ b/compiler/vectorise/Vectorise/Exp.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE CPP, TupleSections #-}
 
 -- |Vectorisation of expressions.
 
diff --git a/compiler/vectorise/Vectorise/Generic/PAMethods.hs b/compiler/vectorise/Vectorise/Generic/PAMethods.hs
index 269119c6dd01..0d5d37c7d7af 100644
--- a/compiler/vectorise/Vectorise/Generic/PAMethods.hs
+++ b/compiler/vectorise/Vectorise/Generic/PAMethods.hs
@@ -16,7 +16,7 @@ import Vectorise.Generic.Description
 import CoreSyn
 import CoreUtils
 import FamInstEnv
-import MkCore            ( mkWildCase )
+import MkCore            ( mkWildCase, mkCoreLet )
 import TyCon
 import CoAxiom
 import Type
@@ -24,6 +24,7 @@ import OccName
 import Coercion
 import MkId
 import FamInst
+import TysPrim( intPrimTy )
 
 import DynFlags
 import FastString
@@ -404,9 +405,13 @@ buildToArrPReprs vect_tc repr_co _ pdatas_tc r
                 -- and PDatas Void arrays in the product. See Note [Empty PDatas].
                 let xSums        =  App (repr_selsLength_v ss) (Var sels)
 
-                (vars, exprs)    <- mapAndUnzipM (to_con xSums) (repr_cons ss)
+                xSums_var <- newLocalVar (fsLit "xsum") intPrimTy
+
+                (vars, exprs)    <- mapAndUnzipM (to_con xSums_var) (repr_cons ss)
                 return ( sels : concat vars
                        , wrapFamInstBody psums_tc (repr_con_tys ss)
+                         $ mkCoreLet (NonRec xSums_var xSums)
+                                 -- mkCoreLet ensures that the let/app invariant holds
                          $ mkConApp psums_con 
                          $ map Type (repr_con_tys ss) ++ (Var sels : exprs))        
 
@@ -414,7 +419,7 @@ buildToArrPReprs vect_tc repr_co _ pdatas_tc r
      = case ss of
         EmptyProd    
          -> do  pvoids  <- builtin pvoidsVar
-                return ([], App (Var pvoids) xSums )
+                return ([], App (Var pvoids) (Var xSums) )
 
         UnaryProd r
          -> do  pty  <- mkPDatasType (compOrigType r)
diff --git a/compiler/vectorise/Vectorise/Generic/PData.hs b/compiler/vectorise/Vectorise/Generic/PData.hs
index 37358c9bdf74..387d49c3ad91 100644
--- a/compiler/vectorise/Vectorise/Generic/PData.hs
+++ b/compiler/vectorise/Vectorise/Generic/PData.hs
@@ -45,7 +45,7 @@ buildDataFamInst :: Name -> TyCon -> TyCon -> AlgTyConRhs -> VM FamInst
 buildDataFamInst name' fam_tc vect_tc rhs
  = do { axiom_name <- mkDerivedName mkInstTyCoOcc name'
 
-      ; (_, tyvars') <- liftDs $ tcInstSkolTyVarsLoc (getSrcSpan name') tyvars
+      ; (_, tyvars') <- liftDs $ tcInstSigTyVarsLoc (getSrcSpan name') tyvars
       ; let ax       = mkSingleCoAxiom axiom_name tyvars' fam_tc pat_tys rep_ty
             tys'     = mkTyVarTys tyvars'
             rep_ty   = mkTyConApp rep_tc tys'
diff --git a/compiler/vectorise/Vectorise/Monad/InstEnv.hs b/compiler/vectorise/Vectorise/Monad/InstEnv.hs
index 84b29ceb6119..a97f319b4f0a 100644
--- a/compiler/vectorise/Vectorise/Monad/InstEnv.hs
+++ b/compiler/vectorise/Vectorise/Monad/InstEnv.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE CPP #-}
+
 module Vectorise.Monad.InstEnv 
   ( existsInst
   , lookupInst
diff --git a/compiler/vectorise/Vectorise/Monad/Naming.hs b/compiler/vectorise/Vectorise/Monad/Naming.hs
index def1ffa58c67..b53324012ff6 100644
--- a/compiler/vectorise/Vectorise/Monad/Naming.hs
+++ b/compiler/vectorise/Vectorise/Monad/Naming.hs
@@ -24,6 +24,7 @@ import Name
 import SrcLoc
 import MkId
 import Id
+import IdInfo( IdDetails(VanillaId) )
 import FastString
 
 import Control.Monad
@@ -67,7 +68,7 @@ mkVectId :: Id -> Type -> VM Id
 mkVectId id ty
   = do { name <- mkLocalisedName mkVectOcc (getName id)
        ; let id' | isDFunId id     = MkId.mkDictFunId name tvs theta cls tys
-                 | isExportedId id = Id.mkExportedLocalId name ty
+                 | isExportedId id = Id.mkExportedLocalId VanillaId name ty
                  | otherwise       = Id.mkLocalId         name ty
        ; return id'
        }
@@ -91,8 +92,8 @@ newExportedVar occ_name ty
       u   <- liftDs newUnique
 
       let name = mkExternalName u mod occ_name noSrcSpan
-      
-      return $ Id.mkExportedLocalId name ty
+
+      return $ Id.mkExportedLocalId VanillaId name ty
 
 -- |Make a fresh local variable with the given type.
 -- The variable's name is formed using the given string as the prefix.
diff --git a/compiler/vectorise/Vectorise/Type/Env.hs b/compiler/vectorise/Vectorise/Type/Env.hs
index 34008efbbd4d..6ee5ca6cd9e5 100644
--- a/compiler/vectorise/Vectorise/Type/Env.hs
+++ b/compiler/vectorise/Vectorise/Type/Env.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE CPP #-}
+
 -- Vectorise a modules type and class declarations.
 --
 -- This produces new type constructors and family instances top be included in the module toplevel
diff --git a/compiler/vectorise/Vectorise/Type/TyConDecl.hs b/compiler/vectorise/Vectorise/Type/TyConDecl.hs
index a8159b09f49a..37a07f710def 100644
--- a/compiler/vectorise/Vectorise/Type/TyConDecl.hs
+++ b/compiler/vectorise/Vectorise/Type/TyConDecl.hs
@@ -59,7 +59,6 @@ vectTyConDecl tycon name'
            -- NB: 'buildClass' attaches new quantifiers and dictionaries to the method types
        ; cls' <- liftDs $
                    buildClass
-                     False                      -- include unfoldings on dictionary selectors
                      name'                      -- new name: "V:Class"
                      (tyConTyVars tycon)        -- keep original type vars
                      (map (const Nominal) (tyConRoles tycon)) -- all role are N for safety
diff --git a/compiler/vectorise/Vectorise/Utils/Base.hs b/compiler/vectorise/Vectorise/Utils/Base.hs
index cb7b34e36a1e..7d4bae3046d0 100644
--- a/compiler/vectorise/Vectorise/Utils/Base.hs
+++ b/compiler/vectorise/Vectorise/Utils/Base.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE CPP #-}
+
 module Vectorise.Utils.Base 
   ( voidType
   , newLocalVVar
diff --git a/configure.ac b/configure.ac
index 744cebdf3c7e..2e9958c39c11 100644
--- a/configure.ac
+++ b/configure.ac
@@ -13,7 +13,7 @@ dnl
 # see what flags are available. (Better yet, read the documentation!)
 #
 
-AC_INIT([The Glorious Glasgow Haskell Compilation System], [7.7], [glasgow-haskell-bugs@haskell.org], [ghc])
+AC_INIT([The Glorious Glasgow Haskell Compilation System], [7.9], [glasgow-haskell-bugs@haskell.org], [ghc])
 
 # Set this to YES for a released version, otherwise NO
 : ${RELEASE=NO}
@@ -34,7 +34,7 @@ fi
 AC_SUBST([CONFIGURE_ARGS], [$ac_configure_args])
 
 dnl ----------------------------------------------------------
-dnl ** Find unixy sort and find commands, 
+dnl ** Find unixy sort and find commands,
 dnl ** which are needed by FP_SETUP_PROJECT_VERSION
 
 dnl ** Find find command (for Win32's benefit)
@@ -91,7 +91,7 @@ AC_ARG_WITH([ghc],
   WithGhc="$GHC"])
 
 dnl ** Tell the make system which OS we are using
-dnl $OSTYPE is set by the operating system to "msys" or "cygwin" or something 
+dnl $OSTYPE is set by the operating system to "msys" or "cygwin" or something
 AC_SUBST(OSTYPE)
 
 AC_ARG_ENABLE(bootstrap-with-devel-snapshot,
@@ -162,6 +162,11 @@ FP_COMPARE_VERSIONS([$GhcVersion],[-gt],[7.7],
                     CMM_SINK_BOOTSTRAP_IS_NEEDED=NO)
 AC_SUBST(CMM_SINK_BOOTSTRAP_IS_NEEDED)
 
+FP_COMPARE_VERSIONS([$GhcVersion],[-lt],[7.9],
+                    SUPPORTS_PACKAGE_KEY=NO,
+                    SUPPORTS_PACKAGE_KEY=YES)
+AC_SUBST(SUPPORTS_PACKAGE_KEY)
+
 # GHC is passed to Cabal, so we need a native path
 if test "${WithGhc}" != ""
 then
@@ -228,7 +233,7 @@ case $host in
      # here we go with the test
      MINOR=`uname -r|cut -d '.' -f 2-`
      if test "$MINOR" -lt "11"; then
-     	SOLARIS_BROKEN_SHLD=YES
+         SOLARIS_BROKEN_SHLD=YES
      fi
      ;;
 esac
@@ -367,7 +372,7 @@ AS_IF([test "x$with_system_libffi" = "xyes"],
 AC_SUBST(UseSystemLibFFI)
 
 AC_ARG_WITH([ffi-includes],
-[AC_HELP_STRING([--with-ffi-includes=ARG]
+[AC_HELP_STRING([--with-ffi-includes=ARG],
   [Find includes for libffi in ARG [default=system default]])
 ],
 [
@@ -382,7 +387,7 @@ AC_ARG_WITH([ffi-includes],
 AC_SUBST(FFIIncludeDir)
 
 AC_ARG_WITH([ffi-libraries],
-[AC_HELP_STRING([--with-ffi-libraries=ARG]
+[AC_HELP_STRING([--with-ffi-libraries=ARG],
   [Find libffi in ARG [default=system default]])
 ],
 [
@@ -474,6 +479,66 @@ FIND_GCC([WhatGccIsCalled], [gcc], [gcc])
 CC="$WhatGccIsCalled"
 export CC
 
+# If --with-gcc was used, and we're not cross-compiling, then it also
+# applies to the stage0 compiler.
+MAYBE_OVERRIDE_STAGE0([gcc],[CC_STAGE0])
+MAYBE_OVERRIDE_STAGE0([ar],[AR_STAGE0])
+
+dnl ** what cpp to use?
+dnl --------------------------------------------------------------
+AC_ARG_WITH(hs-cpp,
+[AC_HELP_STRING([--with-hs-cpp=ARG],
+        [Use ARG as the path to cpp [default=autodetect]])],
+[
+    if test "$HostOS" = "mingw32"
+    then
+        AC_MSG_WARN([Request to use $withval will be ignored])
+    else
+        HaskellCPPCmd=$withval
+    fi
+],
+[
+        HaskellCPPCmd=$WhatGccIsCalled
+]
+)
+
+
+
+dnl ** what cpp flags to use?
+dnl -----------------------------------------------------------
+AC_ARG_WITH(hs-cpp-flags,
+  [AC_HELP_STRING([--with-hs-cpp-flags=ARG],
+          [Use ARG as the path to hs cpp [default=autodetect]])],
+  [
+      if test "$HostOS" = "mingw32"
+      then
+          AC_MSG_WARN([Request to use $withval will be ignored])
+      else
+          HaskellCPPArgs=$withval
+      fi
+  ],
+[
+  $HaskellCPPCmd -x c /dev/null -dM -E > conftest.txt 2>&1
+  if grep "__clang__" conftest.txt >/dev/null 2>&1; then
+    HaskellCPPArgs="-E -undef -traditional -Wno-invalid-pp-token -Wno-unicode -Wno-trigraphs "
+  else
+      $HaskellCPPCmd  -v > conftest.txt 2>&1
+      if  grep "gcc" conftest.txt >/dev/null 2>&1; then
+          HaskellCPPArgs="-E -undef -traditional "
+        else
+          $HaskellCPPCmd  --version > conftest.txt 2>&1
+          if grep "cpphs" conftest.txt >/dev/null 2>&1; then
+            HaskellCPPArgs="--cpp -traditional"
+          else
+            AC_MSG_WARN([configure can't recognize your CPP program, you may need to set --with-hs-cpp-flags=FLAGS explicitly])
+            HaskellCPPArgs=""
+          fi
+      fi
+  fi
+  ]
+)
+
+
 dnl ** Which ld to use?
 dnl --------------------------------------------------------------
 FP_ARG_WITH_PATH_GNU_PROG([LD], [ld], [ld])
@@ -486,6 +551,20 @@ FP_ARG_WITH_PATH_GNU_PROG([NM], [nm], [nm])
 NmCmd="$NM"
 AC_SUBST([NmCmd])
 
+dnl ** Which ar to use?
+dnl --------------------------------------------------------------
+FP_ARG_WITH_PATH_GNU_PROG([AR], [ar], [ar])
+ArCmd="$AR"
+fp_prog_ar="$AR"
+AC_SUBST([ArCmd])
+
+dnl ** Which ranlib to use?
+dnl --------------------------------------------------------------
+FP_ARG_WITH_PATH_GNU_PROG([RANLIB], [ranlib], [ranlib])
+RanlibCmd="$RANLIB"
+RANLIB="$RanlibCmd"
+
+
 # Note: we may not have objdump on OS X, and we only need it on Windows (for DLL checks)
 case $HostOS_CPP in
 cygwin32|mingw32)
@@ -569,8 +648,8 @@ FP_PROG_LD_FILELIST
 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])
 FPTOOLS_SET_C_LD_FLAGS([target],[CONF_CC_OPTS_STAGE1],[CONF_GCC_LINKER_OPTS_STAGE1],[CONF_LD_LINKER_OPTS_STAGE1],[CONF_CPP_OPTS_STAGE1])
-# Stage 3 won't be supported by cross-compilation
 FPTOOLS_SET_C_LD_FLAGS([target],[CONF_CC_OPTS_STAGE2],[CONF_GCC_LINKER_OPTS_STAGE2],[CONF_LD_LINKER_OPTS_STAGE2],[CONF_CPP_OPTS_STAGE2])
+# Stage 3 won't be supported by cross-compilation
 
 FP_GCC_EXTRA_FLAGS
 
@@ -604,9 +683,6 @@ chmod +x install-sh
 dnl ** figure out how to do a BSD-ish install
 AC_PROG_INSTALL
 
-dnl If you can run configure, you certainly have /bin/sh
-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
@@ -744,30 +820,6 @@ FP_CHECK_FUNC([WinExec],
 FP_CHECK_FUNC([GetModuleFileName],
   [@%:@include <windows.h>], [GetModuleFileName((HMODULE)0,(LPTSTR)0,0)])
 
-dnl ** check return type of signal handlers
-dnl Foo: assumes we can use prototypes.
-dnl On BCC, signal handlers have type "int(void)", elsewhere its "void(int)".
-dnl AC_CACHE_CHECK([type of signal handlers], ac_cv_type_signal_handler,
-dnl [AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include <sys/types.h>
-dnl #include <signal.h>
-dnl #ifdef signal
-dnl #undef signal
-dnl #endif
-dnl void (*signal (int, void (*)(int)))(int);
-dnl ]],
-dnl [[int i;]])],
-dnl [ac_cv_type_signal_handler=void_int],
-dnl [ac_cv_type_signal_handler=int_void])])
-dnl if test "$ac_cv_type_signal_handler" = void_int; then
-dnl AC_DEFINE(VOID_INT_SIGNALS)
-dnl fi
-
-dnl On BCC, signal handlers have type "int(void)", elsewhere its "void(int)".
-AC_TYPE_SIGNAL
-if test "$ac_cv_type_signal" = void; then
-  AC_DEFINE([VOID_INT_SIGNALS], [1], [Define to 1 if signal handlers have type void (*)(int). Otherwise, they're assumed to have type int (*)(void).])
-fi
-
 dnl ** check for more functions
 dnl ** The following have been verified to be used in ghc/, but might be used somewhere else, too.
 AC_CHECK_FUNCS([getclock getrusage gettimeofday setitimer siginterrupt sysconf times ctime_r sched_setaffinity setlocale])
@@ -861,7 +913,21 @@ dnl ** check for eventfd which is needed by the I/O manager
 AC_CHECK_HEADERS([sys/eventfd.h])
 AC_CHECK_FUNCS([eventfd])
 
-# checking for PAPI
+dnl ** Check for __thread support in the compiler
+AC_MSG_CHECKING(for __thread support)
+AC_COMPILE_IFELSE(
+  [ AC_LANG_SOURCE([[__thread int tester = 0;]]) ],
+  [
+   AC_MSG_RESULT(yes)
+   AC_DEFINE([CC_SUPPORTS_TLS],[1],[Define to 1 if __thread is supported])
+  ],
+  [
+   AC_MSG_RESULT(no)
+   AC_DEFINE([CC_SUPPORTS_TLS],[0],[Define to 1 if __thread is supported])
+  ])
+
+
+dnl ** checking for PAPI
 AC_CHECK_LIB(papi, PAPI_library_init, HavePapiLib=YES, HavePapiLib=NO)
 AC_CHECK_HEADER([papi.h], [HavePapiHeader=YES], [HavePapiHeader=NO])
 AC_SUBST(HavePapiLib)
@@ -876,6 +942,21 @@ else
 fi
 AC_SUBST(HavePapi)
 
+# Check for perf_event (only more current Linux)
+AC_CHECK_HEADER([linux/perf_event.h], [HavePerfEvent=YES], [HavePerfEvent=NO])
+AC_SUBST(HavePerfEvent)
+
+# Check for libdwarf
+AC_CHECK_HEADER([libdwarf.h], [HaveDwarfHeader=YES], [HaveLibDwarfHeader=NO])
+AC_CHECK_LIB(dwarf, dwarf_init, [HaveDwarfLib=YES], [HaveDwarfLib=NO])
+AC_CHECK_LIB(elf, elf_begin, [HaveElfLib=YES], [HaveElfLib=NO])
+if test "$HaveDwarfLib" = "YES" -a "$HaveDwarfHeader" = "YES" -a "$HaveElfLib" = "YES"; then
+   HaveLibDwarf=YES
+else
+   HaveLibDwarf=NO
+fi
+AC_SUBST(HaveLibDwarf)
+
 if test "$HAVE_DOCBOOK_XSL" = "NO" ||
    test "$XsltprocCmd" = ""
 then
@@ -958,13 +1039,14 @@ echo ["\
    Using $CompilerName       : $WhatGccIsCalled
       which is version       : $GccVersion
    Building a cross compiler : $CrossCompiling
-
-   ld       : $LdCmd
-   Happy    : $HappyCmd ($HappyVersion)
-   Alex     : $AlexCmd ($AlexVersion)
-   Perl     : $PerlCmd
-   dblatex  : $DblatexCmd
-   xsltproc : $XsltprocCmd
+   cpp       : $HaskellCPPCmd
+   cpp-flags : $HaskellCPPArgs
+   ld        : $LdCmd
+   Happy     : $HappyCmd ($HappyVersion)
+   Alex      : $AlexCmd ($AlexVersion)
+   Perl      : $PerlCmd
+   dblatex   : $DblatexCmd
+   xsltproc  : $XsltprocCmd
 
    Using LLVM tools
       llc   : $LlcCmd
diff --git a/distrib/compare/FilenameDescr.hs b/distrib/compare/FilenameDescr.hs
index a0f53fd2a0df..bf2a50ec9bda 100644
--- a/distrib/compare/FilenameDescr.hs
+++ b/distrib/compare/FilenameDescr.hs
@@ -10,7 +10,7 @@ import Utils
 import Tar
 
 -- We can't just compare plain filenames, because versions numbers of GHC
--- and the libaries will vary. So we use FilenameDescr instead, which
+-- and the libraries will vary. So we use FilenameDescr instead, which
 -- abstracts out the version numbers.
 type FilenameDescr = [FilenameDescrBit]
 data FilenameDescrBit = VersionOf String
diff --git a/distrib/compare/Makefile b/distrib/compare/Makefile
index f65c0419eb77..49645783e20b 100644
--- a/distrib/compare/Makefile
+++ b/distrib/compare/Makefile
@@ -2,7 +2,7 @@
 GHC = ghc
 
 compare: *.hs
-	"$(GHC)" -O --make -Wall -Werror $@
+	"$(GHC)" -O -XHaskell2010 --make -Wall -Werror $@
 
 .PHONY: clean
 clean:
diff --git a/distrib/compare/compare.hs b/distrib/compare/compare.hs
index 81055c2826d9..8653e3f6aa2d 100644
--- a/distrib/compare/compare.hs
+++ b/distrib/compare/compare.hs
@@ -1,5 +1,3 @@
-{-# LANGUAGE PatternGuards #-}
-
 module Main (main) where
 
 import Control.Monad.State
diff --git a/distrib/configure.ac.in b/distrib/configure.ac.in
index 4a6944fe17c9..c7a8ead9b0b2 100644
--- a/distrib/configure.ac.in
+++ b/distrib/configure.ac.in
@@ -63,6 +63,65 @@ FIND_GCC([WhatGccIsCalled], [gcc], [gcc])
 CC="$WhatGccIsCalled"
 export CC
 
+
+dnl ** what cpp to use?
+dnl --------------------------------------------------------------
+AC_ARG_WITH(hs-cpp,
+[AC_HELP_STRING([--with-hs-cpp=ARG],
+        [Use ARG as the path to cpp [default=autodetect]])],
+[
+    if test "$HostOS" = "mingw32"
+    then
+        AC_MSG_WARN([Request to use $withval will be ignored])
+    else
+        HaskellCPPCmd=$withval
+    fi
+],
+[
+    if test "$HostOS" != "mingw32"
+    then
+        HaskellCPPCmd=$WhatGccIsCalled
+    fi
+]
+)
+
+
+
+dnl ** what cpp flags to use?
+dnl -----------------------------------------------------------
+AC_ARG_WITH(hs-cpp-flags,
+  [AC_HELP_STRING([--with-hs-cpp-flags=ARG],
+          [Use ARG as the path to hs cpp [default=autodetect]])],
+  [
+      if test "$HostOS" = "mingw32"
+      then
+          AC_MSG_WARN([Request to use $withval will be ignored])
+      else
+          HaskellCPPArgs=$withval
+      fi
+  ],
+[
+  $HaskellCPPCmd -x c /dev/null -dM -E > conftest.txt 2>&1
+  if grep "__clang__" conftest.txt >/dev/null 2>&1; then
+    HaskellCPPArgs="-E -undef -traditional -Wno-invalid-pp-token -Wno-unicode -Wno-trigraphs "
+  else
+      $HaskellCPPCmd  -v > conftest.txt 2>&1
+      if  grep "gcc" conftest.txt >/dev/null 2>&1; then
+          HaskellCPPArgs="-E -undef -traditional "
+        else
+          $HaskellCPPCmd  --version > conftest.txt 2>&1
+          if grep "cpphs" conftest.txt >/dev/null 2>&1; then
+            HaskellCPPArgs="--cpp -traditional"
+          else
+            AC_MSG_WARN([configure can't recognize your CPP program, you may need to set --with-hs-cpp-flags=FLAGS explicitly])
+            HaskellCPPArgs=""
+          fi
+      fi
+  fi
+  ]
+)
+
+
 dnl ** Which ld to use?
 dnl --------------------------------------------------------------
 FP_ARG_WITH_PATH_GNU_PROG([LD], [ld], [ld])
@@ -114,6 +173,7 @@ AC_SUBST(WordSize)
 #
 dnl ** how to invoke `ar' and `ranlib'
 #
+FP_PROG_AR_SUPPORTS_ATFILE
 FP_PROG_AR_NEEDS_RANLIB
 
 FP_SETTINGS
diff --git a/distrib/remilestoning.pl b/distrib/remilestoning.pl
index a544ddaf1792..60a23af518dd 100644
--- a/distrib/remilestoning.pl
+++ b/distrib/remilestoning.pl
@@ -1,5 +1,6 @@
-#!/usr/bin/perl
+#!/usr/bin/env perl
 
+use warnings;
 use strict;
 
 use DBI;
diff --git a/docs/backpack/.gitignore b/docs/backpack/.gitignore
new file mode 100644
index 000000000000..c3eb46ecd66c
--- /dev/null
+++ b/docs/backpack/.gitignore
@@ -0,0 +1,10 @@
+*.aux
+*.bak
+*.bbl
+*.blg
+*.dvi
+*.fdb_latexmk
+*.fls
+*.log
+*.synctex.gz
+backpack-impl.pdf
diff --git a/docs/backpack/Makefile b/docs/backpack/Makefile
new file mode 100644
index 000000000000..0dd7a9dad511
--- /dev/null
+++ b/docs/backpack/Makefile
@@ -0,0 +1,2 @@
+backpack-impl.pdf: backpack-impl.tex
+	latexmk -pdf -latexoption=-halt-on-error -latexoption=-file-line-error -latexoption=-synctex=1 backpack-impl.tex && touch paper.dvi || ! rm -f $@
diff --git a/docs/backpack/arch.png b/docs/backpack/arch.png
new file mode 100644
index 000000000000..d8b8fd21f9ec
Binary files /dev/null and b/docs/backpack/arch.png differ
diff --git a/docs/backpack/backpack-impl.bib b/docs/backpack/backpack-impl.bib
new file mode 100644
index 000000000000..6bda35a8ea0b
--- /dev/null
+++ b/docs/backpack/backpack-impl.bib
@@ -0,0 +1,17 @@
+@inproceedings{Kilpatrick:2014:BRH:2535838.2535884,
+ author = {Kilpatrick, Scott and Dreyer, Derek and Peyton Jones, Simon and Marlow, Simon},
+ title = {Backpack: Retrofitting Haskell with Interfaces},
+ booktitle = {Proceedings of the 41st ACM SIGPLAN-SIGACT Symposium on Principles of Programming Languages},
+ series = {POPL '14},
+ year = {2014},
+ isbn = {978-1-4503-2544-8},
+ location = {San Diego, California, USA},
+ pages = {19--31},
+ numpages = {13},
+ url = {http://doi.acm.org/10.1145/2535838.2535884},
+ doi = {10.1145/2535838.2535884},
+ acmid = {2535884},
+ publisher = {ACM},
+ address = {New York, NY, USA},
+ keywords = {applicative instantiation, haskell modules, mixin modules, module systems, packages, recursive modules, separate modular development, type systems},
+} 
diff --git a/docs/backpack/backpack-impl.tex b/docs/backpack/backpack-impl.tex
new file mode 100644
index 000000000000..963c53c50b51
--- /dev/null
+++ b/docs/backpack/backpack-impl.tex
@@ -0,0 +1,2483 @@
+\documentclass{article}
+
+\usepackage{pifont}
+\usepackage{graphicx} %[pdftex] OR [dvips]
+\usepackage{fullpage}
+\usepackage{wrapfig}
+\usepackage{float}
+\usepackage{titling}
+\usepackage{hyperref}
+\usepackage{tikz}
+\usepackage{color}
+\usepackage{footnote}
+\usepackage{float}
+\usepackage{algorithm}
+\usepackage{algpseudocode}
+\usetikzlibrary{arrows}
+\usetikzlibrary{positioning}
+\setlength{\droptitle}{-6em}
+
+\input{commands-new-new.tex}
+
+\newcommand{\nuAA}{\nu_\mathit{AA}}
+\newcommand{\nuAB}{\nu_\mathit{AB}}
+\newcommand{\nuGA}{\nu_\mathit{GA}}
+\newcommand{\nuGB}{\nu_\mathit{GB}}
+\newcommand{\betaPL}{\beta_\mathit{PL}}
+\newcommand{\betaAA}{\beta_\mathit{AA}}
+\newcommand{\betaAS}{\beta_\mathit{AS}}
+\newcommand{\thinandalso}{\hspace{.45cm}}
+\newcommand{\thinnerandalso}{\hspace{.38cm}}
+
+\input{commands-rebindings.tex}
+
+\newcommand{\var}[1]{\textsf{#1}}
+
+\newcommand{\ghcfile}[1]{\textsl{#1}}
+
+\title{Implementing Backpack}
+
+\begin{document}
+
+\maketitle
+
+The purpose of this document is to describe an implementation path
+for Backpack in GHC\@.
+
+\tableofcontents
+
+\section{What we are trying to solve}
+
+While the current ecosystem has proved itself serviceable for many years,
+there are a number of major problems which causes significant headaches
+for many users.  Here are some of them:
+
+\subsection{Package reinstalls are destructive}\label{sec:destructive}
+
+When attempting to install a new package, you might get an error like
+this:
+
+\begin{verbatim}
+$ cabal install hakyll
+cabal: The following packages are likely to be broken by the reinstalls:
+pandoc-1.9.4.5
+Graphalyze-0.14.0.0
+Use --force-reinstalls if you want to install anyway.
+\end{verbatim}
+
+While this error message is understandable if you're really trying to
+reinstall a package, it is quite surprising that it can occur even if
+you didn't ask for any reinstalls!
+
+The underlying cause of this problem is related to an invariant Cabal
+currently enforces on a package database: there can only be one instance
+of a package for any given package name and version.  This means that it
+is not possible to install a package multiple times, compiled against
+different dependencies.  However, sometimes, reinstalling a package with
+different dependencies is the only way to fulfill version bounds of a
+package!  For example: say we have three packages \pname{a}, \pname{b}
+and \pname{c}.  \pname{b-1.0} is the only version of \pname{b}
+available, and it has been installed and compiled against \pname{c-1.0}.
+Later, the user installs an updated version \pname{c-1.1} and then
+attempts to install \pname{a}, which depends on the specific versions
+\pname{c-1.1} and \pname{b-1.0}.  We \emph{cannot} use the already
+installed version of \pname{b-1.0}, which depends on the wrong version
+of \pname{c}, so our only choice is to reinstall \pname{b-1.0} compiled
+against \pname{c-1.1}.  This will break any packages, e.g. \pname{d},
+which were built against the old version of \pname{b-1.0}.
+
+Our solution to this problem is to \emph{abolish} destructive package
+installs, and allow a package to be installed multiple times with the same
+package name and version.  However, allowing this poses some interesting
+user interface problems, since package IDs are now no longer unambiguous
+identifiers.
+
+\subsection{Version bounds are often over/under-constrained}
+
+When attempting to install a new package, Cabal might fail in this way:
+
+\begin{verbatim}
+$ cabal install hledger-0.18
+Resolving dependencies...
+cabal: Could not resolve dependencies:
+# pile of output
+\end{verbatim}
+
+There are a number of possible reasons why this could occur, but usually
+it's because some of the packages involved have over-constrained version
+bounds, which are resulting in an unsatisfiable set of constraints (or,
+at least, Cabal gave up backtracking before it found a solution.)  To
+add insult to injury, most of the time the bound is nonsense and removing
+it would result in a working compilation.  In fact, this situation is
+so common that Cabal has a flag \verb|--allow-newer| which lets you
+override the package upper bounds.
+
+However, the flip-side is when Cabal finds a satisfying set, but your
+compilation fails with a type error.  Here, you had an under-constrained
+set of version bounds which didn't actually reflect the compatible
+versions of a package, and Cabal picked a version of the package which
+was incompatible.
+
+Our solution to this problem is to use signatures instead of version
+numbers as the primary mechanism by which compatibility is determined:
+e.g., if it typechecks, it's a valid choice.  Version numbers can still
+be used to reflect semantic changes not seen in the types (in
+particular, ruling out buggy versions of a package is a useful
+operation), but these bounds are empirical observations and can be
+collected after-the-fact.
+
+\subsection{It is difficult to support multiple implementations of a type}
+
+This problem is perhaps best described by referring to a particular
+instance of it Haskell's ecosystem: the \texttt{String} data type.  Haskell,
+by default, implements strings as linked lists of integers (representing
+characters).  Many libraries use \texttt{String}, because it's very
+convenient to program against.  However, this representation is also
+very \emph{slow}, so there are alternative implementations such as
+\texttt{Text} which implement efficient, UTF-8 encoded packed byte
+arrays.
+
+Now, suppose you are writing a library and you don't care if the user of
+your library is using \texttt{String} or \texttt{Text}.  However, you
+don't want to rewrite your library twice to support both data types:
+rather, you'd like to rely on some \emph{common interface} between the
+two types, and let the user instantiate the implementation.  The only
+way to do this in today's Haskell is using type classes; however, this
+necessitates rewriting all type signatures from a nice \texttt{String ->
+String} to \texttt{StringLike s => s -> s}.  The result is less readable,
+required a large number of trivial edits to type signatures, and might
+even be less efficient, if GHC does not appropriately specialize your code
+written in this style.
+
+Our solution to this problem is to introduce a new mechanism of
+pluggability: module holes, which let us use types and functions from a
+module \texttt{Data.String} as before, but defer choosing \emph{what}
+module should be used in the implementation to some later point (or
+instantiate the code multiple times with different choices.)
+
+\subsection{Fast moving APIs are difficult to develop/develop against}
+
+Most packages that are uploaded to Hackage have package authors which pay
+some amount of attention to backwards compatibility and avoid making egregious
+breaking changes.  However, a package like the \verb|ghc-api| follows a
+very different model: the library is a treated by its developers as an
+internal component of an application (GHC), and is frequently refactored
+in a way that changes its outwards facing interface.
+
+Arguably, an application like GHC should design a stable API and
+maintain backwards compatibility against it.  However, this is a lot of
+work (including refactoring) which is only being done slowly, and in the
+meantime, the dump of all the modules gives users the functionality they
+want (even if it keeps breaking every version.)
+
+One could say that the core problem is there is no way for users to
+easily communicate to GHC authors what parts of the API they rely on.  A
+developer of GHC who is refactoring an interface will often rely on the
+typechecker to let them know which parts of the codebase they need to
+follow and update, and often could say precisely how to update code to
+use the new interface.  User applications, which live out of tree, don't
+receive this level of attention.
+
+Our solution is to make it possible to typecheck the GHC API against a
+signature.  Important consumers can publish what subsets of the GHC API
+they rely against, and developers of GHC, as part of their normal build
+process, type-check against these signatures.  If the signature breaks,
+a developer can either do the refactoring differently to avoid the
+compatibility-break, or document how to update code to use the new API\@.
+
+\section{Backpack in a nutshell}
+
+For a more in-depth tutorial about Backpack's features, check out Section 2
+of the original Backpack paper.  In this section, we briefly review the
+most important points of Backpack's design.
+
+\paragraph{Thinning and renaming at the module level}
+A user can specify a build dependency which only exposes a subset of
+modules (possibly under different names.)  By itself, it's a way for the
+user to resolve ambiguous module imports at the package level, without
+having to use the \texttt{PackageImports} syntax extension.
+
+\paragraph{Holes (abstract module definitions)}  The core
+component of Backpack's support for \emph{separate modular development}
+is the ability to specify abstract module bindings, or holes, which give
+users of the module an obligation to provide an implementation which
+fulfills the signature of the hole.  In this example:
+
+\begin{verbatim}
+package p where
+    A :: [ ... ]
+    B = [ import A; ... ]
+\end{verbatim}
+
+\verb|p| is an \emph{indefinite package}, which cannot be compiled until
+an implementation of \m{A} is provided.  However, we can still type check
+\m{B} without any implementation of \m{A}, by type checking it against
+the signature.  Holes can be put into signature packages and included
+(depended upon) by other packages to reuse definitions of signatures.
+
+\paragraph{Filling in holes with an implementation}
+A hole in an indefinite package can be instantiated in a \emph{mix-in}
+style: namely, if a signature and an implementation have the same name,
+they are linked together:
+
+\begin{verbatim}
+package q where
+    A = [ ... ]
+    include p -- has signature A
+\end{verbatim}
+
+Renaming is often useful to rename a module (or a hole) so that a signature
+and implementation have the same name and are linked together.
+An indefinite package can be instantiated multiple times with different
+implementations: the \emph{applicativity} of Backpack means that if
+a package is instantiated separately with the same module, the results
+are type equal:
+
+\begin{verbatim}
+package q' where
+    A = [ ... ]
+    include p (A, B as B1)
+    include p (A, B as B2)
+    -- B1 and B2 are equivalent
+\end{verbatim}
+
+\paragraph{Combining signatures together}
+Unlike implementations, it's valid for a multiple signatures with the
+same name to be in scope.
+
+\begin{verbatim}
+package a-sig where
+    A :: [ ... ]
+package a-sig2 where
+    A :: [ ... ]
+package q where
+    include a-sig
+    include a-sig2
+    B = [ import A; ... ]
+\end{verbatim}
+
+These signatures \emph{merge} together, providing the union of the
+functionality (assuming the types of individual entities are
+compatible.)  Backpack has a very simple merging algorithm: types must
+match exactly to be compatible (\emph{width} subtyping).
+
+\clearpage
+
+\section{Module and package identity}
+
+\begin{figure}[H]
+\begin{tabular}{p{0.45\textwidth} p{0.45\textwidth}}
+\begin{verbatim}
+package p where
+    A :: [ data X ]
+    P = [ import A; data Y = Y X ]
+package q where
+    A1 = [ data X = X1 ]
+    A2 = [ data X = X2 ]
+    include p (A as A1, P as P1)
+    include p (A as A2, P as P2)
+\end{verbatim}
+&
+\begin{verbatim}
+package p where
+    A :: [ data X ]
+    P = [ data T = T ] -- no A import!
+package q where
+    A1 = [ data X = X1 ]
+    A2 = [ data X = X2 ]
+    include p (A as A1, P as P1)
+    include p (A as A2, P as P2)
+\end{verbatim}
+\\
+(a) Type equality must consider holes\ldots &
+(b) \ldots but how do we track dependencies? \\
+\end{tabular}
+\caption{Two similar examples}\label{fig:simple-ex}
+\end{figure}
+
+One of the central questions one encounters when type checking Haskell
+code is: \emph{when are two types equal}?  In ordinary Haskell, the
+answer is simple: ``They are equal if their \emph{original names} (i.e.,
+where they were originally defined) are the same.''  However, in
+Backpack, the situation is murkier due to the presence of \emph{holes}.
+Consider the pair of examples in Figure~\ref{fig:simple-ex}.
+In Figure~\ref{fig:simple-ex}a,  the types \m{B1}.\verb|Y| and \m{B2}.\verb|Y| should not be
+considered equal, even though na\"\i vely their original names are
+\pname{p}:\m{B}.\verb|Y|, since their arguments are different \verb|X|'s!
+On the other hand, if we instantiated \pname{p} twice with the same \m{A}
+(e.g., change the second include to \texttt{include p (A as A1, P as P2)}),
+we might consider the two resulting \verb|Y|'s
+equal, an \emph{applicative} semantics of identity instantiation.  In
+Figure~\ref{fig:simple-ex}b, we see that even though \m{A} was instantiated differently,
+we might reasonably wonder if \texttt{T} should still be considered the same,
+since it has no dependence on the actual choice of \m{A}.
+
+In fact, there are quite a few different choices that can be made here.
+Figures~\ref{fig:applicativity}~and~\ref{fig:granularity} summarize the various
+choices on two axes: the granularity of applicativity (under what circumstances
+do we consider two types equal) and the granularity of dependency (what circumstances
+do we consider two types not equal)?  A \ding{52} means the design we have chosen
+answers the question affirmatively---\ding{54}, negatively---but all of these choices
+are valid points on the design space.
+
+\subsection{The granularity of applicativity}
+
+An applicative semantics of package instantiation states that if a package is
+instantiated with the ``same arguments'', then the resulting entities it defines
+should also be considered equal.  Because Backpack uses \emph{mix-in modules},
+it is very natural to consider the arguments of a package instantiation as the
+modules, as shown in Figure~\ref{fig:applicativity}b: the same module \m{A} is
+linked for both instantiations, so \m{P1} and \m{P2} are considered equal.
+
+However, we consider the situation at a finer granularity, we might say, ``Well,
+for a declaration \texttt{data Y = Y X}, only the definition of type \verb|X| matters.
+If they are the same, then \verb|Y| is the same.''  In that case, we might accept
+that in Figure~\ref{fig:applicativity}a, even though \pname{p} is instantiated
+with different modules, at the end of the day, the important component \verb|X| is
+the same in both cases, so \verb|Y| should also be the same.  This is a sort of
+``extreme'' view of modular development, where every declaration is desugared
+into a separate module.  In our design, we will be a bit more conservative, and
+continue with module level applicativity, in the same manner as Paper Backpack.
+
+\paragraph{Implementation considerations}
+Compiling Figure~\ref{fig:applicativity}b to dynamic libraries poses an
+interesting challenge, if every package compiles to a dynamic library.
+When we compile package \pname{q}, the libraries we end up producing are \pname{q}
+and an instance of \pname{p} (instantiated with \pname{q}:\m{A}).  Furthermore,
+\pname{q} refers to code in \pname{p} (the import in \m{Q}), and vice versa (the usage
+of the instantiated hole \m{A}).  When building static libraries, this circular
+dependency doesn't matter: when we link the executable, we can resolve all
+of the symbols in one go.  However, when the libraries in question are
+dynamic libraries \verb|libHSq.so| and \verb|libHSp(q:A).so|, we now have
+a \emph{circular dependency} between the two dynamic libraries, and most dynamic
+linkers will not be able to load either of these libraries.
+
+To break the circularity in Figure~\ref{fig:applicativity}b, we have to \emph{inline}
+the entire module \m{A} into the instance of \pname{p}.  Since the code is exactly
+the same, we can still consider the instance of \m{A} in \pname{q} and in \pname{p}
+type equal.  However, in Figure~\ref{fig:applicativity}c, applicativity has been
+done at a coarser level: although we are using Backpack's module mixin syntax,
+morally, this example is filling in the holes with the \emph{package} \pname{a}
+(rather than a module).  In this case, we can achieve code sharing, since
+\pname{p} can refer directly to \pname{a}, breaking the circularity.
+
+\newcolumntype{C}{>{\centering\arraybackslash}p{0.3\textwidth}}
+    \begin{savenotes}
+\begin{figure}
+    \begin{tabular}{C C C}
+\begin{verbatim}
+package q where
+  A = [ data X = X ]
+  A1 = [ import A; x = 0 ]
+  A2 = [ import A; x = 1 ]
+  include p (A as A1, P as P1)
+  include p (A as A2, P as P2)
+  Q = [ import P1; ... ]
+\end{verbatim}
+&
+\begin{verbatim}
+package q where
+  A = [ data X = X ]
+
+
+  include p (A, P as P1)
+  include p (A, P as P2)
+  Q = [ import P1; ... ]
+\end{verbatim}
+&
+\begin{verbatim}
+package a where
+  A = [ data X = X ]
+package q where
+  include a
+  include p (A, P as P1)
+  include p (A, P as P2)
+  Q = [ import P1; ... ]
+\end{verbatim}
+  \\
+  (a) Declaration applicativity \ding{54} &
+  (b) Module applicativity \ding{52} &
+  (c) Package applicativity \ding{52} \\
+\end{tabular}
+\caption{Choices of granularity of applicativity on \pname{p}: given \texttt{data Y = Y X},  is \m{P1}.\texttt{Y} equal to \m{P2}.\texttt{Y}?}\label{fig:applicativity}
+\end{figure}
+\end{savenotes}
+
+\subsection{The granularity of dependency}
+
+\begin{savenotes}
+\newcolumntype{C}{>{\centering\arraybackslash}p{0.3\textwidth}}
+\begin{figure}
+    \begin{tabular}{C C C}
+\begin{verbatim}
+package p(A,P) where
+  A :: [ data X ]
+  P = [
+    import A
+    data T = T
+    data Y = Y X
+  ]
+\end{verbatim}
+&
+\begin{verbatim}
+package p(A,P) where
+  A :: [ data X ]
+  B = [ data T = T ]
+  C = [
+    import A
+    data Y = Y X
+  ]
+  P = [
+    import B
+    import C
+  ]
+\end{verbatim}
+&
+\begin{verbatim}
+package b where
+  B = [ data T = T ]
+package c where
+  A :: [ data X ]
+  C = [
+    import A
+    data Y = Y X
+  ]
+package p(A,P) where
+  include b; include c
+  P = [ import B; import C ]
+\end{verbatim}
+  \\
+  (a) Declaration granularity \ding{54} &
+  (b) Module granularity \ding{54} &
+  (c) Package granularity \ding{52} \\
+\end{tabular}
+\caption{Choices of granularity for dependency: is the identity of \texttt{T} independent of how \m{A} is instantiated?}\label{fig:granularity}
+\end{figure}
+
+\end{savenotes}
+
+In the previous section, we considered \emph{what} entities may be considered for
+computing dependency; in this section we consider \emph{which} entities are actually
+considered as part of the dependencies for the declaration/module/package we're writing.
+Figure~\ref{fig:granularity} contains a series of examples which exemplify the choice
+of whether or not to collect dependencies on a per-declaration, per-module or per-package basis:
+
+\begin{itemize}
+    \item Package-level granularity states that the modules in a package are
+considered to depend on \emph{all} of the holes in the package, even if
+the hole is never imported.  Figure~\ref{fig:granularity}c is factored so that
+\verb|T| is defined in a distinct package \pname{b} with no holes, so no matter
+the choice of \m{A}, \m{B}.\verb|T| will be the same.  On the other hand, in
+Figure~\ref{fig:granularity}b, there is a hole in the package defining \m{B},
+so the identity of \verb|T| will depend on the choice of \m{A}.
+
+\item Module-level granularity states that each module has its own dependency,
+computed by looking at its import statements.  In this setting, \verb|T| in Figure~\ref{fig:granularity}b
+is independent of \m{A}, since the hole is never imported in \m{B}.  But once again, in
+Figure~\ref{fig:granularity}a, there is an import in the module defining \verb|T|,
+so the identity of \verb|T| once again depends on the choice of \m{A}.
+
+\item Finally, at the finest level of granularity, one could chop up \pname{p} in
+Figure~\ref{fig:granularity}a, looking at the type declaration-level dependency
+to suss out whether or not \verb|T| depends on \m{A}.  It doesn't refer to
+anything in \m{A}, so it is always considered the same.
+\end{itemize}
+
+It is well worth noting that the system described by Paper Backpack tracks dependencies per module;
+however, we have decided that we will implement tracking per package instead:
+a coarser grained granularity which accepts less programs.
+
+Is a finer form of granularity \emph{better?} Not necessarily!  For
+one, we can always split packages into further subpackages (as was done
+in Figure~\ref{fig:granularity}c) which better reflect the internal hole
+dependencies, so it is always possible to rewrite a program to make it
+typecheck---just with more packages.  Additionally, the finer the
+granularity of dependency, the more work I have to do to understand what
+the identities of entities in a module are.  In Paper Backpack, I have
+to understand the imports of all modules in a package; with
+declaration-granularity, I have to understand the entire code.  This is
+a lot of work for the developer to think about; a more granular model is
+easier to remember and reason about.  Finally, package-level granularity
+is much easier to implement, as it preserves the previous compilation
+model, \emph{one library per package}.  At a fine level of granularity, we
+may end up repeatedly compiling a module which actually should be considered
+``the same'' as any other instance of it.
+
+Nevertheless, finer granularity can be desirable from an end-user perspective.
+Usually, these circumstances arise when library-writers are forced to split their
+components into many separate packages, when they would much rather have written
+a single package.  For example, if I define a data type in my library, and would
+like to define a \verb|Lens| instance for it, I would create a new package just
+for the instance, in order to avoid saddling users who aren't interested in lenses
+with an extra dependency.  Another example is test suites, which have dependencies
+on various test frameworks that a user won't care about if they are not planning
+on testing the code. (Cabal has a special case for this, allowing the user
+to write effectively multiple packages in a single Cabal file.)
+
+\subsection{Summary}
+
+We can summarize all of the various schemes by describing the internal data
+types that would be defined by GHC under each regime.  First, we have
+the shared data structures, which correspond closely to what users are
+used to seeing:
+
+\begin{verbatim}
+<pkg-name>   ::= containers, ...
+<pkg-version ::= 1.0, ...
+<pkg-id>     ::= <pkg-name>-<pkg-version>
+<mod-name>   ::= Data.Set, ...
+<occ>        ::= empty, ...
+\end{verbatim}
+
+Changing the \textbf{granularity of applicativity} modifies how we represent the
+list of dependencies associated with an entity.  With module applicativity,
+we list module identities (not yet defined); with declaration applicativity
+we actually list the original names (i.e., ids).
+
+\begin{verbatim}
+<deps>       ::= <id>, ...      # Declaration applicativity
+<deps>       ::= <module>, ...  # Module applicativity
+\end{verbatim}
+
+Changing the \textbf{granularity of dependency} affects how we compute
+the lists of dependencies, and what entities are well defined:
+
+\begin{verbatim}
+# Package-level granularity
+<pkg-key>    ::= hash(<pkg-id> + <deps for pkg>)
+<module>     ::= <pkg-key> : <mod-name>
+<id>         ::= <module> . <occ>
+
+# Module-level granularity
+<pkg-key>    not defined
+<module>     ::= hash(<pkg-id> : <mod-name> + <deps for mod>)
+<id>         ::= <module-key> . <occ>
+
+# Declaration-level granularity
+<pkg-key>    not defined
+<module>     not defined
+<id>         ::= hash(<pkg-id> : <mod-name> . <occ> + <deps for decl>)
+\end{verbatim}
+
+Notice that as we increase the granularity, the notion of a ``package'' and a ``module''
+become undefined.  This is because, for example, with module-level granularity, a single
+``package'' may result in several modules, each of which have different sets of
+dependencies.  It doesn't make much sense to refer to the package as a monolithic entity,
+because the point of splitting up the dependencies was so that if a user relies only
+on a single module, it has a correspondingly restricted set of dependencies.
+\subsection{The new scheme, formally}
+
+\begin{wrapfigure}{R}{0.5\textwidth}
+\begin{myfig}
+\[
+\begin{array}{@{}lr@{\;}c@{\;}l@{}}
+    \text{Package Names (\texttt{PkgName})} & P &\in& \mathit{PkgNames} \\
+    \text{Module Path Names (\texttt{ModName})} & p &\in& \mathit{ModPaths} \\
+    \text{Module Identity Vars} & \alpha,\beta &\in& \mathit{IdentVars} \\
+    \text{Package Key (\texttt{PackageKey})} & \K &::=& P(\vec{p\mapsto\nu}) \\
+    \text{Module Identities (\texttt{Module})} & \nu &::=&
+      \alpha ~|~
+      \K\colon\! p \\
+    \text{Module Identity Substs} & \phi,\theta &::=&
+      \{\vec{\alpha \coloneqq \nu}\} \\
+\end{array}
+\]
+\caption{Module Identities}
+\label{fig:mod-idents}
+\end{myfig}
+\end{wrapfigure}
+
+In this section, we give a formal treatment of our choice in the design space, in the
+same style as the Backpack paper, but omitting mutual recursion, as it follows straightforwardly.
+Physical module
+identities $\nu$, the \texttt{Module} component of \emph{original names} in GHC, are either (1) \emph{variables} $\alpha$, which are
+used to represent holes\footnote{In practice, these will just be fresh paths in a special package key for variables.} or (2) a concrete module $p$ defined in package
+$P$, with holes instantiated with other module identities (might be
+empty)\footnote{In Paper Backpack, we would refer to just $P$:$p$ as the identity
+constructor.  However, we've written the subterms specifically next to $P$ to highlight the semantic difference of these terms.}.
+
+As in traditional Haskell, every package contains a number of module
+files at some module path $p$; within a package these paths are
+guaranteed to be unique.\footnote{In Paper Backpack, the module expressions themselves are used to refer to globally unique identifiers for each literal.  This makes the metatheory simpler, but for implementation purposes it is convenient to conflate the \emph{original} module path that a module is defined at with its physical identity.}  When we write inline module definitions, we assume
+that they are immediately assigned to a module path $p$ which is incorporated
+into their identity.  A module identity $\nu$ simply augments this
+with subterms $\vec{p\mapsto\nu}$ representing how \emph{all} holes in the package $P$
+were instantiated.\footnote{In Paper Backpack, we do not distinguish between holes/non-holes, and we consider all imports of the \emph{module}, not the package.}  This naming is stable because the current Backpack surface syntax does not allow a logical path in a package
+to be undefined.  A package key is $P(\vec{p\mapsto\nu})$.
+
+Here is the very first example from
+Section 2 of the original Backpack paper, \pname{ab-1}:
+
+\begin{example}
+\Pdef{ab-1}{
+    \Pmod{A}{x = True}
+    \Pmod{B}{\Mimp{A}; y = not x}
+    % \Pmodd{C}{\mname{A}}
+}
+\end{example}
+
+The identities of \m{A} and \m{B} are
+\pname{ab-1}:\mname{A} and \pname{ab-1}:\mname{B}, respectively.\footnote{In Paper Backpack, the identity for \mname{B} records its import of \mname{A}, but since it is definite, this is strictly redundant.} In a package with holes, each
+hole (within the package definition) gets a fresh variable as its
+identity, and all of the holes associated with package $P$ are recorded. Consider \pname{abcd-holes-1}:
+
+\begin{example}
+\Pdef{abcd-holes-1}{
+    \Psig{A}{x :: Bool} % chktex 26
+    \Psig{B}{y :: Bool} % chktex 26
+    \Pmod{C}{x = False}
+    \Pmodbig{D}{
+        \Mimpq{A}\\
+        \Mimpq{C}\\
+        % \Mexp{\m{A}.x, z}\\
+        z = \m{A}.x \&\& \m{C}.x
+    }
+}
+\end{example}
+
+The identities of the four modules
+are, in order, $\alpha_a$, $\alpha_b$, $\pname{abcd-holes-1}(\alpha_a,\alpha_b)$:\mname{C}, and
+$\pname{abcd-holes-1}(\alpha_a,\alpha_b)$:\mname{D}.\footnote{In Paper Backpack, the granularity is at the module level, so the subterms of \mname{C} and \mname{D} can differ.}  We include both $\alpha_a$ and $\alpha_b$ in both \mname{C} and \mname{D}, regardless of the imports.  When we link the package against an implementation of the hole, these variables are replaced with the identities of the modules we linked against.
+
+Shaping proceeds in the same way as in Paper Backpack, except that the
+shaping judgment must also accept the package key
+$P(\vec{p\mapsto\alpha})$ so we can create identifiers with
+\textsf{mkident}.  This implies we must know ahead of time what the holes
+of a package are.
+
+\paragraph{A full Backpack comparison}
+If you're curious about how the rest of the Backpack examples translate,
+look no further than this section.
+
+First, consider the module identities in the \m{Graph} instantiations in
+\pname{multinst}, shown in Figure 2 of the original Backpack paper.
+In the definition of \pname{structures}, assume that the variables for
+\m{Prelude} and \m{Array} are $\alpha_P$ and $\alpha_A$ respectively.
+The identity of \m{Graph} is $\pname{structures}(\alpha_P, \alpha_A)$:\m{Graph}. Similarly, the identities of the two array implementations
+are $\nu_{AA} = \pname{arrays-a}(\alpha_P)$:\m{Array} and
+$\nu_{AB} = \pname{arrays-b}(\alpha_P)$:\m{Array}.\footnote{Notice that the subterms coincide with Paper Backpack!  A sign that module level granularity is not necessary for many use-cases.}
+
+The package \pname{graph-a} is more interesting because it
+\emph{links} the packages \pname{arrays-a} and \pname{structures}
+together, with the implementation of \m{Array} from \pname{arrays-a}
+\emph{instantiating} the hole \m{Array} from \pname{structures}.  This
+linking is reflected in the identity of the \m{Graph} module in
+\pname{graph-a}: whereas in \pname{structures} it was $\nu_G =
+\pname{structures}(\alpha_P, \alpha_A)$:\m{Graph}, in \pname{graph-a} it is
+$\nu_{GA} = \nu_G[\nu_{AA}/\alpha_A] = \pname{structures}(\alpha_P, \nu_{AA})$:\m{Graph}.  Similarly, the identity of \m{Graph} in
+\pname{graph-b} is $\nu_{GB} = \nu_G[\nu_{AB}/\alpha_A] =
+\pname{structures}(\alpha_P, \nu_{AB})$:\m{Graph}.  Thus, linking consists
+of substituting the variable identity of a hole by the concrete
+identity of the module filling that hole.
+
+Lastly, \pname{multinst} makes use of both of these \m{Graph}
+modules, under the aliases \m{GA} and \m{GB}, respectively.
+Consequently, in the \m{Client} module, \code{\m{GA}.G} and
+\code{\m{GB}.G} will be correctly viewed as distinct types since they
+originate in modules with distinct identities.
+
+As \pname{multinst} illustrates, module identities effectively encode
+dependency graphs at the package level.\footnote{In Paper Backpack, module identities
+encode dependency graphs at the module level.  In both cases, however, what is being
+depended on is always a module.}  Like in Paper Backpack, we have an \emph{applicative}
+semantics of instantiation, and the applicativity example in Figure 3 of the
+Backpack paper still type checks.  However, because we are operating at a coarser
+granularity, modules may have spurious dependencies on holes that they don't
+actually depend on, which means less type equalities may hold.
+
+
+\subsection{Cabal dependency resolution}
+
+Currently, when we compile a Cabal
+package, Cabal goes ahead and resolves \verb|build-depends| entries with actual
+implementations, which we compile against.  A planned addition to the package key,
+independent of Backpack, is to record the transitive dependency tree selected
+during this dependency resolution process, so that we can install \pname{libfoo-1.0}
+twice compiled against different versions of its dependencies.
+What is the relationship to this transitive dependency tree of \emph{packages},
+with the subterms of our package identities which are \emph{modules}?  Does one
+subsume the other?  In fact, these are separate mechanisms---two levels of indirections,
+so to speak.
+
+To illustrate, suppose I write a Cabal file with \verb|build-depends: foobar|.  A reasonable assumption is that this translates into a
+Backpack package which has \verb|include foobar|.  However, this is not
+actually a Paper Backpack package: Cabal's dependency solver has to
+rewrite all of these package references into versioned references
+\verb|include foobar-0.1|.  For example, this is a pre-package:
+
+\begin{verbatim}
+package foo where
+    include bar
+\end{verbatim}
+
+and this is a Paper Backpack package:
+
+\begin{verbatim}
+package foo-0.3[bar-0.1[baz-0.2]] where
+    include bar-0.1[baz-0.2]
+\end{verbatim}
+
+This tree is very similar to the one tracking dependencies for holes,
+but we must record this tree \emph{even} when our package has no holes.
+%   As a final example, the full module
+%   identity of \m{B1} in Figure~\ref{fig:granularity} may actually be $\pname{p-0.9(q-1.0[p-0.9]:A1)}$:\m{B}.
+
+\paragraph{Linker symbols} As we increase the amount of information in
+PackageId, it's important to be careful about the length of these IDs,
+as they are used for exported linker symbols (e.g.
+\verb|base_TextziReadziLex_zdwvalDig_info|).  Very long symbol names
+hurt compile and link time, object file sizes, GHCi startup time,
+dynamic linking, and make gdb hard to use.  As such, we are going to
+do away with full package names and versions and instead use just a
+base-62 encoded hash, with the first five characters of the package
+name for user-friendliness.
+
+\subsection{Package selection}
+
+When I fire up \texttt{ghci} with no arguments, GHC somehow creates
+out of thin air some consistent set of packages, whose modules I can
+load using \texttt{:m}.  This functionality is extremely handy for
+exploratory work, but actually GHC has to work quite hard in order
+to generate this set of packages, the contents of which are all
+dumped into a global namespace.  For example, GHC doesn't have access
+to Cabal's dependency solver, nor does it know \emph{which} packages
+the user is going to ask for, so it can't just run a constraint solver,
+get a set of consistent packages to offer and provide them to the user.\footnote{Some might
+argue that depending on a global environment in this fashion is wrong, because
+when you perform a build in this way, you have absolutely no ideas what
+dependencies you actually ended up using.  But the fact remains that for
+end users, this functionality is very useful.}
+
+To make matters worse, while in the current design of the package database,
+a package is uniquely identified by its package name and version, in
+the Backpack design, it is \emph{mandatory} that we support multiple
+packages installed in the database with the same package name and version,
+and this can result in complications in the user model.  This further
+complicates GHC's default package selection algorithm.
+
+In this section, we describe how the current algorithm operates (including
+what invariants it tries to uphold and where it goes wrong), and how
+to replace the algorithm to handle generalization to
+multiple instances in the package database.  We'll also try to tease
+apart the relationship between package keys and installed package IDs in
+the database.
+
+\paragraph{The current algorithm} Abstractly, GHC's current package
+selection algorithm operates as follows.  For every package name, select
+the package with the latest version (recall that this is unique) which
+is also \emph{valid}.  A package is valid if:
+
+\begin{itemize}
+    \item It exists in the package database,
+    \item All of its dependencies are valid,
+    \item It is not shadowed by a package with the same package ID\footnote{Recall that currently, a package ID uniquely identifies a package in the package database} in
+        another package database (unless it is in the transitive closure
+        of a package named by \texttt{-package-id}), and
+    \item It is not ignored with \texttt{-ignore-package}.
+\end{itemize}
+
+Package validity is probably the minimal criterion for to GHC to ensure
+that it can actually \emph{use} a package.  If the package is missing,
+GHC can't find the interface files or object code associated with the
+package.  Ignoring packages is a way of pretending that a package is
+missing from the database.
+
+Package validity is also a very weak criterion.  Another criterion we
+might hope holds is \emph{consistency}: when we consider the transitive
+closure of all selected packages, for any given package name, there
+should only be one instance providing that package.  It is trivially
+easy to break this property: suppose that I have packages \pname{a-1.0},
+\pname{b-1.0} compiled against \pname{a-1.0}, and \pname{a-1.1}.  GHC
+will happily load \pname{b-1.0} and \pname{a-1.1} together in the same
+interactive session (they are both valid and the latest versions), even
+though \pname{b-1.0}'s dependency is inconsistent with another package
+that was loaded.  The user will notice if they attempt to treat entities
+from \pname{a} reexported by \pname{b-1.0} and entities from
+\pname{a-1.1} as type equal.  Here is one user who had this problem:
+\url{http://stackoverflow.com/questions/12576817/}.  In some cases, the
+problem is easy to work around (there is only one offending package
+which just needs to be hidden), but if the divergence is deep in two
+separate dependency hierarchies, it is often easier to just blow away
+the package database and try again.
+
+Perversely, destructive reinstallation helps prevent these sorts of
+inconsistent databases.  While inconsistencies can arise when multiple
+versions of a package are installed, multiple versions will frequently
+lead to the necessity of reinstalls.  In the previous example, if a user
+attempts to Cabal install a package which depends on \pname{a-1.1} and
+\pname{b-1.0}, Cabal's dependency solver will propose reinstalling
+\pname{b-1.0} compiled against \pname{a-1.1}, in order to get a
+consistent set of dependencies.  If this reinstall is accepted, we
+invalidate all packages in the database which were previously installed
+against \pname{b-1.0} and \pname{a-1.0}, excluding them from GHC's
+selection process and making it more likely that the user will see a
+consistent view of the database.
+
+\paragraph{Enforcing consistent dependencies}  From the user's
+perspective, it would be desirable if GHC never loaded a set of packages
+whose dependencies were inconsistent.
+There are two ways we can go
+about doing this.  First, we can improve GHC's logic so that it doesn't
+pick an inconsistent set.  However, as a point of design, we'd like to
+keep whatever resolution GHC does as simple as possible (in an ideal
+world, we'd skip the validity checks entirely, but they ended up being
+necessary to prevent broken database from stopping GHC from starting up
+at all). In particular, GHC should \emph{not} learn how to do
+backtracking constraint solving: that's in the domain of Cabal.  Second,
+we can modify the logic of Cabal to enforce that the package database is
+always kept in a consistent state, similar to the consistency check
+Cabal applies to sandboxes, where it refuses to install a package to a
+sandbox if the resulting dependencies would not be consistent.
+
+The second alternative is a appealing, but Cabal sandboxes are currently
+designed for small, self-contained single projects, as opposed to the
+global ``universe'' that a default environment is intended to provide.
+For example, with a Cabal sandbox environment, it's impossible to
+upgrade a dependency to a new version without blowing away the sandbox
+and starting again.  To support upgrades, Cabal needs to do some work:
+when a new version is put in the default set, all of the
+reverse-dependencies of the old version are now inconsistent.  Cabal
+should offer to hide these packages or reinstall them compiled against
+the latest version.  Furthermore, because we in general may not have write
+access to all visible package databases, this visibility information
+must be independent of the package databases themselves.
+
+As a nice bonus, Cabal should also be able to snapshot the older
+environment which captures the state of the universe prior to the
+installation, in case the user wants to revert back.
+
+\paragraph{Modifying the default environment}  Currently, after GHC
+calculates the default package environment, a user may further modify
+the environment by passing package flags to GHC, which can be used to
+explicitly hide or expose packages.  How do these flags interact with
+our Cabal-managed environments?  Hiding packages is simple enough,
+but exposing packages is a bit dicier.  If a user asks for a different
+version of a package than in the default set, it will probably be
+inconsistent with the rest of the dependencies.  Cabal would have to
+be consulted to figure out a maximal set of consistent packages with
+the constraints given.  Alternatively, we could just supply the package
+with no claims of consistency.
+
+However, this use-case is rare.  Usually, it's not because they want a
+specific version: the package is hidden simply because we're not
+interested in loading it by default (\pname{ghc-api} is the canonical
+example, since it dumps a lot of modules in the top level namespace).
+If we distinguish packages which are consistent but hidden, their
+loads can be handled appropriately.
+
+\paragraph{Consistency in Backpack} We have stated as an implicit
+assumption that if we have both \pname{foo-1.0} and \pname{foo-1.1}
+available, only one should be loaded at a time.  What are the
+consequences if both of these packages are loaded at the same time?  An
+import of \m{Data.Foo} provided by both packages would be ambiguous and
+the user might find some type equalities they expect to hold would not.
+However, the result is not \emph{unsound}: indeed, we might imagine a
+user purposely wanting two different versions of a library in the same
+program, renaming the modules they provided so that they could be
+referred to unambiguously.  As another example, suppose that we have an
+indefinite package with a hole that is instantiated multiple times.  In
+this case, a user absolutely may want to refer to both instantiations,
+once again renaming modules so that they have unique names.
+
+There are two consequences of this.  First, while the default package
+set may enforce consistency, a user should still be able to explicitly
+ask for a package instance, renamed so that its modules don't conflict,
+and then use it in their program.  Second, instantiated indefinite packages
+should \emph{never} be placed in the default set, since it's impossible
+to know which instantiation is the one the user prefers.  A definite package
+can reexport an instantiated module under an unambiguous name if the user
+so pleases.
+
+\paragraph{Shadowing, installed package IDs, ABI hashes and package
+keys} Shadowing plays an important role for maintaining the soundness of
+compilation; call this the \emph{compatibility} of the package set.  The
+problem it addresses is when there are two distinct implementations of a
+module, but because their package ID (or package key, in the new world
+order) are the same, they are considered type equal.  It is absolutely
+wrong for a single program to include both implementations
+simultaneously (the symbols would conflict and GHC would incorrectly
+conclude things were type equal when they're not), so \emph{shadowing}'s
+job is to ensure that only one instance is picked, and all the other
+instances considered invalid (and their reverse-dependencies, etc.)
+Recall that in current GHC, within a package database, a package
+instance is uniquely identified by its package ID\@; thus, shadowing
+only needs to take place between package databases.  An interesting
+corner case is when the same package ID occurs in both databases, but
+the installed package IDs are the \emph{same}.  Because the installed
+package ID is currently simply an ABI hash, we skip shadowing, because
+the packages are---in principle---interchangeable.
+
+There are currently a number of proposed changes to this state of affairs:
+
+\begin{itemize}
+    \item Change installed package IDs to not be based on ABI hashes.
+        ABI hashes have a number of disadvantages as identifiers for
+        packages in the database.  First, they cannot be computed until
+        after compilation, which gave the multi-instance GSoC project a
+        few years some headaches.  Second, it's not really true that
+        programs with identical ABI hashes are interchangeable: a new
+        package may be ABI compatible but have different semantics.
+        Thus, installed package IDs are a poor unique identifier for
+        packages in the package database.  However, because GHC does not
+        give ABI stability guarantees, it would not be possible to
+        assume from here that packages with the same installed package
+        ID are ABI compatible.
+
+    \item Relaxing the uniqueness constraint on package IDs.  There are
+        actually two things that could be done here.  First, since we
+        have augmented package IDs with dependency resolution
+        information to form package keys, we could simply state that
+        package keys uniquely identify a package in a database.
+        Shadowing rules can be implemented in the same way as before, by
+        preferring the instance topmost on the stack.  Second, we could
+        also allow \emph{same-database} shadowing: that is, not even
+        package keys are guaranteed to be unique in a database: instead,
+        installed package IDs are the sole unique identifier of a
+        package.  This architecture is Nix inspired, as the intent is
+        to keep all package information in a centralized database.
+\end{itemize}
+
+Without mandatory package environments, same-database shadowing is a bad
+idea, because GHC now has no idea how to resolve shadowing.  Conflicting
+installed package IDs can be simulated by placing them in multiple
+package databases (in principle, the databases can be concatenated together
+and treated as a single monolitic database.)
+
+\section{Shapeless Backpack}\label{sec:simplifying-backpack}
+
+Backpack as currently defined always requires a \emph{shaping} pass,
+which calculates the shapes of all modules defined in a package.
+The shaping pass is critical to the solution of the double-vision problem
+in recursive module linking, but it also presents a number of unpalatable
+implementation problems:
+
+\begin{itemize}
+
+    \item \emph{Shaping is a lot of work.} A module shape specifies the
+        providence of all data types and identifiers defined by a
+        module. To calculate this, we must preprocess and parse all
+        modules, even before we do the type-checking pass.  (Fortunately,
+        shaping doesn't require a full parse of a module, only enough
+        to get identifiers.  However, it does have to understand import
+        statements at the same level of detail as GHC's renamer.)
+
+    \item \emph{Shaping must be done upfront.} In the current Backpack
+        design, all shapes must be computed before any typechecking can
+        occur.  While performing the shaping pass upfront is necessary
+        in order to solve the double vision problem (where a module
+        identity may be influenced by later definitions), it means
+        that GHC must first do a shaping pass, and then revisit every module and
+        compile them proper.  Nor is it (easily) possible to skip the
+        shaping pass when it is unnecessary, as one might expect to be
+        the case in the absence of mutual recursion.  Shaping is not
+        a ``pay as you go'' language feature.
+
+    \item \emph{GHC can't compile all programs shaping accepts.}  Shaping
+        accepts programs that GHC, with its current hs-boot mechanism, cannot
+        compile.  In particular, GHC requires that any data type or function
+        in a signature actually be \emph{defined} in the module corresponding
+        to that file (i.e., an original name can be assigned to these entities
+        immediately.)  Shaping permits unrestricted exports to implement
+        modules; this shows up in the formalism as $\beta$ module variables.
+
+    \item \emph{Shaping encourages inefficient program organization.}
+        Shaping is designed to enable mutually recursive modules, but as
+        currently implemented, mutual recursion is less efficient than
+        code without recursive dependencies. Programmers should avoid
+        this code organization, except when it is absolutely necessary.
+
+    \item \emph{GHC is architecturally ill-suited for directly
+        implementing shaping.}  Shaping implies that GHC's internal
+        concept of an ``original name'' be extended to accommodate
+        module variables.  This is an extremely invasive change to all
+        aspects of GHC, since the original names assumption is baked
+        quite deeply into the compiler.  Plausible implementations of
+        shaping requires all these variables to be skolemized outside
+        of GHC\@.
+
+\end{itemize}
+
+To be clear, the shaping pass is fundamentally necessary for some
+Backpack packages.  Here is the example which convinced Simon:
+
+\begin{verbatim}
+package p where
+    A :: [data T; f :: T -> T]
+    B = [export T(MkT), h; import A(f); data T = MkT; h x = f MkT]
+    A = [export T(MkT), f, h; import B; f MkT = MkT]
+\end{verbatim}
+
+The key to this example is that B \emph{may or may not typecheck} depending
+on the definition of A. Because A reexports B's definition T, B will
+typecheck; but if A defined T on its own, B would not typecheck.  Thus,
+we \emph{cannot} typecheck B until we have done some analysis of A (the
+shaping analysis!)
+
+Thus, it is beneficial (from an optimization point of view) to
+consider a subset of Backpack for which shaping is not necessary.
+Here is a programming discipline which does just that, which we will call the \textbf{linking restriction}: \emph{Module implementations must be declared before
+signatures.}  Formally, this restriction modifies the rule for merging
+polarized module shapes ($\widetilde{\tau}_1^{m_1} \oplus \widetilde{\tau}_2^{m_2}$) so that
+$\widetilde{\tau}_1^- \oplus \widetilde{\tau}_2^+$ is always undefined.\footnote{This seemed to be the crispest way of defining the restriction, although this means an error happens a bit later than I'd like it to: I'd prefer if we errored while merging logical contexts, but we don't know what is a hole at that point.}
+
+Here is an example of the linking restriction. Consider these two packages:
+
+\begin{verbatim}
+package random where
+    System.Random = [ ... ].hs
+
+package monte-carlo where
+    System.Random :: ...
+    System.MonteCarlo = [ ... ].hs
+\end{verbatim}
+
+Here, random is a definite package which may have been compiled ahead
+of time; monte-carlo is an indefinite package with a dependency
+on any package which provides \verb|System.Random|.
+
+Now, to link these two applications together, only one ordering
+is permissible:
+
+\begin{verbatim}
+package myapp where
+    include random
+    include monte-carlo
+\end{verbatim}
+
+If myapp wants to provide its own random implementation, it can do so:
+
+\begin{verbatim}
+package myapp2 where
+    System.Random = [ ... ].hs
+    include monte-carlo
+\end{verbatim}
+
+In both cases, all of \verb|monte-carlo|'s holes have been filled in by the time
+it is included.  The alternate ordering is not allowed.
+
+Why does this discipline prevent mutually recursive modules?  Intuitively,
+a hole is the mechanism by which we can refer to an implementation
+before it is defined; otherwise, we can only refer to definitions which
+preceed our definition. If there are never any holes \emph{which get filled},
+implementation links can only go backwards, ruling out circularity.
+
+It's easy to see how mutual recursion can occur if we break this discipline:
+
+\begin{verbatim}
+package myapp2 where
+    include monte-carlo
+    System.Random = [ import System.MonteCarlo ].hs
+\end{verbatim}
+
+\subsection{Typechecking of definite modules without shaping}
+
+If we are not carrying out a shaping pass, we need to be able to calculate
+$\widetilde{\Xi}_{\mathsf{pkg}}$ on the fly.  In the case that we are
+compiling a package---there will be no holes in the final package---we
+can show that shaping is unnecessary quite easily, since with the
+linking restriction, everything is definite from the get-go.
+
+Observe the following invariant: at any given step of the module
+bindings, the physical context $\widetilde{\Phi}$ contains no
+holes.  We can thus conclude that there are no module variables in any
+type shapes.  As the only time a previously calculated package shape can
+change is due to unification, the incrementally computed shape is in
+fact the true one.
+
+As far as the implementation is concerned, we never have to worry
+about handling module variables; we only need to do extra typechecks
+against (renamed) interface files.
+
+\subsection{Compiling definite packages}\label{sec:compiling}
+
+% New definitions
+\algnewcommand\algorithmicswitch{\textbf{switch}}
+\algnewcommand\algorithmiccase{\textbf{case}}
+\algnewcommand\algorithmicassert{\texttt{assert}}
+% New "environments"
+\algdef{SE}[SWITCH]{Switch}{EndSwitch}[1]{\algorithmicswitch\ #1\ \algorithmicdo}{\algorithmicend\ \algorithmicswitch}%
+\algdef{SE}[CASE]{Case}{EndCase}[1]{\algorithmiccase\ ``#1''}{\algorithmicend\ \algorithmiccase}%
+\algtext*{EndSwitch}%
+\algtext*{EndCase}%
+
+\begin{algorithm}
+    \caption{Compilation of definite packages (assume \texttt{-hide-all-packages} on all \texttt{ghc} invocations)}\label{alg:compile}
+\begin{algorithmic}
+    \Procedure{Compile}{\textbf{package} $P$ \textbf{where} $\vec{B}$, $H$, $db$}\Comment{}$H$ maps hole module names to identities
+    \State$flags\gets \nil$
+    \State$\mathcal{K}$ $\gets$ \Call{Hash}{$P + H$}
+    \State%
+    In-place register the package $\mathcal{K}$ in $db$
+    \For{$B$ \textbf{in} $\vec{B}$}
+        \Case{$p = p\texttt{.hs}$}
+        \State\Call{Exec}{\texttt{ghc -c} $p$\texttt{.hs} \texttt{-package-db} $db$ \texttt{-package-name} $\mathcal{K}$ $flags$}
+        \EndCase%
+        \Case{$p$ $\cc$ $p$\texttt{.hsig}}
+            \State\Call{Exec}{\texttt{ghc -c} $p$\texttt{.hsig} \texttt{-package-db} $db$ \texttt{--sig-of} $H(p)$ $flags$}
+        \EndCase%
+        \Case{$p = p'$}
+            \State$flags\gets flags$ \texttt{-alias} $p$ $p'$
+        \EndCase%
+        \Case{\Cinc{$P'$} $\langle\vec{p_H\mapsto p_H'}, \vec{p\mapsto p'} \rangle$}
+            \State\textbf{let} $H'(p_H) = $ \Call{Exec}{\texttt{ghc --resolve-module} $p_H'$ \texttt{-package-db} $db$ $flags$}
+            \State$\mathcal{K}'\gets$ \Call{Compile}{$P'$, $H'$, $db$}\Comment{}Nota bene: not $flags$
+            \State$flags\gets flags$ \texttt{-package} $\mathcal{K}'$ $\langle\vec{p\mapsto p'}\rangle$
+        \EndCase%
+    \EndFor%
+    \State%
+    Remove $\mathcal{K}$ from $db$
+    \State%
+    Install the complete package $\mathcal{K}$ to the global database
+    \State\Return$\mathcal{K}$
+    \EndProcedure%
+\end{algorithmic}
+\end{algorithm}
+
+The full recursive procedure for compiling a Backpack package using
+one-shot compilation is given in Figure~\ref{alg:compile}.  We
+recursively walk through Backpack descriptions, processing each line by
+invoking GHC and/or modifying our package state.  Here is a more
+in-depth description of the algorithm, line-by-line:
+
+\paragraph{The parameters} To compile a package description for package
+$P$, we need to know $H$, the mapping of holes $p_H$ in package $P$ to
+physical module identities $\nu$ which are implementing them; this
+mapping is used to calculate the package key $\mathcal{K}$ for the
+package in question.  Furthermore, we have an inplace package database
+$db$ in which we will register intermediate build results, including
+partially compiled parent packages which may provide implementations
+of holes for packages they include.
+
+\subsection{Compiling implementations}
+
+We compile modules in the same way we do today, but with some extra
+package visibility $flags$, which let GHC know how to resolve imports
+and look up original names.  We'll describe what the new flags are
+and also discuss some subtleties with module lookup.
+
+\paragraph{In-place registration}  Perhaps surprisingly, we start
+compilation by registering the (uncompiled) package in the in-place
+package database.  This registration does not expose packages, and is
+purely intended to inform the compilation of subpackages where to
+find modules that are provided by the parent (in-progress) package,
+as well as provide auxiliary information, e.g., such as the package name
+and version for error reporting.  The pre-registration trick is an old
+one used by the GHC build system; the key invariant to look out for
+is that we shouldn't reference original names in modules that haven't
+been built yet.  This is enforced by our manual tracking of holes in
+$H$: a module can't occur in $H$ unless it's already been compiled!
+
+\paragraph{New package resolution algorithm}  Currently, invocations
+of \texttt{-package} and similar flags have the result of \emph{hiding}
+other exposed packages with the same name.  However, this is not going
+to work for Backpack: an indefinite package may get loaded multiple times
+with different instantiations, and it might even make sense to load multiple
+versions of the same package simultaneously, as long as their modules
+are renamed to not conflict.
+
+Thus, we impose the following behavior change: when
+\texttt{-hide-all-packages} is specified, we do \emph{not} automatically
+hide packages with the same name as a package specified by
+\texttt{-package} (or a similar flag): they are all included, even if
+there are conflicts.  To deal with conflicts, we augment the syntax of
+\texttt{-package} to also accept a list of thinnings and renamings, e.g.
+\texttt{-package} \pname{containers} $\langle\m{Data.Set},
+\m{Data.Map}\mapsto \m{Map}\rangle$ says to make visible for import
+\m{Data.Set} and \m{Map} (which is \m{Data.Map} renamed.)  This means
+that
+\texttt{-package} \pname{containers-0.9} $\langle\m{Data.Set}\mapsto
+\m{Set09}\rangle$ \texttt{-package} \pname{containers-0.8}
+$\langle\m{Data.Set}\mapsto \m{Set08}\rangle$ now uses both packages
+concurrently (previously, GHC would hide one of them.)
+
+Additionally, it's important to note that two packages exporting the
+same module do not \emph{necessarily} cause a conflict; the modules
+may be linkable.  For example, \texttt{-package} \pname{containers} $\langle\m{Data.Set}\rangle$
+\texttt{-package} \pname{containers} $\langle\m{Data.Set}\rangle$ is fine, because
+precisely the same implementation of \m{Data.Set} is loaded in both cases.
+A similar situation can occur with signatures:
+
+\begin{verbatim}
+package p where
+    A :: [ x :: Int ]
+package q
+    include p
+    A :: [ y :: Int ]
+    B = [ import A; z = x + y ] -- *
+package r where
+    A = [ x = 0; y = 0 ]
+    include q
+\end{verbatim}
+
+Here, both \pname{p} and \pname{q} are visible when compiling the starred
+module, which compiles with the flags \texttt{-package} \pname{p}, but there
+are two interface files available: one available locally, and one from \pname{p}.
+Both of these interface files are \emph{forwarding} to the original implementation
+\pname{r} (more on this in the ``Compiling signatures'' file), so rather than
+reporting an ambiguous import, we instead have to merge the two interface files
+together and use the result as the interface for the module.  (This could be done
+on the fly, or we could generate merged interface files as we go along.)
+
+Note that we do not need to merge signatures with an implementation, in such
+cases, we should just use the implementation interface.  E.g.
+
+\begin{verbatim}
+package p where
+    A :: ...
+package q where
+    A = ...
+    include p
+    B = [ import A ]    -- *
+\end{verbatim}
+
+Here, \m{A} is available both from \pname{p} and \pname{q}, but the use in the
+starred module should be done with respect to the full implementation.
+
+\paragraph{The \texttt{-alias} flag}  We introduce a new flag
+\texttt{-alias} for aliasing modules.  Aliasing is analogous to
+the merging that can occur when we include packages, but it also applies
+to modules which are locally defined.  When we alias a module $p$ with
+$p'$, we require that $p'$ exists in the current module mapping, and then
+we attempt to add an entry for it at entry $p$.  If there is no mapping for
+$p$, this succeeds; otherwise, we apply the same conflict resolution algorithm.
+
+\subsection{Compiling signatures}
+
+Signature compilation is triggered when we compile a signature file.
+This mode similar to how we process \verb|hs-boot| files, except
+we pass an extra flag \verb|--sig-of| which specifies what the
+identity of the actual implementation of the signature is (according to our $H$
+mapping).  This is guaranteed to exist, due to the linking
+restriction, although it may be in a partially registered package
+in $db$.  If the module is \emph{not} exposed under the name of the
+\texttt{hisig}file, we output an \texttt{hisig} file which, for all declarations the
+signature exposes, forwards their definitions to the original
+implementation file.  The intent is that any code in the current package
+which compiles against this signature will use this \texttt{hisig} file,
+not the original one \texttt{hi} file.
+For example, the \texttt{hisig} file produced when compiling the starred interface
+points to the implementation in package \pname{q}.
+
+\begin{verbatim}
+package p where
+    A :: ...    -- *
+    B = [ import A; ... ]
+package q where
+    A = [ ... ]
+    include p
+\end{verbatim}
+
+\paragraph{Sometimes \texttt{hisig} is unnecessary}
+In the following package:
+
+\begin{verbatim}
+package p where
+    P = ...
+    P :: ...
+\end{verbatim}
+
+Paper Backpack specifies that we check the signature \m{P} against implementation
+\m{P}, but otherwise no changes are made (i.e., the signature does not narrow
+the implementation.) In this case, it is not necessary to generate an \texttt{hisig} file;
+the original interface file suffices.
+
+\paragraph{Multiple signatures}  As a simplification, we assume that there
+is only one signature per logical name in a package.  (This prevents
+us from expressing mutual recursion in signatures, but let's not worry
+about it for now.)
+
+\paragraph{Restricted recursive modules ala hs-boot}\label{sec:hs-boot-restrict}
+When we compile an \texttt{hsig} file without any \texttt{--sig-of} flag (because
+no implementation is known), we fall back to old-style GHC mutual recursion.
+Na\"\i vely, a shaping pass would be necessary;
+so we adopt an existing constraint that
+already applies to hs-boot files: \emph{at the time we define a signature,
+we must know what the original name for all data types is}.  In practice,
+GHC enforces this by stating that: (1) an hs-boot file must be
+accompanied with an implementation, and (2) the implementation must
+in fact define (and not reexport) all of the declarations in the signature.
+We can discover if a signature is intended to break a recursive module loop
+when we discover that $p\notin flags_H$; in this case, we fallback to the
+old hs-boot behavior. (Alternatively, the user can explicitly ask for it.)
+
+Why does this not require a shaping pass? The reason is that the
+signature is not really polymorphic: we require that the $\alpha$ module
+variable be resolved to a concrete module later in the same package, and
+that all the $\beta$ module variables be unified with $\alpha$. Thus, we
+know ahead of time the original names and don't need to deal with any
+renaming.\footnote{This strategy doesn't completely resolve the problem
+of cross-package mutual recursion, because we need to first compile a
+bit of the first package (signatures), then the second package, and then
+the rest of the first package.}
+
+Compiling packages in this way gives the tantalizing possibility
+of true separate compilation: the only thing we don't know is what the actual
+package name of an indefinite package will be, and what the correct references
+to have are.  This is a very minor change to the assembly, so one could conceive
+of dynamically rewriting these references at the linking stage.  But
+separate compilation achieved in this fashion would not be able to take
+advantage of cross-module optimizations.
+
+\subsection{Compiling includes}
+
+Includes are the most interesting part of the compilation process, as we have
+calculate how the holes of the subpackage we are filling in are compiled $H'$
+and modify our flags to make the exports of the include visible to subsequently
+compiled modules.  We consider the case with renaming, since includes with
+no renaming are straightforward.
+
+First, we assume that we know \emph{a priori} what the holes of a
+package $p_H$ are (either by some sort of pre-pass, or explicit
+declaration.)  For each of their \emph{renamed targets} $p'_H$, we look
+up the module in the current $flags$ environment, retrieving the
+physical module identity by consulting GHC with the
+\texttt{--resolve-module} flag and storing it in $H'$.  (This can be done in batch.)
+For example:
+
+\begin{verbatim}
+package p where
+    A :: ...
+    ...
+package q where
+    A = [ ... ]
+    B = [ ... ]
+    include p (A as B)
+\end{verbatim}
+
+When computing the entry $H(\pname{A})$, we run the command \texttt{ghc --resolve-module} \pname{B}.
+
+Next, we recursively call \textsc{Compile} with the computed $H'$.
+Note that the entries in $H$ may refer to modules which would not be
+picked up by $flags$, but they will be registered in the inplace
+package database $db$.
+For example, in this situation:
+
+\begin{verbatim}
+package p where
+    B :: ...
+    C = [ import B; ... ]
+package q where
+    A = [ ... ]
+    B = [ import A; ... ]
+    include p
+    D = [ import C; ... ]
+\end{verbatim}
+
+When we recursively process package \pname{p}, $H$ will refer to
+\pname{q}:\m{B}, and we need to know where to find it (\pname{q} is only
+partially processed and so is in the inplace package database.)
+Furthermore, the interface file for \m{B} may refer to \pname{q}:\m{A},
+and thus we likewise need to know how to find its interface file.
+
+Note that the inplace package database is not expected to expose and
+packages. Otherwise, this example would improperly compile:
+
+\begin{verbatim}
+package p where
+    B = [ import A; ... ]
+package q where
+    A = ...
+    include p
+\end{verbatim}
+
+\pname{p} does not compile on its own, so it should not compile if it is
+recursively invoked from \pname{q}.  However, if we exposed the modules
+of the partially registered package \pname{q}, \m{A} is now suddenly
+resolvable.
+
+Finally, once the subpackage is compiled, we can add it to our $flags$ so later
+modules we compile see its (appropriately thinned and renamed) modules, and like
+aliasing.
+
+\paragraph{Absence of an \texttt{hi} file}
+It is important that \texttt{--resolve-module} truly looks up the \emph{implementor}
+of a module, and not just a signature which is providing it at some name.
+Sometimes, a little extra work is necessary to compute this, for example:
+
+\begin{verbatim}
+package p where
+    A :: [ y :: Int ]
+package q where
+    A :: [ x :: Int ]
+    include p -- *
+package r where
+    A = [ x = 0; y = 1 ]
+    include q
+\end{verbatim}
+
+When computing $H'$ for the starred include, our $flags$ only include
+\texttt{-package-dir} \pname{r} $cwd_r$ $\langle\rangle$: with a thinning
+that excludes all modules!  The only interface file we can pick up with these
+$flags$ is the local definition of \m{A}.  However, we \emph{absolutely}
+should set $H'(\m{A})=\pname{q}:\m{A}$; if we do so, then we will incorrectly
+conclude when compiling the signature in \pname{p} that the implementation
+doesn't export enough identifiers to fulfill the signature (\texttt{y} is not
+available from just the signature in \pname{q}).  Instead, we have to look
+up the original implementor of \m{A} in \pname{r}, and use that in $H'$.
+
+\subsection{Commentary}
+
+\paragraph{Just because it compiled, doesn't mean the individual packages type check}
+The compilation mechanism described is slightly more permissive than vanilla Backpack.
+Here is a simple example:
+
+\begin{verbatim}
+package p where
+    A :: [ data T = T ]
+    B :: [ data T = T ]
+    C = [
+        import A
+        import B
+        x = A.T :: B.T
+    ]
+package q where
+    A = [ data T = T ]
+    B = A
+    include p
+\end{verbatim}
+
+Here, we incorrectly decide \m{A}\verb|.T| and \m{B}\verb|.T| are type
+equal when typechecking \m{C}, because the \verb|hisig| files we
+generate for them all point to the same original implementation.  However,
+\pname{p} should not typecheck.
+
+The problem here is that type checking asks ``does it compile with respect
+to all possible instantiations of the holes'', whereas compilation asks
+``does it compile with respect to this particular instantiation of holes.''
+In the absence of a shaping pass, this problem is unavoidable.
+
+\section{Shaped Backpack}
+
+Despite the simplicity of shapeless Backpack with the linking
+restriction in the absence of holes, we will find that when we have
+holes, it will be very difficult to do type-checking without
+some form of shaping.  This section is very much a work in progress,
+but the ability to typecheck against holes, even with the linking restriction,
+is a very important part of modular separate development, so we will need
+to support it at some point.
+
+\subsection{Efficient shaping}
+
+(These are Edward's opinion, he hasn't convinced other folks that this is
+the right way to do it.)
+
+In this section, I want to argue that, although shaping constitutes
+a pre-pass which must be run before compilation in earnest, it is only
+about as bad as the dependency resolution analysis that GHC already does
+in \verb|ghc -M| or \verb|ghc --make|.
+
+In Paper Backpack, what information does shaping compute? It looks at
+exports, imports, data declarations and value declarations (but not the
+actual expressions associated with these values.)  As a matter of fact,
+GHC already must look at the imports associated with a package in order
+to determine the dependency graph, so that it can have some order to compile
+modules in.  There is a specialized parser which just parses these statements,
+and then ignores the rest of the file.
+
+A bit of background: the \emph{renamer} is responsible for resolving
+imports and figuring out where all of these entities actually come from.
+SPJ would really like to avoid having to run the renamer in order to perform
+a shaping pass.
+
+\paragraph{Is it necessary to run the Renamer to do shaping?}
+Edward and Scott believe the answer is no, well, partially.
+Shaping needs to know the original names of all entities exposed by a
+module/signature. Then it needs to know (a) which entities a module/signature
+defines/declares locally and (b) which entities that module/signature exports.
+The former, (a), can be determined by a straightforward inspection of a parse
+tree of the source file.\footnote{Note that no expression or type parsing
+is necessary. We only need names of local values, data types, and data
+constructors.} The latter, (b), is a bit trickier. Right now it's the Renamer
+that interprets imports and exports into original names, so we would still
+rely on that implementation. However, the Renamer does other, harder things
+that we don't need, so ideally we could factor out the import/export
+resolution from the Renamer for use in shaping.
+
+Unfortunately the Renamer's import resolution analyzes \verb|.hi| files, but for
+local modules, which haven't yet been typechecked, we don't have those.
+Instead, we could use a new file format, \verb|.hsi| files, to store the shape of
+a locally defined module. (Defined packages are bundled with their shapes,
+so included modules have \verb|.hsi| files as well.) (What about the logical
+vs.~physical distinction in file names?) If we refactor the import/export
+resolution code, could we rewrite it to generically operate on both
+\verb|.hi| files and \verb|.hsi| files?
+
+Alternatively, rather than storing shapes on a per-source basis, we could
+store (in memory) the entire package shape. Similarly, included packages
+could have a single shape file for the entire package. Although this approach
+would make shaping non-incremental, since an entire package's shape would
+be recomputed any time a constituent module's shape changes, we do not expect
+shaping to be all that expensive.
+
+\subsection{Typechecking of indefinite modules}\label{sec:typechecking-indefinite}
+
+Recall in our argument in the definite case, where we showed there are
+no holes in the physical context.  With indefinite modules, this is no
+longer true. While (with the linking restriction) these holes will never
+be linked against a physical implementation, they may be linked against
+other signatures.  (Note: while disallowing signature linking would
+solve our problem, it would disallow a wide array of useful instances of
+signature reuse, for example, a package mylib that implements both
+mylib-1x-sig and mylib-2x-sig.)
+
+With holes, we must handle module variables, and we sometimes must unify them:
+
+\begin{verbatim}
+package p where
+    A :: [ data A ]
+package q where
+    A :: [ data A ]
+package r where
+    include p
+    include q
+\end{verbatim}
+
+In this package, it is not possible to a priori assign original names to
+module A in p and q, because in package r, they should have the same
+original name.  When signature linking occurs, unification may occur,
+which means we have to rename all relevant original names. (A similar
+situation occurs when a module is typechecked against a signature.)
+
+An invariant which would be nice to have is this: when typechecking a
+signature or including a package, we may apply renaming to the entities
+being brought into context.  But once we've picked an original name for
+our entities, no further renaming should be necessary. (Formally, in the
+unification for semantic object shapes, apply the unifier to the second
+shape, but not the first one.)
+
+However, there are plenty of counterexamples here:
+
+\begin{verbatim}
+package p where
+    A :: [ data A ]
+    B :: [ data A ]
+    M = ...
+    A = B
+\end{verbatim}
+
+In this package, does module M know that A.A and B.A are type equal?  In
+fact, the shaping pass will have assigned equal module identities to A
+and B, so M \emph{equates these types}, despite the aliasing occurring
+after the fact.
+
+We can make this example more sophisticated, by having a later
+subpackage which causes the aliasing; now, the decision is not even a
+local one (on the other hand, the equality should be evident by inspection
+of the package interface associated with q):
+
+\begin{verbatim}
+package p where
+    A :: [ data A ]
+    B :: [ data A ]
+package q where
+    A :: [ data A ]
+    B = A
+package r where
+    include p
+    include q
+\end{verbatim}
+
+Another possibility is that it might be acceptable to do a mini-shaping
+pass, without parsing modules or signatures, \emph{simply} looking at
+names and aliases.  But logical names are not the only mechanism by
+which unification may occur:
+
+\begin{verbatim}
+package p where
+    C :: [ data A ]
+    A = [ data A = A ]
+    B :: [ import A(A) ]
+    C = B
+\end{verbatim}
+
+It is easy to conclude that the original names of C and B are the same.  But
+more importantly, C.A must be given the original name of p:A.A.  This can only
+be discovered by looking at the signature definition for B. In any case, it
+is worth noting that this situation parallels the situation with hs-boot
+files (although there is no mutual recursion here).
+
+The conclusion is that you will probably, in fact, have to do real
+shaping in order to typecheck all of these examples.
+
+\paragraph{Hey, these signature imports are kind of tricky\ldots}
+
+When signatures and modules are interleaved, the interaction can be
+complex.  Here is an example:
+
+\begin{verbatim}
+package p where
+    C :: [ data A ]
+    M = [ import C; ... ]
+    A = [ import M; data A = A ]
+    C :: [ import A(A) ]
+\end{verbatim}
+
+Here, the second signature for C refers to a module implementation A
+(this is permissible: it simply means that the original name for p:C.A
+is p:A.A).  But wait! A relies on M, and M relies on C. Circularity?
+Fortunately not: a client of package p will find it impossible to have
+the hole C implemented in advance, since they will need to get their hands on module
+A\ldots but it will not be defined prior to package p.
+
+In any case, however, it would be good to emit a warning if a package
+cannot be compiled without mutual recursion.
+
+\subsection{Rename on entry}
+
+Consider the following example:
+
+\begin{verbatim}
+package p where
+    A :: [ data T = T ]
+    B = [ import A; x = T ]
+package q where
+    C :: ...
+    A = [ data T = T ]
+    include p
+    D = [
+        import qualified A
+        import qualified B
+        import C
+        x = B.T :: A.T
+    ]
+\end{verbatim}
+
+We are interested in type-checking \pname{q}, which is an indefinite package
+on account of the uninstantiated hole \m{C}.  Furthermore, let's suppose that
+\pname{p} has already been independently typechecked, and its interface files
+installed in some global location with $\alpha_A$ used as the module identity
+of \m{A}. (To simplify this example, we'll assume $\beta_{AT}=\alpha_A$.)
+
+The first three lines of \pname{q} type check in the normal way, but \m{D}
+now poses a problem: if we load the interface file for \m{B} the normal way,
+we will get a reference to type \texttt{T} with the original name $\alpha_A$.\texttt{T},
+whereas from \m{A} we have an original name \pname{q}:\m{A}.\texttt{T}.
+
+Let's suppose that we already have the result of a shaping pass, which
+maps our identity variables to their true identities.
+Let's consider the possible options here:
+
+\begin{itemize}
+    \item We could re-typecheck \pname{p}, feeding it the correct instantiations
+        for its variables.  However, this seems wasteful: we typechecked the
+        package already, and up-to-renaming, the interface files are exactly
+        what we need to type check our application.
+    \item We could make copies of all the interface files, renamed to have the
+        right original names.  This also seems wasteful: why should we have to
+        create a new copy of every interface file in a library we depend on?
+    \item When \emph{reading in} the interface file to GHC, we could apply the
+        renaming according to the shaping pass and store that in memory.
+\end{itemize}
+
+That last solution is pretty appealing, however, there are still circumstances
+we need to create new interface files; these exactly mirror the cases described
+in Section~\ref{sec:compiling}.
+
+\subsection{Incremental typechecking}
+We want to typecheck modules incrementally, i.e., when something changes in
+a package, we only want to re-typecheck the modules that care about that
+change. GHC already does this today.%
+\footnote{\url{https://ghc.haskell.org/trac/ghc/wiki/Commentary/Compiler/RecompilationAvoidance}}
+Is the same mechanism sufficient for Backpack? Edward and Scott think that it
+is, mostly. Our conjecture is that a module should be re-typechecked if the
+existing mechanism says it should \emph{or} if the logical shape
+context (which maps logical names to physical names) has changed. The latter
+condition is due to aliases that affect typechecking of modules.
+
+Let's look again at an example from before:
+\begin{verbatim}
+package p where
+    A :: [ data A ]
+    B :: [ data A ]
+    M = [ import A; import B; ... ]
+\end{verbatim}
+Let's say that \verb|M| is typechecked successfully. Now we add an alias binding
+at the end of the package, \verb|A = B|. Does \verb|M| need to be
+re-typechecked? Yes! (Well, it seems so, but let's just assert ``yes'' for now.
+Certainly in the reverse case---if we remove the alias and then ask---this
+is true, since \verb|M| might have depended on the two \verb|A| types
+being the same.)
+The logical shape context changed to say that \verb|A| and
+\verb|B| now map to the same physical module identity. But does the existing
+recompilation avoidance mechanism say that \verb|M| should be re-typechecked?
+It's unclear. The \verb|.hi| file for \verb|M| records that it imported \verb|A| and
+\verb|B| with particular ABIs, but does it also know about the physical module
+identities (or rather, original module names) of these modules?
+
+Scott thinks this highlights the need for us to get our story straight about
+the connection between logical names, physical module identities, and file
+names!
+
+
+\subsection{Installing indefinite packages}\label{sec:installing-indefinite}
+
+If an indefinite package contains no code at all, we only need
+to install the interface file for the signatures.  However, if
+they include code, we must provide all of the
+ingredients necessary to compile them when the holes are linked against
+actual implementations.  (Figure~\ref{fig:pkgdb})
+
+\paragraph{Source tarball or preprocessed source?}  What is the representation of the source that is saved is.  There
+are a number of possible choices:
+
+\begin{itemize}
+    \item The original tarballs downloaded from Hackage,
+    \item Preprocessed source files,
+    \item Some sort of internal, type-checked representation of Haskell code (maybe the output of the desugarer).
+\end{itemize}
+
+Storing the tarballs is the simplest and most straightforward mechanism,
+but we will have to be very certain that we can recompile the module
+later in precisely the same we compiled it originally, to ensure the hi
+files match up (fortunately, it should be simple to perform an optional
+sanity check before proceeding.) The appeal of saving preprocessed
+source, or even the IRs, is that this is conceptually this is exactly
+what an indefinite package is: we have paused the compilation process
+partway, intending to finish it later.  However, our compilation strategy
+for definite packages requires us to run this step using a \emph{different}
+choice of original names, so it's unclear how much work could actually be reused.
+
+\section{Surface syntax}
+
+In the Backpack paper, a brand new module language is presented, with
+syntax for inline modules and signatures.  This syntax is probably worth implementing,
+because it makes it easy to specify compatibility packages, whose module
+definitions in general may be very short:
+
+\begin{verbatim}
+package ishake-0.12-shake-0.13 where
+    include shake-0.13
+    Development.Shake.Sys = Development.Shake.Cmd
+    Development.Shake = [ (**>) = (&>) ; (*>>) = (|*>)]
+    Development.Shake.Rule = [ defaultPriority = rule . priority 0.5 ]
+    include ishake-0.12
+\end{verbatim}
+
+However, there are a few things that are less than ideal about the
+surface syntax proposed by Paper Backpack:
+
+\begin{itemize}
+    \item It's completely different from the current method users
+        specify packages. There's nothing wrong with this per se
+        (one simply needs to support both formats) but the smaller
+        the delta, the easier the new packaging format is to explain
+        and implement.
+
+    \item Sometimes order matters (relative ordering of signatures and
+        module implementations), and other times it does not (aliases).
+        This can be confusing for users.
+
+    \item Users have to order module definitions topologically,
+        whereas in current Cabal modules can be listed in any order, and
+        GHC figures out an appropriate order to compile them.
+\end{itemize}
+
+Here is an alternative proposal, closely based on Cabal syntax.  Given
+the following Backpack definition:
+
+\begin{verbatim}
+package libfoo(A, B, C, Foo) where
+    include base
+    -- renaming and thinning
+    include libfoo (Foo, Bar as Baz)
+    -- holes
+    A :: [ a :: Bool ].hsig
+    A2 :: [ b :: Bool ].hsig
+    -- normal module
+    B = [
+        import {-# SOURCE #-} A
+        import Foo
+        import Baz
+        ...
+    ].hs
+    -- recursively linked pair of modules, one is private
+    C :: [ data C ].hsig
+    D = [ import {-# SOURCE #-} C; data D = D C ].hs
+    C = [ import D; data C = C D ].hs
+    -- alias
+    A = A2
+\end{verbatim}
+
+We can write the following Cabal-like syntax instead (where
+all of the signatures and modules are placed in appropriately
+named files):
+
+\begin{verbatim}
+package: libfoo
+...
+build-depends: base, libfoo (Foo, Bar as Baz)
+holes: A A2 -- deferred for now
+exposed-modules: Foo B C
+aliases: A = A2
+other-modules: D
+\end{verbatim}
+
+Notably, all of these lists are \emph{insensitive} to ordering!
+The key idea is use of the \verb|{-# SOURCE #-}| pragma, which
+is enough to solve the important ordering constraint between
+signatures and modules.
+
+Here is how the elaboration works.  For simplicity, in this algorithm
+description, we assume all packages being compiled have no holes
+(including \verb|build-depends| packages). Later, we'll discuss how to
+extend the algorithm to handle holes in both subpackages and the main
+package itself.
+
+\begin{enumerate}
+
+    \item At the top-level with \verb|package| $p$ and
+        \verb|exposed-modules| $ms$, record \verb|package p (ms) where|
+
+    \item For each package $p$ with thinning/renaming $ms$ in
+        \verb|build-depends|, record a \verb|include p (ms)| in the
+        Backpack package.  The ordering of these includes does not
+        matter, since none of these packages have holes.
+
+    \item Take all modules $m$ in \verb|other-modules| and
+        \verb|exposed-modules| which were not exported by build
+        dependencies, and create a directed graph where hs and hs-boot
+        files are nodes and imports are edges (the target of an edge is
+        an hs file if it is a normal import, and an hs-boot file if it
+        is a SOURCE import).  Topologically sort this graph, erroring if
+        this graph contains cycles (even with recursive modules, the
+        cycle should have been broken by an hs-boot file).  For each
+        node, in this order, record \verb|M = [ ... ]| or \verb|M :: [ ... ]|
+        depending on whether or not it is an hs or hs-boot.  If possible,
+        sort signatures before implementations when there is no constraint
+        otherwise.
+
+\end{enumerate}
+
+Here is a simple example which shows how SOURCE can be used to disambiguate
+between two important cases. Suppose we have these modules:
+
+\begin{verbatim}
+-- A1.hs
+import {-# SOURCE #-} B
+
+-- A2.hs
+import B
+
+-- B.hs
+x = True
+
+-- B.hs-boot
+x :: Bool
+\end{verbatim}
+
+Then we translate the following packages as follows:
+
+\begin{verbatim}
+exposed-modules: A1 B
+-- translates to
+B :: [ x :: Bool ]
+A1 = [ import B ]
+B = [ x = True ]
+\end{verbatim}
+
+but
+
+\begin{verbatim}
+exposed-modules: A2 B
+-- translates to
+B = [ x = True ]
+B :: [ x :: Bool ]
+A2 = [ import B ]
+\end{verbatim}
+
+The import controls placement between signature and module, and in A1 it
+forces B's signature to be sorted before B's implementation (whereas in
+the second section, there is no constraint so we preferentially place
+the B's implementation first)
+
+\paragraph{Holes in the database} In the presence of holes,
+\verb|build-depends| resolution becomes more complicated.  First,
+let's consider the case where the package we are building is
+definite, but the package database contains indefinite packages with holes.
+In order to maintain the linking restriction, we now have to order packages
+from step (2) of the previous elaboration.  We can do this by creating
+a directed graph, where nodes are packages and edges are from holes to the
+package which implements them.  If there is a cycle, this indicates a mutually
+recursive package.  In the absence of cycles, a topological sorting of this
+graph preserves the linking invariant.
+
+One subtlety to consider is the fact that an entry in \verb|build-depends|
+can affect how a hole is instantiated by another entry.  This might be a
+bit weird to users, who might like to explicitly say how holes are
+filled when instantiating a package.  Food for thought, surface syntax wise.
+
+\paragraph{Holes in the package} Actually, this is quite simple: the
+ordering of includes goes as before, but some indefinite packages in the
+database are less constrained as they're ``dependencies'' are fulfilled
+by the holes at the top-level of this package.  It's also worth noting
+that some dependencies will go unresolved, since the following package
+is valid:
+
+\begin{verbatim}
+package a where
+    A :: ...
+package b where
+    include a
+\end{verbatim}
+
+\paragraph{Multiple signatures}  In Backpack syntax, it's possible to
+define a signature multiple times, which is necessary for mutually
+recursive signatures:
+
+\begin{verbatim}
+package a where
+    A :: [ data A ]
+    B :: [ import A; data B = B A ]
+    A :: [ import B; data A = A B ]
+\end{verbatim}
+
+Critically, notice that we can see the constructors for both module B and A
+after the signatures are linked together.  This is not possible in GHC
+today, but could be possible by permitting multiple hs-boot files.  Now
+the SOURCE pragma indicating an import must \emph{disambiguate} which
+hs-boot file it intends to include.  This might be one way of doing it:
+
+\begin{verbatim}
+-- A.hs-boot2
+data A
+
+-- B.hs-boot
+import {-# SOURCE hs-boot2 #-} A
+
+-- A.hs-boot
+import {-# SOURCE hs-boot #-} B
+\end{verbatim}
+
+\paragraph{Explicit or implicit reexports}  One annoying property of
+this proposal is that, looking at the \verb|exposed-modules| list, it is
+not immediately clear what source files one would expect to find in the
+current package.  It's not obvious what the proper way to go about doing
+this is.
+
+\paragraph{Better syntax for SOURCE}  If we enshrine the SOURCE import
+as a way of solving Backpack ordering problems, it would be nice to have
+some better syntax for it. One possibility is:
+
+\begin{verbatim}
+abstract import Data.Foo
+\end{verbatim}
+
+which makes it clear that this module is pluggable, typechecking against
+a signature.  Note that this only indicates how type checking should be
+done: when actually compiling the module we will compile against the
+interface file for the true implementation of the module.
+
+It's worth noting that the SOURCE annotation was originally made a
+pragma because, in principle, it should have been possible to compile
+some recursive modules without needing the hs-boot file at all. But if
+we're moving towards boot files as signatures, this concern is less
+relevant.
+
+\section{Type classes and type families}
+
+\subsection{Background}
+
+Before we talk about how to support type classes in Backpack, it's first
+worth talking about what we are trying to achieve in the design.  Most
+would agree that \emph{type safety} is the cardinal law that should be
+preserved (in the sense that segfaults should not be possible), but
+there are many instances of ``bad behavior'' (top level mutable state,
+weakening of abstraction guarantees, ambiguous instance resolution, etc)
+which various Haskellers may disagree on the necessity of ruling out.
+
+With this in mind, it is worth summarizing what kind of guarantees are
+presently given by GHC with regards to type classes and type families,
+as well as characterizing the \emph{cultural} expectations of the
+Haskell community.
+
+\paragraph{Type classes}  When discussing type class systems, there are
+several properties that one may talk about.
+A set of instances is \emph{confluent} if, no matter what order
+constraint solving is performed, GHC will terminate with a canonical set
+of constraints that must be satisfied for any given use of a type class.
+In other words, confluence says that we won't conclude that a program
+doesn't type check just because we swapped in a different constraint
+solving algorithm.
+
+Confluence's closely related twin is \emph{coherence} (defined in ``Type
+classes: exploring the design space''). This property states that
+``every different valid typing derivation of a program leads to a
+resulting program that has the same dynamic semantics.''  Why could
+differing typing derivations result in different dynamic semantics?  The
+answer is that context reduction, which picks out type class instances,
+elaborates into concrete choices of dictionaries in the generated code.
+Confluence is a prerequisite for coherence, since one
+can hardly talk about the dynamic semantics of a program that doesn't
+type check.
+
+In the vernacular, confluence and coherence are often incorrectly used
+to refer to another related property: \emph{global uniqueness of instances},
+which states that in a fully compiled program, for any type, there is at most one
+instance resolution for a given type class.  Languages with local type
+class instances such as Scala generally do not have this property, and
+this assumption is frequently used for abstraction.
+
+So, what properties does GHC enforce, in practice?
+In the absence of any type system extensions, GHC's employs a set of
+rules (described in ``Exploring the design space'') to ensure that type
+class resolution is confluent and coherent.  Intuitively, it achieves
+this by having a very simple constraint solving algorithm (generate
+wanted constraints and solve wanted constraints) and then requiring the
+set of instances to be \emph{nonoverlapping}, ensuring there is only
+ever one way to solve a wanted constraint.  Overlap is a
+more stringent restriction than either confluence or coherence, and
+via the \verb|OverlappingInstances| and \verb|IncoherentInstances|, GHC
+allows a user to relax this restriction ``if they know what they're doing.''
+
+Surprisingly, however, GHC does \emph{not} enforce global uniqueness of
+instances.  Imported instances are not checked for overlap until we
+attempt to use them for instance resolution.  Consider the following program:
+
+\begin{verbatim}
+-- T.hs
+data T = T
+-- A.hs
+import T
+instance Eq T where
+-- B.hs
+import T
+instance Eq T where
+-- C.hs
+import A
+import B
+\end{verbatim}
+
+When compiled with one-shot compilation, \verb|C| will not report
+overlapping instances unless we actually attempt to use the \verb|Eq|
+instance in C.\footnote{When using batch compilation, GHC reuses the
+    instance database and is actually able to detect the duplicated
+    instance when compiling B.  But if you run it again, recompilation
+avoidance skips A, and it finishes compiling!  See this bug:
+\url{https://ghc.haskell.org/trac/ghc/ticket/5316}}  This is by
+design\footnote{\url{https://ghc.haskell.org/trac/ghc/ticket/2356}}:
+ensuring that there are no overlapping instances eagerly requires
+eagerly reading all the interface files a module may depend on.
+
+We might summarize these three properties in the following manner.
+Culturally, the Haskell community expects \emph{global uniqueness of instances}
+to hold: the implicit global database of instances should be
+confluent and coherent.  GHC, however, does not enforce uniqueness of
+instances: instead, it merely guarantees that the \emph{subset} of the
+instance database it uses when it compiles any given module is confluent and coherent.  GHC does do some
+tests when an instance is declared to see if it would result in overlap
+with visible instances, but the check is by no means
+perfect\footnote{\url{https://ghc.haskell.org/trac/ghc/ticket/9288}};
+truly, \emph{type-class constraint resolution} has the final word.  One
+mitigating factor is that in the absence of \emph{orphan instances}, GHC is
+guaranteed to eagerly notice when the instance database has overlap.\footnote{Assuming that the instance declaration checks actually worked\ldots}
+
+Clearly, the fact that GHC's lazy behavior is surprising to most
+Haskellers means that the lazy check is mostly good enough: a user
+is likely to discover overlapping instances one way or another.
+However, it is relatively simple to construct example programs which
+violate global uniqueness of instances in an observable way:
+
+\begin{verbatim}
+-- A.hs
+module A where
+data U = X | Y deriving (Eq, Show)
+
+-- B.hs
+module B where
+import Data.Set
+import A
+
+instance Ord U where
+compare X X = EQ
+compare X Y = LT
+compare Y X = GT
+compare Y Y = EQ
+
+ins :: U -> Set U -> Set U
+ins = insert
+
+-- C.hs
+module C where
+import Data.Set
+import A
+
+instance Ord U where
+compare X X = EQ
+compare X Y = GT
+compare Y X = LT
+compare Y Y = EQ
+
+ins' :: U -> Set U -> Set U
+ins' = insert
+
+-- D.hs
+module Main where
+import Data.Set
+import A
+import B
+import C
+
+test :: Set U
+test = ins' X $ ins X $ ins Y $ empty
+
+main :: IO ()
+main = print test
+
+-- OUTPUT
+$ ghc -Wall -XSafe -fforce-recomp --make D.hs
+[1 of 4] Compiling A ( A.hs, A.o )
+[2 of 4] Compiling B ( B.hs, B.o )
+
+B.hs:5:10: Warning: Orphan instance: instance [safe] Ord U
+[3 of 4] Compiling C ( C.hs, C.o )
+
+C.hs:5:10: Warning: Orphan instance: instance [safe] Ord U
+[4 of 4] Compiling Main ( D.hs, D.o )
+Linking D ...
+$ ./D
+fromList [X,Y,X]
+\end{verbatim}
+
+Locally, all type class resolution was coherent: in the subset of
+instances each module had visible, type class resolution could be done
+unambiguously.  Furthermore, the types of \verb|ins| and \verb|ins'|
+discharge type class resolution, so that in \verb|D| when the database
+is now overlapping, no resolution occurs, so the error is never found.
+
+It is easy to dismiss this example as an implementation wart in GHC, and
+continue pretending that global uniqueness of instances holds.  However,
+the problem with \emph{global uniqueness of instances} is that they are
+inherently nonmodular: you might find yourself unable to compose two
+components because they accidentally defined the same type class
+instance, even though these instances are plumbed deep in the
+implementation details of the components.
+
+As it turns out, there is already another feature in Haskell which
+must enforce global uniqueness, to prevent segfaults.
+We now turn to type classes' close cousin: type families.
+
+\paragraph{Type families}  With type families, confluence is the primary
+property of interest.  (Coherence is not of much interest because type
+families are elaborated into coercions, which don't have any
+computational content.)  Rather than considering what the set of
+constraints we reduce to, confluence for type families considers the
+reduction of type families.  The overlap checks for type families
+can be quite sophisticated, especially in the case of closed type
+families.
+
+Unlike type classes, however, GHC \emph{does} check the non-overlap
+of type families eagerly.  The analogous program does \emph{not} type check:
+
+\begin{verbatim}
+-- F.hs
+type family F a :: *
+-- A.hs
+import F
+type instance F Bool = Int
+-- B.hs
+import F
+type instance F Bool = Bool
+-- C.hs
+import A
+import B
+\end{verbatim}
+
+The reason is that it is \emph{unsound} to ever allow any overlap
+(unlike in the case of type classes where it just leads to incoherence.)
+Thus, whereas one might imagine dropping the global uniqueness of instances
+invariant for type classes, it is absolutely necessary to perform global
+enforcement here.  There's no way around it!
+
+\subsection{Local type classes}
+
+Here, we say \textbf{NO} to global uniqueness.
+
+This design is perhaps best discussed in relation to modular type
+classes, which shares many similar properties.  Instances are now
+treated as first class objects (in MTCs, they are simply modules)---we
+may explicitly hide or include instances for type class resolution (in
+MTCs, this is done via the \verb|using| top-level declaration).  This is
+essentially what was sketched in Section 5 of the original Backpack
+paper.  As a simple example:
+
+\begin{verbatim}
+package p where
+    A :: [ data T = T ]
+    B = [ import A; instance Eq T where ... ]
+
+package q where
+    A = [ data T = T; instance Eq T where ... ]
+    include p
+\end{verbatim}
+
+Here, \verb|B| does not see the extra instance declared by \verb|A|,
+because it was thinned from its signature of \verb|A| (and thus never
+declared canonical.)  To declare an instance without making it
+canonical, it must placed in a separate (unimported) module.
+
+Like modular type classes, Backpack does not give rise to incoherence,
+because instance visibility can only be changed at the top level module
+language, where it is already considered best practice to provide
+explicit signatures.  Here is the example used in the Modular Type
+Classes paper to demonstrate the problem:
+
+\begin{verbatim}
+structure A = using EqInt1 in
+    struct ...fun f x = eq(x,x)... end
+structure B = using EqInt2 in
+    struct ...val y = A.f(3)... end
+\end{verbatim}
+
+Is the type of f \verb|int -> bool|, or does it have a type-class
+constraint?  Because type checking proceeds over the entire program, ML
+could hypothetically pick either.  However, ported to Haskell, the
+example looks like this:
+
+\begin{verbatim}
+EqInt1 :: [ instance Eq Int ]
+EqInt2 :: [ instance Eq Int ]
+A = [
+    import EqInt1
+    f x = x == x
+]
+B = [
+    import EqInt2
+    import A hiding (instance Eq Int)
+    y = f 3
+]
+\end{verbatim}
+
+There may be ambiguity, yes, but it can be easily resolved by the
+addition of a top-level type signature to \verb|f|, which is considered
+best-practice anyway.  Additionally, Haskell users are trained to expect
+a particular inference for \verb|f| in any case (the polymorphic one).
+
+Here is another example which might be considered surprising:
+
+\begin{verbatim}
+package p where
+    A :: [ data T = T ]
+    B :: [ data T = T ]
+    C = [
+        import qualified A
+        import qualified B
+        instance Show A.T where show T = "A"
+        instance Show B.T where show T = "B"
+        x :: String
+        x = show A.T ++ show B.T
+    ]
+\end{verbatim}
+
+In the original Backpack paper, it was implied that module \verb|C|
+should not type check if \verb|A.T = B.T| (failing at link time).
+However, if we set aside, for a moment, the issue that anyone who
+imports \verb|C| in such a context will now have overlapping instances,
+there is no reason in principle why the module itself should be
+problematic.  Here is the example in MTCs, which I have good word from
+Derek does type check.
+
+\begin{verbatim}
+signature SIG = sig
+    type t
+    val mk : t
+end
+signature SHOW = sig
+    type t
+    val show : t -> string
+end
+functor Example (A : SIG) (B : SIG) =
+    let structure ShowA : SHOW = struct
+        type t = A.t
+        fun show _ = "A"
+    end in
+    let structure ShowB : SHOW = struct
+        type t = B.t
+        fun show _ = "B"
+    end in
+    using ShowA, ShowB in
+    struct
+        val x = show A.mk ++ show B.mk
+    end : sig val x : string end
+\end{verbatim}
+
+The moral of the story is, even though in a later context the instances
+are overlapping, inside the functor, the type-class resolution is unambiguous
+and should be done (so \verb|x = "AB"|).
+
+Up until this point, we've argued why MTCs and this Backpack design are similar.
+However, there is an important sociological difference between modular type-classes
+and this proposed scheme for Backpack.  In the presentation ``Why Applicative
+Functors Matter'', Derek mentions the canonical example of defining a set:
+
+\begin{verbatim}
+signature ORD = sig type t; val cmp : t -> t -> bool end
+signature SET = sig type t; type elem;
+    val empty : t;
+    val insert : elem -> t -> t ...
+end
+functor MkSet (X : ORD) :> SET where type elem = X.t
+  = struct ... end
+\end{verbatim}
+
+This is actually very different from how sets tend to be defined in
+Haskell today.  If we directly encoded this in Backpack, it would
+look like this:
+
+\begin{verbatim}
+package mk-set where
+    X :: [
+        data T
+        cmp :: T -> T-> Bool
+    ]
+    Set :: [
+        data Set
+        empty :: Set
+        insert :: T -> Set -> Set
+    ]
+    Set = [
+        import X
+        ...
+    ]
+\end{verbatim}
+
+It's also informative to consider how MTCs would encode set as it is written
+today in Haskell:
+
+\begin{verbatim}
+signature ORD = sig type t; val cmp : t -> t -> bool end
+signature SET = sig type 'a t;
+    val empty : 'a t;
+    val insert : (X : ORD) => X.t -> X.t t -> X.t t
+end
+struct MkSet :> SET = struct ... end
+\end{verbatim}
+
+Here, it is clear to see that while functor instantiation occurs for
+implementation, it is not occuring for types.  This is a big limitation
+with the Haskell approach, and it explains why Haskellers, in practice,
+find global uniqueness of instances so desirable.
+
+Implementation-wise, this requires some subtle modifications to how we
+do type class resolution.  Type checking of indefinite modules works as
+before, but when go to actually compile them against explicit
+implementations, we need to ``forget'' that two types are equal when
+doing instance resolution.  This could probably be implemented by
+associating type class instances with the original name that was
+utilized when typechecking, so that we can resolve ambiguous matches
+against types which have the same original name now that we are
+compiling.
+
+As we've mentioned previously, this strategy is unsound for type families.
+
+\subsection{Globally unique}
+
+Here, we say \textbf{YES} to global uniqueness.
+
+When we require the global uniqueness of instances (either because
+that's the type class design we chose, or because we're considering
+the problem of type families), we will need to reject declarations like the
+one cited above when \verb|A.T = B.T|:
+
+\begin{verbatim}
+A :: [ data T ]
+B :: [ data T ]
+C :: [
+    import qualified A
+    import qualified B
+    instance Show A.T where show T = "A"
+    instance Show B.T where show T = "B"
+]
+\end{verbatim}
+
+The paper mentions that a link-time check is sufficient to prevent this
+case from arising.  While in the previous section, we've argued why this
+is actually unnecessary when local instances are allowed, the link-time
+check is a good match in the case of global instances, because any
+instance \emph{must} be declared in the signature.  The scheme proceeds
+as follows: when some instances are typechecked initially, we type check
+them as if all of variable module identities were distinct.  Then, when
+we perform linking (we \verb|include| or we unify some module
+identities), we check again if to see if we've discovered some instance
+overlap.  This linking check is akin to the eager check that is
+performed today for type families; it would need to be implemented for
+type classes as well: however, there is a twist: we are \emph{redoing}
+the overlap check now that some identities have been unified.
+
+As an implementation trick, one could deferring the check until \verb|C|
+is compiled, keeping in line with GHC's lazy ``don't check for overlap
+until the use site.''  (Once again, unsound for type families.)
+
+\paragraph{What about module inequalities?}  An older proposal was for
+signatures to contain ``module inequalities'', i.e., assertions that two
+modules are not equal.  (Technically: we need to be able to apply this
+assertion to $\beta$ module variables, since \verb|A != B| while
+\verb|A.T = B.T|).  Currently, Edward thinks that module inequalities
+are only marginal utility with local instances (i.e., not enough to
+justify the implementation cost) and not useful at all in the world of
+global instances!
+
+With local instances, module inequalities could be useful to statically
+rule out examples like \verb|show A.T ++ show B.T|.  Because such uses
+are not necessarily reflected in the signature, it would be a violation
+of separate module development to try to divine the constraint from the
+implementation itself.  I claim this is of limited utility, however, because,
+as we mentioned earlier, we can compile these ``incoherent'' modules perfectly
+coherently.  With global instances, all instances must be in the signature, so
+while it might be aesthetically displeasing to have the signature impose
+extra restrictions on linking identities, we can carry this out without
+violating the linking restriction.
+
+\section{Bits and bobs}
+
+\subsection{Abstract type synonyms}
+
+In Paper Backpack, abstract type synonyms are not permitted, because GHC doesn't
+understand how to deal with them.  The purpose of this section is to describe
+one particularly nastiness of abstract type synonyms, by way of the occurs check:
+
+\begin{verbatim}
+A :: [ type T ]
+B :: [ import qualified A; type T = [A.T] ]
+\end{verbatim}
+
+At this point, it is illegal for \verb|A = B|, otherwise this type synonym would
+fail the occurs check.  This seems like pretty bad news, since every instance
+of the occurs check in the type-checker could constitute a module inequality.
+
+\section{Open questions}\label{sec:open-questions}
+
+Here are open problems about the implementation which still require
+hashing out.
+
+\begin{itemize}
+
+    \item In Section~\ref{sec:simplifying-backpack}, we argued that we
+        could implement Backpack without needing a shaping pass. We're
+        pretty certain that this will work for typechecking and
+        compiling fully definite packages with no recursive linking, but
+        in Section~\ref{sec:typechecking-indefinite}, we described some
+        of the prevailing difficulties of supporting signature linking.
+        Renaming is not an insurmountable problem, but backwards flow of
+        shaping information can be, and it is unclear how best to
+        accommodate this.  This is probably the most important problem
+        to overcome.
+
+    \item In Section~\ref{sec:installing-indefinite}, a few choices for how to
+        store source code were pitched, however, there is not consensus on which
+        one is best.
+
+    \item What is the impact of the multiplicity of PackageIds on
+        dependency solving in Cabal?  Old questions of what to prefer
+        when multiple package-versions are available (Cabal originally
+        only needed to solve this between different versions of the same
+        package, preferring the oldest version), but with signatures,
+        there are more choices.  Should there be a complex solver that
+        does all signature solving, or a preprocessing step that puts
+        things back into the original Cabal version.  Authors may want
+        to suggest policy for what packages should actually link against
+        signatures (so a crypto library doesn't accidentally link
+        against a null cipher package).
+
+\end{itemize}
+
+\end{document}
diff --git a/docs/backpack/commands-new-new.tex b/docs/backpack/commands-new-new.tex
new file mode 100644
index 000000000000..1f2466e14cb7
--- /dev/null
+++ b/docs/backpack/commands-new-new.tex
@@ -0,0 +1,891 @@
+%!TEX root = paper/paper.tex
+\usepackage{amsmath}
+\usepackage{amssymb}
+\usepackage{amsthm}
+\usepackage{xspace}
+\usepackage{color}
+\usepackage{xifthen}
+\usepackage{graphicx}
+\usepackage{amsbsy}
+\usepackage{mathtools}
+\usepackage{stmaryrd}
+\usepackage{url}
+\usepackage{alltt}
+\usepackage{varwidth}
+% \usepackage{hyperref}
+\usepackage{datetime}
+\usepackage{subfig}
+\usepackage{array}
+\usepackage{multirow}
+\usepackage{xargs}
+\usepackage{marvosym} % for MVAt
+\usepackage{bm} % for blackboard bold semicolon
+
+
+%% HYPERREF COLORS
+\definecolor{darkred}{rgb}{.7,0,0}
+\definecolor{darkgreen}{rgb}{0,.5,0}
+\definecolor{darkblue}{rgb}{0,0,.5}
+% \hypersetup{
+%   linktoc=page,
+%   colorlinks=true,
+%   linkcolor=darkred,
+%   citecolor=darkgreen,
+%   urlcolor=darkblue,
+% }
+
+% Coloring
+\definecolor{hilite}{rgb}{0.7,0,0}
+\newcommand{\hilite}[1]{\color{hilite}#1\color{black}}
+\definecolor{shade}{rgb}{0.85,0.85,0.85}
+\newcommand{\shade}[1]{\colorbox{shade}{\!\ensuremath{#1}\!}}
+
+% Misc
+\newcommand\evalto{\hookrightarrow}
+\newcommand\elabto{\rightsquigarrow}
+\newcommand\elabtox[1]{\stackrel{#1}\rightsquigarrow}
+\newcommand{\yields}{\uparrow}
+\newcommand\too{\Rightarrow}
+\newcommand{\nil}{\cdot}
+\newcommand{\eps}{\epsilon}
+\newcommand{\Ups}{\Upsilon}
+\newcommand{\avoids}{\mathrel{\#}}
+
+\renewcommand{\vec}[1]{\overline{#1}}
+\newcommand{\rname}[1]{\textsc{#1}}
+\newcommand{\infrule}[3][]{%
+  \vspace{0.5ex}
+  \frac{\begin{array}{@{}c@{}}#2\end{array}}%
+       {\mbox{\ensuremath{#3}}}%
+  \ifthenelse{\isempty{#1}}%
+             {}%
+             % {\hspace{1ex}\rlap{(\rname{#1})}}%
+             {\hspace{1ex}(\rname{#1})}%
+  \vspace{0.5ex}
+}
+\newcommand{\infax}[2][]{\infrule[#1]{}{#2}}
+\newcommand{\andalso}{\hspace{.5cm}}
+\newcommand{\suchthat}{~\mathrm{s.t.}~}
+\newenvironment{notes}%
+  {\vspace{-1.5em}\begin{itemize}\setlength\itemsep{0pt}\small}%
+  {\end{itemize}}
+\newcommand{\macrodef}{\mathbin{\overset{\mathrm{def}}{=}}}
+\newcommand{\macroiff}{\mathbin{\overset{\mathrm{def}}{\Leftrightarrow}}}
+
+
+\newcommand{\ttt}[1]{\text{\tt #1}}
+\newcommand{\ttul}{\texttt{\char 95}}
+\newcommand{\ttcc}{\texttt{:\!:}}
+\newcommand{\ttlb}{{\tt {\char '173}}}
+\newcommand{\ttrb}{{\tt {\char '175}}}
+\newcommand{\tsf}[1]{\textsf{#1}}
+
+% \newcommand{\secref}[1]{\S\ref{sec:#1}}
+% \newcommand{\figref}[1]{Figure~\ref{fig:#1}}
+\newcommand{\marginnote}[1]{\marginpar[$\ast$ {\small #1} $\ast$]%
+                                      {$\ast$ {\small #1} $\ast$}}
+\newcommand{\hschange}{\marginnote{!Haskell}}
+\newcommand{\TODO}{\emph{TODO}\marginnote{TODO}}
+\newcommand{\parheader}[1]{\textbf{#1}\quad}
+
+\newcommand{\file}{\ensuremath{\mathit{file}}}
+\newcommand{\mapnil}{~\mathord{\not\mapsto}}
+
+\newcommand{\Ckey}[1]{\textbf{\textsf{#1}}}
+\newcommand{\Cent}[1]{\texttt{#1}}
+% \newcommand{\Cmod}[1]{\texttt{[#1]}}
+% \newcommand{\Csig}[1]{\texttt{[\ttcc{}#1]}}
+\newcommand{\Cmod}[1]{=\texttt{[#1]}}
+\newcommand{\Csig}[1]{~\ttcc{}~\texttt{[#1]}}
+\newcommand{\Cpath}[1]{\ensuremath{\mathsf{#1}}}
+\newcommand{\Cvar}[1]{\ensuremath{\mathsf{#1}}}
+\newcommand{\Ccb}[1]{\text{\ttlb} {#1} \text{\ttrb}}
+\newcommand{\Cpkg}[1]{\texttt{#1}}
+\newcommand{\Cmv}[1]{\ensuremath{\langle #1 \rangle}}
+\newcommand{\Cto}[2]{#1 \mapsto #2}
+\newcommand{\Ctoo}[2]{\Cpath{#1} \mapsto \Cpath{#2}}
+\newcommand{\Crm}[1]{#1 \mapnil}
+\newcommand{\Crmm}[1]{\Cpath{#1} \mapnil}
+\newcommand{\Cthin}[1]{\ensuremath{\langle \Ckey{only}~#1 \rangle}}
+\newcommand{\Cthinn}[1]{\ensuremath{\langle \Ckey{only}~\Cpath{#1} \rangle}}
+\newcommand{\Cinc}[1]{\Ckey{include}~{#1}}
+\newcommand{\Cincc}[1]{\Ckey{include}~\Cpkg{#1}}
+\newcommand{\Cshar}[2]{~\Ckey{where}~{#1} \equiv {#2}}
+\newcommand{\Csharr}[2]{~\Ckey{where}~\Cpath{#1} \equiv \Cpath{#2}}
+\newcommand{\Ctshar}[2]{~\Ckey{where}~{#1} \equiv {#2}}
+\newcommand{\Ctsharr}[3]{~\Ckey{where}~\Cpath{#1}.\Cent{#3} \equiv \Cpath{#2}.\Cent{#3}}
+\newcommand{\Cbinds}[1]{\left\{\!\begin{array}{l} #1 \end{array}\!\right\}}
+\newcommand{\Cbindsp}[1]{\left(\!\begin{array}{l} #1 \end{array}\!\right)}
+\newcommand{\Cpkgs}[1]{\[\begin{array}{l} #1\end{array}\]}
+\newcommand{\Cpkgsl}[1]{\noindent\ensuremath{\begin{array}{@{}l} #1\end{array}}}
+\newcommand{\Ccomment}[1]{\ttt{\emph{--~#1}}}
+\newcommand{\Cimp}[1]{\Ckey{import}~\Cpkg{#1}}
+\newcommand{\Cimpas}[2]{\Ckey{import}~\Cpkg{#1}~\Ckey{as}~\Cvar{#2}}
+
+\newcommand{\Ctbinds}[1]{\left\{\!\vrule width 0.6pt \begin{array}{l} #1 \end{array} \vrule width 0.6pt \!\right\}}
+\newcommand{\Ctbindsx}{\left\{\!\vrule width 0.6pt \; \vrule width 0.6pt \!\right\}}
+\newcommand{\Ctbindsxx}{\left\{\!\vrule width 0.6pt \begin{array}{l}\!\!\!\!\\\!\!\!\!\end{array} \vrule width 0.6pt \!\right\}}
+\newcommand{\Ctbindsxxx}{\left\{\!\vrule width 0.6pt \begin{array}{l}\!\!\!\!\\\!\!\!\!\\\!\!\!\!\end{array} \vrule width 0.6pt \!\right\}}
+
+
+\newcommand{\Cpkgdef}[2]{%
+  \ensuremath{
+  \begin{array}{l}
+  \Ckey{package}~\Cpkg{#1}~\Ckey{where}\\
+  \hspace{1em}\begin{array}{l}
+              #2
+              \end{array}
+  \end{array}}}
+\newcommand{\Cpkgdefonly}[3]{%
+  \ensuremath{
+  \begin{array}{l}
+  \Ckey{package}~\Cpkg{#1}\Cvar{(#2)}~\Ckey{where}\\
+  \hspace{1em}\begin{array}{l}
+              #3
+              \end{array}
+  \end{array}}}
+\newcommand{\Ccc}{\mathbin{\ttcc{}}}
+\newcommand{\Cbinmod}[2]{\Cvar{#1} = \texttt{[#2]}}
+\newcommand{\Cbinsig}[2]{\Cvar{#1} \Ccc \texttt{[#2]}}
+\newcommand{\Cinconly}[2]{\Ckey{include}~\Cpkg{#1}\Cvar{(#2)}}
+\newcommand{\Cimponly}[2]{\Ckey{import}~\Cpkg{#1}\Cvar{(#2)}}
+\newcommand{\Cimpmv}[3]{\Ckey{import}~\Cpkg{#1}\langle\Cvar{#2}\mapsto\Cvar{#3}\rangle}
+
+
+
+
+
+\newcommand{\oxb}[1]{\llbracket #1 \rrbracket}
+\newcommand{\coxb}[1]{\{\hspace{-.5ex}| #1 |\hspace{-.5ex}\}}
+\newcommand{\coxbv}[1]{\coxb{\vec{#1}}}
+\newcommand{\angb}[1]{\ensuremath{\boldsymbol\langle #1 \boldsymbol\rangle}\xspace}
+\newcommand{\angbv}[1]{\angb{\vec{#1}}}
+\newcommand{\aoxbl}{\ensuremath{\boldsymbol\langle\hspace{-.5ex}|}}
+\newcommand{\aoxbr}{\ensuremath{|\hspace{-.5ex}\boldsymbol\rangle}\xspace}
+\newcommand{\aoxb}[1]{\ensuremath{\aoxbl{#1}\aoxbr}}
+\newcommand{\aoxbv}[1]{\aoxb{\vec{#1}}}
+\newcommand{\poxb}[1]{\ensuremath{%
+  (\hspace{-.5ex}|%
+  #1%
+  |\hspace{-.5ex})}\xspace}
+\newcommand{\stof}[1]{{#1}^{\star}}
+% \newcommand{\stof}[1]{\ensuremath{\underline{#1}}}
+\newcommand{\sh}[1]{\ensuremath{\tilde{#1}}}
+
+
+% \newenvironment{code}[1][t]%
+%   {\ignorespaces\begin{varwidth}[#1]{\textwidth}\begin{alltt}}%
+%   {\end{alltt}\end{varwidth}\ignorespacesafterend}
+% \newenvironment{codel}[1][t]%
+%   {\noindent\begin{varwidth}[#1]{\textwidth}\noindent\begin{alltt}}%
+%   {\end{alltt}\end{varwidth}\ignorespacesafterend}
+
+
+%% hack for subfloats in subfig -------------
+\makeatletter
+\newbox\sf@box
+\newenvironment{SubFloat}[2][]%
+  {\def\sf@one{#1}%
+   \def\sf@two{#2}%
+   \setbox\sf@box\hbox
+   \bgroup}%
+  {\egroup
+   \ifx\@empty\sf@two\@empty\relax
+     \def\sf@two{\@empty}
+   \fi
+   \ifx\@empty\sf@one\@empty\relax
+     \subfloat[\sf@two]{\box\sf@box}%
+   \else
+     \subfloat[\sf@one][\sf@two]{\box\sf@box}%
+   \fi}
+\makeatother
+%% ------------------------------------------
+
+%% hack for top-aligned tabular cells -------------
+\newsavebox\topalignbox
+\newcolumntype{L}{%
+  >{\begin{lrbox}\topalignbox
+    \rule{0pt}{\ht\strutbox}}
+  l
+  <{\end{lrbox}%
+    \raisebox{\dimexpr-\height+\ht\strutbox\relax}%
+      {\usebox\topalignbox}}}
+\newcolumntype{C}{%
+  >{\begin{lrbox}\topalignbox
+    \rule{0pt}{\ht\strutbox}}
+  c
+  <{\end{lrbox}%
+    \raisebox{\dimexpr-\height+\ht\strutbox\relax}%
+      {\usebox\topalignbox}}}
+\newcolumntype{R}{%
+  >{\begin{lrbox}\topalignbox
+    \rule{0pt}{\ht\strutbox}}
+  r
+  <{\end{lrbox}%
+    \raisebox{\dimexpr-\height+\ht\strutbox\relax}%
+      {\usebox\topalignbox}}}
+%% ------------------------------------------------
+
+\newcommand\syn[1]{\textsf{#1}}
+\newcommand\bsyn[1]{\textsf{\bfseries #1}}
+\newcommand\msyn[1]{\textsf{#1}}
+\newcommand{\cc}{\mathop{::}}
+
+% \newcommand{\Eimp}[1]{\bsyn{import}~{#1}}
+% \newcommand{\Eonly}[2]{#1~\bsyn{only}~{#2}}
+% \newcommand{\Ehide}[1]{~\bsyn{hide}~{#1}}
+% \newcommand{\Enew}[1]{\bsyn{new}~{#1}}
+% \newcommand{\Elocal}[2]{\bsyn{local}~{#1}~\bsyn{in}~{#2}}
+% \newcommand{\Smv}[3]{\Emv[]{#1}{#2}{#3}}
+\newcommand{\Srm}[2]{#1 \mathord{\setminus} #2}
+
+\newcommand{\cpath}{\varrho}
+\newcommand{\fpath}{\rho}
+
+\newcommand{\ie}{\emph{i.e.},\xspace}
+\newcommand{\eg}{\emph{e.g.},~}
+\newcommand{\etal}{\emph{et al.}}
+
+\renewcommand{\P}[1]{\Cpkg{#1}}
+\newcommand{\X}[1]{\Cvar{#1}}
+\newcommand{\E}{\mathcal{E}}
+\newcommand{\C}{\mathcal{C}}
+\newcommand{\M}{\mathcal{M}}
+\newcommand{\B}{\mathcal{B}}
+\newcommand{\R}{\mathcal{R}}
+\newcommand{\K}{\mathcal{K}}
+\renewcommand{\L}{\mathcal{L}}
+\newcommand{\D}{\mathcal{D}}
+
+%%%% NEW
+
+\newdateformat{numericdate}{%
+\THEYEAR.\twodigit{\THEMONTH}.\twodigit{\THEDAY}
+}
+
+% EL DEFNS
+\newcommand{\shal}[1]{\syn{shallow}(#1)}
+\newcommand{\exports}[1]{\syn{exports}(#1)}
+\newcommand{\Slocals}[1]{\syn{locals}(#1)}
+\newcommand{\Slocalsi}[2]{\syn{locals}(#1; #2)}
+\newcommand{\specs}[1]{\syn{specs}(#1)}
+\newcommand{\ELmkespc}[2]{\syn{mkespc}(#1;#2)}
+\newcommand{\Smkeenv}[1]{\syn{mkeenv}(#1)}
+\newcommand{\Smklocaleenv}[2]{\syn{mklocaleenv}(#1;#2)}
+\newcommand{\Smklocaleenvespcs}[1]{\syn{mklocaleenv}(#1)}
+\newcommand{\Smkphnms}[1]{\syn{mkphnms}(#1)}
+\newcommand{\Smkphnm}[1]{\syn{mkphnm}(#1)}
+\newcommand{\Sfilterespc}[2]{\syn{filterespc}(#1;#2)}
+\newcommand{\Sfilterespcs}[2]{\syn{filterespcs}(#1;#2)}
+\newcommand{\Simps}[1]{\syn{imps}(#1)}
+
+
+
+% IL DEFNS
+\newcommand{\dexp}{\mathit{dexp}}
+\newcommand{\fexp}{\mathit{fexp}}
+\newcommand{\tfexp}{\mathit{tfexp}}
+\newcommand{\pexp}{\mathit{pexp}}
+\newcommand{\dtyp}{\mathit{dtyp}}
+\newcommand{\ftyp}{\mathit{ftyp}}
+\newcommand{\hsmod}{\mathit{hsmod}}
+\newcommand{\fenv}{\mathit{fenv}}
+\newcommand{\ILmkmod}[6]{\syn{mkmod}(#1; #2; #3; #4; #5; #6)}
+\newcommand{\ILmkstubs}[3]{\syn{mkstubs}(#1; #2; #3)}
+\newcommand{\Smkstubs}[1]{\syn{mkstubs}(#1)}
+\newcommand{\ILentnames}[1]{\syn{entnames}(#1)}
+\newcommand{\ILmkfenv}[1]{\syn{mkfenv}(#1)}
+\newcommand{\ILmkdtyp}[1]{\syn{mkdtyp}(#1)}
+\newcommand{\ILmkknd}[1]{\syn{mkknd}(#1)}
+\newcommand{\ILmkimpdecl}[2]{\syn{mkimpdecl}(#1;#2)}
+\newcommand{\ILmkimpdecls}[2]{\syn{mkimpdecls}(#1;#2)}
+\newcommand{\ILmkimpspec}[3]{\syn{mkimpspec}(#1;#2;#3)}
+\newcommand{\ILmkentimp}[3]{\syn{mkentimp}(#1;#2;#3)}
+\newcommand{\ILmkentimpp}[1]{\syn{mkentimp}(#1)}
+\newcommand{\ILmkexp}[2]{\syn{mkexp}(#1;#2)}
+\newcommand{\ILmkexpdecl}[2]{\syn{mkexpdecl}(#1;#2)}
+\newcommand{\ILmkespc}[2]{\syn{mkespc}(#1;#2)}
+\newcommand{\ILshal}[1]{\syn{shallow}(#1)}
+\newcommand{\ILexports}[1]{\syn{exports}(#1)}
+\newcommand{\ILdefns}[1]{\syn{defns}(#1)}
+\newcommand{\ILdefnsi}[2]{\syn{defns}(#1;#2)}
+
+% CORE DEFNS
+\newcommand{\Hentref}{\mathit{eref}}
+\newcommand{\Hentimp}{\mathit{import}}
+\newcommand{\Hentexp}{\mathit{export}}
+\newcommand{\Himp}{\mathit{impdecl}}
+\newcommand{\Himpspec}{\mathit{impspec}}
+\newcommand{\Himps}{\mathit{impdecls}}
+\newcommand{\Hexps}{\mathit{expdecl}}
+\newcommand{\Hdef}{\mathit{def}}
+\newcommand{\Hdefs}{\mathit{defs}}
+\newcommand{\Hdecl}{\mathit{decl}}
+\newcommand{\Hdecls}{\mathit{decls}}
+\newcommand{\Heenv}{\mathit{eenv}}
+\newcommand{\Haenv}{\mathit{aenv}}
+% \newcommand{\HIL}[1]{{\scriptstyle\downarrow}#1}
+\newcommand{\HIL}[1]{\check{#1}}
+
+\newcommand{\Hcmp}{\sqsubseteq}
+
+\newcommand{\uexp}{\mathit{uexp}}
+\newcommand{\utyp}{\mathit{utyp}}
+\newcommand{\typ}{\mathit{typ}}
+\newcommand{\knd}{\mathit{knd}}
+\newcommand{\kndstar}{\ttt{*}}
+\newcommand{\kndarr}[2]{#1\ensuremath{\mathbin{\ttt{->}}}#2}
+\newcommand{\kenv}{\mathit{kenv}}
+\newcommand{\phnm}{\mathit{phnm}}
+\newcommand{\spc}{\mathit{dspc}}
+\newcommand{\spcs}{\mathit{dspcs}}
+\newcommand{\espc}{\mathit{espc}}
+\newcommand{\espcs}{\mathit{espcs}}
+\newcommand{\ds}{\mathit{ds}}
+
+\newcommand{\shctx}{\sh{\Xi}_{\syn{ctx}}}
+\newcommand{\shctxsigma}{\sh{\Sigma}_{\syn{ctx}}}
+
+\newcommand{\vdashsh}{\Vdash}
+
+% \newcommand{\vdashghc}{\vdash_{\!\!\mathrm{c}}^{\!\!\mathrm{\scriptscriptstyle EL}}}
+% \newcommand{\vdashghcil}{\vdash_{\!\!\mathrm{c}}^{\!\!\mathrm{\scriptscriptstyle IL}}}
+% \newcommand{\vdashshghc}{\vdashsh_{\!\!\mathrm{c}}^{\!\!\mathrm{\scriptscriptstyle EL}}}
+\newcommand{\vdashghc}{\vdash_{\!\!\mathrm{c}}}
+\newcommand{\vdashghcil}{\vdash_{\!\!\mathrm{c}}^{\!\!\mathrm{\scriptscriptstyle IL}}}
+\newcommand{\vdashshghc}{\vdashsh_{\!\!\mathrm{c}}}
+
+% CORE STUFF
+\newcommandx*{\JCModImp}[5][1=\sh\B, 2=\nu_0, usedefault=@]%
+  {#1;#2 \vdashshghc #3;#4 \elabto #5}
+\newcommandx*{\JIlCModImp}[5][1=\fenv, 2=f_0, usedefault=@]%
+  {#1;#2 \vdashghcil #3;#4 \elabto #5}
+\newcommandx*{\JCSigImp}[5][1=\sh\B, 2=\sh\tau, usedefault=@]%
+  {#1;#2 \vdashshghc #3;#4 \elabto #5}
+
+\newcommandx*{\JCImpDecl}[3][1=\sh\B, usedefault=@]%
+  {#1 \vdashshghc #2 \elabto #3}
+\newcommandx*{\JCImp}[4][1=\sh\B, 2=p, usedefault=@]%
+  {#1;#2 \vdashshghc #3 \elabto #4}
+\newcommandx*{\JIlCImpDecl}[3][1=\fenv, usedefault=@]%
+  {#1 \vdashghcil #2 \elabto #3}
+\newcommandx*{\JIlCImp}[4][1=\fenv, 2=f, usedefault=@]%
+  {#1;#2 \vdashghcil #3 \elabto #4}
+
+\newcommandx*{\JCModExp}[4][1=\nu_0, 2=\Heenv, usedefault=@]%
+  {#1;#2 \vdashshghc #3 \elabto #4}
+\newcommandx*{\JIlCModExp}[4][1=f_0, 2=\HIL\Heenv, usedefault=@]%
+  {#1;#2 \vdashghcil #3 \elabto #4}
+
+\newcommandx*{\JCModDef}[5][1=\Psi, 2=\nu_0, 3=\Heenv, usedefault=@]%
+  {#1; #2; #3 \vdashghcil #4 : #5}
+\newcommandx*{\JIlCModDef}[5][1=\fenv, 2=f_0, 3=\HIL\Heenv, usedefault=@]%
+  {#1; #2; #3 \vdashghcil #4 : #5}
+\newcommandx*{\JCSigDecl}[5][1=\Psi, 2=\sh\tau, 3=\Heenv, usedefault=@]%
+  {#1; #2; #3 \vdashghcil #4 : #5}
+
+\newcommandx*{\JCExp}[6][1=\sh\Psi, 2=\nu_0, 3=\Hdefs, 4=\Heenv, usedefault=@]%
+  {#1;#2;#3;#4 \vdashshghc #5 \elabto #6}
+\newcommandx*{\JIlCExp}[4][1=f_0, 2=\HIL\Heenv, usedefault=@]%
+  {#1;#2 \vdashghcil #3 \elabto #4}
+
+\newcommandx*{\JCRefExp}[7][1=\sh\Psi, 2=\nu_0, 3=\Hdefs, 4=\Heenv, usedefault=@]%
+  {#1;#2;#3;#4 \vdashshghc #5 \elabto #6:#7}
+\newcommandx*{\JIlCRefExp}[7][1=\fenv, 2=f_0, 3=\HIL\Hdefs, 4=\HIL\Heenv, usedefault=@]%
+  {#1;#2;#3;#4 \vdashghcil #5 \elabto #6:#7}
+
+\newcommandx*{\JCMod}[4][1=\Gamma, 2=\nu_0, usedefault=@]%
+  {#1; #2 \vdashghc #3 : #4}
+\newcommandx*{\JIlCMod}[3][1=\fenv, usedefault=@]%
+  {#1 \vdashghcil #2 : #3}
+\newcommandx*{\JCSig}[5][1=\Gamma, 2=\sh\tau, usedefault=@]%
+  {#1; #2 \vdashghc #3 \elabto #4;#5}
+\newcommandx*{\JCShSig}[5][1=\Gamma, 2=\sh\tau, usedefault=@]%
+  {#1; #2 \vdashghc #3 \elabto #4;#5}
+\newcommandx*{\JCModElab}[5][1=\Gamma, 2=\nu_0, usedefault=@]%
+  % {#1; #2 \vdashghc #3 : #4 \elabto #5}
+  {#1; #2 \vdashghc #3 : #4 \;\shade{\elabto #5}}
+
+\newcommandx*{\JCWfEenv}[2][1=\Haenv, usedefault=@]%
+  {#1 \vdashshghc #2~\syn{wf}}
+\newcommandx*{\JCWfEenvMap}[2][1=\Haenv, usedefault=@]%
+  {#1 \vdashshghc #2~\syn{wf}}
+\newcommandx*{\JIlCWfEenv}[2][1=\HIL\Haenv, usedefault=@]%
+  {#1 \vdashghcil #2~\syn{wf}}
+\newcommandx*{\JIlCWfEenvMap}[2][1=\HIL\Haenv, usedefault=@]%
+  {#1 \vdashghcil #2~\syn{wf}}
+
+\newcommandx*{\JIlTfexp}[3][1=\fenv, 2=f_0, usedefault=@]%
+  {#1; #2 \vdash #3}
+
+
+
+  % IL STUFF
+
+\newcommandx*{\JIlWf}[2][1=\fenv, usedefault=@]%
+  {#1 \vdash #2 ~\syn{wf}}
+\newcommandx*{\JIlKnd}[4][1=\fenv, 2=\kenv, usedefault=@]%
+  {#1;#2 \vdashghcil #3 \mathrel{\cc} #4}
+% \newcommandx*{\JIlSub}[4][1=\fenv, 2=f, usedefault=@]%
+%   {#1;#2 \vdash #3 \le #4}
+\newcommandx*{\JIlSub}[2][usedefault=@]%
+  {\vdash #1 \le #2}
+\newcommandx*{\JIlMerge}[3][usedefault=@]%
+  {\vdash #1 \oplus #2 \Rightarrow #3}
+
+\newcommandx*{\JIlDexp}[2][1=\fenv, usedefault=@]%
+  {#1 \vdash #2}
+\newcommandx*{\JIlDexpTyp}[3][1=\fenv, usedefault=@]%
+  {#1 \vdash #2 : #3}
+
+\newcommandx*{\JIlWfFenv}[2][1=\nil, usedefault=@]%
+  {#1 \vdash #2 ~\syn{wf}}
+\newcommandx*{\JIlWfFtyp}[2][1=\fenv, usedefault=@]%
+  {#1 \vdash #2 ~\syn{wf}}
+\newcommandx*{\JIlWfSpc}[2][1=\fenv, usedefault=@]%
+  {#1 \vdash #2 ~\syn{wf}}
+\newcommandx*{\JIlWfESpc}[2][1=\fenv, usedefault=@]%
+  {#1 \vdash #2 ~\syn{wf}}
+\newcommandx*{\JIlWfSig}[2][1=\fenv, usedefault=@]%
+  {#1 \vdash #2 ~\syn{wf}}
+\newcommandx*{\JIlWfFtypSpecs}[2][1=\fenv, usedefault=@]%
+  {#1 \vdash #2 ~\syn{specs-wf}}
+\newcommandx*{\JIlWfFtypExps}[2][1=\fenv, usedefault=@]%
+  {#1 \vdash #2 ~\syn{exports-wf}}
+\newcommandx*{\JIlWfFenvDeps}[2][1=\fenv, usedefault=@]%
+  {#1 \vdash #2 ~\syn{deps-wf}}
+
+% WF TYPE STUFF IN EL
+\newcommandx*{\JPkgValid}[1]%
+  {\vdash #1 ~\syn{pkg-valid}}
+\newcommandx*{\JWfPkgCtx}[1][1=\Delta, usedefault=@]%
+  {\vdash #1 ~\syn{wf}}
+\newcommandx*{\JWfPhCtx}[2][1=\nil, usedefault=@]%
+  {#1 \vdash #2 ~\syn{wf}}
+\newcommandx*{\JWfModTyp}[2][1=\Psi, usedefault=@]%
+  {#1 \vdash #2 ~\syn{wf}}
+\newcommandx*{\JWfModTypPol}[3][1=\Psi, usedefault=@]%
+  {#1 \vdash #2^{#3} ~\syn{wf}}
+\newcommandx*{\JWfLogSig}[2][1=\Psi, usedefault=@]%
+  {#1 \vdash #2 ~\syn{wf}}
+\newcommandx*{\JWfSpc}[2][1=\Psi, usedefault=@]%
+  {#1 \vdash #2 ~\syn{wf}}
+\newcommandx*{\JWfESpc}[2][1=\Psi, usedefault=@]%
+  {#1 \vdash #2 ~\syn{wf}}
+\newcommandx*{\JWfSig}[2][1=\nil, usedefault=@]%
+  {#1 \vdash #2 ~\syn{wf}}
+\newcommandx*{\JWfModTypSpecs}[2][1=\Psi, usedefault=@]%
+  {#1 \vdash #2 ~\syn{specs-wf}}
+\newcommandx*{\JWfModTypPolSpecs}[3][1=\Psi, usedefault=@]%
+  {#1 \vdash #2^{#3} ~\syn{specs-wf}}
+\newcommandx*{\JWfModTypExps}[2][1=\Psi, usedefault=@]%
+  {#1 \vdash #2 ~\syn{exports-wf}}
+\newcommandx*{\JWfPhCtxDeps}[2][1=\Psi, usedefault=@]%
+  {#1 \vdash #2 ~\syn{deps-wf}}
+\newcommandx*{\JWfPhCtxDepsOne}[4][1=\Psi, usedefault=@]%
+  {#1 \vdash \styp{#2}{#3}{#4} ~\syn{deps-wf}}
+
+% WF SHAPE STUFF IN EL
+\newcommandx*{\JWfShPhCtx}[2][1=\nil, usedefault=@]%
+  {#1 \vdashsh #2 ~\syn{wf}}
+\newcommandx*{\JWfModSh}[2][1=\sh\Psi, usedefault=@]%
+  {#1 \vdashsh #2 ~\syn{wf}}
+\newcommandx*{\JWfModShPol}[3][1=\sh\Psi, usedefault=@]%
+  {#1 \vdashsh #2^{#3} ~\syn{wf}}
+\newcommandx*{\JWfShLogSig}[2][1=\sh\Psi, usedefault=@]%
+  {#1 \vdashsh #2 ~\syn{wf}}
+\newcommandx*{\JWfShSpc}[2][1=\sh\Psi, usedefault=@]%
+  {#1 \vdashsh #2 ~\syn{wf}}
+\newcommandx*{\JWfShESpc}[2][1=\sh\Psi, usedefault=@]%
+  {#1 \vdashsh #2 ~\syn{wf}}
+\newcommandx*{\JWfShSig}[2][1=\nil, usedefault=@]%
+  {#1 \vdashsh #2 ~\syn{wf}}
+\newcommandx*{\JWfModShSpecs}[2][1=\sh\Psi, usedefault=@]%
+  {#1 \vdashsh #2 ~\syn{specs-wf}}
+\newcommandx*{\JWfModShPolSpecs}[3][1=\sh\Psi, usedefault=@]%
+  {#1 \vdashsh #2^{#3} ~\syn{specs-wf}}
+\newcommandx*{\JWfModShExps}[2][1=\sh\Psi, usedefault=@]%
+  {#1 \vdashsh #2 ~\syn{exports-wf}}
+\newcommandx*{\JWfEenv}[4][1=\sh\Psi, 2=\nu_0, 3=\Hdefs, usedefault=@]%
+  {#1;#2;#3 \vdashshghc #4 ~\syn{wf}}
+
+\newcommandx*{\JCoreKnd}[4][1=\Psi, 2=\kenv, usedefault=@]%
+  {#1;#2 \vdashghc #3 \mathrel{\cc} #4}
+
+\newcommandx*{\JStampEq}[2]%
+  {\vdash #1 \equiv #2}
+\newcommandx*{\JStampNeq}[2]%
+  {\vdash #1 \not\equiv #2}
+\newcommandx*{\JUnif}[3]%
+  {\syn{unify}(#1 \doteq #2) \elabto #3}
+\newcommandx*{\JUnifM}[2]%
+  {\syn{unify}(#1) \elabto #2}
+
+\newcommandx*{\JModTypWf}[1]%
+  {\vdash #1 ~\syn{wf}}
+  
+\newcommandx*{\JModSub}[2]%
+  {\vdash #1 \le #2}
+\newcommandx*{\JModSup}[2]%
+  {\vdash #1 \ge #2}
+\newcommandx*{\JShModSub}[2]%
+  {\vdashsh #1 \le #2}
+
+\newcommandx*{\JModEq}[2]%
+  {\vdash #1 \equiv #2}
+% \newcommandx*{\JCShModEq}[3][3=\C]%
+%   {\vdashsh #1 \equiv #2 \mathbin{|} #3}
+
+\newcommandx*{\JETyp}[4][1=\Gamma, 2=\shctxsigma, usedefault=@]%
+  {#1;#2 \vdash #3 : #4}
+\newcommandx*{\JETypElab}[5][1=\Gamma, 2=\shctxsigma, usedefault=@]%
+  {\JETyp[#1][#2]{#3}{#4} \elabto #5}
+\newcommandx*{\JESh}[3][1=\sh\Gamma, usedefault=@]%
+  {#1 \vdashsh #2 \Rightarrow #3}
+
+\newcommandx*{\JBTyp}[5][1=\Delta, 2=\Gamma, 3=\shctx, usedefault=@]%
+  {#1;#2;#3 \vdash #4 : #5}
+\newcommandx*{\JBTypElab}[6][1=\Delta, 2=\Gamma, 3=\shctx, usedefault=@]%
+  % {\JBTyp[#1][#2][#3]{#4}{#5} \elabto #6}
+  {\JBTyp[#1][#2][#3]{#4}{#5} \;\shade{\elabto #6}}
+\newcommandx*{\JBSh}[4][1=\Delta, 2=\sh\Gamma, usedefault=@]%
+  {#1;#2 \vdashsh #3 \Rightarrow #4}
+  
+\newcommandx*{\JBVTyp}[4][1=\Delta, 2=\shctx, usedefault=@]%
+  {#1;#2 \vdash #3 : #4}
+\newcommandx*{\JBVTypElab}[5][1=\Delta, 2=\shctx, usedefault=@]%
+  % {\JBVTyp[#1][#2]{#3}{#4} \elabto #5}
+  {\JBVTyp[#1][#2]{#3}{#4} \;\shade{\elabto #5}}
+\newcommandx*{\JBVSh}[4][1=\Delta, usedefault=@]%
+  {#1 \vdashsh #2 \Rightarrow #3;\, #4}
+  
+\newcommandx*{\JImp}[3][1=\Gamma, usedefault=@]%
+  {#1 \vdashimp #2 \elabto #3}
+\newcommandx*{\JShImp}[3][1=\sh\Gamma, usedefault=@]%
+  {#1 \vdashshimp #2 \elabto #3}
+  
+\newcommandx*{\JGhcMod}[4]%
+  {#1; #2 \vdashghc #3 : #4}
+\newcommandx*{\JShGhcMod}[4]%
+  {#1; #2 \vdashshghc #3 : #4}
+  
+\newcommandx*{\JGhcSig}[5]%
+  {#1; #2 \vdashghc #3 \elabto #4;#5}
+\newcommandx*{\JShGhcSig}[5]%
+  {#1; #2 \vdashshghc #3 \elabto #4;#5}
+  
+\newcommandx*{\JThin}[3][1=t, usedefault=@]%
+  {\vdash #2 \xrightarrow{~#1~} #3}
+\newcommandx*{\JShThin}[3][1=t, usedefault=@]%
+  {\vdashsh #2 \xrightarrow{~#1~} #3}
+
+\newcommandx*{\JShMatch}[3][1=\nu, usedefault=@]%
+  {#1 \vdash #2 \sqsubseteq #3}
+  
+\newcommandx*{\JShTrans}[4]%
+  {\vdash #1 \le_{#2} #3 \elabto #4}
+  
+\newcommandx*{\JMerge}[3]%
+  {\vdash #1 + #2 \Rightarrow #3}
+\newcommandx*{\JShMerge}[5]%
+  {\vdashsh #1 + #2 \Rightarrow #3;\, #4;\, #5}
+\newcommandx*{\JShMergeNew}[4]%
+  {\vdashsh #1 + #2 \Rightarrow #3;\, #4}
+\newcommandx*{\JShMergeSimple}[3]%
+  {\vdashsh #1 + #2 \Rightarrow #3}
+
+\newcommandx*{\JDTyp}[3][1=\Delta, usedefault=@]%
+  {#1 \vdash #2 : #3}
+\newcommandx*{\JDTypElab}[4][1=\Delta, usedefault=@]%
+  % {#1 \vdash #2 : #3 \elabto #4}
+  {#1 \vdash #2 : #3 \;\shade{\elabto #4}}
+
+\newcommandx*{\JTTyp}[2][1=\Delta, usedefault=@]%
+  {#1 \vdash #2}
+
+\newcommandx*{\JSound}[3][1=\Psi_\syn{ctx}, usedefault=@]%
+  {#1 \vdash #2 \sim #3}
+
+\newcommandx*{\JSoundOne}[4][1=\Psi, 2=\fenv, usedefault=@]%
+  {\vdash #3 \sim #4}
+% \newcommand{\Smodi}[4]{\ensuremath{\oxb{=#2 \cc #3 \imps #4}^{#1}}}
+\newcommand{\Smodi}[3]{\ensuremath{\oxb{=#2 \cc #3}^{#1}}}
+\newcommand{\Smod}[2]{\Smodi{+}{#1}{#2}}
+\newcommand{\Ssig}[2]{\Smodi{-}{#1}{#2}}
+\newcommand{\Sreq}[2]{\Smodi{?}{#1}{#2}}
+\newcommand{\Shole}[2]{\Smodi{\circ}{#1}{#2}}
+
+\newcommand{\SSmodi}[2]{\ensuremath{\oxb{=#2}^{#1}}}
+\newcommand{\SSmod}[1]{\SSmodi{+}{#1}}
+\newcommand{\SSsig}[1]{\SSmodi{-}{#1}}
+\newcommand{\SSreq}[1]{\SSmodi{?}{#1}}
+\newcommand{\SShole}[1]{\SSmodi{\circ}{#1}}
+
+% \newcommand{\styp}[3]{\oxb{{#1}\cc{#2}}^{#3}}
+\newcommand{\styp}[3]{{#1}{:}{#2}^{#3}}
+\newcommand{\stm}[2]{\styp{#1}{#2}{\scriptscriptstyle+}}
+\newcommand{\sts}[2]{\styp{#1}{#2}{\scriptscriptstyle-}}
+
+% \newcommand{\mtypsep}{[\!]}
+\newcommand{\mtypsep}{\mbox{$\bm{;}$}}
+\newcommand{\mtypsepsp}{\hspace{.3em}}
+\newcommand{\msh}[3]{\aoxb{#1 ~\mtypsep~ #2 ~\mtypsep~ #3}}
+\newcommand{\mtyp}[3]{
+  \aoxb{\mtypsepsp #1 \mtypsepsp\mtypsep\mtypsepsp
+        #2 \mtypsepsp\mtypsep\mtypsepsp
+        #3 \mtypsepsp}}
+\newcommand{\bigmtyp}[3]{\ensuremath{
+  \left\langle\!\vrule \begin{array}{l}
+    #1 ~\mtypsep \\[0pt]
+    #2 ~\mtypsep \\
+    #3
+  \end{array} \vrule\!\right\rangle
+}}
+
+
+\newcommand{\mtypm}[2]{\mtyp{#1}{#2}^{\scriptstyle+}}
+\newcommand{\mtyps}[2]{\mtyp{#1}{#2}^{\scriptstyle-}}
+\newcommand{\bigmtypm}[2]{\bigmtyp{#1}{#2}^{\scriptstyle+}}
+\newcommand{\bigmtyps}[2]{\bigmtyp{#1}{#2}^{\scriptstyle-}}
+
+\newcommand{\mref}{\ensuremath{\mathit{mref}}}
+\newcommand{\selfpath}{\msyn{Local}}
+
+% \newcommand{\Ltyp}[3]{\oxb{#1 \mathbin{\scriptstyle\MVAt} #2}^{#3}}
+% \newcommand{\Ltyp}[2]{\poxb{#1 \mathbin{\scriptstyle\MVAt} #2}}
+\newcommand{\Ltyp}[2]{#1 {\scriptstyle\MVAt} #2}
+
+\newcommand{\Sshape}[1]{\ensuremath{\syn{shape}(#1)}}
+\newcommand{\Srename}[2]{\ensuremath{\syn{rename}(#1;#2)}}
+\newcommand{\Scons}[2]{\ensuremath{\syn{cons}(#1;#2)}}
+\newcommand{\Smkreq}[1]{\ensuremath{\syn{hide}(#1)}}
+\newcommand{\Sfv}[1]{\ensuremath{\syn{fv}(#1)}}
+\newcommand{\Sdom}[1]{\ensuremath{\syn{dom}(#1)}}
+\newcommand{\Srng}[1]{\ensuremath{\syn{rng}(#1)}}
+\newcommand{\Sdomp}[2]{\ensuremath{\syn{dom}_{#1}(#2)}}
+\newcommand{\Sclos}[1]{\ensuremath{\syn{clos}(#1)}}
+\newcommand{\Scloss}[2]{\ensuremath{\syn{clos}_{#1}(#2)}}
+\newcommand{\Snorm}[1]{\ensuremath{\syn{norm}(#1)}}
+\newcommand{\Sident}[1]{\ensuremath{\syn{ident}(#1)}}
+\newcommand{\Snec}[2]{\ensuremath{\syn{nec}(#1; #2)}}
+\newcommand{\Sprovs}[1]{\ensuremath{\syn{provs}(#1)}}
+\newcommand{\Smkstamp}[2]{\ensuremath{\syn{mkident}(#1; #2)}}
+\newcommand{\Sname}[1]{\ensuremath{\syn{name}(#1)}}
+\newcommand{\Snames}[1]{\ensuremath{\syn{names}(#1)}}
+\newcommand{\Sallnames}[1]{\ensuremath{\syn{allnames}(#1)}}
+\newcommand{\Shassubs}[1]{\ensuremath{\syn{hasSubs}(#1)}}
+\newcommand{\Snooverlap}[1]{\ensuremath{\syn{nooverlap}(#1)}}
+\newcommand{\Sreduce}[2]{\ensuremath{\syn{apply}(#1; #2)}}
+\newcommand{\Smkfenv}[1]{\ensuremath{\syn{mkfenv}(#1)}}
+\newcommand{\Svalidspc}[2]{\ensuremath{\syn{validspc}(#1; #2)}}
+\newcommand{\Srepath}[2]{\ensuremath{\syn{repath}(#1; #2)}}
+\newcommand{\Smksigenv}[2]{\ensuremath{\syn{mksigenv}(#1; #2)}}
+\newcommand{\Smksigshenv}[2]{\ensuremath{\syn{mksigshenv}(#1; #2)}}
+\newcommand{\Squalify}[2]{\ensuremath{\syn{qualify}(#1; #2)}}
+\newcommandx*{\Sdepends}[2][1=\Psi, usedefault=@]%
+  {\ensuremath{\syn{depends}_{#1}(#2)}}
+\newcommandx*{\Sdependss}[3][1=\Psi, 2=N, usedefault=@]%
+  {\ensuremath{\syn{depends}_{#1;#2}(#3)}}
+\newcommandx*{\Sdependsss}[4][1=\Psi, 2=V, 3=\theta, usedefault=@]%
+  {\ensuremath{\syn{depends}_{#1;#2;#3}(#4)}}
+\newcommand{\Snormsubst}[2]{\ensuremath{\syn{norm}(#1; #2)}}
+
+% \newcommand{\Smergeable}[2]{\ensuremath{\syn{mergeable}(#1; #2)}}
+\newcommand{\mdef}{\mathrel{\bot}}
+\newcommand{\Smergeable}[2]{\ensuremath{#1 \mdef #2}}
+
+\newcommand{\Sstamp}[1]{\ensuremath{\syn{stamp}(#1)}}
+\newcommand{\Stype}[1]{\ensuremath{\syn{type}(#1)}}
+
+\newcommand{\Strue}{\ensuremath{\syn{true}}}
+\newcommand{\Sfalse}{\ensuremath{\syn{false}}}
+
+\newcommandx*{\refsstar}[2][1=\nu_0, usedefault=@]%
+  {\ensuremath{\syn{refs}^{\star}}_{#1}(#2)}
+
+\renewcommand{\merge}{\boxplus}
+\newcommand{\meet}{\sqcap}
+
+\newcommand{\Shaslocaleenv}[3]{\ensuremath{\syn{haslocaleenv}(#1;#2;#3)}}
+\newcommand{\MTvalidnewmod}[3]{\ensuremath{\syn{validnewmod}(#1;#2;#3)}}
+\newcommand{\Sdisjoint}[1]{\ensuremath{\syn{disjoint}(#1)}}
+\newcommand{\Sconsistent}[1]{\ensuremath{\syn{consistent}(#1)}}
+\newcommand{\Slocmatch}[2]{\ensuremath{\syn{locmatch}(#1;#2)}}
+\newcommand{\Sctxmatch}[2]{\ensuremath{\syn{ctxmatch}(#1;#2)}}
+\newcommand{\Snolocmatch}[2]{\ensuremath{\syn{nolocmatch}(#1;#2)}}
+\newcommand{\Snoctxmatch}[2]{\ensuremath{\syn{noctxmatch}(#1;#2)}}
+\newcommand{\Sislocal}[2]{\ensuremath{\syn{islocal}(#1;#2)}}
+\newcommand{\Slocalespcs}[2]{\ensuremath{\syn{localespcs}(#1;#2)}}
+
+\newcommand{\Cprod}[1]{\syn{productive}(#1)}
+\newcommand{\Cnil}{\nil}
+\newcommand{\id}{\syn{id}}
+
+\newcommand{\nui}{\nu_{\syn{i}}}
+\newcommand{\taui}{\tau_{\syn{i}}}
+\newcommand{\Psii}{\Psi_{\syn{i}}}
+
+\newcommand{\vis}{\ensuremath{\mathsf{\scriptstyle V}}}
+\newcommand{\hid}{\ensuremath{\mathsf{\scriptstyle H}}}
+
+\newcommand{\taum}[1]{\ensuremath{\tau_{#1}^{m_{#1}}}}
+
+\newcommand{\sigmamod}{\sigma_{\syn{m}}}
+\newcommand{\sigmaprov}{\sigma_{\syn{p}}}
+
+\newcommand{\Svalidsubst}[2]{\ensuremath{\syn{validsubst}(#1;#2)}}
+\newcommand{\Salias}[1]{\ensuremath{\syn{alias}(#1)}}
+\newcommand{\Saliases}[1]{\ensuremath{\syn{aliases}(#1)}}
+\newcommand{\Simp}[1]{\ensuremath{\syn{imp}(#1)}}
+\newcommand{\Styp}[1]{\ensuremath{\syn{typ}(#1)}}
+\newcommand{\Spol}[1]{\ensuremath{\syn{pol}(#1)}}
+
+\newcommand{\stoff}{\stof{(-)}}
+\newcommand{\stheta}{\stof\theta}
+
+
+%%%%%%% FOR THE PAPER!
+\newcommand{\secref}[1]{Section~\ref{sec:#1}}
+\newcommand{\figref}[1]{Figure~\ref{fig:#1}}
+
+% typesetting for module/path names
+\newcommand{\mname}[1]{\textsf{#1}}
+\newcommand{\m}[1]{\mname{#1}}
+
+% typesetting for package names
+\newcommand{\pname}[1]{\textsf{#1}}
+
+\newcommand{\kpm}[2]{\angb{\pname{#1}.#2}}
+
+% for core entities
+\newcommand{\code}[1]{\texttt{#1}}
+\newcommand{\core}[1]{\texttt{#1}}
+
+\newcommand{\req}{\bsyn{req}}
+\newcommand{\hiding}[1]{\req~\m{#1}}
+
+\newcommand{\Emod}[1]{\ensuremath{[#1]}}
+\newcommand{\Esig}[1]{\ensuremath{[\cc#1]}}
+\newcommand{\Epkg}[2]{\bsyn{package}~\pname{#1}~\bsyn{where}~{#2}}
+% \newcommand{\Epkgt}[3]{\bsyn{package}~{#1}~\bsyn{only}~{#2}~\bsyn{where}~{#3}}
+\newcommand{\Epkgt}[3]{\bsyn{package}~\pname{#1}~{#2}~\bsyn{where}~{#3}}
+\newcommand{\Einc}[1]{\bsyn{include}~\pname{#1}}
+% \newcommand{\Einct}[2]{\bsyn{include}~{#1}~\bsyn{only}~{#2}}
+% \newcommand{\Einctr}[3]{\bsyn{include}~{#1}~\bsyn{only}~{#2}~{#3}}
+\newcommand{\Einct}[2]{\bsyn{include}~\pname{#1}~(#2)}
+\newcommand{\Eincr}[2]{\bsyn{include}~\pname{#1}~\angb{#2}}
+\newcommand{\Einctr}[3]{\bsyn{include}~\pname{#1}~(#2)~\angb{#3}}
+\newcommand{\Emv}[2]{#1 \mapsto #2}
+\newcommand{\Emvp}[2]{\m{#1} \mapsto \m{#2}}
+\newcommand{\Etr}[3][~]{{#2}{#1}\langle #3 \rangle}
+\newcommand{\Erm}[3][~]{{#2}{#1}\langle #3 \mapnil \rangle}
+\newcommand{\Ethin}[1]{(#1)}
+\newcommand{\Ethinn}[2]{(#1; #2)}
+
+
+% \newcommand{\Pdef}[2]{\ensuremath{\begin{array}{l} \Phead{#1} #2\end{array}}}
+% \newcommand{\Phead}[1]{\bsyn{package}~\pname{#1}~\bsyn{where} \\}
+% \newcommand{\Pbndd}[2]{\hspace{1em}{#1} = {#2} \\}
+% \newcommand{\Pbnd}[2]{\hspace{1em}\mname{#1} = {#2} \\}
+% \newcommand{\Pref}[2]{\hspace{1em}\mname{#1} = \mname{#2} \\}
+% \newcommand{\Pmod}[2]{\hspace{1em}\mname{#1} = [\code{#2}] \\}
+% \newcommand{\Psig}[2]{\hspace{1em}\mname{#1} \cc [\code{#2}] \\}
+\newcommand{\Pdef}[2]{\ensuremath{
+  \begin{array}{@{\hspace{1em}}L@{\;\;}c@{\;\;}l}
+    \multicolumn{3}{@{}l}{\Phead{#1}} \\
+    #2
+  \end{array}
+}}
+\newcommand{\Pdeft}[3]{\ensuremath{
+  \begin{array}{@{\hspace{1em}}L@{\;\;}c@{\;\;}l}
+    \multicolumn{3}{@{}l}{\Pheadt{#1}{#2}} \\
+    #3
+  \end{array}
+}}
+\newcommand{\Phead}[1]{\bsyn{package}~\pname{#1}~\bsyn{where}}
+\newcommand{\Pheadt}[2]{\bsyn{package}~\pname{#1}~(#2)~\bsyn{where}}
+\newcommand{\Pbnd}[2]{#1 &=& #2 \\}
+\newcommand{\Pref}[2]{\mname{#1} &=& \mname{#2} \\}
+\newcommand{\Pmod}[2]{\mname{#1} &=& [\code{#2}] \\}
+\newcommand{\Pmodd}[2]{\mname{#1} &=& #2 \\}
+\newcommand{\Psig}[2]{\mname{#1} &\cc& [\code{#2}] \\}
+\newcommand{\Psigg}[2]{\mname{#1} &\cc& #2 \\}
+\newcommand{\Pmulti}[1]{\multicolumn{3}{@{\hspace{1em}}l} {#1} \\}
+\newcommand{\Pinc}[1]{\Pmulti{\Einc{#1}}}
+\newcommand{\Pinct}[2]{\Pmulti{\Einct{#1}{#2}}}
+\newcommand{\Pincr}[2]{\Pmulti{\Eincr{#1}{#2}}}
+\newcommand{\Pinctr}[3]{\Pmulti{\Einctr{#1}{#2}{#3}}}
+\newcommand{\Pmodbig}[2]{\mname{#1} &=& \left[
+  \begin{codeblock}
+  #2
+  \end{codeblock}
+\right] \\}
+\newcommand{\Psigbig}[2]{\mname{#1} &\cc& \left[
+  \begin{codeblock}
+  #2
+  \end{codeblock}
+\right] \\}
+
+\newcommand{\Mimp}[1]{\msyn{import}~\mname{#1}}
+\newcommand{\Mimpq}[1]{\msyn{import}~\msyn{qualified}~\mname{#1}}
+\newcommand{\Mimpas}[2]{\msyn{import}~\mname{#1}~\msyn{as}~\mname{#2}}
+\newcommand{\Mimpqas}[2]{\msyn{import}~\msyn{qualified}~\mname{#1}~\msyn{as}~\mname{#2}}
+\newcommand{\Mexp}[1]{\msyn{export}~(#1)}
+
+\newcommand{\illtyped}{\hfill ($\times$) \; ill-typed}
+
+\newenvironment{example}[1][LL]%
+  {\ignorespaces \begin{flushleft}\begin{tabular}{@{\hspace{1em}}#1} }%
+  {\end{tabular}\end{flushleft} \ignorespacesafterend}
+
+\newenvironment{counterexample}[1][LL]%
+  {\ignorespaces \begin{flushleft}\begin{tabular}{@{\hspace{1em}}#1} }%
+  {& \text{\illtyped} \end{tabular}\end{flushleft}  \ignorespacesafterend}
+
+\newenvironment{codeblock}%
+  {\begin{varwidth}{\textwidth}\begin{alltt}}%
+  {\end{alltt}\end{varwidth}}
+
+\newcommand{\fighead}{\hrule\vspace{1.5ex}}
+\newcommand{\figfoot}{\vspace{1ex}\hrule}
+\newenvironment{myfig}{\fighead\small}{\figfoot}
+
+\newcommand{\Mhead}[2]{\syn{module}~{#1}~\syn{(}{#2}\syn{)}~\syn{where}}
+\newcommand{\Mdef}[3]{\ensuremath{
+  \begin{array}{@{\hspace{1em}}L}
+    \multicolumn{1}{@{}L}{\Mhead{#1}{\core{#2}}} \\
+    #3
+  \end{array}
+}}
+
+\newcommand{\HMstof}[1]{\ensuremath{#1}}
+% \newcommand{\HMstof}[1]{\ensuremath{\lfloor #1 \rfloor}}
+% \newcommand{\HMstof}[1]{\ensuremath{\underline{#1}}}
+% \newcommand{\HMstof}[1]{{#1}^{\star}}
+\newcommand{\HMhead}[2]{\syn{module}~\(\HMstof{#1}\)~\syn{(}{#2}\syn{)}~\syn{where}}
+\newcommand{\HMdef}[3]{\ensuremath{
+  \begin{array}{@{\hspace{1em}}L}
+    \multicolumn{1}{@{}L}{\HMhead{#1}{\core{#2}}} \\
+    #3
+  \end{array}
+}}
+\newcommand{\HMimpas}[3]{%
+  \msyn{import}~\ensuremath{\HMstof{#1}}~%
+  \msyn{as}~\mname{#2}~\msyn{(}\core{#3}\msyn{)}}
+\newcommand{\HMimpqas}[3]{%
+  \msyn{import}~\msyn{qualified}~\ensuremath{\HMstof{#1}}~%
+  \msyn{as}~\mname{#2}~\msyn{(}\core{#3}\msyn{)}}
+
+\newcommand{\stackedenv}[2][c]{\ensuremath{
+  \begin{array}{#1}
+  #2
+  \end{array}
+}}
+
+% \renewcommand{\nil}{\mathsf{nil}}
+\renewcommand{\nil}{\mathrel\emptyset}
+
+% \newcommand{\ee}{\mathit{ee}}
+\newcommand{\ee}{\mathit{dent}}
+
+\renewcommand{\gets}{\mathbin{\coloneqq}}
\ No newline at end of file
diff --git a/docs/backpack/commands-rebindings.tex b/docs/backpack/commands-rebindings.tex
new file mode 100644
index 000000000000..96ad2bb2cc30
--- /dev/null
+++ b/docs/backpack/commands-rebindings.tex
@@ -0,0 +1,57 @@
+
+
+%% hide the full syntax of shapes/types for the paper
+\newcommand{\fullmsh}[3]{\aoxb{#1 ~\mtypsep~ #2 ~\mtypsep~ #3}}
+\newcommand{\fullmtyp}[3]{
+  \aoxb{\mtypsepsp #1 \mtypsepsp\mtypsep\mtypsepsp
+        #2 \mtypsepsp\mtypsep\mtypsepsp
+        #3 \mtypsepsp}}
+\newcommand{\fullbigmtyp}[3]{\ensuremath{
+  \left\langle\!\vrule \begin{array}{l}
+    #1 ~\mtypsep \\[0pt]
+    #2 ~\mtypsep \\
+    #3
+  \end{array} \vrule\!\right\rangle
+}}
+\renewcommand{\msh}[2]{\aoxb{#1 \mtypsepsp\mtypsep\mtypsepsp #2}}
+\renewcommand{\mtyp}[2]{
+  \aoxb{#1 ~\mtypsep~ #2}}
+\newcommand{\mtypstretch}[2]{
+  \left\langle\!\vrule
+    \mtypsepsp #1 \mtypsepsp\mtypsep\mtypsepsp #2 \mtypsepsp
+  \vrule\!\right\rangle
+}
+\renewcommand{\bigmtyp}[2]{\ensuremath{
+  \left\langle\!\vrule \begin{array}{l}
+    #1 ~\mtypsep \\[0pt] #2
+  \end{array} \vrule\!\right\rangle
+}}
+
+
+
+%% change syntax of signatures
+\renewcommand{\Esig}[1]{\ensuremath{\,[#1]}}
+
+\renewcommandx*{\JBVSh}[3][1=\Delta, usedefault=@]%
+  {#1 \vdashsh #2 \Rightarrow #3}
+
+
+% JUDGMENTS
+\renewcommandx*{\JBTypElab}[6][1=\Delta, 2=\Gamma, 3=\shctx, usedefault=@]%
+  % {\JBTyp[#1][#2][#3]{#4}{#5} \elabto #6}
+  {\JBTyp[#1][#2][#3]{#4}{#5} \;\shade{\elabto #6}}
+\renewcommandx*{\JBVTypElab}[5][1=\Delta, 2=\shctx, usedefault=@]%
+  % {\JBVTyp[#1][#2]{#3}{#4} \elabto #5}
+  {\JBVTyp[#1][#2]{#3}{#4} \;\shade{\elabto #5}}
+\renewcommandx*{\JDTypElab}[4][1=\Delta, usedefault=@]%
+  % {#1 \vdash #2 : #3 \elabto #4}
+  {#1 \vdash #2 : #3 \;\shade{\elabto #4}}
+\renewcommandx*{\JCModElab}[5][1=\Gamma, 2=\nu_0, usedefault=@]%
+  % {#1; #2 \vdashghc #3 : #4 \elabto #5}
+  {#1; #2 \vdashghc #3 : #4 \;\shade{\elabto #5}}
+
+
+%%% Local Variables: 
+%%% mode: latex
+%%% TeX-master: "paper"
+%%% End: 
diff --git a/docs/backpack/diagrams.pdf b/docs/backpack/diagrams.pdf
new file mode 100644
index 000000000000..a50916b23469
Binary files /dev/null and b/docs/backpack/diagrams.pdf differ
diff --git a/docs/backpack/diagrams.xoj b/docs/backpack/diagrams.xoj
new file mode 100644
index 000000000000..acec8d02de7f
Binary files /dev/null and b/docs/backpack/diagrams.xoj differ
diff --git a/docs/backpack/pkgdb.png b/docs/backpack/pkgdb.png
new file mode 100644
index 000000000000..9779444b42e6
Binary files /dev/null and b/docs/backpack/pkgdb.png differ
diff --git a/docs/coding-style.html b/docs/coding-style.html
index 37aaf8dd46b9..6be9263d974c 100644
--- a/docs/coding-style.html
+++ b/docs/coding-style.html
@@ -324,7 +324,7 @@ <h2>Syntactic details</h2>
   #define PROF_INFO(cl) (((StgClosure*)(cl))->header.profInfo)
 
   // polymorphic case
-  // but note that min(min(1,2),3) does 3 comparisions instead of 2!!
+  // but note that min(min(1,2),3) does 3 comparisons instead of 2!!
   #define min(x,y) (((x)<=(y)) ? (x) : (y))
 </pre>
 
diff --git a/docs/comm/exts/ndp.html b/docs/comm/exts/ndp.html
deleted file mode 100644
index 2c79d728d501..000000000000
--- a/docs/comm/exts/ndp.html
+++ /dev/null
@@ -1,360 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
-<html>
-  <head>
-    <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-8859-1">
-    <title>The GHC Commentary - Parallel Arrays</title>
-  </head>
-
-  <body BGCOLOR="FFFFFF">
-    <h1>The GHC Commentary - Parallel Arrays</h1>
-    <p>
-      This section describes an experimental extension by high-performance
-      arrays, which comprises special syntax for array types and array
-      comprehensions, a set of optimising program transformations, and a set
-      of special purpose libraries.  The extension is currently only partially
-      implemented, but the development will be tracked here.
-    <p>
-      Parallel arrays originally got their name from the aim to provide an
-      architecture-independent programming model for a range of parallel
-      computers.  However, since experiments showed that the approach is also
-      worthwhile for sequential array code, the emphasis has shifted to their
-      parallel evaluation semantics: As soon as any element in a parallel
-      array is demanded, all the other elements are evaluated, too.  This
-      makes parallel arrays more strict than <a
-      href="http://haskell.org/onlinelibrary/array.html">standard Haskell 98
-      arrays</a>, but also opens the door for a loop-based implementation
-      strategy that leads to significantly more efficient code.
-    <p>
-      The programming model as well as the use of the <em>flattening
-      transformation</em>, which is central to the approach, has its origin in
-      the programming language <a
-      href="http://www.cs.cmu.edu/~scandal/nesl.html">Nesl</a>.
-
-    <h2>More Sugar: Special Syntax for Array Comprehensions</h2>
-    <p>
-      The option <code>-XParr</code>, which is a dynamic hsc option that can
-      be reversed with <code>-XNoParr</code>, enables special syntax for
-      parallel arrays, which is not essential to using parallel arrays, but
-      makes for significantly more concise programs.  The switch works by
-      making the lexical analyser (located in <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/parser/Lex.lhs"><code>Lex.lhs</code></a>) 
-      recognise the tokens <code>[:</code> and <code>:]</code>.   Given that
-      the additional productions in the parser (located in <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/parser/Parser.y"><code>Parser.y</code></a>) 
-      cannot be triggered without the lexer generating the necessary tokens,
-      there is no need to alter the behaviour of the parser.
-    <p>
-      The following additional syntax is accepted (the non-terminals are those
-      from the <a href="http://haskell.org/onlinereport/">Haskell 98 language
-      definition</a>):
-    <p>
-      <blockquote><pre>
-atype -> '[:' type ':]				     (parallel array type)
-
-aexp  -> '[:' exp1 ',' ... ',' expk ':]'             (explicit array, k >= 0)
-      |  '[:' exp1 [',' exp2] '..' exp3 ':]'	     (arithmetic array sequence)
-      |  '[:' exp '|' quals1 '|' ... '|' qualsn ':]' (array comprehension, n >= 1)
-
-quals -> qual1 ',' ... ',' qualn	             (qualifier list, n >= 1)
-
-apat  -> '[:' pat1 ',' ... ',' patk ':]'	     (array pattern, k >= 0)
-</pre>
-    </blockquote>
-    <p>
-      Moreover, the extended comprehension syntax that allows for <em>parallel
-      qualifiers</em> (i.e., qualifiers separated by "<code>|</code>") is also
-      supported in list comprehensions.  In general, the similarity to the
-      special syntax for list is obvious.  The two main differences are that
-      (a) arithmetic array sequences are always finite and (b)
-      <code>[::]</code> is not treated as a constructor in expressions and
-      patterns, but rather as a special case of the explicit array syntax.
-      The former is a simple consequence of the parallel evaluation semantics
-      of parallel arrays and the latter is due to arrays not being a
-      constructor-based data type.
-    <p>
-      As a naming convention, types and functions that are concerned with
-      parallel arrays usually contain the string <code>parr</code> or
-      <code>PArr</code> (often as a prefix), and where corresponding types or
-      functions for handling lists exist, the name is identical, except for
-      containing the substring <code>parr</code> instead of <code>list</code>
-      (possibly in caps).
-    <p>
-      The following implications are worth noting explicitly:
-    <ul>
-      <li>As the value and pattern <code>[::]</code> is an empty explicit
-	parallel array (i.e., something of the form <code>ExplicitPArr ty
-	[]</code> in the AST).  This is in contrast to lists, which use the
-	nil-constructor instead.  In the case of parallel arrays, using a
-	constructor would be rather awkward, as it is not a constructor-based
-	type. (This becomes rather clear in the desugarer.)
-      <li>As a consequence, array patterns have the general form <code>[:p1,
-	  p2, ..., pn:]</code>, where <code>n</code> >= 0.  Thus, two array
-	patterns overlap iff they have the same length -- an important property
-	for the pattern matching compiler.
-    </ul>
-
-    <h2>Prelude Support for Parallel Arrays</h2>
-    <p>
-      The Prelude module <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/lib/std/PrelPArr.lhs"><code>PrelPArr</code></a>
-      defines the standard operations and their types on parallel arrays and
-      provides a basic implementation based on boxed arrays.  The interface of
-      <code>PrelPArr</code> is oriented by H98's <code>PrelList</code>, but
-      leaving out all functions that require infinite structures and adding
-      frequently needed array operations, such as permutations.  Parallel
-      arrays are quite unqiue in that they use an entirely different
-      representation as soon as the flattening transformation is activated,
-      which is described further below.  In particular, <code>PrelPArr</code>
-      defines the type <code>[::]</code> and operations to create, process,
-      and inspect parallel arrays.  The type as well as the names of some of
-      the operations are also hardwired in <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/prelude/TysWiredIn.lhs"><code>TysWiredIn</code></a>
-      (see the definition of <code>parrTyCon</code> in this module) and <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/prelude/PrelNames.lhs"><code>PrelNames</code></a>.
-      This is again very much like the case of lists, where the type is
-      defined in <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/lib/std/PrelBase.lhs"><code>PrelBase</code></a>
-      and similarly wired in; however, for lists the entirely
-      constructor-based definition is exposed to user programs, which is not
-      the case for parallel arrays.
-
-    <h2>Desugaring Parallel Arrays</h2>
-    <p>
-      The parallel array extension requires the desugarer to replace all
-      occurrences of (1) explicit parallel arrays, (2) array patterns, and (3)
-      array comprehensions by a suitable combination of invocations of
-      operations defined in <code>PrelPArr</code>.
-
-    <h4>Explicit Parallel Arrays</h4>
-    <p>
-      These are by far the simplest to remove.  We simply replace every
-      occurrence of <code>[:<i>e<sub>1</sub></i>, ...,
-      <i>e<sub>n</sub></i>:]</code> by
-    <blockquote>
-      <code>
-	toP [<i>e<sub>1</sub></i>, ..., <i>e<sub>n</sub></i>]
-      </code>
-    </blockquote>
-    <p>
-      i.e., we build a list of the array elements, which is, then, converted
-      into a parallel array.
-
-    <h4>Parallel Array Patterns</h4>
-    <p>
-      Array patterns are much more tricky as element positions may contain
-      further patterns and the <a
-      href="../the-beast/desugar.html#patmat">pattern matching compiler</a>
-      requires us to flatten all those out.  But before we turn to the gory
-      details, here first the basic idea: A flat array pattern matches exactly
-      iff it's length corresponds to the length of the matched array.  Hence,
-      if we have a set of flat array patterns matching an array value
-      <code>a</code>, it suffices to generate a Core <code>case</code>
-      expression that scrutinises <code>lengthP a</code> and has one
-      alternative for every length of array occuring in one of the patterns.
-      Moreover, there needs to be a default case catching all other array
-      lengths.  In each alternative, array indexing (i.e., the functions
-      <code>!:</code>) is used to bind array elements to the corresponding
-      pattern variables.  This sounds easy enough and is essentially what the
-      parallel array equation of the function <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/deSugar/DsUtils.lhs"><code>DsUtils</code></a><code>.mkCoAlgCaseMatchResult</code>
-      does.
-    <p>
-      Unfortunately, however, the pattern matching compiler expects that it
-      can turn (almost) any pattern into variable patterns, literals, or
-      constructor applications by way of the functions <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/deSugar/Match.lhs"><code>Match</code></a><code>.tidy1</code>.
-      And to make matters worse, some weird machinery in the module <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/deSugar/Check.lhs"><code>Check</code></a> 
-      insists on being able to reverse the process (essentially to pretty
-      print patterns in warnings for incomplete or overlapping patterns).
-    <p>
-      The solution to this is an (unlimited) set of <em>fake</em> constructors
-      for parallel arrays, courtesy of <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/prelude/TysWiredIn.lhs"><code>TysWiredIn</code></a><code>.parrFakeCon</code>.  
-      In other words, any pattern of the form <code>[:<i>p<sub>1</sub></i>,
-      ..., <i>p<sub>n</sub></i>:]</code> is transformed into 
-    <blockquote>
-      <code>
-	MkPArray<i>n</i> <i>p<sub>1</sub></i> ... <i>p<sub>n</sub></i>
-      </code>
-    </blockquote>
-    <p>
-      by <code>Match.tidy1</code>, then, run through the rest of the pattern
-      matching compiler, and finally, picked up by
-      <code>DsUtils.mkCoAlgCaseMatchResult</code>, which converts it into a
-      <code>case</code> expression as outlined above.
-    <p>
-      As an example consider the source expression
-    <blockquote><pre>
-case v of
-  [:x1:]         -> e1
-  [:x2, x3, x4:] -> e2
-  _		 -> e3</pre>
-    </blockquote>
-    <p>
-      <code>Match.tidy1</code> converts it into a form that is equivalent to
-    <blockquote><pre>
-case v of {
-  MkPArr1 x1       -> e1;
-  MkPArr2 x2 x3 x4 -> e2;
-  _	           -> e3;
-}</pre>
-    </blockquote>
-    <p>
-      which <code>DsUtils.mkCoAlgCaseMatchResult</code> turns into the
-      following Core code:
-    <blockquote><pre>
-      case lengthP v of
-        Int# i# -> 
-	  case i# of l {
-	    DFT ->					  e3
-	    1   -> let x1 = v!:0                       in e1
-	    3   -> let x2 = v!:0; x2 = v!:1; x3 = v!:2 in e2
-	  }</pre>
-    </blockquote>
-
-    <h4>Parallel Array Comprehensions</h4>
-    <p>
-      The most challenging construct of the three are array comprehensions.
-      In principle, it would be possible to transform them in essentially the
-      same way as list comprehensions, but this would lead to abysmally slow
-      code as desugaring of list comprehensions generates code that is
-      optimised for sequential, constructor-based structures.  In contrast,
-      array comprehensions need to be transformed into code that solely relies
-      on collective operations and avoids the creation of many small
-      intermediate arrays.  
-    <p>
-      The transformation is implemented by the function <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/deSugar/DsListComp.lhs"><code>DsListComp</code></a><code>.dsPArrComp</code>.
-      In the following, we denote this transformation function by the form
-      <code>&lt;&lt;<i>e</i>&gt;&gt; pa ea</code>, where <code><i>e</i></code>
-      is the comprehension to be compiled and the arguments <code>pa</code>
-      and <code>ea</code> denote a pattern and the currently processed array
-      expression, respectively.  The invariant constraining these two
-      arguments is that all elements in the array produced by <code>ea</code>
-      will <em>successfully</em> match against <code>pa</code>.
-    <p>
-      Given a source-level comprehensions <code>[:e | qss:]</code>, we compile
-      it with <code>&lt;&lt;[:e | qss:]&gt;&gt; () [:():]</code> using the
-      rules 
-    <blockquote><pre>
-<<[:e' |           :]>> pa ea = mapP (\pa -> e') ea
-<<[:e' | b     , qs:]>> pa ea = <<[:e' | qs:]>> pa (filterP (\pa -> b) ea)
-<<[:e' | p <- e, qs:]>> pa ea = 
-  let ef = filterP (\x -> case x of {p -> True; _ -> False}) e
-  in
-  <<[:e' | qs:]>> (pa, p) (crossP ea ef)
-<<[:e' | let ds, qs:]>> pa ea = 
-  <<[:e' | qs:]>> (pa, (x_1, ..., x_n)) 
-    	      (mapP (\v@pa -> (v, let ds in (x_1, ..., x_n))) ea)
-where
-  {x_1, ..., x_n} = DV (ds)		-- Defined Variables
-<<[:e' | qs | qss:]>>   pa ea = 
-  <<[:e' | qss:]>> (pa, (x_1, ..., x_n)) 
-    	       (zipP ea <<[:(x_1, ..., x_n) | qs:]>>)
-where
-  {x_1, ..., x_n} = DV (qs)</pre>
-    </blockquote>
-    <p>
-      We assume the denotation of <code>crossP</code> to be given by
-    <blockquote><pre>
-crossP       :: [:a:] -> [:b:] -> [:(a, b):]
-crossP a1 a2  = let
-  		len1 = lengthP a1
-  		len2 = lengthP a2
-  		x1   = concatP $ mapP (replicateP len2) a1
-  		x2   = concatP $ replicateP len1 a2
-  	      in
-  	      zipP x1 x2</pre>
-    </blockquote>
-    <p>
-      For a more efficient implementation of <code>crossP</code>, see
-      <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/lib/std/PrelPArr.lhs"><code>PrelPArr</code></a>.
-    <p>
-      Moreover, the following optimisations are important:
-    <ul>
-      <li>In the <code>p &lt;- e</code> rule, if <code>pa == ()</code>, drop
-	it and simplify the <code>crossP ea e</code> to <code>e</code>.
-      <li>We assume that fusion will optimise sequences of array processing
-	combinators.
-      <li>FIXME: Do we want to have the following function?
-	<blockquote><pre>
-mapFilterP :: (a -> Maybe b) -> [:a:] -> [:b:]</pre>
-	</blockquote>
-	<p>
-	  Even with fusion <code>(mapP (\p -&gt; e) . filterP (\p -&gt;
-	  b))</code> may still result in redundant pattern matching
-	  operations.  (Let's wait with this until we have seen what the
-	  Simplifier does to the generated code.)
-    </ul>
-
-    <h2>Doing Away With Nested Arrays: The Flattening Transformation</h2>
-    <p>
-      On the quest towards an entirely unboxed representation of parallel
-      arrays, the flattening transformation is the essential ingredient.  GHC
-      uses a <a
-      href="http://www.cse.unsw.edu.au/~chak/papers/CK00.html">substantially
-      improved version</a> of the transformation whose original form was
-      described by Blelloch &amp; Sabot.  The flattening transformation
-      replaces values of type <code>[:a:]</code> as well as functions
-      operating on these values by alternative, more efficient data structures
-      and functions.
-    <p>
-      The flattening machinery is activated by the option
-      <code>-fflatten</code>, which is a static hsc option.  It consists of
-      two steps: function vectorisation and array specialisation.  Only the
-      first of those is implemented so far.  If selected, the transformation
-      is applied to a module in Core form immediately after the <a
-      href="../the-beast/desugar.html">desugarer,</a> before the <a
-      href="../the-beast/simplifier.html">Mighty Simplifier</a> gets to do its
-      job.  After vectorisation, the Core program can be dumped using the
-      option <code>-ddump-vect</code>.  The is a good reason for us to perform
-      flattening immediately after the desugarer.  In <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/main/HscMain.lhs"><code>HscMain</code></a><code>.hscRecomp</code>
-      the so-called <em>persistent compiler state</em> is maintained, which
-      contains all the information about imported interface files needed to
-      lookup the details of imported names (e.g., during renaming and type
-      checking).  However, all this information is zapped before the
-      simplifier is invoked (supposedly to reduce the space-consumption of
-      GHC).  As flattening has to get at all kinds of identifiers from Prelude
-      modules, we need to do it before the relevant information in the
-      persistent compiler state is gone.
-
-    <p>
-      As flattening generally requires all libraries to be compiled for
-      flattening (just like profiling does), there is a <em>compiler way</em>
-      <code>"ndp"</code>, which can be selected using the way option code
-      <code>-ndp</code>.  This option will automagically select
-      <code>-XParr</code> and <code>-fflatten</code>. 
-
-    <h4><code>FlattenMonad</code></h4>
-    <p>
-      The module <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/ndpFlatten/FlattenMonad.lhs"><code>FlattenMonad</code></a>
-      implements the monad <code>Flatten</code> that is used during
-      vectorisation to keep track of various sets of bound variables and a
-      variable substitution map; moreover, it provides a supply of new uniques
-      and allows us to look up names in the persistent compiler state (i.e.,
-      imported identifiers).
-    <p>
-      In order to be able to look up imported identifiers in the persistent
-      compiler state, it is important that these identifies are included into
-      the free variable lists computed by the renamer.  More precisely, all
-      names needed by flattening are included in the names produced by
-      <code>RnEnv.getImplicitModuleFVs</code>.  To avoid putting
-      flattening-dependent lists of names into the renamer, the module
-      <code>FlattenInfo</code> exports <code>namesNeededForFlattening</code>.
-
-      [FIXME: It might be worthwhile to document in the non-Flattening part of
-      the Commentary that the persistent compiler state is zapped after
-      desugaring and how the free variables determined by the renamer imply
-      which names are imported.]
-    
-    <p><small>
-<!-- hhmts start -->
-Last modified: Tue Feb 12 01:44:21 EST 2002
-<!-- hhmts end -->
-    </small>
-  </body>
-</html>
diff --git a/docs/comm/exts/th.html b/docs/comm/exts/th.html
deleted file mode 100644
index 539245db7469..000000000000
--- a/docs/comm/exts/th.html
+++ /dev/null
@@ -1,197 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
-<html>
-  <head>
-    <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-8859-1">
-    <title>The GHC Commentary - Template Haskell</title>
-  </head>
-
-  <body BGCOLOR="FFFFFF">
-    <h1>The GHC Commentary - Template Haskell</h1>
-    <p>
-      The Template Haskell (TH) extension to GHC adds a meta-programming
-      facility in which all meta-level code is executed at compile time.  The
-      design of this extension is detailed in "Template Meta-programming for
-      Haskell", Tim Sheard and Simon Peyton Jones, <a
-      href="http://portal.acm.org/toc.cfm?id=581690&type=proceeding&coll=portal&dl=ACM&part=series&WantType=proceedings&idx=unknown&title=unknown">ACM
-      SIGPLAN 2002 Haskell Workshop,</a> 2002.  However, some of the details
-      changed after the paper was published.
-    </p>
-
-    <h2>Meta Sugar</h2>
-    <p>
-      The extra syntax of TH (quasi-quote brackets, splices, and reification)
-      is handled in the module <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/deSugar/DsMeta.hs"><code>DsMeta</code></a>.
-      In particular, the function <code>dsBracket</code> desugars the four
-      types of quasi-quote brackets (<code>[|...|]</code>,
-      <code>[p|...|]</code>, <code>[d|...|]</code>, and <code>[t|...|]</code>)
-      and <code>dsReify</code> desugars the three types of reification
-      operations (<code>reifyType</code>, <code>reifyDecl</code>, and
-      <code>reifyFixity</code>).
-    </p>
-
-    <h3>Desugaring of Quasi-Quote Brackets</h3>
-    <p>
-      A term in quasi-quote brackets needs to be translated into Core code
-      that, when executed, yields a <em>representation</em> of that term in
-      the form of the abstract syntax trees defined in <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/libraries/template-haskell/Language/Haskell/TH/Syntax.hs"><code>Language.Haskell.TH.Syntax</code></a>.
-      Within <code>DsMeta</code>, this is achieved by four functions
-      corresponding to the four types of quasi-quote brackets:
-      <code>repE</code> (for <code>[|...|]</code>), <code>repP</code> (for
-      <code>[p|...|]</code>), <code>repTy</code> (for <code>[t|...|]</code>),
-      and <code>repTopDs</code> (for <code>[d|...|]</code>).  All four of
-      these functions receive as an argument the GHC-internal Haskell AST of
-      the syntactic form that they quote (i.e., arguments of type <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/hsSyn/HsExpr.lhs"><code>HsExpr</code></a><code>.HsExpr
-	Name</code>, <a href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/hsSyn/HsPat.lhs"><code>HsPat</code></a><code>.HsPat Name</code>, 
-      <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/hsSyn/HsTypes.lhs"><code>HsType</code></a><code>.HsType 
-	Name</code>, and <a
-	href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/hsSyn/HsDecls.lhs"><code>HsDecls</code></a><code>.HsGroup 
-	Name</code>, respectively). 
-    </p>
-    <p>
-      To increase the static type safety in <code>DsMeta</code>, the functions
-      constructing representations do not just return plain values of type <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/coreSyn/CoreSyn.lhs"><code>CoreSyn</code></a>
-      <code>.CoreExpr</code>; instead, <code>DsMeta</code> introduces a
-      parametrised type <code>Core</code> whose dummy type parameter indicates
-      the source-level type of the value computed by the corresponding Core
-      expression.  All construction of Core fragments in <code>DsMeta</code>
-      is performed by smart constructors whose type signatures use the dummy
-      type parameter to constrain the contexts in which they are applicable.
-      For example, a function that builds a Core expression that evaluates to
-      a TH type representation, which has type
-      <code>Language.Haskell.TH.Syntax.Type</code>, would return a value of
-      type 
-    </p>
-    <blockquote>
-      <pre>
-Core Language.Haskell.TH.Syntax.Type</pre>
-    </blockquote>
-
-    <h3>Desugaring of Reification Operators</h3>
-    <p>
-      The TH paper introduces four reification operators:
-      <code>reifyType</code>, <code>reifyDecl</code>,
-      <code>reifyFixity</code>, and <code>reifyLocn</code>.  Of these,
-      currently (= 9 Nov 2002), only the former two are implemented.
-    </p>
-    <p>
-      The operator <code>reifyType</code> receives the name of a function or
-      data constructor as its argument and yields a representation of this
-      entity's type in the form of a value of type
-      <code>TH.Syntax.Type</code>.  Similarly, <code>reifyDecl</code> receives
-      the name of a type and yields a representation of the type's declaration
-      as a value of type <code>TH.Syntax.Decl</code>.  The name of the reified
-      entity is mapped to the GHC-internal representation of the entity by
-      using the function <code>lookupOcc</code> on the name.
-    </p>
-    
-    <h3>Representing Binding Forms</h3>
-    <p>
-      Care needs to be taken when constructing TH representations of Haskell
-      terms that include binding forms, such as lambda abstractions or let
-      bindings.  To avoid name clashes, fresh names need to be generated for
-      all defined identifiers.  This is achieved via the routine
-      <code>DsMeta.mkGenSym</code>, which, given a <code>Name</code>, produces
-      a <code>Name</code> / <code>Id</code> pair (of type
-      <code>GenSymBind</code>) that associates the given <code>Name</code>
-      with a Core identifier that at runtime will be bound to a string that
-      contains the fresh name.  Notice the two-level nature of this
-      arrangement.  It is necessary, as the Core code that constructs the
-      Haskell term representation may be executed multiple types at runtime
-      and it must be ensured that different names are generated in each run.
-    </p>
-    <p>
-      Such fresh bindings need to be entered into the meta environment (of
-      type <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/deSugar/DsMonad.lhs"><code>DsMonad</code></a><code>.DsMetaEnv</code>),
-      which is part of the state (of type <code>DsMonad.DsEnv</code>)
-      maintained in the desugarer monad (of type <code>DsMonad.DsM</code>).
-      This is done using the function <code>DsMeta.addBinds</code>, which
-      extends the current environment by a list of <code>GenSymBind</code>s
-      and executes a subcomputation in this extended environment.  Names can
-      be looked up in the meta environment by way of the functions
-      <code>DsMeta.lookupOcc</code> and <code>DsMeta.lookupBinder</code>; more
-      details about the difference between these two functions can be found in
-      the next subsection.
-    </p>
-    <p>
-      NB: <code>DsMeta</code> uses <code>mkGenSym</code> only when
-      representing terms that may be embedded into a context where names can
-      be shadowed.  For example, a lambda abstraction embedded into an
-      expression can potentially shadow names defined in the context it is
-      being embedded into.  In contrast, this can never be the case for
-      top-level declarations, such as data type declarations; hence, the type
-      variables that a parametric data type declaration abstracts over are not
-      being gensym'ed.  As a result, variables in defining positions are
-      handled differently depending on the syntactic construct in which they
-      appear. 
-    </p>
-
-    <h3>Binders Versus Occurrences</h3>
-    <p>
-      Name lookups in the meta environment of the desugarer use two functions
-      with slightly different behaviour, namely <code>DsMeta.lookupOcc</code>
-      and <code>lookupBinder</code>.  The module <code>DsMeta</code> contains
-      the following explanation as to the difference of these functions:
-    </p>
-    <blockquote>
-      <pre>
-When we desugar [d| data T = MkT |]
-we want to get
-	Data "T" [] [Con "MkT" []] []
-and *not*
-	Data "Foo:T" [] [Con "Foo:MkT" []] []
-That is, the new data decl should fit into whatever new module it is
-asked to fit in.   We do *not* clone, though; no need for this:
-	Data "T79" ....
-
-But if we see this:
-	data T = MkT 
-	foo = reifyDecl T
-
-then we must desugar to
-	foo = Data "Foo:T" [] [Con "Foo:MkT" []] []
-
-So in repTopDs we bring the binders into scope with mkGenSyms and addBinds,
-but in dsReify we do not.  And we use lookupOcc, rather than lookupBinder
-in repTyClD and repC.</pre>
-    </blockquote>
-    <p>
-      This implies that <code>lookupOcc</code>, when it does not find the name
-      in the meta environment, uses the function <code>DsMeta.globalVar</code>
-      to construct the <em>original name</em> of the entity (cf. the TH paper
-      for more details regarding original names).  This name uniquely
-      identifies the entity in the whole program and is in scope
-      <em>independent</em> of whether the user name of the same entity is in
-      scope or not (i.e., it may be defined in a different module without
-      being explicitly imported) and has the form &lt;module&gt;:&lt;name&gt;.
-      <strong>NB:</strong> Incidentally, the current implementation of this
-      mechanisms facilitates breaking any abstraction barrier.
-    </p>
-    
-    <h3>Known-key Names for Template Haskell</h3>
-    <p>
-      During the construction of representations, the desugarer needs to use a
-      large number of functions defined in the library
-      <code>Language.Haskell.TH.Syntax</code>.  The names of these functions
-      need to be made available to the compiler in the way outlined <a
-      href="../the-beast/prelude.html">Primitives and the Prelude.</a>
-      Unfortunately, any change to <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/prelude/PrelNames.lhs"><code>PrelNames</code></a>
-      triggers a significant amount of recompilation.  Hence, the names needed
-      for TH are defined in <code>DsMeta</code> instead (at the end of the
-      module).  All library functions needed by TH are contained in the name
-      set <code>DsMeta.templateHaskellNames</code>.
-    </p>
-    
-    <p><small>
-<!-- hhmts start -->
-Last modified: Wed Nov 13 18:01:48 EST 2002
-<!-- hhmts end -->
-    </small>
-  </body>
-</html>
diff --git a/docs/comm/feedback.html b/docs/comm/feedback.html
deleted file mode 100644
index 1da8b10f2927..000000000000
--- a/docs/comm/feedback.html
+++ /dev/null
@@ -1,34 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
-<html>
-  <head>
-    <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-8859-1">
-    <title>The GHC Commentary - Feedback</title>
-  </head>
-
-  <body BGCOLOR="FFFFFF">
-    <h1>Feedback</h1>
-    <p>
-      <a href="mailto:chak@cse.unsw.edu.au">I</a> welcome any feedback on the
-      material and in particular would appreciated comments on which parts of
-      the document are incomprehensible or miss explanation -- e.g., due to
-      the use of GHC speak that is explained nowhere (words like infotable or
-      so).  Moreover, I would be interested to know which areas of GHC you
-      would like to see covered here.
-    <p>
-      For the moment is probably best if feedback is directed to 
-    <p>
-    <blockquote>
-      <a
-	 href="mailto:chak@cse.unsw.edu.au"><code>chak@cse.unsw.edu.au</code></a>
-    </blockquote>
-    <p>
-      However, if there is sufficient interest, we might consider setting up a
-      mailing list.
-
-    <p><small>
-<!-- hhmts start -->
-Last modified: Wed Aug  8 00:11:42 EST 2001
-<!-- hhmts end -->
-    </small>
-  </body>
-</html>
diff --git a/docs/comm/genesis/genesis.html b/docs/comm/genesis/genesis.html
deleted file mode 100644
index 2ccdf5353a79..000000000000
--- a/docs/comm/genesis/genesis.html
+++ /dev/null
@@ -1,82 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
-<html>
-  <head>
-    <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-8859-1">
-    <title>The GHC Commentary - Outline of the Genesis</title>
-  </head>
-
-  <body BGCOLOR="FFFFFF">
-    <h1>The GHC Commentary - Outline of the Genesis</h1>
-    <p>
-      Building GHC happens in two stages: First you have to prepare the tree
-      with <code>make boot</code>; and second, you build the compiler and
-      associated libraries with <code>make all</code>.  The <code>boot</code>
-      stage builds some tools used during the main build process, generates
-      parsers and other pre-computed source, and finally computes dependency
-      information.  There is considerable detail on the build process in GHC's
-      <a
-	href="http://ghc.haskell.org/trac/ghc/wiki/Building">Building Guide.</a>
-
-    <h4>Debugging the Beast</h4>
-    <p>
-      If you are hacking the compiler or like to play with unstable
-      development versions, chances are that the compiler someday just crashes
-      on you.  Then, it is a good idea to load the <code>core</code> into
-      <code>gdb</code> as usual, but unfortunately there is usually not too
-      much useful information.
-    <p>
-      The next step, then, is somewhat tedious.  You should build a compiler
-      producing programs with a runtime system that has debugging turned on
-      and use that to build the crashing compiler.  There are many sanity
-      checks in the RTS, which may detect inconsistency before they lead to a
-      crash and you may include more debugging information, which helps
-      <code>gdb.</code>  For a RTS with debugging turned on, add the following
-      to <code>build.mk</code> (see also the comment in
-      <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/mk/config.mk.in"><code>config.mk.in</code></a> that you find when searching for
-      <code>GhcRtsHcOpts</code>):
-<blockquote><pre>
-GhcRtsHcOpts+=-optc-DDEBUG
-GhcRtsCcOpts+=-g
-EXTRA_LD_OPTS=-lbfd -liberty</pre></blockquote>
-    <p>
-      Then go into <code>fptools/ghc/rts</code> and <code>make clean boot &&
-      make all</code>.  With the resulting runtime system, you have to re-link
-      the compiler.  Go into <code>fptools/ghc/compiler</code>, delete the
-      file <code>hsc</code> (up to version 4.08) or
-      <code>ghc-&lt;version&gt;</code>, and execute <code>make all</code>.
-    <p>
-      The <code>EXTRA_LD_OPTS</code> are necessary as some of the debugging
-      code uses the BFD library, which in turn requires <code>liberty</code>.
-      I would also recommend (in 4.11 and from 5.0 upwards) adding these linker
-      options to the files <code>package.conf</code> and
-      <code>package.conf.inplace</code> in the directory
-      <code>fptools/ghc/driver/</code> to the <code>extra_ld_opts</code> entry
-      of the package <code>RTS</code>.  Otherwise, you have to supply them
-      whenever you compile and link a program with a compiler that uses the
-      debugging RTS for the programs it produces.
-    <p>
-      To run GHC up to version 4.08 in <code>gdb</code>, first invoke the
-      compiler as usual, but pass it the option <code>-v</code>.  This will
-      show you the exact invocation of the compiler proper <code>hsc</code>.
-      Run <code>hsc</code> with these options in <code>gdb</code>.  The
-      development version 4.11 and stable releases from 5.0 on do no longer
-      use the Perl driver; so, you can run them directly with gdb.
-    <p>
-      <strong>Debugging a compiler during building from HC files.</strong> 
-      If you are boot strapping the compiler on new platform from HC files and
-      it crashes somewhere during the build (e.g., when compiling the
-      libraries), do as explained above, but you may have to re-configure the
-      build system with <code>--enable-hc-boot</code> before re-making the
-      code in <code>fptools/ghc/driver/</code>.
-      If you do this with a compiler up to version 4.08, run the build process
-      with <code>make EXTRA_HC_OPTS=-v</code> to get the exact arguments with
-      which you have to invoke <code>hsc</code> in <code>gdb</code>.
-
-    <p><small>
-<!-- hhmts start -->
-Last modified: Sun Apr 24 22:16:30 CEST 2005
-<!-- hhmts end -->
-    </small>
-  </body>
-</html>
diff --git a/docs/comm/genesis/makefiles.html b/docs/comm/genesis/makefiles.html
deleted file mode 100644
index 7f01fb53acad..000000000000
--- a/docs/comm/genesis/makefiles.html
+++ /dev/null
@@ -1,51 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
-<html>
-  <head>
-    <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-8859-1">
-    <title>The GHC Commentary - Mindboggling Makefiles</title>
-  </head>
-
-  <body BGCOLOR="FFFFFF">
-    <h1>The GHC Commentary - Mindboggling Makefiles</h1>
-    <p>
-      The size and structure of GHC's makefiles makes it quite easy to scream
-      out loud - in pain - during the process of tracking down problems in the
-      make system or when attempting to alter it.  GHC's <a
-	href="http://ghc.haskell.org/trac/ghc/wiki/Building">Building
-	Guide</a> has valuable information on <a
-	href="http://ghc.haskell.org/trac/ghc/wiki/Building/BuildSystem">the
-	makefile architecture.</a>
-
-    <h4>A maze of twisty little passages, all alike</h4>
-    <p>
-      The <code>fptools/</code> toplevel and the various project directories
-      contain not only a <code>Makefile</code> each, but there are
-      subdirectories of name <code>mk/</code> at various levels that contain
-      rules, targets, and so on specific to a project - or, in the case of the
-      toplevel, the default rules for the whole system.  Each <code>mk/</code>
-      directory contains a file <code>boilerplate.mk</code> that ties the
-      various other makefiles together.  Files called <code>target.mk</code>,
-      <code>paths.mk</code>, and <code>suffix.mk</code> contain make targets,
-      definitions of variables containing paths, and suffix rules,
-      respectively.
-    <p>
-      One particularly nasty trick used in this hierarchy of makefiles is the
-      way in which the variable <code>$(TOP)</code> is used.  AFAIK,
-      <code>$(TOP)</code> always points to a directory containing an
-      <code>mk/</code> subdirectory; however, it not necessarily points to the
-      toplevel <code>fptools/</code> directory.  For example, within the GHC
-      subtree, <code>$(TOP)</code> points to <code>fptools/ghc/</code>.
-      However, some of the makefiles in <code>fptools/ghc/mk/</code> will then
-      <em>temporarily</em> redefine <code>$(TOP)</code> to point a level
-      higher (i.e., to <code>fptools/</code>) while they are including the
-      toplevel boilerplate.  After that <code>$(TOP)</code> is redefined to
-      whatever value it had before including makefiles from higher up in the
-      hierarchy. 
-
-    <p><small>
-<!-- hhmts start -->
-Last modified: Wed Aug 22 16:46:33 GMT Daylight Time 2001
-<!-- hhmts end -->
-    </small>
-  </body>
-</html>
diff --git a/docs/comm/genesis/modules.html b/docs/comm/genesis/modules.html
deleted file mode 100644
index 10cd7a8490a9..000000000000
--- a/docs/comm/genesis/modules.html
+++ /dev/null
@@ -1,164 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
-<html>
-  <head>
-    <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-8859-1">
-    <title>The GHC Commentary - The Marvellous Module Structure of GHC </title>
-  </head>
-
-  <body BGCOLOR="FFFFFF">
-    <h1>The GHC Commentary - The Marvellous Module Structure of GHC </h1>
-    <p>
-
-GHC is built out of about 245 Haskell modules.  It can be quite tricky
-to figure out what the module dependency graph looks like.  It can be
-important, too, because loops in the module dependency graph need to 
-be broken carefully using <tt>.hi-boot</tt> interface files.
-<p>
-This section of the commentary documents the subtlest part of
-the module dependency graph, namely the part near the bottom.
-<ul>
-<li> The list is given in compilation order: that is,
-module near the top are more primitive, and are compiled earlier.
-<li> Each module is listed together with its most critical 
-dependencies in parentheses; that is, the dependencies that prevent it being
-compiled earlier.  
-<li> Modules in the same bullet don't depend on each other.
-<li> Loops are documented by a dependency such as "<tt>loop Type.Type</tt>".
-This means tha the module imports <tt>Type.Type</tt>, but module <tt>Type</tt>
-has not yet been compiled, so the import comes from <tt>Type.hi-boot</tt>.
-</ul>
-
-Compilation order is as follows:
-<ul>
-<li>
-<strong>First comes a layer of modules that have few interdependencies,
-and which implement very basic data types</strong>:
-<tt> <ul>
-<li> Util
-<li> OccName
-<li> Pretty
-<li> Outputable
-<li> StringBuffer
-<li> ListSetOps
-<li> Maybes
-<li> etc
-</ul> </tt>
-
-<p> 
-<li> <strong> Now comes the main subtle layer, involving types, classes, type constructors
-identifiers, expressions, rules, and their operations.</strong>
-
-<tt>
-<ul>
-<li>	Name <br> PrimRep
-<p><li>
-	PrelNames
-<p><li>
-	Var (Name, loop IdInfo.IdInfo, 
-	     loop Type.Type, loop Type.Kind)
-<p><li>
-	VarEnv, VarSet, ThinAir
-<p><li>
-	Class (loop TyCon.TyCon, loop Type.Type)
-<p><li>
-	TyCon (loop Type.Type, loop Type.Kind, loop DataCon.DataCon, loop Generics.GenInfo)
-<p><li>
-	TypeRep (loop DataCon.DataCon, loop Subst.substTyWith)
-<p><li>
-	Type (loop PprType.pprType, loop Subst.substTyWith)
-<p><li>
-	FieldLabel(Type) <br> 
-	TysPrim(Type) <br> 
-<p><li>
-	Literal (TysPrim, PprType) <br> 
-	DataCon (loop PprType, loop Subst.substTyWith, FieldLabel.FieldLabel)
-<p><li>
-	TysWiredIn (loop MkId.mkDataConIds)
-<p><li>
-	TcType( lots of TysWiredIn stuff)
-<p><li>
-	PprType( lots of TcType stuff )
-<p><li>
-	PrimOp (PprType, TysWiredIn)
-<p><li>
-	CoreSyn [does not import Id]
-<p><li>
-	IdInfo (CoreSyn.Unfolding, CoreSyn.CoreRules)
-<p><li>
-	Id (lots from IdInfo)
-<p><li>
-	CoreFVs <br>
-	PprCore
-<p><li>
-	CoreUtils (PprCore.pprCoreExpr, CoreFVs.exprFreeVars,
-		   CoreSyn.isEvaldUnfolding CoreSyn.maybeUnfoldingTemplate)
-<p><li>	
-	CoreLint( CoreUtils ) <br>
-	OccurAnal (CoreUtils.exprIsTrivial) <br>
-	CoreTidy (CoreUtils.exprArity ) <br>
-<p><li>
-	CoreUnfold (OccurAnal.occurAnalyseGlobalExpr)
-<p><li>
-	Subst (CoreUnfold.Unfolding, CoreFVs)  <br>
-	Generics (CoreUnfold.mkTopUnfolding) <br>
-	Rules (CoreUnfold.Unfolding, PprCore.pprTidyIdRules)
-<p><li>
-	MkId (CoreUnfold.mkUnfolding, Subst, Rules.addRule)
-<p><li>
-	PrelInfo (MkId)  <br>
-	HscTypes( Rules.RuleBase )
-</ul></tt>
-
-<p><li> <strong>That is the end of the infrastructure. Now we get the 
-	main layer of modules that perform useful work.</strong>
-
-<tt><ul>
-<p><li>
-	CoreTidy (HscTypes.PersistentCompilerState)
-</ul></tt>
-</ul>
-
-HsSyn stuff
-<ul> 
-<li> HsPat.hs-boot
-<li> HsExpr.hs-boot (loop HsPat.LPat)
-<li> HsTypes (loop HsExpr.HsSplice)
-<li> HsBinds (HsTypes.LHsType, loop HsPat.LPat, HsExpr.pprFunBind and others)
-     HsLit (HsTypes.SyntaxName)
-<li> HsPat (HsBinds, HsLit)
-     HsDecls (HsBinds)
-<li> HsExpr (HsDecls, HsPat)
-</ul>
-
-
-
-<h2>Library stuff: base package</h2>
-
-<ul> 
-<li> GHC.Base
-<li> Data.Tuple (GHC.Base), GHC.Ptr (GHC.Base)
-<li> GHC.Enum (Data.Tuple)
-<li> GHC.Show (GHC.Enum)
-<li> GHC.Num (GHC.Show)
-<li> GHC.ST (GHC.Num), GHC.Real (GHC.Num)
-<li> GHC.Arr (GHC.ST) GHC.STRef (GHC.ST)
-<li> GHC.IOBase (GHC.Arr)
-<li> Data.Bits (GHC.Real)
-<li> Data.HashTable (Data.Bits, Control.Monad)
-<li> Data.Typeable (GHC.IOBase, Data.HashTable)
-<li> GHC.Weak (Data.Typeable, GHC.IOBase)
-</ul>
-
-
-    <p><small>
-<!-- hhmts start -->
-Last modified: Wed Aug 22 16:46:33 GMT Daylight Time 2001
-<!-- hhmts end -->
-    </small>
-  </body>
-</html>
-
-
-
-
-
diff --git a/docs/comm/index.html b/docs/comm/index.html
deleted file mode 100644
index 64b9d81ff1c0..000000000000
--- a/docs/comm/index.html
+++ /dev/null
@@ -1,121 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
-<html>
-  <head>
-    <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-8859-1">
-    <title>The GHC Commentary - The Beast Explained</title>
-  </head>
-
-  <body BGCOLOR="FFFFFF">
-    <h1>The Glasgow Haskell Compiler (GHC) Commentary [v0.17]</h1>
-    <p>
-      <!-- Contributors: Whoever makes substantial additions or changes to the
-      document, please add your name and keep the order alphabetic.  Moreover,
-      please bump the version number for any substantial modification that you
-      check into CVS.
-      -->
-      <strong>Manuel M. T. Chakravarty</strong><br>
-      <strong>Sigbjorn Finne</strong><br>
-      <strong>Simon Marlow</strong><br>
-      <strong>Simon Peyton Jones</strong><br>
-      <strong>Julian Seward</strong><br>
-      <strong>Reuben Thomas</strong><br>
-      &nbsp;<br>
-    <p>
-      This document started as a collection of notes describing what <a
-      href="mailto:chak@cse.unsw.edu.au">I</a> learnt when poking around in
-      the <a href="http://haskell.org/ghc/">GHC</a> sources.  During the
-      <i>Haskell Implementers Workshop</i> in January 2001, it was decided to
-      put the commentary into 
-      <a href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/">GHC's CVS
-	repository</a>
-      to allow the whole developer community to add their wizardly insight to
-      the document.
-    <p>
-      <strong>The document is still far from being complete - help it
-      grow!</strong> 
-
-    <h2>Before the Show Begins</h2>
-    <p>
-    <ul>
-      <li><a href="feedback.html">Feedback</a>
-      <li><a href="others.html">Other Sources of Wisdom</a>
-    </ul>
-
-    <h2>Genesis</h2>
-    <p>
-    <ul>
-      <li><a href="genesis/genesis.html">Outline of the Genesis</a>
-      <li><a href="genesis/makefiles.html">Mindboggling Makefiles</a>
-      <li><a href="genesis/modules.html">GHC's Marvellous Module Structure</a>
-    </ul>
-
-    <h2>The Beast Dissected</h2>
-    <p>
-    <ul>
-      <li><a href="the-beast/coding-style.html">Coding style used in
-      the compiler</a>
-      <li><a href="the-beast/driver.html">The Glorious Driver</a>
-      <li><a href="the-beast/prelude.html">Primitives and the Prelude</a>
-      <li><a href="the-beast/syntax.html">Just Syntax</a>
-      <li><a href="the-beast/basicTypes.html">The Basics</a>
-      <li><a href="the-beast/modules.html">Modules, ModuleNames and
-	  Packages</a> 
-      <li><a href="the-beast/names.html">The truth about names: Names and OccNames</a> 
-      <li><a href="the-beast/vars.html">The Real Story about Variables, Ids,
-	  TyVars, and the like</a> 
-      <li><a href="the-beast/data-types.html">Data types and constructors</a> 
-      <li><a href="the-beast/renamer.html">The Glorious Renamer</a>
-      <li><a href="the-beast/types.html">Hybrid Types</a>
-      <li><a href="the-beast/typecheck.html">Checking Types</a>
-      <li><a href="the-beast/desugar.html">Sugar Free: From Haskell To Core</a>
-      <li><a href="the-beast/simplifier.html">The Mighty Simplifier</a>
-      <li><a href="the-beast/mangler.html">The Evil Mangler</a>
-      <li><a href="the-beast/alien.html">Alien Functions</a>
-      <li><a href="the-beast/stg.html">You Got Control: The STG-language</a>
-      <li><a href="the-beast/ncg.html">The Native Code Generator</a>
-      <li><a href="the-beast/ghci.html">GHCi</a>
-      <li><a href="the-beast/fexport.html">Implementation of
-                                           <code>foreign export</code></a>
-      <li><a href="the-beast/main.html">Compiling and running the Main module</code></a>
-    </ul>
-
-    <h2>RTS &amp; Libraries</h2>
-    <p>
-    <ul>
-      <li><a href="http://ghc.haskell.org/trac/ghc/wiki/Commentary/Rts/Conventions">Coding Style Guidelines</a>
-      <li><a href="rts-libs/stgc.html">Spineless Tagless C</a>
-      <li><a href="rts-libs/primitives.html">Primitives</a>
-      <li><a href="rts-libs/prelfound.html">Prelude Foundations</a>
-      <li><a href="rts-libs/prelude.html">Cunning Prelude Code</a>
-      <li><a href="rts-libs/foreignptr.html">On why we have <tt>ForeignPtr</tt></a> 
-      <li><a href="rts-libs/non-blocking.html">Non-blocking I/O for Win32</a>
-      <li><a href="rts-libs/multi-thread.html">Supporting multi-threaded interoperation</a>
-    </ul>
-
-    <h2>Extensions, or Making a Complicated System More Complicated</h2>
-    <p>
-    <ul>
-      <li><a href="exts/th.html">Template Haskell</a>
-      <li><a href="exts/ndp.html">Parallel Arrays</a>
-    </ul>
-
-    <h2>The Source</h2>
-    <p>
-      The online master copy of the Commentary is at
-    <blockquote>
-      <a href="http://www.cse.unsw.edu.au/~chak/haskell/ghc/comm/">http://www.cse.unsw.edu.au/~chak/haskell/ghc/comm/</a>
-    </blockquote>
-    <p>
-      This online version is updated 
-      <a
-	 href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/docs/comm/">from 
-	CVS</a>
-      daily.
-
-    <p><small>
-<!-- hhmts start -->
-Last modified: Thu May 12 19:03:42 EST 2005
-<!-- hhmts end -->
-    </small>
-  </body>
-</html>
diff --git a/docs/comm/others.html b/docs/comm/others.html
deleted file mode 100644
index 52d87e941942..000000000000
--- a/docs/comm/others.html
+++ /dev/null
@@ -1,60 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
-<html>
-  <head>
-    <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-8859-1">
-    <title>The GHC Commentary - Other Sources of Wisdom</title>
-  </head>
-
-  <body BGCOLOR="FFFFFF">
-    <h1>Other Sources of Wisdom</h1>
-    <p>
-      Believe it or not, but there are other people besides you who are
-      masochistic enough to study the innards of the beast.  Some of the have
-      been kind (or cruel?) enough to share their insights with us.  Here is a
-      probably incomplete list:
-    <p>
-    <ul>
-
-      <li>The <a
-      href="http://www.cee.hw.ac.uk/~dsg/gph/docs/StgSurvival.ps.gz">STG
-	  Survival Sheet</a> has -- according to its header -- been written by
-	  `a poor wee soul',<sup><a href="#footnote1">1</a></sup> which
-	  probably has been pushed into the torments of madness by the very
-	  act of contemplating the inner workings of the STG runtime system.
-	  This document discusses GHC's runtime system with a focus on
-	  support for parallel processing (aka GUM).
-
-      <li>Instructions on <a
-      href="http://www-users.cs.york.ac.uk/~olaf/PUBLICATIONS/extendGHC.html">Adding 
-	  an Optimisation Pass to the Glasgow Haskell Compiler</a> 
-	have been compiled by <a
-	href="http://www-users.cs.york.ac.uk/~olaf/">Olaf Chitil</a>.
-	Unfortunately, this document is already a little aged.
-
-      <li><a href="http://www.cs.pdx.edu/~apt/">Andrew Tolmach</a> has defined 
-	<a href="http://www.haskell.org/ghc/docs/papers/core.ps.gz">an external
-	  representation of
-	  GHC's <em>Core</em> language</a> and also implemented a GHC pass
-	that emits the intermediate form into <code>.hcr</code> files.  The
-	option <code>-fext-core</code> triggers GHC to emit Core code after
-	optimisation; in addition, <code>-fno-code</code> is often used to
-	stop compilation after Core has been emitted.
-
-	<!-- Add references to other background texts listed on the GHC docu
-	page 
-	-->
-
-    </ul>
-
-    <p><hr><p>
-      <sup><a name="footnote1">1</a></sup>Usually reliable sources have it that
-      the poor soul in question is no one less than GUM hardcore hacker <a
-      href="http://www.cee.hw.ac.uk/~hwloidl/">Hans-Wolfgang Loidl</a>.
-
-    <p><small>
-<!-- hhmts start -->
-Last modified: Tue Nov 13 10:56:57 EST 2001
-<!-- hhmts end -->
-    </small>
-  </body>
-</html>
diff --git a/docs/comm/rts-libs/foreignptr.html b/docs/comm/rts-libs/foreignptr.html
deleted file mode 100644
index febe9fe422ba..000000000000
--- a/docs/comm/rts-libs/foreignptr.html
+++ /dev/null
@@ -1,68 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
-<html>
-  <head>
-    <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-8859-1">
-    <title>The GHC Commentary - why we have <tt>ForeignPtr</tt></title>
-  </head>
-
-  <body BGCOLOR="FFFFFF">
-
-    <h1>On why we have <tt>ForeignPtr</tt></h1>
-
-    <p>Unfortunately it isn't possible to add a finalizer to a normal
-    <tt>Ptr a</tt>.  We already have a generic finalization mechanism:
-    see the Weak module in package lang.  But the only reliable way to
-    use finalizers is to attach one to an atomic heap object - that
-    way the compiler's optimiser can't interfere with the lifetime of
-    the object.
-
-    <p>The <tt>Ptr</tt> type is really just a boxed address - it's
-    defined like
-
-    <pre>
-data Ptr a = Ptr Addr#
-</pre>
-
-    <p>where <tt>Addr#</tt> is an unboxed native address (just a 32-
-    or 64- bit word).  Putting a finalizer on a <tt>Ptr</tt> is
-    dangerous, because the compiler's optimiser might remove the box
-    altogether.
-
-    <p><tt>ForeignPtr</tt> is defined like this
-
-    <pre>
-data ForeignPtr a = ForeignPtr ForeignObj#
-</pre>
-
-    <p>where <tt>ForeignObj#</tt> is a *boxed* address, it corresponds
-    to a real heap object.  The heap object is primitive from the
-    point of view of the compiler - it can't be optimised away.  So it
-    works to attach a finalizer to the <tt>ForeignObj#</tt> (but not
-    to the <tt>ForeignPtr</tt>!).
-
-    <p>There are several primitive objects to which we can attach
-    finalizers: <tt>MVar#</tt>, <tt>MutVar#</tt>, <tt>ByteArray#</tt>,
-    etc.  We have special functions for some of these: eg.
-    <tt>MVar.addMVarFinalizer</tt>.
-
-    <p>So a nicer interface might be something like
-
-<pre>
-class Finalizable a where
-   addFinalizer :: a -> IO () -> IO ()
-
-instance Finalizable (ForeignPtr a) where ...
-instance Finalizable (MVar a) where ...
-</pre>
-
-    <p>So you might ask why we don't just get rid of <tt>Ptr</tt> and
-    rename <tt>ForeignPtr</tt> to <tt>Ptr</tt>.  The reason for that
-    is just efficiency, I think.
-
-    <p><small>
-<!-- hhmts start -->
-Last modified: Wed Sep 26 09:49:37 BST 2001
-<!-- hhmts end -->
-    </small>
-  </body>
-</html>
diff --git a/docs/comm/rts-libs/multi-thread.html b/docs/comm/rts-libs/multi-thread.html
deleted file mode 100644
index 67a544be8598..000000000000
--- a/docs/comm/rts-libs/multi-thread.html
+++ /dev/null
@@ -1,445 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
-<html>
-<head>
-    <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-8859-1">
-<title>The GHC Commentary - Supporting multi-threaded interoperation</title>
-</head>
-<body>
-<h1>The GHC Commentary - Supporting multi-threaded interoperation</h1>
-<em>
-<p>
-Authors: sof@galois.com, simonmar@microsoft.com<br>
-Date:    April 2002
-</p>
-</em>
-<p>
-This document presents the implementation of an extension to
-Concurrent Haskell that provides two enhancements:
-</p>
-<ul>
-<li>A Concurrent Haskell thread may call an external (e.g., C)
-function in a manner that's transparent to the execution/evaluation of
-other Haskell threads. Section <a href="#callout">Calling out"</a> covers this.
-</li>
-<li>
-OS threads may safely call Haskell functions concurrently. Section
-<a href="#callin">"Calling in"</a> covers this.
-</li>
-</ul>
-
-<!---- ***************************************  ----->
-<h2 id="callout">The problem: foreign calls that block</h2>
-<p>
-When a Concurrent Haskell(CH) thread calls a 'foreign import'ed
-function, the runtime system(RTS) has to handle this in a manner
-transparent to other CH threads. That is, they shouldn't be blocked
-from making progress while the CH thread executes the external
-call. Presently, all threads will block.
-</p>
-<p>
-Clearly, we have to rely on OS-level threads in order to support this
-kind of concurrency. The implementation described here defines the 
-(abstract) OS threads interface that the RTS assumes. The implementation
-currently provides two instances of this interface, one for POSIX
-threads (pthreads) and one for the Win32 threads.
-</p>
-
-<!---- ***************************************  ----->
-<h3>Multi-threading the RTS</h3>
-
-<p>
-A simple and efficient way to implement non-blocking foreign calls is like this:
-<ul>
-<li> Invariant: only one OS thread is allowed to
-execute code inside of the GHC runtime system. [There are alternate
-designs, but I won't go into details on their pros and cons here.]
-We'll call the OS thread that is currently running Haskell threads
-the <em>Current Haskell Worker Thread</em>.
-<p>
-The Current Haskell Worker Thread repeatedly grabs a Haskell thread, executes it until its
-time-slice expires or it blocks on an MVar, then grabs another, and executes
-that, and so on.
-</p>
-<li>
-<p>
-When the Current Haskell Worker comes to execute a potentially blocking 'foreign
-import', it leaves the RTS and ceases being the Current Haskell Worker, but before doing so it makes certain that
-another OS worker thread is available to become the Current Haskell Worker.
-Consequently, even if the external call blocks, the new Current Haskell Worker
-continues execution of the other Concurrent Haskell threads.
-When the external call eventually completes, the Concurrent Haskell
-thread that made the call is passed the result and made runnable
-again.
-</p>
-<p>
-<li>
-A pool of OS threads are constantly trying to become the Current Haskell Worker.
-Only one succeeds at any moment.   If the pool becomes empty, the RTS creates more workers.
-<p><li>
-The OS worker threads are regarded as interchangeable.  A given Haskell thread
-may, during its lifetime, be executed entirely by one OS worker thread, or by more than one.
-There's just no way to tell.
-
-<p><li>If a foreign program wants to call a Haskell function, there is always a thread switch involved.
-The foreign program uses thread-safe mechanisms to create a Haskell thread and make it runnable; and
-the current Haskell Worker Thread exectutes it. See Section <a href="#callin">Calling in</a>.
-</ul>
-<p>
-The rest of this section describes the mechanics of implementing all
-this. There's two parts to it, one that describes how a native (OS) thread
-leaves the RTS to service the external call, the other how the same
-thread handles returning the result of the external call back to the
-Haskell thread.
-</p>
-
-<!---- ***************************************  ----->
-<h3>Making the external call</h3>
-
-<p>
-Presently, GHC handles 'safe' C calls by effectively emitting the
-following code sequence:
-</p>  
-
-<pre>
-    ...save thread state...
-    t = suspendThread();
-    r = foo(arg1,...,argn);
-    resumeThread(t);
-    ...restore thread state...
-    return r;
-</pre>
-
-<p>
-After having squirreled away the state of a Haskell thread,
-<tt>Schedule.c:suspendThread()</tt> is called which puts the current
-thread on a list [<tt>Schedule.c:suspended_ccalling_threads</tt>]
-containing threads that are currently blocked waiting for external calls
-to complete (this is done for the purposes of finding roots when
-garbage collecting).
-</p>
-
-<p>
-In addition to putting the Haskell thread on
-<tt>suspended_ccalling_threads</tt>, <tt>suspendThread()</tt> now also
-does the following:
-</p>
-<ul>
-<li>Instructs the <em>Task Manager</em> to make sure that there's a
-another native thread waiting in the wings to take over the execution
-of Haskell threads. This might entail creating a new
-<em>worker thread</em> or re-using one that's currently waiting for
-more work to do. The <a href="#taskman">Task Manager</a> section
-presents the functionality provided by this subsystem.
-</li>
-
-<li>Releases its capability to execute within the RTS. By doing
-so, another worker thread will become unblocked and start executing
-code within the RTS. See the <a href="#capability">Capability</a>
-section for details.
-</li>
-
-<li><tt>suspendThread()</tt> returns a token which is used to
-identify the Haskell thread that was added to
-<tt>suspended_ccalling_threads</tt>. This is done so that once the
-external call has completed, we know what Haskell thread to pull off
-the <tt>suspended_ccalling_threads</tt> list.
-</li>
-</ul>
-
-<p>
-Upon return from <tt>suspendThread()</tt>, the OS thread is free of
-its RTS executing responsibility, and can now invoke the external
-call. Meanwhile, the other worker thread that have now gained access
-to the RTS will continue executing Concurrent Haskell code. Concurrent
-'stuff' is happening!
-</p>
-
-<!---- ***************************************  ----->
-<h3>Returning the external result</h3>
-
-<p>
-When the native thread eventually returns from the external call,
-the result needs to be communicated back to the Haskell thread that
-issued the external call. The following steps takes care of this:
-</p>
-
-<ul>
-<li>The returning OS thread calls <tt>Schedule.c:resumeThread()</tt>,
-passing along the token referring to the Haskell thread that made the
-call we're returning from.
-</li>
-
-<li>
-The OS thread then tries to grab hold of a <em>returning worker
-capability</em>, via <tt>Capability.c:grabReturnCapability()</tt>.
-Until granted, the thread blocks waiting for RTS permissions. Clearly we
-don't want the thread to be blocked longer than it has to, so whenever
-a thread that is executing within the RTS enters the Scheduler (which
-is quite often, e.g., when a Haskell thread context switch is made),
-it checks to see whether it can give up its RTS capability to a
-returning worker, which is done by calling
-<tt>Capability.c:yieldToReturningWorker()</tt>.
-</li>
-
-<li>
-If a returning worker is waiting (the code in <tt>Capability.c</tt>
-keeps a counter of the number of returning workers that are currently
-blocked waiting), it is woken up and the given the RTS execution
-priviledges/capabilities of the worker thread that gave up its.
-</li>
-
-<li>
-The thread that gave up its capability then tries to re-acquire
-the capability to execute RTS code; this is done by calling
-<tt>Capability.c:waitForWorkCapability()</tt>.
-</li>
-
-<li>
-The returning worker that was woken up will continue execution in
-<tt>resumeThread()</tt>, removing its associated Haskell thread
-from the <tt>suspended_ccalling_threads</tt> list and start evaluating
-that thread, passing it the result of the external call.
-</li>
-</ul>
-
-<!---- ***************************************  ----->
-<h3 id="rts-exec">RTS execution</h3>
-
-<p>
-If a worker thread inside the RTS runs out of runnable Haskell
-threads, it goes to sleep waiting for the external calls to complete.
-It does this by calling <tt>waitForWorkCapability</tt>
-</p>
-
-<p>
-The availability of new runnable Haskell threads is signalled when:
-</p>
-
-<ul>
-<li>When an external call is set up in <tt>suspendThread()</tt>.</li>
-<li>When a new Haskell thread is created (e.g., whenever
-<tt>Concurrent.forkIO</tt> is called from within Haskell); this is
-signalled in <tt>Schedule.c:scheduleThread_()</tt>.
-</li>
-<li>Whenever a Haskell thread is removed from a 'blocking queue'
-attached to an MVar (only?).
-</li>
-</ul>
-
-<!---- ***************************************  ----->
-<h2 id="callin">Calling in</h2>
-
-Providing robust support for having multiple OS threads calling into
-Haskell is not as involved as its dual. 
-
-<ul>
-<li>The OS thread issues the call to a Haskell function by going via
-the <em>Rts API</em> (as specificed in <tt>RtsAPI.h</tt>). 
-<li>Making the function application requires the construction of a
-closure on the heap. This is done in a thread-safe manner by having
-the OS thread lock a designated block of memory (the 'Rts API' block,
-which is part of the GC's root set) for the short period of time it
-takes to construct the application.
-<li>The OS thread then creates a new Haskell thread to execute the
-function application, which (eventually) boils down to calling
-<tt>Schedule.c:createThread()</tt> 
-<li>
-Evaluation is kicked off by calling <tt>Schedule.c:scheduleExtThread()</tt>,
-which asks the Task Manager to possibly create a new worker (OS)
-thread to execute the Haskell thread.
-<li>
-After the OS thread has done this, it blocks waiting for the 
-Haskell thread to complete the evaluation of the Haskell function.
-<p>
-The reason why a separate worker thread is made to evaluate the Haskell
-function and not the OS thread that made the call-in via the
-Rts API, is that we want that OS thread to return as soon as possible.
-We wouldn't be able to guarantee that if the OS thread entered the 
-RTS to (initially) just execute its function application, as the
-Scheduler may side-track it and also ask it to evaluate other Haskell threads.
-</li>
-</ul>
-
-<p>
-<strong>Note:</strong> As of 20020413, the implementation of the RTS API
-only serializes access to the allocator between multiple OS threads wanting
-to call into Haskell (via the RTS API.) It does not coordinate this access
-to the allocator with that of the OS worker thread that's currently executing
-within the RTS. This weakness/bug is scheduled to be tackled as part of an
-overhaul/reworking of the RTS API itself.
-
-
-<!---- ***************************************  ----->
-<h2>Subsystems introduced/modified</h2>
-
-<p>
-These threads extensions affect the Scheduler portions of the runtime
-system. To make it more manageable to work with, the changes
-introduced a couple of new RTS 'sub-systems'. This section presents
-the functionality and API of these sub-systems.
-</p>
-
-<!---- ***************************************  ----->
-<h3 id="#capability">Capabilities</h3>
-
-<p>
-A Capability represent the token required to execute STG code,
-and all the state an OS thread/task needs to run Haskell code:
-its STG registers, a pointer to its TSO, a nursery etc. During
-STG execution, a pointer to the capabilitity is kept in a
-register (BaseReg).
-</p>
-<p>
-Only in an SMP build will there be multiple capabilities, for
-the threaded RTS and other non-threaded builds, there is only
-one global capability, namely <tt>MainCapability</tt>.
-
-<p>
-The Capability API is as follows:
-<pre>
-/* Capability.h */
-extern void initCapabilities(void);
-
-extern void grabReturnCapability(Mutex* pMutex, Capability** pCap);
-extern void waitForWorkCapability(Mutex* pMutex, Capability** pCap, rtsBool runnable);
-extern void releaseCapability(Capability* cap);
-
-extern void yieldToReturningWorker(Mutex* pMutex, Capability* cap);
-
-extern void grabCapability(Capability** cap);
-</pre>
-
-<ul>
-<li><tt>initCapabilities()</tt> initialises the subsystem.
-
-<li><tt>grabReturnCapability()</tt> is called by worker threads
-returning from an external call. It blocks them waiting to gain
-permissions to do so.
-
-<li><tt>waitForWorkCapability()</tt> is called by worker threads
-already inside the RTS, but without any work to do. It blocks them
-waiting for there to new work to become available.
-
-<li><tt>releaseCapability()</tt> hands back a capability. If a
-'returning worker' is waiting, it is signalled that a capability
-has become available. If not, <tt>releaseCapability()</tt> tries
-to signal worker threads that are blocked waiting inside
-<tt>waitForWorkCapability()</tt> that new work might now be
-available.
-
-<li><tt>yieldToReturningWorker()</tt> is called by the worker thread
-that's currently inside the Scheduler. It checks whether there are other
-worker threads waiting to return from making an external call. If so,
-they're given preference and a capability is transferred between worker
-threads. One of the waiting 'returning worker' threads is signalled and made
-runnable, with the other, yielding, worker blocking to re-acquire
-a capability.
-</ul>
-
-<p>
-The condition variables used to implement the synchronisation between
-worker consumers and providers are local to the Capability
-implementation. See source for details and comments.
-</p>
-
-<!---- ***************************************  ----->
-<h3 id="taskman">The Task Manager</h3>
-
-<p>
-The Task Manager API is responsible for managing the creation of
-OS worker RTS threads. When a Haskell thread wants to make an
-external call, the Task Manager is asked to possibly create a
-new worker thread to take over the RTS-executing capability of
-the worker thread that's exiting the RTS to execute the external call.
-
-<p>
-The Capability subsystem keeps track of idle worker threads, so
-making an informed decision about whether or not to create a new OS
-worker thread is easy work for the task manager. The Task manager
-provides the following API:
-</p>
-
-<pre>
-/* Task.h */
-extern void startTaskManager ( nat maxTasks, void (*taskStart)(void) );
-extern void stopTaskManager ( void );
-
-extern void startTask ( void (*taskStart)(void) );
-</pre>
-
-<ul>
-<li><tt>startTaskManager()</tt> and <tt>stopTaskManager()</tt> starts
-up and shuts down the subsystem. When starting up, you have the option
-to limit the overall number of worker threads that can be
-created. An unbounded (modulo OS thread constraints) number of threads
-is created if you pass '0'.
-<li><tt>startTask()</tt> is called when a worker thread calls
-<tt>suspendThread()</tt> to service an external call, asking another
-worker thread to take over its RTS-executing capability. It is also
-called when an external OS thread invokes a Haskell function via the
-<em>Rts API</em>.
-</ul>
-
-<!---- ***************************************  ----->
-<h3>Native threads API</h3>
-
-To hide OS details, the following API is used by the task manager and
-the scheduler to interact with an OS' threads API:
-
-<pre>
-/* OSThreads.h */
-typedef <em>..OS specific..</em> Mutex;
-extern void initMutex    ( Mutex* pMut );
-extern void grabMutex    ( Mutex* pMut );
-extern void releaseMutex ( Mutex* pMut );
-  
-typedef <em>..OS specific..</em> Condition;
-extern void    initCondition      ( Condition* pCond );
-extern void    closeCondition     ( Condition* pCond );
-extern rtsBool broadcastCondition ( Condition* pCond );
-extern rtsBool signalCondition    ( Condition* pCond );
-extern rtsBool waitCondition      ( Condition* pCond, 
-				    Mutex* pMut );
-
-extern OSThreadId osThreadId      ( void );
-extern void shutdownThread        ( void );
-extern void yieldThread           ( void );
-extern int  createOSThread        ( OSThreadId* tid,
-				    void (*startProc)(void) );
-</pre>
-
-
-
-<!---- ***************************************  ----->
-<h2>User-level interface</h2>
-
-To signal that you want an external call to be serviced by a separate
-OS thread, you have to add the attribute <tt>threadsafe</tt> to
-a foreign import declaration, i.e.,
-
-<pre>
-foreign import "bigComp" threadsafe largeComputation :: Int -> IO ()
-</pre>
-
-<p>
-The distinction between 'safe' and thread-safe C calls is made
-so that we may call external functions that aren't re-entrant but may
-cause a GC to occur.
-<p>
-The <tt>threadsafe</tt> attribute subsumes <tt>safe</tt>.
-</p>
-
-<!---- ***************************************  ----->
-<h2>Building the GHC RTS</h2>
-
-The multi-threaded extension isn't currently enabled by default. To
-have it built, you need to run the <tt>fptools</tt> configure script
-with the extra option <tt>--enable-threaded-rts</tt> turned on, and
-then proceed to build the compiler as per normal.
-
-<hr>
-<small>
-<!-- hhmts start --> Last modified: Wed Apr 10 14:21:57 Pacific Daylight Time 2002 <!-- hhmts end -->
-</small>
-</body> </html>
-
diff --git a/docs/comm/rts-libs/non-blocking.html b/docs/comm/rts-libs/non-blocking.html
deleted file mode 100644
index 627bde8d8887..000000000000
--- a/docs/comm/rts-libs/non-blocking.html
+++ /dev/null
@@ -1,133 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
-<html>
-  <head>
-    <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-8859-1">
-    <title>The GHC Commentary - Non-blocking I/O on Win32</title>
-  </head>
-
-  <body BGCOLOR="FFFFFF">
-    <h1>The GHC Commentary - Non-blocking I/O on Win32</h1>
-    <p>
-
-This note discusses the implementation of non-blocking I/O on
-Win32 platforms.   It is not implemented yet (Apr 2002), but it seems worth
-capturing the ideas.  Thanks to Sigbjorn for writing them.
-
-<h2> Background</h2>
-
-GHC has provided non-blocking I/O support for Concurrent Haskell
-threads on platforms that provide 'UNIX-style' non-blocking I/O for
-quite a while. That is, platforms that let you alter the property of a
-file descriptor to instead of having a thread block performing an I/O
-operation that cannot be immediately satisfied, the operation returns
-back a special error code (EWOULDBLOCK.) When that happens, the CH
-thread that made the blocking I/O request is put into a blocked-on-IO
-state (see Foreign.C.Error.throwErrnoIfRetryMayBlock). The RTS will
-in a timely fashion check to see whether I/O is again possible
-(via a call to select()), and if it is, unblock the thread & have it
-re-try the I/O operation. The result is that other Concurrent Haskell
-threads won't be affected, but can continue operating while a thread
-is blocked on I/O.
-<p>
-Non-blocking I/O hasn't been supported by GHC on Win32 platforms, for
-the simple reason that it doesn't provide the OS facilities described
-above. 
-
-<h2>Win32 non-blocking I/O, attempt 1</h2>
-
-Win32 does provide something select()-like, namely the
-WaitForMultipleObjects() API. It takes an array of kernel object
-handles plus a timeout interval, and waits for either one (or all) of
-them to become 'signalled'. A handle representing an open file (for
-reading) becomes signalled once there is input available.
-<p>
-So, it is possible to observe that I/O is possible using this
-function, but not whether there's "enough" to satisfy the I/O request.
-So, if we were to mimic select() usage with WaitForMultipleObjects(),
-we'd correctly avoid blocking initially, but a thread may very well 
-block waiting for their I/O requests to be satisified once the file
-handle has become signalled. [There is a fix for this -- only read
-and write one byte at a the time -- but I'm not advocating that.]
-
-
-<h2>Win32 non-blocking I/O, attempt 2</h2>
-
-Asynchronous I/O on Win32 is supported via 'overlapped I/O'; that is,
-asynchronous read and write requests can be made via the ReadFile() /
-WriteFile () APIs, specifying position and length of the operation.
-If the I/O requests cannot be handled right away, the APIs won't
-block, but return immediately (and report ERROR_IO_PENDING as their
-status code.)
-<p>
-The completion of the request can be reported in a number of ways:
-<ul>
-  <li> synchronously, by blocking inside Read/WriteFile().  (this is the
-    non-overlapped case, really.)
-<p>
-
-  <li> as part of the overlapped I/O request, pass a HANDLE to an event
-    object. The I/O system will signal this event once the request
-    completed, which a waiting thread will then be able to see.
-<p>
-
-  <li> by supplying a pointer to a completion routine, which will be
-    called as an Asynchronous Procedure Call (APC) whenever a thread
-    calls a select bunch of 'alertable' APIs.
-<p>
-
-  <li> by associating the file handle with an I/O completion port.  Once
-    the request completes, the thread servicing the I/O completion
-    port will be notified.
-</ul>
-The use of I/O completion port looks the most interesting to GHC,
-as it provides a central point where all I/O requests are reported.
-<p>
-Note: asynchronous I/O is only fully supported by OSes based on
-the NT codebase, i.e., Win9x don't permit async I/O on files and
-pipes. However, Win9x does support async socket operations, and
-I'm currently guessing here, console I/O. In my view, it would
-be acceptable to provide non-blocking I/O support for NT-based
-OSes only.
-<p>
-Here's the design I currently have in mind:
-<ul>
-<li> Upon startup, an RTS helper thread whose only purpose is to service
-  an I/O completion port, is created.
-<p>
-<li> All files are opened in 'overlapping' mode, and associated
-  with an I/O completion port.
-<p>
-<li> Overlapped I/O requests are used to implement read() and write().
-<p>
-<li> If the request cannot be satisified without blocking, the Haskell
-  thread is put on the blocked-on-I/O thread list & a re-schedule
-  is made.
-<p>
-<li> When the completion of a request is signalled via the I/O completion
-  port, the RTS helper thread will move the associated Haskell thread
-  from the blocked list onto the runnable list. (Clearly, care
-  is required here to have another OS thread mutate internal Scheduler
-  data structures.)
-  
-<p>
-<li> In the event all Concurrent Haskell threads are blocked waiting on
-  I/O, the main RTS thread blocks waiting on an event synchronisation
-  object, which the helper thread will signal whenever it makes
-  a Haskell thread runnable.
-
-</ul>
-
-I might do the communication between the RTS helper thread and the 
-main RTS thread differently though: rather than have the RTS helper 
-thread manipluate thread queues itself, thus requiring careful 
-locking, just have it change a bit on the relevant TSO, which the main 
-RTS thread can check at regular intervals (in some analog of 
-awaitEvent(), for example).
-
-    <p><small>
-<!-- hhmts start -->
-Last modified: Wed Aug  8 19:30:18 EST 2001
-<!-- hhmts end -->
-    </small>
-  </body>
-</html>
diff --git a/docs/comm/rts-libs/prelfound.html b/docs/comm/rts-libs/prelfound.html
deleted file mode 100644
index 25407eed43c7..000000000000
--- a/docs/comm/rts-libs/prelfound.html
+++ /dev/null
@@ -1,57 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
-<html>
-  <head>
-    <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-8859-1">
-    <title>The GHC Commentary - Prelude Foundations</title>
-  </head>
-
-  <body BGCOLOR="FFFFFF">
-    <h1>The GHC Commentary - Prelude Foundations</h1>
-    <p>
-      The standard Haskell Prelude as well as GHC's Prelude extensions are
-      constructed from GHC's <a href="primitives.html">primitives</a> in a
-      couple of layers.  
-
-    <h4><code>PrelBase.lhs</code></h4>
-    <p>
-      Some most elementary Prelude definitions are collected in <a
-	href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/lib/std/PrelBase.lhs"><code>PrelBase.lhs</code></a>.
-      In particular, it defines the boxed versions of Haskell primitive types
-      - for example, <code>Int</code> is defined as
-    <blockquote><pre>
-data Int = I# Int#</pre>
-    </blockquote>
-    <p>
-      Saying that a boxed integer <code>Int</code> is formed by applying the
-      data constructor <code>I#</code> to an <em>unboxed</em> integer of type
-      <code>Int#</code>.  Unboxed types are hardcoded in the compiler and
-      exported together with the <a href="primitives.html">primitive
-	operations</a> understood by GHC.
-    <p>
-      <code>PrelBase.lhs</code> similarly defines basic types, such as,
-      boolean values
-    <blockquote><pre>
-data  Bool  =  False | True  deriving (Eq, Ord)</pre>
-    </blockquote>
-    <p>
-      the unit type
-    <blockquote><pre>
-data  ()  =  ()</pre>
-    </blockquote>
-    <p>
-      and lists
-    <blockquote><pre>
-data [] a = [] | a : [a]</pre>
-    </blockquote>
-    <p>
-      It also contains instance delarations for these types.  In addition,
-      <code>PrelBase.lhs</code> contains some <a href="prelude.html">tricky
-      machinery</a> for efficient list handling.
-
-    <p><small>
-<!-- hhmts start -->
-Last modified: Wed Aug  8 19:30:18 EST 2001
-<!-- hhmts end -->
-    </small>
-  </body>
-</html>
diff --git a/docs/comm/rts-libs/prelude.html b/docs/comm/rts-libs/prelude.html
deleted file mode 100644
index c93e90dddc3b..000000000000
--- a/docs/comm/rts-libs/prelude.html
+++ /dev/null
@@ -1,121 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
-<html>
-  <head>
-    <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-8859-1">
-    <title>The GHC Commentary - Cunning Prelude Code</title>
-  </head>
-
-  <body BGCOLOR="FFFFFF">
-    <h1>The GHC Commentary - Cunning Prelude Code</h1>
-    <p>
-      GHC's uses a many optimisations and GHC specific techniques (unboxed
-      values, RULES pragmas, and so on) to make the heavily used Prelude code
-      as fast as possible.
-
-    <hr>
-    <h4>Par, seq, and lazy</h4>
-
-    In GHC.Conc you will dinf
-<blockquote><pre>
-  pseq a b = a `seq` lazy b
-</pre></blockquote>
-   What's this "lazy" thing.  Well, <tt>pseq</tt> is a <tt>seq</tt> for a parallel setting.
-   We really mean "evaluate a, then b".  But if the strictness analyser sees that pseq is strict
-   in b, then b might be evaluated <em>before</em> a, which is all wrong. 
-<p>
-Solution: wrap the 'b' in a call to <tt>GHC.Base.lazy</tt>.  This function is just the identity function,
-except that it's put into the built-in environment in MkId.lhs.  That is, the MkId.lhs defn over-rides the
-inlining and strictness information that comes in from GHC.Base.hi.  And that makes <tt>lazy</tt> look
-lazy, and have no inlining.  So the strictness analyser gets no traction.
-<p>
-In the worker/wrapper phase, after strictness analysis, <tt>lazy</tt> is "manually" inlined (see WorkWrap.lhs),
-so we get all the efficiency back.
-<p>
-This supersedes an earlier scheme involving an even grosser hack in which par# and seq# returned an
-Int#.  Now there is no seq# operator at all.
-
-
-    <hr>
-    <h4>fold/build</h4>
-    <p>
-      There is a lot of magic in <a
-	href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/lib/std/PrelBase.lhs"><code>PrelBase.lhs</code></a> -
-      among other things, the <a
-	href="http://haskell.cs.yale.edu/ghc/docs/latest/set/rewrite-rules.html">RULES
-      pragmas</a> implementing the <a
-	href="http://research.microsoft.com/Users/simonpj/Papers/deforestation-short-cut.ps.Z">fold/build</a>
-	optimisation.  The code for <code>map</code> is
-      a good example for how it all works. In the prelude code for version
-      5.03 it reads as follows:
-    <blockquote><pre>
-map :: (a -> b) -> [a] -> [b]
-map _ []     = []
-map f (x:xs) = f x : map f xs
-
--- Note eta expanded
-mapFB ::  (elt -> lst -> lst) -> (a -> elt) -> a -> lst -> lst
-{-# INLINE [0] mapFB #-}
-mapFB c f x ys = c (f x) ys
-
-{-# RULES
-"map"	    [~1] forall f xs.	map f xs		= build (\c n -> foldr (mapFB c f) n xs)
-"mapList"   [1]  forall f.	foldr (mapFB (:) f) []	= map f
-"mapFB"	    forall c f g.	mapFB (mapFB c f) g	= mapFB c (f.g) 
-  #-}</pre>
-    </blockquote>
-    <p>
-      Up to (but not including) phase 1, we use the <code>"map"</code> rule to
-      rewrite all saturated applications of <code>map</code> with its
-      build/fold form, hoping for fusion to happen.  In phase 1 and 0, we
-      switch off that rule, inline build, and switch on the
-      <code>"mapList"</code> rule, which rewrites the foldr/mapFB thing back
-      into plain map.
-    <p>
-      It's important that these two rules aren't both active at once 
-      (along with build's unfolding) else we'd get an infinite loop 
-      in the rules.  Hence the activation control using explicit phase numbers.
-    <p>
-      The "mapFB" rule optimises compositions of map.
-    <p>
-      The mechanism as described above is new in 5.03 since January 2002,
-      where the <code>[~</code><i>N</i><code>]</code> syntax for phase number
-      annotations at rules was introduced.  Before that the whole arrangement
-      was more complicated, as the corresponding prelude code for version
-      4.08.1 shows:
-    <blockquote><pre>
-map :: (a -> b) -> [a] -> [b]
-map = mapList
-
--- Note eta expanded
-mapFB ::  (elt -> lst -> lst) -> (a -> elt) -> a -> lst -> lst
-mapFB c f x ys = c (f x) ys
-
-mapList :: (a -> b) -> [a] -> [b]
-mapList _ []     = []
-mapList f (x:xs) = f x : mapList f xs
-
-{-# RULES
-"map"	  forall f xs.  map f xs	       = build (\c n -> foldr (mapFB c f) n xs)
-"mapFB"	  forall c f g. mapFB (mapFB c f) g    = mapFB c (f.g) 
-"mapList" forall f.	foldr (mapFB (:) f) [] = mapList f
- #-}</pre>
-    </blockquote>
-    <p>
-      This code is structured as it is, because the "map" rule first
-      <em>breaks</em> the map <em>open,</em> which exposes it to the various
-      foldr/build rules, and if no foldr/build rule matches, the "mapList"
-      rule <em>closes</em> it again in a later phase of optimisation - after
-      build was inlined.  As a consequence, the whole thing depends a bit on
-      the timing of the various optimisations (the map might be closed again
-      before any of the foldr/build rules fires).  To make the timing
-      deterministic, <code>build</code> gets a <code>{-# INLINE 2 build
-      #-}</code> pragma, which delays <code>build</code>'s inlining, and thus,
-      the closing of the map. [NB: Phase numbering was forward at that time.]
-
-    <p><small>
-<!-- hhmts start -->
-Last modified: Mon Feb 11 20:00:49 EST 2002
-<!-- hhmts end -->
-    </small>
-  </body>
-</html>
diff --git a/docs/comm/rts-libs/primitives.html b/docs/comm/rts-libs/primitives.html
deleted file mode 100644
index 28abc794261b..000000000000
--- a/docs/comm/rts-libs/primitives.html
+++ /dev/null
@@ -1,70 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
-<html>
-  <head>
-    <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-8859-1">
-    <title>The GHC Commentary - Primitives</title>
-  </head>
-
-  <body BGCOLOR="FFFFFF">
-    <h1>The GHC Commentary - Primitives</h1>
-    <p>
-      Most user-level Haskell types and functions provided by GHC (in
-      particular those from the Prelude and GHC's Prelude extensions) are
-      internally constructed from even more elementary types and functions.
-      Most notably, GHC understands a notion of <em>unboxed types,</em> which
-      are the Haskell representation of primitive bit-level integer, float,
-      etc. types (as opposed to their boxed, heap allocated counterparts) -
-      cf. <a
-	href="http://research.microsoft.com/Users/simonpj/Papers/unboxed-values.ps.Z">"Unboxed
-	Values as First Class Citizens."</a>
-
-    <h4>The Ultimate Source of Primitives</h4>
-    <p>
-      The hardwired types of GHC are brought into scope by the module
-      <code>PrelGHC</code>.  This modules only exists in the form of a
-      handwritten interface file <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/lib/std/PrelGHC.hi-boot"><code>PrelGHC.hi-boot</code>,</a>
-      which lists the type and function names, as well as instance
-      declarations.  The actually types of these names as well as their
-      implementation is hardwired into GHC.  Note that the names in this file
-      are z-encoded, and in particular, identifiers ending on <code>zh</code>
-      denote user-level identifiers ending in a hash mark (<code>#</code>),
-      which is used to flag unboxed values or functions operating on unboxed
-      values.  For example, we have <code>Char#</code>, <code>ord#</code>, and
-      so on. 
-
-    <h4>The New Primitive Definition Scheme</h4>
-    <p>
-      As of (about) the development version 4.11, the types and various
-      properties of primitive operations are defined in the file <a
-	href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/prelude/primops.txt.pp"><code>primops.txt.pp</code></a>.
-      (Personally, I don't think that the <code>.txt</code> suffix is really
-      appropriate, as the file is used for automatic code generation; the
-      recent addition of <code>.pp</code> means that the file is now mangled
-      by cpp.)
-    <p>
-      The utility <a
-	href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/utils/genprimopcode/"><code>genprimopcode</code></a> 
-      generates a series of Haskell files from <code>primops.txt</code>, which
-      encode the types and various properties of the primitive operations as
-      compiler internal data structures.  These Haskell files are not complete
-      modules, but program fragments, which are included into compiler modules
-      during the GHC build process.  The generated include files can be found
-      in the directory <code>fptools/ghc/compiler/</code> and carry names
-      matching the pattern <code>primop-*.hs-incl</code>.  They are generate
-      during the execution of the <code>boot</code> target in the
-      <code>fptools/ghc/</code> directory.  This scheme significantly
-      simplifies the maintenance of primitive operations.
-    <p> 
-      As of development version 5.02, the <code>primops.txt</code> file also allows the
-      recording of documentation about intended semantics of the primitives.  This can
-      be extracted into a latex document (or rather, into latex document fragments)
-      via an appropriate switch to <code>genprimopcode</code>. In particular, see <code>primops.txt</code>
-      for full details of how GHC is configured to cope with different machine word sizes.
-    <p><small>
-<!-- hhmts start -->
-Last modified: Mon Nov 26 18:03:16 EST 2001
-<!-- hhmts end -->
-    </small>
-  </body>
-</html>
diff --git a/docs/comm/rts-libs/stgc.html b/docs/comm/rts-libs/stgc.html
deleted file mode 100644
index 196ec9150db9..000000000000
--- a/docs/comm/rts-libs/stgc.html
+++ /dev/null
@@ -1,45 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
-<html>
-  <head>
-    <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-8859-1">
-    <title>The GHC Commentary - Spineless Tagless C</title>
-  </head>
-
-  <body BGCOLOR="FFFFFF">
-    <h1>The GHC Commentary - Spineless Tagless C</h1>
-    <p>
-      The C code generated by GHC doesn't use higher-level features of C to be
-      able to control as precisely as possible what code is generated.
-      Moreover, it uses special features of gcc (such as, first class labels)
-      to produce more efficient code.
-    <p>
-      STG C makes ample use of C's macro language to define idioms, which also
-      reduces the size of the generated C code (thus, reducing I/O times).
-      These macros are defined in the C headers located in GHC's <a
-	href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/includes/"><code>includes</code></a>
-      directory.
-
-    <h4><code>TailCalls.h</code></h4>
-    <p>
-      <a
-	href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/includes/TailCalls.h"><code>TailCalls.h</code></a>
-      defines how tail calls are implemented - and in particular - optimised
-      in GHC generated code.  The default case, for an architecture for which
-      GHC is not optimised, is to use the mini interpreter described in the <a
-	href="http://research.microsoft.com/copyright/accept.asp?path=/users/simonpj/papers/spineless-tagless-gmachine.ps.gz&pub=34">STG paper.</a>
-    <p>
-      For supported architectures, various tricks are used to generate
-      assembler implementing proper tail calls.  On i386, gcc's first class
-      labels are used to directly jump to a function pointer.  Furthermore,
-      markers of the form <code>--- BEGIN ---</code> and <code>--- END
-      ---</code> are added to the assembly right after the function prologue
-      and before the epilogue.  These markers are used by <a
-	href="../the-beast/mangler.html">the Evil Mangler.</a>
-
-    <p><small>
-<!-- hhmts start -->
-Last modified: Wed Aug  8 19:28:29 EST 2001
-<!-- hhmts end -->
-    </small>
-  </body>
-</html>
diff --git a/docs/comm/rts-libs/threaded-rts.html b/docs/comm/rts-libs/threaded-rts.html
deleted file mode 100644
index 739dc8d58a87..000000000000
--- a/docs/comm/rts-libs/threaded-rts.html
+++ /dev/null
@@ -1,126 +0,0 @@
-<html>
-  <head>
-    <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-8859-1">
-      <title>The GHC Commentary - The Multi-threaded runtime, and multiprocessor execution</title>
-  </head>
-
-  <body>
-    <h1>The GHC Commentary - The Multi-threaded runtime, and multiprocessor execution</h1>
-    
-    <p>This section of the commentary explains the structure of the runtime system
-      when used in threaded or SMP mode.</p>
-
-    <p>The <em>threaded</em> version of the runtime supports
-      bound threads and non-blocking foreign calls, and an overview of its
-      design can be found in the paper <a
-	href="http://www.haskell.org/~simonmar/papers/conc-ffi.pdf">Extending
-	the Haskell Foreign Function Interface with Concurrency</a>.  To
-      compile the runtime with threaded support, add the line
-
-<pre>GhcRTSWays += thr</pre>
-
-    to <tt>mk/build.mk</tt>.  When building C code in the runtime for the threaded way,
-      the symbol <tt>THREADED_RTS</tt> is defined (this is arranged by the
-      build system when building for way <tt>thr</tt>, see
-      <tt>mk/config.mk</tt>).  To build a Haskell program
-      with the threaded runtime, pass the flag <tt>-threaded</tt> to GHC (this
-      can be used in conjunction with <tt>-prof</tt>, and possibly
-      <tt>-debug</tt> and others depending on which versions of the RTS have
-      been built.</p>
-
-    <p>The <em>SMP</em> version runtime supports the same facilities as the
-      threaded version, and in addition supports execution of Haskell code by
-      multiple simultaneous OS threads.  For SMP support, both the runtime and
-      the libraries must be built a special way: add the lines
-
-   <pre>
-GhcRTSWays += thr
-GhcLibWays += s</pre>
-
-    to <tt>mk/build.mk</tt>.  To build Haskell code for
-      SMP execution, use the flag <tt>-smp</tt> to GHC (this can be used in
-      conjunction with <tt>-debug</tt>, but no other way-flags at this time).
-      When building C code in the runtime for SMP
-      support, the symbol <tt>SMP</tt> is defined (this is arranged by the
-      compiler when the <tt>-smp</tt> flag is given, see
-      <tt>ghc/compiler/main/StaticFlags.hs</tt>).</p>
-
-    <p>When building the runtime in either the threaded or SMP ways, the symbol
-      <tt>RTS_SUPPORTS_THREADS</tt> will be defined (see <tt>Rts.h</tt>).</p>
-
-    <h2>Overall design</h2>
-
-    <p>The system is based around the notion of a <tt>Capability</tt>.  A
-      <tt>Capability</tt> is an object that represents both the permission to
-      execute some Haskell code, and the state required to do so.  In order
-      to execute some Haskell code, a thread must therefore hold a
-      <tt>Capability</tt>.  The available pool of capabilities is managed by
-      the <tt>Capability</tt> API, described below.</p>
-
-    <p>In the threaded runtime, there is only a single <tt>Capability</tt> in the
-      system, indicating that only a single thread can be executing Haskell
-      code at any one time.  In the SMP runtime, there can be an arbitrary
-      number of capabilities selectable at runtime with the <tt>+RTS -N<em>n</em></tt>
-      flag; in practice the number is best chosen to be the same as the number of
-      processors on the host machine.</p>
-
-    <p>There are a number of OS threads running code in the runtime.  We call
-      these <em>tasks</em> to avoid confusion with Haskell <em>threads</em>.
-      Tasks are managed by the <tt>Task</tt> subsystem, which is mainly
-      concerned with keeping track of statistics such as how much time each
-      task spends executing Haskell code, and also keeping track of how many
-      tasks are around when we want to shut down the runtime.</p>
-
-    <p>Some tasks are created by the runtime itself, and some may be here
-      as a result of a call to Haskell from foreign code (we
-      call this an in-call).  The
-      runtime can support any number of concurrent foreign in-calls, but the
-      number of these calls that will actually run Haskell code in parallel is
-      determined by the number of available capabilities.  Each in-call creates
-      a <em>bound thread</em>, as described in the FFI/Concurrency paper (cited
-      above).</p>
-
-    <p>In the future we may want to bind a <tt>Capability</tt> to a particular
-      processor, so that we can support a notion of affinity - avoiding
-      accidental migration of work from one CPU to another, so that we can make
-      best use of a CPU's local cache.  For now, the design ignores this
-      issue.</p>
-
-    <h2>The <tt>OSThreads</tt> interface</h2>
-
-    <p>This interface is merely an abstraction layer over the OS-specific APIs
-      for managing threads.  It has two main implementations: Win32 and
-      POSIX.</p>
-
-    <p>This is the entirety of the interface:</p>
-
-<pre>
-/* Various abstract types */
-typedef Mutex;
-typedef Condition;
-typedef OSThreadId;
-
-extern OSThreadId osThreadId      ( void );
-extern void shutdownThread        ( void );
-extern void yieldThread           ( void );
-extern int  createOSThread        ( OSThreadId* tid,
-				    void (*startProc)(void) );
-
-extern void initCondition         ( Condition* pCond );
-extern void closeCondition        ( Condition* pCond );
-extern rtsBool broadcastCondition ( Condition* pCond );
-extern rtsBool signalCondition    ( Condition* pCond );
-extern rtsBool waitCondition      ( Condition* pCond, 
-				    Mutex* pMut );
-
-extern void initMutex             ( Mutex* pMut );
-    </pre>
-
-    <h2>The Task interface</h2>
-
-    <h2>The Capability interface</h2>
-
-    <h2>Multiprocessor Haskell Execution</h2>
-
-  </body>
-</html>
diff --git a/docs/comm/the-beast/alien.html b/docs/comm/the-beast/alien.html
deleted file mode 100644
index 3d4776ebc9a0..000000000000
--- a/docs/comm/the-beast/alien.html
+++ /dev/null
@@ -1,56 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
-<html>
-  <head>
-    <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-8859-1">
-    <title>The GHC Commentary - Alien Functions</title>
-  </head>
-
-  <body BGCOLOR="FFFFFF">
-    <h1>The GHC Commentary - Alien Functions</h1>
-    <p>
-      GHC implements experimental (by now it is actually quite well tested)
-      support for access to foreign functions and generally the interaction
-      between Haskell code and code written in other languages.  Code
-      generation in this context can get quite tricky.  This section attempts
-      to cast some light on this aspect of the compiler.
-
-    <h4>FFI Stub Files</h4>
-    <p>
-      For each Haskell module that contains a <code>foreign export
-      dynamic</code> declaration, GHC generates a <code>_stub.c</code> file
-      that needs to be linked with any program that imports the Haskell
-      module.  When asked about it <a
-      href="mailto:simonmar@microsoft.com">Simon Marlow</a> justified the
-      existence of these files as follows:
-    <blockquote>
-      The stub files contain the helper function which invokes the Haskell
-      code when called from C.
-      <p>
-	Each time the foreign export dynamic is invoked to create a new
-	callback function, a small piece of code has to be dynamically
-	generated (by code in <a
-	href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/rts/Adjustor.c"><code>Adjustor.c</code></a>).  It is the address of this dynamically generated bit of
-	code that is returned as the <code>Addr</code> (or <a
-	href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/hslibs/lang/Ptr.lhs"><code>Ptr</code></a>).
-	When called from C, the dynamically generated code must somehow invoke
-	the Haskell function which was originally passed to the
-	f.e.d. function -- it does this by invoking the helper function,
-	passing it a <a
-	href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/hslibs/lang/StablePtr.lhs"><code>StablePtr</code></a>
-	to the Haskell function.  It's split this way for two reasons: the
-	same helper function can be used each time the f.e.d. function is
-	called, and to keep the amount of dynamically generated code to a
-	minimum.
-    </blockquote>
-    <p>
-      The stub code is generated by <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/deSugar/DsForeign.lhs"><code>DSForeign</code></a><code>.fexportEntry</code>.
-
-
-    <p><small>
-<!-- hhmts start -->
-Last modified: Fri Aug 10 11:47:41 EST 2001
-<!-- hhmts end -->
-    </small>
-  </body>
-</html>
diff --git a/docs/comm/the-beast/basicTypes.html b/docs/comm/the-beast/basicTypes.html
deleted file mode 100644
index b411e4c5a9ca..000000000000
--- a/docs/comm/the-beast/basicTypes.html
+++ /dev/null
@@ -1,132 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
-<html>
-  <head>
-    <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-8859-1">
-    <title>The GHC Commentary - The Basics</title>
-  </head>
-
-  <body BGCOLOR="FFFFFF">
-    <h1>The GHC Commentary - The Basics</h1>
-    <p>
-      The directory <a
-	href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/basicTypes/"><code>fptools/ghc/compiler/basicTypes/</code></a> 
-      contains modules that define some of the essential types definition for
-      the compiler - such as, identifiers, variables, modules, and unique
-      names.  Some of those are discussed in the following.  See elsewhere for more
-      detailed information on:
-      <ul>
-      <li> <a href="vars.html"><code>Var</code>s, <code>Id</code>s, and <code>TyVar</code>s</a>
-      <li> <a href="renamer.html"><code>OccName</code>s, <code>RdrName</code>s, and <code>Names</code>s</a>
-      </ul>
-
-    <h2>Elementary Types</h2>
-
-    <h4><code>Id</code>s</h4>
-    <p>
-      An <code>Id</code> (defined in <a
-	href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/basicTypes/Id.lhs"><code>Id.lhs</code></a>
-      essentially records information about value and data constructor
-      identifiers -- to be precise, in the case of data constructors, two
-      <code>Id</code>s are used to represent the worker and wrapper functions
-      for the data constructor, respectively.  The information maintained in
-      the <code>Id</code> abstraction includes among other items strictness,
-      occurrence, specialisation, and unfolding information.
-    <p>
-      Due to the way <code>Id</code>s are used for data constructors,
-      all <code>Id</code>s are represented as variables, which contain a
-      <code>varInfo</code> field of abstract type <code><a
-	href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/basicTypes/IdInfo.lhs">IdInfo</a>.IdInfo</code>.  
-      This is where the information about <code>Id</code>s is really stored.
-      The following is a (currently, partial) list of the various items in an
-      <code>IdInfo</code>:
-    <p>
-    <dl>
-      <dt><a name="occInfo">Occurrence information</a>
-      <dd>The <code>OccInfo</code> data type is defined in the module <a
-	href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/basicTypes/BasicTypes.lhs"><code>BasicTypes.lhs</code></a>.
-	Apart from the trivial <code>NoOccInfo</code>, it distinguishes
-	between variables that do not occur at all (<code>IAmDead</code>),
-	occur just once (<code>OneOcc</code>), or a <a
-	  href="simplifier.html#loopBreaker">loop breakers</a>
-	(<code>IAmALoopBreaker</code>).
-    </dl>
-
-    <h2>Sets, Finite Maps, and Environments</h2>
-    <p>
-      Sets of variables, or more generally names, which are needed throughout
-      the compiler, are provided by the modules <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/basicTypes/VarSet.lhs"><code>VarSet.lhs</code></a>
-      and <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/basicTypes/NameSet.lhs"><code>NameSet.lhs</code></a>,
-      respectively.  Moreover, frequently maps from variables (or names) to
-      other data is needed.  For example, a substitution is represented by a
-      finite map from variable names to expressions.  Jobs like this are
-      solved by means of variable and name environments implemented by the
-      modules <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/basicTypes/VarEnv.lhs"><code>VarEnv.lhs</code></a>
-      and <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/basicTypes/NameEnv.lhs"><code>NameEnv.lhs</code></a>.
-
-    <h4>The Module <code>VarSet</code></h4>
-    <p>
-      The Module <code>VarSet</code> provides the types <code>VarSet</code>,
-      <code>IdSet</code>, and <code>TyVarSet</code>, which are synonyms in the
-      current implementation, as <code>Var</code>, <code>Id</code>, and
-      <code>TyVar</code> are synonyms.  The module provides all the operations
-      that one would expect including the creating of sets from individual
-      variables and lists of variables, union and intersection operations,
-      element checks, deletion, filter, fold, and map functions.
-    <p>
-      The implementation is based on <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/utils/UniqSet.lhs"><code>UniqSet</code></a>s, 
-      which in turn are simply <a href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/utils/UniqFM.lhs"><code>UniqFM</code></a>s
-      (i.e., finite maps with uniques as keys) that map each unique to the
-      variable that it represents.
-      
-    <h4>The Module <code>NameSet</code></h4>
-    <p>
-      The Module <code>NameSet</code> provides the same functionality as
-      <code>VarSet</code> only for <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/basicTypes/Name.lhs"><code>Name</code></a>s.
-      As for the difference between <code>Name</code>s and <code>Var</code>s,
-      a <code>Var</code> is built from a <code>Name</code> plus additional
-      information (mostly importantly type information).
-
-    <h4>The Module <code>VarEnv</code></h4>
-    <p>
-      The module <code>VarEnv</code> provides the types <code>VarEnv</code>,
-      <code>IdEnv</code>, and <code>TyVarEnv</code>, which are again
-      synonyms.  The provided base functionality is similar to
-      <code>VarSet</code> with the main difference that a type <code>VarEnv
-      T</code> associates a value of type <code>T</code> with each variable in
-      the environment, thus effectively implementing a finite map from
-      variables to values of type <code>T</code>.
-    <p>
-      The implementation of <code>VarEnv</code> is also by <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/utils/UniqFM.lhs"><code>UniqFM</code></a>,
-      which entails the slightly surprising implication that it is
-      <em>not</em> possible to retrieve the domain of a variable environment.
-      In other words, there is no function corresponding to
-      <code>VarSet.varSetElems :: VarSet -> [Var]</code> in
-      <code>VarEnv</code>.  This is because the <code>UniqFM</code> used to
-      implement <code>VarEnv</code> stores only the unique corresponding to a
-      variable in the environment, but not the entire variable (and there is
-      no mapping from uniques to variables).
-    <p>
-      In addition to plain variable environments, the module also contains
-      special substitution environments - the type <code>SubstEnv</code> -
-      that associates variables with a special purpose type
-      <code>SubstResult</code>.
-
-    <h4>The Module <code>NameEnv</code></h4>
-    <p>
-      The type <code>NameEnv.NameEnv</code> is like <code>VarEnv</code> only
-      for <code>Name</code>s.
-
-    <p><hr><small>
-<!-- hhmts start -->
-Last modified: Tue Jan  8 18:29:52 EST 2002
-<!-- hhmts end -->
-    </small>
-  </body>
-</html>
diff --git a/docs/comm/the-beast/coding-style.html b/docs/comm/the-beast/coding-style.html
deleted file mode 100644
index 41347c69022c..000000000000
--- a/docs/comm/the-beast/coding-style.html
+++ /dev/null
@@ -1,230 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
-<html>
-  <head>
-    <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-8859-1">
-    <title>The GHC Commentary - Coding Style Guidelines</title>
-  </head>
-
-  <body BGCOLOR="FFFFFF">
-    <h1>The GHC Commentary - Coding Style Guidelines</h1>
-    
-    <p>This is a rough description of some of the coding practices and
-    style that we use for Haskell code inside <tt>ghc/compiler</tt>.
-
-    <p>The general rule is to stick to the same coding style as is
-    already used in the file you're editing.  If you must make
-    stylistic changes, commit them separately from functional changes,
-    so that someone looking back through the change logs can easily
-    distinguish them.
-
-    <h2>To literate or not to literate?</h2>
-
-    <p>In GHC we use a mixture of literate (<tt>.lhs</tt>) and
-    non-literate (<tt>.hs</tt>) source.  I (Simon M.) prefer to use
-    non-literate style, because I think the
-    <tt>\begin{code}..\end{code}</tt> clutter up the source too much,
-    and I like to use Haddock-style comments (we haven't tried
-    processing the whole of GHC with Haddock yet, though).
-
-    <h2>To CPP or not to CPP?</h2>
-
-    <p>We pass all the compiler sources through CPP.  The
-    <tt>-cpp</tt> flag is always added by the build system.  
-
-    <p>The following CPP symbols are used throughout the compiler:
-    
-    <dl>
-      <dt><tt>DEBUG</tt></dt>
-
-      <dd>Used to enables extra checks and debugging output in the
-      compiler.  The <tt>ASSERT</tt> macro (see <tt>HsVersions.h</tt>)
-      provides assertions which disappear when <tt>DEBUG</tt> is not
-      defined.
-
-      <p>All debugging output should be placed inside <tt>#ifdef
-      DEBUG</tt>; we generally use this to provide warnings about
-      strange cases and things that might warrant investigation.  When
-      <tt>DEBUG</tt> is off, the compiler should normally be silent
-      unless something goes wrong (exception when the verbosity level
-      is greater than zero).
-
-      <p>A good rule of thumb is that <tt>DEBUG</tt> shouldn't add
-      more than about 10-20% to the compilation time.  This is the case
-      at the moment.  If it gets too expensive, we won't use it.  For
-      more expensive runtime checks, consider adding a flag - see for
-      example <tt>-dcore-lint</tt>.
-      </dd>
-
-      <dt><tt>GHCI</tt></dt>
-      
-      <dd>Enables GHCi support, including the byte code generator and
-      interactive user interface.  This isn't the default, because the
-      compiler needs to be bootstrapped with itself in order for GHCi
-      to work properly.  The reason is that the byte-code compiler and
-      linker are quite closely tied to the runtime system, so it is
-      essential that GHCi is linked with the most up-to-date RTS.
-      Another reason is that the representation of certain datatypes
-      must be consistent between GHCi and its libraries, and if these
-      were inconsistent then disaster could follow.
-      </dd>
-
-    </dl>
-
-    <h2>Platform tests</h2>
-
-    <p>There are three platforms of interest to GHC:
- 
-    <ul>
-      <li>The <b>Build</b> platform.  This is the platform on which we
-      are building GHC.</li>
-      <li>The <b>Host</b> platform.  This is the platform on which we
-      are going to run this GHC binary, and associated tools.</li>
-      <li>The <b>Target</b> platform.  This is the platform for which
-      this GHC binary will generate code.</li>
-    </ul>
-
-    <p>At the moment, there is very limited support for having
-    different values for buil, host, and target.  In particular:</p>
-
-    <ul>
-      <li>The build platform is currently always the same as the host
-      platform.  The build process needs to use some of the tools in
-      the source tree, for example <tt>ghc-pkg</tt> and
-      <tt>hsc2hs</tt>.</li>
-      
-      <li>If the target platform differs from the host platform, then
-      this is generally for the purpose of building <tt>.hc</tt> files
-      from Haskell source for porting GHC to the target platform.
-      Full cross-compilation isn't supported (yet).</li>
-    </ul>
-
-    <p>In the compiler's source code, you may make use of the
-    following CPP symbols:</p>
-
-    <ul>
-      <li><em>xxx</em><tt>_TARGET_ARCH</tt></li>
-      <li><em>xxx</em><tt>_TARGET_VENDOR</tt></li>
-      <li><em>xxx</em><tt>_TARGET_OS</tt></li>
-      <li><em>xxx</em><tt>_HOST_ARCH</tt></li>
-      <li><em>xxx</em><tt>_HOST_VENDOR</tt></li>
-      <li><em>xxx</em><tt>_HOST_OS</tt></li>
-    </ul>
-    
-    <p>where <em>xxx</em> is the appropriate value:
-    eg. <tt>i386_TARGET_ARCH</tt>.
-
-    <h2>Compiler versions</h2>
-
-    <p>GHC must be compilable by every major version of GHC from 5.02
-    onwards, and itself.  It isn't necessary for it to be compilable
-    by every intermediate development version (that includes last
-    week's CVS sources).
-
-    <p>To maintain compatibility, use <tt>HsVersions.h</tt> (see
-    below) where possible, and try to avoid using <tt>#ifdef</tt> in
-    the source itself.
-
-    <h2>The source file</h2>
-
-    <p>We now describe a typical source file, annotating stylistic
-    choices as we go.
-
-<pre>
-{-# OPTIONS ... #-}
-</pre>
-
-    <p>An <tt>OPTIONS</tt> pragma is optional, but if present it
-    should go right at the top of the file.  Things you might want to
-    put in <tt>OPTIONS</tt> include:
-
-    <ul>
-      <li><tt>-#include</tt> options to bring into scope prototypes
-      for FFI declarations</li>
-      <li><tt>-fvia-C</tt> if you know that
-      this module won't compile with the native code generator.
-    </ul>
-
-    <p>Don't bother putting <tt>-cpp</tt> or <tt>-fglasgow-exts</tt>
-    in the <tt>OPTIONS</tt> pragma; these are already added to the
-    command line by the build system.
-
-
-<pre>
-module Foo (
-   T(..),
-   foo,	     -- :: T -> T
- ) where
-</pre>
-
-    <p>We usually (99% of the time) include an export list.  The only
-    exceptions are perhaps where the export list would list absolutely
-    everything in the module, and even then sometimes we do it anyway.
-
-    <p>It's helpful to give type signatures inside comments in the
-    export list, but hard to keep them consistent, so we don't always
-    do that.
-
-<pre>
-#include "HsVersions.h"
-</pre>
-
-    <p><tt>HsVersions.h</tt> is a CPP header file containing a number
-    of macros that help smooth out the differences between compiler
-    versions.  It defines, for example, macros for library module
-    names which have moved between versions.  Take a look.
-
-<pre>
--- friends
-import SimplMonad
-
--- GHC
-import CoreSyn
-import Id           ( idName, idType )
-import BasicTypes
-
--- libraries
-import DATA_IOREF   ( newIORef, readIORef )
-
--- std
-import List         ( partition )
-import Maybe        ( fromJust )
-</pre>
-
-   <p>List imports in the following order:
-   
-   <ul>
-     <li>Local to this subsystem (or directory) first</li>
-
-     <li>Compiler imports, generally ordered from specific to generic
-       (ie. modules from <tt>utils/</tt> and <tt>basicTypes/</tt>
-       usually come last)</li>
-
-     <li>Library imports</li>
-
-     <li>Standard Haskell 98 imports last</li>
-   </ul>
-
-   <p>Import library modules from the <tt>base</tt> and
-   <tt>haskell98</tt> packages only.  Use <tt>#defines</tt> in
-   <tt>HsVersions.h</tt> when the modules names differ between
-   versions of GHC (eg. <tt>DATA_IOREF</tt> in the example above).
-   For code inside <tt>#ifdef GHCI</tt>, don't need to worry about GHC
-   versioning (because we are bootstrapped).
-
-   <p>We usually use import specs to give an explicit list of the
-   entities imported from a module.  The main reason for doing this is
-   so that you can search the file for an entity and find which module
-   it comes from.  However, huge import lists can be a pain to
-   maintain, so we often omit the import specs when they start to get
-   long (actually I start omitting them when they don't fit on one
-   line --Simon M.).  Tip: use GHC's <tt>-fwarn-unused-imports</tt>
-   flag so that you get notified when an import isn't being used any
-   more.
-
-   <p>If the module can be compiled multiple ways (eg. GHCI
-   vs. non-GHCI), make sure the imports are properly <tt>#ifdefed</tt>
-   too, so as to avoid spurious unused import warnings.
-
-   <p><em>ToDo: finish this</em>
-  </body>
-</html>
diff --git a/docs/comm/the-beast/data-types.html b/docs/comm/the-beast/data-types.html
deleted file mode 100644
index 4ec220c9376d..000000000000
--- a/docs/comm/the-beast/data-types.html
+++ /dev/null
@@ -1,242 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
-<html>
-  <head>
-    <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-8859-1">
-    <title>The GHC Commentary - Data types and data constructors</title>
-  </head>
-
-  <body BGCOLOR="FFFFFF">
-    <h1>The GHC Commentary - Data types and data constructors</h1>
-    <p>
-
-This chapter was thoroughly changed Feb 2003.
-
-<h2>Data types</h2>
-
-Consider the following data type declaration:
-
-<pre>
-  data T a = MkT !(a,a) !(T a) | Nil
-
-  f x = case x of
-          MkT p q -> MkT p (q+1)
-	  Nil     -> Nil
-</pre>
-The user's source program mentions only the constructors <tt>MkT</tt>
-and <tt>Nil</tt>.  However, these constructors actually <em>do</em> something
-in addition to building a data value.  For a start, <tt>MkT</tt> evaluates
-its arguments.  Secondly, with the flag <tt>-funbox-strict-fields</tt> GHC
-will flatten (or unbox) the strict fields.  So we may imagine that there's the
-<em>source</em> constructor <tt>MkT</tt> and the <em>representation</em> constructor
-<tt>MkT</tt>, and things start to get pretty confusing.
-<p>
-GHC now generates three unique <tt>Name</tt>s for each data constructor:
-<pre>
-                                 ---- OccName ------
-			         String  Name space	Used for
-  ---------------------------------------------------------------------------
-  The "source data con" 	   MkT	  DataName	The DataCon itself
-  The "worker data con"		   MkT	  VarName	Its worker Id
-    aka "representation data con"
-  The "wrapper data con"	   $WMkT  VarName	Its wrapper Id (optional)
-</pre>
-Recall that each occurrence name (OccName) is a pair of a string and a
-name space (see <a href="names.html">The truth about names</a>), and
-two OccNames are considered the same only if both components match.
-That is what distinguishes the name of the name of the DataCon from
-the name of its worker Id.  To keep things unambiguous, in what
-follows we'll write "MkT{d}" for the source data con, and "MkT{v}" for
-the worker Id.  (Indeed, when you dump stuff with "-ddumpXXX", if you
-also add "-dppr-debug" you'll get stuff like "Foo {- d rMv -}". The
-"d" part is the name space; the "rMv" is the unique key.)
-<p>
-Each of these three names gets a distinct unique key in GHC's name cache.
-
-<h2>The life cycle of a data type</h2>
-
-Suppose the Haskell source looks like this:
-<pre>
-  data T a = MkT !(a,a) !Int | Nil
-
-  f x = case x of
-          Nil     -> Nil
-          MkT p q -> MkT p (q+1)
-</pre>
-When the parser reads it in, it decides which name space each lexeme comes
-from, thus:
-<pre>
-  data T a = MkT{d} !(a,a) !Int | Nil{d}
-
-  f x = case x of
-          Nil{d}     -> Nil{d}
-          MkT{d} p q -> MkT{d} p (q+1)
-</pre>
-Notice that in the Haskell source <em>all data contructors are named via the "source data con" MkT{d}</em>,
-whether in pattern matching or in expressions.
-<p>
-In the translated source produced by the type checker (-ddump-tc), the program looks like this:
-<pre>
-  f x = case x of
-          Nil{d}     -> Nil{v}
-          MkT{d} p q -> $WMkT p (q+1)
-	  
-</pre>
-Notice that the type checker replaces the occurrence of MkT by the <em>wrapper</em>, but
-the occurrence of Nil by the <em>worker</em>.  Reason: Nil doesn't have a wrapper because there is
-nothing to do in the wrapper (this is the vastly common case).
-<p>
-Though they are not printed out by "-ddump-tc", behind the scenes, there are
-also the following: the data type declaration and the wrapper function for MkT.
-<pre>
-  data T a = MkT{d} a a Int# | Nil{d}
- 
-  $WMkT :: (a,a) -> T a -> T a
-  $WMkT p t = case p of 
-                (a,b) -> seq t (MkT{v} a b t)
-</pre>
-Here, the <em>wrapper</em> <tt>$WMkT</tt> evaluates and takes apart the argument <tt>p</tt>,
-evaluates the argument <tt>t</tt>, and builds a three-field data value
-with the <em>worker</em> constructor <tt>MkT{v}</tt>.  (There are more notes below
-about the unboxing of strict fields.)  The worker $WMkT is called an <em>implicit binding</em>,
-because it's introduced implicitly by the data type declaration (record selectors
-are also implicit bindings, for example).  Implicit bindings are injected into the code
-just before emitting code or External Core.
-<p>
-After desugaring into Core (-ddump-ds), the definition of <tt>f</tt> looks like this:
-<pre>
-  f x = case x of
-          Nil{d}       -> Nil{v}
-          MkT{d} a b r -> let { p = (a,b); q = I# r } in 
-	                  $WMkT p (q+1)
-</pre>
-Notice the way that pattern matching has been desugared to take account of the fact
-that the "real" data constructor MkT has three fields.  
-<p>
-By the time the simplifier has had a go at it, <tt>f</tt> will be transformed to:
-<pre>
-  f x = case x of
-          Nil{d}       -> Nil{v}
-          MkT{d} a b r -> MkT{v} a b (r +# 1#)
-</pre>
-Which is highly cool.
-
-
-<h2> The constructor wrapper functions </h2>
-
-The wrapper functions are automatically generated by GHC, and are
-really emitted into the result code (albeit only after CorePre; see
-<tt>CorePrep.mkImplicitBinds</tt>).  
-The wrapper functions are inlined very
-vigorously, so you will not see many occurrences of the wrapper
-functions in an optimised program, but you may see some.  For example,
-if your Haskell source has
-<pre>
-    map MkT xs
-</pre>
-then <tt>$WMkT</tt> will not be inlined (because it is not applied to anything).
-That is why we generate real top-level bindings for the wrapper functions,
-and generate code for them.
-
-
-<h2> The constructor worker functions </h2>
-
-Saturated applications of the constructor worker function MkT{v} are
-treated specially by the code generator; they really do allocation.
-However, we do want a single, shared, top-level definition for
-top-level nullary constructors (like True and False).  Furthermore,
-what if the code generator encounters a non-saturated application of a
-worker?  E.g. <tt>(map Just xs)</tt>.  We could declare that to be an
-error (CorePrep should saturate them). But instead we currently
-generate a top-level definition for each constructor worker, whether
-nullary or not.  It takes the form:
-<pre>
-  MkT{v} = \ p q r -> MkT{v} p q r
-</pre>
-This is a real hack. The occurrence on the RHS is saturated, so the code generator (both the
-one that generates abstract C and the byte-code generator) treats it as a special case and
-allocates a MkT; it does not make a recursive call!  So now there's a top-level curried
-version of the worker which is available to anyone who wants it.
-<p>
-This strange definition is not emitted into External Core.  Indeed, you might argue that
-we should instead pass the list of <tt>TyCon</tt>s to the code generator and have it 
-generate magic bindings directly.  As it stands, it's a real hack: see the code in
-CorePrep.mkImplicitBinds.
-
-
-<h2> External Core </h2>
-
-When emitting External Core, we should see this for our running example:
-
-<pre>
-  data T a = MkT a a Int# | Nil{d}
- 
-  $WMkT :: (a,a) -> T a -> T a
-  $WMkT p t = case p of 
-                (a,b) -> seq t (MkT a b t)
-
-  f x = case x of
-          Nil       -> Nil
-          MkT a b r -> MkT a b (r +# 1#)
-</pre>
-Notice that it makes perfect sense as a program all by itself.   Constructors
-look like constructors (albeit not identical to the original Haskell ones).
-<p>
-When reading in External Core, the parser is careful to read it back in just
-as it was before it was spat out, namely:
-<pre>
-  data T a = MkT{d} a a Int# | Nil{d}
- 
-  $WMkT :: (a,a) -> T a -> T a
-  $WMkT p t = case p of 
-                (a,b) -> seq t (MkT{v} a b t)
-
-  f x = case x of
-          Nil{d}       -> Nil{v}
-          MkT{d} a b r -> MkT{v} a b (r +# 1#)
-</pre>
-
-
-<h2> Unboxing strict fields </h2>
-
-If GHC unboxes strict fields (as in the first argument of <tt>MkT</tt> above), 
-it also transforms
-source-language case expressions.  Suppose you write this in your Haskell source:
-<pre>
-   case e of 
-     MkT p t -> ..p..t..
-</pre>
-GHC will desugar this to the following Core code:
-<pre>
-   case e of
-     MkT a b t -> let p = (a,b) in ..p..t..
-</pre>
-The local let-binding reboxes the pair because it may be mentioned in
-the case alternative.  This may well be a bad idea, which is why
-<tt>-funbox-strict-fields</tt> is an experimental feature.
-<p>
-It's essential that when importing a type <tt>T</tt> defined in some
-external module <tt>M</tt>, GHC knows what representation was used for
-that type, and that in turn depends on whether module <tt>M</tt> was
-compiled with <tt>-funbox-strict-fields</tt>.  So when writing an
-interface file, GHC therefore records with each data type whether its
-strict fields (if any) should be unboxed.
-
-<h2> Labels and info tables </h2>
-
-<em>Quick rough notes: SLPJ March 2003</em>.
-<p>
-Every data constructor <tt>C</tt>has two info tables:
-<ul>
-<li> The static info table (label <tt>C_static_info</tt>), used for statically-allocated constructors.
-
-<li> The dynamic info table (label <tt>C_con_info</tt>), used for dynamically-allocated constructors.
-</ul>
-Statically-allocated constructors are not moved by the garbage collector, and therefore have a different closure
-type from dynamically-allocated constructors; hence they need
-a distinct info table.  
-Both info tables share the same entry code, but since the entry code is phyiscally juxtaposed with the
-info table, it must be duplicated (<tt>C_static_entry</tt> and <tt>C_con_entry</tt> respectively).
-
-  </body>
-</html>
-
diff --git a/docs/comm/the-beast/desugar.html b/docs/comm/the-beast/desugar.html
deleted file mode 100644
index a66740259bff..000000000000
--- a/docs/comm/the-beast/desugar.html
+++ /dev/null
@@ -1,156 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
-<html>
-  <head>
-    <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-8859-1">
-    <title>The GHC Commentary - Sugar Free: From Haskell To Core</title>
-  </head>
-
-  <body BGCOLOR="FFFFFF">
-    <h1>The GHC Commentary - Sugar Free: From Haskell To Core</h1>
-    <p>
-      Up until after type checking, GHC keeps the source program in an
-      abstract representation of Haskell source without removing any of the
-      syntactic sugar (such as, list comprehensions) that could easily be
-      represented by more primitive Haskell.  This complicates part of the
-      front-end considerably as the abstract syntax of Haskell (as exported by
-      the module <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/hsSyn/HsSyn.lhs"><code>HsSyn</code></a>)
-      is much more complex than a simplified representation close to, say, the
-      <a href="http://haskell.org/onlinereport/intro.html#sect1.2">Haskell
-      Kernel</a> would be.  However, having a representation that is as close
-      as possible to the surface syntax simplifies the generation of clear
-      error messages.  As GHC (quite in contrast to "conventional" compilers)
-      prints code fragments as part of error messages, the choice of
-      representation is especially important.
-    <p>
-      Nonetheless, as soon as the input has passed all static checks, it is
-      transformed into GHC's principal intermediate language that goes by the
-      name of <em>Core</em> and whose representation is exported by the
-      module <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/coreSyn/CoreSyn.lhs"><code>CoreSyn</code></a>.  
-      All following compiler phases, except code generation operate on Core.
-      Due to Andrew Tolmach's effort, there is also an <a
-      href="http://www.haskell.org/ghc/docs/papers/core.ps.gz">external
-      representation for Core.</a>
-    <p>
-      The conversion of the compiled module from <code>HsSyn</code> into that
-      of <code>CoreSyn</code> is performed by a phase called the
-      <em>desugarer</em>, which is located in
-      <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/deSugar/"><code>fptools/ghc/compiler/deSugar/</code></a>.
-      It's operation is detailed in the following.
-    </p>
-
-    <h2>Auxilliary Functions</h2>
-    <p>
-      The modules <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/deSugar/DsMonad.lhs"><code>DsMonad</code></a>
-      defines the desugarer monad (of type <code>DsM</code>) which maintains
-      the environment needed for desugaring.  In particular, it encapsulates a
-      unique supply for generating new variables, a map to lookup standard
-      names (such as functions from the prelude), a source location for error
-      messages, and a pool to collect warning messages generated during
-      desugaring.  Initialisation of the environment happens in the function <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/deSugar/Desugar.lhs"><code>Desugar</code></a><code>.desugar</code>, 
-      which is also the main entry point into the desugarer.
-    <p>
-      The generation of Core code often involves the use of standard functions
-      for which proper identifiers (i.e., values of type <code>Id</code> that
-      actually refer to the definition in the right Prelude) need to be
-      obtained.  This is supported by the function
-      <code>DsMonad.dsLookupGlobalValue :: Name -> DsM Id</code>.
-
-    <h2><a name="patmat">Pattern Matching</a></h2>
-    <p>
-      Nested pattern matching with guards and everything is translated into
-      the simple, flat case expressions of Core by the following modules:
-    <dl>
-      <dt><a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/deSugar/Match.lhs"><code>Match</code></a>:
-      <dd>This modules contains the main pattern-matching compiler in the form
-	of a function called <code>match</code>.  There is some documentation
-	as to how <code>match</code> works contained in the module itself.
-	Generally, the implemented algorithm is similar to the one described
-	in Phil Wadler's Chapter ? of Simon Peyton Jones' <em>The
-	Implementation of Functional Programming Languages</em>.
-	<code>Match</code> exports a couple of functions with not really
-	intuitive names.  In particular, it exports <code>match</code>,
-	<code>matchWrapper</code>, <code>matchExport</code>, and
-	<code>matchSimply</code>.  The function <code>match</code>, which is
-	the main work horse, is only used by the other matching modules.  The
-	function <code>matchExport</code> - despite it's name - is merely used
-	internally in <code>Match</code> and handles warning messages (see
-	below for more details).  The actual interface to the outside is
-	<code>matchWrapper</code>, which converts the output of the type
-	checker into the form needed by the pattern matching compiler (i.e., a
-	list of <code>EquationInfo</code>).  Similar in function to
-	<code>matchWrapper</code> is <code>matchSimply</code>, which provides
-	an interface for the case where a single expression is to be matched
-	against a single pattern (as, for example, is the case in bindings in
-	a <code>do</code> expression).
-      <dt><a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/deSugar/MatchCon.lhs"><code>MatchCon</code></a>:
-      <dd>This module generates code for a set of alternative constructor
-	patterns that belong to a single type by means of the routine
-	<code>matchConFamily</code>.  More precisely, the routine gets a set
-	of equations where the left-most pattern of each equation is a
-	constructor pattern with a head symbol from the same type as that of
-	all the other equations.  A Core case expression is generated that
-	distinguihes between all these constructors.  The routine is clever
-	enough to generate a sparse case expression and to add a catch-all
-	default case only when needed (i.e., if the case expression isn't
-	exhaustive already).  There is also an explanation at the start of the
-	modules.
-      <dt><a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/deSugar/MatchLit.lhs"><code>MatchLit</code></a>:
-      <dd>Generates code for a set of alternative literal patterns by means of
-	the routine <code>matchLiterals</code>.  The principle is similar to
-	that of <code>matchConFamily</code>, but all left-most patterns are
-	literals of the same type.
-      <dt><a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/deSugar/DsUtils.lhs"><code>DsUtils</code></a>:
-      <dd>This module provides a set of auxilliary definitions as well as the
-      data types <code>EquationInfo</code> and <code>MatchResult</code> that
-      form the input and output, respectively, of the pattern matching
-      compiler.
-      <dt><a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/deSugar/Check.lhs"><code>Check</code></a>:
-      <dd>This module does not really contribute the compiling pattern
-      matching, but it inspects sets of equations to find whether there are
-      any overlapping patterns or non-exhaustive pattern sets.  This task is
-      implemented by the function <code>check</code>, which returns a list of
-      patterns that are part of a non-exhaustive case distinction as well as a
-      set of equation labels that can be reached during execution of the code;
-      thus, the remaining equations are shadowed due to overlapping patterns.
-      The function <code>check</code> is invoked and its result converted into
-      suitable warning messages by the function <code>Match.matchExport</code>
-      (which is a wrapper for <code>Match.match</code>).
-    </dl>
-    <p>
-      The central function <code>match</code>, given a set of equations,
-      proceeds in a number of steps:
-      <ol>
-      <li>It starts by desugaring the left-most pattern of each equation using
-	the function <code>tidy1</code> (indirectly via
-	<code>tidyEqnInfo</code>).  During this process, non-elementary
-	pattern (e.g., those using explicit list syntax <code>[x, y, ...,
-	z]</code>) are converted to a standard constructor pattern and also
-	irrefutable pattern are removed.
-      <li>Then, a process called <em>unmixing</em> clusters the equations into
-	blocks (without re-ordering them), such that the left-most pattern of
-	all equations in a block are either all variables, all literals, or
-	all constructors.
-      <li>Each block is, then, compiled by <code>matchUnmixedEqns</code>,
-	which forwards the handling of literal pattern blocks to
-	<code>MatchLit.matchLiterals</code>, of constructor pattern blocks to
-	<code>MatchCon.matchConFamily</code>, and hands variable pattern
-	blocks back to <code>match</code>.
-      </ol>
-
-    <p><hr><small>
-<!-- hhmts start -->
-Last modified: Mon Feb 11 22:35:25 EST 2002
-<!-- hhmts end -->
-    </small>
-  </body>
-</html>
diff --git a/docs/comm/the-beast/driver.html b/docs/comm/the-beast/driver.html
deleted file mode 100644
index fbf65e33e79e..000000000000
--- a/docs/comm/the-beast/driver.html
+++ /dev/null
@@ -1,179 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
-<html>
-  <head>
-    <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-8859-1">
-    <title>The GHC Commentary - The Glorious Driver</title>
-  </head>
-
-  <body BGCOLOR="FFFFFF">
-    <h1>The GHC Commentary - The Glorious Driver</h1>
-    <p>
-      The Glorious Driver (GD) is the part of GHC that orchestrates the
-      interaction of all the other pieces that make up GHC.  It supersedes the
-      <em>Evil Driver (ED),</em> which was a Perl script that served the same
-      purpose and was in use until version 4.08.1 of GHC.  Simon Marlow
-      eventually slayed the ED and instated the GD.  The GD is usually called
-      the <em>Compilation Manager</em> these days.
-    </p>
-    <p>
-      The GD has been substantially extended for GHCi, i.e., the interactive
-      variant of GHC that integrates the compiler with a (meta-circular)
-      interpreter since version 5.00.  Most of the driver is located in the
-      directory 
-      <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/main/"><code>fptools/ghc/compiler/main/</code></a>.
-    </p>
-
-    <h2>Command Line Options</h2>
-    <p>
-      GHC's many flavours of command line options make the code interpreting
-      them rather involved.  The following provides a brief overview of the
-      processing of these options.  Since the addition of the interactive
-      front-end to GHC, there are two kinds of options: <em>static
-      options</em> and <em>dynamic options.</em> The former can only be set
-      when the system is invoked, whereas the latter can be altered in the
-      course of an interactive session.  A brief explanation on the difference
-      between these options and related matters is at the start of the module
-      <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/main/CmdLineOpts.lhs"><code>CmdLineOpts</code></a>.
-      The same module defines the enumeration <code>DynFlag</code>, which
-      contains all dynamic flags.  Moreover, there is the labelled record
-      <code>DynFlags</code> that collects all the flag-related information
-      that is passed by the compilation manager to the compiler proper,
-      <code>hsc</code>, whenever a compilation is triggered.  If you like to
-      find out whether an option is static, use the predicate
-      <code>isStaticHscFlag</code> in the same module.
-    <p>
-      The second module that contains a lot of code related to the management
-      of flags is <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/main/DriverFlags.hs"><code>DriverFlags.hs</code></a>.
-      In particular, the module contains two association lists that map the
-      textual representation of the various flags to a data structure that
-      tells the driver how to parse the flag (e.g., whether it has any
-      arguments) and provides its internal representation.  All static flags
-      are contained in <code>static_flags</code>.  A whole range of
-      <code>-f</code> flags can be negated by adding a <code>-f-no-</code>
-      prefix.  These flags are contained in the association list
-      <code>fFlags</code>.
-    <p>
-      The driver uses a nasty hack based on <code>IORef</code>s that permits
-      the rest of the compiler to access static flags as CAFs; i.e., there is
-      a family of toplevel variable definitions in 
-      <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/main/CmdLineOpts.lhs"><code>CmdLineOpts</code></a>,
-      below the literate section heading <i>Static options</i>, each of which
-      contains the value of one static option.  This is essentially realised
-      via global variables (in the sense of C-style, updatable, global
-      variables) defined via an evil pre-processor macro named
-      <code>GLOBAL_VAR</code>, which is defined in a particularly ugly corner
-      of GHC, namely the C header file 
-      <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/HsVersions.h"><code>HsVersions.h</code></a>. 
-
-    <h2>What Happens When</h2>
-    <p>
-      Inside the Haskell compiler proper (<code>hsc</code>), a whole series of
-      stages (``passes'') are executed in order to transform your Haskell program
-      into C or native code.  This process is orchestrated by
-      <code>main/HscMain.hscMain</code> and its relative
-      <code>hscReComp</code>.  The latter directly invokes, in order,
-      the parser, the renamer, the typechecker, the desugarer, the
-      simplifier (Core2Core), the CoreTidy pass, the CorePrep pass,
-      conversion to STG (CoreToStg), the interface generator
-      (MkFinalIface), the code generator, and code output.  The
-      simplifier is the most complex of these, and is made up of many
-      sub-passes.  These are controlled by <code>buildCoreToDo</code>,
-      as described below.
-
-    <h2>Scheduling Optimisations Phases</h2>
-    <p>
-      GHC has a large variety of optimisations at its disposal, many of which
-      have subtle interdependencies.  The overall plan for program
-      optimisation is fixed in <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/main/DriverState.hs"><code>DriverState.hs</code></a>.
-      First of all, there is the variable <code>hsc_minusNoO_flags</code> that
-      determines the <code>-f</code> options that you get without
-      <code>-O</code> (aka optimisation level 0) as well as
-      <code>hsc_minusO_flags</code> and <code>hsc_minusO2_flags</code> for
-      <code>-O</code> and <code>-O2</code>.
-    <p>
-      However, most of the strategic decisions about optimisations on the
-      intermediate language Core are encoded in the value produced by
-      <code>buildCoreToDo</code>, which is a list with elements of type
-      <code>CoreToDo</code>.  Each element of this list specifies one step in
-      the sequence of core optimisations executed by the <a
-      href="simplifier.html">Mighty Simplifier</a>.  The type
-      <code>CoreToDo</code> is defined in <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/main/CmdLineOpts.lhs"><code>CmdLineOpts.lhs</code></a>.
-      The actual execution of the optimisation plan produced by
-      <code>buildCoreToDo</code> is performed by <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/simplCore/SimplCore.lhs"><code>SimpleCore</code></a><code>.doCorePasses</code>.
-      Core optimisation plans consist of a number of simplification phases
-      (currently, three for optimisation levels of 1 or higher) with
-      decreasing phase numbers (the lowest, corresponding to the last phase,
-      namely 0).  Before and after these phases, optimisations such as
-      specialisation, let floating, worker/wrapper, and so on are executed.
-      The sequence of phases is such that the synergistic effect of the phases
-      is maximised -- however, this is a fairly fragile arrangement.
-    <p>
-      There is a similar construction for optimisations on STG level stored in
-      the variable <code>buildStgToDo :: [StgToDo]</code>.  However, this is a
-      lot less complex than the arrangement for Core optimisations.
-
-    <h2>Linking the <code>RTS</code> and <code>libHSstd</code></h2>
-    <p>
-      Since the RTS and HSstd refer to each other, there is a Cunning
-      Hack to avoid putting them each on the command-line twice or
-      thrice (aside: try asking for `plaice and chips thrice' in a
-      fish and chip shop; bet you only get two lots).  The hack involves 
-      adding
-      the symbols that the RTS needs from libHSstd, such as
-      <code>PrelWeak_runFinalizzerBatch_closure</code> and
-      <code>__stginit_Prelude</code>, to the link line with the
-      <code>-u</code> flag.  The standard library appears before the
-      RTS on the link line, and these options cause the corresponding
-      symbols to be picked up even so the linked might not have seen them
-      being used as the RTS appears later on the link line.  As a result,
-      when the RTS is also scanned, these symbols are already resolved. This
-      avoids the linker having to read the standard library and RTS
-      multiple times.
-    </p>
-    <p>
-      This does, however, leads to a complication.  Normal Haskell
-      programs do not have a <code>main()</code> function, so this is
-      supplied by the RTS (in the file 
-      <a href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/rts/Main.c"><code>Main.c</code></a>).
-      It calls <code>startupHaskell</code>, which
-      itself calls <code>__stginit_PrelMain</code>, which is therefore,
-      since it occurs in the standard library, one of the symbols
-      passed to the linker using the <code>-u</code> option.  This is fine
-      for standalone Haskell programs, but as soon as the Haskell code is only
-      used as part of a program implemented in a foreign language, the
-      <code>main()</code> function of that foreign language should be used
-      instead of that of the Haskell runtime.  In this case, the previously
-      described arrangement unfortunately fails as 
-      <code>__stginit_PrelMain</code> had better not be linked in,
-      because it tries to call <code>__stginit_Main</code>, which won't
-      exist.  In other words, the RTS's <code>main()</code> refers to 
-      <code>__stginit_PrelMain</code> which in turn refers to
-      <code>__stginit_Main</code>.  Although the RTS's <code>main()</code> 
-      might not be linked in if the program provides its own, the driver 
-      will normally force <code>__stginit_PrelMain</code> to be linked in anyway,
-      using <code>-u</code>, because it's a back-reference from the
-      RTS to HSstd.  This case is coped with by the <code>-no-hs-main</code>
-      flag, which suppresses passing the corresonding <code>-u</code> option
-      to the linker -- although in some versions of the compiler (e.g., 5.00.2)
-      it didn't work.  In addition, the driver generally places the C program 
-      providing the <code>main()</code> that we want to use before the RTS
-      on the link line.  Therefore, the RTS's main is never used and
-      without the <code>-u</code> the label <code>__stginit_PrelMain</code> 
-      will not be linked.
-    </p>
-    
-    <p><small>
-<!-- hhmts start -->
-Last modified: Tue Feb 19 11:09:00 UTC 2002
-<!-- hhmts end -->
-    </small>
-  </body>
-</html>
diff --git a/docs/comm/the-beast/fexport.html b/docs/comm/the-beast/fexport.html
deleted file mode 100644
index 956043bafb6a..000000000000
--- a/docs/comm/the-beast/fexport.html
+++ /dev/null
@@ -1,231 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
-<html>
-  <head>
-    <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-8859-1">
-    <title>The GHC Commentary - foreign export</title>
-  </head>
-
-  <body BGCOLOR="FFFFFF">
-    <h1>The GHC Commentary - foreign export</h1>
-
-    The implementation scheme for foreign export, as of 27 Feb 02, is
-    as follows.  There are four cases, of which the first two are easy.
-    <p>
-    <b>(1) static export of an IO-typed function from some module <code>MMM</code></b>
-    <p>
-    <code>foreign export foo :: Int -> Int -> IO Int</code>
-    <p>
-    For this we generate no Haskell code.  However, a C stub is
-    generated, and it looks like this:
-    <p>
-    <pre>
-extern StgClosure* MMM_foo_closure;
-
-HsInt foo (HsInt a1, HsInt a2)
-{
-   SchedulerStatus rc;
-   HaskellObj ret;
-   rc = rts_evalIO(
-           rts_apply(rts_apply(MMM_foo_closure,rts_mkInt(a1)),
-                     rts_mkInt(a2)
-                    ),
-           &ret
-        );
-   rts_checkSchedStatus("foo",rc);
-   return(rts_getInt(ret));
-}
-</pre>
-    <p>
-    This does the obvious thing: builds in the heap the expression
-    <code>(foo a1 a2)</code>, calls <code>rts_evalIO</code> to run it,
-    and uses <code>rts_getInt</code> to fish out the result.
-
-    <p>
-    <b>(2) static export of a non-IO-typed function from some module <code>MMM</code></b>
-    <p>
-    <code>foreign export foo :: Int -> Int -> Int</code>
-    <p>
-    This is identical to case (1), with the sole difference that the
-    stub calls <code>rts_eval</code> rather than
-    <code>rts_evalIO</code>.
-    <p>
-
-    <b>(3) dynamic export of an IO-typed function from some module <code>MMM</code></b>
-    <p>
-    <code>foreign export mkCallback :: (Int -> Int -> IO Int) -> IO (FunPtr a)</code>
-    <p>
-    Dynamic exports are a whole lot more complicated than their static
-    counterparts.
-    <p>
-    First of all, we get some Haskell code, which, when given a
-    function <code>callMe :: (Int -> Int -> IO Int)</code> to be made
-    C-callable, IO-returns a <code>FunPtr a</code>, which is the
-    address of the resulting C-callable code.  This address can now be
-    handed out to the C-world, and callers to it will get routed
-    through to <code>callMe</code>.
-    <p>
-    The generated Haskell function looks like this:
-    <p>
-<pre>
-mkCallback f
-  = do sp <- mkStablePtr f
-       r  <- ccall "createAdjustorThunk" sp (&"run_mkCallback")
-       return r
-</pre>
-    <p>
-    <code>createAdjustorThunk</code> is a gruesome,
-    architecture-specific function in the RTS.  It takes a stable
-    pointer to the Haskell function to be run, and the address of the
-    associated C wrapper, and returns a piece of machine code,
-    which, when called from the outside (C) world, eventually calls
-    through to <code>f</code>.
-    <p>
-    This machine code fragment is called the "Adjustor Thunk" (don't
-    ask me why).  What it does is simply to call onwards to the C
-    helper
-    function <code>run_mkCallback</code>, passing all the args given
-    to it but also conveying <code>sp</code>, which is a stable
-    pointer
-    to the Haskell function to run.  So:
-    <p>
-<pre>
-createAdjustorThunk ( StablePtr sp, CCodeAddress addr_of_helper_C_fn ) 
-{
-   create malloc'd piece of machine code "mc", behaving thusly:
-
-   mc ( args_to_mc ) 
-   { 
-      jump to addr_of_helper_C_fn, passing sp as an additional
-      argument
-   }
-</pre>
-    <p>
-    This is a horrible hack, because there is no portable way, even at
-    the machine code level, to function which adds one argument and
-    then transfers onwards to another C function.  On x86s args are
-    pushed R to L onto the stack, so we can just push <code>sp</code>,
-    fiddle around with return addresses, and jump onwards to the
-    helper C function.  However, on architectures which use register
-    windows and/or pass args extensively in registers (Sparc, Alpha,
-    MIPS, IA64), this scheme borders on the unviable.  GHC has a
-    limited <code>createAdjustorThunk</code> implementation for Sparc
-    and Alpha, which handles only the cases where all args, including
-    the extra one, fit in registers.
-    <p>
-    Anyway: the other lump of code generated as a result of a
-    f-x-dynamic declaration is the C helper stub.  This is basically
-    the same as in the static case, except that it only ever gets
-    called from the adjustor thunk, and therefore must accept 
-    as an extra argument, a stable pointer to the Haskell function
-    to run, naturally enough, as this is not known until run-time.
-    It then dereferences the stable pointer and does the call in
-    the same way as the f-x-static case:
-<pre>
-HsInt Main_d1kv ( StgStablePtr the_stableptr, 
-                  void* original_return_addr, 
-                  HsInt a1, HsInt a2 )
-{
-   SchedulerStatus rc;
-   HaskellObj ret;
-   rc = rts_evalIO(
-           rts_apply(rts_apply((StgClosure*)deRefStablePtr(the_stableptr),
-                               rts_mkInt(a1)
-                     ),
-                     rts_mkInt(a2)
-           ),
-           &ret
-        );
-   rts_checkSchedStatus("Main_d1kv",rc);
-   return(rts_getInt(ret));
-}
-</pre>
-    <p>
-    Note how this function has a purely made-up name
-    <code>Main_d1kv</code>, since unlike the f-x-static case, this
-    function is never called from user code, only from the adjustor
-    thunk.
-    <p>
-    Note also how the function takes a bogus parameter
-    <code>original_return_addr</code>, which is part of this extra-arg
-    hack.  The usual scheme is to leave the original caller's return
-    address in place and merely push the stable pointer above that,
-    hence the spare parameter.
-    <p>
-    Finally, there is some extra trickery, detailed in
-    <code>ghc/rts/Adjustor.c</code>, to get round the following
-    problem: the adjustor thunk lives in mallocville.  It is
-    quite possible that the Haskell code will actually
-    call <code>free()</code> on the adjustor thunk used to get to it
-    -- because otherwise there is no way to reclaim the space used
-    by the adjustor thunk.  That's all very well, but it means that
-    the C helper cannot return to the adjustor thunk in the obvious
-    way, since we've already given it back using <code>free()</code>.
-    So we leave, on the C stack, the address of whoever called the
-    adjustor thunk, and before calling the helper, mess with the stack
-    such that when the helper returns, it returns directly to the
-    adjustor thunk's caller.  
-    <p>
-    That's how the <code>stdcall</code> convention works.  If the
-    adjustor thunk has been called using the <code>ccall</code>
-    convention, we return indirectly, via a statically-allocated
-    yet-another-magic-piece-of-code, which takes care of removing the
-    extra argument that the adjustor thunk pushed onto the stack.
-    This is needed because in <code>ccall</code>-world, it is the
-    caller who removes args after the call, and the original caller of
-    the adjustor thunk has no way to know about the extra arg pushed
-    by the adjustor thunk.
-    <p>
-    You didn't really want to know all this stuff, did you?
-    <p>
-
-
-
-    <b>(4) dynamic export of an non-IO-typed function from some module <code>MMM</code></b>
-    <p>
-    <code>foreign export mkCallback :: (Int -> Int -> Int) -> IO (FunPtr a)</code>
-    <p>
-    (4) relates to (3) as (2) relates to (1), that is, it's identical,
-    except the C stub uses <code>rts_eval</code> instead of
-    <code>rts_evalIO</code>.
-    <p>
-
-
-   <h2>Some perspective on f-x-dynamic</h2>
-
-   The only really horrible problem with f-x-dynamic is how the
-   adjustor thunk should pass to the C helper the stable pointer to
-   use.  Ideally we would like this to be conveyed via some invisible
-   side channel, since then the adjustor thunk could simply jump
-   directly to the C helper, with no non-portable stack fiddling.
-   <p>
-   Unfortunately there is no obvious candidate for the invisible
-   side-channel.  We've chosen to pass it on the stack, with the
-   bad consequences detailed above.  Another possibility would be to
-   park it in a global variable, but this is non-reentrant and
-   non-(OS-)thread-safe.  A third idea is to put it into a callee-saves
-   register, but that has problems too: the C helper may not use that
-   register and therefore we will have trashed any value placed there
-   by the caller; and there is no C-level portable way to read from
-   the register inside the C helper.
-   <p>
-   In short, we can't think of a really satisfactory solution.  I'd
-   vote for introducing some kind of OS-thread-local-state and passing
-   it in there, but that introduces complications of its own.
-   <p>
-   <b>OS-thread-safety</b> is of concern in the C stubs, whilst
-   building up the expressions to run.  These need to have exclusive
-   access to the heap whilst allocating in it.  Also, there needs to
-   be some guarantee that no GC will happen in between the
-   <code>deRefStablePtr</code> call and when <code>rts_eval[IO]</code>
-   starts running.  At the moment there are no guarantees for
-   either property.  This needs to be sorted out before the
-   implementation can be regarded as fully safe to use.
-
-<p><small>
-   
-<!-- hhmts start -->
-Last modified: Weds 27 Feb 02
-<!-- hhmts end -->
-    </small>
-  </body>
-</html>
diff --git a/docs/comm/the-beast/ghci.html b/docs/comm/the-beast/ghci.html
deleted file mode 100644
index b893acdeb462..000000000000
--- a/docs/comm/the-beast/ghci.html
+++ /dev/null
@@ -1,407 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
-<html>
-  <head>
-    <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-8859-1">
-    <title>The GHC Commentary - GHCi</title>
-  </head>
-
-  <body BGCOLOR="FFFFFF">
-    <h1>The GHC Commentary - GHCi</h1>
-
-    This isn't a coherent description of how GHCi works, sorry.  What
-    it is (currently) is a dumping ground for various bits of info
-    pertaining to GHCi, which ought to be recorded somewhere.
-
-    <h2>Debugging the interpreter</h2>
-
-    The usual symptom is that some expression / program crashes when
-    running on the interpreter (commonly), or gets wierd results
-    (rarely).  Unfortunately, finding out what the problem really is
-    has proven to be extremely difficult.  In retrospect it may be
-    argued a design flaw that GHC's implementation of the STG
-    execution mechanism provides only the weakest of support for
-    automated internal consistency checks.  This makes it hard to
-    debug.
-    <p>
-    Execution failures in the interactive system can be due to
-    problems with the bytecode interpreter, problems with the bytecode
-    generator, or problems elsewhere.  From the bugs seen so far, 
-    the bytecode generator is often the culprit, with the interpreter
-    usually being correct.
-    <p>
-    Here are some tips for tracking down interactive nonsense:
-    <ul>
-      <li>Find the smallest source fragment which causes the problem.
-      <p>
-      <li>Using an RTS compiled with <code>-DDEBUG</code> (nb, that
-          means the RTS from the previous stage!), run with <code>+RTS
-          -D2</code> to get a listing in great detail from the
-          interpreter.  Note that the listing is so voluminous that
-          this is impractical unless you have been diligent in
-          the previous step.
-      <p>
-      <li>At least in principle, using the trace and a bit of GDB
-          poking around at the time of death, you can figure out what
-          the problem is.  In practice you quickly get depressed at
-          the hopelessness of ever making sense of the mass of
-          details.  Well, I do, anyway.
-      <p>
-      <li><code>+RTS -D2</code> tries hard to print useful
-          descriptions of what's on the stack, and often succeeds.
-          However, it has no way to map addresses to names in
-          code/data loaded by our runtime linker.  So the C function
-          <code>ghci_enquire</code> is provided.  Given an address, it
-          searches the loaded symbol tables for symbols close to that
-          address.  You can run it from inside GDB:
-      <pre>
-      (gdb) p ghci_enquire ( 0x50a406f0 )
-      0x50a406f0 + -48  ==  `PrelBase_Czh_con_info'
-      0x50a406f0 + -12  ==  `PrelBase_Izh_static_info'
-      0x50a406f0 + -48  ==  `PrelBase_Czh_con_entry'
-      0x50a406f0 + -24  ==  `PrelBase_Izh_con_info'
-      0x50a406f0 +  16  ==  `PrelBase_ZC_con_entry'
-      0x50a406f0 +   0  ==  `PrelBase_ZMZN_static_entry'
-      0x50a406f0 + -36  ==  `PrelBase_Czh_static_entry'
-      0x50a406f0 + -24  ==  `PrelBase_Izh_con_entry'
-      0x50a406f0 +  64  ==  `PrelBase_EQ_static_info'
-      0x50a406f0 +   0  ==  `PrelBase_ZMZN_static_info'
-      0x50a406f0 +  48  ==  `PrelBase_LT_static_entry'
-      $1 = void
-      </pre>
-         In this case the enquired-about address is
-         <code>PrelBase_ZMZN_static_entry</code>.  If no symbols are
-         close to the given addr, nothing is printed.  Not a great
-         mechanism, but better than nothing.
-      <p>
-      <li>We have had various problems in the past due to the bytecode
-          generator (<code>compiler/ghci/ByteCodeGen.lhs</code>) being
-          confused about the true set of free variables of an
-          expression.  The compilation scheme for <code>let</code>s
-          applies the BCO for the RHS of the let to its free
-          variables, so if the free-var annotation is wrong or
-          misleading, you end up with code which has wrong stack
-          offsets, which is usually fatal.
-      <p>
-      <li>The baseline behaviour of the interpreter is to interpret
-          BCOs, and hand all other closures back to the scheduler for
-          evaluation.  However, this causes a huge number of expensive
-          context switches, so the interpreter knows how to enter the
-          most common non-BCO closure types by itself.
-          <p>
-          These optimisations complicate the interpreter.
-          If you think you have an interpreter problem, re-enable the
-          define <code>REFERENCE_INTERPRETER</code> in
-          <code>ghc/rts/Interpreter.c</code>.  All optimisations are
-          thereby disabled, giving the baseline
-          I-only-know-how-to-enter-BCOs behaviour.
-      <p>
-      <li>Following the traces is often problematic because execution
-          hops back and forth between the interpreter, which is
-          traced, and compiled code, which you can't see.
-          Particularly annoying is when the stack looks OK in the
-          interpreter, then compiled code runs for a while, and later
-          we arrive back in the interpreter, with the stack corrupted,
-          and usually in a completely different place from where we
-          left off.
-          <p>
-          If this is biting you baaaad, it may be worth copying
-          sources for the compiled functions causing the problem, into
-          your interpreted module, in the hope that you stay in the
-          interpreter more of the time.  Of course this doesn't work
-          very well if you've defined
-          <code>REFERENCE_INTERPRETER</code> in
-          <code>ghc/rts/Interpreter.c</code>.
-      <p>
-      <li>There are various commented-out pieces of code in
-          <code>Interpreter.c</code> which can be used to get the
-          stack sanity-checked after every entry, and even after after
-          every bytecode instruction executed.  Note that some
-          bytecodes (<code>PUSH_UBX</code>) leave the stack in
-          an unwalkable state, so the <code>do_print_stack</code>
-          local variable is used to suppress the stack walk after
-          them.
-    </ul>
-
-
-    <h2>Useful stuff to know about the interpreter</h2>
-
-    The code generation scheme is straightforward (naive, in fact).
-    <code>-ddump-bcos</code> prints each BCO along with the Core it
-    was generated from, which is very handy.
-    <ul>
-    <li>Simple lets are compiled in-line.  For the general case, let
-        v = E in ..., E is compiled into a new BCO which takes as
-        args its free variables, and v is bound to AP(the new BCO,
-        free vars of E).
-    <p>
-    <li><code>case</code>s as usual, become: push the return
-        continuation, enter the scrutinee.  There is some magic to
-        make all combinations of compiled/interpreted calls and
-        returns work, described below.  In the interpreted case, all
-        case alts are compiled into a single big return BCO, which
-        commences with instructions implementing a switch tree.
-    </ul>
-    <p>
-    <b>ARGCHECK magic</b>
-    <p>
-    You may find ARGCHECK instructions at the start of BCOs which
-    don't appear to need them; case continuations in particular.
-    These play an important role: they force objects which should
-    evaluated to BCOs to actually be BCOs.
-    <p>
-    Typically, there may be an application node somewhere in the heap.
-    This is a thunk which when leant on turns into a BCO for a return
-    continuation.  The thunk may get entered with an update frame on
-    top of the stack.  This is legitimate since from one viewpoint
-    this is an AP which simply reduces to a data object, so does not
-    have functional type.  However, once the AP turns itself into a
-    BCO (so to speak) we cannot simply enter the BCO, because that
-    expects to see args on top of the stack, not an update frame.
-    Therefore any BCO which expects something on the stack above an
-    update frame, even non-function BCOs, start with an ARGCHECK.  In
-    this case it fails, the update is done, the update frame is
-    removed, and the BCO re-entered.  Subsequent entries of the BCO of
-    course go unhindered.
-    <p>
-    The optimised (<code>#undef REFERENCE_INTERPRETER</code>) handles
-    this case specially, so that a trip through the scheduler is
-    avoided.  When reading traces from <code>+RTS -D2 -RTS</code>, you
-    may see BCOs which appear to execute their initial ARGCHECK insn
-    twice.  The first time it fails; the interpreter does the update
-    immediately and re-enters with no further comment.
-    <p>
-    This is all a bit ugly, and, as SimonM correctly points out, it
-    would have been cleaner to make BCOs unpointed (unthunkable)
-    objects, so that a pointer to something <code>:: BCO#</code>
-    really points directly at a BCO.
-    <p>
-    <b>Stack management</b>
-    <p>
-    There isn't any attempt to stub the stack, minimise its growth, or
-    generally remove unused pointers ahead of time.  This is really
-    due to lazyness on my part, although it does have the minor
-    advantage that doing something cleverer would almost certainly
-    increase the number of bytecodes that would have to be executed.
-    Of course we SLIDE out redundant stuff, to get the stack back to
-    the sequel depth, before returning a HNF, but that's all.  As
-    usual this is probably a cause of major space leaks.
-    <p>
-    <b>Building constructors</b>
-    <p>
-    Constructors are built on the stack and then dumped into the heap
-    with a single PACK instruction, which simply copies the top N
-    words of the stack verbatim into the heap, adds an info table, and zaps N
-    words from the stack.  The constructor args are pushed onto the
-    stack one at a time.  One upshot of this is that unboxed values
-    get pushed untaggedly onto the stack (via PUSH_UBX), because that's how they
-    will be in the heap.  That in turn means that the stack is not 
-    always walkable at arbitrary points in BCO execution, although
-    naturally it is whenever GC might occur.
-    <p>
-    Function closures created by the interpreter use the AP-node
-    (tagged) format, so although their fields are similarly
-    constructed on the stack, there is never a stack walkability
-    problem.
-    <p>
-    <b>Unpacking constructors</b>
-    <p>
-    At the start of a case continuation, the returned constructor is
-    unpacked onto the stack, which means that unboxed fields have to
-    be tagged.  Rather than burdening all such continuations with a
-    complex, general mechanism, I split it into two.  The
-    allegedly-common all-pointers case uses a single UNPACK insn
-    to fish out all fields with no further ado.  The slow case uses a
-    sequence of more complex UPK_TAG insns, one for each field (I
-    think).  This seemed like a good compromise to me.
-    <p>
-    <b>Perspective</b>
-    <p>
-    I designed the bytecode mechanism with the experience of both STG
-    hugs and Classic Hugs in mind.  The latter has an small
-    set of bytecodes, a small interpreter loop, and runs amazingly
-    fast considering the cruddy code it has to interpret.  The former
-    had a large interpretative loop with many different opcodes,
-    including multiple minor variants of the same thing, which
-    made it difficult to optimise and maintain, yet it performed more
-    or less comparably with Classic Hugs.
-    <p>
-    My design aims were therefore to minimise the interpreter's
-    complexity whilst maximising performance.  This means reducing the
-    number of opcodes implemented, whilst reducing the number of insns
-    despatched.  In particular there are only two opcodes, PUSH_UBX
-    and UPK_TAG, which deal with tags.  STG Hugs had dozens of opcodes
-    for dealing with tagged data.  In cases where the common
-    all-pointers case is significantly simpler (UNPACK) I deal with it
-    specially.  Finally, the number of insns executed is reduced a
-    little by merging multiple pushes, giving PUSH_LL and PUSH_LLL.
-    These opcode pairings were determined by using the opcode-pair
-    frequency profiling stuff which is ifdef-d out in
-    <code>Interpreter.c</code>.  These significantly improve
-    performance without having much effect on the uglyness or
-    complexity of the interpreter.
-    <p>
-    Overall, the interpreter design is something which turned out
-    well, and I was pleased with it.  Unfortunately I cannot say the
-    same of the bytecode generator.
-
-    <h2><code>case</code> returns between interpreted and compiled code</h2>
-
-    Variants of the following scheme have been drifting around in GHC
-    RTS documentation for several years.  Since what follows is
-    actually what is implemented, I guess it supersedes all other
-    documentation.  Beware; the following may make your brain melt.
-    In all the pictures below, the stack grows downwards.
-    <p>
-    <b>Returning to interpreted code</b>.
-    <p>
-    Interpreted returns employ a set of polymorphic return infotables.
-    Each element in the set corresponds to one of the possible return
-    registers (R1, D1, F1) that compiled code will place the returned
-    value in.  In fact this is a bit misleading, since R1 can be used
-    to return either a pointer or an int, and we need to distinguish
-    these cases.  So, supposing the set of return registers is {R1p,
-    R1n, D1, F1}, there would be four corresponding infotables,
-    <code>stg_ctoi_ret_R1p_info</code>, etc.  In the pictures below we
-    call them <code>stg_ctoi_ret_REP_info</code>.  
-    <p>
-    These return itbls are polymorphic, meaning that all 8 vectored
-    return codes and the direct return code are identical.
-    <p>
-    Before the scrutinee is entered, the stack is arranged like this:
-    <pre>
-   |        |
-   +--------+
-   |  BCO   | -------> the return contination BCO
-   +--------+
-   | itbl * | -------> stg_ctoi_ret_REP_info, with all 9 codes as follows:
-   +--------+
-                          BCO* bco = Sp[1];
-                          push R1/F1/D1 depending on REP
-                          push bco
-                          yield to sched
-    </pre>
-    On entry, the interpreted contination BCO expects the stack to look
-    like this:
-    <pre>
-   |        |
-   +--------+
-   |  BCO   | -------> the return contination BCO
-   +--------+
-   | itbl * | -------> ret_REP_ctoi_info, with all 9 codes as follows:
-   +--------+
-   : VALUE  :  (the returned value, shown with : since it may occupy
-   +--------+   multiple stack words)
-    </pre>
-    A machine code return will park the returned value in R1/F1/D1,
-    and enter the itbl on the top of the stack.  Since it's our magic
-    itbl, this pushes the returned value onto the stack, which is
-    where the interpreter expects to find it.  It then pushes the BCO
-    (again) and yields.  The scheduler removes the BCO from the top,
-    and enters it, so that the continuation is interpreted with the
-    stack as shown above.
-    <p>
-    An interpreted return will create the value to return at the top
-    of the stack.  It then examines the return itbl, which must be
-    immediately underneath the return value, to see if it is one of
-    the magic <code>stg_ctoi_ret_REP_info</code> set.  Since this is so,
-    it knows it is returning to an interpreted contination.  It
-    therefore simply enters the BCO which it assumes it immediately
-    underneath the itbl on the stack.
-
-    <p>
-    <b>Returning to compiled code</b>.
-    <p>
-    Before the scrutinee is entered, the stack is arranged like this:
-    <pre>
-                        ptr to vec code 8 ------> return vector code 8
-   |        |           ....
-   +--------+           ptr to vec code 1 ------> return vector code 1
-   | itbl * | --        Itbl end
-   +--------+   \       ....   
-                 \      Itbl start
-                  ----> direct return code
-    </pre>
-    The scrutinee value is then entered.
-    The case continuation(s) expect the stack to look the same, with
-    the returned HNF in a suitable return register, R1, D1, F1 etc.
-    <p>
-    A machine code return knows whether it is doing a vectored or
-    direct return, and, if the former, which vector element it is.
-    So, for a direct return we jump to <code>Sp[0]</code>, and for a
-    vectored return, jump to <code>((CodePtr*)(Sp[0]))[ - ITBL_LENGTH
-    - vector number ]</code>.  This is (of course) the scheme that
-    compiled code has been using all along.
-    <p>
-    An interpreted return will, as described just above, have examined
-    the itbl immediately beneath the return value it has just pushed,
-    and found it not to be one of the <code>ret_REP_ctoi_info</code> set,
-    so it knows this must be a return to machine code.  It needs to
-    pop the return value, currently on the stack, into R1/F1/D1, and
-    jump through the info table.  Unfortunately the first part cannot
-    be accomplished directly since we are not in Haskellised-C world.
-    <p>
-    We therefore employ a second family of magic infotables, indexed,
-    like the first, on the return representation, and therefore with
-    names of the form <code>stg_itoc_ret_REP_info</code>.  (Note:
-    <code>itoc</code>; the previous bunch were <code>ctoi</code>).
-    This is pushed onto the stack (note, tagged values have their tag
-    zapped), giving:
-    <pre>
-   |        |
-   +--------+
-   | itbl * | -------> arbitrary machine code return itbl
-   +--------+
-   : VALUE  :  (the returned value, possibly multiple words)
-   +--------+
-   | itbl * | -------> stg_itoc_ret_REP_info, with code:
-   +--------+
-                          pop myself (stg_itoc_ret_REP_info) off the stack
-                          pop return value into R1/D1/F1
-                          do standard machine code return to itbl at t.o.s.
-    </pre>
-    We then return to the scheduler, asking it to enter the itbl at
-    t.o.s.  When entered, <code>stg_itoc_ret_REP_info</code> removes
-    itself from the stack, pops the return value into the relevant
-    return register, and returns to the itbl to which we were trying
-    to return in the first place.  
-    <p>
-    Amazingly enough, this stuff all actually works!  Well, mostly ...
-    <p>
-    <b>Unboxed tuples: a Right Royal Spanner In The Works</b>
-    <p>
-    The above scheme depends crucially on having magic infotables
-    <code>stg_{itoc,ctoi}_ret_REP_info</code> for each return
-    representation <code>REP</code>.  It unfortunately fails miserably
-    in the face of unboxed tuple returns, because the set of required
-    tables would be infinite; this despite the fact that for any given
-    unboxed tuple return type, the scheme could be made to work fine.
-    <p>
-    This is a serious problem, because it prevents interpreted
-    code from doing <code>IO</code>-typed returns, since <code>IO
-    t</code> is implemented as <code>(# t, RealWorld# #)</code> or
-    thereabouts.  This restriction in turn rules out FFI stuff in the
-    interpreter.  Not good.
-    <p>
-    Although we have no way to make general unboxed tuples work, we
-    can at least make <code>IO</code>-types work using the following
-    ultra-kludgey observation: <code>RealWorld#</code> doesn't really
-    exist and so has zero size, in compiled code.  In turn this means
-    that a type of the form <code>(# t, RealWorld# #)</code> has the
-    same representation as plain <code>t</code> does.  So the bytecode
-    generator, whilst rejecting code with general unboxed tuple
-    returns, recognises and accepts this special case.  Which means
-    that <code>IO</code>-typed stuff works in the interpreter.  Just.
-    <p>
-    If anyone asks, I will claim I was out of radio contact, on a
-    6-month walking holiday to the south pole, at the time this was
-    ... er ... dreamt up.
-
-
-<p><small>
-   
-<!-- hhmts start -->
-Last modified: Thursday February  7 15:33:49 GMT 2002
-<!-- hhmts end -->
-    </small>
-  </body>
-</html>
diff --git a/docs/comm/the-beast/main.html b/docs/comm/the-beast/main.html
deleted file mode 100644
index 332ffaa50163..000000000000
--- a/docs/comm/the-beast/main.html
+++ /dev/null
@@ -1,35 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
-<html>
-  <head>
-    <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-8859-1">
-    <title>The GHC Commentary - Compiling and running the Main module</title>
-  </head>
-
-  <body BGCOLOR="FFFFFF">
-    <h1>Compiling and running the Main module</h1>
-
-GHC allows you to determine which module contains the "main" function, and
-what that function is called, via the <code>-fmain-is</code> flag.   The trouble is
-that the runtime system is fixed, so what symbol should it link to?
-<p>
-The current solution is this.  Suppose the main function is <code>Foo.run</code>.
-<ul>
-<li>
-Then, when compiling module <code>Foo</code>, GHC adds an extra definition:
-<pre>
-  :Main.main = runIO Foo.run
-</pre>
-Now the RTS can invoke <code>:Main.main</code> to start the program.  (This extra
-definition is inserted in TcRnDriver.checkMain.)
-<p><li>
-Before starting the program, though, the RTS also initialises the module tree
-by calling <code>init_:Main</code>, so when compiling the main module (Foo in this case),
-as well as generating <code>init_Foo</code> as usual, GHC also generates
-<pre>
-  init_zcMain() { init_Foo; }
-</pre>
-This extra initialisation code is generated in CodeGen.mkModuleInit.
-</ul>
-
-  </body>
-</html>
diff --git a/docs/comm/the-beast/mangler.html b/docs/comm/the-beast/mangler.html
deleted file mode 100644
index 1ad80f0d5c38..000000000000
--- a/docs/comm/the-beast/mangler.html
+++ /dev/null
@@ -1,79 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
-<html>
-  <head>
-    <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-8859-1">
-    <title>The GHC Commentary - The Evil Mangler</title>
-  </head>
-
-  <body BGCOLOR="FFFFFF">
-    <h1>The GHC Commentary - The Evil Mangler</h1>
-    <p>
-      The Evil Mangler (EM) is a Perl script invoked by the <a
-	href="driver.html">Glorious Driver</a> after the C compiler (gcc) has
-      translated the GHC-produced C code into assembly.  Consequently, it is
-      only of interest if <code>-fvia-C</code> is in effect (either explicitly
-      or implicitly).
-
-    <h4>Its purpose</h4>
-    <p>
-      The EM reads the assembly produced by gcc and re-arranges code blocks as
-      well as nukes instructions that it considers <em>non-essential.</em> It
-      derives it evilness from its utterly ad hoc, machine, compiler, and
-      whatnot dependent design and implementation.  More precisely, the EM
-      performs the following tasks:
-    <ul>
-      <li>The code executed when a closure is entered is moved adjacent to
-	that closure's infotable.  Moreover, the order of the info table
-	entries is reversed.  Also, SRT pointers are removed from closures that
-        don't need them (non-FUN, RET and THUNK ones).
-      <li>Function prologue and epilogue code is removed.  (GHC generated code
-	manages its own stack and uses the system stack only for return
-	addresses and during calls to C code.)
-      <li>Certain code patterns are replaced by simpler code (eg, loads of
-	fast entry points followed by indirect jumps are replaced by direct
-	jumps to the fast entry point).
-    </ul>
-
-    <h4>Implementation</h4>
-    <p>
-      The EM is located in the Perl script <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/driver/mangler/ghc-asm.lprl"><code>ghc-asm.lprl</code></a>.
-      The script reads the <code>.s</code> file and chops it up into
-      <em>chunks</em> (that's how they are actually called in the script) that
-      roughly correspond to basic blocks.  Each chunk is annotated with an
-      educated guess about what kind of code it contains (e.g., infotable,
-      fast entry point, slow entry point, etc.).  The annotations also contain
-      the symbol introducing the chunk of assembly and whether that chunk has
-      already been processed or not.
-    <p>
-      The parsing of the input into chunks as well as recognising assembly
-      instructions that are to be removed or altered is based on a large
-      number of Perl regular expressions sprinkled over the whole code.  These
-      expressions are rather fragile as they heavily rely on the structure of
-      the generated code - in fact, they even rely on the right amount of
-      white space and thus on the formatting of the assembly.
-    <p>
-      Afterwards, the chunks are reordered, some of them purged, and some
-      stripped of some useless instructions.  Moreover, some instructions are
-      manipulated (eg, loads of fast entry points followed by indirect jumps
-      are replaced by direct jumps to the fast entry point).
-    <p>
-      The EM knows which part of the code belongs to function prologues and
-      epilogues as <a href="../rts-libs/stgc.html">STG C</a> adds tags of the
-      form <code>--- BEGIN ---</code> and <code>--- END ---</code> the
-      assembler just before and after the code proper of a function starts.
-      It adds these tags using gcc's <code>__asm__</code> feature.
-    <p>
-      <strong>Update:</strong> Gcc 2.96 upwards performs more aggressive basic
-      block re-ordering and dead code elimination.  This seems to make the
-      whole <code>--- END ---</code> tag business redundant -- in fact, if
-      proper code is generated, no <code>--- END ---</code> tags survive gcc
-      optimiser. 
-
-    <p><small>
-<!-- hhmts start -->
-Last modified: Sun Feb 17 17:55:47 EST 2002
-<!-- hhmts end -->
-    </small>
-  </body>
-</html>
diff --git a/docs/comm/the-beast/modules.html b/docs/comm/the-beast/modules.html
deleted file mode 100644
index a6655a68a760..000000000000
--- a/docs/comm/the-beast/modules.html
+++ /dev/null
@@ -1,80 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
-<html>
-  <head>
-    <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-8859-1">
-    <title>The GHC Commentary - Modules, ModuleNames and Packages</title>
-  </head>
-
-  <body BGCOLOR="FFFFFF">
-    <h1>Modules, ModuleNames and Packages</h1>
-
-    <p>This section describes the datatypes <code>ModuleName</code>
-    <code>Module</code> and <code>PackageName</code> all available
-    from the module <a
-    href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/basicTypes/Module.lhs"><code>Module</code></a>.<p>
-
-    <h2>Packages</h2>
-
-    <p>A package is a collection of (zero or more) Haskell modules,
-    together with some information about external libraries, extra C
-    compiler options, and other things that this collection of modules
-    requires.  When using DLLs on windows (or shared libraries on a
-    Unix system; currently unsupported), a package can consist of only
-    a single shared library of Haskell code; the reason for this is
-    described below.
-
-    <p>Packages are further described in the User's Guide <a
-    href="http://www.haskell.org/ghc/docs/latest/packages.html">here</a>.
-
-    <h2>The ModuleName type</h2>
-
-    <p>At the bottom of the hierarchy is a <code>ModuleName</code>,
-    which, as its name suggests, is simply the name of a module.  It
-    is represented as a Z-encoded FastString, and is an instance of
-    <code>Uniquable</code> so we can build <code>FiniteMap</code>s
-    with <code>ModuleName</code>s as the keys.
-
-    <p>A <code>ModuleName</code> can be built from a
-    <code>String</code>, using the <code>mkModuleName</code> function.
-
-    <h2>The Module type</h2>
-
-    <p>For a given module, the compiler also needs to know whether the
-    module is in the <em>home package</em>, or in another package.
-    This distinction is important for two reasons:
-
-    <ul>
-    <li><p>When generating code to call a function in another package,
-    the compiler might have to generate a cross-DLL call, which is
-    different from an intra-DLL call (hence the restriction that the
-    code in a package can only reside in a single DLL).
-
-    <li><p>We avoid putting version information in an interface file
-    for entities defined in another package, on the grounds that other
-    packages are generally "stable".  This also helps keep the size of
-    interface files down.
-    </ul>
-
-    <p>The <code>Module</code> type contains a <code>ModuleName</code>
-    and a <code>PackageInfo</code> field.  The
-    <code>PackageInfo</code> indicates whether the given
-    <code>Module</code> comes from the current package or from another
-    package.
-
-    <p>To get the actual package in which a given module resides, you
-    have to read the interface file for that module, which contains
-    the package name (actually the value of the
-    <code>-package-name</code> flag when that module was built).  This
-    information is currently unused inside the compiler, but we might
-    make use of it in the future, especially with the advent of
-    hierarchical modules, to allow the compiler to automatically
-    figure out which packages a program should be linked with, and
-    thus avoid the need to specify <code>-package</code> options on
-    the command line.
-
-    <p><code>Module</code>s are also instances of
-    <code>Uniquable</code>, and indeed the unique of a
-    <code>Module</code> is the same as the unique of the underlying
-    <code>ModuleName</code>.
-  </body>
-</html>
diff --git a/docs/comm/the-beast/names.html b/docs/comm/the-beast/names.html
deleted file mode 100644
index 061fae3ebfef..000000000000
--- a/docs/comm/the-beast/names.html
+++ /dev/null
@@ -1,169 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
-<html>
-  <head>
-    <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-8859-1">
-    <title>The GHC Commentary - The truth about names: OccNames, and Names</title>
-  </head>
-
-  <body BGCOLOR="FFFFFF">
-    <h1>The GHC Commentary - The truth about names: OccNames, and Names</h1>
-    <p>
-      Every entity (type constructor, class, identifier, type variable) has a
-      <code>Name</code>.  The <code>Name</code> type is pervasive in GHC, and
-      is defined in <code>basicTypes/Name.lhs</code>.  Here is what a Name
-      looks like, though it is private to the Name module.
-    </p>
-    <blockquote>
-      <pre>
-data Name = Name {
-	      n_sort :: NameSort,	-- What sort of name it is
-	      n_occ  :: !OccName,	-- Its occurrence name
-	      n_uniq :: Unique,		-- Its identity
-	      n_loc  :: !SrcLoc		-- Definition site
-	  }</pre>
-    </blockquote>
-    <ul>
-      <li> The <code>n_sort</code> field says what sort of name this is: see
-	<a href="#sort">NameSort below</a>.
-      <li> The <code>n_occ</code> field gives the "occurrence name" of the
-	Name; see 
-	<a href="#occname">OccName below</a>.
-      <li> The <code>n_uniq</code> field allows fast tests for equality of
-	Names. 
-      <li> The <code>n_loc</code> field gives some indication of where the
-	name was bound. 
-    </ul>
-    
-    <h2><a name="sort">The <code>NameSort</code> of a <code>Name</code></a></h2>
-    <p>
-      There are four flavours of <code>Name</code>:
-    </p>
-    <blockquote>
-      <pre>
-data NameSort
-  = External Module (Maybe Name)
-	-- (Just parent) => this Name is a subordinate name of 'parent'
-	-- e.g. data constructor of a data type, method of a class
-	-- Nothing => not a subordinate
- 
-  | WiredIn Module (Maybe Name) TyThing BuiltInSyntax
-	-- A variant of External, for wired-in things
-
-  | Internal		-- A user-defined Id or TyVar
-			-- defined in the module being compiled
-
-  | System		-- A system-defined Id or TyVar.  Typically the
-			-- OccName is very uninformative (like 's')</pre>
-    </blockquote>
-    <ul>
-      <li>Here are the sorts of Name an entity can have:
-	<ul>
-	  <li> Class, TyCon: External.
-	  <li> Id: External, Internal, or System.
-	  <li> TyVar: Internal, or System.
-	</ul>
-      </li>
-      <li>An <code>External</code> name has a globally-unique
-	(module name, occurrence name) pair, namely the 
-	<em>original name</em> of the entity,
-	describing where the thing was originally defined.  So for example,
-	if we have
-	<blockquote>
-	  <pre>
-module M where
-  f = e1
-  g = e2
-
-module A where
-  import qualified M as Q
-  import M
-  a = Q.f + g</pre>
-	</blockquote>
-	<p>
-	  then the RdrNames for "a", "Q.f" and "g" get replaced (by the
-	  Renamer)  by the Names "A.a", "M.f", and "M.g" respectively.
-	</p>
-      </li>
-      <li>An <code>InternalName</code> 
-	has only an occurrence name.  Distinct InternalNames may have the same
-	occurrence name; use the Unique to distinguish them.
-      </li>
-      <li>An <code>ExternalName</code> has a unique that never changes.  It
-	is never cloned.  This is important, because the simplifier invents
-	new names pretty freely, but we don't want to lose the connnection
-	with the type environment (constructed earlier).  An
-	<code>InternalName</code> name can be cloned freely.
-      </li>
-      <li><strong>Before CoreTidy</strong>: the Ids that were defined at top
-	level in the original source program get <code>ExternalNames</code>,
-	whereas extra top-level bindings generated (say) by the type checker
-	get <code>InternalNames</code>. q This distinction is occasionally
-	useful for filtering diagnostic output; e.g.  for -ddump-types.
-      </li>
-      <li><strong>After CoreTidy</strong>: An Id with an
-	<code>ExternalName</code> will generate symbols that 
-	appear as external symbols in the object file.  An Id with an
-	<code>InternalName</code> cannot be referenced from outside the
-	module, and so generates a local symbol in the object file.  The
-	CoreTidy pass makes the decision about which names should be External
-	and which Internal.
-      </li>
-      <li>A <code>System</code> name is for the most part the same as an
-	<code>Internal</code>.  Indeed, the differences are purely cosmetic:
-	<ul>
-	  <li>Internal names usually come from some name the
-	    user wrote, whereas a System name has an OccName like "a", or "t".
-	    Usually there are masses of System names with the same OccName but
-	    different uniques, whereas typically there are only a handful of
-	    distince Internal names with the same OccName.
-	  </li>
-	  <li>Another difference is that when unifying the type checker tries
-	    to  unify away type variables with System names, leaving ones with
-	    Internal names (to improve error messages).
-	  </li>
-	</ul>
-      </li>
-    </ul>
-
-    <h2><a name="occname">Occurrence names: <code>OccName</code></a></h2>
-    <p>
-      An <code>OccName</code> is more-or-less just a string, like "foo" or
-      "Tree", giving the (unqualified) name of an entity.
-    </p>
-    <p>
-      Well, not quite just a string, because in Haskell a name like "C" could
-      mean a type constructor or data constructor, depending on context.  So
-      GHC defines a type <tt>OccName</tt> (defined in
-      <tt>basicTypes/OccName.lhs</tt>) that is a pair of a <tt>FastString</tt>
-      and a <tt>NameSpace</tt> indicating which name space the name is drawn
-      from:
-      <blockquote>
-      <pre>
-data OccName = OccName NameSpace EncodedFS</pre>
-    </blockquote>
-    <p>
-      The <tt>EncodedFS</tt> is a synonym for <tt>FastString</tt> indicating
-      that the string is Z-encoded.  (Details in <tt>OccName.lhs</tt>.)
-      Z-encoding encodes funny characters like '%' and '$' into alphabetic
-      characters, like "zp" and "zd", so that they can be used in object-file
-      symbol tables without confusing linkers and suchlike.
-    </p>
-    <p>
-      The name spaces are:
-    </p>
-    <ul>
-      <li> <tt>VarName</tt>: ordinary variables</li>
-      <li> <tt>TvName</tt>: type variables</li>
-      <li> <tt>DataName</tt>: data constructors</li>
-      <li> <tt>TcClsName</tt>: type constructors and classes (in Haskell they
-	share a name space) </li>
-    </ul>
-
-    <small>
-<!-- hhmts start -->
-Last modified: Wed May  4 14:57:55 EST 2005
-<!-- hhmts end -->
-    </small>
-  </body>
-</html>
-
diff --git a/docs/comm/the-beast/ncg.html b/docs/comm/the-beast/ncg.html
deleted file mode 100644
index 84beac2d5164..000000000000
--- a/docs/comm/the-beast/ncg.html
+++ /dev/null
@@ -1,749 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
-<html>
-  <head>
-    <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-8859-1">
-    <title>The GHC Commentary - The Native Code Generator</title>
-  </head>
-
-  <body BGCOLOR="FFFFFF">
-    <h1>The GHC Commentary - The Native Code Generator</h1>
-    <p>
-      On some platforms (currently x86 and PowerPC, with bitrotted
-      support for Sparc and Alpha), GHC can generate assembly code
-      directly, without having to go via C.  This can sometimes almost
-      halve compilation time, and avoids the fragility and
-      horribleness of the <a href="mangler.html">mangler</a>.  The NCG
-      is enabled by default for
-      non-optimising compilation on supported platforms.  For most programs
-      it generates code which runs only 1-3% slower
-      (depending on platform and type of code) than that
-      created by gcc on x86s, so it is well worth using even with
-      optimised compilation.  FP-intensive x86 programs see a bigger
-      slowdown, and all Sparc code runs about 5% slower due to
-      us not filling branch delay slots.
-    <p>
-      The NCG has always been something of a second-class citizen
-      inside GHC, an unloved child, rather.  This means that its
-      integration into the compiler as a whole is rather clumsy, which
-      brings some problems described below.  That apart, the NCG
-      proper is fairly cleanly designed, as target-independent as it
-      reasonably can be, and so should not be difficult to retarget.
-    <p>
-      <b>NOTE!</b> The native code generator was largely rewritten as part
-      of the C-- backend changes, around May 2004.  Unfortunately the
-      rest of this document still refers to the old version, and was written
-      with relation to the CVS head as of end-Jan 2002.  Some of it is relevant,
-      some of it isn't.
-
-    <h2>Overview</h2>
-      The top-level code generator fn is
-    <p>
-    <code>absCtoNat :: AbstractC -> UniqSM (SDoc, Pretty.Doc)</code>
-    <p>
-    The returned <code>SDoc</code> is for debugging, so is empty unless
-    you specify <code>-ddump-stix</code>.  The <code>Pretty.Doc</code>
-    bit is the final assembly code.  Translation involves three main
-    phases, the first and third of which are target-independent.
-    <ul>
-    <li><b>Translation into the <code>Stix</code> representation.</b>  Stix
-        is a simple tree-like RTL-style language, in which you can
-        mention:
-        <p>
-        <ul>
-        <li>An infinite number of temporary, virtual registers.
-        <li>The STG "magic" registers (<code>MagicId</code>), such as
-            the heap and stack pointers.
-        <li>Literals and low-level machine ops (<code>MachOp</code>).
-        <li>Simple address computations.
-        <li>Reads and writes of: memory, virtual regs, and various STG
-            regs. 
-        <li>Labels and <code>if ... goto ...</code> style control-flow.
-        </ul>
-        <p>
-        Stix has two main associated types:
-        <p>
-        <ul>
-        <li><code>StixStmt</code> -- trees executed for their side
-        effects: assignments, control transfers, and auxiliary junk
-        such as segment changes and literal data.
-        <li><code>StixExpr</code> -- trees which denote a value.
-        </ul>
-        <p>
-        Translation into Stix is almost completely
-        target-independent.  Needed dependencies are knowledge of
-        word size and endianness, used when generating code to do 
-        deal with half-word fields in info tables.  This could be
-        abstracted out easily enough.  Also, the Stix translation
-        needs to know which <code>MagicId</code>s map to registers
-        on the given target, and which are stored in offsets from
-        <code>BaseReg</code>.
-        <p>
-        After initial Stix generation, the trees are cleaned up with
-        constant-folding and a little copy-propagation ("Stix
-        inlining", as the code misleadingly calls it).  We take
-        the opportunity to translate <code>MagicId</code>s which are
-        stored in memory on the given target, into suitable memory
-        references.  Those which are stored in registers are left
-        alone.  There is also a half-hearted attempt to lift literal
-        strings to the top level in cases where nested strings have
-        been observed to give incorrect code in the past.
-        <p>
-        Primitive machine-level operations will already be phrased in
-        terms of <code>MachOp</code>s in the presented Abstract C, and
-        these are passed through unchanged.  We comment only that the
-        <code>MachOp</code>s have been chosen so as to be easy to
-        implement on all targets, and their meaning is intended to be
-        unambiguous, and the same on all targets, regardless of word
-        size or endianness.
-        <p>
-        <b>A note on <code>MagicId</code>s.</b>
-        Those which are assigned to
-        registers on the current target are left unmodified.  Those
-        which are not are stored in memory as offsets from
-        <code>BaseReg</code> (which is assumed to permanently have the
-        value <code>(&MainCapability.r)</code>), so the constant folder
-        calculates the offsets and inserts suitable loads/stores.  One
-        complication is that not all archs have <code>BaseReg</code>
-        itself in a register, so for those (sparc), we instead
-        generate the address as an offset from the static symbol
-        <code>MainCapability</code>, since the register table lives in
-        there.
-        <p>
-        Finally, <code>BaseReg</code> does occasionally itself get
-        mentioned in Stix expression trees, and in this case what is
-        denoted is precisely <code>(&MainCapability.r)</code>, not, as
-        in all other cases, the value of memory at some offset from
-        the start of the register table.  Since what it denotes is an
-        r-value and not an l-value, assigning <code>BaseReg</code> is
-        meaningless, so the machinery checks to ensure this never
-        happens.  All these details are taken into account by the
-        constant folder.
-    <p>
-    <li><b>Instruction selection.</b>  This is the only majorly
-        target-specific phase.  It turns Stix statements and
-        expressions into sequences of <code>Instr</code>, a data
-        type which is different for each architecture.
-        <code>Instr</code>, unsurprisingly, has various supporting
-        types, such as <code>Reg</code>, <code>Operand</code>,
-        <code>Imm</code>, etc.  The generated instructions may refer
-        to specific machine registers, or to arbitrary virtual
-        registers, either those created within the instruction
-        selector, or those mentioned in the Stix passed to it.
-        <p>
-        The instruction selectors live in <code>MachCode.lhs</code>.
-        The core functions, for each target, are:
-        <p>
-        <code>
-        getAmode :: StixExpr -> NatM Amode
-        <br>getRegister :: StixExpr -> NatM Register
-        <br>assignMem_IntCode :: PrimRep -> StixExpr -> StixExpr -> NatM InstrBlock
-        <br>assignReg_IntCode :: PrimRep -> StixReg  -> StixExpr -> NatM InstrBlock
-        </code>
-        <p>
-        The insn selectors use the "maximal munch" algorithm.  The
-        bizarrely-misnamed <code>getRegister</code> translates
-        expressions.  A simplified version of its type is:
-        <p>
-        <code>getRegister :: StixExpr -> NatM (OrdList Instr, Reg)</code>
-        <p>
-        That is: it (monadically) turns a <code>StixExpr</code> into a
-        sequence of instructions, and a register, with the meaning
-        that after executing the (possibly empty) sequence of
-        instructions, the (possibly virtual) register will
-        hold the resulting value.  The real situation is complicated
-        by the presence of fixed registers, and is detailed below.
-        <p>
-        Maximal munch is a greedy algorithm and is known not to give
-        globally optimal code sequences, but it is good enough, and
-        fast and simple.  Early incarnations of the NCG used something
-        more sophisticated, but that is long gone now.
-        <p>
-        Similarly, <code>getAmode</code> translates a value, intended
-        to denote an address, into a sequence of insns leading up to
-        a (processor-specific) addressing mode.  This stuff could be
-        done using the general <code>getRegister</code> selector, but
-        would necessarily generate poorer code, because the calculated
-        address would be forced into a register, which might be
-        unnecessary if it could partially or wholly be calculated
-        using an addressing mode.
-        <p>
-        Finally, <code>assignMem_IntCode</code> and
-        <code>assignReg_IntCode</code> create instruction sequences to
-        calculate a value and store it in the given register, or at
-        the given address.  Because these guys translate a statement,
-        not a value, they just return a sequence of insns and no
-        associated register.  Floating-point and 64-bit integer
-        assignments have analogous selectors.
-        <p>
-        Apart from the complexities of fixed vs floating registers,
-        discussed below, the instruction selector is as simple
-        as it can be.  It looks long and scary but detailed
-        examination reveals it to be fairly straightforward.
-    <p>
-    <li><b>Register allocation.</b> The register allocator,
-        <code>AsmRegAlloc.lhs</code> takes sequences of
-        <code>Instr</code>s which mention a mixture of real and
-        virtual registers, and returns a modified sequence referring
-        only to real ones.  It is gloriously and entirely
-        target-independent.  Well, not exactly true.  Instead it
-        regards <code>Instr</code> (instructions) and <code>Reg</code>
-        (virtual and real registers) as abstract types, to which it has
-        the following interface:
-        <p>
-        <code>
-        insnFuture :: Instr -> InsnFuture
-        <br>regUsage :: Instr -> RegUsage
-        <br>patchRegs :: Instr -> (Reg -> Reg) -> Instr
-        </code>
-        <p>
-        <code>insnFuture</code> is used to (re)construct the graph of
-        all possible control transfers between the insns to be
-        allocated.  <code>regUsage</code> returns the sets of registers
-        read and written by an instruction.  And
-        <code>patchRegs</code> is used to apply the allocator's final
-        decision on virtual-to-real reg mapping to an instruction.
-        <p>
-        Clearly these 3 fns have to be written anew for each
-        architecture.  They are defined in
-        <code>RegAllocInfo.lhs</code>.  Think twice, no, thrice,
-        before modifying them: making false claims about insn
-        behaviour will lead to hard-to-find register allocation
-        errors.
-        <p>
-        <code>AsmRegAlloc.lhs</code> contains detailed comments about
-	how the allocator works.  Here is a summary.  The head honcho
-        <p>
-        <code>allocUsingTheseRegs :: [Instr] -> [Reg] -> (Bool, [Instr])</code>
-        <p>
-        takes a list of instructions and a list of real registers
-        available for allocation, and maps as many of the virtual regs
-        in the input into real ones as it can.  The returned
-        <code>Bool</code> indicates whether or not it was
-        successful.  If so, that's the end of it.  If not, the caller
-        of <code>allocUsingTheseRegs</code> will attempt spilling.
-        More of that later.  What <code>allocUsingTheseRegs</code>
-        does is:
-        <p>
-        <ul>
-        <li>Implicitly number each instruction by its position in the
-            input list.
-        <p>
-        <li>Using <code>insnFuture</code>, create the set of all flow
-            edges -- possible control transfers -- within this set of
-            insns.
-        <p>
-        <li>Using <code>regUsage</code> and iterating around the flow
-            graph from the previous step, calculate, for each virtual
-            register, the set of flow edges on which it is live.
-        <p>
-        <li>Make a real-register committment map, which gives the set
-            of edges for which each real register is committed (in
-            use).  These sets are initially empty.  For each virtual
-            register, attempt to find a real register whose current
-            committment does not intersect that of the virtual
-            register -- ie, is uncommitted on all edges that the
-            virtual reg is live.  If successful, this means the vreg
-            can be assigned to the realreg, so add the vreg's set to
-            the realreg's committment.  
-        <p>
-        <li>If all the vregs were assigned to a realreg, use
-            <code>patchInstr</code> to apply the mapping to the insns themselves.
-        </ul>
-        <p>
-        <b>Spilling</b>
-        <p>
-        If <code>allocUsingTheseRegs</code> fails, a baroque
-        mechanism comes into play.  We now know that much simpler
-        schemes are available to do the same thing and give better
-        results.  
-        Anyways:
-        <p>
-        The logic above <code>allocUsingTheseRegs</code>, in
-        <code>doGeneralAlloc</code> and <code>runRegAllocate</code>,
-        observe that allocation has failed with some set R of real
-        registers.  So they apply <code>runRegAllocate</code> a second
-        time to the code, but remove (typically) two registers from R
-        before doing so.  This naturally fails too, but returns a
-        partially-allocated sequence.  <code>doGeneralAlloc</code>
-        then inserts spill code into the sequence, and finally re-runs
-        <code>allocUsingTheseRegs</code>, but supplying the original,
-        unadulterated R.  This is guaranteed to succeed since the two
-        registers previously removed from R are sufficient to allocate
-        all the spill/restore instructions added.
-        <p>
-        Because x86 is very short of registers, and in the worst case
-        needs three removed from R, a softly-softly approach is used.
-        <code>doGeneralAlloc</code> first tries with zero regs removed
-        from R, then if that fails one, then two, etc.  This means
-        <code>allocUsingTheseRegs</code> may get run several times
-        before a successful arrangement is arrived at.
-        <code>findReservedRegs</code> cooks up the sets of spill
-        registers to try with.
-        <p>
-        The resulting machinery is complicated and the generated spill
-        code is appalling.  The saving grace is that spills are very
-        rare so it doesn't matter much.  I did not invent this -- I inherited it.
-        <p>
-        <b>Dealing with common cases fast</b>
-        <p>
-        The entire reg-alloc mechanism described so far is general and
-        correct, but expensive overkill for many simple code blocks.
-        So to begin with we use
-        <code>doSimpleAlloc</code>, which attempts to do something
-        simple.  It exploits the observation that if the total number
-        of virtual registers does not exceed the number of real ones
-        available, we can simply dole out a new realreg each time we
-        see mention of a new vreg, with no regard for control flow.
-        <code>doSimpleAlloc</code> therefore attempts this in a
-        single pass over the code.  It gives up if it runs out of real
-        regs or sees any condition which renders the above observation
-        invalid (fixed reg uses, for example).  
-        <p>
-        This clever hack handles the majority of code blocks quickly.
-        It was copied from the previous reg-allocator (the
-        Mattson/Partain/Marlow/Gill one).
-    </ul>
-
-<p>
-<h2>Complications, observations, and possible improvements</h2>
-
-<h3>Real vs virtual registers in the instruction selectors</h3>
-
-The instruction selectors for expression trees, namely
-<code>getRegister</code>, are complicated by the fact that some 
-expressions can only be computed into a specific register, whereas
-the majority can be computed into any register.  We take x86 as an
-example, but the problem applies to all archs.
-<p>
-Terminology: <em>rreg</em> means real register, a real machine
-register.  <em>vreg</em> means one of an infinite set of virtual
-registers.  The type <code>Reg</code> is the sum of <em>rreg</em> and
-<em>vreg</em>.  The instruction selector generates sequences with
-unconstrained use of vregs, leaving the register allocator to map them
-all into rregs.
-<p>
-Now, where was I ?  Oh yes.  We return to the type of
-<code>getRegister</code>, which despite its name, selects instructions
-to compute the value of an expression tree.  
-<pre>
-   getRegister :: StixExpr -> NatM Register
-
-   data Register
-     = Fixed   PrimRep Reg InstrBlock
-     | Any     PrimRep (Reg -> InstrBlock)
-
-   type InstrBlock -- sequence of instructions
-</pre>
-At first this looks eminently reasonable (apart from the stupid
-name).  <code>getRegister</code>, and nobody else, knows whether or
-not a given expression has to be computed into a fixed rreg or can be
-computed into any rreg or vreg.  In the first case, it returns
-<code>Fixed</code> and indicates which rreg the result is in.  In the
-second case it defers committing to any specific target register by
-returning a function from <code>Reg</code> to <code>InstrBlock</code>,
-and the caller can specify the target reg as it sees fit.
-<p>
-Unfortunately, that forces <code>getRegister</code>'s callers (usually
-itself) to use a clumsy and confusing idiom in the common case where
-they do not care what register the result winds up in.  The reason is
-that although a value might be computed into a fixed rreg, we are
-forbidden (on pain of segmentation fault :) from subsequently
-modifying the fixed reg.  This and other rules are record in "Rules of
-the game" inside <code>MachCode.lhs</code>.
-<p>
-Why can't fixed registers be modified post-hoc?  Consider a simple
-expression like <code>Hp+1</code>.  Since the heap pointer
-<code>Hp</code> is definitely in a fixed register, call it R,
-<code>getRegister</code> on subterm <code>Hp</code> will simply return
-<code>Fixed</code> with an empty sequence and R.  But we can't just
-emit an increment instruction for R, because that trashes
-<code>Hp</code>; instead we first have to copy it into a fresh vreg
-and increment that.
-<p>
-With all that in mind, consider now writing a <code>getRegister</code>
-clause for terms of the form <code>(1 + E)</code>.  Contrived, yes,
-but illustrates the matter.  First we do
-<code>getRegister</code> on E.  Now we are forced to examine what 
-comes back.
-<pre>
-   getRegister (OnePlus e)
-      = getRegister e           `thenNat`   \ e_result ->
-        case e_result of
-           Fixed e_code e_fixed 
-              -> returnNat (Any IntRep (\dst -> e_code ++ [MOV e_fixed dst, INC dst]))
-           Any e_any 
-              -> Any (\dst -> e_any dst ++ [INC dst])
-</pre>
-This seems unreasonably cumbersome, yet the instruction selector is
-full of such idioms.  A good example of the complexities induced by
-this scheme is shown by <code>trivialCode</code> for x86 in
-<code>MachCode.lhs</code>.  This deals with general integer dyadic
-operations on x86 and has numerous cases.  It was difficult to get
-right.
-<p>
-An alternative suggestion is to simplify the type of
-<code>getRegister</code> to this:
-<pre>
-   getRegister :: StixExpr -> NatM (InstrBloc, VReg)
-   type VReg = .... a vreg ...
-</pre>
-and then we could safely write
-<pre>
-   getRegister (OnePlus e)
-      = getRegister e        `thenNat`  \ (e_code, e_vreg) ->
-        returnNat (e_code ++ [INC e_vreg], e_vreg)
-</pre>
-which is about as straightforward as you could hope for.
-Unfortunately, it requires <code>getRegister</code> to insert moves of
-values which naturally compute into an rreg, into a vreg.  Consider:
-<pre>
-   1 + ccall some-C-fn
-</pre>
-On x86 the ccall result is returned in rreg <code>%eax</code>.  The
-resulting sequence, prior to register allocation, would be:
-<pre>
-   # push args
-   call some-C-fn
-   # move %esp to nuke args
-   movl   %eax, %vreg
-   incl   %vreg
-</pre>
-If, as is likely, <code>%eax</code> is not held live beyond this point
-for any other purpose, the move into a fresh register is pointless;
-we'd have been better off leaving the value in <code>%eax</code> as
-long as possible.
-<p>
-The simplified <code>getRegister</code> story is attractive.  It would
-clean up the instruction selectors significantly and make it simpler
-to write new ones.  The only drawback is that it generates redundant
-register moves.  I suggest that eliminating these should be the job
-of the register allocator.  Indeed:
-<ul>
-<li>There has been some work on this already ("Iterated register
-    coalescing" ?), so this isn't a new idea.
-<p>
-<li>You could argue that the existing scheme inappropriately blurs the
-    boundary between the instruction selector and the register
-    allocator.  The instruction selector should .. well .. just
-    select instructions, without having to futz around worrying about
-    what kind of registers subtrees get generated into.  Register
-    allocation should be <em>entirely</em> the domain of the register
-    allocator, with the proviso that it should endeavour to allocate
-    registers so as to minimise the number of non-redundant reg-reg
-    moves in the final output.
-</ul>
-
-
-<h3>Selecting insns for 64-bit values/loads/stores on 32-bit platforms</h3>
-
-Note that this stuff doesn't apply on 64-bit archs, since the
-<code>getRegister</code> mechanism applies there.
-
-The relevant functions are:
-<pre>
-   assignMem_I64Code :: StixExpr -> StixExpr -> NatM InstrBlock
-   assignReg_I64Code :: StixReg  -> StixExpr -> NatM InstrBlock
-   iselExpr64        :: StixExpr -> NatM ChildCode64
-
-   data ChildCode64     -- a.k.a "Register64"
-      = ChildCode64 
-           InstrBlock   -- code
-           VRegUnique   -- unique for the lower 32-bit temporary
-</pre>
-<code>iselExpr64</code> is the 64-bit, plausibly-named analogue of
-<code>getRegister</code>, and <code>ChildCode64</code> is the analogue
-of <code>Register</code>.  The aim here was to generate working 64
-bit code as simply as possible.  To this end, I used the 
-simplified <code>getRegister</code> scheme described above, in which
-<code>iselExpr64</code>generates its results into two vregs which
-can always safely be modified afterwards.
-<p>
-Virtual registers are, unsurprisingly, distinguished by their
-<code>Unique</code>s.  There is a small difficulty in how to
-know what the vreg for the upper 32 bits of a value is, given the vreg
-for the lower 32 bits.  The simple solution adopted is to say that
-any low-32 vreg may also have a hi-32 counterpart which shares the
-same unique, but is otherwise regarded as a separate entity.
-<code>getHiVRegFromLo</code> gets one from the other.
-<pre>
-   data VRegUnique
-      = VRegUniqueLo Unique          -- lower part of a split quantity
-      | VRegUniqueHi Unique          -- upper part thereof
-</pre>
-Apart from that, 64-bit code generation is really simple.  The sparc
-and x86 versions are almost copy-n-pastes of each other, with minor
-adjustments for endianness.  The generated code isn't wonderful but
-is certainly acceptable, and it works.
-
-
-
-<h3>Shortcomings and inefficiencies in the register allocator</h3>
-
-<h4>Redundant reconstruction of the control flow graph</h4>
-
-The allocator goes to considerable computational expense to construct
-all the flow edges in the group of instructions it's allocating for,
-by using the <code>insnFuture</code> function in the
-<code>Instr</code> pseudo-abstract type.
-<p>
-This is really silly, because all that information is present at the
-abstract C stage, but is thrown away in the translation to Stix.
-So a good thing to do is to modify that translation to
-produce a directed graph of Stix straight-line code blocks,
-and to preserve that structure through the insn selector, so the
-allocator can see it.  
-<p>
-This would eliminate the fragile, hacky, arch-specific
-<code>insnFuture</code> mechanism, and probably make the whole
-compiler run measurably faster.  Register allocation is a fair chunk
-of the time of non-optimising compilation (10% or more), and
-reconstructing the flow graph is an expensive part of reg-alloc.
-It would probably accelerate the vreg liveness computation too.
-
-<h4>Really ridiculous method for doing spilling</h4>
-
-This is a more ambitious suggestion, but ... reg-alloc should be
-reimplemented, using the scheme described in "Quality and speed in
-linear-scan register allocation."  (Traub?)  For straight-line code
-blocks, this gives an elegant one-pass algorithm for assigning
-registers and creating the minimal necessary spill code, without the
-need for reserving spill registers ahead of time.
-<p>
-I tried it in Rigr, replacing the previous spiller which used the
-current GHC scheme described above, and it cut the number of spill
-loads and stores by a factor of eight.  Not to mention being simpler,
-easier to understand and very fast.
-<p>
-The Traub paper also describes how to extend their method to multiple
-basic blocks, which will be needed for GHC.  It comes down to
-reconciling multiple vreg-to-rreg mappings at points where control
-flow merges.
-
-<h4>Redundant-move support for revised instruction selector suggestion</h4>
-
-As mentioned above, simplifying the instruction selector will require
-the register allocator to try and allocate source and destination
-vregs to the same rreg in reg-reg moves, so as to make as many as
-possible go away.  Without that, the revised insn selector would
-generate worse code than at present.  I know this stuff has been done
-but know nothing about it.  The Linear-scan reg-alloc paper mentioned
-above does indeed mention a bit about it in the context of single
-basic blocks, but I don't know if that's sufficient.
-
-
-   
-<h3>x86 arcana that you should know about</h3>
-
-The main difficulty with x86 is that many instructions have fixed
-register constraints, which can occasionally make reg-alloc fail
-completely.  And the FPU doesn't have the flat register model which
-the reg-alloc abstraction (implicitly) assumes.
-<p>
-Our strategy is: do a good job for the common small subset, that is
-integer loads, stores, address calculations, basic ALU ops (+, -,
-and, or, xor), and jumps.  That covers the vast majority of 
-executed insns.  And indeed we do a good job, with a loss of
-less than 2% compared with gcc.
-<p>
-Initially we tried to handle integer instructions with awkward
-register constraints (mul, div, shifts by non-constant amounts) via
-various jigglings of the spiller et al.  This never worked robustly,
-and putting platform-specific tweaks in the generic infrastructure is
-a big No-No.  (Not quite true; shifts by a non-constant amount are
-still done by a giant kludge, and should be moved into this new
-framework.)
-<p>
-Fortunately, all such insns are rare.  So the current scheme is to 
-pretend that they don't have any such constraints.  This fiction is
-carried all the way through the register allocator.  When the insn
-finally comes to be printed, we emit a sequence which copies the
-operands through memory (<code>%esp</code>-relative), satisfying the
-constraints of the real instruction.  This localises the gruesomeness
-to just one place.  Here, for example, is the code generated for
-integer divison of <code>%esi</code> by <code>%ecx</code>:
-<pre>
-   # BEGIN IQUOT %ecx, %esi
-   pushl $0
-   pushl %eax  
-   pushl %edx
-   pushl %ecx
-   movl  %esi,% eax
-   cltd
-   idivl 0(%esp)
-   movl %eax, 12(%esp)
-   popl %edx  
-   popl %edx
-   popl %eax
-   popl %esi
-   # END   IQUOT %ecx, %esi
-</pre>
-This is not quite as appalling as it seems, if you consider that the
-division itself typically takes 16+ cycles, whereas the rest of the
-insns probably go through in about 1 cycle each.
-<p>
-This trick is taken to extremes for FP operations.
-<p>
-All notions of the x86 FP stack and its insns have been removed.
-Instead, we pretend, to the instruction selector and register
-allocator, that x86 has six floating point registers,
-<code>%fake0</code> .. <code>%fake5</code>, which can be used in the
-usual flat manner.  We further claim that x86 has floating point
-instructions very similar to SPARC and Alpha, that is, a simple
-3-operand register-register arrangement.  Code generation and register
-allocation proceed on this basis.
-<p>
-When we come to print out the final assembly, our convenient fiction
-is converted to dismal reality.  Each fake instruction is
-independently converted to a series of real x86 instructions.
-<code>%fake0</code> .. <code>%fake5</code> are mapped to
-<code>%st(0)</code> .. <code>%st(5)</code>.  To do reg-reg arithmetic
-operations, the two operands are pushed onto the top of the FP stack,
-the operation done, and the result copied back into the relevant
-register.  When one of the operands is also the destination, we emit a
-slightly less scummy translation.  There are only six
-<code>%fake</code> registers because 2 are needed for the translation,
-and x86 has 8 in total.
-<p>
-The translation is inefficient but is simple and it works.  A cleverer
-translation would handle a sequence of insns, simulating the FP stack
-contents, would not impose a fixed mapping from <code>%fake</code> to
-<code>%st</code> regs, and hopefully could avoid most of the redundant
-reg-reg moves of the current translation.
-<p>
-There are, however, two unforeseen bad side effects:
-<ul>
-<li>This doesn't work properly, because it doesn't observe the normal
-    conventions for x86 FP code generation.  It turns out that each of
-    the 8 elements in the x86 FP register stack has a tag bit which
-    indicates whether or not that register is notionally in use or
-    not.  If you do a FPU operation which happens to read a
-    tagged-as-empty register, you get an x87 FPU (stack invalid)
-    exception, which is normally handled by the FPU without passing it
-    to the OS: the program keeps going, but the resulting FP values
-    are garbage.  The OS can ask for the FPU to pass it FP
-    stack-invalid exceptions, but it usually doesn't.
-    <p>
-    Anyways: inside NCG created x86 FP code this all works fine.
-    However, the NCG's fiction of a flat register set does not operate
-    the x87 register stack in the required stack-like way.  When
-    control returns to a gcc-generated world, the stack tag bits soon
-    cause stack exceptions, and thus garbage results.
-    <p>
-    The only fix I could think of -- and it is horrible -- is to clear
-    all the tag bits just before the next STG-level entry, in chunks
-    of code which use FP insns.  <code>i386_insert_ffrees</code>
-    inserts the relevant <code>ffree</code> insns into such code
-    blocks.  It depends critically on <code>is_G_instr</code> to
-    detect such blocks.
-<p>
-<li>It's very difficult to read the generated assembly and
-    reason about it when debugging, because there's so much clutter.
-    We print the fake insns as comments in the output, and that helps
-    a bit. 
-</ul>
-
-
-
-<h3>Generating code for ccalls</h3>
-
-For reasons I don't really understand, the instruction selectors for
-generating calls to C (<code>genCCall</code>) have proven surprisingly
-difficult to get right, and soaked up a lot of debugging time.  As a
-result, I have once again opted for schemes which are simple and not
-too difficult to argue as correct, even if they don't generate
-excellent code.
-<p>
-The sparc ccall generator in particular forces all arguments into
-temporary virtual registers before moving them to the final
-out-registers (<code>%o0</code> .. <code>%o5</code>).  This creates
-some unnecessary reg-reg moves.  The reason is explained in a
-comment in the code.
-
-
-<h3>Duplicate implementation for many STG macros</h3>
-
-This has been discussed at length already.  It has caused a couple of
-nasty bugs due to subtle untracked divergence in the macro
-translations.  The macro-expander really should be pushed up into the
-Abstract C phase, so the problem can't happen.
-<p>
-Doing so would have the added benefit that the NCG could be used to
-compile more "ways" -- well, at least the 'p' profiling way.
-
-
-<h3>How to debug the NCG without losing your sanity/hair/cool</h3>
-
-Last, but definitely not least ...
-<p>
-The usual syndrome is that some program, when compiled via C, works,
-but not when compiled via the NCG.  Usually the problem is fairly 
-simple to fix, once you find the specific code block which has been
-mistranslated.  But the latter can be nearly impossible, since most
-modules generate at least hundreds and often thousands of them.
-<p>
-My solution: cheat.
-<p>
-Because the via-C and native routes diverge only late in the day,
-it is not difficult to construct a 1-1 correspondence between basic
-blocks on the two routes.  So, if the program works via C but not on
-the NCG, do the following:
-<ul>
-<li>Recompile <code>AsmCodeGen.lhs</code> in the afflicted compiler
-    with <code>-DDEBUG_NCG</code>, so that it inserts
-    <code>___ncg_debug_marker</code>s
-    into the assembly it emits.
-<p>
-<li>Using a binary search on modules, find the module which is causing
-    the problem.
-<p>
-<li>Compile that module to assembly code, with identical flags, twice,
-    once via C and once via NCG.
-    Call the outputs <code>ModuleName.s-gcc</code> and
-    <code>ModuleName.s-nat</code>.  Check that the latter does indeed have 
-    <code>___ncg_debug_marker</code>s in it; otherwise the next steps fail.
-<p>
-<li>Build (with a working compiler) the program
-    <code>fptools/ghc/utils/debugNCG/diff_gcc_nat</code>.
-<p>
-<li>Run: <code>diff_gcc_nat ModuleName.s</code>.  This will
-    construct the 1-1 correspondence, and emits on stdout 
-    a cppable assembly output.  Place this in a file -- I always
-    call it <code>synth.S</code>.  Note, the capital S is important;
-    otherwise it won't get cpp'd.  You can feed this file directly to
-    ghc and it will automatically get cpp'd; you don't have to do so
-    yourself.
-<p>
-<li>By messing with the <code>#define</code>s at the top of
-    <code>synth.S</code>, do a binary search to find the incorrect
-    block.  Keep a careful record of where you are in the search; it
-    is easy to get confused.  Remember also that multiple blocks may
-    be wrong, which also confuses matters.  Finally, I usually start
-    off by re-checking that I can build the executable with all the
-    <code>#define</code>s set to 0 and then all to 1.  This ensures
-    you won't get halfway through the search and then get stuck due to
-    some snafu with gcc-specific literals.  Usually I set
-    <code>UNMATCHED_GCC</code> to 1 all the time, and this bit should
-    contain only literal data.
-    <code>UNMATCHED_NAT</code> should be empty.
-</ul>
-<p>
-<code>diff_gcc_nat</code> was known to work correctly last time I used
-it, in December 01, for both x86 and sparc.  If it doesn't work, due
-to changes in assembly syntax, or whatever, make it work.  The
-investment is well worth it.  Searching for the incorrect block(s) any
-other way is a total time waster.
-
-
-
-</ul>
-
-
-
-
-    <p><small>
-<!-- hhmts start -->
-Last modified: Mon Aug 19 11:41:43 CEST 2013
-<!-- hhmts end -->
-    </small>
-  </body>
-</html>
diff --git a/docs/comm/the-beast/optimistic.html b/docs/comm/the-beast/optimistic.html
deleted file mode 100644
index 4d158022e82f..000000000000
--- a/docs/comm/the-beast/optimistic.html
+++ /dev/null
@@ -1,65 +0,0 @@
-<h2> Architectural stuff </h2>
-
-New fields in the TSO:
-<ul>
-<li> New global speculation-depth register; always counts the number of specuation frames
-on the stack; incremented when 
-starting speculation, decremented when finishing.
-<li> Profiling stuff
-</ul>
-
-
-<h2> Speculation frames </h2>
-
-The info table for a speculation frame points to the static spec-depth configuration
-for that speculation point. (Points to, because the config is mutable, and the info
-table has to be adjacent to the (immutable) code.)
-
- 
-
-<h2> Abortion</h2>
-
-Abortion is modelled by a special asynchronous exception ThreadAbort.
-
-<ul>
-<li> In the scheduler, if a thread returns with ThreadBlocked, and non-zero SpecDepth, send it
-an asynchronous exception.
-
-<li> In the implementation of the <tt>catch#</tt> primop, raise an asynchonous exception if 
-SpecDepth is nonzero.
-
-<li> Timeout, administered by scheduler.  Current story: abort if a speculation frame lasts from
-one minor GC to the next.  We detect this by seeing if there's a profiling frame on the stack --- a 
-profiling frame is added at a minor GC in place of a speculation frame (see Online Profiling).
-</ul>
-
-
-When tearing frames off the stack, we start a new chunk at every speculation frame, as well as every
-update frame.  We proceed down to the deepest speculation frame.  
-<p>
-The <tt>AP_STACK</tt> closure built for a speculation frame must be careful <em>not</em> to enter the 
-next <tt>AP_STACK</tt> closure up, because that would re-enter a possible loop.
-<p>
-Delivering an asynch exception to a thread that is speculating.  Invariant: there can be no catch frames
-inside speculation (we abort in <tt>catch#</tt> when speculating.  So the asynch exception just 
-tears off frames in the standard way until it gets to a catch frame, just as it would usually do.
-<p>
-Abortion can punish one or more of the speculation frames by decrementing their static config variables.
-
-<h3>Synchronous exceptions</h3>
- 
-Synchronous exceptions are treated similarly as before.  The stack is discarded up to an update frame; the
-thunk to be updated is overwritten with "raise x", and the process continues.  Until a catch frame.
-<p>
-When we find a spec frame, we allocate a "raise x" object, and resume execution with the return address
-in the spec frame.  In that way the spec frame is like a catch frame; it stops the unwinding process.
-<p>
-It's essential that every hard failure is caught, else speculation is unsafe.  In particular, divide by zero
-is hard to catch using OS support, so we test explicitly in library code.  You can shoot yourself in the foot 
-by writing <tt>x `div#` 0</tt>, side-stepping the test.
-
-
-<h3> Online profiling </h3>
-
-Sampling can be more frequent than minor GC (by jiggling the end-of-block code) but cannot
-be less frequent, because GC doesn't expect to see profiling frames.
\ No newline at end of file
diff --git a/docs/comm/the-beast/prelude.html b/docs/comm/the-beast/prelude.html
deleted file mode 100644
index 64b607def502..000000000000
--- a/docs/comm/the-beast/prelude.html
+++ /dev/null
@@ -1,207 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
-<html>
-  <head>
-    <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-8859-1">
-    <title>The GHC Commentary - Primitives and the Prelude</title>
-  </head>
-
-  <body BGCOLOR="FFFFFF">
-    <h1>The GHC Commentary - Primitives and the Prelude</h1>
-    <p>
-      One of the trickiest aspects of GHC is the delicate interplay
-      between what knowledge is baked into the compiler, and what
-      knowledge it gets by reading the interface files of library
-      modules.  In general, the less that is baked in, the better.
-<p>
-      Most of what the compiler has to have wired in about primitives and
-      prelude definitions is in
-      <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/prelude/"><code>fptools/ghc/compiler/prelude/</code></a>.
-    </p>
-
-GHC recognises these main classes of baked-in-ness:
-<dl>
-<dt><strong>Primitive types.</strong>
-<dd>Primitive types cannot be defined in Haskell, and are utterly baked into the compiler.
-They are notionally defined in the fictional module <tt>GHC.Prim</tt>.   The <tt>TyCon</tt>s for these types are all defined
-in module <tt>TysPrim</tt>; for example,
-<pre>
-  intPrimTyCon :: TyCon 
-  intPrimTyCon = ....
-</pre>
-Examples:
-<tt>Int#, Float#, Addr#, State#</tt>.  
-<p>
-<dt><strong>Wired-in types.</strong>
-<dd>Wired-in types can be defined in Haskell, and indeed are (many are defined in </tt>GHC.Base</tt>).
-However, it's very convenient for GHC to be able to use the type constructor for (say) <tt>Int</tt>
-without looking it up in any environment.  So module <tt>TysWiredIn</tt> contains many definitions
-like this one:
-<pre>
-  intTyCon :: TyCon
-  intTyCon = ....
-
-  intDataCon :: DataCon 
-  intDataCon = ....
-</pre>
-However, since a <tt>TyCon</tt> value contains the entire type definition inside it, it follows
-that the complete definition of <tt>Int</tt> is thereby baked into the compiler.  
-<p>
-Nevertheless, the library module <tt>GHC.Base</tt> still contains a definition for <tt>Int</tt> 
-just so that its info table etc get generated somewhere.  Chaos will result if the wired-in definition
-in <tt>TysWiredIn</tt> differs from that in <tt>GHC.Base</tt>.
-<p>
-The rule is that only very simple types should be wired in (for example, <tt>Ratio</tt> is not,
-and <tt>IO</tt> is certainly not).  No class is wired in: classes are just too complicated.
-<p>
-Examples: <tt>Int</tt>, <tt>Float</tt>, <tt>List</tt>, tuples.
-
-<p>
-<dt><strong>Known-key things.</strong>
-<dd>GHC knows of the existence of many, many other types, classes and values.  <em>But all it knows is
-their <tt>Name</tt>.</em>  Remember, a <tt>Name</tt> includes a unique key that identifies the 
-thing, plus its defining module and occurrence name 
-(see <a href="names.html">The truth about Names</a>).  Knowing a <tt>Name</tt>, therefore, GHC can
-run off to the interface file for the module and find out everything else it might need.
-<p>
-Most of these known-key names are defined in module <tt>PrelNames</tt>; a further swathe concerning
-Template Haskell are defined in <tt>DsMeta</tt>.  The allocation of unique keys is done manually;
-chaotic things happen if you make a mistake here, which is why they are all together.
-</dl>
-
-All the <tt>Name</tt>s from all the above categories are used to initialise the global name cache,
-which maps (module,occurrence-name) pairs to the globally-unique <tt>Name</tt> for that
-thing.  (See <tt>HscMain.initOrigNames</tt>.)
-
-<p>
-The next sections elaborate these three classes a bit.
-
-
-    <h2>Primitives (module <tt>TysPrim</tt>)</h2>
-    <p>
-      Some types and functions have to be hardwired into the compiler as they
-      are atomic; all other code is essentially built around this primitive
-      functionality.  This includes basic arithmetic types, such as integers,
-      and their elementary operations as well as pointer types.  Primitive
-      types and functions often receive special treatment in the code
-      generator, which means that these entities have to be explicitly
-      represented in the compiler.  Moreover, many of these types receive some
-      explicit treatment in the runtime system, and so, there is some further
-      information about <a href="../rts-libs/primitives.html">primitives in
-      the RTS section</a> of this document.
-    <p>
-      The module <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/prelude/TysPrim.lhs"><code>TysPrim</code></a>
-      exports a list of all primitive type constructors as <code>primTyCons ::
-      [TyCon]</code>.  All of these type constructors (of type
-      <code>TyCon</code>) are also exported as <code>intPrimTyCon</code>,
-      <code>stablePtrPrimTyCon</code>, and so on.  In addition, for each
-      nullary type constructor the corresponding type (of type
-      <code>Type</code>) is also exported; for example, we have
-      <code>intPrimTy :: Type</code>.  For all other type constructors, a
-      function is exported that constructs the type obtained by applying the
-      type constructors to an argument type (of type <code>Type</code>); for
-      example, we have <code>mkStablePtrPrimTy :: Type -> Type</code>.
-    <p>
-      As it is inconvenient to identify type that receive a special treatment
-      by the code generator by looking at their name, the module <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/prelude/PrimRep.lhs"><code>PrimRep</code></a>
-      exports a data type <code>PrimRep</code>, which lists all
-      machine-manipulable implementation types.  The module also exports a set
-      of query functions on <code>PrimRep</code> that define properties, such
-      as a type's byte size or whether a primitive type is a pointer type.
-      Moreover, the function <code>TysPrim.primRepTyCon :: PrimRep ->
-      TyCon</code> converts <code>PrimRep</code> values into the corresponding
-      type constructor.
-
-    <h2>Wired in types (module <tt>TysWiredIn</tt>)</h2>
-    <p>
-      In addition to entities that are primitive, as the compiler has to treat
-      them specially in the backend, there is a set of types, functions,
-      etc. that the Haskell language definition flags as essential to the
-      language by placing them into the special module <code>Prelude</code>
-      that is implicitly imported into each Haskell module.  For some of these
-      entities it suffices to define them (by standard Haskell definitions) in
-      a <code>Prelude</code> module and ensuring that this module is treated
-      specially by being always imported .
-    <p>
-      However, there is a set of entities (such as, for example, the list type
-      and the corresponding data constructors) that have an inbetween status:
-      They are not truly primitive (lists, for example, can easily be defined
-      by a <code>data</code> declaration), but the compiler has to have extra
-      knowledge about them, as they are associated with some particular
-      features of the language (in the case of lists, there is special syntax,
-      such as list comprehensions, associated with the type).  Another
-      example, for a special kind of entity are type classes that can be used
-      in a <code>deriving</code> clause.  All types that are not-primitive,
-      but about which the compiler nonetheless has to have some extra
-      knowledge are defined in the module <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/prelude/TysWiredIn.lhs"><code>TysWiredIn</code></a>.
-    <p>
-      All wired in type constructors are contained in <code>wiredInTyCons ::
-      [TyCon]</code>.  In addition to that list, <code>TysWiredIn</code>
-      exports variables bound to representations of all listed type
-      constructors and their data constructors.  So, for example, we have
-      <code>listTyCon</code> together with <code>nilDataCon</cons> and
-      </code>consDataCon</code>.  There are also convenience functions, such
-      as <code>mkListTy</code> and <code>mkTupleTy</code>, which construct
-      compound types.
-    <p>
-
-    <h2>Known-key names (module <tt>PrelNames</tt>)</h2>
-
-      All names of types, functions, etc. known to the compiler are defined in
-      <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/prelude/PrelNames.lhs"><code>PrelNames</code></a>.
-      This includes the names of types and functions exported from
-      <code>TysWiredIn</code>, but also others.  In particular, this module
-      also fixes the names of all prelude modules; i.e., of the modules whose
-      name starts with <code>Prel</code>, which GHC's library uses to bring
-      some structure into the quite large number of <code>Prelude</code>
-      definitions.
-    <p>
-      <code>PrelNames.knownKeyNames :: [Name]</code> contains all names known
-      to the compiler, but the elements of the list are also exported
-      individually as variables, such as <code>floatTyConName</code> (having
-      the lexeme <code>Float</code>) and <code>floatDataConName</code> (having
-      the lexeme <code>F#</code>).  For each of these names,
-      <code>PrelNames</code> derfines a unique key with a definition, such as
-    <p>
-<blockquote><pre>
-floatPrimTyConKey = mkPreludeTyConUnique 11</pre>
-</blockquote>
-    <p>
-      that is, all unique keys for known prelude names are hardcoded into
-      <code>PrelNames</code> (and uniqueness has to be manually ensured in
-      that module).  To simplify matching the types of important groups of
-      type constructors, <code>PrelNames</code> also exports lists, such as
-      <code>numericTyKeys</code> (keys of all numeric types), that contain the
-      unique keys of all names in that group.  In addition, derivable type
-      classes and their structure is defined by
-      <code>derivableClassKeys</code> and related definitions.
-    <p>
-      In addition to names that have unique keys, <code>PrelNames</code> also
-      defines a set of names without uniqueness information.  These names end
-      on the suffix <code>_RDR</code> and are of type <code>RdrName</code> (an
-      example, is <code>times_RDR</code>, which represents the lexeme
-      <code>*</code>).  The names are used in locations where they pass
-      through the renamer anyway (e.g., special constructors encountered by
-      the parser, such as [], and code generated from deriving clauses), which
-      will take care of adding uniqueness information.
-    <p>
-
-<h2>Gathering it all together (module <tt>PrelInfo</tt>)</h2>
-      The module
-      <a href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/prelude/PrelInfo.lhs"><code>PrelInfo</code></a>
-      in some sense ties all the above together and provides a reasonably
-      restricted interface to these definition to the rest of the compiler.
-      However, from what I have seen, this doesn't quite work out and the
-      earlier mentioned modules are directly imported in many places.
-
-    <p><small>
-<!-- hhmts start -->
-Last modified: Tue Dec 11 17:54:07 EST 2001
-<!-- hhmts end -->
-    </small>
-  </body>
-</html>
diff --git a/docs/comm/the-beast/renamer.html b/docs/comm/the-beast/renamer.html
deleted file mode 100644
index 878e82b370cd..000000000000
--- a/docs/comm/the-beast/renamer.html
+++ /dev/null
@@ -1,249 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
-<html>
-  <head>
-    <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-8859-1">
-    <title>The GHC Commentary - The Glorious Renamer</title>
-  </head>
-
-  <body BGCOLOR="FFFFFF">
-    <h1>The GHC Commentary - The Glorious Renamer</h1>
-    <p>
-      The <em>renamer</em> sits between the parser and the typechecker.
-      However, its operation is quite tightly interwoven with the
-      typechecker.  This is partially due to support for Template Haskell,
-      where spliced code has to be renamed and type checked.  In particular,
-      top-level splices lead to multiple rounds of renaming and type
-      checking.
-    </p>
-    <p>
-      The main externally used functions of the renamer are provided by the
-      module <code>rename/RnSource.lhs</code>.  In particular, we have
-    </p>
-    <blockquote>
-      <pre>
-rnSrcDecls  :: HsGroup RdrName -> RnM (TcGblEnv, HsGroup Name)
-rnTyClDecls :: [LTyClDecl RdrName] -> RnM [LTyClDecl Name]
-rnSplice    :: HsSplice RdrName -> RnM (HsSplice Name, FreeVars)</pre>
-    </blockquote>
-    <p>
-      All of which execute in the renamer monad <code>RnM</code>.  The first
-      function, <code>rnSrcDecls</code> renames a binding group; the second,
-      <code>rnTyClDecls</code> renames a list of (toplevel) type and class
-      declarations; and the third, <code>rnSplice</code> renames a Template
-      Haskell splice.  As the types indicate, the main task of the renamer is
-      to convert converts all the <tt>RdrNames</tt> to <a
-      href="names.html"><tt>Names</tt></a>, which includes a number of
-      well-formedness checks (no duplicate declarations, all names are in
-      scope, and so on).  In addition, the renamer performs other, not
-      strictly name-related, well-formedness checks, which includes checking
-      that the appropriate flags have been supplied whenever language
-      extensions are used in the source.
-    </p>
-
-    <h2>RdrNames</h2>
-    <p>
-      A <tt>RdrName.RdrName</tt> is pretty much just a string (for an
-      unqualified name like "<tt>f</tt>") or a pair of strings (for a
-      qualified name like "<tt>M.f</tt>"):
-    </p>
-    <blockquote>
-      <pre>
-data RdrName 
-  = Unqual OccName
-	-- Used for ordinary, unqualified occurrences 
-
-  | Qual Module OccName
-	-- A qualified name written by the user in 
-	--  *source* code.  The module isn't necessarily 
-	-- the module where the thing is defined; 
-	-- just the one from which it is imported
-
-  | Orig Module OccName
-	-- An original name; the module is the *defining* module.
-	-- This is used when GHC generates code that will be fed
-	-- into the renamer (e.g. from deriving clauses), but where
-	-- we want to say "Use Prelude.map dammit".  
- 
-  | Exact Name
-	-- We know exactly the Name. This is used 
-	--  (a) when the parser parses built-in syntax like "[]" 
-	--	and "(,)", but wants a RdrName from it
-	--  (b) when converting names to the RdrNames in IfaceTypes
-	--	Here an Exact RdrName always contains an External Name
-	--	(Internal Names are converted to simple Unquals)
-	--  (c) by Template Haskell, when TH has generated a unique name</pre>
-    </blockquote>
-    <p> 
-      The OccName type is described in <a href="names.html#occname">The
-	truth about names</a>.
-    </p>
-
-    <h2>The Renamer Monad</h2>
-    <p>
-      Due to the tight integration of the renamer with the typechecker, both
-      use the same monad in recent versions of GHC.  So, we have
-    </p>
-    <blockquote>
-      <pre>
-type RnM  a = TcRn a		-- Historical
-type TcM  a = TcRn a		-- Historical</pre>
-    </blockquote>
-    <p>
-      with the combined monad defined as
-    </p>
-    <blockquote>
-      <pre>
-type TcRn a       = TcRnIf TcGblEnv TcLclEnv a
-type TcRnIf a b c = IOEnv (Env a b) c
-
-data Env gbl lcl	-- Changes as we move into an expression
-  = Env {
-	env_top	 :: HscEnv,	-- Top-level stuff that never changes
-				-- Includes all info about imported things
-
-	env_us   :: TcRef UniqSupply,	-- Unique supply for local varibles
-
-	env_gbl  :: gbl,	-- Info about things defined at the top level
-				-- of the module being compiled
-
-	env_lcl  :: lcl		-- Nested stuff; changes as we go into 
-				-- an expression
-    }</pre>
-    </blockquote>
-    <p>
-      the details of the global environment type <code>TcGblEnv</code> and
-      local environment type <code>TcLclEnv</code> are also defined in the
-      module <code>typecheck/TcRnTypes.lhs</code>.   The monad
-      <code>IOEnv</code> is defined in <code>utils/IOEnv.hs</code> and extends
-      the vanilla <code>IO</code> monad with an additional state parameter
-      <code>env</code> that is treated as in a reader monad.  (Side effecting
-      operations, such as updating the unique supply, are done with
-      <code>TcRef</code>s, which are simply a synonym for <code>IORef</code>s.)
-    </p>
-
-    <h2>Name Space Management</h2>
-    <p>
-      As anticipated by the variants <code>Orig</code> and <code>Exact</code>
-      of <code>RdrName</code> some names should not change during renaming,
-      whereas others need to be turned into unique names.  In this context,
-      the two functions <code>RnEnv.newTopSrcBinder</code> and
-      <code>RnEnv.newLocals</code> are important:
-    </p>
-    <blockquote>
-      <pre>
-newTopSrcBinder :: Module -> Maybe Name -> Located RdrName -> RnM Name
-newLocalsRn     :: [Located RdrName] -> RnM [Name]</pre>
-    </blockquote>
-    <p>
-      The two functions introduces new toplevel and new local names,
-      respectively, where the first two arguments to
-      <code>newTopSrcBinder</code> determine the currently compiled module and
-      the parent construct of the newly defined name.  Both functions create
-      new names only for <code>RdrName</code>s that are neither exact nor
-      original.
-    </p>
-
-    <h3>Introduction of Toplevel Names: Global RdrName Environment</h3>
-    <p>
-      A global <code>RdrName</code> environment
-      <code>RdrName.GlobalRdrEnv</code> is a map from <code>OccName</code>s to
-      lists of qualified names.  More precisely, the latter are
-      <code>Name</code>s with an associated <code>Provenance</code>:
-    </p>
-    <blockquote>
-      <pre>
-data Provenance
-  = LocalDef		-- Defined locally
-	Module
-
-  | Imported 		-- Imported
-	[ImportSpec]	-- INVARIANT: non-empty
-	Bool		-- True iff the thing was named *explicitly* 
-			-- in *any* of the import specs rather than being 
-			-- imported as part of a group; 
-	-- e.g.
-	--	import B
-	--	import C( T(..) )
-	-- Here, everything imported by B, and the constructors of T
-	-- are not named explicitly; only T is named explicitly.
-	-- This info is used when warning of unused names.</pre>
-    </blockquote>
-    <p>
-      The part of the global <code>RdrName</code> environment for a module
-      that contains the local definitions is created by the function
-      <code>RnNames.importsFromLocalDecls</code>, which also computes a data
-      structure recording all imported declarations in the form of a value of
-      type <code>TcRnTypes.ImportAvails</code>.
-    </p>
-    <p>
-      The function <code>importsFromLocalDecls</code>, in turn, makes use of
-      <code>RnNames.getLocalDeclBinders :: Module -> HsGroup RdrName -> RnM
-      [AvailInfo]</code> to extract all declared names from a binding group,
-      where <code>HscTypes.AvailInfo</code> is essentially a collection of
-      <code>Name</code>s; i.e., <code>getLocalDeclBinders</code>, on the fly,
-      generates <code>Name</code>s from the <code>RdrName</code>s of all
-      top-level binders of the module represented by the <code>HsGroup
-      RdrName</code> argument.
-    </p>
-    <p>
-      It is important to note that all this happens before the renamer
-      actually descends into the toplevel bindings of a module.  In other
-      words, before <code>TcRnDriver.rnTopSrcDecls</code> performs the
-      renaming of a module by way of <code>RnSource.rnSrcDecls</code>, it uses
-      <code>importsFromLocalDecls</code> to set up the global
-      <code>RdrName</code> environment, which contains <code>Name</code>s for
-      all imported <em>and</em> all locally defined toplevel binders.  Hence,
-      when the helpers of <code>rnSrcDecls</code> come across the
-      <em>defining</em> occurrences of a toplevel <code>RdrName</code>, they
-      don't rename it by generating a new name, but they simply look up its
-      name in the global <code>RdrName</code> environment.
-    </p>
-
-    <h2>Rebindable syntax</h2>
-    <p>
-      In Haskell when one writes "3" one gets "fromInteger 3", where
-      "fromInteger" comes from the Prelude (regardless of whether the
-      Prelude is in scope).  If you want to completely redefine numbers,
-      that becomes inconvenient.  So GHC lets you say
-      "-fno-implicit-prelude"; in that case, the "fromInteger" comes from
-      whatever is in scope.  (This is documented in the User Guide.)
-    </p>
-    <p>
-      This feature is implemented as follows (I always forget).
-    <ul>
-      <li>Names that are implicitly bound by the Prelude, are marked by the
-	type <code>HsExpr.SyntaxExpr</code>.  Moreover, the association list
-	<code>HsExpr.SyntaxTable</code> is set up by the renamer to map
-	rebindable names to the value they are bound to.
-      </li>
-      <li>Currently, five constructs related to numerals
-	(<code>HsExpr.NegApp</code>, <code>HsPat.NPat</code>,
-	<code>HsPat.NPlusKPat</code>,  	<code>HsLit.HsIntegral</code>, and
-	<code>HsLit.HsFractional</code>)  and 
-	two constructs related to code>do</code> expressions
-	(<code>HsExpr.BindStmt</code> and 
-	<code>HsExpr.ExprStmt</code>) have rebindable syntax.
-      </li> 
-      <li> When the parser builds these constructs, it puts in the
-	built-in Prelude Name (e.g. PrelNum.fromInteger).
-      </li>
-      <li> When the renamer encounters these constructs, it calls
-      <tt>RnEnv.lookupSyntaxName</tt>. 
-	This checks for <tt>-fno-implicit-prelude</tt>; if not, it just
-	returns the same Name; otherwise it takes the occurrence name of the
-	Name, turns it into an unqualified RdrName, and looks it up in the
-	environment.  The returned name is plugged back into the construct.
-      </li>
-      <li> The typechecker uses the Name to generate the appropriate typing
-	constraints. 
-      </li>
-    </ul>
-
-    <p><small>
-<!-- hhmts start -->
-Last modified: Wed May  4 17:16:15 EST 2005
-<!-- hhmts end -->
-    </small>
-  </body>
-</html>
-
diff --git a/docs/comm/the-beast/simplifier.html b/docs/comm/the-beast/simplifier.html
deleted file mode 100644
index 4dbce7765b1e..000000000000
--- a/docs/comm/the-beast/simplifier.html
+++ /dev/null
@@ -1,86 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
-<html>
-  <head>
-    <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-8859-1">
-    <title>The GHC Commentary - The Mighty Simplifier</title>
-  </head>
-
-  <body BGCOLOR="FFFFFF">
-    <h1>The GHC Commentary - The Mighty Simplifier</h1>
-    <p>
-      Most of the optimising program transformations applied by GHC are
-      performed on an intermediate language called <em>Core,</em> which
-      essentially is a compiler-friendly formulation of rank-2 polymorphic
-      lambda terms defined in the module <a
-	href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/coreSyn/CoreSyn.lhs/"><code>CoreSyn.lhs</code>.</a>
-      The transformation engine optimising Core programs is called the
-      <em>Simplifier</em> and composed from a couple of modules located in the
-      directory <a
-	href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/simplCore/"><code>fptools/ghc/compiler/simplCore/</code>.</a>
-      The main engine of the simplifier is contained in <a
-	href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/simplCore/Simplify.lhs"><code>Simplify.lhs</code>.</a>
-      and its driver is the routine <code>core2core</code> in <a
-	href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/simplCore/SimplCore.lhs"><code>SimplCore.lhs</code>.</a>
-    <p>
-      The program that the simplifier has produced after applying its various
-      optimisations can be obtained by passing the option
-      <code>-ddump-simpl</code> to GHC.  Moreover, the various intermediate
-      stages of the optimisation process is printed when passing
-      <code>-dverbose-core2core</code>.
-
-    <h4><a name="loopBreaker">Recursive Definitions</a></h4>
-    <p>
-      The simplification process has to take special care when handling
-      recursive binding groups; otherwise, the compiler might loop.
-      Therefore, the routine <code>reOrderRec</code> in <a
-	href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/simplCore/OccurAnal.lhs"><code>OccurAnal.lhs</code></a>
-      computes a set of <em>loop breakers</em> - a set of definitions that
-      together cut any possible loop in the binding group.  It marks the
-      identifiers bound by these definitions as loop breakers by enriching
-      their <a href="basicTypes.html#occInfo">occurrence information.</a>  Loop
-      breakers will <em>never</em> be inlined by the simplifier; thus,
-      guaranteeing termination of the simplification procedure.  (This is not
-      entirely accurate -- see <a href="#rules">rewrite rules</a> below.)
-
-      The processes finding loop breakers works as follows: First, the
-      strongly connected components (SCC) of the graph representing all
-      function dependencies is computed.  Then, each SCC is inspected in turn.
-      If it contains only a single binding (self-recursive function), this is
-      the loop breaker.  In case of multiple recursive bindings, the function
-      attempts to select bindings where the decision not to inline them does
-      cause the least harm - in the sense of inhibiting optimisations in the
-      code.  This is achieved by considering each binding in turn and awarding
-      a <em>score</em> between 0 and 4, where a lower score means that the
-      function is less useful for inlining - and thus, a better loop breaker.
-      The evaluation of bingings is performed by the function
-      <code>score</code> locally defined in <code>OccurAnal</code>.
-      
-      Note that, because core programs represent function definitions as
-      <em>one</em> binding choosing between the possibly many equations in the
-      source program with a <code>case</code> construct, a loop breaker cannot
-      inline any of its possibly many alternatives (not even the non-recursive
-      alternatives).
-
-    <h4><a name="rules">Rewrite Rules</a></h4>
-    <p>
-      The application of rewrite rules is controlled in the module <a
-	href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/simplCore/Simplify.lhs"><code>Simplify.lhs</code></a>
-      by the function <code>completeCall</code>.  This function first checks
-      whether it should inline the function applied at the currently inspected
-      call site, then simplifies the arguments, and finally, checks whether
-      any rewrite rule can be applied (and also whether there is a matching
-      specialised version of the applied function).  The actual check for rule
-      application is performed by the function <code><a
-	href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/specialise/Rules.lhs">Rules</a>.lookupRule</code>.
-    <p>
-      It should be note that the application of rewrite rules is not subject
-      to the loop breaker check - i.e., rules of loop breakers will be applied
-      regardless of whether this may cause the simplifier to diverge.
-
-    <p><small>
-<!-- hhmts start -->
-Last modified: Wed Aug  8 19:25:33 EST 2001
-<!-- hhmts end -->
-    </small>
-  </body>
-</html>
diff --git a/docs/comm/the-beast/stg.html b/docs/comm/the-beast/stg.html
deleted file mode 100644
index 6c9851623a2d..000000000000
--- a/docs/comm/the-beast/stg.html
+++ /dev/null
@@ -1,164 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
-<html>
-  <head>
-    <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-8859-1">
-    <title>The GHC Commentary - You Got Control: The STG-language</title>
-  </head>
-
-  <body BGCOLOR="FFFFFF">
-    <h1>The GHC Commentary - You Got Control: The STG-language</h1>
-    <p>
-      GHC contains two completely independent backends: the byte code
-      generator and the machine code generator.  The decision over which of
-      the two is invoked is made in <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/main/HscMain.lhs"><code>HscMain</code></a><code>.hscCodeGen</code>.
-      The machine code generator proceeds itself in a number of phases: First,
-      the <a href="desugar.html">Core</a> intermediate language is translated
-      into <em>STG-language</em>; second, STG-language is transformed into a
-      GHC-internal variant of <a href="http://www.cminusminus.org/">C--</a>;
-      and thirdly, this is either emitted as concrete C--, converted to GNU C,
-      or translated to native code (by the <a href="ncg.html">native code
-      generator</a> which targets IA32, Sparc, and PowerPC [as of March '5]).
-    </p>
-    <p>
-      In the following, we will have a look at the first step of machine code
-      generation, namely the translation steps involving the STG-language.
-      Details about the underlying abstract machine, the <em>Spineless Tagless
-      G-machine</em>, are in <a
-      href="http://research.microsoft.com/copyright/accept.asp?path=/users/simonpj/papers/spineless-tagless-gmachine.ps.gz&pub=34">Implementing
-      lazy functional languages on stock hardware: the Spineless Tagless
-      G-machine</a>, SL Peyton Jones, Journal of Functional Programming 2(2),
-      Apr 1992, pp127-202. (Some details have changed since the publication of
-      this article, but it still gives a good introduction to the main
-      concepts.)
-    </p>
-
-    <h2>The STG Language</h2>
-    <p>
-      The AST of the STG-language and the generation of STG code from Core is
-      both located in the <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/stgSyn/"><code>stgSyn/</code></a>
-      directory; in the modules <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/stgSyn/StgSyn.lhs"><code>StgSyn</code></a>
-      and <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/stgSyn/CoreToStg.lhs"><code>CoreToStg</code></a>,
-      respectively.
-    </p>
-    <p>
-      Conceptually, the STG-language is a lambda calculus (including data
-      constructors and case expressions) whose syntax is restricted to make
-      all control flow explicit.  As such, it can be regarded as a variant of
-      <em>administrative normal form (ANF).</em> (C.f., <a
-      href="http://doi.acm.org/10.1145/173262.155113">The essence of compiling
-      with continuations.</a> Cormac Flanagan, Amr Sabry, Bruce F. Duba, and
-      Matthias Felleisen. <em>ACM SIGPLAN Conference on Programming Language
-	Design and Implementation,</em> ACM Press, 1993.)  Each syntactic from
-      has a precise operational interpretation, in addition to the
-      denotational interpretation inherited from the lambda calculus.  The
-      concrete representation of the STG language inside GHC also includes
-      auxiliary attributes, such as <em>static reference tables (SRTs),</em>
-      which determine the top-level bindings referenced by each let binding
-      and case expression.
-    </p>
-    <p>
-      As usual in ANF, arguments to functions etc. are restricted to atoms
-      (i.e., constants or variables), which implies that all sub-expressions
-      are explicitly named and evaluation order is explicit.  Specific to the
-      STG language is that all let bindings correspond to closure allocation
-      (thunks, function closures, and data constructors) and that case
-      expressions encode both computation and case selection.  There are two
-      flavours of case expressions scrutinising boxed and unboxed values,
-      respectively.  The former perform function calls including demanding the
-      evaluation of thunks, whereas the latter execute primitive operations
-      (such as arithmetic on fixed size integers and floating-point numbers).
-    </p>
-    <p>
-      The representation of STG language defined in <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/stgSyn/StgSyn.lhs"><code>StgSyn</code></a>
-      abstracts over both binders and occurrences of variables.  The type names
-      involved in this generic definition all carry the prefix
-      <code>Gen</code> (such as in <code>GenStgBinding</code>).  Instances of
-      these generic definitions, where both binders and occurrences are of type
-      <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/basicTypes/Id.lhs"><code>Id</code></a><code>.Id</code>
-      are defined as type synonyms and use type names that drop the
-      <code>Gen</code> prefix (i.e., becoming plain <code>StgBinding</code>).
-      Complete programs in STG form are represented by values of type
-      <code>[StgBinding]</code>.
-    </p>
-
-    <h2>From Core to STG</h2>
-    <p>
-      Although, the actual translation from Core AST into STG AST is performed
-      by the function <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/stgSyn/CoreToStg.lhs"><code>CoreToStg</code></a><code>.coreToStg</code>
-      (or <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/stgSyn/CoreToStg.lhs"><code>CoreToStg</code></a><code>.coreExprToStg</code>
-      for individual expressions), the translation crucial depends on <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/coreSyn/CorePrep.lhs"><code>CorePrep</code></a><code>.corePrepPgm</code>
-      (resp. <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/coreSyn/CorePrep.lhs"><code>CorePrep</code></a><code>.corePrepExpr</code>),
-      which prepares Core code for code generation (for both byte code and
-      machine code generation).  <code>CorePrep</code> saturates primitive and
-      constructor applications, turns the code into A-normal form, renames all
-      identifiers into globally unique names, generates bindings for
-      constructor workers, constructor wrappers, and record selectors plus
-      some further cleanup.
-    </p>
-    <p>
-      In other words, after Core code is prepared for code generation it is
-      structurally already in the form required by the STG language.  The main
-      work performed by the actual transformation from Core to STG, as
-      performed by <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/stgSyn/CoreToStg.lhs"><code>CoreToStg</code></a><code>.coreToStg</code>,
-      is to compute the live and free variables as well as live CAFs (constant
-      applicative forms) at each let binding and case alternative.  In
-      subsequent phases, the live CAF information is used to compute SRTs.
-      The live variable information is used to determine which stack slots
-      need to be zapped (to avoid space leaks) and the free variable
-      information is need to construct closures.  Moreover, hints for
-      optimised code generation are computed, such as whether a closure needs
-      to be updated after is has been evaluated.
-    </p>
-
-    <h2>STG Passes</h2>
-    <p>
-      These days little actual work is performed on programs in STG form; in
-      particular, the code is not further optimised.  All serious optimisation
-      (except low-level optimisations which are performed during native code
-      generation) has already been done on Core.  The main task of <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/stgSyn/CoreToStg.lhs"><code>CoreToStg</code></a><code>.stg2stg</code>
-      is to compute SRTs from the live CAF information determined during STG
-      generation.  Other than that, <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/profiling/SCCfinal.lhs"><code>SCCfinal</code></a><code>.stgMassageForProfiling</code>
-      is executed when compiling for profiling and information may be dumped
-      for debugging purposes.
-    </p>
-
-    <h2>Towards C--</h2>
-    <p>
-      GHC's internal form of C-- is defined in the module <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/cmm/Cmm.hs"><code>Cmm</code></a>.
-      The definition is generic in that it abstracts over the type of static
-      data and of the contents of basic blocks (i.e., over the concrete
-      representation of constant data and instructions).  These generic
-      definitions have names carrying the prefix <code>Gen</code> (such as
-      <code>GenCmm</code>).  The same module also instantiates the generic
-      form to a concrete form where data is represented by
-      <code>CmmStatic</code> and instructions are represented by
-      <code>CmmStmt</code> (giving us, e.g., <code>Cmm</code> from
-      <code>GenCmm</code>).  The concrete form more or less follows the
-      external <a href="http://www.cminusminus.org/">C--</a> language.
-    </p>
-    <p>
-      Programs in STG form are translated to <code>Cmm</code> by <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/codeGen/CodeGen.lhs"><code>CodeGen</code></a><code>.codeGen</code>
-    </p>
-
-    <p><hr><small>
-<!-- hhmts start -->
-Last modified: Sat Mar  5 22:55:25 EST 2005
-<!-- hhmts end -->
-    </small>
-  </body>
-</html>
diff --git a/docs/comm/the-beast/syntax.html b/docs/comm/the-beast/syntax.html
deleted file mode 100644
index be5bbefa17a7..000000000000
--- a/docs/comm/the-beast/syntax.html
+++ /dev/null
@@ -1,99 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
-<html>
-  <head>
-    <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-8859-1">
-    <title>The GHC Commentary - Just Syntax</title>
-  </head>
-
-  <body BGCOLOR="FFFFFF">
-    <h1>The GHC Commentary - Just Syntax</h1>
-    <p>
-      The lexical and syntactic analyser for Haskell programs are located in
-      <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/parser/"><code>fptools/ghc/compiler/parser/</code></a>.
-    </p>
-
-    <h2>The Lexer</h2>
-    <p>
-      The lexer is a rather tedious piece of Haskell code contained in the
-      module <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/parser/Lex.lhs"><code>Lex</code></a>.
-      Its complexity partially stems from covering, in addition to Haskell 98, 
-      also the whole range of GHC language extensions plus its ability to
-      analyse interface files in addition to normal Haskell source.  The lexer
-      defines a parser monad <code>P a</code>, where <code>a</code> is the
-      type of the result expected from a successful parse.  More precisely, a
-      result of type
-<blockquote><pre>
-data ParseResult a = POk PState a
-		   | PFailed Message</pre>
-</blockquote>
-    <p>
-      is produced with <code>Message</code> being from <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/main/ErrUtils.lhs"><code>ErrUtils</code></a>
-      (and currently is simply a synonym for <code>SDoc</code>).
-    <p>
-      The record type <code>PState</code> contains information such as the
-      current source location, buffer state, contexts for layout processing,
-      and whether Glasgow extensions are accepted (either due to
-      <code>-fglasgow-exts</code> or due to reading an interface file).  Most
-      of the fields of <code>PState</code> store unboxed values; in fact, even
-      the flag indicating whether Glasgow extensions are enabled is
-      represented by an unboxed integer instead of by a <code>Bool</code>.  My
-      (= chak's) guess is that this is to avoid having to perform a
-      <code>case</code> on a boxed value in the inner loop of the lexer.
-    <p>
-      The same lexer is used by the Haskell source parser, the Haskell
-      interface parser, and the package configuration parser.
-    
-    <h2>The Haskell Source Parser</h2>
-    <p>
-      The parser for Haskell source files is defined in the form of a parser
-      specification for the parser generator <a
-      href="http://haskell.org/happy/">Happy</a> in the file <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/parser/Parser.y"><code>Parser.y</code></a>. 
-      The parser exports three entry points for parsing entire modules
-      (<code>parseModule</code>, individual statements
-      (<code>parseStmt</code>), and individual identifiers
-      (<code>parseIdentifier</code>), respectively.  The last two are needed
-      for GHCi.  All three require a parser state (of type
-      <code>PState</code>) and are invoked from <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/main/HscMain.lhs"><code>HscMain</code></a>.
-    <p>
-      Parsing of Haskell is a rather involved process.  The most challenging
-      features are probably the treatment of layout and expressions that
-      contain infix operators.  The latter may be user-defined and so are not
-      easily captured in a static syntax specification.  Infix operators may
-      also appear in the right hand sides of value definitions, and so, GHC's
-      parser treats those in the same way as expressions.  In other words, as
-      general expressions are a syntactic superset of expressions - ok, they
-      <em>nearly</em> are - the parser simply attempts to parse a general
-      expression in such positions.  Afterwards, the generated parse tree is
-      inspected to ensure that the accepted phrase indeed forms a legal
-      pattern.  This and similar checks are performed by the routines from <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/parser/ParseUtil.lhs"><code>ParseUtil</code></a>. In
-      some cases, these routines do, in addition to checking for
-      wellformedness, also transform the parse tree, such that it fits into
-      the syntactic context in which it has been parsed; in fact, this happens
-      for patterns, which are transformed from a representation of type
-      <code>RdrNameHsExpr</code> into a representation of type
-      <code>RdrNamePat</code>.
-
-    <h2>The Haskell Interface Parser</h2>
-    <p>
-      The parser for interface files is also generated by Happy from <a href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/rename/ParseIface.y"><code>ParseIface.y</code></a>.
-      It's main routine <code>parseIface</code> is invoked from <a href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/rename/RnHiFiles.lhs"><code>RnHiFiles</code></a><code>.readIface</code>.
-
-    <h2>The Package Configuration Parser</h2>
-    <p>
-      The parser for configuration files is by far the smallest of the three
-      and defined in <a href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/main/ParsePkgConf.y"><code>ParsePkgConf.y</code></a>.
-      It exports <code>loadPackageConfig</code>, which is used by <a href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/main/DriverState.hs"><code>DriverState</code></a><code>.readPackageConf</code>.
-    
-    <p><small>
-<!-- hhmts start -->
-Last modified: Wed Jan 16 00:30:14 EST 2002
-<!-- hhmts end -->
-    </small>
-  </body>
-</html>
diff --git a/docs/comm/the-beast/typecheck.html b/docs/comm/the-beast/typecheck.html
deleted file mode 100644
index 482a44762818..000000000000
--- a/docs/comm/the-beast/typecheck.html
+++ /dev/null
@@ -1,316 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
-<html>
-  <head>
-    <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-8859-1">
-    <title>The GHC Commentary - Checking Types</title>
-  </head>
-
-  <body BGCOLOR="FFFFFF">
-    <h1>The GHC Commentary - Checking Types</h1>
-    <p>
-      Probably the most important phase in the frontend is the type checker,
-      which is located at <a
-	href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/typecheck/"><code>fptools/ghc/compiler/typecheck/</code>.</a>
-      GHC type checks programs in their original Haskell form before the
-      desugarer converts them into Core code.  This complicates the type
-      checker as it has to handle the much more verbose Haskell AST, but it
-      improves error messages, as those message are based on the same
-      structure that the user sees.
-    </p>
-    <p>
-      GHC defines the abstract syntax of Haskell programs in <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/hsSyn/HsSyn.lhs"><code>HsSyn</code></a>
-      using a structure that abstracts over the concrete representation of
-      bound occurrences of identifiers and patterns.  The module <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/typecheck/TcHsSyn.lhs"><code>TcHsSyn</code></a>
-      defines a number of helper function required by the type checker.  Note
-      that the type <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/typecheck/TcRnTypes.lhs"><code>TcRnTypes</code></a>.<code>TcId</code>
-      used to represent identifiers in some signatures during type checking
-      is, in fact, nothing but a synonym for a <a href="vars.html">plain
-      <code>Id</code>.</a>  
-    </p>
-    <p>
-      It is also noteworthy, that the representations of types changes during
-      type checking from <code>HsType</code> to <code>TypeRep.Type</code>.
-      The latter is a <a href="types.html">hybrid type representation</a> that
-      is used to type Core, but still contains sufficient information to
-      recover source types.  In particular, the type checker maintains and
-      compares types in their <code>Type</code> form.
-    </p>
-
-    <h2>The Overall Flow of Things</h2>
-
-    <h4>Entry Points Into the Type Checker</h4>
-    <p>
-      The interface of the type checker (and <a
-      href="renamer.html">renamer</a>) to the rest of the compiler is provided
-      by <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/typecheck/TcRnDriver.lhs"><code>TcRnDriver</code></a>.
-      Entire modules are processed by calling <code>tcRnModule</code> and GHCi
-      uses <code>tcRnStmt</code>, <code>tcRnExpr</code>, and
-      <code>tcRnType</code> to typecheck statements and expressions, and to
-      kind check types, respectively.  Moreover, <code>tcRnExtCore</code> is
-      provided to typecheck external Core code.  Moreover,
-      <code>tcTopSrcDecls</code> is used by Template Haskell - more
-      specifically by <code>TcSplice.tc_bracket</code>
-      - to type check the contents of declaration brackets.
-    </p>
-
-    <h4>Renaming and Type Checking a Module</h4>
-    <p>
-      The function <code>tcRnModule</code> controls the complete static
-      analysis of a Haskell module.  It sets up the combined renamer and type
-      checker monad, resolves all import statements, initiates the actual
-      renaming and type checking process, and finally, wraps off by processing
-      the export list.
-    </p>
-    <p>
-      The actual type checking and renaming process is initiated via
-      <code>TcRnDriver.tcRnSrcDecls</code>, which uses a helper called
-      <code>tc_rn_src_decls</code> to implement the iterative renaming and
-      type checking process required by <a href="../exts/th.html">Template
-      Haskell</a>.  However, before it invokes <code>tc_rn_src_decls</code>,
-      it takes care of hi-boot files; afterwards, it simplifies type
-      constraints and zonking (see below regarding the later).
-    </p>
-    <p>
-      The function <code>tc_rn_src_decls</code> partitions static analysis of
-      a whole module into multiple rounds, where the initial round is followed
-      by an additional one for each toplevel splice.  It collects all
-      declarations up to the next splice into an <code>HsDecl.HsGroup</code>
-      to rename and type check that <em>declaration group</em> by calling
-      <code>TcRnDriver.tcRnGroup</code>.  Afterwards, it executes the
-      splice (if there are any left) and proceeds to the next group, which
-      includes the declarations produced by the splice.
-    </p>
-    <p>
-      The function <code>tcRnGroup</code>, finally, gets down to invoke the
-      actual renaming and type checking via
-      <code>TcRnDriver.rnTopSrcDecls</code> and
-      <code>TcRnDriver.tcTopSrcDecls</code>, respectively.  The renamer, apart
-      from renaming, computes the global type checking environment, of type
-      <code>TcRnTypes.TcGblEnv</code>, which is stored in the type checking
-      monad before type checking commences.
-    </p>
-
-    <h2>Type Checking a Declaration Group</h2>
-    <p>
-      The type checking of a declaration group, performed by
-      <code>tcTopSrcDecls</code> starts by processing of the type and class
-      declarations of the current module, using the function
-      <code>TcTyClsDecls.tcTyAndClassDecls</code>.  This is followed by a
-      first round over instance declarations using
-      <code>TcInstDcls.tcInstDecls1</code>, which in particular generates all
-      additional bindings due to the deriving process.  Then come foreign
-      import declarations (<code>TcForeign.tcForeignImports</code>) and
-      default declarations (<code>TcDefaults.tcDefaults</code>).
-    </p>
-    <p>
-      Now, finally, toplevel value declarations (including derived ones) are
-      type checked using <code>TcBinds.tcTopBinds</code>.  Afterwards,
-      <code>TcInstDcls.tcInstDecls2</code> traverses instances for the second
-      time.  Type checking concludes with processing foreign exports
-      (<code>TcForeign.tcForeignExports</code>) and rewrite rules
-      (<code>TcRules.tcRules</code>).  Finally, the global environment is
-      extended with the new bindings.
-    </p>
-
-    <h2>Type checking Type and Class Declarations</h2>
-    <p>
-      Type and class declarations are type checked in a couple of phases that
-      contain recursive dependencies - aka <em>knots.</em> The first knot
-      encompasses almost the whole type checking of these declarations and
-      forms the main piece of <code>TcTyClsDecls.tcTyAndClassDecls</code>.
-    </p>
-    <p>
-      Inside this big knot, the first main operation is kind checking, which
-      again involves a knot.  It is implemented by <code>kcTyClDecls</code>,
-      which performs kind checking of potentially recursively-dependent type
-      and class declarations using kind variables for initially unknown kinds.
-      During processing the individual declarations some of these variables
-      will be instantiated depending on the context; the rest gets by default
-      kind <code>*</code> (during <em>zonking</em> of the kind signatures).
-      Type synonyms are treated specially in this process, because they can
-      have an unboxed type, but they cannot be recursive.  Hence, their kinds
-      are inferred in dependency order.  Moreover, in contrast to class
-      declarations and other type declarations, synonyms are not entered into
-      the global environment as a global <code>TyThing</code>.
-      (<code>TypeRep.TyThing</code> is a sum type that combines the various
-      flavours of typish entities, such that they can be stuck into type
-      environments and similar.)
-    </p>
-
-    <h2>More Details</h2>
-
-    <h4>Types Variables and Zonking</h4>
-    <p>
-      During type checking type variables are represented by mutable variables
-      - cf. the <a href="vars.html#TyVar">variable story.</a>  Consequently,
-      unification can instantiate type variables by updating those mutable
-      variables.  This process of instantiation is (for reasons that elude me)
-      called <a
-      href="http://www.dictionary.com/cgi-bin/dict.pl?term=zonk&db=*">zonking</a>
-      in GHC's sources.  The zonking routines for the various forms of Haskell
-      constructs are responsible for most of the code in the module <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/typecheck/TcHsSyn.lhs"><code>TcHsSyn</code>,</a>
-      whereas the routines that actually operate on mutable types are defined
-      in <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/typecheck/TcMType.lhs"><code>TcMType</code></a>;
-      this includes the zonking of type variables and type terms, routines to
-      create mutable structures and update them as well as routines that check
-      constraints, such as that type variables in function signatures have not
-      been instantiated during type checking.  The actual type unification
-      routine is <code>uTys</code> in the module <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/typecheck/TcUnify.lhs"><code>TcUnify</code></a>.
-    </p>
-    <p>
-      All type variables that may be instantiated (those in signatures
-      may not), but haven't been instantiated during type checking, are zonked
-      to <code>()</code>, so that after type checking all mutable variables
-      have been eliminated.
-    </p>
-
-    <h4>Type Representation</h4>
-    <p>
-      The representation of types is fixed in the module <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/typecheck/TcRep.lhs"><code>TcRep</code></a>
-      and exported as the data type <code>Type</code>.  As explained in <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/typecheck/TcType.lhs"><code>TcType</code></a>,
-      GHC supports rank-N types, but, in the type checker, maintains the
-      restriction that type variables cannot be instantiated to quantified
-      types (i.e., the type system is predicative).  The type checker floats
-      universal quantifiers outside and maintains types in prenex form.
-      (However, quantifiers can, of course, not float out of negative
-      positions.)  Overall, we have
-    </p>
-    <blockquote>
-      <pre>
-sigma -> forall tyvars. phi
-phi   -> theta => rho
-rho   -> sigma -> rho
-       | tau
-tau   -> tyvar
-       | tycon tau_1 .. tau_n
-       | tau_1 tau_2
-       | tau_1 -> tau_2</pre>
-    </blockquote>
-    <p>
-      where <code>sigma</code> is in prenex form; i.e., there is never a
-      forall to the right of an arrow in a <code>phi</code> type.  Moreover, a
-      type of the form <code>tau</code> never contains a quantifier (which
-      includes arguments to type constructors).
-    </p>
-    <p>
-      Of particular interest are the variants <code>SourceTy</code> and
-      <code>NoteTy</code> of <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/typecheck/TypeRep.lhs"><code>TypeRep</code></a>.<code>Type</code>.
-      The constructor <code>SourceTy :: SourceType -> Type</code> represents a
-      type constraint; that is, a predicate over types represented by a
-      dictionary.  The type checker treats a <code>SourceTy</code> as opaque,
-      but during the translation to core it will be expanded into its concrete
-      representation (i.e., a dictionary type) by the function <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/types/Type.lhs"><code>Type</code></a>.<code>sourceTypeRep</code>.  
-      Note that newtypes are not covered by <code>SourceType</code>s anymore,
-      even if some comments in GHC still suggest this.  Instead, all newtype
-      applications are initially represented as a <code>NewTcApp</code>, until
-      they are eliminated by calls to <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/types/Type.lhs"><code>Type</code></a>.<code>newTypeRep</code>.
-    </p>
-    <p>
-      The <code>NoteTy</code> constructor is used to add non-essential
-      information to a type term.  Such information has the type
-      <code>TypeRep.TyNote</code> and is either the set of free type variables
-      of the annotated expression or the unexpanded version of a type synonym.
-      Free variables sets are cached as notes to save the overhead of
-      repeatedly computing the same set for a given term.  Unexpanded type
-      synonyms are useful for generating comprehensible error messages, but
-      have no influence on the process of type checking.
-    </p>
-
-    <h4>Type Checking Environment</h4>
-    <p>
-      During type checking, GHC maintains a <em>type environment</em> whose
-      type definitions are fixed in the module <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/typecheck/TcRnTypes.lhs"><code>TcRnTypes</code></a> with the operations defined in
-<a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/typecheck/TcEnv.lhs"><code>TcEnv</code></a>.
-      Among other things, the environment contains all imported and local
-      instances as well as a list of <em>global</em> entities (imported and
-      local types and classes together with imported identifiers) and
-      <em>local</em> entities (locally defined identifiers).  This environment
-      is threaded through the type checking monad, whose support functions
-      including initialisation can be found in the module <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/typecheck/TcRnMonad.lhs"><code>TcRnMonad</code>.</a>
-
-    <h4>Expressions</h4>
-    <p>
-      Expressions are type checked by <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/typecheck/TcExpr.lhs"><code>TcExpr</code>.</a>  
-    <p>
-      Usage occurrences of identifiers are processed by the function
-      <code>tcId</code> whose main purpose is to <a href="#inst">instantiate
-      overloaded identifiers.</a> It essentially calls
-      <code>TcInst.instOverloadedFun</code> once for each universally
-      quantified set of type constraints.  It should be noted that overloaded
-      identifiers are replaced by new names that are first defined in the LIE
-      (Local Instance Environment?) and later promoted into top-level
-      bindings.
-      
-    <h4><a name="inst">Handling of Dictionaries and Method Instances</a></h4>
-    <p>
-      GHC implements overloading using so-called <em>dictionaries.</em> A
-      dictionary is a tuple of functions -- one function for each method in
-      the class of which the dictionary implements an instance.  During type
-      checking, GHC replaces each type constraint of a function with one
-      additional argument.  At runtime, the extended function gets passed a
-      matching class dictionary by way of these additional arguments.
-      Whenever the function needs to call a method of such a class, it simply
-      extracts it from the dictionary.
-    <p>
-      This sounds simple enough; however, the actual implementation is a bit
-      more tricky as it wants to keep track of all the instances at which
-      overloaded functions are used in a module.  This information is useful
-      to optimise the code.  The implementation is the module <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/typecheck/Inst.lhs"><code>Inst.lhs</code>.</a>
-    <p>
-      The function <code>instOverloadedFun</code> is invoked for each
-      overloaded usage occurrence of an identifier, where overloaded means that
-      the type of the idendifier contains a non-trivial type constraint.  It
-      proceeds in two steps: (1) Allocation of a method instance
-      (<code>newMethodWithGivenTy</code>) and (2) instantiation of functional
-      dependencies.  The former implies allocating a new unique identifier,
-      which replaces the original (overloaded) identifier at the currently
-      type-checked usage occurrence.
-    <p>
-      The new identifier (after being threaded through the LIE) eventually
-      will be bound by a top-level binding whose rhs contains a partial
-      application of the original overloaded identifier.  This papp applies
-      the overloaded function to the dictionaries needed for the current
-      instance.  In GHC lingo, this is called a <em>method.</em>  Before
-      becoming a top-level binding, the method is first represented as a value
-      of type <code>Inst.Inst</code>, which makes it easy to fold multiple
-      instances of the same identifier at the same types into one global
-      definition.  (And probably other things, too, which I haven't
-      investigated yet.)
-
-    <p>
-      <strong>Note:</strong> As of 13 January 2001 (wrt. to the code in the
-      CVS HEAD), the above mechanism interferes badly with RULES pragmas
-      defined over overloaded functions.  During instantiation, a new name is
-      created for an overloaded function partially applied to the dictionaries
-      needed in a usage position of that function.  As the rewrite rule,
-      however, mentions the original overloaded name, it won't fire anymore
-      -- unless later phases remove the intermediate definition again.  The
-      latest CVS version of GHC has an option
-      <code>-fno-method-sharing</code>, which avoids sharing instantiation
-      stubs.  This is usually/often/sometimes sufficient to make the rules
-      fire again.
-
-    <p><small>
-<!-- hhmts start -->
-Last modified: Thu May 12 22:52:46 EST 2005
-<!-- hhmts end -->
-    </small>
-  </body>
-</html>
diff --git a/docs/comm/the-beast/types.html b/docs/comm/the-beast/types.html
deleted file mode 100644
index 383b71f0548d..000000000000
--- a/docs/comm/the-beast/types.html
+++ /dev/null
@@ -1,179 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
-<html>
-  <head>
-    <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-8859-1">
-    <title>The GHC Commentary - Hybrid Types</title>
-  </head>
-
-  <body BGCOLOR="FFFFFF">
-    <h1>The GHC Commentary - Hybrid Types</h1>
-    <p>
-      GHC essentially supports two type systems: (1) the <em>source type
-	system</em> (which is a heavily extended version of the type system of
-      Haskell 98) and (2) the <em>Core type system,</em> which is the type system
-      used by the intermediate language (see also <a
-      href="desugar.html">Sugar Free: From Haskell To Core</a>).
-    </p>
-    <p>
-      During parsing and renaming, type information is represented in a form
-      that is very close to Haskell's concrete syntax; it is defined by
-      <code>HsTypes.HsType</code>.  In addition, type, class, and instance
-      declarations are maintained in their source form as defined in the
-      module <code>HsDecl</code>.  The situation changes during type checking,
-      where types are translated into a second representation, which is
-      defined in the module <code>types/TypeRep.lhs</code>, as type
-      <code>Type</code>.  This second representation is peculiar in that it is
-      a hybrid between the source representation of types and the Core
-      representation of types.  Using functions, such as
-      <code>Type.coreView</code> and <code>Type.deepCoreView</code>, a value
-      of type <code>Type</code> exhibits its Core representation.  On the
-      other hand, pretty printing a <code>Type</code> with
-      <code>TypeRep.pprType</code> yields the type's source representation.
-    </p>
-    <p>
-      In fact, the <a href="typecheck.html">type checker</a> maintains type
-      environments based on <code>Type</code>, but needs to perform type
-      checking on source-level types.  As a result, we have functions
-      <code>Type.tcEqType</code> and <code>Type.tcCmpType</code>, which
-      compare types based on their source representation, as well as the
-      function <code>coreEqType</code>, which compares them based on their
-      core representation.  The latter is needed during type checking of Core
-      (as performed by the functions in the module
-      <code>coreSyn/CoreLint.lhs</code>). 
-    </p>
-
-    <h2>Type Synonyms</h2>
-    <p>
-      Type synonyms in Haskell are essentially a form of macro definitions on
-      the type level.  For example, when the type checker compares two type
-      terms, synonyms are always compared in their expanded form.  However, to
-      produce good error messages, we like to avoid expanding type synonyms
-      during pretty printing.  Hence, <code>Type</code> has a variant
-      <code>NoteTy TyNote Type</code>, where
-    </p>
-    <blockquote>
-      <pre>
-data TyNote
-  = FTVNote TyVarSet	-- The free type variables of the noted expression
-
-  | SynNote Type	-- Used for type synonyms
-			-- The Type is always a TyConApp, and is the un-expanded form.
-			-- The type to which the note is attached is the expanded form.</pre>
-    </blockquote>
-    <p>
-      In other words, a <code>NoteTy</code> represents the expanded form of a
-      type synonym together with a note stating its source form.
-    </p>
-
-    <h3>Creating Representation Types of Synonyms</h3>
-    <p>
-      During translation from <code>HsType</code> to <code>Type</code> the
-      function <code>Type.mkSynTy</code> is used to construct representations
-      of applications of type synonyms.  It creates a <code>NoteTy</code> node
-      if the synonym is applied to a sufficient number of arguments;
-      otherwise, it builds a simple <code>TyConApp</code> and leaves it to
-      <code>TcMType.checkValidType</code> to pick up invalid unsaturated
-      synonym applications.  While creating a <code>NoteTy</code>,
-      <code>mkSynTy</code> also expands the synonym by substituting the type
-      arguments for the parameters of the synonym definition, using
-      <code>Type.substTyWith</code>.
-    </p>
-    <p>
-      The function <code>mkSynTy</code> is used indirectly via
-      <code>mkGenTyConApp</code>, <code>mkAppTy</code>, and
-      <code>mkAppTy</code>, which construct type representations involving
-      type applications.  The function <code>mkSynTy</code> is also used
-      directly during type checking interface files; this is for tedious
-      reasons to do with forall hoisting - see the comment at
-      <code>TcIface.mkIfTcApp</code>. 
-    </p>
-
-    <h2>Newtypes</h2>
-    <p>
-      Data types declared by a <code>newtype</code> declarations constitute new
-      type constructors---i.e., they are not just type macros, but introduce
-      new type names.  However, provided that a newtype is not recursive, we
-      still want to implement it by its representation type.  GHC realises this
-      by providing two flavours of type equality: (1) <code>tcEqType</code> is
-      source-level type equality, which compares newtypes and
-      <code>PredType</code>s by name, and (2) <code>coreEqType</code> compares
-      them structurally (by using <code>deepCoreView</code> to expand the
-      representation before comparing).  The function
-      <code>deepCoreView</code> (via <code>coreView</code>) invokes
-      <code>expandNewTcApp</code> for every type constructor application
-      (<code>TyConApp</code>) to determine whether we are looking at a newtype
-      application that needs to be expanded to its representation type.
-    </p>
-
-    <h2>Predicates</h2>
-    <p>
-      The dictionary translation of type classes, translates each predicate in
-      a type context of a type signature into an additional argument, which
-      carries a dictionary with the functions overloaded by the corresponding
-      class.  The <code>Type</code> data type has a special variant
-      <code>PredTy PredType</code> for predicates, where
-    </p>
-    <blockquote>
-      <pre>
-data PredType 
-  = ClassP Class [Type]		-- Class predicate
-  | IParam (IPName Name) Type	-- Implicit parameter</pre>
-    </blockquote>
-    <p>
-      These types need to be handled as source type during type checking, but
-      turn into their representations when inspected through
-      <code>coreView</code>.  The representation is determined by
-      <code>Type.predTypeRep</code>.
-    </p>
-
-    <h2>Representation of Type Constructors</h2>
-    <p>
-      Type constructor applications are represented in <code>Type</code> by
-      the variant <code>TyConApp :: TyCon -> [Type] -> Type</code>.  The first
-      argument to <code>TyConApp</code>, namely <code>TyCon.TyCon</code>,
-      distinguishes between function type constructors (variant
-      <code>FunTyCon</code>) and algebraic type constructors (variant
-      <code>AlgTyCon</code>), which arise from data and newtype declarations.
-      The variant <code>AlgTyCon</code> contains all the information available
-      from the data/newtype declaration as well as derived information, such
-      as the <code>Unique</code> and argument variance information.  This
-      includes a field <code>algTcRhs :: AlgTyConRhs</code>, where
-      <code>AlgTyConRhs</code> distinguishes three kinds of algebraic data
-      type declarations: (1) declarations that have been exported abstractly,
-      (2) <code>data</code> declarations, and (3) <code>newtype</code>
-      declarations.  The last two both include their original right hand side;
-      in addition, the third variant also caches the "ultimate" representation
-      type, which is the right hand side after expanding all type synonyms and
-      non-recursive newtypes.
-    </p>
-    <p>
-      Both data and newtype declarations refer to their data constructors
-      represented as <code>DataCon.DataCon</code>, which include all details
-      of their signature (as derived from the original declaration) as well
-      information for code generation, such as their tag value.
-    </p>
-
-    <h2>Representation of Classes and Instances</h2>
-    <p>
-      Class declarations turn into values of type <code>Class.Class</code>.
-      They represent methods as the <code>Id</code>s of the dictionary
-      selector functions.  Similar selector functions are available for
-      superclass dictionaries.
-    </p>
-    <p>
-      Instance declarations turn into values of type
-      <code>InstEnv.Instance</code>, which in interface files are represented
-      as <code>IfaceSyn.IfaceInst</code>.  Moreover, the type
-      <code>InstEnv.InstEnv</code>, which is a synonym for <code>UniqFM
-      ClsInstEnv</code>, provides a mapping of classes to their
-      instances---<code>ClsInstEnv</code> is essentially a list of instance
-      declarations.
-    </p>
-
-    <p><small>
-<!-- hhmts start -->
-Last modified: Sun Jun 19 13:07:22 EST 2005
-<!-- hhmts end -->
-    </small></p>
-  </body>
-</html>
diff --git a/docs/comm/the-beast/vars.html b/docs/comm/the-beast/vars.html
deleted file mode 100644
index 9bbd310c605a..000000000000
--- a/docs/comm/the-beast/vars.html
+++ /dev/null
@@ -1,235 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
-<html>
-  <head>
-    <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-8859-1">
-    <title>The GHC Commentary - The Real Story about Variables, Ids, TyVars, and the like</title>
-  </head>
-
-  <body BGCOLOR="FFFFFF">
-    <h1>The GHC Commentary - The Real Story about Variables, Ids, TyVars, and the like</h1>
-    <p>
-
-
-<h2>Variables</h2>
-
-The <code>Var</code> type, defined in <code>basicTypes/Var.lhs</code>,
-represents variables, both term variables and type variables:
-<pre>
-    data Var
-      = Var {
-	    varName    :: Name,
-	    realUnique :: FastInt,
-	    varType    :: Type,
-	    varDetails :: VarDetails,
-	    varInfo    :: IdInfo		
-	}
-</pre>
-<ul>
-<li> The <code>varName</code> field contains the identity of the variable:
-its unique number, and its print-name.  See "<a href="names.html">The truth about names</a>".
-
-<p><li> The <code>realUnique</code> field caches the unique number in the
-<code>varName</code> field, just to make comparison of <code>Var</code>s a little faster.
-
-<p><li> The <code>varType</code> field gives the type of a term variable, or the kind of a
-type variable.  (Types and kinds are both represented by a <code>Type</code>.)
-
-<p><li> The <code>varDetails</code> field distinguishes term variables from type variables,
-and makes some further distinctions (see below).
-
-<p><li> For term variables (only) the <code>varInfo</code> field contains lots of useful
-information: strictness, unfolding, etc.  However, this information is all optional;
-you can always throw away the <code>IdInfo</code>.  In contrast, you can't safely throw away
-the <code>VarDetails</code> of a <code>Var</code>
-</ul>
-<p>
-It's often fantastically convenient to have term variables and type variables
-share a single data type.  For example, 
-<pre>
-  exprFreeVars :: CoreExpr -> VarSet
-</pre>
-If there were two types, we'd need to return two sets.  Simiarly, big lambdas and
-little lambdas use the same constructor in Core, which is extremely convenient.
-<p>
-We define a couple of type synonyms:
-<pre>
-  type Id    = Var  -- Term variables
-  type TyVar = Var  -- Type variables
-</pre>
-just to help us document the occasions when we are expecting only term variables,
-or only type variables.
-
-
-<h2> The <code>VarDetails</code> field </h2>
-
-The <code>VarDetails</code> field tells what kind of variable this is:
-<pre>
-data VarDetails
-  = LocalId 		-- Used for locally-defined Ids (see NOTE below)
-	LocalIdDetails
-
-  | GlobalId 		-- Used for imported Ids, dict selectors etc
-	GlobalIdDetails
-
-  | TyVar
-  | MutTyVar (IORef (Maybe Type)) 	-- Used during unification;
-	     TyVarDetails
-</pre>
-
-<a name="TyVar">
-<h2>Type variables (<code>TyVar</code>)</h2>
-</a>
-<p>
-The <code>TyVar</code> case is self-explanatory.  The <code>MutTyVar</code>
-case is used only during type checking.  Then a type variable can be unified,
-using an imperative update, with a type, and that is what the
-<code>IORef</code> is for.  The <code>TcType.TyVarDetails</code> field records
-the sort of type variable we are dealing with.  It is defined as
-<pre>
-data TyVarDetails = SigTv | ClsTv | InstTv | VanillaTv
-</pre>
-<code>SigTv</code> marks type variables that were introduced when
-instantiating a type signature prior to matching it against the inferred type
-of a definition.  The variants <code>ClsTv</code> and <code>InstTv</code> mark
-scoped type variables introduced by class and instance heads, respectively.
-These first three sorts of type variables are skolem variables (tested by the
-predicate <code>isSkolemTyVar</code>); i.e., they must <em>not</em> be
-instantiated. All other type variables are marked as <code>VanillaTv</code>.
-<p>
-For a long time I tried to keep mutable Vars statically type-distinct
-from immutable Vars, but I've finally given up.   It's just too painful.
-After type checking there are no MutTyVars left, but there's no static check
-of that fact.
-
-<h2>Term variables (<code>Id</code>)</h2>
-
-A term variable (of type <code>Id</code>) is represented either by a
-<code>LocalId</code> or a <code>GlobalId</code>:
-<p>
-A <code>GlobalId</code> is
-<ul>
-<li> Always bound at top-level.
-<li> Always has a <code>GlobalName</code>, and hence has 
-     a <code>Unique</code> that is globally unique across the whole
-     GHC invocation (a single invocation may compile multiple modules).
-<li> Has <code>IdInfo</code> that is absolutely fixed, forever.
-</ul>
-
-<p>
-A <code>LocalId</code> is:
-<ul> 
-<li> Always bound in the module being compiled:
-<ul>
-<li> <em>either</em> bound within an expression (lambda, case, local let(rec))
-<li> <em>or</em> defined at top level in the module being compiled.
-</ul>
-<li> Has IdInfo that changes as the simpifier bashes repeatedly on it.
-</ul>
-<p>
-The key thing about <code>LocalId</code>s is that the free-variable finder
-typically treats them as candidate free variables. That is, it ignores
-<code>GlobalId</code>s such as imported constants, data contructors, etc.
-<p>
-An important invariant is this: <em>All the bindings in the module
-being compiled (whether top level or not) are <code>LocalId</code>s
-until the CoreTidy phase.</em> In the CoreTidy phase, all
-externally-visible top-level bindings are made into GlobalIds.  This
-is the point when a <code>LocalId</code> becomes "frozen" and becomes
-a fixed, immutable <code>GlobalId</code>.
-<p>
-(A binding is <em>"externally-visible"</em> if it is exported, or
-mentioned in the unfolding of an externally-visible Id.  An
-externally-visible Id may not have an unfolding, either because it is
-too big, or because it is the loop-breaker of a recursive group.)
-
-<h3>Global Ids and implicit Ids</h3>
-
-<code>GlobalId</code>s are further categorised by their <code>GlobalIdDetails</code>.
-This type is defined in <code>basicTypes/IdInfo</code>, because it mentions other
-structured types like <code>DataCon</code>.  Unfortunately it is *used* in <code>Var.lhs</code>
-so there's a <code>hi-boot</code> knot to get it there.  Anyway, here's the declaration:
-<pre>
-data GlobalIdDetails
-  = NotGlobalId			-- Used as a convenient extra return value 
-                                -- from globalIdDetails
-
-  | VanillaGlobal		-- Imported from elsewhere
-
-  | PrimOpId PrimOp		-- The Id for a primitive operator
-  | FCallId ForeignCall		-- The Id for a foreign call
-
-  -- These next ones are all "implicit Ids"
-  | RecordSelId FieldLabel	-- The Id for a record selector
-  | DataConId DataCon		-- The Id for a data constructor *worker*
-  | DataConWrapId DataCon	-- The Id for a data constructor *wrapper*
-				-- [the only reasons we need to know is so that
-				--  a) we can  suppress printing a definition in the interface file
-				--  b) when typechecking a pattern we can get from the
-				--     Id back to the data con]
-</pre>
-The <code>GlobalIdDetails</code> allows us to go from the <code>Id</code> for 
-a record selector, say, to its field name; or the <code>Id</code> for a primitive
-operator to the <code>PrimOp</code> itself.
-<p>
-Certain <code>GlobalId</code>s are called <em>"implicit"</em> Ids.  An implicit
-Id is derived by implication from some other declaration.  So a record selector is
-derived from its data type declaration, for example.  An implicit Ids is always 
-a <code>GlobalId</code>.  For most of the compilation, the implicit Ids are just
-that: implicit.  If you do -ddump-simpl you won't see their definition.  (That's
-why it's true to say that until CoreTidy all Ids in this compilation unit are
-LocalIds.)  But at CorePrep, a binding is added for each implicit Id defined in
-this module, so that the code generator will generate code for the (curried) function.
-<p>
-Implicit Ids carry their unfolding inside them, of course, so they may well have
-been inlined much earlier; but we generate the curried top-level defn just in
-case its ever needed.
-
-<h3>LocalIds</h3>
-
-The <code>LocalIdDetails</code> gives more info about a <code>LocalId</code>:
-<pre>
-data LocalIdDetails 
-  = NotExported	-- Not exported
-  | Exported	-- Exported
-  | SpecPragma	-- Not exported, but not to be discarded either
-		-- It's unclean that this is so deeply built in
-</pre>
-From this we can tell whether the <code>LocalId</code> is exported, and that
-tells us whether we can drop an unused binding as dead code. 
-<p>
-The <code>SpecPragma</code> thing is a HACK.  Suppose you write a SPECIALIZE pragma:
-<pre>
-   foo :: Num a => a -> a
-   {-# SPECIALIZE foo :: Int -> Int #-}
-   foo = ...
-</pre>
-The type checker generates a dummy call to <code>foo</code> at the right types:
-<pre>
-   $dummy = foo Int dNumInt
-</pre>
-The Id <code>$dummy</code> is marked <code>SpecPragma</code>.  Its role is to hang
-onto that call to <code>foo</code> so that the specialiser can see it, but there
-are no calls to <code>$dummy</code>.
-The simplifier is careful not to discard <code>SpecPragma</code> Ids, so that it
-reaches the specialiser.  The specialiser processes the right hand side of a <code>SpecPragma</code> Id
-to find calls to overloaded functions, <em>and then discards the <code>SpecPragma</code> Id</em>.
-So <code>SpecPragma</code> behaves a like <code>Exported</code>, at least until the specialiser.
-
-
-<h3> ExternalNames and InternalNames </h3>
-
-Notice that whether an Id is a <code>LocalId</code> or <code>GlobalId</code> is 
-not the same as whether the Id has an <code>ExternaName</code> or an <code>InternalName</code>
-(see "<a href="names.html#sort">The truth about Names</a>"):
-<ul>
-<li> Every <code>GlobalId</code> has an <code>ExternalName</code>.
-<li> A <code>LocalId</code> might have either kind of <code>Name</code>.
-</ul>
-
-<!-- hhmts start -->
-Last modified: Fri Sep 12 15:17:18 BST 2003
-<!-- hhmts end -->
-    </small>
-  </body>
-</html>
-
diff --git a/docs/core-spec/core-spec.mng b/docs/core-spec/core-spec.mng
index 4e134e08541a..28540ac8e9e9 100644
--- a/docs/core-spec/core-spec.mng
+++ b/docs/core-spec/core-spec.mng
@@ -75,7 +75,9 @@ We also leave abstract the function \coderef{basicTypes/Literal.lhs}{literalType
 and the judgment \coderef{coreSyn/CoreLint.lhs}{lintTyLit} (written $[[G |-tylit lit : k]]$).
 
 \subsection{Variables}
-
+\enlargethispage{10pt} % without this first line of "z" definition is placed on
+                       % second page and it becomes the only line of text on that
+                       % page, resulting in whole page being empty.
 GHC uses the same datatype to represent term-level variables and type-level
 variables:
 
diff --git a/docs/core-spec/core-spec.pdf b/docs/core-spec/core-spec.pdf
index b9a9f4ba12f5..5d9f29c58b07 100644
Binary files a/docs/core-spec/core-spec.pdf and b/docs/core-spec/core-spec.pdf differ
diff --git a/docs/docbook-cheat-sheet/Makefile b/docs/docbook-cheat-sheet/Makefile
deleted file mode 100644
index 8cd9f518698e..000000000000
--- a/docs/docbook-cheat-sheet/Makefile
+++ /dev/null
@@ -1,9 +0,0 @@
-TOP = ../..
-include $(TOP)/mk/boilerplate.mk
-
-XML_DOC = docbook-cheat-sheet
-INSTALL_XML_DOC = docbook-cheat-sheet
-
-include $(TOP)/mk/bindist.mk
-
-include $(TOP)/mk/target.mk
diff --git a/docs/docbook-cheat-sheet/docbook-cheat-sheet.xml b/docs/docbook-cheat-sheet/docbook-cheat-sheet.xml
deleted file mode 100644
index d48b3ef6f212..000000000000
--- a/docs/docbook-cheat-sheet/docbook-cheat-sheet.xml
+++ /dev/null
@@ -1,223 +0,0 @@
-<?xml version="1.0" encoding="iso-8859-1"?>
-<!DOCTYPE article PUBLIC "-//OASIS//DTD DocBook XML V4.5//EN"
-   "http://www.oasis-open.org/docbook/xml/4.5/docbookx.dtd">
-
-<article id="docbook-cheat-sheet">
-
-  <articleinfo>
-    <title>Using DocBook to write GHC documentation</title>
-    <author><othername>The GHC Team</othername></author>
-    <address><email>glasgow-haskell-&lcub;users,bugs&rcub;@dcs.gla.ac.uk</email></address>
-    <pubdate>January 2000</pubdate>
-  </articleinfo>
-
-  <sect1 id="sec-getting-docbook">
-    <title>Getting the DocBook tools</title>
-    <para>See the installation guide.</para>
-  </sect1>
-
-  <sect1 id="doc-layout">
-    <title>Document layout</title>
-
-    <para>The GHC documentation is written using DocBook XML V4.5, so
-    the first few lines should look like this:</para>
-
-<programlisting>
-&lt;?xml version="1.0" encoding="iso-8859-1"?>
-&lt;!DOCTYPE article PUBLIC "-//OASIS//DTD DocBook XML V4.5//EN"
-   "http://www.oasis-open.org/docbook/xml/4.5/docbookx.dtd">
-</programlisting>
-
-    <para>The encoding can of course be chosen according to taste.</para>
-
-    <para> This guide is <emphasis>not</emphasis> meant to teach you
-    how to write DocBook; read the <ulink
-    url="http://www.docbook.org/">DocBook book</ulink> for that. It is
-    more of a reference than a tutorial, so see the <ulink
-    url="http://www.oasis-open.org/docbook/">DocBook home page</ulink>
-    for other links.</para>
-
-    <para>However, by popular demand, here are some useful points:
-    </para>
-
-    <itemizedlist>
-      <listitem>
-        <para>Remember to use <sgmltag class="starttag">para</sgmltag>
-        inside <sgmltag class="starttag">listitem</sgmltag>s.</para>
-      </listitem>
-    </itemizedlist>
-
-    <para>The rest of this section outlines the use of several tags
-    which may not be obvious (DocBook is rather scholastic in style:
-    it has tags for many things from C function prototypes to keyboard
-    bindings; at the same time it has many omissions and
-    oddities). The current scheme has many infelicities, partly
-    because it was dreamt up in a hurry while the author was learning
-    DocBook and converting the documentation thereto, and partly
-    because DocBook is rather C-centric.</para>
-
-    <variablelist>
-
-      <varlistentry>
-        <term>Comments</term>
-        <listitem>
-          <para>Comments in XML look like this: <sgmltag
-          class="sgmlcomment">This is a comment</sgmltag>.</para>
-        </listitem>
-      </varlistentry>
-
-      <varlistentry>
-        <term><sgmltag class="starttag">command</sgmltag></term>
-        <listitem>
-          <para>Used for commands typed into interactive sessions
-          (e.g. <command>cp foo bar</command> and the names of
-          programs such as <command>gmake</command>.</para>
-        </listitem>
-      </varlistentry>
-
-      <varlistentry>
-        <term><sgmltag class="starttag">constant</sgmltag></term>
-        <listitem>
-          <para>Used for system constants such as
-          <constant>U_MAXINT</constant> and
-          <filename>Makefile</filename> variables like
-          <constant>SRC_FILES</constant> (because they are usually
-          constant for a given run of <command>make</command>, and
-          hence have a constant feel to them).</para>
-        </listitem>
-      </varlistentry>
-
-      <varlistentry>
-        <term><sgmltag class="starttag">email</sgmltag></term>
-        <listitem>
-          <para>For email addresses. This is a tag that's easy to
-          overlook if you don't know it's there.</para>
-        </listitem>
-      </varlistentry>
-
-      <varlistentry>
-        <term><sgmltag class="starttag">filename</sgmltag></term>
-        <listitem>
-          <para>Used for paths, filenames, file extensions.</para>
-        </listitem>
-      </varlistentry>
-
-      <varlistentry>
-        <term><sgmltag class="starttag">function</sgmltag></term>
-        <listitem>
-          <para>Used for functions and constructors.</para>
-        </listitem>
-      </varlistentry>
-
-      <varlistentry>
-        <term><sgmltag class="starttag">indexterm</sgmltag></term>
-        <listitem>
-          <para>The normal way to mark up an index term is
-          <literal>&lt;indexterm&gt;&lt;primary&gt;term&lt;/primary&gt;&lt;/indexterm&gt;</literal>.</para>
-        </listitem>
-      </varlistentry>
-
-      <varlistentry>
-        <term><sgmltag class="starttag">keycap</sgmltag></term>
-        <term><sgmltag class="starttag">keycombo</sgmltag></term>
-        <listitem>
-          <para>Some more tags you may miss. Used for combinations
-          such as
-          <keycombo><keycap>Control</keycap><keycap>D</keycap></keycombo>.</para>
-        </listitem>
-      </varlistentry>
-
-      <varlistentry>
-        <term><sgmltag class="starttag">literal</sgmltag></term>
-        <listitem>
-          <para>Used for everything that should appear in typewriter
-          font that has no other obvious tag: types, monads, small
-          snippets of program text that are formatted inline, and the
-          like.</para>
-        </listitem>
-      </varlistentry>
-
-      <varlistentry>
-        <term><sgmltag class="starttag">option</sgmltag></term>
-        <listitem>
-          <para>Used for compiler options and similar.</para>
-        </listitem>
-      </varlistentry>
-
-      <varlistentry>
-        <term><sgmltag class="starttag">programlisting</sgmltag></term>
-        <listitem>
-          <para>For displayed program listings (including shell
-          scripts).</para>
-        </listitem>
-      </varlistentry>
-
-      <varlistentry>
-        <term><sgmltag class="starttag">screen</sgmltag></term>
-        <listitem>
-          <para>For displayed screen dumps, such as portions of shell
-          interaction. It's easy to tell the difference between these
-          and shell scripts: the latter lack a shell prompt.</para>
-        </listitem>
-      </varlistentry>
-
-      <varlistentry>
-        <term><sgmltag class="starttag">varname</sgmltag></term>
-        <listitem>
-          <para>Used for variables, but not type variables.</para>
-        </listitem>
-      </varlistentry>
-
-    </variablelist>
-
-  </sect1>
-
-  <sect1 id="docbook-tables">
-    <title>Tables</title>
-
-    <para>Tables are quite complicated to write in DocBook XML (as in HTML,
-    there are lots of fiddly tags), so here's an example you can
-    cannibalise. In the spirit of the LaTeX short introduction I don't
-    repeat all the markup verbatim; you have to look at the source for
-    that.</para>
-
-    <informaltable>
-      <tgroup cols="3">
-        <colspec colname="one" align="left" colsep="0"/>
-        <colspec colname="two" align="center" colsep="0"/>
-        <colspec colname="three" align="right" colsep="0"/>
-        <tbody>
-
-          <row>
-            <entry>Here's</entry>
-            <entry>a sample</entry>
-            <entry>table</entry>
-          </row>
-
-          <row>
-            <entry>With differently</entry>
-            <entry>aligned</entry>
-            <entry>cells</entry>
-          </row>
-
-          <row>
-            <entry namest="one" nameend="three" morerows="1">
-              <para> There's not much else to it. Entries can span
-              both extra rows and extra columns; just be careful when
-              using block markup (such as <sgmltag
-              class="starttag">para</sgmltag>s) within an <sgmltag
-              class="starttag">entry</sgmltag> that there is no space
-              between the open and close <sgmltag
-              class="starttag">entry</sgmltag> tags and the adjacent
-              text, as otherwise you will suffer from <ulink
-              url="http://www.docbook.org/tdg/html/entry.html">Pernicious
-              Mixed Content</ulink> (the parser will think you're
-              using inline markup).</para>
-            </entry>
-          </row>
-
-        </tbody>
-      </tgroup>
-    </informaltable>
-  </sect1>
-</article>
diff --git a/docs/storage-mgt/rp.tex b/docs/storage-mgt/rp.tex
index 20e313ba4316..0d841b9d42ec 100644
--- a/docs/storage-mgt/rp.tex
+++ b/docs/storage-mgt/rp.tex
@@ -1029,7 +1029,7 @@ \section{Usage}
 \label{fig-cacheprof}
 \end{figure}
 
-\section{Comparision with nhc}
+\section{Comparison with nhc}
 
 \section{Files}
 
diff --git a/docs/users_guide/7.10.1-notes.xml b/docs/users_guide/7.10.1-notes.xml
new file mode 100644
index 000000000000..0af4c3145b8e
--- /dev/null
+++ b/docs/users_guide/7.10.1-notes.xml
@@ -0,0 +1,411 @@
+<?xml version="1.0" encoding="iso-8859-1"?>
+<sect1 id="release-7-10-1">
+  <title>Release notes for version 7.10.1</title>
+
+  <para>
+      The significant changes to the various parts of the compiler are listed
+      in the following sections. There have also been numerous bug fixes and
+      performance improvements over the 7.8 branch.
+  </para>
+
+  <sect2>
+    <title>Highlights</title>
+
+    <para>
+        The highlights, since the 7.8 branch, are:
+    </para>
+
+    <itemizedlist>
+        <listitem>
+            <para>
+                TODO FIXME
+           </para>
+       </listitem>
+   </itemizedlist>
+  </sect2>
+
+  <sect2>
+    <title>Full details</title>
+    <sect3>
+        <title>Language</title>
+        <itemizedlist>
+            <listitem>
+                <para>
+                    Added support for <link linkend="binary-literals">binary integer literals</link>
+               </para>
+           </listitem>
+       </itemizedlist>
+    </sect3>
+
+    <sect3>
+        <title>Compiler</title>
+        <itemizedlist>
+            <listitem>
+                <para>
+                    GHC now checks that all the language extensions required for
+                    the inferred type signatures are explicitly enabled. This
+                    means that if any of the type signatures inferred in your
+                    program requires some language extension you will need to
+                    enable it. The motivation is that adding a missing type
+                    signature inferred by GHC should yield a program that
+                    typechecks. Previously this was not the case.
+                </para>
+                <para>
+                    This is a breaking change. Code that used to compile in the
+                    past might fail with an error message requiring some
+                    particular language extension (most likely
+                    <option>-XTypeFamilies</option>, <option>-XGADTs</option> or
+                    <option>-XFlexibleContexts</option>).
+                </para>
+           </listitem>
+       </itemizedlist>
+    </sect3>
+
+    <sect3>
+        <title>GHCi</title>
+        <itemizedlist>
+            <listitem>
+                <para>
+                    TODO FIXME
+               </para>
+           </listitem>
+       </itemizedlist>
+    </sect3>
+
+    <sect3>
+        <title>Template Haskell</title>
+        <itemizedlist>
+            <listitem>
+                <para>
+                    TODO FIXME
+               </para>
+           </listitem>
+       </itemizedlist>
+    </sect3>
+
+    <sect3>
+        <title>Runtime system</title>
+        <itemizedlist>
+            <listitem>
+                <para>
+                    TODO FIXME
+               </para>
+           </listitem>
+       </itemizedlist>
+    </sect3>
+
+    <sect3>
+        <title>Build system</title>
+        <itemizedlist>
+            <listitem>
+                <para>
+                    <literal>ghc-pkg</literal> now respects <option>--user</option>
+                    and <option>--global</option> when modifying packages (e.g.
+                    changing exposed/trust flag or unregistering).  Previously,
+                    <literal>ghc-pkg</literal> would ignore these flags and modify
+                    whichever package it found first on the database stack.  To
+                    recover the old behavior, simply omit these flags.
+               </para>
+           </listitem>
+            <listitem>
+                <para>
+                    <literal>ghc-pkg</literal> accepts a <option>--user-package-db</option>
+                    flag which allows a user to override the location of the user package
+                    database.  Unlike databases specified using <option>--package-db</option>,
+                    a user package database configured this way respects
+                    the <option>--user</option> flag.
+               </para>
+           </listitem>
+       </itemizedlist>
+    </sect3>
+  </sect2>
+
+  <sect2>
+    <title>Libraries</title>
+
+    <sect3>
+        <title>array</title>
+        <itemizedlist>
+            <listitem>
+                <para>
+                    Version number XXXXX (was 0.5.0.0)
+               </para>
+           </listitem>
+       </itemizedlist>
+    </sect3>
+
+    <sect3>
+        <title>base</title>
+        <itemizedlist>
+            <listitem>
+                <para>
+                    Version number XXXXX (was 4.7.0.0)
+               </para>
+           </listitem>
+       </itemizedlist>
+    </sect3>
+
+    <sect3>
+        <title>bin-package-db</title>
+        <itemizedlist>
+            <listitem>
+                <para>
+                    This is an internal package, and should not be used.
+               </para>
+           </listitem>
+       </itemizedlist>
+    </sect3>
+
+    <sect3>
+        <title>binary</title>
+        <itemizedlist>
+            <listitem>
+                <para>
+                    Version number XXXXX (was 0.7.1.0)
+               </para>
+           </listitem>
+       </itemizedlist>
+    </sect3>
+
+    <sect3>
+        <title>bytestring</title>
+        <itemizedlist>
+            <listitem>
+                <para>
+                    Version number XXXXX (was 0.10.4.0)
+               </para>
+           </listitem>
+       </itemizedlist>
+    </sect3>
+
+    <sect3>
+        <title>Cabal</title>
+        <itemizedlist>
+            <listitem>
+                <para>
+                    Version number XXXXX (was 1.18.1.3)
+              </para>
+          </listitem>
+      </itemizedlist>
+    </sect3>
+
+    <sect3>
+        <title>containers</title>
+        <itemizedlist>
+            <listitem>
+                <para>
+                    Version number XXXXX (was 0.5.4.0)
+               </para>
+           </listitem>
+       </itemizedlist>
+    </sect3>
+
+    <sect3>
+        <title>deepseq</title>
+        <itemizedlist>
+            <listitem>
+                <para>
+                    Version number XXXXX (was 1.3.0.2)
+               </para>
+           </listitem>
+       </itemizedlist>
+    </sect3>
+
+    <sect3>
+        <title>directory</title>
+        <itemizedlist>
+            <listitem>
+                <para>
+                    Version number XXXXX (was 1.2.0.2)
+               </para>
+           </listitem>
+       </itemizedlist>
+    </sect3>
+
+    <sect3>
+        <title>filepath</title>
+        <itemizedlist>
+            <listitem>
+                <para>
+                    Version number XXXXX (was 1.3.0.2)
+               </para>
+           </listitem>
+       </itemizedlist>
+    </sect3>
+
+    <sect3>
+        <title>ghc</title>
+        <itemizedlist>
+            <listitem>
+                <para>
+                    Many internal functions in GHC related to package IDs have been
+                    renamed to refer to package keys, e.g. <literal>PackageId</literal>
+                    is now <literal>PackageKey</literal>, the wired-in names
+                    such as <literal>primPackageId</literal> are now
+                    <literal>primPackageKey</literal>, etc.  This reflects a distinction
+                    that we are now making: a package ID is, as before, the user-visible
+                    ID from Cabal <literal>foo-1.0</literal>; a package key is now
+                    a compiler-internal entity used for generating linking symbols, and
+                    may not correspond at all to the package ID.  In
+                    particular, there may be multiple package keys per
+                    package ID.
+               </para>
+           </listitem>
+       </itemizedlist>
+    </sect3>
+
+    <sect3>
+        <title>ghc-prim</title>
+        <itemizedlist>
+            <listitem>
+                <para>
+                    Version number XXXXX (was 0.3.1.0)
+               </para>
+           </listitem>
+       </itemizedlist>
+    </sect3>
+
+    <sect3>
+        <title>haskell98</title>
+        <itemizedlist>
+            <listitem>
+                <para>
+                    Version number XXXXX (was 2.0.0.3)
+               </para>
+           </listitem>
+       </itemizedlist>
+    </sect3>
+
+    <sect3>
+        <title>haskell2010</title>
+        <itemizedlist>
+            <listitem>
+                <para>
+                    Version number XXXXX (was 1.1.1.1)
+               </para>
+           </listitem>
+       </itemizedlist>
+    </sect3>
+
+    <sect3>
+        <title>hoopl</title>
+        <itemizedlist>
+            <listitem>
+                <para>
+                    Version number XXXXX (was 3.10.0.0)
+               </para>
+           </listitem>
+       </itemizedlist>
+    </sect3>
+
+    <sect3>
+        <title>hpc</title>
+        <itemizedlist>
+            <listitem>
+                <para>
+                    Version number XXXXX (was 0.6.0.1)
+               </para>
+           </listitem>
+       </itemizedlist>
+    </sect3>
+
+    <sect3>
+        <title>integer-gmp</title>
+        <itemizedlist>
+            <listitem>
+                <para>
+                    Version number XXXXX (was 0.5.1.0)
+               </para>
+           </listitem>
+       </itemizedlist>
+    </sect3>
+
+    <sect3>
+        <title>old-locale</title>
+        <itemizedlist>
+            <listitem>
+                <para>
+                    Version number XXXXX (was 1.0.0.6)
+               </para>
+           </listitem>
+       </itemizedlist>
+    </sect3>
+
+    <sect3>
+        <title>old-time</title>
+        <itemizedlist>
+            <listitem>
+                <para>
+                    Version number XXXXX (was 1.1.0.2)
+               </para>
+           </listitem>
+       </itemizedlist>
+    </sect3>
+
+    <sect3>
+        <title>process</title>
+        <itemizedlist>
+            <listitem>
+                <para>
+                    Version number XXXXX (was 1.2.0.0)
+               </para>
+           </listitem>
+       </itemizedlist>
+    </sect3>
+
+    <sect3>
+        <title>template-haskell</title>
+        <itemizedlist>
+            <listitem>
+                <para>
+                    Version number XXXXX (was 2.9.0.0)
+               </para>
+           </listitem>
+       </itemizedlist>
+    </sect3>
+
+    <sect3>
+        <title>time</title>
+        <itemizedlist>
+            <listitem>
+                <para>
+                    Version number XXXXX (was 1.4.1)
+               </para>
+           </listitem>
+       </itemizedlist>
+    </sect3>
+
+    <sect3>
+        <title>unix</title>
+        <itemizedlist>
+            <listitem>
+                <para>
+                    Version number XXXXX (was 2.7.0.0)
+               </para>
+           </listitem>
+       </itemizedlist>
+    </sect3>
+
+    <sect3>
+        <title>Win32</title>
+        <itemizedlist>
+            <listitem>
+                <para>
+                    Version number XXXXX (was 2.3.0.1)
+               </para>
+           </listitem>
+       </itemizedlist>
+    </sect3>
+  </sect2>
+
+  <sect2>
+    <title>Known bugs</title>
+    <itemizedlist>
+        <listitem>
+            <para>
+                TODO FIXME
+           </para>
+       </listitem>
+   </itemizedlist>
+  </sect2>
+</sect1>
diff --git a/docs/users_guide/7.8.1-notes.xml b/docs/users_guide/7.8.1-notes.xml
deleted file mode 100644
index 1ae96bc80ed0..000000000000
--- a/docs/users_guide/7.8.1-notes.xml
+++ /dev/null
@@ -1,1206 +0,0 @@
-<?xml version="1.0" encoding="iso-8859-1"?>
-<sect1 id="release-7-8-1">
-  <title>Release notes for version 7.8.1</title>
-
-  <para>
-      The significant changes to the various parts of the compiler are listed
-      in the following sections. There have also been numerous bug fixes and
-      performance improvements over the 7.6 branch.
-  </para>
-
-  <sect2>
-    <title>Highlights</title>
-
-    <para>
-        The highlights, since the 7.6 branch, are:
-    </para>
-
-    <itemizedlist>
-        <listitem>
-            <para>
-                OS X Mavericks with XCode 5 is now properly supported
-                by GHC. As a result of this, GHC now uses Clang to
-                preprocess Haskell code by default for Mavericks
-                builds.
-           </para>
-
-            <para>
-                Note that normally, GHC used <literal>gcc</literal> as
-                the preprocessor for Haskell code (as it was the
-                default everywhere,) which implements
-                <literal>-traditional</literal> behavior. However,
-                Clang is not 100% compatible with GCC's
-                <literal>-traditional</literal> as it is rather
-                implementation specified and does not match any
-                specification. Clang is also more strict.
-           </para>
-
-            <para>
-                As a result of this, when using Clang as the
-                preprocessor, some programs which previously used
-                <literal>-XCPP</literal> and the preprocessor will now
-                fail to compile. Users who wish to retain the previous
-                behavior are better off using cpphs as an external
-                preprocessor for the time being.
-           </para>
-
-            <para>
-                In the future, we hope to fix this by adopting a
-                better preprocessor implementation independent of the
-                C compiler (perhaps cpphs itself,) and ship that
-                instead.
-           </para>
-       </listitem>
-
-        <listitem>
-            <para>
-                By default, GHC has a new warning enabled,
-                <literal>-fwarn-typed-holes</literal>, which causes the
-                compiler to respond with the types of unbound
-                variables it encounters in the source code. (It is
-                reminiscient of the "holes" feature in languages such
-                as Agda.)
-
-                For more information, see <xref linkend="typed-holes"/>.
-           </para>
-       </listitem>
-
-        <listitem>
-            <para>
-                GHC can now perform simple evaluation of type-level
-                natural numbers, when using the
-                <literal>DataKinds</literal> extension. For example,
-                given a type-level constraint such as <literal>(x + 3)
-                ~ 5</literal>, GHC is able to infer that
-                <literal>x</literal> is 2. Similarly, GHC can now
-                understand type-level identities such as <literal>x +
-                0 ~ x</literal>.
-           </para>
-
-            <para>
-                Note that the solving of these equations is only used
-                to resolve unification variables - it does not
-                generate new facts in the type checker. This is
-                similar to how functional dependencies work.
-           </para>
-       </listitem>
-
-        <listitem>
-            <para>
-                It is now possible to declare a 'closed' <literal>type
-                family</literal> when using the
-                <literal>TypeFamilies</literal> extension. A closed
-                <literal>type family</literal> cannot have any
-                instances created other than the ones in its
-                definition.
-
-                For more information, see <xref linkend="closed-type-families"/>.
-           </para>
-       </listitem>
-
-       <listitem>
-           <para>
-                Use of the <literal>GeneralizedNewtypeDeriving</literal>
-                extension is now subject to <emphasis>role checking</emphasis>,
-                to ensure type safety of the derived instances. As this change
-                increases the type safety of GHC, it is possible that some code
-                that previously compiled will no longer work.
-
-                For more information, see <xref linkend="roles"/>.
-           </para>
-       </listitem>
-
-        <listitem>
-            <para>
-                GHC now supports overloading list literals using the new
-                <literal>OverloadedLists</literal> extension.
-
-                For more information, see <xref linkend="overloaded-lists"/>.
-           </para>
-       </listitem>
-
-        <listitem>
-            <para>
-                GHC now supports pattern synonyms, enabled by the
-                <literal>-XPatternSynonyms</literal> extension,
-                allowing you to name and abstract over patterns more
-                easily.
-
-                For more information, see <xref linkend="pattern-synonyms"/>.
-           </para>
-           <para>
-                Note: For the GHC 7.8.1 version, this language feature
-                should be regarded as a preview.
-           </para>
-       </listitem>
-
-        <listitem>
-            <para>
-                There has been significant overhaul of the type
-                inference engine and constraint solver, meaning it
-                should be faster and use less memory.
-           </para>
-       </listitem>
-
-        <listitem>
-            <para>
-                By default, GHC will now unbox all "small" strict
-                fields in a data type. A "small" data type is one
-                whose size is equivalent to or smaller than the native
-                word size of the machine. This means you no longer
-                have to specify <literal>UNPACK</literal> pragmas for
-                e.g. strict <literal>Int</literal> fields. This also
-                applies to floating-point values.
-           </para>
-       </listitem>
-
-        <listitem>
-            <para>
-                GHC now has a brand-new I/O manager that scales significantly
-                better for larger workloads compared to the previous one. It
-                should scale linearly up to approximately 32 cores.
-           </para>
-       </listitem>
-
-        <listitem>
-            <para>
-                The LLVM backend now supports 128- and 256-bit SIMD
-                operations.
-           </para>
-            <para>
-                Note carefully: this is <emphasis>only</emphasis> available with
-                the LLVM backend, and should be considered
-                experimental.
-           </para>
-       </listitem>
-
-        <listitem>
-            <para>
-                The new code generator, after significant work by many
-                individuals over the past several years, is now enabled by
-                default. This is a complete rewrite of the STG to Cmm
-                transformation. In general, your programs may get slightly
-                faster.
-           </para>
-
-            <para>
-                The old code generator has been removed completely.
-           </para>
-       </listitem>
-
-        <listitem>
-            <para>
-                GHC now has substantially better support for cross
-                compilation. In particular, GHC now has all the
-                necessary patches to support cross compilation to
-                Apple iOS, using the LLVM backend.
-           </para>
-       </listitem>
-
-        <listitem>
-            <para>
-                PrimOps for comparing unboxed values now return
-                <literal>Int#</literal> instead of <literal>Bool</literal>.
-                This change is backwards incompatible. See
-                <ulink url="http://ghc.haskell.org/trac/ghc/wiki/NewPrimopsInGHC7.8">
-                this GHC wiki page</ulink> for instructions how to update your
-                existing code. See <ulink url="http://ghc.haskell.org/trac/ghc/wiki/PrimBool">
-                here</ulink> for motivation and discussion of implementation details.
-           </para>
-       </listitem>
-
-        <listitem>
-            <para>
-                New PrimOps for atomic memory operations.
-                The <literal>casMutVar#</literal> PrimOp was introduced in
-                GHC 7.2 (debugged in 7.4).  This release also includes additional
-                PrimOps for compare-and-swap (<literal>casArray#</literal> and
-                <literal>casIntArray#</literal>) and one for fetch-and-add
-                (<literal>fetchAddIntArray#</literal>).
-           </para>
-       </listitem>
-
-        <listitem>
-            <para>
-                On Linux, FreeBSD and Mac OS X, GHCi now uses the
-                system dynamic linker by default, instead of its built
-                in (static) object linker. This is more robust
-                cross-platform, and fixes many long-standing bugs (for
-                example: constructors and destructors, weak symbols,
-                etc work correctly, and several edge cases in the RTS
-                are fixed.)
-           </para>
-
-            <para>
-                As a result of this, GHCi (and Template Haskell) must
-                now load <emphasis>dynamic</emphasis> object files, not static
-                ones. To assist this, there is a new compilation flag,
-                <literal>-dynamic-too</literal>, which when used
-                during compilation causes GHC to emit both static and
-                dynamic object files at the same time. GHC itself
-                still defaults to static linking.
-            </para>
-
-            <para>
-                Note that Cabal will correctly handle
-                <literal>-dynamic-too</literal> for you automatically,
-                especially when <literal>-XTemplateHaskell</literal>
-                is needed - but you <emphasis>must</emphasis> tell Cabal you are
-                using the <literal>TemplateHaskell</literal>
-                extension.
-           </para>
-
-            <para>
-                Currently, Dynamic GHCi and
-                <literal>-dynamic-too</literal> are not supported on
-                Windows (32bit or 64bit.)
-           </para>
-       </listitem>
-
-        <listitem>
-            <para>
-                <literal>Typeable</literal> is now poly-kinded, making
-                <literal>Typeable1</literal>, <literal>Typeable2</literal>,
-                etc., obsolete, deprecated, and relegated to
-                <literal>Data.OldTypeable</literal>. Furthermore, user-written
-                instances of <literal>Typeable</literal> are now disallowed:
-                use <literal>deriving</literal> or the new extension
-                <literal>-XAutoDeriveTypeable</literal>, which will create
-                <literal>Typeable</literal> instances for every datatype
-                declared in the module.
-           </para>
-       </listitem>
-
-        <listitem>
-            <para>
-                GHC now has a parallel compilation driver. When
-                compiling with <literal>--make</literal> (which is on
-                by default,) you may also specify
-                <literal>-jN</literal> in order to compile
-                <replaceable>N</replaceable> modules in
-                parallel. (Note: this will automatically scale on
-                multicore machines without specifying <literal>+RTS
-                -N</literal> to the compiler.)
-           </para>
-       </listitem>
-
-        <listitem>
-            <para>
-                GHC now has support for a new pragma,
-                <literal>{-# MINIMAL #-}</literal>, allowing you to
-                explicitly declare the minimal complete definition of
-                a class. Should an instance not provide the minimal
-                required definitions, a warning will be emitted.
-           </para>
-       </listitem>
-
-        <listitem>
-            <para>
-                In GHC 7.10, <literal>Applicative</literal> will
-                become a superclass of <literal>Monad</literal>,
-                potentially breaking a lot of user code. To ease this
-                transition, GHC now generates warnings when
-                definitions conflict with the Applicative-Monad
-                Proposal (AMP).
-           </para>
-
-            <para>
-                A warning is emitted if a type is an instance of
-                <literal>Monad</literal> but not of
-                <literal>Applicative</literal>,
-                <literal>MonadPlus</literal> but not
-                <literal>Alternative</literal>, and when a local
-                function named <literal>join</literal>,
-                <literal>&lt;*&gt;</literal> or <literal>pure</literal> is
-                defined.
-           </para>
-
-            <para>
-                The warnings are enabled by default, and can be controlled
-                using the new flag <literal>-f[no-]warn-amp</literal>.
-           </para>
-       </listitem>
-
-        <listitem>
-            <para>
-                Using the new <literal>InterruptibleFFI</literal>
-                extension, it's possible to now declare a foreign
-                import as <literal>interruptible</literal>, as opposed
-                to only <literal>safe</literal> or
-                <literal>unsafe</literal>. An
-                <literal>interruptible</literal> foreign call is the
-                same as a <literal>safe</literal> call, but may be
-                interrupted by asynchronous <emphasis>Haskell
-                exceptions</emphasis>, such as those generated by
-                <literal>throwTo</literal> or
-                <literal>timeout</literal>.
-           </para>
-
-            <para>
-                For more information (including the exact details on
-                how the foreign thread is interrupted,) see <xref
-                linkend="ffi-interruptible"/>.
-           </para>
-       </listitem>
-
-        <listitem>
-            <para>
-                GHC's internal compiler pipeline is now exposed
-                through a <literal>Hooks</literal> module inside the
-                GHC API. These hooks allow you to control most of the
-                internal compiler phase machinery, including compiling
-                expressions, phase control, and linking.
-           </para>
-
-            <para>
-                Note: this interface will likely see continuous
-                refinement and API changes in future releases, so it
-                should be considered a preview.
-           </para>
-       </listitem>
-   </itemizedlist>
-  </sect2>
-
-  <sect2>
-    <title>Full details</title>
-    <sect3>
-        <title>Language</title>
-        <itemizedlist>
-            <listitem>
-                <para>
-                    There is a new extension,
-                    <literal>NullaryTypeClasses</literal>, which
-                    allows you to declare a type class without any
-                    parameters.
-               </para>
-           </listitem>
-       </itemizedlist>
-
-        <itemizedlist>
-            <listitem>
-                <para>
-                    There is a new extension,
-                    <literal>NumDecimals</literal>, which allows you
-                    to specify an integer using compact "floating
-                    literal" syntax. This lets you say things like
-                    <literal>1.2e6 :: Integer</literal> instead of
-                    <literal>1200000</literal>
-               </para>
-           </listitem>
-       </itemizedlist>
-
-        <itemizedlist>
-            <listitem>
-                <para>
-                    There is a new extension,
-                    <literal>NegativeLiterals</literal>, which will
-                    cause GHC to interpret the expression
-                    <literal>-123</literal> as <literal>fromIntegral
-                    (-123)</literal>. Haskell 98 and Haskell 2010 both
-                    specify that it should instead desugar to
-                    <literal>negate (fromIntegral 123)</literal>
-               </para>
-           </listitem>
-       </itemizedlist>
-
-        <itemizedlist>
-            <listitem>
-                <para>
-                    There is a new extension,
-                    <literal>EmptyCase</literal>, which allows
-                    to write a case expression with no alternatives
-                    <literal>case ... of {}</literal>.
-               </para>
-           </listitem>
-       </itemizedlist>
-
-        <itemizedlist>
-            <listitem>
-                <para>
-                     The <literal>IncoherentInstances</literal>
-                     extension has seen a behavioral change, and is
-                     now 'liberated' and less conservative during
-                     instance resolution. This allows more programs to
-                     compile than before.
-               </para>
-                <para>
-                     Now, <literal>IncoherentInstances</literal> will
-                     always pick an arbitrary matching instance, if
-                     multiple ones exist.
-               </para>
-           </listitem>
-       </itemizedlist>
-
-        <itemizedlist>
-            <listitem>
-                <para>
-                     A new built-in function <literal>coerce</literal> is
-                     provided that allows to safely coerce values between types
-                     that have the same run-time-presentation, such as
-                     newtypes, but also newtypes inside containers. See the
-                     haddock documentation of
-                     <ulink url="&libraryBaseLocation;/GHC-Exts.html#v%3Acoerce">coerce</ulink>
-                     and of the class
-                     <ulink url="&libraryBaseLocation;/GHC-Exts.html#t%3ACoercible">Coercible</ulink>
-                     for more details.
-               </para>
-                <para>
-                     This feature is included in this release as a technology
-                     preview, and may change its syntax and/or semantics in the
-                     next release.
-               </para>
-           </listitem>
-       </itemizedlist>
-
-        <itemizedlist>
-            <listitem>
-                <para>
-                     The new pragma, <literal>{-# MINIMAL #-}</literal>,
-                     allows to explicitly declare the minimal complete
-                     definition of a class. Should an instance not provide
-                     the minimal required definitions, a warning will be
-                     emitted.
-               </para>
-
-                <para>
-                     See <xref linkend="minimal-pragma"/> for more details.
-               </para>
-           </listitem>
-       </itemizedlist>
-    </sect3>
-
-    <sect3>
-        <title>Compiler</title>
-        <itemizedlist>
-            <listitem>
-                <para>
-                    GHC can now build both static and dynamic object
-                    files at the same time in a single compilation
-                    pass, when given the
-                    <literal>-dynamic-too</literal> flag. This will
-                    produce both a statically-linkable
-                    <literal>.o</literal> object file, and a
-                    dynamically-linkable <literal>.dyn_o</literal>
-                    file. The output suffix of the dynamic objects can
-                    be controlled by the flag
-                    <literal>-dynosuf</literal>.
-               </para>
-
-                <para>
-                    Note that GHC still builds statically by default.
-               </para>
-           </listitem>
-            <listitem>
-                <para>
-                    GHC now supports a
-                    <literal>--show-options</literal> flag, which will
-                    dump all of the flags it supports to standard out.
-               </para>
-           </listitem>
-            <listitem>
-                <para>
-                    GHC now supports warning about overflow of integer
-                    literals, enabled by
-                    <literal>-fwarn-overflowed-literals</literal>. It
-                    is enabled by default.
-               </para>
-           </listitem>
-            <listitem>
-                <para>
-                    It's now possible to switch the system linker on Linux
-                    (between GNU gold and GNU ld) at runtime without problem.
-               </para>
-           </listitem>
-            <listitem>
-                <para>
-                    The <literal>-fwarn-dodgy-imports</literal> flag now warns
-                    in the case an <literal>import</literal> statement hides an
-                    entity which is not exported.
-               </para>
-           </listitem>
-            <listitem>
-                <para>
-                    The LLVM backend was overhauled and rewritten, and
-                    should hopefully be easier to maintain and work on
-                    in the future.
-               </para>
-           </listitem>
-            <listitem>
-                <para>
-                    GHC now detects annotation changes during
-                    recompilation, and correctly persists new
-                    annotations.
-               </para>
-           </listitem>
-            <listitem>
-                <para>
-                    There is a new set of primops for utilizing
-                    hardware-based prefetch instructions, to help
-                    guide the processor's caching decisions.
-               </para>
-                <para>
-                    Currently, these are only supported with the LLVM
-                    backend and x86/amd64 backends.
-               </para>
-           </listitem>
-       </itemizedlist>
-    </sect3>
-
-    <sect3>
-        <title>GHCi</title>
-        <itemizedlist>
-            <listitem>
-                    The monomorphism restriction is now turned off
-                    by default in GHCi.
-            </listitem>
-         
-            <listitem>
-                <para>
-                    GHCi now supports a <literal>prompt2</literal>
-                    setting, which allows you to customize the
-                    continuation prompt of multi-line input.
-
-                    For more information, see <xref linkend="ghci-commands"/>.
-               </para>
-           </listitem>
-           <listitem>
-                <para>
-                    The new <literal>:shows paths</literal> command
-                    shows the current working directory and the
-                    current search path for Haskell modules.
-               </para>
-           </listitem>
-
-           <listitem>
-                <para>
-                    On Linux, the static GHCi linker now supports weak symbols.
-               </para>
-           </listitem>
-
-            <listitem>
-                <para>
-                    The (static) GHCi linker now runs constructors for
-                    linked libraries. This means for example that C
-                    code using
-                    <literal>__attribute__((constructor))</literal>
-                    can now properly be loaded into GHCi.
-               </para>
-
-                <para>
-                    Note: destructors are not supported.
-               </para>
-           </listitem>
-       </itemizedlist>
-    </sect3>
-
-    <sect3>
-        <title>Template Haskell</title>
-        <itemizedlist>
-            <listitem>
-                <para>
-                    Template Haskell now supports Roles.
-               </para>
-           </listitem>
-            <listitem>
-                <para>
-                    Template Haskell now supports annotation pragmas.
-               </para>
-           </listitem>
-           <listitem>
-             <para>
-                    Typed Template Haskell expressions are now supported. See
-                    <xref linkend="template-haskell"/> for more details.
-             </para>
-           </listitem>
-           <listitem>
-             <para>
-                    Template Haskell declarations, types, patterns, and
-                    <emphasis>untyped</emphasis> expressions are no longer
-                    typechecked at all. This is a backwards-compatible change
-                    since it allows strictly more programs to be typed.
-             </para>
-           </listitem>
-       </itemizedlist>
-    </sect3>
-
-    <sect3>
-        <title>Runtime system</title>
-        <itemizedlist>
-            <listitem>
-                <para>
-                    The RTS linker can now unload object code at
-                    runtime (when using the GHC API
-                    <literal>ObjLink</literal> module.) Previously,
-                    GHC would not unload the old object file, causing
-                    a gradual memory leak as more objects were loaded
-                    over time.
-               </para>
-
-                <para>
-                    Note that this change in unloading behavior
-                    <emphasis>only</emphasis> affects statically
-                    linked binaries, and not dynamic ones.
-               </para>
-           </listitem>
-
-            <listitem>
-                <para>
-                    The performance of <literal>StablePtr</literal>s and
-                    <literal>StableName</literal>s has been improved.
-               </para>
-           </listitem>
-
-            <listitem>
-                <para>
-                    The default maximum stack size has
-                    increased. Previously, it defaulted to 8m
-                    (equivalent to passing <literal>+RTS
-                    -K8m</literal>. Now, GHC will use up-to 80% of the
-                    <emphasis>physical memory</emphasis> available at
-                    runtime.
-               </para>
-           </listitem>
-       </itemizedlist>
-    </sect3>
-
-    <sect3>
-        <title>Build system</title>
-        <itemizedlist>
-            <listitem>
-                <para>
-                    GHC >= 7.4 is now required for bootstrapping.
-               </para>
-           </listitem>
-            <listitem>
-                <para>
-                    GHC can now be built with Clang, and use Clang as
-                    the preprocessor for Haskell code. Only Clang
-                    version 3.4 (or Apple LLVM Clang 5.0) or beyond is
-                    reliably supported.
-               </para>
-
-                <para>
-                    Note that normally, GHC uses
-                    <literal>gcc</literal> as the preprocessor for
-                    Haskell code, which implements
-                    <literal>-traditional</literal> behavior. However,
-                    Clang is not 100% compatible with GCC's
-                    <literal>-traditional</literal> as it is rather
-                    implementation specified, and is more strict.
-               </para>
-
-                <para>
-                    As a result of this, when using Clang as the
-                    preprocessor, some programs which previously used
-                    <literal>-XCPP</literal> and the preprocessor will
-                    now fail to compile. Users who wish to retain the
-                    previous behavior are better off using cpphs.
-               </para>
-           </listitem>
-       </itemizedlist>
-    </sect3>
-  </sect2>
-
-  <sect2>
-    <title>Libraries</title>
-
-    <para>
-        There have been some changes that have effected multiple
-        libraries:
-    </para>
-
-     <itemizedlist>
-         <listitem>
-             <para>
-                 TODO FIXME
-            </para>
-        </listitem>
-    </itemizedlist>
-
-    <sect3>
-        <title>array</title>
-        <itemizedlist>
-            <listitem>
-                <para>
-                    Version number 0.5.0.0 (was 0.4.0.1)
-               </para>
-           </listitem>
-       </itemizedlist>
-    </sect3>
-
-    <sect3>
-        <title>base</title>
-        <itemizedlist>
-            <listitem>
-                <para>
-                    Version number 4.7.0.0 (was 4.6.0.1)
-               </para>
-           </listitem>
-            <listitem>
-                <para>
-                    The <literal>Control.Category</literal> module now has the
-                    <literal>PolyKinds</literal> extension enabled, meaning
-                    that instances of <literal>Category</literal> no longer
-                    need be of kind <literal>* -> * -> *</literal>.
-               </para>
-           </listitem>
-            <listitem>
-                <para>
-                    There are now <literal>Foldable</literal> and <literal>Traversable</literal>
-                    instances for <literal>Either a</literal>, <literal>Const r</literal>, and <literal>(,) a</literal>.
-               </para>
-           </listitem>
-            <listitem>
-                <para>
-                    There is now a <literal>Monoid</literal> instance for <literal>Const</literal>.
-               </para>
-           </listitem>
-             <listitem>
-                <para>
-                    There is now a <literal>Data</literal> instance for <literal>Data.Version</literal>.
-               </para>
-           </listitem>
-             <listitem>
-                <para>
-                    There are now <literal>Eq</literal>, <literal>Ord</literal>, <literal>Show</literal> and <literal>Read</literal> instances for <literal>ZipList</literal>.
-               </para>
-           </listitem>
-             <listitem>
-                <para>
-                    There are now <literal>Eq</literal>, <literal>Ord</literal>, <literal>Show</literal> and <literal>Read</literal> instances for <literal>Down</literal>.
-               </para>
-           </listitem>
-             <listitem>
-                <para>
-                    There are now <literal>Eq</literal>, <literal>Ord</literal>, <literal>Show</literal>, <literal>Read</literal> and <literal>Generic</literal> instances for types in GHC.Generics (<literal>U1</literal>, <literal>Par1</literal>, <literal>Rec1</literal>, <literal>K1</literal>, <literal>M1</literal>, <literal>(:+:)</literal>, <literal>(:*:)</literal>, <literal>(:.:)</literal>).
-               </para>
-           </listitem>
-            <listitem>
-                <para>
-                    A zero-width unboxed poly-kinded <literal>Proxy#</literal>
-                    was added to <literal>GHC.Prim</literal>. It can be used to make it so
-                    that there is no the operational overhead for passing around proxy
-                    arguments to model type application.
-               </para>
-           </listitem>
-             <listitem>
-                <para>
-                    <literal>Control.Concurrent.MVar</literal> has a new
-                    implementation of <literal>readMVar</literal>, which
-                    fixes a long-standing bug where
-                    <literal>readMVar</literal> is only atomic if there
-                    are no other threads running
-                    <literal>putMVar</literal>.
-                    <literal>readMVar</literal> now is atomic, and is
-                    guaranteed to return the value from the first
-                    <literal>putMVar</literal>.  There is also a new <literal>tryReadMVar</literal>
-                    which is a non-blocking version.
-               </para>
-           </listitem>
-            <listitem>
-                <para>
-                    There are now byte endian-swapping primitives
-                    available in <literal>Data.Word</literal>, which
-                    use optimized machine instructions when available.
-               </para>
-           </listitem>
-            <listitem>
-                <para>
-                    <literal>Data.Bool</literal> now exports
-                    <literal>bool :: a -> a -> Bool -> a</literal>, analogously
-                    to <literal>maybe</literal> and <literal>either</literal>
-                    in their respective modules.
-               </para>
-           </listitem>
-            <listitem>
-                <para>
-                     Rewrote portions of <literal>Text.Printf</literal>, and
-                     made changes to <literal>Numeric</literal> (added
-                     <literal>Numeric.showFFloatAlt</literal> and
-                     <literal>Numeric.showGFloatAlt</literal>) and
-                     <literal>GHC.Float</literal> (added
-                     <literal>formatRealFloatAlt</literal>) to support it.
-                     The rewritten version is extensible to user types, adds a
-                     "generic" format specifier "<literal>%v</literal>",
-                     extends the <literal>printf</literal> spec
-                     to support much of C's <literal>printf(3)</literal>
-                     functionality, and fixes the spurious warnings about
-                     using <literal>Text.Printf.printf</literal> at
-                     <literal>(IO a)</literal> while ignoring the return value.
-                     These changes were contributed by Bart Massey.
-               </para>
-           </listitem>
-            <listitem>
-                <para>
-                     The minimal complete definitions for all
-                     type-classes with cyclic default implementations
-                     have been explicitly annotated with the new
-                     <literal>{-# MINIMAL #-}</literal> pragma.
-               </para>
-           </listitem>
-            <listitem>
-                <para>
-                     <literal>Control.Applicative.WrappedMonad</literal>,
-                     which can be used to convert a <literal>Monad</literal>
-                     to an <literal>Applicative</literal>, has now
-                     a <literal>Monad m => Monad (WrappedMonad m)</literal>
-                     instance.
-               </para>
-           </listitem>
-       </itemizedlist>
-    </sect3>
-
-    <sect3>
-        <title>bin-package-db</title>
-        <itemizedlist>
-            <listitem>
-                <para>
-                    This is an internal package, and should not be used.
-               </para>
-           </listitem>
-       </itemizedlist>
-    </sect3>
-
-    <sect3>
-        <title>binary</title>
-        <itemizedlist>
-            <listitem>
-                <para>
-                    Version number 0.7.1.0 (was 0.5.1.1)
-               </para>
-           </listitem>
-       </itemizedlist>
-    </sect3>
-
-    <sect3>
-        <title>bytestring</title>
-        <itemizedlist>
-            <listitem>
-                <para>
-                    Version number 0.10.4.0 (was 0.10.0.0)
-               </para>
-           </listitem>
-       </itemizedlist>
-    </sect3>
-
-    <sect3>
-        <title>Cabal</title>
-        <itemizedlist>
-            <listitem>
-                <para>
-                    Version number 1.18.1.3 (was 1.16.0)
-              </para>
-          </listitem>
-      </itemizedlist>
-    </sect3>
-
-    <sect3>
-        <title>containers</title>
-        <itemizedlist>
-            <listitem>
-                <para>
-                    Version number 0.5.4.0 (was 0.5.0.0)
-               </para>
-           </listitem>
-       </itemizedlist>
-    </sect3>
-
-    <sect3>
-        <title>deepseq</title>
-        <itemizedlist>
-            <listitem>
-                <para>
-                    Version number 1.3.0.2 (was 1.3.0.1)
-               </para>
-           </listitem>
-       </itemizedlist>
-    </sect3>
-
-    <sect3>
-        <title>directory</title>
-        <itemizedlist>
-            <listitem>
-                <para>
-                    Version number 1.2.0.2 (was 1.2.0.1)
-               </para>
-           </listitem>
-            <listitem>
-                <para>
-                    The function <literal>findExecutables</literal>
-                    now correctly checks to see if the execute bit is
-                    set on Linux, rather than just looking in
-                    <literal>$PATH</literal>.
-               </para>
-           </listitem>
-            <listitem>
-                <para>
-                    There are several new functions for finding files,
-                    including <literal>findFiles</literal> and
-                    <literal>findFilesWith</literal>, which allow you
-                    to search for a file given a set of filepaths, and
-                    run a predicate over them.
-               </para>
-           </listitem>
-       </itemizedlist>
-    </sect3>
-
-    <sect3>
-        <title>filepath</title>
-        <itemizedlist>
-            <listitem>
-                <para>
-                    Version number 1.3.0.2 (was 1.3.0.1)
-               </para>
-           </listitem>
-       </itemizedlist>
-    </sect3>
-
-    <sect3>
-        <title>ghc-prim</title>
-        <itemizedlist>
-            <listitem>
-                <para>
-                    Version number 0.3.1.0 (was 0.3.0.0)
-               </para>
-           </listitem>
-            <listitem>
-                <para>
-                     The type-classes <literal>Eq</literal> and
-                     <literal>Ord</literal> have been annotated with
-                     the new <literal>{-# MINIMAL #-}</literal>
-                     pragma.
-               </para>
-           </listitem>
-            <listitem>
-                <para>
-                    There is a new type exposed by
-                    <literal>GHC.Types</literal>, called
-                    <literal>SPEC</literal>, which can be used to
-                    inform GHC to perform call-pattern specialisation
-                    extremely aggressively. See <xref
-                    linkend="options-optimise"/> for more details
-                    concerning <literal>-fspec-constr</literal>.
-               </para>
-           </listitem>
-       </itemizedlist>
-    </sect3>
-
-    <sect3>
-        <title>haskell98</title>
-        <itemizedlist>
-            <listitem>
-                <para>
-                    Version number 2.0.0.3 (was 2.0.0.2)
-               </para>
-           </listitem>
-       </itemizedlist>
-    </sect3>
-
-    <sect3>
-        <title>haskell2010</title>
-        <itemizedlist>
-            <listitem>
-                <para>
-                    Version number 1.1.1.1 (was 1.1.1.0)
-               </para>
-           </listitem>
-       </itemizedlist>
-    </sect3>
-
-    <sect3>
-        <title>hoopl</title>
-        <itemizedlist>
-            <listitem>
-                <para>
-                    Version number 3.10.0.0 (was 3.9.0.0)
-               </para>
-           </listitem>
-       </itemizedlist>
-    </sect3>
-
-    <sect3>
-        <title>hpc</title>
-        <itemizedlist>
-            <listitem>
-                <para>
-                    Version number 0.6.0.1 (was 0.6.0.0)
-               </para>
-           </listitem>
-       </itemizedlist>
-    </sect3>
-
-    <sect3>
-        <title>integer-gmp</title>
-        <itemizedlist>
-            <listitem>
-                <para>
-                    Version number 0.5.1.0 (was 0.5.0.0)
-               </para>
-           </listitem>
-       </itemizedlist>
-    </sect3>
-
-    <sect3>
-        <title>old-locale</title>
-        <itemizedlist>
-            <listitem>
-                <para>
-                    Version number 1.0.0.6 (was 1.0.0.5)
-               </para>
-           </listitem>
-       </itemizedlist>
-    </sect3>
-
-    <sect3>
-        <title>old-time</title>
-        <itemizedlist>
-            <listitem>
-                <para>
-                    Version number 1.1.0.2 (was 1.1.0.1)
-               </para>
-           </listitem>
-       </itemizedlist>
-    </sect3>
-
-    <sect3>
-        <title>process</title>
-        <itemizedlist>
-            <listitem>
-                <para>
-                    Version number 1.2.0.0 (was 1.1.0.2)
-               </para>
-           </listitem>
-            <listitem>
-                <para>
-                    Several bugs have been fixed, including deadlocks
-                    in <literal>readProcess</literal> and
-                    <literal>readProcessWithExitCode</literal>.
-               </para>
-           </listitem>
-       </itemizedlist>
-    </sect3>
-
-    <sect3>
-        <title>template-haskell</title>
-        <itemizedlist>
-            <listitem>
-                <para>
-                    Version number 2.9.0.0 (was 2.8.0.0)
-               </para>
-           </listitem>
-            <listitem>
-                <para>
-                    Typed Template Haskell expressions are now
-                    supported. See <xref linkend="template-haskell"/>
-                    for more details.
-               </para>
-           </listitem>
-            <listitem>
-                <para>
-                    There is now support for roles.
-               </para>
-           </listitem>
-            <listitem>
-                <para>
-                    There is now support for annotation pragmas.
-               </para>
-           </listitem>
-       </itemizedlist>
-    </sect3>
-
-    <sect3>
-        <title>time</title>
-        <itemizedlist>
-            <listitem>
-                <para>
-                    Version number 1.4.1 (was 1.4.1)
-               </para>
-           </listitem>
-       </itemizedlist>
-    </sect3>
-
-    <sect3>
-        <title>unix</title>
-        <itemizedlist>
-            <listitem>
-                <para>
-                    Version number 2.7.0.0 (was 2.6.0.0)
-               </para>
-           </listitem>
-            <listitem>
-                <para>
-                    A crash in <literal>getGroupEntryForID</literal>
-                    (and related functions like
-                    <literal>getUserEntryForID</literal> and
-                    <literal>getUserEntryForName</literal>) in
-                    multi-threaded applications has been fixed.
-               </para>
-           </listitem>
-            <listitem>
-                <para>
-                    The functions <literal>getGroupEntryForID</literal>
-                    and <literal>getUserEntryForID</literal> now fail
-                    with a <literal>isDoesNotExist</literal> error when
-                    the specified ID cannot be found.
-               </para>
-           </listitem>
-       </itemizedlist>
-    </sect3>
-
-    <sect3>
-        <title>Win32</title>
-        <itemizedlist>
-            <listitem>
-                <para>
-                    Version number 2.3.0.0 (was 2.3.0.0)
-               </para>
-           </listitem>
-       </itemizedlist>
-    </sect3>
-  </sect2>
-
-  <sect2>
-    <title>Known bugs</title>
-    <itemizedlist>
-        <listitem>
-            <para>
-                On OS X 10.7 and beyond, with default build settings,
-                the runtime system currently suffers from a fairly
-                large (30%) performance regression in the parallel
-                garbage collector when using
-                <literal>-threaded</literal> impacting its thoroughput
-                and overall scalability.
-           </para>
-            <para>
-                This is due to the fact that the OS X 10.7+ toolchain
-                does not (by default) support register variables, or a
-                fast <literal>__thread</literal> implementation. Note
-                that this can be worked around by building GHC using
-                GCC instead on OS X platforms, but the binary
-                distribution then requires GCC later.
-           </para>
-       </listitem>
-
-        <listitem>
-            <para>
-                On Windows, <literal>-dynamic-too</literal> is unsupported.
-           </para>
-       </listitem>
-
-        <listitem>
-            <para>
-                On Windows, we currently don't ship dynamic libraries
-                or use a dynamic GHCi, unlike Linux, FreeBSD or OS X.
-           </para>
-       </listitem>
-
-        <listitem>
-            <para>
-                On 64bit Windows, the static linker currently suffers
-                from some rather large bugs, which we hope to have
-                some fixes for soon.
-           </para>
-       </listitem>
-   </itemizedlist>
-  </sect2>
-</sect1>
diff --git a/docs/users_guide/codegens.xml b/docs/users_guide/codegens.xml
index f854e1137e36..d2a805a3ee04 100644
--- a/docs/users_guide/codegens.xml
+++ b/docs/users_guide/codegens.xml
@@ -38,25 +38,27 @@
        
     <para>You must install and have LLVM available on your PATH for the LLVM
       code generator to work. Specifically GHC needs to be able to call the
-      <command>opt</command>and <command>llc</command> tools.  Secondly, if you
+      <command>opt</command> and <command>llc</command> tools.  Secondly, if you
       are running Mac OS X with LLVM 3.0 or greater then
       you also need the <ulink url="http://clang.llvm.org">Clang c
-        compiler</ulink> compiler available on your PATH. Clang and LLVM are
-      both included with OS X by default from 10.6 onwards.
+        compiler</ulink> compiler available on your PATH.
     </para>
 
     <para>To install LLVM and Clang:
       <itemizedlist>
         <listitem><emphasis>Linux</emphasis>: Use your package management tool.
         </listitem>
-        <listitem><emphasis>Mac OS X</emphasis>: LLVM and Clang are included by
-          default from <literal>10.6</literal> and later. For
-          <literal>10.5</literal> you should install the
-          <ulink url="http://mxcl.github.com/homebrew/">Homebrew</ulink> package
-          manager for OS X. Alternatively you can download binaries for LLVM
-          and Clang from
-          <ulink url="http://llvm.org/releases/download.html">here</ulink>.
+        <listitem><emphasis>Mac OS X</emphasis>: Clang is included by
+        default on recent OS X machines when XCode is installed (from
+        <literal>10.6</literal> and later). LLVM is not included. In
+        order to use the LLVM based code generator, you should install
+        the <ulink
+        url="http://mxcl.github.com/homebrew/">Homebrew</ulink>
+        package manager for OS X. Alternatively you can download
+        binaries for LLVM and Clang from <ulink
+        url="http://llvm.org/releases/download.html">here</ulink>.
         </listitem>
+
         <listitem><emphasis>Windows</emphasis>: You should download binaries for
           LLVM and clang from
           <ulink url="http://llvm.org/releases/download.html">here</ulink>.
diff --git a/docs/users_guide/external_core.xml b/docs/users_guide/external_core.xml
deleted file mode 100644
index e4354410efa6..000000000000
--- a/docs/users_guide/external_core.xml
+++ /dev/null
@@ -1,1804 +0,0 @@
-<?xml version="1.0" encoding="utf-8"?>
-
-<!--
-This document is a semi-automatic conversion of docs/ext-core/core.tex to DocBook using
-
-1. `htlatex` to convert LaTeX to HTML
-2. `pandoc` to convert HTML to DocBook
-3. extensive manual work by James H. Fisher (jameshfisher@gmail.com)
--->
-
-<!--
-TODO:
-
-* Replace "java" programlisting with "ghccore"
-("ghccore" is not recognized by highlighters,
-causing some generators to fail).
-
-* Complete bibliography entries with journal titles;
-I am unsure of the proper DocBook elements.
-
-* Integrate this file with the rest of the Users' Guide.
--->
-
-
-<chapter id="an-external-representation-for-the-ghc-core-language-for-ghc-6.10">
-  <title>An External Representation for the GHC Core Language (For GHC 6.10)</title>
-
-  <para>Andrew Tolmach, Tim Chevalier ({apt,tjc}@cs.pdx.edu) and The GHC Team</para>
-
-    <para>This chapter provides a precise definition for the GHC Core
-    language, so that it can be used to communicate between GHC and new
-    stand-alone compilation tools such as back-ends or
-    optimizers.<footnote>
-    <para>This is a draft document, which attempts
-    to describe GHC’s current behavior as precisely as possible. Working
-    notes scattered throughout indicate areas where further work is
-    needed. Constructive comments are very welcome, both on the
-    presentation, and on ways in which GHC could be improved in order to
-    simplify the Core story.</para>
-
-    <para>Support for generating external Core (post-optimization) was
-    originally introduced in GHC 5.02. The definition of external Core in
-    this document reflects the version of external Core generated by the
-    HEAD (unstable) branch of GHC as of May 3, 2008 (version 6.9), using
-    the compiler flag <code>-fext-core</code>. We expect that GHC 6.10 will be
-    consistent with this definition.</para>
-  </footnote>
-  The definition includes a formal grammar and an informal semantics.
-  An executable typechecker and interpreter (in Haskell), which
-  formally embody the static and dynamic semantics, are available
-    separately.</para>
-
-  <section id="introduction">
-    <title>Introduction</title>
-
-    <para>The Glasgow Haskell Compiler (GHC) uses an intermediate language,
-    called <quote>Core,</quote> as its internal program representation within the
-    compiler’s simplification phase. Core resembles a subset of
-    Haskell, but with explicit type annotations in the style of the
-    polymorphic lambda calculus (F<subscript>ω</subscript>).</para>
-
-    <para>GHC’s front-end translates full Haskell 98 (plus some extensions)
-    into Core. The GHC optimizer then repeatedly transforms Core
-    programs while preserving their meaning. A <quote>Core Lint</quote> pass in GHC
-    typechecks Core in between transformation passes (at least when
-    the user enables linting by setting a compiler flag), verifying
-    that transformations preserve type-correctness. Finally, GHC’s
-    back-end translates Core into STG-machine code <citation>stg-machine</citation> and then into C
-    or native code.</para>
-
-    <para>Two existing papers discuss the original rationale for the design
-    and use of Core <citation>ghc-inliner,comp-by-trans-scp</citation>, although the (two different) idealized
-    versions of Core described therein differ in significant ways from
-    the actual Core language in current GHC. In particular, with the
-    advent of GHC support for generalized algebraic datatypes (GADTs)
-    <citation>gadts</citation> Core was extended beyond its previous
-    F<subscript>ω</subscript>-style incarnation to support type
-    equality constraints and safe coercions, and is now based on a
-    system known as F<subscript>C</subscript> <citation>system-fc</citation>.</para>
-
-    <para>Researchers interested in writing just <emphasis>part</emphasis> of a Haskell compiler,
-    such as a new back-end or a new optimizer pass, might like to use
-    GHC to provide the other parts of the compiler. For example, they
-    might like to use GHC’s front-end to parse, desugar, and
-    type-check source Haskell, then feeding the resulting code to
-    their own back-end tool. As another example, they might like to
-    use Core as the target language for a front-end compiler of their
-    own design, feeding externally synthesized Core into GHC in order
-    to take advantage of GHC’s optimizer, code generator, and run-time
-    system. Without external Core, there are two ways for compiler
-    writers to do this: they can link their code into the GHC
-    executable, which is an arduous process, or they can use the GHC
-    API <citation>ghc-api</citation> to do the same task more cleanly. Both ways require new
-    code to be written in Haskell.</para>
-
-    <para>We present a precisely specified external format for Core files.
-    The external format is text-based and human-readable, to promote
-    interoperability and ease of use. We hope this format will make it
-    easier for external developers to use GHC in a modular way.</para>
-
-    <para>It has long been true that GHC prints an ad-hoc textual
-    representation of Core if you set certain compiler flags. But this
-    representation is intended to be read by people who are debugging
-    the compiler, not by other programs. Making Core into a
-    machine-readable, bi-directional communication format requires:
-
-    <orderedlist>
-      <listitem>
-        precisely specifying the external format of Core;
-      </listitem>
-      <listitem>
-        modifying GHC to generate external Core files
-        (post-simplification; as always, users can control the exact
-        transformations GHC does with command-line flags);
-      </listitem>
-      <listitem>
-        modifying GHC to accept external Core files in place of
-        Haskell source files (users will also be able to control what
-        GHC does to those files with command-line flags).
-      </listitem>
-    </orderedlist>
-    </para>
-
-    <para>The first two facilities will let developers couple GHC’s
-    front-end (parser, type-checker, desugarer), and optionally its
-    optimizer, with new back-end tools. The last facility will let
-    developers write new Core-to-Core transformations as an external
-    tool and integrate them into GHC. It will also allow new
-    front-ends to generate Core that can be fed into GHC’s optimizer
-    or back-end.</para>
-
-    <para>However, because there are many (undocumented) idiosyncracies in
-    the way GHC produces Core from source Haskell, it will be hard for
-    an external tool to produce Core that can be integrated with
-    GHC-produced Core (e.g., for the Prelude), and we don’t aim to
-    support this. Indeed, for the time being, we aim to support only
-    the first two facilities and not the third: we define and
-    implement Core as an external format that GHC can use to
-    communicate with external back-end tools, and defer the larger
-    task of extending GHC to support reading this external format back
-    in.</para>
-
-    <para>This document addresses the first requirement, a formal Core
-    definition, by proposing a formal grammar for an
-    <link linkend="external-grammar-of-core">external representation of Core</link>,
-    and an <link linkend="informal-semantics">informal semantics</link>.</para>
-
-    <para>GHC supports many type system extensions; the External Core
-    printer built into GHC only supports some of them. However,
-    External Core should be capable of representing any Haskell 98
-    program, and may be able to represent programs that require
-    certain type system extensions as well. If a program uses
-    unsupported features, GHC may fail to compile it to Core when the
-    -fext-core flag is set, or GHC may successfully compile it to
-    Core, but the external tools will not be able to typecheck or
-    interpret it.</para>
-
-    <para>Formal static and dynamic semantics in the form of an executable
-    typechecker and interpreter are available separately in the GHC
-    source tree
-    <footnote><ulink url="http://git.haskell.org/ghc.git/tree">http://git.haskell.org/ghc.git</ulink></footnote>
-    under <code>utils/ext-core</code>.</para>
-
-  </section>
-  <section id="external-grammar-of-core">
-    <title>External Grammar of Core</title>
-
-    <para>In designing the external grammar, we have tried to strike a
-    balance among a number of competing goals, including easy
-    parseability by machines, easy readability by humans, and adequate
-    structural simplicity to allow straightforward presentations of
-    the semantics. Thus, we had to make some compromises.
-    Specifically:</para>
-
-    <itemizedlist>
-      <listitem>In order to avoid explosion of parentheses, we support
-      standard precedences and short-cuts for expressions, types,
-      and kinds. Thus we had to introduce multiple non-terminals for
-      each of these syntactic categories, and as a result, the
-      concrete grammar is longer and more complex than the
-      underlying abstract syntax.</listitem>
-
-      <listitem>On the other hand, we have kept the grammar simpler by
-      avoiding special syntax for tuple types and terms. Tuples
-      (both boxed and unboxed) are treated as ordinary constructors.</listitem>
-
-      <listitem>All type abstractions and applications are given in full, even
-      though some of them (e.g., for tuples) could be reconstructed;
-      this means a parser for Core does not have to reconstruct
-      types.<footnote>
-      These choices are certainly debatable. In
-      particular, keeping type applications on tuples and case arms
-      considerably increases the size of Core files and makes them less
-      human-readable, though it allows a Core parser to be simpler.
-      </footnote></listitem>
-
-      <listitem>The syntax of identifiers is heavily restricted (to just
-      alphanumerics and underscores); this again makes Core easier
-      to parse but harder to read.</listitem>
-    </itemizedlist>
-
-    <para>We use the following notational conventions for syntax:
-
-    <informaltable frame="none">
-      <tgroup cols='2' align='left' colsep="0" rowsep="0">
-        <tbody>
-          <row>
-            <entry>[ pat ]</entry>
-            <entry>optional</entry>
-          </row>
-
-          <row>
-            <entry>{ pat }</entry>
-            <entry>zero or more repetitions</entry>
-          </row>
-
-          <row>
-            <entry>
-              { pat }<superscript>+</superscript>
-            </entry>
-            <entry>one or more repetitions</entry>
-          </row>
-
-          <row>
-            <entry>
-              pat<subscript>1</subscript> ∣ pat<subscript>2</subscript>
-            </entry>
-            <entry>choice</entry>
-          </row>
-
-          <row>
-            <entry>
-              <code>fibonacci</code>
-            </entry>
-            <entry>terminal syntax in typewriter font</entry>
-          </row>
-        </tbody>
-      </tgroup>
-    </informaltable>
-    </para>
-
-    <informaltable frame="none" colsep="0" rowsep="0">
-      <tgroup cols='5'>
-        <colspec colname="cat"  align="left"   colwidth="3*"  />
-        <colspec colname="lhs"  align="right"  colwidth="2*"  />
-        <colspec                align="center" colwidth="*"   />
-        <colspec colname="rhs"  align="left"   colwidth="10*" />
-        <colspec colname="name" align="right"  colwidth="6*"  />
-        <tbody>
-          <row rowsep="1">
-            <entry>Module</entry>
-            <entry>module</entry>
-            <entry>→</entry>
-            <entry>
-              <code>%module</code> mident { tdef ; }{ vdefg ; }
-            </entry>
-            <entry></entry>
-          </row>
-
-          <row>
-            <entry morerows="1" valign="top">Type defn.</entry>
-            <entry morerows="1" valign="top">tdef</entry>
-            <entry>→</entry>
-            <entry>
-              <code>%data</code> qtycon { tbind } <code>= {</code>  [ cdef {<code>;</code> cdef } ] <code>}</code>
-            </entry>
-            <entry>algebraic type</entry>
-          </row>
-          <row rowsep="1">
-            <entry>∣</entry>
-            <entry>
-              <code>%newtype</code> qtycon qtycon { tbind } <code>=</code> ty
-            </entry>
-            <entry>newtype</entry>
-          </row>
-
-          <row rowsep="1">
-            <entry>Constr. defn.</entry>
-            <entry>cdef</entry>
-            <entry>→</entry>
-            <entry>
-              qdcon { <code>@</code> tbind }{ aty }<superscript>+</superscript>
-            </entry>
-          </row>
-
-          <row>
-            <entry morerows="2" valign="top">Value defn.</entry>
-            <entry morerows="1" valign="top">vdefg</entry>
-            <entry>→</entry>
-            <entry><code>%rec {</code> vdef { <code>;</code> vdef } <code>}</code></entry>
-            <entry>recursive</entry>
-          </row>
-
-          <row>
-            <entry>∣</entry>
-            <entry>vdef</entry>
-            <entry>non-recursive</entry>
-          </row>
-
-          <row rowsep="1">
-            <entry>vdef</entry>
-            <entry>→</entry>
-            <entry>qvar <code>::</code> ty <code>=</code> exp</entry>
-            <entry></entry>
-          </row>
-
-          <row>
-            <entry morerows="3" valign="top">Atomic expr.</entry>
-            <entry morerows="3" valign="top">aexp</entry>
-            <entry>→</entry>
-            <entry>qvar</entry>
-            <entry>variable</entry>
-          </row>
-
-          <row>
-            <entry>∣</entry>
-            <entry>qdcon</entry>
-            <entry>data constructor</entry>
-          </row>
-
-          <row>
-            <entry>∣</entry>
-            <entry>lit</entry>
-            <entry>literal</entry>
-          </row>
-
-          <row rowsep="1">
-            <entry>∣</entry>
-            <entry><code>(</code> exp <code>)</code></entry>
-            <entry>nested expr.</entry>
-          </row>
-
-          <row>
-            <entry morerows="9" valign="top">Expression</entry>
-            <entry morerows="9" valign="top">exp</entry>
-            <entry>→</entry>
-            <entry>aexp</entry>
-            <entry>atomic expresion</entry>
-          </row>
-
-          <row>
-            <entry>∣</entry>
-            <entry>aexp { arg }<superscript>+</superscript></entry>
-            <entry>application</entry>
-          </row>
-
-          <row>
-            <entry>∣</entry>
-            <entry><code>\</code> { binder }<superscript>+</superscript> &arw; exp</entry>
-            <entry>abstraction</entry>
-          </row>
-
-          <row>
-            <entry>∣</entry>
-            <entry><code>%let</code> vdefg <code>%in</code> exp</entry>
-            <entry>local definition</entry>
-          </row>
-
-          <row>
-            <entry>∣</entry>
-            <entry><code>%case (</code> aty <code>)</code> exp <code>%of</code> vbind <code>{</code> alt { <code>;</code> alt } <code>}</code></entry>
-            <entry>case expression</entry>
-          </row>
-
-          <row>
-            <entry>∣</entry>
-            <entry><code>%cast</code> exp aty</entry>
-            <entry>type coercion</entry>
-          </row>
-
-          <row>
-            <entry>∣</entry>
-            <entry><code>%note</code> &quot; { char } &quot; exp</entry>
-            <entry>expression note</entry>
-          </row>
-
-          <row>
-            <entry>∣</entry>
-            <entry><code>%external ccall &quot;</code> { char } <code>&quot;</code> aty</entry>
-            <entry>external reference</entry>
-          </row>
-
-          <row>
-            <entry>∣</entry>
-            <entry><code>%dynexternal ccall</code> aty</entry>
-            <entry>external reference (dynamic)</entry>
-          </row>
-
-          <row rowsep="1">
-            <entry>∣</entry>
-            <entry><code>%label &quot;</code> { char } <code>&quot;</code></entry>
-            <entry>external label</entry>
-          </row>
-
-          <row>
-            <entry morerows="1" valign="top">Argument</entry>
-            <entry morerows="1" valign="top">arg</entry>
-            <entry>→</entry>
-            <entry><code>@</code> aty</entry>
-            <entry>type argument</entry>
-          </row>
-
-          <row rowsep="1">
-            <entry>∣</entry>
-            <entry>aexp</entry>
-            <entry>value argument</entry>
-          </row>
-
-          <row>
-            <entry morerows="2" valign="top">Case alt.</entry>
-            <entry morerows="2" valign="top">alt</entry>
-            <entry>→</entry>
-            <entry>qdcon { <code>@</code> tbind }{ vbind } <code>&arw;</code> exp</entry>
-            <entry>constructor alternative</entry>
-          </row>
-
-          <row>
-            <entry>∣</entry>
-            <entry>lit <code>&arw;</code> exp</entry>
-            <entry>literal alternative</entry>
-          </row>
-
-          <row rowsep="1">
-            <entry>∣</entry>
-            <entry><code>%_ &arw;</code> exp</entry>
-            <entry>default alternative</entry>
-          </row>
-
-          <row>
-            <entry morerows="1" valign="top">Binder</entry>
-            <entry morerows="1" valign="top">binder</entry>
-            <entry>→</entry>
-            <entry><code>@</code> tbind</entry>
-            <entry>type binder</entry>
-          </row>
-
-          <row rowsep="1">
-            <entry>∣</entry>
-            <entry>vbind</entry>
-            <entry>value binder</entry>
-          </row>
-
-          <row>
-            <entry morerows="1" valign="top">Type binder</entry>
-            <entry morerows="1" valign="top">tbind</entry>
-            <entry>→</entry>
-            <entry>tyvar</entry>
-            <entry>implicitly of kind *</entry>
-          </row>
-
-          <row rowsep="1">
-            <entry>∣</entry>
-            <entry><code>(</code> tyvar <code>::</code> kind <code>)</code></entry>
-            <entry>explicitly kinded</entry>
-          </row>
-
-          <row rowsep="1">
-            <entry>Value binder</entry>
-            <entry>vbind</entry>
-            <entry>→</entry>
-            <entry><code>(</code> var <code>::</code> ty <code>)</code></entry>
-            <entry></entry>
-          </row>
-
-          <row>
-            <entry morerows="3" valign="top">Literal</entry>
-            <entry morerows="3" valign="top">lit</entry>
-            <entry>→</entry>
-            <entry><code>(</code> [<code>-</code>] { digit }<superscript>+</superscript> <code>::</code> ty <code>)</code></entry>
-            <entry>integer</entry>
-          </row>
-
-          <row>
-            <entry>∣</entry>
-            <entry><code>(</code> [<code>-</code>] { digit }<superscript>+</superscript> <code>%</code> { digit }<superscript>+</superscript> <code>::</code> ty <code>)</code></entry>
-            <entry>rational</entry>
-          </row>
-
-          <row>
-            <entry>∣</entry>
-            <entry><code>( '</code> char <code>' ::</code> ty <code>)</code></entry>
-            <entry>character</entry>
-          </row>
-
-          <row rowsep="1">
-            <entry>∣</entry>
-            <entry><code>( &quot;</code> { char } <code>&quot; ::</code> ty <code>)</code></entry>
-            <entry>string</entry>
-          </row>
-
-          <row>
-            <entry morerows="2" valign="top">Character</entry>
-            <entry morerows="1" valign="top">char</entry>
-            <entry>→</entry>
-            <entry namest="rhs" nameend="name"><emphasis>any ASCII character in range 0x20-0x7E except 0x22,0x27,0x5c</emphasis></entry>
-          </row>
-
-          <row>
-            <entry>∣</entry>
-            <entry><code>\x</code> hex hex</entry>
-            <entry>ASCII code escape sequence</entry>
-          </row>
-
-          <row rowsep="1">
-            <entry>hex</entry>
-            <entry>→</entry>
-            <entry>0∣…∣9 ∣a ∣…∣f</entry>
-            <entry></entry>
-          </row>
-
-          <row>
-            <entry morerows="2" valign="top">Atomic type</entry>
-            <entry morerows="2" valign="top">aty</entry>
-            <entry>→</entry>
-            <entry>tyvar</entry>
-            <entry>type variable</entry>
-          </row>
-
-          <row>
-            <entry>∣</entry>
-            <entry>qtycon</entry>
-            <entry>type constructor</entry>
-          </row>
-
-          <row rowsep="1">
-            <entry>∣</entry>
-            <entry><code>(</code> ty <code>)</code></entry>
-            <entry>nested type</entry>
-          </row>
-
-          <row>
-            <entry morerows="7" valign="top">Basic type</entry>
-            <entry morerows="7" valign="top">bty</entry>
-            <entry>→</entry>
-            <entry>aty</entry>
-            <entry>atomic type</entry>
-          </row>
-
-          <row>
-            <entry>∣</entry>
-            <entry>bty aty</entry>
-            <entry>type application</entry>
-          </row>
-
-          <row>
-            <entry>∣</entry>
-            <entry><code>%trans</code> aty aty</entry>
-            <entry>transitive coercion</entry>
-          </row>
-
-          <row>
-            <entry>∣</entry>
-            <entry><code>%sym</code> aty</entry>
-            <entry>symmetric coercion</entry>
-          </row>
-
-          <row>
-            <entry>∣</entry>
-            <entry><code>%unsafe</code> aty aty</entry>
-            <entry>unsafe coercion</entry>
-          </row>
-
-          <row>
-            <entry>∣</entry>
-            <entry><code>%left</code> aty</entry>
-            <entry>left coercion</entry>
-          </row>
-
-          <row>
-            <entry>∣</entry>
-            <entry><code>%right</code> aty</entry>
-            <entry>right coercion</entry>
-          </row>
-
-          <row rowsep="1">
-            <entry>∣</entry>
-            <entry><code>%inst</code> aty aty</entry>
-            <entry>instantiation coercion</entry>
-          </row>
-
-          <row>
-            <entry morerows="2" valign="top">Type</entry>
-            <entry morerows="2" valign="top">ty</entry>
-            <entry>→</entry>
-            <entry>bty</entry>
-            <entry>basic type</entry>
-          </row>
-
-          <row>
-            <entry>∣</entry>
-            <entry><code>%forall</code> { tbind }<superscript>+</superscript> <code>.</code> ty</entry>
-            <entry>type abstraction</entry>
-          </row>
-
-          <row rowsep="1">
-            <entry>∣</entry>
-            <entry>bty <code>&arw;</code> ty</entry>
-            <entry>arrow type construction</entry>
-          </row>
-
-          <row>
-            <entry morerows="4" valign="top">Atomic kind</entry>
-            <entry morerows="4" valign="top">akind</entry>
-            <entry>→</entry>
-            <entry><code>*</code></entry>
-            <entry>lifted kind</entry>
-          </row>
-
-          <row>
-            <entry>∣</entry>
-            <entry><code>#</code></entry>
-            <entry>unlifted kind</entry>
-          </row>
-
-          <row>
-            <entry>∣</entry>
-            <entry><code>?</code></entry>
-            <entry>open kind</entry>
-          </row>
-
-          <row>
-            <entry>∣</entry>
-            <entry>bty <code>:=:</code> bty</entry>
-            <entry>equality kind</entry>
-          </row>
-
-          <row rowsep="1">
-            <entry>∣</entry>
-            <entry><code>(</code> kind <code>)</code></entry>
-            <entry>nested kind</entry>
-          </row>
-
-          <row>
-            <entry morerows="1" valign="top">Kind</entry>
-            <entry morerows="1" valign="top">kind</entry>
-            <entry>→</entry>
-            <entry>akind</entry>
-            <entry>atomic kind</entry>
-          </row>
-
-          <row rowsep="1">
-            <entry>∣</entry>
-            <entry>akind <code>&arw;</code> kind</entry>
-            <entry>arrow kind</entry>
-          </row>
-
-          <row>
-            <entry morerows="7" valign="top">Identifier</entry>
-            <entry>mident</entry>
-            <entry>→</entry>
-            <entry>pname <code>:</code> uname</entry>
-            <entry>module</entry>
-          </row>
-
-          <row>
-            <entry>tycon</entry>
-            <entry>→</entry>
-            <entry>uname</entry>
-            <entry>type constr.</entry>
-          </row>
-
-          <row>
-            <entry>qtycon</entry>
-            <entry>→</entry>
-            <entry>mident <code>.</code> tycon</entry>
-            <entry>qualified type constr.</entry>
-          </row>
-
-          <row>   
-            <entry>tyvar</entry>
-            <entry>→</entry>
-            <entry>lname</entry>
-            <entry>type variable</entry>
-          </row>
-
-          <row>
-            <entry>dcon</entry>
-            <entry>→</entry>
-            <entry>uname</entry>
-            <entry>data constr.</entry>
-          </row>
-
-          <row>
-            <entry>qdcon</entry>
-            <entry>→</entry>
-            <entry>mident <code>.</code> dcon</entry>
-            <entry>qualified data constr.</entry>
-          </row>
-
-          <row>
-            <entry>var</entry>
-            <entry>→</entry>
-            <entry>lname</entry>
-            <entry>variable</entry>
-          </row>
-
-          <row rowsep="1">
-            <entry>qvar</entry>
-            <entry>→</entry>
-            <entry>[ mident <code>.</code> ] var</entry>
-            <entry>optionally qualified variable</entry>
-          </row>
-
-          <row>
-            <entry morerows="6" valign="top">Name</entry>
-            <entry>lname</entry>
-            <entry>→</entry>
-            <entry>lower { namechar }</entry>
-            <entry></entry>
-          </row>
-
-          <row>
-            <entry>uname</entry>
-            <entry>→</entry>
-            <entry>upper { namechar }</entry>
-            <entry></entry>
-          </row>
-
-          <row>
-            <entry>pname</entry>
-            <entry>→</entry>
-            <entry>{ namechar }<superscript>+</superscript></entry>
-            <entry></entry>
-          </row>
-
-          <row>
-            <entry>namechar</entry>
-            <entry>→</entry>
-            <entry>lower ∣ upper ∣ digit</entry>
-            <entry></entry>
-          </row>
-
-          <row>
-            <entry>lower</entry>
-            <entry>→</entry>
-            <entry><code>a</code> ∣ <code>b</code> ∣ … ∣ <code>z</code> ∣ <code>_</code></entry>
-            <entry></entry>
-          </row>
-
-          <row>
-            <entry>upper</entry>
-            <entry>→</entry>
-            <entry><code>A</code> ∣ <code>B</code> ∣ … ∣ <code>Z</code></entry>
-            <entry></entry>
-          </row>
-
-          <row>
-            <entry>digit</entry>
-            <entry>→</entry>
-            <entry><code>0</code> ∣ <code>1</code> ∣ … ∣ <code>9</code></entry>
-            <entry></entry>
-          </row>
-        </tbody>
-      </tgroup>
-    </informaltable>
-  </section>
-
-  <section id="informal-semantics">
-    <title>Informal Semantics</title>
-
-    <para>At the term level, Core resembles a explicitly-typed polymorphic
-    lambda calculus (F<subscript>ω</subscript>), with the addition of
-    local <code>let</code> bindings, algebraic type definitions, constructors, and
-    <code>case</code> expressions, and primitive types, literals and operators. Its
-    type system is richer than that of System F, supporting explicit
-    type equality coercions and type functions.<citation>system-fc</citation></para>
-
-    <para>In this section we concentrate on the less obvious points about
-    Core.</para>
-
-    <section id="program-organization-and-modules">
-      <title>Program Organization and Modules</title>
-
-      <para>Core programs are organized into <emphasis>modules</emphasis>, corresponding directly
-      to source-level Haskell modules. Each module has a identifying
-      name <emphasis>mident</emphasis>. A module identifier consists of a <emphasis>package name</emphasis>
-      followed by a module name, which may be hierarchical: for
-      example, <code>base:GHC.Base</code> is the module identifier for GHC’s Base
-      module. Its name is <code>Base</code>, and it lives in the GHC hierarchy
-      within the <code>base</code> package. Section 5.8 of the GHC users’ guide
-      explains package names <citation>ghc-user-guide</citation>. In particular, note that a Core
-      program may contain multiple modules with the same (possibly
-      hierarchical) module name that differ in their package names. In
-      some of the code examples that follow, we will omit package
-      names and possibly full hierarchical module names from
-      identifiers for brevity, but be aware that they are always
-      required.<footnote>
-      A possible improvement to the Core syntax
-      would be to add explicit import lists to Core modules, which could be
-      used to specify abbrevations for long qualified names. This would make
-      the code more human-readable.
-      </footnote></para>
-
-      <para>Each module may contain the following kinds of top-level
-      declarations:
-
-      <itemizedlist>
-        <listitem>
-          Algebraic data type declarations, each defining a type
-          constructor and one or more data constructors;
-        </listitem>
-        <listitem>
-          Newtype declarations, corresponding to Haskell <code>newtype</code>
-          declarations, each defining a type constructor and a
-          coercion name; and
-        </listitem>
-        <listitem>
-          Value declarations, defining the types and values of
-          top-level variables.
-        </listitem>
-      </itemizedlist>
-      </para>
-
-      <para>No type constructor, data constructor, or top-level value may be
-      declared more than once within a given module. All the type
-      declarations are (potentially) mutually recursive. Value
-      declarations must be in dependency order, with explicit grouping
-      of potentially mutually recursive declarations.</para>
-
-      <para>Identifiers defined in top-level declarations may be <emphasis>external</emphasis> or
-      <emphasis>internal</emphasis>. External identifiers can be referenced from any other
-      module in the program, using conventional dot notation (e.g.,
-      <code>base:GHC.Base.Bool</code>, <code>base:GHC.Base.True</code>). Internal identifiers
-      are visible only within the defining module. All type and data
-      constructors are external, and are always defined and referenced
-      using fully qualified names (with dots).</para>
-
-      <para>A top-level value is external if it is defined and referenced
-      using a fully qualified name with a dot (e.g., <code>main:MyModule.foo = ...</code>);
-      otherwise, it is internal (e.g., <code>bar = ...</code>). Note that
-      Core’s notion of an external identifier does not necessarily
-      coincide with that of <quote>exported</quote> identifier in a Haskell source
-      module. An identifier can be an external identifier in Core, but
-      not be exported by the original Haskell source
-      module.<footnote>
-      Two examples of such identifiers are: data
-      constructors, and values that potentially appear in an unfolding. For an
-      example of the latter, consider <code>Main.foo = ... Main.bar ...</code>, where
-      <code>Main.foo</code> is inlineable. Since <code>bar</code> appears in <code>foo</code>’s unfolding, it is
-      defined and referenced with an external name, even if <code>bar</code> was not
-      exported by the original source module.
-    </footnote>
-    However, if an identifier was exported by the Haskell source
-      module, it will appear as an external name in Core.</para>
-
-      <para>Core modules have no explicit import or export lists. Modules
-      may be mutually recursive. Note that because of the latter fact,
-      GHC currently prints out the top-level bindings for every module
-      as a single recursive group, in order to avoid keeping track of
-      dependencies between top-level values within a module. An
-      external Core tool could reconstruct dependencies later, of
-      course.</para>
-
-      <para>There is also an implicitly-defined module <code>ghc-prim:GHC.Prim</code>,
-      which exports the <quote>built-in</quote> types and values that must be
-      provided by any implementation of Core (including GHC). Details
-      of this module are in the <link linkend="primitive-module">Primitive Module section</link>.</para>
-
-      <para>A Core <emphasis>program</emphasis> is a collection of distinctly-named modules that
-      includes a module called main:Main having an exported value
-      called <code>main:ZCMain.main</code> of type <code>base:GHC.IOBase.IO a</code> (for some
-      type <code>a</code>). (Note that the strangely named wrapper for <code>main</code> is the
-      one exception to the rule that qualified names defined within a
-      module <code>m</code> must have module name <code>m</code>.)</para>
-
-      <para>Many Core programs will contain library modules, such as
-      <code>base:GHC.Base</code>, which implement parts of the Haskell standard
-      library. In principle, these modules are ordinary Haskell
-      modules, with no special status. In practice, the requirement on
-      the type of <code>main:Main.main</code> implies that every program will
-      contain a large subset of the standard library modules.</para>
-
-    </section>
-    <section id="namespaces">
-      <title>Namespaces</title>
-
-      <para>There are five distinct namespaces:
-      <orderedlist>
-        <listitem>module identifiers (<code>mident</code>),</listitem>
-        <listitem>type constructors  (<code>tycon</code>),</listitem>
-        <listitem>type variables     (<code>tyvar</code>),</listitem>
-        <listitem>data constructors  (<code>dcon</code>),</listitem>
-        <listitem>term variables     (<code>var</code>).</listitem>
-      </orderedlist>
-      </para>
-
-      <para>Spaces (1), (2+3), and (4+5) can be distinguished from each
-      other by context. To distinguish (2) from (3) and (4) from (5),
-      we require that data and type constructors begin with an
-      upper-case character, and that term and type variables begin
-      with a lower-case character.</para>
-
-      <para>Primitive types and operators are not syntactically
-      distinguished.</para>
-
-      <para>Primitive <emphasis>coercion</emphasis> operators, of which there are six, <emphasis>are</emphasis>
-      syntactically distinguished in the grammar. This is because
-      these coercions must be fully applied, and because
-      distinguishing their applications in the syntax makes
-      typechecking easier.</para>
-
-      <para>A given variable (type or term) may have multiple definitions
-      within a module. However, definitions of term variables never
-      <quote>shadow</quote> one another: the scope of the definition of a given
-      variable never contains a redefinition of the same variable.
-      Type variables may be shadowed. Thus, if a term variable has
-      multiple definitions within a module, all those definitions must
-      be local (let-bound). The only exception to this rule is that
-      (necessarily closed) types labelling <code>%external</code> expressions may
-      contain <code>tyvar</code> bindings that shadow outer bindings.</para>
-
-      <para>Core generated by GHC makes heavy use of encoded names, in which
-      the characters <code>Z</code> and <code>z</code> are used to introduce escape sequences
-      for non-alphabetic characters such as dollar sign <code>$</code> (<code>zd</code>), hash <code>#</code>
-      (<code>zh</code>), plus <code>+</code> (<code>zp</code>), etc. This is the same encoding used in <code>.hi</code>
-      files and in the back-end of GHC itself, except that we
-      sometimes change an initial <code>z</code> to <code>Z</code>, or vice-versa, in order to
-      maintain case distinctions.</para>
-
-      <para>Finally, note that hierarchical module names are z-encoded in
-      Core: for example, <code>base:GHC.Base.foo</code> is rendered as
-      <code>base:GHCziBase.foo</code>. A parser may reconstruct the module
-      hierarchy, or regard <code>GHCziBase</code> as a flat name.</para>
-
-    </section>
-    <section id="types-and-kinds">
-      <title>Types and Kinds</title>
-
-      <para>In Core, all type abstractions and applications are explicit.
-      This make it easy to typecheck any (closed) fragment of Core
-      code. An full executable typechecker is available separately.</para>
-
-      <section id="types">
-        <title>Types</title>
-
-        <para>Types are described by type expressions, which are built from
-        named type constructors and type variables using type
-        application and universal quantification. Each type
-        constructor has a fixed arity ≥ 0. Because it is so widely
-        used, there is special infix syntax for the fully-applied
-        function type constructor (<code>&arw;</code>). (The prefix identifier for
-        this constructor is <code>ghc-prim:GHC.Prim.ZLzmzgZR</code>; this should
-        only appear in unapplied or partially applied form.)</para>
-
-        <para>There are also a number of other primitive type constructors
-        (e.g., <code>Intzh</code>) that are predefined in the <code>GHC.Prim</code> module, but
-        have no special syntax. <code>%data</code> and <code>%newtype</code> declarations
-        introduce additional type constructors, as described below.
-        Type constructors are distinguished solely by name.</para>
-
-      </section>
-      <section id="coercions">
-        <title>Coercions</title>
-
-        <para>A type may also be built using one of the primitive coercion
-        operators, as described in <link linkend="namespaces">the Namespaces section</link>. For details on the
-        meanings of these operators, see the System FC paper <citation>system-fc</citation>. Also
-        see <link linkend="newtypes">the Newtypes section</link> for
-        examples of how GHC uses coercions in Core code.</para>
-
-      </section>
-      <section id="kinds">
-        <title>Kinds</title>
-        <para>As described in the Haskell definition, it is necessary to
-        distinguish well-formed type-expressions by classifying them
-        into different <emphasis>kinds</emphasis> <citation>haskell98, p. 41</citation><!-- TODO -->. In particular, Core
-        explicitly records the kind of every bound type variable.</para>
-
-        <para>In addition, Core’s kind system includes equality kinds, as in
-        System FC <citation>system-fc</citation>. An application of a built-in coercion, or of a
-        user-defined coercion as introduced by a <code>newtype</code> declaration,
-        has an equality kind.</para>
-
-      </section>
-      <section id="lifted-and-unlifted-types">
-        <title>Lifted and Unlifted Types</title>
-
-        <para>Semantically, a type is <emphasis>lifted</emphasis> if and only if it has bottom as
-        an element. We need to distinguish them because operationally,
-        terms with lifted types may be represented by closures; terms
-        with unlifted types must not be represented by closures, which
-        implies that any unboxed value is necessarily unlifted. We
-        distinguish between lifted and unlifted types by ascribing
-        them different kinds.</para>
-
-        <para>Currently, all the primitive types are unlifted (including a
-        few boxed primitive types such as <code>ByteArrayzh</code>). Peyton-Jones
-        and Launchbury <citation>pj:unboxed</citation> described the ideas behind unboxed and
-        unlifted types.</para>
-
-      </section>
-      <section id="type-constructors-base-kinds-and-higher-kinds">
-        <title>Type Constructors; Base Kinds and Higher Kinds</title>
-
-        <para>Every type constructor has a kind, depending on its arity and
-        whether it or its arguments are lifted.</para>
-
-        <para>Term variables can only be assigned types that have base
-        kinds: the base kinds are <code>*</code>, <code>#</code>, and <code>?</code>. The three base kinds
-        distinguish the liftedness of the types they classify: <code>*</code>
-        represents lifted types; <code>#</code> represents unlifted types; and <code>?</code> is
-        the <quote>open</quote> kind, representing a type that may be either lifted
-        or unlifted. Of these, only <code>*</code> ever appears in Core type
-        declarations generated from user code; the other two are
-        needed to describe certain types in primitive (or otherwise
-        specially-generated) code (which, after optimization, could
-        potentially appear anywhere).</para>
-
-        <para>In particular, no top-level identifier (except in
-        <code>ghc-prim:GHC.Prim</code>) has a type of kind <code>#</code> or <code>?</code>.</para>
-
-        <para>Nullary type constructors have base kinds: for example, the
-        type <code>Int</code> has kind <code>*</code>, and <code>Int#</code> has kind <code>#</code>.</para>
-
-        <para>Non-nullary type constructors have higher kinds: kinds that
-        have the form
-        k<subscript>1</subscript><code>&arw;</code>k<subscript>2</subscript>, where
-        k<subscript>1</subscript> and k<subscript>2</subscript> are
-        kinds. For example, the function type constructor <code>&arw;</code> has
-        kind <code>* &arw; (* &arw; *)</code>. Since Haskell allows abstracting
-        over type constructors, type variables may have higher kinds;
-        however, much more commonly they have kind <code>*</code>, so that is the
-        default if a type binder omits a kind.</para>
-
-      </section>
-
-      <section id="type-synonyms-and-type-equivalence">
-        <title>Type Synonyms and Type Equivalence</title>
-
-        <para>There is no mechanism for defining type synonyms
-        (corresponding to Haskell <code>type</code> declarations).</para>
-
-        <para>Type equivalence is just syntactic equivalence on type
-        expressions (of base kinds) modulo:</para>
-
-        <itemizedlist>
-          <listitem>alpha-renaming of variables bound in <code>%forall</code> types;</listitem>
-          <listitem>the identity a <code>&arw;</code> b ≡ <code>ghc-prim:GHC.Prim.ZLzmzgZR</code> a b</listitem>
-        </itemizedlist>
-        
-      </section>
-    </section>
-    <section id="algebraic-data-types">
-      <title>Algebraic data types</title>
-
-      <para>Each data declaration introduces a new type constructor and a
-      set of one or more data constructors, normally corresponding
-      directly to a source Haskell <code>data</code> declaration. For example, the
-      source declaration
-      
-      <programlisting language="haskell">
-data Bintree a =
-    Fork (Bintree a) (Bintree a)
-  | Leaf a
-      </programlisting>
-
-      might induce the following Core declaration
-      
-      <programlisting language="java">
-%data Bintree a = {
-  Fork (Bintree a) (Bintree a);
-  Leaf a)}
-      </programlisting>
-
-      which introduces the unary type constructor Bintree of kind
-      <code>*&arw;*</code> and two data constructors with types
-      
-      <programlisting language="java">
-Fork :: %forall a . Bintree a &arw; Bintree a &arw; Bintree a
-Leaf :: %forall a . a &arw; Bintree a
-      </programlisting>
-
-      We define the <emphasis>arity</emphasis> of each data constructor to be the number of
-      value arguments it takes; e.g. <code>Fork</code> has arity 2 and <code>Leaf</code> has
-      arity 1.</para>
-
-      <para>For a less conventional example illustrating the possibility of
-      higher-order kinds, the Haskell source declaration
-      
-      <programlisting language="haskell">
-data A f a = MkA (f a)
-      </programlisting>
-
-      might induce the Core declaration
-      
-      <programlisting language="java">
-%data A (f::*&arw;*) a = { MkA (f a) }
-      </programlisting>
-
-      which introduces the constructor
-      
-      <programlisting language="java">
-MkA :: %forall (f::*&arw;*) a . (f a) &arw; (A f) a
-      </programlisting></para>
-
-      <para>GHC (like some other Haskell implementations) supports an
-      extension to Haskell98 for existential types such as
-      
-      <programlisting language="haskell">
-data T = forall a . MkT a (a &arw; Bool)
-      </programlisting>
-
-      This is represented by the Core declaration
-      
-      <programlisting language="java">
-%data T = {MkT @a a (a &arw; Bool)}
-      </programlisting>
-
-      which introduces the nullary type constructor T and the data
-      constructor
-
-      <programlisting language="java">
-MkT :: %forall a . a &arw; (a &arw; Bool) &arw; T
-      </programlisting>
-
-      In general, existentially quantified variables appear as extra
-      universally quantified variables in the data contructor types. An
-      example of how to construct and deconstruct values of type <code>T</code> is
-      shown in <link linkend="expression-forms">the Expression Forms section</link>.</para>
-
-    </section>
-    <section id="newtypes">
-      <title>Newtypes</title>
-
-      <para>Each Core <code>%newtype</code> declaration introduces a new type constructor
-      and an associated representation type, corresponding to a source
-      Haskell <code>newtype</code> declaration. However, unlike in source Haskell,
-      a <code>%newtype</code> declaration does not introduce any data constructors.</para>
-
-      <para>Each <code>%newtype</code> declaration also introduces a new coercion
-      (syntactically, just another type constructor) that implies an
-      axiom equating the type constructor, applied to any type
-      variables bound by the <code>%newtype</code>, to the representation type.</para>
-
-      <para>For example, the Haskell fragment
-      
-      <programlisting language="haskell">
-newtype U = MkU Bool
-u = MkU True
-v = case u of
-  MkU b &arw; not b
-      </programlisting>
-
-      might induce the Core fragment
-
-      <programlisting language="java">
-%newtype U ZCCoU = Bool;
-u :: U = %cast (True)
-           ((%sym ZCCoU));
-v :: Bool = not (%cast (u) ZCCoU);
-      </programlisting></para>
-
-      <para>The <code>newtype</code> declaration implies that the types <code>U</code> and <code>Bool</code> have
-      equivalent representations, and the coercion axiom <code>ZCCoU</code>
-      provides evidence that <code>U</code> is equivalent to <code>Bool</code>. Notice that in
-      the body of <code>u</code>, the boolean value <code>True</code> is cast to type <code>U</code> using
-      the primitive symmetry rule applied to <code>ZCCoU</code>: that is, using a
-      coercion of kind <code>Bool :=: U</code>. And in the body of <code>v</code>, <code>u</code> is cast
-      back to type <code>Bool</code> using the axiom <code>ZCCoU</code>.</para>
-
-      <para>Notice that the <code>case</code> in the Haskell source code above translates
-      to a <code>cast</code> in the corresponding Core code. That is because
-      operationally, a <code>case</code> on a value whose type is declared by a
-      <code>newtype</code> declaration is a no-op. Unlike a <code>case</code> on any other
-      value, such a <code>case</code> does no evaluation: its only function is to
-      coerce its scrutinee’s type.</para>
-
-      <para>Also notice that unlike in a previous draft version of External
-      Core, there is no need to handle recursive newtypes specially.</para>
-
-    </section>
-
-    <section id="expression-forms">
-      <title>Expression Forms</title>
-
-      <para>Variables and data constructors are straightforward.</para>
-
-      <para>Literal (<emphasis role="variable">lit</emphasis>) expressions consist of a literal value, in one of
-      four different formats, and a (primitive) type annotation. Only
-      certain combinations of format and type are permitted;
-      see <link linkend="primitive-module">the Primitive Module section</link>.
-      The character and string formats can describe only 8-bit ASCII characters.</para>
-
-      <para>Moreover, because the operational semantics for Core interprets
-      strings as C-style null-terminated strings, strings should not
-      contain embedded nulls.</para>
-
-      <para>In Core, value applications, type applications, value
-      abstractions, and type abstractions are all explicit. To tell
-      them apart, type arguments in applications and formal type
-      arguments in abstractions are preceded by an <code>@ symbol</code>. (In
-      abstractions, the <code>@</code> plays essentially the same role as the more
-      usual Λ symbol.) For example, the Haskell source declaration
-      
-      <programlisting language="haskell">
-f x = Leaf (Leaf x)
-      </programlisting>
-
-      might induce the Core declaration
-
-      <programlisting language="java">
-f :: %forall a . a &arw; BinTree (BinTree a) =
-  \ @a (x::a) &arw; Leaf @(Bintree a) (Leaf @a x)
-      </programlisting></para>
-
-      <para>Value applications may be of user-defined functions, data
-      constructors, or primitives. None of these sorts of applications
-      are necessarily saturated.</para>
-
-      <para>Note that the arguments of type applications are not always of
-      kind <code>*</code>. For example, given our previous definition of type <code>A</code>:
-
-      <programlisting language="haskell">
-data A f a = MkA (f a)
-      </programlisting>
-
-      the source code
-
-      <programlisting language="haskell">
-MkA (Leaf True)
-      </programlisting>
-
-      becomes
-
-      <programlisting language="java">
-(MkA @Bintree @Bool) (Leaf @Bool True)
-      </programlisting></para>
-
-      <para>Local bindings, of a single variable or of a set of mutually
-      recursive variables, are represented by <code>%let</code> expressions in the
-      usual way.</para>
-
-      <para>By far the most complicated expression form is <code>%case</code>. <code>%case</code>
-      expressions are permitted over values of any type, although they
-      will normally be algebraic or primitive types (with literal
-      values). Evaluating a <code>%case</code> forces the evaluation of the
-      expression being tested (the <quote>scrutinee</quote>). The value of the
-      scrutinee is bound to the variable following the <code>%of</code> keyword,
-      which is in scope in all alternatives; this is useful when the
-      scrutinee is a non-atomic expression (see next example). The
-      scrutinee is preceded by the type of the entire <code>%case</code>
-      expression: that is, the result type that all of the <code>%case</code>
-      alternatives have (this is intended to make type reconstruction
-      easier in the presence of type equality coercions).</para>
-
-      <para>In an algebraic <code>%case</code>, all the case alternatives must be labeled
-      with distinct data constructors from the algebraic type,
-      followed by any existential type variable bindings (see below),
-      and typed term variable bindings corresponding to the data
-      constructor’s arguments. The number of variables must match the
-      data constructor’s arity.</para>
-
-      <para>For example, the following Haskell source expression
-
-      <programlisting language="haskell">
-case g x of
-  Fork l r &arw; Fork r l
-  t@(Leaf v) &arw; Fork t t
-      </programlisting>
-
-      might induce the Core expression
-
-      <programlisting language="java">
-%case ((Bintree a)) g x %of (t::Bintree a)
-  Fork (l::Bintree a) (r::Bintree a) &arw;
-    Fork @a r l
-  Leaf (v::a) &arw;
-    Fork @a t t
-      </programlisting></para>
-
-      <para>When performing a <code>%case</code> over a value of an
-      existentially-quantified algebraic type, the alternative must
-      include extra local type bindings for the
-      existentially-quantified variables. For example, given
-
-      <programlisting language="haskell">
-data T = forall a . MkT a (a &arw; Bool)
-      </programlisting>      
-
-      the source
-
-      <programlisting language="haskell">
-case x of
-  MkT w g &arw; g w
-      </programlisting>      
-
-      becomes
-
-      <programlisting language="java">
-%case x %of (x’::T)
-  MkT @b (w::b) (g::b&arw;Bool) &arw; g w
-      </programlisting></para>
-
-      <para>In a <code>%case</code> over literal alternatives, all the case alternatives
-      must be distinct literals of the same primitive type.</para>
-
-      <para>The list of alternatives may begin with a default alternative
-      labeled with an underscore (<code>%_</code>), whose right-hand side will be
-      evaluated if none of the other alternatives match. The default
-      is optional except for in a case over a primitive type, or when
-      there are no other alternatives. If the case is over neither an
-      algebraic type nor a primitive type, then the list of
-      alternatives must contain a default alternative and nothing
-      else. For algebraic cases, the set of alternatives need not be
-      exhaustive, even if no default is given; if alternatives are
-      missing, this implies that GHC has deduced that they cannot
-      occur.</para>
-
-      <para><code>%cast</code> is used to manipulate newtypes, as described in
-      <link linkend="newtypes">the Newtype section</link>. The <code>%cast</code> expression
-      takes an expression and a coercion: syntactically, the coercion
-      is an arbitrary type, but it must have an equality kind. In an
-      expression <code>(cast e co)</code>, if <code>e :: T</code> and <code>co</code> has kind <code>T :=: U</code>, then
-      the overall expression has type <code>U</code> <citation>ghc-fc-commentary</citation>. Here, <code>co</code> must be a
-      coercion whose left-hand side is <code>T</code>.</para>
-
-      <para>Note that unlike the <code>%coerce</code> expression that existed in previous
-      versions of Core, this means that <code>%cast</code> is (almost) type-safe:
-      the coercion argument provides evidence that can be verified by
-      a typechecker. There are still unsafe <code>%cast</code>s, corresponding to
-      the unsafe <code>%coerce</code> construct that existed in old versions of
-      Core, because there is a primitive unsafe coercion type that can
-      be used to cast arbitrary types to each other. GHC uses this for
-      such purposes as coercing the return type of a function (such as
-      error) which is guaranteed to never return:
-      
-      <programlisting language="haskell">
-case (error &quot;&quot;) of
-  True &arw; 1
-  False &arw; 2
-      </programlisting>
-
-      becomes:
-
-      <programlisting language="java">
-%cast (error @ Bool (ZMZN @ Char))
-(%unsafe Bool Integer);
-      </programlisting>
-
-      <code>%cast</code> has no operational meaning and is only used in
-      typechecking.</para>
-
-      <para>A <code>%note</code> expression carries arbitrary internal information that
-      GHC finds interesting. The information is encoded as a string.
-      Expression notes currently generated by GHC include the inlining
-      pragma (<code>InlineMe</code>) and cost-center labels for profiling.</para>
-
-      <para>A <code>%external</code> expression denotes an external identifier, which has
-      the indicated type (always expressed in terms of Haskell
-      primitive types). External Core supports two kinds of external
-      calls: <code>%external</code> and <code>%dynexternal</code>. Only the former is supported
-      by the current set of stand-alone Core tools. In addition, there
-      is a <code>%label</code> construct which GHC may generate but which the Core
-      tools do not support.</para>
-
-      <para>The present syntax for externals is sufficient for describing C
-      functions and labels. Interfacing to other languages may require
-      additional information or a different interpretation of the name
-      string.</para>
-
-    </section>
-
-    <section id="expression-evaluation">
-      <title>Expression Evaluation</title>
-      <para>The dynamic semantics of Core are defined on the type-erasure of
-      the program: for example, we ignore all type abstractions and
-      applications. The denotational semantics of the resulting
-      type-free program are just the conventional ones for a
-      call-by-name language, in which expressions are only evaluated
-      on demand. But Core is intended to be a call-by-<emphasis>need</emphasis> language,
-      in which expressions are only evaluated once. To express the
-      sharing behavior of call-by-need, we give an operational model
-      in the style of Launchbury <citation>launchbury93natural</citation>.</para>
-
-      <para>This section describes the model informally; a more formal
-      semantics is separately available as an executable interpreter.</para>
-
-      <para>To simplify the semantics, we consider only <quote>well-behaved</quote> Core
-      programs in which constructor and primitive applications are
-      fully saturated, and in which non-trivial expresssions of
-      unlifted kind (<code>#</code>) appear only as scrutinees in <code>%case</code>
-      expressions. Any program can easily be put into this form; a
-      separately available preprocessor illustrates how. In the
-      remainder of this section, we use <quote>Core</quote> to mean <quote>well-behaved</quote>
-      Core.</para>
-
-      <para>Evaluating a Core expression means reducing it to <emphasis>weak-head normal form (WHNF)</emphasis>,
-      i.e., a primitive value, lambda abstraction,
-      or fully-applied data constructor. Evaluating a program means
-      evaluating the expression <code>main:ZCMain.main</code>.</para>
-
-      <para>To make sure that expression evaluation is shared, we make use
-      of a <emphasis>heap</emphasis>, which contains <emphasis>heap entries</emphasis>. A heap entry can be:
-
-      <itemizedlist>
-	<listitem>
-	  A <emphasis>thunk</emphasis>, representing an unevaluated expression, also known
-	  as a suspension.
-	</listitem>
-	<listitem>
-	  A <emphasis>WHNF</emphasis>, representing an evaluated expression. The result of
-	  evaluating a thunk is a WHNF. A WHNF is always a closure
-	  (corresponding to a lambda abstraction in the source
-	  program) or a data constructor application: computations
-	  over primitive types are never suspended.
-	</listitem>
-      </itemizedlist></para>
-
-      <para><emphasis>Heap pointers</emphasis> point to heap entries: at different times, the
-      same heap pointer can point to either a thunk or a WHNF, because
-      the run-time system overwrites thunks with WHNFs as computation
-      proceeds.</para>
-
-      <para>The suspended computation that a thunk represents might
-      represent evaluating one of three different kinds of expression.
-      The run-time system allocates a different kind of thunk
-      depending on what kind of expression it is:
-
-      <itemizedlist>
-	<listitem>
-	  A thunk for a value definition has a group of suspended
-	  defining expressions, along with a list of bindings between
-	  defined names and heap pointers to those suspensions. (A
-	  value definition may be a recursive group of definitions or
-	  a single non-recursive definition, and it may be top-level
-	  (global) or <code>let</code>-bound (local)).
-	</listitem>
-	<listitem>
-	  A thunk for a function application (where the function is
-	  user-defined) has a suspended actual argument expression,
-	  and a binding between the formal argument and a heap pointer
-	  to that suspension.
-	</listitem>
-	<listitem>
-	  A thunk for a constructor application has a suspended actual
-	  argument expression; the entire constructed value has a heap
-	  pointer to that suspension embedded in it.
-	</listitem>
-      </itemizedlist></para>
-
-      <para>As computation proceeds, copies of the heap pointer for a given
-      thunk propagate through the executing program. When another
-      computation demands the result of that thunk, the thunk is
-      <emphasis>forced</emphasis>: the run-time system computes the thunk’s result,
-      yielding a WHNF, and overwrites the heap entry for the thunk
-      with the WHNF. Now, all copies of the heap pointer point to the
-      new heap entry: a WHNF. Forcing occurs only in the context of
-
-      <itemizedlist>
-        <listitem>evaluating the operator expression of an application;</listitem>
-        <listitem>evaluating the scrutinee of a <code>case</code> expression; or</listitem>
-        <listitem>evaluating an argument to a primitive or external function application</listitem>
-      </itemizedlist>
-      </para>
-
-      <para>When no pointers to a heap entry (whether it is a thunk or WHNF)
-      remain, the garbage collector can reclaim the space it uses. We
-      assume this happens implicitly.</para>
-
-      <para>With the exception of functions, arrays, and mutable variables,
-      we intend that values of all primitive types should be held
-      <emphasis>unboxed</emphasis>: they should not be heap-allocated. This does not
-      violate call-by-need semantics: all primitive types are
-      <emphasis>unlifted</emphasis>, which means that values of those types must be
-      evaluated strictly. Unboxed tuple types are not heap-allocated
-      either.</para>
-
-      <para>Certain primitives and <code>%external</code> functions cause side-effects to
-      state threads or to the real world. Where the ordering of these
-      side-effects matters, Core already forces this order with data
-      dependencies on the pseudo-values representing the threads.</para>
-
-      <para>An implementation must specially support the <code>raisezh</code> and
-      <code>handlezh</code> primitives: for example, by using a handler stack.
-      Again, real-world threading guarantees that they will execute in
-      the correct order.</para>
-
-    </section>
-  </section>
-  <section id="primitive-module">
-    <title>Primitive Module</title>
-
-    <para>The semantics of External Core rely on the contents and informal
-    semantics of the primitive module <code>ghc-prim:GHC.Prim</code>. Nearly all
-    the primitives are required in order to cover GHC’s implementation
-    of the Haskell98 standard prelude; the only operators that can be
-    completely omitted are those supporting the byte-code interpreter,
-    parallelism, and foreign objects. Some of the concurrency
-    primitives are needed, but can be given degenerate implementations
-    if it desired to target a purely sequential backend (see Section
-    <link linkend="non-concurrent-back-end">the Non-concurrent Back End section</link>).</para>
-
-    <para>In addition to these primitives, a large number of C library
-    functions are required to implement the full standard Prelude,
-    particularly to handle I/O and arithmetic on less usual types.</para>
-
-    <para>For a full listing of the names and types of the primitive
-    operators, see the GHC library documentation <citation>ghcprim</citation>.</para>
-
-    <section id="non-concurrent-back-end">
-      <title>Non-concurrent Back End</title>
-
-      <para>The Haskell98 standard prelude doesn’t include any concurrency
-      support, but GHC’s implementation of it relies on the existence
-      of some concurrency primitives. However, it never actually forks
-      multiple threads. Hence, the concurrency primitives can be given
-      degenerate implementations that will work in a non-concurrent
-      setting, as follows:</para>
-
-      <itemizedlist>
-        <listitem>
-	  <code>ThreadIdzh</code> can be represented by a singleton type, whose
-	  (unique) value is returned by <code>myThreadIdzh</code>.
-        </listitem>
-        <listitem>
-	  <code>forkzh</code> can just die with an <quote>unimplemented</quote> message.
-        </listitem>
-        <listitem>
-	  <code>killThreadzh</code> and <code>yieldzh</code> can also just die <quote>unimplemented</quote>
-	  since in a one-thread world, the only thread a thread can
-	  kill is itself, and if a thread yields the program hangs.
-        </listitem>
-        <listitem>
-	  <code>MVarzh a</code> can be represented by <code>MutVarzh (Maybe a)</code>; where a
-	  concurrent implementation would block, the sequential
-	  implementation can just die with a suitable message (since
-	  no other thread exists to unblock it).
-        </listitem>
-        <listitem>
-	  <code>waitReadzh</code> and <code>waitWritezh</code> can be implemented using a <code>select</code>
-	  with no timeout.
-        </listitem>
-      </itemizedlist>
-    </section>
-
-    <section id="literals">
-      <title>Literals</title>
-
-      <para>Only the following combination of literal forms and types are
-      permitted:</para>
-
-      <informaltable frame="none" colsep="0" rowsep="0">
-        <tgroup cols='3'>
-          <colspec colname="literal"     align="left" colwidth="*"  />
-          <colspec colname="type"        align="left" colwidth="*"  />
-          <colspec colname="description" align="left" colwidth="4*" />
-          <thead>
-            <row> 
-              <entry>Literal form</entry>
-              <entry>Type</entry>
-              <entry>Description</entry>
-            </row>
-          </thead>
-          <tbody>
-            <row>
-              <entry morerows="3" valign="top">integer</entry>
-              <entry><code>Intzh</code></entry>
-              <entry>Int</entry>
-            </row>
-            <row>
-              <entry><code>Wordzh</code></entry>
-              <entry>Word</entry>
-            </row>
-            <row>
-              <entry><code>Addrzh</code></entry>
-              <entry>Address</entry>
-            </row>
-            <row>
-              <entry><code>Charzh</code></entry>
-              <entry>Unicode character code</entry>
-            </row>
-
-            <row>
-              <entry morerows="1" valign="top">rational</entry>
-              <entry><code>Floatzh</code></entry>
-              <entry>Float</entry>
-            </row>
-            <row>
-              <entry><code>Doublezh</code></entry>
-              <entry>Double</entry>
-            </row>
-
-            <row>
-              <entry>character</entry>
-              <entry><code>Charzh</code></entry>
-              <entry>Unicode character specified by ASCII character</entry>
-            </row>
-
-            <row>
-              <entry>string</entry>
-              <entry><code>Addrzh</code></entry>
-              <entry>Address of specified C-format string</entry>
-            </row>
-          </tbody>
-        </tgroup>
-      </informaltable>
-    </section>
-  </section>
-
-
-  <bibliolist>
-    <!-- This bibliography was semi-automatically converted by JabRef from core.bib. -->
-
-    <title>References</title>
-    
-    <biblioentry>
-      <abbrev>ghc-user-guide</abbrev>
-      <authorgroup>
-        <author><surname>The GHC Team</surname></author> 
-      </authorgroup>
-      <citetitle pubwork="article">The Glorious Glasgow Haskell Compilation System User's Guide, Version 6.8.2</citetitle>
-      <pubdate>2008</pubdate>
-      <bibliomisc><ulink url="http://www.haskell.org/ghc/docs/latest/html/users_guide/index.html">http://www.haskell.org/ghc/docs/latest/html/users_guide/index.html</ulink></bibliomisc>
-    </biblioentry>
-
-    <biblioentry>
-      <abbrev>ghc-fc-commentary</abbrev>
-      <authorgroup>
-        <author><surname>GHC Wiki</surname></author> 
-      </authorgroup>
-      <citetitle pubwork="article">System FC: equality constraints and coercions</citetitle>
-      <pubdate>2006</pubdate>  
-      <bibliomisc><ulink url="http://ghc.haskell.org/trac/ghc/wiki/Commentary/Compiler/FC">http://ghc.haskell.org/trac/ghc/wiki/Commentary/Compiler/FC</ulink></bibliomisc>
-    </biblioentry>
-
-    <biblioentry>
-      <abbrev>ghc-api</abbrev>
-      <authorgroup>
-        <author><surname>Haskell Wiki</surname></author> 
-      </authorgroup>
-      <citetitle pubwork="article">Using GHC as a library</citetitle>
-      <pubdate>2007</pubdate>  
-      <bibliomisc><ulink url="http://haskell.org/haskellwiki/GHC/As_a_library">http://haskell.org/haskellwiki/GHC/As_a_library</ulink></bibliomisc>
-    </biblioentry>
-
-    <biblioentry>
-      <abbrev>haskell98</abbrev>
-      <authorgroup>
-        <editor><firstname>Simon</firstname><surname>Peyton-Jones</surname></editor> 
-      </authorgroup>
-      <citetitle pubwork="article">Haskell 98 Language and Libraries: The Revised Report</citetitle>
-      <publisher>
-        <publishername>Cambridge University Press</publishername>
-        <address>
-          <city>Cambridge></city>
-          <state>UK</state>
-        </address>
-      </publisher>
-      <pubdate>2003</pubdate>
-    </biblioentry>
-
-    <biblioentry>
-      <abbrev>system-fc</abbrev>
-      <authorgroup>
-        <author><firstname>Martin</firstname><surname>Sulzmann</surname></author>
-        <author><firstname>Manuel M.T.</firstname><surname>Chakravarty</surname></author>
-        <author><firstname>Simon</firstname><surname>Peyton-Jones</surname></author>
-        <author><firstname>Kevin</firstname><surname>Donnelly</surname></author> 
-      </authorgroup>
-      <citetitle pubwork="article">System F with type equality coercions</citetitle>
-      <publisher>
-        <publishername>ACM</publishername>
-        <address>
-          <city>New York</city>
-          <state>NY</state>
-          <country>USA</country>
-        </address>
-      </publisher>
-      <artpagenums>53-66</artpagenums> 
-      <pubdate>2007</pubdate>  
-      <bibliomisc><ulink url="http://portal.acm.org/citation.cfm?id=1190324">http://portal.acm.org/citation.cfm?id=1190324</ulink></bibliomisc>
-      <!-- booktitle = {{TLDI '07: Proceedings of the 2007 ACM SIGPLAN International Workshop on Types in Language Design and Implementation}}, -->
-    </biblioentry>
-
-    <biblioentry>
-      <abbrev>gadts</abbrev>
-      <authorgroup>
-        <author><firstname>Simon</firstname><surname>Peyton-Jones</surname></author>
-        <author><firstname>Dimitrios</firstname><surname>Vytiniotis</surname></author>
-        <author><firstname>Stephanie</firstname><surname>Weirich</surname></author>
-        <author><firstname>Geoffrey</firstname><surname>Washburn</surname></author> 
-      </authorgroup>
-      <citetitle pubwork="article">Simple unification-based type inference for GADTs</citetitle>
-      <publisher>
-        <publishername>ACM</publishername>
-        <address>
-          <city>New York</city>
-          <state>NY</state>
-          <country>USA</country>
-        </address>
-      </publisher>
-      <artpagenums>50-61</artpagenums> 
-      <pubdate>2006</pubdate>  
-      <bibliomisc><ulink url="http://research.microsoft.com/Users/simonpj/papers/gadt/index.htm">http://research.microsoft.com/Users/simonpj/papers/gadt/index.htm</ulink></bibliomisc>
-    </biblioentry>
-
-    <biblioentry>
-      <abbrev>Launchbury94</abbrev>
-      <authorgroup>
-        <author><firstname>John</firstname><surname>Launchbury</surname></author>
-        <author><firstname>Simon L.</firstname><surname>Peyton-Jones</surname></author> 
-      </authorgroup>
-      <citetitle pubwork="article">Lazy Functional State Threads</citetitle>
-      <artpagenums>24-35</artpagenums> 
-      <pubdate>1994</pubdate>  
-      <bibliomisc><ulink url="http://citeseer.ist.psu.edu/article/launchbury93lazy.html">http://citeseer.ist.psu.edu/article/launchbury93lazy.html</ulink></bibliomisc>
-      <!--      booktitle = "{SIGPLAN} {Conference} on {Programming Language Design and Implementation}", -->
-    </biblioentry>
-
-    <biblioentry>
-      <abbrev>pj:unboxed</abbrev>
-      <authorgroup>
-        <author><firstname>Simon L.</firstname><surname>Peyton-Jones</surname></author>
-        <author><firstname>John</firstname><surname>Launchbury</surname></author> 
-        <editor><firstname>J.</firstname><surname>Hughes</surname></editor> 
-      </authorgroup>
-      <citetitle pubwork="article">Unboxed Values as First Class Citizens in a Non-strict Functional Language</citetitle>
-      <publisher>
-        <publishername>Springer-Verlag LNCS523</publishername>
-        <address>
-          <city>Cambridge</city>
-          <state>Massachussetts</state>
-          <country>USA</country>
-        </address>
-      </publisher>
-      <artpagenums>636-666</artpagenums> 
-      <pubdate>1991, August 26-28</pubdate>  
-      <bibliomisc><ulink url="http://citeseer.ist.psu.edu/jones91unboxed.html">http://citeseer.ist.psu.edu/jones91unboxed.html</ulink></bibliomisc>
-      <!--      booktitle = "Proceedings of the Conference on Functional Programming and Computer Architecture", -->
-    </biblioentry>
-
-    <biblioentry>
-      <abbrev>ghc-inliner</abbrev>
-      <authorgroup>
-        <author><firstname>Simon</firstname><surname>Peyton-Jones</surname></author>
-        <author><firstname>Simon</firstname><surname>Marlow</surname></author> 
-      </authorgroup>
-      <citetitle pubwork="article">Secrets of the Glasgow Haskell Compiler inliner</citetitle>
-      <pubdate>1999</pubdate>  
-      <address>
-        <city>Paris</city>
-        <country>France</country>
-      </address>
-      <bibliomisc><ulink url="http://research.microsoft.com/Users/simonpj/Papers/inlining/inline.pdf">http://research.microsoft.com/Users/simonpj/Papers/inlining/inline.pdf</ulink></bibliomisc>
-      <!-- booktitle = "Workshop on Implementing Declarative Languages", -->
-    </biblioentry>
-
-    <biblioentry>
-      <abbrev>comp-by-trans-scp</abbrev>
-      <authorgroup>
-        <author><firstname>Simon L.</firstname><surname>Peyton-Jones</surname></author>
-        <author><firstname>A. L. M.</firstname><surname>Santos</surname></author> 
-      </authorgroup>
-      <citetitle pubwork="article">A transformation-based optimiser for Haskell</citetitle>
-      <citetitle pubwork="journal">Science of Computer Programming</citetitle>
-      <volumenum>32</volumenum> 
-      <issuenum>1-3</issuenum>
-      <artpagenums>3-47</artpagenums> 
-      <pubdate>1998</pubdate>  
-      <bibliomisc><ulink url="http://citeseer.ist.psu.edu/peytonjones98transformationbased.html">http://citeseer.ist.psu.edu/peytonjones98transformationbased.html</ulink></bibliomisc>
-    </biblioentry>
-
-    <biblioentry>
-      <abbrev>stg-machine</abbrev>
-      <authorgroup>
-        <author><firstname>Simon L.</firstname><surname>Peyton-Jones</surname></author> 
-      </authorgroup>
-      <citetitle pubwork="article">Implementing Lazy Functional Languages on Stock Hardware: The Spineless Tagless G-Machine</citetitle>
-      <citetitle pubwork="journal">Journal of Functional Programming</citetitle>
-      <volumenum>2</volumenum> 
-      <issuenum>2</issuenum>
-      <artpagenums>127-202</artpagenums> 
-      <pubdate>1992</pubdate>  
-      <bibliomisc><ulink url="http://citeseer.ist.psu.edu/peytonjones92implementing.html">http://citeseer.ist.psu.edu/peytonjones92implementing.html</ulink></bibliomisc>
-    </biblioentry>
-
-    <biblioentry>
-      <abbrev>launchbury93natural</abbrev>
-      <authorgroup>
-        <author><firstname>John</firstname><surname>Launchbury</surname></author> 
-      </authorgroup>
-      <citetitle pubwork="article">A Natural Semantics for Lazy Evaluation</citetitle>
-      <artpagenums>144-154</artpagenums> 
-      <address>
-        <city>Charleston</city>
-        <state>South Carolina</state>
-      </address>
-      <pubdate>1993</pubdate>  
-      <bibliomisc><ulink url="http://citeseer.ist.psu.edu/launchbury93natural.html">http://citeseer.ist.psu.edu/launchbury93natural.html</ulink></bibliomisc>
-      <!-- booktitle = "Conference Record of the Twentieth Annual {ACM} {SIGPLAN}-{SIGACT} Symposium on Principles of Programming Languages", -->
-    </biblioentry>
-
-    <biblioentry>
-      <abbrev>ghcprim</abbrev>
-      <authorgroup>
-        <author><surname>The GHC Team</surname></author> 
-      </authorgroup>
-      <citetitle pubwork="article">Library documentation: GHC.Prim</citetitle>
-      <pubdate>2008</pubdate>
-      <bibliomisc><ulink url="http://www.haskell.org/ghc/docs/latest/html/libraries/base/GHC-Prim.html">http://www.haskell.org/ghc/docs/latest/html/libraries/base/GHC-Prim.html</ulink></bibliomisc>  
-    </biblioentry>
-  </bibliolist>
-
-</chapter>
diff --git a/docs/users_guide/ffi-chap.xml b/docs/users_guide/ffi-chap.xml
index 4d91947c7204..e7d5a0c37d83 100644
--- a/docs/users_guide/ffi-chap.xml
+++ b/docs/users_guide/ffi-chap.xml
@@ -213,6 +213,40 @@ newtype {-# CTYPE            "useconds_t" #-} T = ...
 </programlisting>
         </para>
       </sect2>
+
+      <sect2>
+        <title><literal>hs_thread_done()</literal></title>
+
+<programlisting>
+void hs_thread_done(void);
+</programlisting>
+
+        <para>
+          GHC allocates a small amount of thread-local memory when a
+          thread calls a Haskell function via a <literal>foreign
+          export</literal>.  This memory is not normally freed until
+          <literal>hs_exit()</literal>; the memory is cached so that
+          subsequent calls into Haskell are fast.  However, if your
+          application is long-running and repeatedly creates new
+          threads that call into Haskell, you probably want to arrange
+          that this memory is freed in those threads that have
+          finished calling Haskell functions.  To do this, call
+          <literal>hs_thread_done()</literal> from the thread whose
+          memory you want to free.
+        </para>
+
+        <para>
+          Calling <literal>hs_thread_done()</literal> is entirely
+          optional.  You can call it as often or as little as you
+          like.  It is safe to call it from a thread that has never
+          called any Haskell functions, or one that never will.  If
+          you forget to call it, the worst that can happen is that
+          some memory remains allocated until
+          <literal>hs_exit()</literal> is called.  If you call it too
+          often, the worst that can happen is that the next call to a
+          Haskell function incurs some extra overhead.
+        </para>
+      </sect2>
   </sect1>
 
   <sect1 id="ffi-ghc">
diff --git a/docs/users_guide/flags.xml b/docs/users_guide/flags.xml
index 3a69c8f55082..8381ca12546b 100644
--- a/docs/users_guide/flags.xml
+++ b/docs/users_guide/flags.xml
@@ -590,7 +590,7 @@
         </thead>
         <tbody>
           <row>
-            <entry><option>-package-name</option> <replaceable>P</replaceable></entry>
+            <entry><option>-this-package-key</option> <replaceable>P</replaceable></entry>
             <entry>Compile to be part of package <replaceable>P</replaceable></entry>
             <entry>static</entry>
             <entry>-</entry>
@@ -704,9 +704,15 @@
           </row>
         </thead>
         <tbody>
+          <row>
+            <entry><option>-fcontext-stack=N</option><replaceable>n</replaceable></entry>
+            <entry>set the <link linkend="undecidable-instances">limit for context reduction</link>. Default is 20.</entry>
+            <entry>dynamic</entry>
+            <entry></entry>
+          </row>
           <row>
             <entry><option>-fglasgow-exts</option></entry>
-            <entry>Enable most language extensions; see <xref linkend="options-language"/> for exactly which ones.</entry>
+            <entry>Deprecated. Enable most language extensions; see <xref linkend="options-language"/> for exactly which ones.</entry>
             <entry>dynamic</entry>
             <entry><option>-fno-glasgow-exts</option></entry>
           </row>
@@ -717,10 +723,10 @@
             <entry><option>-fno-irrefutable-tuples</option></entry>
           </row>
           <row>
-            <entry><option>-fcontext-stack=N</option><replaceable>n</replaceable></entry>
-            <entry>set the <link linkend="undecidable-instances">limit for context reduction</link>. Default is 20.</entry>
+            <entry><option>-fpackage-trust</option></entry>
+            <entry>Enable <link linkend="safe-haskell">Safe Haskell</link> trusted package requirement for trustworthy modules.</entry>
             <entry>dynamic</entry>
-            <entry></entry>
+            <entry><option>-</option></entry>
           </row>
           <row>
             <entry><option>-ftype-function-depth=N</option><replaceable>n</replaceable></entry>
@@ -745,29 +751,80 @@
           </row>
           <row>
             <entry><option>-XAutoDeriveTypeable</option></entry>
-            <entry>Automatically <link linkend="auto-derive-typeable">derive Typeable instances for every datatype and type class declaration</link>.
+            <entry>Automatically <link linkend="deriving-typeable">derive Typeable instances for every datatype and type class declaration</link>.
             Implies <option>-XDeriveDataTypeable</option>.</entry>
             <entry>dynamic</entry>
             <entry><option>-XNoAutoDeriveTypeable</option></entry>
           </row>
+          <row>
+            <entry><option>-XBangPatterns</option></entry>
+            <entry>Enable <link linkend="bang-patterns">bang patterns</link>.</entry>
+            <entry>dynamic</entry>
+            <entry><option>-XNoBangPatterns</option></entry>
+          </row>
+          <row>
+            <entry><option>-XBinaryLiterals</option></entry>
+            <entry>Enable support for <link linkend="binary-literals">binary literals</link>.</entry>
+            <entry>dynamic</entry>
+            <entry><option>-XNoBinaryLiterals</option></entry>
+          </row>
+          <row>
+            <entry><option>-XCApiFFI</option></entry>
+            <entry>Enable <link linkend="ffi-capi">the CAPI calling convention</link>.</entry>
+            <entry>dynamic</entry>
+            <entry><option>-XNoCAPIFFI</option></entry>
+          </row>
+          <row>
+            <entry><option>-XConstrainedClassMethods</option></entry>
+            <entry>Enable <link linkend="class-method-types">constrained class methods</link>.</entry>
+            <entry>dynamic</entry>
+            <entry><option>-XNoConstrainedClassMethods</option></entry>
+          </row>
           <row>
             <entry><option>-XConstraintKinds</option></entry>
             <entry>Enable a <link linkend="constraint-kind">kind of constraints</link>.</entry>
             <entry>dynamic</entry>
             <entry><option>-XNoConstraintKinds</option></entry>
           </row>
+          <row>
+            <entry><option>-XCPP</option></entry>
+            <entry>Enable the <link linkend="c-pre-processor">C preprocessor</link>.</entry>
+            <entry>dynamic</entry>
+            <entry><option>-XNoCPP</option></entry>
+          </row>
           <row>
             <entry><option>-XDataKinds</option></entry>
             <entry>Enable <link linkend="promotion">datatype promotion</link>.</entry>
             <entry>dynamic</entry>
             <entry><option>-XNoDataKinds</option></entry>
           </row>
+          <row>
+            <entry><option>-XDefaultSignatures</option></entry>
+            <entry>Enable <link linkend="class-default-signatures">default signatures</link>.</entry>
+            <entry>dynamic</entry>
+            <entry><option>-XNoDefaultSignatures</option></entry>
+          </row>
           <row>
             <entry><option>-XDeriveDataTypeable</option></entry>
-            <entry>Enable <link linkend="deriving-typeable">deriving for the Data and Typeable classes</link>.</entry>
+            <entry>Enable <link linkend="deriving-typeable">deriving for the Data and Typeable classes</link>.
+              Implied by <option>-XAutoDeriveTypeable</option>.</entry>
             <entry>dynamic</entry>
             <entry><option>-XNoDeriveDataTypeable</option></entry>
           </row>
+          <row>
+            <entry><option>-XDeriveFunctor</option></entry>
+            <entry>Enable <link linkend="deriving-extra">deriving for the Functor class</link>.
+              Implied by <option>-XDeriveTraversable</option>.</entry>
+            <entry>dynamic</entry>
+            <entry><option>-XNoDeriveFunctor</option></entry>
+          </row>
+          <row>
+            <entry><option>-XDeriveFoldable</option></entry>
+            <entry>Enable <link linkend="deriving-extra">deriving for the Foldable class</link>.
+              Implied by <option>-XDeriveTraversable</option>.</entry>
+            <entry>dynamic</entry>
+            <entry><option>-XNoDeriveFoldable</option></entry>
+          </row>
           <row>
             <entry><option>-XDeriveGeneric</option></entry>
             <entry>Enable <link linkend="deriving-typeable">deriving for the Generic class</link>.</entry>
@@ -775,42 +832,93 @@
             <entry><option>-XNoDeriveGeneric</option></entry>
           </row>
           <row>
-            <entry><option>-XGeneralizedNewtypeDeriving</option></entry>
-            <entry>Enable <link linkend="newtype-deriving">newtype deriving</link>.</entry>
+            <entry><option>-XDeriveTraversable</option></entry>
+            <entry>Enable <link linkend="deriving-extra">deriving for the Traversable class</link>.
+              Implies <option>-XDeriveFunctor</option> and <option>-XDeriveFoldable</option>.</entry>
             <entry>dynamic</entry>
-            <entry><option>-XNoGeneralizedNewtypeDeriving</option></entry>
+            <entry><option>-XNoDeriveTraversable</option></entry>
           </row>
           <row>
             <entry><option>-XDisambiguateRecordFields</option></entry>
-            <entry>Enable <link linkend="disambiguate-fields">record
-                field disambiguation</link></entry>
+            <entry>Enable <link linkend="disambiguate-fields">record field disambiguation</link>.
+              Implied by <option>-XRecordWildCards</option>.</entry>
             <entry>dynamic</entry>
             <entry><option>-XNoDisambiguateRecordFields</option></entry>
           </row>
           <row>
             <entry><option>-XEmptyCase</option></entry>
-            <entry>Allow <link linkend="empty-case">empty case alternatives</link>
-                  </entry>
+            <entry>Allow <link linkend="empty-case">empty case alternatives</link>.</entry>
             <entry>dynamic</entry>
             <entry><option>-XNoEmptyCase</option></entry>
           </row>
+          <row>
+            <entry><option>-XEmptyDataDecls</option></entry>
+            <entry>Enable empty data declarations.</entry>
+            <entry>dynamic</entry>
+            <entry><option>-XNoEmptyDataDecls</option></entry>
+          </row>
+          <row>
+            <entry><option>-XExistentialQuantification</option></entry>
+            <entry>Enable <link linkend="existential-quantification">existential quantification</link>.</entry>
+            <entry>dynamic</entry>
+            <entry><option>-XNoExistentialQuantification</option></entry>
+          </row>
+          <row>
+            <entry><option>-XExplicitForAll</option></entry>
+            <entry>Enable <link linkend="explicit-foralls">explicit universal quantification</link>.
+              Implied by <option>-XScopedTypeVariables</option>,
+              <option>-XLiberalTypeSynonyms</option>,
+              <option>-XRankNTypes</option> and
+              <option>-XExistentialQuantification</option>.
+            </entry>
+            <entry>dynamic</entry>
+            <entry><option>-XNoExplicitForAll</option></entry>
+          </row>
+          <row>
+            <entry><option>-XExplicitNamespaces</option></entry>
+            <entry>Enable using the keyword <literal>type</literal> to specify the namespace of
+                   entries in imports and exports (<xref linkend="explicit-namespaces"/>).
+                   Implied by <option>-XTypeOperators</option> and <option>-XTypeFamilies</option>.</entry>
+            <entry>dynamic</entry>
+            <entry><option>-XNoExplicitNamespaces</option></entry>
+          </row>
           <row>
             <entry><option>-XExtendedDefaultRules</option></entry>
-            <entry>Use GHCi's <link linkend="extended-default-rules">extended default rules</link> in a normal module</entry>
+            <entry>Use GHCi's <link linkend="extended-default-rules">extended default rules</link> in a normal module.</entry>
             <entry>dynamic</entry>
             <entry><option>-XNoExtendedDefaultRules</option></entry>
           </row>
+          <row>
+            <entry><option>-XFlexibleContexts</option></entry>
+            <entry>Enable <link linkend="flexible-contexts">flexible contexts</link>.
+              Implied by <option>-XImplicitParams</option>.</entry>
+            <entry>dynamic</entry>
+            <entry><option>-XNoFlexibleContexts</option></entry>
+          </row>
+          <row>
+            <entry><option>-XFlexibleInstances</option></entry>
+            <entry>Enable <link linkend="instance-rules">flexible instances</link>.
+              Implies <option>-XTypeSynonymInstances</option>. Implied by <option>-XImplicitParams</option>.</entry>
+            <entry>dynamic</entry>
+            <entry><option>-XNoFlexibleInstances</option></entry>
+          </row>
           <row>
             <entry><option>-XForeignFunctionInterface</option></entry>
-            <entry>Enable <link linkend="ffi">foreign function interface</link> (implied by
-              <option>-fglasgow-exts</option>)</entry>
+            <entry>Enable <link linkend="ffi">foreign function interface</link>.</entry>
             <entry>dynamic</entry>
             <entry><option>-XNoForeignFunctionInterface</option></entry>
           </row>
+          <row>
+            <entry><option>-XFunctionalDependencies</option></entry>
+            <entry>Enable <link linkend="functional-dependencies">functional dependencies</link>.
+              Implies <option>-XMultiParamTypeClasses</option>.</entry>
+            <entry>dynamic</entry>
+            <entry><option>-XNoFunctionalDependencies</option></entry>
+          </row>
           <row>
             <entry><option>-XGADTs</option></entry>
             <entry>Enable <link linkend="gadt">generalised algebraic data types</link>.
-            </entry>
+              Implies <option>-XGADTSyntax</option> and <option>-XMonoLocalBinds</option>.</entry>
             <entry>dynamic</entry>
             <entry><option>-XNoGADTs</option></entry>
           </row>
@@ -821,6 +929,12 @@
             <entry>dynamic</entry>
             <entry><option>-XNoGADTSyntax</option></entry>
           </row>
+          <row>
+            <entry><option>-XGeneralizedNewtypeDeriving</option></entry>
+            <entry>Enable <link linkend="newtype-deriving">newtype deriving</link>.</entry>
+            <entry>dynamic</entry>
+            <entry><option>-XNoGeneralizedNewtypeDeriving</option></entry>
+          </row>
           <row>
             <entry><option>-XGenerics</option></entry>
             <entry>Deprecated, does nothing. No longer enables <link linkend="generic-classes">generic classes</link>.
@@ -832,103 +946,73 @@
           <row>
             <entry><option>-XImplicitParams</option></entry>
             <entry>Enable <link linkend="implicit-parameters">Implicit Parameters</link>.
-              Implied by <option>-fglasgow-exts</option>.</entry>
+              Implies <option>-XFlexibleContexts</option> and <option>-XFlexibleInstances</option>.</entry>
             <entry>dynamic</entry>
             <entry><option>-XNoImplicitParams</option></entry>
           </row>
           <row>
             <entry><option>-XNoImplicitPrelude</option></entry>
-            <entry>Don't implicitly <literal>import Prelude</literal></entry>
+            <entry>Don't implicitly <literal>import Prelude</literal>.
+              Implied by <option>-XRebindableSyntax</option>.</entry>
             <entry>dynamic</entry>
             <entry><option>-XImplicitPrelude</option></entry>
           </row>
           <row>
-            <entry><option>-XIncoherentInstances</option></entry>
-            <entry>Enable <link linkend="instance-overlap">incoherent instances</link>.
-              Implies <option>-XOverlappingInstances</option> </entry>
-            <entry>dynamic</entry>
-            <entry><option>-XNoIncoherentInstances</option></entry>
-          </row>
-          <row>
-            <entry><option>-XNoMonomorphismRestriction</option></entry>
-            <entry>Disable the <link linkend="monomorphism">monomorphism restriction</link></entry>
-            <entry>dynamic</entry>
-            <entry><option>-XMonomorphismRrestriction</option></entry>
-          </row>
-          <row>
-            <entry><option>-XNegativeLiterals</option></entry>
-            <entry>Enable support for <link linkend="negative-literals">negative literals</link></entry>
-            <entry>dynamic</entry>
-            <entry><option>-XNoNegativeLiterals</option></entry>
-          </row>
-          <row>
-            <entry><option>-XNoNPlusKPatterns</option></entry>
-            <entry>Disable support for <literal>n+k</literal> patterns</entry>
-            <entry>dynamic</entry>
-            <entry><option>-XNPlusKPatterns</option></entry>
-          </row>
-          <row>
-            <entry><option>-XNumDecimals</option></entry>
-            <entry>Enable support for 'fractional' integer literals</entry>
-            <entry>dynamic</entry>
-            <entry><option>-XNoNumDecimals</option></entry>
-          </row>
-          <row>
-            <entry><option>-XOverlappingInstances</option></entry>
-            <entry>Enable <link linkend="instance-overlap">overlapping instances</link></entry>
+            <entry><option>-XImpredicativeTypes</option></entry>
+            <entry>Enable <link linkend="impredicative-polymorphism">impredicative types</link>.
+              Implies <option>-XRankNTypes</option>.</entry>
             <entry>dynamic</entry>
-            <entry><option>-XNoOverlappingInstances</option></entry>
+            <entry><option>-XNoImpredicativeTypes</option></entry>
           </row>
           <row>
-            <entry><option>-XOverloadedLists</option></entry>
-            <entry>Enable <link linkend="overloaded-lists">overloaded lists</link>.
-            </entry>
+            <entry><option>-XIncoherentInstances</option></entry>
+            <entry>Enable <link linkend="instance-overlap">incoherent instances</link>.
+              Implies <option>-XOverlappingInstances</option>.</entry>
             <entry>dynamic</entry>
-            <entry><option>-XNoOverloadedLists</option></entry>
+            <entry><option>-XNoIncoherentInstances</option></entry>
           </row>
           <row>
-            <entry><option>-XOverloadedStrings</option></entry>
-            <entry>Enable <link linkend="overloaded-strings">overloaded string literals</link>.
-            </entry>
+            <entry><option>-XInstanceSigs</option></entry>
+            <entry>Enable <link linkend="instance-sigs">instance signatures</link>.</entry>
             <entry>dynamic</entry>
-            <entry><option>-XNoOverloadedStrings</option></entry>
+            <entry><option>-XNoInstanceSigs</option></entry>
           </row>
           <row>
-            <entry><option>-XQuasiQuotes</option></entry>
-            <entry>Enable <link linkend="th-quasiquotation">quasiquotation</link>.</entry>
+            <entry><option>-XInterruptibleFFI</option></entry>
+            <entry>Enable interruptible FFI.</entry>
             <entry>dynamic</entry>
-            <entry><option>-XNoQuasiQuotes</option></entry>
+            <entry><option>-XNoInterruptibleFFI</option></entry>
           </row>
           <row>
-            <entry><option>-XRelaxedPolyRec</option></entry>
-            <entry>Relaxed checking for <link linkend="typing-binds">mutually-recursive polymorphic functions</link></entry>
+            <entry><option>-XKindSignatures</option></entry>
+            <entry>Enable <link linkend="kinding">kind signatures</link>.
+              Implied by <option>-XTypeFamilies</option> and <option>-XPolyKinds</option>.</entry>
             <entry>dynamic</entry>
-            <entry><option>-XNoRelaxedPolyRec</option></entry>
+            <entry><option>-XNoKindSignatures</option></entry>
           </row>
           <row>
-            <entry><option>-XNoTraditionalRecordSyntax</option></entry>
-            <entry>Disable support for traditional record syntax (as supported by Haskell 98) <literal>C {f = x}</literal></entry>
+            <entry><option>-XLambdaCase</option></entry>
+            <entry>Enable <link linkend="lambda-case">lambda-case expressions</link>.</entry>
             <entry>dynamic</entry>
-            <entry><option>-XTraditionalRecordSyntax</option></entry>
+            <entry><option>-XNoLambdaCase</option></entry>
           </row>
           <row>
-            <entry><option>-XTypeFamilies</option></entry>
-            <entry>Enable <link linkend="type-families">type families</link>.</entry>
+            <entry><option>-XLiberalTypeSynonyms</option></entry>
+            <entry>Enable <link linkend="type-synonyms">liberalised type synonyms</link>.</entry>
             <entry>dynamic</entry>
-            <entry><option>-XNoTypeFamilies</option></entry>
+            <entry><option>-XNoLiberalTypeSynonyms</option></entry>
           </row>
           <row>
-            <entry><option>-XUndecidableInstances</option></entry>
-            <entry>Enable <link linkend="undecidable-instances">undecidable instances</link></entry>
+            <entry><option>-XMagicHash</option></entry>
+            <entry>Allow "#" as a <link linkend="magic-hash">postfix modifier on identifiers</link>.</entry>
             <entry>dynamic</entry>
-            <entry><option>-XNoUndecidableInstances</option></entry>
+            <entry><option>-XNoMagicHash</option></entry>
           </row>
           <row>
-            <entry><option>-XPolyKinds</option></entry>
-            <entry>Enable <link linkend="kind-polymorphism">kind polymorphism</link>.
-                   Implies <option>-XKindSignatures</option>.</entry>
+            <entry><option>-XMonadComprehensions</option></entry>
+            <entry>Enable <link linkend="monad-comprehensions">monad comprehensions</link>.</entry>
             <entry>dynamic</entry>
-            <entry><option>-XNoPolyKinds</option></entry>
+            <entry><option>-XNoMonadComprehensions</option></entry>
           </row>
           <row>
             <entry><option>-XMonoLocalBinds</option></entry>
@@ -937,165 +1021,159 @@
             </entry>
             <entry>dynamic</entry>
             <entry><option>-XNoMonoLocalBinds</option></entry>
-          </row>
+          </row>          
           <row>
-            <entry><option>-XRebindableSyntax</option></entry>
-            <entry>Employ <link linkend="rebindable-syntax">rebindable syntax</link></entry>
+            <entry><option>-XNoMonomorphismRestriction</option></entry>
+            <entry>Disable the <link linkend="monomorphism">monomorphism restriction</link>.</entry>
             <entry>dynamic</entry>
-            <entry><option>-XNoRebindableSyntax</option></entry>
+            <entry><option>-XMonomorphismRrestriction</option></entry>
           </row>
           <row>
-            <entry><option>-XScopedTypeVariables</option></entry>
-            <entry>Enable <link linkend="scoped-type-variables">lexically-scoped type variables</link>.
-              Implied by <option>-fglasgow-exts</option>.</entry>
+            <entry><option>-XMultiParamTypeClasses</option></entry>
+            <entry>Enable <link linkend="multi-param-type-classes">multi parameter type classes</link>.
+              Implied by <option>-XFunctionalDependencies</option>.</entry>
             <entry>dynamic</entry>
-            <entry><option>-XNoScopedTypeVariables</option></entry>
+            <entry><option>-XNoMultiParamTypeClasses</option></entry>
           </row>
           <row>
-            <entry><option>-XTemplateHaskell</option></entry>
-            <entry>Enable <link linkend="template-haskell">Template Haskell</link>.
-              No longer implied by <option>-fglasgow-exts</option>.</entry>
+            <entry><option>-XMultiWayIf</option></entry>
+            <entry>Enable <link linkend="multi-way-if">multi-way if-expressions</link>.</entry>
             <entry>dynamic</entry>
-            <entry><option>-XNoTemplateHaskell</option></entry>
+            <entry><option>-XNoMultiWayIf</option></entry>
           </row>
           <row>
-            <entry><option>-XBangPatterns</option></entry>
-            <entry>Enable <link linkend="bang-patterns">bang patterns</link>.</entry>
+            <entry><option>-XNamedFieldPuns</option></entry>
+            <entry>Enable <link linkend="record-puns">record puns</link>.</entry>
             <entry>dynamic</entry>
-            <entry><option>-XNoBangPatterns</option></entry>
+            <entry><option>-XNoNamedFieldPuns</option></entry>
           </row>
           <row>
-            <entry><option>-XCPP</option></entry>
-            <entry>Enable the <link linkend="c-pre-processor">C preprocessor</link>.</entry>
+            <entry><option>-XNegativeLiterals</option></entry>
+            <entry>Enable support for <link linkend="negative-literals">negative literals</link>.</entry>
             <entry>dynamic</entry>
-            <entry><option>-XNoCPP</option></entry>
+            <entry><option>-XNoNegativeLiterals</option></entry>
           </row>
           <row>
-            <entry><option>-XPatternGuards</option></entry>
-            <entry>Enable <link linkend="pattern-guards">pattern guards</link>.</entry>
+            <entry><option>-XNoNPlusKPatterns</option></entry>
+            <entry>Disable support for <literal>n+k</literal> patterns.</entry>
             <entry>dynamic</entry>
-            <entry><option>-XNoPatternGuards</option></entry>
+            <entry><option>-XNPlusKPatterns</option></entry>
           </row>
           <row>
-            <entry><option>-XViewPatterns</option></entry>
-            <entry>Enable <link linkend="view-patterns">view patterns</link>.</entry>
+            <entry><option>-XNullaryTypeClasses</option></entry>
+            <entry>Deprecated, does nothing. <link linkend="nullary-type-classes">nullary (no parameter) type classes</link> are now enabled using <option>-XMultiParamTypeClasses</option>.</entry>
             <entry>dynamic</entry>
-            <entry><option>-XNoViewPatterns</option></entry>
+            <entry><option>-XNoNullaryTypeClasses</option></entry>
           </row>
           <row>
-            <entry><option>-XUnicodeSyntax</option></entry>
-            <entry>Enable <link linkend="unicode-syntax">unicode syntax</link>.</entry>
+            <entry><option>-XNumDecimals</option></entry>
+            <entry>Enable support for 'fractional' integer literals.</entry>
             <entry>dynamic</entry>
-            <entry><option>-XNoUnicodeSyntax</option></entry>
+            <entry><option>-XNoNumDecimals</option></entry>
           </row>
           <row>
-            <entry><option>-XMagicHash</option></entry>
-            <entry>Allow "#" as a <link linkend="magic-hash">postfix modifier on identifiers</link>.</entry>
+            <entry><option>-XOverlappingInstances</option></entry>
+            <entry>Enable <link linkend="instance-overlap">overlapping instances</link>.</entry>
             <entry>dynamic</entry>
-            <entry><option>-XNoMagicHash</option></entry>
+            <entry><option>-XNoOverlappingInstances</option></entry>
           </row>
           <row>
-            <entry><option>-XExplicitForAll</option></entry>
-            <entry>Enable <link linkend="explicit-foralls">explicit universal quantification</link>.
-              Implied by <option>-XScopedTypeVariables</option>,
-              <option>-XLiberalTypeSynonyms</option>,
-              <option>-XRankNTypes</option>,
-              <option>-XExistentialQuantification</option>
+            <entry><option>-XOverloadedLists</option></entry>
+            <entry>Enable <link linkend="overloaded-lists">overloaded lists</link>.
             </entry>
             <entry>dynamic</entry>
-            <entry><option>-XNoExplicitForAll</option></entry>
-          </row>
-          <row>
-            <entry><option>-XPolymorphicComponents</option></entry>
-            <entry>Enable <link linkend="universal-quantification">polymorphic components for data constructors</link>.</entry>
-            <entry>dynamic, synonym for <option>-XRankNTypes</option></entry>
-            <entry><option>-XNoPolymorphicComponents</option></entry>
+            <entry><option>-XNoOverloadedLists</option></entry>
           </row>
           <row>
-            <entry><option>-XRank2Types</option></entry>
-            <entry>Enable <link linkend="universal-quantification">rank-2 types</link>.</entry>
-            <entry>dynamic, synonym for <option>-XRankNTypes</option></entry>
-            <entry><option>-XNoRank2Types</option></entry>
+            <entry><option>-XOverloadedStrings</option></entry>
+            <entry>Enable <link linkend="overloaded-strings">overloaded string literals</link>.
+            </entry>
+            <entry>dynamic</entry>
+            <entry><option>-XNoOverloadedStrings</option></entry>
           </row>
           <row>
-            <entry><option>-XRankNTypes</option></entry>
-            <entry>Enable <link linkend="universal-quantification">rank-N types</link>.</entry>
+            <entry><option>-XPackageImports</option></entry>
+            <entry>Enable <link linkend="package-imports">package-qualified imports</link>.</entry>
             <entry>dynamic</entry>
-            <entry><option>-XNoRankNTypes</option></entry>
+            <entry><option>-XNoPackageImports</option></entry>
           </row>
           <row>
-            <entry><option>-XImpredicativeTypes</option></entry>
-            <entry>Enable <link linkend="impredicative-polymorphism">impredicative types</link>.</entry>
+            <entry><option>-XParallelArrays</option></entry>
+            <entry>Enable parallel arrays.
+              Implies <option>-XParallelListComp</option>.</entry>
             <entry>dynamic</entry>
-            <entry><option>-XNoImpredicativeTypes</option></entry>
+            <entry><option>-XNoParallelArrays</option></entry>
           </row>
           <row>
-            <entry><option>-XExistentialQuantification</option></entry>
-            <entry>Enable <link linkend="existential-quantification">existential quantification</link>.</entry>
+            <entry><option>-XParallelListComp</option></entry>
+            <entry>Enable <link linkend="parallel-list-comprehensions">parallel list comprehensions</link>.
+              Implied by <option>-XParallelArrays</option>.</entry>
             <entry>dynamic</entry>
-            <entry><option>-XNoExistentialQuantification</option></entry>
+            <entry><option>-XNoParallelListComp</option></entry>
           </row>
           <row>
-            <entry><option>-XKindSignatures</option></entry>
-            <entry>Enable <link linkend="kinding">kind signatures</link>.</entry>
+            <entry><option>-XPatternGuards</option></entry>
+            <entry>Enable <link linkend="pattern-guards">pattern guards</link>.</entry>
             <entry>dynamic</entry>
-            <entry><option>-XNoKindSignatures</option></entry>
+            <entry><option>-XNoPatternGuards</option></entry>
           </row>
           <row>
-            <entry><option>-XEmptyDataDecls</option></entry>
-            <entry>Enable empty data declarations.</entry>
+            <entry><option>-XPatternSynonyms</option></entry>
+            <entry>Enable <link linkend="pattern-synonyms">pattern synonyms</link>.</entry>
             <entry>dynamic</entry>
-            <entry><option>-XNoEmptyDataDecls</option></entry>
+            <entry><option>-XNoPatternSynonyms</option></entry>
           </row>
           <row>
-            <entry><option>-XParallelListComp</option></entry>
-            <entry>Enable <link linkend="parallel-list-comprehensions">parallel list comprehensions</link>.</entry>
+            <entry><option>-XPolyKinds</option></entry>
+            <entry>Enable <link linkend="kind-polymorphism">kind polymorphism</link>.
+                   Implies <option>-XKindSignatures</option>.</entry>
             <entry>dynamic</entry>
-            <entry><option>-XNoParallelListComp</option></entry>
+            <entry><option>-XNoPolyKinds</option></entry>
           </row>
           <row>
-            <entry><option>-XTransformListComp</option></entry>
-            <entry>Enable <link linkend="generalised-list-comprehensions">generalised list comprehensions</link>.</entry>
-            <entry>dynamic</entry>
-            <entry><option>-XNoTransformListComp</option></entry>
+            <entry><option>-XPolymorphicComponents</option></entry>
+            <entry>Enable <link linkend="universal-quantification">polymorphic components for data constructors</link>.</entry>
+            <entry>dynamic, synonym for <option>-XRankNTypes</option></entry>
+            <entry><option>-XNoPolymorphicComponents</option></entry>
           </row>
           <row>
-            <entry><option>-XMonadComprehensions</option></entry>
-            <entry>Enable <link linkend="monad-comprehensions">monad comprehensions</link>.</entry>
+            <entry><option>-XPostfixOperators</option></entry>
+            <entry>Enable <link linkend="postfix-operators">postfix operators</link>.</entry>
             <entry>dynamic</entry>
-            <entry><option>-XNoMonadComprehensions</option></entry>
+            <entry><option>-XNoPostfixOperators</option></entry>
           </row>
           <row>
-            <entry><option>-XUnliftedFFITypes</option></entry>
-            <entry>Enable unlifted FFI types.</entry>
+            <entry><option>-XQuasiQuotes</option></entry>
+            <entry>Enable <link linkend="th-quasiquotation">quasiquotation</link>.</entry>
             <entry>dynamic</entry>
-            <entry><option>-XNoUnliftedFFITypes</option></entry>
+            <entry><option>-XNoQuasiQuotes</option></entry>
           </row>
           <row>
-            <entry><option>-XInterruptibleFFI</option></entry>
-            <entry>Enable interruptible FFI.</entry>
-            <entry>dynamic</entry>
-            <entry><option>-XNoInterruptibleFFI</option></entry>
+            <entry><option>-XRank2Types</option></entry>
+            <entry>Enable <link linkend="universal-quantification">rank-2 types</link>.</entry>
+            <entry>dynamic, synonym for <option>-XRankNTypes</option></entry>
+            <entry><option>-XNoRank2Types</option></entry>
           </row>
           <row>
-            <entry><option>-XLiberalTypeSynonyms</option></entry>
-            <entry>Enable <link linkend="type-synonyms">liberalised type synonyms</link>.</entry>
+            <entry><option>-XRankNTypes</option></entry>
+            <entry>Enable <link linkend="universal-quantification">rank-N types</link>.
+              Implied by <option>-XImpredicativeTypes</option>.</entry>
             <entry>dynamic</entry>
-            <entry><option>-XNoLiberalTypeSynonyms</option></entry>
+            <entry><option>-XNoRankNTypes</option></entry>
           </row>
           <row>
-            <entry><option>-XTypeOperators</option></entry>
-            <entry>Enable <link linkend="type-operators">type operators</link>.</entry>
+            <entry><option>-XRebindableSyntax</option></entry>
+            <entry>Employ <link linkend="rebindable-syntax">rebindable syntax</link>.
+              Implies <option>-XNoImplicitPrelude</option>.</entry>
             <entry>dynamic</entry>
-            <entry><option>-XNoTypeOperators</option></entry>
+            <entry><option>-XNoRebindableSyntax</option></entry>
           </row>
           <row>
-            <entry><option>-XExplicitNamespaces</option></entry>
-            <entry>Enable using the keyword <literal>type</literal> to specify the namespace of
-                   entries in imports and exports (<xref linkend="explicit-namespaces"/>).
-                   Implied by <option>-XTypeOperators</option> and <option>-XTypeFamilies</option>.</entry>
+            <entry><option>-XRecordWildCards</option></entry>
+            <entry>Enable <link linkend="record-wildcards">record wildcards</link>.
+              Implies <option>-XDisambiguateRecordFields</option>.</entry>
             <entry>dynamic</entry>
-            <entry><option>-XNoExplicitNamespaces</option></entry>
+            <entry><option>-XNoRecordWildCards</option></entry>
           </row>
           <row>
             <entry><option>-XRecursiveDo</option></entry>
@@ -1104,34 +1182,30 @@
             <entry><option>-XNoRecursiveDo</option></entry>
           </row>
           <row>
-            <entry><option>-XParallelArrays</option></entry>
-            <entry>Enable parallel arrays.</entry>
-            <entry>dynamic</entry>
-            <entry><option>-XNoParallelArrays</option></entry>
-          </row>
-          <row>
-            <entry><option>-XRecordWildCards</option></entry>
-            <entry>Enable <link linkend="record-wildcards">record wildcards</link>.</entry>
+            <entry><option>-XRelaxedPolyRec</option></entry>
+            <entry><emphasis>(deprecated)</emphasis> Relaxed checking for 
+              <link linkend="typing-binds">mutually-recursive polymorphic functions</link>.</entry>
             <entry>dynamic</entry>
-            <entry><option>-XNoRecordWildCards</option></entry>
+            <entry><option>-XNoRelaxedPolyRec</option></entry>
           </row>
           <row>
-            <entry><option>-XNamedFieldPuns</option></entry>
-            <entry>Enable <link linkend="record-puns">record puns</link>.</entry>
+            <entry><option>-XRoleAnnotations</option></entry>
+            <entry>Enable <link linkend="role-annotations">role annotations</link>.</entry>
             <entry>dynamic</entry>
-            <entry><option>-XNoNamedFieldPuns</option></entry>
+            <entry><option>-XNoRoleAnnotations</option></entry>
           </row>
           <row>
-            <entry><option>-XDisambiguateRecordFields</option></entry>
-            <entry>Enable  <link linkend="disambiguate-fields">record field disambiguation</link>. </entry>
+            <entry><option>-XSafe</option></entry>
+            <entry>Enable the <link linkend="safe-haskell">Safe Haskell</link> Safe mode.</entry>
             <entry>dynamic</entry>
-            <entry><option>-XNoDisambiguateRecordFields</option></entry>
+            <entry><option>-</option></entry>
           </row>
           <row>
-            <entry><option>-XUnboxedTuples</option></entry>
-            <entry>Enable <link linkend="unboxed-tuples">unboxed tuples</link>.</entry>
+            <entry><option>-XScopedTypeVariables</option></entry>
+            <entry>Enable <link linkend="scoped-type-variables">lexically-scoped type variables</link>.
+              </entry>
             <entry>dynamic</entry>
-            <entry><option>-XNoUnboxedTuples</option></entry>
+            <entry><option>-XNoScopedTypeVariables</option></entry>
           </row>
           <row>
             <entry><option>-XStandaloneDeriving</option></entry>
@@ -1140,83 +1214,80 @@
             <entry><option>-XNoStandaloneDeriving</option></entry>
           </row>
           <row>
-            <entry><option>-XTypeSynonymInstances</option></entry>
-            <entry>Enable <link linkend="flexible-instance-head">type synonyms in instance heads</link>.</entry>
-            <entry>dynamic</entry>
-            <entry><option>-XNoTypeSynonymInstances</option></entry>
-          </row>
-          <row>
-            <entry><option>-XFlexibleContexts</option></entry>
-            <entry>Enable <link linkend="flexible-contexts">flexible contexts</link>.</entry>
+            <entry><option>-XTemplateHaskell</option></entry>
+            <entry>Enable <link linkend="template-haskell">Template Haskell</link>.</entry>
             <entry>dynamic</entry>
-            <entry><option>-XNoFlexibleContexts</option></entry>
+            <entry><option>-XNoTemplateHaskell</option></entry>
           </row>
           <row>
-            <entry><option>-XFlexibleInstances</option></entry>
-            <entry>Enable <link linkend="instance-rules">flexible instances</link>.
-              Implies <option>-XTypeSynonymInstances</option> </entry>
+            <entry><option>-XNoTraditionalRecordSyntax</option></entry>
+            <entry>Disable support for traditional record syntax (as supported by Haskell 98) <literal>C {f = x}</literal></entry>
             <entry>dynamic</entry>
-            <entry><option>-XNoFlexibleInstances</option></entry>
+            <entry><option>-XTraditionalRecordSyntax</option></entry>
           </row>
           <row>
-            <entry><option>-XConstrainedClassMethods</option></entry>
-            <entry>Enable <link linkend="class-method-types">constrained class methods</link>.</entry>
+            <entry><option>-XTransformListComp</option></entry>
+            <entry>Enable <link linkend="generalised-list-comprehensions">generalised list comprehensions</link>.</entry>
             <entry>dynamic</entry>
-            <entry><option>-XNoConstrainedClassMethods</option></entry>
+            <entry><option>-XNoTransformListComp</option></entry>
           </row>
           <row>
-            <entry><option>-XDefaultSignatures</option></entry>
-            <entry>Enable <link linkend="class-default-signatures">default signatures</link>.</entry>
+            <entry><option>-XTrustworthy</option></entry>
+            <entry>Enable the <link linkend="safe-haskell">Safe Haskell</link> Trustworthy mode.</entry>
             <entry>dynamic</entry>
-            <entry><option>-XNoDefaultSignatures</option></entry>
+            <entry><option>-</option></entry>
           </row>
           <row>
-            <entry><option>-XMultiParamTypeClasses</option></entry>
-            <entry>Enable <link linkend="multi-param-type-classes">multi parameter type classes</link>.</entry>
+            <entry><option>-XTupleSections</option></entry>
+            <entry>Enable <link linkend="tuple-sections">tuple sections</link>.</entry>
             <entry>dynamic</entry>
-            <entry><option>-XNoMultiParamTypeClasses</option></entry>
+            <entry><option>-XNoTupleSections</option></entry>
           </row>
           <row>
-            <entry><option>-XNullaryTypeClasses</option></entry>
-            <entry>Enable <link linkend="nullary-type-classes">nullary (no parameter) type classes</link>.</entry>
+            <entry><option>-XTypeFamilies</option></entry>
+            <entry>Enable <link linkend="type-families">type families</link>.
+              Implies <option>-XExplicitNamespaces</option>, <option>-XKindSignatures</option>
+              and <option>-XMonoLocalBinds</option>.</entry>
             <entry>dynamic</entry>
-            <entry><option>-XNoNullaryTypeClasses</option></entry>
+            <entry><option>-XNoTypeFamilies</option></entry>
           </row>
           <row>
-            <entry><option>-XFunctionalDependencies</option></entry>
-            <entry>Enable <link linkend="functional-dependencies">functional dependencies</link>.</entry>
+            <entry><option>-XTypeOperators</option></entry>
+            <entry>Enable <link linkend="type-operators">type operators</link>.
+              Implies <option>-XExplicitNamespaces</option>.</entry>
             <entry>dynamic</entry>
-            <entry><option>-XNoFunctionalDependencies</option></entry>
+            <entry><option>-XNoTypeOperators</option></entry>
           </row>
           <row>
-            <entry><option>-XPackageImports</option></entry>
-            <entry>Enable <link linkend="package-imports">package-qualified imports</link>.</entry>
+            <entry><option>-XTypeSynonymInstances</option></entry>
+            <entry>Enable <link linkend="flexible-instance-head">type synonyms in instance heads</link>.
+              Implied by <option>-XFlexibleInstances</option>.</entry>
             <entry>dynamic</entry>
-            <entry><option>-XNoPackageImports</option></entry>
+            <entry><option>-XNoTypeSynonymInstances</option></entry>
           </row>
           <row>
-            <entry><option>-XLambdaCase</option></entry>
-            <entry>Enable <link linkend="lambda-case">lambda-case expressions</link>.</entry>
+            <entry><option>-XUnboxedTuples</option></entry>
+            <entry>Enable <link linkend="unboxed-tuples">unboxed tuples</link>.</entry>
             <entry>dynamic</entry>
-            <entry><option>-XNoLambdaCase</option></entry>
+            <entry><option>-XNoUnboxedTuples</option></entry>
           </row>
           <row>
-            <entry><option>-XMultiWayIf</option></entry>
-            <entry>Enable <link linkend="multi-way-if">multi-way if-expressions</link>.</entry>
+            <entry><option>-XUndecidableInstances</option></entry>
+            <entry>Enable <link linkend="undecidable-instances">undecidable instances</link>.</entry>
             <entry>dynamic</entry>
-            <entry><option>-XNoMultiWayIf</option></entry>
+            <entry><option>-XNoUndecidableInstances</option></entry>
           </row>
           <row>
-            <entry><option>-XSafe</option></entry>
-            <entry>Enable the <link linkend="safe-haskell">Safe Haskell</link> Safe mode.</entry>
+            <entry><option>-XUnicodeSyntax</option></entry>
+            <entry>Enable <link linkend="unicode-syntax">unicode syntax</link>.</entry>
             <entry>dynamic</entry>
-            <entry><option>-</option></entry>
+            <entry><option>-XNoUnicodeSyntax</option></entry>
           </row>
           <row>
-            <entry><option>-XTrustworthy</option></entry>
-            <entry>Enable the <link linkend="safe-haskell">Safe Haskell</link> Trustworthy mode.</entry>
+            <entry><option>-XUnliftedFFITypes</option></entry>
+            <entry>Enable unlifted FFI types.</entry>
             <entry>dynamic</entry>
-            <entry><option>-</option></entry>
+            <entry><option>-XNoUnliftedFFITypes</option></entry>
           </row>
           <row>
             <entry><option>-XUnsafe</option></entry>
@@ -1225,10 +1296,10 @@
             <entry><option>-</option></entry>
           </row>
           <row>
-            <entry><option>-fpackage-trust</option></entry>
-            <entry>Enable <link linkend="safe-haskell">Safe Haskell</link> trusted package requirement for trustworthy modules.</entry>
+            <entry><option>-XViewPatterns</option></entry>
+            <entry>Enable <link linkend="view-patterns">view patterns</link>.</entry>
             <entry>dynamic</entry>
-            <entry><option>-</option></entry>
+            <entry><option>-XNoViewPatterns</option></entry>
           </row>
         </tbody>
       </tgroup>
@@ -1516,7 +1587,7 @@
 
           <row>
             <entry><option>-fwarn-amp</option></entry>
-            <entry>warn on definitions conflicting with the Applicative-Monad Proposal (AMP)</entry>
+            <entry><emphasis>(deprecated)</emphasis> warn on definitions conflicting with the Applicative-Monad Proposal (AMP)</entry>
             <entry>dynamic</entry>
             <entry><option>-fno-warn-amp</option></entry>
           </row>
@@ -1890,6 +1961,43 @@
             <entry><option>-fno-unfolding-use-threshold</option></entry>
           </row>
 
+          <row>
+            <entry><option>-fmax-inline-alloc-size</option>=<replaceable>n</replaceable></entry>
+            <entry>Set the maximum size of inline array allocations to
+            <replaceable>n</replaceable> bytes (default: 128). GHC
+            will allocate non-pinned arrays of statically known size
+            in the current nursery block if they're no bigger than
+            <replaceable>n</replaceable> bytes, ignoring GC overheap.
+            This value should be quite a bit smaller than the block
+            size (typically: 4096).</entry>
+            <entry>dynamic</entry>
+            <entry>-</entry>
+          </row>
+
+          <row>
+            <entry>
+            <option>-fmax-inline-memcpy-insns</option>=<replaceable>n</replaceable>
+            </entry>
+            <entry>Inline memcpy calls if they would generate no more
+            than <replaceable>n</replaceable> pseudo instructions
+            (default: 32).
+            </entry>
+            <entry>dynamic</entry>
+            <entry>-</entry>
+          </row>
+
+          <row>
+            <entry>
+            <option>-fmax-inline-memset-insns</option>=<replaceable>n</replaceable>
+            </entry>
+            <entry>Inline memset calls if they would generate no more
+            than <replaceable>n</replaceable> pseudo instructions
+            (default: 32).
+            </entry>
+            <entry>dynamic</entry>
+            <entry>-</entry>
+          </row>
+
         </tbody>
       </tgroup>
     </informaltable>
@@ -2106,6 +2214,12 @@
             <entry>dynamic</entry>
             <entry>-</entry>
           </row>
+          <row>
+            <entry><option>-fwrite-interface</option></entry>
+            <entry>Always write interface files</entry>
+            <entry>dynamic</entry>
+            <entry>-</entry>
+          </row>
           <row>
             <entry><option>-fbyte-code</option></entry>
             <entry>Generate byte-code</entry>
@@ -2515,12 +2629,6 @@
             <entry>dynamic</entry>
             <entry>-</entry>
           </row>
-          <row>
-            <entry><option>-optm</option> <replaceable>option</replaceable></entry>
-            <entry>pass <replaceable>option</replaceable> to the mangler</entry>
-            <entry>dynamic</entry>
-            <entry>-</entry>
-          </row>
           <row>
             <entry><option>-opta</option> <replaceable>option</replaceable></entry>
             <entry>pass <replaceable>option</replaceable> to the assembler</entry>
@@ -2573,42 +2681,6 @@
             <entry>-</entry>
           </row>
         </tbody>
-        <tbody>
-          <row>
-            <entry><option>-monly-[432]-regs</option></entry>
-            <entry>(x86 only) give some registers back to the C compiler</entry>
-            <entry>dynamic</entry>
-            <entry>-</entry>
-          </row>
-        </tbody>
-      </tgroup>
-    </informaltable>
-  </sect2>
-
-
-  <sect2>
-    <title>External core file options</title>
-
-    <para><xref linkend="ext-core"/></para>
-
-    <informaltable>
-      <tgroup cols="4" align="left" colsep="1" rowsep="1">
-        <thead>
-          <row>
-            <entry>Flag</entry>
-            <entry>Description</entry>
-            <entry>Static/Dynamic</entry>
-            <entry>Reverse</entry>
-          </row>
-        </thead>
-        <tbody>
-          <row>
-            <entry><option>-fext-core</option></entry>
-            <entry>Generate <filename>.hcr</filename> external Core files</entry>
-            <entry>dynamic</entry>
-            <entry>-</entry>
-          </row>
-        </tbody>
       </tgroup>
     </informaltable>
   </sect2>
@@ -3023,7 +3095,7 @@
         </thead>
         <tbody>
           <row>
-            <entry><option>-j <replaceable>N</replaceable></option></entry>
+            <entry><option>-j<replaceable>N</replaceable></option></entry>
             <entry>When compiling with <literal>--make</literal>, compile <replaceable>N</replaceable> modules in parallel.</entry>
             <entry>dynamic</entry>
             <entry>-</entry>
diff --git a/docs/users_guide/ghci.xml b/docs/users_guide/ghci.xml
index 912ecb25ce7d..729f96f24422 100644
--- a/docs/users_guide/ghci.xml
+++ b/docs/users_guide/ghci.xml
@@ -2432,7 +2432,9 @@ Prelude> :. cmds.ghci
         <listitem>
           <para>Opens an editor to edit the file
           <replaceable>file</replaceable>, or the most recently loaded
-          module if <replaceable>file</replaceable> is omitted.  The
+          module if <replaceable>file</replaceable> is omitted.
+          If there were errors during the last loading,
+          the cursor will be positioned at the line of the first error. The
           editor to invoke is taken from the <literal>EDITOR</literal>
           environment variable, or a default editor on your system if
           <literal>EDITOR</literal> is not set.  You can change the
@@ -3294,12 +3296,38 @@ Prelude> :set -fno-warn-incomplete-patterns -XNoMultiParamTypeClasses
       <title>Setting options for interactive evaluation only</title>
 
       <para>
-        GHCi actually maintains two sets of options: one set that
-        applies when loading modules, and another set that applies for
-        expressions and commands typed at the prompt.  The
-        <literal>:set</literal> command modifies both, but there is
+        GHCi actually maintains <emphasis>two</emphasis> sets of options: 
+<itemizedlist>
+<listitem><para>
+  The <emphasis>loading options</emphasis> apply when loading modules
+</para></listitem>
+<listitem><para>
+  The <emphasis>interactive options</emphasis> apply when evaluating expressions and commands typed at the GHCi prompt.
+</para></listitem>
+</itemizedlist>
+The <literal>:set</literal> command modifies both, but there is
         also a <literal>:seti</literal> command (for "set
-        interactive") that affects only the second set.
+        interactive") that affects only the interactive options set.
+      </para>
+
+      <para>
+        It is often useful to change the interactive options, 
+        without having that option apply to loaded modules
+        too.  For example
+<screen>
+:seti -XMonoLocalBinds
+</screen>
+        It would be undesirable if <option>-XMonoLocalBinds</option> were to
+        apply to loaded modules too: that might cause a compilation error, but
+        more commonly it will cause extra recompilation, because GHC will think
+        that it needs to recompile the module because the flags have changed.
+      </para>
+
+      <para>
+        If you are setting language options in your <literal>.ghci</literal> file, it is good practice
+        to use <literal>:seti</literal> rather than <literal>:set</literal>,
+        unless you really do want them to apply to all modules you
+        load in GHCi.
       </para>
 
       <para>
@@ -3307,8 +3335,6 @@ Prelude> :set -fno-warn-incomplete-patterns -XNoMultiParamTypeClasses
         <literal>:set</literal> and <literal>:seti</literal> commands
         respectively, with no arguments.  For example, in a clean GHCi
         session we might see something like this:
-      </para>
-
 <screen>
 Prelude> :seti
 base language is: Haskell2010
@@ -3322,38 +3348,24 @@ other dynamic, non-language, flag settings:
   -fimplicit-import-qualified
 warning settings:
 </screen>
-      <para>
-        Note that the option <option>-XExtendedDefaultRules</option>
-        is on, because we apply special defaulting rules to
+      </para>
+<para>
+The two sets of options are initialised as follows.  First, both sets of options
+are initialised as described in <xref linkend="ghci-dot-files"/>.
+Then the interactive options are modified as follows:
+<itemizedlist>
+<listitem><para>
+        The option <option>-XExtendedDefaultRules</option>
+        is enabled, in order to apply special defaulting rules to
         expressions typed at the prompt (see <xref
         linkend="extended-default-rules" />).
-      </para>
-
-      <para>
-        Furthermore, the Monomorphism Restriction is disabled by default in
-        GHCi (see <xref linkend="monomorphism" />).
-      </para>
-
-      <para>
-        It is often useful to change the language options for expressions typed
-        at the prompt only, without having that option apply to loaded modules
-        too.  For example
-<screen>
-:seti -XMonoLocalBinds
-</screen>
-        It would be undesirable if <option>-XMonoLocalBinds</option> were to
-        apply to loaded modules too: that might cause a compilation error, but
-        more commonly it will cause extra recompilation, because GHC will think
-        that it needs to recompile the module because the flags have changed.
-      </para>
+      </para></listitem>
 
-      <para>
-        It is therefore good practice if you are setting language
-        options in your <literal>.ghci</literal> file, to use
-        <literal>:seti</literal> rather than <literal>:set</literal>
-        unless you really do want them to apply to all modules you
-        load in GHCi.
-      </para>
+<listitem> <para>
+        The Monomorphism Restriction is disabled (see <xref linkend="monomorphism" />).
+      </para></listitem>
+</itemizedlist>
+</para>
     </sect2>
   </sect1>
 
diff --git a/docs/users_guide/glasgow_exts.xml b/docs/users_guide/glasgow_exts.xml
index 51174171523a..bfdeea4e5879 100644
--- a/docs/users_guide/glasgow_exts.xml
+++ b/docs/users_guide/glasgow_exts.xml
@@ -480,6 +480,26 @@ Indeed, the bindings can even be recursive.
       </para>
    </sect2>
 
+    <sect2 id="binary-literals">
+      <title>Binary integer literals</title>
+      <para>
+          Haskell 2010 and Haskell 98 allows for integer literals to
+          be given in decimal, octal (prefixed by
+          <literal>0o</literal> or <literal>0O</literal>), or
+          hexadecimal notation (prefixed by <literal>0x</literal> or
+          <literal>0X</literal>).
+      </para>
+
+      <para>
+          The language extension <option>-XBinaryLiterals</option>
+          adds support for expressing integer literals in binary
+          notation with the prefix <literal>0b</literal> or
+          <literal>0B</literal>. For instance, the binary integer
+          literal <literal>0b11001001</literal> will be desugared into
+          <literal>fromInteger 201</literal> when
+          <option>-XBinaryLiterals</option> is enabled.
+      </para>
+   </sect2>
 
     <!-- ====================== HIERARCHICAL MODULES =======================  -->
 
@@ -856,9 +876,11 @@ y)</literal> will not be coalesced.
 </title>
 
 <para>
-Pattern synonyms are enabled by the flag <literal>-XPatternSynonyms</literal>.
-More information and examples of view patterns can be found on the
-<ulink url="http://ghc.haskell.org/trac/ghc/wiki/PatternSynonyms">Wiki
+Pattern synonyms are enabled by the flag
+<literal>-XPatternSynonyms</literal>, which is required for both
+defining them <emphasis>and</emphasis> using them.  More information
+and examples of view patterns can be found on the <ulink
+url="http://ghc.haskell.org/trac/ghc/wiki/PatternSynonyms">Wiki
 page</ulink>.
 </para>
 
@@ -965,65 +987,89 @@ Which enables us to rewrite our functions in a much cleaner style:
 In this case, <literal>Head</literal> <replaceable>x</replaceable>
 cannot be used in expressions, only patterns, since it wouldn't
 specify a value for the <replaceable>xs</replaceable> on the
-right-hand side.
+right-hand side. We can give an explicit inversion of a pattern
+synonym using the following syntax:
 </para>
 
-<para>
-The semantics of a unidirectional pattern synonym declaration and
-usage are as follows:
+<programlisting>
+  pattern Head x &lt;- x:xs where
+    Head x = [x]
+</programlisting>
 
-<itemizedlist>
+<para>
+The syntax and semantics of pattern synonyms are elaborated in the
+following subsections.  
+See the <ulink
+url="http://ghc.haskell.org/trac/ghc/wiki/PatternSynonyms">Wiki
+page</ulink> for more details.
+</para>
 
-<listitem> Syntax:
+<sect3> <title>Syntax and scoping of pattern synonyms</title>
 <para>
 A pattern synonym declaration can be either unidirectional or
 bidirectional. The syntax for unidirectional pattern synonyms is:
-</para>
 <programlisting>
   pattern Name args &lt;- pat
 </programlisting>
-<para>
   and the syntax for bidirectional pattern synonyms is:
-</para>
 <programlisting>
   pattern Name args = pat
+</programlisting> or
+<programlisting>
+  pattern Name args &lt;- pat where
+    Name args = expr
 </programlisting>
+  Either prefix or infix syntax can be
+  used.
+</para>
 <para>
   Pattern synonym declarations can only occur in the top level of a
   module. In particular, they are not allowed as local
   definitions. Currently, they also don't work in GHCi, but that is a
   technical restriction that will be lifted in later versions.
 </para>
+<para>
+  The variables in the left-hand side of the definition are bound by
+  the pattern on the right-hand side. For implicitly bidirectional
+  pattern synonyms, all the variables of the right-hand side must also
+  occur on the left-hand side; also, wildcard patterns and view
+  patterns are not allowed. For unidirectional and
+  explicitly-bidirectional pattern synonyms, there is no restriction
+  on the right-hand side pattern.
+</para>
+
+<para>
+  Pattern synonyms cannot be defined recursively.
+</para>
+</sect3>
+
+<sect3 id="patsyn-impexp"> <title>Import and export of pattern synonyms</title>
+
 <para>
   The name of the pattern synonym itself is in the same namespace as
-  proper data constructors. Either prefix or infix syntax can be
-  used. In export/import specifications, you have to prefix pattern
+  proper data constructors. In an export or import specification,
+  you must prefix pattern
   names with the <literal>pattern</literal> keyword, e.g.:
-</para>
 <programlisting>
   module Example (pattern Single) where
   pattern Single x = [x]
 </programlisting>
-</listitem>
-
-<listitem> Scoping:
-
-<para>
-  The variables in the left-hand side of the definition are bound by
-  the pattern on the right-hand side. For bidirectional pattern
-  synonyms, all the variables of the right-hand side must also occur
-  on the left-hand side; also, wildcard patterns and view patterns are
-  not allowed. For unidirectional pattern synonyms, there is no
-  restriction on the right-hand side pattern.
+Without the <literal>pattern</literal> prefix, <literal>Single</literal> would
+be interpreted as a type constructor in the export list.
 </para>
-
 <para>
-  Pattern synonyms cannot be defined recursively.
+You may also use the <literal>pattern</literal> keyword in an import/export
+specification to import or export an ordinary data constructor.  For example:
+<programlisting>
+  import Data.Maybe( pattern Just )
+</programlisting>
+would bring into scope the data constructor <literal>Just</literal> from the
+<literal>Maybe</literal> type, without also bringing the type constructor
+<literal>Maybe</literal> into scope.
 </para>
+</sect3>
 
-</listitem>
-
-<listitem> Typing:
+<sect3> <title>Typing of pattern synonyms</title>
 
 <para>
   Given a pattern synonym definition of the form
@@ -1098,10 +1144,9 @@ pattern (Show b) => ExNumPat b :: (Num a, Eq a) => T a
 <programlisting>
   ExNumPat :: (Show b, Num a, Eq a) => b -> T t
 </programlisting>
+</sect3>
 
-</listitem>
-
-<listitem> Matching:
+<sect3><title>Matching of pattern synonyms</title>
 
 <para>
 A pattern synonym occurrence in a pattern is evaluated by first
@@ -1123,8 +1168,6 @@ f' _                                   = False
 <para>
   Note that the strictness of <literal>f</literal> differs from that
   of <literal>g</literal> defined below:
-</para>
-
 <programlisting>
 g [True, True] = True
 g _            = False
@@ -1134,9 +1177,8 @@ g _            = False
 *Main> g (False:undefined)
 False
 </programlisting>
-</listitem>
-</itemizedlist>
 </para>
+</sect3>
 
 </sect2>
 
@@ -1881,7 +1923,8 @@ the comprehension being over an arbitrary monad.
 	      functions <literal>(>>=)</literal>,
 	      <literal>(>>)</literal>, and <literal>fail</literal>,
 	      are in scope (not the Prelude
-	      versions).  List comprehensions, mdo (<xref linkend="recursive-do-notation"/>), and parallel array
+	      versions).  List comprehensions, <literal>mdo</literal>
+	      (<xref linkend="recursive-do-notation"/>), and parallel array
 	      comprehensions, are unaffected.  </para></listitem>
 
 	      <listitem>
@@ -2389,7 +2432,36 @@ necessary to enable them.
 </sect2>
 
 <sect2 id="package-imports">
-  <title>Package-qualified imports</title>
+<title>Import and export extensions</title>
+
+<sect3>
+  <title>Hiding things the imported module doesn't export</title>
+
+<para>
+Technically in Haskell 2010 this is illegal:
+<programlisting>
+module A( f ) where
+  f = True
+
+module B where
+  import A hiding( g )  -- A does not export g
+  g = f
+</programlisting>
+The <literal>import A hiding( g )</literal> in module <literal>B</literal>
+is technically an error (<ulink url="http://www.haskell.org/onlinereport/haskell2010/haskellch5.html#x11-1020005.3.1">Haskell Report, 5.3.1</ulink>)
+because <literal>A</literal> does not export <literal>g</literal>.
+However GHC allows it, in the interests of supporting backward compatibility; for example, a newer version of
+<literal>A</literal> might export <literal>g</literal>, and you want <literal>B</literal> to work
+in either case.
+</para>
+<para>
+The warning <literal>-fwarn-dodgy-imports</literal>, which is off by default but included with <literal>-W</literal>,
+warns if you hide something that the imported module does not export.
+</para>
+</sect3>
+
+<sect3>
+  <title id="package-qualified-imports">Package-qualified imports</title>
 
   <para>With the <option>-XPackageImports</option> flag, GHC allows
   import declarations to be qualified by the package name that the
@@ -2412,10 +2484,12 @@ import "network" Network.Socket
     added mainly so that we can build backwards-compatible versions of
     packages when APIs change.  It can lead to fragile dependencies in
     the common case: modules occasionally move from one package to
-    another, rendering any package-qualified imports broken.</para>
-</sect2>
+    another, rendering any package-qualified imports broken.
+    See also <xref linkend="package-thinning-and-renaming" /> for
+    an alternative way of disambiguating between module names.</para>
+</sect3>
 
-<sect2 id="safe-imports-ext">
+<sect3 id="safe-imports-ext">
   <title>Safe imports</title>
 
   <para>With the <option>-XSafe</option>, <option>-XTrustworthy</option>
@@ -2433,9 +2507,9 @@ import safe qualified Network.Socket as NS
     safely imported. For a description of when a import is
     considered safe see <xref linkend="safe-haskell"/></para>
 
-</sect2>
+</sect3>
 
-<sect2 id="explicit-namespaces">
+<sect3 id="explicit-namespaces">
 <title>Explicit namespaces in import/export</title>
 
 <para> In an import or export list, such as 
@@ -2463,6 +2537,14 @@ disambiguate this case, thus:
 The extension <option>-XExplicitNamespaces</option>
 is implied by <option>-XTypeOperators</option> and (for some reason) by <option>-XTypeFamilies</option>.
 </para>
+<para>
+In addition, with <option>-XPatternSynonyms</option> you can prefix the name of
+a data constructor in an import or export list with the keyword <literal>pattern</literal>,
+to allow the import or export of a data constructor without its parent type constructor
+(see <xref linkend="patsyn-impexp"/>).
+</para>
+</sect3>
+
 </sect2>
 
 <sect2 id="syntax-stolen">
@@ -3752,8 +3834,16 @@ GHC now allows stand-alone <literal>deriving</literal> declarations, enabled by
 </programlisting>
 The syntax is identical to that of an ordinary instance declaration apart from (a) the keyword
 <literal>deriving</literal>, and (b) the absence of the <literal>where</literal> part.
-Note the following points:
+</para>
+<para>
+However, standalone deriving differs from a <literal>deriving</literal> clause in a number
+of important ways:
 <itemizedlist>
+<listitem><para>The standalone deriving declaration does not need to be in the
+same module as the data type declaration.  (But be aware of the dangers of
+orphan instances (<xref linkend="orphan-modules"/>).
+</para></listitem>
+
 <listitem><para>
 You must supply an explicit context (in the example the context is <literal>(Eq a)</literal>),
 exactly as you would in an ordinary instance declaration.
@@ -3761,12 +3851,6 @@ exactly as you would in an ordinary instance declaration.
 attached to a data type declaration, the context is inferred.)
 </para></listitem>
 
-<listitem><para>
-A <literal>deriving instance</literal> declaration
-must obey the same rules concerning form and termination as ordinary instance declarations,
-controlled by the same flags; see <xref linkend="instance-decls"/>.
-</para></listitem>
-
 <listitem><para>
 Unlike a <literal>deriving</literal>
 declaration attached to a <literal>data</literal> declaration, the instance can be more specific
@@ -3789,6 +3873,8 @@ declaration attached to a <literal>data</literal> declaration,
 GHC does not restrict the form of the data type.  Instead, GHC simply generates the appropriate
 boilerplate code for the specified class, and typechecks it. If there is a type error, it is
 your problem. (GHC will show you the offending code if it has a type error.)
+</para>
+<para>
 The merit of this is that you can derive instances for GADTs and other exotic
 data types, providing only that the boilerplate code does indeed typecheck.  For example:
 <programlisting>
@@ -3803,7 +3889,24 @@ data type declaration for <literal>T</literal>,
 because <literal>T</literal> is a GADT, but you <emphasis>can</emphasis> generate
 the instance declaration using stand-alone deriving.
 </para>
+<para>
+The down-side is that,
+if the boilerplate code fails to typecheck, you will get an error message about that
+code, which you did not write.  Whereas, with a <literal>deriving</literal> clause
+the side-conditions are necessarily more conservative, but any error message
+may be more comprehensible.
+</para>
 </listitem>
+</itemizedlist></para>
+
+<para>
+In other ways, however, a standalone deriving obeys the same rules as ordinary deriving:
+<itemizedlist>
+<listitem><para>
+A <literal>deriving instance</literal> declaration
+must obey the same rules concerning form and termination as ordinary instance declarations,
+controlled by the same flags; see <xref linkend="instance-decls"/>.
+</para></listitem>
 
 <listitem>
 <para>The stand-alone syntax is generalised for newtypes in exactly the same
@@ -3821,9 +3924,8 @@ GHC always treats the <emphasis>last</emphasis> parameter of the instance
 
 </sect2>
 
-
-<sect2 id="deriving-typeable">
-<title>Deriving clause for extra classes (<literal>Typeable</literal>, <literal>Data</literal>, etc)</title>
+<sect2 id="deriving-extra">
+<title>Deriving instances of extra classes (<literal>Data</literal>, etc)</title>
 
 <para>
 Haskell 98 allows the programmer to add "<literal>deriving( Eq, Ord )</literal>" to a data type
@@ -3835,27 +3937,6 @@ classes <literal>Eq</literal>, <literal>Ord</literal>,
 <para>
 GHC extends this list with several more classes that may be automatically derived:
 <itemizedlist>
-<listitem><para> With <option>-XDeriveDataTypeable</option>, you can derive instances of the classes
-<literal>Typeable</literal>, and <literal>Data</literal>, defined in the library
-modules <literal>Data.Typeable</literal> and <literal>Data.Data</literal> respectively.
-</para>
-<para>Since GHC 7.8.1, <literal>Typeable</literal> is kind-polymorphic (see
-<xref linkend="kind-polymorphism"/>) and can be derived for any datatype and
-type class. Instances for datatypes can be derived by attaching a
-<literal>deriving Typeable</literal> clause to the datatype declaration, or by
-using standalone deriving (see <xref linkend="stand-alone-deriving"/>).
-Instances for type classes can only be derived using standalone deriving.
-For data families, <literal>Typeable</literal> should only be derived for the
-uninstantiated family type; each instance will then automatically have a
-<literal>Typeable</literal> instance too.
-See also <xref linkend="auto-derive-typeable"/>.
-</para>
-<para>
-Also since GHC 7.8.1, handwritten (ie. not derived) instances of
-<literal>Typeable</literal> are forbidden, and will result in an error.
-</para>
-</listitem>
-
 <listitem><para> With <option>-XDeriveGeneric</option>, you can derive
 instances of the classes <literal>Generic</literal> and
 <literal>Generic1</literal>, defined in <literal>GHC.Generics</literal>.
@@ -3868,6 +3949,12 @@ the class <literal>Functor</literal>,
 defined in <literal>GHC.Base</literal>.
 </para></listitem>
 
+<listitem><para> With <option>-XDeriveDataTypeable</option>, you can derive instances of
+the class <literal>Data</literal>,
+defined in <literal>Data.Data</literal>.  See <xref linkend="deriving-typeable"/> for 
+deriving <literal>Typeable</literal>.
+</para></listitem>
+
 <listitem><para> With <option>-XDeriveFoldable</option>, you can derive instances of
 the class <literal>Foldable</literal>,
 defined in <literal>Data.Foldable</literal>.
@@ -3875,24 +3962,73 @@ defined in <literal>Data.Foldable</literal>.
 
 <listitem><para> With <option>-XDeriveTraversable</option>, you can derive instances of
 the class <literal>Traversable</literal>,
-defined in <literal>Data.Traversable</literal>.
+defined in <literal>Data.Traversable</literal>. Since the <literal>Traversable</literal>
+instance dictates the instances of <literal>Functor</literal> and 
+<literal>Foldable</literal>, you'll probably want to derive them too, so
+<option>-XDeriveTraversable</option> implies
+<option>-XDeriveFunctor</option> and <option>-XDeriveFoldable</option>.
 </para></listitem>
 </itemizedlist>
+You can also use a standalone deriving declaration instead
+(see <xref linkend="stand-alone-deriving"/>).
+</para>
+<para>
 In each case the appropriate class must be in scope before it
 can be mentioned in the <literal>deriving</literal> clause.
 </para>
 </sect2>
 
-<sect2 id="auto-derive-typeable">
-<title>Automatically deriving <literal>Typeable</literal> instances</title>
+<sect2 id="deriving-typeable">
+<title>Deriving <literal>Typeable</literal> instances</title>
 
-<para>
+<para>The class <literal>Typeable</literal> is very special:
+<itemizedlist>
+<listitem><para>
+<literal>Typeable</literal> is kind-polymorphic (see
+<xref linkend="kind-polymorphism"/>).
+</para></listitem>
+
+<listitem><para>
+Only derived instances of <literal>Typeable</literal> are allowed;
+i.e. handwritten instances are forbidden.  This ensures that the
+programmer cannot subert the type system by writing bogus instances.
+</para></listitem>
+
+<listitem><para>
+With <option>-XDeriveDataTypeable</option> 
+GHC allows you to derive instances of <literal>Typeable</literal> for data types or newtypes,
+using a <literal>deriving</literal> clause, or using 
+a standalone deriving declaration (<xref linkend="stand-alone-deriving"/>).
+</para></listitem>
+
+<listitem><para>
+With <option>-XDataKinds</option>, deriving <literal>Typeable</literal> for a data
+type (whether via a deriving clause or standalone deriving)
+also derives <literal>Typeable</literal> for the promoted data constructors (<xref linkend="promotion"/>).
+</para></listitem>
+
+<listitem><para>
+However, using standalone deriving, you can <emphasis>also</emphasis> derive
+a <literal>Typeable</literal> instance for a data family.
+You may not add a <literal>deriving(Typeable)</literal> clause to a
+<literal>data instance</literal> declaration; instead you must use a
+standalone deriving declaration for the data family.
+</para></listitem>
+
+<listitem><para>
+Using standalone deriving, you can <emphasis>also</emphasis> derive
+a <literal>Typeable</literal> instance for a type class.
+</para></listitem>
+
+<listitem><para>
 The flag <option>-XAutoDeriveTypeable</option> triggers the generation
-of derived <literal>Typeable</literal> instances for every datatype and type
-class declaration in the module it is used. It will also generate
-<literal>Typeable</literal> instances for any promoted data constructors
-(<xref linkend="promotion"/>). This flag implies
-<option>-XDeriveDataTypeable</option> (<xref linkend="deriving-typeable"/>).
+of derived <literal>Typeable</literal> instances for every datatype, data family, 
+and type class declaration in the module it is used, unless a manually-specified one is
+already provided.
+This flag implies <option>-XDeriveDataTypeable</option>.
+</para></listitem>
+</itemizedlist>
+
 </para>
 
 </sect2>
@@ -4018,47 +4154,52 @@ the newtype and its representation.
 
 <sect3> <title> A more precise specification </title>
 <para>
-Derived instance declarations are constructed as follows. Consider the
-declaration (after expansion of any type synonyms)
+A derived instance is derived only for declarations of these forms (after expansion of any type synonyms)
 
 <programlisting>
-  newtype T v1...vn = T' (t vk+1...vn) deriving (c1...cm)
+  newtype T v1..vn                   = MkT (t vk+1..vn) deriving (C t1..tj)
+  newtype instance T s1..sk vk+1..vn = MkT (t vk+1..vn) deriving (C t1..tj)
 </programlisting>
-
 where
  <itemizedlist>
 <listitem><para>
-  The <literal>ci</literal> are partial applications of
-  classes of the form <literal>C t1'...tj'</literal>, where the arity of <literal>C</literal>
+<literal>v1..vn</literal> are type variables, and <literal>t</literal>, 
+<literal>s1..sk</literal>, <literal>t1..tj</literal> are types.
+</para></listitem>
+<listitem><para>
+  The <literal>(C t1..tj)</literal> is a partial applications of the class <literal>C</literal>,
+  where the arity of <literal>C</literal>
   is exactly <literal>j+1</literal>.  That is, <literal>C</literal> lacks exactly one type argument.
 </para></listitem>
 <listitem><para>
-  The <literal>k</literal> is chosen so that <literal>ci (T v1...vk)</literal> is well-kinded.
+  <literal>k</literal> is chosen so that <literal>C t1..tj (T v1...vk)</literal> is well-kinded.
+(Or, in the case of a <literal>data instance</literal>, so that <literal>C t1..tj (T s1..sk)</literal> is
+well kinded.)
 </para></listitem>
 <listitem><para>
   The type <literal>t</literal> is an arbitrary type.
 </para></listitem>
 <listitem><para>
-  The type variables <literal>vk+1...vn</literal> do not occur in <literal>t</literal>,
-  nor in the <literal>ci</literal>, and
+  The type variables <literal>vk+1...vn</literal> do not occur in the types <literal>t</literal>,
+  <literal>s1..sk</literal>, or <literal>t1..tj</literal>.
 </para></listitem>
 <listitem><para>
-  None of the <literal>ci</literal> is <literal>Read</literal>, <literal>Show</literal>,
+  <literal>C</literal> is not <literal>Read</literal>, <literal>Show</literal>,
 		<literal>Typeable</literal>, or <literal>Data</literal>.  These classes
 		should not "look through" the type or its constructor.  You can still
 		derive these classes for a newtype, but it happens in the usual way, not
 		via this new mechanism.
 </para></listitem>
 <listitem><para>
-  It is safe to coerce each of the methods of <literal>ci</literal>. That is,
-  the missing last argument to each of the <literal>ci</literal> is not used
-  at a nominal role in any of the <literal>ci</literal>'s methods.
+  It is safe to coerce each of the methods of <literal>C</literal>. That is,
+  the missing last argument to <literal>C</literal> is not used
+  at a nominal role in any of the <literal>C</literal>'s methods.
   (See <xref linkend="roles"/>.)</para></listitem>
 </itemizedlist>
-Then, for each <literal>ci</literal>, the derived instance
+Then the derived instance is of form
 declaration is:
 <programlisting>
-  instance ci t => ci (T v1...vk)
+  instance C t1..tj t => C t1..tj (T v1...vk)
 </programlisting>
 As an example which does <emphasis>not</emphasis> work, consider
 <programlisting>
@@ -4260,7 +4401,9 @@ We use default signatures to simplify generic programming in GHC
 
 <sect3 id="nullary-type-classes">
 <title>Nullary type classes</title>
-Nullary (no parameter) type classes are enabled with <option>-XNullaryTypeClasses</option>.
+Nullary (no parameter) type classes are enabled with
+<option>-XMultiTypeClasses</option>; historically, they were enabled with the
+(now deprecated) <option>-XNullaryTypeClasses</option>.
 Since there are no available parameters, there can be at most one instance
 of a nullary class. A nullary type class might be used to document some assumption
 in a type signature (such as reliance on the Riemann hypothesis) or add some
@@ -4881,40 +5024,128 @@ with <option>-fcontext-stack=</option><emphasis>N</emphasis>.
 In general, as discussed in <xref linkend="instance-resolution"/>,
 <emphasis>GHC requires that it be unambiguous which instance
 declaration
-should be used to resolve a type-class constraint</emphasis>. This behaviour
-can be modified by two flags: <option>-XOverlappingInstances</option>
+should be used to resolve a type-class constraint</emphasis>.
+GHC also provides a way to to loosen
+the instance resolution, by
+allowing more than one instance to match, <emphasis>provided there is a most
+specific one</emphasis>.  Moreover, it can be loosened further, by allowing more than one instance to match
+irespective of whether there is a most specific one.
+This section gives the details.
+</para>
+<para>
+To control the choice of instance, it is possible to specify the overlap behavior for individual
+instances with a pragma, written immediately after the
+<literal>instance</literal> keyword.  The pragma may be one of:
+<literal>{-# OVERLAPPING #-}</literal>,
+<literal>{-# OVERLAPPABLE #-}</literal>,
+<literal>{-# OVERLAPS #-}</literal>,
+or <literal>{-# INCOHERENT #-}</literal>.
+</para>
+<para>
+The matching behaviour is also influenced by two module-level language extension flags: <option>-XOverlappingInstances</option>
 <indexterm><primary>-XOverlappingInstances
 </primary></indexterm>
 and <option>-XIncoherentInstances</option>
 <indexterm><primary>-XIncoherentInstances
-</primary></indexterm>, as this section discusses.  Both these
-flags are dynamic flags, and can be set on a per-module basis, using
-an <literal>LANGUAGE</literal> pragma if desired (<xref linkend="language-pragma"/>).</para>
+</primary></indexterm>.   These flags are now deprecated (since GHC 7.10) in favour of
+the fine-grained per-instance pragmas.
+</para>
+
 <para>
-The <option>-XOverlappingInstances</option> flag instructs GHC to loosen
-the instance resolution described in <xref linkend="instance-resolution"/>, by
-allowing more than one instance to match, <emphasis>provided there is a most
-specific one</emphasis>. The <option>-XIncoherentInstances</option> flag
-further loosens the resolution, by allowing more than one instance to match,
-irespective of whether there is a most specific one.
+A more precise specification is as follows.
+The willingness to be overlapped or incoherent is a property of
+the <emphasis>instance declaration</emphasis> itself, controlled as follows:
+<itemizedlist>
+<listitem><para>An instance is <emphasis>incoherent</emphasis> if: it has an <literal>INCOHERENT</literal> pragma; or if the instance has no pragma and it appears in a module compiled with <literal>-XIncoherentInstances</literal>.
+</para></listitem>
+<listitem><para>An instance is <emphasis>overlappable</emphasis> if: it has an <literal>OVERLAPPABLE</literal> or <literal>OVERLAPS</literal> pragma; or if the instance has no pragma and it appears in a module compiled with <literal>-XOverlappingInstances</literal>; or if the instance is incoherent.
+</para></listitem>
+<listitem><para>An instance is <emphasis>overlapping</emphasis> if: it has an <literal>OVERLAPPING</literal> or <literal>OVERLAPS</literal> pragma; or if the instance has no pragma and it appears in a module compiled with <literal>-XOverlappingInstances</literal>; or if the instance is incoherent.
+</para></listitem>
+</itemizedlist>
 </para>
 
 <para>
-For example, consider
+Now suppose that, in some client module, we are searching for an instance of the
+<emphasis>target constraint</emphasis> <literal>(C ty1 .. tyn)</literal>.
+The search works like this.
+<itemizedlist>
+<listitem><para>
+Find all instances I that <emphasis>match</emphasis> the target constraint;
+that is, the target constraint is a substitution instance of I.  These
+instance declarations are the <emphasis>candidates</emphasis>.
+</para></listitem>
+
+<listitem><para>
+Eliminate any candidate IX for which both of the following hold:
+
+<itemizedlist>
+  <listitem><para>There is another candidate IY that is strictly more specific;
+    that is, IY is a substitution instance of IX but not vice versa.
+  </para></listitem>
+  <listitem><para>
+  Either IX is <emphasis>overlappable</emphasis>, or IY is
+  <emphasis>overlapping</emphasis>.  (This "either/or" design, rather than a "both/and" design,
+  allow a client to deliberately override an instance from a library, without requiring a change to the library.)
+  </para></listitem>
+  </itemizedlist>
+</para>
+</listitem>
+
+<listitem><para>
+If exactly one non-incoherent candidate remains, select it.  If all
+remaining candidates are incoherent, select an arbitary
+one. Otherwise the search fails (i.e. when more than one surviving candidate is not incoherent).
+</para></listitem>
+
+<listitem><para>
+If the selected candidate (from the previous step) is incoherent, the search succeeds, returning that candidate.
+</para></listitem>
+
+<listitem><para>
+If not, find all instances that <emphasis>unify</emphasis> with the target
+constraint, but do not <emphasis>match</emphasis> it.
+Such non-candidate instances might match when the target constraint is further
+instantiated.  If all of them are incoherent, the search succeeds, returning the selected candidate;
+if not, the search fails.
+</para></listitem>
+
+</itemizedlist>
+Notice that these rules are not influenced by flag settings in the client module, where
+the instances are <emphasis>used</emphasis>.
+These rules make it possible for a library author to design a library that relies on
+overlapping instances without the client having to know.
+</para>
+<para>
+Errors are reported <emphasis>lazily</emphasis> (when attempting to solve a constraint), rather than <emphasis>eagerly</emphasis> 
+(when the instances themselves are defined).  Consider, for example
 <programlisting>
-  instance context1 => C Int b     where ...  -- (A)
-  instance context2 => C a   Bool  where ...  -- (B)
-  instance context3 => C a   [b]   where ...  -- (C)
-  instance context4 => C Int [Int] where ...  -- (D)
+  instance C Int  b where ..
+  instance C a Bool where ..
+</programlisting>
+These potentially overlap, but GHC will not complain about the instance declarations
+themselves, regardless of flag settings.  If we later try to solve the constraint
+<literal>(C Int Char)</literal> then only the first instance matches, and all is well.
+Similarly with <literal>(C Bool Bool)</literal>.  But if we try to solve <literal>(C Int Bool)</literal>,
+both instances match and an error is reported.
+</para>
+
+<para>
+As a more substantial example of the rules in action, consider
+<programlisting>
+  instance {-# OVERLAPPABLE #-} context1 => C Int b     where ...  -- (A)
+  instance {-# OVERLAPPABLE #-} context2 => C a   Bool  where ...  -- (B)
+  instance {-# OVERLAPPABLE #-} context3 => C a   [b]   where ...  -- (C)
+  instance {-# OVERLAPPING  #-} context4 => C Int [Int] where ...  -- (D)
 </programlisting>
-compiled with <option>-XOverlappingInstances</option> enabled. The constraint
-<literal>C Int [Int]</literal> matches instances (A), (C) and (D), but the last
+Now suppose that the type inference
+engine needs to solve the constraint
+<literal>C Int [Int]</literal>.  This constraint matches instances (A), (C) and (D), but the last
 is more specific, and hence is chosen.
 </para>
 <para>If (D) did not exist then (A) and (C) would still be matched, but neither is
-most specific. In that case, the program would be rejected even with
-<option>-XOverlappingInstances</option>. With
-<option>-XIncoherentInstances</option> enabled, it would be accepted and (A) or
+most specific. In that case, the program would be rejected, unless
+<option>-XIncoherentInstances</option> is enabled, in which case it would be accepted and (A) or
 (C) would be chosen arbitrarily.
 </para>
 <para>
@@ -4924,7 +5155,7 @@ the head of former is a substitution instance of the latter. For example
 substituting <literal>a:=Int</literal>.
 </para>
 <para>
-However, GHC is conservative about committing to an overlapping instance.  For example:
+GHC is conservative about committing to an overlapping instance.  For example:
 <programlisting>
   f :: [b] -> [b]
   f x = ...
@@ -5021,56 +5252,6 @@ the program prints
 would be to reject module <literal>Help</literal>
 on the grounds that a later instance declaration might overlap the local one.)
 </para>
-<para>
-The willingness to be overlapped or incoherent is a property of
-the <emphasis>instance declaration</emphasis> itself, controlled by the
-presence or otherwise of the <option>-XOverlappingInstances</option>
-and <option>-XIncoherentInstances</option> flags when that module is
-being defined.  Suppose we are searching for an instance of the 
-<emphasis>target constraint</emphasis> <literal>(C ty1 .. tyn)</literal>.
-The search works like this.
-<itemizedlist>
-<listitem><para>
-Find all instances I that <emphasis>match</emphasis> the target constraint;
-that is, the target constraint is a substitution instance of I.  These
-instance declarations are the <emphasis>candidates</emphasis>.
-</para></listitem>
-
-<listitem><para>
-Find all <emphasis>non-candidate</emphasis> instances 
-that <emphasis>unify</emphasis> with the target constraint.
-Such non-candidates instances might match when the target constraint is further
-instantiated.  If all of them were compiled with
-<option>-XIncoherentInstances</option>, proceed; if not, the search fails.
-</para></listitem>
-
-<listitem><para>
-Eliminate any candidate IX for which both of the following hold:
-
-<itemizedlist>
-<listitem><para>There is another candidate IY that is strictly more specific;
-that is, IY is a substitution instance of IX but not vice versa.
-</para></listitem>
-<listitem><para>Either IX or IY was compiled with 
-<option>-XOverlappingInstances</option>.
-</para></listitem>
-</itemizedlist>
-
-</para></listitem>
-
-<listitem><para>
-If only one candidate remains, pick it.
-Otherwise if all remaining candidates were compiled with
-<option>-XInccoherentInstances</option>, pick an arbitrary candidate.
-</para></listitem>
-
-</itemizedlist>
-These rules make it possible for a library author to design a library that relies on
-overlapping instances without the library client having to know.
-</para>
-<para>The <option>-XIncoherentInstances</option> flag implies the
-<option>-XOverlappingInstances</option> flag, but not vice versa.
-</para>
 </sect3>
 
 <sect3 id="instance-sigs">
@@ -5144,21 +5325,30 @@ it explicitly (for example, to give an instance declaration for it), you can imp
 from module <literal>GHC.Exts</literal>.
 </para>
 <para>
-Haskell's defaulting mechanism is extended to cover string literals, when <option>-XOverloadedStrings</option> is specified.
+Haskell's defaulting mechanism (<ulink url="http://www.haskell.org/onlinereport/decls.html#sect4.3.4">Haskell Report, Section 4.3.4</ulink>)
+is extended to cover string literals, when <option>-XOverloadedStrings</option> is specified.
 Specifically:
 <itemizedlist>
 <listitem><para>
-Each type in a default declaration must be an
+Each type in a <literal>default</literal> declaration must be an
 instance of <literal>Num</literal> <emphasis>or</emphasis> of <literal>IsString</literal>.
 </para></listitem>
 
 <listitem><para>
-The standard defaulting rule (<ulink url="http://www.haskell.org/onlinereport/decls.html#sect4.3.4">Haskell Report, Section 4.3.4</ulink>)
+If no <literal>default</literal> declaration is given, then it is just as if the module
+contained the declaration <literal>default( Integer, Double, String)</literal>.
+</para></listitem>
+
+<listitem><para>
+The standard defaulting rule
 is extended thus: defaulting applies when all the unresolved constraints involve standard classes
 <emphasis>or</emphasis> <literal>IsString</literal>; and at least one is a numeric class
 <emphasis>or</emphasis> <literal>IsString</literal>.
 </para></listitem>
 </itemizedlist>
+So, for example, the expression <literal>length "foo"</literal> will give rise
+to an ambiguous use of <literal>IsString a0</literal> which, becuase of the above
+rules, will default to <literal>String</literal>.
 </para>
 <para>
 A small example:
@@ -5260,7 +5450,7 @@ class IsList l where
   fromListN _ = fromList
 </programlisting>
 
-<para>The <literal>FromList</literal> class and its methods are intended to be
+<para>The <literal>IsList</literal> class and its methods are intended to be
 used in conjunction with the <option>OverloadedLists</option> extension.
 <itemizedlist>
 <listitem> <para> The type function
@@ -5292,32 +5482,32 @@ of <literal>IsList</literal>, so that list notation becomes
 useful for completely new data types.
 Here are several example instances:
 <programlisting>
-instance FromList [a] where
+instance IsList [a] where
   type Item [a] = a
   fromList = id
   toList = id
 
-instance (Ord a) => FromList (Set a) where
+instance (Ord a) => IsList (Set a) where
   type Item (Set a) = a
   fromList = Set.fromList
   toList = Set.toList
 
-instance (Ord k) => FromList (Map k v) where
+instance (Ord k) => IsList (Map k v) where
   type Item (Map k v) = (k,v)
   fromList = Map.fromList
   toList = Map.toList
 
-instance FromList (IntMap v) where
+instance IsList (IntMap v) where
   type Item (IntMap v) = (Int,v)
   fromList = IntMap.fromList
   toList = IntMap.toList
 
-instance FromList Text where
+instance IsList Text where
   type Item Text = Char
   fromList = Text.pack
   toList = Text.unpack
 
-instance FromList (Vector a) where
+instance IsList (Vector a) where
   type Item (Vector a) = a
   fromList  = Vector.fromList
   fromListN = Vector.fromListN
@@ -5885,28 +6075,39 @@ instance (GMapKey a, GMapKey b) => GMapKey (Either a b) where
   data GMap (Either a b) v = GMapEither (GMap a v) (GMap b v)
   ...
 
-instance (Eq (Elem [e])) => Collects ([e]) where
+instance Eq (Elem [e]) => Collects [e] where
   type Elem [e] = e
   ...
 </programlisting>
-        The most important point about associated family instances is that the
-        type indexes corresponding to class parameters must be identical to
-        the type given in the instance head; here this is the first argument
-        of <literal>GMap</literal>, namely <literal>Either a b</literal>,
-        which coincides with the only class parameter.
-      </para>
-      <para>
-	Instances for an associated family can only appear as part of
-	instance declarations of the class in which the family was declared -
-	just as with the equations of the methods of a class.  Also in
-	correspondence to how methods are handled, declarations of associated
-	types can be omitted in class instances.  If an associated family
-	instance is omitted, the corresponding instance type is not inhabited;
+Note the following points:
+<itemizedlist>
+<listitem><para>
+        The type indexes corresponding to class parameters must have precisely the same shape
+        the type given in the instance head.  To have the same "shape" means that
+        the two types are identical modulo renaming of type variables. For example:
+<programlisting>
+instance Eq (Elem [e]) => Collects [e] where
+  -- Choose one of the following alternatives:
+  type Elem [e] = e       -- OK
+  type Elem [x] = x       -- OK
+  type Elem x   = x       -- BAD; shape of 'x' is different to '[e]'
+  type Elem [Maybe x] = x -- BAD: shape of '[Maybe x]' is different to '[e]'
+</programlisting>
+</para></listitem>
+<listitem><para>
+	An instances for an associated family can only appear as part of
+	an instance declarations of the class in which the family was declared,
+	just as with the equations of the methods of a class.
+</para></listitem>
+<listitem><para>
+     The instance for an associated type can be omitted in class instances.  In that case,
+     unless there is a default instance (see <xref linkend="assoc-decl-defs"/>), 
+     the corresponding instance type is not inhabited;
 	i.e., only diverging expressions, such
 	as <literal>undefined</literal>, can assume the type.
-      </para>
-      <para>
-        Although it is unusual, there can be <emphasis>multiple</emphasis>
+</para></listitem>
+<listitem><para>
+        Although it is unusual, there (currently) can be <emphasis>multiple</emphasis>
         instances for an associated family in a single instance declaration.
         For example, this is legitimate:
 <programlisting>
@@ -5920,8 +6121,10 @@ instance GMapKey Flob where
         Since you cannot give any <emphasis>subsequent</emphasis> instances for
         <literal>(GMap Flob ...)</literal>, this facility is most useful when
         the free indexed parameter is of a kind with a finite number of alternatives
-        (unlike <literal>*</literal>).
-      </para>
+        (unlike <literal>*</literal>).  WARNING: this facility may be withdrawn in the future.
+</para></listitem>
+</itemizedlist>
+</para>
     </sect3>
 
     <sect3 id="assoc-decl-defs">
@@ -5939,22 +6142,50 @@ class IsBoolMap v where
 instance IsBoolMap [(Int, Bool)] where
   lookupKey = lookup
 </programlisting>
-The <literal>instance</literal> keyword is optional.
-      </para>
+In an <literal>instance</literal> declaration for the class, if no explicit
+<literal>type instance</literal> declaration is given for the associated type, the default declaration
+is used instead, just as with default class methods.
+</para>
 <para>
-There can also be multiple defaults for a single type, as long as they do not
-overlap:
+Note the following points:
+<itemizedlist>
+<listitem><para>
+  The <literal>instance</literal> keyword is optional.
+</para></listitem>
+<listitem><para>
+   There can be at most one default declaration for an associated type synonym.
+</para></listitem>
+<listitem><para>
+  A default declaration is not permitted for an associated
+  <emphasis>data</emphasis> type.
+</para></listitem>
+<listitem><para>
+   The default declaration must mention only type <emphasis>variables</emphasis> on the left hand side,
+   and the right hand side must mention only type varaibels bound on the left hand side.
+   However, unlike the associated type family declaration itself,
+   the type variables of the default instance are independent of those of the parent class.
+</para></listitem>
+</itemizedlist>
+Here are some examples:
 <programlisting>
-class C a where
-  type F a b
-  type F a Int  = Bool
-  type F a Bool = Int
+  class C a where
+    type F1 a :: *
+    type instance F1 a = [a]     -- OK
+    type instance F1 a = a->a    -- BAD; only one default instance is allowed
+
+    type F2 b a                  -- OK; note the family has more type
+                                 --     variables than the class
+    type instance F2 c d = c->d  -- OK; you don't have to use 'a' in the type instance
+
+    type F3 a
+    type F3 [b] = b              -- BAD; only type variables allowed on the LHS
+
+    type F4 a
+    type F4 b = a                -- BAD; 'a' is not in scope  in the RHS
 </programlisting>
+</para>
 
-A default declaration is not permitted for an associated
-<emphasis>data</emphasis> type.
-      </para>
-    </sect3>
+</sect3>
 
     <sect3 id="scoping-class-params">
       <title>Scoping of class parameters</title>
@@ -6296,11 +6527,11 @@ data T m a = MkT (m a) (T Maybe (m a))
 </programlisting>
 The recursive use of <literal>T</literal> forced the second argument to have kind <literal>*</literal>.
 However, just as in type inference, you can achieve polymorphic recursion by giving a
-<emphasis>complete kind signature</emphasis> for <literal>T</literal>. The way to give
-a complete kind signature for a data type is to use a GADT-style declaration with an
-explicit kind signature thus:
+<emphasis>complete kind signature</emphasis> for <literal>T</literal>. A complete
+kind signature is present when all argument kinds and the result kind are known, without
+any need for inference. For example:
 <programlisting>
-data T :: (k -> *) -> k -> * where
+data T (m :: k -> *) :: k -> * where
   MkT :: m a -> T Maybe (m a) -> T m a
 </programlisting>
 The complete user-supplied kind signature specifies the polymorphic kind for <literal>T</literal>,
@@ -6312,26 +6543,41 @@ In particular, the recursive use of <literal>T</literal> is at kind <literal>*</
 What exactly is considered to be a "complete user-supplied kind signature" for a type constructor?
 These are the forms:
 <itemizedlist>
-<listitem><para>
-A GADT-style data type declaration, with an explicit "<literal>::</literal>" in the header.
-For example:
+<listitem><para>For a datatype, every type variable must be annotated with a kind. In a
+GADT-style declaration, there may also be a kind signature (with a top-level
+<literal>::</literal> in the header), but the presence or absence of this annotation
+does not affect whether or not the declaration has a complete signature.
 <programlisting>
 data T1 :: (k -> *) -> k -> *       where ...   -- Yes  T1 :: forall k. (k->*) -> k -> *
 data T2 (a :: k -> *) :: k -> *     where ...   -- Yes  T2 :: forall k. (k->*) -> k -> *
 data T3 (a :: k -> *) (b :: k) :: * where ...   -- Yes  T3 :: forall k. (k->*) -> k -> *
-data T4 a (b :: k)             :: * where ...   -- YES  T4 :: forall k. * -> k -> *
+data T4 (a :: k -> *) (b :: k)      where ...   -- Yes  T4 :: forall k. (k->*) -> k -> *
 
-data T5 a b                         where ...   -- NO  kind is inferred
-data T4 (a :: k -> *) (b :: k)      where ...   -- NO  kind is inferred
-</programlisting>
-It makes no difference where you put the "<literal>::</literal>" but it must be there.
-You cannot give a complete kind signature using a Haskell-98-style data type declaration;
-you must use GADT syntax.
+data T5 a (b :: k)             :: * where ...   -- NO  kind is inferred
+data T6 a b                         where ...   -- NO  kind is inferred
+</programlisting></para>
+</listitem>
+
+<listitem><para>
+For a class, every type variable must be annotated with a kind.
 </para></listitem>
 
+<listitem><para>
+For a type synonym, every type variable and the result type must all be annotated
+with kinds.
+<programlisting>
+type S1 (a :: k) = (a :: k)    -- Yes   S1 :: forall k. k -> k
+type S2 (a :: k) = a           -- No    kind is inferred
+type S3 (a :: k) = Proxy a     -- No    kind is inferred
+</programlisting>
+Note that in <literal>S2</literal> and <literal>S3</literal>, the kind of the
+right-hand side is rather apparent, but it is still not considered to have a complete
+signature -- no inference can be done before detecting the signature.</para></listitem>
+
 <listitem><para>
 An open type or data family declaration <emphasis>always</emphasis> has a
-complete user-specified kind signature; no "<literal>::</literal>" is required:
+complete user-specified kind signature; un-annotated type variables default to
+kind <literal>*</literal>.
 <programlisting>
 data family D1 a           	-- D1 :: * -> *
 data family D2 (a :: k)    	-- D2 :: forall k. k -> *
@@ -6346,10 +6592,12 @@ variable annotation from the class declaration. It keeps its polymorphic kind
 in the associated type declaration. The variable <literal>b</literal>, however,
 gets defaulted to <literal>*</literal>.
 </para></listitem>
+
+<listitem><para>
+A closed type familey has a complete signature when all of its type variables
+are annotated and a return kind (with a top-level <literal>::</literal>) is supplied.
+</para></listitem>
 </itemizedlist>
-In a complete user-specified kind signature, any un-decorated type variable to the
-left of the "<literal>::</literal>" is considered to have kind "<literal>*</literal>".
-If you want kind polymorphism, specify a kind variable.
 </para>
 
 </sect2>
@@ -6359,31 +6607,33 @@ If you want kind polymorphism, specify a kind variable.
 <para>Although all open type families are considered to have a complete
 user-specified kind signature, we can relax this condition for closed type
 families, where we have equations on which to perform kind inference. GHC will
-infer a kind for any type variable in a closed type family when that kind is
-never used in pattern-matching. If you want a kind variable to be used in
-pattern-matching, you must declare it explicitly.
-</para>
-
-<para>
-Here are some examples (assuming <literal>-XDataKinds</literal> is enabled):
-<programlisting>
-type family Not a where      -- Not :: Bool -> Bool
-  Not False = True
-  Not True  = False
-
-type family F a where        -- ERROR: requires pattern-matching on a kind variable
-  F Int   = Bool
-  F Maybe = Char
-
-type family G (a :: k) where -- G :: k -> *
-  G Int   = Bool
-  G Maybe = Char
-
-type family SafeHead where   -- SafeHead :: [k] -> Maybe k
-  SafeHead '[] = Nothing     -- note that k is not required for pattern-matching
-  SafeHead (h ': t) = Just h
-</programlisting>
-</para>
+infer kinds for the arguments and result types of a closed type family.</para>
+
+<para>GHC supports <emphasis>kind-indexed</emphasis> type families, where the
+family matches both on the kind and type. GHC will <emphasis>not</emphasis> infer
+this behaviour without a complete user-supplied kind signature, as doing so would
+sometimes infer non-principal types.</para>
+
+<para>For example:
+<programlisting>
+type family F1 a where
+  F1 True  = False
+  F1 False = True
+  F1 x     = x
+-- F1 fails to compile: kind-indexing is not inferred
+
+type family F2 (a :: k) where
+  F2 True  = False
+  F2 False = True
+  F2 x     = x
+-- F2 fails to compile: no complete signature
+
+type family F3 (a :: k) :: k where
+  F3 True  = False
+  F3 False = True
+  F3 x     = x
+-- OK
+</programlisting></para>
 
 </sect2>
 
@@ -6569,14 +6819,78 @@ Note that this requires <option>-XTypeOperators</option>.
 </para>
 </sect2>
 
-<sect2 id="promoted-literals">
-<title>Promoted Literals</title>
+<sect2 id="promotion-existentials">
+<title>Promoting existential data constructors</title>
+<para>
+Note that we do promote existential data constructors that are otherwise suitable.
+For example, consider the following:
+<programlisting>
+data Ex :: * where
+  MkEx :: forall a. a -> Ex
+</programlisting>
+Both the type <literal>Ex</literal> and the data constructor <literal>MkEx</literal>
+get promoted, with the polymorphic kind <literal>'MkEx :: forall k. k -> Ex</literal>.
+Somewhat surprisingly, you can write a type family to extract the member
+of a type-level existential:
+<programlisting>
+type family UnEx (ex :: Ex) :: k
+type instance UnEx (MkEx x) = x
+</programlisting>
+At first blush, <literal>UnEx</literal> seems poorly-kinded. The return kind
+<literal>k</literal> is not mentioned in the arguments, and thus it would seem
+that an instance would have to return a member of <literal>k</literal>
+<emphasis>for any</emphasis> <literal>k</literal>. However, this is not the
+case. The type family <literal>UnEx</literal> is a kind-indexed type family.
+The return kind <literal>k</literal> is an implicit parameter to <literal>UnEx</literal>.
+The elaborated definitions are as follows:
+<programlisting>
+type family UnEx (k :: BOX) (ex :: Ex) :: k
+type instance UnEx k (MkEx k x) = x
+</programlisting>
+Thus, the instance triggers only when the implicit parameter to <literal>UnEx</literal>
+matches the implicit parameter to <literal>MkEx</literal>. Because <literal>k</literal>
+is actually a parameter to <literal>UnEx</literal>, the kind is not escaping the
+existential, and the above code is valid.
+</para>
+
+<para>
+See also <ulink url="http://ghc.haskell.org/trac/ghc/ticket/7347">Trac #7347</ulink>.
+</para>
+</sect2>
+
+<sect2>
+<title>Promoting type operators</title>
+<para>
+Type operators are <emphasis>not</emphasis> promoted to the kind level. Why not? Because
+<literal>*</literal> is a kind, parsed the way identifiers are. Thus, if a programmer
+tried to write <literal>Either * Bool</literal>, would it be <literal>Either</literal>
+applied to <literal>*</literal> and <literal>Bool</literal>? Or would it be
+<literal>*</literal> applied to <literal>Either</literal> and <literal>Bool</literal>.
+To avoid this quagmire, we simply forbid promoting type operators to the kind level.
+</para>
+</sect2>
+
+
+</sect1>
+
+<sect1 id="type-level-literals">
+<title>Type-Level Literals</title>
 <para>
-Numeric and string literals are promoted to the type level, giving convenient
-access to a large number of predefined type-level constants.  Numeric literals
-are of kind <literal>Nat</literal>, while string literals are of kind
-<literal>Symbol</literal>.  These kinds are defined in the module
-<literal>GHC.TypeLits</literal>.
+GHC supports numeric and string literals at the type level, giving convenient
+access to a large number of predefined type-level constants.
+Numeric literals are of kind <literal>Nat</literal>, while string literals
+are of kind <literal>Symbol</literal>.
+This feature is enabled by the <literal>XDataKinds</literal>
+language extension.
+</para>
+
+<para>
+The kinds of the literals and all other low-level operations for this feature
+are defined in module <literal>GHC.TypeLits</literal>. Note that the module
+defines some type-level operators that clash with their value-level
+counterparts (e.g. <literal>(+)</literal>).  Import and export declarations
+referring to these operators require an explicit namespace
+annotation (see <xref linkend="explicit-namespaces"/>).
 </para>
 
 <para>
@@ -6611,44 +6925,84 @@ instance Has Point "y" Int where from (Point _ y) _ = y
 example = from (Point 1 2) (Get :: Label "x")
 </programlisting>
 </para>
-</sect2>
 
-<sect2 id="promotion-existentials">
-<title>Promoting existential data constructors</title>
+<sect2 id="typelit-runtime">
+<title>Runtime Values for Type-Level Literals</title>
 <para>
-Note that we do promote existential data constructors that are otherwise suitable.
-For example, consider the following:
+Sometimes it is useful to access the value-level literal assocaited with
+a type-level literal.  This is done with the functions
+<literal>natVal</literal> and <literal>symbolVal</literal>. For example:
 <programlisting>
-data Ex :: * where
-  MkEx :: forall a. a -> Ex
+GHC.TypeLits> natVal (Proxy :: Proxy 2)
+2
 </programlisting>
-Both the type <literal>Ex</literal> and the data constructor <literal>MkEx</literal>
-get promoted, with the polymorphic kind <literal>'MkEx :: forall k. k -> Ex</literal>.
-Somewhat surprisingly, you can write a type family to extract the member
-of a type-level existential:
+These functions are overloaded because they need to return a different
+result, depending on the type at which they are instantiated.
 <programlisting>
-type family UnEx (ex :: Ex) :: k
-type instance UnEx (MkEx x) = x
+natVal :: KnownNat n => proxy n -> Integer
+
+-- instance KnownNat 0
+-- instance KnownNat 1
+-- instance KnownNat 2
+-- ...
 </programlisting>
-At first blush, <literal>UnEx</literal> seems poorly-kinded. The return kind
-<literal>k</literal> is not mentioned in the arguments, and thus it would seem
-that an instance would have to return a member of <literal>k</literal>
-<emphasis>for any</emphasis> <literal>k</literal>. However, this is not the
-case. The type family <literal>UnEx</literal> is a kind-indexed type family.
-The return kind <literal>k</literal> is an implicit parameter to <literal>UnEx</literal>.
-The elaborated definitions are as follows:
+GHC discharges the constraint as soon as it knows what concrete
+type-level literal is being used in the program.  Note that this works
+only for <emphasis>literals</emphasis> and not arbitrary type expressions.
+For example, a constraint of the form <literal>KnownNat (a + b)</literal>
+will <emphasis>not</emphasis> be simplified to
+<literal>(KnownNat a, KnownNat b)</literal>; instead, GHC will keep the
+constraint as is, until it can simplify <literal>a + b</literal> to
+a constant value.
+</para>
+</sect2>
+
+<para>
+It is also possible to convert a run-time integer or string value to
+the corresponding type-level literal.  Of course, the resulting type
+literal will be unknown at compile-time, so it is hidden in an existential
+type.   The conversion may be performed using <literal>someNatVal</literal>
+for integers and <literal>someSymbolVal</literal> for strings:
 <programlisting>
-type family UnEx (k :: BOX) (ex :: Ex) :: k
-type instance UnEx k (MkEx k x) = x
+someNatVal :: Integer -> Maybe SomeNat
+SomeNat    :: KnownNat n => Proxy n -> SomeNat
 </programlisting>
-Thus, the instance triggers only when the implicit parameter to <literal>UnEx</literal>
-matches the implicit parameter to <literal>MkEx</literal>. Because <literal>k</literal>
-is actually a parameter to <literal>UnEx</literal>, the kind is not escaping the
-existential, and the above code is valid.
+The operations on strings are similar.
 </para>
 
+<sect2 id="typelit-tyfuns">
+<title>Computing With Type-Level Naturals</title>
 <para>
-See also <ulink url="http://ghc.haskell.org/trac/ghc/ticket/7347">Trac #7347</ulink>.
+GHC 7.8 can evaluate arithmetic expressions involving type-level natural
+numbers.  Such expressions may be constructed using the type-families
+<literal>(+), (*), (^)</literal> for addition, multiplication,
+and exponentiation.  Numbers may be compared using <literal>(&lt;=?)</literal>,
+which returns a promoted boolean value, or <literal>(&lt;=)</literal>, which
+compares numbers as a constraint.  For example:
+<programlisting>
+GHC.TypeLits> natVal (Proxy :: Proxy (2 + 3))
+5
+</programlisting>
+</para>
+<para>
+At present, GHC is quite limited in its reasoning about arithmetic:
+it will only evalute the arithmetic type functions and compare the results---
+in the same way that it does for any other type function.  In particular,
+it does not know more general facts about arithmetic, such as the commutativity
+and associativity of <literal>(+)</literal>, for example.
+</para>
+
+<para>
+However, it is possible to perform a bit of "backwards" evaluation.
+For example, here is how we could get GHC to compute arbitrary logarithms
+at the type level:
+<programlisting>
+lg :: Proxy base -> Proxy (base ^ pow) -> Proxy pow
+lg _ _ = Proxy
+
+GHC.TypeLits> natVal (lg (Proxy :: Proxy 2) (Proxy :: Proxy 8))
+3
+</programlisting>
 </para>
 </sect2>
 
@@ -6696,6 +7050,21 @@ class (F a ~ b) => C a b where
       with the class head.  Method signatures are not affected by that
       process.
     </para>
+
+  <sect2 id="coercible">
+  <title>The <literal>Coercible</literal> constraint</title>
+  <para>
+  The constraint <literal>Coercible t1 t2</literal> is similar to <literal>t1 ~
+  t2</literal>, but denotes representational equality between
+  <literal>t1</literal> and <literal>t2</literal> in the sense of Roles
+  (<xref linkend="roles"/>). It is exported by
+  <ulink url="&libraryBaseLocation;/Data-Coerce.html"><literal>Data.Coerce</literal></ulink>,
+  which also contains the documentation. More details and discussion can be found in
+  the paper
+  <ulink href="http://www.cis.upenn.edu/~eir/papers/2014/coercible/coercible.pdf">Safe Coercions"</ulink>.
+  </para>
+  </sect2>
+
   </sect1>
 
 <sect1 id="constraint-kind">
@@ -7862,7 +8231,8 @@ scope over the methods defined in the <literal>where</literal> part.  For exampl
 4.5.5</ulink>
 of the Haskell Report)
 can be completely switched off by
-<option>-XNoMonomorphismRestriction</option>.
+<option>-XNoMonomorphismRestriction</option>. Since GHC 7.8.1, the monomorphism
+restriction is switched off by default in GHCi's interactive options (see <xref linkend="ghci-interactive-options"/>).
 </para>
 </sect3>
 
@@ -7935,12 +8305,30 @@ pattern binding must have the same context.  For example, this is fine:
 <para>
 An ML-style language usually generalises the type of any let-bound or where-bound variable,
 so that it is as polymorphic as possible.
-With the flag <option>-XMonoLocalBinds</option> GHC implements a slightly more conservative policy:
-<emphasis>it generalises only "closed" bindings</emphasis>.
-A binding is considered "closed" if either
+With the flag <option>-XMonoLocalBinds</option> GHC implements a slightly more conservative policy,
+using the following rules:
 <itemizedlist>
-<listitem><para>It is one of the top-level bindings of a module, or </para></listitem>
-<listitem><para>Its free variables are all themselves closed</para></listitem>
+  <listitem><para>
+  A variable is <emphasis>closed</emphasis> if and only if
+    <itemizedlist>
+    <listitem><para> the variable is let-bound</para></listitem>
+    <listitem><para> one of the following holds:
+          <itemizedlist>
+          <listitem><para>the variable has an explicit type signature that has no free type variables, or</para></listitem>
+          <listitem><para>its binding group is fully generalised (see next bullet) </para></listitem>
+         </itemizedlist>
+    </para></listitem>
+    </itemizedlist>
+  </para></listitem>
+
+  <listitem><para>
+  A binding group is <emphasis>fully generalised</emphasis> if and only if
+    <itemizedlist> 
+    <listitem><para>each of its free variables is either imported or closed, and</para></listitem>
+    <listitem><para>the binding is not affected by the monomorphism restriction 
+        (<ulink url="http://www.haskell.org/onlinereport/decls.html#sect4.5.5">Haskell Report, Section 4.5.5</ulink>)</para></listitem>
+    </itemizedlist>
+  </para></listitem>
 </itemizedlist>
 For example, consider
 <programlisting>
@@ -7949,15 +8337,18 @@ g x = let h y = f y * 2
           k z = z+x
       in  h x + k x
 </programlisting>
-Here <literal>f</literal> and <literal>g</literal> are closed because they are bound at top level.
-Also <literal>h</literal> is closed because its only free variable <literal>f</literal> is closed.
-But <literal>k</literal> is not closed because it mentions <literal>x</literal> which is locally bound.
-Another way to think of it is this: all closed bindings <literal>could</literal> be defined at top level.
-(In the example, we could move <literal>h</literal> to top level.)
-</para><para>
-All of this applies only to bindings that lack an explicit type signature, so that GHC has to
-infer its type.  If you supply a type signature, then that fixes type of the binding, end of story.
-</para><para>
+Here <literal>f</literal> is generalised because it has no free variables; and its binding group
+is unaffected by the monomorphism restriction; and hence <literal>f</literal> is closed.
+The same reasoning applies to <literal>g</literal>, except that it has one closed free variable, namely <literal>f</literal>.
+Similarly <literal>h</literal> is closed, <emphasis>even though it is not bound at top level</emphasis>,
+because its only free variable <literal>f</literal> is closed.
+But <literal>k</literal> is not closed, because it mentions <literal>x</literal> which is not closed (because it is not let-bound).
+</para>
+<para>
+Notice that a top-level binding that is affected by the monomorphism restriction is not closed, and hence may
+in turn prevent generalisation of bindings that mention it.
+</para>
+<para>
 The rationale for this more conservative strategy is given in
 <ulink url="http://research.microsoft.com/~simonpj/papers/constraints/index.htm">the papers</ulink> "Let should not be generalised" and "Modular type inference with local assumptions", and
 a related <ulink url="http://ghc.haskell.org/trac/ghc/blog/LetGeneralisationInGhc7">blog post</ulink>.
@@ -7978,23 +8369,22 @@ with <option>-XNoMonoLocalBinds</option> but type inference becomes less predica
 <option>-fwarn-typed-holes</option>, which is enabled by default.</para>
 
 <para>
-The goal of the typed holes warning is not to change the type system, but to help with writing Haskell
-code. Type holes can be used to obtain extra information from the type checker, which might otherwise be hard
-to get.
-Normally, the type checker is used to decide if a module is well typed or not. Using GHCi,
-users can inspect the (inferred) type signatures of all top-level bindings. However, determining the
-type of a single term is still hard. Yet while writing code, it could be helpful to know the type of
-the term you're about to write.
-</para>
-
-<para>
-This extension allows special placeholders, written with a leading underscore (e.g. "<literal>_</literal>",
+This option allows special placeholders, written with a leading underscore (e.g. "<literal>_</literal>",
 "<literal>_foo</literal>", "<literal>_bar</literal>"), to be used as an expression.
 During compilation these holes will generate an error message describing what type is expected there,
 information about the origin of any free type variables, and a list of local bindings
 that might help fill the hole with actual code.
 </para>
 
+<para>
+The goal of the typed holes warning is not to change the type system, but to help with writing Haskell
+code. Typed holes can be used to obtain extra information from the type checker, which might otherwise be hard
+to get.
+Normally, using GHCi, users can inspect the (inferred) type signatures of all top-level bindings.
+However, this method is less convenient with terms which are not defined on top-level or
+inside complex expressions. Holes allow to check the type of the term you're about to write.
+</para>
+
 <para>
 Holes work together well with <link linkend="defer-type-errors">deferring type errors to runtime</link>:
 with <literal>-fdefer-type-errors</literal>, the error from a hole is also deferred, effctively making the hole
@@ -8023,15 +8413,15 @@ hole.hs:2:7:
 </para>
 
 <para>
-Multiple type holes can be used to find common type variables between expressions. For example:
+Multiple typed holes can be used to find common type variables between expressions. For example:
 <programlisting>
 sum :: [Int] -> Int
-sum xx = foldr _f _z xs
+sum xs = foldr _f _z xs
 </programlisting>
 Shows:
 <programlisting>
 holes.hs:2:15:
-    Found hole `_f' with type: Int-> Int -> Int
+    Found hole `_f' with type: Int -> Int -> Int
     In the first argument of `foldr', namely `_'
     In the expression: foldr _a _b _c
     In an equation for `sum': sum x = foldr _a _b _c
@@ -8070,7 +8460,6 @@ unbound.hs:1:13:
     In the second argument of `(:)', namely `_x'
     In the expression: _x : _x
     In an equation for `cons': cons = _x : _x
-Failed, modules loaded: none.
 </programlisting>
 This ensures that an unbound identifier is never reported with a too polymorphic type, like
 <literal>forall a. a</literal>, when used multiple times for types that can not be unified.
@@ -8212,9 +8601,7 @@ Wiki page</ulink>.
       constructions.  You need to use the flag
       <option>-XTemplateHaskell</option>
 	<indexterm><primary><option>-XTemplateHaskell</option></primary>
-      </indexterm>to switch these syntactic extensions on
-      (<option>-XTemplateHaskell</option> is no longer implied by
-      <option>-fglasgow-exts</option>).</para>
+      </indexterm>to switch these syntactic extensions on.</para>
 
 	<itemizedlist>
 	      <listitem><para>
@@ -10436,6 +10823,23 @@ data T = T {-# NOUNPACK #-} !(Int,Int)
      </para>
 </sect2>
 
+<sect2 id="overlap-pragma">
+<title>OVERLAPPING, OVERLAPPABLE, OVERLAPS, and INCOHERENT pragmas</title>
+<para>
+The pragmas
+  <literal>OVERLAPPING</literal>,
+  <literal>OVERLAPPABLE</literal>,
+  <literal>OVERLAPS</literal>,
+  <literal>INCOHERENT</literal> are used to specify the overlap
+behavior for individual instances, as described in Section
+<xref linkend="instance-overlap"/>.  The pragmas are written immediately
+after the <literal>instance</literal> keyword, like this:
+</para>
+<programlisting>
+instance {-# OVERLAPPING #-} C t where ...
+</programlisting>
+</sect2>
+
 </sect1>
 
 <!--  ======================= REWRITE RULES ======================== -->
@@ -10712,8 +11116,8 @@ not be substituted, and the rule would not fire.
 
 </sect2>
 
-<sect2 id="conlike">
-<title>How rules interact with INLINE/NOINLINE and CONLIKE pragmas</title>
+<sect2 id="rules-inline">
+<title>How rules interact with INLINE/NOINLINE pragmas</title>
 
 <para>
 Ordinary inlining happens at the same time as rule rewriting, which may lead to unexpected
@@ -10739,7 +11143,14 @@ would have been a better chance that <literal>f</literal>'s RULE might fire.
 The way to get predictable behaviour is to use a NOINLINE
 pragma, or an INLINE[<replaceable>phase</replaceable>] pragma, on <literal>f</literal>, to ensure
 that it is not inlined until its RULEs have had a chance to fire.
+The warning flag <option>-fwarn-inline-rule-shadowing</option> (see <xref linkend="options-sanity"/>)
+warns about this situation.
 </para>
+</sect2>
+
+<sect2 id="conlike">
+<title>How rules interact with CONLIKE pragmas</title>
+
 <para>
 GHC is very cautious about duplicating work.  For example, consider
 <programlisting>
@@ -11084,69 +11495,6 @@ program even if fusion doesn't happen.  More rules in <filename>GHC/List.lhs</fi
 
 </sect2>
 
-<sect2 id="core-pragma">
-  <title>CORE pragma</title>
-
-  <indexterm><primary>CORE pragma</primary></indexterm>
-  <indexterm><primary>pragma, CORE</primary></indexterm>
-  <indexterm><primary>core, annotation</primary></indexterm>
-
-<para>
-  The external core format supports <quote>Note</quote> annotations;
-  the <literal>CORE</literal> pragma gives a way to specify what these
-  should be in your Haskell source code.  Syntactically, core
-  annotations are attached to expressions and take a Haskell string
-  literal as an argument.  The following function definition shows an
-  example:
-
-<programlisting>
-f x = ({-# CORE "foo" #-} show) ({-# CORE "bar" #-} x)
-</programlisting>
-
-  Semantically, this is equivalent to:
-
-<programlisting>
-g x = show x
-</programlisting>
-</para>
-
-<para>
-  However, when external core is generated (via
-  <option>-fext-core</option>), there will be Notes attached to the
-  expressions <function>show</function> and <varname>x</varname>.
-  The core function declaration for <function>f</function> is:
-</para>
-
-<programlisting>
-  f :: %forall a . GHCziShow.ZCTShow a ->
-                   a -> GHCziBase.ZMZN GHCziBase.Char =
-    \ @ a (zddShow::GHCziShow.ZCTShow a) (eta::a) ->
-        (%note "foo"
-         %case zddShow %of (tpl::GHCziShow.ZCTShow a)
-           {GHCziShow.ZCDShow
-            (tpl1::GHCziBase.Int ->
-                   a ->
-                   GHCziBase.ZMZN GHCziBase.Char -> GHCziBase.ZMZN GHCziBase.Cha
-r)
-            (tpl2::a -> GHCziBase.ZMZN GHCziBase.Char)
-            (tpl3::GHCziBase.ZMZN a ->
-                   GHCziBase.ZMZN GHCziBase.Char -> GHCziBase.ZMZN GHCziBase.Cha
-r) ->
-              tpl2})
-        (%note "bar"
-         eta);
-</programlisting>
-
-<para>
-  Here, we can see that the function <function>show</function> (which
-  has been expanded out to a case expression over the Show dictionary)
-  has a <literal>%note</literal> attached to it, as does the
-  expression <varname>eta</varname> (which used to be called
-  <varname>x</varname>).
-</para>
-
-</sect2>
-
 </sect1>
 
 <sect1 id="special-ids">
@@ -11440,7 +11788,7 @@ described in <ulink
 url="http://www.seas.upenn.edu/~sweirich/papers/popl163af-weirich.pdf">Generative
 type abstraction and type-level computation</ulink>, published at POPL 2011.</para>
 
-<sect2>
+<sect2 id="nominal-representational-and-phantom">
 <title>Nominal, Representational, and Phantom</title>
 
 <para>The goal of the roles system is to track when two types have the same
@@ -11497,7 +11845,7 @@ are unrelated.</para>
 
 </sect2>
 
-<sect2>
+<sect2 id="role-inference">
 <title>Role inference</title>
 
 <para>
@@ -11551,7 +11899,7 @@ but role nominal for <literal>b</literal>.</para>
 
 </sect2>
 
-<sect2>
+<sect2 id="role-annotations">
 <title>Role annotations
 <indexterm><primary>-XRoleAnnotations</primary></indexterm>
 </title>
@@ -11601,14 +11949,18 @@ to be at role nominal. This would be done with a declaration</para>
 </programlisting>
 
 <para>Role annotations can also be used should a programmer wish to write
-a class with a representational (or phantom) role.</para>
+a class with a representational (or phantom) role. However, as a class
+with non-nominal roles can quickly lead to class instance incoherence,
+it is necessary to also specify <option>-XIncoherentInstances</option>
+to allow non-nominal roles for classes.</para>
 
 <para>The other place where role annotations may be necessary are in
 <literal>hs-boot</literal> files (<xref linkend="mutual-recursion"/>), where
 the right-hand sides of definitions can be omitted. As usual, the
 types/classes declared in an <literal>hs-boot</literal> file must match up
 with the definitions in the <literal>hs</literal> file, including down to the
-roles. The default role is representational in <literal>hs-boot</literal> files,
+roles. The default role for datatypes
+is representational in <literal>hs-boot</literal> files,
 corresponding to the common use case.</para>
 
 <para>
@@ -11637,7 +11989,7 @@ Here are some examples:</para>
   type role T4 nominal
   data T4 a = MkT4 (a Int) -- OK, but nominal is higher than necessary
 
-  type role C representational _
+  type role C representational _   -- OK, with -XIncoherentInstances
   class C a b where ...    -- OK, b will get a nominal role
 
   type role X nominal
diff --git a/docs/users_guide/gone_wrong.xml b/docs/users_guide/gone_wrong.xml
index 114b06cfd690..bb5fcb0d4e77 100644
--- a/docs/users_guide/gone_wrong.xml
+++ b/docs/users_guide/gone_wrong.xml
@@ -146,7 +146,7 @@
           <emphasis>must</emphasis> be re-compiled.</para>
 
 	  <para>A useful option to alert you when interfaces change is
-          <option>-hi-diffs</option><indexterm><primary>-hi-diffs
+          <option>-ddump-hi-diffs</option><indexterm><primary>-ddump-hi-diffs
           option</primary></indexterm>.  It will run
           <command>diff</command> on the changed interface file,
           before and after, when applicable.</para>
@@ -167,7 +167,7 @@
 
 <screen>
 % rm *.o        # scrub your object files
-% make my_prog  # re-make your program; use -hi-diffs to highlight changes;
+% make my_prog  # re-make your program; use -ddump-hi-diffs to highlight changes;
                 # as mentioned above, use -dcore-lint to be more paranoid
 % ./my_prog ... # retry...
 </screen>
diff --git a/docs/users_guide/packages.xml b/docs/users_guide/packages.xml
index 3f2dd97aa535..ee29cb1c2f1d 100644
--- a/docs/users_guide/packages.xml
+++ b/docs/users_guide/packages.xml
@@ -88,7 +88,11 @@ $ ghc-pkg list
       to expose a hidden package or hide an exposed one.  Only modules
       from exposed packages may be imported by your Haskell code; if
       you try to import a module from a hidden package, GHC will emit
-      an error message.
+      an error message.  If there are a multiple exposed versions of a package,
+      GHC will prefer the latest one.  Additionally, some packages may be
+      broken: that is, they are missing from the package database, or one of
+      their dependencies are broken; in this case; these packages are excluded
+      from the default set of packages.
     </para>
 
     <para>
@@ -137,8 +141,11 @@ exposed-modules: Network.BSD,
             (e.g. <literal>network-1.0</literal>) or the version
             number can be omitted if there is only one version of the
             package installed. If there are multiple versions
-            of <replaceable>P</replaceable> installed, then all other
-            versions will become hidden.</para>
+            of <replaceable>P</replaceable> installed and
+            <option>-hide-all-packages</option> was not specified, then all
+            other versions will become hidden.  <option>-package</option>
+            supports thinning and renaming described in <xref
+            linkend="package-thinning-and-renaming" />.</para>
 
           <para>The <option>-package <replaceable>P</replaceable></option>
             option also causes package <replaceable>P</replaceable> to
@@ -183,10 +190,12 @@ exposed-modules: Network.BSD,
         <listitem>
           <para>
             Exposes a package like <option>-package</option>, but the
-            package is named by its ID rather than by name.  This is a
+            package is named by its installed package ID rather than by name.  This is a
             more robust way to name packages, and can be used to
             select packages that would otherwise be shadowed.  Cabal
             passes <option>-package-id</option> flags to GHC.
+            <option>-package-id</option> supports thinning and renaming
+            described in <xref linkend="package-thinning-and-renaming" />.
           </para>
         </listitem>
       </varlistentry>
@@ -258,19 +267,15 @@ exposed-modules: Network.BSD,
       </varlistentry>
 
       <varlistentry>
-        <term><option>-package-name</option> <replaceable>foo</replaceable>
-        <indexterm><primary><option>-package-name</option></primary>
+        <term><option>-this-package-key</option> <replaceable>foo</replaceable>
+        <indexterm><primary><option>-this-package-key</option></primary>
           </indexterm></term>
         <listitem>
           <para>Tells GHC the the module being compiled forms part of
-            package <replaceable>foo</replaceable>.
+            package key <replaceable>foo</replaceable>; internally, these
+            keys are used to determine type equality and linker symbols.
             If this flag is omitted (a very common case) then the
             default package <literal>main</literal> is assumed.</para>
-            <para>Note: the argument to <option>-package-name</option>
-              should be the full
-              package <literal>name-version</literal> for the package.
-              For example:
-            <literal>-package mypkg-1.2</literal>.</para>
         </listitem>
       </varlistentry>
 
@@ -328,7 +333,7 @@ exposed-modules: Network.BSD,
 
   <para>Every complete Haskell program must define <literal>main</literal> in
    module <literal>Main</literal>
-   in package <literal>main</literal>.   (Omitting the <option>-package-name</option> flag compiles
+   in package <literal>main</literal>.   (Omitting the <option>-this-package-key</option> flag compiles
    code for package <literal>main</literal>.) Failure to do so leads to a somewhat obscure
    link-time error of the form:
 <programlisting>
@@ -367,6 +372,52 @@ _ZCMain_main_closure
     name.</para>
   </sect2>
 
+  <sect2 id="package-thinning-and-renaming">
+    <title>Thinning and renaming modules</title>
+
+  <para>When incorporating packages from multiple sources, you may end up
+  in a situation where multiple packages publish modules with the same name.
+  Previously, the only way to distinguish between these modules was to
+  use <xref linkend="package-qualified-imports" />. However, since GHC 7.10,
+  the <option>-package</option> flags (and their variants) have been extended
+  to allow a user to explicitly control what modules a package brings into
+  scope, by analogy to the import lists that users can attach to module imports.
+  </para>
+
+  <para>
+  The basic syntax is that instead of specifying a package name P to the package
+  flag <literal>-package</literal>, instead we specify both a package name and a
+  parenthesized, comma-separated list of module names to import.  For example,
+  <literal>-package "base (Data.List, Data.Bool)"</literal> makes only
+  <literal>Data.List</literal> and <literal>Data.Bool</literal> visible from
+  package <literal>base</literal>.
+  We also support renaming of modules, in case you need to refer to both modules
+  simultaneously; this is supporting by writing <literal>OldModName as
+  NewModName</literal>, e.g. <literal>-package "base (Data.Bool as
+  Bool)</literal>. It's important to specify quotes
+  so that your shell passes the package name and thinning/renaming list as a
+  single argument to GHC.</para>
+
+  <para>Package imports with thinning/renaming do not hide other versions of the
+  package: e.g. if containers-0.9 is already exposed, <literal>-package
+  "containers-0.8 (Data.List as ListV8)"</literal> will only add an additional
+  binding to the environment.  Similarly, <literal>-package "base (Data.Bool as
+  Bool)" -package "base (Data.List as List)"</literal> is equivalent to
+  <literal>-package "base (Data.Bool as Bool, Data.List as List)"</literal>.
+  Literal names must refer to modules defined by the original package, so for
+  example <literal>-package "base (Data.Bool as Bool, Bool as Baz)"</literal> is
+  invalid unless there was a <literal>Bool</literal> module defined in the
+  original package.  Hiding a package also clears all of its renamings.  </para>
+
+  <para>
+  You can use renaming to provide an alternate prelude, e.g.
+  <literal>-hide-all-packages -package "basic-prelude (BasicPrelude as
+  Prelude)"</literal>, in lieu of the <xref
+  linkend="rebindable-syntax">NoImplicitPrelude</xref> extension.
+  </para>
+
+  </sect2>
+
   <sect2 id="package-databases">
     <title>Package Databases</title>
 
@@ -528,12 +579,11 @@ _ZCMain_main_closure
   </sect2>
 
   <sect2 id="package-ids">
-    <title>Package IDs, dependencies, and broken packages</title>
+    <title>Installed package IDs, dependencies, and broken packages</title>
 
     <para>Each installed package has a unique identifier (the
-      &ldquo;installed package ID&rdquo;, or just &ldquo;package
-      ID&rdquo; for short) , which distinguishes it from all other
-      installed packages on the system.  To see the package IDs
+      &ldquo;installed package ID&rdquo;), which distinguishes it from all other
+      installed packages on the system.  To see the installed package IDs
       associated with each installed package, use <literal>ghc-pkg
       list -v</literal>:</para>
 
@@ -549,10 +599,10 @@ using cache: /usr/lib/ghc-6.12.1/package.conf.d/package.cache
 </screen>
 
     <para>
-      The string in parentheses after the package name is the package
+      The string in parentheses after the package name is the installed package
       ID: it normally begins with the package name and version, and
       ends in a hash string derived from the compiled package.
-      Dependencies between packages are expressed in terms of package
+      Dependencies between packages are expressed in terms of installed package
       IDs, rather than just packages and versions.  For example, take
       a look at the dependencies of the <literal>haskell98</literal>
       package:
@@ -570,14 +620,14 @@ depends: array-0.2.0.1-9cbf76a576b6ee9c1f880cf171a0928d
 </screen>
 
     <para>
-      The purpose of the package ID is to detect problems caused by
+      The purpose of the installed package ID is to detect problems caused by
       re-installing a package without also recompiling the packages
       that depend on it.  Recompiling dependencies is necessary,
       because the newly compiled package may have a different ABI
       (Application Binary Interface) than the previous version, even
       if both packages were built from the same source code using the
-      same compiler.  With package IDs, a recompiled
-      package will have a different package ID from the previous
+      same compiler.  With installed package IDs, a recompiled
+      package will have a different installed package ID from the previous
       version, so packages that depended on the previous version are
       now orphaned - one of their dependencies is not satisfied.
       Packages that are broken in this way are shown in
@@ -691,7 +741,9 @@ haskell98-1.0.1.0
       package; the specified action will be applied to all the matching
       packages.  A package specifier that matches all version of the package
       can also be written <replaceable>pkg</replaceable><literal>-*</literal>,
-      to make it clearer that multiple packages are being matched.</para>
+      to make it clearer that multiple packages are being matched.  To match
+      against the installed package ID instead of just package name and version,
+      pass the <option>--ipid</option> flag.</para>
 
     <variablelist>
       <varlistentry>
@@ -1047,8 +1099,25 @@ ghc-pkg dot | tred | dot -Tpdf >pkgs.pdf
           <para>Output the <literal>ghc-pkg</literal> version number.</para>
         </listitem>
       </varlistentry>
-    </variablelist>
 
+      <varlistentry>
+        <term>
+          <option>--ipid</option>
+          <indexterm><primary>
+              <option>--ipid</option>
+            </primary></indexterm>
+        </term>
+        <listitem>
+          <para>Causes <literal>ghc-pkg</literal> to interpret arguments
+          as installed package IDs (e.g., an identifier like
+          <literal>unix-2.3.1.0-de7803f1a8cd88d2161b29b083c94240
+          </literal>).  This is useful if providing just the package
+          name and version are ambiguous (in old versions of GHC, this
+          was guaranteed to be unique, but this invariant no longer
+          necessarily holds).</para>
+        </listitem>
+      </varlistentry>
+    </variablelist>
   </sect2>
 
   <sect2 id="building-packages">
@@ -1152,8 +1221,8 @@ ghc-pkg dot | tred | dot -Tpdf >pkgs.pdf
     </itemizedlist>
 
      <para>To compile a module which is to be part of a new package,
-      use the <literal>-package-name</literal> option (<xref linkend="using-packages"/>).
-      Failure to use the <literal>-package-name</literal> option
+      use the <literal>-this-package-key</literal> option (<xref linkend="using-packages"/>).
+      Failure to use the <literal>-this-package-key</literal> option
       when compiling a package will probably result in disaster, but
       you will only discover later when you attempt to import modules
       from the package.  At this point GHC will complain that the
@@ -1288,7 +1357,7 @@ haddock-html: /usr/share/doc/ghc/html/libraries/unix
           <indexterm><primary><literal>id</literal></primary><secondary>package specification</secondary></indexterm>
         </term>
         <listitem>
-          <para>The package ID.  It is up to you to choose a suitable
+          <para>The installed package ID.  It is up to you to choose a suitable
           one.</para>
         </listitem>
       </varlistentry>
@@ -1445,6 +1514,25 @@ haddock-html: /usr/share/doc/ghc/html/libraries/unix
         </listitem>
         </varlistentry>
 
+        <varlistentry>
+          <term>
+            <literal>reexported-modules</literal>
+            <indexterm><primary><literal>reexported-modules</literal></primary><secondary>reexport specification</secondary></indexterm>
+          </term>
+          <listitem>
+            <para>Modules reexported by this package.  This list takes
+            the form of <literal>pkg:OldName as NewName
+            (A@orig-pkg-0.1-HASH)</literal>: the first portion of the
+            string is the user-written reexport specification (possibly
+            omitting the package qualifier and the renaming), while the
+            parenthetical is the original package which exposed the
+            module under are particular name.  Reexported modules have
+            a relaxed overlap constraint: it's permissible for two
+            packages to reexport the same module as the same name if the
+            reexported moduleis identical.</para>
+          </listitem>
+        </varlistentry>
+
         <varlistentry>
           <term>
             <literal>trusted</literal>
diff --git a/docs/users_guide/phases.xml b/docs/users_guide/phases.xml
index acb53a73d907..8a5589acdab1 100644
--- a/docs/users_guide/phases.xml
+++ b/docs/users_guide/phases.xml
@@ -216,15 +216,6 @@
           <para>Pass <replaceable>option</replaceable> to the LLVM compiler.</para>
         </listitem>
       </varlistentry>
-      <varlistentry>
-        <term>
-          <option>-optm</option>  <replaceable>option</replaceable>
-          <indexterm><primary><option>-optm</option></primary></indexterm>
-        </term>
-        <listitem>
-          <para>Pass <replaceable>option</replaceable> to the mangler.</para>
-        </listitem>
-      </varlistentry>
       <varlistentry>
         <term>
           <option>-opta</option>  <replaceable>option</replaceable>
@@ -585,8 +576,22 @@ $ cat foo.hspp</screen>
         </term>
         <listitem>
           <para>Omit code generation (and all later phases)
-          altogether.  Might be of some use if you just want to see
-          dumps of the intermediate compilation phases.</para>
+          altogether.  This is useful if you're only interested in
+          type checking code.</para>
+        </listitem>
+      </varlistentry>
+
+      <varlistentry>
+        <term>
+          <option>-fwrite-interface</option>
+          <indexterm><primary><option>-fwrite-interface</option></primary></indexterm>
+        </term>
+        <listitem>
+          <para>Always write interface files.  GHC will normally write
+          interface files automatically, but this flag is useful with
+          <option>-fno-code</option>, which normally suppresses generation
+          of interface files.  This is useful if you want to type check
+          over multiple runs of GHC without compiling dependencies.</para>
         </listitem>
       </varlistentry>
 
diff --git a/docs/users_guide/safe_haskell.xml b/docs/users_guide/safe_haskell.xml
index 04a244b3aff7..10d0a638f0df 100644
--- a/docs/users_guide/safe_haskell.xml
+++ b/docs/users_guide/safe_haskell.xml
@@ -186,18 +186,18 @@
       </para>
 
       <para>
-      The use of the <option>-XSafe</option> flag to compile the Danger module
-      restricts the features of Haskell that can be used to a
-      <link linkend="safe-language">safe subset</link>. This includes
-      disallowing <literal>unsafePerformIO</literal>, Template Haskell, pure
-      FFI functions, Generalized Newtype Deriving, RULES and restricting the
-      operation of Overlapping Instances. The <option>-XSafe</option> flag also
-      restricts the modules can be imported by Danger to only those that are
-      considered trusted. Trusted modules are those compiled with
-      <option>-XSafe</option>, where GHC provides a mechanical guarantee that
-      the code is safe. Or those modules compiled with
-      <option>-XTrustworthy</option>, where the module author claims that the
-      module is Safe.
+      The use of the <option>-XSafe</option> flag to compile the
+      Danger module restricts the features of Haskell that can be used
+      to a <link linkend="safe-language">safe subset</link>. This
+      includes disallowing <literal>unsafePerformIO</literal>,
+      Template Haskell, pure FFI functions, RULES and restricting the
+      operation of Overlapping Instances. The <option>-XSafe</option>
+      flag also restricts the modules can be imported by Danger to
+      only those that are considered trusted. Trusted modules are
+      those compiled with <option>-XSafe</option>, where GHC provides
+      a mechanical guarantee that the code is safe. Or those modules
+      compiled with <option>-XTrustworthy</option>, where the module
+      author claims that the module is Safe.
       </para>
 
       <para>
@@ -254,6 +254,7 @@
         for example, that the <literal>unsafePerformIO :: IO a -> a</literal>
         function is disallowed in the safe language.
       </listitem>
+
       <listitem><emphasis>Module boundary control</emphasis> &mdash; Haskell
         code compiled using the safe language is guaranteed to only access
         symbols that are publicly available to it through other modules export
@@ -263,10 +264,8 @@
         through careful use of its export list then code compiled using the
         safe language that imports M is guaranteed to respect those invariants.
         Because of this, <emphasis><link linkend="template-haskell">Template
-        Haskell</link></emphasis> and <emphasis>
-        <link linkend="newtype-deriving">GeneralizedNewtypeDeriving</link>
-        </emphasis> are disabled in the safe language as they can be used
-        to violate this property.
+        Haskell</link></emphasis> is disabled in the safe language as it can be
+        used to violate this property.
       </listitem>
       <listitem><emphasis>Semantic consistency</emphasis> &mdash; The safe
         language is strictly a subset of Haskell as implemented by GHC. Any
@@ -294,10 +293,6 @@
     following features:
 
     <itemizedlist>
-      <listitem><emphasis>GeneralizedNewtypeDeriving</emphasis> &mdash; It can
-        be used to violate constructor access control, by allowing untrusted
-        code to manipulate protected data types in ways the data type author
-        did not intend, breaking invariants they have established.</listitem>
       <listitem><emphasis>TemplateHaskell</emphasis> &mdash; Is particularly
         dangerous, as it can cause side effects even at compilation time and
         can be used to access constructors of abstract data types.</listitem>
diff --git a/docs/users_guide/ug-book.xml.in b/docs/users_guide/ug-book.xml.in
index dc5d4f7c35b7..b87563ac3b01 100644
--- a/docs/users_guide/ug-book.xml.in
+++ b/docs/users_guide/ug-book.xml.in
@@ -17,7 +17,6 @@
 &lang-features;
 &ffi-chap;
 &extending-ghc;
-&external-core;
 &wrong;
 &utils;
 &win32-dll;
diff --git a/docs/users_guide/ug-ent.xml.in b/docs/users_guide/ug-ent.xml.in
index ce87089f2446..6753ff7e5b69 100644
--- a/docs/users_guide/ug-ent.xml.in
+++ b/docs/users_guide/ug-ent.xml.in
@@ -3,7 +3,7 @@
 <!ENTITY flags          SYSTEM "flags.xml">
 <!ENTITY license        SYSTEM "license.xml">
 <!ENTITY intro          SYSTEM "intro.xml" >
-<!ENTITY relnotes1      SYSTEM "7.8.1-notes.xml" >
+<!ENTITY relnotes1      SYSTEM "7.10.1-notes.xml" >
 <!ENTITY using          SYSTEM "using.xml" >
 <!ENTITY code-gens      SYSTEM "codegens.xml" >
 <!ENTITY runtime        SYSTEM "runtime_control.xml" >
@@ -12,7 +12,6 @@
 <!ENTITY sooner         SYSTEM "sooner.xml" >
 <!ENTITY lang-features  SYSTEM "lang.xml" >
 <!ENTITY glasgowexts    SYSTEM "glasgow_exts.xml" >
-<!ENTITY external-core  SYSTEM "external_core.xml" >
 <!ENTITY packages       SYSTEM "packages.xml" >
 <!ENTITY parallel       SYSTEM "parallel.xml" >
 <!ENTITY safehaskell    SYSTEM "safe_haskell.xml" >
diff --git a/docs/users_guide/using.xml b/docs/users_guide/using.xml
index 8d8211eb5aad..921d5a3345c3 100644
--- a/docs/users_guide/using.xml
+++ b/docs/users_guide/using.xml
@@ -899,20 +899,37 @@ ghci> :set -fprint-explicit-foralls
 ghci> :t f
 f :: forall a. a -> a
 </screen>
-         Using <option>-fprint-explicit-kinds</option> makes GHC print kind-foralls and kind applications
+However, regardless of the flag setting, the quantifiers are printed under these circumstances:
+<itemizedlist>
+<listitem><para>For nested <literal>foralls</literal>, e.g.
+<screen>
+ghci> :t GHC.ST.runST
+GHC.ST.runST :: (forall s. GHC.ST.ST s a) -> a
+</screen>
+</para></listitem>
+<listitem><para>If any of the quantified type variables has a kind
+that mentions a kind variable, e.g.
+<screen>
+ghci> :i Data.Coerce.coerce
+coerce ::
+  forall (k :: BOX) (a :: k) (b :: k). Coercible a b => a -> b
+     -- Defined in GHC.Prim
+</screen>
+</para></listitem>
+</itemizedlist>
+          </para>
+          <para>
+         Using <option>-fprint-explicit-kinds</option> makes GHC print kind arguments
          in types, which are normally suppressed.  This can be important when you are using kind polymorphism.
          For example:
 <screen>
 ghci> :set -XPolyKinds
 ghci> data T a = MkT
 ghci> :t MkT
-MkT :: T b
+MkT :: forall (k :: BOX) (a :: k). T a
 ghci> :set -fprint-explicit-foralls
 ghci> :t MkT
-MkT :: forall (b::k). T b
-ghci> :set -fprint-explicit-kinds
-ghci> :t MkT
-MkT :: forall (k::BOX) (b:k). T b
+MkT :: forall (k :: BOX) (a :: k). T k a
 </screen>
          </para>
         </listitem>
@@ -1719,15 +1736,50 @@ f "2"    = 2
           <indexterm><primary>unused binds, warning</primary></indexterm>
           <indexterm><primary>binds, unused</primary></indexterm>
           <para>Report any function definitions (and local bindings)
-          which are unused.  For top-level functions, the warning is
-          only given if the binding is not exported.</para>
-          <para>A definition is regarded as "used" if (a) it is exported, or (b) it is
-            mentioned in the right hand side of another definition that is used, or (c) the
-            function it defines begins with an underscore.  The last case provides a
-            way to suppress unused-binding warnings selectively.  </para>
-          <para> Notice that a variable
-            is reported as unused even if it appears in the right-hand side of another
-            unused binding. </para>
+          which are unused.  More precisely:
+
+          <itemizedlist>
+          <listitem><para>Warn if a binding brings into scope a variable that is not used,
+          except if the variable's name starts with an underscore.  The "starts-with-underscore"
+          condition provides a way to selectively disable the warning.
+        </para>
+          <para>
+          A variable is regarded as "used" if 
+          <itemizedlist>
+          <listitem><para>It is exported, or</para></listitem>
+          <listitem><para>It appears in the right hand side of a binding that binds at 
+                           least one used variable that is used</para></listitem>
+          </itemizedlist>
+          For example
+            <programlisting>
+module A (f) where
+f = let (p,q) = rhs1 in t p  -- Warning about unused q
+t = rhs3                     -- No warning: f is used, and hence so is t
+g = h x                      -- Warning: g unused
+h = rhs2                     -- Warning: h is only used in the right-hand side of another unused binding
+_w = True                    -- No warning: _w starts with an underscore
+            </programlisting>
+          </para></listitem>
+
+          <listitem><para>
+          Warn if a pattern binding binds no variables at all, unless it is a lone, possibly-banged, wild-card pattern.
+          For example:
+            <programlisting>
+Just _ = rhs3    -- Warning: unused pattern binding
+(_, _) = rhs4    -- Warning: unused pattern binding
+_  = rhs3        -- No warning: lone wild-card pattern
+!_ = rhs4        -- No warning: banged wild-card pattern; behaves like seq
+            </programlisting>
+          The motivation for allowing lone wild-card patterns is they
+          are not very different from <literal>_v = rhs3</literal>,
+          which elicits no warning; and they can be useful to add a type
+          constraint, e.g. <literal>_ = x::Int</literal>. A lone
+          banged wild-card pattern is is useful as an alternative 
+          (to <literal>seq</literal>) way to force evaluation.
+        </para>
+        </listitem>
+          </itemizedlist>
+          </para>
         </listitem>
       </varlistentry>
 
@@ -1814,6 +1866,16 @@ f "2"    = 2
         </listitem>
       </varlistentry>
 
+      <varlistentry>
+        <term><option>-fwarn-inline-rule-shadowing</option>:</term>
+        <listitem>
+          <indexterm><primary><option>-fwarn-inline-rule-shadowing</option></primary></indexterm>
+          <para>Warn if a rewrite RULE might fail to fire because the function might be
+                inlined before the rule has a chance to fire.  See <xref linkend="rules-inline"/>.
+              </para>
+        </listitem>
+      </varlistentry>
+
     </variablelist>
 
     <para>If you're feeling really paranoid, the
@@ -2967,44 +3029,6 @@ data D = D !C
   </sect1>
 
 &runtime;
-
-<sect1 id="ext-core">
-  <title>Generating and compiling External Core Files</title>
-
-  <indexterm><primary>intermediate code generation</primary></indexterm>
-
-  <para>GHC can dump its optimized intermediate code (said to be in &ldquo;Core&rdquo; format)
-  to a file as a side-effect of compilation. Non-GHC back-end tools can read and process Core files; these files have the suffix
-  <filename>.hcr</filename>. The Core format is described in <ulink url="../../core.pdf">
-  <citetitle>An External Representation for the GHC Core Language</citetitle></ulink>,
-  and sample tools
-  for manipulating Core files (in Haskell) are available in the
-  <ulink url="http://hackage.haskell.org/package/extcore">extcore package on Hackage</ulink>.  Note that the format of <literal>.hcr</literal>
-  files is <emphasis>different</emphasis> from the Core output format that GHC generates
-  for debugging purposes (<xref linkend="options-debugging"/>), though the two formats appear somewhat similar.</para>
-
-  <para>The Core format natively supports notes which you can add to
-  your source code using the <literal>CORE</literal> pragma (see <xref
-  linkend="pragmas"/>).</para>
-
-    <variablelist>
-
-        <varlistentry>
-          <term>
-            <option>-fext-core</option>
-            <indexterm><primary><option>-fext-core</option></primary></indexterm>
-          </term>
-          <listitem>
-            <para>Generate <literal>.hcr</literal> files.</para>
-          </listitem>
-        </varlistentry>
-
-    </variablelist>
-
-<para>Currently (as of version 6.8.2), GHC does not have the ability to read in External Core files as source. If you would like GHC to have this ability, please <ulink url="http://ghc.haskell.org/trac/ghc/wiki/MailingListsAndIRC">make your wishes known to the GHC Team</ulink>.</para>
-
-</sect1>
-
 &debug;
 &flags;
 
diff --git a/docs/vh/Makefile b/docs/vh/Makefile
deleted file mode 100644
index 4410e4953dc9..000000000000
--- a/docs/vh/Makefile
+++ /dev/null
@@ -1,7 +0,0 @@
-TOP = ../..
-include $(TOP)/mk/boilerplate.mk
-
-XML_DOC = vh
-INSTALL_XML_DOC = vh
-
-include $(TOP)/mk/target.mk
diff --git a/docs/vh/vh.xml b/docs/vh/vh.xml
deleted file mode 100644
index 5c25e3109c6a..000000000000
--- a/docs/vh/vh.xml
+++ /dev/null
@@ -1,312 +0,0 @@
-<?xml version="1.0" encoding="iso-8859-1"?>
-<!DOCTYPE article PUBLIC "-//OASIS//DTD DocBook XML V4.5//EN"
-   "http://www.oasis-open.org/docbook/xml/4.5/docbookx.dtd" [
-]>
-<article id="visual-haskell">
-
-  <articleinfo>
-
-    <title>Visual Haskell User's Guide</title>
-  <author>
-    <firstname>Simon</firstname>
-    <surname>Marlow</surname>
-    <email>simonmar@microsoft.com</email>
-  </author>
-  <author>
-    <firstname>Krasimir</firstname>
-    <surname>Angelov</surname>
-    <email>kr.angelov@gmail.com</email>
-  </author>
-
-  </articleinfo>
-
-  <section id="sec-introduction">
-    <title>Introduction</title>
-
-    <para>Visual Haskell is a plugin for Microsoft's Visual Studio
-      development environment to support development of Haskell software.
-      Like the other Visual languages, Visual Haskell integrates with the
-      Visual Studio editor to provide interactive features to aid Haskell
-      development, and it enables the construction of projects consisting of
-      multiple Haskell modules.</para>
-
-    <section id="sec-obtaining">
-      <title>Installing Visual Haskell</title>
-
-      <para>In order to use Visual Haskell, you need <ulink url="http://msdn.microsoft.com/vstudio/productinfo/">Visual Studio .NET
-        2003</ulink>.  Right now, this is the only supported version of Visual
-        Studio - unfortunately we haven't yet added support for the 2005
-        Beta.  The Express languages (Visual C++ Express etc.) also will not
-        work, because they don't have support for plugins.</para>
-
-      <para>You don't need to install GHC separately: Visual Haskell
-        is bundled with a complete GHC distribution, and various other tools
-        (Happy, Alex, Haddock).</para>
-
-      <para>The latest Visual Haskell installer can be obtained from
-        here:</para>
-
-      <para><ulink
-        url="http://www.haskell.org/visualhaskell/"><literal>http://www.haskell.org/visualhaskell/</literal></ulink></para>
-    </section>
-
-    <section id="release-notes">
-      <title>Release Notes</title>
-
-      <section>
-        <title>Version 0.0, first release</title>
-
-        <para>This release is a technology preview, and should be considered
-          alpha quality.  It works for us, but you are fairly likely to
-          encounter problems.  If you're willing to try it out and report
-          bugs, we'd be grateful for the feedback.</para>
-
-        <itemizedlist>
-          <listitem>
-            <para>This release of Visual Haskell is bundled with a
-              development snapshot of GHC, version 6.5 from around 14
-              September 2005.  This version of GHC is used to provide the
-              interactive editing features, and will be used to compile all
-              code inside Visual Haskell.  It is possible that in future
-              releases we may be able to relax this tight coupling between
-              Visual Haskell and the bundled GHC.</para>
-
-            <para>Please note that future releases of Visual
-              Haskell will update the compiler, and hence the
-              packages, and so may break your code.  Also note that because
-              the bundled GHC is not a released version, it may have bugs and
-              quirks itself: please report them as usual to
-              <email>glasgow-haskell-bugs@haskell.org</email>.</para>
-        </listitem>
-
-        <listitem>
-          <para>We're not making source code for the plugin generally
-            available at this time, due to licensing restrictions on the
-            Visual Studio APIs that the plugin uses (for more
-            information see <ulink
-              url="http://msdn.microsoft.com/vstudio/extend/">Visual Studio
-              Extensibility Center</ulink>).  If you're interested in
-            contributing to Visual Haskell, please get in touch with the
-            authors.</para>
-        </listitem>
-      </itemizedlist>
-    </section>
-  </section>
-
-    <section id="sec-bugs">
-      <title>Getting support, reporting bugs</title>
-      <para>Please report bugs to
-        <email>glasgow-haskell-bugs@haskell.org</email> (subscribe <ulink url="http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs">here</ulink>), clearly indicating
-        that your bug report relates to Visual Haskell, and giving as much
-        information as possible so that we can reproduce the bug.  Even if
-        you can't reproduce the bug reliably, it is still useful to report
-        what you've seen.</para>
-
-      <para>For help and support, use the
-        <email>glasgow-haskell-users@haskell.org</email> (subscribe <ulink
-          url="http://www.haskell.org/mailman/listinfo/glasgow-haskell-users">here</ulink>) mailing list.</para>
-    </section>
-
-    <section id="sec-license">
-      <title>License</title>
-
-    <blockquote>
-      <para>Copyright © Microsoft Corporation. All rights reserved.</para>
-      <para>Copyright © The University of Glasgow. All rights reserved.</para>
-      <para>Copyright © Krasimir Angelov. All rights reserved.</para>
-
-      <para>Redistribution and use in source and binary forms, with or without
-        modification,  are permitted provided that the following conditions
-        are met:</para>
-
-      <itemizedlist>
-        <listitem>
-          <para>Redistributions of source code must retain the above
-            copyright notice, this list of conditions and the following
-            disclaimer.</para>
-        </listitem>
-
-        <listitem>
-          <para>Redistributions in binary form must reproduce the above
-            copyright notice, this list of conditions and the following
-            disclaimer in the documentation and/or other materials provided
-            with the distribution.</para>
-        </listitem>
-
-        <listitem>
-          <para>The names of the copyright holders may not be used to endorse
-            or promote products derived from this software without specific
-            prior written permission.</para>
-        </listitem>
-      </itemizedlist>
-
-      <para>THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS
-        "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
-        LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
-        FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
-        COPYRIGHT HOLDERS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
-        SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
-        LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF
-        USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED
-        AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
-        LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
-        ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
-        POSSIBILITY OF SUCH DAMAGE.</para>
-    </blockquote>
-  </section>
-
-  </section>
-
-  <section id="sec-using">
-    <title>Using Visual Haskell</title>
-
-    <section>
-      <title>Overview of features</title>
-
-      <para>The following features are provided in the Visual Studio editor
-        when editing Haskell code:</para>
-
-      <itemizedlist>
-        <listitem>
-          <para>Automatic checking of code as you type, and visual indication
-            of parse errors, scoping errors and type errors.</para>
-        </listitem>
-
-        <listitem>
-        <para>Quick info: hovering the mouse over an identifier pops up
-          an information box, including the type of the identifier.</para>
-        </listitem>
-
-        <listitem>
-        <para>A drop-down bar at the top of the editing window lists the
-          top-level declarations in the module, and allows quick navigation
-          to a declaration.</para>
-        </listitem>
-
-        <listitem>
-        <para>Name completion for identifiers in scope: press Ctrl+Space
-          after a partial identifier to see the completions.</para>
-        </listitem>
-
-        <listitem>
-        <para>Go to declaration: right clicking on an identifier and
-          selecting "Go to declaration" will jump the cursor to the
-          declaration of the identifier.  This works for locally-defined
-          identifiers and those defined in another module of the project; it
-          does not work for library functions currently.</para>
-        </listitem>
-      </itemizedlist>
-
-    <para>The following features are provided by the project system for
-      constructing Haskell projects:</para>
-
-    <itemizedlist>
-      <listitem>
-        <para>Multi-module Haskell projects are fully supported, based on the
-          <ulink url="http://www.haskell.org/cabal">Cabal</ulink>
-          infrastructure.  A project in Visual Haskell <emphasis>is</emphasis>
-          a Cabal package, and vice-versa.  A Visual Studio project can be
-          taken to a machine without Visual Haskell and built/installed as a
-          normal Cabal package, and an existing Cabal package can be edited
-          directly in Visual Haskell<footnote><para>This works as long as the
-              Cabal package is using Cabal's simple build system; Cabal
-              packages using their own build systems cannot be edited in Visual
-              Haskell.</para>
-          </footnote>.</para>
-      </listitem>
-
-      <listitem>
-        <para>Editing of most of the package meta-data is supported through
-          the project property pages.</para>
-      </listitem>
-
-      <listitem>
-        <para>The interactive editing features work across multiple modules in
-          a project.  When one module is edited, changes are automatically
-          propagated to dependent modules, even if the edited module has not yet
-          been saved.</para>
-      </listitem>
-
-      <listitem>
-        <para>Building is supported through the Cabal build system, and build
-          errors are communicated back to the editor and placed in the task
-          list.  Use any of the Visual Studio build commands (e.g. Build
-          Project from the context menu on the project, or Ctrl-Shift-B to
-          build the whole solution).</para>
-      </listitem>
-
-    </itemizedlist>
-
-  <para>Additionally, Visual Haskell is bundled with a large collection of
-    documentation: the GHC manual, the hierarchical libraries reference, and
-    other material all of which can be browsed within Visual Studio
-    itself.</para>
-  </section>
-
-  <section>
-    <title>Getting Started</title>
-
-    <para>After installing Visual Haskell, start up Visual Studio as you
-      would normally, and observe that on the splash screen where it lists
-      the supported languages you should now see an icon for Visual
-      Haskell (if you don't see this, something has gone wrong... please let
-      us know).</para>
-
-    <para>Firstly, take a look at the bundled documentation.  Go to
-      Help-&gt;Contents, and you should see the &ldquo;Visual Haskell Help
-      Collection&rdquo;, which contains a large collection of GHC and
-      Haskell-related documentaiton, including this document.</para>
-
-    <para>To start using Visual Haskell right away, create a new
-      project (File-&gt;New-&gt;Project...).  Select one of the Haskell
-      project types (Console Application or Library Package), and hit Ok.
-      The project will be created for you, and an example module
-      added: <literal>Main.hs</literal> for an application, or
-      <literal>Module1.hs</literal> for a library.</para>
-
-    <para>You can now start adding code to
-      <literal>Main.hs</literal>, or adding new modules.  To add a new
-      module, right-click on the <literal>src</literal> directory, and
-      select Add-&gt;New Item.  Visual Haskell supports hierarchical
-      modules too: you can add new folders using the same Add menu to
-      create new nodes in the hierarchy.</para>
-
-    <para>If you have any errors in your code, they will be underlined with
-      a red squiggly line.  Select the Tasks window (usually a tab near the
-      bottom of the Visual Studio window) to see the error messages, and
-      click on an error message to jump to it in the editor.</para>
-
-    <para>To build the program, hit Ctrl-Shift-B, or select one of the
-      options from the Build menu.</para>
-  </section>
-
-  <section>
-    <title>Editing Haskell code</title>
-
-      <para>(ToDo: more detail here)</para>
-
-      <para>Your module must be plain Haskell (<literal>.hs</literal>) for
-        the interactive features to fully work.  If your module is
-        pre-processed with CPP or Literate Haskell, then Visual Haskell will
-        only check the module when it is saved; between saves the source will
-        not be checked for errors and the type information will not be
-        updated.  If the source file is
-        pre-processed with Happy or another pre-processor, then you may have
-        to build the project before the type information will be updated
-        (because the pre-processor is only run as part of the build process).
-        Pre-processed source files work fine in a multi-module setting; you
-        can have modules which depend on a pre-processed module and full
-        interactive checking will still be available in those modules.</para>
-
-      <para>Because Visual Haskell is using GHC as a backend for its
-        interactive editing features, it supports the full GHC language,
-        including all extensions.</para>
-    </section>
-
-    <section>
-      <title>Using Projects</title>
-      <para>(ToDo: more detail here)</para>
-    </section>
-
-  </section>
-</article>
diff --git a/driver/ghc-usage.txt b/driver/ghc-usage.txt
index 239b4540d840..0b56db7419ae 100644
--- a/driver/ghc-usage.txt
+++ b/driver/ghc-usage.txt
@@ -5,12 +5,12 @@ Usage:
 To compile and link a complete Haskell program, run the compiler like
 so:
 
-    $$ --make Main
+    $$ Main
 
 where the module Main is in a file named Main.hs (or Main.lhs) in the
 current directory.  The other modules in the program will be located
 and compiled automatically, and the linked program will be placed in
-the file `a.out' (or `Main.exe' on Windows).
+the file `Main' (or `Main.exe' on Windows).
 
 Alternatively, $$ can be used to compile files individually.  Each
 input file is guided through (some of the) possible phases of a
@@ -73,7 +73,7 @@ Given the above, here are some TYPICAL invocations of $$:
 The User's Guide has more information about GHC's *many* options.  An
 online copy can be found here:
 
-   http://haskell.org/haskellwiki/GHC
+   http://www.haskell.org/ghc/docs/latest/html/users_guide/
 
 If you *really* want to see every option, then you can pass
 '--show-options' to the compiler.
diff --git a/driver/ghci-usage.txt b/driver/ghci-usage.txt
index d9628b2c4142..1a848fc9b5a4 100644
--- a/driver/ghci-usage.txt
+++ b/driver/ghci-usage.txt
@@ -21,4 +21,4 @@ GHC does.  Some of the options that are commonly used are:
 Full details can be found in the User's Guide, an online copy of which
 can be found here:
 
-    http://haskell.org/haskellwiki/GHC
+    http://www.haskell.org/ghc/docs/latest/html/users_guide/
diff --git a/driver/ghci/ghc.mk b/driver/ghci/ghc.mk
index 4c5c09e761d7..ba6984c37aca 100644
--- a/driver/ghci/ghc.mk
+++ b/driver/ghci/ghc.mk
@@ -22,7 +22,7 @@ install_driver_ghci:
 	$(call removeFiles,                                "$(WRAPPER)")
 	$(CREATE_SCRIPT)                                   "$(WRAPPER)"
 	echo '#!$(SHELL)'                               >> "$(WRAPPER)"
-	echo 'exec "$(bindir)/ghc-$(ProjectVersion)" --interactive $${1+"$$@"}' >> "$(WRAPPER)"
+	echo 'exec "$(bindir)/ghc-$(ProjectVersion)" --interactive "$$@"' >> "$(WRAPPER)"
 	$(EXECUTABLE_FILE)                                 "$(WRAPPER)"
 	$(call removeFiles,"$(DESTDIR)$(bindir)/ghci")
 	$(LN_S) ghci-$(ProjectVersion) "$(DESTDIR)$(bindir)/ghci"
@@ -57,7 +57,7 @@ install_driver_ghcii:
 	$(call INSTALL_DIR,$(DESTDIR)$(bindir))
 	$(call removeFiles,"$(GHCII_SCRIPT)")
 	echo "#!$(SHELL)"                                  >> $(GHCII_SCRIPT)
-	echo 'exec "$$0"/../ghc --interactive $${1+"$$@"}' >> $(GHCII_SCRIPT)
+	echo 'exec "$$(dirname "$$0")"/ghc --interactive "$$@"' >> $(GHCII_SCRIPT)
 	$(EXECUTABLE_FILE) $(GHCII_SCRIPT)
 	cp $(GHCII_SCRIPT) $(GHCII_SCRIPT_VERSIONED)
 	$(EXECUTABLE_FILE) $(GHCII_SCRIPT_VERSIONED)
diff --git a/ghc.mk b/ghc.mk
index f48714ebf474..8ba90fe83137 100644
--- a/ghc.mk
+++ b/ghc.mk
@@ -282,11 +282,6 @@ include rules/dependencies.mk
 include rules/build-dependencies.mk
 include rules/include-dependencies.mk
 
-# -----------------------------------------------------------------------------
-# Dynamic library references
-
-include rules/relative-dynlib-references.mk
-
 # -----------------------------------------------------------------------------
 # Build package-data.mk files
 
@@ -430,13 +425,6 @@ PACKAGES_STAGE2 += haskell98
 PACKAGES_STAGE2 += haskell2010
 endif
 
-# We normally install only the packages down to this point
-REGULAR_INSTALL_PACKAGES := $(addprefix libraries/,$(PACKAGES_STAGE1))
-ifeq "$(Stage1Only)" "NO"
-REGULAR_INSTALL_PACKAGES += compiler
-endif
-REGULAR_INSTALL_PACKAGES += $(addprefix libraries/,$(PACKAGES_STAGE2))
-
 PACKAGES_STAGE1 += xhtml
 ifeq "$(Windows_Target)" "NO"
 ifneq "$(TargetOS_CPP)" "ios"
@@ -445,6 +433,13 @@ endif
 endif
 PACKAGES_STAGE1 += haskeline
 
+# We normally install only the packages down to this point
+REGULAR_INSTALL_PACKAGES := $(addprefix libraries/,$(PACKAGES_STAGE1))
+ifneq "$(Stage1Only)" "YES"
+REGULAR_INSTALL_PACKAGES += compiler
+endif
+REGULAR_INSTALL_PACKAGES += $(addprefix libraries/,$(PACKAGES_STAGE2))
+
 # If we have built the programs with dynamic libraries, then
 # ghc will be dynamically linked against haskeline.so etc, so
 # we need the dynamic libraries of everything down to here
@@ -457,9 +452,17 @@ ifneq "$(CrossCompiling)" "YES"
 define addExtraPackage
 ifeq "$2" "-"
 # Do nothing; this package is already handled above
-else ifeq "$2 $$(GhcProfiled)" "dph YES"
-# Ignore the package: These packages need TH, which is incompatible
-# with a profiled GHC
+else ifeq "$2" "dph"
+## DPH-specific clause
+ifeq "$$(GhcProfiled)" "YES"
+# Ignore package: The DPH packages need TH, which is incompatible with
+# a profiled GHC
+else ifneq "$$(BUILD_DPH)" "YES"
+# Ignore package: DPH was disabled
+else
+PACKAGES_STAGE2 += $1
+endif
+## end of DPH-specific clause
 else
 PACKAGES_STAGE2 += $1
 endif
@@ -469,7 +472,7 @@ endif
 
 # If we want to just install everything, then we want all the packages
 SUPERSIZE_INSTALL_PACKAGES := $(addprefix libraries/,$(PACKAGES_STAGE1))
-ifeq "$(Stage1Only)" "NO"
+ifneq "$(Stage1Only)" "YES"
 SUPERSIZE_INSTALL_PACKAGES += compiler
 endif
 SUPERSIZE_INSTALL_PACKAGES += $(addprefix libraries/,$(PACKAGES_STAGE2))
@@ -640,8 +643,10 @@ ifneq "$(CLEANING)" "YES"
 BUILD_DIRS += $(patsubst %, libraries/%, $(PACKAGES_STAGE2))
 BUILD_DIRS += $(patsubst %, libraries/%, $(PACKAGES_STAGE1))
 BUILD_DIRS += $(patsubst %, libraries/%, $(filter-out $(PACKAGES_STAGE1),$(PACKAGES_STAGE0)))
+ifeq "$(BUILD_DPH)" "YES"
 BUILD_DIRS += $(wildcard libraries/dph)
 endif
+endif
 
 
 ifeq "$(INTEGER_LIBRARY)" "integer-gmp"
@@ -658,7 +663,7 @@ BUILD_DIRS += compiler
 BUILD_DIRS += utils/hsc2hs
 BUILD_DIRS += utils/ghc-pkg
 BUILD_DIRS += utils/testremove
-ifeq "$(Stage1Only)" "NO"
+ifneq "$(Stage1Only)" "YES"
 BUILD_DIRS += utils/ghctags
 endif
 BUILD_DIRS += utils/dll-split
@@ -906,10 +911,10 @@ install_packages: rts/dist/package.conf.install
 	$(call INSTALL_DIR,"$(DESTDIR)$(topdir)")
 	$(call removeTrees,"$(INSTALLED_PACKAGE_CONF)")
 	$(call INSTALL_DIR,"$(INSTALLED_PACKAGE_CONF)")
-	$(call INSTALL_DIR,"$(DESTDIR)$(topdir)/rts-1.0")
-	$(call installLibsTo, $(RTS_INSTALL_LIBS), "$(DESTDIR)$(topdir)/rts-1.0")
+	$(call INSTALL_DIR,"$(DESTDIR)$(topdir)/rts")
+	$(call installLibsTo, $(RTS_INSTALL_LIBS), "$(DESTDIR)$(topdir)/rts")
 	$(foreach p, $(INSTALL_DYNLIBS), \
-	    $(call installLibsTo, $(wildcard $p/dist-install/build/*.so $p/dist-install/build/*.dll $p/dist-install/build/*.dylib), "$(DESTDIR)$(topdir)/$($p_PACKAGE)-$($p_dist-install_VERSION)"))
+	    $(call installLibsTo, $(wildcard $p/dist-install/build/*.so $p/dist-install/build/*.dll $p/dist-install/build/*.dylib), "$(DESTDIR)$(topdir)/$($p_dist-install_PACKAGE_KEY)"))
 	$(foreach p, $(INSTALL_PACKAGES),                             \
 	    $(call make-command,                                      \
 	           "$(ghc-cabal_INPLACE)" copy                        \
@@ -1014,12 +1019,12 @@ unix-binary-dist-prep:
 	$(call removeFiles,$(BIN_DIST_PREP_TAR))
 # h means "follow symlinks", e.g. if aclocal.m4 is a symlink to a source
 # tree then we want to include the real file, not a symlink to it
-	cd bindistprep && "$(TAR_CMD)" hcf - -T ../bindist-list | bzip2 -c > ../$(BIN_DIST_PREP_TAR_BZ2)
+	cd bindistprep && "$(TAR_CMD)" hcf - -T ../bindist-list | $(TAR_COMP_CMD) -c > ../$(BIN_DIST_PREP_TAR_COMP)
 
 windows-binary-dist-prep:
 	$(call removeTrees,bindistprep/)
 	$(MAKE) prefix=$(TOP)/$(BIN_DIST_PREP_DIR) install
-	cd bindistprep && "$(TAR_CMD)" cf - $(BIN_DIST_NAME) | bzip2 -c > ../$(BIN_DIST_PREP_TAR_BZ2)
+	cd bindistprep && "$(TAR_CMD)" cf - $(BIN_DIST_NAME) | $(TAR_COMP_CMD) -c > ../$(BIN_DIST_PREP_TAR_COMP)
 
 # tryTimes tries to run its third argument multiple times, until it
 # succeeds. Don't call it directly; call try10Times instead.
@@ -1037,7 +1042,7 @@ try10Times = $(call tryTimes,,x x x x x x x x x x,$1) { echo Failed; false; }
 
 .PHONY: publish-binary-dist
 publish-binary-dist:
-	$(call try10Times,$(PublishCp) $(BIN_DIST_TAR_BZ2) $(PublishLocation)/dist)
+	$(call try10Times,$(PublishCp) $(BIN_DIST_TAR_COMP) $(PublishLocation)/dist)
 
 ifeq "$(mingw32_TARGET_OS)" "1"
 DOCDIR_TO_PUBLISH = $(BIN_DIST_INST_DIR)/doc
@@ -1077,17 +1082,17 @@ SRC_DIST_BASE_NAME = ghc-$(ProjectVersion)
 SRC_DIST_GHC_NAME                 = ghc-$(ProjectVersion)-src
 SRC_DIST_GHC_ROOT                 = $(SRC_DIST_ROOT)/ghc
 SRC_DIST_GHC_DIR                  = $(SRC_DIST_GHC_ROOT)/$(SRC_DIST_BASE_NAME)
-SRC_DIST_GHC_TARBALL              = $(SRC_DIST_ROOT)/$(SRC_DIST_GHC_NAME).tar.bz2
+SRC_DIST_GHC_TARBALL              = $(SRC_DIST_ROOT)/$(SRC_DIST_GHC_NAME).tar.$(TAR_COMP_EXT)
 
 SRC_DIST_WINDOWS_TARBALLS_NAME    = ghc-$(ProjectVersion)-windows-extra-src
 SRC_DIST_WINDOWS_TARBALLS_ROOT    = $(SRC_DIST_ROOT)/windows-tarballs
 SRC_DIST_WINDOWS_TARBALLS_DIR     = $(SRC_DIST_WINDOWS_TARBALLS_ROOT)/$(SRC_DIST_BASE_NAME)
-SRC_DIST_WINDOWS_TARBALLS_TARBALL = $(SRC_DIST_ROOT)/$(SRC_DIST_WINDOWS_TARBALLS_NAME).tar.bz2
+SRC_DIST_WINDOWS_TARBALLS_TARBALL = $(SRC_DIST_ROOT)/$(SRC_DIST_WINDOWS_TARBALLS_NAME).tar.$(TAR_COMP_EXT)
 
 SRC_DIST_TESTSUITE_NAME           = ghc-$(ProjectVersion)-testsuite
 SRC_DIST_TESTSUITE_ROOT           = $(SRC_DIST_ROOT)/testsuite-ghc
 SRC_DIST_TESTSUITE_DIR            = $(SRC_DIST_TESTSUITE_ROOT)/$(SRC_DIST_BASE_NAME)
-SRC_DIST_TESTSUITE_TARBALL        = $(SRC_DIST_ROOT)/$(SRC_DIST_TESTSUITE_NAME).tar.bz2
+SRC_DIST_TESTSUITE_TARBALL        = $(SRC_DIST_ROOT)/$(SRC_DIST_TESTSUITE_NAME).tar.$(TAR_COMP_EXT)
 
 #
 # Files to include in source distributions
@@ -1114,6 +1119,9 @@ define sdist_ghc_file
 	mv $(SRC_DIST_GHC_DIR)/$1/$3/$4/$5.$6 $(SRC_DIST_GHC_DIR)/$1/$3/$4/$5.$6.source
 endef
 
+# Extra packages which shouldn't be in the source distribution: see #8801
+EXTRA_PACKAGES=parallel stm random primitive vector dph
+
 .PHONY: sdist-ghc-prep
 sdist-ghc-prep :
 	$(call removeTrees,$(SRC_DIST_GHC_ROOT))
@@ -1128,11 +1136,11 @@ sdist-ghc-prep :
 	$(call removeTrees,$(SRC_DIST_GHC_DIR)/libraries/stamp/)
 	$(call removeTrees,$(SRC_DIST_GHC_DIR)/compiler/stage[123])
 	$(call removeFiles,$(SRC_DIST_GHC_DIR)/mk/build.mk)
+	for i in $(EXTRA_PACKAGES); do $(RM) $(RM_OPTS_REC) $(SRC_DIST_GHC_DIR)/libraries/$$i/; done
 	$(call sdist_ghc_file,compiler,stage2,cmm,,CmmLex,x)
 	$(call sdist_ghc_file,compiler,stage2,cmm,,CmmParse,y)
 	$(call sdist_ghc_file,compiler,stage2,parser,,Lexer,x)
 	$(call sdist_ghc_file,compiler,stage2,parser,,Parser,y.pp)
-	$(call sdist_ghc_file,compiler,stage2,parser,,ParserCore,y)
 	$(call sdist_ghc_file,utils/hpc,dist-install,,,HpcParser,y)
 	$(call sdist_ghc_file,utils/genprimopcode,dist,,,Lexer,x)
 	$(call sdist_ghc_file,utils/genprimopcode,dist,,,Parser,y)
@@ -1158,13 +1166,22 @@ sdist-testsuite-prep :
 	mkdir $(SRC_DIST_TESTSUITE_DIR)
 	mkdir $(SRC_DIST_TESTSUITE_DIR)/testsuite
 	cd $(SRC_DIST_TESTSUITE_DIR)/testsuite && lndir $(TOP)/testsuite
-	$(call removeTrees,$(SRC_DIST_TESTSUITE_DIR)/testsuite/.git)
+
+.PHONY: sdist-ghc
+sdist-ghc: sdist-ghc-prep
+	cd $(SRC_DIST_GHC_ROOT)              && "$(TAR_CMD)" chf - $(SRC_DIST_BASE_NAME) 2> src_ghc_log               | $(TAR_COMP_CMD) -c > $(TOP)/$(SRC_DIST_GHC_TARBALL)
+
+.PHONY: sdist-windows-tarballs
+sdist-windows-tarballs: sdist-windows-tarballs-prep
+	cd $(SRC_DIST_WINDOWS_TARBALLS_ROOT) && "$(TAR_CMD)" chf - $(SRC_DIST_BASE_NAME) 2> windows_extra_src_ghc_log | $(TAR_COMP_CMD) -c > $(TOP)/$(SRC_DIST_WINDOWS_TARBALLS_TARBALL)
+
+.PHONY: sdist-testsuite
+sdist-testsuite: sdist-testsuite-prep
+	cd $(SRC_DIST_TESTSUITE_ROOT)        && "$(TAR_CMD)" chf - $(SRC_DIST_BASE_NAME) 2> testsuite_log             | $(TAR_COMP_CMD) -c > $(TOP)/$(SRC_DIST_TESTSUITE_TARBALL)
+
 
 .PHONY: sdist
-sdist : sdist-ghc-prep sdist-windows-tarballs-prep sdist-testsuite-prep
-	cd $(SRC_DIST_GHC_ROOT)              && "$(TAR_CMD)" chf - $(SRC_DIST_BASE_NAME) 2> src_ghc_log               | bzip2 > $(TOP)/$(SRC_DIST_GHC_TARBALL)
-	cd $(SRC_DIST_WINDOWS_TARBALLS_ROOT) && "$(TAR_CMD)" chf - $(SRC_DIST_BASE_NAME) 2> windows_extra_src_ghc_log | bzip2 > $(TOP)/$(SRC_DIST_WINDOWS_TARBALLS_TARBALL)
-	cd $(SRC_DIST_TESTSUITE_ROOT)        && "$(TAR_CMD)" chf - $(SRC_DIST_BASE_NAME) 2> testsuite_log             | bzip2 > $(TOP)/$(SRC_DIST_TESTSUITE_TARBALL)
+sdist : sdist-ghc sdist-windows-tarballs sdist-testsuite
 
 sdist-manifest : $(SRC_DIST_GHC_TARBALL)
 	tar tjf $(SRC_DIST_GHC_TARBALL) | sed "s|^ghc-$(ProjectVersion)/||" | sort >sdist-manifest
@@ -1194,6 +1211,11 @@ sdist_%:
 
 CLEAN_FILES += libraries/bootstrapping.conf
 CLEAN_FILES += libraries/integer-gmp/cbits/GmpDerivedConstants.h
+CLEAN_FILES += libraries/integer-gmp/include/HsIntegerGmp.h
+CLEAN_FILES += libraries/base/include/EventConfig.h
+CLEAN_FILES += mk/config.mk.old
+CLEAN_FILES += mk/project.mk.old
+CLEAN_FILES += compiler/ghc.cabal.old
 
 # These are no longer generated, but we still clean them for a while
 # as they may still be in old GHC trees:
@@ -1211,6 +1233,10 @@ clean : clean_files clean_libraries
 .PHONY: clean_files
 clean_files :
 	$(call removeFiles,$(CLEAN_FILES))
+# this is here since CLEAN_FILES can't handle folders
+	$(call removeTrees,includes/dist-derivedconstants)
+	$(call removeTrees,inplace/bin)
+	$(call removeTrees,inplace/lib)
 
 .PHONY: clean_libraries
 clean_libraries: $(patsubst %,clean_libraries/%_dist-install,$(PACKAGES_STAGE1) $(PACKAGES_STAGE2))
@@ -1259,6 +1285,7 @@ distclean : clean
 	$(call removeFiles,docs/index.html)
 	$(call removeFiles,libraries/prologue.txt)
 	$(call removeFiles,distrib/configure.ac)
+	$(call removeFiles,ch01.html ch02.html index.html)
 
 # ./configure also makes these.
 	$(call removeFiles,mk/config.h)
@@ -1341,7 +1368,7 @@ validate_build_xhtml:
 	cd libraries/xhtml && ./Setup configure --with-ghc="$(BINDIST_PREFIX)/bin/ghc" $(BINDIST_HADDOCK_FLAG) $(BINDIST_LIBRARY_FLAGS) --global --builddir=dist-bindist --prefix="$(BINDIST_PREFIX)"
 	cd libraries/xhtml && ./Setup build   --builddir=dist-bindist
 ifeq "$(HADDOCK_DOCS)" "YES"
-	cd libraries/xhtml && ./Setup haddock --builddir=dist-bindist
+	cd libraries/xhtml && ./Setup haddock --ghc-options=-optP-P --builddir=dist-bindist
 endif
 	cd libraries/xhtml && ./Setup install --builddir=dist-bindist
 	cd libraries/xhtml && ./Setup clean   --builddir=dist-bindist
diff --git a/ghc/GhciMonad.hs b/ghc/GhciMonad.hs
index 54e7e0c984cc..22109c428dc8 100644
--- a/ghc/GhciMonad.hs
+++ b/ghc/GhciMonad.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP, FlexibleInstances, UnboxedTuples, MagicHash #-}
 {-# OPTIONS_GHC -fno-cse -fno-warn-orphans #-}
 -- -fno-cse is needed for GLOBAL_VAR's to behave properly
 
@@ -32,6 +33,7 @@ import Outputable       hiding (printForUser, printForUserPartWay)
 import qualified Outputable
 import Util
 import DynFlags
+import FastString
 import HscTypes
 import SrcLoc
 import Module
@@ -104,7 +106,8 @@ data GHCiState = GHCiState
 
         -- help text to display to a user
         short_help :: String,
-        long_help  :: String
+        long_help  :: String,
+        lastErrorLocations :: IORef [(FastString, Int)]
      }
 
 type TickArray = Array Int [(BreakIndex,SrcSpan)]
@@ -316,7 +319,12 @@ printTimes dflags allocs psecs
             secs_str = showFFloat (Just 2) secs
         putStrLn (showSDoc dflags (
                  parens (text (secs_str "") <+> text "secs" <> comma <+>
-                         text (show allocs) <+> text "bytes")))
+                         text (separateThousands allocs) <+> text "bytes")))
+  where
+    separateThousands n = reverse . sep . reverse . show $ n
+      where sep n'
+              | length n' <= 3 = n'
+              | otherwise = take 3 n' ++ "," ++ sep (drop 3 n')
 
 -----------------------------------------------------------------------------
 -- reverting CAFs
diff --git a/ghc/InteractiveUI.hs b/ghc/InteractiveUI.hs
index 1476f95add77..3d871d9d1d71 100644
--- a/ghc/InteractiveUI.hs
+++ b/ghc/InteractiveUI.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP, MagicHash, NondecreasingIndentation, TupleSections #-}
 {-# OPTIONS -fno-cse #-}
 -- -fno-cse is needed for GLOBAL_VAR's to behave properly
 
@@ -27,6 +28,7 @@ import Debugger
 
 -- The GHC interface
 import DynFlags
+import ErrUtils
 import GhcMonad ( modifySession )
 import qualified GHC
 import GHC ( LoadHowMuch(..), Target(..),  TargetId(..), InteractiveImport(..),
@@ -37,14 +39,13 @@ import HscTypes ( tyThingParent_maybe, handleFlagWarnings, getSafeMode, hsc_IC,
                   setInteractivePrintName )
 import Module
 import Name
-import Packages ( trusted, getPackageDetails, exposed, exposedModules, pkgIdMap )
+import Packages ( trusted, getPackageDetails, listVisibleModuleNames, pprFlag )
 import PprTyThing
 import RdrName ( getGRE_NameQualifier_maybes )
 import SrcLoc
 import qualified Lexer
 
 import StringBuffer
-import UniqFM ( eltsUFM )
 import Outputable hiding ( printForUser, printForUserPartWay, bold )
 
 -- Other random utilities
@@ -71,7 +72,7 @@ import Data.Array
 import qualified Data.ByteString.Char8 as BS
 import Data.Char
 import Data.Function
-import Data.IORef ( IORef, readIORef, writeIORef )
+import Data.IORef ( IORef, modifyIORef, newIORef, readIORef, writeIORef )
 import Data.List ( find, group, intercalate, intersperse, isPrefixOf, nub,
                    partition, sort, sortBy )
 import Data.Maybe
@@ -103,7 +104,6 @@ import GHC.IO.Exception ( IOErrorType(InvalidArgument) )
 import GHC.IO.Handle ( hFlushAll )
 import GHC.TopHandler ( topHandler )
 
-
 -----------------------------------------------------------------------------
 
 data GhciSettings = GhciSettings {
@@ -379,6 +379,12 @@ interactiveUI config srcs maybe_exprs = do
                $ dflags
    GHC.setInteractiveDynFlags dflags'
 
+   lastErrLocationsRef <- liftIO $ newIORef []
+   progDynFlags <- GHC.getProgramDynFlags
+   _ <- GHC.setProgramDynFlags $
+      progDynFlags { log_action = ghciLogAction lastErrLocationsRef }
+
+ 
    liftIO $ when (isNothing maybe_exprs) $ do
         -- Only for GHCi (not runghc and ghc -e):
 
@@ -399,31 +405,46 @@ interactiveUI config srcs maybe_exprs = do
 #endif
 
    default_editor <- liftIO $ findEditor
-
    startGHCi (runGHCi srcs maybe_exprs)
-        GHCiState{ progname       = default_progname,
-                   GhciMonad.args = default_args,
-                   prompt         = defPrompt config,
-                   prompt2        = defPrompt2 config,
-                   stop           = default_stop,
-                   editor         = default_editor,
-                   options        = [],
-                   line_number    = 1,
-                   break_ctr      = 0,
-                   breaks         = [],
-                   tickarrays     = emptyModuleEnv,
-                   ghci_commands  = availableCommands config,
-                   last_command   = Nothing,
-                   cmdqueue       = [],
-                   remembered_ctx = [],
-                   transient_ctx  = [],
-                   ghc_e          = isJust maybe_exprs,
-                   short_help     = shortHelpText config,
-                   long_help      = fullHelpText config
+        GHCiState{ progname           = default_progname,
+                   GhciMonad.args     = default_args,
+                   prompt             = defPrompt config,
+                   prompt2            = defPrompt2 config,
+                   stop               = default_stop,
+                   editor             = default_editor,
+                   options            = [],
+                   line_number        = 1,
+                   break_ctr          = 0,
+                   breaks             = [],
+                   tickarrays         = emptyModuleEnv,
+                   ghci_commands      = availableCommands config,
+                   last_command       = Nothing,
+                   cmdqueue           = [],
+                   remembered_ctx     = [],
+                   transient_ctx      = [],
+                   ghc_e              = isJust maybe_exprs,
+                   short_help         = shortHelpText config,
+                   long_help          = fullHelpText config,
+                   lastErrorLocations = lastErrLocationsRef
                  }
-
+    
    return ()
 
+resetLastErrorLocations :: GHCi ()
+resetLastErrorLocations = do
+    st <- getGHCiState
+    liftIO $ writeIORef (lastErrorLocations st) []
+
+ghciLogAction :: IORef [(FastString, Int)] ->  LogAction
+ghciLogAction lastErrLocations dflags severity srcSpan style msg = do
+    defaultLogAction dflags severity srcSpan style msg
+    case severity of
+        SevError -> case srcSpan of
+            RealSrcSpan rsp -> modifyIORef lastErrLocations
+                (++ [(srcLocFile (realSrcSpanStart rsp), srcLocLine (realSrcSpanStart rsp))])
+            _ -> return ()
+        _ -> return ()
+
 withGhcAppData :: (FilePath -> IO a) -> IO a -> IO a
 withGhcAppData right left = do
     either_dir <- tryIO (getAppUserDataDirectory "ghc")
@@ -455,13 +476,18 @@ runGHCi paths maybe_exprs = do
    canonicalizePath' fp = liftM Just (canonicalizePath fp)
                 `catchIO` \_ -> return Nothing
 
-   sourceConfigFile :: FilePath -> GHCi ()
-   sourceConfigFile file = do
+   sourceConfigFile :: (FilePath, Bool) -> GHCi ()
+   sourceConfigFile (file, check_perms) = do
      exists <- liftIO $ doesFileExist file
      when exists $ do
-       dir_ok  <- liftIO $ checkPerms (getDirectory file)
-       file_ok <- liftIO $ checkPerms file
-       when (dir_ok && file_ok) $ do
+       perms_ok <-
+         if not check_perms
+            then return True
+            else do
+              dir_ok  <- liftIO $ checkPerms (getDirectory file)
+              file_ok <- liftIO $ checkPerms file
+              return (dir_ok && file_ok)
+       when perms_ok $ do
          either_hdl <- liftIO $ tryIO (openFile file ReadMode)
          case either_hdl of
            Left _e   -> return ()
@@ -479,9 +505,14 @@ runGHCi paths maybe_exprs = do
   setGHCContextFromGHCiState
 
   when (read_dot_files) $ do
-    mcfgs0 <- sequence $ [ current_dir, app_user_dir, home_dir ] ++ map (return . Just ) (ghciScripts dflags)
-    mcfgs <- liftIO $ mapM canonicalizePath' (catMaybes mcfgs0)
-    mapM_ sourceConfigFile $ nub $ catMaybes mcfgs
+    mcfgs0 <- catMaybes <$> sequence [ current_dir, app_user_dir, home_dir ]
+    let mcfgs1 = zip mcfgs0 (repeat True)
+              ++ zip (ghciScripts dflags) (repeat False)
+         -- False says "don't check permissions".  We don't
+         -- require that a script explicitly added by
+         -- -ghci-script is owned by the current user. (#6017)
+    mcfgs <- liftIO $ mapM (\(f, b) -> (,b) <$> canonicalizePath' f) mcfgs1
+    mapM_ sourceConfigFile $ nub $ [ (f,b) | (Just f, b) <- mcfgs ]
         -- nub, because we don't want to read .ghci twice if the
         -- CWD is $HOME.
 
@@ -554,8 +585,9 @@ nextInputLine show_prompt is_tty
     fileLoop stdin
 
 -- NOTE: We only read .ghci files if they are owned by the current user,
--- and aren't world writable.  Otherwise, we could be accidentally
--- running code planted by a malicious third party.
+-- and aren't world writable (files owned by root are ok, see #9324).
+-- Otherwise, we could be accidentally running code planted by
+-- a malicious third party.
 
 -- Furthermore, We only read ./.ghci if . is owned by the current user
 -- and isn't writable by anyone else.  I think this is sufficient: we
@@ -570,18 +602,14 @@ checkPerms name =
   handleIO (\_ -> return False) $ do
     st <- getFileStatus name
     me <- getRealUserID
-    if fileOwner st /= me then do
-        putStrLn $ "WARNING: " ++ name ++ " is owned by someone else, IGNORING!"
-        return False
-     else do
-        let mode = System.Posix.fileMode st
-        if (groupWriteMode == (mode `intersectFileModes` groupWriteMode))
-            || (otherWriteMode == (mode `intersectFileModes` otherWriteMode))
-            then do
-                putStrLn $ "*** WARNING: " ++ name ++
-                           " is writable by someone else, IGNORING!"
-                return False
-            else return True
+    let mode = System.Posix.fileMode st
+        ok = (fileOwner st == me || fileOwner st == 0) &&
+             groupWriteMode /= mode `intersectFileModes` groupWriteMode &&
+             otherWriteMode /= mode `intersectFileModes` otherWriteMode
+    unless ok $
+      putStrLn $ "*** WARNING: " ++ name ++
+                 " is writable by someone else, IGNORING!"
+    return ok
 #endif
 
 incrementLineNo :: InputT GHCi ()
@@ -1109,9 +1137,10 @@ runMain s = case toArgs s of
             Left err   -> liftIO (hPutStrLn stderr err)
             Right args ->
                 do dflags <- getDynFlags
-                   case mainFunIs dflags of
-                       Nothing -> doWithArgs args "main"
-                       Just f  -> doWithArgs args f
+                   let main = fromMaybe "main" (mainFunIs dflags)
+                   -- Wrap the main function in 'void' to discard its value instead
+                   -- of printing it (#9086). See Haskell 2010 report Chapter 5.
+                   doWithArgs args $ "Control.Monad.void (" ++ main ++ ")"
 
 -----------------------------------------------------------------------------
 -- :run
@@ -1159,10 +1188,18 @@ editFile :: String -> InputT GHCi ()
 editFile str =
   do file <- if null str then lift chooseEditFile else expandPath str
      st <- lift getGHCiState
+     errs <- liftIO $ readIORef $ lastErrorLocations st
      let cmd = editor st
      when (null cmd)
        $ throwGhcException (CmdLineError "editor not set, use :set editor")
-     code <- liftIO $ system (cmd ++ ' ':file)
+     lineOpt <- liftIO $ do
+         curFileErrs <- filterM (\(f, _) -> unpackFS f `sameFile` file) errs
+         return $ case curFileErrs of
+             (_, line):_ -> " +" ++ show line
+             _ -> ""
+     let cmdArgs = ' ':(file ++ lineOpt)
+     code <- liftIO $ system (cmd ++ cmdArgs)
+
      when (code == ExitSuccess)
        $ reloadModule ""
 
@@ -1353,6 +1390,7 @@ doLoad retain_context howmuch = do
   -- the ModBreaks will have gone away.
   lift discardActiveBreakPoints
 
+  lift resetLastErrorLocations
   -- Enable buffering stdout and stderr as we're compiling. Keeping these
   -- handles unbuffered will just slow the compilation down, especially when
   -- compiling in parallel.
@@ -1377,7 +1415,6 @@ afterLoad ok retain_context = do
   modulesLoadedMsg ok loaded_mods
   lift $ setContextAfterLoad retain_context loaded_mod_summaries
 
-
 setContextAfterLoad :: Bool -> [GHC.ModSummary] -> GHCi ()
 setContextAfterLoad keep_ctxt [] = do
   setContextKeepingPackageModules keep_ctxt []
@@ -1483,7 +1520,7 @@ kindOfType norm str
   $ do
        (ty, kind) <- GHC.typeKind norm str
        printForUser $ vcat [ text str <+> dcolon <+> pprTypeForUser kind
-                           , ppWhen norm $ equals <+> ppr ty ]
+                           , ppWhen norm $ equals <+> pprTypeForUser ty ]
 
 
 -----------------------------------------------------------------------------
@@ -1566,26 +1603,25 @@ isSafeModule m = do
     liftIO $ putStrLn $ "Package Trust: " ++ (if packageTrustOn dflags then "On" else "Off")
     when (not $ null good)
          (liftIO $ putStrLn $ "Trusted package dependencies (trusted): " ++
-                        (intercalate ", " $ map packageIdString good))
+                        (intercalate ", " $ map (showPpr dflags) good))
     case msafe && null bad of
         True -> liftIO $ putStrLn $ mname ++ " is trusted!"
         False -> do
             when (not $ null bad)
                  (liftIO $ putStrLn $ "Trusted package dependencies (untrusted): "
-                            ++ (intercalate ", " $ map packageIdString bad))
+                            ++ (intercalate ", " $ map (showPpr dflags) bad))
             liftIO $ putStrLn $ mname ++ " is NOT trusted!"
 
   where
     mname = GHC.moduleNameString $ GHC.moduleName m
 
     packageTrusted dflags md
-        | thisPackage dflags == modulePackageId md = True
-        | otherwise = trusted $ getPackageDetails (pkgState dflags) (modulePackageId md)
+        | thisPackage dflags == modulePackageKey md = True
+        | otherwise = trusted $ getPackageDetails dflags (modulePackageKey md)
 
     tallyPkgs dflags deps | not (packageTrustOn dflags) = ([], [])
                           | otherwise = partition part deps
-        where state = pkgState dflags
-              part pkg = trusted $ getPackageDetails state pkg
+        where part pkg = trusted $ getPackageDetails dflags pkg
 
 -----------------------------------------------------------------------------
 -- :browse
@@ -2295,15 +2331,9 @@ showPackages :: GHCi ()
 showPackages = do
   dflags <- getDynFlags
   let pkg_flags = packageFlags dflags
-  liftIO $ putStrLn $ showSDoc dflags $ vcat $
-    text ("active package flags:"++if null pkg_flags then " none" else "")
-    : map showFlag pkg_flags
-  where showFlag (ExposePackage   p) = text $ "  -package " ++ p
-        showFlag (HidePackage     p) = text $ "  -hide-package " ++ p
-        showFlag (IgnorePackage   p) = text $ "  -ignore-package " ++ p
-        showFlag (ExposePackageId p) = text $ "  -package-id " ++ p
-        showFlag (TrustPackage    p) = text $ "  -trust " ++ p
-        showFlag (DistrustPackage p) = text $ "  -distrust " ++ p
+  liftIO $ putStrLn $ showSDoc dflags $
+    text ("active package flags:"++if null pkg_flags then " none" else "") $$
+      nest 2 (vcat (map pprFlag pkg_flags))
 
 showPaths :: GHCi ()
 showPaths = do
@@ -2438,7 +2468,7 @@ completeIdentifier = wrapIdentCompleter $ \w -> do
 
 completeModule = wrapIdentCompleter $ \w -> do
   dflags <- GHC.getSessionDynFlags
-  let pkg_mods = allExposedModules dflags
+  let pkg_mods = allVisibleModules dflags
   loaded_mods <- liftM (map GHC.ms_mod_name) getLoadedModules
   return $ filter (w `isPrefixOf`)
         $ map (showPpr dflags) $ loaded_mods ++ pkg_mods
@@ -2450,7 +2480,7 @@ completeSetModule = wrapIdentCompleterWithModifier "+-" $ \m w -> do
       imports <- GHC.getContext
       return $ map iiModuleName imports
     _ -> do
-      let pkg_mods = allExposedModules dflags
+      let pkg_mods = allVisibleModules dflags
       loaded_mods <- liftM (map GHC.ms_mod_name) getLoadedModules
       return $ loaded_mods ++ pkg_mods
   return $ filter (w `isPrefixOf`) $ map (showPpr dflags) modules
@@ -2495,22 +2525,21 @@ unionComplete f1 f2 line = do
 
 wrapCompleter :: String -> (String -> GHCi [String]) -> CompletionFunc GHCi
 wrapCompleter breakChars fun = completeWord Nothing breakChars
-    $ fmap (map simpleCompletion) . fmap sort . fun
+    $ fmap (map simpleCompletion . nubSort) . fun
 
 wrapIdentCompleter :: (String -> GHCi [String]) -> CompletionFunc GHCi
 wrapIdentCompleter = wrapCompleter word_break_chars
 
 wrapIdentCompleterWithModifier :: String -> (Maybe Char -> String -> GHCi [String]) -> CompletionFunc GHCi
 wrapIdentCompleterWithModifier modifChars fun = completeWordWithPrev Nothing word_break_chars
-    $ \rest -> fmap (map simpleCompletion) . fmap sort . fun (getModifier rest)
+    $ \rest -> fmap (map simpleCompletion . nubSort) . fun (getModifier rest)
  where
   getModifier = find (`elem` modifChars)
 
-allExposedModules :: DynFlags -> [ModuleName]
-allExposedModules dflags
- = concat (map exposedModules (filter exposed (eltsUFM pkg_db)))
- where
-  pkg_db = pkgIdMap (pkgState dflags)
+-- | Return a list of visible module names for autocompletion.
+-- (NB: exposed != visible)
+allVisibleModules :: DynFlags -> [ModuleName]
+allVisibleModules dflags = listVisibleModuleNames dflags
 
 completeExpression = completeQuotedWord (Just '\\') "\"" listFiles
                         completeIdentifier
@@ -3093,7 +3122,7 @@ lookupModuleName :: GHC.GhcMonad m => ModuleName -> m Module
 lookupModuleName mName = GHC.lookupModule mName Nothing
 
 isHomeModule :: Module -> Bool
-isHomeModule m = GHC.modulePackageId m == mainPackageId
+isHomeModule m = GHC.modulePackageKey m == mainPackageKey
 
 -- TODO: won't work if home dir is encoded.
 -- (changeDirectory may not work either in that case.)
@@ -3107,7 +3136,13 @@ expandPathIO p =
         tilde <- getHomeDirectory -- will fail if HOME not defined
         return (tilde ++ '/':d)
    other ->
-        return other
+        return other    
+
+sameFile :: FilePath -> FilePath -> IO Bool
+sameFile path1 path2 = do
+    absPath1 <- canonicalizePath path1
+    absPath2 <- canonicalizePath path2
+    return $ absPath1 == absPath2
 
 wantInterpretedModule :: GHC.GhcMonad m => String -> m Module
 wantInterpretedModule str = wantInterpretedModuleName (GHC.mkModuleName str)
@@ -3117,7 +3152,7 @@ wantInterpretedModuleName modname = do
    modl <- lookupModuleName modname
    let str = moduleNameString modname
    dflags <- getDynFlags
-   when (GHC.modulePackageId modl /= thisPackage dflags) $
+   when (GHC.modulePackageKey modl /= thisPackage dflags) $
       throwGhcException (CmdLineError ("module '" ++ str ++ "' is from another package;\nthis command requires an interpreted module"))
    is_interpreted <- GHC.moduleIsInterpreted modl
    when (not is_interpreted) $
diff --git a/ghc/Main.hs b/ghc/Main.hs
index 868042b4e223..70dde39824ea 100644
--- a/ghc/Main.hs
+++ b/ghc/Main.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP, NondecreasingIndentation #-}
 {-# OPTIONS -fno-warn-incomplete-patterns -optc-DNON_POSIX_SOURCE #-}
 
 -----------------------------------------------------------------------------
@@ -32,7 +33,7 @@ import InteractiveUI    ( interactiveUI, ghciWelcomeMsg, defaultGhciSettings )
 import Config
 import Constants
 import HscTypes
-import Packages         ( dumpPackages )
+import Packages         ( dumpPackages, simpleDumpPackages, pprModuleMap )
 import DriverPhases
 import BasicTypes       ( failed )
 import StaticFlags
@@ -76,6 +77,7 @@ import Data.Maybe
 
 main :: IO ()
 main = do
+   initGCStatistics -- See Note [-Bsymbolic and hooks]
    hSetBuffering stdout LineBuffering
    hSetBuffering stderr LineBuffering
    GHC.defaultErrorHandler defaultFatalMessager defaultFlushOut $ do
@@ -207,12 +209,19 @@ main' postLoadMode dflags0 args flagWarnings = do
   hsc_env <- GHC.getSession
 
         ---------------- Display configuration -----------
-  when (verbosity dflags6 >= 4) $
-        liftIO $ dumpPackages dflags6
+  case verbosity dflags6 of
+    v | v == 4 -> liftIO $ simpleDumpPackages dflags6
+      | v >= 5 -> liftIO $ dumpPackages dflags6
+      | otherwise -> return ()
 
   when (verbosity dflags6 >= 3) $ do
         liftIO $ hPutStrLn stderr ("Hsc static flags: " ++ unwords staticFlags)
 
+
+  when (dopt Opt_D_dump_mod_map dflags6) . liftIO $
+    printInfoForUser (dflags6 { pprCols = 200 })
+                     (pkgQual dflags6) (pprModuleMap dflags6)
+
         ---------------- Final sanity checking -----------
   liftIO $ checkOptions postLoadMode dflags6 srcs objs
 
@@ -560,7 +569,7 @@ mode_flags =
   , Flag "M"            (PassFlag (setMode doMkDependHSMode))
   , Flag "E"            (PassFlag (setMode (stopBeforeMode anyHsc)))
   , Flag "C"            (PassFlag (setMode (stopBeforeMode HCc)))
-  , Flag "S"            (PassFlag (setMode (stopBeforeMode As)))
+  , Flag "S"            (PassFlag (setMode (stopBeforeMode (As False))))
   , Flag "-make"        (PassFlag (setMode doMakeMode))
   , Flag "-interactive" (PassFlag (setMode doInteractiveMode))
   , Flag "-abi-hash"    (PassFlag (setMode doAbiHashMode))
@@ -627,7 +636,8 @@ doMake srcs  = do
         haskellish (f,Nothing) =
           looksLikeModuleName f || isHaskellUserSrcFilename f || '.' `notElem` f
         haskellish (_,Just phase) =
-          phase `notElem` [As, Cc, Cobjc, Cobjcpp, CmmCpp, Cmm, StopLn]
+          phase `notElem` [ As True, As False, Cc, Cobjc, Cobjcpp, CmmCpp, Cmm
+                          , StopLn]
 
     hsc_env <- GHC.getSession
 
@@ -818,3 +828,26 @@ unknownFlagsErr fs = throwGhcException $ UsageError $ concatMap oneError fs
         (case fuzzyMatch f (nub allFlags) of
             [] -> ""
             suggs -> "did you mean one of:\n" ++ unlines (map ("  " ++) suggs)) 
+
+{- Note [-Bsymbolic and hooks]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+-Bsymbolic is a flag that prevents the binding of references to global
+symbols to symbols outside the shared library being compiled (see `man
+ld`). When dynamically linking, we don't use -Bsymbolic on the RTS
+package: that is because we want hooks to be overridden by the user,
+we don't want to constrain them to the RTS package.
+
+Unfortunately this seems to have broken somehow on OS X: as a result,
+defaultHooks (in hschooks.c) is not called, which does not initialize
+the GC stats. As a result, this breaks things like `:set +s` in GHCi
+(#8754). As a hacky workaround, we instead call 'defaultHooks'
+directly to initalize the flags in the RTS.
+
+A byproduct of this, I believe, is that hooks are likely broken on OS
+X when dynamically linking. But this probably doesn't affect most
+people since we're linking GHC dynamically, but most things themselves
+link statically.
+-}
+
+foreign import ccall safe "initGCStatistics"
+  initGCStatistics :: IO ()
diff --git a/ghc/ghc-bin.cabal.in b/ghc/ghc-bin.cabal.in
index 561c55cb7d8d..dcbc69567525 100644
--- a/ghc/ghc-bin.cabal.in
+++ b/ghc/ghc-bin.cabal.in
@@ -16,7 +16,7 @@ Category: XXX
 Data-Dir: ..
 Data-Files: settings
 Build-Type: Simple
-Cabal-Version: >= 1.2
+Cabal-Version: >=1.10
 
 Flag ghci
     Description: Build GHCi support.
@@ -24,6 +24,8 @@ Flag ghci
     Manual: True
 
 Executable ghc
+    Default-Language: Haskell2010
+
     Main-Is: Main.hs
     Build-Depends: base       >= 3   && < 5,
                    array      >= 0.1 && < 0.6,
@@ -43,11 +45,17 @@ Executable ghc
     if flag(ghci)
         CPP-Options: -DGHCI
         GHC-Options: -fno-warn-name-shadowing
-        Other-Modules: InteractiveUI, GhciMonad, GhciTags
+        Other-Modules:
+            InteractiveUI
+            GhciMonad
+            GhciTags
         Build-Depends: transformers, haskeline
-        Extensions: ForeignFunctionInterface,
-                    UnboxedTuples,
-                    FlexibleInstances,
-                    MagicHash
+        Other-Extensions:
+            FlexibleInstances
+            MagicHash
+            TupleSections
+            UnboxedTuples
 
-    Extensions: CPP, PatternGuards, NondecreasingIndentation
+    Other-Extensions:
+        CPP
+        NondecreasingIndentation
diff --git a/ghc/hschooks.c b/ghc/hschooks.c
index 4e6e66d3e203..4c588d0ef750 100644
--- a/ghc/hschooks.c
+++ b/ghc/hschooks.c
@@ -15,6 +15,18 @@ in instead of the defaults.
 #include <unistd.h>
 #endif
 
+void
+initGCStatistics(void)
+{
+  /* Workaround for #8754: if the GC stats aren't enabled because the
+   compiler couldn't use -Bsymbolic to link the default hooks, then
+   initialize them sensibly. See Note [-Bsymbolic and hooks] in
+   Main.hs. */
+  if (RtsFlags.GcFlags.giveStats == NO_GC_STATS) {
+    RtsFlags.GcFlags.giveStats = COLLECT_GC_STATS;
+  }
+}
+
 void
 defaultsHook (void)
 {
@@ -28,7 +40,8 @@ defaultsHook (void)
 #endif
 
     RtsFlags.GcFlags.maxStkSize         = 512*1024*1024 / sizeof(W_);
-    RtsFlags.GcFlags.giveStats = COLLECT_GC_STATS;
+
+    initGCStatistics();
 
     // See #3408: the default idle GC time of 0.3s is too short on
     // Windows where we receive console events once per second or so.
diff --git a/includes/Cmm.h b/includes/Cmm.h
index 0e30c1657d12..e62e96fcc095 100644
--- a/includes/Cmm.h
+++ b/includes/Cmm.h
@@ -600,8 +600,11 @@
 
 #if defined(PROFILING) || (!defined(THREADED_RTS) && defined(DEBUG))
 #define OVERWRITING_CLOSURE(c) foreign "C" overwritingClosure(c "ptr")
+#define OVERWRITING_CLOSURE_OFS(c,n) \
+    foreign "C" overwritingClosureOfs(c "ptr", n)
 #else
 #define OVERWRITING_CLOSURE(c) /* nothing */
+#define OVERWRITING_CLOSURE_OFS(c,n) /* nothing */
 #endif
 
 #ifdef THREADED_RTS
@@ -806,4 +809,121 @@
       __gen = TO_W_(bdescr_gen_no(__bd));                       \
       if (__gen > 0) { recordMutableCap(__p, __gen); }
 
+/* -----------------------------------------------------------------------------
+   Arrays
+   -------------------------------------------------------------------------- */
+
+/* Complete function body for the clone family of (mutable) array ops.
+   Defined as a macro to avoid function call overhead or code
+   duplication. */
+#define cloneArray(info, src, offset, n)                       \
+    W_ words, size;                                            \
+    gcptr dst, dst_p, src_p;                                   \
+                                                               \
+    again: MAYBE_GC(again);                                    \
+                                                               \
+    size = n + mutArrPtrsCardWords(n);                         \
+    words = BYTES_TO_WDS(SIZEOF_StgMutArrPtrs) + size;         \
+    ("ptr" dst) = ccall allocate(MyCapability() "ptr", words); \
+    TICK_ALLOC_PRIM(SIZEOF_StgMutArrPtrs, WDS(size), 0);       \
+                                                               \
+    SET_HDR(dst, info, CCCS);                                  \
+    StgMutArrPtrs_ptrs(dst) = n;                               \
+    StgMutArrPtrs_size(dst) = size;                            \
+                                                               \
+    dst_p = dst + SIZEOF_StgMutArrPtrs;                        \
+    src_p = src + SIZEOF_StgMutArrPtrs + WDS(offset);          \
+  while:                                                       \
+    if (n != 0) {                                              \
+        n = n - 1;                                             \
+        W_[dst_p] = W_[src_p];                                 \
+        dst_p = dst_p + WDS(1);                                \
+        src_p = src_p + WDS(1);                                \
+        goto while;                                            \
+    }                                                          \
+                                                               \
+    return (dst);
+
+#define copyArray(src, src_off, dst, dst_off, n)                  \
+  W_ dst_elems_p, dst_p, src_p, dst_cards_p, bytes;               \
+                                                                  \
+    if ((n) != 0) {                                               \
+        SET_HDR(dst, stg_MUT_ARR_PTRS_DIRTY_info, CCCS);          \
+                                                                  \
+        dst_elems_p = (dst) + SIZEOF_StgMutArrPtrs;               \
+        dst_p = dst_elems_p + WDS(dst_off);                       \
+        src_p = (src) + SIZEOF_StgMutArrPtrs + WDS(src_off);      \
+        bytes = WDS(n);                                           \
+                                                                  \
+        prim %memcpy(dst_p, src_p, bytes, WDS(1));                \
+                                                                  \
+        dst_cards_p = dst_elems_p + WDS(StgMutArrPtrs_ptrs(dst)); \
+        setCards(dst_cards_p, dst_off, n);                        \
+    }                                                             \
+                                                                  \
+    return ();
+
+#define copyMutableArray(src, src_off, dst, dst_off, n)           \
+  W_ dst_elems_p, dst_p, src_p, dst_cards_p, bytes;               \
+                                                                  \
+    if ((n) != 0) {                                               \
+        SET_HDR(dst, stg_MUT_ARR_PTRS_DIRTY_info, CCCS);          \
+                                                                  \
+        dst_elems_p = (dst) + SIZEOF_StgMutArrPtrs;               \
+        dst_p = dst_elems_p + WDS(dst_off);                       \
+        src_p = (src) + SIZEOF_StgMutArrPtrs + WDS(src_off);      \
+        bytes = WDS(n);                                           \
+                                                                  \
+        if ((src) == (dst)) {                                     \
+            prim %memmove(dst_p, src_p, bytes, WDS(1));           \
+        } else {                                                  \
+            prim %memcpy(dst_p, src_p, bytes, WDS(1));            \
+        }                                                         \
+                                                                  \
+        dst_cards_p = dst_elems_p + WDS(StgMutArrPtrs_ptrs(dst)); \
+        setCards(dst_cards_p, dst_off, n);                        \
+    }                                                             \
+                                                                  \
+    return ();
+
+/*
+ * Set the cards in the cards table pointed to by dst_cards_p for an
+ * update to n elements, starting at element dst_off.
+ */
+#define setCards(dst_cards_p, dst_off, n)                      \
+    W_ __start_card, __end_card, __cards;                      \
+    __start_card = mutArrPtrCardDown(dst_off);                 \
+    __end_card = mutArrPtrCardDown((dst_off) + (n) - 1);       \
+    __cards = __end_card - __start_card + 1;                   \
+    prim %memset((dst_cards_p) + __start_card, 1, __cards, 1);
+
+/* Complete function body for the clone family of small (mutable)
+   array ops. Defined as a macro to avoid function call overhead or
+   code duplication. */
+#define cloneSmallArray(info, src, offset, n)                  \
+    W_ words, size;                                            \
+    gcptr dst, dst_p, src_p;                                   \
+                                                               \
+    again: MAYBE_GC(again);                                    \
+                                                               \
+    words = BYTES_TO_WDS(SIZEOF_StgSmallMutArrPtrs) + n;       \
+    ("ptr" dst) = ccall allocate(MyCapability() "ptr", words); \
+    TICK_ALLOC_PRIM(SIZEOF_StgSmallMutArrPtrs, WDS(n), 0);     \
+                                                               \
+    SET_HDR(dst, info, CCCS);                                  \
+    StgSmallMutArrPtrs_ptrs(dst) = n;                          \
+                                                               \
+    dst_p = dst + SIZEOF_StgSmallMutArrPtrs;                   \
+    src_p = src + SIZEOF_StgSmallMutArrPtrs + WDS(offset);     \
+  while:                                                       \
+    if (n != 0) {                                              \
+        n = n - 1;                                             \
+        W_[dst_p] = W_[src_p];                                 \
+        dst_p = dst_p + WDS(1);                                \
+        src_p = src_p + WDS(1);                                \
+        goto while;                                            \
+    }                                                          \
+                                                               \
+    return (dst);
+
 #endif /* CMM_H */
diff --git a/includes/CodeGen.Platform.hs b/includes/CodeGen.Platform.hs
index 3d6dd41ae46c..62708cc4cc02 100644
--- a/includes/CodeGen.Platform.hs
+++ b/includes/CodeGen.Platform.hs
@@ -742,6 +742,8 @@ globalRegMaybe CurrentTSO               = Just (RealRegSingle REG_CurrentTSO)
 globalRegMaybe CurrentNursery           = Just (RealRegSingle REG_CurrentNursery)
 # endif
 globalRegMaybe _                        = Nothing
+#elif MACHREGS_NO_REGS
+globalRegMaybe _ = Nothing
 #else
 globalRegMaybe = panic "globalRegMaybe not defined for this platform"
 #endif
diff --git a/includes/HsFFI.h b/includes/HsFFI.h
index a21811efb5f7..ab3b3ebb2329 100644
--- a/includes/HsFFI.h
+++ b/includes/HsFFI.h
@@ -150,6 +150,7 @@ extern void hs_init     (int *argc, char **argv[]);
 extern void hs_exit     (void);
 extern void hs_set_argv (int argc, char *argv[]);
 extern void hs_add_root (void (*init_root)(void));
+extern void hs_thread_done (void);
 
 extern void hs_perform_gc (void);
 
diff --git a/includes/RtsAPI.h b/includes/RtsAPI.h
index daae30b8211d..6e4decb8bd4d 100644
--- a/includes/RtsAPI.h
+++ b/includes/RtsAPI.h
@@ -223,6 +223,19 @@ void rts_checkSchedStatus (char* site, Capability *);
 
 SchedulerStatus rts_getSchedStatus (Capability *cap);
 
+/*
+ * The RTS allocates some thread-local data when you make a call into
+ * Haskell using one of the rts_eval() functions.  This data is not
+ * normally freed until hs_exit().  If you want to free it earlier
+ * than this, perhaps because the thread is about to exit, then call
+ * rts_done() from the thread.
+ *
+ * It is safe to make more rts_eval() calls after calling rts_done(),
+ * but the next one will cause allocation of the thread-local memory
+ * again.
+ */
+void rts_done (void);
+
 /* --------------------------------------------------------------------------
    Wrapper closures
 
diff --git a/includes/Stg.h b/includes/Stg.h
index 09de8d4b2a4b..9edb6a0f2bdc 100644
--- a/includes/Stg.h
+++ b/includes/Stg.h
@@ -213,7 +213,35 @@ typedef StgFunPtr       F_;
 #define II_(X)          static StgWordArray (X) GNU_ATTRIBUTE(aligned (8))
 #define IF_(f)    static StgFunPtr GNUC3_ATTRIBUTE(used) f(void)
 #define FN_(f)    StgFunPtr f(void)
-#define EF_(f)    extern StgFunPtr f(void)
+#define EF_(f)    extern StgFunPtr f()   /* See Note [External function prototypes] */
+
+/* Note [External function prototypes]  See Trac #8965
+   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+The external-function macro EF_(F) used to be defined as
+    extern StgFunPtr f(void)
+i.e a function of zero arguments.  On most platforms this doesn't
+matter very much: calls to these functions put the parameters in the
+usual places anyway, and (with the exception of varargs) things just
+work.
+
+However, the ELFv2 ABI on ppc64 optimises stack allocation
+(http://gcc.gnu.org/ml/gcc-patches/2013-11/msg01149.html): a call to a
+function that has a prototype, is not varargs, and receives all parameters
+in registers rather than on the stack does not require the caller to
+allocate an argument save area.  The incorrect prototypes cause GCC to
+believe that all functions declared this way can be called without an
+argument save area, but if the callee has sufficiently many arguments then
+it will expect that area to be present, and will thus corrupt the caller's
+stack.  This happens in particular with calls to runInteractiveProcess in
+libraries/process/cbits/runProcess.c, and led to Trac #8965.
+
+The simplest fix appears to be to declare these external functions with an
+unspecified argument list rather than a void argument list.  This is no
+worse for platforms that don't care either way, and allows a successful
+bootstrap of GHC 7.8 on little-endian Linux ppc64 (which uses the ELFv2
+ABI).
+*/
+
 
 /* -----------------------------------------------------------------------------
    Tail calls
@@ -240,6 +268,7 @@ typedef StgFunPtr       F_;
 #include "stg/MiscClosures.h"
 #endif
 
+#include "stg/Prim.h" /* ghc-prim fallbacks */
 #include "stg/SMP.h" // write_barrier() inline is required
 
 /* -----------------------------------------------------------------------------
diff --git a/includes/rts/Constants.h b/includes/rts/Constants.h
index 842c37b36910..0d9ef9febc83 100644
--- a/includes/rts/Constants.h
+++ b/includes/rts/Constants.h
@@ -202,32 +202,34 @@
  */
 #define NotBlocked          0
 #define BlockedOnMVar       1
-#define BlockedOnMVarRead   2
-#define BlockedOnBlackHole  3
-#define BlockedOnRead       4
-#define BlockedOnWrite      5
-#define BlockedOnDelay      6
-#define BlockedOnSTM        7
+#define BlockedOnMVarRead   14 /* TODO: renumber me, see #9003 */
+#define BlockedOnBlackHole  2
+#define BlockedOnRead       3
+#define BlockedOnWrite      4
+#define BlockedOnDelay      5
+#define BlockedOnSTM        6
 
 /* Win32 only: */
-#define BlockedOnDoProc     8
+#define BlockedOnDoProc     7
 
 /* Only relevant for PAR: */
   /* blocked on a remote closure represented by a Global Address: */
-#define BlockedOnGA         9
+#define BlockedOnGA         8
   /* same as above but without sending a Fetch message */
-#define BlockedOnGA_NoSend  10
+#define BlockedOnGA_NoSend  9
 /* Only relevant for THREADED_RTS: */
-#define BlockedOnCCall      11
-#define BlockedOnCCall_Interruptible 12
+#define BlockedOnCCall      10
+#define BlockedOnCCall_Interruptible 11
    /* same as above but permit killing the worker thread */
 
 /* Involved in a message sent to tso->msg_cap */
-#define BlockedOnMsgThrowTo 13
+#define BlockedOnMsgThrowTo 12
 
 /* The thread is not on any run queues, but can be woken up
    by tryWakeupThread() */
-#define ThreadMigrating     14
+#define ThreadMigrating     13
+
+/* WARNING WARNING top number is BlockedOnMVarRead 14, not 13!! */
 
 /*
  * These constants are returned to the scheduler by a thread that has
@@ -292,4 +294,16 @@
 
 #define MAX_SPARE_WORKERS 6
 
+/* Maximum number of heap allocation samples to collect per
+ * Cap. Should be more than block count of typical allocation area, so
+ * it is guaranteed to be flushed before we ever fill it.
+ */
+
+#define HEAP_ALLOC_MAX_SAMPLES 4096
+
+/* Maximum number of timer samples to collect per Task. Lower values
+ * mean that the buffer will be flushed more often.
+ */
+#define TIMER_MAX_SAMPLES 512
+
 #endif /* RTS_CONSTANTS_H */
diff --git a/includes/rts/EventLogFormat.h b/includes/rts/EventLogFormat.h
index e08a44996f84..9cc03dd3ff55 100644
--- a/includes/rts/EventLogFormat.h
+++ b/includes/rts/EventLogFormat.h
@@ -162,6 +162,8 @@
 #define EVENT_TASK_MIGRATE        56 /* (taskID, cap, new_cap)   */
 #define EVENT_TASK_DELETE         57 /* (taskID)                 */
 #define EVENT_USER_MARKER         58 /* (marker_name) */
+#define EVENT_HACK_BUG_T9003      59 /* Hack: see trac #9003 */
+
 /* Range 59 - 59 is available for new GHC and common events. */
 
 /* Range 60 - 80 is used by eden for parallel tracing
@@ -172,12 +174,23 @@
 
 /* Range 140 - 159 is reserved for Perf events. */
 
+/* Range 200 - 210 is hereby reserved for profiling stuff. In hopes that I this
+   is were I can find some peace. */
+
+#define EVENT_DEBUG_MODULE        200
+#define EVENT_DEBUG_BLOCK         201
+#define EVENT_DEBUG_SOURCE        202
+#define EVENT_DEBUG_CORE          203
+#define EVENT_DEBUG_SAMPLE_RANGE  204
+
+#define EVENT_SAMPLES             205
+
 /*
  * The highest event code +1 that ghc itself emits. Note that some event
  * ranges higher than this are reserved but not currently emitted by ghc.
  * This must match the size of the EventDesc[] array in EventLog.c
  */
-#define NUM_GHC_EVENT_TAGS        59
+#define NUM_GHC_EVENT_TAGS        206
 
 #if 0  /* DEPRECATED EVENTS: */
 /* we don't actually need to record the thread, it's implicit */
diff --git a/includes/rts/Flags.h b/includes/rts/Flags.h
index bf6a7f3c5cac..c29da48f1d2b 100644
--- a/includes/rts/Flags.h
+++ b/includes/rts/Flags.h
@@ -100,10 +100,15 @@ struct PROFILING_FLAGS {
 
 # define HEAP_BY_CLOSURE_TYPE   8
 
+/* trace heap profiling */
+# define TRACE_HEAP_START       256
+# define TRACE_HEAP_BY_CODE_PTR (TRACE_HEAP_START+0)
+
     Time                heapProfileInterval; /* time between samples */
     nat                 heapProfileIntervalTicks; /* ticks between samples (derived) */
-    rtsBool             includeTSOs;
 
+#ifdef PROFILING
+    rtsBool             includeTSOs;
 
     rtsBool		showCCSOnException;
 
@@ -118,6 +123,7 @@ struct PROFILING_FLAGS {
     char*               ccsSelector;
     char*               retainerSelector;
     char*               bioSelector;
+#endif
 
 };
 
@@ -126,6 +132,7 @@ struct PROFILING_FLAGS {
 #define TRACE_STDERR    2
 
 struct TRACE_FLAGS {
+#ifdef TRACING
     int tracing;
     rtsBool timestamp;      /* show timestamp in stderr output */
     rtsBool scheduler;      /* trace scheduler events */
@@ -133,6 +140,10 @@ struct TRACE_FLAGS {
     rtsBool sparks_sampled; /* trace spark events by a sampled method */
     rtsBool sparks_full;    /* trace spark events 100% accurately */
     rtsBool user;           /* trace user events (emitted from Haskell code) */
+
+    rtsBool allocSampling;  /* collect code pointers from allocation sites */
+    rtsBool timerSampling;  /* collect instruction pointers from timer signals */
+#endif
 };
 
 struct CONCURRENT_FLAGS {
@@ -210,6 +221,25 @@ struct PAPI_FLAGS {
 
 #endif
 
+#ifdef USE_PERF_EVENT
+
+struct PERF_EVENT_FLAGS {
+#ifdef TRACING
+    nat     sampleType;
+    nat     samplePeriod;
+#endif
+};
+
+#define PERF_EVENT_SAMPLE_BY_CYCLE       1
+#define PERF_EVENT_SAMPLE_BY_CACHE       2
+#define PERF_EVENT_SAMPLE_BY_CACHE_MISS  3
+#define PERF_EVENT_SAMPLE_BY_BRANCH      4
+#define PERF_EVENT_SAMPLE_BY_BRANCH_MISS 5
+#define PERF_EVENT_SAMPLE_BY_STALLED_FE  6
+#define PERF_EVENT_SAMPLE_BY_STALLED_BE  7
+
+#endif
+
 /* Put them together: */
 
 typedef struct _RTS_FLAGS {
@@ -229,6 +259,9 @@ typedef struct _RTS_FLAGS {
 #ifdef USE_PAPI
     struct PAPI_FLAGS   PapiFlags;
 #endif
+#ifdef USE_PERF_EVENT
+    struct PERF_EVENT_FLAGS PerfEventFlags;
+#endif
 } RTS_FLAGS;
 
 #ifdef COMPILING_RTS_MAIN
diff --git a/includes/rts/SpinLock.h b/includes/rts/SpinLock.h
index b6eccced8a0b..b54d678fa52c 100644
--- a/includes/rts/SpinLock.h
+++ b/includes/rts/SpinLock.h
@@ -34,8 +34,6 @@ typedef struct SpinLock_
 typedef StgWord SpinLock;
 #endif
 
-typedef StgWord SpinLockCount;
-
 #if defined(PROF_SPIN)
 
 // PROF_SPIN enables counting the number of times we spin on a lock
diff --git a/includes/rts/storage/Block.h b/includes/rts/storage/Block.h
index 5567bf455a65..29c081bba841 100644
--- a/includes/rts/storage/Block.h
+++ b/includes/rts/storage/Block.h
@@ -9,16 +9,26 @@
 #ifndef RTS_STORAGE_BLOCK_H
 #define RTS_STORAGE_BLOCK_H
 
+#include "ghcconfig.h"
+
 /* The actual block and megablock-size constants are defined in
  * includes/Constants.h, all constants here are derived from these.
  */
 
 /* Block related constants (BLOCK_SHIFT is defined in Constants.h) */
 
+#if SIZEOF_LONG == SIZEOF_VOID_P
+#define UNIT 1UL
+#elif SIZEOF_LONG_LONG == SIZEOF_VOID_P
+#define UNIT 1ULL
+#else
+#error "Size of pointer is suspicious."
+#endif
+
 #ifdef CMINUSMINUS
 #define BLOCK_SIZE   (1<<BLOCK_SHIFT)
 #else
-#define BLOCK_SIZE   (1UL<<BLOCK_SHIFT)
+#define BLOCK_SIZE   (UNIT<<BLOCK_SHIFT)
 // Note [integer overflow]
 #endif
 
@@ -33,7 +43,7 @@
 #ifdef CMINUSMINUS
 #define MBLOCK_SIZE    (1<<MBLOCK_SHIFT)
 #else
-#define MBLOCK_SIZE    (1UL<<MBLOCK_SHIFT)
+#define MBLOCK_SIZE    (UNIT<<MBLOCK_SHIFT)
 // Note [integer overflow]
 #endif
 
diff --git a/includes/rts/storage/ClosureMacros.h b/includes/rts/storage/ClosureMacros.h
index 88434d4e7941..2a0f1972181e 100644
--- a/includes/rts/storage/ClosureMacros.h
+++ b/includes/rts/storage/ClosureMacros.h
@@ -326,6 +326,10 @@ EXTERN_INLINE StgOffset mut_arr_ptrs_sizeW( StgMutArrPtrs* x );
 EXTERN_INLINE StgOffset mut_arr_ptrs_sizeW( StgMutArrPtrs* x )
 { return sizeofW(StgMutArrPtrs) + x->size; }
 
+EXTERN_INLINE StgOffset small_mut_arr_ptrs_sizeW( StgSmallMutArrPtrs* x );
+EXTERN_INLINE StgOffset small_mut_arr_ptrs_sizeW( StgSmallMutArrPtrs* x )
+{ return sizeofW(StgSmallMutArrPtrs) + x->ptrs; }
+
 EXTERN_INLINE StgWord stack_sizeW ( StgStack *stack );
 EXTERN_INLINE StgWord stack_sizeW ( StgStack *stack )
 { return sizeofW(StgStack) + stack->stack_size; }
@@ -334,6 +338,11 @@ EXTERN_INLINE StgWord bco_sizeW ( StgBCO *bco );
 EXTERN_INLINE StgWord bco_sizeW ( StgBCO *bco )
 { return bco->size; }
 
+/*
+ * TODO: Consider to switch return type from 'nat' to 'StgWord' #8742
+ *
+ * (Also for 'closure_sizeW' below)
+ */
 EXTERN_INLINE nat closure_sizeW_ (StgClosure *p, StgInfoTable *info);
 EXTERN_INLINE nat
 closure_sizeW_ (StgClosure *p, StgInfoTable *info)
@@ -378,6 +387,11 @@ closure_sizeW_ (StgClosure *p, StgInfoTable *info)
     case MUT_ARR_PTRS_FROZEN:
     case MUT_ARR_PTRS_FROZEN0:
 	return mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
+    case SMALL_MUT_ARR_PTRS_CLEAN:
+    case SMALL_MUT_ARR_PTRS_DIRTY:
+    case SMALL_MUT_ARR_PTRS_FROZEN:
+    case SMALL_MUT_ARR_PTRS_FROZEN0:
+	return small_mut_arr_ptrs_sizeW((StgSmallMutArrPtrs*)p);
     case TSO:
         return sizeofW(StgTSO);
     case STACK:
@@ -490,8 +504,11 @@ INLINE_HEADER StgWord8 *mutArrPtrsCard (StgMutArrPtrs *a, W_ n)
 
 #if ZERO_SLOP_FOR_LDV_PROF || ZERO_SLOP_FOR_SANITY_CHECK
 #define OVERWRITING_CLOSURE(c) overwritingClosure(c)
+#define OVERWRITING_CLOSURE_OFS(c,n) \
+    overwritingClosureOfs(c,n)
 #else
 #define OVERWRITING_CLOSURE(c) /* nothing */
+#define OVERWRITING_CLOSURE_OFS(c,n) /* nothing */
 #endif
 
 #ifdef PROFILING
@@ -520,4 +537,34 @@ EXTERN_INLINE void overwritingClosure (StgClosure *p)
     }
 }
 
+// Version of 'overwritingClosure' which overwrites only a suffix of a
+// closure.  The offset is expressed in words relative to 'p' and shall
+// be less than or equal to closure_sizeW(p), and usually at least as
+// large as the respective thunk header.
+//
+// Note: As this calls LDV_recordDead() you have to call LDV_RECORD()
+//       on the final state of the closure at the call-site
+EXTERN_INLINE void overwritingClosureOfs (StgClosure *p, nat offset);
+EXTERN_INLINE void overwritingClosureOfs (StgClosure *p, nat offset)
+{
+    nat size, i;
+
+#if ZERO_SLOP_FOR_LDV_PROF && !ZERO_SLOP_FOR_SANITY_CHECK
+    // see Note [zeroing slop], also #8402
+    if (era <= 0) return;
+#endif
+
+    size = closure_sizeW(p);
+
+    ASSERT(offset <= size);
+
+    // For LDV profiling, we need to record the closure as dead
+#if defined(PROFILING)
+    LDV_recordDead(p, size);
+#endif
+
+    for (i = offset; i < size; i++)
+        ((StgWord *)p)[i] = 0;
+}
+
 #endif /* RTS_STORAGE_CLOSUREMACROS_H */
diff --git a/includes/rts/storage/ClosureTypes.h b/includes/rts/storage/ClosureTypes.h
index 73a73117193d..9bdddc4e0e22 100644
--- a/includes/rts/storage/ClosureTypes.h
+++ b/includes/rts/storage/ClosureTypes.h
@@ -79,6 +79,10 @@
 #define CATCH_RETRY_FRAME       58
 #define CATCH_STM_FRAME         59
 #define WHITEHOLE               60
-#define N_CLOSURE_TYPES         61
+#define SMALL_MUT_ARR_PTRS_CLEAN      61
+#define SMALL_MUT_ARR_PTRS_DIRTY      62
+#define SMALL_MUT_ARR_PTRS_FROZEN0    63
+#define SMALL_MUT_ARR_PTRS_FROZEN     64
+#define N_CLOSURE_TYPES         65
 
 #endif /* RTS_STORAGE_CLOSURETYPES_H */
diff --git a/includes/rts/storage/Closures.h b/includes/rts/storage/Closures.h
index 27041287b972..8aed04e79ca6 100644
--- a/includes/rts/storage/Closures.h
+++ b/includes/rts/storage/Closures.h
@@ -156,6 +156,12 @@ typedef struct {
     // see also: StgMutArrPtrs macros in ClosureMacros.h
 } StgMutArrPtrs;
 
+typedef struct {
+    StgHeader   header;
+    StgWord     ptrs;
+    StgClosure *payload[FLEXIBLE_ARRAY];
+} StgSmallMutArrPtrs;
+
 typedef struct {
     StgHeader   header;
     StgClosure *var;
diff --git a/includes/stg/HaskellMachRegs.h b/includes/stg/HaskellMachRegs.h
index 94b1612e7bc1..5480c721fd70 100644
--- a/includes/stg/HaskellMachRegs.h
+++ b/includes/stg/HaskellMachRegs.h
@@ -38,6 +38,7 @@
 #define MACHREGS_powerpc  (powerpc_TARGET_ARCH || powerpc64_TARGET_ARCH || rs6000_TARGET_ARCH)
 #define MACHREGS_sparc    sparc_TARGET_ARCH
 #define MACHREGS_arm      arm_TARGET_ARCH
+#define MACHREGS_aarch64  aarch64_TARGET_ARCH
 #define MACHREGS_darwin   darwin_TARGET_OS
 
 #endif
diff --git a/includes/stg/MachRegs.h b/includes/stg/MachRegs.h
index 587f947a6ee8..417fb6923bea 100644
--- a/includes/stg/MachRegs.h
+++ b/includes/stg/MachRegs.h
@@ -1,6 +1,6 @@
 /* -----------------------------------------------------------------------------
  *
- * (c) The GHC Team, 1998-2011
+ * (c) The GHC Team, 1998-2014
  *
  * Registers used in STG code.  Might or might not correspond to
  * actual machine registers.
@@ -531,6 +531,61 @@
 #define REG_D2    d11
 #endif
 
+/* -----------------------------------------------------------------------------
+   The ARMv8/AArch64 ABI register mapping
+
+   The AArch64 provides 31 64-bit general purpose registers
+   and 32 128-bit SIMD/floating point registers.
+
+   General purpose registers (see Chapter 5.1.1 in ARM IHI 0055B)
+
+   Register | Special | Role in the procedure call standard
+   ---------+---------+------------------------------------
+     SP     |         | The Stack Pointer
+     r30    |  LR     | The Link Register
+     r29    |  FP     | The Frame Pointer
+   r19-r28  |         | Callee-saved registers
+     r18    |         | The Platform Register, if needed; 
+            |         | or temporary register
+     r17    |  IP1    | The second intra-procedure-call temporary register
+     r16    |  IP0    | The first intra-procedure-call scratch register
+    r9-r15  |         | Temporary registers
+     r8     |         | Indirect result location register
+    r0-r7   |         | Parameter/result registers
+
+
+   FPU/SIMD registers
+
+   s/d/q/v0-v7    Argument / result/ scratch registers
+   s/d/q/v8-v15   callee-saved registers (must be preserved across subrutine calls,
+                  but only bottom 64-bit value needs to be preserved)
+   s/d/q/v16-v31  temporary registers
+
+   ----------------------------------------------------------------------------- */
+
+#elif MACHREGS_aarch64
+
+#define REG(x) __asm__(#x)
+
+#define REG_Base        r19
+#define REG_Sp          r20
+#define REG_Hp          r21
+#define REG_R1          r22
+#define REG_R2          r23
+#define REG_R3          r24
+#define REG_R4          r25
+#define REG_R5          r26
+#define REG_R6          r27
+#define REG_SpLim       r28
+
+#define REG_F1          s8
+#define REG_F2          s9
+#define REG_F3          s10
+#define REG_F4          s11
+
+#define REG_D1          d12
+#define REG_D2          d13
+
 #else
 
 #error Cannot find platform to give register info for
diff --git a/includes/stg/MiscClosures.h b/includes/stg/MiscClosures.h
index f8c8f0dbd1fd..d2b933deb07b 100644
--- a/includes/stg/MiscClosures.h
+++ b/includes/stg/MiscClosures.h
@@ -112,6 +112,10 @@ RTS_ENTRY(stg_MUT_ARR_PTRS_CLEAN);
 RTS_ENTRY(stg_MUT_ARR_PTRS_DIRTY);
 RTS_ENTRY(stg_MUT_ARR_PTRS_FROZEN);
 RTS_ENTRY(stg_MUT_ARR_PTRS_FROZEN0);
+RTS_ENTRY(stg_SMALL_MUT_ARR_PTRS_CLEAN);
+RTS_ENTRY(stg_SMALL_MUT_ARR_PTRS_DIRTY);
+RTS_ENTRY(stg_SMALL_MUT_ARR_PTRS_FROZEN);
+RTS_ENTRY(stg_SMALL_MUT_ARR_PTRS_FROZEN0);
 RTS_ENTRY(stg_MUT_VAR_CLEAN);
 RTS_ENTRY(stg_MUT_VAR_DIRTY);
 RTS_ENTRY(stg_END_TSO_QUEUE);
@@ -343,10 +347,29 @@ RTS_FUN_DECL(stg_casArrayzh);
 RTS_FUN_DECL(stg_newByteArrayzh);
 RTS_FUN_DECL(stg_newPinnedByteArrayzh);
 RTS_FUN_DECL(stg_newAlignedPinnedByteArrayzh);
+RTS_FUN_DECL(stg_shrinkMutableByteArrayzh);
+RTS_FUN_DECL(stg_resizzeMutableByteArrayzh);
 RTS_FUN_DECL(stg_casIntArrayzh);
-RTS_FUN_DECL(stg_fetchAddIntArrayzh);
 RTS_FUN_DECL(stg_newArrayzh);
 RTS_FUN_DECL(stg_newArrayArrayzh);
+RTS_FUN_DECL(stg_copyArrayzh);
+RTS_FUN_DECL(stg_copyMutableArrayzh);
+RTS_FUN_DECL(stg_copyArrayArrayzh);
+RTS_FUN_DECL(stg_copyMutableArrayArrayzh);
+RTS_FUN_DECL(stg_cloneArrayzh);
+RTS_FUN_DECL(stg_cloneMutableArrayzh);
+RTS_FUN_DECL(stg_freezzeArrayzh);
+RTS_FUN_DECL(stg_thawArrayzh);
+
+RTS_FUN_DECL(stg_newSmallArrayzh);
+RTS_FUN_DECL(stg_unsafeThawSmallArrayzh);
+RTS_FUN_DECL(stg_cloneSmallArrayzh);
+RTS_FUN_DECL(stg_cloneSmallMutableArrayzh);
+RTS_FUN_DECL(stg_freezzeSmallArrayzh);
+RTS_FUN_DECL(stg_thawSmallArrayzh);
+RTS_FUN_DECL(stg_copySmallArrayzh);
+RTS_FUN_DECL(stg_copySmallMutableArrayzh);
+RTS_FUN_DECL(stg_casSmallArrayzh);
 
 RTS_FUN_DECL(stg_newMutVarzh);
 RTS_FUN_DECL(stg_atomicModifyMutVarzh);
@@ -465,6 +488,8 @@ extern StgWord      RTS_VAR(CCS_LIST);         /* registered CCS list */
 extern StgWord      CCS_SYSTEM[];
 extern unsigned int RTS_VAR(CC_ID);            /* global ids */
 extern unsigned int RTS_VAR(CCS_ID);
+RTS_FUN_DECL(enterFunCCS);
+RTS_FUN_DECL(pushCostCentre);
 
 // Capability.c
 extern unsigned int n_capabilities;
diff --git a/includes/stg/Prim.h b/includes/stg/Prim.h
new file mode 100644
index 000000000000..48bbddb09c94
--- /dev/null
+++ b/includes/stg/Prim.h
@@ -0,0 +1,47 @@
+/* ----------------------------------------------------------------------------
+ *
+ * (c) The GHC Team, 2014-2014
+ *
+ * Declarations for C fallback primitives implemented by 'ghc-prim' package.
+ *
+ * Do not #include this file directly: #include "Rts.h" instead.
+ *
+ * To understand the structure of the RTS headers, see the wiki:
+ *   http://ghc.haskell.org/trac/ghc/wiki/Commentary/SourceTree/Includes
+ *
+ * -------------------------------------------------------------------------- */
+
+#ifndef PRIM_H
+#define PRIM_H
+
+/* libraries/ghc-prim/cbits/bswap.c */
+StgWord16 hs_bswap16(StgWord16 x);
+StgWord32 hs_bswap32(StgWord32 x);
+StgWord64 hs_bswap64(StgWord64 x);
+
+/* TODO: longlong.c */
+
+/* libraries/ghc-prim/cbits/popcnt.c */
+StgWord hs_popcnt8(StgWord x);
+StgWord hs_popcnt16(StgWord x);
+StgWord hs_popcnt32(StgWord x);
+StgWord hs_popcnt64(StgWord64 x);
+StgWord hs_popcnt(StgWord x);
+
+/* libraries/ghc-prim/cbits/word2float.c */
+StgFloat hs_word2float32(StgWord x);
+StgDouble hs_word2float64(StgWord x);
+
+/* libraries/ghc-prim/cbits/clz.c */
+StgWord hs_clz8(StgWord x);
+StgWord hs_clz16(StgWord x);
+StgWord hs_clz32(StgWord x);
+StgWord hs_clz64(StgWord64 x);
+
+/* libraries/ghc-prim/cbits/ctz.c */
+StgWord hs_ctz8(StgWord x);
+StgWord hs_ctz16(StgWord x);
+StgWord hs_ctz32(StgWord x);
+StgWord hs_ctz64(StgWord64 x);
+
+#endif /* PRIM_H */
diff --git a/includes/stg/SMP.h b/includes/stg/SMP.h
index 01663dd86e2b..00608c707c9a 100644
--- a/includes/stg/SMP.h
+++ b/includes/stg/SMP.h
@@ -107,7 +107,10 @@ EXTERN_INLINE StgWord
 xchg(StgPtr p, StgWord w)
 {
     StgWord result;
-#if i386_HOST_ARCH || x86_64_HOST_ARCH
+#if defined(NOSMP)
+    result = *p;
+    *p = w;
+#elif i386_HOST_ARCH || x86_64_HOST_ARCH
     result = w;
     __asm__ __volatile__ (
         // NB: the xchg instruction is implicitly locked, so we do not
@@ -154,9 +157,6 @@ xchg(StgPtr p, StgWord w)
                           : "r" (w), "r" (p)
                           : "memory"
                           );
-#elif !defined(WITHSMP)
-    result = *p;
-    *p = w;
 #else
 #error xchg() unimplemented on this architecture
 #endif
@@ -170,7 +170,14 @@ xchg(StgPtr p, StgWord w)
 EXTERN_INLINE StgWord
 cas(StgVolatilePtr p, StgWord o, StgWord n)
 {
-#if i386_HOST_ARCH || x86_64_HOST_ARCH
+#if defined(NOSMP)
+    StgWord result;
+    result = *p;
+    if (result == o) {
+        *p = n;
+    }
+    return result;
+#elif i386_HOST_ARCH || x86_64_HOST_ARCH
     __asm__ __volatile__ (
  	  "lock\ncmpxchg %3,%1"
           :"=a"(o), "+m" (*(volatile unsigned int *)p)
@@ -225,13 +232,6 @@ cas(StgVolatilePtr p, StgWord o, StgWord n)
                 : "cc","memory");
 
     return result;
-#elif !defined(WITHSMP)
-    StgWord result;
-    result = *p;
-    if (result == o) {
-        *p = n;
-    }
-    return result;
 #else
 #error cas() unimplemented on this architecture
 #endif
@@ -302,7 +302,9 @@ busy_wait_nop(void)
  */
 EXTERN_INLINE void
 write_barrier(void) {
-#if i386_HOST_ARCH || x86_64_HOST_ARCH
+#if defined(NOSMP)
+    return;
+#elif i386_HOST_ARCH || x86_64_HOST_ARCH
     __asm__ __volatile__ ("" : : : "memory");
 #elif powerpc_HOST_ARCH
     __asm__ __volatile__ ("lwsync" : : : "memory");
@@ -313,8 +315,6 @@ write_barrier(void) {
     __asm__ __volatile__ ("" : : : "memory");
 #elif arm_HOST_ARCH && !defined(arm_HOST_ARCH_PRE_ARMv7)
     __asm__ __volatile__ ("dmb  st" : : : "memory");
-#elif !defined(WITHSMP)
-    return;
 #else
 #error memory barriers unimplemented on this architecture
 #endif
@@ -322,7 +322,9 @@ write_barrier(void) {
 
 EXTERN_INLINE void
 store_load_barrier(void) {
-#if i386_HOST_ARCH
+#if defined(NOSMP)
+    return;
+#elif i386_HOST_ARCH
     __asm__ __volatile__ ("lock; addl $0,0(%%esp)" : : : "memory");
 #elif x86_64_HOST_ARCH
     __asm__ __volatile__ ("lock; addq $0,0(%%rsp)" : : : "memory");
@@ -332,8 +334,6 @@ store_load_barrier(void) {
     __asm__ __volatile__ ("membar #StoreLoad" : : : "memory");
 #elif arm_HOST_ARCH && !defined(arm_HOST_ARCH_PRE_ARMv7)
     __asm__ __volatile__ ("dmb" : : : "memory");
-#elif !defined(WITHSMP)
-    return;
 #else
 #error memory barriers unimplemented on this architecture
 #endif
@@ -341,7 +341,9 @@ store_load_barrier(void) {
 
 EXTERN_INLINE void
 load_load_barrier(void) {
-#if i386_HOST_ARCH
+#if defined(NOSMP)
+    return;
+#elif i386_HOST_ARCH
     __asm__ __volatile__ ("" : : : "memory");
 #elif x86_64_HOST_ARCH
     __asm__ __volatile__ ("" : : : "memory");
@@ -352,8 +354,6 @@ load_load_barrier(void) {
     __asm__ __volatile__ ("" : : : "memory");
 #elif arm_HOST_ARCH && !defined(arm_HOST_ARCH_PRE_ARMv7)
     __asm__ __volatile__ ("dmb" : : : "memory");
-#elif !defined(WITHSMP)
-    return;
 #else
 #error memory barriers unimplemented on this architecture
 #endif
diff --git a/libffi-tarballs b/libffi-tarballs
new file mode 160000
index 000000000000..a0088d1da0e1
--- /dev/null
+++ b/libffi-tarballs
@@ -0,0 +1 @@
+Subproject commit a0088d1da0e171849ddb47a46c869856037a01d1
diff --git a/libraries/Cabal b/libraries/Cabal
index e97aa58f6851..6cc46998f077 160000
--- a/libraries/Cabal
+++ b/libraries/Cabal
@@ -1 +1 @@
-Subproject commit e97aa58f68519db54de1c62339459ebb88aed069
+Subproject commit 6cc46998f0778c04b535c805416604995fe153b5
diff --git a/libraries/Win32 b/libraries/Win32
index 3da00d80f2fd..c51e81a43cd5 160000
--- a/libraries/Win32
+++ b/libraries/Win32
@@ -1 +1 @@
-Subproject commit 3da00d80f2fd7d1032e3530e1af1b39fba79aac3
+Subproject commit c51e81a43cd5e9540453bd5ca6da8992245a4774
diff --git a/libraries/array b/libraries/array
new file mode 160000
index 000000000000..7784c531e2fc
--- /dev/null
+++ b/libraries/array
@@ -0,0 +1 @@
+Subproject commit 7784c531e2fc8ae7e544ce50293a6108005cedd4
diff --git a/libraries/base/.authorspellings b/libraries/base/.authorspellings
new file mode 100644
index 000000000000..7687ac65d43a
--- /dev/null
+++ b/libraries/base/.authorspellings
@@ -0,0 +1,12 @@
+Simon Marlow            <marlowsd@gmail.com>,            simonmar, simonmar@microsoft.com
+Ross Paterson           <ross@soi.city.ac.uk>,           ross
+Sven Panne              <sven.panne@aedion.de>,          panne
+Malcolm Wallace         <Malcolm.Wallace@cs.york.ac.uk>, malcolm
+Simon Peyton Jones      <simonpj@microsoft.com>,         simonpj
+Don Stewart             <dons@galois.com>,               dons
+Tim Harris              <tharris@microsoft.com>,         tharris
+Lennart Augustsson      <lennart@augustsson.net>,        lennart.augustsson@credit-suisse.com
+Duncan Coutts           <duncan@haskell.org>,            duncan.coutts@worc.ox.ac.uk, duncan@well-typed.com
+Ben Lippmeier           <benl@ouroborus.net>,            benl@cse.unsw.edu.au, Ben.Lippmeier@anu.edu.au
+Manuel M T Chakravarty  <chak@cse.unsw.edu.au>,          chak
+Jose Pedro Magalhaes    <jpm@cs.uu.nl>,                  jpm@cs.uu.nl
diff --git a/libraries/base/.gitignore b/libraries/base/.gitignore
new file mode 100644
index 000000000000..54bc34c8af77
--- /dev/null
+++ b/libraries/base/.gitignore
@@ -0,0 +1,21 @@
+*.o
+*.aux
+*.hi
+*.tix
+
+# Backup files
+*~
+
+# Specific generated files
+/GNUmakefile
+/autom4te.cache/
+/base.buildinfo
+/config.log
+/config.status
+/configure
+/dist-install/
+/ghc.mk
+/include/EventConfig.h
+/include/HsBaseConfig.h
+/include/HsBaseConfig.h.in
+
diff --git a/libraries/base/Control/Applicative.hs b/libraries/base/Control/Applicative.hs
new file mode 100644
index 000000000000..81ce513a58b7
--- /dev/null
+++ b/libraries/base/Control/Applicative.hs
@@ -0,0 +1,334 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE AutoDeriveTypeable #-}
+{-# LANGUAGE DeriveGeneric #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Control.Applicative
+-- Copyright   :  Conor McBride and Ross Paterson 2005
+-- License     :  BSD-style (see the LICENSE file in the distribution)
+--
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  experimental
+-- Portability :  portable
+--
+-- This module describes a structure intermediate between a functor and
+-- a monad (technically, a strong lax monoidal functor).  Compared with
+-- monads, this interface lacks the full power of the binding operation
+-- '>>=', but
+--
+-- * it has more instances.
+--
+-- * it is sufficient for many uses, e.g. context-free parsing, or the
+--   'Data.Traversable.Traversable' class.
+--
+-- * instances can perform analysis of computations before they are
+--   executed, and thus produce shared optimizations.
+--
+-- This interface was introduced for parsers by Niklas R&#xF6;jemo, because
+-- it admits more sharing than the monadic interface.  The names here are
+-- mostly based on parsing work by Doaitse Swierstra.
+--
+-- For more details, see
+-- <http://www.soi.city.ac.uk/~ross/papers/Applicative.html Applicative Programming with Effects>,
+-- by Conor McBride and Ross Paterson.
+
+module Control.Applicative (
+    -- * Applicative functors
+    Applicative(..),
+    -- * Alternatives
+    Alternative(..),
+    -- * Instances
+    Const(..), WrappedMonad(..), WrappedArrow(..), ZipList(..),
+    -- * Utility functions
+    (<$>), (<$), (<**>),
+    liftA, liftA2, liftA3,
+    optional,
+    ) where
+
+import Prelude hiding (id,(.))
+
+import Control.Category
+import Control.Arrow
+import Control.Monad (liftM, ap, MonadPlus(..))
+import Control.Monad.ST.Safe (ST)
+import qualified Control.Monad.ST.Lazy.Safe as Lazy (ST)
+import Data.Functor ((<$>), (<$))
+import Data.Monoid (Monoid(..), First(..), Last(..))
+import Data.Proxy
+
+import Text.ParserCombinators.ReadP (ReadP)
+import Text.ParserCombinators.ReadPrec (ReadPrec)
+
+import GHC.Conc (STM, retry, orElse)
+import GHC.Generics
+
+infixl 3 <|>
+infixl 4 <*>, <*, *>, <**>
+
+-- | A functor with application, providing operations to
+--
+-- * embed pure expressions ('pure'), and
+--
+-- * sequence computations and combine their results ('<*>').
+--
+-- A minimal complete definition must include implementations of these
+-- functions satisfying the following laws:
+--
+-- [/identity/]
+--
+--      @'pure' 'id' '<*>' v = v@
+--
+-- [/composition/]
+--
+--      @'pure' (.) '<*>' u '<*>' v '<*>' w = u '<*>' (v '<*>' w)@
+--
+-- [/homomorphism/]
+--
+--      @'pure' f '<*>' 'pure' x = 'pure' (f x)@
+--
+-- [/interchange/]
+--
+--      @u '<*>' 'pure' y = 'pure' ('$' y) '<*>' u@
+--
+-- The other methods have the following default definitions, which may
+-- be overridden with equivalent specialized implementations:
+--
+--   * @u '*>' v = 'pure' ('const' 'id') '<*>' u '<*>' v@
+--
+--   * @u '<*' v = 'pure' 'const' '<*>' u '<*>' v@
+--
+-- As a consequence of these laws, the 'Functor' instance for @f@ will satisfy
+--
+--   * @'fmap' f x = 'pure' f '<*>' x@
+--
+-- If @f@ is also a 'Monad', it should satisfy
+--
+--   * @'pure' = 'return'@
+--
+--   * @('<*>') = 'ap'@
+--
+-- (which implies that 'pure' and '<*>' satisfy the applicative functor laws).
+
+class Functor f => Applicative f where
+    -- | Lift a value.
+    pure :: a -> f a
+
+    -- | Sequential application.
+    (<*>) :: f (a -> b) -> f a -> f b
+
+    -- | Sequence actions, discarding the value of the first argument.
+    (*>) :: f a -> f b -> f b
+    (*>) = liftA2 (const id)
+
+    -- | Sequence actions, discarding the value of the second argument.
+    (<*) :: f a -> f b -> f a
+    (<*) = liftA2 const
+
+-- | A monoid on applicative functors.
+--
+-- Minimal complete definition: 'empty' and '<|>'.
+--
+-- If defined, 'some' and 'many' should be the least solutions
+-- of the equations:
+--
+-- * @some v = (:) '<$>' v '<*>' many v@
+--
+-- * @many v = some v '<|>' 'pure' []@
+class Applicative f => Alternative f where
+    -- | The identity of '<|>'
+    empty :: f a
+    -- | An associative binary operation
+    (<|>) :: f a -> f a -> f a
+
+    -- | One or more.
+    some :: f a -> f [a]
+    some v = some_v
+      where
+        many_v = some_v <|> pure []
+        some_v = (:) <$> v <*> many_v
+
+    -- | Zero or more.
+    many :: f a -> f [a]
+    many v = many_v
+      where
+        many_v = some_v <|> pure []
+        some_v = (:) <$> v <*> many_v
+
+-- instances for Prelude types
+
+instance Applicative Maybe where
+    pure = return
+    (<*>) = ap
+
+instance Alternative Maybe where
+    empty = Nothing
+    Nothing <|> r = r
+    l       <|> _ = l
+
+instance Applicative [] where
+    pure = return
+    (<*>) = ap
+
+instance Alternative [] where
+    empty = []
+    (<|>) = (++)
+
+instance Applicative IO where
+    pure = return
+    (<*>) = ap
+
+instance Applicative (ST s) where
+    pure = return
+    (<*>) = ap
+
+instance Applicative (Lazy.ST s) where
+    pure = return
+    (<*>) = ap
+
+instance Applicative STM where
+    pure = return
+    (<*>) = ap
+
+instance Alternative STM where
+    empty = retry
+    (<|>) = orElse
+
+instance Applicative ((->) a) where
+    pure = const
+    (<*>) f g x = f x (g x)
+
+instance Monoid a => Applicative ((,) a) where
+    pure x = (mempty, x)
+    (u, f) <*> (v, x) = (u `mappend` v, f x)
+
+instance Applicative (Either e) where
+    pure          = Right
+    Left  e <*> _ = Left e
+    Right f <*> r = fmap f r
+
+instance Applicative ReadP where
+    pure = return
+    (<*>) = ap
+
+instance Alternative ReadP where
+    empty = mzero
+    (<|>) = mplus
+
+instance Applicative ReadPrec where
+    pure = return
+    (<*>) = ap
+
+instance Alternative ReadPrec where
+    empty = mzero
+    (<|>) = mplus
+
+instance Arrow a => Applicative (ArrowMonad a) where
+   pure x = ArrowMonad (arr (const x))
+   ArrowMonad f <*> ArrowMonad x = ArrowMonad (f &&& x >>> arr (uncurry id))
+
+instance ArrowPlus a => Alternative (ArrowMonad a) where
+   empty = ArrowMonad zeroArrow
+   ArrowMonad x <|> ArrowMonad y = ArrowMonad (x <+> y)
+
+-- new instances
+
+newtype Const a b = Const { getConst :: a }
+                  deriving (Generic, Generic1)
+
+instance Functor (Const m) where
+    fmap _ (Const v) = Const v
+
+-- Added in base-4.7.0.0
+instance Monoid a => Monoid (Const a b) where
+    mempty = Const mempty
+    mappend (Const a) (Const b) = Const (mappend a b)
+
+instance Monoid m => Applicative (Const m) where
+    pure _ = Const mempty
+    Const f <*> Const v = Const (f `mappend` v)
+
+newtype WrappedMonad m a = WrapMonad { unwrapMonad :: m a }
+                         deriving (Generic, Generic1)
+
+instance Monad m => Functor (WrappedMonad m) where
+    fmap f (WrapMonad v) = WrapMonad (liftM f v)
+
+instance Monad m => Applicative (WrappedMonad m) where
+    pure = WrapMonad . return
+    WrapMonad f <*> WrapMonad v = WrapMonad (f `ap` v)
+
+-- Added in base-4.7.0.0 (GHC Trac #8218)
+instance Monad m => Monad (WrappedMonad m) where
+    return = WrapMonad . return
+    a >>= f = WrapMonad (unwrapMonad a >>= unwrapMonad . f)
+
+instance MonadPlus m => Alternative (WrappedMonad m) where
+    empty = WrapMonad mzero
+    WrapMonad u <|> WrapMonad v = WrapMonad (u `mplus` v)
+
+newtype WrappedArrow a b c = WrapArrow { unwrapArrow :: a b c }
+                           deriving (Generic, Generic1)
+
+instance Arrow a => Functor (WrappedArrow a b) where
+    fmap f (WrapArrow a) = WrapArrow (a >>> arr f)
+
+instance Arrow a => Applicative (WrappedArrow a b) where
+    pure x = WrapArrow (arr (const x))
+    WrapArrow f <*> WrapArrow v = WrapArrow (f &&& v >>> arr (uncurry id))
+
+instance (ArrowZero a, ArrowPlus a) => Alternative (WrappedArrow a b) where
+    empty = WrapArrow zeroArrow
+    WrapArrow u <|> WrapArrow v = WrapArrow (u <+> v)
+
+-- Added in base-4.8.0.0
+instance Applicative First where
+        pure x = First (Just x)
+        First x <*> First y = First (x <*> y)
+
+instance Applicative Last where
+        pure x = Last (Just x)
+        Last x <*> Last y = Last (x <*> y)
+
+-- | Lists, but with an 'Applicative' functor based on zipping, so that
+--
+-- @f '<$>' 'ZipList' xs1 '<*>' ... '<*>' 'ZipList' xsn = 'ZipList' (zipWithn f xs1 ... xsn)@
+--
+newtype ZipList a = ZipList { getZipList :: [a] }
+                  deriving (Show, Eq, Ord, Read, Generic, Generic1)
+
+instance Functor ZipList where
+    fmap f (ZipList xs) = ZipList (map f xs)
+
+instance Applicative ZipList where
+    pure x = ZipList (repeat x)
+    ZipList fs <*> ZipList xs = ZipList (zipWith id fs xs)
+
+instance Applicative Proxy where
+    pure _ = Proxy
+    {-# INLINE pure #-}
+    _ <*> _ = Proxy
+    {-# INLINE (<*>) #-}
+
+-- extra functions
+
+-- | A variant of '<*>' with the arguments reversed.
+(<**>) :: Applicative f => f a -> f (a -> b) -> f b
+(<**>) = liftA2 (flip ($))
+
+-- | Lift a function to actions.
+-- This function may be used as a value for `fmap` in a `Functor` instance.
+liftA :: Applicative f => (a -> b) -> f a -> f b
+liftA f a = pure f <*> a
+
+-- | Lift a binary function to actions.
+liftA2 :: Applicative f => (a -> b -> c) -> f a -> f b -> f c
+liftA2 f a b = f <$> a <*> b
+
+-- | Lift a ternary function to actions.
+liftA3 :: Applicative f => (a -> b -> c -> d) -> f a -> f b -> f c -> f d
+liftA3 f a b c = f <$> a <*> b <*> c
+
+-- | One or none.
+optional :: Alternative f => f a -> f (Maybe a)
+optional v = Just <$> v <|> pure Nothing
diff --git a/libraries/base/Control/Arrow.hs b/libraries/base/Control/Arrow.hs
new file mode 100644
index 000000000000..b723dd4722a2
--- /dev/null
+++ b/libraries/base/Control/Arrow.hs
@@ -0,0 +1,362 @@
+{-# LANGUAGE Trustworthy #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Control.Arrow
+-- Copyright   :  (c) Ross Paterson 2002
+-- License     :  BSD-style (see the LICENSE file in the distribution)
+--
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  provisional
+-- Portability :  portable
+--
+-- Basic arrow definitions, based on
+--
+--  * /Generalising Monads to Arrows/, by John Hughes,
+--    /Science of Computer Programming/ 37, pp67-111, May 2000.
+--
+-- plus a couple of definitions ('returnA' and 'loop') from
+--
+--  * /A New Notation for Arrows/, by Ross Paterson, in /ICFP 2001/,
+--    Firenze, Italy, pp229-240.
+--
+-- These papers and more information on arrows can be found at
+-- <http://www.haskell.org/arrows/>.
+
+module Control.Arrow (
+    -- * Arrows
+    Arrow(..), Kleisli(..),
+    -- ** Derived combinators
+    returnA,
+    (^>>), (>>^),
+    (>>>), (<<<), -- reexported
+    -- ** Right-to-left variants
+    (<<^), (^<<),
+    -- * Monoid operations
+    ArrowZero(..), ArrowPlus(..),
+    -- * Conditionals
+    ArrowChoice(..),
+    -- * Arrow application
+    ArrowApply(..), ArrowMonad(..), leftApp,
+    -- * Feedback
+    ArrowLoop(..)
+    ) where
+
+import Prelude hiding (id,(.))
+
+import Control.Monad
+import Control.Monad.Fix
+import Control.Category
+
+infixr 5 <+>
+infixr 3 ***
+infixr 3 &&&
+infixr 2 +++
+infixr 2 |||
+infixr 1 ^>>, >>^
+infixr 1 ^<<, <<^
+
+-- | The basic arrow class.
+--
+-- Minimal complete definition: 'arr' and 'first', satisfying the laws
+--
+--  * @'arr' id = 'id'@
+--
+--  * @'arr' (f >>> g) = 'arr' f >>> 'arr' g@
+--
+--  * @'first' ('arr' f) = 'arr' ('first' f)@
+--
+--  * @'first' (f >>> g) = 'first' f >>> 'first' g@
+--
+--  * @'first' f >>> 'arr' 'fst' = 'arr' 'fst' >>> f@
+--
+--  * @'first' f >>> 'arr' ('id' *** g) = 'arr' ('id' *** g) >>> 'first' f@
+--
+--  * @'first' ('first' f) >>> 'arr' 'assoc' = 'arr' 'assoc' >>> 'first' f@
+--
+-- where
+--
+-- > assoc ((a,b),c) = (a,(b,c))
+--
+-- The other combinators have sensible default definitions,
+-- which may be overridden for efficiency.
+
+class Category a => Arrow a where
+
+    -- | Lift a function to an arrow.
+    arr :: (b -> c) -> a b c
+
+    -- | Send the first component of the input through the argument
+    --   arrow, and copy the rest unchanged to the output.
+    first :: a b c -> a (b,d) (c,d)
+
+    -- | A mirror image of 'first'.
+    --
+    --   The default definition may be overridden with a more efficient
+    --   version if desired.
+    second :: a b c -> a (d,b) (d,c)
+    second f = arr swap >>> first f >>> arr swap
+      where
+        swap :: (x,y) -> (y,x)
+        swap ~(x,y) = (y,x)
+
+    -- | Split the input between the two argument arrows and combine
+    --   their output.  Note that this is in general not a functor.
+    --
+    --   The default definition may be overridden with a more efficient
+    --   version if desired.
+    (***) :: a b c -> a b' c' -> a (b,b') (c,c')
+    f *** g = first f >>> second g
+
+    -- | Fanout: send the input to both argument arrows and combine
+    --   their output.
+    --
+    --   The default definition may be overridden with a more efficient
+    --   version if desired.
+    (&&&) :: a b c -> a b c' -> a b (c,c')
+    f &&& g = arr (\b -> (b,b)) >>> f *** g
+
+{-# RULES
+"compose/arr"   forall f g .
+                (arr f) . (arr g) = arr (f . g)
+"first/arr"     forall f .
+                first (arr f) = arr (first f)
+"second/arr"    forall f .
+                second (arr f) = arr (second f)
+"product/arr"   forall f g .
+                arr f *** arr g = arr (f *** g)
+"fanout/arr"    forall f g .
+                arr f &&& arr g = arr (f &&& g)
+"compose/first" forall f g .
+                (first f) . (first g) = first (f . g)
+"compose/second" forall f g .
+                (second f) . (second g) = second (f . g)
+ #-}
+
+-- Ordinary functions are arrows.
+
+instance Arrow (->) where
+    arr f = f
+    first f = f *** id
+    second f = id *** f
+--  (f *** g) ~(x,y) = (f x, g y)
+--  sorry, although the above defn is fully H'98, nhc98 can't parse it.
+    (***) f g ~(x,y) = (f x, g y)
+
+-- | Kleisli arrows of a monad.
+newtype Kleisli m a b = Kleisli { runKleisli :: a -> m b }
+
+instance Monad m => Category (Kleisli m) where
+    id = Kleisli return
+    (Kleisli f) . (Kleisli g) = Kleisli (\b -> g b >>= f)
+
+instance Monad m => Arrow (Kleisli m) where
+    arr f = Kleisli (return . f)
+    first (Kleisli f) = Kleisli (\ ~(b,d) -> f b >>= \c -> return (c,d))
+    second (Kleisli f) = Kleisli (\ ~(d,b) -> f b >>= \c -> return (d,c))
+
+-- | The identity arrow, which plays the role of 'return' in arrow notation.
+returnA :: Arrow a => a b b
+returnA = arr id
+
+-- | Precomposition with a pure function.
+(^>>) :: Arrow a => (b -> c) -> a c d -> a b d
+f ^>> a = arr f >>> a
+
+-- | Postcomposition with a pure function.
+(>>^) :: Arrow a => a b c -> (c -> d) -> a b d
+a >>^ f = a >>> arr f
+
+-- | Precomposition with a pure function (right-to-left variant).
+(<<^) :: Arrow a => a c d -> (b -> c) -> a b d
+a <<^ f = a <<< arr f
+
+-- | Postcomposition with a pure function (right-to-left variant).
+(^<<) :: Arrow a => (c -> d) -> a b c -> a b d
+f ^<< a = arr f <<< a
+
+class Arrow a => ArrowZero a where
+    zeroArrow :: a b c
+
+instance MonadPlus m => ArrowZero (Kleisli m) where
+    zeroArrow = Kleisli (\_ -> mzero)
+
+-- | A monoid on arrows.
+class ArrowZero a => ArrowPlus a where
+    -- | An associative operation with identity 'zeroArrow'.
+    (<+>) :: a b c -> a b c -> a b c
+
+instance MonadPlus m => ArrowPlus (Kleisli m) where
+    Kleisli f <+> Kleisli g = Kleisli (\x -> f x `mplus` g x)
+
+-- | Choice, for arrows that support it.  This class underlies the
+-- @if@ and @case@ constructs in arrow notation.
+--
+-- Minimal complete definition: 'left', satisfying the laws
+--
+--  * @'left' ('arr' f) = 'arr' ('left' f)@
+--
+--  * @'left' (f >>> g) = 'left' f >>> 'left' g@
+--
+--  * @f >>> 'arr' 'Left' = 'arr' 'Left' >>> 'left' f@
+--
+--  * @'left' f >>> 'arr' ('id' +++ g) = 'arr' ('id' +++ g) >>> 'left' f@
+--
+--  * @'left' ('left' f) >>> 'arr' 'assocsum' = 'arr' 'assocsum' >>> 'left' f@
+--
+-- where
+--
+-- > assocsum (Left (Left x)) = Left x
+-- > assocsum (Left (Right y)) = Right (Left y)
+-- > assocsum (Right z) = Right (Right z)
+--
+-- The other combinators have sensible default definitions, which may
+-- be overridden for efficiency.
+
+class Arrow a => ArrowChoice a where
+
+    -- | Feed marked inputs through the argument arrow, passing the
+    --   rest through unchanged to the output.
+    left :: a b c -> a (Either b d) (Either c d)
+
+    -- | A mirror image of 'left'.
+    --
+    --   The default definition may be overridden with a more efficient
+    --   version if desired.
+    right :: a b c -> a (Either d b) (Either d c)
+    right f = arr mirror >>> left f >>> arr mirror
+      where
+        mirror :: Either x y -> Either y x
+        mirror (Left x) = Right x
+        mirror (Right y) = Left y
+
+    -- | Split the input between the two argument arrows, retagging
+    --   and merging their outputs.
+    --   Note that this is in general not a functor.
+    --
+    --   The default definition may be overridden with a more efficient
+    --   version if desired.
+    (+++) :: a b c -> a b' c' -> a (Either b b') (Either c c')
+    f +++ g = left f >>> right g
+
+    -- | Fanin: Split the input between the two argument arrows and
+    --   merge their outputs.
+    --
+    --   The default definition may be overridden with a more efficient
+    --   version if desired.
+    (|||) :: a b d -> a c d -> a (Either b c) d
+    f ||| g = f +++ g >>> arr untag
+      where
+        untag (Left x) = x
+        untag (Right y) = y
+
+{-# RULES
+"left/arr"      forall f .
+                left (arr f) = arr (left f)
+"right/arr"     forall f .
+                right (arr f) = arr (right f)
+"sum/arr"       forall f g .
+                arr f +++ arr g = arr (f +++ g)
+"fanin/arr"     forall f g .
+                arr f ||| arr g = arr (f ||| g)
+"compose/left"  forall f g .
+                left f . left g = left (f . g)
+"compose/right" forall f g .
+                right f . right g = right (f . g)
+ #-}
+
+instance ArrowChoice (->) where
+    left f = f +++ id
+    right f = id +++ f
+    f +++ g = (Left . f) ||| (Right . g)
+    (|||) = either
+
+instance Monad m => ArrowChoice (Kleisli m) where
+    left f = f +++ arr id
+    right f = arr id +++ f
+    f +++ g = (f >>> arr Left) ||| (g >>> arr Right)
+    Kleisli f ||| Kleisli g = Kleisli (either f g)
+
+-- | Some arrows allow application of arrow inputs to other inputs.
+-- Instances should satisfy the following laws:
+--
+--  * @'first' ('arr' (\\x -> 'arr' (\\y -> (x,y)))) >>> 'app' = 'id'@
+--
+--  * @'first' ('arr' (g >>>)) >>> 'app' = 'second' g >>> 'app'@
+--
+--  * @'first' ('arr' (>>> h)) >>> 'app' = 'app' >>> h@
+--
+-- Such arrows are equivalent to monads (see 'ArrowMonad').
+
+class Arrow a => ArrowApply a where
+    app :: a (a b c, b) c
+
+instance ArrowApply (->) where
+    app (f,x) = f x
+
+instance Monad m => ArrowApply (Kleisli m) where
+    app = Kleisli (\(Kleisli f, x) -> f x)
+
+-- | The 'ArrowApply' class is equivalent to 'Monad': any monad gives rise
+--   to a 'Kleisli' arrow, and any instance of 'ArrowApply' defines a monad.
+
+newtype ArrowMonad a b = ArrowMonad (a () b)
+
+instance Arrow a => Functor (ArrowMonad a) where
+    fmap f (ArrowMonad m) = ArrowMonad $ m >>> arr f
+
+instance ArrowApply a => Monad (ArrowMonad a) where
+    return x = ArrowMonad (arr (\_ -> x))
+    ArrowMonad m >>= f = ArrowMonad $
+        m >>> arr (\x -> let ArrowMonad h = f x in (h, ())) >>> app
+
+instance (ArrowApply a, ArrowPlus a) => MonadPlus (ArrowMonad a) where
+   mzero = ArrowMonad zeroArrow
+   ArrowMonad x `mplus` ArrowMonad y = ArrowMonad (x <+> y)
+
+-- | Any instance of 'ArrowApply' can be made into an instance of
+--   'ArrowChoice' by defining 'left' = 'leftApp'.
+
+leftApp :: ArrowApply a => a b c -> a (Either b d) (Either c d)
+leftApp f = arr ((\b -> (arr (\() -> b) >>> f >>> arr Left, ())) |||
+             (\d -> (arr (\() -> d) >>> arr Right, ()))) >>> app
+
+-- | The 'loop' operator expresses computations in which an output value
+-- is fed back as input, although the computation occurs only once.
+-- It underlies the @rec@ value recursion construct in arrow notation.
+-- 'loop' should satisfy the following laws:
+--
+-- [/extension/]
+--      @'loop' ('arr' f) = 'arr' (\\ b -> 'fst' ('fix' (\\ (c,d) -> f (b,d))))@
+--
+-- [/left tightening/]
+--      @'loop' ('first' h >>> f) = h >>> 'loop' f@
+--
+-- [/right tightening/]
+--      @'loop' (f >>> 'first' h) = 'loop' f >>> h@
+--
+-- [/sliding/]
+--      @'loop' (f >>> 'arr' ('id' *** k)) = 'loop' ('arr' ('id' *** k) >>> f)@
+--
+-- [/vanishing/]
+--      @'loop' ('loop' f) = 'loop' ('arr' unassoc >>> f >>> 'arr' assoc)@
+--
+-- [/superposing/]
+--      @'second' ('loop' f) = 'loop' ('arr' assoc >>> 'second' f >>> 'arr' unassoc)@
+--
+-- where
+--
+-- > assoc ((a,b),c) = (a,(b,c))
+-- > unassoc (a,(b,c)) = ((a,b),c)
+--
+class Arrow a => ArrowLoop a where
+    loop :: a (b,d) (c,d) -> a b c
+
+instance ArrowLoop (->) where
+    loop f b = let (c,d) = f (b,d) in c
+
+-- | Beware that for many monads (those for which the '>>=' operation
+-- is strict) this instance will /not/ satisfy the right-tightening law
+-- required by the 'ArrowLoop' class.
+instance MonadFix m => ArrowLoop (Kleisli m) where
+    loop (Kleisli f) = Kleisli (liftM fst . mfix . f')
+      where f' x y = f (x, snd y)
diff --git a/libraries/base/Control/Category.hs b/libraries/base/Control/Category.hs
new file mode 100644
index 000000000000..35875c9bdd3f
--- /dev/null
+++ b/libraries/base/Control/Category.hs
@@ -0,0 +1,66 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE CPP #-}
+
+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 706
+{-# LANGUAGE PolyKinds, GADTs #-}
+#endif
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Control.Category
+-- Copyright   :  (c) Ashley Yakeley 2007
+-- License     :  BSD-style (see the LICENSE file in the distribution)
+--
+-- Maintainer  :  ashley@semantic.org
+-- Stability   :  experimental
+-- Portability :  portable
+
+-- http://ghc.haskell.org/trac/ghc/ticket/1773
+
+module Control.Category where
+
+import qualified Prelude
+import Data.Type.Coercion
+import Data.Type.Equality
+import GHC.Prim (coerce)
+
+infixr 9 .
+infixr 1 >>>, <<<
+
+-- | A class for categories.
+--   id and (.) must form a monoid.
+class Category cat where
+    -- | the identity morphism
+    id :: cat a a
+
+    -- | morphism composition
+    (.) :: cat b c -> cat a b -> cat a c
+
+{-# RULES
+"identity/left" forall p .
+                id . p = p
+"identity/right"        forall p .
+                p . id = p
+"association"   forall p q r .
+                (p . q) . r = p . (q . r)
+ #-}
+
+instance Category (->) where
+    id = Prelude.id
+    (.) = (Prelude..)
+
+instance Category (:~:) where
+  id          = Refl
+  Refl . Refl = Refl
+
+instance Category Coercion where
+  id = Coercion
+  (.) Coercion = coerce
+
+-- | Right-to-left composition
+(<<<) :: Category cat => cat b c -> cat a b -> cat a c
+(<<<) = (.)
+
+-- | Left-to-right composition
+(>>>) :: Category cat => cat a b -> cat b c -> cat a c
+f >>> g = g . f
diff --git a/libraries/base/Control/Concurrent.hs b/libraries/base/Control/Concurrent.hs
new file mode 100644
index 000000000000..e5a0ebfe20f6
--- /dev/null
+++ b/libraries/base/Control/Concurrent.hs
@@ -0,0 +1,665 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE CPP
+           , MagicHash
+           , UnboxedTuples
+           , ScopedTypeVariables
+  #-}
+{-# OPTIONS_GHC -fno-warn-unused-imports #-}
+{-# OPTIONS_GHC -fno-warn-deprecations #-}
+-- kludge for the Control.Concurrent.QSem, Control.Concurrent.QSemN
+-- and Control.Concurrent.SampleVar imports.
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Control.Concurrent
+-- Copyright   :  (c) The University of Glasgow 2001
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+--
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  experimental
+-- Portability :  non-portable (concurrency)
+--
+-- A common interface to a collection of useful concurrency
+-- abstractions.
+--
+-----------------------------------------------------------------------------
+
+module Control.Concurrent (
+        -- * Concurrent Haskell
+
+        -- $conc_intro
+
+        -- * Basic concurrency operations
+
+        ThreadId,
+        myThreadId,
+
+        forkIO,
+        forkFinally,
+        forkIOWithUnmask,
+        killThread,
+        throwTo,
+
+        -- ** Threads with affinity
+        forkOn,
+        forkOnWithUnmask,
+        getNumCapabilities,
+        setNumCapabilities,
+        threadCapability,
+
+        -- * Scheduling
+
+        -- $conc_scheduling
+        yield,
+
+        -- ** Blocking
+
+        -- $blocking
+
+        -- ** Waiting
+        threadDelay,
+        threadWaitRead,
+        threadWaitWrite,
+        threadWaitReadSTM,
+        threadWaitWriteSTM,
+
+        -- * Communication abstractions
+
+        module Control.Concurrent.MVar,
+        module Control.Concurrent.Chan,
+        module Control.Concurrent.QSem,
+        module Control.Concurrent.QSemN,
+
+        -- * Bound Threads
+        -- $boundthreads
+        rtsSupportsBoundThreads,
+        forkOS,
+        isCurrentThreadBound,
+        runInBoundThread,
+        runInUnboundThread,
+
+        -- * Weak references to ThreadIds
+        mkWeakThreadId,
+
+        -- * GHC's implementation of concurrency
+
+        -- |This section describes features specific to GHC's
+        -- implementation of Concurrent Haskell.
+
+        -- ** Haskell threads and Operating System threads
+
+        -- $osthreads
+
+        -- ** Terminating the program
+
+        -- $termination
+
+        -- ** Pre-emption
+
+        -- $preemption
+
+        -- ** Deadlock
+
+        -- $deadlock
+
+    ) where
+
+import Prelude
+
+import Control.Exception.Base as Exception
+
+import GHC.Exception
+import GHC.Conc hiding (threadWaitRead, threadWaitWrite,
+                        threadWaitReadSTM, threadWaitWriteSTM)
+import qualified GHC.Conc
+import GHC.IO           ( IO(..), unsafeInterleaveIO, unsafeUnmask )
+import GHC.IORef        ( newIORef, readIORef, writeIORef )
+import GHC.Base
+
+import System.Posix.Types ( Fd )
+import Foreign.StablePtr
+import Foreign.C.Types
+import Control.Monad
+
+#ifdef mingw32_HOST_OS
+import Foreign.C
+import System.IO
+import Data.Maybe (Maybe(..))
+#endif
+
+import Control.Concurrent.MVar
+import Control.Concurrent.Chan
+import Control.Concurrent.QSem
+import Control.Concurrent.QSemN
+
+{- $conc_intro
+
+The concurrency extension for Haskell is described in the paper
+/Concurrent Haskell/
+<http://www.haskell.org/ghc/docs/papers/concurrent-haskell.ps.gz>.
+
+Concurrency is \"lightweight\", which means that both thread creation
+and context switching overheads are extremely low.  Scheduling of
+Haskell threads is done internally in the Haskell runtime system, and
+doesn't make use of any operating system-supplied thread packages.
+
+However, if you want to interact with a foreign library that expects your
+program to use the operating system-supplied thread package, you can do so
+by using 'forkOS' instead of 'forkIO'.
+
+Haskell threads can communicate via 'MVar's, a kind of synchronised
+mutable variable (see "Control.Concurrent.MVar").  Several common
+concurrency abstractions can be built from 'MVar's, and these are
+provided by the "Control.Concurrent" library.
+In GHC, threads may also communicate via exceptions.
+-}
+
+{- $conc_scheduling
+
+    Scheduling may be either pre-emptive or co-operative,
+    depending on the implementation of Concurrent Haskell (see below
+    for information related to specific compilers).  In a co-operative
+    system, context switches only occur when you use one of the
+    primitives defined in this module.  This means that programs such
+    as:
+
+
+>   main = forkIO (write 'a') >> write 'b'
+>     where write c = putChar c >> write c
+
+    will print either @aaaaaaaaaaaaaa...@ or @bbbbbbbbbbbb...@,
+    instead of some random interleaving of @a@s and @b@s.  In
+    practice, cooperative multitasking is sufficient for writing
+    simple graphical user interfaces.
+-}
+
+{- $blocking
+Different Haskell implementations have different characteristics with
+regard to which operations block /all/ threads.
+
+Using GHC without the @-threaded@ option, all foreign calls will block
+all other Haskell threads in the system, although I\/O operations will
+not.  With the @-threaded@ option, only foreign calls with the @unsafe@
+attribute will block all other threads.
+
+-}
+
+-- | fork a thread and call the supplied function when the thread is about
+-- to terminate, with an exception or a returned value.  The function is
+-- called with asynchronous exceptions masked.
+--
+-- > forkFinally action and_then =
+-- >   mask $ \restore ->
+-- >     forkIO $ try (restore action) >>= and_then
+--
+-- This function is useful for informing the parent when a child
+-- terminates, for example.
+--
+-- /Since: 4.6.0.0/
+forkFinally :: IO a -> (Either SomeException a -> IO ()) -> IO ThreadId
+forkFinally action and_then =
+  mask $ \restore ->
+    forkIO $ try (restore action) >>= and_then
+
+-- ---------------------------------------------------------------------------
+-- Bound Threads
+
+{- $boundthreads
+   #boundthreads#
+
+Support for multiple operating system threads and bound threads as described
+below is currently only available in the GHC runtime system if you use the
+/-threaded/ option when linking.
+
+Other Haskell systems do not currently support multiple operating system threads.
+
+A bound thread is a haskell thread that is /bound/ to an operating system
+thread. While the bound thread is still scheduled by the Haskell run-time
+system, the operating system thread takes care of all the foreign calls made
+by the bound thread.
+
+To a foreign library, the bound thread will look exactly like an ordinary
+operating system thread created using OS functions like @pthread_create@
+or @CreateThread@.
+
+Bound threads can be created using the 'forkOS' function below. All foreign
+exported functions are run in a bound thread (bound to the OS thread that
+called the function). Also, the @main@ action of every Haskell program is
+run in a bound thread.
+
+Why do we need this? Because if a foreign library is called from a thread
+created using 'forkIO', it won't have access to any /thread-local state/ -
+state variables that have specific values for each OS thread
+(see POSIX's @pthread_key_create@ or Win32's @TlsAlloc@). Therefore, some
+libraries (OpenGL, for example) will not work from a thread created using
+'forkIO'. They work fine in threads created using 'forkOS' or when called
+from @main@ or from a @foreign export@.
+
+In terms of performance, 'forkOS' (aka bound) threads are much more
+expensive than 'forkIO' (aka unbound) threads, because a 'forkOS'
+thread is tied to a particular OS thread, whereas a 'forkIO' thread
+can be run by any OS thread.  Context-switching between a 'forkOS'
+thread and a 'forkIO' thread is many times more expensive than between
+two 'forkIO' threads.
+
+Note in particular that the main program thread (the thread running
+@Main.main@) is always a bound thread, so for good concurrency
+performance you should ensure that the main thread is not doing
+repeated communication with other threads in the system.  Typically
+this means forking subthreads to do the work using 'forkIO', and
+waiting for the results in the main thread.
+
+-}
+
+-- | 'True' if bound threads are supported.
+-- If @rtsSupportsBoundThreads@ is 'False', 'isCurrentThreadBound'
+-- will always return 'False' and both 'forkOS' and 'runInBoundThread' will
+-- fail.
+foreign import ccall rtsSupportsBoundThreads :: Bool
+
+
+{- |
+Like 'forkIO', this sparks off a new thread to run the 'IO'
+computation passed as the first argument, and returns the 'ThreadId'
+of the newly created thread.
+
+However, 'forkOS' creates a /bound/ thread, which is necessary if you
+need to call foreign (non-Haskell) libraries that make use of
+thread-local state, such as OpenGL (see "Control.Concurrent#boundthreads").
+
+Using 'forkOS' instead of 'forkIO' makes no difference at all to the
+scheduling behaviour of the Haskell runtime system.  It is a common
+misconception that you need to use 'forkOS' instead of 'forkIO' to
+avoid blocking all the Haskell threads when making a foreign call;
+this isn't the case.  To allow foreign calls to be made without
+blocking all the Haskell threads (with GHC), it is only necessary to
+use the @-threaded@ option when linking your program, and to make sure
+the foreign import is not marked @unsafe@.
+-}
+
+forkOS :: IO () -> IO ThreadId
+
+foreign export ccall forkOS_entry
+    :: StablePtr (IO ()) -> IO ()
+
+foreign import ccall "forkOS_entry" forkOS_entry_reimported
+    :: StablePtr (IO ()) -> IO ()
+
+forkOS_entry :: StablePtr (IO ()) -> IO ()
+forkOS_entry stableAction = do
+        action <- deRefStablePtr stableAction
+        action
+
+foreign import ccall forkOS_createThread
+    :: StablePtr (IO ()) -> IO CInt
+
+failNonThreaded :: IO a
+failNonThreaded = fail $ "RTS doesn't support multiple OS threads "
+                       ++"(use ghc -threaded when linking)"
+
+forkOS action0
+    | rtsSupportsBoundThreads = do
+        mv <- newEmptyMVar
+        b <- Exception.getMaskingState
+        let
+            -- async exceptions are masked in the child if they are masked
+            -- in the parent, as for forkIO (see #1048). forkOS_createThread
+            -- creates a thread with exceptions masked by default.
+            action1 = case b of
+                        Unmasked -> unsafeUnmask action0
+                        MaskedInterruptible -> action0
+                        MaskedUninterruptible -> uninterruptibleMask_ action0
+
+            action_plus = Exception.catch action1 childHandler
+
+        entry <- newStablePtr (myThreadId >>= putMVar mv >> action_plus)
+        err <- forkOS_createThread entry
+        when (err /= 0) $ fail "Cannot create OS thread."
+        tid <- takeMVar mv
+        freeStablePtr entry
+        return tid
+    | otherwise = failNonThreaded
+
+-- | Returns 'True' if the calling thread is /bound/, that is, if it is
+-- safe to use foreign libraries that rely on thread-local state from the
+-- calling thread.
+isCurrentThreadBound :: IO Bool
+isCurrentThreadBound = IO $ \ s# ->
+    case isCurrentThreadBound# s# of
+        (# s2#, flg #) -> (# s2#, isTrue# (flg /=# 0#) #)
+
+
+{- |
+Run the 'IO' computation passed as the first argument. If the calling thread
+is not /bound/, a bound thread is created temporarily. @runInBoundThread@
+doesn't finish until the 'IO' computation finishes.
+
+You can wrap a series of foreign function calls that rely on thread-local state
+with @runInBoundThread@ so that you can use them without knowing whether the
+current thread is /bound/.
+-}
+runInBoundThread :: IO a -> IO a
+
+runInBoundThread action
+    | rtsSupportsBoundThreads = do
+        bound <- isCurrentThreadBound
+        if bound
+            then action
+            else do
+                ref <- newIORef undefined
+                let action_plus = Exception.try action >>= writeIORef ref
+                bracket (newStablePtr action_plus)
+                        freeStablePtr
+                        (\cEntry -> forkOS_entry_reimported cEntry >> readIORef ref) >>=
+                  unsafeResult
+    | otherwise = failNonThreaded
+
+{- |
+Run the 'IO' computation passed as the first argument. If the calling thread
+is /bound/, an unbound thread is created temporarily using 'forkIO'.
+@runInBoundThread@ doesn't finish until the 'IO' computation finishes.
+
+Use this function /only/ in the rare case that you have actually observed a
+performance loss due to the use of bound threads. A program that
+doesn't need its main thread to be bound and makes /heavy/ use of concurrency
+(e.g. a web server), might want to wrap its @main@ action in
+@runInUnboundThread@.
+
+Note that exceptions which are thrown to the current thread are thrown in turn
+to the thread that is executing the given computation. This ensures there's
+always a way of killing the forked thread.
+-}
+runInUnboundThread :: IO a -> IO a
+
+runInUnboundThread action = do
+  bound <- isCurrentThreadBound
+  if bound
+    then do
+      mv <- newEmptyMVar
+      mask $ \restore -> do
+        tid <- forkIO $ Exception.try (restore action) >>= putMVar mv
+        let wait = takeMVar mv `Exception.catch` \(e :: SomeException) ->
+                     Exception.throwTo tid e >> wait
+        wait >>= unsafeResult
+    else action
+
+unsafeResult :: Either SomeException a -> IO a
+unsafeResult = either Exception.throwIO return
+
+-- ---------------------------------------------------------------------------
+-- threadWaitRead/threadWaitWrite
+
+-- | Block the current thread until data is available to read on the
+-- given file descriptor (GHC only).
+--
+-- This will throw an 'IOError' if the file descriptor was closed
+-- while this thread was blocked.  To safely close a file descriptor
+-- that has been used with 'threadWaitRead', use
+-- 'GHC.Conc.closeFdWith'.
+threadWaitRead :: Fd -> IO ()
+threadWaitRead fd
+#ifdef mingw32_HOST_OS
+  -- we have no IO manager implementing threadWaitRead on Windows.
+  -- fdReady does the right thing, but we have to call it in a
+  -- separate thread, otherwise threadWaitRead won't be interruptible,
+  -- and this only works with -threaded.
+  | threaded  = withThread (waitFd fd 0)
+  | otherwise = case fd of
+                  0 -> do _ <- hWaitForInput stdin (-1)
+                          return ()
+                        -- hWaitForInput does work properly, but we can only
+                        -- do this for stdin since we know its FD.
+                  _ -> error "threadWaitRead requires -threaded on Windows, or use System.IO.hWaitForInput"
+#else
+  = GHC.Conc.threadWaitRead fd
+#endif
+
+-- | Block the current thread until data can be written to the
+-- given file descriptor (GHC only).
+--
+-- This will throw an 'IOError' if the file descriptor was closed
+-- while this thread was blocked.  To safely close a file descriptor
+-- that has been used with 'threadWaitWrite', use
+-- 'GHC.Conc.closeFdWith'.
+threadWaitWrite :: Fd -> IO ()
+threadWaitWrite fd
+#ifdef mingw32_HOST_OS
+  | threaded  = withThread (waitFd fd 1)
+  | otherwise = error "threadWaitWrite requires -threaded on Windows"
+#else
+  = GHC.Conc.threadWaitWrite fd
+#endif
+
+-- | Returns an STM action that can be used to wait for data
+-- to read from a file descriptor. The second returned value
+-- is an IO action that can be used to deregister interest
+-- in the file descriptor.
+--
+-- /Since: 4.7.0.0/
+threadWaitReadSTM :: Fd -> IO (STM (), IO ())
+threadWaitReadSTM fd
+#ifdef mingw32_HOST_OS
+  | threaded = do v <- newTVarIO Nothing
+                  mask_ $ void $ forkIO $ do result <- try (waitFd fd 0)
+                                             atomically (writeTVar v $ Just result)
+                  let waitAction = do result <- readTVar v
+                                      case result of
+                                        Nothing         -> retry
+                                        Just (Right ()) -> return ()
+                                        Just (Left e)   -> throwSTM (e :: IOException)
+                  let killAction = return ()
+                  return (waitAction, killAction)
+  | otherwise = error "threadWaitReadSTM requires -threaded on Windows"
+#else
+  = GHC.Conc.threadWaitReadSTM fd
+#endif
+
+-- | Returns an STM action that can be used to wait until data
+-- can be written to a file descriptor. The second returned value
+-- is an IO action that can be used to deregister interest
+-- in the file descriptor.
+--
+-- /Since: 4.7.0.0/
+threadWaitWriteSTM :: Fd -> IO (STM (), IO ())
+threadWaitWriteSTM fd
+#ifdef mingw32_HOST_OS
+  | threaded = do v <- newTVarIO Nothing
+                  mask_ $ void $ forkIO $ do result <- try (waitFd fd 1)
+                                             atomically (writeTVar v $ Just result)
+                  let waitAction = do result <- readTVar v
+                                      case result of
+                                        Nothing         -> retry
+                                        Just (Right ()) -> return ()
+                                        Just (Left e)   -> throwSTM (e :: IOException)
+                  let killAction = return ()
+                  return (waitAction, killAction)
+  | otherwise = error "threadWaitWriteSTM requires -threaded on Windows"
+#else
+  = GHC.Conc.threadWaitWriteSTM fd
+#endif
+
+#ifdef mingw32_HOST_OS
+foreign import ccall unsafe "rtsSupportsBoundThreads" threaded :: Bool
+
+withThread :: IO a -> IO a
+withThread io = do
+  m <- newEmptyMVar
+  _ <- mask_ $ forkIO $ try io >>= putMVar m
+  x <- takeMVar m
+  case x of
+    Right a -> return a
+    Left e  -> throwIO (e :: IOException)
+
+waitFd :: Fd -> CInt -> IO ()
+waitFd fd write = do
+   throwErrnoIfMinus1_ "fdReady" $
+        fdReady (fromIntegral fd) write iNFINITE 0
+
+iNFINITE :: CInt
+iNFINITE = 0xFFFFFFFF -- urgh
+
+foreign import ccall safe "fdReady"
+  fdReady :: CInt -> CInt -> CInt -> CInt -> IO CInt
+#endif
+
+-- ---------------------------------------------------------------------------
+-- More docs
+
+{- $osthreads
+
+      #osthreads# In GHC, threads created by 'forkIO' are lightweight threads, and
+      are managed entirely by the GHC runtime.  Typically Haskell
+      threads are an order of magnitude or two more efficient (in
+      terms of both time and space) than operating system threads.
+
+      The downside of having lightweight threads is that only one can
+      run at a time, so if one thread blocks in a foreign call, for
+      example, the other threads cannot continue.  The GHC runtime
+      works around this by making use of full OS threads where
+      necessary.  When the program is built with the @-threaded@
+      option (to link against the multithreaded version of the
+      runtime), a thread making a @safe@ foreign call will not block
+      the other threads in the system; another OS thread will take
+      over running Haskell threads until the original call returns.
+      The runtime maintains a pool of these /worker/ threads so that
+      multiple Haskell threads can be involved in external calls
+      simultaneously.
+
+      The "System.IO" library manages multiplexing in its own way.  On
+      Windows systems it uses @safe@ foreign calls to ensure that
+      threads doing I\/O operations don't block the whole runtime,
+      whereas on Unix systems all the currently blocked I\/O requests
+      are managed by a single thread (the /IO manager thread/) using
+      a mechanism such as @epoll@ or @kqueue@, depending on what is
+      provided by the host operating system.
+
+      The runtime will run a Haskell thread using any of the available
+      worker OS threads.  If you need control over which particular OS
+      thread is used to run a given Haskell thread, perhaps because
+      you need to call a foreign library that uses OS-thread-local
+      state, then you need bound threads (see "Control.Concurrent#boundthreads").
+
+      If you don't use the @-threaded@ option, then the runtime does
+      not make use of multiple OS threads.  Foreign calls will block
+      all other running Haskell threads until the call returns.  The
+      "System.IO" library still does multiplexing, so there can be multiple
+      threads doing I\/O, and this is handled internally by the runtime using
+      @select@.
+-}
+
+{- $termination
+
+      In a standalone GHC program, only the main thread is
+      required to terminate in order for the process to terminate.
+      Thus all other forked threads will simply terminate at the same
+      time as the main thread (the terminology for this kind of
+      behaviour is \"daemonic threads\").
+
+      If you want the program to wait for child threads to
+      finish before exiting, you need to program this yourself.  A
+      simple mechanism is to have each child thread write to an
+      'MVar' when it completes, and have the main
+      thread wait on all the 'MVar's before
+      exiting:
+
+>   myForkIO :: IO () -> IO (MVar ())
+>   myForkIO io = do
+>     mvar <- newEmptyMVar
+>     forkFinally io (\_ -> putMVar mvar ())
+>     return mvar
+
+      Note that we use 'forkFinally' to make sure that the
+      'MVar' is written to even if the thread dies or
+      is killed for some reason.
+
+      A better method is to keep a global list of all child
+      threads which we should wait for at the end of the program:
+
+>    children :: MVar [MVar ()]
+>    children = unsafePerformIO (newMVar [])
+>
+>    waitForChildren :: IO ()
+>    waitForChildren = do
+>      cs <- takeMVar children
+>      case cs of
+>        []   -> return ()
+>        m:ms -> do
+>           putMVar children ms
+>           takeMVar m
+>           waitForChildren
+>
+>    forkChild :: IO () -> IO ThreadId
+>    forkChild io = do
+>        mvar <- newEmptyMVar
+>        childs <- takeMVar children
+>        putMVar children (mvar:childs)
+>        forkFinally io (\_ -> putMVar mvar ())
+>
+>     main =
+>       later waitForChildren $
+>       ...
+
+      The main thread principle also applies to calls to Haskell from
+      outside, using @foreign export@.  When the @foreign export@ed
+      function is invoked, it starts a new main thread, and it returns
+      when this main thread terminates.  If the call causes new
+      threads to be forked, they may remain in the system after the
+      @foreign export@ed function has returned.
+-}
+
+{- $preemption
+
+      GHC implements pre-emptive multitasking: the execution of
+      threads are interleaved in a random fashion.  More specifically,
+      a thread may be pre-empted whenever it allocates some memory,
+      which unfortunately means that tight loops which do no
+      allocation tend to lock out other threads (this only seems to
+      happen with pathological benchmark-style code, however).
+
+      The rescheduling timer runs on a 20ms granularity by
+      default, but this may be altered using the
+      @-i\<n\>@ RTS option.  After a rescheduling
+      \"tick\" the running thread is pre-empted as soon as
+      possible.
+
+      One final note: the
+      @aaaa@ @bbbb@ example may not
+      work too well on GHC (see Scheduling, above), due
+      to the locking on a 'System.IO.Handle'.  Only one thread
+      may hold the lock on a 'System.IO.Handle' at any one
+      time, so if a reschedule happens while a thread is holding the
+      lock, the other thread won't be able to run.  The upshot is that
+      the switch from @aaaa@ to
+      @bbbbb@ happens infrequently.  It can be
+      improved by lowering the reschedule tick period.  We also have a
+      patch that causes a reschedule whenever a thread waiting on a
+      lock is woken up, but haven't found it to be useful for anything
+      other than this example :-)
+-}
+
+{- $deadlock
+
+GHC attempts to detect when threads are deadlocked using the garbage
+collector.  A thread that is not reachable (cannot be found by
+following pointers from live objects) must be deadlocked, and in this
+case the thread is sent an exception.  The exception is either
+'BlockedIndefinitelyOnMVar', 'BlockedIndefinitelyOnSTM',
+'NonTermination', or 'Deadlock', depending on the way in which the
+thread is deadlocked.
+
+Note that this feature is intended for debugging, and should not be
+relied on for the correct operation of your program.  There is no
+guarantee that the garbage collector will be accurate enough to detect
+your deadlock, and no guarantee that the garbage collector will run in
+a timely enough manner.  Basically, the same caveats as for finalizers
+apply to deadlock detection.
+
+There is a subtle interaction between deadlock detection and
+finalizers (as created by 'Foreign.Concurrent.newForeignPtr' or the
+functions in "System.Mem.Weak"): if a thread is blocked waiting for a
+finalizer to run, then the thread will be considered deadlocked and
+sent an exception.  So preferably don't do this, but if you have no
+alternative then it is possible to prevent the thread from being
+considered deadlocked by making a 'StablePtr' pointing to it.  Don't
+forget to release the 'StablePtr' later with 'freeStablePtr'.
+-}
diff --git a/libraries/base/Control/Concurrent/Chan.hs b/libraries/base/Control/Concurrent/Chan.hs
new file mode 100644
index 000000000000..e0b7b54c2345
--- /dev/null
+++ b/libraries/base/Control/Concurrent/Chan.hs
@@ -0,0 +1,164 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE AutoDeriveTypeable, StandaloneDeriving #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Control.Concurrent.Chan
+-- Copyright   :  (c) The University of Glasgow 2001
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+-- 
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  experimental
+-- Portability :  non-portable (concurrency)
+--
+-- Unbounded channels.
+--
+-----------------------------------------------------------------------------
+
+module Control.Concurrent.Chan
+  ( 
+          -- * The 'Chan' type
+        Chan,                   -- abstract
+
+          -- * Operations
+        newChan,
+        writeChan,
+        readChan,
+        dupChan,
+        unGetChan,
+        isEmptyChan,
+
+          -- * Stream interface
+        getChanContents,
+        writeList2Chan,
+   ) where
+
+import Prelude
+
+import System.IO.Unsafe         ( unsafeInterleaveIO )
+import Control.Concurrent.MVar
+import Control.Exception (mask_)
+import Data.Typeable
+
+#define _UPK_(x) {-# UNPACK #-} !(x)
+
+-- A channel is represented by two @MVar@s keeping track of the two ends
+-- of the channel contents,i.e.,  the read- and write ends. Empty @MVar@s
+-- are used to handle consumers trying to read from an empty channel.
+
+-- |'Chan' is an abstract type representing an unbounded FIFO channel.
+data Chan a
+ = Chan _UPK_(MVar (Stream a))
+        _UPK_(MVar (Stream a)) -- Invariant: the Stream a is always an empty MVar
+   deriving (Eq,Typeable)
+
+type Stream a = MVar (ChItem a)
+
+data ChItem a = ChItem a _UPK_(Stream a)
+  -- benchmarks show that unboxing the MVar here is worthwhile, because
+  -- although it leads to higher allocation, the channel data takes up
+  -- less space and is therefore quicker to GC.
+
+-- See the Concurrent Haskell paper for a diagram explaining the
+-- how the different channel operations proceed.
+
+-- @newChan@ sets up the read and write end of a channel by initialising
+-- these two @MVar@s with an empty @MVar@.
+
+-- |Build and returns a new instance of 'Chan'.
+newChan :: IO (Chan a)
+newChan = do
+   hole  <- newEmptyMVar
+   readVar  <- newMVar hole
+   writeVar <- newMVar hole
+   return (Chan readVar writeVar)
+
+-- To put an element on a channel, a new hole at the write end is created.
+-- What was previously the empty @MVar@ at the back of the channel is then
+-- filled in with a new stream element holding the entered value and the
+-- new hole.
+
+-- |Write a value to a 'Chan'.
+writeChan :: Chan a -> a -> IO ()
+writeChan (Chan _ writeVar) val = do
+  new_hole <- newEmptyMVar
+  mask_ $ do
+    old_hole <- takeMVar writeVar
+    putMVar old_hole (ChItem val new_hole)
+    putMVar writeVar new_hole
+
+-- The reason we don't simply do this:
+--
+--    modifyMVar_ writeVar $ \old_hole -> do
+--      putMVar old_hole (ChItem val new_hole)
+--      return new_hole
+--
+-- is because if an asynchronous exception is received after the 'putMVar'
+-- completes and before modifyMVar_ installs the new value, it will set the
+-- Chan's write end to a filled hole.
+
+-- |Read the next value from the 'Chan'.
+readChan :: Chan a -> IO a
+readChan (Chan readVar _) = do
+  modifyMVarMasked readVar $ \read_end -> do -- Note [modifyMVarMasked]
+    (ChItem val new_read_end) <- readMVar read_end
+        -- Use readMVar here, not takeMVar,
+        -- else dupChan doesn't work
+    return (new_read_end, val)
+
+-- Note [modifyMVarMasked]
+-- This prevents a theoretical deadlock if an asynchronous exception
+-- happens during the readMVar while the MVar is empty.  In that case
+-- the read_end MVar will be left empty, and subsequent readers will
+-- deadlock.  Using modifyMVarMasked prevents this.  The deadlock can
+-- be reproduced, but only by expanding readMVar and inserting an
+-- artificial yield between its takeMVar and putMVar operations.
+
+
+-- |Duplicate a 'Chan': the duplicate channel begins empty, but data written to
+-- either channel from then on will be available from both.  Hence this creates
+-- a kind of broadcast channel, where data written by anyone is seen by
+-- everyone else.
+--
+-- (Note that a duplicated channel is not equal to its original.
+-- So: @fmap (c /=) $ dupChan c@ returns @True@ for all @c@.)
+dupChan :: Chan a -> IO (Chan a)
+dupChan (Chan _ writeVar) = do
+   hole       <- readMVar writeVar
+   newReadVar <- newMVar hole
+   return (Chan newReadVar writeVar)
+
+-- |Put a data item back onto a channel, where it will be the next item read.
+unGetChan :: Chan a -> a -> IO ()
+unGetChan (Chan readVar _) val = do
+   new_read_end <- newEmptyMVar
+   modifyMVar_ readVar $ \read_end -> do
+     putMVar new_read_end (ChItem val read_end)
+     return new_read_end
+{-# DEPRECATED unGetChan "if you need this operation, use Control.Concurrent.STM.TChan instead.  See <http://ghc.haskell.org/trac/ghc/ticket/4154> for details" #-} -- deprecated in 7.0
+
+-- |Returns 'True' if the supplied 'Chan' is empty.
+isEmptyChan :: Chan a -> IO Bool
+isEmptyChan (Chan readVar writeVar) = do
+   withMVar readVar $ \r -> do
+     w <- readMVar writeVar
+     let eq = r == w
+     eq `seq` return eq
+{-# DEPRECATED isEmptyChan "if you need this operation, use Control.Concurrent.STM.TChan instead.  See <http://ghc.haskell.org/trac/ghc/ticket/4154> for details" #-} -- deprecated in 7.0
+
+-- Operators for interfacing with functional streams.
+
+-- |Return a lazy list representing the contents of the supplied
+-- 'Chan', much like 'System.IO.hGetContents'.
+getChanContents :: Chan a -> IO [a]
+getChanContents ch
+  = unsafeInterleaveIO (do
+        x  <- readChan ch
+        xs <- getChanContents ch
+        return (x:xs)
+    )
+
+-- |Write an entire list of items to a 'Chan'.
+writeList2Chan :: Chan a -> [a] -> IO ()
+writeList2Chan ch ls = sequence_ (map (writeChan ch) ls)
diff --git a/libraries/base/Control/Concurrent/MVar.hs b/libraries/base/Control/Concurrent/MVar.hs
new file mode 100644
index 000000000000..72a44d38d9db
--- /dev/null
+++ b/libraries/base/Control/Concurrent/MVar.hs
@@ -0,0 +1,274 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE NoImplicitPrelude, UnboxedTuples, MagicHash #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Control.Concurrent.MVar
+-- Copyright   :  (c) The University of Glasgow 2001
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+-- 
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  experimental
+-- Portability :  non-portable (concurrency)
+--
+-- An @'MVar' t@ is mutable location that is either empty or contains a
+-- value of type @t@.  It has two fundamental operations: 'putMVar'
+-- which fills an 'MVar' if it is empty and blocks otherwise, and
+-- 'takeMVar' which empties an 'MVar' if it is full and blocks
+-- otherwise.  They can be used in multiple different ways:
+--
+--   1. As synchronized mutable variables,
+--
+--   2. As channels, with 'takeMVar' and 'putMVar' as receive and send, and
+--
+--   3. As a binary semaphore @'MVar' ()@, with 'takeMVar' and 'putMVar' as
+--      wait and signal.
+--
+-- They were introduced in the paper
+-- <http://research.microsoft.com/~simonpj/papers/concurrent-haskell.ps.gz "Concurrent Haskell">
+-- by Simon Peyton Jones, Andrew Gordon and Sigbjorn Finne, though
+-- some details of their implementation have since then changed (in
+-- particular, a put on a full 'MVar' used to error, but now merely
+-- blocks.)
+--
+-- === Applicability
+--
+-- 'MVar's offer more flexibility than 'IORef's, but less flexibility
+-- than 'STM'.  They are appropriate for building synchronization
+-- primitives and performing simple interthread communication; however
+-- they are very simple and susceptible to race conditions, deadlocks or
+-- uncaught exceptions.  Do not use them if you need perform larger
+-- atomic operations such as reading from multiple variables: use 'STM'
+-- instead.
+--
+-- In particular, the "bigger" functions in this module ('readMVar',
+-- 'swapMVar', 'withMVar', 'modifyMVar_' and 'modifyMVar') are simply
+-- the composition of a 'takeMVar' followed by a 'putMVar' with
+-- exception safety.
+-- These only have atomicity guarantees if all other threads
+-- perform a 'takeMVar' before a 'putMVar' as well;  otherwise, they may
+-- block.
+--
+-- === Fairness
+--
+-- No thread can be blocked indefinitely on an 'MVar' unless another
+-- thread holds that 'MVar' indefinitely.  One usual implementation of
+-- this fairness guarantee is that threads blocked on an 'MVar' are
+-- served in a first-in-first-out fashion, but this is not guaranteed
+-- in the semantics.
+--
+-- === Gotchas
+--
+-- Like many other Haskell data structures, 'MVar's are lazy.  This
+-- means that if you place an expensive unevaluated thunk inside an
+-- 'MVar', it will be evaluated by the thread that consumes it, not the
+-- thread that produced it.  Be sure to 'evaluate' values to be placed
+-- in an 'MVar' to the appropriate normal form, or utilize a strict
+-- MVar provided by the strict-concurrency package.
+--
+-- === Ordering
+--
+-- 'MVar' operations are always observed to take place in the order
+-- they are written in the program, regardless of the memory model of
+-- the underlying machine.  This is in contrast to 'IORef' operations
+-- which may appear out-of-order to another thread in some cases.
+--
+-- === Example
+--
+-- Consider the following concurrent data structure, a skip channel.
+-- This is a channel for an intermittent source of high bandwidth
+-- information (for example, mouse movement events.)  Writing to the
+-- channel never blocks, and reading from the channel only returns the
+-- most recent value, or blocks if there are no new values.  Multiple
+-- readers are supported with a @dupSkipChan@ operation.
+--
+-- A skip channel is a pair of 'MVar's. The first 'MVar' contains the
+-- current value, and a list of semaphores that need to be notified
+-- when it changes. The second 'MVar' is a semaphore for this particular
+-- reader: it is full if there is a value in the channel that this
+-- reader has not read yet, and empty otherwise.
+--
+-- @
+--     data SkipChan a = SkipChan (MVar (a, [MVar ()])) (MVar ())
+--
+--     newSkipChan :: IO (SkipChan a)
+--     newSkipChan = do
+--         sem <- newEmptyMVar
+--         main <- newMVar (undefined, [sem])
+--         return (SkipChan main sem)
+--
+--     putSkipChan :: SkipChan a -> a -> IO ()
+--     putSkipChan (SkipChan main _) v = do
+--         (_, sems) <- takeMVar main
+--         putMVar main (v, [])
+--         mapM_ (\sem -> putMVar sem ()) sems
+--
+--     getSkipChan :: SkipChan a -> IO a
+--     getSkipChan (SkipChan main sem) = do
+--         takeMVar sem
+--         (v, sems) <- takeMVar main
+--         putMVar main (v, sem:sems)
+--         return v
+--
+--     dupSkipChan :: SkipChan a -> IO (SkipChan a)
+--     dupSkipChan (SkipChan main _) = do
+--         sem <- newEmptyMVar
+--         (v, sems) <- takeMVar main
+--         putMVar main (v, sem:sems)
+--         return (SkipChan main sem)
+-- @
+--
+-- This example was adapted from the original Concurrent Haskell paper.
+-- For more examples of 'MVar's being used to build higher-level
+-- synchronization primitives, see 'Control.Concurrent.Chan' and
+-- 'Control.Concurrent.QSem'.
+--
+-----------------------------------------------------------------------------
+
+module Control.Concurrent.MVar
+        (
+          -- * @MVar@s
+          MVar
+        , newEmptyMVar
+        , newMVar
+        , takeMVar
+        , putMVar
+        , readMVar
+        , swapMVar
+        , tryTakeMVar
+        , tryPutMVar
+        , isEmptyMVar
+        , withMVar
+        , withMVarMasked
+        , modifyMVar_
+        , modifyMVar
+        , modifyMVarMasked_
+        , modifyMVarMasked
+        , tryReadMVar
+        , mkWeakMVar
+        , addMVarFinalizer
+    ) where
+
+import GHC.MVar ( MVar(..), newEmptyMVar, newMVar, takeMVar, putMVar,
+                  tryTakeMVar, tryPutMVar, isEmptyMVar, readMVar,
+                  tryReadMVar
+                )
+import qualified GHC.MVar
+import GHC.Weak
+import GHC.Base
+
+import Control.Exception.Base
+
+{-|
+  Take a value from an 'MVar', put a new value into the 'MVar' and
+  return the value taken. This function is atomic only if there are
+  no other producers for this 'MVar'.
+-}
+swapMVar :: MVar a -> a -> IO a
+swapMVar mvar new =
+  mask_ $ do
+    old <- takeMVar mvar
+    putMVar mvar new
+    return old
+
+{-|
+  'withMVar' is an exception-safe wrapper for operating on the contents
+  of an 'MVar'.  This operation is exception-safe: it will replace the
+  original contents of the 'MVar' if an exception is raised (see
+  "Control.Exception").  However, it is only atomic if there are no
+  other producers for this 'MVar'.
+-}
+{-# INLINE withMVar #-}
+-- inlining has been reported to have dramatic effects; see
+-- http://www.haskell.org//pipermail/haskell/2006-May/017907.html
+withMVar :: MVar a -> (a -> IO b) -> IO b
+withMVar m io =
+  mask $ \restore -> do
+    a <- takeMVar m
+    b <- restore (io a) `onException` putMVar m a
+    putMVar m a
+    return b
+
+{-|
+  Like 'withMVar', but the @IO@ action in the second argument is executed
+  with asynchronous exceptions masked.
+
+  /Since: 4.7.0.0/
+-}
+{-# INLINE withMVarMasked #-}
+withMVarMasked :: MVar a -> (a -> IO b) -> IO b
+withMVarMasked m io =
+  mask_ $ do
+    a <- takeMVar m
+    b <- io a `onException` putMVar m a
+    putMVar m a
+    return b
+
+{-|
+  An exception-safe wrapper for modifying the contents of an 'MVar'.
+  Like 'withMVar', 'modifyMVar' will replace the original contents of
+  the 'MVar' if an exception is raised during the operation.  This
+  function is only atomic if there are no other producers for this
+  'MVar'.
+-}
+{-# INLINE modifyMVar_ #-}
+modifyMVar_ :: MVar a -> (a -> IO a) -> IO ()
+modifyMVar_ m io =
+  mask $ \restore -> do
+    a  <- takeMVar m
+    a' <- restore (io a) `onException` putMVar m a
+    putMVar m a'
+
+{-|
+  A slight variation on 'modifyMVar_' that allows a value to be
+  returned (@b@) in addition to the modified value of the 'MVar'.
+-}
+{-# INLINE modifyMVar #-}
+modifyMVar :: MVar a -> (a -> IO (a,b)) -> IO b
+modifyMVar m io =
+  mask $ \restore -> do
+    a      <- takeMVar m
+    (a',b) <- restore (io a >>= evaluate) `onException` putMVar m a
+    putMVar m a'
+    return b
+
+{-|
+  Like 'modifyMVar_', but the @IO@ action in the second argument is executed with
+  asynchronous exceptions masked.
+
+  /Since: 4.6.0.0/
+-}
+{-# INLINE modifyMVarMasked_ #-}
+modifyMVarMasked_ :: MVar a -> (a -> IO a) -> IO ()
+modifyMVarMasked_ m io =
+  mask_ $ do
+    a  <- takeMVar m
+    a' <- io a `onException` putMVar m a
+    putMVar m a'
+
+{-|
+  Like 'modifyMVar', but the @IO@ action in the second argument is executed with
+  asynchronous exceptions masked.
+
+  /Since: 4.6.0.0/
+-}
+{-# INLINE modifyMVarMasked #-}
+modifyMVarMasked :: MVar a -> (a -> IO (a,b)) -> IO b
+modifyMVarMasked m io =
+  mask_ $ do
+    a      <- takeMVar m
+    (a',b) <- (io a >>= evaluate) `onException` putMVar m a
+    putMVar m a'
+    return b
+
+{-# DEPRECATED addMVarFinalizer "use 'mkWeakMVar' instead" #-} -- deprecated in 7.6
+addMVarFinalizer :: MVar a -> IO () -> IO ()
+addMVarFinalizer = GHC.MVar.addMVarFinalizer
+
+-- | Make a 'Weak' pointer to an 'MVar', using the second argument as
+-- a finalizer to run when 'MVar' is garbage-collected
+--
+-- /Since: 4.6.0.0/
+mkWeakMVar :: MVar a -> IO () -> IO (Weak (MVar a))
+mkWeakMVar m@(MVar m#) f = IO $ \s ->
+  case mkWeak# m# m f s of (# s1, w #) -> (# s1, Weak w #)
diff --git a/libraries/base/Control/Concurrent/QSem.hs b/libraries/base/Control/Concurrent/QSem.hs
new file mode 100644
index 000000000000..223d86539d97
--- /dev/null
+++ b/libraries/base/Control/Concurrent/QSem.hs
@@ -0,0 +1,130 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE AutoDeriveTypeable, BangPatterns #-}
+{-# OPTIONS_GHC -funbox-strict-fields #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Control.Concurrent.QSem
+-- Copyright   :  (c) The University of Glasgow 2001
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+-- 
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  experimental
+-- Portability :  non-portable (concurrency)
+--
+-- Simple quantity semaphores.
+--
+-----------------------------------------------------------------------------
+
+module Control.Concurrent.QSem
+        ( -- * Simple Quantity Semaphores
+          QSem,         -- abstract
+          newQSem,      -- :: Int  -> IO QSem
+          waitQSem,     -- :: QSem -> IO ()
+          signalQSem    -- :: QSem -> IO ()
+        ) where
+
+import Control.Concurrent.MVar ( MVar, newEmptyMVar, takeMVar, tryTakeMVar
+                          , putMVar, newMVar, tryPutMVar)
+import Control.Exception
+import Data.Maybe
+
+-- | 'QSem' is a quantity semaphore in which the resource is aqcuired
+-- and released in units of one. It provides guaranteed FIFO ordering
+-- for satisfying blocked `waitQSem` calls.
+--
+-- The pattern
+--
+-- >   bracket_ waitQSem signalQSem (...)
+--
+-- is safe; it never loses a unit of the resource.
+--
+data QSem = QSem !(MVar (Int, [MVar ()], [MVar ()]))
+
+-- The semaphore state (i, xs, ys):
+--
+--   i is the current resource value
+--
+--   (xs,ys) is the queue of blocked threads, where the queue is
+--           given by xs ++ reverse ys.  We can enqueue new blocked threads
+--           by consing onto ys, and dequeue by removing from the head of xs.
+--
+-- A blocked thread is represented by an empty (MVar ()).  To unblock
+-- the thread, we put () into the MVar.
+--
+-- A thread can dequeue itself by also putting () into the MVar, which
+-- it must do if it receives an exception while blocked in waitQSem.
+-- This means that when unblocking a thread in signalQSem we must
+-- first check whether the MVar is already full; the MVar lock on the
+-- semaphore itself resolves race conditions between signalQSem and a
+-- thread attempting to dequeue itself.
+
+-- |Build a new 'QSem' with a supplied initial quantity.
+--  The initial quantity must be at least 0.
+newQSem :: Int -> IO QSem
+newQSem initial
+  | initial < 0 = fail "newQSem: Initial quantity must be non-negative"
+  | otherwise   = do
+      sem <- newMVar (initial, [], [])
+      return (QSem sem)
+
+-- |Wait for a unit to become available
+waitQSem :: QSem -> IO ()
+waitQSem (QSem m) =
+  mask_ $ do
+    (i,b1,b2) <- takeMVar m
+    if i == 0
+       then do
+         b <- newEmptyMVar
+         putMVar m (i, b1, b:b2)
+         wait b
+       else do
+         let !z = i-1
+         putMVar m (z, b1, b2)
+         return ()
+  where
+    wait b = takeMVar b `onException` do
+                (uninterruptibleMask_ $ do -- Note [signal uninterruptible]
+                   (i,b1,b2) <- takeMVar m
+                   r <- tryTakeMVar b
+                   r' <- if isJust r
+                            then signal (i,b1,b2)
+                            else do putMVar b (); return (i,b1,b2)
+                   putMVar m r')
+
+-- |Signal that a unit of the 'QSem' is available
+signalQSem :: QSem -> IO ()
+signalQSem (QSem m) =
+  uninterruptibleMask_ $ do -- Note [signal uninterruptible]
+    r <- takeMVar m
+    r' <- signal r
+    putMVar m r'
+
+-- Note [signal uninterruptible]
+--
+--   If we have
+--
+--      bracket waitQSem signalQSem (...)
+--
+--   and an exception arrives at the signalQSem, then we must not lose
+--   the resource.  The signalQSem is masked by bracket, but taking
+--   the MVar might block, and so it would be interruptible.  Hence we
+--   need an uninterruptibleMask here.
+--
+--   This isn't ideal: during high contention, some threads won't be
+--   interruptible.  The QSemSTM implementation has better behaviour
+--   here, but it performs much worse than this one in some
+--   benchmarks.
+
+signal :: (Int,[MVar ()],[MVar ()]) -> IO (Int,[MVar ()],[MVar ()])
+signal (i,a1,a2) =
+ if i == 0
+   then loop a1 a2
+   else let !z = i+1 in return (z, a1, a2)
+ where
+   loop [] [] = return (1, [], [])
+   loop [] b2 = loop (reverse b2) []
+   loop (b:bs) b2 = do
+     r <- tryPutMVar b ()
+     if r then return (0, bs, b2)
+          else loop bs b2
diff --git a/libraries/base/Control/Concurrent/QSemN.hs b/libraries/base/Control/Concurrent/QSemN.hs
new file mode 100644
index 000000000000..a377e5e804c6
--- /dev/null
+++ b/libraries/base/Control/Concurrent/QSemN.hs
@@ -0,0 +1,124 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE AutoDeriveTypeable, BangPatterns #-}
+{-# OPTIONS_GHC -funbox-strict-fields #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Control.Concurrent.QSemN
+-- Copyright   :  (c) The University of Glasgow 2001
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+-- 
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  experimental
+-- Portability :  non-portable (concurrency)
+--
+-- Quantity semaphores in which each thread may wait for an arbitrary
+-- \"amount\".
+--
+-----------------------------------------------------------------------------
+
+module Control.Concurrent.QSemN
+        (  -- * General Quantity Semaphores
+          QSemN,        -- abstract
+          newQSemN,     -- :: Int   -> IO QSemN
+          waitQSemN,    -- :: QSemN -> Int -> IO ()
+          signalQSemN   -- :: QSemN -> Int -> IO ()
+      ) where
+
+import Control.Concurrent.MVar ( MVar, newEmptyMVar, takeMVar, tryTakeMVar
+                          , putMVar, newMVar
+                          , tryPutMVar, isEmptyMVar)
+import Data.Typeable
+import Control.Exception
+import Data.Maybe
+
+-- | 'QSemN' is a quantity semaphore in which the resource is aqcuired
+-- and released in units of one. It provides guaranteed FIFO ordering
+-- for satisfying blocked `waitQSemN` calls.
+--
+-- The pattern
+--
+-- >   bracket_ (waitQSemN n) (signalQSemN n) (...)
+--
+-- is safe; it never loses any of the resource.
+--
+data QSemN = QSemN !(MVar (Int, [(Int, MVar ())], [(Int, MVar ())]))
+  deriving Typeable
+
+-- The semaphore state (i, xs, ys):
+--
+--   i is the current resource value
+--
+--   (xs,ys) is the queue of blocked threads, where the queue is
+--           given by xs ++ reverse ys.  We can enqueue new blocked threads
+--           by consing onto ys, and dequeue by removing from the head of xs.
+--
+-- A blocked thread is represented by an empty (MVar ()).  To unblock
+-- the thread, we put () into the MVar.
+--
+-- A thread can dequeue itself by also putting () into the MVar, which
+-- it must do if it receives an exception while blocked in waitQSemN.
+-- This means that when unblocking a thread in signalQSemN we must
+-- first check whether the MVar is already full; the MVar lock on the
+-- semaphore itself resolves race conditions between signalQSemN and a
+-- thread attempting to dequeue itself.
+
+-- |Build a new 'QSemN' with a supplied initial quantity.
+--  The initial quantity must be at least 0.
+newQSemN :: Int -> IO QSemN
+newQSemN initial
+  | initial < 0 = fail "newQSemN: Initial quantity must be non-negative"
+  | otherwise   = do
+      sem <- newMVar (initial, [], [])
+      return (QSemN sem)
+
+-- |Wait for the specified quantity to become available
+waitQSemN :: QSemN -> Int -> IO ()
+waitQSemN (QSemN m) sz =
+  mask_ $ do
+    (i,b1,b2) <- takeMVar m
+    let z = i-sz
+    if z < 0
+       then do
+         b <- newEmptyMVar
+         putMVar m (i, b1, (sz,b):b2)
+         wait b
+       else do
+         putMVar m (z, b1, b2)
+         return ()
+  where
+    wait b = do
+        takeMVar b `onException`
+                (uninterruptibleMask_ $ do -- Note [signal uninterruptible]
+                   (i,b1,b2) <- takeMVar m
+                   r <- tryTakeMVar b
+                   r' <- if isJust r
+                            then signal sz (i,b1,b2)
+                            else do putMVar b (); return (i,b1,b2)
+                   putMVar m r')
+
+-- |Signal that a given quantity is now available from the 'QSemN'.
+signalQSemN :: QSemN -> Int -> IO ()
+signalQSemN (QSemN m) sz = uninterruptibleMask_ $ do
+  r <- takeMVar m
+  r' <- signal sz r
+  putMVar m r'
+
+signal :: Int
+       -> (Int,[(Int,MVar ())],[(Int,MVar ())])
+       -> IO (Int,[(Int,MVar ())],[(Int,MVar ())])
+
+signal sz0 (i,a1,a2) = loop (sz0 + i) a1 a2
+ where
+   loop 0  bs b2 = return (0,  bs, b2)
+   loop sz [] [] = return (sz, [], [])
+   loop sz [] b2 = loop sz (reverse b2) []
+   loop sz ((j,b):bs) b2
+     | j > sz = do
+       r <- isEmptyMVar b
+       if r then return (sz, (j,b):bs, b2)
+            else loop sz bs b2
+     | otherwise = do
+       r <- tryPutMVar b ()
+       if r then loop (sz-j) bs b2
+            else loop sz bs b2
diff --git a/libraries/base/Control/Exception.hs b/libraries/base/Control/Exception.hs
new file mode 100644
index 000000000000..7c019eb5ca34
--- /dev/null
+++ b/libraries/base/Control/Exception.hs
@@ -0,0 +1,391 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE NoImplicitPrelude, ExistentialQuantification #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Control.Exception
+-- Copyright   :  (c) The University of Glasgow 2001
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+--
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  experimental
+-- Portability :  non-portable (extended exceptions)
+--
+-- This module provides support for raising and catching both built-in
+-- and user-defined exceptions.
+--
+-- In addition to exceptions thrown by 'IO' operations, exceptions may
+-- be thrown by pure code (imprecise exceptions) or by external events
+-- (asynchronous exceptions), but may only be caught in the 'IO' monad.
+-- For more details, see:
+--
+--  * /A semantics for imprecise exceptions/, by Simon Peyton Jones,
+--    Alastair Reid, Tony Hoare, Simon Marlow, Fergus Henderson,
+--    in /PLDI'99/.
+--
+--  * /Asynchronous exceptions in Haskell/, by Simon Marlow, Simon Peyton
+--    Jones, Andy Moran and John Reppy, in /PLDI'01/.
+--
+--  * /An Extensible Dynamically-Typed Hierarchy of Exceptions/,
+--    by Simon Marlow, in /Haskell '06/.
+--
+-----------------------------------------------------------------------------
+
+module Control.Exception (
+
+        -- * The Exception type
+        SomeException(..),
+        Exception(..),          -- class
+        IOException,            -- instance Eq, Ord, Show, Typeable, Exception
+        ArithException(..),     -- instance Eq, Ord, Show, Typeable, Exception
+        ArrayException(..),     -- instance Eq, Ord, Show, Typeable, Exception
+        AssertionFailed(..),
+        SomeAsyncException(..),
+        AsyncException(..),     -- instance Eq, Ord, Show, Typeable, Exception
+        asyncExceptionToException, asyncExceptionFromException,
+
+        NonTermination(..),
+        NestedAtomically(..),
+        BlockedIndefinitelyOnMVar(..),
+        BlockedIndefinitelyOnSTM(..),
+        Deadlock(..),
+        NoMethodError(..),
+        PatternMatchFail(..),
+        RecConError(..),
+        RecSelError(..),
+        RecUpdError(..),
+        ErrorCall(..),
+
+        -- * Throwing exceptions
+        throw,
+        throwIO,
+        ioError,
+        throwTo,
+
+        -- * Catching Exceptions
+
+        -- $catching
+
+        -- ** Catching all exceptions
+
+        -- $catchall
+
+        -- ** The @catch@ functions
+        catch,
+        catches, Handler(..),
+        catchJust,
+
+        -- ** The @handle@ functions
+        handle,
+        handleJust,
+
+        -- ** The @try@ functions
+        try,
+        tryJust,
+
+        -- ** The @evaluate@ function
+        evaluate,
+
+        -- ** The @mapException@ function
+        mapException,
+
+        -- * Asynchronous Exceptions
+
+        -- $async
+
+        -- ** Asynchronous exception control
+
+        -- |The following functions allow a thread to control delivery of
+        -- asynchronous exceptions during a critical region.
+
+        mask,
+        mask_,
+        uninterruptibleMask,
+        uninterruptibleMask_,
+        MaskingState(..),
+        getMaskingState,
+        allowInterrupt,
+
+        -- *** Applying @mask@ to an exception handler
+
+        -- $block_handler
+
+        -- *** Interruptible operations
+
+        -- $interruptible
+
+        -- * Assertions
+
+        assert,
+
+        -- * Utilities
+
+        bracket,
+        bracket_,
+        bracketOnError,
+
+        finally,
+        onException,
+
+  ) where
+
+import Control.Exception.Base
+
+import GHC.Base
+import GHC.IO (unsafeUnmask)
+import Data.Maybe
+
+-- | You need this when using 'catches'.
+data Handler a = forall e . Exception e => Handler (e -> IO a)
+
+instance Functor Handler where
+     fmap f (Handler h) = Handler (fmap f . h)
+
+{- |
+Sometimes you want to catch two different sorts of exception. You could
+do something like
+
+> f = expr `catch` \ (ex :: ArithException) -> handleArith ex
+>          `catch` \ (ex :: IOException)    -> handleIO    ex
+
+However, there are a couple of problems with this approach. The first is
+that having two exception handlers is inefficient. However, the more
+serious issue is that the second exception handler will catch exceptions
+in the first, e.g. in the example above, if @handleArith@ throws an
+@IOException@ then the second exception handler will catch it.
+
+Instead, we provide a function 'catches', which would be used thus:
+
+> f = expr `catches` [Handler (\ (ex :: ArithException) -> handleArith ex),
+>                     Handler (\ (ex :: IOException)    -> handleIO    ex)]
+-}
+catches :: IO a -> [Handler a] -> IO a
+catches io handlers = io `catch` catchesHandler handlers
+
+catchesHandler :: [Handler a] -> SomeException -> IO a
+catchesHandler handlers e = foldr tryHandler (throw e) handlers
+    where tryHandler (Handler handler) res
+              = case fromException e of
+                Just e' -> handler e'
+                Nothing -> res
+
+-- -----------------------------------------------------------------------------
+-- Catching exceptions
+
+{- $catching
+
+There are several functions for catching and examining
+exceptions; all of them may only be used from within the
+'IO' monad.
+
+Here's a rule of thumb for deciding which catch-style function to
+use:
+
+ * If you want to do some cleanup in the event that an exception
+   is raised, use 'finally', 'bracket' or 'onException'.
+
+ * To recover after an exception and do something else, the best
+   choice is to use one of the 'try' family.
+
+ * ... unless you are recovering from an asynchronous exception, in which
+   case use 'catch' or 'catchJust'.
+
+The difference between using 'try' and 'catch' for recovery is that in
+'catch' the handler is inside an implicit 'block' (see \"Asynchronous
+Exceptions\") which is important when catching asynchronous
+exceptions, but when catching other kinds of exception it is
+unnecessary.  Furthermore it is possible to accidentally stay inside
+the implicit 'block' by tail-calling rather than returning from the
+handler, which is why we recommend using 'try' rather than 'catch' for
+ordinary exception recovery.
+
+A typical use of 'tryJust' for recovery looks like this:
+
+>  do r <- tryJust (guard . isDoesNotExistError) $ getEnv "HOME"
+>     case r of
+>       Left  e    -> ...
+>       Right home -> ...
+
+-}
+
+-- -----------------------------------------------------------------------------
+-- Asynchronous exceptions
+
+-- | When invoked inside 'mask', this function allows a blocked
+-- asynchronous exception to be raised, if one exists.  It is
+-- equivalent to performing an interruptible operation (see
+-- #interruptible#), but does not involve any actual blocking.
+--
+-- When called outside 'mask', or inside 'uninterruptibleMask', this
+-- function has no effect.
+--
+-- /Since: 4.4.0.0/
+allowInterrupt :: IO ()
+allowInterrupt = unsafeUnmask $ return ()
+
+{- $async
+
+ #AsynchronousExceptions# Asynchronous exceptions are so-called because they arise due to
+external influences, and can be raised at any point during execution.
+'StackOverflow' and 'HeapOverflow' are two examples of
+system-generated asynchronous exceptions.
+
+The primary source of asynchronous exceptions, however, is
+'throwTo':
+
+>  throwTo :: ThreadId -> Exception -> IO ()
+
+'throwTo' (also 'Control.Concurrent.killThread') allows one
+running thread to raise an arbitrary exception in another thread.  The
+exception is therefore asynchronous with respect to the target thread,
+which could be doing anything at the time it receives the exception.
+Great care should be taken with asynchronous exceptions; it is all too
+easy to introduce race conditions by the over zealous use of
+'throwTo'.
+-}
+
+{- $block_handler
+There\'s an implied 'mask' around every exception handler in a call
+to one of the 'catch' family of functions.  This is because that is
+what you want most of the time - it eliminates a common race condition
+in starting an exception handler, because there may be no exception
+handler on the stack to handle another exception if one arrives
+immediately.  If asynchronous exceptions are masked on entering the
+handler, though, we have time to install a new exception handler
+before being interrupted.  If this weren\'t the default, one would have
+to write something like
+
+>      mask $ \restore ->
+>           catch (restore (...))
+>                 (\e -> handler)
+
+If you need to unblock asynchronous exceptions again in the exception
+handler, 'restore' can be used there too.
+
+Note that 'try' and friends /do not/ have a similar default, because
+there is no exception handler in this case.  Don't use 'try' for
+recovering from an asynchronous exception.
+-}
+
+{- $interruptible
+
+ #interruptible#
+Some operations are /interruptible/, which means that they can receive
+asynchronous exceptions even in the scope of a 'mask'.  Any function
+which may itself block is defined as interruptible; this includes
+'Control.Concurrent.MVar.takeMVar'
+(but not 'Control.Concurrent.MVar.tryTakeMVar'),
+and most operations which perform
+some I\/O with the outside world.  The reason for having
+interruptible operations is so that we can write things like
+
+>      mask $ \restore -> do
+>         a <- takeMVar m
+>         catch (restore (...))
+>               (\e -> ...)
+
+if the 'Control.Concurrent.MVar.takeMVar' was not interruptible,
+then this particular
+combination could lead to deadlock, because the thread itself would be
+blocked in a state where it can\'t receive any asynchronous exceptions.
+With 'Control.Concurrent.MVar.takeMVar' interruptible, however, we can be
+safe in the knowledge that the thread can receive exceptions right up
+until the point when the 'Control.Concurrent.MVar.takeMVar' succeeds.
+Similar arguments apply for other interruptible operations like
+'System.IO.openFile'.
+
+It is useful to think of 'mask' not as a way to completely prevent
+asynchronous exceptions, but as a way to switch from asynchronous mode
+to polling mode.  The main difficulty with asynchronous
+exceptions is that they normally can occur anywhere, but within a
+'mask' an asynchronous exception is only raised by operations that are
+interruptible (or call other interruptible operations).  In many cases
+these operations may themselves raise exceptions, such as I\/O errors,
+so the caller will usually be prepared to handle exceptions arising from the
+operation anyway.  To perfom an explicit poll for asynchronous exceptions
+inside 'mask', use 'allowInterrupt'.
+
+Sometimes it is too onerous to handle exceptions in the middle of a
+critical piece of stateful code.  There are three ways to handle this
+kind of situation:
+
+ * Use STM.  Since a transaction is always either completely executed
+   or not at all, transactions are a good way to maintain invariants
+   over state in the presence of asynchronous (and indeed synchronous)
+   exceptions.
+
+ * Use 'mask', and avoid interruptible operations.  In order to do
+   this, we have to know which operations are interruptible.  It is
+   impossible to know for any given library function whether it might
+   invoke an interruptible operation internally; so instead we give a
+   list of guaranteed-not-to-be-interruptible operations below.
+
+ * Use 'uninterruptibleMask'.  This is generally not recommended,
+   unless you can guarantee that any interruptible operations invoked
+   during the scope of 'uninterruptibleMask' can only ever block for
+   a short time.  Otherwise, 'uninterruptibleMask' is a good way to
+   make your program deadlock and be unresponsive to user interrupts.
+
+The following operations are guaranteed not to be interruptible:
+
+ * operations on 'IORef' from "Data.IORef"
+
+ * STM transactions that do not use 'retry'
+
+ * everything from the @Foreign@ modules
+
+ * everything from @Control.Exception@ except for 'throwTo'
+
+ * @tryTakeMVar@, @tryPutMVar@, @isEmptyMVar@
+
+ * @takeMVar@ if the @MVar@ is definitely full, and conversely @putMVar@ if the @MVar@ is definitely empty
+
+ * @newEmptyMVar@, @newMVar@
+
+ * @forkIO@, @forkIOUnmasked@, @myThreadId@
+
+-}
+
+{- $catchall
+
+It is possible to catch all exceptions, by using the type 'SomeException':
+
+> catch f (\e -> ... (e :: SomeException) ...)
+
+HOWEVER, this is normally not what you want to do!
+
+For example, suppose you want to read a file, but if it doesn't exist
+then continue as if it contained \"\".  You might be tempted to just
+catch all exceptions and return \"\" in the handler. However, this has
+all sorts of undesirable consequences.  For example, if the user
+presses control-C at just the right moment then the 'UserInterrupt'
+exception will be caught, and the program will continue running under
+the belief that the file contains \"\".  Similarly, if another thread
+tries to kill the thread reading the file then the 'ThreadKilled'
+exception will be ignored.
+
+Instead, you should only catch exactly the exceptions that you really
+want. In this case, this would likely be more specific than even
+\"any IO exception\"; a permissions error would likely also want to be
+handled differently. Instead, you would probably want something like:
+
+> e <- tryJust (guard . isDoesNotExistError) (readFile f)
+> let str = either (const "") id e
+
+There are occassions when you really do need to catch any sort of
+exception. However, in most cases this is just so you can do some
+cleaning up; you aren't actually interested in the exception itself.
+For example, if you open a file then you want to close it again,
+whether processing the file executes normally or throws an exception.
+However, in these cases you can use functions like 'bracket', 'finally'
+and 'onException', which never actually pass you the exception, but
+just call the cleanup functions at the appropriate points.
+
+But sometimes you really do need to catch any exception, and actually
+see what the exception is. One example is at the very top-level of a
+program, you may wish to catch any exception, print it to a logfile or
+the screen, and then exit gracefully. For these cases, you can use
+'catch' (or one of the other exception-catching functions) with the
+'SomeException' type.
+-}
+
diff --git a/libraries/base/Control/Exception/Base.hs b/libraries/base/Control/Exception/Base.hs
new file mode 100644
index 000000000000..8df4958cbb1d
--- /dev/null
+++ b/libraries/base/Control/Exception/Base.hs
@@ -0,0 +1,407 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE NoImplicitPrelude, MagicHash #-}
+{-# LANGUAGE AutoDeriveTypeable, StandaloneDeriving #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Control.Exception.Base
+-- Copyright   :  (c) The University of Glasgow 2001
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+-- 
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  experimental
+-- Portability :  non-portable (extended exceptions)
+--
+-- Extensible exceptions, except for multiple handlers.
+--
+-----------------------------------------------------------------------------
+
+module Control.Exception.Base (
+
+        -- * The Exception type
+        SomeException(..),
+        Exception(..),
+        IOException,
+        ArithException(..),
+        ArrayException(..),
+        AssertionFailed(..),
+        SomeAsyncException(..), AsyncException(..),
+        asyncExceptionToException, asyncExceptionFromException,
+        NonTermination(..),
+        NestedAtomically(..),
+        BlockedIndefinitelyOnMVar(..),
+        BlockedIndefinitelyOnSTM(..),
+        Deadlock(..),
+        NoMethodError(..),
+        PatternMatchFail(..),
+        RecConError(..),
+        RecSelError(..),
+        RecUpdError(..),
+        ErrorCall(..),
+
+        -- * Throwing exceptions
+        throwIO,
+        throw,
+        ioError,
+        throwTo,
+
+        -- * Catching Exceptions
+
+        -- ** The @catch@ functions
+        catch,
+        catchJust,
+
+        -- ** The @handle@ functions
+        handle,
+        handleJust,
+
+        -- ** The @try@ functions
+        try,
+        tryJust,
+        onException,
+
+        -- ** The @evaluate@ function
+        evaluate,
+
+        -- ** The @mapException@ function
+        mapException,
+
+        -- * Asynchronous Exceptions
+
+        -- ** Asynchronous exception control
+        mask,
+        mask_,
+        uninterruptibleMask,
+        uninterruptibleMask_,
+        MaskingState(..),
+        getMaskingState,
+
+        -- * Assertions
+
+        assert,
+
+        -- * Utilities
+
+        bracket,
+        bracket_,
+        bracketOnError,
+
+        finally,
+
+        -- * Calls for GHC runtime
+        recSelError, recConError, irrefutPatError, runtimeError,
+        nonExhaustiveGuardsError, patError, noMethodBindingError,
+        absentError,
+        nonTermination, nestedAtomically,
+  ) where
+
+import GHC.Base
+import GHC.IO hiding (bracket,finally,onException)
+import GHC.IO.Exception
+import GHC.Exception
+import GHC.Show
+-- import GHC.Exception hiding ( Exception )
+import GHC.Conc.Sync
+
+import Data.Dynamic
+import Data.Either
+import Data.Maybe
+
+-----------------------------------------------------------------------------
+-- Catching exceptions
+
+-- |This is the simplest of the exception-catching functions.  It
+-- takes a single argument, runs it, and if an exception is raised
+-- the \"handler\" is executed, with the value of the exception passed as an
+-- argument.  Otherwise, the result is returned as normal.  For example:
+--
+-- >   catch (readFile f)
+-- >         (\e -> do let err = show (e :: IOException)
+-- >                   hPutStr stderr ("Warning: Couldn't open " ++ f ++ ": " ++ err)
+-- >                   return "")
+--
+-- Note that we have to give a type signature to @e@, or the program
+-- will not typecheck as the type is ambiguous. While it is possible
+-- to catch exceptions of any type, see the section \"Catching all
+-- exceptions\" (in "Control.Exception") for an explanation of the problems with doing so.
+--
+-- For catching exceptions in pure (non-'IO') expressions, see the
+-- function 'evaluate'.
+--
+-- Note that due to Haskell\'s unspecified evaluation order, an
+-- expression may throw one of several possible exceptions: consider
+-- the expression @(error \"urk\") + (1 \`div\` 0)@.  Does
+-- the expression throw
+-- @ErrorCall \"urk\"@, or @DivideByZero@?
+--
+-- The answer is \"it might throw either\"; the choice is
+-- non-deterministic. If you are catching any type of exception then you
+-- might catch either. If you are calling @catch@ with type
+-- @IO Int -> (ArithException -> IO Int) -> IO Int@ then the handler may
+-- get run with @DivideByZero@ as an argument, or an @ErrorCall \"urk\"@
+-- exception may be propogated further up. If you call it again, you
+-- might get a the opposite behaviour. This is ok, because 'catch' is an
+-- 'IO' computation.
+--
+catch   :: Exception e
+        => IO a         -- ^ The computation to run
+        -> (e -> IO a)  -- ^ Handler to invoke if an exception is raised
+        -> IO a
+catch = catchException
+
+-- | The function 'catchJust' is like 'catch', but it takes an extra
+-- argument which is an /exception predicate/, a function which
+-- selects which type of exceptions we\'re interested in.
+--
+-- > catchJust (\e -> if isDoesNotExistErrorType (ioeGetErrorType e) then Just () else Nothing)
+-- >           (readFile f)
+-- >           (\_ -> do hPutStrLn stderr ("No such file: " ++ show f)
+-- >                     return "")
+--
+-- Any other exceptions which are not matched by the predicate
+-- are re-raised, and may be caught by an enclosing
+-- 'catch', 'catchJust', etc.
+catchJust
+        :: Exception e
+        => (e -> Maybe b)         -- ^ Predicate to select exceptions
+        -> IO a                   -- ^ Computation to run
+        -> (b -> IO a)            -- ^ Handler
+        -> IO a
+catchJust p a handler = catch a handler'
+  where handler' e = case p e of
+                        Nothing -> throwIO e
+                        Just b  -> handler b
+
+-- | A version of 'catch' with the arguments swapped around; useful in
+-- situations where the code for the handler is shorter.  For example:
+--
+-- >   do handle (\NonTermination -> exitWith (ExitFailure 1)) $
+-- >      ...
+handle     :: Exception e => (e -> IO a) -> IO a -> IO a
+handle     =  flip catch
+
+-- | A version of 'catchJust' with the arguments swapped around (see
+-- 'handle').
+handleJust :: Exception e => (e -> Maybe b) -> (b -> IO a) -> IO a -> IO a
+handleJust p =  flip (catchJust p)
+
+-----------------------------------------------------------------------------
+-- 'mapException'
+
+-- | This function maps one exception into another as proposed in the
+-- paper \"A semantics for imprecise exceptions\".
+
+-- Notice that the usage of 'unsafePerformIO' is safe here.
+
+mapException :: (Exception e1, Exception e2) => (e1 -> e2) -> a -> a
+mapException f v = unsafePerformIO (catch (evaluate v)
+                                          (\x -> throwIO (f x)))
+
+-----------------------------------------------------------------------------
+-- 'try' and variations.
+
+-- | Similar to 'catch', but returns an 'Either' result which is
+-- @('Right' a)@ if no exception of type @e@ was raised, or @('Left' ex)@
+-- if an exception of type @e@ was raised and its value is @ex@.
+-- If any other type of exception is raised than it will be propogated
+-- up to the next enclosing exception handler.
+--
+-- >  try a = catch (Right `liftM` a) (return . Left)
+
+try :: Exception e => IO a -> IO (Either e a)
+try a = catch (a >>= \ v -> return (Right v)) (\e -> return (Left e))
+
+-- | A variant of 'try' that takes an exception predicate to select
+-- which exceptions are caught (c.f. 'catchJust').  If the exception
+-- does not match the predicate, it is re-thrown.
+tryJust :: Exception e => (e -> Maybe b) -> IO a -> IO (Either b a)
+tryJust p a = do
+  r <- try a
+  case r of
+        Right v -> return (Right v)
+        Left  e -> case p e of
+                        Nothing -> throwIO e
+                        Just b  -> return (Left b)
+
+-- | Like 'finally', but only performs the final action if there was an
+-- exception raised by the computation.
+onException :: IO a -> IO b -> IO a
+onException io what = io `catch` \e -> do _ <- what
+                                          throwIO (e :: SomeException)
+
+-----------------------------------------------------------------------------
+-- Some Useful Functions
+
+-- | When you want to acquire a resource, do some work with it, and
+-- then release the resource, it is a good idea to use 'bracket',
+-- because 'bracket' will install the necessary exception handler to
+-- release the resource in the event that an exception is raised
+-- during the computation.  If an exception is raised, then 'bracket' will
+-- re-raise the exception (after performing the release).
+--
+-- A common example is opening a file:
+--
+-- > bracket
+-- >   (openFile "filename" ReadMode)
+-- >   (hClose)
+-- >   (\fileHandle -> do { ... })
+--
+-- The arguments to 'bracket' are in this order so that we can partially apply
+-- it, e.g.:
+--
+-- > withFile name mode = bracket (openFile name mode) hClose
+--
+bracket
+        :: IO a         -- ^ computation to run first (\"acquire resource\")
+        -> (a -> IO b)  -- ^ computation to run last (\"release resource\")
+        -> (a -> IO c)  -- ^ computation to run in-between
+        -> IO c         -- returns the value from the in-between computation
+bracket before after thing =
+  mask $ \restore -> do
+    a <- before
+    r <- restore (thing a) `onException` after a
+    _ <- after a
+    return r
+
+-- | A specialised variant of 'bracket' with just a computation to run
+-- afterward.
+--
+finally :: IO a         -- ^ computation to run first
+        -> IO b         -- ^ computation to run afterward (even if an exception
+                        -- was raised)
+        -> IO a         -- returns the value from the first computation
+a `finally` sequel =
+  mask $ \restore -> do
+    r <- restore a `onException` sequel
+    _ <- sequel
+    return r
+
+-- | A variant of 'bracket' where the return value from the first computation
+-- is not required.
+bracket_ :: IO a -> IO b -> IO c -> IO c
+bracket_ before after thing = bracket before (const after) (const thing)
+
+-- | Like 'bracket', but only performs the final action if there was an
+-- exception raised by the in-between computation.
+bracketOnError
+        :: IO a         -- ^ computation to run first (\"acquire resource\")
+        -> (a -> IO b)  -- ^ computation to run last (\"release resource\")
+        -> (a -> IO c)  -- ^ computation to run in-between
+        -> IO c         -- returns the value from the in-between computation
+bracketOnError before after thing =
+  mask $ \restore -> do
+    a <- before
+    restore (thing a) `onException` after a
+
+-----
+
+-- |A pattern match failed. The @String@ gives information about the
+-- source location of the pattern.
+data PatternMatchFail = PatternMatchFail String deriving Typeable
+
+instance Show PatternMatchFail where
+    showsPrec _ (PatternMatchFail err) = showString err
+
+instance Exception PatternMatchFail
+
+-----
+
+-- |A record selector was applied to a constructor without the
+-- appropriate field. This can only happen with a datatype with
+-- multiple constructors, where some fields are in one constructor
+-- but not another. The @String@ gives information about the source
+-- location of the record selector.
+data RecSelError = RecSelError String deriving Typeable
+
+instance Show RecSelError where
+    showsPrec _ (RecSelError err) = showString err
+
+instance Exception RecSelError
+
+-----
+
+-- |An uninitialised record field was used. The @String@ gives
+-- information about the source location where the record was
+-- constructed.
+data RecConError = RecConError String deriving Typeable
+
+instance Show RecConError where
+    showsPrec _ (RecConError err) = showString err
+
+instance Exception RecConError
+
+-----
+
+-- |A record update was performed on a constructor without the
+-- appropriate field. This can only happen with a datatype with
+-- multiple constructors, where some fields are in one constructor
+-- but not another. The @String@ gives information about the source
+-- location of the record update.
+data RecUpdError = RecUpdError String deriving Typeable
+
+instance Show RecUpdError where
+    showsPrec _ (RecUpdError err) = showString err
+
+instance Exception RecUpdError
+
+-----
+
+-- |A class method without a definition (neither a default definition,
+-- nor a definition in the appropriate instance) was called. The
+-- @String@ gives information about which method it was.
+data NoMethodError = NoMethodError String deriving Typeable
+
+instance Show NoMethodError where
+    showsPrec _ (NoMethodError err) = showString err
+
+instance Exception NoMethodError
+
+-----
+
+-- |Thrown when the runtime system detects that the computation is
+-- guaranteed not to terminate. Note that there is no guarantee that
+-- the runtime system will notice whether any given computation is
+-- guaranteed to terminate or not.
+data NonTermination = NonTermination deriving Typeable
+
+instance Show NonTermination where
+    showsPrec _ NonTermination = showString "<<loop>>"
+
+instance Exception NonTermination
+
+-----
+
+-- |Thrown when the program attempts to call @atomically@, from the @stm@
+-- package, inside another call to @atomically@.
+data NestedAtomically = NestedAtomically deriving Typeable
+
+instance Show NestedAtomically where
+    showsPrec _ NestedAtomically = showString "Control.Concurrent.STM.atomically was nested"
+
+instance Exception NestedAtomically
+
+-----
+
+recSelError, recConError, irrefutPatError, runtimeError,
+  nonExhaustiveGuardsError, patError, noMethodBindingError,
+  absentError
+        :: Addr# -> a   -- All take a UTF8-encoded C string
+
+recSelError              s = throw (RecSelError ("No match in record selector "
+			                         ++ unpackCStringUtf8# s))  -- No location info unfortunately
+runtimeError             s = error (unpackCStringUtf8# s)                   -- No location info unfortunately
+absentError              s = error ("Oops!  Entered absent arg " ++ unpackCStringUtf8# s)
+
+nonExhaustiveGuardsError s = throw (PatternMatchFail (untangle s "Non-exhaustive guards in"))
+irrefutPatError          s = throw (PatternMatchFail (untangle s "Irrefutable pattern failed for pattern"))
+recConError              s = throw (RecConError      (untangle s "Missing field in record construction"))
+noMethodBindingError     s = throw (NoMethodError    (untangle s "No instance nor default method for class operation"))
+patError                 s = throw (PatternMatchFail (untangle s "Non-exhaustive patterns in"))
+
+-- GHC's RTS calls this
+nonTermination :: SomeException
+nonTermination = toException NonTermination
+
+-- GHC's RTS calls this
+nestedAtomically :: SomeException
+nestedAtomically = toException NestedAtomically
diff --git a/libraries/base/Control/Monad.hs b/libraries/base/Control/Monad.hs
new file mode 100644
index 000000000000..00c1fdda37a7
--- /dev/null
+++ b/libraries/base/Control/Monad.hs
@@ -0,0 +1,367 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Control.Monad
+-- Copyright   :  (c) The University of Glasgow 2001
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+-- 
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  provisional
+-- Portability :  portable
+--
+-- The 'Functor', 'Monad' and 'MonadPlus' classes,
+-- with some useful operations on monads.
+
+module Control.Monad
+    (
+    -- * Functor and monad classes
+
+      Functor(fmap)
+    , Monad((>>=), (>>), return, fail)
+
+    , MonadPlus (
+          mzero
+        , mplus
+        )
+    -- * Functions
+
+    -- ** Naming conventions
+    -- $naming
+
+    -- ** Basic @Monad@ functions
+
+    , mapM
+    , mapM_
+    , forM
+    , forM_
+    , sequence
+    , sequence_
+    , (=<<)
+    , (>=>)
+    , (<=<)
+    , forever
+    , void
+
+    -- ** Generalisations of list functions
+
+    , join
+    , msum
+    , mfilter
+    , filterM
+    , mapAndUnzipM
+    , zipWithM
+    , zipWithM_
+    , foldM
+    , foldM_
+    , replicateM
+    , replicateM_
+
+    -- ** Conditional execution of monadic expressions
+
+    , guard
+    , when
+    , unless
+
+    -- ** Monadic lifting operators
+
+    , liftM
+    , liftM2
+    , liftM3
+    , liftM4
+    , liftM5
+
+    , ap
+
+    -- ** Strict monadic functions
+
+    , (<$!>)
+    ) where
+
+import Data.Maybe
+
+import GHC.List
+import GHC.Base
+
+infixr 1 =<<
+
+-- -----------------------------------------------------------------------------
+-- Prelude monad functions
+
+-- | Same as '>>=', but with the arguments interchanged.
+{-# SPECIALISE (=<<) :: (a -> [b]) -> [a] -> [b] #-}
+(=<<)           :: Monad m => (a -> m b) -> m a -> m b
+f =<< x         = x >>= f
+
+-- | Evaluate each action in the sequence from left to right,
+-- and collect the results.
+sequence       :: Monad m => [m a] -> m [a] 
+{-# INLINE sequence #-}
+sequence ms = foldr k (return []) ms
+            where
+              k m m' = do { x <- m; xs <- m'; return (x:xs) }
+
+-- | Evaluate each action in the sequence from left to right,
+-- and ignore the results.
+sequence_        :: Monad m => [m a] -> m () 
+{-# INLINE sequence_ #-}
+sequence_ ms     =  foldr (>>) (return ()) ms
+
+-- | @'mapM' f@ is equivalent to @'sequence' . 'map' f@.
+mapM            :: Monad m => (a -> m b) -> [a] -> m [b]
+{-# INLINE mapM #-}
+mapM f as       =  sequence (map f as)
+
+-- | @'mapM_' f@ is equivalent to @'sequence_' . 'map' f@.
+mapM_           :: Monad m => (a -> m b) -> [a] -> m ()
+{-# INLINE mapM_ #-}
+mapM_ f as      =  sequence_ (map f as)
+
+-- -----------------------------------------------------------------------------
+-- The MonadPlus class definition
+
+-- | Monads that also support choice and failure.
+class Monad m => MonadPlus m where
+   -- | the identity of 'mplus'.  It should also satisfy the equations
+   --
+   -- > mzero >>= f  =  mzero
+   -- > v >> mzero   =  mzero
+   --
+   mzero :: m a 
+   -- | an associative operation
+   mplus :: m a -> m a -> m a
+
+instance MonadPlus [] where
+   mzero = []
+   mplus = (++)
+
+instance MonadPlus Maybe where
+   mzero = Nothing
+
+   Nothing `mplus` ys  = ys
+   xs      `mplus` _ys = xs
+
+-- -----------------------------------------------------------------------------
+-- Functions mandated by the Prelude
+
+-- | @'guard' b@ is @'return' ()@ if @b@ is 'True',
+-- and 'mzero' if @b@ is 'False'.
+guard           :: (MonadPlus m) => Bool -> m ()
+guard True      =  return ()
+guard False     =  mzero
+
+-- | This generalizes the list-based 'filter' function.
+
+filterM          :: (Monad m) => (a -> m Bool) -> [a] -> m [a]
+filterM _ []     =  return []
+filterM p (x:xs) =  do
+   flg <- p x
+   ys  <- filterM p xs
+   return (if flg then x:ys else ys)
+
+-- | 'forM' is 'mapM' with its arguments flipped
+forM            :: Monad m => [a] -> (a -> m b) -> m [b]
+{-# INLINE forM #-}
+forM            = flip mapM
+
+-- | 'forM_' is 'mapM_' with its arguments flipped
+forM_           :: Monad m => [a] -> (a -> m b) -> m ()
+{-# INLINE forM_ #-}
+forM_           = flip mapM_
+
+-- | This generalizes the list-based 'concat' function.
+
+msum        :: MonadPlus m => [m a] -> m a
+{-# INLINE msum #-}
+msum        =  foldr mplus mzero
+
+infixr 1 <=<, >=>
+
+-- | Left-to-right Kleisli composition of monads.
+(>=>)       :: Monad m => (a -> m b) -> (b -> m c) -> (a -> m c)
+f >=> g     = \x -> f x >>= g
+
+-- | Right-to-left Kleisli composition of monads. @('>=>')@, with the arguments flipped
+(<=<)       :: Monad m => (b -> m c) -> (a -> m b) -> (a -> m c)
+(<=<)       = flip (>=>)
+
+-- | @'forever' act@ repeats the action infinitely.
+forever     :: (Monad m) => m a -> m b
+{-# INLINE forever #-}
+forever a   = let a' = a >> a' in a'
+-- Use explicit sharing here, as it is prevents a space leak regardless of
+-- optimizations.
+
+-- | @'void' value@ discards or ignores the result of evaluation, such as the return value of an 'IO' action.
+void :: Functor f => f a -> f ()
+void = fmap (const ())
+
+-- -----------------------------------------------------------------------------
+-- Other monad functions
+
+-- | The 'join' function is the conventional monad join operator. It is used to
+-- remove one level of monadic structure, projecting its bound argument into the
+-- outer level.
+join              :: (Monad m) => m (m a) -> m a
+join x            =  x >>= id
+
+-- | The 'mapAndUnzipM' function maps its first argument over a list, returning
+-- the result as a pair of lists. This function is mainly used with complicated
+-- data structures or a state-transforming monad.
+mapAndUnzipM      :: (Monad m) => (a -> m (b,c)) -> [a] -> m ([b], [c])
+mapAndUnzipM f xs =  sequence (map f xs) >>= return . unzip
+
+-- | The 'zipWithM' function generalizes 'zipWith' to arbitrary monads.
+zipWithM          :: (Monad m) => (a -> b -> m c) -> [a] -> [b] -> m [c]
+zipWithM f xs ys  =  sequence (zipWith f xs ys)
+
+-- | 'zipWithM_' is the extension of 'zipWithM' which ignores the final result.
+zipWithM_         :: (Monad m) => (a -> b -> m c) -> [a] -> [b] -> m ()
+zipWithM_ f xs ys =  sequence_ (zipWith f xs ys)
+
+{- | The 'foldM' function is analogous to 'foldl', except that its result is
+encapsulated in a monad. Note that 'foldM' works from left-to-right over
+the list arguments. This could be an issue where @('>>')@ and the `folded
+function' are not commutative.
+
+
+>       foldM f a1 [x1, x2, ..., xm]
+
+==  
+
+>       do
+>         a2 <- f a1 x1
+>         a3 <- f a2 x2
+>         ...
+>         f am xm
+
+If right-to-left evaluation is required, the input list should be reversed.
+-}
+
+foldM             :: (Monad m) => (a -> b -> m a) -> a -> [b] -> m a
+foldM _ a []      =  return a
+foldM f a (x:xs)  =  f a x >>= \fax -> foldM f fax xs
+
+-- | Like 'foldM', but discards the result.
+foldM_            :: (Monad m) => (a -> b -> m a) -> a -> [b] -> m ()
+foldM_ f a xs     = foldM f a xs >> return ()
+
+-- | @'replicateM' n act@ performs the action @n@ times,
+-- gathering the results.
+replicateM        :: (Monad m) => Int -> m a -> m [a]
+replicateM n x    = sequence (replicate n x)
+
+-- | Like 'replicateM', but discards the result.
+replicateM_       :: (Monad m) => Int -> m a -> m ()
+replicateM_ n x   = sequence_ (replicate n x)
+
+{- | Conditional execution of monadic expressions. For example, 
+
+>       when debug (putStr "Debugging\n")
+
+will output the string @Debugging\\n@ if the Boolean value @debug@ is 'True',
+and otherwise do nothing.
+-}
+
+when              :: (Monad m) => Bool -> m () -> m ()
+when p s          =  if p then s else return ()
+
+-- | The reverse of 'when'.
+
+unless            :: (Monad m) => Bool -> m () -> m ()
+unless p s        =  if p then return () else s
+
+-- | Promote a function to a monad.
+liftM   :: (Monad m) => (a1 -> r) -> m a1 -> m r
+liftM f m1              = do { x1 <- m1; return (f x1) }
+
+-- | Promote a function to a monad, scanning the monadic arguments from
+-- left to right.  For example,
+--
+-- >    liftM2 (+) [0,1] [0,2] = [0,2,1,3]
+-- >    liftM2 (+) (Just 1) Nothing = Nothing
+--
+liftM2  :: (Monad m) => (a1 -> a2 -> r) -> m a1 -> m a2 -> m r
+liftM2 f m1 m2          = do { x1 <- m1; x2 <- m2; return (f x1 x2) }
+
+-- | Promote a function to a monad, scanning the monadic arguments from
+-- left to right (cf. 'liftM2').
+liftM3  :: (Monad m) => (a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r
+liftM3 f m1 m2 m3       = do { x1 <- m1; x2 <- m2; x3 <- m3; return (f x1 x2 x3) }
+
+-- | Promote a function to a monad, scanning the monadic arguments from
+-- left to right (cf. 'liftM2').
+liftM4  :: (Monad m) => (a1 -> a2 -> a3 -> a4 -> r) -> m a1 -> m a2 -> m a3 -> m a4 -> m r
+liftM4 f m1 m2 m3 m4    = do { x1 <- m1; x2 <- m2; x3 <- m3; x4 <- m4; return (f x1 x2 x3 x4) }
+
+-- | Promote a function to a monad, scanning the monadic arguments from
+-- left to right (cf. 'liftM2').
+liftM5  :: (Monad m) => (a1 -> a2 -> a3 -> a4 -> a5 -> r) -> m a1 -> m a2 -> m a3 -> m a4 -> m a5 -> m r
+liftM5 f m1 m2 m3 m4 m5 = do { x1 <- m1; x2 <- m2; x3 <- m3; x4 <- m4; x5 <- m5; return (f x1 x2 x3 x4 x5) }
+
+{- | In many situations, the 'liftM' operations can be replaced by uses of
+'ap', which promotes function application. 
+
+>       return f `ap` x1 `ap` ... `ap` xn
+
+is equivalent to 
+
+>       liftMn f x1 x2 ... xn
+
+-}
+
+ap                :: (Monad m) => m (a -> b) -> m a -> m b
+ap                =  liftM2 id
+
+infixl 4 <$!>
+
+-- | Strict version of 'Data.Functor.<$>'.
+--
+-- /Since: 4.7.1.0/
+(<$!>) :: Monad m => (a -> b) -> m a -> m b
+{-# INLINE (<$!>) #-}
+f <$!> m = do
+  x <- m
+  let z = f x
+  z `seq` return z
+
+
+-- -----------------------------------------------------------------------------
+-- Other MonadPlus functions
+
+-- | Direct 'MonadPlus' equivalent of 'filter'
+-- @'filter'@ = @(mfilter:: (a -> Bool) -> [a] -> [a]@
+-- applicable to any 'MonadPlus', for example
+-- @mfilter odd (Just 1) == Just 1@
+-- @mfilter odd (Just 2) == Nothing@
+
+mfilter :: (MonadPlus m) => (a -> Bool) -> m a -> m a
+mfilter p ma = do
+  a <- ma
+  if p a then return a else mzero
+
+{- $naming
+
+The functions in this library use the following naming conventions: 
+
+* A postfix \'@M@\' always stands for a function in the Kleisli category:
+  The monad type constructor @m@ is added to function results
+  (modulo currying) and nowhere else.  So, for example, 
+
+>  filter  ::              (a ->   Bool) -> [a] ->   [a]
+>  filterM :: (Monad m) => (a -> m Bool) -> [a] -> m [a]
+
+* A postfix \'@_@\' changes the result type from @(m a)@ to @(m ())@.
+  Thus, for example: 
+
+>  sequence  :: Monad m => [m a] -> m [a] 
+>  sequence_ :: Monad m => [m a] -> m () 
+
+* A prefix \'@m@\' generalizes an existing function to a monadic form.
+  Thus, for example: 
+
+>  sum  :: Num a       => [a]   -> a
+>  msum :: MonadPlus m => [m a] -> m a
+
+-}
diff --git a/libraries/base/Control/Monad/Fix.hs b/libraries/base/Control/Monad/Fix.hs
new file mode 100644
index 000000000000..8036fefcd1a6
--- /dev/null
+++ b/libraries/base/Control/Monad/Fix.hs
@@ -0,0 +1,79 @@
+{-# LANGUAGE Trustworthy #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Control.Monad.Fix
+-- Copyright   :  (c) Andy Gill 2001,
+--                (c) Oregon Graduate Institute of Science and Technology, 2002
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  experimental
+-- Portability :  portable
+--
+-- Monadic fixpoints.
+--
+-- For a detailed discussion, see Levent Erkok's thesis,
+-- /Value Recursion in Monadic Computations/, Oregon Graduate Institute, 2002.
+--
+-----------------------------------------------------------------------------
+
+module Control.Monad.Fix (
+        MonadFix(mfix),
+        fix
+  ) where
+
+import Prelude
+import System.IO
+import Data.Function (fix)
+import GHC.ST
+
+-- | Monads having fixed points with a \'knot-tying\' semantics.
+-- Instances of 'MonadFix' should satisfy the following laws:
+--
+-- [/purity/]
+--      @'mfix' ('return' . h)  =  'return' ('fix' h)@
+--
+-- [/left shrinking/ (or /tightening/)]
+--      @'mfix' (\\x -> a >>= \\y -> f x y)  =  a >>= \\y -> 'mfix' (\\x -> f x y)@
+--
+-- [/sliding/]
+--      @'mfix' ('Control.Monad.liftM' h . f)  =  'Control.Monad.liftM' h ('mfix' (f . h))@,
+--      for strict @h@.
+--
+-- [/nesting/]
+--      @'mfix' (\\x -> 'mfix' (\\y -> f x y))  =  'mfix' (\\x -> f x x)@
+--
+-- This class is used in the translation of the recursive @do@ notation
+-- supported by GHC and Hugs.
+class (Monad m) => MonadFix m where
+        -- | The fixed point of a monadic computation.
+        -- @'mfix' f@ executes the action @f@ only once, with the eventual
+        -- output fed back as the input.  Hence @f@ should not be strict,
+        -- for then @'mfix' f@ would diverge.
+        mfix :: (a -> m a) -> m a
+
+-- Instances of MonadFix for Prelude monads
+
+instance MonadFix Maybe where
+    mfix f = let a = f (unJust a) in a
+             where unJust (Just x) = x
+                   unJust Nothing  = error "mfix Maybe: Nothing"
+
+instance MonadFix [] where
+    mfix f = case fix (f . head) of
+               []    -> []
+               (x:_) -> x : mfix (tail . f)
+
+instance MonadFix IO where
+    mfix = fixIO 
+
+instance MonadFix ((->) r) where
+    mfix f = \ r -> let a = f a r in a
+
+instance MonadFix (Either e) where
+    mfix f = let a = f (unRight a) in a
+             where unRight (Right x) = x
+                   unRight (Left  _) = error "mfix Either: Left"
+
+instance MonadFix (ST s) where
+        mfix = fixST
diff --git a/libraries/base/Control/Monad/Instances.hs b/libraries/base/Control/Monad/Instances.hs
new file mode 100644
index 000000000000..687d33c4b8a7
--- /dev/null
+++ b/libraries/base/Control/Monad/Instances.hs
@@ -0,0 +1,21 @@
+{-# LANGUAGE Safe #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Control.Monad.Instances
+-- Copyright   :  (c) The University of Glasgow 2001
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+--
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  provisional
+-- Portability :  portable
+--
+-- /This module is DEPRECATED and will be removed in the future!/
+--
+-- 'Functor' and 'Monad' instances for @(->) r@ and
+-- 'Functor' instances for @(,) a@ and @'Either' a@.
+
+module Control.Monad.Instances {-# DEPRECATED "This module now contains no instances and will be removed in the future" #-} -- deprecated in 7.8
+    (Functor(..),Monad(..)) where
+
+import Prelude
diff --git a/libraries/base/Control/Monad/ST.hs b/libraries/base/Control/Monad/ST.hs
new file mode 100644
index 000000000000..0d2f58b16bff
--- /dev/null
+++ b/libraries/base/Control/Monad/ST.hs
@@ -0,0 +1,35 @@
+{-# LANGUAGE Unsafe #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Control.Monad.ST
+-- Copyright   :  (c) The University of Glasgow 2001
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+--
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  experimental
+-- Portability :  non-portable (requires universal quantification for runST)
+--
+-- This library provides support for /strict/ state threads, as
+-- described in the PLDI \'94 paper by John Launchbury and Simon Peyton
+-- Jones /Lazy Functional State Threads/.
+--
+-- References (variables) that can be used within the @ST@ monad are
+-- provided by "Data.STRef", and arrays are provided by
+-- "Data.Array.ST".
+
+-----------------------------------------------------------------------------
+
+module Control.Monad.ST (
+        -- * The 'ST' Monad
+        ST,             -- abstract, instance of Functor, Monad, Typeable.
+        runST,
+        fixST,
+
+        -- * Converting 'ST' to 'IO'
+        RealWorld,              -- abstract
+        stToIO,
+    ) where
+
+import Control.Monad.ST.Safe
+
diff --git a/libraries/base/Control/Monad/ST/Imp.hs b/libraries/base/Control/Monad/ST/Imp.hs
new file mode 100644
index 000000000000..984970fc7268
--- /dev/null
+++ b/libraries/base/Control/Monad/ST/Imp.hs
@@ -0,0 +1,38 @@
+{-# LANGUAGE Unsafe #-}
+{-# OPTIONS_HADDOCK hide #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Control.Monad.ST.Imp
+-- Copyright   :  (c) The University of Glasgow 2001
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+-- 
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  experimental
+-- Portability :  non-portable (requires universal quantification for runST)
+--
+-- This library provides support for /strict/ state threads, as
+-- described in the PLDI \'94 paper by John Launchbury and Simon Peyton
+-- Jones /Lazy Functional State Threads/.
+--
+-----------------------------------------------------------------------------
+
+module Control.Monad.ST.Imp (
+        -- * The 'ST' Monad
+        ST,             -- abstract, instance of Functor, Monad, Typeable.
+        runST,
+        fixST,
+
+        -- * Converting 'ST' to 'IO'
+        RealWorld,              -- abstract
+        stToIO,
+
+        -- * Unsafe operations
+        unsafeInterleaveST,
+        unsafeIOToST,
+        unsafeSTToIO
+    ) where
+
+import GHC.ST           ( ST, runST, fixST, unsafeInterleaveST )
+import GHC.Base         ( RealWorld )
+import GHC.IO           ( stToIO, unsafeIOToST, unsafeSTToIO )
diff --git a/libraries/base/Control/Monad/ST/Lazy.hs b/libraries/base/Control/Monad/ST/Lazy.hs
new file mode 100644
index 000000000000..c21272812d09
--- /dev/null
+++ b/libraries/base/Control/Monad/ST/Lazy.hs
@@ -0,0 +1,34 @@
+{-# LANGUAGE Unsafe #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Control.Monad.ST.Lazy
+-- Copyright   :  (c) The University of Glasgow 2001
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+-- 
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  provisional
+-- Portability :  non-portable (requires universal quantification for runST)
+--
+-- This module presents an identical interface to "Control.Monad.ST",
+-- except that the monad delays evaluation of state operations until
+-- a value depending on them is required.
+--
+-----------------------------------------------------------------------------
+
+module Control.Monad.ST.Lazy (
+        -- * The 'ST' monad
+        ST,
+        runST,
+        fixST,
+
+        -- * Converting between strict and lazy 'ST'
+        strictToLazyST, lazyToStrictST,
+
+        -- * Converting 'ST' To 'IO'
+        RealWorld,
+        stToIO,
+    ) where
+
+import Control.Monad.ST.Lazy.Safe
+
diff --git a/libraries/base/Control/Monad/ST/Lazy/Imp.hs b/libraries/base/Control/Monad/ST/Lazy/Imp.hs
new file mode 100644
index 000000000000..19e8974807c8
--- /dev/null
+++ b/libraries/base/Control/Monad/ST/Lazy/Imp.hs
@@ -0,0 +1,149 @@
+{-# LANGUAGE Unsafe #-}
+{-# LANGUAGE MagicHash, UnboxedTuples, RankNTypes #-}
+{-# OPTIONS_HADDOCK hide #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Control.Monad.ST.Lazy.Imp
+-- Copyright   :  (c) The University of Glasgow 2001
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+-- 
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  provisional
+-- Portability :  non-portable (requires universal quantification for runST)
+--
+-- This module presents an identical interface to "Control.Monad.ST",
+-- except that the monad delays evaluation of state operations until
+-- a value depending on them is required.
+--
+-----------------------------------------------------------------------------
+
+module Control.Monad.ST.Lazy.Imp (
+        -- * The 'ST' monad
+        ST,
+        runST,
+        fixST,
+
+        -- * Converting between strict and lazy 'ST'
+        strictToLazyST, lazyToStrictST,
+
+        -- * Converting 'ST' To 'IO'
+        RealWorld,
+        stToIO,
+
+        -- * Unsafe operations
+        unsafeInterleaveST,
+        unsafeIOToST
+    ) where
+
+import Prelude
+
+import Control.Monad.Fix
+
+import qualified Control.Monad.ST.Safe as ST
+import qualified Control.Monad.ST.Unsafe as ST
+
+import qualified GHC.ST as GHC.ST
+import GHC.Base
+
+-- | The lazy state-transformer monad.
+-- A computation of type @'ST' s a@ transforms an internal state indexed
+-- by @s@, and returns a value of type @a@.
+-- The @s@ parameter is either
+--
+-- * an unstantiated type variable (inside invocations of 'runST'), or
+--
+-- * 'RealWorld' (inside invocations of 'stToIO').
+--
+-- It serves to keep the internal states of different invocations of
+-- 'runST' separate from each other and from invocations of 'stToIO'.
+--
+-- The '>>=' and '>>' operations are not strict in the state.  For example,
+--
+-- @'runST' (writeSTRef _|_ v >>= readSTRef _|_ >> return 2) = 2@
+newtype ST s a = ST (State s -> (a, State s))
+data State s = S# (State# s)
+
+instance Functor (ST s) where
+    fmap f m = ST $ \ s ->
+      let 
+       ST m_a = m
+       (r,new_s) = m_a s
+      in
+      (f r,new_s)
+
+instance Monad (ST s) where
+
+        return a = ST $ \ s -> (a,s)
+        m >> k   =  m >>= \ _ -> k
+        fail s   = error s
+
+        (ST m) >>= k
+         = ST $ \ s ->
+           let
+             (r,new_s) = m s
+             ST k_a = k r
+           in
+           k_a new_s
+
+{-# NOINLINE runST #-}
+-- | Return the value computed by a state transformer computation.
+-- The @forall@ ensures that the internal state used by the 'ST'
+-- computation is inaccessible to the rest of the program.
+runST :: (forall s. ST s a) -> a
+runST st = case st of ST the_st -> let (r,_) = the_st (S# realWorld#) in r
+
+-- | Allow the result of a state transformer computation to be used (lazily)
+-- inside the computation.
+-- Note that if @f@ is strict, @'fixST' f = _|_@.
+fixST :: (a -> ST s a) -> ST s a
+fixST m = ST (\ s -> 
+                let 
+                   ST m_r = m r
+                   (r,s') = m_r s
+                in
+                   (r,s'))
+
+instance MonadFix (ST s) where
+        mfix = fixST
+
+-- ---------------------------------------------------------------------------
+-- Strict <--> Lazy
+
+{-|
+Convert a strict 'ST' computation into a lazy one.  The strict state
+thread passed to 'strictToLazyST' is not performed until the result of
+the lazy state thread it returns is demanded.
+-}
+strictToLazyST :: ST.ST s a -> ST s a
+strictToLazyST m = ST $ \s ->
+        let 
+           pr = case s of { S# s# -> GHC.ST.liftST m s# }
+           r  = case pr of { GHC.ST.STret _ v -> v }
+           s' = case pr of { GHC.ST.STret s2# _ -> S# s2# }
+        in
+        (r, s')
+
+{-| 
+Convert a lazy 'ST' computation into a strict one.
+-}
+lazyToStrictST :: ST s a -> ST.ST s a
+lazyToStrictST (ST m) = GHC.ST.ST $ \s ->
+        case (m (S# s)) of (a, S# s') -> (# s', a #)
+
+-- | A monad transformer embedding lazy state transformers in the 'IO'
+-- monad.  The 'RealWorld' parameter indicates that the internal state
+-- used by the 'ST' computation is a special one supplied by the 'IO'
+-- monad, and thus distinct from those used by invocations of 'runST'.
+stToIO :: ST RealWorld a -> IO a
+stToIO = ST.stToIO . lazyToStrictST
+
+-- ---------------------------------------------------------------------------
+-- Strict <--> Lazy
+
+unsafeInterleaveST :: ST s a -> ST s a
+unsafeInterleaveST = strictToLazyST . ST.unsafeInterleaveST . lazyToStrictST
+
+unsafeIOToST :: IO a -> ST s a
+unsafeIOToST = strictToLazyST . ST.unsafeIOToST
+
diff --git a/libraries/base/Control/Monad/ST/Lazy/Safe.hs b/libraries/base/Control/Monad/ST/Lazy/Safe.hs
new file mode 100644
index 000000000000..387313f287e0
--- /dev/null
+++ b/libraries/base/Control/Monad/ST/Lazy/Safe.hs
@@ -0,0 +1,36 @@
+{-# LANGUAGE Trustworthy #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Control.Monad.ST.Lazy.Safe
+-- Copyright   :  (c) The University of Glasgow 2001
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+--
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  provisional
+-- Portability :  non-portable (requires universal quantification for runST)
+--
+-- This module presents an identical interface to "Control.Monad.ST",
+-- except that the monad delays evaluation of state operations until
+-- a value depending on them is required.
+--
+-- Safe API only.
+--
+-----------------------------------------------------------------------------
+
+module Control.Monad.ST.Lazy.Safe (
+        -- * The 'ST' monad
+        ST,
+        runST,
+        fixST,
+
+        -- * Converting between strict and lazy 'ST'
+        strictToLazyST, lazyToStrictST,
+
+        -- * Converting 'ST' To 'IO'
+        RealWorld,
+        stToIO,
+    ) where
+
+import Control.Monad.ST.Lazy.Imp
+
diff --git a/libraries/base/Control/Monad/ST/Lazy/Unsafe.hs b/libraries/base/Control/Monad/ST/Lazy/Unsafe.hs
new file mode 100644
index 000000000000..4a1b8c79a639
--- /dev/null
+++ b/libraries/base/Control/Monad/ST/Lazy/Unsafe.hs
@@ -0,0 +1,28 @@
+{-# LANGUAGE Unsafe #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Control.Monad.ST.Lazy.Unsafe
+-- Copyright   :  (c) The University of Glasgow 2001
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+--
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  provisional
+-- Portability :  non-portable (requires universal quantification for runST)
+--
+-- This module presents an identical interface to "Control.Monad.ST",
+-- except that the monad delays evaluation of state operations until
+-- a value depending on them is required.
+--
+-- Unsafe API.
+--
+-----------------------------------------------------------------------------
+
+module Control.Monad.ST.Lazy.Unsafe (
+        -- * Unsafe operations
+        unsafeInterleaveST,
+        unsafeIOToST
+    ) where
+
+import Control.Monad.ST.Lazy.Imp
+
diff --git a/libraries/base/Control/Monad/ST/Safe.hs b/libraries/base/Control/Monad/ST/Safe.hs
new file mode 100644
index 000000000000..1e9c98189529
--- /dev/null
+++ b/libraries/base/Control/Monad/ST/Safe.hs
@@ -0,0 +1,33 @@
+{-# LANGUAGE Trustworthy #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Control.Monad.ST.Safe
+-- Copyright   :  (c) The University of Glasgow 2001
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+--
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  experimental
+-- Portability :  non-portable (requires universal quantification for runST)
+--
+-- This library provides support for /strict/ state threads, as
+-- described in the PLDI \'94 paper by John Launchbury and Simon Peyton
+-- Jones /Lazy Functional State Threads/.
+--
+-- Safe API Only.
+--
+-----------------------------------------------------------------------------
+
+module Control.Monad.ST.Safe (
+        -- * The 'ST' Monad
+        ST,             -- abstract
+        runST,
+        fixST,
+
+        -- * Converting 'ST' to 'IO'
+        RealWorld,              -- abstract
+        stToIO,
+    ) where
+
+import Control.Monad.ST.Imp
+
diff --git a/libraries/base/Control/Monad/ST/Strict.hs b/libraries/base/Control/Monad/ST/Strict.hs
new file mode 100644
index 000000000000..4e474d95ae04
--- /dev/null
+++ b/libraries/base/Control/Monad/ST/Strict.hs
@@ -0,0 +1,20 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Control.Monad.ST.Strict
+-- Copyright   :  (c) The University of Glasgow 2001
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+--
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  provisional
+-- Portability :  non-portable (requires universal quantification for runST)
+--
+-- The strict ST monad (re-export of "Control.Monad.ST")
+--
+-----------------------------------------------------------------------------
+
+module Control.Monad.ST.Strict (
+        module Control.Monad.ST
+  ) where
+
+import Control.Monad.ST
+
diff --git a/libraries/base/Control/Monad/ST/Unsafe.hs b/libraries/base/Control/Monad/ST/Unsafe.hs
new file mode 100644
index 000000000000..9fa4b739b1a2
--- /dev/null
+++ b/libraries/base/Control/Monad/ST/Unsafe.hs
@@ -0,0 +1,29 @@
+{-# LANGUAGE Unsafe #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Control.Monad.ST.Unsafe
+-- Copyright   :  (c) The University of Glasgow 2001
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+--
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  experimental
+-- Portability :  non-portable (requires universal quantification for runST)
+--
+-- This library provides support for /strict/ state threads, as
+-- described in the PLDI \'94 paper by John Launchbury and Simon Peyton
+-- Jones /Lazy Functional State Threads/.
+--
+-- Unsafe API.
+--
+-----------------------------------------------------------------------------
+
+module Control.Monad.ST.Unsafe (
+        -- * Unsafe operations
+        unsafeInterleaveST,
+        unsafeIOToST,
+        unsafeSTToIO
+    ) where
+
+import Control.Monad.ST.Imp
+
diff --git a/libraries/base/Control/Monad/Zip.hs b/libraries/base/Control/Monad/Zip.hs
new file mode 100644
index 000000000000..ec13eedf2337
--- /dev/null
+++ b/libraries/base/Control/Monad/Zip.hs
@@ -0,0 +1,56 @@
+{-# LANGUAGE Safe #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Control.Monad.Zip
+-- Copyright   :  (c) Nils Schweinsberg 2011,
+--                (c) George Giorgidze 2011
+--                (c) University Tuebingen 2011
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  experimental
+-- Portability :  portable
+--
+-- Monadic zipping (used for monad comprehensions)
+--
+-----------------------------------------------------------------------------
+
+module Control.Monad.Zip where
+
+import Prelude
+import Control.Monad (liftM)
+
+-- | `MonadZip` type class. Minimal definition: `mzip` or `mzipWith`
+--
+-- Instances should satisfy the laws:
+--
+-- * Naturality :
+--
+--   > liftM (f *** g) (mzip ma mb) = mzip (liftM f ma) (liftM g mb)
+--
+-- * Information Preservation:
+--
+--   > liftM (const ()) ma = liftM (const ()) mb
+--   > ==>
+--   > munzip (mzip ma mb) = (ma, mb)
+--
+class Monad m => MonadZip m where
+
+    mzip :: m a -> m b -> m (a,b)
+    mzip = mzipWith (,)
+
+    mzipWith :: (a -> b -> c) -> m a -> m b -> m c
+    mzipWith f ma mb = liftM (uncurry f) (mzip ma mb)
+
+    munzip :: m (a,b) -> (m a, m b)
+    munzip mab = (liftM fst mab, liftM snd mab)
+    -- munzip is a member of the class because sometimes
+    -- you can implement it more efficiently than the
+    -- above default code.  See Trac #4370 comment by giorgidze
+    {-# MINIMAL mzip | mzipWith #-}
+
+instance MonadZip [] where
+    mzip     = zip
+    mzipWith = zipWith
+    munzip   = unzip
+
diff --git a/libraries/base/Data/Bits.hs b/libraries/base/Data/Bits.hs
new file mode 100644
index 000000000000..81b180bb7ef7
--- /dev/null
+++ b/libraries/base/Data/Bits.hs
@@ -0,0 +1,479 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE CPP, NoImplicitPrelude, BangPatterns, MagicHash #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.Bits
+-- Copyright   :  (c) The University of Glasgow 2001
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+--
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  experimental
+-- Portability :  portable
+--
+-- This module defines bitwise operations for signed and unsigned
+-- integers.  Instances of the class 'Bits' for the 'Int' and
+-- 'Integer' types are available from this module, and instances for
+-- explicitly sized integral types are available from the
+-- "Data.Int" and "Data.Word" modules.
+--
+-----------------------------------------------------------------------------
+
+module Data.Bits (
+  Bits(
+    (.&.), (.|.), xor,
+    complement,
+    shift,
+    rotate,
+    zeroBits,
+    bit,
+    setBit,
+    clearBit,
+    complementBit,
+    testBit,
+    bitSizeMaybe,
+    bitSize,
+    isSigned,
+    shiftL, shiftR,
+    unsafeShiftL, unsafeShiftR,
+    rotateL, rotateR,
+    popCount
+  ),
+  FiniteBits(finiteBitSize),
+
+  bitDefault,
+  testBitDefault,
+  popCountDefault
+ ) where
+
+-- Defines the @Bits@ class containing bit-based operations.
+-- See library document for details on the semantics of the
+-- individual operations.
+
+#include "MachDeps.h"
+
+import Data.Maybe
+import GHC.Enum
+import GHC.Num
+import GHC.Base
+
+infixl 8 `shift`, `rotate`, `shiftL`, `shiftR`, `rotateL`, `rotateR`
+infixl 7 .&.
+infixl 6 `xor`
+infixl 5 .|.
+
+{-# DEPRECATED bitSize "Use 'bitSizeMaybe' or 'finiteBitSize' instead" #-} -- deprecated in 7.8
+
+{-|
+The 'Bits' class defines bitwise operations over integral types.
+
+* Bits are numbered from 0 with bit 0 being the least
+  significant bit.
+
+Minimal complete definition: '.&.', '.|.', 'xor', 'complement',
+('shift' or ('shiftL' and 'shiftR')), ('rotate' or ('rotateL' and 'rotateR')),
+'bitSize', 'isSigned', 'testBit', 'bit', and 'popCount'.  The latter three can
+be implemented using `testBitDefault', 'bitDefault', and 'popCountDefault', if
+@a@ is also an instance of 'Num'.
+-}
+class Eq a => Bits a where
+    -- | Bitwise \"and\"
+    (.&.) :: a -> a -> a
+
+    -- | Bitwise \"or\"
+    (.|.) :: a -> a -> a
+
+    -- | Bitwise \"xor\"
+    xor :: a -> a -> a
+
+    {-| Reverse all the bits in the argument -}
+    complement        :: a -> a
+
+    {-| @'shift' x i@ shifts @x@ left by @i@ bits if @i@ is positive,
+        or right by @-i@ bits otherwise.
+        Right shifts perform sign extension on signed number types;
+        i.e. they fill the top bits with 1 if the @x@ is negative
+        and with 0 otherwise.
+
+        An instance can define either this unified 'shift' or 'shiftL' and
+        'shiftR', depending on which is more convenient for the type in
+        question. -}
+    shift             :: a -> Int -> a
+
+    x `shift`   i | i<0       = x `shiftR` (-i)
+                  | i>0       = x `shiftL` i
+                  | otherwise = x
+
+    {-| @'rotate' x i@ rotates @x@ left by @i@ bits if @i@ is positive,
+        or right by @-i@ bits otherwise.
+
+        For unbounded types like 'Integer', 'rotate' is equivalent to 'shift'.
+
+        An instance can define either this unified 'rotate' or 'rotateL' and
+        'rotateR', depending on which is more convenient for the type in
+        question. -}
+    rotate            :: a -> Int -> a
+
+    x `rotate`  i | i<0       = x `rotateR` (-i)
+                  | i>0       = x `rotateL` i
+                  | otherwise = x
+
+    {-
+    -- Rotation can be implemented in terms of two shifts, but care is
+    -- needed for negative values.  This suggested implementation assumes
+    -- 2's-complement arithmetic.  It is commented out because it would
+    -- require an extra context (Ord a) on the signature of 'rotate'.
+    x `rotate`  i | i<0 && isSigned x && x<0
+                         = let left = i+bitSize x in
+                           ((x `shift` i) .&. complement ((-1) `shift` left))
+                           .|. (x `shift` left)
+                  | i<0  = (x `shift` i) .|. (x `shift` (i+bitSize x))
+                  | i==0 = x
+                  | i>0  = (x `shift` i) .|. (x `shift` (i-bitSize x))
+    -}
+
+    -- | 'zeroBits' is the value with all bits unset.
+    --
+    -- The following laws ought to hold (for all valid bit indices @/n/@):
+    --
+    --   * @'clearBit' 'zeroBits' /n/ == 'zeroBits'@
+    --   * @'setBit'   'zeroBits' /n/ == 'bit' /n/@
+    --   * @'testBit'  'zeroBits' /n/ == False@
+    --   * @'popCount' 'zeroBits'   == 0@
+    --
+    -- This method uses @'clearBit' ('bit' 0) 0@ as its default
+    -- implementation (which ought to be equivalent to 'zeroBits' for
+    -- types which possess a 0th bit).
+    --
+    -- /Since: 4.7.0.0/
+    zeroBits :: a
+    zeroBits = clearBit (bit 0) 0
+
+    -- | @bit /i/@ is a value with the @/i/@th bit set and all other bits clear.
+    --
+    -- See also 'zeroBits'.
+    bit               :: Int -> a
+
+    -- | @x \`setBit\` i@ is the same as @x .|. bit i@
+    setBit            :: a -> Int -> a
+
+    -- | @x \`clearBit\` i@ is the same as @x .&. complement (bit i)@
+    clearBit          :: a -> Int -> a
+
+    -- | @x \`complementBit\` i@ is the same as @x \`xor\` bit i@
+    complementBit     :: a -> Int -> a
+
+    -- | Return 'True' if the @n@th bit of the argument is 1
+    testBit           :: a -> Int -> Bool
+
+    {-| Return the number of bits in the type of the argument.  The actual
+        value of the argument is ignored.  Returns Nothing
+        for types that do not have a fixed bitsize, like 'Integer'.
+
+        /Since: 4.7.0.0/
+        -}
+    bitSizeMaybe      :: a -> Maybe Int
+
+    {-| Return the number of bits in the type of the argument.  The actual
+        value of the argument is ignored.  The function 'bitSize' is
+        undefined for types that do not have a fixed bitsize, like 'Integer'.
+        -}
+    bitSize           :: a -> Int
+
+    {-| Return 'True' if the argument is a signed type.  The actual
+        value of the argument is ignored -}
+    isSigned          :: a -> Bool
+
+    {-# INLINE setBit #-}
+    {-# INLINE clearBit #-}
+    {-# INLINE complementBit #-}
+    x `setBit` i        = x .|. bit i
+    x `clearBit` i      = x .&. complement (bit i)
+    x `complementBit` i = x `xor` bit i
+
+    {-| Shift the argument left by the specified number of bits
+        (which must be non-negative).
+
+        An instance can define either this and 'shiftR' or the unified
+        'shift', depending on which is more convenient for the type in
+        question. -}
+    shiftL            :: a -> Int -> a
+    {-# INLINE shiftL #-}
+    x `shiftL`  i = x `shift`  i
+
+    {-| Shift the argument left by the specified number of bits.  The
+        result is undefined for negative shift amounts and shift amounts
+        greater or equal to the 'bitSize'.
+
+        Defaults to 'shiftL' unless defined explicitly by an instance.
+
+        /Since: 4.5.0.0/ -}
+    unsafeShiftL            :: a -> Int -> a
+    {-# INLINE unsafeShiftL #-}
+    x `unsafeShiftL` i = x `shiftL` i
+
+    {-| Shift the first argument right by the specified number of bits. The
+        result is undefined for negative shift amounts and shift amounts
+        greater or equal to the 'bitSize'.
+
+        Right shifts perform sign extension on signed number types;
+        i.e. they fill the top bits with 1 if the @x@ is negative
+        and with 0 otherwise.
+
+        An instance can define either this and 'shiftL' or the unified
+        'shift', depending on which is more convenient for the type in
+        question. -}
+    shiftR            :: a -> Int -> a
+    {-# INLINE shiftR #-}
+    x `shiftR`  i = x `shift`  (-i)
+
+    {-| Shift the first argument right by the specified number of bits, which
+        must be non-negative an smaller than the number of bits in the type.
+
+        Right shifts perform sign extension on signed number types;
+        i.e. they fill the top bits with 1 if the @x@ is negative
+        and with 0 otherwise.
+
+        Defaults to 'shiftR' unless defined explicitly by an instance.
+
+        /Since: 4.5.0.0/ -}
+    unsafeShiftR            :: a -> Int -> a
+    {-# INLINE unsafeShiftR #-}
+    x `unsafeShiftR` i = x `shiftR` i
+
+    {-| Rotate the argument left by the specified number of bits
+        (which must be non-negative).
+
+        An instance can define either this and 'rotateR' or the unified
+        'rotate', depending on which is more convenient for the type in
+        question. -}
+    rotateL           :: a -> Int -> a
+    {-# INLINE rotateL #-}
+    x `rotateL` i = x `rotate` i
+
+    {-| Rotate the argument right by the specified number of bits
+        (which must be non-negative).
+
+        An instance can define either this and 'rotateL' or the unified
+        'rotate', depending on which is more convenient for the type in
+        question. -}
+    rotateR           :: a -> Int -> a
+    {-# INLINE rotateR #-}
+    x `rotateR` i = x `rotate` (-i)
+
+    {-| Return the number of set bits in the argument.  This number is
+        known as the population count or the Hamming weight.
+
+        /Since: 4.5.0.0/ -}
+    popCount          :: a -> Int
+
+    {-# MINIMAL (.&.), (.|.), xor, complement,
+                (shift | (shiftL, shiftR)),
+                (rotate | (rotateL, rotateR)),
+                bitSize, bitSizeMaybe, isSigned, testBit, bit, popCount #-}
+
+-- |The 'FiniteBits' class denotes types with a finite, fixed number of bits.
+--
+-- /Since: 4.7.0.0/
+class Bits b => FiniteBits b where
+    -- | Return the number of bits in the type of the argument.
+    -- The actual value of the argument is ignored. Moreover, 'finiteBitSize'
+    -- is total, in contrast to the deprecated 'bitSize' function it replaces.
+    --
+    -- @
+    -- 'finiteBitSize' = 'bitSize'
+    -- 'bitSizeMaybe' = 'Just' . 'finiteBitSize'
+    -- @
+    --
+    -- /Since: 4.7.0.0/
+    finiteBitSize :: b -> Int
+
+-- The defaults below are written with lambdas so that e.g.
+--     bit = bitDefault
+-- is fully applied, so inlining will happen
+
+-- | Default implementation for 'bit'.
+--
+-- Note that: @bitDefault i = 1 `shiftL` i@
+--
+-- /Since: 4.6.0.0/
+bitDefault :: (Bits a, Num a) => Int -> a
+bitDefault = \i -> 1 `shiftL` i
+{-# INLINE bitDefault #-}
+
+-- | Default implementation for 'testBit'.
+--
+-- Note that: @testBitDefault x i = (x .&. bit i) /= 0@
+--
+-- /Since: 4.6.0.0/
+testBitDefault ::  (Bits a, Num a) => a -> Int -> Bool
+testBitDefault = \x i -> (x .&. bit i) /= 0
+{-# INLINE testBitDefault #-}
+
+-- | Default implementation for 'popCount'.
+--
+-- This implementation is intentionally naive. Instances are expected to provide
+-- an optimized implementation for their size.
+--
+-- /Since: 4.6.0.0/
+popCountDefault :: (Bits a, Num a) => a -> Int
+popCountDefault = go 0
+ where
+   go !c 0 = c
+   go c w = go (c+1) (w .&. (w - 1)) -- clear the least significant
+{-# INLINABLE popCountDefault #-}
+
+
+-- Interpret 'Bool' as 1-bit bit-field; /Since: 4.7.0.0/
+instance Bits Bool where
+    (.&.) = (&&)
+
+    (.|.) = (||)
+
+    xor = (/=)
+
+    complement = not
+
+    shift x 0 = x
+    shift _ _ = False
+
+    rotate x _ = x
+
+    bit 0 = True
+    bit _ = False
+
+    testBit x 0 = x
+    testBit _ _ = False
+
+    bitSizeMaybe _ = Just 1
+
+    bitSize _ = 1
+
+    isSigned _ = False
+
+    popCount False = 0
+    popCount True  = 1
+
+instance FiniteBits Bool where
+    finiteBitSize _ = 1
+
+
+instance Bits Int where
+    {-# INLINE shift #-}
+    {-# INLINE bit #-}
+    {-# INLINE testBit #-}
+
+    zeroBits = 0
+
+    bit     = bitDefault
+
+    testBit = testBitDefault
+
+    (I# x#) .&.   (I# y#)          = I# (x# `andI#` y#)
+    (I# x#) .|.   (I# y#)          = I# (x# `orI#`  y#)
+    (I# x#) `xor` (I# y#)          = I# (x# `xorI#` y#)
+    complement (I# x#)             = I# (notI# x#)
+    (I# x#) `shift` (I# i#)
+        | isTrue# (i# >=# 0#)      = I# (x# `iShiftL#` i#)
+        | otherwise                = I# (x# `iShiftRA#` negateInt# i#)
+    (I# x#) `shiftL` (I# i#)       = I# (x# `iShiftL#` i#)
+    (I# x#) `unsafeShiftL` (I# i#) = I# (x# `uncheckedIShiftL#` i#)
+    (I# x#) `shiftR` (I# i#)       = I# (x# `iShiftRA#` i#)
+    (I# x#) `unsafeShiftR` (I# i#) = I# (x# `uncheckedIShiftRA#` i#)
+
+    {-# INLINE rotate #-} 	-- See Note [Constant folding for rotate]
+    (I# x#) `rotate` (I# i#) =
+        I# ((x# `uncheckedIShiftL#` i'#) `orI#` (x# `uncheckedIShiftRL#` (wsib -# i'#)))
+      where
+        !i'# = i# `andI#` (wsib -# 1#)
+        !wsib = WORD_SIZE_IN_BITS#   {- work around preprocessor problem (??) -}
+    bitSizeMaybe i         = Just (finiteBitSize i)
+    bitSize i              = finiteBitSize i
+
+    popCount (I# x#) = I# (word2Int# (popCnt# (int2Word# x#)))
+
+    isSigned _             = True
+
+instance FiniteBits Int where
+    finiteBitSize _ = WORD_SIZE_IN_BITS
+
+instance Bits Word where
+    {-# INLINE shift #-}
+    {-# INLINE bit #-}
+    {-# INLINE testBit #-}
+
+    (W# x#) .&.   (W# y#)    = W# (x# `and#` y#)
+    (W# x#) .|.   (W# y#)    = W# (x# `or#`  y#)
+    (W# x#) `xor` (W# y#)    = W# (x# `xor#` y#)
+    complement (W# x#)       = W# (x# `xor#` mb#)
+        where !(W# mb#) = maxBound
+    (W# x#) `shift` (I# i#)
+        | isTrue# (i# >=# 0#)      = W# (x# `shiftL#` i#)
+        | otherwise                = W# (x# `shiftRL#` negateInt# i#)
+    (W# x#) `shiftL` (I# i#)       = W# (x# `shiftL#` i#)
+    (W# x#) `unsafeShiftL` (I# i#) = W# (x# `uncheckedShiftL#` i#)
+    (W# x#) `shiftR` (I# i#)       = W# (x# `shiftRL#` i#)
+    (W# x#) `unsafeShiftR` (I# i#) = W# (x# `uncheckedShiftRL#` i#)
+    (W# x#) `rotate` (I# i#)
+        | isTrue# (i'# ==# 0#) = W# x#
+        | otherwise  = W# ((x# `uncheckedShiftL#` i'#) `or#` (x# `uncheckedShiftRL#` (wsib -# i'#)))
+        where
+        !i'# = i# `andI#` (wsib -# 1#)
+        !wsib = WORD_SIZE_IN_BITS#  {- work around preprocessor problem (??) -}
+    bitSizeMaybe i           = Just (finiteBitSize i)
+    bitSize i                = finiteBitSize i
+    isSigned _               = False
+    popCount (W# x#)         = I# (word2Int# (popCnt# x#))
+    bit                      = bitDefault
+    testBit                  = testBitDefault
+
+instance FiniteBits Word where
+    finiteBitSize _ = WORD_SIZE_IN_BITS
+
+instance Bits Integer where
+   (.&.) = andInteger
+   (.|.) = orInteger
+   xor = xorInteger
+   complement = complementInteger
+   shift x i@(I# i#) | i >= 0    = shiftLInteger x i#
+                     | otherwise = shiftRInteger x (negateInt# i#)
+   shiftL x (I# i#) = shiftLInteger x i#
+   shiftR x (I# i#) = shiftRInteger x i#
+
+   testBit x (I# i) = testBitInteger x i
+
+   zeroBits   = 0
+   bit        = bitDefault
+   popCount   = popCountDefault
+
+   rotate x i = shift x i   -- since an Integer never wraps around
+
+   bitSizeMaybe _ = Nothing
+   bitSize _  = error "Data.Bits.bitSize(Integer)"
+   isSigned _ = True
+
+{- 	Note [Constant folding for rotate]
+	~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+The INLINE on the Int instance of rotate enables it to be constant
+folded.  For example:
+     sumU . mapU (`rotate` 3) . replicateU 10000000 $ (7 :: Int)
+goes to:
+   Main.$wfold =
+     \ (ww_sO7 :: Int#) (ww1_sOb :: Int#) ->
+       case ww1_sOb of wild_XM {
+         __DEFAULT -> Main.$wfold (+# ww_sO7 56) (+# wild_XM 1);
+         10000000 -> ww_sO7
+whereas before it was left as a call to $wrotate.
+
+All other Bits instances seem to inline well enough on their
+own to enable constant folding; for example 'shift':
+     sumU . mapU (`shift` 3) . replicateU 10000000 $ (7 :: Int)
+ goes to:
+     Main.$wfold =
+       \ (ww_sOb :: Int#) (ww1_sOf :: Int#) ->
+         case ww1_sOf of wild_XM {
+           __DEFAULT -> Main.$wfold (+# ww_sOb 56) (+# wild_XM 1);
+           10000000 -> ww_sOb
+         }
+-}
+
diff --git a/libraries/base/Data/Bool.hs b/libraries/base/Data/Bool.hs
new file mode 100644
index 000000000000..deeac800f926
--- /dev/null
+++ b/libraries/base/Data/Bool.hs
@@ -0,0 +1,38 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.Bool
+-- Copyright   :  (c) The University of Glasgow 2001
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+-- 
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  experimental
+-- Portability :  portable
+--
+-- The 'Bool' type and related functions.
+--
+-----------------------------------------------------------------------------
+
+module Data.Bool (
+   -- * Booleans
+   Bool(..),
+   -- ** Operations 
+   (&&),
+   (||),
+   not,
+   otherwise,
+   bool,
+  ) where
+
+import GHC.Base
+
+-- | Case analysis for the 'Bool' type.
+-- @bool a b p@ evaluates to @a@ when @p@ is @False@, and evaluates to @b@
+-- when @p@ is @True@.
+--
+-- /Since: 4.7.0.0/
+bool :: a -> a -> Bool -> a
+bool f _ False = f
+bool _ t True  = t
diff --git a/libraries/base/Data/Char.hs b/libraries/base/Data/Char.hs
new file mode 100644
index 000000000000..aa4a59485c41
--- /dev/null
+++ b/libraries/base/Data/Char.hs
@@ -0,0 +1,178 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.Char
+-- Copyright   :  (c) The University of Glasgow 2001
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+-- 
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  stable
+-- Portability :  portable
+--
+-- The Char type and associated operations.
+--
+-----------------------------------------------------------------------------
+
+module Data.Char
+    (
+      Char
+
+    -- * Character classification
+    -- | Unicode characters are divided into letters, numbers, marks,
+    -- punctuation, symbols, separators (including spaces) and others
+    -- (including control characters).
+    , isControl, isSpace
+    , isLower, isUpper, isAlpha, isAlphaNum, isPrint
+    , isDigit, isOctDigit, isHexDigit
+    , isLetter, isMark, isNumber, isPunctuation, isSymbol, isSeparator
+
+    -- ** Subranges
+    , isAscii, isLatin1
+    , isAsciiUpper, isAsciiLower
+
+    -- ** Unicode general categories
+    , GeneralCategory(..), generalCategory
+
+    -- * Case conversion
+    , toUpper, toLower, toTitle
+
+    -- * Single digit characters
+    , digitToInt
+    , intToDigit
+
+    -- * Numeric representations
+    , ord
+    , chr
+
+    -- * String representations
+    , showLitChar
+    , lexLitChar
+    , readLitChar
+    ) where
+
+import GHC.Base
+import GHC.Arr (Ix)
+import GHC.Char
+import GHC.Real (fromIntegral)
+import GHC.Show
+import GHC.Read (Read, readLitChar, lexLitChar)
+import GHC.Unicode
+import GHC.Num
+import GHC.Enum
+
+-- | Convert a single digit 'Char' to the corresponding 'Int'.  
+-- This function fails unless its argument satisfies 'isHexDigit',
+-- but recognises both upper and lower-case hexadecimal digits
+-- (i.e. @\'0\'@..@\'9\'@, @\'a\'@..@\'f\'@, @\'A\'@..@\'F\'@).
+digitToInt :: Char -> Int
+digitToInt c
+ | isDigit c            =  ord c - ord '0'
+ | c >= 'a' && c <= 'f' =  ord c - ord 'a' + 10
+ | c >= 'A' && c <= 'F' =  ord c - ord 'A' + 10
+ | otherwise            =  error ("Char.digitToInt: not a digit " ++ show c) -- sigh
+
+-- | Unicode General Categories (column 2 of the UnicodeData table)
+-- in the order they are listed in the Unicode standard.
+
+data GeneralCategory
+        = UppercaseLetter       -- ^ Lu: Letter, Uppercase
+        | LowercaseLetter       -- ^ Ll: Letter, Lowercase
+        | TitlecaseLetter       -- ^ Lt: Letter, Titlecase
+        | ModifierLetter        -- ^ Lm: Letter, Modifier
+        | OtherLetter           -- ^ Lo: Letter, Other
+        | NonSpacingMark        -- ^ Mn: Mark, Non-Spacing
+        | SpacingCombiningMark  -- ^ Mc: Mark, Spacing Combining
+        | EnclosingMark         -- ^ Me: Mark, Enclosing
+        | DecimalNumber         -- ^ Nd: Number, Decimal
+        | LetterNumber          -- ^ Nl: Number, Letter
+        | OtherNumber           -- ^ No: Number, Other
+        | ConnectorPunctuation  -- ^ Pc: Punctuation, Connector
+        | DashPunctuation       -- ^ Pd: Punctuation, Dash
+        | OpenPunctuation       -- ^ Ps: Punctuation, Open
+        | ClosePunctuation      -- ^ Pe: Punctuation, Close
+        | InitialQuote          -- ^ Pi: Punctuation, Initial quote
+        | FinalQuote            -- ^ Pf: Punctuation, Final quote
+        | OtherPunctuation      -- ^ Po: Punctuation, Other
+        | MathSymbol            -- ^ Sm: Symbol, Math
+        | CurrencySymbol        -- ^ Sc: Symbol, Currency
+        | ModifierSymbol        -- ^ Sk: Symbol, Modifier
+        | OtherSymbol           -- ^ So: Symbol, Other
+        | Space                 -- ^ Zs: Separator, Space
+        | LineSeparator         -- ^ Zl: Separator, Line
+        | ParagraphSeparator    -- ^ Zp: Separator, Paragraph
+        | Control               -- ^ Cc: Other, Control
+        | Format                -- ^ Cf: Other, Format
+        | Surrogate             -- ^ Cs: Other, Surrogate
+        | PrivateUse            -- ^ Co: Other, Private Use
+        | NotAssigned           -- ^ Cn: Other, Not Assigned
+        deriving (Eq, Ord, Enum, Read, Show, Bounded, Ix)
+
+-- | The Unicode general category of the character.
+generalCategory :: Char -> GeneralCategory
+generalCategory c = toEnum $ fromIntegral $ wgencat $ fromIntegral $ ord c
+
+-- derived character classifiers
+
+-- | Selects alphabetic Unicode characters (lower-case, upper-case and
+-- title-case letters, plus letters of caseless scripts and modifiers letters).
+-- This function is equivalent to 'Data.Char.isAlpha'.
+isLetter :: Char -> Bool
+isLetter c = case generalCategory c of
+        UppercaseLetter         -> True
+        LowercaseLetter         -> True
+        TitlecaseLetter         -> True
+        ModifierLetter          -> True
+        OtherLetter             -> True
+        _                       -> False
+
+-- | Selects Unicode mark characters, e.g. accents and the like, which
+-- combine with preceding letters.
+isMark :: Char -> Bool
+isMark c = case generalCategory c of
+        NonSpacingMark          -> True
+        SpacingCombiningMark    -> True
+        EnclosingMark           -> True
+        _                       -> False
+
+-- | Selects Unicode numeric characters, including digits from various
+-- scripts, Roman numerals, etc.
+isNumber :: Char -> Bool
+isNumber c = case generalCategory c of
+        DecimalNumber           -> True
+        LetterNumber            -> True
+        OtherNumber             -> True
+        _                       -> False
+
+-- | Selects Unicode punctuation characters, including various kinds
+-- of connectors, brackets and quotes.
+isPunctuation :: Char -> Bool
+isPunctuation c = case generalCategory c of
+        ConnectorPunctuation    -> True
+        DashPunctuation         -> True
+        OpenPunctuation         -> True
+        ClosePunctuation        -> True
+        InitialQuote            -> True
+        FinalQuote              -> True
+        OtherPunctuation        -> True
+        _                       -> False
+
+-- | Selects Unicode symbol characters, including mathematical and
+-- currency symbols.
+isSymbol :: Char -> Bool
+isSymbol c = case generalCategory c of
+        MathSymbol              -> True
+        CurrencySymbol          -> True
+        ModifierSymbol          -> True
+        OtherSymbol             -> True
+        _                       -> False
+
+-- | Selects Unicode space and separator characters.
+isSeparator :: Char -> Bool
+isSeparator c = case generalCategory c of
+        Space                   -> True
+        LineSeparator           -> True
+        ParagraphSeparator      -> True
+        _                       -> False
+
diff --git a/libraries/base/Data/Coerce.hs b/libraries/base/Data/Coerce.hs
new file mode 100644
index 000000000000..653a857da8e4
--- /dev/null
+++ b/libraries/base/Data/Coerce.hs
@@ -0,0 +1,30 @@
+{-# LANGUAGE Unsafe #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.Coerce
+-- Copyright   :  (c) The University of Glasgow 2001
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+--
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  provisional
+-- Portability :  portable
+--
+-- Safe coercions between data types.
+--
+-- More in-depth information can be found on the
+-- <https://ghc.haskell.org/trac/ghc/wiki/Roles Roles wiki page>
+--
+-- /Since: 4.7.0.0/
+-----------------------------------------------------------------------------
+
+module Data.Coerce
+        ( -- * Safe coercions
+          coerce, Coercible,
+        ) where
+import GHC.Prim (coerce)
+import GHC.Types (Coercible)
+
+import GHC.Base () -- for build ordering
+
diff --git a/libraries/base/Data/Complex.hs b/libraries/base/Data/Complex.hs
new file mode 100644
index 000000000000..0ce148788d56
--- /dev/null
+++ b/libraries/base/Data/Complex.hs
@@ -0,0 +1,175 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE AutoDeriveTypeable #-}
+{-# LANGUAGE StandaloneDeriving #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.Complex
+-- Copyright   :  (c) The University of Glasgow 2001
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+--
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  provisional
+-- Portability :  portable
+--
+-- Complex numbers.
+--
+-----------------------------------------------------------------------------
+
+module Data.Complex
+        (
+        -- * Rectangular form
+          Complex((:+))
+
+        , realPart
+        , imagPart
+        -- * Polar form
+        , mkPolar
+        , cis
+        , polar
+        , magnitude
+        , phase
+        -- * Conjugate
+        , conjugate
+
+        )  where
+
+import Prelude
+
+import Data.Typeable
+import Data.Data (Data)
+
+infix  6  :+
+
+-- -----------------------------------------------------------------------------
+-- The Complex type
+
+-- | Complex numbers are an algebraic type.
+--
+-- For a complex number @z@, @'abs' z@ is a number with the magnitude of @z@,
+-- but oriented in the positive real direction, whereas @'signum' z@
+-- has the phase of @z@, but unit magnitude.
+data Complex a
+  = !a :+ !a    -- ^ forms a complex number from its real and imaginary
+                -- rectangular components.
+        deriving (Eq, Show, Read, Data, Typeable)
+
+-- -----------------------------------------------------------------------------
+-- Functions over Complex
+
+-- | Extracts the real part of a complex number.
+realPart :: Complex a -> a
+realPart (x :+ _) =  x
+
+-- | Extracts the imaginary part of a complex number.
+imagPart :: Complex a -> a
+imagPart (_ :+ y) =  y
+
+-- | The conjugate of a complex number.
+{-# SPECIALISE conjugate :: Complex Double -> Complex Double #-}
+conjugate        :: Num a => Complex a -> Complex a
+conjugate (x:+y) =  x :+ (-y)
+
+-- | Form a complex number from polar components of magnitude and phase.
+{-# SPECIALISE mkPolar :: Double -> Double -> Complex Double #-}
+mkPolar          :: Floating a => a -> a -> Complex a
+mkPolar r theta  =  r * cos theta :+ r * sin theta
+
+-- | @'cis' t@ is a complex value with magnitude @1@
+-- and phase @t@ (modulo @2*'pi'@).
+{-# SPECIALISE cis :: Double -> Complex Double #-}
+cis              :: Floating a => a -> Complex a
+cis theta        =  cos theta :+ sin theta
+
+-- | The function 'polar' takes a complex number and
+-- returns a (magnitude, phase) pair in canonical form:
+-- the magnitude is nonnegative, and the phase in the range @(-'pi', 'pi']@;
+-- if the magnitude is zero, then so is the phase.
+{-# SPECIALISE polar :: Complex Double -> (Double,Double) #-}
+polar            :: (RealFloat a) => Complex a -> (a,a)
+polar z          =  (magnitude z, phase z)
+
+-- | The nonnegative magnitude of a complex number.
+{-# SPECIALISE magnitude :: Complex Double -> Double #-}
+magnitude :: (RealFloat a) => Complex a -> a
+magnitude (x:+y) =  scaleFloat k
+                     (sqrt (sqr (scaleFloat mk x) + sqr (scaleFloat mk y)))
+                    where k  = max (exponent x) (exponent y)
+                          mk = - k
+                          sqr z = z * z
+
+-- | The phase of a complex number, in the range @(-'pi', 'pi']@.
+-- If the magnitude is zero, then so is the phase.
+{-# SPECIALISE phase :: Complex Double -> Double #-}
+phase :: (RealFloat a) => Complex a -> a
+phase (0 :+ 0)   = 0            -- SLPJ July 97 from John Peterson
+phase (x:+y)     = atan2 y x
+
+
+-- -----------------------------------------------------------------------------
+-- Instances of Complex
+
+instance  (RealFloat a) => Num (Complex a)  where
+    {-# SPECIALISE instance Num (Complex Float) #-}
+    {-# SPECIALISE instance Num (Complex Double) #-}
+    (x:+y) + (x':+y')   =  (x+x') :+ (y+y')
+    (x:+y) - (x':+y')   =  (x-x') :+ (y-y')
+    (x:+y) * (x':+y')   =  (x*x'-y*y') :+ (x*y'+y*x')
+    negate (x:+y)       =  negate x :+ negate y
+    abs z               =  magnitude z :+ 0
+    signum (0:+0)       =  0
+    signum z@(x:+y)     =  x/r :+ y/r  where r = magnitude z
+    fromInteger n       =  fromInteger n :+ 0
+
+instance  (RealFloat a) => Fractional (Complex a)  where
+    {-# SPECIALISE instance Fractional (Complex Float) #-}
+    {-# SPECIALISE instance Fractional (Complex Double) #-}
+    (x:+y) / (x':+y')   =  (x*x''+y*y'') / d :+ (y*x''-x*y'') / d
+                           where x'' = scaleFloat k x'
+                                 y'' = scaleFloat k y'
+                                 k   = - max (exponent x') (exponent y')
+                                 d   = x'*x'' + y'*y''
+
+    fromRational a      =  fromRational a :+ 0
+
+instance  (RealFloat a) => Floating (Complex a) where
+    {-# SPECIALISE instance Floating (Complex Float) #-}
+    {-# SPECIALISE instance Floating (Complex Double) #-}
+    pi             =  pi :+ 0
+    exp (x:+y)     =  expx * cos y :+ expx * sin y
+                      where expx = exp x
+    log z          =  log (magnitude z) :+ phase z
+
+    sqrt (0:+0)    =  0
+    sqrt z@(x:+y)  =  u :+ (if y < 0 then -v else v)
+                      where (u,v) = if x < 0 then (v',u') else (u',v')
+                            v'    = abs y / (u'*2)
+                            u'    = sqrt ((magnitude z + abs x) / 2)
+
+    sin (x:+y)     =  sin x * cosh y :+ cos x * sinh y
+    cos (x:+y)     =  cos x * cosh y :+ (- sin x * sinh y)
+    tan (x:+y)     =  (sinx*coshy:+cosx*sinhy)/(cosx*coshy:+(-sinx*sinhy))
+                      where sinx  = sin x
+                            cosx  = cos x
+                            sinhy = sinh y
+                            coshy = cosh y
+
+    sinh (x:+y)    =  cos y * sinh x :+ sin  y * cosh x
+    cosh (x:+y)    =  cos y * cosh x :+ sin y * sinh x
+    tanh (x:+y)    =  (cosy*sinhx:+siny*coshx)/(cosy*coshx:+siny*sinhx)
+                      where siny  = sin y
+                            cosy  = cos y
+                            sinhx = sinh x
+                            coshx = cosh x
+
+    asin z@(x:+y)  =  y':+(-x')
+                      where  (x':+y') = log (((-y):+x) + sqrt (1 - z*z))
+    acos z         =  y'':+(-x'')
+                      where (x'':+y'') = log (z + ((-y'):+x'))
+                            (x':+y')   = sqrt (1 - z*z)
+    atan z@(x:+y)  =  y':+(-x')
+                      where (x':+y') = log (((1-y):+x) / sqrt (1+z*z))
+
+    asinh z        =  log (z + sqrt (1+z*z))
+    acosh z        =  log (z + (z+1) * sqrt ((z-1)/(z+1)))
+    atanh z        =  0.5 * log ((1.0+z) / (1.0-z))
diff --git a/libraries/base/Data/Data.hs b/libraries/base/Data/Data.hs
new file mode 100644
index 000000000000..49407fae1607
--- /dev/null
+++ b/libraries/base/Data/Data.hs
@@ -0,0 +1,1395 @@
+{-# LANGUAGE Trustworthy, FlexibleInstances #-}
+{-# LANGUAGE RankNTypes, ScopedTypeVariables, PolyKinds #-}
+{-# LANGUAGE StandaloneDeriving, AutoDeriveTypeable, TypeOperators,
+             GADTs #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.Data
+-- Copyright   :  (c) The University of Glasgow, CWI 2001--2004
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+-- 
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  experimental
+-- Portability :  non-portable (local universal quantification)
+--
+-- \"Scrap your boilerplate\" --- Generic programming in Haskell.
+-- See <http://www.cs.vu.nl/boilerplate/>. This module provides
+-- the 'Data' class with its primitives for generic programming, along
+-- with instances for many datatypes. It corresponds to a merge between
+-- the previous "Data.Generics.Basics" and almost all of 
+-- "Data.Generics.Instances". The instances that are not present
+-- in this module were moved to the @Data.Generics.Instances@ module
+-- in the @syb@ package.
+--
+-- For more information, please visit the new
+-- SYB wiki: <http://www.cs.uu.nl/wiki/bin/view/GenericProgramming/SYB>.
+--
+-----------------------------------------------------------------------------
+
+module Data.Data (
+
+        -- * Module Data.Typeable re-exported for convenience
+        module Data.Typeable,
+
+        -- * The Data class for processing constructor applications
+        Data(
+                gfoldl,
+                gunfold,
+                toConstr,
+                dataTypeOf,
+                dataCast1,      -- mediate types and unary type constructors
+                dataCast2,      -- mediate types and binary type constructors
+                -- Generic maps defined in terms of gfoldl 
+                gmapT,
+                gmapQ,
+                gmapQl,
+                gmapQr,
+                gmapQi,
+                gmapM,
+                gmapMp,
+                gmapMo
+            ),
+
+        -- * Datatype representations
+        DataType,       -- abstract
+        -- ** Constructors
+        mkDataType,
+        mkIntType,
+        mkFloatType,
+        mkCharType,
+        mkNoRepType,
+        -- ** Observers
+        dataTypeName,
+        DataRep(..),
+        dataTypeRep,
+        -- ** Convenience functions
+        repConstr,
+        isAlgType,
+        dataTypeConstrs,
+        indexConstr,
+        maxConstrIndex,
+        isNorepType,
+
+        -- * Data constructor representations
+        Constr,         -- abstract
+        ConIndex,       -- alias for Int, start at 1
+        Fixity(..),
+        -- ** Constructors
+        mkConstr,
+        mkIntegralConstr,
+        mkRealConstr,
+        mkCharConstr,
+        -- ** Observers
+        constrType,
+        ConstrRep(..),
+        constrRep,
+        constrFields,
+        constrFixity,
+        -- ** Convenience function: algebraic data types
+        constrIndex,
+        -- ** From strings to constructors and vice versa: all data types
+        showConstr,
+        readConstr,
+
+        -- * Convenience functions: take type constructors apart
+        tyconUQname,
+        tyconModule,
+
+        -- * Generic operations defined in terms of 'gunfold'
+        fromConstr,
+        fromConstrB,
+        fromConstrM
+
+  ) where
+
+
+------------------------------------------------------------------------------
+
+import Prelude -- necessary to get dependencies right
+
+import Data.Typeable
+import Data.Maybe
+import Data.Version( Version(..) )
+import Control.Monad
+
+-- Imports for the instances
+import Data.Int              -- So we can give Data instance for Int8, ...
+import Data.Type.Coercion
+import Data.Coerce
+import Data.Word             -- So we can give Data instance for Word8, ...
+import GHC.Real( Ratio(..) ) -- So we can give Data instance for Ratio
+--import GHC.IOBase            -- So we can give Data instance for IO, Handle
+import GHC.Ptr               -- So we can give Data instance for Ptr
+import GHC.ForeignPtr        -- So we can give Data instance for ForeignPtr
+--import GHC.Stable            -- So we can give Data instance for StablePtr
+--import GHC.ST                -- So we can give Data instance for ST
+--import GHC.Conc              -- So we can give Data instance for MVar & Co.
+import GHC.Arr               -- So we can give Data instance for Array
+
+
+------------------------------------------------------------------------------
+--
+--      The Data class
+--
+------------------------------------------------------------------------------
+
+{- |
+The 'Data' class comprehends a fundamental primitive 'gfoldl' for
+folding over constructor applications, say terms. This primitive can
+be instantiated in several ways to map over the immediate subterms
+of a term; see the @gmap@ combinators later in this class.  Indeed, a
+generic programmer does not necessarily need to use the ingenious gfoldl
+primitive but rather the intuitive @gmap@ combinators.  The 'gfoldl'
+primitive is completed by means to query top-level constructors, to
+turn constructor representations into proper terms, and to list all
+possible datatype constructors.  This completion allows us to serve
+generic programming scenarios like read, show, equality, term generation.
+
+The combinators 'gmapT', 'gmapQ', 'gmapM', etc are all provided with
+default definitions in terms of 'gfoldl', leaving open the opportunity
+to provide datatype-specific definitions.
+(The inclusion of the @gmap@ combinators as members of class 'Data'
+allows the programmer or the compiler to derive specialised, and maybe
+more efficient code per datatype.  /Note/: 'gfoldl' is more higher-order
+than the @gmap@ combinators.  This is subject to ongoing benchmarking
+experiments.  It might turn out that the @gmap@ combinators will be
+moved out of the class 'Data'.)
+
+Conceptually, the definition of the @gmap@ combinators in terms of the
+primitive 'gfoldl' requires the identification of the 'gfoldl' function
+arguments.  Technically, we also need to identify the type constructor
+@c@ for the construction of the result type from the folded term type.
+
+In the definition of @gmapQ@/x/ combinators, we use phantom type
+constructors for the @c@ in the type of 'gfoldl' because the result type
+of a query does not involve the (polymorphic) type of the term argument.
+In the definition of 'gmapQl' we simply use the plain constant type
+constructor because 'gfoldl' is left-associative anyway and so it is
+readily suited to fold a left-associative binary operation over the
+immediate subterms.  In the definition of gmapQr, extra effort is
+needed. We use a higher-order accumulation trick to mediate between
+left-associative constructor application vs. right-associative binary
+operation (e.g., @(:)@).  When the query is meant to compute a value
+of type @r@, then the result type withing generic folding is @r -> r@.
+So the result of folding is a function to which we finally pass the
+right unit.
+
+With the @-XDeriveDataTypeable@ option, GHC can generate instances of the
+'Data' class automatically.  For example, given the declaration
+
+> data T a b = C1 a b | C2 deriving (Typeable, Data)
+
+GHC will generate an instance that is equivalent to
+
+> instance (Data a, Data b) => Data (T a b) where
+>     gfoldl k z (C1 a b) = z C1 `k` a `k` b
+>     gfoldl k z C2       = z C2
+>
+>     gunfold k z c = case constrIndex c of
+>                         1 -> k (k (z C1))
+>                         2 -> z C2
+>
+>     toConstr (C1 _ _) = con_C1
+>     toConstr C2       = con_C2
+>
+>     dataTypeOf _ = ty_T
+>
+> con_C1 = mkConstr ty_T "C1" [] Prefix
+> con_C2 = mkConstr ty_T "C2" [] Prefix
+> ty_T   = mkDataType "Module.T" [con_C1, con_C2]
+
+This is suitable for datatypes that are exported transparently.
+
+-}
+
+class Typeable a => Data a where
+
+  -- | Left-associative fold operation for constructor applications.
+  --
+  -- The type of 'gfoldl' is a headache, but operationally it is a simple
+  -- generalisation of a list fold.
+  --
+  -- The default definition for 'gfoldl' is @'const' 'id'@, which is
+  -- suitable for abstract datatypes with no substructures.
+  gfoldl  :: (forall d b. Data d => c (d -> b) -> d -> c b)
+                -- ^ defines how nonempty constructor applications are
+                -- folded.  It takes the folded tail of the constructor
+                -- application and its head, i.e., an immediate subterm,
+                -- and combines them in some way.
+          -> (forall g. g -> c g)
+                -- ^ defines how the empty constructor application is
+                -- folded, like the neutral \/ start element for list
+                -- folding.
+          -> a
+                -- ^ structure to be folded.
+          -> c a
+                -- ^ result, with a type defined in terms of @a@, but
+                -- variability is achieved by means of type constructor
+                -- @c@ for the construction of the actual result type.
+
+  -- See the 'Data' instances in this file for an illustration of 'gfoldl'.
+
+  gfoldl _ z = z
+
+  -- | Unfolding constructor applications
+  gunfold :: (forall b r. Data b => c (b -> r) -> c r)
+          -> (forall r. r -> c r)
+          -> Constr
+          -> c a
+
+  -- | Obtaining the constructor from a given datum.
+  -- For proper terms, this is meant to be the top-level constructor.
+  -- Primitive datatypes are here viewed as potentially infinite sets of
+  -- values (i.e., constructors).
+  toConstr   :: a -> Constr
+
+
+  -- | The outer type constructor of the type
+  dataTypeOf  :: a -> DataType
+
+
+
+------------------------------------------------------------------------------
+--
+-- Mediate types and type constructors
+--
+------------------------------------------------------------------------------
+
+  -- | Mediate types and unary type constructors.
+  -- In 'Data' instances of the form @T a@, 'dataCast1' should be defined
+  -- as 'gcast1'.
+  --
+  -- The default definition is @'const' 'Nothing'@, which is appropriate
+  -- for non-unary type constructors.
+  dataCast1 :: Typeable t
+            => (forall d. Data d => c (t d))
+            -> Maybe (c a)
+  dataCast1 _ = Nothing
+
+  -- | Mediate types and binary type constructors.
+  -- In 'Data' instances of the form @T a b@, 'dataCast2' should be
+  -- defined as 'gcast2'.
+  --
+  -- The default definition is @'const' 'Nothing'@, which is appropriate
+  -- for non-binary type constructors.
+  dataCast2 :: Typeable t
+            => (forall d e. (Data d, Data e) => c (t d e))
+            -> Maybe (c a)
+  dataCast2 _ = Nothing
+
+
+
+------------------------------------------------------------------------------
+--
+--      Typical generic maps defined in terms of gfoldl
+--
+------------------------------------------------------------------------------
+
+
+  -- | A generic transformation that maps over the immediate subterms
+  --
+  -- The default definition instantiates the type constructor @c@ in the
+  -- type of 'gfoldl' to an identity datatype constructor, using the
+  -- isomorphism pair as injection and projection.
+  gmapT :: (forall b. Data b => b -> b) -> a -> a
+
+  -- Use an identity datatype constructor ID (see below)
+  -- to instantiate the type constructor c in the type of gfoldl,
+  -- and perform injections ID and projections unID accordingly.
+  --
+  gmapT f x0 = unID (gfoldl k ID x0)
+    where
+      k :: Data d => ID (d->b) -> d -> ID b
+      k (ID c) x = ID (c (f x))
+
+
+  -- | A generic query with a left-associative binary operator
+  gmapQl :: forall r r'. (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r
+  gmapQl o r f = unCONST . gfoldl k z
+    where
+      k :: Data d => CONST r (d->b) -> d -> CONST r b
+      k c x = CONST $ (unCONST c) `o` f x
+      z :: g -> CONST r g
+      z _   = CONST r
+
+  -- | A generic query with a right-associative binary operator
+  gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r
+  gmapQr o r0 f x0 = unQr (gfoldl k (const (Qr id)) x0) r0
+    where
+      k :: Data d => Qr r (d->b) -> d -> Qr r b
+      k (Qr c) x = Qr (\r -> c (f x `o` r))
+
+
+  -- | A generic query that processes the immediate subterms and returns a list
+  -- of results.  The list is given in the same order as originally specified
+  -- in the declaration of the data constructors.
+  gmapQ :: (forall d. Data d => d -> u) -> a -> [u]
+  gmapQ f = gmapQr (:) [] f
+
+
+  -- | A generic query that processes one child by index (zero-based)
+  gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> a -> u
+  gmapQi i f x = case gfoldl k z x of { Qi _ q -> fromJust q }
+    where
+      k :: Data d => Qi u (d -> b) -> d -> Qi u b
+      k (Qi i' q) a = Qi (i'+1) (if i==i' then Just (f a) else q)
+      z :: g -> Qi q g
+      z _           = Qi 0 Nothing
+
+
+  -- | A generic monadic transformation that maps over the immediate subterms
+  --
+  -- The default definition instantiates the type constructor @c@ in
+  -- the type of 'gfoldl' to the monad datatype constructor, defining
+  -- injection and projection using 'return' and '>>='.
+  gmapM :: forall m. Monad m => (forall d. Data d => d -> m d) -> a -> m a
+
+  -- Use immediately the monad datatype constructor 
+  -- to instantiate the type constructor c in the type of gfoldl,
+  -- so injection and projection is done by return and >>=.
+  --  
+  gmapM f = gfoldl k return
+    where
+      k :: Data d => m (d -> b) -> d -> m b
+      k c x = do c' <- c
+                 x' <- f x
+                 return (c' x')
+
+
+  -- | Transformation of at least one immediate subterm does not fail
+  gmapMp :: forall m. MonadPlus m => (forall d. Data d => d -> m d) -> a -> m a
+
+{-
+
+The type constructor that we use here simply keeps track of the fact
+if we already succeeded for an immediate subterm; see Mp below. To
+this end, we couple the monadic computation with a Boolean.
+
+-}
+
+  gmapMp f x = unMp (gfoldl k z x) >>= \(x',b) ->
+                if b then return x' else mzero
+    where
+      z :: g -> Mp m g
+      z g = Mp (return (g,False))
+      k :: Data d => Mp m (d -> b) -> d -> Mp m b
+      k (Mp c) y
+        = Mp ( c >>= \(h, b) ->
+                 (f y >>= \y' -> return (h y', True))
+                 `mplus` return (h y, b)
+             )
+
+  -- | Transformation of one immediate subterm with success
+  gmapMo :: forall m. MonadPlus m => (forall d. Data d => d -> m d) -> a -> m a
+
+{-
+
+We use the same pairing trick as for gmapMp, 
+i.e., we use an extra Bool component to keep track of the 
+fact whether an immediate subterm was processed successfully.
+However, we cut of mapping over subterms once a first subterm
+was transformed successfully.
+
+-}
+
+  gmapMo f x = unMp (gfoldl k z x) >>= \(x',b) ->
+                if b then return x' else mzero
+    where
+      z :: g -> Mp m g
+      z g = Mp (return (g,False))
+      k :: Data d => Mp m (d -> b) -> d -> Mp m b
+      k (Mp c) y
+        = Mp ( c >>= \(h,b) -> if b
+                        then return (h y, b)
+                        else (f y >>= \y' -> return (h y',True))
+                             `mplus` return (h y, b)
+             )
+
+
+-- | The identity type constructor needed for the definition of gmapT
+newtype ID x = ID { unID :: x }
+
+
+-- | The constant type constructor needed for the definition of gmapQl
+newtype CONST c a = CONST { unCONST :: c }
+
+
+-- | Type constructor for adding counters to queries
+data Qi q a = Qi Int (Maybe q)
+
+
+-- | The type constructor used in definition of gmapQr
+newtype Qr r a = Qr { unQr  :: r -> r }
+
+
+-- | The type constructor used in definition of gmapMp
+newtype Mp m x = Mp { unMp :: m (x, Bool) }
+
+
+
+------------------------------------------------------------------------------
+--
+--      Generic unfolding
+--
+------------------------------------------------------------------------------
+
+
+-- | Build a term skeleton
+fromConstr :: Data a => Constr -> a
+fromConstr = fromConstrB (error "Data.Data.fromConstr")
+
+
+-- | Build a term and use a generic function for subterms
+fromConstrB :: Data a
+            => (forall d. Data d => d)
+            -> Constr
+            -> a
+fromConstrB f = unID . gunfold k z
+ where
+  k :: forall b r. Data b => ID (b -> r) -> ID r
+  k c = ID (unID c f)
+ 
+  z :: forall r. r -> ID r
+  z = ID
+
+
+-- | Monadic variation on 'fromConstrB'
+fromConstrM :: forall m a. (Monad m, Data a)
+            => (forall d. Data d => m d)
+            -> Constr
+            -> m a
+fromConstrM f = gunfold k z
+ where
+  k :: forall b r. Data b => m (b -> r) -> m r
+  k c = do { c' <- c; b <- f; return (c' b) }
+
+  z :: forall r. r -> m r
+  z = return
+
+
+
+------------------------------------------------------------------------------
+--
+--      Datatype and constructor representations
+--
+------------------------------------------------------------------------------
+
+
+--
+-- | Representation of datatypes.
+-- A package of constructor representations with names of type and module.
+--
+data DataType = DataType
+                        { tycon   :: String
+                        , datarep :: DataRep
+                        }
+
+              deriving Show
+
+-- | Representation of constructors. Note that equality on constructors
+-- with different types may not work -- i.e. the constructors for 'False' and
+-- 'Nothing' may compare equal.
+data Constr = Constr
+                        { conrep    :: ConstrRep
+                        , constring :: String
+                        , confields :: [String] -- for AlgRep only
+                        , confixity :: Fixity   -- for AlgRep only
+                        , datatype  :: DataType
+                        }
+
+instance Show Constr where
+ show = constring
+
+
+-- | Equality of constructors
+instance Eq Constr where
+  c == c' = constrRep c == constrRep c'
+
+
+-- | Public representation of datatypes
+data DataRep = AlgRep [Constr]
+             | IntRep
+             | FloatRep
+             | CharRep
+             | NoRep
+
+            deriving (Eq,Show)
+-- The list of constructors could be an array, a balanced tree, or others.
+
+
+-- | Public representation of constructors
+data ConstrRep = AlgConstr    ConIndex
+               | IntConstr    Integer
+               | FloatConstr  Rational
+               | CharConstr   Char
+
+               deriving (Eq,Show)
+
+
+-- | Unique index for datatype constructors,
+-- counting from 1 in the order they are given in the program text.
+type ConIndex = Int
+
+
+-- | Fixity of constructors
+data Fixity = Prefix
+            | Infix     -- Later: add associativity and precedence
+
+            deriving (Eq,Show)
+
+
+------------------------------------------------------------------------------
+--
+--      Observers for datatype representations
+--
+------------------------------------------------------------------------------
+
+
+-- | Gets the type constructor including the module
+dataTypeName :: DataType -> String
+dataTypeName = tycon
+
+
+
+-- | Gets the public presentation of a datatype
+dataTypeRep :: DataType -> DataRep
+dataTypeRep = datarep
+
+
+-- | Gets the datatype of a constructor
+constrType :: Constr -> DataType
+constrType = datatype
+
+
+-- | Gets the public presentation of constructors
+constrRep :: Constr -> ConstrRep
+constrRep = conrep
+
+
+-- | Look up a constructor by its representation
+repConstr :: DataType -> ConstrRep -> Constr
+repConstr dt cr =
+      case (dataTypeRep dt, cr) of
+        (AlgRep cs, AlgConstr i)      -> cs !! (i-1)
+        (IntRep,    IntConstr i)      -> mkIntegralConstr dt i
+        (FloatRep,  FloatConstr f)    -> mkRealConstr dt f
+        (CharRep,   CharConstr c)     -> mkCharConstr dt c
+        _ -> error "Data.Data.repConstr: The given ConstrRep does not fit to the given DataType."
+
+
+
+------------------------------------------------------------------------------
+--
+--      Representations of algebraic data types
+--
+------------------------------------------------------------------------------
+
+
+-- | Constructs an algebraic datatype
+mkDataType :: String -> [Constr] -> DataType
+mkDataType str cs = DataType
+                        { tycon   = str
+                        , datarep = AlgRep cs
+                        }
+
+
+-- | Constructs a constructor
+mkConstr :: DataType -> String -> [String] -> Fixity -> Constr
+mkConstr dt str fields fix =
+        Constr
+                { conrep    = AlgConstr idx
+                , constring = str
+                , confields = fields
+                , confixity = fix
+                , datatype  = dt
+                }
+  where
+    idx = head [ i | (c,i) <- dataTypeConstrs dt `zip` [1..],
+                     showConstr c == str ]
+
+
+-- | Gets the constructors of an algebraic datatype
+dataTypeConstrs :: DataType -> [Constr]
+dataTypeConstrs dt = case datarep dt of
+                        (AlgRep cons) -> cons
+                        _ -> error $ "Data.Data.dataTypeConstrs is not supported for "
+                                    ++ dataTypeName dt ++
+                                    ", as it is not an algebraic data type."
+
+
+-- | Gets the field labels of a constructor.  The list of labels
+-- is returned in the same order as they were given in the original 
+-- constructor declaration.
+constrFields :: Constr -> [String]
+constrFields = confields
+
+
+-- | Gets the fixity of a constructor
+constrFixity :: Constr -> Fixity
+constrFixity = confixity
+
+
+
+------------------------------------------------------------------------------
+--
+--      From strings to constr's and vice versa: all data types
+--      
+------------------------------------------------------------------------------
+
+
+-- | Gets the string for a constructor
+showConstr :: Constr -> String
+showConstr = constring
+
+
+-- | Lookup a constructor via a string
+readConstr :: DataType -> String -> Maybe Constr
+readConstr dt str =
+      case dataTypeRep dt of
+        AlgRep cons -> idx cons
+        IntRep      -> mkReadCon (\i -> (mkPrimCon dt str (IntConstr i)))
+        FloatRep    -> mkReadCon ffloat
+        CharRep     -> mkReadCon (\c -> (mkPrimCon dt str (CharConstr c)))
+        NoRep       -> Nothing
+  where
+
+    -- Read a value and build a constructor
+    mkReadCon :: Read t => (t -> Constr) -> Maybe Constr
+    mkReadCon f = case (reads str) of
+                    [(t,"")] -> Just (f t)
+                    _ -> Nothing
+
+    -- Traverse list of algebraic datatype constructors
+    idx :: [Constr] -> Maybe Constr
+    idx cons = let fit = filter ((==) str . showConstr) cons
+                in if fit == []
+                     then Nothing
+                     else Just (head fit)
+
+    ffloat :: Double -> Constr
+    ffloat =  mkPrimCon dt str . FloatConstr . toRational
+
+------------------------------------------------------------------------------
+--
+--      Convenience funtions: algebraic data types
+--
+------------------------------------------------------------------------------
+
+
+-- | Test for an algebraic type
+isAlgType :: DataType -> Bool
+isAlgType dt = case datarep dt of
+                 (AlgRep _) -> True
+                 _ -> False
+
+
+-- | Gets the constructor for an index (algebraic datatypes only)
+indexConstr :: DataType -> ConIndex -> Constr
+indexConstr dt idx = case datarep dt of
+                        (AlgRep cs) -> cs !! (idx-1)
+                        _           -> error $ "Data.Data.indexConstr is not supported for "
+                                               ++ dataTypeName dt ++
+                                               ", as it is not an algebraic data type."
+
+
+-- | Gets the index of a constructor (algebraic datatypes only)
+constrIndex :: Constr -> ConIndex
+constrIndex con = case constrRep con of
+                    (AlgConstr idx) -> idx
+                    _ -> error $ "Data.Data.constrIndex is not supported for "
+                                 ++ dataTypeName (constrType con) ++
+                                 ", as it is not an algebraic data type."
+
+
+-- | Gets the maximum constructor index of an algebraic datatype
+maxConstrIndex :: DataType -> ConIndex
+maxConstrIndex dt = case dataTypeRep dt of
+                        AlgRep cs -> length cs
+                        _            -> error $ "Data.Data.maxConstrIndex is not supported for "
+                                                 ++ dataTypeName dt ++
+                                                 ", as it is not an algebraic data type."
+
+
+
+------------------------------------------------------------------------------
+--
+--      Representation of primitive types
+--
+------------------------------------------------------------------------------
+
+
+-- | Constructs the 'Int' type
+mkIntType :: String -> DataType
+mkIntType = mkPrimType IntRep
+
+
+-- | Constructs the 'Float' type
+mkFloatType :: String -> DataType
+mkFloatType = mkPrimType FloatRep
+
+
+-- | Constructs the 'Char' type
+mkCharType :: String -> DataType
+mkCharType = mkPrimType CharRep
+
+
+-- | Helper for 'mkIntType', 'mkFloatType'
+mkPrimType :: DataRep -> String -> DataType
+mkPrimType dr str = DataType
+                        { tycon   = str
+                        , datarep = dr
+                        }
+
+
+-- Makes a constructor for primitive types
+mkPrimCon :: DataType -> String -> ConstrRep -> Constr
+mkPrimCon dt str cr = Constr
+                        { datatype  = dt
+                        , conrep    = cr
+                        , constring = str
+                        , confields = error "Data.Data.confields"
+                        , confixity = error "Data.Data.confixity"
+                        }
+
+mkIntegralConstr :: (Integral a, Show a) => DataType -> a -> Constr
+mkIntegralConstr dt i = case datarep dt of
+                  IntRep -> mkPrimCon dt (show i) (IntConstr (toInteger  i))
+                  _ -> error $ "Data.Data.mkIntegralConstr is not supported for "
+                               ++ dataTypeName dt ++
+                               ", as it is not an Integral data type."
+
+mkRealConstr :: (Real a, Show a) => DataType -> a -> Constr
+mkRealConstr dt f = case datarep dt of
+                    FloatRep -> mkPrimCon dt (show f) (FloatConstr (toRational f))
+                    _ -> error $ "Data.Data.mkRealConstr is not supported for "
+                                 ++ dataTypeName dt ++
+                                 ", as it is not an Real data type."
+
+-- | Makes a constructor for 'Char'.
+mkCharConstr :: DataType -> Char -> Constr
+mkCharConstr dt c = case datarep dt of
+                   CharRep -> mkPrimCon dt (show c) (CharConstr c)
+                   _ -> error $ "Data.Data.mkCharConstr is not supported for "
+                                ++ dataTypeName dt ++
+                                ", as it is not an Char data type."
+
+
+------------------------------------------------------------------------------
+--
+--      Non-representations for non-representable types
+--
+------------------------------------------------------------------------------
+
+
+-- | Constructs a non-representation for a non-representable type
+mkNoRepType :: String -> DataType
+mkNoRepType str = DataType
+                        { tycon   = str
+                        , datarep = NoRep
+                        }
+
+-- | Test for a non-representable type
+isNorepType :: DataType -> Bool
+isNorepType dt = case datarep dt of
+                   NoRep -> True
+                   _ -> False
+
+
+
+------------------------------------------------------------------------------
+--
+--      Convenience for qualified type constructors
+--
+------------------------------------------------------------------------------
+
+
+-- | Gets the unqualified type constructor:
+-- drop *.*.*... before name
+--
+tyconUQname :: String -> String
+tyconUQname x = let x' = dropWhile (not . (==) '.') x
+                 in if x' == [] then x else tyconUQname (tail x')
+
+
+-- | Gets the module of a type constructor:
+-- take *.*.*... before name
+tyconModule :: String -> String
+tyconModule x = let (a,b) = break ((==) '.') x
+                 in if b == ""
+                      then b
+                      else a ++ tyconModule' (tail b)
+  where
+    tyconModule' y = let y' = tyconModule y
+                      in if y' == "" then "" else ('.':y')
+
+
+
+
+------------------------------------------------------------------------------
+------------------------------------------------------------------------------
+--
+--      Instances of the Data class for Prelude-like types.
+--      We define top-level definitions for representations.
+--
+------------------------------------------------------------------------------
+
+
+falseConstr :: Constr
+falseConstr  = mkConstr boolDataType "False" [] Prefix
+trueConstr :: Constr
+trueConstr   = mkConstr boolDataType "True"  [] Prefix
+
+boolDataType :: DataType
+boolDataType = mkDataType "Prelude.Bool" [falseConstr,trueConstr]
+
+instance Data Bool where
+  toConstr False = falseConstr
+  toConstr True  = trueConstr
+  gunfold _ z c  = case constrIndex c of
+                     1 -> z False
+                     2 -> z True
+                     _ -> error $ "Data.Data.gunfold: Constructor "
+                                  ++ show c
+                                  ++ " is not of type Bool."
+  dataTypeOf _ = boolDataType
+
+
+------------------------------------------------------------------------------
+
+charType :: DataType
+charType = mkCharType "Prelude.Char"
+
+instance Data Char where
+  toConstr x = mkCharConstr charType x
+  gunfold _ z c = case constrRep c of
+                    (CharConstr x) -> z x
+                    _ -> error $ "Data.Data.gunfold: Constructor " ++ show c
+                                 ++ " is not of type Char."
+  dataTypeOf _ = charType
+
+
+------------------------------------------------------------------------------
+
+floatType :: DataType
+floatType = mkFloatType "Prelude.Float"
+
+instance Data Float where
+  toConstr = mkRealConstr floatType
+  gunfold _ z c = case constrRep c of
+                    (FloatConstr x) -> z (realToFrac x)
+                    _ -> error $ "Data.Data.gunfold: Constructor " ++ show c
+                                 ++ " is not of type Float."
+  dataTypeOf _ = floatType
+
+
+------------------------------------------------------------------------------
+
+doubleType :: DataType
+doubleType = mkFloatType "Prelude.Double"
+
+instance Data Double where
+  toConstr = mkRealConstr doubleType
+  gunfold _ z c = case constrRep c of
+                    (FloatConstr x) -> z (realToFrac x)
+                    _ -> error $ "Data.Data.gunfold: Constructor " ++ show c
+                                 ++ " is not of type Double."
+  dataTypeOf _ = doubleType
+
+
+------------------------------------------------------------------------------
+
+intType :: DataType
+intType = mkIntType "Prelude.Int"
+
+instance Data Int where
+  toConstr x = mkIntegralConstr intType x
+  gunfold _ z c = case constrRep c of
+                    (IntConstr x) -> z (fromIntegral x)
+                    _ -> error $ "Data.Data.gunfold: Constructor " ++ show c
+                                 ++ " is not of type Int."
+  dataTypeOf _ = intType
+
+
+------------------------------------------------------------------------------
+
+integerType :: DataType
+integerType = mkIntType "Prelude.Integer"
+
+instance Data Integer where
+  toConstr = mkIntegralConstr integerType
+  gunfold _ z c = case constrRep c of
+                    (IntConstr x) -> z x
+                    _ -> error $ "Data.Data.gunfold: Constructor " ++ show c
+                                 ++ " is not of type Integer."
+  dataTypeOf _ = integerType
+
+
+------------------------------------------------------------------------------
+
+int8Type :: DataType
+int8Type = mkIntType "Data.Int.Int8"
+
+instance Data Int8 where
+  toConstr x = mkIntegralConstr int8Type x
+  gunfold _ z c = case constrRep c of
+                    (IntConstr x) -> z (fromIntegral x)
+                    _ -> error $ "Data.Data.gunfold: Constructor " ++ show c
+                                 ++ " is not of type Int8."
+  dataTypeOf _ = int8Type
+
+
+------------------------------------------------------------------------------
+
+int16Type :: DataType
+int16Type = mkIntType "Data.Int.Int16"
+
+instance Data Int16 where
+  toConstr x = mkIntegralConstr int16Type x
+  gunfold _ z c = case constrRep c of
+                    (IntConstr x) -> z (fromIntegral x)
+                    _ -> error $ "Data.Data.gunfold: Constructor " ++ show c
+                                 ++ " is not of type Int16."
+  dataTypeOf _ = int16Type
+
+
+------------------------------------------------------------------------------
+
+int32Type :: DataType
+int32Type = mkIntType "Data.Int.Int32"
+
+instance Data Int32 where
+  toConstr x = mkIntegralConstr int32Type x
+  gunfold _ z c = case constrRep c of
+                    (IntConstr x) -> z (fromIntegral x)
+                    _ -> error $ "Data.Data.gunfold: Constructor " ++ show c
+                                 ++ " is not of type Int32."
+  dataTypeOf _ = int32Type
+
+
+------------------------------------------------------------------------------
+
+int64Type :: DataType
+int64Type = mkIntType "Data.Int.Int64"
+
+instance Data Int64 where
+  toConstr x = mkIntegralConstr int64Type x
+  gunfold _ z c = case constrRep c of
+                    (IntConstr x) -> z (fromIntegral x)
+                    _ -> error $ "Data.Data.gunfold: Constructor " ++ show c
+                                 ++ " is not of type Int64."
+  dataTypeOf _ = int64Type
+
+
+------------------------------------------------------------------------------
+
+wordType :: DataType
+wordType = mkIntType "Data.Word.Word"
+
+instance Data Word where
+  toConstr x = mkIntegralConstr wordType x
+  gunfold _ z c = case constrRep c of
+                    (IntConstr x) -> z (fromIntegral x)
+                    _ -> error $ "Data.Data.gunfold: Constructor " ++ show c
+                                 ++ " is not of type Word"
+  dataTypeOf _ = wordType
+
+
+------------------------------------------------------------------------------
+
+word8Type :: DataType
+word8Type = mkIntType "Data.Word.Word8"
+
+instance Data Word8 where
+  toConstr x = mkIntegralConstr word8Type x
+  gunfold _ z c = case constrRep c of
+                    (IntConstr x) -> z (fromIntegral x)
+                    _ -> error $ "Data.Data.gunfold: Constructor " ++ show c
+                                 ++ " is not of type Word8."
+  dataTypeOf _ = word8Type
+
+
+------------------------------------------------------------------------------
+
+word16Type :: DataType
+word16Type = mkIntType "Data.Word.Word16"
+
+instance Data Word16 where
+  toConstr x = mkIntegralConstr word16Type x
+  gunfold _ z c = case constrRep c of
+                    (IntConstr x) -> z (fromIntegral x)
+                    _ -> error $ "Data.Data.gunfold: Constructor " ++ show c
+                                 ++ " is not of type Word16."
+  dataTypeOf _ = word16Type
+
+
+------------------------------------------------------------------------------
+
+word32Type :: DataType
+word32Type = mkIntType "Data.Word.Word32"
+
+instance Data Word32 where
+  toConstr x = mkIntegralConstr word32Type x
+  gunfold _ z c = case constrRep c of
+                    (IntConstr x) -> z (fromIntegral x)
+                    _ -> error $ "Data.Data.gunfold: Constructor " ++ show c
+                                 ++ " is not of type Word32."
+  dataTypeOf _ = word32Type
+
+
+------------------------------------------------------------------------------
+
+word64Type :: DataType
+word64Type = mkIntType "Data.Word.Word64"
+
+instance Data Word64 where
+  toConstr x = mkIntegralConstr word64Type x
+  gunfold _ z c = case constrRep c of
+                    (IntConstr x) -> z (fromIntegral x)
+                    _ -> error $ "Data.Data.gunfold: Constructor " ++ show c
+                                 ++ " is not of type Word64."
+  dataTypeOf _ = word64Type
+
+
+------------------------------------------------------------------------------
+
+ratioConstr :: Constr
+ratioConstr = mkConstr ratioDataType ":%" [] Infix
+
+ratioDataType :: DataType
+ratioDataType = mkDataType "GHC.Real.Ratio" [ratioConstr]
+
+instance (Data a, Integral a) => Data (Ratio a) where
+  gfoldl k z (a :% b) = z (:%) `k` a `k` b
+  toConstr _ = ratioConstr
+  gunfold k z c | constrIndex c == 1 = k (k (z (:%)))
+  gunfold _ _ _ = error "Data.Data.gunfold(Ratio)"
+  dataTypeOf _  = ratioDataType
+
+
+------------------------------------------------------------------------------
+
+nilConstr :: Constr
+nilConstr    = mkConstr listDataType "[]" [] Prefix
+consConstr :: Constr
+consConstr   = mkConstr listDataType "(:)" [] Infix
+
+listDataType :: DataType
+listDataType = mkDataType "Prelude.[]" [nilConstr,consConstr]
+
+instance Data a => Data [a] where
+  gfoldl _ z []     = z []
+  gfoldl f z (x:xs) = z (:) `f` x `f` xs
+  toConstr []    = nilConstr
+  toConstr (_:_) = consConstr
+  gunfold k z c = case constrIndex c of
+                    1 -> z []
+                    2 -> k (k (z (:)))
+                    _ -> error "Data.Data.gunfold(List)"
+  dataTypeOf _ = listDataType
+  dataCast1 f  = gcast1 f
+
+--
+-- The gmaps are given as an illustration.
+-- This shows that the gmaps for lists are different from list maps.
+--
+  gmapT  _   []     = []
+  gmapT  f   (x:xs) = (f x:f xs)
+  gmapQ  _   []     = []
+  gmapQ  f   (x:xs) = [f x,f xs]
+  gmapM  _   []     = return []
+  gmapM  f   (x:xs) = f x >>= \x' -> f xs >>= \xs' -> return (x':xs')
+
+
+------------------------------------------------------------------------------
+
+nothingConstr :: Constr
+nothingConstr = mkConstr maybeDataType "Nothing" [] Prefix
+justConstr :: Constr
+justConstr    = mkConstr maybeDataType "Just"    [] Prefix
+
+maybeDataType :: DataType
+maybeDataType = mkDataType "Prelude.Maybe" [nothingConstr,justConstr]
+
+instance Data a => Data (Maybe a) where
+  gfoldl _ z Nothing  = z Nothing
+  gfoldl f z (Just x) = z Just `f` x
+  toConstr Nothing  = nothingConstr
+  toConstr (Just _) = justConstr
+  gunfold k z c = case constrIndex c of
+                    1 -> z Nothing
+                    2 -> k (z Just)
+                    _ -> error "Data.Data.gunfold(Maybe)"
+  dataTypeOf _ = maybeDataType
+  dataCast1 f  = gcast1 f
+
+
+------------------------------------------------------------------------------
+
+ltConstr :: Constr
+ltConstr         = mkConstr orderingDataType "LT" [] Prefix
+eqConstr :: Constr
+eqConstr         = mkConstr orderingDataType "EQ" [] Prefix
+gtConstr :: Constr
+gtConstr         = mkConstr orderingDataType "GT" [] Prefix
+
+orderingDataType :: DataType
+orderingDataType = mkDataType "Prelude.Ordering" [ltConstr,eqConstr,gtConstr]
+
+instance Data Ordering where
+  gfoldl _ z LT  = z LT
+  gfoldl _ z EQ  = z EQ
+  gfoldl _ z GT  = z GT
+  toConstr LT  = ltConstr
+  toConstr EQ  = eqConstr
+  toConstr GT  = gtConstr
+  gunfold _ z c = case constrIndex c of
+                    1 -> z LT
+                    2 -> z EQ
+                    3 -> z GT
+                    _ -> error "Data.Data.gunfold(Ordering)"
+  dataTypeOf _ = orderingDataType
+
+
+------------------------------------------------------------------------------
+
+leftConstr :: Constr
+leftConstr     = mkConstr eitherDataType "Left"  [] Prefix
+
+rightConstr :: Constr
+rightConstr    = mkConstr eitherDataType "Right" [] Prefix
+
+eitherDataType :: DataType
+eitherDataType = mkDataType "Prelude.Either" [leftConstr,rightConstr]
+
+instance (Data a, Data b) => Data (Either a b) where
+  gfoldl f z (Left a)   = z Left  `f` a
+  gfoldl f z (Right a)  = z Right `f` a
+  toConstr (Left _)  = leftConstr
+  toConstr (Right _) = rightConstr
+  gunfold k z c = case constrIndex c of
+                    1 -> k (z Left)
+                    2 -> k (z Right)
+                    _ -> error "Data.Data.gunfold(Either)"
+  dataTypeOf _ = eitherDataType
+  dataCast2 f  = gcast2 f
+
+
+------------------------------------------------------------------------------
+
+tuple0Constr :: Constr
+tuple0Constr = mkConstr tuple0DataType "()" [] Prefix
+
+tuple0DataType :: DataType
+tuple0DataType = mkDataType "Prelude.()" [tuple0Constr]
+
+instance Data () where
+  toConstr ()   = tuple0Constr
+  gunfold _ z c | constrIndex c == 1 = z ()
+  gunfold _ _ _ = error "Data.Data.gunfold(unit)"
+  dataTypeOf _  = tuple0DataType
+
+
+------------------------------------------------------------------------------
+
+tuple2Constr :: Constr
+tuple2Constr = mkConstr tuple2DataType "(,)" [] Infix
+
+tuple2DataType :: DataType
+tuple2DataType = mkDataType "Prelude.(,)" [tuple2Constr]
+
+instance (Data a, Data b) => Data (a,b) where
+  gfoldl f z (a,b) = z (,) `f` a `f` b
+  toConstr (_,_) = tuple2Constr
+  gunfold k z c | constrIndex c == 1 = k (k (z (,)))
+  gunfold _ _ _ = error "Data.Data.gunfold(tup2)"
+  dataTypeOf _  = tuple2DataType
+  dataCast2 f   = gcast2 f
+
+
+------------------------------------------------------------------------------
+
+tuple3Constr :: Constr
+tuple3Constr = mkConstr tuple3DataType "(,,)" [] Infix
+
+tuple3DataType :: DataType
+tuple3DataType = mkDataType "Prelude.(,,)" [tuple3Constr]
+
+instance (Data a, Data b, Data c) => Data (a,b,c) where
+  gfoldl f z (a,b,c) = z (,,) `f` a `f` b `f` c
+  toConstr (_,_,_) = tuple3Constr
+  gunfold k z c | constrIndex c == 1 = k (k (k (z (,,))))
+  gunfold _ _ _ = error "Data.Data.gunfold(tup3)"
+  dataTypeOf _  = tuple3DataType
+
+
+------------------------------------------------------------------------------
+
+tuple4Constr :: Constr
+tuple4Constr = mkConstr tuple4DataType "(,,,)" [] Infix
+
+tuple4DataType :: DataType
+tuple4DataType = mkDataType "Prelude.(,,,)" [tuple4Constr]
+
+instance (Data a, Data b, Data c, Data d)
+         => Data (a,b,c,d) where
+  gfoldl f z (a,b,c,d) = z (,,,) `f` a `f` b `f` c `f` d
+  toConstr (_,_,_,_) = tuple4Constr
+  gunfold k z c = case constrIndex c of
+                    1 -> k (k (k (k (z (,,,)))))
+                    _ -> error "Data.Data.gunfold(tup4)"
+  dataTypeOf _ = tuple4DataType
+
+
+------------------------------------------------------------------------------
+
+tuple5Constr :: Constr
+tuple5Constr = mkConstr tuple5DataType "(,,,,)" [] Infix
+
+tuple5DataType :: DataType
+tuple5DataType = mkDataType "Prelude.(,,,,)" [tuple5Constr]
+
+instance (Data a, Data b, Data c, Data d, Data e)
+         => Data (a,b,c,d,e) where
+  gfoldl f z (a,b,c,d,e) = z (,,,,) `f` a `f` b `f` c `f` d `f` e
+  toConstr (_,_,_,_,_) = tuple5Constr
+  gunfold k z c = case constrIndex c of
+                    1 -> k (k (k (k (k (z (,,,,))))))
+                    _ -> error "Data.Data.gunfold(tup5)"
+  dataTypeOf _ = tuple5DataType
+
+
+------------------------------------------------------------------------------
+
+tuple6Constr :: Constr
+tuple6Constr = mkConstr tuple6DataType "(,,,,,)" [] Infix
+
+tuple6DataType :: DataType
+tuple6DataType = mkDataType "Prelude.(,,,,,)" [tuple6Constr]
+
+instance (Data a, Data b, Data c, Data d, Data e, Data f)
+         => Data (a,b,c,d,e,f) where
+  gfoldl f z (a,b,c,d,e,f') = z (,,,,,) `f` a `f` b `f` c `f` d `f` e `f` f'
+  toConstr (_,_,_,_,_,_) = tuple6Constr
+  gunfold k z c = case constrIndex c of
+                    1 -> k (k (k (k (k (k (z (,,,,,)))))))
+                    _ -> error "Data.Data.gunfold(tup6)"
+  dataTypeOf _ = tuple6DataType
+
+
+------------------------------------------------------------------------------
+
+tuple7Constr :: Constr
+tuple7Constr = mkConstr tuple7DataType "(,,,,,,)" [] Infix
+
+tuple7DataType :: DataType
+tuple7DataType = mkDataType "Prelude.(,,,,,,)" [tuple7Constr]
+
+instance (Data a, Data b, Data c, Data d, Data e, Data f, Data g)
+         => Data (a,b,c,d,e,f,g) where
+  gfoldl f z (a,b,c,d,e,f',g) =
+    z (,,,,,,) `f` a `f` b `f` c `f` d `f` e `f` f' `f` g
+  toConstr  (_,_,_,_,_,_,_) = tuple7Constr
+  gunfold k z c = case constrIndex c of
+                    1 -> k (k (k (k (k (k (k (z (,,,,,,))))))))
+                    _ -> error "Data.Data.gunfold(tup7)"
+  dataTypeOf _ = tuple7DataType
+
+
+------------------------------------------------------------------------------
+
+instance (Data a, Typeable a) => Data (Ptr a) where
+  toConstr _   = error "Data.Data.toConstr(Ptr)"
+  gunfold _ _  = error "Data.Data.gunfold(Ptr)"
+  dataTypeOf _ = mkNoRepType "GHC.Ptr.Ptr"
+  dataCast1 x  = gcast1 x
+
+------------------------------------------------------------------------------
+
+instance (Data a, Typeable a) => Data (ForeignPtr a) where
+  toConstr _   = error "Data.Data.toConstr(ForeignPtr)"
+  gunfold _ _  = error "Data.Data.gunfold(ForeignPtr)"
+  dataTypeOf _ = mkNoRepType "GHC.ForeignPtr.ForeignPtr"
+  dataCast1 x  = gcast1 x
+
+------------------------------------------------------------------------------
+-- The Data instance for Array preserves data abstraction at the cost of 
+-- inefficiency. We omit reflection services for the sake of data abstraction.
+instance (Typeable a, Data a, Data b, Ix a) => Data (Array a b)
+ where
+  gfoldl f z a = z (listArray (bounds a)) `f` (elems a)
+  toConstr _   = error "Data.Data.toConstr(Array)"
+  gunfold _ _  = error "Data.Data.gunfold(Array)"
+  dataTypeOf _ = mkNoRepType "Data.Array.Array"
+  dataCast2 x  = gcast2 x
+
+----------------------------------------------------------------------------
+-- Data instance for Proxy
+
+proxyConstr :: Constr
+proxyConstr = mkConstr proxyDataType "Proxy" [] Prefix
+
+proxyDataType :: DataType
+proxyDataType = mkDataType "Data.Proxy.Proxy" [proxyConstr]
+
+instance (Data t) => Data (Proxy t) where
+  gfoldl _ z Proxy  = z Proxy
+  toConstr Proxy  = proxyConstr
+  gunfold _ z c = case constrIndex c of
+                    1 -> z Proxy
+                    _ -> error "Data.Data.gunfold(Proxy)"
+  dataTypeOf _ = proxyDataType
+  dataCast1 f  = gcast1 f
+
+-----------------------------------------------------------------------
+-- instance for (:~:)
+
+reflConstr :: Constr
+reflConstr = mkConstr equalityDataType "Refl" [] Prefix
+
+equalityDataType :: DataType
+equalityDataType = mkDataType "Data.Type.Equality.(:~:)" [reflConstr]
+
+instance (a ~ b, Data a) => Data (a :~: b) where
+  gfoldl _ z Refl = z Refl
+  toConstr Refl   = reflConstr
+  gunfold _ z c   = case constrIndex c of
+                      1 -> z Refl
+                      _ -> error "Data.Data.gunfold(:~:)"
+  dataTypeOf _    = equalityDataType
+  dataCast2 f     = gcast2 f
+
+-----------------------------------------------------------------------
+-- instance for Coercion
+
+coercionConstr :: Constr
+coercionConstr = mkConstr equalityDataType "Coercion" [] Prefix
+
+coercionDataType :: DataType
+coercionDataType = mkDataType "Data.Type.Coercion.Coercion" [coercionConstr]
+
+instance (Coercible a b, Data a, Data b) => Data (Coercion a b) where
+  gfoldl _ z Coercion = z Coercion
+  toConstr Coercion = coercionConstr
+  gunfold _ z c   = case constrIndex c of
+                      1 -> z Coercion
+                      _ -> error "Data.Data.gunfold(Coercion)"
+  dataTypeOf _    = coercionDataType
+  dataCast2 f     = gcast2 f
+
+-----------------------------------------------------------------------
+-- instance for Data.Version
+
+versionConstr :: Constr
+versionConstr = mkConstr versionDataType "Version" ["versionBranch","versionTags"] Prefix
+
+versionDataType :: DataType
+versionDataType = mkDataType "Data.Version.Version" [versionConstr]
+
+instance Data Version where
+  gfoldl k z (Version bs ts) = z Version `k` bs `k` ts
+  toConstr (Version _ _) = versionConstr
+  gunfold k z c = case constrIndex c of
+                    1 -> k (k (z Version))
+                    _ -> error "Data.Data.gunfold(Version)"
+  dataTypeOf _  = versionDataType
diff --git a/libraries/base/Data/Dynamic.hs b/libraries/base/Data/Dynamic.hs
new file mode 100644
index 000000000000..50bea62e1a3a
--- /dev/null
+++ b/libraries/base/Data/Dynamic.hs
@@ -0,0 +1,145 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE AutoDeriveTypeable, StandaloneDeriving #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.Dynamic
+-- Copyright   :  (c) The University of Glasgow 2001
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+-- 
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  experimental
+-- Portability :  portable
+--
+-- The Dynamic interface provides basic support for dynamic types.
+-- 
+-- Operations for injecting values of arbitrary type into
+-- a dynamically typed value, Dynamic, are provided, together
+-- with operations for converting dynamic values into a concrete
+-- (monomorphic) type.
+-- 
+-----------------------------------------------------------------------------
+
+module Data.Dynamic
+  (
+
+        -- Module Data.Typeable re-exported for convenience
+        module Data.Typeable,
+
+        -- * The @Dynamic@ type
+        Dynamic,        -- abstract, instance of: Show, Typeable
+
+        -- * Converting to and from @Dynamic@
+        toDyn,
+        fromDyn,
+        fromDynamic,
+        
+        -- * Applying functions of dynamic type
+        dynApply,
+        dynApp,
+        dynTypeRep
+
+  ) where
+
+
+import Data.Typeable
+import Data.Maybe
+import Unsafe.Coerce
+
+import GHC.Base
+import GHC.Show
+import GHC.Exception
+
+-------------------------------------------------------------
+--
+--              The type Dynamic
+--
+-------------------------------------------------------------
+
+{-|
+  A value of type 'Dynamic' is an object encapsulated together with its type.
+
+  A 'Dynamic' may only represent a monomorphic value; an attempt to
+  create a value of type 'Dynamic' from a polymorphically-typed
+  expression will result in an ambiguity error (see 'toDyn').
+
+  'Show'ing a value of type 'Dynamic' returns a pretty-printed representation
+  of the object\'s type; useful for debugging.
+-}
+data Dynamic = Dynamic TypeRep Obj
+               deriving Typeable
+
+instance Show Dynamic where
+   -- the instance just prints the type representation.
+   showsPrec _ (Dynamic t _) = 
+          showString "<<" . 
+          showsPrec 0 t   . 
+          showString ">>"
+
+-- here so that it isn't an orphan:
+instance Exception Dynamic
+
+type Obj = Any
+ -- Use GHC's primitive 'Any' type to hold the dynamically typed value.
+ --
+ -- In GHC's new eval/apply execution model this type must not look
+ -- like a data type.  If it did, GHC would use the constructor convention 
+ -- when evaluating it, and this will go wrong if the object is really a 
+ -- function.  Using Any forces GHC to use
+ -- a fallback convention for evaluating it that works for all types.
+
+-- | Converts an arbitrary value into an object of type 'Dynamic'.  
+--
+-- The type of the object must be an instance of 'Typeable', which
+-- ensures that only monomorphically-typed objects may be converted to
+-- 'Dynamic'.  To convert a polymorphic object into 'Dynamic', give it
+-- a monomorphic type signature.  For example:
+--
+-- >    toDyn (id :: Int -> Int)
+--
+toDyn :: Typeable a => a -> Dynamic
+toDyn v = Dynamic (typeOf v) (unsafeCoerce v)
+
+-- | Converts a 'Dynamic' object back into an ordinary Haskell value of
+-- the correct type.  See also 'fromDynamic'.
+fromDyn :: Typeable a
+        => Dynamic      -- ^ the dynamically-typed object
+        -> a            -- ^ a default value 
+        -> a            -- ^ returns: the value of the first argument, if
+                        -- it has the correct type, otherwise the value of
+                        -- the second argument.
+fromDyn (Dynamic t v) def
+  | typeOf def == t = unsafeCoerce v
+  | otherwise       = def
+
+-- | Converts a 'Dynamic' object back into an ordinary Haskell value of
+-- the correct type.  See also 'fromDyn'.
+fromDynamic
+        :: Typeable a
+        => Dynamic      -- ^ the dynamically-typed object
+        -> Maybe a      -- ^ returns: @'Just' a@, if the dynamically-typed
+                        -- object has the correct type (and @a@ is its value), 
+                        -- or 'Nothing' otherwise.
+fromDynamic (Dynamic t v) =
+  case unsafeCoerce v of 
+    r | t == typeOf r -> Just r
+      | otherwise     -> Nothing
+
+-- (f::(a->b)) `dynApply` (x::a) = (f a)::b
+dynApply :: Dynamic -> Dynamic -> Maybe Dynamic
+dynApply (Dynamic t1 f) (Dynamic t2 x) =
+  case funResultTy t1 t2 of
+    Just t3 -> Just (Dynamic t3 ((unsafeCoerce f) x))
+    Nothing -> Nothing
+
+dynApp :: Dynamic -> Dynamic -> Dynamic
+dynApp f x = case dynApply f x of 
+             Just r -> r
+             Nothing -> error ("Type error in dynamic application.\n" ++
+                               "Can't apply function " ++ show f ++
+                               " to argument " ++ show x)
+
+dynTypeRep :: Dynamic -> TypeRep
+dynTypeRep (Dynamic tr _) = tr 
+
diff --git a/libraries/base/Data/Either.hs b/libraries/base/Data/Either.hs
new file mode 100644
index 000000000000..9abb20522ce0
--- /dev/null
+++ b/libraries/base/Data/Either.hs
@@ -0,0 +1,123 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE AutoDeriveTypeable, StandaloneDeriving #-}
+{-# LANGUAGE PolyKinds, DataKinds, TypeFamilies, TypeOperators, UndecidableInstances #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.Either
+-- Copyright   :  (c) The University of Glasgow 2001
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+-- 
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  experimental
+-- Portability :  portable
+--
+-- The Either type, and associated operations.
+--
+-----------------------------------------------------------------------------
+
+module Data.Either (
+   Either(..),
+   either,
+   lefts,
+   rights,
+   isLeft,
+   isRight,
+   partitionEithers,
+ ) where
+
+import GHC.Base
+import GHC.Show
+import GHC.Read
+
+import Data.Typeable
+import Data.Type.Equality
+
+{-
+-- just for testing
+import Test.QuickCheck
+-}
+
+{-|
+
+The 'Either' type represents values with two possibilities: a value of
+type @'Either' a b@ is either @'Left' a@ or @'Right' b@.
+
+The 'Either' type is sometimes used to represent a value which is
+either correct or an error; by convention, the 'Left' constructor is
+used to hold an error value and the 'Right' constructor is used to
+hold a correct value (mnemonic: \"right\" also means \"correct\").
+-}
+data  Either a b  =  Left a | Right b
+  deriving (Eq, Ord, Read, Show, Typeable)
+
+instance Functor (Either a) where
+    fmap _ (Left x) = Left x
+    fmap f (Right y) = Right (f y)
+
+instance Monad (Either e) where
+    return = Right
+    Left  l >>= _ = Left l
+    Right r >>= k = k r
+
+-- | Case analysis for the 'Either' type.
+-- If the value is @'Left' a@, apply the first function to @a@;
+-- if it is @'Right' b@, apply the second function to @b@.
+either                  :: (a -> c) -> (b -> c) -> Either a b -> c
+either f _ (Left x)     =  f x
+either _ g (Right y)    =  g y
+
+-- | Extracts from a list of 'Either' all the 'Left' elements
+-- All the 'Left' elements are extracted in order.
+
+lefts   :: [Either a b] -> [a]
+lefts x = [a | Left a <- x]
+
+-- | Extracts from a list of 'Either' all the 'Right' elements
+-- All the 'Right' elements are extracted in order.
+
+rights   :: [Either a b] -> [b]
+rights x = [a | Right a <- x]
+
+-- | Partitions a list of 'Either' into two lists
+-- All the 'Left' elements are extracted, in order, to the first
+-- component of the output.  Similarly the 'Right' elements are extracted
+-- to the second component of the output.
+
+partitionEithers :: [Either a b] -> ([a],[b])
+partitionEithers = foldr (either left right) ([],[])
+ where
+  left  a ~(l, r) = (a:l, r)
+  right a ~(l, r) = (l, a:r)
+
+-- | Return `True` if the given value is a `Left`-value, `False` otherwise.
+--
+-- /Since: 4.7.0.0/
+isLeft :: Either a b -> Bool
+isLeft (Left  _) = True
+isLeft (Right _) = False
+
+-- | Return `True` if the given value is a `Right`-value, `False` otherwise.
+--
+-- /Since: 4.7.0.0/
+isRight :: Either a b -> Bool
+isRight (Left  _) = False
+isRight (Right _) = True
+
+-- instance for the == Boolean type-level equality operator
+type family EqEither a b where
+  EqEither (Left x)  (Left y)  = x == y
+  EqEither (Right x) (Right y) = x == y
+  EqEither a         b         = False
+type instance a == b = EqEither a b
+
+{-
+{--------------------------------------------------------------------
+  Testing
+--------------------------------------------------------------------}
+prop_partitionEithers :: [Either Int Int] -> Bool
+prop_partitionEithers x =
+  partitionEithers x == (lefts x, rights x)
+-}
+
diff --git a/libraries/base/Data/Eq.hs b/libraries/base/Data/Eq.hs
new file mode 100644
index 000000000000..fe487bf454d7
--- /dev/null
+++ b/libraries/base/Data/Eq.hs
@@ -0,0 +1,22 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.Eq
+-- Copyright   :  (c) The University of Glasgow 2005
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+-- 
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  stable
+-- Portability :  portable
+--
+-- Equality
+--
+-----------------------------------------------------------------------------
+
+module Data.Eq (
+   Eq(..),
+ ) where
+
+import GHC.Base
diff --git a/libraries/base/Data/Fixed.hs b/libraries/base/Data/Fixed.hs
new file mode 100644
index 000000000000..cadbb61ac1c4
--- /dev/null
+++ b/libraries/base/Data/Fixed.hs
@@ -0,0 +1,218 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE AutoDeriveTypeable #-}
+{-# OPTIONS -Wall -fno-warn-unused-binds #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.Fixed
+-- Copyright   :  (c) Ashley Yakeley 2005, 2006, 2009
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+-- 
+-- Maintainer  :  Ashley Yakeley <ashley@semantic.org>
+-- Stability   :  experimental
+-- Portability :  portable
+--
+-- This module defines a \"Fixed\" type for fixed-precision arithmetic.
+-- The parameter to Fixed is any type that's an instance of HasResolution.
+-- HasResolution has a single method that gives the resolution of the Fixed type.
+--
+-- This module also contains generalisations of div, mod, and divmod to work
+-- with any Real instance.
+--
+-----------------------------------------------------------------------------
+
+module Data.Fixed
+(
+    div',mod',divMod',
+
+    Fixed(..), HasResolution(..),
+    showFixed,
+    E0,Uni,
+    E1,Deci,
+    E2,Centi,
+    E3,Milli,
+    E6,Micro,
+    E9,Nano,
+    E12,Pico
+) where
+
+import Prelude -- necessary to get dependencies right
+import Data.Typeable
+import Data.Data
+import GHC.Read
+import Text.ParserCombinators.ReadPrec
+import Text.Read.Lex
+
+default () -- avoid any defaulting shenanigans
+
+-- | generalisation of 'div' to any instance of Real
+div' :: (Real a,Integral b) => a -> a -> b
+div' n d = floor ((toRational n) / (toRational d))
+
+-- | generalisation of 'divMod' to any instance of Real
+divMod' :: (Real a,Integral b) => a -> a -> (b,a)
+divMod' n d = (f,n - (fromIntegral f) * d) where
+    f = div' n d
+
+-- | generalisation of 'mod' to any instance of Real
+mod' :: (Real a) => a -> a -> a
+mod' n d = n - (fromInteger f) * d where
+    f = div' n d
+
+-- | The type parameter should be an instance of 'HasResolution'.
+newtype Fixed a = MkFixed Integer -- ^ /Since: 4.7.0.0/
+        deriving (Eq,Ord,Typeable)
+
+-- We do this because the automatically derived Data instance requires (Data a) context.
+-- Our manual instance has the more general (Typeable a) context.
+tyFixed :: DataType
+tyFixed = mkDataType "Data.Fixed.Fixed" [conMkFixed]
+conMkFixed :: Constr
+conMkFixed = mkConstr tyFixed "MkFixed" [] Prefix
+instance (Typeable a) => Data (Fixed a) where
+    gfoldl k z (MkFixed a) = k (z MkFixed) a
+    gunfold k z _ = k (z MkFixed)
+    dataTypeOf _ = tyFixed
+    toConstr _ = conMkFixed
+
+class HasResolution a where
+    resolution :: p a -> Integer
+
+withType :: (p a -> f a) -> f a
+withType foo = foo undefined
+
+withResolution :: (HasResolution a) => (Integer -> f a) -> f a
+withResolution foo = withType (foo . resolution)
+
+instance Enum (Fixed a) where
+    succ (MkFixed a) = MkFixed (succ a)
+    pred (MkFixed a) = MkFixed (pred a)
+    toEnum = MkFixed . toEnum
+    fromEnum (MkFixed a) = fromEnum a
+    enumFrom (MkFixed a) = fmap MkFixed (enumFrom a)
+    enumFromThen (MkFixed a) (MkFixed b) = fmap MkFixed (enumFromThen a b)
+    enumFromTo (MkFixed a) (MkFixed b) = fmap MkFixed (enumFromTo a b)
+    enumFromThenTo (MkFixed a) (MkFixed b) (MkFixed c) = fmap MkFixed (enumFromThenTo a b c)
+
+instance (HasResolution a) => Num (Fixed a) where
+    (MkFixed a) + (MkFixed b) = MkFixed (a + b)
+    (MkFixed a) - (MkFixed b) = MkFixed (a - b)
+    fa@(MkFixed a) * (MkFixed b) = MkFixed (div (a * b) (resolution fa))
+    negate (MkFixed a) = MkFixed (negate a)
+    abs (MkFixed a) = MkFixed (abs a)
+    signum (MkFixed a) = fromInteger (signum a)
+    fromInteger i = withResolution (\res -> MkFixed (i * res))
+
+instance (HasResolution a) => Real (Fixed a) where
+    toRational fa@(MkFixed a) = (toRational a) / (toRational (resolution fa))
+
+instance (HasResolution a) => Fractional (Fixed a) where
+    fa@(MkFixed a) / (MkFixed b) = MkFixed (div (a * (resolution fa)) b)
+    recip fa@(MkFixed a) = MkFixed (div (res * res) a) where
+        res = resolution fa
+    fromRational r = withResolution (\res -> MkFixed (floor (r * (toRational res))))
+
+instance (HasResolution a) => RealFrac (Fixed a) where
+    properFraction a = (i,a - (fromIntegral i)) where
+        i = truncate a
+    truncate f = truncate (toRational f)
+    round f = round (toRational f)
+    ceiling f = ceiling (toRational f)
+    floor f = floor (toRational f)
+
+chopZeros :: Integer -> String
+chopZeros 0 = ""
+chopZeros a | mod a 10 == 0 = chopZeros (div a 10)
+chopZeros a = show a
+
+-- only works for positive a
+showIntegerZeros :: Bool -> Int -> Integer -> String
+showIntegerZeros True _ 0 = ""
+showIntegerZeros chopTrailingZeros digits a = replicate (digits - length s) '0' ++ s' where
+    s = show a
+    s' = if chopTrailingZeros then chopZeros a else s
+
+withDot :: String -> String
+withDot "" = ""
+withDot s = '.':s
+
+-- | First arg is whether to chop off trailing zeros
+showFixed :: (HasResolution a) => Bool -> Fixed a -> String
+showFixed chopTrailingZeros fa@(MkFixed a) | a < 0 = "-" ++ (showFixed chopTrailingZeros (asTypeOf (MkFixed (negate a)) fa))
+showFixed chopTrailingZeros fa@(MkFixed a) = (show i) ++ (withDot (showIntegerZeros chopTrailingZeros digits fracNum)) where
+    res = resolution fa
+    (i,d) = divMod a res
+    -- enough digits to be unambiguous
+    digits = ceiling (logBase 10 (fromInteger res) :: Double)
+    maxnum = 10 ^ digits
+    fracNum = div (d * maxnum) res
+
+instance (HasResolution a) => Show (Fixed a) where
+    show = showFixed False
+
+instance (HasResolution a) => Read (Fixed a) where
+    readPrec     = readNumber convertFixed
+    readListPrec = readListPrecDefault
+    readList     = readListDefault
+
+convertFixed :: forall a . HasResolution a => Lexeme -> ReadPrec (Fixed a)
+convertFixed (Number n)
+ | Just (i, f) <- numberToFixed e n =
+    return (fromInteger i + (fromInteger f / (10 ^ e)))
+    where r = resolution (undefined :: Fixed a)
+          -- round 'e' up to help make the 'read . show == id' property
+          -- possible also for cases where 'resolution' is not a
+          -- power-of-10, such as e.g. when 'resolution = 128'
+          e = ceiling (logBase 10 (fromInteger r) :: Double)
+convertFixed _ = pfail
+
+data E0 = E0
+     deriving (Typeable)
+instance HasResolution E0 where
+    resolution _ = 1
+-- | resolution of 1, this works the same as Integer
+type Uni = Fixed E0
+
+data E1 = E1
+     deriving (Typeable)
+instance HasResolution E1 where
+    resolution _ = 10
+-- | resolution of 10^-1 = .1
+type Deci = Fixed E1
+
+data E2 = E2
+     deriving (Typeable)
+instance HasResolution E2 where
+    resolution _ = 100
+-- | resolution of 10^-2 = .01, useful for many monetary currencies
+type Centi = Fixed E2
+
+data E3 = E3
+     deriving (Typeable)
+instance HasResolution E3 where
+    resolution _ = 1000
+-- | resolution of 10^-3 = .001
+type Milli = Fixed E3
+
+data E6 = E6
+     deriving (Typeable)
+instance HasResolution E6 where
+    resolution _ = 1000000
+-- | resolution of 10^-6 = .000001
+type Micro = Fixed E6
+
+data E9 = E9
+     deriving (Typeable)
+instance HasResolution E9 where
+    resolution _ = 1000000000
+-- | resolution of 10^-9 = .000000001
+type Nano = Fixed E9
+
+data E12 = E12
+     deriving (Typeable)
+instance HasResolution E12 where
+    resolution _ = 1000000000000
+-- | resolution of 10^-12 = .000000000001
+type Pico = Fixed E12
+
diff --git a/libraries/base/Data/Foldable.hs b/libraries/base/Data/Foldable.hs
new file mode 100644
index 000000000000..0f0d5bfbf13f
--- /dev/null
+++ b/libraries/base/Data/Foldable.hs
@@ -0,0 +1,340 @@
+{-# LANGUAGE Trustworthy #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.Foldable
+-- Copyright   :  Ross Paterson 2005
+-- License     :  BSD-style (see the LICENSE file in the distribution)
+--
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  experimental
+-- Portability :  portable
+--
+-- Class of data structures that can be folded to a summary value.
+--
+-- Many of these functions generalize "Prelude", "Control.Monad" and
+-- "Data.List" functions of the same names from lists to any 'Foldable'
+-- functor.  To avoid ambiguity, either import those modules hiding
+-- these names or qualify uses of these function names with an alias
+-- for this module.
+--
+-----------------------------------------------------------------------------
+
+module Data.Foldable (
+    -- * Folds
+    Foldable(..),
+    -- ** Special biased folds
+    foldrM,
+    foldlM,
+    -- ** Folding actions
+    -- *** Applicative actions
+    traverse_,
+    for_,
+    sequenceA_,
+    asum,
+    -- *** Monadic actions
+    mapM_,
+    forM_,
+    sequence_,
+    msum,
+    -- ** Specialized folds
+    toList,
+    concat,
+    concatMap,
+    and,
+    or,
+    any,
+    all,
+    sum,
+    product,
+    maximum,
+    maximumBy,
+    minimum,
+    minimumBy,
+    -- ** Searches
+    elem,
+    notElem,
+    find
+    ) where
+
+import Prelude hiding (foldl, foldr, foldl1, foldr1, mapM_, sequence_,
+                elem, notElem, concat, concatMap, and, or, any, all,
+                sum, product, maximum, minimum)
+import qualified Prelude (foldl, foldr, foldl1, foldr1)
+import qualified Data.List as List (foldl')
+import Control.Applicative
+import Control.Monad (MonadPlus(..))
+import Data.Maybe (fromMaybe, listToMaybe)
+import Data.Monoid
+import Data.Proxy
+
+import GHC.Exts (build)
+import GHC.Arr
+
+-- | Data structures that can be folded.
+--
+-- Minimal complete definition: 'foldMap' or 'foldr'.
+--
+-- For example, given a data type
+--
+-- > data Tree a = Empty | Leaf a | Node (Tree a) a (Tree a)
+--
+-- a suitable instance would be
+--
+-- > instance Foldable Tree where
+-- >    foldMap f Empty = mempty
+-- >    foldMap f (Leaf x) = f x
+-- >    foldMap f (Node l k r) = foldMap f l `mappend` f k `mappend` foldMap f r
+--
+-- This is suitable even for abstract types, as the monoid is assumed
+-- to satisfy the monoid laws.  Alternatively, one could define @foldr@:
+--
+-- > instance Foldable Tree where
+-- >    foldr f z Empty = z
+-- >    foldr f z (Leaf x) = f x z
+-- >    foldr f z (Node l k r) = foldr f (f k (foldr f z r)) l
+--
+class Foldable t where
+    -- | Combine the elements of a structure using a monoid.
+    fold :: Monoid m => t m -> m
+    fold = foldMap id
+
+    -- | Map each element of the structure to a monoid,
+    -- and combine the results.
+    foldMap :: Monoid m => (a -> m) -> t a -> m
+    foldMap f = foldr (mappend . f) mempty
+
+    -- | Right-associative fold of a structure.
+    --
+    -- @'foldr' f z = 'Prelude.foldr' f z . 'toList'@
+    foldr :: (a -> b -> b) -> b -> t a -> b
+    foldr f z t = appEndo (foldMap (Endo . f) t) z
+
+    -- | Right-associative fold of a structure, 
+    -- but with strict application of the operator.
+    foldr' :: (a -> b -> b) -> b -> t a -> b
+    foldr' f z0 xs = foldl f' id xs z0
+      where f' k x z = k $! f x z
+
+    -- | Left-associative fold of a structure.
+    --
+    -- @'foldl' f z = 'Prelude.foldl' f z . 'toList'@
+    foldl :: (b -> a -> b) -> b -> t a -> b
+    foldl f z t = appEndo (getDual (foldMap (Dual . Endo . flip f) t)) z
+
+    -- | Left-associative fold of a structure.
+    -- but with strict application of the operator.
+    --
+    -- @'foldl' f z = 'List.foldl'' f z . 'toList'@
+    foldl' :: (b -> a -> b) -> b -> t a -> b
+    foldl' f z0 xs = foldr f' id xs z0
+      where f' x k z = k $! f z x
+
+    -- | A variant of 'foldr' that has no base case,
+    -- and thus may only be applied to non-empty structures.
+    --
+    -- @'foldr1' f = 'Prelude.foldr1' f . 'toList'@
+    foldr1 :: (a -> a -> a) -> t a -> a
+    foldr1 f xs = fromMaybe (error "foldr1: empty structure")
+                    (foldr mf Nothing xs)
+      where
+        mf x Nothing = Just x
+        mf x (Just y) = Just (f x y)
+
+    -- | A variant of 'foldl' that has no base case,
+    -- and thus may only be applied to non-empty structures.
+    --
+    -- @'foldl1' f = 'Prelude.foldl1' f . 'toList'@
+    foldl1 :: (a -> a -> a) -> t a -> a
+    foldl1 f xs = fromMaybe (error "foldl1: empty structure")
+                    (foldl mf Nothing xs)
+      where
+        mf Nothing y = Just y
+        mf (Just x) y = Just (f x y)
+    {-# MINIMAL foldMap | foldr #-}
+
+-- instances for Prelude types
+
+instance Foldable Maybe where
+    foldr _ z Nothing = z
+    foldr f z (Just x) = f x z
+
+    foldl _ z Nothing = z
+    foldl f z (Just x) = f z x
+
+instance Foldable [] where
+    foldr = Prelude.foldr
+    foldl = Prelude.foldl
+    foldl' = List.foldl'
+    foldr1 = Prelude.foldr1
+    foldl1 = Prelude.foldl1
+
+instance Foldable (Either a) where
+    foldMap _ (Left _) = mempty
+    foldMap f (Right y) = f y
+
+    foldr _ z (Left _) = z
+    foldr f z (Right y) = f y z
+
+instance Foldable ((,) a) where
+    foldMap f (_, y) = f y
+
+    foldr f z (_, y) = f y z
+
+instance Ix i => Foldable (Array i) where
+    foldr f z = Prelude.foldr f z . elems
+    foldl f z = Prelude.foldl f z . elems
+    foldr1 f = Prelude.foldr1 f . elems
+    foldl1 f = Prelude.foldl1 f . elems
+
+instance Foldable Proxy where
+    foldMap _ _ = mempty
+    {-# INLINE foldMap #-}
+    fold _ = mempty
+    {-# INLINE fold #-}
+    foldr _ z _ = z
+    {-# INLINE foldr #-}
+    foldl _ z _ = z
+    {-# INLINE foldl #-}
+    foldl1 _ _ = error "foldl1: Proxy"
+    {-# INLINE foldl1 #-}
+    foldr1 _ _ = error "foldr1: Proxy"
+    {-# INLINE foldr1 #-}
+
+instance Foldable (Const m) where
+    foldMap _ _ = mempty
+
+-- | Monadic fold over the elements of a structure,
+-- associating to the right, i.e. from right to left.
+foldrM :: (Foldable t, Monad m) => (a -> b -> m b) -> b -> t a -> m b
+foldrM f z0 xs = foldl f' return xs z0
+  where f' k x z = f x z >>= k
+
+-- | Monadic fold over the elements of a structure,
+-- associating to the left, i.e. from left to right.
+foldlM :: (Foldable t, Monad m) => (b -> a -> m b) -> b -> t a -> m b
+foldlM f z0 xs = foldr f' return xs z0
+  where f' x k z = f z x >>= k
+
+-- | Map each element of a structure to an action, evaluate
+-- these actions from left to right, and ignore the results.
+traverse_ :: (Foldable t, Applicative f) => (a -> f b) -> t a -> f ()
+traverse_ f = foldr ((*>) . f) (pure ())
+
+-- | 'for_' is 'traverse_' with its arguments flipped.
+for_ :: (Foldable t, Applicative f) => t a -> (a -> f b) -> f ()
+{-# INLINE for_ #-}
+for_ = flip traverse_
+
+-- | Map each element of a structure to a monadic action, evaluate
+-- these actions from left to right, and ignore the results.
+mapM_ :: (Foldable t, Monad m) => (a -> m b) -> t a -> m ()
+mapM_ f = foldr ((>>) . f) (return ())
+
+-- | 'forM_' is 'mapM_' with its arguments flipped.
+forM_ :: (Foldable t, Monad m) => t a -> (a -> m b) -> m ()
+{-# INLINE forM_ #-}
+forM_ = flip mapM_
+
+-- | Evaluate each action in the structure from left to right,
+-- and ignore the results.
+sequenceA_ :: (Foldable t, Applicative f) => t (f a) -> f ()
+sequenceA_ = foldr (*>) (pure ())
+
+-- | Evaluate each monadic action in the structure from left to right,
+-- and ignore the results.
+sequence_ :: (Foldable t, Monad m) => t (m a) -> m ()
+sequence_ = foldr (>>) (return ())
+
+-- | The sum of a collection of actions, generalizing 'concat'.
+asum :: (Foldable t, Alternative f) => t (f a) -> f a
+{-# INLINE asum #-}
+asum = foldr (<|>) empty
+
+-- | The sum of a collection of actions, generalizing 'concat'.
+msum :: (Foldable t, MonadPlus m) => t (m a) -> m a
+{-# INLINE msum #-}
+msum = foldr mplus mzero
+
+-- These use foldr rather than foldMap to avoid repeated concatenation.
+
+-- | List of elements of a structure.
+toList :: Foldable t => t a -> [a]
+{-# INLINE toList #-}
+toList t = build (\ c n -> foldr c n t)
+
+-- | The concatenation of all the elements of a container of lists.
+concat :: Foldable t => t [a] -> [a]
+concat = fold
+
+-- | Map a function over all the elements of a container and concatenate
+-- the resulting lists.
+concatMap :: Foldable t => (a -> [b]) -> t a -> [b]
+concatMap = foldMap
+
+-- | 'and' returns the conjunction of a container of Bools.  For the
+-- result to be 'True', the container must be finite; 'False', however,
+-- results from a 'False' value finitely far from the left end.
+and :: Foldable t => t Bool -> Bool
+and = getAll . foldMap All
+
+-- | 'or' returns the disjunction of a container of Bools.  For the
+-- result to be 'False', the container must be finite; 'True', however,
+-- results from a 'True' value finitely far from the left end.
+or :: Foldable t => t Bool -> Bool
+or = getAny . foldMap Any
+
+-- | Determines whether any element of the structure satisfies the predicate.
+any :: Foldable t => (a -> Bool) -> t a -> Bool
+any p = getAny . foldMap (Any . p)
+
+-- | Determines whether all elements of the structure satisfy the predicate.
+all :: Foldable t => (a -> Bool) -> t a -> Bool
+all p = getAll . foldMap (All . p)
+
+-- | The 'sum' function computes the sum of the numbers of a structure.
+sum :: (Foldable t, Num a) => t a -> a
+sum = getSum . foldMap Sum
+
+-- | The 'product' function computes the product of the numbers of a structure.
+product :: (Foldable t, Num a) => t a -> a
+product = getProduct . foldMap Product
+
+-- | The largest element of a non-empty structure.
+maximum :: (Foldable t, Ord a) => t a -> a
+maximum = foldr1 max
+
+-- | The largest element of a non-empty structure with respect to the
+-- given comparison function.
+maximumBy :: Foldable t => (a -> a -> Ordering) -> t a -> a
+maximumBy cmp = foldr1 max'
+  where max' x y = case cmp x y of
+                        GT -> x
+                        _  -> y
+
+-- | The least element of a non-empty structure.
+minimum :: (Foldable t, Ord a) => t a -> a
+minimum = foldr1 min
+
+-- | The least element of a non-empty structure with respect to the
+-- given comparison function.
+minimumBy :: Foldable t => (a -> a -> Ordering) -> t a -> a
+minimumBy cmp = foldr1 min'
+  where min' x y = case cmp x y of
+                        GT -> y
+                        _  -> x
+
+-- | Does the element occur in the structure?
+elem :: (Foldable t, Eq a) => a -> t a -> Bool
+elem = any . (==)
+
+-- | 'notElem' is the negation of 'elem'.
+notElem :: (Foldable t, Eq a) => a -> t a -> Bool
+notElem x = not . elem x
+
+-- | The 'find' function takes a predicate and a structure and returns
+-- the leftmost element of the structure matching the predicate, or
+-- 'Nothing' if there is no such element.
+find :: Foldable t => (a -> Bool) -> t a -> Maybe a
+find p = listToMaybe . concatMap (\ x -> if p x then [x] else [])
+
diff --git a/libraries/base/Data/Function.hs b/libraries/base/Data/Function.hs
new file mode 100644
index 000000000000..afb6e5693ad8
--- /dev/null
+++ b/libraries/base/Data/Function.hs
@@ -0,0 +1,99 @@
+{-# LANGUAGE Safe #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.Function
+-- Copyright   :  Nils Anders Danielsson 2006
+--             ,  Alexander Berntsen     2014
+-- License     :  BSD-style (see the LICENSE file in the distribution)
+--
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  experimental
+-- Portability :  portable
+--
+-- Simple combinators working solely on and with functions.
+--
+-----------------------------------------------------------------------------
+
+module Data.Function
+  ( -- * "Prelude" re-exports
+    id, const, (.), flip, ($)
+    -- * Other combinators
+  , (&)
+  , fix
+  , on
+  ) where
+
+import Prelude
+
+infixl 0 `on`
+infixl 1 &
+
+-- | @'fix' f@ is the least fixed point of the function @f@,
+-- i.e. the least defined @x@ such that @f x = x@.
+fix :: (a -> a) -> a
+fix f = let x = f x in x
+
+-- | @(*) \`on\` f = \\x y -> f x * f y@.
+--
+-- Typical usage: @'Data.List.sortBy' ('compare' \`on\` 'fst')@.
+--
+-- Algebraic properties:
+--
+-- * @(*) \`on\` 'id' = (*)@ (if @(*) &#x2209; {&#x22a5;, 'const' &#x22a5;}@)
+--
+-- * @((*) \`on\` f) \`on\` g = (*) \`on\` (f . g)@
+--
+-- * @'flip' on f . 'flip' on g = 'flip' on (g . f)@
+
+-- Proofs (so that I don't have to edit the test-suite):
+
+--   (*) `on` id
+-- =
+--   \x y -> id x * id y
+-- =
+--   \x y -> x * y
+-- = { If (*) /= _|_ or const _|_. }
+--   (*)
+
+--   (*) `on` f `on` g
+-- =
+--   ((*) `on` f) `on` g
+-- =
+--   \x y -> ((*) `on` f) (g x) (g y)
+-- =
+--   \x y -> (\x y -> f x * f y) (g x) (g y)
+-- =
+--   \x y -> f (g x) * f (g y)
+-- =
+--   \x y -> (f . g) x * (f . g) y
+-- =
+--   (*) `on` (f . g)
+-- =
+--   (*) `on` f . g
+
+--   flip on f . flip on g
+-- =
+--   (\h (*) -> (*) `on` h) f . (\h (*) -> (*) `on` h) g
+-- =
+--   (\(*) -> (*) `on` f) . (\(*) -> (*) `on` g)
+-- =
+--   \(*) -> (*) `on` g `on` f
+-- = { See above. }
+--   \(*) -> (*) `on` g . f
+-- =
+--   (\h (*) -> (*) `on` h) (g . f)
+-- =
+--   flip on (g . f)
+
+on :: (b -> b -> c) -> (a -> b) -> a -> a -> c
+(.*.) `on` f = \x y -> f x .*. f y
+
+
+-- | '&' is a reverse application operator.  This provides notational
+-- convenience.  Its precedence is one higher than that of the forward
+-- application operator '$', which allows '&' to be nested in '$'.
+--
+-- /Since: 4.7.1.0/
+(&) :: a -> (a -> b) -> b
+x & f = f x
diff --git a/libraries/base/Data/Functor.hs b/libraries/base/Data/Functor.hs
new file mode 100644
index 000000000000..1869b1604a15
--- /dev/null
+++ b/libraries/base/Data/Functor.hs
@@ -0,0 +1,41 @@
+{-# LANGUAGE Trustworthy #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.Functor
+-- Copyright   :  (c) The University of Glasgow 2001
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+-- 
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  provisional
+-- Portability :  portable
+--
+-- Functors: uniform action over a parameterized type, generalizing the
+-- 'map' function on lists.
+
+module Data.Functor
+    (
+      Functor(fmap),
+      (<$),
+      ($>),
+      (<$>),
+      void,
+    ) where
+
+import Control.Monad
+import GHC.Base (Functor(..))
+
+infixl 4 <$>
+
+-- | An infix synonym for 'fmap'.
+(<$>) :: Functor f => (a -> b) -> f a -> f b
+(<$>) = fmap
+
+infixl 4 $>
+
+-- | Flipped version of '<$'.
+--
+-- /Since: 4.7.0.0/
+($>) :: Functor f => f a -> b -> f b
+($>) = flip (<$)
+
diff --git a/libraries/base/Data/IORef.hs b/libraries/base/Data/IORef.hs
new file mode 100644
index 000000000000..0e5717cb7c46
--- /dev/null
+++ b/libraries/base/Data/IORef.hs
@@ -0,0 +1,162 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE CPP, NoImplicitPrelude, MagicHash, UnboxedTuples #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.IORef
+-- Copyright   :  (c) The University of Glasgow 2001
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+-- 
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  experimental
+-- Portability :  portable
+--
+-- Mutable references in the IO monad.
+--
+-----------------------------------------------------------------------------
+
+module Data.IORef
+  ( 
+        -- * IORefs
+        IORef,                -- abstract, instance of: Eq, Typeable
+        newIORef,
+        readIORef,
+        writeIORef,
+        modifyIORef,
+        modifyIORef',
+        atomicModifyIORef,
+        atomicModifyIORef',
+        atomicWriteIORef,
+
+#if !defined(__PARALLEL_HASKELL__)
+        mkWeakIORef,
+#endif
+        -- ** Memory Model
+
+        -- $memmodel
+
+        ) where
+
+import GHC.Base
+import GHC.STRef
+import GHC.IORef hiding (atomicModifyIORef)
+import qualified GHC.IORef
+#if !defined(__PARALLEL_HASKELL__)
+import GHC.Weak
+#endif
+
+#if !defined(__PARALLEL_HASKELL__)
+-- |Make a 'Weak' pointer to an 'IORef', using the second argument as a finalizer
+-- to run when 'IORef' is garbage-collected
+mkWeakIORef :: IORef a -> IO () -> IO (Weak (IORef a))
+mkWeakIORef r@(IORef (STRef r#)) f = IO $ \s ->
+  case mkWeak# r# r f s of (# s1, w #) -> (# s1, Weak w #)
+#endif
+
+-- |Mutate the contents of an 'IORef'.
+--
+-- Be warned that 'modifyIORef' does not apply the function strictly.  This
+-- means if the program calls 'modifyIORef' many times, but seldomly uses the
+-- value, thunks will pile up in memory resulting in a space leak.  This is a
+-- common mistake made when using an IORef as a counter.  For example, the
+-- following will likely produce a stack overflow:
+--
+-- >ref <- newIORef 0
+-- >replicateM_ 1000000 $ modifyIORef ref (+1)
+-- >readIORef ref >>= print
+--
+-- To avoid this problem, use 'modifyIORef'' instead.
+modifyIORef :: IORef a -> (a -> a) -> IO ()
+modifyIORef ref f = readIORef ref >>= writeIORef ref . f
+
+-- |Strict version of 'modifyIORef'
+--
+-- /Since: 4.6.0.0/
+modifyIORef' :: IORef a -> (a -> a) -> IO ()
+modifyIORef' ref f = do
+    x <- readIORef ref
+    let x' = f x
+    x' `seq` writeIORef ref x'
+
+-- |Atomically modifies the contents of an 'IORef'.
+--
+-- This function is useful for using 'IORef' in a safe way in a multithreaded
+-- program.  If you only have one 'IORef', then using 'atomicModifyIORef' to
+-- access and modify it will prevent race conditions.
+--
+-- Extending the atomicity to multiple 'IORef's is problematic, so it
+-- is recommended that if you need to do anything more complicated
+-- then using 'Control.Concurrent.MVar.MVar' instead is a good idea.
+--
+-- 'atomicModifyIORef' does not apply the function strictly.  This is important
+-- to know even if all you are doing is replacing the value.  For example, this
+-- will leak memory:
+--
+-- >ref <- newIORef '1'
+-- >forever $ atomicModifyIORef ref (\_ -> ('2', ()))
+--
+-- Use 'atomicModifyIORef'' or 'atomicWriteIORef' to avoid this problem.
+--
+atomicModifyIORef :: IORef a -> (a -> (a,b)) -> IO b
+atomicModifyIORef = GHC.IORef.atomicModifyIORef
+
+-- | Strict version of 'atomicModifyIORef'.  This forces both the value stored
+-- in the 'IORef' as well as the value returned.
+--
+-- /Since: 4.6.0.0/
+atomicModifyIORef' :: IORef a -> (a -> (a,b)) -> IO b
+atomicModifyIORef' ref f = do
+    b <- atomicModifyIORef ref
+            (\x -> let (a, b) = f x
+                    in (a, a `seq` b))
+    b `seq` return b
+
+-- | Variant of 'writeIORef' with the \"barrier to reordering\" property that
+-- 'atomicModifyIORef' has.
+--
+-- /Since: 4.6.0.0/
+atomicWriteIORef :: IORef a -> a -> IO ()
+atomicWriteIORef ref a = do
+    x <- atomicModifyIORef ref (\_ -> (a, ()))
+    x `seq` return ()
+
+{- $memmodel
+
+  In a concurrent program, 'IORef' operations may appear out-of-order
+  to another thread, depending on the memory model of the underlying
+  processor architecture.  For example, on x86, loads can move ahead
+  of stores, so in the following example:
+
+>  maybePrint :: IORef Bool -> IORef Bool -> IO ()
+>  maybePrint myRef yourRef = do
+>    writeIORef myRef True
+>    yourVal <- readIORef yourRef
+>    unless yourVal $ putStrLn "critical section"
+>
+>  main :: IO ()
+>  main = do
+>    r1 <- newIORef False
+>    r2 <- newIORef False
+>    forkIO $ maybePrint r1 r2
+>    forkIO $ maybePrint r2 r1
+>    threadDelay 1000000
+
+  it is possible that the string @"critical section"@ is printed
+  twice, even though there is no interleaving of the operations of the
+  two threads that allows that outcome.  The memory model of x86
+  allows 'readIORef' to happen before the earlier 'writeIORef'.
+
+  The implementation is required to ensure that reordering of memory
+  operations cannot cause type-correct code to go wrong.  In
+  particular, when inspecting the value read from an 'IORef', the
+  memory writes that created that value must have occurred from the
+  point of view of the current thread.
+
+  'atomicModifyIORef' acts as a barrier to reordering.  Multiple
+  'atomicModifyIORef' operations occur in strict program order.  An
+  'atomicModifyIORef' is never observed to take place ahead of any
+  earlier (in program order) 'IORef' operations, or after any later
+  'IORef' operations.
+
+-}
+
diff --git a/libraries/base/Data/Int.hs b/libraries/base/Data/Int.hs
new file mode 100644
index 000000000000..8ca822142ced
--- /dev/null
+++ b/libraries/base/Data/Int.hs
@@ -0,0 +1,55 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.Int
+-- Copyright   :  (c) The University of Glasgow 2001
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+-- 
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  experimental
+-- Portability :  portable
+--
+-- Signed integer types
+--
+-----------------------------------------------------------------------------
+
+module Data.Int
+  ( 
+        -- * Signed integer types
+        Int,
+        Int8, Int16, Int32, Int64,
+
+        -- * Notes
+
+        -- $notes
+        ) where
+
+import GHC.Base ( Int )
+import GHC.Int  ( Int8, Int16, Int32, Int64 )
+
+{- $notes
+
+* All arithmetic is performed modulo 2^n, where @n@ is the number of
+  bits in the type.
+
+* For coercing between any two integer types, use 'Prelude.fromIntegral',
+  which is specialized for all the common cases so should be fast
+  enough.  Coercing word types (see "Data.Word") to and from integer
+  types preserves representation, not sign.
+
+* The rules that hold for 'Prelude.Enum' instances over a
+  bounded type such as 'Int' (see the section of the
+  Haskell report dealing with arithmetic sequences) also hold for the
+  'Prelude.Enum' instances over the various
+  'Int' types defined here.
+
+* Right and left shifts by amounts greater than or equal to the width
+  of the type result in either zero or -1, depending on the sign of
+  the value being shifted.  This is contrary to the behaviour in C,
+  which is undefined; a common interpretation is to truncate the shift
+  count to the width of the type, for example @1 \<\< 32
+  == 1@ in some C implementations.
+-}
+
diff --git a/libraries/base/Data/Ix.hs b/libraries/base/Data/Ix.hs
new file mode 100644
index 000000000000..bdfea60b73a0
--- /dev/null
+++ b/libraries/base/Data/Ix.hs
@@ -0,0 +1,66 @@
+{-# LANGUAGE Trustworthy #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.Ix
+-- Copyright   :  (c) The University of Glasgow 2001
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+-- 
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  stable
+-- Portability :  portable
+--
+-- The 'Ix' class is used to map a contiguous subrange of values in
+-- type onto integers.  It is used primarily for array indexing
+-- (see the array package).
+-- 
+-----------------------------------------------------------------------------
+
+module Data.Ix
+    (
+    -- * The 'Ix' class
+        Ix
+          ( range
+          , index
+          , inRange
+          , rangeSize
+          )
+    -- Ix instances:
+    --
+    --  Ix Char
+    --  Ix Int
+    --  Ix Integer
+    --  Ix Bool
+    --  Ix Ordering
+    --  Ix ()
+    --  (Ix a, Ix b) => Ix (a, b)
+    --  ...
+
+    -- * Deriving Instances of 'Ix'
+    -- | Derived instance declarations for the class 'Ix' are only possible
+    -- for enumerations (i.e. datatypes having only nullary constructors)
+    -- and single-constructor datatypes, including arbitrarily large tuples,
+    -- whose constituent types are instances of 'Ix'. 
+    -- 
+    -- * For an enumeration, the nullary constructors are assumed to be
+    -- numbered left-to-right with the indices being 0 to n-1 inclusive. This
+    -- is the same numbering defined by the 'Enum' class. For example, given
+    -- the datatype: 
+    -- 
+    -- >        data Colour = Red | Orange | Yellow | Green | Blue | Indigo | Violet
+    -- 
+    -- we would have: 
+    -- 
+    -- >        range   (Yellow,Blue)        ==  [Yellow,Green,Blue]
+    -- >        index   (Yellow,Blue) Green  ==  1
+    -- >        inRange (Yellow,Blue) Red    ==  False
+    -- 
+    -- * For single-constructor datatypes, the derived instance declarations
+    -- are as shown for tuples in Figure 1
+    -- <http://www.haskell.org/onlinelibrary/ix.html#prelude-index>.
+
+    ) where
+
+-- import Prelude
+
+import GHC.Arr
diff --git a/libraries/base/Data/List.hs b/libraries/base/Data/List.hs
new file mode 100644
index 000000000000..2cd9a3b4d107
--- /dev/null
+++ b/libraries/base/Data/List.hs
@@ -0,0 +1,1087 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE CPP, NoImplicitPrelude, ScopedTypeVariables, MagicHash #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.List
+-- Copyright   :  (c) The University of Glasgow 2001
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+--
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  stable
+-- Portability :  portable
+--
+-- Operations on lists.
+--
+-----------------------------------------------------------------------------
+
+module Data.List
+   (
+   -- * Basic functions
+
+     (++)
+   , head
+   , last
+   , tail
+   , init
+   , null
+   , length
+
+   -- * List transformations
+   , map
+   , reverse
+
+   , intersperse
+   , intercalate
+   , transpose
+
+   , subsequences
+   , permutations
+
+   -- * Reducing lists (folds)
+
+   , foldl
+   , foldl'
+   , foldl1
+   , foldl1'
+   , foldr
+   , foldr1
+
+   -- ** Special folds
+
+   , concat
+   , concatMap
+   , and
+   , or
+   , any
+   , all
+   , sum
+   , product
+   , maximum
+   , minimum
+
+   -- * Building lists
+
+   -- ** Scans
+   , scanl
+   , scanl1
+   , scanr
+   , scanr1
+
+   -- ** Accumulating maps
+   , mapAccumL
+   , mapAccumR
+
+   -- ** Infinite lists
+   , iterate
+   , repeat
+   , replicate
+   , cycle
+
+   -- ** Unfolding
+   , unfoldr
+
+   -- * Sublists
+
+   -- ** Extracting sublists
+   , take
+   , drop
+   , splitAt
+
+   , takeWhile
+   , dropWhile
+   , dropWhileEnd
+   , span
+   , break
+
+   , stripPrefix
+
+   , group
+
+   , inits
+   , tails
+
+   -- ** Predicates
+   , isPrefixOf
+   , isSuffixOf
+   , isInfixOf
+
+   -- * Searching lists
+
+   -- ** Searching by equality
+   , elem
+   , notElem
+   , lookup
+
+   -- ** Searching with a predicate
+   , find
+   , filter
+   , partition
+
+   -- * Indexing lists
+   -- | These functions treat a list @xs@ as a indexed collection,
+   -- with indices ranging from 0 to @'length' xs - 1@.
+
+   , (!!)
+
+   , elemIndex
+   , elemIndices
+
+   , findIndex
+   , findIndices
+
+   -- * Zipping and unzipping lists
+
+   , zip
+   , zip3
+   , zip4, zip5, zip6, zip7
+
+   , zipWith
+   , zipWith3
+   , zipWith4, zipWith5, zipWith6, zipWith7
+
+   , unzip
+   , unzip3
+   , unzip4, unzip5, unzip6, unzip7
+
+   -- * Special lists
+
+   -- ** Functions on strings
+   , lines
+   , words
+   , unlines
+   , unwords
+
+   -- ** \"Set\" operations
+
+   , nub
+
+   , delete
+   , (\\)
+
+   , union
+   , intersect
+
+   -- ** Ordered lists
+   , sort
+   , sortOn
+   , insert
+
+   -- * Generalized functions
+
+   -- ** The \"@By@\" operations
+   -- | By convention, overloaded functions have a non-overloaded
+   -- counterpart whose name is suffixed with \`@By@\'.
+   --
+   -- It is often convenient to use these functions together with
+   -- 'Data.Function.on', for instance @'sortBy' ('compare'
+   -- \`on\` 'fst')@.
+
+   -- *** User-supplied equality (replacing an @Eq@ context)
+   -- | The predicate is assumed to define an equivalence.
+   , nubBy
+   , deleteBy
+   , deleteFirstsBy
+   , unionBy
+   , intersectBy
+   , groupBy
+
+   -- *** User-supplied comparison (replacing an @Ord@ context)
+   -- | The function is assumed to define a total ordering.
+   , sortBy
+   , insertBy
+   , maximumBy
+   , minimumBy
+
+   -- ** The \"@generic@\" operations
+   -- | The prefix \`@generic@\' indicates an overloaded function that
+   -- is a generalized version of a "Prelude" function.
+
+   , genericLength
+   , genericTake
+   , genericDrop
+   , genericSplitAt
+   , genericIndex
+   , genericReplicate
+
+   ) where
+
+import Data.Maybe
+import Data.Char        ( isSpace )
+import Data.Ord         ( comparing )
+import Data.Tuple       ( fst, snd )
+
+import GHC.Num
+import GHC.Real
+import GHC.List
+import GHC.Base
+
+infix 5 \\ -- comment to fool cpp: https://www.haskell.org/ghc/docs/latest/html/users_guide/options-phases.html#cpp-string-gaps
+
+-- -----------------------------------------------------------------------------
+-- List functions
+
+-- | The 'dropWhileEnd' function drops the largest suffix of a list
+-- in which the given predicate holds for all elements.  For example:
+--
+-- > dropWhileEnd isSpace "foo\n" == "foo"
+-- > dropWhileEnd isSpace "foo bar" == "foo bar"
+-- > dropWhileEnd isSpace ("foo\n" ++ undefined) == "foo" ++ undefined
+--
+-- /Since: 4.5.0.0/
+dropWhileEnd :: (a -> Bool) -> [a] -> [a]
+dropWhileEnd p = foldr (\x xs -> if p x && null xs then [] else x : xs) []
+
+-- | The 'stripPrefix' function drops the given prefix from a list.
+-- It returns 'Nothing' if the list did not start with the prefix
+-- given, or 'Just' the list after the prefix, if it does.
+--
+-- > stripPrefix "foo" "foobar" == Just "bar"
+-- > stripPrefix "foo" "foo" == Just ""
+-- > stripPrefix "foo" "barfoo" == Nothing
+-- > stripPrefix "foo" "barfoobaz" == Nothing
+stripPrefix :: Eq a => [a] -> [a] -> Maybe [a]
+stripPrefix [] ys = Just ys
+stripPrefix (x:xs) (y:ys)
+ | x == y = stripPrefix xs ys
+stripPrefix _ _ = Nothing
+
+-- | The 'elemIndex' function returns the index of the first element
+-- in the given list which is equal (by '==') to the query element,
+-- or 'Nothing' if there is no such element.
+elemIndex       :: Eq a => a -> [a] -> Maybe Int
+elemIndex x     = findIndex (x==)
+
+-- | The 'elemIndices' function extends 'elemIndex', by returning the
+-- indices of all elements equal to the query element, in ascending order.
+elemIndices     :: Eq a => a -> [a] -> [Int]
+elemIndices x   = findIndices (x==)
+
+-- | The 'find' function takes a predicate and a list and returns the
+-- first element in the list matching the predicate, or 'Nothing' if
+-- there is no such element.
+find            :: (a -> Bool) -> [a] -> Maybe a
+find p          = listToMaybe . filter p
+
+-- | The 'findIndex' function takes a predicate and a list and returns
+-- the index of the first element in the list satisfying the predicate,
+-- or 'Nothing' if there is no such element.
+findIndex       :: (a -> Bool) -> [a] -> Maybe Int
+findIndex p     = listToMaybe . findIndices p
+
+-- | The 'findIndices' function extends 'findIndex', by returning the
+-- indices of all elements satisfying the predicate, in ascending order.
+findIndices      :: (a -> Bool) -> [a] -> [Int]
+#ifdef USE_REPORT_PRELUDE
+findIndices p xs = [ i | (x,i) <- zip xs [0..], p x]
+#else
+-- Efficient definition
+findIndices p ls = loop 0# ls
+                 where
+                   loop _ [] = []
+                   loop n (x:xs) | p x       = I# n : loop (n +# 1#) xs
+                                 | otherwise = loop (n +# 1#) xs
+#endif  /* USE_REPORT_PRELUDE */
+
+-- | The 'isPrefixOf' function takes two lists and returns 'True'
+-- iff the first list is a prefix of the second.
+isPrefixOf              :: (Eq a) => [a] -> [a] -> Bool
+isPrefixOf [] _         =  True
+isPrefixOf _  []        =  False
+isPrefixOf (x:xs) (y:ys)=  x == y && isPrefixOf xs ys
+
+-- | The 'isSuffixOf' function takes two lists and returns 'True'
+-- iff the first list is a suffix of the second.
+-- Both lists must be finite.
+isSuffixOf              :: (Eq a) => [a] -> [a] -> Bool
+isSuffixOf x y          =  reverse x `isPrefixOf` reverse y
+
+-- | The 'isInfixOf' function takes two lists and returns 'True'
+-- iff the first list is contained, wholly and intact,
+-- anywhere within the second.
+--
+-- Example:
+--
+-- >isInfixOf "Haskell" "I really like Haskell." == True
+-- >isInfixOf "Ial" "I really like Haskell." == False
+isInfixOf               :: (Eq a) => [a] -> [a] -> Bool
+isInfixOf needle haystack = any (isPrefixOf needle) (tails haystack)
+
+-- | /O(n^2)/. The 'nub' function removes duplicate elements from a list.
+-- In particular, it keeps only the first occurrence of each element.
+-- (The name 'nub' means \`essence\'.)
+-- It is a special case of 'nubBy', which allows the programmer to supply
+-- their own equality test.
+nub                     :: (Eq a) => [a] -> [a]
+#ifdef USE_REPORT_PRELUDE
+nub                     =  nubBy (==)
+#else
+-- stolen from HBC
+nub l                   = nub' l []             -- '
+  where
+    nub' [] _           = []                    -- '
+    nub' (x:xs) ls                              -- '
+        | x `elem` ls   = nub' xs ls            -- '
+        | otherwise     = x : nub' xs (x:ls)    -- '
+#endif
+
+-- | The 'nubBy' function behaves just like 'nub', except it uses a
+-- user-supplied equality predicate instead of the overloaded '=='
+-- function.
+nubBy                   :: (a -> a -> Bool) -> [a] -> [a]
+#ifdef USE_REPORT_PRELUDE
+nubBy eq []             =  []
+nubBy eq (x:xs)         =  x : nubBy eq (filter (\ y -> not (eq x y)) xs)
+#else
+nubBy eq l              = nubBy' l []
+  where
+    nubBy' [] _         = []
+    nubBy' (y:ys) xs
+       | elem_by eq y xs = nubBy' ys xs
+       | otherwise       = y : nubBy' ys (y:xs)
+
+-- Not exported:
+-- Note that we keep the call to `eq` with arguments in the
+-- same order as in the reference implementation
+-- 'xs' is the list of things we've seen so far,
+-- 'y' is the potential new element
+elem_by :: (a -> a -> Bool) -> a -> [a] -> Bool
+elem_by _  _ []         =  False
+elem_by eq y (x:xs)     =  y `eq` x || elem_by eq y xs
+#endif
+
+
+-- | 'delete' @x@ removes the first occurrence of @x@ from its list argument.
+-- For example,
+--
+-- > delete 'a' "banana" == "bnana"
+--
+-- It is a special case of 'deleteBy', which allows the programmer to
+-- supply their own equality test.
+
+delete                  :: (Eq a) => a -> [a] -> [a]
+delete                  =  deleteBy (==)
+
+-- | The 'deleteBy' function behaves like 'delete', but takes a
+-- user-supplied equality predicate.
+deleteBy                :: (a -> a -> Bool) -> a -> [a] -> [a]
+deleteBy _  _ []        = []
+deleteBy eq x (y:ys)    = if x `eq` y then ys else y : deleteBy eq x ys
+
+-- | The '\\' function is list difference (non-associative).
+-- In the result of @xs@ '\\' @ys@, the first occurrence of each element of
+-- @ys@ in turn (if any) has been removed from @xs@.  Thus
+--
+-- > (xs ++ ys) \\ xs == ys.
+--
+-- It is a special case of 'deleteFirstsBy', which allows the programmer
+-- to supply their own equality test.
+
+(\\)                    :: (Eq a) => [a] -> [a] -> [a]
+(\\)                    =  foldl (flip delete)
+
+-- | The 'union' function returns the list union of the two lists.
+-- For example,
+--
+-- > "dog" `union` "cow" == "dogcw"
+--
+-- Duplicates, and elements of the first list, are removed from the
+-- the second list, but if the first list contains duplicates, so will
+-- the result.
+-- It is a special case of 'unionBy', which allows the programmer to supply
+-- their own equality test.
+
+union                   :: (Eq a) => [a] -> [a] -> [a]
+union                   = unionBy (==)
+
+-- | The 'unionBy' function is the non-overloaded version of 'union'.
+unionBy                 :: (a -> a -> Bool) -> [a] -> [a] -> [a]
+unionBy eq xs ys        =  xs ++ foldl (flip (deleteBy eq)) (nubBy eq ys) xs
+
+-- | The 'intersect' function takes the list intersection of two lists.
+-- For example,
+--
+-- > [1,2,3,4] `intersect` [2,4,6,8] == [2,4]
+--
+-- If the first list contains duplicates, so will the result.
+--
+-- > [1,2,2,3,4] `intersect` [6,4,4,2] == [2,2,4]
+--
+-- It is a special case of 'intersectBy', which allows the programmer to
+-- supply their own equality test. If the element is found in both the first
+-- and the second list, the element from the first list will be used.
+
+intersect               :: (Eq a) => [a] -> [a] -> [a]
+intersect               =  intersectBy (==)
+
+-- | The 'intersectBy' function is the non-overloaded version of 'intersect'.
+intersectBy             :: (a -> a -> Bool) -> [a] -> [a] -> [a]
+intersectBy _  [] _     =  []
+intersectBy _  _  []    =  []
+intersectBy eq xs ys    =  [x | x <- xs, any (eq x) ys]
+
+-- | The 'intersperse' function takes an element and a list and
+-- \`intersperses\' that element between the elements of the list.
+-- For example,
+--
+-- > intersperse ',' "abcde" == "a,b,c,d,e"
+
+intersperse             :: a -> [a] -> [a]
+intersperse _   []      = []
+intersperse sep (x:xs)  = x : prependToAll sep xs
+
+
+-- Not exported:
+-- We want to make every element in the 'intersperse'd list available
+-- as soon as possible to avoid space leaks. Experiments suggested that
+-- a separate top-level helper is more efficient than a local worker.
+prependToAll            :: a -> [a] -> [a]
+prependToAll _   []     = []
+prependToAll sep (x:xs) = sep : x : prependToAll sep xs
+
+-- | 'intercalate' @xs xss@ is equivalent to @('concat' ('intersperse' xs xss))@.
+-- It inserts the list @xs@ in between the lists in @xss@ and concatenates the
+-- result.
+intercalate :: [a] -> [[a]] -> [a]
+intercalate xs xss = concat (intersperse xs xss)
+
+-- | The 'transpose' function transposes the rows and columns of its argument.
+-- For example,
+--
+-- > transpose [[1,2,3],[4,5,6]] == [[1,4],[2,5],[3,6]]
+
+transpose               :: [[a]] -> [[a]]
+transpose []             = []
+transpose ([]   : xss)   = transpose xss
+transpose ((x:xs) : xss) = (x : [h | (h:_) <- xss]) : transpose (xs : [ t | (_:t) <- xss])
+
+
+-- | The 'partition' function takes a predicate a list and returns
+-- the pair of lists of elements which do and do not satisfy the
+-- predicate, respectively; i.e.,
+--
+-- > partition p xs == (filter p xs, filter (not . p) xs)
+
+partition               :: (a -> Bool) -> [a] -> ([a],[a])
+{-# INLINE partition #-}
+partition p xs = foldr (select p) ([],[]) xs
+
+select :: (a -> Bool) -> a -> ([a], [a]) -> ([a], [a])
+select p x ~(ts,fs) | p x       = (x:ts,fs)
+                    | otherwise = (ts, x:fs)
+
+-- | The 'mapAccumL' function behaves like a combination of 'map' and
+-- 'foldl'; it applies a function to each element of a list, passing
+-- an accumulating parameter from left to right, and returning a final
+-- value of this accumulator together with the new list.
+mapAccumL :: (acc -> x -> (acc, y)) -- Function of elt of input list
+                                    -- and accumulator, returning new
+                                    -- accumulator and elt of result list
+          -> acc            -- Initial accumulator
+          -> [x]            -- Input list
+          -> (acc, [y])     -- Final accumulator and result list
+mapAccumL _ s []        =  (s, [])
+mapAccumL f s (x:xs)    =  (s'',y:ys)
+                           where (s', y ) = f s x
+                                 (s'',ys) = mapAccumL f s' xs
+
+-- | The 'mapAccumR' function behaves like a combination of 'map' and
+-- 'foldr'; it applies a function to each element of a list, passing
+-- an accumulating parameter from right to left, and returning a final
+-- value of this accumulator together with the new list.
+mapAccumR :: (acc -> x -> (acc, y))     -- Function of elt of input list
+                                        -- and accumulator, returning new
+                                        -- accumulator and elt of result list
+            -> acc              -- Initial accumulator
+            -> [x]              -- Input list
+            -> (acc, [y])               -- Final accumulator and result list
+mapAccumR _ s []        =  (s, [])
+mapAccumR f s (x:xs)    =  (s'', y:ys)
+                           where (s'',y ) = f s' x
+                                 (s', ys) = mapAccumR f s xs
+
+-- | The 'insert' function takes an element and a list and inserts the
+-- element into the list at the first position where it is less
+-- than or equal to the next element.  In particular, if the list
+-- is sorted before the call, the result will also be sorted.
+-- It is a special case of 'insertBy', which allows the programmer to
+-- supply their own comparison function.
+insert :: Ord a => a -> [a] -> [a]
+insert e ls = insertBy (compare) e ls
+
+-- | The non-overloaded version of 'insert'.
+insertBy :: (a -> a -> Ordering) -> a -> [a] -> [a]
+insertBy _   x [] = [x]
+insertBy cmp x ys@(y:ys')
+ = case cmp x y of
+     GT -> y : insertBy cmp x ys'
+     _  -> x : ys
+
+-- | 'maximum' returns the maximum value from a list,
+-- which must be non-empty, finite, and of an ordered type.
+-- It is a special case of 'Data.List.maximumBy', which allows the
+-- programmer to supply their own comparison function.
+maximum                 :: (Ord a) => [a] -> a
+{-# INLINE [1] maximum #-}
+maximum []              =  errorEmptyList "maximum"
+maximum xs              =  foldl1 max xs
+
+{-# RULES
+  "maximumInt"     maximum = (strictMaximum :: [Int]     -> Int);
+  "maximumInteger" maximum = (strictMaximum :: [Integer] -> Integer)
+ #-}
+
+-- We can't make the overloaded version of maximum strict without
+-- changing its semantics (max might not be strict), but we can for
+-- the version specialised to 'Int'.
+strictMaximum           :: (Ord a) => [a] -> a
+strictMaximum []        =  errorEmptyList "maximum"
+strictMaximum xs        =  foldl1' max xs
+
+-- | 'minimum' returns the minimum value from a list,
+-- which must be non-empty, finite, and of an ordered type.
+-- It is a special case of 'Data.List.minimumBy', which allows the
+-- programmer to supply their own comparison function.
+minimum                 :: (Ord a) => [a] -> a
+{-# INLINE [1] minimum #-}
+minimum []              =  errorEmptyList "minimum"
+minimum xs              =  foldl1 min xs
+
+{-# RULES
+  "minimumInt"     minimum = (strictMinimum :: [Int]     -> Int);
+  "minimumInteger" minimum = (strictMinimum :: [Integer] -> Integer)
+ #-}
+
+strictMinimum           :: (Ord a) => [a] -> a
+strictMinimum []        =  errorEmptyList "minimum"
+strictMinimum xs        =  foldl1' min xs
+
+-- | The 'maximumBy' function takes a comparison function and a list
+-- and returns the greatest element of the list by the comparison function.
+-- The list must be finite and non-empty.
+maximumBy               :: (a -> a -> Ordering) -> [a] -> a
+maximumBy _ []          =  error "List.maximumBy: empty list"
+maximumBy cmp xs        =  foldl1 maxBy xs
+                        where
+                           maxBy x y = case cmp x y of
+                                       GT -> x
+                                       _  -> y
+
+-- | The 'minimumBy' function takes a comparison function and a list
+-- and returns the least element of the list by the comparison function.
+-- The list must be finite and non-empty.
+minimumBy               :: (a -> a -> Ordering) -> [a] -> a
+minimumBy _ []          =  error "List.minimumBy: empty list"
+minimumBy cmp xs        =  foldl1 minBy xs
+                        where
+                           minBy x y = case cmp x y of
+                                       GT -> y
+                                       _  -> x
+
+-- | The 'genericLength' function is an overloaded version of 'length'.  In
+-- particular, instead of returning an 'Int', it returns any type which is
+-- an instance of 'Num'.  It is, however, less efficient than 'length'.
+genericLength           :: (Num i) => [a] -> i
+{-# NOINLINE [1] genericLength #-}
+genericLength []        =  0
+genericLength (_:l)     =  1 + genericLength l
+
+{-# RULES
+  "genericLengthInt"     genericLength = (strictGenericLength :: [a] -> Int);
+  "genericLengthInteger" genericLength = (strictGenericLength :: [a] -> Integer);
+ #-}
+
+strictGenericLength     :: (Num i) => [b] -> i
+strictGenericLength l   =  gl l 0
+                        where
+                           gl [] a     = a
+                           gl (_:xs) a = let a' = a + 1 in a' `seq` gl xs a'
+
+-- | The 'genericTake' function is an overloaded version of 'take', which
+-- accepts any 'Integral' value as the number of elements to take.
+genericTake             :: (Integral i) => i -> [a] -> [a]
+genericTake n _ | n <= 0 = []
+genericTake _ []        =  []
+genericTake n (x:xs)    =  x : genericTake (n-1) xs
+
+-- | The 'genericDrop' function is an overloaded version of 'drop', which
+-- accepts any 'Integral' value as the number of elements to drop.
+genericDrop             :: (Integral i) => i -> [a] -> [a]
+genericDrop n xs | n <= 0 = xs
+genericDrop _ []        =  []
+genericDrop n (_:xs)    =  genericDrop (n-1) xs
+
+
+-- | The 'genericSplitAt' function is an overloaded version of 'splitAt', which
+-- accepts any 'Integral' value as the position at which to split.
+genericSplitAt          :: (Integral i) => i -> [a] -> ([a], [a])
+genericSplitAt n xs | n <= 0 =  ([],xs)
+genericSplitAt _ []     =  ([],[])
+genericSplitAt n (x:xs) =  (x:xs',xs'') where
+    (xs',xs'') = genericSplitAt (n-1) xs
+
+-- | The 'genericIndex' function is an overloaded version of '!!', which
+-- accepts any 'Integral' value as the index.
+genericIndex :: (Integral i) => [a] -> i -> a
+genericIndex (x:_)  0 = x
+genericIndex (_:xs) n
+ | n > 0     = genericIndex xs (n-1)
+ | otherwise = error "List.genericIndex: negative argument."
+genericIndex _ _      = error "List.genericIndex: index too large."
+
+-- | The 'genericReplicate' function is an overloaded version of 'replicate',
+-- which accepts any 'Integral' value as the number of repetitions to make.
+genericReplicate        :: (Integral i) => i -> a -> [a]
+genericReplicate n x    =  genericTake n (repeat x)
+
+-- | The 'zip4' function takes four lists and returns a list of
+-- quadruples, analogous to 'zip'.
+zip4                    :: [a] -> [b] -> [c] -> [d] -> [(a,b,c,d)]
+zip4                    =  zipWith4 (,,,)
+
+-- | The 'zip5' function takes five lists and returns a list of
+-- five-tuples, analogous to 'zip'.
+zip5                    :: [a] -> [b] -> [c] -> [d] -> [e] -> [(a,b,c,d,e)]
+zip5                    =  zipWith5 (,,,,)
+
+-- | The 'zip6' function takes six lists and returns a list of six-tuples,
+-- analogous to 'zip'.
+zip6                    :: [a] -> [b] -> [c] -> [d] -> [e] -> [f] ->
+                              [(a,b,c,d,e,f)]
+zip6                    =  zipWith6 (,,,,,)
+
+-- | The 'zip7' function takes seven lists and returns a list of
+-- seven-tuples, analogous to 'zip'.
+zip7                    :: [a] -> [b] -> [c] -> [d] -> [e] -> [f] ->
+                              [g] -> [(a,b,c,d,e,f,g)]
+zip7                    =  zipWith7 (,,,,,,)
+
+-- | The 'zipWith4' function takes a function which combines four
+-- elements, as well as four lists and returns a list of their point-wise
+-- combination, analogous to 'zipWith'.
+zipWith4                :: (a->b->c->d->e) -> [a]->[b]->[c]->[d]->[e]
+zipWith4 z (a:as) (b:bs) (c:cs) (d:ds)
+                        =  z a b c d : zipWith4 z as bs cs ds
+zipWith4 _ _ _ _ _      =  []
+
+-- | The 'zipWith5' function takes a function which combines five
+-- elements, as well as five lists and returns a list of their point-wise
+-- combination, analogous to 'zipWith'.
+zipWith5                :: (a->b->c->d->e->f) ->
+                           [a]->[b]->[c]->[d]->[e]->[f]
+zipWith5 z (a:as) (b:bs) (c:cs) (d:ds) (e:es)
+                        =  z a b c d e : zipWith5 z as bs cs ds es
+zipWith5 _ _ _ _ _ _    = []
+
+-- | The 'zipWith6' function takes a function which combines six
+-- elements, as well as six lists and returns a list of their point-wise
+-- combination, analogous to 'zipWith'.
+zipWith6                :: (a->b->c->d->e->f->g) ->
+                           [a]->[b]->[c]->[d]->[e]->[f]->[g]
+zipWith6 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) (f:fs)
+                        =  z a b c d e f : zipWith6 z as bs cs ds es fs
+zipWith6 _ _ _ _ _ _ _  = []
+
+-- | The 'zipWith7' function takes a function which combines seven
+-- elements, as well as seven lists and returns a list of their point-wise
+-- combination, analogous to 'zipWith'.
+zipWith7                :: (a->b->c->d->e->f->g->h) ->
+                           [a]->[b]->[c]->[d]->[e]->[f]->[g]->[h]
+zipWith7 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) (f:fs) (g:gs)
+                   =  z a b c d e f g : zipWith7 z as bs cs ds es fs gs
+zipWith7 _ _ _ _ _ _ _ _ = []
+
+-- | The 'unzip4' function takes a list of quadruples and returns four
+-- lists, analogous to 'unzip'.
+unzip4                  :: [(a,b,c,d)] -> ([a],[b],[c],[d])
+unzip4                  =  foldr (\(a,b,c,d) ~(as,bs,cs,ds) ->
+                                        (a:as,b:bs,c:cs,d:ds))
+                                 ([],[],[],[])
+
+-- | The 'unzip5' function takes a list of five-tuples and returns five
+-- lists, analogous to 'unzip'.
+unzip5                  :: [(a,b,c,d,e)] -> ([a],[b],[c],[d],[e])
+unzip5                  =  foldr (\(a,b,c,d,e) ~(as,bs,cs,ds,es) ->
+                                        (a:as,b:bs,c:cs,d:ds,e:es))
+                                 ([],[],[],[],[])
+
+-- | The 'unzip6' function takes a list of six-tuples and returns six
+-- lists, analogous to 'unzip'.
+unzip6                  :: [(a,b,c,d,e,f)] -> ([a],[b],[c],[d],[e],[f])
+unzip6                  =  foldr (\(a,b,c,d,e,f) ~(as,bs,cs,ds,es,fs) ->
+                                        (a:as,b:bs,c:cs,d:ds,e:es,f:fs))
+                                 ([],[],[],[],[],[])
+
+-- | The 'unzip7' function takes a list of seven-tuples and returns
+-- seven lists, analogous to 'unzip'.
+unzip7          :: [(a,b,c,d,e,f,g)] -> ([a],[b],[c],[d],[e],[f],[g])
+unzip7          =  foldr (\(a,b,c,d,e,f,g) ~(as,bs,cs,ds,es,fs,gs) ->
+                                (a:as,b:bs,c:cs,d:ds,e:es,f:fs,g:gs))
+                         ([],[],[],[],[],[],[])
+
+
+-- | The 'deleteFirstsBy' function takes a predicate and two lists and
+-- returns the first list with the first occurrence of each element of
+-- the second list removed.
+deleteFirstsBy          :: (a -> a -> Bool) -> [a] -> [a] -> [a]
+deleteFirstsBy eq       =  foldl (flip (deleteBy eq))
+
+-- | The 'group' function takes a list and returns a list of lists such
+-- that the concatenation of the result is equal to the argument.  Moreover,
+-- each sublist in the result contains only equal elements.  For example,
+--
+-- > group "Mississippi" = ["M","i","ss","i","ss","i","pp","i"]
+--
+-- It is a special case of 'groupBy', which allows the programmer to supply
+-- their own equality test.
+group                   :: Eq a => [a] -> [[a]]
+group                   =  groupBy (==)
+
+-- | The 'groupBy' function is the non-overloaded version of 'group'.
+groupBy                 :: (a -> a -> Bool) -> [a] -> [[a]]
+groupBy _  []           =  []
+groupBy eq (x:xs)       =  (x:ys) : groupBy eq zs
+                           where (ys,zs) = span (eq x) xs
+
+-- | The 'inits' function returns all initial segments of the argument,
+-- shortest first.  For example,
+--
+-- > inits "abc" == ["","a","ab","abc"]
+--
+-- Note that 'inits' has the following strictness property:
+-- @inits _|_ = [] : _|_@
+inits                   :: [a] -> [[a]]
+inits xs                =  [] : case xs of
+                                  []      -> []
+                                  x : xs' -> map (x :) (inits xs')
+
+-- | The 'tails' function returns all final segments of the argument,
+-- longest first.  For example,
+--
+-- > tails "abc" == ["abc", "bc", "c",""]
+--
+-- Note that 'tails' has the following strictness property:
+-- @tails _|_ = _|_ : _|_@
+tails                   :: [a] -> [[a]]
+tails xs                =  xs : case xs of
+                                  []      -> []
+                                  _ : xs' -> tails xs'
+
+-- | The 'subsequences' function returns the list of all subsequences of the argument.
+--
+-- > subsequences "abc" == ["","a","b","ab","c","ac","bc","abc"]
+subsequences            :: [a] -> [[a]]
+subsequences xs         =  [] : nonEmptySubsequences xs
+
+-- | The 'nonEmptySubsequences' function returns the list of all subsequences of the argument,
+--   except for the empty list.
+--
+-- > nonEmptySubsequences "abc" == ["a","b","ab","c","ac","bc","abc"]
+nonEmptySubsequences         :: [a] -> [[a]]
+nonEmptySubsequences []      =  []
+nonEmptySubsequences (x:xs)  =  [x] : foldr f [] (nonEmptySubsequences xs)
+  where f ys r = ys : (x : ys) : r
+
+
+-- | The 'permutations' function returns the list of all permutations of the argument.
+--
+-- > permutations "abc" == ["abc","bac","cba","bca","cab","acb"]
+permutations            :: [a] -> [[a]]
+permutations xs0        =  xs0 : perms xs0 []
+  where
+    perms []     _  = []
+    perms (t:ts) is = foldr interleave (perms ts (t:is)) (permutations is)
+      where interleave    xs     r = let (_,zs) = interleave' id xs r in zs
+            interleave' _ []     r = (ts, r)
+            interleave' f (y:ys) r = let (us,zs) = interleave' (f . (y:)) ys r
+                                     in  (y:us, f (t:y:us) : zs)
+
+
+------------------------------------------------------------------------------
+-- Quick Sort algorithm taken from HBC's QSort library.
+
+-- | The 'sort' function implements a stable sorting algorithm.
+-- It is a special case of 'sortBy', which allows the programmer to supply
+-- their own comparison function.
+sort :: (Ord a) => [a] -> [a]
+
+-- | The 'sortBy' function is the non-overloaded version of 'sort'.
+sortBy :: (a -> a -> Ordering) -> [a] -> [a]
+
+#ifdef USE_REPORT_PRELUDE
+sort = sortBy compare
+sortBy cmp = foldr (insertBy cmp) []
+#else
+
+{-
+GHC's mergesort replaced by a better implementation, 24/12/2009.
+This code originally contributed to the nhc12 compiler by Thomas Nordin
+in 2002.  Rumoured to have been based on code by Lennart Augustsson, e.g.
+    http://www.mail-archive.com/haskell@haskell.org/msg01822.html
+and possibly to bear similarities to a 1982 paper by Richard O'Keefe:
+"A smooth applicative merge sort".
+
+Benchmarks show it to be often 2x the speed of the previous implementation.
+Fixes ticket http://ghc.haskell.org/trac/ghc/ticket/2143
+-}
+
+sort = sortBy compare
+sortBy cmp = mergeAll . sequences
+  where
+    sequences (a:b:xs)
+      | a `cmp` b == GT = descending b [a]  xs
+      | otherwise       = ascending  b (a:) xs
+    sequences xs = [xs]
+
+    descending a as (b:bs)
+      | a `cmp` b == GT = descending b (a:as) bs
+    descending a as bs  = (a:as): sequences bs
+
+    ascending a as (b:bs)
+      | a `cmp` b /= GT = ascending b (\ys -> as (a:ys)) bs
+    ascending a as bs   = as [a]: sequences bs
+
+    mergeAll [x] = x
+    mergeAll xs  = mergeAll (mergePairs xs)
+
+    mergePairs (a:b:xs) = merge a b: mergePairs xs
+    mergePairs xs       = xs
+
+    merge as@(a:as') bs@(b:bs')
+      | a `cmp` b == GT = b:merge as  bs'
+      | otherwise       = a:merge as' bs
+    merge [] bs         = bs
+    merge as []         = as
+
+{-
+sortBy cmp l = mergesort cmp l
+sort l = mergesort compare l
+
+Quicksort replaced by mergesort, 14/5/2002.
+
+From: Ian Lynagh <igloo@earth.li>
+
+I am curious as to why the List.sort implementation in GHC is a
+quicksort algorithm rather than an algorithm that guarantees n log n
+time in the worst case? I have attached a mergesort implementation along
+with a few scripts to time it's performance, the results of which are
+shown below (* means it didn't finish successfully - in all cases this
+was due to a stack overflow).
+
+If I heap profile the random_list case with only 10000 then I see
+random_list peaks at using about 2.5M of memory, whereas in the same
+program using List.sort it uses only 100k.
+
+Input style     Input length     Sort data     Sort alg    User time
+stdin           10000            random_list   sort        2.82
+stdin           10000            random_list   mergesort   2.96
+stdin           10000            sorted        sort        31.37
+stdin           10000            sorted        mergesort   1.90
+stdin           10000            revsorted     sort        31.21
+stdin           10000            revsorted     mergesort   1.88
+stdin           100000           random_list   sort        *
+stdin           100000           random_list   mergesort   *
+stdin           100000           sorted        sort        *
+stdin           100000           sorted        mergesort   *
+stdin           100000           revsorted     sort        *
+stdin           100000           revsorted     mergesort   *
+func            10000            random_list   sort        0.31
+func            10000            random_list   mergesort   0.91
+func            10000            sorted        sort        19.09
+func            10000            sorted        mergesort   0.15
+func            10000            revsorted     sort        19.17
+func            10000            revsorted     mergesort   0.16
+func            100000           random_list   sort        3.85
+func            100000           random_list   mergesort   *
+func            100000           sorted        sort        5831.47
+func            100000           sorted        mergesort   2.23
+func            100000           revsorted     sort        5872.34
+func            100000           revsorted     mergesort   2.24
+
+mergesort :: (a -> a -> Ordering) -> [a] -> [a]
+mergesort cmp = mergesort' cmp . map wrap
+
+mergesort' :: (a -> a -> Ordering) -> [[a]] -> [a]
+mergesort' _   [] = []
+mergesort' _   [xs] = xs
+mergesort' cmp xss = mergesort' cmp (merge_pairs cmp xss)
+
+merge_pairs :: (a -> a -> Ordering) -> [[a]] -> [[a]]
+merge_pairs _   [] = []
+merge_pairs _   [xs] = [xs]
+merge_pairs cmp (xs:ys:xss) = merge cmp xs ys : merge_pairs cmp xss
+
+merge :: (a -> a -> Ordering) -> [a] -> [a] -> [a]
+merge _   [] ys = ys
+merge _   xs [] = xs
+merge cmp (x:xs) (y:ys)
+ = case x `cmp` y of
+        GT -> y : merge cmp (x:xs)   ys
+        _  -> x : merge cmp    xs (y:ys)
+
+wrap :: a -> [a]
+wrap x = [x]
+
+
+
+OLDER: qsort version
+
+-- qsort is stable and does not concatenate.
+qsort :: (a -> a -> Ordering) -> [a] -> [a] -> [a]
+qsort _   []     r = r
+qsort _   [x]    r = x:r
+qsort cmp (x:xs) r = qpart cmp x xs [] [] r
+
+-- qpart partitions and sorts the sublists
+qpart :: (a -> a -> Ordering) -> a -> [a] -> [a] -> [a] -> [a] -> [a]
+qpart cmp x [] rlt rge r =
+    -- rlt and rge are in reverse order and must be sorted with an
+    -- anti-stable sorting
+    rqsort cmp rlt (x:rqsort cmp rge r)
+qpart cmp x (y:ys) rlt rge r =
+    case cmp x y of
+        GT -> qpart cmp x ys (y:rlt) rge r
+        _  -> qpart cmp x ys rlt (y:rge) r
+
+-- rqsort is as qsort but anti-stable, i.e. reverses equal elements
+rqsort :: (a -> a -> Ordering) -> [a] -> [a] -> [a]
+rqsort _   []     r = r
+rqsort _   [x]    r = x:r
+rqsort cmp (x:xs) r = rqpart cmp x xs [] [] r
+
+rqpart :: (a -> a -> Ordering) -> a -> [a] -> [a] -> [a] -> [a] -> [a]
+rqpart cmp x [] rle rgt r =
+    qsort cmp rle (x:qsort cmp rgt r)
+rqpart cmp x (y:ys) rle rgt r =
+    case cmp y x of
+        GT -> rqpart cmp x ys rle (y:rgt) r
+        _  -> rqpart cmp x ys (y:rle) rgt r
+-}
+
+#endif /* USE_REPORT_PRELUDE */
+
+-- | Sort a list by comparing the results of a key function applied to each
+-- element.  @sortOn f@ is equivalent to @sortBy . comparing f@, but has the
+-- performance advantage of only evaluating @f@ once for each element in the
+-- input list.  This is called the decorate-sort-undecorate paradigm, or
+-- Schwartzian transform.
+--
+-- /Since: 4.7.1.0/
+sortOn :: Ord b => (a -> b) -> [a] -> [a]
+sortOn f =
+  map snd . sortBy (comparing fst) . map (\x -> let y = f x in y `seq` (y, x))
+
+-- | The 'unfoldr' function is a \`dual\' to 'foldr': while 'foldr'
+-- reduces a list to a summary value, 'unfoldr' builds a list from
+-- a seed value.  The function takes the element and returns 'Nothing'
+-- if it is done producing the list or returns 'Just' @(a,b)@, in which
+-- case, @a@ is a prepended to the list and @b@ is used as the next
+-- element in a recursive call.  For example,
+--
+-- > iterate f == unfoldr (\x -> Just (x, f x))
+--
+-- In some cases, 'unfoldr' can undo a 'foldr' operation:
+--
+-- > unfoldr f' (foldr f z xs) == xs
+--
+-- if the following holds:
+--
+-- > f' (f x y) = Just (x,y)
+-- > f' z       = Nothing
+--
+-- A simple use of unfoldr:
+--
+-- > unfoldr (\b -> if b == 0 then Nothing else Just (b, b-1)) 10
+-- >  [10,9,8,7,6,5,4,3,2,1]
+--
+unfoldr      :: (b -> Maybe (a, b)) -> b -> [a]
+unfoldr f b  =
+  case f b of
+   Just (a,new_b) -> a : unfoldr f new_b
+   Nothing        -> []
+
+-- -----------------------------------------------------------------------------
+
+-- | A strict version of 'foldl'.
+foldl'           :: forall a b . (b -> a -> b) -> b -> [a] -> b
+foldl' k z0 xs = foldr (\(v::a) (fn::b->b) (z::b) -> z `seq` fn (k z v)) (id :: b -> b) xs z0
+-- Implementing foldl' via foldr is only a good idea if the compiler can optimize
+-- the resulting code (eta-expand the recursive "go"), so this needs -fcall-arity!
+-- Also see #7994
+
+-- | 'foldl1' is a variant of 'foldl' that has no starting value argument,
+-- and thus must be applied to non-empty lists.
+foldl1                  :: (a -> a -> a) -> [a] -> a
+foldl1 f (x:xs)         =  foldl f x xs
+foldl1 _ []             =  errorEmptyList "foldl1"
+
+-- | A strict version of 'foldl1'
+foldl1'                  :: (a -> a -> a) -> [a] -> a
+foldl1' f (x:xs)         =  foldl' f x xs
+foldl1' _ []             =  errorEmptyList "foldl1'"
+
+-- -----------------------------------------------------------------------------
+-- List sum and product
+
+-- | The 'sum' function computes the sum of a finite list of numbers.
+sum                     :: (Num a) => [a] -> a
+-- | The 'product' function computes the product of a finite list of numbers.
+product                 :: (Num a) => [a] -> a
+
+{-# INLINE sum #-}
+sum                     =  foldl (+) 0
+{-# INLINE product #-}
+product                 =  foldl (*) 1
+
+-- -----------------------------------------------------------------------------
+-- Functions on strings
+
+-- | 'lines' breaks a string up into a list of strings at newline
+-- characters.  The resulting strings do not contain newlines.
+lines                   :: String -> [String]
+lines ""                =  []
+-- Somehow GHC doesn't detect the selector thunks in the below code,
+-- so s' keeps a reference to the first line via the pair and we have
+-- a space leak (cf. #4334).
+-- So we need to make GHC see the selector thunks with a trick.
+lines s                 =  cons (case break (== '\n') s of
+                                    (l, s') -> (l, case s' of
+                                                    []      -> []
+                                                    _:s''   -> lines s''))
+  where
+    cons ~(h, t)        =  h : t
+
+-- | 'unlines' is an inverse operation to 'lines'.
+-- It joins lines, after appending a terminating newline to each.
+unlines                 :: [String] -> String
+#ifdef USE_REPORT_PRELUDE
+unlines                 =  concatMap (++ "\n")
+#else
+-- HBC version (stolen)
+-- here's a more efficient version
+unlines [] = []
+unlines (l:ls) = l ++ '\n' : unlines ls
+#endif
+
+-- | 'words' breaks a string up into a list of words, which were delimited
+-- by white space.
+words                   :: String -> [String]
+words s                 =  case dropWhile {-partain:Char.-}isSpace s of
+                                "" -> []
+                                s' -> w : words s''
+                                      where (w, s'') =
+                                             break {-partain:Char.-}isSpace s'
+
+-- | 'unwords' is an inverse operation to 'words'.
+-- It joins words with separating spaces.
+unwords                 :: [String] -> String
+#ifdef USE_REPORT_PRELUDE
+unwords []              =  ""
+unwords ws              =  foldr1 (\w s -> w ++ ' ':s) ws
+#else
+-- HBC version (stolen)
+-- here's a more efficient version
+unwords []              =  ""
+unwords [w]             = w
+unwords (w:ws)          = w ++ ' ' : unwords ws
+#endif
diff --git a/libraries/base/Data/Maybe.hs b/libraries/base/Data/Maybe.hs
new file mode 100644
index 000000000000..fe2a0abc1eb3
--- /dev/null
+++ b/libraries/base/Data/Maybe.hs
@@ -0,0 +1,141 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.Maybe
+-- Copyright   :  (c) The University of Glasgow 2001
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+-- 
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  stable
+-- Portability :  portable
+--
+-- The Maybe type, and associated operations.
+--
+-----------------------------------------------------------------------------
+
+module Data.Maybe
+   (
+     Maybe(Nothing,Just)
+
+   , maybe
+
+   , isJust
+   , isNothing
+   , fromJust
+   , fromMaybe
+   , listToMaybe
+   , maybeToList
+   , catMaybes
+   , mapMaybe
+   ) where
+
+import GHC.Base
+
+-- ---------------------------------------------------------------------------
+-- The Maybe type, and instances
+
+-- | The 'Maybe' type encapsulates an optional value.  A value of type
+-- @'Maybe' a@ either contains a value of type @a@ (represented as @'Just' a@), 
+-- or it is empty (represented as 'Nothing').  Using 'Maybe' is a good way to 
+-- deal with errors or exceptional cases without resorting to drastic
+-- measures such as 'error'.
+--
+-- The 'Maybe' type is also a monad.  It is a simple kind of error
+-- monad, where all errors are represented by 'Nothing'.  A richer
+-- error monad can be built using the 'Data.Either.Either' type.
+
+data  Maybe a  =  Nothing | Just a
+  deriving (Eq, Ord)
+
+instance  Functor Maybe  where
+    fmap _ Nothing       = Nothing
+    fmap f (Just a)      = Just (f a)
+
+instance  Monad Maybe  where
+    (Just x) >>= k      = k x
+    Nothing  >>= _      = Nothing
+
+    (Just _) >>  k      = k
+    Nothing  >>  _      = Nothing
+
+    return              = Just
+    fail _              = Nothing
+
+-- ---------------------------------------------------------------------------
+-- Functions over Maybe
+
+-- | The 'maybe' function takes a default value, a function, and a 'Maybe'
+-- value.  If the 'Maybe' value is 'Nothing', the function returns the
+-- default value.  Otherwise, it applies the function to the value inside
+-- the 'Just' and returns the result.
+maybe :: b -> (a -> b) -> Maybe a -> b
+maybe n _ Nothing  = n
+maybe _ f (Just x) = f x
+
+-- | The 'isJust' function returns 'True' iff its argument is of the
+-- form @Just _@.
+isJust         :: Maybe a -> Bool
+isJust Nothing = False
+isJust _       = True
+
+-- | The 'isNothing' function returns 'True' iff its argument is 'Nothing'.
+isNothing         :: Maybe a -> Bool
+isNothing Nothing = True
+isNothing _       = False
+
+-- | The 'fromJust' function extracts the element out of a 'Just' and
+-- throws an error if its argument is 'Nothing'.
+fromJust          :: Maybe a -> a
+fromJust Nothing  = error "Maybe.fromJust: Nothing" -- yuck
+fromJust (Just x) = x
+
+-- | The 'fromMaybe' function takes a default value and and 'Maybe'
+-- value.  If the 'Maybe' is 'Nothing', it returns the default values;
+-- otherwise, it returns the value contained in the 'Maybe'.
+fromMaybe     :: a -> Maybe a -> a
+fromMaybe d x = case x of {Nothing -> d;Just v  -> v}
+
+-- | The 'maybeToList' function returns an empty list when given
+-- 'Nothing' or a singleton list when not given 'Nothing'.
+maybeToList            :: Maybe a -> [a]
+maybeToList  Nothing   = []
+maybeToList  (Just x)  = [x]
+
+-- | The 'listToMaybe' function returns 'Nothing' on an empty list
+-- or @'Just' a@ where @a@ is the first element of the list.
+listToMaybe           :: [a] -> Maybe a
+listToMaybe []        =  Nothing
+listToMaybe (a:_)     =  Just a
+
+-- | The 'catMaybes' function takes a list of 'Maybe's and returns
+-- a list of all the 'Just' values. 
+catMaybes              :: [Maybe a] -> [a]
+catMaybes ls = [x | Just x <- ls]
+
+-- | The 'mapMaybe' function is a version of 'map' which can throw
+-- out elements.  In particular, the functional argument returns
+-- something of type @'Maybe' b@.  If this is 'Nothing', no element
+-- is added on to the result list.  If it just @'Just' b@, then @b@ is
+-- included in the result list.
+mapMaybe          :: (a -> Maybe b) -> [a] -> [b]
+mapMaybe _ []     = []
+mapMaybe f (x:xs) =
+ let rs = mapMaybe f xs in
+ case f x of
+  Nothing -> rs
+  Just r  -> r:rs
+{-# NOINLINE [1] mapMaybe #-}
+
+{-# RULES
+"mapMaybe"     [~1] forall f xs. mapMaybe f xs
+                    = build (\c n -> foldr (mapMaybeFB c f) n xs)
+"mapMaybeList" [1]  forall f. foldr (mapMaybeFB (:) f) [] = mapMaybe f
+  #-}
+
+{-# NOINLINE [0] mapMaybeFB #-}
+mapMaybeFB :: (b -> r -> r) -> (a -> Maybe b) -> a -> r -> r
+mapMaybeFB cons f x next = case f x of
+  Nothing -> next
+  Just r -> cons r next
diff --git a/libraries/base/Data/Monoid.hs b/libraries/base/Data/Monoid.hs
new file mode 100644
index 000000000000..2100518e3a94
--- /dev/null
+++ b/libraries/base/Data/Monoid.hs
@@ -0,0 +1,298 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE AutoDeriveTypeable #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE PolyKinds #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.Monoid
+-- Copyright   :  (c) Andy Gill 2001,
+--                (c) Oregon Graduate Institute of Science and Technology, 2001
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+--
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  experimental
+-- Portability :  portable
+--
+-- A class for monoids (types with an associative binary operation that
+-- has an identity) with various general-purpose instances.
+--
+-----------------------------------------------------------------------------
+
+module Data.Monoid (
+        -- * Monoid typeclass
+        Monoid(..),
+        (<>),
+        Dual(..),
+        Endo(..),
+        -- * Bool wrappers
+        All(..),
+        Any(..),
+        -- * Num wrappers
+        Sum(..),
+        Product(..),
+        -- * Maybe wrappers
+        -- $MaybeExamples
+        First(..),
+        Last(..)
+  ) where
+
+-- Push down the module in the dependency hierarchy.
+import GHC.Base hiding (Any)
+import GHC.Enum
+import GHC.Num
+import GHC.Read
+import GHC.Show
+import GHC.Generics
+import Data.Maybe
+import Data.Proxy
+
+{-
+-- just for testing
+import Data.Maybe
+import Test.QuickCheck
+-- -}
+
+-- ---------------------------------------------------------------------------
+-- | The class of monoids (types with an associative binary operation that
+-- has an identity).  Instances should satisfy the following laws:
+--
+--  * @mappend mempty x = x@
+--
+--  * @mappend x mempty = x@
+--
+--  * @mappend x (mappend y z) = mappend (mappend x y) z@
+--
+--  * @mconcat = 'foldr' mappend mempty@
+--
+-- The method names refer to the monoid of lists under concatenation,
+-- but there are many other instances.
+--
+-- Minimal complete definition: 'mempty' and 'mappend'.
+--
+-- Some types can be viewed as a monoid in more than one way,
+-- e.g. both addition and multiplication on numbers.
+-- In such cases we often define @newtype@s and make those instances
+-- of 'Monoid', e.g. 'Sum' and 'Product'.
+
+class Monoid a where
+        mempty  :: a
+        -- ^ Identity of 'mappend'
+        mappend :: a -> a -> a
+        -- ^ An associative operation
+        mconcat :: [a] -> a
+
+        -- ^ Fold a list using the monoid.
+        -- For most types, the default definition for 'mconcat' will be
+        -- used, but the function is included in the class definition so
+        -- that an optimized version can be provided for specific types.
+
+        mconcat = foldr mappend mempty
+
+infixr 6 <>
+
+-- | An infix synonym for 'mappend'.
+--
+-- /Since: 4.5.0.0/
+(<>) :: Monoid m => m -> m -> m
+(<>) = mappend
+{-# INLINE (<>) #-}
+
+-- Monoid instances.
+
+instance Monoid [a] where
+        mempty  = []
+        mappend = (++)
+
+instance Monoid b => Monoid (a -> b) where
+        mempty _ = mempty
+        mappend f g x = f x `mappend` g x
+
+instance Monoid () where
+        -- Should it be strict?
+        mempty        = ()
+        _ `mappend` _ = ()
+        mconcat _     = ()
+
+instance (Monoid a, Monoid b) => Monoid (a,b) where
+        mempty = (mempty, mempty)
+        (a1,b1) `mappend` (a2,b2) =
+                (a1 `mappend` a2, b1 `mappend` b2)
+
+instance (Monoid a, Monoid b, Monoid c) => Monoid (a,b,c) where
+        mempty = (mempty, mempty, mempty)
+        (a1,b1,c1) `mappend` (a2,b2,c2) =
+                (a1 `mappend` a2, b1 `mappend` b2, c1 `mappend` c2)
+
+instance (Monoid a, Monoid b, Monoid c, Monoid d) => Monoid (a,b,c,d) where
+        mempty = (mempty, mempty, mempty, mempty)
+        (a1,b1,c1,d1) `mappend` (a2,b2,c2,d2) =
+                (a1 `mappend` a2, b1 `mappend` b2,
+                 c1 `mappend` c2, d1 `mappend` d2)
+
+instance (Monoid a, Monoid b, Monoid c, Monoid d, Monoid e) =>
+                Monoid (a,b,c,d,e) where
+        mempty = (mempty, mempty, mempty, mempty, mempty)
+        (a1,b1,c1,d1,e1) `mappend` (a2,b2,c2,d2,e2) =
+                (a1 `mappend` a2, b1 `mappend` b2, c1 `mappend` c2,
+                 d1 `mappend` d2, e1 `mappend` e2)
+
+-- lexicographical ordering
+instance Monoid Ordering where
+        mempty         = EQ
+        LT `mappend` _ = LT
+        EQ `mappend` y = y
+        GT `mappend` _ = GT
+
+instance Monoid (Proxy s) where
+    mempty = Proxy
+    mappend _ _ = Proxy
+    mconcat _ = Proxy
+
+-- | The dual of a monoid, obtained by swapping the arguments of 'mappend'.
+newtype Dual a = Dual { getDual :: a }
+        deriving (Eq, Ord, Read, Show, Bounded, Generic, Generic1)
+
+instance Monoid a => Monoid (Dual a) where
+        mempty = Dual mempty
+        Dual x `mappend` Dual y = Dual (y `mappend` x)
+
+-- | The monoid of endomorphisms under composition.
+newtype Endo a = Endo { appEndo :: a -> a }
+               deriving (Generic)
+
+instance Monoid (Endo a) where
+        mempty = Endo id
+        Endo f `mappend` Endo g = Endo (f . g)
+
+-- | Boolean monoid under conjunction.
+newtype All = All { getAll :: Bool }
+        deriving (Eq, Ord, Read, Show, Bounded, Generic)
+
+instance Monoid All where
+        mempty = All True
+        All x `mappend` All y = All (x && y)
+
+-- | Boolean monoid under disjunction.
+newtype Any = Any { getAny :: Bool }
+        deriving (Eq, Ord, Read, Show, Bounded, Generic)
+
+instance Monoid Any where
+        mempty = Any False
+        Any x `mappend` Any y = Any (x || y)
+
+-- | Monoid under addition.
+newtype Sum a = Sum { getSum :: a }
+        deriving (Eq, Ord, Read, Show, Bounded, Generic, Generic1, Num)
+
+instance Num a => Monoid (Sum a) where
+        mempty = Sum 0
+        Sum x `mappend` Sum y = Sum (x + y)
+
+-- | Monoid under multiplication.
+newtype Product a = Product { getProduct :: a }
+        deriving (Eq, Ord, Read, Show, Bounded, Generic, Generic1, Num)
+
+instance Num a => Monoid (Product a) where
+        mempty = Product 1
+        Product x `mappend` Product y = Product (x * y)
+
+-- $MaybeExamples
+-- To implement @find@ or @findLast@ on any 'Foldable':
+--
+-- @
+-- findLast :: Foldable t => (a -> Bool) -> t a -> Maybe a
+-- findLast pred = getLast . foldMap (\x -> if pred x
+--                                            then Last (Just x)
+--                                            else Last Nothing)
+-- @
+--
+-- Much of Data.Map's interface can be implemented with
+-- Data.Map.alter. Some of the rest can be implemented with a new
+-- @alterA@ function and either 'First' or 'Last':
+--
+-- > alterA :: (Applicative f, Ord k) =>
+-- >           (Maybe a -> f (Maybe a)) -> k -> Map k a -> f (Map k a)
+-- >
+-- > instance Monoid a => Applicative ((,) a)  -- from Control.Applicative
+--
+-- @
+-- insertLookupWithKey :: Ord k => (k -> v -> v -> v) -> k -> v
+--                     -> Map k v -> (Maybe v, Map k v)
+-- insertLookupWithKey combine key value =
+--   Arrow.first getFirst . alterA doChange key
+--   where
+--   doChange Nothing = (First Nothing, Just value)
+--   doChange (Just oldValue) =
+--     (First (Just oldValue),
+--      Just (combine key value oldValue))
+-- @
+
+-- | Lift a semigroup into 'Maybe' forming a 'Monoid' according to
+-- <http://en.wikipedia.org/wiki/Monoid>: \"Any semigroup @S@ may be
+-- turned into a monoid simply by adjoining an element @e@ not in @S@
+-- and defining @e*e = e@ and @e*s = s = s*e@ for all @s ∈ S@.\" Since
+-- there is no \"Semigroup\" typeclass providing just 'mappend', we
+-- use 'Monoid' instead.
+instance Monoid a => Monoid (Maybe a) where
+  mempty = Nothing
+  Nothing `mappend` m = m
+  m `mappend` Nothing = m
+  Just m1 `mappend` Just m2 = Just (m1 `mappend` m2)
+
+
+-- | Maybe monoid returning the leftmost non-Nothing value.
+newtype First a = First { getFirst :: Maybe a }
+        deriving (Eq, Ord, Read, Show, Generic, Generic1)
+
+instance Monoid (First a) where
+        mempty = First Nothing
+        r@(First (Just _)) `mappend` _ = r
+        First Nothing `mappend` r = r
+
+instance Functor First where
+        fmap f (First x) = First (fmap f x)
+
+instance Monad First where
+        return x = First (Just x)
+        First x >>= m = First (x >>= getFirst . m)
+
+-- | Maybe monoid returning the rightmost non-Nothing value.
+newtype Last a = Last { getLast :: Maybe a }
+        deriving (Eq, Ord, Read, Show, Generic, Generic1)
+
+instance Monoid (Last a) where
+        mempty = Last Nothing
+        _ `mappend` r@(Last (Just _)) = r
+        r `mappend` Last Nothing = r
+
+instance Functor Last where
+        fmap f (Last x) = Last (fmap f x)
+
+instance Monad Last where
+        return x = Last (Just x)
+        Last x >>= m = Last (x >>= getLast . m)
+
+{-
+{--------------------------------------------------------------------
+  Testing
+--------------------------------------------------------------------}
+instance Arbitrary a => Arbitrary (Maybe a) where
+  arbitrary = oneof [return Nothing, Just `fmap` arbitrary]
+
+prop_mconcatMaybe :: [Maybe [Int]] -> Bool
+prop_mconcatMaybe x =
+  fromMaybe [] (mconcat x) == mconcat (catMaybes x)
+
+prop_mconcatFirst :: [Maybe Int] -> Bool
+prop_mconcatFirst x =
+  getFirst (mconcat (map First x)) == listToMaybe (catMaybes x)
+prop_mconcatLast :: [Maybe Int] -> Bool
+prop_mconcatLast x =
+  getLast (mconcat (map Last x)) == listLastToMaybe (catMaybes x)
+        where listLastToMaybe [] = Nothing
+              listLastToMaybe lst = Just (last lst)
+-- -}
+
diff --git a/libraries/base/Data/OldTypeable.hs b/libraries/base/Data/OldTypeable.hs
new file mode 100644
index 000000000000..d6b5b6255c4c
--- /dev/null
+++ b/libraries/base/Data/OldTypeable.hs
@@ -0,0 +1,179 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE CPP
+           , NoImplicitPrelude
+           , OverlappingInstances
+           , ScopedTypeVariables
+           , FlexibleInstances
+  #-}
+{-# OPTIONS_GHC -funbox-strict-fields -fno-warn-warnings-deprecations #-}
+
+-- The -XOverlappingInstances flag allows the user to over-ride
+-- the instances for Typeable given here.  In particular, we provide an instance
+--      instance ... => Typeable (s a) 
+-- But a user might want to say
+--      instance ... => Typeable (MyType a b)
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.Typeable
+-- Copyright   :  (c) The University of Glasgow, CWI 2001--2004
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+-- 
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  experimental
+-- Portability :  portable
+--
+-- This module defines the old, kind-monomorphic 'Typeable' class. It is now
+-- deprecated; users are recommended to use the kind-polymorphic
+-- "Data.Typeable" module instead.
+--
+-- /Since: 4.7.0.0/
+-----------------------------------------------------------------------------
+
+module Data.OldTypeable {-# DEPRECATED "Use Data.Typeable instead" #-} -- deprecated in 7.8
+  (
+
+        -- * The Typeable class
+        Typeable( typeOf ),     -- :: a -> TypeRep
+
+        -- * Type-safe cast
+        cast,                   -- :: (Typeable a, Typeable b) => a -> Maybe b
+        gcast,                  -- a generalisation of cast
+
+        -- * Type representations
+        TypeRep,        -- abstract, instance of: Eq, Show, Typeable
+        showsTypeRep,
+
+        TyCon,          -- abstract, instance of: Eq, Show, Typeable
+        tyConString,    -- :: TyCon   -> String
+        tyConPackage,   -- :: TyCon   -> String
+        tyConModule,    -- :: TyCon   -> String
+        tyConName,      -- :: TyCon   -> String
+
+        -- * Construction of type representations
+        mkTyCon,        -- :: String  -> TyCon
+        mkTyCon3,       -- :: String  -> String -> String -> TyCon
+        mkTyConApp,     -- :: TyCon   -> [TypeRep] -> TypeRep
+        mkAppTy,        -- :: TypeRep -> TypeRep   -> TypeRep
+        mkFunTy,        -- :: TypeRep -> TypeRep   -> TypeRep
+
+        -- * Observation of type representations
+        splitTyConApp,  -- :: TypeRep -> (TyCon, [TypeRep])
+        funResultTy,    -- :: TypeRep -> TypeRep   -> Maybe TypeRep
+        typeRepTyCon,   -- :: TypeRep -> TyCon
+        typeRepArgs,    -- :: TypeRep -> [TypeRep]
+        typeRepKey,     -- :: TypeRep -> IO TypeRepKey
+        TypeRepKey,     -- abstract, instance of Eq, Ord
+
+        -- * The other Typeable classes
+        -- | /Note:/ The general instances are provided for GHC only.
+        Typeable1( typeOf1 ),   -- :: t a -> TypeRep
+        Typeable2( typeOf2 ),   -- :: t a b -> TypeRep
+        Typeable3( typeOf3 ),   -- :: t a b c -> TypeRep
+        Typeable4( typeOf4 ),   -- :: t a b c d -> TypeRep
+        Typeable5( typeOf5 ),   -- :: t a b c d e -> TypeRep
+        Typeable6( typeOf6 ),   -- :: t a b c d e f -> TypeRep
+        Typeable7( typeOf7 ),   -- :: t a b c d e f g -> TypeRep
+        gcast1,                 -- :: ... => c (t a) -> Maybe (c (t' a))
+        gcast2,                 -- :: ... => c (t a b) -> Maybe (c (t' a b))
+
+        -- * Default instances
+        -- | /Note:/ These are not needed by GHC, for which these instances
+        -- are generated by general instance declarations.
+        typeOfDefault,  -- :: (Typeable1 t, Typeable a) => t a -> TypeRep
+        typeOf1Default, -- :: (Typeable2 t, Typeable a) => t a b -> TypeRep
+        typeOf2Default, -- :: (Typeable3 t, Typeable a) => t a b c -> TypeRep
+        typeOf3Default, -- :: (Typeable4 t, Typeable a) => t a b c d -> TypeRep
+        typeOf4Default, -- :: (Typeable5 t, Typeable a) => t a b c d e -> TypeRep
+        typeOf5Default, -- :: (Typeable6 t, Typeable a) => t a b c d e f -> TypeRep
+        typeOf6Default  -- :: (Typeable7 t, Typeable a) => t a b c d e f g -> TypeRep
+
+  ) where
+
+import Data.OldTypeable.Internal hiding (mkTyCon)
+
+import Unsafe.Coerce
+import Data.Maybe
+
+import GHC.Base
+
+import GHC.Fingerprint.Type
+import GHC.Fingerprint
+
+#include "OldTypeable.h"
+
+{-# DEPRECATED typeRepKey "TypeRep itself is now an instance of Ord" #-} -- deprecated in 7.2
+-- | (DEPRECATED) Returns a unique key associated with a 'TypeRep'.
+-- This function is deprecated because 'TypeRep' itself is now an
+-- instance of 'Ord', so mappings can be made directly with 'TypeRep'
+-- as the key.
+--
+typeRepKey :: TypeRep -> IO TypeRepKey
+typeRepKey (TypeRep f _ _) = return (TypeRepKey f)
+
+        -- 
+        -- let fTy = mkTyCon "Foo" in show (mkTyConApp (mkTyCon ",,")
+        --                                 [fTy,fTy,fTy])
+        -- 
+        -- returns "(Foo,Foo,Foo)"
+        --
+        -- The TypeRep Show instance promises to print tuple types
+        -- correctly. Tuple type constructors are specified by a 
+        -- sequence of commas, e.g., (mkTyCon ",,,,") returns
+        -- the 5-tuple tycon.
+
+newtype TypeRepKey = TypeRepKey Fingerprint
+  deriving (Eq,Ord)
+
+----------------- Construction ---------------------
+
+{-# DEPRECATED mkTyCon "either derive Typeable, or use mkTyCon3 instead" #-} -- deprecated in 7.2
+-- | Backwards-compatible API
+mkTyCon :: String       -- ^ unique string
+        -> TyCon        -- ^ A unique 'TyCon' object
+mkTyCon name = TyCon (fingerprintString name) "" "" name
+
+-------------------------------------------------------------
+--
+--              Type-safe cast
+--
+-------------------------------------------------------------
+
+-- | The type-safe cast operation
+cast :: (Typeable a, Typeable b) => a -> Maybe b
+cast x = r
+       where
+         r = if typeOf x == typeOf (fromJust r)
+               then Just $ unsafeCoerce x
+               else Nothing
+
+-- | A flexible variation parameterised in a type constructor
+gcast :: (Typeable a, Typeable b) => c a -> Maybe (c b)
+gcast x = r
+ where
+  r = if typeOf (getArg x) == typeOf (getArg (fromJust r))
+        then Just $ unsafeCoerce x
+        else Nothing
+  getArg :: c x -> x 
+  getArg = undefined
+
+-- | Cast for * -> *
+gcast1 :: (Typeable1 t, Typeable1 t') => c (t a) -> Maybe (c (t' a)) 
+gcast1 x = r
+ where
+  r = if typeOf1 (getArg x) == typeOf1 (getArg (fromJust r))
+       then Just $ unsafeCoerce x
+       else Nothing
+  getArg :: c x -> x 
+  getArg = undefined
+
+-- | Cast for * -> * -> *
+gcast2 :: (Typeable2 t, Typeable2 t') => c (t a b) -> Maybe (c (t' a b)) 
+gcast2 x = r
+ where
+  r = if typeOf2 (getArg x) == typeOf2 (getArg (fromJust r))
+       then Just $ unsafeCoerce x
+       else Nothing
+  getArg :: c x -> x 
+  getArg = undefined
+
diff --git a/libraries/base/Data/OldTypeable/Internal.hs b/libraries/base/Data/OldTypeable/Internal.hs
new file mode 100644
index 000000000000..2b0293046649
--- /dev/null
+++ b/libraries/base/Data/OldTypeable/Internal.hs
@@ -0,0 +1,475 @@
+{-# LANGUAGE Unsafe #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.Typeable.Internal
+-- Copyright   :  (c) The University of Glasgow, CWI 2001--2011
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+-- 
+-- The representations of the types TyCon and TypeRep, and the
+-- function mkTyCon which is used by derived instances of Typeable to
+-- construct a TyCon.
+--
+-- /Since: 4.7.0.0/
+-----------------------------------------------------------------------------
+
+{-# LANGUAGE CPP
+           , NoImplicitPrelude
+           , OverlappingInstances
+           , ScopedTypeVariables
+           , FlexibleInstances
+           , MagicHash
+           , DeriveDataTypeable
+           , StandaloneDeriving #-}
+
+module Data.OldTypeable.Internal {-# DEPRECATED "Use Data.Typeable.Internal instead" #-} ( -- deprecated in 7.8
+    TypeRep(..),
+    TyCon(..),
+    mkTyCon,
+    mkTyCon3,
+    mkTyConApp,
+    mkAppTy,
+    typeRepTyCon,
+    typeOfDefault,
+    typeOf1Default,
+    typeOf2Default,
+    typeOf3Default,
+    typeOf4Default,
+    typeOf5Default,
+    typeOf6Default,
+    Typeable(..),
+    Typeable1(..),
+    Typeable2(..),
+    Typeable3(..),
+    Typeable4(..),
+    Typeable5(..),
+    Typeable6(..),
+    Typeable7(..),
+    mkFunTy,
+    splitTyConApp,
+    funResultTy,
+    typeRepArgs,
+    showsTypeRep,
+    tyConString,
+    listTc, funTc
+  ) where
+
+import GHC.Base
+import GHC.Word
+import GHC.Show
+import Data.Maybe
+import Data.List
+import GHC.Num
+import GHC.Real
+import GHC.IORef
+import GHC.IOArray
+import GHC.MVar
+import GHC.ST           ( ST )
+import GHC.STRef        ( STRef )
+import GHC.Ptr          ( Ptr, FunPtr )
+import GHC.Stable
+import GHC.Arr          ( Array, STArray )
+import Data.Int
+
+import GHC.Fingerprint.Type
+import GHC.Fingerprint
+
+-- | A concrete representation of a (monomorphic) type.  'TypeRep'
+-- supports reasonably efficient equality.
+data TypeRep = TypeRep {-# UNPACK #-} !Fingerprint TyCon [TypeRep]
+
+-- Compare keys for equality
+instance Eq TypeRep where
+  (TypeRep k1 _ _) == (TypeRep k2 _ _) = k1 == k2
+
+instance Ord TypeRep where
+  (TypeRep k1 _ _) <= (TypeRep k2 _ _) = k1 <= k2
+
+-- | An abstract representation of a type constructor.  'TyCon' objects can
+-- be built using 'mkTyCon'.
+data TyCon = TyCon {
+   tyConHash    :: {-# UNPACK #-} !Fingerprint,
+   tyConPackage :: String,
+   tyConModule  :: String,
+   tyConName    :: String
+ }
+
+instance Eq TyCon where
+  (TyCon t1 _ _ _) == (TyCon t2 _ _ _) = t1 == t2
+
+instance Ord TyCon where
+  (TyCon k1 _ _ _) <= (TyCon k2 _ _ _) = k1 <= k2
+
+----------------- Construction --------------------
+
+#include "MachDeps.h"
+
+-- mkTyCon is an internal function to make it easier for GHC to
+-- generate derived instances.  GHC precomputes the MD5 hash for the
+-- TyCon and passes it as two separate 64-bit values to mkTyCon.  The
+-- TyCon for a derived Typeable instance will end up being statically
+-- allocated.
+
+#if WORD_SIZE_IN_BITS < 64
+mkTyCon :: Word64# -> Word64# -> String -> String -> String -> TyCon
+#else
+mkTyCon :: Word#   -> Word#   -> String -> String -> String -> TyCon
+#endif
+mkTyCon high# low# pkg modl name
+  = TyCon (Fingerprint (W64# high#) (W64# low#)) pkg modl name
+
+-- | Applies a type constructor to a sequence of types
+mkTyConApp  :: TyCon -> [TypeRep] -> TypeRep
+mkTyConApp tc@(TyCon tc_k _ _ _) []
+  = TypeRep tc_k tc [] -- optimisation: all derived Typeable instances
+                       -- end up here, and it helps generate smaller
+                       -- code for derived Typeable.
+mkTyConApp tc@(TyCon tc_k _ _ _) args
+  = TypeRep (fingerprintFingerprints (tc_k : arg_ks)) tc args
+  where
+    arg_ks = [k | TypeRep k _ _ <- args]
+
+-- | A special case of 'mkTyConApp', which applies the function 
+-- type constructor to a pair of types.
+mkFunTy  :: TypeRep -> TypeRep -> TypeRep
+mkFunTy f a = mkTyConApp funTc [f,a]
+
+-- | Splits a type constructor application
+splitTyConApp :: TypeRep -> (TyCon,[TypeRep])
+splitTyConApp (TypeRep _ tc trs) = (tc,trs)
+
+-- | Applies a type to a function type.  Returns: @'Just' u@ if the
+-- first argument represents a function of type @t -> u@ and the
+-- second argument represents a function of type @t@.  Otherwise,
+-- returns 'Nothing'.
+funResultTy :: TypeRep -> TypeRep -> Maybe TypeRep
+funResultTy trFun trArg
+  = case splitTyConApp trFun of
+      (tc, [t1,t2]) | tc == funTc && t1 == trArg -> Just t2
+      _ -> Nothing
+
+-- | Adds a TypeRep argument to a TypeRep.
+mkAppTy :: TypeRep -> TypeRep -> TypeRep
+mkAppTy (TypeRep _ tc trs) arg_tr = mkTyConApp tc (trs ++ [arg_tr])
+   -- Notice that we call mkTyConApp to construct the fingerprint from tc and
+   -- the arg fingerprints.  Simply combining the current fingerprint with
+   -- the new one won't give the same answer, but of course we want to 
+   -- ensure that a TypeRep of the same shape has the same fingerprint!
+   -- See Trac #5962
+
+-- | Builds a 'TyCon' object representing a type constructor.  An
+-- implementation of "Data.Typeable" should ensure that the following holds:
+--
+-- >  A==A' ^ B==B' ^ C==C' ==> mkTyCon A B C == mkTyCon A' B' C'
+--
+
+--
+mkTyCon3 :: String       -- ^ package name
+         -> String       -- ^ module name
+         -> String       -- ^ the name of the type constructor
+         -> TyCon        -- ^ A unique 'TyCon' object
+mkTyCon3 pkg modl name =
+  TyCon (fingerprintString (unwords [pkg, modl, name])) pkg modl name
+
+----------------- Observation ---------------------
+
+-- | Observe the type constructor of a type representation
+typeRepTyCon :: TypeRep -> TyCon
+typeRepTyCon (TypeRep _ tc _) = tc
+
+-- | Observe the argument types of a type representation
+typeRepArgs :: TypeRep -> [TypeRep]
+typeRepArgs (TypeRep _ _ args) = args
+
+-- | Observe string encoding of a type representation
+{-# DEPRECATED tyConString "renamed to tyConName; tyConModule and tyConPackage are also available." #-} -- deprecated in 7.4
+tyConString :: TyCon   -> String
+tyConString = tyConName
+
+-------------------------------------------------------------
+--
+--      The Typeable class and friends
+--
+-------------------------------------------------------------
+
+{- Note [Memoising typeOf]
+~~~~~~~~~~~~~~~~~~~~~~~~~~
+IMPORTANT: we don't want to recalculate the type-rep once per
+call to the dummy argument.  This is what went wrong in Trac #3245
+So we help GHC by manually keeping the 'rep' *outside* the value 
+lambda, thus
+    
+    typeOfDefault :: forall t a. (Typeable1 t, Typeable a) => t a -> TypeRep
+    typeOfDefault = \_ -> rep
+      where
+        rep = typeOf1 (undefined :: t a) `mkAppTy` 
+              typeOf  (undefined :: a)
+
+Notice the crucial use of scoped type variables here!
+-}
+
+-- | The class 'Typeable' allows a concrete representation of a type to
+-- be calculated.
+class Typeable a where
+  typeOf :: a -> TypeRep
+  -- ^ Takes a value of type @a@ and returns a concrete representation
+  -- of that type.  The /value/ of the argument should be ignored by
+  -- any instance of 'Typeable', so that it is safe to pass 'undefined' as
+  -- the argument.
+
+-- | Variant for unary type constructors
+class Typeable1 t where
+  typeOf1 :: t a -> TypeRep
+
+-- | For defining a 'Typeable' instance from any 'Typeable1' instance.
+typeOfDefault :: forall t a. (Typeable1 t, Typeable a) => t a -> TypeRep
+typeOfDefault = \_ -> rep
+ where
+   rep = typeOf1 (undefined :: t a) `mkAppTy` 
+         typeOf  (undefined :: a)
+   -- Note [Memoising typeOf]
+
+-- | Variant for binary type constructors
+class Typeable2 t where
+  typeOf2 :: t a b -> TypeRep
+
+-- | For defining a 'Typeable1' instance from any 'Typeable2' instance.
+typeOf1Default :: forall t a b. (Typeable2 t, Typeable a) => t a b -> TypeRep
+typeOf1Default = \_ -> rep 
+ where
+   rep = typeOf2 (undefined :: t a b) `mkAppTy` 
+         typeOf  (undefined :: a)
+   -- Note [Memoising typeOf]
+
+-- | Variant for 3-ary type constructors
+class Typeable3 t where
+  typeOf3 :: t a b c -> TypeRep
+
+-- | For defining a 'Typeable2' instance from any 'Typeable3' instance.
+typeOf2Default :: forall t a b c. (Typeable3 t, Typeable a) => t a b c -> TypeRep
+typeOf2Default = \_ -> rep 
+ where
+   rep = typeOf3 (undefined :: t a b c) `mkAppTy` 
+         typeOf  (undefined :: a)
+   -- Note [Memoising typeOf]
+
+-- | Variant for 4-ary type constructors
+class Typeable4 t where
+  typeOf4 :: t a b c d -> TypeRep
+
+-- | For defining a 'Typeable3' instance from any 'Typeable4' instance.
+typeOf3Default :: forall t a b c d. (Typeable4 t, Typeable a) => t a b c d -> TypeRep
+typeOf3Default = \_ -> rep
+ where
+   rep = typeOf4 (undefined :: t a b c d) `mkAppTy` 
+         typeOf  (undefined :: a)
+   -- Note [Memoising typeOf]
+   
+-- | Variant for 5-ary type constructors
+class Typeable5 t where
+  typeOf5 :: t a b c d e -> TypeRep
+
+-- | For defining a 'Typeable4' instance from any 'Typeable5' instance.
+typeOf4Default :: forall t a b c d e. (Typeable5 t, Typeable a) => t a b c d e -> TypeRep
+typeOf4Default = \_ -> rep 
+ where
+   rep = typeOf5 (undefined :: t a b c d e) `mkAppTy` 
+         typeOf  (undefined :: a)
+   -- Note [Memoising typeOf]
+
+-- | Variant for 6-ary type constructors
+class Typeable6 t where
+  typeOf6 :: t a b c d e f -> TypeRep
+
+-- | For defining a 'Typeable5' instance from any 'Typeable6' instance.
+typeOf5Default :: forall t a b c d e f. (Typeable6 t, Typeable a) => t a b c d e f -> TypeRep
+typeOf5Default = \_ -> rep
+ where
+   rep = typeOf6 (undefined :: t a b c d e f) `mkAppTy` 
+         typeOf  (undefined :: a)
+   -- Note [Memoising typeOf]
+
+-- | Variant for 7-ary type constructors
+class Typeable7 t where
+  typeOf7 :: t a b c d e f g -> TypeRep
+
+-- | For defining a 'Typeable6' instance from any 'Typeable7' instance.
+typeOf6Default :: forall t a b c d e f g. (Typeable7 t, Typeable a) => t a b c d e f g -> TypeRep
+typeOf6Default = \_ -> rep
+ where
+   rep = typeOf7 (undefined :: t a b c d e f g) `mkAppTy` 
+         typeOf  (undefined :: a)
+   -- Note [Memoising typeOf]
+
+-- Given a @Typeable@/n/ instance for an /n/-ary type constructor,
+-- define the instances for partial applications.
+-- Programmers using non-GHC implementations must do this manually
+-- for each type constructor.
+-- (The INSTANCE_TYPEABLE/n/ macros in Typeable.h include this.)
+
+-- | One Typeable instance for all Typeable1 instances
+instance (Typeable1 s, Typeable a)
+       => Typeable (s a) where
+  typeOf = typeOfDefault
+
+-- | One Typeable1 instance for all Typeable2 instances
+instance (Typeable2 s, Typeable a)
+       => Typeable1 (s a) where
+  typeOf1 = typeOf1Default
+
+-- | One Typeable2 instance for all Typeable3 instances
+instance (Typeable3 s, Typeable a)
+       => Typeable2 (s a) where
+  typeOf2 = typeOf2Default
+
+-- | One Typeable3 instance for all Typeable4 instances
+instance (Typeable4 s, Typeable a)
+       => Typeable3 (s a) where
+  typeOf3 = typeOf3Default
+
+-- | One Typeable4 instance for all Typeable5 instances
+instance (Typeable5 s, Typeable a)
+       => Typeable4 (s a) where
+  typeOf4 = typeOf4Default
+
+-- | One Typeable5 instance for all Typeable6 instances
+instance (Typeable6 s, Typeable a)
+       => Typeable5 (s a) where
+  typeOf5 = typeOf5Default
+
+-- | One Typeable6 instance for all Typeable7 instances
+instance (Typeable7 s, Typeable a)
+       => Typeable6 (s a) where
+  typeOf6 = typeOf6Default
+
+----------------- Showing TypeReps --------------------
+
+instance Show TypeRep where
+  showsPrec p (TypeRep _ tycon tys) =
+    case tys of
+      [] -> showsPrec p tycon
+      [x]   | tycon == listTc -> showChar '[' . shows x . showChar ']'
+      [a,r] | tycon == funTc  -> showParen (p > 8) $
+                                 showsPrec 9 a .
+                                 showString " -> " .
+                                 showsPrec 8 r
+      xs | isTupleTyCon tycon -> showTuple xs
+         | otherwise         ->
+            showParen (p > 9) $
+            showsPrec p tycon . 
+            showChar ' '      . 
+            showArgs tys
+
+showsTypeRep :: TypeRep -> ShowS
+showsTypeRep = shows
+
+instance Show TyCon where
+  showsPrec _ t = showString (tyConName t)
+
+isTupleTyCon :: TyCon -> Bool
+isTupleTyCon (TyCon _ _ _ ('(':',':_)) = True
+isTupleTyCon _                         = False
+
+-- Some (Show.TypeRep) helpers:
+
+showArgs :: Show a => [a] -> ShowS
+showArgs [] = id
+showArgs [a] = showsPrec 10 a
+showArgs (a:as) = showsPrec 10 a . showString " " . showArgs as 
+
+showTuple :: [TypeRep] -> ShowS
+showTuple args = showChar '('
+               . (foldr (.) id $ intersperse (showChar ',') 
+                               $ map (showsPrec 10) args)
+               . showChar ')'
+
+listTc :: TyCon
+listTc = typeRepTyCon (typeOf [()])
+
+funTc :: TyCon
+funTc = mkTyCon3 "ghc-prim" "GHC.Types" "->"
+
+-------------------------------------------------------------
+--
+--      Instances of the Typeable classes for Prelude types
+--
+-------------------------------------------------------------
+
+#include "OldTypeable.h"
+
+INSTANCE_TYPEABLE0((),unitTc,"()")
+INSTANCE_TYPEABLE1([],listTc,"[]")
+INSTANCE_TYPEABLE1(Maybe,maybeTc,"Maybe")
+INSTANCE_TYPEABLE1(Ratio,ratioTc,"Ratio")
+
+{-
+TODO: Deriving this instance fails with:
+libraries/base/Data/Typeable.hs:589:1:
+    Can't make a derived instance of `Typeable2 (->)':
+      The last argument of the instance must be a data or newtype application
+    In the stand-alone deriving instance for `Typeable2 (->)'
+-}
+instance Typeable2 (->) where { typeOf2 _ = mkTyConApp funTc [] }
+
+INSTANCE_TYPEABLE1(IO,ioTc,"IO")
+
+-- Types defined in GHC.MVar
+INSTANCE_TYPEABLE1(MVar,mvarTc,"MVar" )
+
+INSTANCE_TYPEABLE2(Array,arrayTc,"Array")
+INSTANCE_TYPEABLE2(IOArray,iOArrayTc,"IOArray")
+
+INSTANCE_TYPEABLE2(ST,stTc,"ST")
+INSTANCE_TYPEABLE2(STRef,stRefTc,"STRef")
+INSTANCE_TYPEABLE3(STArray,sTArrayTc,"STArray")
+
+INSTANCE_TYPEABLE2((,),pairTc,"(,)")
+INSTANCE_TYPEABLE3((,,),tup3Tc,"(,,)")
+INSTANCE_TYPEABLE4((,,,),tup4Tc,"(,,,)")
+INSTANCE_TYPEABLE5((,,,,),tup5Tc,"(,,,,)")
+INSTANCE_TYPEABLE6((,,,,,),tup6Tc,"(,,,,,)")
+INSTANCE_TYPEABLE7((,,,,,,),tup7Tc,"(,,,,,,)")
+
+INSTANCE_TYPEABLE1(Ptr,ptrTc,"Ptr")
+INSTANCE_TYPEABLE1(FunPtr,funPtrTc,"FunPtr")
+INSTANCE_TYPEABLE1(StablePtr,stablePtrTc,"StablePtr")
+INSTANCE_TYPEABLE1(IORef,iORefTc,"IORef")
+
+-------------------------------------------------------
+--
+-- Generate Typeable instances for standard datatypes
+--
+-------------------------------------------------------
+
+INSTANCE_TYPEABLE0(Bool,boolTc,"Bool")
+INSTANCE_TYPEABLE0(Char,charTc,"Char")
+INSTANCE_TYPEABLE0(Float,floatTc,"Float")
+INSTANCE_TYPEABLE0(Double,doubleTc,"Double")
+INSTANCE_TYPEABLE0(Int,intTc,"Int")
+INSTANCE_TYPEABLE0(Word,wordTc,"Word" )
+INSTANCE_TYPEABLE0(Integer,integerTc,"Integer")
+INSTANCE_TYPEABLE0(Ordering,orderingTc,"Ordering")
+
+INSTANCE_TYPEABLE0(Int8,int8Tc,"Int8")
+INSTANCE_TYPEABLE0(Int16,int16Tc,"Int16")
+INSTANCE_TYPEABLE0(Int32,int32Tc,"Int32")
+INSTANCE_TYPEABLE0(Int64,int64Tc,"Int64")
+
+INSTANCE_TYPEABLE0(Word8,word8Tc,"Word8" )
+INSTANCE_TYPEABLE0(Word16,word16Tc,"Word16")
+INSTANCE_TYPEABLE0(Word32,word32Tc,"Word32")
+INSTANCE_TYPEABLE0(Word64,word64Tc,"Word64")
+
+INSTANCE_TYPEABLE0(TyCon,tyconTc,"TyCon")
+INSTANCE_TYPEABLE0(TypeRep,typeRepTc,"TypeRep")
+
+{-
+TODO: This can't be derived currently:
+libraries/base/Data/Typeable.hs:674:1:
+    Can't make a derived instance of `Typeable RealWorld':
+      The last argument of the instance must be a data or newtype application
+    In the stand-alone deriving instance for `Typeable RealWorld'
+-}
+realWorldTc :: TyCon; \
+realWorldTc = mkTyCon3 "ghc-prim" "GHC.Types" "RealWorld"; \
+instance Typeable RealWorld where { typeOf _ = mkTyConApp realWorldTc [] }
diff --git a/libraries/base/Data/OldTypeable/Internal.hs-boot b/libraries/base/Data/OldTypeable/Internal.hs-boot
new file mode 100644
index 000000000000..4c1d63647857
--- /dev/null
+++ b/libraries/base/Data/OldTypeable/Internal.hs-boot
@@ -0,0 +1,28 @@
+{-# LANGUAGE Unsafe #-}
+{-# LANGUAGE CPP, NoImplicitPrelude, MagicHash #-}
+
+module Data.OldTypeable.Internal (
+    Typeable(typeOf),
+    TypeRep,
+    TyCon,
+    mkTyCon,
+    mkTyConApp
+  ) where
+
+import GHC.Base
+
+data TypeRep
+data TyCon
+
+#include "MachDeps.h"
+
+#if WORD_SIZE_IN_BITS < 64
+mkTyCon :: Word64# -> Word64# -> String -> String -> String -> TyCon
+#else
+mkTyCon :: Word#   -> Word#   -> String -> String -> String -> TyCon
+#endif
+
+mkTyConApp   :: TyCon -> [TypeRep] -> TypeRep
+
+class Typeable a where
+  typeOf :: a -> TypeRep
diff --git a/libraries/base/Data/Ord.hs b/libraries/base/Data/Ord.hs
new file mode 100644
index 000000000000..624dae1e9a24
--- /dev/null
+++ b/libraries/base/Data/Ord.hs
@@ -0,0 +1,52 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.Ord
+-- Copyright   :  (c) The University of Glasgow 2005
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+-- 
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  stable
+-- Portability :  portable
+--
+-- Orderings
+--
+-----------------------------------------------------------------------------
+
+module Data.Ord (
+   Ord(..),
+   Ordering(..),
+   Down(..),
+   comparing,
+ ) where
+
+import GHC.Base
+import GHC.Show
+import GHC.Read
+
+-- | 
+-- > comparing p x y = compare (p x) (p y)
+--
+-- Useful combinator for use in conjunction with the @xxxBy@ family
+-- of functions from "Data.List", for example:
+--
+-- >   ... sortBy (comparing fst) ...
+comparing :: (Ord a) => (b -> a) -> b -> b -> Ordering
+comparing p x y = compare (p x) (p y)
+
+-- | The 'Down' type allows you to reverse sort order conveniently.  A value of type
+-- @'Down' a@ contains a value of type @a@ (represented as @'Down' a@).
+-- If @a@ has an @'Ord'@ instance associated with it then comparing two
+-- values thus wrapped will give you the opposite of their normal sort order.
+-- This is particularly useful when sorting in generalised list comprehensions,
+-- as in: @then sortWith by 'Down' x@
+--
+-- Provides 'Show' and 'Read' instances (/since: 4.7.0.0/).
+--
+-- /Since: 4.6.0.0/
+newtype Down a = Down a deriving (Eq, Show, Read)
+
+instance Ord a => Ord (Down a) where
+    compare (Down x) (Down y) = y `compare` x
diff --git a/libraries/base/Data/Proxy.hs b/libraries/base/Data/Proxy.hs
new file mode 100644
index 000000000000..ab89066cfa84
--- /dev/null
+++ b/libraries/base/Data/Proxy.hs
@@ -0,0 +1,88 @@
+{-# LANGUAGE NoImplicitPrelude, Trustworthy #-}
+{-# LANGUAGE PolyKinds #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.Proxy
+-- License     :  BSD-style (see the LICENSE file in the distribution)
+--
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  experimental
+-- Portability :  portable
+--
+-- Definition of a Proxy type (poly-kinded in GHC)
+--
+-- /Since: 4.7.0.0/
+-----------------------------------------------------------------------------
+
+module Data.Proxy
+  (
+        Proxy(..), asProxyTypeOf
+      , KProxy(..)
+  ) where
+
+import GHC.Base
+import GHC.Show
+import GHC.Read
+import GHC.Enum
+import GHC.Arr
+
+-- | A concrete, poly-kinded proxy type
+data Proxy t = Proxy
+
+-- | A concrete, promotable proxy type, for use at the kind level
+-- There are no instances for this because it is intended at the kind level only
+data KProxy (t :: *) = KProxy
+
+instance Eq (Proxy s) where
+  _ == _ = True
+
+instance Ord (Proxy s) where
+  compare _ _ = EQ
+
+instance Show (Proxy s) where
+  showsPrec _ _ = showString "Proxy"
+
+instance Read (Proxy s) where
+  readsPrec d = readParen (d > 10) (\r -> [(Proxy, s) | ("Proxy",s) <- lex r ])
+
+instance Enum (Proxy s) where
+    succ _               = error "Proxy.succ"
+    pred _               = error "Proxy.pred"
+    fromEnum _           = 0
+    toEnum 0             = Proxy
+    toEnum _             = error "Proxy.toEnum: 0 expected"
+    enumFrom _           = [Proxy]
+    enumFromThen _ _     = [Proxy]
+    enumFromThenTo _ _ _ = [Proxy]
+    enumFromTo _ _       = [Proxy]
+
+instance Ix (Proxy s) where
+    range _           = [Proxy]
+    index _ _         = 0
+    inRange _ _       = True
+    rangeSize _       = 1
+    unsafeIndex _ _   = 0
+    unsafeRangeSize _ = 1
+
+instance Bounded (Proxy s) where
+    minBound = Proxy
+    maxBound = Proxy
+
+instance Functor Proxy where
+    fmap _ _ = Proxy
+    {-# INLINE fmap #-}
+
+instance Monad Proxy where
+    return _ = Proxy
+    {-# INLINE return #-}
+    _ >>= _ = Proxy
+    {-# INLINE (>>=) #-}
+
+-- | 'asProxyTypeOf' is a type-restricted version of 'const'.
+-- It is usually used as an infix operator, and its typing forces its first
+-- argument (which is usually overloaded) to have the same type as the tag
+-- of the second.
+asProxyTypeOf :: a -> Proxy a -> a
+asProxyTypeOf = const
+{-# INLINE asProxyTypeOf #-}
diff --git a/libraries/base/Data/Ratio.hs b/libraries/base/Data/Ratio.hs
new file mode 100644
index 000000000000..6a16e9a260bb
--- /dev/null
+++ b/libraries/base/Data/Ratio.hs
@@ -0,0 +1,75 @@
+{-# LANGUAGE Safe #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.Ratio
+-- Copyright   :  (c) The University of Glasgow 2001
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+-- 
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  stable
+-- Portability :  portable
+--
+-- Standard functions on rational numbers
+--
+-----------------------------------------------------------------------------
+
+module Data.Ratio
+    ( Ratio
+    , Rational
+    , (%)
+    , numerator
+    , denominator
+    , approxRational
+
+  ) where
+
+import Prelude
+
+import GHC.Real         -- The basic defns for Ratio
+
+-- -----------------------------------------------------------------------------
+-- approxRational
+
+-- | 'approxRational', applied to two real fractional numbers @x@ and @epsilon@,
+-- returns the simplest rational number within @epsilon@ of @x@.
+-- A rational number @y@ is said to be /simpler/ than another @y'@ if
+--
+-- * @'abs' ('numerator' y) <= 'abs' ('numerator' y')@, and
+--
+-- * @'denominator' y <= 'denominator' y'@.
+--
+-- Any real interval contains a unique simplest rational;
+-- in particular, note that @0\/1@ is the simplest rational of all.
+
+-- Implementation details: Here, for simplicity, we assume a closed rational
+-- interval.  If such an interval includes at least one whole number, then
+-- the simplest rational is the absolutely least whole number.  Otherwise,
+-- the bounds are of the form q%1 + r%d and q%1 + r'%d', where abs r < d
+-- and abs r' < d', and the simplest rational is q%1 + the reciprocal of
+-- the simplest rational between d'%r' and d%r.
+
+approxRational          :: (RealFrac a) => a -> a -> Rational
+approxRational rat eps  =  simplest (rat-eps) (rat+eps)
+        where simplest x y | y < x      =  simplest y x
+                           | x == y     =  xr
+                           | x > 0      =  simplest' n d n' d'
+                           | y < 0      =  - simplest' (-n') d' (-n) d
+                           | otherwise  =  0 :% 1
+                                        where xr  = toRational x
+                                              n   = numerator xr
+                                              d   = denominator xr
+                                              nd' = toRational y
+                                              n'  = numerator nd'
+                                              d'  = denominator nd'
+
+              simplest' n d n' d'       -- assumes 0 < n%d < n'%d'
+                        | r == 0     =  q :% 1
+                        | q /= q'    =  (q+1) :% 1
+                        | otherwise  =  (q*n''+d'') :% n''
+                                     where (q,r)      =  quotRem n d
+                                           (q',r')    =  quotRem n' d'
+                                           nd''       =  simplest' d' r' d r
+                                           n''        =  numerator nd''
+                                           d''        =  denominator nd''
+
diff --git a/libraries/base/Data/STRef.hs b/libraries/base/Data/STRef.hs
new file mode 100644
index 000000000000..dc65abc7919f
--- /dev/null
+++ b/libraries/base/Data/STRef.hs
@@ -0,0 +1,56 @@
+{-# LANGUAGE Trustworthy #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.STRef
+-- Copyright   :  (c) The University of Glasgow 2001
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+-- 
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  experimental
+-- Portability :  non-portable (uses Control.Monad.ST)
+--
+-- Mutable references in the (strict) ST monad.
+--
+-----------------------------------------------------------------------------
+
+module Data.STRef (
+        -- * STRefs
+        STRef,          -- abstract
+        newSTRef,
+        readSTRef,
+        writeSTRef,
+        modifySTRef,
+        modifySTRef'
+ ) where
+
+import Prelude
+
+import GHC.ST
+import GHC.STRef
+
+-- | Mutate the contents of an 'STRef'.
+--
+-- Be warned that 'modifySTRef' does not apply the function strictly.  This
+-- means if the program calls 'modifySTRef' many times, but seldomly uses the
+-- value, thunks will pile up in memory resulting in a space leak.  This is a
+-- common mistake made when using an STRef as a counter.  For example, the
+-- following will leak memory and likely produce a stack overflow:
+--
+-- >print $ runST $ do
+-- >    ref <- newSTRef 0
+-- >    replicateM_ 1000000 $ modifySTRef ref (+1)
+-- >    readSTRef ref
+--
+-- To avoid this problem, use 'modifySTRef'' instead.
+modifySTRef :: STRef s a -> (a -> a) -> ST s ()
+modifySTRef ref f = writeSTRef ref . f =<< readSTRef ref
+
+-- | Strict version of 'modifySTRef'
+--
+-- /Since: 4.6.0.0/
+modifySTRef' :: STRef s a -> (a -> a) -> ST s ()
+modifySTRef' ref f = do
+    x <- readSTRef ref
+    let x' = f x
+    x' `seq` writeSTRef ref x'
diff --git a/libraries/base/Data/STRef/Lazy.hs b/libraries/base/Data/STRef/Lazy.hs
new file mode 100644
index 000000000000..039b03f3b569
--- /dev/null
+++ b/libraries/base/Data/STRef/Lazy.hs
@@ -0,0 +1,39 @@
+{-# LANGUAGE Safe #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.STRef.Lazy
+-- Copyright   :  (c) The University of Glasgow 2001
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+-- 
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  experimental
+-- Portability :  non-portable (uses Control.Monad.ST.Lazy)
+--
+-- Mutable references in the lazy ST monad.
+--
+-----------------------------------------------------------------------------
+
+module Data.STRef.Lazy (
+        -- * STRefs
+        ST.STRef,       -- abstract
+        newSTRef,
+        readSTRef,
+        writeSTRef,
+        modifySTRef
+ ) where
+
+import Control.Monad.ST.Lazy.Safe
+import qualified Data.STRef as ST
+import Prelude
+
+newSTRef    :: a -> ST s (ST.STRef s a)
+readSTRef   :: ST.STRef s a -> ST s a
+writeSTRef  :: ST.STRef s a -> a -> ST s ()
+modifySTRef :: ST.STRef s a -> (a -> a) -> ST s ()
+
+newSTRef        = strictToLazyST . ST.newSTRef
+readSTRef       = strictToLazyST . ST.readSTRef
+writeSTRef  r a = strictToLazyST (ST.writeSTRef r a)
+modifySTRef r f = strictToLazyST (ST.modifySTRef r f)
+
diff --git a/libraries/base/Data/STRef/Strict.hs b/libraries/base/Data/STRef/Strict.hs
new file mode 100644
index 000000000000..ead6683f8abe
--- /dev/null
+++ b/libraries/base/Data/STRef/Strict.hs
@@ -0,0 +1,22 @@
+{-# LANGUAGE Safe #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.STRef.Strict
+-- Copyright   :  (c) The University of Glasgow 2001
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+-- 
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  provisional
+-- Portability :  non-portable (uses Control.Monad.ST.Strict)
+--
+-- Mutable references in the (strict) ST monad (re-export of "Data.STRef")
+--
+-----------------------------------------------------------------------------
+
+module Data.STRef.Strict (
+        module Data.STRef
+  ) where
+
+import Data.STRef
+
diff --git a/libraries/base/Data/String.hs b/libraries/base/Data/String.hs
new file mode 100644
index 000000000000..a03569f21f99
--- /dev/null
+++ b/libraries/base/Data/String.hs
@@ -0,0 +1,39 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE NoImplicitPrelude, FlexibleInstances #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.String
+-- Copyright   :  (c) The University of Glasgow 2007
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+--
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  experimental
+-- Portability :  portable
+--
+-- The @String@ type and associated operations.
+--
+-----------------------------------------------------------------------------
+
+module Data.String (
+   String
+ , IsString(..)
+
+ -- * Functions on strings
+ , lines
+ , words
+ , unlines
+ , unwords
+ ) where
+
+import GHC.Base
+import Data.List (lines, words, unlines, unwords)
+
+-- | Class for string-like datastructures; used by the overloaded string
+--   extension (-XOverloadedStrings in GHC).
+class IsString a where
+    fromString :: String -> a
+
+instance IsString [Char] where
+    fromString xs = xs
+
diff --git a/libraries/base/Data/Traversable.hs b/libraries/base/Data/Traversable.hs
new file mode 100644
index 000000000000..e69d2b3c5ae5
--- /dev/null
+++ b/libraries/base/Data/Traversable.hs
@@ -0,0 +1,280 @@
+{-# LANGUAGE Trustworthy #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.Traversable
+-- Copyright   :  Conor McBride and Ross Paterson 2005
+-- License     :  BSD-style (see the LICENSE file in the distribution)
+--
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  experimental
+-- Portability :  portable
+--
+-- Class of data structures that can be traversed from left to right,
+-- performing an action on each element.
+--
+-- See also
+--
+--  * \"Applicative Programming with Effects\",
+--    by Conor McBride and Ross Paterson,
+--    /Journal of Functional Programming/ 18:1 (2008) 1-13, online at
+--    <http://www.soi.city.ac.uk/~ross/papers/Applicative.html>.
+--
+--  * \"The Essence of the Iterator Pattern\",
+--    by Jeremy Gibbons and Bruno Oliveira,
+--    in /Mathematically-Structured Functional Programming/, 2006, online at
+--    <http://web.comlab.ox.ac.uk/oucl/work/jeremy.gibbons/publications/#iterator>.
+--
+--  * \"An Investigation of the Laws of Traversals\",
+--    by Mauro Jaskelioff and Ondrej Rypacek,
+--    in /Mathematically-Structured Functional Programming/, 2012, online at
+--    <http://arxiv.org/pdf/1202.2919>.
+--
+-- Note that the functions 'mapM' and 'sequence' generalize "Prelude"
+-- functions of the same names from lists to any 'Traversable' functor.
+-- To avoid ambiguity, either import the "Prelude" hiding these names
+-- or qualify uses of these function names with an alias for this module.
+--
+-----------------------------------------------------------------------------
+
+module Data.Traversable (
+    -- * The 'Traversable' class
+    Traversable(..),
+    -- * Utility functions
+    for,
+    forM,
+    mapAccumL,
+    mapAccumR,
+    -- * General definitions for superclass methods
+    fmapDefault,
+    foldMapDefault,
+    ) where
+
+import Prelude hiding (mapM, sequence, foldr)
+import qualified Prelude (mapM, foldr)
+import Control.Applicative
+import Data.Foldable (Foldable())
+import Data.Monoid (Monoid)
+import Data.Proxy
+
+import GHC.Arr
+
+-- | Functors representing data structures that can be traversed from
+-- left to right.
+--
+-- Minimal complete definition: 'traverse' or 'sequenceA'.
+--
+-- A definition of 'traverse' must satisfy the following laws:
+--
+-- [/naturality/]
+--   @t . 'traverse' f = 'traverse' (t . f)@
+--   for every applicative transformation @t@
+--
+-- [/identity/]
+--   @'traverse' Identity = Identity@
+--
+-- [/composition/]
+--   @'traverse' (Compose . 'fmap' g . f) = Compose . 'fmap' ('traverse' g) . 'traverse' f@
+--
+-- A definition of 'sequenceA' must satisfy the following laws:
+--
+-- [/naturality/]
+--   @t . 'sequenceA' = 'sequenceA' . 'fmap' t@
+--   for every applicative transformation @t@
+--
+-- [/identity/]
+--   @'sequenceA' . 'fmap' Identity = Identity@
+--
+-- [/composition/]
+--   @'sequenceA' . 'fmap' Compose = Compose . 'fmap' 'sequenceA' . 'sequenceA'@
+--
+-- where an /applicative transformation/ is a function
+--
+-- @t :: (Applicative f, Applicative g) => f a -> g a@
+--
+-- preserving the 'Applicative' operations, i.e.
+--
+--  * @t ('pure' x) = 'pure' x@
+--
+--  * @t (x '<*>' y) = t x '<*>' t y@
+--
+-- and the identity functor @Identity@ and composition of functors @Compose@
+-- are defined as
+--
+-- >   newtype Identity a = Identity a
+-- >
+-- >   instance Functor Identity where
+-- >     fmap f (Identity x) = Identity (f x)
+-- >
+-- >   instance Applicative Indentity where
+-- >     pure x = Identity x
+-- >     Identity f <*> Identity x = Identity (f x)
+-- >
+-- >   newtype Compose f g a = Compose (f (g a))
+-- >
+-- >   instance (Functor f, Functor g) => Functor (Compose f g) where
+-- >     fmap f (Compose x) = Compose (fmap (fmap f) x)
+-- >
+-- >   instance (Applicative f, Applicative g) => Applicative (Compose f g) where
+-- >     pure x = Compose (pure (pure x))
+-- >     Compose f <*> Compose x = Compose ((<*>) <$> f <*> x)
+--
+-- (The naturality law is implied by parametricity.)
+--
+-- Instances are similar to 'Functor', e.g. given a data type
+--
+-- > data Tree a = Empty | Leaf a | Node (Tree a) a (Tree a)
+--
+-- a suitable instance would be
+--
+-- > instance Traversable Tree where
+-- >    traverse f Empty = pure Empty
+-- >    traverse f (Leaf x) = Leaf <$> f x
+-- >    traverse f (Node l k r) = Node <$> traverse f l <*> f k <*> traverse f r
+--
+-- This is suitable even for abstract types, as the laws for '<*>'
+-- imply a form of associativity.
+--
+-- The superclass instances should satisfy the following:
+--
+--  * In the 'Functor' instance, 'fmap' should be equivalent to traversal
+--    with the identity applicative functor ('fmapDefault').
+--
+--  * In the 'Foldable' instance, 'Data.Foldable.foldMap' should be
+--    equivalent to traversal with a constant applicative functor
+--    ('foldMapDefault').
+--
+class (Functor t, Foldable t) => Traversable t where
+    -- | Map each element of a structure to an action, evaluate
+    -- these actions from left to right, and collect the results.
+    traverse :: Applicative f => (a -> f b) -> t a -> f (t b)
+    traverse f = sequenceA . fmap f
+
+    -- | Evaluate each action in the structure from left to right,
+    -- and collect the results.
+    sequenceA :: Applicative f => t (f a) -> f (t a)
+    sequenceA = traverse id
+
+    -- | Map each element of a structure to a monadic action, evaluate
+    -- these actions from left to right, and collect the results.
+    mapM :: Monad m => (a -> m b) -> t a -> m (t b)
+    mapM f = unwrapMonad . traverse (WrapMonad . f)
+
+    -- | Evaluate each monadic action in the structure from left to right,
+    -- and collect the results.
+    sequence :: Monad m => t (m a) -> m (t a)
+    sequence = mapM id
+    {-# MINIMAL traverse | sequenceA #-}
+
+-- instances for Prelude types
+
+instance Traversable Maybe where
+    traverse _ Nothing = pure Nothing
+    traverse f (Just x) = Just <$> f x
+
+instance Traversable [] where
+    {-# INLINE traverse #-} -- so that traverse can fuse
+    traverse f = Prelude.foldr cons_f (pure [])
+      where cons_f x ys = (:) <$> f x <*> ys
+
+    mapM = Prelude.mapM
+
+instance Traversable (Either a) where
+    traverse _ (Left x) = pure (Left x)
+    traverse f (Right y) = Right <$> f y
+
+instance Traversable ((,) a) where
+    traverse f (x, y) = (,) x <$> f y
+
+instance Ix i => Traversable (Array i) where
+    traverse f arr = listArray (bounds arr) `fmap` traverse f (elems arr)
+
+instance Traversable Proxy where
+    traverse _ _ = pure Proxy
+    {-# INLINE traverse #-}
+    sequenceA _ = pure Proxy
+    {-# INLINE sequenceA #-}
+    mapM _ _ = return Proxy
+    {-# INLINE mapM #-}
+    sequence _ = return Proxy
+    {-# INLINE sequence #-}
+
+instance Traversable (Const m) where
+    traverse _ (Const m) = pure $ Const m
+
+-- general functions
+
+-- | 'for' is 'traverse' with its arguments flipped.
+for :: (Traversable t, Applicative f) => t a -> (a -> f b) -> f (t b)
+{-# INLINE for #-}
+for = flip traverse
+
+-- | 'forM' is 'mapM' with its arguments flipped.
+forM :: (Traversable t, Monad m) => t a -> (a -> m b) -> m (t b)
+{-# INLINE forM #-}
+forM = flip mapM
+
+-- left-to-right state transformer
+newtype StateL s a = StateL { runStateL :: s -> (s, a) }
+
+instance Functor (StateL s) where
+    fmap f (StateL k) = StateL $ \ s -> let (s', v) = k s in (s', f v)
+
+instance Applicative (StateL s) where
+    pure x = StateL (\ s -> (s, x))
+    StateL kf <*> StateL kv = StateL $ \ s ->
+        let (s', f) = kf s
+            (s'', v) = kv s'
+        in (s'', f v)
+
+-- |The 'mapAccumL' function behaves like a combination of 'fmap'
+-- and 'foldl'; it applies a function to each element of a structure,
+-- passing an accumulating parameter from left to right, and returning
+-- a final value of this accumulator together with the new structure.
+mapAccumL :: Traversable t => (a -> b -> (a, c)) -> a -> t b -> (a, t c)
+mapAccumL f s t = runStateL (traverse (StateL . flip f) t) s
+
+-- right-to-left state transformer
+newtype StateR s a = StateR { runStateR :: s -> (s, a) }
+
+instance Functor (StateR s) where
+    fmap f (StateR k) = StateR $ \ s -> let (s', v) = k s in (s', f v)
+
+instance Applicative (StateR s) where
+    pure x = StateR (\ s -> (s, x))
+    StateR kf <*> StateR kv = StateR $ \ s ->
+        let (s', v) = kv s
+            (s'', f) = kf s'
+        in (s'', f v)
+
+-- |The 'mapAccumR' function behaves like a combination of 'fmap'
+-- and 'foldr'; it applies a function to each element of a structure,
+-- passing an accumulating parameter from right to left, and returning
+-- a final value of this accumulator together with the new structure.
+mapAccumR :: Traversable t => (a -> b -> (a, c)) -> a -> t b -> (a, t c)
+mapAccumR f s t = runStateR (traverse (StateR . flip f) t) s
+
+-- | This function may be used as a value for `fmap` in a `Functor`
+--   instance, provided that 'traverse' is defined. (Using
+--   `fmapDefault` with a `Traversable` instance defined only by
+--   'sequenceA' will result in infinite recursion.)
+fmapDefault :: Traversable t => (a -> b) -> t a -> t b
+{-# INLINE fmapDefault #-}
+fmapDefault f = getId . traverse (Id . f)
+
+-- | This function may be used as a value for `Data.Foldable.foldMap`
+-- in a `Foldable` instance.
+foldMapDefault :: (Traversable t, Monoid m) => (a -> m) -> t a -> m
+foldMapDefault f = getConst . traverse (Const . f)
+
+-- local instances
+
+newtype Id a = Id { getId :: a }
+
+instance Functor Id where
+    fmap f (Id x) = Id (f x)
+
+instance Applicative Id where
+    pure = Id
+    Id f <*> Id x = Id (f x)
+
diff --git a/libraries/base/Data/Tuple.hs b/libraries/base/Data/Tuple.hs
new file mode 100644
index 000000000000..ec8478a6ff58
--- /dev/null
+++ b/libraries/base/Data/Tuple.hs
@@ -0,0 +1,64 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# OPTIONS_GHC -fno-warn-unused-imports #-}
+-- XXX -fno-warn-unused-imports needed for the GHC.Tuple import below. Sigh.
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.Tuple
+-- Copyright   :  (c) The University of Glasgow 2001
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+-- 
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  experimental
+-- Portability :  portable
+--
+-- The tuple data types, and associated functions.
+--
+-----------------------------------------------------------------------------
+
+module Data.Tuple
+  ( fst
+  , snd
+  , curry
+  , uncurry
+  , swap
+  )
+    where
+
+import GHC.Base
+-- We need to depend on GHC.Base so that
+-- a) so that we get GHC.Classes, GHC.Types
+
+-- b) so that GHC.Base.inline is available, which is used
+--    when expanding instance declarations
+
+import GHC.Tuple
+-- We must import GHC.Tuple, to ensure sure that the
+-- data constructors of `(,)' are in scope when we do
+-- the standalone deriving instance for Eq (a,b) etc
+
+default ()              -- Double isn't available yet
+
+-- ---------------------------------------------------------------------------
+-- Standard functions over tuples
+
+-- | Extract the first component of a pair.
+fst                     :: (a,b) -> a
+fst (x,_)               =  x
+
+-- | Extract the second component of a pair.
+snd                     :: (a,b) -> b
+snd (_,y)               =  y
+
+-- | 'curry' converts an uncurried function to a curried function.
+curry                   :: ((a, b) -> c) -> a -> b -> c
+curry f x y             =  f (x, y)
+
+-- | 'uncurry' converts a curried function to a function on pairs.
+uncurry                 :: (a -> b -> c) -> ((a, b) -> c)
+uncurry f p             =  f (fst p) (snd p)
+
+-- | Swap the components of a pair.
+swap                    :: (a,b) -> (b,a)
+swap (a,b)              = (b,a)
diff --git a/libraries/base/Data/Type/Bool.hs b/libraries/base/Data/Type/Bool.hs
new file mode 100644
index 000000000000..705db9eb2865
--- /dev/null
+++ b/libraries/base/Data/Type/Bool.hs
@@ -0,0 +1,56 @@
+{-# LANGUAGE TypeFamilies, TypeOperators, DataKinds, NoImplicitPrelude,
+             PolyKinds #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.Type.Bool
+-- License     :  BSD-style (see the LICENSE file in the distribution)
+--
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  experimental
+-- Portability :  not portable
+--
+-- Basic operations on type-level Booleans.
+--
+-- /Since: 4.7.0.0/
+-----------------------------------------------------------------------------
+
+module Data.Type.Bool (
+  If, type (&&), type (||), Not
+  ) where
+
+import Data.Bool
+
+-- This needs to be in base because (&&) is used in Data.Type.Equality.
+-- The other functions do not need to be in base, but seemed to be appropriate
+-- here.
+
+-- | Type-level "If". @If True a b@ ==> @a@; @If False a b@ ==> @b@
+type family If cond tru fls where
+  If True  tru fls = tru
+  If False tru fls = fls
+
+-- | Type-level "and"
+type family a && b where
+  False && a     = False
+  True  && a     = a
+  a     && False = False
+  a     && True  = a
+  a     && a     = a
+infixr 3 &&
+
+-- | Type-level "or"
+type family a || b where
+  False || a     = a
+  True  || a     = True
+  a     || False = a
+  a     || True  = True
+  a     || a     = a
+infixr 2 ||
+
+-- | Type-level "not"
+type family Not a where
+  Not False = True
+  Not True  = False
+
+  
\ No newline at end of file
diff --git a/libraries/base/Data/Type/Coercion.hs b/libraries/base/Data/Type/Coercion.hs
new file mode 100644
index 000000000000..7044339a3a04
--- /dev/null
+++ b/libraries/base/Data/Type/Coercion.hs
@@ -0,0 +1,101 @@
+{-# LANGUAGE DeriveGeneric       #-}
+{-# LANGUAGE TypeOperators       #-}
+{-# LANGUAGE TypeFamilies        #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE GADTs               #-}
+{-# LANGUAGE FlexibleInstances   #-}
+{-# LANGUAGE StandaloneDeriving  #-}
+{-# LANGUAGE NoImplicitPrelude   #-}
+{-# LANGUAGE PolyKinds           #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.Type.Coercion
+-- License     :  BSD-style (see the LICENSE file in the distribution)
+--
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  experimental
+-- Portability :  not portable
+--
+-- Definition of representational equality ('Coercion').
+--
+-- /Since: 4.7.0.0/
+-----------------------------------------------------------------------------
+
+module Data.Type.Coercion
+  ( Coercion(..)
+  , coerceWith
+  , sym
+  , trans
+  , repr
+  , TestCoercion(..)
+  ) where
+
+import qualified Data.Type.Equality as Eq
+import Data.Maybe
+import GHC.Enum
+import GHC.Show
+import GHC.Read
+import GHC.Base
+
+-- | Representational equality. If @Coercion a b@ is inhabited by some terminating
+-- value, then the type @a@ has the same underlying representation as the type @b@.
+--
+-- To use this equality in practice, pattern-match on the @Coercion a b@ to get out
+-- the @Coercible a b@ instance, and then use 'coerce' to apply it.
+--
+-- /Since: 4.7.0.0/
+data Coercion a b where
+  Coercion :: Coercible a b => Coercion a b
+
+-- with credit to Conal Elliott for 'ty', Erik Hesselink & Martijn van
+-- Steenbergen for 'type-equality', Edward Kmett for 'eq', and Gabor Greif
+-- for 'type-eq'
+
+newtype Sym a b = Sym { unsym :: Coercion b a }
+
+-- | Type-safe cast, using representational equality
+coerceWith :: Coercion a b -> a -> b
+coerceWith Coercion x = coerce x
+
+-- | Symmetry of representational equality
+sym :: forall a b. Coercion a b -> Coercion b a
+sym Coercion = unsym (coerce (Sym Coercion :: Sym a a))
+
+-- | Transitivity of representational equality
+trans :: Coercion a b -> Coercion b c -> Coercion a c
+trans c Coercion = coerce c
+
+-- | Convert propositional (nominal) equality to representational equality
+repr :: (a Eq.:~: b) -> Coercion a b
+repr Eq.Refl = Coercion
+
+deriving instance Eq   (Coercion a b)
+deriving instance Show (Coercion a b)
+deriving instance Ord  (Coercion a b)
+
+instance Coercible a b => Read (Coercion a b) where
+  readsPrec d = readParen (d > 10) (\r -> [(Coercion, s) | ("Coercion",s) <- lex r ])
+
+instance Coercible a b => Enum (Coercion a b) where
+  toEnum 0 = Coercion
+  toEnum _ = error "Data.Type.Coercion.toEnum: bad argument"
+
+  fromEnum Coercion = 0
+
+instance Coercible a b => Bounded (Coercion a b) where
+  minBound = Coercion
+  maxBound = Coercion
+
+-- | This class contains types where you can learn the equality of two types
+-- from information contained in /terms/. Typically, only singleton types should
+-- inhabit this class.
+class TestCoercion f where
+  -- | Conditionally prove the representational equality of @a@ and @b@.
+  testCoercion :: f a -> f b -> Maybe (Coercion a b)
+
+instance TestCoercion ((Eq.:~:) a) where
+  testCoercion Eq.Refl Eq.Refl = Just Coercion
+
+instance TestCoercion (Coercion a) where
+  testCoercion c Coercion = Just $ coerce (sym c)
diff --git a/libraries/base/Data/Type/Equality.hs b/libraries/base/Data/Type/Equality.hs
new file mode 100644
index 000000000000..626e817b3066
--- /dev/null
+++ b/libraries/base/Data/Type/Equality.hs
@@ -0,0 +1,282 @@
+{-# LANGUAGE DeriveGeneric        #-}
+{-# LANGUAGE TypeOperators        #-}
+{-# LANGUAGE GADTs                #-}
+{-# LANGUAGE FlexibleInstances    #-}
+{-# LANGUAGE StandaloneDeriving   #-}
+{-# LANGUAGE NoImplicitPrelude    #-}
+{-# LANGUAGE PolyKinds            #-}
+{-# LANGUAGE RankNTypes           #-}
+{-# LANGUAGE DataKinds            #-}
+{-# LANGUAGE TypeFamilies         #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE ExplicitNamespaces   #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.Type.Equality
+-- License     :  BSD-style (see the LICENSE file in the distribution)
+--
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  experimental
+-- Portability :  not portable
+--
+-- Definition of propositional equality @(:~:)@. Pattern-matching on a variable
+-- of type @(a :~: b)@ produces a proof that @a ~ b@.
+--
+-- /Since: 4.7.0.0/
+-----------------------------------------------------------------------------
+
+
+
+module Data.Type.Equality (
+  -- * The equality type
+  (:~:)(..),
+  
+  -- * Working with equality
+  sym, trans, castWith, gcastWith, apply, inner, outer,
+
+  -- * Inferring equality from other types
+  TestEquality(..),
+
+  -- * Boolean type-level equality
+  type (==)
+  ) where
+
+import Data.Maybe
+import GHC.Enum
+import GHC.Show
+import GHC.Read
+import GHC.Base
+import Data.Type.Bool
+
+infix 4 :~:
+
+-- | Propositional equality. If @a :~: b@ is inhabited by some terminating
+-- value, then the type @a@ is the same as the type @b@. To use this equality
+-- in practice, pattern-match on the @a :~: b@ to get out the @Refl@ constructor;
+-- in the body of the pattern-match, the compiler knows that @a ~ b@.
+--
+-- /Since: 4.7.0.0/
+data a :~: b where
+  Refl :: a :~: a
+
+-- with credit to Conal Elliott for 'ty', Erik Hesselink & Martijn van
+-- Steenbergen for 'type-equality', Edward Kmett for 'eq', and Gabor Greif
+-- for 'type-eq'
+
+-- | Symmetry of equality
+sym :: (a :~: b) -> (b :~: a)
+sym Refl = Refl
+
+-- | Transitivity of equality
+trans :: (a :~: b) -> (b :~: c) -> (a :~: c)
+trans Refl Refl = Refl
+
+-- | Type-safe cast, using propositional equality
+castWith :: (a :~: b) -> a -> b
+castWith Refl x = x
+
+-- | Generalized form of type-safe cast using propositional equality
+gcastWith :: (a :~: b) -> ((a ~ b) => r) -> r
+gcastWith Refl x = x
+
+-- | Apply one equality to another, respectively
+apply :: (f :~: g) -> (a :~: b) -> (f a :~: g b)
+apply Refl Refl = Refl
+
+-- | Extract equality of the arguments from an equality of a applied types
+inner :: (f a :~: g b) -> (a :~: b)
+inner Refl = Refl
+
+-- | Extract equality of type constructors from an equality of applied types
+outer :: (f a :~: g b) -> (f :~: g)
+outer Refl = Refl
+
+deriving instance Eq   (a :~: b)
+deriving instance Show (a :~: b)
+deriving instance Ord  (a :~: b)
+
+instance a ~ b => Read (a :~: b) where
+  readsPrec d = readParen (d > 10) (\r -> [(Refl, s) | ("Refl",s) <- lex r ])
+
+instance a ~ b => Enum (a :~: b) where
+  toEnum 0 = Refl
+  toEnum _ = error "Data.Type.Equality.toEnum: bad argument"
+
+  fromEnum Refl = 0
+
+instance a ~ b => Bounded (a :~: b) where
+  minBound = Refl
+  maxBound = Refl
+
+-- | This class contains types where you can learn the equality of two types
+-- from information contained in /terms/. Typically, only singleton types should
+-- inhabit this class.
+class TestEquality f where
+  -- | Conditionally prove the equality of @a@ and @b@.
+  testEquality :: f a -> f b -> Maybe (a :~: b)
+
+instance TestEquality ((:~:) a) where
+  testEquality Refl Refl = Just Refl
+
+-- | A type family to compute Boolean equality. Instances are provided
+-- only for /open/ kinds, such as @*@ and function kinds. Instances are
+-- also provided for datatypes exported from base. A poly-kinded instance
+-- is /not/ provided, as a recursive definition for algebraic kinds is
+-- generally more useful.
+type family (a :: k) == (b :: k) :: Bool
+infix 4 ==
+
+{-
+This comment explains more about why a poly-kinded instance for (==) is
+not provided. To be concrete, here would be the poly-kinded instance:
+
+type family EqPoly (a :: k) (b :: k) where
+ EqPoly a a = True
+ EqPoly a b = False
+type instance (a :: k) == (b :: k) = EqPoly a b
+
+Note that this overlaps with every other instance -- if this were defined,
+it would be the only instance for (==).
+
+Now, consider
+data Nat = Zero | Succ Nat
+
+Suppose I want
+foo :: (Succ n == Succ m) ~ True => ((n == m) :~: True)
+foo = Refl
+
+This would not type-check with the poly-kinded instance. `Succ n == Succ m`
+quickly becomes `EqPoly (Succ n) (Succ m)` but then is stuck. We don't know
+enough about `n` and `m` to reduce further.
+
+On the other hand, consider this:
+
+type family EqNat (a :: Nat) (b :: Nat) where
+ EqNat Zero     Zero     = True
+ EqNat (Succ n) (Succ m) = EqNat n m
+ EqNat n        m        = False
+type instance (a :: Nat) == (b :: Nat) = EqNat a b
+
+With this instance, `foo` type-checks fine. `Succ n == Succ m` becomes `EqNat
+(Succ n) (Succ m)` which becomes `EqNat n m`. Thus, we can conclude `(n == m)
+~ True` as desired.
+
+So, the Nat-specific instance allows strictly more reductions, and is thus
+preferable to the poly-kinded instance. But, if we introduce the poly-kinded
+instance, we are barred from writing the Nat-specific instance, due to
+overlap.
+
+Even better than the current instance for * would be one that does this sort
+of recursion for all datatypes, something like this:
+
+type family EqStar (a :: *) (b :: *) where
+ EqStar Bool Bool = True
+ EqStar (a,b) (c,d) = a == c && b == d
+ EqStar (Maybe a) (Maybe b) = a == b
+ ...
+ EqStar a b = False
+
+The problem is the (...) is extensible -- we would want to add new cases for
+all datatypes in scope. This is not currently possible for closed type
+families.
+-}
+
+-- all of the following closed type families are local to this module
+type family EqStar (a :: *) (b :: *) where
+  EqStar a a = True
+  EqStar a b = False
+
+-- This looks dangerous, but it isn't. This allows == to be defined
+-- over arbitrary type constructors.
+type family EqArrow (a :: k1 -> k2) (b :: k1 -> k2) where
+  EqArrow a a = True
+  EqArrow a b = False
+
+type family EqBool a b where
+  EqBool True  True  = True
+  EqBool False False = True
+  EqBool a     b     = False
+
+type family EqOrdering a b where
+  EqOrdering LT LT = True
+  EqOrdering EQ EQ = True
+  EqOrdering GT GT = True
+  EqOrdering a  b  = False
+
+type EqUnit (a :: ()) (b :: ()) = True
+
+type family EqList a b where
+  EqList '[]        '[]        = True
+  EqList (h1 ': t1) (h2 ': t2) = (h1 == h2) && (t1 == t2)
+  EqList a          b          = False
+
+type family EqMaybe a b where
+  EqMaybe Nothing  Nothing  = True
+  EqMaybe (Just x) (Just y) = x == y
+  EqMaybe a        b        = False
+
+type family Eq2 a b where
+  Eq2 '(a1, b1) '(a2, b2) = a1 == a2 && b1 == b2
+
+type family Eq3 a b where
+  Eq3 '(a1, b1, c1) '(a2, b2, c2) = a1 == a2 && b1 == b2 && c1 == c2
+
+type family Eq4 a b where
+  Eq4 '(a1, b1, c1, d1) '(a2, b2, c2, d2) = a1 == a2 && b1 == b2 && c1 == c2 && d1 == d2
+
+type family Eq5 a b where
+  Eq5 '(a1, b1, c1, d1, e1) '(a2, b2, c2, d2, e2) = a1 == a2 && b1 == b2 && c1 == c2 && d1 == d2 && e1 == e2
+
+type family Eq6 a b where
+  Eq6 '(a1, b1, c1, d1, e1, f1) '(a2, b2, c2, d2, e2, f2) = a1 == a2 && b1 == b2 && c1 == c2 && d1 == d2 && e1 == e2 && f1 == f2
+
+type family Eq7 a b where
+  Eq7 '(a1, b1, c1, d1, e1, f1, g1) '(a2, b2, c2, d2, e2, f2, g2) = a1 == a2 && b1 == b2 && c1 == c2 && d1 == d2 && e1 == e2 && f1 == f2 && g1 == g2
+
+type family Eq8 a b where
+  Eq8 '(a1, b1, c1, d1, e1, f1, g1, h1) '(a2, b2, c2, d2, e2, f2, g2, h2) = a1 == a2 && b1 == b2 && c1 == c2 && d1 == d2 && e1 == e2 && f1 == f2 && g1 == g2 && h1 == h2
+
+type family Eq9 a b where
+  Eq9 '(a1, b1, c1, d1, e1, f1, g1, h1, i1) '(a2, b2, c2, d2, e2, f2, g2, h2, i2) = a1 == a2 && b1 == b2 && c1 == c2 && d1 == d2 && e1 == e2 && f1 == f2 && g1 == g2 && h1 == h2 && i1 == i2
+
+type family Eq10 a b where
+  Eq10 '(a1, b1, c1, d1, e1, f1, g1, h1, i1, j1) '(a2, b2, c2, d2, e2, f2, g2, h2, i2, j2) = a1 == a2 && b1 == b2 && c1 == c2 && d1 == d2 && e1 == e2 && f1 == f2 && g1 == g2 && h1 == h2 && i1 == i2 && j1 == j2
+
+type family Eq11 a b where
+  Eq11 '(a1, b1, c1, d1, e1, f1, g1, h1, i1, j1, k1) '(a2, b2, c2, d2, e2, f2, g2, h2, i2, j2, k2) = a1 == a2 && b1 == b2 && c1 == c2 && d1 == d2 && e1 == e2 && f1 == f2 && g1 == g2 && h1 == h2 && i1 == i2 && j1 == j2 && k1 == k2
+
+type family Eq12 a b where
+  Eq12 '(a1, b1, c1, d1, e1, f1, g1, h1, i1, j1, k1, l1) '(a2, b2, c2, d2, e2, f2, g2, h2, i2, j2, k2, l2) = a1 == a2 && b1 == b2 && c1 == c2 && d1 == d2 && e1 == e2 && f1 == f2 && g1 == g2 && h1 == h2 && i1 == i2 && j1 == j2 && k1 == k2 && l1 == l2
+
+type family Eq13 a b where
+  Eq13 '(a1, b1, c1, d1, e1, f1, g1, h1, i1, j1, k1, l1, m1) '(a2, b2, c2, d2, e2, f2, g2, h2, i2, j2, k2, l2, m2) = a1 == a2 && b1 == b2 && c1 == c2 && d1 == d2 && e1 == e2 && f1 == f2 && g1 == g2 && h1 == h2 && i1 == i2 && j1 == j2 && k1 == k2 && l1 == l2 && m1 == m2
+
+type family Eq14 a b where
+  Eq14 '(a1, b1, c1, d1, e1, f1, g1, h1, i1, j1, k1, l1, m1, n1) '(a2, b2, c2, d2, e2, f2, g2, h2, i2, j2, k2, l2, m2, n2) = a1 == a2 && b1 == b2 && c1 == c2 && d1 == d2 && e1 == e2 && f1 == f2 && g1 == g2 && h1 == h2 && i1 == i2 && j1 == j2 && k1 == k2 && l1 == l2 && m1 == m2 && n1 == n2
+
+type family Eq15 a b where
+  Eq15 '(a1, b1, c1, d1, e1, f1, g1, h1, i1, j1, k1, l1, m1, n1, o1) '(a2, b2, c2, d2, e2, f2, g2, h2, i2, j2, k2, l2, m2, n2, o2) = a1 == a2 && b1 == b2 && c1 == c2 && d1 == d2 && e1 == e2 && f1 == f2 && g1 == g2 && h1 == h2 && i1 == i2 && j1 == j2 && k1 == k2 && l1 == l2 && m1 == m2 && n1 == n2 && o1 == o2
+
+-- these all look to be overlapping, but they are differentiated by their kinds
+type instance a == b = EqStar a b
+type instance a == b = EqArrow a b
+type instance a == b = EqBool a b
+type instance a == b = EqOrdering a b
+type instance a == b = EqUnit a b
+type instance a == b = EqList a b
+type instance a == b = EqMaybe a b
+type instance a == b = Eq2 a b
+type instance a == b = Eq3 a b
+type instance a == b = Eq4 a b
+type instance a == b = Eq5 a b
+type instance a == b = Eq6 a b
+type instance a == b = Eq7 a b
+type instance a == b = Eq8 a b
+type instance a == b = Eq9 a b
+type instance a == b = Eq10 a b
+type instance a == b = Eq11 a b
+type instance a == b = Eq12 a b
+type instance a == b = Eq13 a b
+type instance a == b = Eq14 a b
+type instance a == b = Eq15 a b
diff --git a/libraries/base/Data/Typeable.hs b/libraries/base/Data/Typeable.hs
new file mode 100644
index 000000000000..f658a9e78864
--- /dev/null
+++ b/libraries/base/Data/Typeable.hs
@@ -0,0 +1,137 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE NoImplicitPrelude
+           , OverlappingInstances
+           , ScopedTypeVariables
+           , FlexibleInstances
+           , TypeOperators
+           , PolyKinds
+           , GADTs
+           , MagicHash
+  #-}
+{-# OPTIONS_GHC -funbox-strict-fields #-}
+
+-- The -XOverlappingInstances flag allows the user to over-ride
+-- the instances for Typeable given here.  In particular, we provide an instance
+--      instance ... => Typeable (s a) 
+-- But a user might want to say
+--      instance ... => Typeable (MyType a b)
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.Typeable
+-- Copyright   :  (c) The University of Glasgow, CWI 2001--2004
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+-- 
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  experimental
+-- Portability :  portable
+--
+-- The 'Typeable' class reifies types to some extent by associating type
+-- representations to types. These type representations can be compared,
+-- and one can in turn define a type-safe cast operation. To this end,
+-- an unsafe cast is guarded by a test for type (representation)
+-- equivalence. The module "Data.Dynamic" uses Typeable for an
+-- implementation of dynamics. The module "Data.Data" uses Typeable
+-- and type-safe cast (but not dynamics) to support the \"Scrap your
+-- boilerplate\" style of generic programming.
+--
+-- == Compatibility Notes
+--
+-- Since GHC 7.8, 'Typeable' is poly-kinded. The changes required for this might
+-- break some old programs involving 'Typeable'. More details on this, including
+-- how to fix your code, can be found on the
+-- <https://ghc.haskell.org/trac/ghc/wiki/GhcKinds/PolyTypeable PolyTypeable wiki page>
+--
+-----------------------------------------------------------------------------
+
+module Data.Typeable
+  (
+        -- * The Typeable class
+        Typeable,
+        typeRep,
+
+        -- * Propositional equality
+        (:~:)(Refl),
+
+        -- * For backwards compatibility
+        typeOf, typeOf1, typeOf2, typeOf3, typeOf4, typeOf5, typeOf6, typeOf7,
+        Typeable1, Typeable2, Typeable3, Typeable4, Typeable5, Typeable6,
+        Typeable7,
+
+        -- * Type-safe cast
+        cast,
+        eqT,
+        gcast,                  -- a generalisation of cast
+
+        -- * Generalized casts for higher-order kinds
+        gcast1,                 -- :: ... => c (t a) -> Maybe (c (t' a))
+        gcast2,                 -- :: ... => c (t a b) -> Maybe (c (t' a b))
+
+        -- * A canonical proxy type
+        Proxy (..),
+        
+        -- * Type representations
+        TypeRep,        -- abstract, instance of: Eq, Show, Typeable
+        showsTypeRep,
+
+        TyCon,          -- abstract, instance of: Eq, Show, Typeable
+        tyConString,
+        tyConPackage,
+        tyConModule,
+        tyConName,
+
+        -- * Construction of type representations
+        -- mkTyCon,        -- :: String  -> TyCon
+        mkTyCon3,       -- :: String  -> String -> String -> TyCon
+        mkTyConApp,     -- :: TyCon   -> [TypeRep] -> TypeRep
+        mkAppTy,        -- :: TypeRep -> TypeRep   -> TypeRep
+        mkFunTy,        -- :: TypeRep -> TypeRep   -> TypeRep
+
+        -- * Observation of type representations
+        splitTyConApp,  -- :: TypeRep -> (TyCon, [TypeRep])
+        funResultTy,    -- :: TypeRep -> TypeRep   -> Maybe TypeRep
+        typeRepTyCon,   -- :: TypeRep -> TyCon
+        typeRepArgs,    -- :: TypeRep -> [TypeRep]
+  ) where
+
+import Data.Typeable.Internal hiding (mkTyCon)
+import Data.Type.Equality
+
+import Unsafe.Coerce
+import Data.Maybe
+import GHC.Base
+
+-------------------------------------------------------------
+--
+--              Type-safe cast
+--
+-------------------------------------------------------------
+
+-- | The type-safe cast operation
+cast :: forall a b. (Typeable a, Typeable b) => a -> Maybe b
+cast x = if typeRep (Proxy :: Proxy a) == typeRep (Proxy :: Proxy b)
+           then Just $ unsafeCoerce x
+           else Nothing
+
+-- | Extract a witness of equality of two types
+--
+-- /Since: 4.7.0.0/
+eqT :: forall a b. (Typeable a, Typeable b) => Maybe (a :~: b)
+eqT = if typeRep (Proxy :: Proxy a) == typeRep (Proxy :: Proxy b)
+      then Just $ unsafeCoerce Refl
+      else Nothing
+
+-- | A flexible variation parameterised in a type constructor
+gcast :: forall a b c. (Typeable a, Typeable b) => c a -> Maybe (c b)
+gcast x = fmap (\Refl -> x) (eqT :: Maybe (a :~: b))
+
+-- | Cast over @k1 -> k2@
+gcast1 :: forall c t t' a. (Typeable t, Typeable t')
+       => c (t a) -> Maybe (c (t' a)) 
+gcast1 x = fmap (\Refl -> x) (eqT :: Maybe (t :~: t'))
+
+-- | Cast over @k1 -> k2 -> k3@
+gcast2 :: forall c t t' a b. (Typeable t, Typeable t')
+       => c (t a b) -> Maybe (c (t' a b)) 
+gcast2 x = fmap (\Refl -> x) (eqT :: Maybe (t :~: t'))
+
diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs
new file mode 100644
index 000000000000..b67f88c446b3
--- /dev/null
+++ b/libraries/base/Data/Typeable/Internal.hs
@@ -0,0 +1,496 @@
+{-# LANGUAGE Unsafe             #-}
+{-# LANGUAGE BangPatterns #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.Typeable.Internal
+-- Copyright   :  (c) The University of Glasgow, CWI 2001--2011
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+-- 
+-- The representations of the types TyCon and TypeRep, and the
+-- function mkTyCon which is used by derived instances of Typeable to
+-- construct a TyCon.
+--
+-----------------------------------------------------------------------------
+
+{-# LANGUAGE CPP
+           , NoImplicitPrelude
+           , OverlappingInstances
+           , ScopedTypeVariables
+           , FlexibleInstances
+           , MagicHash
+           , KindSignatures
+           , PolyKinds
+           , ConstraintKinds
+           , DeriveDataTypeable
+           , DataKinds
+           , UndecidableInstances
+           , StandaloneDeriving #-}
+
+module Data.Typeable.Internal (
+    Proxy (..),
+    TypeRep(..),
+    Fingerprint(..),
+    typeOf, typeOf1, typeOf2, typeOf3, typeOf4, typeOf5, typeOf6, typeOf7,
+    Typeable1, Typeable2, Typeable3, Typeable4, Typeable5, Typeable6, Typeable7,
+    TyCon(..),
+    typeRep,
+    mkTyCon,
+    mkTyCon3,
+    mkTyConApp,
+    mkAppTy,
+    typeRepTyCon,
+    Typeable(..),
+    mkFunTy,
+    splitTyConApp,
+    funResultTy,
+    typeRepArgs,
+    showsTypeRep,
+    tyConString,
+    listTc, funTc
+  ) where
+
+import GHC.Base
+import GHC.Word
+import GHC.Show
+import GHC.Read ( Read )
+import Data.Maybe
+import Data.Proxy
+import GHC.Num
+import GHC.Real
+-- import GHC.IORef
+-- import GHC.IOArray
+-- import GHC.MVar
+import GHC.ST           ( ST, STret )
+import GHC.STRef        ( STRef )
+import GHC.Ptr          ( Ptr, FunPtr )
+-- import GHC.Stable
+import GHC.Arr          ( Array, STArray, Ix )
+import GHC.TypeLits ( Nat, Symbol, KnownNat, KnownSymbol, natVal', symbolVal' )
+import Data.Type.Coercion
+import Data.Type.Equality
+import Text.ParserCombinators.ReadP ( ReadP )
+import Text.Read.Lex ( Lexeme, Number )
+import Text.ParserCombinators.ReadPrec ( ReadPrec )
+import GHC.Float ( FFFormat, RealFloat, Floating )
+import Data.Bits ( Bits, FiniteBits )
+import GHC.Enum ( Bounded, Enum )
+import Control.Monad ( MonadPlus )
+-- import Data.Int
+
+import GHC.Fingerprint.Type
+import {-# SOURCE #-} GHC.Fingerprint
+   -- loop: GHC.Fingerprint -> Foreign.Ptr -> Data.Typeable
+   -- Better to break the loop here, because we want non-SOURCE imports
+   -- of Data.Typeable as much as possible so we can optimise the derived
+   -- instances.
+
+-- | A concrete representation of a (monomorphic) type.  'TypeRep'
+-- supports reasonably efficient equality.
+data TypeRep = TypeRep {-# UNPACK #-} !Fingerprint TyCon [TypeRep]
+
+-- Compare keys for equality
+instance Eq TypeRep where
+  (TypeRep k1 _ _) == (TypeRep k2 _ _) = k1 == k2
+
+instance Ord TypeRep where
+  (TypeRep k1 _ _) <= (TypeRep k2 _ _) = k1 <= k2
+
+-- | An abstract representation of a type constructor.  'TyCon' objects can
+-- be built using 'mkTyCon'.
+data TyCon = TyCon {
+   tyConHash    :: {-# UNPACK #-} !Fingerprint,
+   tyConPackage :: String, -- ^ /Since: 4.5.0.0/
+   tyConModule  :: String, -- ^ /Since: 4.5.0.0/
+   tyConName    :: String  -- ^ /Since: 4.5.0.0/
+ }
+
+instance Eq TyCon where
+  (TyCon t1 _ _ _) == (TyCon t2 _ _ _) = t1 == t2
+
+instance Ord TyCon where
+  (TyCon k1 _ _ _) <= (TyCon k2 _ _ _) = k1 <= k2
+
+----------------- Construction --------------------
+
+#include "MachDeps.h"
+
+-- mkTyCon is an internal function to make it easier for GHC to
+-- generate derived instances.  GHC precomputes the MD5 hash for the
+-- TyCon and passes it as two separate 64-bit values to mkTyCon.  The
+-- TyCon for a derived Typeable instance will end up being statically
+-- allocated.
+
+#if WORD_SIZE_IN_BITS < 64
+mkTyCon :: Word64# -> Word64# -> String -> String -> String -> TyCon
+#else
+mkTyCon :: Word#   -> Word#   -> String -> String -> String -> TyCon
+#endif
+mkTyCon high# low# pkg modl name
+  = TyCon (Fingerprint (W64# high#) (W64# low#)) pkg modl name
+
+-- | Applies a type constructor to a sequence of types
+mkTyConApp  :: TyCon -> [TypeRep] -> TypeRep
+mkTyConApp tc@(TyCon tc_k _ _ _) []
+  = TypeRep tc_k tc [] -- optimisation: all derived Typeable instances
+                       -- end up here, and it helps generate smaller
+                       -- code for derived Typeable.
+mkTyConApp tc@(TyCon tc_k _ _ _) args
+  = TypeRep (fingerprintFingerprints (tc_k : arg_ks)) tc args
+  where
+    arg_ks = [k | TypeRep k _ _ <- args]
+
+-- | A special case of 'mkTyConApp', which applies the function 
+-- type constructor to a pair of types.
+mkFunTy  :: TypeRep -> TypeRep -> TypeRep
+mkFunTy f a = mkTyConApp funTc [f,a]
+
+-- | Splits a type constructor application
+splitTyConApp :: TypeRep -> (TyCon,[TypeRep])
+splitTyConApp (TypeRep _ tc trs) = (tc,trs)
+
+-- | Applies a type to a function type.  Returns: @'Just' u@ if the
+-- first argument represents a function of type @t -> u@ and the
+-- second argument represents a function of type @t@.  Otherwise,
+-- returns 'Nothing'.
+funResultTy :: TypeRep -> TypeRep -> Maybe TypeRep
+funResultTy trFun trArg
+  = case splitTyConApp trFun of
+      (tc, [t1,t2]) | tc == funTc && t1 == trArg -> Just t2
+      _ -> Nothing
+
+-- | Adds a TypeRep argument to a TypeRep.
+mkAppTy :: TypeRep -> TypeRep -> TypeRep
+mkAppTy (TypeRep _ tc trs) arg_tr = mkTyConApp tc (trs ++ [arg_tr])
+   -- Notice that we call mkTyConApp to construct the fingerprint from tc and
+   -- the arg fingerprints.  Simply combining the current fingerprint with
+   -- the new one won't give the same answer, but of course we want to 
+   -- ensure that a TypeRep of the same shape has the same fingerprint!
+   -- See Trac #5962
+
+-- | Builds a 'TyCon' object representing a type constructor.  An
+-- implementation of "Data.Typeable" should ensure that the following holds:
+--
+-- >  A==A' ^ B==B' ^ C==C' ==> mkTyCon A B C == mkTyCon A' B' C'
+--
+
+--
+mkTyCon3 :: String       -- ^ package name
+         -> String       -- ^ module name
+         -> String       -- ^ the name of the type constructor
+         -> TyCon        -- ^ A unique 'TyCon' object
+mkTyCon3 pkg modl name =
+  TyCon (fingerprintString (pkg ++ (' ':modl) ++ (' ':name))) pkg modl name
+
+----------------- Observation ---------------------
+
+-- | Observe the type constructor of a type representation
+typeRepTyCon :: TypeRep -> TyCon
+typeRepTyCon (TypeRep _ tc _) = tc
+
+-- | Observe the argument types of a type representation
+typeRepArgs :: TypeRep -> [TypeRep]
+typeRepArgs (TypeRep _ _ args) = args
+
+-- | Observe string encoding of a type representation
+{-# DEPRECATED tyConString "renamed to 'tyConName'; 'tyConModule' and 'tyConPackage' are also available." #-} -- deprecated in 7.4
+tyConString :: TyCon   -> String
+tyConString = tyConName
+
+-------------------------------------------------------------
+--
+--      The Typeable class and friends
+--
+-------------------------------------------------------------
+
+-- | The class 'Typeable' allows a concrete representation of a type to
+-- be calculated.
+class Typeable a where
+  typeRep# :: Proxy# a -> TypeRep
+
+-- | Takes a value of type @a@ and returns a concrete representation
+-- of that type.
+--
+-- /Since: 4.7.0.0/
+typeRep :: forall proxy a. Typeable a => proxy a -> TypeRep
+typeRep _ = typeRep# (proxy# :: Proxy# a)
+{-# INLINE typeRep #-}
+
+-- Keeping backwards-compatibility
+typeOf :: forall a. Typeable a => a -> TypeRep
+typeOf _ = typeRep (Proxy :: Proxy a)
+
+typeOf1 :: forall t (a :: *). Typeable t => t a -> TypeRep
+typeOf1 _ = typeRep (Proxy :: Proxy t)
+
+typeOf2 :: forall t (a :: *) (b :: *). Typeable t => t a b -> TypeRep
+typeOf2 _ = typeRep (Proxy :: Proxy t)
+
+typeOf3 :: forall t (a :: *) (b :: *) (c :: *). Typeable t
+        => t a b c -> TypeRep
+typeOf3 _ = typeRep (Proxy :: Proxy t)
+
+typeOf4 :: forall t (a :: *) (b :: *) (c :: *) (d :: *). Typeable t
+        => t a b c d -> TypeRep
+typeOf4 _ = typeRep (Proxy :: Proxy t)
+
+typeOf5 :: forall t (a :: *) (b :: *) (c :: *) (d :: *) (e :: *). Typeable t
+        => t a b c d e -> TypeRep
+typeOf5 _ = typeRep (Proxy :: Proxy t)
+
+typeOf6 :: forall t (a :: *) (b :: *) (c :: *) (d :: *) (e :: *) (f :: *).
+                Typeable t => t a b c d e f -> TypeRep
+typeOf6 _ = typeRep (Proxy :: Proxy t)
+
+typeOf7 :: forall t (a :: *) (b :: *) (c :: *) (d :: *) (e :: *) (f :: *)
+                (g :: *). Typeable t => t a b c d e f g -> TypeRep
+typeOf7 _ = typeRep (Proxy :: Proxy t)
+
+type Typeable1 (a :: * -> *)                               = Typeable a
+type Typeable2 (a :: * -> * -> *)                          = Typeable a
+type Typeable3 (a :: * -> * -> * -> *)                     = Typeable a
+type Typeable4 (a :: * -> * -> * -> * -> *)                = Typeable a
+type Typeable5 (a :: * -> * -> * -> * -> * -> *)           = Typeable a
+type Typeable6 (a :: * -> * -> * -> * -> * -> * -> *)      = Typeable a
+type Typeable7 (a :: * -> * -> * -> * -> * -> * -> * -> *) = Typeable a
+
+{-# DEPRECATED Typeable1 "renamed to 'Typeable'" #-} -- deprecated in 7.8
+{-# DEPRECATED Typeable2 "renamed to 'Typeable'" #-} -- deprecated in 7.8
+{-# DEPRECATED Typeable3 "renamed to 'Typeable'" #-} -- deprecated in 7.8
+{-# DEPRECATED Typeable4 "renamed to 'Typeable'" #-} -- deprecated in 7.8
+{-# DEPRECATED Typeable5 "renamed to 'Typeable'" #-} -- deprecated in 7.8
+{-# DEPRECATED Typeable6 "renamed to 'Typeable'" #-} -- deprecated in 7.8
+{-# DEPRECATED Typeable7 "renamed to 'Typeable'" #-} -- deprecated in 7.8
+
+-- | Kind-polymorphic Typeable instance for type application
+instance (Typeable s, Typeable a) => Typeable (s a) where
+         -- See Note [The apparent incoherence of Typable]
+  typeRep# = \_ -> rep                  -- Note [Memoising typeOf]
+    where !ty1 = typeRep# (proxy# :: Proxy# s)
+          !ty2 = typeRep# (proxy# :: Proxy# a)
+          !rep = ty1 `mkAppTy` ty2
+
+{- Note [Memoising typeOf]
+~~~~~~~~~~~~~~~~~~~~~~~~~~
+See #3245, #9203
+
+IMPORTANT: we don't want to recalculate the TypeRep once per call with
+the proxy argument.  This is what went wrong in #3245 and #9203. So we
+help GHC by manually keeping the 'rep' *outside* the lambda.
+-}
+
+----------------- Showing TypeReps --------------------
+
+instance Show TypeRep where
+  showsPrec p (TypeRep _ tycon tys) =
+    case tys of
+      [] -> showsPrec p tycon
+      [x]   | tycon == listTc -> showChar '[' . shows x . showChar ']'
+      [a,r] | tycon == funTc  -> showParen (p > 8) $
+                                 showsPrec 9 a .
+                                 showString " -> " .
+                                 showsPrec 8 r
+      xs | isTupleTyCon tycon -> showTuple xs
+         | otherwise         ->
+            showParen (p > 9) $
+            showsPrec p tycon . 
+            showChar ' '      . 
+            showArgs (showChar ' ') tys
+
+showsTypeRep :: TypeRep -> ShowS
+showsTypeRep = shows
+
+instance Show TyCon where
+  showsPrec _ t = showString (tyConName t)
+
+isTupleTyCon :: TyCon -> Bool
+isTupleTyCon (TyCon _ _ _ ('(':',':_)) = True
+isTupleTyCon _                         = False
+
+-- Some (Show.TypeRep) helpers:
+
+showArgs :: Show a => ShowS -> [a] -> ShowS
+showArgs _   []     = id
+showArgs _   [a]    = showsPrec 10 a
+showArgs sep (a:as) = showsPrec 10 a . sep . showArgs sep as 
+
+showTuple :: [TypeRep] -> ShowS
+showTuple args = showChar '('
+               . showArgs (showChar ',') args
+               . showChar ')'
+
+listTc :: TyCon
+listTc = typeRepTyCon (typeOf [()])
+
+funTc :: TyCon
+funTc = typeRepTyCon (typeRep (Proxy :: Proxy (->)))
+
+-------------------------------------------------------------
+--
+--      Instances of the Typeable classes for Prelude types
+--
+-------------------------------------------------------------
+
+deriving instance Typeable ()
+deriving instance Typeable []
+deriving instance Typeable Maybe
+deriving instance Typeable Ratio
+deriving instance Typeable (->)
+deriving instance Typeable IO
+
+deriving instance Typeable Array
+
+deriving instance Typeable ST
+deriving instance Typeable STret
+deriving instance Typeable STRef
+deriving instance Typeable STArray
+
+deriving instance Typeable (,)
+deriving instance Typeable (,,)
+deriving instance Typeable (,,,)
+deriving instance Typeable (,,,,)
+deriving instance Typeable (,,,,,)
+deriving instance Typeable (,,,,,,)
+
+deriving instance Typeable Ptr
+deriving instance Typeable FunPtr
+
+-------------------------------------------------------
+--
+-- Generate Typeable instances for standard datatypes
+--
+-------------------------------------------------------
+
+deriving instance Typeable Bool
+deriving instance Typeable Char
+deriving instance Typeable Float
+deriving instance Typeable Double
+deriving instance Typeable Int
+deriving instance Typeable Word
+deriving instance Typeable Integer
+deriving instance Typeable Ordering
+
+deriving instance Typeable Word8
+deriving instance Typeable Word16
+deriving instance Typeable Word32
+deriving instance Typeable Word64
+
+deriving instance Typeable TyCon
+deriving instance Typeable TypeRep
+deriving instance Typeable Fingerprint
+
+deriving instance Typeable RealWorld
+deriving instance Typeable Proxy
+deriving instance Typeable KProxy
+deriving instance Typeable (:~:)
+deriving instance Typeable Coercion
+
+deriving instance Typeable ReadP
+deriving instance Typeable Lexeme
+deriving instance Typeable Number
+deriving instance Typeable ReadPrec
+
+deriving instance Typeable FFFormat
+
+-------------------------------------------------------
+--
+-- Generate Typeable instances for standard classes
+--
+-------------------------------------------------------
+
+deriving instance Typeable (~)
+deriving instance Typeable Coercible
+deriving instance Typeable TestEquality
+deriving instance Typeable TestCoercion
+
+deriving instance Typeable Eq
+deriving instance Typeable Ord
+
+deriving instance Typeable Bits
+deriving instance Typeable FiniteBits
+deriving instance Typeable Num
+deriving instance Typeable Real
+deriving instance Typeable Integral
+deriving instance Typeable Fractional
+deriving instance Typeable RealFrac
+deriving instance Typeable Floating
+deriving instance Typeable RealFloat
+
+deriving instance Typeable Bounded
+deriving instance Typeable Enum
+deriving instance Typeable Ix
+
+deriving instance Typeable Show
+deriving instance Typeable Read
+
+deriving instance Typeable Functor
+deriving instance Typeable Monad
+deriving instance Typeable MonadPlus
+
+deriving instance Typeable Typeable
+
+
+
+--------------------------------------------------------------------------------
+-- Instances for type literals
+
+{- Note [Potential Collisions in `Nat` and `Symbol` instances]
+
+Kinds resulting from lifted types have finitely many type-constructors.
+This is not the case for `Nat` and `Symbol`, which both contain *infinitely*
+many type constructors (e.g., `Nat` has 0, 1, 2, 3, etc.).  One might think
+that this would increase the chance of hash-collisions in the type but this
+is not the case because the fingerprint stored in a `TypeRep` identifies
+the whole *type* and not just the type constructor.  This is why the chance
+of collisions for `Nat` and `Symbol` is not any worse than it is for other
+lifted types with infinitely many inhabitants.  Indeed, `Nat` is
+isomorphic to (lifted) `[()]`  and `Symbol` is isomorphic to `[Char]`.
+-}
+
+{- Note [The apparent incoherence of Typable] See Trac #9242
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+The reason we have INCOHERENT on Typeable (n:Nat) and Typeable (s:Symbol)
+because we also have an instance Typable (f a).  Now suppose we have
+  [Wanted] Typeable (a :: Nat)
+we should pick the (x::Nat) instance, even though the instance
+matching rules would worry that 'a' might later be instantiated to
+(f b), for some f and b. But we type theorists know that there are no
+type constructors f of kind blah -> Nat, so this can never happen and
+it's safe to pick the second instance. -}
+
+
+instance {-# INCOHERENT #-} KnownNat n => Typeable (n :: Nat) where
+  -- See Note [The apparent incoherence of Typable]
+  -- See #9203 for an explanation of why this is written as `\_ -> rep`.
+  typeRep# = \_ -> rep
+    where
+    rep = mkTyConApp tc []
+    tc = TyCon
+           { tyConHash     = fingerprintString (mk pack modu nm)
+           , tyConPackage  = pack
+           , tyConModule   = modu
+           , tyConName     = nm
+           }
+    pack = "base"
+    modu = "GHC.TypeLits"
+    nm   = show (natVal' (proxy# :: Proxy# n))
+    mk a b c = a ++ " " ++ b ++ " " ++ c
+
+
+instance {-# INCOHERENT #-} KnownSymbol s => Typeable (s :: Symbol) where
+  -- See Note [The apparent incoherence of Typable]
+  -- See #9203 for an explanation of why this is written as `\_ -> rep`.
+  typeRep# = \_ -> rep
+    where
+    rep = mkTyConApp tc []
+    tc = TyCon
+           { tyConHash     = fingerprintString (mk pack modu nm)
+           , tyConPackage  = pack
+           , tyConModule   = modu
+           , tyConName     = nm
+           }
+    pack = "base"
+    modu = "GHC.TypeLits"
+    nm   = show (symbolVal' (proxy# :: Proxy# s))
+    mk a b c = a ++ " " ++ b ++ " " ++ c
+
diff --git a/libraries/base/Data/Typeable/Internal.hs-boot b/libraries/base/Data/Typeable/Internal.hs-boot
new file mode 100644
index 000000000000..e2f65ee50861
--- /dev/null
+++ b/libraries/base/Data/Typeable/Internal.hs-boot
@@ -0,0 +1,30 @@
+{-# LANGUAGE Unsafe #-}
+{-# LANGUAGE CPP, NoImplicitPrelude, MagicHash, PolyKinds #-}
+
+module Data.Typeable.Internal (
+    Proxy(..),
+    Typeable(typeRep),
+    TypeRep,
+    TyCon,
+    mkTyCon,
+    mkTyConApp
+  ) where
+
+import GHC.Base
+import {-# SOURCE #-} Data.Proxy
+
+data TypeRep
+data TyCon
+
+#include "MachDeps.h"
+
+#if WORD_SIZE_IN_BITS < 64
+mkTyCon :: Word64# -> Word64# -> String -> String -> String -> TyCon
+#else
+mkTyCon :: Word#   -> Word#   -> String -> String -> String -> TyCon
+#endif
+
+mkTyConApp   :: TyCon -> [TypeRep] -> TypeRep
+
+class Typeable a where
+  typeRep :: proxy a -> TypeRep
diff --git a/libraries/base/Data/Unique.hs b/libraries/base/Data/Unique.hs
new file mode 100644
index 000000000000..a5c0d6c753ec
--- /dev/null
+++ b/libraries/base/Data/Unique.hs
@@ -0,0 +1,74 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE MagicHash, AutoDeriveTypeable #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.Unique
+-- Copyright   :  (c) The University of Glasgow 2001
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+-- 
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  experimental
+-- Portability :  non-portable
+--
+-- An abstract interface to a unique symbol generator.
+--
+-----------------------------------------------------------------------------
+
+module Data.Unique (
+   -- * Unique objects
+   Unique,
+   newUnique,
+   hashUnique
+ ) where
+
+import Prelude
+
+import System.IO.Unsafe (unsafePerformIO)
+
+import GHC.Base
+import GHC.Num
+import Data.Typeable
+import Data.IORef
+
+-- | An abstract unique object.  Objects of type 'Unique' may be
+-- compared for equality and ordering and hashed into 'Int'.
+newtype Unique = Unique Integer deriving (Eq,Ord,Typeable)
+
+uniqSource :: IORef Integer
+uniqSource = unsafePerformIO (newIORef 0)
+{-# NOINLINE uniqSource #-}
+
+-- | Creates a new object of type 'Unique'.  The value returned will
+-- not compare equal to any other value of type 'Unique' returned by
+-- previous calls to 'newUnique'.  There is no limit on the number of
+-- times 'newUnique' may be called.
+newUnique :: IO Unique
+newUnique = do
+  r <- atomicModifyIORef' uniqSource $ \x -> let z = x+1 in (z,z)
+  return (Unique r)
+
+-- SDM (18/3/2010): changed from MVar to STM.  This fixes
+--  1. there was no async exception protection
+--  2. there was a space leak (now new value is strict)
+--  3. using atomicModifyIORef would be slightly quicker, but can
+--     suffer from adverse scheduling issues (see #3838)
+--  4. also, the STM version is faster.
+
+-- SDM (30/4/2012): changed to IORef using atomicModifyIORef.  Reasons:
+--  1. STM version could not be used inside unsafePerformIO, if it
+--     happened to be poked inside an STM transaction.
+--  2. IORef version can be used with unsafeIOToSTM inside STM,
+--     because if the transaction retries then we just get a new
+--     Unique.
+--  3. IORef version is very slightly faster.
+
+-- IGL (08/06/2013): changed to using atomicModifyIORef' instead.
+--  This feels a little safer, from the point of view of not leaking
+--  memory, but the resulting core is identical.
+
+-- | Hashes a 'Unique' into an 'Int'.  Two 'Unique's may hash to the
+-- same value, although in practice this is unlikely.  The 'Int'
+-- returned makes a good hash key.
+hashUnique :: Unique -> Int
+hashUnique (Unique i) = I# (hashInteger i)
diff --git a/libraries/base/Data/Version.hs b/libraries/base/Data/Version.hs
new file mode 100644
index 000000000000..8b88486571b3
--- /dev/null
+++ b/libraries/base/Data/Version.hs
@@ -0,0 +1,115 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE AutoDeriveTypeable #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.Version
+-- Copyright   :  (c) The University of Glasgow 2004
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+-- 
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  experimental
+-- Portability :  non-portable (local universal quantification in ReadP)
+--
+-- A general library for representation and manipulation of versions.
+-- 
+-- Versioning schemes are many and varied, so the version
+-- representation provided by this library is intended to be a
+-- compromise between complete generality, where almost no common
+-- functionality could reasonably be provided, and fixing a particular
+-- versioning scheme, which would probably be too restrictive.
+-- 
+-- So the approach taken here is to provide a representation which
+-- subsumes many of the versioning schemes commonly in use, and we
+-- provide implementations of 'Eq', 'Ord' and conversion to\/from 'String'
+-- which will be appropriate for some applications, but not all.
+--
+-----------------------------------------------------------------------------
+
+module Data.Version (
+        -- * The @Version@ type
+        Version(..),
+        -- * A concrete representation of @Version@
+        showVersion, parseVersion,
+  ) where
+
+import Prelude -- necessary to get dependencies right
+
+import Text.ParserCombinators.ReadP
+
+import Data.Typeable    ( Typeable )
+import Data.List        ( intersperse, sort )
+import Control.Monad    ( liftM )
+import Data.Char        ( isDigit, isAlphaNum )
+
+{- |
+A 'Version' represents the version of a software entity.  
+
+An instance of 'Eq' is provided, which implements exact equality
+modulo reordering of the tags in the 'versionTags' field.
+
+An instance of 'Ord' is also provided, which gives lexicographic
+ordering on the 'versionBranch' fields (i.e. 2.1 > 2.0, 1.2.3 > 1.2.2,
+etc.).  This is expected to be sufficient for many uses, but note that
+you may need to use a more specific ordering for your versioning
+scheme.  For example, some versioning schemes may include pre-releases
+which have tags @\"pre1\"@, @\"pre2\"@, and so on, and these would need to
+be taken into account when determining ordering.  In some cases, date
+ordering may be more appropriate, so the application would have to
+look for @date@ tags in the 'versionTags' field and compare those.
+The bottom line is, don't always assume that 'compare' and other 'Ord'
+operations are the right thing for every 'Version'.
+
+Similarly, concrete representations of versions may differ.  One
+possible concrete representation is provided (see 'showVersion' and
+'parseVersion'), but depending on the application a different concrete
+representation may be more appropriate.
+-}
+data Version = 
+  Version { versionBranch :: [Int],
+                -- ^ The numeric branch for this version.  This reflects the
+                -- fact that most software versions are tree-structured; there
+                -- is a main trunk which is tagged with versions at various
+                -- points (1,2,3...), and the first branch off the trunk after
+                -- version 3 is 3.1, the second branch off the trunk after
+                -- version 3 is 3.2, and so on.  The tree can be branched
+                -- arbitrarily, just by adding more digits.
+                -- 
+                -- We represent the branch as a list of 'Int', so
+                -- version 3.2.1 becomes [3,2,1].  Lexicographic ordering
+                -- (i.e. the default instance of 'Ord' for @[Int]@) gives
+                -- the natural ordering of branches.
+
+           versionTags :: [String]  -- really a bag
+                -- ^ A version can be tagged with an arbitrary list of strings.
+                -- The interpretation of the list of tags is entirely dependent
+                -- on the entity that this version applies to.
+        }
+  deriving (Read,Show,Typeable)
+
+instance Eq Version where
+  v1 == v2  =  versionBranch v1 == versionBranch v2 
+                && sort (versionTags v1) == sort (versionTags v2)
+                -- tags may be in any order
+
+instance Ord Version where
+  v1 `compare` v2 = versionBranch v1 `compare` versionBranch v2
+
+-- -----------------------------------------------------------------------------
+-- A concrete representation of 'Version'
+
+-- | Provides one possible concrete representation for 'Version'.  For
+-- a version with 'versionBranch' @= [1,2,3]@ and 'versionTags' 
+-- @= [\"tag1\",\"tag2\"]@, the output will be @1.2.3-tag1-tag2@.
+--
+showVersion :: Version -> String
+showVersion (Version branch tags)
+  = concat (intersperse "." (map show branch)) ++ 
+     concatMap ('-':) tags
+
+-- | A parser for versions in the format produced by 'showVersion'.
+--
+parseVersion :: ReadP Version
+parseVersion = do branch <- sepBy1 (liftM read $ munch1 isDigit) (char '.')
+                  tags   <- many (char '-' >> munch1 isAlphaNum)
+                  return Version{versionBranch=branch, versionTags=tags}
diff --git a/libraries/base/Data/Word.hs b/libraries/base/Data/Word.hs
new file mode 100644
index 000000000000..8af39b6d4d19
--- /dev/null
+++ b/libraries/base/Data/Word.hs
@@ -0,0 +1,62 @@
+{-# LANGUAGE Safe #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.Word
+-- Copyright   :  (c) The University of Glasgow 2001
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+-- 
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  experimental
+-- Portability :  portable
+--
+-- Unsigned integer types.
+--
+-----------------------------------------------------------------------------
+
+module Data.Word
+  (
+        -- * Unsigned integral types
+
+        Word,
+        Word8, Word16, Word32, Word64,
+
+        -- * byte swapping
+        byteSwap16, byteSwap32, byteSwap64,
+
+        -- * Notes
+
+        -- $notes
+        ) where
+
+import GHC.Word
+
+{- $notes
+
+* All arithmetic is performed modulo 2^n, where n is the number of
+  bits in the type.  One non-obvious consequence of this is that 'Prelude.negate'
+  should /not/ raise an error on negative arguments.
+
+* For coercing between any two integer types, use
+  'Prelude.fromIntegral', which is specialized for all the
+  common cases so should be fast enough.  Coercing word types to and
+  from integer types preserves representation, not sign.
+
+* It would be very natural to add a type @Natural@ providing an unbounded 
+  size unsigned integer, just as 'Prelude.Integer' provides unbounded
+  size signed integers.  We do not do that yet since there is no demand
+  for it.
+
+* The rules that hold for 'Prelude.Enum' instances over a bounded type
+  such as 'Prelude.Int' (see the section of the Haskell report dealing
+  with arithmetic sequences) also hold for the 'Prelude.Enum' instances
+  over the various 'Word' types defined here.
+
+* Right and left shifts by amounts greater than or equal to the width
+  of the type result in a zero result.  This is contrary to the
+  behaviour in C, which is undefined; a common interpretation is to
+  truncate the shift count to the width of the type, for example @1 \<\<
+  32 == 1@ in some C implementations. 
+-}
+
diff --git a/libraries/base/Debug/Trace.hs b/libraries/base/Debug/Trace.hs
new file mode 100644
index 000000000000..92e5b205c832
--- /dev/null
+++ b/libraries/base/Debug/Trace.hs
@@ -0,0 +1,284 @@
+{-# LANGUAGE Unsafe #-}
+{-# LANGUAGE MagicHash, UnboxedTuples #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Debug.Trace
+-- Copyright   :  (c) The University of Glasgow 2001
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+-- 
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  provisional
+-- Portability :  portable
+--
+-- Functions for tracing and monitoring execution.
+--
+-- These can be useful for investigating bugs or performance problems.
+-- They should /not/ be used in production code.
+--
+-----------------------------------------------------------------------------
+
+module Debug.Trace (
+        -- * Tracing
+        -- $tracing
+        trace,
+        traceId,
+        traceShow,
+        traceShowId,
+        traceStack,
+        traceIO,
+        traceM,
+        traceShowM,
+        putTraceMsg,
+
+        -- * Eventlog tracing
+        -- $eventlog_tracing
+        traceEvent,
+        traceEventIO,
+        
+        -- * Execution phase markers
+        -- $markers
+        traceMarker,
+        traceMarkerIO,
+  ) where
+
+import Prelude
+import System.IO.Unsafe
+import Control.Monad
+
+import Foreign.C.String
+import GHC.Base
+import qualified GHC.Foreign
+import GHC.IO.Encoding
+import GHC.Ptr
+import GHC.Stack
+import Data.List
+
+-- $tracing
+--
+-- The 'trace', 'traceShow' and 'traceIO' functions print messages to an output
+-- stream. They are intended for \"printf debugging\", that is: tracing the flow
+-- of execution and printing interesting values.
+
+-- The usual output stream is 'System.IO.stderr'. For Windows GUI applications
+-- (that have no stderr) the output is directed to the Windows debug console.
+-- Some implementations of these functions may decorate the string that\'s
+-- output to indicate that you\'re tracing.
+
+-- | The 'traceIO' function outputs the trace message from the IO monad.
+-- This sequences the output with respect to other IO actions.
+--
+-- /Since: 4.5.0.0/
+traceIO :: String -> IO ()
+traceIO msg = do
+    withCString "%s\n" $ \cfmt -> do
+     -- NB: debugBelch can't deal with null bytes, so filter them
+     -- out so we don't accidentally truncate the message.  See Trac #9395
+     let (nulls, msg') = partition (=='\0') msg
+     withCString msg' $ \cmsg ->
+      debugBelch cfmt cmsg
+     when (not (null nulls)) $
+       withCString "WARNING: previous trace message had null bytes" $ \cmsg ->
+         debugBelch cfmt cmsg
+
+-- don't use debugBelch() directly, because we cannot call varargs functions
+-- using the FFI.
+foreign import ccall unsafe "HsBase.h debugBelch2"
+   debugBelch :: CString -> CString -> IO ()
+
+-- |
+putTraceMsg :: String -> IO ()
+putTraceMsg = traceIO
+{-# DEPRECATED putTraceMsg "Use 'Debug.Trace.traceIO'" #-} -- deprecated in 7.4
+
+
+{-# NOINLINE trace #-}
+{-|
+The 'trace' function outputs the trace message given as its first argument,
+before returning the second argument as its result.
+
+For example, this returns the value of @f x@ but first outputs the message.
+
+> trace ("calling f with x = " ++ show x) (f x)
+
+The 'trace' function should /only/ be used for debugging, or for monitoring
+execution. The function is not referentially transparent: its type indicates
+that it is a pure function but it has the side effect of outputting the
+trace message.
+-}
+trace :: String -> a -> a
+trace string expr = unsafePerformIO $ do
+    traceIO string
+    return expr
+
+{-|
+Like 'trace' but returns the message instead of a third value.
+
+/Since: 4.7.0.0/
+-}
+traceId :: String -> String
+traceId a = trace a a
+
+{-|
+Like 'trace', but uses 'show' on the argument to convert it to a 'String'.
+
+This makes it convenient for printing the values of interesting variables or
+expressions inside a function. For example here we print the value of the
+variables @x@ and @z@:
+
+> f x y =
+>     traceShow (x, z) $ result
+>   where
+>     z = ...
+>     ...
+-}
+traceShow :: (Show a) => a -> b -> b
+traceShow = trace . show
+
+{-|
+Like 'traceShow' but returns the shown value instead of a third value.
+
+/Since: 4.7.0.0/
+-}
+traceShowId :: (Show a) => a -> a
+traceShowId a = trace (show a) a
+
+{-|
+Like 'trace' but returning unit in an arbitrary monad. Allows for convenient
+use in do-notation. Note that the application of 'trace' is not an action in the
+monad, as 'traceIO' is in the 'IO' monad.
+
+> ... = do
+>   x <- ...
+>   traceM $ "x: " ++ show x
+>   y <- ...
+>   traceM $ "y: " ++ show y
+
+/Since: 4.7.0.0/
+-}
+traceM :: (Monad m) => String -> m ()
+traceM string = trace string $ return ()
+
+{-|
+Like 'traceM', but uses 'show' on the argument to convert it to a 'String'.
+
+> ... = do
+>   x <- ...
+>   traceMShow $ x
+>   y <- ...
+>   traceMShow $ x + y
+
+/Since: 4.7.0.0/
+-}
+traceShowM :: (Show a, Monad m) => a -> m ()
+traceShowM = traceM . show
+
+-- | like 'trace', but additionally prints a call stack if one is
+-- available.
+--
+-- In the current GHC implementation, the call stack is only
+-- availble if the program was compiled with @-prof@; otherwise
+-- 'traceStack' behaves exactly like 'trace'.  Entries in the call
+-- stack correspond to @SCC@ annotations, so it is a good idea to use
+-- @-fprof-auto@ or @-fprof-auto-calls@ to add SCC annotations automatically.
+--
+-- /Since: 4.5.0.0/
+traceStack :: String -> a -> a
+traceStack str expr = unsafePerformIO $ do
+   traceIO str
+   stack <- currentCallStack
+   when (not (null stack)) $ traceIO (renderStack stack)
+   return expr
+
+
+-- $eventlog_tracing
+--
+-- Eventlog tracing is a performance profiling system. These functions emit
+-- extra events into the eventlog. In combination with eventlog profiling
+-- tools these functions can be used for monitoring execution and
+-- investigating performance problems.
+--
+-- Currently only GHC provides eventlog profiling, see the GHC user guide for
+-- details on how to use it. These function exists for other Haskell
+-- implementations but no events are emitted. Note that the string message is
+-- always evaluated, whether or not profiling is available or enabled.
+
+{-# NOINLINE traceEvent #-}
+-- | The 'traceEvent' function behaves like 'trace' with the difference that
+-- the message is emitted to the eventlog, if eventlog profiling is available
+-- and enabled at runtime.
+--
+-- It is suitable for use in pure code. In an IO context use 'traceEventIO'
+-- instead.
+--
+-- Note that when using GHC's SMP runtime, it is possible (but rare) to get
+-- duplicate events emitted if two CPUs simultaneously evaluate the same thunk
+-- that uses 'traceEvent'.
+--
+-- /Since: 4.5.0.0/
+traceEvent :: String -> a -> a
+traceEvent msg expr = unsafeDupablePerformIO $ do
+    traceEventIO msg
+    return expr
+
+-- | The 'traceEventIO' function emits a message to the eventlog, if eventlog
+-- profiling is available and enabled at runtime.
+--
+-- Compared to 'traceEvent', 'traceEventIO' sequences the event with respect to
+-- other IO actions.
+--
+-- /Since: 4.5.0.0/
+traceEventIO :: String -> IO ()
+traceEventIO msg =
+  GHC.Foreign.withCString utf8 msg $ \(Ptr p) -> IO $ \s ->
+    case traceEvent# p s of s' -> (# s', () #)
+
+-- $markers
+--
+-- When looking at a profile for the execution of a program we often want to
+-- be able to mark certain points or phases in the execution and see that
+-- visually in the profile.
+
+-- For example, a program might have several distinct phases with different
+-- performance or resource behaviour in each phase. To properly interpret the
+-- profile graph we really want to see when each phase starts and ends.
+--
+-- Markers let us do this: we can annotate the program to emit a marker at
+-- an appropriate point during execution and then see that in a profile.
+-- 
+-- Currently this feature is only supported in GHC by the eventlog tracing
+-- system, but in future it may also be supported by the heap profiling or
+-- other profiling tools. These function exists for other Haskell
+-- implementations but they have no effect. Note that the string message is
+-- always evaluated, whether or not profiling is available or enabled.
+
+{-# NOINLINE traceMarker #-}
+-- | The 'traceMarker' function emits a marker to the eventlog, if eventlog
+-- profiling is available and enabled at runtime. The @String@ is the name of
+-- the marker. The name is just used in the profiling tools to help you keep
+-- clear which marker is which.
+--
+-- This function is suitable for use in pure code. In an IO context use
+-- 'traceMarkerIO' instead.
+--
+-- Note that when using GHC's SMP runtime, it is possible (but rare) to get
+-- duplicate events emitted if two CPUs simultaneously evaluate the same thunk
+-- that uses 'traceMarker'.
+--
+-- /Since: 4.7.0.0/
+traceMarker :: String -> a -> a
+traceMarker msg expr = unsafeDupablePerformIO $ do
+    traceMarkerIO msg
+    return expr
+
+-- | The 'traceMarkerIO' function emits a marker to the eventlog, if eventlog
+-- profiling is available and enabled at runtime.
+--
+-- Compared to 'traceMarker', 'traceMarkerIO' sequences the event with respect to
+-- other IO actions.
+--
+-- /Since: 4.7.0.0/
+traceMarkerIO :: String -> IO ()
+traceMarkerIO msg =
+  GHC.Foreign.withCString utf8 msg $ \(Ptr p) -> IO $ \s ->
+    case traceMarker# p s of s' -> (# s', () #)
diff --git a/libraries/base/Foreign.hs b/libraries/base/Foreign.hs
new file mode 100644
index 000000000000..43ee102830c5
--- /dev/null
+++ b/libraries/base/Foreign.hs
@@ -0,0 +1,38 @@
+{-# LANGUAGE Unsafe #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Foreign
+-- Copyright   :  (c) The FFI task force 2001
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+-- 
+-- Maintainer  :  ffi@haskell.org
+-- Stability   :  provisional
+-- Portability :  portable
+--
+-- A collection of data types, classes, and functions for interfacing
+-- with another programming language.
+--
+-----------------------------------------------------------------------------
+
+module Foreign
+        ( module Data.Bits
+        , module Data.Int
+        , module Data.Word
+        , module Foreign.Ptr
+        , module Foreign.ForeignPtr
+        , module Foreign.StablePtr
+        , module Foreign.Storable
+        , module Foreign.Marshal
+        ) where
+
+import Data.Bits
+import Data.Int
+import Data.Word
+import Foreign.Ptr
+import Foreign.ForeignPtr
+import Foreign.StablePtr
+import Foreign.Storable
+import Foreign.Marshal
+
diff --git a/libraries/base/Foreign/C.hs b/libraries/base/Foreign/C.hs
new file mode 100644
index 000000000000..83ab6b883a07
--- /dev/null
+++ b/libraries/base/Foreign/C.hs
@@ -0,0 +1,27 @@
+{-# LANGUAGE Safe #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Foreign.C
+-- Copyright   :  (c) The FFI task force 2001
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+-- 
+-- Maintainer  :  ffi@haskell.org
+-- Stability   :  provisional
+-- Portability :  portable
+--
+-- Bundles the C specific FFI library functionality
+--
+-----------------------------------------------------------------------------
+
+module Foreign.C
+        ( module Foreign.C.Types
+        , module Foreign.C.String
+        , module Foreign.C.Error
+        ) where
+
+import Foreign.C.Types
+import Foreign.C.String
+import Foreign.C.Error
+
diff --git a/libraries/base/Foreign/C/Error.hs b/libraries/base/Foreign/C/Error.hs
new file mode 100644
index 000000000000..dbc0b3ec5663
--- /dev/null
+++ b/libraries/base/Foreign/C/Error.hs
@@ -0,0 +1,575 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE CPP, NoImplicitPrelude #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Foreign.C.Error
+-- Copyright   :  (c) The FFI task force 2001
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+-- 
+-- Maintainer  :  ffi@haskell.org
+-- Stability   :  provisional
+-- Portability :  portable
+--
+-- C-specific Marshalling support: Handling of C \"errno\" error codes.
+--
+-----------------------------------------------------------------------------
+
+module Foreign.C.Error (
+
+  -- * Haskell representations of @errno@ values
+
+  Errno(..),
+
+  -- ** Common @errno@ symbols
+  -- | Different operating systems and\/or C libraries often support
+  -- different values of @errno@.  This module defines the common values,
+  -- but due to the open definition of 'Errno' users may add definitions
+  -- which are not predefined.
+  eOK, e2BIG, eACCES, eADDRINUSE, eADDRNOTAVAIL, eADV, eAFNOSUPPORT, eAGAIN, 
+  eALREADY, eBADF, eBADMSG, eBADRPC, eBUSY, eCHILD, eCOMM, eCONNABORTED, 
+  eCONNREFUSED, eCONNRESET, eDEADLK, eDESTADDRREQ, eDIRTY, eDOM, eDQUOT, 
+  eEXIST, eFAULT, eFBIG, eFTYPE, eHOSTDOWN, eHOSTUNREACH, eIDRM, eILSEQ, 
+  eINPROGRESS, eINTR, eINVAL, eIO, eISCONN, eISDIR, eLOOP, eMFILE, eMLINK, 
+  eMSGSIZE, eMULTIHOP, eNAMETOOLONG, eNETDOWN, eNETRESET, eNETUNREACH, 
+  eNFILE, eNOBUFS, eNODATA, eNODEV, eNOENT, eNOEXEC, eNOLCK, eNOLINK, 
+  eNOMEM, eNOMSG, eNONET, eNOPROTOOPT, eNOSPC, eNOSR, eNOSTR, eNOSYS, 
+  eNOTBLK, eNOTCONN, eNOTDIR, eNOTEMPTY, eNOTSOCK, eNOTSUP, eNOTTY, eNXIO,
+  eOPNOTSUPP, ePERM, ePFNOSUPPORT, ePIPE, ePROCLIM, ePROCUNAVAIL, 
+  ePROGMISMATCH, ePROGUNAVAIL, ePROTO, ePROTONOSUPPORT, ePROTOTYPE, 
+  eRANGE, eREMCHG, eREMOTE, eROFS, eRPCMISMATCH, eRREMOTE, eSHUTDOWN, 
+  eSOCKTNOSUPPORT, eSPIPE, eSRCH, eSRMNT, eSTALE, eTIME, eTIMEDOUT, 
+  eTOOMANYREFS, eTXTBSY, eUSERS, eWOULDBLOCK, eXDEV,
+
+  -- ** 'Errno' functions
+  isValidErrno,
+
+  -- access to the current thread's "errno" value
+  --
+  getErrno,
+  resetErrno,
+
+  -- conversion of an "errno" value into IO error
+  --
+  errnoToIOError,
+
+  -- throw current "errno" value
+  --
+  throwErrno,
+
+  -- ** Guards for IO operations that may fail
+
+  throwErrnoIf,
+  throwErrnoIf_,
+  throwErrnoIfRetry,
+  throwErrnoIfRetry_,
+  throwErrnoIfMinus1,
+  throwErrnoIfMinus1_,
+  throwErrnoIfMinus1Retry,
+  throwErrnoIfMinus1Retry_,  
+  throwErrnoIfNull,
+  throwErrnoIfNullRetry,
+
+  throwErrnoIfRetryMayBlock, 
+  throwErrnoIfRetryMayBlock_,
+  throwErrnoIfMinus1RetryMayBlock,
+  throwErrnoIfMinus1RetryMayBlock_,  
+  throwErrnoIfNullRetryMayBlock,
+
+  throwErrnoPath,
+  throwErrnoPathIf,
+  throwErrnoPathIf_,
+  throwErrnoPathIfNull,
+  throwErrnoPathIfMinus1,
+  throwErrnoPathIfMinus1_,
+) where
+
+
+-- this is were we get the CONST_XXX definitions from that configure
+-- calculated for us
+--
+#include "HsBaseConfig.h"
+
+import Foreign.Ptr
+import Foreign.C.Types
+import Foreign.C.String
+import Control.Monad            ( void )
+import Data.Maybe
+
+import GHC.IO
+import GHC.IO.Exception
+import GHC.IO.Handle.Types
+import GHC.Num
+import GHC.Base
+
+-- "errno" type
+-- ------------
+
+-- | Haskell representation for @errno@ values.
+-- The implementation is deliberately exposed, to allow users to add
+-- their own definitions of 'Errno' values.
+
+newtype Errno = Errno CInt
+
+instance Eq Errno where
+  errno1@(Errno no1) == errno2@(Errno no2) 
+    | isValidErrno errno1 && isValidErrno errno2 = no1 == no2
+    | otherwise                                  = False
+
+-- common "errno" symbols
+--
+eOK, e2BIG, eACCES, eADDRINUSE, eADDRNOTAVAIL, eADV, eAFNOSUPPORT, eAGAIN, 
+  eALREADY, eBADF, eBADMSG, eBADRPC, eBUSY, eCHILD, eCOMM, eCONNABORTED, 
+  eCONNREFUSED, eCONNRESET, eDEADLK, eDESTADDRREQ, eDIRTY, eDOM, eDQUOT, 
+  eEXIST, eFAULT, eFBIG, eFTYPE, eHOSTDOWN, eHOSTUNREACH, eIDRM, eILSEQ, 
+  eINPROGRESS, eINTR, eINVAL, eIO, eISCONN, eISDIR, eLOOP, eMFILE, eMLINK, 
+  eMSGSIZE, eMULTIHOP, eNAMETOOLONG, eNETDOWN, eNETRESET, eNETUNREACH, 
+  eNFILE, eNOBUFS, eNODATA, eNODEV, eNOENT, eNOEXEC, eNOLCK, eNOLINK, 
+  eNOMEM, eNOMSG, eNONET, eNOPROTOOPT, eNOSPC, eNOSR, eNOSTR, eNOSYS, 
+  eNOTBLK, eNOTCONN, eNOTDIR, eNOTEMPTY, eNOTSOCK, eNOTSUP, eNOTTY, eNXIO,
+  eOPNOTSUPP, ePERM, ePFNOSUPPORT, ePIPE, ePROCLIM, ePROCUNAVAIL, 
+  ePROGMISMATCH, ePROGUNAVAIL, ePROTO, ePROTONOSUPPORT, ePROTOTYPE, 
+  eRANGE, eREMCHG, eREMOTE, eROFS, eRPCMISMATCH, eRREMOTE, eSHUTDOWN, 
+  eSOCKTNOSUPPORT, eSPIPE, eSRCH, eSRMNT, eSTALE, eTIME, eTIMEDOUT, 
+  eTOOMANYREFS, eTXTBSY, eUSERS, eWOULDBLOCK, eXDEV                    :: Errno
+--
+-- the cCONST_XXX identifiers are cpp symbols whose value is computed by
+-- configure 
+--
+eOK             = Errno 0
+e2BIG           = Errno (CONST_E2BIG)
+eACCES          = Errno (CONST_EACCES)
+eADDRINUSE      = Errno (CONST_EADDRINUSE)
+eADDRNOTAVAIL   = Errno (CONST_EADDRNOTAVAIL)
+eADV            = Errno (CONST_EADV)
+eAFNOSUPPORT    = Errno (CONST_EAFNOSUPPORT)
+eAGAIN          = Errno (CONST_EAGAIN)
+eALREADY        = Errno (CONST_EALREADY)
+eBADF           = Errno (CONST_EBADF)
+eBADMSG         = Errno (CONST_EBADMSG)
+eBADRPC         = Errno (CONST_EBADRPC)
+eBUSY           = Errno (CONST_EBUSY)
+eCHILD          = Errno (CONST_ECHILD)
+eCOMM           = Errno (CONST_ECOMM)
+eCONNABORTED    = Errno (CONST_ECONNABORTED)
+eCONNREFUSED    = Errno (CONST_ECONNREFUSED)
+eCONNRESET      = Errno (CONST_ECONNRESET)
+eDEADLK         = Errno (CONST_EDEADLK)
+eDESTADDRREQ    = Errno (CONST_EDESTADDRREQ)
+eDIRTY          = Errno (CONST_EDIRTY)
+eDOM            = Errno (CONST_EDOM)
+eDQUOT          = Errno (CONST_EDQUOT)
+eEXIST          = Errno (CONST_EEXIST)
+eFAULT          = Errno (CONST_EFAULT)
+eFBIG           = Errno (CONST_EFBIG)
+eFTYPE          = Errno (CONST_EFTYPE)
+eHOSTDOWN       = Errno (CONST_EHOSTDOWN)
+eHOSTUNREACH    = Errno (CONST_EHOSTUNREACH)
+eIDRM           = Errno (CONST_EIDRM)
+eILSEQ          = Errno (CONST_EILSEQ)
+eINPROGRESS     = Errno (CONST_EINPROGRESS)
+eINTR           = Errno (CONST_EINTR)
+eINVAL          = Errno (CONST_EINVAL)
+eIO             = Errno (CONST_EIO)
+eISCONN         = Errno (CONST_EISCONN)
+eISDIR          = Errno (CONST_EISDIR)
+eLOOP           = Errno (CONST_ELOOP)
+eMFILE          = Errno (CONST_EMFILE)
+eMLINK          = Errno (CONST_EMLINK)
+eMSGSIZE        = Errno (CONST_EMSGSIZE)
+eMULTIHOP       = Errno (CONST_EMULTIHOP)
+eNAMETOOLONG    = Errno (CONST_ENAMETOOLONG)
+eNETDOWN        = Errno (CONST_ENETDOWN)
+eNETRESET       = Errno (CONST_ENETRESET)
+eNETUNREACH     = Errno (CONST_ENETUNREACH)
+eNFILE          = Errno (CONST_ENFILE)
+eNOBUFS         = Errno (CONST_ENOBUFS)
+eNODATA         = Errno (CONST_ENODATA)
+eNODEV          = Errno (CONST_ENODEV)
+eNOENT          = Errno (CONST_ENOENT)
+eNOEXEC         = Errno (CONST_ENOEXEC)
+eNOLCK          = Errno (CONST_ENOLCK)
+eNOLINK         = Errno (CONST_ENOLINK)
+eNOMEM          = Errno (CONST_ENOMEM)
+eNOMSG          = Errno (CONST_ENOMSG)
+eNONET          = Errno (CONST_ENONET)
+eNOPROTOOPT     = Errno (CONST_ENOPROTOOPT)
+eNOSPC          = Errno (CONST_ENOSPC)
+eNOSR           = Errno (CONST_ENOSR)
+eNOSTR          = Errno (CONST_ENOSTR)
+eNOSYS          = Errno (CONST_ENOSYS)
+eNOTBLK         = Errno (CONST_ENOTBLK)
+eNOTCONN        = Errno (CONST_ENOTCONN)
+eNOTDIR         = Errno (CONST_ENOTDIR)
+eNOTEMPTY       = Errno (CONST_ENOTEMPTY)
+eNOTSOCK        = Errno (CONST_ENOTSOCK)
+eNOTSUP         = Errno (CONST_ENOTSUP)
+-- ^ /Since: 4.7.0.0/
+eNOTTY          = Errno (CONST_ENOTTY)
+eNXIO           = Errno (CONST_ENXIO)
+eOPNOTSUPP      = Errno (CONST_EOPNOTSUPP)
+ePERM           = Errno (CONST_EPERM)
+ePFNOSUPPORT    = Errno (CONST_EPFNOSUPPORT)
+ePIPE           = Errno (CONST_EPIPE)
+ePROCLIM        = Errno (CONST_EPROCLIM)
+ePROCUNAVAIL    = Errno (CONST_EPROCUNAVAIL)
+ePROGMISMATCH   = Errno (CONST_EPROGMISMATCH)
+ePROGUNAVAIL    = Errno (CONST_EPROGUNAVAIL)
+ePROTO          = Errno (CONST_EPROTO)
+ePROTONOSUPPORT = Errno (CONST_EPROTONOSUPPORT)
+ePROTOTYPE      = Errno (CONST_EPROTOTYPE)
+eRANGE          = Errno (CONST_ERANGE)
+eREMCHG         = Errno (CONST_EREMCHG)
+eREMOTE         = Errno (CONST_EREMOTE)
+eROFS           = Errno (CONST_EROFS)
+eRPCMISMATCH    = Errno (CONST_ERPCMISMATCH)
+eRREMOTE        = Errno (CONST_ERREMOTE)
+eSHUTDOWN       = Errno (CONST_ESHUTDOWN)
+eSOCKTNOSUPPORT = Errno (CONST_ESOCKTNOSUPPORT)
+eSPIPE          = Errno (CONST_ESPIPE)
+eSRCH           = Errno (CONST_ESRCH)
+eSRMNT          = Errno (CONST_ESRMNT)
+eSTALE          = Errno (CONST_ESTALE)
+eTIME           = Errno (CONST_ETIME)
+eTIMEDOUT       = Errno (CONST_ETIMEDOUT)
+eTOOMANYREFS    = Errno (CONST_ETOOMANYREFS)
+eTXTBSY         = Errno (CONST_ETXTBSY)
+eUSERS          = Errno (CONST_EUSERS)
+eWOULDBLOCK     = Errno (CONST_EWOULDBLOCK)
+eXDEV           = Errno (CONST_EXDEV)
+
+-- | Yield 'True' if the given 'Errno' value is valid on the system.
+-- This implies that the 'Eq' instance of 'Errno' is also system dependent
+-- as it is only defined for valid values of 'Errno'.
+--
+isValidErrno               :: Errno -> Bool
+--
+-- the configure script sets all invalid "errno"s to -1
+--
+isValidErrno (Errno errno)  = errno /= -1
+
+
+-- access to the current thread's "errno" value
+-- --------------------------------------------
+
+-- | Get the current value of @errno@ in the current thread.
+--
+getErrno :: IO Errno
+
+-- We must call a C function to get the value of errno in general.  On
+-- threaded systems, errno is hidden behind a C macro so that each OS
+-- thread gets its own copy.
+getErrno = do e <- get_errno; return (Errno e)
+foreign import ccall unsafe "HsBase.h __hscore_get_errno" get_errno :: IO CInt
+
+-- | Reset the current thread\'s @errno@ value to 'eOK'.
+--
+resetErrno :: IO ()
+
+-- Again, setting errno has to be done via a C function.
+resetErrno = set_errno 0
+foreign import ccall unsafe "HsBase.h __hscore_set_errno" set_errno :: CInt -> IO ()
+
+-- throw current "errno" value
+-- ---------------------------
+
+-- | Throw an 'IOError' corresponding to the current value of 'getErrno'.
+--
+throwErrno     :: String        -- ^ textual description of the error location
+               -> IO a
+throwErrno loc  =
+  do
+    errno <- getErrno
+    ioError (errnoToIOError loc errno Nothing Nothing)
+
+
+-- guards for IO operations that may fail
+-- --------------------------------------
+
+-- | Throw an 'IOError' corresponding to the current value of 'getErrno'
+-- if the result value of the 'IO' action meets the given predicate.
+--
+throwErrnoIf    :: (a -> Bool)  -- ^ predicate to apply to the result value
+                                -- of the 'IO' operation
+                -> String       -- ^ textual description of the location
+                -> IO a         -- ^ the 'IO' operation to be executed
+                -> IO a
+throwErrnoIf pred loc f  = 
+  do
+    res <- f
+    if pred res then throwErrno loc else return res
+
+-- | as 'throwErrnoIf', but discards the result of the 'IO' action after
+-- error handling.
+--
+throwErrnoIf_   :: (a -> Bool) -> String -> IO a -> IO ()
+throwErrnoIf_ pred loc f  = void $ throwErrnoIf pred loc f
+
+-- | as 'throwErrnoIf', but retry the 'IO' action when it yields the
+-- error code 'eINTR' - this amounts to the standard retry loop for
+-- interrupted POSIX system calls.
+--
+throwErrnoIfRetry            :: (a -> Bool) -> String -> IO a -> IO a
+throwErrnoIfRetry pred loc f  = 
+  do
+    res <- f
+    if pred res
+      then do
+        err <- getErrno
+        if err == eINTR
+          then throwErrnoIfRetry pred loc f
+          else throwErrno loc
+      else return res
+
+-- | as 'throwErrnoIfRetry', but additionally if the operation 
+-- yields the error code 'eAGAIN' or 'eWOULDBLOCK', an alternative
+-- action is executed before retrying.
+--
+throwErrnoIfRetryMayBlock
+                :: (a -> Bool)  -- ^ predicate to apply to the result value
+                                -- of the 'IO' operation
+                -> String       -- ^ textual description of the location
+                -> IO a         -- ^ the 'IO' operation to be executed
+                -> IO b         -- ^ action to execute before retrying if
+                                -- an immediate retry would block
+                -> IO a
+throwErrnoIfRetryMayBlock pred loc f on_block  = 
+  do
+    res <- f
+    if pred res
+      then do
+        err <- getErrno
+        if err == eINTR
+          then throwErrnoIfRetryMayBlock pred loc f on_block
+          else if err == eWOULDBLOCK || err == eAGAIN
+                 then do _ <- on_block
+                         throwErrnoIfRetryMayBlock pred loc f on_block
+                 else throwErrno loc
+      else return res
+
+-- | as 'throwErrnoIfRetry', but discards the result.
+--
+throwErrnoIfRetry_            :: (a -> Bool) -> String -> IO a -> IO ()
+throwErrnoIfRetry_ pred loc f  = void $ throwErrnoIfRetry pred loc f
+
+-- | as 'throwErrnoIfRetryMayBlock', but discards the result.
+--
+throwErrnoIfRetryMayBlock_ :: (a -> Bool) -> String -> IO a -> IO b -> IO ()
+throwErrnoIfRetryMayBlock_ pred loc f on_block 
+  = void $ throwErrnoIfRetryMayBlock pred loc f on_block
+
+-- | Throw an 'IOError' corresponding to the current value of 'getErrno'
+-- if the 'IO' action returns a result of @-1@.
+--
+throwErrnoIfMinus1 :: (Eq a, Num a) => String -> IO a -> IO a
+throwErrnoIfMinus1  = throwErrnoIf (== -1)
+
+-- | as 'throwErrnoIfMinus1', but discards the result.
+--
+throwErrnoIfMinus1_ :: (Eq a, Num a) => String -> IO a -> IO ()
+throwErrnoIfMinus1_  = throwErrnoIf_ (== -1)
+
+-- | Throw an 'IOError' corresponding to the current value of 'getErrno'
+-- if the 'IO' action returns a result of @-1@, but retries in case of
+-- an interrupted operation.
+--
+throwErrnoIfMinus1Retry :: (Eq a, Num a) => String -> IO a -> IO a
+throwErrnoIfMinus1Retry  = throwErrnoIfRetry (== -1)
+
+-- | as 'throwErrnoIfMinus1', but discards the result.
+--
+throwErrnoIfMinus1Retry_ :: (Eq a, Num a) => String -> IO a -> IO ()
+throwErrnoIfMinus1Retry_  = throwErrnoIfRetry_ (== -1)
+
+-- | as 'throwErrnoIfMinus1Retry', but checks for operations that would block.
+--
+throwErrnoIfMinus1RetryMayBlock :: (Eq a, Num a)
+                                => String -> IO a -> IO b -> IO a
+throwErrnoIfMinus1RetryMayBlock  = throwErrnoIfRetryMayBlock (== -1)
+
+-- | as 'throwErrnoIfMinus1RetryMayBlock', but discards the result.
+--
+throwErrnoIfMinus1RetryMayBlock_ :: (Eq a, Num a)
+                                 => String -> IO a -> IO b -> IO ()
+throwErrnoIfMinus1RetryMayBlock_  = throwErrnoIfRetryMayBlock_ (== -1)
+
+-- | Throw an 'IOError' corresponding to the current value of 'getErrno'
+-- if the 'IO' action returns 'nullPtr'.
+--
+throwErrnoIfNull :: String -> IO (Ptr a) -> IO (Ptr a)
+throwErrnoIfNull  = throwErrnoIf (== nullPtr)
+
+-- | Throw an 'IOError' corresponding to the current value of 'getErrno'
+-- if the 'IO' action returns 'nullPtr',
+-- but retry in case of an interrupted operation.
+--
+throwErrnoIfNullRetry :: String -> IO (Ptr a) -> IO (Ptr a)
+throwErrnoIfNullRetry  = throwErrnoIfRetry (== nullPtr)
+
+-- | as 'throwErrnoIfNullRetry', but checks for operations that would block.
+--
+throwErrnoIfNullRetryMayBlock :: String -> IO (Ptr a) -> IO b -> IO (Ptr a)
+throwErrnoIfNullRetryMayBlock  = throwErrnoIfRetryMayBlock (== nullPtr)
+
+-- | as 'throwErrno', but exceptions include the given path when appropriate.
+--
+throwErrnoPath :: String -> FilePath -> IO a
+throwErrnoPath loc path =
+  do
+    errno <- getErrno
+    ioError (errnoToIOError loc errno Nothing (Just path))
+
+-- | as 'throwErrnoIf', but exceptions include the given path when
+--   appropriate.
+--
+throwErrnoPathIf :: (a -> Bool) -> String -> FilePath -> IO a -> IO a
+throwErrnoPathIf pred loc path f =
+  do
+    res <- f
+    if pred res then throwErrnoPath loc path else return res
+
+-- | as 'throwErrnoIf_', but exceptions include the given path when
+--   appropriate.
+--
+throwErrnoPathIf_ :: (a -> Bool) -> String -> FilePath -> IO a -> IO ()
+throwErrnoPathIf_ pred loc path f  = void $ throwErrnoPathIf pred loc path f
+
+-- | as 'throwErrnoIfNull', but exceptions include the given path when
+--   appropriate.
+--
+throwErrnoPathIfNull :: String -> FilePath -> IO (Ptr a) -> IO (Ptr a)
+throwErrnoPathIfNull  = throwErrnoPathIf (== nullPtr)
+
+-- | as 'throwErrnoIfMinus1', but exceptions include the given path when
+--   appropriate.
+--
+throwErrnoPathIfMinus1 :: (Eq a, Num a) => String -> FilePath -> IO a -> IO a
+throwErrnoPathIfMinus1 = throwErrnoPathIf (== -1)
+
+-- | as 'throwErrnoIfMinus1_', but exceptions include the given path when
+--   appropriate.
+--
+throwErrnoPathIfMinus1_ :: (Eq a, Num a) => String -> FilePath -> IO a -> IO ()
+throwErrnoPathIfMinus1_  = throwErrnoPathIf_ (== -1)
+
+-- conversion of an "errno" value into IO error
+-- --------------------------------------------
+
+-- | Construct an 'IOError' based on the given 'Errno' value.
+-- The optional information can be used to improve the accuracy of
+-- error messages.
+--
+errnoToIOError  :: String       -- ^ the location where the error occurred
+                -> Errno        -- ^ the error number
+                -> Maybe Handle -- ^ optional handle associated with the error
+                -> Maybe String -- ^ optional filename associated with the error
+                -> IOError
+errnoToIOError loc errno maybeHdl maybeName = unsafePerformIO $ do
+    str <- strerror errno >>= peekCString
+    return (IOError maybeHdl errType loc str (Just errno') maybeName)
+    where
+    Errno errno' = errno
+    errType
+        | errno == eOK             = OtherError
+        | errno == e2BIG           = ResourceExhausted
+        | errno == eACCES          = PermissionDenied
+        | errno == eADDRINUSE      = ResourceBusy
+        | errno == eADDRNOTAVAIL   = UnsupportedOperation
+        | errno == eADV            = OtherError
+        | errno == eAFNOSUPPORT    = UnsupportedOperation
+        | errno == eAGAIN          = ResourceExhausted
+        | errno == eALREADY        = AlreadyExists
+        | errno == eBADF           = InvalidArgument
+        | errno == eBADMSG         = InappropriateType
+        | errno == eBADRPC         = OtherError
+        | errno == eBUSY           = ResourceBusy
+        | errno == eCHILD          = NoSuchThing
+        | errno == eCOMM           = ResourceVanished
+        | errno == eCONNABORTED    = OtherError
+        | errno == eCONNREFUSED    = NoSuchThing
+        | errno == eCONNRESET      = ResourceVanished
+        | errno == eDEADLK         = ResourceBusy
+        | errno == eDESTADDRREQ    = InvalidArgument
+        | errno == eDIRTY          = UnsatisfiedConstraints
+        | errno == eDOM            = InvalidArgument
+        | errno == eDQUOT          = PermissionDenied
+        | errno == eEXIST          = AlreadyExists
+        | errno == eFAULT          = OtherError
+        | errno == eFBIG           = PermissionDenied
+        | errno == eFTYPE          = InappropriateType
+        | errno == eHOSTDOWN       = NoSuchThing
+        | errno == eHOSTUNREACH    = NoSuchThing
+        | errno == eIDRM           = ResourceVanished
+        | errno == eILSEQ          = InvalidArgument
+        | errno == eINPROGRESS     = AlreadyExists
+        | errno == eINTR           = Interrupted
+        | errno == eINVAL          = InvalidArgument
+        | errno == eIO             = HardwareFault
+        | errno == eISCONN         = AlreadyExists
+        | errno == eISDIR          = InappropriateType
+        | errno == eLOOP           = InvalidArgument
+        | errno == eMFILE          = ResourceExhausted
+        | errno == eMLINK          = ResourceExhausted
+        | errno == eMSGSIZE        = ResourceExhausted
+        | errno == eMULTIHOP       = UnsupportedOperation
+        | errno == eNAMETOOLONG    = InvalidArgument
+        | errno == eNETDOWN        = ResourceVanished
+        | errno == eNETRESET       = ResourceVanished
+        | errno == eNETUNREACH     = NoSuchThing
+        | errno == eNFILE          = ResourceExhausted
+        | errno == eNOBUFS         = ResourceExhausted
+        | errno == eNODATA         = NoSuchThing
+        | errno == eNODEV          = UnsupportedOperation
+        | errno == eNOENT          = NoSuchThing
+        | errno == eNOEXEC         = InvalidArgument
+        | errno == eNOLCK          = ResourceExhausted
+        | errno == eNOLINK         = ResourceVanished
+        | errno == eNOMEM          = ResourceExhausted
+        | errno == eNOMSG          = NoSuchThing
+        | errno == eNONET          = NoSuchThing
+        | errno == eNOPROTOOPT     = UnsupportedOperation
+        | errno == eNOSPC          = ResourceExhausted
+        | errno == eNOSR           = ResourceExhausted
+        | errno == eNOSTR          = InvalidArgument
+        | errno == eNOSYS          = UnsupportedOperation
+        | errno == eNOTBLK         = InvalidArgument
+        | errno == eNOTCONN        = InvalidArgument
+        | errno == eNOTDIR         = InappropriateType
+        | errno == eNOTEMPTY       = UnsatisfiedConstraints
+        | errno == eNOTSOCK        = InvalidArgument
+        | errno == eNOTTY          = IllegalOperation
+        | errno == eNXIO           = NoSuchThing
+        | errno == eOPNOTSUPP      = UnsupportedOperation
+        | errno == ePERM           = PermissionDenied
+        | errno == ePFNOSUPPORT    = UnsupportedOperation
+        | errno == ePIPE           = ResourceVanished
+        | errno == ePROCLIM        = PermissionDenied
+        | errno == ePROCUNAVAIL    = UnsupportedOperation
+        | errno == ePROGMISMATCH   = ProtocolError
+        | errno == ePROGUNAVAIL    = UnsupportedOperation
+        | errno == ePROTO          = ProtocolError
+        | errno == ePROTONOSUPPORT = ProtocolError
+        | errno == ePROTOTYPE      = ProtocolError
+        | errno == eRANGE          = UnsupportedOperation
+        | errno == eREMCHG         = ResourceVanished
+        | errno == eREMOTE         = IllegalOperation
+        | errno == eROFS           = PermissionDenied
+        | errno == eRPCMISMATCH    = ProtocolError
+        | errno == eRREMOTE        = IllegalOperation
+        | errno == eSHUTDOWN       = IllegalOperation
+        | errno == eSOCKTNOSUPPORT = UnsupportedOperation
+        | errno == eSPIPE          = UnsupportedOperation
+        | errno == eSRCH           = NoSuchThing
+        | errno == eSRMNT          = UnsatisfiedConstraints
+        | errno == eSTALE          = ResourceVanished
+        | errno == eTIME           = TimeExpired
+        | errno == eTIMEDOUT       = TimeExpired
+        | errno == eTOOMANYREFS    = ResourceExhausted
+        | errno == eTXTBSY         = ResourceBusy
+        | errno == eUSERS          = ResourceExhausted
+        | errno == eWOULDBLOCK     = OtherError
+        | errno == eXDEV           = UnsupportedOperation
+        | otherwise                = OtherError
+
+foreign import ccall unsafe "string.h" strerror :: Errno -> IO (Ptr CChar)
+
diff --git a/libraries/base/Foreign/C/String.hs b/libraries/base/Foreign/C/String.hs
new file mode 100644
index 000000000000..cdbd241db588
--- /dev/null
+++ b/libraries/base/Foreign/C/String.hs
@@ -0,0 +1,461 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE CPP, NoImplicitPrelude #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Foreign.C.String
+-- Copyright   :  (c) The FFI task force 2001
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+-- 
+-- Maintainer  :  ffi@haskell.org
+-- Stability   :  provisional
+-- Portability :  portable
+--
+-- Utilities for primitive marshalling of C strings.
+--
+-- The marshalling converts each Haskell character, representing a Unicode
+-- code point, to one or more bytes in a manner that, by default, is
+-- determined by the current locale.  As a consequence, no guarantees
+-- can be made about the relative length of a Haskell string and its
+-- corresponding C string, and therefore all the marshalling routines
+-- include memory allocation.  The translation between Unicode and the
+-- encoding of the current locale may be lossy.
+--
+-----------------------------------------------------------------------------
+
+module Foreign.C.String (   -- representation of strings in C
+  -- * C strings
+
+  CString,
+  CStringLen,
+
+  -- ** Using a locale-dependent encoding
+
+  -- | These functions are different from their @CAString@ counterparts
+  -- in that they will use an encoding determined by the current locale,
+  -- rather than always assuming ASCII.
+
+  -- conversion of C strings into Haskell strings
+  --
+  peekCString,
+  peekCStringLen,
+
+  -- conversion of Haskell strings into C strings
+  --
+  newCString,
+  newCStringLen,
+
+  -- conversion of Haskell strings into C strings using temporary storage
+  --
+  withCString,
+  withCStringLen,
+
+  charIsRepresentable,
+
+  -- ** Using 8-bit characters
+
+  -- | These variants of the above functions are for use with C libraries
+  -- that are ignorant of Unicode.  These functions should be used with
+  -- care, as a loss of information can occur.
+
+  castCharToCChar,
+  castCCharToChar,
+
+  castCharToCUChar,
+  castCUCharToChar,
+  castCharToCSChar,
+  castCSCharToChar,
+
+  peekCAString,
+  peekCAStringLen,
+  newCAString,
+  newCAStringLen,
+  withCAString,
+  withCAStringLen,
+
+  -- * C wide strings
+
+  -- | These variants of the above functions are for use with C libraries
+  -- that encode Unicode using the C @wchar_t@ type in a system-dependent
+  -- way.  The only encodings supported are
+  --
+  -- * UTF-32 (the C compiler defines @__STDC_ISO_10646__@), or
+  --
+  -- * UTF-16 (as used on Windows systems).
+
+  CWString,
+  CWStringLen,
+
+  peekCWString,
+  peekCWStringLen,
+  newCWString,
+  newCWStringLen,
+  withCWString,
+  withCWStringLen,
+
+  ) where
+
+import Foreign.Marshal.Array
+import Foreign.C.Types
+import Foreign.Ptr
+import Foreign.Storable
+
+import Data.Word
+
+import Control.Monad
+
+import GHC.Char
+import GHC.List
+import GHC.Real
+import GHC.Num
+import GHC.Base
+
+import {-# SOURCE #-} GHC.IO.Encoding
+import qualified GHC.Foreign as GHC
+
+-----------------------------------------------------------------------------
+-- Strings
+
+-- representation of strings in C
+-- ------------------------------
+
+-- | A C string is a reference to an array of C characters terminated by NUL.
+type CString    = Ptr CChar
+
+-- | A string with explicit length information in bytes instead of a
+-- terminating NUL (allowing NUL characters in the middle of the string).
+type CStringLen = (Ptr CChar, Int)
+
+-- exported functions
+-- ------------------
+--
+-- * the following routines apply the default conversion when converting the
+--   C-land character encoding into the Haskell-land character encoding
+
+-- | Marshal a NUL terminated C string into a Haskell string.
+--
+peekCString    :: CString -> IO String
+peekCString s = getForeignEncoding >>= flip GHC.peekCString s
+
+-- | Marshal a C string with explicit length into a Haskell string.
+--
+peekCStringLen           :: CStringLen -> IO String
+peekCStringLen s = getForeignEncoding >>= flip GHC.peekCStringLen s
+
+-- | Marshal a Haskell string into a NUL terminated C string.
+--
+-- * the Haskell string may /not/ contain any NUL characters
+--
+-- * new storage is allocated for the C string and must be
+--   explicitly freed using 'Foreign.Marshal.Alloc.free' or
+--   'Foreign.Marshal.Alloc.finalizerFree'.
+--
+newCString :: String -> IO CString
+newCString s = getForeignEncoding >>= flip GHC.newCString s
+
+-- | Marshal a Haskell string into a C string (ie, character array) with
+-- explicit length information.
+--
+-- * new storage is allocated for the C string and must be
+--   explicitly freed using 'Foreign.Marshal.Alloc.free' or
+--   'Foreign.Marshal.Alloc.finalizerFree'.
+--
+newCStringLen     :: String -> IO CStringLen
+newCStringLen s = getForeignEncoding >>= flip GHC.newCStringLen s
+
+-- | Marshal a Haskell string into a NUL terminated C string using temporary
+-- storage.
+--
+-- * the Haskell string may /not/ contain any NUL characters
+--
+-- * the memory is freed when the subcomputation terminates (either
+--   normally or via an exception), so the pointer to the temporary
+--   storage must /not/ be used after this.
+--
+withCString :: String -> (CString -> IO a) -> IO a
+withCString s f = getForeignEncoding >>= \enc -> GHC.withCString enc s f
+
+-- | Marshal a Haskell string into a C string (ie, character array)
+-- in temporary storage, with explicit length information.
+--
+-- * the memory is freed when the subcomputation terminates (either
+--   normally or via an exception), so the pointer to the temporary
+--   storage must /not/ be used after this.
+--
+withCStringLen         :: String -> (CStringLen -> IO a) -> IO a
+withCStringLen s f = getForeignEncoding >>= \enc -> GHC.withCStringLen enc s f
+
+-- -- | Determines whether a character can be accurately encoded in a 'CString'.
+-- -- Unrepresentable characters are converted to '?' or their nearest visual equivalent.
+charIsRepresentable :: Char -> IO Bool
+charIsRepresentable c = getForeignEncoding >>= flip GHC.charIsRepresentable c
+
+-- single byte characters
+-- ----------------------
+--
+--   ** NOTE: These routines don't handle conversions! **
+
+-- | Convert a C byte, representing a Latin-1 character, to the corresponding
+-- Haskell character.
+castCCharToChar :: CChar -> Char
+castCCharToChar ch = unsafeChr (fromIntegral (fromIntegral ch :: Word8))
+
+-- | Convert a Haskell character to a C character.
+-- This function is only safe on the first 256 characters.
+castCharToCChar :: Char -> CChar
+castCharToCChar ch = fromIntegral (ord ch)
+
+-- | Convert a C @unsigned char@, representing a Latin-1 character, to
+-- the corresponding Haskell character.
+castCUCharToChar :: CUChar -> Char
+castCUCharToChar ch = unsafeChr (fromIntegral (fromIntegral ch :: Word8))
+
+-- | Convert a Haskell character to a C @unsigned char@.
+-- This function is only safe on the first 256 characters.
+castCharToCUChar :: Char -> CUChar
+castCharToCUChar ch = fromIntegral (ord ch)
+
+-- | Convert a C @signed char@, representing a Latin-1 character, to the
+-- corresponding Haskell character.
+castCSCharToChar :: CSChar -> Char
+castCSCharToChar ch = unsafeChr (fromIntegral (fromIntegral ch :: Word8))
+
+-- | Convert a Haskell character to a C @signed char@.
+-- This function is only safe on the first 256 characters.
+castCharToCSChar :: Char -> CSChar
+castCharToCSChar ch = fromIntegral (ord ch)
+
+-- | Marshal a NUL terminated C string into a Haskell string.
+--
+peekCAString    :: CString -> IO String
+peekCAString cp = do
+  l <- lengthArray0 nUL cp
+  if l <= 0 then return "" else loop "" (l-1)
+  where
+    loop s i = do
+        xval <- peekElemOff cp i
+        let val = castCCharToChar xval
+        val `seq` if i <= 0 then return (val:s) else loop (val:s) (i-1)
+
+-- | Marshal a C string with explicit length into a Haskell string.
+--
+peekCAStringLen           :: CStringLen -> IO String
+peekCAStringLen (cp, len) 
+  | len <= 0  = return "" -- being (too?) nice.
+  | otherwise = loop [] (len-1)
+  where
+    loop acc i = do
+         xval <- peekElemOff cp i
+         let val = castCCharToChar xval
+           -- blow away the coercion ASAP.
+         if (val `seq` (i == 0))
+          then return (val:acc)
+          else loop (val:acc) (i-1)
+
+-- | Marshal a Haskell string into a NUL terminated C string.
+--
+-- * the Haskell string may /not/ contain any NUL characters
+--
+-- * new storage is allocated for the C string and must be
+--   explicitly freed using 'Foreign.Marshal.Alloc.free' or
+--   'Foreign.Marshal.Alloc.finalizerFree'.
+--
+newCAString :: String -> IO CString
+newCAString str = do
+  ptr <- mallocArray0 (length str)
+  let
+        go [] n     = pokeElemOff ptr n nUL
+        go (c:cs) n = do pokeElemOff ptr n (castCharToCChar c); go cs (n+1)
+  go str 0
+  return ptr
+
+-- | Marshal a Haskell string into a C string (ie, character array) with
+-- explicit length information.
+--
+-- * new storage is allocated for the C string and must be
+--   explicitly freed using 'Foreign.Marshal.Alloc.free' or
+--   'Foreign.Marshal.Alloc.finalizerFree'.
+--
+newCAStringLen     :: String -> IO CStringLen
+newCAStringLen str = do
+  ptr <- mallocArray0 len
+  let
+        go [] n     = n `seq` return () -- make it strict in n
+        go (c:cs) n = do pokeElemOff ptr n (castCharToCChar c); go cs (n+1)
+  go str 0
+  return (ptr, len)
+  where
+    len = length str
+
+-- | Marshal a Haskell string into a NUL terminated C string using temporary
+-- storage.
+--
+-- * the Haskell string may /not/ contain any NUL characters
+--
+-- * the memory is freed when the subcomputation terminates (either
+--   normally or via an exception), so the pointer to the temporary
+--   storage must /not/ be used after this.
+--
+withCAString :: String -> (CString -> IO a) -> IO a
+withCAString str f =
+  allocaArray0 (length str) $ \ptr ->
+      let
+        go [] n     = pokeElemOff ptr n nUL
+        go (c:cs) n = do pokeElemOff ptr n (castCharToCChar c); go cs (n+1)
+      in do
+      go str 0
+      f ptr
+
+-- | Marshal a Haskell string into a C string (ie, character array)
+-- in temporary storage, with explicit length information.
+--
+-- * the memory is freed when the subcomputation terminates (either
+--   normally or via an exception), so the pointer to the temporary
+--   storage must /not/ be used after this.
+--
+withCAStringLen         :: String -> (CStringLen -> IO a) -> IO a
+withCAStringLen str f    =
+  allocaArray len $ \ptr ->
+      let
+        go [] n     = n `seq` return () -- make it strict in n
+        go (c:cs) n = do pokeElemOff ptr n (castCharToCChar c); go cs (n+1)
+      in do
+      go str 0
+      f (ptr,len)
+  where
+    len = length str
+
+-- auxiliary definitions
+-- ----------------------
+
+-- C's end of string character
+--
+nUL :: CChar
+nUL  = 0
+
+-- allocate an array to hold the list and pair it with the number of elements
+newArrayLen        :: Storable a => [a] -> IO (Ptr a, Int)
+newArrayLen xs      = do
+  a <- newArray xs
+  return (a, length xs)
+
+-----------------------------------------------------------------------------
+-- Wide strings
+
+-- representation of wide strings in C
+-- -----------------------------------
+
+-- | A C wide string is a reference to an array of C wide characters
+-- terminated by NUL.
+type CWString    = Ptr CWchar
+
+-- | A wide character string with explicit length information in 'CWchar's
+-- instead of a terminating NUL (allowing NUL characters in the middle
+-- of the string).
+type CWStringLen = (Ptr CWchar, Int)
+
+-- | Marshal a NUL terminated C wide string into a Haskell string.
+--
+peekCWString    :: CWString -> IO String
+peekCWString cp  = do
+  cs <- peekArray0 wNUL cp
+  return (cWcharsToChars cs)
+
+-- | Marshal a C wide string with explicit length into a Haskell string.
+--
+peekCWStringLen           :: CWStringLen -> IO String
+peekCWStringLen (cp, len)  = do
+  cs <- peekArray len cp
+  return (cWcharsToChars cs)
+
+-- | Marshal a Haskell string into a NUL terminated C wide string.
+--
+-- * the Haskell string may /not/ contain any NUL characters
+--
+-- * new storage is allocated for the C wide string and must
+--   be explicitly freed using 'Foreign.Marshal.Alloc.free' or
+--   'Foreign.Marshal.Alloc.finalizerFree'.
+--
+newCWString :: String -> IO CWString
+newCWString  = newArray0 wNUL . charsToCWchars
+
+-- | Marshal a Haskell string into a C wide string (ie, wide character array)
+-- with explicit length information.
+--
+-- * new storage is allocated for the C wide string and must
+--   be explicitly freed using 'Foreign.Marshal.Alloc.free' or
+--   'Foreign.Marshal.Alloc.finalizerFree'.
+--
+newCWStringLen     :: String -> IO CWStringLen
+newCWStringLen str  = newArrayLen (charsToCWchars str)
+
+-- | Marshal a Haskell string into a NUL terminated C wide string using
+-- temporary storage.
+--
+-- * the Haskell string may /not/ contain any NUL characters
+--
+-- * the memory is freed when the subcomputation terminates (either
+--   normally or via an exception), so the pointer to the temporary
+--   storage must /not/ be used after this.
+--
+withCWString :: String -> (CWString -> IO a) -> IO a
+withCWString  = withArray0 wNUL . charsToCWchars
+
+-- | Marshal a Haskell string into a C wide string (i.e. wide
+-- character array) in temporary storage, with explicit length
+-- information.
+--
+-- * the memory is freed when the subcomputation terminates (either
+--   normally or via an exception), so the pointer to the temporary
+--   storage must /not/ be used after this.
+--
+withCWStringLen         :: String -> (CWStringLen -> IO a) -> IO a
+withCWStringLen str f    =
+  withArrayLen (charsToCWchars str) $ \ len ptr -> f (ptr, len)
+
+-- auxiliary definitions
+-- ----------------------
+
+wNUL :: CWchar
+wNUL = 0
+
+cWcharsToChars :: [CWchar] -> [Char]
+charsToCWchars :: [Char] -> [CWchar]
+
+#ifdef mingw32_HOST_OS
+
+-- On Windows, wchar_t is 16 bits wide and CWString uses the UTF-16 encoding.
+
+-- coding errors generate Chars in the surrogate range
+cWcharsToChars = map chr . fromUTF16 . map fromIntegral
+ where
+  fromUTF16 (c1:c2:wcs)
+    | 0xd800 <= c1 && c1 <= 0xdbff && 0xdc00 <= c2 && c2 <= 0xdfff =
+      ((c1 - 0xd800)*0x400 + (c2 - 0xdc00) + 0x10000) : fromUTF16 wcs
+  fromUTF16 (c:wcs) = c : fromUTF16 wcs
+  fromUTF16 [] = []
+
+charsToCWchars = foldr utf16Char [] . map ord
+ where
+  utf16Char c wcs
+    | c < 0x10000 = fromIntegral c : wcs
+    | otherwise   = let c' = c - 0x10000 in
+                    fromIntegral (c' `div` 0x400 + 0xd800) :
+                    fromIntegral (c' `mod` 0x400 + 0xdc00) : wcs
+
+#else /* !mingw32_HOST_OS */
+
+cWcharsToChars xs  = map castCWcharToChar xs
+charsToCWchars xs  = map castCharToCWchar xs
+
+-- These conversions only make sense if __STDC_ISO_10646__ is defined
+-- (meaning that wchar_t is ISO 10646, aka Unicode)
+
+castCWcharToChar :: CWchar -> Char
+castCWcharToChar ch = chr (fromIntegral ch )
+
+castCharToCWchar :: Char -> CWchar
+castCharToCWchar ch = fromIntegral (ord ch)
+
+#endif /* !mingw32_HOST_OS */
+
diff --git a/libraries/base/Foreign/C/Types.hs b/libraries/base/Foreign/C/Types.hs
new file mode 100644
index 000000000000..39ba2a868ced
--- /dev/null
+++ b/libraries/base/Foreign/C/Types.hs
@@ -0,0 +1,263 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE CPP
+           , NoImplicitPrelude
+           , MagicHash
+           , GeneralizedNewtypeDeriving
+  #-}
+{-# OPTIONS_GHC -fno-warn-unused-binds #-}
+{-# LANGUAGE AutoDeriveTypeable, StandaloneDeriving #-}
+-- XXX -fno-warn-unused-binds stops us warning about unused constructors,
+-- but really we should just remove them if we don't want them
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Foreign.C.Types
+-- Copyright   :  (c) The FFI task force 2001
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+-- 
+-- Maintainer  :  ffi@haskell.org
+-- Stability   :  provisional
+-- Portability :  portable
+--
+-- Mapping of C types to corresponding Haskell types.
+--
+-----------------------------------------------------------------------------
+
+module Foreign.C.Types
+        ( -- * Representations of C types
+          -- $ctypes
+
+          -- ** Integral types
+          -- | These types are are represented as @newtype@s of
+          -- types in "Data.Int" and "Data.Word", and are instances of
+          -- 'Prelude.Eq', 'Prelude.Ord', 'Prelude.Num', 'Prelude.Read',
+          -- 'Prelude.Show', 'Prelude.Enum', 'Typeable', 'Storable',
+          -- 'Prelude.Bounded', 'Prelude.Real', 'Prelude.Integral' and
+          -- 'Bits'.
+          CChar(..),    CSChar(..),   CUChar(..)
+        , CShort(..),   CUShort(..),  CInt(..),      CUInt(..)
+        , CLong(..),    CULong(..)
+        , CPtrdiff(..), CSize(..),    CWchar(..),    CSigAtomic(..)
+        , CLLong(..),   CULLong(..)
+        , CIntPtr(..),  CUIntPtr(..), CIntMax(..),   CUIntMax(..)
+
+          -- ** Numeric types
+          -- | These types are represented as @newtype@s of basic
+          -- foreign types, and are instances of
+          -- 'Prelude.Eq', 'Prelude.Ord', 'Prelude.Num', 'Prelude.Read',
+          -- 'Prelude.Show', 'Prelude.Enum', 'Typeable' and 'Storable'.
+        , CClock(..),   CTime(..),    CUSeconds(..), CSUSeconds(..)
+
+        -- extracted from CTime, because we don't want this comment in
+        -- the Haskell language reports:
+
+        -- | To convert 'CTime' to 'Data.Time.UTCTime', use the following:
+        --
+        -- > \t -> posixSecondsToUTCTime (realToFrac t :: POSIXTime)
+        --
+
+          -- ** Floating types
+          -- | These types are are represented as @newtype@s of
+          -- 'Prelude.Float' and 'Prelude.Double', and are instances of
+          -- 'Prelude.Eq', 'Prelude.Ord', 'Prelude.Num', 'Prelude.Read',
+          -- 'Prelude.Show', 'Prelude.Enum', 'Typeable', 'Storable',
+          -- 'Prelude.Real', 'Prelude.Fractional', 'Prelude.Floating',
+          -- 'Prelude.RealFrac' and 'Prelude.RealFloat'.
+        , CFloat(..),   CDouble(..)
+        -- XXX GHC doesn't support CLDouble yet
+        -- , CLDouble(..)
+
+          -- ** Other types
+
+          -- Instances of: Eq and Storable
+        , CFile,        CFpos,     CJmpBuf
+        ) where
+
+import Foreign.Storable
+import Data.Bits        ( Bits(..), FiniteBits(..) )
+import Data.Int         ( Int8,  Int16,  Int32,  Int64  )
+import Data.Word        ( Word8, Word16, Word32, Word64 )
+import Data.Typeable
+
+import GHC.Base
+import GHC.Float
+import GHC.Enum
+import GHC.Real
+import GHC.Show
+import GHC.Read
+import GHC.Num
+
+#include "HsBaseConfig.h"
+#include "CTypes.h"
+
+-- | Haskell type representing the C @char@ type.
+INTEGRAL_TYPE(CChar,HTYPE_CHAR)
+-- | Haskell type representing the C @signed char@ type.
+INTEGRAL_TYPE(CSChar,HTYPE_SIGNED_CHAR)
+-- | Haskell type representing the C @unsigned char@ type.
+INTEGRAL_TYPE(CUChar,HTYPE_UNSIGNED_CHAR)
+
+-- | Haskell type representing the C @short@ type.
+INTEGRAL_TYPE(CShort,HTYPE_SHORT)
+-- | Haskell type representing the C @unsigned short@ type.
+INTEGRAL_TYPE(CUShort,HTYPE_UNSIGNED_SHORT)
+
+-- | Haskell type representing the C @int@ type.
+INTEGRAL_TYPE(CInt,HTYPE_INT)
+-- | Haskell type representing the C @unsigned int@ type.
+INTEGRAL_TYPE(CUInt,HTYPE_UNSIGNED_INT)
+
+-- | Haskell type representing the C @long@ type.
+INTEGRAL_TYPE(CLong,HTYPE_LONG)
+-- | Haskell type representing the C @unsigned long@ type.
+INTEGRAL_TYPE(CULong,HTYPE_UNSIGNED_LONG)
+
+-- | Haskell type representing the C @long long@ type.
+INTEGRAL_TYPE(CLLong,HTYPE_LONG_LONG)
+-- | Haskell type representing the C @unsigned long long@ type.
+INTEGRAL_TYPE(CULLong,HTYPE_UNSIGNED_LONG_LONG)
+
+{-# RULES
+"fromIntegral/a->CChar"   fromIntegral = \x -> CChar   (fromIntegral x)
+"fromIntegral/a->CSChar"  fromIntegral = \x -> CSChar  (fromIntegral x)
+"fromIntegral/a->CUChar"  fromIntegral = \x -> CUChar  (fromIntegral x)
+"fromIntegral/a->CShort"  fromIntegral = \x -> CShort  (fromIntegral x)
+"fromIntegral/a->CUShort" fromIntegral = \x -> CUShort (fromIntegral x)
+"fromIntegral/a->CInt"    fromIntegral = \x -> CInt    (fromIntegral x)
+"fromIntegral/a->CUInt"   fromIntegral = \x -> CUInt   (fromIntegral x)
+"fromIntegral/a->CLong"   fromIntegral = \x -> CLong   (fromIntegral x)
+"fromIntegral/a->CULong"  fromIntegral = \x -> CULong  (fromIntegral x)
+"fromIntegral/a->CLLong"  fromIntegral = \x -> CLLong  (fromIntegral x)
+"fromIntegral/a->CULLong" fromIntegral = \x -> CULLong (fromIntegral x)
+
+"fromIntegral/CChar->a"   fromIntegral = \(CChar   x) -> fromIntegral x
+"fromIntegral/CSChar->a"  fromIntegral = \(CSChar  x) -> fromIntegral x
+"fromIntegral/CUChar->a"  fromIntegral = \(CUChar  x) -> fromIntegral x
+"fromIntegral/CShort->a"  fromIntegral = \(CShort  x) -> fromIntegral x
+"fromIntegral/CUShort->a" fromIntegral = \(CUShort x) -> fromIntegral x
+"fromIntegral/CInt->a"    fromIntegral = \(CInt    x) -> fromIntegral x
+"fromIntegral/CUInt->a"   fromIntegral = \(CUInt   x) -> fromIntegral x
+"fromIntegral/CLong->a"   fromIntegral = \(CLong   x) -> fromIntegral x
+"fromIntegral/CULong->a"  fromIntegral = \(CULong  x) -> fromIntegral x
+"fromIntegral/CLLong->a"  fromIntegral = \(CLLong  x) -> fromIntegral x
+"fromIntegral/CULLong->a" fromIntegral = \(CULLong x) -> fromIntegral x
+ #-}
+
+-- | Haskell type representing the C @float@ type.
+FLOATING_TYPE(CFloat,HTYPE_FLOAT)
+-- | Haskell type representing the C @double@ type.
+FLOATING_TYPE(CDouble,HTYPE_DOUBLE)
+-- XXX GHC doesn't support CLDouble yet
+
+{-# RULES
+"realToFrac/a->CFloat"    realToFrac = \x -> CFloat   (realToFrac x)
+"realToFrac/a->CDouble"   realToFrac = \x -> CDouble  (realToFrac x)
+
+"realToFrac/CFloat->a"    realToFrac = \(CFloat   x) -> realToFrac x
+"realToFrac/CDouble->a"   realToFrac = \(CDouble  x) -> realToFrac x
+ #-}
+
+-- GHC doesn't support CLDouble yet
+-- "realToFrac/a->CLDouble"  realToFrac = \x -> CLDouble (realToFrac x)
+-- "realToFrac/CLDouble->a"  realToFrac = \(CLDouble x) -> realToFrac x
+
+-- | Haskell type representing the C @ptrdiff_t@ type.
+INTEGRAL_TYPE(CPtrdiff,HTYPE_PTRDIFF_T)
+-- | Haskell type representing the C @size_t@ type.
+INTEGRAL_TYPE(CSize,HTYPE_SIZE_T)
+-- | Haskell type representing the C @wchar_t@ type.
+INTEGRAL_TYPE(CWchar,HTYPE_WCHAR_T)
+-- | Haskell type representing the C @sig_atomic_t@ type.
+INTEGRAL_TYPE(CSigAtomic,HTYPE_SIG_ATOMIC_T)
+
+{-# RULES
+"fromIntegral/a->CPtrdiff"   fromIntegral = \x -> CPtrdiff   (fromIntegral x)
+"fromIntegral/a->CSize"      fromIntegral = \x -> CSize      (fromIntegral x)
+"fromIntegral/a->CWchar"     fromIntegral = \x -> CWchar     (fromIntegral x)
+"fromIntegral/a->CSigAtomic" fromIntegral = \x -> CSigAtomic (fromIntegral x)
+
+"fromIntegral/CPtrdiff->a"   fromIntegral = \(CPtrdiff   x) -> fromIntegral x
+"fromIntegral/CSize->a"      fromIntegral = \(CSize      x) -> fromIntegral x
+"fromIntegral/CWchar->a"     fromIntegral = \(CWchar     x) -> fromIntegral x
+"fromIntegral/CSigAtomic->a" fromIntegral = \(CSigAtomic x) -> fromIntegral x
+ #-}
+
+-- | Haskell type representing the C @clock_t@ type.
+ARITHMETIC_TYPE(CClock,HTYPE_CLOCK_T)
+-- | Haskell type representing the C @time_t@ type.
+ARITHMETIC_TYPE(CTime,HTYPE_TIME_T)
+-- | Haskell type representing the C @useconds_t@ type.
+--
+-- /Since: 4.4.0.0/
+ARITHMETIC_TYPE(CUSeconds,HTYPE_USECONDS_T)
+-- | Haskell type representing the C @suseconds_t@ type.
+--
+-- /Since: 4.4.0.0/
+ARITHMETIC_TYPE(CSUSeconds,HTYPE_SUSECONDS_T)
+
+-- FIXME: Implement and provide instances for Eq and Storable
+-- | Haskell type representing the C @FILE@ type.
+data CFile = CFile
+-- | Haskell type representing the C @fpos_t@ type.
+data CFpos = CFpos
+-- | Haskell type representing the C @jmp_buf@ type.
+data CJmpBuf = CJmpBuf
+
+INTEGRAL_TYPE(CIntPtr,HTYPE_INTPTR_T)
+INTEGRAL_TYPE(CUIntPtr,HTYPE_UINTPTR_T)
+INTEGRAL_TYPE(CIntMax,HTYPE_INTMAX_T)
+INTEGRAL_TYPE(CUIntMax,HTYPE_UINTMAX_T)
+
+{-# RULES
+"fromIntegral/a->CIntPtr"  fromIntegral = \x -> CIntPtr  (fromIntegral x)
+"fromIntegral/a->CUIntPtr" fromIntegral = \x -> CUIntPtr (fromIntegral x)
+"fromIntegral/a->CIntMax"  fromIntegral = \x -> CIntMax  (fromIntegral x)
+"fromIntegral/a->CUIntMax" fromIntegral = \x -> CUIntMax (fromIntegral x)
+ #-}
+
+-- C99 types which are still missing include:
+-- wint_t, wctrans_t, wctype_t
+
+{- $ctypes
+
+These types are needed to accurately represent C function prototypes,
+in order to access C library interfaces in Haskell.  The Haskell system
+is not required to represent those types exactly as C does, but the
+following guarantees are provided concerning a Haskell type @CT@
+representing a C type @t@:
+
+* If a C function prototype has @t@ as an argument or result type, the
+  use of @CT@ in the corresponding position in a foreign declaration
+  permits the Haskell program to access the full range of values encoded
+  by the C type; and conversely, any Haskell value for @CT@ has a valid
+  representation in C.
+
+* @'sizeOf' ('Prelude.undefined' :: CT)@ will yield the same value as
+  @sizeof (t)@ in C.
+
+* @'alignment' ('Prelude.undefined' :: CT)@ matches the alignment
+  constraint enforced by the C implementation for @t@.
+
+* The members 'peek' and 'poke' of the 'Storable' class map all values
+  of @CT@ to the corresponding value of @t@ and vice versa.
+
+* When an instance of 'Prelude.Bounded' is defined for @CT@, the values
+  of 'Prelude.minBound' and 'Prelude.maxBound' coincide with @t_MIN@
+  and @t_MAX@ in C.
+
+* When an instance of 'Prelude.Eq' or 'Prelude.Ord' is defined for @CT@,
+  the predicates defined by the type class implement the same relation
+  as the corresponding predicate in C on @t@.
+
+* When an instance of 'Prelude.Num', 'Prelude.Read', 'Prelude.Integral',
+  'Prelude.Fractional', 'Prelude.Floating', 'Prelude.RealFrac', or
+  'Prelude.RealFloat' is defined for @CT@, the arithmetic operations
+  defined by the type class implement the same function as the
+  corresponding arithmetic operations (if available) in C on @t@.
+
+* When an instance of 'Bits' is defined for @CT@, the bitwise operation
+  defined by the type class implement the same function as the
+  corresponding bitwise operation in C on @t@.
+
+-}
+
diff --git a/libraries/base/Foreign/Concurrent.hs b/libraries/base/Foreign/Concurrent.hs
new file mode 100644
index 000000000000..9d27166fde78
--- /dev/null
+++ b/libraries/base/Foreign/Concurrent.hs
@@ -0,0 +1,51 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Foreign.Concurrent
+-- Copyright   :  (c) The University of Glasgow 2003
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+-- 
+-- Maintainer  :  ffi@haskell.org
+-- Stability   :  provisional
+-- Portability :  non-portable (requires concurrency)
+--
+-- FFI datatypes and operations that use or require concurrency (GHC only).
+--
+-----------------------------------------------------------------------------
+
+module Foreign.Concurrent
+  (
+        -- * Concurrency-based 'ForeignPtr' operations
+
+        -- | These functions generalize their namesakes in the portable
+        -- "Foreign.ForeignPtr" module by allowing arbitrary 'IO' actions
+        -- as finalizers.  These finalizers necessarily run in a separate
+        -- thread, cf. /Destructors, Finalizers and Synchronization/,
+        -- by Hans Boehm, /POPL/, 2003.
+
+        newForeignPtr,
+        addForeignPtrFinalizer,
+  ) where
+
+import GHC.IO         ( IO )
+import GHC.Ptr        ( Ptr )
+import GHC.ForeignPtr ( ForeignPtr )
+import qualified GHC.ForeignPtr
+
+newForeignPtr :: Ptr a -> IO () -> IO (ForeignPtr a)
+-- ^Turns a plain memory reference into a foreign object by associating
+-- a finalizer - given by the monadic operation - with the reference.
+-- The finalizer will be executed after the last reference to the
+-- foreign object is dropped.  There is no guarantee of promptness, and
+-- in fact there is no guarantee that the finalizer will eventually
+-- run at all.
+newForeignPtr = GHC.ForeignPtr.newConcForeignPtr
+
+addForeignPtrFinalizer :: ForeignPtr a -> IO () -> IO ()
+-- ^This function adds a finalizer to the given 'ForeignPtr'.
+-- The finalizer will run after the last reference to the foreign object
+-- is dropped, but /before/ all previously registered finalizers for the
+-- same object.
+addForeignPtrFinalizer = GHC.ForeignPtr.addForeignPtrConcFinalizer
diff --git a/libraries/base/Foreign/ForeignPtr.hs b/libraries/base/Foreign/ForeignPtr.hs
new file mode 100644
index 000000000000..2e9b9ec08a8d
--- /dev/null
+++ b/libraries/base/Foreign/ForeignPtr.hs
@@ -0,0 +1,47 @@
+{-# LANGUAGE Unsafe #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Foreign.ForeignPtr
+-- Copyright   :  (c) The University of Glasgow 2001
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+-- 
+-- Maintainer  :  ffi@haskell.org
+-- Stability   :  provisional
+-- Portability :  portable
+--
+-- The 'ForeignPtr' type and operations.  This module is part of the
+-- Foreign Function Interface (FFI) and will usually be imported via
+-- the "Foreign" module.
+--
+-----------------------------------------------------------------------------
+
+module Foreign.ForeignPtr ( 
+        -- * Finalised data pointers
+          ForeignPtr
+        , FinalizerPtr
+        , FinalizerEnvPtr
+
+        -- ** Basic operations
+        , newForeignPtr
+        , newForeignPtr_
+        , addForeignPtrFinalizer
+        , newForeignPtrEnv
+        , addForeignPtrFinalizerEnv
+        , withForeignPtr
+        , finalizeForeignPtr
+
+        -- ** Low-level operations
+        , touchForeignPtr
+        , castForeignPtr
+
+        -- ** Allocating managed memory
+        , mallocForeignPtr
+        , mallocForeignPtrBytes
+        , mallocForeignPtrArray
+        , mallocForeignPtrArray0
+    ) where
+
+import Foreign.ForeignPtr.Safe
+
diff --git a/libraries/base/Foreign/ForeignPtr/Imp.hs b/libraries/base/Foreign/ForeignPtr/Imp.hs
new file mode 100644
index 000000000000..2c3f39365b60
--- /dev/null
+++ b/libraries/base/Foreign/ForeignPtr/Imp.hs
@@ -0,0 +1,120 @@
+{-# LANGUAGE Unsafe #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# OPTIONS_HADDOCK hide #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Foreign.ForeignPtr.Imp
+-- Copyright   :  (c) The University of Glasgow 2001
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+-- 
+-- Maintainer  :  ffi@haskell.org
+-- Stability   :  provisional
+-- Portability :  portable
+--
+-- The 'ForeignPtr' type and operations.  This module is part of the
+-- Foreign Function Interface (FFI) and will usually be imported via
+-- the "Foreign" module.
+--
+-----------------------------------------------------------------------------
+
+module Foreign.ForeignPtr.Imp
+        ( 
+        -- * Finalised data pointers
+          ForeignPtr
+        , FinalizerPtr
+        , FinalizerEnvPtr
+
+        -- ** Basic operations
+        , newForeignPtr
+        , newForeignPtr_
+        , addForeignPtrFinalizer
+        , newForeignPtrEnv
+        , addForeignPtrFinalizerEnv
+        , withForeignPtr
+        , finalizeForeignPtr
+
+        -- ** Low-level operations
+        , unsafeForeignPtrToPtr
+        , touchForeignPtr
+        , castForeignPtr
+
+        -- ** Allocating managed memory
+        , mallocForeignPtr
+        , mallocForeignPtrBytes
+        , mallocForeignPtrArray
+        , mallocForeignPtrArray0
+        ) 
+        where
+
+import Foreign.Ptr
+import Foreign.Storable ( Storable(sizeOf) )
+
+import GHC.Base
+import GHC.Num
+import GHC.ForeignPtr
+
+newForeignPtr :: FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
+-- ^Turns a plain memory reference into a foreign pointer, and
+-- associates a finalizer with the reference.  The finalizer will be
+-- executed after the last reference to the foreign object is dropped.
+-- There is no guarantee of promptness, however the finalizer will be
+-- executed before the program exits.
+newForeignPtr finalizer p
+  = do fObj <- newForeignPtr_ p
+       addForeignPtrFinalizer finalizer fObj
+       return fObj
+
+withForeignPtr :: ForeignPtr a -> (Ptr a -> IO b) -> IO b
+-- ^This is a way to look at the pointer living inside a
+-- foreign object.  This function takes a function which is
+-- applied to that pointer. The resulting 'IO' action is then
+-- executed. The foreign object is kept alive at least during
+-- the whole action, even if it is not used directly
+-- inside. Note that it is not safe to return the pointer from
+-- the action and use it after the action completes. All uses
+-- of the pointer should be inside the
+-- 'withForeignPtr' bracket.  The reason for
+-- this unsafeness is the same as for
+-- 'unsafeForeignPtrToPtr' below: the finalizer
+-- may run earlier than expected, because the compiler can only
+-- track usage of the 'ForeignPtr' object, not
+-- a 'Ptr' object made from it.
+--
+-- This function is normally used for marshalling data to
+-- or from the object pointed to by the
+-- 'ForeignPtr', using the operations from the
+-- 'Storable' class.
+withForeignPtr fo io
+  = do r <- io (unsafeForeignPtrToPtr fo)
+       touchForeignPtr fo
+       return r
+
+-- | This variant of 'newForeignPtr' adds a finalizer that expects an
+-- environment in addition to the finalized pointer.  The environment
+-- that will be passed to the finalizer is fixed by the second argument to
+-- 'newForeignPtrEnv'.
+newForeignPtrEnv ::
+    FinalizerEnvPtr env a -> Ptr env -> Ptr a -> IO (ForeignPtr a)
+newForeignPtrEnv finalizer env p
+  = do fObj <- newForeignPtr_ p
+       addForeignPtrFinalizerEnv finalizer env fObj
+       return fObj
+
+-- | This function is similar to 'Foreign.Marshal.Array.mallocArray',
+-- but yields a memory area that has a finalizer attached that releases
+-- the memory area.  As with 'mallocForeignPtr', it is not guaranteed that
+-- the block of memory was allocated by 'Foreign.Marshal.Alloc.malloc'.
+mallocForeignPtrArray :: Storable a => Int -> IO (ForeignPtr a)
+mallocForeignPtrArray  = doMalloc undefined
+  where
+    doMalloc            :: Storable b => b -> Int -> IO (ForeignPtr b)
+    doMalloc dummy size  = mallocForeignPtrBytes (size * sizeOf dummy)
+
+-- | This function is similar to 'Foreign.Marshal.Array.mallocArray0',
+-- but yields a memory area that has a finalizer attached that releases
+-- the memory area.  As with 'mallocForeignPtr', it is not guaranteed that
+-- the block of memory was allocated by 'Foreign.Marshal.Alloc.malloc'.
+mallocForeignPtrArray0      :: Storable a => Int -> IO (ForeignPtr a)
+mallocForeignPtrArray0 size  = mallocForeignPtrArray (size + 1)
+
diff --git a/libraries/base/Foreign/ForeignPtr/Safe.hs b/libraries/base/Foreign/ForeignPtr/Safe.hs
new file mode 100644
index 000000000000..190e8b680a8d
--- /dev/null
+++ b/libraries/base/Foreign/ForeignPtr/Safe.hs
@@ -0,0 +1,49 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Foreign.ForeignPtr.Safe
+-- Copyright   :  (c) The University of Glasgow 2001
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+-- 
+-- Maintainer  :  ffi@haskell.org
+-- Stability   :  provisional
+-- Portability :  portable
+--
+-- The 'ForeignPtr' type and operations.  This module is part of the
+-- Foreign Function Interface (FFI) and will usually be imported via
+-- the "Foreign" module.
+--
+-- Safe API Only.
+--
+-----------------------------------------------------------------------------
+
+module Foreign.ForeignPtr.Safe (
+        -- * Finalised data pointers
+          ForeignPtr
+        , FinalizerPtr
+        , FinalizerEnvPtr
+
+        -- ** Basic operations
+        , newForeignPtr
+        , newForeignPtr_
+        , addForeignPtrFinalizer
+        , newForeignPtrEnv
+        , addForeignPtrFinalizerEnv
+        , withForeignPtr
+        , finalizeForeignPtr
+
+        -- ** Low-level operations
+        , touchForeignPtr
+        , castForeignPtr
+
+        -- ** Allocating managed memory
+        , mallocForeignPtr
+        , mallocForeignPtrBytes
+        , mallocForeignPtrArray
+        , mallocForeignPtrArray0
+    ) where
+
+import Foreign.ForeignPtr.Imp
+
diff --git a/libraries/base/Foreign/ForeignPtr/Unsafe.hs b/libraries/base/Foreign/ForeignPtr/Unsafe.hs
new file mode 100644
index 000000000000..5a36a7e12ba4
--- /dev/null
+++ b/libraries/base/Foreign/ForeignPtr/Unsafe.hs
@@ -0,0 +1,28 @@
+{-# LANGUAGE Unsafe #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Foreign.ForeignPtr.Unsafe
+-- Copyright   :  (c) The University of Glasgow 2001
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+-- 
+-- Maintainer  :  ffi@haskell.org
+-- Stability   :  provisional
+-- Portability :  portable
+--
+-- The 'ForeignPtr' type and operations.  This module is part of the
+-- Foreign Function Interface (FFI) and will usually be imported via
+-- the "Foreign" module.
+--
+-- Unsafe API Only.
+--
+-----------------------------------------------------------------------------
+
+module Foreign.ForeignPtr.Unsafe (
+        -- ** Unsafe low-level operations
+        unsafeForeignPtrToPtr,
+    ) where
+
+import Foreign.ForeignPtr.Imp
+
diff --git a/libraries/base/Foreign/Marshal.hs b/libraries/base/Foreign/Marshal.hs
new file mode 100644
index 000000000000..9336549c6f45
--- /dev/null
+++ b/libraries/base/Foreign/Marshal.hs
@@ -0,0 +1,26 @@
+{-# LANGUAGE Unsafe #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Foreign.Marshal
+-- Copyright   :  (c) The FFI task force 2003
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+-- 
+-- Maintainer  :  ffi@haskell.org
+-- Stability   :  provisional
+-- Portability :  portable
+--
+-- Marshalling support
+--
+-----------------------------------------------------------------------------
+
+module Foreign.Marshal
+        (
+         -- | The module "Foreign.Marshal" re-exports the safe content in the
+         -- @Foreign.Marshal@ hierarchy:
+          module Foreign.Marshal.Safe
+        ) where
+
+import Foreign.Marshal.Safe
+
diff --git a/libraries/base/Foreign/Marshal/Alloc.hs b/libraries/base/Foreign/Marshal/Alloc.hs
new file mode 100644
index 000000000000..a9d70405538c
--- /dev/null
+++ b/libraries/base/Foreign/Marshal/Alloc.hs
@@ -0,0 +1,211 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE NoImplicitPrelude
+           , MagicHash
+           , UnboxedTuples
+  #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Foreign.Marshal.Alloc
+-- Copyright   :  (c) The FFI task force 2001
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+-- 
+-- Maintainer  :  ffi@haskell.org
+-- Stability   :  provisional
+-- Portability :  portable
+--
+-- The module "Foreign.Marshal.Alloc" provides operations to allocate and
+-- deallocate blocks of raw memory (i.e., unstructured chunks of memory
+-- outside of the area maintained by the Haskell storage manager).  These
+-- memory blocks are commonly used to pass compound data structures to
+-- foreign functions or to provide space in which compound result values
+-- are obtained from foreign functions.
+-- 
+-- If any of the allocation functions fails, an exception is thrown.
+-- In some cases, memory exhaustion may mean the process is terminated.
+-- If 'free' or 'reallocBytes' is applied to a memory area
+-- that has been allocated with 'alloca' or 'allocaBytes', the
+-- behaviour is undefined.  Any further access to memory areas allocated with
+-- 'alloca' or 'allocaBytes', after the computation that was passed to
+-- the allocation function has terminated, leads to undefined behaviour.  Any
+-- further access to the memory area referenced by a pointer passed to
+-- 'realloc', 'reallocBytes', or 'free' entails undefined
+-- behaviour.
+-- 
+-- All storage allocated by functions that allocate based on a /size in bytes/
+-- must be sufficiently aligned for any of the basic foreign types
+-- that fits into the newly allocated storage. All storage allocated by
+-- functions that allocate based on a specific type must be sufficiently
+-- aligned for that type. Array allocation routines need to obey the same
+-- alignment constraints for each array element.
+--
+-----------------------------------------------------------------------------
+
+module Foreign.Marshal.Alloc (
+  -- * Memory allocation
+  -- ** Local allocation
+  alloca,
+  allocaBytes,
+  allocaBytesAligned,
+
+  -- ** Dynamic allocation
+  malloc,
+  mallocBytes,
+
+  realloc,
+  reallocBytes,
+
+  free,
+  finalizerFree
+) where
+
+import Data.Maybe
+import Foreign.C.Types          ( CSize(..) )
+import Foreign.Storable         ( Storable(sizeOf,alignment) )
+import Foreign.ForeignPtr       ( FinalizerPtr )
+import GHC.IO.Exception
+import GHC.Real
+import GHC.Ptr
+import GHC.Base
+
+-- exported functions
+-- ------------------
+
+-- |Allocate a block of memory that is sufficient to hold values of type
+-- @a@.  The size of the area allocated is determined by the 'sizeOf'
+-- method from the instance of 'Storable' for the appropriate type.
+--
+-- The memory may be deallocated using 'free' or 'finalizerFree' when
+-- no longer required.
+--
+{-# INLINE malloc #-}
+malloc :: Storable a => IO (Ptr a)
+malloc  = doMalloc undefined
+  where
+    doMalloc       :: Storable b => b -> IO (Ptr b)
+    doMalloc dummy  = mallocBytes (sizeOf dummy)
+
+-- |Allocate a block of memory of the given number of bytes.
+-- The block of memory is sufficiently aligned for any of the basic
+-- foreign types that fits into a memory block of the allocated size.
+--
+-- The memory may be deallocated using 'free' or 'finalizerFree' when
+-- no longer required.
+--
+mallocBytes      :: Int -> IO (Ptr a)
+mallocBytes size  = failWhenNULL "malloc" (_malloc (fromIntegral size))
+
+-- |@'alloca' f@ executes the computation @f@, passing as argument
+-- a pointer to a temporarily allocated block of memory sufficient to
+-- hold values of type @a@.
+--
+-- The memory is freed when @f@ terminates (either normally or via an
+-- exception), so the pointer passed to @f@ must /not/ be used after this.
+--
+{-# INLINE alloca #-}
+alloca :: Storable a => (Ptr a -> IO b) -> IO b
+alloca  = doAlloca undefined
+  where
+    doAlloca       :: Storable a' => a' -> (Ptr a' -> IO b') -> IO b'
+    doAlloca dummy  = allocaBytesAligned (sizeOf dummy) (alignment dummy)
+
+-- |@'allocaBytes' n f@ executes the computation @f@, passing as argument
+-- a pointer to a temporarily allocated block of memory of @n@ bytes.
+-- The block of memory is sufficiently aligned for any of the basic
+-- foreign types that fits into a memory block of the allocated size.
+--
+-- The memory is freed when @f@ terminates (either normally or via an
+-- exception), so the pointer passed to @f@ must /not/ be used after this.
+--
+allocaBytes :: Int -> (Ptr a -> IO b) -> IO b
+allocaBytes (I# size) action = IO $ \ s0 ->
+     case newPinnedByteArray# size s0      of { (# s1, mbarr# #) ->
+     case unsafeFreezeByteArray# mbarr# s1 of { (# s2, barr#  #) ->
+     let addr = Ptr (byteArrayContents# barr#) in
+     case action addr     of { IO action' ->
+     case action' s2      of { (# s3, r #) ->
+     case touch# barr# s3 of { s4 ->
+     (# s4, r #)
+  }}}}}
+
+allocaBytesAligned :: Int -> Int -> (Ptr a -> IO b) -> IO b
+allocaBytesAligned (I# size) (I# align) action = IO $ \ s0 ->
+     case newAlignedPinnedByteArray# size align s0 of { (# s1, mbarr# #) ->
+     case unsafeFreezeByteArray# mbarr# s1 of { (# s2, barr#  #) ->
+     let addr = Ptr (byteArrayContents# barr#) in
+     case action addr     of { IO action' ->
+     case action' s2      of { (# s3, r #) ->
+     case touch# barr# s3 of { s4 ->
+     (# s4, r #)
+  }}}}}
+
+-- |Resize a memory area that was allocated with 'malloc' or 'mallocBytes'
+-- to the size needed to store values of type @b@.  The returned pointer
+-- may refer to an entirely different memory area, but will be suitably
+-- aligned to hold values of type @b@.  The contents of the referenced
+-- memory area will be the same as of the original pointer up to the
+-- minimum of the original size and the size of values of type @b@.
+--
+-- If the argument to 'realloc' is 'nullPtr', 'realloc' behaves like
+-- 'malloc'.
+--
+realloc :: Storable b => Ptr a -> IO (Ptr b)
+realloc  = doRealloc undefined
+  where
+    doRealloc           :: Storable b' => b' -> Ptr a' -> IO (Ptr b')
+    doRealloc dummy ptr  = let
+                             size = fromIntegral (sizeOf dummy)
+                           in
+                           failWhenNULL "realloc" (_realloc ptr size)
+
+-- |Resize a memory area that was allocated with 'malloc' or 'mallocBytes'
+-- to the given size.  The returned pointer may refer to an entirely
+-- different memory area, but will be sufficiently aligned for any of the
+-- basic foreign types that fits into a memory block of the given size.
+-- The contents of the referenced memory area will be the same as of
+-- the original pointer up to the minimum of the original size and the
+-- given size.
+--
+-- If the pointer argument to 'reallocBytes' is 'nullPtr', 'reallocBytes'
+-- behaves like 'malloc'.  If the requested size is 0, 'reallocBytes'
+-- behaves like 'free'.
+--
+reallocBytes          :: Ptr a -> Int -> IO (Ptr a)
+reallocBytes ptr 0     = do free ptr; return nullPtr
+reallocBytes ptr size  = 
+  failWhenNULL "realloc" (_realloc ptr (fromIntegral size))
+
+-- |Free a block of memory that was allocated with 'malloc',
+-- 'mallocBytes', 'realloc', 'reallocBytes', 'Foreign.Marshal.Utils.new'
+-- or any of the @new@/X/ functions in "Foreign.Marshal.Array" or
+-- "Foreign.C.String".
+--
+free :: Ptr a -> IO ()
+free  = _free
+
+
+-- auxilliary routines
+-- -------------------
+
+-- asserts that the pointer returned from the action in the second argument is
+-- non-null
+--
+failWhenNULL :: String -> IO (Ptr a) -> IO (Ptr a)
+failWhenNULL name f = do
+   addr <- f
+   if addr == nullPtr
+      then ioError (IOError Nothing ResourceExhausted name 
+                                        "out of memory" Nothing Nothing)
+      else return addr
+
+-- basic C routines needed for memory allocation
+--
+foreign import ccall unsafe "stdlib.h malloc"  _malloc  ::          CSize -> IO (Ptr a)
+foreign import ccall unsafe "stdlib.h realloc" _realloc :: Ptr a -> CSize -> IO (Ptr b)
+foreign import ccall unsafe "stdlib.h free"    _free    :: Ptr a -> IO ()
+
+-- | A pointer to a foreign function equivalent to 'free', which may be
+-- used as a finalizer (cf 'Foreign.ForeignPtr.ForeignPtr') for storage
+-- allocated with 'malloc', 'mallocBytes', 'realloc' or 'reallocBytes'.
+foreign import ccall unsafe "stdlib.h &free" finalizerFree :: FinalizerPtr a
+
diff --git a/libraries/base/Foreign/Marshal/Array.hs b/libraries/base/Foreign/Marshal/Array.hs
new file mode 100644
index 000000000000..8d7dcfb560e0
--- /dev/null
+++ b/libraries/base/Foreign/Marshal/Array.hs
@@ -0,0 +1,264 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE NoImplicitPrelude, MagicHash #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Foreign.Marshal.Array
+-- Copyright   :  (c) The FFI task force 2001
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+-- 
+-- Maintainer  :  ffi@haskell.org
+-- Stability   :  provisional
+-- Portability :  portable
+--
+-- Marshalling support: routines allocating, storing, and retrieving Haskell
+-- lists that are represented as arrays in the foreign language
+--
+-----------------------------------------------------------------------------
+
+module Foreign.Marshal.Array (
+  -- * Marshalling arrays
+
+  -- ** Allocation
+  --
+  mallocArray,
+  mallocArray0,
+
+  allocaArray,
+  allocaArray0,
+
+  reallocArray,
+  reallocArray0,
+
+  -- ** Marshalling
+  --
+  peekArray,
+  peekArray0,
+
+  pokeArray,
+  pokeArray0,
+
+  -- ** Combined allocation and marshalling
+  --
+  newArray,
+  newArray0,
+
+  withArray,
+  withArray0,
+
+  withArrayLen,
+  withArrayLen0,
+
+  -- ** Copying
+
+  -- | (argument order: destination, source)
+  copyArray,
+  moveArray,
+
+  -- ** Finding the length
+  --
+  lengthArray0,
+
+  -- ** Indexing
+  --
+  advancePtr,
+) where
+
+import Foreign.Ptr      (Ptr, plusPtr)
+import Foreign.Storable (Storable(alignment,sizeOf,peekElemOff,pokeElemOff))
+import Foreign.Marshal.Alloc (mallocBytes, allocaBytesAligned, reallocBytes)
+import Foreign.Marshal.Utils (copyBytes, moveBytes)
+
+import GHC.Num
+import GHC.List
+import GHC.Base
+
+-- allocation
+-- ----------
+
+-- |Allocate storage for the given number of elements of a storable type
+-- (like 'Foreign.Marshal.Alloc.malloc', but for multiple elements).
+--
+mallocArray :: Storable a => Int -> IO (Ptr a)
+mallocArray  = doMalloc undefined
+  where
+    doMalloc            :: Storable a' => a' -> Int -> IO (Ptr a')
+    doMalloc dummy size  = mallocBytes (size * sizeOf dummy)
+
+-- |Like 'mallocArray', but add an extra position to hold a special
+-- termination element.
+--
+mallocArray0      :: Storable a => Int -> IO (Ptr a)
+mallocArray0 size  = mallocArray (size + 1)
+
+-- |Temporarily allocate space for the given number of elements
+-- (like 'Foreign.Marshal.Alloc.alloca', but for multiple elements).
+--
+allocaArray :: Storable a => Int -> (Ptr a -> IO b) -> IO b
+allocaArray  = doAlloca undefined
+  where
+    doAlloca            :: Storable a' => a' -> Int -> (Ptr a' -> IO b') -> IO b'
+    doAlloca dummy size  = allocaBytesAligned (size * sizeOf dummy)
+                                              (alignment dummy)
+
+-- |Like 'allocaArray', but add an extra position to hold a special
+-- termination element.
+--
+allocaArray0      :: Storable a => Int -> (Ptr a -> IO b) -> IO b
+allocaArray0 size  = allocaArray (size + 1)
+{-# INLINE allocaArray0 #-}
+  -- needed to get allocaArray to inline into withCString, for unknown
+  -- reasons --SDM 23/4/2010, see #4004 for benchmark
+
+-- |Adjust the size of an array
+--
+reallocArray :: Storable a => Ptr a -> Int -> IO (Ptr a)
+reallocArray  = doRealloc undefined
+  where
+    doRealloc                :: Storable a' => a' -> Ptr a' -> Int -> IO (Ptr a')
+    doRealloc dummy ptr size  = reallocBytes ptr (size * sizeOf dummy)
+
+-- |Adjust the size of an array including an extra position for the end marker.
+--
+reallocArray0          :: Storable a => Ptr a -> Int -> IO (Ptr a)
+reallocArray0 ptr size  = reallocArray ptr (size + 1)
+
+
+-- marshalling
+-- -----------
+
+-- |Convert an array of given length into a Haskell list.  The implementation
+-- is tail-recursive and so uses constant stack space.
+--
+peekArray          :: Storable a => Int -> Ptr a -> IO [a]
+peekArray size ptr | size <= 0 = return []
+                 | otherwise = f (size-1) []
+  where
+    f 0 acc = do e <- peekElemOff ptr 0; return (e:acc)
+    f n acc = do e <- peekElemOff ptr n; f (n-1) (e:acc)
+  
+-- |Convert an array terminated by the given end marker into a Haskell list
+--
+peekArray0            :: (Storable a, Eq a) => a -> Ptr a -> IO [a]
+peekArray0 marker ptr  = do
+  size <- lengthArray0 marker ptr
+  peekArray size ptr
+
+-- |Write the list elements consecutive into memory
+--
+pokeArray :: Storable a => Ptr a -> [a] -> IO ()
+pokeArray ptr vals0 = go vals0 0#
+  where go [] _          = return ()
+        go (val:vals) n# = do pokeElemOff ptr (I# n#) val; go vals (n# +# 1#)
+
+-- |Write the list elements consecutive into memory and terminate them with the
+-- given marker element
+--
+pokeArray0 :: Storable a => a -> Ptr a -> [a] -> IO ()
+pokeArray0 marker ptr vals0 = go vals0 0#
+  where go [] n#         = pokeElemOff ptr (I# n#) marker
+        go (val:vals) n# = do pokeElemOff ptr (I# n#) val; go vals (n# +# 1#)
+
+-- combined allocation and marshalling
+-- -----------------------------------
+
+-- |Write a list of storable elements into a newly allocated, consecutive
+-- sequence of storable values
+-- (like 'Foreign.Marshal.Utils.new', but for multiple elements).
+--
+newArray      :: Storable a => [a] -> IO (Ptr a)
+newArray vals  = do
+  ptr <- mallocArray (length vals)
+  pokeArray ptr vals
+  return ptr
+
+-- |Write a list of storable elements into a newly allocated, consecutive
+-- sequence of storable values, where the end is fixed by the given end marker
+--
+newArray0             :: Storable a => a -> [a] -> IO (Ptr a)
+newArray0 marker vals  = do
+  ptr <- mallocArray0 (length vals)
+  pokeArray0 marker ptr vals
+  return ptr
+
+-- |Temporarily store a list of storable values in memory
+-- (like 'Foreign.Marshal.Utils.with', but for multiple elements).
+--
+withArray :: Storable a => [a] -> (Ptr a -> IO b) -> IO b
+withArray vals = withArrayLen vals . const
+
+-- |Like 'withArray', but the action gets the number of values
+-- as an additional parameter
+--
+withArrayLen :: Storable a => [a] -> (Int -> Ptr a -> IO b) -> IO b
+withArrayLen vals f  =
+  allocaArray len $ \ptr -> do
+      pokeArray ptr vals
+      res <- f len ptr
+      return res
+  where
+    len = length vals
+
+-- |Like 'withArray', but a terminator indicates where the array ends
+--
+withArray0 :: Storable a => a -> [a] -> (Ptr a -> IO b) -> IO b
+withArray0 marker vals = withArrayLen0 marker vals . const
+
+-- |Like 'withArrayLen', but a terminator indicates where the array ends
+--
+withArrayLen0 :: Storable a => a -> [a] -> (Int -> Ptr a -> IO b) -> IO b
+withArrayLen0 marker vals f  =
+  allocaArray0 len $ \ptr -> do
+      pokeArray0 marker ptr vals
+      res <- f len ptr
+      return res
+  where
+    len = length vals
+
+
+-- copying (argument order: destination, source)
+-- -------
+
+-- |Copy the given number of elements from the second array (source) into the
+-- first array (destination); the copied areas may /not/ overlap
+--
+copyArray :: Storable a => Ptr a -> Ptr a -> Int -> IO ()
+copyArray  = doCopy undefined
+  where
+    doCopy                     :: Storable a' => a' -> Ptr a' -> Ptr a' -> Int -> IO ()
+    doCopy dummy dest src size  = copyBytes dest src (size * sizeOf dummy)
+
+-- |Copy the given number of elements from the second array (source) into the
+-- first array (destination); the copied areas /may/ overlap
+--
+moveArray :: Storable a => Ptr a -> Ptr a -> Int -> IO ()
+moveArray  = doMove undefined
+  where
+    doMove                     :: Storable a' => a' -> Ptr a' -> Ptr a' -> Int -> IO ()
+    doMove dummy dest src size  = moveBytes dest src (size * sizeOf dummy)
+
+
+-- finding the length
+-- ------------------
+
+-- |Return the number of elements in an array, excluding the terminator
+--
+lengthArray0            :: (Storable a, Eq a) => a -> Ptr a -> IO Int
+lengthArray0 marker ptr  = loop 0
+  where
+    loop i = do
+        val <- peekElemOff ptr i
+        if val == marker then return i else loop (i+1)
+
+
+-- indexing
+-- --------
+
+-- |Advance a pointer into an array by the given number of elements
+--
+advancePtr :: Storable a => Ptr a -> Int -> Ptr a
+advancePtr  = doAdvance undefined
+  where
+    doAdvance             :: Storable a' => a' -> Ptr a' -> Int -> Ptr a'
+    doAdvance dummy ptr i  = ptr `plusPtr` (i * sizeOf dummy)
+
diff --git a/libraries/base/Foreign/Marshal/Error.hs b/libraries/base/Foreign/Marshal/Error.hs
new file mode 100644
index 000000000000..758812b68828
--- /dev/null
+++ b/libraries/base/Foreign/Marshal/Error.hs
@@ -0,0 +1,82 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE CPP, NoImplicitPrelude #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Foreign.Marshal.Error
+-- Copyright   :  (c) The FFI task force 2001
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+-- 
+-- Maintainer  :  ffi@haskell.org
+-- Stability   :  provisional
+-- Portability :  portable
+--
+-- Routines for testing return values and raising a 'userError' exception
+-- in case of values indicating an error state.
+--
+-----------------------------------------------------------------------------
+
+module Foreign.Marshal.Error (
+  throwIf,
+  throwIf_,
+  throwIfNeg,
+  throwIfNeg_,
+  throwIfNull,
+
+  -- Discard return value
+  --
+  void
+) where
+
+import Foreign.Ptr
+
+#ifdef __HADDOCK__
+import Data.Bool
+import System.IO.Error
+#endif
+import GHC.Base
+import GHC.Num
+import GHC.IO.Exception
+
+-- exported functions
+-- ------------------
+
+-- |Execute an 'IO' action, throwing a 'userError' if the predicate yields
+-- 'True' when applied to the result returned by the 'IO' action.
+-- If no exception is raised, return the result of the computation.
+--
+throwIf :: (a -> Bool)  -- ^ error condition on the result of the 'IO' action
+        -> (a -> String) -- ^ computes an error message from erroneous results
+                        -- of the 'IO' action
+        -> IO a         -- ^ the 'IO' action to be executed
+        -> IO a
+throwIf pred msgfct act  = 
+  do
+    res <- act
+    (if pred res then ioError . userError . msgfct else return) res
+
+-- |Like 'throwIf', but discarding the result
+--
+throwIf_                 :: (a -> Bool) -> (a -> String) -> IO a -> IO ()
+throwIf_ pred msgfct act  = void $ throwIf pred msgfct act
+
+-- |Guards against negative result values
+--
+throwIfNeg :: (Ord a, Num a) => (a -> String) -> IO a -> IO a
+throwIfNeg  = throwIf (< 0)
+
+-- |Like 'throwIfNeg', but discarding the result
+--
+throwIfNeg_ :: (Ord a, Num a) => (a -> String) -> IO a -> IO ()
+throwIfNeg_  = throwIf_ (< 0)
+
+-- |Guards against null pointers
+--
+throwIfNull :: String -> IO (Ptr a) -> IO (Ptr a)
+throwIfNull  = throwIf (== nullPtr) . const
+
+-- |Discard the return value of an 'IO' action
+--
+void     :: IO a -> IO ()
+void act  = act >> return ()
+{-# DEPRECATED void "use 'Control.Monad.void' instead" #-} -- deprecated in 7.6
diff --git a/libraries/base/Foreign/Marshal/Pool.hs b/libraries/base/Foreign/Marshal/Pool.hs
new file mode 100644
index 000000000000..8dc57ae753b9
--- /dev/null
+++ b/libraries/base/Foreign/Marshal/Pool.hs
@@ -0,0 +1,199 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+
+--------------------------------------------------------------------------------
+-- |
+-- Module      :  Foreign.Marshal.Pool
+-- Copyright   :  (c) Sven Panne 2002-2004
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+-- 
+-- Maintainer  :  sven.panne@aedion.de
+-- Stability   :  provisional
+-- Portability :  portable
+--
+-- This module contains support for pooled memory management. Under this scheme,
+-- (re-)allocations belong to a given pool, and everything in a pool is
+-- deallocated when the pool itself is deallocated. This is useful when
+-- 'Foreign.Marshal.Alloc.alloca' with its implicit allocation and deallocation
+-- is not flexible enough, but explicit uses of 'Foreign.Marshal.Alloc.malloc'
+-- and 'free' are too awkward.
+--
+--------------------------------------------------------------------------------
+
+module Foreign.Marshal.Pool (
+   -- * Pool management
+   Pool,
+   newPool,
+   freePool,
+   withPool,
+
+   -- * (Re-)Allocation within a pool
+   pooledMalloc,
+   pooledMallocBytes,
+
+   pooledRealloc,
+   pooledReallocBytes,
+
+   pooledMallocArray,
+   pooledMallocArray0,
+
+   pooledReallocArray,
+   pooledReallocArray0,
+
+   -- * Combined allocation and marshalling
+   pooledNew,
+   pooledNewArray,
+   pooledNewArray0
+) where
+
+import GHC.Base              ( Int, Monad(..), (.), not )
+import GHC.Err               ( undefined )
+import GHC.Exception         ( throw )
+import GHC.IO                ( IO, mask, catchAny )
+import GHC.IORef             ( IORef, newIORef, readIORef, writeIORef )
+import GHC.List              ( elem, length )
+import GHC.Num               ( Num(..) )
+
+import Control.Monad         ( liftM )
+import Data.List             ( delete )
+import Foreign.Marshal.Alloc ( mallocBytes, reallocBytes, free )
+import Foreign.Marshal.Array ( pokeArray, pokeArray0 )
+import Foreign.Marshal.Error ( throwIf )
+import Foreign.Ptr           ( Ptr, castPtr )
+import Foreign.Storable      ( Storable(sizeOf, poke) )
+
+--------------------------------------------------------------------------------
+
+-- To avoid non-H2010 stuff like existentially quantified data constructors, we
+-- simply use pointers to () below. Not very nice, but...
+
+-- | A memory pool.
+
+newtype Pool = Pool (IORef [Ptr ()])
+
+-- | Allocate a fresh memory pool.
+
+newPool :: IO Pool
+newPool = liftM Pool (newIORef [])
+
+-- | Deallocate a memory pool and everything which has been allocated in the
+-- pool itself.
+
+freePool :: Pool -> IO ()
+freePool (Pool pool) = readIORef pool >>= freeAll
+   where freeAll []     = return ()
+         freeAll (p:ps) = free p >> freeAll ps
+
+-- | Execute an action with a fresh memory pool, which gets automatically
+-- deallocated (including its contents) after the action has finished.
+
+withPool :: (Pool -> IO b) -> IO b
+withPool act =   -- ATTENTION: cut-n-paste from Control.Exception below!
+   mask (\restore -> do
+      pool <- newPool
+      val <- catchAny
+                (restore (act pool))
+                (\e -> do freePool pool; throw e)
+      freePool pool
+      return val)
+
+--------------------------------------------------------------------------------
+
+-- | Allocate space for storable type in the given pool. The size of the area
+-- allocated is determined by the 'sizeOf' method from the instance of
+-- 'Storable' for the appropriate type.
+
+pooledMalloc :: Storable a => Pool -> IO (Ptr a)
+pooledMalloc = pm undefined
+  where
+    pm           :: Storable a' => a' -> Pool -> IO (Ptr a')
+    pm dummy pool = pooledMallocBytes pool (sizeOf dummy)
+
+-- | Allocate the given number of bytes of storage in the pool.
+
+pooledMallocBytes :: Pool -> Int -> IO (Ptr a)
+pooledMallocBytes (Pool pool) size = do
+   ptr <- mallocBytes size
+   ptrs <- readIORef pool
+   writeIORef pool (ptr:ptrs)
+   return (castPtr ptr)
+
+-- | Adjust the storage area for an element in the pool to the given size of
+-- the required type.
+
+pooledRealloc :: Storable a => Pool -> Ptr a -> IO (Ptr a)
+pooledRealloc = pr undefined
+  where
+    pr               :: Storable a' => a' -> Pool -> Ptr a' -> IO (Ptr a')
+    pr dummy pool ptr = pooledReallocBytes pool ptr (sizeOf dummy)
+
+-- | Adjust the storage area for an element in the pool to the given size.
+
+pooledReallocBytes :: Pool -> Ptr a -> Int -> IO (Ptr a)
+pooledReallocBytes (Pool pool) ptr size = do
+   let cPtr = castPtr ptr
+   _ <- throwIf (not . (cPtr `elem`)) (\_ -> "pointer not in pool") (readIORef pool)
+   newPtr <- reallocBytes cPtr size
+   ptrs <- readIORef pool
+   writeIORef pool (newPtr : delete cPtr ptrs)
+   return (castPtr newPtr)
+
+-- | Allocate storage for the given number of elements of a storable type in the
+-- pool.
+
+pooledMallocArray :: Storable a => Pool -> Int -> IO (Ptr a)
+pooledMallocArray = pma undefined
+  where
+    pma                :: Storable a' => a' -> Pool -> Int -> IO (Ptr a')
+    pma dummy pool size = pooledMallocBytes pool (size * sizeOf dummy)
+
+-- | Allocate storage for the given number of elements of a storable type in the
+-- pool, but leave room for an extra element to signal the end of the array.
+
+pooledMallocArray0 :: Storable a => Pool -> Int -> IO (Ptr a)
+pooledMallocArray0 pool size =
+   pooledMallocArray pool (size + 1)
+
+-- | Adjust the size of an array in the given pool.
+
+pooledReallocArray :: Storable a => Pool -> Ptr a -> Int -> IO (Ptr a)
+pooledReallocArray = pra undefined
+  where
+    pra                ::  Storable a' => a' -> Pool -> Ptr a' -> Int -> IO (Ptr a')
+    pra dummy pool ptr size  = pooledReallocBytes pool ptr (size * sizeOf dummy)
+
+-- | Adjust the size of an array with an end marker in the given pool.
+
+pooledReallocArray0 :: Storable a => Pool -> Ptr a -> Int -> IO (Ptr a)
+pooledReallocArray0 pool ptr size =
+   pooledReallocArray pool ptr (size + 1)
+
+--------------------------------------------------------------------------------
+
+-- | Allocate storage for a value in the given pool and marshal the value into
+-- this storage.
+
+pooledNew :: Storable a => Pool -> a -> IO (Ptr a)
+pooledNew pool val = do
+   ptr <- pooledMalloc pool
+   poke ptr val
+   return ptr
+
+-- | Allocate consecutive storage for a list of values in the given pool and
+-- marshal these values into it.
+
+pooledNewArray :: Storable a => Pool -> [a] -> IO (Ptr a)
+pooledNewArray pool vals = do
+   ptr <- pooledMallocArray pool (length vals)
+   pokeArray ptr vals
+   return ptr
+
+-- | Allocate consecutive storage for a list of values in the given pool and
+-- marshal these values into it, terminating the end with the given marker.
+
+pooledNewArray0 :: Storable a => Pool -> a -> [a] -> IO (Ptr a)
+pooledNewArray0 pool marker vals = do
+   ptr <- pooledMallocArray0 pool (length vals)
+   pokeArray0 marker ptr vals
+   return ptr
+
diff --git a/libraries/base/Foreign/Marshal/Safe.hs b/libraries/base/Foreign/Marshal/Safe.hs
new file mode 100644
index 000000000000..85bad2bdd7c1
--- /dev/null
+++ b/libraries/base/Foreign/Marshal/Safe.hs
@@ -0,0 +1,36 @@
+{-# LANGUAGE Safe #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Foreign.Marshal.Safe
+-- Copyright   :  (c) The FFI task force 2003
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+-- 
+-- Maintainer  :  ffi@haskell.org
+-- Stability   :  provisional
+-- Portability :  portable
+--
+-- Marshalling support
+--
+-- Safe API Only.
+--
+-----------------------------------------------------------------------------
+
+module Foreign.Marshal.Safe
+        (
+         -- | The module "Foreign.Marshal.Safe" re-exports the other modules in the
+         -- @Foreign.Marshal@ hierarchy:
+          module Foreign.Marshal.Alloc
+        , module Foreign.Marshal.Array
+        , module Foreign.Marshal.Error
+        , module Foreign.Marshal.Pool
+        , module Foreign.Marshal.Utils
+        ) where
+
+import Foreign.Marshal.Alloc
+import Foreign.Marshal.Array
+import Foreign.Marshal.Error
+import Foreign.Marshal.Pool
+import Foreign.Marshal.Utils
+
diff --git a/libraries/base/Foreign/Marshal/Unsafe.hs b/libraries/base/Foreign/Marshal/Unsafe.hs
new file mode 100644
index 000000000000..7e986f99e882
--- /dev/null
+++ b/libraries/base/Foreign/Marshal/Unsafe.hs
@@ -0,0 +1,45 @@
+{-# LANGUAGE Unsafe #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Foreign.Marshal.Unsafe
+-- Copyright   :  (c) The FFI task force 2003
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+-- 
+-- Maintainer  :  ffi@haskell.org
+-- Stability   :  provisional
+-- Portability :  portable
+--
+-- Marshalling support. Unsafe API.
+--
+-----------------------------------------------------------------------------
+
+module Foreign.Marshal.Unsafe (
+        -- * Unsafe functions
+        unsafeLocalState
+    ) where
+
+import GHC.IO
+
+{- |
+Sometimes an external entity is a pure function, except that it passes
+arguments and/or results via pointers.  The function
+@unsafeLocalState@ permits the packaging of such entities as pure
+functions.  
+
+The only IO operations allowed in the IO action passed to
+@unsafeLocalState@ are (a) local allocation (@alloca@, @allocaBytes@
+and derived operations such as @withArray@ and @withCString@), and (b)
+pointer operations (@Foreign.Storable@ and @Foreign.Ptr@) on the
+pointers to local storage, and (c) foreign functions whose only
+observable effect is to read and/or write the locally allocated
+memory.  Passing an IO operation that does not obey these rules
+results in undefined behaviour.
+
+It is expected that this operation will be
+replaced in a future revision of Haskell.
+-}
+unsafeLocalState :: IO a -> a
+unsafeLocalState = unsafeDupablePerformIO
+
diff --git a/libraries/base/Foreign/Marshal/Utils.hs b/libraries/base/Foreign/Marshal/Utils.hs
new file mode 100644
index 000000000000..4654e550f2c2
--- /dev/null
+++ b/libraries/base/Foreign/Marshal/Utils.hs
@@ -0,0 +1,172 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Foreign.Marshal.Utils
+-- Copyright   :  (c) The FFI task force 2001
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+-- 
+-- Maintainer  :  ffi@haskell.org
+-- Stability   :  provisional
+-- Portability :  portable
+--
+-- Utilities for primitive marshaling
+--
+-----------------------------------------------------------------------------
+
+module Foreign.Marshal.Utils (
+  -- * General marshalling utilities
+
+  -- ** Combined allocation and marshalling
+  --
+  with,
+  new,
+
+  -- ** Marshalling of Boolean values (non-zero corresponds to 'True')
+  --
+  fromBool,
+  toBool,
+
+  -- ** Marshalling of Maybe values
+  --
+  maybeNew,
+  maybeWith,
+  maybePeek,
+
+  -- ** Marshalling lists of storable objects
+  --
+  withMany,
+
+  -- ** Haskellish interface to memcpy and memmove
+  -- | (argument order: destination, source)
+  --
+  copyBytes,
+  moveBytes,
+) where
+
+import Data.Maybe
+import Foreign.Ptr              ( Ptr, nullPtr )
+import Foreign.Storable         ( Storable(poke) )
+import Foreign.C.Types          ( CSize(..) )
+import Foreign.Marshal.Alloc    ( malloc, alloca )
+
+import GHC.Real                 ( fromIntegral )
+import GHC.Num
+import GHC.Base
+
+-- combined allocation and marshalling
+-- -----------------------------------
+
+-- |Allocate a block of memory and marshal a value into it
+-- (the combination of 'malloc' and 'poke').
+-- The size of the area allocated is determined by the 'Foreign.Storable.sizeOf'
+-- method from the instance of 'Storable' for the appropriate type.
+--
+-- The memory may be deallocated using 'Foreign.Marshal.Alloc.free' or
+-- 'Foreign.Marshal.Alloc.finalizerFree' when no longer required.
+--
+new     :: Storable a => a -> IO (Ptr a)
+new val  = 
+  do 
+    ptr <- malloc
+    poke ptr val
+    return ptr
+
+-- |@'with' val f@ executes the computation @f@, passing as argument
+-- a pointer to a temporarily allocated block of memory into which
+-- @val@ has been marshalled (the combination of 'alloca' and 'poke').
+--
+-- The memory is freed when @f@ terminates (either normally or via an
+-- exception), so the pointer passed to @f@ must /not/ be used after this.
+--
+with       :: Storable a => a -> (Ptr a -> IO b) -> IO b
+with val f  =
+  alloca $ \ptr -> do
+    poke ptr val
+    res <- f ptr
+    return res
+
+
+-- marshalling of Boolean values (non-zero corresponds to 'True')
+-- -----------------------------
+
+-- |Convert a Haskell 'Bool' to its numeric representation
+--
+fromBool       :: Num a => Bool -> a
+fromBool False  = 0
+fromBool True   = 1
+
+-- |Convert a Boolean in numeric representation to a Haskell value
+--
+toBool :: (Eq a, Num a) => a -> Bool
+toBool  = (/= 0)
+
+
+-- marshalling of Maybe values
+-- ---------------------------
+
+-- |Allocate storage and marshal a storable value wrapped into a 'Maybe'
+--
+-- * the 'nullPtr' is used to represent 'Nothing'
+--
+maybeNew :: (      a -> IO (Ptr b))
+         -> (Maybe a -> IO (Ptr b))
+maybeNew  = maybe (return nullPtr)
+
+-- |Converts a @withXXX@ combinator into one marshalling a value wrapped
+-- into a 'Maybe', using 'nullPtr' to represent 'Nothing'.
+--
+maybeWith :: (      a -> (Ptr b -> IO c) -> IO c) 
+          -> (Maybe a -> (Ptr b -> IO c) -> IO c)
+maybeWith  = maybe ($ nullPtr)
+
+-- |Convert a peek combinator into a one returning 'Nothing' if applied to a
+-- 'nullPtr' 
+--
+maybePeek                           :: (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
+maybePeek peek ptr | ptr == nullPtr  = return Nothing
+                   | otherwise       = do a <- peek ptr; return (Just a)
+
+
+-- marshalling lists of storable objects
+-- -------------------------------------
+
+-- |Replicates a @withXXX@ combinator over a list of objects, yielding a list of
+-- marshalled objects
+--
+withMany :: (a -> (b -> res) -> res)  -- withXXX combinator for one object
+         -> [a]                       -- storable objects
+         -> ([b] -> res)              -- action on list of marshalled obj.s
+         -> res
+withMany _       []     f = f []
+withMany withFoo (x:xs) f = withFoo x $ \x' ->
+                              withMany withFoo xs (\xs' -> f (x':xs'))
+
+
+-- Haskellish interface to memcpy and memmove
+-- ------------------------------------------
+
+-- |Copies the given number of bytes from the second area (source) into the
+-- first (destination); the copied areas may /not/ overlap
+--
+copyBytes               :: Ptr a -> Ptr a -> Int -> IO ()
+copyBytes dest src size  = do _ <- memcpy dest src (fromIntegral size)
+                              return ()
+
+-- |Copies the given number of bytes from the second area (source) into the
+-- first (destination); the copied areas /may/ overlap
+--
+moveBytes               :: Ptr a -> Ptr a -> Int -> IO ()
+moveBytes dest src size  = do _ <- memmove dest src (fromIntegral size)
+                              return ()
+
+
+-- auxilliary routines
+-- -------------------
+
+-- |Basic C routines needed for memory copying
+--
+foreign import ccall unsafe "string.h" memcpy  :: Ptr a -> Ptr a -> CSize -> IO (Ptr a)
+foreign import ccall unsafe "string.h" memmove :: Ptr a -> Ptr a -> CSize -> IO (Ptr a)
+
diff --git a/libraries/base/Foreign/Ptr.hs b/libraries/base/Foreign/Ptr.hs
new file mode 100644
index 000000000000..f35fdeb70faf
--- /dev/null
+++ b/libraries/base/Foreign/Ptr.hs
@@ -0,0 +1,104 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE CPP
+           , NoImplicitPrelude
+           , MagicHash
+           , GeneralizedNewtypeDeriving
+  #-}
+{-# LANGUAGE AutoDeriveTypeable, StandaloneDeriving #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Foreign.Ptr
+-- Copyright   :  (c) The FFI task force 2001
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+-- 
+-- Maintainer  :  ffi@haskell.org
+-- Stability   :  provisional
+-- Portability :  portable
+--
+-- This module provides typed pointers to foreign data.  It is part
+-- of the Foreign Function Interface (FFI) and will normally be
+-- imported via the "Foreign" module.
+--
+-----------------------------------------------------------------------------
+
+module Foreign.Ptr (
+
+    -- * Data pointers
+
+    Ptr,
+    nullPtr,
+    castPtr,
+    plusPtr,
+    alignPtr,
+    minusPtr,
+
+    -- * Function pointers
+
+    FunPtr,
+    nullFunPtr,
+    castFunPtr,
+    castFunPtrToPtr,
+    castPtrToFunPtr,
+
+    freeHaskellFunPtr,
+    -- Free the function pointer created by foreign export dynamic.
+
+    -- * Integral types with lossless conversion to and from pointers
+    IntPtr,
+    ptrToIntPtr,
+    intPtrToPtr,
+    WordPtr,
+    ptrToWordPtr,
+    wordPtrToPtr
+ ) where
+
+import GHC.Ptr
+import GHC.Base
+import GHC.Num
+import GHC.Read
+import GHC.Real
+import GHC.Show
+import GHC.Enum
+
+import Data.Bits
+import Data.Typeable
+import Foreign.Storable ( Storable(..) )
+
+-- | Release the storage associated with the given 'FunPtr', which
+-- must have been obtained from a wrapper stub.  This should be called
+-- whenever the return value from a foreign import wrapper function is
+-- no longer required; otherwise, the storage it uses will leak.
+foreign import ccall unsafe "freeHaskellFunctionPtr"
+    freeHaskellFunPtr :: FunPtr a -> IO ()
+
+#include "HsBaseConfig.h"
+#include "CTypes.h"
+
+-- | An unsigned integral type that can be losslessly converted to and from
+-- @Ptr@. This type is also compatible with the C99 type @uintptr_t@, and
+-- can be marshalled to and from that type safely.
+INTEGRAL_TYPE(WordPtr,Word)
+        -- Word and Int are guaranteed pointer-sized in GHC
+
+-- | A signed integral type that can be losslessly converted to and from
+-- @Ptr@.  This type is also compatible with the C99 type @intptr_t@, and
+-- can be marshalled to and from that type safely.
+INTEGRAL_TYPE(IntPtr,Int)
+        -- Word and Int are guaranteed pointer-sized in GHC
+
+-- | casts a @Ptr@ to a @WordPtr@
+ptrToWordPtr :: Ptr a -> WordPtr
+ptrToWordPtr (Ptr a#) = WordPtr (W# (int2Word# (addr2Int# a#)))
+
+-- | casts a @WordPtr@ to a @Ptr@
+wordPtrToPtr :: WordPtr -> Ptr a
+wordPtrToPtr (WordPtr (W# w#)) = Ptr (int2Addr# (word2Int# w#))
+
+-- | casts a @Ptr@ to an @IntPtr@
+ptrToIntPtr :: Ptr a -> IntPtr
+ptrToIntPtr (Ptr a#) = IntPtr (I# (addr2Int# a#))
+
+-- | casts an @IntPtr@ to a @Ptr@
+intPtrToPtr :: IntPtr -> Ptr a
+intPtrToPtr (IntPtr (I# i#)) = Ptr (int2Addr# i#)
diff --git a/libraries/base/Foreign/Safe.hs b/libraries/base/Foreign/Safe.hs
new file mode 100644
index 000000000000..9809aff1cb93
--- /dev/null
+++ b/libraries/base/Foreign/Safe.hs
@@ -0,0 +1,40 @@
+{-# LANGUAGE Safe #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Foreign.Safe
+-- Copyright   :  (c) The FFI task force 2001
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+-- 
+-- Maintainer  :  ffi@haskell.org
+-- Stability   :  provisional
+-- Portability :  portable
+--
+-- A collection of data types, classes, and functions for interfacing
+-- with another programming language.
+--
+-- Safe API Only.
+--
+-----------------------------------------------------------------------------
+
+module Foreign.Safe
+        ( module Data.Bits
+        , module Data.Int
+        , module Data.Word
+        , module Foreign.Ptr
+        , module Foreign.ForeignPtr.Safe
+        , module Foreign.StablePtr
+        , module Foreign.Storable
+        , module Foreign.Marshal.Safe
+        ) where
+
+import Data.Bits
+import Data.Int
+import Data.Word
+import Foreign.Ptr
+import Foreign.ForeignPtr.Safe
+import Foreign.StablePtr
+import Foreign.Storable
+import Foreign.Marshal.Safe
+
diff --git a/libraries/base/Foreign/StablePtr.hs b/libraries/base/Foreign/StablePtr.hs
new file mode 100644
index 000000000000..acd89e5428d0
--- /dev/null
+++ b/libraries/base/Foreign/StablePtr.hs
@@ -0,0 +1,47 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Foreign.StablePtr
+-- Copyright   :  (c) The University of Glasgow 2001
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+-- 
+-- Maintainer  :  ffi@haskell.org
+-- Stability   :  provisional
+-- Portability :  portable
+--
+-- This module is part of the Foreign Function Interface (FFI) and will usually
+-- be imported via the module "Foreign".
+--
+-----------------------------------------------------------------------------
+
+
+module Foreign.StablePtr
+        ( -- * Stable references to Haskell values
+          StablePtr          -- abstract
+        , newStablePtr
+        , deRefStablePtr
+        , freeStablePtr
+        , castStablePtrToPtr
+        , castPtrToStablePtr
+        , -- ** The C-side interface
+
+          -- $cinterface
+        ) where
+
+import GHC.Stable
+
+-- $cinterface
+--
+-- The following definition is available to C programs inter-operating with
+-- Haskell code when including the header @HsFFI.h@.
+--
+-- > typedef void *HsStablePtr;  /* C representation of a StablePtr */
+--
+-- Note that no assumptions may be made about the values representing stable
+-- pointers.  In fact, they need not even be valid memory addresses.  The only
+-- guarantee provided is that if they are passed back to Haskell land, the
+-- function 'deRefStablePtr' will be able to reconstruct the
+-- Haskell value referred to by the stable pointer.
+
diff --git a/libraries/base/Foreign/Storable.hs b/libraries/base/Foreign/Storable.hs
new file mode 100644
index 000000000000..74417413f2aa
--- /dev/null
+++ b/libraries/base/Foreign/Storable.hs
@@ -0,0 +1,249 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE CPP, NoImplicitPrelude, ScopedTypeVariables #-}
+{-# LANGUAGE BangPatterns #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Foreign.Storable
+-- Copyright   :  (c) The FFI task force 2001
+-- License     :  see libraries/base/LICENSE
+-- 
+-- Maintainer  :  ffi@haskell.org
+-- Stability   :  provisional
+-- Portability :  portable
+--
+-- The module "Foreign.Storable" provides most elementary support for
+-- marshalling and is part of the language-independent portion of the
+-- Foreign Function Interface (FFI), and will normally be imported via
+-- the "Foreign" module.
+--
+-----------------------------------------------------------------------------
+
+module Foreign.Storable
+        ( Storable(
+             sizeOf,
+             alignment,
+             peekElemOff,
+             pokeElemOff,
+             peekByteOff,
+             pokeByteOff,
+             peek,
+             poke)
+        ) where
+
+
+import Control.Monad            ( liftM )
+
+#include "MachDeps.h"
+#include "HsBaseConfig.h"
+
+import GHC.Storable
+import GHC.Stable       ( StablePtr )
+import GHC.Num
+import GHC.Int
+import GHC.Word
+import GHC.Ptr
+import GHC.Base
+import GHC.Fingerprint.Type
+import Data.Bits
+import GHC.Real
+
+{- |
+The member functions of this class facilitate writing values of
+primitive types to raw memory (which may have been allocated with the
+above mentioned routines) and reading values from blocks of raw
+memory.  The class, furthermore, includes support for computing the
+storage requirements and alignment restrictions of storable types.
+
+Memory addresses are represented as values of type @'Ptr' a@, for some
+@a@ which is an instance of class 'Storable'.  The type argument to
+'Ptr' helps provide some valuable type safety in FFI code (you can\'t
+mix pointers of different types without an explicit cast), while
+helping the Haskell type system figure out which marshalling method is
+needed for a given pointer.
+
+All marshalling between Haskell and a foreign language ultimately
+boils down to translating Haskell data structures into the binary
+representation of a corresponding data structure of the foreign
+language and vice versa.  To code this marshalling in Haskell, it is
+necessary to manipulate primitive data types stored in unstructured
+memory blocks.  The class 'Storable' facilitates this manipulation on
+all types for which it is instantiated, which are the standard basic
+types of Haskell, the fixed size @Int@ types ('Int8', 'Int16',
+'Int32', 'Int64'), the fixed size @Word@ types ('Word8', 'Word16',
+'Word32', 'Word64'), 'StablePtr', all types from "Foreign.C.Types",
+as well as 'Ptr'.
+
+Minimal complete definition: 'sizeOf', 'alignment', one of 'peek',
+'peekElemOff' and 'peekByteOff', and one of 'poke', 'pokeElemOff' and
+'pokeByteOff'.
+-}
+
+class Storable a where
+
+   sizeOf      :: a -> Int
+   -- ^ Computes the storage requirements (in bytes) of the argument.
+   -- The value of the argument is not used.
+
+   alignment   :: a -> Int
+   -- ^ Computes the alignment constraint of the argument.  An
+   -- alignment constraint @x@ is fulfilled by any address divisible
+   -- by @x@.  The value of the argument is not used.
+
+   peekElemOff :: Ptr a -> Int      -> IO a
+   -- ^       Read a value from a memory area regarded as an array
+   --         of values of the same kind.  The first argument specifies
+   --         the start address of the array and the second the index into
+   --         the array (the first element of the array has index
+   --         @0@).  The following equality holds,
+   -- 
+   -- > peekElemOff addr idx = IOExts.fixIO $ \result ->
+   -- >   peek (addr `plusPtr` (idx * sizeOf result))
+   --
+   --         Note that this is only a specification, not
+   --         necessarily the concrete implementation of the
+   --         function.
+
+   pokeElemOff :: Ptr a -> Int -> a -> IO ()
+   -- ^       Write a value to a memory area regarded as an array of
+   --         values of the same kind.  The following equality holds:
+   -- 
+   -- > pokeElemOff addr idx x = 
+   -- >   poke (addr `plusPtr` (idx * sizeOf x)) x
+
+   peekByteOff :: Ptr b -> Int      -> IO a
+   -- ^       Read a value from a memory location given by a base
+   --         address and offset.  The following equality holds:
+   --
+   -- > peekByteOff addr off = peek (addr `plusPtr` off)
+
+   pokeByteOff :: Ptr b -> Int -> a -> IO ()
+   -- ^       Write a value to a memory location given by a base
+   --         address and offset.  The following equality holds:
+   --
+   -- > pokeByteOff addr off x = poke (addr `plusPtr` off) x
+  
+   peek        :: Ptr a      -> IO a
+   -- ^ Read a value from the given memory location.
+   --
+   --  Note that the peek and poke functions might require properly
+   --  aligned addresses to function correctly.  This is architecture
+   --  dependent; thus, portable code should ensure that when peeking or
+   --  poking values of some type @a@, the alignment
+   --  constraint for @a@, as given by the function
+   --  'alignment' is fulfilled.
+
+   poke        :: Ptr a -> a -> IO ()
+   -- ^ Write the given value to the given memory location.  Alignment
+   -- restrictions might apply; see 'peek'.
+ 
+   -- circular default instances
+   peekElemOff = peekElemOff_ undefined
+      where peekElemOff_ :: a -> Ptr a -> Int -> IO a
+            peekElemOff_ undef ptr off = peekByteOff ptr (off * sizeOf undef)
+   pokeElemOff ptr off val = pokeByteOff ptr (off * sizeOf val) val
+
+   peekByteOff ptr off = peek (ptr `plusPtr` off)
+   pokeByteOff ptr off = poke (ptr `plusPtr` off)
+
+   peek ptr = peekElemOff ptr 0
+   poke ptr = pokeElemOff ptr 0
+
+   {-# MINIMAL sizeOf, alignment,
+               (peek | peekElemOff | peekByteOff),
+               (poke | pokeElemOff | pokeByteOff) #-}
+
+-- System-dependent, but rather obvious instances
+
+instance Storable Bool where
+   sizeOf _          = sizeOf (undefined::HTYPE_INT)
+   alignment _       = alignment (undefined::HTYPE_INT)
+   peekElemOff p i   = liftM (/= (0::HTYPE_INT)) $ peekElemOff (castPtr p) i
+   pokeElemOff p i x = pokeElemOff (castPtr p) i (if x then 1 else 0::HTYPE_INT)
+
+#define STORABLE(T,size,align,read,write)       \
+instance Storable (T) where {                   \
+    sizeOf    _ = size;                         \
+    alignment _ = align;                        \
+    peekElemOff = read;                         \
+    pokeElemOff = write }
+
+STORABLE(Char,SIZEOF_INT32,ALIGNMENT_INT32,
+         readWideCharOffPtr,writeWideCharOffPtr)
+
+STORABLE(Int,SIZEOF_HSINT,ALIGNMENT_HSINT,
+         readIntOffPtr,writeIntOffPtr)
+
+STORABLE(Word,SIZEOF_HSWORD,ALIGNMENT_HSWORD,
+         readWordOffPtr,writeWordOffPtr)
+
+STORABLE((Ptr a),SIZEOF_HSPTR,ALIGNMENT_HSPTR,
+         readPtrOffPtr,writePtrOffPtr)
+
+STORABLE((FunPtr a),SIZEOF_HSFUNPTR,ALIGNMENT_HSFUNPTR,
+         readFunPtrOffPtr,writeFunPtrOffPtr)
+
+STORABLE((StablePtr a),SIZEOF_HSSTABLEPTR,ALIGNMENT_HSSTABLEPTR,
+         readStablePtrOffPtr,writeStablePtrOffPtr)
+
+STORABLE(Float,SIZEOF_HSFLOAT,ALIGNMENT_HSFLOAT,
+         readFloatOffPtr,writeFloatOffPtr)
+
+STORABLE(Double,SIZEOF_HSDOUBLE,ALIGNMENT_HSDOUBLE,
+         readDoubleOffPtr,writeDoubleOffPtr)
+
+STORABLE(Word8,SIZEOF_WORD8,ALIGNMENT_WORD8,
+         readWord8OffPtr,writeWord8OffPtr)
+
+STORABLE(Word16,SIZEOF_WORD16,ALIGNMENT_WORD16,
+         readWord16OffPtr,writeWord16OffPtr)
+
+STORABLE(Word32,SIZEOF_WORD32,ALIGNMENT_WORD32,
+         readWord32OffPtr,writeWord32OffPtr)
+
+STORABLE(Word64,SIZEOF_WORD64,ALIGNMENT_WORD64,
+         readWord64OffPtr,writeWord64OffPtr)
+
+STORABLE(Int8,SIZEOF_INT8,ALIGNMENT_INT8,
+         readInt8OffPtr,writeInt8OffPtr)
+
+STORABLE(Int16,SIZEOF_INT16,ALIGNMENT_INT16,
+         readInt16OffPtr,writeInt16OffPtr)
+
+STORABLE(Int32,SIZEOF_INT32,ALIGNMENT_INT32,
+         readInt32OffPtr,writeInt32OffPtr)
+
+STORABLE(Int64,SIZEOF_INT64,ALIGNMENT_INT64,
+         readInt64OffPtr,writeInt64OffPtr)
+
+-- XXX: here to avoid orphan instance in GHC.Fingerprint
+instance Storable Fingerprint where
+  sizeOf _ = 16
+  alignment _ = 8
+  peek = peekFingerprint
+  poke = pokeFingerprint
+
+-- peek/poke in fixed BIG-endian 128-bit format
+peekFingerprint :: Ptr Fingerprint -> IO Fingerprint
+peekFingerprint p0 = do
+      let peekW64 :: Ptr Word8 -> Int -> Word64 -> IO Word64
+          peekW64 _  0  !i = return i
+          peekW64 !p !n !i = do
+                w8 <- peek p
+                peekW64 (p `plusPtr` 1) (n-1) 
+                    ((i `shiftL` 8) .|. fromIntegral w8)
+
+      high <- peekW64 (castPtr p0) 8 0
+      low  <- peekW64 (castPtr p0 `plusPtr` 8) 8 0
+      return (Fingerprint high low)
+
+pokeFingerprint :: Ptr Fingerprint -> Fingerprint -> IO ()
+pokeFingerprint p0 (Fingerprint high low) = do
+      let pokeW64 :: Ptr Word8 -> Int -> Word64 -> IO ()
+          pokeW64 _ 0  _  = return ()
+          pokeW64 p !n !i = do
+                pokeElemOff p (n-1) (fromIntegral i)
+                pokeW64 p (n-1) (i `shiftR` 8)
+
+      pokeW64 (castPtr p0) 8 high
+      pokeW64 (castPtr p0 `plusPtr` 8) 8 low
diff --git a/libraries/base/GHC/Arr.lhs b/libraries/base/GHC/Arr.lhs
new file mode 100644
index 000000000000..14bc917cca0d
--- /dev/null
+++ b/libraries/base/GHC/Arr.lhs
@@ -0,0 +1,852 @@
+\begin{code}
+{-# LANGUAGE Unsafe #-}
+{-# LANGUAGE NoImplicitPrelude, MagicHash, UnboxedTuples #-}
+{-# OPTIONS_GHC -funbox-strict-fields #-}
+{-# OPTIONS_HADDOCK hide #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.Arr
+-- Copyright   :  (c) The University of Glasgow, 1994-2000
+-- License     :  see libraries/base/LICENSE
+--
+-- Maintainer  :  cvs-ghc@haskell.org
+-- Stability   :  internal
+-- Portability :  non-portable (GHC extensions)
+--
+-- GHC\'s array implementation.
+--
+-----------------------------------------------------------------------------
+
+module GHC.Arr (
+        Ix(..), Array(..), STArray(..),
+
+        indexError, hopelessIndexError,
+        arrEleBottom, array, listArray,
+        (!), safeRangeSize, negRange, safeIndex, badSafeIndex,
+        bounds, numElements, numElementsSTArray, indices, elems,
+        assocs, accumArray, adjust, (//), accum,
+        amap, ixmap,
+        eqArray, cmpArray, cmpIntArray,
+        newSTArray, boundsSTArray,
+        readSTArray, writeSTArray,
+        freezeSTArray, thawSTArray,
+
+        -- * Unsafe operations
+        fill, done,
+        unsafeArray, unsafeArray',
+        lessSafeIndex, unsafeAt, unsafeReplace,
+        unsafeAccumArray, unsafeAccumArray', unsafeAccum,
+        unsafeReadSTArray, unsafeWriteSTArray,
+        unsafeFreezeSTArray, unsafeThawSTArray,
+    ) where
+
+import GHC.Enum
+import GHC.Num
+import GHC.ST
+import GHC.Base
+import GHC.List
+import GHC.Real( fromIntegral )
+import GHC.Show
+
+infixl 9  !, //
+
+default ()
+\end{code}
+
+
+%*********************************************************
+%*                                                      *
+\subsection{The @Ix@ class}
+%*                                                      *
+%*********************************************************
+
+\begin{code}
+-- | The 'Ix' class is used to map a contiguous subrange of values in
+-- a type onto integers.  It is used primarily for array indexing
+-- (see the array package).
+--
+-- The first argument @(l,u)@ of each of these operations is a pair
+-- specifying the lower and upper bounds of a contiguous subrange of values.
+--
+-- An implementation is entitled to assume the following laws about these
+-- operations:
+--
+-- * @'inRange' (l,u) i == 'elem' i ('range' (l,u))@ @ @
+--
+-- * @'range' (l,u) '!!' 'index' (l,u) i == i@, when @'inRange' (l,u) i@
+--
+-- * @'map' ('index' (l,u)) ('range' (l,u))) == [0..'rangeSize' (l,u)-1]@ @ @
+--
+-- * @'rangeSize' (l,u) == 'length' ('range' (l,u))@ @ @
+--
+-- Minimal complete instance: 'range', 'index' and 'inRange'.
+--
+class (Ord a) => Ix a where
+    -- | The list of values in the subrange defined by a bounding pair.
+    range               :: (a,a) -> [a]
+    -- | The position of a subscript in the subrange.
+    index               :: (a,a) -> a -> Int
+    -- | Like 'index', but without checking that the value is in range.
+    unsafeIndex         :: (a,a) -> a -> Int
+    -- | Returns 'True' the given subscript lies in the range defined
+    -- the bounding pair.
+    inRange             :: (a,a) -> a -> Bool
+    -- | The size of the subrange defined by a bounding pair.
+    rangeSize           :: (a,a) -> Int
+    -- | like 'rangeSize', but without checking that the upper bound is
+    -- in range.
+    unsafeRangeSize     :: (a,a) -> Int
+
+        -- Must specify one of index, unsafeIndex
+
+	-- 'index' is typically over-ridden in instances, with essentially
+	-- the same code, but using indexError instead of hopelessIndexError
+	-- Reason: we have 'Show' at the instances
+    {-# INLINE index #-}  -- See Note [Inlining index]
+    index b i | inRange b i = unsafeIndex b i
+              | otherwise   = hopelessIndexError
+
+    unsafeIndex b i = index b i
+
+    rangeSize b@(_l,h) | inRange b h = unsafeIndex b h + 1
+                       | otherwise   = 0        -- This case is only here to
+                                                -- check for an empty range
+        -- NB: replacing (inRange b h) by (l <= h) fails for
+        --     tuples.  E.g.  (1,2) <= (2,1) but the range is empty
+
+    unsafeRangeSize b@(_l,h) = unsafeIndex b h + 1
+\end{code}
+
+Note that the following is NOT right
+        rangeSize (l,h) | l <= h    = index b h + 1
+                        | otherwise = 0
+
+Because it might be the case that l<h, but the range
+is nevertheless empty.  Consider
+        ((1,2),(2,1))
+Here l<h, but the second index ranges from 2..1 and
+hence is empty
+
+%*********************************************************
+%*                                                      *
+\subsection{Instances of @Ix@}
+%*                                                      *
+%*********************************************************
+
+Note [Inlining index]
+~~~~~~~~~~~~~~~~~~~~~
+We inline the 'index' operation,
+
+ * Partly because it generates much faster code
+   (although bigger); see Trac #1216
+
+ * Partly because it exposes the bounds checks to the simplifier which
+   might help a big.
+
+If you make a per-instance index method, you may consider inlining it.
+
+Note [Double bounds-checking of index values]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+When you index an array, a!x, there are two possible bounds checks we might make:
+
+  (A) Check that (inRange (bounds a) x) holds.
+
+      (A) is checked in the method for 'index'
+
+  (B) Check that (index (bounds a) x) lies in the range 0..n,
+      where n is the size of the underlying array
+
+      (B) is checked in the top-level function (!), in safeIndex.
+
+Of course it *should* be the case that (A) holds iff (B) holds, but that
+is a property of the particular instances of index, bounds, and inRange,
+so GHC cannot guarantee it.
+
+ * If you do (A) and not (B), then you might get a seg-fault,
+   by indexing at some bizarre location.  Trac #1610
+
+ * If you do (B) but not (A), you may get no complaint when you index
+   an array out of its semantic bounds.  Trac #2120
+
+At various times we have had (A) and not (B), or (B) and not (A); both
+led to complaints.  So now we implement *both* checks (Trac #2669).
+
+For 1-d, 2-d, and 3-d arrays of Int we have specialised instances to avoid this.
+
+Note [Out-of-bounds error messages]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+The default method for 'index' generates hoplelessIndexError, because
+Ix doesn't have Show as a superclass.  For particular base types we
+can do better, so we override the default method for index.
+
+\begin{code}
+-- Abstract these errors from the relevant index functions so that
+-- the guts of the function will be small enough to inline.
+
+{-# NOINLINE indexError #-}
+indexError :: Show a => (a,a) -> a -> String -> b
+indexError rng i tp
+  = error (showString "Ix{" . showString tp . showString "}.index: Index " .
+           showParen True (showsPrec 0 i) .
+           showString " out of range " $
+           showParen True (showsPrec 0 rng) "")
+
+hopelessIndexError :: Int -- Try to use 'indexError' instead!
+hopelessIndexError = error "Error in array index"
+
+----------------------------------------------------------------------
+instance  Ix Char  where
+    {-# INLINE range #-}
+    range (m,n) = [m..n]
+
+    {-# INLINE unsafeIndex #-}
+    unsafeIndex (m,_n) i = fromEnum i - fromEnum m
+
+    {-# INLINE index #-}  -- See Note [Out-of-bounds error messages]
+                          -- and Note [Inlining index]
+    index b i | inRange b i =  unsafeIndex b i
+              | otherwise   =  indexError b i "Char"
+
+    inRange (m,n) i     =  m <= i && i <= n
+
+----------------------------------------------------------------------
+instance  Ix Int  where
+    {-# INLINE range #-}
+        -- The INLINE stops the build in the RHS from getting inlined,
+        -- so that callers can fuse with the result of range
+    range (m,n) = [m..n]
+
+    {-# INLINE unsafeIndex #-}
+    unsafeIndex (m,_n) i = i - m
+
+    {-# INLINE index #-}  -- See Note [Out-of-bounds error messages]
+                          -- and Note [Inlining index]
+    index b i | inRange b i =  unsafeIndex b i
+              | otherwise   =  indexError b i "Int"
+
+    {-# INLINE inRange #-}
+    inRange (I# m,I# n) (I# i) =  isTrue# (m <=# i) && isTrue# (i <=# n)
+
+instance Ix Word where
+    range (m,n)         = [m..n]
+    unsafeIndex (m,_) i = fromIntegral (i - m)
+    inRange (m,n) i     = m <= i && i <= n
+
+----------------------------------------------------------------------
+instance  Ix Integer  where
+    {-# INLINE range #-}
+    range (m,n) = [m..n]
+
+    {-# INLINE unsafeIndex #-}
+    unsafeIndex (m,_n) i   = fromInteger (i - m)
+
+    {-# INLINE index #-}  -- See Note [Out-of-bounds error messages]
+                          -- and Note [Inlining index]
+    index b i | inRange b i =  unsafeIndex b i
+              | otherwise   =  indexError b i "Integer"
+
+    inRange (m,n) i     =  m <= i && i <= n
+
+----------------------------------------------------------------------
+instance Ix Bool where -- as derived
+    {-# INLINE range #-}
+    range (m,n) = [m..n]
+
+    {-# INLINE unsafeIndex #-}
+    unsafeIndex (l,_) i = fromEnum i - fromEnum l
+
+    {-# INLINE index #-}  -- See Note [Out-of-bounds error messages]
+                          -- and Note [Inlining index]
+    index b i | inRange b i =  unsafeIndex b i
+              | otherwise   =  indexError b i "Bool"
+
+    inRange (l,u) i = fromEnum i >= fromEnum l && fromEnum i <= fromEnum u
+
+----------------------------------------------------------------------
+instance Ix Ordering where -- as derived
+    {-# INLINE range #-}
+    range (m,n) = [m..n]
+
+    {-# INLINE unsafeIndex #-}
+    unsafeIndex (l,_) i = fromEnum i - fromEnum l
+
+    {-# INLINE index #-}  -- See Note [Out-of-bounds error messages]
+                          -- and Note [Inlining index]
+    index b i | inRange b i =  unsafeIndex b i
+              | otherwise   =  indexError b i "Ordering"
+
+    inRange (l,u) i = fromEnum i >= fromEnum l && fromEnum i <= fromEnum u
+
+----------------------------------------------------------------------
+instance Ix () where
+    {-# INLINE range #-}
+    range   ((), ())    = [()]
+    {-# INLINE unsafeIndex #-}
+    unsafeIndex   ((), ()) () = 0
+    {-# INLINE inRange #-}
+    inRange ((), ()) () = True
+
+    {-# INLINE index #-}  -- See Note [Inlining index]
+    index b i = unsafeIndex b i
+
+----------------------------------------------------------------------
+instance (Ix a, Ix b) => Ix (a, b) where -- as derived
+    {-# SPECIALISE instance Ix (Int,Int) #-}
+
+    {-# INLINE range #-}
+    range ((l1,l2),(u1,u2)) =
+      [ (i1,i2) | i1 <- range (l1,u1), i2 <- range (l2,u2) ]
+
+    {-# INLINE unsafeIndex #-}
+    unsafeIndex ((l1,l2),(u1,u2)) (i1,i2) =
+      unsafeIndex (l1,u1) i1 * unsafeRangeSize (l2,u2) + unsafeIndex (l2,u2) i2
+
+    {-# INLINE inRange #-}
+    inRange ((l1,l2),(u1,u2)) (i1,i2) =
+      inRange (l1,u1) i1 && inRange (l2,u2) i2
+
+    -- Default method for index
+
+----------------------------------------------------------------------
+instance  (Ix a1, Ix a2, Ix a3) => Ix (a1,a2,a3)  where
+    {-# SPECIALISE instance Ix (Int,Int,Int) #-}
+
+    range ((l1,l2,l3),(u1,u2,u3)) =
+        [(i1,i2,i3) | i1 <- range (l1,u1),
+                      i2 <- range (l2,u2),
+                      i3 <- range (l3,u3)]
+
+    unsafeIndex ((l1,l2,l3),(u1,u2,u3)) (i1,i2,i3) =
+      unsafeIndex (l3,u3) i3 + unsafeRangeSize (l3,u3) * (
+      unsafeIndex (l2,u2) i2 + unsafeRangeSize (l2,u2) * (
+      unsafeIndex (l1,u1) i1))
+
+    inRange ((l1,l2,l3),(u1,u2,u3)) (i1,i2,i3) =
+      inRange (l1,u1) i1 && inRange (l2,u2) i2 &&
+      inRange (l3,u3) i3
+
+    -- Default method for index
+
+----------------------------------------------------------------------
+instance  (Ix a1, Ix a2, Ix a3, Ix a4) => Ix (a1,a2,a3,a4)  where
+    range ((l1,l2,l3,l4),(u1,u2,u3,u4)) =
+      [(i1,i2,i3,i4) | i1 <- range (l1,u1),
+                       i2 <- range (l2,u2),
+                       i3 <- range (l3,u3),
+                       i4 <- range (l4,u4)]
+
+    unsafeIndex ((l1,l2,l3,l4),(u1,u2,u3,u4)) (i1,i2,i3,i4) =
+      unsafeIndex (l4,u4) i4 + unsafeRangeSize (l4,u4) * (
+      unsafeIndex (l3,u3) i3 + unsafeRangeSize (l3,u3) * (
+      unsafeIndex (l2,u2) i2 + unsafeRangeSize (l2,u2) * (
+      unsafeIndex (l1,u1) i1)))
+
+    inRange ((l1,l2,l3,l4),(u1,u2,u3,u4)) (i1,i2,i3,i4) =
+      inRange (l1,u1) i1 && inRange (l2,u2) i2 &&
+      inRange (l3,u3) i3 && inRange (l4,u4) i4
+
+    -- Default method for index
+
+instance  (Ix a1, Ix a2, Ix a3, Ix a4, Ix a5) => Ix (a1,a2,a3,a4,a5)  where
+    range ((l1,l2,l3,l4,l5),(u1,u2,u3,u4,u5)) =
+      [(i1,i2,i3,i4,i5) | i1 <- range (l1,u1),
+                          i2 <- range (l2,u2),
+                          i3 <- range (l3,u3),
+                          i4 <- range (l4,u4),
+                          i5 <- range (l5,u5)]
+
+    unsafeIndex ((l1,l2,l3,l4,l5),(u1,u2,u3,u4,u5)) (i1,i2,i3,i4,i5) =
+      unsafeIndex (l5,u5) i5 + unsafeRangeSize (l5,u5) * (
+      unsafeIndex (l4,u4) i4 + unsafeRangeSize (l4,u4) * (
+      unsafeIndex (l3,u3) i3 + unsafeRangeSize (l3,u3) * (
+      unsafeIndex (l2,u2) i2 + unsafeRangeSize (l2,u2) * (
+      unsafeIndex (l1,u1) i1))))
+
+    inRange ((l1,l2,l3,l4,l5),(u1,u2,u3,u4,u5)) (i1,i2,i3,i4,i5) =
+      inRange (l1,u1) i1 && inRange (l2,u2) i2 &&
+      inRange (l3,u3) i3 && inRange (l4,u4) i4 &&
+      inRange (l5,u5) i5
+
+    -- Default method for index
+\end{code}
+
+%*********************************************************
+%*                                                      *
+\subsection{The @Array@ types}
+%*                                                      *
+%*********************************************************
+
+\begin{code}
+-- | The type of immutable non-strict (boxed) arrays
+-- with indices in @i@ and elements in @e@.
+data Array i e
+   = Array            !i         -- the lower bound, l
+                      !i         -- the upper bound, u
+       {-# UNPACK #-} !Int       -- A cache of (rangeSize (l,u))
+                                 -- used to make sure an index is
+                                 -- really in range
+                      (Array# e) -- The actual elements
+
+-- | Mutable, boxed, non-strict arrays in the 'ST' monad.  The type
+-- arguments are as follows:
+--
+--  * @s@: the state variable argument for the 'ST' type
+--
+--  * @i@: the index type of the array (should be an instance of 'Ix')
+--
+--  * @e@: the element type of the array.
+--
+data STArray s i e
+  = STArray           !i               -- the lower bound, l
+                      !i               -- the upper bound, u
+      {-# UNPACK #-}  !Int             -- A cache of (rangeSize (l,u))
+                                       -- used to make sure an index is
+                                       -- really in range
+                   (MutableArray# s e) -- The actual elements
+        -- No Ix context for STArray.  They are stupid,
+        -- and force an Ix context on the equality instance.
+
+-- Just pointer equality on mutable arrays:
+instance Eq (STArray s i e) where
+    STArray _ _ _ arr1# == STArray _ _ _ arr2# =
+        isTrue# (sameMutableArray# arr1# arr2#)
+\end{code}
+
+
+%*********************************************************
+%*                                                      *
+\subsection{Operations on immutable arrays}
+%*                                                      *
+%*********************************************************
+
+\begin{code}
+{-# NOINLINE arrEleBottom #-}
+arrEleBottom :: a
+arrEleBottom = error "(Array.!): undefined array element"
+
+-- | Construct an array with the specified bounds and containing values
+-- for given indices within these bounds.
+--
+-- The array is undefined (i.e. bottom) if any index in the list is
+-- out of bounds.  The Haskell 2010 Report further specifies that if any
+-- two associations in the list have the same index, the value at that
+-- index is undefined (i.e. bottom).  However in GHC's implementation,
+-- the value at such an index is the value part of the last association
+-- with that index in the list.
+--
+-- Because the indices must be checked for these errors, 'array' is
+-- strict in the bounds argument and in the indices of the association
+-- list, but non-strict in the values.  Thus, recurrences such as the
+-- following are possible:
+--
+-- > a = array (1,100) ((1,1) : [(i, i * a!(i-1)) | i <- [2..100]])
+--
+-- Not every index within the bounds of the array need appear in the
+-- association list, but the values associated with indices that do not
+-- appear will be undefined (i.e. bottom).
+--
+-- If, in any dimension, the lower bound is greater than the upper bound,
+-- then the array is legal, but empty.  Indexing an empty array always
+-- gives an array-bounds error, but 'bounds' still yields the bounds
+-- with which the array was constructed.
+{-# INLINE array #-}
+array :: Ix i
+        => (i,i)        -- ^ a pair of /bounds/, each of the index type
+                        -- of the array.  These bounds are the lowest and
+                        -- highest indices in the array, in that order.
+                        -- For example, a one-origin vector of length
+                        -- '10' has bounds '(1,10)', and a one-origin '10'
+                        -- by '10' matrix has bounds '((1,1),(10,10))'.
+        -> [(i, e)]     -- ^ a list of /associations/ of the form
+                        -- (/index/, /value/).  Typically, this list will
+                        -- be expressed as a comprehension.  An
+                        -- association '(i, x)' defines the value of
+                        -- the array at index 'i' to be 'x'.
+        -> Array i e
+array (l,u) ies
+    = let n = safeRangeSize (l,u)
+      in unsafeArray' (l,u) n
+                      [(safeIndex (l,u) n i, e) | (i, e) <- ies]
+
+{-# INLINE unsafeArray #-}
+unsafeArray :: Ix i => (i,i) -> [(Int, e)] -> Array i e
+unsafeArray b ies = unsafeArray' b (rangeSize b) ies
+
+{-# INLINE unsafeArray' #-}
+unsafeArray' :: Ix i => (i,i) -> Int -> [(Int, e)] -> Array i e
+unsafeArray' (l,u) n@(I# n#) ies = runST (ST $ \s1# ->
+    case newArray# n# arrEleBottom s1# of
+        (# s2#, marr# #) ->
+            foldr (fill marr#) (done l u n marr#) ies s2#)
+
+{-# INLINE fill #-}
+fill :: MutableArray# s e -> (Int, e) -> STRep s a -> STRep s a
+-- NB: put the \s after the "=" so that 'fill'
+--     inlines when applied to three args
+fill marr# (I# i#, e) next
+ = \s1# -> case writeArray# marr# i# e s1# of
+             s2# -> next s2#
+
+{-# INLINE done #-}
+done :: Ix i => i -> i -> Int -> MutableArray# s e -> STRep s (Array i e)
+-- See NB on 'fill'
+-- Make sure it is strict in 'n'
+done l u n@(I# _) marr#
+  = \s1# -> case unsafeFreezeArray# marr# s1# of
+              (# s2#, arr# #) -> (# s2#, Array l u n arr# #)
+
+-- This is inefficient and I'm not sure why:
+-- listArray (l,u) es = unsafeArray (l,u) (zip [0 .. rangeSize (l,u) - 1] es)
+-- The code below is better. It still doesn't enable foldr/build
+-- transformation on the list of elements; I guess it's impossible
+-- using mechanisms currently available.
+
+-- | Construct an array from a pair of bounds and a list of values in
+-- index order.
+{-# INLINE listArray #-}
+listArray :: Ix i => (i,i) -> [e] -> Array i e
+listArray (l,u) es = runST (ST $ \s1# ->
+    case safeRangeSize (l,u)            of { n@(I# n#) ->
+    case newArray# n# arrEleBottom s1#  of { (# s2#, marr# #) ->
+    let fillFromList i# xs s3# | isTrue# (i# ==# n#) = s3#
+                               | otherwise = case xs of
+            []   -> s3#
+            y:ys -> case writeArray# marr# i# y s3# of { s4# ->
+                    fillFromList (i# +# 1#) ys s4# } in
+    case fillFromList 0# es s2#         of { s3# ->
+    done l u n marr# s3# }}})
+
+-- | The value at the given index in an array.
+{-# INLINE (!) #-}
+(!) :: Ix i => Array i e -> i -> e
+arr@(Array l u n _) ! i = unsafeAt arr $ safeIndex (l,u) n i
+
+{-# INLINE safeRangeSize #-}
+safeRangeSize :: Ix i => (i, i) -> Int
+safeRangeSize (l,u) = let r = rangeSize (l, u)
+                      in if r < 0 then negRange
+                                  else r
+
+-- Don't inline this error message everywhere!!
+negRange :: Int	  -- Uninformative, but Ix does not provide Show
+negRange = error "Negative range size"
+
+{-# INLINE[1] safeIndex #-}
+-- See Note [Double bounds-checking of index values]
+-- Inline *after* (!) so the rules can fire
+-- Make sure it is strict in n
+safeIndex :: Ix i => (i, i) -> Int -> i -> Int
+safeIndex (l,u) n@(I# _) i 
+  | (0 <= i') && (i' < n) = i'
+  | otherwise             = badSafeIndex i' n
+  where
+    i' = index (l,u) i
+
+-- See Note [Double bounds-checking of index values]
+{-# RULES
+"safeIndex/I"       safeIndex = lessSafeIndex :: (Int,Int) -> Int -> Int -> Int
+"safeIndex/(I,I)"   safeIndex = lessSafeIndex :: ((Int,Int),(Int,Int)) -> Int -> (Int,Int) -> Int
+"safeIndex/(I,I,I)" safeIndex = lessSafeIndex :: ((Int,Int,Int),(Int,Int,Int)) -> Int -> (Int,Int,Int) -> Int
+  #-}
+
+lessSafeIndex :: Ix i => (i, i) -> Int -> i -> Int
+-- See Note [Double bounds-checking of index values]
+-- Do only (A), the semantic check
+lessSafeIndex (l,u) _ i = index (l,u) i
+
+-- Don't inline this long error message everywhere!!
+badSafeIndex :: Int -> Int -> Int
+badSafeIndex i' n = error ("Error in array index; " ++ show i' ++
+                        " not in range [0.." ++ show n ++ ")")
+
+{-# INLINE unsafeAt #-}
+unsafeAt :: Ix i => Array i e -> Int -> e
+unsafeAt (Array _ _ _ arr#) (I# i#) =
+    case indexArray# arr# i# of (# e #) -> e
+
+-- | The bounds with which an array was constructed.
+{-# INLINE bounds #-}
+bounds :: Ix i => Array i e -> (i,i)
+bounds (Array l u _ _) = (l,u)
+
+-- | The number of elements in the array.
+{-# INLINE numElements #-}
+numElements :: Ix i => Array i e -> Int
+numElements (Array _ _ n _) = n
+
+-- | The list of indices of an array in ascending order.
+{-# INLINE indices #-}
+indices :: Ix i => Array i e -> [i]
+indices (Array l u _ _) = range (l,u)
+
+-- | The list of elements of an array in index order.
+{-# INLINE elems #-}
+elems :: Ix i => Array i e -> [e]
+elems arr@(Array _ _ n _) =
+    [unsafeAt arr i | i <- [0 .. n - 1]]
+
+-- | The list of associations of an array in index order.
+{-# INLINE assocs #-}
+assocs :: Ix i => Array i e -> [(i, e)]
+assocs arr@(Array l u _ _) =
+    [(i, arr ! i) | i <- range (l,u)]
+
+-- | The 'accumArray' function deals with repeated indices in the association
+-- list using an /accumulating function/ which combines the values of
+-- associations with the same index.
+-- For example, given a list of values of some index type, @hist@
+-- produces a histogram of the number of occurrences of each index within
+-- a specified range:
+--
+-- > hist :: (Ix a, Num b) => (a,a) -> [a] -> Array a b
+-- > hist bnds is = accumArray (+) 0 bnds [(i, 1) | i<-is, inRange bnds i]
+--
+-- If the accumulating function is strict, then 'accumArray' is strict in
+-- the values, as well as the indices, in the association list.  Thus,
+-- unlike ordinary arrays built with 'array', accumulated arrays should
+-- not in general be recursive.
+{-# INLINE accumArray #-}
+accumArray :: Ix i
+        => (e -> a -> e)        -- ^ accumulating function
+        -> e                    -- ^ initial value
+        -> (i,i)                -- ^ bounds of the array
+        -> [(i, a)]             -- ^ association list
+        -> Array i e
+accumArray f initial (l,u) ies =
+    let n = safeRangeSize (l,u)
+    in unsafeAccumArray' f initial (l,u) n
+                         [(safeIndex (l,u) n i, e) | (i, e) <- ies]
+
+{-# INLINE unsafeAccumArray #-}
+unsafeAccumArray :: Ix i => (e -> a -> e) -> e -> (i,i) -> [(Int, a)] -> Array i e
+unsafeAccumArray f initial b ies = unsafeAccumArray' f initial b (rangeSize b) ies
+
+{-# INLINE unsafeAccumArray' #-}
+unsafeAccumArray' :: Ix i => (e -> a -> e) -> e -> (i,i) -> Int -> [(Int, a)] -> Array i e
+unsafeAccumArray' f initial (l,u) n@(I# n#) ies = runST (ST $ \s1# ->
+    case newArray# n# initial s1#          of { (# s2#, marr# #) ->
+    foldr (adjust f marr#) (done l u n marr#) ies s2# })
+
+{-# INLINE adjust #-}
+adjust :: (e -> a -> e) -> MutableArray# s e -> (Int, a) -> STRep s b -> STRep s b
+-- See NB on 'fill'
+adjust f marr# (I# i#, new) next
+  = \s1# -> case readArray# marr# i# s1# of
+        	(# s2#, old #) ->
+        	    case writeArray# marr# i# (f old new) s2# of
+        	        s3# -> next s3#
+
+-- | Constructs an array identical to the first argument except that it has
+-- been updated by the associations in the right argument.
+-- For example, if @m@ is a 1-origin, @n@ by @n@ matrix, then
+--
+-- > m//[((i,i), 0) | i <- [1..n]]
+--
+-- is the same matrix, except with the diagonal zeroed.
+--
+-- Repeated indices in the association list are handled as for 'array':
+-- Haskell 2010 specifies that the resulting array is undefined (i.e. bottom),
+-- but GHC's implementation uses the last association for each index.
+{-# INLINE (//) #-}
+(//) :: Ix i => Array i e -> [(i, e)] -> Array i e
+arr@(Array l u n _) // ies =
+    unsafeReplace arr [(safeIndex (l,u) n i, e) | (i, e) <- ies]
+
+{-# INLINE unsafeReplace #-}
+unsafeReplace :: Ix i => Array i e -> [(Int, e)] -> Array i e
+unsafeReplace arr ies = runST (do
+    STArray l u n marr# <- thawSTArray arr
+    ST (foldr (fill marr#) (done l u n marr#) ies))
+
+-- | @'accum' f@ takes an array and an association list and accumulates
+-- pairs from the list into the array with the accumulating function @f@.
+-- Thus 'accumArray' can be defined using 'accum':
+--
+-- > accumArray f z b = accum f (array b [(i, z) | i <- range b])
+--
+{-# INLINE accum #-}
+accum :: Ix i => (e -> a -> e) -> Array i e -> [(i, a)] -> Array i e
+accum f arr@(Array l u n _) ies =
+    unsafeAccum f arr [(safeIndex (l,u) n i, e) | (i, e) <- ies]
+
+{-# INLINE unsafeAccum #-}
+unsafeAccum :: Ix i => (e -> a -> e) -> Array i e -> [(Int, a)] -> Array i e
+unsafeAccum f arr ies = runST (do
+    STArray l u n marr# <- thawSTArray arr
+    ST (foldr (adjust f marr#) (done l u n marr#) ies))
+
+{-# INLINE amap #-}
+amap :: Ix i => (a -> b) -> Array i a -> Array i b
+amap f arr@(Array l u n _) =
+    unsafeArray' (l,u) n [(i, f (unsafeAt arr i)) | i <- [0 .. n - 1]]
+
+-- | 'ixmap' allows for transformations on array indices.
+-- It may be thought of as providing function composition on the right
+-- with the mapping that the original array embodies.
+--
+-- A similar transformation of array values may be achieved using 'fmap'
+-- from the 'Array' instance of the 'Functor' class.
+{-# INLINE ixmap #-}
+ixmap :: (Ix i, Ix j) => (i,i) -> (i -> j) -> Array j e -> Array i e
+ixmap (l,u) f arr =
+    array (l,u) [(i, arr ! f i) | i <- range (l,u)]
+
+{-# INLINE eqArray #-}
+eqArray :: (Ix i, Eq e) => Array i e -> Array i e -> Bool
+eqArray arr1@(Array l1 u1 n1 _) arr2@(Array l2 u2 n2 _) =
+    if n1 == 0 then n2 == 0 else
+    l1 == l2 && u1 == u2 &&
+    and [unsafeAt arr1 i == unsafeAt arr2 i | i <- [0 .. n1 - 1]]
+
+{-# INLINE [1] cmpArray #-}
+cmpArray :: (Ix i, Ord e) => Array i e -> Array i e -> Ordering
+cmpArray arr1 arr2 = compare (assocs arr1) (assocs arr2)
+
+{-# INLINE cmpIntArray #-}
+cmpIntArray :: Ord e => Array Int e -> Array Int e -> Ordering
+cmpIntArray arr1@(Array l1 u1 n1 _) arr2@(Array l2 u2 n2 _) =
+    if n1 == 0 then
+        if n2 == 0 then EQ else LT
+    else if n2 == 0 then GT
+    else case compare l1 l2 of
+             EQ    -> foldr cmp (compare u1 u2) [0 .. (n1 `min` n2) - 1]
+             other -> other
+  where
+    cmp i rest = case compare (unsafeAt arr1 i) (unsafeAt arr2 i) of
+        EQ    -> rest
+        other -> other
+
+{-# RULES "cmpArray/Int" cmpArray = cmpIntArray #-}
+\end{code}
+
+
+%*********************************************************
+%*                                                      *
+\subsection{Array instances}
+%*                                                      *
+%*********************************************************
+
+\begin{code}
+instance Ix i => Functor (Array i) where
+    fmap = amap
+
+instance (Ix i, Eq e) => Eq (Array i e) where
+    (==) = eqArray
+
+instance (Ix i, Ord e) => Ord (Array i e) where
+    compare = cmpArray
+
+instance (Ix a, Show a, Show b) => Show (Array a b) where
+    showsPrec p a =
+        showParen (p > appPrec) $
+        showString "array " .
+        showsPrec appPrec1 (bounds a) .
+        showChar ' ' .
+        showsPrec appPrec1 (assocs a)
+        -- Precedence of 'array' is the precedence of application
+
+-- The Read instance is in GHC.Read
+\end{code}
+
+
+%*********************************************************
+%*                                                      *
+\subsection{Operations on mutable arrays}
+%*                                                      *
+%*********************************************************
+
+Idle ADR question: What's the tradeoff here between flattening these
+datatypes into @STArray ix ix (MutableArray# s elt)@ and using
+it as is?  As I see it, the former uses slightly less heap and
+provides faster access to the individual parts of the bounds while the
+code used has the benefit of providing a ready-made @(lo, hi)@ pair as
+required by many array-related functions.  Which wins? Is the
+difference significant (probably not).
+
+Idle AJG answer: When I looked at the outputted code (though it was 2
+years ago) it seems like you often needed the tuple, and we build
+it frequently. Now we've got the overloading specialiser things
+might be different, though.
+
+\begin{code}
+{-# INLINE newSTArray #-}
+newSTArray :: Ix i => (i,i) -> e -> ST s (STArray s i e)
+newSTArray (l,u) initial = ST $ \s1# ->
+    case safeRangeSize (l,u)            of { n@(I# n#) ->
+    case newArray# n# initial s1#       of { (# s2#, marr# #) ->
+    (# s2#, STArray l u n marr# #) }}
+
+{-# INLINE boundsSTArray #-}
+boundsSTArray :: STArray s i e -> (i,i)
+boundsSTArray (STArray l u _ _) = (l,u)
+
+{-# INLINE numElementsSTArray #-}
+numElementsSTArray :: STArray s i e -> Int
+numElementsSTArray (STArray _ _ n _) = n
+
+{-# INLINE readSTArray #-}
+readSTArray :: Ix i => STArray s i e -> i -> ST s e
+readSTArray marr@(STArray l u n _) i =
+    unsafeReadSTArray marr (safeIndex (l,u) n i)
+
+{-# INLINE unsafeReadSTArray #-}
+unsafeReadSTArray :: Ix i => STArray s i e -> Int -> ST s e
+unsafeReadSTArray (STArray _ _ _ marr#) (I# i#)
+    = ST $ \s1# -> readArray# marr# i# s1#
+
+{-# INLINE writeSTArray #-}
+writeSTArray :: Ix i => STArray s i e -> i -> e -> ST s ()
+writeSTArray marr@(STArray l u n _) i e =
+    unsafeWriteSTArray marr (safeIndex (l,u) n i) e
+
+{-# INLINE unsafeWriteSTArray #-}
+unsafeWriteSTArray :: Ix i => STArray s i e -> Int -> e -> ST s ()
+unsafeWriteSTArray (STArray _ _ _ marr#) (I# i#) e = ST $ \s1# ->
+    case writeArray# marr# i# e s1# of
+        s2# -> (# s2#, () #)
+\end{code}
+
+
+%*********************************************************
+%*                                                      *
+\subsection{Moving between mutable and immutable}
+%*                                                      *
+%*********************************************************
+
+\begin{code}
+freezeSTArray :: Ix i => STArray s i e -> ST s (Array i e)
+freezeSTArray (STArray l u n@(I# n#) marr#) = ST $ \s1# ->
+    case newArray# n# arrEleBottom s1#  of { (# s2#, marr'# #) ->
+    let copy i# s3# | isTrue# (i# ==# n#) = s3#
+                    | otherwise =
+            case readArray# marr# i# s3# of { (# s4#, e #) ->
+            case writeArray# marr'# i# e s4# of { s5# ->
+            copy (i# +# 1#) s5# }} in
+    case copy 0# s2#                    of { s3# ->
+    case unsafeFreezeArray# marr'# s3#  of { (# s4#, arr# #) ->
+    (# s4#, Array l u n arr# #) }}}
+
+{-# INLINE unsafeFreezeSTArray #-}
+unsafeFreezeSTArray :: Ix i => STArray s i e -> ST s (Array i e)
+unsafeFreezeSTArray (STArray l u n marr#) = ST $ \s1# ->
+    case unsafeFreezeArray# marr# s1#   of { (# s2#, arr# #) ->
+    (# s2#, Array l u n arr# #) }
+
+thawSTArray :: Ix i => Array i e -> ST s (STArray s i e)
+thawSTArray (Array l u n@(I# n#) arr#) = ST $ \s1# ->
+    case newArray# n# arrEleBottom s1#  of { (# s2#, marr# #) ->
+    let copy i# s3# | isTrue# (i# ==# n#) = s3#
+                    | otherwise =
+            case indexArray# arr# i#    of { (# e #) ->
+            case writeArray# marr# i# e s3# of { s4# ->
+            copy (i# +# 1#) s4# }} in
+    case copy 0# s2#                    of { s3# ->
+    (# s3#, STArray l u n marr# #) }}
+
+{-# INLINE unsafeThawSTArray #-}
+unsafeThawSTArray :: Ix i => Array i e -> ST s (STArray s i e)
+unsafeThawSTArray (Array l u n arr#) = ST $ \s1# ->
+    case unsafeThawArray# arr# s1#      of { (# s2#, marr# #) ->
+    (# s2#, STArray l u n marr# #) }
+\end{code}
diff --git a/libraries/base/GHC/Base.lhs b/libraries/base/GHC/Base.lhs
new file mode 100644
index 000000000000..6a089ee432dc
--- /dev/null
+++ b/libraries/base/GHC/Base.lhs
@@ -0,0 +1,777 @@
+\section[GHC.Base]{Module @GHC.Base@}
+
+The overall structure of the GHC Prelude is a bit tricky.
+
+  a) We want to avoid "orphan modules", i.e. ones with instance
+        decls that don't belong either to a tycon or a class
+        defined in the same module
+
+  b) We want to avoid giant modules
+
+So the rough structure is as follows, in (linearised) dependency order
+
+
+GHC.Prim        Has no implementation.  It defines built-in things, and
+                by importing it you bring them into scope.
+                The source file is GHC.Prim.hi-boot, which is just
+                copied to make GHC.Prim.hi
+
+GHC.Base        Classes: Eq, Ord, Functor, Monad
+                Types:   list, (), Int, Bool, Ordering, Char, String
+
+Data.Tuple      Types: tuples, plus instances for GHC.Base classes
+
+GHC.Show        Class: Show, plus instances for GHC.Base/GHC.Tup types
+
+GHC.Enum        Class: Enum,  plus instances for GHC.Base/GHC.Tup types
+
+Data.Maybe      Type: Maybe, plus instances for GHC.Base classes
+
+GHC.List        List functions
+
+GHC.Num         Class: Num, plus instances for Int
+                Type:  Integer, plus instances for all classes so far (Eq, Ord, Num, Show)
+
+                Integer is needed here because it is mentioned in the signature
+                of 'fromInteger' in class Num
+
+GHC.Real        Classes: Real, Integral, Fractional, RealFrac
+                         plus instances for Int, Integer
+                Types:  Ratio, Rational
+                        plus intances for classes so far
+
+                Rational is needed here because it is mentioned in the signature
+                of 'toRational' in class Real
+
+GHC.ST  The ST monad, instances and a few helper functions
+
+Ix              Classes: Ix, plus instances for Int, Bool, Char, Integer, Ordering, tuples
+
+GHC.Arr         Types: Array, MutableArray, MutableVar
+
+                Arrays are used by a function in GHC.Float
+
+GHC.Float       Classes: Floating, RealFloat
+                Types:   Float, Double, plus instances of all classes so far
+
+                This module contains everything to do with floating point.
+                It is a big module (900 lines)
+                With a bit of luck, many modules can be compiled without ever reading GHC.Float.hi
+
+
+Other Prelude modules are much easier with fewer complex dependencies.
+
+\begin{code}
+{-# LANGUAGE Unsafe #-}
+{-# LANGUAGE CPP
+           , NoImplicitPrelude
+           , BangPatterns
+           , ExplicitForAll
+           , MagicHash
+           , UnboxedTuples
+           , ExistentialQuantification
+           , RankNTypes
+  #-}
+-- -fno-warn-orphans is needed for things like:
+-- Orphan rule: "x# -# x#" ALWAYS forall x# :: Int# -# x# x# = 0
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# OPTIONS_HADDOCK hide #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.Base
+-- Copyright   :  (c) The University of Glasgow, 1992-2002
+-- License     :  see libraries/base/LICENSE
+--
+-- Maintainer  :  cvs-ghc@haskell.org
+-- Stability   :  internal
+-- Portability :  non-portable (GHC extensions)
+--
+-- Basic data types and classes.
+--
+-----------------------------------------------------------------------------
+
+#include "MachDeps.h"
+
+module GHC.Base
+        (
+        module GHC.Base,
+        module GHC.Classes,
+        module GHC.CString,
+        module GHC.Magic,
+        module GHC.Types,
+        module GHC.Prim,        -- Re-export GHC.Prim and [boot] GHC.Err,
+                                -- to avoid lots of people having to
+        module GHC.Err          -- import it explicitly
+  )
+        where
+
+import GHC.Types
+import GHC.Classes
+import GHC.CString
+import GHC.Magic
+import GHC.Prim
+import GHC.Err
+import {-# SOURCE #-} GHC.IO (failIO)
+
+import GHC.Tuple ()     -- Note [Depend on GHC.Tuple]
+import GHC.Integer ()   -- Note [Depend on GHC.Integer]
+
+infixr 9  .
+infixr 5  ++
+infixl 4  <$
+infixl 1  >>, >>=
+infixr 0  $
+
+default ()              -- Double isn't available yet
+\end{code}
+
+Note [Depend on GHC.Integer]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+The Integer type is special because TidyPgm uses
+GHC.Integer.Type.mkInteger to construct Integer literal values
+Currently it reads the interface file whether or not the current
+module *has* any Integer literals, so it's important that
+GHC.Integer.Type (in patckage integer-gmp or integer-simple) is
+compiled before any other module.  (There's a hack in GHC to disable
+this for packages ghc-prim, integer-gmp, integer-simple, which aren't
+allowed to contain any Integer literals.)
+
+Likewise we implicitly need Integer when deriving things like Eq
+instances.
+
+The danger is that if the build system doesn't know about the dependency
+on Integer, it'll compile some base module before GHC.Integer.Type, 
+resulting in:
+  Failed to load interface for ‘GHC.Integer.Type’
+    There are files missing in the ‘integer-gmp’ package,
+
+Bottom line: we make GHC.Base depend on GHC.Integer; and everything
+else either depends on GHC.Base, or does not have NoImplicitPrelude
+(and hence depends on Prelude).
+
+Note [Depend on GHC.Tuple]
+~~~~~~~~~~~~~~~~~~~~~~~~~~
+Similarly, tuple syntax (or ()) creates an implicit dependency on
+GHC.Tuple, so we use the same rule as for Integer --- see Note [Depend on
+GHC.Integer] --- to explain this to the build system.  We make GHC.Base
+depend on GHC.Tuple, and everything else depends on GHC.Base or Prelude.
+
+%*********************************************************
+%*                                                      *
+\subsection{DEBUGGING STUFF}
+%*  (for use when compiling GHC.Base itself doesn't work)
+%*                                                      *
+%*********************************************************
+
+\begin{code}
+{-
+data  Bool  =  False | True
+data Ordering = LT | EQ | GT
+data Char = C# Char#
+type  String = [Char]
+data Int = I# Int#
+data  ()  =  ()
+data [] a = MkNil
+
+not True = False
+(&&) True True = True
+otherwise = True
+
+build = error "urk"
+foldr = error "urk"
+-}
+\end{code}
+
+
+%*********************************************************
+%*                                                      *
+\subsection{Monadic classes @Functor@, @Monad@ }
+%*                                                      *
+%*********************************************************
+
+\begin{code}
+{- | The 'Functor' class is used for types that can be mapped over.
+Instances of 'Functor' should satisfy the following laws:
+
+> fmap id  ==  id
+> fmap (f . g)  ==  fmap f . fmap g
+
+The instances of 'Functor' for lists, 'Data.Maybe.Maybe' and 'System.IO.IO'
+satisfy these laws.
+-}
+
+class  Functor f  where
+    fmap        :: (a -> b) -> f a -> f b
+
+    -- | Replace all locations in the input with the same value.
+    -- The default definition is @'fmap' . 'const'@, but this may be
+    -- overridden with a more efficient version.
+    (<$)        :: a -> f b -> f a
+    (<$)        =  fmap . const
+
+{- | The 'Monad' class defines the basic operations over a /monad/,
+a concept from a branch of mathematics known as /category theory/.
+From the perspective of a Haskell programmer, however, it is best to
+think of a monad as an /abstract datatype/ of actions.
+Haskell's @do@ expressions provide a convenient syntax for writing
+monadic expressions.
+
+Minimal complete definition: '>>=' and 'return'.
+
+Instances of 'Monad' should satisfy the following laws:
+
+> return a >>= k  ==  k a
+> m >>= return  ==  m
+> m >>= (\x -> k x >>= h)  ==  (m >>= k) >>= h
+
+Instances of both 'Monad' and 'Functor' should additionally satisfy the law:
+
+> fmap f xs  ==  xs >>= return . f
+
+The instances of 'Monad' for lists, 'Data.Maybe.Maybe' and 'System.IO.IO'
+defined in the "Prelude" satisfy these laws.
+-}
+
+class  Monad m  where
+    -- | Sequentially compose two actions, passing any value produced
+    -- by the first as an argument to the second.
+    (>>=)       :: forall a b. m a -> (a -> m b) -> m b
+    -- | Sequentially compose two actions, discarding any value produced
+    -- by the first, like sequencing operators (such as the semicolon)
+    -- in imperative languages.
+    (>>)        :: forall a b. m a -> m b -> m b
+        -- Explicit for-alls so that we know what order to
+        -- give type arguments when desugaring
+
+    -- | Inject a value into the monadic type.
+    return      :: a -> m a
+    -- | Fail with a message.  This operation is not part of the
+    -- mathematical definition of a monad, but is invoked on pattern-match
+    -- failure in a @do@ expression.
+    fail        :: String -> m a
+
+    {-# INLINE (>>) #-}
+    m >> k      = m >>= \_ -> k
+    fail s      = error s
+
+instance Functor ((->) r) where
+    fmap = (.)
+
+instance Monad ((->) r) where
+    return = const
+    f >>= k = \ r -> k (f r) r
+
+instance Functor ((,) a) where
+    fmap f (x,y) = (x, f y)
+\end{code}
+
+
+%*********************************************************
+%*                                                      *
+\subsection{The list type}
+%*                                                      *
+%*********************************************************
+
+\begin{code}
+instance Functor [] where
+    fmap = map
+
+instance  Monad []  where
+    m >>= k             = foldr ((++) . k) [] m
+    m >> k              = foldr ((++) . (\ _ -> k)) [] m
+    return x            = [x]
+    fail _              = []
+\end{code}
+
+A few list functions that appear here because they are used here.
+The rest of the prelude list functions are in GHC.List.
+
+----------------------------------------------
+--      foldr/build/augment
+----------------------------------------------
+
+\begin{code}
+-- | 'foldr', applied to a binary operator, a starting value (typically
+-- the right-identity of the operator), and a list, reduces the list
+-- using the binary operator, from right to left:
+--
+-- > foldr f z [x1, x2, ..., xn] == x1 `f` (x2 `f` ... (xn `f` z)...)
+
+foldr            :: (a -> b -> b) -> b -> [a] -> b
+-- foldr _ z []     =  z
+-- foldr f z (x:xs) =  f x (foldr f z xs)
+{-# INLINE [0] foldr #-}
+-- Inline only in the final stage, after the foldr/cons rule has had a chance
+-- Also note that we inline it when it has *two* parameters, which are the
+-- ones we are keen about specialising!
+foldr k z = go
+          where
+            go []     = z
+            go (y:ys) = y `k` go ys
+
+-- | A list producer that can be fused with 'foldr'.
+-- This function is merely
+--
+-- >    build g = g (:) []
+--
+-- but GHC's simplifier will transform an expression of the form
+-- @'foldr' k z ('build' g)@, which may arise after inlining, to @g k z@,
+-- which avoids producing an intermediate list.
+
+build   :: forall a. (forall b. (a -> b -> b) -> b -> b) -> [a]
+{-# INLINE [1] build #-}
+        -- The INLINE is important, even though build is tiny,
+        -- because it prevents [] getting inlined in the version that
+        -- appears in the interface file.  If [] *is* inlined, it
+        -- won't match with [] appearing in rules in an importing module.
+        --
+        -- The "1" says to inline in phase 1
+
+build g = g (:) []
+
+-- | A list producer that can be fused with 'foldr'.
+-- This function is merely
+--
+-- >    augment g xs = g (:) xs
+--
+-- but GHC's simplifier will transform an expression of the form
+-- @'foldr' k z ('augment' g xs)@, which may arise after inlining, to
+-- @g k ('foldr' k z xs)@, which avoids producing an intermediate list.
+
+augment :: forall a. (forall b. (a->b->b) -> b -> b) -> [a] -> [a]
+{-# INLINE [1] augment #-}
+augment g xs = g (:) xs
+
+{-# RULES
+"fold/build"    forall k z (g::forall b. (a->b->b) -> b -> b) .
+                foldr k z (build g) = g k z
+
+"foldr/augment" forall k z xs (g::forall b. (a->b->b) -> b -> b) .
+                foldr k z (augment g xs) = g k (foldr k z xs)
+
+"foldr/id"                        foldr (:) [] = \x  -> x
+"foldr/app"     [1] forall ys. foldr (:) ys = \xs -> xs ++ ys
+        -- Only activate this from phase 1, because that's
+        -- when we disable the rule that expands (++) into foldr
+
+-- The foldr/cons rule looks nice, but it can give disastrously
+-- bloated code when commpiling
+--      array (a,b) [(1,2), (2,2), (3,2), ...very long list... ]
+-- i.e. when there are very very long literal lists
+-- So I've disabled it for now. We could have special cases
+-- for short lists, I suppose.
+-- "foldr/cons" forall k z x xs. foldr k z (x:xs) = k x (foldr k z xs)
+
+"foldr/single"  forall k z x. foldr k z [x] = k x z
+"foldr/nil"     forall k z.   foldr k z []  = z
+
+"augment/build" forall (g::forall b. (a->b->b) -> b -> b)
+                       (h::forall b. (a->b->b) -> b -> b) .
+                       augment g (build h) = build (\c n -> g c (h c n))
+"augment/nil"   forall (g::forall b. (a->b->b) -> b -> b) .
+                        augment g [] = build g
+ #-}
+
+-- This rule is true, but not (I think) useful:
+--      augment g (augment h t) = augment (\cn -> g c (h c n)) t
+\end{code}
+
+
+----------------------------------------------
+--              map
+----------------------------------------------
+
+\begin{code}
+-- | 'map' @f xs@ is the list obtained by applying @f@ to each element
+-- of @xs@, i.e.,
+--
+-- > map f [x1, x2, ..., xn] == [f x1, f x2, ..., f xn]
+-- > map f [x1, x2, ...] == [f x1, f x2, ...]
+
+map :: (a -> b) -> [a] -> [b]
+{-# NOINLINE [1] map #-}    -- We want the RULE to fire first.
+                            -- It's recursive, so won't inline anyway,
+                            -- but saying so is more explicit
+map _ []     = []
+map f (x:xs) = f x : map f xs
+
+-- Note eta expanded
+mapFB ::  (elt -> lst -> lst) -> (a -> elt) -> a -> lst -> lst
+{-# INLINE [0] mapFB #-}
+mapFB c f = \x ys -> c (f x) ys
+
+-- The rules for map work like this.
+--
+-- Up to (but not including) phase 1, we use the "map" rule to
+-- rewrite all saturated applications of map with its build/fold
+-- form, hoping for fusion to happen.
+-- In phase 1 and 0, we switch off that rule, inline build, and
+-- switch on the "mapList" rule, which rewrites the foldr/mapFB
+-- thing back into plain map.
+--
+-- It's important that these two rules aren't both active at once
+-- (along with build's unfolding) else we'd get an infinite loop
+-- in the rules.  Hence the activation control below.
+--
+-- The "mapFB" rule optimises compositions of map.
+--
+-- This same pattern is followed by many other functions:
+-- e.g. append, filter, iterate, repeat, etc.
+
+{-# RULES
+"map"       [~1] forall f xs.   map f xs                = build (\c n -> foldr (mapFB c f) n xs)
+"mapList"   [1]  forall f.      foldr (mapFB (:) f) []  = map f
+"mapFB"     forall c f g.       mapFB (mapFB c f) g     = mapFB c (f.g)
+  #-}
+
+-- There's also a rule for Map and Data.Coerce. See "Safe Coercions",
+-- section 6.4:
+--
+--   http://research.microsoft.com/en-us/um/people/simonpj/papers/ext-f/coercible.pdf
+
+{-# RULES "map/coerce" [1] map coerce = coerce #-}
+
+\end{code}
+
+
+----------------------------------------------
+--              append
+----------------------------------------------
+\begin{code}
+-- | Append two lists, i.e.,
+--
+-- > [x1, ..., xm] ++ [y1, ..., yn] == [x1, ..., xm, y1, ..., yn]
+-- > [x1, ..., xm] ++ [y1, ...] == [x1, ..., xm, y1, ...]
+--
+-- If the first list is not finite, the result is the first list.
+
+(++) :: [a] -> [a] -> [a]
+{-# NOINLINE [1] (++) #-}    -- We want the RULE to fire first.
+                             -- It's recursive, so won't inline anyway,
+                             -- but saying so is more explicit
+(++) []     ys = ys
+(++) (x:xs) ys = x : xs ++ ys
+
+{-# RULES
+"++"    [~1] forall xs ys. xs ++ ys = augment (\c n -> foldr c n xs) ys
+  #-}
+
+\end{code}
+
+
+%*********************************************************
+%*                                                      *
+\subsection{Type @Bool@}
+%*                                                      *
+%*********************************************************
+
+\begin{code}
+-- |'otherwise' is defined as the value 'True'.  It helps to make
+-- guards more readable.  eg.
+--
+-- >  f x | x < 0     = ...
+-- >      | otherwise = ...
+otherwise               :: Bool
+otherwise               =  True
+\end{code}
+
+%*********************************************************
+%*                                                      *
+\subsection{Type @Char@ and @String@}
+%*                                                      *
+%*********************************************************
+
+\begin{code}
+-- | A 'String' is a list of characters.  String constants in Haskell are values
+-- of type 'String'.
+--
+type String = [Char]
+
+unsafeChr :: Int -> Char
+unsafeChr (I# i#) = C# (chr# i#)
+
+-- | The 'Prelude.fromEnum' method restricted to the type 'Data.Char.Char'.
+ord :: Char -> Int
+ord (C# c#) = I# (ord# c#)
+\end{code}
+
+String equality is used when desugaring pattern-matches against strings.
+
+\begin{code}
+eqString :: String -> String -> Bool
+eqString []       []       = True
+eqString (c1:cs1) (c2:cs2) = c1 == c2 && cs1 `eqString` cs2
+eqString _        _        = False
+
+{-# RULES "eqString" (==) = eqString #-}
+-- eqString also has a BuiltInRule in PrelRules.lhs:
+--      eqString (unpackCString# (Lit s1)) (unpackCString# (Lit s2) = s1==s2
+\end{code}
+
+
+%*********************************************************
+%*                                                      *
+\subsection{Type @Int@}
+%*                                                      *
+%*********************************************************
+
+\begin{code}
+maxInt, minInt :: Int
+
+{- Seems clumsy. Should perhaps put minInt and MaxInt directly into MachDeps.h -}
+#if WORD_SIZE_IN_BITS == 31
+minInt  = I# (-0x40000000#)
+maxInt  = I# 0x3FFFFFFF#
+#elif WORD_SIZE_IN_BITS == 32
+minInt  = I# (-0x80000000#)
+maxInt  = I# 0x7FFFFFFF#
+#else
+minInt  = I# (-0x8000000000000000#)
+maxInt  = I# 0x7FFFFFFFFFFFFFFF#
+#endif
+\end{code}
+
+
+%*********************************************************
+%*                                                      *
+\subsection{The function type}
+%*                                                      *
+%*********************************************************
+
+\begin{code}
+-- | Identity function.
+id                      :: a -> a
+id x                    =  x
+
+-- Assertion function.  This simply ignores its boolean argument.
+-- The compiler may rewrite it to @('assertError' line)@.
+
+-- | If the first argument evaluates to 'True', then the result is the
+-- second argument.  Otherwise an 'AssertionFailed' exception is raised,
+-- containing a 'String' with the source file and line number of the
+-- call to 'assert'.
+--
+-- Assertions can normally be turned on or off with a compiler flag
+-- (for GHC, assertions are normally on unless optimisation is turned on
+-- with @-O@ or the @-fignore-asserts@
+-- option is given).  When assertions are turned off, the first
+-- argument to 'assert' is ignored, and the second argument is
+-- returned as the result.
+
+--      SLPJ: in 5.04 etc 'assert' is in GHC.Prim,
+--      but from Template Haskell onwards it's simply
+--      defined here in Base.lhs
+assert :: Bool -> a -> a
+assert _pred r = r
+
+breakpoint :: a -> a
+breakpoint r = r
+
+breakpointCond :: Bool -> a -> a
+breakpointCond _ r = r
+
+data Opaque = forall a. O a
+
+-- | Constant function.
+const                   :: a -> b -> a
+const x _               =  x
+
+-- | Function composition.
+{-# INLINE (.) #-}
+-- Make sure it has TWO args only on the left, so that it inlines
+-- when applied to two functions, even if there is no final argument
+(.)    :: (b -> c) -> (a -> b) -> a -> c
+(.) f g = \x -> f (g x)
+
+-- | @'flip' f@ takes its (first) two arguments in the reverse order of @f@.
+flip                    :: (a -> b -> c) -> b -> a -> c
+flip f x y              =  f y x
+
+-- | Application operator.  This operator is redundant, since ordinary
+-- application @(f x)@ means the same as @(f '$' x)@. However, '$' has
+-- low, right-associative binding precedence, so it sometimes allows
+-- parentheses to be omitted; for example:
+--
+-- >     f $ g $ h x  =  f (g (h x))
+--
+-- It is also useful in higher-order situations, such as @'map' ('$' 0) xs@,
+-- or @'Data.List.zipWith' ('$') fs xs@.
+{-# INLINE ($) #-}
+($)                     :: (a -> b) -> a -> b
+f $ x                   =  f x
+
+-- | @'until' p f@ yields the result of applying @f@ until @p@ holds.
+until                   :: (a -> Bool) -> (a -> a) -> a -> a
+until p f = go
+  where
+    go x | p x          = x
+         | otherwise    = go (f x)
+
+-- | 'asTypeOf' is a type-restricted version of 'const'.  It is usually
+-- used as an infix operator, and its typing forces its first argument
+-- (which is usually overloaded) to have the same type as the second.
+asTypeOf                :: a -> a -> a
+asTypeOf                =  const
+\end{code}
+
+%*********************************************************
+%*                                                      *
+\subsection{@Functor@ and @Monad@ instances for @IO@}
+%*                                                      *
+%*********************************************************
+
+\begin{code}
+instance  Functor IO where
+   fmap f x = x >>= (return . f)
+
+instance  Monad IO  where
+    {-# INLINE return #-}
+    {-# INLINE (>>)   #-}
+    {-# INLINE (>>=)  #-}
+    m >> k    = m >>= \ _ -> k
+    return    = returnIO
+    (>>=)     = bindIO
+    fail s    = failIO s
+
+returnIO :: a -> IO a
+returnIO x = IO $ \ s -> (# s, x #)
+
+bindIO :: IO a -> (a -> IO b) -> IO b
+bindIO (IO m) k = IO $ \ s -> case m s of (# new_s, a #) -> unIO (k a) new_s
+
+thenIO :: IO a -> IO b -> IO b
+thenIO (IO m) k = IO $ \ s -> case m s of (# new_s, _ #) -> unIO k new_s
+
+unIO :: IO a -> (State# RealWorld -> (# State# RealWorld, a #))
+unIO (IO a) = a
+\end{code}
+
+%*********************************************************
+%*                                                      *
+\subsection{@getTag@}
+%*                                                      *
+%*********************************************************
+
+Returns the 'tag' of a constructor application; this function is used
+by the deriving code for Eq, Ord and Enum.
+
+The primitive dataToTag# requires an evaluated constructor application
+as its argument, so we provide getTag as a wrapper that performs the
+evaluation before calling dataToTag#.  We could have dataToTag#
+evaluate its argument, but we prefer to do it this way because (a)
+dataToTag# can be an inline primop if it doesn't need to do any
+evaluation, and (b) we want to expose the evaluation to the
+simplifier, because it might be possible to eliminate the evaluation
+in the case when the argument is already known to be evaluated.
+
+\begin{code}
+{-# INLINE getTag #-}
+getTag :: a -> Int#
+getTag x = x `seq` dataToTag# x
+\end{code}
+
+%*********************************************************
+%*                                                      *
+\subsection{Numeric primops}
+%*                                                      *
+%*********************************************************
+
+Definitions of the boxed PrimOps; these will be
+used in the case of partial applications, etc.
+
+\begin{code}
+{-# INLINE quotInt #-}
+{-# INLINE remInt #-}
+
+quotInt, remInt, divInt, modInt :: Int -> Int -> Int
+(I# x) `quotInt`  (I# y) = I# (x `quotInt#` y)
+(I# x) `remInt`   (I# y) = I# (x `remInt#`  y)
+(I# x) `divInt`   (I# y) = I# (x `divInt#`  y)
+(I# x) `modInt`   (I# y) = I# (x `modInt#`  y)
+
+quotRemInt :: Int -> Int -> (Int, Int)
+(I# x) `quotRemInt` (I# y) = case x `quotRemInt#` y of
+                             (# q, r #) ->
+                                 (I# q, I# r)
+
+divModInt :: Int -> Int -> (Int, Int)
+(I# x) `divModInt` (I# y) = case x `divModInt#` y of
+                            (# q, r #) -> (I# q, I# r)
+
+divModInt# :: Int# -> Int# -> (# Int#, Int# #)
+x# `divModInt#` y#
+ | isTrue# (x# ># 0#) && isTrue# (y# <# 0#) =
+                                    case (x# -# 1#) `quotRemInt#` y# of
+                                      (# q, r #) -> (# q -# 1#, r +# y# +# 1# #)
+ | isTrue# (x# <# 0#) && isTrue# (y# ># 0#) =
+                                    case (x# +# 1#) `quotRemInt#` y# of
+                                      (# q, r #) -> (# q -# 1#, r +# y# -# 1# #)
+ | otherwise                                =
+                                    x# `quotRemInt#` y#
+
+-- Wrappers for the shift operations.  The uncheckedShift# family are
+-- undefined when the amount being shifted by is greater than the size
+-- in bits of Int#, so these wrappers perform a check and return
+-- either zero or -1 appropriately.
+--
+-- Note that these wrappers still produce undefined results when the
+-- second argument (the shift amount) is negative.
+
+-- | Shift the argument left by the specified number of bits
+-- (which must be non-negative).
+shiftL# :: Word# -> Int# -> Word#
+a `shiftL#` b   | isTrue# (b >=# WORD_SIZE_IN_BITS#) = 0##
+                | otherwise                          = a `uncheckedShiftL#` b
+
+-- | Shift the argument right by the specified number of bits
+-- (which must be non-negative).
+-- The "RL" means "right, logical" (as opposed to RA for arithmetic)
+-- (although an arithmetic right shift wouldn't make sense for Word#)
+shiftRL# :: Word# -> Int# -> Word#
+a `shiftRL#` b  | isTrue# (b >=# WORD_SIZE_IN_BITS#) = 0##
+                | otherwise                          = a `uncheckedShiftRL#` b
+
+-- | Shift the argument left by the specified number of bits
+-- (which must be non-negative).
+iShiftL# :: Int# -> Int# -> Int#
+a `iShiftL#` b  | isTrue# (b >=# WORD_SIZE_IN_BITS#) = 0#
+                | otherwise                          = a `uncheckedIShiftL#` b
+
+-- | Shift the argument right (signed) by the specified number of bits
+-- (which must be non-negative).
+-- The "RA" means "right, arithmetic" (as opposed to RL for logical)
+iShiftRA# :: Int# -> Int# -> Int#
+a `iShiftRA#` b | isTrue# (b >=# WORD_SIZE_IN_BITS#) = if isTrue# (a <# 0#)
+                                                          then (-1#)
+                                                          else 0#
+                | otherwise                          = a `uncheckedIShiftRA#` b
+
+-- | Shift the argument right (unsigned) by the specified number of bits
+-- (which must be non-negative).
+-- The "RL" means "right, logical" (as opposed to RA for arithmetic)
+iShiftRL# :: Int# -> Int# -> Int#
+a `iShiftRL#` b | isTrue# (b >=# WORD_SIZE_IN_BITS#) = 0#
+                | otherwise                          = a `uncheckedIShiftRL#` b
+
+-- Rules for C strings (the functions themselves are now in GHC.CString)
+{-# RULES
+"unpack"       [~1] forall a   . unpackCString# a             = build (unpackFoldrCString# a)
+"unpack-list"  [1]  forall a   . unpackFoldrCString# a (:) [] = unpackCString# a
+"unpack-append"     forall a n . unpackFoldrCString# a (:) n  = unpackAppendCString# a n
+
+-- There's a built-in rule (in PrelRules.lhs) for
+--      unpackFoldr "foo" c (unpackFoldr "baz" c n)  =  unpackFoldr "foobaz" c n
+
+  #-}
+\end{code}
+
+
+#ifdef __HADDOCK__
+\begin{code}
+-- | A special argument for the 'Control.Monad.ST.ST' type constructor,
+-- indexing a state embedded in the 'Prelude.IO' monad by
+-- 'Control.Monad.ST.stToIO'.
+data RealWorld
+\end{code}
+#endif
diff --git a/libraries/base/GHC/Char.hs b/libraries/base/GHC/Char.hs
new file mode 100644
index 000000000000..2db18c6c1d52
--- /dev/null
+++ b/libraries/base/GHC/Char.hs
@@ -0,0 +1,15 @@
+
+{-# LANGUAGE NoImplicitPrelude, MagicHash #-}
+
+module GHC.Char (chr) where
+
+import GHC.Base
+import GHC.Show
+
+-- | The 'Prelude.toEnum' method restricted to the type 'Data.Char.Char'.
+chr :: Int -> Char
+chr i@(I# i#)
+ | isTrue# (int2Word# i# `leWord#` 0x10FFFF##) = C# (chr# i#)
+ | otherwise
+    = error ("Prelude.chr: bad argument: " ++ showSignedInt (I# 9#) i "")
+
diff --git a/libraries/base/GHC/Conc.lhs b/libraries/base/GHC/Conc.lhs
new file mode 100644
index 000000000000..1ba17f29120d
--- /dev/null
+++ b/libraries/base/GHC/Conc.lhs
@@ -0,0 +1,116 @@
+\begin{code}
+{-# LANGUAGE Unsafe #-}
+{-# LANGUAGE CPP, NoImplicitPrelude #-}
+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
+{-# OPTIONS_HADDOCK not-home #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.Conc
+-- Copyright   :  (c) The University of Glasgow, 1994-2002
+-- License     :  see libraries/base/LICENSE
+-- 
+-- Maintainer  :  cvs-ghc@haskell.org
+-- Stability   :  internal
+-- Portability :  non-portable (GHC extensions)
+--
+-- Basic concurrency stuff.
+-- 
+-----------------------------------------------------------------------------
+
+-- No: #hide, because bits of this module are exposed by the stm package.
+-- However, we don't want this module to be the home location for the
+-- bits it exports, we'd rather have Control.Concurrent and the other
+-- higher level modules be the home.  Hence: #not-home
+
+module GHC.Conc
+        ( ThreadId(..)
+
+        -- * Forking and suchlike
+        , forkIO
+        , forkIOWithUnmask
+        , forkOn
+        , forkOnWithUnmask
+        , numCapabilities
+        , getNumCapabilities
+        , setNumCapabilities
+        , getNumProcessors
+        , numSparks
+        , childHandler
+        , myThreadId
+        , killThread
+        , throwTo
+        , par
+        , pseq
+        , runSparks
+        , yield
+        , labelThread
+        , mkWeakThreadId
+
+        , ThreadStatus(..), BlockReason(..)
+        , threadStatus
+        , threadCapability
+
+        -- * Waiting
+        , threadDelay
+        , registerDelay
+        , threadWaitRead
+        , threadWaitWrite
+        , threadWaitReadSTM
+        , threadWaitWriteSTM
+        , closeFdWith
+
+        -- * TVars
+        , STM(..)
+        , atomically
+        , retry
+        , orElse
+        , throwSTM
+        , catchSTM
+        , alwaysSucceeds
+        , always
+        , TVar(..)
+        , newTVar
+        , newTVarIO
+        , readTVar
+        , readTVarIO
+        , writeTVar
+        , unsafeIOToSTM
+
+        -- * Miscellaneous
+        , withMVar
+#ifdef mingw32_HOST_OS
+        , asyncRead
+        , asyncWrite
+        , asyncDoProc
+
+        , asyncReadBA
+        , asyncWriteBA
+#endif
+
+#ifndef mingw32_HOST_OS
+        , Signal, HandlerFun, setHandler, runHandlers
+#endif
+
+        , ensureIOManagerIsRunning
+        , ioManagerCapabilitiesChanged
+
+#ifdef mingw32_HOST_OS
+        , ConsoleEvent(..)
+        , win32ConsoleHandler
+        , toWin32ConsoleEvent
+#endif
+        , setUncaughtExceptionHandler
+        , getUncaughtExceptionHandler
+
+        , reportError, reportStackOverflow
+        ) where
+
+import GHC.Conc.IO
+import GHC.Conc.Sync
+
+#ifndef mingw32_HOST_OS
+import GHC.Conc.Signal
+#endif
+
+\end{code}
diff --git a/libraries/base/GHC/Conc/IO.hs b/libraries/base/GHC/Conc/IO.hs
new file mode 100644
index 000000000000..3a57c9336995
--- /dev/null
+++ b/libraries/base/GHC/Conc/IO.hs
@@ -0,0 +1,203 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE CPP
+           , NoImplicitPrelude
+           , MagicHash
+           , UnboxedTuples
+  #-}
+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
+{-# OPTIONS_HADDOCK not-home #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.Conc.IO
+-- Copyright   :  (c) The University of Glasgow, 1994-2002
+-- License     :  see libraries/base/LICENSE
+--
+-- Maintainer  :  cvs-ghc@haskell.org
+-- Stability   :  internal
+-- Portability :  non-portable (GHC extensions)
+--
+-- Basic concurrency stuff.
+--
+-----------------------------------------------------------------------------
+
+-- No: #hide, because bits of this module are exposed by the stm package.
+-- However, we don't want this module to be the home location for the
+-- bits it exports, we'd rather have Control.Concurrent and the other
+-- higher level modules be the home.  Hence: #not-home
+
+module GHC.Conc.IO
+        ( ensureIOManagerIsRunning
+        , ioManagerCapabilitiesChanged
+
+        -- * Waiting
+        , threadDelay
+        , registerDelay
+        , threadWaitRead
+        , threadWaitWrite
+        , threadWaitReadSTM
+        , threadWaitWriteSTM
+        , closeFdWith
+
+#ifdef mingw32_HOST_OS
+        , asyncRead
+        , asyncWrite
+        , asyncDoProc
+
+        , asyncReadBA
+        , asyncWriteBA
+
+        , ConsoleEvent(..)
+        , win32ConsoleHandler
+        , toWin32ConsoleEvent
+#endif
+        ) where
+
+import Foreign
+import GHC.Base
+import GHC.Conc.Sync as Sync
+import GHC.Real ( fromIntegral )
+import System.Posix.Types
+
+#ifdef mingw32_HOST_OS
+import qualified GHC.Conc.Windows as Windows
+import GHC.Conc.Windows (asyncRead, asyncWrite, asyncDoProc, asyncReadBA,
+                         asyncWriteBA, ConsoleEvent(..), win32ConsoleHandler,
+                         toWin32ConsoleEvent)
+#else
+import qualified GHC.Event.Thread as Event
+#endif
+
+ensureIOManagerIsRunning :: IO ()
+#ifndef mingw32_HOST_OS
+ensureIOManagerIsRunning = Event.ensureIOManagerIsRunning
+#else
+ensureIOManagerIsRunning = Windows.ensureIOManagerIsRunning
+#endif
+
+ioManagerCapabilitiesChanged :: IO ()
+#ifndef mingw32_HOST_OS
+ioManagerCapabilitiesChanged = Event.ioManagerCapabilitiesChanged
+#else
+ioManagerCapabilitiesChanged = return ()
+#endif
+
+-- | Block the current thread until data is available to read on the
+-- given file descriptor (GHC only).
+--
+-- This will throw an 'IOError' if the file descriptor was closed
+-- while this thread was blocked.  To safely close a file descriptor
+-- that has been used with 'threadWaitRead', use 'closeFdWith'.
+threadWaitRead :: Fd -> IO ()
+threadWaitRead fd
+#ifndef mingw32_HOST_OS
+  | threaded  = Event.threadWaitRead fd
+#endif
+  | otherwise = IO $ \s ->
+        case fromIntegral fd of { I# fd# ->
+        case waitRead# fd# s of { s' -> (# s', () #)
+        }}
+
+-- | Block the current thread until data can be written to the
+-- given file descriptor (GHC only).
+--
+-- This will throw an 'IOError' if the file descriptor was closed
+-- while this thread was blocked.  To safely close a file descriptor
+-- that has been used with 'threadWaitWrite', use 'closeFdWith'.
+threadWaitWrite :: Fd -> IO ()
+threadWaitWrite fd
+#ifndef mingw32_HOST_OS
+  | threaded  = Event.threadWaitWrite fd
+#endif
+  | otherwise = IO $ \s ->
+        case fromIntegral fd of { I# fd# ->
+        case waitWrite# fd# s of { s' -> (# s', () #)
+        }}
+
+-- | Returns an STM action that can be used to wait for data
+-- to read from a file descriptor. The second returned value
+-- is an IO action that can be used to deregister interest
+-- in the file descriptor.
+threadWaitReadSTM :: Fd -> IO (Sync.STM (), IO ())
+threadWaitReadSTM fd 
+#ifndef mingw32_HOST_OS
+  | threaded  = Event.threadWaitReadSTM fd
+#endif
+  | otherwise = do
+      m <- Sync.newTVarIO False
+      _ <- Sync.forkIO $ do
+        threadWaitRead fd
+        Sync.atomically $ Sync.writeTVar m True
+      let waitAction = do b <- Sync.readTVar m
+                          if b then return () else retry
+      let killAction = return ()
+      return (waitAction, killAction)
+
+-- | Returns an STM action that can be used to wait until data
+-- can be written to a file descriptor. The second returned value
+-- is an IO action that can be used to deregister interest
+-- in the file descriptor.
+threadWaitWriteSTM :: Fd -> IO (Sync.STM (), IO ())
+threadWaitWriteSTM fd 
+#ifndef mingw32_HOST_OS
+  | threaded  = Event.threadWaitWriteSTM fd
+#endif
+  | otherwise = do
+      m <- Sync.newTVarIO False
+      _ <- Sync.forkIO $ do
+        threadWaitWrite fd
+        Sync.atomically $ Sync.writeTVar m True
+      let waitAction = do b <- Sync.readTVar m
+                          if b then return () else retry
+      let killAction = return ()
+      return (waitAction, killAction)
+
+-- | Close a file descriptor in a concurrency-safe way (GHC only).  If
+-- you are using 'threadWaitRead' or 'threadWaitWrite' to perform
+-- blocking I\/O, you /must/ use this function to close file
+-- descriptors, or blocked threads may not be woken.
+--
+-- Any threads that are blocked on the file descriptor via
+-- 'threadWaitRead' or 'threadWaitWrite' will be unblocked by having
+-- IO exceptions thrown.
+closeFdWith :: (Fd -> IO ()) -- ^ Low-level action that performs the real close.
+            -> Fd            -- ^ File descriptor to close.
+            -> IO ()
+closeFdWith close fd
+#ifndef mingw32_HOST_OS
+  | threaded  = Event.closeFdWith close fd
+#endif
+  | otherwise = close fd
+
+-- | Suspends the current thread for a given number of microseconds
+-- (GHC only).
+--
+-- There is no guarantee that the thread will be rescheduled promptly
+-- when the delay has expired, but the thread will never continue to
+-- run /earlier/ than specified.
+--
+threadDelay :: Int -> IO ()
+threadDelay time
+#ifdef mingw32_HOST_OS
+  | threaded  = Windows.threadDelay time
+#else
+  | threaded  = Event.threadDelay time
+#endif
+  | otherwise = IO $ \s ->
+        case time of { I# time# ->
+        case delay# time# s of { s' -> (# s', () #)
+        }}
+
+-- | Set the value of returned TVar to True after a given number of
+-- microseconds. The caveats associated with threadDelay also apply.
+--
+registerDelay :: Int -> IO (TVar Bool)
+registerDelay usecs
+#ifdef mingw32_HOST_OS
+  | threaded = Windows.registerDelay usecs
+#else
+  | threaded = Event.registerDelay usecs
+#endif
+  | otherwise = error "registerDelay: requires -threaded"
+
+foreign import ccall unsafe "rtsSupportsBoundThreads" threaded :: Bool
diff --git a/libraries/base/GHC/Conc/Signal.hs b/libraries/base/GHC/Conc/Signal.hs
new file mode 100644
index 000000000000..2d704191451f
--- /dev/null
+++ b/libraries/base/GHC/Conc/Signal.hs
@@ -0,0 +1,91 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+
+module GHC.Conc.Signal
+        ( Signal
+        , HandlerFun
+        , setHandler
+        , runHandlers
+        ) where
+
+import Control.Concurrent.MVar (MVar, newMVar, withMVar)
+import Data.Dynamic (Dynamic)
+import Data.Maybe (Maybe(..))
+import Foreign.C.Types (CInt)
+import Foreign.ForeignPtr (ForeignPtr)
+import Foreign.StablePtr (castPtrToStablePtr, castStablePtrToPtr,
+                          deRefStablePtr, freeStablePtr, newStablePtr)
+import Foreign.Ptr (Ptr, castPtr)
+import GHC.Arr (inRange)
+import GHC.Base
+import GHC.Conc.Sync (forkIO)
+import GHC.IO (mask_, unsafePerformIO)
+import GHC.IOArray (IOArray, boundsIOArray, newIOArray,
+                    unsafeReadIOArray, unsafeWriteIOArray)
+import GHC.Real (fromIntegral)
+import GHC.Word (Word8)
+
+------------------------------------------------------------------------
+-- Signal handling
+
+type Signal = CInt
+
+maxSig :: Int
+maxSig = 64
+
+type HandlerFun = ForeignPtr Word8 -> IO ()
+
+-- Lock used to protect concurrent access to signal_handlers.  Symptom
+-- of this race condition is GHC bug #1922, although that bug was on
+-- Windows a similar bug also exists on Unix.
+signal_handlers :: MVar (IOArray Int (Maybe (HandlerFun,Dynamic)))
+signal_handlers = unsafePerformIO $ do
+  arr <- newIOArray (0, maxSig) Nothing
+  m <- newMVar arr
+  sharedCAF m getOrSetGHCConcSignalSignalHandlerStore
+{-# NOINLINE signal_handlers #-}
+
+foreign import ccall unsafe "getOrSetGHCConcSignalSignalHandlerStore"
+  getOrSetGHCConcSignalSignalHandlerStore :: Ptr a -> IO (Ptr a)
+
+setHandler :: Signal -> Maybe (HandlerFun, Dynamic)
+           -> IO (Maybe (HandlerFun, Dynamic))
+setHandler sig handler = do
+  let int = fromIntegral sig
+  withMVar signal_handlers $ \arr ->
+    if not (inRange (boundsIOArray arr) int)
+      then error "GHC.Conc.setHandler: signal out of range"
+      else do old <- unsafeReadIOArray arr int
+              unsafeWriteIOArray arr int handler
+              return old
+
+runHandlers :: ForeignPtr Word8 -> Signal -> IO ()
+runHandlers p_info sig = do
+  let int = fromIntegral sig
+  withMVar signal_handlers $ \arr ->
+    if not (inRange (boundsIOArray arr) int)
+      then return ()
+      else do handler <- unsafeReadIOArray arr int
+              case handler of
+                Nothing -> return ()
+                Just (f,_)  -> do _ <- forkIO (f p_info)
+                                  return ()
+
+-- Machinery needed to ensure that we only have one copy of certain
+-- CAFs in this module even when the base package is present twice, as
+-- it is when base is dynamically loaded into GHCi.  The RTS keeps
+-- track of the single true value of the CAF, so even when the CAFs in
+-- the dynamically-loaded base package are reverted, nothing bad
+-- happens.
+--
+sharedCAF :: a -> (Ptr a -> IO (Ptr a)) -> IO a
+sharedCAF a get_or_set =
+  mask_ $ do
+    stable_ref <- newStablePtr a
+    let ref = castPtr (castStablePtrToPtr stable_ref)
+    ref2 <- get_or_set ref
+    if ref == ref2
+      then return a
+      else do freeStablePtr stable_ref
+              deRefStablePtr (castPtrToStablePtr (castPtr ref2))
+
diff --git a/libraries/base/GHC/Conc/Sync.lhs b/libraries/base/GHC/Conc/Sync.lhs
new file mode 100644
index 000000000000..bd60ebd8fc54
--- /dev/null
+++ b/libraries/base/GHC/Conc/Sync.lhs
@@ -0,0 +1,821 @@
+\begin{code}
+{-# LANGUAGE Unsafe #-}
+{-# LANGUAGE CPP
+           , NoImplicitPrelude
+           , BangPatterns
+           , MagicHash
+           , UnboxedTuples
+           , UnliftedFFITypes
+           , DeriveDataTypeable
+           , StandaloneDeriving
+           , RankNTypes
+  #-}
+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
+{-# OPTIONS_HADDOCK not-home #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.Conc.Sync
+-- Copyright   :  (c) The University of Glasgow, 1994-2002
+-- License     :  see libraries/base/LICENSE
+--
+-- Maintainer  :  cvs-ghc@haskell.org
+-- Stability   :  internal
+-- Portability :  non-portable (GHC extensions)
+--
+-- Basic concurrency stuff.
+--
+-----------------------------------------------------------------------------
+
+-- No: #hide, because bits of this module are exposed by the stm package.
+-- However, we don't want this module to be the home location for the
+-- bits it exports, we'd rather have Control.Concurrent and the other
+-- higher level modules be the home.  Hence:
+
+-- #not-home
+module GHC.Conc.Sync
+        ( ThreadId(..)
+
+        -- * Forking and suchlike
+        , forkIO
+        , forkIOWithUnmask
+        , forkOn
+        , forkOnWithUnmask
+        , numCapabilities
+        , getNumCapabilities
+        , setNumCapabilities
+        , getNumProcessors
+        , numSparks
+        , childHandler
+        , myThreadId
+        , killThread
+        , throwTo
+        , par
+        , pseq
+        , runSparks
+        , yield
+        , labelThread
+        , mkWeakThreadId
+
+        , ThreadStatus(..), BlockReason(..)
+        , threadStatus
+        , threadCapability
+
+        -- * TVars
+        , STM(..)
+        , atomically
+        , retry
+        , orElse
+        , throwSTM
+        , catchSTM
+        , alwaysSucceeds
+        , always
+        , TVar(..)
+        , newTVar
+        , newTVarIO
+        , readTVar
+        , readTVarIO
+        , writeTVar
+        , unsafeIOToSTM
+
+        -- * Miscellaneous
+        , withMVar
+        , modifyMVar_
+
+        , setUncaughtExceptionHandler
+        , getUncaughtExceptionHandler
+
+        , reportError, reportStackOverflow
+
+        , sharedCAF
+        ) where
+
+import Foreign
+import Foreign.C
+
+#ifdef mingw32_HOST_OS
+import Data.Typeable
+#endif
+
+#ifndef mingw32_HOST_OS
+import Data.Dynamic
+#endif
+import Control.Monad
+import Data.Maybe
+
+import GHC.Base
+import {-# SOURCE #-} GHC.IO.Handle ( hFlush )
+import {-# SOURCE #-} GHC.IO.Handle.FD ( stdout )
+import GHC.IO
+import GHC.IO.Encoding.UTF8
+import GHC.IO.Exception
+import GHC.Exception
+import qualified GHC.Foreign
+import GHC.IORef
+import GHC.MVar
+import GHC.Ptr
+import GHC.Real         ( fromIntegral )
+import GHC.Show         ( Show(..), showString )
+import GHC.Weak
+
+infixr 0 `par`, `pseq`
+\end{code}
+
+%************************************************************************
+%*                                                                      *
+\subsection{@ThreadId@, @par@, and @fork@}
+%*                                                                      *
+%************************************************************************
+
+\begin{code}
+data ThreadId = ThreadId ThreadId# deriving( Typeable )
+-- ToDo: data ThreadId = ThreadId (Weak ThreadId#)
+-- But since ThreadId# is unlifted, the Weak type must use open
+-- type variables.
+{- ^
+A 'ThreadId' is an abstract type representing a handle to a thread.
+'ThreadId' is an instance of 'Eq', 'Ord' and 'Show', where
+the 'Ord' instance implements an arbitrary total ordering over
+'ThreadId's. The 'Show' instance lets you convert an arbitrary-valued
+'ThreadId' to string form; showing a 'ThreadId' value is occasionally
+useful when debugging or diagnosing the behaviour of a concurrent
+program.
+
+/Note/: in GHC, if you have a 'ThreadId', you essentially have
+a pointer to the thread itself.  This means the thread itself can\'t be
+garbage collected until you drop the 'ThreadId'.
+This misfeature will hopefully be corrected at a later date.
+
+-}
+
+instance Show ThreadId where
+   showsPrec d t =
+        showString "ThreadId " .
+        showsPrec d (getThreadId (id2TSO t))
+
+foreign import ccall unsafe "rts_getThreadId" getThreadId :: ThreadId# -> CInt
+
+id2TSO :: ThreadId -> ThreadId#
+id2TSO (ThreadId t) = t
+
+foreign import ccall unsafe "cmp_thread" cmp_thread :: ThreadId# -> ThreadId# -> CInt
+-- Returns -1, 0, 1
+
+cmpThread :: ThreadId -> ThreadId -> Ordering
+cmpThread t1 t2 =
+   case cmp_thread (id2TSO t1) (id2TSO t2) of
+      -1 -> LT
+      0  -> EQ
+      _  -> GT -- must be 1
+
+instance Eq ThreadId where
+   t1 == t2 =
+      case t1 `cmpThread` t2 of
+         EQ -> True
+         _  -> False
+
+instance Ord ThreadId where
+   compare = cmpThread
+
+{- |
+Sparks off a new thread to run the 'IO' computation passed as the
+first argument, and returns the 'ThreadId' of the newly created
+thread.
+
+The new thread will be a lightweight thread; if you want to use a foreign
+library that uses thread-local storage, use 'Control.Concurrent.forkOS' instead.
+
+GHC note: the new thread inherits the /masked/ state of the parent
+(see 'Control.Exception.mask').
+
+The newly created thread has an exception handler that discards the
+exceptions 'BlockedIndefinitelyOnMVar', 'BlockedIndefinitelyOnSTM', and
+'ThreadKilled', and passes all other exceptions to the uncaught
+exception handler.
+-}
+forkIO :: IO () -> IO ThreadId
+forkIO action = IO $ \ s ->
+   case (fork# action_plus s) of (# s1, tid #) -> (# s1, ThreadId tid #)
+ where
+  action_plus = catchException action childHandler
+
+-- | Like 'forkIO', but the child thread is passed a function that can
+-- be used to unmask asynchronous exceptions.  This function is
+-- typically used in the following way
+--
+-- >  ... mask_ $ forkIOWithUnmask $ \unmask ->
+-- >                 catch (unmask ...) handler
+--
+-- so that the exception handler in the child thread is established
+-- with asynchronous exceptions masked, meanwhile the main body of
+-- the child thread is executed in the unmasked state.
+--
+-- Note that the unmask function passed to the child thread should
+-- only be used in that thread; the behaviour is undefined if it is
+-- invoked in a different thread.
+--
+-- /Since: 4.4.0.0/
+forkIOWithUnmask :: ((forall a . IO a -> IO a) -> IO ()) -> IO ThreadId
+forkIOWithUnmask io = forkIO (io unsafeUnmask)
+
+{- |
+Like 'forkIO', but lets you specify on which capability the thread
+should run.  Unlike a `forkIO` thread, a thread created by `forkOn`
+will stay on the same capability for its entire lifetime (`forkIO`
+threads can migrate between capabilities according to the scheduling
+policy).  `forkOn` is useful for overriding the scheduling policy when
+you know in advance how best to distribute the threads.
+
+The `Int` argument specifies a /capability number/ (see
+'getNumCapabilities').  Typically capabilities correspond to physical
+processors, but the exact behaviour is implementation-dependent.  The
+value passed to 'forkOn' is interpreted modulo the total number of
+capabilities as returned by 'getNumCapabilities'.
+
+GHC note: the number of capabilities is specified by the @+RTS -N@
+option when the program is started.  Capabilities can be fixed to
+actual processor cores with @+RTS -qa@ if the underlying operating
+system supports that, although in practice this is usually unnecessary
+(and may actually degrade performance in some cases - experimentation
+is recommended).
+
+/Since: 4.4.0.0/
+-}
+forkOn :: Int -> IO () -> IO ThreadId
+forkOn (I# cpu) action = IO $ \ s ->
+   case (forkOn# cpu action_plus s) of (# s1, tid #) -> (# s1, ThreadId tid #)
+ where
+  action_plus = catchException action childHandler
+
+-- | Like 'forkIOWithUnmask', but the child thread is pinned to the
+-- given CPU, as with 'forkOn'.
+--
+-- /Since: 4.4.0.0/
+forkOnWithUnmask :: Int -> ((forall a . IO a -> IO a) -> IO ()) -> IO ThreadId
+forkOnWithUnmask cpu io = forkOn cpu (io unsafeUnmask)
+
+-- | the value passed to the @+RTS -N@ flag.  This is the number of
+-- Haskell threads that can run truly simultaneously at any given
+-- time, and is typically set to the number of physical processor cores on
+-- the machine.
+--
+-- Strictly speaking it is better to use 'getNumCapabilities', because
+-- the number of capabilities might vary at runtime.
+--
+numCapabilities :: Int
+numCapabilities = unsafePerformIO $ getNumCapabilities
+
+{- |
+Returns the number of Haskell threads that can run truly
+simultaneously (on separate physical processors) at any given time.  To change
+this value, use 'setNumCapabilities'.
+
+/Since: 4.4.0.0/
+-}
+getNumCapabilities :: IO Int
+getNumCapabilities = do
+   n <- peek enabled_capabilities
+   return (fromIntegral n)
+
+{- |
+Set the number of Haskell threads that can run truly simultaneously
+(on separate physical processors) at any given time.  The number
+passed to `forkOn` is interpreted modulo this value.  The initial
+value is given by the @+RTS -N@ runtime flag.
+
+This is also the number of threads that will participate in parallel
+garbage collection.  It is strongly recommended that the number of
+capabilities is not set larger than the number of physical processor
+cores, and it may often be beneficial to leave one or more cores free
+to avoid contention with other processes in the machine.
+
+/Since: 4.5.0.0/
+-}
+setNumCapabilities :: Int -> IO ()
+setNumCapabilities i = c_setNumCapabilities (fromIntegral i)
+
+foreign import ccall safe "setNumCapabilities"
+  c_setNumCapabilities :: CUInt -> IO ()
+
+-- | Returns the number of CPUs that the machine has
+--
+-- /Since: 4.5.0.0/
+getNumProcessors :: IO Int
+getNumProcessors = fmap fromIntegral c_getNumberOfProcessors
+
+foreign import ccall unsafe "getNumberOfProcessors"
+  c_getNumberOfProcessors :: IO CUInt
+
+-- | Returns the number of sparks currently in the local spark pool
+numSparks :: IO Int
+numSparks = IO $ \s -> case numSparks# s of (# s', n #) -> (# s', I# n #)
+
+foreign import ccall "&enabled_capabilities" enabled_capabilities :: Ptr CInt
+
+childHandler :: SomeException -> IO ()
+childHandler err = catchException (real_handler err) childHandler
+
+real_handler :: SomeException -> IO ()
+real_handler se
+  | Just BlockedIndefinitelyOnMVar <- fromException se  =  return ()
+  | Just BlockedIndefinitelyOnSTM  <- fromException se  =  return ()
+  | Just ThreadKilled              <- fromException se  =  return ()
+  | Just StackOverflow             <- fromException se  =  reportStackOverflow
+  | otherwise                                           =  reportError se
+
+{- | 'killThread' raises the 'ThreadKilled' exception in the given
+thread (GHC only).
+
+> killThread tid = throwTo tid ThreadKilled
+
+-}
+killThread :: ThreadId -> IO ()
+killThread tid = throwTo tid ThreadKilled
+
+{- | 'throwTo' raises an arbitrary exception in the target thread (GHC only).
+
+Exception delivery synchronizes between the source and target thread:
+'throwTo' does not return until the exception has been raised in the
+target thread. The calling thread can thus be certain that the target
+thread has received the exception.  Exception delivery is also atomic
+with respect to other exceptions. Atomicity is a useful property to have
+when dealing with race conditions: e.g. if there are two threads that
+can kill each other, it is guaranteed that only one of the threads
+will get to kill the other.
+
+Whatever work the target thread was doing when the exception was
+raised is not lost: the computation is suspended until required by
+another thread.
+
+If the target thread is currently making a foreign call, then the
+exception will not be raised (and hence 'throwTo' will not return)
+until the call has completed.  This is the case regardless of whether
+the call is inside a 'mask' or not.  However, in GHC a foreign call
+can be annotated as @interruptible@, in which case a 'throwTo' will
+cause the RTS to attempt to cause the call to return; see the GHC
+documentation for more details.
+
+Important note: the behaviour of 'throwTo' differs from that described in
+the paper \"Asynchronous exceptions in Haskell\"
+(<http://research.microsoft.com/~simonpj/Papers/asynch-exns.htm>).
+In the paper, 'throwTo' is non-blocking; but the library implementation adopts
+a more synchronous design in which 'throwTo' does not return until the exception
+is received by the target thread.  The trade-off is discussed in Section 9 of the paper.
+Like any blocking operation, 'throwTo' is therefore interruptible (see Section 5.3 of
+the paper).  Unlike other interruptible operations, however, 'throwTo'
+is /always/ interruptible, even if it does not actually block.
+
+There is no guarantee that the exception will be delivered promptly,
+although the runtime will endeavour to ensure that arbitrary
+delays don't occur.  In GHC, an exception can only be raised when a
+thread reaches a /safe point/, where a safe point is where memory
+allocation occurs.  Some loops do not perform any memory allocation
+inside the loop and therefore cannot be interrupted by a 'throwTo'.
+
+If the target of 'throwTo' is the calling thread, then the behaviour
+is the same as 'Control.Exception.throwIO', except that the exception
+is thrown as an asynchronous exception.  This means that if there is
+an enclosing pure computation, which would be the case if the current
+IO operation is inside 'unsafePerformIO' or 'unsafeInterleaveIO', that
+computation is not permanently replaced by the exception, but is
+suspended as if it had received an asynchronous exception.
+
+Note that if 'throwTo' is called with the current thread as the
+target, the exception will be thrown even if the thread is currently
+inside 'mask' or 'uninterruptibleMask'.
+  -}
+throwTo :: Exception e => ThreadId -> e -> IO ()
+throwTo (ThreadId tid) ex = IO $ \ s ->
+   case (killThread# tid (toException ex) s) of s1 -> (# s1, () #)
+
+-- | Returns the 'ThreadId' of the calling thread (GHC only).
+myThreadId :: IO ThreadId
+myThreadId = IO $ \s ->
+   case (myThreadId# s) of (# s1, tid #) -> (# s1, ThreadId tid #)
+
+
+-- |The 'yield' action allows (forces, in a co-operative multitasking
+-- implementation) a context-switch to any other currently runnable
+-- threads (if any), and is occasionally useful when implementing
+-- concurrency abstractions.
+yield :: IO ()
+yield = IO $ \s ->
+   case (yield# s) of s1 -> (# s1, () #)
+
+{- | 'labelThread' stores a string as identifier for this thread if
+you built a RTS with debugging support. This identifier will be used in
+the debugging output to make distinction of different threads easier
+(otherwise you only have the thread state object\'s address in the heap).
+
+Other applications like the graphical Concurrent Haskell Debugger
+(<http://www.informatik.uni-kiel.de/~fhu/chd/>) may choose to overload
+'labelThread' for their purposes as well.
+-}
+
+labelThread :: ThreadId -> String -> IO ()
+labelThread (ThreadId t) str =
+    GHC.Foreign.withCString utf8 str $ \(Ptr p) ->
+    IO $ \ s ->
+     case labelThread# t p s of s1 -> (# s1, () #)
+
+--      Nota Bene: 'pseq' used to be 'seq'
+--                 but 'seq' is now defined in PrelGHC
+--
+-- "pseq" is defined a bit weirdly (see below)
+--
+-- The reason for the strange "lazy" call is that
+-- it fools the compiler into thinking that pseq  and par are non-strict in
+-- their second argument (even if it inlines pseq at the call site).
+-- If it thinks pseq is strict in "y", then it often evaluates
+-- "y" before "x", which is totally wrong.
+
+{-# INLINE pseq  #-}
+pseq :: a -> b -> b
+pseq  x y = x `seq` lazy y
+
+{-# INLINE par  #-}
+par :: a -> b -> b
+par  x y = case (par# x) of { _ -> lazy y }
+
+-- | Internal function used by the RTS to run sparks.
+runSparks :: IO ()
+runSparks = IO loop
+  where loop s = case getSpark# s of
+                   (# s', n, p #) ->
+                      if isTrue# (n ==# 0#)
+                      then (# s', () #)
+                      else p `seq` loop s'
+
+data BlockReason
+  = BlockedOnMVar
+        -- ^blocked on 'MVar'
+  {- possibly (see 'threadstatus' below):
+  | BlockedOnMVarRead
+        -- ^blocked on reading an empty 'MVar'
+  -}
+  | BlockedOnBlackHole
+        -- ^blocked on a computation in progress by another thread
+  | BlockedOnException
+        -- ^blocked in 'throwTo'
+  | BlockedOnSTM
+        -- ^blocked in 'retry' in an STM transaction
+  | BlockedOnForeignCall
+        -- ^currently in a foreign call
+  | BlockedOnOther
+        -- ^blocked on some other resource.  Without @-threaded@,
+        -- I\/O and 'threadDelay' show up as 'BlockedOnOther', with @-threaded@
+        -- they show up as 'BlockedOnMVar'.
+  deriving (Eq,Ord,Show)
+
+-- | The current status of a thread
+data ThreadStatus
+  = ThreadRunning
+        -- ^the thread is currently runnable or running
+  | ThreadFinished
+        -- ^the thread has finished
+  | ThreadBlocked  BlockReason
+        -- ^the thread is blocked on some resource
+  | ThreadDied
+        -- ^the thread received an uncaught exception
+  deriving (Eq,Ord,Show)
+
+threadStatus :: ThreadId -> IO ThreadStatus
+threadStatus (ThreadId t) = IO $ \s ->
+   case threadStatus# t s of
+    (# s', stat, _cap, _locked #) -> (# s', mk_stat (I# stat) #)
+   where
+        -- NB. keep these in sync with includes/rts/Constants.h
+     mk_stat 0  = ThreadRunning
+     mk_stat 1  = ThreadBlocked BlockedOnMVar
+     mk_stat 2  = ThreadBlocked BlockedOnBlackHole
+     mk_stat 6  = ThreadBlocked BlockedOnSTM
+     mk_stat 10 = ThreadBlocked BlockedOnForeignCall
+     mk_stat 11 = ThreadBlocked BlockedOnForeignCall
+     mk_stat 12 = ThreadBlocked BlockedOnException
+     mk_stat 14 = ThreadBlocked BlockedOnMVar -- possibly: BlockedOnMVarRead
+     -- NB. these are hardcoded in rts/PrimOps.cmm
+     mk_stat 16 = ThreadFinished
+     mk_stat 17 = ThreadDied
+     mk_stat _  = ThreadBlocked BlockedOnOther
+
+-- | returns the number of the capability on which the thread is currently
+-- running, and a boolean indicating whether the thread is locked to
+-- that capability or not.  A thread is locked to a capability if it
+-- was created with @forkOn@.
+--
+-- /Since: 4.4.0.0/
+threadCapability :: ThreadId -> IO (Int, Bool)
+threadCapability (ThreadId t) = IO $ \s ->
+   case threadStatus# t s of
+     (# s', _, cap#, locked# #) -> (# s', (I# cap#, isTrue# (locked# /=# 0#)) #)
+
+-- | make a weak pointer to a 'ThreadId'.  It can be important to do
+-- this if you want to hold a reference to a 'ThreadId' while still
+-- allowing the thread to receive the @BlockedIndefinitely@ family of
+-- exceptions (e.g. 'BlockedIndefinitelyOnMVar').  Holding a normal
+-- 'ThreadId' reference will prevent the delivery of
+-- @BlockedIndefinitely@ exceptions because the reference could be
+-- used as the target of 'throwTo' at any time, which would unblock
+-- the thread.
+--
+-- Holding a @Weak ThreadId@, on the other hand, will not prevent the
+-- thread from receiving @BlockedIndefinitely@ exceptions.  It is
+-- still possible to throw an exception to a @Weak ThreadId@, but the
+-- caller must use @deRefWeak@ first to determine whether the thread
+-- still exists.
+--
+-- /Since: 4.6.0.0/
+mkWeakThreadId :: ThreadId -> IO (Weak ThreadId)
+mkWeakThreadId t@(ThreadId t#) = IO $ \s ->
+   case mkWeakNoFinalizer# t# t s of
+      (# s1, w #) -> (# s1, Weak w #)
+\end{code}
+
+
+%************************************************************************
+%*                                                                      *
+\subsection[stm]{Transactional heap operations}
+%*                                                                      *
+%************************************************************************
+
+TVars are shared memory locations which support atomic memory
+transactions.
+
+\begin{code}
+-- |A monad supporting atomic memory transactions.
+newtype STM a = STM (State# RealWorld -> (# State# RealWorld, a #))
+                deriving Typeable
+
+unSTM :: STM a -> (State# RealWorld -> (# State# RealWorld, a #))
+unSTM (STM a) = a
+
+instance  Functor STM where
+   fmap f x = x >>= (return . f)
+
+instance  Monad STM  where
+    {-# INLINE return #-}
+    {-# INLINE (>>)   #-}
+    {-# INLINE (>>=)  #-}
+    m >> k      = thenSTM m k
+    return x    = returnSTM x
+    m >>= k     = bindSTM m k
+
+bindSTM :: STM a -> (a -> STM b) -> STM b
+bindSTM (STM m) k = STM ( \s ->
+  case m s of
+    (# new_s, a #) -> unSTM (k a) new_s
+  )
+
+thenSTM :: STM a -> STM b -> STM b
+thenSTM (STM m) k = STM ( \s ->
+  case m s of
+    (# new_s, _ #) -> unSTM k new_s
+  )
+
+returnSTM :: a -> STM a
+returnSTM x = STM (\s -> (# s, x #))
+
+instance MonadPlus STM where
+  mzero = retry
+  mplus = orElse
+
+-- | Unsafely performs IO in the STM monad.  Beware: this is a highly
+-- dangerous thing to do.
+--
+--   * The STM implementation will often run transactions multiple
+--     times, so you need to be prepared for this if your IO has any
+--     side effects.
+--
+--   * The STM implementation will abort transactions that are known to
+--     be invalid and need to be restarted.  This may happen in the middle
+--     of `unsafeIOToSTM`, so make sure you don't acquire any resources
+--     that need releasing (exception handlers are ignored when aborting
+--     the transaction).  That includes doing any IO using Handles, for
+--     example.  Getting this wrong will probably lead to random deadlocks.
+--
+--   * The transaction may have seen an inconsistent view of memory when
+--     the IO runs.  Invariants that you expect to be true throughout
+--     your program may not be true inside a transaction, due to the
+--     way transactions are implemented.  Normally this wouldn't be visible
+--     to the programmer, but using `unsafeIOToSTM` can expose it.
+--
+unsafeIOToSTM :: IO a -> STM a
+unsafeIOToSTM (IO m) = STM m
+
+-- |Perform a series of STM actions atomically.
+--
+-- You cannot use 'atomically' inside an 'unsafePerformIO' or 'unsafeInterleaveIO'.
+-- Any attempt to do so will result in a runtime error.  (Reason: allowing
+-- this would effectively allow a transaction inside a transaction, depending
+-- on exactly when the thunk is evaluated.)
+--
+-- However, see 'newTVarIO', which can be called inside 'unsafePerformIO',
+-- and which allows top-level TVars to be allocated.
+
+atomically :: STM a -> IO a
+atomically (STM m) = IO (\s -> (atomically# m) s )
+
+-- |Retry execution of the current memory transaction because it has seen
+-- values in TVars which mean that it should not continue (e.g. the TVars
+-- represent a shared buffer that is now empty).  The implementation may
+-- block the thread until one of the TVars that it has read from has been
+-- udpated. (GHC only)
+retry :: STM a
+retry = STM $ \s# -> retry# s#
+
+-- |Compose two alternative STM actions (GHC only).  If the first action
+-- completes without retrying then it forms the result of the orElse.
+-- Otherwise, if the first action retries, then the second action is
+-- tried in its place.  If both actions retry then the orElse as a
+-- whole retries.
+orElse :: STM a -> STM a -> STM a
+orElse (STM m) e = STM $ \s -> catchRetry# m (unSTM e) s
+
+-- | A variant of 'throw' that can only be used within the 'STM' monad.
+--
+-- Throwing an exception in @STM@ aborts the transaction and propagates the
+-- exception.
+--
+-- Although 'throwSTM' has a type that is an instance of the type of 'throw', the
+-- two functions are subtly different:
+--
+-- > throw e    `seq` x  ===> throw e
+-- > throwSTM e `seq` x  ===> x
+--
+-- The first example will cause the exception @e@ to be raised,
+-- whereas the second one won\'t.  In fact, 'throwSTM' will only cause
+-- an exception to be raised when it is used within the 'STM' monad.
+-- The 'throwSTM' variant should be used in preference to 'throw' to
+-- raise an exception within the 'STM' monad because it guarantees
+-- ordering with respect to other 'STM' operations, whereas 'throw'
+-- does not.
+throwSTM :: Exception e => e -> STM a
+throwSTM e = STM $ raiseIO# (toException e)
+
+-- |Exception handling within STM actions.
+catchSTM :: Exception e => STM a -> (e -> STM a) -> STM a
+catchSTM (STM m) handler = STM $ catchSTM# m handler'
+    where
+      handler' e = case fromException e of
+                     Just e' -> unSTM (handler e')
+                     Nothing -> raiseIO# e
+
+-- | Low-level primitive on which always and alwaysSucceeds are built.
+-- checkInv differs form these in that (i) the invariant is not
+-- checked when checkInv is called, only at the end of this and
+-- subsequent transcations, (ii) the invariant failure is indicated
+-- by raising an exception.
+checkInv :: STM a -> STM ()
+checkInv (STM m) = STM (\s -> (check# m) s)
+
+-- | alwaysSucceeds adds a new invariant that must be true when passed
+-- to alwaysSucceeds, at the end of the current transaction, and at
+-- the end of every subsequent transaction.  If it fails at any
+-- of those points then the transaction violating it is aborted
+-- and the exception raised by the invariant is propagated.
+alwaysSucceeds :: STM a -> STM ()
+alwaysSucceeds i = do ( i >> retry ) `orElse` ( return () )
+                      checkInv i
+
+-- | always is a variant of alwaysSucceeds in which the invariant is
+-- expressed as an STM Bool action that must return True.  Returning
+-- False or raising an exception are both treated as invariant failures.
+always :: STM Bool -> STM ()
+always i = alwaysSucceeds ( do v <- i
+                               if (v) then return () else ( error "Transactional invariant violation" ) )
+
+-- |Shared memory locations that support atomic memory transactions.
+data TVar a = TVar (TVar# RealWorld a)
+              deriving Typeable
+
+instance Eq (TVar a) where
+        (TVar tvar1#) == (TVar tvar2#) = isTrue# (sameTVar# tvar1# tvar2#)
+
+-- |Create a new TVar holding a value supplied
+newTVar :: a -> STM (TVar a)
+newTVar val = STM $ \s1# ->
+    case newTVar# val s1# of
+         (# s2#, tvar# #) -> (# s2#, TVar tvar# #)
+
+-- |@IO@ version of 'newTVar'.  This is useful for creating top-level
+-- 'TVar's using 'System.IO.Unsafe.unsafePerformIO', because using
+-- 'atomically' inside 'System.IO.Unsafe.unsafePerformIO' isn't
+-- possible.
+newTVarIO :: a -> IO (TVar a)
+newTVarIO val = IO $ \s1# ->
+    case newTVar# val s1# of
+         (# s2#, tvar# #) -> (# s2#, TVar tvar# #)
+
+-- |Return the current value stored in a TVar.
+-- This is equivalent to
+--
+-- >  readTVarIO = atomically . readTVar
+--
+-- but works much faster, because it doesn't perform a complete
+-- transaction, it just reads the current value of the 'TVar'.
+readTVarIO :: TVar a -> IO a
+readTVarIO (TVar tvar#) = IO $ \s# -> readTVarIO# tvar# s#
+
+-- |Return the current value stored in a TVar
+readTVar :: TVar a -> STM a
+readTVar (TVar tvar#) = STM $ \s# -> readTVar# tvar# s#
+
+-- |Write the supplied value into a TVar
+writeTVar :: TVar a -> a -> STM ()
+writeTVar (TVar tvar#) val = STM $ \s1# ->
+    case writeTVar# tvar# val s1# of
+         s2# -> (# s2#, () #)
+
+\end{code}
+
+MVar utilities
+
+\begin{code}
+withMVar :: MVar a -> (a -> IO b) -> IO b
+withMVar m io =
+  mask $ \restore -> do
+    a <- takeMVar m
+    b <- catchAny (restore (io a))
+            (\e -> do putMVar m a; throw e)
+    putMVar m a
+    return b
+
+modifyMVar_ :: MVar a -> (a -> IO a) -> IO ()
+modifyMVar_ m io =
+  mask $ \restore -> do
+    a <- takeMVar m
+    a' <- catchAny (restore (io a))
+            (\e -> do putMVar m a; throw e)
+    putMVar m a'
+    return ()
+\end{code}
+
+%************************************************************************
+%*                                                                      *
+\subsection{Thread waiting}
+%*                                                                      *
+%************************************************************************
+
+\begin{code}
+
+-- Machinery needed to ensureb that we only have one copy of certain
+-- CAFs in this module even when the base package is present twice, as
+-- it is when base is dynamically loaded into GHCi.  The RTS keeps
+-- track of the single true value of the CAF, so even when the CAFs in
+-- the dynamically-loaded base package are reverted, nothing bad
+-- happens.
+--
+sharedCAF :: a -> (Ptr a -> IO (Ptr a)) -> IO a
+sharedCAF a get_or_set =
+   mask_ $ do
+     stable_ref <- newStablePtr a
+     let ref = castPtr (castStablePtrToPtr stable_ref)
+     ref2 <- get_or_set ref
+     if ref==ref2
+        then return a
+        else do freeStablePtr stable_ref
+                deRefStablePtr (castPtrToStablePtr (castPtr ref2))
+
+reportStackOverflow :: IO ()
+reportStackOverflow = do
+     ThreadId tid <- myThreadId
+     callStackOverflowHook tid
+
+reportError :: SomeException -> IO ()
+reportError ex = do
+   handler <- getUncaughtExceptionHandler
+   handler ex
+
+-- SUP: Are the hooks allowed to re-enter Haskell land?  If so, remove
+-- the unsafe below.
+foreign import ccall unsafe "stackOverflow"
+        callStackOverflowHook :: ThreadId# -> IO ()
+
+{-# NOINLINE uncaughtExceptionHandler #-}
+uncaughtExceptionHandler :: IORef (SomeException -> IO ())
+uncaughtExceptionHandler = unsafePerformIO (newIORef defaultHandler)
+   where
+      defaultHandler :: SomeException -> IO ()
+      defaultHandler se@(SomeException ex) = do
+         (hFlush stdout) `catchAny` (\ _ -> return ())
+         let msg = case cast ex of
+               Just Deadlock -> "no threads to run:  infinite loop or deadlock?"
+               _ -> case cast ex of
+                    Just (ErrorCall s) -> s
+                    _                  -> showsPrec 0 se ""
+         withCString "%s" $ \cfmt ->
+          withCString msg $ \cmsg ->
+            errorBelch cfmt cmsg
+
+-- don't use errorBelch() directly, because we cannot call varargs functions
+-- using the FFI.
+foreign import ccall unsafe "HsBase.h errorBelch2"
+   errorBelch :: CString -> CString -> IO ()
+
+setUncaughtExceptionHandler :: (SomeException -> IO ()) -> IO ()
+setUncaughtExceptionHandler = writeIORef uncaughtExceptionHandler
+
+getUncaughtExceptionHandler :: IO (SomeException -> IO ())
+getUncaughtExceptionHandler = readIORef uncaughtExceptionHandler
+
+\end{code}
diff --git a/libraries/base/GHC/Conc/Windows.hs b/libraries/base/GHC/Conc/Windows.hs
new file mode 100644
index 000000000000..c01281ac689d
--- /dev/null
+++ b/libraries/base/GHC/Conc/Windows.hs
@@ -0,0 +1,340 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE CPP, NoImplicitPrelude, MagicHash, UnboxedTuples, AutoDeriveTypeable #-}
+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
+{-# OPTIONS_HADDOCK not-home #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.Conc.Windows
+-- Copyright   :  (c) The University of Glasgow, 1994-2002
+-- License     :  see libraries/base/LICENSE
+--
+-- Maintainer  :  cvs-ghc@haskell.org
+-- Stability   :  internal
+-- Portability :  non-portable (GHC extensions)
+--
+-- Windows I/O manager
+--
+-----------------------------------------------------------------------------
+
+-- #not-home
+module GHC.Conc.Windows
+       ( ensureIOManagerIsRunning
+
+       -- * Waiting
+       , threadDelay
+       , registerDelay
+
+       -- * Miscellaneous
+       , asyncRead
+       , asyncWrite
+       , asyncDoProc
+
+       , asyncReadBA
+       , asyncWriteBA
+
+       , ConsoleEvent(..)
+       , win32ConsoleHandler
+       , toWin32ConsoleEvent
+       ) where
+
+import Control.Monad
+import Data.Bits (shiftR)
+import Data.Maybe (Maybe(..))
+import Data.Typeable
+import GHC.Base
+import GHC.Conc.Sync
+import GHC.Enum (Enum)
+import GHC.IO (unsafePerformIO)
+import GHC.IORef
+import GHC.MVar
+import GHC.Num (Num(..))
+import GHC.Ptr
+import GHC.Read (Read)
+import GHC.Real (div, fromIntegral)
+import GHC.Show (Show)
+import GHC.Word (Word32, Word64)
+import GHC.Windows
+
+#ifdef mingw32_HOST_OS
+# if defined(i386_HOST_ARCH)
+#  define WINDOWS_CCONV stdcall
+# elif defined(x86_64_HOST_ARCH)
+#  define WINDOWS_CCONV ccall
+# else
+#  error Unknown mingw32 arch
+# endif
+#endif
+
+-- ----------------------------------------------------------------------------
+-- Thread waiting
+
+-- Note: threadWaitRead and threadWaitWrite aren't really functional
+-- on Win32, but left in there because lib code (still) uses them (the manner
+-- in which they're used doesn't cause problems on a Win32 platform though.)
+
+asyncRead :: Int -> Int -> Int -> Ptr a -> IO (Int, Int)
+asyncRead  (I# fd) (I# isSock) (I# len) (Ptr buf) =
+  IO $ \s -> case asyncRead# fd isSock len buf s of
+               (# s', len#, err# #) -> (# s', (I# len#, I# err#) #)
+
+asyncWrite :: Int -> Int -> Int -> Ptr a -> IO (Int, Int)
+asyncWrite  (I# fd) (I# isSock) (I# len) (Ptr buf) =
+  IO $ \s -> case asyncWrite# fd isSock len buf s of
+               (# s', len#, err# #) -> (# s', (I# len#, I# err#) #)
+
+asyncDoProc :: FunPtr (Ptr a -> IO Int) -> Ptr a -> IO Int
+asyncDoProc (FunPtr proc) (Ptr param) =
+    -- the 'length' value is ignored; simplifies implementation of
+    -- the async*# primops to have them all return the same result.
+  IO $ \s -> case asyncDoProc# proc param s  of
+               (# s', _len#, err# #) -> (# s', I# err# #)
+
+-- to aid the use of these primops by the IO Handle implementation,
+-- provide the following convenience funs:
+
+-- this better be a pinned byte array!
+asyncReadBA :: Int -> Int -> Int -> Int -> MutableByteArray# RealWorld -> IO (Int,Int)
+asyncReadBA fd isSock len off bufB =
+  asyncRead fd isSock len ((Ptr (byteArrayContents# (unsafeCoerce# bufB))) `plusPtr` off)
+
+asyncWriteBA :: Int -> Int -> Int -> Int -> MutableByteArray# RealWorld -> IO (Int,Int)
+asyncWriteBA fd isSock len off bufB =
+  asyncWrite fd isSock len ((Ptr (byteArrayContents# (unsafeCoerce# bufB))) `plusPtr` off)
+
+-- ----------------------------------------------------------------------------
+-- Threaded RTS implementation of threadDelay
+
+-- | Suspends the current thread for a given number of microseconds
+-- (GHC only).
+--
+-- There is no guarantee that the thread will be rescheduled promptly
+-- when the delay has expired, but the thread will never continue to
+-- run /earlier/ than specified.
+--
+threadDelay :: Int -> IO ()
+threadDelay time
+  | threaded  = waitForDelayEvent time
+  | otherwise = IO $ \s ->
+        case time of { I# time# ->
+        case delay# time# s of { s' -> (# s', () #)
+        }}
+
+-- | Set the value of returned TVar to True after a given number of
+-- microseconds. The caveats associated with threadDelay also apply.
+--
+registerDelay :: Int -> IO (TVar Bool)
+registerDelay usecs
+  | threaded = waitForDelayEventSTM usecs
+  | otherwise = error "registerDelay: requires -threaded"
+
+foreign import ccall unsafe "rtsSupportsBoundThreads" threaded :: Bool
+
+waitForDelayEvent :: Int -> IO ()
+waitForDelayEvent usecs = do
+  m <- newEmptyMVar
+  target <- calculateTarget usecs
+  atomicModifyIORef pendingDelays (\xs -> (Delay target m : xs, ()))
+  prodServiceThread
+  takeMVar m
+
+-- Delays for use in STM
+waitForDelayEventSTM :: Int -> IO (TVar Bool)
+waitForDelayEventSTM usecs = do
+   t <- atomically $ newTVar False
+   target <- calculateTarget usecs
+   atomicModifyIORef pendingDelays (\xs -> (DelaySTM target t : xs, ()))
+   prodServiceThread
+   return t
+
+calculateTarget :: Int -> IO USecs
+calculateTarget usecs = do
+    now <- getMonotonicUSec
+    return $ now + (fromIntegral usecs)
+
+data DelayReq
+  = Delay    {-# UNPACK #-} !USecs {-# UNPACK #-} !(MVar ())
+  | DelaySTM {-# UNPACK #-} !USecs {-# UNPACK #-} !(TVar Bool)
+
+{-# NOINLINE pendingDelays #-}
+pendingDelays :: IORef [DelayReq]
+pendingDelays = unsafePerformIO $ do
+   m <- newIORef []
+   sharedCAF m getOrSetGHCConcWindowsPendingDelaysStore
+
+foreign import ccall unsafe "getOrSetGHCConcWindowsPendingDelaysStore"
+    getOrSetGHCConcWindowsPendingDelaysStore :: Ptr a -> IO (Ptr a)
+
+{-# NOINLINE ioManagerThread #-}
+ioManagerThread :: MVar (Maybe ThreadId)
+ioManagerThread = unsafePerformIO $ do
+   m <- newMVar Nothing
+   sharedCAF m getOrSetGHCConcWindowsIOManagerThreadStore
+
+foreign import ccall unsafe "getOrSetGHCConcWindowsIOManagerThreadStore"
+    getOrSetGHCConcWindowsIOManagerThreadStore :: Ptr a -> IO (Ptr a)
+
+ensureIOManagerIsRunning :: IO ()
+ensureIOManagerIsRunning
+  | threaded  = startIOManagerThread
+  | otherwise = return ()
+
+startIOManagerThread :: IO ()
+startIOManagerThread = do
+  modifyMVar_ ioManagerThread $ \old -> do
+    let create = do t <- forkIO ioManager; return (Just t)
+    case old of
+      Nothing -> create
+      Just t  -> do
+        s <- threadStatus t
+        case s of
+          ThreadFinished -> create
+          ThreadDied     -> create
+          _other         -> return (Just t)
+
+insertDelay :: DelayReq -> [DelayReq] -> [DelayReq]
+insertDelay d [] = [d]
+insertDelay d1 ds@(d2 : rest)
+  | delayTime d1 <= delayTime d2 = d1 : ds
+  | otherwise                    = d2 : insertDelay d1 rest
+
+delayTime :: DelayReq -> USecs
+delayTime (Delay t _) = t
+delayTime (DelaySTM t _) = t
+
+type USecs = Word64
+type NSecs = Word64
+
+foreign import ccall unsafe "getMonotonicNSec"
+  getMonotonicNSec :: IO NSecs
+
+getMonotonicUSec :: IO USecs
+getMonotonicUSec = fmap (`div` 1000) getMonotonicNSec
+
+{-# NOINLINE prodding #-}
+prodding :: IORef Bool
+prodding = unsafePerformIO $ do
+   r <- newIORef False
+   sharedCAF r getOrSetGHCConcWindowsProddingStore
+
+foreign import ccall unsafe "getOrSetGHCConcWindowsProddingStore"
+    getOrSetGHCConcWindowsProddingStore :: Ptr a -> IO (Ptr a)
+
+prodServiceThread :: IO ()
+prodServiceThread = do
+  -- NB. use atomicModifyIORef here, otherwise there are race
+  -- conditions in which prodding is left at True but the server is
+  -- blocked in select().
+  was_set <- atomicModifyIORef prodding $ \b -> (True,b)
+  unless was_set wakeupIOManager
+
+-- ----------------------------------------------------------------------------
+-- Windows IO manager thread
+
+ioManager :: IO ()
+ioManager = do
+  wakeup <- c_getIOManagerEvent
+  service_loop wakeup []
+
+service_loop :: HANDLE          -- read end of pipe
+             -> [DelayReq]      -- current delay requests
+             -> IO ()
+
+service_loop wakeup old_delays = do
+  -- pick up new delay requests
+  new_delays <- atomicModifyIORef pendingDelays (\a -> ([],a))
+  let  delays = foldr insertDelay old_delays new_delays
+
+  now <- getMonotonicUSec
+  (delays', timeout) <- getDelay now delays
+
+  r <- c_WaitForSingleObject wakeup timeout
+  case r of
+    0xffffffff -> do throwGetLastError "service_loop"
+    0 -> do
+        r2 <- c_readIOManagerEvent
+        exit <-
+              case r2 of
+                _ | r2 == io_MANAGER_WAKEUP -> return False
+                _ | r2 == io_MANAGER_DIE    -> return True
+                0 -> return False -- spurious wakeup
+                _ -> do start_console_handler (r2 `shiftR` 1); return False
+        unless exit $ service_cont wakeup delays'
+
+    _other -> service_cont wakeup delays' -- probably timeout
+
+service_cont :: HANDLE -> [DelayReq] -> IO ()
+service_cont wakeup delays = do
+  r <- atomicModifyIORef prodding (\_ -> (False,False))
+  r `seq` return () -- avoid space leak
+  service_loop wakeup delays
+
+-- must agree with rts/win32/ThrIOManager.c
+io_MANAGER_WAKEUP, io_MANAGER_DIE :: Word32
+io_MANAGER_WAKEUP = 0xffffffff
+io_MANAGER_DIE    = 0xfffffffe
+
+data ConsoleEvent
+ = ControlC
+ | Break
+ | Close
+    -- these are sent to Services only.
+ | Logoff
+ | Shutdown
+ deriving (Eq, Ord, Enum, Show, Read, Typeable)
+
+start_console_handler :: Word32 -> IO ()
+start_console_handler r =
+  case toWin32ConsoleEvent r of
+     Just x  -> withMVar win32ConsoleHandler $ \handler -> do
+                    _ <- forkIO (handler x)
+                    return ()
+     Nothing -> return ()
+
+toWin32ConsoleEvent :: (Eq a, Num a) => a -> Maybe ConsoleEvent
+toWin32ConsoleEvent ev =
+   case ev of
+       0 {- CTRL_C_EVENT-}        -> Just ControlC
+       1 {- CTRL_BREAK_EVENT-}    -> Just Break
+       2 {- CTRL_CLOSE_EVENT-}    -> Just Close
+       5 {- CTRL_LOGOFF_EVENT-}   -> Just Logoff
+       6 {- CTRL_SHUTDOWN_EVENT-} -> Just Shutdown
+       _ -> Nothing
+
+win32ConsoleHandler :: MVar (ConsoleEvent -> IO ())
+win32ConsoleHandler = unsafePerformIO (newMVar (error "win32ConsoleHandler"))
+
+wakeupIOManager :: IO ()
+wakeupIOManager = c_sendIOManagerEvent io_MANAGER_WAKEUP
+
+-- Walk the queue of pending delays, waking up any that have passed
+-- and return the smallest delay to wait for.  The queue of pending
+-- delays is kept ordered.
+getDelay :: USecs -> [DelayReq] -> IO ([DelayReq], DWORD)
+getDelay _   [] = return ([], iNFINITE)
+getDelay now all@(d : rest)
+  = case d of
+     Delay time m | now >= time -> do
+        putMVar m ()
+        getDelay now rest
+     DelaySTM time t | now >= time -> do
+        atomically $ writeTVar t True
+        getDelay now rest
+     _otherwise ->
+        -- delay is in millisecs for WaitForSingleObject
+        let micro_seconds = delayTime d - now
+            milli_seconds = (micro_seconds + 999) `div` 1000
+        in return (all, fromIntegral milli_seconds)
+
+foreign import ccall unsafe "getIOManagerEvent" -- in the RTS (ThrIOManager.c)
+  c_getIOManagerEvent :: IO HANDLE
+
+foreign import ccall unsafe "readIOManagerEvent" -- in the RTS (ThrIOManager.c)
+  c_readIOManagerEvent :: IO Word32
+
+foreign import ccall unsafe "sendIOManagerEvent" -- in the RTS (ThrIOManager.c)
+  c_sendIOManagerEvent :: Word32 -> IO ()
+
+foreign import WINDOWS_CCONV "WaitForSingleObject"
+   c_WaitForSingleObject :: HANDLE -> DWORD -> IO DWORD
+
diff --git a/libraries/base/GHC/ConsoleHandler.hs b/libraries/base/GHC/ConsoleHandler.hs
new file mode 100644
index 000000000000..4eaa434186e4
--- /dev/null
+++ b/libraries/base/GHC/ConsoleHandler.hs
@@ -0,0 +1,158 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE CPP #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.ConsoleHandler
+-- Copyright   :  (c) The University of Glasgow
+-- License     :  see libraries/base/LICENSE
+-- 
+-- Maintainer  :  cvs-ghc@haskell.org
+-- Stability   :  internal
+-- Portability :  non-portable (GHC extensions)
+--
+-- NB. the contents of this module are only available on Windows.
+--
+-- Installing Win32 console handlers.
+-- 
+-----------------------------------------------------------------------------
+
+module GHC.ConsoleHandler
+#if !defined(mingw32_HOST_OS) && !defined(__HADDOCK__)
+        where
+#else /* whole file */
+        ( Handler(..)
+        , installHandler
+        , ConsoleEvent(..)
+        , flushConsole
+        ) where
+
+{-
+#include "rts/Signals.h"
+
+Note: this #include is inside a Haskell comment
+      but it brings into scope some #defines
+      that are used by CPP below (eg STG_SIG_DFL).
+      Having it in a comment means that there's no
+      danger that C-like crap will be misunderstood
+      by GHC
+-}
+
+import Foreign
+import Foreign.C
+import GHC.IO.FD
+import GHC.IO.Exception
+import GHC.IO.Handle.Types
+import GHC.IO.Handle.Internals
+import GHC.Conc
+import Control.Concurrent.MVar
+import Data.Typeable
+
+data Handler
+ = Default
+ | Ignore
+ | Catch (ConsoleEvent -> IO ())
+
+-- | Allows Windows console events to be caught and handled.  To
+-- handle a console event, call 'installHandler' passing the
+-- appropriate 'Handler' value.  When the event is received, if the
+-- 'Handler' value is @Catch f@, then a new thread will be spawned by
+-- the system to execute @f e@, where @e@ is the 'ConsoleEvent' that
+-- was received.
+--
+-- Note that console events can only be received by an application
+-- running in a Windows console.  Certain environments that look like consoles
+-- do not support console events, these include:
+--
+--  * Cygwin shells with @CYGWIN=tty@ set (if you don't set @CYGWIN=tty@,
+--    then a Cygwin shell behaves like a Windows console).
+--  * Cygwin xterm and rxvt windows
+--  * MSYS rxvt windows
+--
+-- In order for your application to receive console events, avoid running
+-- it in one of these environments.
+--
+installHandler :: Handler -> IO Handler
+installHandler handler
+  | threaded =
+    modifyMVar win32ConsoleHandler $ \old_h -> do
+      (new_h,rc) <-
+        case handler of
+          Default -> do
+            r <- rts_installHandler STG_SIG_DFL nullPtr
+            return (no_handler, r)
+          Ignore  -> do
+            r <- rts_installHandler STG_SIG_IGN nullPtr
+            return (no_handler, r)
+          Catch h -> do
+            r <- rts_installHandler STG_SIG_HAN nullPtr
+            return (h, r)
+      prev_handler <-
+        case rc of
+          STG_SIG_DFL -> return Default
+          STG_SIG_IGN -> return Ignore
+          STG_SIG_HAN -> return (Catch old_h)
+          _           -> error "installHandler: Bad threaded rc value"
+      return (new_h, prev_handler)
+
+  | otherwise =
+  alloca $ \ p_sp -> do
+   rc <-
+    case handler of
+     Default -> rts_installHandler STG_SIG_DFL p_sp
+     Ignore  -> rts_installHandler STG_SIG_IGN p_sp
+     Catch h -> do
+        v <- newStablePtr (toHandler h)
+        poke p_sp v
+        rts_installHandler STG_SIG_HAN p_sp
+   case rc of
+     STG_SIG_DFL -> return Default
+     STG_SIG_IGN -> return Ignore
+     STG_SIG_HAN -> do
+        osptr <- peek p_sp
+        oldh  <- deRefStablePtr osptr
+         -- stable pointer is no longer in use, free it.
+        freeStablePtr osptr
+        return (Catch (\ ev -> oldh (fromConsoleEvent ev)))
+     _           -> error "installHandler: Bad non-threaded rc value"
+  where
+   fromConsoleEvent ev =
+     case ev of
+       ControlC -> 0 {- CTRL_C_EVENT-}
+       Break    -> 1 {- CTRL_BREAK_EVENT-}
+       Close    -> 2 {- CTRL_CLOSE_EVENT-}
+       Logoff   -> 5 {- CTRL_LOGOFF_EVENT-}
+       Shutdown -> 6 {- CTRL_SHUTDOWN_EVENT-}
+
+   toHandler hdlr ev = do
+      case toWin32ConsoleEvent ev of
+         -- see rts/win32/ConsoleHandler.c for comments as to why
+         -- rts_ConsoleHandlerDone is called here.
+        Just x  -> hdlr x >> rts_ConsoleHandlerDone ev
+        Nothing -> return () -- silently ignore..
+
+   no_handler = error "win32ConsoleHandler"
+
+foreign import ccall "rtsSupportsBoundThreads" threaded :: Bool
+
+foreign import ccall unsafe "RtsExternal.h rts_InstallConsoleEvent" 
+  rts_installHandler :: CInt -> Ptr (StablePtr (CInt -> IO ())) -> IO CInt
+foreign import ccall unsafe "RtsExternal.h rts_ConsoleHandlerDone"
+  rts_ConsoleHandlerDone :: CInt -> IO ()
+
+
+flushConsole :: Handle -> IO ()
+flushConsole h =
+  wantReadableHandle_ "flushConsole" h $ \ Handle__{haDevice=dev} ->
+    case cast dev of
+      Nothing -> ioException $
+                    IOError (Just h) IllegalOperation "flushConsole"
+                        "handle is not a file descriptor" Nothing Nothing
+      Just fd -> do
+        throwErrnoIfMinus1Retry_ "flushConsole" $
+           flush_console_fd (fdFD fd)
+
+foreign import ccall unsafe "consUtils.h flush_input_console__"
+        flush_console_fd :: CInt -> IO CInt
+
+#endif /* mingw32_HOST_OS */
diff --git a/libraries/base/GHC/Constants.hs b/libraries/base/GHC/Constants.hs
new file mode 100644
index 000000000000..d8efd7228cc2
--- /dev/null
+++ b/libraries/base/GHC/Constants.hs
@@ -0,0 +1,10 @@
+{-# LANGUAGE Trustworthy #-}
+
+module GHC.Constants where
+
+import Prelude ()
+
+-- TODO: This used to include HaskellConstants.hs, but that has now gone.
+-- We probably want to include the constants in platformConstants somehow
+-- instead.
+
diff --git a/libraries/base/GHC/Desugar.hs b/libraries/base/GHC/Desugar.hs
new file mode 100644
index 000000000000..cdea698851cd
--- /dev/null
+++ b/libraries/base/GHC/Desugar.hs
@@ -0,0 +1,41 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE NoImplicitPrelude
+           , RankNTypes
+           , ExistentialQuantification
+  #-}
+{-# OPTIONS_HADDOCK hide #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.Desugar
+-- Copyright   :  (c) The University of Glasgow, 2007
+-- License     :  see libraries/base/LICENSE
+-- 
+-- Maintainer  :  cvs-ghc@haskell.org
+-- Stability   :  internal
+-- Portability :  non-portable (GHC extensions)
+--
+-- Support code for desugaring in GHC
+-- 
+-----------------------------------------------------------------------------
+
+module GHC.Desugar ((>>>), AnnotationWrapper(..), toAnnotationWrapper) where
+
+import Control.Arrow    (Arrow(..))
+import Control.Category ((.))
+import Data.Data        (Data)
+
+-- A version of Control.Category.>>> overloaded on Arrow
+(>>>) :: forall arr. Arrow arr => forall a b c. arr a b -> arr b c -> arr a c
+-- NB: the type of this function is the "shape" that GHC expects
+--     in tcInstClassOp.  So don't put all the foralls at the front!  
+--     Yes, this is a bit grotesque, but heck it works and the whole
+--     arrows stuff needs reworking anyway!
+f >>> g = g . f
+
+-- A wrapper data type that lets the typechecker get at the appropriate dictionaries for an annotation
+data AnnotationWrapper = forall a. (Data a) => AnnotationWrapper a
+
+toAnnotationWrapper :: (Data a) => a -> AnnotationWrapper
+toAnnotationWrapper what = AnnotationWrapper what
+
diff --git a/libraries/base/GHC/Enum.lhs b/libraries/base/GHC/Enum.lhs
new file mode 100644
index 000000000000..d94e2ec54b1f
--- /dev/null
+++ b/libraries/base/GHC/Enum.lhs
@@ -0,0 +1,741 @@
+\begin{code}
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE CPP, NoImplicitPrelude, BangPatterns, MagicHash #-}
+{-# OPTIONS_HADDOCK hide #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.Enum
+-- Copyright   :  (c) The University of Glasgow, 1992-2002
+-- License     :  see libraries/base/LICENSE
+--
+-- Maintainer  :  cvs-ghc@haskell.org
+-- Stability   :  internal
+-- Portability :  non-portable (GHC extensions)
+--
+-- The 'Enum' and 'Bounded' classes.
+--
+-----------------------------------------------------------------------------
+
+#include "MachDeps.h"
+
+module GHC.Enum(
+        Bounded(..), Enum(..),
+        boundedEnumFrom, boundedEnumFromThen,
+        toEnumError, fromEnumError, succError, predError,
+
+        -- Instances for Bounded and Enum: (), Char, Int
+
+   ) where
+
+import GHC.Base
+import GHC.Char
+import GHC.Integer
+import GHC.Num
+import GHC.Show
+default ()              -- Double isn't available yet
+\end{code}
+
+
+%*********************************************************
+%*                                                      *
+\subsection{Class declarations}
+%*                                                      *
+%*********************************************************
+
+\begin{code}
+-- | The 'Bounded' class is used to name the upper and lower limits of a
+-- type.  'Ord' is not a superclass of 'Bounded' since types that are not
+-- totally ordered may also have upper and lower bounds.
+--
+-- The 'Bounded' class may be derived for any enumeration type;
+-- 'minBound' is the first constructor listed in the @data@ declaration
+-- and 'maxBound' is the last.
+-- 'Bounded' may also be derived for single-constructor datatypes whose
+-- constituent types are in 'Bounded'.
+
+class  Bounded a  where
+    minBound, maxBound :: a
+
+-- | Class 'Enum' defines operations on sequentially ordered types.
+--
+-- The @enumFrom@... methods are used in Haskell's translation of
+-- arithmetic sequences.
+--
+-- Instances of 'Enum' may be derived for any enumeration type (types
+-- whose constructors have no fields).  The nullary constructors are
+-- assumed to be numbered left-to-right by 'fromEnum' from @0@ through @n-1@.
+-- See Chapter 10 of the /Haskell Report/ for more details.
+--
+-- For any type that is an instance of class 'Bounded' as well as 'Enum',
+-- the following should hold:
+--
+-- * The calls @'succ' 'maxBound'@ and @'pred' 'minBound'@ should result in
+--   a runtime error.
+--
+-- * 'fromEnum' and 'toEnum' should give a runtime error if the
+--   result value is not representable in the result type.
+--   For example, @'toEnum' 7 :: 'Bool'@ is an error.
+--
+-- * 'enumFrom' and 'enumFromThen' should be defined with an implicit bound,
+--   thus:
+--
+-- >    enumFrom     x   = enumFromTo     x maxBound
+-- >    enumFromThen x y = enumFromThenTo x y bound
+-- >      where
+-- >        bound | fromEnum y >= fromEnum x = maxBound
+-- >              | otherwise                = minBound
+--
+class  Enum a   where
+    -- | the successor of a value.  For numeric types, 'succ' adds 1.
+    succ                :: a -> a
+    -- | the predecessor of a value.  For numeric types, 'pred' subtracts 1.
+    pred                :: a -> a
+    -- | Convert from an 'Int'.
+    toEnum              :: Int -> a
+    -- | Convert to an 'Int'.
+    -- It is implementation-dependent what 'fromEnum' returns when
+    -- applied to a value that is too large to fit in an 'Int'.
+    fromEnum            :: a -> Int
+
+    -- | Used in Haskell's translation of @[n..]@.
+    enumFrom            :: a -> [a]
+    -- | Used in Haskell's translation of @[n,n'..]@.
+    enumFromThen        :: a -> a -> [a]
+    -- | Used in Haskell's translation of @[n..m]@.
+    enumFromTo          :: a -> a -> [a]
+    -- | Used in Haskell's translation of @[n,n'..m]@.
+    enumFromThenTo      :: a -> a -> a -> [a]
+
+    succ                   = toEnum . (+ 1)  . fromEnum
+    pred                   = toEnum . (subtract 1) . fromEnum
+    enumFrom x             = map toEnum [fromEnum x ..]
+    enumFromThen x y       = map toEnum [fromEnum x, fromEnum y ..]
+    enumFromTo x y         = map toEnum [fromEnum x .. fromEnum y]
+    enumFromThenTo x1 x2 y = map toEnum [fromEnum x1, fromEnum x2 .. fromEnum y]
+
+-- Default methods for bounded enumerations
+boundedEnumFrom :: (Enum a, Bounded a) => a -> [a]
+boundedEnumFrom n = map toEnum [fromEnum n .. fromEnum (maxBound `asTypeOf` n)]
+
+boundedEnumFromThen :: (Enum a, Bounded a) => a -> a -> [a]
+boundedEnumFromThen n1 n2
+  | i_n2 >= i_n1  = map toEnum [i_n1, i_n2 .. fromEnum (maxBound `asTypeOf` n1)]
+  | otherwise     = map toEnum [i_n1, i_n2 .. fromEnum (minBound `asTypeOf` n1)]
+  where
+    i_n1 = fromEnum n1
+    i_n2 = fromEnum n2
+\end{code}
+
+\begin{code}
+------------------------------------------------------------------------
+-- Helper functions
+------------------------------------------------------------------------
+
+{-# NOINLINE toEnumError #-}
+toEnumError :: (Show a) => String -> Int -> (a,a) -> b
+toEnumError inst_ty i bnds =
+    error $ "Enum.toEnum{" ++ inst_ty ++ "}: tag (" ++
+            show i ++
+            ") is outside of bounds " ++
+            show bnds
+
+{-# NOINLINE fromEnumError #-}
+fromEnumError :: (Show a) => String -> a -> b
+fromEnumError inst_ty x =
+    error $ "Enum.fromEnum{" ++ inst_ty ++ "}: value (" ++
+            show x ++
+            ") is outside of Int's bounds " ++
+            show (minBound::Int, maxBound::Int)
+
+{-# NOINLINE succError #-}
+succError :: String -> a
+succError inst_ty =
+    error $ "Enum.succ{" ++ inst_ty ++ "}: tried to take `succ' of maxBound"
+
+{-# NOINLINE predError #-}
+predError :: String -> a
+predError inst_ty =
+    error $ "Enum.pred{" ++ inst_ty ++ "}: tried to take `pred' of minBound"
+\end{code}
+
+
+%*********************************************************
+%*                                                      *
+\subsection{Tuples}
+%*                                                      *
+%*********************************************************
+
+\begin{code}
+instance Bounded () where
+    minBound = ()
+    maxBound = ()
+
+instance Enum () where
+    succ _      = error "Prelude.Enum.().succ: bad argument"
+    pred _      = error "Prelude.Enum.().pred: bad argument"
+
+    toEnum x | x == 0    = ()
+             | otherwise = error "Prelude.Enum.().toEnum: bad argument"
+
+    fromEnum () = 0
+    enumFrom ()         = [()]
+    enumFromThen () ()  = let many = ():many in many
+    enumFromTo () ()    = [()]
+    enumFromThenTo () () () = let many = ():many in many
+\end{code}
+
+\begin{code}
+-- Report requires instances up to 15
+instance (Bounded a, Bounded b) => Bounded (a,b) where
+   minBound = (minBound, minBound)
+   maxBound = (maxBound, maxBound)
+
+instance (Bounded a, Bounded b, Bounded c) => Bounded (a,b,c) where
+   minBound = (minBound, minBound, minBound)
+   maxBound = (maxBound, maxBound, maxBound)
+
+instance (Bounded a, Bounded b, Bounded c, Bounded d) => Bounded (a,b,c,d) where
+   minBound = (minBound, minBound, minBound, minBound)
+   maxBound = (maxBound, maxBound, maxBound, maxBound)
+
+instance (Bounded a, Bounded b, Bounded c, Bounded d, Bounded e) => Bounded (a,b,c,d,e) where
+   minBound = (minBound, minBound, minBound, minBound, minBound)
+   maxBound = (maxBound, maxBound, maxBound, maxBound, maxBound)
+
+instance (Bounded a, Bounded b, Bounded c, Bounded d, Bounded e, Bounded f)
+        => Bounded (a,b,c,d,e,f) where
+   minBound = (minBound, minBound, minBound, minBound, minBound, minBound)
+   maxBound = (maxBound, maxBound, maxBound, maxBound, maxBound, maxBound)
+
+instance (Bounded a, Bounded b, Bounded c, Bounded d, Bounded e, Bounded f, Bounded g)
+        => Bounded (a,b,c,d,e,f,g) where
+   minBound = (minBound, minBound, minBound, minBound, minBound, minBound, minBound)
+   maxBound = (maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound)
+
+instance (Bounded a, Bounded b, Bounded c, Bounded d, Bounded e, Bounded f, Bounded g,
+          Bounded h)
+        => Bounded (a,b,c,d,e,f,g,h) where
+   minBound = (minBound, minBound, minBound, minBound, minBound, minBound, minBound, minBound)
+   maxBound = (maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound)
+
+instance (Bounded a, Bounded b, Bounded c, Bounded d, Bounded e, Bounded f, Bounded g,
+          Bounded h, Bounded i)
+        => Bounded (a,b,c,d,e,f,g,h,i) where
+   minBound = (minBound, minBound, minBound, minBound, minBound, minBound, minBound, minBound,
+               minBound)
+   maxBound = (maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound,
+               maxBound)
+
+instance (Bounded a, Bounded b, Bounded c, Bounded d, Bounded e, Bounded f, Bounded g,
+          Bounded h, Bounded i, Bounded j)
+        => Bounded (a,b,c,d,e,f,g,h,i,j) where
+   minBound = (minBound, minBound, minBound, minBound, minBound, minBound, minBound, minBound,
+               minBound, minBound)
+   maxBound = (maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound,
+               maxBound, maxBound)
+
+instance (Bounded a, Bounded b, Bounded c, Bounded d, Bounded e, Bounded f, Bounded g,
+          Bounded h, Bounded i, Bounded j, Bounded k)
+        => Bounded (a,b,c,d,e,f,g,h,i,j,k) where
+   minBound = (minBound, minBound, minBound, minBound, minBound, minBound, minBound, minBound,
+               minBound, minBound, minBound)
+   maxBound = (maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound,
+               maxBound, maxBound, maxBound)
+
+instance (Bounded a, Bounded b, Bounded c, Bounded d, Bounded e, Bounded f, Bounded g,
+          Bounded h, Bounded i, Bounded j, Bounded k, Bounded l)
+        => Bounded (a,b,c,d,e,f,g,h,i,j,k,l) where
+   minBound = (minBound, minBound, minBound, minBound, minBound, minBound, minBound, minBound,
+               minBound, minBound, minBound, minBound)
+   maxBound = (maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound,
+               maxBound, maxBound, maxBound, maxBound)
+
+instance (Bounded a, Bounded b, Bounded c, Bounded d, Bounded e, Bounded f, Bounded g,
+          Bounded h, Bounded i, Bounded j, Bounded k, Bounded l, Bounded m)
+        => Bounded (a,b,c,d,e,f,g,h,i,j,k,l,m) where
+   minBound = (minBound, minBound, minBound, minBound, minBound, minBound, minBound, minBound,
+               minBound, minBound, minBound, minBound, minBound)
+   maxBound = (maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound,
+               maxBound, maxBound, maxBound, maxBound, maxBound)
+
+instance (Bounded a, Bounded b, Bounded c, Bounded d, Bounded e, Bounded f, Bounded g,
+          Bounded h, Bounded i, Bounded j, Bounded k, Bounded l, Bounded m, Bounded n)
+        => Bounded (a,b,c,d,e,f,g,h,i,j,k,l,m,n) where
+   minBound = (minBound, minBound, minBound, minBound, minBound, minBound, minBound, minBound,
+               minBound, minBound, minBound, minBound, minBound, minBound)
+   maxBound = (maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound,
+               maxBound, maxBound, maxBound, maxBound, maxBound, maxBound)
+
+instance (Bounded a, Bounded b, Bounded c, Bounded d, Bounded e, Bounded f, Bounded g,
+          Bounded h, Bounded i, Bounded j, Bounded k, Bounded l, Bounded m, Bounded n, Bounded o)
+        => Bounded (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) where
+   minBound = (minBound, minBound, minBound, minBound, minBound, minBound, minBound, minBound,
+               minBound, minBound, minBound, minBound, minBound, minBound, minBound)
+   maxBound = (maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound,
+               maxBound, maxBound, maxBound, maxBound, maxBound, maxBound, maxBound)
+\end{code}
+
+
+%*********************************************************
+%*                                                      *
+\subsection{Type @Bool@}
+%*                                                      *
+%*********************************************************
+
+\begin{code}
+instance Bounded Bool where
+  minBound = False
+  maxBound = True
+
+instance Enum Bool where
+  succ False = True
+  succ True  = error "Prelude.Enum.Bool.succ: bad argument"
+
+  pred True  = False
+  pred False  = error "Prelude.Enum.Bool.pred: bad argument"
+
+  toEnum n | n == 0    = False
+           | n == 1    = True
+           | otherwise = error "Prelude.Enum.Bool.toEnum: bad argument"
+
+  fromEnum False = 0
+  fromEnum True  = 1
+
+  -- Use defaults for the rest
+  enumFrom     = boundedEnumFrom
+  enumFromThen = boundedEnumFromThen
+\end{code}
+
+%*********************************************************
+%*                                                      *
+\subsection{Type @Ordering@}
+%*                                                      *
+%*********************************************************
+
+\begin{code}
+instance Bounded Ordering where
+  minBound = LT
+  maxBound = GT
+
+instance Enum Ordering where
+  succ LT = EQ
+  succ EQ = GT
+  succ GT = error "Prelude.Enum.Ordering.succ: bad argument"
+
+  pred GT = EQ
+  pred EQ = LT
+  pred LT = error "Prelude.Enum.Ordering.pred: bad argument"
+
+  toEnum n | n == 0 = LT
+           | n == 1 = EQ
+           | n == 2 = GT
+  toEnum _ = error "Prelude.Enum.Ordering.toEnum: bad argument"
+
+  fromEnum LT = 0
+  fromEnum EQ = 1
+  fromEnum GT = 2
+
+  -- Use defaults for the rest
+  enumFrom     = boundedEnumFrom
+  enumFromThen = boundedEnumFromThen
+\end{code}
+
+%*********************************************************
+%*                                                      *
+\subsection{Type @Char@}
+%*                                                      *
+%*********************************************************
+
+\begin{code}
+instance  Bounded Char  where
+    minBound =  '\0'
+    maxBound =  '\x10FFFF'
+
+instance  Enum Char  where
+    succ (C# c#)
+       | isTrue# (ord# c# /=# 0x10FFFF#) = C# (chr# (ord# c# +# 1#))
+       | otherwise             = error ("Prelude.Enum.Char.succ: bad argument")
+    pred (C# c#)
+       | isTrue# (ord# c# /=# 0#) = C# (chr# (ord# c# -# 1#))
+       | otherwise                = error ("Prelude.Enum.Char.pred: bad argument")
+
+    toEnum   = chr
+    fromEnum = ord
+
+    {-# INLINE enumFrom #-}
+    enumFrom (C# x) = eftChar (ord# x) 0x10FFFF#
+        -- Blarg: technically I guess enumFrom isn't strict!
+
+    {-# INLINE enumFromTo #-}
+    enumFromTo (C# x) (C# y) = eftChar (ord# x) (ord# y)
+
+    {-# INLINE enumFromThen #-}
+    enumFromThen (C# x1) (C# x2) = efdChar (ord# x1) (ord# x2)
+
+    {-# INLINE enumFromThenTo #-}
+    enumFromThenTo (C# x1) (C# x2) (C# y) = efdtChar (ord# x1) (ord# x2) (ord# y)
+
+{-# RULES
+"eftChar"       [~1] forall x y.        eftChar x y       = build (\c n -> eftCharFB c n x y)
+"efdChar"       [~1] forall x1 x2.      efdChar x1 x2     = build (\ c n -> efdCharFB c n x1 x2)
+"efdtChar"      [~1] forall x1 x2 l.    efdtChar x1 x2 l  = build (\ c n -> efdtCharFB c n x1 x2 l)
+"eftCharList"   [1]  eftCharFB  (:) [] = eftChar
+"efdCharList"   [1]  efdCharFB  (:) [] = efdChar
+"efdtCharList"  [1]  efdtCharFB (:) [] = efdtChar
+ #-}
+
+
+-- We can do better than for Ints because we don't
+-- have hassles about arithmetic overflow at maxBound
+{-# INLINE [0] eftCharFB #-}
+eftCharFB :: (Char -> a -> a) -> a -> Int# -> Int# -> a
+eftCharFB c n x0 y = go x0
+                 where
+                    go x | isTrue# (x ># y) = n
+                         | otherwise        = C# (chr# x) `c` go (x +# 1#)
+
+{-# NOINLINE [1] eftChar #-}
+eftChar :: Int# -> Int# -> String
+eftChar x y | isTrue# (x ># y ) = []
+            | otherwise         = C# (chr# x) : eftChar (x +# 1#) y
+
+
+-- For enumFromThenTo we give up on inlining
+{-# NOINLINE [0] efdCharFB #-}
+efdCharFB :: (Char -> a -> a) -> a -> Int# -> Int# -> a
+efdCharFB c n x1 x2
+  | isTrue# (delta >=# 0#) = go_up_char_fb c n x1 delta 0x10FFFF#
+  | otherwise              = go_dn_char_fb c n x1 delta 0#
+  where
+    !delta = x2 -# x1
+
+{-# NOINLINE [1] efdChar #-}
+efdChar :: Int# -> Int# -> String
+efdChar x1 x2
+  | isTrue# (delta >=# 0#) = go_up_char_list x1 delta 0x10FFFF#
+  | otherwise              = go_dn_char_list x1 delta 0#
+  where
+    !delta = x2 -# x1
+
+{-# NOINLINE [0] efdtCharFB #-}
+efdtCharFB :: (Char -> a -> a) -> a -> Int# -> Int# -> Int# -> a
+efdtCharFB c n x1 x2 lim
+  | isTrue# (delta >=# 0#) = go_up_char_fb c n x1 delta lim
+  | otherwise              = go_dn_char_fb c n x1 delta lim
+  where
+    !delta = x2 -# x1
+
+{-# NOINLINE [1] efdtChar #-}
+efdtChar :: Int# -> Int# -> Int# -> String
+efdtChar x1 x2 lim
+  | isTrue# (delta >=# 0#) = go_up_char_list x1 delta lim
+  | otherwise              = go_dn_char_list x1 delta lim
+  where
+    !delta = x2 -# x1
+
+go_up_char_fb :: (Char -> a -> a) -> a -> Int# -> Int# -> Int# -> a
+go_up_char_fb c n x0 delta lim
+  = go_up x0
+  where
+    go_up x | isTrue# (x ># lim) = n
+            | otherwise          = C# (chr# x) `c` go_up (x +# delta)
+
+go_dn_char_fb :: (Char -> a -> a) -> a -> Int# -> Int# -> Int# -> a
+go_dn_char_fb c n x0 delta lim
+  = go_dn x0
+  where
+    go_dn x | isTrue# (x <# lim) = n
+            | otherwise          = C# (chr# x) `c` go_dn (x +# delta)
+
+go_up_char_list :: Int# -> Int# -> Int# -> String
+go_up_char_list x0 delta lim
+  = go_up x0
+  where
+    go_up x | isTrue# (x ># lim) = []
+            | otherwise          = C# (chr# x) : go_up (x +# delta)
+
+go_dn_char_list :: Int# -> Int# -> Int# -> String
+go_dn_char_list x0 delta lim
+  = go_dn x0
+  where
+    go_dn x | isTrue# (x <# lim) = []
+            | otherwise          = C# (chr# x) : go_dn (x +# delta)
+\end{code}
+
+
+%*********************************************************
+%*                                                      *
+\subsection{Type @Int@}
+%*                                                      *
+%*********************************************************
+
+Be careful about these instances.
+        (a) remember that you have to count down as well as up e.g. [13,12..0]
+        (b) be careful of Int overflow
+        (c) remember that Int is bounded, so [1..] terminates at maxInt
+
+\begin{code}
+instance  Bounded Int where
+    minBound =  minInt
+    maxBound =  maxInt
+
+instance  Enum Int  where
+    succ x
+       | x == maxBound  = error "Prelude.Enum.succ{Int}: tried to take `succ' of maxBound"
+       | otherwise      = x + 1
+    pred x
+       | x == minBound  = error "Prelude.Enum.pred{Int}: tried to take `pred' of minBound"
+       | otherwise      = x - 1
+
+    toEnum   x = x
+    fromEnum x = x
+
+    {-# INLINE enumFrom #-}
+    enumFrom (I# x) = eftInt x maxInt#
+        where !(I# maxInt#) = maxInt
+        -- Blarg: technically I guess enumFrom isn't strict!
+
+    {-# INLINE enumFromTo #-}
+    enumFromTo (I# x) (I# y) = eftInt x y
+
+    {-# INLINE enumFromThen #-}
+    enumFromThen (I# x1) (I# x2) = efdInt x1 x2
+
+    {-# INLINE enumFromThenTo #-}
+    enumFromThenTo (I# x1) (I# x2) (I# y) = efdtInt x1 x2 y
+
+
+-----------------------------------------------------
+-- eftInt and eftIntFB deal with [a..b], which is the
+-- most common form, so we take a lot of care
+-- In particular, we have rules for deforestation
+
+{-# RULES
+"eftInt"        [~1] forall x y. eftInt x y = build (\ c n -> eftIntFB c n x y)
+"eftIntList"    [1] eftIntFB  (:) [] = eftInt
+ #-}
+
+{-# NOINLINE [1] eftInt #-}
+eftInt :: Int# -> Int# -> [Int]
+-- [x1..x2]
+eftInt x0 y | isTrue# (x0 ># y) = []
+            | otherwise         = go x0
+               where
+                 go x = I# x : if isTrue# (x ==# y)
+                               then []
+                               else go (x +# 1#)
+
+{-# INLINE [0] eftIntFB #-}
+eftIntFB :: (Int -> r -> r) -> r -> Int# -> Int# -> r
+eftIntFB c n x0 y | isTrue# (x0 ># y) = n
+                  | otherwise         = go x0
+                 where
+                   go x = I# x `c` if isTrue# (x ==# y)
+                                   then n
+                                   else go (x +# 1#)
+                        -- Watch out for y=maxBound; hence ==, not >
+        -- Be very careful not to have more than one "c"
+        -- so that when eftInfFB is inlined we can inline
+        -- whatever is bound to "c"
+
+
+-----------------------------------------------------
+-- efdInt and efdtInt deal with [a,b..] and [a,b..c].
+-- The code is more complicated because of worries about Int overflow.
+
+{-# RULES
+"efdtInt"       [~1] forall x1 x2 y.
+                     efdtInt x1 x2 y = build (\ c n -> efdtIntFB c n x1 x2 y)
+"efdtIntUpList" [1]  efdtIntFB (:) [] = efdtInt
+ #-}
+
+efdInt :: Int# -> Int# -> [Int]
+-- [x1,x2..maxInt]
+efdInt x1 x2
+ | isTrue# (x2 >=# x1) = case maxInt of I# y -> efdtIntUp x1 x2 y
+ | otherwise           = case minInt of I# y -> efdtIntDn x1 x2 y
+
+{-# NOINLINE [1] efdtInt #-}
+efdtInt :: Int# -> Int# -> Int# -> [Int]
+-- [x1,x2..y]
+efdtInt x1 x2 y
+ | isTrue# (x2 >=# x1) = efdtIntUp x1 x2 y
+ | otherwise           = efdtIntDn x1 x2 y
+
+{-# INLINE [0] efdtIntFB #-}
+efdtIntFB :: (Int -> r -> r) -> r -> Int# -> Int# -> Int# -> r
+efdtIntFB c n x1 x2 y
+ | isTrue# (x2 >=# x1) = efdtIntUpFB c n x1 x2 y
+ | otherwise           = efdtIntDnFB c n x1 x2 y
+
+-- Requires x2 >= x1
+efdtIntUp :: Int# -> Int# -> Int# -> [Int]
+efdtIntUp x1 x2 y    -- Be careful about overflow!
+ | isTrue# (y <# x2) = if isTrue# (y <# x1) then [] else [I# x1]
+ | otherwise = -- Common case: x1 <= x2 <= y
+               let !delta = x2 -# x1 -- >= 0
+                   !y' = y -# delta  -- x1 <= y' <= y; hence y' is representable
+
+                   -- Invariant: x <= y
+                   -- Note that: z <= y' => z + delta won't overflow
+                   -- so we are guaranteed not to overflow if/when we recurse
+                   go_up x | isTrue# (x ># y') = [I# x]
+                           | otherwise         = I# x : go_up (x +# delta)
+               in I# x1 : go_up x2
+
+-- Requires x2 >= x1
+efdtIntUpFB :: (Int -> r -> r) -> r -> Int# -> Int# -> Int# -> r
+efdtIntUpFB c n x1 x2 y    -- Be careful about overflow!
+ | isTrue# (y <# x2) = if isTrue# (y <# x1) then n else I# x1 `c` n
+ | otherwise = -- Common case: x1 <= x2 <= y
+               let !delta = x2 -# x1 -- >= 0
+                   !y' = y -# delta  -- x1 <= y' <= y; hence y' is representable
+
+                   -- Invariant: x <= y
+                   -- Note that: z <= y' => z + delta won't overflow
+                   -- so we are guaranteed not to overflow if/when we recurse
+                   go_up x | isTrue# (x ># y') = I# x `c` n
+                           | otherwise         = I# x `c` go_up (x +# delta)
+               in I# x1 `c` go_up x2
+
+-- Requires x2 <= x1
+efdtIntDn :: Int# -> Int# -> Int# -> [Int]
+efdtIntDn x1 x2 y    -- Be careful about underflow!
+ | isTrue# (y ># x2) = if isTrue# (y ># x1) then [] else [I# x1]
+ | otherwise = -- Common case: x1 >= x2 >= y
+               let !delta = x2 -# x1 -- <= 0
+                   !y' = y -# delta  -- y <= y' <= x1; hence y' is representable
+
+                   -- Invariant: x >= y
+                   -- Note that: z >= y' => z + delta won't underflow
+                   -- so we are guaranteed not to underflow if/when we recurse
+                   go_dn x | isTrue# (x <# y') = [I# x]
+                           | otherwise         = I# x : go_dn (x +# delta)
+   in I# x1 : go_dn x2
+
+-- Requires x2 <= x1
+efdtIntDnFB :: (Int -> r -> r) -> r -> Int# -> Int# -> Int# -> r
+efdtIntDnFB c n x1 x2 y    -- Be careful about underflow!
+ | isTrue# (y ># x2) = if isTrue# (y ># x1) then n else I# x1 `c` n
+ | otherwise = -- Common case: x1 >= x2 >= y
+               let !delta = x2 -# x1 -- <= 0
+                   !y' = y -# delta  -- y <= y' <= x1; hence y' is representable
+
+                   -- Invariant: x >= y
+                   -- Note that: z >= y' => z + delta won't underflow
+                   -- so we are guaranteed not to underflow if/when we recurse
+                   go_dn x | isTrue# (x <# y') = I# x `c` n
+                           | otherwise         = I# x `c` go_dn (x +# delta)
+               in I# x1 `c` go_dn x2
+\end{code}
+
+
+%*********************************************************
+%*                                                      *
+\subsection{Type @Word@}
+%*                                                      *
+%*********************************************************
+
+\begin{code}
+instance Bounded Word where
+    minBound = 0
+
+    -- use unboxed literals for maxBound, because GHC doesn't optimise
+    -- (fromInteger 0xffffffff :: Word).
+#if WORD_SIZE_IN_BITS == 32
+    maxBound = W# (int2Word# 0xFFFFFFFF#)
+#elif WORD_SIZE_IN_BITS == 64
+    maxBound = W# (int2Word# 0xFFFFFFFFFFFFFFFF#)
+#else
+#error Unhandled value for WORD_SIZE_IN_BITS
+#endif
+\end{code}
+
+
+%*********************************************************
+%*                                                      *
+\subsection{The @Integer@ instance for @Enum@}
+%*                                                      *
+%*********************************************************
+
+\begin{code}
+instance  Enum Integer  where
+    succ x               = x + 1
+    pred x               = x - 1
+    toEnum (I# n)        = smallInteger n
+    fromEnum n           = I# (integerToInt n)
+
+    {-# INLINE enumFrom #-}
+    {-# INLINE enumFromThen #-}
+    {-# INLINE enumFromTo #-}
+    {-# INLINE enumFromThenTo #-}
+    enumFrom x             = enumDeltaInteger   x 1
+    enumFromThen x y       = enumDeltaInteger   x (y-x)
+    enumFromTo x lim       = enumDeltaToInteger x 1     lim
+    enumFromThenTo x y lim = enumDeltaToInteger x (y-x) lim
+
+{-# RULES
+"enumDeltaInteger"      [~1] forall x y.  enumDeltaInteger x y     = build (\c _ -> enumDeltaIntegerFB c x y)
+"efdtInteger"           [~1] forall x y l.enumDeltaToInteger x y l = build (\c n -> enumDeltaToIntegerFB c n x y l)
+"enumDeltaInteger"      [1] enumDeltaIntegerFB   (:)    = enumDeltaInteger
+"enumDeltaToInteger"    [1] enumDeltaToIntegerFB (:) [] = enumDeltaToInteger
+ #-}
+
+{-# NOINLINE [0] enumDeltaIntegerFB #-}
+enumDeltaIntegerFB :: (Integer -> b -> b) -> Integer -> Integer -> b
+enumDeltaIntegerFB c x d = x `seq` (x `c` enumDeltaIntegerFB c (x+d) d)
+
+{-# NOINLINE [1] enumDeltaInteger #-}
+enumDeltaInteger :: Integer -> Integer -> [Integer]
+enumDeltaInteger x d = x `seq` (x : enumDeltaInteger (x+d) d)
+-- strict accumulator, so
+--     head (drop 1000000 [1 .. ]
+-- works
+
+{-# NOINLINE [0] enumDeltaToIntegerFB #-}
+-- Don't inline this until RULE "enumDeltaToInteger" has had a chance to fire
+enumDeltaToIntegerFB :: (Integer -> a -> a) -> a
+                     -> Integer -> Integer -> Integer -> a
+enumDeltaToIntegerFB c n x delta lim
+  | delta >= 0 = up_fb c n x delta lim
+  | otherwise  = dn_fb c n x delta lim
+
+{-# RULES
+"enumDeltaToInteger1"   [0] forall c n x . enumDeltaToIntegerFB c n x 1 = up_fb c n x 1
+ #-}
+-- This rule ensures that in the common case (delta = 1), we do not do the check here,
+-- and also that we have the chance to inline up_fb, which would allow the constructor to be
+-- inlined and good things to happen.
+-- We do not do it for Int this way because hand-tuned code already exists, and
+-- the special case varies more from the general case, due to the issue of overflows.
+
+{-# NOINLINE [1] enumDeltaToInteger #-}
+enumDeltaToInteger :: Integer -> Integer -> Integer -> [Integer]
+enumDeltaToInteger x delta lim
+  | delta >= 0 = up_list x delta lim
+  | otherwise  = dn_list x delta lim
+
+up_fb :: (Integer -> a -> a) -> a -> Integer -> Integer -> Integer -> a
+up_fb c n x0 delta lim = go (x0 :: Integer)
+                      where
+                        go x | x > lim   = n
+                             | otherwise = x `c` go (x+delta)
+dn_fb :: (Integer -> a -> a) -> a -> Integer -> Integer -> Integer -> a
+dn_fb c n x0 delta lim = go (x0 :: Integer)
+                      where
+                        go x | x < lim   = n
+                             | otherwise = x `c` go (x+delta)
+
+up_list :: Integer -> Integer -> Integer -> [Integer]
+up_list x0 delta lim = go (x0 :: Integer)
+                    where
+                        go x | x > lim   = []
+                             | otherwise = x : go (x+delta)
+dn_list :: Integer -> Integer -> Integer -> [Integer]
+dn_list x0 delta lim = go (x0 :: Integer)
+                    where
+                        go x | x < lim   = []
+                             | otherwise = x : go (x+delta)
+\end{code}
+
diff --git a/libraries/base/GHC/Environment.hs b/libraries/base/GHC/Environment.hs
new file mode 100644
index 000000000000..257ee27ebf3b
--- /dev/null
+++ b/libraries/base/GHC/Environment.hs
@@ -0,0 +1,61 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE CPP #-}
+
+module GHC.Environment (getFullArgs) where
+
+import Prelude
+import Foreign
+import Foreign.C
+
+#ifdef mingw32_HOST_OS
+import GHC.IO (finally)
+import GHC.Windows
+
+# if defined(i386_HOST_ARCH)
+#  define WINDOWS_CCONV stdcall
+# elif defined(x86_64_HOST_ARCH)
+#  define WINDOWS_CCONV ccall
+# else
+#  error Unknown mingw32 arch
+# endif
+
+-- Ignore the arguments to hs_init on Windows for the sake of Unicode compat
+getFullArgs :: IO [String]
+getFullArgs = do
+    p_arg_string <- c_GetCommandLine
+    alloca $ \p_argc -> do
+     p_argv <- c_CommandLineToArgv p_arg_string p_argc
+     if p_argv == nullPtr
+      then throwGetLastError "getFullArgs"
+      else flip finally (c_LocalFree p_argv) $ do
+       argc <- peek p_argc
+       p_argvs <- peekArray (fromIntegral argc) p_argv
+       mapM peekCWString p_argvs
+
+foreign import WINDOWS_CCONV unsafe "windows.h GetCommandLineW"
+    c_GetCommandLine :: IO (Ptr CWString)
+
+foreign import WINDOWS_CCONV unsafe "windows.h CommandLineToArgvW"
+    c_CommandLineToArgv :: Ptr CWString -> Ptr CInt -> IO (Ptr CWString)
+
+foreign import WINDOWS_CCONV unsafe "Windows.h LocalFree"
+    c_LocalFree :: Ptr a -> IO (Ptr a)
+#else
+import Control.Monad
+
+import GHC.IO.Encoding
+import qualified GHC.Foreign as GHC
+
+getFullArgs :: IO [String]
+getFullArgs =
+  alloca $ \ p_argc ->
+  alloca $ \ p_argv -> do
+   getFullProgArgv p_argc p_argv
+   p    <- fromIntegral `liftM` peek p_argc
+   argv <- peek p_argv
+   enc <- getFileSystemEncoding
+   peekArray (p - 1) (advancePtr argv 1) >>= mapM (GHC.peekCString enc)
+
+foreign import ccall unsafe "getFullProgArgv"
+    getFullProgArgv :: Ptr CInt -> Ptr (Ptr CString) -> IO ()
+#endif
diff --git a/libraries/base/GHC/Err.lhs b/libraries/base/GHC/Err.lhs
new file mode 100644
index 000000000000..f7679842e062
--- /dev/null
+++ b/libraries/base/GHC/Err.lhs
@@ -0,0 +1,68 @@
+\begin{code}
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE NoImplicitPrelude, MagicHash #-}
+{-# OPTIONS_HADDOCK hide #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.Err
+-- Copyright   :  (c) The University of Glasgow, 1994-2002
+-- License     :  see libraries/base/LICENSE
+-- 
+-- Maintainer  :  cvs-ghc@haskell.org
+-- Stability   :  internal
+-- Portability :  non-portable (GHC extensions)
+--
+-- The "GHC.Err" module defines the code for the wired-in error functions,
+-- which have a special type in the compiler (with \"open tyvars\").
+-- 
+-- We cannot define these functions in a module where they might be used
+-- (e.g., "GHC.Base"), because the magical wired-in type will get confused
+-- with what the typechecker figures out.
+-- 
+-----------------------------------------------------------------------------
+
+module GHC.Err( absentErr, error, undefined ) where
+import GHC.CString ()
+import GHC.Types
+import GHC.Prim
+import GHC.Integer ()   -- Make sure Integer is compiled first
+                        -- because GHC depends on it in a wired-in way
+                        -- so the build system doesn't see the dependency
+import {-# SOURCE #-} GHC.Exception( errorCallException )
+\end{code}
+
+%*********************************************************
+%*                                                      *
+\subsection{Error-ish functions}
+%*                                                      *
+%*********************************************************
+
+\begin{code}
+-- | 'error' stops execution and displays an error message.
+error :: [Char] -> a
+error s = raise# (errorCallException s)
+
+-- | A special case of 'error'.
+-- It is expected that compilers will recognize this and insert error
+-- messages which are more appropriate to the context in which 'undefined'
+-- appears. 
+
+undefined :: a
+undefined =  error "Prelude.undefined"
+\end{code}
+
+%*********************************************************
+%*                                                       *
+\subsection{Compiler generated errors + local utils}
+%*                                                       *
+%*********************************************************
+
+Used for compiler-generated error message;
+encoding saves bytes of string junk.
+
+\begin{code}
+absentErr :: a
+absentErr = error "Oops! The program has entered an `absent' argument!\n"
+\end{code}
+
diff --git a/libraries/base/GHC/Event.hs b/libraries/base/GHC/Event.hs
new file mode 100644
index 000000000000..9746bc7f2e32
--- /dev/null
+++ b/libraries/base/GHC/Event.hs
@@ -0,0 +1,45 @@
+{-# LANGUAGE Trustworthy #-}
+
+-- ----------------------------------------------------------------------------
+-- | This module provides scalable event notification for file
+-- descriptors and timeouts.
+--
+-- This module should be considered GHC internal.
+--
+-- ----------------------------------------------------------------------------
+
+module GHC.Event
+    ( -- * Types
+      EventManager
+    , TimerManager
+
+      -- * Creation
+    , getSystemEventManager
+    , new
+    , getSystemTimerManager
+
+      -- * Registering interest in I/O events
+    , Event
+    , evtRead
+    , evtWrite
+    , IOCallback
+    , FdKey(keyFd)
+    , registerFd
+    , registerFd_
+    , unregisterFd
+    , unregisterFd_
+    , closeFd
+
+      -- * Registering interest in timeout events
+    , TimeoutCallback
+    , TimeoutKey
+    , registerTimeout
+    , updateTimeout
+    , unregisterTimeout
+    ) where
+
+import GHC.Event.Manager
+import GHC.Event.TimerManager (TimeoutCallback, TimeoutKey, registerTimeout,
+                               updateTimeout, unregisterTimeout, TimerManager)
+import GHC.Event.Thread (getSystemEventManager, getSystemTimerManager)
+
diff --git a/libraries/base/GHC/Event/Arr.hs b/libraries/base/GHC/Event/Arr.hs
new file mode 100644
index 000000000000..c2ca8f9b8d43
--- /dev/null
+++ b/libraries/base/GHC/Event/Arr.hs
@@ -0,0 +1,32 @@
+{-# LANGUAGE MagicHash, NoImplicitPrelude, UnboxedTuples #-}
+
+module GHC.Event.Arr
+    (
+      Arr(..)
+    , new
+    , size
+    , read
+    , write
+    ) where
+
+import GHC.Base (($))
+import GHC.Prim (MutableArray#, RealWorld, newArray#, readArray#,
+                 sizeofMutableArray#, writeArray#)
+import GHC.Types (IO(..), Int(..))
+
+data Arr a = Arr (MutableArray# RealWorld a)
+
+new :: a -> Int -> IO (Arr a)
+new defval (I# n#) = IO $ \s0# ->
+  case newArray# n# defval s0# of (# s1#, marr# #) -> (# s1#, Arr marr# #)
+
+size :: Arr a -> Int
+size (Arr a) = I# (sizeofMutableArray# a)
+
+read :: Arr a -> Int -> IO a
+read (Arr a) (I# n#) = IO $ \s0# ->
+  case readArray# a n# s0# of (# s1#, val #) -> (# s1#, val #)
+
+write :: Arr a -> Int -> a -> IO ()
+write (Arr a) (I# n#) val = IO $ \s0# ->
+  case writeArray# a n# val s0# of s1# -> (# s1#, () #)
diff --git a/libraries/base/GHC/Event/Array.hs b/libraries/base/GHC/Event/Array.hs
new file mode 100644
index 000000000000..30dbd77f5b5f
--- /dev/null
+++ b/libraries/base/GHC/Event/Array.hs
@@ -0,0 +1,313 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE BangPatterns, CPP, NoImplicitPrelude #-}
+
+module GHC.Event.Array
+    (
+      Array
+    , capacity
+    , clear
+    , concat
+    , copy
+    , duplicate
+    , empty
+    , ensureCapacity
+    , findIndex
+    , forM_
+    , length
+    , loop
+    , new
+    , removeAt
+    , snoc
+    , unsafeLoad
+    , unsafeRead
+    , unsafeWrite
+    , useAsPtr
+    ) where
+
+import Control.Monad hiding (forM_)
+import Data.Bits ((.|.), shiftR)
+import Data.IORef (IORef, atomicModifyIORef', newIORef, readIORef, writeIORef)
+import Data.Maybe
+import Foreign.C.Types (CSize(..))
+import Foreign.ForeignPtr (ForeignPtr, withForeignPtr)
+import Foreign.Ptr (Ptr, nullPtr, plusPtr)
+import Foreign.Storable (Storable(..))
+import GHC.Base
+import GHC.ForeignPtr (mallocPlainForeignPtrBytes, newForeignPtr_)
+import GHC.Num (Num(..))
+import GHC.Real (fromIntegral)
+import GHC.Show (show)
+
+#include "MachDeps.h"
+
+#define BOUNDS_CHECKING 1
+
+#if defined(BOUNDS_CHECKING)
+-- This fugly hack is brought by GHC's apparent reluctance to deal
+-- with MagicHash and UnboxedTuples when inferring types. Eek!
+#define CHECK_BOUNDS(_func_,_len_,_k_) \
+if (_k_) < 0 || (_k_) >= (_len_) then error ("GHC.Event.Array." ++ (_func_) ++ ": bounds error, index " ++ show (_k_) ++ ", capacity " ++ show (_len_)) else
+#else
+#define CHECK_BOUNDS(_func_,_len_,_k_)
+#endif
+
+-- Invariant: size <= capacity
+newtype Array a = Array (IORef (AC a))
+
+-- The actual array content.
+data AC a = AC
+    !(ForeignPtr a)  -- Elements
+    !Int      -- Number of elements (length)
+    !Int      -- Maximum number of elements (capacity)
+
+empty :: IO (Array a)
+empty = do
+  p <- newForeignPtr_ nullPtr
+  Array `fmap` newIORef (AC p 0 0)
+
+allocArray :: Storable a => Int -> IO (ForeignPtr a)
+allocArray n = allocHack undefined
+ where
+  allocHack :: Storable a => a -> IO (ForeignPtr a)
+  allocHack dummy = mallocPlainForeignPtrBytes (n * sizeOf dummy)
+
+reallocArray :: Storable a => ForeignPtr a -> Int -> Int -> IO (ForeignPtr a)
+reallocArray p newSize oldSize = reallocHack undefined p
+ where
+  reallocHack :: Storable a => a -> ForeignPtr a -> IO (ForeignPtr a)
+  reallocHack dummy src = do
+      let size = sizeOf dummy
+      dst <- mallocPlainForeignPtrBytes (newSize * size)
+      withForeignPtr src $ \s ->
+        when (s /= nullPtr && oldSize > 0) .
+          withForeignPtr dst $ \d -> do
+            _ <- memcpy d s (fromIntegral (oldSize * size))
+            return ()
+      return dst
+
+new :: Storable a => Int -> IO (Array a)
+new c = do
+    es <- allocArray cap
+    fmap Array (newIORef (AC es 0 cap))
+  where
+    cap = firstPowerOf2 c
+
+duplicate :: Storable a => Array a -> IO (Array a)
+duplicate a = dupHack undefined a
+ where
+  dupHack :: Storable b => b -> Array b -> IO (Array b)
+  dupHack dummy (Array ref) = do
+    AC es len cap <- readIORef ref
+    ary <- allocArray cap
+    withForeignPtr ary $ \dest ->
+      withForeignPtr es $ \src -> do
+        _ <- memcpy dest src (fromIntegral (len * sizeOf dummy))
+        return ()
+    Array `fmap` newIORef (AC ary len cap)
+
+length :: Array a -> IO Int
+length (Array ref) = do
+    AC _ len _ <- readIORef ref
+    return len
+
+capacity :: Array a -> IO Int
+capacity (Array ref) = do
+    AC _ _ cap <- readIORef ref
+    return cap
+
+unsafeRead :: Storable a => Array a -> Int -> IO a
+unsafeRead (Array ref) ix = do
+    AC es _ cap <- readIORef ref
+    CHECK_BOUNDS("unsafeRead",cap,ix)
+      withForeignPtr es $ \p ->
+        peekElemOff p ix
+
+unsafeWrite :: Storable a => Array a -> Int -> a -> IO ()
+unsafeWrite (Array ref) ix a = do
+    ac <- readIORef ref
+    unsafeWrite' ac ix a
+
+unsafeWrite' :: Storable a => AC a -> Int -> a -> IO ()
+unsafeWrite' (AC es _ cap) ix a = do
+    CHECK_BOUNDS("unsafeWrite'",cap,ix)
+      withForeignPtr es $ \p ->
+        pokeElemOff p ix a
+
+unsafeLoad :: Storable a => Array a -> (Ptr a -> Int -> IO Int) -> IO Int
+unsafeLoad (Array ref) load = do
+    AC es _ cap <- readIORef ref
+    len' <- withForeignPtr es $ \p -> load p cap
+    writeIORef ref (AC es len' cap)
+    return len'
+
+ensureCapacity :: Storable a => Array a -> Int -> IO ()
+ensureCapacity (Array ref) c = do
+    ac@(AC _ _ cap) <- readIORef ref
+    ac'@(AC _ _ cap') <- ensureCapacity' ac c
+    when (cap' /= cap) $
+      writeIORef ref ac'
+
+ensureCapacity' :: Storable a => AC a -> Int -> IO (AC a)
+ensureCapacity' ac@(AC es len cap) c = do
+    if c > cap
+      then do
+        es' <- reallocArray es cap' cap
+        return (AC es' len cap')
+      else
+        return ac
+  where
+    cap' = firstPowerOf2 c
+
+useAsPtr :: Array a -> (Ptr a -> Int -> IO b) -> IO b
+useAsPtr (Array ref) f = do
+    AC es len _ <- readIORef ref
+    withForeignPtr es $ \p -> f p len
+
+snoc :: Storable a => Array a -> a -> IO ()
+snoc (Array ref) e = do
+    ac@(AC _ len _) <- readIORef ref
+    let len' = len + 1
+    ac'@(AC es _ cap) <- ensureCapacity' ac len'
+    unsafeWrite' ac' len e
+    writeIORef ref (AC es len' cap)
+
+clear :: Storable a => Array a -> IO ()
+clear (Array ref) = do
+  atomicModifyIORef' ref $ \(AC es _ cap) ->
+        (AC es 0 cap, ())
+
+forM_ :: Storable a => Array a -> (a -> IO ()) -> IO ()
+forM_ ary g = forHack ary g undefined
+  where
+    forHack :: Storable b => Array b -> (b -> IO ()) -> b -> IO ()
+    forHack (Array ref) f dummy = do
+      AC es len _ <- readIORef ref
+      let size = sizeOf dummy
+          offset = len * size
+      withForeignPtr es $ \p -> do
+        let go n | n >= offset = return ()
+                 | otherwise = do
+              f =<< peek (p `plusPtr` n)
+              go (n + size)
+        go 0
+
+loop :: Storable a => Array a -> b -> (b -> a -> IO (b,Bool)) -> IO ()
+loop ary z g = loopHack ary z g undefined
+  where
+    loopHack :: Storable b => Array b -> c -> (c -> b -> IO (c,Bool)) -> b
+             -> IO ()
+    loopHack (Array ref) y f dummy = do
+      AC es len _ <- readIORef ref
+      let size = sizeOf dummy
+          offset = len * size
+      withForeignPtr es $ \p -> do
+        let go n k
+                | n >= offset = return ()
+                | otherwise = do
+                      (k',cont) <- f k =<< peek (p `plusPtr` n)
+                      when cont $ go (n + size) k'
+        go 0 y
+
+findIndex :: Storable a => (a -> Bool) -> Array a -> IO (Maybe (Int,a))
+findIndex = findHack undefined
+ where
+  findHack :: Storable b => b -> (b -> Bool) -> Array b -> IO (Maybe (Int,b))
+  findHack dummy p (Array ref) = do
+    AC es len _ <- readIORef ref
+    let size   = sizeOf dummy
+        offset = len * size
+    withForeignPtr es $ \ptr ->
+      let go !n !i
+            | n >= offset = return Nothing
+            | otherwise = do
+                val <- peek (ptr `plusPtr` n)
+                if p val
+                  then return $ Just (i, val)
+                  else go (n + size) (i + 1)
+      in  go 0 0
+
+concat :: Storable a => Array a -> Array a -> IO ()
+concat (Array d) (Array s) = do
+  da@(AC _ dlen _) <- readIORef d
+  sa@(AC _ slen _) <- readIORef s
+  writeIORef d =<< copy' da dlen sa 0 slen
+
+-- | Copy part of the source array into the destination array. The
+-- destination array is resized if not large enough.
+copy :: Storable a => Array a -> Int -> Array a -> Int -> Int -> IO ()
+copy (Array d) dstart (Array s) sstart maxCount = do
+  da <- readIORef d
+  sa <- readIORef s
+  writeIORef d =<< copy' da dstart sa sstart maxCount
+
+-- | Copy part of the source array into the destination array. The
+-- destination array is resized if not large enough.
+copy' :: Storable a => AC a -> Int -> AC a -> Int -> Int -> IO (AC a)
+copy' d dstart s sstart maxCount = copyHack d s undefined
+ where
+  copyHack :: Storable b => AC b -> AC b -> b -> IO (AC b)
+  copyHack dac@(AC _ oldLen _) (AC src slen _) dummy = do
+    when (maxCount < 0 || dstart < 0 || dstart > oldLen || sstart < 0 ||
+          sstart > slen) $ error "copy: bad offsets or lengths"
+    let size = sizeOf dummy
+        count = min maxCount (slen - sstart)
+    if count == 0
+      then return dac
+      else do
+        AC dst dlen dcap <- ensureCapacity' dac (dstart + count)
+        withForeignPtr dst $ \dptr ->
+          withForeignPtr src $ \sptr -> do
+            _ <- memcpy (dptr `plusPtr` (dstart * size))
+                        (sptr `plusPtr` (sstart * size))
+                        (fromIntegral (count * size))
+            return $ AC dst (max dlen (dstart + count)) dcap
+
+removeAt :: Storable a => Array a -> Int -> IO ()
+removeAt a i = removeHack a undefined
+ where
+  removeHack :: Storable b => Array b -> b -> IO ()
+  removeHack (Array ary) dummy = do
+    AC fp oldLen cap <- readIORef ary
+    when (i < 0 || i >= oldLen) $ error "removeAt: invalid index"
+    let size   = sizeOf dummy
+        newLen = oldLen - 1
+    when (newLen > 0 && i < newLen) .
+      withForeignPtr fp $ \ptr -> do
+        _ <- memmove (ptr `plusPtr` (size * i))
+                     (ptr `plusPtr` (size * (i+1)))
+                     (fromIntegral (size * (newLen-i)))
+        return ()
+    writeIORef ary (AC fp newLen cap)
+
+{-The firstPowerOf2 function works by setting all bits on the right-hand
+side of the most significant flagged bit to 1, and then incrementing
+the entire value at the end so it "rolls over" to the nearest power of
+two.
+-}
+
+-- | Computes the next-highest power of two for a particular integer,
+-- @n@.  If @n@ is already a power of two, returns @n@.  If @n@ is
+-- zero, returns zero, even though zero is not a power of two.
+firstPowerOf2 :: Int -> Int
+firstPowerOf2 !n =
+    let !n1 = n - 1
+        !n2 = n1 .|. (n1 `shiftR` 1)
+        !n3 = n2 .|. (n2 `shiftR` 2)
+        !n4 = n3 .|. (n3 `shiftR` 4)
+        !n5 = n4 .|. (n4 `shiftR` 8)
+        !n6 = n5 .|. (n5 `shiftR` 16)
+#if WORD_SIZE_IN_BITS == 32
+    in n6 + 1
+#elif WORD_SIZE_IN_BITS == 64
+        !n7 = n6 .|. (n6 `shiftR` 32)
+    in n7 + 1
+#else
+# error firstPowerOf2 not defined on this architecture
+#endif
+
+foreign import ccall unsafe "string.h memcpy"
+    memcpy :: Ptr a -> Ptr a -> CSize -> IO (Ptr a)
+
+foreign import ccall unsafe "string.h memmove"
+    memmove :: Ptr a -> Ptr a -> CSize -> IO (Ptr a)
+
diff --git a/libraries/base/GHC/Event/Clock.hsc b/libraries/base/GHC/Event/Clock.hsc
new file mode 100644
index 000000000000..5dbdb674d312
--- /dev/null
+++ b/libraries/base/GHC/Event/Clock.hsc
@@ -0,0 +1,17 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+
+module GHC.Event.Clock (getMonotonicTime) where
+
+import GHC.Base
+import GHC.Real
+import Data.Word
+
+-- | Return monotonic time in seconds, since some unspecified starting point
+getMonotonicTime :: IO Double
+getMonotonicTime = do w <- getMonotonicNSec
+                      return (fromIntegral w / 1000000000)
+
+foreign import ccall unsafe "getMonotonicNSec"
+    getMonotonicNSec :: IO Word64
+
diff --git a/libraries/base/GHC/Event/Control.hs b/libraries/base/GHC/Event/Control.hs
new file mode 100644
index 000000000000..2951a6a6819f
--- /dev/null
+++ b/libraries/base/GHC/Event/Control.hs
@@ -0,0 +1,208 @@
+{-# LANGUAGE Unsafe #-}
+{-# LANGUAGE CPP
+           , NoImplicitPrelude
+           , ScopedTypeVariables
+           , BangPatterns
+  #-}
+
+module GHC.Event.Control
+    (
+    -- * Managing the IO manager
+      Signal
+    , ControlMessage(..)
+    , Control
+    , newControl
+    , closeControl
+    -- ** Control message reception
+    , readControlMessage
+    -- *** File descriptors
+    , controlReadFd
+    , wakeupReadFd
+    -- ** Control message sending
+    , sendWakeup
+    , sendDie
+    -- * Utilities
+    , setNonBlockingFD
+    ) where
+
+#include "EventConfig.h"
+
+import Control.Monad (when)
+import Foreign.ForeignPtr (ForeignPtr)
+import GHC.Base
+import GHC.Conc.Signal (Signal)
+import GHC.Real (fromIntegral)
+import GHC.Show (Show)
+import GHC.Word (Word8)
+import Foreign.C.Error (throwErrnoIfMinus1_)
+import Foreign.C.Types (CInt(..), CSize(..))
+import Foreign.ForeignPtr (mallocForeignPtrBytes, withForeignPtr)
+import Foreign.Marshal (alloca, allocaBytes)
+import Foreign.Marshal.Array (allocaArray)
+import Foreign.Ptr (castPtr)
+import Foreign.Storable (peek, peekElemOff, poke)
+import System.Posix.Internals (c_close, c_pipe, c_read, c_write,
+                               setCloseOnExec, setNonBlockingFD)
+import System.Posix.Types (Fd)
+
+#if defined(HAVE_EVENTFD)
+import Foreign.C.Error (throwErrnoIfMinus1)
+import Foreign.C.Types (CULLong(..))
+#else
+import Foreign.C.Error (eAGAIN, eWOULDBLOCK, getErrno, throwErrno)
+#endif
+
+data ControlMessage = CMsgWakeup
+                    | CMsgDie
+                    | CMsgSignal {-# UNPACK #-} !(ForeignPtr Word8)
+                                 {-# UNPACK #-} !Signal
+    deriving (Eq, Show)
+
+-- | The structure used to tell the IO manager thread what to do.
+data Control = W {
+      controlReadFd  :: {-# UNPACK #-} !Fd
+    , controlWriteFd :: {-# UNPACK #-} !Fd
+#if defined(HAVE_EVENTFD)
+    , controlEventFd :: {-# UNPACK #-} !Fd
+#else
+    , wakeupReadFd   :: {-# UNPACK #-} !Fd
+    , wakeupWriteFd  :: {-# UNPACK #-} !Fd
+#endif
+    } deriving (Show)
+
+#if defined(HAVE_EVENTFD)
+wakeupReadFd :: Control -> Fd
+wakeupReadFd = controlEventFd
+{-# INLINE wakeupReadFd #-}
+#endif
+
+-- | Create the structure (usually a pipe) used for waking up the IO
+-- manager thread from another thread.
+newControl :: Bool -> IO Control
+newControl shouldRegister = allocaArray 2 $ \fds -> do
+  let createPipe = do
+        throwErrnoIfMinus1_ "pipe" $ c_pipe fds
+        rd <- peekElemOff fds 0
+        wr <- peekElemOff fds 1
+        -- The write end must be non-blocking, since we may need to
+        -- poke the event manager from a signal handler.
+        setNonBlockingFD wr True
+        setCloseOnExec rd
+        setCloseOnExec wr
+        return (rd, wr)
+  (ctrl_rd, ctrl_wr) <- createPipe
+  when shouldRegister $ c_setIOManagerControlFd ctrl_wr
+#if defined(HAVE_EVENTFD)
+  ev <- throwErrnoIfMinus1 "eventfd" $ c_eventfd 0 0
+  setNonBlockingFD ev True
+  setCloseOnExec ev
+  when shouldRegister $ c_setIOManagerWakeupFd ev
+#else
+  (wake_rd, wake_wr) <- createPipe
+  when shouldRegister $ c_setIOManagerWakeupFd wake_wr
+#endif
+  return W { controlReadFd  = fromIntegral ctrl_rd
+           , controlWriteFd = fromIntegral ctrl_wr
+#if defined(HAVE_EVENTFD)
+           , controlEventFd = fromIntegral ev
+#else
+           , wakeupReadFd   = fromIntegral wake_rd
+           , wakeupWriteFd  = fromIntegral wake_wr
+#endif
+           }
+
+-- | Close the control structure used by the IO manager thread.
+closeControl :: Control -> IO ()
+closeControl w = do
+  _ <- c_close . fromIntegral . controlReadFd $ w
+  _ <- c_close . fromIntegral . controlWriteFd $ w
+#if defined(HAVE_EVENTFD)
+  _ <- c_close . fromIntegral . controlEventFd $ w
+#else
+  _ <- c_close . fromIntegral . wakeupReadFd $ w
+  _ <- c_close . fromIntegral . wakeupWriteFd $ w
+#endif
+  return ()
+
+io_MANAGER_WAKEUP, io_MANAGER_DIE :: Word8
+io_MANAGER_WAKEUP = 0xff
+io_MANAGER_DIE    = 0xfe
+
+foreign import ccall "__hscore_sizeof_siginfo_t"
+    sizeof_siginfo_t :: CSize
+
+readControlMessage :: Control -> Fd -> IO ControlMessage
+readControlMessage ctrl fd
+    | fd == wakeupReadFd ctrl = allocaBytes wakeupBufferSize $ \p -> do
+                    throwErrnoIfMinus1_ "readWakeupMessage" $
+                      c_read (fromIntegral fd) p (fromIntegral wakeupBufferSize)
+                    return CMsgWakeup
+    | otherwise =
+        alloca $ \p -> do
+            throwErrnoIfMinus1_ "readControlMessage" $
+                c_read (fromIntegral fd) p 1
+            s <- peek p
+            case s of
+                -- Wakeup messages shouldn't be sent on the control
+                -- file descriptor but we handle them anyway.
+                _ | s == io_MANAGER_WAKEUP -> return CMsgWakeup
+                _ | s == io_MANAGER_DIE    -> return CMsgDie
+                _ -> do  -- Signal
+                    fp <- mallocForeignPtrBytes (fromIntegral sizeof_siginfo_t)
+                    withForeignPtr fp $ \p_siginfo -> do
+                        r <- c_read (fromIntegral fd) (castPtr p_siginfo)
+                             sizeof_siginfo_t
+                        when (r /= fromIntegral sizeof_siginfo_t) $
+                            error "failed to read siginfo_t"
+                        let !s' = fromIntegral s
+                        return $ CMsgSignal fp s'
+
+  where wakeupBufferSize =
+#if defined(HAVE_EVENTFD)
+            8
+#else
+            4096
+#endif
+
+sendWakeup :: Control -> IO ()
+#if defined(HAVE_EVENTFD)
+sendWakeup c =
+  throwErrnoIfMinus1_ "sendWakeup" $
+  c_eventfd_write (fromIntegral (controlEventFd c)) 1
+#else
+sendWakeup c = do
+  n <- sendMessage (wakeupWriteFd c) CMsgWakeup
+  case n of
+    _ | n /= -1   -> return ()
+      | otherwise -> do
+                   errno <- getErrno
+                   when (errno /= eAGAIN && errno /= eWOULDBLOCK) $
+                     throwErrno "sendWakeup"
+#endif
+
+sendDie :: Control -> IO ()
+sendDie c = throwErrnoIfMinus1_ "sendDie" $
+            sendMessage (controlWriteFd c) CMsgDie
+
+sendMessage :: Fd -> ControlMessage -> IO Int
+sendMessage fd msg = alloca $ \p -> do
+  case msg of
+    CMsgWakeup        -> poke p io_MANAGER_WAKEUP
+    CMsgDie           -> poke p io_MANAGER_DIE
+    CMsgSignal _fp _s -> error "Signals can only be sent from within the RTS"
+  fromIntegral `fmap` c_write (fromIntegral fd) p 1
+
+#if defined(HAVE_EVENTFD)
+foreign import ccall unsafe "sys/eventfd.h eventfd"
+   c_eventfd :: CInt -> CInt -> IO CInt
+
+foreign import ccall unsafe "sys/eventfd.h eventfd_write"
+   c_eventfd_write :: CInt -> CULLong -> IO CInt
+#endif
+
+-- Used to tell the RTS how it can send messages to the I/O manager.
+foreign import ccall "setIOManagerControlFd"
+   c_setIOManagerControlFd :: CInt -> IO ()
+
+foreign import ccall "setIOManagerWakeupFd"
+   c_setIOManagerWakeupFd :: CInt -> IO ()
diff --git a/libraries/base/GHC/Event/EPoll.hsc b/libraries/base/GHC/Event/EPoll.hsc
new file mode 100644
index 000000000000..b808b21e961d
--- /dev/null
+++ b/libraries/base/GHC/Event/EPoll.hsc
@@ -0,0 +1,242 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving
+           , NoImplicitPrelude
+           , BangPatterns
+  #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- A binding to the epoll I/O event notification facility
+--
+-- epoll is a variant of poll that can be used either as an edge-triggered or
+-- a level-triggered interface and scales well to large numbers of watched file
+-- descriptors.
+--
+-- epoll decouples monitor an fd from the process of registering it.
+--
+-----------------------------------------------------------------------------
+
+module GHC.Event.EPoll
+    (
+      new
+    , available
+    ) where
+
+import qualified GHC.Event.Internal as E
+
+#include "EventConfig.h"
+#if !defined(HAVE_EPOLL)
+import GHC.Base
+
+new :: IO E.Backend
+new = error "EPoll back end not implemented for this platform"
+
+available :: Bool
+available = False
+{-# INLINE available #-}
+#else
+
+#include <sys/epoll.h>
+
+import Control.Monad (when)
+import Data.Bits (Bits, FiniteBits, (.|.), (.&.))
+import Data.Maybe (Maybe(..))
+import Data.Monoid (Monoid(..))
+import Data.Word (Word32)
+import Foreign.C.Error (eNOENT, getErrno, throwErrno,
+                        throwErrnoIfMinus1, throwErrnoIfMinus1_)
+import Foreign.C.Types (CInt(..))
+import Foreign.Marshal.Utils (with)
+import Foreign.Ptr (Ptr)
+import Foreign.Storable (Storable(..))
+import GHC.Base
+import GHC.Num (Num(..))
+import GHC.Real (ceiling, fromIntegral)
+import GHC.Show (Show)
+import System.Posix.Internals (c_close)
+import System.Posix.Internals (setCloseOnExec)
+import System.Posix.Types (Fd(..))
+
+import qualified GHC.Event.Array    as A
+import           GHC.Event.Internal (Timeout(..))
+
+available :: Bool
+available = True
+{-# INLINE available #-}
+
+data EPoll = EPoll {
+      epollFd     :: {-# UNPACK #-} !EPollFd
+    , epollEvents :: {-# UNPACK #-} !(A.Array Event)
+    }
+
+-- | Create a new epoll backend.
+new :: IO E.Backend
+new = do
+  epfd <- epollCreate
+  evts <- A.new 64
+  let !be = E.backend poll modifyFd modifyFdOnce delete (EPoll epfd evts)
+  return be
+
+delete :: EPoll -> IO ()
+delete be = do
+  _ <- c_close . fromEPollFd . epollFd $ be
+  return ()
+
+-- | Change the set of events we are interested in for a given file
+-- descriptor.
+modifyFd :: EPoll -> Fd -> E.Event -> E.Event -> IO Bool
+modifyFd ep fd oevt nevt =
+  with (Event (fromEvent nevt) fd) $ \evptr -> do
+    epollControl (epollFd ep) op fd evptr
+    return True
+  where op | oevt == mempty = controlOpAdd
+           | nevt == mempty = controlOpDelete
+           | otherwise      = controlOpModify
+
+modifyFdOnce :: EPoll -> Fd -> E.Event -> IO Bool
+modifyFdOnce ep fd evt =
+  do let !ev = fromEvent evt .|. epollOneShot
+     res <- with (Event ev fd) $
+            epollControl_ (epollFd ep) controlOpModify fd
+     if res == 0
+       then return True
+       else do err <- getErrno
+               if err == eNOENT
+                 then with (Event ev fd) $ \evptr -> do
+                        epollControl (epollFd ep) controlOpAdd fd evptr
+                        return True
+                 else throwErrno "modifyFdOnce"
+
+-- | Select a set of file descriptors which are ready for I/O
+-- operations and call @f@ for all ready file descriptors, passing the
+-- events that are ready.
+poll :: EPoll                     -- ^ state
+     -> Maybe Timeout             -- ^ timeout in milliseconds
+     -> (Fd -> E.Event -> IO ())  -- ^ I/O callback
+     -> IO Int
+poll ep mtimeout f = do
+  let events = epollEvents ep
+      fd = epollFd ep
+
+  -- Will return zero if the system call was interupted, in which case
+  -- we just return (and try again later.)
+  n <- A.unsafeLoad events $ \es cap -> case mtimeout of
+    Just timeout -> epollWait fd es cap $ fromTimeout timeout
+    Nothing      -> epollWaitNonBlock fd es cap
+
+  when (n > 0) $ do
+    A.forM_ events $ \e -> f (eventFd e) (toEvent (eventTypes e))
+    cap <- A.capacity events
+    when (cap == n) $ A.ensureCapacity events (2 * cap)
+  return n
+
+newtype EPollFd = EPollFd {
+      fromEPollFd :: CInt
+    } deriving (Eq, Show)
+
+data Event = Event {
+      eventTypes :: EventType
+    , eventFd    :: Fd
+    } deriving (Show)
+
+instance Storable Event where
+    sizeOf    _ = #size struct epoll_event
+    alignment _ = alignment (undefined :: CInt)
+
+    peek ptr = do
+        ets <- #{peek struct epoll_event, events} ptr
+        ed  <- #{peek struct epoll_event, data.fd}   ptr
+        let !ev = Event (EventType ets) ed
+        return ev
+
+    poke ptr e = do
+        #{poke struct epoll_event, events} ptr (unEventType $ eventTypes e)
+        #{poke struct epoll_event, data.fd}   ptr (eventFd e)
+
+newtype ControlOp = ControlOp CInt
+
+#{enum ControlOp, ControlOp
+ , controlOpAdd    = EPOLL_CTL_ADD
+ , controlOpModify = EPOLL_CTL_MOD
+ , controlOpDelete = EPOLL_CTL_DEL
+ }
+
+newtype EventType = EventType {
+      unEventType :: Word32
+    } deriving (Show, Eq, Num, Bits, FiniteBits)
+
+#{enum EventType, EventType
+ , epollIn  = EPOLLIN
+ , epollOut = EPOLLOUT
+ , epollErr = EPOLLERR
+ , epollHup = EPOLLHUP
+ , epollOneShot = EPOLLONESHOT              
+ }
+
+-- | Create a new epoll context, returning a file descriptor associated with the context.
+-- The fd may be used for subsequent calls to this epoll context.
+--
+-- The size parameter to epoll_create is a hint about the expected number of handles.
+--
+-- The file descriptor returned from epoll_create() should be destroyed via
+-- a call to close() after polling is finished
+--
+epollCreate :: IO EPollFd
+epollCreate = do
+  fd <- throwErrnoIfMinus1 "epollCreate" $
+        c_epoll_create 256 -- argument is ignored
+  setCloseOnExec fd
+  let !epollFd' = EPollFd fd
+  return epollFd'
+
+epollControl :: EPollFd -> ControlOp -> Fd -> Ptr Event -> IO ()
+epollControl epfd op fd event =
+    throwErrnoIfMinus1_ "epollControl" $ epollControl_ epfd op fd event
+
+epollControl_ :: EPollFd -> ControlOp -> Fd -> Ptr Event -> IO CInt
+epollControl_ (EPollFd epfd) (ControlOp op) (Fd fd) event =
+    c_epoll_ctl epfd op fd event
+
+epollWait :: EPollFd -> Ptr Event -> Int -> Int -> IO Int
+epollWait (EPollFd epfd) events numEvents timeout =
+    fmap fromIntegral .
+    E.throwErrnoIfMinus1NoRetry "epollWait" $
+    c_epoll_wait epfd events (fromIntegral numEvents) (fromIntegral timeout)
+
+epollWaitNonBlock :: EPollFd -> Ptr Event -> Int -> IO Int
+epollWaitNonBlock (EPollFd epfd) events numEvents =
+  fmap fromIntegral .
+  E.throwErrnoIfMinus1NoRetry "epollWaitNonBlock" $
+  c_epoll_wait_unsafe epfd events (fromIntegral numEvents) 0
+
+fromEvent :: E.Event -> EventType
+fromEvent e = remap E.evtRead  epollIn .|.
+              remap E.evtWrite epollOut
+  where remap evt to
+            | e `E.eventIs` evt = to
+            | otherwise         = 0
+
+toEvent :: EventType -> E.Event
+toEvent e = remap (epollIn  .|. epollErr .|. epollHup) E.evtRead `mappend`
+            remap (epollOut .|. epollErr .|. epollHup) E.evtWrite
+  where remap evt to
+            | e .&. evt /= 0 = to
+            | otherwise      = mempty
+
+fromTimeout :: Timeout -> Int
+fromTimeout Forever     = -1
+fromTimeout (Timeout s) = ceiling $ 1000 * s
+
+foreign import ccall unsafe "sys/epoll.h epoll_create"
+    c_epoll_create :: CInt -> IO CInt
+
+foreign import ccall unsafe "sys/epoll.h epoll_ctl"
+    c_epoll_ctl :: CInt -> CInt -> CInt -> Ptr Event -> IO CInt
+
+foreign import ccall safe "sys/epoll.h epoll_wait"
+    c_epoll_wait :: CInt -> Ptr Event -> CInt -> CInt -> IO CInt
+
+foreign import ccall unsafe "sys/epoll.h epoll_wait"
+    c_epoll_wait_unsafe :: CInt -> Ptr Event -> CInt -> CInt -> IO CInt
+#endif /* defined(HAVE_EPOLL) */
+
diff --git a/libraries/base/GHC/Event/IntTable.hs b/libraries/base/GHC/Event/IntTable.hs
new file mode 100644
index 000000000000..d8cbcc0d45eb
--- /dev/null
+++ b/libraries/base/GHC/Event/IntTable.hs
@@ -0,0 +1,141 @@
+{-# LANGUAGE BangPatterns, NoImplicitPrelude, RecordWildCards, Trustworthy #-}
+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
+
+module GHC.Event.IntTable
+    (
+      IntTable
+    , new
+    , lookup
+    , insertWith
+    , reset
+    , delete
+    , updateWith
+    ) where
+
+import Control.Monad ((=<<), liftM, unless, when)
+import Data.Bits ((.&.), shiftL, shiftR)
+import Data.IORef (IORef, newIORef, readIORef, writeIORef)
+import Data.Maybe (Maybe(..), isJust)
+import Foreign.ForeignPtr (ForeignPtr, mallocForeignPtr, withForeignPtr)
+import Foreign.Storable (peek, poke)
+import GHC.Base (Monad(..), ($), const, otherwise)
+import GHC.Classes (Eq(..), Ord(..))
+import GHC.Event.Arr (Arr)
+import GHC.Num (Num(..))
+import GHC.Prim (seq)
+import GHC.Types (Bool(..), IO(..), Int(..))
+import qualified GHC.Event.Arr as Arr
+
+-- A very simple chained integer-keyed mutable hash table. We use
+-- power-of-two sizing, grow at a load factor of 0.75, and never
+-- shrink. The "hash function" is the identity function.
+
+newtype IntTable a = IntTable (IORef (IT a))
+
+data IT a = IT {
+      tabArr  :: {-# UNPACK #-} !(Arr (Bucket a))
+    , tabSize :: {-# UNPACK #-} !(ForeignPtr Int)
+    }
+
+data Bucket a = Empty
+              | Bucket {
+      bucketKey   :: {-# UNPACK #-} !Int
+    , bucketValue :: a
+    , bucketNext  :: Bucket a
+    }
+
+lookup :: Int -> IntTable a -> IO (Maybe a)
+lookup k (IntTable ref) = do
+  let go Bucket{..}
+        | bucketKey == k = return (Just bucketValue)
+        | otherwise      = go bucketNext
+      go _ = return Nothing
+  it@IT{..} <- readIORef ref
+  go =<< Arr.read tabArr (indexOf k it)
+
+new :: Int -> IO (IntTable a)
+new capacity = IntTable `liftM` (newIORef =<< new_ capacity)
+
+new_ :: Int -> IO (IT a)
+new_ capacity = do
+  arr <- Arr.new Empty capacity
+  size <- mallocForeignPtr
+  withForeignPtr size $ \ptr -> poke ptr 0
+  return IT { tabArr = arr
+            , tabSize = size
+            }
+
+grow :: IT a -> IORef (IT a) -> Int -> IO ()
+grow oldit ref size = do
+  newit <- new_ (Arr.size (tabArr oldit) `shiftL` 1)
+  let copySlot n !i
+        | n == size = return ()
+        | otherwise = do
+          let copyBucket !m Empty          = copySlot m (i+1)
+              copyBucket  m bkt@Bucket{..} = do
+                let idx = indexOf bucketKey newit
+                next <- Arr.read (tabArr newit) idx
+                Arr.write (tabArr newit) idx bkt { bucketNext = next }
+                copyBucket (m+1) bucketNext
+          copyBucket n =<< Arr.read (tabArr oldit) i
+  copySlot 0 0
+  withForeignPtr (tabSize newit) $ \ptr -> poke ptr size
+  writeIORef ref newit
+
+insertWith :: (a -> a -> a) -> Int -> a -> IntTable a -> IO (Maybe a)
+insertWith f k v inttable@(IntTable ref) = do
+  it@IT{..} <- readIORef ref
+  let idx = indexOf k it
+      go seen bkt@Bucket{..}
+        | bucketKey == k = do
+          let !v' = f v bucketValue
+              !next = seen <> bucketNext
+              Empty        <> bs = bs
+              b@Bucket{..} <> bs = b { bucketNext = bucketNext <> bs }
+          Arr.write tabArr idx (Bucket k v' next)
+          return (Just bucketValue)
+        | otherwise = go bkt { bucketNext = seen } bucketNext
+      go seen _ = withForeignPtr tabSize $ \ptr -> do
+        size <- peek ptr
+        if size + 1 >= Arr.size tabArr - (Arr.size tabArr `shiftR` 2)
+          then grow it ref size >> insertWith f k v inttable
+          else do
+            v `seq` Arr.write tabArr idx (Bucket k v seen)
+            poke ptr (size + 1)
+            return Nothing
+  go Empty =<< Arr.read tabArr idx
+{-# INLINABLE insertWith #-}
+
+-- | Used to undo the effect of a prior insertWith.
+reset :: Int -> Maybe a -> IntTable a -> IO ()
+reset k (Just v) tbl = insertWith const k v tbl >> return ()
+reset k Nothing  tbl = delete k tbl >> return ()
+
+indexOf :: Int -> IT a -> Int
+indexOf k IT{..} = k .&. (Arr.size tabArr - 1)
+
+delete :: Int -> IntTable a -> IO (Maybe a)
+delete k t = updateWith (const Nothing) k t
+
+updateWith :: (a -> Maybe a) -> Int -> IntTable a -> IO (Maybe a)
+updateWith f k (IntTable ref) = do
+  it@IT{..} <- readIORef ref
+  let idx = indexOf k it
+      go changed bkt@Bucket{..}
+        | bucketKey == k =
+            let fbv = f bucketValue
+                !nb = case fbv of
+                        Just val -> bkt { bucketValue = val }
+                        Nothing  -> bucketNext
+            in (fbv, Just bucketValue, nb)
+        | otherwise = case go changed bucketNext of
+                        (fbv, ov, nb) -> (fbv, ov, bkt { bucketNext = nb })
+      go _ e = (Nothing, Nothing, e)
+  (fbv, oldVal, newBucket) <- go False `liftM` Arr.read tabArr idx
+  when (isJust oldVal) $ do
+    Arr.write tabArr idx newBucket
+    unless (isJust fbv) $
+      withForeignPtr tabSize $ \ptr -> do
+        size <- peek ptr
+        poke ptr (size - 1)
+  return oldVal
diff --git a/libraries/base/GHC/Event/Internal.hs b/libraries/base/GHC/Event/Internal.hs
new file mode 100644
index 000000000000..a4c2e10d3222
--- /dev/null
+++ b/libraries/base/GHC/Event/Internal.hs
@@ -0,0 +1,159 @@
+{-# LANGUAGE Unsafe #-}
+{-# LANGUAGE ExistentialQuantification, NoImplicitPrelude #-}
+
+module GHC.Event.Internal
+    (
+    -- * Event back end
+      Backend
+    , backend
+    , delete
+    , poll
+    , modifyFd
+    , modifyFdOnce
+    -- * Event type
+    , Event
+    , evtRead
+    , evtWrite
+    , evtClose
+    , eventIs
+    -- * Timeout type
+    , Timeout(..)
+    -- * Helpers
+    , throwErrnoIfMinus1NoRetry
+    ) where
+
+import Data.Bits ((.|.), (.&.))
+import Data.List (foldl', intercalate)
+import Data.Maybe (Maybe(..))
+import Data.Monoid (Monoid(..))
+import Foreign.C.Error (eINTR, getErrno, throwErrno)
+import System.Posix.Types (Fd)
+import GHC.Base
+import GHC.Num (Num(..))
+import GHC.Show (Show(..))
+import GHC.List (filter, null)
+
+-- | An I\/O event.
+newtype Event = Event Int
+    deriving (Eq)
+
+evtNothing :: Event
+evtNothing = Event 0
+{-# INLINE evtNothing #-}
+
+-- | Data is available to be read.
+evtRead :: Event
+evtRead = Event 1
+{-# INLINE evtRead #-}
+
+-- | The file descriptor is ready to accept a write.
+evtWrite :: Event
+evtWrite = Event 2
+{-# INLINE evtWrite #-}
+
+-- | Another thread closed the file descriptor.
+evtClose :: Event
+evtClose = Event 4
+{-# INLINE evtClose #-}
+
+eventIs :: Event -> Event -> Bool
+eventIs (Event a) (Event b) = a .&. b /= 0
+
+instance Show Event where
+    show e = '[' : (intercalate "," . filter (not . null) $
+                    [evtRead `so` "evtRead",
+                     evtWrite `so` "evtWrite",
+                     evtClose `so` "evtClose"]) ++ "]"
+        where ev `so` disp | e `eventIs` ev = disp
+                           | otherwise      = ""
+
+instance Monoid Event where
+    mempty  = evtNothing
+    mappend = evtCombine
+    mconcat = evtConcat
+
+evtCombine :: Event -> Event -> Event
+evtCombine (Event a) (Event b) = Event (a .|. b)
+{-# INLINE evtCombine #-}
+
+evtConcat :: [Event] -> Event
+evtConcat = foldl' evtCombine evtNothing
+{-# INLINE evtConcat #-}
+
+-- | A type alias for timeouts, specified in seconds.
+data Timeout = Timeout {-# UNPACK #-} !Double
+             | Forever
+               deriving (Show)
+
+-- | Event notification backend.
+data Backend = forall a. Backend {
+      _beState :: !a
+
+    -- | Poll backend for new events.  The provided callback is called
+    -- once per file descriptor with new events.
+    , _bePoll :: a                          -- backend state
+              -> Maybe Timeout              -- timeout in milliseconds ('Nothing' for non-blocking poll)
+              -> (Fd -> Event -> IO ())     -- I/O callback
+              -> IO Int
+
+    -- | Register, modify, or unregister interest in the given events
+    -- on the given file descriptor.
+    , _beModifyFd :: a
+                  -> Fd       -- file descriptor
+                  -> Event    -- old events to watch for ('mempty' for new)
+                  -> Event    -- new events to watch for ('mempty' to delete)
+                  -> IO Bool
+
+    , _beModifyFdOnce :: a
+                         -> Fd    -- file descriptor
+                         -> Event -- new events to watch
+                         -> IO Bool
+
+    , _beDelete :: a -> IO ()
+    }
+
+backend :: (a -> Maybe Timeout -> (Fd -> Event -> IO ()) -> IO Int)
+        -> (a -> Fd -> Event -> Event -> IO Bool)
+        -> (a -> Fd -> Event -> IO Bool)
+        -> (a -> IO ())
+        -> a
+        -> Backend
+backend bPoll bModifyFd bModifyFdOnce bDelete state =
+  Backend state bPoll bModifyFd bModifyFdOnce bDelete
+{-# INLINE backend #-}
+
+poll :: Backend -> Maybe Timeout -> (Fd -> Event -> IO ()) -> IO Int
+poll (Backend bState bPoll _ _ _) = bPoll bState
+{-# INLINE poll #-}
+
+-- | Returns 'True' if the modification succeeded.
+-- Returns 'False' if this backend does not support
+-- event notifications on this type of file.
+modifyFd :: Backend -> Fd -> Event -> Event -> IO Bool
+modifyFd (Backend bState _ bModifyFd _ _) = bModifyFd bState
+{-# INLINE modifyFd #-}
+
+-- | Returns 'True' if the modification succeeded.
+-- Returns 'False' if this backend does not support
+-- event notifications on this type of file.
+modifyFdOnce :: Backend -> Fd -> Event -> IO Bool
+modifyFdOnce (Backend bState _ _ bModifyFdOnce _) = bModifyFdOnce bState
+{-# INLINE modifyFdOnce #-}
+
+delete :: Backend -> IO ()
+delete (Backend bState _ _ _ bDelete) = bDelete bState
+{-# INLINE delete #-}
+
+-- | Throw an 'IOError' corresponding to the current value of
+-- 'getErrno' if the result value of the 'IO' action is -1 and
+-- 'getErrno' is not 'eINTR'.  If the result value is -1 and
+-- 'getErrno' returns 'eINTR' 0 is returned.  Otherwise the result
+-- value is returned.
+throwErrnoIfMinus1NoRetry :: (Eq a, Num a) => String -> IO a -> IO a
+throwErrnoIfMinus1NoRetry loc f = do
+    res <- f
+    if res == -1
+        then do
+            err <- getErrno
+            if err == eINTR then return 0 else throwErrno loc
+        else return res
diff --git a/libraries/base/GHC/Event/KQueue.hsc b/libraries/base/GHC/Event/KQueue.hsc
new file mode 100644
index 000000000000..bc88855961cf
--- /dev/null
+++ b/libraries/base/GHC/Event/KQueue.hsc
@@ -0,0 +1,297 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE CApiFFI
+           , GeneralizedNewtypeDeriving
+           , NoImplicitPrelude
+           , RecordWildCards
+           , BangPatterns
+  #-}
+
+module GHC.Event.KQueue
+    (
+      new
+    , available
+    ) where
+
+import qualified GHC.Event.Internal as E
+
+#include "EventConfig.h"
+#if !defined(HAVE_KQUEUE)
+import GHC.Base
+
+new :: IO E.Backend
+new = error "KQueue back end not implemented for this platform"
+
+available :: Bool
+available = False
+{-# INLINE available #-}
+#else
+
+import Control.Monad (when)
+import Data.Bits (Bits(..), FiniteBits(..))
+import Data.Maybe (Maybe(..))
+import Data.Monoid (Monoid(..))
+import Data.Word (Word16, Word32)
+import Foreign.C.Error (throwErrnoIfMinus1, eINTR, eINVAL,
+                        eNOTSUP, getErrno, throwErrno)
+import Foreign.C.Types
+import Foreign.Marshal.Alloc (alloca)
+import Foreign.Ptr (Ptr, nullPtr)
+import Foreign.Storable (Storable(..))
+import GHC.Base
+import GHC.Enum (toEnum)
+import GHC.Num (Num(..))
+import GHC.Real (ceiling, floor, fromIntegral)
+import GHC.Show (Show(show))
+import GHC.Event.Internal (Timeout(..))
+import System.Posix.Internals (c_close)
+import System.Posix.Types (Fd(..))
+import qualified GHC.Event.Array as A
+
+#if defined(netbsd_HOST_OS)
+import Data.Int (Int64)
+#endif
+
+#include <sys/types.h>
+#include <sys/event.h>
+#include <sys/time.h>
+
+-- Handle brokenness on some BSD variants, notably OS X up to at least
+-- 10.6.  If NOTE_EOF isn't available, we have no way to receive a
+-- notification from the kernel when we reach EOF on a plain file.
+#ifndef NOTE_EOF
+# define NOTE_EOF 0
+#endif
+
+available :: Bool
+available = True
+{-# INLINE available #-}
+
+------------------------------------------------------------------------
+-- Exported interface
+
+data KQueue = KQueue {
+      kqueueFd     :: {-# UNPACK #-} !KQueueFd
+    , kqueueEvents :: {-# UNPACK #-} !(A.Array Event)
+    }
+
+new :: IO E.Backend
+new = do
+  kqfd <- kqueue
+  events <- A.new 64
+  let !be = E.backend poll modifyFd modifyFdOnce delete (KQueue kqfd events)
+  return be
+
+delete :: KQueue -> IO ()
+delete kq = do
+  _ <- c_close . fromKQueueFd . kqueueFd $ kq
+  return ()
+
+modifyFd :: KQueue -> Fd -> E.Event -> E.Event -> IO Bool
+modifyFd kq fd oevt nevt
+  | nevt == mempty = do
+      let !ev = event fd (toFilter oevt) flagDelete noteEOF
+      kqueueControl (kqueueFd kq) ev
+  | otherwise      = do
+      let !ev = event fd (toFilter nevt) flagAdd noteEOF
+      kqueueControl (kqueueFd kq) ev
+
+toFilter :: E.Event -> Filter
+toFilter evt
+  | evt `E.eventIs` E.evtRead = filterRead
+  | otherwise                 = filterWrite
+
+modifyFdOnce :: KQueue -> Fd -> E.Event -> IO Bool
+modifyFdOnce kq fd evt = do
+    let !ev = event fd (toFilter evt) (flagAdd .|. flagOneshot) noteEOF
+    kqueueControl (kqueueFd kq) ev
+
+poll :: KQueue
+     -> Maybe Timeout
+     -> (Fd -> E.Event -> IO ())
+     -> IO Int
+poll kq mtimeout f = do
+    let events = kqueueEvents kq
+        fd = kqueueFd kq
+
+    n <- A.unsafeLoad events $ \es cap -> case mtimeout of
+      Just timeout -> kqueueWait fd es cap $ fromTimeout timeout
+      Nothing      -> kqueueWaitNonBlock fd es cap
+
+    when (n > 0) $ do
+        A.forM_ events $ \e -> f (fromIntegral (ident e)) (toEvent (filter e))
+        cap <- A.capacity events
+        when (n == cap) $ A.ensureCapacity events (2 * cap)
+    return n
+------------------------------------------------------------------------
+-- FFI binding
+
+newtype KQueueFd = KQueueFd {
+      fromKQueueFd :: CInt
+    } deriving (Eq, Show)
+
+data Event = KEvent {
+      ident  :: {-# UNPACK #-} !CUIntPtr
+    , filter :: {-# UNPACK #-} !Filter
+    , flags  :: {-# UNPACK #-} !Flag
+    , fflags :: {-# UNPACK #-} !FFlag
+#ifdef netbsd_HOST_OS
+    , data_  :: {-# UNPACK #-} !Int64
+#else
+    , data_  :: {-# UNPACK #-} !CIntPtr
+#endif
+    , udata  :: {-# UNPACK #-} !(Ptr ())
+    } deriving Show
+
+event :: Fd -> Filter -> Flag -> FFlag -> Event
+event fd filt flag fflag = KEvent (fromIntegral fd) filt flag fflag 0 nullPtr
+
+instance Storable Event where
+    sizeOf _ = #size struct kevent
+    alignment _ = alignment (undefined :: CInt)
+
+    peek ptr = do
+        ident'  <- #{peek struct kevent, ident} ptr
+        filter' <- #{peek struct kevent, filter} ptr
+        flags'  <- #{peek struct kevent, flags} ptr
+        fflags' <- #{peek struct kevent, fflags} ptr
+        data'   <- #{peek struct kevent, data} ptr
+        udata'  <- #{peek struct kevent, udata} ptr
+        let !ev = KEvent ident' (Filter filter') (Flag flags') fflags' data'
+                         udata'
+        return ev
+
+    poke ptr ev = do
+        #{poke struct kevent, ident} ptr (ident ev)
+        #{poke struct kevent, filter} ptr (filter ev)
+        #{poke struct kevent, flags} ptr (flags ev)
+        #{poke struct kevent, fflags} ptr (fflags ev)
+        #{poke struct kevent, data} ptr (data_ ev)
+        #{poke struct kevent, udata} ptr (udata ev)
+
+newtype FFlag = FFlag Word32
+    deriving (Eq, Show, Storable)
+
+#{enum FFlag, FFlag
+ , noteEOF = NOTE_EOF
+ }
+
+#if SIZEOF_KEV_FLAGS == 4 /* kevent.flag: uint32_t or uint16_t. */
+newtype Flag = Flag Word32
+#else
+newtype Flag = Flag Word16
+#endif
+    deriving (Bits, FiniteBits, Eq, Num, Show, Storable)
+
+#{enum Flag, Flag
+ , flagAdd     = EV_ADD
+ , flagDelete  = EV_DELETE
+ , flagOneshot = EV_ONESHOT
+ }
+
+#if SIZEOF_KEV_FILTER == 4 /*kevent.filter: uint32_t or uint16_t. */
+newtype Filter = Filter Word32
+#else
+newtype Filter = Filter Word16
+#endif
+    deriving (Bits, FiniteBits, Eq, Num, Show, Storable)
+
+filterRead :: Filter
+filterRead = Filter (#const EVFILT_READ)
+filterWrite :: Filter
+filterWrite  = Filter (#const EVFILT_WRITE)
+
+data TimeSpec = TimeSpec {
+      tv_sec  :: {-# UNPACK #-} !CTime
+    , tv_nsec :: {-# UNPACK #-} !CLong
+    }
+
+instance Storable TimeSpec where
+    sizeOf _ = #size struct timespec
+    alignment _ = alignment (undefined :: CInt)
+
+    peek ptr = do
+        tv_sec'  <- #{peek struct timespec, tv_sec} ptr
+        tv_nsec' <- #{peek struct timespec, tv_nsec} ptr
+        let !ts = TimeSpec tv_sec' tv_nsec'
+        return ts
+
+    poke ptr ts = do
+        #{poke struct timespec, tv_sec} ptr (tv_sec ts)
+        #{poke struct timespec, tv_nsec} ptr (tv_nsec ts)
+
+kqueue :: IO KQueueFd
+kqueue = KQueueFd `fmap` throwErrnoIfMinus1 "kqueue" c_kqueue
+
+kqueueControl :: KQueueFd -> Event -> IO Bool
+kqueueControl kfd ev =
+    withTimeSpec (TimeSpec 0 0) $ \tp ->
+        withEvent ev $ \evp -> do
+            res <- kevent False kfd evp 1 nullPtr 0 tp
+            if res == -1
+              then do
+               err <- getErrno
+               case err of
+                 _ | err == eINTR  -> return True
+                 _ | err == eINVAL -> return False
+                 _ | err == eNOTSUP -> return False
+                 _                 -> throwErrno "kevent"
+              else return True
+
+kqueueWait :: KQueueFd -> Ptr Event -> Int -> TimeSpec -> IO Int
+kqueueWait fd es cap tm =
+    fmap fromIntegral $ E.throwErrnoIfMinus1NoRetry "kevent" $
+    withTimeSpec tm $ kevent True fd nullPtr 0 es cap
+
+kqueueWaitNonBlock :: KQueueFd -> Ptr Event -> Int -> IO Int
+kqueueWaitNonBlock fd es cap =
+    fmap fromIntegral $ E.throwErrnoIfMinus1NoRetry "kevent" $
+    withTimeSpec (TimeSpec 0 0) $ kevent False fd nullPtr 0 es cap
+
+-- TODO: We cannot retry on EINTR as the timeout would be wrong.
+-- Perhaps we should just return without calling any callbacks.
+kevent :: Bool -> KQueueFd -> Ptr Event -> Int -> Ptr Event -> Int -> Ptr TimeSpec
+       -> IO CInt
+kevent safe k chs chlen evs evlen ts
+  | safe      = c_kevent k chs (fromIntegral chlen) evs (fromIntegral evlen) ts
+  | otherwise = c_kevent_unsafe k chs (fromIntegral chlen) evs (fromIntegral evlen) ts
+
+withEvent :: Event -> (Ptr Event -> IO a) -> IO a
+withEvent ev f = alloca $ \ptr -> poke ptr ev >> f ptr
+
+withTimeSpec :: TimeSpec -> (Ptr TimeSpec -> IO a) -> IO a
+withTimeSpec ts f
+  | tv_sec ts < 0 = f nullPtr
+  | otherwise     = alloca $ \ptr -> poke ptr ts >> f ptr
+
+fromTimeout :: Timeout -> TimeSpec
+fromTimeout Forever     = TimeSpec (-1) (-1)
+fromTimeout (Timeout s) = TimeSpec (toEnum sec) (toEnum nanosec)
+  where
+    sec :: Int
+    sec     = floor s
+
+    nanosec :: Int
+    nanosec = ceiling $ (s - fromIntegral sec) * 1000000000
+
+toEvent :: Filter -> E.Event
+toEvent (Filter f)
+  | f == (#const EVFILT_READ) = E.evtRead
+  | f == (#const EVFILT_WRITE) = E.evtWrite
+  | otherwise = error $ "toEvent: unknown filter " ++ show f
+
+foreign import ccall unsafe "kqueue"
+    c_kqueue :: IO CInt
+
+#if defined(HAVE_KEVENT)
+foreign import capi safe "sys/event.h kevent"
+    c_kevent :: KQueueFd -> Ptr Event -> CInt -> Ptr Event -> CInt
+             -> Ptr TimeSpec -> IO CInt
+
+foreign import ccall unsafe "kevent"
+    c_kevent_unsafe :: KQueueFd -> Ptr Event -> CInt -> Ptr Event -> CInt
+                    -> Ptr TimeSpec -> IO CInt
+#else
+#error no kevent system call available!?
+#endif
+
+#endif /* defined(HAVE_KQUEUE) */
diff --git a/libraries/base/GHC/Event/Manager.hs b/libraries/base/GHC/Event/Manager.hs
new file mode 100644
index 000000000000..d55d5b1193ea
--- /dev/null
+++ b/libraries/base/GHC/Event/Manager.hs
@@ -0,0 +1,481 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE BangPatterns
+           , CPP
+           , ExistentialQuantification
+           , NoImplicitPrelude
+           , RecordWildCards
+           , TypeSynonymInstances
+           , FlexibleInstances
+  #-}
+module GHC.Event.Manager
+    ( -- * Types
+      EventManager
+
+      -- * Creation
+    , new
+    , newWith
+    , newDefaultBackend
+
+      -- * Running
+    , finished
+    , loop
+    , step
+    , shutdown
+    , release
+    , cleanup
+    , wakeManager
+
+      -- * State
+    , callbackTableVar
+
+      -- * Registering interest in I/O events
+    , Event
+    , evtRead
+    , evtWrite
+    , IOCallback
+    , FdKey(keyFd)
+    , FdData
+    , registerFd_
+    , registerFd
+    , unregisterFd_
+    , unregisterFd
+    , closeFd
+    , closeFd_
+    ) where
+
+#include "EventConfig.h"
+
+------------------------------------------------------------------------
+-- Imports
+
+import Control.Concurrent.MVar (MVar, newMVar, readMVar, putMVar,
+                                tryPutMVar, takeMVar, withMVar)
+import Control.Exception (onException)
+import Control.Monad ((=<<), forM_, liftM, when, replicateM, void)
+import Data.Bits ((.&.))
+import Data.IORef (IORef, atomicModifyIORef', mkWeakIORef, newIORef, readIORef,
+                   writeIORef)
+import Data.Maybe (Maybe(..), maybe)
+import Data.Monoid (mappend, mconcat, mempty)
+import GHC.Arr (Array, (!), listArray)
+import GHC.Base
+import GHC.Conc.Signal (runHandlers)
+import GHC.Conc.Sync (yield)
+import GHC.List (filter)
+import GHC.Num (Num(..))
+import GHC.Real (fromIntegral)
+import GHC.Show (Show(..))
+import GHC.Event.Control
+import GHC.Event.IntTable (IntTable)
+import GHC.Event.Internal (Backend, Event, evtClose, evtRead, evtWrite,
+                           Timeout(..))
+import GHC.Event.Unique (Unique, UniqueSource, newSource, newUnique)
+import System.Posix.Types (Fd)
+
+import qualified GHC.Event.IntTable as IT
+import qualified GHC.Event.Internal as I
+
+#if defined(HAVE_KQUEUE)
+import qualified GHC.Event.KQueue as KQueue
+#elif defined(HAVE_EPOLL)
+import qualified GHC.Event.EPoll  as EPoll
+#elif defined(HAVE_POLL)
+import qualified GHC.Event.Poll   as Poll
+#else
+# error not implemented for this operating system
+#endif
+
+------------------------------------------------------------------------
+-- Types
+
+data FdData = FdData {
+      fdKey       :: {-# UNPACK #-} !FdKey
+    , fdEvents    :: {-# UNPACK #-} !Event
+    , _fdCallback :: !IOCallback
+    }
+
+-- | A file descriptor registration cookie.
+data FdKey = FdKey {
+      keyFd     :: {-# UNPACK #-} !Fd
+    , keyUnique :: {-# UNPACK #-} !Unique
+    } deriving (Eq, Show)
+
+-- | Callback invoked on I/O events.
+type IOCallback = FdKey -> Event -> IO ()
+
+data State = Created
+           | Running
+           | Dying
+           | Releasing
+           | Finished
+             deriving (Eq, Show)
+
+-- | The event manager state.
+data EventManager = EventManager
+    { emBackend      :: !Backend
+    , emFds          :: {-# UNPACK #-} !(Array Int (MVar (IntTable [FdData])))
+    , emState        :: {-# UNPACK #-} !(IORef State)
+    , emUniqueSource :: {-# UNPACK #-} !UniqueSource
+    , emControl      :: {-# UNPACK #-} !Control
+    , emOneShot      :: !Bool
+    , emLock         :: {-# UNPACK #-} !(MVar ())
+    }
+
+-- must be power of 2
+callbackArraySize :: Int
+callbackArraySize = 32
+
+hashFd :: Fd -> Int
+hashFd fd = fromIntegral fd .&. (callbackArraySize - 1)
+{-# INLINE hashFd #-}
+
+callbackTableVar :: EventManager -> Fd -> MVar (IntTable [FdData])
+callbackTableVar mgr fd = emFds mgr ! hashFd fd
+{-# INLINE callbackTableVar #-}
+
+haveOneShot :: Bool
+{-# INLINE haveOneShot #-}
+#if defined(darwin_HOST_OS) || defined(ios_HOST_OS)
+haveOneShot = False
+#elif defined(HAVE_EPOLL) || defined(HAVE_KQUEUE)
+haveOneShot = True
+#else
+haveOneShot = False
+#endif
+------------------------------------------------------------------------
+-- Creation
+
+handleControlEvent :: EventManager -> Fd -> Event -> IO ()
+handleControlEvent mgr fd _evt = do
+  msg <- readControlMessage (emControl mgr) fd
+  case msg of
+    CMsgWakeup      -> return ()
+    CMsgDie         -> writeIORef (emState mgr) Finished
+    CMsgSignal fp s -> runHandlers fp s
+
+newDefaultBackend :: IO Backend
+#if defined(HAVE_KQUEUE)
+newDefaultBackend = KQueue.new
+#elif defined(HAVE_EPOLL)
+newDefaultBackend = EPoll.new
+#elif defined(HAVE_POLL)
+newDefaultBackend = Poll.new
+#else
+newDefaultBackend = error "no back end for this platform"
+#endif
+
+-- | Create a new event manager.
+new :: Bool -> IO EventManager
+new oneShot = newWith oneShot =<< newDefaultBackend
+
+newWith :: Bool -> Backend -> IO EventManager
+newWith oneShot be = do
+  iofds <- fmap (listArray (0, callbackArraySize-1)) $
+           replicateM callbackArraySize (newMVar =<< IT.new 8)
+  ctrl <- newControl False
+  state <- newIORef Created
+  us <- newSource
+  _ <- mkWeakIORef state $ do
+               st <- atomicModifyIORef' state $ \s -> (Finished, s)
+               when (st /= Finished) $ do
+                 I.delete be
+                 closeControl ctrl
+  lockVar <- newMVar ()
+  let mgr = EventManager { emBackend = be
+                         , emFds = iofds
+                         , emState = state
+                         , emUniqueSource = us
+                         , emControl = ctrl
+                         , emOneShot = oneShot
+                         , emLock = lockVar
+                         }
+  registerControlFd mgr (controlReadFd ctrl) evtRead
+  registerControlFd mgr (wakeupReadFd ctrl) evtRead
+  return mgr
+
+failOnInvalidFile :: String -> Fd -> IO Bool -> IO ()
+failOnInvalidFile loc fd m = do
+  ok <- m
+  when (not ok) $
+    let msg = "Failed while attempting to modify registration of file " ++
+              show fd ++ " at location " ++ loc
+    in error msg
+
+registerControlFd :: EventManager -> Fd -> Event -> IO ()
+registerControlFd mgr fd evs =
+  failOnInvalidFile "registerControlFd" fd $
+  I.modifyFd (emBackend mgr) fd mempty evs
+
+-- | Asynchronously shuts down the event manager, if running.
+shutdown :: EventManager -> IO ()
+shutdown mgr = do
+  state <- atomicModifyIORef' (emState mgr) $ \s -> (Dying, s)
+  when (state == Running) $ sendDie (emControl mgr)
+
+-- | Asynchronously tell the thread executing the event
+-- manager loop to exit.
+release :: EventManager -> IO ()
+release EventManager{..} = do
+  state <- atomicModifyIORef' emState $ \s -> (Releasing, s)
+  when (state == Running) $ sendWakeup emControl
+
+finished :: EventManager -> IO Bool
+finished mgr = (== Finished) `liftM` readIORef (emState mgr)
+
+cleanup :: EventManager -> IO ()
+cleanup EventManager{..} = do
+  writeIORef emState Finished
+  void $ tryPutMVar emLock ()
+  I.delete emBackend
+  closeControl emControl
+
+------------------------------------------------------------------------
+-- Event loop
+
+-- | Start handling events.  This function loops until told to stop,
+-- using 'shutdown'.
+--
+-- /Note/: This loop can only be run once per 'EventManager', as it
+-- closes all of its control resources when it finishes.
+loop :: EventManager -> IO ()
+loop mgr@EventManager{..} = do
+  void $ takeMVar emLock
+  state <- atomicModifyIORef' emState $ \s -> case s of
+    Created -> (Running, s)
+    Releasing -> (Running, s)
+    _       -> (s, s)
+  case state of
+    Created   -> go `onException` cleanup mgr
+    Releasing -> go `onException` cleanup mgr
+    Dying     -> cleanup mgr
+    -- While a poll loop is never forked when the event manager is in the
+    -- 'Finished' state, its state could read 'Finished' once the new thread
+    -- actually runs.  This is not an error, just an unfortunate race condition
+    -- in Thread.restartPollLoop.  See #8235
+    Finished  -> return ()
+    _         -> do cleanup mgr
+                    error $ "GHC.Event.Manager.loop: state is already " ++
+                            show state
+ where
+  go = do state <- step mgr
+          case state of
+            Running   -> yield >> go
+            Releasing -> putMVar emLock ()
+            _         -> cleanup mgr
+
+-- | To make a step, we first do a non-blocking poll, in case
+-- there are already events ready to handle. This improves performance
+-- because we can make an unsafe foreign C call, thereby avoiding
+-- forcing the current Task to release the Capability and forcing a context switch.
+-- If the poll fails to find events, we yield, putting the poll loop thread at
+-- end of the Haskell run queue. When it comes back around, we do one more
+-- non-blocking poll, in case we get lucky and have ready events.
+-- If that also returns no events, then we do a blocking poll.
+step :: EventManager -> IO State
+step mgr@EventManager{..} = do
+  waitForIO
+  state <- readIORef emState
+  state `seq` return state
+  where
+    waitForIO = do
+      n1 <- I.poll emBackend Nothing (onFdEvent mgr)
+      when (n1 <= 0) $ do
+        yield
+        n2 <- I.poll emBackend Nothing (onFdEvent mgr)
+        when (n2 <= 0) $ do
+          _ <- I.poll emBackend (Just Forever) (onFdEvent mgr)
+          return ()
+
+------------------------------------------------------------------------
+-- Registering interest in I/O events
+
+-- | Register interest in the given events, without waking the event
+-- manager thread.  The 'Bool' return value indicates whether the
+-- event manager ought to be woken.
+registerFd_ :: EventManager -> IOCallback -> Fd -> Event
+            -> IO (FdKey, Bool)
+registerFd_ mgr@(EventManager{..}) cb fd evs = do
+  u <- newUnique emUniqueSource
+  let fd'  = fromIntegral fd
+      reg  = FdKey fd u
+      !fdd = FdData reg evs cb
+  (modify,ok) <- withMVar (callbackTableVar mgr fd) $ \tbl ->
+    if haveOneShot && emOneShot
+    then do
+      oldFdd <- IT.insertWith (++) fd' [fdd] tbl
+      let evs' = maybe evs (combineEvents evs) oldFdd
+      ok <- I.modifyFdOnce emBackend fd evs'
+      if ok
+        then return (False, True)
+        else IT.reset fd' oldFdd tbl >> return (False, False)
+    else do
+      oldFdd <- IT.insertWith (++) fd' [fdd] tbl
+      let (oldEvs, newEvs) =
+            case oldFdd of
+              Nothing   -> (mempty, evs)
+              Just prev -> (eventsOf prev, combineEvents evs prev)
+          modify = oldEvs /= newEvs
+      ok <- if modify
+            then I.modifyFd emBackend fd oldEvs newEvs
+            else return True
+      if ok
+        then return (modify, True)
+        else IT.reset fd' oldFdd tbl >> return (False, False)
+  -- this simulates behavior of old IO manager:
+  -- i.e. just call the callback if the registration fails.
+  when (not ok) (cb reg evs)
+  return (reg,modify)
+{-# INLINE registerFd_ #-}
+
+combineEvents :: Event -> [FdData] -> Event
+combineEvents ev [fdd] = mappend ev (fdEvents fdd)
+combineEvents ev fdds  = mappend ev (eventsOf fdds)
+{-# INLINE combineEvents #-}
+
+-- | @registerFd mgr cb fd evs@ registers interest in the events @evs@
+-- on the file descriptor @fd@.  @cb@ is called for each event that
+-- occurs.  Returns a cookie that can be handed to 'unregisterFd'.
+registerFd :: EventManager -> IOCallback -> Fd -> Event -> IO FdKey
+registerFd mgr cb fd evs = do
+  (r, wake) <- registerFd_ mgr cb fd evs
+  when wake $ wakeManager mgr
+  return r
+{-# INLINE registerFd #-}
+
+{-
+    Building GHC with parallel IO manager on Mac freezes when
+    compiling the dph libraries in the phase 2. As workaround, we
+    don't use oneshot and we wake up an IO manager on Mac every time
+    when we register an event.
+
+    For more information, please read:
+        http://ghc.haskell.org/trac/ghc/ticket/7651
+-}
+-- | Wake up the event manager.
+wakeManager :: EventManager -> IO ()
+#if defined(darwin_HOST_OS) || defined(ios_HOST_OS)
+wakeManager mgr = sendWakeup (emControl mgr)
+#elif defined(HAVE_EPOLL) || defined(HAVE_KQUEUE)
+wakeManager _ = return ()
+#else
+wakeManager mgr = sendWakeup (emControl mgr)
+#endif
+
+eventsOf :: [FdData] -> Event
+eventsOf = mconcat . map fdEvents
+
+-- | Drop a previous file descriptor registration, without waking the
+-- event manager thread.  The return value indicates whether the event
+-- manager ought to be woken.
+unregisterFd_ :: EventManager -> FdKey -> IO Bool
+unregisterFd_ mgr@(EventManager{..}) (FdKey fd u) =
+  withMVar (callbackTableVar mgr fd) $ \tbl -> do
+    let dropReg = nullToNothing . filter ((/= u) . keyUnique . fdKey)
+        fd' = fromIntegral fd
+        pairEvents prev = do
+          r <- maybe mempty eventsOf `fmap` IT.lookup fd' tbl
+          return (eventsOf prev, r)
+    (oldEvs, newEvs) <- IT.updateWith dropReg fd' tbl >>=
+                        maybe (return (mempty, mempty)) pairEvents
+    let modify = oldEvs /= newEvs
+    when modify $ failOnInvalidFile "unregisterFd_" fd $
+      if haveOneShot && emOneShot && newEvs /= mempty
+      then I.modifyFdOnce emBackend fd newEvs
+      else I.modifyFd emBackend fd oldEvs newEvs
+    return modify
+
+-- | Drop a previous file descriptor registration.
+unregisterFd :: EventManager -> FdKey -> IO ()
+unregisterFd mgr reg = do
+  wake <- unregisterFd_ mgr reg
+  when wake $ wakeManager mgr
+
+-- | Close a file descriptor in a race-safe way.
+closeFd :: EventManager -> (Fd -> IO ()) -> Fd -> IO ()
+closeFd mgr close fd = do
+  fds <- withMVar (callbackTableVar mgr fd) $ \tbl -> do
+    prev <- IT.delete (fromIntegral fd) tbl
+    case prev of
+      Nothing  -> close fd >> return []
+      Just fds -> do
+        let oldEvs = eventsOf fds
+        when (oldEvs /= mempty) $ do
+          _ <- I.modifyFd (emBackend mgr) fd oldEvs mempty
+          wakeManager mgr
+        close fd
+        return fds
+  forM_ fds $ \(FdData reg ev cb) -> cb reg (ev `mappend` evtClose)
+
+-- | Close a file descriptor in a race-safe way.
+-- It assumes the caller will update the callback tables and that the caller
+-- holds the callback table lock for the fd. It must hold this lock because
+-- this command executes a backend command on the fd.
+closeFd_ :: EventManager
+            -> IntTable [FdData]
+            -> Fd
+            -> IO (IO ())
+closeFd_ mgr tbl fd = do
+  prev <- IT.delete (fromIntegral fd) tbl
+  case prev of
+    Nothing  -> return (return ())
+    Just fds -> do
+      let oldEvs = eventsOf fds
+      when (oldEvs /= mempty) $ do
+        _ <- I.modifyFd (emBackend mgr) fd oldEvs mempty
+        wakeManager mgr
+      return $
+        forM_ fds $ \(FdData reg ev cb) -> cb reg (ev `mappend` evtClose)
+
+------------------------------------------------------------------------
+-- Utilities
+
+-- | Call the callbacks corresponding to the given file descriptor.
+onFdEvent :: EventManager -> Fd -> Event -> IO ()
+onFdEvent mgr fd evs =
+  if fd == controlReadFd (emControl mgr) || fd == wakeupReadFd (emControl mgr)
+  then handleControlEvent mgr fd evs
+  else
+    if emOneShot mgr
+    then
+      do fdds <- withMVar (callbackTableVar mgr fd) $ \tbl ->
+           IT.delete fd' tbl >>=
+           maybe (return []) (selectCallbacks tbl)
+         forM_ fdds $ \(FdData reg _ cb) -> cb reg evs
+    else
+      do found <- IT.lookup fd' =<< readMVar (callbackTableVar mgr fd)
+         case found of
+           Just cbs -> forM_ cbs $ \(FdData reg ev cb) -> do
+             when (evs `I.eventIs` ev) $ cb reg evs
+           Nothing  -> return ()
+  where
+    fd' :: Int
+    fd' = fromIntegral fd
+
+    selectCallbacks :: IntTable [FdData] -> [FdData] -> IO [FdData]
+    selectCallbacks tbl cbs = aux cbs [] []
+      where
+        -- nothing to rearm.
+        aux [] _    []          =
+          if haveOneShot
+          then return cbs
+          else do _ <- I.modifyFd (emBackend mgr) fd (eventsOf cbs) mempty
+                  return cbs
+
+        -- reinsert and rearm; note that we already have the lock on the
+        -- callback table for this fd, and we deleted above, so we know there
+        -- is no entry in the table for this fd.
+        aux [] fdds saved@(_:_) = do
+          _ <- if haveOneShot
+               then I.modifyFdOnce (emBackend mgr) fd $ eventsOf saved
+               else I.modifyFd (emBackend mgr) fd (eventsOf cbs) $ eventsOf saved
+          _ <- IT.insertWith (\_ _ -> saved) fd' saved tbl
+          return fdds
+
+        -- continue, saving those callbacks that don't match the event
+        aux (fdd@(FdData _ evs' _) : cbs') fdds saved
+          | evs `I.eventIs` evs' = aux cbs' (fdd:fdds) saved
+          | otherwise            = aux cbs' fdds (fdd:saved)
+
+nullToNothing :: [a] -> Maybe [a]
+nullToNothing []       = Nothing
+nullToNothing xs@(_:_) = Just xs
diff --git a/libraries/base/GHC/Event/PSQ.hs b/libraries/base/GHC/Event/PSQ.hs
new file mode 100644
index 000000000000..853958bc292b
--- /dev/null
+++ b/libraries/base/GHC/Event/PSQ.hs
@@ -0,0 +1,485 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE BangPatterns, NoImplicitPrelude #-}
+
+-- Copyright (c) 2008, Ralf Hinze
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions
+-- are met:
+--
+--     * Redistributions of source code must retain the above
+--       copyright notice, this list of conditions and the following
+--       disclaimer.
+--
+--     * Redistributions in binary form must reproduce the above
+--       copyright notice, this list of conditions and the following
+--       disclaimer in the documentation and/or other materials
+--       provided with the distribution.
+--
+--     * The names of the contributors may not be used to endorse or
+--       promote products derived from this software without specific
+--       prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+-- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+-- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
+-- FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+-- COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
+-- INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
+-- (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+-- SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+-- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+-- STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+-- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED
+-- OF THE POSSIBILITY OF SUCH DAMAGE.
+
+-- | A /priority search queue/ (henceforth /queue/) efficiently
+-- supports the operations of both a search tree and a priority queue.
+-- An 'Elem'ent is a product of a key, a priority, and a
+-- value. Elements can be inserted, deleted, modified and queried in
+-- logarithmic time, and the element with the least priority can be
+-- retrieved in constant time.  A queue can be built from a list of
+-- elements, sorted by keys, in linear time.
+--
+-- This implementation is due to Ralf Hinze with some modifications by
+-- Scott Dillard and Johan Tibell.
+--
+-- * Hinze, R., /A Simple Implementation Technique for Priority Search
+-- Queues/, ICFP 2001, pp. 110-121
+--
+-- <http://citeseer.ist.psu.edu/hinze01simple.html>
+module GHC.Event.PSQ
+    (
+    -- * Binding Type
+    Elem(..)
+    , Key
+    , Prio
+
+    -- * Priority Search Queue Type
+    , PSQ
+
+    -- * Query
+    , size
+    , null
+    , lookup
+
+    -- * Construction
+    , empty
+    , singleton
+
+    -- * Insertion
+    , insert
+
+    -- * Delete/Update
+    , delete
+    , adjust
+
+    -- * Conversion
+    , toList
+    , toAscList
+    , toDescList
+    , fromList
+
+    -- * Min
+    , findMin
+    , deleteMin
+    , minView
+    , atMost
+    ) where
+
+import Data.Maybe (Maybe(..))
+import GHC.Base
+import GHC.Num (Num(..))
+import GHC.Show (Show(showsPrec))
+import GHC.Event.Unique (Unique)
+
+-- | @E k p@ binds the key @k@ with the priority @p@.
+data Elem a = E
+    { key   :: {-# UNPACK #-} !Key
+    , prio  :: {-# UNPACK #-} !Prio
+    , value :: a
+    } deriving (Eq, Show)
+
+------------------------------------------------------------------------
+-- | A mapping from keys @k@ to priorites @p@.
+
+type Prio = Double
+type Key = Unique
+
+data PSQ a = Void
+           | Winner {-# UNPACK #-} !(Elem a)
+                    !(LTree a)
+                    {-# UNPACK #-} !Key  -- max key
+           deriving (Eq, Show)
+
+-- | /O(1)/ The number of elements in a queue.
+size :: PSQ a -> Int
+size Void            = 0
+size (Winner _ lt _) = 1 + size' lt
+
+-- | /O(1)/ True if the queue is empty.
+null :: PSQ a -> Bool
+null Void           = True
+null (Winner _ _ _) = False
+
+-- | /O(log n)/ The priority and value of a given key, or Nothing if
+-- the key is not bound.
+lookup :: Key -> PSQ a -> Maybe (Prio, a)
+lookup k q = case tourView q of
+    Null -> Nothing
+    Single (E k' p v)
+        | k == k'   -> Just (p, v)
+        | otherwise -> Nothing
+    tl `Play` tr
+        | k <= maxKey tl -> lookup k tl
+        | otherwise      -> lookup k tr
+
+------------------------------------------------------------------------
+-- Construction
+
+empty :: PSQ a
+empty = Void
+
+-- | /O(1)/ Build a queue with one element.
+singleton :: Key -> Prio -> a -> PSQ a
+singleton k p v = Winner (E k p v) Start k
+
+------------------------------------------------------------------------
+-- Insertion
+
+-- | /O(log n)/ Insert a new key, priority and value in the queue.  If
+-- the key is already present in the queue, the associated priority
+-- and value are replaced with the supplied priority and value.
+insert :: Key -> Prio -> a -> PSQ a -> PSQ a
+insert k p v q = case q of
+    Void -> singleton k p v
+    Winner (E k' p' v') Start _ -> case compare k k' of
+        LT -> singleton k  p  v  `play` singleton k' p' v'
+        EQ -> singleton k  p  v
+        GT -> singleton k' p' v' `play` singleton k  p  v
+    Winner e (RLoser _ e' tl m tr) m'
+        | k <= m    -> insert k p v (Winner e tl m) `play` (Winner e' tr m')
+        | otherwise -> (Winner e tl m) `play` insert k p v (Winner e' tr m')
+    Winner e (LLoser _ e' tl m tr) m'
+        | k <= m    -> insert k p v (Winner e' tl m) `play` (Winner e tr m')
+        | otherwise -> (Winner e' tl m) `play` insert k p v (Winner e tr m')
+
+------------------------------------------------------------------------
+-- Delete/Update
+
+-- | /O(log n)/ Delete a key and its priority and value from the
+-- queue.  When the key is not a member of the queue, the original
+-- queue is returned.
+delete :: Key -> PSQ a -> PSQ a
+delete k q = case q of
+    Void -> empty
+    Winner (E k' p v) Start _
+        | k == k'   -> empty
+        | otherwise -> singleton k' p v
+    Winner e (RLoser _ e' tl m tr) m'
+        | k <= m    -> delete k (Winner e tl m) `play` (Winner e' tr m')
+        | otherwise -> (Winner e tl m) `play` delete k (Winner e' tr m')
+    Winner e (LLoser _ e' tl m tr) m'
+        | k <= m    -> delete k (Winner e' tl m) `play` (Winner e tr m')
+        | otherwise -> (Winner e' tl m) `play` delete k (Winner e tr m')
+
+-- | /O(log n)/ Update a priority at a specific key with the result
+-- of the provided function.  When the key is not a member of the
+-- queue, the original queue is returned.
+adjust :: (Prio -> Prio) -> Key -> PSQ a -> PSQ a
+adjust f k q0 =  go q0
+  where
+    go q = case q of
+        Void -> empty
+        Winner (E k' p v) Start _
+            | k == k'   -> singleton k' (f p) v
+            | otherwise -> singleton k' p v
+        Winner e (RLoser _ e' tl m tr) m'
+            | k <= m    -> go (Winner e tl m) `unsafePlay` (Winner e' tr m')
+            | otherwise -> (Winner e tl m) `unsafePlay` go (Winner e' tr m')
+        Winner e (LLoser _ e' tl m tr) m'
+            | k <= m    -> go (Winner e' tl m) `unsafePlay` (Winner e tr m')
+            | otherwise -> (Winner e' tl m) `unsafePlay` go (Winner e tr m')
+{-# INLINE adjust #-}
+
+------------------------------------------------------------------------
+-- Conversion
+
+-- | /O(n*log n)/ Build a queue from a list of key/priority/value
+-- tuples.  If the list contains more than one priority and value for
+-- the same key, the last priority and value for the key is retained.
+fromList :: [Elem a] -> PSQ a
+fromList = foldr (\(E k p v) q -> insert k p v q) empty
+
+-- | /O(n)/ Convert to a list of key/priority/value tuples.
+toList :: PSQ a -> [Elem a]
+toList = toAscList
+
+-- | /O(n)/ Convert to an ascending list.
+toAscList :: PSQ a -> [Elem a]
+toAscList q  = seqToList (toAscLists q)
+
+toAscLists :: PSQ a -> Sequ (Elem a)
+toAscLists q = case tourView q of
+    Null         -> emptySequ
+    Single e     -> singleSequ e
+    tl `Play` tr -> toAscLists tl <> toAscLists tr
+
+-- | /O(n)/ Convert to a descending list.
+toDescList :: PSQ a -> [ Elem a ]
+toDescList q = seqToList (toDescLists q)
+
+toDescLists :: PSQ a -> Sequ (Elem a)
+toDescLists q = case tourView q of
+    Null         -> emptySequ
+    Single e     -> singleSequ e
+    tl `Play` tr -> toDescLists tr <> toDescLists tl
+
+------------------------------------------------------------------------
+-- Min
+
+-- | /O(1)/ The element with the lowest priority.
+findMin :: PSQ a -> Maybe (Elem a)
+findMin Void           = Nothing
+findMin (Winner e _ _) = Just e
+
+-- | /O(log n)/ Delete the element with the lowest priority.  Returns
+-- an empty queue if the queue is empty.
+deleteMin :: PSQ a -> PSQ a
+deleteMin Void           = Void
+deleteMin (Winner _ t m) = secondBest t m
+
+-- | /O(log n)/ Retrieve the binding with the least priority, and the
+-- rest of the queue stripped of that binding.
+minView :: PSQ a -> Maybe (Elem a, PSQ a)
+minView Void           = Nothing
+minView (Winner e t m) = Just (e, secondBest t m)
+
+secondBest :: LTree a -> Key -> PSQ a
+secondBest Start _                 = Void
+secondBest (LLoser _ e tl m tr) m' = Winner e tl m `play` secondBest tr m'
+secondBest (RLoser _ e tl m tr) m' = secondBest tl m `play` Winner e tr m'
+
+-- | /O(r*(log n - log r))/ Return a list of elements ordered by
+-- key whose priorities are at most @pt@.
+atMost :: Prio -> PSQ a -> ([Elem a], PSQ a)
+atMost pt q = let (sequ, q') = atMosts pt q
+              in (seqToList sequ, q')
+
+atMosts :: Prio -> PSQ a -> (Sequ (Elem a), PSQ a)
+atMosts !pt q = case q of
+    (Winner e _ _)
+        | prio e > pt -> (emptySequ, q)
+    Void              -> (emptySequ, Void)
+    Winner e Start _  -> (singleSequ e, Void)
+    Winner e (RLoser _ e' tl m tr) m' ->
+        let (sequ, q')   = atMosts pt (Winner e tl m)
+            (sequ', q'') = atMosts pt (Winner e' tr m')
+        in (sequ <> sequ', q' `play` q'')
+    Winner e (LLoser _ e' tl m tr) m' ->
+        let (sequ, q')   = atMosts pt (Winner e' tl m)
+            (sequ', q'') = atMosts pt (Winner e tr m')
+        in (sequ <> sequ', q' `play` q'')
+
+------------------------------------------------------------------------
+-- Loser tree
+
+type Size = Int
+
+data LTree a = Start
+             | LLoser {-# UNPACK #-} !Size
+                      {-# UNPACK #-} !(Elem a)
+                      !(LTree a)
+                      {-# UNPACK #-} !Key  -- split key
+                      !(LTree a)
+             | RLoser {-# UNPACK #-} !Size
+                      {-# UNPACK #-} !(Elem a)
+                      !(LTree a)
+                      {-# UNPACK #-} !Key  -- split key
+                      !(LTree a)
+             deriving (Eq, Show)
+
+size' :: LTree a -> Size
+size' Start              = 0
+size' (LLoser s _ _ _ _) = s
+size' (RLoser s _ _ _ _) = s
+
+left, right :: LTree a -> LTree a
+
+left Start                = moduleError "left" "empty loser tree"
+left (LLoser _ _ tl _ _ ) = tl
+left (RLoser _ _ tl _ _ ) = tl
+
+right Start                = moduleError "right" "empty loser tree"
+right (LLoser _ _ _  _ tr) = tr
+right (RLoser _ _ _  _ tr) = tr
+
+maxKey :: PSQ a -> Key
+maxKey Void           = moduleError "maxKey" "empty queue"
+maxKey (Winner _ _ m) = m
+
+lloser, rloser :: Key -> Prio -> a -> LTree a -> Key -> LTree a -> LTree a
+lloser k p v tl m tr = LLoser (1 + size' tl + size' tr) (E k p v) tl m tr
+rloser k p v tl m tr = RLoser (1 + size' tl + size' tr) (E k p v) tl m tr
+
+------------------------------------------------------------------------
+-- Balancing
+
+-- | Balance factor
+omega :: Int
+omega = 4
+
+lbalance, rbalance :: Key -> Prio -> a -> LTree a -> Key -> LTree a -> LTree a
+
+lbalance k p v l m r
+    | size' l + size' r < 2     = lloser        k p v l m r
+    | size' r > omega * size' l = lbalanceLeft  k p v l m r
+    | size' l > omega * size' r = lbalanceRight k p v l m r
+    | otherwise                 = lloser        k p v l m r
+
+rbalance k p v l m r
+    | size' l + size' r < 2     = rloser        k p v l m r
+    | size' r > omega * size' l = rbalanceLeft  k p v l m r
+    | size' l > omega * size' r = rbalanceRight k p v l m r
+    | otherwise                 = rloser        k p v l m r
+
+lbalanceLeft :: Key -> Prio -> a -> LTree a -> Key -> LTree a -> LTree a
+lbalanceLeft  k p v l m r
+    | size' (left r) < size' (right r) = lsingleLeft  k p v l m r
+    | otherwise                        = ldoubleLeft  k p v l m r
+
+lbalanceRight :: Key -> Prio -> a -> LTree a -> Key -> LTree a -> LTree a
+lbalanceRight k p v l m r
+    | size' (left l) > size' (right l) = lsingleRight k p v l m r
+    | otherwise                        = ldoubleRight k p v l m r
+
+rbalanceLeft :: Key -> Prio -> a -> LTree a -> Key -> LTree a -> LTree a
+rbalanceLeft  k p v l m r
+    | size' (left r) < size' (right r) = rsingleLeft  k p v l m r
+    | otherwise                        = rdoubleLeft  k p v l m r
+
+rbalanceRight :: Key -> Prio -> a -> LTree a -> Key -> LTree a -> LTree a
+rbalanceRight k p v l m r
+    | size' (left l) > size' (right l) = rsingleRight k p v l m r
+    | otherwise                        = rdoubleRight k p v l m r
+
+lsingleLeft :: Key -> Prio -> a -> LTree a -> Key -> LTree a -> LTree a
+lsingleLeft k1 p1 v1 t1 m1 (LLoser _ (E k2 p2 v2) t2 m2 t3)
+    | p1 <= p2  = lloser k1 p1 v1 (rloser k2 p2 v2 t1 m1 t2) m2 t3
+    | otherwise = lloser k2 p2 v2 (lloser k1 p1 v1 t1 m1 t2) m2 t3
+lsingleLeft k1 p1 v1 t1 m1 (RLoser _ (E k2 p2 v2) t2 m2 t3) =
+    rloser k2 p2 v2 (lloser k1 p1 v1 t1 m1 t2) m2 t3
+lsingleLeft _ _ _ _ _ _ = moduleError "lsingleLeft" "malformed tree"
+
+rsingleLeft :: Key -> Prio -> a -> LTree a -> Key -> LTree a -> LTree a
+rsingleLeft k1 p1 v1 t1 m1 (LLoser _ (E k2 p2 v2) t2 m2 t3) =
+    rloser k1 p1 v1 (rloser k2 p2 v2 t1 m1 t2) m2 t3
+rsingleLeft k1 p1 v1 t1 m1 (RLoser _ (E k2 p2 v2) t2 m2 t3) =
+    rloser k2 p2 v2 (rloser k1 p1 v1 t1 m1 t2) m2 t3
+rsingleLeft _ _ _ _ _ _ = moduleError "rsingleLeft" "malformed tree"
+
+lsingleRight :: Key -> Prio -> a -> LTree a -> Key -> LTree a -> LTree a
+lsingleRight k1 p1 v1 (LLoser _ (E k2 p2 v2) t1 m1 t2) m2 t3 =
+    lloser k2 p2 v2 t1 m1 (lloser k1 p1 v1 t2 m2 t3)
+lsingleRight k1 p1 v1 (RLoser _ (E k2 p2 v2) t1 m1 t2) m2 t3 =
+    lloser k1 p1 v1 t1 m1 (lloser k2 p2 v2 t2 m2 t3)
+lsingleRight _ _ _ _ _ _ = moduleError "lsingleRight" "malformed tree"
+
+rsingleRight :: Key -> Prio -> a -> LTree a -> Key -> LTree a -> LTree a
+rsingleRight k1 p1 v1 (LLoser _ (E k2 p2 v2) t1 m1 t2) m2 t3 =
+    lloser k2 p2 v2 t1 m1 (rloser k1 p1 v1 t2 m2 t3)
+rsingleRight k1 p1 v1 (RLoser _ (E k2 p2 v2) t1 m1 t2) m2 t3
+    | p1 <= p2  = rloser k1 p1 v1 t1 m1 (lloser k2 p2 v2 t2 m2 t3)
+    | otherwise = rloser k2 p2 v2 t1 m1 (rloser k1 p1 v1 t2 m2 t3)
+rsingleRight _ _ _ _ _ _ = moduleError "rsingleRight" "malformed tree"
+
+ldoubleLeft :: Key -> Prio -> a -> LTree a -> Key -> LTree a -> LTree a
+ldoubleLeft k1 p1 v1 t1 m1 (LLoser _ (E k2 p2 v2) t2 m2 t3) =
+    lsingleLeft k1 p1 v1 t1 m1 (lsingleRight k2 p2 v2 t2 m2 t3)
+ldoubleLeft k1 p1 v1 t1 m1 (RLoser _ (E k2 p2 v2) t2 m2 t3) =
+    lsingleLeft k1 p1 v1 t1 m1 (rsingleRight k2 p2 v2 t2 m2 t3)
+ldoubleLeft _ _ _ _ _ _ = moduleError "ldoubleLeft" "malformed tree"
+
+ldoubleRight :: Key -> Prio -> a -> LTree a -> Key -> LTree a -> LTree a
+ldoubleRight k1 p1 v1 (LLoser _ (E k2 p2 v2) t1 m1 t2) m2 t3 =
+    lsingleRight k1 p1 v1 (lsingleLeft k2 p2 v2 t1 m1 t2) m2 t3
+ldoubleRight k1 p1 v1 (RLoser _ (E k2 p2 v2) t1 m1 t2) m2 t3 =
+    lsingleRight k1 p1 v1 (rsingleLeft k2 p2 v2 t1 m1 t2) m2 t3
+ldoubleRight _ _ _ _ _ _ = moduleError "ldoubleRight" "malformed tree"
+
+rdoubleLeft :: Key -> Prio -> a -> LTree a -> Key -> LTree a -> LTree a
+rdoubleLeft k1 p1 v1 t1 m1 (LLoser _ (E k2 p2 v2) t2 m2 t3) =
+    rsingleLeft k1 p1 v1 t1 m1 (lsingleRight k2 p2 v2 t2 m2 t3)
+rdoubleLeft k1 p1 v1 t1 m1 (RLoser _ (E k2 p2 v2) t2 m2 t3) =
+    rsingleLeft k1 p1 v1 t1 m1 (rsingleRight k2 p2 v2 t2 m2 t3)
+rdoubleLeft _ _ _ _ _ _ = moduleError "rdoubleLeft" "malformed tree"
+
+rdoubleRight :: Key -> Prio -> a -> LTree a -> Key -> LTree a -> LTree a
+rdoubleRight k1 p1 v1 (LLoser _ (E k2 p2 v2) t1 m1 t2) m2 t3 =
+    rsingleRight k1 p1 v1 (lsingleLeft k2 p2 v2 t1 m1 t2) m2 t3
+rdoubleRight k1 p1 v1 (RLoser _ (E k2 p2 v2) t1 m1 t2) m2 t3 =
+    rsingleRight k1 p1 v1 (rsingleLeft k2 p2 v2 t1 m1 t2) m2 t3
+rdoubleRight _ _ _ _ _ _ = moduleError "rdoubleRight" "malformed tree"
+
+-- | Take two pennants and returns a new pennant that is the union of
+-- the two with the precondition that the keys in the �rst tree are
+-- strictly smaller than the keys in the second tree.
+play :: PSQ a -> PSQ a -> PSQ a
+Void `play` t' = t'
+t `play` Void  = t
+Winner e@(E k p v) t m `play` Winner e'@(E k' p' v') t' m'
+    | p <= p'   = Winner e (rbalance k' p' v' t m t') m'
+    | otherwise = Winner e' (lbalance k p v t m t') m'
+{-# INLINE play #-}
+
+-- | A version of 'play' that can be used if the shape of the tree has
+-- not changed or if the tree is known to be balanced.
+unsafePlay :: PSQ a -> PSQ a -> PSQ a
+Void `unsafePlay` t' =  t'
+t `unsafePlay` Void  =  t
+Winner e@(E k p v) t m `unsafePlay` Winner e'@(E k' p' v') t' m'
+    | p <= p'   = Winner e (rloser k' p' v' t m t') m'
+    | otherwise = Winner e' (lloser k p v t m t') m'
+{-# INLINE unsafePlay #-}
+
+data TourView a = Null
+                | Single {-# UNPACK #-} !(Elem a)
+                | (PSQ a) `Play` (PSQ a)
+
+tourView :: PSQ a -> TourView a
+tourView Void               = Null
+tourView (Winner e Start _) = Single e
+tourView (Winner e (RLoser _ e' tl m tr) m') =
+    Winner e tl m `Play` Winner e' tr m'
+tourView (Winner e (LLoser _ e' tl m tr) m') =
+    Winner e' tl m `Play` Winner e tr m'
+
+------------------------------------------------------------------------
+-- Utility functions
+
+moduleError :: String -> String -> a
+moduleError fun msg = error ("GHC.Event.PSQ." ++ fun ++ ':' : ' ' : msg)
+{-# NOINLINE moduleError #-}
+
+------------------------------------------------------------------------
+-- Hughes's efficient sequence type
+
+newtype Sequ a = Sequ ([a] -> [a])
+
+emptySequ :: Sequ a
+emptySequ = Sequ (\as -> as)
+
+singleSequ :: a -> Sequ a
+singleSequ a = Sequ (\as -> a : as)
+
+(<>) :: Sequ a -> Sequ a -> Sequ a
+Sequ x1 <> Sequ x2 = Sequ (\as -> x1 (x2 as))
+infixr 5 <>
+
+seqToList :: Sequ a -> [a]
+seqToList (Sequ x) = x []
+
+instance Show a => Show (Sequ a) where
+    showsPrec d a = showsPrec d (seqToList a)
+
diff --git a/libraries/base/GHC/Event/Poll.hsc b/libraries/base/GHC/Event/Poll.hsc
new file mode 100644
index 000000000000..2ed25bec8b6a
--- /dev/null
+++ b/libraries/base/GHC/Event/Poll.hsc
@@ -0,0 +1,210 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving
+           , NoImplicitPrelude
+           , BangPatterns
+  #-}
+
+module GHC.Event.Poll
+    (
+      new
+    , available
+    ) where
+
+#include "EventConfig.h"
+
+#if !defined(HAVE_POLL_H)
+import GHC.Base
+import qualified GHC.Event.Internal as E
+
+new :: IO E.Backend
+new = error "Poll back end not implemented for this platform"
+
+available :: Bool
+available = False
+{-# INLINE available #-}
+#else
+#include <poll.h>
+
+import Control.Concurrent.MVar (MVar, newMVar, swapMVar)
+import Control.Monad ((=<<), liftM, liftM2, unless)
+import Data.Bits (Bits, FiniteBits, (.|.), (.&.))
+import Data.Maybe (Maybe(..))
+import Data.Monoid (Monoid(..))
+import Data.Word
+import Foreign.C.Types (CInt(..), CShort(..))
+import Foreign.Ptr (Ptr)
+import Foreign.Storable (Storable(..))
+import GHC.Base
+import GHC.Conc.Sync (withMVar)
+import GHC.Enum (maxBound)
+import GHC.Num (Num(..))
+import GHC.Real (ceiling, fromIntegral)
+import GHC.Show (Show)
+import System.Posix.Types (Fd(..))
+
+import qualified GHC.Event.Array as A
+import qualified GHC.Event.Internal as E
+
+available :: Bool
+available = True
+{-# INLINE available #-}
+
+data Poll = Poll {
+      pollChanges :: {-# UNPACK #-} !(MVar (A.Array PollFd))
+    , pollFd      :: {-# UNPACK #-} !(A.Array PollFd)
+    }
+
+new :: IO E.Backend
+new = E.backend poll modifyFd modifyFdOnce (\_ -> return ()) `liftM`
+      liftM2 Poll (newMVar =<< A.empty) A.empty
+
+modifyFd :: Poll -> Fd -> E.Event -> E.Event -> IO Bool
+modifyFd p fd oevt nevt =
+  withMVar (pollChanges p) $ \ary -> do
+    A.snoc ary $ PollFd fd (fromEvent nevt) (fromEvent oevt)
+    return True
+
+modifyFdOnce :: Poll -> Fd -> E.Event -> IO Bool
+modifyFdOnce = error "modifyFdOnce not supported in Poll backend"
+
+reworkFd :: Poll -> PollFd -> IO ()
+reworkFd p (PollFd fd npevt opevt) = do
+  let ary = pollFd p
+  if opevt == 0
+    then A.snoc ary $ PollFd fd npevt 0
+    else do
+      found <- A.findIndex ((== fd) . pfdFd) ary
+      case found of
+        Nothing        -> error "reworkFd: event not found"
+        Just (i,_)
+          | npevt /= 0 -> A.unsafeWrite ary i $ PollFd fd npevt 0
+          | otherwise  -> A.removeAt ary i
+
+poll :: Poll
+     -> Maybe E.Timeout
+     -> (Fd -> E.Event -> IO ())
+     -> IO Int
+poll p mtout f = do
+  let a = pollFd p
+  mods <- swapMVar (pollChanges p) =<< A.empty
+  A.forM_ mods (reworkFd p)
+  n <- A.useAsPtr a $ \ptr len ->
+    E.throwErrnoIfMinus1NoRetry "c_poll" $
+    case mtout of
+      Just tout ->
+        c_pollLoop ptr (fromIntegral len) (fromTimeout tout)
+      Nothing   ->
+        c_poll_unsafe ptr (fromIntegral len) 0
+  unless (n == 0) $ do
+    A.loop a 0 $ \i e -> do
+      let r = pfdRevents e
+      if r /= 0
+        then do f (pfdFd e) (toEvent r)
+                let i' = i + 1
+                return (i', i' == n)
+        else return (i, True)
+  return (fromIntegral n)
+  where
+    -- The poll timeout is specified as an Int, but c_poll takes a CInt. These
+    -- can't be safely coerced as on many systems (e.g. x86_64) CInt has a
+    -- maxBound of (2^32 - 1), even though Int may have a significantly higher
+    -- bound.
+    --
+    -- This function deals with timeouts greater than maxBound :: CInt, by
+    -- looping until c_poll returns a non-zero value (0 indicates timeout
+    -- expired) OR the full timeout has passed.
+    c_pollLoop :: Ptr PollFd -> (#type nfds_t) -> Int -> IO CInt
+    c_pollLoop ptr len tout
+        | tout <= maxPollTimeout = c_poll ptr len (fromIntegral tout)
+        | otherwise = do
+            result <- c_poll ptr len (fromIntegral maxPollTimeout)
+            if result == 0
+               then c_pollLoop ptr len (fromIntegral (tout - maxPollTimeout))
+               else return result
+
+    -- We need to account for 3 cases:
+    --     1. Int and CInt are of equal size.
+    --     2. Int is larger than CInt
+    --     3. Int is smaller than CInt
+    --
+    -- In case 1, the value of maxPollTimeout will be the maxBound of Int.
+    --
+    -- In case 2, the value of maxPollTimeout will be the maxBound of CInt,
+    -- which is the largest value accepted by c_poll. This will result in
+    -- c_pollLoop recursing if the provided timeout is larger.
+    --
+    -- In case 3, "fromIntegral (maxBound :: CInt) :: Int" will result in a
+    -- negative Int, max will thus return maxBound :: Int. Since poll doesn't
+    -- accept values bigger than maxBound :: Int and CInt is larger than Int,
+    -- there is no problem converting Int to CInt for the c_poll call.
+    maxPollTimeout :: Int
+    maxPollTimeout = max maxBound (fromIntegral (maxBound :: CInt))
+
+fromTimeout :: E.Timeout -> Int
+fromTimeout E.Forever     = -1
+fromTimeout (E.Timeout s) = ceiling $ 1000 * s
+
+data PollFd = PollFd {
+      pfdFd      :: {-# UNPACK #-} !Fd
+    , pfdEvents  :: {-# UNPACK #-} !Event
+    , pfdRevents :: {-# UNPACK #-} !Event
+    } deriving (Show)
+
+newtype Event = Event CShort
+    deriving (Eq, Show, Num, Storable, Bits, FiniteBits)
+
+-- We have to duplicate the whole enum like this in order for the
+-- hsc2hs cross-compilation mode to work
+#ifdef POLLRDHUP
+#{enum Event, Event
+ , pollIn    = POLLIN
+ , pollOut   = POLLOUT
+ , pollRdHup = POLLRDHUP
+ , pollErr   = POLLERR
+ , pollHup   = POLLHUP
+ }
+#else
+#{enum Event, Event
+ , pollIn    = POLLIN
+ , pollOut   = POLLOUT
+ , pollErr   = POLLERR
+ , pollHup   = POLLHUP
+ }
+#endif
+
+fromEvent :: E.Event -> Event
+fromEvent e = remap E.evtRead  pollIn .|.
+              remap E.evtWrite pollOut
+  where remap evt to
+            | e `E.eventIs` evt = to
+            | otherwise         = 0
+
+toEvent :: Event -> E.Event
+toEvent e = remap (pollIn .|. pollErr .|. pollHup)  E.evtRead `mappend`
+            remap (pollOut .|. pollErr .|. pollHup) E.evtWrite
+  where remap evt to
+            | e .&. evt /= 0 = to
+            | otherwise      = mempty
+
+instance Storable PollFd where
+    sizeOf _    = #size struct pollfd
+    alignment _ = alignment (undefined :: CInt)
+
+    peek ptr = do
+      fd <- #{peek struct pollfd, fd} ptr
+      events <- #{peek struct pollfd, events} ptr
+      revents <- #{peek struct pollfd, revents} ptr
+      let !pollFd' = PollFd fd events revents
+      return pollFd'
+
+    poke ptr p = do
+      #{poke struct pollfd, fd} ptr (pfdFd p)
+      #{poke struct pollfd, events} ptr (pfdEvents p)
+      #{poke struct pollfd, revents} ptr (pfdRevents p)
+
+foreign import ccall safe "poll.h poll"
+    c_poll :: Ptr PollFd -> (#type nfds_t) -> CInt -> IO CInt
+
+foreign import ccall unsafe "poll.h poll"
+    c_poll_unsafe :: Ptr PollFd -> (#type nfds_t) -> CInt -> IO CInt
+#endif /* defined(HAVE_POLL_H) */
diff --git a/libraries/base/GHC/Event/Thread.hs b/libraries/base/GHC/Event/Thread.hs
new file mode 100644
index 000000000000..dcfa32aa286f
--- /dev/null
+++ b/libraries/base/GHC/Event/Thread.hs
@@ -0,0 +1,354 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE BangPatterns, NoImplicitPrelude #-}
+module GHC.Event.Thread
+    ( getSystemEventManager
+    , getSystemTimerManager
+    , ensureIOManagerIsRunning
+    , ioManagerCapabilitiesChanged
+    , threadWaitRead
+    , threadWaitWrite
+    , threadWaitReadSTM
+    , threadWaitWriteSTM
+    , closeFdWith
+    , threadDelay
+    , registerDelay
+    , blockedOnBadFD -- used by RTS
+    ) where
+
+import Control.Exception (finally, SomeException, toException)
+import Control.Monad (forM, forM_, sequence_, zipWithM, when)
+import Data.IORef (IORef, newIORef, readIORef, writeIORef)
+import Data.List (zipWith3)
+import Data.Maybe (Maybe(..))
+import Data.Tuple (snd)
+import Foreign.C.Error (eBADF, errnoToIOError)
+import Foreign.Ptr (Ptr)
+import GHC.Base
+import GHC.Conc.Sync (TVar, ThreadId, ThreadStatus(..), atomically, forkIO,
+                      labelThread, modifyMVar_, withMVar, newTVar, sharedCAF,
+                      getNumCapabilities, threadCapability, myThreadId, forkOn,
+                      threadStatus, writeTVar, newTVarIO, readTVar, retry,throwSTM,STM)
+import GHC.IO (mask_, onException)
+import GHC.IO.Exception (ioError)
+import GHC.IOArray (IOArray, newIOArray, readIOArray, writeIOArray,
+                    boundsIOArray)
+import GHC.MVar (MVar, newEmptyMVar, newMVar, putMVar, takeMVar)
+import GHC.Event.Internal (eventIs, evtClose)
+import GHC.Event.Manager (Event, EventManager, evtRead, evtWrite, loop,
+                             new, registerFd, unregisterFd_)
+import qualified GHC.Event.Manager as M
+import qualified GHC.Event.TimerManager as TM
+import GHC.Num ((-), (+))
+import GHC.Show (showSignedInt)
+import System.IO.Unsafe (unsafePerformIO)
+import System.Posix.Types (Fd)
+
+-- | Suspends the current thread for a given number of microseconds
+-- (GHC only).
+--
+-- There is no guarantee that the thread will be rescheduled promptly
+-- when the delay has expired, but the thread will never continue to
+-- run /earlier/ than specified.
+threadDelay :: Int -> IO ()
+threadDelay usecs = mask_ $ do
+  mgr <- getSystemTimerManager
+  m <- newEmptyMVar
+  reg <- TM.registerTimeout mgr usecs (putMVar m ())
+  takeMVar m `onException` TM.unregisterTimeout mgr reg
+
+-- | Set the value of returned TVar to True after a given number of
+-- microseconds. The caveats associated with threadDelay also apply.
+--
+registerDelay :: Int -> IO (TVar Bool)
+registerDelay usecs = do
+  t <- atomically $ newTVar False
+  mgr <- getSystemTimerManager
+  _ <- TM.registerTimeout mgr usecs . atomically $ writeTVar t True
+  return t
+
+-- | Block the current thread until data is available to read from the
+-- given file descriptor.
+--
+-- This will throw an 'IOError' if the file descriptor was closed
+-- while this thread was blocked.  To safely close a file descriptor
+-- that has been used with 'threadWaitRead', use 'closeFdWith'.
+threadWaitRead :: Fd -> IO ()
+threadWaitRead = threadWait evtRead
+{-# INLINE threadWaitRead #-}
+
+-- | Block the current thread until the given file descriptor can
+-- accept data to write.
+--
+-- This will throw an 'IOError' if the file descriptor was closed
+-- while this thread was blocked.  To safely close a file descriptor
+-- that has been used with 'threadWaitWrite', use 'closeFdWith'.
+threadWaitWrite :: Fd -> IO ()
+threadWaitWrite = threadWait evtWrite
+{-# INLINE threadWaitWrite #-}
+
+-- | Close a file descriptor in a concurrency-safe way.
+--
+-- Any threads that are blocked on the file descriptor via
+-- 'threadWaitRead' or 'threadWaitWrite' will be unblocked by having
+-- IO exceptions thrown.
+closeFdWith :: (Fd -> IO ())        -- ^ Action that performs the close.
+            -> Fd                   -- ^ File descriptor to close.
+            -> IO ()
+closeFdWith close fd = do
+  eventManagerArray <- readIORef eventManager
+  let (low, high) = boundsIOArray eventManagerArray
+  mgrs <- forM [low..high] $ \i -> do
+    Just (_,!mgr) <- readIOArray eventManagerArray i
+    return mgr
+  mask_ $ do
+    tables <- forM mgrs $ \mgr -> takeMVar $ M.callbackTableVar mgr fd
+    cbApps <- zipWithM (\mgr table -> M.closeFd_ mgr table fd) mgrs tables
+    close fd `finally` sequence_ (zipWith3 finish mgrs tables cbApps)
+  where
+    finish mgr table cbApp = putMVar (M.callbackTableVar mgr fd) table >> cbApp
+
+threadWait :: Event -> Fd -> IO ()
+threadWait evt fd = mask_ $ do
+  m <- newEmptyMVar
+  mgr <- getSystemEventManager_
+  reg <- registerFd mgr (\_ e -> putMVar m e) fd evt
+  evt' <- takeMVar m `onException` unregisterFd_ mgr reg
+  if evt' `eventIs` evtClose
+    then ioError $ errnoToIOError "threadWait" eBADF Nothing Nothing
+    else return ()
+
+-- used at least by RTS in 'select()' IO manager backend
+blockedOnBadFD :: SomeException
+blockedOnBadFD = toException $ errnoToIOError "awaitEvent" eBADF Nothing Nothing
+
+threadWaitSTM :: Event -> Fd -> IO (STM (), IO ())
+threadWaitSTM evt fd = mask_ $ do
+  m <- newTVarIO Nothing
+  mgr <- getSystemEventManager_
+  reg <- registerFd mgr (\_ e -> atomically (writeTVar m (Just e))) fd evt
+  let waitAction =
+        do mevt <- readTVar m
+           case mevt of
+             Nothing -> retry
+             Just evt' ->
+               if evt' `eventIs` evtClose
+               then throwSTM $ errnoToIOError "threadWaitSTM" eBADF Nothing Nothing
+               else return ()
+  return (waitAction, unregisterFd_ mgr reg >> return ())
+
+-- | Allows a thread to use an STM action to wait for a file descriptor to be readable.
+-- The STM action will retry until the file descriptor has data ready.
+-- The second element of the return value pair is an IO action that can be used
+-- to deregister interest in the file descriptor.
+--
+-- The STM action will throw an 'IOError' if the file descriptor was closed
+-- while the STM action is being executed.  To safely close a file descriptor
+-- that has been used with 'threadWaitReadSTM', use 'closeFdWith'.
+threadWaitReadSTM :: Fd -> IO (STM (), IO ())
+threadWaitReadSTM = threadWaitSTM evtRead
+{-# INLINE threadWaitReadSTM #-}
+
+-- | Allows a thread to use an STM action to wait until a file descriptor can accept a write.
+-- The STM action will retry while the file until the given file descriptor can accept a write.
+-- The second element of the return value pair is an IO action that can be used to deregister
+-- interest in the file descriptor.
+--
+-- The STM action will throw an 'IOError' if the file descriptor was closed
+-- while the STM action is being executed.  To safely close a file descriptor
+-- that has been used with 'threadWaitWriteSTM', use 'closeFdWith'.
+threadWaitWriteSTM :: Fd -> IO (STM (), IO ())
+threadWaitWriteSTM = threadWaitSTM evtWrite
+{-# INLINE threadWaitWriteSTM #-}
+
+
+-- | Retrieve the system event manager for the capability on which the
+-- calling thread is running.
+--
+-- This function always returns 'Just' the current thread's event manager
+-- when using the threaded RTS and 'Nothing' otherwise.
+getSystemEventManager :: IO (Maybe EventManager)
+getSystemEventManager = do
+  t <- myThreadId
+  (cap, _) <- threadCapability t
+  eventManagerArray <- readIORef eventManager
+  mmgr <- readIOArray eventManagerArray cap
+  return $ fmap snd mmgr
+
+getSystemEventManager_ :: IO EventManager
+getSystemEventManager_ = do
+  Just mgr <- getSystemEventManager
+  return mgr
+{-# INLINE getSystemEventManager_ #-}
+
+foreign import ccall unsafe "getOrSetSystemEventThreadEventManagerStore"
+    getOrSetSystemEventThreadEventManagerStore :: Ptr a -> IO (Ptr a)
+
+eventManager :: IORef (IOArray Int (Maybe (ThreadId, EventManager)))
+eventManager = unsafePerformIO $ do
+    numCaps <- getNumCapabilities
+    eventManagerArray <- newIOArray (0, numCaps - 1) Nothing
+    em <- newIORef eventManagerArray
+    sharedCAF em getOrSetSystemEventThreadEventManagerStore
+{-# NOINLINE eventManager #-}
+
+numEnabledEventManagers :: IORef Int
+numEnabledEventManagers = unsafePerformIO $ do
+  newIORef 0
+{-# NOINLINE numEnabledEventManagers #-}
+
+foreign import ccall unsafe "getOrSetSystemEventThreadIOManagerThreadStore"
+    getOrSetSystemEventThreadIOManagerThreadStore :: Ptr a -> IO (Ptr a)
+
+-- | The ioManagerLock protects the 'eventManager' value:
+-- Only one thread at a time can start or shutdown event managers.
+{-# NOINLINE ioManagerLock #-}
+ioManagerLock :: MVar ()
+ioManagerLock = unsafePerformIO $ do
+   m <- newMVar ()
+   sharedCAF m getOrSetSystemEventThreadIOManagerThreadStore
+
+getSystemTimerManager :: IO TM.TimerManager
+getSystemTimerManager = do
+  Just mgr <- readIORef timerManager
+  return mgr
+
+foreign import ccall unsafe "getOrSetSystemTimerThreadEventManagerStore"
+    getOrSetSystemTimerThreadEventManagerStore :: Ptr a -> IO (Ptr a)
+
+timerManager :: IORef (Maybe TM.TimerManager)
+timerManager = unsafePerformIO $ do
+    em <- newIORef Nothing
+    sharedCAF em getOrSetSystemTimerThreadEventManagerStore
+{-# NOINLINE timerManager #-}
+
+foreign import ccall unsafe "getOrSetSystemTimerThreadIOManagerThreadStore"
+    getOrSetSystemTimerThreadIOManagerThreadStore :: Ptr a -> IO (Ptr a)
+
+{-# NOINLINE timerManagerThreadVar #-}
+timerManagerThreadVar :: MVar (Maybe ThreadId)
+timerManagerThreadVar = unsafePerformIO $ do
+   m <- newMVar Nothing
+   sharedCAF m getOrSetSystemTimerThreadIOManagerThreadStore
+
+ensureIOManagerIsRunning :: IO ()
+ensureIOManagerIsRunning
+  | not threaded = return ()
+  | otherwise = do
+      startIOManagerThreads
+      startTimerManagerThread
+
+startIOManagerThreads :: IO ()
+startIOManagerThreads =
+  withMVar ioManagerLock $ \_ -> do
+    eventManagerArray <- readIORef eventManager
+    let (_, high) = boundsIOArray eventManagerArray
+    forM_ [0..high] (startIOManagerThread eventManagerArray)
+    writeIORef numEnabledEventManagers (high+1)
+
+show_int :: Int -> String
+show_int i = showSignedInt 0 i ""
+
+restartPollLoop :: EventManager -> Int -> IO ThreadId
+restartPollLoop mgr i = do
+  M.release mgr
+  !t <- forkOn i $ loop mgr
+  labelThread t ("IOManager on cap " ++ show_int i)
+  return t
+
+startIOManagerThread :: IOArray Int (Maybe (ThreadId, EventManager))
+                        -> Int
+                        -> IO ()
+startIOManagerThread eventManagerArray i = do
+  let create = do
+        !mgr <- new True
+        !t <- forkOn i $ loop mgr
+        labelThread t ("IOManager on cap " ++ show_int i)
+        writeIOArray eventManagerArray i (Just (t,mgr))
+  old <- readIOArray eventManagerArray i
+  case old of
+    Nothing     -> create
+    Just (t,em) -> do
+      s <- threadStatus t
+      case s of
+        ThreadFinished -> create
+        ThreadDied     -> do
+          -- Sanity check: if the thread has died, there is a chance
+          -- that event manager is still alive. This could happend during
+          -- the fork, for example. In this case we should clean up
+          -- open pipes and everything else related to the event manager.
+          -- See #4449
+          M.cleanup em
+          create
+        _other         -> return ()
+
+startTimerManagerThread :: IO ()
+startTimerManagerThread = modifyMVar_ timerManagerThreadVar $ \old -> do
+  let create = do
+        !mgr <- TM.new
+        writeIORef timerManager $ Just mgr
+        !t <- forkIO $ TM.loop mgr `finally` shutdownManagers
+        labelThread t "TimerManager"
+        return $ Just t
+  case old of
+    Nothing            -> create
+    st@(Just t) -> do
+      s <- threadStatus t
+      case s of
+        ThreadFinished -> create
+        ThreadDied     -> do
+          -- Sanity check: if the thread has died, there is a chance
+          -- that event manager is still alive. This could happend during
+          -- the fork, for example. In this case we should clean up
+          -- open pipes and everything else related to the event manager.
+          -- See #4449
+          mem <- readIORef timerManager
+          _ <- case mem of
+                 Nothing -> return ()
+                 Just em -> TM.cleanup em
+          create
+        _other         -> return st
+
+shutdownManagers :: IO ()
+shutdownManagers =
+  withMVar ioManagerLock $ \_ -> do
+    eventManagerArray <- readIORef eventManager
+    let (_, high) = boundsIOArray eventManagerArray
+    forM_ [0..high] $ \i -> do
+      mmgr <- readIOArray eventManagerArray i
+      case mmgr of
+        Nothing -> return ()
+        Just (_,mgr) -> M.shutdown mgr
+
+foreign import ccall unsafe "rtsSupportsBoundThreads" threaded :: Bool
+
+ioManagerCapabilitiesChanged :: IO ()
+ioManagerCapabilitiesChanged = do
+  withMVar ioManagerLock $ \_ -> do
+    new_n_caps <- getNumCapabilities
+    numEnabled <- readIORef numEnabledEventManagers
+    writeIORef numEnabledEventManagers new_n_caps
+    eventManagerArray <- readIORef eventManager
+    let (_, high) = boundsIOArray eventManagerArray
+    let old_n_caps = high + 1
+    if new_n_caps > old_n_caps
+      then do new_eventManagerArray <- newIOArray (0, new_n_caps - 1) Nothing
+
+              -- copy the existing values into the new array:
+              forM_ [0..high] $ \i -> do
+                Just (tid,mgr) <- readIOArray eventManagerArray i
+                if i < numEnabled
+                  then writeIOArray new_eventManagerArray i (Just (tid,mgr))
+                  else do tid' <- restartPollLoop mgr i
+                          writeIOArray new_eventManagerArray i (Just (tid',mgr))
+
+              -- create new IO managers for the new caps:
+              forM_ [old_n_caps..new_n_caps-1] $
+                startIOManagerThread new_eventManagerArray
+
+              -- update the event manager array reference:
+              writeIORef eventManager new_eventManagerArray
+      else when (new_n_caps > numEnabled) $
+            forM_ [numEnabled..new_n_caps-1] $ \i -> do
+              Just (_,mgr) <- readIOArray eventManagerArray i
+              tid <- restartPollLoop mgr i
+              writeIOArray eventManagerArray i (Just (tid,mgr))
diff --git a/libraries/base/GHC/Event/TimerManager.hs b/libraries/base/GHC/Event/TimerManager.hs
new file mode 100644
index 000000000000..f581330e259c
--- /dev/null
+++ b/libraries/base/GHC/Event/TimerManager.hs
@@ -0,0 +1,270 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE BangPatterns
+           , CPP
+           , ExistentialQuantification
+           , NoImplicitPrelude
+           , TypeSynonymInstances
+           , FlexibleInstances
+  #-}
+
+module GHC.Event.TimerManager
+    ( -- * Types
+      TimerManager
+
+      -- * Creation
+    , new
+    , newWith
+    , newDefaultBackend
+
+      -- * Running
+    , finished
+    , loop
+    , step
+    , shutdown
+    , cleanup
+    , wakeManager
+
+      -- * Registering interest in timeout events
+    , TimeoutCallback
+    , TimeoutKey
+    , registerTimeout
+    , updateTimeout
+    , unregisterTimeout
+    ) where
+
+#include "EventConfig.h"
+
+------------------------------------------------------------------------
+-- Imports
+
+import Control.Exception (finally)
+import Control.Monad ((=<<), liftM, sequence_, when)
+import Data.IORef (IORef, atomicModifyIORef', mkWeakIORef, newIORef, readIORef,
+                   writeIORef)
+import Data.Maybe (Maybe(..))
+import Data.Monoid (mempty)
+import GHC.Base
+import GHC.Conc.Signal (runHandlers)
+import GHC.Num (Num(..))
+import GHC.Real ((/), fromIntegral )
+import GHC.Show (Show(..))
+import GHC.Event.Clock (getMonotonicTime)
+import GHC.Event.Control
+import GHC.Event.Internal (Backend, Event, evtRead, Timeout(..))
+import GHC.Event.Unique (Unique, UniqueSource, newSource, newUnique)
+import System.Posix.Types (Fd)
+
+import qualified GHC.Event.Internal as I
+import qualified GHC.Event.PSQ as Q
+
+#if defined(HAVE_POLL)
+import qualified GHC.Event.Poll   as Poll
+#else
+# error not implemented for this operating system
+#endif
+
+------------------------------------------------------------------------
+-- Types
+
+-- | A timeout registration cookie.
+newtype TimeoutKey   = TK Unique
+    deriving (Eq)
+
+-- | Callback invoked on timeout events.
+type TimeoutCallback = IO ()
+
+data State = Created
+           | Running
+           | Dying
+           | Finished
+             deriving (Eq, Show)
+
+-- | A priority search queue, with timeouts as priorities.
+type TimeoutQueue = Q.PSQ TimeoutCallback
+
+{-
+Instead of directly modifying the 'TimeoutQueue' in
+e.g. 'registerTimeout' we keep a list of edits to perform, in the form
+of a chain of function closures, and have the I/O manager thread
+perform the edits later.  This exist to address the following GC
+problem:
+
+Since e.g. 'registerTimeout' doesn't force the evaluation of the
+thunks inside the 'emTimeouts' IORef a number of thunks build up
+inside the IORef.  If the I/O manager thread doesn't evaluate these
+thunks soon enough they'll get promoted to the old generation and
+become roots for all subsequent minor GCs.
+
+When the thunks eventually get evaluated they will each create a new
+intermediate 'TimeoutQueue' that immediately becomes garbage.  Since
+the thunks serve as roots until the next major GC these intermediate
+'TimeoutQueue's will get copied unnecessarily in the next minor GC,
+increasing GC time.  This problem is known as "floating garbage".
+
+Keeping a list of edits doesn't stop this from happening but makes the
+amount of data that gets copied smaller.
+
+TODO: Evaluate the content of the IORef to WHNF on each insert once
+this bug is resolved: http://ghc.haskell.org/trac/ghc/ticket/3838
+-}
+
+-- | An edit to apply to a 'TimeoutQueue'.
+type TimeoutEdit = TimeoutQueue -> TimeoutQueue
+
+-- | The event manager state.
+data TimerManager = TimerManager
+    { emBackend      :: !Backend
+    , emTimeouts     :: {-# UNPACK #-} !(IORef TimeoutQueue)
+    , emState        :: {-# UNPACK #-} !(IORef State)
+    , emUniqueSource :: {-# UNPACK #-} !UniqueSource
+    , emControl      :: {-# UNPACK #-} !Control
+    }
+
+------------------------------------------------------------------------
+-- Creation
+
+handleControlEvent :: TimerManager -> Fd -> Event -> IO ()
+handleControlEvent mgr fd _evt = do
+  msg <- readControlMessage (emControl mgr) fd
+  case msg of
+    CMsgWakeup      -> return ()
+    CMsgDie         -> writeIORef (emState mgr) Finished
+    CMsgSignal fp s -> runHandlers fp s
+
+newDefaultBackend :: IO Backend
+#if defined(HAVE_POLL)
+newDefaultBackend = Poll.new
+#else
+newDefaultBackend = error "no back end for this platform"
+#endif
+
+-- | Create a new event manager.
+new :: IO TimerManager
+new = newWith =<< newDefaultBackend
+
+newWith :: Backend -> IO TimerManager
+newWith be = do
+  timeouts <- newIORef Q.empty
+  ctrl <- newControl True
+  state <- newIORef Created
+  us <- newSource
+  _ <- mkWeakIORef state $ do
+               st <- atomicModifyIORef' state $ \s -> (Finished, s)
+               when (st /= Finished) $ do
+                 I.delete be
+                 closeControl ctrl
+  let mgr = TimerManager { emBackend = be
+                         , emTimeouts = timeouts
+                         , emState = state
+                         , emUniqueSource = us
+                         , emControl = ctrl
+                         }
+  _ <- I.modifyFd be (controlReadFd ctrl) mempty evtRead
+  _ <- I.modifyFd be (wakeupReadFd ctrl) mempty evtRead
+  return mgr
+
+-- | Asynchronously shuts down the event manager, if running.
+shutdown :: TimerManager -> IO ()
+shutdown mgr = do
+  state <- atomicModifyIORef' (emState mgr) $ \s -> (Dying, s)
+  when (state == Running) $ sendDie (emControl mgr)
+
+finished :: TimerManager -> IO Bool
+finished mgr = (== Finished) `liftM` readIORef (emState mgr)
+
+cleanup :: TimerManager -> IO ()
+cleanup mgr = do
+  writeIORef (emState mgr) Finished
+  I.delete (emBackend mgr)
+  closeControl (emControl mgr)
+
+------------------------------------------------------------------------
+-- Event loop
+
+-- | Start handling events.  This function loops until told to stop,
+-- using 'shutdown'.
+--
+-- /Note/: This loop can only be run once per 'TimerManager', as it
+-- closes all of its control resources when it finishes.
+loop :: TimerManager -> IO ()
+loop mgr = do
+  state <- atomicModifyIORef' (emState mgr) $ \s -> case s of
+    Created -> (Running, s)
+    _       -> (s, s)
+  case state of
+    Created -> go `finally` cleanup mgr
+    Dying   -> cleanup mgr
+    _       -> do cleanup mgr
+                  error $ "GHC.Event.Manager.loop: state is already " ++
+                      show state
+ where
+  go = do running <- step mgr
+          when running go
+
+step :: TimerManager -> IO Bool
+step mgr = do
+  timeout <- mkTimeout
+  _ <- I.poll (emBackend mgr) (Just timeout) (handleControlEvent mgr)
+  state <- readIORef (emState mgr)
+  state `seq` return (state == Running)
+ where
+
+  -- | Call all expired timer callbacks and return the time to the
+  -- next timeout.
+  mkTimeout :: IO Timeout
+  mkTimeout = do
+      now <- getMonotonicTime
+      (expired, timeout) <- atomicModifyIORef' (emTimeouts mgr) $ \tq ->
+           let (expired, tq') = Q.atMost now tq
+               timeout = case Q.minView tq' of
+                 Nothing             -> Forever
+                 Just (Q.E _ t _, _) ->
+                     -- This value will always be positive since the call
+                     -- to 'atMost' above removed any timeouts <= 'now'
+                     let t' = t - now in t' `seq` Timeout t'
+           in (tq', (expired, timeout))
+      sequence_ $ map Q.value expired
+      return timeout
+
+-- | Wake up the event manager.
+wakeManager :: TimerManager -> IO ()
+wakeManager mgr = sendWakeup (emControl mgr)
+
+------------------------------------------------------------------------
+-- Registering interest in timeout events
+
+-- | Register a timeout in the given number of microseconds.  The
+-- returned 'TimeoutKey' can be used to later unregister or update the
+-- timeout.  The timeout is automatically unregistered after the given
+-- time has passed.
+registerTimeout :: TimerManager -> Int -> TimeoutCallback -> IO TimeoutKey
+registerTimeout mgr us cb = do
+  !key <- newUnique (emUniqueSource mgr)
+  if us <= 0 then cb
+    else do
+      now <- getMonotonicTime
+      let expTime = fromIntegral us / 1000000.0 + now
+
+      editTimeouts mgr (Q.insert key expTime cb)
+      wakeManager mgr
+  return $ TK key
+
+-- | Unregister an active timeout.
+unregisterTimeout :: TimerManager -> TimeoutKey -> IO ()
+unregisterTimeout mgr (TK key) = do
+  editTimeouts mgr (Q.delete key)
+  wakeManager mgr
+
+-- | Update an active timeout to fire in the given number of
+-- microseconds.
+updateTimeout :: TimerManager -> TimeoutKey -> Int -> IO ()
+updateTimeout mgr (TK key) us = do
+  now <- getMonotonicTime
+  let expTime = fromIntegral us / 1000000.0 + now
+
+  editTimeouts mgr (Q.adjust (const expTime) key)
+  wakeManager mgr
+
+editTimeouts :: TimerManager -> TimeoutEdit -> IO ()
+editTimeouts mgr g = atomicModifyIORef' (emTimeouts mgr) $ \tq -> (g tq, ())
+
diff --git a/libraries/base/GHC/Event/Unique.hs b/libraries/base/GHC/Event/Unique.hs
new file mode 100644
index 000000000000..f5093c92838e
--- /dev/null
+++ b/libraries/base/GHC/Event/Unique.hs
@@ -0,0 +1,42 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE BangPatterns, GeneralizedNewtypeDeriving, NoImplicitPrelude #-}
+module GHC.Event.Unique
+    (
+      UniqueSource
+    , Unique(..)
+    , newSource
+    , newUnique
+    ) where
+
+import Data.Int (Int64)
+import GHC.Base
+import GHC.Conc.Sync (TVar, atomically, newTVarIO, readTVar, writeTVar)
+import GHC.Num (Num(..))
+import GHC.Show (Show(..))
+
+-- We used to use IORefs here, but Simon switched us to STM when we
+-- found that our use of atomicModifyIORef was subject to a severe RTS
+-- performance problem when used in a tight loop from multiple
+-- threads: http://ghc.haskell.org/trac/ghc/ticket/3838
+--
+-- There seems to be no performance cost to using a TVar instead.
+
+newtype UniqueSource = US (TVar Int64)
+
+newtype Unique = Unique { asInt64 :: Int64 }
+    deriving (Eq, Ord, Num)
+
+instance Show Unique where
+    show = show . asInt64
+
+newSource :: IO UniqueSource
+newSource = US `fmap` newTVarIO 0
+
+newUnique :: UniqueSource -> IO Unique
+newUnique (US ref) = atomically $ do
+  u <- readTVar ref
+  let !u' = u+1
+  writeTVar ref u'
+  return $ Unique u'
+{-# INLINE newUnique #-}
+
diff --git a/libraries/base/GHC/Exception.lhs b/libraries/base/GHC/Exception.lhs
new file mode 100644
index 000000000000..540df31da1ea
--- /dev/null
+++ b/libraries/base/GHC/Exception.lhs
@@ -0,0 +1,210 @@
+\begin{code}
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE NoImplicitPrelude
+           , ExistentialQuantification
+           , MagicHash
+           , DeriveDataTypeable
+  #-}
+{-# OPTIONS_HADDOCK hide #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.Exception
+-- Copyright   :  (c) The University of Glasgow, 1998-2002
+-- License     :  see libraries/base/LICENSE
+-- 
+-- Maintainer  :  cvs-ghc@haskell.org
+-- Stability   :  internal
+-- Portability :  non-portable (GHC extensions)
+--
+-- Exceptions and exception-handling functions.
+-- 
+-----------------------------------------------------------------------------
+
+module GHC.Exception
+       ( Exception(..)    -- Class
+       , throw
+       , SomeException(..), ErrorCall(..), ArithException(..)
+       , divZeroException, overflowException, ratioZeroDenomException
+       , errorCallException
+       ) where
+
+import Data.Maybe
+import Data.Typeable (Typeable, cast)
+   -- loop: Data.Typeable -> GHC.Err -> GHC.Exception
+import GHC.Base
+import GHC.Show
+\end{code}
+
+%*********************************************************
+%*                                                      *
+\subsection{Exceptions}
+%*                                                      *
+%*********************************************************
+
+\begin{code}
+{- |
+The @SomeException@ type is the root of the exception type hierarchy.
+When an exception of type @e@ is thrown, behind the scenes it is
+encapsulated in a @SomeException@.
+-}
+data SomeException = forall e . Exception e => SomeException e
+    deriving Typeable
+
+instance Show SomeException where
+    showsPrec p (SomeException e) = showsPrec p e
+
+{- |
+Any type that you wish to throw or catch as an exception must be an
+instance of the @Exception@ class. The simplest case is a new exception
+type directly below the root:
+
+> data MyException = ThisException | ThatException
+>     deriving (Show, Typeable)
+>
+> instance Exception MyException
+
+The default method definitions in the @Exception@ class do what we need
+in this case. You can now throw and catch @ThisException@ and
+@ThatException@ as exceptions:
+
+@
+*Main> throw ThisException \`catch\` \\e -> putStrLn (\"Caught \" ++ show (e :: MyException))
+Caught ThisException
+@
+
+In more complicated examples, you may wish to define a whole hierarchy
+of exceptions:
+
+> ---------------------------------------------------------------------
+> -- Make the root exception type for all the exceptions in a compiler
+>
+> data SomeCompilerException = forall e . Exception e => SomeCompilerException e
+>     deriving Typeable
+>
+> instance Show SomeCompilerException where
+>     show (SomeCompilerException e) = show e
+>
+> instance Exception SomeCompilerException
+>
+> compilerExceptionToException :: Exception e => e -> SomeException
+> compilerExceptionToException = toException . SomeCompilerException
+>
+> compilerExceptionFromException :: Exception e => SomeException -> Maybe e
+> compilerExceptionFromException x = do
+>     SomeCompilerException a <- fromException x
+>     cast a
+>
+> ---------------------------------------------------------------------
+> -- Make a subhierarchy for exceptions in the frontend of the compiler
+>
+> data SomeFrontendException = forall e . Exception e => SomeFrontendException e
+>     deriving Typeable
+>
+> instance Show SomeFrontendException where
+>     show (SomeFrontendException e) = show e
+>
+> instance Exception SomeFrontendException where
+>     toException = compilerExceptionToException
+>     fromException = compilerExceptionFromException
+>
+> frontendExceptionToException :: Exception e => e -> SomeException
+> frontendExceptionToException = toException . SomeFrontendException
+>
+> frontendExceptionFromException :: Exception e => SomeException -> Maybe e
+> frontendExceptionFromException x = do
+>     SomeFrontendException a <- fromException x
+>     cast a
+>
+> ---------------------------------------------------------------------
+> -- Make an exception type for a particular frontend compiler exception
+>
+> data MismatchedParentheses = MismatchedParentheses
+>     deriving (Typeable, Show)
+>
+> instance Exception MismatchedParentheses where
+>     toException   = frontendExceptionToException
+>     fromException = frontendExceptionFromException
+
+We can now catch a @MismatchedParentheses@ exception as
+@MismatchedParentheses@, @SomeFrontendException@ or
+@SomeCompilerException@, but not other types, e.g. @IOException@:
+
+@
+*Main> throw MismatchedParentheses `catch` \e -> putStrLn (\"Caught \" ++ show (e :: MismatchedParentheses))
+Caught MismatchedParentheses
+*Main> throw MismatchedParentheses `catch` \e -> putStrLn (\"Caught \" ++ show (e :: SomeFrontendException))
+Caught MismatchedParentheses
+*Main> throw MismatchedParentheses `catch` \e -> putStrLn (\"Caught \" ++ show (e :: SomeCompilerException))
+Caught MismatchedParentheses
+*Main> throw MismatchedParentheses `catch` \e -> putStrLn (\"Caught \" ++ show (e :: IOException))
+*** Exception: MismatchedParentheses
+@
+
+-}
+class (Typeable e, Show e) => Exception e where
+    toException   :: e -> SomeException
+    fromException :: SomeException -> Maybe e
+
+    toException = SomeException
+    fromException (SomeException e) = cast e
+
+instance Exception SomeException where
+    toException se = se
+    fromException = Just
+\end{code}
+
+%*********************************************************
+%*                                                      *
+\subsection{Primitive throw}
+%*                                                      *
+%*********************************************************
+
+\begin{code}
+-- | Throw an exception.  Exceptions may be thrown from purely
+-- functional code, but may only be caught within the 'IO' monad.
+throw :: Exception e => e -> a
+throw e = raise# (toException e)
+\end{code}
+
+\begin{code}
+-- |This is thrown when the user calls 'error'. The @String@ is the
+-- argument given to 'error'.
+newtype ErrorCall = ErrorCall String
+    deriving (Eq, Ord, Typeable)
+
+instance Exception ErrorCall
+
+instance Show ErrorCall where
+    showsPrec _ (ErrorCall err) = showString err
+
+errorCallException :: String -> SomeException
+errorCallException s = toException (ErrorCall s)
+
+-----
+
+-- |Arithmetic exceptions.
+data ArithException
+  = Overflow
+  | Underflow
+  | LossOfPrecision
+  | DivideByZero
+  | Denormal
+  | RatioZeroDenominator -- ^ /Since: 4.6.0.0/
+  deriving (Eq, Ord, Typeable)
+
+divZeroException, overflowException, ratioZeroDenomException  :: SomeException
+divZeroException  	= toException DivideByZero
+overflowException 	= toException Overflow
+ratioZeroDenomException = toException RatioZeroDenominator
+
+instance Exception ArithException
+
+instance Show ArithException where
+  showsPrec _ Overflow        = showString "arithmetic overflow"
+  showsPrec _ Underflow       = showString "arithmetic underflow"
+  showsPrec _ LossOfPrecision = showString "loss of precision"
+  showsPrec _ DivideByZero    = showString "divide by zero"
+  showsPrec _ Denormal        = showString "denormal"
+  showsPrec _ RatioZeroDenominator = showString "Ratio has zero denominator"
+\end{code}
diff --git a/libraries/base/GHC/Exception.lhs-boot b/libraries/base/GHC/Exception.lhs-boot
new file mode 100644
index 000000000000..f93d806755e4
--- /dev/null
+++ b/libraries/base/GHC/Exception.lhs-boot
@@ -0,0 +1,38 @@
+This SOURCE-imported hs-boot module cuts a big dependency loop:
+
+         GHC.Exception
+imports  Data.Maybe
+imports  GHC.Base
+imports  GHC.Err
+imports  {-# SOURCE #-} GHC.Exception
+
+More dramatically
+
+         GHC.Exception
+imports  Data.Typeable
+imports  Data.Typeable.Internals
+imports  GHC.Arr (fingerprint representation etc)
+imports  GHC.Real
+imports  {-# SOURCE #-} GHC.Exception
+
+However, GHC.Exceptions loop-breaking exports are all nice,
+well-behaved, non-bottom values.  The clients use 'raise#'
+to get a visibly-bottom value.
+
+\begin{code}
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+
+---------------------------------------------------------------------------
+--                  Ghc.Exception.hs-boot
+---------------------------------------------------------------------------
+
+module GHC.Exception ( SomeException, errorCallException,
+                       divZeroException, overflowException, ratioZeroDenomException  
+    ) where 
+import GHC.Types( Char )
+
+data SomeException
+divZeroException, overflowException, ratioZeroDenomException  :: SomeException
+errorCallException :: [Char] -> SomeException
+\end{code}
diff --git a/libraries/base/GHC/Exts.hs b/libraries/base/GHC/Exts.hs
new file mode 100755
index 000000000000..938631001ad0
--- /dev/null
+++ b/libraries/base/GHC/Exts.hs
@@ -0,0 +1,179 @@
+{-# LANGUAGE Unsafe #-}
+{-# LANGUAGE MagicHash, UnboxedTuples, AutoDeriveTypeable, TypeFamilies, MultiParamTypeClasses, FlexibleInstances #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.Exts
+-- Copyright   :  (c) The University of Glasgow 2002
+-- License     :  see libraries/base/LICENSE
+--
+-- Maintainer  :  cvs-ghc@haskell.org
+-- Stability   :  internal
+-- Portability :  non-portable (GHC Extensions)
+--
+-- GHC Extensions: this is the Approved Way to get at GHC-specific extensions.
+--
+-- Note: no other base module should import this module.
+-----------------------------------------------------------------------------
+
+module GHC.Exts
+       (
+        -- * Representations of some basic types
+        Int(..),Word(..),Float(..),Double(..),
+        Char(..),
+        Ptr(..), FunPtr(..),
+
+        -- * The maximum tuple size
+        maxTupleSize,
+
+        -- * Primitive operations
+        module GHC.Prim,
+        shiftL#, shiftRL#, iShiftL#, iShiftRA#, iShiftRL#,
+        uncheckedShiftL64#, uncheckedShiftRL64#,
+        uncheckedIShiftL64#, uncheckedIShiftRA64#,
+        isTrue#,
+
+        -- * Fusion
+        build, augment,
+
+        -- * Overloaded string literals
+        IsString(..),
+
+        -- * Debugging
+        breakpoint, breakpointCond,
+
+        -- * Ids with special behaviour
+        lazy, inline,
+
+        -- * Safe coercions
+        --
+        -- | These are available from the /Trustworthy/ module "Data.Coerce" as well
+        --
+        -- /Since: 4.7.0.0/
+        Data.Coerce.coerce, Data.Coerce.Coercible,
+
+        -- * Transform comprehensions
+        Down(..), groupWith, sortWith, the,
+
+        -- * Event logging
+        traceEvent,
+
+        -- * SpecConstr annotations
+        SpecConstrAnnotation(..),
+
+        -- * The call stack
+        currentCallStack,
+
+        -- * The Constraint kind
+        Constraint,
+
+        -- * Overloaded lists
+        IsList(..)
+       ) where
+
+import Prelude
+
+import GHC.Prim hiding (coerce)
+import GHC.Base hiding (coerce) -- implicitly comes from GHC.Prim
+import GHC.Word
+import GHC.Int
+import GHC.Ptr
+import GHC.Stack
+import qualified Data.Coerce
+import Data.String
+import Data.List
+import Data.Data
+import Data.Ord
+import qualified Debug.Trace
+
+-- XXX This should really be in Data.Tuple, where the definitions are
+maxTupleSize :: Int
+maxTupleSize = 62
+
+-- | 'the' ensures that all the elements of the list are identical
+-- and then returns that unique element
+the :: Eq a => [a] -> a
+the (x:xs)
+  | all (x ==) xs = x
+  | otherwise     = error "GHC.Exts.the: non-identical elements"
+the []            = error "GHC.Exts.the: empty list"
+
+-- | The 'sortWith' function sorts a list of elements using the
+-- user supplied function to project something out of each element
+sortWith :: Ord b => (a -> b) -> [a] -> [a]
+sortWith f = sortBy (\x y -> compare (f x) (f y))
+
+-- | The 'groupWith' function uses the user supplied function which
+-- projects an element out of every list element in order to first sort the
+-- input list and then to form groups by equality on these projected elements
+{-# INLINE groupWith #-}
+groupWith :: Ord b => (a -> b) -> [a] -> [[a]]
+groupWith f xs = build (\c n -> groupByFB c n (\x y -> f x == f y) (sortWith f xs))
+
+groupByFB :: ([a] -> lst -> lst) -> lst -> (a -> a -> Bool) -> [a] -> lst
+groupByFB c n eq xs0 = groupByFBCore xs0
+  where groupByFBCore [] = n
+        groupByFBCore (x:xs) = c (x:ys) (groupByFBCore zs)
+            where (ys, zs) = span (eq x) xs
+
+
+-- -----------------------------------------------------------------------------
+-- tracing
+
+traceEvent :: String -> IO ()
+traceEvent = Debug.Trace.traceEventIO
+{-# DEPRECATED traceEvent "Use 'Debug.Trace.traceEvent' or 'Debug.Trace.traceEventIO'" #-} -- deprecated in 7.4
+
+
+{- **********************************************************************
+*									*
+*              SpecConstr annotation                                    *
+*									*
+********************************************************************** -}
+
+-- Annotating a type with NoSpecConstr will make SpecConstr
+-- not specialise for arguments of that type.
+
+-- This data type is defined here, rather than in the SpecConstr module
+-- itself, so that importing it doesn't force stupidly linking the
+-- entire ghc package at runtime
+
+data SpecConstrAnnotation = NoSpecConstr | ForceSpecConstr
+                deriving( Data, Typeable, Eq )
+
+
+{- **********************************************************************
+*									*
+*              The IsList class                                         *
+*									*
+********************************************************************** -}
+
+-- | The 'IsList' class and its methods are intended to be used in
+--   conjunction with the OverloadedLists extension.
+--
+-- /Since: 4.7.0.0/
+class IsList l where
+  -- | The 'Item' type function returns the type of items of the structure
+  --   @l@.
+  type Item l
+
+  -- | The 'fromList' function constructs the structure @l@ from the given
+  --   list of @Item l@
+  fromList  :: [Item l] -> l
+
+  -- | The 'fromListN' function takes the input list's length as a hint. Its
+  --   behaviour should be equivalent to 'fromList'. The hint can be used to
+  --   construct the structure @l@ more efficiently compared to 'fromList'. If
+  --   the given hint does not equal to the input list's length the behaviour of
+  --   'fromListN' is not specified.
+  fromListN :: Int -> [Item l] -> l
+  fromListN _ = fromList
+
+  -- | The 'toList' function extracts a list of @Item l@ from the structure @l@.
+  --   It should satisfy fromList . toList = id.
+  toList :: l -> [Item l]
+
+instance IsList [a] where
+  type (Item [a]) = a
+  fromList = id
+  toList = id
diff --git a/libraries/base/GHC/Fingerprint.hs b/libraries/base/GHC/Fingerprint.hs
new file mode 100644
index 000000000000..a7568e6bc081
--- /dev/null
+++ b/libraries/base/GHC/Fingerprint.hs
@@ -0,0 +1,115 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE CPP
+           , NoImplicitPrelude
+           , BangPatterns
+  #-}
+
+-- ----------------------------------------------------------------------------
+--
+--  (c) The University of Glasgow 2006
+--
+-- Fingerprints for recompilation checking and ABI versioning, and
+-- implementing fast comparison of Typeable.
+--
+-- ----------------------------------------------------------------------------
+
+module GHC.Fingerprint (
+        Fingerprint(..), fingerprint0,
+        fingerprintData,
+        fingerprintString,
+        fingerprintFingerprints,
+        getFileHash
+   ) where
+
+import GHC.IO
+import GHC.Base
+import GHC.Num
+import GHC.List
+import GHC.Real
+import GHC.Show
+import Foreign
+import Foreign.C
+import System.IO
+import Control.Monad (when)
+
+import GHC.Fingerprint.Type
+
+-- for SIZEOF_STRUCT_MD5CONTEXT:
+#include "HsBaseConfig.h"
+
+-- XXX instance Storable Fingerprint
+-- defined in Foreign.Storable to avoid orphan instance
+
+fingerprint0 :: Fingerprint
+fingerprint0 = Fingerprint 0 0
+
+fingerprintFingerprints :: [Fingerprint] -> Fingerprint
+fingerprintFingerprints fs = unsafeDupablePerformIO $
+  withArrayLen fs $ \len p -> do
+    fingerprintData (castPtr p) (len * sizeOf (head fs))
+
+fingerprintData :: Ptr Word8 -> Int -> IO Fingerprint
+fingerprintData buf len = do
+  allocaBytes SIZEOF_STRUCT_MD5CONTEXT $ \pctxt -> do
+    c_MD5Init pctxt
+    c_MD5Update pctxt buf (fromIntegral len)
+    allocaBytes 16 $ \pdigest -> do
+      c_MD5Final pdigest pctxt
+      peek (castPtr pdigest :: Ptr Fingerprint)
+
+-- This is duplicated in compiler/utils/Fingerprint.hsc
+fingerprintString :: String -> Fingerprint
+fingerprintString str = unsafeDupablePerformIO $
+  withArrayLen word8s $ \len p ->
+     fingerprintData p len
+    where word8s = concatMap f str
+          f c = let w32 :: Word32
+                    w32 = fromIntegral (ord c)
+                in [fromIntegral (w32 `shiftR` 24),
+                    fromIntegral (w32 `shiftR` 16),
+                    fromIntegral (w32 `shiftR` 8),
+                    fromIntegral w32]
+
+-- | Computes the hash of a given file.
+-- This function loops over the handle, running in constant memory.
+--
+-- /Since: 4.7.0.0/
+getFileHash :: FilePath -> IO Fingerprint
+getFileHash path = withBinaryFile path ReadMode $ \h -> do
+  allocaBytes SIZEOF_STRUCT_MD5CONTEXT $ \pctxt -> do
+    c_MD5Init pctxt
+
+    processChunks h (\buf size -> c_MD5Update pctxt buf (fromIntegral size))
+
+    allocaBytes 16 $ \pdigest -> do
+      c_MD5Final pdigest pctxt
+      peek (castPtr pdigest :: Ptr Fingerprint)
+
+  where
+    _BUFSIZE = 4096
+
+    -- | Loop over _BUFSIZE sized chunks read from the handle,
+    -- passing the callback a block of bytes and its size.
+    processChunks :: Handle -> (Ptr Word8 -> Int -> IO ()) -> IO ()
+    processChunks h f = allocaBytes _BUFSIZE $ \arrPtr ->
+
+      let loop = do
+            count <- hGetBuf h arrPtr _BUFSIZE
+            eof <- hIsEOF h
+            when (count /= _BUFSIZE && not eof) $ error $
+              "GHC.Fingerprint.getFileHash: only read " ++ show count ++ " bytes"
+
+            f arrPtr count
+
+            when (not eof) loop
+
+      in loop
+
+data MD5Context
+
+foreign import ccall unsafe "__hsbase_MD5Init"
+   c_MD5Init   :: Ptr MD5Context -> IO ()
+foreign import ccall unsafe "__hsbase_MD5Update"
+   c_MD5Update :: Ptr MD5Context -> Ptr Word8 -> CInt -> IO ()
+foreign import ccall unsafe "__hsbase_MD5Final"
+   c_MD5Final  :: Ptr Word8 -> Ptr MD5Context -> IO ()
diff --git a/libraries/base/GHC/Fingerprint.hs-boot b/libraries/base/GHC/Fingerprint.hs-boot
new file mode 100644
index 000000000000..36833b8ed203
--- /dev/null
+++ b/libraries/base/GHC/Fingerprint.hs-boot
@@ -0,0 +1,13 @@
+{-# LANGUAGE Unsafe #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+module GHC.Fingerprint (
+        fingerprintString,
+        fingerprintFingerprints
+  ) where
+
+import GHC.Base
+import GHC.Fingerprint.Type
+
+fingerprintFingerprints :: [Fingerprint] -> Fingerprint
+fingerprintString :: String -> Fingerprint
+
diff --git a/libraries/base/GHC/Fingerprint/Type.hs b/libraries/base/GHC/Fingerprint/Type.hs
new file mode 100644
index 000000000000..9dedd9434548
--- /dev/null
+++ b/libraries/base/GHC/Fingerprint/Type.hs
@@ -0,0 +1,32 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+-- ----------------------------------------------------------------------------
+--
+--  (c) The University of Glasgow 2006
+--
+-- Fingerprints for recompilation checking and ABI versioning, and
+-- implementing fast comparison of Typeable.
+--
+-- ----------------------------------------------------------------------------
+
+module GHC.Fingerprint.Type (Fingerprint(..)) where
+
+import GHC.Base
+import GHC.List (length, replicate)
+import GHC.Num
+import GHC.Show
+import GHC.Word
+import Numeric (showHex)
+
+-- Using 128-bit MD5 fingerprints for now.
+
+data Fingerprint = Fingerprint {-# UNPACK #-} !Word64 {-# UNPACK #-} !Word64
+  deriving (Eq, Ord)
+
+instance Show Fingerprint where
+  show (Fingerprint w1 w2) = hex16 w1 ++ hex16 w2
+    where
+      -- | Formats a 64 bit number as 16 digits hex.
+      hex16 :: Word64 -> String
+      hex16 i = let hex = showHex i ""
+                 in replicate (16 - length hex) '0' ++ hex
diff --git a/libraries/base/GHC/Float.lhs b/libraries/base/GHC/Float.lhs
new file mode 100644
index 000000000000..e0c4f4ae9514
--- /dev/null
+++ b/libraries/base/GHC/Float.lhs
@@ -0,0 +1,1200 @@
+\begin{code}
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE CPP
+           , NoImplicitPrelude
+           , MagicHash
+           , UnboxedTuples
+  #-}
+-- We believe we could deorphan this module, by moving lots of things
+-- around, but we haven't got there yet:
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# OPTIONS_HADDOCK hide #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.Float
+-- Copyright   :  (c) The University of Glasgow 1994-2002
+--                Portions obtained from hbc (c) Lennart Augusstson
+-- License     :  see libraries/base/LICENSE
+--
+-- Maintainer  :  cvs-ghc@haskell.org
+-- Stability   :  internal
+-- Portability :  non-portable (GHC Extensions)
+--
+-- The types 'Float' and 'Double', and the classes 'Floating' and 'RealFloat'.
+--
+-----------------------------------------------------------------------------
+
+#include "ieee-flpt.h"
+
+module GHC.Float( module GHC.Float, Float(..), Double(..), Float#, Double#
+                , double2Int, int2Double, float2Int, int2Float )
+    where
+
+import Data.Maybe
+
+import Data.Bits
+import GHC.Base
+import GHC.List
+import GHC.Enum
+import GHC.Show
+import GHC.Num
+import GHC.Real
+import GHC.Arr
+import GHC.Float.RealFracMethods
+import GHC.Float.ConversionUtils
+import GHC.Integer.Logarithms ( integerLogBase# )
+import GHC.Integer.Logarithms.Internals
+
+infixr 8  **
+\end{code}
+
+%*********************************************************
+%*                                                      *
+\subsection{Standard numeric classes}
+%*                                                      *
+%*********************************************************
+
+\begin{code}
+-- | Trigonometric and hyperbolic functions and related functions.
+--
+-- Minimal complete definition:
+--      'pi', 'exp', 'log', 'sin', 'cos', 'sinh', 'cosh',
+--      'asin', 'acos', 'atan', 'asinh', 'acosh' and 'atanh'
+class  (Fractional a) => Floating a  where
+    pi                  :: a
+    exp, log, sqrt      :: a -> a
+    (**), logBase       :: a -> a -> a
+    sin, cos, tan       :: a -> a
+    asin, acos, atan    :: a -> a
+    sinh, cosh, tanh    :: a -> a
+    asinh, acosh, atanh :: a -> a
+
+    {-# INLINE (**) #-}
+    {-# INLINE logBase #-}
+    {-# INLINE sqrt #-}
+    {-# INLINE tan #-}
+    {-# INLINE tanh #-}
+    x ** y              =  exp (log x * y)
+    logBase x y         =  log y / log x
+    sqrt x              =  x ** 0.5
+    tan  x              =  sin  x / cos  x
+    tanh x              =  sinh x / cosh x
+
+-- | Efficient, machine-independent access to the components of a
+-- floating-point number.
+--
+-- Minimal complete definition:
+--      all except 'exponent', 'significand', 'scaleFloat' and 'atan2'
+class  (RealFrac a, Floating a) => RealFloat a  where
+    -- | a constant function, returning the radix of the representation
+    -- (often @2@)
+    floatRadix          :: a -> Integer
+    -- | a constant function, returning the number of digits of
+    -- 'floatRadix' in the significand
+    floatDigits         :: a -> Int
+    -- | a constant function, returning the lowest and highest values
+    -- the exponent may assume
+    floatRange          :: a -> (Int,Int)
+    -- | The function 'decodeFloat' applied to a real floating-point
+    -- number returns the significand expressed as an 'Integer' and an
+    -- appropriately scaled exponent (an 'Int').  If @'decodeFloat' x@
+    -- yields @(m,n)@, then @x@ is equal in value to @m*b^^n@, where @b@
+    -- is the floating-point radix, and furthermore, either @m@ and @n@
+    -- are both zero or else @b^(d-1) <= 'abs' m < b^d@, where @d@ is
+    -- the value of @'floatDigits' x@.
+    -- In particular, @'decodeFloat' 0 = (0,0)@. If the type
+    -- contains a negative zero, also @'decodeFloat' (-0.0) = (0,0)@.
+    -- /The result of/ @'decodeFloat' x@ /is unspecified if either of/
+    -- @'isNaN' x@ /or/ @'isInfinite' x@ /is/ 'True'.
+    decodeFloat         :: a -> (Integer,Int)
+    -- | 'encodeFloat' performs the inverse of 'decodeFloat' in the
+    -- sense that for finite @x@ with the exception of @-0.0@,
+    -- @'uncurry' 'encodeFloat' ('decodeFloat' x) = x@.
+    -- @'encodeFloat' m n@ is one of the two closest representable
+    -- floating-point numbers to @m*b^^n@ (or @&#177;Infinity@ if overflow
+    -- occurs); usually the closer, but if @m@ contains too many bits,
+    -- the result may be rounded in the wrong direction.
+    encodeFloat         :: Integer -> Int -> a
+    -- | 'exponent' corresponds to the second component of 'decodeFloat'.
+    -- @'exponent' 0 = 0@ and for finite nonzero @x@,
+    -- @'exponent' x = snd ('decodeFloat' x) + 'floatDigits' x@.
+    -- If @x@ is a finite floating-point number, it is equal in value to
+    -- @'significand' x * b ^^ 'exponent' x@, where @b@ is the
+    -- floating-point radix.
+    -- The behaviour is unspecified on infinite or @NaN@ values.
+    exponent            :: a -> Int
+    -- | The first component of 'decodeFloat', scaled to lie in the open
+    -- interval (@-1@,@1@), either @0.0@ or of absolute value @>= 1\/b@,
+    -- where @b@ is the floating-point radix.
+    -- The behaviour is unspecified on infinite or @NaN@ values.
+    significand         :: a -> a
+    -- | multiplies a floating-point number by an integer power of the radix
+    scaleFloat          :: Int -> a -> a
+    -- | 'True' if the argument is an IEEE \"not-a-number\" (NaN) value
+    isNaN               :: a -> Bool
+    -- | 'True' if the argument is an IEEE infinity or negative infinity
+    isInfinite          :: a -> Bool
+    -- | 'True' if the argument is too small to be represented in
+    -- normalized format
+    isDenormalized      :: a -> Bool
+    -- | 'True' if the argument is an IEEE negative zero
+    isNegativeZero      :: a -> Bool
+    -- | 'True' if the argument is an IEEE floating point number
+    isIEEE              :: a -> Bool
+    -- | a version of arctangent taking two real floating-point arguments.
+    -- For real floating @x@ and @y@, @'atan2' y x@ computes the angle
+    -- (from the positive x-axis) of the vector from the origin to the
+    -- point @(x,y)@.  @'atan2' y x@ returns a value in the range [@-pi@,
+    -- @pi@].  It follows the Common Lisp semantics for the origin when
+    -- signed zeroes are supported.  @'atan2' y 1@, with @y@ in a type
+    -- that is 'RealFloat', should return the same value as @'atan' y@.
+    -- A default definition of 'atan2' is provided, but implementors
+    -- can provide a more accurate implementation.
+    atan2               :: a -> a -> a
+
+
+    exponent x          =  if m == 0 then 0 else n + floatDigits x
+                           where (m,n) = decodeFloat x
+
+    significand x       =  encodeFloat m (negate (floatDigits x))
+                           where (m,_) = decodeFloat x
+
+    scaleFloat 0 x      =  x
+    scaleFloat k x
+      | isFix           =  x
+      | otherwise       =  encodeFloat m (n + clamp b k)
+                           where (m,n) = decodeFloat x
+                                 (l,h) = floatRange x
+                                 d     = floatDigits x
+                                 b     = h - l + 4*d
+                                 -- n+k may overflow, which would lead
+                                 -- to wrong results, hence we clamp the
+                                 -- scaling parameter.
+                                 -- If n + k would be larger than h,
+                                 -- n + clamp b k must be too, simliar
+                                 -- for smaller than l - d.
+                                 -- Add a little extra to keep clear
+                                 -- from the boundary cases.
+                                 isFix = x == 0 || isNaN x || isInfinite x
+
+    atan2 y x
+      | x > 0            =  atan (y/x)
+      | x == 0 && y > 0  =  pi/2
+      | x <  0 && y > 0  =  pi + atan (y/x)
+      |(x <= 0 && y < 0)            ||
+       (x <  0 && isNegativeZero y) ||
+       (isNegativeZero x && isNegativeZero y)
+                         = -atan2 (-y) x
+      | y == 0 && (x < 0 || isNegativeZero x)
+                          =  pi    -- must be after the previous test on zero y
+      | x==0 && y==0      =  y     -- must be after the other double zero tests
+      | otherwise         =  x + y -- x or y is a NaN, return a NaN (via +)
+\end{code}
+
+
+%*********************************************************
+%*                                                      *
+\subsection{Type @Float@}
+%*                                                      *
+%*********************************************************
+
+\begin{code}
+instance  Num Float  where
+    (+)         x y     =  plusFloat x y
+    (-)         x y     =  minusFloat x y
+    negate      x       =  negateFloat x
+    (*)         x y     =  timesFloat x y
+    abs x | x >= 0.0    =  x
+          | otherwise   =  negateFloat x
+    signum x | x == 0.0  = 0
+             | x > 0.0   = 1
+             | otherwise = negate 1
+
+    {-# INLINE fromInteger #-}
+    fromInteger i = F# (floatFromInteger i)
+
+instance  Real Float  where
+    toRational (F# x#)  =
+        case decodeFloat_Int# x# of
+          (# m#, e# #)
+            | isTrue# (e# >=# 0#)                               ->
+                    (smallInteger m# `shiftLInteger` e#) :% 1
+            | isTrue# ((int2Word# m# `and#` 1##) `eqWord#` 0##) ->
+                    case elimZerosInt# m# (negateInt# e#) of
+                      (# n, d# #) -> n :% shiftLInteger 1 d#
+            | otherwise                                         ->
+                    smallInteger m# :% shiftLInteger 1 (negateInt# e#)
+
+instance  Fractional Float  where
+    (/) x y             =  divideFloat x y
+    {-# INLINE fromRational #-}
+    fromRational (n:%d) = rationalToFloat n d
+    recip x             =  1.0 / x
+
+rationalToFloat :: Integer -> Integer -> Float
+{-# NOINLINE [1] rationalToFloat #-}
+rationalToFloat n 0
+    | n == 0        = 0/0
+    | n < 0         = (-1)/0
+    | otherwise     = 1/0
+rationalToFloat n d
+    | n == 0        = encodeFloat 0 0
+    | n < 0         = -(fromRat'' minEx mantDigs (-n) d)
+    | otherwise     = fromRat'' minEx mantDigs n d
+      where
+        minEx       = FLT_MIN_EXP
+        mantDigs    = FLT_MANT_DIG
+
+-- RULES for Integer and Int
+{-# RULES
+"properFraction/Float->Integer"     properFraction = properFractionFloatInteger
+"truncate/Float->Integer"           truncate = truncateFloatInteger
+"floor/Float->Integer"              floor = floorFloatInteger
+"ceiling/Float->Integer"            ceiling = ceilingFloatInteger
+"round/Float->Integer"              round = roundFloatInteger
+"properFraction/Float->Int"         properFraction = properFractionFloatInt
+"truncate/Float->Int"               truncate = float2Int
+"floor/Float->Int"                  floor = floorFloatInt
+"ceiling/Float->Int"                ceiling = ceilingFloatInt
+"round/Float->Int"                  round = roundFloatInt
+  #-}
+instance  RealFrac Float  where
+
+        -- ceiling, floor, and truncate are all small
+    {-# INLINE [1] ceiling #-}
+    {-# INLINE [1] floor #-}
+    {-# INLINE [1] truncate #-}
+
+-- We assume that FLT_RADIX is 2 so that we can use more efficient code
+#if FLT_RADIX != 2
+#error FLT_RADIX must be 2
+#endif
+    properFraction (F# x#)
+      = case decodeFloat_Int# x# of
+        (# m#, n# #) ->
+            let m = I# m#
+                n = I# n#
+            in
+            if n >= 0
+            then (fromIntegral m * (2 ^ n), 0.0)
+            else let i = if m >= 0 then                m `shiftR` negate n
+                                   else negate (negate m `shiftR` negate n)
+                     f = m - (i `shiftL` negate n)
+                 in (fromIntegral i, encodeFloat (fromIntegral f) n)
+
+    truncate x  = case properFraction x of
+                     (n,_) -> n
+
+    round x     = case properFraction x of
+                     (n,r) -> let
+                                m         = if r < 0.0 then n - 1 else n + 1
+                                half_down = abs r - 0.5
+                              in
+                              case (compare half_down 0.0) of
+                                LT -> n
+                                EQ -> if even n then n else m
+                                GT -> m
+
+    ceiling x   = case properFraction x of
+                    (n,r) -> if r > 0.0 then n + 1 else n
+
+    floor x     = case properFraction x of
+                    (n,r) -> if r < 0.0 then n - 1 else n
+
+instance  Floating Float  where
+    pi                  =  3.141592653589793238
+    exp x               =  expFloat x
+    log x               =  logFloat x
+    sqrt x              =  sqrtFloat x
+    sin x               =  sinFloat x
+    cos x               =  cosFloat x
+    tan x               =  tanFloat x
+    asin x              =  asinFloat x
+    acos x              =  acosFloat x
+    atan x              =  atanFloat x
+    sinh x              =  sinhFloat x
+    cosh x              =  coshFloat x
+    tanh x              =  tanhFloat x
+    (**) x y            =  powerFloat x y
+    logBase x y         =  log y / log x
+
+    asinh x = log (x + sqrt (1.0+x*x))
+    acosh x = log (x + (x+1.0) * sqrt ((x-1.0)/(x+1.0)))
+    atanh x = 0.5 * log ((1.0+x) / (1.0-x))
+
+instance  RealFloat Float  where
+    floatRadix _        =  FLT_RADIX        -- from float.h
+    floatDigits _       =  FLT_MANT_DIG     -- ditto
+    floatRange _        =  (FLT_MIN_EXP, FLT_MAX_EXP) -- ditto
+
+    decodeFloat (F# f#) = case decodeFloat_Int# f# of
+                          (# i, e #) -> (smallInteger i, I# e)
+
+    encodeFloat i (I# e) = F# (encodeFloatInteger i e)
+
+    exponent x          = case decodeFloat x of
+                            (m,n) -> if m == 0 then 0 else n + floatDigits x
+
+    significand x       = case decodeFloat x of
+                            (m,_) -> encodeFloat m (negate (floatDigits x))
+
+    scaleFloat 0 x      = x
+    scaleFloat k x
+      | isFix           = x
+      | otherwise       = case decodeFloat x of
+                            (m,n) -> encodeFloat m (n + clamp bf k)
+                        where bf = FLT_MAX_EXP - (FLT_MIN_EXP) + 4*FLT_MANT_DIG
+                              isFix = x == 0 || isFloatFinite x == 0
+
+    isNaN x          = 0 /= isFloatNaN x
+    isInfinite x     = 0 /= isFloatInfinite x
+    isDenormalized x = 0 /= isFloatDenormalized x
+    isNegativeZero x = 0 /= isFloatNegativeZero x
+    isIEEE _         = True
+
+instance  Show Float  where
+    showsPrec   x = showSignedFloat showFloat x
+    showList = showList__ (showsPrec 0)
+\end{code}
+
+%*********************************************************
+%*                                                      *
+\subsection{Type @Double@}
+%*                                                      *
+%*********************************************************
+
+\begin{code}
+instance  Num Double  where
+    (+)         x y     =  plusDouble x y
+    (-)         x y     =  minusDouble x y
+    negate      x       =  negateDouble x
+    (*)         x y     =  timesDouble x y
+    abs x | x >= 0.0    =  x
+          | otherwise   =  negateDouble x
+    signum x | x == 0.0  = 0
+             | x > 0.0   = 1
+             | otherwise = negate 1
+
+    {-# INLINE fromInteger #-}
+    fromInteger i = D# (doubleFromInteger i)
+
+
+instance  Real Double  where
+    toRational (D# x#)  =
+        case decodeDoubleInteger x# of
+          (# m, e# #)
+            | isTrue# (e# >=# 0#)                                  ->
+                shiftLInteger m e# :% 1
+            | isTrue# ((integerToWord m `and#` 1##) `eqWord#` 0##) ->
+                case elimZerosInteger m (negateInt# e#) of
+                    (# n, d# #) ->  n :% shiftLInteger 1 d#
+            | otherwise                                            ->
+                m :% shiftLInteger 1 (negateInt# e#)
+
+instance  Fractional Double  where
+    (/) x y             =  divideDouble x y
+    {-# INLINE fromRational #-}
+    fromRational (n:%d) = rationalToDouble n d
+    recip x             =  1.0 / x
+
+rationalToDouble :: Integer -> Integer -> Double
+{-# NOINLINE [1] rationalToDouble #-}
+rationalToDouble n 0
+    | n == 0        = 0/0
+    | n < 0         = (-1)/0
+    | otherwise     = 1/0
+rationalToDouble n d
+    | n == 0        = encodeFloat 0 0
+    | n < 0         = -(fromRat'' minEx mantDigs (-n) d)
+    | otherwise     = fromRat'' minEx mantDigs n d
+      where
+        minEx       = DBL_MIN_EXP
+        mantDigs    = DBL_MANT_DIG
+
+instance  Floating Double  where
+    pi                  =  3.141592653589793238
+    exp x               =  expDouble x
+    log x               =  logDouble x
+    sqrt x              =  sqrtDouble x
+    sin  x              =  sinDouble x
+    cos  x              =  cosDouble x
+    tan  x              =  tanDouble x
+    asin x              =  asinDouble x
+    acos x              =  acosDouble x
+    atan x              =  atanDouble x
+    sinh x              =  sinhDouble x
+    cosh x              =  coshDouble x
+    tanh x              =  tanhDouble x
+    (**) x y            =  powerDouble x y
+    logBase x y         =  log y / log x
+
+    asinh x = log (x + sqrt (1.0+x*x))
+    acosh x = log (x + (x+1.0) * sqrt ((x-1.0)/(x+1.0)))
+    atanh x = 0.5 * log ((1.0+x) / (1.0-x))
+
+-- RULES for Integer and Int
+{-# RULES
+"properFraction/Double->Integer"    properFraction = properFractionDoubleInteger
+"truncate/Double->Integer"          truncate = truncateDoubleInteger
+"floor/Double->Integer"             floor = floorDoubleInteger
+"ceiling/Double->Integer"           ceiling = ceilingDoubleInteger
+"round/Double->Integer"             round = roundDoubleInteger
+"properFraction/Double->Int"        properFraction = properFractionDoubleInt
+"truncate/Double->Int"              truncate = double2Int
+"floor/Double->Int"                 floor = floorDoubleInt
+"ceiling/Double->Int"               ceiling = ceilingDoubleInt
+"round/Double->Int"                 round = roundDoubleInt
+  #-}
+instance  RealFrac Double  where
+
+        -- ceiling, floor, and truncate are all small
+    {-# INLINE [1] ceiling #-}
+    {-# INLINE [1] floor #-}
+    {-# INLINE [1] truncate #-}
+
+    properFraction x
+      = case (decodeFloat x)      of { (m,n) ->
+        if n >= 0 then
+            (fromInteger m * 2 ^ n, 0.0)
+        else
+            case (quotRem m (2^(negate n))) of { (w,r) ->
+            (fromInteger w, encodeFloat r n)
+            }
+        }
+
+    truncate x  = case properFraction x of
+                     (n,_) -> n
+
+    round x     = case properFraction x of
+                     (n,r) -> let
+                                m         = if r < 0.0 then n - 1 else n + 1
+                                half_down = abs r - 0.5
+                              in
+                              case (compare half_down 0.0) of
+                                LT -> n
+                                EQ -> if even n then n else m
+                                GT -> m
+
+    ceiling x   = case properFraction x of
+                    (n,r) -> if r > 0.0 then n + 1 else n
+
+    floor x     = case properFraction x of
+                    (n,r) -> if r < 0.0 then n - 1 else n
+
+instance  RealFloat Double  where
+    floatRadix _        =  FLT_RADIX        -- from float.h
+    floatDigits _       =  DBL_MANT_DIG     -- ditto
+    floatRange _        =  (DBL_MIN_EXP, DBL_MAX_EXP) -- ditto
+
+    decodeFloat (D# x#)
+      = case decodeDoubleInteger x#   of
+          (# i, j #) -> (i, I# j)
+
+    encodeFloat i (I# j) = D# (encodeDoubleInteger i j)
+
+    exponent x          = case decodeFloat x of
+                            (m,n) -> if m == 0 then 0 else n + floatDigits x
+
+    significand x       = case decodeFloat x of
+                            (m,_) -> encodeFloat m (negate (floatDigits x))
+
+    scaleFloat 0 x      = x
+    scaleFloat k x
+      | isFix           = x
+      | otherwise       = case decodeFloat x of
+                            (m,n) -> encodeFloat m (n + clamp bd k)
+                        where bd = DBL_MAX_EXP - (DBL_MIN_EXP) + 4*DBL_MANT_DIG
+                              isFix = x == 0 || isDoubleFinite x == 0
+
+    isNaN x             = 0 /= isDoubleNaN x
+    isInfinite x        = 0 /= isDoubleInfinite x
+    isDenormalized x    = 0 /= isDoubleDenormalized x
+    isNegativeZero x    = 0 /= isDoubleNegativeZero x
+    isIEEE _            = True
+
+instance  Show Double  where
+    showsPrec   x = showSignedFloat showFloat x
+    showList = showList__ (showsPrec 0)
+\end{code}
+
+%*********************************************************
+%*                                                      *
+\subsection{@Enum@ instances}
+%*                                                      *
+%*********************************************************
+
+The @Enum@ instances for Floats and Doubles are slightly unusual.
+The @toEnum@ function truncates numbers to Int.  The definitions
+of @enumFrom@ and @enumFromThen@ allow floats to be used in arithmetic
+series: [0,0.1 .. 1.0].  However, roundoff errors make these somewhat
+dubious.  This example may have either 10 or 11 elements, depending on
+how 0.1 is represented.
+
+NOTE: The instances for Float and Double do not make use of the default
+methods for @enumFromTo@ and @enumFromThenTo@, as these rely on there being
+a `non-lossy' conversion to and from Ints. Instead we make use of the
+1.2 default methods (back in the days when Enum had Ord as a superclass)
+for these (@numericEnumFromTo@ and @numericEnumFromThenTo@ below.)
+
+\begin{code}
+instance  Enum Float  where
+    succ x         = x + 1
+    pred x         = x - 1
+    toEnum         = int2Float
+    fromEnum       = fromInteger . truncate   -- may overflow
+    enumFrom       = numericEnumFrom
+    enumFromTo     = numericEnumFromTo
+    enumFromThen   = numericEnumFromThen
+    enumFromThenTo = numericEnumFromThenTo
+
+instance  Enum Double  where
+    succ x         = x + 1
+    pred x         = x - 1
+    toEnum         =  int2Double
+    fromEnum       =  fromInteger . truncate   -- may overflow
+    enumFrom       =  numericEnumFrom
+    enumFromTo     =  numericEnumFromTo
+    enumFromThen   =  numericEnumFromThen
+    enumFromThenTo =  numericEnumFromThenTo
+\end{code}
+
+
+%*********************************************************
+%*                                                      *
+\subsection{Printing floating point}
+%*                                                      *
+%*********************************************************
+
+
+\begin{code}
+-- | Show a signed 'RealFloat' value to full precision
+-- using standard decimal notation for arguments whose absolute value lies
+-- between @0.1@ and @9,999,999@, and scientific notation otherwise.
+showFloat :: (RealFloat a) => a -> ShowS
+showFloat x  =  showString (formatRealFloat FFGeneric Nothing x)
+
+-- These are the format types.  This type is not exported.
+
+data FFFormat = FFExponent | FFFixed | FFGeneric
+
+-- This is just a compatibility stub, as the "alt" argument formerly
+-- didn't exist.
+formatRealFloat :: (RealFloat a) => FFFormat -> Maybe Int -> a -> String
+formatRealFloat fmt decs x = formatRealFloatAlt fmt decs False x
+
+formatRealFloatAlt :: (RealFloat a) => FFFormat -> Maybe Int -> Bool -> a
+                 -> String
+formatRealFloatAlt fmt decs alt x
+   | isNaN x                   = "NaN"
+   | isInfinite x              = if x < 0 then "-Infinity" else "Infinity"
+   | x < 0 || isNegativeZero x = '-':doFmt fmt (floatToDigits (toInteger base) (-x))
+   | otherwise                 = doFmt fmt (floatToDigits (toInteger base) x)
+ where
+  base = 10
+
+  doFmt format (is, e) =
+    let ds = map intToDigit is in
+    case format of
+     FFGeneric ->
+      doFmt (if e < 0 || e > 7 then FFExponent else FFFixed)
+            (is,e)
+     FFExponent ->
+      case decs of
+       Nothing ->
+        let show_e' = show (e-1) in
+        case ds of
+          "0"     -> "0.0e0"
+          [d]     -> d : ".0e" ++ show_e'
+          (d:ds') -> d : '.' : ds' ++ "e" ++ show_e'
+          []      -> error "formatRealFloat/doFmt/FFExponent: []"
+       Just dec ->
+        let dec' = max dec 1 in
+        case is of
+         [0] -> '0' :'.' : take dec' (repeat '0') ++ "e0"
+         _ ->
+          let
+           (ei,is') = roundTo base (dec'+1) is
+           (d:ds') = map intToDigit (if ei > 0 then init is' else is')
+          in
+          d:'.':ds' ++ 'e':show (e-1+ei)
+     FFFixed ->
+      let
+       mk0 ls = case ls of { "" -> "0" ; _ -> ls}
+      in
+      case decs of
+       Nothing
+          | e <= 0    -> "0." ++ replicate (-e) '0' ++ ds
+          | otherwise ->
+             let
+                f 0 s    rs  = mk0 (reverse s) ++ '.':mk0 rs
+                f n s    ""  = f (n-1) ('0':s) ""
+                f n s (r:rs) = f (n-1) (r:s) rs
+             in
+                f e "" ds
+       Just dec ->
+        let dec' = max dec 0 in
+        if e >= 0 then
+         let
+          (ei,is') = roundTo base (dec' + e) is
+          (ls,rs)  = splitAt (e+ei) (map intToDigit is')
+         in
+         mk0 ls ++ (if null rs && not alt then "" else '.':rs)
+        else
+         let
+          (ei,is') = roundTo base dec' (replicate (-e) 0 ++ is)
+          d:ds' = map intToDigit (if ei > 0 then is' else 0:is')
+         in
+         d : (if null ds' && not alt then "" else '.':ds')
+
+
+roundTo :: Int -> Int -> [Int] -> (Int,[Int])
+roundTo base d is =
+  case f d True is of
+    x@(0,_) -> x
+    (1,xs)  -> (1, 1:xs)
+    _       -> error "roundTo: bad Value"
+ where
+  b2 = base `quot` 2
+
+  f n _ []     = (0, replicate n 0)
+  f 0 e (x:xs) | x == b2 && e && all (== 0) xs = (0, [])   -- Round to even when at exactly half the base
+               | otherwise = (if x >= b2 then 1 else 0, [])
+  f n _ (i:xs)
+     | i' == base = (1,0:ds)
+     | otherwise  = (0,i':ds)
+      where
+       (c,ds) = f (n-1) (even i) xs
+       i'     = c + i
+
+-- Based on "Printing Floating-Point Numbers Quickly and Accurately"
+-- by R.G. Burger and R.K. Dybvig in PLDI 96.
+-- This version uses a much slower logarithm estimator. It should be improved.
+
+-- | 'floatToDigits' takes a base and a non-negative 'RealFloat' number,
+-- and returns a list of digits and an exponent.
+-- In particular, if @x>=0@, and
+--
+-- > floatToDigits base x = ([d1,d2,...,dn], e)
+--
+-- then
+--
+--      (1) @n >= 1@
+--
+--      (2) @x = 0.d1d2...dn * (base**e)@
+--
+--      (3) @0 <= di <= base-1@
+
+floatToDigits :: (RealFloat a) => Integer -> a -> ([Int], Int)
+floatToDigits _ 0 = ([0], 0)
+floatToDigits base x =
+ let
+  (f0, e0) = decodeFloat x
+  (minExp0, _) = floatRange x
+  p = floatDigits x
+  b = floatRadix x
+  minExp = minExp0 - p -- the real minimum exponent
+  -- Haskell requires that f be adjusted so denormalized numbers
+  -- will have an impossibly low exponent.  Adjust for this.
+  (f, e) =
+   let n = minExp - e0 in
+   if n > 0 then (f0 `quot` (expt b n), e0+n) else (f0, e0)
+  (r, s, mUp, mDn) =
+   if e >= 0 then
+    let be = expt b e in
+    if f == expt b (p-1) then
+      (f*be*b*2, 2*b, be*b, be)     -- according to Burger and Dybvig
+    else
+      (f*be*2, 2, be, be)
+   else
+    if e > minExp && f == expt b (p-1) then
+      (f*b*2, expt b (-e+1)*2, b, 1)
+    else
+      (f*2, expt b (-e)*2, 1, 1)
+  k :: Int
+  k =
+   let
+    k0 :: Int
+    k0 =
+     if b == 2 && base == 10 then
+        -- logBase 10 2 is very slightly larger than 8651/28738
+        -- (about 5.3558e-10), so if log x >= 0, the approximation
+        -- k1 is too small, hence we add one and need one fixup step less.
+        -- If log x < 0, the approximation errs rather on the high side.
+        -- That is usually more than compensated for by ignoring the
+        -- fractional part of logBase 2 x, but when x is a power of 1/2
+        -- or slightly larger and the exponent is a multiple of the
+        -- denominator of the rational approximation to logBase 10 2,
+        -- k1 is larger than logBase 10 x. If k1 > 1 + logBase 10 x,
+        -- we get a leading zero-digit we don't want.
+        -- With the approximation 3/10, this happened for
+        -- 0.5^1030, 0.5^1040, ..., 0.5^1070 and values close above.
+        -- The approximation 8651/28738 guarantees k1 < 1 + logBase 10 x
+        -- for IEEE-ish floating point types with exponent fields
+        -- <= 17 bits and mantissae of several thousand bits, earlier
+        -- convergents to logBase 10 2 would fail for long double.
+        -- Using quot instead of div is a little faster and requires
+        -- fewer fixup steps for negative lx.
+        let lx = p - 1 + e0
+            k1 = (lx * 8651) `quot` 28738
+        in if lx >= 0 then k1 + 1 else k1
+     else
+	-- f :: Integer, log :: Float -> Float,
+        --               ceiling :: Float -> Int
+        ceiling ((log (fromInteger (f+1) :: Float) +
+                 fromIntegral e * log (fromInteger b)) /
+                   log (fromInteger base))
+--WAS:            fromInt e * log (fromInteger b))
+
+    fixup n =
+      if n >= 0 then
+        if r + mUp <= expt base n * s then n else fixup (n+1)
+      else
+        if expt base (-n) * (r + mUp) <= s then n else fixup (n+1)
+   in
+   fixup k0
+
+  gen ds rn sN mUpN mDnN =
+   let
+    (dn, rn') = (rn * base) `quotRem` sN
+    mUpN' = mUpN * base
+    mDnN' = mDnN * base
+   in
+   case (rn' < mDnN', rn' + mUpN' > sN) of
+    (True,  False) -> dn : ds
+    (False, True)  -> dn+1 : ds
+    (True,  True)  -> if rn' * 2 < sN then dn : ds else dn+1 : ds
+    (False, False) -> gen (dn:ds) rn' sN mUpN' mDnN'
+
+  rds =
+   if k >= 0 then
+      gen [] r (s * expt base k) mUp mDn
+   else
+     let bk = expt base (-k) in
+     gen [] (r * bk) s (mUp * bk) (mDn * bk)
+ in
+ (map fromIntegral (reverse rds), k)
+
+\end{code}
+
+
+%*********************************************************
+%*                                                      *
+\subsection{Converting from a Rational to a RealFloat
+%*                                                      *
+%*********************************************************
+
+[In response to a request for documentation of how fromRational works,
+Joe Fasel writes:] A quite reasonable request!  This code was added to
+the Prelude just before the 1.2 release, when Lennart, working with an
+early version of hbi, noticed that (read . show) was not the identity
+for floating-point numbers.  (There was a one-bit error about half the
+time.)  The original version of the conversion function was in fact
+simply a floating-point divide, as you suggest above. The new version
+is, I grant you, somewhat denser.
+
+Unfortunately, Joe's code doesn't work!  Here's an example:
+
+main = putStr (shows (1.82173691287639817263897126389712638972163e-300::Double) "\n")
+
+This program prints
+        0.0000000000000000
+instead of
+        1.8217369128763981e-300
+
+Here's Joe's code:
+
+\begin{pseudocode}
+fromRat :: (RealFloat a) => Rational -> a
+fromRat x = x'
+        where x' = f e
+
+--              If the exponent of the nearest floating-point number to x
+--              is e, then the significand is the integer nearest xb^(-e),
+--              where b is the floating-point radix.  We start with a good
+--              guess for e, and if it is correct, the exponent of the
+--              floating-point number we construct will again be e.  If
+--              not, one more iteration is needed.
+
+              f e   = if e' == e then y else f e'
+                      where y      = encodeFloat (round (x * (1 % b)^^e)) e
+                            (_,e') = decodeFloat y
+              b     = floatRadix x'
+
+--              We obtain a trial exponent by doing a floating-point
+--              division of x's numerator by its denominator.  The
+--              result of this division may not itself be the ultimate
+--              result, because of an accumulation of three rounding
+--              errors.
+
+              (s,e) = decodeFloat (fromInteger (numerator x) `asTypeOf` x'
+                                        / fromInteger (denominator x))
+\end{pseudocode}
+
+Now, here's Lennart's code (which works)
+
+\begin{code}
+-- | Converts a 'Rational' value into any type in class 'RealFloat'.
+{-# RULES
+"fromRat/Float"     fromRat = (fromRational :: Rational -> Float)
+"fromRat/Double"    fromRat = (fromRational :: Rational -> Double)
+  #-}
+
+{-# NOINLINE [1] fromRat #-}
+fromRat :: (RealFloat a) => Rational -> a
+
+-- Deal with special cases first, delegating the real work to fromRat'
+fromRat (n :% 0) | n > 0     =  1/0        -- +Infinity
+                 | n < 0     = -1/0        -- -Infinity
+                 | otherwise =  0/0        -- NaN
+
+fromRat (n :% d) | n > 0     = fromRat' (n :% d)
+                 | n < 0     = - fromRat' ((-n) :% d)
+                 | otherwise = encodeFloat 0 0             -- Zero
+
+-- Conversion process:
+-- Scale the rational number by the RealFloat base until
+-- it lies in the range of the mantissa (as used by decodeFloat/encodeFloat).
+-- Then round the rational to an Integer and encode it with the exponent
+-- that we got from the scaling.
+-- To speed up the scaling process we compute the log2 of the number to get
+-- a first guess of the exponent.
+
+fromRat' :: (RealFloat a) => Rational -> a
+-- Invariant: argument is strictly positive
+fromRat' x = r
+  where b = floatRadix r
+        p = floatDigits r
+        (minExp0, _) = floatRange r
+        minExp = minExp0 - p            -- the real minimum exponent
+        xMax   = toRational (expt b p)
+        p0 = (integerLogBase b (numerator x) - integerLogBase b (denominator x) - p) `max` minExp
+        -- if x = n/d and ln = integerLogBase b n, ld = integerLogBase b d,
+        -- then b^(ln-ld-1) < x < b^(ln-ld+1)
+        f = if p0 < 0 then 1 :% expt b (-p0) else expt b p0 :% 1
+        x0 = x / f
+        -- if ln - ld >= minExp0, then b^(p-1) < x0 < b^(p+1), so there's at most
+        -- one scaling step needed, otherwise, x0 < b^p and no scaling is needed
+        (x', p') = if x0 >= xMax then (x0 / toRational b, p0+1) else (x0, p0)
+        r = encodeFloat (round x') p'
+
+-- Exponentiation with a cache for the most common numbers.
+minExpt, maxExpt :: Int
+minExpt = 0
+maxExpt = 1100
+
+expt :: Integer -> Int -> Integer
+expt base n =
+    if base == 2 && n >= minExpt && n <= maxExpt then
+        expts!n
+    else
+        if base == 10 && n <= maxExpt10 then
+            expts10!n
+        else
+            base^n
+
+expts :: Array Int Integer
+expts = array (minExpt,maxExpt) [(n,2^n) | n <- [minExpt .. maxExpt]]
+
+maxExpt10 :: Int
+maxExpt10 = 324
+
+expts10 :: Array Int Integer
+expts10 = array (minExpt,maxExpt10) [(n,10^n) | n <- [minExpt .. maxExpt10]]
+
+-- Compute the (floor of the) log of i in base b.
+-- Simplest way would be just divide i by b until it's smaller then b, but that would
+-- be very slow!  We are just slightly more clever, except for base 2, where
+-- we take advantage of the representation of Integers.
+-- The general case could be improved by a lookup table for
+-- approximating the result by integerLog2 i / integerLog2 b.
+integerLogBase :: Integer -> Integer -> Int
+integerLogBase b i
+   | i < b     = 0
+   | b == 2    = I# (integerLog2# i)
+   | otherwise = I# (integerLogBase# b i)
+
+\end{code}
+
+Unfortunately, the old conversion code was awfully slow due to
+a) a slow integer logarithm
+b) repeated calculation of gcd's
+
+For the case of Rational's coming from a Float or Double via toRational,
+we can exploit the fact that the denominator is a power of two, which for
+these brings a huge speedup since we need only shift and add instead
+of division.
+
+The below is an adaption of fromRat' for the conversion to
+Float or Double exploiting the known floatRadix and avoiding
+divisions as much as possible.
+
+\begin{code}
+{-# SPECIALISE fromRat'' :: Int -> Int -> Integer -> Integer -> Float,
+                            Int -> Int -> Integer -> Integer -> Double #-}
+fromRat'' :: RealFloat a => Int -> Int -> Integer -> Integer -> a
+-- Invariant: n and d strictly positive
+fromRat'' minEx@(I# me#) mantDigs@(I# md#) n d =
+    case integerLog2IsPowerOf2# d of
+      (# ld#, pw# #)
+        | isTrue# (pw# ==# 0#) ->
+          case integerLog2# n of
+            ln# | isTrue# (ln# >=# (ld# +# me# -# 1#)) ->
+                  -- this means n/d >= 2^(minEx-1), i.e. we are guaranteed to get
+                  -- a normalised number, round to mantDigs bits
+                  if isTrue# (ln# <# md#)
+                    then encodeFloat n (I# (negateInt# ld#))
+                    else let n'  = n `shiftR` (I# (ln# +# 1# -# md#))
+                             n'' = case roundingMode# n (ln# -# md#) of
+                                    0# -> n'
+                                    2# -> n' + 1
+                                    _  -> case fromInteger n' .&. (1 :: Int) of
+                                            0 -> n'
+                                            _ -> n' + 1
+                         in encodeFloat n'' (I# (ln# -# ld# +# 1# -# md#))
+                | otherwise ->
+                  -- n/d < 2^(minEx-1), a denorm or rounded to 2^(minEx-1)
+                  -- the exponent for encoding is always minEx-mantDigs
+                  -- so we must shift right by (minEx-mantDigs) - (-ld)
+                  case ld# +# (me# -# md#) of
+                    ld'# | isTrue# (ld'# <=# 0#) -> -- we would shift left, so we don't shift
+                           encodeFloat n (I# ((me# -# md#) -# ld'#))
+                         | isTrue# (ld'# <=# ln#) ->
+                           let n' = n `shiftR` (I# ld'#)
+                           in case roundingMode# n (ld'# -# 1#) of
+                                0# -> encodeFloat n' (minEx - mantDigs)
+                                1# -> if fromInteger n' .&. (1 :: Int) == 0
+                                        then encodeFloat n' (minEx-mantDigs)
+                                        else encodeFloat (n' + 1) (minEx-mantDigs)
+                                _  -> encodeFloat (n' + 1) (minEx-mantDigs)
+                         | isTrue# (ld'# ># (ln# +# 1#)) -> encodeFloat 0 0 -- result of shift < 0.5
+                         | otherwise ->  -- first bit of n shifted to 0.5 place
+                           case integerLog2IsPowerOf2# n of
+                            (# _, 0# #) -> encodeFloat 0 0  -- round to even
+                            (# _, _ #)  -> encodeFloat 1 (minEx - mantDigs)
+        | otherwise ->
+          let ln = I# (integerLog2# n)
+              ld = I# ld#
+              -- 2^(ln-ld-1) < n/d < 2^(ln-ld+1)
+              p0 = max minEx (ln - ld)
+              (n', d')
+                | p0 < mantDigs = (n `shiftL` (mantDigs - p0), d)
+                | p0 == mantDigs = (n, d)
+                | otherwise     = (n, d `shiftL` (p0 - mantDigs))
+              -- if ln-ld < minEx, then n'/d' < 2^mantDigs, else
+              -- 2^(mantDigs-1) < n'/d' < 2^(mantDigs+1) and we
+              -- may need one scaling step
+              scale p a b
+                | (b `shiftL` mantDigs) <= a = (p+1, a, b `shiftL` 1)
+                | otherwise = (p, a, b)
+              (p', n'', d'') = scale (p0-mantDigs) n' d'
+              -- n''/d'' < 2^mantDigs and p' == minEx-mantDigs or n''/d'' >= 2^(mantDigs-1)
+              rdq = case n'' `quotRem` d'' of
+                     (q,r) -> case compare (r `shiftL` 1) d'' of
+                                LT -> q
+                                EQ -> if fromInteger q .&. (1 :: Int) == 0
+                                        then q else q+1
+                                GT -> q+1
+          in  encodeFloat rdq p'
+\end{code}
+
+
+%*********************************************************
+%*                                                      *
+\subsection{Floating point numeric primops}
+%*                                                      *
+%*********************************************************
+
+Definitions of the boxed PrimOps; these will be
+used in the case of partial applications, etc.
+
+\begin{code}
+plusFloat, minusFloat, timesFloat, divideFloat :: Float -> Float -> Float
+plusFloat   (F# x) (F# y) = F# (plusFloat# x y)
+minusFloat  (F# x) (F# y) = F# (minusFloat# x y)
+timesFloat  (F# x) (F# y) = F# (timesFloat# x y)
+divideFloat (F# x) (F# y) = F# (divideFloat# x y)
+
+negateFloat :: Float -> Float
+negateFloat (F# x)        = F# (negateFloat# x)
+
+gtFloat, geFloat, eqFloat, neFloat, ltFloat, leFloat :: Float -> Float -> Bool
+gtFloat     (F# x) (F# y) = isTrue# (gtFloat# x y)
+geFloat     (F# x) (F# y) = isTrue# (geFloat# x y)
+eqFloat     (F# x) (F# y) = isTrue# (eqFloat# x y)
+neFloat     (F# x) (F# y) = isTrue# (neFloat# x y)
+ltFloat     (F# x) (F# y) = isTrue# (ltFloat# x y)
+leFloat     (F# x) (F# y) = isTrue# (leFloat# x y)
+
+expFloat, logFloat, sqrtFloat :: Float -> Float
+sinFloat, cosFloat, tanFloat  :: Float -> Float
+asinFloat, acosFloat, atanFloat  :: Float -> Float
+sinhFloat, coshFloat, tanhFloat  :: Float -> Float
+expFloat    (F# x) = F# (expFloat# x)
+logFloat    (F# x) = F# (logFloat# x)
+sqrtFloat   (F# x) = F# (sqrtFloat# x)
+sinFloat    (F# x) = F# (sinFloat# x)
+cosFloat    (F# x) = F# (cosFloat# x)
+tanFloat    (F# x) = F# (tanFloat# x)
+asinFloat   (F# x) = F# (asinFloat# x)
+acosFloat   (F# x) = F# (acosFloat# x)
+atanFloat   (F# x) = F# (atanFloat# x)
+sinhFloat   (F# x) = F# (sinhFloat# x)
+coshFloat   (F# x) = F# (coshFloat# x)
+tanhFloat   (F# x) = F# (tanhFloat# x)
+
+powerFloat :: Float -> Float -> Float
+powerFloat  (F# x) (F# y) = F# (powerFloat# x y)
+
+-- definitions of the boxed PrimOps; these will be
+-- used in the case of partial applications, etc.
+
+plusDouble, minusDouble, timesDouble, divideDouble :: Double -> Double -> Double
+plusDouble   (D# x) (D# y) = D# (x +## y)
+minusDouble  (D# x) (D# y) = D# (x -## y)
+timesDouble  (D# x) (D# y) = D# (x *## y)
+divideDouble (D# x) (D# y) = D# (x /## y)
+
+negateDouble :: Double -> Double
+negateDouble (D# x)        = D# (negateDouble# x)
+
+gtDouble, geDouble, eqDouble, neDouble, leDouble, ltDouble :: Double -> Double -> Bool
+gtDouble    (D# x) (D# y) = isTrue# (x >##  y)
+geDouble    (D# x) (D# y) = isTrue# (x >=## y)
+eqDouble    (D# x) (D# y) = isTrue# (x ==## y)
+neDouble    (D# x) (D# y) = isTrue# (x /=## y)
+ltDouble    (D# x) (D# y) = isTrue# (x <##  y)
+leDouble    (D# x) (D# y) = isTrue# (x <=## y)
+
+double2Float :: Double -> Float
+double2Float (D# x) = F# (double2Float# x)
+
+float2Double :: Float -> Double
+float2Double (F# x) = D# (float2Double# x)
+
+expDouble, logDouble, sqrtDouble :: Double -> Double
+sinDouble, cosDouble, tanDouble  :: Double -> Double
+asinDouble, acosDouble, atanDouble  :: Double -> Double
+sinhDouble, coshDouble, tanhDouble  :: Double -> Double
+expDouble    (D# x) = D# (expDouble# x)
+logDouble    (D# x) = D# (logDouble# x)
+sqrtDouble   (D# x) = D# (sqrtDouble# x)
+sinDouble    (D# x) = D# (sinDouble# x)
+cosDouble    (D# x) = D# (cosDouble# x)
+tanDouble    (D# x) = D# (tanDouble# x)
+asinDouble   (D# x) = D# (asinDouble# x)
+acosDouble   (D# x) = D# (acosDouble# x)
+atanDouble   (D# x) = D# (atanDouble# x)
+sinhDouble   (D# x) = D# (sinhDouble# x)
+coshDouble   (D# x) = D# (coshDouble# x)
+tanhDouble   (D# x) = D# (tanhDouble# x)
+
+powerDouble :: Double -> Double -> Double
+powerDouble  (D# x) (D# y) = D# (x **## y)
+\end{code}
+
+\begin{code}
+foreign import ccall unsafe "isFloatNaN" isFloatNaN :: Float -> Int
+foreign import ccall unsafe "isFloatInfinite" isFloatInfinite :: Float -> Int
+foreign import ccall unsafe "isFloatDenormalized" isFloatDenormalized :: Float -> Int
+foreign import ccall unsafe "isFloatNegativeZero" isFloatNegativeZero :: Float -> Int
+foreign import ccall unsafe "isFloatFinite" isFloatFinite :: Float -> Int
+
+foreign import ccall unsafe "isDoubleNaN" isDoubleNaN :: Double -> Int
+foreign import ccall unsafe "isDoubleInfinite" isDoubleInfinite :: Double -> Int
+foreign import ccall unsafe "isDoubleDenormalized" isDoubleDenormalized :: Double -> Int
+foreign import ccall unsafe "isDoubleNegativeZero" isDoubleNegativeZero :: Double -> Int
+foreign import ccall unsafe "isDoubleFinite" isDoubleFinite :: Double -> Int
+\end{code}
+
+%*********************************************************
+%*                                                      *
+\subsection{Coercion rules}
+%*                                                      *
+%*********************************************************
+
+\begin{code}
+
+word2Double :: Word -> Double
+word2Double (W# w) = D# (word2Double# w)
+
+word2Float :: Word -> Float
+word2Float (W# w) = F# (word2Float# w)
+
+{-# RULES
+"fromIntegral/Int->Float"   fromIntegral = int2Float
+"fromIntegral/Int->Double"  fromIntegral = int2Double
+"fromIntegral/Word->Float"  fromIntegral = word2Float
+"fromIntegral/Word->Double" fromIntegral = word2Double
+"realToFrac/Float->Float"   realToFrac   = id :: Float -> Float
+"realToFrac/Float->Double"  realToFrac   = float2Double
+"realToFrac/Double->Float"  realToFrac   = double2Float
+"realToFrac/Double->Double" realToFrac   = id :: Double -> Double
+"realToFrac/Int->Double"    realToFrac   = int2Double	-- See Note [realToFrac int-to-float]
+"realToFrac/Int->Float"     realToFrac   = int2Float	-- 	..ditto
+    #-}
+\end{code}
+
+Note [realToFrac int-to-float]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Don found that the RULES for realToFrac/Int->Double and simliarly
+Float made a huge difference to some stream-fusion programs.  Here's
+an example
+
+      import Data.Array.Vector
+
+      n = 40000000
+
+      main = do
+            let c = replicateU n (2::Double)
+                a = mapU realToFrac (enumFromToU 0 (n-1) ) :: UArr Double
+            print (sumU (zipWithU (*) c a))
+
+Without the RULE we get this loop body:
+
+      case $wtoRational sc_sY4 of ww_aM7 { (# ww1_aM9, ww2_aMa #) ->
+      case $wfromRat ww1_aM9 ww2_aMa of tpl_X1P { D# ipv_sW3 ->
+      Main.$s$wfold
+        (+# sc_sY4 1)
+        (+# wild_X1i 1)
+        (+## sc2_sY6 (*## 2.0 ipv_sW3))
+
+And with the rule:
+
+     Main.$s$wfold
+        (+# sc_sXT 1)
+        (+# wild_X1h 1)
+        (+## sc2_sXV (*## 2.0 (int2Double# sc_sXT)))
+
+The running time of the program goes from 120 seconds to 0.198 seconds
+with the native backend, and 0.143 seconds with the C backend.
+
+A few more details in Trac #2251, and the patch message
+"Add RULES for realToFrac from Int".
+
+%*********************************************************
+%*                                                      *
+\subsection{Utils}
+%*                                                      *
+%*********************************************************
+
+\begin{code}
+showSignedFloat :: (RealFloat a)
+  => (a -> ShowS)       -- ^ a function that can show unsigned values
+  -> Int                -- ^ the precedence of the enclosing context
+  -> a                  -- ^ the value to show
+  -> ShowS
+showSignedFloat showPos p x
+   | x < 0 || isNegativeZero x
+       = showParen (p > 6) (showChar '-' . showPos (-x))
+   | otherwise = showPos x
+\end{code}
+
+We need to prevent over/underflow of the exponent in encodeFloat when
+called from scaleFloat, hence we clamp the scaling parameter.
+We must have a large enough range to cover the maximum difference of
+exponents returned by decodeFloat.
+\begin{code}
+clamp :: Int -> Int -> Int
+clamp bd k = max (-bd) (min bd k)
+\end{code}
diff --git a/libraries/base/GHC/Float/ConversionUtils.hs b/libraries/base/GHC/Float/ConversionUtils.hs
new file mode 100644
index 000000000000..4d0674f12875
--- /dev/null
+++ b/libraries/base/GHC/Float/ConversionUtils.hs
@@ -0,0 +1,100 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE CPP, MagicHash, UnboxedTuples, NoImplicitPrelude #-}
+{-# OPTIONS_GHC -O2 #-}
+{-# OPTIONS_HADDOCK hide #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.Float.ConversionUtils
+-- Copyright   :  (c) Daniel Fischer 2010
+-- License     :  see libraries/base/LICENSE
+--
+-- Maintainer  :  cvs-ghc@haskell.org
+-- Stability   :  internal
+-- Portability :  non-portable (GHC Extensions)
+--
+-- Utilities for conversion between Double/Float and Rational
+--
+-----------------------------------------------------------------------------
+
+#include "MachDeps.h"
+
+module GHC.Float.ConversionUtils ( elimZerosInteger, elimZerosInt# ) where
+
+import GHC.Base
+import GHC.Integer
+#if WORD_SIZE_IN_BITS < 64
+import GHC.IntWord64
+#endif
+
+default ()
+
+#if WORD_SIZE_IN_BITS < 64
+
+#define TO64    integerToInt64
+
+toByte64# :: Int64# -> Int#
+toByte64# i = word2Int# (and# 255## (int2Word# (int64ToInt# i)))
+
+-- Double mantissae have 53 bits, too much for Int#
+elim64# :: Int64# -> Int# -> (# Integer, Int# #)
+elim64# n e =
+    case zeroCount (toByte64# n) of
+      t | isTrue# (e <=# t) -> (# int64ToInteger (uncheckedIShiftRA64# n e), 0# #)
+        | isTrue# (t <# 8#) -> (# int64ToInteger (uncheckedIShiftRA64# n t), e -# t #)
+        | otherwise         -> elim64# (uncheckedIShiftRA64# n 8#) (e -# 8#)
+
+#else
+
+#define TO64    integerToInt
+
+-- Double mantissae fit it Int#
+elim64# :: Int# -> Int# -> (# Integer, Int# #)
+elim64# = elimZerosInt#
+
+#endif
+
+{-# INLINE elimZerosInteger #-}
+elimZerosInteger :: Integer -> Int# -> (# Integer, Int# #)
+elimZerosInteger m e = elim64# (TO64 m) e
+
+elimZerosInt# :: Int# -> Int# -> (# Integer, Int# #)
+elimZerosInt# n e =
+    case zeroCount (toByte# n) of
+      t | isTrue# (e <=# t) -> (# smallInteger (uncheckedIShiftRA# n e), 0# #)
+        | isTrue# (t <# 8#) -> (# smallInteger (uncheckedIShiftRA# n t), e -# t #)
+        | otherwise         -> elimZerosInt# (uncheckedIShiftRA# n 8#) (e -# 8#)
+
+{-# INLINE zeroCount #-}
+zeroCount :: Int# -> Int#
+zeroCount i =
+    case zeroCountArr of
+      BA ba -> indexInt8Array# ba i
+
+toByte# :: Int# -> Int#
+toByte# i = word2Int# (and# 255## (int2Word# i))
+
+
+data BA = BA ByteArray#
+
+-- Number of trailing zero bits in a byte
+zeroCountArr :: BA
+zeroCountArr =
+    let mkArr s =
+          case newByteArray# 256# s of
+            (# s1, mba #) ->
+              case writeInt8Array# mba 0# 8# s1 of
+                s2 ->
+                  let fillA step val idx st
+                        | isTrue# (idx <# 256#) =
+                                        case writeInt8Array# mba idx val st of
+                                          nx -> fillA step val (idx +# step) nx
+                        | isTrue# (step <# 256#) =
+                                        fillA (2# *# step) (val +# 1#) step  st
+                        | otherwise   = st
+                  in case fillA 2# 0# 1# s2 of
+                       s3 -> case unsafeFreezeByteArray# mba s3 of
+                                (# _, ba #) -> ba
+    in case mkArr realWorld# of
+        b -> BA b
+
diff --git a/libraries/base/GHC/Float/RealFracMethods.hs b/libraries/base/GHC/Float/RealFracMethods.hs
new file mode 100644
index 000000000000..763ba93008ad
--- /dev/null
+++ b/libraries/base/GHC/Float/RealFracMethods.hs
@@ -0,0 +1,342 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE CPP, MagicHash, UnboxedTuples, NoImplicitPrelude #-}
+{-# OPTIONS_HADDOCK hide #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.Float.RealFracMethods
+-- Copyright   :  (c) Daniel Fischer 2010
+-- License     :  see libraries/base/LICENSE
+--
+-- Maintainer  :  cvs-ghc@haskell.org
+-- Stability   :  internal
+-- Portability :  non-portable (GHC Extensions)
+--
+-- Methods for the RealFrac instances for 'Float' and 'Double',
+-- with specialised versions for 'Int'.
+--
+-- Moved to their own module to not bloat GHC.Float further.
+--
+-----------------------------------------------------------------------------
+
+#include "MachDeps.h"
+
+module GHC.Float.RealFracMethods
+    ( -- * Double methods
+      -- ** Integer results
+      properFractionDoubleInteger
+    , truncateDoubleInteger
+    , floorDoubleInteger
+    , ceilingDoubleInteger
+    , roundDoubleInteger
+      -- ** Int results
+    , properFractionDoubleInt
+    , floorDoubleInt
+    , ceilingDoubleInt
+    , roundDoubleInt
+      -- * Double/Int conversions, wrapped primops
+    , double2Int
+    , int2Double
+      -- * Float methods
+      -- ** Integer results
+    , properFractionFloatInteger
+    , truncateFloatInteger
+    , floorFloatInteger
+    , ceilingFloatInteger
+    , roundFloatInteger
+      -- ** Int results
+    , properFractionFloatInt
+    , floorFloatInt
+    , ceilingFloatInt
+    , roundFloatInt
+      -- * Float/Int conversions, wrapped primops
+    , float2Int
+    , int2Float
+    ) where
+
+import GHC.Integer
+
+import GHC.Base
+import GHC.Num ()
+
+#if WORD_SIZE_IN_BITS < 64
+
+import GHC.IntWord64
+
+#define TO64 integerToInt64
+#define FROM64 int64ToInteger
+#define MINUS64 minusInt64#
+#define NEGATE64 negateInt64#
+
+#else
+
+#define TO64 integerToInt
+#define FROM64 smallInteger
+#define MINUS64 ( -# )
+#define NEGATE64 negateInt#
+
+uncheckedIShiftRA64# :: Int# -> Int# -> Int#
+uncheckedIShiftRA64# = uncheckedIShiftRA#
+
+uncheckedIShiftL64# :: Int# -> Int# -> Int#
+uncheckedIShiftL64# = uncheckedIShiftL#
+
+#endif
+
+default ()
+
+------------------------------------------------------------------------------
+--                              Float Methods                               --
+------------------------------------------------------------------------------
+
+-- Special Functions for Int, nice, easy and fast.
+-- They should be small enough to be inlined automatically.
+
+-- We have to test for ±0.0 to avoid returning -0.0 in the second
+-- component of the pair. Unfortunately the branching costs a lot
+-- of performance.
+properFractionFloatInt :: Float -> (Int, Float)
+properFractionFloatInt (F# x) =
+    if isTrue# (x `eqFloat#` 0.0#)
+        then (I# 0#, F# 0.0#)
+        else case float2Int# x of
+                n -> (I# n, F# (x `minusFloat#` int2Float# n))
+
+-- truncateFloatInt = float2Int
+
+floorFloatInt :: Float -> Int
+floorFloatInt (F# x) =
+    case float2Int# x of
+      n | isTrue# (x `ltFloat#` int2Float# n) -> I# (n -# 1#)
+        | otherwise                           -> I# n
+
+ceilingFloatInt :: Float -> Int
+ceilingFloatInt (F# x) =
+    case float2Int# x of
+      n | isTrue# (int2Float# n `ltFloat#` x) -> I# (n +# 1#)
+        | otherwise                           -> I# n
+
+roundFloatInt :: Float -> Int
+roundFloatInt x = float2Int (c_rintFloat x)
+
+-- Functions with Integer results
+
+-- With the new code generator in GHC 7, the explicit bit-fiddling is
+-- slower than the old code for values of small modulus, but when the
+-- 'Int' range is left, the bit-fiddling quickly wins big, so we use that.
+-- If the methods are called on smallish values, hopefully people go
+-- through Int and not larger types.
+
+-- Note: For negative exponents, we must check the validity of the shift
+-- distance for the right shifts of the mantissa.
+
+{-# INLINE properFractionFloatInteger #-}
+properFractionFloatInteger :: Float -> (Integer, Float)
+properFractionFloatInteger v@(F# x) =
+    case decodeFloat_Int# x of
+      (# m, e #)
+        | isTrue# (e <# 0#) ->
+          case negateInt# e of
+            s | isTrue# (s ># 23#) -> (0, v)
+              | isTrue# (m <#  0#) ->
+                case negateInt# (negateInt# m `uncheckedIShiftRA#` s) of
+                  k -> (smallInteger k,
+                            case m -# (k `uncheckedIShiftL#` s) of
+                              r -> F# (encodeFloatInteger (smallInteger r) e))
+              | otherwise           ->
+                case m `uncheckedIShiftRL#` s of
+                  k -> (smallInteger k,
+                            case m -# (k `uncheckedIShiftL#` s) of
+                              r -> F# (encodeFloatInteger (smallInteger r) e))
+        | otherwise -> (shiftLInteger (smallInteger m) e, F# 0.0#)
+
+{-# INLINE truncateFloatInteger #-}
+truncateFloatInteger :: Float -> Integer
+truncateFloatInteger x =
+    case properFractionFloatInteger x of
+      (n, _) -> n
+
+-- floor is easier for negative numbers than truncate, so this gets its
+-- own implementation, it's a little faster.
+{-# INLINE floorFloatInteger #-}
+floorFloatInteger :: Float -> Integer
+floorFloatInteger (F# x) =
+    case decodeFloat_Int# x of
+      (# m, e #)
+        | isTrue# (e <# 0#) ->
+          case negateInt# e of
+            s | isTrue# (s ># 23#) -> if isTrue# (m <# 0#) then (-1) else 0
+              | otherwise          -> smallInteger (m `uncheckedIShiftRA#` s)
+        | otherwise -> shiftLInteger (smallInteger m) e
+
+-- ceiling x = -floor (-x)
+-- If giving this its own implementation is faster at all,
+-- it's only marginally so, hence we keep it short.
+{-# INLINE ceilingFloatInteger #-}
+ceilingFloatInteger :: Float -> Integer
+ceilingFloatInteger (F# x) =
+    negateInteger (floorFloatInteger (F# (negateFloat# x)))
+
+{-# INLINE roundFloatInteger #-}
+roundFloatInteger :: Float -> Integer
+roundFloatInteger x = float2Integer (c_rintFloat x)
+
+------------------------------------------------------------------------------
+--                              Double Methods                              --
+------------------------------------------------------------------------------
+
+-- Special Functions for Int, nice, easy and fast.
+-- They should be small enough to be inlined automatically.
+
+-- We have to test for ±0.0 to avoid returning -0.0 in the second
+-- component of the pair. Unfortunately the branching costs a lot
+-- of performance.
+properFractionDoubleInt :: Double -> (Int, Double)
+properFractionDoubleInt (D# x) =
+    if isTrue# (x ==## 0.0##)
+        then (I# 0#, D# 0.0##)
+        else case double2Int# x of
+                n -> (I# n, D# (x -## int2Double# n))
+
+-- truncateDoubleInt = double2Int
+
+floorDoubleInt :: Double -> Int
+floorDoubleInt (D# x) =
+    case double2Int# x of
+      n | isTrue# (x <## int2Double# n) -> I# (n -# 1#)
+        | otherwise                     -> I# n
+
+ceilingDoubleInt :: Double -> Int
+ceilingDoubleInt (D# x) =
+    case double2Int# x of
+      n | isTrue# (int2Double# n <## x) -> I# (n +# 1#)
+        | otherwise                     -> I# n
+
+roundDoubleInt :: Double -> Int
+roundDoubleInt x = double2Int (c_rintDouble x)
+
+-- Functions with Integer results
+
+-- The new Code generator isn't quite as good for the old 'Double' code
+-- as for the 'Float' code, so for 'Double' the bit-fiddling also wins
+-- when the values have small modulus.
+
+-- When the exponent is negative, all mantissae have less than 64 bits
+-- and the right shifting of sized types is much faster than that of
+-- 'Integer's, especially when we can
+
+-- Note: For negative exponents, we must check the validity of the shift
+-- distance for the right shifts of the mantissa.
+
+{-# INLINE properFractionDoubleInteger #-}
+properFractionDoubleInteger :: Double -> (Integer, Double)
+properFractionDoubleInteger v@(D# x) =
+    case decodeDoubleInteger x of
+      (# m, e #)
+        | isTrue# (e <# 0#) ->
+          case negateInt# e of
+            s | isTrue# (s ># 52#) -> (0, v)
+              | m < 0                 ->
+                case TO64 (negateInteger m) of
+                  n ->
+                    case n `uncheckedIShiftRA64#` s of
+                      k ->
+                        (FROM64 (NEGATE64 k),
+                          case MINUS64 n (k `uncheckedIShiftL64#` s) of
+                            r ->
+                              D# (encodeDoubleInteger (FROM64 (NEGATE64 r)) e))
+              | otherwise           ->
+                case TO64 m of
+                  n ->
+                    case n `uncheckedIShiftRA64#` s of
+                      k -> (FROM64 k,
+                            case MINUS64 n (k `uncheckedIShiftL64#` s) of
+                              r -> D# (encodeDoubleInteger (FROM64 r) e))
+        | otherwise -> (shiftLInteger m e, D# 0.0##)
+
+{-# INLINE truncateDoubleInteger #-}
+truncateDoubleInteger :: Double -> Integer
+truncateDoubleInteger x =
+    case properFractionDoubleInteger x of
+      (n, _) -> n
+
+-- floor is easier for negative numbers than truncate, so this gets its
+-- own implementation, it's a little faster.
+{-# INLINE floorDoubleInteger #-}
+floorDoubleInteger :: Double -> Integer
+floorDoubleInteger (D# x) =
+    case decodeDoubleInteger x of
+      (# m, e #)
+        | isTrue# (e <# 0#) ->
+          case negateInt# e of
+            s | isTrue# (s ># 52#) -> if m < 0 then (-1) else 0
+              | otherwise          ->
+                case TO64 m of
+                  n -> FROM64 (n `uncheckedIShiftRA64#` s)
+        | otherwise -> shiftLInteger m e
+
+{-# INLINE ceilingDoubleInteger #-}
+ceilingDoubleInteger :: Double -> Integer
+ceilingDoubleInteger (D# x) =
+    negateInteger (floorDoubleInteger (D# (negateDouble# x)))
+
+{-# INLINE roundDoubleInteger #-}
+roundDoubleInteger :: Double -> Integer
+roundDoubleInteger x = double2Integer (c_rintDouble x)
+
+-- Wrappers around double2Int#, int2Double#, float2Int# and int2Float#,
+-- we need them here, so we move them from GHC.Float and re-export them
+-- explicitly from there.
+
+double2Int :: Double -> Int
+double2Int (D# x) = I# (double2Int# x)
+
+int2Double :: Int -> Double
+int2Double (I# i) = D# (int2Double# i)
+
+float2Int :: Float -> Int
+float2Int (F# x) = I# (float2Int# x)
+
+int2Float :: Int -> Float
+int2Float (I# i) = F# (int2Float# i)
+
+-- Quicker conversions from 'Double' and 'Float' to 'Integer',
+-- assuming the floating point value is integral.
+--
+-- Note: Since the value is integral, the exponent can't be less than
+-- (-TYP_MANT_DIG), so we need not check the validity of the shift
+-- distance for the right shfts here.
+
+{-# INLINE double2Integer #-}
+double2Integer :: Double -> Integer
+double2Integer (D# x) =
+    case decodeDoubleInteger x of
+      (# m, e #)
+        | isTrue# (e <# 0#) ->
+          case TO64 m of
+            n -> FROM64 (n `uncheckedIShiftRA64#` negateInt# e)
+        | otherwise -> shiftLInteger m e
+
+{-# INLINE float2Integer #-}
+float2Integer :: Float -> Integer
+float2Integer (F# x) =
+    case decodeFloat_Int# x of
+      (# m, e #)
+        | isTrue# (e <# 0#) -> smallInteger (m `uncheckedIShiftRA#` negateInt# e)
+        | otherwise         -> shiftLInteger (smallInteger m) e
+
+-- Foreign imports, the rounding is done faster in C when the value
+-- isn't integral, so we call out for rounding. For values of large
+-- modulus, calling out to C is slower than staying in Haskell, but
+-- presumably 'round' is mostly called for values with smaller modulus,
+-- when calling out to C is a major win.
+-- For all other functions, calling out to C gives at most a marginal
+-- speedup for values of small modulus and is much slower than staying
+-- in Haskell for values of large modulus, so those are done in Haskell.
+
+foreign import ccall unsafe "rintDouble"
+    c_rintDouble :: Double -> Double
+
+foreign import ccall unsafe "rintFloat"
+    c_rintFloat :: Float -> Float
+
diff --git a/libraries/base/GHC/Foreign.hs b/libraries/base/GHC/Foreign.hs
new file mode 100644
index 000000000000..ef64d4857257
--- /dev/null
+++ b/libraries/base/GHC/Foreign.hs
@@ -0,0 +1,256 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.Foreign
+-- Copyright   :  (c) The University of Glasgow, 2008-2011
+-- License     :  see libraries/base/LICENSE
+-- 
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  internal
+-- Portability :  non-portable
+--
+-- Foreign marshalling support for CStrings with configurable encodings
+--
+-----------------------------------------------------------------------------
+
+module GHC.Foreign (
+    -- * C strings with a configurable encoding
+    
+    -- conversion of C strings into Haskell strings
+    --
+    peekCString,
+    peekCStringLen,
+    
+    -- conversion of Haskell strings into C strings
+    --
+    newCString,
+    newCStringLen,
+    
+    -- conversion of Haskell strings into C strings using temporary storage
+    --
+    withCString,
+    withCStringLen,
+    
+    charIsRepresentable,
+  ) where
+
+import Foreign.Marshal.Array
+import Foreign.C.Types
+import Foreign.Ptr
+import Foreign.Storable
+
+import Data.Word
+
+-- Imports for the locale-encoding version of marshallers
+import Control.Monad
+
+import Data.Tuple (fst)
+import Data.Maybe
+
+import GHC.Show ( show )
+
+import Foreign.Marshal.Alloc
+import Foreign.ForeignPtr
+
+import GHC.Debug
+import GHC.List
+import GHC.Num
+import GHC.Base
+
+import GHC.IO
+import GHC.IO.Exception
+import GHC.IO.Buffer
+import GHC.IO.Encoding.Types
+
+
+c_DEBUG_DUMP :: Bool
+c_DEBUG_DUMP = False
+
+putDebugMsg :: String -> IO ()
+putDebugMsg | c_DEBUG_DUMP = debugLn
+            | otherwise    = const (return ())
+
+
+-- These definitions are identical to those in Foreign.C.String, but copied in here to avoid a cycle:
+type CString    = Ptr CChar
+type CStringLen = (Ptr CChar, Int)
+
+-- exported functions
+-- ------------------
+
+-- | Marshal a NUL terminated C string into a Haskell string.
+--
+peekCString    :: TextEncoding -> CString -> IO String
+peekCString enc cp = do
+    sz <- lengthArray0 nUL cp
+    peekEncodedCString enc (cp, sz * cCharSize)
+
+-- | Marshal a C string with explicit length into a Haskell string.
+--
+peekCStringLen           :: TextEncoding -> CStringLen -> IO String
+peekCStringLen = peekEncodedCString
+
+-- | Marshal a Haskell string into a NUL terminated C string.
+--
+-- * the Haskell string may /not/ contain any NUL characters
+--
+-- * new storage is allocated for the C string and must be
+--   explicitly freed using 'Foreign.Marshal.Alloc.free' or
+--   'Foreign.Marshal.Alloc.finalizerFree'.
+--
+newCString :: TextEncoding -> String -> IO CString
+newCString enc = liftM fst . newEncodedCString enc True
+
+-- | Marshal a Haskell string into a C string (ie, character array) with
+-- explicit length information.
+--
+-- * new storage is allocated for the C string and must be
+--   explicitly freed using 'Foreign.Marshal.Alloc.free' or
+--   'Foreign.Marshal.Alloc.finalizerFree'.
+--
+newCStringLen     :: TextEncoding -> String -> IO CStringLen
+newCStringLen enc = newEncodedCString enc False
+
+-- | Marshal a Haskell string into a NUL terminated C string using temporary
+-- storage.
+--
+-- * the Haskell string may /not/ contain any NUL characters
+--
+-- * the memory is freed when the subcomputation terminates (either
+--   normally or via an exception), so the pointer to the temporary
+--   storage must /not/ be used after this.
+--
+withCString :: TextEncoding -> String -> (CString -> IO a) -> IO a
+withCString enc s act = withEncodedCString enc True s $ \(cp, _sz) -> act cp
+
+-- | Marshal a Haskell string into a C string (ie, character array)
+-- in temporary storage, with explicit length information.
+--
+-- * the memory is freed when the subcomputation terminates (either
+--   normally or via an exception), so the pointer to the temporary
+--   storage must /not/ be used after this.
+--
+withCStringLen         :: TextEncoding -> String -> (CStringLen -> IO a) -> IO a
+withCStringLen enc = withEncodedCString enc False
+
+
+-- | Determines whether a character can be accurately encoded in a 'CString'.
+--
+-- Pretty much anyone who uses this function is in a state of sin because
+-- whether or not a character is encodable will, in general, depend on the
+-- context in which it occurs.
+charIsRepresentable :: TextEncoding -> Char -> IO Bool
+charIsRepresentable enc c = withCString enc [c] (fmap (== [c]) . peekCString enc) `catchException` (\e -> let _ = e :: IOException in return False)
+
+-- auxiliary definitions
+-- ----------------------
+
+-- C's end of string character
+nUL :: CChar
+nUL  = 0
+
+-- Size of a CChar in bytes
+cCharSize :: Int
+cCharSize = sizeOf (undefined :: CChar)
+
+
+{-# INLINE peekEncodedCString #-}
+peekEncodedCString :: TextEncoding -- ^ Encoding of CString
+                   -> CStringLen
+                   -> IO String    -- ^ String in Haskell terms
+peekEncodedCString (TextEncoding { mkTextDecoder = mk_decoder }) (p, sz_bytes)
+  = bracket mk_decoder close $ \decoder -> do
+      let chunk_size = sz_bytes `max` 1 -- Decode buffer chunk size in characters: one iteration only for ASCII
+      from0 <- fmap (\fp -> bufferAdd sz_bytes (emptyBuffer fp sz_bytes ReadBuffer)) $ newForeignPtr_ (castPtr p)
+      to <- newCharBuffer chunk_size WriteBuffer
+
+      let go iteration from = do
+            (why, from', to') <- encode decoder from to
+            if isEmptyBuffer from'
+             then
+              -- No input remaining: @why@ will be InputUnderflow, but we don't care
+              withBuffer to' $ peekArray (bufferElems to')
+             else do
+              -- Input remaining: what went wrong?
+              putDebugMsg ("peekEncodedCString: " ++ show iteration ++ " " ++ show why)
+              (from'', to'') <- case why of InvalidSequence -> recover decoder from' to' -- These conditions are equally bad because
+                                            InputUnderflow  -> recover decoder from' to' -- they indicate malformed/truncated input
+                                            OutputUnderflow -> return (from', to')       -- We will have more space next time round
+              putDebugMsg ("peekEncodedCString: from " ++ summaryBuffer from ++ " " ++ summaryBuffer from' ++ " " ++ summaryBuffer from'')
+              putDebugMsg ("peekEncodedCString: to " ++ summaryBuffer to ++ " " ++ summaryBuffer to' ++ " " ++ summaryBuffer to'')
+              to_chars <- withBuffer to'' $ peekArray (bufferElems to'')
+              fmap (to_chars++) $ go (iteration + 1) from''
+
+      go (0 :: Int) from0
+
+{-# INLINE withEncodedCString #-}
+withEncodedCString :: TextEncoding         -- ^ Encoding of CString to create
+                   -> Bool                 -- ^ Null-terminate?
+                   -> String               -- ^ String to encode
+                   -> (CStringLen -> IO a) -- ^ Worker that can safely use the allocated memory
+                   -> IO a
+withEncodedCString (TextEncoding { mkTextEncoder = mk_encoder }) null_terminate s act
+  = bracket mk_encoder close $ \encoder -> withArrayLen s $ \sz p -> do
+      from <- fmap (\fp -> bufferAdd sz (emptyBuffer fp sz ReadBuffer)) $ newForeignPtr_ p
+
+      let go iteration to_sz_bytes = do
+           putDebugMsg ("withEncodedCString: " ++ show iteration)
+           allocaBytes to_sz_bytes $ \to_p -> do
+            mb_res <- tryFillBufferAndCall encoder null_terminate from to_p to_sz_bytes act
+            case mb_res of
+              Nothing  -> go (iteration + 1) (to_sz_bytes * 2)
+              Just res -> return res
+
+      -- If the input string is ASCII, this value will ensure we only allocate once
+      go (0 :: Int) (cCharSize * (sz + 1))
+
+{-# INLINE newEncodedCString #-}
+newEncodedCString :: TextEncoding  -- ^ Encoding of CString to create
+                  -> Bool          -- ^ Null-terminate?
+                  -> String        -- ^ String to encode
+                  -> IO CStringLen
+newEncodedCString (TextEncoding { mkTextEncoder = mk_encoder }) null_terminate s
+  = bracket mk_encoder close $ \encoder -> withArrayLen s $ \sz p -> do
+      from <- fmap (\fp -> bufferAdd sz (emptyBuffer fp sz ReadBuffer)) $ newForeignPtr_ p
+
+      let go iteration to_p to_sz_bytes = do
+           putDebugMsg ("newEncodedCString: " ++ show iteration)
+           mb_res <- tryFillBufferAndCall encoder null_terminate from to_p to_sz_bytes return
+           case mb_res of
+             Nothing  -> do
+                 let to_sz_bytes' = to_sz_bytes * 2
+                 to_p' <- reallocBytes to_p to_sz_bytes'
+                 go (iteration + 1) to_p' to_sz_bytes'
+             Just res -> return res
+
+      -- If the input string is ASCII, this value will ensure we only allocate once
+      let to_sz_bytes = cCharSize * (sz + 1)
+      to_p <- mallocBytes to_sz_bytes
+      go (0 :: Int) to_p to_sz_bytes
+
+
+tryFillBufferAndCall :: TextEncoder dstate -> Bool -> Buffer Char -> Ptr Word8 -> Int
+                     -> (CStringLen -> IO a) -> IO (Maybe a)
+tryFillBufferAndCall encoder null_terminate from0 to_p to_sz_bytes act = do
+    to_fp <- newForeignPtr_ to_p
+    go (0 :: Int) (from0, emptyBuffer to_fp to_sz_bytes WriteBuffer)
+  where
+    go iteration (from, to) = do
+      (why, from', to') <- encode encoder from to
+      putDebugMsg ("tryFillBufferAndCall: " ++ show iteration ++ " " ++ show why ++ " " ++ summaryBuffer from ++ " " ++ summaryBuffer from')
+      if isEmptyBuffer from'
+       then if null_terminate && bufferAvailable to' == 0
+             then return Nothing -- We had enough for the string but not the terminator: ask the caller for more buffer
+             else do
+               -- Awesome, we had enough buffer
+               let bytes = bufferElems to'
+               withBuffer to' $ \to_ptr -> do
+                   when null_terminate $ pokeElemOff to_ptr (bufR to') 0
+                   fmap Just $ act (castPtr to_ptr, bytes) -- NB: the length information is specified as being in *bytes*
+       else case why of -- We didn't consume all of the input
+              InputUnderflow  -> recover encoder from' to' >>= go (iteration + 1) -- These conditions are equally bad
+              InvalidSequence -> recover encoder from' to' >>= go (iteration + 1) -- since the input was truncated/invalid
+              OutputUnderflow -> return Nothing -- Oops, out of buffer during decoding: ask the caller for more
+
diff --git a/libraries/base/GHC/ForeignPtr.hs b/libraries/base/GHC/ForeignPtr.hs
new file mode 100644
index 000000000000..fe7293e41ee7
--- /dev/null
+++ b/libraries/base/GHC/ForeignPtr.hs
@@ -0,0 +1,438 @@
+{-# LANGUAGE Unsafe #-}
+{-# LANGUAGE NoImplicitPrelude
+           , BangPatterns
+           , MagicHash
+           , UnboxedTuples
+  #-}
+{-# OPTIONS_HADDOCK hide #-}
+{-# LANGUAGE AutoDeriveTypeable, StandaloneDeriving #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.ForeignPtr
+-- Copyright   :  (c) The University of Glasgow, 1992-2003
+-- License     :  see libraries/base/LICENSE
+-- 
+-- Maintainer  :  cvs-ghc@haskell.org
+-- Stability   :  internal
+-- Portability :  non-portable (GHC extensions)
+--
+-- GHC's implementation of the 'ForeignPtr' data type.
+-- 
+-----------------------------------------------------------------------------
+
+module GHC.ForeignPtr
+  (
+        ForeignPtr(..),
+        ForeignPtrContents(..),
+        FinalizerPtr,
+        FinalizerEnvPtr,
+        newForeignPtr_,
+        mallocForeignPtr,
+        mallocPlainForeignPtr,
+        mallocForeignPtrBytes,
+        mallocPlainForeignPtrBytes,
+        mallocForeignPtrAlignedBytes,
+        mallocPlainForeignPtrAlignedBytes,
+        addForeignPtrFinalizer,
+        addForeignPtrFinalizerEnv,
+        touchForeignPtr,
+        unsafeForeignPtrToPtr,
+        castForeignPtr,
+        newConcForeignPtr,
+        addForeignPtrConcFinalizer,
+        finalizeForeignPtr
+  ) where
+
+import Control.Monad    ( sequence_ )
+import Foreign.Storable
+import Data.Typeable
+
+import GHC.Show
+import GHC.Base
+import GHC.IORef
+import GHC.STRef        ( STRef(..) )
+import GHC.Ptr          ( Ptr(..), FunPtr(..) )
+
+-- |The type 'ForeignPtr' represents references to objects that are
+-- maintained in a foreign language, i.e., that are not part of the
+-- data structures usually managed by the Haskell storage manager.
+-- The essential difference between 'ForeignPtr's and vanilla memory
+-- references of type @Ptr a@ is that the former may be associated
+-- with /finalizers/. A finalizer is a routine that is invoked when
+-- the Haskell storage manager detects that - within the Haskell heap
+-- and stack - there are no more references left that are pointing to
+-- the 'ForeignPtr'.  Typically, the finalizer will, then, invoke
+-- routines in the foreign language that free the resources bound by
+-- the foreign object.
+--
+-- The 'ForeignPtr' is parameterised in the same way as 'Ptr'.  The
+-- type argument of 'ForeignPtr' should normally be an instance of
+-- class 'Storable'.
+--
+data ForeignPtr a = ForeignPtr Addr# ForeignPtrContents
+                    deriving Typeable
+        -- we cache the Addr# in the ForeignPtr object, but attach
+        -- the finalizer to the IORef (or the MutableByteArray# in
+        -- the case of a MallocPtr).  The aim of the representation
+        -- is to make withForeignPtr efficient; in fact, withForeignPtr
+        -- should be just as efficient as unpacking a Ptr, and multiple
+        -- withForeignPtrs can share an unpacked ForeignPtr.  Note
+        -- that touchForeignPtr only has to touch the ForeignPtrContents
+        -- object, because that ensures that whatever the finalizer is
+        -- attached to is kept alive.
+
+data Finalizers
+  = NoFinalizers
+  | CFinalizers (Weak# ())
+  | HaskellFinalizers [IO ()]
+
+data ForeignPtrContents
+  = PlainForeignPtr !(IORef Finalizers)
+  | MallocPtr      (MutableByteArray# RealWorld) !(IORef Finalizers)
+  | PlainPtr       (MutableByteArray# RealWorld)
+
+instance Eq (ForeignPtr a) where
+    p == q  =  unsafeForeignPtrToPtr p == unsafeForeignPtrToPtr q
+
+instance Ord (ForeignPtr a) where
+    compare p q  =  compare (unsafeForeignPtrToPtr p) (unsafeForeignPtrToPtr q)
+
+instance Show (ForeignPtr a) where
+    showsPrec p f = showsPrec p (unsafeForeignPtrToPtr f)
+
+
+-- |A finalizer is represented as a pointer to a foreign function that, at
+-- finalisation time, gets as an argument a plain pointer variant of the
+-- foreign pointer that the finalizer is associated with.
+-- 
+-- Note that the foreign function /must/ use the @ccall@ calling convention.
+--
+type FinalizerPtr a        = FunPtr (Ptr a -> IO ())
+type FinalizerEnvPtr env a = FunPtr (Ptr env -> Ptr a -> IO ())
+
+newConcForeignPtr :: Ptr a -> IO () -> IO (ForeignPtr a)
+--
+-- ^Turns a plain memory reference into a foreign object by
+-- associating a finalizer - given by the monadic operation - with the
+-- reference.  The storage manager will start the finalizer, in a
+-- separate thread, some time after the last reference to the
+-- @ForeignPtr@ is dropped.  There is no guarantee of promptness, and
+-- in fact there is no guarantee that the finalizer will eventually
+-- run at all.
+--
+-- Note that references from a finalizer do not necessarily prevent
+-- another object from being finalized.  If A's finalizer refers to B
+-- (perhaps using 'touchForeignPtr', then the only guarantee is that
+-- B's finalizer will never be started before A's.  If both A and B
+-- are unreachable, then both finalizers will start together.  See
+-- 'touchForeignPtr' for more on finalizer ordering.
+--
+newConcForeignPtr p finalizer
+  = do fObj <- newForeignPtr_ p
+       addForeignPtrConcFinalizer fObj finalizer
+       return fObj
+
+mallocForeignPtr :: Storable a => IO (ForeignPtr a)
+-- ^ Allocate some memory and return a 'ForeignPtr' to it.  The memory
+-- will be released automatically when the 'ForeignPtr' is discarded.
+--
+-- 'mallocForeignPtr' is equivalent to
+--
+-- >    do { p <- malloc; newForeignPtr finalizerFree p }
+-- 
+-- although it may be implemented differently internally: you may not
+-- assume that the memory returned by 'mallocForeignPtr' has been
+-- allocated with 'Foreign.Marshal.Alloc.malloc'.
+--
+-- GHC notes: 'mallocForeignPtr' has a heavily optimised
+-- implementation in GHC.  It uses pinned memory in the garbage
+-- collected heap, so the 'ForeignPtr' does not require a finalizer to
+-- free the memory.  Use of 'mallocForeignPtr' and associated
+-- functions is strongly recommended in preference to 'newForeignPtr'
+-- with a finalizer.
+-- 
+mallocForeignPtr = doMalloc undefined
+  where doMalloc :: Storable b => b -> IO (ForeignPtr b)
+        doMalloc a
+          | I# size < 0 = error "mallocForeignPtr: size must be >= 0"
+          | otherwise = do
+          r <- newIORef NoFinalizers
+          IO $ \s ->
+            case newAlignedPinnedByteArray# size align s of { (# s', mbarr# #) ->
+             (# s', ForeignPtr (byteArrayContents# (unsafeCoerce# mbarr#))
+                               (MallocPtr mbarr# r) #)
+            }
+            where !(I# size)  = sizeOf a
+                  !(I# align) = alignment a
+
+-- | This function is similar to 'mallocForeignPtr', except that the
+-- size of the memory required is given explicitly as a number of bytes.
+mallocForeignPtrBytes :: Int -> IO (ForeignPtr a)
+mallocForeignPtrBytes size | size < 0 =
+  error "mallocForeignPtrBytes: size must be >= 0"
+mallocForeignPtrBytes (I# size) = do 
+  r <- newIORef NoFinalizers
+  IO $ \s ->
+     case newPinnedByteArray# size s      of { (# s', mbarr# #) ->
+       (# s', ForeignPtr (byteArrayContents# (unsafeCoerce# mbarr#))
+                         (MallocPtr mbarr# r) #)
+     }
+
+-- | This function is similar to 'mallocForeignPtrBytes', except that the
+-- size and alignment of the memory required is given explicitly as numbers of
+-- bytes.
+mallocForeignPtrAlignedBytes :: Int -> Int -> IO (ForeignPtr a)
+mallocForeignPtrAlignedBytes size _align | size < 0 =
+  error "mallocForeignPtrAlignedBytes: size must be >= 0"
+mallocForeignPtrAlignedBytes (I# size) (I# align) = do
+  r <- newIORef NoFinalizers
+  IO $ \s ->
+     case newAlignedPinnedByteArray# size align s of { (# s', mbarr# #) ->
+       (# s', ForeignPtr (byteArrayContents# (unsafeCoerce# mbarr#))
+                         (MallocPtr mbarr# r) #)
+     }
+
+-- | Allocate some memory and return a 'ForeignPtr' to it.  The memory
+-- will be released automatically when the 'ForeignPtr' is discarded.
+--
+-- GHC notes: 'mallocPlainForeignPtr' has a heavily optimised
+-- implementation in GHC.  It uses pinned memory in the garbage
+-- collected heap, as for mallocForeignPtr. Unlike mallocForeignPtr, a
+-- ForeignPtr created with mallocPlainForeignPtr carries no finalizers.
+-- It is not possible to add a finalizer to a ForeignPtr created with
+-- mallocPlainForeignPtr. This is useful for ForeignPtrs that will live
+-- only inside Haskell (such as those created for packed strings).
+-- Attempts to add a finalizer to a ForeignPtr created this way, or to
+-- finalize such a pointer, will throw an exception.
+-- 
+mallocPlainForeignPtr :: Storable a => IO (ForeignPtr a)
+mallocPlainForeignPtr = doMalloc undefined
+  where doMalloc :: Storable b => b -> IO (ForeignPtr b)
+        doMalloc a
+          | I# size < 0 = error "mallocForeignPtr: size must be >= 0"
+          | otherwise = IO $ \s ->
+            case newAlignedPinnedByteArray# size align s of { (# s', mbarr# #) ->
+             (# s', ForeignPtr (byteArrayContents# (unsafeCoerce# mbarr#))
+                               (PlainPtr mbarr#) #)
+            }
+            where !(I# size)  = sizeOf a
+                  !(I# align) = alignment a
+
+-- | This function is similar to 'mallocForeignPtrBytes', except that
+-- the internally an optimised ForeignPtr representation with no
+-- finalizer is used. Attempts to add a finalizer will cause an
+-- exception to be thrown.
+mallocPlainForeignPtrBytes :: Int -> IO (ForeignPtr a)
+mallocPlainForeignPtrBytes size | size < 0 =
+  error "mallocPlainForeignPtrBytes: size must be >= 0"
+mallocPlainForeignPtrBytes (I# size) = IO $ \s ->
+    case newPinnedByteArray# size s      of { (# s', mbarr# #) ->
+       (# s', ForeignPtr (byteArrayContents# (unsafeCoerce# mbarr#))
+                         (PlainPtr mbarr#) #)
+     }
+
+-- | This function is similar to 'mallocForeignPtrAlignedBytes', except that
+-- the internally an optimised ForeignPtr representation with no
+-- finalizer is used. Attempts to add a finalizer will cause an
+-- exception to be thrown.
+mallocPlainForeignPtrAlignedBytes :: Int -> Int -> IO (ForeignPtr a)
+mallocPlainForeignPtrAlignedBytes size _align | size < 0 =
+  error "mallocPlainForeignPtrAlignedBytes: size must be >= 0"
+mallocPlainForeignPtrAlignedBytes (I# size) (I# align) = IO $ \s ->
+    case newAlignedPinnedByteArray# size align s of { (# s', mbarr# #) ->
+       (# s', ForeignPtr (byteArrayContents# (unsafeCoerce# mbarr#))
+                         (PlainPtr mbarr#) #)
+     }
+
+addForeignPtrFinalizer :: FinalizerPtr a -> ForeignPtr a -> IO ()
+-- ^This function adds a finalizer to the given foreign object.  The
+-- finalizer will run /before/ all other finalizers for the same
+-- object which have already been registered.
+addForeignPtrFinalizer (FunPtr fp) (ForeignPtr p c) = case c of
+  PlainForeignPtr r -> f r >> return ()
+  MallocPtr     _ r -> f r >> return ()
+  _ -> error "GHC.ForeignPtr: attempt to add a finalizer to a plain pointer"
+ where
+    f r = insertCFinalizer r fp 0# nullAddr# p
+
+addForeignPtrFinalizerEnv ::
+  FinalizerEnvPtr env a -> Ptr env -> ForeignPtr a -> IO ()
+-- ^ Like 'addForeignPtrFinalizerEnv' but allows the finalizer to be
+-- passed an additional environment parameter to be passed to the
+-- finalizer.  The environment passed to the finalizer is fixed by the
+-- second argument to 'addForeignPtrFinalizerEnv'
+addForeignPtrFinalizerEnv (FunPtr fp) (Ptr ep) (ForeignPtr p c) = case c of
+  PlainForeignPtr r -> f r >> return ()
+  MallocPtr     _ r -> f r >> return ()
+  _ -> error "GHC.ForeignPtr: attempt to add a finalizer to a plain pointer"
+ where
+    f r = insertCFinalizer r fp 1# ep p
+
+addForeignPtrConcFinalizer :: ForeignPtr a -> IO () -> IO ()
+-- ^This function adds a finalizer to the given @ForeignPtr@.  The
+-- finalizer will run /before/ all other finalizers for the same
+-- object which have already been registered.
+--
+-- This is a variant of @addForeignPtrFinalizer@, where the finalizer
+-- is an arbitrary @IO@ action.  When it is invoked, the finalizer
+-- will run in a new thread.
+--
+-- NB. Be very careful with these finalizers.  One common trap is that
+-- if a finalizer references another finalized value, it does not
+-- prevent that value from being finalized.  In particular, 'Handle's
+-- are finalized objects, so a finalizer should not refer to a 'Handle'
+-- (including @stdout@, @stdin@ or @stderr@).
+--
+addForeignPtrConcFinalizer (ForeignPtr _ c) finalizer = 
+  addForeignPtrConcFinalizer_ c finalizer
+
+addForeignPtrConcFinalizer_ :: ForeignPtrContents -> IO () -> IO ()
+addForeignPtrConcFinalizer_ (PlainForeignPtr r) finalizer = do
+  noFinalizers <- insertHaskellFinalizer r finalizer
+  if noFinalizers
+     then IO $ \s ->
+              case r of { IORef (STRef r#) ->
+              case mkWeak# r# () (foreignPtrFinalizer r) s of {  (# s1, _ #) ->
+              (# s1, () #) }}
+     else return ()
+addForeignPtrConcFinalizer_ f@(MallocPtr fo r) finalizer = do
+  noFinalizers <- insertHaskellFinalizer r finalizer
+  if noFinalizers
+     then  IO $ \s -> 
+               case mkWeak# fo () (do foreignPtrFinalizer r; touch f) s of
+                  (# s1, _ #) -> (# s1, () #)
+     else return ()
+
+addForeignPtrConcFinalizer_ _ _ =
+  error "GHC.ForeignPtr: attempt to add a finalizer to plain pointer"
+
+insertHaskellFinalizer :: IORef Finalizers -> IO () -> IO Bool
+insertHaskellFinalizer r f = do
+  !wasEmpty <- atomicModifyIORef r $ \finalizers -> case finalizers of
+      NoFinalizers -> (HaskellFinalizers [f], True)
+      HaskellFinalizers fs -> (HaskellFinalizers (f:fs), False)
+      _ -> noMixingError
+  return wasEmpty
+
+-- | A box around Weak#, private to this module.
+data MyWeak = MyWeak (Weak# ())
+
+insertCFinalizer ::
+  IORef Finalizers -> Addr# -> Int# -> Addr# -> Addr# -> IO ()
+insertCFinalizer r fp flag ep p = do
+  MyWeak w <- ensureCFinalizerWeak r
+  IO $ \s -> case addCFinalizerToWeak# fp p flag ep w s of
+      (# s1, 1# #) -> (# s1, () #)
+
+      -- Failed to add the finalizer because some other thread
+      -- has finalized w by calling foreignPtrFinalizer. We retry now.
+      -- This won't be an infinite loop because that thread must have
+      -- replaced the content of r before calling finalizeWeak#.
+      (# s1, _ #) -> unIO (insertCFinalizer r fp flag ep p) s1
+
+ensureCFinalizerWeak :: IORef Finalizers -> IO MyWeak
+ensureCFinalizerWeak ref@(IORef (STRef r#)) = do
+  fin <- readIORef ref
+  case fin of
+      CFinalizers weak -> return (MyWeak weak)
+      HaskellFinalizers{} -> noMixingError
+      NoFinalizers -> IO $ \s ->
+          case mkWeakNoFinalizer# r# () s of { (# s1, w #) ->
+          case atomicModifyMutVar# r# (update w) s1 of
+              { (# s2, (weak, needKill ) #) ->
+          if needKill
+            then case finalizeWeak# w s2 of { (# s3, _, _ #) ->
+              (# s3, weak #) }
+            else (# s2, weak #) }}
+  where
+      update _ fin@(CFinalizers w) = (fin, (MyWeak w, True))
+      update w NoFinalizers = (CFinalizers w, (MyWeak w, False))
+      update _ _ = noMixingError
+
+noMixingError :: a
+noMixingError = error $
+   "GHC.ForeignPtr: attempt to mix Haskell and C finalizers " ++
+   "in the same ForeignPtr"
+
+foreignPtrFinalizer :: IORef Finalizers -> IO ()
+foreignPtrFinalizer r = do
+  fs <- atomicModifyIORef r $ \fs -> (NoFinalizers, fs) -- atomic, see #7170
+  case fs of
+    NoFinalizers -> return ()
+    CFinalizers w -> IO $ \s -> case finalizeWeak# w s of
+        (# s1, 1#, f #) -> f s1
+        (# s1, _, _ #) -> (# s1, () #)
+    HaskellFinalizers actions -> sequence_ actions
+
+newForeignPtr_ :: Ptr a -> IO (ForeignPtr a)
+-- ^Turns a plain memory reference into a foreign pointer that may be
+-- associated with finalizers by using 'addForeignPtrFinalizer'.
+newForeignPtr_ (Ptr obj) =  do
+  r <- newIORef NoFinalizers
+  return (ForeignPtr obj (PlainForeignPtr r))
+
+touchForeignPtr :: ForeignPtr a -> IO ()
+-- ^This function ensures that the foreign object in
+-- question is alive at the given place in the sequence of IO
+-- actions. In particular 'Foreign.ForeignPtr.withForeignPtr'
+-- does a 'touchForeignPtr' after it
+-- executes the user action.
+-- 
+-- Note that this function should not be used to express dependencies
+-- between finalizers on 'ForeignPtr's.  For example, if the finalizer
+-- for a 'ForeignPtr' @F1@ calls 'touchForeignPtr' on a second
+-- 'ForeignPtr' @F2@, then the only guarantee is that the finalizer
+-- for @F2@ is never started before the finalizer for @F1@.  They
+-- might be started together if for example both @F1@ and @F2@ are
+-- otherwise unreachable, and in that case the scheduler might end up
+-- running the finalizer for @F2@ first.
+--
+-- In general, it is not recommended to use finalizers on separate
+-- objects with ordering constraints between them.  To express the
+-- ordering robustly requires explicit synchronisation using @MVar@s
+-- between the finalizers, but even then the runtime sometimes runs
+-- multiple finalizers sequentially in a single thread (for
+-- performance reasons), so synchronisation between finalizers could
+-- result in artificial deadlock.  Another alternative is to use
+-- explicit reference counting.
+--
+touchForeignPtr (ForeignPtr _ r) = touch r
+
+touch :: ForeignPtrContents -> IO ()
+touch r = IO $ \s -> case touch# r s of s' -> (# s', () #)
+
+unsafeForeignPtrToPtr :: ForeignPtr a -> Ptr a
+-- ^This function extracts the pointer component of a foreign
+-- pointer.  This is a potentially dangerous operations, as if the
+-- argument to 'unsafeForeignPtrToPtr' is the last usage
+-- occurrence of the given foreign pointer, then its finalizer(s) will
+-- be run, which potentially invalidates the plain pointer just
+-- obtained.  Hence, 'touchForeignPtr' must be used
+-- wherever it has to be guaranteed that the pointer lives on - i.e.,
+-- has another usage occurrence.
+--
+-- To avoid subtle coding errors, hand written marshalling code
+-- should preferably use 'Foreign.ForeignPtr.withForeignPtr' rather
+-- than combinations of 'unsafeForeignPtrToPtr' and
+-- 'touchForeignPtr'.  However, the latter routines
+-- are occasionally preferred in tool generated marshalling code.
+unsafeForeignPtrToPtr (ForeignPtr fo _) = Ptr fo
+
+castForeignPtr :: ForeignPtr a -> ForeignPtr b
+-- ^This function casts a 'ForeignPtr'
+-- parameterised by one type into another type.
+castForeignPtr f = unsafeCoerce# f
+
+-- | Causes the finalizers associated with a foreign pointer to be run
+-- immediately.
+finalizeForeignPtr :: ForeignPtr a -> IO ()
+finalizeForeignPtr (ForeignPtr _ (PlainPtr _)) = return () -- no effect
+finalizeForeignPtr (ForeignPtr _ foreignPtr) = foreignPtrFinalizer refFinalizers
+        where
+                refFinalizers = case foreignPtr of
+                        (PlainForeignPtr ref) -> ref
+                        (MallocPtr     _ ref) -> ref
+                        PlainPtr _            ->
+                            error "finalizeForeignPtr PlainPtr"
+
diff --git a/libraries/base/GHC/GHCi.hs b/libraries/base/GHC/GHCi.hs
new file mode 100644
index 000000000000..f66d540574d9
--- /dev/null
+++ b/libraries/base/GHC/GHCi.hs
@@ -0,0 +1,43 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# OPTIONS_HADDOCK hide #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.GHCi
+-- Copyright   :  (c) The University of Glasgow 2012
+-- License     :  see libraries/base/LICENSE
+--
+-- Maintainer  :  cvs-ghc@haskell.org
+-- Stability   :  internal
+-- Portability :  non-portable (GHC Extensions)
+--
+-- The GHCi Monad lifting interface.
+--
+-- EXPERIMENTAL! DON'T USE.
+--
+-----------------------------------------------------------------------------
+
+module GHC.GHCi {-# WARNING "This is an unstable interface." #-} (
+        GHCiSandboxIO(..), NoIO()
+    ) where
+
+import GHC.Base (IO(), Monad, (>>=), return, id, (.))
+
+-- | A monad that can execute GHCi statements by lifting them out of
+-- m into the IO monad. (e.g state monads)
+class (Monad m) => GHCiSandboxIO m where
+    ghciStepIO :: m a -> IO a
+
+instance GHCiSandboxIO IO where
+    ghciStepIO = id
+
+-- | A monad that doesn't allow any IO.
+newtype NoIO a = NoIO { noio :: IO a }
+
+instance Monad NoIO where
+    return a  = NoIO (return a)
+    (>>=) k f = NoIO (noio k >>= noio . f)
+
+instance GHCiSandboxIO NoIO where
+    ghciStepIO = noio
+
diff --git a/libraries/base/GHC/Generics.hs b/libraries/base/GHC/Generics.hs
new file mode 100644
index 000000000000..1c818588bb95
--- /dev/null
+++ b/libraries/base/GHC/Generics.hs
@@ -0,0 +1,819 @@
+{-# LANGUAGE Trustworthy            #-}
+{-# LANGUAGE CPP                    #-}
+{-# LANGUAGE NoImplicitPrelude      #-}
+{-# LANGUAGE TypeSynonymInstances   #-}
+{-# LANGUAGE TypeOperators          #-}
+{-# LANGUAGE KindSignatures         #-}
+{-# LANGUAGE TypeFamilies           #-}
+{-# LANGUAGE StandaloneDeriving     #-}
+{-# LANGUAGE DeriveGeneric          #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.Generics
+-- Copyright   :  (c) Universiteit Utrecht 2010-2011, University of Oxford 2012-2013
+-- License     :  see libraries/base/LICENSE
+-- 
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  internal
+-- Portability :  non-portable
+--
+-- /Since: 4.6.0.0/
+-- 
+-- If you're using @GHC.Generics@, you should consider using the
+-- <http://hackage.haskell.org/package/generic-deriving> package, which 
+-- contains many useful generic functions.
+
+module GHC.Generics  (
+-- * Introduction
+--
+-- |
+--
+-- Datatype-generic functions are are based on the idea of converting values of
+-- a datatype @T@ into corresponding values of a (nearly) isomorphic type @'Rep' T@.
+-- The type @'Rep' T@ is
+-- built from a limited set of type constructors, all provided by this module. A
+-- datatype-generic function is then an overloaded function with instances
+-- for most of these type constructors, together with a wrapper that performs
+-- the mapping between @T@ and @'Rep' T@. By using this technique, we merely need
+-- a few generic instances in order to implement functionality that works for any
+-- representable type.
+--
+-- Representable types are collected in the 'Generic' class, which defines the
+-- associated type 'Rep' as well as conversion functions 'from' and 'to'.
+-- Typically, you will not define 'Generic' instances by hand, but have the compiler
+-- derive them for you.
+
+-- ** Representing datatypes
+--
+-- |
+--
+-- The key to defining your own datatype-generic functions is to understand how to
+-- represent datatypes using the given set of type constructors.
+--
+-- Let us look at an example first:
+--
+-- @
+-- data Tree a = Leaf a | Node (Tree a) (Tree a)
+--   deriving 'Generic'
+-- @
+--
+-- The above declaration (which requires the language pragma @DeriveGeneric@)
+-- causes the following representation to be generated:
+--
+-- @
+-- instance 'Generic' (Tree a) where
+--   type 'Rep' (Tree a) =
+--     'D1' D1Tree
+--       ('C1' C1_0Tree
+--          ('S1' 'NoSelector' ('Par0' a))
+--        ':+:'
+--        'C1' C1_1Tree
+--          ('S1' 'NoSelector' ('Rec0' (Tree a))
+--           ':*:'
+--           'S1' 'NoSelector' ('Rec0' (Tree a))))
+--   ...
+-- @
+--
+-- /Hint:/ You can obtain information about the code being generated from GHC by passing
+-- the @-ddump-deriv@ flag. In GHCi, you can expand a type family such as 'Rep' using
+-- the @:kind!@ command.
+--
+#if 0
+-- /TODO:/ Newer GHC versions abandon the distinction between 'Par0' and 'Rec0' and will
+-- use 'Rec0' everywhere.
+--
+#endif
+-- This is a lot of information! However, most of it is actually merely meta-information
+-- that makes names of datatypes and constructors and more available on the type level.
+--
+-- Here is a reduced representation for 'Tree' with nearly all meta-information removed,
+-- for now keeping only the most essential aspects:
+--
+-- @
+-- instance 'Generic' (Tree a) where
+--   type 'Rep' (Tree a) =
+--     'Par0' a
+--     ':+:'
+--     ('Rec0' (Tree a) ':*:' 'Rec0' (Tree a))
+-- @
+--
+-- The @Tree@ datatype has two constructors. The representation of individual constructors
+-- is combined using the binary type constructor ':+:'.
+--
+-- The first constructor consists of a single field, which is the parameter @a@. This is
+-- represented as @'Par0' a@.
+--
+-- The second constructor consists of two fields. Each is a recursive field of type @Tree a@,
+-- represented as @'Rec0' (Tree a)@. Representations of individual fields are combined using
+-- the binary type constructor ':*:'.
+--
+-- Now let us explain the additional tags being used in the complete representation:
+--
+--    * The @'S1' 'NoSelector'@ indicates that there is no record field selector associated with
+--      this field of the constructor.
+--
+--    * The @'C1' C1_0Tree@ and @'C1' C1_1Tree@ invocations indicate that the enclosed part is
+--      the representation of the first and second constructor of datatype @Tree@, respectively.
+--      Here, @C1_0Tree@ and @C1_1Tree@ are datatypes generated by the compiler as part of
+--      @deriving 'Generic'@. These datatypes are proxy types with no values. They are useful
+--      because they are instances of the type class 'Constructor'. This type class can be used
+--      to obtain information about the constructor in question, such as its name
+--      or infix priority.
+--
+--    * The @'D1' D1Tree@ tag indicates that the enclosed part is the representation of the
+--      datatype @Tree@. Again, @D1Tree@ is a datatype generated by the compiler. It is a
+--      proxy type, and is useful by being an instance of class 'Datatype', which
+--      can be used to obtain the name of a datatype, the module it has been defined in, and
+--      whether it has been defined using @data@ or @newtype@.
+
+-- ** Derived and fundamental representation types
+--
+-- |
+--
+-- There are many datatype-generic functions that do not distinguish between positions that
+-- are parameters or positions that are recursive calls. There are also many datatype-generic
+-- functions that do not care about the names of datatypes and constructors at all. To keep
+-- the number of cases to consider in generic functions in such a situation to a minimum,
+-- it turns out that many of the type constructors introduced above are actually synonyms,
+-- defining them to be variants of a smaller set of constructors.
+
+-- *** Individual fields of constructors: 'K1'
+--
+-- |
+--
+-- The type constructors 'Par0' and 'Rec0' are variants of 'K1':
+--
+-- @
+-- type 'Par0' = 'K1' 'P'
+-- type 'Rec0' = 'K1' 'R'
+-- @
+--
+-- Here, 'P' and 'R' are type-level proxies again that do not have any associated values.
+
+-- *** Meta information: 'M1'
+--
+-- |
+--
+-- The type constructors 'S1', 'C1' and 'D1' are all variants of 'M1':
+--
+-- @
+-- type 'S1' = 'M1' 'S'
+-- type 'C1' = 'M1' 'C'
+-- type 'D1' = 'M1' 'D'
+-- @
+--
+-- The types 'S', 'C' and 'R' are once again type-level proxies, just used to create
+-- several variants of 'M1'.
+
+-- *** Additional generic representation type constructors
+--
+-- |
+--
+-- Next to 'K1', 'M1', ':+:' and ':*:' there are a few more type constructors that occur
+-- in the representations of other datatypes.
+
+-- **** Empty datatypes: 'V1'
+--
+-- |
+--
+-- For empty datatypes, 'V1' is used as a representation. For example,
+--
+-- @
+-- data Empty deriving 'Generic'
+-- @
+--
+-- yields
+--
+-- @
+-- instance 'Generic' Empty where
+--   type 'Rep' Empty = 'D1' D1Empty 'V1'
+-- @
+
+-- **** Constructors without fields: 'U1'
+--
+-- |
+--
+-- If a constructor has no arguments, then 'U1' is used as its representation. For example
+-- the representation of 'Bool' is
+--
+-- @
+-- instance 'Generic' Bool where
+--   type 'Rep' Bool =
+--     'D1' D1Bool
+--       ('C1' C1_0Bool 'U1' ':+:' 'C1' C1_1Bool 'U1')
+-- @
+
+-- *** Representation of types with many constructors or many fields
+--
+-- |
+--
+-- As ':+:' and ':*:' are just binary operators, one might ask what happens if the
+-- datatype has more than two constructors, or a constructor with more than two
+-- fields. The answer is simple: the operators are used several times, to combine
+-- all the constructors and fields as needed. However, users /should not rely on
+-- a specific nesting strategy/ for ':+:' and ':*:' being used. The compiler is
+-- free to choose any nesting it prefers. (In practice, the current implementation
+-- tries to produce a more or less balanced nesting, so that the traversal of the
+-- structure of the datatype from the root to a particular component can be performed
+-- in logarithmic rather than linear time.)
+
+-- ** Defining datatype-generic functions
+--
+-- |
+--
+-- A datatype-generic function comprises two parts:
+--
+--    1. /Generic instances/ for the function, implementing it for most of the representation
+--       type constructors introduced above.
+--
+--    2. A /wrapper/ that for any datatype that is in `Generic`, performs the conversion
+--       between the original value and its `Rep`-based representation and then invokes the
+--       generic instances.
+--
+-- As an example, let us look at a function 'encode' that produces a naive, but lossless
+-- bit encoding of values of various datatypes. So we are aiming to define a function
+--
+-- @
+-- encode :: 'Generic' a => a -> [Bool]
+-- @
+--
+-- where we use 'Bool' as our datatype for bits.
+--
+-- For part 1, we define a class @Encode'@. Perhaps surprisingly, this class is parameterized
+-- over a type constructor @f@ of kind @* -> *@. This is a technicality: all the representation
+-- type constructors operate with kind @* -> *@ as base kind. But the type argument is never
+-- being used. This may be changed at some point in the future. The class has a single method,
+-- and we use the type we want our final function to have, but we replace the occurrences of
+-- the generic type argument @a@ with @f p@ (where the @p@ is any argument; it will not be used).
+--
+-- > class Encode' f where
+-- >   encode' :: f p -> [Bool]
+--
+-- With the goal in mind to make @encode@ work on @Tree@ and other datatypes, we now define
+-- instances for the representation type constructors 'V1', 'U1', ':+:', ':*:', 'K1', and 'M1'.
+
+-- *** Definition of the generic representation types
+--
+-- |
+--
+-- In order to be able to do this, we need to know the actual definitions of these types:
+--
+-- @
+-- data    'V1'        p                       -- lifted version of Empty
+-- data    'U1'        p = 'U1'                  -- lifted version of ()
+-- data    (':+:') f g p = 'L1' (f p) | 'R1' (g p) -- lifted version of 'Either'
+-- data    (':*:') f g p = (f p) ':*:' (g p)     -- lifted version of (,) 
+-- newtype 'K1'    i c p = 'K1' { 'unK1' :: c }    -- a container for a c
+-- newtype 'M1'  i t f p = 'M1' { 'unM1' :: f p }  -- a wrapper
+-- @
+--
+-- So, 'U1' is just the unit type, ':+:' is just a binary choice like 'Either',
+-- ':*:' is a binary pair like the pair constructor @(,)@, and 'K1' is a value
+-- of a specific type @c@, and 'M1' wraps a value of the generic type argument,
+-- which in the lifted world is an @f p@ (where we do not care about @p@).
+
+-- *** Generic instances
+--
+-- |
+--
+-- The instance for 'V1' is slightly awkward (but also rarely used):
+--
+-- @
+-- instance Encode' 'V1' where
+--   encode' x = undefined
+-- @
+--
+-- There are no values of type @V1 p@ to pass (except undefined), so this is
+-- actually impossible. One can ask why it is useful to define an instance for
+-- 'V1' at all in this case? Well, an empty type can be used as an argument to
+-- a non-empty type, and you might still want to encode the resulting type.
+-- As a somewhat contrived example, consider @[Empty]@, which is not an empty
+-- type, but contains just the empty list. The 'V1' instance ensures that we
+-- can call the generic function on such types.
+--
+-- There is exactly one value of type 'U1', so encoding it requires no
+-- knowledge, and we can use zero bits:
+--
+-- @
+-- instance Encode' 'U1' where
+--   encode' 'U1' = []
+-- @
+--
+-- In the case for ':+:', we produce 'False' or 'True' depending on whether
+-- the constructor of the value provided is located on the left or on the right:
+--
+-- @
+-- instance (Encode' f, Encode' g) => Encode' (f ':+:' g) where
+--   encode' ('L1' x) = False : encode' x
+--   encode' ('R1' x) = True  : encode' x
+-- @
+--
+-- In the case for ':*:', we append the encodings of the two subcomponents:
+--
+-- @
+-- instance (Encode' f, Encode' g) => Encode' (f ':*:' g) where
+--   encode' (x ':*:' y) = encode' x ++ encode' y
+-- @
+--
+-- The case for 'K1' is rather interesting. Here, we call the final function
+-- 'encode' that we yet have to define, recursively. We will use another type
+-- class 'Encode' for that function:
+--
+-- @
+-- instance (Encode c) => Encode' ('K1' i c) where
+--   encode' ('K1' x) = encode x
+-- @
+--
+-- Note how 'Par0' and 'Rec0' both being mapped to 'K1' allows us to define
+-- a uniform instance here.
+--
+-- Similarly, we can define a uniform instance for 'M1', because we completely
+-- disregard all meta-information:
+--
+-- @
+-- instance (Encode' f) => Encode' ('M1' i t f) where
+--   encode' ('M1' x) = encode' x
+-- @
+--
+-- Unlike in 'K1', the instance for 'M1' refers to 'encode'', not 'encode'.
+
+-- *** The wrapper and generic default
+--
+-- |
+--
+-- We now define class 'Encode' for the actual 'encode' function:
+--
+-- @
+-- class Encode a where
+--   encode :: a -> [Bool]
+--   default encode :: ('Generic' a) => a -> [Bool]
+--   encode x = encode' ('from' x)
+-- @
+--
+-- The incoming 'x' is converted using 'from', then we dispatch to the
+-- generic instances using 'encode''. We use this as a default definition
+-- for 'encode'. We need the 'default encode' signature because ordinary
+-- Haskell default methods must not introduce additional class constraints,
+-- but our generic default does.
+--
+-- Defining a particular instance is now as simple as saying
+--
+-- @
+-- instance (Encode a) => Encode (Tree a)
+-- @
+--
+#if 0
+-- /TODO:/ Add usage example?
+--
+#endif
+-- The generic default is being used. In the future, it will hopefully be
+-- possible to use @deriving Encode@ as well, but GHC does not yet support
+-- that syntax for this situation.
+--
+-- Having 'Encode' as a class has the advantage that we can define
+-- non-generic special cases, which is particularly useful for abstract
+-- datatypes that have no structural representation. For example, given
+-- a suitable integer encoding function 'encodeInt', we can define
+--
+-- @
+-- instance Encode Int where
+--   encode = encodeInt
+-- @
+
+-- *** Omitting generic instances
+--
+-- |
+--
+-- It is not always required to provide instances for all the generic
+-- representation types, but omitting instances restricts the set of
+-- datatypes the functions will work for:
+--
+--    * If no ':+:' instance is given, the function may still work for
+--      empty datatypes or datatypes that have a single constructor,
+--      but will fail on datatypes with more than one constructor.
+--
+--    * If no ':*:' instance is given, the function may still work for
+--      datatypes where each constructor has just zero or one field,
+--      in particular for enumeration types.
+--
+--    * If no 'K1' instance is given, the function may still work for
+--      enumeration types, where no constructor has any fields.
+--
+--    * If no 'V1' instance is given, the function may still work for
+--      any datatype that is not empty.
+--
+--    * If no 'U1' instance is given, the function may still work for
+--      any datatype where each constructor has at least one field.
+--
+-- An 'M1' instance is always required (but it can just ignore the
+-- meta-information, as is the case for 'encode' above).
+#if 0
+-- *** Using meta-information
+--
+-- |
+--
+-- TODO
+#endif
+-- ** Generic constructor classes
+--
+-- |
+--
+-- Datatype-generic functions as defined above work for a large class
+-- of datatypes, including parameterized datatypes. (We have used 'Tree'
+-- as our example above, which is of kind @* -> *@.) However, the
+-- 'Generic' class ranges over types of kind @*@, and therefore, the
+-- resulting generic functions (such as 'encode') must be parameterized
+-- by a generic type argument of kind @*@.
+--
+-- What if we want to define generic classes that range over type
+-- constructors (such as 'Functor', 'Traversable', or 'Foldable')?
+
+-- *** The 'Generic1' class
+--
+-- |
+--
+-- Like 'Generic', there is a class 'Generic1' that defines a
+-- representation 'Rep1' and conversion functions 'from1' and 'to1',
+-- only that 'Generic1' ranges over types of kind @* -> *@.
+-- The 'Generic1' class is also derivable.
+--
+-- The representation 'Rep1' is ever so slightly different from 'Rep'.
+-- Let us look at 'Tree' as an example again:
+--
+-- @
+-- data Tree a = Leaf a | Node (Tree a) (Tree a)
+--   deriving 'Generic1'
+-- @
+--
+-- The above declaration causes the following representation to be generated:
+--
+-- instance 'Generic1' Tree where
+--   type 'Rep1' Tree =
+--     'D1' D1Tree
+--       ('C1' C1_0Tree
+--          ('S1' 'NoSelector' 'Par1')
+--        ':+:'
+--        'C1' C1_1Tree
+--          ('S1' 'NoSelector' ('Rec1' Tree)
+--           ':*:'
+--           'S1' 'NoSelector' ('Rec1' Tree)))
+--   ...
+--
+-- The representation reuses 'D1', 'C1', 'S1' (and thereby 'M1') as well
+-- as ':+:' and ':*:' from 'Rep'. (This reusability is the reason that we
+-- carry around the dummy type argument for kind-@*@-types, but there are
+-- already enough different names involved without duplicating each of
+-- these.)
+--
+-- What's different is that we now use 'Par1' to refer to the parameter
+-- (and that parameter, which used to be @a@), is not mentioned explicitly
+-- by name anywhere; and we use 'Rec1' to refer to a recursive use of @Tree a@.
+
+-- *** Representation of @* -> *@ types
+--
+-- |
+--
+-- Unlike 'Par0' and 'Rec0', the 'Par1' and 'Rec1' type constructors do not
+-- map to 'K1'. They are defined directly, as follows:
+--
+-- @
+-- newtype 'Par1'   p = 'Par1' { 'unPar1' ::   p } -- gives access to parameter p
+-- newtype 'Rec1' f p = 'Rec1' { 'unRec1' :: f p } -- a wrapper
+-- @
+--
+-- In 'Par1', the parameter @p@ is used for the first time, whereas 'Rec1' simply
+-- wraps an application of @f@ to @p@.
+--
+-- Note that 'K1' (in the guise of 'Rec0') can still occur in a 'Rep1' representation,
+-- namely when the datatype has a field that does not mention the parameter.
+--
+-- The declaration
+--
+-- @
+-- data WithInt a = WithInt Int a
+--   deriving 'Generic1'
+-- @
+--
+-- yields
+--
+-- @
+-- class 'Rep1' WithInt where
+--   type 'Rep1' WithInt =
+--     'D1' D1WithInt
+--       ('C1' C1_0WithInt
+--         ('S1' 'NoSelector' ('Rec0' Int)
+--          ':*:'
+--          'S1' 'NoSelector' 'Par1'))
+-- @
+--
+-- If the parameter @a@ appears underneath a composition of other type constructors,
+-- then the representation involves composition, too:
+--
+-- @
+-- data Rose a = Fork a [Rose a]
+-- @
+--
+-- yields
+--
+-- @
+-- class 'Rep1' Rose where
+--   type 'Rep1' Rose =
+--     'D1' D1Rose
+--       ('C1' C1_0Rose
+--         ('S1' 'NoSelector' 'Par1'
+--          ':*:'
+--          'S1' 'NoSelector' ([] ':.:' 'Rec1' Rose)
+-- @
+--
+-- where
+--
+-- @
+-- newtype (':.:') f g p = 'Comp1' { 'unComp1' :: f (g p) }
+-- @
+#if 0
+-- *** Limitations
+--
+-- |
+--
+-- /TODO/
+--
+-- /TODO:/ Also clear up confusion about 'Rec0' and 'Rec1' not really indicating recursion.
+--
+#endif
+-----------------------------------------------------------------------------
+
+  -- * Generic representation types
+    V1, U1(..), Par1(..), Rec1(..), K1(..), M1(..)
+  , (:+:)(..), (:*:)(..), (:.:)(..)
+
+  -- ** Synonyms for convenience
+  , Rec0, Par0, R, P
+  , D1, C1, S1, D, C, S
+
+  -- * Meta-information
+  , Datatype(..), Constructor(..), Selector(..), NoSelector
+  , Fixity(..), Associativity(..), Arity(..), prec
+
+  -- * Generic type classes
+  , Generic(..), Generic1(..)
+
+  ) where
+
+-- We use some base types
+import GHC.Types
+import Data.Maybe ( Maybe(..) )
+import Data.Either ( Either(..) )
+
+-- Needed for instances
+import GHC.Classes ( Eq, Ord )
+import GHC.Read ( Read )
+import GHC.Show ( Show )
+import Data.Proxy
+
+--------------------------------------------------------------------------------
+-- Representation types
+--------------------------------------------------------------------------------
+
+-- | Void: used for datatypes without constructors
+data V1 p
+
+-- | Unit: used for constructors without arguments
+data U1 p = U1
+  deriving (Eq, Ord, Read, Show, Generic)
+
+-- | Used for marking occurrences of the parameter
+newtype Par1 p = Par1 { unPar1 :: p }
+  deriving (Eq, Ord, Read, Show, Generic)
+
+-- | Recursive calls of kind * -> *
+newtype Rec1 f p = Rec1 { unRec1 :: f p }
+  deriving (Eq, Ord, Read, Show, Generic)
+
+-- | Constants, additional parameters and recursion of kind *
+newtype K1 i c p = K1 { unK1 :: c }
+  deriving (Eq, Ord, Read, Show, Generic)
+
+-- | Meta-information (constructor names, etc.)
+newtype M1 i c f p = M1 { unM1 :: f p }
+  deriving (Eq, Ord, Read, Show, Generic)
+
+-- | Sums: encode choice between constructors
+infixr 5 :+:
+data (:+:) f g p = L1 (f p) | R1 (g p)
+  deriving (Eq, Ord, Read, Show, Generic)
+
+-- | Products: encode multiple arguments to constructors
+infixr 6 :*:
+data (:*:) f g p = f p :*: g p
+  deriving (Eq, Ord, Read, Show, Generic)
+
+-- | Composition of functors
+infixr 7 :.:
+newtype (:.:) f g p = Comp1 { unComp1 :: f (g p) }
+  deriving (Eq, Ord, Read, Show, Generic)
+
+-- | Tag for K1: recursion (of kind *)
+data R
+-- | Tag for K1: parameters (other than the last)
+data P
+
+-- | Type synonym for encoding recursion (of kind *)
+type Rec0  = K1 R
+-- | Type synonym for encoding parameters (other than the last)
+type Par0  = K1 P
+{-# DEPRECATED Par0 "'Par0' is no longer used; use 'Rec0' instead" #-} -- deprecated in 7.6
+{-# DEPRECATED P "'P' is no longer used; use 'R' instead" #-} -- deprecated in 7.6
+
+-- | Tag for M1: datatype
+data D
+-- | Tag for M1: constructor
+data C
+-- | Tag for M1: record selector
+data S
+
+-- | Type synonym for encoding meta-information for datatypes
+type D1 = M1 D
+
+-- | Type synonym for encoding meta-information for constructors
+type C1 = M1 C
+
+-- | Type synonym for encoding meta-information for record selectors
+type S1 = M1 S
+
+
+-- | Class for datatypes that represent datatypes
+class Datatype d where
+  -- | The name of the datatype (unqualified)
+  datatypeName :: t d (f :: * -> *) a -> [Char]
+  -- | The fully-qualified name of the module where the type is declared
+  moduleName   :: t d (f :: * -> *) a -> [Char]
+  -- | Marks if the datatype is actually a newtype
+  isNewtype    :: t d (f :: * -> *) a -> Bool
+  isNewtype _ = False
+
+
+-- | Class for datatypes that represent records
+class Selector s where
+  -- | The name of the selector
+  selName :: t s (f :: * -> *) a -> [Char]
+
+-- | Used for constructor fields without a name
+data NoSelector
+
+instance Selector NoSelector where selName _ = ""
+
+-- | Class for datatypes that represent data constructors
+class Constructor c where
+  -- | The name of the constructor
+  conName :: t c (f :: * -> *) a -> [Char]
+
+  -- | The fixity of the constructor
+  conFixity :: t c (f :: * -> *) a -> Fixity
+  conFixity _ = Prefix
+
+  -- | Marks if this constructor is a record
+  conIsRecord :: t c (f :: * -> *) a -> Bool
+  conIsRecord _ = False
+
+
+-- | Datatype to represent the arity of a tuple.
+data Arity = NoArity | Arity Int
+  deriving (Eq, Show, Ord, Read, Generic)
+
+-- | Datatype to represent the fixity of a constructor. An infix
+-- | declaration directly corresponds to an application of 'Infix'.
+data Fixity = Prefix | Infix Associativity Int
+  deriving (Eq, Show, Ord, Read, Generic)
+
+-- | Get the precedence of a fixity value.
+prec :: Fixity -> Int
+prec Prefix      = 10
+prec (Infix _ n) = n
+
+-- | Datatype to represent the associativity of a constructor
+data Associativity = LeftAssociative
+                   | RightAssociative
+                   | NotAssociative
+  deriving (Eq, Show, Ord, Read, Generic)
+
+-- | Representable types of kind *.
+-- This class is derivable in GHC with the DeriveGeneric flag on.
+class Generic a where
+  -- | Generic representation type
+  type Rep a :: * -> *
+  -- | Convert from the datatype to its representation
+  from  :: a -> (Rep a) x
+  -- | Convert from the representation to the datatype
+  to    :: (Rep a) x -> a
+
+
+-- | Representable types of kind * -> *.
+-- This class is derivable in GHC with the DeriveGeneric flag on.
+class Generic1 f where
+  -- | Generic representation type
+  type Rep1 f :: * -> *
+  -- | Convert from the datatype to its representation
+  from1  :: f a -> (Rep1 f) a
+  -- | Convert from the representation to the datatype
+  to1    :: (Rep1 f) a -> f a
+
+
+--------------------------------------------------------------------------------
+-- Derived instances
+--------------------------------------------------------------------------------
+deriving instance Generic [a]
+deriving instance Generic (Maybe a)
+deriving instance Generic (Either a b)
+deriving instance Generic Bool
+deriving instance Generic Ordering
+deriving instance Generic ()
+deriving instance Generic ((,) a b)
+deriving instance Generic ((,,) a b c)
+deriving instance Generic ((,,,) a b c d)
+deriving instance Generic ((,,,,) a b c d e)
+deriving instance Generic ((,,,,,) a b c d e f)
+deriving instance Generic ((,,,,,,) a b c d e f g)
+
+deriving instance Generic1 []
+deriving instance Generic1 Maybe
+deriving instance Generic1 (Either a)
+deriving instance Generic1 ((,) a)
+deriving instance Generic1 ((,,) a b)
+deriving instance Generic1 ((,,,) a b c)
+deriving instance Generic1 ((,,,,) a b c d)
+deriving instance Generic1 ((,,,,,) a b c d e)
+deriving instance Generic1 ((,,,,,,) a b c d e f)
+
+--------------------------------------------------------------------------------
+-- Primitive representations
+--------------------------------------------------------------------------------
+
+-- Int
+data D_Int
+data C_Int
+
+instance Datatype D_Int where
+  datatypeName _ = "Int"
+  moduleName   _ = "GHC.Int"
+
+instance Constructor C_Int where
+  conName _ = "" -- JPM: I'm not sure this is the right implementation...
+
+instance Generic Int where
+  type Rep Int = D1 D_Int (C1 C_Int (S1 NoSelector (Rec0 Int)))
+  from x = M1 (M1 (M1 (K1 x)))
+  to (M1 (M1 (M1 (K1 x)))) = x
+
+
+-- Float
+data D_Float
+data C_Float
+
+instance Datatype D_Float where
+  datatypeName _ = "Float"
+  moduleName   _ = "GHC.Float"
+
+instance Constructor C_Float where
+  conName _ = "" -- JPM: I'm not sure this is the right implementation...
+
+instance Generic Float where
+  type Rep Float = D1 D_Float (C1 C_Float (S1 NoSelector (Rec0 Float)))
+  from x = M1 (M1 (M1 (K1 x)))
+  to (M1 (M1 (M1 (K1 x)))) = x
+
+
+-- Double
+data D_Double
+data C_Double
+
+instance Datatype D_Double where
+  datatypeName _ = "Double"
+  moduleName   _ = "GHC.Float"
+
+instance Constructor C_Double where
+  conName _ = "" -- JPM: I'm not sure this is the right implementation...
+
+instance Generic Double where
+  type Rep Double = D1 D_Double (C1 C_Double (S1 NoSelector (Rec0 Double)))
+  from x = M1 (M1 (M1 (K1 x)))
+  to (M1 (M1 (M1 (K1 x)))) = x
+
+
+-- Char
+data D_Char
+data C_Char
+
+instance Datatype D_Char where
+  datatypeName _ = "Char"
+  moduleName   _ = "GHC.Base"
+
+instance Constructor C_Char where
+  conName _ = "" -- JPM: I'm not sure this is the right implementation...
+
+instance Generic Char where
+  type Rep Char = D1 D_Char (C1 C_Char (S1 NoSelector (Rec0 Char)))
+  from x = M1 (M1 (M1 (K1 x)))
+  to (M1 (M1 (M1 (K1 x)))) = x
+
+deriving instance Generic (Proxy t)
diff --git a/libraries/base/GHC/IO.hs b/libraries/base/GHC/IO.hs
new file mode 100644
index 000000000000..53096656d66e
--- /dev/null
+++ b/libraries/base/GHC/IO.hs
@@ -0,0 +1,481 @@
+{-# LANGUAGE Unsafe #-}
+{-# LANGUAGE NoImplicitPrelude
+           , BangPatterns
+           , RankNTypes
+           , MagicHash
+           , UnboxedTuples
+  #-}
+{-# OPTIONS_GHC -funbox-strict-fields #-}
+{-# OPTIONS_HADDOCK hide #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.IO
+-- Copyright   :  (c) The University of Glasgow 1994-2002
+-- License     :  see libraries/base/LICENSE
+-- 
+-- Maintainer  :  cvs-ghc@haskell.org
+-- Stability   :  internal
+-- Portability :  non-portable (GHC Extensions)
+--
+-- Definitions for the 'IO' monad and its friends.
+--
+-----------------------------------------------------------------------------
+
+module GHC.IO (
+        IO(..), unIO, failIO, liftIO,
+        unsafePerformIO, unsafeInterleaveIO,
+        unsafeDupablePerformIO, unsafeDupableInterleaveIO,
+        noDuplicate,
+
+        -- To and from from ST
+        stToIO, ioToST, unsafeIOToST, unsafeSTToIO,
+
+        FilePath,
+
+        catchException, catchAny, throwIO,
+        mask, mask_, uninterruptibleMask, uninterruptibleMask_, 
+        MaskingState(..), getMaskingState,
+        unsafeUnmask,
+        onException, bracket, finally, evaluate
+    ) where
+
+import GHC.Base
+import GHC.ST
+import GHC.Exception
+import GHC.Show
+import Data.Maybe
+
+import {-# SOURCE #-} GHC.IO.Exception ( userError )
+
+-- ---------------------------------------------------------------------------
+-- The IO Monad
+
+{-
+The IO Monad is just an instance of the ST monad, where the state is
+the real world.  We use the exception mechanism (in GHC.Exception) to
+implement IO exceptions.
+
+NOTE: The IO representation is deeply wired in to various parts of the
+system.  The following list may or may not be exhaustive:
+
+Compiler  - types of various primitives in PrimOp.lhs
+
+RTS       - forceIO (StgMiscClosures.hc)
+          - catchzh_fast, (un)?blockAsyncExceptionszh_fast, raisezh_fast 
+            (Exceptions.hc)
+          - raiseAsync (Schedule.c)
+
+Prelude   - GHC.IO.lhs, and several other places including
+            GHC.Exception.lhs.
+
+Libraries - parts of hslibs/lang.
+
+--SDM
+-}
+
+liftIO :: IO a -> State# RealWorld -> STret RealWorld a
+liftIO (IO m) = \s -> case m s of (# s', r #) -> STret s' r
+
+failIO :: String -> IO a
+failIO s = IO (raiseIO# (toException (userError s)))
+
+-- ---------------------------------------------------------------------------
+-- Coercions between IO and ST
+
+-- | A monad transformer embedding strict state transformers in the 'IO'
+-- monad.  The 'RealWorld' parameter indicates that the internal state
+-- used by the 'ST' computation is a special one supplied by the 'IO'
+-- monad, and thus distinct from those used by invocations of 'runST'.
+stToIO        :: ST RealWorld a -> IO a
+stToIO (ST m) = IO m
+
+ioToST        :: IO a -> ST RealWorld a
+ioToST (IO m) = (ST m)
+
+-- This relies on IO and ST having the same representation modulo the
+-- constraint on the type of the state
+--
+unsafeIOToST        :: IO a -> ST s a
+unsafeIOToST (IO io) = ST $ \ s -> (unsafeCoerce# io) s
+
+unsafeSTToIO :: ST s a -> IO a
+unsafeSTToIO (ST m) = IO (unsafeCoerce# m)
+
+-- ---------------------------------------------------------------------------
+-- Unsafe IO operations
+
+{-|
+This is the \"back door\" into the 'IO' monad, allowing
+'IO' computation to be performed at any time.  For
+this to be safe, the 'IO' computation should be
+free of side effects and independent of its environment.
+
+If the I\/O computation wrapped in 'unsafePerformIO' performs side
+effects, then the relative order in which those side effects take
+place (relative to the main I\/O trunk, or other calls to
+'unsafePerformIO') is indeterminate.  Furthermore, when using
+'unsafePerformIO' to cause side-effects, you should take the following
+precautions to ensure the side effects are performed as many times as
+you expect them to be.  Note that these precautions are necessary for
+GHC, but may not be sufficient, and other compilers may require
+different precautions:
+
+  * Use @{\-\# NOINLINE foo \#-\}@ as a pragma on any function @foo@
+        that calls 'unsafePerformIO'.  If the call is inlined,
+        the I\/O may be performed more than once.
+
+  * Use the compiler flag @-fno-cse@ to prevent common sub-expression
+        elimination being performed on the module, which might combine
+        two side effects that were meant to be separate.  A good example
+        is using multiple global variables (like @test@ in the example below).
+
+  * Make sure that the either you switch off let-floating (@-fno-full-laziness@), or that the 
+        call to 'unsafePerformIO' cannot float outside a lambda.  For example, 
+        if you say:
+        @
+           f x = unsafePerformIO (newIORef [])
+        @
+        you may get only one reference cell shared between all calls to @f@.
+        Better would be
+        @
+           f x = unsafePerformIO (newIORef [x])
+        @
+        because now it can't float outside the lambda.
+
+It is less well known that
+'unsafePerformIO' is not type safe.  For example:
+
+>     test :: IORef [a]
+>     test = unsafePerformIO $ newIORef []
+>     
+>     main = do
+>             writeIORef test [42]
+>             bang <- readIORef test
+>             print (bang :: [Char])
+
+This program will core dump.  This problem with polymorphic references
+is well known in the ML community, and does not arise with normal
+monadic use of references.  There is no easy way to make it impossible
+once you use 'unsafePerformIO'.  Indeed, it is
+possible to write @coerce :: a -> b@ with the
+help of 'unsafePerformIO'.  So be careful!
+-}
+unsafePerformIO :: IO a -> a
+unsafePerformIO m = unsafeDupablePerformIO (noDuplicate >> m)
+
+{-| 
+This version of 'unsafePerformIO' is more efficient
+because it omits the check that the IO is only being performed by a
+single thread.  Hence, when you use 'unsafeDupablePerformIO',
+there is a possibility that the IO action may be performed multiple
+times (on a multiprocessor), and you should therefore ensure that
+it gives the same results each time. It may even happen that one
+of the duplicated IO actions is only run partially, and then interrupted
+in the middle without an exception being raised. Therefore, functions
+like 'bracket' cannot be used safely within 'unsafeDupablePerformIO'.
+
+/Since: 4.4.0.0/
+-}
+{-# NOINLINE unsafeDupablePerformIO #-}
+unsafeDupablePerformIO  :: IO a -> a
+unsafeDupablePerformIO (IO m) = lazy (case m realWorld# of (# _, r #) -> r)
+
+-- Why do we NOINLINE unsafeDupablePerformIO?  See the comment with
+-- GHC.ST.runST.  Essentially the issue is that the IO computation
+-- inside unsafePerformIO must be atomic: it must either all run, or
+-- not at all.  If we let the compiler see the application of the IO
+-- to realWorld#, it might float out part of the IO.
+
+-- Why is there a call to 'lazy' in unsafeDupablePerformIO?
+-- If we don't have it, the demand analyser discovers the following strictness
+-- for unsafeDupablePerformIO:  C(U(AV))
+-- But then consider
+--      unsafeDupablePerformIO (\s -> let r = f x in 
+--                             case writeIORef v r s of (# s1, _ #) ->
+--                             (# s1, r #)
+-- The strictness analyser will find that the binding for r is strict,
+-- (because of uPIO's strictness sig), and so it'll evaluate it before 
+-- doing the writeIORef.  This actually makes tests/lib/should_run/memo002
+-- get a deadlock!  
+--
+-- Solution: don't expose the strictness of unsafeDupablePerformIO,
+--           by hiding it with 'lazy'
+
+{-|
+'unsafeInterleaveIO' allows 'IO' computation to be deferred lazily.
+When passed a value of type @IO a@, the 'IO' will only be performed
+when the value of the @a@ is demanded.  This is used to implement lazy
+file reading, see 'System.IO.hGetContents'.
+-}
+{-# INLINE unsafeInterleaveIO #-}
+unsafeInterleaveIO :: IO a -> IO a
+unsafeInterleaveIO m = unsafeDupableInterleaveIO (noDuplicate >> m)
+
+-- We used to believe that INLINE on unsafeInterleaveIO was safe,
+-- because the state from this IO thread is passed explicitly to the
+-- interleaved IO, so it cannot be floated out and shared.
+--
+-- HOWEVER, if the compiler figures out that r is used strictly here,
+-- then it will eliminate the thunk and the side effects in m will no
+-- longer be shared in the way the programmer was probably expecting,
+-- but can be performed many times.  In #5943, this broke our
+-- definition of fixIO, which contains
+--
+--    ans <- unsafeInterleaveIO (takeMVar m)
+--
+-- after inlining, we lose the sharing of the takeMVar, so the second
+-- time 'ans' was demanded we got a deadlock.  We could fix this with
+-- a readMVar, but it seems wrong for unsafeInterleaveIO to sometimes
+-- share and sometimes not (plus it probably breaks the noDuplicate).
+-- So now, we do not inline unsafeDupableInterleaveIO.
+
+{-# NOINLINE unsafeDupableInterleaveIO #-}
+unsafeDupableInterleaveIO :: IO a -> IO a
+unsafeDupableInterleaveIO (IO m)
+  = IO ( \ s -> let
+                   r = case m s of (# _, res #) -> res
+                in
+                (# s, r #))
+
+{-| 
+Ensures that the suspensions under evaluation by the current thread
+are unique; that is, the current thread is not evaluating anything
+that is also under evaluation by another thread that has also executed
+'noDuplicate'.
+
+This operation is used in the definition of 'unsafePerformIO' to
+prevent the IO action from being executed multiple times, which is usually
+undesirable.
+-}
+noDuplicate :: IO ()
+noDuplicate = IO $ \s -> case noDuplicate# s of s' -> (# s', () #)
+
+-- -----------------------------------------------------------------------------
+-- | File and directory names are values of type 'String', whose precise
+-- meaning is operating system dependent. Files can be opened, yielding a
+-- handle which can then be used to operate on the contents of that file.
+
+type FilePath = String
+
+-- -----------------------------------------------------------------------------
+-- Primitive catch and throwIO
+
+{-
+catchException used to handle the passing around of the state to the
+action and the handler.  This turned out to be a bad idea - it meant
+that we had to wrap both arguments in thunks so they could be entered
+as normal (remember IO returns an unboxed pair...).
+
+Now catch# has type
+
+    catch# :: IO a -> (b -> IO a) -> IO a
+
+(well almost; the compiler doesn't know about the IO newtype so we
+have to work around that in the definition of catchException below).
+-}
+
+catchException :: Exception e => IO a -> (e -> IO a) -> IO a
+catchException (IO io) handler = IO $ catch# io handler'
+    where handler' e = case fromException e of
+                       Just e' -> unIO (handler e')
+                       Nothing -> raiseIO# e
+
+catchAny :: IO a -> (forall e . Exception e => e -> IO a) -> IO a
+catchAny (IO io) handler = IO $ catch# io handler'
+    where handler' (SomeException e) = unIO (handler e)
+
+-- | A variant of 'throw' that can only be used within the 'IO' monad.
+--
+-- Although 'throwIO' has a type that is an instance of the type of 'throw', the
+-- two functions are subtly different:
+--
+-- > throw e   `seq` x  ===> throw e
+-- > throwIO e `seq` x  ===> x
+--
+-- The first example will cause the exception @e@ to be raised,
+-- whereas the second one won\'t.  In fact, 'throwIO' will only cause
+-- an exception to be raised when it is used within the 'IO' monad.
+-- The 'throwIO' variant should be used in preference to 'throw' to
+-- raise an exception within the 'IO' monad because it guarantees
+-- ordering with respect to other 'IO' operations, whereas 'throw'
+-- does not.
+throwIO :: Exception e => e -> IO a
+throwIO e = IO (raiseIO# (toException e))
+
+-- -----------------------------------------------------------------------------
+-- Controlling asynchronous exception delivery
+
+-- Applying 'block' to a computation will
+-- execute that computation with asynchronous exceptions
+-- /blocked/.  That is, any thread which
+-- attempts to raise an exception in the current thread with 'Control.Exception.throwTo' will be
+-- blocked until asynchronous exceptions are unblocked again.  There\'s
+-- no need to worry about re-enabling asynchronous exceptions; that is
+-- done automatically on exiting the scope of
+-- 'block'.
+--
+-- Threads created by 'Control.Concurrent.forkIO' inherit the blocked
+-- state from the parent; that is, to start a thread in blocked mode,
+-- use @block $ forkIO ...@.  This is particularly useful if you need to
+-- establish an exception handler in the forked thread before any
+-- asynchronous exceptions are received.
+block :: IO a -> IO a
+block (IO io) = IO $ maskAsyncExceptions# io
+
+-- To re-enable asynchronous exceptions inside the scope of
+-- 'block', 'unblock' can be
+-- used.  It scopes in exactly the same way, so on exit from
+-- 'unblock' asynchronous exception delivery will
+-- be disabled again.
+unblock :: IO a -> IO a
+unblock = unsafeUnmask
+
+unsafeUnmask :: IO a -> IO a
+unsafeUnmask (IO io) = IO $ unmaskAsyncExceptions# io
+
+blockUninterruptible :: IO a -> IO a
+blockUninterruptible (IO io) = IO $ maskUninterruptible# io
+
+-- | Describes the behaviour of a thread when an asynchronous
+-- exception is received.
+data MaskingState
+  = Unmasked -- ^ asynchronous exceptions are unmasked (the normal state)
+  | MaskedInterruptible 
+      -- ^ the state during 'mask': asynchronous exceptions are masked, but blocking operations may still be interrupted
+  | MaskedUninterruptible
+      -- ^ the state during 'uninterruptibleMask': asynchronous exceptions are masked, and blocking operations may not be interrupted
+ deriving (Eq,Show)
+
+-- | Returns the 'MaskingState' for the current thread.
+getMaskingState :: IO MaskingState
+getMaskingState  = IO $ \s -> 
+  case getMaskingState# s of
+     (# s', i #) -> (# s', case i of
+                             0# -> Unmasked
+                             1# -> MaskedUninterruptible
+                             _  -> MaskedInterruptible #)
+
+onException :: IO a -> IO b -> IO a
+onException io what = io `catchException` \e -> do _ <- what
+                                                   throwIO (e :: SomeException)
+
+-- | Executes an IO computation with asynchronous
+-- exceptions /masked/.  That is, any thread which attempts to raise
+-- an exception in the current thread with 'Control.Exception.throwTo'
+-- will be blocked until asynchronous exceptions are unmasked again.
+--
+-- The argument passed to 'mask' is a function that takes as its
+-- argument another function, which can be used to restore the
+-- prevailing masking state within the context of the masked
+-- computation.  For example, a common way to use 'mask' is to protect
+-- the acquisition of a resource:
+--
+-- > mask $ \restore -> do
+-- >     x <- acquire
+-- >     restore (do_something_with x) `onException` release
+-- >     release
+--
+-- This code guarantees that @acquire@ is paired with @release@, by masking
+-- asynchronous exceptions for the critical parts. (Rather than write
+-- this code yourself, it would be better to use
+-- 'Control.Exception.bracket' which abstracts the general pattern).
+--
+-- Note that the @restore@ action passed to the argument to 'mask'
+-- does not necessarily unmask asynchronous exceptions, it just
+-- restores the masking state to that of the enclosing context.  Thus
+-- if asynchronous exceptions are already masked, 'mask' cannot be used
+-- to unmask exceptions again.  This is so that if you call a library function
+-- with exceptions masked, you can be sure that the library call will not be
+-- able to unmask exceptions again.  If you are writing library code and need
+-- to use asynchronous exceptions, the only way is to create a new thread;
+-- see 'Control.Concurrent.forkIOWithUnmask'.
+--
+-- Asynchronous exceptions may still be received while in the masked
+-- state if the masked thread /blocks/ in certain ways; see
+-- "Control.Exception#interruptible".
+--
+-- Threads created by 'Control.Concurrent.forkIO' inherit the masked
+-- state from the parent; that is, to start a thread in blocked mode,
+-- use @mask_ $ forkIO ...@.  This is particularly useful if you need
+-- to establish an exception handler in the forked thread before any
+-- asynchronous exceptions are received.  To create a a new thread in
+-- an unmasked state use 'Control.Concurrent.forkIOUnmasked'.
+-- 
+mask  :: ((forall a. IO a -> IO a) -> IO b) -> IO b
+
+-- | Like 'mask', but does not pass a @restore@ action to the argument.
+mask_ :: IO a -> IO a
+
+-- | Like 'mask', but the masked computation is not interruptible (see
+-- "Control.Exception#interruptible").  THIS SHOULD BE USED WITH
+-- GREAT CARE, because if a thread executing in 'uninterruptibleMask'
+-- blocks for any reason, then the thread (and possibly the program,
+-- if this is the main thread) will be unresponsive and unkillable.
+-- This function should only be necessary if you need to mask
+-- exceptions around an interruptible operation, and you can guarantee
+-- that the interruptible operation will only block for a short period
+-- of time.
+--
+uninterruptibleMask :: ((forall a. IO a -> IO a) -> IO b) -> IO b
+
+-- | Like 'uninterruptibleMask', but does not pass a @restore@ action
+-- to the argument.
+uninterruptibleMask_ :: IO a -> IO a
+
+mask_ io = mask $ \_ -> io
+
+mask io = do
+  b <- getMaskingState
+  case b of
+    Unmasked -> block $ io unblock
+    _        -> io id
+
+uninterruptibleMask_ io = uninterruptibleMask $ \_ -> io
+
+uninterruptibleMask io = do
+  b <- getMaskingState
+  case b of
+    Unmasked              -> blockUninterruptible $ io unblock
+    MaskedInterruptible   -> blockUninterruptible $ io block
+    MaskedUninterruptible -> io id
+
+bracket
+        :: IO a         -- ^ computation to run first (\"acquire resource\")
+        -> (a -> IO b)  -- ^ computation to run last (\"release resource\")
+        -> (a -> IO c)  -- ^ computation to run in-between
+        -> IO c         -- returns the value from the in-between computation
+bracket before after thing =
+  mask $ \restore -> do
+    a <- before
+    r <- restore (thing a) `onException` after a
+    _ <- after a
+    return r
+
+finally :: IO a         -- ^ computation to run first
+        -> IO b         -- ^ computation to run afterward (even if an exception
+                        -- was raised)
+        -> IO a         -- returns the value from the first computation
+a `finally` sequel =
+  mask $ \restore -> do
+    r <- restore a `onException` sequel
+    _ <- sequel
+    return r
+
+-- | Forces its argument to be evaluated to weak head normal form when
+-- the resultant 'IO' action is executed. It can be used to order
+-- evaluation with respect to other 'IO' operations; its semantics are
+-- given by
+--
+-- >   evaluate x `seq` y    ==>  y
+-- >   evaluate x `catch` f  ==>  (return $! x) `catch` f
+-- >   evaluate x >>= f      ==>  (return $! x) >>= f
+--
+-- /Note:/ the first equation implies that @(evaluate x)@ is /not/ the
+-- same as @(return $! x)@.  A correct definition is
+--
+-- >   evaluate x = (return $! x) >>= return
+--
+evaluate :: a -> IO a
+evaluate a = IO $ \s -> seq# a s -- NB. see #2273, #5129
+
diff --git a/libraries/base/GHC/IO.hs-boot b/libraries/base/GHC/IO.hs-boot
new file mode 100644
index 000000000000..fb0dd963b310
--- /dev/null
+++ b/libraries/base/GHC/IO.hs-boot
@@ -0,0 +1,9 @@
+{-# LANGUAGE Unsafe #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+
+module GHC.IO where
+
+import GHC.Types
+
+failIO :: [Char] -> IO a
+
diff --git a/libraries/base/GHC/IO/Buffer.hs b/libraries/base/GHC/IO/Buffer.hs
new file mode 100644
index 000000000000..e0695552c824
--- /dev/null
+++ b/libraries/base/GHC/IO/Buffer.hs
@@ -0,0 +1,291 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE CPP, NoImplicitPrelude #-}
+{-# OPTIONS_GHC -funbox-strict-fields #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.IO.Buffer
+-- Copyright   :  (c) The University of Glasgow 2008
+-- License     :  see libraries/base/LICENSE
+-- 
+-- Maintainer  :  cvs-ghc@haskell.org
+-- Stability   :  internal
+-- Portability :  non-portable (GHC Extensions)
+--
+-- Buffers used in the IO system
+--
+-----------------------------------------------------------------------------
+
+module GHC.IO.Buffer (
+    -- * Buffers of any element
+    Buffer(..), BufferState(..), CharBuffer, CharBufElem,
+
+    -- ** Creation
+    newByteBuffer,
+    newCharBuffer,
+    newBuffer,
+    emptyBuffer,
+
+    -- ** Insertion/removal
+    bufferRemove,
+    bufferAdd,
+    slideContents,
+    bufferAdjustL,
+
+    -- ** Inspecting
+    isEmptyBuffer,
+    isFullBuffer,
+    isFullCharBuffer,
+    isWriteBuffer,
+    bufferElems,
+    bufferAvailable,
+    summaryBuffer,
+
+    -- ** Operating on the raw buffer as a Ptr
+    withBuffer,
+    withRawBuffer,
+
+    -- ** Assertions
+    checkBuffer,
+
+    -- * Raw buffers
+    RawBuffer,
+    readWord8Buf,
+    writeWord8Buf,
+    RawCharBuffer,
+    peekCharBuf,
+    readCharBuf,
+    writeCharBuf,
+    readCharBufPtr,
+    writeCharBufPtr,
+    charSize,
+ ) where
+
+import GHC.Base
+-- import GHC.IO
+import GHC.Num
+import GHC.Ptr
+import GHC.Word
+import GHC.Show
+import GHC.Real
+import Foreign.C.Types
+import Foreign.ForeignPtr
+import Foreign.Storable
+
+-- Char buffers use either UTF-16 or UTF-32, with the endianness matching
+-- the endianness of the host.
+--
+-- Invariants:
+--   * a Char buffer consists of *valid* UTF-16 or UTF-32
+--   * only whole characters: no partial surrogate pairs
+
+#define CHARBUF_UTF32
+
+-- #define CHARBUF_UTF16
+--
+-- NB. it won't work to just change this to CHARBUF_UTF16.  Some of
+-- the code to make this work is there, and it has been tested with
+-- the Iconv codec, but there are some pieces that are known to be
+-- broken.  In particular, the built-in codecs
+-- e.g. GHC.IO.Encoding.UTF{8,16,32} need to use isFullCharBuffer or
+-- similar in place of the ow >= os comparisons.
+
+-- ---------------------------------------------------------------------------
+-- Raw blocks of data
+
+type RawBuffer e = ForeignPtr e
+
+readWord8Buf :: RawBuffer Word8 -> Int -> IO Word8
+readWord8Buf arr ix = withForeignPtr arr $ \p -> peekByteOff p ix
+
+writeWord8Buf :: RawBuffer Word8 -> Int -> Word8 -> IO ()
+writeWord8Buf arr ix w = withForeignPtr arr $ \p -> pokeByteOff p ix w
+
+#ifdef CHARBUF_UTF16
+type CharBufElem = Word16
+#else
+type CharBufElem = Char
+#endif
+
+type RawCharBuffer = RawBuffer CharBufElem
+
+peekCharBuf :: RawCharBuffer -> Int -> IO Char
+peekCharBuf arr ix = withForeignPtr arr $ \p -> do
+                        (c,_) <- readCharBufPtr p ix
+                        return c
+
+{-# INLINE readCharBuf #-}
+readCharBuf :: RawCharBuffer -> Int -> IO (Char, Int)
+readCharBuf arr ix = withForeignPtr arr $ \p -> readCharBufPtr p ix
+
+{-# INLINE writeCharBuf #-}
+writeCharBuf :: RawCharBuffer -> Int -> Char -> IO Int
+writeCharBuf arr ix c = withForeignPtr arr $ \p -> writeCharBufPtr p ix c
+
+{-# INLINE readCharBufPtr #-}
+readCharBufPtr :: Ptr CharBufElem -> Int -> IO (Char, Int)
+#ifdef CHARBUF_UTF16
+readCharBufPtr p ix = do
+  c1 <- peekElemOff p ix
+  if (c1 < 0xd800 || c1 > 0xdbff)
+     then return (chr (fromIntegral c1), ix+1)
+     else do c2 <- peekElemOff p (ix+1)
+             return (unsafeChr ((fromIntegral c1 - 0xd800)*0x400 +
+                                (fromIntegral c2 - 0xdc00) + 0x10000), ix+2)
+#else
+readCharBufPtr p ix = do c <- peekElemOff (castPtr p) ix; return (c, ix+1)
+#endif
+
+{-# INLINE writeCharBufPtr #-}
+writeCharBufPtr :: Ptr CharBufElem -> Int -> Char -> IO Int
+#ifdef CHARBUF_UTF16
+writeCharBufPtr p ix ch
+  | c < 0x10000 = do pokeElemOff p ix (fromIntegral c)
+                     return (ix+1)
+  | otherwise   = do let c' = c - 0x10000
+                     pokeElemOff p ix (fromIntegral (c' `div` 0x400 + 0xd800))
+                     pokeElemOff p (ix+1) (fromIntegral (c' `mod` 0x400 + 0xdc00))
+                     return (ix+2)
+  where
+    c = ord ch
+#else
+writeCharBufPtr p ix ch = do pokeElemOff (castPtr p) ix ch; return (ix+1)
+#endif
+
+charSize :: Int
+#ifdef CHARBUF_UTF16
+charSize = 2
+#else
+charSize = 4
+#endif
+
+-- ---------------------------------------------------------------------------
+-- Buffers
+
+-- | A mutable array of bytes that can be passed to foreign functions.
+--
+-- The buffer is represented by a record, where the record contains
+-- the raw buffer and the start/end points of the filled portion.  The
+-- buffer contents itself is mutable, but the rest of the record is
+-- immutable.  This is a slightly odd mix, but it turns out to be
+-- quite practical: by making all the buffer metadata immutable, we
+-- can have operations on buffer metadata outside of the IO monad.
+--
+-- The "live" elements of the buffer are those between the 'bufL' and
+-- 'bufR' offsets.  In an empty buffer, 'bufL' is equal to 'bufR', but
+-- they might not be zero: for exmaple, the buffer might correspond to
+-- a memory-mapped file and in which case 'bufL' will point to the
+-- next location to be written, which is not necessarily the beginning
+-- of the file.
+data Buffer e
+  = Buffer {
+	bufRaw   :: !(RawBuffer e),
+        bufState :: BufferState,
+	bufSize  :: !Int,          -- in elements, not bytes
+	bufL     :: !Int,          -- offset of first item in the buffer
+	bufR     :: !Int           -- offset of last item + 1
+  }
+
+#ifdef CHARBUF_UTF16
+type CharBuffer = Buffer Word16
+#else
+type CharBuffer = Buffer Char
+#endif
+
+data BufferState = ReadBuffer | WriteBuffer deriving (Eq)
+
+withBuffer :: Buffer e -> (Ptr e -> IO a) -> IO a
+withBuffer Buffer{ bufRaw=raw } f = withForeignPtr (castForeignPtr raw) f
+
+withRawBuffer :: RawBuffer e -> (Ptr e -> IO a) -> IO a
+withRawBuffer raw f = withForeignPtr (castForeignPtr raw) f
+
+isEmptyBuffer :: Buffer e -> Bool
+isEmptyBuffer Buffer{ bufL=l, bufR=r } = l == r
+
+isFullBuffer :: Buffer e -> Bool
+isFullBuffer Buffer{ bufR=w, bufSize=s } = s == w
+
+-- if a Char buffer does not have room for a surrogate pair, it is "full"
+isFullCharBuffer :: Buffer e -> Bool
+#ifdef CHARBUF_UTF16
+isFullCharBuffer buf = bufferAvailable buf < 2
+#else
+isFullCharBuffer = isFullBuffer
+#endif
+
+isWriteBuffer :: Buffer e -> Bool
+isWriteBuffer buf = case bufState buf of
+                        WriteBuffer -> True
+                        ReadBuffer  -> False
+
+bufferElems :: Buffer e -> Int
+bufferElems Buffer{ bufR=w, bufL=r } = w - r
+
+bufferAvailable :: Buffer e -> Int
+bufferAvailable Buffer{ bufR=w, bufSize=s } = s - w
+
+bufferRemove :: Int -> Buffer e -> Buffer e
+bufferRemove i buf@Buffer{ bufL=r } = bufferAdjustL (r+i) buf
+
+bufferAdjustL :: Int -> Buffer e -> Buffer e
+bufferAdjustL l buf@Buffer{ bufR=w }
+  | l == w    = buf{ bufL=0, bufR=0 }
+  | otherwise = buf{ bufL=l, bufR=w }
+
+bufferAdd :: Int -> Buffer e -> Buffer e
+bufferAdd i buf@Buffer{ bufR=w } = buf{ bufR=w+i }
+
+emptyBuffer :: RawBuffer e -> Int -> BufferState -> Buffer e
+emptyBuffer raw sz state = 
+  Buffer{ bufRaw=raw, bufState=state, bufR=0, bufL=0, bufSize=sz }
+
+newByteBuffer :: Int -> BufferState -> IO (Buffer Word8)
+newByteBuffer c st = newBuffer c c st
+
+newCharBuffer :: Int -> BufferState -> IO CharBuffer
+newCharBuffer c st = newBuffer (c * charSize) c st
+
+newBuffer :: Int -> Int -> BufferState -> IO (Buffer e)
+newBuffer bytes sz state = do
+  fp <- mallocForeignPtrBytes bytes
+  return (emptyBuffer fp sz state)
+
+-- | slides the contents of the buffer to the beginning
+slideContents :: Buffer Word8 -> IO (Buffer Word8)
+slideContents buf@Buffer{ bufL=l, bufR=r, bufRaw=raw } = do
+  let elems = r - l
+  withRawBuffer raw $ \p ->
+      do _ <- memmove p (p `plusPtr` l) (fromIntegral elems)
+         return ()
+  return buf{ bufL=0, bufR=elems }
+
+foreign import ccall unsafe "memmove"
+   memmove :: Ptr a -> Ptr a -> CSize -> IO (Ptr a)
+
+summaryBuffer :: Buffer a -> String
+summaryBuffer buf = "buf" ++ show (bufSize buf) ++ "(" ++ show (bufL buf) ++ "-" ++ show (bufR buf) ++ ")"
+
+-- INVARIANTS on Buffers:
+--   * r <= w
+--   * if r == w, and the buffer is for reading, then r == 0 && w == 0
+--   * a write buffer is never full.  If an operation
+--     fills up the buffer, it will always flush it before 
+--     returning.
+--   * a read buffer may be full as a result of hLookAhead.  In normal
+--     operation, a read buffer always has at least one character of space.
+
+checkBuffer :: Buffer a -> IO ()
+checkBuffer buf@Buffer{ bufState = state, bufL=r, bufR=w, bufSize=size } = do
+     check buf (
+      	size > 0
+      	&& r <= w
+      	&& w <= size
+      	&& ( r /= w || state == WriteBuffer || (r == 0 && w == 0) )
+        && ( state /= WriteBuffer || w < size ) -- write buffer is never full
+      )
+
+check :: Buffer a -> Bool -> IO ()
+check _   True  = return ()
+check buf False = error ("buffer invariant violation: " ++ summaryBuffer buf)
+
diff --git a/libraries/base/GHC/IO/BufferedIO.hs b/libraries/base/GHC/IO/BufferedIO.hs
new file mode 100644
index 000000000000..b715c6138060
--- /dev/null
+++ b/libraries/base/GHC/IO/BufferedIO.hs
@@ -0,0 +1,127 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# OPTIONS_GHC -funbox-strict-fields #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.IO.BufferedIO
+-- Copyright   :  (c) The University of Glasgow 2008
+-- License     :  see libraries/base/LICENSE
+-- 
+-- Maintainer  :  cvs-ghc@haskell.org
+-- Stability   :  internal
+-- Portability :  non-portable (GHC Extensions)
+--
+-- Class of buffered IO devices
+--
+-----------------------------------------------------------------------------
+
+module GHC.IO.BufferedIO (
+        BufferedIO(..),
+        readBuf, readBufNonBlocking, writeBuf, writeBufNonBlocking
+    ) where
+
+import GHC.Base
+import GHC.Ptr
+import Data.Word
+import GHC.Num
+import Data.Maybe
+import GHC.IO.Device as IODevice
+import GHC.IO.Device as RawIO
+import GHC.IO.Buffer
+
+-- | The purpose of 'BufferedIO' is to provide a common interface for I/O
+-- devices that can read and write data through a buffer.  Devices that
+-- implement 'BufferedIO' include ordinary files, memory-mapped files,
+-- and bytestrings.  The underlying device implementing a 'Handle' must
+-- provide 'BufferedIO'.
+--
+class BufferedIO dev where
+  -- | allocate a new buffer.  The size of the buffer is at the
+  -- discretion of the device; e.g. for a memory-mapped file the
+  -- buffer will probably cover the entire file.
+  newBuffer         :: dev -> BufferState -> IO (Buffer Word8)
+
+  -- | reads bytes into the buffer, blocking if there are no bytes
+  -- available.  Returns the number of bytes read (zero indicates
+  -- end-of-file), and the new buffer.
+  fillReadBuffer    :: dev -> Buffer Word8 -> IO (Int, Buffer Word8)
+
+  -- | reads bytes into the buffer without blocking.  Returns the
+  -- number of bytes read (Nothing indicates end-of-file), and the new
+  -- buffer.
+  fillReadBuffer0   :: dev -> Buffer Word8 -> IO (Maybe Int, Buffer Word8)
+
+  -- | Prepares an empty write buffer.  This lets the device decide
+  -- how to set up a write buffer: the buffer may need to point to a
+  -- specific location in memory, for example.  This is typically used
+  -- by the client when switching from reading to writing on a
+  -- buffered read/write device.
+  --
+  -- There is no corresponding operation for read buffers, because before
+  -- reading the client will always call 'fillReadBuffer'.
+  emptyWriteBuffer  :: dev -> Buffer Word8 -> IO (Buffer Word8)
+  emptyWriteBuffer _dev buf 
+    = return buf{ bufL=0, bufR=0, bufState = WriteBuffer }
+
+  -- | Flush all the data from the supplied write buffer out to the device.
+  -- The returned buffer should be empty, and ready for writing.
+  flushWriteBuffer  :: dev -> Buffer Word8 -> IO (Buffer Word8)
+
+  -- | Flush data from the supplied write buffer out to the device
+  -- without blocking.  Returns the number of bytes written and the
+  -- remaining buffer.
+  flushWriteBuffer0 :: dev -> Buffer Word8 -> IO (Int, Buffer Word8)
+
+-- for an I/O device, these operations will perform reading/writing
+-- to/from the device.
+
+-- for a memory-mapped file, the buffer will be the whole file in
+-- memory.  fillReadBuffer sets the pointers to encompass the whole
+-- file, and flushWriteBuffer needs to do no I/O.  A memory-mapped
+-- file has to maintain its own file pointer.
+
+-- for a bytestring, again the buffer should match the bytestring in
+-- memory.
+
+-- ---------------------------------------------------------------------------
+-- Low-level read/write to/from buffers
+
+-- These operations make it easy to implement an instance of 'BufferedIO'
+-- for an object that supports 'RawIO'.
+
+readBuf :: RawIO dev => dev -> Buffer Word8 -> IO (Int, Buffer Word8)
+readBuf dev bbuf = do
+  let bytes = bufferAvailable bbuf
+  res <- withBuffer bbuf $ \ptr ->
+             RawIO.read dev (ptr `plusPtr` bufR bbuf) bytes
+  return (res, bbuf{ bufR = bufR bbuf + res })
+         -- zero indicates end of file
+
+readBufNonBlocking :: RawIO dev => dev -> Buffer Word8
+                     -> IO (Maybe Int,   -- Nothing ==> end of file
+                                         -- Just n  ==> n bytes were read (n>=0)
+                            Buffer Word8)
+readBufNonBlocking dev bbuf = do
+  let bytes = bufferAvailable bbuf
+  res <- withBuffer bbuf $ \ptr ->
+           IODevice.readNonBlocking dev (ptr `plusPtr` bufR bbuf) bytes
+  case res of
+     Nothing -> return (Nothing, bbuf)
+     Just n  -> return (Just n, bbuf{ bufR = bufR bbuf + n })
+
+writeBuf :: RawIO dev => dev -> Buffer Word8 -> IO (Buffer Word8)
+writeBuf dev bbuf = do
+  let bytes = bufferElems bbuf
+  withBuffer bbuf $ \ptr ->
+      IODevice.write dev (ptr `plusPtr` bufL bbuf) bytes
+  return bbuf{ bufL=0, bufR=0 }
+
+-- XXX ToDo
+writeBufNonBlocking :: RawIO dev => dev -> Buffer Word8 -> IO (Int, Buffer Word8)
+writeBufNonBlocking dev bbuf = do
+  let bytes = bufferElems bbuf
+  res <- withBuffer bbuf $ \ptr ->
+            IODevice.writeNonBlocking dev (ptr `plusPtr` bufL bbuf) bytes
+  return (res, bufferAdjustL (bufL bbuf + res) bbuf)
+
diff --git a/libraries/base/GHC/IO/Device.hs b/libraries/base/GHC/IO/Device.hs
new file mode 100644
index 000000000000..e20cdf077076
--- /dev/null
+++ b/libraries/base/GHC/IO/Device.hs
@@ -0,0 +1,171 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE NoImplicitPrelude, BangPatterns #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.IO.Device
+-- Copyright   :  (c) The University of Glasgow, 1994-2008
+-- License     :  see libraries/base/LICENSE
+-- 
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  internal
+-- Portability :  non-portable
+--
+-- Type classes for I/O providers.
+--
+-----------------------------------------------------------------------------
+
+module GHC.IO.Device (
+        RawIO(..),
+        IODevice(..),
+        IODeviceType(..),
+        SeekMode(..)
+    ) where  
+
+import GHC.Base
+import GHC.Word
+import GHC.Arr
+import GHC.Enum
+import GHC.Read
+import GHC.Show
+import GHC.Ptr
+import Data.Maybe
+import GHC.Num
+import GHC.IO
+import {-# SOURCE #-} GHC.IO.Exception ( unsupportedOperation )
+
+-- | A low-level I/O provider where the data is bytes in memory.
+class RawIO a where
+  -- | Read up to the specified number of bytes, returning the number
+  -- of bytes actually read.  This function should only block if there
+  -- is no data available.  If there is not enough data available,
+  -- then the function should just return the available data. A return
+  -- value of zero indicates that the end of the data stream (e.g. end
+  -- of file) has been reached.
+  read                :: a -> Ptr Word8 -> Int -> IO Int
+
+  -- | Read up to the specified number of bytes, returning the number
+  -- of bytes actually read, or 'Nothing' if the end of the stream has
+  -- been reached.
+  readNonBlocking     :: a -> Ptr Word8 -> Int -> IO (Maybe Int)
+
+  -- | Write the specified number of bytes.
+  write               :: a -> Ptr Word8 -> Int -> IO ()
+
+  -- | Write up to the specified number of bytes without blocking.  Returns
+  -- the actual number of bytes written.
+  writeNonBlocking    :: a -> Ptr Word8 -> Int -> IO Int
+
+
+-- | I/O operations required for implementing a 'Handle'.
+class IODevice a where
+  -- | @ready dev write msecs@ returns 'True' if the device has data
+  -- to read (if @write@ is 'False') or space to write new data (if
+  -- @write@ is 'True').  @msecs@ specifies how long to wait, in
+  -- milliseconds.
+  -- 
+  ready :: a -> Bool -> Int -> IO Bool
+
+  -- | closes the device.  Further operations on the device should
+  -- produce exceptions.
+  close :: a -> IO ()
+
+  -- | returns 'True' if the device is a terminal or console.
+  isTerminal :: a -> IO Bool
+  isTerminal _ = return False
+
+  -- | returns 'True' if the device supports 'seek' operations.
+  isSeekable :: a -> IO Bool
+  isSeekable _ = return False
+
+  -- | seek to the specified position in the data.
+  seek :: a -> SeekMode -> Integer -> IO ()
+  seek _ _ _ = ioe_unsupportedOperation
+
+  -- | return the current position in the data.
+  tell :: a -> IO Integer
+  tell _ = ioe_unsupportedOperation
+
+  -- | return the size of the data.
+  getSize :: a -> IO Integer
+  getSize _ = ioe_unsupportedOperation
+
+  -- | change the size of the data.
+  setSize :: a -> Integer -> IO () 
+  setSize _ _ = ioe_unsupportedOperation
+
+  -- | for terminal devices, changes whether characters are echoed on
+  -- the device.
+  setEcho :: a -> Bool -> IO ()
+  setEcho _ _ = ioe_unsupportedOperation
+
+  -- | returns the current echoing status.
+  getEcho :: a -> IO Bool
+  getEcho _ = ioe_unsupportedOperation
+
+  -- | some devices (e.g. terminals) support a "raw" mode where
+  -- characters entered are immediately made available to the program.
+  -- If available, this operations enables raw mode.
+  setRaw :: a -> Bool -> IO ()
+  setRaw _ _ = ioe_unsupportedOperation
+
+  -- | returns the 'IODeviceType' corresponding to this device.
+  devType :: a -> IO IODeviceType
+
+  -- | duplicates the device, if possible.  The new device is expected
+  -- to share a file pointer with the original device (like Unix @dup@).
+  dup :: a -> IO a
+  dup _ = ioe_unsupportedOperation
+
+  -- | @dup2 source target@ replaces the target device with the source
+  -- device.  The target device is closed first, if necessary, and then
+  -- it is made into a duplicate of the first device (like Unix @dup2@).
+  dup2 :: a -> a -> IO a
+  dup2 _ _ = ioe_unsupportedOperation
+
+ioe_unsupportedOperation :: IO a
+ioe_unsupportedOperation = throwIO unsupportedOperation
+
+-- | Type of a device that can be used to back a
+-- 'GHC.IO.Handle.Handle' (see also 'GHC.IO.Handle.mkFileHandle'). The
+-- standard libraries provide creation of 'GHC.IO.Handle.Handle's via
+-- Posix file operations with file descriptors (see
+-- 'GHC.IO.Handle.FD.mkHandleFromFD') with FD being the underlying
+-- 'GHC.IO.Device.IODevice' instance.
+--
+-- Users may provide custom instances of 'GHC.IO.Device.IODevice'
+-- which are expected to conform the following rules:
+
+data IODeviceType
+  = Directory -- ^ The standard libraries do not have direct support
+              -- for this device type, but a user implementation is
+              -- expected to provide a list of file names in
+              -- the directory, in any order, separated by @'\0'@
+              -- characters, excluding the @"."@ and @".."@ names. See
+              -- also 'System.Directory.getDirectoryContents'.  Seek
+              -- operations are not supported on directories (other
+              -- than to the zero position).
+  | Stream    -- ^ A duplex communications channel (results in
+              -- creation of a duplex 'GHC.IO.Handle.Handle'). The
+              -- standard libraries use this device type when
+              -- creating 'GHC.IO.Handle.Handle's for open sockets.
+  | RegularFile -- ^ A file that may be read or written, and also
+                -- may be seekable.
+  | RawDevice -- ^ A "raw" (disk) device which supports block binary
+              -- read and write operations and may be seekable only
+              -- to positions of certain granularity (block-
+              -- aligned).
+  deriving (Eq)
+
+-- -----------------------------------------------------------------------------
+-- SeekMode type
+
+-- | A mode that determines the effect of 'hSeek' @hdl mode i@.
+data SeekMode
+  = AbsoluteSeek        -- ^ the position of @hdl@ is set to @i@.
+  | RelativeSeek        -- ^ the position of @hdl@ is set to offset @i@
+                        -- from the current position.
+  | SeekFromEnd         -- ^ the position of @hdl@ is set to offset @i@
+                        -- from the end of the file.
+    deriving (Eq, Ord, Ix, Enum, Read, Show)
+
diff --git a/libraries/base/GHC/IO/Encoding.hs b/libraries/base/GHC/IO/Encoding.hs
new file mode 100644
index 000000000000..eb4d74ccfc9f
--- /dev/null
+++ b/libraries/base/GHC/IO/Encoding.hs
@@ -0,0 +1,264 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE CPP, NoImplicitPrelude #-}
+{-# OPTIONS_GHC -funbox-strict-fields #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.IO.Encoding
+-- Copyright   :  (c) The University of Glasgow, 2008-2009
+-- License     :  see libraries/base/LICENSE
+-- 
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  internal
+-- Portability :  non-portable
+--
+-- Text codecs for I/O
+--
+-----------------------------------------------------------------------------
+
+module GHC.IO.Encoding (
+        BufferCodec(..), TextEncoding(..), TextEncoder, TextDecoder, CodingProgress(..),
+        latin1, latin1_encode, latin1_decode,
+        utf8, utf8_bom,
+        utf16, utf16le, utf16be,
+        utf32, utf32le, utf32be, 
+        initLocaleEncoding,
+        getLocaleEncoding, getFileSystemEncoding, getForeignEncoding,
+        setLocaleEncoding, setFileSystemEncoding, setForeignEncoding,
+        char8,
+        mkTextEncoding,
+    ) where
+
+import GHC.Base
+import GHC.IO.Exception
+import GHC.IO.Buffer
+import GHC.IO.Encoding.Failure
+import GHC.IO.Encoding.Types
+#if !defined(mingw32_HOST_OS)
+import qualified GHC.IO.Encoding.Iconv as Iconv
+#else
+import qualified GHC.IO.Encoding.CodePage as CodePage
+import Text.Read (reads)
+#endif
+import qualified GHC.IO.Encoding.Latin1 as Latin1
+import qualified GHC.IO.Encoding.UTF8   as UTF8
+import qualified GHC.IO.Encoding.UTF16  as UTF16
+import qualified GHC.IO.Encoding.UTF32  as UTF32
+import GHC.Word
+
+import Data.IORef
+import Data.Char (toUpper)
+import Data.List
+import Data.Maybe
+import System.IO.Unsafe (unsafePerformIO)
+
+-- -----------------------------------------------------------------------------
+
+-- | The Latin1 (ISO8859-1) encoding.  This encoding maps bytes
+-- directly to the first 256 Unicode code points, and is thus not a
+-- complete Unicode encoding.  An attempt to write a character greater than
+-- '\255' to a 'Handle' using the 'latin1' encoding will result in an error.
+latin1  :: TextEncoding
+latin1 = Latin1.latin1_checked
+
+-- | The UTF-8 Unicode encoding
+utf8  :: TextEncoding
+utf8 = UTF8.utf8
+
+-- | The UTF-8 Unicode encoding, with a byte-order-mark (BOM; the byte
+-- sequence 0xEF 0xBB 0xBF).  This encoding behaves like 'utf8',
+-- except that on input, the BOM sequence is ignored at the beginning
+-- of the stream, and on output, the BOM sequence is prepended.
+--
+-- The byte-order-mark is strictly unnecessary in UTF-8, but is
+-- sometimes used to identify the encoding of a file.
+--
+utf8_bom  :: TextEncoding
+utf8_bom = UTF8.utf8_bom
+
+-- | The UTF-16 Unicode encoding (a byte-order-mark should be used to
+-- indicate endianness).
+utf16  :: TextEncoding
+utf16 = UTF16.utf16
+
+-- | The UTF-16 Unicode encoding (litte-endian)
+utf16le  :: TextEncoding
+utf16le = UTF16.utf16le
+
+-- | The UTF-16 Unicode encoding (big-endian)
+utf16be  :: TextEncoding
+utf16be = UTF16.utf16be
+
+-- | The UTF-32 Unicode encoding (a byte-order-mark should be used to
+-- indicate endianness).
+utf32  :: TextEncoding
+utf32 = UTF32.utf32
+
+-- | The UTF-32 Unicode encoding (litte-endian)
+utf32le  :: TextEncoding
+utf32le = UTF32.utf32le
+
+-- | The UTF-32 Unicode encoding (big-endian)
+utf32be  :: TextEncoding
+utf32be = UTF32.utf32be
+
+-- | The Unicode encoding of the current locale
+--
+-- /Since: 4.5.0.0/
+getLocaleEncoding :: IO TextEncoding
+
+-- | The Unicode encoding of the current locale, but allowing arbitrary
+-- undecodable bytes to be round-tripped through it.
+--
+-- This 'TextEncoding' is used to decode and encode command line arguments
+-- and environment variables on non-Windows platforms.
+--
+-- On Windows, this encoding *should not* be used if possible because
+-- the use of code pages is deprecated: Strings should be retrieved
+-- via the "wide" W-family of UTF-16 APIs instead
+--
+-- /Since: 4.5.0.0/
+getFileSystemEncoding :: IO TextEncoding
+
+-- | The Unicode encoding of the current locale, but where undecodable
+-- bytes are replaced with their closest visual match. Used for
+-- the 'CString' marshalling functions in "Foreign.C.String"
+--
+-- /Since: 4.5.0.0/
+getForeignEncoding :: IO TextEncoding
+
+-- | /Since: 4.5.0.0/
+setLocaleEncoding, setFileSystemEncoding, setForeignEncoding :: TextEncoding -> IO ()
+
+(getLocaleEncoding, setLocaleEncoding)         = mkGlobal initLocaleEncoding
+(getFileSystemEncoding, setFileSystemEncoding) = mkGlobal initFileSystemEncoding
+(getForeignEncoding, setForeignEncoding)       = mkGlobal initForeignEncoding
+
+mkGlobal :: a -> (IO a, a -> IO ())
+mkGlobal x = unsafePerformIO $ do
+    x_ref <- newIORef x
+    return (readIORef x_ref, writeIORef x_ref)
+
+-- | /Since: 4.5.0.0/
+initLocaleEncoding, initFileSystemEncoding, initForeignEncoding :: TextEncoding
+
+#if !defined(mingw32_HOST_OS)
+-- It is rather important that we don't just call Iconv.mkIconvEncoding here
+-- because some iconvs (in particular GNU iconv) will brokenly UTF-8 encode
+-- lone surrogates without complaint.
+--
+-- By going through our Haskell implementations of those encodings, we are
+-- guaranteed to catch such errors.
+--
+-- FIXME: this is not a complete solution because if the locale encoding is one
+-- which we don't have a Haskell-side decoder for, iconv might still ignore the
+-- lone surrogate in the input.
+initLocaleEncoding     = unsafePerformIO $ mkTextEncoding' ErrorOnCodingFailure Iconv.localeEncodingName
+initFileSystemEncoding = unsafePerformIO $ mkTextEncoding' RoundtripFailure     Iconv.localeEncodingName
+initForeignEncoding    = unsafePerformIO $ mkTextEncoding' IgnoreCodingFailure  Iconv.localeEncodingName
+#else
+initLocaleEncoding     = CodePage.localeEncoding
+initFileSystemEncoding = CodePage.mkLocaleEncoding RoundtripFailure
+initForeignEncoding    = CodePage.mkLocaleEncoding IgnoreCodingFailure
+#endif
+
+-- | An encoding in which Unicode code points are translated to bytes
+-- by taking the code point modulo 256.  When decoding, bytes are
+-- translated directly into the equivalent code point.
+--
+-- This encoding never fails in either direction.  However, encoding
+-- discards information, so encode followed by decode is not the
+-- identity.
+--
+-- /Since: 4.4.0.0/
+char8 :: TextEncoding
+char8 = Latin1.latin1
+
+-- | Look up the named Unicode encoding.  May fail with 
+--
+--  * 'isDoesNotExistError' if the encoding is unknown
+--
+-- The set of known encodings is system-dependent, but includes at least:
+--
+--  * @UTF-8@
+--
+--  * @UTF-16@, @UTF-16BE@, @UTF-16LE@
+--
+--  * @UTF-32@, @UTF-32BE@, @UTF-32LE@
+--
+-- There is additional notation (borrowed from GNU iconv) for specifying
+-- how illegal characters are handled:
+--
+--  * a suffix of @\/\/IGNORE@, e.g. @UTF-8\/\/IGNORE@, will cause 
+--    all illegal sequences on input to be ignored, and on output
+--    will drop all code points that have no representation in the
+--    target encoding.
+--
+--  * a suffix of @\/\/TRANSLIT@ will choose a replacement character
+--    for illegal sequences or code points.
+--
+--  * a suffix of @\/\/ROUNDTRIP@ will use a PEP383-style escape mechanism
+--    to represent any invalid bytes in the input as Unicode codepoints (specifically,
+--    as lone surrogates, which are normally invalid in UTF-32).
+--    Upon output, these special codepoints are detected and turned back into the
+--    corresponding original byte.
+--
+--    In theory, this mechanism allows arbitrary data to be roundtripped via
+--    a 'String' with no loss of data. In practice, there are two limitations
+--    to be aware of:
+--
+--      1. This only stands a chance of working for an encoding which is an ASCII
+--         superset, as for security reasons we refuse to escape any bytes smaller
+--         than 128. Many encodings of interest are ASCII supersets (in particular,
+--         you can assume that the locale encoding is an ASCII superset) but many
+--         (such as UTF-16) are not.
+--
+--      2. If the underlying encoding is not itself roundtrippable, this mechanism
+--         can fail. Roundtrippable encodings are those which have an injective mapping
+--         into Unicode. Almost all encodings meet this criteria, but some do not. Notably,
+--         Shift-JIS (CP932) and Big5 contain several different encodings of the same
+--         Unicode codepoint.
+--
+-- On Windows, you can access supported code pages with the prefix
+-- @CP@; for example, @\"CP1250\"@.
+--
+mkTextEncoding :: String -> IO TextEncoding
+mkTextEncoding e = case mb_coding_failure_mode of
+    Nothing -> unknownEncodingErr e
+    Just cfm -> mkTextEncoding' cfm enc
+  where
+    (enc, suffix) = span (/= '/') e
+    mb_coding_failure_mode = case suffix of
+        ""            -> Just ErrorOnCodingFailure
+        "//IGNORE"    -> Just IgnoreCodingFailure
+        "//TRANSLIT"  -> Just TransliterateCodingFailure
+        "//ROUNDTRIP" -> Just RoundtripFailure
+        _             -> Nothing
+
+mkTextEncoding' :: CodingFailureMode -> String -> IO TextEncoding
+mkTextEncoding' cfm enc = case [toUpper c | c <- enc, c /= '-'] of
+    "UTF8"    -> return $ UTF8.mkUTF8 cfm
+    "UTF16"   -> return $ UTF16.mkUTF16 cfm
+    "UTF16LE" -> return $ UTF16.mkUTF16le cfm
+    "UTF16BE" -> return $ UTF16.mkUTF16be cfm
+    "UTF32"   -> return $ UTF32.mkUTF32 cfm
+    "UTF32LE" -> return $ UTF32.mkUTF32le cfm
+    "UTF32BE" -> return $ UTF32.mkUTF32be cfm
+#if defined(mingw32_HOST_OS)
+    'C':'P':n | [(cp,"")] <- reads n -> return $ CodePage.mkCodePageEncoding cfm cp
+    _ -> unknownEncodingErr (enc ++ codingFailureModeSuffix cfm)
+#else
+    _ -> Iconv.mkIconvEncoding cfm enc
+#endif
+
+latin1_encode :: CharBuffer -> Buffer Word8 -> IO (CharBuffer, Buffer Word8)
+latin1_encode input output = fmap (\(_why,input',output') -> (input',output')) $ Latin1.latin1_encode input output -- unchecked, used for char8
+--latin1_encode = unsafePerformIO $ do mkTextEncoder Iconv.latin1 >>= return.encode
+
+latin1_decode :: Buffer Word8 -> CharBuffer -> IO (Buffer Word8, CharBuffer)
+latin1_decode input output = fmap (\(_why,input',output') -> (input',output')) $ Latin1.latin1_decode input output
+--latin1_decode = unsafePerformIO $ do mkTextDecoder Iconv.latin1 >>= return.encode
+
+unknownEncodingErr :: String -> IO a    
+unknownEncodingErr e = ioException (IOError Nothing NoSuchThing "mkTextEncoding"
+                                            ("unknown encoding:" ++ e)  Nothing Nothing)
diff --git a/libraries/base/GHC/IO/Encoding.hs-boot b/libraries/base/GHC/IO/Encoding.hs-boot
new file mode 100644
index 000000000000..ea32431eb77a
--- /dev/null
+++ b/libraries/base/GHC/IO/Encoding.hs-boot
@@ -0,0 +1,10 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+
+module GHC.IO.Encoding where
+
+import GHC.IO (IO)
+import GHC.IO.Encoding.Types
+
+getLocaleEncoding, getFileSystemEncoding, getForeignEncoding :: IO TextEncoding
+
diff --git a/libraries/base/GHC/IO/Encoding/CodePage.hs b/libraries/base/GHC/IO/Encoding/CodePage.hs
new file mode 100644
index 000000000000..6a8ee1a396a3
--- /dev/null
+++ b/libraries/base/GHC/IO/Encoding/CodePage.hs
@@ -0,0 +1,184 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE CPP, BangPatterns, NoImplicitPrelude,
+             NondecreasingIndentation, MagicHash #-}
+
+module GHC.IO.Encoding.CodePage(
+#if defined(mingw32_HOST_OS)
+                        codePageEncoding, mkCodePageEncoding,
+                        localeEncoding, mkLocaleEncoding
+#endif
+                            ) where
+
+#if !defined(mingw32_HOST_OS)
+import GHC.Base () -- Build ordering
+#else
+import GHC.Base
+import GHC.Show
+import GHC.Num
+import GHC.Enum
+import GHC.Word
+import GHC.IO (unsafePerformIO)
+import GHC.IO.Encoding.Failure
+import GHC.IO.Encoding.Types
+import GHC.IO.Buffer
+import Data.Bits
+import Data.Maybe
+import Data.List (lookup)
+
+import qualified GHC.IO.Encoding.CodePage.API as API
+import GHC.IO.Encoding.CodePage.Table
+
+import GHC.IO.Encoding.UTF8 (mkUTF8)
+import GHC.IO.Encoding.UTF16 (mkUTF16le, mkUTF16be)
+import GHC.IO.Encoding.UTF32 (mkUTF32le, mkUTF32be)
+
+#ifdef mingw32_HOST_OS
+# if defined(i386_HOST_ARCH)
+#  define WINDOWS_CCONV stdcall
+# elif defined(x86_64_HOST_ARCH)
+#  define WINDOWS_CCONV ccall
+# else
+#  error Unknown mingw32 arch
+# endif
+#endif
+
+-- note CodePage = UInt which might not work on Win64.  But the Win32 package
+-- also has this issue.
+getCurrentCodePage :: IO Word32
+getCurrentCodePage = do
+    conCP <- getConsoleCP
+    if conCP > 0
+        then return conCP
+        else getACP
+
+-- Since the Win32 package depends on base, we have to import these ourselves:
+foreign import WINDOWS_CCONV unsafe "windows.h GetConsoleCP"
+    getConsoleCP :: IO Word32
+
+foreign import WINDOWS_CCONV unsafe "windows.h GetACP"
+    getACP :: IO Word32
+
+{-# NOINLINE currentCodePage #-}
+currentCodePage :: Word32
+currentCodePage = unsafePerformIO getCurrentCodePage
+
+localeEncoding :: TextEncoding
+localeEncoding = mkLocaleEncoding ErrorOnCodingFailure
+
+mkLocaleEncoding :: CodingFailureMode -> TextEncoding
+mkLocaleEncoding cfm = mkCodePageEncoding cfm currentCodePage
+
+
+codePageEncoding :: Word32 -> TextEncoding
+codePageEncoding = mkCodePageEncoding ErrorOnCodingFailure
+
+mkCodePageEncoding :: CodingFailureMode -> Word32 -> TextEncoding
+mkCodePageEncoding cfm 65001 = mkUTF8 cfm
+mkCodePageEncoding cfm 1200 = mkUTF16le cfm
+mkCodePageEncoding cfm 1201 = mkUTF16be cfm
+mkCodePageEncoding cfm 12000 = mkUTF32le cfm
+mkCodePageEncoding cfm 12001 = mkUTF32be cfm
+mkCodePageEncoding cfm cp = maybe (API.mkCodePageEncoding cfm cp) (buildEncoding cfm cp) (lookup cp codePageMap)
+
+buildEncoding :: CodingFailureMode -> Word32 -> CodePageArrays -> TextEncoding
+buildEncoding cfm cp SingleByteCP {decoderArray = dec, encoderArray = enc}
+  = TextEncoding {
+      textEncodingName = "CP" ++ show cp
+    , mkTextDecoder = return $ simpleCodec (recoverDecode cfm) $ decodeFromSingleByte dec
+    , mkTextEncoder = return $ simpleCodec (recoverEncode cfm) $ encodeToSingleByte enc
+    }
+
+simpleCodec :: (Buffer from -> Buffer to -> IO (Buffer from, Buffer to))
+            -> (Buffer from -> Buffer to -> IO (CodingProgress, Buffer from, Buffer to))
+                -> BufferCodec from to ()
+simpleCodec r f = BufferCodec {
+    encode = f,
+    recover = r,
+    close = return (),
+    getState = return (),
+    setState = return
+  }
+
+decodeFromSingleByte :: ConvArray Char -> DecodeBuffer
+decodeFromSingleByte convArr
+    input@Buffer  { bufRaw=iraw, bufL=ir0, bufR=iw,  bufSize=_  }
+    output@Buffer { bufRaw=oraw, bufL=_,   bufR=ow0, bufSize=os }
+  = let
+        done why !ir !ow = return (why,
+                                   if ir==iw then input{ bufL=0, bufR=0}
+                                             else input{ bufL=ir},
+                                   output {bufR=ow})
+        loop !ir !ow
+            | ow >= os  = done OutputUnderflow ir ow
+            | ir >= iw  = done InputUnderflow ir ow
+            | otherwise = do
+                b <- readWord8Buf iraw ir
+                let c = lookupConv convArr b
+                if c=='\0' && b /= 0 then invalid else do
+                ow' <- writeCharBuf oraw ow c
+                loop (ir+1) ow'
+          where
+            invalid = done InvalidSequence ir ow
+    in loop ir0 ow0
+
+encodeToSingleByte :: CompactArray Char Word8 -> EncodeBuffer
+encodeToSingleByte CompactArray { encoderMax = maxChar,
+                         encoderIndices = indices,
+                         encoderValues = values }
+    input@Buffer{ bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ }
+    output@Buffer{ bufRaw=oraw, bufL=_,   bufR=ow0, bufSize=os }
+  = let
+        done why !ir !ow = return (why,
+                                   if ir==iw then input { bufL=0, bufR=0 }
+                                             else input { bufL=ir },
+                                   output {bufR=ow})
+        loop !ir !ow
+            | ow >= os  = done OutputUnderflow ir ow
+            | ir >= iw  = done InputUnderflow ir ow
+            | otherwise = do
+                (c,ir') <- readCharBuf iraw ir
+                case lookupCompact maxChar indices values c of
+                    Nothing -> invalid
+                    Just 0 | c /= '\0' -> invalid
+                    Just b -> do
+                        writeWord8Buf oraw ow b
+                        loop ir' (ow+1)
+            where
+                invalid = done InvalidSequence ir ow
+    in
+    loop ir0 ow0
+
+
+--------------------------------------------
+-- Array access functions
+
+-- {-# INLINE lookupConv #-}
+lookupConv :: ConvArray Char -> Word8 -> Char
+lookupConv a = indexChar a . fromEnum
+
+{-# INLINE lookupCompact #-}
+lookupCompact :: Char -> ConvArray Int -> ConvArray Word8 -> Char -> Maybe Word8
+lookupCompact maxVal indexes values x
+    | x > maxVal = Nothing
+    | otherwise = Just $ indexWord8 values $ j + (i .&. mask)
+  where
+    i = fromEnum x
+    mask = (1 `shiftL` n) - 1
+    k = i `shiftR` n
+    j = indexInt indexes k
+    n = blockBitSize
+
+{-# INLINE indexInt #-}
+indexInt :: ConvArray Int -> Int -> Int
+indexInt (ConvArray p) (I# i) = I# (indexInt16OffAddr# p i)
+
+{-# INLINE indexWord8 #-}
+indexWord8 :: ConvArray Word8 -> Int -> Word8
+indexWord8 (ConvArray p) (I# i) = W8# (indexWord8OffAddr# p i)
+
+{-# INLINE indexChar #-}
+indexChar :: ConvArray Char -> Int -> Char
+indexChar (ConvArray p) (I# i) = C# (chr# (indexInt16OffAddr# p i))
+
+#endif
+
diff --git a/libraries/base/GHC/IO/Encoding/CodePage/API.hs b/libraries/base/GHC/IO/Encoding/CodePage/API.hs
new file mode 100644
index 000000000000..570ea800040a
--- /dev/null
+++ b/libraries/base/GHC/IO/Encoding/CodePage/API.hs
@@ -0,0 +1,426 @@
+{-# LANGUAGE CPP, NoImplicitPrelude, NondecreasingIndentation, RecordWildCards, ScopedTypeVariables #-}
+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
+module GHC.IO.Encoding.CodePage.API (
+    mkCodePageEncoding
+  ) where
+
+import Foreign.C
+import Foreign.Ptr
+import Foreign.Marshal
+import Foreign.Storable
+import Control.Monad
+import Data.Bits
+import Data.Either
+import Data.Word
+
+import GHC.Base
+import GHC.List
+import GHC.IO.Buffer
+import GHC.IO.Encoding.Failure
+import GHC.IO.Encoding.Types
+import GHC.IO.Encoding.UTF16
+import GHC.Num
+import GHC.Show
+import GHC.Real
+import GHC.Windows
+import GHC.ForeignPtr (castForeignPtr)
+
+import System.Posix.Internals
+
+
+c_DEBUG_DUMP :: Bool
+c_DEBUG_DUMP = False
+
+debugIO :: String -> IO ()
+debugIO s
+ | c_DEBUG_DUMP = puts s
+ | otherwise    = return ()
+
+
+#if defined(i386_HOST_ARCH)
+# define WINDOWS_CCONV stdcall
+#elif defined(x86_64_HOST_ARCH)
+# define WINDOWS_CCONV ccall
+#else
+# error Unknown mingw32 arch
+#endif
+
+
+type LPCSTR = Ptr Word8
+
+
+mAX_DEFAULTCHAR :: Int
+mAX_DEFAULTCHAR = 2
+
+mAX_LEADBYTES :: Int
+mAX_LEADBYTES = 12
+
+-- Don't really care about the contents of this, but we have to make sure the size is right
+data CPINFO = CPINFO {
+    maxCharSize :: UINT,
+    defaultChar :: [BYTE], -- ^ Always of length mAX_DEFAULTCHAR
+    leadByte    :: [BYTE]  -- ^ Always of length mAX_LEADBYTES
+  }
+
+instance Storable CPINFO where
+    sizeOf    _ = sizeOf (undefined :: UINT) + (mAX_DEFAULTCHAR + mAX_LEADBYTES) * sizeOf (undefined :: BYTE)
+    alignment _ = alignment (undefined :: CInt)
+    peek ptr = do
+      ptr <- return $ castPtr ptr
+      a <- peek ptr
+      ptr <- return $ castPtr $ advancePtr ptr 1
+      b <- peekArray mAX_DEFAULTCHAR ptr
+      c <- peekArray mAX_LEADBYTES   (advancePtr ptr mAX_DEFAULTCHAR)
+      return $ CPINFO a b c  
+    poke ptr val = do
+      ptr <- return $ castPtr ptr
+      poke ptr (maxCharSize val)
+      ptr <- return $ castPtr $ advancePtr ptr 1
+      pokeArray' "CPINFO.defaultChar" mAX_DEFAULTCHAR ptr                              (defaultChar val)
+      pokeArray' "CPINFO.leadByte"    mAX_LEADBYTES   (advancePtr ptr mAX_DEFAULTCHAR) (leadByte val) 
+
+pokeArray' :: Storable a => String -> Int -> Ptr a -> [a] -> IO ()
+pokeArray' msg sz ptr xs | length xs == sz = pokeArray ptr xs
+                         | otherwise       = error $ msg ++ ": expected " ++ show sz ++ " elements in list but got " ++ show (length xs)
+
+
+foreign import WINDOWS_CCONV unsafe "windows.h GetCPInfo"
+    c_GetCPInfo :: UINT       -- ^ CodePage
+                -> Ptr CPINFO -- ^ lpCPInfo
+                -> IO BOOL
+
+foreign import WINDOWS_CCONV unsafe "windows.h MultiByteToWideChar"
+    c_MultiByteToWideChar :: UINT   -- ^ CodePage
+                          -> DWORD  -- ^ dwFlags
+                          -> LPCSTR -- ^ lpMultiByteStr
+                          -> CInt   -- ^ cbMultiByte
+                          -> LPWSTR -- ^ lpWideCharStr
+                          -> CInt   -- ^ cchWideChar
+                          -> IO CInt
+
+foreign import WINDOWS_CCONV unsafe "windows.h WideCharToMultiByte"
+    c_WideCharToMultiByte :: UINT   -- ^ CodePage
+                          -> DWORD  -- ^ dwFlags
+                          -> LPWSTR -- ^ lpWideCharStr
+                          -> CInt   -- ^ cchWideChar
+                          -> LPCSTR -- ^ lpMultiByteStr
+                          -> CInt   -- ^ cbMultiByte
+                          -> LPCSTR -- ^ lpDefaultChar
+                          -> LPBOOL -- ^ lpUsedDefaultChar
+                          -> IO CInt
+
+foreign import WINDOWS_CCONV unsafe "windows.h IsDBCSLeadByteEx"
+    c_IsDBCSLeadByteEx :: UINT    -- ^ CodePage
+                       -> BYTE    -- ^ TestChar
+                       -> IO BOOL
+
+
+-- | Returns a slow but correct implementation of TextEncoding using the Win32 API.
+--
+-- This is useful for supporting DBCS text encoding on the console without having to statically link
+-- in huge code tables into all of our executables, or just as a fallback mechanism if a new code page
+-- is introduced that we don't know how to deal with ourselves yet.  
+mkCodePageEncoding :: CodingFailureMode -> Word32 -> TextEncoding
+mkCodePageEncoding cfm cp
+  = TextEncoding { 
+        textEncodingName = "CP" ++ show cp,
+        mkTextDecoder = newCP (recoverDecode cfm) cpDecode cp,
+        mkTextEncoder = newCP (recoverEncode cfm) cpEncode cp
+      }
+
+newCP :: (Buffer from -> Buffer to -> IO (Buffer from, Buffer to))
+      -> (Word32 -> Int -> CodeBuffer from to)
+      -> Word32
+      -> IO (BufferCodec from to ())
+newCP rec fn cp = do
+  -- Fail early if the code page doesn't exist, to match the behaviour of the IConv TextEncoding
+  max_char_size <- alloca $ \cpinfo_ptr -> do
+    success <- c_GetCPInfo cp cpinfo_ptr 
+    unless success $ throwGetLastError ("GetCPInfo " ++ show cp)
+    fmap (fromIntegral . maxCharSize) $ peek cpinfo_ptr
+
+  debugIO $ "GetCPInfo " ++ show cp ++ " = " ++ show max_char_size
+
+  return $ BufferCodec {
+    encode = fn cp max_char_size,
+    recover = rec,
+    close  = return (),
+    -- Windows doesn't supply a way to save/restore the state and doesn't need one
+    -- since it's a dumb string->string API rather than a clever streaming one.
+    getState = return (),
+    setState = const $ return ()
+  }
+
+
+utf16_native_encode' :: EncodeBuffer
+utf16_native_decode' :: DecodeBuffer
+#ifdef WORDS_BIGENDIAN
+utf16_native_encode' = utf16be_encode
+utf16_native_decode' = utf16be_decode
+#else
+utf16_native_encode' = utf16le_encode
+utf16_native_decode' = utf16le_decode
+#endif
+
+saner :: CodeBuffer from to
+      -> Buffer from -> Buffer to
+      -> IO (CodingProgress, Int, Buffer from, Buffer to)
+saner code ibuf obuf = do
+  (why, ibuf', obuf') <- code ibuf obuf
+  -- Weird but true: the UTF16 codes have a special case (see the "done" functions)
+  -- whereby if they entirely consume the input instead of returning an input buffer
+  -- that is empty because bufL has reached bufR, they return a buffer that is empty
+  -- because bufL = bufR = 0.
+  --
+  -- This is really very odd and confusing for our code that expects the difference
+  -- between the old and new input buffer bufLs to indicate the number of elements
+  -- that were consumed!
+  --
+  -- We fix it by explicitly extracting an integer which is the # of things consumed, like so:
+  if isEmptyBuffer ibuf'
+   then return (InputUnderflow, bufferElems ibuf,       ibuf', obuf')
+   else return (why,            bufL ibuf' - bufL ibuf, ibuf', obuf')
+
+byteView :: Buffer CWchar -> Buffer Word8
+byteView (Buffer {..}) = Buffer { bufState = bufState, bufRaw = castForeignPtr bufRaw, bufSize = bufSize * 2, bufL = bufL * 2, bufR = bufR * 2 }
+
+cwcharView :: Buffer Word8 -> Buffer CWchar
+cwcharView (Buffer {..}) = Buffer { bufState = bufState, bufRaw = castForeignPtr bufRaw, bufSize = half bufSize, bufL = half bufL, bufR = half bufR }
+  where half x = case x `divMod` 2 of (y, 0) -> y
+                                      _      -> error "cwcharView: utf16_(encode|decode) (wrote out|consumed) non multiple-of-2 number of bytes"
+
+utf16_native_encode :: CodeBuffer Char CWchar
+utf16_native_encode ibuf obuf = do
+  (why, ibuf, obuf) <- utf16_native_encode' ibuf (byteView obuf)
+  return (why, ibuf, cwcharView obuf)
+
+utf16_native_decode :: CodeBuffer CWchar Char
+utf16_native_decode ibuf obuf = do
+  (why, ibuf, obuf) <- utf16_native_decode' (byteView ibuf) obuf
+  return (why, cwcharView ibuf, obuf)
+
+cpDecode :: Word32 -> Int -> DecodeBuffer
+cpDecode cp max_char_size = \ibuf obuf -> do
+#ifdef CHARBUF_UTF16
+    let mbuf = obuf
+#else
+    -- FIXME: share the buffer between runs, even if the buffer is not the perfect size
+    let sz =       (bufferElems ibuf * 2)     -- I guess in the worst case the input CP text consists of 1-byte sequences that map entirely to things outside the BMP and so require 2 UTF-16 chars
+             `min` (bufferAvailable obuf * 2) -- In the best case, each pair of UTF-16 points becomes a single UTF-32 point
+    mbuf <- newBuffer (2 * sz) sz WriteBuffer :: IO (Buffer CWchar)
+#endif
+    debugIO $ "cpDecode " ++ summaryBuffer ibuf ++ " " ++ summaryBuffer mbuf
+    (why1, ibuf', mbuf') <- cpRecode try' is_valid_prefix max_char_size 1 0 1 ibuf mbuf
+    debugIO $ "cpRecode (cpDecode) = " ++ show why1 ++ " " ++ summaryBuffer ibuf' ++ " " ++ summaryBuffer mbuf'
+#ifdef CHARBUF_UTF16
+    return (why1, ibuf', mbuf')
+#else
+    -- Convert as much UTF-16 as possible to UTF-32. Note that it's impossible for this to fail
+    -- due to illegal characters since the output from Window's encoding function should be correct UTF-16.
+    -- However, it's perfectly possible to run out of either output or input buffer.
+    debugIO $ "utf16_native_decode " ++ summaryBuffer mbuf' ++ " " ++ summaryBuffer obuf
+    (why2, target_utf16_count, mbuf', obuf) <- saner utf16_native_decode (mbuf' { bufState = ReadBuffer }) obuf
+    debugIO $ "utf16_native_decode = " ++ show why2 ++ " " ++ summaryBuffer mbuf' ++ " " ++ summaryBuffer obuf
+    case why2 of
+      -- If we successfully translate all of the UTF-16 buffer, we need to know why we couldn't get any more
+      -- UTF-16 out of the Windows API
+      InputUnderflow | isEmptyBuffer mbuf' -> return (why1, ibuf', obuf)
+                     | otherwise           -> error "cpDecode: impossible underflown UTF-16 buffer"
+      -- InvalidSequence should be impossible since mbuf' is output from Windows.
+      InvalidSequence -> error "InvalidSequence on output of Windows API"
+      -- If we run out of space in obuf, we need to ask for more output buffer space, while also returning
+      -- the characters we have managed to consume so far.
+      OutputUnderflow -> do
+        -- We have an interesting problem here similar to the cpEncode case where we have to figure out how much
+        -- of the byte buffer was consumed to reach as far as the last UTF-16 character we actually decoded to UTF-32 OK.
+        --
+        -- The minimum number of bytes it could take is half the number of UTF-16 chars we got on the output, since
+        -- one byte could theoretically generate two UTF-16 characters.
+        -- The common case (ASCII text) is that every byte in the input maps to a single UTF-16 character.
+        -- In the worst case max_char_size bytes map to each UTF-16 character.
+        byte_count <- bSearch "cpDecode" (cpRecode try' is_valid_prefix max_char_size 1 0 1) ibuf mbuf target_utf16_count (target_utf16_count `div` 2) target_utf16_count (target_utf16_count * max_char_size)
+        return (OutputUnderflow, bufferRemove byte_count ibuf, obuf)
+#endif
+  where
+    is_valid_prefix = c_IsDBCSLeadByteEx cp
+    try' iptr icnt optr ocnt
+     -- MultiByteToWideChar does surprising things if you have ocnt == 0
+     | ocnt == 0 = return (Left True)
+     | otherwise = do
+        err <- c_MultiByteToWideChar (fromIntegral cp) 8 -- MB_ERR_INVALID_CHARS == 8: Fail if an invalid input character is encountered
+                                     iptr (fromIntegral icnt) optr (fromIntegral ocnt)
+        debugIO $ "MultiByteToWideChar " ++ show cp ++ " 8 " ++ show iptr ++ " " ++ show icnt ++ " " ++ show optr ++ " " ++ show ocnt ++ "\n = " ++ show err
+        case err of
+          -- 0 indicates that we did not succeed
+          0 -> do
+            err <- getLastError
+            case err of
+                122  -> return (Left True)
+                1113 -> return (Left False)
+                _    -> failWith "MultiByteToWideChar" err
+          wrote_chars -> return (Right (fromIntegral wrote_chars))
+
+cpEncode :: Word32 -> Int -> EncodeBuffer
+cpEncode cp _max_char_size = \ibuf obuf -> do
+#ifdef CHARBUF_UTF16
+    let mbuf' = ibuf
+#else
+    -- FIXME: share the buffer between runs, even though that means we can't size the buffer as we want.
+    let sz =       (bufferElems ibuf * 2)     -- UTF-32 always uses 4 bytes. UTF-16 uses at most 4 bytes.
+             `min` (bufferAvailable obuf * 2) -- In the best case, each pair of UTF-16 points fits into only 1 byte
+    mbuf <- newBuffer (2 * sz) sz WriteBuffer
+    
+    -- Convert as much UTF-32 as possible to UTF-16. NB: this can't fail due to output underflow
+    -- since we sized the output buffer correctly. However, it could fail due to an illegal character
+    -- in the input if it encounters a lone surrogate. In this case, our recovery will be applied as normal.
+    (why1, ibuf', mbuf') <- utf16_native_encode ibuf mbuf
+#endif
+    debugIO $ "\ncpEncode " ++ summaryBuffer mbuf' ++ " " ++ summaryBuffer obuf
+    (why2, target_utf16_count, mbuf', obuf) <- saner (cpRecode try' is_valid_prefix 2 1 1 0) (mbuf' { bufState = ReadBuffer }) obuf
+    debugIO $ "cpRecode (cpEncode) = " ++ show why2 ++ " " ++ summaryBuffer mbuf' ++ " " ++ summaryBuffer obuf
+#ifdef CHARBUF_UTF16
+    return (why2, mbuf', obuf)
+#else
+    case why2 of
+      -- If we succesfully translate all of the UTF-16 buffer, we need to know why
+      -- we weren't able to get any more UTF-16 out of the UTF-32 buffer
+      InputUnderflow | isEmptyBuffer mbuf' -> return (why1, ibuf', obuf)
+                     | otherwise           -> error "cpEncode: impossible underflown UTF-16 buffer"
+      -- With OutputUnderflow/InvalidSequence we only care about the failings of the UTF-16->CP translation.
+      -- Yes, InvalidSequence is possible even though mbuf' is guaranteed to be valid UTF-16, because
+      -- the code page may not be able to represent the encoded Unicode codepoint.
+      _ -> do
+        -- Here is an interesting problem. If we have only managed to translate part of the mbuf'
+        -- then we need to return an ibuf which has consumed exactly those bytes required to obtain
+        -- that part of the mbuf'. To reconstruct this information, we binary search for the number of
+        -- UTF-32 characters required to get the consumed count of UTF-16 characters:
+        --
+        -- When dealing with data from the BMP (the common case), consuming N UTF-16 characters will be the same as consuming N
+        -- UTF-32 characters. We start our search there so that most binary searches will terminate in a single iteration. 
+        -- Furthermore, the absolute minimum number of UTF-32 characters this can correspond to is 1/2 the UTF-16 byte count
+        -- (this will be realised when the input data is entirely not in the BMP).
+        utf32_count <- bSearch "cpEncode" utf16_native_encode ibuf mbuf target_utf16_count (target_utf16_count `div` 2) target_utf16_count target_utf16_count
+        return (why2, bufferRemove utf32_count ibuf, obuf)
+#endif
+  where
+    -- Single characters should be mappable to bytes. If they aren't supported by the CP then we have an invalid input sequence.
+    is_valid_prefix _ = return False
+
+    try' iptr icnt optr ocnt
+     -- WideCharToMultiByte does surprising things if you call it with ocnt == 0
+     | ocnt == 0 = return (Left True)
+     | otherwise = alloca $ \defaulted_ptr -> do
+      poke defaulted_ptr False
+      err <- c_WideCharToMultiByte (fromIntegral cp) 0 -- NB: the WC_ERR_INVALID_CHARS flag is uselses: only has an effect with the UTF-8 code page
+                                   iptr (fromIntegral icnt) optr (fromIntegral ocnt)
+                                   nullPtr defaulted_ptr
+      defaulted <- peek defaulted_ptr
+      debugIO $ "WideCharToMultiByte " ++ show cp ++ " 0 " ++ show iptr ++ " " ++ show icnt ++ " " ++ show optr ++ " " ++ show ocnt ++ " NULL " ++ show defaulted_ptr ++ "\n = " ++ show err ++ ", " ++ show defaulted
+      case err of
+          -- 0 indicates that we did not succeed
+          0 -> do
+            err <- getLastError
+            case err of
+                122  -> return (Left True)
+                1113 -> return (Left False)
+                _    -> failWith "WideCharToMultiByte" err
+          wrote_bytes | defaulted -> return (Left False)
+                      | otherwise -> return (Right (fromIntegral wrote_bytes))
+
+bSearch :: String
+        -> CodeBuffer from to
+        -> Buffer from -> Buffer to -- From buffer (crucial data source) and to buffer (temporary storage only). To buffer must be empty (L=R).
+        -> Int               -- Target size of to buffer
+        -> Int -> Int -> Int -- Binary search min, mid, max
+        -> IO Int            -- Size of from buffer required to reach target size of to buffer
+bSearch msg code ibuf mbuf target_to_elems = go
+  where
+    go mn md mx = do
+      -- NB: this loop repeatedly reencodes on top of mbuf using a varying fraction of ibuf. It doesn't
+      -- matter if we blast the contents of mbuf since we already consumed all of the contents we are going to use.
+      (_why, ibuf, mbuf) <- code (ibuf { bufR = bufL ibuf + md }) mbuf
+      debugIO $ "code (bSearch " ++ msg ++ ") " ++ show md ++ " = " ++ show _why ++ ", " ++ summaryBuffer ibuf ++ summaryBuffer mbuf
+      -- The normal case is to get InputUnderflow here, which indicates that coding basically
+      -- terminated normally.
+      --
+      -- However, InvalidSequence is also possible if we are being called from cpDecode if we
+      -- have just been unlucky enough to set md so that ibuf straddles a byte boundary.
+      -- In this case we have to be really careful, because we don't want to report that
+      -- "md" elements is the right number when in actual fact we could have had md-1 input
+      -- elements and still produced the same number of bufferElems in mbuf. 
+      --
+      -- In fact, we have to worry about this possibility even if we get InputUnderflow
+      -- since that will report InputUnderflow rather than InvalidSequence if the buffer
+      -- ends in a valid lead byte. So the expedient thing to do is simply to check if
+      -- the input buffer was entirely consumed.
+      --
+      -- When called from cpDecode, OutputUnderflow is also possible.
+      --
+      -- Luckily if we have InvalidSequence/OutputUnderflow and we do not appear to have reached
+      -- the target, what we should do is the same as normal because the fraction of ibuf that our
+      -- first "code" coded succesfully must be invalid-sequence-free, and ibuf will always
+      -- have been decoded as far as the first invalid sequence in it. 
+      case bufferElems mbuf `compare` target_to_elems of
+        -- Coding n "from" chars from the input yields exactly as many "to" chars
+        -- as were consumed by the recode. All is peachy:
+        EQ -> debugIO ("bSearch = " ++ show solution) >> return solution
+          where solution = md - bufferElems ibuf
+        -- If we encoded fewer "to" characters than the target number, try again with more "from" characters (and vice-versa)
+        LT -> go' (md+1) mx
+        GT -> go' mn (md-1)
+    go' mn mx | mn <= mx  = go mn (mn + ((mx - mn) `div` 2)) mx
+              | otherwise = error $ "bSearch(" ++ msg ++ "): search crossed! " ++ show (summaryBuffer ibuf, summaryBuffer mbuf, target_to_elems, mn, mx)
+
+cpRecode :: forall from to. (Show from, Storable from)
+         => (Ptr from -> Int -> Ptr to -> Int -> IO (Either Bool Int))
+         -> (from -> IO Bool)
+         -> Int -- ^ Maximum length of a complete translatable sequence in the input (e.g. 2 if the input is UTF-16, 1 if the input is a SBCS, 2 is the input is a DBCS). Must be at least 1.
+         -> Int -- ^ Minimum number of output elements per complete translatable sequence in the input (almost certainly 1)
+         -> Int -> Int
+         -> CodeBuffer from to
+cpRecode try' is_valid_prefix max_i_size min_o_size iscale oscale = go
+  where
+    go :: CodeBuffer from to
+    go ibuf obuf | isEmptyBuffer ibuf                = return (InputUnderflow,  ibuf, obuf)
+                 | bufferAvailable obuf < min_o_size = return (OutputUnderflow, ibuf, obuf)
+                 | otherwise                         = try (bufferElems ibuf `min` ((max_i_size * bufferAvailable obuf) `div` min_o_size)) seek_smaller
+      where
+        done why = return (why, ibuf, obuf)
+
+        seek_smaller n longer_was_valid
+          -- In this case, we can't shrink any further via any method. Calling (try 0) wouldn't be right because that will always claim InputUnderflow...
+          | n <= 1 = if longer_was_valid
+                      -- try m (where m >= n) was valid but we overflowed the output buffer with even a single input element
+                      then done OutputUnderflow
+                      -- there was no initial valid sequence in the input, but it might just be a truncated buffer - we need to check
+                      else do byte <- withBuffer ibuf $ \ptr -> peekElemOff ptr (bufL ibuf)
+                              valid_prefix <- is_valid_prefix byte
+                              done (if valid_prefix && bufferElems ibuf < max_i_size then InputUnderflow else InvalidSequence)
+          -- If we're already looking at very small buffers, try every n down to 1, to ensure we spot as long a sequence as exists while avoiding trying 0.
+          -- Doing it this way ensures that we spot a single initial sequence of length <= max_i_size if any such exists.
+          | n < 2 * max_i_size = try (n - 1) (\pred_n pred_n_was_valid -> seek_smaller pred_n (longer_was_valid || pred_n_was_valid))
+          -- Otherwise, try a binary chop to try to either get the prefix before the invalid input, or shrink the output down so it fits
+          -- in the output buffer. After the chop, try to consume extra input elements to try to recover as much of the sequence as possible if we
+          -- end up chopping a multi-element input sequence into two parts.
+          --
+          -- Note that since max_i_size >= 1:
+          --  * (n `div` 2) >= 1, so we don't try 0
+          --  * ((n `div` 2) + (max_i_size - 1)) < n, so we don't get into a loop where (seek_smaller n) calls post_divide (n `div` 2) calls (seek_smaller n)
+          | let n' = n `div` 2 = try n' (post_divide n' longer_was_valid)
+
+        post_divide _  _                n True  = seek_smaller n True
+        post_divide n' longer_was_valid n False | n < n' + max_i_size - 1 = try (n + 1) (post_divide n' longer_was_valid) -- There's still a chance..
+                                                | otherwise               = seek_smaller n' longer_was_valid              -- No amount of recovery could save us :(
+
+        try n k_fail = withBuffer ibuf $ \iptr -> withBuffer obuf $ \optr -> do
+          ei_err_wrote <- try' (iptr `plusPtr` (bufL ibuf `shiftL` iscale)) n
+                               (optr `plusPtr` (bufR obuf `shiftL` oscale)) (bufferAvailable obuf)
+          debugIO $ "try " ++ show n ++ " = " ++ show ei_err_wrote
+          case ei_err_wrote of
+            -- ERROR_INSUFFICIENT_BUFFER: A supplied buffer size was not large enough, or it was incorrectly set to NULL.
+            Left True  -> k_fail n True
+            -- ERROR_NO_UNICODE_TRANSLATION: Invalid Unicode was found in a string.
+            Left False -> k_fail n False
+            -- Must have interpreted all given bytes successfully
+            -- We need to iterate until we have consumed the complete contents of the buffer
+            Right wrote_elts -> go (bufferRemove n ibuf) (obuf { bufR = bufR obuf + wrote_elts })
diff --git a/libraries/base/GHC/IO/Encoding/CodePage/Table.hs b/libraries/base/GHC/IO/Encoding/CodePage/Table.hs
new file mode 100644
index 000000000000..eed0841b827e
--- /dev/null
+++ b/libraries/base/GHC/IO/Encoding/CodePage/Table.hs
@@ -0,0 +1,432 @@
+{-# LANGUAGE MagicHash, NoImplicitPrelude #-}
+-- Do not edit this file directly!
+-- It was generated by the MakeTable.hs script using the files below.
+-- To regenerate it, run "make" in ../../../../codepages/
+-- 
+-- Files:
+-- CP037.TXT
+-- CP1026.TXT
+-- CP1250.TXT
+-- CP1251.TXT
+-- CP1252.TXT
+-- CP1253.TXT
+-- CP1254.TXT
+-- CP1255.TXT
+-- CP1256.TXT
+-- CP1257.TXT
+-- CP1258.TXT
+-- CP437.TXT
+-- CP500.TXT
+-- CP737.TXT
+-- CP775.TXT
+-- CP850.TXT
+-- CP852.TXT
+-- CP855.TXT
+-- CP857.TXT
+-- CP860.TXT
+-- CP861.TXT
+-- CP862.TXT
+-- CP863.TXT
+-- CP864.TXT
+-- CP865.TXT
+-- CP866.TXT
+-- CP869.TXT
+-- CP874.TXT
+-- CP875.TXT
+module GHC.IO.Encoding.CodePage.Table where
+
+import GHC.Prim
+import GHC.Base
+import GHC.Word
+data ConvArray a = ConvArray Addr#
+data CompactArray a b = CompactArray {
+    encoderMax :: !a,
+    encoderIndices :: !(ConvArray Int),
+    encoderValues :: !(ConvArray b)
+  }
+
+data CodePageArrays = SingleByteCP {
+    decoderArray :: !(ConvArray Char),
+    encoderArray :: !(CompactArray Char Word8)
+  }
+
+blockBitSize :: Int
+blockBitSize = 6
+codePageMap :: [(Word32, CodePageArrays)]
+codePageMap = [
+    (37, SingleByteCP {
+     decoderArray = ConvArray "\x0\x0\x1\x0\x2\x0\x3\x0\x9c\x0\x9\x0\x86\x0\x7f\x0\x97\x0\x8d\x0\x8e\x0\xb\x0\xc\x0\xd\x0\xe\x0\xf\x0\x10\x0\x11\x0\x12\x0\x13\x0\x9d\x0\x85\x0\x8\x0\x87\x0\x18\x0\x19\x0\x92\x0\x8f\x0\x1c\x0\x1d\x0\x1e\x0\x1f\x0\x80\x0\x81\x0\x82\x0\x83\x0\x84\x0\xa\x0\x17\x0\x1b\x0\x88\x0\x89\x0\x8a\x0\x8b\x0\x8c\x0\x5\x0\x6\x0\x7\x0\x90\x0\x91\x0\x16\x0\x93\x0\x94\x0\x95\x0\x96\x0\x4\x0\x98\x0\x99\x0\x9a\x0\x9b\x0\x14\x0\x15\x0\x9e\x0\x1a\x0\x20\x0\xa0\x0\xe2\x0\xe4\x0\xe0\x0\xe1\x0\xe3\x0\xe5\x0\xe7\x0\xf1\x0\xa2\x0\x2e\x0\x3c\x0\x28\x0\x2b\x0\x7c\x0\x26\x0\xe9\x0\xea\x0\xeb\x0\xe8\x0\xed\x0\xee\x0\xef\x0\xec\x0\xdf\x0\x21\x0\x24\x0\x2a\x0\x29\x0\x3b\x0\xac\x0\x2d\x0\x2f\x0\xc2\x0\xc4\x0\xc0\x0\xc1\x0\xc3\x0\xc5\x0\xc7\x0\xd1\x0\xa6\x0\x2c\x0\x25\x0\x5f\x0\x3e\x0\x3f\x0\xf8\x0\xc9\x0\xca\x0\xcb\x0\xc8\x0\xcd\x0\xce\x0\xcf\x0\xcc\x0\x60\x0\x3a\x0\x23\x0\x40\x0\x27\x0\x3d\x0\x22\x0\xd8\x0\x61\x0\x62\x0\x63\x0\x64\x0\x65\x0\x66\x0\x67\x0\x68\x0\x69\x0\xab\x0\xbb\x0\xf0\x0\xfd\x0\xfe\x0\xb1\x0\xb0\x0\x6a\x0\x6b\x0\x6c\x0\x6d\x0\x6e\x0\x6f\x0\x70\x0\x71\x0\x72\x0\xaa\x0\xba\x0\xe6\x0\xb8\x0\xc6\x0\xa4\x0\xb5\x0\x7e\x0\x73\x0\x74\x0\x75\x0\x76\x0\x77\x0\x78\x0\x79\x0\x7a\x0\xa1\x0\xbf\x0\xd0\x0\xdd\x0\xde\x0\xae\x0\x5e\x0\xa3\x0\xa5\x0\xb7\x0\xa9\x0\xa7\x0\xb6\x0\xbc\x0\xbd\x0\xbe\x0\x5b\x0\x5d\x0\xaf\x0\xa8\x0\xb4\x0\xd7\x0\x7b\x0\x41\x0\x42\x0\x43\x0\x44\x0\x45\x0\x46\x0\x47\x0\x48\x0\x49\x0\xad\x0\xf4\x0\xf6\x0\xf2\x0\xf3\x0\xf5\x0\x7d\x0\x4a\x0\x4b\x0\x4c\x0\x4d\x0\x4e\x0\x4f\x0\x50\x0\x51\x0\x52\x0\xb9\x0\xfb\x0\xfc\x0\xf9\x0\xfa\x0\xff\x0\x5c\x0\xf7\x0\x53\x0\x54\x0\x55\x0\x56\x0\x57\x0\x58\x0\x59\x0\x5a\x0\xb2\x0\xd4\x0\xd6\x0\xd2\x0\xd3\x0\xd5\x0\x30\x0\x31\x0\x32\x0\x33\x0\x34\x0\x35\x0\x36\x0\x37\x0\x38\x0\x39\x0\xb3\x0\xdb\x0\xdc\x0\xd9\x0\xda\x0\x9f\x0"#
+     , encoderArray = 
+ CompactArray {
+        encoderIndices = ConvArray "\x0\x0\x40\x0\x80\x0\xc0\x0"#
+        , encoderValues = ConvArray "\x0\x1\x2\x3\x37\x2d\x2e\x2f\x16\x5\x25\xb\xc\xd\xe\xf\x10\x11\x12\x13\x3c\x3d\x32\x26\x18\x19\x3f\x27\x1c\x1d\x1e\x1f\x40\x5a\x7f\x7b\x5b\x6c\x50\x7d\x4d\x5d\x5c\x4e\x6b\x60\x4b\x61\xf0\xf1\xf2\xf3\xf4\xf5\xf6\xf7\xf8\xf9\x7a\x5e\x4c\x7e\x6e\x6f\x7c\xc1\xc2\xc3\xc4\xc5\xc6\xc7\xc8\xc9\xd1\xd2\xd3\xd4\xd5\xd6\xd7\xd8\xd9\xe2\xe3\xe4\xe5\xe6\xe7\xe8\xe9\xba\xe0\xbb\xb0\x6d\x79\x81\x82\x83\x84\x85\x86\x87\x88\x89\x91\x92\x93\x94\x95\x96\x97\x98\x99\xa2\xa3\xa4\xa5\xa6\xa7\xa8\xa9\xc0\x4f\xd0\xa1\x7\x20\x21\x22\x23\x24\x15\x6\x17\x28\x29\x2a\x2b\x2c\x9\xa\x1b\x30\x31\x1a\x33\x34\x35\x36\x8\x38\x39\x3a\x3b\x4\x14\x3e\xff\x41\xaa\x4a\xb1\x9f\xb2\x6a\xb5\xbd\xb4\x9a\x8a\x5f\xca\xaf\xbc\x90\x8f\xea\xfa\xbe\xa0\xb6\xb3\x9d\xda\x9b\x8b\xb7\xb8\xb9\xab\x64\x65\x62\x66\x63\x67\x9e\x68\x74\x71\x72\x73\x78\x75\x76\x77\xac\x69\xed\xee\xeb\xef\xec\xbf\x80\xfd\xfe\xfb\xfc\xad\xae\x59\x44\x45\x42\x46\x43\x47\x9c\x48\x54\x51\x52\x53\x58\x55\x56\x57\x8c\x49\xcd\xce\xcb\xcf\xcc\xe1\x70\xdd\xde\xdb\xdc\x8d\x8e\xdf"#
+        , encoderMax = '\255'
+        }
+
+   }
+    )
+
+    ,
+    (1026, SingleByteCP {
+     decoderArray = ConvArray "\x0\x0\x1\x0\x2\x0\x3\x0\x9c\x0\x9\x0\x86\x0\x7f\x0\x97\x0\x8d\x0\x8e\x0\xb\x0\xc\x0\xd\x0\xe\x0\xf\x0\x10\x0\x11\x0\x12\x0\x13\x0\x9d\x0\x85\x0\x8\x0\x87\x0\x18\x0\x19\x0\x92\x0\x8f\x0\x1c\x0\x1d\x0\x1e\x0\x1f\x0\x80\x0\x81\x0\x82\x0\x83\x0\x84\x0\xa\x0\x17\x0\x1b\x0\x88\x0\x89\x0\x8a\x0\x8b\x0\x8c\x0\x5\x0\x6\x0\x7\x0\x90\x0\x91\x0\x16\x0\x93\x0\x94\x0\x95\x0\x96\x0\x4\x0\x98\x0\x99\x0\x9a\x0\x9b\x0\x14\x0\x15\x0\x9e\x0\x1a\x0\x20\x0\xa0\x0\xe2\x0\xe4\x0\xe0\x0\xe1\x0\xe3\x0\xe5\x0\x7b\x0\xf1\x0\xc7\x0\x2e\x0\x3c\x0\x28\x0\x2b\x0\x21\x0\x26\x0\xe9\x0\xea\x0\xeb\x0\xe8\x0\xed\x0\xee\x0\xef\x0\xec\x0\xdf\x0\x1e\x1\x30\x1\x2a\x0\x29\x0\x3b\x0\x5e\x0\x2d\x0\x2f\x0\xc2\x0\xc4\x0\xc0\x0\xc1\x0\xc3\x0\xc5\x0\x5b\x0\xd1\x0\x5f\x1\x2c\x0\x25\x0\x5f\x0\x3e\x0\x3f\x0\xf8\x0\xc9\x0\xca\x0\xcb\x0\xc8\x0\xcd\x0\xce\x0\xcf\x0\xcc\x0\x31\x1\x3a\x0\xd6\x0\x5e\x1\x27\x0\x3d\x0\xdc\x0\xd8\x0\x61\x0\x62\x0\x63\x0\x64\x0\x65\x0\x66\x0\x67\x0\x68\x0\x69\x0\xab\x0\xbb\x0\x7d\x0\x60\x0\xa6\x0\xb1\x0\xb0\x0\x6a\x0\x6b\x0\x6c\x0\x6d\x0\x6e\x0\x6f\x0\x70\x0\x71\x0\x72\x0\xaa\x0\xba\x0\xe6\x0\xb8\x0\xc6\x0\xa4\x0\xb5\x0\xf6\x0\x73\x0\x74\x0\x75\x0\x76\x0\x77\x0\x78\x0\x79\x0\x7a\x0\xa1\x0\xbf\x0\x5d\x0\x24\x0\x40\x0\xae\x0\xa2\x0\xa3\x0\xa5\x0\xb7\x0\xa9\x0\xa7\x0\xb6\x0\xbc\x0\xbd\x0\xbe\x0\xac\x0\x7c\x0\xaf\x0\xa8\x0\xb4\x0\xd7\x0\xe7\x0\x41\x0\x42\x0\x43\x0\x44\x0\x45\x0\x46\x0\x47\x0\x48\x0\x49\x0\xad\x0\xf4\x0\x7e\x0\xf2\x0\xf3\x0\xf5\x0\x1f\x1\x4a\x0\x4b\x0\x4c\x0\x4d\x0\x4e\x0\x4f\x0\x50\x0\x51\x0\x52\x0\xb9\x0\xfb\x0\x5c\x0\xf9\x0\xfa\x0\xff\x0\xfc\x0\xf7\x0\x53\x0\x54\x0\x55\x0\x56\x0\x57\x0\x58\x0\x59\x0\x5a\x0\xb2\x0\xd4\x0\x23\x0\xd2\x0\xd3\x0\xd5\x0\x30\x0\x31\x0\x32\x0\x33\x0\x34\x0\x35\x0\x36\x0\x37\x0\x38\x0\x39\x0\xb3\x0\xdb\x0\x22\x0\xd9\x0\xda\x0\x9f\x0"#
+     , encoderArray = 
+ CompactArray {
+        encoderIndices = ConvArray "\x0\x0\x40\x0\x80\x0\xc0\x0\x0\x1\x40\x1"#
+        , encoderValues = ConvArray "\x0\x1\x2\x3\x37\x2d\x2e\x2f\x16\x5\x25\xb\xc\xd\xe\xf\x10\x11\x12\x13\x3c\x3d\x32\x26\x18\x19\x3f\x27\x1c\x1d\x1e\x1f\x40\x4f\xfc\xec\xad\x6c\x50\x7d\x4d\x5d\x5c\x4e\x6b\x60\x4b\x61\xf0\xf1\xf2\xf3\xf4\xf5\xf6\xf7\xf8\xf9\x7a\x5e\x4c\x7e\x6e\x6f\xae\xc1\xc2\xc3\xc4\xc5\xc6\xc7\xc8\xc9\xd1\xd2\xd3\xd4\xd5\xd6\xd7\xd8\xd9\xe2\xe3\xe4\xe5\xe6\xe7\xe8\xe9\x68\xdc\xac\x5f\x6d\x8d\x81\x82\x83\x84\x85\x86\x87\x88\x89\x91\x92\x93\x94\x95\x96\x97\x98\x99\xa2\xa3\xa4\xa5\xa6\xa7\xa8\xa9\x48\xbb\x8c\xcc\x7\x20\x21\x22\x23\x24\x15\x6\x17\x28\x29\x2a\x2b\x2c\x9\xa\x1b\x30\x31\x1a\x33\x34\x35\x36\x8\x38\x39\x3a\x3b\x4\x14\x3e\xff\x41\xaa\xb0\xb1\x9f\xb2\x8e\xb5\xbd\xb4\x9a\x8a\xba\xca\xaf\xbc\x90\x8f\xea\xfa\xbe\xa0\xb6\xb3\x9d\xda\x9b\x8b\xb7\xb8\xb9\xab\x64\x65\x62\x66\x63\x67\x9e\x4a\x74\x71\x72\x73\x78\x75\x76\x77\x0\x69\xed\xee\xeb\xef\x7b\xbf\x80\xfd\xfe\xfb\x7f\x0\x0\x59\x44\x45\x42\x46\x43\x47\x9c\xc0\x54\x51\x52\x53\x58\x55\x56\x57\x0\x49\xcd\xce\xcb\xcf\xa1\xe1\x70\xdd\xde\xdb\xe0\x0\x0\xdf\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x5a\xd0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x5b\x79\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x7c\x6a"#
+        , encoderMax = '\351'
+        }
+
+   }
+    )
+
+    ,
+    (1250, SingleByteCP {
+     decoderArray = ConvArray "\x0\x0\x1\x0\x2\x0\x3\x0\x4\x0\x5\x0\x6\x0\x7\x0\x8\x0\x9\x0\xa\x0\xb\x0\xc\x0\xd\x0\xe\x0\xf\x0\x10\x0\x11\x0\x12\x0\x13\x0\x14\x0\x15\x0\x16\x0\x17\x0\x18\x0\x19\x0\x1a\x0\x1b\x0\x1c\x0\x1d\x0\x1e\x0\x1f\x0\x20\x0\x21\x0\x22\x0\x23\x0\x24\x0\x25\x0\x26\x0\x27\x0\x28\x0\x29\x0\x2a\x0\x2b\x0\x2c\x0\x2d\x0\x2e\x0\x2f\x0\x30\x0\x31\x0\x32\x0\x33\x0\x34\x0\x35\x0\x36\x0\x37\x0\x38\x0\x39\x0\x3a\x0\x3b\x0\x3c\x0\x3d\x0\x3e\x0\x3f\x0\x40\x0\x41\x0\x42\x0\x43\x0\x44\x0\x45\x0\x46\x0\x47\x0\x48\x0\x49\x0\x4a\x0\x4b\x0\x4c\x0\x4d\x0\x4e\x0\x4f\x0\x50\x0\x51\x0\x52\x0\x53\x0\x54\x0\x55\x0\x56\x0\x57\x0\x58\x0\x59\x0\x5a\x0\x5b\x0\x5c\x0\x5d\x0\x5e\x0\x5f\x0\x60\x0\x61\x0\x62\x0\x63\x0\x64\x0\x65\x0\x66\x0\x67\x0\x68\x0\x69\x0\x6a\x0\x6b\x0\x6c\x0\x6d\x0\x6e\x0\x6f\x0\x70\x0\x71\x0\x72\x0\x73\x0\x74\x0\x75\x0\x76\x0\x77\x0\x78\x0\x79\x0\x7a\x0\x7b\x0\x7c\x0\x7d\x0\x7e\x0\x7f\x0\xac\x20\x0\x0\x1a\x20\x0\x0\x1e\x20\x26\x20\x20\x20\x21\x20\x0\x0\x30\x20\x60\x1\x39\x20\x5a\x1\x64\x1\x7d\x1\x79\x1\x0\x0\x18\x20\x19\x20\x1c\x20\x1d\x20\x22\x20\x13\x20\x14\x20\x0\x0\x22\x21\x61\x1\x3a\x20\x5b\x1\x65\x1\x7e\x1\x7a\x1\xa0\x0\xc7\x2\xd8\x2\x41\x1\xa4\x0\x4\x1\xa6\x0\xa7\x0\xa8\x0\xa9\x0\x5e\x1\xab\x0\xac\x0\xad\x0\xae\x0\x7b\x1\xb0\x0\xb1\x0\xdb\x2\x42\x1\xb4\x0\xb5\x0\xb6\x0\xb7\x0\xb8\x0\x5\x1\x5f\x1\xbb\x0\x3d\x1\xdd\x2\x3e\x1\x7c\x1\x54\x1\xc1\x0\xc2\x0\x2\x1\xc4\x0\x39\x1\x6\x1\xc7\x0\xc\x1\xc9\x0\x18\x1\xcb\x0\x1a\x1\xcd\x0\xce\x0\xe\x1\x10\x1\x43\x1\x47\x1\xd3\x0\xd4\x0\x50\x1\xd6\x0\xd7\x0\x58\x1\x6e\x1\xda\x0\x70\x1\xdc\x0\xdd\x0\x62\x1\xdf\x0\x55\x1\xe1\x0\xe2\x0\x3\x1\xe4\x0\x3a\x1\x7\x1\xe7\x0\xd\x1\xe9\x0\x19\x1\xeb\x0\x1b\x1\xed\x0\xee\x0\xf\x1\x11\x1\x44\x1\x48\x1\xf3\x0\xf4\x0\x51\x1\xf6\x0\xf7\x0\x59\x1\x6f\x1\xfa\x0\x71\x1\xfc\x0\xfd\x0\x63\x1\xd9\x2"#
+     , encoderArray = 
+ CompactArray {
+        encoderIndices = ConvArray "\x0\x0\x40\x0\x80\x0\xc0\x0\x0\x1\x40\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\xc0\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x0\x2\x80\x1\x40\x2\x80\x1\x80\x2"#
+        , encoderValues = ConvArray "\x0\x1\x2\x3\x4\x5\x6\x7\x8\x9\xa\xb\xc\xd\xe\xf\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x1a\x1b\x1c\x1d\x1e\x1f\x20\x21\x22\x23\x24\x25\x26\x27\x28\x29\x2a\x2b\x2c\x2d\x2e\x2f\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x3a\x3b\x3c\x3d\x3e\x3f\x40\x41\x42\x43\x44\x45\x46\x47\x48\x49\x4a\x4b\x4c\x4d\x4e\x4f\x50\x51\x52\x53\x54\x55\x56\x57\x58\x59\x5a\x5b\x5c\x5d\x5e\x5f\x60\x61\x62\x63\x64\x65\x66\x67\x68\x69\x6a\x6b\x6c\x6d\x6e\x6f\x70\x71\x72\x73\x74\x75\x76\x77\x78\x79\x7a\x7b\x7c\x7d\x7e\x7f\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xa0\x0\x0\x0\xa4\x0\xa6\xa7\xa8\xa9\x0\xab\xac\xad\xae\x0\xb0\xb1\x0\x0\xb4\xb5\xb6\xb7\xb8\x0\x0\xbb\x0\x0\x0\x0\x0\xc1\xc2\x0\xc4\x0\x0\xc7\x0\xc9\x0\xcb\x0\xcd\xce\x0\x0\x0\x0\xd3\xd4\x0\xd6\xd7\x0\x0\xda\x0\xdc\xdd\x0\xdf\x0\xe1\xe2\x0\xe4\x0\x0\xe7\x0\xe9\x0\xeb\x0\xed\xee\x0\x0\x0\x0\xf3\xf4\x0\xf6\xf7\x0\x0\xfa\x0\xfc\xfd\x0\x0\x0\x0\xc3\xe3\xa5\xb9\xc6\xe6\x0\x0\x0\x0\xc8\xe8\xcf\xef\xd0\xf0\x0\x0\x0\x0\x0\x0\xca\xea\xcc\xec\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xc5\xe5\x0\x0\xbc\xbe\x0\x0\xa3\xb3\xd1\xf1\x0\x0\xd2\xf2\x0\x0\x0\x0\x0\x0\x0\xd5\xf5\x0\x0\xc0\xe0\x0\x0\xd8\xf8\x8c\x9c\x0\x0\xaa\xba\x8a\x9a\xde\xfe\x8d\x9d\x0\x0\x0\x0\x0\x0\x0\x0\xd9\xf9\xdb\xfb\x0\x0\x0\x0\x0\x0\x0\x8f\x9f\xaf\xbf\x8e\x9e\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xa1\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xa2\xff\x0\xb2\x0\xbd\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x96\x97\x0\x0\x0\x91\x92\x82\x0\x93\x94\x84\x0\x86\x87\x95\x0\x0\x0\x85\x0\x0\x0\x0\x0\x0\x0\x0\x0\x89\x0\x0\x0\x0\x0\x0\x0\x0\x8b\x9b\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x80\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x99"#
+        , encoderMax = '\8482'
+        }
+
+   }
+    )
+
+    ,
+    (1251, SingleByteCP {
+     decoderArray = ConvArray "\x0\x0\x1\x0\x2\x0\x3\x0\x4\x0\x5\x0\x6\x0\x7\x0\x8\x0\x9\x0\xa\x0\xb\x0\xc\x0\xd\x0\xe\x0\xf\x0\x10\x0\x11\x0\x12\x0\x13\x0\x14\x0\x15\x0\x16\x0\x17\x0\x18\x0\x19\x0\x1a\x0\x1b\x0\x1c\x0\x1d\x0\x1e\x0\x1f\x0\x20\x0\x21\x0\x22\x0\x23\x0\x24\x0\x25\x0\x26\x0\x27\x0\x28\x0\x29\x0\x2a\x0\x2b\x0\x2c\x0\x2d\x0\x2e\x0\x2f\x0\x30\x0\x31\x0\x32\x0\x33\x0\x34\x0\x35\x0\x36\x0\x37\x0\x38\x0\x39\x0\x3a\x0\x3b\x0\x3c\x0\x3d\x0\x3e\x0\x3f\x0\x40\x0\x41\x0\x42\x0\x43\x0\x44\x0\x45\x0\x46\x0\x47\x0\x48\x0\x49\x0\x4a\x0\x4b\x0\x4c\x0\x4d\x0\x4e\x0\x4f\x0\x50\x0\x51\x0\x52\x0\x53\x0\x54\x0\x55\x0\x56\x0\x57\x0\x58\x0\x59\x0\x5a\x0\x5b\x0\x5c\x0\x5d\x0\x5e\x0\x5f\x0\x60\x0\x61\x0\x62\x0\x63\x0\x64\x0\x65\x0\x66\x0\x67\x0\x68\x0\x69\x0\x6a\x0\x6b\x0\x6c\x0\x6d\x0\x6e\x0\x6f\x0\x70\x0\x71\x0\x72\x0\x73\x0\x74\x0\x75\x0\x76\x0\x77\x0\x78\x0\x79\x0\x7a\x0\x7b\x0\x7c\x0\x7d\x0\x7e\x0\x7f\x0\x2\x4\x3\x4\x1a\x20\x53\x4\x1e\x20\x26\x20\x20\x20\x21\x20\xac\x20\x30\x20\x9\x4\x39\x20\xa\x4\xc\x4\xb\x4\xf\x4\x52\x4\x18\x20\x19\x20\x1c\x20\x1d\x20\x22\x20\x13\x20\x14\x20\x0\x0\x22\x21\x59\x4\x3a\x20\x5a\x4\x5c\x4\x5b\x4\x5f\x4\xa0\x0\xe\x4\x5e\x4\x8\x4\xa4\x0\x90\x4\xa6\x0\xa7\x0\x1\x4\xa9\x0\x4\x4\xab\x0\xac\x0\xad\x0\xae\x0\x7\x4\xb0\x0\xb1\x0\x6\x4\x56\x4\x91\x4\xb5\x0\xb6\x0\xb7\x0\x51\x4\x16\x21\x54\x4\xbb\x0\x58\x4\x5\x4\x55\x4\x57\x4\x10\x4\x11\x4\x12\x4\x13\x4\x14\x4\x15\x4\x16\x4\x17\x4\x18\x4\x19\x4\x1a\x4\x1b\x4\x1c\x4\x1d\x4\x1e\x4\x1f\x4\x20\x4\x21\x4\x22\x4\x23\x4\x24\x4\x25\x4\x26\x4\x27\x4\x28\x4\x29\x4\x2a\x4\x2b\x4\x2c\x4\x2d\x4\x2e\x4\x2f\x4\x30\x4\x31\x4\x32\x4\x33\x4\x34\x4\x35\x4\x36\x4\x37\x4\x38\x4\x39\x4\x3a\x4\x3b\x4\x3c\x4\x3d\x4\x3e\x4\x3f\x4\x40\x4\x41\x4\x42\x4\x43\x4\x44\x4\x45\x4\x46\x4\x47\x4\x48\x4\x49\x4\x4a\x4\x4b\x4\x4c\x4\x4d\x4\x4e\x4\x4f\x4"#
+     , encoderArray = 
+ CompactArray {
+        encoderIndices = ConvArray "\x0\x0\x40\x0\x80\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\x0\x1\x40\x1\x80\x1\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x1\xc0\x0\x0\x2\xc0\x0\x40\x2"#
+        , encoderValues = ConvArray "\x0\x1\x2\x3\x4\x5\x6\x7\x8\x9\xa\xb\xc\xd\xe\xf\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x1a\x1b\x1c\x1d\x1e\x1f\x20\x21\x22\x23\x24\x25\x26\x27\x28\x29\x2a\x2b\x2c\x2d\x2e\x2f\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x3a\x3b\x3c\x3d\x3e\x3f\x40\x41\x42\x43\x44\x45\x46\x47\x48\x49\x4a\x4b\x4c\x4d\x4e\x4f\x50\x51\x52\x53\x54\x55\x56\x57\x58\x59\x5a\x5b\x5c\x5d\x5e\x5f\x60\x61\x62\x63\x64\x65\x66\x67\x68\x69\x6a\x6b\x6c\x6d\x6e\x6f\x70\x71\x72\x73\x74\x75\x76\x77\x78\x79\x7a\x7b\x7c\x7d\x7e\x7f\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xa0\x0\x0\x0\xa4\x0\xa6\xa7\x0\xa9\x0\xab\xac\xad\xae\x0\xb0\xb1\x0\x0\x0\xb5\xb6\xb7\x0\x0\x0\xbb\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xa8\x80\x81\xaa\xbd\xb2\xaf\xa3\x8a\x8c\x8e\x8d\x0\xa1\x8f\xc0\xc1\xc2\xc3\xc4\xc5\xc6\xc7\xc8\xc9\xca\xcb\xcc\xcd\xce\xcf\xd0\xd1\xd2\xd3\xd4\xd5\xd6\xd7\xd8\xd9\xda\xdb\xdc\xdd\xde\xdf\xe0\xe1\xe2\xe3\xe4\xe5\xe6\xe7\xe8\xe9\xea\xeb\xec\xed\xee\xef\xf0\xf1\xf2\xf3\xf4\xf5\xf6\xf7\xf8\xf9\xfa\xfb\xfc\xfd\xfe\xff\x0\xb8\x90\x83\xba\xbe\xb3\xbf\xbc\x9a\x9c\x9e\x9d\x0\xa2\x9f\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xa5\xb4\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x96\x97\x0\x0\x0\x91\x92\x82\x0\x93\x94\x84\x0\x86\x87\x95\x0\x0\x0\x85\x0\x0\x0\x0\x0\x0\x0\x0\x0\x89\x0\x0\x0\x0\x0\x0\x0\x0\x8b\x9b\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x88\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xb9\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x99"#
+        , encoderMax = '\8482'
+        }
+
+   }
+    )
+
+    ,
+    (1252, SingleByteCP {
+     decoderArray = ConvArray "\x0\x0\x1\x0\x2\x0\x3\x0\x4\x0\x5\x0\x6\x0\x7\x0\x8\x0\x9\x0\xa\x0\xb\x0\xc\x0\xd\x0\xe\x0\xf\x0\x10\x0\x11\x0\x12\x0\x13\x0\x14\x0\x15\x0\x16\x0\x17\x0\x18\x0\x19\x0\x1a\x0\x1b\x0\x1c\x0\x1d\x0\x1e\x0\x1f\x0\x20\x0\x21\x0\x22\x0\x23\x0\x24\x0\x25\x0\x26\x0\x27\x0\x28\x0\x29\x0\x2a\x0\x2b\x0\x2c\x0\x2d\x0\x2e\x0\x2f\x0\x30\x0\x31\x0\x32\x0\x33\x0\x34\x0\x35\x0\x36\x0\x37\x0\x38\x0\x39\x0\x3a\x0\x3b\x0\x3c\x0\x3d\x0\x3e\x0\x3f\x0\x40\x0\x41\x0\x42\x0\x43\x0\x44\x0\x45\x0\x46\x0\x47\x0\x48\x0\x49\x0\x4a\x0\x4b\x0\x4c\x0\x4d\x0\x4e\x0\x4f\x0\x50\x0\x51\x0\x52\x0\x53\x0\x54\x0\x55\x0\x56\x0\x57\x0\x58\x0\x59\x0\x5a\x0\x5b\x0\x5c\x0\x5d\x0\x5e\x0\x5f\x0\x60\x0\x61\x0\x62\x0\x63\x0\x64\x0\x65\x0\x66\x0\x67\x0\x68\x0\x69\x0\x6a\x0\x6b\x0\x6c\x0\x6d\x0\x6e\x0\x6f\x0\x70\x0\x71\x0\x72\x0\x73\x0\x74\x0\x75\x0\x76\x0\x77\x0\x78\x0\x79\x0\x7a\x0\x7b\x0\x7c\x0\x7d\x0\x7e\x0\x7f\x0\xac\x20\x0\x0\x1a\x20\x92\x1\x1e\x20\x26\x20\x20\x20\x21\x20\xc6\x2\x30\x20\x60\x1\x39\x20\x52\x1\x0\x0\x7d\x1\x0\x0\x0\x0\x18\x20\x19\x20\x1c\x20\x1d\x20\x22\x20\x13\x20\x14\x20\xdc\x2\x22\x21\x61\x1\x3a\x20\x53\x1\x0\x0\x7e\x1\x78\x1\xa0\x0\xa1\x0\xa2\x0\xa3\x0\xa4\x0\xa5\x0\xa6\x0\xa7\x0\xa8\x0\xa9\x0\xaa\x0\xab\x0\xac\x0\xad\x0\xae\x0\xaf\x0\xb0\x0\xb1\x0\xb2\x0\xb3\x0\xb4\x0\xb5\x0\xb6\x0\xb7\x0\xb8\x0\xb9\x0\xba\x0\xbb\x0\xbc\x0\xbd\x0\xbe\x0\xbf\x0\xc0\x0\xc1\x0\xc2\x0\xc3\x0\xc4\x0\xc5\x0\xc6\x0\xc7\x0\xc8\x0\xc9\x0\xca\x0\xcb\x0\xcc\x0\xcd\x0\xce\x0\xcf\x0\xd0\x0\xd1\x0\xd2\x0\xd3\x0\xd4\x0\xd5\x0\xd6\x0\xd7\x0\xd8\x0\xd9\x0\xda\x0\xdb\x0\xdc\x0\xdd\x0\xde\x0\xdf\x0\xe0\x0\xe1\x0\xe2\x0\xe3\x0\xe4\x0\xe5\x0\xe6\x0\xe7\x0\xe8\x0\xe9\x0\xea\x0\xeb\x0\xec\x0\xed\x0\xee\x0\xef\x0\xf0\x0\xf1\x0\xf2\x0\xf3\x0\xf4\x0\xf5\x0\xf6\x0\xf7\x0\xf8\x0\xf9\x0\xfa\x0\xfb\x0\xfc\x0\xfd\x0\xfe\x0\xff\x0"#
+     , encoderArray = 
+ CompactArray {
+        encoderIndices = ConvArray "\x0\x0\x40\x0\x80\x0\xc0\x0\x0\x1\x40\x1\x80\x1\x0\x1\x0\x1\x0\x1\x0\x1\xc0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x2\x0\x1\x40\x2\x0\x1\x80\x2"#
+        , encoderValues = ConvArray "\x0\x1\x2\x3\x4\x5\x6\x7\x8\x9\xa\xb\xc\xd\xe\xf\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x1a\x1b\x1c\x1d\x1e\x1f\x20\x21\x22\x23\x24\x25\x26\x27\x28\x29\x2a\x2b\x2c\x2d\x2e\x2f\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x3a\x3b\x3c\x3d\x3e\x3f\x40\x41\x42\x43\x44\x45\x46\x47\x48\x49\x4a\x4b\x4c\x4d\x4e\x4f\x50\x51\x52\x53\x54\x55\x56\x57\x58\x59\x5a\x5b\x5c\x5d\x5e\x5f\x60\x61\x62\x63\x64\x65\x66\x67\x68\x69\x6a\x6b\x6c\x6d\x6e\x6f\x70\x71\x72\x73\x74\x75\x76\x77\x78\x79\x7a\x7b\x7c\x7d\x7e\x7f\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xa0\xa1\xa2\xa3\xa4\xa5\xa6\xa7\xa8\xa9\xaa\xab\xac\xad\xae\xaf\xb0\xb1\xb2\xb3\xb4\xb5\xb6\xb7\xb8\xb9\xba\xbb\xbc\xbd\xbe\xbf\xc0\xc1\xc2\xc3\xc4\xc5\xc6\xc7\xc8\xc9\xca\xcb\xcc\xcd\xce\xcf\xd0\xd1\xd2\xd3\xd4\xd5\xd6\xd7\xd8\xd9\xda\xdb\xdc\xdd\xde\xdf\xe0\xe1\xe2\xe3\xe4\xe5\xe6\xe7\xe8\xe9\xea\xeb\xec\xed\xee\xef\xf0\xf1\xf2\xf3\xf4\xf5\xf6\xf7\xf8\xf9\xfa\xfb\xfc\xfd\xfe\xff\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x8c\x9c\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x8a\x9a\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x9f\x0\x0\x0\x0\x8e\x9e\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x83\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x88\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x98\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x96\x97\x0\x0\x0\x91\x92\x82\x0\x93\x94\x84\x0\x86\x87\x95\x0\x0\x0\x85\x0\x0\x0\x0\x0\x0\x0\x0\x0\x89\x0\x0\x0\x0\x0\x0\x0\x0\x8b\x9b\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x80\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x99"#
+        , encoderMax = '\8482'
+        }
+
+   }
+    )
+
+    ,
+    (1253, SingleByteCP {
+     decoderArray = ConvArray "\x0\x0\x1\x0\x2\x0\x3\x0\x4\x0\x5\x0\x6\x0\x7\x0\x8\x0\x9\x0\xa\x0\xb\x0\xc\x0\xd\x0\xe\x0\xf\x0\x10\x0\x11\x0\x12\x0\x13\x0\x14\x0\x15\x0\x16\x0\x17\x0\x18\x0\x19\x0\x1a\x0\x1b\x0\x1c\x0\x1d\x0\x1e\x0\x1f\x0\x20\x0\x21\x0\x22\x0\x23\x0\x24\x0\x25\x0\x26\x0\x27\x0\x28\x0\x29\x0\x2a\x0\x2b\x0\x2c\x0\x2d\x0\x2e\x0\x2f\x0\x30\x0\x31\x0\x32\x0\x33\x0\x34\x0\x35\x0\x36\x0\x37\x0\x38\x0\x39\x0\x3a\x0\x3b\x0\x3c\x0\x3d\x0\x3e\x0\x3f\x0\x40\x0\x41\x0\x42\x0\x43\x0\x44\x0\x45\x0\x46\x0\x47\x0\x48\x0\x49\x0\x4a\x0\x4b\x0\x4c\x0\x4d\x0\x4e\x0\x4f\x0\x50\x0\x51\x0\x52\x0\x53\x0\x54\x0\x55\x0\x56\x0\x57\x0\x58\x0\x59\x0\x5a\x0\x5b\x0\x5c\x0\x5d\x0\x5e\x0\x5f\x0\x60\x0\x61\x0\x62\x0\x63\x0\x64\x0\x65\x0\x66\x0\x67\x0\x68\x0\x69\x0\x6a\x0\x6b\x0\x6c\x0\x6d\x0\x6e\x0\x6f\x0\x70\x0\x71\x0\x72\x0\x73\x0\x74\x0\x75\x0\x76\x0\x77\x0\x78\x0\x79\x0\x7a\x0\x7b\x0\x7c\x0\x7d\x0\x7e\x0\x7f\x0\xac\x20\x0\x0\x1a\x20\x92\x1\x1e\x20\x26\x20\x20\x20\x21\x20\x0\x0\x30\x20\x0\x0\x39\x20\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x18\x20\x19\x20\x1c\x20\x1d\x20\x22\x20\x13\x20\x14\x20\x0\x0\x22\x21\x0\x0\x3a\x20\x0\x0\x0\x0\x0\x0\x0\x0\xa0\x0\x85\x3\x86\x3\xa3\x0\xa4\x0\xa5\x0\xa6\x0\xa7\x0\xa8\x0\xa9\x0\x0\x0\xab\x0\xac\x0\xad\x0\xae\x0\x15\x20\xb0\x0\xb1\x0\xb2\x0\xb3\x0\x84\x3\xb5\x0\xb6\x0\xb7\x0\x88\x3\x89\x3\x8a\x3\xbb\x0\x8c\x3\xbd\x0\x8e\x3\x8f\x3\x90\x3\x91\x3\x92\x3\x93\x3\x94\x3\x95\x3\x96\x3\x97\x3\x98\x3\x99\x3\x9a\x3\x9b\x3\x9c\x3\x9d\x3\x9e\x3\x9f\x3\xa0\x3\xa1\x3\x0\x0\xa3\x3\xa4\x3\xa5\x3\xa6\x3\xa7\x3\xa8\x3\xa9\x3\xaa\x3\xab\x3\xac\x3\xad\x3\xae\x3\xaf\x3\xb0\x3\xb1\x3\xb2\x3\xb3\x3\xb4\x3\xb5\x3\xb6\x3\xb7\x3\xb8\x3\xb9\x3\xba\x3\xbb\x3\xbc\x3\xbd\x3\xbe\x3\xbf\x3\xc0\x3\xc1\x3\xc2\x3\xc3\x3\xc4\x3\xc5\x3\xc6\x3\xc7\x3\xc8\x3\xc9\x3\xca\x3\xcb\x3\xcc\x3\xcd\x3\xce\x3\x0\x0"#
+     , encoderArray = 
+ CompactArray {
+        encoderIndices = ConvArray "\x0\x0\x40\x0\x80\x0\xc0\x0\xc0\x0\xc0\x0\x0\x1\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\x40\x1\x80\x1\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x1\xc0\x0\x0\x2\xc0\x0\x40\x2"#
+        , encoderValues = ConvArray "\x0\x1\x2\x3\x4\x5\x6\x7\x8\x9\xa\xb\xc\xd\xe\xf\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x1a\x1b\x1c\x1d\x1e\x1f\x20\x21\x22\x23\x24\x25\x26\x27\x28\x29\x2a\x2b\x2c\x2d\x2e\x2f\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x3a\x3b\x3c\x3d\x3e\x3f\x40\x41\x42\x43\x44\x45\x46\x47\x48\x49\x4a\x4b\x4c\x4d\x4e\x4f\x50\x51\x52\x53\x54\x55\x56\x57\x58\x59\x5a\x5b\x5c\x5d\x5e\x5f\x60\x61\x62\x63\x64\x65\x66\x67\x68\x69\x6a\x6b\x6c\x6d\x6e\x6f\x70\x71\x72\x73\x74\x75\x76\x77\x78\x79\x7a\x7b\x7c\x7d\x7e\x7f\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xa0\x0\x0\xa3\xa4\xa5\xa6\xa7\xa8\xa9\x0\xab\xac\xad\xae\x0\xb0\xb1\xb2\xb3\x0\xb5\xb6\xb7\x0\x0\x0\xbb\x0\xbd\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x83\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xb4\xa1\xa2\x0\xb8\xb9\xba\x0\xbc\x0\xbe\xbf\xc0\xc1\xc2\xc3\xc4\xc5\xc6\xc7\xc8\xc9\xca\xcb\xcc\xcd\xce\xcf\xd0\xd1\x0\xd3\xd4\xd5\xd6\xd7\xd8\xd9\xda\xdb\xdc\xdd\xde\xdf\xe0\xe1\xe2\xe3\xe4\xe5\xe6\xe7\xe8\xe9\xea\xeb\xec\xed\xee\xef\xf0\xf1\xf2\xf3\xf4\xf5\xf6\xf7\xf8\xf9\xfa\xfb\xfc\xfd\xfe\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x96\x97\xaf\x0\x0\x91\x92\x82\x0\x93\x94\x84\x0\x86\x87\x95\x0\x0\x0\x85\x0\x0\x0\x0\x0\x0\x0\x0\x0\x89\x0\x0\x0\x0\x0\x0\x0\x0\x8b\x9b\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x80\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x99"#
+        , encoderMax = '\8482'
+        }
+
+   }
+    )
+
+    ,
+    (1254, SingleByteCP {
+     decoderArray = ConvArray "\x0\x0\x1\x0\x2\x0\x3\x0\x4\x0\x5\x0\x6\x0\x7\x0\x8\x0\x9\x0\xa\x0\xb\x0\xc\x0\xd\x0\xe\x0\xf\x0\x10\x0\x11\x0\x12\x0\x13\x0\x14\x0\x15\x0\x16\x0\x17\x0\x18\x0\x19\x0\x1a\x0\x1b\x0\x1c\x0\x1d\x0\x1e\x0\x1f\x0\x20\x0\x21\x0\x22\x0\x23\x0\x24\x0\x25\x0\x26\x0\x27\x0\x28\x0\x29\x0\x2a\x0\x2b\x0\x2c\x0\x2d\x0\x2e\x0\x2f\x0\x30\x0\x31\x0\x32\x0\x33\x0\x34\x0\x35\x0\x36\x0\x37\x0\x38\x0\x39\x0\x3a\x0\x3b\x0\x3c\x0\x3d\x0\x3e\x0\x3f\x0\x40\x0\x41\x0\x42\x0\x43\x0\x44\x0\x45\x0\x46\x0\x47\x0\x48\x0\x49\x0\x4a\x0\x4b\x0\x4c\x0\x4d\x0\x4e\x0\x4f\x0\x50\x0\x51\x0\x52\x0\x53\x0\x54\x0\x55\x0\x56\x0\x57\x0\x58\x0\x59\x0\x5a\x0\x5b\x0\x5c\x0\x5d\x0\x5e\x0\x5f\x0\x60\x0\x61\x0\x62\x0\x63\x0\x64\x0\x65\x0\x66\x0\x67\x0\x68\x0\x69\x0\x6a\x0\x6b\x0\x6c\x0\x6d\x0\x6e\x0\x6f\x0\x70\x0\x71\x0\x72\x0\x73\x0\x74\x0\x75\x0\x76\x0\x77\x0\x78\x0\x79\x0\x7a\x0\x7b\x0\x7c\x0\x7d\x0\x7e\x0\x7f\x0\xac\x20\x0\x0\x1a\x20\x92\x1\x1e\x20\x26\x20\x20\x20\x21\x20\xc6\x2\x30\x20\x60\x1\x39\x20\x52\x1\x0\x0\x0\x0\x0\x0\x0\x0\x18\x20\x19\x20\x1c\x20\x1d\x20\x22\x20\x13\x20\x14\x20\xdc\x2\x22\x21\x61\x1\x3a\x20\x53\x1\x0\x0\x0\x0\x78\x1\xa0\x0\xa1\x0\xa2\x0\xa3\x0\xa4\x0\xa5\x0\xa6\x0\xa7\x0\xa8\x0\xa9\x0\xaa\x0\xab\x0\xac\x0\xad\x0\xae\x0\xaf\x0\xb0\x0\xb1\x0\xb2\x0\xb3\x0\xb4\x0\xb5\x0\xb6\x0\xb7\x0\xb8\x0\xb9\x0\xba\x0\xbb\x0\xbc\x0\xbd\x0\xbe\x0\xbf\x0\xc0\x0\xc1\x0\xc2\x0\xc3\x0\xc4\x0\xc5\x0\xc6\x0\xc7\x0\xc8\x0\xc9\x0\xca\x0\xcb\x0\xcc\x0\xcd\x0\xce\x0\xcf\x0\x1e\x1\xd1\x0\xd2\x0\xd3\x0\xd4\x0\xd5\x0\xd6\x0\xd7\x0\xd8\x0\xd9\x0\xda\x0\xdb\x0\xdc\x0\x30\x1\x5e\x1\xdf\x0\xe0\x0\xe1\x0\xe2\x0\xe3\x0\xe4\x0\xe5\x0\xe6\x0\xe7\x0\xe8\x0\xe9\x0\xea\x0\xeb\x0\xec\x0\xed\x0\xee\x0\xef\x0\x1f\x1\xf1\x0\xf2\x0\xf3\x0\xf4\x0\xf5\x0\xf6\x0\xf7\x0\xf8\x0\xf9\x0\xfa\x0\xfb\x0\xfc\x0\x31\x1\x5f\x1\xff\x0"#
+     , encoderArray = 
+ CompactArray {
+        encoderIndices = ConvArray "\x0\x0\x40\x0\x80\x0\xc0\x0\x0\x1\x40\x1\x80\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\x0\x2\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\x40\x2\xc0\x1\x80\x2\xc0\x1\xc0\x2"#
+        , encoderValues = ConvArray "\x0\x1\x2\x3\x4\x5\x6\x7\x8\x9\xa\xb\xc\xd\xe\xf\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x1a\x1b\x1c\x1d\x1e\x1f\x20\x21\x22\x23\x24\x25\x26\x27\x28\x29\x2a\x2b\x2c\x2d\x2e\x2f\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x3a\x3b\x3c\x3d\x3e\x3f\x40\x41\x42\x43\x44\x45\x46\x47\x48\x49\x4a\x4b\x4c\x4d\x4e\x4f\x50\x51\x52\x53\x54\x55\x56\x57\x58\x59\x5a\x5b\x5c\x5d\x5e\x5f\x60\x61\x62\x63\x64\x65\x66\x67\x68\x69\x6a\x6b\x6c\x6d\x6e\x6f\x70\x71\x72\x73\x74\x75\x76\x77\x78\x79\x7a\x7b\x7c\x7d\x7e\x7f\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xa0\xa1\xa2\xa3\xa4\xa5\xa6\xa7\xa8\xa9\xaa\xab\xac\xad\xae\xaf\xb0\xb1\xb2\xb3\xb4\xb5\xb6\xb7\xb8\xb9\xba\xbb\xbc\xbd\xbe\xbf\xc0\xc1\xc2\xc3\xc4\xc5\xc6\xc7\xc8\xc9\xca\xcb\xcc\xcd\xce\xcf\x0\xd1\xd2\xd3\xd4\xd5\xd6\xd7\xd8\xd9\xda\xdb\xdc\x0\x0\xdf\xe0\xe1\xe2\xe3\xe4\xe5\xe6\xe7\xe8\xe9\xea\xeb\xec\xed\xee\xef\x0\xf1\xf2\xf3\xf4\xf5\xf6\xf7\xf8\xf9\xfa\xfb\xfc\x0\x0\xff\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xd0\xf0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xdd\xfd\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x8c\x9c\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xde\xfe\x8a\x9a\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x9f\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x83\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x88\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x98\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x96\x97\x0\x0\x0\x91\x92\x82\x0\x93\x94\x84\x0\x86\x87\x95\x0\x0\x0\x85\x0\x0\x0\x0\x0\x0\x0\x0\x0\x89\x0\x0\x0\x0\x0\x0\x0\x0\x8b\x9b\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x80\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x99"#
+        , encoderMax = '\8482'
+        }
+
+   }
+    )
+
+    ,
+    (1255, SingleByteCP {
+     decoderArray = ConvArray "\x0\x0\x1\x0\x2\x0\x3\x0\x4\x0\x5\x0\x6\x0\x7\x0\x8\x0\x9\x0\xa\x0\xb\x0\xc\x0\xd\x0\xe\x0\xf\x0\x10\x0\x11\x0\x12\x0\x13\x0\x14\x0\x15\x0\x16\x0\x17\x0\x18\x0\x19\x0\x1a\x0\x1b\x0\x1c\x0\x1d\x0\x1e\x0\x1f\x0\x20\x0\x21\x0\x22\x0\x23\x0\x24\x0\x25\x0\x26\x0\x27\x0\x28\x0\x29\x0\x2a\x0\x2b\x0\x2c\x0\x2d\x0\x2e\x0\x2f\x0\x30\x0\x31\x0\x32\x0\x33\x0\x34\x0\x35\x0\x36\x0\x37\x0\x38\x0\x39\x0\x3a\x0\x3b\x0\x3c\x0\x3d\x0\x3e\x0\x3f\x0\x40\x0\x41\x0\x42\x0\x43\x0\x44\x0\x45\x0\x46\x0\x47\x0\x48\x0\x49\x0\x4a\x0\x4b\x0\x4c\x0\x4d\x0\x4e\x0\x4f\x0\x50\x0\x51\x0\x52\x0\x53\x0\x54\x0\x55\x0\x56\x0\x57\x0\x58\x0\x59\x0\x5a\x0\x5b\x0\x5c\x0\x5d\x0\x5e\x0\x5f\x0\x60\x0\x61\x0\x62\x0\x63\x0\x64\x0\x65\x0\x66\x0\x67\x0\x68\x0\x69\x0\x6a\x0\x6b\x0\x6c\x0\x6d\x0\x6e\x0\x6f\x0\x70\x0\x71\x0\x72\x0\x73\x0\x74\x0\x75\x0\x76\x0\x77\x0\x78\x0\x79\x0\x7a\x0\x7b\x0\x7c\x0\x7d\x0\x7e\x0\x7f\x0\xac\x20\x0\x0\x1a\x20\x92\x1\x1e\x20\x26\x20\x20\x20\x21\x20\xc6\x2\x30\x20\x0\x0\x39\x20\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x18\x20\x19\x20\x1c\x20\x1d\x20\x22\x20\x13\x20\x14\x20\xdc\x2\x22\x21\x0\x0\x3a\x20\x0\x0\x0\x0\x0\x0\x0\x0\xa0\x0\xa1\x0\xa2\x0\xa3\x0\xaa\x20\xa5\x0\xa6\x0\xa7\x0\xa8\x0\xa9\x0\xd7\x0\xab\x0\xac\x0\xad\x0\xae\x0\xaf\x0\xb0\x0\xb1\x0\xb2\x0\xb3\x0\xb4\x0\xb5\x0\xb6\x0\xb7\x0\xb8\x0\xb9\x0\xf7\x0\xbb\x0\xbc\x0\xbd\x0\xbe\x0\xbf\x0\xb0\x5\xb1\x5\xb2\x5\xb3\x5\xb4\x5\xb5\x5\xb6\x5\xb7\x5\xb8\x5\xb9\x5\x0\x0\xbb\x5\xbc\x5\xbd\x5\xbe\x5\xbf\x5\xc0\x5\xc1\x5\xc2\x5\xc3\x5\xf0\x5\xf1\x5\xf2\x5\xf3\x5\xf4\x5\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xd0\x5\xd1\x5\xd2\x5\xd3\x5\xd4\x5\xd5\x5\xd6\x5\xd7\x5\xd8\x5\xd9\x5\xda\x5\xdb\x5\xdc\x5\xdd\x5\xde\x5\xdf\x5\xe0\x5\xe1\x5\xe2\x5\xe3\x5\xe4\x5\xe5\x5\xe6\x5\xe7\x5\xe8\x5\xe9\x5\xea\x5\x0\x0\x0\x0\xe\x20\xf\x20\x0\x0"#
+     , encoderArray = 
+ CompactArray {
+        encoderIndices = ConvArray "\x0\x0\x40\x0\x80\x0\xc0\x0\x0\x1\x0\x1\x40\x1\x0\x1\x0\x1\x0\x1\x0\x1\x80\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\xc0\x1\x0\x2\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x40\x2\x0\x1\x80\x2\x0\x1\xc0\x2"#
+        , encoderValues = ConvArray "\x0\x1\x2\x3\x4\x5\x6\x7\x8\x9\xa\xb\xc\xd\xe\xf\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x1a\x1b\x1c\x1d\x1e\x1f\x20\x21\x22\x23\x24\x25\x26\x27\x28\x29\x2a\x2b\x2c\x2d\x2e\x2f\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x3a\x3b\x3c\x3d\x3e\x3f\x40\x41\x42\x43\x44\x45\x46\x47\x48\x49\x4a\x4b\x4c\x4d\x4e\x4f\x50\x51\x52\x53\x54\x55\x56\x57\x58\x59\x5a\x5b\x5c\x5d\x5e\x5f\x60\x61\x62\x63\x64\x65\x66\x67\x68\x69\x6a\x6b\x6c\x6d\x6e\x6f\x70\x71\x72\x73\x74\x75\x76\x77\x78\x79\x7a\x7b\x7c\x7d\x7e\x7f\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xa0\xa1\xa2\xa3\x0\xa5\xa6\xa7\xa8\xa9\x0\xab\xac\xad\xae\xaf\xb0\xb1\xb2\xb3\xb4\xb5\xb6\xb7\xb8\xb9\x0\xbb\xbc\xbd\xbe\xbf\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xaa\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xba\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x83\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x88\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x98\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xc0\xc1\xc2\xc3\xc4\xc5\xc6\xc7\xc8\xc9\x0\xcb\xcc\xcd\xce\xcf\xd0\xd1\xd2\xd3\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xe0\xe1\xe2\xe3\xe4\xe5\xe6\xe7\xe8\xe9\xea\xeb\xec\xed\xee\xef\xf0\xf1\xf2\xf3\xf4\xf5\xf6\xf7\xf8\xf9\xfa\x0\x0\x0\x0\x0\xd4\xd5\xd6\xd7\xd8\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xfd\xfe\x0\x0\x0\x96\x97\x0\x0\x0\x91\x92\x82\x0\x93\x94\x84\x0\x86\x87\x95\x0\x0\x0\x85\x0\x0\x0\x0\x0\x0\x0\x0\x0\x89\x0\x0\x0\x0\x0\x0\x0\x0\x8b\x9b\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xa4\x0\x80\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x99"#
+        , encoderMax = '\8482'
+        }
+
+   }
+    )
+
+    ,
+    (1256, SingleByteCP {
+     decoderArray = ConvArray "\x0\x0\x1\x0\x2\x0\x3\x0\x4\x0\x5\x0\x6\x0\x7\x0\x8\x0\x9\x0\xa\x0\xb\x0\xc\x0\xd\x0\xe\x0\xf\x0\x10\x0\x11\x0\x12\x0\x13\x0\x14\x0\x15\x0\x16\x0\x17\x0\x18\x0\x19\x0\x1a\x0\x1b\x0\x1c\x0\x1d\x0\x1e\x0\x1f\x0\x20\x0\x21\x0\x22\x0\x23\x0\x24\x0\x25\x0\x26\x0\x27\x0\x28\x0\x29\x0\x2a\x0\x2b\x0\x2c\x0\x2d\x0\x2e\x0\x2f\x0\x30\x0\x31\x0\x32\x0\x33\x0\x34\x0\x35\x0\x36\x0\x37\x0\x38\x0\x39\x0\x3a\x0\x3b\x0\x3c\x0\x3d\x0\x3e\x0\x3f\x0\x40\x0\x41\x0\x42\x0\x43\x0\x44\x0\x45\x0\x46\x0\x47\x0\x48\x0\x49\x0\x4a\x0\x4b\x0\x4c\x0\x4d\x0\x4e\x0\x4f\x0\x50\x0\x51\x0\x52\x0\x53\x0\x54\x0\x55\x0\x56\x0\x57\x0\x58\x0\x59\x0\x5a\x0\x5b\x0\x5c\x0\x5d\x0\x5e\x0\x5f\x0\x60\x0\x61\x0\x62\x0\x63\x0\x64\x0\x65\x0\x66\x0\x67\x0\x68\x0\x69\x0\x6a\x0\x6b\x0\x6c\x0\x6d\x0\x6e\x0\x6f\x0\x70\x0\x71\x0\x72\x0\x73\x0\x74\x0\x75\x0\x76\x0\x77\x0\x78\x0\x79\x0\x7a\x0\x7b\x0\x7c\x0\x7d\x0\x7e\x0\x7f\x0\xac\x20\x7e\x6\x1a\x20\x92\x1\x1e\x20\x26\x20\x20\x20\x21\x20\xc6\x2\x30\x20\x79\x6\x39\x20\x52\x1\x86\x6\x98\x6\x88\x6\xaf\x6\x18\x20\x19\x20\x1c\x20\x1d\x20\x22\x20\x13\x20\x14\x20\xa9\x6\x22\x21\x91\x6\x3a\x20\x53\x1\xc\x20\xd\x20\xba\x6\xa0\x0\xc\x6\xa2\x0\xa3\x0\xa4\x0\xa5\x0\xa6\x0\xa7\x0\xa8\x0\xa9\x0\xbe\x6\xab\x0\xac\x0\xad\x0\xae\x0\xaf\x0\xb0\x0\xb1\x0\xb2\x0\xb3\x0\xb4\x0\xb5\x0\xb6\x0\xb7\x0\xb8\x0\xb9\x0\x1b\x6\xbb\x0\xbc\x0\xbd\x0\xbe\x0\x1f\x6\xc1\x6\x21\x6\x22\x6\x23\x6\x24\x6\x25\x6\x26\x6\x27\x6\x28\x6\x29\x6\x2a\x6\x2b\x6\x2c\x6\x2d\x6\x2e\x6\x2f\x6\x30\x6\x31\x6\x32\x6\x33\x6\x34\x6\x35\x6\x36\x6\xd7\x0\x37\x6\x38\x6\x39\x6\x3a\x6\x40\x6\x41\x6\x42\x6\x43\x6\xe0\x0\x44\x6\xe2\x0\x45\x6\x46\x6\x47\x6\x48\x6\xe7\x0\xe8\x0\xe9\x0\xea\x0\xeb\x0\x49\x6\x4a\x6\xee\x0\xef\x0\x4b\x6\x4c\x6\x4d\x6\x4e\x6\xf4\x0\x4f\x6\x50\x6\xf7\x0\x51\x6\xf9\x0\x52\x6\xfb\x0\xfc\x0\xe\x20\xf\x20\xd2\x6"#
+     , encoderArray = 
+ CompactArray {
+        encoderIndices = ConvArray "\x0\x0\x40\x0\x80\x0\xc0\x0\x0\x1\x40\x1\x80\x1\x0\x1\x0\x1\x0\x1\x0\x1\xc0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x2\x40\x2\x80\x2\xc0\x2\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x3\x0\x1\x40\x3\x0\x1\x80\x3"#
+        , encoderValues = ConvArray "\x0\x1\x2\x3\x4\x5\x6\x7\x8\x9\xa\xb\xc\xd\xe\xf\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x1a\x1b\x1c\x1d\x1e\x1f\x20\x21\x22\x23\x24\x25\x26\x27\x28\x29\x2a\x2b\x2c\x2d\x2e\x2f\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x3a\x3b\x3c\x3d\x3e\x3f\x40\x41\x42\x43\x44\x45\x46\x47\x48\x49\x4a\x4b\x4c\x4d\x4e\x4f\x50\x51\x52\x53\x54\x55\x56\x57\x58\x59\x5a\x5b\x5c\x5d\x5e\x5f\x60\x61\x62\x63\x64\x65\x66\x67\x68\x69\x6a\x6b\x6c\x6d\x6e\x6f\x70\x71\x72\x73\x74\x75\x76\x77\x78\x79\x7a\x7b\x7c\x7d\x7e\x7f\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xa0\x0\xa2\xa3\xa4\xa5\xa6\xa7\xa8\xa9\x0\xab\xac\xad\xae\xaf\xb0\xb1\xb2\xb3\xb4\xb5\xb6\xb7\xb8\xb9\x0\xbb\xbc\xbd\xbe\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xd7\x0\x0\x0\x0\x0\x0\x0\x0\xe0\x0\xe2\x0\x0\x0\x0\xe7\xe8\xe9\xea\xeb\x0\x0\xee\xef\x0\x0\x0\x0\xf4\x0\x0\xf7\x0\xf9\x0\xfb\xfc\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x8c\x9c\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x83\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x88\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xa1\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xba\x0\x0\x0\xbf\x0\xc1\xc2\xc3\xc4\xc5\xc6\xc7\xc8\xc9\xca\xcb\xcc\xcd\xce\xcf\xd0\xd1\xd2\xd3\xd4\xd5\xd6\xd8\xd9\xda\xdb\x0\x0\x0\x0\x0\xdc\xdd\xde\xdf\xe1\xe3\xe4\xe5\xe6\xec\xed\xf0\xf1\xf2\xf3\xf5\xf6\xf8\xfa\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x8a\x0\x0\x0\x0\x81\x0\x0\x0\x0\x0\x0\x0\x8d\x0\x8f\x0\x0\x0\x0\x0\x0\x0\x0\x9a\x0\x0\x0\x0\x0\x0\x8e\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x98\x0\x0\x0\x0\x0\x90\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x9f\x0\x0\x0\xaa\x0\x0\xc0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xff\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x9d\x9e\xfd\xfe\x0\x0\x0\x96\x97\x0\x0\x0\x91\x92\x82\x0\x93\x94\x84\x0\x86\x87\x95\x0\x0\x0\x85\x0\x0\x0\x0\x0\x0\x0\x0\x0\x89\x0\x0\x0\x0\x0\x0\x0\x0\x8b\x9b\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x80\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x99"#
+        , encoderMax = '\8482'
+        }
+
+   }
+    )
+
+    ,
+    (1257, SingleByteCP {
+     decoderArray = ConvArray "\x0\x0\x1\x0\x2\x0\x3\x0\x4\x0\x5\x0\x6\x0\x7\x0\x8\x0\x9\x0\xa\x0\xb\x0\xc\x0\xd\x0\xe\x0\xf\x0\x10\x0\x11\x0\x12\x0\x13\x0\x14\x0\x15\x0\x16\x0\x17\x0\x18\x0\x19\x0\x1a\x0\x1b\x0\x1c\x0\x1d\x0\x1e\x0\x1f\x0\x20\x0\x21\x0\x22\x0\x23\x0\x24\x0\x25\x0\x26\x0\x27\x0\x28\x0\x29\x0\x2a\x0\x2b\x0\x2c\x0\x2d\x0\x2e\x0\x2f\x0\x30\x0\x31\x0\x32\x0\x33\x0\x34\x0\x35\x0\x36\x0\x37\x0\x38\x0\x39\x0\x3a\x0\x3b\x0\x3c\x0\x3d\x0\x3e\x0\x3f\x0\x40\x0\x41\x0\x42\x0\x43\x0\x44\x0\x45\x0\x46\x0\x47\x0\x48\x0\x49\x0\x4a\x0\x4b\x0\x4c\x0\x4d\x0\x4e\x0\x4f\x0\x50\x0\x51\x0\x52\x0\x53\x0\x54\x0\x55\x0\x56\x0\x57\x0\x58\x0\x59\x0\x5a\x0\x5b\x0\x5c\x0\x5d\x0\x5e\x0\x5f\x0\x60\x0\x61\x0\x62\x0\x63\x0\x64\x0\x65\x0\x66\x0\x67\x0\x68\x0\x69\x0\x6a\x0\x6b\x0\x6c\x0\x6d\x0\x6e\x0\x6f\x0\x70\x0\x71\x0\x72\x0\x73\x0\x74\x0\x75\x0\x76\x0\x77\x0\x78\x0\x79\x0\x7a\x0\x7b\x0\x7c\x0\x7d\x0\x7e\x0\x7f\x0\xac\x20\x0\x0\x1a\x20\x0\x0\x1e\x20\x26\x20\x20\x20\x21\x20\x0\x0\x30\x20\x0\x0\x39\x20\x0\x0\xa8\x0\xc7\x2\xb8\x0\x0\x0\x18\x20\x19\x20\x1c\x20\x1d\x20\x22\x20\x13\x20\x14\x20\x0\x0\x22\x21\x0\x0\x3a\x20\x0\x0\xaf\x0\xdb\x2\x0\x0\xa0\x0\x0\x0\xa2\x0\xa3\x0\xa4\x0\x0\x0\xa6\x0\xa7\x0\xd8\x0\xa9\x0\x56\x1\xab\x0\xac\x0\xad\x0\xae\x0\xc6\x0\xb0\x0\xb1\x0\xb2\x0\xb3\x0\xb4\x0\xb5\x0\xb6\x0\xb7\x0\xf8\x0\xb9\x0\x57\x1\xbb\x0\xbc\x0\xbd\x0\xbe\x0\xe6\x0\x4\x1\x2e\x1\x0\x1\x6\x1\xc4\x0\xc5\x0\x18\x1\x12\x1\xc\x1\xc9\x0\x79\x1\x16\x1\x22\x1\x36\x1\x2a\x1\x3b\x1\x60\x1\x43\x1\x45\x1\xd3\x0\x4c\x1\xd5\x0\xd6\x0\xd7\x0\x72\x1\x41\x1\x5a\x1\x6a\x1\xdc\x0\x7b\x1\x7d\x1\xdf\x0\x5\x1\x2f\x1\x1\x1\x7\x1\xe4\x0\xe5\x0\x19\x1\x13\x1\xd\x1\xe9\x0\x7a\x1\x17\x1\x23\x1\x37\x1\x2b\x1\x3c\x1\x61\x1\x44\x1\x46\x1\xf3\x0\x4d\x1\xf5\x0\xf6\x0\xf7\x0\x73\x1\x42\x1\x5b\x1\x6b\x1\xfc\x0\x7c\x1\x7e\x1\xd9\x2"#
+     , encoderArray = 
+ CompactArray {
+        encoderIndices = ConvArray "\x0\x0\x40\x0\x80\x0\xc0\x0\x0\x1\x40\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\xc0\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x0\x2\x80\x1\x40\x2\x80\x1\x80\x2"#
+        , encoderValues = ConvArray "\x0\x1\x2\x3\x4\x5\x6\x7\x8\x9\xa\xb\xc\xd\xe\xf\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x1a\x1b\x1c\x1d\x1e\x1f\x20\x21\x22\x23\x24\x25\x26\x27\x28\x29\x2a\x2b\x2c\x2d\x2e\x2f\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x3a\x3b\x3c\x3d\x3e\x3f\x40\x41\x42\x43\x44\x45\x46\x47\x48\x49\x4a\x4b\x4c\x4d\x4e\x4f\x50\x51\x52\x53\x54\x55\x56\x57\x58\x59\x5a\x5b\x5c\x5d\x5e\x5f\x60\x61\x62\x63\x64\x65\x66\x67\x68\x69\x6a\x6b\x6c\x6d\x6e\x6f\x70\x71\x72\x73\x74\x75\x76\x77\x78\x79\x7a\x7b\x7c\x7d\x7e\x7f\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xa0\x0\xa2\xa3\xa4\x0\xa6\xa7\x8d\xa9\x0\xab\xac\xad\xae\x9d\xb0\xb1\xb2\xb3\xb4\xb5\xb6\xb7\x8f\xb9\x0\xbb\xbc\xbd\xbe\x0\x0\x0\x0\x0\xc4\xc5\xaf\x0\x0\xc9\x0\x0\x0\x0\x0\x0\x0\x0\x0\xd3\x0\xd5\xd6\xd7\xa8\x0\x0\x0\xdc\x0\x0\xdf\x0\x0\x0\x0\xe4\xe5\xbf\x0\x0\xe9\x0\x0\x0\x0\x0\x0\x0\x0\x0\xf3\x0\xf5\xf6\xf7\xb8\x0\x0\x0\xfc\x0\x0\x0\xc2\xe2\x0\x0\xc0\xe0\xc3\xe3\x0\x0\x0\x0\xc8\xe8\x0\x0\x0\x0\xc7\xe7\x0\x0\xcb\xeb\xc6\xe6\x0\x0\x0\x0\x0\x0\x0\x0\xcc\xec\x0\x0\x0\x0\x0\x0\xce\xee\x0\x0\xc1\xe1\x0\x0\x0\x0\x0\x0\xcd\xed\x0\x0\x0\xcf\xef\x0\x0\x0\x0\xd9\xf9\xd1\xf1\xd2\xf2\x0\x0\x0\x0\x0\xd4\xf4\x0\x0\x0\x0\x0\x0\x0\x0\xaa\xba\x0\x0\xda\xfa\x0\x0\x0\x0\xd0\xf0\x0\x0\x0\x0\x0\x0\x0\x0\xdb\xfb\x0\x0\x0\x0\x0\x0\xd8\xf8\x0\x0\x0\x0\x0\xca\xea\xdd\xfd\xde\xfe\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x8e\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xff\x0\x9e\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x96\x97\x0\x0\x0\x91\x92\x82\x0\x93\x94\x84\x0\x86\x87\x95\x0\x0\x0\x85\x0\x0\x0\x0\x0\x0\x0\x0\x0\x89\x0\x0\x0\x0\x0\x0\x0\x0\x8b\x9b\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x80\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x99"#
+        , encoderMax = '\8482'
+        }
+
+   }
+    )
+
+    ,
+    (1258, SingleByteCP {
+     decoderArray = ConvArray "\x0\x0\x1\x0\x2\x0\x3\x0\x4\x0\x5\x0\x6\x0\x7\x0\x8\x0\x9\x0\xa\x0\xb\x0\xc\x0\xd\x0\xe\x0\xf\x0\x10\x0\x11\x0\x12\x0\x13\x0\x14\x0\x15\x0\x16\x0\x17\x0\x18\x0\x19\x0\x1a\x0\x1b\x0\x1c\x0\x1d\x0\x1e\x0\x1f\x0\x20\x0\x21\x0\x22\x0\x23\x0\x24\x0\x25\x0\x26\x0\x27\x0\x28\x0\x29\x0\x2a\x0\x2b\x0\x2c\x0\x2d\x0\x2e\x0\x2f\x0\x30\x0\x31\x0\x32\x0\x33\x0\x34\x0\x35\x0\x36\x0\x37\x0\x38\x0\x39\x0\x3a\x0\x3b\x0\x3c\x0\x3d\x0\x3e\x0\x3f\x0\x40\x0\x41\x0\x42\x0\x43\x0\x44\x0\x45\x0\x46\x0\x47\x0\x48\x0\x49\x0\x4a\x0\x4b\x0\x4c\x0\x4d\x0\x4e\x0\x4f\x0\x50\x0\x51\x0\x52\x0\x53\x0\x54\x0\x55\x0\x56\x0\x57\x0\x58\x0\x59\x0\x5a\x0\x5b\x0\x5c\x0\x5d\x0\x5e\x0\x5f\x0\x60\x0\x61\x0\x62\x0\x63\x0\x64\x0\x65\x0\x66\x0\x67\x0\x68\x0\x69\x0\x6a\x0\x6b\x0\x6c\x0\x6d\x0\x6e\x0\x6f\x0\x70\x0\x71\x0\x72\x0\x73\x0\x74\x0\x75\x0\x76\x0\x77\x0\x78\x0\x79\x0\x7a\x0\x7b\x0\x7c\x0\x7d\x0\x7e\x0\x7f\x0\xac\x20\x0\x0\x1a\x20\x92\x1\x1e\x20\x26\x20\x20\x20\x21\x20\xc6\x2\x30\x20\x0\x0\x39\x20\x52\x1\x0\x0\x0\x0\x0\x0\x0\x0\x18\x20\x19\x20\x1c\x20\x1d\x20\x22\x20\x13\x20\x14\x20\xdc\x2\x22\x21\x0\x0\x3a\x20\x53\x1\x0\x0\x0\x0\x78\x1\xa0\x0\xa1\x0\xa2\x0\xa3\x0\xa4\x0\xa5\x0\xa6\x0\xa7\x0\xa8\x0\xa9\x0\xaa\x0\xab\x0\xac\x0\xad\x0\xae\x0\xaf\x0\xb0\x0\xb1\x0\xb2\x0\xb3\x0\xb4\x0\xb5\x0\xb6\x0\xb7\x0\xb8\x0\xb9\x0\xba\x0\xbb\x0\xbc\x0\xbd\x0\xbe\x0\xbf\x0\xc0\x0\xc1\x0\xc2\x0\x2\x1\xc4\x0\xc5\x0\xc6\x0\xc7\x0\xc8\x0\xc9\x0\xca\x0\xcb\x0\x0\x3\xcd\x0\xce\x0\xcf\x0\x10\x1\xd1\x0\x9\x3\xd3\x0\xd4\x0\xa0\x1\xd6\x0\xd7\x0\xd8\x0\xd9\x0\xda\x0\xdb\x0\xdc\x0\xaf\x1\x3\x3\xdf\x0\xe0\x0\xe1\x0\xe2\x0\x3\x1\xe4\x0\xe5\x0\xe6\x0\xe7\x0\xe8\x0\xe9\x0\xea\x0\xeb\x0\x1\x3\xed\x0\xee\x0\xef\x0\x11\x1\xf1\x0\x23\x3\xf3\x0\xf4\x0\xa1\x1\xf6\x0\xf7\x0\xf8\x0\xf9\x0\xfa\x0\xfb\x0\xfc\x0\xb0\x1\xab\x20\xff\x0"#
+     , encoderArray = 
+ CompactArray {
+        encoderIndices = ConvArray "\x0\x0\x40\x0\x80\x0\xc0\x0\x0\x1\x40\x1\x80\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\x0\x2\x40\x2\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\xc0\x1\x80\x2\xc0\x1\xc0\x2\xc0\x1\x0\x3"#
+        , encoderValues = ConvArray "\x0\x1\x2\x3\x4\x5\x6\x7\x8\x9\xa\xb\xc\xd\xe\xf\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x1a\x1b\x1c\x1d\x1e\x1f\x20\x21\x22\x23\x24\x25\x26\x27\x28\x29\x2a\x2b\x2c\x2d\x2e\x2f\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x3a\x3b\x3c\x3d\x3e\x3f\x40\x41\x42\x43\x44\x45\x46\x47\x48\x49\x4a\x4b\x4c\x4d\x4e\x4f\x50\x51\x52\x53\x54\x55\x56\x57\x58\x59\x5a\x5b\x5c\x5d\x5e\x5f\x60\x61\x62\x63\x64\x65\x66\x67\x68\x69\x6a\x6b\x6c\x6d\x6e\x6f\x70\x71\x72\x73\x74\x75\x76\x77\x78\x79\x7a\x7b\x7c\x7d\x7e\x7f\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xa0\xa1\xa2\xa3\xa4\xa5\xa6\xa7\xa8\xa9\xaa\xab\xac\xad\xae\xaf\xb0\xb1\xb2\xb3\xb4\xb5\xb6\xb7\xb8\xb9\xba\xbb\xbc\xbd\xbe\xbf\xc0\xc1\xc2\x0\xc4\xc5\xc6\xc7\xc8\xc9\xca\xcb\x0\xcd\xce\xcf\x0\xd1\x0\xd3\xd4\x0\xd6\xd7\xd8\xd9\xda\xdb\xdc\x0\x0\xdf\xe0\xe1\xe2\x0\xe4\xe5\xe6\xe7\xe8\xe9\xea\xeb\x0\xed\xee\xef\x0\xf1\x0\xf3\xf4\x0\xf6\xf7\xf8\xf9\xfa\xfb\xfc\x0\x0\xff\x0\x0\xc3\xe3\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xd0\xf0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x8c\x9c\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x9f\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x83\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xd5\xf5\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xdd\xfd\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x88\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x98\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xcc\xec\x0\xde\x0\x0\x0\x0\x0\xd2\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xf2\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x96\x97\x0\x0\x0\x91\x92\x82\x0\x93\x94\x84\x0\x86\x87\x95\x0\x0\x0\x85\x0\x0\x0\x0\x0\x0\x0\x0\x0\x89\x0\x0\x0\x0\x0\x0\x0\x0\x8b\x9b\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xfe\x80\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x99"#
+        , encoderMax = '\8482'
+        }
+
+   }
+    )
+
+    ,
+    (437, SingleByteCP {
+     decoderArray = ConvArray "\x0\x0\x1\x0\x2\x0\x3\x0\x4\x0\x5\x0\x6\x0\x7\x0\x8\x0\x9\x0\xa\x0\xb\x0\xc\x0\xd\x0\xe\x0\xf\x0\x10\x0\x11\x0\x12\x0\x13\x0\x14\x0\x15\x0\x16\x0\x17\x0\x18\x0\x19\x0\x1a\x0\x1b\x0\x1c\x0\x1d\x0\x1e\x0\x1f\x0\x20\x0\x21\x0\x22\x0\x23\x0\x24\x0\x25\x0\x26\x0\x27\x0\x28\x0\x29\x0\x2a\x0\x2b\x0\x2c\x0\x2d\x0\x2e\x0\x2f\x0\x30\x0\x31\x0\x32\x0\x33\x0\x34\x0\x35\x0\x36\x0\x37\x0\x38\x0\x39\x0\x3a\x0\x3b\x0\x3c\x0\x3d\x0\x3e\x0\x3f\x0\x40\x0\x41\x0\x42\x0\x43\x0\x44\x0\x45\x0\x46\x0\x47\x0\x48\x0\x49\x0\x4a\x0\x4b\x0\x4c\x0\x4d\x0\x4e\x0\x4f\x0\x50\x0\x51\x0\x52\x0\x53\x0\x54\x0\x55\x0\x56\x0\x57\x0\x58\x0\x59\x0\x5a\x0\x5b\x0\x5c\x0\x5d\x0\x5e\x0\x5f\x0\x60\x0\x61\x0\x62\x0\x63\x0\x64\x0\x65\x0\x66\x0\x67\x0\x68\x0\x69\x0\x6a\x0\x6b\x0\x6c\x0\x6d\x0\x6e\x0\x6f\x0\x70\x0\x71\x0\x72\x0\x73\x0\x74\x0\x75\x0\x76\x0\x77\x0\x78\x0\x79\x0\x7a\x0\x7b\x0\x7c\x0\x7d\x0\x7e\x0\x7f\x0\xc7\x0\xfc\x0\xe9\x0\xe2\x0\xe4\x0\xe0\x0\xe5\x0\xe7\x0\xea\x0\xeb\x0\xe8\x0\xef\x0\xee\x0\xec\x0\xc4\x0\xc5\x0\xc9\x0\xe6\x0\xc6\x0\xf4\x0\xf6\x0\xf2\x0\xfb\x0\xf9\x0\xff\x0\xd6\x0\xdc\x0\xa2\x0\xa3\x0\xa5\x0\xa7\x20\x92\x1\xe1\x0\xed\x0\xf3\x0\xfa\x0\xf1\x0\xd1\x0\xaa\x0\xba\x0\xbf\x0\x10\x23\xac\x0\xbd\x0\xbc\x0\xa1\x0\xab\x0\xbb\x0\x91\x25\x92\x25\x93\x25\x2\x25\x24\x25\x61\x25\x62\x25\x56\x25\x55\x25\x63\x25\x51\x25\x57\x25\x5d\x25\x5c\x25\x5b\x25\x10\x25\x14\x25\x34\x25\x2c\x25\x1c\x25\x0\x25\x3c\x25\x5e\x25\x5f\x25\x5a\x25\x54\x25\x69\x25\x66\x25\x60\x25\x50\x25\x6c\x25\x67\x25\x68\x25\x64\x25\x65\x25\x59\x25\x58\x25\x52\x25\x53\x25\x6b\x25\x6a\x25\x18\x25\xc\x25\x88\x25\x84\x25\x8c\x25\x90\x25\x80\x25\xb1\x3\xdf\x0\x93\x3\xc0\x3\xa3\x3\xc3\x3\xb5\x0\xc4\x3\xa6\x3\x98\x3\xa9\x3\xb4\x3\x1e\x22\xc6\x3\xb5\x3\x29\x22\x61\x22\xb1\x0\x65\x22\x64\x22\x20\x23\x21\x23\xf7\x0\x48\x22\xb0\x0\x19\x22\xb7\x0\x1a\x22\x7f\x20\xb2\x0\xa0\x25\xa0\x0"#
+     , encoderArray = 
+ CompactArray {
+        encoderIndices = ConvArray "\x0\x0\x40\x0\x80\x0\xc0\x0\x0\x1\x0\x1\x40\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x80\x1\xc0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x2\x40\x2\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x80\x2\xc0\x2\x0\x1\x0\x1\x0\x3\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x40\x3\x80\x3\xc0\x3"#
+        , encoderValues = ConvArray "\x0\x1\x2\x3\x4\x5\x6\x7\x8\x9\xa\xb\xc\xd\xe\xf\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x1a\x1b\x1c\x1d\x1e\x1f\x20\x21\x22\x23\x24\x25\x26\x27\x28\x29\x2a\x2b\x2c\x2d\x2e\x2f\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x3a\x3b\x3c\x3d\x3e\x3f\x40\x41\x42\x43\x44\x45\x46\x47\x48\x49\x4a\x4b\x4c\x4d\x4e\x4f\x50\x51\x52\x53\x54\x55\x56\x57\x58\x59\x5a\x5b\x5c\x5d\x5e\x5f\x60\x61\x62\x63\x64\x65\x66\x67\x68\x69\x6a\x6b\x6c\x6d\x6e\x6f\x70\x71\x72\x73\x74\x75\x76\x77\x78\x79\x7a\x7b\x7c\x7d\x7e\x7f\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xff\xad\x9b\x9c\x0\x9d\x0\x0\x0\x0\xa6\xae\xaa\x0\x0\x0\xf8\xf1\xfd\x0\x0\xe6\x0\xfa\x0\x0\xa7\xaf\xac\xab\x0\xa8\x0\x0\x0\x0\x8e\x8f\x92\x80\x0\x90\x0\x0\x0\x0\x0\x0\x0\xa5\x0\x0\x0\x0\x99\x0\x0\x0\x0\x0\x9a\x0\x0\xe1\x85\xa0\x83\x0\x84\x86\x91\x87\x8a\x82\x88\x89\x8d\xa1\x8c\x8b\x0\xa4\x95\xa2\x93\x0\x94\xf6\x0\x97\xa3\x96\x81\x0\x0\x98\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x9f\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xe2\x0\x0\x0\x0\xe9\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xe4\x0\x0\xe8\x0\x0\xea\x0\x0\x0\x0\x0\x0\x0\xe0\x0\x0\xeb\xee\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xe3\x0\x0\xe5\xe7\x0\xed\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xfc\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x9e\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xf9\xfb\x0\x0\x0\xec\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xef\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xf7\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xf0\x0\x0\xf3\xf2\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xa9\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xf4\xf5\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xc4\x0\xb3\x0\x0\x0\x0\x0\x0\x0\x0\x0\xda\x0\x0\x0\xbf\x0\x0\x0\xc0\x0\x0\x0\xd9\x0\x0\x0\xc3\x0\x0\x0\x0\x0\x0\x0\xb4\x0\x0\x0\x0\x0\x0\x0\xc2\x0\x0\x0\x0\x0\x0\x0\xc1\x0\x0\x0\x0\x0\x0\x0\xc5\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xcd\xba\xd5\xd6\xc9\xb8\xb7\xbb\xd4\xd3\xc8\xbe\xbd\xbc\xc6\xc7\xcc\xb5\xb6\xb9\xd1\xd2\xcb\xcf\xd0\xca\xd8\xd7\xce\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xdf\x0\x0\x0\xdc\x0\x0\x0\xdb\x0\x0\x0\xdd\x0\x0\x0\xde\xb0\xb1\xb2\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xfe"#
+        , encoderMax = '\9632'
+        }
+
+   }
+    )
+
+    ,
+    (500, SingleByteCP {
+     decoderArray = ConvArray "\x0\x0\x1\x0\x2\x0\x3\x0\x9c\x0\x9\x0\x86\x0\x7f\x0\x97\x0\x8d\x0\x8e\x0\xb\x0\xc\x0\xd\x0\xe\x0\xf\x0\x10\x0\x11\x0\x12\x0\x13\x0\x9d\x0\x85\x0\x8\x0\x87\x0\x18\x0\x19\x0\x92\x0\x8f\x0\x1c\x0\x1d\x0\x1e\x0\x1f\x0\x80\x0\x81\x0\x82\x0\x83\x0\x84\x0\xa\x0\x17\x0\x1b\x0\x88\x0\x89\x0\x8a\x0\x8b\x0\x8c\x0\x5\x0\x6\x0\x7\x0\x90\x0\x91\x0\x16\x0\x93\x0\x94\x0\x95\x0\x96\x0\x4\x0\x98\x0\x99\x0\x9a\x0\x9b\x0\x14\x0\x15\x0\x9e\x0\x1a\x0\x20\x0\xa0\x0\xe2\x0\xe4\x0\xe0\x0\xe1\x0\xe3\x0\xe5\x0\xe7\x0\xf1\x0\x5b\x0\x2e\x0\x3c\x0\x28\x0\x2b\x0\x21\x0\x26\x0\xe9\x0\xea\x0\xeb\x0\xe8\x0\xed\x0\xee\x0\xef\x0\xec\x0\xdf\x0\x5d\x0\x24\x0\x2a\x0\x29\x0\x3b\x0\x5e\x0\x2d\x0\x2f\x0\xc2\x0\xc4\x0\xc0\x0\xc1\x0\xc3\x0\xc5\x0\xc7\x0\xd1\x0\xa6\x0\x2c\x0\x25\x0\x5f\x0\x3e\x0\x3f\x0\xf8\x0\xc9\x0\xca\x0\xcb\x0\xc8\x0\xcd\x0\xce\x0\xcf\x0\xcc\x0\x60\x0\x3a\x0\x23\x0\x40\x0\x27\x0\x3d\x0\x22\x0\xd8\x0\x61\x0\x62\x0\x63\x0\x64\x0\x65\x0\x66\x0\x67\x0\x68\x0\x69\x0\xab\x0\xbb\x0\xf0\x0\xfd\x0\xfe\x0\xb1\x0\xb0\x0\x6a\x0\x6b\x0\x6c\x0\x6d\x0\x6e\x0\x6f\x0\x70\x0\x71\x0\x72\x0\xaa\x0\xba\x0\xe6\x0\xb8\x0\xc6\x0\xa4\x0\xb5\x0\x7e\x0\x73\x0\x74\x0\x75\x0\x76\x0\x77\x0\x78\x0\x79\x0\x7a\x0\xa1\x0\xbf\x0\xd0\x0\xdd\x0\xde\x0\xae\x0\xa2\x0\xa3\x0\xa5\x0\xb7\x0\xa9\x0\xa7\x0\xb6\x0\xbc\x0\xbd\x0\xbe\x0\xac\x0\x7c\x0\xaf\x0\xa8\x0\xb4\x0\xd7\x0\x7b\x0\x41\x0\x42\x0\x43\x0\x44\x0\x45\x0\x46\x0\x47\x0\x48\x0\x49\x0\xad\x0\xf4\x0\xf6\x0\xf2\x0\xf3\x0\xf5\x0\x7d\x0\x4a\x0\x4b\x0\x4c\x0\x4d\x0\x4e\x0\x4f\x0\x50\x0\x51\x0\x52\x0\xb9\x0\xfb\x0\xfc\x0\xf9\x0\xfa\x0\xff\x0\x5c\x0\xf7\x0\x53\x0\x54\x0\x55\x0\x56\x0\x57\x0\x58\x0\x59\x0\x5a\x0\xb2\x0\xd4\x0\xd6\x0\xd2\x0\xd3\x0\xd5\x0\x30\x0\x31\x0\x32\x0\x33\x0\x34\x0\x35\x0\x36\x0\x37\x0\x38\x0\x39\x0\xb3\x0\xdb\x0\xdc\x0\xd9\x0\xda\x0\x9f\x0"#
+     , encoderArray = 
+ CompactArray {
+        encoderIndices = ConvArray "\x0\x0\x40\x0\x80\x0\xc0\x0"#
+        , encoderValues = ConvArray "\x0\x1\x2\x3\x37\x2d\x2e\x2f\x16\x5\x25\xb\xc\xd\xe\xf\x10\x11\x12\x13\x3c\x3d\x32\x26\x18\x19\x3f\x27\x1c\x1d\x1e\x1f\x40\x4f\x7f\x7b\x5b\x6c\x50\x7d\x4d\x5d\x5c\x4e\x6b\x60\x4b\x61\xf0\xf1\xf2\xf3\xf4\xf5\xf6\xf7\xf8\xf9\x7a\x5e\x4c\x7e\x6e\x6f\x7c\xc1\xc2\xc3\xc4\xc5\xc6\xc7\xc8\xc9\xd1\xd2\xd3\xd4\xd5\xd6\xd7\xd8\xd9\xe2\xe3\xe4\xe5\xe6\xe7\xe8\xe9\x4a\xe0\x5a\x5f\x6d\x79\x81\x82\x83\x84\x85\x86\x87\x88\x89\x91\x92\x93\x94\x95\x96\x97\x98\x99\xa2\xa3\xa4\xa5\xa6\xa7\xa8\xa9\xc0\xbb\xd0\xa1\x7\x20\x21\x22\x23\x24\x15\x6\x17\x28\x29\x2a\x2b\x2c\x9\xa\x1b\x30\x31\x1a\x33\x34\x35\x36\x8\x38\x39\x3a\x3b\x4\x14\x3e\xff\x41\xaa\xb0\xb1\x9f\xb2\x6a\xb5\xbd\xb4\x9a\x8a\xba\xca\xaf\xbc\x90\x8f\xea\xfa\xbe\xa0\xb6\xb3\x9d\xda\x9b\x8b\xb7\xb8\xb9\xab\x64\x65\x62\x66\x63\x67\x9e\x68\x74\x71\x72\x73\x78\x75\x76\x77\xac\x69\xed\xee\xeb\xef\xec\xbf\x80\xfd\xfe\xfb\xfc\xad\xae\x59\x44\x45\x42\x46\x43\x47\x9c\x48\x54\x51\x52\x53\x58\x55\x56\x57\x8c\x49\xcd\xce\xcb\xcf\xcc\xe1\x70\xdd\xde\xdb\xdc\x8d\x8e\xdf"#
+        , encoderMax = '\255'
+        }
+
+   }
+    )
+
+    ,
+    (737, SingleByteCP {
+     decoderArray = ConvArray "\x0\x0\x1\x0\x2\x0\x3\x0\x4\x0\x5\x0\x6\x0\x7\x0\x8\x0\x9\x0\xa\x0\xb\x0\xc\x0\xd\x0\xe\x0\xf\x0\x10\x0\x11\x0\x12\x0\x13\x0\x14\x0\x15\x0\x16\x0\x17\x0\x18\x0\x19\x0\x1a\x0\x1b\x0\x1c\x0\x1d\x0\x1e\x0\x1f\x0\x20\x0\x21\x0\x22\x0\x23\x0\x24\x0\x25\x0\x26\x0\x27\x0\x28\x0\x29\x0\x2a\x0\x2b\x0\x2c\x0\x2d\x0\x2e\x0\x2f\x0\x30\x0\x31\x0\x32\x0\x33\x0\x34\x0\x35\x0\x36\x0\x37\x0\x38\x0\x39\x0\x3a\x0\x3b\x0\x3c\x0\x3d\x0\x3e\x0\x3f\x0\x40\x0\x41\x0\x42\x0\x43\x0\x44\x0\x45\x0\x46\x0\x47\x0\x48\x0\x49\x0\x4a\x0\x4b\x0\x4c\x0\x4d\x0\x4e\x0\x4f\x0\x50\x0\x51\x0\x52\x0\x53\x0\x54\x0\x55\x0\x56\x0\x57\x0\x58\x0\x59\x0\x5a\x0\x5b\x0\x5c\x0\x5d\x0\x5e\x0\x5f\x0\x60\x0\x61\x0\x62\x0\x63\x0\x64\x0\x65\x0\x66\x0\x67\x0\x68\x0\x69\x0\x6a\x0\x6b\x0\x6c\x0\x6d\x0\x6e\x0\x6f\x0\x70\x0\x71\x0\x72\x0\x73\x0\x74\x0\x75\x0\x76\x0\x77\x0\x78\x0\x79\x0\x7a\x0\x7b\x0\x7c\x0\x7d\x0\x7e\x0\x7f\x0\x91\x3\x92\x3\x93\x3\x94\x3\x95\x3\x96\x3\x97\x3\x98\x3\x99\x3\x9a\x3\x9b\x3\x9c\x3\x9d\x3\x9e\x3\x9f\x3\xa0\x3\xa1\x3\xa3\x3\xa4\x3\xa5\x3\xa6\x3\xa7\x3\xa8\x3\xa9\x3\xb1\x3\xb2\x3\xb3\x3\xb4\x3\xb5\x3\xb6\x3\xb7\x3\xb8\x3\xb9\x3\xba\x3\xbb\x3\xbc\x3\xbd\x3\xbe\x3\xbf\x3\xc0\x3\xc1\x3\xc3\x3\xc2\x3\xc4\x3\xc5\x3\xc6\x3\xc7\x3\xc8\x3\x91\x25\x92\x25\x93\x25\x2\x25\x24\x25\x61\x25\x62\x25\x56\x25\x55\x25\x63\x25\x51\x25\x57\x25\x5d\x25\x5c\x25\x5b\x25\x10\x25\x14\x25\x34\x25\x2c\x25\x1c\x25\x0\x25\x3c\x25\x5e\x25\x5f\x25\x5a\x25\x54\x25\x69\x25\x66\x25\x60\x25\x50\x25\x6c\x25\x67\x25\x68\x25\x64\x25\x65\x25\x59\x25\x58\x25\x52\x25\x53\x25\x6b\x25\x6a\x25\x18\x25\xc\x25\x88\x25\x84\x25\x8c\x25\x90\x25\x80\x25\xc9\x3\xac\x3\xad\x3\xae\x3\xca\x3\xaf\x3\xcc\x3\xcd\x3\xcb\x3\xce\x3\x86\x3\x88\x3\x89\x3\x8a\x3\x8c\x3\x8e\x3\x8f\x3\xb1\x0\x65\x22\x64\x22\xaa\x3\xab\x3\xf7\x0\x48\x22\xb0\x0\x19\x22\xb7\x0\x1a\x22\x7f\x20\xb2\x0\xa0\x25\xa0\x0"#
+     , encoderArray = 
+ CompactArray {
+        encoderIndices = ConvArray "\x0\x0\x40\x0\x80\x0\xc0\x0\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x40\x1\x80\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\xc0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x2\x40\x2\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x80\x2\xc0\x2\x0\x3"#
+        , encoderValues = ConvArray "\x0\x1\x2\x3\x4\x5\x6\x7\x8\x9\xa\xb\xc\xd\xe\xf\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x1a\x1b\x1c\x1d\x1e\x1f\x20\x21\x22\x23\x24\x25\x26\x27\x28\x29\x2a\x2b\x2c\x2d\x2e\x2f\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x3a\x3b\x3c\x3d\x3e\x3f\x40\x41\x42\x43\x44\x45\x46\x47\x48\x49\x4a\x4b\x4c\x4d\x4e\x4f\x50\x51\x52\x53\x54\x55\x56\x57\x58\x59\x5a\x5b\x5c\x5d\x5e\x5f\x60\x61\x62\x63\x64\x65\x66\x67\x68\x69\x6a\x6b\x6c\x6d\x6e\x6f\x70\x71\x72\x73\x74\x75\x76\x77\x78\x79\x7a\x7b\x7c\x7d\x7e\x7f\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xff\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xf8\xf1\xfd\x0\x0\x0\x0\xfa\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xf6\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xea\x0\xeb\xec\xed\x0\xee\x0\xef\xf0\x0\x80\x81\x82\x83\x84\x85\x86\x87\x88\x89\x8a\x8b\x8c\x8d\x8e\x8f\x90\x0\x91\x92\x93\x94\x95\x96\x97\xf4\xf5\xe1\xe2\xe3\xe5\x0\x98\x99\x9a\x9b\x9c\x9d\x9e\x9f\xa0\xa1\xa2\xa3\xa4\xa5\xa6\xa7\xa8\xaa\xa9\xab\xac\xad\xae\xaf\xe0\xe4\xe8\xe6\xe7\xe9\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xfc\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xf9\xfb\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xf7\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xf3\xf2\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xc4\x0\xb3\x0\x0\x0\x0\x0\x0\x0\x0\x0\xda\x0\x0\x0\xbf\x0\x0\x0\xc0\x0\x0\x0\xd9\x0\x0\x0\xc3\x0\x0\x0\x0\x0\x0\x0\xb4\x0\x0\x0\x0\x0\x0\x0\xc2\x0\x0\x0\x0\x0\x0\x0\xc1\x0\x0\x0\x0\x0\x0\x0\xc5\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xcd\xba\xd5\xd6\xc9\xb8\xb7\xbb\xd4\xd3\xc8\xbe\xbd\xbc\xc6\xc7\xcc\xb5\xb6\xb9\xd1\xd2\xcb\xcf\xd0\xca\xd8\xd7\xce\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xdf\x0\x0\x0\xdc\x0\x0\x0\xdb\x0\x0\x0\xdd\x0\x0\x0\xde\xb0\xb1\xb2\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xfe"#
+        , encoderMax = '\9632'
+        }
+
+   }
+    )
+
+    ,
+    (775, SingleByteCP {
+     decoderArray = ConvArray "\x0\x0\x1\x0\x2\x0\x3\x0\x4\x0\x5\x0\x6\x0\x7\x0\x8\x0\x9\x0\xa\x0\xb\x0\xc\x0\xd\x0\xe\x0\xf\x0\x10\x0\x11\x0\x12\x0\x13\x0\x14\x0\x15\x0\x16\x0\x17\x0\x18\x0\x19\x0\x1a\x0\x1b\x0\x1c\x0\x1d\x0\x1e\x0\x1f\x0\x20\x0\x21\x0\x22\x0\x23\x0\x24\x0\x25\x0\x26\x0\x27\x0\x28\x0\x29\x0\x2a\x0\x2b\x0\x2c\x0\x2d\x0\x2e\x0\x2f\x0\x30\x0\x31\x0\x32\x0\x33\x0\x34\x0\x35\x0\x36\x0\x37\x0\x38\x0\x39\x0\x3a\x0\x3b\x0\x3c\x0\x3d\x0\x3e\x0\x3f\x0\x40\x0\x41\x0\x42\x0\x43\x0\x44\x0\x45\x0\x46\x0\x47\x0\x48\x0\x49\x0\x4a\x0\x4b\x0\x4c\x0\x4d\x0\x4e\x0\x4f\x0\x50\x0\x51\x0\x52\x0\x53\x0\x54\x0\x55\x0\x56\x0\x57\x0\x58\x0\x59\x0\x5a\x0\x5b\x0\x5c\x0\x5d\x0\x5e\x0\x5f\x0\x60\x0\x61\x0\x62\x0\x63\x0\x64\x0\x65\x0\x66\x0\x67\x0\x68\x0\x69\x0\x6a\x0\x6b\x0\x6c\x0\x6d\x0\x6e\x0\x6f\x0\x70\x0\x71\x0\x72\x0\x73\x0\x74\x0\x75\x0\x76\x0\x77\x0\x78\x0\x79\x0\x7a\x0\x7b\x0\x7c\x0\x7d\x0\x7e\x0\x7f\x0\x6\x1\xfc\x0\xe9\x0\x1\x1\xe4\x0\x23\x1\xe5\x0\x7\x1\x42\x1\x13\x1\x56\x1\x57\x1\x2b\x1\x79\x1\xc4\x0\xc5\x0\xc9\x0\xe6\x0\xc6\x0\x4d\x1\xf6\x0\x22\x1\xa2\x0\x5a\x1\x5b\x1\xd6\x0\xdc\x0\xf8\x0\xa3\x0\xd8\x0\xd7\x0\xa4\x0\x0\x1\x2a\x1\xf3\x0\x7b\x1\x7c\x1\x7a\x1\x1d\x20\xa6\x0\xa9\x0\xae\x0\xac\x0\xbd\x0\xbc\x0\x41\x1\xab\x0\xbb\x0\x91\x25\x92\x25\x93\x25\x2\x25\x24\x25\x4\x1\xc\x1\x18\x1\x16\x1\x63\x25\x51\x25\x57\x25\x5d\x25\x2e\x1\x60\x1\x10\x25\x14\x25\x34\x25\x2c\x25\x1c\x25\x0\x25\x3c\x25\x72\x1\x6a\x1\x5a\x25\x54\x25\x69\x25\x66\x25\x60\x25\x50\x25\x6c\x25\x7d\x1\x5\x1\xd\x1\x19\x1\x17\x1\x2f\x1\x61\x1\x73\x1\x6b\x1\x7e\x1\x18\x25\xc\x25\x88\x25\x84\x25\x8c\x25\x90\x25\x80\x25\xd3\x0\xdf\x0\x4c\x1\x43\x1\xf5\x0\xd5\x0\xb5\x0\x44\x1\x36\x1\x37\x1\x3b\x1\x3c\x1\x46\x1\x12\x1\x45\x1\x19\x20\xad\x0\xb1\x0\x1c\x20\xbe\x0\xb6\x0\xa7\x0\xf7\x0\x1e\x20\xb0\x0\x19\x22\xb7\x0\xb9\x0\xb3\x0\xb2\x0\xa0\x25\xa0\x0"#
+     , encoderArray = 
+ CompactArray {
+        encoderIndices = ConvArray "\x0\x0\x40\x0\x80\x0\xc0\x0\x0\x1\x40\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\xc0\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x0\x2\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x40\x2\x80\x2\xc0\x2"#
+        , encoderValues = ConvArray "\x0\x1\x2\x3\x4\x5\x6\x7\x8\x9\xa\xb\xc\xd\xe\xf\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x1a\x1b\x1c\x1d\x1e\x1f\x20\x21\x22\x23\x24\x25\x26\x27\x28\x29\x2a\x2b\x2c\x2d\x2e\x2f\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x3a\x3b\x3c\x3d\x3e\x3f\x40\x41\x42\x43\x44\x45\x46\x47\x48\x49\x4a\x4b\x4c\x4d\x4e\x4f\x50\x51\x52\x53\x54\x55\x56\x57\x58\x59\x5a\x5b\x5c\x5d\x5e\x5f\x60\x61\x62\x63\x64\x65\x66\x67\x68\x69\x6a\x6b\x6c\x6d\x6e\x6f\x70\x71\x72\x73\x74\x75\x76\x77\x78\x79\x7a\x7b\x7c\x7d\x7e\x7f\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xff\x0\x96\x9c\x9f\x0\xa7\xf5\x0\xa8\x0\xae\xaa\xf0\xa9\x0\xf8\xf1\xfd\xfc\x0\xe6\xf4\xfa\x0\xfb\x0\xaf\xac\xab\xf3\x0\x0\x0\x0\x0\x8e\x8f\x92\x0\x0\x90\x0\x0\x0\x0\x0\x0\x0\x0\x0\xe0\x0\xe5\x99\x9e\x9d\x0\x0\x0\x9a\x0\x0\xe1\x0\x0\x0\x0\x84\x86\x91\x0\x0\x82\x0\x0\x0\x0\x0\x0\x0\x0\x0\xa2\x0\xe4\x94\xf6\x9b\x0\x0\x0\x81\x0\x0\x0\xa0\x83\x0\x0\xb5\xd0\x80\x87\x0\x0\x0\x0\xb6\xd1\x0\x0\x0\x0\xed\x89\x0\x0\xb8\xd3\xb7\xd2\x0\x0\x0\x0\x0\x0\x0\x0\x95\x85\x0\x0\x0\x0\x0\x0\xa1\x8c\x0\x0\xbd\xd4\x0\x0\x0\x0\x0\x0\xe8\xe9\x0\x0\x0\xea\xeb\x0\x0\x0\x0\xad\x88\xe3\xe7\xee\xec\x0\x0\x0\x0\x0\xe2\x93\x0\x0\x0\x0\x0\x0\x0\x0\x8a\x8b\x0\x0\x97\x98\x0\x0\x0\x0\xbe\xd5\x0\x0\x0\x0\x0\x0\x0\x0\xc7\xd7\x0\x0\x0\x0\x0\x0\xc6\xd6\x0\x0\x0\x0\x0\x8d\xa5\xa3\xa4\xcf\xd8\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xef\x0\x0\xf2\xa6\xf7\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xf9\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xc4\x0\xb3\x0\x0\x0\x0\x0\x0\x0\x0\x0\xda\x0\x0\x0\xbf\x0\x0\x0\xc0\x0\x0\x0\xd9\x0\x0\x0\xc3\x0\x0\x0\x0\x0\x0\x0\xb4\x0\x0\x0\x0\x0\x0\x0\xc2\x0\x0\x0\x0\x0\x0\x0\xc1\x0\x0\x0\x0\x0\x0\x0\xc5\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xcd\xba\x0\x0\xc9\x0\x0\xbb\x0\x0\xc8\x0\x0\xbc\x0\x0\xcc\x0\x0\xb9\x0\x0\xcb\x0\x0\xca\x0\x0\xce\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xdf\x0\x0\x0\xdc\x0\x0\x0\xdb\x0\x0\x0\xdd\x0\x0\x0\xde\xb0\xb1\xb2\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xfe"#
+        , encoderMax = '\9632'
+        }
+
+   }
+    )
+
+    ,
+    (850, SingleByteCP {
+     decoderArray = ConvArray "\x0\x0\x1\x0\x2\x0\x3\x0\x4\x0\x5\x0\x6\x0\x7\x0\x8\x0\x9\x0\xa\x0\xb\x0\xc\x0\xd\x0\xe\x0\xf\x0\x10\x0\x11\x0\x12\x0\x13\x0\x14\x0\x15\x0\x16\x0\x17\x0\x18\x0\x19\x0\x1a\x0\x1b\x0\x1c\x0\x1d\x0\x1e\x0\x1f\x0\x20\x0\x21\x0\x22\x0\x23\x0\x24\x0\x25\x0\x26\x0\x27\x0\x28\x0\x29\x0\x2a\x0\x2b\x0\x2c\x0\x2d\x0\x2e\x0\x2f\x0\x30\x0\x31\x0\x32\x0\x33\x0\x34\x0\x35\x0\x36\x0\x37\x0\x38\x0\x39\x0\x3a\x0\x3b\x0\x3c\x0\x3d\x0\x3e\x0\x3f\x0\x40\x0\x41\x0\x42\x0\x43\x0\x44\x0\x45\x0\x46\x0\x47\x0\x48\x0\x49\x0\x4a\x0\x4b\x0\x4c\x0\x4d\x0\x4e\x0\x4f\x0\x50\x0\x51\x0\x52\x0\x53\x0\x54\x0\x55\x0\x56\x0\x57\x0\x58\x0\x59\x0\x5a\x0\x5b\x0\x5c\x0\x5d\x0\x5e\x0\x5f\x0\x60\x0\x61\x0\x62\x0\x63\x0\x64\x0\x65\x0\x66\x0\x67\x0\x68\x0\x69\x0\x6a\x0\x6b\x0\x6c\x0\x6d\x0\x6e\x0\x6f\x0\x70\x0\x71\x0\x72\x0\x73\x0\x74\x0\x75\x0\x76\x0\x77\x0\x78\x0\x79\x0\x7a\x0\x7b\x0\x7c\x0\x7d\x0\x7e\x0\x7f\x0\xc7\x0\xfc\x0\xe9\x0\xe2\x0\xe4\x0\xe0\x0\xe5\x0\xe7\x0\xea\x0\xeb\x0\xe8\x0\xef\x0\xee\x0\xec\x0\xc4\x0\xc5\x0\xc9\x0\xe6\x0\xc6\x0\xf4\x0\xf6\x0\xf2\x0\xfb\x0\xf9\x0\xff\x0\xd6\x0\xdc\x0\xf8\x0\xa3\x0\xd8\x0\xd7\x0\x92\x1\xe1\x0\xed\x0\xf3\x0\xfa\x0\xf1\x0\xd1\x0\xaa\x0\xba\x0\xbf\x0\xae\x0\xac\x0\xbd\x0\xbc\x0\xa1\x0\xab\x0\xbb\x0\x91\x25\x92\x25\x93\x25\x2\x25\x24\x25\xc1\x0\xc2\x0\xc0\x0\xa9\x0\x63\x25\x51\x25\x57\x25\x5d\x25\xa2\x0\xa5\x0\x10\x25\x14\x25\x34\x25\x2c\x25\x1c\x25\x0\x25\x3c\x25\xe3\x0\xc3\x0\x5a\x25\x54\x25\x69\x25\x66\x25\x60\x25\x50\x25\x6c\x25\xa4\x0\xf0\x0\xd0\x0\xca\x0\xcb\x0\xc8\x0\x31\x1\xcd\x0\xce\x0\xcf\x0\x18\x25\xc\x25\x88\x25\x84\x25\xa6\x0\xcc\x0\x80\x25\xd3\x0\xdf\x0\xd4\x0\xd2\x0\xf5\x0\xd5\x0\xb5\x0\xfe\x0\xde\x0\xda\x0\xdb\x0\xd9\x0\xfd\x0\xdd\x0\xaf\x0\xb4\x0\xad\x0\xb1\x0\x17\x20\xbe\x0\xb6\x0\xa7\x0\xf7\x0\xb8\x0\xb0\x0\xa8\x0\xb7\x0\xb9\x0\xb3\x0\xb2\x0\xa0\x25\xa0\x0"#
+     , encoderArray = 
+ CompactArray {
+        encoderIndices = ConvArray "\x0\x0\x40\x0\x80\x0\xc0\x0\x0\x1\x40\x1\x80\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\xc0\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x40\x1\x0\x2\x40\x2\x80\x2"#
+        , encoderValues = ConvArray "\x0\x1\x2\x3\x4\x5\x6\x7\x8\x9\xa\xb\xc\xd\xe\xf\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x1a\x1b\x1c\x1d\x1e\x1f\x20\x21\x22\x23\x24\x25\x26\x27\x28\x29\x2a\x2b\x2c\x2d\x2e\x2f\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x3a\x3b\x3c\x3d\x3e\x3f\x40\x41\x42\x43\x44\x45\x46\x47\x48\x49\x4a\x4b\x4c\x4d\x4e\x4f\x50\x51\x52\x53\x54\x55\x56\x57\x58\x59\x5a\x5b\x5c\x5d\x5e\x5f\x60\x61\x62\x63\x64\x65\x66\x67\x68\x69\x6a\x6b\x6c\x6d\x6e\x6f\x70\x71\x72\x73\x74\x75\x76\x77\x78\x79\x7a\x7b\x7c\x7d\x7e\x7f\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xff\xad\xbd\x9c\xcf\xbe\xdd\xf5\xf9\xb8\xa6\xae\xaa\xf0\xa9\xee\xf8\xf1\xfd\xfc\xef\xe6\xf4\xfa\xf7\xfb\xa7\xaf\xac\xab\xf3\xa8\xb7\xb5\xb6\xc7\x8e\x8f\x92\x80\xd4\x90\xd2\xd3\xde\xd6\xd7\xd8\xd1\xa5\xe3\xe0\xe2\xe5\x99\x9e\x9d\xeb\xe9\xea\x9a\xed\xe8\xe1\x85\xa0\x83\xc6\x84\x86\x91\x87\x8a\x82\x88\x89\x8d\xa1\x8c\x8b\xd0\xa4\x95\xa2\x93\xe4\x94\xf6\x9b\x97\xa3\x96\x81\xec\xe7\x98\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xd5\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x9f\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xf2\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xc4\x0\xb3\x0\x0\x0\x0\x0\x0\x0\x0\x0\xda\x0\x0\x0\xbf\x0\x0\x0\xc0\x0\x0\x0\xd9\x0\x0\x0\xc3\x0\x0\x0\x0\x0\x0\x0\xb4\x0\x0\x0\x0\x0\x0\x0\xc2\x0\x0\x0\x0\x0\x0\x0\xc1\x0\x0\x0\x0\x0\x0\x0\xc5\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xcd\xba\x0\x0\xc9\x0\x0\xbb\x0\x0\xc8\x0\x0\xbc\x0\x0\xcc\x0\x0\xb9\x0\x0\xcb\x0\x0\xca\x0\x0\xce\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xdf\x0\x0\x0\xdc\x0\x0\x0\xdb\x0\x0\x0\x0\x0\x0\x0\x0\xb0\xb1\xb2\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xfe"#
+        , encoderMax = '\9632'
+        }
+
+   }
+    )
+
+    ,
+    (852, SingleByteCP {
+     decoderArray = ConvArray "\x0\x0\x1\x0\x2\x0\x3\x0\x4\x0\x5\x0\x6\x0\x7\x0\x8\x0\x9\x0\xa\x0\xb\x0\xc\x0\xd\x0\xe\x0\xf\x0\x10\x0\x11\x0\x12\x0\x13\x0\x14\x0\x15\x0\x16\x0\x17\x0\x18\x0\x19\x0\x1a\x0\x1b\x0\x1c\x0\x1d\x0\x1e\x0\x1f\x0\x20\x0\x21\x0\x22\x0\x23\x0\x24\x0\x25\x0\x26\x0\x27\x0\x28\x0\x29\x0\x2a\x0\x2b\x0\x2c\x0\x2d\x0\x2e\x0\x2f\x0\x30\x0\x31\x0\x32\x0\x33\x0\x34\x0\x35\x0\x36\x0\x37\x0\x38\x0\x39\x0\x3a\x0\x3b\x0\x3c\x0\x3d\x0\x3e\x0\x3f\x0\x40\x0\x41\x0\x42\x0\x43\x0\x44\x0\x45\x0\x46\x0\x47\x0\x48\x0\x49\x0\x4a\x0\x4b\x0\x4c\x0\x4d\x0\x4e\x0\x4f\x0\x50\x0\x51\x0\x52\x0\x53\x0\x54\x0\x55\x0\x56\x0\x57\x0\x58\x0\x59\x0\x5a\x0\x5b\x0\x5c\x0\x5d\x0\x5e\x0\x5f\x0\x60\x0\x61\x0\x62\x0\x63\x0\x64\x0\x65\x0\x66\x0\x67\x0\x68\x0\x69\x0\x6a\x0\x6b\x0\x6c\x0\x6d\x0\x6e\x0\x6f\x0\x70\x0\x71\x0\x72\x0\x73\x0\x74\x0\x75\x0\x76\x0\x77\x0\x78\x0\x79\x0\x7a\x0\x7b\x0\x7c\x0\x7d\x0\x7e\x0\x7f\x0\xc7\x0\xfc\x0\xe9\x0\xe2\x0\xe4\x0\x6f\x1\x7\x1\xe7\x0\x42\x1\xeb\x0\x50\x1\x51\x1\xee\x0\x79\x1\xc4\x0\x6\x1\xc9\x0\x39\x1\x3a\x1\xf4\x0\xf6\x0\x3d\x1\x3e\x1\x5a\x1\x5b\x1\xd6\x0\xdc\x0\x64\x1\x65\x1\x41\x1\xd7\x0\xd\x1\xe1\x0\xed\x0\xf3\x0\xfa\x0\x4\x1\x5\x1\x7d\x1\x7e\x1\x18\x1\x19\x1\xac\x0\x7a\x1\xc\x1\x5f\x1\xab\x0\xbb\x0\x91\x25\x92\x25\x93\x25\x2\x25\x24\x25\xc1\x0\xc2\x0\x1a\x1\x5e\x1\x63\x25\x51\x25\x57\x25\x5d\x25\x7b\x1\x7c\x1\x10\x25\x14\x25\x34\x25\x2c\x25\x1c\x25\x0\x25\x3c\x25\x2\x1\x3\x1\x5a\x25\x54\x25\x69\x25\x66\x25\x60\x25\x50\x25\x6c\x25\xa4\x0\x11\x1\x10\x1\xe\x1\xcb\x0\xf\x1\x47\x1\xcd\x0\xce\x0\x1b\x1\x18\x25\xc\x25\x88\x25\x84\x25\x62\x1\x6e\x1\x80\x25\xd3\x0\xdf\x0\xd4\x0\x43\x1\x44\x1\x48\x1\x60\x1\x61\x1\x54\x1\xda\x0\x55\x1\x70\x1\xfd\x0\xdd\x0\x63\x1\xb4\x0\xad\x0\xdd\x2\xdb\x2\xc7\x2\xd8\x2\xa7\x0\xf7\x0\xb8\x0\xb0\x0\xa8\x0\xd9\x2\x71\x1\x58\x1\x59\x1\xa0\x25\xa0\x0"#
+     , encoderArray = 
+ CompactArray {
+        encoderIndices = ConvArray "\x0\x0\x40\x0\x80\x0\xc0\x0\x0\x1\x40\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\xc0\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x0\x2\x40\x2\x80\x2"#
+        , encoderValues = ConvArray "\x0\x1\x2\x3\x4\x5\x6\x7\x8\x9\xa\xb\xc\xd\xe\xf\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x1a\x1b\x1c\x1d\x1e\x1f\x20\x21\x22\x23\x24\x25\x26\x27\x28\x29\x2a\x2b\x2c\x2d\x2e\x2f\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x3a\x3b\x3c\x3d\x3e\x3f\x40\x41\x42\x43\x44\x45\x46\x47\x48\x49\x4a\x4b\x4c\x4d\x4e\x4f\x50\x51\x52\x53\x54\x55\x56\x57\x58\x59\x5a\x5b\x5c\x5d\x5e\x5f\x60\x61\x62\x63\x64\x65\x66\x67\x68\x69\x6a\x6b\x6c\x6d\x6e\x6f\x70\x71\x72\x73\x74\x75\x76\x77\x78\x79\x7a\x7b\x7c\x7d\x7e\x7f\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xff\x0\x0\x0\xcf\x0\x0\xf5\xf9\x0\x0\xae\xaa\xf0\x0\x0\xf8\x0\x0\x0\xef\x0\x0\x0\xf7\x0\x0\xaf\x0\x0\x0\x0\x0\xb5\xb6\x0\x8e\x0\x0\x80\x0\x90\x0\xd3\x0\xd6\xd7\x0\x0\x0\x0\xe0\xe2\x0\x99\x9e\x0\x0\xe9\x0\x9a\xed\x0\xe1\x0\xa0\x83\x0\x84\x0\x0\x87\x0\x82\x0\x89\x0\xa1\x8c\x0\x0\x0\x0\xa2\x93\x0\x94\xf6\x0\x0\xa3\x0\x81\xec\x0\x0\x0\x0\xc6\xc7\xa4\xa5\x8f\x86\x0\x0\x0\x0\xac\x9f\xd2\xd4\xd1\xd0\x0\x0\x0\x0\x0\x0\xa8\xa9\xb7\xd8\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x91\x92\x0\x0\x95\x96\x0\x0\x9d\x88\xe3\xe4\x0\x0\xd5\xe5\x0\x0\x0\x0\x0\x0\x0\x8a\x8b\x0\x0\xe8\xea\x0\x0\xfc\xfd\x97\x98\x0\x0\xb8\xad\xe6\xe7\xdd\xee\x9b\x9c\x0\x0\x0\x0\x0\x0\x0\x0\xde\x85\xeb\xfb\x0\x0\x0\x0\x0\x0\x0\x8d\xab\xbd\xbe\xa6\xa7\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xf3\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xf4\xfa\x0\xf2\x0\xf1\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xc4\x0\xb3\x0\x0\x0\x0\x0\x0\x0\x0\x0\xda\x0\x0\x0\xbf\x0\x0\x0\xc0\x0\x0\x0\xd9\x0\x0\x0\xc3\x0\x0\x0\x0\x0\x0\x0\xb4\x0\x0\x0\x0\x0\x0\x0\xc2\x0\x0\x0\x0\x0\x0\x0\xc1\x0\x0\x0\x0\x0\x0\x0\xc5\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xcd\xba\x0\x0\xc9\x0\x0\xbb\x0\x0\xc8\x0\x0\xbc\x0\x0\xcc\x0\x0\xb9\x0\x0\xcb\x0\x0\xca\x0\x0\xce\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xdf\x0\x0\x0\xdc\x0\x0\x0\xdb\x0\x0\x0\x0\x0\x0\x0\x0\xb0\xb1\xb2\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xfe"#
+        , encoderMax = '\9632'
+        }
+
+   }
+    )
+
+    ,
+    (855, SingleByteCP {
+     decoderArray = ConvArray "\x0\x0\x1\x0\x2\x0\x3\x0\x4\x0\x5\x0\x6\x0\x7\x0\x8\x0\x9\x0\xa\x0\xb\x0\xc\x0\xd\x0\xe\x0\xf\x0\x10\x0\x11\x0\x12\x0\x13\x0\x14\x0\x15\x0\x16\x0\x17\x0\x18\x0\x19\x0\x1a\x0\x1b\x0\x1c\x0\x1d\x0\x1e\x0\x1f\x0\x20\x0\x21\x0\x22\x0\x23\x0\x24\x0\x25\x0\x26\x0\x27\x0\x28\x0\x29\x0\x2a\x0\x2b\x0\x2c\x0\x2d\x0\x2e\x0\x2f\x0\x30\x0\x31\x0\x32\x0\x33\x0\x34\x0\x35\x0\x36\x0\x37\x0\x38\x0\x39\x0\x3a\x0\x3b\x0\x3c\x0\x3d\x0\x3e\x0\x3f\x0\x40\x0\x41\x0\x42\x0\x43\x0\x44\x0\x45\x0\x46\x0\x47\x0\x48\x0\x49\x0\x4a\x0\x4b\x0\x4c\x0\x4d\x0\x4e\x0\x4f\x0\x50\x0\x51\x0\x52\x0\x53\x0\x54\x0\x55\x0\x56\x0\x57\x0\x58\x0\x59\x0\x5a\x0\x5b\x0\x5c\x0\x5d\x0\x5e\x0\x5f\x0\x60\x0\x61\x0\x62\x0\x63\x0\x64\x0\x65\x0\x66\x0\x67\x0\x68\x0\x69\x0\x6a\x0\x6b\x0\x6c\x0\x6d\x0\x6e\x0\x6f\x0\x70\x0\x71\x0\x72\x0\x73\x0\x74\x0\x75\x0\x76\x0\x77\x0\x78\x0\x79\x0\x7a\x0\x7b\x0\x7c\x0\x7d\x0\x7e\x0\x7f\x0\x52\x4\x2\x4\x53\x4\x3\x4\x51\x4\x1\x4\x54\x4\x4\x4\x55\x4\x5\x4\x56\x4\x6\x4\x57\x4\x7\x4\x58\x4\x8\x4\x59\x4\x9\x4\x5a\x4\xa\x4\x5b\x4\xb\x4\x5c\x4\xc\x4\x5e\x4\xe\x4\x5f\x4\xf\x4\x4e\x4\x2e\x4\x4a\x4\x2a\x4\x30\x4\x10\x4\x31\x4\x11\x4\x46\x4\x26\x4\x34\x4\x14\x4\x35\x4\x15\x4\x44\x4\x24\x4\x33\x4\x13\x4\xab\x0\xbb\x0\x91\x25\x92\x25\x93\x25\x2\x25\x24\x25\x45\x4\x25\x4\x38\x4\x18\x4\x63\x25\x51\x25\x57\x25\x5d\x25\x39\x4\x19\x4\x10\x25\x14\x25\x34\x25\x2c\x25\x1c\x25\x0\x25\x3c\x25\x3a\x4\x1a\x4\x5a\x25\x54\x25\x69\x25\x66\x25\x60\x25\x50\x25\x6c\x25\xa4\x0\x3b\x4\x1b\x4\x3c\x4\x1c\x4\x3d\x4\x1d\x4\x3e\x4\x1e\x4\x3f\x4\x18\x25\xc\x25\x88\x25\x84\x25\x1f\x4\x4f\x4\x80\x25\x2f\x4\x40\x4\x20\x4\x41\x4\x21\x4\x42\x4\x22\x4\x43\x4\x23\x4\x36\x4\x16\x4\x32\x4\x12\x4\x4c\x4\x2c\x4\x16\x21\xad\x0\x4b\x4\x2b\x4\x37\x4\x17\x4\x48\x4\x28\x4\x4d\x4\x2d\x4\x49\x4\x29\x4\x47\x4\x27\x4\xa7\x0\xa0\x25\xa0\x0"#
+     , encoderArray = 
+ CompactArray {
+        encoderIndices = ConvArray "\x0\x0\x40\x0\x80\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\x0\x1\x40\x1\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\x80\x1\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x1\x0\x2\x40\x2"#
+        , encoderValues = ConvArray "\x0\x1\x2\x3\x4\x5\x6\x7\x8\x9\xa\xb\xc\xd\xe\xf\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x1a\x1b\x1c\x1d\x1e\x1f\x20\x21\x22\x23\x24\x25\x26\x27\x28\x29\x2a\x2b\x2c\x2d\x2e\x2f\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x3a\x3b\x3c\x3d\x3e\x3f\x40\x41\x42\x43\x44\x45\x46\x47\x48\x49\x4a\x4b\x4c\x4d\x4e\x4f\x50\x51\x52\x53\x54\x55\x56\x57\x58\x59\x5a\x5b\x5c\x5d\x5e\x5f\x60\x61\x62\x63\x64\x65\x66\x67\x68\x69\x6a\x6b\x6c\x6d\x6e\x6f\x70\x71\x72\x73\x74\x75\x76\x77\x78\x79\x7a\x7b\x7c\x7d\x7e\x7f\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xff\x0\x0\x0\xcf\x0\x0\xfd\x0\x0\x0\xae\x0\xf0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xaf\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x85\x81\x83\x87\x89\x8b\x8d\x8f\x91\x93\x95\x97\x0\x99\x9b\xa1\xa3\xec\xad\xa7\xa9\xea\xf4\xb8\xbe\xc7\xd1\xd3\xd5\xd7\xdd\xe2\xe4\xe6\xe8\xab\xb6\xa5\xfc\xf6\xfa\x9f\xf2\xee\xf8\x9d\xe0\xa0\xa2\xeb\xac\xa6\xa8\xe9\xf3\xb7\xbd\xc6\xd0\xd2\xd4\xd6\xd8\xe1\xe3\xe5\xe7\xaa\xb5\xa4\xfb\xf5\xf9\x9e\xf1\xed\xf7\x9c\xde\x0\x84\x80\x82\x86\x88\x8a\x8c\x8e\x90\x92\x94\x96\x0\x98\x9a\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xef\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xc4\x0\xb3\x0\x0\x0\x0\x0\x0\x0\x0\x0\xda\x0\x0\x0\xbf\x0\x0\x0\xc0\x0\x0\x0\xd9\x0\x0\x0\xc3\x0\x0\x0\x0\x0\x0\x0\xb4\x0\x0\x0\x0\x0\x0\x0\xc2\x0\x0\x0\x0\x0\x0\x0\xc1\x0\x0\x0\x0\x0\x0\x0\xc5\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xcd\xba\x0\x0\xc9\x0\x0\xbb\x0\x0\xc8\x0\x0\xbc\x0\x0\xcc\x0\x0\xb9\x0\x0\xcb\x0\x0\xca\x0\x0\xce\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xdf\x0\x0\x0\xdc\x0\x0\x0\xdb\x0\x0\x0\x0\x0\x0\x0\x0\xb0\xb1\xb2\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xfe"#
+        , encoderMax = '\9632'
+        }
+
+   }
+    )
+
+    ,
+    (857, SingleByteCP {
+     decoderArray = ConvArray "\x0\x0\x1\x0\x2\x0\x3\x0\x4\x0\x5\x0\x6\x0\x7\x0\x8\x0\x9\x0\xa\x0\xb\x0\xc\x0\xd\x0\xe\x0\xf\x0\x10\x0\x11\x0\x12\x0\x13\x0\x14\x0\x15\x0\x16\x0\x17\x0\x18\x0\x19\x0\x1a\x0\x1b\x0\x1c\x0\x1d\x0\x1e\x0\x1f\x0\x20\x0\x21\x0\x22\x0\x23\x0\x24\x0\x25\x0\x26\x0\x27\x0\x28\x0\x29\x0\x2a\x0\x2b\x0\x2c\x0\x2d\x0\x2e\x0\x2f\x0\x30\x0\x31\x0\x32\x0\x33\x0\x34\x0\x35\x0\x36\x0\x37\x0\x38\x0\x39\x0\x3a\x0\x3b\x0\x3c\x0\x3d\x0\x3e\x0\x3f\x0\x40\x0\x41\x0\x42\x0\x43\x0\x44\x0\x45\x0\x46\x0\x47\x0\x48\x0\x49\x0\x4a\x0\x4b\x0\x4c\x0\x4d\x0\x4e\x0\x4f\x0\x50\x0\x51\x0\x52\x0\x53\x0\x54\x0\x55\x0\x56\x0\x57\x0\x58\x0\x59\x0\x5a\x0\x5b\x0\x5c\x0\x5d\x0\x5e\x0\x5f\x0\x60\x0\x61\x0\x62\x0\x63\x0\x64\x0\x65\x0\x66\x0\x67\x0\x68\x0\x69\x0\x6a\x0\x6b\x0\x6c\x0\x6d\x0\x6e\x0\x6f\x0\x70\x0\x71\x0\x72\x0\x73\x0\x74\x0\x75\x0\x76\x0\x77\x0\x78\x0\x79\x0\x7a\x0\x7b\x0\x7c\x0\x7d\x0\x7e\x0\x7f\x0\xc7\x0\xfc\x0\xe9\x0\xe2\x0\xe4\x0\xe0\x0\xe5\x0\xe7\x0\xea\x0\xeb\x0\xe8\x0\xef\x0\xee\x0\x31\x1\xc4\x0\xc5\x0\xc9\x0\xe6\x0\xc6\x0\xf4\x0\xf6\x0\xf2\x0\xfb\x0\xf9\x0\x30\x1\xd6\x0\xdc\x0\xf8\x0\xa3\x0\xd8\x0\x5e\x1\x5f\x1\xe1\x0\xed\x0\xf3\x0\xfa\x0\xf1\x0\xd1\x0\x1e\x1\x1f\x1\xbf\x0\xae\x0\xac\x0\xbd\x0\xbc\x0\xa1\x0\xab\x0\xbb\x0\x91\x25\x92\x25\x93\x25\x2\x25\x24\x25\xc1\x0\xc2\x0\xc0\x0\xa9\x0\x63\x25\x51\x25\x57\x25\x5d\x25\xa2\x0\xa5\x0\x10\x25\x14\x25\x34\x25\x2c\x25\x1c\x25\x0\x25\x3c\x25\xe3\x0\xc3\x0\x5a\x25\x54\x25\x69\x25\x66\x25\x60\x25\x50\x25\x6c\x25\xa4\x0\xba\x0\xaa\x0\xca\x0\xcb\x0\xc8\x0\x0\x0\xcd\x0\xce\x0\xcf\x0\x18\x25\xc\x25\x88\x25\x84\x25\xa6\x0\xcc\x0\x80\x25\xd3\x0\xdf\x0\xd4\x0\xd2\x0\xf5\x0\xd5\x0\xb5\x0\x0\x0\xd7\x0\xda\x0\xdb\x0\xd9\x0\xec\x0\xff\x0\xaf\x0\xb4\x0\xad\x0\xb1\x0\x0\x0\xbe\x0\xb6\x0\xa7\x0\xf7\x0\xb8\x0\xb0\x0\xa8\x0\xb7\x0\xb9\x0\xb3\x0\xb2\x0\xa0\x25\xa0\x0"#
+     , encoderArray = 
+ CompactArray {
+        encoderIndices = ConvArray "\x0\x0\x40\x0\x80\x0\xc0\x0\x0\x1\x40\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\x80\x1\xc0\x1\x0\x2\x40\x2"#
+        , encoderValues = ConvArray "\x0\x1\x2\x3\x4\x5\x6\x7\x8\x9\xa\xb\xc\xd\xe\xf\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x1a\x1b\x1c\x1d\x1e\x1f\x20\x21\x22\x23\x24\x25\x26\x27\x28\x29\x2a\x2b\x2c\x2d\x2e\x2f\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x3a\x3b\x3c\x3d\x3e\x3f\x40\x41\x42\x43\x44\x45\x46\x47\x48\x49\x4a\x4b\x4c\x4d\x4e\x4f\x50\x51\x52\x53\x54\x55\x56\x57\x58\x59\x5a\x5b\x5c\x5d\x5e\x5f\x60\x61\x62\x63\x64\x65\x66\x67\x68\x69\x6a\x6b\x6c\x6d\x6e\x6f\x70\x71\x72\x73\x74\x75\x76\x77\x78\x79\x7a\x7b\x7c\x7d\x7e\x7f\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xff\xad\xbd\x9c\xcf\xbe\xdd\xf5\xf9\xb8\xd1\xae\xaa\xf0\xa9\xee\xf8\xf1\xfd\xfc\xef\xe6\xf4\xfa\xf7\xfb\xd0\xaf\xac\xab\xf3\xa8\xb7\xb5\xb6\xc7\x8e\x8f\x92\x80\xd4\x90\xd2\xd3\xde\xd6\xd7\xd8\x0\xa5\xe3\xe0\xe2\xe5\x99\xe8\x9d\xeb\xe9\xea\x9a\x0\x0\xe1\x85\xa0\x83\xc6\x84\x86\x91\x87\x8a\x82\x88\x89\xec\xa1\x8c\x8b\x0\xa4\x95\xa2\x93\xe4\x94\xf6\x9b\x97\xa3\x96\x81\x0\x0\xed\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xa6\xa7\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x98\x8d\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x9e\x9f\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xc4\x0\xb3\x0\x0\x0\x0\x0\x0\x0\x0\x0\xda\x0\x0\x0\xbf\x0\x0\x0\xc0\x0\x0\x0\xd9\x0\x0\x0\xc3\x0\x0\x0\x0\x0\x0\x0\xb4\x0\x0\x0\x0\x0\x0\x0\xc2\x0\x0\x0\x0\x0\x0\x0\xc1\x0\x0\x0\x0\x0\x0\x0\xc5\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xcd\xba\x0\x0\xc9\x0\x0\xbb\x0\x0\xc8\x0\x0\xbc\x0\x0\xcc\x0\x0\xb9\x0\x0\xcb\x0\x0\xca\x0\x0\xce\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xdf\x0\x0\x0\xdc\x0\x0\x0\xdb\x0\x0\x0\x0\x0\x0\x0\x0\xb0\xb1\xb2\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xfe"#
+        , encoderMax = '\9632'
+        }
+
+   }
+    )
+
+    ,
+    (860, SingleByteCP {
+     decoderArray = ConvArray "\x0\x0\x1\x0\x2\x0\x3\x0\x4\x0\x5\x0\x6\x0\x7\x0\x8\x0\x9\x0\xa\x0\xb\x0\xc\x0\xd\x0\xe\x0\xf\x0\x10\x0\x11\x0\x12\x0\x13\x0\x14\x0\x15\x0\x16\x0\x17\x0\x18\x0\x19\x0\x1a\x0\x1b\x0\x1c\x0\x1d\x0\x1e\x0\x1f\x0\x20\x0\x21\x0\x22\x0\x23\x0\x24\x0\x25\x0\x26\x0\x27\x0\x28\x0\x29\x0\x2a\x0\x2b\x0\x2c\x0\x2d\x0\x2e\x0\x2f\x0\x30\x0\x31\x0\x32\x0\x33\x0\x34\x0\x35\x0\x36\x0\x37\x0\x38\x0\x39\x0\x3a\x0\x3b\x0\x3c\x0\x3d\x0\x3e\x0\x3f\x0\x40\x0\x41\x0\x42\x0\x43\x0\x44\x0\x45\x0\x46\x0\x47\x0\x48\x0\x49\x0\x4a\x0\x4b\x0\x4c\x0\x4d\x0\x4e\x0\x4f\x0\x50\x0\x51\x0\x52\x0\x53\x0\x54\x0\x55\x0\x56\x0\x57\x0\x58\x0\x59\x0\x5a\x0\x5b\x0\x5c\x0\x5d\x0\x5e\x0\x5f\x0\x60\x0\x61\x0\x62\x0\x63\x0\x64\x0\x65\x0\x66\x0\x67\x0\x68\x0\x69\x0\x6a\x0\x6b\x0\x6c\x0\x6d\x0\x6e\x0\x6f\x0\x70\x0\x71\x0\x72\x0\x73\x0\x74\x0\x75\x0\x76\x0\x77\x0\x78\x0\x79\x0\x7a\x0\x7b\x0\x7c\x0\x7d\x0\x7e\x0\x7f\x0\xc7\x0\xfc\x0\xe9\x0\xe2\x0\xe3\x0\xe0\x0\xc1\x0\xe7\x0\xea\x0\xca\x0\xe8\x0\xcd\x0\xd4\x0\xec\x0\xc3\x0\xc2\x0\xc9\x0\xc0\x0\xc8\x0\xf4\x0\xf5\x0\xf2\x0\xda\x0\xf9\x0\xcc\x0\xd5\x0\xdc\x0\xa2\x0\xa3\x0\xd9\x0\xa7\x20\xd3\x0\xe1\x0\xed\x0\xf3\x0\xfa\x0\xf1\x0\xd1\x0\xaa\x0\xba\x0\xbf\x0\xd2\x0\xac\x0\xbd\x0\xbc\x0\xa1\x0\xab\x0\xbb\x0\x91\x25\x92\x25\x93\x25\x2\x25\x24\x25\x61\x25\x62\x25\x56\x25\x55\x25\x63\x25\x51\x25\x57\x25\x5d\x25\x5c\x25\x5b\x25\x10\x25\x14\x25\x34\x25\x2c\x25\x1c\x25\x0\x25\x3c\x25\x5e\x25\x5f\x25\x5a\x25\x54\x25\x69\x25\x66\x25\x60\x25\x50\x25\x6c\x25\x67\x25\x68\x25\x64\x25\x65\x25\x59\x25\x58\x25\x52\x25\x53\x25\x6b\x25\x6a\x25\x18\x25\xc\x25\x88\x25\x84\x25\x8c\x25\x90\x25\x80\x25\xb1\x3\xdf\x0\x93\x3\xc0\x3\xa3\x3\xc3\x3\xb5\x0\xc4\x3\xa6\x3\x98\x3\xa9\x3\xb4\x3\x1e\x22\xc6\x3\xb5\x3\x29\x22\x61\x22\xb1\x0\x65\x22\x64\x22\x20\x23\x21\x23\xf7\x0\x48\x22\xb0\x0\x19\x22\xb7\x0\x1a\x22\x7f\x20\xb2\x0\xa0\x25\xa0\x0"#
+     , encoderArray = 
+ CompactArray {
+        encoderIndices = ConvArray "\x0\x0\x40\x0\x80\x0\xc0\x0\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x40\x1\x80\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\xc0\x1\x0\x2\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x40\x2\x80\x2\x0\x1\x0\x1\xc0\x2\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x3\x40\x3\x80\x3"#
+        , encoderValues = ConvArray "\x0\x1\x2\x3\x4\x5\x6\x7\x8\x9\xa\xb\xc\xd\xe\xf\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x1a\x1b\x1c\x1d\x1e\x1f\x20\x21\x22\x23\x24\x25\x26\x27\x28\x29\x2a\x2b\x2c\x2d\x2e\x2f\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x3a\x3b\x3c\x3d\x3e\x3f\x40\x41\x42\x43\x44\x45\x46\x47\x48\x49\x4a\x4b\x4c\x4d\x4e\x4f\x50\x51\x52\x53\x54\x55\x56\x57\x58\x59\x5a\x5b\x5c\x5d\x5e\x5f\x60\x61\x62\x63\x64\x65\x66\x67\x68\x69\x6a\x6b\x6c\x6d\x6e\x6f\x70\x71\x72\x73\x74\x75\x76\x77\x78\x79\x7a\x7b\x7c\x7d\x7e\x7f\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xff\xad\x9b\x9c\x0\x0\x0\x0\x0\x0\xa6\xae\xaa\x0\x0\x0\xf8\xf1\xfd\x0\x0\xe6\x0\xfa\x0\x0\xa7\xaf\xac\xab\x0\xa8\x91\x86\x8f\x8e\x0\x0\x0\x80\x92\x90\x89\x0\x98\x8b\x0\x0\x0\xa5\xa9\x9f\x8c\x99\x0\x0\x0\x9d\x96\x0\x9a\x0\x0\xe1\x85\xa0\x83\x84\x0\x0\x0\x87\x8a\x82\x88\x0\x8d\xa1\x0\x0\x0\xa4\x95\xa2\x93\x94\x0\xf6\x0\x97\xa3\x0\x81\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xe2\x0\x0\x0\x0\xe9\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xe4\x0\x0\xe8\x0\x0\xea\x0\x0\x0\x0\x0\x0\x0\xe0\x0\x0\xeb\xee\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xe3\x0\x0\xe5\xe7\x0\xed\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xfc\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x9e\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xf9\xfb\x0\x0\x0\xec\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xef\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xf7\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xf0\x0\x0\xf3\xf2\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xf4\xf5\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xc4\x0\xb3\x0\x0\x0\x0\x0\x0\x0\x0\x0\xda\x0\x0\x0\xbf\x0\x0\x0\xc0\x0\x0\x0\xd9\x0\x0\x0\xc3\x0\x0\x0\x0\x0\x0\x0\xb4\x0\x0\x0\x0\x0\x0\x0\xc2\x0\x0\x0\x0\x0\x0\x0\xc1\x0\x0\x0\x0\x0\x0\x0\xc5\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xcd\xba\xd5\xd6\xc9\xb8\xb7\xbb\xd4\xd3\xc8\xbe\xbd\xbc\xc6\xc7\xcc\xb5\xb6\xb9\xd1\xd2\xcb\xcf\xd0\xca\xd8\xd7\xce\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xdf\x0\x0\x0\xdc\x0\x0\x0\xdb\x0\x0\x0\xdd\x0\x0\x0\xde\xb0\xb1\xb2\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xfe"#
+        , encoderMax = '\9632'
+        }
+
+   }
+    )
+
+    ,
+    (861, SingleByteCP {
+     decoderArray = ConvArray "\x0\x0\x1\x0\x2\x0\x3\x0\x4\x0\x5\x0\x6\x0\x7\x0\x8\x0\x9\x0\xa\x0\xb\x0\xc\x0\xd\x0\xe\x0\xf\x0\x10\x0\x11\x0\x12\x0\x13\x0\x14\x0\x15\x0\x16\x0\x17\x0\x18\x0\x19\x0\x1a\x0\x1b\x0\x1c\x0\x1d\x0\x1e\x0\x1f\x0\x20\x0\x21\x0\x22\x0\x23\x0\x24\x0\x25\x0\x26\x0\x27\x0\x28\x0\x29\x0\x2a\x0\x2b\x0\x2c\x0\x2d\x0\x2e\x0\x2f\x0\x30\x0\x31\x0\x32\x0\x33\x0\x34\x0\x35\x0\x36\x0\x37\x0\x38\x0\x39\x0\x3a\x0\x3b\x0\x3c\x0\x3d\x0\x3e\x0\x3f\x0\x40\x0\x41\x0\x42\x0\x43\x0\x44\x0\x45\x0\x46\x0\x47\x0\x48\x0\x49\x0\x4a\x0\x4b\x0\x4c\x0\x4d\x0\x4e\x0\x4f\x0\x50\x0\x51\x0\x52\x0\x53\x0\x54\x0\x55\x0\x56\x0\x57\x0\x58\x0\x59\x0\x5a\x0\x5b\x0\x5c\x0\x5d\x0\x5e\x0\x5f\x0\x60\x0\x61\x0\x62\x0\x63\x0\x64\x0\x65\x0\x66\x0\x67\x0\x68\x0\x69\x0\x6a\x0\x6b\x0\x6c\x0\x6d\x0\x6e\x0\x6f\x0\x70\x0\x71\x0\x72\x0\x73\x0\x74\x0\x75\x0\x76\x0\x77\x0\x78\x0\x79\x0\x7a\x0\x7b\x0\x7c\x0\x7d\x0\x7e\x0\x7f\x0\xc7\x0\xfc\x0\xe9\x0\xe2\x0\xe4\x0\xe0\x0\xe5\x0\xe7\x0\xea\x0\xeb\x0\xe8\x0\xd0\x0\xf0\x0\xde\x0\xc4\x0\xc5\x0\xc9\x0\xe6\x0\xc6\x0\xf4\x0\xf6\x0\xfe\x0\xfb\x0\xdd\x0\xfd\x0\xd6\x0\xdc\x0\xf8\x0\xa3\x0\xd8\x0\xa7\x20\x92\x1\xe1\x0\xed\x0\xf3\x0\xfa\x0\xc1\x0\xcd\x0\xd3\x0\xda\x0\xbf\x0\x10\x23\xac\x0\xbd\x0\xbc\x0\xa1\x0\xab\x0\xbb\x0\x91\x25\x92\x25\x93\x25\x2\x25\x24\x25\x61\x25\x62\x25\x56\x25\x55\x25\x63\x25\x51\x25\x57\x25\x5d\x25\x5c\x25\x5b\x25\x10\x25\x14\x25\x34\x25\x2c\x25\x1c\x25\x0\x25\x3c\x25\x5e\x25\x5f\x25\x5a\x25\x54\x25\x69\x25\x66\x25\x60\x25\x50\x25\x6c\x25\x67\x25\x68\x25\x64\x25\x65\x25\x59\x25\x58\x25\x52\x25\x53\x25\x6b\x25\x6a\x25\x18\x25\xc\x25\x88\x25\x84\x25\x8c\x25\x90\x25\x80\x25\xb1\x3\xdf\x0\x93\x3\xc0\x3\xa3\x3\xc3\x3\xb5\x0\xc4\x3\xa6\x3\x98\x3\xa9\x3\xb4\x3\x1e\x22\xc6\x3\xb5\x3\x29\x22\x61\x22\xb1\x0\x65\x22\x64\x22\x20\x23\x21\x23\xf7\x0\x48\x22\xb0\x0\x19\x22\xb7\x0\x1a\x22\x7f\x20\xb2\x0\xa0\x25\xa0\x0"#
+     , encoderArray = 
+ CompactArray {
+        encoderIndices = ConvArray "\x0\x0\x40\x0\x80\x0\xc0\x0\x0\x1\x0\x1\x40\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x80\x1\xc0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x2\x40\x2\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x80\x2\xc0\x2\x0\x1\x0\x1\x0\x3\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x40\x3\x80\x3\xc0\x3"#
+        , encoderValues = ConvArray "\x0\x1\x2\x3\x4\x5\x6\x7\x8\x9\xa\xb\xc\xd\xe\xf\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x1a\x1b\x1c\x1d\x1e\x1f\x20\x21\x22\x23\x24\x25\x26\x27\x28\x29\x2a\x2b\x2c\x2d\x2e\x2f\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x3a\x3b\x3c\x3d\x3e\x3f\x40\x41\x42\x43\x44\x45\x46\x47\x48\x49\x4a\x4b\x4c\x4d\x4e\x4f\x50\x51\x52\x53\x54\x55\x56\x57\x58\x59\x5a\x5b\x5c\x5d\x5e\x5f\x60\x61\x62\x63\x64\x65\x66\x67\x68\x69\x6a\x6b\x6c\x6d\x6e\x6f\x70\x71\x72\x73\x74\x75\x76\x77\x78\x79\x7a\x7b\x7c\x7d\x7e\x7f\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xff\xad\x0\x9c\x0\x0\x0\x0\x0\x0\x0\xae\xaa\x0\x0\x0\xf8\xf1\xfd\x0\x0\xe6\x0\xfa\x0\x0\x0\xaf\xac\xab\x0\xa8\x0\xa4\x0\x0\x8e\x8f\x92\x80\x0\x90\x0\x0\x0\xa5\x0\x0\x8b\x0\x0\xa6\x0\x0\x99\x0\x9d\x0\xa7\x0\x9a\x97\x8d\xe1\x85\xa0\x83\x0\x84\x86\x91\x87\x8a\x82\x88\x89\x0\xa1\x0\x0\x8c\x0\x0\xa2\x93\x0\x94\xf6\x9b\x0\xa3\x96\x81\x98\x95\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x9f\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xe2\x0\x0\x0\x0\xe9\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xe4\x0\x0\xe8\x0\x0\xea\x0\x0\x0\x0\x0\x0\x0\xe0\x0\x0\xeb\xee\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xe3\x0\x0\xe5\xe7\x0\xed\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xfc\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x9e\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xf9\xfb\x0\x0\x0\xec\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xef\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xf7\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xf0\x0\x0\xf3\xf2\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xa9\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xf4\xf5\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xc4\x0\xb3\x0\x0\x0\x0\x0\x0\x0\x0\x0\xda\x0\x0\x0\xbf\x0\x0\x0\xc0\x0\x0\x0\xd9\x0\x0\x0\xc3\x0\x0\x0\x0\x0\x0\x0\xb4\x0\x0\x0\x0\x0\x0\x0\xc2\x0\x0\x0\x0\x0\x0\x0\xc1\x0\x0\x0\x0\x0\x0\x0\xc5\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xcd\xba\xd5\xd6\xc9\xb8\xb7\xbb\xd4\xd3\xc8\xbe\xbd\xbc\xc6\xc7\xcc\xb5\xb6\xb9\xd1\xd2\xcb\xcf\xd0\xca\xd8\xd7\xce\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xdf\x0\x0\x0\xdc\x0\x0\x0\xdb\x0\x0\x0\xdd\x0\x0\x0\xde\xb0\xb1\xb2\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xfe"#
+        , encoderMax = '\9632'
+        }
+
+   }
+    )
+
+    ,
+    (862, SingleByteCP {
+     decoderArray = ConvArray "\x0\x0\x1\x0\x2\x0\x3\x0\x4\x0\x5\x0\x6\x0\x7\x0\x8\x0\x9\x0\xa\x0\xb\x0\xc\x0\xd\x0\xe\x0\xf\x0\x10\x0\x11\x0\x12\x0\x13\x0\x14\x0\x15\x0\x16\x0\x17\x0\x18\x0\x19\x0\x1a\x0\x1b\x0\x1c\x0\x1d\x0\x1e\x0\x1f\x0\x20\x0\x21\x0\x22\x0\x23\x0\x24\x0\x25\x0\x26\x0\x27\x0\x28\x0\x29\x0\x2a\x0\x2b\x0\x2c\x0\x2d\x0\x2e\x0\x2f\x0\x30\x0\x31\x0\x32\x0\x33\x0\x34\x0\x35\x0\x36\x0\x37\x0\x38\x0\x39\x0\x3a\x0\x3b\x0\x3c\x0\x3d\x0\x3e\x0\x3f\x0\x40\x0\x41\x0\x42\x0\x43\x0\x44\x0\x45\x0\x46\x0\x47\x0\x48\x0\x49\x0\x4a\x0\x4b\x0\x4c\x0\x4d\x0\x4e\x0\x4f\x0\x50\x0\x51\x0\x52\x0\x53\x0\x54\x0\x55\x0\x56\x0\x57\x0\x58\x0\x59\x0\x5a\x0\x5b\x0\x5c\x0\x5d\x0\x5e\x0\x5f\x0\x60\x0\x61\x0\x62\x0\x63\x0\x64\x0\x65\x0\x66\x0\x67\x0\x68\x0\x69\x0\x6a\x0\x6b\x0\x6c\x0\x6d\x0\x6e\x0\x6f\x0\x70\x0\x71\x0\x72\x0\x73\x0\x74\x0\x75\x0\x76\x0\x77\x0\x78\x0\x79\x0\x7a\x0\x7b\x0\x7c\x0\x7d\x0\x7e\x0\x7f\x0\xd0\x5\xd1\x5\xd2\x5\xd3\x5\xd4\x5\xd5\x5\xd6\x5\xd7\x5\xd8\x5\xd9\x5\xda\x5\xdb\x5\xdc\x5\xdd\x5\xde\x5\xdf\x5\xe0\x5\xe1\x5\xe2\x5\xe3\x5\xe4\x5\xe5\x5\xe6\x5\xe7\x5\xe8\x5\xe9\x5\xea\x5\xa2\x0\xa3\x0\xa5\x0\xa7\x20\x92\x1\xe1\x0\xed\x0\xf3\x0\xfa\x0\xf1\x0\xd1\x0\xaa\x0\xba\x0\xbf\x0\x10\x23\xac\x0\xbd\x0\xbc\x0\xa1\x0\xab\x0\xbb\x0\x91\x25\x92\x25\x93\x25\x2\x25\x24\x25\x61\x25\x62\x25\x56\x25\x55\x25\x63\x25\x51\x25\x57\x25\x5d\x25\x5c\x25\x5b\x25\x10\x25\x14\x25\x34\x25\x2c\x25\x1c\x25\x0\x25\x3c\x25\x5e\x25\x5f\x25\x5a\x25\x54\x25\x69\x25\x66\x25\x60\x25\x50\x25\x6c\x25\x67\x25\x68\x25\x64\x25\x65\x25\x59\x25\x58\x25\x52\x25\x53\x25\x6b\x25\x6a\x25\x18\x25\xc\x25\x88\x25\x84\x25\x8c\x25\x90\x25\x80\x25\xb1\x3\xdf\x0\x93\x3\xc0\x3\xa3\x3\xc3\x3\xb5\x0\xc4\x3\xa6\x3\x98\x3\xa9\x3\xb4\x3\x1e\x22\xc6\x3\xb5\x3\x29\x22\x61\x22\xb1\x0\x65\x22\x64\x22\x20\x23\x21\x23\xf7\x0\x48\x22\xb0\x0\x19\x22\xb7\x0\x1a\x22\x7f\x20\xb2\x0\xa0\x25\xa0\x0"#
+     , encoderArray = 
+ CompactArray {
+        encoderIndices = ConvArray "\x0\x0\x40\x0\x80\x0\xc0\x0\x0\x1\x0\x1\x40\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x80\x1\xc0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x2\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x40\x2\x80\x2\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\xc0\x2\x0\x3\x0\x1\x0\x1\x40\x3\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x80\x3\xc0\x3\x0\x4"#
+        , encoderValues = ConvArray "\x0\x1\x2\x3\x4\x5\x6\x7\x8\x9\xa\xb\xc\xd\xe\xf\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x1a\x1b\x1c\x1d\x1e\x1f\x20\x21\x22\x23\x24\x25\x26\x27\x28\x29\x2a\x2b\x2c\x2d\x2e\x2f\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x3a\x3b\x3c\x3d\x3e\x3f\x40\x41\x42\x43\x44\x45\x46\x47\x48\x49\x4a\x4b\x4c\x4d\x4e\x4f\x50\x51\x52\x53\x54\x55\x56\x57\x58\x59\x5a\x5b\x5c\x5d\x5e\x5f\x60\x61\x62\x63\x64\x65\x66\x67\x68\x69\x6a\x6b\x6c\x6d\x6e\x6f\x70\x71\x72\x73\x74\x75\x76\x77\x78\x79\x7a\x7b\x7c\x7d\x7e\x7f\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xff\xad\x9b\x9c\x0\x9d\x0\x0\x0\x0\xa6\xae\xaa\x0\x0\x0\xf8\xf1\xfd\x0\x0\xe6\x0\xfa\x0\x0\xa7\xaf\xac\xab\x0\xa8\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xa5\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xe1\x0\xa0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xa1\x0\x0\x0\xa4\x0\xa2\x0\x0\x0\xf6\x0\x0\xa3\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x9f\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xe2\x0\x0\x0\x0\xe9\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xe4\x0\x0\xe8\x0\x0\xea\x0\x0\x0\x0\x0\x0\x0\xe0\x0\x0\xeb\xee\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xe3\x0\x0\xe5\xe7\x0\xed\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x80\x81\x82\x83\x84\x85\x86\x87\x88\x89\x8a\x8b\x8c\x8d\x8e\x8f\x90\x91\x92\x93\x94\x95\x96\x97\x98\x99\x9a\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xfc\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x9e\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xf9\xfb\x0\x0\x0\xec\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xef\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xf7\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xf0\x0\x0\xf3\xf2\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xa9\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xf4\xf5\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xc4\x0\xb3\x0\x0\x0\x0\x0\x0\x0\x0\x0\xda\x0\x0\x0\xbf\x0\x0\x0\xc0\x0\x0\x0\xd9\x0\x0\x0\xc3\x0\x0\x0\x0\x0\x0\x0\xb4\x0\x0\x0\x0\x0\x0\x0\xc2\x0\x0\x0\x0\x0\x0\x0\xc1\x0\x0\x0\x0\x0\x0\x0\xc5\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xcd\xba\xd5\xd6\xc9\xb8\xb7\xbb\xd4\xd3\xc8\xbe\xbd\xbc\xc6\xc7\xcc\xb5\xb6\xb9\xd1\xd2\xcb\xcf\xd0\xca\xd8\xd7\xce\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xdf\x0\x0\x0\xdc\x0\x0\x0\xdb\x0\x0\x0\xdd\x0\x0\x0\xde\xb0\xb1\xb2\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xfe"#
+        , encoderMax = '\9632'
+        }
+
+   }
+    )
+
+    ,
+    (863, SingleByteCP {
+     decoderArray = ConvArray "\x0\x0\x1\x0\x2\x0\x3\x0\x4\x0\x5\x0\x6\x0\x7\x0\x8\x0\x9\x0\xa\x0\xb\x0\xc\x0\xd\x0\xe\x0\xf\x0\x10\x0\x11\x0\x12\x0\x13\x0\x14\x0\x15\x0\x16\x0\x17\x0\x18\x0\x19\x0\x1a\x0\x1b\x0\x1c\x0\x1d\x0\x1e\x0\x1f\x0\x20\x0\x21\x0\x22\x0\x23\x0\x24\x0\x25\x0\x26\x0\x27\x0\x28\x0\x29\x0\x2a\x0\x2b\x0\x2c\x0\x2d\x0\x2e\x0\x2f\x0\x30\x0\x31\x0\x32\x0\x33\x0\x34\x0\x35\x0\x36\x0\x37\x0\x38\x0\x39\x0\x3a\x0\x3b\x0\x3c\x0\x3d\x0\x3e\x0\x3f\x0\x40\x0\x41\x0\x42\x0\x43\x0\x44\x0\x45\x0\x46\x0\x47\x0\x48\x0\x49\x0\x4a\x0\x4b\x0\x4c\x0\x4d\x0\x4e\x0\x4f\x0\x50\x0\x51\x0\x52\x0\x53\x0\x54\x0\x55\x0\x56\x0\x57\x0\x58\x0\x59\x0\x5a\x0\x5b\x0\x5c\x0\x5d\x0\x5e\x0\x5f\x0\x60\x0\x61\x0\x62\x0\x63\x0\x64\x0\x65\x0\x66\x0\x67\x0\x68\x0\x69\x0\x6a\x0\x6b\x0\x6c\x0\x6d\x0\x6e\x0\x6f\x0\x70\x0\x71\x0\x72\x0\x73\x0\x74\x0\x75\x0\x76\x0\x77\x0\x78\x0\x79\x0\x7a\x0\x7b\x0\x7c\x0\x7d\x0\x7e\x0\x7f\x0\xc7\x0\xfc\x0\xe9\x0\xe2\x0\xc2\x0\xe0\x0\xb6\x0\xe7\x0\xea\x0\xeb\x0\xe8\x0\xef\x0\xee\x0\x17\x20\xc0\x0\xa7\x0\xc9\x0\xc8\x0\xca\x0\xf4\x0\xcb\x0\xcf\x0\xfb\x0\xf9\x0\xa4\x0\xd4\x0\xdc\x0\xa2\x0\xa3\x0\xd9\x0\xdb\x0\x92\x1\xa6\x0\xb4\x0\xf3\x0\xfa\x0\xa8\x0\xb8\x0\xb3\x0\xaf\x0\xce\x0\x10\x23\xac\x0\xbd\x0\xbc\x0\xbe\x0\xab\x0\xbb\x0\x91\x25\x92\x25\x93\x25\x2\x25\x24\x25\x61\x25\x62\x25\x56\x25\x55\x25\x63\x25\x51\x25\x57\x25\x5d\x25\x5c\x25\x5b\x25\x10\x25\x14\x25\x34\x25\x2c\x25\x1c\x25\x0\x25\x3c\x25\x5e\x25\x5f\x25\x5a\x25\x54\x25\x69\x25\x66\x25\x60\x25\x50\x25\x6c\x25\x67\x25\x68\x25\x64\x25\x65\x25\x59\x25\x58\x25\x52\x25\x53\x25\x6b\x25\x6a\x25\x18\x25\xc\x25\x88\x25\x84\x25\x8c\x25\x90\x25\x80\x25\xb1\x3\xdf\x0\x93\x3\xc0\x3\xa3\x3\xc3\x3\xb5\x0\xc4\x3\xa6\x3\x98\x3\xa9\x3\xb4\x3\x1e\x22\xc6\x3\xb5\x3\x29\x22\x61\x22\xb1\x0\x65\x22\x64\x22\x20\x23\x21\x23\xf7\x0\x48\x22\xb0\x0\x19\x22\xb7\x0\x1a\x22\x7f\x20\xb2\x0\xa0\x25\xa0\x0"#
+     , encoderArray = 
+ CompactArray {
+        encoderIndices = ConvArray "\x0\x0\x40\x0\x80\x0\xc0\x0\x0\x1\x0\x1\x40\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x80\x1\xc0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x2\x40\x2\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x80\x2\xc0\x2\x0\x1\x0\x1\x0\x3\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x40\x3\x80\x3\xc0\x3"#
+        , encoderValues = ConvArray "\x0\x1\x2\x3\x4\x5\x6\x7\x8\x9\xa\xb\xc\xd\xe\xf\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x1a\x1b\x1c\x1d\x1e\x1f\x20\x21\x22\x23\x24\x25\x26\x27\x28\x29\x2a\x2b\x2c\x2d\x2e\x2f\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x3a\x3b\x3c\x3d\x3e\x3f\x40\x41\x42\x43\x44\x45\x46\x47\x48\x49\x4a\x4b\x4c\x4d\x4e\x4f\x50\x51\x52\x53\x54\x55\x56\x57\x58\x59\x5a\x5b\x5c\x5d\x5e\x5f\x60\x61\x62\x63\x64\x65\x66\x67\x68\x69\x6a\x6b\x6c\x6d\x6e\x6f\x70\x71\x72\x73\x74\x75\x76\x77\x78\x79\x7a\x7b\x7c\x7d\x7e\x7f\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xff\x0\x9b\x9c\x98\x0\xa0\x8f\xa4\x0\x0\xae\xaa\x0\x0\xa7\xf8\xf1\xfd\xa6\xa1\xe6\x86\xfa\xa5\x0\x0\xaf\xac\xab\xad\x0\x8e\x0\x84\x0\x0\x0\x0\x80\x91\x90\x92\x94\x0\x0\xa8\x95\x0\x0\x0\x0\x99\x0\x0\x0\x0\x9d\x0\x9e\x9a\x0\x0\xe1\x85\x0\x83\x0\x0\x0\x0\x87\x8a\x82\x88\x89\x0\x0\x8c\x8b\x0\x0\x0\xa2\x93\x0\x0\xf6\x0\x97\xa3\x96\x81\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x9f\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xe2\x0\x0\x0\x0\xe9\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xe4\x0\x0\xe8\x0\x0\xea\x0\x0\x0\x0\x0\x0\x0\xe0\x0\x0\xeb\xee\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xe3\x0\x0\xe5\xe7\x0\xed\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x8d\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xfc\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xf9\xfb\x0\x0\x0\xec\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xef\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xf7\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xf0\x0\x0\xf3\xf2\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xa9\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xf4\xf5\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xc4\x0\xb3\x0\x0\x0\x0\x0\x0\x0\x0\x0\xda\x0\x0\x0\xbf\x0\x0\x0\xc0\x0\x0\x0\xd9\x0\x0\x0\xc3\x0\x0\x0\x0\x0\x0\x0\xb4\x0\x0\x0\x0\x0\x0\x0\xc2\x0\x0\x0\x0\x0\x0\x0\xc1\x0\x0\x0\x0\x0\x0\x0\xc5\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xcd\xba\xd5\xd6\xc9\xb8\xb7\xbb\xd4\xd3\xc8\xbe\xbd\xbc\xc6\xc7\xcc\xb5\xb6\xb9\xd1\xd2\xcb\xcf\xd0\xca\xd8\xd7\xce\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xdf\x0\x0\x0\xdc\x0\x0\x0\xdb\x0\x0\x0\xdd\x0\x0\x0\xde\xb0\xb1\xb2\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xfe"#
+        , encoderMax = '\9632'
+        }
+
+   }
+    )
+
+    ,
+    (864, SingleByteCP {
+     decoderArray = ConvArray "\x0\x0\x1\x0\x2\x0\x3\x0\x4\x0\x5\x0\x6\x0\x7\x0\x8\x0\x9\x0\xa\x0\xb\x0\xc\x0\xd\x0\xe\x0\xf\x0\x10\x0\x11\x0\x12\x0\x13\x0\x14\x0\x15\x0\x16\x0\x17\x0\x18\x0\x19\x0\x1a\x0\x1b\x0\x1c\x0\x1d\x0\x1e\x0\x1f\x0\x20\x0\x21\x0\x22\x0\x23\x0\x24\x0\x6a\x6\x26\x0\x27\x0\x28\x0\x29\x0\x2a\x0\x2b\x0\x2c\x0\x2d\x0\x2e\x0\x2f\x0\x30\x0\x31\x0\x32\x0\x33\x0\x34\x0\x35\x0\x36\x0\x37\x0\x38\x0\x39\x0\x3a\x0\x3b\x0\x3c\x0\x3d\x0\x3e\x0\x3f\x0\x40\x0\x41\x0\x42\x0\x43\x0\x44\x0\x45\x0\x46\x0\x47\x0\x48\x0\x49\x0\x4a\x0\x4b\x0\x4c\x0\x4d\x0\x4e\x0\x4f\x0\x50\x0\x51\x0\x52\x0\x53\x0\x54\x0\x55\x0\x56\x0\x57\x0\x58\x0\x59\x0\x5a\x0\x5b\x0\x5c\x0\x5d\x0\x5e\x0\x5f\x0\x60\x0\x61\x0\x62\x0\x63\x0\x64\x0\x65\x0\x66\x0\x67\x0\x68\x0\x69\x0\x6a\x0\x6b\x0\x6c\x0\x6d\x0\x6e\x0\x6f\x0\x70\x0\x71\x0\x72\x0\x73\x0\x74\x0\x75\x0\x76\x0\x77\x0\x78\x0\x79\x0\x7a\x0\x7b\x0\x7c\x0\x7d\x0\x7e\x0\x7f\x0\xb0\x0\xb7\x0\x19\x22\x1a\x22\x92\x25\x0\x25\x2\x25\x3c\x25\x24\x25\x2c\x25\x1c\x25\x34\x25\x10\x25\xc\x25\x14\x25\x18\x25\xb2\x3\x1e\x22\xc6\x3\xb1\x0\xbd\x0\xbc\x0\x48\x22\xab\x0\xbb\x0\xf7\xfe\xf8\xfe\x0\x0\x0\x0\xfb\xfe\xfc\xfe\x0\x0\xa0\x0\xad\x0\x82\xfe\xa3\x0\xa4\x0\x84\xfe\x0\x0\x0\x0\x8e\xfe\x8f\xfe\x95\xfe\x99\xfe\xc\x6\x9d\xfe\xa1\xfe\xa5\xfe\x60\x6\x61\x6\x62\x6\x63\x6\x64\x6\x65\x6\x66\x6\x67\x6\x68\x6\x69\x6\xd1\xfe\x1b\x6\xb1\xfe\xb5\xfe\xb9\xfe\x1f\x6\xa2\x0\x80\xfe\x81\xfe\x83\xfe\x85\xfe\xca\xfe\x8b\xfe\x8d\xfe\x91\xfe\x93\xfe\x97\xfe\x9b\xfe\x9f\xfe\xa3\xfe\xa7\xfe\xa9\xfe\xab\xfe\xad\xfe\xaf\xfe\xb3\xfe\xb7\xfe\xbb\xfe\xbf\xfe\xc1\xfe\xc5\xfe\xcb\xfe\xcf\xfe\xa6\x0\xac\x0\xf7\x0\xd7\x0\xc9\xfe\x40\x6\xd3\xfe\xd7\xfe\xdb\xfe\xdf\xfe\xe3\xfe\xe7\xfe\xeb\xfe\xed\xfe\xef\xfe\xf3\xfe\xbd\xfe\xcc\xfe\xce\xfe\xcd\xfe\xe1\xfe\x7d\xfe\x51\x6\xe5\xfe\xe9\xfe\xec\xfe\xf0\xfe\xf2\xfe\xd0\xfe\xd5\xfe\xf5\xfe\xf6\xfe\xdd\xfe\xd9\xfe\xf1\xfe\xa0\x25\x0\x0"#
+     , encoderArray = 
+ CompactArray {
+        encoderIndices = ConvArray "\x0\x0\x40\x0\x80\x0\xc0\x0\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x40\x1\x80\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\xc0\x1\x0\x2\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x40\x2\x80\x2\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\xc0\x2\x0\x1\x0\x3\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x40\x3\x80\x3\xc0\x3"#
+        , encoderValues = ConvArray "\x0\x1\x2\x3\x4\x5\x6\x7\x8\x9\xa\xb\xc\xd\xe\xf\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x1a\x1b\x1c\x1d\x1e\x1f\x20\x21\x22\x23\x24\x0\x26\x27\x28\x29\x2a\x2b\x2c\x2d\x2e\x2f\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x3a\x3b\x3c\x3d\x3e\x3f\x40\x41\x42\x43\x44\x45\x46\x47\x48\x49\x4a\x4b\x4c\x4d\x4e\x4f\x50\x51\x52\x53\x54\x55\x56\x57\x58\x59\x5a\x5b\x5c\x5d\x5e\x5f\x60\x61\x62\x63\x64\x65\x66\x67\x68\x69\x6a\x6b\x6c\x6d\x6e\x6f\x70\x71\x72\x73\x74\x75\x76\x77\x78\x79\x7a\x7b\x7c\x7d\x7e\x7f\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xa0\x0\xc0\xa3\xa4\x0\xdb\x0\x0\x0\x0\x97\xdc\xa1\x0\x0\x80\x93\x0\x0\x0\x0\x0\x81\x0\x0\x0\x98\x95\x94\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xde\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xdd\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x90\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x92\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xac\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xbb\x0\x0\x0\xbf\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xe0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xf1\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xb0\xb1\xb2\xb3\xb4\xb5\xb6\xb7\xb8\xb9\x25\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x82\x83\x0\x0\x0\x91\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x96\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x85\x0\x86\x0\x0\x0\x0\x0\x0\x0\x0\x0\x8d\x0\x0\x0\x8c\x0\x0\x0\x8e\x0\x0\x0\x8f\x0\x0\x0\x8a\x0\x0\x0\x0\x0\x0\x0\x88\x0\x0\x0\x0\x0\x0\x0\x89\x0\x0\x0\x0\x0\x0\x0\x8b\x0\x0\x0\x0\x0\x0\x0\x87\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x84\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xfe\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xf0\x0\x0\xc1\xc2\xa2\xc3\xa5\xc4\x0\x0\x0\x0\x0\xc6\x0\xc7\xa8\xa9\x0\xc8\x0\xc9\x0\xaa\x0\xca\x0\xab\x0\xcb\x0\xad\x0\xcc\x0\xae\x0\xcd\x0\xaf\x0\xce\x0\xcf\x0\xd0\x0\xd1\x0\xd2\x0\xbc\x0\xd3\x0\xbd\x0\xd4\x0\xbe\x0\xd5\x0\xeb\x0\xd6\x0\xd7\x0\x0\x0\xd8\x0\x0\x0\xdf\xc5\xd9\xec\xee\xed\xda\xf7\xba\x0\xe1\x0\xf8\x0\xe2\x0\xfc\x0\xe3\x0\xfb\x0\xe4\x0\xef\x0\xe5\x0\xf2\x0\xe6\x0\xf3\x0\xe7\xf4\xe8\x0\xe9\xf5\xfd\xf6\xea\x0\xf9\xfa\x99\x9a\x0\x0\x9d\x9e"#
+        , encoderMax = '\65276'
+        }
+
+   }
+    )
+
+    ,
+    (865, SingleByteCP {
+     decoderArray = ConvArray "\x0\x0\x1\x0\x2\x0\x3\x0\x4\x0\x5\x0\x6\x0\x7\x0\x8\x0\x9\x0\xa\x0\xb\x0\xc\x0\xd\x0\xe\x0\xf\x0\x10\x0\x11\x0\x12\x0\x13\x0\x14\x0\x15\x0\x16\x0\x17\x0\x18\x0\x19\x0\x1a\x0\x1b\x0\x1c\x0\x1d\x0\x1e\x0\x1f\x0\x20\x0\x21\x0\x22\x0\x23\x0\x24\x0\x25\x0\x26\x0\x27\x0\x28\x0\x29\x0\x2a\x0\x2b\x0\x2c\x0\x2d\x0\x2e\x0\x2f\x0\x30\x0\x31\x0\x32\x0\x33\x0\x34\x0\x35\x0\x36\x0\x37\x0\x38\x0\x39\x0\x3a\x0\x3b\x0\x3c\x0\x3d\x0\x3e\x0\x3f\x0\x40\x0\x41\x0\x42\x0\x43\x0\x44\x0\x45\x0\x46\x0\x47\x0\x48\x0\x49\x0\x4a\x0\x4b\x0\x4c\x0\x4d\x0\x4e\x0\x4f\x0\x50\x0\x51\x0\x52\x0\x53\x0\x54\x0\x55\x0\x56\x0\x57\x0\x58\x0\x59\x0\x5a\x0\x5b\x0\x5c\x0\x5d\x0\x5e\x0\x5f\x0\x60\x0\x61\x0\x62\x0\x63\x0\x64\x0\x65\x0\x66\x0\x67\x0\x68\x0\x69\x0\x6a\x0\x6b\x0\x6c\x0\x6d\x0\x6e\x0\x6f\x0\x70\x0\x71\x0\x72\x0\x73\x0\x74\x0\x75\x0\x76\x0\x77\x0\x78\x0\x79\x0\x7a\x0\x7b\x0\x7c\x0\x7d\x0\x7e\x0\x7f\x0\xc7\x0\xfc\x0\xe9\x0\xe2\x0\xe4\x0\xe0\x0\xe5\x0\xe7\x0\xea\x0\xeb\x0\xe8\x0\xef\x0\xee\x0\xec\x0\xc4\x0\xc5\x0\xc9\x0\xe6\x0\xc6\x0\xf4\x0\xf6\x0\xf2\x0\xfb\x0\xf9\x0\xff\x0\xd6\x0\xdc\x0\xf8\x0\xa3\x0\xd8\x0\xa7\x20\x92\x1\xe1\x0\xed\x0\xf3\x0\xfa\x0\xf1\x0\xd1\x0\xaa\x0\xba\x0\xbf\x0\x10\x23\xac\x0\xbd\x0\xbc\x0\xa1\x0\xab\x0\xa4\x0\x91\x25\x92\x25\x93\x25\x2\x25\x24\x25\x61\x25\x62\x25\x56\x25\x55\x25\x63\x25\x51\x25\x57\x25\x5d\x25\x5c\x25\x5b\x25\x10\x25\x14\x25\x34\x25\x2c\x25\x1c\x25\x0\x25\x3c\x25\x5e\x25\x5f\x25\x5a\x25\x54\x25\x69\x25\x66\x25\x60\x25\x50\x25\x6c\x25\x67\x25\x68\x25\x64\x25\x65\x25\x59\x25\x58\x25\x52\x25\x53\x25\x6b\x25\x6a\x25\x18\x25\xc\x25\x88\x25\x84\x25\x8c\x25\x90\x25\x80\x25\xb1\x3\xdf\x0\x93\x3\xc0\x3\xa3\x3\xc3\x3\xb5\x0\xc4\x3\xa6\x3\x98\x3\xa9\x3\xb4\x3\x1e\x22\xc6\x3\xb5\x3\x29\x22\x61\x22\xb1\x0\x65\x22\x64\x22\x20\x23\x21\x23\xf7\x0\x48\x22\xb0\x0\x19\x22\xb7\x0\x1a\x22\x7f\x20\xb2\x0\xa0\x25\xa0\x0"#
+     , encoderArray = 
+ CompactArray {
+        encoderIndices = ConvArray "\x0\x0\x40\x0\x80\x0\xc0\x0\x0\x1\x0\x1\x40\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x80\x1\xc0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x2\x40\x2\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x80\x2\xc0\x2\x0\x1\x0\x1\x0\x3\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x0\x1\x40\x3\x80\x3\xc0\x3"#
+        , encoderValues = ConvArray "\x0\x1\x2\x3\x4\x5\x6\x7\x8\x9\xa\xb\xc\xd\xe\xf\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x1a\x1b\x1c\x1d\x1e\x1f\x20\x21\x22\x23\x24\x25\x26\x27\x28\x29\x2a\x2b\x2c\x2d\x2e\x2f\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x3a\x3b\x3c\x3d\x3e\x3f\x40\x41\x42\x43\x44\x45\x46\x47\x48\x49\x4a\x4b\x4c\x4d\x4e\x4f\x50\x51\x52\x53\x54\x55\x56\x57\x58\x59\x5a\x5b\x5c\x5d\x5e\x5f\x60\x61\x62\x63\x64\x65\x66\x67\x68\x69\x6a\x6b\x6c\x6d\x6e\x6f\x70\x71\x72\x73\x74\x75\x76\x77\x78\x79\x7a\x7b\x7c\x7d\x7e\x7f\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xff\xad\x0\x9c\xaf\x0\x0\x0\x0\x0\xa6\xae\xaa\x0\x0\x0\xf8\xf1\xfd\x0\x0\xe6\x0\xfa\x0\x0\xa7\x0\xac\xab\x0\xa8\x0\x0\x0\x0\x8e\x8f\x92\x80\x0\x90\x0\x0\x0\x0\x0\x0\x0\xa5\x0\x0\x0\x0\x99\x0\x9d\x0\x0\x0\x9a\x0\x0\xe1\x85\xa0\x83\x0\x84\x86\x91\x87\x8a\x82\x88\x89\x8d\xa1\x8c\x8b\x0\xa4\x95\xa2\x93\x0\x94\xf6\x9b\x97\xa3\x96\x81\x0\x0\x98\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x9f\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xe2\x0\x0\x0\x0\xe9\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xe4\x0\x0\xe8\x0\x0\xea\x0\x0\x0\x0\x0\x0\x0\xe0\x0\x0\xeb\xee\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xe3\x0\x0\xe5\xe7\x0\xed\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xfc\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x9e\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xf9\xfb\x0\x0\x0\xec\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xef\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xf7\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xf0\x0\x0\xf3\xf2\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xa9\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xf4\xf5\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xc4\x0\xb3\x0\x0\x0\x0\x0\x0\x0\x0\x0\xda\x0\x0\x0\xbf\x0\x0\x0\xc0\x0\x0\x0\xd9\x0\x0\x0\xc3\x0\x0\x0\x0\x0\x0\x0\xb4\x0\x0\x0\x0\x0\x0\x0\xc2\x0\x0\x0\x0\x0\x0\x0\xc1\x0\x0\x0\x0\x0\x0\x0\xc5\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xcd\xba\xd5\xd6\xc9\xb8\xb7\xbb\xd4\xd3\xc8\xbe\xbd\xbc\xc6\xc7\xcc\xb5\xb6\xb9\xd1\xd2\xcb\xcf\xd0\xca\xd8\xd7\xce\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xdf\x0\x0\x0\xdc\x0\x0\x0\xdb\x0\x0\x0\xdd\x0\x0\x0\xde\xb0\xb1\xb2\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xfe"#
+        , encoderMax = '\9632'
+        }
+
+   }
+    )
+
+    ,
+    (866, SingleByteCP {
+     decoderArray = ConvArray "\x0\x0\x1\x0\x2\x0\x3\x0\x4\x0\x5\x0\x6\x0\x7\x0\x8\x0\x9\x0\xa\x0\xb\x0\xc\x0\xd\x0\xe\x0\xf\x0\x10\x0\x11\x0\x12\x0\x13\x0\x14\x0\x15\x0\x16\x0\x17\x0\x18\x0\x19\x0\x1a\x0\x1b\x0\x1c\x0\x1d\x0\x1e\x0\x1f\x0\x20\x0\x21\x0\x22\x0\x23\x0\x24\x0\x25\x0\x26\x0\x27\x0\x28\x0\x29\x0\x2a\x0\x2b\x0\x2c\x0\x2d\x0\x2e\x0\x2f\x0\x30\x0\x31\x0\x32\x0\x33\x0\x34\x0\x35\x0\x36\x0\x37\x0\x38\x0\x39\x0\x3a\x0\x3b\x0\x3c\x0\x3d\x0\x3e\x0\x3f\x0\x40\x0\x41\x0\x42\x0\x43\x0\x44\x0\x45\x0\x46\x0\x47\x0\x48\x0\x49\x0\x4a\x0\x4b\x0\x4c\x0\x4d\x0\x4e\x0\x4f\x0\x50\x0\x51\x0\x52\x0\x53\x0\x54\x0\x55\x0\x56\x0\x57\x0\x58\x0\x59\x0\x5a\x0\x5b\x0\x5c\x0\x5d\x0\x5e\x0\x5f\x0\x60\x0\x61\x0\x62\x0\x63\x0\x64\x0\x65\x0\x66\x0\x67\x0\x68\x0\x69\x0\x6a\x0\x6b\x0\x6c\x0\x6d\x0\x6e\x0\x6f\x0\x70\x0\x71\x0\x72\x0\x73\x0\x74\x0\x75\x0\x76\x0\x77\x0\x78\x0\x79\x0\x7a\x0\x7b\x0\x7c\x0\x7d\x0\x7e\x0\x7f\x0\x10\x4\x11\x4\x12\x4\x13\x4\x14\x4\x15\x4\x16\x4\x17\x4\x18\x4\x19\x4\x1a\x4\x1b\x4\x1c\x4\x1d\x4\x1e\x4\x1f\x4\x20\x4\x21\x4\x22\x4\x23\x4\x24\x4\x25\x4\x26\x4\x27\x4\x28\x4\x29\x4\x2a\x4\x2b\x4\x2c\x4\x2d\x4\x2e\x4\x2f\x4\x30\x4\x31\x4\x32\x4\x33\x4\x34\x4\x35\x4\x36\x4\x37\x4\x38\x4\x39\x4\x3a\x4\x3b\x4\x3c\x4\x3d\x4\x3e\x4\x3f\x4\x91\x25\x92\x25\x93\x25\x2\x25\x24\x25\x61\x25\x62\x25\x56\x25\x55\x25\x63\x25\x51\x25\x57\x25\x5d\x25\x5c\x25\x5b\x25\x10\x25\x14\x25\x34\x25\x2c\x25\x1c\x25\x0\x25\x3c\x25\x5e\x25\x5f\x25\x5a\x25\x54\x25\x69\x25\x66\x25\x60\x25\x50\x25\x6c\x25\x67\x25\x68\x25\x64\x25\x65\x25\x59\x25\x58\x25\x52\x25\x53\x25\x6b\x25\x6a\x25\x18\x25\xc\x25\x88\x25\x84\x25\x8c\x25\x90\x25\x80\x25\x40\x4\x41\x4\x42\x4\x43\x4\x44\x4\x45\x4\x46\x4\x47\x4\x48\x4\x49\x4\x4a\x4\x4b\x4\x4c\x4\x4d\x4\x4e\x4\x4f\x4\x1\x4\x51\x4\x4\x4\x54\x4\x7\x4\x57\x4\xe\x4\x5e\x4\xb0\x0\x19\x22\xb7\x0\x1a\x22\x16\x21\xa4\x0\xa0\x25\xa0\x0"#
+     , encoderArray = 
+ CompactArray {
+        encoderIndices = ConvArray "\x0\x0\x40\x0\x80\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\x0\x1\x40\x1\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\x80\x1\xc0\x0\xc0\x0\xc0\x0\xc0\x1\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\x0\x2\x40\x2\x80\x2"#
+        , encoderValues = ConvArray "\x0\x1\x2\x3\x4\x5\x6\x7\x8\x9\xa\xb\xc\xd\xe\xf\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x1a\x1b\x1c\x1d\x1e\x1f\x20\x21\x22\x23\x24\x25\x26\x27\x28\x29\x2a\x2b\x2c\x2d\x2e\x2f\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x3a\x3b\x3c\x3d\x3e\x3f\x40\x41\x42\x43\x44\x45\x46\x47\x48\x49\x4a\x4b\x4c\x4d\x4e\x4f\x50\x51\x52\x53\x54\x55\x56\x57\x58\x59\x5a\x5b\x5c\x5d\x5e\x5f\x60\x61\x62\x63\x64\x65\x66\x67\x68\x69\x6a\x6b\x6c\x6d\x6e\x6f\x70\x71\x72\x73\x74\x75\x76\x77\x78\x79\x7a\x7b\x7c\x7d\x7e\x7f\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xff\x0\x0\x0\xfd\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xf8\x0\x0\x0\x0\x0\x0\xfa\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xf0\x0\x0\xf2\x0\x0\xf4\x0\x0\x0\x0\x0\x0\xf6\x0\x80\x81\x82\x83\x84\x85\x86\x87\x88\x89\x8a\x8b\x8c\x8d\x8e\x8f\x90\x91\x92\x93\x94\x95\x96\x97\x98\x99\x9a\x9b\x9c\x9d\x9e\x9f\xa0\xa1\xa2\xa3\xa4\xa5\xa6\xa7\xa8\xa9\xaa\xab\xac\xad\xae\xaf\xe0\xe1\xe2\xe3\xe4\xe5\xe6\xe7\xe8\xe9\xea\xeb\xec\xed\xee\xef\x0\xf1\x0\x0\xf3\x0\x0\xf5\x0\x0\x0\x0\x0\x0\xf7\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xfc\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xf9\xfb\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xc4\x0\xb3\x0\x0\x0\x0\x0\x0\x0\x0\x0\xda\x0\x0\x0\xbf\x0\x0\x0\xc0\x0\x0\x0\xd9\x0\x0\x0\xc3\x0\x0\x0\x0\x0\x0\x0\xb4\x0\x0\x0\x0\x0\x0\x0\xc2\x0\x0\x0\x0\x0\x0\x0\xc1\x0\x0\x0\x0\x0\x0\x0\xc5\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xcd\xba\xd5\xd6\xc9\xb8\xb7\xbb\xd4\xd3\xc8\xbe\xbd\xbc\xc6\xc7\xcc\xb5\xb6\xb9\xd1\xd2\xcb\xcf\xd0\xca\xd8\xd7\xce\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xdf\x0\x0\x0\xdc\x0\x0\x0\xdb\x0\x0\x0\xdd\x0\x0\x0\xde\xb0\xb1\xb2\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xfe"#
+        , encoderMax = '\9632'
+        }
+
+   }
+    )
+
+    ,
+    (869, SingleByteCP {
+     decoderArray = ConvArray "\x0\x0\x1\x0\x2\x0\x3\x0\x4\x0\x5\x0\x6\x0\x7\x0\x8\x0\x9\x0\xa\x0\xb\x0\xc\x0\xd\x0\xe\x0\xf\x0\x10\x0\x11\x0\x12\x0\x13\x0\x14\x0\x15\x0\x16\x0\x17\x0\x18\x0\x19\x0\x1a\x0\x1b\x0\x1c\x0\x1d\x0\x1e\x0\x1f\x0\x20\x0\x21\x0\x22\x0\x23\x0\x24\x0\x25\x0\x26\x0\x27\x0\x28\x0\x29\x0\x2a\x0\x2b\x0\x2c\x0\x2d\x0\x2e\x0\x2f\x0\x30\x0\x31\x0\x32\x0\x33\x0\x34\x0\x35\x0\x36\x0\x37\x0\x38\x0\x39\x0\x3a\x0\x3b\x0\x3c\x0\x3d\x0\x3e\x0\x3f\x0\x40\x0\x41\x0\x42\x0\x43\x0\x44\x0\x45\x0\x46\x0\x47\x0\x48\x0\x49\x0\x4a\x0\x4b\x0\x4c\x0\x4d\x0\x4e\x0\x4f\x0\x50\x0\x51\x0\x52\x0\x53\x0\x54\x0\x55\x0\x56\x0\x57\x0\x58\x0\x59\x0\x5a\x0\x5b\x0\x5c\x0\x5d\x0\x5e\x0\x5f\x0\x60\x0\x61\x0\x62\x0\x63\x0\x64\x0\x65\x0\x66\x0\x67\x0\x68\x0\x69\x0\x6a\x0\x6b\x0\x6c\x0\x6d\x0\x6e\x0\x6f\x0\x70\x0\x71\x0\x72\x0\x73\x0\x74\x0\x75\x0\x76\x0\x77\x0\x78\x0\x79\x0\x7a\x0\x7b\x0\x7c\x0\x7d\x0\x7e\x0\x7f\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x86\x3\x0\x0\xb7\x0\xac\x0\xa6\x0\x18\x20\x19\x20\x88\x3\x15\x20\x89\x3\x8a\x3\xaa\x3\x8c\x3\x0\x0\x0\x0\x8e\x3\xab\x3\xa9\x0\x8f\x3\xb2\x0\xb3\x0\xac\x3\xa3\x0\xad\x3\xae\x3\xaf\x3\xca\x3\x90\x3\xcc\x3\xcd\x3\x91\x3\x92\x3\x93\x3\x94\x3\x95\x3\x96\x3\x97\x3\xbd\x0\x98\x3\x99\x3\xab\x0\xbb\x0\x91\x25\x92\x25\x93\x25\x2\x25\x24\x25\x9a\x3\x9b\x3\x9c\x3\x9d\x3\x63\x25\x51\x25\x57\x25\x5d\x25\x9e\x3\x9f\x3\x10\x25\x14\x25\x34\x25\x2c\x25\x1c\x25\x0\x25\x3c\x25\xa0\x3\xa1\x3\x5a\x25\x54\x25\x69\x25\x66\x25\x60\x25\x50\x25\x6c\x25\xa3\x3\xa4\x3\xa5\x3\xa6\x3\xa7\x3\xa8\x3\xa9\x3\xb1\x3\xb2\x3\xb3\x3\x18\x25\xc\x25\x88\x25\x84\x25\xb4\x3\xb5\x3\x80\x25\xb6\x3\xb7\x3\xb8\x3\xb9\x3\xba\x3\xbb\x3\xbc\x3\xbd\x3\xbe\x3\xbf\x3\xc0\x3\xc1\x3\xc3\x3\xc2\x3\xc4\x3\x84\x3\xad\x0\xb1\x0\xc5\x3\xc6\x3\xc7\x3\xa7\x0\xc8\x3\x85\x3\xb0\x0\xa8\x0\xc9\x3\xcb\x3\xb0\x3\xce\x3\xa0\x25\xa0\x0"#
+     , encoderArray = 
+ CompactArray {
+        encoderIndices = ConvArray "\x0\x0\x40\x0\x80\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\x0\x1\x40\x1\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\x80\x1\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x1\x0\x2\x40\x2"#
+        , encoderValues = ConvArray "\x0\x1\x2\x3\x4\x5\x6\x7\x8\x9\xa\xb\xc\xd\xe\xf\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x1a\x1b\x1c\x1d\x1e\x1f\x20\x21\x22\x23\x24\x25\x26\x27\x28\x29\x2a\x2b\x2c\x2d\x2e\x2f\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x3a\x3b\x3c\x3d\x3e\x3f\x40\x41\x42\x43\x44\x45\x46\x47\x48\x49\x4a\x4b\x4c\x4d\x4e\x4f\x50\x51\x52\x53\x54\x55\x56\x57\x58\x59\x5a\x5b\x5c\x5d\x5e\x5f\x60\x61\x62\x63\x64\x65\x66\x67\x68\x69\x6a\x6b\x6c\x6d\x6e\x6f\x70\x71\x72\x73\x74\x75\x76\x77\x78\x79\x7a\x7b\x7c\x7d\x7e\x7f\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xff\x0\x0\x9c\x0\x0\x8a\xf5\xf9\x97\x0\xae\x89\xf0\x0\x0\xf8\xf1\x99\x9a\x0\x0\x0\x88\x0\x0\x0\xaf\x0\xab\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xef\xf7\x86\x0\x8d\x8f\x90\x0\x92\x0\x95\x98\xa1\xa4\xa5\xa6\xa7\xa8\xa9\xaa\xac\xad\xb5\xb6\xb7\xb8\xbd\xbe\xc6\xc7\x0\xcf\xd0\xd1\xd2\xd3\xd4\xd5\x91\x96\x9b\x9d\x9e\x9f\xfc\xd6\xd7\xd8\xdd\xde\xe0\xe1\xe2\xe3\xe4\xe5\xe6\xe7\xe8\xe9\xea\xeb\xed\xec\xee\xf2\xf3\xf4\xf6\xfa\xa0\xfb\xa2\xa3\xfd\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x8e\x0\x0\x8b\x8c\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xc4\x0\xb3\x0\x0\x0\x0\x0\x0\x0\x0\x0\xda\x0\x0\x0\xbf\x0\x0\x0\xc0\x0\x0\x0\xd9\x0\x0\x0\xc3\x0\x0\x0\x0\x0\x0\x0\xb4\x0\x0\x0\x0\x0\x0\x0\xc2\x0\x0\x0\x0\x0\x0\x0\xc1\x0\x0\x0\x0\x0\x0\x0\xc5\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xcd\xba\x0\x0\xc9\x0\x0\xbb\x0\x0\xc8\x0\x0\xbc\x0\x0\xcc\x0\x0\xb9\x0\x0\xcb\x0\x0\xca\x0\x0\xce\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xdf\x0\x0\x0\xdc\x0\x0\x0\xdb\x0\x0\x0\x0\x0\x0\x0\x0\xb0\xb1\xb2\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xfe"#
+        , encoderMax = '\9632'
+        }
+
+   }
+    )
+
+    ,
+    (874, SingleByteCP {
+     decoderArray = ConvArray "\x0\x0\x1\x0\x2\x0\x3\x0\x4\x0\x5\x0\x6\x0\x7\x0\x8\x0\x9\x0\xa\x0\xb\x0\xc\x0\xd\x0\xe\x0\xf\x0\x10\x0\x11\x0\x12\x0\x13\x0\x14\x0\x15\x0\x16\x0\x17\x0\x18\x0\x19\x0\x1a\x0\x1b\x0\x1c\x0\x1d\x0\x1e\x0\x1f\x0\x20\x0\x21\x0\x22\x0\x23\x0\x24\x0\x25\x0\x26\x0\x27\x0\x28\x0\x29\x0\x2a\x0\x2b\x0\x2c\x0\x2d\x0\x2e\x0\x2f\x0\x30\x0\x31\x0\x32\x0\x33\x0\x34\x0\x35\x0\x36\x0\x37\x0\x38\x0\x39\x0\x3a\x0\x3b\x0\x3c\x0\x3d\x0\x3e\x0\x3f\x0\x40\x0\x41\x0\x42\x0\x43\x0\x44\x0\x45\x0\x46\x0\x47\x0\x48\x0\x49\x0\x4a\x0\x4b\x0\x4c\x0\x4d\x0\x4e\x0\x4f\x0\x50\x0\x51\x0\x52\x0\x53\x0\x54\x0\x55\x0\x56\x0\x57\x0\x58\x0\x59\x0\x5a\x0\x5b\x0\x5c\x0\x5d\x0\x5e\x0\x5f\x0\x60\x0\x61\x0\x62\x0\x63\x0\x64\x0\x65\x0\x66\x0\x67\x0\x68\x0\x69\x0\x6a\x0\x6b\x0\x6c\x0\x6d\x0\x6e\x0\x6f\x0\x70\x0\x71\x0\x72\x0\x73\x0\x74\x0\x75\x0\x76\x0\x77\x0\x78\x0\x79\x0\x7a\x0\x7b\x0\x7c\x0\x7d\x0\x7e\x0\x7f\x0\xac\x20\x0\x0\x0\x0\x0\x0\x0\x0\x26\x20\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x18\x20\x19\x20\x1c\x20\x1d\x20\x22\x20\x13\x20\x14\x20\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xa0\x0\x1\xe\x2\xe\x3\xe\x4\xe\x5\xe\x6\xe\x7\xe\x8\xe\x9\xe\xa\xe\xb\xe\xc\xe\xd\xe\xe\xe\xf\xe\x10\xe\x11\xe\x12\xe\x13\xe\x14\xe\x15\xe\x16\xe\x17\xe\x18\xe\x19\xe\x1a\xe\x1b\xe\x1c\xe\x1d\xe\x1e\xe\x1f\xe\x20\xe\x21\xe\x22\xe\x23\xe\x24\xe\x25\xe\x26\xe\x27\xe\x28\xe\x29\xe\x2a\xe\x2b\xe\x2c\xe\x2d\xe\x2e\xe\x2f\xe\x30\xe\x31\xe\x32\xe\x33\xe\x34\xe\x35\xe\x36\xe\x37\xe\x38\xe\x39\xe\x3a\xe\x0\x0\x0\x0\x0\x0\x0\x0\x3f\xe\x40\xe\x41\xe\x42\xe\x43\xe\x44\xe\x45\xe\x46\xe\x47\xe\x48\xe\x49\xe\x4a\xe\x4b\xe\x4c\xe\x4d\xe\x4e\xe\x4f\xe\x50\xe\x51\xe\x52\xe\x53\xe\x54\xe\x55\xe\x56\xe\x57\xe\x58\xe\x59\xe\x5a\xe\x5b\xe\x0\x0\x0\x0\x0\x0\x0\x0"#
+     , encoderArray = 
+ CompactArray {
+        encoderIndices = ConvArray "\x0\x0\x40\x0\x80\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\x0\x1\x40\x1\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\x80\x1\xc0\x0\xc0\x1"#
+        , encoderValues = ConvArray "\x0\x1\x2\x3\x4\x5\x6\x7\x8\x9\xa\xb\xc\xd\xe\xf\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x1a\x1b\x1c\x1d\x1e\x1f\x20\x21\x22\x23\x24\x25\x26\x27\x28\x29\x2a\x2b\x2c\x2d\x2e\x2f\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x3a\x3b\x3c\x3d\x3e\x3f\x40\x41\x42\x43\x44\x45\x46\x47\x48\x49\x4a\x4b\x4c\x4d\x4e\x4f\x50\x51\x52\x53\x54\x55\x56\x57\x58\x59\x5a\x5b\x5c\x5d\x5e\x5f\x60\x61\x62\x63\x64\x65\x66\x67\x68\x69\x6a\x6b\x6c\x6d\x6e\x6f\x70\x71\x72\x73\x74\x75\x76\x77\x78\x79\x7a\x7b\x7c\x7d\x7e\x7f\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xa0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xa1\xa2\xa3\xa4\xa5\xa6\xa7\xa8\xa9\xaa\xab\xac\xad\xae\xaf\xb0\xb1\xb2\xb3\xb4\xb5\xb6\xb7\xb8\xb9\xba\xbb\xbc\xbd\xbe\xbf\xc0\xc1\xc2\xc3\xc4\xc5\xc6\xc7\xc8\xc9\xca\xcb\xcc\xcd\xce\xcf\xd0\xd1\xd2\xd3\xd4\xd5\xd6\xd7\xd8\xd9\xda\x0\x0\x0\x0\xdf\xe0\xe1\xe2\xe3\xe4\xe5\xe6\xe7\xe8\xe9\xea\xeb\xec\xed\xee\xef\xf0\xf1\xf2\xf3\xf4\xf5\xf6\xf7\xf8\xf9\xfa\xfb\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x96\x97\x0\x0\x0\x91\x92\x0\x0\x93\x94\x0\x0\x0\x0\x95\x0\x0\x0\x85\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x80"#
+        , encoderMax = '\8364'
+        }
+
+   }
+    )
+
+    ,
+    (875, SingleByteCP {
+     decoderArray = ConvArray "\x0\x0\x1\x0\x2\x0\x3\x0\x9c\x0\x9\x0\x86\x0\x7f\x0\x97\x0\x8d\x0\x8e\x0\xb\x0\xc\x0\xd\x0\xe\x0\xf\x0\x10\x0\x11\x0\x12\x0\x13\x0\x9d\x0\x85\x0\x8\x0\x87\x0\x18\x0\x19\x0\x92\x0\x8f\x0\x1c\x0\x1d\x0\x1e\x0\x1f\x0\x80\x0\x81\x0\x82\x0\x83\x0\x84\x0\xa\x0\x17\x0\x1b\x0\x88\x0\x89\x0\x8a\x0\x8b\x0\x8c\x0\x5\x0\x6\x0\x7\x0\x90\x0\x91\x0\x16\x0\x93\x0\x94\x0\x95\x0\x96\x0\x4\x0\x98\x0\x99\x0\x9a\x0\x9b\x0\x14\x0\x15\x0\x9e\x0\x1a\x0\x20\x0\x91\x3\x92\x3\x93\x3\x94\x3\x95\x3\x96\x3\x97\x3\x98\x3\x99\x3\x5b\x0\x2e\x0\x3c\x0\x28\x0\x2b\x0\x21\x0\x26\x0\x9a\x3\x9b\x3\x9c\x3\x9d\x3\x9e\x3\x9f\x3\xa0\x3\xa1\x3\xa3\x3\x5d\x0\x24\x0\x2a\x0\x29\x0\x3b\x0\x5e\x0\x2d\x0\x2f\x0\xa4\x3\xa5\x3\xa6\x3\xa7\x3\xa8\x3\xa9\x3\xaa\x3\xab\x3\x7c\x0\x2c\x0\x25\x0\x5f\x0\x3e\x0\x3f\x0\xa8\x0\x86\x3\x88\x3\x89\x3\xa0\x0\x8a\x3\x8c\x3\x8e\x3\x8f\x3\x60\x0\x3a\x0\x23\x0\x40\x0\x27\x0\x3d\x0\x22\x0\x85\x3\x61\x0\x62\x0\x63\x0\x64\x0\x65\x0\x66\x0\x67\x0\x68\x0\x69\x0\xb1\x3\xb2\x3\xb3\x3\xb4\x3\xb5\x3\xb6\x3\xb0\x0\x6a\x0\x6b\x0\x6c\x0\x6d\x0\x6e\x0\x6f\x0\x70\x0\x71\x0\x72\x0\xb7\x3\xb8\x3\xb9\x3\xba\x3\xbb\x3\xbc\x3\xb4\x0\x7e\x0\x73\x0\x74\x0\x75\x0\x76\x0\x77\x0\x78\x0\x79\x0\x7a\x0\xbd\x3\xbe\x3\xbf\x3\xc0\x3\xc1\x3\xc3\x3\xa3\x0\xac\x3\xad\x3\xae\x3\xca\x3\xaf\x3\xcc\x3\xcd\x3\xcb\x3\xce\x3\xc2\x3\xc4\x3\xc5\x3\xc6\x3\xc7\x3\xc8\x3\x7b\x0\x41\x0\x42\x0\x43\x0\x44\x0\x45\x0\x46\x0\x47\x0\x48\x0\x49\x0\xad\x0\xc9\x3\x90\x3\xb0\x3\x18\x20\x15\x20\x7d\x0\x4a\x0\x4b\x0\x4c\x0\x4d\x0\x4e\x0\x4f\x0\x50\x0\x51\x0\x52\x0\xb1\x0\xbd\x0\x1a\x0\x87\x3\x19\x20\xa6\x0\x5c\x0\x1a\x0\x53\x0\x54\x0\x55\x0\x56\x0\x57\x0\x58\x0\x59\x0\x5a\x0\xb2\x0\xa7\x0\x1a\x0\x1a\x0\xab\x0\xac\x0\x30\x0\x31\x0\x32\x0\x33\x0\x34\x0\x35\x0\x36\x0\x37\x0\x38\x0\x39\x0\xb3\x0\xa9\x0\x1a\x0\x1a\x0\xbb\x0\x9f\x0"#
+     , encoderArray = 
+ CompactArray {
+        encoderIndices = ConvArray "\x0\x0\x40\x0\x80\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\x0\x1\x40\x1\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\xc0\x0\x80\x1"#
+        , encoderValues = ConvArray "\x0\x1\x2\x3\x37\x2d\x2e\x2f\x16\x5\x25\xb\xc\xd\xe\xf\x10\x11\x12\x13\x3c\x3d\x32\x26\x18\x19\xfd\x27\x1c\x1d\x1e\x1f\x40\x4f\x7f\x7b\x5b\x6c\x50\x7d\x4d\x5d\x5c\x4e\x6b\x60\x4b\x61\xf0\xf1\xf2\xf3\xf4\xf5\xf6\xf7\xf8\xf9\x7a\x5e\x4c\x7e\x6e\x6f\x7c\xc1\xc2\xc3\xc4\xc5\xc6\xc7\xc8\xc9\xd1\xd2\xd3\xd4\xd5\xd6\xd7\xd8\xd9\xe2\xe3\xe4\xe5\xe6\xe7\xe8\xe9\x4a\xe0\x5a\x5f\x6d\x79\x81\x82\x83\x84\x85\x86\x87\x88\x89\x91\x92\x93\x94\x95\x96\x97\x98\x99\xa2\xa3\xa4\xa5\xa6\xa7\xa8\xa9\xc0\x6a\xd0\xa1\x7\x20\x21\x22\x23\x24\x15\x6\x17\x28\x29\x2a\x2b\x2c\x9\xa\x1b\x30\x31\x1a\x33\x34\x35\x36\x8\x38\x39\x3a\x3b\x4\x14\x3e\xff\x74\x0\x0\xb0\x0\x0\xdf\xeb\x70\xfb\x0\xee\xef\xca\x0\x0\x90\xda\xea\xfa\xa0\x0\x0\x0\x0\x0\x0\xfe\x0\xdb\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x80\x71\xdd\x72\x73\x75\x0\x76\x0\x77\x78\xcc\x41\x42\x43\x44\x45\x46\x47\x48\x49\x51\x52\x53\x54\x55\x56\x57\x58\x0\x59\x62\x63\x64\x65\x66\x67\x68\x69\xb1\xb2\xb3\xb5\xcd\x8a\x8b\x8c\x8d\x8e\x8f\x9a\x9b\x9c\x9d\x9e\x9f\xaa\xab\xac\xad\xae\xba\xaf\xbb\xbc\xbd\xbe\xbf\xcb\xb4\xb8\xb6\xb7\xb9\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\x0\xcf\x0\x0\xce\xde"#
+        , encoderMax = '\8217'
+        }
+
+   }
+    )
+    ]
diff --git a/libraries/base/GHC/IO/Encoding/Failure.hs b/libraries/base/GHC/IO/Encoding/Failure.hs
new file mode 100644
index 000000000000..4b24d06012f9
--- /dev/null
+++ b/libraries/base/GHC/IO/Encoding/Failure.hs
@@ -0,0 +1,205 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.IO.Encoding.Failure
+-- Copyright   :  (c) The University of Glasgow, 2008-2011
+-- License     :  see libraries/base/LICENSE
+-- 
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  internal
+-- Portability :  non-portable
+--
+-- Types for specifying how text encoding/decoding fails
+--
+-----------------------------------------------------------------------------
+
+module GHC.IO.Encoding.Failure (
+    CodingFailureMode(..), codingFailureModeSuffix,
+    isSurrogate,
+    recoverDecode, recoverEncode
+  ) where
+
+import GHC.IO
+import GHC.IO.Buffer
+import GHC.IO.Exception
+
+import GHC.Base
+import GHC.Char
+import GHC.Word
+import GHC.Show
+import GHC.Num
+import GHC.Real ( fromIntegral )
+
+--import System.Posix.Internals
+
+import Data.Maybe
+
+
+-- | The 'CodingFailureMode' is used to construct 'TextEncoding's, and
+-- specifies how they handle illegal sequences.
+data CodingFailureMode
+  = ErrorOnCodingFailure
+       -- ^ Throw an error when an illegal sequence is encountered
+  | IgnoreCodingFailure
+       -- ^ Attempt to ignore and recover if an illegal sequence is
+       -- encountered
+  | TransliterateCodingFailure
+       -- ^ Replace with the closest visual match upon an illegal
+       -- sequence
+  | RoundtripFailure
+       -- ^ Use the private-use escape mechanism to attempt to allow
+       -- illegal sequences to be roundtripped.
+  deriving (Show)
+       -- This will only work properly for those encodings which are
+       -- strict supersets of ASCII in the sense that valid ASCII data
+       -- is also valid in that encoding. This is not true for
+       -- e.g. UTF-16, because ASCII characters must be padded to two
+       -- bytes to retain their meaning.
+
+-- Note [Roundtripping]
+-- ~~~~~~~~~~~~~~~~~~~~
+--
+-- Roundtripping is based on the ideas of PEP383.
+--
+-- We used to use the range of private-use characters from 0xEF80 to
+-- 0xEFFF designated for "encoding hacks" by the ConScript Unicode Registery
+-- to encode these characters.
+--
+-- However, people didn't like this because it means we don't get
+-- guaranteed roundtripping for byte sequences that look like a UTF-8
+-- encoded codepoint 0xEFxx.
+--
+-- So now like PEP383 we use lone surrogate codepoints 0xDCxx to escape
+-- undecodable bytes, even though that may confuse Unicode processing
+-- software written in Haskell. This guarantees roundtripping because
+-- unicode input that includes lone surrogate codepoints is invalid by
+-- definition.
+--
+-- When we used private-use characters there was a technical problem when it
+-- came to encoding back to bytes using iconv. The iconv code will not fail when
+-- it tries to encode a private-use character (as it would if trying to encode
+-- a surrogate), which means that we won't get a chance to replace it
+-- with the byte we originally escaped.
+--
+-- To work around this, when filling the buffer to be encoded (in
+-- writeBlocks/withEncodedCString/newEncodedCString), we replaced the
+-- private-use characters with lone surrogates again! Likewise, when
+-- reading from a buffer (unpack/unpack_nl/peekEncodedCString) we have
+-- to do the inverse process.
+--
+-- The user of String would never see these lone surrogates, but it
+-- ensures that iconv will throw an error when encountering them.  We
+-- use lone surrogates in the range 0xDC00 to 0xDCFF for this purpose.
+
+codingFailureModeSuffix :: CodingFailureMode -> String
+codingFailureModeSuffix ErrorOnCodingFailure       = ""
+codingFailureModeSuffix IgnoreCodingFailure        = "//IGNORE"
+codingFailureModeSuffix TransliterateCodingFailure = "//TRANSLIT"
+codingFailureModeSuffix RoundtripFailure           = "//ROUNDTRIP"
+
+-- | In transliterate mode, we use this character when decoding
+-- unknown bytes.
+--
+-- This is the defined Unicode replacement character:
+-- <http://www.fileformat.info/info/unicode/char/0fffd/index.htm>
+unrepresentableChar :: Char
+unrepresentableChar = '\xFFFD'
+
+-- It is extraordinarily important that this series of
+-- predicates/transformers gets inlined, because they tend to be used
+-- in inner loops related to text encoding. In particular,
+-- surrogatifyRoundtripCharacter must be inlined (see #5536)
+
+-- | Some characters are actually "surrogate" codepoints defined for
+-- use in UTF-16. We need to signal an invalid character if we detect
+-- them when encoding a sequence of 'Char's into 'Word8's because they
+-- won't give valid Unicode.
+--
+-- We may also need to signal an invalid character if we detect them
+-- when encoding a sequence of 'Char's into 'Word8's because the
+-- 'RoundtripFailure' mode creates these to round-trip bytes through
+-- our internal UTF-16 encoding.
+{-# INLINE isSurrogate #-}
+isSurrogate :: Char -> Bool
+isSurrogate c = (0xD800 <= x && x <= 0xDBFF)
+             || (0xDC00 <= x && x <= 0xDFFF)
+  where x = ord c
+
+-- Bytes (in Buffer Word8) --> lone surrogates (in Buffer CharBufElem)
+{-# INLINE escapeToRoundtripCharacterSurrogate #-}
+escapeToRoundtripCharacterSurrogate :: Word8 -> Char
+escapeToRoundtripCharacterSurrogate b
+  | b < 128   = chr (fromIntegral b)
+      -- Disallow 'smuggling' of ASCII bytes. For roundtripping to
+      -- work, this assumes encoding is ASCII-superset.
+  | otherwise = chr (0xDC00 + fromIntegral b)
+
+-- Lone surrogates (in Buffer CharBufElem) --> bytes (in Buffer Word8)
+{-# INLINE unescapeRoundtripCharacterSurrogate #-}
+unescapeRoundtripCharacterSurrogate :: Char -> Maybe Word8
+unescapeRoundtripCharacterSurrogate c
+    | 0xDC80 <= x && x < 0xDD00 = Just (fromIntegral x) -- Discard high byte
+    | otherwise                 = Nothing
+  where x = ord c
+
+recoverDecode :: CodingFailureMode -> Buffer Word8 -> Buffer Char
+              -> IO (Buffer Word8, Buffer Char)
+recoverDecode cfm input@Buffer{  bufRaw=iraw, bufL=ir, bufR=_  }
+                  output@Buffer{ bufRaw=oraw, bufL=_,  bufR=ow } = do
+ --puts $ "recoverDecode " ++ show ir
+ case cfm of
+  ErrorOnCodingFailure       -> ioe_decodingError
+  IgnoreCodingFailure        -> return (input { bufL=ir+1 }, output)
+  TransliterateCodingFailure -> do
+      ow' <- writeCharBuf oraw ow unrepresentableChar
+      return (input { bufL=ir+1 }, output { bufR=ow' })
+  RoundtripFailure           -> do
+      b <- readWord8Buf iraw ir
+      ow' <- writeCharBuf oraw ow (escapeToRoundtripCharacterSurrogate b)
+      return (input { bufL=ir+1 }, output { bufR=ow' })
+
+recoverEncode :: CodingFailureMode -> Buffer Char -> Buffer Word8
+              -> IO (Buffer Char, Buffer Word8)
+recoverEncode cfm input@Buffer{  bufRaw=iraw, bufL=ir, bufR=_  }
+                  output@Buffer{ bufRaw=oraw, bufL=_,  bufR=ow } = do
+  (c,ir') <- readCharBuf iraw ir
+  --puts $ "recoverEncode " ++ show ir ++ " " ++ show ir'
+  case cfm of
+    IgnoreCodingFailure        -> return (input { bufL=ir' }, output)
+    TransliterateCodingFailure -> do
+        if c == '?'
+         then return (input { bufL=ir' }, output)
+         else do
+          -- XXX: evil hack! To implement transliteration, we just
+          -- poke an ASCII ? into the input buffer and tell the caller
+          -- to try and decode again. This is *probably* safe given
+          -- current uses of TextEncoding.
+          --
+          -- The "if" test above ensures we skip if the encoding fails
+          -- to deal with the ?, though this should never happen in
+          -- practice as all encodings are in fact capable of
+          -- reperesenting all ASCII characters.
+          _ir' <- writeCharBuf iraw ir '?'
+          return (input, output)
+        
+        -- This implementation does not work because e.g. UTF-16
+        -- requires 2 bytes to encode a simple ASCII value
+        --writeWord8Buf oraw ow unrepresentableByte
+        --return (input { bufL=ir' }, output { bufR=ow+1 })
+    RoundtripFailure | Just x <- unescapeRoundtripCharacterSurrogate c -> do
+        writeWord8Buf oraw ow x
+        return (input { bufL=ir' }, output { bufR=ow+1 })
+    _                          -> ioe_encodingError
+
+ioe_decodingError :: IO a
+ioe_decodingError = ioException
+    (IOError Nothing InvalidArgument "recoverDecode"
+        "invalid byte sequence" Nothing Nothing)
+
+ioe_encodingError :: IO a
+ioe_encodingError = ioException
+    (IOError Nothing InvalidArgument "recoverEncode"
+        "invalid character" Nothing Nothing)
+
diff --git a/libraries/base/GHC/IO/Encoding/Iconv.hs b/libraries/base/GHC/IO/Encoding/Iconv.hs
new file mode 100644
index 000000000000..2ae61463179f
--- /dev/null
+++ b/libraries/base/GHC/IO/Encoding/Iconv.hs
@@ -0,0 +1,188 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE CPP
+           , NoImplicitPrelude
+           , NondecreasingIndentation
+  #-}
+{-# OPTIONS_HADDOCK hide #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.IO.Encoding.Iconv
+-- Copyright   :  (c) The University of Glasgow, 2008-2009
+-- License     :  see libraries/base/LICENSE
+-- 
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  internal
+-- Portability :  non-portable
+--
+-- This module provides text encoding/decoding using iconv
+--
+-----------------------------------------------------------------------------
+
+module GHC.IO.Encoding.Iconv (
+#if !defined(mingw32_HOST_OS)
+   iconvEncoding, mkIconvEncoding,
+   localeEncodingName
+#endif
+ ) where
+
+#include "MachDeps.h"
+#include "HsBaseConfig.h"
+
+#if defined(mingw32_HOST_OS)
+import GHC.Base () -- For build ordering
+#else
+
+import Foreign.Safe
+import Foreign.C
+import Data.Maybe
+import GHC.Base
+import GHC.IO.Buffer
+import GHC.IO.Encoding.Failure
+import GHC.IO.Encoding.Types
+import GHC.List (span)
+import GHC.Num
+import GHC.Show
+import GHC.Real
+import System.IO.Unsafe (unsafePerformIO)
+import System.Posix.Internals
+
+c_DEBUG_DUMP :: Bool
+c_DEBUG_DUMP = False
+
+iconv_trace :: String -> IO ()
+iconv_trace s
+ | c_DEBUG_DUMP = puts s
+ | otherwise    = return ()
+
+-- -----------------------------------------------------------------------------
+-- iconv encoders/decoders
+
+{-# NOINLINE localeEncodingName #-}
+localeEncodingName :: String
+localeEncodingName = unsafePerformIO $ do
+   -- Use locale_charset() or nl_langinfo(CODESET) to get the encoding
+   -- if we have either of them.
+   cstr <- c_localeEncoding
+   peekCAString cstr -- Assume charset names are ASCII
+
+-- We hope iconv_t is a storable type.  It should be, since it has at least the
+-- value -1, which is a possible return value from iconv_open.
+type IConv = CLong -- ToDo: (#type iconv_t)
+
+foreign import ccall unsafe "hs_iconv_open"
+    hs_iconv_open :: CString -> CString -> IO IConv
+
+foreign import ccall unsafe "hs_iconv_close"
+    hs_iconv_close :: IConv -> IO CInt
+
+foreign import ccall unsafe "hs_iconv"
+    hs_iconv :: IConv -> Ptr CString -> Ptr CSize -> Ptr CString -> Ptr CSize
+	  -> IO CSize
+
+foreign import ccall unsafe "localeEncoding"
+    c_localeEncoding :: IO CString
+
+haskellChar :: String
+#ifdef WORDS_BIGENDIAN
+haskellChar | charSize == 2 = "UTF-16BE"
+            | otherwise     = "UTF-32BE"
+#else
+haskellChar | charSize == 2 = "UTF-16LE"
+            | otherwise     = "UTF-32LE"
+#endif
+
+char_shift :: Int
+char_shift | charSize == 2 = 1
+           | otherwise     = 2
+
+iconvEncoding :: String -> IO TextEncoding
+iconvEncoding = mkIconvEncoding ErrorOnCodingFailure
+
+mkIconvEncoding :: CodingFailureMode -> String -> IO TextEncoding
+mkIconvEncoding cfm charset = do
+  return (TextEncoding { 
+                textEncodingName = charset,
+		mkTextDecoder = newIConv raw_charset (haskellChar ++ suffix) (recoverDecode cfm) iconvDecode,
+		mkTextEncoder = newIConv haskellChar charset                 (recoverEncode cfm) iconvEncode})
+  where
+    -- An annoying feature of GNU iconv is that the //PREFIXES only take
+    -- effect when they appear on the tocode parameter to iconv_open:
+    (raw_charset, suffix) = span (/= '/') charset
+
+newIConv :: String -> String
+   -> (Buffer a -> Buffer b -> IO (Buffer a, Buffer b))
+   -> (IConv -> Buffer a -> Buffer b -> IO (CodingProgress, Buffer a, Buffer b))
+   -> IO (BufferCodec a b ())
+newIConv from to rec fn =
+  -- Assume charset names are ASCII
+  withCAString from $ \ from_str ->
+  withCAString to   $ \ to_str -> do
+    iconvt <- throwErrnoIfMinus1 "mkTextEncoding" $ hs_iconv_open to_str from_str
+    let iclose = throwErrnoIfMinus1_ "Iconv.close" $ hs_iconv_close iconvt
+    return BufferCodec{
+                encode = fn iconvt,
+                recover = rec,
+                close  = iclose,
+                -- iconv doesn't supply a way to save/restore the state
+                getState = return (),
+                setState = const $ return ()
+                }
+
+iconvDecode :: IConv -> DecodeBuffer
+iconvDecode iconv_t ibuf obuf = iconvRecode iconv_t ibuf 0 obuf char_shift
+
+iconvEncode :: IConv -> EncodeBuffer
+iconvEncode iconv_t ibuf obuf = iconvRecode iconv_t ibuf char_shift obuf 0
+
+iconvRecode :: IConv -> Buffer a -> Int -> Buffer b -> Int 
+            -> IO (CodingProgress, Buffer a, Buffer b)
+iconvRecode iconv_t
+  input@Buffer{  bufRaw=iraw, bufL=ir, bufR=iw, bufSize=_  }  iscale
+  output@Buffer{ bufRaw=oraw, bufL=_,  bufR=ow, bufSize=os }  oscale
+  = do
+    iconv_trace ("haskellChar=" ++ show haskellChar)
+    iconv_trace ("iconvRecode before, input=" ++ show (summaryBuffer input))
+    iconv_trace ("iconvRecode before, output=" ++ show (summaryBuffer output))
+    withRawBuffer iraw $ \ piraw -> do
+    withRawBuffer oraw $ \ poraw -> do
+    with (piraw `plusPtr` (ir `shiftL` iscale)) $ \ p_inbuf -> do
+    with (poraw `plusPtr` (ow `shiftL` oscale)) $ \ p_outbuf -> do
+    with (fromIntegral ((iw-ir) `shiftL` iscale)) $ \ p_inleft -> do
+    with (fromIntegral ((os-ow) `shiftL` oscale)) $ \ p_outleft -> do
+      res <- hs_iconv iconv_t p_inbuf p_inleft p_outbuf p_outleft
+      new_inleft  <- peek p_inleft
+      new_outleft <- peek p_outleft
+      let 
+	  new_inleft'  = fromIntegral new_inleft `shiftR` iscale
+	  new_outleft' = fromIntegral new_outleft `shiftR` oscale
+	  new_input  
+            | new_inleft == 0  = input { bufL = 0, bufR = 0 }
+	    | otherwise        = input { bufL = iw - new_inleft' }
+	  new_output = output{ bufR = os - new_outleft' }
+      iconv_trace ("iconv res=" ++ show res)
+      iconv_trace ("iconvRecode after,  input=" ++ show (summaryBuffer new_input))
+      iconv_trace ("iconvRecode after,  output=" ++ show (summaryBuffer new_output))
+      if (res /= -1)
+	then do -- all input translated
+	   return (InputUnderflow, new_input, new_output)
+	else do
+      errno <- getErrno
+      case errno of
+        e | e == e2BIG  -> return (OutputUnderflow, new_input, new_output)
+          | e == eINVAL -> return (InputUnderflow, new_input, new_output)
+           -- Sometimes iconv reports EILSEQ for a
+           -- character in the input even when there is no room
+           -- in the output; in this case we might be about to
+           -- change the encoding anyway, so the following bytes
+           -- could very well be in a different encoding.
+           --
+           -- Because we can only say InvalidSequence if there is at least
+           -- one element left in the output, we have to special case this.
+          | e == eILSEQ -> return (if new_outleft' == 0 then OutputUnderflow else InvalidSequence, new_input, new_output)
+          | otherwise -> do
+              iconv_trace ("iconv returned error: " ++ show (errnoToIOError "iconv" e Nothing Nothing))
+              throwErrno "iconvRecoder"
+
+#endif /* !mingw32_HOST_OS */
+
diff --git a/libraries/base/GHC/IO/Encoding/Latin1.hs b/libraries/base/GHC/IO/Encoding/Latin1.hs
new file mode 100644
index 000000000000..5ec711097346
--- /dev/null
+++ b/libraries/base/GHC/IO/Encoding/Latin1.hs
@@ -0,0 +1,155 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE NoImplicitPrelude
+           , BangPatterns
+           , NondecreasingIndentation
+  #-}
+{-# OPTIONS_GHC  -funbox-strict-fields #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.IO.Encoding.Latin1
+-- Copyright   :  (c) The University of Glasgow, 2009
+-- License     :  see libraries/base/LICENSE
+-- 
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  internal
+-- Portability :  non-portable
+--
+-- UTF-32 Codecs for the IO library
+--
+-- Portions Copyright   : (c) Tom Harper 2008-2009,
+--                        (c) Bryan O'Sullivan 2009,
+--                        (c) Duncan Coutts 2009
+--
+-----------------------------------------------------------------------------
+
+module GHC.IO.Encoding.Latin1 (
+  latin1, mkLatin1,
+  latin1_checked, mkLatin1_checked,
+  latin1_decode,
+  latin1_encode,
+  latin1_checked_encode,
+  ) where
+
+import GHC.Base
+import GHC.Real
+import GHC.Num
+-- import GHC.IO
+import GHC.IO.Buffer
+import GHC.IO.Encoding.Failure
+import GHC.IO.Encoding.Types
+
+-- -----------------------------------------------------------------------------
+-- Latin1
+
+latin1 :: TextEncoding
+latin1 = mkLatin1 ErrorOnCodingFailure
+
+-- | /Since: 4.4.0.0/
+mkLatin1 :: CodingFailureMode -> TextEncoding
+mkLatin1 cfm = TextEncoding { textEncodingName = "ISO8859-1",
+                              mkTextDecoder = latin1_DF cfm,
+                              mkTextEncoder = latin1_EF cfm }
+
+latin1_DF :: CodingFailureMode -> IO (TextDecoder ())
+latin1_DF cfm =
+  return (BufferCodec {
+             encode   = latin1_decode,
+             recover  = recoverDecode cfm,
+             close    = return (),
+             getState = return (),
+             setState = const $ return ()
+          })
+
+latin1_EF :: CodingFailureMode -> IO (TextEncoder ())
+latin1_EF cfm =
+  return (BufferCodec {
+             encode   = latin1_encode,
+             recover  = recoverEncode cfm,
+             close    = return (),
+             getState = return (),
+             setState = const $ return ()
+          })
+
+latin1_checked :: TextEncoding
+latin1_checked = mkLatin1_checked ErrorOnCodingFailure
+
+-- | /Since: 4.4.0.0/
+mkLatin1_checked :: CodingFailureMode -> TextEncoding
+mkLatin1_checked cfm = TextEncoding { textEncodingName = "ISO8859-1(checked)",
+                                      mkTextDecoder = latin1_DF cfm,
+                                      mkTextEncoder = latin1_checked_EF cfm }
+
+latin1_checked_EF :: CodingFailureMode -> IO (TextEncoder ())
+latin1_checked_EF cfm =
+  return (BufferCodec {
+             encode   = latin1_checked_encode,
+             recover  = recoverEncode cfm,
+             close    = return (),
+             getState = return (),
+             setState = const $ return ()
+          })
+
+
+latin1_decode :: DecodeBuffer
+latin1_decode 
+  input@Buffer{  bufRaw=iraw, bufL=ir0, bufR=iw,  bufSize=_  }
+  output@Buffer{ bufRaw=oraw, bufL=_,   bufR=ow0, bufSize=os }
+ = let 
+       loop !ir !ow
+         | ow >= os = done OutputUnderflow ir ow
+         | ir >= iw = done InputUnderflow ir ow
+         | otherwise = do
+              c0 <- readWord8Buf iraw ir
+              ow' <- writeCharBuf oraw ow (unsafeChr (fromIntegral c0))
+              loop (ir+1) ow'
+
+       -- lambda-lifted, to avoid thunks being built in the inner-loop:
+       done why !ir !ow = return (why,
+                                  if ir == iw then input{ bufL=0, bufR=0 }
+                                              else input{ bufL=ir },
+                                  output{ bufR=ow })
+    in
+    loop ir0 ow0
+
+latin1_encode :: EncodeBuffer
+latin1_encode
+  input@Buffer{  bufRaw=iraw, bufL=ir0, bufR=iw,  bufSize=_  }
+  output@Buffer{ bufRaw=oraw, bufL=_,   bufR=ow0, bufSize=os }
+ = let
+      done why !ir !ow = return (why,
+                                 if ir == iw then input{ bufL=0, bufR=0 }
+                                             else input{ bufL=ir },
+                                 output{ bufR=ow })
+      loop !ir !ow
+        | ow >= os = done OutputUnderflow ir ow
+        | ir >= iw = done InputUnderflow ir ow
+        | otherwise = do
+           (c,ir') <- readCharBuf iraw ir
+           writeWord8Buf oraw ow (fromIntegral (ord c))
+           loop ir' (ow+1)
+    in
+    loop ir0 ow0
+
+latin1_checked_encode :: EncodeBuffer
+latin1_checked_encode
+  input@Buffer{  bufRaw=iraw, bufL=ir0, bufR=iw,  bufSize=_  }
+  output@Buffer{ bufRaw=oraw, bufL=_,   bufR=ow0, bufSize=os }
+ = let
+      done why !ir !ow = return (why,
+                                 if ir == iw then input{ bufL=0, bufR=0 }
+                                             else input{ bufL=ir },
+                                 output{ bufR=ow })
+      loop !ir !ow
+        | ow >= os = done OutputUnderflow ir ow
+        | ir >= iw = done InputUnderflow ir ow
+        | otherwise = do
+           (c,ir') <- readCharBuf iraw ir
+           if ord c > 0xff then invalid else do
+           writeWord8Buf oraw ow (fromIntegral (ord c))
+           loop ir' (ow+1)
+        where
+           invalid = done InvalidSequence ir ow
+    in
+    loop ir0 ow0
+
diff --git a/libraries/base/GHC/IO/Encoding/Types.hs b/libraries/base/GHC/IO/Encoding/Types.hs
new file mode 100644
index 000000000000..95bb2905a407
--- /dev/null
+++ b/libraries/base/GHC/IO/Encoding/Types.hs
@@ -0,0 +1,132 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE NoImplicitPrelude, ExistentialQuantification #-}
+{-# OPTIONS_GHC -funbox-strict-fields #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.IO.Encoding.Types
+-- Copyright   :  (c) The University of Glasgow, 2008-2009
+-- License     :  see libraries/base/LICENSE
+-- 
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  internal
+-- Portability :  non-portable
+--
+-- Types for text encoding/decoding
+--
+-----------------------------------------------------------------------------
+
+module GHC.IO.Encoding.Types (
+    BufferCodec(..),
+    TextEncoding(..),
+    TextEncoder, TextDecoder,
+    CodeBuffer, EncodeBuffer, DecodeBuffer,
+    CodingProgress(..)
+  ) where
+
+import GHC.Base
+import GHC.Word
+import GHC.Show
+-- import GHC.IO
+import GHC.IO.Buffer
+
+-- -----------------------------------------------------------------------------
+-- Text encoders/decoders
+
+data BufferCodec from to state = BufferCodec {
+  encode :: CodeBuffer from to,
+   -- ^ The @encode@ function translates elements of the buffer @from@
+   -- to the buffer @to@.  It should translate as many elements as possible
+   -- given the sizes of the buffers, including translating zero elements
+   -- if there is either not enough room in @to@, or @from@ does not
+   -- contain a complete multibyte sequence.
+   --
+   -- If multiple CodingProgress returns are possible, OutputUnderflow must be
+   -- preferred to InvalidSequence. This allows GHC's IO library to assume that
+   -- if we observe InvalidSequence there is at least a single element available
+   -- in the output buffer.
+   --
+   -- The fact that as many elements as possible are translated is used by the IO
+   -- library in order to report translation errors at the point they
+   -- actually occur, rather than when the buffer is translated.
+  
+  recover :: Buffer from -> Buffer to -> IO (Buffer from, Buffer to),
+   -- ^ The @recover@ function is used to continue decoding
+   -- in the presence of invalid or unrepresentable sequences. This includes
+   -- both those detected by @encode@ returning @InvalidSequence@ and those
+   -- that occur because the input byte sequence appears to be truncated.
+   --
+   -- Progress will usually be made by skipping the first element of the @from@
+   -- buffer. This function should only be called if you are certain that you
+   -- wish to do this skipping and if the @to@ buffer has at least one element
+   -- of free space. Because this function deals with decoding failure, it assumes
+   -- that the from buffer has at least one element.
+   --
+   -- @recover@ may raise an exception rather than skipping anything.
+   --
+   -- Currently, some implementations of @recover@ may mutate the input buffer.
+   -- In particular, this feature is used to implement transliteration.
+   --
+   -- /Since: 4.4.0.0/
+  
+  close  :: IO (),
+   -- ^ Resources associated with the encoding may now be released.
+   -- The @encode@ function may not be called again after calling
+   -- @close@.
+
+  getState :: IO state,
+   -- ^ Return the current state of the codec.
+   --
+   -- Many codecs are not stateful, and in these case the state can be
+   -- represented as '()'.  Other codecs maintain a state.  For
+   -- example, UTF-16 recognises a BOM (byte-order-mark) character at
+   -- the beginning of the input, and remembers thereafter whether to
+   -- use big-endian or little-endian mode.  In this case, the state
+   -- of the codec would include two pieces of information: whether we
+   -- are at the beginning of the stream (the BOM only occurs at the
+   -- beginning), and if not, whether to use the big or little-endian
+   -- encoding.
+
+  setState :: state -> IO ()
+   -- restore the state of the codec using the state from a previous
+   -- call to 'getState'.
+ }
+
+type CodeBuffer from to = Buffer from -> Buffer to -> IO (CodingProgress, Buffer from, Buffer to)
+type DecodeBuffer = CodeBuffer Word8 Char
+type EncodeBuffer = CodeBuffer Char Word8
+
+type TextDecoder state = BufferCodec Word8 CharBufElem state
+type TextEncoder state = BufferCodec CharBufElem Word8 state
+
+-- | A 'TextEncoding' is a specification of a conversion scheme
+-- between sequences of bytes and sequences of Unicode characters.
+--
+-- For example, UTF-8 is an encoding of Unicode characters into a sequence
+-- of bytes.  The 'TextEncoding' for UTF-8 is 'utf8'.
+data TextEncoding
+  = forall dstate estate . TextEncoding  {
+        textEncodingName :: String,
+                   -- ^ a string that can be passed to 'mkTextEncoding' to
+                   -- create an equivalent 'TextEncoding'.
+        mkTextDecoder :: IO (TextDecoder dstate),
+                   -- ^ Creates a means of decoding bytes into characters: the result must not
+                   -- be shared between several byte sequences or simultaneously across threads
+        mkTextEncoder :: IO (TextEncoder estate)
+                   -- ^ Creates a means of encode characters into bytes: the result must not
+                   -- be shared between several character sequences or simultaneously across threads
+  }
+
+instance Show TextEncoding where
+  -- | Returns the value of 'textEncodingName'
+  show te = textEncodingName te
+
+-- | /Since: 4.4.0.0/
+data CodingProgress = InputUnderflow  -- ^ Stopped because the input contains insufficient available elements,
+                                      -- or all of the input sequence has been sucessfully translated.
+                    | OutputUnderflow -- ^ Stopped because the output contains insufficient free elements
+                    | InvalidSequence -- ^ Stopped because there are sufficient free elements in the output
+                                      -- to output at least one encoded ASCII character, but the input contains
+                                      -- an invalid or unrepresentable sequence
+                    deriving (Eq, Show)
+
diff --git a/libraries/base/GHC/IO/Encoding/UTF16.hs b/libraries/base/GHC/IO/Encoding/UTF16.hs
new file mode 100644
index 000000000000..b0ff992a0dfc
--- /dev/null
+++ b/libraries/base/GHC/IO/Encoding/UTF16.hs
@@ -0,0 +1,360 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE NoImplicitPrelude
+           , BangPatterns
+           , NondecreasingIndentation
+           , MagicHash
+  #-}
+{-# OPTIONS_GHC  -funbox-strict-fields #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.IO.Encoding.UTF16
+-- Copyright   :  (c) The University of Glasgow, 2009
+-- License     :  see libraries/base/LICENSE
+-- 
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  internal
+-- Portability :  non-portable
+--
+-- UTF-16 Codecs for the IO library
+--
+-- Portions Copyright   : (c) Tom Harper 2008-2009,
+--                        (c) Bryan O'Sullivan 2009,
+--                        (c) Duncan Coutts 2009
+--
+-----------------------------------------------------------------------------
+
+module GHC.IO.Encoding.UTF16 (
+  utf16, mkUTF16,
+  utf16_decode,
+  utf16_encode,
+
+  utf16be, mkUTF16be,
+  utf16be_decode,
+  utf16be_encode,
+
+  utf16le, mkUTF16le,
+  utf16le_decode,
+  utf16le_encode,
+  ) where
+
+import GHC.Base
+import GHC.Real
+import GHC.Num
+-- import GHC.IO
+import GHC.IO.Buffer
+import GHC.IO.Encoding.Failure
+import GHC.IO.Encoding.Types
+import GHC.Word
+import Data.Bits
+import Data.Maybe
+import GHC.IORef
+
+-- -----------------------------------------------------------------------------
+-- The UTF-16 codec: either UTF16BE or UTF16LE with a BOM
+
+utf16  :: TextEncoding
+utf16 = mkUTF16 ErrorOnCodingFailure
+
+-- | /Since: 4.4.0.0/
+mkUTF16 :: CodingFailureMode -> TextEncoding
+mkUTF16 cfm =  TextEncoding { textEncodingName = "UTF-16",
+                              mkTextDecoder = utf16_DF cfm,
+                              mkTextEncoder = utf16_EF cfm }
+
+utf16_DF :: CodingFailureMode -> IO (TextDecoder (Maybe DecodeBuffer))
+utf16_DF cfm = do
+  seen_bom <- newIORef Nothing
+  return (BufferCodec {
+             encode   = utf16_decode seen_bom,
+             recover  = recoverDecode cfm,
+             close    = return (),
+             getState = readIORef seen_bom,
+             setState = writeIORef seen_bom
+          })
+
+utf16_EF :: CodingFailureMode -> IO (TextEncoder Bool)
+utf16_EF cfm = do
+  done_bom <- newIORef False
+  return (BufferCodec {
+             encode   = utf16_encode done_bom,
+             recover  = recoverEncode cfm,
+             close    = return (),
+             getState = readIORef done_bom,
+             setState = writeIORef done_bom
+          })
+
+utf16_encode :: IORef Bool -> EncodeBuffer
+utf16_encode done_bom input
+  output@Buffer{ bufRaw=oraw, bufL=_, bufR=ow, bufSize=os }
+ = do
+  b <- readIORef done_bom
+  if b then utf16_native_encode input output
+       else if os - ow < 2
+               then return (OutputUnderflow,input,output)
+               else do
+                    writeIORef done_bom True
+                    writeWord8Buf oraw ow     bom1
+                    writeWord8Buf oraw (ow+1) bom2
+                    utf16_native_encode input output{ bufR = ow+2 }
+
+utf16_decode :: IORef (Maybe DecodeBuffer) -> DecodeBuffer
+utf16_decode seen_bom
+  input@Buffer{  bufRaw=iraw, bufL=ir, bufR=iw,  bufSize=_  }
+  output
+ = do
+   mb <- readIORef seen_bom
+   case mb of
+     Just decode -> decode input output
+     Nothing ->
+       if iw - ir < 2 then return (InputUnderflow,input,output) else do
+       c0 <- readWord8Buf iraw ir
+       c1 <- readWord8Buf iraw (ir+1)
+       case () of
+        _ | c0 == bomB && c1 == bomL -> do
+               writeIORef seen_bom (Just utf16be_decode)
+               utf16be_decode input{ bufL= ir+2 } output
+          | c0 == bomL && c1 == bomB -> do
+               writeIORef seen_bom (Just utf16le_decode)
+               utf16le_decode input{ bufL= ir+2 } output
+          | otherwise -> do
+               writeIORef seen_bom (Just utf16_native_decode)
+               utf16_native_decode input output
+
+
+bomB, bomL, bom1, bom2 :: Word8
+bomB = 0xfe
+bomL = 0xff
+
+-- choose UTF-16BE by default for UTF-16 output
+utf16_native_decode :: DecodeBuffer
+utf16_native_decode = utf16be_decode
+
+utf16_native_encode :: EncodeBuffer
+utf16_native_encode = utf16be_encode
+
+bom1 = bomB
+bom2 = bomL
+
+-- -----------------------------------------------------------------------------
+-- UTF16LE and UTF16BE
+
+utf16be :: TextEncoding
+utf16be = mkUTF16be ErrorOnCodingFailure
+
+-- | /Since: 4.4.0.0/
+mkUTF16be :: CodingFailureMode -> TextEncoding
+mkUTF16be cfm = TextEncoding { textEncodingName = "UTF-16BE",
+                               mkTextDecoder = utf16be_DF cfm,
+                               mkTextEncoder = utf16be_EF cfm }
+
+utf16be_DF :: CodingFailureMode -> IO (TextDecoder ())
+utf16be_DF cfm =
+  return (BufferCodec {
+             encode   = utf16be_decode,
+             recover  = recoverDecode cfm,
+             close    = return (),
+             getState = return (),
+             setState = const $ return ()
+          })
+
+utf16be_EF :: CodingFailureMode -> IO (TextEncoder ())
+utf16be_EF cfm =
+  return (BufferCodec {
+             encode   = utf16be_encode,
+             recover  = recoverEncode cfm,
+             close    = return (),
+             getState = return (),
+             setState = const $ return ()
+          })
+
+utf16le :: TextEncoding
+utf16le = mkUTF16le ErrorOnCodingFailure
+
+-- | /Since: 4.4.0.0/
+mkUTF16le :: CodingFailureMode -> TextEncoding
+mkUTF16le cfm = TextEncoding { textEncodingName = "UTF16-LE",
+                               mkTextDecoder = utf16le_DF cfm,
+                               mkTextEncoder = utf16le_EF cfm }
+
+utf16le_DF :: CodingFailureMode -> IO (TextDecoder ())
+utf16le_DF cfm =
+  return (BufferCodec {
+             encode   = utf16le_decode,
+             recover  = recoverDecode cfm,
+             close    = return (),
+             getState = return (),
+             setState = const $ return ()
+          })
+
+utf16le_EF :: CodingFailureMode -> IO (TextEncoder ())
+utf16le_EF cfm =
+  return (BufferCodec {
+             encode   = utf16le_encode,
+             recover  = recoverEncode cfm,
+             close    = return (),
+             getState = return (),
+             setState = const $ return ()
+          })
+
+
+utf16be_decode :: DecodeBuffer
+utf16be_decode 
+  input@Buffer{  bufRaw=iraw, bufL=ir0, bufR=iw,  bufSize=_  }
+  output@Buffer{ bufRaw=oraw, bufL=_,   bufR=ow0, bufSize=os }
+ = let 
+       loop !ir !ow
+         | ow >= os     = done OutputUnderflow ir ow
+         | ir >= iw     = done InputUnderflow ir ow
+         | ir + 1 == iw = done InputUnderflow ir ow
+         | otherwise = do
+              c0 <- readWord8Buf iraw ir
+              c1 <- readWord8Buf iraw (ir+1)
+              let x1 = fromIntegral c0 `shiftL` 8 + fromIntegral c1
+              if validate1 x1
+                 then do ow' <- writeCharBuf oraw ow (unsafeChr (fromIntegral x1))
+                         loop (ir+2) ow'
+                 else if iw - ir < 4 then done InputUnderflow ir ow else do
+                      c2 <- readWord8Buf iraw (ir+2)
+                      c3 <- readWord8Buf iraw (ir+3)
+                      let x2 = fromIntegral c2 `shiftL` 8 + fromIntegral c3
+                      if not (validate2 x1 x2) then invalid else do
+                      ow' <- writeCharBuf oraw ow (chr2 x1 x2)
+                      loop (ir+4) ow'
+         where
+           invalid = done InvalidSequence ir ow
+
+       -- lambda-lifted, to avoid thunks being built in the inner-loop:
+       done why !ir !ow = return (why,
+                                  if ir == iw then input{ bufL=0, bufR=0 }
+                                              else input{ bufL=ir },
+                                  output{ bufR=ow })
+    in
+    loop ir0 ow0
+
+utf16le_decode :: DecodeBuffer
+utf16le_decode 
+  input@Buffer{  bufRaw=iraw, bufL=ir0, bufR=iw,  bufSize=_  }
+  output@Buffer{ bufRaw=oraw, bufL=_,   bufR=ow0, bufSize=os }
+ = let 
+       loop !ir !ow
+         | ow >= os     = done OutputUnderflow ir ow
+         | ir >= iw     = done InputUnderflow ir ow
+         | ir + 1 == iw = done InputUnderflow ir ow
+         | otherwise = do
+              c0 <- readWord8Buf iraw ir
+              c1 <- readWord8Buf iraw (ir+1)
+              let x1 = fromIntegral c1 `shiftL` 8 + fromIntegral c0
+              if validate1 x1
+                 then do ow' <- writeCharBuf oraw ow (unsafeChr (fromIntegral x1))
+                         loop (ir+2) ow'
+                 else if iw - ir < 4 then done InputUnderflow ir ow else do
+                      c2 <- readWord8Buf iraw (ir+2)
+                      c3 <- readWord8Buf iraw (ir+3)
+                      let x2 = fromIntegral c3 `shiftL` 8 + fromIntegral c2
+                      if not (validate2 x1 x2) then invalid else do
+                      ow' <- writeCharBuf oraw ow (chr2 x1 x2)
+                      loop (ir+4) ow'
+         where
+           invalid = done InvalidSequence ir ow
+
+       -- lambda-lifted, to avoid thunks being built in the inner-loop:
+       done why !ir !ow = return (why,
+                                  if ir == iw then input{ bufL=0, bufR=0 }
+                                              else input{ bufL=ir },
+                                  output{ bufR=ow })
+    in
+    loop ir0 ow0
+
+utf16be_encode :: EncodeBuffer
+utf16be_encode
+  input@Buffer{  bufRaw=iraw, bufL=ir0, bufR=iw,  bufSize=_  }
+  output@Buffer{ bufRaw=oraw, bufL=_,   bufR=ow0, bufSize=os }
+ = let 
+      done why !ir !ow = return (why,
+                                 if ir == iw then input{ bufL=0, bufR=0 }
+                                             else input{ bufL=ir },
+                                 output{ bufR=ow })
+      loop !ir !ow
+        | ir >= iw     =  done InputUnderflow ir ow
+        | os - ow < 2  =  done OutputUnderflow ir ow
+        | otherwise = do
+           (c,ir') <- readCharBuf iraw ir
+           case ord c of
+             x | x < 0x10000 -> if isSurrogate c then done InvalidSequence ir ow else do
+                    writeWord8Buf oraw ow     (fromIntegral (x `shiftR` 8))
+                    writeWord8Buf oraw (ow+1) (fromIntegral x)
+                    loop ir' (ow+2)
+               | otherwise -> do
+                    if os - ow < 4 then done OutputUnderflow ir ow else do
+                    let 
+                         n1 = x - 0x10000
+                         c1 = fromIntegral (n1 `shiftR` 18 + 0xD8)
+                         c2 = fromIntegral (n1 `shiftR` 10)
+                         n2 = n1 .&. 0x3FF
+                         c3 = fromIntegral (n2 `shiftR` 8 + 0xDC)
+                         c4 = fromIntegral n2
+                    --
+                    writeWord8Buf oraw ow     c1
+                    writeWord8Buf oraw (ow+1) c2
+                    writeWord8Buf oraw (ow+2) c3
+                    writeWord8Buf oraw (ow+3) c4
+                    loop ir' (ow+4)
+    in
+    loop ir0 ow0
+
+utf16le_encode :: EncodeBuffer
+utf16le_encode
+  input@Buffer{  bufRaw=iraw, bufL=ir0, bufR=iw,  bufSize=_  }
+  output@Buffer{ bufRaw=oraw, bufL=_,   bufR=ow0, bufSize=os }
+ = let
+      done why !ir !ow = return (why,
+                                 if ir == iw then input{ bufL=0, bufR=0 }
+                                             else input{ bufL=ir },
+                                 output{ bufR=ow })
+      loop !ir !ow
+        | ir >= iw     =  done InputUnderflow ir ow
+        | os - ow < 2  =  done OutputUnderflow ir ow
+        | otherwise = do
+           (c,ir') <- readCharBuf iraw ir
+           case ord c of
+             x | x < 0x10000 -> if isSurrogate c then done InvalidSequence ir ow else do
+                    writeWord8Buf oraw ow     (fromIntegral x)
+                    writeWord8Buf oraw (ow+1) (fromIntegral (x `shiftR` 8))
+                    loop ir' (ow+2)
+               | otherwise ->
+                    if os - ow < 4 then done OutputUnderflow ir ow else do
+                    let 
+                         n1 = x - 0x10000
+                         c1 = fromIntegral (n1 `shiftR` 18 + 0xD8)
+                         c2 = fromIntegral (n1 `shiftR` 10)
+                         n2 = n1 .&. 0x3FF
+                         c3 = fromIntegral (n2 `shiftR` 8 + 0xDC)
+                         c4 = fromIntegral n2
+                    --
+                    writeWord8Buf oraw ow     c2
+                    writeWord8Buf oraw (ow+1) c1
+                    writeWord8Buf oraw (ow+2) c4
+                    writeWord8Buf oraw (ow+3) c3
+                    loop ir' (ow+4)
+    in
+    loop ir0 ow0
+
+chr2 :: Word16 -> Word16 -> Char
+chr2 (W16# a#) (W16# b#) = C# (chr# (upper# +# lower# +# 0x10000#))
+    where
+      !x# = word2Int# a#
+      !y# = word2Int# b#
+      !upper# = uncheckedIShiftL# (x# -# 0xD800#) 10#
+      !lower# = y# -# 0xDC00#
+{-# INLINE chr2 #-}
+
+validate1    :: Word16 -> Bool
+validate1 x1 = (x1 >= 0 && x1 < 0xD800) || x1 > 0xDFFF
+{-# INLINE validate1 #-}
+
+validate2       ::  Word16 -> Word16 -> Bool
+validate2 x1 x2 = x1 >= 0xD800 && x1 <= 0xDBFF &&
+                  x2 >= 0xDC00 && x2 <= 0xDFFF
+{-# INLINE validate2 #-}
+
diff --git a/libraries/base/GHC/IO/Encoding/UTF32.hs b/libraries/base/GHC/IO/Encoding/UTF32.hs
new file mode 100644
index 000000000000..eddc4f869337
--- /dev/null
+++ b/libraries/base/GHC/IO/Encoding/UTF32.hs
@@ -0,0 +1,337 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE NoImplicitPrelude
+           , BangPatterns
+           , NondecreasingIndentation
+           , MagicHash
+  #-}
+{-# OPTIONS_GHC  -funbox-strict-fields #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.IO.Encoding.UTF32
+-- Copyright   :  (c) The University of Glasgow, 2009
+-- License     :  see libraries/base/LICENSE
+-- 
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  internal
+-- Portability :  non-portable
+--
+-- UTF-32 Codecs for the IO library
+--
+-- Portions Copyright   : (c) Tom Harper 2008-2009,
+--                        (c) Bryan O'Sullivan 2009,
+--                        (c) Duncan Coutts 2009
+--
+-----------------------------------------------------------------------------
+
+module GHC.IO.Encoding.UTF32 (
+  utf32, mkUTF32,
+  utf32_decode,
+  utf32_encode,
+
+  utf32be, mkUTF32be,
+  utf32be_decode,
+  utf32be_encode,
+
+  utf32le, mkUTF32le,
+  utf32le_decode,
+  utf32le_encode,
+  ) where
+
+import GHC.Base
+import GHC.Real
+import GHC.Num
+-- import GHC.IO
+import GHC.IO.Buffer
+import GHC.IO.Encoding.Failure
+import GHC.IO.Encoding.Types
+import GHC.Word
+import Data.Bits
+import Data.Maybe
+import GHC.IORef
+
+-- -----------------------------------------------------------------------------
+-- The UTF-32 codec: either UTF-32BE or UTF-32LE with a BOM
+
+utf32  :: TextEncoding
+utf32 = mkUTF32 ErrorOnCodingFailure
+
+-- | /Since: 4.4.0.0/
+mkUTF32 :: CodingFailureMode -> TextEncoding
+mkUTF32 cfm = TextEncoding { textEncodingName = "UTF-32",
+                             mkTextDecoder = utf32_DF cfm,
+                             mkTextEncoder = utf32_EF cfm }
+
+utf32_DF :: CodingFailureMode -> IO (TextDecoder (Maybe DecodeBuffer))
+utf32_DF cfm = do
+  seen_bom <- newIORef Nothing
+  return (BufferCodec {
+             encode   = utf32_decode seen_bom,
+             recover  = recoverDecode cfm,
+             close    = return (),
+             getState = readIORef seen_bom,
+             setState = writeIORef seen_bom
+          })
+
+utf32_EF :: CodingFailureMode -> IO (TextEncoder Bool)
+utf32_EF cfm = do
+  done_bom <- newIORef False
+  return (BufferCodec {
+             encode   = utf32_encode done_bom,
+             recover  = recoverEncode cfm,
+             close    = return (),
+             getState = readIORef done_bom,
+             setState = writeIORef done_bom
+          })
+
+utf32_encode :: IORef Bool -> EncodeBuffer
+utf32_encode done_bom input
+  output@Buffer{ bufRaw=oraw, bufL=_, bufR=ow, bufSize=os }
+ = do
+  b <- readIORef done_bom
+  if b then utf32_native_encode input output
+       else if os - ow < 4
+               then return (OutputUnderflow, input,output)
+               else do
+                    writeIORef done_bom True
+                    writeWord8Buf oraw ow     bom0
+                    writeWord8Buf oraw (ow+1) bom1
+                    writeWord8Buf oraw (ow+2) bom2
+                    writeWord8Buf oraw (ow+3) bom3
+                    utf32_native_encode input output{ bufR = ow+4 }
+
+utf32_decode :: IORef (Maybe DecodeBuffer) -> DecodeBuffer
+utf32_decode seen_bom
+  input@Buffer{  bufRaw=iraw, bufL=ir, bufR=iw,  bufSize=_  }
+  output
+ = do
+   mb <- readIORef seen_bom
+   case mb of
+     Just decode -> decode input output
+     Nothing ->
+       if iw - ir < 4 then return (InputUnderflow, input,output) else do
+       c0 <- readWord8Buf iraw ir
+       c1 <- readWord8Buf iraw (ir+1)
+       c2 <- readWord8Buf iraw (ir+2)
+       c3 <- readWord8Buf iraw (ir+3)
+       case () of
+        _ | c0 == bom0 && c1 == bom1 && c2 == bom2 && c3 == bom3 -> do
+               writeIORef seen_bom (Just utf32be_decode)
+               utf32be_decode input{ bufL= ir+4 } output
+        _ | c0 == bom3 && c1 == bom2 && c2 == bom1 && c3 == bom0 -> do
+               writeIORef seen_bom (Just utf32le_decode)
+               utf32le_decode input{ bufL= ir+4 } output
+          | otherwise -> do
+               writeIORef seen_bom (Just utf32_native_decode)
+               utf32_native_decode input output
+
+
+bom0, bom1, bom2, bom3 :: Word8
+bom0 = 0
+bom1 = 0
+bom2 = 0xfe
+bom3 = 0xff
+
+-- choose UTF-32BE by default for UTF-32 output
+utf32_native_decode :: DecodeBuffer
+utf32_native_decode = utf32be_decode
+
+utf32_native_encode :: EncodeBuffer
+utf32_native_encode = utf32be_encode
+
+-- -----------------------------------------------------------------------------
+-- UTF32LE and UTF32BE
+
+utf32be :: TextEncoding
+utf32be = mkUTF32be ErrorOnCodingFailure
+
+-- | /Since: 4.4.0.0/
+mkUTF32be :: CodingFailureMode -> TextEncoding
+mkUTF32be cfm = TextEncoding { textEncodingName = "UTF-32BE",
+                               mkTextDecoder = utf32be_DF cfm,
+                               mkTextEncoder = utf32be_EF cfm }
+
+utf32be_DF :: CodingFailureMode -> IO (TextDecoder ())
+utf32be_DF cfm =
+  return (BufferCodec {
+             encode   = utf32be_decode,
+             recover  = recoverDecode cfm,
+             close    = return (),
+             getState = return (),
+             setState = const $ return ()
+          })
+
+utf32be_EF :: CodingFailureMode -> IO (TextEncoder ())
+utf32be_EF cfm =
+  return (BufferCodec {
+             encode   = utf32be_encode,
+             recover  = recoverEncode cfm,
+             close    = return (),
+             getState = return (),
+             setState = const $ return ()
+          })
+
+
+utf32le :: TextEncoding
+utf32le = mkUTF32le ErrorOnCodingFailure
+
+-- | /Since: 4.4.0.0/
+mkUTF32le :: CodingFailureMode -> TextEncoding
+mkUTF32le cfm = TextEncoding { textEncodingName = "UTF-32LE",
+                               mkTextDecoder = utf32le_DF cfm,
+                               mkTextEncoder = utf32le_EF cfm }
+
+utf32le_DF :: CodingFailureMode -> IO (TextDecoder ())
+utf32le_DF cfm =
+  return (BufferCodec {
+             encode   = utf32le_decode,
+             recover  = recoverDecode cfm,
+             close    = return (),
+             getState = return (),
+             setState = const $ return ()
+          })
+
+utf32le_EF :: CodingFailureMode -> IO (TextEncoder ())
+utf32le_EF cfm =
+  return (BufferCodec {
+             encode   = utf32le_encode,
+             recover  = recoverEncode cfm,
+             close    = return (),
+             getState = return (),
+             setState = const $ return ()
+          })
+
+
+utf32be_decode :: DecodeBuffer
+utf32be_decode 
+  input@Buffer{  bufRaw=iraw, bufL=ir0, bufR=iw,  bufSize=_  }
+  output@Buffer{ bufRaw=oraw, bufL=_,   bufR=ow0, bufSize=os }
+ = let 
+       loop !ir !ow
+         | ow >= os    = done OutputUnderflow ir ow
+         | iw - ir < 4 = done InputUnderflow  ir ow
+         | otherwise = do
+              c0 <- readWord8Buf iraw ir
+              c1 <- readWord8Buf iraw (ir+1)
+              c2 <- readWord8Buf iraw (ir+2)
+              c3 <- readWord8Buf iraw (ir+3)
+              let x1 = chr4 c0 c1 c2 c3
+              if not (validate x1) then invalid else do
+              ow' <- writeCharBuf oraw ow x1
+              loop (ir+4) ow'
+         where
+           invalid = done InvalidSequence ir ow
+
+       -- lambda-lifted, to avoid thunks being built in the inner-loop:
+       done why !ir !ow = return (why,
+                                  if ir == iw then input{ bufL=0, bufR=0 }
+                                              else input{ bufL=ir },
+                                  output{ bufR=ow })
+    in
+    loop ir0 ow0
+
+utf32le_decode :: DecodeBuffer
+utf32le_decode 
+  input@Buffer{  bufRaw=iraw, bufL=ir0, bufR=iw,  bufSize=_  }
+  output@Buffer{ bufRaw=oraw, bufL=_,   bufR=ow0, bufSize=os }
+ = let 
+       loop !ir !ow
+         | ow >= os    = done OutputUnderflow ir ow
+         | iw - ir < 4 = done InputUnderflow  ir ow
+         | otherwise = do
+              c0 <- readWord8Buf iraw ir
+              c1 <- readWord8Buf iraw (ir+1)
+              c2 <- readWord8Buf iraw (ir+2)
+              c3 <- readWord8Buf iraw (ir+3)
+              let x1 = chr4 c3 c2 c1 c0
+              if not (validate x1) then invalid else do
+              ow' <- writeCharBuf oraw ow x1
+              loop (ir+4) ow'
+         where
+           invalid = done InvalidSequence ir ow
+
+       -- lambda-lifted, to avoid thunks being built in the inner-loop:
+       done why !ir !ow = return (why,
+                                  if ir == iw then input{ bufL=0, bufR=0 }
+                                              else input{ bufL=ir },
+                                  output{ bufR=ow })
+    in
+    loop ir0 ow0
+
+utf32be_encode :: EncodeBuffer
+utf32be_encode
+  input@Buffer{  bufRaw=iraw, bufL=ir0, bufR=iw,  bufSize=_  }
+  output@Buffer{ bufRaw=oraw, bufL=_,   bufR=ow0, bufSize=os }
+ = let 
+      done why !ir !ow = return (why,
+                                 if ir == iw then input{ bufL=0, bufR=0 }
+                                             else input{ bufL=ir },
+                                 output{ bufR=ow })
+      loop !ir !ow
+        | ir >= iw    = done InputUnderflow  ir ow
+        | os - ow < 4 = done OutputUnderflow ir ow
+        | otherwise = do
+           (c,ir') <- readCharBuf iraw ir
+           if isSurrogate c then done InvalidSequence ir ow else do
+             let (c0,c1,c2,c3) = ord4 c
+             writeWord8Buf oraw ow     c0
+             writeWord8Buf oraw (ow+1) c1
+             writeWord8Buf oraw (ow+2) c2
+             writeWord8Buf oraw (ow+3) c3
+             loop ir' (ow+4)
+    in
+    loop ir0 ow0
+
+utf32le_encode :: EncodeBuffer
+utf32le_encode
+  input@Buffer{  bufRaw=iraw, bufL=ir0, bufR=iw,  bufSize=_  }
+  output@Buffer{ bufRaw=oraw, bufL=_,   bufR=ow0, bufSize=os }
+ = let
+      done why !ir !ow = return (why,
+                                 if ir == iw then input{ bufL=0, bufR=0 }
+                                             else input{ bufL=ir },
+                                 output{ bufR=ow })
+      loop !ir !ow
+        | ir >= iw    = done InputUnderflow  ir ow
+        | os - ow < 4 = done OutputUnderflow ir ow
+        | otherwise = do
+           (c,ir') <- readCharBuf iraw ir
+           if isSurrogate c then done InvalidSequence ir ow else do
+             let (c0,c1,c2,c3) = ord4 c
+             writeWord8Buf oraw ow     c3
+             writeWord8Buf oraw (ow+1) c2
+             writeWord8Buf oraw (ow+2) c1
+             writeWord8Buf oraw (ow+3) c0
+             loop ir' (ow+4)
+    in
+    loop ir0 ow0
+
+chr4 :: Word8 -> Word8 -> Word8 -> Word8 -> Char
+chr4 (W8# x1#) (W8# x2#) (W8# x3#) (W8# x4#) =
+    C# (chr# (z1# +# z2# +# z3# +# z4#))
+    where
+      !y1# = word2Int# x1#
+      !y2# = word2Int# x2#
+      !y3# = word2Int# x3#
+      !y4# = word2Int# x4#
+      !z1# = uncheckedIShiftL# y1# 24#
+      !z2# = uncheckedIShiftL# y2# 16#
+      !z3# = uncheckedIShiftL# y3# 8#
+      !z4# = y4#
+{-# INLINE chr4 #-}
+
+ord4 :: Char -> (Word8,Word8,Word8,Word8)
+ord4 c = (fromIntegral (x `shiftR` 24), 
+          fromIntegral (x `shiftR` 16), 
+          fromIntegral (x `shiftR` 8),
+          fromIntegral x)
+  where
+    x = ord c
+{-# INLINE ord4 #-}
+
+
+validate    :: Char -> Bool
+validate c = (x1 >= 0x0 && x1 < 0xD800) || (x1 > 0xDFFF && x1 <= 0x10FFFF)
+   where x1 = ord c
+{-# INLINE validate #-}
+
diff --git a/libraries/base/GHC/IO/Encoding/UTF8.hs b/libraries/base/GHC/IO/Encoding/UTF8.hs
new file mode 100644
index 000000000000..1c48acf18eb0
--- /dev/null
+++ b/libraries/base/GHC/IO/Encoding/UTF8.hs
@@ -0,0 +1,362 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE NoImplicitPrelude
+           , BangPatterns
+           , NondecreasingIndentation
+           , MagicHash
+  #-}
+{-# OPTIONS_GHC -funbox-strict-fields #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.IO.Encoding.UTF8
+-- Copyright   :  (c) The University of Glasgow, 2009
+-- License     :  see libraries/base/LICENSE
+-- 
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  internal
+-- Portability :  non-portable
+--
+-- UTF-8 Codec for the IO library
+--
+-- Portions Copyright   : (c) Tom Harper 2008-2009,
+--                        (c) Bryan O'Sullivan 2009,
+--                        (c) Duncan Coutts 2009
+--
+-----------------------------------------------------------------------------
+
+module GHC.IO.Encoding.UTF8 (
+  utf8, mkUTF8,
+  utf8_bom, mkUTF8_bom
+  ) where
+
+import GHC.Base
+import GHC.Real
+import GHC.Num
+import GHC.IORef
+-- import GHC.IO
+import GHC.IO.Buffer
+import GHC.IO.Encoding.Failure
+import GHC.IO.Encoding.Types
+import GHC.Word
+import Data.Bits
+
+utf8 :: TextEncoding
+utf8 = mkUTF8 ErrorOnCodingFailure
+
+-- | /Since: 4.4.0.0/
+mkUTF8 :: CodingFailureMode -> TextEncoding
+mkUTF8 cfm = TextEncoding { textEncodingName = "UTF-8",
+                            mkTextDecoder = utf8_DF cfm,
+                            mkTextEncoder = utf8_EF cfm }
+
+
+utf8_DF :: CodingFailureMode -> IO (TextDecoder ())
+utf8_DF cfm =
+  return (BufferCodec {
+             encode   = utf8_decode,
+             recover  = recoverDecode cfm,
+             close    = return (),
+             getState = return (),
+             setState = const $ return ()
+          })
+
+utf8_EF :: CodingFailureMode -> IO (TextEncoder ())
+utf8_EF cfm =
+  return (BufferCodec {
+             encode   = utf8_encode,
+             recover  = recoverEncode cfm,
+             close    = return (),
+             getState = return (),
+             setState = const $ return ()
+          })
+
+utf8_bom :: TextEncoding
+utf8_bom = mkUTF8_bom ErrorOnCodingFailure
+
+mkUTF8_bom :: CodingFailureMode -> TextEncoding
+mkUTF8_bom cfm = TextEncoding { textEncodingName = "UTF-8BOM",
+                                mkTextDecoder = utf8_bom_DF cfm,
+                                mkTextEncoder = utf8_bom_EF cfm }
+
+utf8_bom_DF :: CodingFailureMode -> IO (TextDecoder Bool)
+utf8_bom_DF cfm = do
+   ref <- newIORef True
+   return (BufferCodec {
+             encode   = utf8_bom_decode ref,
+             recover  = recoverDecode cfm,
+             close    = return (),
+             getState = readIORef ref,
+             setState = writeIORef ref
+          })
+
+utf8_bom_EF :: CodingFailureMode -> IO (TextEncoder Bool)
+utf8_bom_EF cfm = do
+   ref <- newIORef True
+   return (BufferCodec {
+             encode   = utf8_bom_encode ref,
+             recover  = recoverEncode cfm,
+             close    = return (),
+             getState = readIORef ref,
+             setState = writeIORef ref
+          })
+
+utf8_bom_decode :: IORef Bool -> DecodeBuffer
+utf8_bom_decode ref
+  input@Buffer{  bufRaw=iraw, bufL=ir, bufR=iw,  bufSize=_  }
+  output
+ = do
+   first <- readIORef ref
+   if not first
+      then utf8_decode input output
+      else do
+       let no_bom = do writeIORef ref False; utf8_decode input output
+       if iw - ir < 1 then return (InputUnderflow,input,output) else do
+       c0 <- readWord8Buf iraw ir
+       if (c0 /= bom0) then no_bom else do
+       if iw - ir < 2 then return (InputUnderflow,input,output) else do
+       c1 <- readWord8Buf iraw (ir+1)
+       if (c1 /= bom1) then no_bom else do
+       if iw - ir < 3 then return (InputUnderflow,input,output) else do
+       c2 <- readWord8Buf iraw (ir+2)
+       if (c2 /= bom2) then no_bom else do
+       -- found a BOM, ignore it and carry on
+       writeIORef ref False
+       utf8_decode input{ bufL = ir + 3 } output
+
+utf8_bom_encode :: IORef Bool -> EncodeBuffer
+utf8_bom_encode ref input
+  output@Buffer{ bufRaw=oraw, bufL=_, bufR=ow, bufSize=os }
+ = do
+  b <- readIORef ref
+  if not b then utf8_encode input output
+           else if os - ow < 3
+                  then return (OutputUnderflow,input,output)
+                  else do
+                    writeIORef ref False
+                    writeWord8Buf oraw ow     bom0
+                    writeWord8Buf oraw (ow+1) bom1
+                    writeWord8Buf oraw (ow+2) bom2
+                    utf8_encode input output{ bufR = ow+3 }
+
+bom0, bom1, bom2 :: Word8
+bom0 = 0xef
+bom1 = 0xbb
+bom2 = 0xbf
+
+utf8_decode :: DecodeBuffer
+utf8_decode 
+  input@Buffer{  bufRaw=iraw, bufL=ir0, bufR=iw,  bufSize=_  }
+  output@Buffer{ bufRaw=oraw, bufL=_,   bufR=ow0, bufSize=os }
+ = let 
+       loop !ir !ow
+         | ow >= os = done OutputUnderflow ir ow
+         | ir >= iw = done InputUnderflow ir ow
+         | otherwise = do
+              c0 <- readWord8Buf iraw ir
+              case c0 of
+                _ | c0 <= 0x7f -> do 
+                           ow' <- writeCharBuf oraw ow (unsafeChr (fromIntegral c0))
+                           loop (ir+1) ow'
+                  | c0 >= 0xc0 && c0 <= 0xc1 -> invalid -- Overlong forms
+                  | c0 >= 0xc2 && c0 <= 0xdf ->
+                           if iw - ir < 2 then done InputUnderflow ir ow else do
+                           c1 <- readWord8Buf iraw (ir+1)
+                           if (c1 < 0x80 || c1 >= 0xc0) then invalid else do
+                           ow' <- writeCharBuf oraw ow (chr2 c0 c1)
+                           loop (ir+2) ow'
+                  | c0 >= 0xe0 && c0 <= 0xef ->
+                      case iw - ir of
+                        1 -> done InputUnderflow ir ow
+                        2 -> do -- check for an error even when we don't have
+                                -- the full sequence yet (#3341)
+                           c1 <- readWord8Buf iraw (ir+1)
+                           if not (validate3 c0 c1 0x80) 
+                              then invalid else done InputUnderflow ir ow
+                        _ -> do
+                           c1 <- readWord8Buf iraw (ir+1)
+                           c2 <- readWord8Buf iraw (ir+2)
+                           if not (validate3 c0 c1 c2) then invalid else do
+                           ow' <- writeCharBuf oraw ow (chr3 c0 c1 c2)
+                           loop (ir+3) ow'
+                  | c0 >= 0xf0 ->
+                      case iw - ir of
+                        1 -> done InputUnderflow ir ow
+                        2 -> do -- check for an error even when we don't have
+                                -- the full sequence yet (#3341)
+                           c1 <- readWord8Buf iraw (ir+1)
+                           if not (validate4 c0 c1 0x80 0x80)
+                              then invalid else done InputUnderflow ir ow
+                        3 -> do
+                           c1 <- readWord8Buf iraw (ir+1)
+                           c2 <- readWord8Buf iraw (ir+2)
+                           if not (validate4 c0 c1 c2 0x80)
+                              then invalid else done InputUnderflow ir ow
+                        _ -> do
+                           c1 <- readWord8Buf iraw (ir+1)
+                           c2 <- readWord8Buf iraw (ir+2)
+                           c3 <- readWord8Buf iraw (ir+3)
+                           if not (validate4 c0 c1 c2 c3) then invalid else do
+                           ow' <- writeCharBuf oraw ow (chr4 c0 c1 c2 c3)
+                           loop (ir+4) ow'
+                  | otherwise ->
+                           invalid
+         where
+           invalid = done InvalidSequence ir ow
+
+       -- lambda-lifted, to avoid thunks being built in the inner-loop:
+       done why !ir !ow = return (why,
+                                  if ir == iw then input{ bufL=0, bufR=0 }
+                                              else input{ bufL=ir },
+                                  output{ bufR=ow })
+   in
+   loop ir0 ow0
+
+utf8_encode :: EncodeBuffer
+utf8_encode
+  input@Buffer{  bufRaw=iraw, bufL=ir0, bufR=iw,  bufSize=_  }
+  output@Buffer{ bufRaw=oraw, bufL=_,   bufR=ow0, bufSize=os }
+ = let 
+      done why !ir !ow = return (why,
+                                 if ir == iw then input{ bufL=0, bufR=0 }
+                                             else input{ bufL=ir },
+                                 output{ bufR=ow })
+      loop !ir !ow
+        | ow >= os = done OutputUnderflow ir ow
+        | ir >= iw = done InputUnderflow ir ow
+        | otherwise = do
+           (c,ir') <- readCharBuf iraw ir
+           case ord c of
+             x | x <= 0x7F   -> do
+                    writeWord8Buf oraw ow (fromIntegral x)
+                    loop ir' (ow+1)
+               | x <= 0x07FF ->
+                    if os - ow < 2 then done OutputUnderflow ir ow else do
+                    let (c1,c2) = ord2 c
+                    writeWord8Buf oraw ow     c1
+                    writeWord8Buf oraw (ow+1) c2
+                    loop ir' (ow+2)
+               | x <= 0xFFFF -> if isSurrogate c then done InvalidSequence ir ow else do
+                    if os - ow < 3 then done OutputUnderflow ir ow else do
+                    let (c1,c2,c3) = ord3 c
+                    writeWord8Buf oraw ow     c1
+                    writeWord8Buf oraw (ow+1) c2
+                    writeWord8Buf oraw (ow+2) c3
+                    loop ir' (ow+3)
+               | otherwise -> do
+                    if os - ow < 4 then done OutputUnderflow ir ow else do
+                    let (c1,c2,c3,c4) = ord4 c
+                    writeWord8Buf oraw ow     c1
+                    writeWord8Buf oraw (ow+1) c2
+                    writeWord8Buf oraw (ow+2) c3
+                    writeWord8Buf oraw (ow+3) c4
+                    loop ir' (ow+4)
+   in
+   loop ir0 ow0
+
+-- -----------------------------------------------------------------------------
+-- UTF-8 primitives, lifted from Data.Text.Fusion.Utf8
+  
+ord2   :: Char -> (Word8,Word8)
+ord2 c = assert (n >= 0x80 && n <= 0x07ff) (x1,x2)
+    where
+      n  = ord c
+      x1 = fromIntegral $ (n `shiftR` 6) + 0xC0
+      x2 = fromIntegral $ (n .&. 0x3F)   + 0x80
+
+ord3   :: Char -> (Word8,Word8,Word8)
+ord3 c = assert (n >= 0x0800 && n <= 0xffff) (x1,x2,x3)
+    where
+      n  = ord c
+      x1 = fromIntegral $ (n `shiftR` 12) + 0xE0
+      x2 = fromIntegral $ ((n `shiftR` 6) .&. 0x3F) + 0x80
+      x3 = fromIntegral $ (n .&. 0x3F) + 0x80
+
+ord4   :: Char -> (Word8,Word8,Word8,Word8)
+ord4 c = assert (n >= 0x10000) (x1,x2,x3,x4)
+    where
+      n  = ord c
+      x1 = fromIntegral $ (n `shiftR` 18) + 0xF0
+      x2 = fromIntegral $ ((n `shiftR` 12) .&. 0x3F) + 0x80
+      x3 = fromIntegral $ ((n `shiftR` 6) .&. 0x3F) + 0x80
+      x4 = fromIntegral $ (n .&. 0x3F) + 0x80
+
+chr2       :: Word8 -> Word8 -> Char
+chr2 (W8# x1#) (W8# x2#) = C# (chr# (z1# +# z2#))
+    where
+      !y1# = word2Int# x1#
+      !y2# = word2Int# x2#
+      !z1# = uncheckedIShiftL# (y1# -# 0xC0#) 6#
+      !z2# = y2# -# 0x80#
+{-# INLINE chr2 #-}
+
+chr3          :: Word8 -> Word8 -> Word8 -> Char
+chr3 (W8# x1#) (W8# x2#) (W8# x3#) = C# (chr# (z1# +# z2# +# z3#))
+    where
+      !y1# = word2Int# x1#
+      !y2# = word2Int# x2#
+      !y3# = word2Int# x3#
+      !z1# = uncheckedIShiftL# (y1# -# 0xE0#) 12#
+      !z2# = uncheckedIShiftL# (y2# -# 0x80#) 6#
+      !z3# = y3# -# 0x80#
+{-# INLINE chr3 #-}
+
+chr4             :: Word8 -> Word8 -> Word8 -> Word8 -> Char
+chr4 (W8# x1#) (W8# x2#) (W8# x3#) (W8# x4#) =
+    C# (chr# (z1# +# z2# +# z3# +# z4#))
+    where
+      !y1# = word2Int# x1#
+      !y2# = word2Int# x2#
+      !y3# = word2Int# x3#
+      !y4# = word2Int# x4#
+      !z1# = uncheckedIShiftL# (y1# -# 0xF0#) 18#
+      !z2# = uncheckedIShiftL# (y2# -# 0x80#) 12#
+      !z3# = uncheckedIShiftL# (y3# -# 0x80#) 6#
+      !z4# = y4# -# 0x80#
+{-# INLINE chr4 #-}
+
+between :: Word8                -- ^ byte to check
+        -> Word8                -- ^ lower bound
+        -> Word8                -- ^ upper bound
+        -> Bool
+between x y z = x >= y && x <= z
+{-# INLINE between #-}
+
+validate3          :: Word8 -> Word8 -> Word8 -> Bool
+{-# INLINE validate3 #-}
+validate3 x1 x2 x3 = validate3_1 ||
+                     validate3_2 ||
+                     validate3_3 ||
+                     validate3_4
+  where
+    validate3_1 = (x1 == 0xE0) &&
+                  between x2 0xA0 0xBF &&
+                  between x3 0x80 0xBF
+    validate3_2 = between x1 0xE1 0xEC &&
+                  between x2 0x80 0xBF &&
+                  between x3 0x80 0xBF
+    validate3_3 = x1 == 0xED &&
+                  between x2 0x80 0x9F &&
+                  between x3 0x80 0xBF
+    validate3_4 = between x1 0xEE 0xEF &&
+                  between x2 0x80 0xBF &&
+                  between x3 0x80 0xBF
+
+validate4             :: Word8 -> Word8 -> Word8 -> Word8 -> Bool
+{-# INLINE validate4 #-}
+validate4 x1 x2 x3 x4 = validate4_1 ||
+                        validate4_2 ||
+                        validate4_3
+  where 
+    validate4_1 = x1 == 0xF0 &&
+                  between x2 0x90 0xBF &&
+                  between x3 0x80 0xBF &&
+                  between x4 0x80 0xBF
+    validate4_2 = between x1 0xF1 0xF3 &&
+                  between x2 0x80 0xBF &&
+                  between x3 0x80 0xBF &&
+                  between x4 0x80 0xBF
+    validate4_3 = x1 == 0xF4 &&
+                  between x2 0x80 0x8F &&
+                  between x3 0x80 0xBF &&
+                  between x4 0x80 0xBF
+
diff --git a/libraries/base/GHC/IO/Exception.hs b/libraries/base/GHC/IO/Exception.hs
new file mode 100644
index 000000000000..e7e3316ca9ac
--- /dev/null
+++ b/libraries/base/GHC/IO/Exception.hs
@@ -0,0 +1,372 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE NoImplicitPrelude, AutoDeriveTypeable, MagicHash,
+             ExistentialQuantification #-}
+{-# OPTIONS_GHC -funbox-strict-fields #-}
+{-# OPTIONS_HADDOCK hide #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.IO.Exception
+-- Copyright   :  (c) The University of Glasgow, 2009
+-- License     :  see libraries/base/LICENSE
+--
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  internal
+-- Portability :  non-portable
+--
+-- IO-related Exception types and functions
+--
+-----------------------------------------------------------------------------
+
+module GHC.IO.Exception (
+  BlockedIndefinitelyOnMVar(..), blockedIndefinitelyOnMVar,
+  BlockedIndefinitelyOnSTM(..), blockedIndefinitelyOnSTM,
+  Deadlock(..),
+  AssertionFailed(..),
+
+  SomeAsyncException(..),
+  asyncExceptionToException, asyncExceptionFromException,
+  AsyncException(..), stackOverflow, heapOverflow,
+
+  ArrayException(..),
+  ExitCode(..),
+
+  ioException,
+  ioError,
+  IOError,
+  IOException(..),
+  IOErrorType(..),
+  userError,
+  assertError,
+  unsupportedOperation,
+  untangle,
+ ) where
+
+import GHC.Base
+import GHC.List
+import GHC.IO
+import GHC.Show
+import GHC.Read
+import GHC.Exception
+import Data.Maybe
+import GHC.IO.Handle.Types
+import Foreign.C.Types
+
+import Data.Typeable     ( Typeable, cast )
+
+-- ------------------------------------------------------------------------
+-- Exception datatypes and operations
+
+-- |The thread is blocked on an @MVar@, but there are no other references
+-- to the @MVar@ so it can't ever continue.
+data BlockedIndefinitelyOnMVar = BlockedIndefinitelyOnMVar
+    deriving Typeable
+
+instance Exception BlockedIndefinitelyOnMVar
+
+instance Show BlockedIndefinitelyOnMVar where
+    showsPrec _ BlockedIndefinitelyOnMVar = showString "thread blocked indefinitely in an MVar operation"
+
+blockedIndefinitelyOnMVar :: SomeException -- for the RTS
+blockedIndefinitelyOnMVar = toException BlockedIndefinitelyOnMVar
+
+-----
+
+-- |The thread is waiting to retry an STM transaction, but there are no
+-- other references to any @TVar@s involved, so it can't ever continue.
+data BlockedIndefinitelyOnSTM = BlockedIndefinitelyOnSTM
+    deriving Typeable
+
+instance Exception BlockedIndefinitelyOnSTM
+
+instance Show BlockedIndefinitelyOnSTM where
+    showsPrec _ BlockedIndefinitelyOnSTM = showString "thread blocked indefinitely in an STM transaction"
+
+blockedIndefinitelyOnSTM :: SomeException -- for the RTS
+blockedIndefinitelyOnSTM = toException BlockedIndefinitelyOnSTM
+
+-----
+
+-- |There are no runnable threads, so the program is deadlocked.
+-- The @Deadlock@ exception is raised in the main thread only.
+data Deadlock = Deadlock
+    deriving Typeable
+
+instance Exception Deadlock
+
+instance Show Deadlock where
+    showsPrec _ Deadlock = showString "<<deadlock>>"
+
+-----
+
+-- |'assert' was applied to 'False'.
+data AssertionFailed = AssertionFailed String
+    deriving Typeable
+
+instance Exception AssertionFailed
+
+instance Show AssertionFailed where
+    showsPrec _ (AssertionFailed err) = showString err
+
+-----
+
+-- |Superclass for asynchronous exceptions.
+--
+-- /Since: 4.7.0.0/
+data SomeAsyncException = forall e . Exception e => SomeAsyncException e
+  deriving Typeable
+
+instance Show SomeAsyncException where
+    show (SomeAsyncException e) = show e
+
+instance Exception SomeAsyncException
+
+-- |/Since: 4.7.0.0/
+asyncExceptionToException :: Exception e => e -> SomeException
+asyncExceptionToException = toException . SomeAsyncException
+
+-- |/Since: 4.7.0.0/
+asyncExceptionFromException :: Exception e => SomeException -> Maybe e
+asyncExceptionFromException x = do
+    SomeAsyncException a <- fromException x
+    cast a
+
+
+-- |Asynchronous exceptions.
+data AsyncException
+  = StackOverflow
+        -- ^The current thread\'s stack exceeded its limit.
+        -- Since an exception has been raised, the thread\'s stack
+        -- will certainly be below its limit again, but the
+        -- programmer should take remedial action
+        -- immediately.
+  | HeapOverflow
+        -- ^The program\'s heap is reaching its limit, and
+        -- the program should take action to reduce the amount of
+        -- live data it has. Notes:
+        --
+        --   * It is undefined which thread receives this exception.
+        --
+        --   * GHC currently does not throw 'HeapOverflow' exceptions.
+  | ThreadKilled
+        -- ^This exception is raised by another thread
+        -- calling 'Control.Concurrent.killThread', or by the system
+        -- if it needs to terminate the thread for some
+        -- reason.
+  | UserInterrupt
+        -- ^This exception is raised by default in the main thread of
+        -- the program when the user requests to terminate the program
+        -- via the usual mechanism(s) (e.g. Control-C in the console).
+  deriving (Eq, Ord, Typeable)
+
+instance Exception AsyncException where
+  toException = asyncExceptionToException
+  fromException = asyncExceptionFromException
+
+-- | Exceptions generated by array operations
+data ArrayException
+  = IndexOutOfBounds    String
+        -- ^An attempt was made to index an array outside
+        -- its declared bounds.
+  | UndefinedElement    String
+        -- ^An attempt was made to evaluate an element of an
+        -- array that had not been initialized.
+  deriving (Eq, Ord, Typeable)
+
+instance Exception ArrayException
+
+stackOverflow, heapOverflow :: SomeException -- for the RTS
+stackOverflow = toException StackOverflow
+heapOverflow  = toException HeapOverflow
+
+instance Show AsyncException where
+  showsPrec _ StackOverflow   = showString "stack overflow"
+  showsPrec _ HeapOverflow    = showString "heap overflow"
+  showsPrec _ ThreadKilled    = showString "thread killed"
+  showsPrec _ UserInterrupt   = showString "user interrupt"
+
+instance Show ArrayException where
+  showsPrec _ (IndexOutOfBounds s)
+        = showString "array index out of range"
+        . (if not (null s) then showString ": " . showString s
+                           else id)
+  showsPrec _ (UndefinedElement s)
+        = showString "undefined array element"
+        . (if not (null s) then showString ": " . showString s
+                           else id)
+
+-- -----------------------------------------------------------------------------
+-- The ExitCode type
+
+-- We need it here because it is used in ExitException in the
+-- Exception datatype (above).
+
+-- | Defines the exit codes that a program can return.
+data ExitCode
+  = ExitSuccess -- ^ indicates successful termination;
+  | ExitFailure Int
+                -- ^ indicates program failure with an exit code.
+                -- The exact interpretation of the code is
+                -- operating-system dependent.  In particular, some values
+                -- may be prohibited (e.g. 0 on a POSIX-compliant system).
+  deriving (Eq, Ord, Read, Show, Typeable)
+
+instance Exception ExitCode
+
+ioException     :: IOException -> IO a
+ioException err = throwIO err
+
+-- | Raise an 'IOError' in the 'IO' monad.
+ioError         :: IOError -> IO a
+ioError         =  ioException
+
+-- ---------------------------------------------------------------------------
+-- IOError type
+
+-- | The Haskell 2010 type for exceptions in the 'IO' monad.
+-- Any I\/O operation may raise an 'IOError' instead of returning a result.
+-- For a more general type of exception, including also those that arise
+-- in pure code, see "Control.Exception.Exception".
+--
+-- In Haskell 2010, this is an opaque type.
+type IOError = IOException
+
+-- |Exceptions that occur in the @IO@ monad.
+-- An @IOException@ records a more specific error type, a descriptive
+-- string and maybe the handle that was used when the error was
+-- flagged.
+data IOException
+ = IOError {
+     ioe_handle   :: Maybe Handle,   -- the handle used by the action flagging
+                                     -- the error.
+     ioe_type     :: IOErrorType,    -- what it was.
+     ioe_location :: String,         -- location.
+     ioe_description :: String,      -- error type specific information.
+     ioe_errno    :: Maybe CInt,     -- errno leading to this error, if any.
+     ioe_filename :: Maybe FilePath  -- filename the error is related to.
+   }
+    deriving Typeable
+
+instance Exception IOException
+
+instance Eq IOException where
+  (IOError h1 e1 loc1 str1 en1 fn1) == (IOError h2 e2 loc2 str2 en2 fn2) =
+    e1==e2 && str1==str2 && h1==h2 && loc1==loc2 && en1==en2 && fn1==fn2
+
+-- | An abstract type that contains a value for each variant of 'IOError'.
+data IOErrorType
+  -- Haskell 2010:
+  = AlreadyExists
+  | NoSuchThing
+  | ResourceBusy
+  | ResourceExhausted
+  | EOF
+  | IllegalOperation
+  | PermissionDenied
+  | UserError
+  -- GHC only:
+  | UnsatisfiedConstraints
+  | SystemError
+  | ProtocolError
+  | OtherError
+  | InvalidArgument
+  | InappropriateType
+  | HardwareFault
+  | UnsupportedOperation
+  | TimeExpired
+  | ResourceVanished
+  | Interrupted
+
+instance Eq IOErrorType where
+   x == y = isTrue# (getTag x ==# getTag y)
+
+instance Show IOErrorType where
+  showsPrec _ e =
+    showString $
+    case e of
+      AlreadyExists     -> "already exists"
+      NoSuchThing       -> "does not exist"
+      ResourceBusy      -> "resource busy"
+      ResourceExhausted -> "resource exhausted"
+      EOF               -> "end of file"
+      IllegalOperation  -> "illegal operation"
+      PermissionDenied  -> "permission denied"
+      UserError         -> "user error"
+      HardwareFault     -> "hardware fault"
+      InappropriateType -> "inappropriate type"
+      Interrupted       -> "interrupted"
+      InvalidArgument   -> "invalid argument"
+      OtherError        -> "failed"
+      ProtocolError     -> "protocol error"
+      ResourceVanished  -> "resource vanished"
+      SystemError       -> "system error"
+      TimeExpired       -> "timeout"
+      UnsatisfiedConstraints -> "unsatisified constraints" -- ultra-precise!
+      UnsupportedOperation -> "unsupported operation"
+
+-- | Construct an 'IOError' value with a string describing the error.
+-- The 'fail' method of the 'IO' instance of the 'Monad' class raises a
+-- 'userError', thus:
+--
+-- > instance Monad IO where
+-- >   ...
+-- >   fail s = ioError (userError s)
+--
+userError       :: String  -> IOError
+userError str   =  IOError Nothing UserError "" str Nothing Nothing
+
+-- ---------------------------------------------------------------------------
+-- Showing IOErrors
+
+instance Show IOException where
+    showsPrec p (IOError hdl iot loc s _ fn) =
+      (case fn of
+         Nothing -> case hdl of
+                        Nothing -> id
+                        Just h  -> showsPrec p h . showString ": "
+         Just name -> showString name . showString ": ") .
+      (case loc of
+         "" -> id
+         _  -> showString loc . showString ": ") .
+      showsPrec p iot .
+      (case s of
+         "" -> id
+         _  -> showString " (" . showString s . showString ")")
+
+-- Note the use of "lazy". This means that
+--     assert False (throw e)
+-- will throw the assertion failure rather than e. See trac #5561.
+assertError :: Addr# -> Bool -> a -> a
+assertError str predicate v
+  | predicate = lazy v
+  | otherwise = throw (AssertionFailed (untangle str "Assertion failed"))
+
+unsupportedOperation :: IOError
+unsupportedOperation =
+   (IOError Nothing UnsupportedOperation ""
+        "Operation is not supported" Nothing Nothing)
+
+{-
+(untangle coded message) expects "coded" to be of the form
+        "location|details"
+It prints
+        location message details
+-}
+untangle :: Addr# -> String -> String
+untangle coded message
+  =  location
+  ++ ": "
+  ++ message
+  ++ details
+  ++ "\n"
+  where
+    coded_str = unpackCStringUtf8# coded
+
+    (location, details)
+      = case (span not_bar coded_str) of { (loc, rest) ->
+        case rest of
+          ('|':det) -> (loc, ' ' : det)
+          _         -> (loc, "")
+        }
+    not_bar c = c /= '|'
+
diff --git a/libraries/base/GHC/IO/Exception.hs-boot b/libraries/base/GHC/IO/Exception.hs-boot
new file mode 100644
index 000000000000..3506c1e2719b
--- /dev/null
+++ b/libraries/base/GHC/IO/Exception.hs-boot
@@ -0,0 +1,15 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+
+module GHC.IO.Exception where
+
+import GHC.Base
+import GHC.Exception
+
+data IOException
+instance Exception IOException
+
+type IOError = IOException
+userError :: String  -> IOError
+unsupportedOperation :: IOError
+
diff --git a/libraries/base/GHC/IO/FD.hs b/libraries/base/GHC/IO/FD.hs
new file mode 100644
index 000000000000..1134e95f8dd2
--- /dev/null
+++ b/libraries/base/GHC/IO/FD.hs
@@ -0,0 +1,679 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE CPP
+           , NoImplicitPrelude
+           , BangPatterns
+           , AutoDeriveTypeable
+  #-}
+{-# OPTIONS_GHC -fno-warn-identities #-}
+-- Whether there are identities depends on the platform
+{-# OPTIONS_HADDOCK hide #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.IO.FD
+-- Copyright   :  (c) The University of Glasgow, 1994-2008
+-- License     :  see libraries/base/LICENSE
+--
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  internal
+-- Portability :  non-portable
+--
+-- Raw read/write operations on file descriptors
+--
+-----------------------------------------------------------------------------
+
+module GHC.IO.FD (
+        FD(..),
+        openFile, mkFD, release,
+        setNonBlockingMode,
+        readRawBufferPtr, readRawBufferPtrNoBlock, writeRawBufferPtr,
+        stdin, stdout, stderr
+    ) where
+
+import GHC.Base
+import GHC.Num
+import GHC.Real
+import GHC.Show
+import GHC.Enum
+import Data.Maybe
+import Control.Monad
+import Data.Typeable
+
+import GHC.IO
+import GHC.IO.IOMode
+import GHC.IO.Buffer
+import GHC.IO.BufferedIO
+import qualified GHC.IO.Device
+import GHC.IO.Device (SeekMode(..), IODeviceType(..))
+import GHC.Conc.IO
+import GHC.IO.Exception
+#ifdef mingw32_HOST_OS
+import GHC.Windows
+#endif
+
+import Foreign
+import Foreign.C
+import qualified System.Posix.Internals
+import System.Posix.Internals hiding (FD, setEcho, getEcho)
+import System.Posix.Types
+
+#ifdef mingw32_HOST_OS
+# if defined(i386_HOST_ARCH)
+#  define WINDOWS_CCONV stdcall
+# elif defined(x86_64_HOST_ARCH)
+#  define WINDOWS_CCONV ccall
+# else
+#  error Unknown mingw32 arch
+# endif
+#endif
+
+c_DEBUG_DUMP :: Bool
+c_DEBUG_DUMP = False
+
+-- -----------------------------------------------------------------------------
+-- The file-descriptor IO device
+
+data FD = FD {
+  fdFD :: {-# UNPACK #-} !CInt,
+#ifdef mingw32_HOST_OS
+  -- On Windows, a socket file descriptor needs to be read and written
+  -- using different functions (send/recv).
+  fdIsSocket_ :: {-# UNPACK #-} !Int
+#else
+  -- On Unix we need to know whether this FD has O_NONBLOCK set.
+  -- If it has, then we can use more efficient routines to read/write to it.
+  -- It is always safe for this to be off.
+  fdIsNonBlocking :: {-# UNPACK #-} !Int
+#endif
+ }
+ deriving Typeable
+
+#ifdef mingw32_HOST_OS
+fdIsSocket :: FD -> Bool
+fdIsSocket fd = fdIsSocket_ fd /= 0
+#endif
+
+instance Show FD where
+  show fd = show (fdFD fd)
+
+instance GHC.IO.Device.RawIO FD where
+  read             = fdRead
+  readNonBlocking  = fdReadNonBlocking
+  write            = fdWrite
+  writeNonBlocking = fdWriteNonBlocking
+
+instance GHC.IO.Device.IODevice FD where
+  ready         = ready
+  close         = close
+  isTerminal    = isTerminal
+  isSeekable    = isSeekable
+  seek          = seek
+  tell          = tell
+  getSize       = getSize
+  setSize       = setSize
+  setEcho       = setEcho
+  getEcho       = getEcho
+  setRaw        = setRaw
+  devType       = devType
+  dup           = dup
+  dup2          = dup2
+
+-- We used to use System.Posix.Internals.dEFAULT_BUFFER_SIZE, which is
+-- taken from the value of BUFSIZ on the current platform.  This value
+-- varies too much though: it is 512 on Windows, 1024 on OS X and 8192
+-- on Linux.  So let's just use a decent size on every platform:
+dEFAULT_FD_BUFFER_SIZE :: Int
+dEFAULT_FD_BUFFER_SIZE = 8096
+
+instance BufferedIO FD where
+  newBuffer _dev state = newByteBuffer dEFAULT_FD_BUFFER_SIZE state
+  fillReadBuffer    fd buf = readBuf' fd buf
+  fillReadBuffer0   fd buf = readBufNonBlocking fd buf
+  flushWriteBuffer  fd buf = writeBuf' fd buf
+  flushWriteBuffer0 fd buf = writeBufNonBlocking fd buf
+
+readBuf' :: FD -> Buffer Word8 -> IO (Int, Buffer Word8)
+readBuf' fd buf = do
+  when c_DEBUG_DUMP $
+      puts ("readBuf fd=" ++ show fd ++ " " ++ summaryBuffer buf ++ "\n")
+  (r,buf') <- readBuf fd buf
+  when c_DEBUG_DUMP $
+      puts ("after: " ++ summaryBuffer buf' ++ "\n")
+  return (r,buf')
+
+writeBuf' :: FD -> Buffer Word8 -> IO (Buffer Word8)
+writeBuf' fd buf = do
+  when c_DEBUG_DUMP $
+      puts ("writeBuf fd=" ++ show fd ++ " " ++ summaryBuffer buf ++ "\n")
+  writeBuf fd buf
+
+-- -----------------------------------------------------------------------------
+-- opening files
+
+-- | Open a file and make an 'FD' for it.  Truncates the file to zero
+-- size when the `IOMode` is `WriteMode`.
+openFile
+  :: FilePath -- ^ file to open
+  -> IOMode   -- ^ mode in which to open the file
+  -> Bool     -- ^ open the file in non-blocking mode?
+  -> IO (FD,IODeviceType)
+
+openFile filepath iomode non_blocking =
+  withFilePath filepath $ \ f ->
+
+    let 
+      oflags1 = case iomode of
+                  ReadMode      -> read_flags
+                  WriteMode     -> write_flags
+                  ReadWriteMode -> rw_flags
+                  AppendMode    -> append_flags
+
+#ifdef mingw32_HOST_OS
+      binary_flags = o_BINARY
+#else
+      binary_flags = 0
+#endif
+
+      oflags2 = oflags1 .|. binary_flags
+
+      oflags | non_blocking = oflags2 .|. nonblock_flags
+             | otherwise    = oflags2
+    in do
+
+    -- the old implementation had a complicated series of three opens,
+    -- which is perhaps because we have to be careful not to open
+    -- directories.  However, the man pages I've read say that open()
+    -- always returns EISDIR if the file is a directory and was opened
+    -- for writing, so I think we're ok with a single open() here...
+    fd <- throwErrnoIfMinus1Retry "openFile"
+                (if non_blocking then c_open      f oflags 0o666
+                                 else c_safe_open f oflags 0o666)
+
+    (fD,fd_type) <- mkFD fd iomode Nothing{-no stat-}
+                            False{-not a socket-} 
+                            non_blocking
+            `catchAny` \e -> do _ <- c_close fd
+                                throwIO e
+
+    -- we want to truncate() if this is an open in WriteMode, but only
+    -- if the target is a RegularFile.  ftruncate() fails on special files
+    -- like /dev/null.
+    when (iomode == WriteMode && fd_type == RegularFile) $
+      setSize fD 0
+
+    return (fD,fd_type)
+
+std_flags, output_flags, read_flags, write_flags, rw_flags,
+    append_flags, nonblock_flags :: CInt
+std_flags    = o_NOCTTY
+output_flags = std_flags    .|. o_CREAT
+read_flags   = std_flags    .|. o_RDONLY 
+write_flags  = output_flags .|. o_WRONLY
+rw_flags     = output_flags .|. o_RDWR
+append_flags = write_flags  .|. o_APPEND
+nonblock_flags = o_NONBLOCK
+
+
+-- | Make a 'FD' from an existing file descriptor.  Fails if the FD
+-- refers to a directory.  If the FD refers to a file, `mkFD` locks
+-- the file according to the Haskell 2010 single writer/multiple reader
+-- locking semantics (this is why we need the `IOMode` argument too).
+mkFD :: CInt
+     -> IOMode
+     -> Maybe (IODeviceType, CDev, CIno)
+     -- the results of fdStat if we already know them, or we want
+     -- to prevent fdToHandle_stat from doing its own stat.
+     -- These are used for:
+     --   - we fail if the FD refers to a directory
+     --   - if the FD refers to a file, we lock it using (cdev,cino)
+     -> Bool   -- ^ is a socket (on Windows)
+     -> Bool   -- ^ is in non-blocking mode on Unix
+     -> IO (FD,IODeviceType)
+
+mkFD fd iomode mb_stat is_socket is_nonblock = do
+
+    let _ = (is_socket, is_nonblock) -- warning suppression
+
+    (fd_type,dev,ino) <- 
+        case mb_stat of
+          Nothing   -> fdStat fd
+          Just stat -> return stat
+
+    let write = case iomode of
+                   ReadMode -> False
+                   _ -> True
+
+    case fd_type of
+        Directory -> 
+           ioException (IOError Nothing InappropriateType "openFile"
+                           "is a directory" Nothing Nothing)
+
+        -- regular files need to be locked
+        RegularFile -> do
+           -- On Windows we need an additional call to get a unique device id
+           -- and inode, since fstat just returns 0 for both.
+           (unique_dev, unique_ino) <- getUniqueFileInfo fd dev ino
+           r <- lockFile fd unique_dev unique_ino (fromBool write)
+           when (r == -1)  $
+                ioException (IOError Nothing ResourceBusy "openFile"
+                                   "file is locked" Nothing Nothing)
+
+        _other_type -> return ()
+
+#ifdef mingw32_HOST_OS
+    unless is_socket $ setmode fd True >> return ()
+#endif
+
+    return (FD{ fdFD = fd,
+#ifndef mingw32_HOST_OS
+                fdIsNonBlocking = fromEnum is_nonblock
+#else
+                fdIsSocket_ = fromEnum is_socket
+#endif
+              },
+            fd_type)
+
+getUniqueFileInfo :: CInt -> CDev -> CIno -> IO (Word64, Word64)
+#ifndef mingw32_HOST_OS
+getUniqueFileInfo _ dev ino = return (fromIntegral dev, fromIntegral ino)
+#else
+getUniqueFileInfo fd _ _ = do
+  with 0 $ \devptr -> do
+    with 0 $ \inoptr -> do
+      c_getUniqueFileInfo fd devptr inoptr
+      liftM2 (,) (peek devptr) (peek inoptr)
+#endif
+
+#ifdef mingw32_HOST_OS
+foreign import ccall unsafe "__hscore_setmode"
+  setmode :: CInt -> Bool -> IO CInt
+#endif
+
+-- -----------------------------------------------------------------------------
+-- Standard file descriptors
+
+stdFD :: CInt -> FD
+stdFD fd = FD { fdFD = fd,
+#ifdef mingw32_HOST_OS
+                fdIsSocket_ = 0
+#else
+                fdIsNonBlocking = 0
+   -- We don't set non-blocking mode on standard handles, because it may
+   -- confuse other applications attached to the same TTY/pipe
+   -- see Note [nonblock]
+#endif
+                }
+
+stdin, stdout, stderr :: FD
+stdin  = stdFD 0
+stdout = stdFD 1
+stderr = stdFD 2
+
+-- -----------------------------------------------------------------------------
+-- Operations on file descriptors
+
+close :: FD -> IO ()
+close fd =
+  do let closer realFd =
+           throwErrnoIfMinus1Retry_ "GHC.IO.FD.close" $
+#ifdef mingw32_HOST_OS
+           if fdIsSocket fd then
+             c_closesocket (fromIntegral realFd)
+           else
+#endif
+             c_close (fromIntegral realFd)
+
+     -- release the lock *first*, because otherwise if we're preempted
+     -- after closing but before releasing, the FD may have been reused.
+     -- (#7646)
+     release fd
+
+     closeFdWith closer (fromIntegral (fdFD fd))
+
+release :: FD -> IO ()
+release fd = do _ <- unlockFile (fdFD fd)
+                return ()
+
+#ifdef mingw32_HOST_OS
+foreign import WINDOWS_CCONV unsafe "HsBase.h closesocket"
+   c_closesocket :: CInt -> IO CInt
+#endif
+
+isSeekable :: FD -> IO Bool
+isSeekable fd = do
+  t <- devType fd
+  return (t == RegularFile || t == RawDevice)
+
+seek :: FD -> SeekMode -> Integer -> IO ()
+seek fd mode off = do
+  throwErrnoIfMinus1Retry_ "seek" $
+     c_lseek (fdFD fd) (fromIntegral off) seektype
+ where
+    seektype :: CInt
+    seektype = case mode of
+                   AbsoluteSeek -> sEEK_SET
+                   RelativeSeek -> sEEK_CUR
+                   SeekFromEnd  -> sEEK_END
+
+tell :: FD -> IO Integer
+tell fd =
+ fromIntegral `fmap`
+   (throwErrnoIfMinus1Retry "hGetPosn" $
+      c_lseek (fdFD fd) 0 sEEK_CUR)
+
+getSize :: FD -> IO Integer
+getSize fd = fdFileSize (fdFD fd)
+
+setSize :: FD -> Integer -> IO () 
+setSize fd size = do
+  throwErrnoIf_ (/=0) "GHC.IO.FD.setSize"  $
+     c_ftruncate (fdFD fd) (fromIntegral size)
+
+devType :: FD -> IO IODeviceType
+devType fd = do (ty,_,_) <- fdStat (fdFD fd); return ty
+
+dup :: FD -> IO FD
+dup fd = do
+  newfd <- throwErrnoIfMinus1 "GHC.IO.FD.dup" $ c_dup (fdFD fd)
+  return fd{ fdFD = newfd }
+
+dup2 :: FD -> FD -> IO FD
+dup2 fd fdto = do
+  -- Windows' dup2 does not return the new descriptor, unlike Unix
+  throwErrnoIfMinus1_ "GHC.IO.FD.dup2" $
+    c_dup2 (fdFD fd) (fdFD fdto)
+  return fd{ fdFD = fdFD fdto } -- original FD, with the new fdFD
+
+setNonBlockingMode :: FD -> Bool -> IO FD
+setNonBlockingMode fd set = do 
+  setNonBlockingFD (fdFD fd) set
+#if defined(mingw32_HOST_OS)
+  return fd
+#else
+  return fd{ fdIsNonBlocking = fromEnum set }
+#endif
+
+ready :: FD -> Bool -> Int -> IO Bool
+ready fd write msecs = do
+  r <- throwErrnoIfMinus1Retry "GHC.IO.FD.ready" $
+          fdReady (fdFD fd) (fromIntegral $ fromEnum $ write)
+                            (fromIntegral msecs)
+#if defined(mingw32_HOST_OS)
+                          (fromIntegral $ fromEnum $ fdIsSocket fd)
+#else
+                          0
+#endif
+  return (toEnum (fromIntegral r))
+
+foreign import ccall safe "fdReady"
+  fdReady :: CInt -> CInt -> CInt -> CInt -> IO CInt
+
+-- ---------------------------------------------------------------------------
+-- Terminal-related stuff
+
+isTerminal :: FD -> IO Bool
+isTerminal fd =
+#if defined(mingw32_HOST_OS)
+    if fdIsSocket fd then return False
+                     else is_console (fdFD fd) >>= return.toBool
+#else
+    c_isatty (fdFD fd) >>= return.toBool
+#endif
+
+setEcho :: FD -> Bool -> IO () 
+setEcho fd on = System.Posix.Internals.setEcho (fdFD fd) on
+
+getEcho :: FD -> IO Bool
+getEcho fd = System.Posix.Internals.getEcho (fdFD fd)
+
+setRaw :: FD -> Bool -> IO ()
+setRaw fd raw = System.Posix.Internals.setCooked (fdFD fd) (not raw)
+
+-- -----------------------------------------------------------------------------
+-- Reading and Writing
+
+fdRead :: FD -> Ptr Word8 -> Int -> IO Int
+fdRead fd ptr bytes
+  = do { r <- readRawBufferPtr "GHC.IO.FD.fdRead" fd ptr 0 (fromIntegral bytes)
+       ; return (fromIntegral r) }
+
+fdReadNonBlocking :: FD -> Ptr Word8 -> Int -> IO (Maybe Int)
+fdReadNonBlocking fd ptr bytes = do
+  r <- readRawBufferPtrNoBlock "GHC.IO.FD.fdReadNonBlocking" fd ptr 
+           0 (fromIntegral bytes)
+  case fromIntegral r of
+    (-1) -> return (Nothing)
+    n    -> return (Just n)
+
+
+fdWrite :: FD -> Ptr Word8 -> Int -> IO ()
+fdWrite fd ptr bytes = do
+  res <- writeRawBufferPtr "GHC.IO.FD.fdWrite" fd ptr 0 (fromIntegral bytes)
+  let res' = fromIntegral res
+  if res' < bytes 
+     then fdWrite fd (ptr `plusPtr` res') (bytes - res')
+     else return ()
+
+-- XXX ToDo: this isn't non-blocking
+fdWriteNonBlocking :: FD -> Ptr Word8 -> Int -> IO Int
+fdWriteNonBlocking fd ptr bytes = do
+  res <- writeRawBufferPtrNoBlock "GHC.IO.FD.fdWriteNonBlocking" fd ptr 0
+            (fromIntegral bytes)
+  return (fromIntegral res)
+
+-- -----------------------------------------------------------------------------
+-- FD operations
+
+-- Low level routines for reading/writing to (raw)buffers:
+
+#ifndef mingw32_HOST_OS
+
+{-
+NOTE [nonblock]:
+
+Unix has broken semantics when it comes to non-blocking I/O: you can
+set the O_NONBLOCK flag on an FD, but it applies to the all other FDs
+attached to the same underlying file, pipe or TTY; there's no way to
+have private non-blocking behaviour for an FD.  See bug #724.
+
+We fix this by only setting O_NONBLOCK on FDs that we create; FDs that
+come from external sources or are exposed externally are left in
+blocking mode.  This solution has some problems though.  We can't
+completely simulate a non-blocking read without O_NONBLOCK: several
+cases are wrong here.  The cases that are wrong:
+
+  * reading/writing to a blocking FD in non-threaded mode.
+    In threaded mode, we just make a safe call to read().  
+    In non-threaded mode we call select() before attempting to read,
+    but that leaves a small race window where the data can be read
+    from the file descriptor before we issue our blocking read().
+  * readRawBufferNoBlock for a blocking FD
+
+NOTE [2363]:
+
+In the threaded RTS we could just make safe calls to read()/write()
+for file descriptors in blocking mode without worrying about blocking
+other threads, but the problem with this is that the thread will be
+uninterruptible while it is blocked in the foreign call.  See #2363.
+So now we always call fdReady() before reading, and if fdReady
+indicates that there's no data, we call threadWaitRead.
+
+-}
+
+readRawBufferPtr :: String -> FD -> Ptr Word8 -> Int -> CSize -> IO Int
+readRawBufferPtr loc !fd buf off len
+  | isNonBlocking fd = unsafe_read -- unsafe is ok, it can't block
+  | otherwise    = do r <- throwErrnoIfMinus1 loc 
+                                (unsafe_fdReady (fdFD fd) 0 0 0)
+                      if r /= 0 
+                        then read
+                        else do threadWaitRead (fromIntegral (fdFD fd)); read
+  where
+    do_read call = fromIntegral `fmap`
+                      throwErrnoIfMinus1RetryMayBlock loc call
+                            (threadWaitRead (fromIntegral (fdFD fd)))
+    read        = if threaded then safe_read else unsafe_read
+    unsafe_read = do_read (c_read (fdFD fd) (buf `plusPtr` off) len)
+    safe_read   = do_read (c_safe_read (fdFD fd) (buf `plusPtr` off) len)
+
+-- return: -1 indicates EOF, >=0 is bytes read
+readRawBufferPtrNoBlock :: String -> FD -> Ptr Word8 -> Int -> CSize -> IO Int
+readRawBufferPtrNoBlock loc !fd buf off len
+  | isNonBlocking fd  = unsafe_read -- unsafe is ok, it can't block
+  | otherwise    = do r <- unsafe_fdReady (fdFD fd) 0 0 0
+                      if r /= 0 then safe_read
+                                else return 0
+       -- XXX see note [nonblock]
+ where
+   do_read call = do r <- throwErrnoIfMinus1RetryOnBlock loc call (return (-1))
+                     case r of
+                       (-1) -> return 0
+                       0    -> return (-1)
+                       n    -> return (fromIntegral n)
+   unsafe_read  = do_read (c_read (fdFD fd) (buf `plusPtr` off) len)
+   safe_read    = do_read (c_safe_read (fdFD fd) (buf `plusPtr` off) len)
+
+writeRawBufferPtr :: String -> FD -> Ptr Word8 -> Int -> CSize -> IO CInt
+writeRawBufferPtr loc !fd buf off len
+  | isNonBlocking fd = unsafe_write -- unsafe is ok, it can't block
+  | otherwise   = do r <- unsafe_fdReady (fdFD fd) 1 0 0
+                     if r /= 0 
+                        then write
+                        else do threadWaitWrite (fromIntegral (fdFD fd)); write
+  where
+    do_write call = fromIntegral `fmap`
+                      throwErrnoIfMinus1RetryMayBlock loc call
+                        (threadWaitWrite (fromIntegral (fdFD fd)))
+    write         = if threaded then safe_write else unsafe_write
+    unsafe_write  = do_write (c_write (fdFD fd) (buf `plusPtr` off) len)
+    safe_write    = do_write (c_safe_write (fdFD fd) (buf `plusPtr` off) len)
+
+writeRawBufferPtrNoBlock :: String -> FD -> Ptr Word8 -> Int -> CSize -> IO CInt
+writeRawBufferPtrNoBlock loc !fd buf off len
+  | isNonBlocking fd = unsafe_write -- unsafe is ok, it can't block
+  | otherwise   = do r <- unsafe_fdReady (fdFD fd) 1 0 0
+                     if r /= 0 then write
+                               else return 0
+  where
+    do_write call = do r <- throwErrnoIfMinus1RetryOnBlock loc call (return (-1))
+                       case r of
+                         (-1) -> return 0
+                         n    -> return (fromIntegral n)
+    write         = if threaded then safe_write else unsafe_write
+    unsafe_write  = do_write (c_write (fdFD fd) (buf `plusPtr` off) len)
+    safe_write    = do_write (c_safe_write (fdFD fd) (buf `plusPtr` off) len)
+
+isNonBlocking :: FD -> Bool
+isNonBlocking fd = fdIsNonBlocking fd /= 0
+
+foreign import ccall unsafe "fdReady"
+  unsafe_fdReady :: CInt -> CInt -> CInt -> CInt -> IO CInt
+
+#else /* mingw32_HOST_OS.... */
+
+readRawBufferPtr :: String -> FD -> Ptr Word8 -> Int -> CSize -> IO CInt
+readRawBufferPtr loc !fd buf off len
+  | threaded  = blockingReadRawBufferPtr loc fd buf off len
+  | otherwise = asyncReadRawBufferPtr    loc fd buf off len
+
+writeRawBufferPtr :: String -> FD -> Ptr Word8 -> Int -> CSize -> IO CInt
+writeRawBufferPtr loc !fd buf off len
+  | threaded  = blockingWriteRawBufferPtr loc fd buf off len
+  | otherwise = asyncWriteRawBufferPtr    loc fd buf off len
+
+readRawBufferPtrNoBlock :: String -> FD -> Ptr Word8 -> Int -> CSize -> IO CInt
+readRawBufferPtrNoBlock = readRawBufferPtr
+
+writeRawBufferPtrNoBlock :: String -> FD -> Ptr Word8 -> Int -> CSize -> IO CInt
+writeRawBufferPtrNoBlock = writeRawBufferPtr
+
+-- Async versions of the read/write primitives, for the non-threaded RTS
+
+asyncReadRawBufferPtr :: String -> FD -> Ptr Word8 -> Int -> CSize -> IO CInt
+asyncReadRawBufferPtr loc !fd buf off len = do
+    (l, rc) <- asyncRead (fromIntegral (fdFD fd)) (fdIsSocket_ fd) 
+                        (fromIntegral len) (buf `plusPtr` off)
+    if l == (-1)
+      then 
+        ioError (errnoToIOError loc (Errno (fromIntegral rc)) Nothing Nothing)
+      else return (fromIntegral l)
+
+asyncWriteRawBufferPtr :: String -> FD -> Ptr Word8 -> Int -> CSize -> IO CInt
+asyncWriteRawBufferPtr loc !fd buf off len = do
+    (l, rc) <- asyncWrite (fromIntegral (fdFD fd)) (fdIsSocket_ fd)
+                  (fromIntegral len) (buf `plusPtr` off)
+    if l == (-1)
+      then 
+        ioError (errnoToIOError loc (Errno (fromIntegral rc)) Nothing Nothing)
+      else return (fromIntegral l)
+
+-- Blocking versions of the read/write primitives, for the threaded RTS
+
+blockingReadRawBufferPtr :: String -> FD -> Ptr Word8 -> Int -> CSize -> IO CInt
+blockingReadRawBufferPtr loc fd buf off len
+  = fmap fromIntegral $ throwErrnoIfMinus1Retry loc $
+        if fdIsSocket fd
+           then c_safe_recv (fdFD fd) (buf `plusPtr` off) len 0
+           else c_safe_read (fdFD fd) (buf `plusPtr` off) len
+
+blockingWriteRawBufferPtr :: String -> FD -> Ptr Word8-> Int -> CSize -> IO CInt
+blockingWriteRawBufferPtr loc fd buf off len 
+  = fmap fromIntegral $ throwErrnoIfMinus1Retry loc $
+        if fdIsSocket fd
+           then c_safe_send  (fdFD fd) (buf `plusPtr` off) len 0
+           else do
+             r <- c_safe_write (fdFD fd) (buf `plusPtr` off) len
+             when (r == -1) c_maperrno
+             return r
+      -- we don't trust write() to give us the correct errno, and
+      -- instead do the errno conversion from GetLastError()
+      -- ourselves.  The main reason is that we treat ERROR_NO_DATA
+      -- (pipe is closing) as EPIPE, whereas write() returns EINVAL
+      -- for this case.  We need to detect EPIPE correctly, because it
+      -- shouldn't be reported as an error when it happens on stdout.
+
+-- NOTE: "safe" versions of the read/write calls for use by the threaded RTS.
+-- These calls may block, but that's ok.
+
+foreign import WINDOWS_CCONV safe "recv"
+   c_safe_recv :: CInt -> Ptr Word8 -> CSize -> CInt{-flags-} -> IO CSsize
+
+foreign import WINDOWS_CCONV safe "send"
+   c_safe_send :: CInt -> Ptr Word8 -> CSize -> CInt{-flags-} -> IO CSsize
+
+#endif
+
+foreign import ccall "rtsSupportsBoundThreads" threaded :: Bool
+
+-- -----------------------------------------------------------------------------
+-- utils
+
+#ifndef mingw32_HOST_OS
+throwErrnoIfMinus1RetryOnBlock  :: String -> IO CSsize -> IO CSsize -> IO CSsize
+throwErrnoIfMinus1RetryOnBlock loc f on_block  = 
+  do
+    res <- f
+    if (res :: CSsize) == -1
+      then do
+        err <- getErrno
+        if err == eINTR
+          then throwErrnoIfMinus1RetryOnBlock loc f on_block
+          else if err == eWOULDBLOCK || err == eAGAIN
+                 then do on_block
+                 else throwErrno loc
+      else return res
+#endif
+
+-- -----------------------------------------------------------------------------
+-- Locking/unlocking
+
+foreign import ccall unsafe "lockFile"
+  lockFile :: CInt -> Word64 -> Word64 -> CInt -> IO CInt
+
+foreign import ccall unsafe "unlockFile"
+  unlockFile :: CInt -> IO CInt
+
+#ifdef mingw32_HOST_OS
+foreign import ccall unsafe "get_unique_file_info"
+  c_getUniqueFileInfo :: CInt -> Ptr Word64 -> Ptr Word64 -> IO ()
+#endif
diff --git a/libraries/base/GHC/IO/Handle.hs b/libraries/base/GHC/IO/Handle.hs
new file mode 100644
index 000000000000..62196700283d
--- /dev/null
+++ b/libraries/base/GHC/IO/Handle.hs
@@ -0,0 +1,744 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE CPP
+           , NoImplicitPrelude
+           , RecordWildCards
+           , NondecreasingIndentation
+  #-}
+{-# OPTIONS_GHC -fno-warn-unused-matches #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.IO.Handle
+-- Copyright   :  (c) The University of Glasgow, 1994-2009
+-- License     :  see libraries/base/LICENSE
+-- 
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  provisional
+-- Portability :  non-portable
+--
+-- External API for GHC's Handle implementation
+--
+-----------------------------------------------------------------------------
+
+module GHC.IO.Handle (
+   Handle,
+   BufferMode(..),
+ 
+   mkFileHandle, mkDuplexHandle,
+ 
+   hFileSize, hSetFileSize, hIsEOF, hLookAhead,
+   hSetBuffering, hSetBinaryMode, hSetEncoding, hGetEncoding,
+   hFlush, hFlushAll, hDuplicate, hDuplicateTo,
+ 
+   hClose, hClose_help,
+ 
+   HandlePosition, HandlePosn(..), hGetPosn, hSetPosn,
+   SeekMode(..), hSeek, hTell,
+ 
+   hIsOpen, hIsClosed, hIsReadable, hIsWritable, hGetBuffering, hIsSeekable,
+   hSetEcho, hGetEcho, hIsTerminalDevice,
+ 
+   hSetNewlineMode, Newline(..), NewlineMode(..), nativeNewline,
+   noNewlineTranslation, universalNewlineMode, nativeNewlineMode,
+
+   hShow,
+
+   hWaitForInput, hGetChar, hGetLine, hGetContents, hPutChar, hPutStr,
+
+   hGetBuf, hGetBufNonBlocking, hPutBuf, hPutBufNonBlocking
+ ) where
+
+import GHC.IO
+import GHC.IO.Exception
+import GHC.IO.Encoding
+import GHC.IO.Buffer
+import GHC.IO.BufferedIO ( BufferedIO )
+import GHC.IO.Device as IODevice
+import GHC.IO.Handle.Types
+import GHC.IO.Handle.Internals
+import GHC.IO.Handle.Text
+import qualified GHC.IO.BufferedIO as Buffered
+
+import GHC.Base
+import GHC.Exception
+import GHC.MVar
+import GHC.IORef
+import GHC.Show
+import GHC.Num
+import GHC.Real
+import Data.Maybe
+import Data.Typeable
+import Control.Monad
+
+-- ---------------------------------------------------------------------------
+-- Closing a handle
+
+-- | Computation 'hClose' @hdl@ makes handle @hdl@ closed.  Before the
+-- computation finishes, if @hdl@ is writable its buffer is flushed as
+-- for 'hFlush'.
+-- Performing 'hClose' on a handle that has already been closed has no effect; 
+-- doing so is not an error.  All other operations on a closed handle will fail.
+-- If 'hClose' fails for any reason, any further operations (apart from
+-- 'hClose') on the handle will still fail as if @hdl@ had been successfully
+-- closed.
+
+hClose :: Handle -> IO ()
+hClose h@(FileHandle _ m)     = do 
+  mb_exc <- hClose' h m
+  hClose_maybethrow mb_exc h
+hClose h@(DuplexHandle _ r w) = do
+  excs <- mapM (hClose' h) [r,w]
+  hClose_maybethrow (listToMaybe (catMaybes excs)) h
+
+hClose_maybethrow :: Maybe SomeException -> Handle -> IO ()
+hClose_maybethrow Nothing  h = return ()
+hClose_maybethrow (Just e) h = hClose_rethrow e h
+
+hClose_rethrow :: SomeException -> Handle -> IO ()
+hClose_rethrow e h = 
+  case fromException e of
+    Just ioe -> ioError (augmentIOError ioe "hClose" h)
+    Nothing  -> throwIO e
+
+hClose' :: Handle -> MVar Handle__ -> IO (Maybe SomeException)
+hClose' h m = withHandle' "hClose" h m $ hClose_help
+
+-----------------------------------------------------------------------------
+-- Detecting and changing the size of a file
+
+-- | For a handle @hdl@ which attached to a physical file,
+-- 'hFileSize' @hdl@ returns the size of that file in 8-bit bytes.
+
+hFileSize :: Handle -> IO Integer
+hFileSize handle =
+    withHandle_ "hFileSize" handle $ \ handle_@Handle__{haDevice=dev} -> do
+    case haType handle_ of 
+      ClosedHandle              -> ioe_closedHandle
+      SemiClosedHandle          -> ioe_closedHandle
+      _ -> do flushWriteBuffer handle_
+              r <- IODevice.getSize dev
+              if r /= -1
+                 then return r
+                 else ioException (IOError Nothing InappropriateType "hFileSize"
+                                   "not a regular file" Nothing Nothing)
+
+
+-- | 'hSetFileSize' @hdl@ @size@ truncates the physical file with handle @hdl@ to @size@ bytes.
+
+hSetFileSize :: Handle -> Integer -> IO ()
+hSetFileSize handle size =
+    withHandle_ "hSetFileSize" handle $ \ handle_@Handle__{haDevice=dev} -> do
+    case haType handle_ of 
+      ClosedHandle              -> ioe_closedHandle
+      SemiClosedHandle          -> ioe_closedHandle
+      _ -> do flushWriteBuffer handle_
+              IODevice.setSize dev size
+              return ()
+
+-- ---------------------------------------------------------------------------
+-- Detecting the End of Input
+
+-- | For a readable handle @hdl@, 'hIsEOF' @hdl@ returns
+-- 'True' if no further input can be taken from @hdl@ or for a
+-- physical file, if the current I\/O position is equal to the length of
+-- the file.  Otherwise, it returns 'False'.
+--
+-- NOTE: 'hIsEOF' may block, because it has to attempt to read from
+-- the stream to determine whether there is any more data to be read.
+
+hIsEOF :: Handle -> IO Bool
+hIsEOF handle = wantReadableHandle_ "hIsEOF" handle $ \Handle__{..} -> do
+
+  cbuf <- readIORef haCharBuffer
+  if not (isEmptyBuffer cbuf) then return False else do
+
+  bbuf <- readIORef haByteBuffer
+  if not (isEmptyBuffer bbuf) then return False else do
+
+  -- NB. do no decoding, just fill the byte buffer; see #3808
+  (r,bbuf') <- Buffered.fillReadBuffer haDevice bbuf
+  if r == 0
+     then return True
+     else do writeIORef haByteBuffer bbuf'
+             return False
+
+-- ---------------------------------------------------------------------------
+-- Looking ahead
+
+-- | Computation 'hLookAhead' returns the next character from the handle
+-- without removing it from the input buffer, blocking until a character
+-- is available.
+--
+-- This operation may fail with:
+--
+--  * 'isEOFError' if the end of file has been reached.
+
+hLookAhead :: Handle -> IO Char
+hLookAhead handle =
+  wantReadableHandle_ "hLookAhead"  handle hLookAhead_
+
+-- ---------------------------------------------------------------------------
+-- Buffering Operations
+
+-- Three kinds of buffering are supported: line-buffering,
+-- block-buffering or no-buffering.  See GHC.IO.Handle for definition and
+-- further explanation of what the type represent.
+
+-- | Computation 'hSetBuffering' @hdl mode@ sets the mode of buffering for
+-- handle @hdl@ on subsequent reads and writes.
+--
+-- If the buffer mode is changed from 'BlockBuffering' or
+-- 'LineBuffering' to 'NoBuffering', then
+--
+--  * if @hdl@ is writable, the buffer is flushed as for 'hFlush';
+--
+--  * if @hdl@ is not writable, the contents of the buffer is discarded.
+--
+-- This operation may fail with:
+--
+--  * 'isPermissionError' if the handle has already been used for reading
+--    or writing and the implementation does not allow the buffering mode
+--    to be changed.
+
+hSetBuffering :: Handle -> BufferMode -> IO ()
+hSetBuffering handle mode =
+  withAllHandles__ "hSetBuffering" handle $ \ handle_@Handle__{..} -> do
+  case haType of
+    ClosedHandle -> ioe_closedHandle
+    _ -> do
+         if mode == haBufferMode then return handle_ else do
+
+         -- See [note Buffer Sizing] in GHC.IO.Handle.Types
+
+          -- check for errors:
+          case mode of
+              BlockBuffering (Just n) | n <= 0    -> ioe_bufsiz n
+              _ -> return ()
+
+          -- for input terminals we need to put the terminal into
+          -- cooked or raw mode depending on the type of buffering.
+          is_tty <- IODevice.isTerminal haDevice
+          when (is_tty && isReadableHandleType haType) $
+                case mode of
+#ifndef mingw32_HOST_OS
+        -- 'raw' mode under win32 is a bit too specialised (and troublesome
+        -- for most common uses), so simply disable its use here.
+                  NoBuffering -> IODevice.setRaw haDevice True
+#else
+                  NoBuffering -> return ()
+#endif
+                  _           -> IODevice.setRaw haDevice False
+
+          -- throw away spare buffers, they might be the wrong size
+          writeIORef haBuffers BufferListNil
+
+          return Handle__{ haBufferMode = mode,.. }
+
+-- -----------------------------------------------------------------------------
+-- hSetEncoding
+
+-- | The action 'hSetEncoding' @hdl@ @encoding@ changes the text encoding
+-- for the handle @hdl@ to @encoding@.  The default encoding when a 'Handle' is
+-- created is 'localeEncoding', namely the default encoding for the current
+-- locale.
+--
+-- To create a 'Handle' with no encoding at all, use 'openBinaryFile'.  To
+-- stop further encoding or decoding on an existing 'Handle', use
+-- 'hSetBinaryMode'.
+--
+-- 'hSetEncoding' may need to flush buffered data in order to change
+-- the encoding.
+--
+hSetEncoding :: Handle -> TextEncoding -> IO ()
+hSetEncoding hdl encoding = do
+  withAllHandles__ "hSetEncoding" hdl $ \h_@Handle__{..} -> do
+    flushCharBuffer h_
+    closeTextCodecs h_
+    openTextEncoding (Just encoding) haType $ \ mb_encoder mb_decoder -> do
+    bbuf <- readIORef haByteBuffer
+    ref <- newIORef (error "last_decode")
+    return (Handle__{ haLastDecode = ref, 
+                      haDecoder = mb_decoder, 
+                      haEncoder = mb_encoder,
+                      haCodec   = Just encoding, .. })
+
+-- | Return the current 'TextEncoding' for the specified 'Handle', or
+-- 'Nothing' if the 'Handle' is in binary mode.
+--
+-- Note that the 'TextEncoding' remembers nothing about the state of
+-- the encoder/decoder in use on this 'Handle'.  For example, if the
+-- encoding in use is UTF-16, then using 'hGetEncoding' and
+-- 'hSetEncoding' to save and restore the encoding may result in an
+-- extra byte-order-mark being written to the file.
+--
+hGetEncoding :: Handle -> IO (Maybe TextEncoding)
+hGetEncoding hdl =
+  withHandle_ "hGetEncoding" hdl $ \h_@Handle__{..} -> return haCodec
+
+-- -----------------------------------------------------------------------------
+-- hFlush
+
+-- | The action 'hFlush' @hdl@ causes any items buffered for output
+-- in handle @hdl@ to be sent immediately to the operating system.
+--
+-- This operation may fail with:
+--
+--  * 'isFullError' if the device is full;
+--
+--  * 'isPermissionError' if a system resource limit would be exceeded.
+--    It is unspecified whether the characters in the buffer are discarded
+--    or retained under these circumstances.
+
+hFlush :: Handle -> IO () 
+hFlush handle = wantWritableHandle "hFlush" handle flushWriteBuffer
+
+-- | The action 'hFlushAll' @hdl@ flushes all buffered data in @hdl@,
+-- including any buffered read data.  Buffered read data is flushed
+-- by seeking the file position back to the point before the bufferred
+-- data was read, and hence only works if @hdl@ is seekable (see
+-- 'hIsSeekable').
+--
+-- This operation may fail with:
+--
+--  * 'isFullError' if the device is full;
+--
+--  * 'isPermissionError' if a system resource limit would be exceeded.
+--    It is unspecified whether the characters in the buffer are discarded
+--    or retained under these circumstances;
+--
+--  * 'isIllegalOperation' if @hdl@ has buffered read data, and is not
+--    seekable.
+
+hFlushAll :: Handle -> IO () 
+hFlushAll handle = withHandle_ "hFlushAll" handle flushBuffer
+
+-- -----------------------------------------------------------------------------
+-- Repositioning Handles
+
+data HandlePosn = HandlePosn Handle HandlePosition
+
+instance Eq HandlePosn where
+    (HandlePosn h1 p1) == (HandlePosn h2 p2) = p1==p2 && h1==h2
+
+instance Show HandlePosn where
+   showsPrec p (HandlePosn h pos) = 
+        showsPrec p h . showString " at position " . shows pos
+
+  -- HandlePosition is the Haskell equivalent of POSIX' off_t.
+  -- We represent it as an Integer on the Haskell side, but
+  -- cheat slightly in that hGetPosn calls upon a C helper
+  -- that reports the position back via (merely) an Int.
+type HandlePosition = Integer
+
+-- | Computation 'hGetPosn' @hdl@ returns the current I\/O position of
+-- @hdl@ as a value of the abstract type 'HandlePosn'.
+
+hGetPosn :: Handle -> IO HandlePosn
+hGetPosn handle = do
+    posn <- hTell handle
+    return (HandlePosn handle posn)
+
+-- | If a call to 'hGetPosn' @hdl@ returns a position @p@,
+-- then computation 'hSetPosn' @p@ sets the position of @hdl@
+-- to the position it held at the time of the call to 'hGetPosn'.
+--
+-- This operation may fail with:
+--
+--  * 'isPermissionError' if a system resource limit would be exceeded.
+
+hSetPosn :: HandlePosn -> IO () 
+hSetPosn (HandlePosn h i) = hSeek h AbsoluteSeek i
+
+-- ---------------------------------------------------------------------------
+-- hSeek
+
+{- Note: 
+ - when seeking using `SeekFromEnd', positive offsets (>=0) means
+   seeking at or past EOF.
+
+ - we possibly deviate from the report on the issue of seeking within
+   the buffer and whether to flush it or not.  The report isn't exactly
+   clear here.
+-}
+
+-- | Computation 'hSeek' @hdl mode i@ sets the position of handle
+-- @hdl@ depending on @mode@.
+-- The offset @i@ is given in terms of 8-bit bytes.
+--
+-- If @hdl@ is block- or line-buffered, then seeking to a position which is not
+-- in the current buffer will first cause any items in the output buffer to be
+-- written to the device, and then cause the input buffer to be discarded.
+-- Some handles may not be seekable (see 'hIsSeekable'), or only support a
+-- subset of the possible positioning operations (for instance, it may only
+-- be possible to seek to the end of a tape, or to a positive offset from
+-- the beginning or current position).
+-- It is not possible to set a negative I\/O position, or for
+-- a physical file, an I\/O position beyond the current end-of-file.
+--
+-- This operation may fail with:
+--
+--  * 'isIllegalOperationError' if the Handle is not seekable, or does
+--     not support the requested seek mode.
+--
+--  * 'isPermissionError' if a system resource limit would be exceeded.
+
+hSeek :: Handle -> SeekMode -> Integer -> IO () 
+hSeek handle mode offset =
+    wantSeekableHandle "hSeek" handle $ \ handle_@Handle__{..} -> do
+    debugIO ("hSeek " ++ show (mode,offset))
+    buf <- readIORef haCharBuffer
+
+    if isWriteBuffer buf
+        then do flushWriteBuffer handle_
+                IODevice.seek haDevice mode offset
+        else do
+
+    let r = bufL buf; w = bufR buf
+    if mode == RelativeSeek && isNothing haDecoder && 
+       offset >= 0 && offset < fromIntegral (w - r)
+        then writeIORef haCharBuffer buf{ bufL = r + fromIntegral offset }
+        else do 
+
+    flushCharReadBuffer handle_
+    flushByteReadBuffer handle_
+    IODevice.seek haDevice mode offset
+
+
+-- | Computation 'hTell' @hdl@ returns the current position of the
+-- handle @hdl@, as the number of bytes from the beginning of
+-- the file.  The value returned may be subsequently passed to
+-- 'hSeek' to reposition the handle to the current position.
+-- 
+-- This operation may fail with:
+--
+--  * 'isIllegalOperationError' if the Handle is not seekable.
+--
+hTell :: Handle -> IO Integer
+hTell handle = 
+    wantSeekableHandle "hGetPosn" handle $ \ handle_@Handle__{..} -> do
+
+      posn <- IODevice.tell haDevice
+
+      -- we can't tell the real byte offset if there are buffered
+      -- Chars, so must flush first:
+      flushCharBuffer handle_
+
+      bbuf <- readIORef haByteBuffer
+
+      let real_posn
+           | isWriteBuffer bbuf = posn + fromIntegral (bufferElems bbuf)
+           | otherwise          = posn - fromIntegral (bufferElems bbuf)
+
+      cbuf <- readIORef haCharBuffer
+      debugIO ("\nhGetPosn: (posn, real_posn) = " ++ show (posn, real_posn))
+      debugIO ("   cbuf: " ++ summaryBuffer cbuf ++
+            "   bbuf: " ++ summaryBuffer bbuf)
+
+      return real_posn
+
+-- -----------------------------------------------------------------------------
+-- Handle Properties
+
+-- A number of operations return information about the properties of a
+-- handle.  Each of these operations returns `True' if the handle has
+-- the specified property, and `False' otherwise.
+
+hIsOpen :: Handle -> IO Bool
+hIsOpen handle =
+    withHandle_ "hIsOpen" handle $ \ handle_ -> do
+    case haType handle_ of 
+      ClosedHandle         -> return False
+      SemiClosedHandle     -> return False
+      _                    -> return True
+
+hIsClosed :: Handle -> IO Bool
+hIsClosed handle =
+    withHandle_ "hIsClosed" handle $ \ handle_ -> do
+    case haType handle_ of 
+      ClosedHandle         -> return True
+      _                    -> return False
+
+{- not defined, nor exported, but mentioned
+   here for documentation purposes:
+
+    hSemiClosed :: Handle -> IO Bool
+    hSemiClosed h = do
+       ho <- hIsOpen h
+       hc <- hIsClosed h
+       return (not (ho || hc))
+-}
+
+hIsReadable :: Handle -> IO Bool
+hIsReadable (DuplexHandle _ _ _) = return True
+hIsReadable handle =
+    withHandle_ "hIsReadable" handle $ \ handle_ -> do
+    case haType handle_ of 
+      ClosedHandle         -> ioe_closedHandle
+      SemiClosedHandle     -> ioe_closedHandle
+      htype                -> return (isReadableHandleType htype)
+
+hIsWritable :: Handle -> IO Bool
+hIsWritable (DuplexHandle _ _ _) = return True
+hIsWritable handle =
+    withHandle_ "hIsWritable" handle $ \ handle_ -> do
+    case haType handle_ of 
+      ClosedHandle         -> ioe_closedHandle
+      SemiClosedHandle     -> ioe_closedHandle
+      htype                -> return (isWritableHandleType htype)
+
+-- | Computation 'hGetBuffering' @hdl@ returns the current buffering mode
+-- for @hdl@.
+
+hGetBuffering :: Handle -> IO BufferMode
+hGetBuffering handle = 
+    withHandle_ "hGetBuffering" handle $ \ handle_ -> do
+    case haType handle_ of 
+      ClosedHandle         -> ioe_closedHandle
+      _ -> 
+           -- We're being non-standard here, and allow the buffering
+           -- of a semi-closed handle to be queried.   -- sof 6/98
+          return (haBufferMode handle_)  -- could be stricter..
+
+hIsSeekable :: Handle -> IO Bool
+hIsSeekable handle =
+    withHandle_ "hIsSeekable" handle $ \ handle_@Handle__{..} -> do
+    case haType of 
+      ClosedHandle         -> ioe_closedHandle
+      SemiClosedHandle     -> ioe_closedHandle
+      AppendHandle         -> return False
+      _                    -> IODevice.isSeekable haDevice
+
+-- -----------------------------------------------------------------------------
+-- Changing echo status (Non-standard GHC extensions)
+
+-- | Set the echoing status of a handle connected to a terminal.
+
+hSetEcho :: Handle -> Bool -> IO ()
+hSetEcho handle on = do
+    isT   <- hIsTerminalDevice handle
+    if not isT
+     then return ()
+     else
+      withHandle_ "hSetEcho" handle $ \ Handle__{..} -> do
+      case haType of 
+         ClosedHandle -> ioe_closedHandle
+         _            -> IODevice.setEcho haDevice on
+
+-- | Get the echoing status of a handle connected to a terminal.
+
+hGetEcho :: Handle -> IO Bool
+hGetEcho handle = do
+    isT   <- hIsTerminalDevice handle
+    if not isT
+     then return False
+     else
+       withHandle_ "hGetEcho" handle $ \ Handle__{..} -> do
+       case haType of 
+         ClosedHandle -> ioe_closedHandle
+         _            -> IODevice.getEcho haDevice
+
+-- | Is the handle connected to a terminal?
+
+hIsTerminalDevice :: Handle -> IO Bool
+hIsTerminalDevice handle = do
+    withHandle_ "hIsTerminalDevice" handle $ \ Handle__{..} -> do
+     case haType of 
+       ClosedHandle -> ioe_closedHandle
+       _            -> IODevice.isTerminal haDevice
+
+-- -----------------------------------------------------------------------------
+-- hSetBinaryMode
+
+-- | Select binary mode ('True') or text mode ('False') on a open handle.
+-- (See also 'openBinaryFile'.)
+--
+-- This has the same effect as calling 'hSetEncoding' with 'char8', together
+-- with 'hSetNewlineMode' with 'noNewlineTranslation'.
+--
+hSetBinaryMode :: Handle -> Bool -> IO ()
+hSetBinaryMode handle bin =
+  withAllHandles__ "hSetBinaryMode" handle $ \ h_@Handle__{..} ->
+    do 
+         flushCharBuffer h_
+         closeTextCodecs h_
+
+         mb_te <- if bin then return Nothing
+                         else fmap Just getLocaleEncoding
+
+         openTextEncoding mb_te haType $ \ mb_encoder mb_decoder -> do
+
+         -- should match the default newline mode, whatever that is
+         let nl    | bin       = noNewlineTranslation
+                   | otherwise = nativeNewlineMode
+
+         bbuf <- readIORef haByteBuffer
+         ref <- newIORef (error "codec_state", bbuf)
+
+         return Handle__{ haLastDecode = ref,
+                          haEncoder  = mb_encoder, 
+                          haDecoder  = mb_decoder,
+                          haCodec    = mb_te,
+                          haInputNL  = inputNL nl,
+                          haOutputNL = outputNL nl, .. }
+  
+-- -----------------------------------------------------------------------------
+-- hSetNewlineMode
+
+-- | Set the 'NewlineMode' on the specified 'Handle'.  All buffered
+-- data is flushed first.
+hSetNewlineMode :: Handle -> NewlineMode -> IO ()
+hSetNewlineMode handle NewlineMode{ inputNL=i, outputNL=o } =
+  withAllHandles__ "hSetNewlineMode" handle $ \h_@Handle__{..} ->
+    do
+         flushBuffer h_
+         return h_{ haInputNL=i, haOutputNL=o }
+
+-- -----------------------------------------------------------------------------
+-- Duplicating a Handle
+
+-- | Returns a duplicate of the original handle, with its own buffer.
+-- The two Handles will share a file pointer, however.  The original
+-- handle's buffer is flushed, including discarding any input data,
+-- before the handle is duplicated.
+
+hDuplicate :: Handle -> IO Handle
+hDuplicate h@(FileHandle path m) = do
+  withHandle_' "hDuplicate" h m $ \h_ ->
+      dupHandle path h Nothing h_ (Just handleFinalizer)
+hDuplicate h@(DuplexHandle path r w) = do
+  write_side@(FileHandle _ write_m) <- 
+     withHandle_' "hDuplicate" h w $ \h_ ->
+        dupHandle path h Nothing h_ (Just handleFinalizer)
+  read_side@(FileHandle _ read_m) <- 
+    withHandle_' "hDuplicate" h r $ \h_ ->
+        dupHandle path h (Just write_m) h_  Nothing
+  return (DuplexHandle path read_m write_m)
+
+dupHandle :: FilePath
+          -> Handle
+          -> Maybe (MVar Handle__)
+          -> Handle__
+          -> Maybe HandleFinalizer
+          -> IO Handle
+dupHandle filepath h other_side h_@Handle__{..} mb_finalizer = do
+  -- flush the buffer first, so we don't have to copy its contents
+  flushBuffer h_
+  case other_side of
+    Nothing -> do
+       new_dev <- IODevice.dup haDevice
+       dupHandle_ new_dev filepath other_side h_ mb_finalizer
+    Just r  -> 
+       withHandle_' "dupHandle" h r $ \Handle__{haDevice=dev} -> do
+         dupHandle_ dev filepath other_side h_ mb_finalizer
+
+dupHandle_ :: (IODevice dev, BufferedIO dev, Typeable dev) => dev
+           -> FilePath
+           -> Maybe (MVar Handle__)
+           -> Handle__
+           -> Maybe HandleFinalizer
+           -> IO Handle
+dupHandle_ new_dev filepath other_side h_@Handle__{..} mb_finalizer = do
+   -- XXX wrong!
+  mb_codec <- if isJust haEncoder then fmap Just getLocaleEncoding else return Nothing
+  mkHandle new_dev filepath haType True{-buffered-} mb_codec
+      NewlineMode { inputNL = haInputNL, outputNL = haOutputNL }
+      mb_finalizer other_side
+
+-- -----------------------------------------------------------------------------
+-- Replacing a Handle
+
+{- |
+Makes the second handle a duplicate of the first handle.  The second 
+handle will be closed first, if it is not already.
+
+This can be used to retarget the standard Handles, for example:
+
+> do h <- openFile "mystdout" WriteMode
+>    hDuplicateTo h stdout
+-}
+
+hDuplicateTo :: Handle -> Handle -> IO ()
+hDuplicateTo h1@(FileHandle path m1) h2@(FileHandle _ m2)  = do
+ withHandle__' "hDuplicateTo" h2 m2 $ \h2_ -> do
+   _ <- hClose_help h2_
+   withHandle_' "hDuplicateTo" h1 m1 $ \h1_ -> do
+     dupHandleTo path h1 Nothing h2_ h1_ (Just handleFinalizer)
+hDuplicateTo h1@(DuplexHandle path r1 w1) h2@(DuplexHandle _ r2 w2)  = do
+ withHandle__' "hDuplicateTo" h2 w2  $ \w2_ -> do
+   _ <- hClose_help w2_
+   withHandle_' "hDuplicateTo" h1 w1 $ \w1_ -> do
+     dupHandleTo path h1 Nothing w2_ w1_ (Just handleFinalizer)
+ withHandle__' "hDuplicateTo" h2 r2  $ \r2_ -> do
+   _ <- hClose_help r2_
+   withHandle_' "hDuplicateTo" h1 r1 $ \r1_ -> do
+     dupHandleTo path h1 (Just w1) r2_ r1_ Nothing
+hDuplicateTo h1 _ = 
+  ioe_dupHandlesNotCompatible h1
+
+
+ioe_dupHandlesNotCompatible :: Handle -> IO a
+ioe_dupHandlesNotCompatible h =
+   ioException (IOError (Just h) IllegalOperation "hDuplicateTo" 
+                "handles are incompatible" Nothing Nothing)
+
+dupHandleTo :: FilePath 
+            -> Handle
+            -> Maybe (MVar Handle__)
+            -> Handle__
+            -> Handle__
+            -> Maybe HandleFinalizer
+            -> IO Handle__
+dupHandleTo filepath h other_side 
+            hto_@Handle__{haDevice=devTo,..}
+            h_@Handle__{haDevice=dev} mb_finalizer = do
+  flushBuffer h_
+  case cast devTo of
+    Nothing   -> ioe_dupHandlesNotCompatible h
+    Just dev' -> do 
+      _ <- IODevice.dup2 dev dev'
+      FileHandle _ m <- dupHandle_ dev' filepath other_side h_ mb_finalizer
+      takeMVar m
+
+-- ---------------------------------------------------------------------------
+-- showing Handles.
+--
+-- | 'hShow' is in the 'IO' monad, and gives more comprehensive output
+-- than the (pure) instance of 'Show' for 'Handle'.
+
+hShow :: Handle -> IO String
+hShow h@(FileHandle path _) = showHandle' path False h
+hShow h@(DuplexHandle path _ _) = showHandle' path True h
+
+showHandle' :: String -> Bool -> Handle -> IO String
+showHandle' filepath is_duplex h = 
+  withHandle_ "showHandle" h $ \hdl_ ->
+    let
+     showType | is_duplex = showString "duplex (read-write)"
+              | otherwise = shows (haType hdl_)
+    in
+    return 
+      (( showChar '{' . 
+        showHdl (haType hdl_) 
+            (showString "loc=" . showString filepath . showChar ',' .
+             showString "type=" . showType . showChar ',' .
+             showString "buffering=" . showBufMode (unsafePerformIO (readIORef (haCharBuffer hdl_))) (haBufferMode hdl_) . showString "}" )
+      ) "")
+   where
+
+    showHdl :: HandleType -> ShowS -> ShowS
+    showHdl ht cont = 
+       case ht of
+        ClosedHandle  -> shows ht . showString "}"
+        _ -> cont
+
+    showBufMode :: Buffer e -> BufferMode -> ShowS
+    showBufMode buf bmo =
+      case bmo of
+        NoBuffering   -> showString "none"
+        LineBuffering -> showString "line"
+        BlockBuffering (Just n) -> showString "block " . showParen True (shows n)
+        BlockBuffering Nothing  -> showString "block " . showParen True (shows def)
+      where
+       def :: Int 
+       def = bufSize buf
+
diff --git a/libraries/base/GHC/IO/Handle.hs-boot b/libraries/base/GHC/IO/Handle.hs-boot
new file mode 100644
index 000000000000..02cd1bf610ec
--- /dev/null
+++ b/libraries/base/GHC/IO/Handle.hs-boot
@@ -0,0 +1,10 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+
+module GHC.IO.Handle where
+
+import GHC.IO
+import GHC.IO.Handle.Types
+
+hFlush :: Handle -> IO ()
+
diff --git a/libraries/base/GHC/IO/Handle/FD.hs b/libraries/base/GHC/IO/Handle/FD.hs
new file mode 100644
index 000000000000..ac792de4fb9e
--- /dev/null
+++ b/libraries/base/GHC/IO/Handle/FD.hs
@@ -0,0 +1,291 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE CPP, NoImplicitPrelude #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.IO.Handle.FD
+-- Copyright   :  (c) The University of Glasgow, 1994-2008
+-- License     :  see libraries/base/LICENSE
+-- 
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  internal
+-- Portability :  non-portable
+--
+-- Handle operations implemented by file descriptors (FDs)
+--
+-----------------------------------------------------------------------------
+
+module GHC.IO.Handle.FD ( 
+  stdin, stdout, stderr,
+  openFile, openBinaryFile, openFileBlocking,
+  mkHandleFromFD, fdToHandle, fdToHandle',
+  isEOF
+ ) where
+
+import GHC.Base
+import GHC.Show
+import Data.Maybe
+import Foreign.C.Types
+import GHC.MVar
+import GHC.IO
+import GHC.IO.Encoding
+import GHC.IO.Device as IODevice
+import GHC.IO.Exception
+import GHC.IO.IOMode
+import GHC.IO.Handle
+import GHC.IO.Handle.Types
+import GHC.IO.Handle.Internals
+import qualified GHC.IO.FD as FD
+import qualified System.Posix.Internals as Posix
+
+-- ---------------------------------------------------------------------------
+-- Standard Handles
+
+-- Three handles are allocated during program initialisation.  The first
+-- two manage input or output from the Haskell program's standard input
+-- or output channel respectively.  The third manages output to the
+-- standard error channel. These handles are initially open.
+
+-- | A handle managing input from the Haskell program's standard input channel.
+stdin :: Handle
+{-# NOINLINE stdin #-}
+stdin = unsafePerformIO $ do
+   -- ToDo: acquire lock
+   setBinaryMode FD.stdin
+   enc <- getLocaleEncoding
+   mkHandle FD.stdin "<stdin>" ReadHandle True (Just enc)
+                nativeNewlineMode{-translate newlines-}
+                (Just stdHandleFinalizer) Nothing
+
+-- | A handle managing output to the Haskell program's standard output channel.
+stdout :: Handle
+{-# NOINLINE stdout #-}
+stdout = unsafePerformIO $ do
+   -- ToDo: acquire lock
+   setBinaryMode FD.stdout
+   enc <- getLocaleEncoding
+   mkHandle FD.stdout "<stdout>" WriteHandle True (Just enc)
+                nativeNewlineMode{-translate newlines-}
+                (Just stdHandleFinalizer) Nothing
+
+-- | A handle managing output to the Haskell program's standard error channel.
+stderr :: Handle
+{-# NOINLINE stderr #-}
+stderr = unsafePerformIO $ do
+    -- ToDo: acquire lock
+   setBinaryMode FD.stderr
+   enc <- getLocaleEncoding
+   mkHandle FD.stderr "<stderr>" WriteHandle False{-stderr is unbuffered-} 
+                (Just enc)
+                nativeNewlineMode{-translate newlines-}
+                (Just stdHandleFinalizer) Nothing
+
+stdHandleFinalizer :: FilePath -> MVar Handle__ -> IO ()
+stdHandleFinalizer fp m = do
+  h_ <- takeMVar m
+  flushWriteBuffer h_
+  case haType h_ of 
+      ClosedHandle -> return ()
+      _other       -> closeTextCodecs h_
+  putMVar m (ioe_finalizedHandle fp)
+
+-- We have to put the FDs into binary mode on Windows to avoid the newline
+-- translation that the CRT IO library does.
+setBinaryMode :: FD.FD -> IO ()
+#ifdef mingw32_HOST_OS
+setBinaryMode fd = do _ <- setmode (FD.fdFD fd) True
+                      return ()
+#else
+setBinaryMode _ = return ()
+#endif
+
+#ifdef mingw32_HOST_OS
+foreign import ccall unsafe "__hscore_setmode"
+  setmode :: CInt -> Bool -> IO CInt
+#endif
+
+-- ---------------------------------------------------------------------------
+-- isEOF
+
+-- | The computation 'isEOF' is identical to 'hIsEOF',
+-- except that it works only on 'stdin'.
+
+isEOF :: IO Bool
+isEOF = hIsEOF stdin
+
+-- ---------------------------------------------------------------------------
+-- Opening and Closing Files
+
+addFilePathToIOError :: String -> FilePath -> IOException -> IOException
+addFilePathToIOError fun fp ioe
+  = ioe{ ioe_location = fun, ioe_filename = Just fp }
+
+-- | Computation 'openFile' @file mode@ allocates and returns a new, open
+-- handle to manage the file @file@.  It manages input if @mode@
+-- is 'ReadMode', output if @mode@ is 'WriteMode' or 'AppendMode',
+-- and both input and output if mode is 'ReadWriteMode'.
+--
+-- If the file does not exist and it is opened for output, it should be
+-- created as a new file.  If @mode@ is 'WriteMode' and the file
+-- already exists, then it should be truncated to zero length.
+-- Some operating systems delete empty files, so there is no guarantee
+-- that the file will exist following an 'openFile' with @mode@
+-- 'WriteMode' unless it is subsequently written to successfully.
+-- The handle is positioned at the end of the file if @mode@ is
+-- 'AppendMode', and otherwise at the beginning (in which case its
+-- internal position is 0).
+-- The initial buffer mode is implementation-dependent.
+--
+-- This operation may fail with:
+--
+--  * 'isAlreadyInUseError' if the file is already open and cannot be reopened;
+--
+--  * 'isDoesNotExistError' if the file does not exist; or
+--
+--  * 'isPermissionError' if the user does not have permission to open the file.
+--
+-- Note: if you will be working with files containing binary data, you'll want to
+-- be using 'openBinaryFile'.
+openFile :: FilePath -> IOMode -> IO Handle
+openFile fp im = 
+  catchException
+    (openFile' fp im dEFAULT_OPEN_IN_BINARY_MODE True)
+    (\e -> ioError (addFilePathToIOError "openFile" fp e))
+
+-- | Like 'openFile', but opens the file in ordinary blocking mode.
+-- This can be useful for opening a FIFO for reading: if we open in
+-- non-blocking mode then the open will fail if there are no writers,
+-- whereas a blocking open will block until a writer appears.
+--
+-- /Since: 4.4.0.0/
+openFileBlocking :: FilePath -> IOMode -> IO Handle
+openFileBlocking fp im =
+  catchException
+    (openFile' fp im dEFAULT_OPEN_IN_BINARY_MODE False)
+    (\e -> ioError (addFilePathToIOError "openFile" fp e))
+
+-- | Like 'openFile', but open the file in binary mode.
+-- On Windows, reading a file in text mode (which is the default)
+-- will translate CRLF to LF, and writing will translate LF to CRLF.
+-- This is usually what you want with text files.  With binary files
+-- this is undesirable; also, as usual under Microsoft operating systems,
+-- text mode treats control-Z as EOF.  Binary mode turns off all special
+-- treatment of end-of-line and end-of-file characters.
+-- (See also 'hSetBinaryMode'.)
+
+openBinaryFile :: FilePath -> IOMode -> IO Handle
+openBinaryFile fp m =
+  catchException
+    (openFile' fp m True True)
+    (\e -> ioError (addFilePathToIOError "openBinaryFile" fp e))
+
+openFile' :: String -> IOMode -> Bool -> Bool -> IO Handle
+openFile' filepath iomode binary non_blocking = do
+  -- first open the file to get an FD
+  (fd, fd_type) <- FD.openFile filepath iomode non_blocking
+
+  mb_codec <- if binary then return Nothing else fmap Just getLocaleEncoding
+
+  -- then use it to make a Handle
+  mkHandleFromFD fd fd_type filepath iomode
+                   False {- do not *set* non-blocking mode -}
+                   mb_codec
+            `onException` IODevice.close fd
+        -- NB. don't forget to close the FD if mkHandleFromFD fails, otherwise
+        -- this FD leaks.
+        -- ASSERT: if we just created the file, then fdToHandle' won't fail
+        -- (so we don't need to worry about removing the newly created file
+        --  in the event of an error).
+
+
+-- ---------------------------------------------------------------------------
+-- Converting file descriptors to Handles
+
+mkHandleFromFD
+   :: FD.FD
+   -> IODeviceType
+   -> FilePath  -- a string describing this file descriptor (e.g. the filename)
+   -> IOMode
+   -> Bool      --  *set* non-blocking mode on the FD
+   -> Maybe TextEncoding
+   -> IO Handle
+
+mkHandleFromFD fd0 fd_type filepath iomode set_non_blocking mb_codec
+  = do
+#ifndef mingw32_HOST_OS
+    -- turn on non-blocking mode
+    fd <- if set_non_blocking 
+             then FD.setNonBlockingMode fd0 True
+             else return fd0
+#else
+    let _ = set_non_blocking -- warning suppression
+    fd <- return fd0
+#endif
+
+    let nl | isJust mb_codec = nativeNewlineMode
+           | otherwise       = noNewlineTranslation
+
+    case fd_type of
+        Directory -> 
+           ioException (IOError Nothing InappropriateType "openFile"
+                           "is a directory" Nothing Nothing)
+
+        Stream
+           -- only *Streams* can be DuplexHandles.  Other read/write
+           -- Handles must share a buffer.
+           | ReadWriteMode <- iomode -> 
+                mkDuplexHandle fd filepath mb_codec nl
+                   
+
+        _other -> 
+           mkFileHandle fd filepath iomode mb_codec nl
+
+-- | Old API kept to avoid breaking clients
+fdToHandle' :: CInt
+            -> Maybe IODeviceType
+            -> Bool -- is_socket on Win, non-blocking on Unix
+            -> FilePath
+            -> IOMode
+            -> Bool -- binary
+            -> IO Handle
+fdToHandle' fdint mb_type is_socket filepath iomode binary = do
+  let mb_stat = case mb_type of
+                        Nothing          -> Nothing
+                          -- mkFD will do the stat:
+                        Just RegularFile -> Nothing
+                          -- no stat required for streams etc.:
+                        Just other       -> Just (other,0,0)
+  (fd,fd_type) <- FD.mkFD fdint iomode mb_stat
+                       is_socket
+                       is_socket
+  enc <- if binary then return Nothing else fmap Just getLocaleEncoding
+  mkHandleFromFD fd fd_type filepath iomode is_socket enc
+
+
+-- | Turn an existing file descriptor into a Handle.  This is used by
+-- various external libraries to make Handles.
+--
+-- Makes a binary Handle.  This is for historical reasons; it should
+-- probably be a text Handle with the default encoding and newline
+-- translation instead.
+fdToHandle :: Posix.FD -> IO Handle
+fdToHandle fdint = do
+   iomode <- Posix.fdGetMode fdint
+   (fd,fd_type) <- FD.mkFD fdint iomode Nothing
+            False{-is_socket-} 
+              -- NB. the is_socket flag is False, meaning that:
+              --  on Windows we're guessing this is not a socket (XXX)
+            False{-is_nonblock-}
+              -- file descriptors that we get from external sources are
+              -- not put into non-blocking mode, because that would affect
+              -- other users of the file descriptor
+   let fd_str = "<file descriptor: " ++ show fd ++ ">"
+   mkHandleFromFD fd fd_type fd_str iomode False{-non-block-} 
+                  Nothing -- bin mode
+
+-- ---------------------------------------------------------------------------
+-- Are files opened by default in text or binary mode, if the user doesn't
+-- specify?
+
+dEFAULT_OPEN_IN_BINARY_MODE :: Bool
+dEFAULT_OPEN_IN_BINARY_MODE = False
diff --git a/libraries/base/GHC/IO/Handle/FD.hs-boot b/libraries/base/GHC/IO/Handle/FD.hs-boot
new file mode 100644
index 000000000000..b592a050159b
--- /dev/null
+++ b/libraries/base/GHC/IO/Handle/FD.hs-boot
@@ -0,0 +1,10 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+
+module GHC.IO.Handle.FD where
+
+import GHC.IO.Handle.Types
+
+-- used in GHC.Conc, which is below GHC.IO.Handle.FD
+stdout :: Handle
+
diff --git a/libraries/base/GHC/IO/Handle/Internals.hs b/libraries/base/GHC/IO/Handle/Internals.hs
new file mode 100644
index 000000000000..e53349ac3505
--- /dev/null
+++ b/libraries/base/GHC/IO/Handle/Internals.hs
@@ -0,0 +1,942 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE NoImplicitPrelude
+           , RecordWildCards
+           , BangPatterns
+           , NondecreasingIndentation
+           , RankNTypes
+  #-}
+{-# OPTIONS_GHC -fno-warn-unused-matches #-}
+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
+{-# OPTIONS_HADDOCK hide #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.IO.Handle.Internals
+-- Copyright   :  (c) The University of Glasgow, 1994-2001
+-- License     :  see libraries/base/LICENSE
+-- 
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  internal
+-- Portability :  non-portable
+--
+-- This module defines the basic operations on I\/O \"handles\".  All
+-- of the operations defined here are independent of the underlying
+-- device.
+--
+-----------------------------------------------------------------------------
+
+module GHC.IO.Handle.Internals (
+  withHandle, withHandle', withHandle_,
+  withHandle__', withHandle_', withAllHandles__,
+  wantWritableHandle, wantReadableHandle, wantReadableHandle_, 
+  wantSeekableHandle,
+
+  mkHandle, mkFileHandle, mkDuplexHandle,
+  openTextEncoding, closeTextCodecs, initBufferState,
+  dEFAULT_CHAR_BUFFER_SIZE,
+
+  flushBuffer, flushWriteBuffer, flushCharReadBuffer,
+  flushCharBuffer, flushByteReadBuffer, flushByteWriteBuffer,
+
+  readTextDevice, writeCharBuffer, readTextDeviceNonBlocking,
+  decodeByteBuf,
+
+  augmentIOError,
+  ioe_closedHandle, ioe_EOF, ioe_notReadable, ioe_notWritable,
+  ioe_finalizedHandle, ioe_bufsiz,
+
+  hClose_help, hLookAhead_,
+
+  HandleFinalizer, handleFinalizer,
+
+  debugIO,
+ ) where
+
+import GHC.IO
+import GHC.IO.IOMode
+import GHC.IO.Encoding as Encoding
+import GHC.IO.Encoding.Types (CodeBuffer)
+import GHC.IO.Handle.Types
+import GHC.IO.Buffer
+import GHC.IO.BufferedIO (BufferedIO)
+import GHC.IO.Exception
+import GHC.IO.Device (IODevice, SeekMode(..))
+import qualified GHC.IO.Device as IODevice
+import qualified GHC.IO.BufferedIO as Buffered
+
+import GHC.Conc.Sync
+import GHC.Real
+import GHC.Base
+import GHC.Exception
+import GHC.Num          ( Num(..) )
+import GHC.Show
+import GHC.IORef
+import GHC.MVar
+import Data.Typeable
+import Control.Monad
+import Data.Maybe
+import Foreign.Safe
+import System.Posix.Internals hiding (FD)
+
+import Foreign.C
+
+c_DEBUG_DUMP :: Bool
+c_DEBUG_DUMP = False
+
+-- ---------------------------------------------------------------------------
+-- Creating a new handle
+
+type HandleFinalizer = FilePath -> MVar Handle__ -> IO ()
+
+newFileHandle :: FilePath -> Maybe HandleFinalizer -> Handle__ -> IO Handle
+newFileHandle filepath mb_finalizer hc = do
+  m <- newMVar hc
+  case mb_finalizer of
+    Just finalizer -> addMVarFinalizer m (finalizer filepath m)
+    Nothing        -> return ()
+  return (FileHandle filepath m)
+
+-- ---------------------------------------------------------------------------
+-- Working with Handles
+
+{-
+In the concurrent world, handles are locked during use.  This is done
+by wrapping an MVar around the handle which acts as a mutex over
+operations on the handle.
+
+To avoid races, we use the following bracketing operations.  The idea
+is to obtain the lock, do some operation and replace the lock again,
+whether the operation succeeded or failed.  We also want to handle the
+case where the thread receives an exception while processing the IO
+operation: in these cases we also want to relinquish the lock.
+
+There are three versions of @withHandle@: corresponding to the three
+possible combinations of:
+
+        - the operation may side-effect the handle
+        - the operation may return a result
+
+If the operation generates an error or an exception is raised, the
+original handle is always replaced.
+-}
+
+{-# INLINE withHandle #-}
+withHandle :: String -> Handle -> (Handle__ -> IO (Handle__,a)) -> IO a
+withHandle fun h@(FileHandle _ m)     act = withHandle' fun h m act
+withHandle fun h@(DuplexHandle _ m _) act = withHandle' fun h m act
+
+withHandle' :: String -> Handle -> MVar Handle__
+   -> (Handle__ -> IO (Handle__,a)) -> IO a
+withHandle' fun h m act =
+ mask_ $ do
+   (h',v)  <- do_operation fun h act m
+   checkHandleInvariants h'
+   putMVar m h'
+   return v
+
+{-# INLINE withHandle_ #-}
+withHandle_ :: String -> Handle -> (Handle__ -> IO a) -> IO a
+withHandle_ fun h@(FileHandle _ m)     act = withHandle_' fun h m act
+withHandle_ fun h@(DuplexHandle _ m _) act = withHandle_' fun h m act
+
+withHandle_' :: String -> Handle -> MVar Handle__ -> (Handle__ -> IO a) -> IO a
+withHandle_' fun h m act = withHandle' fun h m $ \h_ -> do
+                              a <- act h_
+                              return (h_,a)
+
+withAllHandles__ :: String -> Handle -> (Handle__ -> IO Handle__) -> IO ()
+withAllHandles__ fun h@(FileHandle _ m)     act = withHandle__' fun h m act
+withAllHandles__ fun h@(DuplexHandle _ r w) act = do
+  withHandle__' fun h r act
+  withHandle__' fun h w act
+
+withHandle__' :: String -> Handle -> MVar Handle__ -> (Handle__ -> IO Handle__)
+              -> IO ()
+withHandle__' fun h m act =
+ mask_ $ do
+   h'  <- do_operation fun h act m
+   checkHandleInvariants h'
+   putMVar m h'
+   return ()
+
+do_operation :: String -> Handle -> (Handle__ -> IO a) -> MVar Handle__ -> IO a
+do_operation fun h act m = do
+  h_ <- takeMVar m
+  checkHandleInvariants h_
+  act h_ `catchException` handler h_
+  where
+    handler h_ e = do
+      putMVar m h_
+      case () of
+        _ | Just ioe <- fromException e ->
+            ioError (augmentIOError ioe fun h)
+        _ | Just async_ex <- fromException e -> do -- see Note [async]
+            let _ = async_ex :: SomeAsyncException
+            t <- myThreadId
+            throwTo t e
+            do_operation fun h act m
+        _otherwise ->
+            throwIO e
+
+-- Note [async]
+--
+-- If an asynchronous exception is raised during an I/O operation,
+-- normally it is fine to just re-throw the exception synchronously.
+-- However, if we are inside an unsafePerformIO or an
+-- unsafeInterleaveIO, this would replace the enclosing thunk with the
+-- exception raised, which is wrong (#3997).  We have to release the
+-- lock on the Handle, but what do we replace the thunk with?  What
+-- should happen when the thunk is subsequently demanded again?
+--
+-- The only sensible choice we have is to re-do the IO operation on
+-- resumption, but then we have to be careful in the IO library that
+-- this is always safe to do.  In particular we should
+--
+--    never perform any side-effects before an interruptible operation
+--
+-- because the interruptible operation may raise an asynchronous
+-- exception, which may cause the operation and its side effects to be
+-- subsequently performed again.
+--
+-- Re-doing the IO operation is achieved by:
+--   - using throwTo to re-throw the asynchronous exception asynchronously
+--     in the current thread
+--   - on resumption, it will be as if throwTo returns.  In that case, we
+--     recursively invoke the original operation (see do_operation above).
+--
+-- Interruptible operations in the I/O library are:
+--    - threadWaitRead/threadWaitWrite
+--    - fillReadBuffer/flushWriteBuffer
+--    - readTextDevice/writeTextDevice
+
+augmentIOError :: IOException -> String -> Handle -> IOException
+augmentIOError ioe@IOError{ ioe_filename = fp } fun h
+  = ioe { ioe_handle = Just h, ioe_location = fun, ioe_filename = filepath }
+  where filepath
+          | Just _ <- fp = fp
+          | otherwise = case h of
+                          FileHandle path _     -> Just path
+                          DuplexHandle path _ _ -> Just path
+
+-- ---------------------------------------------------------------------------
+-- Wrapper for write operations.
+
+wantWritableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
+wantWritableHandle fun h@(FileHandle _ m) act
+  = wantWritableHandle' fun h m act
+wantWritableHandle fun h@(DuplexHandle _ _ m) act
+  = wantWritableHandle' fun h m act
+    -- we know it's not a ReadHandle or ReadWriteHandle, but we have to
+    -- check for ClosedHandle/SemiClosedHandle. (#4808)
+
+wantWritableHandle'
+        :: String -> Handle -> MVar Handle__
+        -> (Handle__ -> IO a) -> IO a
+wantWritableHandle' fun h m act
+   = withHandle_' fun h m (checkWritableHandle act)
+
+checkWritableHandle :: (Handle__ -> IO a) -> Handle__ -> IO a
+checkWritableHandle act h_@Handle__{..}
+  = case haType of
+      ClosedHandle         -> ioe_closedHandle
+      SemiClosedHandle     -> ioe_closedHandle
+      ReadHandle           -> ioe_notWritable
+      ReadWriteHandle      -> do
+        buf <- readIORef haCharBuffer
+        when (not (isWriteBuffer buf)) $ do
+           flushCharReadBuffer h_
+           flushByteReadBuffer h_
+           buf <- readIORef haCharBuffer
+           writeIORef haCharBuffer buf{ bufState = WriteBuffer }
+           buf <- readIORef haByteBuffer
+           buf' <- Buffered.emptyWriteBuffer haDevice buf
+           writeIORef haByteBuffer buf'
+        act h_
+      _other               -> act h_
+
+-- ---------------------------------------------------------------------------
+-- Wrapper for read operations.
+
+wantReadableHandle :: String -> Handle -> (Handle__ -> IO (Handle__,a)) -> IO a
+wantReadableHandle fun h act = withHandle fun h (checkReadableHandle act)
+
+wantReadableHandle_ :: String -> Handle -> (Handle__ -> IO a) -> IO a
+wantReadableHandle_ fun h@(FileHandle  _ m)   act
+  = wantReadableHandle' fun h m act
+wantReadableHandle_ fun h@(DuplexHandle _ m _) act
+  = wantReadableHandle' fun h m act
+    -- we know it's not a WriteHandle or ReadWriteHandle, but we have to
+    -- check for ClosedHandle/SemiClosedHandle. (#4808)
+
+wantReadableHandle'
+        :: String -> Handle -> MVar Handle__
+        -> (Handle__ -> IO a) -> IO a
+wantReadableHandle' fun h m act
+  = withHandle_' fun h m (checkReadableHandle act)
+
+checkReadableHandle :: (Handle__ -> IO a) -> Handle__ -> IO a
+checkReadableHandle act h_@Handle__{..} =
+    case haType of
+      ClosedHandle         -> ioe_closedHandle
+      SemiClosedHandle     -> ioe_closedHandle
+      AppendHandle         -> ioe_notReadable
+      WriteHandle          -> ioe_notReadable
+      ReadWriteHandle      -> do
+          -- a read/write handle and we want to read from it.  We must
+          -- flush all buffered write data first.
+          bbuf <- readIORef haByteBuffer
+          when (isWriteBuffer bbuf) $ do
+             when (not (isEmptyBuffer bbuf)) $ flushByteWriteBuffer h_
+             cbuf' <- readIORef haCharBuffer
+             writeIORef haCharBuffer cbuf'{ bufState = ReadBuffer }
+             bbuf <- readIORef haByteBuffer
+             writeIORef haByteBuffer bbuf{ bufState = ReadBuffer }
+          act h_
+      _other               -> act h_
+
+-- ---------------------------------------------------------------------------
+-- Wrapper for seek operations.
+
+wantSeekableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
+wantSeekableHandle fun h@(DuplexHandle _ _ _) _act =
+  ioException (IOError (Just h) IllegalOperation fun
+                   "handle is not seekable" Nothing Nothing)
+wantSeekableHandle fun h@(FileHandle _ m) act =
+  withHandle_' fun h m (checkSeekableHandle act)
+
+checkSeekableHandle :: (Handle__ -> IO a) -> Handle__ -> IO a
+checkSeekableHandle act handle_@Handle__{haDevice=dev} =
+    case haType handle_ of
+      ClosedHandle      -> ioe_closedHandle
+      SemiClosedHandle  -> ioe_closedHandle
+      AppendHandle      -> ioe_notSeekable
+      _ -> do b <- IODevice.isSeekable dev
+              if b then act handle_
+                   else ioe_notSeekable
+
+-- -----------------------------------------------------------------------------
+-- Handy IOErrors
+
+ioe_closedHandle, ioe_EOF,
+  ioe_notReadable, ioe_notWritable, ioe_cannotFlushNotSeekable,
+  ioe_notSeekable :: IO a
+
+ioe_closedHandle = ioException
+   (IOError Nothing IllegalOperation ""
+        "handle is closed" Nothing Nothing)
+ioe_EOF = ioException
+   (IOError Nothing EOF "" "" Nothing Nothing)
+ioe_notReadable = ioException
+   (IOError Nothing IllegalOperation ""
+        "handle is not open for reading" Nothing Nothing)
+ioe_notWritable = ioException
+   (IOError Nothing IllegalOperation ""
+        "handle is not open for writing" Nothing Nothing)
+ioe_notSeekable = ioException
+   (IOError Nothing IllegalOperation ""
+        "handle is not seekable" Nothing Nothing)
+ioe_cannotFlushNotSeekable = ioException
+   (IOError Nothing IllegalOperation ""
+      "cannot flush the read buffer: underlying device is not seekable"
+        Nothing Nothing)
+
+ioe_finalizedHandle :: FilePath -> Handle__
+ioe_finalizedHandle fp = throw
+   (IOError Nothing IllegalOperation ""
+        "handle is finalized" Nothing (Just fp))
+
+ioe_bufsiz :: Int -> IO a
+ioe_bufsiz n = ioException
+   (IOError Nothing InvalidArgument "hSetBuffering"
+        ("illegal buffer size " ++ showsPrec 9 n []) Nothing Nothing)
+                                -- 9 => should be parens'ified.
+
+-- ---------------------------------------------------------------------------
+-- Wrapper for Handle encoding/decoding.
+
+-- The interface for TextEncoding changed so that a TextEncoding doesn't raise
+-- an exception if it encounters an invalid sequnce. Furthermore, encoding
+-- returns a reason as to why encoding stopped, letting us know if it was due
+-- to input/output underflow or an invalid sequence.
+--
+-- This code adapts this elaborated interface back to the original TextEncoding
+-- interface.
+--
+-- FIXME: it is possible that Handle code using the haDecoder/haEncoder fields
+-- could be made clearer by using the 'encode' interface directly. I have not
+-- looked into this.
+
+streamEncode :: BufferCodec from to state
+             -> Buffer from -> Buffer to
+             -> IO (Buffer from, Buffer to)
+streamEncode codec from to = fmap (\(_, from', to') -> (from', to')) $ recoveringEncode codec from to
+
+-- | Just like 'encode', but interleaves calls to 'encode' with calls to 'recover' in order to make as much progress as possible
+recoveringEncode :: BufferCodec from to state -> CodeBuffer from to
+recoveringEncode codec from to = go from to
+  where
+    go from to = do
+      (why, from', to') <- encode codec from to
+      -- When we are dealing with Handles, we don't care about input/output
+      -- underflow particularly, and we want to delay errors about invalid
+      -- sequences as far as possible.
+      case why of
+        InvalidSequence | bufL from == bufL from' -> do
+          -- NB: it is OK to call recover here. Because we saw InvalidSequence, by the invariants
+          -- on "encode" it must be the case that there is at least one elements available in the output
+          -- buffer. Furthermore, clearly there is at least one element in the input buffer since we found
+          -- something invalid there!
+          (from', to') <- recover codec from' to'
+          go from' to'
+        _ -> return (why, from', to')
+
+-- -----------------------------------------------------------------------------
+-- Handle Finalizers
+
+-- For a duplex handle, we arrange that the read side points to the write side
+-- (and hence keeps it alive if the read side is alive).  This is done by
+-- having the haOtherSide field of the read side point to the read side.
+-- The finalizer is then placed on the write side, and the handle only gets
+-- finalized once, when both sides are no longer required.
+
+-- NOTE about finalized handles: It's possible that a handle can be
+-- finalized and then we try to use it later, for example if the
+-- handle is referenced from another finalizer, or from a thread that
+-- has become unreferenced and then resurrected (arguably in the
+-- latter case we shouldn't finalize the Handle...).  Anyway,
+-- we try to emit a helpful message which is better than nothing.
+--
+-- [later; 8/2010] However, a program like this can yield a strange
+-- error message:
+--
+--   main = writeFile "out" loop
+--   loop = let x = x in x
+--
+-- because the main thread and the Handle are both unreachable at the
+-- same time, the Handle may get finalized before the main thread
+-- receives the NonTermination exception, and the exception handler
+-- will then report an error.  We'd rather this was not an error and
+-- the program just prints "<<loop>>".
+
+handleFinalizer :: FilePath -> MVar Handle__ -> IO ()
+handleFinalizer fp m = do
+  handle_ <- takeMVar m
+  (handle_', _) <- hClose_help handle_
+  putMVar m handle_'
+  return ()
+
+-- ---------------------------------------------------------------------------
+-- Allocating buffers
+
+-- using an 8k char buffer instead of 32k improved performance for a
+-- basic "cat" program by ~30% for me.  --SDM
+dEFAULT_CHAR_BUFFER_SIZE :: Int
+dEFAULT_CHAR_BUFFER_SIZE = 2048 -- 8k/sizeof(HsChar)
+
+getCharBuffer :: IODevice dev => dev -> BufferState
+              -> IO (IORef CharBuffer, BufferMode)
+getCharBuffer dev state = do
+  buffer <- newCharBuffer dEFAULT_CHAR_BUFFER_SIZE state
+  ioref  <- newIORef buffer
+  is_tty <- IODevice.isTerminal dev
+
+  let buffer_mode 
+         | is_tty    = LineBuffering 
+         | otherwise = BlockBuffering Nothing
+
+  return (ioref, buffer_mode)
+
+mkUnBuffer :: BufferState -> IO (IORef CharBuffer, BufferMode)
+mkUnBuffer state = do
+  buffer <- newCharBuffer dEFAULT_CHAR_BUFFER_SIZE state
+              --  See [note Buffer Sizing], GHC.IO.Handle.Types
+  ref <- newIORef buffer
+  return (ref, NoBuffering)
+
+-- -----------------------------------------------------------------------------
+-- Flushing buffers
+
+-- | syncs the file with the buffer, including moving the
+-- file pointer backwards in the case of a read buffer.  This can fail
+-- on a non-seekable read Handle.
+flushBuffer :: Handle__ -> IO ()
+flushBuffer h_@Handle__{..} = do
+  buf <- readIORef haCharBuffer
+  case bufState buf of
+    ReadBuffer  -> do
+        flushCharReadBuffer h_
+        flushByteReadBuffer h_
+    WriteBuffer -> do
+        flushByteWriteBuffer h_
+
+-- | flushes the Char buffer only.  Works on all Handles.
+flushCharBuffer :: Handle__ -> IO ()
+flushCharBuffer h_@Handle__{..} = do
+  cbuf <- readIORef haCharBuffer
+  case bufState cbuf of
+    ReadBuffer  -> do
+        flushCharReadBuffer h_
+    WriteBuffer ->
+        when (not (isEmptyBuffer cbuf)) $
+           error "internal IO library error: Char buffer non-empty"
+
+-- -----------------------------------------------------------------------------
+-- Writing data (flushing write buffers)
+
+-- flushWriteBuffer flushes the buffer iff it contains pending write
+-- data.  Flushes both the Char and the byte buffer, leaving both
+-- empty.
+flushWriteBuffer :: Handle__ -> IO ()
+flushWriteBuffer h_@Handle__{..} = do
+  buf <- readIORef haByteBuffer
+  when (isWriteBuffer buf) $ flushByteWriteBuffer h_
+
+flushByteWriteBuffer :: Handle__ -> IO ()
+flushByteWriteBuffer h_@Handle__{..} = do
+  bbuf <- readIORef haByteBuffer
+  when (not (isEmptyBuffer bbuf)) $ do
+    bbuf' <- Buffered.flushWriteBuffer haDevice bbuf
+    writeIORef haByteBuffer bbuf'
+
+-- write the contents of the CharBuffer to the Handle__.
+-- The data will be encoded and pushed to the byte buffer,
+-- flushing if the buffer becomes full.
+writeCharBuffer :: Handle__ -> CharBuffer -> IO ()
+writeCharBuffer h_@Handle__{..} !cbuf = do
+  --
+  bbuf <- readIORef haByteBuffer
+
+  debugIO ("writeCharBuffer: cbuf=" ++ summaryBuffer cbuf ++
+        " bbuf=" ++ summaryBuffer bbuf)
+
+  (cbuf',bbuf') <- case haEncoder of
+    Nothing      -> latin1_encode cbuf bbuf
+    Just encoder -> (streamEncode encoder) cbuf bbuf
+
+  debugIO ("writeCharBuffer after encoding: cbuf=" ++ summaryBuffer cbuf' ++
+        " bbuf=" ++ summaryBuffer bbuf')
+
+          -- flush if the write buffer is full
+  if isFullBuffer bbuf'
+          --  or we made no progress
+     || not (isEmptyBuffer cbuf') && bufL cbuf' == bufL cbuf
+          -- or the byte buffer has more elements than the user wanted buffered
+     || (case haBufferMode of
+          BlockBuffering (Just s) -> bufferElems bbuf' >= s
+          NoBuffering -> True
+          _other -> False)
+    then do
+      bbuf'' <- Buffered.flushWriteBuffer haDevice bbuf'
+      writeIORef haByteBuffer bbuf''
+    else
+      writeIORef haByteBuffer bbuf'
+
+  if not (isEmptyBuffer cbuf')
+     then writeCharBuffer h_ cbuf'
+     else return ()
+
+-- -----------------------------------------------------------------------------
+-- Flushing read buffers
+
+-- It is always possible to flush the Char buffer back to the byte buffer.
+flushCharReadBuffer :: Handle__ -> IO ()
+flushCharReadBuffer Handle__{..} = do
+  cbuf <- readIORef haCharBuffer
+  if isWriteBuffer cbuf || isEmptyBuffer cbuf then return () else do
+
+  -- haLastDecode is the byte buffer just before we did our last batch of
+  -- decoding.  We're going to re-decode the bytes up to the current char,
+  -- to find out where we should revert the byte buffer to.
+  (codec_state, bbuf0) <- readIORef haLastDecode
+
+  cbuf0 <- readIORef haCharBuffer
+  writeIORef haCharBuffer cbuf0{ bufL=0, bufR=0 }
+
+  -- if we haven't used any characters from the char buffer, then just
+  -- re-install the old byte buffer.
+  if bufL cbuf0 == 0
+     then do writeIORef haByteBuffer bbuf0
+             return ()
+     else do
+
+  case haDecoder of
+    Nothing -> do
+      writeIORef haByteBuffer bbuf0 { bufL = bufL bbuf0 + bufL cbuf0 }
+      -- no decoder: the number of bytes to decode is the same as the
+      -- number of chars we have used up.
+
+    Just decoder -> do
+      debugIO ("flushCharReadBuffer re-decode, bbuf=" ++ summaryBuffer bbuf0 ++
+               " cbuf=" ++ summaryBuffer cbuf0)
+
+      -- restore the codec state
+      setState decoder codec_state
+    
+      (bbuf1,cbuf1) <- (streamEncode decoder) bbuf0
+                               cbuf0{ bufL=0, bufR=0, bufSize = bufL cbuf0 }
+    
+      debugIO ("finished, bbuf=" ++ summaryBuffer bbuf1 ++
+               " cbuf=" ++ summaryBuffer cbuf1)
+
+      writeIORef haByteBuffer bbuf1
+
+
+-- When flushing the byte read buffer, we seek backwards by the number
+-- of characters in the buffer.  The file descriptor must therefore be
+-- seekable: attempting to flush the read buffer on an unseekable
+-- handle is not allowed.
+
+flushByteReadBuffer :: Handle__ -> IO ()
+flushByteReadBuffer h_@Handle__{..} = do
+  bbuf <- readIORef haByteBuffer
+
+  if isEmptyBuffer bbuf then return () else do
+
+  seekable <- IODevice.isSeekable haDevice
+  when (not seekable) $ ioe_cannotFlushNotSeekable
+
+  let seek = negate (bufR bbuf - bufL bbuf)
+
+  debugIO ("flushByteReadBuffer: new file offset = " ++ show seek)
+  IODevice.seek haDevice RelativeSeek (fromIntegral seek)
+
+  writeIORef haByteBuffer bbuf{ bufL=0, bufR=0 }
+
+-- ----------------------------------------------------------------------------
+-- Making Handles
+
+mkHandle :: (IODevice dev, BufferedIO dev, Typeable dev) => dev
+            -> FilePath
+            -> HandleType
+            -> Bool                     -- buffered?
+            -> Maybe TextEncoding
+            -> NewlineMode
+            -> Maybe HandleFinalizer
+            -> Maybe (MVar Handle__)
+            -> IO Handle
+
+mkHandle dev filepath ha_type buffered mb_codec nl finalizer other_side = do
+   openTextEncoding mb_codec ha_type $ \ mb_encoder mb_decoder -> do
+
+   let buf_state = initBufferState ha_type
+   bbuf <- Buffered.newBuffer dev buf_state
+   bbufref <- newIORef bbuf
+   last_decode <- newIORef (error "codec_state", bbuf)
+
+   (cbufref,bmode) <- 
+         if buffered then getCharBuffer dev buf_state
+                     else mkUnBuffer buf_state
+
+   spares <- newIORef BufferListNil
+   newFileHandle filepath finalizer
+            (Handle__ { haDevice = dev,
+                        haType = ha_type,
+                        haBufferMode = bmode,
+                        haByteBuffer = bbufref,
+                        haLastDecode = last_decode,
+                        haCharBuffer = cbufref,
+                        haBuffers = spares,
+                        haEncoder = mb_encoder,
+                        haDecoder = mb_decoder,
+                        haCodec = mb_codec,
+                        haInputNL = inputNL nl,
+                        haOutputNL = outputNL nl,
+                        haOtherSide = other_side
+                      })
+
+-- | makes a new 'Handle'
+mkFileHandle :: (IODevice dev, BufferedIO dev, Typeable dev)
+             => dev -- ^ the underlying IO device, which must support 
+                    -- 'IODevice', 'BufferedIO' and 'Typeable'
+             -> FilePath
+                    -- ^ a string describing the 'Handle', e.g. the file
+                    -- path for a file.  Used in error messages.
+             -> IOMode
+                    -- The mode in which the 'Handle' is to be used
+             -> Maybe TextEncoding
+                    -- Create the 'Handle' with no text encoding?
+             -> NewlineMode
+                    -- Translate newlines?
+             -> IO Handle
+mkFileHandle dev filepath iomode mb_codec tr_newlines = do
+   mkHandle dev filepath (ioModeToHandleType iomode) True{-buffered-} mb_codec
+            tr_newlines
+            (Just handleFinalizer) Nothing{-other_side-}
+
+-- | like 'mkFileHandle', except that a 'Handle' is created with two
+-- independent buffers, one for reading and one for writing.  Used for
+-- full-duplex streams, such as network sockets.
+mkDuplexHandle :: (IODevice dev, BufferedIO dev, Typeable dev) => dev
+               -> FilePath -> Maybe TextEncoding -> NewlineMode -> IO Handle
+mkDuplexHandle dev filepath mb_codec tr_newlines = do
+
+  write_side@(FileHandle _ write_m) <- 
+       mkHandle dev filepath WriteHandle True mb_codec
+                        tr_newlines
+                        (Just handleFinalizer)
+                        Nothing -- no othersie
+
+  read_side@(FileHandle _ read_m) <- 
+      mkHandle dev filepath ReadHandle True mb_codec
+                        tr_newlines
+                        Nothing -- no finalizer
+                        (Just write_m)
+
+  return (DuplexHandle filepath read_m write_m)
+
+ioModeToHandleType :: IOMode -> HandleType
+ioModeToHandleType ReadMode      = ReadHandle
+ioModeToHandleType WriteMode     = WriteHandle
+ioModeToHandleType ReadWriteMode = ReadWriteHandle
+ioModeToHandleType AppendMode    = AppendHandle
+
+initBufferState :: HandleType -> BufferState
+initBufferState ReadHandle = ReadBuffer
+initBufferState _          = WriteBuffer
+
+openTextEncoding
+   :: Maybe TextEncoding
+   -> HandleType
+   -> (forall es ds . Maybe (TextEncoder es) -> Maybe (TextDecoder ds) -> IO a)
+   -> IO a
+
+openTextEncoding Nothing   ha_type cont = cont Nothing Nothing
+openTextEncoding (Just TextEncoding{..}) ha_type cont = do
+    mb_decoder <- if isReadableHandleType ha_type then do
+                     decoder <- mkTextDecoder
+                     return (Just decoder)
+                  else
+                     return Nothing
+    mb_encoder <- if isWritableHandleType ha_type then do
+                     encoder <- mkTextEncoder
+                     return (Just encoder)
+                  else 
+                     return Nothing
+    cont mb_encoder mb_decoder
+
+closeTextCodecs :: Handle__ -> IO ()
+closeTextCodecs Handle__{..} = do
+  case haDecoder of Nothing -> return (); Just d -> Encoding.close d
+  case haEncoder of Nothing -> return (); Just d -> Encoding.close d
+
+-- ---------------------------------------------------------------------------
+-- closing Handles
+
+-- hClose_help is also called by lazyRead (in GHC.IO.Handle.Text) when
+-- EOF is read or an IO error occurs on a lazy stream.  The
+-- semi-closed Handle is then closed immediately.  We have to be
+-- careful with DuplexHandles though: we have to leave the closing to
+-- the finalizer in that case, because the write side may still be in
+-- use.
+hClose_help :: Handle__ -> IO (Handle__, Maybe SomeException)
+hClose_help handle_ =
+  case haType handle_ of 
+      ClosedHandle -> return (handle_,Nothing)
+      _ -> do mb_exc1 <- trymaybe $ flushWriteBuffer handle_ -- interruptible
+                    -- it is important that hClose doesn't fail and
+                    -- leave the Handle open (#3128), so we catch
+                    -- exceptions when flushing the buffer.
+              (h_, mb_exc2) <- hClose_handle_ handle_
+              return (h_, if isJust mb_exc1 then mb_exc1 else mb_exc2)
+
+
+trymaybe :: IO () -> IO (Maybe SomeException)
+trymaybe io = (do io; return Nothing) `catchException` \e -> return (Just e)
+
+hClose_handle_ :: Handle__ -> IO (Handle__, Maybe SomeException)
+hClose_handle_ h_@Handle__{..} = do
+
+    -- close the file descriptor, but not when this is the read
+    -- side of a duplex handle.
+    -- If an exception is raised by the close(), we want to continue
+    -- to close the handle and release the lock if it has one, then 
+    -- we return the exception to the caller of hClose_help which can
+    -- raise it if necessary.
+    maybe_exception <- 
+      case haOtherSide of
+        Nothing -> trymaybe $ IODevice.close haDevice
+        Just _  -> return Nothing
+
+    -- free the spare buffers
+    writeIORef haBuffers BufferListNil
+    writeIORef haCharBuffer noCharBuffer
+    writeIORef haByteBuffer noByteBuffer
+  
+    -- release our encoder/decoder
+    closeTextCodecs h_
+
+    -- we must set the fd to -1, because the finalizer is going
+    -- to run eventually and try to close/unlock it.
+    -- ToDo: necessary?  the handle will be marked ClosedHandle
+    -- XXX GHC won't let us use record update here, hence wildcards
+    return (Handle__{ haType = ClosedHandle, .. }, maybe_exception)
+
+{-# NOINLINE noCharBuffer #-}
+noCharBuffer :: CharBuffer
+noCharBuffer = unsafePerformIO $ newCharBuffer 1 ReadBuffer
+
+{-# NOINLINE noByteBuffer #-}
+noByteBuffer :: Buffer Word8
+noByteBuffer = unsafePerformIO $ newByteBuffer 1 ReadBuffer
+
+-- ---------------------------------------------------------------------------
+-- Looking ahead
+
+hLookAhead_ :: Handle__ -> IO Char
+hLookAhead_ handle_@Handle__{..} = do
+    buf <- readIORef haCharBuffer
+  
+    -- fill up the read buffer if necessary
+    new_buf <- if isEmptyBuffer buf
+                  then readTextDevice handle_ buf
+                  else return buf
+    writeIORef haCharBuffer new_buf
+  
+    peekCharBuf (bufRaw buf) (bufL buf)
+
+-- ---------------------------------------------------------------------------
+-- debugging
+
+debugIO :: String -> IO ()
+debugIO s
+ | c_DEBUG_DUMP
+    = do _ <- withCStringLen (s ++ "\n") $
+                  \(p, len) -> c_write 1 (castPtr p) (fromIntegral len)
+         return ()
+ | otherwise = return ()
+
+-- ----------------------------------------------------------------------------
+-- Text input/output
+
+-- Read characters into the provided buffer.  Return when any
+-- characters are available; raise an exception if the end of 
+-- file is reached.
+--
+-- In uses of readTextDevice within base, the input buffer is either:
+--   * empty
+--   * or contains a single \r (when doing newline translation)
+--
+-- The input character buffer must have a capacity at least 1 greater
+-- than the number of elements it currently contains.
+--
+-- Users of this function expect that the buffer returned contains
+-- at least 1 more character than the input buffer.
+readTextDevice :: Handle__ -> CharBuffer -> IO CharBuffer
+readTextDevice h_@Handle__{..} cbuf = do
+  --
+  bbuf0 <- readIORef haByteBuffer
+
+  debugIO ("readTextDevice: cbuf=" ++ summaryBuffer cbuf ++ 
+        " bbuf=" ++ summaryBuffer bbuf0)
+
+  bbuf1 <- if not (isEmptyBuffer bbuf0)
+              then return bbuf0
+              else do
+                   (r,bbuf1) <- Buffered.fillReadBuffer haDevice bbuf0
+                   if r == 0 then ioe_EOF else do  -- raise EOF
+                   return bbuf1
+
+  debugIO ("readTextDevice after reading: bbuf=" ++ summaryBuffer bbuf1)
+
+  (bbuf2,cbuf') <- 
+      case haDecoder of
+          Nothing      -> do
+               writeIORef haLastDecode (error "codec_state", bbuf1)
+               latin1_decode bbuf1 cbuf
+          Just decoder -> do
+               state <- getState decoder
+               writeIORef haLastDecode (state, bbuf1)
+               (streamEncode decoder) bbuf1 cbuf
+
+  debugIO ("readTextDevice after decoding: cbuf=" ++ summaryBuffer cbuf' ++ 
+        " bbuf=" ++ summaryBuffer bbuf2)
+
+  -- We can't return from readTextDevice without reading at least a single extra character,
+  -- so check that we have managed to achieve that
+  writeIORef haByteBuffer bbuf2
+  if bufR cbuf' == bufR cbuf
+     -- we need more bytes to make a Char. NB: bbuf2 may be empty (even though bbuf1 wasn't) when we
+     -- are using an encoding that can skip bytes without outputting characters, such as UTF8//IGNORE
+     then readTextDevice' h_ bbuf2 cbuf
+     else return cbuf'
+
+-- we have an incomplete byte sequence at the end of the buffer: try to
+-- read more bytes.
+readTextDevice' :: Handle__ -> Buffer Word8 -> CharBuffer -> IO CharBuffer
+readTextDevice' h_@Handle__{..} bbuf0 cbuf0 = do
+  --
+  -- copy the partial sequence to the beginning of the buffer, so we have
+  -- room to read more bytes.
+  bbuf1 <- slideContents bbuf0
+
+  -- readTextDevice only calls us if we got some bytes but not some characters.
+  -- This can't occur if haDecoder is Nothing because latin1_decode accepts all bytes.
+  let Just decoder = haDecoder
+  
+  (r,bbuf2) <- Buffered.fillReadBuffer haDevice bbuf1
+  if r == 0
+   then do
+     -- bbuf2 can be empty here when we encounter an invalid byte sequence at the end of the input
+     -- with a //IGNORE codec which consumes bytes without outputting characters
+     if isEmptyBuffer bbuf2 then ioe_EOF else do
+     (bbuf3, cbuf1) <- recover decoder bbuf2 cbuf0
+     debugIO ("readTextDevice' after recovery: bbuf=" ++ summaryBuffer bbuf3 ++ ", cbuf=" ++ summaryBuffer cbuf1)
+     writeIORef haByteBuffer bbuf3
+     -- We should recursively invoke readTextDevice after recovery,
+     -- if recovery did not add at least one new character to the buffer:
+     --  1. If we were using IgnoreCodingFailure it might be the case that
+     --     cbuf1 is the same length as cbuf0 and we need to raise ioe_EOF
+     --  2. If we were using TransliterateCodingFailure we might have *mutated*
+     --     the byte buffer without changing the pointers into either buffer.
+     --     We need to try and decode it again - it might just go through this time.
+     if bufR cbuf1 == bufR cbuf0
+      then readTextDevice h_ cbuf1
+      else return cbuf1
+   else do
+    debugIO ("readTextDevice' after reading: bbuf=" ++ summaryBuffer bbuf2)
+  
+    (bbuf3,cbuf1) <- do
+       state <- getState decoder
+       writeIORef haLastDecode (state, bbuf2)
+       (streamEncode decoder) bbuf2 cbuf0
+  
+    debugIO ("readTextDevice' after decoding: cbuf=" ++ summaryBuffer cbuf1 ++ 
+          " bbuf=" ++ summaryBuffer bbuf3)
+  
+    writeIORef haByteBuffer bbuf3
+    if bufR cbuf0 == bufR cbuf1
+       then readTextDevice' h_ bbuf3 cbuf1
+       else return cbuf1
+
+-- Read characters into the provided buffer.  Do not block;
+-- return zero characters instead.  Raises an exception on end-of-file.
+readTextDeviceNonBlocking :: Handle__ -> CharBuffer -> IO CharBuffer
+readTextDeviceNonBlocking h_@Handle__{..} cbuf = do
+  --
+  bbuf0 <- readIORef haByteBuffer
+  when (isEmptyBuffer bbuf0) $ do
+     (r,bbuf1) <- Buffered.fillReadBuffer0 haDevice bbuf0
+     if isNothing r then ioe_EOF else do  -- raise EOF
+     writeIORef haByteBuffer bbuf1
+
+  decodeByteBuf h_ cbuf
+
+-- Decode bytes from the byte buffer into the supplied CharBuffer.
+decodeByteBuf :: Handle__ -> CharBuffer -> IO CharBuffer
+decodeByteBuf h_@Handle__{..} cbuf = do
+  --
+  bbuf0 <- readIORef haByteBuffer
+
+  (bbuf2,cbuf') <-
+      case haDecoder of
+          Nothing      -> do
+               writeIORef haLastDecode (error "codec_state", bbuf0)
+               latin1_decode bbuf0 cbuf
+          Just decoder -> do
+               state <- getState decoder
+               writeIORef haLastDecode (state, bbuf0)
+               (streamEncode decoder) bbuf0 cbuf
+
+  writeIORef haByteBuffer bbuf2
+  return cbuf'
+
diff --git a/libraries/base/GHC/IO/Handle/Text.hs b/libraries/base/GHC/IO/Handle/Text.hs
new file mode 100644
index 000000000000..f182e7f3821f
--- /dev/null
+++ b/libraries/base/GHC/IO/Handle/Text.hs
@@ -0,0 +1,1004 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE CPP
+           , NoImplicitPrelude
+           , RecordWildCards
+           , BangPatterns
+           , NondecreasingIndentation
+           , MagicHash
+  #-}
+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
+{-# OPTIONS_GHC -fno-warn-unused-matches #-}
+{-# OPTIONS_HADDOCK hide #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.IO.Text
+-- Copyright   :  (c) The University of Glasgow, 1992-2008
+-- License     :  see libraries/base/LICENSE
+-- 
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  internal
+-- Portability :  non-portable
+--
+-- String I\/O functions
+--
+-----------------------------------------------------------------------------
+
+module GHC.IO.Handle.Text ( 
+        hWaitForInput, hGetChar, hGetLine, hGetContents, hPutChar, hPutStr,
+        commitBuffer',       -- hack, see below
+        hGetBuf, hGetBufSome, hGetBufNonBlocking, hPutBuf, hPutBufNonBlocking,
+        memcpy, hPutStrLn,
+    ) where
+
+import GHC.IO
+import GHC.IO.FD
+import GHC.IO.Buffer
+import qualified GHC.IO.BufferedIO as Buffered
+import GHC.IO.Exception
+import GHC.Exception
+import GHC.IO.Handle.Types
+import GHC.IO.Handle.Internals
+import qualified GHC.IO.Device as IODevice
+import qualified GHC.IO.Device as RawIO
+
+import Foreign
+import Foreign.C
+
+import qualified Control.Exception as Exception
+import Data.Typeable
+import System.IO.Error
+import Data.Maybe
+import Control.Monad
+
+import GHC.IORef
+import GHC.Base
+import GHC.Real
+import GHC.Num
+import GHC.Show
+import GHC.List
+
+-- ---------------------------------------------------------------------------
+-- Simple input operations
+
+-- If hWaitForInput finds anything in the Handle's buffer, it
+-- immediately returns.  If not, it tries to read from the underlying
+-- OS handle. Notice that for buffered Handles connected to terminals
+-- this means waiting until a complete line is available.
+
+-- | Computation 'hWaitForInput' @hdl t@
+-- waits until input is available on handle @hdl@.
+-- It returns 'True' as soon as input is available on @hdl@,
+-- or 'False' if no input is available within @t@ milliseconds.  Note that
+-- 'hWaitForInput' waits until one or more full /characters/ are available,
+-- which means that it needs to do decoding, and hence may fail
+-- with a decoding error.
+--
+-- If @t@ is less than zero, then @hWaitForInput@ waits indefinitely.
+--
+-- This operation may fail with:
+--
+--  * 'isEOFError' if the end of file has been reached.
+--
+--  * a decoding error, if the input begins with an invalid byte sequence
+--    in this Handle's encoding.
+--
+-- NOTE for GHC users: unless you use the @-threaded@ flag,
+-- @hWaitForInput hdl t@ where @t >= 0@ will block all other Haskell
+-- threads for the duration of the call.  It behaves like a
+-- @safe@ foreign call in this respect.
+--
+
+hWaitForInput :: Handle -> Int -> IO Bool
+hWaitForInput h msecs = do
+  wantReadableHandle_ "hWaitForInput" h $ \ handle_@Handle__{..} -> do
+  cbuf <- readIORef haCharBuffer
+
+  if not (isEmptyBuffer cbuf) then return True else do
+
+  if msecs < 0 
+        then do cbuf' <- readTextDevice handle_ cbuf
+                writeIORef haCharBuffer cbuf'
+                return True
+        else do
+               -- there might be bytes in the byte buffer waiting to be decoded
+               cbuf' <- decodeByteBuf handle_ cbuf
+               writeIORef haCharBuffer cbuf'
+
+               if not (isEmptyBuffer cbuf') then return True else do
+
+                r <- IODevice.ready haDevice False{-read-} msecs
+                if r then do -- Call hLookAhead' to throw an EOF
+                             -- exception if appropriate
+                             _ <- hLookAhead_ handle_
+                             return True
+                     else return False
+                -- XXX we should only return when there are full characters
+                -- not when there are only bytes.  That would mean looping
+                -- and re-running IODevice.ready if we don't have any full
+                -- characters; but we don't know how long we've waited
+                -- so far.
+
+-- ---------------------------------------------------------------------------
+-- hGetChar
+
+-- | Computation 'hGetChar' @hdl@ reads a character from the file or
+-- channel managed by @hdl@, blocking until a character is available.
+--
+-- This operation may fail with:
+--
+--  * 'isEOFError' if the end of file has been reached.
+
+hGetChar :: Handle -> IO Char
+hGetChar handle =
+  wantReadableHandle_ "hGetChar" handle $ \handle_@Handle__{..} -> do
+
+  -- buffering mode makes no difference: we just read whatever is available
+  -- from the device (blocking only if there is nothing available), and then
+  -- return the first character.
+  -- See [note Buffered Reading] in GHC.IO.Handle.Types
+  buf0 <- readIORef haCharBuffer
+
+  buf1 <- if isEmptyBuffer buf0
+             then readTextDevice handle_ buf0
+             else return buf0
+
+  (c1,i) <- readCharBuf (bufRaw buf1) (bufL buf1)
+  let buf2 = bufferAdjustL i buf1
+
+  if haInputNL == CRLF && c1 == '\r'
+     then do
+            mbuf3 <- if isEmptyBuffer buf2
+                      then maybeFillReadBuffer handle_ buf2
+                      else return (Just buf2)
+
+            case mbuf3 of
+               -- EOF, so just return the '\r' we have
+               Nothing -> do
+                  writeIORef haCharBuffer buf2
+                  return '\r'
+               Just buf3 -> do
+                  (c2,i2) <- readCharBuf (bufRaw buf2) (bufL buf2)
+                  if c2 == '\n'
+                     then do
+                       writeIORef haCharBuffer (bufferAdjustL i2 buf3)
+                       return '\n'
+                     else do
+                       -- not a \r\n sequence, so just return the \r
+                       writeIORef haCharBuffer buf3
+                       return '\r'
+     else do
+            writeIORef haCharBuffer buf2
+            return c1
+
+-- ---------------------------------------------------------------------------
+-- hGetLine
+
+-- | Computation 'hGetLine' @hdl@ reads a line from the file or
+-- channel managed by @hdl@.
+--
+-- This operation may fail with:
+--
+--  * 'isEOFError' if the end of file is encountered when reading
+--    the /first/ character of the line.
+--
+-- If 'hGetLine' encounters end-of-file at any other point while reading
+-- in a line, it is treated as a line terminator and the (partial)
+-- line is returned.
+
+hGetLine :: Handle -> IO String
+hGetLine h =
+  wantReadableHandle_ "hGetLine" h $ \ handle_ -> do
+     hGetLineBuffered handle_
+
+hGetLineBuffered :: Handle__ -> IO String
+hGetLineBuffered handle_@Handle__{..} = do
+  buf <- readIORef haCharBuffer
+  hGetLineBufferedLoop handle_ buf []
+
+hGetLineBufferedLoop :: Handle__
+                     -> CharBuffer -> [String]
+                     -> IO String
+hGetLineBufferedLoop handle_@Handle__{..}
+        buf@Buffer{ bufL=r0, bufR=w, bufRaw=raw0 } xss =
+  let
+        -- find the end-of-line character, if there is one
+        loop raw r
+           | r == w = return (False, w)
+           | otherwise =  do
+                (c,r') <- readCharBuf raw r
+                if c == '\n'
+                   then return (True, r) -- NB. not r': don't include the '\n'
+                   else loop raw r'
+  in do
+  (eol, off) <- loop raw0 r0
+
+  debugIO ("hGetLineBufferedLoop: r=" ++ show r0 ++ ", w=" ++ show w ++ ", off=" ++ show off)
+
+  (xs,r') <- if haInputNL == CRLF
+                then unpack_nl raw0 r0 off ""
+                else do xs <- unpack raw0 r0 off ""
+                        return (xs,off)
+
+  -- if eol == True, then off is the offset of the '\n'
+  -- otherwise off == w and the buffer is now empty.
+  if eol -- r' == off
+        then do writeIORef haCharBuffer (bufferAdjustL (off+1) buf)
+                return (concat (reverse (xs:xss)))
+        else do
+             let buf1 = bufferAdjustL r' buf
+             maybe_buf <- maybeFillReadBuffer handle_ buf1
+             case maybe_buf of
+                -- Nothing indicates we caught an EOF, and we may have a
+                -- partial line to return.
+                Nothing -> do
+                     -- we reached EOF.  There might be a lone \r left
+                     -- in the buffer, so check for that and
+                     -- append it to the line if necessary.
+                     -- 
+                     let pre = if not (isEmptyBuffer buf1) then "\r" else ""
+                     writeIORef haCharBuffer buf1{ bufL=0, bufR=0 }
+                     let str = concat (reverse (pre:xs:xss))
+                     if not (null str)
+                        then return str
+                        else ioe_EOF
+                Just new_buf ->
+                     hGetLineBufferedLoop handle_ new_buf (xs:xss)
+
+maybeFillReadBuffer :: Handle__ -> CharBuffer -> IO (Maybe CharBuffer)
+maybeFillReadBuffer handle_ buf
+  = Exception.catch
+     (do buf' <- getSomeCharacters handle_ buf
+         return (Just buf')
+     )
+     (\e -> do if isEOFError e
+                  then return Nothing
+                  else ioError e)
+
+-- See GHC.IO.Buffer
+#define CHARBUF_UTF32
+-- #define CHARBUF_UTF16
+
+-- NB. performance-critical code: eyeball the Core.
+unpack :: RawCharBuffer -> Int -> Int -> [Char] -> IO [Char]
+unpack !buf !r !w acc0
+ | r == w    = return acc0
+ | otherwise = 
+  withRawBuffer buf $ \pbuf -> 
+    let
+        unpackRB acc !i
+         | i < r  = return acc
+         | otherwise = do
+              -- Here, we are rather careful to only put an *evaluated* character
+              -- in the output string. Due to pointer tagging, this allows the consumer
+              -- to avoid ping-ponging between the actual consumer code and the thunk code
+#ifdef CHARBUF_UTF16
+              -- reverse-order decoding of UTF-16
+              c2 <- peekElemOff pbuf i
+              if (c2 < 0xdc00 || c2 > 0xdffff)
+                 then unpackRB (unsafeChr (fromIntegral c2) : acc) (i-1)
+                 else do c1 <- peekElemOff pbuf (i-1)
+                         let c = (fromIntegral c1 - 0xd800) * 0x400 +
+                                 (fromIntegral c2 - 0xdc00) + 0x10000
+                         case desurrogatifyRoundtripCharacter (unsafeChr c) of
+                           { C# c# -> unpackRB (C# c# : acc) (i-2) }
+#else
+              c <- peekElemOff pbuf i
+              unpackRB (c : acc) (i-1)
+#endif
+     in
+     unpackRB acc0 (w-1)
+
+-- NB. performance-critical code: eyeball the Core.
+unpack_nl :: RawCharBuffer -> Int -> Int -> [Char] -> IO ([Char],Int)
+unpack_nl !buf !r !w acc0
+ | r == w    =  return (acc0, 0)
+ | otherwise =
+  withRawBuffer buf $ \pbuf ->
+    let
+        unpackRB acc !i
+         | i < r  = return acc
+         | otherwise = do
+              c <- peekElemOff pbuf i
+              if (c == '\n' && i > r)
+                 then do
+                         c1 <- peekElemOff pbuf (i-1)
+                         if (c1 == '\r')
+                            then unpackRB ('\n':acc) (i-2)
+                            else unpackRB ('\n':acc) (i-1)
+                 else do
+                         unpackRB (c : acc) (i-1)
+     in do
+     c <- peekElemOff pbuf (w-1)
+     if (c == '\r')
+        then do 
+                -- If the last char is a '\r', we need to know whether or
+                -- not it is followed by a '\n', so leave it in the buffer
+                -- for now and just unpack the rest.
+                str <- unpackRB acc0 (w-2)
+                return (str, w-1)
+        else do
+                str <- unpackRB acc0 (w-1)
+                return (str, w)
+
+-- Note [#5536]
+--
+-- We originally had
+--
+--    let c' = desurrogatifyRoundtripCharacter c in
+--    c' `seq` unpackRB (c':acc) (i-1)
+--
+-- but this resulted in Core like
+--
+--    case (case x <# y of True -> C# e1; False -> C# e2) of c
+--      C# _ -> unpackRB (c:acc) (i-1)
+--
+-- which compiles into a continuation for the outer case, with each
+-- branch of the inner case building a C# and then jumping to the
+-- continuation.  We'd rather not have this extra jump, which makes
+-- quite a difference to performance (see #5536) It turns out that
+-- matching on the C# directly causes GHC to do the case-of-case,
+-- giving much straighter code.
+
+-- -----------------------------------------------------------------------------
+-- hGetContents
+
+-- hGetContents on a DuplexHandle only affects the read side: you can
+-- carry on writing to it afterwards.
+
+-- | Computation 'hGetContents' @hdl@ returns the list of characters
+-- corresponding to the unread portion of the channel or file managed
+-- by @hdl@, which is put into an intermediate state, /semi-closed/.
+-- In this state, @hdl@ is effectively closed,
+-- but items are read from @hdl@ on demand and accumulated in a special
+-- list returned by 'hGetContents' @hdl@.
+--
+-- Any operation that fails because a handle is closed,
+-- also fails if a handle is semi-closed.  The only exception is 'hClose'.
+-- A semi-closed handle becomes closed:
+--
+--  * if 'hClose' is applied to it;
+--
+--  * if an I\/O error occurs when reading an item from the handle;
+--
+--  * or once the entire contents of the handle has been read.
+--
+-- Once a semi-closed handle becomes closed, the contents of the
+-- associated list becomes fixed.  The contents of this final list is
+-- only partially specified: it will contain at least all the items of
+-- the stream that were evaluated prior to the handle becoming closed.
+--
+-- Any I\/O errors encountered while a handle is semi-closed are simply
+-- discarded.
+--
+-- This operation may fail with:
+--
+--  * 'isEOFError' if the end of file has been reached.
+
+hGetContents :: Handle -> IO String
+hGetContents handle = 
+   wantReadableHandle "hGetContents" handle $ \handle_ -> do
+      xs <- lazyRead handle
+      return (handle_{ haType=SemiClosedHandle}, xs )
+
+-- Note that someone may close the semi-closed handle (or change its
+-- buffering), so each time these lazy read functions are pulled on,
+-- they have to check whether the handle has indeed been closed.
+
+lazyRead :: Handle -> IO String
+lazyRead handle = 
+   unsafeInterleaveIO $
+        withHandle "hGetContents" handle $ \ handle_ -> do
+        case haType handle_ of
+          ClosedHandle     -> return (handle_, "")
+          SemiClosedHandle -> lazyReadBuffered handle handle_
+          _ -> ioException 
+                  (IOError (Just handle) IllegalOperation "hGetContents"
+                        "illegal handle type" Nothing Nothing)
+
+lazyReadBuffered :: Handle -> Handle__ -> IO (Handle__, [Char])
+lazyReadBuffered h handle_@Handle__{..} = do
+   buf <- readIORef haCharBuffer
+   Exception.catch
+        (do
+            buf'@Buffer{..} <- getSomeCharacters handle_ buf
+            lazy_rest <- lazyRead h
+            (s,r) <- if haInputNL == CRLF
+                         then unpack_nl bufRaw bufL bufR lazy_rest
+                         else do s <- unpack bufRaw bufL bufR lazy_rest
+                                 return (s,bufR)
+            writeIORef haCharBuffer (bufferAdjustL r buf')
+            return (handle_, s)
+        )
+        (\e -> do (handle_', _) <- hClose_help handle_
+                  debugIO ("hGetContents caught: " ++ show e)
+                  -- We might have a \r cached in CRLF mode.  So we
+                  -- need to check for that and return it:
+                  let r = if isEOFError e
+                             then if not (isEmptyBuffer buf)
+                                     then "\r"
+                                     else ""
+                             else
+                                  throw (augmentIOError e "hGetContents" h)
+
+                  return (handle_', r)
+        )
+
+-- ensure we have some characters in the buffer
+getSomeCharacters :: Handle__ -> CharBuffer -> IO CharBuffer
+getSomeCharacters handle_@Handle__{..} buf@Buffer{..} =
+  case bufferElems buf of
+
+    -- buffer empty: read some more
+    0 -> readTextDevice handle_ buf
+
+    -- if the buffer has a single '\r' in it and we're doing newline
+    -- translation: read some more
+    1 | haInputNL == CRLF -> do
+      (c,_) <- readCharBuf bufRaw bufL
+      if c == '\r'
+         then do -- shuffle the '\r' to the beginning.  This is only safe
+                 -- if we're about to call readTextDevice, otherwise it
+                 -- would mess up flushCharBuffer.
+                 -- See [note Buffer Flushing], GHC.IO.Handle.Types
+                 _ <- writeCharBuf bufRaw 0 '\r'
+                 let buf' = buf{ bufL=0, bufR=1 }
+                 readTextDevice handle_ buf'
+         else do
+                 return buf
+
+    -- buffer has some chars in it already: just return it
+    _otherwise ->
+      return buf
+
+-- ---------------------------------------------------------------------------
+-- hPutChar
+
+-- | Computation 'hPutChar' @hdl ch@ writes the character @ch@ to the
+-- file or channel managed by @hdl@.  Characters may be buffered if
+-- buffering is enabled for @hdl@.
+--
+-- This operation may fail with:
+--
+--  * 'isFullError' if the device is full; or
+--
+--  * 'isPermissionError' if another system resource limit would be exceeded.
+
+hPutChar :: Handle -> Char -> IO ()
+hPutChar handle c = do
+    c `seq` return ()
+    wantWritableHandle "hPutChar" handle $ \ handle_  -> do
+     hPutcBuffered handle_ c
+
+hPutcBuffered :: Handle__ -> Char -> IO ()
+hPutcBuffered handle_@Handle__{..} c = do
+  buf <- readIORef haCharBuffer
+  if c == '\n'
+     then do buf1 <- if haOutputNL == CRLF
+                        then do
+                          buf1 <- putc buf '\r'
+                          putc buf1 '\n'
+                        else do
+                          putc buf '\n'
+             writeCharBuffer handle_ buf1
+             when is_line $ flushByteWriteBuffer handle_
+      else do
+          buf1 <- putc buf c
+          writeCharBuffer handle_ buf1
+          return ()
+  where
+    is_line = case haBufferMode of
+                LineBuffering -> True
+                _             -> False
+
+    putc buf@Buffer{ bufRaw=raw, bufR=w } c = do
+       debugIO ("putc: " ++ summaryBuffer buf)
+       w'  <- writeCharBuf raw w c
+       return buf{ bufR = w' }
+
+-- ---------------------------------------------------------------------------
+-- hPutStr
+
+-- We go to some trouble to avoid keeping the handle locked while we're
+-- evaluating the string argument to hPutStr, in case doing so triggers another
+-- I/O operation on the same handle which would lead to deadlock.  The classic
+-- case is
+--
+--              putStr (trace "hello" "world")
+--
+-- so the basic scheme is this:
+--
+--      * copy the string into a fresh buffer,
+--      * "commit" the buffer to the handle.
+--
+-- Committing may involve simply copying the contents of the new
+-- buffer into the handle's buffer, flushing one or both buffers, or
+-- maybe just swapping the buffers over (if the handle's buffer was
+-- empty).  See commitBuffer below.
+
+-- | Computation 'hPutStr' @hdl s@ writes the string
+-- @s@ to the file or channel managed by @hdl@.
+--
+-- This operation may fail with:
+--
+--  * 'isFullError' if the device is full; or
+--
+--  * 'isPermissionError' if another system resource limit would be exceeded.
+
+hPutStr :: Handle -> String -> IO ()
+hPutStr handle str = hPutStr' handle str False
+
+-- | The same as 'hPutStr', but adds a newline character.
+hPutStrLn :: Handle -> String -> IO ()
+hPutStrLn handle str = hPutStr' handle str True
+  -- An optimisation: we treat hPutStrLn specially, to avoid the
+  -- overhead of a single putChar '\n', which is quite high now that we
+  -- have to encode eagerly.
+
+hPutStr' :: Handle -> String -> Bool -> IO ()
+hPutStr' handle str add_nl =
+  do
+    (buffer_mode, nl) <-
+         wantWritableHandle "hPutStr" handle $ \h_ -> do
+                       bmode <- getSpareBuffer h_
+                       return (bmode, haOutputNL h_)
+
+    case buffer_mode of
+       (NoBuffering, _) -> do
+            hPutChars handle str        -- v. slow, but we don't care
+            when add_nl $ hPutChar handle '\n'
+       (LineBuffering, buf) -> do
+            writeBlocks handle True  add_nl nl buf str
+       (BlockBuffering _, buf) -> do
+            writeBlocks handle False add_nl nl buf str
+
+hPutChars :: Handle -> [Char] -> IO ()
+hPutChars _      [] = return ()
+hPutChars handle (c:cs) = hPutChar handle c >> hPutChars handle cs
+
+getSpareBuffer :: Handle__ -> IO (BufferMode, CharBuffer)
+getSpareBuffer Handle__{haCharBuffer=ref, 
+                        haBuffers=spare_ref,
+                        haBufferMode=mode}
+ = do
+   case mode of
+     NoBuffering -> return (mode, error "no buffer!")
+     _ -> do
+          bufs <- readIORef spare_ref
+          buf  <- readIORef ref
+          case bufs of
+            BufferListCons b rest -> do
+                writeIORef spare_ref rest
+                return ( mode, emptyBuffer b (bufSize buf) WriteBuffer)
+            BufferListNil -> do
+                new_buf <- newCharBuffer (bufSize buf) WriteBuffer
+                return (mode, new_buf)
+
+
+-- NB. performance-critical code: eyeball the Core.
+writeBlocks :: Handle -> Bool -> Bool -> Newline -> Buffer CharBufElem -> String -> IO ()
+writeBlocks hdl line_buffered add_nl nl
+            buf@Buffer{ bufRaw=raw, bufSize=len } s =
+  let
+   shoveString :: Int -> [Char] -> [Char] -> IO ()
+   shoveString !n [] [] = do
+        commitBuffer hdl raw len n False{-no flush-} True{-release-}
+   shoveString !n [] rest = do
+        shoveString n rest []
+   shoveString !n (c:cs) rest
+     -- n+1 so we have enough room to write '\r\n' if necessary
+     | n + 1 >= len = do
+        commitBuffer hdl raw len n False{-flush-} False
+        shoveString 0 (c:cs) rest
+     | c == '\n'  =  do
+        n' <- if nl == CRLF
+                 then do 
+                    n1 <- writeCharBuf raw n  '\r'
+                    writeCharBuf raw n1 '\n'
+                 else do
+                    writeCharBuf raw n c
+        if line_buffered
+           then do
+                -- end of line, so write and flush
+               commitBuffer hdl raw len n' True{-flush-} False
+               shoveString 0 cs rest
+           else do
+               shoveString n' cs rest
+     | otherwise = do
+        n' <- writeCharBuf raw n c
+        shoveString n' cs rest
+  in
+  shoveString 0 s (if add_nl then "\n" else "")
+
+-- -----------------------------------------------------------------------------
+-- commitBuffer handle buf sz count flush release
+-- 
+-- Write the contents of the buffer 'buf' ('sz' bytes long, containing
+-- 'count' bytes of data) to handle (handle must be block or line buffered).
+
+commitBuffer
+        :: Handle                       -- handle to commit to
+        -> RawCharBuffer -> Int         -- address and size (in bytes) of buffer
+        -> Int                          -- number of bytes of data in buffer
+        -> Bool                         -- True <=> flush the handle afterward
+        -> Bool                         -- release the buffer?
+        -> IO ()
+
+commitBuffer hdl !raw !sz !count flush release = 
+  wantWritableHandle "commitBuffer" hdl $ \h_@Handle__{..} -> do
+      debugIO ("commitBuffer: sz=" ++ show sz ++ ", count=" ++ show count
+            ++ ", flush=" ++ show flush ++ ", release=" ++ show release)
+
+      writeCharBuffer h_ Buffer{ bufRaw=raw, bufState=WriteBuffer,
+                                 bufL=0, bufR=count, bufSize=sz }
+
+      when flush $ flushByteWriteBuffer h_
+
+      -- release the buffer if necessary
+      when release $ do
+          -- find size of current buffer
+          old_buf@Buffer{ bufSize=size } <- readIORef haCharBuffer
+          when (sz == size) $ do
+               spare_bufs <- readIORef haBuffers
+               writeIORef haBuffers (BufferListCons raw spare_bufs)
+
+      return ()
+
+-- backwards compatibility; the text package uses this
+commitBuffer' :: RawCharBuffer -> Int -> Int -> Bool -> Bool -> Handle__
+              -> IO CharBuffer
+commitBuffer' raw sz@(I# _) count@(I# _) flush release h_@Handle__{..}
+   = do
+      debugIO ("commitBuffer: sz=" ++ show sz ++ ", count=" ++ show count
+            ++ ", flush=" ++ show flush ++ ", release=" ++ show release)
+
+      let this_buf = Buffer{ bufRaw=raw, bufState=WriteBuffer,
+                             bufL=0, bufR=count, bufSize=sz }
+
+      writeCharBuffer h_ this_buf
+
+      when flush $ flushByteWriteBuffer h_
+
+      -- release the buffer if necessary
+      when release $ do
+          -- find size of current buffer
+          old_buf@Buffer{ bufSize=size } <- readIORef haCharBuffer
+          when (sz == size) $ do
+               spare_bufs <- readIORef haBuffers
+               writeIORef haBuffers (BufferListCons raw spare_bufs)
+
+      return this_buf
+
+-- ---------------------------------------------------------------------------
+-- Reading/writing sequences of bytes.
+
+-- ---------------------------------------------------------------------------
+-- hPutBuf
+
+-- | 'hPutBuf' @hdl buf count@ writes @count@ 8-bit bytes from the
+-- buffer @buf@ to the handle @hdl@.  It returns ().
+--
+-- 'hPutBuf' ignores any text encoding that applies to the 'Handle',
+-- writing the bytes directly to the underlying file or device.
+--
+-- 'hPutBuf' ignores the prevailing 'TextEncoding' and
+-- 'NewlineMode' on the 'Handle', and writes bytes directly.
+--
+-- This operation may fail with:
+--
+--  * 'ResourceVanished' if the handle is a pipe or socket, and the
+--    reading end is closed.  (If this is a POSIX system, and the program
+--    has not asked to ignore SIGPIPE, then a SIGPIPE may be delivered
+--    instead, whose default action is to terminate the program).
+
+hPutBuf :: Handle                       -- handle to write to
+        -> Ptr a                        -- address of buffer
+        -> Int                          -- number of bytes of data in buffer
+        -> IO ()
+hPutBuf h ptr count = do _ <- hPutBuf' h ptr count True
+                         return ()
+
+hPutBufNonBlocking
+        :: Handle                       -- handle to write to
+        -> Ptr a                        -- address of buffer
+        -> Int                          -- number of bytes of data in buffer
+        -> IO Int                       -- returns: number of bytes written
+hPutBufNonBlocking h ptr count = hPutBuf' h ptr count False
+
+hPutBuf':: Handle                       -- handle to write to
+        -> Ptr a                        -- address of buffer
+        -> Int                          -- number of bytes of data in buffer
+        -> Bool                         -- allow blocking?
+        -> IO Int
+hPutBuf' handle ptr count can_block
+  | count == 0 = return 0
+  | count <  0 = illegalBufferSize handle "hPutBuf" count
+  | otherwise = 
+    wantWritableHandle "hPutBuf" handle $ 
+      \ h_@Handle__{..} -> do
+          debugIO ("hPutBuf count=" ++ show count)
+
+          r <- bufWrite h_ (castPtr ptr) count can_block
+
+          -- we must flush if this Handle is set to NoBuffering.  If
+          -- it is set to LineBuffering, be conservative and flush
+          -- anyway (we didn't check for newlines in the data).
+          case haBufferMode of
+             BlockBuffering _      -> do return ()
+             _line_or_no_buffering -> do flushWriteBuffer h_
+          return r
+
+bufWrite :: Handle__-> Ptr Word8 -> Int -> Bool -> IO Int
+bufWrite h_@Handle__{..} ptr count can_block =
+  seq count $ do  -- strictness hack
+  old_buf@Buffer{ bufRaw=old_raw, bufR=w, bufSize=size }
+     <- readIORef haByteBuffer
+
+  -- enough room in handle buffer?
+  if (size - w > count)
+        -- There's enough room in the buffer:
+        -- just copy the data in and update bufR.
+        then do debugIO ("hPutBuf: copying to buffer, w=" ++ show w)
+                copyToRawBuffer old_raw w ptr count
+                writeIORef haByteBuffer old_buf{ bufR = w + count }
+                return count
+
+        -- else, we have to flush
+        else do debugIO "hPutBuf: flushing first"
+                old_buf' <- Buffered.flushWriteBuffer haDevice old_buf
+                        -- TODO: we should do a non-blocking flush here
+                writeIORef haByteBuffer old_buf'
+                -- if we can fit in the buffer, then just loop  
+                if count < size
+                   then bufWrite h_ ptr count can_block
+                   else if can_block
+                           then do writeChunk h_ (castPtr ptr) count
+                                   return count
+                           else writeChunkNonBlocking h_ (castPtr ptr) count
+
+writeChunk :: Handle__ -> Ptr Word8 -> Int -> IO ()
+writeChunk h_@Handle__{..} ptr bytes
+  | Just fd <- cast haDevice  =  RawIO.write (fd::FD) ptr bytes
+  | otherwise = error "Todo: hPutBuf"
+
+writeChunkNonBlocking :: Handle__ -> Ptr Word8 -> Int -> IO Int
+writeChunkNonBlocking h_@Handle__{..} ptr bytes 
+  | Just fd <- cast haDevice  =  RawIO.writeNonBlocking (fd::FD) ptr bytes
+  | otherwise = error "Todo: hPutBuf"
+
+-- ---------------------------------------------------------------------------
+-- hGetBuf
+
+-- | 'hGetBuf' @hdl buf count@ reads data from the handle @hdl@
+-- into the buffer @buf@ until either EOF is reached or
+-- @count@ 8-bit bytes have been read.
+-- It returns the number of bytes actually read.  This may be zero if
+-- EOF was reached before any data was read (or if @count@ is zero).
+--
+-- 'hGetBuf' never raises an EOF exception, instead it returns a value
+-- smaller than @count@.
+--
+-- If the handle is a pipe or socket, and the writing end
+-- is closed, 'hGetBuf' will behave as if EOF was reached.
+--
+-- 'hGetBuf' ignores the prevailing 'TextEncoding' and 'NewlineMode'
+-- on the 'Handle', and reads bytes directly.
+
+hGetBuf :: Handle -> Ptr a -> Int -> IO Int
+hGetBuf h ptr count
+  | count == 0 = return 0
+  | count <  0 = illegalBufferSize h "hGetBuf" count
+  | otherwise = 
+      wantReadableHandle_ "hGetBuf" h $ \ h_@Handle__{..} -> do
+         flushCharReadBuffer h_
+         buf@Buffer{ bufRaw=raw, bufR=w, bufL=r, bufSize=sz }
+            <- readIORef haByteBuffer
+         if isEmptyBuffer buf
+            then bufReadEmpty    h_ buf (castPtr ptr) 0 count
+            else bufReadNonEmpty h_ buf (castPtr ptr) 0 count
+
+-- small reads go through the buffer, large reads are satisfied by
+-- taking data first from the buffer and then direct from the file
+-- descriptor.
+
+bufReadNonEmpty :: Handle__ -> Buffer Word8 -> Ptr Word8 -> Int -> Int -> IO Int
+bufReadNonEmpty h_@Handle__{..}
+                buf@Buffer{ bufRaw=raw, bufR=w, bufL=r, bufSize=sz }
+                ptr !so_far !count 
+ = do
+        let avail = w - r
+        if (count < avail)
+           then do 
+                copyFromRawBuffer ptr raw r count
+                writeIORef haByteBuffer buf{ bufL = r + count }
+                return (so_far + count)
+           else do
+  
+        copyFromRawBuffer ptr raw r avail
+        let buf' = buf{ bufR=0, bufL=0 }
+        writeIORef haByteBuffer buf'
+        let remaining = count - avail
+            so_far' = so_far + avail
+            ptr' = ptr `plusPtr` avail
+
+        if remaining == 0 
+           then return so_far'
+           else bufReadEmpty h_ buf' ptr' so_far' remaining
+
+
+bufReadEmpty :: Handle__ -> Buffer Word8 -> Ptr Word8 -> Int -> Int -> IO Int
+bufReadEmpty h_@Handle__{..}
+             buf@Buffer{ bufRaw=raw, bufR=w, bufL=r, bufSize=sz }
+             ptr so_far count
+ | count > sz, Just fd <- cast haDevice = loop fd 0 count
+ | otherwise = do
+     (r,buf') <- Buffered.fillReadBuffer haDevice buf
+     if r == 0 
+        then return so_far
+        else do writeIORef haByteBuffer buf'
+                bufReadNonEmpty h_ buf' ptr so_far count
+ where
+  loop :: FD -> Int -> Int -> IO Int
+  loop fd off bytes | bytes <= 0 = return (so_far + off)
+  loop fd off bytes = do
+    r <- RawIO.read (fd::FD) (ptr `plusPtr` off) bytes
+    if r == 0
+        then return (so_far + off)
+        else loop fd (off + r) (bytes - r)
+
+-- ---------------------------------------------------------------------------
+-- hGetBufSome
+
+-- | 'hGetBufSome' @hdl buf count@ reads data from the handle @hdl@
+-- into the buffer @buf@.  If there is any data available to read,
+-- then 'hGetBufSome' returns it immediately; it only blocks if there
+-- is no data to be read.
+--
+-- It returns the number of bytes actually read.  This may be zero if
+-- EOF was reached before any data was read (or if @count@ is zero).
+--
+-- 'hGetBufSome' never raises an EOF exception, instead it returns a value
+-- smaller than @count@.
+--
+-- If the handle is a pipe or socket, and the writing end
+-- is closed, 'hGetBufSome' will behave as if EOF was reached.
+--
+-- 'hGetBufSome' ignores the prevailing 'TextEncoding' and 'NewlineMode'
+-- on the 'Handle', and reads bytes directly.
+
+hGetBufSome :: Handle -> Ptr a -> Int -> IO Int
+hGetBufSome h ptr count
+  | count == 0 = return 0
+  | count <  0 = illegalBufferSize h "hGetBufSome" count
+  | otherwise =
+      wantReadableHandle_ "hGetBufSome" h $ \ h_@Handle__{..} -> do
+         flushCharReadBuffer h_
+         buf@Buffer{ bufSize=sz } <- readIORef haByteBuffer
+         if isEmptyBuffer buf
+            then case count > sz of  -- large read? optimize it with a little special case:
+                    True | Just fd <- haFD h_ -> do RawIO.read fd (castPtr ptr) count
+                    _ -> do (r,buf') <- Buffered.fillReadBuffer haDevice buf
+                            if r == 0
+                               then return 0
+                               else do writeIORef haByteBuffer buf'
+                                       bufReadNBNonEmpty h_ buf' (castPtr ptr) 0 (min r count)
+                                        -- new count is  (min r count), so
+                                        -- that bufReadNBNonEmpty will not
+                                        -- issue another read.
+            else
+              let count' = min count (bufferElems buf)
+              in bufReadNBNonEmpty h_ buf (castPtr ptr) 0 count'
+
+haFD :: Handle__ -> Maybe FD
+haFD h_@Handle__{..} = cast haDevice
+
+-- | 'hGetBufNonBlocking' @hdl buf count@ reads data from the handle @hdl@
+-- into the buffer @buf@ until either EOF is reached, or
+-- @count@ 8-bit bytes have been read, or there is no more data available
+-- to read immediately.
+--
+-- 'hGetBufNonBlocking' is identical to 'hGetBuf', except that it will
+-- never block waiting for data to become available, instead it returns
+-- only whatever data is available.  To wait for data to arrive before
+-- calling 'hGetBufNonBlocking', use 'hWaitForInput'.
+--
+-- If the handle is a pipe or socket, and the writing end
+-- is closed, 'hGetBufNonBlocking' will behave as if EOF was reached.
+--
+-- 'hGetBufNonBlocking' ignores the prevailing 'TextEncoding' and
+-- 'NewlineMode' on the 'Handle', and reads bytes directly.
+--
+-- NOTE: on Windows, this function does not work correctly; it
+-- behaves identically to 'hGetBuf'.
+
+hGetBufNonBlocking :: Handle -> Ptr a -> Int -> IO Int
+hGetBufNonBlocking h ptr count
+  | count == 0 = return 0
+  | count <  0 = illegalBufferSize h "hGetBufNonBlocking" count
+  | otherwise = 
+      wantReadableHandle_ "hGetBufNonBlocking" h $ \ h_@Handle__{..} -> do
+         flushCharReadBuffer h_
+         buf@Buffer{ bufRaw=raw, bufR=w, bufL=r, bufSize=sz }
+            <- readIORef haByteBuffer
+         if isEmptyBuffer buf
+            then bufReadNBEmpty    h_ buf (castPtr ptr) 0 count
+            else bufReadNBNonEmpty h_ buf (castPtr ptr) 0 count
+
+bufReadNBEmpty :: Handle__ -> Buffer Word8 -> Ptr Word8 -> Int -> Int -> IO Int
+bufReadNBEmpty   h_@Handle__{..}
+                 buf@Buffer{ bufRaw=raw, bufR=w, bufL=r, bufSize=sz }
+                 ptr so_far count
+  | count > sz,
+    Just fd <- cast haDevice = do
+       m <- RawIO.readNonBlocking (fd::FD) ptr count
+       case m of
+         Nothing -> return so_far
+         Just n  -> return (so_far + n)
+
+ | otherwise = do
+     buf <- readIORef haByteBuffer
+     (r,buf') <- Buffered.fillReadBuffer0 haDevice buf
+     case r of
+       Nothing -> return so_far
+       Just 0  -> return so_far
+       Just r  -> do
+         writeIORef haByteBuffer buf'
+         bufReadNBNonEmpty h_ buf' ptr so_far (min count r)
+                          -- NOTE: new count is    min count r
+                          -- so we will just copy the contents of the
+                          -- buffer in the recursive call, and not
+                          -- loop again.
+
+
+bufReadNBNonEmpty :: Handle__ -> Buffer Word8 -> Ptr Word8 -> Int -> Int -> IO Int
+bufReadNBNonEmpty h_@Handle__{..}
+                  buf@Buffer{ bufRaw=raw, bufR=w, bufL=r, bufSize=sz }
+                  ptr so_far count
+  = do
+        let avail = w - r
+        if (count < avail)
+           then do 
+                copyFromRawBuffer ptr raw r count
+                writeIORef haByteBuffer buf{ bufL = r + count }
+                return (so_far + count)
+           else do
+
+        copyFromRawBuffer ptr raw r avail
+        let buf' = buf{ bufR=0, bufL=0 }
+        writeIORef haByteBuffer buf'
+        let remaining = count - avail
+            so_far' = so_far + avail
+            ptr' = ptr `plusPtr` avail
+
+        if remaining == 0
+           then return so_far'
+           else bufReadNBEmpty h_ buf' ptr' so_far' remaining
+
+-- ---------------------------------------------------------------------------
+-- memcpy wrappers
+
+copyToRawBuffer :: RawBuffer e -> Int -> Ptr e -> Int -> IO ()
+copyToRawBuffer raw off ptr bytes =
+ withRawBuffer raw $ \praw ->
+   do _ <- memcpy (praw `plusPtr` off) ptr (fromIntegral bytes)
+      return ()
+
+copyFromRawBuffer :: Ptr e -> RawBuffer e -> Int -> Int -> IO ()
+copyFromRawBuffer ptr raw off bytes =
+ withRawBuffer raw $ \praw ->
+   do _ <- memcpy ptr (praw `plusPtr` off) (fromIntegral bytes)
+      return ()
+
+foreign import ccall unsafe "memcpy"
+   memcpy :: Ptr a -> Ptr a -> CSize -> IO (Ptr ())
+
+-----------------------------------------------------------------------------
+-- Internal Utils
+
+illegalBufferSize :: Handle -> String -> Int -> IO a
+illegalBufferSize handle fn sz =
+        ioException (IOError (Just handle)
+                            InvalidArgument  fn
+                            ("illegal buffer size " ++ showsPrec 9 sz [])
+                            Nothing Nothing)
+
diff --git a/libraries/base/GHC/IO/Handle/Types.hs b/libraries/base/GHC/IO/Handle/Types.hs
new file mode 100644
index 000000000000..defa33bbca2c
--- /dev/null
+++ b/libraries/base/GHC/IO/Handle/Types.hs
@@ -0,0 +1,431 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE CPP
+           , NoImplicitPrelude
+           , ExistentialQuantification
+           , AutoDeriveTypeable
+  #-}
+{-# OPTIONS_GHC -funbox-strict-fields #-}
+{-# OPTIONS_HADDOCK hide #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.IO.Handle.Types
+-- Copyright   :  (c) The University of Glasgow, 1994-2009
+-- License     :  see libraries/base/LICENSE
+-- 
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  internal
+-- Portability :  non-portable
+--
+-- Basic types for the implementation of IO Handles.
+--
+-----------------------------------------------------------------------------
+
+module GHC.IO.Handle.Types (
+      Handle(..), Handle__(..), showHandle,
+      checkHandleInvariants,
+      BufferList(..),
+      HandleType(..),
+      isReadableHandleType, isWritableHandleType, isReadWriteHandleType,
+      BufferMode(..),
+      BufferCodec(..),
+      NewlineMode(..), Newline(..), nativeNewline,
+      universalNewlineMode, noNewlineTranslation, nativeNewlineMode
+  ) where
+
+#undef DEBUG
+
+import GHC.Base
+import GHC.MVar
+import GHC.IO
+import GHC.IO.Buffer
+import GHC.IO.BufferedIO
+import GHC.IO.Encoding.Types
+import GHC.IORef
+import Data.Maybe
+import GHC.Show
+import GHC.Read
+import GHC.Word
+import GHC.IO.Device
+import Data.Typeable
+#ifdef DEBUG
+import Control.Monad
+#endif
+
+-- ---------------------------------------------------------------------------
+-- Handle type
+
+--  A Handle is represented by (a reference to) a record 
+--  containing the state of the I/O port/device. We record
+--  the following pieces of info:
+
+--    * type (read,write,closed etc.)
+--    * the underlying file descriptor
+--    * buffering mode 
+--    * buffer, and spare buffers
+--    * user-friendly name (usually the
+--      FilePath used when IO.openFile was called)
+
+-- Note: when a Handle is garbage collected, we want to flush its buffer
+-- and close the OS file handle, so as to free up a (precious) resource.
+
+-- | Haskell defines operations to read and write characters from and to files,
+-- represented by values of type @Handle@.  Each value of this type is a
+-- /handle/: a record used by the Haskell run-time system to /manage/ I\/O
+-- with file system objects.  A handle has at least the following properties:
+-- 
+--  * whether it manages input or output or both;
+--
+--  * whether it is /open/, /closed/ or /semi-closed/;
+--
+--  * whether the object is seekable;
+--
+--  * whether buffering is disabled, or enabled on a line or block basis;
+--
+--  * a buffer (whose length may be zero).
+--
+-- Most handles will also have a current I\/O position indicating where the next
+-- input or output operation will occur.  A handle is /readable/ if it
+-- manages only input or both input and output; likewise, it is /writable/ if
+-- it manages only output or both input and output.  A handle is /open/ when
+-- first allocated.
+-- Once it is closed it can no longer be used for either input or output,
+-- though an implementation cannot re-use its storage while references
+-- remain to it.  Handles are in the 'Show' and 'Eq' classes.  The string
+-- produced by showing a handle is system dependent; it should include
+-- enough information to identify the handle for debugging.  A handle is
+-- equal according to '==' only to itself; no attempt
+-- is made to compare the internal state of different handles for equality.
+
+data Handle 
+  = FileHandle                          -- A normal handle to a file
+        FilePath                        -- the file (used for error messages
+                                        -- only)
+        !(MVar Handle__)
+
+  | DuplexHandle                        -- A handle to a read/write stream
+        FilePath                        -- file for a FIFO, otherwise some
+                                        --   descriptive string (used for error
+                                        --   messages only)
+        !(MVar Handle__)                -- The read side
+        !(MVar Handle__)                -- The write side
+
+  deriving Typeable
+
+-- NOTES:
+--    * A 'FileHandle' is seekable.  A 'DuplexHandle' may or may not be
+--      seekable.
+
+instance Eq Handle where
+ (FileHandle _ h1)     == (FileHandle _ h2)     = h1 == h2
+ (DuplexHandle _ h1 _) == (DuplexHandle _ h2 _) = h1 == h2
+ _ == _ = False 
+
+data Handle__
+  = forall dev enc_state dec_state . (IODevice dev, BufferedIO dev, Typeable dev) =>
+    Handle__ {
+      haDevice      :: !dev,
+      haType        :: HandleType,           -- type (read/write/append etc.)
+      haByteBuffer  :: !(IORef (Buffer Word8)),
+      haBufferMode  :: BufferMode,
+      haLastDecode  :: !(IORef (dec_state, Buffer Word8)),
+      haCharBuffer  :: !(IORef (Buffer CharBufElem)), -- the current buffer
+      haBuffers     :: !(IORef (BufferList CharBufElem)),  -- spare buffers
+      haEncoder     :: Maybe (TextEncoder enc_state),
+      haDecoder     :: Maybe (TextDecoder dec_state),
+      haCodec       :: Maybe TextEncoding,
+      haInputNL     :: Newline,
+      haOutputNL    :: Newline,
+      haOtherSide   :: Maybe (MVar Handle__) -- ptr to the write side of a 
+                                             -- duplex handle.
+    }
+    deriving Typeable
+
+-- we keep a few spare buffers around in a handle to avoid allocating
+-- a new one for each hPutStr.  These buffers are *guaranteed* to be the
+-- same size as the main buffer.
+data BufferList e
+  = BufferListNil 
+  | BufferListCons (RawBuffer e) (BufferList e)
+
+--  Internally, we classify handles as being one
+--  of the following:
+
+data HandleType
+ = ClosedHandle
+ | SemiClosedHandle
+ | ReadHandle
+ | WriteHandle
+ | AppendHandle
+ | ReadWriteHandle
+
+isReadableHandleType :: HandleType -> Bool
+isReadableHandleType ReadHandle         = True
+isReadableHandleType ReadWriteHandle    = True
+isReadableHandleType _                  = False
+
+isWritableHandleType :: HandleType -> Bool
+isWritableHandleType AppendHandle    = True
+isWritableHandleType WriteHandle     = True
+isWritableHandleType ReadWriteHandle = True
+isWritableHandleType _               = False
+
+isReadWriteHandleType :: HandleType -> Bool
+isReadWriteHandleType ReadWriteHandle{} = True
+isReadWriteHandleType _                 = False
+
+-- INVARIANTS on Handles:
+--
+--   * A handle *always* has a buffer, even if it is only 1 character long
+--     (an unbuffered handle needs a 1 character buffer in order to support
+--      hLookAhead and hIsEOF).
+--   * In a read Handle, the byte buffer is always empty (we decode when reading)
+--   * In a wriite Handle, the Char buffer is always empty (we encode when writing)
+--
+checkHandleInvariants :: Handle__ -> IO ()
+#ifdef DEBUG
+checkHandleInvariants h_ = do
+ bbuf <- readIORef (haByteBuffer h_)
+ checkBuffer bbuf
+ cbuf <- readIORef (haCharBuffer h_)
+ checkBuffer cbuf
+ when (isWriteBuffer cbuf && not (isEmptyBuffer cbuf)) $
+   error ("checkHandleInvariants: char write buffer non-empty: " ++
+          summaryBuffer bbuf ++ ", " ++ summaryBuffer cbuf)
+ when (isWriteBuffer bbuf /= isWriteBuffer cbuf) $
+   error ("checkHandleInvariants: buffer modes differ: " ++
+          summaryBuffer bbuf ++ ", " ++ summaryBuffer cbuf)
+
+#else
+checkHandleInvariants _ = return ()
+#endif
+
+-- ---------------------------------------------------------------------------
+-- Buffering modes
+
+-- | Three kinds of buffering are supported: line-buffering, 
+-- block-buffering or no-buffering.  These modes have the following
+-- effects. For output, items are written out, or /flushed/,
+-- from the internal buffer according to the buffer mode:
+--
+--  * /line-buffering/: the entire output buffer is flushed
+--    whenever a newline is output, the buffer overflows, 
+--    a 'System.IO.hFlush' is issued, or the handle is closed.
+--
+--  * /block-buffering/: the entire buffer is written out whenever it
+--    overflows, a 'System.IO.hFlush' is issued, or the handle is closed.
+--
+--  * /no-buffering/: output is written immediately, and never stored
+--    in the buffer.
+--
+-- An implementation is free to flush the buffer more frequently,
+-- but not less frequently, than specified above.
+-- The output buffer is emptied as soon as it has been written out.
+--
+-- Similarly, input occurs according to the buffer mode for the handle:
+--
+--  * /line-buffering/: when the buffer for the handle is not empty,
+--    the next item is obtained from the buffer; otherwise, when the
+--    buffer is empty, characters up to and including the next newline
+--    character are read into the buffer.  No characters are available
+--    until the newline character is available or the buffer is full.
+--
+--  * /block-buffering/: when the buffer for the handle becomes empty,
+--    the next block of data is read into the buffer.
+--
+--  * /no-buffering/: the next input item is read and returned.
+--    The 'System.IO.hLookAhead' operation implies that even a no-buffered
+--    handle may require a one-character buffer.
+--
+-- The default buffering mode when a handle is opened is
+-- implementation-dependent and may depend on the file system object
+-- which is attached to that handle.
+-- For most implementations, physical files will normally be block-buffered 
+-- and terminals will normally be line-buffered.
+
+data BufferMode  
+ = NoBuffering  -- ^ buffering is disabled if possible.
+ | LineBuffering
+                -- ^ line-buffering should be enabled if possible.
+ | BlockBuffering (Maybe Int)
+                -- ^ block-buffering should be enabled if possible.
+                -- The size of the buffer is @n@ items if the argument
+                -- is 'Just' @n@ and is otherwise implementation-dependent.
+   deriving (Eq, Ord, Read, Show)
+
+{-
+[note Buffering Implementation]
+
+Each Handle has two buffers: a byte buffer (haByteBuffer) and a Char
+buffer (haCharBuffer).  
+
+[note Buffered Reading]
+
+For read Handles, bytes are read into the byte buffer, and immediately
+decoded into the Char buffer (see
+GHC.IO.Handle.Internals.readTextDevice).  The only way there might be
+some data left in the byte buffer is if there is a partial multi-byte
+character sequence that cannot be decoded into a full character.
+
+Note that the buffering mode (haBufferMode) makes no difference when
+reading data into a Handle.  When reading, we can always just read all
+the data there is available without blocking, decode it into the Char
+buffer, and then provide it immediately to the caller.
+
+[note Buffered Writing]
+
+Characters are written into the Char buffer by e.g. hPutStr.  At the
+end of the operation, or when the char buffer is full, the buffer is
+decoded to the byte buffer (see writeCharBuffer).  This is so that we
+can detect encoding errors at the right point.
+
+Hence, the Char buffer is always empty between Handle operations.
+
+[note Buffer Sizing]
+
+The char buffer is always a default size (dEFAULT_CHAR_BUFFER_SIZE).
+The byte buffer size is chosen by the underlying device (via its
+IODevice.newBuffer).  Hence the size of these buffers is not under
+user control.
+
+There are certain minimum sizes for these buffers imposed by the
+library (but not checked):
+
+ - we must be able to buffer at least one character, so that
+   hLookAhead can work
+
+ - the byte buffer must be able to store at least one encoded
+   character in the current encoding (6 bytes?)
+
+ - when reading, the char buffer must have room for two characters, so
+   that we can spot the \r\n sequence.
+
+How do we implement hSetBuffering?
+
+For reading, we have never used the user-supplied buffer size, because
+there's no point: we always pass all available data to the reader
+immediately.  Buffering would imply waiting until a certain amount of
+data is available, which has no advantages.  So hSetBuffering is
+essentially a no-op for read handles, except that it turns on/off raw
+mode for the underlying device if necessary.
+
+For writing, the buffering mode is handled by the write operations
+themselves (hPutChar and hPutStr).  Every write ends with
+writeCharBuffer, which checks whether the buffer should be flushed
+according to the current buffering mode.  Additionally, we look for
+newlines and flush if the mode is LineBuffering.
+
+[note Buffer Flushing]
+
+** Flushing the Char buffer
+
+We must be able to flush the Char buffer, in order to implement
+hSetEncoding, and things like hGetBuf which want to read raw bytes.
+
+Flushing the Char buffer on a write Handle is easy: it is always empty.
+
+Flushing the Char buffer on a read Handle involves rewinding the byte
+buffer to the point representing the next Char in the Char buffer.
+This is done by
+
+ - remembering the state of the byte buffer *before* the last decode
+
+ - re-decoding the bytes that represent the chars already read from the
+   Char buffer.  This gives us the point in the byte buffer that
+   represents the *next* Char to be read.
+
+In order for this to work, after readTextHandle we must NOT MODIFY THE
+CONTENTS OF THE BYTE OR CHAR BUFFERS, except to remove characters from
+the Char buffer.
+
+** Flushing the byte buffer
+
+The byte buffer can be flushed if the Char buffer has already been
+flushed (see above).  For a read Handle, flushing the byte buffer
+means seeking the device back by the number of bytes in the buffer,
+and hence it is only possible on a seekable Handle.
+
+-}
+
+-- ---------------------------------------------------------------------------
+-- Newline translation
+
+-- | The representation of a newline in the external file or stream.
+data Newline = LF    -- ^ '\n'
+             | CRLF  -- ^ '\r\n'
+             deriving (Eq, Ord, Read, Show)
+
+-- | Specifies the translation, if any, of newline characters between
+-- internal Strings and the external file or stream.  Haskell Strings
+-- are assumed to represent newlines with the '\n' character; the
+-- newline mode specifies how to translate '\n' on output, and what to
+-- translate into '\n' on input.
+data NewlineMode 
+  = NewlineMode { inputNL :: Newline,
+                    -- ^ the representation of newlines on input
+                  outputNL :: Newline
+                    -- ^ the representation of newlines on output
+                 }
+             deriving (Eq, Ord, Read, Show)
+
+-- | The native newline representation for the current platform: 'LF'
+-- on Unix systems, 'CRLF' on Windows.
+nativeNewline :: Newline
+#ifdef mingw32_HOST_OS
+nativeNewline = CRLF
+#else
+nativeNewline = LF
+#endif
+
+-- | Map '\r\n' into '\n' on input, and '\n' to the native newline
+-- represetnation on output.  This mode can be used on any platform, and
+-- works with text files using any newline convention.  The downside is
+-- that @readFile >>= writeFile@ might yield a different file.
+-- 
+-- > universalNewlineMode  = NewlineMode { inputNL  = CRLF, 
+-- >                                       outputNL = nativeNewline }
+--
+universalNewlineMode :: NewlineMode
+universalNewlineMode  = NewlineMode { inputNL  = CRLF, 
+                                      outputNL = nativeNewline }
+
+-- | Use the native newline representation on both input and output
+-- 
+-- > nativeNewlineMode  = NewlineMode { inputNL  = nativeNewline
+-- >                                    outputNL = nativeNewline }
+--
+nativeNewlineMode    :: NewlineMode
+nativeNewlineMode     = NewlineMode { inputNL  = nativeNewline, 
+                                      outputNL = nativeNewline }
+
+-- | Do no newline translation at all.
+-- 
+-- > noNewlineTranslation  = NewlineMode { inputNL  = LF, outputNL = LF }
+--
+noNewlineTranslation :: NewlineMode
+noNewlineTranslation  = NewlineMode { inputNL  = LF, outputNL = LF }
+
+-- ---------------------------------------------------------------------------
+-- Show instance for Handles
+
+-- handle types are 'show'n when printing error msgs, so
+-- we provide a more user-friendly Show instance for it
+-- than the derived one.
+
+instance Show HandleType where
+  showsPrec _ t =
+    case t of
+      ClosedHandle      -> showString "closed"
+      SemiClosedHandle  -> showString "semi-closed"
+      ReadHandle        -> showString "readable"
+      WriteHandle       -> showString "writable"
+      AppendHandle      -> showString "writable (append)"
+      ReadWriteHandle   -> showString "read-writable"
+
+instance Show Handle where 
+  showsPrec _ (FileHandle   file _)   = showHandle file
+  showsPrec _ (DuplexHandle file _ _) = showHandle file
+
+showHandle :: FilePath -> String -> String
+showHandle file = showString "{handle: " . showString file . showString "}"
+
diff --git a/libraries/base/GHC/IO/IOMode.hs b/libraries/base/GHC/IO/IOMode.hs
new file mode 100644
index 000000000000..42cc9f31b1f2
--- /dev/null
+++ b/libraries/base/GHC/IO/IOMode.hs
@@ -0,0 +1,30 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# OPTIONS_HADDOCK hide #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.IO.IOMode
+-- Copyright   :  (c) The University of Glasgow, 1994-2008
+-- License     :  see libraries/base/LICENSE
+-- 
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  internal
+-- Portability :  non-portable
+--
+-- The IOMode type
+--
+-----------------------------------------------------------------------------
+
+module GHC.IO.IOMode (IOMode(..)) where
+
+import GHC.Base
+import GHC.Show
+import GHC.Read
+import GHC.Arr
+import GHC.Enum
+
+-- | See 'System.IO.openFile'
+data IOMode      =  ReadMode | WriteMode | AppendMode | ReadWriteMode
+                    deriving (Eq, Ord, Ix, Enum, Read, Show)
+
diff --git a/libraries/base/GHC/IOArray.hs b/libraries/base/GHC/IOArray.hs
new file mode 100644
index 000000000000..ff9e545817cd
--- /dev/null
+++ b/libraries/base/GHC/IOArray.hs
@@ -0,0 +1,74 @@
+{-# LANGUAGE Unsafe #-}
+{-# LANGUAGE NoImplicitPrelude, AutoDeriveTypeable #-}
+{-# OPTIONS_GHC -funbox-strict-fields #-}
+{-# OPTIONS_HADDOCK hide #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.IOArray
+-- Copyright   :  (c) The University of Glasgow 2008
+-- License     :  see libraries/base/LICENSE
+--
+-- Maintainer  :  cvs-ghc@haskell.org
+-- Stability   :  internal
+-- Portability :  non-portable (GHC Extensions)
+--
+-- The IOArray type
+--
+-----------------------------------------------------------------------------
+
+module GHC.IOArray (
+        IOArray(..),
+        newIOArray, unsafeReadIOArray, unsafeWriteIOArray,
+        readIOArray, writeIOArray,
+        boundsIOArray
+    ) where
+
+import GHC.Base
+import GHC.IO
+import GHC.Arr
+import Data.Typeable.Internal
+
+-- ---------------------------------------------------------------------------
+-- | An 'IOArray' is a mutable, boxed, non-strict array in the 'IO' monad.
+-- The type arguments are as follows:
+--
+--  * @i@: the index type of the array (should be an instance of 'Ix')
+--
+--  * @e@: the element type of the array.
+--
+--
+
+newtype IOArray i e = IOArray (STArray RealWorld i e) deriving( Typeable )
+
+-- explicit instance because Haddock can't figure out a derived one
+instance Eq (IOArray i e) where
+  IOArray x == IOArray y = x == y
+
+-- |Build a new 'IOArray'
+newIOArray :: Ix i => (i,i) -> e -> IO (IOArray i e)
+{-# INLINE newIOArray #-}
+newIOArray lu initial  = stToIO $ do {marr <- newSTArray lu initial; return (IOArray marr)}
+
+-- | Read a value from an 'IOArray'
+unsafeReadIOArray  :: Ix i => IOArray i e -> Int -> IO e
+{-# INLINE unsafeReadIOArray #-}
+unsafeReadIOArray (IOArray marr) i = stToIO (unsafeReadSTArray marr i)
+
+-- | Write a new value into an 'IOArray'
+unsafeWriteIOArray :: Ix i => IOArray i e -> Int -> e -> IO ()
+{-# INLINE unsafeWriteIOArray #-}
+unsafeWriteIOArray (IOArray marr) i e = stToIO (unsafeWriteSTArray marr i e)
+
+-- | Read a value from an 'IOArray'
+readIOArray  :: Ix i => IOArray i e -> i -> IO e
+readIOArray (IOArray marr) i = stToIO (readSTArray marr i)
+
+-- | Write a new value into an 'IOArray'
+writeIOArray :: Ix i => IOArray i e -> i -> e -> IO ()
+writeIOArray (IOArray marr) i e = stToIO (writeSTArray marr i e)
+
+{-# INLINE boundsIOArray #-}
+boundsIOArray :: IOArray i e -> (i,i)
+boundsIOArray (IOArray marr) = boundsSTArray marr
+
diff --git a/libraries/base/GHC/IORef.hs b/libraries/base/GHC/IORef.hs
new file mode 100644
index 000000000000..154c30cd8d86
--- /dev/null
+++ b/libraries/base/GHC/IORef.hs
@@ -0,0 +1,54 @@
+{-# LANGUAGE Unsafe #-}
+{-# LANGUAGE NoImplicitPrelude, MagicHash, AutoDeriveTypeable #-}
+{-# OPTIONS_GHC -funbox-strict-fields #-}
+{-# OPTIONS_HADDOCK hide #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.IORef
+-- Copyright   :  (c) The University of Glasgow 2008
+-- License     :  see libraries/base/LICENSE
+--
+-- Maintainer  :  cvs-ghc@haskell.org
+-- Stability   :  internal
+-- Portability :  non-portable (GHC Extensions)
+--
+-- The IORef type
+--
+-----------------------------------------------------------------------------
+
+module GHC.IORef (
+        IORef(..),
+        newIORef, readIORef, writeIORef, atomicModifyIORef
+    ) where
+
+import GHC.Base
+import GHC.STRef
+import GHC.IO
+import Data.Typeable.Internal( Typeable )
+
+-- ---------------------------------------------------------------------------
+-- IORefs
+
+-- |A mutable variable in the 'IO' monad
+newtype IORef a = IORef (STRef RealWorld a) deriving( Typeable )
+
+-- explicit instance because Haddock can't figure out a derived one
+instance Eq (IORef a) where
+  IORef x == IORef y = x == y
+
+-- |Build a new 'IORef'
+newIORef    :: a -> IO (IORef a)
+newIORef v = stToIO (newSTRef v) >>= \ var -> return (IORef var)
+
+-- |Read the value of an 'IORef'
+readIORef   :: IORef a -> IO a
+readIORef  (IORef var) = stToIO (readSTRef var)
+
+-- |Write a new value into an 'IORef'
+writeIORef  :: IORef a -> a -> IO ()
+writeIORef (IORef var) v = stToIO (writeSTRef var v)
+
+atomicModifyIORef :: IORef a -> (a -> (a,b)) -> IO b
+atomicModifyIORef (IORef (STRef r#)) f = IO $ \s -> atomicModifyMutVar# r# f s
+
diff --git a/libraries/base/GHC/IP.hs b/libraries/base/GHC/IP.hs
new file mode 100644
index 000000000000..95b00c15ffc6
--- /dev/null
+++ b/libraries/base/GHC/IP.hs
@@ -0,0 +1,16 @@
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+
+-- | /Since: 4.6.0.0/
+module GHC.IP (IP(..)) where
+
+import GHC.TypeLits
+
+-- | The syntax @?x :: a@ is desugared into @IP "x" a@
+class IP (x :: Symbol) a | x -> a where
+  ip :: a
+
+
diff --git a/libraries/base/GHC/Int.hs b/libraries/base/GHC/Int.hs
new file mode 100644
index 000000000000..467b3f4e3066
--- /dev/null
+++ b/libraries/base/GHC/Int.hs
@@ -0,0 +1,1010 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE CPP, NoImplicitPrelude, BangPatterns, MagicHash, UnboxedTuples,
+             StandaloneDeriving, AutoDeriveTypeable, NegativeLiterals #-}
+{-# OPTIONS_HADDOCK hide #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.Int
+-- Copyright   :  (c) The University of Glasgow 1997-2002
+-- License     :  see libraries/base/LICENSE
+--
+-- Maintainer  :  cvs-ghc@haskell.org
+-- Stability   :  internal
+-- Portability :  non-portable (GHC Extensions)
+--
+-- The sized integral datatypes, 'Int8', 'Int16', 'Int32', and 'Int64'.
+--
+-----------------------------------------------------------------------------
+
+#include "MachDeps.h"
+
+module GHC.Int (
+        Int8(..), Int16(..), Int32(..), Int64(..),
+        uncheckedIShiftL64#, uncheckedIShiftRA64#
+    ) where
+
+import Data.Bits
+import Data.Maybe
+
+#if WORD_SIZE_IN_BITS < 64
+import GHC.IntWord64
+#endif
+
+import GHC.Base
+import GHC.Enum
+import GHC.Num
+import GHC.Real
+import GHC.Read
+import GHC.Arr
+import GHC.Word hiding (uncheckedShiftL64#, uncheckedShiftRL64#)
+import GHC.Show
+import GHC.Float ()     -- for RealFrac methods
+import Data.Typeable
+
+
+------------------------------------------------------------------------
+-- type Int8
+------------------------------------------------------------------------
+
+-- Int8 is represented in the same way as Int. Operations may assume
+-- and must ensure that it holds only values from its logical range.
+
+data {-# CTYPE "HsInt8" #-} Int8 = I8# Int# deriving (Eq, Ord, Typeable)
+-- ^ 8-bit signed integer type
+
+instance Show Int8 where
+    showsPrec p x = showsPrec p (fromIntegral x :: Int)
+
+instance Num Int8 where
+    (I8# x#) + (I8# y#)    = I8# (narrow8Int# (x# +# y#))
+    (I8# x#) - (I8# y#)    = I8# (narrow8Int# (x# -# y#))
+    (I8# x#) * (I8# y#)    = I8# (narrow8Int# (x# *# y#))
+    negate (I8# x#)        = I8# (narrow8Int# (negateInt# x#))
+    abs x | x >= 0         = x
+          | otherwise      = negate x
+    signum x | x > 0       = 1
+    signum 0               = 0
+    signum _               = -1
+    fromInteger i          = I8# (narrow8Int# (integerToInt i))
+
+instance Real Int8 where
+    toRational x = toInteger x % 1
+
+instance Enum Int8 where
+    succ x
+        | x /= maxBound = x + 1
+        | otherwise     = succError "Int8"
+    pred x
+        | x /= minBound = x - 1
+        | otherwise     = predError "Int8"
+    toEnum i@(I# i#)
+        | i >= fromIntegral (minBound::Int8) && i <= fromIntegral (maxBound::Int8)
+                        = I8# i#
+        | otherwise     = toEnumError "Int8" i (minBound::Int8, maxBound::Int8)
+    fromEnum (I8# x#)   = I# x#
+    enumFrom            = boundedEnumFrom
+    enumFromThen        = boundedEnumFromThen
+
+instance Integral Int8 where
+    quot    x@(I8# x#) y@(I8# y#)
+        | y == 0                     = divZeroError
+        | y == (-1) && x == minBound = overflowError -- Note [Order of tests]
+        | otherwise                  = I8# (narrow8Int# (x# `quotInt#` y#))
+    rem     (I8# x#) y@(I8# y#)
+        | y == 0                     = divZeroError
+        | otherwise                  = I8# (narrow8Int# (x# `remInt#` y#))
+    div     x@(I8# x#) y@(I8# y#)
+        | y == 0                     = divZeroError
+        | y == (-1) && x == minBound = overflowError -- Note [Order of tests]
+        | otherwise                  = I8# (narrow8Int# (x# `divInt#` y#))
+    mod       (I8# x#) y@(I8# y#)
+        | y == 0                     = divZeroError
+        | otherwise                  = I8# (narrow8Int# (x# `modInt#` y#))
+    quotRem x@(I8# x#) y@(I8# y#)
+        | y == 0                     = divZeroError
+          -- Note [Order of tests]
+        | y == (-1) && x == minBound = (overflowError, 0)
+        | otherwise                  = case x# `quotRemInt#` y# of
+                                       (# q, r #) ->
+                                           (I8# (narrow8Int# q),
+                                            I8# (narrow8Int# r))
+    divMod  x@(I8# x#) y@(I8# y#)
+        | y == 0                     = divZeroError
+          -- Note [Order of tests]
+        | y == (-1) && x == minBound = (overflowError, 0)
+        | otherwise                  = case x# `divModInt#` y# of
+                                       (# d, m #) ->
+                                           (I8# (narrow8Int# d),
+                                            I8# (narrow8Int# m))
+    toInteger (I8# x#)               = smallInteger x#
+
+instance Bounded Int8 where
+    minBound = -0x80
+    maxBound =  0x7F
+
+instance Ix Int8 where
+    range (m,n)         = [m..n]
+    unsafeIndex (m,_) i = fromIntegral i - fromIntegral m
+    inRange (m,n) i     = m <= i && i <= n
+
+instance Read Int8 where
+    readsPrec p s = [(fromIntegral (x::Int), r) | (x, r) <- readsPrec p s]
+
+instance Bits Int8 where
+    {-# INLINE shift #-}
+    {-# INLINE bit #-}
+    {-# INLINE testBit #-}
+
+    (I8# x#) .&.   (I8# y#)   = I8# (word2Int# (int2Word# x# `and#` int2Word# y#))
+    (I8# x#) .|.   (I8# y#)   = I8# (word2Int# (int2Word# x# `or#`  int2Word# y#))
+    (I8# x#) `xor` (I8# y#)   = I8# (word2Int# (int2Word# x# `xor#` int2Word# y#))
+    complement (I8# x#)       = I8# (word2Int# (not# (int2Word# x#)))
+    (I8# x#) `shift` (I# i#)
+        | isTrue# (i# >=# 0#) = I8# (narrow8Int# (x# `iShiftL#` i#))
+        | otherwise           = I8# (x# `iShiftRA#` negateInt# i#)
+    (I8# x#) `shiftL`       (I# i#) = I8# (narrow8Int# (x# `iShiftL#` i#))
+    (I8# x#) `unsafeShiftL` (I# i#) = I8# (narrow8Int# (x# `uncheckedIShiftL#` i#))
+    (I8# x#) `shiftR`       (I# i#) = I8# (x# `iShiftRA#` i#)
+    (I8# x#) `unsafeShiftR` (I# i#) = I8# (x# `uncheckedIShiftRA#` i#)
+    (I8# x#) `rotate` (I# i#)
+        | isTrue# (i'# ==# 0#)
+        = I8# x#
+        | otherwise
+        = I8# (narrow8Int# (word2Int# ((x'# `uncheckedShiftL#` i'#) `or#`
+                                       (x'# `uncheckedShiftRL#` (8# -# i'#)))))
+        where
+        !x'# = narrow8Word# (int2Word# x#)
+        !i'# = word2Int# (int2Word# i# `and#` 7##)
+    bitSizeMaybe i            = Just (finiteBitSize i)
+    bitSize i                 = finiteBitSize i
+    isSigned _                = True
+    popCount (I8# x#)         = I# (word2Int# (popCnt8# (int2Word# x#)))
+    bit                       = bitDefault
+    testBit                   = testBitDefault
+
+instance FiniteBits Int8 where
+    finiteBitSize _ = 8
+
+{-# RULES
+"fromIntegral/Int8->Int8" fromIntegral = id :: Int8 -> Int8
+"fromIntegral/a->Int8"    fromIntegral = \x -> case fromIntegral x of I# x# -> I8# (narrow8Int# x#)
+"fromIntegral/Int8->a"    fromIntegral = \(I8# x#) -> fromIntegral (I# x#)
+  #-}
+
+{-# RULES
+"properFraction/Float->(Int8,Float)"
+    properFraction = \x ->
+                      case properFraction x of {
+                        (n, y) -> ((fromIntegral :: Int -> Int8) n, y :: Float) }
+"truncate/Float->Int8"
+    truncate = (fromIntegral :: Int -> Int8) . (truncate :: Float -> Int)
+"floor/Float->Int8"
+    floor    = (fromIntegral :: Int -> Int8) . (floor :: Float -> Int)
+"ceiling/Float->Int8"
+    ceiling  = (fromIntegral :: Int -> Int8) . (ceiling :: Float -> Int)
+"round/Float->Int8"
+    round    = (fromIntegral :: Int -> Int8) . (round  :: Float -> Int)
+  #-}
+
+{-# RULES
+"properFraction/Double->(Int8,Double)"
+    properFraction = \x ->
+                      case properFraction x of {
+                        (n, y) -> ((fromIntegral :: Int -> Int8) n, y :: Double) }
+"truncate/Double->Int8"
+    truncate = (fromIntegral :: Int -> Int8) . (truncate :: Double -> Int)
+"floor/Double->Int8"
+    floor    = (fromIntegral :: Int -> Int8) . (floor :: Double -> Int)
+"ceiling/Double->Int8"
+    ceiling  = (fromIntegral :: Int -> Int8) . (ceiling :: Double -> Int)
+"round/Double->Int8"
+    round    = (fromIntegral :: Int -> Int8) . (round  :: Double -> Int)
+  #-}
+
+------------------------------------------------------------------------
+-- type Int16
+------------------------------------------------------------------------
+
+-- Int16 is represented in the same way as Int. Operations may assume
+-- and must ensure that it holds only values from its logical range.
+
+data {-# CTYPE "HsInt16" #-} Int16 = I16# Int# deriving (Eq, Ord, Typeable)
+-- ^ 16-bit signed integer type
+
+instance Show Int16 where
+    showsPrec p x = showsPrec p (fromIntegral x :: Int)
+
+instance Num Int16 where
+    (I16# x#) + (I16# y#)  = I16# (narrow16Int# (x# +# y#))
+    (I16# x#) - (I16# y#)  = I16# (narrow16Int# (x# -# y#))
+    (I16# x#) * (I16# y#)  = I16# (narrow16Int# (x# *# y#))
+    negate (I16# x#)       = I16# (narrow16Int# (negateInt# x#))
+    abs x | x >= 0         = x
+          | otherwise      = negate x
+    signum x | x > 0       = 1
+    signum 0               = 0
+    signum _               = -1
+    fromInteger i          = I16# (narrow16Int# (integerToInt i))
+
+instance Real Int16 where
+    toRational x = toInteger x % 1
+
+instance Enum Int16 where
+    succ x
+        | x /= maxBound = x + 1
+        | otherwise     = succError "Int16"
+    pred x
+        | x /= minBound = x - 1
+        | otherwise     = predError "Int16"
+    toEnum i@(I# i#)
+        | i >= fromIntegral (minBound::Int16) && i <= fromIntegral (maxBound::Int16)
+                        = I16# i#
+        | otherwise     = toEnumError "Int16" i (minBound::Int16, maxBound::Int16)
+    fromEnum (I16# x#)  = I# x#
+    enumFrom            = boundedEnumFrom
+    enumFromThen        = boundedEnumFromThen
+
+instance Integral Int16 where
+    quot    x@(I16# x#) y@(I16# y#)
+        | y == 0                     = divZeroError
+        | y == (-1) && x == minBound = overflowError -- Note [Order of tests]
+        | otherwise                  = I16# (narrow16Int# (x# `quotInt#` y#))
+    rem       (I16# x#) y@(I16# y#)
+        | y == 0                     = divZeroError
+        | otherwise                  = I16# (narrow16Int# (x# `remInt#` y#))
+    div     x@(I16# x#) y@(I16# y#)
+        | y == 0                     = divZeroError
+        | y == (-1) && x == minBound = overflowError -- Note [Order of tests]
+        | otherwise                  = I16# (narrow16Int# (x# `divInt#` y#))
+    mod       (I16# x#) y@(I16# y#)
+        | y == 0                     = divZeroError
+        | otherwise                  = I16# (narrow16Int# (x# `modInt#` y#))
+    quotRem x@(I16# x#) y@(I16# y#)
+        | y == 0                     = divZeroError
+          -- Note [Order of tests]
+        | y == (-1) && x == minBound = (overflowError, 0)
+        | otherwise                  = case x# `quotRemInt#` y# of
+                                       (# q, r #) ->
+                                           (I16# (narrow16Int# q),
+                                            I16# (narrow16Int# r))
+    divMod  x@(I16# x#) y@(I16# y#)
+        | y == 0                     = divZeroError
+          -- Note [Order of tests]
+        | y == (-1) && x == minBound = (overflowError, 0)
+        | otherwise                  = case x# `divModInt#` y# of
+                                       (# d, m #) ->
+                                           (I16# (narrow16Int# d),
+                                            I16# (narrow16Int# m))
+    toInteger (I16# x#)              = smallInteger x#
+
+instance Bounded Int16 where
+    minBound = -0x8000
+    maxBound =  0x7FFF
+
+instance Ix Int16 where
+    range (m,n)         = [m..n]
+    unsafeIndex (m,_) i = fromIntegral i - fromIntegral m
+    inRange (m,n) i     = m <= i && i <= n
+
+instance Read Int16 where
+    readsPrec p s = [(fromIntegral (x::Int), r) | (x, r) <- readsPrec p s]
+
+instance Bits Int16 where
+    {-# INLINE shift #-}
+    {-# INLINE bit #-}
+    {-# INLINE testBit #-}
+
+    (I16# x#) .&.   (I16# y#)  = I16# (word2Int# (int2Word# x# `and#` int2Word# y#))
+    (I16# x#) .|.   (I16# y#)  = I16# (word2Int# (int2Word# x# `or#`  int2Word# y#))
+    (I16# x#) `xor` (I16# y#)  = I16# (word2Int# (int2Word# x# `xor#` int2Word# y#))
+    complement (I16# x#)       = I16# (word2Int# (not# (int2Word# x#)))
+    (I16# x#) `shift` (I# i#)
+        | isTrue# (i# >=# 0#)  = I16# (narrow16Int# (x# `iShiftL#` i#))
+        | otherwise            = I16# (x# `iShiftRA#` negateInt# i#)
+    (I16# x#) `shiftL`       (I# i#) = I16# (narrow16Int# (x# `iShiftL#` i#))
+    (I16# x#) `unsafeShiftL` (I# i#) = I16# (narrow16Int# (x# `uncheckedIShiftL#` i#))
+    (I16# x#) `shiftR`       (I# i#) = I16# (x# `iShiftRA#` i#)
+    (I16# x#) `unsafeShiftR` (I# i#) = I16# (x# `uncheckedIShiftRA#` i#)
+    (I16# x#) `rotate` (I# i#)
+        | isTrue# (i'# ==# 0#)
+        = I16# x#
+        | otherwise
+        = I16# (narrow16Int# (word2Int# ((x'# `uncheckedShiftL#` i'#) `or#`
+                                         (x'# `uncheckedShiftRL#` (16# -# i'#)))))
+        where
+        !x'# = narrow16Word# (int2Word# x#)
+        !i'# = word2Int# (int2Word# i# `and#` 15##)
+    bitSizeMaybe i             = Just (finiteBitSize i)
+    bitSize i                  = finiteBitSize i
+    isSigned _                 = True
+    popCount (I16# x#)         = I# (word2Int# (popCnt16# (int2Word# x#)))
+    bit                        = bitDefault
+    testBit                    = testBitDefault
+
+instance FiniteBits Int16 where
+    finiteBitSize _ = 16
+
+{-# RULES
+"fromIntegral/Word8->Int16"  fromIntegral = \(W8# x#) -> I16# (word2Int# x#)
+"fromIntegral/Int8->Int16"   fromIntegral = \(I8# x#) -> I16# x#
+"fromIntegral/Int16->Int16"  fromIntegral = id :: Int16 -> Int16
+"fromIntegral/a->Int16"      fromIntegral = \x -> case fromIntegral x of I# x# -> I16# (narrow16Int# x#)
+"fromIntegral/Int16->a"      fromIntegral = \(I16# x#) -> fromIntegral (I# x#)
+  #-}
+
+{-# RULES
+"properFraction/Float->(Int16,Float)"
+    properFraction = \x ->
+                      case properFraction x of {
+                        (n, y) -> ((fromIntegral :: Int -> Int16) n, y :: Float) }
+"truncate/Float->Int16"
+    truncate = (fromIntegral :: Int -> Int16) . (truncate :: Float -> Int)
+"floor/Float->Int16"
+    floor    = (fromIntegral :: Int -> Int16) . (floor :: Float -> Int)
+"ceiling/Float->Int16"
+    ceiling  = (fromIntegral :: Int -> Int16) . (ceiling :: Float -> Int)
+"round/Float->Int16"
+    round    = (fromIntegral :: Int -> Int16) . (round  :: Float -> Int)
+  #-}
+
+{-# RULES
+"properFraction/Double->(Int16,Double)"
+    properFraction = \x ->
+                      case properFraction x of {
+                        (n, y) -> ((fromIntegral :: Int -> Int16) n, y :: Double) }
+"truncate/Double->Int16"
+    truncate = (fromIntegral :: Int -> Int16) . (truncate :: Double -> Int)
+"floor/Double->Int16"
+    floor    = (fromIntegral :: Int -> Int16) . (floor :: Double -> Int)
+"ceiling/Double->Int16"
+    ceiling  = (fromIntegral :: Int -> Int16) . (ceiling :: Double -> Int)
+"round/Double->Int16"
+    round    = (fromIntegral :: Int -> Int16) . (round  :: Double -> Int)
+  #-}
+
+------------------------------------------------------------------------
+-- type Int32
+------------------------------------------------------------------------
+
+-- Int32 is represented in the same way as Int.
+#if WORD_SIZE_IN_BITS > 32
+-- Operations may assume and must ensure that it holds only values
+-- from its logical range.
+#endif
+
+data {-# CTYPE "HsInt32" #-} Int32 = I32# Int# deriving (Eq, Ord, Typeable)
+-- ^ 32-bit signed integer type
+
+instance Show Int32 where
+    showsPrec p x = showsPrec p (fromIntegral x :: Int)
+
+instance Num Int32 where
+    (I32# x#) + (I32# y#)  = I32# (narrow32Int# (x# +# y#))
+    (I32# x#) - (I32# y#)  = I32# (narrow32Int# (x# -# y#))
+    (I32# x#) * (I32# y#)  = I32# (narrow32Int# (x# *# y#))
+    negate (I32# x#)       = I32# (narrow32Int# (negateInt# x#))
+    abs x | x >= 0         = x
+          | otherwise      = negate x
+    signum x | x > 0       = 1
+    signum 0               = 0
+    signum _               = -1
+    fromInteger i          = I32# (narrow32Int# (integerToInt i))
+
+instance Enum Int32 where
+    succ x
+        | x /= maxBound = x + 1
+        | otherwise     = succError "Int32"
+    pred x
+        | x /= minBound = x - 1
+        | otherwise     = predError "Int32"
+#if WORD_SIZE_IN_BITS == 32
+    toEnum (I# i#)      = I32# i#
+#else
+    toEnum i@(I# i#)
+        | i >= fromIntegral (minBound::Int32) && i <= fromIntegral (maxBound::Int32)
+                        = I32# i#
+        | otherwise     = toEnumError "Int32" i (minBound::Int32, maxBound::Int32)
+#endif
+    fromEnum (I32# x#)  = I# x#
+    enumFrom            = boundedEnumFrom
+    enumFromThen        = boundedEnumFromThen
+
+instance Integral Int32 where
+    quot    x@(I32# x#) y@(I32# y#)
+        | y == 0                     = divZeroError
+        | y == (-1) && x == minBound = overflowError -- Note [Order of tests]
+        | otherwise                  = I32# (narrow32Int# (x# `quotInt#` y#))
+    rem       (I32# x#) y@(I32# y#)
+        | y == 0                     = divZeroError
+          -- The quotRem CPU instruction fails for minBound `quotRem` -1,
+          -- but minBound `rem` -1 is well-defined (0). We therefore
+          -- special-case it.
+        | y == (-1)                  = 0
+        | otherwise                  = I32# (narrow32Int# (x# `remInt#` y#))
+    div     x@(I32# x#) y@(I32# y#)
+        | y == 0                     = divZeroError
+        | y == (-1) && x == minBound = overflowError -- Note [Order of tests]
+        | otherwise                  = I32# (narrow32Int# (x# `divInt#` y#))
+    mod       (I32# x#) y@(I32# y#)
+        | y == 0                     = divZeroError
+          -- The divMod CPU instruction fails for minBound `divMod` -1,
+          -- but minBound `mod` -1 is well-defined (0). We therefore
+          -- special-case it.
+        | y == (-1)                  = 0
+        | otherwise                  = I32# (narrow32Int# (x# `modInt#` y#))
+    quotRem x@(I32# x#) y@(I32# y#)
+        | y == 0                     = divZeroError
+          -- Note [Order of tests]
+        | y == (-1) && x == minBound = (overflowError, 0)
+        | otherwise                  = case x# `quotRemInt#` y# of
+                                       (# q, r #) ->
+                                           (I32# (narrow32Int# q),
+                                            I32# (narrow32Int# r))
+    divMod  x@(I32# x#) y@(I32# y#)
+        | y == 0                     = divZeroError
+          -- Note [Order of tests]
+        | y == (-1) && x == minBound = (overflowError, 0)
+        | otherwise                  = case x# `divModInt#` y# of
+                                       (# d, m #) ->
+                                           (I32# (narrow32Int# d),
+                                            I32# (narrow32Int# m))
+    toInteger (I32# x#)              = smallInteger x#
+
+instance Read Int32 where
+    readsPrec p s = [(fromIntegral (x::Int), r) | (x, r) <- readsPrec p s]
+
+instance Bits Int32 where
+    {-# INLINE shift #-}
+    {-# INLINE bit #-}
+    {-# INLINE testBit #-}
+
+    (I32# x#) .&.   (I32# y#)  = I32# (word2Int# (int2Word# x# `and#` int2Word# y#))
+    (I32# x#) .|.   (I32# y#)  = I32# (word2Int# (int2Word# x# `or#`  int2Word# y#))
+    (I32# x#) `xor` (I32# y#)  = I32# (word2Int# (int2Word# x# `xor#` int2Word# y#))
+    complement (I32# x#)       = I32# (word2Int# (not# (int2Word# x#)))
+    (I32# x#) `shift` (I# i#)
+        | isTrue# (i# >=# 0#)  = I32# (narrow32Int# (x# `iShiftL#` i#))
+        | otherwise            = I32# (x# `iShiftRA#` negateInt# i#)
+    (I32# x#) `shiftL`       (I# i#) = I32# (narrow32Int# (x# `iShiftL#` i#))
+    (I32# x#) `unsafeShiftL` (I# i#) =
+        I32# (narrow32Int# (x# `uncheckedIShiftL#` i#))
+    (I32# x#) `shiftR`       (I# i#) = I32# (x# `iShiftRA#` i#)
+    (I32# x#) `unsafeShiftR` (I# i#) = I32# (x# `uncheckedIShiftRA#` i#)
+    (I32# x#) `rotate` (I# i#)
+        | isTrue# (i'# ==# 0#)
+        = I32# x#
+        | otherwise
+        = I32# (narrow32Int# (word2Int# ((x'# `uncheckedShiftL#` i'#) `or#`
+                                         (x'# `uncheckedShiftRL#` (32# -# i'#)))))
+        where
+        !x'# = narrow32Word# (int2Word# x#)
+        !i'# = word2Int# (int2Word# i# `and#` 31##)
+    bitSizeMaybe i             = Just (finiteBitSize i)
+    bitSize i                  = finiteBitSize i
+    isSigned _                 = True
+    popCount (I32# x#)         = I# (word2Int# (popCnt32# (int2Word# x#)))
+    bit                        = bitDefault
+    testBit                    = testBitDefault
+
+instance FiniteBits Int32 where
+    finiteBitSize _ = 32
+
+{-# RULES
+"fromIntegral/Word8->Int32"  fromIntegral = \(W8# x#) -> I32# (word2Int# x#)
+"fromIntegral/Word16->Int32" fromIntegral = \(W16# x#) -> I32# (word2Int# x#)
+"fromIntegral/Int8->Int32"   fromIntegral = \(I8# x#) -> I32# x#
+"fromIntegral/Int16->Int32"  fromIntegral = \(I16# x#) -> I32# x#
+"fromIntegral/Int32->Int32"  fromIntegral = id :: Int32 -> Int32
+"fromIntegral/a->Int32"      fromIntegral = \x -> case fromIntegral x of I# x# -> I32# (narrow32Int# x#)
+"fromIntegral/Int32->a"      fromIntegral = \(I32# x#) -> fromIntegral (I# x#)
+  #-}
+
+{-# RULES
+"properFraction/Float->(Int32,Float)"
+    properFraction = \x ->
+                      case properFraction x of {
+                        (n, y) -> ((fromIntegral :: Int -> Int32) n, y :: Float) }
+"truncate/Float->Int32"
+    truncate = (fromIntegral :: Int -> Int32) . (truncate :: Float -> Int)
+"floor/Float->Int32"
+    floor    = (fromIntegral :: Int -> Int32) . (floor :: Float -> Int)
+"ceiling/Float->Int32"
+    ceiling  = (fromIntegral :: Int -> Int32) . (ceiling :: Float -> Int)
+"round/Float->Int32"
+    round    = (fromIntegral :: Int -> Int32) . (round  :: Float -> Int)
+  #-}
+
+{-# RULES
+"properFraction/Double->(Int32,Double)"
+    properFraction = \x ->
+                      case properFraction x of {
+                        (n, y) -> ((fromIntegral :: Int -> Int32) n, y :: Double) }
+"truncate/Double->Int32"
+    truncate = (fromIntegral :: Int -> Int32) . (truncate :: Double -> Int)
+"floor/Double->Int32"
+    floor    = (fromIntegral :: Int -> Int32) . (floor :: Double -> Int)
+"ceiling/Double->Int32"
+    ceiling  = (fromIntegral :: Int -> Int32) . (ceiling :: Double -> Int)
+"round/Double->Int32"
+    round    = (fromIntegral :: Int -> Int32) . (round  :: Double -> Int)
+  #-}
+
+instance Real Int32 where
+    toRational x = toInteger x % 1
+
+instance Bounded Int32 where
+    minBound = -0x80000000
+    maxBound =  0x7FFFFFFF
+
+instance Ix Int32 where
+    range (m,n)         = [m..n]
+    unsafeIndex (m,_) i = fromIntegral i - fromIntegral m
+    inRange (m,n) i     = m <= i && i <= n
+
+------------------------------------------------------------------------
+-- type Int64
+------------------------------------------------------------------------
+
+#if WORD_SIZE_IN_BITS < 64
+
+data {-# CTYPE "HsInt64" #-} Int64 = I64# Int64# deriving( Typeable )
+-- ^ 64-bit signed integer type
+
+instance Eq Int64 where
+    (I64# x#) == (I64# y#) = isTrue# (x# `eqInt64#` y#)
+    (I64# x#) /= (I64# y#) = isTrue# (x# `neInt64#` y#)
+
+instance Ord Int64 where
+    (I64# x#) <  (I64# y#) = isTrue# (x# `ltInt64#` y#)
+    (I64# x#) <= (I64# y#) = isTrue# (x# `leInt64#` y#)
+    (I64# x#) >  (I64# y#) = isTrue# (x# `gtInt64#` y#)
+    (I64# x#) >= (I64# y#) = isTrue# (x# `geInt64#` y#)
+
+instance Show Int64 where
+    showsPrec p x = showsPrec p (toInteger x)
+
+instance Num Int64 where
+    (I64# x#) + (I64# y#)  = I64# (x# `plusInt64#`  y#)
+    (I64# x#) - (I64# y#)  = I64# (x# `minusInt64#` y#)
+    (I64# x#) * (I64# y#)  = I64# (x# `timesInt64#` y#)
+    negate (I64# x#)       = I64# (negateInt64# x#)
+    abs x | x >= 0         = x
+          | otherwise      = negate x
+    signum x | x > 0       = 1
+    signum 0               = 0
+    signum _               = -1
+    fromInteger i          = I64# (integerToInt64 i)
+
+instance Enum Int64 where
+    succ x
+        | x /= maxBound = x + 1
+        | otherwise     = succError "Int64"
+    pred x
+        | x /= minBound = x - 1
+        | otherwise     = predError "Int64"
+    toEnum (I# i#)      = I64# (intToInt64# i#)
+    fromEnum x@(I64# x#)
+        | x >= fromIntegral (minBound::Int) && x <= fromIntegral (maxBound::Int)
+                        = I# (int64ToInt# x#)
+        | otherwise     = fromEnumError "Int64" x
+    enumFrom            = integralEnumFrom
+    enumFromThen        = integralEnumFromThen
+    enumFromTo          = integralEnumFromTo
+    enumFromThenTo      = integralEnumFromThenTo
+
+instance Integral Int64 where
+    quot    x@(I64# x#) y@(I64# y#)
+        | y == 0                     = divZeroError
+        | y == (-1) && x == minBound = overflowError -- Note [Order of tests]
+        | otherwise                  = I64# (x# `quotInt64#` y#)
+    rem       (I64# x#) y@(I64# y#)
+        | y == 0                     = divZeroError
+          -- The quotRem CPU instruction fails for minBound `quotRem` -1,
+          -- but minBound `rem` -1 is well-defined (0). We therefore
+          -- special-case it.
+        | y == (-1)                  = 0
+        | otherwise                  = I64# (x# `remInt64#` y#)
+    div     x@(I64# x#) y@(I64# y#)
+        | y == 0                     = divZeroError
+        | y == (-1) && x == minBound = overflowError -- Note [Order of tests]
+        | otherwise                  = I64# (x# `divInt64#` y#)
+    mod       (I64# x#) y@(I64# y#)
+        | y == 0                     = divZeroError
+          -- The divMod CPU instruction fails for minBound `divMod` -1,
+          -- but minBound `mod` -1 is well-defined (0). We therefore
+          -- special-case it.
+        | y == (-1)                  = 0
+        | otherwise                  = I64# (x# `modInt64#` y#)
+    quotRem x@(I64# x#) y@(I64# y#)
+        | y == 0                     = divZeroError
+          -- Note [Order of tests]
+        | y == (-1) && x == minBound = (overflowError, 0)
+        | otherwise                  = (I64# (x# `quotInt64#` y#),
+                                        I64# (x# `remInt64#` y#))
+    divMod  x@(I64# x#) y@(I64# y#)
+        | y == 0                     = divZeroError
+          -- Note [Order of tests]
+        | y == (-1) && x == minBound = (overflowError, 0)
+        | otherwise                  = (I64# (x# `divInt64#` y#),
+                                        I64# (x# `modInt64#` y#))
+    toInteger (I64# x)               = int64ToInteger x
+
+
+divInt64#, modInt64# :: Int64# -> Int64# -> Int64#
+
+-- Define div in terms of quot, being careful to avoid overflow (#7233)
+x# `divInt64#` y#
+    | isTrue# (x# `gtInt64#` zero) && isTrue# (y# `ltInt64#` zero)
+        = ((x# `minusInt64#` one) `quotInt64#` y#) `minusInt64#` one
+    | isTrue# (x# `ltInt64#` zero) && isTrue# (y# `gtInt64#` zero)
+        = ((x# `plusInt64#` one)  `quotInt64#` y#) `minusInt64#` one
+    | otherwise
+        = x# `quotInt64#` y#
+    where
+    !zero = intToInt64# 0#
+    !one  = intToInt64# 1#
+
+x# `modInt64#` y#
+    | isTrue# (x# `gtInt64#` zero) && isTrue# (y# `ltInt64#` zero) ||
+      isTrue# (x# `ltInt64#` zero) && isTrue# (y# `gtInt64#` zero)
+        = if isTrue# (r# `neInt64#` zero) then r# `plusInt64#` y# else zero
+    | otherwise = r#
+    where
+    !zero = intToInt64# 0#
+    !r# = x# `remInt64#` y#
+
+instance Read Int64 where
+    readsPrec p s = [(fromInteger x, r) | (x, r) <- readsPrec p s]
+
+instance Bits Int64 where
+    {-# INLINE shift #-}
+    {-# INLINE bit #-}
+    {-# INLINE testBit #-}
+
+    (I64# x#) .&.   (I64# y#)  = I64# (word64ToInt64# (int64ToWord64# x# `and64#` int64ToWord64# y#))
+    (I64# x#) .|.   (I64# y#)  = I64# (word64ToInt64# (int64ToWord64# x# `or64#`  int64ToWord64# y#))
+    (I64# x#) `xor` (I64# y#)  = I64# (word64ToInt64# (int64ToWord64# x# `xor64#` int64ToWord64# y#))
+    complement (I64# x#)       = I64# (word64ToInt64# (not64# (int64ToWord64# x#)))
+    (I64# x#) `shift` (I# i#)
+        | isTrue# (i# >=# 0#)  = I64# (x# `iShiftL64#` i#)
+        | otherwise            = I64# (x# `iShiftRA64#` negateInt# i#)
+    (I64# x#) `shiftL` (I# i#) = I64# (x# `iShiftL64#` i#)
+    (I64# x#) `unsafeShiftL` (I# i#) = I64# (x# `uncheckedIShiftL64#` i#)
+    (I64# x#) `shiftR` (I# i#) = I64# (x# `iShiftRA64#` i#)
+    (I64# x#) `unsafeShiftR` (I# i#) = I64# (x# `uncheckedIShiftRA64#` i#)
+    (I64# x#) `rotate` (I# i#)
+        | isTrue# (i'# ==# 0#)
+        = I64# x#
+        | otherwise
+        = I64# (word64ToInt64# ((x'# `uncheckedShiftL64#` i'#) `or64#`
+                                (x'# `uncheckedShiftRL64#` (64# -# i'#))))
+        where
+        !x'# = int64ToWord64# x#
+        !i'# = word2Int# (int2Word# i# `and#` 63##)
+    bitSizeMaybe i             = Just (finiteBitSize i)
+    bitSize i                  = finiteBitSize i
+    isSigned _                 = True
+    popCount (I64# x#)         =
+        I# (word2Int# (popCnt64# (int64ToWord64# x#)))
+    bit                        = bitDefault
+    testBit                    = testBitDefault
+
+-- give the 64-bit shift operations the same treatment as the 32-bit
+-- ones (see GHC.Base), namely we wrap them in tests to catch the
+-- cases when we're shifting more than 64 bits to avoid unspecified
+-- behaviour in the C shift operations.
+
+iShiftL64#, iShiftRA64# :: Int64# -> Int# -> Int64#
+
+a `iShiftL64#` b  | isTrue# (b >=# 64#) = intToInt64# 0#
+		  | otherwise           = a `uncheckedIShiftL64#` b
+
+a `iShiftRA64#` b | isTrue# (b >=# 64#) = if isTrue# (a `ltInt64#` (intToInt64# 0#))
+				          then intToInt64# (-1#)
+					  else intToInt64# 0#
+		  | otherwise = a `uncheckedIShiftRA64#` b
+
+{-# RULES
+"fromIntegral/Int->Int64"    fromIntegral = \(I#   x#) -> I64# (intToInt64# x#)
+"fromIntegral/Word->Int64"   fromIntegral = \(W#   x#) -> I64# (word64ToInt64# (wordToWord64# x#))
+"fromIntegral/Word64->Int64" fromIntegral = \(W64# x#) -> I64# (word64ToInt64# x#)
+"fromIntegral/Int64->Int"    fromIntegral = \(I64# x#) -> I#   (int64ToInt# x#)
+"fromIntegral/Int64->Word"   fromIntegral = \(I64# x#) -> W#   (int2Word# (int64ToInt# x#))
+"fromIntegral/Int64->Word64" fromIntegral = \(I64# x#) -> W64# (int64ToWord64# x#)
+"fromIntegral/Int64->Int64"  fromIntegral = id :: Int64 -> Int64
+  #-}
+
+-- No RULES for RealFrac methods if Int is smaller than Int64, we can't
+-- go through Int and whether going through Integer is faster is uncertain.
+#else
+
+-- Int64 is represented in the same way as Int.
+-- Operations may assume and must ensure that it holds only values
+-- from its logical range.
+
+data {-# CTYPE "HsInt64" #-} Int64 = I64# Int# deriving (Eq, Ord, Typeable)
+-- ^ 64-bit signed integer type
+
+instance Show Int64 where
+    showsPrec p x = showsPrec p (fromIntegral x :: Int)
+
+instance Num Int64 where
+    (I64# x#) + (I64# y#)  = I64# (x# +# y#)
+    (I64# x#) - (I64# y#)  = I64# (x# -# y#)
+    (I64# x#) * (I64# y#)  = I64# (x# *# y#)
+    negate (I64# x#)       = I64# (negateInt# x#)
+    abs x | x >= 0         = x
+          | otherwise      = negate x
+    signum x | x > 0       = 1
+    signum 0               = 0
+    signum _               = -1
+    fromInteger i          = I64# (integerToInt i)
+
+instance Enum Int64 where
+    succ x
+        | x /= maxBound = x + 1
+        | otherwise     = succError "Int64"
+    pred x
+        | x /= minBound = x - 1
+        | otherwise     = predError "Int64"
+    toEnum (I# i#)      = I64# i#
+    fromEnum (I64# x#)  = I# x#
+    enumFrom            = boundedEnumFrom
+    enumFromThen        = boundedEnumFromThen
+
+instance Integral Int64 where
+    quot    x@(I64# x#) y@(I64# y#)
+        | y == 0                     = divZeroError
+        | y == (-1) && x == minBound = overflowError -- Note [Order of tests]
+        | otherwise                  = I64# (x# `quotInt#` y#)
+    rem       (I64# x#) y@(I64# y#)
+        | y == 0                     = divZeroError
+          -- The quotRem CPU instruction fails for minBound `quotRem` -1,
+          -- but minBound `rem` -1 is well-defined (0). We therefore
+          -- special-case it.
+        | y == (-1)                  = 0
+        | otherwise                  = I64# (x# `remInt#` y#)
+    div     x@(I64# x#) y@(I64# y#)
+        | y == 0                     = divZeroError
+        | y == (-1) && x == minBound = overflowError -- Note [Order of tests]
+        | otherwise                  = I64# (x# `divInt#` y#)
+    mod       (I64# x#) y@(I64# y#)
+        | y == 0                     = divZeroError
+          -- The divMod CPU instruction fails for minBound `divMod` -1,
+          -- but minBound `mod` -1 is well-defined (0). We therefore
+          -- special-case it.
+        | y == (-1)                  = 0
+        | otherwise                  = I64# (x# `modInt#` y#)
+    quotRem x@(I64# x#) y@(I64# y#)
+        | y == 0                     = divZeroError
+          -- Note [Order of tests]
+        | y == (-1) && x == minBound = (overflowError, 0)
+        | otherwise                  = case x# `quotRemInt#` y# of
+                                       (# q, r #) ->
+                                           (I64# q, I64# r)
+    divMod  x@(I64# x#) y@(I64# y#)
+        | y == 0                     = divZeroError
+          -- Note [Order of tests]
+        | y == (-1) && x == minBound = (overflowError, 0)
+        | otherwise                  = case x# `divModInt#` y# of
+                                       (# d, m #) ->
+                                           (I64# d, I64# m)
+    toInteger (I64# x#)              = smallInteger x#
+
+instance Read Int64 where
+    readsPrec p s = [(fromIntegral (x::Int), r) | (x, r) <- readsPrec p s]
+
+instance Bits Int64 where
+    {-# INLINE shift #-}
+    {-# INLINE bit #-}
+    {-# INLINE testBit #-}
+
+    (I64# x#) .&.   (I64# y#)  = I64# (word2Int# (int2Word# x# `and#` int2Word# y#))
+    (I64# x#) .|.   (I64# y#)  = I64# (word2Int# (int2Word# x# `or#`  int2Word# y#))
+    (I64# x#) `xor` (I64# y#)  = I64# (word2Int# (int2Word# x# `xor#` int2Word# y#))
+    complement (I64# x#)       = I64# (word2Int# (int2Word# x# `xor#` int2Word# (-1#)))
+    (I64# x#) `shift` (I# i#)
+        | isTrue# (i# >=# 0#)  = I64# (x# `iShiftL#` i#)
+        | otherwise            = I64# (x# `iShiftRA#` negateInt# i#)
+    (I64# x#) `shiftL`       (I# i#) = I64# (x# `iShiftL#` i#)
+    (I64# x#) `unsafeShiftL` (I# i#) = I64# (x# `uncheckedIShiftL#` i#)
+    (I64# x#) `shiftR`       (I# i#) = I64# (x# `iShiftRA#` i#)
+    (I64# x#) `unsafeShiftR` (I# i#) = I64# (x# `uncheckedIShiftRA#` i#)
+    (I64# x#) `rotate` (I# i#)
+        | isTrue# (i'# ==# 0#)
+        = I64# x#
+        | otherwise
+        = I64# (word2Int# ((x'# `uncheckedShiftL#` i'#) `or#`
+                           (x'# `uncheckedShiftRL#` (64# -# i'#))))
+        where
+        !x'# = int2Word# x#
+        !i'# = word2Int# (int2Word# i# `and#` 63##)
+    bitSizeMaybe i             = Just (finiteBitSize i)
+    bitSize i                  = finiteBitSize i
+    isSigned _                 = True
+    popCount (I64# x#)         = I# (word2Int# (popCnt64# (int2Word# x#)))
+    bit                        = bitDefault
+    testBit                    = testBitDefault
+
+{-# RULES
+"fromIntegral/a->Int64" fromIntegral = \x -> case fromIntegral x of I# x# -> I64# x#
+"fromIntegral/Int64->a" fromIntegral = \(I64# x#) -> fromIntegral (I# x#)
+  #-}
+
+{-# RULES
+"properFraction/Float->(Int64,Float)"
+    properFraction = \x ->
+                      case properFraction x of {
+                        (n, y) -> ((fromIntegral :: Int -> Int64) n, y :: Float) }
+"truncate/Float->Int64"
+    truncate = (fromIntegral :: Int -> Int64) . (truncate :: Float -> Int)
+"floor/Float->Int64"
+    floor    = (fromIntegral :: Int -> Int64) . (floor :: Float -> Int)
+"ceiling/Float->Int64"
+    ceiling  = (fromIntegral :: Int -> Int64) . (ceiling :: Float -> Int)
+"round/Float->Int64"
+    round    = (fromIntegral :: Int -> Int64) . (round  :: Float -> Int)
+  #-}
+
+{-# RULES
+"properFraction/Double->(Int64,Double)"
+    properFraction = \x ->
+                      case properFraction x of {
+                        (n, y) -> ((fromIntegral :: Int -> Int64) n, y :: Double) }
+"truncate/Double->Int64"
+    truncate = (fromIntegral :: Int -> Int64) . (truncate :: Double -> Int)
+"floor/Double->Int64"
+    floor    = (fromIntegral :: Int -> Int64) . (floor :: Double -> Int)
+"ceiling/Double->Int64"
+    ceiling  = (fromIntegral :: Int -> Int64) . (ceiling :: Double -> Int)
+"round/Double->Int64"
+    round    = (fromIntegral :: Int -> Int64) . (round  :: Double -> Int)
+  #-}
+
+uncheckedIShiftL64# :: Int# -> Int# -> Int#
+uncheckedIShiftL64#  = uncheckedIShiftL#
+
+uncheckedIShiftRA64# :: Int# -> Int# -> Int#
+uncheckedIShiftRA64# = uncheckedIShiftRA#
+#endif
+
+instance FiniteBits Int64 where
+    finiteBitSize _ = 64
+
+instance Real Int64 where
+    toRational x = toInteger x % 1
+
+instance Bounded Int64 where
+    minBound = -0x8000000000000000
+    maxBound =  0x7FFFFFFFFFFFFFFF
+
+instance Ix Int64 where
+    range (m,n)         = [m..n]
+    unsafeIndex (m,_) i = fromIntegral i - fromIntegral m
+    inRange (m,n) i     = m <= i && i <= n
+
+
+{-
+Note [Order of tests]
+
+Suppose we had a definition like:
+
+    quot x y
+     | y == 0                     = divZeroError
+     | x == minBound && y == (-1) = overflowError
+     | otherwise                  = x `primQuot` y
+
+Note in particular that the
+    x == minBound
+test comes before the
+    y == (-1)
+test.
+
+this expands to something like:
+
+    case y of
+    0 -> divZeroError
+    _ -> case x of
+         -9223372036854775808 ->
+             case y of
+             -1 -> overflowError
+             _ -> x `primQuot` y
+         _ -> x `primQuot` y
+
+Now if we have the call (x `quot` 2), and quot gets inlined, then we get:
+
+    case 2 of
+    0 -> divZeroError
+    _ -> case x of
+         -9223372036854775808 ->
+             case 2 of
+             -1 -> overflowError
+             _ -> x `primQuot` 2
+         _ -> x `primQuot` 2
+
+which simplifies to:
+
+    case x of
+    -9223372036854775808 -> x `primQuot` 2
+    _                    -> x `primQuot` 2
+
+Now we have a case with two identical branches, which would be
+eliminated (assuming it doesn't affect strictness, which it doesn't in
+this case), leaving the desired:
+
+    x `primQuot` 2
+
+except in the minBound branch we know what x is, and GHC cleverly does
+the division at compile time, giving:
+
+    case x of
+    -9223372036854775808 -> -4611686018427387904
+    _                    -> x `primQuot` 2
+
+So instead we use a definition like:
+
+    quot x y
+     | y == 0                     = divZeroError
+     | y == (-1) && x == minBound = overflowError
+     | otherwise                  = x `primQuot` y
+
+which gives us:
+
+    case y of
+    0 -> divZeroError
+    -1 ->
+        case x of
+        -9223372036854775808 -> overflowError
+        _ -> x `primQuot` y
+    _ -> x `primQuot` y
+
+for which our call (x `quot` 2) expands to:
+
+    case 2 of
+    0 -> divZeroError
+    -1 ->
+        case x of
+        -9223372036854775808 -> overflowError
+        _ -> x `primQuot` 2
+    _ -> x `primQuot` 2
+
+which simplifies to:
+
+    x `primQuot` 2
+
+as required.
+
+
+
+But we now have the same problem with a constant numerator: the call
+(2 `quot` y) expands to
+
+    case y of
+    0 -> divZeroError
+    -1 ->
+        case 2 of
+        -9223372036854775808 -> overflowError
+        _ -> 2 `primQuot` y
+    _ -> 2 `primQuot` y
+
+which simplifies to:
+
+    case y of
+    0 -> divZeroError
+    -1 -> 2 `primQuot` y
+    _ -> 2 `primQuot` y
+
+which simplifies to:
+
+    case y of
+    0 -> divZeroError
+    -1 -> -2
+    _ -> 2 `primQuot` y
+
+
+However, constant denominators are more common than constant numerators,
+so the
+    y == (-1) && x == minBound
+order gives us better code in the common case.
+-}
diff --git a/libraries/base/GHC/List.lhs b/libraries/base/GHC/List.lhs
new file mode 100644
index 000000000000..9b6cc2eb194c
--- /dev/null
+++ b/libraries/base/GHC/List.lhs
@@ -0,0 +1,770 @@
+\begin{code}
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE CPP, NoImplicitPrelude, ScopedTypeVariables, MagicHash #-}
+{-# OPTIONS_HADDOCK hide #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.List
+-- Copyright   :  (c) The University of Glasgow 1994-2002
+-- License     :  see libraries/base/LICENSE
+--
+-- Maintainer  :  cvs-ghc@haskell.org
+-- Stability   :  internal
+-- Portability :  non-portable (GHC Extensions)
+--
+-- The List data type and its operations
+--
+-----------------------------------------------------------------------------
+
+module GHC.List (
+   -- [] (..),          -- built-in syntax; can't be used in export list
+
+   map, (++), filter, concat,
+   head, last, tail, init, null, length, (!!),
+   foldl, scanl, scanl1, foldr, foldr1, scanr, scanr1,
+   iterate, repeat, replicate, cycle,
+   take, drop, splitAt, takeWhile, dropWhile, span, break,
+   reverse, and, or,
+   any, all, elem, notElem, lookup,
+   concatMap,
+   zip, zip3, zipWith, zipWith3, unzip, unzip3,
+   errorEmptyList,
+
+#ifndef USE_REPORT_PRELUDE
+   -- non-standard, but hidden when creating the Prelude
+   -- export list.
+   takeUInt_append
+#endif
+
+ ) where
+
+import Data.Maybe
+import GHC.Base
+
+infixl 9  !!
+infix  4 `elem`, `notElem`
+\end{code}
+
+%*********************************************************
+%*                                                      *
+\subsection{List-manipulation functions}
+%*                                                      *
+%*********************************************************
+
+\begin{code}
+-- | Extract the first element of a list, which must be non-empty.
+head                    :: [a] -> a
+head (x:_)              =  x
+head []                 =  badHead
+{-# NOINLINE [1] head #-}
+
+badHead :: a
+badHead = errorEmptyList "head"
+
+-- This rule is useful in cases like
+--      head [y | (x,y) <- ps, x==t]
+{-# RULES
+"head/build"    forall (g::forall b.(a->b->b)->b->b) .
+                head (build g) = g (\x _ -> x) badHead
+"head/augment"  forall xs (g::forall b. (a->b->b) -> b -> b) .
+                head (augment g xs) = g (\x _ -> x) (head xs)
+ #-}
+
+-- | Extract the elements after the head of a list, which must be non-empty.
+tail                    :: [a] -> [a]
+tail (_:xs)             =  xs
+tail []                 =  errorEmptyList "tail"
+
+-- | Extract the last element of a list, which must be finite and non-empty.
+last                    :: [a] -> a
+#ifdef USE_REPORT_PRELUDE
+last [x]                =  x
+last (_:xs)             =  last xs
+last []                 =  errorEmptyList "last"
+#else
+-- use foldl to allow fusion
+last = foldl (\_ x -> x) (errorEmptyList "last")
+#endif
+
+-- | Return all the elements of a list except the last one.
+-- The list must be non-empty.
+init                    :: [a] -> [a]
+#ifdef USE_REPORT_PRELUDE
+init [x]                =  []
+init (x:xs)             =  x : init xs
+init []                 =  errorEmptyList "init"
+#else
+-- eliminate repeated cases
+init []                 =  errorEmptyList "init"
+init (x:xs)             =  init' x xs
+  where init' _ []     = []
+        init' y (z:zs) = y : init' z zs
+#endif
+
+-- | Test whether a list is empty.
+null                    :: [a] -> Bool
+null []                 =  True
+null (_:_)              =  False
+
+-- | /O(n)/. 'length' returns the length of a finite list as an 'Int'.
+-- It is an instance of the more general 'Data.List.genericLength',
+-- the result type of which may be any kind of number.
+{-# NOINLINE [1] length #-}
+length                  :: [a] -> Int
+length l                =  lenAcc l 0#
+
+lenAcc :: [a] -> Int# -> Int
+lenAcc []     a# = I# a#
+lenAcc (_:xs) a# = lenAcc xs (a# +# 1#)
+
+incLen :: a -> (Int# -> Int) -> Int# -> Int
+incLen _ g x = g (x +# 1#)
+
+-- These rules make length into a good consumer
+-- Note that we use a higher-order-style use of foldr, so that
+-- the accumulating parameter can be evaluated strictly
+-- See Trac #876 for what goes wrong otherwise
+{-# RULES
+"length"     [~1] forall xs. length xs = foldr incLen I# xs 0#
+"lengthList" [1]  foldr incLen I# = lenAcc
+ #-}
+
+-- | 'filter', applied to a predicate and a list, returns the list of
+-- those elements that satisfy the predicate; i.e.,
+--
+-- > filter p xs = [ x | x <- xs, p x]
+
+{-# NOINLINE [1] filter #-}
+filter :: (a -> Bool) -> [a] -> [a]
+filter _pred []    = []
+filter pred (x:xs)
+  | pred x         = x : filter pred xs
+  | otherwise      = filter pred xs
+
+{-# NOINLINE [0] filterFB #-}
+filterFB :: (a -> b -> b) -> (a -> Bool) -> a -> b -> b
+filterFB c p x r | p x       = x `c` r
+                 | otherwise = r
+
+{-# RULES
+"filter"     [~1] forall p xs.  filter p xs = build (\c n -> foldr (filterFB c p) n xs)
+"filterList" [1]  forall p.     foldr (filterFB (:) p) [] = filter p
+"filterFB"        forall c p q. filterFB (filterFB c p) q = filterFB c (\x -> q x && p x)
+ #-}
+
+-- Note the filterFB rule, which has p and q the "wrong way round" in the RHS.
+--     filterFB (filterFB c p) q a b
+--   = if q a then filterFB c p a b else b
+--   = if q a then (if p a then c a b else b) else b
+--   = if q a && p a then c a b else b
+--   = filterFB c (\x -> q x && p x) a b
+-- I originally wrote (\x -> p x && q x), which is wrong, and actually
+-- gave rise to a live bug report.  SLPJ.
+
+
+-- | 'foldl', applied to a binary operator, a starting value (typically
+-- the left-identity of the operator), and a list, reduces the list
+-- using the binary operator, from left to right:
+--
+-- > foldl f z [x1, x2, ..., xn] == (...((z `f` x1) `f` x2) `f`...) `f` xn
+--
+-- The list must be finite.
+
+-- We write foldl as a non-recursive thing, so that it
+-- can be inlined, and then (often) strictness-analysed,
+-- and hence the classic space leak on foldl (+) 0 xs
+
+foldl :: forall a b. (b -> a -> b) -> b -> [a] -> b
+{-# INLINE foldl #-}
+foldl k z0 xs = foldr (\(v::a) (fn::b->b) (z::b) -> fn (k z v)) (id :: b -> b) xs z0
+-- Implementing foldl via foldr is only a good idea if the compiler can optimize
+-- the resulting code (eta-expand the recursive "go"), so this needs -fcall-arity!
+-- Also see #7994
+
+-- | 'scanl' is similar to 'foldl', but returns a list of successive
+-- reduced values from the left:
+--
+-- > scanl f z [x1, x2, ...] == [z, z `f` x1, (z `f` x1) `f` x2, ...]
+--
+-- Note that
+--
+-- > last (scanl f z xs) == foldl f z xs.
+
+scanl                   :: (b -> a -> b) -> b -> [a] -> [b]
+scanl f q ls            =  q : (case ls of
+                                []   -> []
+                                x:xs -> scanl f (f q x) xs)
+
+-- | 'scanl1' is a variant of 'scanl' that has no starting value argument:
+--
+-- > scanl1 f [x1, x2, ...] == [x1, x1 `f` x2, ...]
+
+scanl1                  :: (a -> a -> a) -> [a] -> [a]
+scanl1 f (x:xs)         =  scanl f x xs
+scanl1 _ []             =  []
+
+-- foldr, foldr1, scanr, and scanr1 are the right-to-left duals of the
+-- above functions.
+
+-- | 'foldr1' is a variant of 'foldr' that has no starting value argument,
+-- and thus must be applied to non-empty lists.
+
+foldr1                  :: (a -> a -> a) -> [a] -> a
+foldr1 _ [x]            =  x
+foldr1 f (x:xs)         =  f x (foldr1 f xs)
+foldr1 _ []             =  errorEmptyList "foldr1"
+
+-- | 'scanr' is the right-to-left dual of 'scanl'.
+-- Note that
+--
+-- > head (scanr f z xs) == foldr f z xs.
+
+scanr                   :: (a -> b -> b) -> b -> [a] -> [b]
+scanr _ q0 []           =  [q0]
+scanr f q0 (x:xs)       =  f x q : qs
+                           where qs@(q:_) = scanr f q0 xs
+
+-- | 'scanr1' is a variant of 'scanr' that has no starting value argument.
+
+scanr1                  :: (a -> a -> a) -> [a] -> [a]
+scanr1 _ []             =  []
+scanr1 _ [x]            =  [x]
+scanr1 f (x:xs)         =  f x q : qs
+                           where qs@(q:_) = scanr1 f xs
+
+-- | 'iterate' @f x@ returns an infinite list of repeated applications
+-- of @f@ to @x@:
+--
+-- > iterate f x == [x, f x, f (f x), ...]
+
+{-# NOINLINE [1] iterate #-}
+iterate :: (a -> a) -> a -> [a]
+iterate f x =  x : iterate f (f x)
+
+{-# NOINLINE [0] iterateFB #-}
+iterateFB :: (a -> b -> b) -> (a -> a) -> a -> b
+iterateFB c f x = x `c` iterateFB c f (f x)
+
+{-# RULES
+"iterate"    [~1] forall f x.   iterate f x = build (\c _n -> iterateFB c f x)
+"iterateFB"  [1]                iterateFB (:) = iterate
+ #-}
+
+
+-- | 'repeat' @x@ is an infinite list, with @x@ the value of every element.
+repeat :: a -> [a]
+{-# INLINE [0] repeat #-}
+-- The pragma just gives the rules more chance to fire
+repeat x = xs where xs = x : xs
+
+{-# INLINE [0] repeatFB #-}     -- ditto
+repeatFB :: (a -> b -> b) -> a -> b
+repeatFB c x = xs where xs = x `c` xs
+
+
+{-# RULES
+"repeat"    [~1] forall x. repeat x = build (\c _n -> repeatFB c x)
+"repeatFB"  [1]  repeatFB (:)       = repeat
+ #-}
+
+-- | 'replicate' @n x@ is a list of length @n@ with @x@ the value of
+-- every element.
+-- It is an instance of the more general 'Data.List.genericReplicate',
+-- in which @n@ may be of any integral type.
+{-# INLINE replicate #-}
+replicate               :: Int -> a -> [a]
+replicate n x           =  take n (repeat x)
+
+-- | 'cycle' ties a finite list into a circular one, or equivalently,
+-- the infinite repetition of the original list.  It is the identity
+-- on infinite lists.
+
+cycle                   :: [a] -> [a]
+cycle []                = error "Prelude.cycle: empty list"
+cycle xs                = xs' where xs' = xs ++ xs'
+
+-- | 'takeWhile', applied to a predicate @p@ and a list @xs@, returns the
+-- longest prefix (possibly empty) of @xs@ of elements that satisfy @p@:
+--
+-- > takeWhile (< 3) [1,2,3,4,1,2,3,4] == [1,2]
+-- > takeWhile (< 9) [1,2,3] == [1,2,3]
+-- > takeWhile (< 0) [1,2,3] == []
+--
+
+takeWhile               :: (a -> Bool) -> [a] -> [a]
+takeWhile _ []          =  []
+takeWhile p (x:xs)
+            | p x       =  x : takeWhile p xs
+            | otherwise =  []
+
+-- | 'dropWhile' @p xs@ returns the suffix remaining after 'takeWhile' @p xs@:
+--
+-- > dropWhile (< 3) [1,2,3,4,5,1,2,3] == [3,4,5,1,2,3]
+-- > dropWhile (< 9) [1,2,3] == []
+-- > dropWhile (< 0) [1,2,3] == [1,2,3]
+--
+
+dropWhile               :: (a -> Bool) -> [a] -> [a]
+dropWhile _ []          =  []
+dropWhile p xs@(x:xs')
+            | p x       =  dropWhile p xs'
+            | otherwise =  xs
+
+-- | 'take' @n@, applied to a list @xs@, returns the prefix of @xs@
+-- of length @n@, or @xs@ itself if @n > 'length' xs@:
+--
+-- > take 5 "Hello World!" == "Hello"
+-- > take 3 [1,2,3,4,5] == [1,2,3]
+-- > take 3 [1,2] == [1,2]
+-- > take 3 [] == []
+-- > take (-1) [1,2] == []
+-- > take 0 [1,2] == []
+--
+-- It is an instance of the more general 'Data.List.genericTake',
+-- in which @n@ may be of any integral type.
+take                   :: Int -> [a] -> [a]
+
+-- | 'drop' @n xs@ returns the suffix of @xs@
+-- after the first @n@ elements, or @[]@ if @n > 'length' xs@:
+--
+-- > drop 6 "Hello World!" == "World!"
+-- > drop 3 [1,2,3,4,5] == [4,5]
+-- > drop 3 [1,2] == []
+-- > drop 3 [] == []
+-- > drop (-1) [1,2] == [1,2]
+-- > drop 0 [1,2] == [1,2]
+--
+-- It is an instance of the more general 'Data.List.genericDrop',
+-- in which @n@ may be of any integral type.
+drop                   :: Int -> [a] -> [a]
+
+-- | 'splitAt' @n xs@ returns a tuple where first element is @xs@ prefix of
+-- length @n@ and second element is the remainder of the list:
+--
+-- > splitAt 6 "Hello World!" == ("Hello ","World!")
+-- > splitAt 3 [1,2,3,4,5] == ([1,2,3],[4,5])
+-- > splitAt 1 [1,2,3] == ([1],[2,3])
+-- > splitAt 3 [1,2,3] == ([1,2,3],[])
+-- > splitAt 4 [1,2,3] == ([1,2,3],[])
+-- > splitAt 0 [1,2,3] == ([],[1,2,3])
+-- > splitAt (-1) [1,2,3] == ([],[1,2,3])
+--
+-- It is equivalent to @('take' n xs, 'drop' n xs)@ when @n@ is not @_|_@
+-- (@splitAt _|_ xs = _|_@).
+-- 'splitAt' is an instance of the more general 'Data.List.genericSplitAt',
+-- in which @n@ may be of any integral type.
+splitAt                :: Int -> [a] -> ([a],[a])
+
+#ifdef USE_REPORT_PRELUDE
+take n _      | n <= 0 =  []
+take _ []              =  []
+take n (x:xs)          =  x : take (n-1) xs
+
+drop n xs     | n <= 0 =  xs
+drop _ []              =  []
+drop n (_:xs)          =  drop (n-1) xs
+
+splitAt n xs           =  (take n xs, drop n xs)
+
+#else /* hack away */
+{-# RULES
+"take"     [~1] forall n xs . take n xs = takeFoldr n xs
+"takeList"  [1] forall n xs . foldr (takeFB (:) []) (takeConst []) xs n = takeUInt n xs
+ #-}
+
+{-# INLINE takeFoldr #-}
+takeFoldr :: Int -> [a] -> [a]
+takeFoldr (I# n#) xs
+  = build (\c nil -> if isTrue# (n# <=# 0#) then nil else
+                     foldr (takeFB c nil) (takeConst nil) xs n#)
+
+{-# NOINLINE [0] takeConst #-}
+-- just a version of const that doesn't get inlined too early, so we
+-- can spot it in rules.  Also we need a type sig due to the unboxed Int#.
+takeConst :: a -> Int# -> a
+takeConst x _ = x
+
+{-# NOINLINE [0] takeFB #-}
+takeFB :: (a -> b -> b) -> b -> a -> (Int# -> b) -> Int# -> b
+takeFB c n x xs m | isTrue# (m <=# 1#) = x `c` n
+                  | otherwise          = x `c` xs (m -# 1#)
+
+{-# INLINE [0] take #-}
+take (I# n#) xs = takeUInt n# xs
+
+-- The general code for take, below, checks n <= maxInt
+-- No need to check for maxInt overflow when specialised
+-- at type Int or Int# since the Int must be <= maxInt
+
+takeUInt :: Int# -> [b] -> [b]
+takeUInt n xs
+  | isTrue# (n >=# 0#) = take_unsafe_UInt n xs
+  | otherwise          = []
+
+take_unsafe_UInt :: Int# -> [b] -> [b]
+take_unsafe_UInt 0#  _  = []
+take_unsafe_UInt m   ls =
+  case ls of
+    []     -> []
+    (x:xs) -> x : take_unsafe_UInt (m -# 1#) xs
+
+takeUInt_append :: Int# -> [b] -> [b] -> [b]
+takeUInt_append n xs rs
+  | isTrue# (n >=# 0#) = take_unsafe_UInt_append n xs rs
+  | otherwise          = []
+
+take_unsafe_UInt_append :: Int# -> [b] -> [b] -> [b]
+take_unsafe_UInt_append 0#  _ rs  = rs
+take_unsafe_UInt_append m  ls rs  =
+  case ls of
+    []     -> rs
+    (x:xs) -> x : take_unsafe_UInt_append (m -# 1#) xs rs
+
+drop (I# n#) ls
+  | isTrue# (n# <# 0#) = ls
+  | otherwise          = drop# n# ls
+    where
+        drop# :: Int# -> [a] -> [a]
+        drop# 0# xs      = xs
+        drop# _  xs@[]   = xs
+        drop# m# (_:xs)  = drop# (m# -# 1#) xs
+
+splitAt (I# n#) ls
+  | isTrue# (n# <# 0#) = ([], ls)
+  | otherwise          = splitAt# n# ls
+    where
+        splitAt# :: Int# -> [a] -> ([a], [a])
+        splitAt# 0# xs     = ([], xs)
+        splitAt# _  xs@[]  = (xs, xs)
+        splitAt# m# (x:xs) = (x:xs', xs'')
+          where
+            (xs', xs'') = splitAt# (m# -# 1#) xs
+
+#endif /* USE_REPORT_PRELUDE */
+
+-- | 'span', applied to a predicate @p@ and a list @xs@, returns a tuple where
+-- first element is longest prefix (possibly empty) of @xs@ of elements that
+-- satisfy @p@ and second element is the remainder of the list:
+--
+-- > span (< 3) [1,2,3,4,1,2,3,4] == ([1,2],[3,4,1,2,3,4])
+-- > span (< 9) [1,2,3] == ([1,2,3],[])
+-- > span (< 0) [1,2,3] == ([],[1,2,3])
+--
+-- 'span' @p xs@ is equivalent to @('takeWhile' p xs, 'dropWhile' p xs)@
+
+span                    :: (a -> Bool) -> [a] -> ([a],[a])
+span _ xs@[]            =  (xs, xs)
+span p xs@(x:xs')
+         | p x          =  let (ys,zs) = span p xs' in (x:ys,zs)
+         | otherwise    =  ([],xs)
+
+-- | 'break', applied to a predicate @p@ and a list @xs@, returns a tuple where
+-- first element is longest prefix (possibly empty) of @xs@ of elements that
+-- /do not satisfy/ @p@ and second element is the remainder of the list:
+--
+-- > break (> 3) [1,2,3,4,1,2,3,4] == ([1,2,3],[4,1,2,3,4])
+-- > break (< 9) [1,2,3] == ([],[1,2,3])
+-- > break (> 9) [1,2,3] == ([1,2,3],[])
+--
+-- 'break' @p@ is equivalent to @'span' ('not' . p)@.
+
+break                   :: (a -> Bool) -> [a] -> ([a],[a])
+#ifdef USE_REPORT_PRELUDE
+break p                 =  span (not . p)
+#else
+-- HBC version (stolen)
+break _ xs@[]           =  (xs, xs)
+break p xs@(x:xs')
+           | p x        =  ([],xs)
+           | otherwise  =  let (ys,zs) = break p xs' in (x:ys,zs)
+#endif
+
+-- | 'reverse' @xs@ returns the elements of @xs@ in reverse order.
+-- @xs@ must be finite.
+reverse                 :: [a] -> [a]
+#ifdef USE_REPORT_PRELUDE
+reverse                 =  foldl (flip (:)) []
+#else
+reverse l =  rev l []
+  where
+    rev []     a = a
+    rev (x:xs) a = rev xs (x:a)
+#endif
+
+-- | 'and' returns the conjunction of a Boolean list.  For the result to be
+-- 'True', the list must be finite; 'False', however, results from a 'False'
+-- value at a finite index of a finite or infinite list.
+and                     :: [Bool] -> Bool
+
+-- | 'or' returns the disjunction of a Boolean list.  For the result to be
+-- 'False', the list must be finite; 'True', however, results from a 'True'
+-- value at a finite index of a finite or infinite list.
+or                      :: [Bool] -> Bool
+#ifdef USE_REPORT_PRELUDE
+and                     =  foldr (&&) True
+or                      =  foldr (||) False
+#else
+and []          =  True
+and (x:xs)      =  x && and xs
+or []           =  False
+or (x:xs)       =  x || or xs
+
+{-# NOINLINE [1] and #-}
+{-# NOINLINE [1] or #-}
+
+{-# RULES
+"and/build"     forall (g::forall b.(Bool->b->b)->b->b) .
+                and (build g) = g (&&) True
+"or/build"      forall (g::forall b.(Bool->b->b)->b->b) .
+                or (build g) = g (||) False
+ #-}
+#endif
+
+-- | Applied to a predicate and a list, 'any' determines if any element
+-- of the list satisfies the predicate.  For the result to be
+-- 'False', the list must be finite; 'True', however, results from a 'True'
+-- value for the predicate applied to an element at a finite index of a finite or infinite list.
+any                     :: (a -> Bool) -> [a] -> Bool
+
+-- | Applied to a predicate and a list, 'all' determines if all elements
+-- of the list satisfy the predicate. For the result to be
+-- 'True', the list must be finite; 'False', however, results from a 'False'
+-- value for the predicate applied to an element at a finite index of a finite or infinite list.
+all                     :: (a -> Bool) -> [a] -> Bool
+#ifdef USE_REPORT_PRELUDE
+any p                   =  or . map p
+all p                   =  and . map p
+#else
+any _ []        = False
+any p (x:xs)    = p x || any p xs
+
+all _ []        =  True
+all p (x:xs)    =  p x && all p xs
+
+{-# NOINLINE [1] any #-}
+{-# NOINLINE [1] all #-}
+
+{-# RULES
+"any/build"     forall p (g::forall b.(a->b->b)->b->b) .
+                any p (build g) = g ((||) . p) False
+"all/build"     forall p (g::forall b.(a->b->b)->b->b) .
+                all p (build g) = g ((&&) . p) True
+ #-}
+#endif
+
+-- | 'elem' is the list membership predicate, usually written in infix form,
+-- e.g., @x \`elem\` xs@.  For the result to be
+-- 'False', the list must be finite; 'True', however, results from an element equal to @x@ found at a finite index of a finite or infinite list.
+elem                    :: (Eq a) => a -> [a] -> Bool
+
+-- | 'notElem' is the negation of 'elem'.
+notElem                 :: (Eq a) => a -> [a] -> Bool
+#ifdef USE_REPORT_PRELUDE
+elem x                  =  any (== x)
+notElem x               =  all (/= x)
+#else
+elem _ []       = False
+elem x (y:ys)   = x==y || elem x ys
+
+notElem _ []    =  True
+notElem x (y:ys)=  x /= y && notElem x ys
+#endif
+
+-- | 'lookup' @key assocs@ looks up a key in an association list.
+lookup                  :: (Eq a) => a -> [(a,b)] -> Maybe b
+lookup _key []          =  Nothing
+lookup  key ((x,y):xys)
+    | key == x          =  Just y
+    | otherwise         =  lookup key xys
+
+-- | Map a function over a list and concatenate the results.
+concatMap               :: (a -> [b]) -> [a] -> [b]
+concatMap f             =  foldr ((++) . f) []
+
+-- | Concatenate a list of lists.
+concat :: [[a]] -> [a]
+concat = foldr (++) []
+
+{-# NOINLINE [1] concat #-}
+
+{-# RULES
+  "concat" forall xs. concat xs = build (\c n -> foldr (\x y -> foldr c y x) n xs)
+-- We don't bother to turn non-fusible applications of concat back into concat
+ #-}
+
+\end{code}
+
+
+\begin{code}
+-- | List index (subscript) operator, starting from 0.
+-- It is an instance of the more general 'Data.List.genericIndex',
+-- which takes an index of any integral type.
+(!!)                    :: [a] -> Int -> a
+#ifdef USE_REPORT_PRELUDE
+xs     !! n | n < 0 =  error "Prelude.!!: negative index"
+[]     !! _         =  error "Prelude.!!: index too large"
+(x:_)  !! 0         =  x
+(_:xs) !! n         =  xs !! (n-1)
+#else
+-- HBC version (stolen), then unboxified
+-- The semantics is not quite the same for error conditions
+-- in the more efficient version.
+--
+xs !! (I# n0) | isTrue# (n0 <# 0#) =  error "Prelude.(!!): negative index\n"
+              | otherwise          =  sub xs n0
+                         where
+                            sub :: [a] -> Int# -> a
+                            sub []     _ = error "Prelude.(!!): index too large\n"
+                            sub (y:ys) n = if isTrue# (n ==# 0#)
+                                           then y
+                                           else sub ys (n -# 1#)
+#endif
+\end{code}
+
+
+%*********************************************************
+%*                                                      *
+\subsection{The zip family}
+%*                                                      *
+%*********************************************************
+
+\begin{code}
+foldr2 :: (a -> b -> c -> c) -> c -> [a] -> [b] -> c
+foldr2 k z = go
+  where
+	go []    _ys     = z
+	go _xs   []      = z
+	go (x:xs) (y:ys) = k x y (go xs ys)
+{-# INLINE [0] foldr2 #-}
+
+foldr2_left :: (a -> b -> c -> d) -> d -> a -> ([b] -> c) -> [b] -> d
+foldr2_left _k  z _x _r []     = z
+foldr2_left  k _z  x  r (y:ys) = k x y (r ys)
+
+foldr2_right :: (a -> b -> c -> d) -> d -> b -> ([a] -> c) -> [a] -> d
+foldr2_right _k z  _y _r []     = z
+foldr2_right  k _z  y  r (x:xs) = k x y (r xs)
+
+-- foldr2 k z xs ys = foldr (foldr2_left k z)  (\_ -> z) xs ys
+-- foldr2 k z xs ys = foldr (foldr2_right k z) (\_ -> z) ys xs
+{-# RULES
+"foldr2/left"   forall k z ys (g::forall b.(a->b->b)->b->b) .
+                  foldr2 k z (build g) ys = g (foldr2_left  k z) (\_ -> z) ys
+
+"foldr2/right"  forall k z xs (g::forall b.(a->b->b)->b->b) .
+                  foldr2 k z xs (build g) = g (foldr2_right k z) (\_ -> z) xs
+ #-}
+\end{code}
+
+The foldr2/right rule isn't exactly right, because it changes
+the strictness of foldr2 (and thereby zip)
+
+E.g. main = print (null (zip nonobviousNil (build undefined)))
+          where   nonobviousNil = f 3
+                  f n = if n == 0 then [] else f (n-1)
+
+I'm going to leave it though.
+
+
+Zips for larger tuples are in the List module.
+
+\begin{code}
+----------------------------------------------
+-- | 'zip' takes two lists and returns a list of corresponding pairs.
+-- If one input list is short, excess elements of the longer list are
+-- discarded.
+{-# NOINLINE [1] zip #-}
+zip :: [a] -> [b] -> [(a,b)]
+zip (a:as) (b:bs) = (a,b) : zip as bs
+zip _      _      = []
+
+{-# INLINE [0] zipFB #-}
+zipFB :: ((a, b) -> c -> d) -> a -> b -> c -> d
+zipFB c = \x y r -> (x,y) `c` r
+
+{-# RULES
+"zip"      [~1] forall xs ys. zip xs ys = build (\c n -> foldr2 (zipFB c) n xs ys)
+"zipList"  [1]  foldr2 (zipFB (:)) []   = zip
+ #-}
+\end{code}
+
+\begin{code}
+----------------------------------------------
+-- | 'zip3' takes three lists and returns a list of triples, analogous to
+-- 'zip'.
+zip3 :: [a] -> [b] -> [c] -> [(a,b,c)]
+-- Specification
+-- zip3 =  zipWith3 (,,)
+zip3 (a:as) (b:bs) (c:cs) = (a,b,c) : zip3 as bs cs
+zip3 _      _      _      = []
+\end{code}
+
+
+-- The zipWith family generalises the zip family by zipping with the
+-- function given as the first argument, instead of a tupling function.
+
+\begin{code}
+----------------------------------------------
+-- | 'zipWith' generalises 'zip' by zipping with the function given
+-- as the first argument, instead of a tupling function.
+-- For example, @'zipWith' (+)@ is applied to two lists to produce the
+-- list of corresponding sums.
+{-# NOINLINE [1] zipWith #-}
+zipWith :: (a->b->c) -> [a]->[b]->[c]
+zipWith f (a:as) (b:bs) = f a b : zipWith f as bs
+zipWith _ _      _      = []
+
+-- zipWithFB must have arity 2 since it gets two arguments in the "zipWith"
+-- rule; it might not get inlined otherwise
+{-# INLINE [0] zipWithFB #-}
+zipWithFB :: (a -> b -> c) -> (d -> e -> a) -> d -> e -> b -> c
+zipWithFB c f = \x y r -> (x `f` y) `c` r
+
+{-# RULES
+"zipWith"       [~1] forall f xs ys.    zipWith f xs ys = build (\c n -> foldr2 (zipWithFB c f) n xs ys)
+"zipWithList"   [1]  forall f.  foldr2 (zipWithFB (:) f) [] = zipWith f
+  #-}
+\end{code}
+
+\begin{code}
+-- | The 'zipWith3' function takes a function which combines three
+-- elements, as well as three lists and returns a list of their point-wise
+-- combination, analogous to 'zipWith'.
+zipWith3                :: (a->b->c->d) -> [a]->[b]->[c]->[d]
+zipWith3 z (a:as) (b:bs) (c:cs)
+                        =  z a b c : zipWith3 z as bs cs
+zipWith3 _ _ _ _        =  []
+
+-- | 'unzip' transforms a list of pairs into a list of first components
+-- and a list of second components.
+unzip    :: [(a,b)] -> ([a],[b])
+{-# INLINE unzip #-}
+unzip    =  foldr (\(a,b) ~(as,bs) -> (a:as,b:bs)) ([],[])
+
+-- | The 'unzip3' function takes a list of triples and returns three
+-- lists, analogous to 'unzip'.
+unzip3   :: [(a,b,c)] -> ([a],[b],[c])
+{-# INLINE unzip3 #-}
+unzip3   =  foldr (\(a,b,c) ~(as,bs,cs) -> (a:as,b:bs,c:cs))
+                  ([],[],[])
+\end{code}
+
+
+%*********************************************************
+%*                                                      *
+\subsection{Error code}
+%*                                                      *
+%*********************************************************
+
+Common up near identical calls to `error' to reduce the number
+constant strings created when compiled:
+
+\begin{code}
+errorEmptyList :: String -> a
+errorEmptyList fun =
+  error (prel_list_str ++ fun ++ ": empty list")
+
+prel_list_str :: String
+prel_list_str = "Prelude."
+\end{code}
diff --git a/libraries/base/GHC/MVar.hs b/libraries/base/GHC/MVar.hs
new file mode 100644
index 000000000000..ff138a5ef2a4
--- /dev/null
+++ b/libraries/base/GHC/MVar.hs
@@ -0,0 +1,183 @@
+{-# LANGUAGE Unsafe, AutoDeriveTypeable #-}
+{-# LANGUAGE NoImplicitPrelude, MagicHash, UnboxedTuples #-}
+{-# OPTIONS_GHC -funbox-strict-fields #-}
+{-# OPTIONS_HADDOCK hide #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.MVar
+-- Copyright   :  (c) The University of Glasgow 2008
+-- License     :  see libraries/base/LICENSE
+--
+-- Maintainer  :  cvs-ghc@haskell.org
+-- Stability   :  internal
+-- Portability :  non-portable (GHC Extensions)
+--
+-- The MVar type
+--
+-----------------------------------------------------------------------------
+
+module GHC.MVar (
+        -- * MVars
+          MVar(..)
+        , newMVar
+        , newEmptyMVar
+        , takeMVar
+        , readMVar
+        , putMVar
+        , tryTakeMVar
+        , tryPutMVar
+        , tryReadMVar
+        , isEmptyMVar
+        , addMVarFinalizer
+    ) where
+
+import GHC.Base
+import Data.Maybe
+import Data.Typeable
+
+data MVar a = MVar (MVar# RealWorld a) deriving( Typeable )
+{- ^
+An 'MVar' (pronounced \"em-var\") is a synchronising variable, used
+for communication between concurrent threads.  It can be thought of
+as a a box, which may be empty or full.
+-}
+
+-- pull in Eq (Mvar a) too, to avoid GHC.Conc being an orphan-instance module
+instance Eq (MVar a) where
+        (MVar mvar1#) == (MVar mvar2#) = isTrue# (sameMVar# mvar1# mvar2#)
+
+{-
+M-Vars are rendezvous points for concurrent threads.  They begin
+empty, and any attempt to read an empty M-Var blocks.  When an M-Var
+is written, a single blocked thread may be freed.  Reading an M-Var
+toggles its state from full back to empty.  Therefore, any value
+written to an M-Var may only be read once.  Multiple reads and writes
+are allowed, but there must be at least one read between any two
+writes.
+-}
+
+--Defined in IOBase to avoid cycle: data MVar a = MVar (SynchVar# RealWorld a)
+
+-- |Create an 'MVar' which is initially empty.
+newEmptyMVar  :: IO (MVar a)
+newEmptyMVar = IO $ \ s# ->
+    case newMVar# s# of
+         (# s2#, svar# #) -> (# s2#, MVar svar# #)
+
+-- |Create an 'MVar' which contains the supplied value.
+newMVar :: a -> IO (MVar a)
+newMVar value =
+    newEmptyMVar        >>= \ mvar ->
+    putMVar mvar value  >>
+    return mvar
+
+-- |Return the contents of the 'MVar'.  If the 'MVar' is currently
+-- empty, 'takeMVar' will wait until it is full.  After a 'takeMVar',
+-- the 'MVar' is left empty.
+--
+-- There are two further important properties of 'takeMVar':
+--
+--   * 'takeMVar' is single-wakeup.  That is, if there are multiple
+--     threads blocked in 'takeMVar', and the 'MVar' becomes full,
+--     only one thread will be woken up.  The runtime guarantees that
+--     the woken thread completes its 'takeMVar' operation.
+--
+--   * When multiple threads are blocked on an 'MVar', they are
+--     woken up in FIFO order.  This is useful for providing
+--     fairness properties of abstractions built using 'MVar's.
+--
+takeMVar :: MVar a -> IO a
+takeMVar (MVar mvar#) = IO $ \ s# -> takeMVar# mvar# s#
+
+-- |Atomically read the contents of an 'MVar'.  If the 'MVar' is
+-- currently empty, 'readMVar' will wait until its full.
+-- 'readMVar' is guaranteed to receive the next 'putMVar'.
+--
+-- 'readMVar' is multiple-wakeup, so when multiple readers are
+-- blocked on an 'MVar', all of them are woken up at the same time.
+--
+-- /Compatibility note:/ Prior to base 4.7, 'readMVar' was a combination
+-- of 'takeMVar' and 'putMVar'.  This mean that in the presence of
+-- other threads attempting to 'putMVar', 'readMVar' could block.
+-- Furthermore, 'readMVar' would not receive the next 'putMVar' if there
+-- was already a pending thread blocked on 'takeMVar'.  The old behavior
+-- can be recovered by implementing 'readMVar as follows:
+--
+-- @
+--  readMVar :: MVar a -> IO a
+--  readMVar m =
+--    mask_ $ do
+--      a <- takeMVar m
+--      putMVar m a
+--      return a
+-- @
+readMVar :: MVar a -> IO a
+readMVar (MVar mvar#) = IO $ \ s# -> readMVar# mvar# s#
+
+-- |Put a value into an 'MVar'.  If the 'MVar' is currently full,
+-- 'putMVar' will wait until it becomes empty.
+--
+-- There are two further important properties of 'putMVar':
+--
+--   * 'putMVar' is single-wakeup.  That is, if there are multiple
+--     threads blocked in 'putMVar', and the 'MVar' becomes empty,
+--     only one thread will be woken up.  The runtime guarantees that
+--     the woken thread completes its 'putMVar' operation.
+--
+--   * When multiple threads are blocked on an 'MVar', they are
+--     woken up in FIFO order.  This is useful for providing
+--     fairness properties of abstractions built using 'MVar's.
+--
+putMVar  :: MVar a -> a -> IO ()
+putMVar (MVar mvar#) x = IO $ \ s# ->
+    case putMVar# mvar# x s# of
+        s2# -> (# s2#, () #)
+
+-- |A non-blocking version of 'takeMVar'.  The 'tryTakeMVar' function
+-- returns immediately, with 'Nothing' if the 'MVar' was empty, or
+-- @'Just' a@ if the 'MVar' was full with contents @a@.  After 'tryTakeMVar',
+-- the 'MVar' is left empty.
+tryTakeMVar :: MVar a -> IO (Maybe a)
+tryTakeMVar (MVar m) = IO $ \ s ->
+    case tryTakeMVar# m s of
+        (# s', 0#, _ #) -> (# s', Nothing #)      -- MVar is empty
+        (# s', _,  a #) -> (# s', Just a  #)      -- MVar is full
+
+-- |A non-blocking version of 'putMVar'.  The 'tryPutMVar' function
+-- attempts to put the value @a@ into the 'MVar', returning 'True' if
+-- it was successful, or 'False' otherwise.
+tryPutMVar  :: MVar a -> a -> IO Bool
+tryPutMVar (MVar mvar#) x = IO $ \ s# ->
+    case tryPutMVar# mvar# x s# of
+        (# s, 0# #) -> (# s, False #)
+        (# s, _  #) -> (# s, True #)
+
+-- |A non-blocking version of 'readMVar'.  The 'tryReadMVar' function
+-- returns immediately, with 'Nothing' if the 'MVar' was empty, or
+-- @'Just' a@ if the 'MVar' was full with contents @a@.
+--
+-- /Since: 4.7.0.0/
+tryReadMVar :: MVar a -> IO (Maybe a)
+tryReadMVar (MVar m) = IO $ \ s ->
+    case tryReadMVar# m s of
+        (# s', 0#, _ #) -> (# s', Nothing #)      -- MVar is empty
+        (# s', _,  a #) -> (# s', Just a  #)      -- MVar is full
+
+-- |Check whether a given 'MVar' is empty.
+--
+-- Notice that the boolean value returned  is just a snapshot of
+-- the state of the MVar. By the time you get to react on its result,
+-- the MVar may have been filled (or emptied) - so be extremely
+-- careful when using this operation.   Use 'tryTakeMVar' instead if possible.
+isEmptyMVar :: MVar a -> IO Bool
+isEmptyMVar (MVar mv#) = IO $ \ s# ->
+    case isEmptyMVar# mv# s# of
+        (# s2#, flg #) -> (# s2#, isTrue# (flg /=# 0#) #)
+
+-- |Add a finalizer to an 'MVar' (GHC only).  See "Foreign.ForeignPtr" and
+-- "System.Mem.Weak" for more about finalizers.
+addMVarFinalizer :: MVar a -> IO () -> IO ()
+addMVarFinalizer (MVar m) finalizer =
+  IO $ \s -> case mkWeak# m () finalizer s of { (# s1, _ #) -> (# s1, () #) }
+
diff --git a/libraries/base/GHC/Num.lhs b/libraries/base/GHC/Num.lhs
new file mode 100644
index 000000000000..5cdf782a413e
--- /dev/null
+++ b/libraries/base/GHC/Num.lhs
@@ -0,0 +1,135 @@
+\begin{code}
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE NoImplicitPrelude, MagicHash, UnboxedTuples #-}
+{-# OPTIONS_HADDOCK hide #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.Num
+-- Copyright   :  (c) The University of Glasgow 1994-2002
+-- License     :  see libraries/base/LICENSE
+--
+-- Maintainer  :  cvs-ghc@haskell.org
+-- Stability   :  internal
+-- Portability :  non-portable (GHC Extensions)
+--
+-- The 'Num' class and the 'Integer' type.
+--
+-----------------------------------------------------------------------------
+
+module GHC.Num (module GHC.Num, module GHC.Integer) where
+
+import GHC.Base
+import GHC.Integer
+
+infixl 7  *
+infixl 6  +, -
+
+default ()              -- Double isn't available yet,
+                        -- and we shouldn't be using defaults anyway
+\end{code}
+
+%*********************************************************
+%*                                                      *
+\subsection{Standard numeric class}
+%*                                                      *
+%*********************************************************
+
+\begin{code}
+-- | Basic numeric class.
+--
+-- Minimal complete definition: all except 'negate' or @(-)@
+class  Num a  where
+    (+), (-), (*)       :: a -> a -> a
+    -- | Unary negation.
+    negate              :: a -> a
+    -- | Absolute value.
+    abs                 :: a -> a
+    -- | Sign of a number.
+    -- The functions 'abs' and 'signum' should satisfy the law:
+    --
+    -- > abs x * signum x == x
+    --
+    -- For real numbers, the 'signum' is either @-1@ (negative), @0@ (zero)
+    -- or @1@ (positive).
+    signum              :: a -> a
+    -- | Conversion from an 'Integer'.
+    -- An integer literal represents the application of the function
+    -- 'fromInteger' to the appropriate value of type 'Integer',
+    -- so such literals have type @('Num' a) => a@.
+    fromInteger         :: Integer -> a
+
+    {-# INLINE (-) #-}
+    {-# INLINE negate #-}
+    x - y               = x + negate y
+    negate x            = 0 - x
+    {-# MINIMAL (+), (*), abs, signum, fromInteger, (negate | (-)) #-}
+
+-- | the same as @'flip' ('-')@.
+--
+-- Because @-@ is treated specially in the Haskell grammar,
+-- @(-@ /e/@)@ is not a section, but an application of prefix negation.
+-- However, @('subtract'@ /exp/@)@ is equivalent to the disallowed section.
+{-# INLINE subtract #-}
+subtract :: (Num a) => a -> a -> a
+subtract x y = y - x
+\end{code}
+
+
+%*********************************************************
+%*                                                      *
+\subsection{Instances for @Int@}
+%*                                                      *
+%*********************************************************
+
+\begin{code}
+instance  Num Int  where
+    I# x + I# y = I# (x +# y)
+    I# x - I# y = I# (x -# y)
+    negate (I# x) = I# (negateInt# x)
+    I# x * I# y = I# (x *# y)
+    abs n  = if n `geInt` 0 then n else negate n
+
+    signum n | n `ltInt` 0 = negate 1
+             | n `eqInt` 0 = 0
+             | otherwise   = 1
+
+    {-# INLINE fromInteger #-}	 -- Just to be sure!
+    fromInteger i = I# (integerToInt i)
+\end{code}
+
+%*********************************************************
+%*                                                      *
+\subsection{Instances for @Word@}
+%*                                                      *
+%*********************************************************
+
+\begin{code}
+instance Num Word where
+    (W# x#) + (W# y#)      = W# (x# `plusWord#` y#)
+    (W# x#) - (W# y#)      = W# (x# `minusWord#` y#)
+    (W# x#) * (W# y#)      = W# (x# `timesWord#` y#)
+    negate (W# x#)         = W# (int2Word# (negateInt# (word2Int# x#)))
+    abs x                  = x
+    signum 0               = 0
+    signum _               = 1
+    fromInteger i          = W# (integerToWord i)
+\end{code}
+
+%*********************************************************
+%*                                                      *
+\subsection{The @Integer@ instances for @Num@}
+%*                                                      *
+%*********************************************************
+
+\begin{code}
+instance  Num Integer  where
+    (+) = plusInteger
+    (-) = minusInteger
+    (*) = timesInteger
+    negate         = negateInteger
+    fromInteger x  =  x
+
+    abs = absInteger
+    signum = signumInteger
+\end{code}
+
diff --git a/libraries/base/GHC/PArr.hs b/libraries/base/GHC/PArr.hs
new file mode 100644
index 000000000000..d569acab28af
--- /dev/null
+++ b/libraries/base/GHC/PArr.hs
@@ -0,0 +1,36 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE ParallelArrays, MagicHash #-}
+{-# OPTIONS_GHC -funbox-strict-fields #-}
+{-# OPTIONS_HADDOCK hide #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.PArr
+-- Copyright   :  (c) 2001-2011 The Data Parallel Haskell team
+-- License     :  see libraries/base/LICENSE
+-- 
+-- Maintainer  :  cvs-ghc@haskell.org
+-- Stability   :  internal
+-- Portability :  non-portable (GHC Extensions)
+--
+-- BIG UGLY HACK: The desugarer special cases this module.  Despite the uses of '-XParallelArrays',
+--                the desugarer does not load 'Data.Array.Parallel' into its global state. (Hence,
+--                the present module may not use any other piece of '-XParallelArray' syntax.)
+--
+--                This will be cleaned up when we change the internal represention of '[::]' to not
+--                rely on a wired-in type constructor.
+
+module GHC.PArr where
+
+import GHC.Base
+
+-- Representation of parallel arrays
+--
+-- Vanilla representation of parallel Haskell based on standard GHC arrays that is used if the
+-- vectorised is /not/ used.
+--
+-- NB: This definition *must* be kept in sync with `TysWiredIn.parrTyCon'!
+--
+data [::] e = PArr !Int (Array# e)
+
+type PArr = [::]   -- this synonym is to get access to '[::]' without using the special syntax
diff --git a/libraries/base/GHC/Pack.lhs b/libraries/base/GHC/Pack.lhs
new file mode 100644
index 000000000000..ba6107e548b2
--- /dev/null
+++ b/libraries/base/GHC/Pack.lhs
@@ -0,0 +1,103 @@
+\begin{code}
+{-# LANGUAGE Unsafe #-}
+{-# LANGUAGE NoImplicitPrelude, MagicHash, UnboxedTuples #-}
+{-# OPTIONS_HADDOCK hide #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.Pack
+-- Copyright   :  (c) The University of Glasgow 1997-2002
+-- License     :  see libraries/base/LICENSE
+-- 
+-- Maintainer  :  cvs-ghc@haskell.org
+-- Stability   :  internal
+-- Portability :  non-portable (GHC Extensions)
+--
+-- This module provides a small set of low-level functions for packing
+-- and unpacking a chunk of bytes. Used by code emitted by the compiler
+-- plus the prelude libraries.
+-- 
+-- The programmer level view of packed strings is provided by a GHC
+-- system library PackedString.
+--
+-----------------------------------------------------------------------------
+
+module GHC.Pack
+       (
+        -- (**) - emitted by compiler.
+
+        packCString#,
+        unpackCString,
+        unpackCString#,
+        unpackNBytes#,
+        unpackFoldrCString#,  -- (**)
+        unpackAppendCString#,  -- (**)
+       ) 
+        where
+
+import GHC.Base
+import GHC.List ( length )
+import GHC.ST
+import GHC.Ptr
+
+data ByteArray ix              = ByteArray        ix ix ByteArray#
+data MutableByteArray s ix     = MutableByteArray ix ix (MutableByteArray# s)
+
+unpackCString :: Ptr a -> [Char]
+unpackCString a@(Ptr addr)
+  | a == nullPtr  = []
+  | otherwise      = unpackCString# addr
+
+packCString#         :: [Char]          -> ByteArray#
+packCString# str = case (packString str) of { ByteArray _ _ bytes -> bytes }
+
+packString :: [Char] -> ByteArray Int
+packString str = runST (packStringST str)
+
+packStringST :: [Char] -> ST s (ByteArray Int)
+packStringST str =
+  let len = length str  in
+  packNBytesST len str
+
+packNBytesST :: Int -> [Char] -> ST s (ByteArray Int)
+packNBytesST (I# length#) str =
+  {- 
+   allocate an array that will hold the string
+   (not forgetting the NUL byte at the end)
+  -}
+ new_ps_array (length# +# 1#) >>= \ ch_array ->
+   -- fill in packed string from "str"
+ fill_in ch_array 0# str   >>
+   -- freeze the puppy:
+ freeze_ps_array ch_array length#
+ where
+  fill_in :: MutableByteArray s Int -> Int# -> [Char] -> ST s ()
+  fill_in arr_in# idx [] =
+   write_ps_array arr_in# idx (chr# 0#) >>
+   return ()
+
+  fill_in arr_in# idx (C# c : cs) =
+   write_ps_array arr_in# idx c  >>
+   fill_in arr_in# (idx +# 1#) cs
+
+-- (Very :-) ``Specialised'' versions of some CharArray things...
+
+new_ps_array    :: Int# -> ST s (MutableByteArray s Int)
+write_ps_array  :: MutableByteArray s Int -> Int# -> Char# -> ST s () 
+freeze_ps_array :: MutableByteArray s Int -> Int# -> ST s (ByteArray Int)
+
+new_ps_array size = ST $ \ s ->
+    case (newByteArray# size s)   of { (# s2#, barr# #) ->
+    (# s2#, MutableByteArray bot bot barr# #) }
+  where
+    bot = error "new_ps_array"
+
+write_ps_array (MutableByteArray _ _ barr#) n ch = ST $ \ s# ->
+    case writeCharArray# barr# n ch s#  of { s2#   ->
+    (# s2#, () #) }
+
+-- same as unsafeFreezeByteArray
+freeze_ps_array (MutableByteArray _ _ arr#) len# = ST $ \ s# ->
+    case unsafeFreezeByteArray# arr# s# of { (# s2#, frozen# #) ->
+    (# s2#, ByteArray 0 (I# len#) frozen# #) }
+\end{code}
diff --git a/libraries/base/GHC/Profiling.hs b/libraries/base/GHC/Profiling.hs
new file mode 100644
index 000000000000..c0322187cb8c
--- /dev/null
+++ b/libraries/base/GHC/Profiling.hs
@@ -0,0 +1,5 @@
+-- | /Since: 4.7.0.0/
+module GHC.Profiling where
+
+foreign import ccall startProfTimer :: IO ()
+foreign import ccall stopProfTimer :: IO ()
diff --git a/libraries/base/GHC/Ptr.lhs b/libraries/base/GHC/Ptr.lhs
new file mode 100644
index 000000000000..a55f01e9b130
--- /dev/null
+++ b/libraries/base/GHC/Ptr.lhs
@@ -0,0 +1,177 @@
+\begin{code}
+{-# LANGUAGE Unsafe #-}
+{-# LANGUAGE CPP, NoImplicitPrelude, MagicHash, RoleAnnotations #-}
+{-# OPTIONS_HADDOCK hide #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.Ptr
+-- Copyright   :  (c) The FFI Task Force, 2000-2002
+-- License     :  see libraries/base/LICENSE
+-- 
+-- Maintainer  :  ffi@haskell.org
+-- Stability   :  internal
+-- Portability :  non-portable (GHC Extensions)
+--
+-- The 'Ptr' and 'FunPtr' types and operations.
+--
+-----------------------------------------------------------------------------
+
+module GHC.Ptr (
+        Ptr(..), FunPtr(..),
+        nullPtr, castPtr, plusPtr, alignPtr, minusPtr,
+        nullFunPtr, castFunPtr,
+
+        -- * Unsafe functions
+        castFunPtrToPtr, castPtrToFunPtr
+    ) where
+
+import GHC.Base
+import GHC.Show
+import GHC.Num
+import GHC.List ( length, replicate )
+import Numeric          ( showHex )
+
+#include "MachDeps.h"
+
+------------------------------------------------------------------------
+-- Data pointers.
+
+-- The role of Ptr's parameter is phantom, as there is no relation between
+-- the Haskell representation and whathever the user puts at the end of the
+-- pointer. And phantom is useful to implement castPtr (see #9163)
+
+-- redundant role annotation checks that this doesn't change
+type role Ptr phantom  
+data Ptr a = Ptr Addr# deriving (Eq, Ord)
+-- ^ A value of type @'Ptr' a@ represents a pointer to an object, or an
+-- array of objects, which may be marshalled to or from Haskell values
+-- of type @a@.
+--
+-- The type @a@ will often be an instance of class
+-- 'Foreign.Storable.Storable' which provides the marshalling operations.
+-- However this is not essential, and you can provide your own operations
+-- to access the pointer.  For example you might write small foreign
+-- functions to get or set the fields of a C @struct@.
+
+-- |The constant 'nullPtr' contains a distinguished value of 'Ptr'
+-- that is not associated with a valid memory location.
+nullPtr :: Ptr a
+nullPtr = Ptr nullAddr#
+
+-- |The 'castPtr' function casts a pointer from one type to another.
+castPtr :: Ptr a -> Ptr b
+castPtr = coerce
+
+-- |Advances the given address by the given offset in bytes.
+plusPtr :: Ptr a -> Int -> Ptr b
+plusPtr (Ptr addr) (I# d) = Ptr (plusAddr# addr d)
+
+-- |Given an arbitrary address and an alignment constraint,
+-- 'alignPtr' yields the next higher address that fulfills the
+-- alignment constraint.  An alignment constraint @x@ is fulfilled by
+-- any address divisible by @x@.  This operation is idempotent.
+alignPtr :: Ptr a -> Int -> Ptr a
+alignPtr addr@(Ptr a) (I# i)
+  = case remAddr# a i of {
+      0# -> addr;
+      n -> Ptr (plusAddr# a (i -# n)) }
+
+-- |Computes the offset required to get from the second to the first
+-- argument.  We have 
+--
+-- > p2 == p1 `plusPtr` (p2 `minusPtr` p1)
+minusPtr :: Ptr a -> Ptr b -> Int
+minusPtr (Ptr a1) (Ptr a2) = I# (minusAddr# a1 a2)
+
+------------------------------------------------------------------------
+-- Function pointers for the default calling convention.
+
+-- 'FunPtr' has a phantom role for similar reasons to 'Ptr'. Note
+-- that 'FunPtr's role cannot become nominal without changes elsewhere
+-- in GHC. See Note [FFI type roles] in TcForeign.
+type role FunPtr phantom
+data FunPtr a = FunPtr Addr# deriving (Eq, Ord)
+-- ^ A value of type @'FunPtr' a@ is a pointer to a function callable
+-- from foreign code.  The type @a@ will normally be a /foreign type/,
+-- a function type with zero or more arguments where
+--
+-- * the argument types are /marshallable foreign types/,
+--   i.e. 'Char', 'Int', 'Double', 'Float',
+--   'Bool', 'Data.Int.Int8', 'Data.Int.Int16', 'Data.Int.Int32',
+--   'Data.Int.Int64', 'Data.Word.Word8', 'Data.Word.Word16',
+--   'Data.Word.Word32', 'Data.Word.Word64', @'Ptr' a@, @'FunPtr' a@,
+--   @'Foreign.StablePtr.StablePtr' a@ or a renaming of any of these
+--   using @newtype@.
+-- 
+-- * the return type is either a marshallable foreign type or has the form
+--   @'IO' t@ where @t@ is a marshallable foreign type or @()@.
+--
+-- A value of type @'FunPtr' a@ may be a pointer to a foreign function,
+-- either returned by another foreign function or imported with a
+-- a static address import like
+--
+-- > foreign import ccall "stdlib.h &free"
+-- >   p_free :: FunPtr (Ptr a -> IO ())
+--
+-- or a pointer to a Haskell function created using a /wrapper/ stub
+-- declared to produce a 'FunPtr' of the correct type.  For example:
+--
+-- > type Compare = Int -> Int -> Bool
+-- > foreign import ccall "wrapper"
+-- >   mkCompare :: Compare -> IO (FunPtr Compare)
+--
+-- Calls to wrapper stubs like @mkCompare@ allocate storage, which
+-- should be released with 'Foreign.Ptr.freeHaskellFunPtr' when no
+-- longer required.
+--
+-- To convert 'FunPtr' values to corresponding Haskell functions, one
+-- can define a /dynamic/ stub for the specific foreign type, e.g.
+--
+-- > type IntFunction = CInt -> IO ()
+-- > foreign import ccall "dynamic" 
+-- >   mkFun :: FunPtr IntFunction -> IntFunction
+
+-- |The constant 'nullFunPtr' contains a
+-- distinguished value of 'FunPtr' that is not
+-- associated with a valid memory location.
+nullFunPtr :: FunPtr a
+nullFunPtr = FunPtr nullAddr#
+
+-- |Casts a 'FunPtr' to a 'FunPtr' of a different type.
+castFunPtr :: FunPtr a -> FunPtr b
+castFunPtr = coerce
+
+-- |Casts a 'FunPtr' to a 'Ptr'.
+--
+-- /Note:/ this is valid only on architectures where data and function
+-- pointers range over the same set of addresses, and should only be used
+-- for bindings to external libraries whose interface already relies on
+-- this assumption.
+castFunPtrToPtr :: FunPtr a -> Ptr b
+castFunPtrToPtr (FunPtr addr) = Ptr addr
+
+-- |Casts a 'Ptr' to a 'FunPtr'.
+--
+-- /Note:/ this is valid only on architectures where data and function
+-- pointers range over the same set of addresses, and should only be used
+-- for bindings to external libraries whose interface already relies on
+-- this assumption.
+castPtrToFunPtr :: Ptr a -> FunPtr b
+castPtrToFunPtr (Ptr addr) = FunPtr addr
+
+
+------------------------------------------------------------------------
+-- Show instances for Ptr and FunPtr
+
+instance Show (Ptr a) where
+   showsPrec _ (Ptr a) rs = pad_out (showHex (wordToInteger(int2Word#(addr2Int# a))) "")
+     where
+        -- want 0s prefixed to pad it out to a fixed length.
+       pad_out ls = 
+          '0':'x':(replicate (2*SIZEOF_HSPTR - length ls) '0') ++ ls ++ rs
+
+instance Show (FunPtr a) where
+   showsPrec p = showsPrec p . castFunPtrToPtr
+
+\end{code}
diff --git a/libraries/base/GHC/Read.lhs b/libraries/base/GHC/Read.lhs
new file mode 100644
index 000000000000..ab730e66521e
--- /dev/null
+++ b/libraries/base/GHC/Read.lhs
@@ -0,0 +1,682 @@
+\begin{code}
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE NoImplicitPrelude, StandaloneDeriving, ScopedTypeVariables #-}
+{-# OPTIONS_HADDOCK hide #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.Read
+-- Copyright   :  (c) The University of Glasgow, 1994-2002
+-- License     :  see libraries/base/LICENSE
+-- 
+-- Maintainer  :  cvs-ghc@haskell.org
+-- Stability   :  internal
+-- Portability :  non-portable (GHC Extensions)
+--
+-- The 'Read' class and instances for basic data types.
+--
+-----------------------------------------------------------------------------
+
+module GHC.Read
+  ( Read(..)   -- class
+
+  -- ReadS type
+  , ReadS
+
+  -- H2010 compatibility
+  , lex
+  , lexLitChar
+  , readLitChar
+  , lexDigits
+
+  -- defining readers
+  , lexP, expectP
+  , paren
+  , parens
+  , list
+  , choose
+  , readListDefault, readListPrecDefault
+  , readNumber
+
+  -- Temporary
+  , readParen
+  )
+ where
+
+import qualified Text.ParserCombinators.ReadP as P
+
+import Text.ParserCombinators.ReadP
+  ( ReadS
+  , readP_to_S
+  )
+
+import qualified Text.Read.Lex as L
+-- Lex exports 'lex', which is also defined here,
+-- hence the qualified import.
+-- We can't import *anything* unqualified, because that
+-- confuses Haddock.
+
+import Text.ParserCombinators.ReadPrec
+
+import Data.Maybe
+
+import {-# SOURCE #-} GHC.Unicode       ( isDigit )
+import GHC.Num
+import GHC.Real
+import GHC.Float
+import GHC.Show
+import GHC.Base
+import GHC.Arr
+\end{code}
+
+
+\begin{code}
+-- | @'readParen' 'True' p@ parses what @p@ parses, but surrounded with
+-- parentheses.
+--
+-- @'readParen' 'False' p@ parses what @p@ parses, but optionally
+-- surrounded with parentheses.
+readParen       :: Bool -> ReadS a -> ReadS a
+-- A Haskell 2010 function
+readParen b g   =  if b then mandatory else optional
+                   where optional r  = g r ++ mandatory r
+                         mandatory r = do
+                                ("(",s) <- lex r
+                                (x,t)   <- optional s
+                                (")",u) <- lex t
+                                return (x,u)
+\end{code}
+
+
+%*********************************************************
+%*                                                      *
+\subsection{The @Read@ class}
+%*                                                      *
+%*********************************************************
+
+\begin{code}
+------------------------------------------------------------------------
+-- class Read
+
+-- | Parsing of 'String's, producing values.
+--
+-- Minimal complete definition: 'readsPrec' (or, for GHC only, 'readPrec')
+--
+-- Derived instances of 'Read' make the following assumptions, which
+-- derived instances of 'Text.Show.Show' obey:
+--
+-- * If the constructor is defined to be an infix operator, then the
+--   derived 'Read' instance will parse only infix applications of
+--   the constructor (not the prefix form).
+--
+-- * Associativity is not used to reduce the occurrence of parentheses,
+--   although precedence may be.
+--
+-- * If the constructor is defined using record syntax, the derived 'Read'
+--   will parse only the record-syntax form, and furthermore, the fields
+--   must be given in the same order as the original declaration.
+--
+-- * The derived 'Read' instance allows arbitrary Haskell whitespace
+--   between tokens of the input string.  Extra parentheses are also
+--   allowed.
+--
+-- For example, given the declarations
+--
+-- > infixr 5 :^:
+-- > data Tree a =  Leaf a  |  Tree a :^: Tree a
+--
+-- the derived instance of 'Read' in Haskell 2010 is equivalent to
+--
+-- > instance (Read a) => Read (Tree a) where
+-- >
+-- >         readsPrec d r =  readParen (d > app_prec)
+-- >                          (\r -> [(Leaf m,t) |
+-- >                                  ("Leaf",s) <- lex r,
+-- >                                  (m,t) <- readsPrec (app_prec+1) s]) r
+-- >
+-- >                       ++ readParen (d > up_prec)
+-- >                          (\r -> [(u:^:v,w) |
+-- >                                  (u,s) <- readsPrec (up_prec+1) r,
+-- >                                  (":^:",t) <- lex s,
+-- >                                  (v,w) <- readsPrec (up_prec+1) t]) r
+-- >
+-- >           where app_prec = 10
+-- >                 up_prec = 5
+--
+-- Note that right-associativity of @:^:@ is unused.
+--
+-- The derived instance in GHC is equivalent to
+--
+-- > instance (Read a) => Read (Tree a) where
+-- >
+-- >         readPrec = parens $ (prec app_prec $ do
+-- >                                  Ident "Leaf" <- lexP
+-- >                                  m <- step readPrec
+-- >                                  return (Leaf m))
+-- >
+-- >                      +++ (prec up_prec $ do
+-- >                                  u <- step readPrec
+-- >                                  Symbol ":^:" <- lexP
+-- >                                  v <- step readPrec
+-- >                                  return (u :^: v))
+-- >
+-- >           where app_prec = 10
+-- >                 up_prec = 5
+-- >
+-- >         readListPrec = readListPrecDefault
+
+class Read a where
+  -- | attempts to parse a value from the front of the string, returning
+  -- a list of (parsed value, remaining string) pairs.  If there is no
+  -- successful parse, the returned list is empty.
+  --
+  -- Derived instances of 'Read' and 'Text.Show.Show' satisfy the following:
+  --
+  -- * @(x,\"\")@ is an element of
+  --   @('readsPrec' d ('Text.Show.showsPrec' d x \"\"))@.
+  --
+  -- That is, 'readsPrec' parses the string produced by
+  -- 'Text.Show.showsPrec', and delivers the value that
+  -- 'Text.Show.showsPrec' started with.
+
+  readsPrec    :: Int   -- ^ the operator precedence of the enclosing
+                        -- context (a number from @0@ to @11@).
+                        -- Function application has precedence @10@.
+                -> ReadS a
+
+  -- | The method 'readList' is provided to allow the programmer to
+  -- give a specialised way of parsing lists of values.
+  -- For example, this is used by the predefined 'Read' instance of
+  -- the 'Char' type, where values of type 'String' should be are
+  -- expected to use double quotes, rather than square brackets.
+  readList     :: ReadS [a]
+
+  -- | Proposed replacement for 'readsPrec' using new-style parsers (GHC only).
+  readPrec     :: ReadPrec a
+
+  -- | Proposed replacement for 'readList' using new-style parsers (GHC only).
+  -- The default definition uses 'readList'.  Instances that define 'readPrec'
+  -- should also define 'readListPrec' as 'readListPrecDefault'.
+  readListPrec :: ReadPrec [a]
+  
+  -- default definitions
+  readsPrec    = readPrec_to_S readPrec
+  readList     = readPrec_to_S (list readPrec) 0
+  readPrec     = readS_to_Prec readsPrec
+  readListPrec = readS_to_Prec (\_ -> readList)
+  {-# MINIMAL readsPrec | readPrec #-}
+
+readListDefault :: Read a => ReadS [a]
+-- ^ A possible replacement definition for the 'readList' method (GHC only).
+--   This is only needed for GHC, and even then only for 'Read' instances
+--   where 'readListPrec' isn't defined as 'readListPrecDefault'.
+readListDefault = readPrec_to_S readListPrec 0
+
+readListPrecDefault :: Read a => ReadPrec [a]
+-- ^ A possible replacement definition for the 'readListPrec' method,
+--   defined using 'readPrec' (GHC only).
+readListPrecDefault = list readPrec
+
+------------------------------------------------------------------------
+-- H2010 compatibility
+
+-- | The 'lex' function reads a single lexeme from the input, discarding
+-- initial white space, and returning the characters that constitute the
+-- lexeme.  If the input string contains only white space, 'lex' returns a
+-- single successful \`lexeme\' consisting of the empty string.  (Thus
+-- @'lex' \"\" = [(\"\",\"\")]@.)  If there is no legal lexeme at the
+-- beginning of the input string, 'lex' fails (i.e. returns @[]@).
+--
+-- This lexer is not completely faithful to the Haskell lexical syntax
+-- in the following respects:
+--
+-- * Qualified names are not handled properly
+--
+-- * Octal and hexadecimal numerics are not recognized as a single token
+--
+-- * Comments are not treated properly
+lex :: ReadS String             -- As defined by H2010
+lex s  = readP_to_S L.hsLex s
+
+-- | Read a string representation of a character, using Haskell
+-- source-language escape conventions.  For example:
+--
+-- > lexLitChar  "\\nHello"  =  [("\\n", "Hello")]
+--
+lexLitChar :: ReadS String      -- As defined by H2010
+lexLitChar = readP_to_S (do { (s, _) <- P.gather L.lexChar ;
+                              return s })
+        -- There was a skipSpaces before the P.gather L.lexChar,
+        -- but that seems inconsistent with readLitChar
+
+-- | Read a string representation of a character, using Haskell
+-- source-language escape conventions, and convert it to the character
+-- that it encodes.  For example:
+--
+-- > readLitChar "\\nHello"  =  [('\n', "Hello")]
+--
+readLitChar :: ReadS Char       -- As defined by H2010
+readLitChar = readP_to_S L.lexChar
+
+-- | Reads a non-empty string of decimal digits.
+lexDigits :: ReadS String
+lexDigits = readP_to_S (P.munch1 isDigit)
+
+------------------------------------------------------------------------
+-- utility parsers
+
+lexP :: ReadPrec L.Lexeme
+-- ^ Parse a single lexeme
+lexP = lift L.lex
+
+expectP :: L.Lexeme -> ReadPrec ()
+expectP lexeme = lift (L.expect lexeme)
+
+paren :: ReadPrec a -> ReadPrec a
+-- ^ @(paren p)@ parses \"(P0)\"
+--      where @p@ parses \"P0\" in precedence context zero
+paren p = do expectP (L.Punc "(")
+             x <- reset p
+             expectP (L.Punc ")")
+             return x
+
+parens :: ReadPrec a -> ReadPrec a
+-- ^ @(parens p)@ parses \"P\", \"(P0)\", \"((P0))\", etc, 
+--      where @p@ parses \"P\"  in the current precedence context
+--          and parses \"P0\" in precedence context zero
+parens p = optional
+ where
+  optional  = p +++ mandatory
+  mandatory = paren optional
+
+list :: ReadPrec a -> ReadPrec [a]
+-- ^ @(list p)@ parses a list of things parsed by @p@,
+-- using the usual square-bracket syntax.
+list readx =
+  parens
+  ( do expectP (L.Punc "[")
+       (listRest False +++ listNext)
+  )
+ where
+  listRest started =
+    do L.Punc c <- lexP
+       case c of
+         "]"           -> return []
+         "," | started -> listNext
+         _             -> pfail
+  
+  listNext =
+    do x  <- reset readx
+       xs <- listRest True
+       return (x:xs)
+
+choose :: [(String, ReadPrec a)] -> ReadPrec a
+-- ^ Parse the specified lexeme and continue as specified.
+-- Esp useful for nullary constructors; e.g.
+--    @choose [(\"A\", return A), (\"B\", return B)]@
+-- We match both Ident and Symbol because the constructor
+-- might be an operator eg @(:~:)@
+choose sps = foldr ((+++) . try_one) pfail sps
+           where
+             try_one (s,p) = do { token <- lexP ;
+                                  case token of
+                                    L.Ident s'  | s==s' -> p
+                                    L.Symbol s' | s==s' -> p
+                                    _other              -> pfail }
+\end{code}
+
+
+%*********************************************************
+%*                                                      *
+\subsection{Simple instances of Read}
+%*                                                      *
+%*********************************************************
+
+\begin{code}
+instance Read Char where
+  readPrec =
+    parens
+    ( do L.Char c <- lexP
+         return c
+    )
+
+  readListPrec =
+    parens
+    ( do L.String s <- lexP     -- Looks for "foo"
+         return s
+     +++
+      readListPrecDefault       -- Looks for ['f','o','o']
+    )                           -- (more generous than H2010 spec)
+
+  readList = readListDefault
+
+instance Read Bool where
+  readPrec =
+    parens
+    ( do L.Ident s <- lexP
+         case s of
+           "True"  -> return True
+           "False" -> return False
+           _       -> pfail
+    )
+
+  readListPrec = readListPrecDefault
+  readList     = readListDefault
+
+instance Read Ordering where
+  readPrec =
+    parens
+    ( do L.Ident s <- lexP
+         case s of
+           "LT" -> return LT
+           "EQ" -> return EQ
+           "GT" -> return GT
+           _    -> pfail
+    )
+
+  readListPrec = readListPrecDefault
+  readList     = readListDefault
+\end{code}
+
+
+%*********************************************************
+%*                                                      *
+\subsection{Structure instances of Read: Maybe, List etc}
+%*                                                      *
+%*********************************************************
+
+For structured instances of Read we start using the precedences.  The
+idea is then that 'parens (prec k p)' will fail immediately when trying
+to parse it in a context with a higher precedence level than k. But if
+there is one parenthesis parsed, then the required precedence level
+drops to 0 again, and parsing inside p may succeed.
+
+'appPrec' is just the precedence level of function application.  So,
+if we are parsing function application, we'd better require the
+precedence level to be at least 'appPrec'. Otherwise, we have to put
+parentheses around it.
+
+'step' is used to increase the precedence levels inside a
+parser, and can be used to express left- or right- associativity. For
+example, % is defined to be left associative, so we only increase
+precedence on the right hand side.
+
+Note how step is used in for example the Maybe parser to increase the
+precedence beyond appPrec, so that basically only literals and
+parenthesis-like objects such as (...) and [...] can be an argument to
+'Just'.
+
+\begin{code}
+instance Read a => Read (Maybe a) where
+  readPrec =
+    parens
+    (do expectP (L.Ident "Nothing")
+        return Nothing
+     +++
+     prec appPrec (
+        do expectP (L.Ident "Just")
+           x <- step readPrec
+           return (Just x))
+    )
+
+  readListPrec = readListPrecDefault
+  readList     = readListDefault
+
+instance Read a => Read [a] where
+  readPrec     = readListPrec
+  readListPrec = readListPrecDefault
+  readList     = readListDefault
+
+instance  (Ix a, Read a, Read b) => Read (Array a b)  where
+    readPrec = parens $ prec appPrec $
+               do expectP (L.Ident "array")
+                  theBounds <- step readPrec
+                  vals   <- step readPrec
+                  return (array theBounds vals)
+
+    readListPrec = readListPrecDefault
+    readList     = readListDefault
+
+instance Read L.Lexeme where
+  readPrec     = lexP
+  readListPrec = readListPrecDefault
+  readList     = readListDefault
+\end{code}
+
+
+%*********************************************************
+%*                                                      *
+\subsection{Numeric instances of Read}
+%*                                                      *
+%*********************************************************
+
+\begin{code}
+readNumber :: Num a => (L.Lexeme -> ReadPrec a) -> ReadPrec a
+-- Read a signed number
+readNumber convert =
+  parens
+  ( do x <- lexP
+       case x of
+         L.Symbol "-" -> do y <- lexP
+                            n <- convert y
+                            return (negate n)
+
+         _   -> convert x
+  )
+
+
+convertInt :: Num a => L.Lexeme -> ReadPrec a
+convertInt (L.Number n)
+ | Just i <- L.numberToInteger n = return (fromInteger i)
+convertInt _ = pfail
+
+convertFrac :: forall a . RealFloat a => L.Lexeme -> ReadPrec a
+convertFrac (L.Ident "NaN")      = return (0 / 0)
+convertFrac (L.Ident "Infinity") = return (1 / 0)
+convertFrac (L.Number n) = let resRange = floatRange (undefined :: a)
+                           in case L.numberToRangedRational resRange n of
+                              Nothing -> return (1 / 0)
+                              Just rat -> return $ fromRational rat
+convertFrac _            = pfail
+
+instance Read Int where
+  readPrec     = readNumber convertInt
+  readListPrec = readListPrecDefault
+  readList     = readListDefault
+
+instance Read Word where
+    readsPrec p s = [(fromInteger x, r) | (x, r) <- readsPrec p s]
+
+instance Read Integer where
+  readPrec     = readNumber convertInt
+  readListPrec = readListPrecDefault
+  readList     = readListDefault
+
+instance Read Float where
+  readPrec     = readNumber convertFrac
+  readListPrec = readListPrecDefault
+  readList     = readListDefault
+
+instance Read Double where
+  readPrec     = readNumber convertFrac
+  readListPrec = readListPrecDefault
+  readList     = readListDefault
+
+instance (Integral a, Read a) => Read (Ratio a) where
+  readPrec =
+    parens
+    ( prec ratioPrec
+      ( do x <- step readPrec
+           expectP (L.Symbol "%")
+           y <- step readPrec
+           return (x % y)
+      )
+    )
+
+  readListPrec = readListPrecDefault
+  readList     = readListDefault
+\end{code}
+
+
+%*********************************************************
+%*                                                      *
+        Tuple instances of Read, up to size 15
+%*                                                      *
+%*********************************************************
+
+\begin{code}
+instance Read () where
+  readPrec =
+    parens
+    ( paren
+      ( return ()
+      )
+    )
+
+  readListPrec = readListPrecDefault
+  readList     = readListDefault
+
+instance (Read a, Read b) => Read (a,b) where
+  readPrec = wrap_tup read_tup2
+  readListPrec = readListPrecDefault
+  readList     = readListDefault
+
+wrap_tup :: ReadPrec a -> ReadPrec a
+wrap_tup p = parens (paren p)
+
+read_comma :: ReadPrec ()
+read_comma = expectP (L.Punc ",")
+
+read_tup2 :: (Read a, Read b) => ReadPrec (a,b)
+-- Reads "a , b"  no parens!
+read_tup2 = do x <- readPrec
+               read_comma
+               y <- readPrec
+               return (x,y)
+
+read_tup4 :: (Read a, Read b, Read c, Read d) => ReadPrec (a,b,c,d)
+read_tup4 = do  (a,b) <- read_tup2
+                read_comma
+                (c,d) <- read_tup2
+                return (a,b,c,d)
+
+
+read_tup8 :: (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h)
+          => ReadPrec (a,b,c,d,e,f,g,h)
+read_tup8 = do  (a,b,c,d) <- read_tup4
+                read_comma
+                (e,f,g,h) <- read_tup4
+                return (a,b,c,d,e,f,g,h)
+
+
+instance (Read a, Read b, Read c) => Read (a, b, c) where
+  readPrec = wrap_tup (do { (a,b) <- read_tup2; read_comma 
+                          ; c <- readPrec 
+                          ; return (a,b,c) })
+  readListPrec = readListPrecDefault
+  readList     = readListDefault
+
+instance (Read a, Read b, Read c, Read d) => Read (a, b, c, d) where
+  readPrec = wrap_tup read_tup4
+  readListPrec = readListPrecDefault
+  readList     = readListDefault
+
+instance (Read a, Read b, Read c, Read d, Read e) => Read (a, b, c, d, e) where
+  readPrec = wrap_tup (do { (a,b,c,d) <- read_tup4; read_comma
+                          ; e <- readPrec
+                          ; return (a,b,c,d,e) })
+  readListPrec = readListPrecDefault
+  readList     = readListDefault
+
+instance (Read a, Read b, Read c, Read d, Read e, Read f)
+        => Read (a, b, c, d, e, f) where
+  readPrec = wrap_tup (do { (a,b,c,d) <- read_tup4; read_comma
+                          ; (e,f) <- read_tup2
+                          ; return (a,b,c,d,e,f) })
+  readListPrec = readListPrecDefault
+  readList     = readListDefault
+
+instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g)
+        => Read (a, b, c, d, e, f, g) where
+  readPrec = wrap_tup (do { (a,b,c,d) <- read_tup4; read_comma
+                          ; (e,f) <- read_tup2; read_comma
+                          ; g <- readPrec
+                          ; return (a,b,c,d,e,f,g) })
+  readListPrec = readListPrecDefault
+  readList     = readListDefault
+
+instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h)
+        => Read (a, b, c, d, e, f, g, h) where
+  readPrec     = wrap_tup read_tup8
+  readListPrec = readListPrecDefault
+  readList     = readListDefault
+
+instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h,
+          Read i)
+        => Read (a, b, c, d, e, f, g, h, i) where
+  readPrec = wrap_tup (do { (a,b,c,d,e,f,g,h) <- read_tup8; read_comma
+                          ; i <- readPrec
+                          ; return (a,b,c,d,e,f,g,h,i) })
+  readListPrec = readListPrecDefault
+  readList     = readListDefault
+
+instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h,
+          Read i, Read j)
+        => Read (a, b, c, d, e, f, g, h, i, j) where
+  readPrec = wrap_tup (do { (a,b,c,d,e,f,g,h) <- read_tup8; read_comma
+                          ; (i,j) <- read_tup2
+                          ; return (a,b,c,d,e,f,g,h,i,j) })
+  readListPrec = readListPrecDefault
+  readList     = readListDefault
+
+instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h,
+          Read i, Read j, Read k)
+        => Read (a, b, c, d, e, f, g, h, i, j, k) where
+  readPrec = wrap_tup (do { (a,b,c,d,e,f,g,h) <- read_tup8; read_comma
+                          ; (i,j) <- read_tup2; read_comma
+                          ; k <- readPrec
+                          ; return (a,b,c,d,e,f,g,h,i,j,k) })
+  readListPrec = readListPrecDefault
+  readList     = readListDefault
+
+instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h,
+          Read i, Read j, Read k, Read l)
+        => Read (a, b, c, d, e, f, g, h, i, j, k, l) where
+  readPrec = wrap_tup (do { (a,b,c,d,e,f,g,h) <- read_tup8; read_comma
+                          ; (i,j,k,l) <- read_tup4
+                          ; return (a,b,c,d,e,f,g,h,i,j,k,l) })
+  readListPrec = readListPrecDefault
+  readList     = readListDefault
+
+instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h,
+          Read i, Read j, Read k, Read l, Read m)
+        => Read (a, b, c, d, e, f, g, h, i, j, k, l, m) where
+  readPrec = wrap_tup (do { (a,b,c,d,e,f,g,h) <- read_tup8; read_comma
+                          ; (i,j,k,l) <- read_tup4; read_comma
+                          ; m <- readPrec
+                          ; return (a,b,c,d,e,f,g,h,i,j,k,l,m) })
+  readListPrec = readListPrecDefault
+  readList     = readListDefault
+
+instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h,
+          Read i, Read j, Read k, Read l, Read m, Read n)
+        => Read (a, b, c, d, e, f, g, h, i, j, k, l, m, n) where
+  readPrec = wrap_tup (do { (a,b,c,d,e,f,g,h) <- read_tup8; read_comma
+                          ; (i,j,k,l) <- read_tup4; read_comma
+                          ; (m,n) <- read_tup2
+                          ; return (a,b,c,d,e,f,g,h,i,j,k,l,m,n) })
+  readListPrec = readListPrecDefault
+  readList     = readListDefault
+
+instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h,
+          Read i, Read j, Read k, Read l, Read m, Read n, Read o)
+        => Read (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) where
+  readPrec = wrap_tup (do { (a,b,c,d,e,f,g,h) <- read_tup8; read_comma
+                          ; (i,j,k,l) <- read_tup4; read_comma
+                          ; (m,n) <- read_tup2; read_comma
+                          ; o <- readPrec
+                          ; return (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) })
+  readListPrec = readListPrecDefault
+  readList     = readListDefault
+\end{code}
+
diff --git a/libraries/base/GHC/Real.lhs b/libraries/base/GHC/Real.lhs
new file mode 100644
index 000000000000..d70dd819d912
--- /dev/null
+++ b/libraries/base/GHC/Real.lhs
@@ -0,0 +1,729 @@
+\begin{code}
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE CPP, NoImplicitPrelude, MagicHash, UnboxedTuples, BangPatterns #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# OPTIONS_HADDOCK hide #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.Real
+-- Copyright   :  (c) The University of Glasgow, 1994-2002
+-- License     :  see libraries/base/LICENSE
+--
+-- Maintainer  :  cvs-ghc@haskell.org
+-- Stability   :  internal
+-- Portability :  non-portable (GHC Extensions)
+--
+-- The types 'Ratio' and 'Rational', and the classes 'Real', 'Fractional',
+-- 'Integral', and 'RealFrac'.
+--
+-----------------------------------------------------------------------------
+
+module GHC.Real where
+
+import GHC.Base
+import GHC.Num
+import GHC.List
+import GHC.Enum
+import GHC.Show
+import {-# SOURCE #-} GHC.Exception( divZeroException, overflowException, ratioZeroDenomException )
+
+#ifdef OPTIMISE_INTEGER_GCD_LCM
+import GHC.Integer.GMP.Internals
+#endif
+
+infixr 8  ^, ^^
+infixl 7  /, `quot`, `rem`, `div`, `mod`
+infixl 7  %
+
+default ()              -- Double isn't available yet,
+                        -- and we shouldn't be using defaults anyway
+\end{code}
+
+
+%*********************************************************
+%*                                                      *
+       Divide by zero and arithmetic overflow
+%*                                                      *
+%*********************************************************
+
+We put them here because they are needed relatively early
+in the libraries before the Exception type has been defined yet.
+
+\begin{code}
+{-# NOINLINE divZeroError #-}
+divZeroError :: a
+divZeroError = raise# divZeroException
+
+{-# NOINLINE ratioZeroDenominatorError #-}
+ratioZeroDenominatorError :: a
+ratioZeroDenominatorError = raise# ratioZeroDenomException
+
+{-# NOINLINE overflowError #-}
+overflowError :: a
+overflowError = raise# overflowException
+\end{code}
+
+%*********************************************************
+%*                                                      *
+\subsection{The @Ratio@ and @Rational@ types}
+%*                                                      *
+%*********************************************************
+
+\begin{code}
+-- | Rational numbers, with numerator and denominator of some 'Integral' type.
+data  Ratio a = !a :% !a  deriving (Eq)
+
+-- | Arbitrary-precision rational numbers, represented as a ratio of
+-- two 'Integer' values.  A rational number may be constructed using
+-- the '%' operator.
+type  Rational          =  Ratio Integer
+
+ratioPrec, ratioPrec1 :: Int
+ratioPrec  = 7  -- Precedence of ':%' constructor
+ratioPrec1 = ratioPrec + 1
+
+infinity, notANumber :: Rational
+infinity   = 1 :% 0
+notANumber = 0 :% 0
+
+-- Use :%, not % for Inf/NaN; the latter would
+-- immediately lead to a runtime error, because it normalises.
+\end{code}
+
+
+\begin{code}
+-- | Forms the ratio of two integral numbers.
+{-# SPECIALISE (%) :: Integer -> Integer -> Rational #-}
+(%)                     :: (Integral a) => a -> a -> Ratio a
+
+-- | Extract the numerator of the ratio in reduced form:
+-- the numerator and denominator have no common factor and the denominator
+-- is positive.
+numerator       :: (Integral a) => Ratio a -> a
+
+-- | Extract the denominator of the ratio in reduced form:
+-- the numerator and denominator have no common factor and the denominator
+-- is positive.
+denominator     :: (Integral a) => Ratio a -> a
+\end{code}
+
+\tr{reduce} is a subsidiary function used only in this module .
+It normalises a ratio by dividing both numerator and denominator by
+their greatest common divisor.
+
+\begin{code}
+reduce ::  (Integral a) => a -> a -> Ratio a
+{-# SPECIALISE reduce :: Integer -> Integer -> Rational #-}
+reduce _ 0              =  ratioZeroDenominatorError
+reduce x y              =  (x `quot` d) :% (y `quot` d)
+                           where d = gcd x y
+\end{code}
+
+\begin{code}
+x % y                   =  reduce (x * signum y) (abs y)
+
+numerator   (x :% _)    =  x
+denominator (_ :% y)    =  y
+\end{code}
+
+
+%*********************************************************
+%*                                                      *
+\subsection{Standard numeric classes}
+%*                                                      *
+%*********************************************************
+
+\begin{code}
+class  (Num a, Ord a) => Real a  where
+    -- | the rational equivalent of its real argument with full precision
+    toRational          ::  a -> Rational
+
+-- | Integral numbers, supporting integer division.
+--
+-- Minimal complete definition: 'quotRem' and 'toInteger'
+class  (Real a, Enum a) => Integral a  where
+    -- | integer division truncated toward zero
+    quot                :: a -> a -> a
+    -- | integer remainder, satisfying
+    --
+    -- > (x `quot` y)*y + (x `rem` y) == x
+    rem                 :: a -> a -> a
+    -- | integer division truncated toward negative infinity
+    div                 :: a -> a -> a
+    -- | integer modulus, satisfying
+    --
+    -- > (x `div` y)*y + (x `mod` y) == x
+    mod                 :: a -> a -> a
+    -- | simultaneous 'quot' and 'rem'
+    quotRem             :: a -> a -> (a,a)
+    -- | simultaneous 'div' and 'mod'
+    divMod              :: a -> a -> (a,a)
+    -- | conversion to 'Integer'
+    toInteger           :: a -> Integer
+
+    {-# INLINE quot #-}
+    {-# INLINE rem #-}
+    {-# INLINE div #-}
+    {-# INLINE mod #-}
+    n `quot` d          =  q  where (q,_) = quotRem n d
+    n `rem` d           =  r  where (_,r) = quotRem n d
+    n `div` d           =  q  where (q,_) = divMod n d
+    n `mod` d           =  r  where (_,r) = divMod n d
+
+    divMod n d          =  if signum r == negate (signum d) then (q-1, r+d) else qr
+                           where qr@(q,r) = quotRem n d
+
+-- | Fractional numbers, supporting real division.
+--
+-- Minimal complete definition: 'fromRational' and ('recip' or @('/')@)
+class  (Num a) => Fractional a  where
+    -- | fractional division
+    (/)                 :: a -> a -> a
+    -- | reciprocal fraction
+    recip               :: a -> a
+    -- | Conversion from a 'Rational' (that is @'Ratio' 'Integer'@).
+    -- A floating literal stands for an application of 'fromRational'
+    -- to a value of type 'Rational', so such literals have type
+    -- @('Fractional' a) => a@.
+    fromRational        :: Rational -> a
+
+    {-# INLINE recip #-}
+    {-# INLINE (/) #-}
+    recip x             =  1 / x
+    x / y               = x * recip y
+    {-# MINIMAL fromRational, (recip | (/)) #-}
+
+-- | Extracting components of fractions.
+--
+-- Minimal complete definition: 'properFraction'
+class  (Real a, Fractional a) => RealFrac a  where
+    -- | The function 'properFraction' takes a real fractional number @x@
+    -- and returns a pair @(n,f)@ such that @x = n+f@, and:
+    --
+    -- * @n@ is an integral number with the same sign as @x@; and
+    --
+    -- * @f@ is a fraction with the same type and sign as @x@,
+    --   and with absolute value less than @1@.
+    --
+    -- The default definitions of the 'ceiling', 'floor', 'truncate'
+    -- and 'round' functions are in terms of 'properFraction'.
+    properFraction      :: (Integral b) => a -> (b,a)
+    -- | @'truncate' x@ returns the integer nearest @x@ between zero and @x@
+    truncate            :: (Integral b) => a -> b
+    -- | @'round' x@ returns the nearest integer to @x@;
+    --   the even integer if @x@ is equidistant between two integers
+    round               :: (Integral b) => a -> b
+    -- | @'ceiling' x@ returns the least integer not less than @x@
+    ceiling             :: (Integral b) => a -> b
+    -- | @'floor' x@ returns the greatest integer not greater than @x@
+    floor               :: (Integral b) => a -> b
+
+    {-# INLINE truncate #-}
+    truncate x          =  m  where (m,_) = properFraction x
+
+    round x             =  let (n,r) = properFraction x
+                               m     = if r < 0 then n - 1 else n + 1
+                           in case signum (abs r - 0.5) of
+                                -1 -> n
+                                0  -> if even n then n else m
+                                1  -> m
+                                _  -> error "round default defn: Bad value"
+
+    ceiling x           =  if r > 0 then n + 1 else n
+                           where (n,r) = properFraction x
+
+    floor x             =  if r < 0 then n - 1 else n
+                           where (n,r) = properFraction x
+\end{code}
+
+
+These 'numeric' enumerations come straight from the Report
+
+\begin{code}
+numericEnumFrom         :: (Fractional a) => a -> [a]
+numericEnumFrom n	=  n `seq` (n : numericEnumFrom (n + 1))
+
+numericEnumFromThen     :: (Fractional a) => a -> a -> [a]
+numericEnumFromThen n m	= n `seq` m `seq` (n : numericEnumFromThen m (m+m-n))
+
+numericEnumFromTo       :: (Ord a, Fractional a) => a -> a -> [a]
+numericEnumFromTo n m   = takeWhile (<= m + 1/2) (numericEnumFrom n)
+
+numericEnumFromThenTo   :: (Ord a, Fractional a) => a -> a -> a -> [a]
+numericEnumFromThenTo e1 e2 e3
+    = takeWhile predicate (numericEnumFromThen e1 e2)
+                                where
+                                 mid = (e2 - e1) / 2
+                                 predicate | e2 >= e1  = (<= e3 + mid)
+                                           | otherwise = (>= e3 + mid)
+\end{code}
+
+
+%*********************************************************
+%*                                                      *
+\subsection{Instances for @Int@}
+%*                                                      *
+%*********************************************************
+
+\begin{code}
+instance  Real Int  where
+    toRational x        =  toInteger x :% 1
+
+instance  Integral Int  where
+    toInteger (I# i) = smallInteger i
+
+    a `quot` b
+     | b == 0                     = divZeroError
+     | b == (-1) && a == minBound = overflowError -- Note [Order of tests]
+                                                  -- in GHC.Int
+     | otherwise                  =  a `quotInt` b
+
+    a `rem` b
+     | b == 0                     = divZeroError
+       -- The quotRem CPU instruction fails for minBound `quotRem` -1,
+       -- but minBound `rem` -1 is well-defined (0). We therefore
+       -- special-case it.
+     | b == (-1)                  = 0
+     | otherwise                  =  a `remInt` b
+
+    a `div` b
+     | b == 0                     = divZeroError
+     | b == (-1) && a == minBound = overflowError -- Note [Order of tests]
+                                                  -- in GHC.Int
+     | otherwise                  =  a `divInt` b
+
+    a `mod` b
+     | b == 0                     = divZeroError
+       -- The divMod CPU instruction fails for minBound `divMod` -1,
+       -- but minBound `mod` -1 is well-defined (0). We therefore
+       -- special-case it.
+     | b == (-1)                  = 0
+     | otherwise                  =  a `modInt` b
+
+    a `quotRem` b
+     | b == 0                     = divZeroError
+       -- Note [Order of tests] in GHC.Int
+     | b == (-1) && a == minBound = (overflowError, 0)
+     | otherwise                  =  a `quotRemInt` b
+
+    a `divMod` b
+     | b == 0                     = divZeroError
+       -- Note [Order of tests] in GHC.Int
+     | b == (-1) && a == minBound = (overflowError, 0)
+     | otherwise                  =  a `divModInt` b
+\end{code}
+
+
+%*********************************************************
+%*                                                      *
+\subsection{Instances for @Word@}
+%*                                                      *
+%*********************************************************
+
+\begin{code}
+instance Real Word where
+    toRational x = toInteger x % 1
+
+instance Integral Word where
+    quot    (W# x#) y@(W# y#)
+        | y /= 0                = W# (x# `quotWord#` y#)
+        | otherwise             = divZeroError
+    rem     (W# x#) y@(W# y#)
+        | y /= 0                = W# (x# `remWord#` y#)
+        | otherwise             = divZeroError
+    div     (W# x#) y@(W# y#)
+        | y /= 0                = W# (x# `quotWord#` y#)
+        | otherwise             = divZeroError
+    mod     (W# x#) y@(W# y#)
+        | y /= 0                = W# (x# `remWord#` y#)
+        | otherwise             = divZeroError
+    quotRem (W# x#) y@(W# y#)
+        | y /= 0                = case x# `quotRemWord#` y# of
+                                  (# q, r #) ->
+                                      (W# q, W# r)
+        | otherwise             = divZeroError
+    divMod  (W# x#) y@(W# y#)
+        | y /= 0                = (W# (x# `quotWord#` y#), W# (x# `remWord#` y#))
+        | otherwise             = divZeroError
+    toInteger (W# x#)
+        | isTrue# (i# >=# 0#)   = smallInteger i#
+        | otherwise             = wordToInteger x#
+        where
+        !i# = word2Int# x#
+
+instance Enum Word where
+    succ x
+        | x /= maxBound = x + 1
+        | otherwise     = succError "Word"
+    pred x
+        | x /= minBound = x - 1
+        | otherwise     = predError "Word"
+    toEnum i@(I# i#)
+        | i >= 0        = W# (int2Word# i#)
+        | otherwise     = toEnumError "Word" i (minBound::Word, maxBound::Word)
+    fromEnum x@(W# x#)
+        | x <= fromIntegral (maxBound::Int)
+                        = I# (word2Int# x#)
+        | otherwise     = fromEnumError "Word" x
+    enumFrom            = integralEnumFrom
+    enumFromThen        = integralEnumFromThen
+    enumFromTo          = integralEnumFromTo
+    enumFromThenTo      = integralEnumFromThenTo
+\end{code}
+
+
+%*********************************************************
+%*                                                      *
+\subsection{Instances for @Integer@}
+%*                                                      *
+%*********************************************************
+
+\begin{code}
+instance  Real Integer  where
+    toRational x        =  x :% 1
+
+-- Note [Integer division constant folding]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+--
+-- Constant folding of quot, rem, div, mod, divMod and quotRem for
+-- Integer arguments depends crucially on inlining. Constant folding
+-- rules defined in compiler/prelude/PrelRules.lhs trigger for
+-- quotInteger, remInteger and so on. So if calls to quot, rem and so on
+-- were not inlined the rules would not fire. The rules would also not
+-- fire if calls to quotInteger and so on were inlined, but this does not
+-- happen because they are all marked with NOINLINE pragma - see documentation
+-- of integer-gmp or integer-simple.
+
+instance  Integral Integer where
+    toInteger n      = n
+
+    {-# INLINE quot #-}
+    _ `quot` 0 = divZeroError
+    n `quot` d = n `quotInteger` d
+
+    {-# INLINE rem #-}
+    _ `rem` 0 = divZeroError
+    n `rem` d = n `remInteger` d
+
+    {-# INLINE div #-}
+    _ `div` 0 = divZeroError
+    n `div` d = n `divInteger` d
+
+    {-# INLINE mod #-}
+    _ `mod` 0 = divZeroError
+    n `mod` d = n `modInteger` d
+
+    {-# INLINE divMod #-}
+    _ `divMod` 0 = divZeroError
+    n `divMod` d = case n `divModInteger` d of
+                     (# x, y #) -> (x, y)
+
+    {-# INLINE quotRem #-}
+    _ `quotRem` 0 = divZeroError
+    n `quotRem` d = case n `quotRemInteger` d of
+                      (# q, r #) -> (q, r)
+\end{code}
+
+
+%*********************************************************
+%*                                                      *
+\subsection{Instances for @Ratio@}
+%*                                                      *
+%*********************************************************
+
+\begin{code}
+instance  (Integral a)  => Ord (Ratio a)  where
+    {-# SPECIALIZE instance Ord Rational #-}
+    (x:%y) <= (x':%y')  =  x * y' <= x' * y
+    (x:%y) <  (x':%y')  =  x * y' <  x' * y
+
+instance  (Integral a)  => Num (Ratio a)  where
+    {-# SPECIALIZE instance Num Rational #-}
+    (x:%y) + (x':%y')   =  reduce (x*y' + x'*y) (y*y')
+    (x:%y) - (x':%y')   =  reduce (x*y' - x'*y) (y*y')
+    (x:%y) * (x':%y')   =  reduce (x * x') (y * y')
+    negate (x:%y)       =  (-x) :% y
+    abs (x:%y)          =  abs x :% y
+    signum (x:%_)       =  signum x :% 1
+    fromInteger x       =  fromInteger x :% 1
+
+{-# RULES "fromRational/id" fromRational = id :: Rational -> Rational #-}
+instance  (Integral a)  => Fractional (Ratio a)  where
+    {-# SPECIALIZE instance Fractional Rational #-}
+    (x:%y) / (x':%y')   =  (x*y') % (y*x')
+    recip (0:%_)        = ratioZeroDenominatorError
+    recip (x:%y)
+        | x < 0         = negate y :% negate x
+        | otherwise     = y :% x
+    fromRational (x:%y) =  fromInteger x % fromInteger y
+
+instance  (Integral a)  => Real (Ratio a)  where
+    {-# SPECIALIZE instance Real Rational #-}
+    toRational (x:%y)   =  toInteger x :% toInteger y
+
+instance  (Integral a)  => RealFrac (Ratio a)  where
+    {-# SPECIALIZE instance RealFrac Rational #-}
+    properFraction (x:%y) = (fromInteger (toInteger q), r:%y)
+                          where (q,r) = quotRem x y
+
+instance  (Integral a, Show a)  => Show (Ratio a)  where
+    {-# SPECIALIZE instance Show Rational #-}
+    showsPrec p (x:%y)  =  showParen (p > ratioPrec) $
+                           showsPrec ratioPrec1 x .
+                           showString " % " .
+                           -- H98 report has spaces round the %
+                           -- but we removed them [May 04]
+                           -- and added them again for consistency with
+                           -- Haskell 98 [Sep 08, #1920]
+                           showsPrec ratioPrec1 y
+
+instance  (Integral a)  => Enum (Ratio a)  where
+    {-# SPECIALIZE instance Enum Rational #-}
+    succ x              =  x + 1
+    pred x              =  x - 1
+
+    toEnum n            =  fromIntegral n :% 1
+    fromEnum            =  fromInteger . truncate
+
+    enumFrom            =  numericEnumFrom
+    enumFromThen        =  numericEnumFromThen
+    enumFromTo          =  numericEnumFromTo
+    enumFromThenTo      =  numericEnumFromThenTo
+\end{code}
+
+
+%*********************************************************
+%*                                                      *
+\subsection{Coercions}
+%*                                                      *
+%*********************************************************
+
+\begin{code}
+-- | general coercion from integral types
+{-# NOINLINE [1] fromIntegral #-}
+fromIntegral :: (Integral a, Num b) => a -> b
+fromIntegral = fromInteger . toInteger
+
+{-# RULES
+"fromIntegral/Int->Int" fromIntegral = id :: Int -> Int
+    #-}
+
+{-# RULES
+"fromIntegral/Int->Word"  fromIntegral = \(I# x#) -> W# (int2Word# x#)
+"fromIntegral/Word->Int"  fromIntegral = \(W# x#) -> I# (word2Int# x#)
+"fromIntegral/Word->Word" fromIntegral = id :: Word -> Word
+    #-}
+
+-- | general coercion to fractional types
+realToFrac :: (Real a, Fractional b) => a -> b
+{-# NOINLINE [1] realToFrac #-}
+realToFrac = fromRational . toRational
+\end{code}
+
+%*********************************************************
+%*                                                      *
+\subsection{Overloaded numeric functions}
+%*                                                      *
+%*********************************************************
+
+\begin{code}
+-- | Converts a possibly-negative 'Real' value to a string.
+showSigned :: (Real a)
+  => (a -> ShowS)       -- ^ a function that can show unsigned values
+  -> Int                -- ^ the precedence of the enclosing context
+  -> a                  -- ^ the value to show
+  -> ShowS
+showSigned showPos p x
+   | x < 0     = showParen (p > 6) (showChar '-' . showPos (-x))
+   | otherwise = showPos x
+
+even, odd       :: (Integral a) => a -> Bool
+even n          =  n `rem` 2 == 0
+odd             =  not . even
+
+-------------------------------------------------------
+-- | raise a number to a non-negative integral power
+{-# SPECIALISE [1] (^) ::
+        Integer -> Integer -> Integer,
+        Integer -> Int -> Integer,
+        Int -> Int -> Int #-}
+{-# INLINABLE [1] (^) #-}    -- See Note [Inlining (^)]
+(^) :: (Num a, Integral b) => a -> b -> a
+x0 ^ y0 | y0 < 0    = error "Negative exponent"
+        | y0 == 0   = 1
+        | otherwise = f x0 y0
+    where -- f : x0 ^ y0 = x ^ y
+          f x y | even y    = f (x * x) (y `quot` 2)
+                | y == 1    = x
+                | otherwise = g (x * x) ((y - 1) `quot` 2) x
+          -- g : x0 ^ y0 = (x ^ y) * z
+          g x y z | even y = g (x * x) (y `quot` 2) z
+                  | y == 1 = x * z
+                  | otherwise = g (x * x) ((y - 1) `quot` 2) (x * z)
+
+-- | raise a number to an integral power
+(^^)            :: (Fractional a, Integral b) => a -> b -> a
+{-# INLINABLE [1] (^^) #-}         -- See Note [Inlining (^)
+x ^^ n          =  if n >= 0 then x^n else recip (x^(negate n))
+
+{- Note [Inlining (^)
+   ~~~~~~~~~~~~~~~~~~~~~
+   The INLINABLE pragma allows (^) to be specialised at its call sites.
+   If it is called repeatedly at the same type, that can make a huge
+   difference, because of those constants which can be repeatedly
+   calculated.
+
+   Currently the fromInteger calls are not floated because we get
+             \d1 d2 x y -> blah
+   after the gentle round of simplification. -}
+
+{- Rules for powers with known small exponent
+    see #5237
+    For small exponents, (^) is inefficient compared to manually
+    expanding the multiplication tree.
+    Here, rules for the most common exponent types are given.
+    The range of exponents for which rules are given is quite
+    arbitrary and kept small to not unduly increase the number of rules.
+    0 and 1 are excluded based on the assumption that nobody would
+    write x^0 or x^1 in code and the cases where an exponent could
+    be statically resolved to 0 or 1 are rare.
+
+    It might be desirable to have corresponding rules also for
+    exponents of other types, in particular Word, but we can't
+    have those rules here (importing GHC.Word or GHC.Int would
+    create a cyclic module dependency), and it's doubtful they
+    would fire, since the exponents of other types tend to get
+    floated out before the rule has a chance to fire.
+
+    Also desirable would be rules for (^^), but I haven't managed
+    to get those to fire.
+
+    Note: Trying to save multiplications by sharing the square for
+    exponents 4 and 5 does not save time, indeed, for Double, it is
+    up to twice slower, so the rules contain flat sequences of
+    multiplications.
+-}
+
+{-# RULES
+"^2/Int"        forall x. x ^ (2 :: Int) = let u = x in u*u
+"^3/Int"        forall x. x ^ (3 :: Int) = let u = x in u*u*u
+"^4/Int"        forall x. x ^ (4 :: Int) = let u = x in u*u*u*u
+"^5/Int"        forall x. x ^ (5 :: Int) = let u = x in u*u*u*u*u
+"^2/Integer"    forall x. x ^ (2 :: Integer) = let u = x in u*u
+"^3/Integer"    forall x. x ^ (3 :: Integer) = let u = x in u*u*u
+"^4/Integer"    forall x. x ^ (4 :: Integer) = let u = x in u*u*u*u
+"^5/Integer"    forall x. x ^ (5 :: Integer) = let u = x in u*u*u*u*u
+  #-}
+
+-------------------------------------------------------
+-- Special power functions for Rational
+--
+-- see #4337
+--
+-- Rationale:
+-- For a legitimate Rational (n :% d), the numerator and denominator are
+-- coprime, i.e. they have no common prime factor.
+-- Therefore all powers (n ^ a) and (d ^ b) are also coprime, so it is
+-- not necessary to compute the greatest common divisor, which would be
+-- done in the default implementation at each multiplication step.
+-- Since exponentiation quickly leads to very large numbers and
+-- calculation of gcds is generally very slow for large numbers,
+-- avoiding the gcd leads to an order of magnitude speedup relatively
+-- soon (and an asymptotic improvement overall).
+--
+-- Note:
+-- We cannot use these functions for general Ratio a because that would
+-- change results in a multitude of cases.
+-- The cause is that if a and b are coprime, their remainders by any
+-- positive modulus generally aren't, so in the default implementation
+-- reduction occurs.
+--
+-- Example:
+-- (17 % 3) ^ 3 :: Ratio Word8
+-- Default:
+-- (17 % 3) ^ 3 = ((17 % 3) ^ 2) * (17 % 3)
+--              = ((289 `mod` 256) % 9) * (17 % 3)
+--              = (33 % 9) * (17 % 3)
+--              = (11 % 3) * (17 % 3)
+--              = (187 % 9)
+-- But:
+-- ((17^3) `mod` 256) % (3^3)   = (4913 `mod` 256) % 27
+--                              = 49 % 27
+--
+-- TODO:
+-- Find out whether special-casing for numerator, denominator or
+-- exponent = 1 (or -1, where that may apply) gains something.
+
+-- Special version of (^) for Rational base
+{-# RULES "(^)/Rational"    (^) = (^%^) #-}
+(^%^)           :: Integral a => Rational -> a -> Rational
+(n :% d) ^%^ e
+    | e < 0     = error "Negative exponent"
+    | e == 0    = 1 :% 1
+    | otherwise = (n ^ e) :% (d ^ e)
+
+-- Special version of (^^) for Rational base
+{-# RULES "(^^)/Rational"   (^^) = (^^%^^) #-}
+(^^%^^)         :: Integral a => Rational -> a -> Rational
+(n :% d) ^^%^^ e
+    | e > 0     = (n ^ e) :% (d ^ e)
+    | e == 0    = 1 :% 1
+    | n > 0     = (d ^ (negate e)) :% (n ^ (negate e))
+    | n == 0    = ratioZeroDenominatorError
+    | otherwise = let nn = d ^ (negate e)
+                      dd = (negate n) ^ (negate e)
+                  in if even e then (nn :% dd) else (negate nn :% dd)
+
+-------------------------------------------------------
+-- | @'gcd' x y@ is the non-negative factor of both @x@ and @y@ of which
+-- every common factor of @x@ and @y@ is also a factor; for example
+-- @'gcd' 4 2 = 2@, @'gcd' (-4) 6 = 2@, @'gcd' 0 4@ = @4@. @'gcd' 0 0@ = @0@.
+-- (That is, the common divisor that is \"greatest\" in the divisibility
+-- preordering.)
+--
+-- Note: Since for signed fixed-width integer types, @'abs' 'minBound' < 0@,
+-- the result may be negative if one of the arguments is @'minBound'@ (and
+-- necessarily is if the other is @0@ or @'minBound'@) for such types.
+gcd             :: (Integral a) => a -> a -> a
+{-# NOINLINE [1] gcd #-}
+gcd x y         =  gcd' (abs x) (abs y)
+                   where gcd' a 0  =  a
+                         gcd' a b  =  gcd' b (a `rem` b)
+
+-- | @'lcm' x y@ is the smallest positive integer that both @x@ and @y@ divide.
+lcm             :: (Integral a) => a -> a -> a
+{-# SPECIALISE lcm :: Int -> Int -> Int #-}
+{-# NOINLINE [1] lcm #-}
+lcm _ 0         =  0
+lcm 0 _         =  0
+lcm x y         =  abs ((x `quot` (gcd x y)) * y)
+
+#ifdef OPTIMISE_INTEGER_GCD_LCM
+{-# RULES
+"gcd/Int->Int->Int"             gcd = gcdInt'
+"gcd/Integer->Integer->Integer" gcd = gcdInteger
+"lcm/Integer->Integer->Integer" lcm = lcmInteger
+ #-}
+
+gcdInt' :: Int -> Int -> Int
+gcdInt' (I# x) (I# y) = I# (gcdInt x y)
+#endif
+
+integralEnumFrom :: (Integral a, Bounded a) => a -> [a]
+integralEnumFrom n = map fromInteger [toInteger n .. toInteger (maxBound `asTypeOf` n)]
+
+integralEnumFromThen :: (Integral a, Bounded a) => a -> a -> [a]
+integralEnumFromThen n1 n2
+  | i_n2 >= i_n1  = map fromInteger [i_n1, i_n2 .. toInteger (maxBound `asTypeOf` n1)]
+  | otherwise     = map fromInteger [i_n1, i_n2 .. toInteger (minBound `asTypeOf` n1)]
+  where
+    i_n1 = toInteger n1
+    i_n2 = toInteger n2
+
+integralEnumFromTo :: Integral a => a -> a -> [a]
+integralEnumFromTo n m = map fromInteger [toInteger n .. toInteger m]
+
+integralEnumFromThenTo :: Integral a => a -> a -> a -> [a]
+integralEnumFromThenTo n1 n2 m
+  = map fromInteger [toInteger n1, toInteger n2 .. toInteger m]
+\end{code}
diff --git a/libraries/base/GHC/ST.lhs b/libraries/base/GHC/ST.lhs
new file mode 100644
index 000000000000..5da8b0afedb4
--- /dev/null
+++ b/libraries/base/GHC/ST.lhs
@@ -0,0 +1,170 @@
+\begin{code}
+{-# LANGUAGE Unsafe #-}
+{-# LANGUAGE NoImplicitPrelude, MagicHash, UnboxedTuples, RankNTypes #-}
+{-# OPTIONS_HADDOCK hide #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.ST
+-- Copyright   :  (c) The University of Glasgow, 1992-2002
+-- License     :  see libraries/base/LICENSE
+-- 
+-- Maintainer  :  cvs-ghc@haskell.org
+-- Stability   :  internal
+-- Portability :  non-portable (GHC Extensions)
+--
+-- The 'ST' Monad.
+--
+-----------------------------------------------------------------------------
+
+module GHC.ST (
+        ST(..), STret(..), STRep,
+        fixST, runST, runSTRep,
+
+        -- * Unsafe functions
+        liftST, unsafeInterleaveST
+    ) where
+
+import GHC.Base
+import GHC.Show
+
+default ()
+\end{code}
+
+%*********************************************************
+%*                                                      *
+\subsection{The @ST@ monad}
+%*                                                      *
+%*********************************************************
+
+The state-transformer monad proper.  By default the monad is strict;
+too many people got bitten by space leaks when it was lazy.
+
+\begin{code}
+-- | The strict state-transformer monad.
+-- A computation of type @'ST' s a@ transforms an internal state indexed
+-- by @s@, and returns a value of type @a@.
+-- The @s@ parameter is either
+--
+-- * an uninstantiated type variable (inside invocations of 'runST'), or
+--
+-- * 'RealWorld' (inside invocations of 'Control.Monad.ST.stToIO').
+--
+-- It serves to keep the internal states of different invocations
+-- of 'runST' separate from each other and from invocations of
+-- 'Control.Monad.ST.stToIO'.
+--
+-- The '>>=' and '>>' operations are strict in the state (though not in
+-- values stored in the state).  For example,
+--
+-- @'runST' (writeSTRef _|_ v >>= f) = _|_@
+newtype ST s a = ST (STRep s a)
+type STRep s a = State# s -> (# State# s, a #)
+
+instance Functor (ST s) where
+    fmap f (ST m) = ST $ \ s ->
+      case (m s) of { (# new_s, r #) ->
+      (# new_s, f r #) }
+
+instance Monad (ST s) where
+    {-# INLINE return #-}
+    {-# INLINE (>>)   #-}
+    {-# INLINE (>>=)  #-}
+    return x = ST (\ s -> (# s, x #))
+    m >> k   = m >>= \ _ -> k
+
+    (ST m) >>= k
+      = ST (\ s ->
+        case (m s) of { (# new_s, r #) ->
+        case (k r) of { ST k2 ->
+        (k2 new_s) }})
+
+data STret s a = STret (State# s) a
+
+-- liftST is useful when we want a lifted result from an ST computation.  See
+-- fixST below.
+liftST :: ST s a -> State# s -> STret s a
+liftST (ST m) = \s -> case m s of (# s', r #) -> STret s' r
+
+{-# NOINLINE unsafeInterleaveST #-}
+unsafeInterleaveST :: ST s a -> ST s a
+unsafeInterleaveST (ST m) = ST ( \ s ->
+    let
+        r = case m s of (# _, res #) -> res
+    in
+    (# s, r #)
+  )
+
+-- | Allow the result of a state transformer computation to be used (lazily)
+-- inside the computation.
+-- Note that if @f@ is strict, @'fixST' f = _|_@.
+fixST :: (a -> ST s a) -> ST s a
+fixST k = ST $ \ s ->
+    let ans       = liftST (k r) s
+        STret _ r = ans
+    in
+    case ans of STret s' x -> (# s', x #)
+
+instance  Show (ST s a)  where
+    showsPrec _ _  = showString "<<ST action>>"
+    showList       = showList__ (showsPrec 0)
+\end{code}
+
+Definition of runST
+~~~~~~~~~~~~~~~~~~~
+
+SLPJ 95/04: Why @runST@ must not have an unfolding; consider:
+\begin{verbatim}
+f x =
+  runST ( \ s -> let
+                    (a, s')  = newArray# 100 [] s
+                    (_, s'') = fill_in_array_or_something a x s'
+                  in
+                  freezeArray# a s'' )
+\end{verbatim}
+If we inline @runST@, we'll get:
+\begin{verbatim}
+f x = let
+        (a, s')  = newArray# 100 [] realWorld#{-NB-}
+        (_, s'') = fill_in_array_or_something a x s'
+      in
+      freezeArray# a s''
+\end{verbatim}
+And now the @newArray#@ binding can be floated to become a CAF, which
+is totally and utterly wrong:
+\begin{verbatim}
+f = let
+    (a, s')  = newArray# 100 [] realWorld#{-NB-} -- YIKES!!!
+    in
+    \ x ->
+        let (_, s'') = fill_in_array_or_something a x s' in
+        freezeArray# a s''
+\end{verbatim}
+All calls to @f@ will share a {\em single} array!  End SLPJ 95/04.
+
+\begin{code}
+{-# INLINE runST #-}
+-- The INLINE prevents runSTRep getting inlined in *this* module
+-- so that it is still visible when runST is inlined in an importing
+-- module.  Regrettably delicate.  runST is behaving like a wrapper.
+
+-- | Return the value computed by a state transformer computation.
+-- The @forall@ ensures that the internal state used by the 'ST'
+-- computation is inaccessible to the rest of the program.
+runST :: (forall s. ST s a) -> a
+runST st = runSTRep (case st of { ST st_rep -> st_rep })
+
+-- I'm only letting runSTRep be inlined right at the end, in particular *after* full laziness
+-- That's what the "INLINE [0]" says.
+--              SLPJ Apr 99
+-- {-# INLINE [0] runSTRep #-}
+
+-- SDM: further to the above, inline phase 0 is run *before*
+-- full-laziness at the moment, which means that the above comment is
+-- invalid.  Inlining runSTRep doesn't make a huge amount of
+-- difference, anyway.  Hence:
+
+{-# NOINLINE runSTRep #-}
+runSTRep :: (forall s. STRep s a) -> a
+runSTRep st_rep = case st_rep realWorld# of
+                        (# _, r #) -> r
+\end{code}
diff --git a/libraries/base/GHC/STRef.lhs b/libraries/base/GHC/STRef.lhs
new file mode 100644
index 000000000000..1fbc5a3d79bd
--- /dev/null
+++ b/libraries/base/GHC/STRef.lhs
@@ -0,0 +1,52 @@
+\begin{code}
+{-# LANGUAGE Unsafe #-}
+{-# LANGUAGE NoImplicitPrelude, MagicHash, UnboxedTuples #-}
+{-# OPTIONS_HADDOCK hide #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.STRef
+-- Copyright   :  (c) The University of Glasgow, 1994-2002
+-- License     :  see libraries/base/LICENSE
+--
+-- Maintainer  :  cvs-ghc@haskell.org
+-- Stability   :  internal
+-- Portability :  non-portable (GHC Extensions)
+--
+-- References in the 'ST' monad.
+--
+-----------------------------------------------------------------------------
+
+module GHC.STRef (
+        STRef(..),
+        newSTRef, readSTRef, writeSTRef
+    ) where
+
+import GHC.ST
+import GHC.Base
+
+data STRef s a = STRef (MutVar# s a)
+-- ^ a value of type @STRef s a@ is a mutable variable in state thread @s@,
+-- containing a value of type @a@
+
+-- |Build a new 'STRef' in the current state thread
+newSTRef :: a -> ST s (STRef s a)
+newSTRef init = ST $ \s1# ->
+    case newMutVar# init s1#            of { (# s2#, var# #) ->
+    (# s2#, STRef var# #) }
+
+-- |Read the value of an 'STRef'
+readSTRef :: STRef s a -> ST s a
+readSTRef (STRef var#) = ST $ \s1# -> readMutVar# var# s1#
+
+-- |Write a new value into an 'STRef'
+writeSTRef :: STRef s a -> a -> ST s ()
+writeSTRef (STRef var#) val = ST $ \s1# ->
+    case writeMutVar# var# val s1#      of { s2# ->
+    (# s2#, () #) }
+
+-- Just pointer equality on mutable references:
+instance Eq (STRef s a) where
+    STRef v1# == STRef v2# = isTrue# (sameMutVar# v1# v2#)
+
+\end{code}
diff --git a/libraries/base/GHC/Show.lhs b/libraries/base/GHC/Show.lhs
new file mode 100644
index 000000000000..45338e884599
--- /dev/null
+++ b/libraries/base/GHC/Show.lhs
@@ -0,0 +1,554 @@
+\begin{code}
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE CPP, NoImplicitPrelude, BangPatterns, StandaloneDeriving,
+             MagicHash, UnboxedTuples #-}
+{-# OPTIONS_HADDOCK hide #-}
+
+#include "MachDeps.h"
+#if SIZEOF_HSWORD == 4
+#define DIGITS       9
+#define BASE         1000000000
+#elif SIZEOF_HSWORD == 8
+#define DIGITS       18
+#define BASE         1000000000000000000
+#else
+#error Please define DIGITS and BASE
+-- DIGITS should be the largest integer such that
+--     10^DIGITS < 2^(SIZEOF_HSWORD * 8 - 1)
+-- BASE should be 10^DIGITS. Note that ^ is not available yet.
+#endif
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.Show
+-- Copyright   :  (c) The University of Glasgow, 1992-2002
+-- License     :  see libraries/base/LICENSE
+--
+-- Maintainer  :  cvs-ghc@haskell.org
+-- Stability   :  internal
+-- Portability :  non-portable (GHC Extensions)
+--
+-- The 'Show' class, and related operations.
+--
+-----------------------------------------------------------------------------
+
+module GHC.Show
+        (
+        Show(..), ShowS,
+
+        -- Instances for Show: (), [], Bool, Ordering, Int, Char
+
+        -- Show support code
+        shows, showChar, showString, showMultiLineString,
+        showParen, showList__, showSpace,
+        showLitChar, showLitString, protectEsc,
+        intToDigit, showSignedInt,
+        appPrec, appPrec1,
+
+        -- Character operations
+        asciiTab,
+  )
+        where
+
+import GHC.Base
+import GHC.Num
+import Data.Maybe
+import GHC.List ((!!), foldr1, break)
+\end{code}
+
+
+
+%*********************************************************
+%*                                                      *
+\subsection{The @Show@ class}
+%*                                                      *
+%*********************************************************
+
+\begin{code}
+-- | The @shows@ functions return a function that prepends the
+-- output 'String' to an existing 'String'.  This allows constant-time
+-- concatenation of results using function composition.
+type ShowS = String -> String
+
+-- | Conversion of values to readable 'String's.
+--
+-- Minimal complete definition: 'showsPrec' or 'show'.
+--
+-- Derived instances of 'Show' have the following properties, which
+-- are compatible with derived instances of 'Text.Read.Read':
+--
+-- * The result of 'show' is a syntactically correct Haskell
+--   expression containing only constants, given the fixity
+--   declarations in force at the point where the type is declared.
+--   It contains only the constructor names defined in the data type,
+--   parentheses, and spaces.  When labelled constructor fields are
+--   used, braces, commas, field names, and equal signs are also used.
+--
+-- * If the constructor is defined to be an infix operator, then
+--   'showsPrec' will produce infix applications of the constructor.
+--
+-- * the representation will be enclosed in parentheses if the
+--   precedence of the top-level constructor in @x@ is less than @d@
+--   (associativity is ignored).  Thus, if @d@ is @0@ then the result
+--   is never surrounded in parentheses; if @d@ is @11@ it is always
+--   surrounded in parentheses, unless it is an atomic expression.
+--
+-- * If the constructor is defined using record syntax, then 'show'
+--   will produce the record-syntax form, with the fields given in the
+--   same order as the original declaration.
+--
+-- For example, given the declarations
+--
+-- > infixr 5 :^:
+-- > data Tree a =  Leaf a  |  Tree a :^: Tree a
+--
+-- the derived instance of 'Show' is equivalent to
+--
+-- > instance (Show a) => Show (Tree a) where
+-- >
+-- >        showsPrec d (Leaf m) = showParen (d > app_prec) $
+-- >             showString "Leaf " . showsPrec (app_prec+1) m
+-- >          where app_prec = 10
+-- >
+-- >        showsPrec d (u :^: v) = showParen (d > up_prec) $
+-- >             showsPrec (up_prec+1) u .
+-- >             showString " :^: "      .
+-- >             showsPrec (up_prec+1) v
+-- >          where up_prec = 5
+--
+-- Note that right-associativity of @:^:@ is ignored.  For example,
+--
+-- * @'show' (Leaf 1 :^: Leaf 2 :^: Leaf 3)@ produces the string
+--   @\"Leaf 1 :^: (Leaf 2 :^: Leaf 3)\"@.
+
+class  Show a  where
+    -- | Convert a value to a readable 'String'.
+    --
+    -- 'showsPrec' should satisfy the law
+    --
+    -- > showsPrec d x r ++ s  ==  showsPrec d x (r ++ s)
+    --
+    -- Derived instances of 'Text.Read.Read' and 'Show' satisfy the following:
+    --
+    -- * @(x,\"\")@ is an element of
+    --   @('Text.Read.readsPrec' d ('showsPrec' d x \"\"))@.
+    --
+    -- That is, 'Text.Read.readsPrec' parses the string produced by
+    -- 'showsPrec', and delivers the value that 'showsPrec' started with.
+
+    showsPrec :: Int    -- ^ the operator precedence of the enclosing
+                        -- context (a number from @0@ to @11@).
+                        -- Function application has precedence @10@.
+              -> a      -- ^ the value to be converted to a 'String'
+              -> ShowS
+
+    -- | A specialised variant of 'showsPrec', using precedence context
+    -- zero, and returning an ordinary 'String'.
+    show      :: a   -> String
+
+    -- | The method 'showList' is provided to allow the programmer to
+    -- give a specialised way of showing lists of values.
+    -- For example, this is used by the predefined 'Show' instance of
+    -- the 'Char' type, where values of type 'String' should be shown
+    -- in double quotes, rather than between square brackets.
+    showList  :: [a] -> ShowS
+
+    showsPrec _ x s = show x ++ s
+    show x          = shows x ""
+    showList ls   s = showList__ shows ls s
+    {-# MINIMAL showsPrec | show #-}
+
+showList__ :: (a -> ShowS) ->  [a] -> ShowS
+showList__ _     []     s = "[]" ++ s
+showList__ showx (x:xs) s = '[' : showx x (showl xs)
+  where
+    showl []     = ']' : s
+    showl (y:ys) = ',' : showx y (showl ys)
+
+appPrec, appPrec1 :: Int
+        -- Use unboxed stuff because we don't have overloaded numerics yet
+appPrec = I# 10#        -- Precedence of application:
+                        --   one more than the maximum operator precedence of 9
+appPrec1 = I# 11#       -- appPrec + 1
+\end{code}
+
+%*********************************************************
+%*                                                      *
+\subsection{Simple Instances}
+%*                                                      *
+%*********************************************************
+
+\begin{code}
+
+instance  Show ()  where
+    showsPrec _ () = showString "()"
+
+instance Show a => Show [a]  where
+    showsPrec _         = showList
+
+instance Show Bool where
+  showsPrec _ True  = showString "True"
+  showsPrec _ False = showString "False"
+
+instance Show Ordering where
+  showsPrec _ LT = showString "LT"
+  showsPrec _ EQ = showString "EQ"
+  showsPrec _ GT = showString "GT"
+
+instance  Show Char  where
+    showsPrec _ '\'' = showString "'\\''"
+    showsPrec _ c    = showChar '\'' . showLitChar c . showChar '\''
+
+    showList cs = showChar '"' . showLitString cs . showChar '"'
+
+instance Show Int where
+    showsPrec = showSignedInt
+
+instance Show Word where
+    showsPrec _ (W# w) = showWord w
+
+showWord :: Word# -> ShowS
+showWord w# cs
+ | isTrue# (w# `ltWord#` 10##) = C# (chr# (ord# '0'# +# word2Int# w#)) : cs
+ | otherwise = case chr# (ord# '0'# +# word2Int# (w# `remWord#` 10##)) of
+               c# ->
+                   showWord (w# `quotWord#` 10##) (C# c# : cs)
+
+instance Show a => Show (Maybe a) where
+    showsPrec _p Nothing s = showString "Nothing" s
+    showsPrec p (Just x) s
+                          = (showParen (p > appPrec) $
+                             showString "Just " .
+                             showsPrec appPrec1 x) s
+\end{code}
+
+
+%*********************************************************
+%*                                                      *
+\subsection{Show instances for the first few tuples
+%*                                                      *
+%*********************************************************
+
+\begin{code}
+-- The explicit 's' parameters are important
+-- Otherwise GHC thinks that "shows x" might take a lot of work to compute
+-- and generates defns like
+--      showsPrec _ (x,y) = let sx = shows x; sy = shows y in
+--                          \s -> showChar '(' (sx (showChar ',' (sy (showChar ')' s))))
+
+instance  (Show a, Show b) => Show (a,b)  where
+  showsPrec _ (a,b) s = show_tuple [shows a, shows b] s
+
+instance (Show a, Show b, Show c) => Show (a, b, c) where
+  showsPrec _ (a,b,c) s = show_tuple [shows a, shows b, shows c] s
+
+instance (Show a, Show b, Show c, Show d) => Show (a, b, c, d) where
+  showsPrec _ (a,b,c,d) s = show_tuple [shows a, shows b, shows c, shows d] s
+
+instance (Show a, Show b, Show c, Show d, Show e) => Show (a, b, c, d, e) where
+  showsPrec _ (a,b,c,d,e) s = show_tuple [shows a, shows b, shows c, shows d, shows e] s
+
+instance (Show a, Show b, Show c, Show d, Show e, Show f) => Show (a,b,c,d,e,f) where
+  showsPrec _ (a,b,c,d,e,f) s = show_tuple [shows a, shows b, shows c, shows d, shows e, shows f] s
+
+instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g)
+        => Show (a,b,c,d,e,f,g) where
+  showsPrec _ (a,b,c,d,e,f,g) s
+        = show_tuple [shows a, shows b, shows c, shows d, shows e, shows f, shows g] s
+
+instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h)
+         => Show (a,b,c,d,e,f,g,h) where
+  showsPrec _ (a,b,c,d,e,f,g,h) s
+        = show_tuple [shows a, shows b, shows c, shows d, shows e, shows f, shows g, shows h] s
+
+instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h, Show i)
+         => Show (a,b,c,d,e,f,g,h,i) where
+  showsPrec _ (a,b,c,d,e,f,g,h,i) s
+        = show_tuple [shows a, shows b, shows c, shows d, shows e, shows f, shows g, shows h,
+                      shows i] s
+
+instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h, Show i, Show j)
+         => Show (a,b,c,d,e,f,g,h,i,j) where
+  showsPrec _ (a,b,c,d,e,f,g,h,i,j) s
+        = show_tuple [shows a, shows b, shows c, shows d, shows e, shows f, shows g, shows h,
+                      shows i, shows j] s
+
+instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h, Show i, Show j, Show k)
+         => Show (a,b,c,d,e,f,g,h,i,j,k) where
+  showsPrec _ (a,b,c,d,e,f,g,h,i,j,k) s
+        = show_tuple [shows a, shows b, shows c, shows d, shows e, shows f, shows g, shows h,
+                      shows i, shows j, shows k] s
+
+instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h, Show i, Show j, Show k,
+          Show l)
+         => Show (a,b,c,d,e,f,g,h,i,j,k,l) where
+  showsPrec _ (a,b,c,d,e,f,g,h,i,j,k,l) s
+        = show_tuple [shows a, shows b, shows c, shows d, shows e, shows f, shows g, shows h,
+                      shows i, shows j, shows k, shows l] s
+
+instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h, Show i, Show j, Show k,
+          Show l, Show m)
+         => Show (a,b,c,d,e,f,g,h,i,j,k,l,m) where
+  showsPrec _ (a,b,c,d,e,f,g,h,i,j,k,l,m) s
+        = show_tuple [shows a, shows b, shows c, shows d, shows e, shows f, shows g, shows h,
+                      shows i, shows j, shows k, shows l, shows m] s
+
+instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h, Show i, Show j, Show k,
+          Show l, Show m, Show n)
+         => Show (a,b,c,d,e,f,g,h,i,j,k,l,m,n) where
+  showsPrec _ (a,b,c,d,e,f,g,h,i,j,k,l,m,n) s
+        = show_tuple [shows a, shows b, shows c, shows d, shows e, shows f, shows g, shows h,
+                      shows i, shows j, shows k, shows l, shows m, shows n] s
+
+instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h, Show i, Show j, Show k,
+          Show l, Show m, Show n, Show o)
+         => Show (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) where
+  showsPrec _ (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) s
+        = show_tuple [shows a, shows b, shows c, shows d, shows e, shows f, shows g, shows h,
+                      shows i, shows j, shows k, shows l, shows m, shows n, shows o] s
+
+show_tuple :: [ShowS] -> ShowS
+show_tuple ss = showChar '('
+              . foldr1 (\s r -> s . showChar ',' . r) ss
+              . showChar ')'
+\end{code}
+
+
+%*********************************************************
+%*                                                      *
+\subsection{Support code for @Show@}
+%*                                                      *
+%*********************************************************
+
+\begin{code}
+-- | equivalent to 'showsPrec' with a precedence of 0.
+shows           :: (Show a) => a -> ShowS
+shows           =  showsPrec 0
+
+-- | utility function converting a 'Char' to a show function that
+-- simply prepends the character unchanged.
+showChar        :: Char -> ShowS
+showChar        =  (:)
+
+-- | utility function converting a 'String' to a show function that
+-- simply prepends the string unchanged.
+showString      :: String -> ShowS
+showString      =  (++)
+
+-- | utility function that surrounds the inner show function with
+-- parentheses when the 'Bool' parameter is 'True'.
+showParen       :: Bool -> ShowS -> ShowS
+showParen b p   =  if b then showChar '(' . p . showChar ')' else p
+
+showSpace :: ShowS
+showSpace = {-showChar ' '-} \ xs -> ' ' : xs
+\end{code}
+
+Code specific for characters
+
+\begin{code}
+-- | Convert a character to a string using only printable characters,
+-- using Haskell source-language escape conventions.  For example:
+--
+-- > showLitChar '\n' s  =  "\\n" ++ s
+--
+showLitChar                :: Char -> ShowS
+showLitChar c s | c > '\DEL' =  showChar '\\' (protectEsc isDec (shows (ord c)) s)
+showLitChar '\DEL'         s =  showString "\\DEL" s
+showLitChar '\\'           s =  showString "\\\\" s
+showLitChar c s | c >= ' '   =  showChar c s
+showLitChar '\a'           s =  showString "\\a" s
+showLitChar '\b'           s =  showString "\\b" s
+showLitChar '\f'           s =  showString "\\f" s
+showLitChar '\n'           s =  showString "\\n" s
+showLitChar '\r'           s =  showString "\\r" s
+showLitChar '\t'           s =  showString "\\t" s
+showLitChar '\v'           s =  showString "\\v" s
+showLitChar '\SO'          s =  protectEsc (== 'H') (showString "\\SO") s
+showLitChar c              s =  showString ('\\' : asciiTab!!ord c) s
+        -- I've done manual eta-expansion here, because otherwise it's
+        -- impossible to stop (asciiTab!!ord) getting floated out as an MFE
+
+showLitString :: String -> ShowS
+-- | Same as 'showLitChar', but for strings
+-- It converts the string to a string using Haskell escape conventions
+-- for non-printable characters. Does not add double-quotes around the
+-- whole thing; the caller should do that.
+-- The main difference from showLitChar (apart from the fact that the
+-- argument is a string not a list) is that we must escape double-quotes
+showLitString []         s = s
+showLitString ('"' : cs) s = showString "\\\"" (showLitString cs s)
+showLitString (c   : cs) s = showLitChar c (showLitString cs s)
+   -- Making 's' an explicit parameter makes it clear to GHC that
+   -- showLitString has arity 2, which avoids it allocating an extra lambda
+   -- The sticking point is the recursive call to (showLitString cs), which
+   -- it can't figure out would be ok with arity 2.
+
+showMultiLineString :: String -> [String]
+-- | Like 'showLitString' (expand escape characters using Haskell
+-- escape conventions), but
+--   * break the string into multiple lines
+--   * wrap the entire thing in double quotes
+-- Example:  @showMultiLineString "hello\ngoodbye\nblah"@
+-- returns   @["\"hello\\n\\", "\\goodbye\n\\", "\\blah\""]@
+showMultiLineString str
+  = go '\"' str
+  where
+    go ch s = case break (== '\n') s of
+                (l, _:s'@(_:_)) -> (ch : showLitString l "\\n\\") : go '\\' s'
+                (l, _)          -> [ch : showLitString l "\""]
+
+isDec :: Char -> Bool
+isDec c = c >= '0' && c <= '9'
+
+protectEsc :: (Char -> Bool) -> ShowS -> ShowS
+protectEsc p f             = f . cont
+                             where cont s@(c:_) | p c = "\\&" ++ s
+                                   cont s             = s
+
+
+asciiTab :: [String]
+asciiTab = -- Using an array drags in the array module.  listArray ('\NUL', ' ')
+           ["NUL", "SOH", "STX", "ETX", "EOT", "ENQ", "ACK", "BEL",
+            "BS",  "HT",  "LF",  "VT",  "FF",  "CR",  "SO",  "SI",
+            "DLE", "DC1", "DC2", "DC3", "DC4", "NAK", "SYN", "ETB",
+            "CAN", "EM",  "SUB", "ESC", "FS",  "GS",  "RS",  "US",
+            "SP"]
+\end{code}
+
+Code specific for Ints.
+
+\begin{code}
+-- | Convert an 'Int' in the range @0@..@15@ to the corresponding single
+-- digit 'Char'.  This function fails on other inputs, and generates
+-- lower-case hexadecimal digits.
+intToDigit :: Int -> Char
+intToDigit (I# i)
+    | isTrue# (i >=# 0#)  && isTrue# (i <=#  9#) = unsafeChr (ord '0' + I# i)
+    | isTrue# (i >=# 10#) && isTrue# (i <=# 15#) = unsafeChr (ord 'a' + I# i - 10)
+    | otherwise =  error ("Char.intToDigit: not a digit " ++ show (I# i))
+
+showSignedInt :: Int -> Int -> ShowS
+showSignedInt (I# p) (I# n) r
+    | isTrue# (n <# 0#) && isTrue# (p ># 6#) = '(' : itos n (')' : r)
+    | otherwise                              = itos n r
+
+itos :: Int# -> String -> String
+itos n# cs
+    | isTrue# (n# <# 0#) =
+        let !(I# minInt#) = minInt in
+        if isTrue# (n# ==# minInt#)
+                -- negateInt# minInt overflows, so we can't do that:
+           then '-' : (case n# `quotRemInt#` 10# of
+                       (# q, r #) ->
+                           itos' (negateInt# q) (itos' (negateInt# r) cs))
+           else '-' : itos' (negateInt# n#) cs
+    | otherwise = itos' n# cs
+    where
+    itos' :: Int# -> String -> String
+    itos' x# cs'
+        | isTrue# (x# <# 10#) = C# (chr# (ord# '0'# +# x#)) : cs'
+        | otherwise = case x# `quotRemInt#` 10# of
+                      (# q, r #) ->
+                          case chr# (ord# '0'# +# r) of
+                          c# ->
+                              itos' q (C# c# : cs')
+\end{code}
+
+
+%*********************************************************
+%*                                                      *
+\subsection{The @Integer@ instances for @Show@}
+%*                                                      *
+%*********************************************************
+
+\begin{code}
+instance Show Integer where
+    showsPrec p n r
+        | p > 6 && n < 0 = '(' : integerToString n (')' : r)
+        -- Minor point: testing p first gives better code
+        -- in the not-uncommon case where the p argument
+        -- is a constant
+        | otherwise = integerToString n r
+    showList = showList__ (showsPrec 0)
+
+-- Divide an conquer implementation of string conversion
+integerToString :: Integer -> String -> String
+integerToString n0 cs0
+    | n0 < 0    = '-' : integerToString' (- n0) cs0
+    | otherwise = integerToString' n0 cs0
+    where
+    integerToString' :: Integer -> String -> String
+    integerToString' n cs
+        | n < BASE  = jhead (fromInteger n) cs
+        | otherwise = jprinth (jsplitf (BASE*BASE) n) cs
+
+    -- Split n into digits in base p. We first split n into digits
+    -- in base p*p and then split each of these digits into two.
+    -- Note that the first 'digit' modulo p*p may have a leading zero
+    -- in base p that we need to drop - this is what jsplith takes care of.
+    -- jsplitb the handles the remaining digits.
+    jsplitf :: Integer -> Integer -> [Integer]
+    jsplitf p n
+        | p > n     = [n]
+        | otherwise = jsplith p (jsplitf (p*p) n)
+
+    jsplith :: Integer -> [Integer] -> [Integer]
+    jsplith p (n:ns) =
+        case n `quotRemInteger` p of
+        (# q, r #) ->
+            if q > 0 then q : r : jsplitb p ns
+                     else     r : jsplitb p ns
+    jsplith _ [] = error "jsplith: []"
+
+    jsplitb :: Integer -> [Integer] -> [Integer]
+    jsplitb _ []     = []
+    jsplitb p (n:ns) = case n `quotRemInteger` p of
+                       (# q, r #) ->
+                           q : r : jsplitb p ns
+
+    -- Convert a number that has been split into digits in base BASE^2
+    -- this includes a last splitting step and then conversion of digits
+    -- that all fit into a machine word.
+    jprinth :: [Integer] -> String -> String
+    jprinth (n:ns) cs =
+        case n `quotRemInteger` BASE of
+        (# q', r' #) ->
+            let q = fromInteger q'
+                r = fromInteger r'
+            in if q > 0 then jhead q $ jblock r $ jprintb ns cs
+                        else jhead r $ jprintb ns cs
+    jprinth [] _ = error "jprinth []"
+
+    jprintb :: [Integer] -> String -> String
+    jprintb []     cs = cs
+    jprintb (n:ns) cs = case n `quotRemInteger` BASE of
+                        (# q', r' #) ->
+                            let q = fromInteger q'
+                                r = fromInteger r'
+                            in jblock q $ jblock r $ jprintb ns cs
+
+    -- Convert an integer that fits into a machine word. Again, we have two
+    -- functions, one that drops leading zeros (jhead) and one that doesn't
+    -- (jblock)
+    jhead :: Int -> String -> String
+    jhead n cs
+        | n < 10    = case unsafeChr (ord '0' + n) of
+            c@(C# _) -> c : cs
+        | otherwise = case unsafeChr (ord '0' + r) of
+            c@(C# _) -> jhead q (c : cs)
+        where
+        (q, r) = n `quotRemInt` 10
+
+    jblock = jblock' {- ' -} DIGITS
+
+    jblock' :: Int -> Int -> String -> String
+    jblock' d n cs
+        | d == 1    = case unsafeChr (ord '0' + n) of
+             c@(C# _) -> c : cs
+        | otherwise = case unsafeChr (ord '0' + r) of
+             c@(C# _) -> jblock' (d - 1) q (c : cs)
+        where
+        (q, r) = n `quotRemInt` 10
+\end{code}
+
diff --git a/libraries/base/GHC/Show.lhs-boot b/libraries/base/GHC/Show.lhs-boot
new file mode 100644
index 000000000000..a2363f69f41b
--- /dev/null
+++ b/libraries/base/GHC/Show.lhs-boot
@@ -0,0 +1,11 @@
+\begin{code}
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+
+module GHC.Show (showSignedInt) where
+
+import GHC.Types
+
+showSignedInt :: Int -> Int -> [Char] -> [Char]
+\end{code}
+
diff --git a/libraries/base/GHC/Stable.lhs b/libraries/base/GHC/Stable.lhs
new file mode 100644
index 000000000000..61f6621b88eb
--- /dev/null
+++ b/libraries/base/GHC/Stable.lhs
@@ -0,0 +1,113 @@
+\begin{code}
+{-# LANGUAGE Unsafe, DeriveDataTypeable #-}
+{-# LANGUAGE NoImplicitPrelude
+           , MagicHash
+           , UnboxedTuples
+  #-}
+{-# OPTIONS_HADDOCK hide #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.Stable
+-- Copyright   :  (c) The University of Glasgow, 1992-2004
+-- License     :  see libraries/base/LICENSE
+-- 
+-- Maintainer  :  ffi@haskell.org
+-- Stability   :  internal
+-- Portability :  non-portable (GHC Extensions)
+--
+-- Stable pointers.
+--
+-----------------------------------------------------------------------------
+
+module GHC.Stable (
+        StablePtr(..),
+        newStablePtr,
+        deRefStablePtr,
+        freeStablePtr,
+        castStablePtrToPtr,
+        castPtrToStablePtr
+    ) where
+
+import GHC.Ptr
+import GHC.Base
+import Data.Typeable.Internal
+
+-----------------------------------------------------------------------------
+-- Stable Pointers
+
+{- |
+A /stable pointer/ is a reference to a Haskell expression that is
+guaranteed not to be affected by garbage collection, i.e., it will neither be
+deallocated nor will the value of the stable pointer itself change during
+garbage collection (ordinary references may be relocated during garbage
+collection).  Consequently, stable pointers can be passed to foreign code,
+which can treat it as an opaque reference to a Haskell value.
+
+A value of type @StablePtr a@ is a stable pointer to a Haskell
+expression of type @a@.
+-}
+data {-# CTYPE "HsStablePtr" #-} StablePtr a = StablePtr (StablePtr# a)
+  deriving( Typeable )
+
+-- |
+-- Create a stable pointer referring to the given Haskell value.
+--
+newStablePtr   :: a -> IO (StablePtr a)
+newStablePtr a = IO $ \ s ->
+    case makeStablePtr# a s of (# s', sp #) -> (# s', StablePtr sp #)
+
+-- |
+-- Obtain the Haskell value referenced by a stable pointer, i.e., the
+-- same value that was passed to the corresponding call to
+-- 'makeStablePtr'.  If the argument to 'deRefStablePtr' has
+-- already been freed using 'freeStablePtr', the behaviour of
+-- 'deRefStablePtr' is undefined.
+--
+deRefStablePtr :: StablePtr a -> IO a
+deRefStablePtr (StablePtr sp) = IO $ \s -> deRefStablePtr# sp s
+
+-- |
+-- Dissolve the association between the stable pointer and the Haskell
+-- value. Afterwards, if the stable pointer is passed to
+-- 'deRefStablePtr' or 'freeStablePtr', the behaviour is
+-- undefined.  However, the stable pointer may still be passed to
+-- 'castStablePtrToPtr', but the @'Foreign.Ptr.Ptr' ()@ value returned
+-- by 'castStablePtrToPtr', in this case, is undefined (in particular,
+-- it may be 'Foreign.Ptr.nullPtr').  Nevertheless, the call
+-- to 'castStablePtrToPtr' is guaranteed not to diverge.
+--
+foreign import ccall unsafe "hs_free_stable_ptr" freeStablePtr :: StablePtr a -> IO ()
+
+-- |
+-- Coerce a stable pointer to an address. No guarantees are made about
+-- the resulting value, except that the original stable pointer can be
+-- recovered by 'castPtrToStablePtr'.  In particular, the address may not
+-- refer to an accessible memory location and any attempt to pass it to
+-- the member functions of the class 'Foreign.Storable.Storable' leads to
+-- undefined behaviour.
+--
+castStablePtrToPtr :: StablePtr a -> Ptr ()
+castStablePtrToPtr (StablePtr s) = Ptr (unsafeCoerce# s)
+
+
+-- |
+-- The inverse of 'castStablePtrToPtr', i.e., we have the identity
+-- 
+-- > sp == castPtrToStablePtr (castStablePtrToPtr sp)
+-- 
+-- for any stable pointer @sp@ on which 'freeStablePtr' has
+-- not been executed yet.  Moreover, 'castPtrToStablePtr' may
+-- only be applied to pointers that have been produced by
+-- 'castStablePtrToPtr'.
+--
+castPtrToStablePtr :: Ptr () -> StablePtr a
+castPtrToStablePtr (Ptr a) = StablePtr (unsafeCoerce# a)
+
+instance Eq (StablePtr a) where 
+    (StablePtr sp1) == (StablePtr sp2) =
+        case eqStablePtr# sp1 sp2 of
+           0# -> False
+           _  -> True
+
+\end{code}
diff --git a/libraries/base/GHC/Stack.hsc b/libraries/base/GHC/Stack.hsc
new file mode 100644
index 000000000000..079f5b0516ad
--- /dev/null
+++ b/libraries/base/GHC/Stack.hsc
@@ -0,0 +1,127 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.Stack
+-- Copyright   :  (c) The University of Glasgow 2011
+-- License     :  see libraries/base/LICENSE
+-- 
+-- Maintainer  :  cvs-ghc@haskell.org
+-- Stability   :  internal
+-- Portability :  non-portable (GHC Extensions)
+--
+-- Access to GHC's call-stack simulation
+--
+-- /Since: 4.5.0.0/
+-----------------------------------------------------------------------------
+
+{-# LANGUAGE UnboxedTuples, MagicHash #-}
+module GHC.Stack (
+    -- * Call stack
+    currentCallStack,
+    whoCreated,
+    errorWithStackTrace,
+
+    -- * Internals
+    CostCentreStack,
+    CostCentre,
+    getCurrentCCS,
+    getCCSOf,
+    ccsCC,
+    ccsParent,
+    ccLabel,
+    ccModule,
+    ccSrcSpan,
+    ccsToStrings,
+    renderStack
+  ) where
+
+import Foreign
+import Foreign.C
+
+import GHC.IO
+import GHC.Base
+import GHC.Ptr
+import GHC.Foreign as GHC
+import GHC.IO.Encoding
+import GHC.Exception
+
+#define PROFILING
+#include "Rts.h"
+
+data CostCentreStack
+data CostCentre
+
+getCurrentCCS :: dummy -> IO (Ptr CostCentreStack)
+getCurrentCCS dummy = IO $ \s ->
+   case getCurrentCCS## dummy s of
+     (## s', addr ##) -> (## s', Ptr addr ##)
+
+getCCSOf :: a -> IO (Ptr CostCentreStack)
+getCCSOf obj = IO $ \s ->
+   case getCCSOf## obj s of
+     (## s', addr ##) -> (## s', Ptr addr ##)
+
+ccsCC :: Ptr CostCentreStack -> IO (Ptr CostCentre)
+ccsCC p = (# peek CostCentreStack, cc) p
+
+ccsParent :: Ptr CostCentreStack -> IO (Ptr CostCentreStack)
+ccsParent p = (# peek CostCentreStack, prevStack) p
+
+ccLabel :: Ptr CostCentre -> IO CString
+ccLabel p = (# peek CostCentre, label) p
+
+ccModule :: Ptr CostCentre -> IO CString
+ccModule p = (# peek CostCentre, module) p
+
+ccSrcSpan :: Ptr CostCentre -> IO CString
+ccSrcSpan p = (# peek CostCentre, srcloc) p
+
+-- | returns a '[String]' representing the current call stack.  This
+-- can be useful for debugging.
+--
+-- The implementation uses the call-stack simulation maintined by the
+-- profiler, so it only works if the program was compiled with @-prof@
+-- and contains suitable SCC annotations (e.g. by using @-fprof-auto@).
+-- Otherwise, the list returned is likely to be empty or
+-- uninformative.
+--
+-- /Since: 4.5.0.0/
+
+currentCallStack :: IO [String]
+currentCallStack = ccsToStrings =<< getCurrentCCS ()
+
+ccsToStrings :: Ptr CostCentreStack -> IO [String]
+ccsToStrings ccs0 = go ccs0 []
+  where
+    go ccs acc
+     | ccs == nullPtr = return acc
+     | otherwise = do
+        cc  <- ccsCC ccs
+        lbl <- GHC.peekCString utf8 =<< ccLabel cc
+        mdl <- GHC.peekCString utf8 =<< ccModule cc
+        loc <- GHC.peekCString utf8 =<< ccSrcSpan cc
+        parent <- ccsParent ccs
+        if (mdl == "MAIN" && lbl == "MAIN")
+           then return acc
+           else go parent ((mdl ++ '.':lbl ++ ' ':'(':loc ++ ")") : acc)
+
+-- | Get the stack trace attached to an object.
+--
+-- /Since: 4.5.0.0/
+whoCreated :: a -> IO [String]
+whoCreated obj = do
+  ccs <- getCCSOf obj
+  ccsToStrings ccs
+
+renderStack :: [String] -> String
+renderStack strs = "Stack trace:" ++ concatMap ("\n  "++) (reverse strs)
+
+-- | Like the function 'error', but appends a stack trace to the error
+-- message if one is available.
+--
+-- /Since: 4.7.0.0/
+errorWithStackTrace :: String -> a
+errorWithStackTrace x = unsafeDupablePerformIO $ do
+   stack <- ccsToStrings =<< getCurrentCCS x
+   if null stack
+      then throwIO (ErrorCall x)
+      else throwIO (ErrorCall (x ++ '\n' : renderStack stack))
diff --git a/libraries/base/GHC/Stats.hsc b/libraries/base/GHC/Stats.hsc
new file mode 100644
index 000000000000..11e31b982168
--- /dev/null
+++ b/libraries/base/GHC/Stats.hsc
@@ -0,0 +1,150 @@
+{-# LANGUAGE Safe #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# OPTIONS_GHC -funbox-strict-fields #-}
+
+-----------------------------------------------------------------------------
+-- | This module provides access to internal garbage collection and
+-- memory usage statistics.  These statistics are not available unless
+-- a program is run with the @-T@ RTS flag.
+--
+-- This module is GHC-only and should not be considered portable.
+--
+-- /Since: 4.5.0.0/
+-----------------------------------------------------------------------------
+module GHC.Stats
+    ( GCStats(..)
+    , getGCStats
+    , getGCStatsEnabled
+) where
+
+import Control.Monad
+import Data.Int
+import GHC.IO.Exception
+import Foreign.Marshal.Alloc
+import Foreign.Storable
+import Foreign.Ptr
+
+#include "Rts.h"
+
+foreign import ccall "getGCStats"        getGCStats_       :: Ptr () -> IO ()
+
+-- | Returns whether GC stats have been enabled (with @+RTS -T@, for example).
+--
+-- /Since: 4.6.0.0/
+foreign import ccall "getGCStatsEnabled" getGCStatsEnabled :: IO Bool
+
+-- I'm probably violating a bucket of constraints here... oops.
+
+-- | Global garbage collection and memory statistics.
+--
+-- /Since: 4.5.0.0/
+data GCStats = GCStats
+    { bytesAllocated :: !Int64 -- ^ Total number of bytes allocated
+    , numGcs :: !Int64 -- ^ Number of garbage collections performed
+    , maxBytesUsed :: !Int64 -- ^ Maximum number of live bytes seen so far
+    , numByteUsageSamples :: !Int64 -- ^ Number of byte usage samples taken
+    -- | Sum of all byte usage samples, can be used with
+    -- 'numByteUsageSamples' to calculate averages with
+    -- arbitrary weighting (if you are sampling this record multiple
+    -- times).
+    , cumulativeBytesUsed :: !Int64
+    , bytesCopied :: !Int64 -- ^ Number of bytes copied during GC
+    , currentBytesUsed :: !Int64 -- ^ Current number of live bytes
+    , currentBytesSlop :: !Int64 -- ^ Current number of bytes lost to slop
+    , maxBytesSlop :: !Int64 -- ^ Maximum number of bytes lost to slop at any one time so far
+    , peakMegabytesAllocated :: !Int64 -- ^ Maximum number of megabytes allocated
+    -- | CPU time spent running mutator threads.  This does not include
+    -- any profiling overhead or initialization.
+    , mutatorCpuSeconds :: !Double
+    -- | Wall clock time spent running mutator threads.  This does not
+    -- include initialization.
+    , mutatorWallSeconds :: !Double
+    , gcCpuSeconds :: !Double -- ^ CPU time spent running GC
+    , gcWallSeconds :: !Double -- ^ Wall clock time spent running GC
+    , cpuSeconds :: !Double -- ^ Total CPU time elapsed since program start
+    , wallSeconds :: !Double -- ^ Total wall clock time elapsed since start
+    -- | Number of bytes copied during GC, minus space held by mutable
+    -- lists held by the capabilities.  Can be used with
+    -- 'parMaxBytesCopied' to determine how well parallel GC utilized
+    -- all cores.
+    , parTotBytesCopied :: !Int64
+    -- | Sum of number of bytes copied each GC by the most active GC
+    -- thread each GC.  The ratio of 'parTotBytesCopied' divided by
+    -- 'parMaxBytesCopied' approaches 1 for a maximally sequential
+    -- run and approaches the number of threads (set by the RTS flag
+    -- @-N@) for a maximally parallel run.
+    , parMaxBytesCopied :: !Int64
+    } deriving (Show, Read)
+
+    {-
+    , initCpuSeconds :: !Double
+    , initWallSeconds :: !Double
+    -}
+
+-- | Retrieves garbage collection and memory statistics as of the last
+-- garbage collection.  If you would like your statistics as recent as
+-- possible, first run a 'System.Mem.performGC'.
+--
+-- /Since: 4.5.0.0/
+getGCStats :: IO GCStats
+getGCStats = do
+  statsEnabled <- getGCStatsEnabled
+  unless statsEnabled .  ioError $ IOError
+    Nothing
+    UnsupportedOperation
+    ""
+    "getGCStats: GC stats not enabled. Use `+RTS -T -RTS' to enable them."
+    Nothing
+    Nothing
+  allocaBytes (#size GCStats) $ \p -> do
+    getGCStats_ p
+    bytesAllocated <- (# peek GCStats, bytes_allocated) p
+    numGcs <- (# peek GCStats, num_gcs ) p
+    numByteUsageSamples <- (# peek GCStats, num_byte_usage_samples ) p
+    maxBytesUsed <- (# peek GCStats, max_bytes_used ) p
+    cumulativeBytesUsed <- (# peek GCStats, cumulative_bytes_used ) p
+    bytesCopied <- (# peek GCStats, bytes_copied ) p
+    currentBytesUsed <- (# peek GCStats, current_bytes_used ) p
+    currentBytesSlop <- (# peek GCStats, current_bytes_slop) p
+    maxBytesSlop <- (# peek GCStats, max_bytes_slop) p
+    peakMegabytesAllocated <- (# peek GCStats, peak_megabytes_allocated ) p
+    {-
+    initCpuSeconds <- (# peek GCStats, init_cpu_seconds) p
+    initWallSeconds <- (# peek GCStats, init_wall_seconds) p
+    -}
+    mutatorCpuSeconds <- (# peek GCStats, mutator_cpu_seconds) p
+    mutatorWallSeconds <- (# peek GCStats, mutator_wall_seconds) p
+    gcCpuSeconds <- (# peek GCStats, gc_cpu_seconds) p
+    gcWallSeconds <- (# peek GCStats, gc_wall_seconds) p
+    cpuSeconds <- (# peek GCStats, cpu_seconds) p
+    wallSeconds <- (# peek GCStats, wall_seconds) p
+    parTotBytesCopied <- (# peek GCStats, par_tot_bytes_copied) p
+    parMaxBytesCopied <- (# peek GCStats, par_max_bytes_copied) p
+    return GCStats { .. }
+
+{-
+
+-- Nontrivial to implement: TaskStats needs arbitrarily large
+-- amounts of memory, spark stats wants to use SparkCounters
+-- but that needs a new rts/ header.
+
+data TaskStats = TaskStats
+    { taskMutCpuSeconds :: Int64
+    , taskMutWallSeconds :: Int64
+    , taskGcCpuSeconds :: Int64
+    , taskGcWallSeconds :: Int64
+    } deriving (Show, Read)
+
+data SparkStats = SparkStats
+    { sparksCreated :: Int64
+    , sparksDud :: Int64
+    , sparksOverflowed :: Int64
+    , sparksConverted :: Int64
+    , sparksGcd :: Int64
+    , sparksFizzled :: Int64
+    } deriving (Show, Read)
+
+-- We also could get per-generation stats, which requires a
+-- non-constant but at runtime known about of memory.
+
+-}
diff --git a/libraries/base/GHC/Storable.lhs b/libraries/base/GHC/Storable.lhs
new file mode 100644
index 000000000000..13668725af71
--- /dev/null
+++ b/libraries/base/GHC/Storable.lhs
@@ -0,0 +1,164 @@
+\begin{code}
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE NoImplicitPrelude, MagicHash, UnboxedTuples #-}
+{-# OPTIONS_HADDOCK hide #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.Storable
+-- Copyright   :  (c) The FFI task force, 2000-2002
+-- License     :  see libraries/base/LICENSE
+-- 
+-- Maintainer  :  ffi@haskell.org
+-- Stability   :  internal
+-- Portability :  non-portable (GHC Extensions)
+--
+-- Helper functions for "Foreign.Storable"
+--
+-----------------------------------------------------------------------------
+
+module GHC.Storable
+        ( readWideCharOffPtr  
+        , readIntOffPtr       
+        , readWordOffPtr      
+        , readPtrOffPtr       
+        , readFunPtrOffPtr    
+        , readFloatOffPtr     
+        , readDoubleOffPtr    
+        , readStablePtrOffPtr 
+        , readInt8OffPtr      
+        , readInt16OffPtr     
+        , readInt32OffPtr     
+        , readInt64OffPtr     
+        , readWord8OffPtr     
+        , readWord16OffPtr    
+        , readWord32OffPtr    
+        , readWord64OffPtr    
+        , writeWideCharOffPtr 
+        , writeIntOffPtr      
+        , writeWordOffPtr     
+        , writePtrOffPtr      
+        , writeFunPtrOffPtr   
+        , writeFloatOffPtr    
+        , writeDoubleOffPtr   
+        , writeStablePtrOffPtr
+        , writeInt8OffPtr     
+        , writeInt16OffPtr    
+        , writeInt32OffPtr    
+        , writeInt64OffPtr    
+        , writeWord8OffPtr    
+        , writeWord16OffPtr   
+        , writeWord32OffPtr   
+        , writeWord64OffPtr   
+        ) where
+
+import GHC.Stable ( StablePtr(..) )
+import GHC.Int
+import GHC.Word
+import GHC.Ptr
+import GHC.Base
+\end{code}
+
+\begin{code}
+
+readWideCharOffPtr  :: Ptr Char          -> Int -> IO Char
+readIntOffPtr       :: Ptr Int           -> Int -> IO Int
+readWordOffPtr      :: Ptr Word          -> Int -> IO Word
+readPtrOffPtr       :: Ptr (Ptr a)       -> Int -> IO (Ptr a)
+readFunPtrOffPtr    :: Ptr (FunPtr a)    -> Int -> IO (FunPtr a)
+readFloatOffPtr     :: Ptr Float         -> Int -> IO Float
+readDoubleOffPtr    :: Ptr Double        -> Int -> IO Double
+readStablePtrOffPtr :: Ptr (StablePtr a) -> Int -> IO (StablePtr a)
+readInt8OffPtr      :: Ptr Int8          -> Int -> IO Int8
+readInt16OffPtr     :: Ptr Int16         -> Int -> IO Int16
+readInt32OffPtr     :: Ptr Int32         -> Int -> IO Int32
+readInt64OffPtr     :: Ptr Int64         -> Int -> IO Int64
+readWord8OffPtr     :: Ptr Word8         -> Int -> IO Word8
+readWord16OffPtr    :: Ptr Word16        -> Int -> IO Word16
+readWord32OffPtr    :: Ptr Word32        -> Int -> IO Word32
+readWord64OffPtr    :: Ptr Word64        -> Int -> IO Word64
+
+readWideCharOffPtr (Ptr a) (I# i)
+  = IO $ \s -> case readWideCharOffAddr# a i s  of (# s2, x #) -> (# s2, C# x #)
+readIntOffPtr (Ptr a) (I# i)
+  = IO $ \s -> case readIntOffAddr# a i s       of (# s2, x #) -> (# s2, I# x #)
+readWordOffPtr (Ptr a) (I# i)
+  = IO $ \s -> case readWordOffAddr# a i s      of (# s2, x #) -> (# s2, W# x #)
+readPtrOffPtr (Ptr a) (I# i)
+  = IO $ \s -> case readAddrOffAddr# a i s      of (# s2, x #) -> (# s2, Ptr x #)
+readFunPtrOffPtr (Ptr a) (I# i)
+  = IO $ \s -> case readAddrOffAddr# a i s      of (# s2, x #) -> (# s2, FunPtr x #)
+readFloatOffPtr (Ptr a) (I# i)
+  = IO $ \s -> case readFloatOffAddr# a i s     of (# s2, x #) -> (# s2, F# x #)
+readDoubleOffPtr (Ptr a) (I# i)
+  = IO $ \s -> case readDoubleOffAddr# a i s    of (# s2, x #) -> (# s2, D# x #)
+readStablePtrOffPtr (Ptr a) (I# i)
+  = IO $ \s -> case readStablePtrOffAddr# a i s of (# s2, x #) -> (# s2, StablePtr x #)
+readInt8OffPtr (Ptr a) (I# i)
+  = IO $ \s -> case readInt8OffAddr# a i s      of (# s2, x #) -> (# s2, I8# x #)
+readWord8OffPtr (Ptr a) (I# i)
+  = IO $ \s -> case readWord8OffAddr# a i s     of (# s2, x #) -> (# s2, W8# x #)
+readInt16OffPtr (Ptr a) (I# i)
+  = IO $ \s -> case readInt16OffAddr# a i s     of (# s2, x #) -> (# s2, I16# x #)
+readWord16OffPtr (Ptr a) (I# i)
+  = IO $ \s -> case readWord16OffAddr# a i s    of (# s2, x #) -> (# s2, W16# x #)
+readInt32OffPtr (Ptr a) (I# i)
+  = IO $ \s -> case readInt32OffAddr# a i s     of (# s2, x #) -> (# s2, I32# x #)
+readWord32OffPtr (Ptr a) (I# i)
+  = IO $ \s -> case readWord32OffAddr# a i s    of (# s2, x #) -> (# s2, W32# x #)
+readInt64OffPtr (Ptr a) (I# i)
+  = IO $ \s -> case readInt64OffAddr# a i s     of (# s2, x #) -> (# s2, I64# x #)
+readWord64OffPtr (Ptr a) (I# i)
+  = IO $ \s -> case readWord64OffAddr# a i s    of (# s2, x #) -> (# s2, W64# x #)
+
+writeWideCharOffPtr  :: Ptr Char          -> Int -> Char        -> IO ()
+writeIntOffPtr       :: Ptr Int           -> Int -> Int         -> IO ()
+writeWordOffPtr      :: Ptr Word          -> Int -> Word        -> IO ()
+writePtrOffPtr       :: Ptr (Ptr a)       -> Int -> Ptr a       -> IO ()
+writeFunPtrOffPtr    :: Ptr (FunPtr a)    -> Int -> FunPtr a    -> IO ()
+writeFloatOffPtr     :: Ptr Float         -> Int -> Float       -> IO ()
+writeDoubleOffPtr    :: Ptr Double        -> Int -> Double      -> IO ()
+writeStablePtrOffPtr :: Ptr (StablePtr a) -> Int -> StablePtr a -> IO ()
+writeInt8OffPtr      :: Ptr Int8          -> Int -> Int8        -> IO ()
+writeInt16OffPtr     :: Ptr Int16         -> Int -> Int16       -> IO ()
+writeInt32OffPtr     :: Ptr Int32         -> Int -> Int32       -> IO ()
+writeInt64OffPtr     :: Ptr Int64         -> Int -> Int64       -> IO ()
+writeWord8OffPtr     :: Ptr Word8         -> Int -> Word8       -> IO ()
+writeWord16OffPtr    :: Ptr Word16        -> Int -> Word16      -> IO ()
+writeWord32OffPtr    :: Ptr Word32        -> Int -> Word32      -> IO ()
+writeWord64OffPtr    :: Ptr Word64        -> Int -> Word64      -> IO ()
+
+writeWideCharOffPtr (Ptr a) (I# i) (C# x)
+  = IO $ \s -> case writeWideCharOffAddr# a i x s  of s2 -> (# s2, () #)
+writeIntOffPtr (Ptr a) (I# i) (I# x)
+  = IO $ \s -> case writeIntOffAddr# a i x s       of s2 -> (# s2, () #)
+writeWordOffPtr (Ptr a) (I# i) (W# x)
+  = IO $ \s -> case writeWordOffAddr# a i x s      of s2 -> (# s2, () #)
+writePtrOffPtr (Ptr a) (I# i) (Ptr x)
+  = IO $ \s -> case writeAddrOffAddr# a i x s      of s2 -> (# s2, () #)
+writeFunPtrOffPtr (Ptr a) (I# i) (FunPtr x)
+  = IO $ \s -> case writeAddrOffAddr# a i x s      of s2 -> (# s2, () #)
+writeFloatOffPtr (Ptr a) (I# i) (F# x)
+  = IO $ \s -> case writeFloatOffAddr# a i x s     of s2 -> (# s2, () #)
+writeDoubleOffPtr (Ptr a) (I# i) (D# x)
+  = IO $ \s -> case writeDoubleOffAddr# a i x s    of s2 -> (# s2, () #)
+writeStablePtrOffPtr (Ptr a) (I# i) (StablePtr x)
+  = IO $ \s -> case writeStablePtrOffAddr# a i x s of s2 -> (# s2 , () #)
+writeInt8OffPtr (Ptr a) (I# i) (I8# x)
+  = IO $ \s -> case writeInt8OffAddr# a i x s      of s2 -> (# s2, () #)
+writeWord8OffPtr (Ptr a) (I# i) (W8# x)
+  = IO $ \s -> case writeWord8OffAddr# a i x s     of s2 -> (# s2, () #)
+writeInt16OffPtr (Ptr a) (I# i) (I16# x)
+  = IO $ \s -> case writeInt16OffAddr# a i x s     of s2 -> (# s2, () #)
+writeWord16OffPtr (Ptr a) (I# i) (W16# x)
+  = IO $ \s -> case writeWord16OffAddr# a i x s    of s2 -> (# s2, () #)
+writeInt32OffPtr (Ptr a) (I# i) (I32# x)
+  = IO $ \s -> case writeInt32OffAddr# a i x s     of s2 -> (# s2, () #)
+writeWord32OffPtr (Ptr a) (I# i) (W32# x)
+  = IO $ \s -> case writeWord32OffAddr# a i x s    of s2 -> (# s2, () #)
+writeInt64OffPtr (Ptr a) (I# i) (I64# x)
+  = IO $ \s -> case writeInt64OffAddr# a i x s     of s2 -> (# s2, () #)
+writeWord64OffPtr (Ptr a) (I# i) (W64# x)
+  = IO $ \s -> case writeWord64OffAddr# a i x s    of s2 -> (# s2, () #)
+
+\end{code}
diff --git a/libraries/base/GHC/TopHandler.lhs b/libraries/base/GHC/TopHandler.lhs
new file mode 100644
index 000000000000..ee8e792e268d
--- /dev/null
+++ b/libraries/base/GHC/TopHandler.lhs
@@ -0,0 +1,227 @@
+\begin{code}
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE CPP
+           , NoImplicitPrelude
+           , MagicHash
+           , UnboxedTuples
+  #-}
+{-# OPTIONS_GHC -fno-warn-unused-imports #-}
+{-# OPTIONS_HADDOCK hide #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.TopHandler
+-- Copyright   :  (c) The University of Glasgow, 2001-2002
+-- License     :  see libraries/base/LICENSE
+-- 
+-- Maintainer  :  cvs-ghc@haskell.org
+-- Stability   :  internal
+-- Portability :  non-portable (GHC Extensions)
+--
+-- Support for catching exceptions raised during top-level computations
+-- (e.g. @Main.main@, 'Control.Concurrent.forkIO', and foreign exports)
+--
+-----------------------------------------------------------------------------
+
+module GHC.TopHandler (
+        runMainIO, runIO, runIOFastExit, runNonIO,
+        topHandler, topHandlerFastExit,
+        reportStackOverflow, reportError,
+        flushStdHandles
+    ) where
+
+#include "HsBaseConfig.h"
+
+import Control.Exception
+import Data.Maybe
+import Data.Dynamic (toDyn)
+
+import Foreign
+import Foreign.C
+import GHC.Base
+import GHC.Conc hiding (throwTo)
+import GHC.Num
+import GHC.Real
+import GHC.MVar
+import GHC.IO
+import GHC.IO.Handle.FD
+import GHC.IO.Handle
+import GHC.IO.Exception
+import GHC.Weak
+import Data.Typeable
+#if defined(mingw32_HOST_OS)
+import GHC.ConsoleHandler
+#endif
+
+-- | 'runMainIO' is wrapped around 'Main.main' (or whatever main is
+-- called in the program).  It catches otherwise uncaught exceptions,
+-- and also flushes stdout\/stderr before exiting.
+runMainIO :: IO a -> IO a
+runMainIO main = 
+    do 
+      main_thread_id <- myThreadId
+      weak_tid <- mkWeakThreadId main_thread_id
+      install_interrupt_handler $ do
+           m <- deRefWeak weak_tid 
+           case m of
+               Nothing  -> return ()
+               Just tid -> throwTo tid (toException UserInterrupt)
+      main -- hs_exit() will flush
+    `catch`
+      topHandler
+
+install_interrupt_handler :: IO () -> IO ()
+#ifdef mingw32_HOST_OS
+install_interrupt_handler handler = do
+  _ <- GHC.ConsoleHandler.installHandler $
+     Catch $ \event -> 
+        case event of
+           ControlC -> handler
+           Break    -> handler
+           Close    -> handler
+           _ -> return ()
+  return ()
+#else
+#include "rts/Signals.h"
+-- specialised version of System.Posix.Signals.installHandler, which
+-- isn't available here.
+install_interrupt_handler handler = do
+   let sig = CONST_SIGINT :: CInt
+   _ <- setHandler sig (Just (const handler, toDyn handler))
+   _ <- stg_sig_install sig STG_SIG_RST nullPtr
+     -- STG_SIG_RST: the second ^C kills us for real, just in case the
+     -- RTS or program is unresponsive.
+   return ()
+
+foreign import ccall unsafe
+  stg_sig_install
+	:: CInt				-- sig no.
+	-> CInt				-- action code (STG_SIG_HAN etc.)
+	-> Ptr ()			-- (in, out) blocked
+	-> IO CInt			-- (ret) old action code
+#endif
+
+-- | 'runIO' is wrapped around every @foreign export@ and @foreign
+-- import \"wrapper\"@ to mop up any uncaught exceptions.  Thus, the
+-- result of running 'System.Exit.exitWith' in a foreign-exported
+-- function is the same as in the main thread: it terminates the
+-- program.
+--
+runIO :: IO a -> IO a
+runIO main = catch main topHandler
+
+-- | Like 'runIO', but in the event of an exception that causes an exit,
+-- we don't shut down the system cleanly, we just exit.  This is
+-- useful in some cases, because the safe exit version will give other
+-- threads a chance to clean up first, which might shut down the
+-- system in a different way.  For example, try 
+--
+--   main = forkIO (runIO (exitWith (ExitFailure 1))) >> threadDelay 10000
+--
+-- This will sometimes exit with "interrupted" and code 0, because the
+-- main thread is given a chance to shut down when the child thread calls
+-- safeExit.  There is a race to shut down between the main and child threads.
+--
+runIOFastExit :: IO a -> IO a
+runIOFastExit main = catch main topHandlerFastExit
+        -- NB. this is used by the testsuite driver
+
+-- | The same as 'runIO', but for non-IO computations.  Used for
+-- wrapping @foreign export@ and @foreign import \"wrapper\"@ when these
+-- are used to export Haskell functions with non-IO types.
+--
+runNonIO :: a -> IO a
+runNonIO a = catch (a `seq` return a) topHandler
+
+topHandler :: SomeException -> IO a
+topHandler err = catch (real_handler safeExit err) topHandler
+
+topHandlerFastExit :: SomeException -> IO a
+topHandlerFastExit err = 
+  catchException (real_handler fastExit err) topHandlerFastExit
+
+-- Make sure we handle errors while reporting the error!
+-- (e.g. evaluating the string passed to 'error' might generate
+--  another error, etc.)
+--
+real_handler :: (Int -> IO a) -> SomeException -> IO a
+real_handler exit se = do
+  flushStdHandles -- before any error output
+  case fromException se of
+      Just StackOverflow -> do
+           reportStackOverflow
+           exit 2
+
+      Just UserInterrupt  -> exitInterrupted
+
+      _ -> case fromException se of
+           -- only the main thread gets ExitException exceptions
+           Just ExitSuccess     -> exit 0
+           Just (ExitFailure n) -> exit n
+
+           -- EPIPE errors received for stdout are ignored (#2699)
+           _ -> case fromException se of
+                Just IOError{ ioe_type = ResourceVanished,
+                              ioe_errno = Just ioe,
+                              ioe_handle = Just hdl }
+                   | Errno ioe == ePIPE, hdl == stdout -> exit 0
+                _ -> do reportError se
+                        exit 1
+           
+
+-- try to flush stdout/stderr, but don't worry if we fail
+-- (these handles might have errors, and we don't want to go into
+-- an infinite loop).
+flushStdHandles :: IO ()
+flushStdHandles = do
+  hFlush stdout `catchAny` \_ -> return ()
+  hFlush stderr `catchAny` \_ -> return ()
+
+safeExit, fastExit :: Int -> IO a
+safeExit = exitHelper useSafeExit
+fastExit = exitHelper useFastExit
+
+unreachable :: IO a
+unreachable = fail "If you can read this, shutdownHaskellAndExit did not exit."
+
+exitHelper :: CInt -> Int -> IO a
+#ifdef mingw32_HOST_OS
+exitHelper exitKind r =
+  shutdownHaskellAndExit (fromIntegral r) exitKind >> unreachable
+#else
+-- On Unix we use an encoding for the ExitCode:
+--      0 -- 255  normal exit code
+--   -127 -- -1   exit by signal
+-- For any invalid encoding we just use a replacement (0xff).
+exitHelper exitKind r
+  | r >= 0 && r <= 255
+  = shutdownHaskellAndExit   (fromIntegral   r)  exitKind >> unreachable
+  | r >= -127 && r <= -1
+  = shutdownHaskellAndSignal (fromIntegral (-r)) exitKind >> unreachable
+  | otherwise
+  = shutdownHaskellAndExit   0xff                exitKind >> unreachable
+
+foreign import ccall "shutdownHaskellAndSignal"
+  shutdownHaskellAndSignal :: CInt -> CInt -> IO ()
+#endif
+
+exitInterrupted :: IO a
+exitInterrupted = 
+#ifdef mingw32_HOST_OS
+  safeExit 252
+#else
+  -- we must exit via the default action for SIGINT, so that the
+  -- parent of this process can take appropriate action (see #2301)
+  safeExit (-CONST_SIGINT)
+#endif
+
+-- NOTE: shutdownHaskellAndExit must be called "safe", because it *can*
+-- re-enter Haskell land through finalizers.
+foreign import ccall "Rts.h shutdownHaskellAndExit"
+  shutdownHaskellAndExit :: CInt -> CInt -> IO ()
+
+useFastExit, useSafeExit :: CInt
+useFastExit = 1
+useSafeExit = 0
+
+\end{code}
diff --git a/libraries/base/GHC/TypeLits.hs b/libraries/base/GHC/TypeLits.hs
new file mode 100644
index 000000000000..7ae6fb042253
--- /dev/null
+++ b/libraries/base/GHC/TypeLits.hs
@@ -0,0 +1,240 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE UndecidableInstances #-}  -- for compiling instances of (==)
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE MagicHash #-}
+
+{-| This module is an internal GHC module.  It declares the constants used
+in the implementation of type-level natural numbers.  The programmer interface
+for working with type-level naturals should be defined in a separate library.
+
+/Since: 4.6.0.0/
+-}
+
+module GHC.TypeLits
+  ( -- * Kinds
+    Nat, Symbol
+
+    -- * Linking type and value level
+  , KnownNat, natVal, natVal'
+  , KnownSymbol, symbolVal, symbolVal'
+  , SomeNat(..), SomeSymbol(..)
+  , someNatVal, someSymbolVal
+  , sameNat, sameSymbol
+
+
+    -- * Functions on type literals
+  , type (<=), type (<=?), type (+), type (*), type (^), type (-)
+  , CmpNat, CmpSymbol
+
+  ) where
+
+import GHC.Base(Eq(..), Ord(..), Bool(True,False), Ordering(..), otherwise)
+import GHC.Num(Integer)
+import GHC.Base(String)
+import GHC.Show(Show(..))
+import GHC.Read(Read(..))
+import GHC.Prim(magicDict, Proxy#)
+import Data.Maybe(Maybe(..))
+import Data.Proxy (Proxy(..))
+import Data.Type.Equality(type (==), (:~:)(Refl))
+import Unsafe.Coerce(unsafeCoerce)
+
+-- | (Kind) This is the kind of type-level natural numbers.
+data Nat
+
+-- | (Kind) This is the kind of type-level symbols.
+data Symbol
+
+
+--------------------------------------------------------------------------------
+
+-- | This class gives the integer associated with a type-level natural.
+-- There are instances of the class for every concrete literal: 0, 1, 2, etc.
+--
+-- /Since: 4.7.0.0/
+class KnownNat (n :: Nat) where
+  natSing :: SNat n
+
+-- | This class gives the string associated with a type-level symbol.
+-- There are instances of the class for every concrete literal: "hello", etc.
+--
+-- /Since: 4.7.0.0/
+class KnownSymbol (n :: Symbol) where
+  symbolSing :: SSymbol n
+
+-- | /Since: 4.7.0.0/
+natVal :: forall n proxy. KnownNat n => proxy n -> Integer
+natVal _ = case natSing :: SNat n of
+             SNat x -> x
+
+-- | /Since: 4.7.0.0/
+symbolVal :: forall n proxy. KnownSymbol n => proxy n -> String
+symbolVal _ = case symbolSing :: SSymbol n of
+                SSymbol x -> x
+
+-- | /Since: 4.7.1.0/
+natVal' :: forall n. KnownNat n => Proxy# n -> Integer
+natVal' _ = case natSing :: SNat n of
+             SNat x -> x
+
+-- | /Since: 4.7.1.0/
+symbolVal' :: forall n. KnownSymbol n => Proxy# n -> String
+symbolVal' _ = case symbolSing :: SSymbol n of
+                SSymbol x -> x
+
+
+
+-- | This type represents unknown type-level natural numbers.
+data SomeNat    = forall n. KnownNat n    => SomeNat    (Proxy n)
+                  -- ^ /Since: 4.7.0.0/
+
+-- | This type represents unknown type-level symbols.
+data SomeSymbol = forall n. KnownSymbol n => SomeSymbol (Proxy n)
+                  -- ^ /Since: 4.7.0.0/
+
+-- | Convert an integer into an unknown type-level natural.
+--
+-- /Since: 4.7.0.0/
+someNatVal :: Integer -> Maybe SomeNat
+someNatVal n
+  | n >= 0        = Just (withSNat SomeNat (SNat n) Proxy)
+  | otherwise     = Nothing
+
+-- | Convert a string into an unknown type-level symbol.
+--
+-- /Since: 4.7.0.0/
+someSymbolVal :: String -> SomeSymbol
+someSymbolVal n   = withSSymbol SomeSymbol (SSymbol n) Proxy
+
+
+
+instance Eq SomeNat where
+  SomeNat x == SomeNat y = natVal x == natVal y
+
+instance Ord SomeNat where
+  compare (SomeNat x) (SomeNat y) = compare (natVal x) (natVal y)
+
+instance Show SomeNat where
+  showsPrec p (SomeNat x) = showsPrec p (natVal x)
+
+instance Read SomeNat where
+  readsPrec p xs = do (a,ys) <- readsPrec p xs
+                      case someNatVal a of
+                        Nothing -> []
+                        Just n  -> [(n,ys)]
+
+
+instance Eq SomeSymbol where
+  SomeSymbol x == SomeSymbol y = symbolVal x == symbolVal y
+
+instance Ord SomeSymbol where
+  compare (SomeSymbol x) (SomeSymbol y) = compare (symbolVal x) (symbolVal y)
+
+instance Show SomeSymbol where
+  showsPrec p (SomeSymbol x) = showsPrec p (symbolVal x)
+
+instance Read SomeSymbol where
+  readsPrec p xs = [ (someSymbolVal a, ys) | (a,ys) <- readsPrec p xs ]
+
+type family EqNat (a :: Nat) (b :: Nat) where
+  EqNat a a = True
+  EqNat a b = False
+type instance a == b = EqNat a b
+
+type family EqSymbol (a :: Symbol) (b :: Symbol) where
+  EqSymbol a a = True
+  EqSymbol a b = False
+type instance a == b = EqSymbol a b
+
+--------------------------------------------------------------------------------
+
+infix  4 <=?, <=
+infixl 6 +, -
+infixl 7 *
+infixr 8 ^
+
+-- | Comparison of type-level naturals, as a constraint.
+type x <= y = (x <=? y) ~ True
+
+-- | Comparison of type-level symbols, as a function.
+--
+-- /Since: 4.7.0.0/
+type family CmpSymbol (m :: Symbol) (n :: Symbol) :: Ordering
+
+-- | Comparison of type-level naturals, as a function.
+--
+-- /Since: 4.7.0.0/
+type family CmpNat    (m :: Nat)    (n :: Nat)    :: Ordering
+
+{- | Comparison of type-level naturals, as a function.
+NOTE: The functionality for this function should be subsumed
+by 'CmpNat', so this might go away in the future.
+Please let us know, if you encounter discrepancies between the two. -}
+type family (m :: Nat) <=? (n :: Nat) :: Bool
+
+-- | Addition of type-level naturals.
+type family (m :: Nat) + (n :: Nat) :: Nat
+
+-- | Multiplication of type-level naturals.
+type family (m :: Nat) * (n :: Nat) :: Nat
+
+-- | Exponentiation of type-level naturals.
+type family (m :: Nat) ^ (n :: Nat) :: Nat
+
+-- | Subtraction of type-level naturals.
+--
+-- /Since: 4.7.0.0/
+type family (m :: Nat) - (n :: Nat) :: Nat
+
+
+--------------------------------------------------------------------------------
+
+-- | We either get evidence that this function was instantiated with the
+-- same type-level numbers, or 'Nothing'.
+--
+-- /Since: 4.7.0.0/
+sameNat :: (KnownNat a, KnownNat b) =>
+           Proxy a -> Proxy b -> Maybe (a :~: b)
+sameNat x y
+  | natVal x == natVal y = Just (unsafeCoerce Refl)
+  | otherwise            = Nothing
+
+-- | We either get evidence that this function was instantiated with the
+-- same type-level symbols, or 'Nothing'.
+--
+-- /Since: 4.7.0.0/
+sameSymbol :: (KnownSymbol a, KnownSymbol b) =>
+              Proxy a -> Proxy b -> Maybe (a :~: b)
+sameSymbol x y
+  | symbolVal x == symbolVal y  = Just (unsafeCoerce Refl)
+  | otherwise                   = Nothing
+
+--------------------------------------------------------------------------------
+-- PRIVATE:
+
+newtype SNat    (n :: Nat)    = SNat    Integer
+newtype SSymbol (s :: Symbol) = SSymbol String
+
+data WrapN a b = WrapN (KnownNat    a => Proxy a -> b)
+data WrapS a b = WrapS (KnownSymbol a => Proxy a -> b)
+
+-- See Note [magicDictId magic] in "basicType/MkId.hs"
+withSNat :: (KnownNat a => Proxy a -> b)
+         -> SNat a      -> Proxy a -> b
+withSNat f x y = magicDict (WrapN f) x y
+
+-- See Note [magicDictId magic] in "basicType/MkId.hs"
+withSSymbol :: (KnownSymbol a => Proxy a -> b)
+            -> SSymbol a      -> Proxy a -> b
+withSSymbol f x y = magicDict (WrapS f) x y
+
+
diff --git a/libraries/base/GHC/Unicode.hs b/libraries/base/GHC/Unicode.hs
new file mode 100644
index 000000000000..ef58975e0848
--- /dev/null
+++ b/libraries/base/GHC/Unicode.hs
@@ -0,0 +1,179 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE CPP, NoImplicitPrelude #-}
+{-# OPTIONS_HADDOCK hide #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.Unicode
+-- Copyright   :  (c) The University of Glasgow, 2003
+-- License     :  see libraries/base/LICENSE
+-- 
+-- Maintainer  :  cvs-ghc@haskell.org
+-- Stability   :  internal
+-- Portability :  non-portable (GHC extensions)
+--
+-- Implementations for the character predicates (isLower, isUpper, etc.)
+-- and the conversions (toUpper, toLower).  The implementation uses
+-- libunicode on Unix systems if that is available.
+--
+-----------------------------------------------------------------------------
+
+module GHC.Unicode (
+        isAscii, isLatin1, isControl,
+        isAsciiUpper, isAsciiLower,
+        isPrint, isSpace,  isUpper,
+        isLower, isAlpha,  isDigit,
+        isOctDigit, isHexDigit, isAlphaNum,
+        toUpper, toLower, toTitle,
+        wgencat
+    ) where
+
+import GHC.Base
+import GHC.Char
+import GHC.Real        (fromIntegral)
+import Foreign.C.Types (CInt(..))
+
+#include "HsBaseConfig.h"
+
+-- | Selects the first 128 characters of the Unicode character set,
+-- corresponding to the ASCII character set.
+isAscii                 :: Char -> Bool
+isAscii c               =  c <  '\x80'
+
+-- | Selects the first 256 characters of the Unicode character set,
+-- corresponding to the ISO 8859-1 (Latin-1) character set.
+isLatin1                :: Char -> Bool
+isLatin1 c              =  c <= '\xff'
+
+-- | Selects ASCII lower-case letters,
+-- i.e. characters satisfying both 'isAscii' and 'isLower'.
+isAsciiLower :: Char -> Bool
+isAsciiLower c          =  c >= 'a' && c <= 'z'
+
+-- | Selects ASCII upper-case letters,
+-- i.e. characters satisfying both 'isAscii' and 'isUpper'.
+isAsciiUpper :: Char -> Bool
+isAsciiUpper c          =  c >= 'A' && c <= 'Z'
+
+-- | Selects control characters, which are the non-printing characters of
+-- the Latin-1 subset of Unicode.
+isControl               :: Char -> Bool
+
+-- | Selects printable Unicode characters
+-- (letters, numbers, marks, punctuation, symbols and spaces).
+isPrint                 :: Char -> Bool
+
+-- | Returns 'True' for any Unicode space character, and the control
+-- characters @\\t@, @\\n@, @\\r@, @\\f@, @\\v@.
+isSpace                 :: Char -> Bool
+-- isSpace includes non-breaking space
+-- Done with explicit equalities both for efficiency, and to avoid a tiresome
+-- recursion with GHC.List elem
+isSpace c               =  c == ' '     ||
+                           c == '\t'    ||
+                           c == '\n'    ||
+                           c == '\r'    ||
+                           c == '\f'    ||
+                           c == '\v'    ||
+                           c == '\xa0'  ||
+                           iswspace (fromIntegral (ord c)) /= 0
+
+-- | Selects upper-case or title-case alphabetic Unicode characters (letters).
+-- Title case is used by a small number of letter ligatures like the
+-- single-character form of /Lj/.
+isUpper                 :: Char -> Bool
+
+-- | Selects lower-case alphabetic Unicode characters (letters).
+isLower                 :: Char -> Bool
+
+-- | Selects alphabetic Unicode characters (lower-case, upper-case and
+-- title-case letters, plus letters of caseless scripts and modifiers letters).
+-- This function is equivalent to 'Data.Char.isLetter'.
+isAlpha                 :: Char -> Bool
+
+-- | Selects alphabetic or numeric digit Unicode characters.
+--
+-- Note that numeric digits outside the ASCII range are selected by this
+-- function but not by 'isDigit'.  Such digits may be part of identifiers
+-- but are not used by the printer and reader to represent numbers.
+isAlphaNum              :: Char -> Bool
+
+-- | Selects ASCII digits, i.e. @\'0\'@..@\'9\'@.
+isDigit                 :: Char -> Bool
+isDigit c               =  c >= '0' && c <= '9'
+
+-- | Selects ASCII octal digits, i.e. @\'0\'@..@\'7\'@.
+isOctDigit              :: Char -> Bool
+isOctDigit c            =  c >= '0' && c <= '7'
+
+-- | Selects ASCII hexadecimal digits,
+-- i.e. @\'0\'@..@\'9\'@, @\'a\'@..@\'f\'@, @\'A\'@..@\'F\'@.
+isHexDigit              :: Char -> Bool
+isHexDigit c            =  isDigit c || c >= 'A' && c <= 'F' ||
+                                        c >= 'a' && c <= 'f'
+
+-- | Convert a letter to the corresponding upper-case letter, if any.
+-- Any other character is returned unchanged.
+toUpper                 :: Char -> Char
+
+-- | Convert a letter to the corresponding lower-case letter, if any.
+-- Any other character is returned unchanged.
+toLower                 :: Char -> Char
+
+-- | Convert a letter to the corresponding title-case or upper-case
+-- letter, if any.  (Title case differs from upper case only for a small
+-- number of ligature letters.)
+-- Any other character is returned unchanged.
+toTitle                 :: Char -> Char
+
+-- -----------------------------------------------------------------------------
+-- Implementation with the supplied auto-generated Unicode character properties
+-- table
+
+-- Regardless of the O/S and Library, use the functions contained in WCsubst.c
+
+isAlpha    c = iswalpha (fromIntegral (ord c)) /= 0
+isAlphaNum c = iswalnum (fromIntegral (ord c)) /= 0
+--isSpace    c = iswspace (fromIntegral (ord c)) /= 0
+isControl  c = iswcntrl (fromIntegral (ord c)) /= 0
+isPrint    c = iswprint (fromIntegral (ord c)) /= 0
+isUpper    c = iswupper (fromIntegral (ord c)) /= 0
+isLower    c = iswlower (fromIntegral (ord c)) /= 0
+
+toLower c = chr (fromIntegral (towlower (fromIntegral (ord c))))
+toUpper c = chr (fromIntegral (towupper (fromIntegral (ord c))))
+toTitle c = chr (fromIntegral (towtitle (fromIntegral (ord c))))
+
+foreign import ccall unsafe "u_iswalpha"
+  iswalpha :: CInt -> CInt
+
+foreign import ccall unsafe "u_iswalnum"
+  iswalnum :: CInt -> CInt
+
+foreign import ccall unsafe "u_iswcntrl"
+  iswcntrl :: CInt -> CInt
+
+foreign import ccall unsafe "u_iswspace"
+  iswspace :: CInt -> CInt
+
+foreign import ccall unsafe "u_iswprint"
+  iswprint :: CInt -> CInt
+
+foreign import ccall unsafe "u_iswlower"
+  iswlower :: CInt -> CInt
+
+foreign import ccall unsafe "u_iswupper"
+  iswupper :: CInt -> CInt
+
+foreign import ccall unsafe "u_towlower"
+  towlower :: CInt -> CInt
+
+foreign import ccall unsafe "u_towupper"
+  towupper :: CInt -> CInt
+
+foreign import ccall unsafe "u_towtitle"
+  towtitle :: CInt -> CInt
+
+foreign import ccall unsafe "u_gencat"
+  wgencat :: CInt -> CInt
+
diff --git a/libraries/base/GHC/Unicode.hs-boot b/libraries/base/GHC/Unicode.hs-boot
new file mode 100644
index 000000000000..51bf87ddcfc8
--- /dev/null
+++ b/libraries/base/GHC/Unicode.hs-boot
@@ -0,0 +1,20 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+
+module GHC.Unicode where
+
+import GHC.Types
+
+isAscii         :: Char -> Bool
+isLatin1        :: Char -> Bool
+isControl       :: Char -> Bool
+isPrint         :: Char -> Bool
+isSpace         :: Char -> Bool
+isUpper         :: Char -> Bool
+isLower         :: Char -> Bool
+isAlpha         :: Char -> Bool
+isDigit         :: Char -> Bool
+isOctDigit      :: Char -> Bool
+isHexDigit      :: Char -> Bool
+isAlphaNum      :: Char -> Bool
+
diff --git a/libraries/base/GHC/Weak.lhs b/libraries/base/GHC/Weak.lhs
new file mode 100644
index 000000000000..bffd9f82366e
--- /dev/null
+++ b/libraries/base/GHC/Weak.lhs
@@ -0,0 +1,161 @@
+\begin{code}
+{-# LANGUAGE Unsafe #-}
+{-# LANGUAGE NoImplicitPrelude
+           , BangPatterns
+           , MagicHash
+           , UnboxedTuples
+           , DeriveDataTypeable
+           , StandaloneDeriving
+  #-}
+{-# OPTIONS_HADDOCK hide #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.Weak
+-- Copyright   :  (c) The University of Glasgow, 1998-2002
+-- License     :  see libraries/base/LICENSE
+-- 
+-- Maintainer  :  cvs-ghc@haskell.org
+-- Stability   :  internal
+-- Portability :  non-portable (GHC Extensions)
+--
+-- Weak pointers.
+--
+-----------------------------------------------------------------------------
+
+module GHC.Weak (
+        Weak(..),
+        mkWeak,
+        deRefWeak,
+        finalize,
+        runFinalizerBatch
+    ) where
+
+import GHC.Base
+import Data.Maybe
+import Data.Typeable
+
+{-|
+A weak pointer object with a key and a value.  The value has type @v@.
+
+A weak pointer expresses a relationship between two objects, the
+/key/ and the /value/:  if the key is considered to be alive by the
+garbage collector, then the value is also alive.  A reference from
+the value to the key does /not/ keep the key alive.
+
+A weak pointer may also have a finalizer of type @IO ()@; if it does,
+then the finalizer will be run at most once, at a time after the key
+has become unreachable by the program (\"dead\").  The storage manager
+attempts to run the finalizer(s) for an object soon after the object
+dies, but promptness is not guaranteed.  
+
+It is not guaranteed that a finalizer will eventually run, and no
+attempt is made to run outstanding finalizers when the program exits.
+Therefore finalizers should not be relied on to clean up resources -
+other methods (eg. exception handlers) should be employed, possibly in
+addition to finalizers.
+
+References from the finalizer to the key are treated in the same way
+as references from the value to the key: they do not keep the key
+alive.  A finalizer may therefore ressurrect the key, perhaps by
+storing it in the same data structure.
+
+The finalizer, and the relationship between the key and the value,
+exist regardless of whether the program keeps a reference to the
+'Weak' object or not.
+
+There may be multiple weak pointers with the same key.  In this
+case, the finalizers for each of these weak pointers will all be
+run in some arbitrary order, or perhaps concurrently, when the key
+dies.  If the programmer specifies a finalizer that assumes it has
+the only reference to an object (for example, a file that it wishes
+to close), then the programmer must ensure that there is only one
+such finalizer.
+
+If there are no other threads to run, the runtime system will check
+for runnable finalizers before declaring the system to be deadlocked.
+
+WARNING: weak pointers to ordinary non-primitive Haskell types are
+particularly fragile, because the compiler is free to optimise away or
+duplicate the underlying data structure.  Therefore attempting to
+place a finalizer on an ordinary Haskell type may well result in the
+finalizer running earlier than you expected.  This is not a problem
+for caches and memo tables where early finalization is benign.
+
+Finalizers /can/ be used reliably for types that are created explicitly
+and have identity, such as @IORef@ and @MVar@.  However, to place a
+finalizer on one of these types, you should use the specific operation
+provided for that type, e.g. @mkWeakIORef@ and @addMVarFinalizer@
+respectively (the non-uniformity is accidental).  These operations
+attach the finalizer to the primitive object inside the box
+(e.g. @MutVar#@ in the case of @IORef@), because attaching the
+finalizer to the box itself fails when the outer box is optimised away
+by the compiler.
+
+-}
+data Weak v = Weak (Weak# v) deriving Typeable
+
+-- | Establishes a weak pointer to @k@, with value @v@ and a finalizer.
+--
+-- This is the most general interface for building a weak pointer.
+--
+mkWeak  :: k                            -- ^ key
+        -> v                            -- ^ value
+        -> Maybe (IO ())                -- ^ finalizer
+        -> IO (Weak v)                  -- ^ returns: a weak pointer object
+
+mkWeak key val (Just finalizer) = IO $ \s ->
+   case mkWeak# key val finalizer s of { (# s1, w #) -> (# s1, Weak w #) }
+mkWeak key val Nothing = IO $ \s ->
+   case mkWeakNoFinalizer# key val s of { (# s1, w #) -> (# s1, Weak w #) }
+
+{-|
+Dereferences a weak pointer.  If the key is still alive, then
+@'Just' v@ is returned (where @v@ is the /value/ in the weak pointer), otherwise
+'Nothing' is returned.
+
+The return value of 'deRefWeak' depends on when the garbage collector
+runs, hence it is in the 'IO' monad.
+-}
+deRefWeak :: Weak v -> IO (Maybe v)
+deRefWeak (Weak w) = IO $ \s ->
+   case deRefWeak# w s of
+        (# s1, flag, p #) -> case flag of
+                                0# -> (# s1, Nothing #)
+                                _  -> (# s1, Just p #)
+
+-- | Causes a the finalizer associated with a weak pointer to be run
+-- immediately.
+finalize :: Weak v -> IO ()
+finalize (Weak w) = IO $ \s ->
+   case finalizeWeak# w s of
+        (# s1, 0#, _ #) -> (# s1, () #) -- already dead, or no finalizer
+        (# s1, _,  f #) -> f s1
+
+{-
+Instance Eq (Weak v) where
+  (Weak w1) == (Weak w2) = w1 `sameWeak#` w2
+-}
+
+
+-- run a batch of finalizers from the garbage collector.  We're given 
+-- an array of finalizers and the length of the array, and we just
+-- call each one in turn.
+--
+-- the IO primitives are inlined by hand here to get the optimal
+-- code (sigh) --SDM.
+
+runFinalizerBatch :: Int -> Array# (IO ()) -> IO ()
+runFinalizerBatch (I# n) arr = 
+   let  go m  = IO $ \s ->
+                  case m of 
+                  0# -> (# s, () #)
+                  _  -> let !m' = m -# 1# in
+                        case indexArray# arr m' of { (# io #) -> 
+                        case unIO io s of          { (# s', _ #) -> 
+                        unIO (go m') s'
+                        }}
+   in
+        go n
+
+\end{code}
diff --git a/libraries/base/GHC/Windows.hs b/libraries/base/GHC/Windows.hs
new file mode 100644
index 000000000000..940ba5897d7c
--- /dev/null
+++ b/libraries/base/GHC/Windows.hs
@@ -0,0 +1,195 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.Windows
+-- Copyright   :  (c) The University of Glasgow, 2009
+-- License     :  see libraries/base/LICENSE
+-- 
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  internal
+-- Portability :  non-portable
+--
+-- Windows functionality used by several modules.
+--
+-- ToDo: this just duplicates part of System.Win32.Types, which isn't
+-- available yet.  We should move some Win32 functionality down here,
+-- maybe as part of the grand reorganisation of the base package...
+--
+-----------------------------------------------------------------------------
+
+module GHC.Windows (
+        -- * Types
+        BOOL,
+        LPBOOL,
+        BYTE,
+        DWORD,
+        UINT,
+        ErrCode,
+        HANDLE,
+        LPWSTR,
+        LPTSTR,
+
+        -- * Constants
+        iNFINITE,
+        iNVALID_HANDLE_VALUE,
+
+        -- * System errors
+        throwGetLastError,
+        failWith,
+        getLastError,
+        getErrorMessage,
+        errCodeToIOError,
+
+        -- ** Guards for system calls that might fail
+        failIf,
+        failIf_,
+        failIfNull,
+        failIfZero,
+        failIfFalse_,
+        failUnlessSuccess,
+        failUnlessSuccessOr,
+
+        -- ** Mapping system errors to errno
+        -- $errno
+        c_maperrno,
+        c_maperrno_func,
+    ) where
+
+import Data.Char
+import Data.List
+import Data.Maybe
+import Data.Word
+import Foreign.C.Error
+import Foreign.C.String
+import Foreign.C.Types
+import Foreign.Ptr
+import GHC.Base
+import GHC.IO
+import GHC.Num
+import System.IO.Error
+
+import qualified Numeric
+
+#if defined(i386_HOST_ARCH)
+# define WINDOWS_CCONV stdcall
+#elif defined(x86_64_HOST_ARCH)
+# define WINDOWS_CCONV ccall
+#else
+# error Unknown mingw32 arch
+#endif
+
+type BOOL    = Bool
+type LPBOOL  = Ptr BOOL
+type BYTE    = Word8
+type DWORD   = Word32
+type UINT    = Word32
+type ErrCode = DWORD
+type HANDLE  = Ptr ()
+type LPWSTR  = Ptr CWchar
+
+-- | Be careful with this.  LPTSTR can mean either WCHAR* or CHAR*, depending
+-- on whether the UNICODE macro is defined in the corresponding C code.
+-- Consider using LPWSTR instead.
+type LPTSTR = LPWSTR
+
+iNFINITE :: DWORD
+iNFINITE = 0xFFFFFFFF -- urgh
+
+iNVALID_HANDLE_VALUE :: HANDLE
+iNVALID_HANDLE_VALUE = wordPtrToPtr (-1)
+
+-- | Get the last system error, and throw it as an 'IOError' exception.
+throwGetLastError :: String -> IO a
+throwGetLastError where_from =
+    getLastError >>= failWith where_from
+
+-- | Convert a Windows error code to an exception, then throw it.
+failWith :: String -> ErrCode -> IO a
+failWith fn_name err_code =
+    errCodeToIOError fn_name err_code >>= throwIO
+
+-- | Convert a Windows error code to an exception.
+errCodeToIOError :: String -> ErrCode -> IO IOError
+errCodeToIOError fn_name err_code = do
+    msg <- getErrorMessage err_code
+
+    -- turn GetLastError() into errno, which errnoToIOError knows
+    -- how to convert to an IOException we can throw.
+    -- XXX we should really do this directly.
+    let errno = c_maperrno_func err_code
+
+    let msg' = reverse $ dropWhile isSpace $ reverse msg -- drop trailing \n
+        ioerror = errnoToIOError fn_name errno Nothing Nothing
+                    `ioeSetErrorString` msg'
+    return ioerror
+
+-- | Get a string describing a Windows error code.  This uses the
+-- @FormatMessage@ system call.
+getErrorMessage :: ErrCode -> IO String
+getErrorMessage err_code =
+    mask_ $ do
+        c_msg <- c_getErrorMessage err_code
+        if c_msg == nullPtr
+          then return $ "Error 0x" ++ Numeric.showHex err_code ""
+          else do msg <- peekCWString c_msg
+                  -- We ignore failure of freeing c_msg, given we're already failing
+                  _ <- localFree c_msg
+                  return msg
+
+failIf :: (a -> Bool) -> String -> IO a -> IO a
+failIf p wh act = do
+    v <- act
+    if p v then throwGetLastError wh else return v
+
+failIf_ :: (a -> Bool) -> String -> IO a -> IO ()
+failIf_ p wh act = do
+    v <- act
+    if p v then throwGetLastError wh else return ()
+
+failIfNull :: String -> IO (Ptr a) -> IO (Ptr a)
+failIfNull = failIf (== nullPtr)
+
+failIfZero :: (Eq a, Num a) => String -> IO a -> IO a
+failIfZero = failIf (== 0)
+
+failIfFalse_ :: String -> IO Bool -> IO ()
+failIfFalse_ = failIf_ not
+
+failUnlessSuccess :: String -> IO ErrCode -> IO ()
+failUnlessSuccess fn_name act = do
+    r <- act
+    if r == 0 then return () else failWith fn_name r
+
+failUnlessSuccessOr :: ErrCode -> String -> IO ErrCode -> IO Bool
+failUnlessSuccessOr val fn_name act = do
+    r <- act
+    if r == 0 then return False
+        else if r == val then return True
+        else failWith fn_name r
+
+-- $errno
+--
+-- On Windows, @errno@ is defined by msvcrt.dll for compatibility with other
+-- systems, and is distinct from the system error as returned
+-- by @GetLastError@.
+
+-- | Map the last system error to an errno value, and assign it to @errno@.
+foreign import ccall unsafe "maperrno"             -- in Win32Utils.c
+   c_maperrno :: IO ()
+
+-- | Pure function variant of 'c_maperrno' that does not call @GetLastError@
+-- or modify @errno@.
+foreign import ccall unsafe "maperrno_func"        -- in Win32Utils.c
+   c_maperrno_func :: ErrCode -> Errno
+
+foreign import ccall unsafe "base_getErrorMessage" -- in Win32Utils.c
+    c_getErrorMessage :: DWORD -> IO LPWSTR
+
+foreign import WINDOWS_CCONV unsafe "windows.h LocalFree"
+    localFree :: Ptr a -> IO (Ptr a)
+
+-- | Get the last system error produced in the current thread.
+foreign import WINDOWS_CCONV unsafe "windows.h GetLastError"
+    getLastError :: IO ErrCode
diff --git a/libraries/base/GHC/Word.hs b/libraries/base/GHC/Word.hs
new file mode 100644
index 000000000000..86978dc9c42e
--- /dev/null
+++ b/libraries/base/GHC/Word.hs
@@ -0,0 +1,798 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE CPP, NoImplicitPrelude, BangPatterns, MagicHash, UnboxedTuples #-}
+{-# OPTIONS_HADDOCK hide #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.Word
+-- Copyright   :  (c) The University of Glasgow, 1997-2002
+-- License     :  see libraries/base/LICENSE
+--
+-- Maintainer  :  cvs-ghc@haskell.org
+-- Stability   :  internal
+-- Portability :  non-portable (GHC Extensions)
+--
+-- Sized unsigned integral types: 'Word', 'Word8', 'Word16', 'Word32', and
+-- 'Word64'.
+--
+-----------------------------------------------------------------------------
+
+#include "MachDeps.h"
+
+module GHC.Word (
+    Word(..), Word8(..), Word16(..), Word32(..), Word64(..),
+    uncheckedShiftL64#,
+    uncheckedShiftRL64#,
+    byteSwap16,
+    byteSwap32,
+    byteSwap64
+    ) where
+
+import Data.Bits
+import Data.Maybe
+
+#if WORD_SIZE_IN_BITS < 64
+import GHC.IntWord64
+#endif
+
+-- import {-# SOURCE #-} GHC.Exception
+import GHC.Base
+import GHC.Enum
+import GHC.Num
+import GHC.Real
+import GHC.Read
+import GHC.Arr
+import GHC.Show
+import GHC.Float ()     -- for RealFrac methods
+
+------------------------------------------------------------------------
+-- type Word8
+------------------------------------------------------------------------
+
+-- Word8 is represented in the same way as Word. Operations may assume
+-- and must ensure that it holds only values from its logical range.
+
+data {-# CTYPE "HsWord8" #-} Word8 = W8# Word# deriving (Eq, Ord)
+-- ^ 8-bit unsigned integer type
+
+instance Show Word8 where
+    showsPrec p x = showsPrec p (fromIntegral x :: Int)
+
+instance Num Word8 where
+    (W8# x#) + (W8# y#)    = W8# (narrow8Word# (x# `plusWord#` y#))
+    (W8# x#) - (W8# y#)    = W8# (narrow8Word# (x# `minusWord#` y#))
+    (W8# x#) * (W8# y#)    = W8# (narrow8Word# (x# `timesWord#` y#))
+    negate (W8# x#)        = W8# (narrow8Word# (int2Word# (negateInt# (word2Int# x#))))
+    abs x                  = x
+    signum 0               = 0
+    signum _               = 1
+    fromInteger i          = W8# (narrow8Word# (integerToWord i))
+
+instance Real Word8 where
+    toRational x = toInteger x % 1
+
+instance Enum Word8 where
+    succ x
+        | x /= maxBound = x + 1
+        | otherwise     = succError "Word8"
+    pred x
+        | x /= minBound = x - 1
+        | otherwise     = predError "Word8"
+    toEnum i@(I# i#)
+        | i >= 0 && i <= fromIntegral (maxBound::Word8)
+                        = W8# (int2Word# i#)
+        | otherwise     = toEnumError "Word8" i (minBound::Word8, maxBound::Word8)
+    fromEnum (W8# x#)   = I# (word2Int# x#)
+    enumFrom            = boundedEnumFrom
+    enumFromThen        = boundedEnumFromThen
+
+instance Integral Word8 where
+    quot    (W8# x#) y@(W8# y#)
+        | y /= 0                  = W8# (x# `quotWord#` y#)
+        | otherwise               = divZeroError
+    rem     (W8# x#) y@(W8# y#)
+        | y /= 0                  = W8# (x# `remWord#` y#)
+        | otherwise               = divZeroError
+    div     (W8# x#) y@(W8# y#)
+        | y /= 0                  = W8# (x# `quotWord#` y#)
+        | otherwise               = divZeroError
+    mod     (W8# x#) y@(W8# y#)
+        | y /= 0                  = W8# (x# `remWord#` y#)
+        | otherwise               = divZeroError
+    quotRem (W8# x#) y@(W8# y#)
+        | y /= 0                  = case x# `quotRemWord#` y# of
+                                    (# q, r #) ->
+                                        (W8# q, W8# r)
+        | otherwise               = divZeroError
+    divMod  (W8# x#) y@(W8# y#)
+        | y /= 0                  = (W8# (x# `quotWord#` y#), W8# (x# `remWord#` y#))
+        | otherwise               = divZeroError
+    toInteger (W8# x#)            = smallInteger (word2Int# x#)
+
+instance Bounded Word8 where
+    minBound = 0
+    maxBound = 0xFF
+
+instance Ix Word8 where
+    range (m,n)         = [m..n]
+    unsafeIndex (m,_) i = fromIntegral (i - m)
+    inRange (m,n) i     = m <= i && i <= n
+
+instance Read Word8 where
+    readsPrec p s = [(fromIntegral (x::Int), r) | (x, r) <- readsPrec p s]
+
+instance Bits Word8 where
+    {-# INLINE shift #-}
+    {-# INLINE bit #-}
+    {-# INLINE testBit #-}
+
+    (W8# x#) .&.   (W8# y#)   = W8# (x# `and#` y#)
+    (W8# x#) .|.   (W8# y#)   = W8# (x# `or#`  y#)
+    (W8# x#) `xor` (W8# y#)   = W8# (x# `xor#` y#)
+    complement (W8# x#)       = W8# (x# `xor#` mb#)
+        where !(W8# mb#) = maxBound
+    (W8# x#) `shift` (I# i#)
+        | isTrue# (i# >=# 0#) = W8# (narrow8Word# (x# `shiftL#` i#))
+        | otherwise           = W8# (x# `shiftRL#` negateInt# i#)
+    (W8# x#) `shiftL`       (I# i#) = W8# (narrow8Word# (x# `shiftL#` i#))
+    (W8# x#) `unsafeShiftL` (I# i#) =
+        W8# (narrow8Word# (x# `uncheckedShiftL#` i#))
+    (W8# x#) `shiftR`       (I# i#) = W8# (x# `shiftRL#` i#)
+    (W8# x#) `unsafeShiftR` (I# i#) = W8# (x# `uncheckedShiftRL#` i#)
+    (W8# x#) `rotate`       (I# i#)
+        | isTrue# (i'# ==# 0#) = W8# x#
+        | otherwise  = W8# (narrow8Word# ((x# `uncheckedShiftL#` i'#) `or#`
+                                          (x# `uncheckedShiftRL#` (8# -# i'#))))
+        where
+        !i'# = word2Int# (int2Word# i# `and#` 7##)
+    bitSizeMaybe i            = Just (finiteBitSize i)
+    bitSize i                 = finiteBitSize i
+    isSigned _                = False
+    popCount (W8# x#)         = I# (word2Int# (popCnt8# x#))
+    bit                       = bitDefault
+    testBit                   = testBitDefault
+
+instance FiniteBits Word8 where
+    finiteBitSize _ = 8
+
+{-# RULES
+"fromIntegral/Word8->Word8"   fromIntegral = id :: Word8 -> Word8
+"fromIntegral/Word8->Integer" fromIntegral = toInteger :: Word8 -> Integer
+"fromIntegral/a->Word8"       fromIntegral = \x -> case fromIntegral x of W# x# -> W8# (narrow8Word# x#)
+"fromIntegral/Word8->a"       fromIntegral = \(W8# x#) -> fromIntegral (W# x#)
+  #-}
+
+{-# RULES
+"properFraction/Float->(Word8,Float)"
+    properFraction = \x ->
+                      case properFraction x of {
+                        (n, y) -> ((fromIntegral :: Int -> Word8) n, y :: Float) }
+"truncate/Float->Word8"
+    truncate = (fromIntegral :: Int -> Word8) . (truncate :: Float -> Int)
+"floor/Float->Word8"
+    floor    = (fromIntegral :: Int -> Word8) . (floor :: Float -> Int)
+"ceiling/Float->Word8"
+    ceiling  = (fromIntegral :: Int -> Word8) . (ceiling :: Float -> Int)
+"round/Float->Word8"
+    round    = (fromIntegral :: Int -> Word8) . (round  :: Float -> Int)
+  #-}
+
+{-# RULES
+"properFraction/Double->(Word8,Double)"
+    properFraction = \x ->
+                      case properFraction x of {
+                        (n, y) -> ((fromIntegral :: Int -> Word8) n, y :: Double) }
+"truncate/Double->Word8"
+    truncate = (fromIntegral :: Int -> Word8) . (truncate :: Double -> Int)
+"floor/Double->Word8"
+    floor    = (fromIntegral :: Int -> Word8) . (floor :: Double -> Int)
+"ceiling/Double->Word8"
+    ceiling  = (fromIntegral :: Int -> Word8) . (ceiling :: Double -> Int)
+"round/Double->Word8"
+    round    = (fromIntegral :: Int -> Word8) . (round  :: Double -> Int)
+  #-}
+
+------------------------------------------------------------------------
+-- type Word16
+------------------------------------------------------------------------
+
+-- Word16 is represented in the same way as Word. Operations may assume
+-- and must ensure that it holds only values from its logical range.
+
+data {-# CTYPE "HsWord16" #-} Word16 = W16# Word# deriving (Eq, Ord)
+-- ^ 16-bit unsigned integer type
+
+instance Show Word16 where
+    showsPrec p x = showsPrec p (fromIntegral x :: Int)
+
+instance Num Word16 where
+    (W16# x#) + (W16# y#)  = W16# (narrow16Word# (x# `plusWord#` y#))
+    (W16# x#) - (W16# y#)  = W16# (narrow16Word# (x# `minusWord#` y#))
+    (W16# x#) * (W16# y#)  = W16# (narrow16Word# (x# `timesWord#` y#))
+    negate (W16# x#)       = W16# (narrow16Word# (int2Word# (negateInt# (word2Int# x#))))
+    abs x                  = x
+    signum 0               = 0
+    signum _               = 1
+    fromInteger i          = W16# (narrow16Word# (integerToWord i))
+
+instance Real Word16 where
+    toRational x = toInteger x % 1
+
+instance Enum Word16 where
+    succ x
+        | x /= maxBound = x + 1
+        | otherwise     = succError "Word16"
+    pred x
+        | x /= minBound = x - 1
+        | otherwise     = predError "Word16"
+    toEnum i@(I# i#)
+        | i >= 0 && i <= fromIntegral (maxBound::Word16)
+                        = W16# (int2Word# i#)
+        | otherwise     = toEnumError "Word16" i (minBound::Word16, maxBound::Word16)
+    fromEnum (W16# x#)  = I# (word2Int# x#)
+    enumFrom            = boundedEnumFrom
+    enumFromThen        = boundedEnumFromThen
+
+instance Integral Word16 where
+    quot    (W16# x#) y@(W16# y#)
+        | y /= 0                    = W16# (x# `quotWord#` y#)
+        | otherwise                 = divZeroError
+    rem     (W16# x#) y@(W16# y#)
+        | y /= 0                    = W16# (x# `remWord#` y#)
+        | otherwise                 = divZeroError
+    div     (W16# x#) y@(W16# y#)
+        | y /= 0                    = W16# (x# `quotWord#` y#)
+        | otherwise                 = divZeroError
+    mod     (W16# x#) y@(W16# y#)
+        | y /= 0                    = W16# (x# `remWord#` y#)
+        | otherwise                 = divZeroError
+    quotRem (W16# x#) y@(W16# y#)
+        | y /= 0                  = case x# `quotRemWord#` y# of
+                                    (# q, r #) ->
+                                        (W16# q, W16# r)
+        | otherwise                 = divZeroError
+    divMod  (W16# x#) y@(W16# y#)
+        | y /= 0                    = (W16# (x# `quotWord#` y#), W16# (x# `remWord#` y#))
+        | otherwise                 = divZeroError
+    toInteger (W16# x#)             = smallInteger (word2Int# x#)
+
+instance Bounded Word16 where
+    minBound = 0
+    maxBound = 0xFFFF
+
+instance Ix Word16 where
+    range (m,n)         = [m..n]
+    unsafeIndex (m,_) i = fromIntegral (i - m)
+    inRange (m,n) i     = m <= i && i <= n
+
+instance Read Word16 where
+    readsPrec p s = [(fromIntegral (x::Int), r) | (x, r) <- readsPrec p s]
+
+instance Bits Word16 where
+    {-# INLINE shift #-}
+    {-# INLINE bit #-}
+    {-# INLINE testBit #-}
+
+    (W16# x#) .&.   (W16# y#)  = W16# (x# `and#` y#)
+    (W16# x#) .|.   (W16# y#)  = W16# (x# `or#`  y#)
+    (W16# x#) `xor` (W16# y#)  = W16# (x# `xor#` y#)
+    complement (W16# x#)       = W16# (x# `xor#` mb#)
+        where !(W16# mb#) = maxBound
+    (W16# x#) `shift` (I# i#)
+        | isTrue# (i# >=# 0#)  = W16# (narrow16Word# (x# `shiftL#` i#))
+        | otherwise            = W16# (x# `shiftRL#` negateInt# i#)
+    (W16# x#) `shiftL` (I# i#)       = W16# (narrow16Word# (x# `shiftL#` i#))
+    (W16# x#) `unsafeShiftL` (I# i#) =
+        W16# (narrow16Word# (x# `uncheckedShiftL#` i#))
+    (W16# x#) `shiftR`       (I# i#) = W16# (x# `shiftRL#` i#)
+    (W16# x#) `unsafeShiftR` (I# i#) = W16# (x# `uncheckedShiftRL#` i#)
+    (W16# x#) `rotate`       (I# i#)
+        | isTrue# (i'# ==# 0#) = W16# x#
+        | otherwise  = W16# (narrow16Word# ((x# `uncheckedShiftL#` i'#) `or#`
+                                            (x# `uncheckedShiftRL#` (16# -# i'#))))
+        where
+        !i'# = word2Int# (int2Word# i# `and#` 15##)
+    bitSizeMaybe i            = Just (finiteBitSize i)
+    bitSize i                 = finiteBitSize i
+    isSigned _                = False
+    popCount (W16# x#)        = I# (word2Int# (popCnt16# x#))
+    bit                       = bitDefault
+    testBit                   = testBitDefault
+
+instance FiniteBits Word16 where
+    finiteBitSize _ = 16
+
+-- | Swap bytes in 'Word16'.
+--
+-- /Since: 4.7.0.0/
+byteSwap16 :: Word16 -> Word16
+byteSwap16 (W16# w#) = W16# (narrow16Word# (byteSwap16# w#))
+
+{-# RULES
+"fromIntegral/Word8->Word16"   fromIntegral = \(W8# x#) -> W16# x#
+"fromIntegral/Word16->Word16"  fromIntegral = id :: Word16 -> Word16
+"fromIntegral/Word16->Integer" fromIntegral = toInteger :: Word16 -> Integer
+"fromIntegral/a->Word16"       fromIntegral = \x -> case fromIntegral x of W# x# -> W16# (narrow16Word# x#)
+"fromIntegral/Word16->a"       fromIntegral = \(W16# x#) -> fromIntegral (W# x#)
+  #-}
+
+{-# RULES
+"properFraction/Float->(Word16,Float)"
+    properFraction = \x ->
+                      case properFraction x of {
+                        (n, y) -> ((fromIntegral :: Int -> Word16) n, y :: Float) }
+"truncate/Float->Word16"
+    truncate = (fromIntegral :: Int -> Word16) . (truncate :: Float -> Int)
+"floor/Float->Word16"
+    floor    = (fromIntegral :: Int -> Word16) . (floor :: Float -> Int)
+"ceiling/Float->Word16"
+    ceiling  = (fromIntegral :: Int -> Word16) . (ceiling :: Float -> Int)
+"round/Float->Word16"
+    round    = (fromIntegral :: Int -> Word16) . (round  :: Float -> Int)
+  #-}
+
+{-# RULES
+"properFraction/Double->(Word16,Double)"
+    properFraction = \x ->
+                      case properFraction x of {
+                        (n, y) -> ((fromIntegral :: Int -> Word16) n, y :: Double) }
+"truncate/Double->Word16"
+    truncate = (fromIntegral :: Int -> Word16) . (truncate :: Double -> Int)
+"floor/Double->Word16"
+    floor    = (fromIntegral :: Int -> Word16) . (floor :: Double -> Int)
+"ceiling/Double->Word16"
+    ceiling  = (fromIntegral :: Int -> Word16) . (ceiling :: Double -> Int)
+"round/Double->Word16"
+    round    = (fromIntegral :: Int -> Word16) . (round  :: Double -> Int)
+  #-}
+
+------------------------------------------------------------------------
+-- type Word32
+------------------------------------------------------------------------
+
+-- Word32 is represented in the same way as Word.
+#if WORD_SIZE_IN_BITS > 32
+-- Operations may assume and must ensure that it holds only values
+-- from its logical range.
+
+-- We can use rewrite rules for the RealFrac methods
+
+{-# RULES
+"properFraction/Float->(Word32,Float)"
+    properFraction = \x ->
+                      case properFraction x of {
+                        (n, y) -> ((fromIntegral :: Int -> Word32) n, y :: Float) }
+"truncate/Float->Word32"
+    truncate = (fromIntegral :: Int -> Word32) . (truncate :: Float -> Int)
+"floor/Float->Word32"
+    floor    = (fromIntegral :: Int -> Word32) . (floor :: Float -> Int)
+"ceiling/Float->Word32"
+    ceiling  = (fromIntegral :: Int -> Word32) . (ceiling :: Float -> Int)
+"round/Float->Word32"
+    round    = (fromIntegral :: Int -> Word32) . (round  :: Float -> Int)
+  #-}
+
+{-# RULES
+"properFraction/Double->(Word32,Double)"
+    properFraction = \x ->
+                      case properFraction x of {
+                        (n, y) -> ((fromIntegral :: Int -> Word32) n, y :: Double) }
+"truncate/Double->Word32"
+    truncate = (fromIntegral :: Int -> Word32) . (truncate :: Double -> Int)
+"floor/Double->Word32"
+    floor    = (fromIntegral :: Int -> Word32) . (floor :: Double -> Int)
+"ceiling/Double->Word32"
+    ceiling  = (fromIntegral :: Int -> Word32) . (ceiling :: Double -> Int)
+"round/Double->Word32"
+    round    = (fromIntegral :: Int -> Word32) . (round  :: Double -> Int)
+  #-}
+
+#endif
+
+data {-# CTYPE "HsWord32" #-} Word32 = W32# Word# deriving (Eq, Ord)
+-- ^ 32-bit unsigned integer type
+
+instance Num Word32 where
+    (W32# x#) + (W32# y#)  = W32# (narrow32Word# (x# `plusWord#` y#))
+    (W32# x#) - (W32# y#)  = W32# (narrow32Word# (x# `minusWord#` y#))
+    (W32# x#) * (W32# y#)  = W32# (narrow32Word# (x# `timesWord#` y#))
+    negate (W32# x#)       = W32# (narrow32Word# (int2Word# (negateInt# (word2Int# x#))))
+    abs x                  = x
+    signum 0               = 0
+    signum _               = 1
+    fromInteger i          = W32# (narrow32Word# (integerToWord i))
+
+instance Enum Word32 where
+    succ x
+        | x /= maxBound = x + 1
+        | otherwise     = succError "Word32"
+    pred x
+        | x /= minBound = x - 1
+        | otherwise     = predError "Word32"
+    toEnum i@(I# i#)
+        | i >= 0
+#if WORD_SIZE_IN_BITS > 32
+          && i <= fromIntegral (maxBound::Word32)
+#endif
+                        = W32# (int2Word# i#)
+        | otherwise     = toEnumError "Word32" i (minBound::Word32, maxBound::Word32)
+#if WORD_SIZE_IN_BITS == 32
+    fromEnum x@(W32# x#)
+        | x <= fromIntegral (maxBound::Int)
+                        = I# (word2Int# x#)
+        | otherwise     = fromEnumError "Word32" x
+    enumFrom            = integralEnumFrom
+    enumFromThen        = integralEnumFromThen
+    enumFromTo          = integralEnumFromTo
+    enumFromThenTo      = integralEnumFromThenTo
+#else
+    fromEnum (W32# x#)  = I# (word2Int# x#)
+    enumFrom            = boundedEnumFrom
+    enumFromThen        = boundedEnumFromThen
+#endif
+
+instance Integral Word32 where
+    quot    (W32# x#) y@(W32# y#)
+        | y /= 0                    = W32# (x# `quotWord#` y#)
+        | otherwise                 = divZeroError
+    rem     (W32# x#) y@(W32# y#)
+        | y /= 0                    = W32# (x# `remWord#` y#)
+        | otherwise                 = divZeroError
+    div     (W32# x#) y@(W32# y#)
+        | y /= 0                    = W32# (x# `quotWord#` y#)
+        | otherwise                 = divZeroError
+    mod     (W32# x#) y@(W32# y#)
+        | y /= 0                    = W32# (x# `remWord#` y#)
+        | otherwise                 = divZeroError
+    quotRem (W32# x#) y@(W32# y#)
+        | y /= 0                  = case x# `quotRemWord#` y# of
+                                    (# q, r #) ->
+                                        (W32# q, W32# r)
+        | otherwise                 = divZeroError
+    divMod  (W32# x#) y@(W32# y#)
+        | y /= 0                    = (W32# (x# `quotWord#` y#), W32# (x# `remWord#` y#))
+        | otherwise                 = divZeroError
+    toInteger (W32# x#)
+#if WORD_SIZE_IN_BITS == 32
+        | isTrue# (i# >=# 0#)       = smallInteger i#
+        | otherwise                 = wordToInteger x#
+        where
+        !i# = word2Int# x#
+#else
+                                    = smallInteger (word2Int# x#)
+#endif
+
+instance Bits Word32 where
+    {-# INLINE shift #-}
+    {-# INLINE bit #-}
+    {-# INLINE testBit #-}
+
+    (W32# x#) .&.   (W32# y#)  = W32# (x# `and#` y#)
+    (W32# x#) .|.   (W32# y#)  = W32# (x# `or#`  y#)
+    (W32# x#) `xor` (W32# y#)  = W32# (x# `xor#` y#)
+    complement (W32# x#)       = W32# (x# `xor#` mb#)
+        where !(W32# mb#) = maxBound
+    (W32# x#) `shift` (I# i#)
+        | isTrue# (i# >=# 0#)  = W32# (narrow32Word# (x# `shiftL#` i#))
+        | otherwise            = W32# (x# `shiftRL#` negateInt# i#)
+    (W32# x#) `shiftL`       (I# i#) = W32# (narrow32Word# (x# `shiftL#` i#))
+    (W32# x#) `unsafeShiftL` (I# i#) =
+        W32# (narrow32Word# (x# `uncheckedShiftL#` i#))
+    (W32# x#) `shiftR`       (I# i#) = W32# (x# `shiftRL#` i#)
+    (W32# x#) `unsafeShiftR` (I# i#) = W32# (x# `uncheckedShiftRL#` i#)
+    (W32# x#) `rotate`       (I# i#)
+        | isTrue# (i'# ==# 0#) = W32# x#
+        | otherwise   = W32# (narrow32Word# ((x# `uncheckedShiftL#` i'#) `or#`
+                                            (x# `uncheckedShiftRL#` (32# -# i'#))))
+        where
+        !i'# = word2Int# (int2Word# i# `and#` 31##)
+    bitSizeMaybe i            = Just (finiteBitSize i)
+    bitSize i                 = finiteBitSize i
+    isSigned _                = False
+    popCount (W32# x#)        = I# (word2Int# (popCnt32# x#))
+    bit                       = bitDefault
+    testBit                   = testBitDefault
+
+instance FiniteBits Word32 where
+    finiteBitSize _ = 32
+
+{-# RULES
+"fromIntegral/Word8->Word32"   fromIntegral = \(W8# x#) -> W32# x#
+"fromIntegral/Word16->Word32"  fromIntegral = \(W16# x#) -> W32# x#
+"fromIntegral/Word32->Word32"  fromIntegral = id :: Word32 -> Word32
+"fromIntegral/Word32->Integer" fromIntegral = toInteger :: Word32 -> Integer
+"fromIntegral/a->Word32"       fromIntegral = \x -> case fromIntegral x of W# x# -> W32# (narrow32Word# x#)
+"fromIntegral/Word32->a"       fromIntegral = \(W32# x#) -> fromIntegral (W# x#)
+  #-}
+
+instance Show Word32 where
+#if WORD_SIZE_IN_BITS < 33
+    showsPrec p x = showsPrec p (toInteger x)
+#else
+    showsPrec p x = showsPrec p (fromIntegral x :: Int)
+#endif
+
+
+instance Real Word32 where
+    toRational x = toInteger x % 1
+
+instance Bounded Word32 where
+    minBound = 0
+    maxBound = 0xFFFFFFFF
+
+instance Ix Word32 where
+    range (m,n)         = [m..n]
+    unsafeIndex (m,_) i = fromIntegral (i - m)
+    inRange (m,n) i     = m <= i && i <= n
+
+instance Read Word32 where
+#if WORD_SIZE_IN_BITS < 33
+    readsPrec p s = [(fromInteger x, r) | (x, r) <- readsPrec p s]
+#else
+    readsPrec p s = [(fromIntegral (x::Int), r) | (x, r) <- readsPrec p s]
+#endif
+
+-- | Reverse order of bytes in 'Word32'.
+--
+-- /Since: 4.7.0.0/
+byteSwap32 :: Word32 -> Word32
+byteSwap32 (W32# w#) = W32# (narrow32Word# (byteSwap32# w#))
+
+------------------------------------------------------------------------
+-- type Word64
+------------------------------------------------------------------------
+
+#if WORD_SIZE_IN_BITS < 64
+
+data {-# CTYPE "HsWord64" #-} Word64 = W64# Word64#
+-- ^ 64-bit unsigned integer type
+
+instance Eq Word64 where
+    (W64# x#) == (W64# y#) = isTrue# (x# `eqWord64#` y#)
+    (W64# x#) /= (W64# y#) = isTrue# (x# `neWord64#` y#)
+
+instance Ord Word64 where
+    (W64# x#) <  (W64# y#) = isTrue# (x# `ltWord64#` y#)
+    (W64# x#) <= (W64# y#) = isTrue# (x# `leWord64#` y#)
+    (W64# x#) >  (W64# y#) = isTrue# (x# `gtWord64#` y#)
+    (W64# x#) >= (W64# y#) = isTrue# (x# `geWord64#` y#)
+
+instance Num Word64 where
+    (W64# x#) + (W64# y#)  = W64# (int64ToWord64# (word64ToInt64# x# `plusInt64#` word64ToInt64# y#))
+    (W64# x#) - (W64# y#)  = W64# (int64ToWord64# (word64ToInt64# x# `minusInt64#` word64ToInt64# y#))
+    (W64# x#) * (W64# y#)  = W64# (int64ToWord64# (word64ToInt64# x# `timesInt64#` word64ToInt64# y#))
+    negate (W64# x#)       = W64# (int64ToWord64# (negateInt64# (word64ToInt64# x#)))
+    abs x                  = x
+    signum 0               = 0
+    signum _               = 1
+    fromInteger i          = W64# (integerToWord64 i)
+
+instance Enum Word64 where
+    succ x
+        | x /= maxBound = x + 1
+        | otherwise     = succError "Word64"
+    pred x
+        | x /= minBound = x - 1
+        | otherwise     = predError "Word64"
+    toEnum i@(I# i#)
+        | i >= 0        = W64# (wordToWord64# (int2Word# i#))
+        | otherwise     = toEnumError "Word64" i (minBound::Word64, maxBound::Word64)
+    fromEnum x@(W64# x#)
+        | x <= fromIntegral (maxBound::Int)
+                        = I# (word2Int# (word64ToWord# x#))
+        | otherwise     = fromEnumError "Word64" x
+    enumFrom            = integralEnumFrom
+    enumFromThen        = integralEnumFromThen
+    enumFromTo          = integralEnumFromTo
+    enumFromThenTo      = integralEnumFromThenTo
+
+instance Integral Word64 where
+    quot    (W64# x#) y@(W64# y#)
+        | y /= 0                    = W64# (x# `quotWord64#` y#)
+        | otherwise                 = divZeroError
+    rem     (W64# x#) y@(W64# y#)
+        | y /= 0                    = W64# (x# `remWord64#` y#)
+        | otherwise                 = divZeroError
+    div     (W64# x#) y@(W64# y#)
+        | y /= 0                    = W64# (x# `quotWord64#` y#)
+        | otherwise                 = divZeroError
+    mod     (W64# x#) y@(W64# y#)
+        | y /= 0                    = W64# (x# `remWord64#` y#)
+        | otherwise                 = divZeroError
+    quotRem (W64# x#) y@(W64# y#)
+        | y /= 0                    = (W64# (x# `quotWord64#` y#), W64# (x# `remWord64#` y#))
+        | otherwise                 = divZeroError
+    divMod  (W64# x#) y@(W64# y#)
+        | y /= 0                    = (W64# (x# `quotWord64#` y#), W64# (x# `remWord64#` y#))
+        | otherwise                 = divZeroError
+    toInteger (W64# x#)             = word64ToInteger x#
+
+instance Bits Word64 where
+    {-# INLINE shift #-}
+    {-# INLINE bit #-}
+    {-# INLINE testBit #-}
+
+    (W64# x#) .&.   (W64# y#)  = W64# (x# `and64#` y#)
+    (W64# x#) .|.   (W64# y#)  = W64# (x# `or64#`  y#)
+    (W64# x#) `xor` (W64# y#)  = W64# (x# `xor64#` y#)
+    complement (W64# x#)       = W64# (not64# x#)
+    (W64# x#) `shift` (I# i#)
+        | isTrue# (i# >=# 0#)  = W64# (x# `shiftL64#` i#)
+        | otherwise            = W64# (x# `shiftRL64#` negateInt# i#)
+    (W64# x#) `shiftL`       (I# i#) = W64# (x# `shiftL64#` i#)
+    (W64# x#) `unsafeShiftL` (I# i#) = W64# (x# `uncheckedShiftL64#` i#)
+    (W64# x#) `shiftR`       (I# i#) = W64# (x# `shiftRL64#` i#)
+    (W64# x#) `unsafeShiftR` (I# i#) = W64# (x# `uncheckedShiftRL64#` i#)
+    (W64# x#) `rotate` (I# i#)
+        | isTrue# (i'# ==# 0#) = W64# x#
+        | otherwise            = W64# ((x# `uncheckedShiftL64#` i'#) `or64#`
+                                       (x# `uncheckedShiftRL64#` (64# -# i'#)))
+        where
+        !i'# = word2Int# (int2Word# i# `and#` 63##)
+    bitSizeMaybe i            = Just (finiteBitSize i)
+    bitSize i                 = finiteBitSize i
+    isSigned _                = False
+    popCount (W64# x#)        = I# (word2Int# (popCnt64# x#))
+    bit                       = bitDefault
+    testBit                   = testBitDefault
+
+-- give the 64-bit shift operations the same treatment as the 32-bit
+-- ones (see GHC.Base), namely we wrap them in tests to catch the
+-- cases when we're shifting more than 64 bits to avoid unspecified
+-- behaviour in the C shift operations.
+
+shiftL64#, shiftRL64# :: Word64# -> Int# -> Word64#
+
+a `shiftL64#` b  | isTrue# (b >=# 64#) = wordToWord64# 0##
+                 | otherwise           = a `uncheckedShiftL64#` b
+
+a `shiftRL64#` b | isTrue# (b >=# 64#) = wordToWord64# 0##
+                 | otherwise           = a `uncheckedShiftRL64#` b
+
+{-# RULES
+"fromIntegral/Int->Word64"    fromIntegral = \(I#   x#) -> W64# (int64ToWord64# (intToInt64# x#))
+"fromIntegral/Word->Word64"   fromIntegral = \(W#   x#) -> W64# (wordToWord64# x#)
+"fromIntegral/Word64->Int"    fromIntegral = \(W64# x#) -> I#   (word2Int# (word64ToWord# x#))
+"fromIntegral/Word64->Word"   fromIntegral = \(W64# x#) -> W#   (word64ToWord# x#)
+"fromIntegral/Word64->Word64" fromIntegral = id :: Word64 -> Word64
+  #-}
+
+#else
+
+-- Word64 is represented in the same way as Word.
+-- Operations may assume and must ensure that it holds only values
+-- from its logical range.
+
+data {-# CTYPE "HsWord64" #-} Word64 = W64# Word# deriving (Eq, Ord)
+-- ^ 64-bit unsigned integer type
+
+instance Num Word64 where
+    (W64# x#) + (W64# y#)  = W64# (x# `plusWord#` y#)
+    (W64# x#) - (W64# y#)  = W64# (x# `minusWord#` y#)
+    (W64# x#) * (W64# y#)  = W64# (x# `timesWord#` y#)
+    negate (W64# x#)       = W64# (int2Word# (negateInt# (word2Int# x#)))
+    abs x                  = x
+    signum 0               = 0
+    signum _               = 1
+    fromInteger i          = W64# (integerToWord i)
+
+instance Enum Word64 where
+    succ x
+        | x /= maxBound = x + 1
+        | otherwise     = succError "Word64"
+    pred x
+        | x /= minBound = x - 1
+        | otherwise     = predError "Word64"
+    toEnum i@(I# i#)
+        | i >= 0        = W64# (int2Word# i#)
+        | otherwise     = toEnumError "Word64" i (minBound::Word64, maxBound::Word64)
+    fromEnum x@(W64# x#)
+        | x <= fromIntegral (maxBound::Int)
+                        = I# (word2Int# x#)
+        | otherwise     = fromEnumError "Word64" x
+    enumFrom            = integralEnumFrom
+    enumFromThen        = integralEnumFromThen
+    enumFromTo          = integralEnumFromTo
+    enumFromThenTo      = integralEnumFromThenTo
+
+instance Integral Word64 where
+    quot    (W64# x#) y@(W64# y#)
+        | y /= 0                    = W64# (x# `quotWord#` y#)
+        | otherwise                 = divZeroError
+    rem     (W64# x#) y@(W64# y#)
+        | y /= 0                    = W64# (x# `remWord#` y#)
+        | otherwise                 = divZeroError
+    div     (W64# x#) y@(W64# y#)
+        | y /= 0                    = W64# (x# `quotWord#` y#)
+        | otherwise                 = divZeroError
+    mod     (W64# x#) y@(W64# y#)
+        | y /= 0                    = W64# (x# `remWord#` y#)
+        | otherwise                 = divZeroError
+    quotRem (W64# x#) y@(W64# y#)
+        | y /= 0                  = case x# `quotRemWord#` y# of
+                                    (# q, r #) ->
+                                        (W64# q, W64# r)
+        | otherwise                 = divZeroError
+    divMod  (W64# x#) y@(W64# y#)
+        | y /= 0                    = (W64# (x# `quotWord#` y#), W64# (x# `remWord#` y#))
+        | otherwise                 = divZeroError
+    toInteger (W64# x#)
+        | isTrue# (i# >=# 0#)       = smallInteger i#
+        | otherwise                 = wordToInteger x#
+        where
+        !i# = word2Int# x#
+
+instance Bits Word64 where
+    {-# INLINE shift #-}
+    {-# INLINE bit #-}
+    {-# INLINE testBit #-}
+
+    (W64# x#) .&.   (W64# y#)  = W64# (x# `and#` y#)
+    (W64# x#) .|.   (W64# y#)  = W64# (x# `or#`  y#)
+    (W64# x#) `xor` (W64# y#)  = W64# (x# `xor#` y#)
+    complement (W64# x#)       = W64# (x# `xor#` mb#)
+        where !(W64# mb#) = maxBound
+    (W64# x#) `shift` (I# i#)
+        | isTrue# (i# >=# 0#)  = W64# (x# `shiftL#` i#)
+        | otherwise            = W64# (x# `shiftRL#` negateInt# i#)
+    (W64# x#) `shiftL`       (I# i#) = W64# (x# `shiftL#` i#)
+    (W64# x#) `unsafeShiftL` (I# i#) = W64# (x# `uncheckedShiftL#` i#)
+    (W64# x#) `shiftR`       (I# i#) = W64# (x# `shiftRL#` i#)
+    (W64# x#) `unsafeShiftR` (I# i#) = W64# (x# `uncheckedShiftRL#` i#)
+    (W64# x#) `rotate` (I# i#)
+        | isTrue# (i'# ==# 0#) = W64# x#
+        | otherwise            = W64# ((x# `uncheckedShiftL#` i'#) `or#`
+                                       (x# `uncheckedShiftRL#` (64# -# i'#)))
+        where
+        !i'# = word2Int# (int2Word# i# `and#` 63##)
+    bitSizeMaybe i            = Just (finiteBitSize i)
+    bitSize i                 = finiteBitSize i
+    isSigned _                = False
+    popCount (W64# x#)        = I# (word2Int# (popCnt64# x#))
+    bit                       = bitDefault
+    testBit                   = testBitDefault
+
+{-# RULES
+"fromIntegral/a->Word64" fromIntegral = \x -> case fromIntegral x of W# x# -> W64# x#
+"fromIntegral/Word64->a" fromIntegral = \(W64# x#) -> fromIntegral (W# x#)
+  #-}
+
+uncheckedShiftL64# :: Word# -> Int# -> Word#
+uncheckedShiftL64#  = uncheckedShiftL#
+
+uncheckedShiftRL64# :: Word# -> Int# -> Word#
+uncheckedShiftRL64# = uncheckedShiftRL#
+
+#endif
+
+instance FiniteBits Word64 where
+    finiteBitSize _ = 64
+
+instance Show Word64 where
+    showsPrec p x = showsPrec p (toInteger x)
+
+instance Real Word64 where
+    toRational x = toInteger x % 1
+
+instance Bounded Word64 where
+    minBound = 0
+    maxBound = 0xFFFFFFFFFFFFFFFF
+
+instance Ix Word64 where
+    range (m,n)         = [m..n]
+    unsafeIndex (m,_) i = fromIntegral (i - m)
+    inRange (m,n) i     = m <= i && i <= n
+
+instance Read Word64 where
+    readsPrec p s = [(fromInteger x, r) | (x, r) <- readsPrec p s]
+
+-- | Reverse order of bytes in 'Word64'.
+--
+-- /Since: 4.7.0.0/
+#if WORD_SIZE_IN_BITS < 64
+byteSwap64 :: Word64 -> Word64
+byteSwap64 (W64# w#) = W64# (byteSwap64# w#)
+#else
+byteSwap64 :: Word64 -> Word64
+byteSwap64 (W64# w#) = W64# (byteSwap# w#)
+#endif
diff --git a/libraries/base/LICENSE b/libraries/base/LICENSE
new file mode 100644
index 000000000000..e25dd46a3413
--- /dev/null
+++ b/libraries/base/LICENSE
@@ -0,0 +1,83 @@
+This library (libraries/base) is derived from code from several
+sources: 
+
+  * Code from the GHC project which is largely (c) The University of
+    Glasgow, and distributable under a BSD-style license (see below),
+
+  * Code from the Haskell 98 Report which is (c) Simon Peyton Jones
+    and freely redistributable (but see the full license for
+    restrictions).
+
+  * Code from the Haskell Foreign Function Interface specification,
+    which is (c) Manuel M. T. Chakravarty and freely redistributable
+    (but see the full license for restrictions).
+
+The full text of these licenses is reproduced below.  All of the
+licenses are BSD-style or compatible.
+
+-----------------------------------------------------------------------------
+
+The Glasgow Haskell Compiler License
+
+Copyright 2004, The University Court of the University of Glasgow. 
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+- Redistributions of source code must retain the above copyright notice,
+this list of conditions and the following disclaimer.
+ 
+- Redistributions in binary form must reproduce the above copyright notice,
+this list of conditions and the following disclaimer in the documentation
+and/or other materials provided with the distribution.
+ 
+- Neither name of the University nor the names of its contributors may be
+used to endorse or promote products derived from this software without
+specific prior written permission. 
+
+THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
+GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
+DAMAGE.
+
+-----------------------------------------------------------------------------
+
+Code derived from the document "Report on the Programming Language
+Haskell 98", is distributed under the following license:
+
+  Copyright (c) 2002 Simon Peyton Jones
+
+  The authors intend this Report to belong to the entire Haskell
+  community, and so we grant permission to copy and distribute it for
+  any purpose, provided that it is reproduced in its entirety,
+  including this Notice.  Modified versions of this Report may also be
+  copied and distributed for any purpose, provided that the modified
+  version is clearly presented as such, and that it does not claim to
+  be a definition of the Haskell 98 Language.
+
+-----------------------------------------------------------------------------
+
+Code derived from the document "The Haskell 98 Foreign Function
+Interface, An Addendum to the Haskell 98 Report" is distributed under
+the following license:
+
+  Copyright (c) 2002 Manuel M. T. Chakravarty
+
+  The authors intend this Report to belong to the entire Haskell
+  community, and so we grant permission to copy and distribute it for
+  any purpose, provided that it is reproduced in its entirety,
+  including this Notice.  Modified versions of this Report may also be
+  copied and distributed for any purpose, provided that the modified
+  version is clearly presented as such, and that it does not claim to
+  be a definition of the Haskell 98 Foreign Function Interface.
+
+-----------------------------------------------------------------------------
diff --git a/libraries/base/Numeric.hs b/libraries/base/Numeric.hs
new file mode 100644
index 000000000000..4a1a5b121a75
--- /dev/null
+++ b/libraries/base/Numeric.hs
@@ -0,0 +1,232 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE NoImplicitPrelude, MagicHash #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Numeric
+-- Copyright   :  (c) The University of Glasgow 2002
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+--
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  provisional
+-- Portability :  portable
+--
+-- Odds and ends, mostly functions for reading and showing
+-- 'RealFloat'-like kind of values.
+--
+-----------------------------------------------------------------------------
+
+module Numeric (
+
+        -- * Showing
+
+        showSigned,
+
+        showIntAtBase,
+        showInt,
+        showHex,
+        showOct,
+
+        showEFloat,
+        showFFloat,
+        showGFloat,
+        showFFloatAlt,
+        showGFloatAlt,
+        showFloat,
+
+        floatToDigits,
+
+        -- * Reading
+
+        -- | /NB:/ 'readInt' is the \'dual\' of 'showIntAtBase',
+        -- and 'readDec' is the \`dual\' of 'showInt'.
+        -- The inconsistent naming is a historical accident.
+
+        readSigned,
+
+        readInt,
+        readDec,
+        readOct,
+        readHex,
+
+        readFloat,
+
+        lexDigits,
+
+        -- * Miscellaneous
+
+        fromRat,
+
+        ) where
+
+import GHC.Base
+import GHC.Read
+import GHC.Real
+import GHC.Float
+import GHC.Num
+import GHC.Show
+import Data.Maybe
+import Text.ParserCombinators.ReadP( ReadP, readP_to_S, pfail )
+import qualified Text.Read.Lex as L
+
+-- -----------------------------------------------------------------------------
+-- Reading
+
+-- | Reads an /unsigned/ 'Integral' value in an arbitrary base.
+readInt :: Num a
+  => a                  -- ^ the base
+  -> (Char -> Bool)     -- ^ a predicate distinguishing valid digits in this base
+  -> (Char -> Int)      -- ^ a function converting a valid digit character to an 'Int'
+  -> ReadS a
+readInt base isDigit valDigit = readP_to_S (L.readIntP base isDigit valDigit)
+
+-- | Read an unsigned number in octal notation.
+readOct :: (Eq a, Num a) => ReadS a
+readOct = readP_to_S L.readOctP
+
+-- | Read an unsigned number in decimal notation.
+readDec :: (Eq a, Num a) => ReadS a
+readDec = readP_to_S L.readDecP
+
+-- | Read an unsigned number in hexadecimal notation.
+-- Both upper or lower case letters are allowed.
+readHex :: (Eq a, Num a) => ReadS a
+readHex = readP_to_S L.readHexP
+
+-- | Reads an /unsigned/ 'RealFrac' value,
+-- expressed in decimal scientific notation.
+readFloat :: RealFrac a => ReadS a
+readFloat = readP_to_S readFloatP
+
+readFloatP :: RealFrac a => ReadP a
+readFloatP =
+  do tok <- L.lex
+     case tok of
+       L.Number n -> return $ fromRational $ L.numberToRational n
+       _          -> pfail
+
+-- It's turgid to have readSigned work using list comprehensions,
+-- but it's specified as a ReadS to ReadS transformer
+-- With a bit of luck no one will use it.
+
+-- | Reads a /signed/ 'Real' value, given a reader for an unsigned value.
+readSigned :: (Real a) => ReadS a -> ReadS a
+readSigned readPos = readParen False read'
+                     where read' r  = read'' r ++
+                                      (do
+                                        ("-",s) <- lex r
+                                        (x,t)   <- read'' s
+                                        return (-x,t))
+                           read'' r = do
+                               (str,s) <- lex r
+                               (n,"")  <- readPos str
+                               return (n,s)
+
+-- -----------------------------------------------------------------------------
+-- Showing
+
+-- | Show /non-negative/ 'Integral' numbers in base 10.
+showInt :: Integral a => a -> ShowS
+showInt n0 cs0
+    | n0 < 0    = error "Numeric.showInt: can't show negative numbers"
+    | otherwise = go n0 cs0
+    where
+    go n cs
+        | n < 10    = case unsafeChr (ord '0' + fromIntegral n) of
+            c@(C# _) -> c:cs
+        | otherwise = case unsafeChr (ord '0' + fromIntegral r) of
+            c@(C# _) -> go q (c:cs)
+        where
+        (q,r) = n `quotRem` 10
+
+-- Controlling the format and precision of floats. The code that
+-- implements the formatting itself is in @PrelNum@ to avoid
+-- mutual module deps.
+
+{-# SPECIALIZE showEFloat ::
+        Maybe Int -> Float  -> ShowS,
+        Maybe Int -> Double -> ShowS #-}
+{-# SPECIALIZE showFFloat ::
+        Maybe Int -> Float  -> ShowS,
+        Maybe Int -> Double -> ShowS #-}
+{-# SPECIALIZE showGFloat ::
+        Maybe Int -> Float  -> ShowS,
+        Maybe Int -> Double -> ShowS #-}
+
+-- | Show a signed 'RealFloat' value
+-- using scientific (exponential) notation (e.g. @2.45e2@, @1.5e-3@).
+--
+-- In the call @'showEFloat' digs val@, if @digs@ is 'Nothing',
+-- the value is shown to full precision; if @digs@ is @'Just' d@,
+-- then at most @d@ digits after the decimal point are shown.
+showEFloat    :: (RealFloat a) => Maybe Int -> a -> ShowS
+
+-- | Show a signed 'RealFloat' value
+-- using standard decimal notation (e.g. @245000@, @0.0015@).
+--
+-- In the call @'showFFloat' digs val@, if @digs@ is 'Nothing',
+-- the value is shown to full precision; if @digs@ is @'Just' d@,
+-- then at most @d@ digits after the decimal point are shown.
+showFFloat    :: (RealFloat a) => Maybe Int -> a -> ShowS
+
+-- | Show a signed 'RealFloat' value
+-- using standard decimal notation for arguments whose absolute value lies
+-- between @0.1@ and @9,999,999@, and scientific notation otherwise.
+--
+-- In the call @'showGFloat' digs val@, if @digs@ is 'Nothing',
+-- the value is shown to full precision; if @digs@ is @'Just' d@,
+-- then at most @d@ digits after the decimal point are shown.
+showGFloat    :: (RealFloat a) => Maybe Int -> a -> ShowS
+
+showEFloat d x =  showString (formatRealFloat FFExponent d x)
+showFFloat d x =  showString (formatRealFloat FFFixed d x)
+showGFloat d x =  showString (formatRealFloat FFGeneric d x)
+
+-- | Show a signed 'RealFloat' value
+-- using standard decimal notation (e.g. @245000@, @0.0015@).
+--
+-- This behaves as 'showFFloat', except that a decimal point
+-- is always guaranteed, even if not needed.
+--
+-- /Since: 4.7.0.0/
+showFFloatAlt    :: (RealFloat a) => Maybe Int -> a -> ShowS
+
+-- | Show a signed 'RealFloat' value
+-- using standard decimal notation for arguments whose absolute value lies
+-- between @0.1@ and @9,999,999@, and scientific notation otherwise.
+--
+-- This behaves as 'showFFloat', except that a decimal point
+-- is always guaranteed, even if not needed.
+--
+-- /Since: 4.7.0.0/
+showGFloatAlt    :: (RealFloat a) => Maybe Int -> a -> ShowS
+
+showFFloatAlt d x =  showString (formatRealFloatAlt FFFixed d True x)
+showGFloatAlt d x =  showString (formatRealFloatAlt FFGeneric d True x)
+
+-- ---------------------------------------------------------------------------
+-- Integer printing functions
+
+-- | Shows a /non-negative/ 'Integral' number using the base specified by the
+-- first argument, and the character representation specified by the second.
+showIntAtBase :: (Integral a, Show a) => a -> (Int -> Char) -> a -> ShowS
+showIntAtBase base toChr n0 r0
+  | base <= 1 = error ("Numeric.showIntAtBase: applied to unsupported base " ++ show base)
+  | n0 <  0   = error ("Numeric.showIntAtBase: applied to negative number " ++ show n0)
+  | otherwise = showIt (quotRem n0 base) r0
+   where
+    showIt (n,d) r = seq c $ -- stricter than necessary
+      case n of
+        0 -> r'
+        _ -> showIt (quotRem n base) r'
+     where
+      c  = toChr (fromIntegral d)
+      r' = c : r
+
+-- | Show /non-negative/ 'Integral' numbers in base 16.
+showHex :: (Integral a,Show a) => a -> ShowS
+showHex = showIntAtBase 16 intToDigit
+
+-- | Show /non-negative/ 'Integral' numbers in base 8.
+showOct :: (Integral a, Show a) => a -> ShowS
+showOct = showIntAtBase 8  intToDigit
diff --git a/libraries/base/Prelude.hs b/libraries/base/Prelude.hs
new file mode 100644
index 000000000000..9b1119e15596
--- /dev/null
+++ b/libraries/base/Prelude.hs
@@ -0,0 +1,175 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE CPP, NoImplicitPrelude, BangPatterns #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Prelude
+-- Copyright   :  (c) The University of Glasgow 2001
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+-- 
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  stable
+-- Portability :  portable
+--
+-- The Prelude: a standard module. The Prelude is imported by default
+-- into all Haskell modules unless either there is an explicit import
+-- statement for it, or the NoImplicitPrelude extension is enabled.
+--
+-----------------------------------------------------------------------------
+
+module Prelude (
+
+    -- * Standard types, classes and related functions
+
+    -- ** Basic data types
+    Bool(False, True),
+    (&&), (||), not, otherwise,
+
+    Maybe(Nothing, Just),
+    maybe,
+
+    Either(Left, Right),
+    either,
+
+    Ordering(LT, EQ, GT),
+    Char, String,
+
+    -- *** Tuples
+    fst, snd, curry, uncurry,
+
+    -- ** Basic type classes
+    Eq((==), (/=)),
+    Ord(compare, (<), (<=), (>=), (>), max, min),
+    Enum(succ, pred, toEnum, fromEnum, enumFrom, enumFromThen,
+         enumFromTo, enumFromThenTo),
+    Bounded(minBound, maxBound),
+
+    -- ** Numbers
+
+    -- *** Numeric types
+    Int, Integer, Float, Double,
+    Rational,
+
+    -- *** Numeric type classes
+    Num((+), (-), (*), negate, abs, signum, fromInteger),
+    Real(toRational),
+    Integral(quot, rem, div, mod, quotRem, divMod, toInteger),
+    Fractional((/), recip, fromRational),
+    Floating(pi, exp, log, sqrt, (**), logBase, sin, cos, tan,
+             asin, acos, atan, sinh, cosh, tanh, asinh, acosh, atanh),
+    RealFrac(properFraction, truncate, round, ceiling, floor),
+    RealFloat(floatRadix, floatDigits, floatRange, decodeFloat,
+              encodeFloat, exponent, significand, scaleFloat, isNaN,
+              isInfinite, isDenormalized, isIEEE, isNegativeZero, atan2),
+
+    -- *** Numeric functions
+    subtract, even, odd, gcd, lcm, (^), (^^),
+    fromIntegral, realToFrac,
+
+    -- ** Monads and functors
+    Monad((>>=), (>>), return, fail),
+    Functor(fmap),
+    mapM, mapM_, sequence, sequence_, (=<<),
+
+    -- ** Miscellaneous functions
+    id, const, (.), flip, ($), until,
+    asTypeOf, error, undefined,
+    seq, ($!),
+
+    -- * List operations
+    map, (++), filter,
+    head, last, tail, init, null, length, (!!),
+    reverse,
+    -- ** Reducing lists (folds)
+    foldl, foldl1, foldr, foldr1,
+    -- *** Special folds
+    and, or, any, all,
+    sum, product,
+    concat, concatMap,
+    maximum, minimum,
+    -- ** Building lists
+    -- *** Scans
+    scanl, scanl1, scanr, scanr1,
+    -- *** Infinite lists
+    iterate, repeat, replicate, cycle,
+    -- ** Sublists
+    take, drop, splitAt, takeWhile, dropWhile, span, break,
+    -- ** Searching lists
+    elem, notElem, lookup,
+    -- ** Zipping and unzipping lists
+    zip, zip3, zipWith, zipWith3, unzip, unzip3,
+    -- ** Functions on strings
+    lines, words, unlines, unwords,
+
+    -- * Converting to and from @String@
+    -- ** Converting to @String@
+    ShowS,
+    Show(showsPrec, showList, show),
+    shows,
+    showChar, showString, showParen,
+    -- ** Converting from @String@
+    ReadS,
+    Read(readsPrec, readList),
+    reads, readParen, read, lex,
+
+    -- * Basic Input and output
+    IO,
+    -- ** Simple I\/O operations
+    -- All I/O functions defined here are character oriented.  The
+    -- treatment of the newline character will vary on different systems.
+    -- For example, two characters of input, return and linefeed, may
+    -- read as a single newline character.  These functions cannot be
+    -- used portably for binary I/O.
+    -- *** Output functions
+    putChar,
+    putStr, putStrLn, print,
+    -- *** Input functions
+    getChar,
+    getLine, getContents, interact,
+    -- *** Files
+    FilePath,
+    readFile, writeFile, appendFile, readIO, readLn,
+    -- ** Exception handling in the I\/O monad
+    IOError, ioError, userError,
+
+  ) where
+
+import Control.Monad
+import System.IO
+import System.IO.Error
+import Data.List
+import Data.Either
+import Data.Maybe
+import Data.Tuple
+
+import GHC.Base
+import Text.Read
+import GHC.Enum
+import GHC.Num
+import GHC.Real
+import GHC.Float
+import GHC.Show
+
+infixr 0 $!
+
+-- -----------------------------------------------------------------------------
+-- Miscellaneous functions
+
+-- | Strict (call-by-value) application, defined in terms of 'seq'.
+($!)    :: (a -> b) -> a -> b
+f $! x  = let !vx = x in f vx  -- see #2273
+
+#ifdef __HADDOCK__
+-- | The value of @'seq' a b@ is bottom if @a@ is bottom, and otherwise
+-- equal to @b@.  'seq' is usually introduced to improve performance by
+-- avoiding unneeded laziness.
+--
+-- A note on evaluation order: the expression @seq a b@ does /not/ guarantee
+-- that @a@ will be evaluated before @b@. The only guarantee given by @seq@ is
+-- that the both @a@ and @b@ will be evaluated before @seq@ returns a value. In
+-- particular, this means that @b@ may be evaluated before @a@. If you need to
+-- guarantee a specific order of evaluation, you must use the function @pseq@
+-- from the parallel package.
+seq :: a -> b -> b
+seq _ y = y
+#endif
diff --git a/libraries/base/Setup.hs b/libraries/base/Setup.hs
new file mode 100644
index 000000000000..7cf9bfd7caf9
--- /dev/null
+++ b/libraries/base/Setup.hs
@@ -0,0 +1,6 @@
+module Main (main) where
+
+import Distribution.Simple
+
+main :: IO ()
+main = defaultMainWithHooks defaultUserHooks
diff --git a/libraries/base/System/CPUTime.hsc b/libraries/base/System/CPUTime.hsc
new file mode 100644
index 000000000000..85634b747338
--- /dev/null
+++ b/libraries/base/System/CPUTime.hsc
@@ -0,0 +1,163 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE CPP, NondecreasingIndentation, CApiFFI #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  System.CPUTime
+-- Copyright   :  (c) The University of Glasgow 2001
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+-- 
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  provisional
+-- Portability :  portable
+--
+-- The standard CPUTime library.
+--
+-----------------------------------------------------------------------------
+
+#include "HsFFI.h"
+#include "HsBaseConfig.h"
+
+module System.CPUTime 
+        (
+         getCPUTime,       -- :: IO Integer
+         cpuTimePrecision  -- :: Integer
+        ) where
+
+import Prelude
+
+import Data.Ratio
+
+import Foreign.Safe
+import Foreign.C
+
+-- For struct rusage
+#if !defined(mingw32_HOST_OS) && !defined(irix_HOST_OS)
+# if HAVE_SYS_RESOURCE_H
+#  include <sys/resource.h>
+# endif
+#endif
+
+-- For FILETIME etc. on Windows
+#if HAVE_WINDOWS_H
+#include <windows.h>
+#endif
+
+-- for struct tms
+#if HAVE_SYS_TIMES_H
+#include <sys/times.h>
+#endif
+
+##ifdef mingw32_HOST_OS
+## if defined(i386_HOST_ARCH)
+##  define WINDOWS_CCONV stdcall
+## elif defined(x86_64_HOST_ARCH)
+##  define WINDOWS_CCONV ccall
+## else
+##  error Unknown mingw32 arch
+## endif
+##else
+##endif
+
+#if !defined(mingw32_HOST_OS) && !defined(cygwin32_HOST_OS)
+realToInteger :: Real a => a -> Integer
+realToInteger ct = round (realToFrac ct :: Double)
+  -- CTime, CClock, CUShort etc are in Real but not Fractional, 
+  -- so we must convert to Double before we can round it
+#endif
+
+-- -----------------------------------------------------------------------------
+-- |Computation 'getCPUTime' returns the number of picoseconds CPU time
+-- used by the current program.  The precision of this result is
+-- implementation-dependent.
+
+getCPUTime :: IO Integer
+getCPUTime = do
+
+#if !defined(mingw32_HOST_OS) && !defined(cygwin32_HOST_OS)
+-- getrusage() is right royal pain to deal with when targetting multiple
+-- versions of Solaris, since some versions supply it in libc (2.3 and 2.5),
+-- while 2.4 has got it in libucb (I wouldn't be too surprised if it was back
+-- again in libucb in 2.6..)
+--
+-- Avoid the problem by resorting to times() instead.
+--
+#if defined(HAVE_GETRUSAGE) && ! irix_HOST_OS && ! solaris2_HOST_OS
+    allocaBytes (#const sizeof(struct rusage)) $ \ p_rusage -> do
+    throwErrnoIfMinus1_ "getrusage" $ getrusage (#const RUSAGE_SELF) p_rusage
+
+    let ru_utime = (#ptr struct rusage, ru_utime) p_rusage
+    let ru_stime = (#ptr struct rusage, ru_stime) p_rusage
+    u_sec  <- (#peek struct timeval,tv_sec)  ru_utime :: IO CTime
+    u_usec <- (#peek struct timeval,tv_usec) ru_utime :: IO CSUSeconds
+    s_sec  <- (#peek struct timeval,tv_sec)  ru_stime :: IO CTime
+    s_usec <- (#peek struct timeval,tv_usec) ru_stime :: IO CSUSeconds
+    return ((realToInteger u_sec * 1000000 + realToInteger u_usec + 
+             realToInteger s_sec * 1000000 + realToInteger s_usec) 
+                * 1000000)
+
+type CRUsage = ()
+foreign import capi unsafe "HsBase.h getrusage" getrusage :: CInt -> Ptr CRUsage -> IO CInt
+#elif defined(HAVE_TIMES)
+    allocaBytes (#const sizeof(struct tms)) $ \ p_tms -> do
+    _ <- times p_tms
+    u_ticks  <- (#peek struct tms,tms_utime) p_tms :: IO CClock
+    s_ticks  <- (#peek struct tms,tms_stime) p_tms :: IO CClock
+    return (( (realToInteger u_ticks + realToInteger s_ticks) * 1000000000000) 
+                        `div` fromIntegral clockTicks)
+
+type CTms = ()
+foreign import ccall unsafe times :: Ptr CTms -> IO CClock
+#else
+    ioException (IOError Nothing UnsupportedOperation 
+                         "getCPUTime"
+                         "can't get CPU time"
+                         Nothing)
+#endif
+
+#else /* win32 */
+     -- NOTE: GetProcessTimes() is only supported on NT-based OSes.
+     -- The counts reported by GetProcessTimes() are in 100-ns (10^-7) units.
+    allocaBytes (#const sizeof(FILETIME)) $ \ p_creationTime -> do
+    allocaBytes (#const sizeof(FILETIME)) $ \ p_exitTime -> do
+    allocaBytes (#const sizeof(FILETIME)) $ \ p_kernelTime -> do
+    allocaBytes (#const sizeof(FILETIME)) $ \ p_userTime -> do
+    pid <- getCurrentProcess
+    ok <- getProcessTimes pid p_creationTime p_exitTime p_kernelTime p_userTime
+    if toBool ok then do
+      ut <- ft2psecs p_userTime
+      kt <- ft2psecs p_kernelTime
+      return (ut + kt)
+     else return 0
+  where 
+        ft2psecs :: Ptr FILETIME -> IO Integer
+        ft2psecs ft = do
+          high <- (#peek FILETIME,dwHighDateTime) ft :: IO Word32
+          low  <- (#peek FILETIME,dwLowDateTime)  ft :: IO Word32
+            -- Convert 100-ns units to picosecs (10^-12) 
+            -- => multiply by 10^5.
+          return (((fromIntegral high) * (2^(32::Int)) + (fromIntegral low)) * 100000)
+
+    -- ToDo: pin down elapsed times to just the OS thread(s) that
+    -- are evaluating/managing Haskell code.
+
+type FILETIME = ()
+type HANDLE = ()
+-- need proper Haskell names (initial lower-case character)
+foreign import WINDOWS_CCONV unsafe "GetCurrentProcess" getCurrentProcess :: IO (Ptr HANDLE)
+foreign import WINDOWS_CCONV unsafe "GetProcessTimes" getProcessTimes :: Ptr HANDLE -> Ptr FILETIME -> Ptr FILETIME -> Ptr FILETIME -> Ptr FILETIME -> IO CInt
+
+#endif /* not _WIN32 */
+
+
+-- |The 'cpuTimePrecision' constant is the smallest measurable difference
+-- in CPU time that the implementation can record, and is given as an
+-- integral number of picoseconds.
+
+cpuTimePrecision :: Integer
+cpuTimePrecision = round ((1000000000000::Integer) % fromIntegral (clockTicks))
+
+foreign import ccall unsafe clk_tck :: CLong
+
+clockTicks :: Int
+clockTicks = fromIntegral clk_tck
diff --git a/libraries/base/System/Console/GetOpt.hs b/libraries/base/System/Console/GetOpt.hs
new file mode 100644
index 000000000000..5bdb6d11d130
--- /dev/null
+++ b/libraries/base/System/Console/GetOpt.hs
@@ -0,0 +1,409 @@
+{-# LANGUAGE Safe #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  System.Console.GetOpt
+-- Copyright   :  (c) Sven Panne 2002-2005
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+-- 
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  experimental
+-- Portability :  portable
+--
+-- This library provides facilities for parsing the command-line options
+-- in a standalone program.  It is essentially a Haskell port of the GNU 
+-- @getopt@ library.
+--
+-----------------------------------------------------------------------------
+
+{-
+Sven Panne <Sven.Panne@informatik.uni-muenchen.de> Oct. 1996 (small
+changes Dec. 1997)
+
+Two rather obscure features are missing: The Bash 2.0 non-option hack
+(if you don't already know it, you probably don't want to hear about
+it...) and the recognition of long options with a single dash
+(e.g. '-help' is recognised as '--help', as long as there is no short
+option 'h').
+
+Other differences between GNU's getopt and this implementation:
+
+* To enforce a coherent description of options and arguments, there
+  are explanation fields in the option/argument descriptor.
+
+* Error messages are now more informative, but no longer POSIX
+  compliant... :-(
+
+And a final Haskell advertisement: The GNU C implementation uses well
+over 1100 lines, we need only 195 here, including a 46 line example! 
+:-)
+-}
+
+module System.Console.GetOpt (
+   -- * GetOpt
+   getOpt, getOpt',
+   usageInfo,
+   ArgOrder(..),
+   OptDescr(..),
+   ArgDescr(..),
+
+   -- * Examples
+
+   -- |To hopefully illuminate the role of the different data structures,
+   -- here are the command-line options for a (very simple) compiler,
+   -- done in two different ways.
+   -- The difference arises because the type of 'getOpt' is
+   -- parameterized by the type of values derived from flags.
+
+   -- ** Interpreting flags as concrete values
+   -- $example1
+
+   -- ** Interpreting flags as transformations of an options record
+   -- $example2
+) where
+
+import Prelude -- necessary to get dependencies right
+
+import Data.List ( isPrefixOf, find )
+
+-- |What to do with options following non-options
+data ArgOrder a
+  = RequireOrder                -- ^ no option processing after first non-option
+  | Permute                     -- ^ freely intersperse options and non-options
+  | ReturnInOrder (String -> a) -- ^ wrap non-options into options
+
+{-|
+Each 'OptDescr' describes a single option.
+
+The arguments to 'Option' are:
+
+* list of short option characters
+
+* list of long option strings (without \"--\")
+
+* argument descriptor
+
+* explanation of option for user
+-}
+data OptDescr a =              -- description of a single options:
+   Option [Char]                --    list of short option characters
+          [String]              --    list of long option strings (without "--")
+          (ArgDescr a)          --    argument descriptor
+          String                --    explanation of option for user
+
+-- |Describes whether an option takes an argument or not, and if so
+-- how the argument is injected into a value of type @a@.
+data ArgDescr a
+   = NoArg                   a         -- ^   no argument expected
+   | ReqArg (String       -> a) String -- ^   option requires argument
+   | OptArg (Maybe String -> a) String -- ^   optional argument
+
+instance Functor ArgOrder where
+    fmap _ RequireOrder      = RequireOrder
+    fmap _ Permute           = Permute
+    fmap f (ReturnInOrder g) = ReturnInOrder (f . g)
+
+instance Functor OptDescr where
+    fmap f (Option a b argDescr c) = Option a b (fmap f argDescr) c
+
+instance Functor ArgDescr where
+    fmap f (NoArg a)    = NoArg (f a)
+    fmap f (ReqArg g s) = ReqArg (f . g) s
+    fmap f (OptArg g s) = OptArg (f . g) s
+
+data OptKind a                -- kind of cmd line arg (internal use only):
+   = Opt       a                --    an option
+   | UnreqOpt  String           --    an un-recognized option
+   | NonOpt    String           --    a non-option
+   | EndOfOpts                  --    end-of-options marker (i.e. "--")
+   | OptErr    String           --    something went wrong...
+
+-- | Return a string describing the usage of a command, derived from
+-- the header (first argument) and the options described by the 
+-- second argument.
+usageInfo :: String                    -- header
+          -> [OptDescr a]              -- option descriptors
+          -> String                    -- nicely formatted decription of options
+usageInfo header optDescr = unlines (header:table)
+   where (ss,ls,ds)     = (unzip3 . concatMap fmtOpt) optDescr
+         table          = zipWith3 paste (sameLen ss) (sameLen ls) ds
+         paste x y z    = "  " ++ x ++ "  " ++ y ++ "  " ++ z
+         sameLen xs     = flushLeft ((maximum . map length) xs) xs
+         flushLeft n xs = [ take n (x ++ repeat ' ') | x <- xs ]
+
+fmtOpt :: OptDescr a -> [(String,String,String)]
+fmtOpt (Option sos los ad descr) =
+   case lines descr of
+     []     -> [(sosFmt,losFmt,"")]
+     (d:ds) ->  (sosFmt,losFmt,d) : [ ("","",d') | d' <- ds ]
+   where sepBy _  []     = ""
+         sepBy _  [x]    = x
+         sepBy ch (x:xs) = x ++ ch:' ':sepBy ch xs
+         sosFmt = sepBy ',' (map (fmtShort ad) sos)
+         losFmt = sepBy ',' (map (fmtLong  ad) los)
+
+fmtShort :: ArgDescr a -> Char -> String
+fmtShort (NoArg  _   ) so = "-" ++ [so]
+fmtShort (ReqArg _ ad) so = "-" ++ [so] ++ " " ++ ad
+fmtShort (OptArg _ ad) so = "-" ++ [so] ++ "[" ++ ad ++ "]"
+
+fmtLong :: ArgDescr a -> String -> String
+fmtLong (NoArg  _   ) lo = "--" ++ lo
+fmtLong (ReqArg _ ad) lo = "--" ++ lo ++ "=" ++ ad
+fmtLong (OptArg _ ad) lo = "--" ++ lo ++ "[=" ++ ad ++ "]"
+
+{-|
+Process the command-line, and return the list of values that matched
+(and those that didn\'t). The arguments are:
+
+* The order requirements (see 'ArgOrder')
+
+* The option descriptions (see 'OptDescr')
+
+* The actual command line arguments (presumably got from 
+  'System.Environment.getArgs').
+
+'getOpt' returns a triple consisting of the option arguments, a list
+of non-options, and a list of error messages.
+-}
+getOpt :: ArgOrder a                   -- non-option handling
+       -> [OptDescr a]                 -- option descriptors
+       -> [String]                     -- the command-line arguments
+       -> ([a],[String],[String])      -- (options,non-options,error messages)
+getOpt ordering optDescr args = (os,xs,es ++ map errUnrec us)
+   where (os,xs,us,es) = getOpt' ordering optDescr args
+
+{-|
+This is almost the same as 'getOpt', but returns a quadruple
+consisting of the option arguments, a list of non-options, a list of
+unrecognized options, and a list of error messages.
+-}
+getOpt' :: ArgOrder a                         -- non-option handling
+        -> [OptDescr a]                       -- option descriptors
+        -> [String]                           -- the command-line arguments
+        -> ([a],[String], [String] ,[String]) -- (options,non-options,unrecognized,error messages)
+getOpt' _        _        []         =  ([],[],[],[])
+getOpt' ordering optDescr (arg:args) = procNextOpt opt ordering
+   where procNextOpt (Opt o)      _                 = (o:os,xs,us,es)
+         procNextOpt (UnreqOpt u) _                 = (os,xs,u:us,es)
+         procNextOpt (NonOpt x)   RequireOrder      = ([],x:rest,[],[])
+         procNextOpt (NonOpt x)   Permute           = (os,x:xs,us,es)
+         procNextOpt (NonOpt x)   (ReturnInOrder f) = (f x :os, xs,us,es)
+         procNextOpt EndOfOpts    RequireOrder      = ([],rest,[],[])
+         procNextOpt EndOfOpts    Permute           = ([],rest,[],[])
+         procNextOpt EndOfOpts    (ReturnInOrder f) = (map f rest,[],[],[])
+         procNextOpt (OptErr e)   _                 = (os,xs,us,e:es)
+
+         (opt,rest) = getNext arg args optDescr
+         (os,xs,us,es) = getOpt' ordering optDescr rest
+
+-- take a look at the next cmd line arg and decide what to do with it
+getNext :: String -> [String] -> [OptDescr a] -> (OptKind a,[String])
+getNext ('-':'-':[]) rest _        = (EndOfOpts,rest)
+getNext ('-':'-':xs) rest optDescr = longOpt xs rest optDescr
+getNext ('-': x :xs) rest optDescr = shortOpt x xs rest optDescr
+getNext a            rest _        = (NonOpt a,rest)
+
+-- handle long option
+longOpt :: String -> [String] -> [OptDescr a] -> (OptKind a,[String])
+longOpt ls rs optDescr = long ads arg rs
+   where (opt,arg) = break (=='=') ls
+         getWith p = [ o | o@(Option _ xs _ _) <- optDescr
+                         , find (p opt) xs /= Nothing ]
+         exact     = getWith (==)
+         options   = if null exact then getWith isPrefixOf else exact
+         ads       = [ ad | Option _ _ ad _ <- options ]
+         optStr    = ("--"++opt)
+
+         long (_:_:_)      _        rest     = (errAmbig options optStr,rest)
+         long [NoArg  a  ] []       rest     = (Opt a,rest)
+         long [NoArg  _  ] ('=':_)  rest     = (errNoArg optStr,rest)
+         long [ReqArg _ d] []       []       = (errReq d optStr,[])
+         long [ReqArg f _] []       (r:rest) = (Opt (f r),rest)
+         long [ReqArg f _] ('=':xs) rest     = (Opt (f xs),rest)
+         long [OptArg f _] []       rest     = (Opt (f Nothing),rest)
+         long [OptArg f _] ('=':xs) rest     = (Opt (f (Just xs)),rest)
+         long _            _        rest     = (UnreqOpt ("--"++ls),rest)
+
+-- handle short option
+shortOpt :: Char -> String -> [String] -> [OptDescr a] -> (OptKind a,[String])
+shortOpt y ys rs optDescr = short ads ys rs
+  where options = [ o  | o@(Option ss _ _ _) <- optDescr, s <- ss, y == s ]
+        ads     = [ ad | Option _ _ ad _ <- options ]
+        optStr  = '-':[y]
+
+        short (_:_:_)        _  rest     = (errAmbig options optStr,rest)
+        short (NoArg  a  :_) [] rest     = (Opt a,rest)
+        short (NoArg  a  :_) xs rest     = (Opt a,('-':xs):rest)
+        short (ReqArg _ d:_) [] []       = (errReq d optStr,[])
+        short (ReqArg f _:_) [] (r:rest) = (Opt (f r),rest)
+        short (ReqArg f _:_) xs rest     = (Opt (f xs),rest)
+        short (OptArg f _:_) [] rest     = (Opt (f Nothing),rest)
+        short (OptArg f _:_) xs rest     = (Opt (f (Just xs)),rest)
+        short []             [] rest     = (UnreqOpt optStr,rest)
+        short []             xs rest     = (UnreqOpt optStr,('-':xs):rest)
+
+-- miscellaneous error formatting
+
+errAmbig :: [OptDescr a] -> String -> OptKind a
+errAmbig ods optStr = OptErr (usageInfo header ods)
+   where header = "option `" ++ optStr ++ "' is ambiguous; could be one of:"
+
+errReq :: String -> String -> OptKind a
+errReq d optStr = OptErr ("option `" ++ optStr ++ "' requires an argument " ++ d ++ "\n")
+
+errUnrec :: String -> String
+errUnrec optStr = "unrecognized option `" ++ optStr ++ "'\n"
+
+errNoArg :: String -> OptKind a
+errNoArg optStr = OptErr ("option `" ++ optStr ++ "' doesn't allow an argument\n")
+
+{-
+-----------------------------------------------------------------------------------------
+-- and here a small and hopefully enlightening example:
+
+data Flag = Verbose | Version | Name String | Output String | Arg String   deriving Show
+
+options :: [OptDescr Flag]
+options =
+   [Option ['v']     ["verbose"]           (NoArg Verbose)      "verbosely list files",
+    Option ['V','?'] ["version","release"] (NoArg Version)      "show version info",
+    Option ['o']     ["output"]            (OptArg out "FILE")  "use FILE for dump",
+    Option ['n']     ["name"]              (ReqArg Name "USER") "only dump USER's files"]
+
+out :: Maybe String -> Flag
+out Nothing  = Output "stdout"
+out (Just o) = Output o
+
+test :: ArgOrder Flag -> [String] -> String
+test order cmdline = case getOpt order options cmdline of
+                        (o,n,[]  ) -> "options=" ++ show o ++ "  args=" ++ show n ++ "\n"
+                        (_,_,errs) -> concat errs ++ usageInfo header options
+   where header = "Usage: foobar [OPTION...] files..."
+
+-- example runs:
+-- putStr (test RequireOrder ["foo","-v"])
+--    ==> options=[]  args=["foo", "-v"]
+-- putStr (test Permute ["foo","-v"])
+--    ==> options=[Verbose]  args=["foo"]
+-- putStr (test (ReturnInOrder Arg) ["foo","-v"])
+--    ==> options=[Arg "foo", Verbose]  args=[]
+-- putStr (test Permute ["foo","--","-v"])
+--    ==> options=[]  args=["foo", "-v"]
+-- putStr (test Permute ["-?o","--name","bar","--na=baz"])
+--    ==> options=[Version, Output "stdout", Name "bar", Name "baz"]  args=[]
+-- putStr (test Permute ["--ver","foo"])
+--    ==> option `--ver' is ambiguous; could be one of:
+--          -v      --verbose             verbosely list files
+--          -V, -?  --version, --release  show version info   
+--        Usage: foobar [OPTION...] files...
+--          -v        --verbose             verbosely list files  
+--          -V, -?    --version, --release  show version info     
+--          -o[FILE]  --output[=FILE]       use FILE for dump     
+--          -n USER   --name=USER           only dump USER's files
+-----------------------------------------------------------------------------------------
+-}
+
+{- $example1
+
+A simple choice for the type associated with flags is to define a type
+@Flag@ as an algebraic type representing the possible flags and their
+arguments:
+
+>    module Opts1 where
+>    
+>    import System.Console.GetOpt
+>    import Data.Maybe ( fromMaybe )
+>    
+>    data Flag 
+>     = Verbose  | Version 
+>     | Input String | Output String | LibDir String
+>       deriving Show
+>    
+>    options :: [OptDescr Flag]
+>    options =
+>     [ Option ['v']     ["verbose"] (NoArg Verbose)       "chatty output on stderr"
+>     , Option ['V','?'] ["version"] (NoArg Version)       "show version number"
+>     , Option ['o']     ["output"]  (OptArg outp "FILE")  "output FILE"
+>     , Option ['c']     []          (OptArg inp  "FILE")  "input FILE"
+>     , Option ['L']     ["libdir"]  (ReqArg LibDir "DIR") "library directory"
+>     ]
+>    
+>    inp,outp :: Maybe String -> Flag
+>    outp = Output . fromMaybe "stdout"
+>    inp  = Input  . fromMaybe "stdin"
+>    
+>    compilerOpts :: [String] -> IO ([Flag], [String])
+>    compilerOpts argv = 
+>       case getOpt Permute options argv of
+>          (o,n,[]  ) -> return (o,n)
+>          (_,_,errs) -> ioError (userError (concat errs ++ usageInfo header options))
+>      where header = "Usage: ic [OPTION...] files..."
+
+Then the rest of the program will use the constructed list of flags
+to determine it\'s behaviour.
+
+-}
+
+{- $example2
+
+A different approach is to group the option values in a record of type
+@Options@, and have each flag yield a function of type
+@Options -> Options@ transforming this record.
+
+>    module Opts2 where
+>
+>    import System.Console.GetOpt
+>    import Data.Maybe ( fromMaybe )
+>
+>    data Options = Options
+>     { optVerbose     :: Bool
+>     , optShowVersion :: Bool
+>     , optOutput      :: Maybe FilePath
+>     , optInput       :: Maybe FilePath
+>     , optLibDirs     :: [FilePath]
+>     } deriving Show
+>
+>    defaultOptions    = Options
+>     { optVerbose     = False
+>     , optShowVersion = False
+>     , optOutput      = Nothing
+>     , optInput       = Nothing
+>     , optLibDirs     = []
+>     }
+>
+>    options :: [OptDescr (Options -> Options)]
+>    options =
+>     [ Option ['v']     ["verbose"]
+>         (NoArg (\ opts -> opts { optVerbose = True }))
+>         "chatty output on stderr"
+>     , Option ['V','?'] ["version"]
+>         (NoArg (\ opts -> opts { optShowVersion = True }))
+>         "show version number"
+>     , Option ['o']     ["output"]
+>         (OptArg ((\ f opts -> opts { optOutput = Just f }) . fromMaybe "output")
+>                 "FILE")
+>         "output FILE"
+>     , Option ['c']     []
+>         (OptArg ((\ f opts -> opts { optInput = Just f }) . fromMaybe "input")
+>                 "FILE")
+>         "input FILE"
+>     , Option ['L']     ["libdir"]
+>         (ReqArg (\ d opts -> opts { optLibDirs = optLibDirs opts ++ [d] }) "DIR")
+>         "library directory"
+>     ]
+>
+>    compilerOpts :: [String] -> IO (Options, [String])
+>    compilerOpts argv =
+>       case getOpt Permute options argv of
+>          (o,n,[]  ) -> return (foldl (flip id) defaultOptions o, n)
+>          (_,_,errs) -> ioError (userError (concat errs ++ usageInfo header options))
+>      where header = "Usage: ic [OPTION...] files..."
+
+Similarly, each flag could yield a monadic function transforming a record,
+of type @Options -> IO Options@ (or any other monad), allowing option
+processing to perform actions of the chosen monad, e.g. printing help or
+version messages, checking that file arguments exist, etc.
+
+-}
+
diff --git a/libraries/base/System/Environment.hs b/libraries/base/System/Environment.hs
new file mode 100644
index 000000000000..b238360d2402
--- /dev/null
+++ b/libraries/base/System/Environment.hs
@@ -0,0 +1,451 @@
+{-# LANGUAGE Safe #-}
+{-# LANGUAGE CPP #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  System.Environment
+-- Copyright   :  (c) The University of Glasgow 2001
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+--
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  provisional
+-- Portability :  portable
+--
+-- Miscellaneous information about the system environment.
+--
+-----------------------------------------------------------------------------
+
+module System.Environment
+    (
+      getArgs,
+      getProgName,
+      getExecutablePath,
+      getEnv,
+      lookupEnv,
+      setEnv,
+      unsetEnv,
+      withArgs,
+      withProgName,
+      getEnvironment,
+  ) where
+
+import Prelude
+
+import Foreign.Safe
+import Foreign.C
+import System.IO.Error (mkIOError)
+import Control.Exception.Base (bracket, throwIO)
+-- import GHC.IO
+import GHC.IO.Exception
+import GHC.IO.Encoding (getFileSystemEncoding)
+import qualified GHC.Foreign as GHC
+import Data.List
+import Control.Monad
+#ifdef mingw32_HOST_OS
+import GHC.Environment
+import GHC.Windows
+#else
+import System.Posix.Internals (withFilePath)
+#endif
+
+import System.Environment.ExecutablePath
+
+#ifdef mingw32_HOST_OS
+# if defined(i386_HOST_ARCH)
+#  define WINDOWS_CCONV stdcall
+# elif defined(x86_64_HOST_ARCH)
+#  define WINDOWS_CCONV ccall
+# else
+#  error Unknown mingw32 arch
+# endif
+#endif
+
+#include "HsBaseConfig.h"
+
+-- ---------------------------------------------------------------------------
+-- getArgs, getProgName, getEnv
+
+#ifdef mingw32_HOST_OS
+
+-- Ignore the arguments to hs_init on Windows for the sake of Unicode compat
+
+getWin32ProgArgv_certainly :: IO [String]
+getWin32ProgArgv_certainly = do
+        mb_argv <- getWin32ProgArgv
+        case mb_argv of
+          Nothing   -> fmap dropRTSArgs getFullArgs
+          Just argv -> return argv
+
+withWin32ProgArgv :: [String] -> IO a -> IO a
+withWin32ProgArgv argv act = bracket begin setWin32ProgArgv (\_ -> act)
+  where
+    begin = do
+          mb_old_argv <- getWin32ProgArgv
+          setWin32ProgArgv (Just argv)
+          return mb_old_argv
+
+getWin32ProgArgv :: IO (Maybe [String])
+getWin32ProgArgv = alloca $ \p_argc -> alloca $ \p_argv -> do
+        c_getWin32ProgArgv p_argc p_argv
+        argc <- peek p_argc
+        argv_p <- peek p_argv
+        if argv_p == nullPtr
+         then return Nothing
+         else do
+          argv_ps <- peekArray (fromIntegral argc) argv_p
+          fmap Just $ mapM peekCWString argv_ps
+
+setWin32ProgArgv :: Maybe [String] -> IO ()
+setWin32ProgArgv Nothing = c_setWin32ProgArgv 0 nullPtr
+setWin32ProgArgv (Just argv) = withMany withCWString argv $ \argv_ps -> withArrayLen argv_ps $ \argc argv_p -> do
+        c_setWin32ProgArgv (fromIntegral argc) argv_p
+
+foreign import ccall unsafe "getWin32ProgArgv"
+  c_getWin32ProgArgv :: Ptr CInt -> Ptr (Ptr CWString) -> IO ()
+
+foreign import ccall unsafe "setWin32ProgArgv"
+  c_setWin32ProgArgv :: CInt -> Ptr CWString -> IO ()
+
+dropRTSArgs :: [String] -> [String]
+dropRTSArgs []             = []
+dropRTSArgs ("+RTS":rest)  = dropRTSArgs (dropWhile (/= "-RTS") rest)
+dropRTSArgs ("--RTS":rest) = rest
+dropRTSArgs ("-RTS":rest)  = dropRTSArgs rest
+dropRTSArgs (arg:rest)     = arg : dropRTSArgs rest
+
+#endif
+
+-- | Computation 'getArgs' returns a list of the program's command
+-- line arguments (not including the program name).
+getArgs :: IO [String]
+
+#ifdef mingw32_HOST_OS
+getArgs =  fmap tail getWin32ProgArgv_certainly
+#else
+getArgs =
+  alloca $ \ p_argc ->
+  alloca $ \ p_argv -> do
+   getProgArgv p_argc p_argv
+   p    <- fromIntegral `liftM` peek p_argc
+   argv <- peek p_argv
+   enc <- getFileSystemEncoding
+   peekArray (p - 1) (advancePtr argv 1) >>= mapM (GHC.peekCString enc)
+
+foreign import ccall unsafe "getProgArgv"
+  getProgArgv :: Ptr CInt -> Ptr (Ptr CString) -> IO ()
+#endif
+
+{-|
+Computation 'getProgName' returns the name of the program as it was
+invoked.
+
+However, this is hard-to-impossible to implement on some non-Unix
+OSes, so instead, for maximum portability, we just return the leafname
+of the program as invoked. Even then there are some differences
+between platforms: on Windows, for example, a program invoked as foo
+is probably really @FOO.EXE@, and that is what 'getProgName' will return.
+-}
+getProgName :: IO String
+#ifdef mingw32_HOST_OS
+-- Ignore the arguments to hs_init on Windows for the sake of Unicode compat
+getProgName = fmap (basename . head) getWin32ProgArgv_certainly
+#else
+getProgName =
+  alloca $ \ p_argc ->
+  alloca $ \ p_argv -> do
+     getProgArgv p_argc p_argv
+     argv <- peek p_argv
+     unpackProgName argv
+
+unpackProgName  :: Ptr (Ptr CChar) -> IO String   -- argv[0]
+unpackProgName argv = do
+  enc <- getFileSystemEncoding
+  s <- peekElemOff argv 0 >>= GHC.peekCString enc
+  return (basename s)
+#endif
+
+basename :: FilePath -> FilePath
+basename f = go f f
+ where
+  go acc [] = acc
+  go acc (x:xs)
+    | isPathSeparator x = go xs xs
+    | otherwise         = go acc xs
+
+  isPathSeparator :: Char -> Bool
+  isPathSeparator '/'  = True
+#ifdef mingw32_HOST_OS
+  isPathSeparator '\\' = True
+#endif
+  isPathSeparator _    = False
+
+
+-- | Computation 'getEnv' @var@ returns the value
+-- of the environment variable @var@. For the inverse, POSIX users
+-- can use 'System.Posix.Env.putEnv'.
+--
+-- This computation may fail with:
+--
+--  * 'System.IO.Error.isDoesNotExistError' if the environment variable
+--    does not exist.
+
+getEnv :: String -> IO String
+getEnv name = lookupEnv name >>= maybe handleError return
+  where
+#ifdef mingw32_HOST_OS
+    handleError = do
+        err <- c_GetLastError
+        if err == eRROR_ENVVAR_NOT_FOUND
+            then ioe_missingEnvVar name
+            else throwGetLastError "getEnv"
+
+eRROR_ENVVAR_NOT_FOUND :: DWORD
+eRROR_ENVVAR_NOT_FOUND = 203
+
+foreign import WINDOWS_CCONV unsafe "windows.h GetLastError"
+  c_GetLastError:: IO DWORD
+
+#else
+    handleError = ioe_missingEnvVar name
+#endif
+
+-- | Return the value of the environment variable @var@, or @Nothing@ if
+-- there is no such value.
+--
+-- For POSIX users, this is equivalent to 'System.Posix.Env.getEnv'.
+--
+-- /Since: 4.6.0.0/
+lookupEnv :: String -> IO (Maybe String)
+#ifdef mingw32_HOST_OS
+lookupEnv name = withCWString name $ \s -> try_size s 256
+  where
+    try_size s size = allocaArray (fromIntegral size) $ \p_value -> do
+      res <- c_GetEnvironmentVariable s p_value size
+      case res of
+        0 -> return Nothing
+        _ | res > size -> try_size s res -- Rare: size increased between calls to GetEnvironmentVariable
+          | otherwise  -> peekCWString p_value >>= return . Just
+
+foreign import WINDOWS_CCONV unsafe "windows.h GetEnvironmentVariableW"
+  c_GetEnvironmentVariable :: LPWSTR -> LPWSTR -> DWORD -> IO DWORD
+#else
+lookupEnv name =
+    withCString name $ \s -> do
+      litstring <- c_getenv s
+      if litstring /= nullPtr
+        then do enc <- getFileSystemEncoding
+                result <- GHC.peekCString enc litstring
+                return $ Just result
+        else return Nothing
+
+foreign import ccall unsafe "getenv"
+   c_getenv :: CString -> IO (Ptr CChar)
+#endif
+
+ioe_missingEnvVar :: String -> IO a
+ioe_missingEnvVar name = ioException (IOError Nothing NoSuchThing "getEnv"
+    "no environment variable" Nothing (Just name))
+
+-- | @setEnv name value@ sets the specified environment variable to @value@.
+--
+-- On Windows setting an environment variable to the /empty string/ removes
+-- that environment variable from the environment.  For the sake of
+-- compatibility we adopt that behavior.  In particular
+--
+-- @
+-- setEnv name \"\"
+-- @
+--
+-- has the same effect as
+--
+-- @
+-- `unsetEnv` name
+-- @
+--
+-- If you don't care about Windows support and want to set an environment
+-- variable to the empty string use @System.Posix.Env.setEnv@ from the @unix@
+-- package instead.
+--
+-- Throws `Control.Exception.IOException` if @name@ is the empty string or
+-- contains an equals sign.
+--
+-- /Since: 4.7.0.0/
+setEnv :: String -> String -> IO ()
+setEnv key_ value_
+  | null key       = throwIO (mkIOError InvalidArgument "setEnv" Nothing Nothing)
+  | '=' `elem` key = throwIO (mkIOError InvalidArgument "setEnv" Nothing Nothing)
+  | null value     = unsetEnv key
+  | otherwise      = setEnv_ key value
+  where
+    key   = takeWhile (/= '\NUL') key_
+    value = takeWhile (/= '\NUL') value_
+
+setEnv_ :: String -> String -> IO ()
+#ifdef mingw32_HOST_OS
+setEnv_ key value = withCWString key $ \k -> withCWString value $ \v -> do
+  success <- c_SetEnvironmentVariable k v
+  unless success (throwGetLastError "setEnv")
+
+foreign import WINDOWS_CCONV unsafe "windows.h SetEnvironmentVariableW"
+  c_SetEnvironmentVariable :: LPTSTR -> LPTSTR -> IO Bool
+#else
+
+-- NOTE: The 'setenv()' function is not available on all systems, hence we use
+-- 'putenv()'.  This leaks memory, but so do common implementations of
+-- 'setenv()' (AFAIK).
+setEnv_ k v = putEnv (k ++ "=" ++ v)
+
+putEnv :: String -> IO ()
+putEnv keyvalue = do
+  s <- getFileSystemEncoding >>= (`GHC.newCString` keyvalue)
+  -- IMPORTANT: Do not free `s` after calling putenv!
+  --
+  -- According to SUSv2, the string passed to putenv becomes part of the
+  -- enviroment.
+  throwErrnoIf_ (/= 0) "putenv" (c_putenv s)
+
+foreign import ccall unsafe "putenv" c_putenv :: CString -> IO CInt
+#endif
+
+-- | @unSet name@ removes the specified environment variable from the
+-- environment of the current process.
+--
+-- Throws `Control.Exception.IOException` if @name@ is the empty string or
+-- contains an equals sign.
+--
+-- /Since: 4.7.0.0/
+unsetEnv :: String -> IO ()
+#ifdef mingw32_HOST_OS
+unsetEnv key = withCWString key $ \k -> do
+  success <- c_SetEnvironmentVariable k nullPtr
+  unless success $ do
+    -- We consider unsetting an environment variable that does not exist not as
+    -- an error, hence we ignore eRROR_ENVVAR_NOT_FOUND.
+    err <- c_GetLastError
+    unless (err == eRROR_ENVVAR_NOT_FOUND) $ do
+      throwGetLastError "unsetEnv"
+#else
+
+#ifdef HAVE_UNSETENV
+unsetEnv key = withFilePath key (throwErrnoIf_ (/= 0) "unsetEnv" . c_unsetenv)
+foreign import ccall unsafe "__hsbase_unsetenv" c_unsetenv :: CString -> IO CInt
+#else
+unsetEnv key = setEnv_ key ""
+#endif
+
+#endif
+
+{-|
+'withArgs' @args act@ - while executing action @act@, have 'getArgs'
+return @args@.
+-}
+withArgs :: [String] -> IO a -> IO a
+withArgs xs act = do
+   p <- System.Environment.getProgName
+   withArgv (p:xs) act
+
+{-|
+'withProgName' @name act@ - while executing action @act@,
+have 'getProgName' return @name@.
+-}
+withProgName :: String -> IO a -> IO a
+withProgName nm act = do
+   xs <- System.Environment.getArgs
+   withArgv (nm:xs) act
+
+-- Worker routine which marshals and replaces an argv vector for
+-- the duration of an action.
+
+withArgv :: [String] -> IO a -> IO a
+
+#ifdef mingw32_HOST_OS
+-- We have to reflect the updated arguments in the RTS-side variables as
+-- well, because the RTS still consults them for error messages and the like.
+-- If we don't do this then ghc-e005 fails.
+withArgv new_args act = withWin32ProgArgv new_args $ withProgArgv new_args act
+#else
+withArgv = withProgArgv
+#endif
+
+withProgArgv :: [String] -> IO a -> IO a
+withProgArgv new_args act = do
+  pName <- System.Environment.getProgName
+  existing_args <- System.Environment.getArgs
+  bracket (setProgArgv new_args)
+          (\argv -> do _ <- setProgArgv (pName:existing_args)
+                       freeProgArgv argv)
+          (const act)
+
+freeProgArgv :: Ptr CString -> IO ()
+freeProgArgv argv = do
+  size <- lengthArray0 nullPtr argv
+  sequence_ [ peek (argv `advancePtr` i) >>= free
+            | i <- [size - 1, size - 2 .. 0]]
+  free argv
+
+setProgArgv :: [String] -> IO (Ptr CString)
+setProgArgv argv = do
+  enc <- getFileSystemEncoding
+  vs <- mapM (GHC.newCString enc) argv >>= newArray0 nullPtr
+  c_setProgArgv (genericLength argv) vs
+  return vs
+
+foreign import ccall unsafe "setProgArgv"
+  c_setProgArgv  :: CInt -> Ptr CString -> IO ()
+
+-- |'getEnvironment' retrieves the entire environment as a
+-- list of @(key,value)@ pairs.
+--
+-- If an environment entry does not contain an @\'=\'@ character,
+-- the @key@ is the whole entry and the @value@ is the empty string.
+getEnvironment :: IO [(String, String)]
+
+#ifdef mingw32_HOST_OS
+getEnvironment = bracket c_GetEnvironmentStrings c_FreeEnvironmentStrings $ \pBlock ->
+    if pBlock == nullPtr then return []
+     else go pBlock
+  where
+    go pBlock = do
+        -- The block is terminated by a null byte where there
+        -- should be an environment variable of the form X=Y
+        c <- peek pBlock
+        if c == 0 then return []
+         else do
+          -- Seek the next pair (or terminating null):
+          pBlock' <- seekNull pBlock False
+          -- We now know the length in bytes, but ignore it when
+          -- getting the actual String:
+          str <- peekCWString pBlock
+          fmap (divvy str :) $ go pBlock'
+
+    -- Returns pointer to the byte *after* the next null
+    seekNull pBlock done = do
+        let pBlock' = pBlock `plusPtr` sizeOf (undefined :: CWchar)
+        if done then return pBlock'
+         else do
+           c <- peek pBlock'
+           seekNull pBlock' (c == (0 :: Word8 ))
+
+foreign import WINDOWS_CCONV unsafe "windows.h GetEnvironmentStringsW"
+  c_GetEnvironmentStrings :: IO (Ptr CWchar)
+
+foreign import WINDOWS_CCONV unsafe "windows.h FreeEnvironmentStringsW"
+  c_FreeEnvironmentStrings :: Ptr CWchar -> IO Bool
+#else
+getEnvironment = do
+   pBlock <- getEnvBlock
+   if pBlock == nullPtr then return []
+    else do
+      enc <- getFileSystemEncoding
+      stuff <- peekArray0 nullPtr pBlock >>= mapM (GHC.peekCString enc)
+      return (map divvy stuff)
+
+foreign import ccall unsafe "__hscore_environ"
+  getEnvBlock :: IO (Ptr CString)
+#endif
+
+divvy :: String -> (String, String)
+divvy str =
+  case break (=='=') str of
+    (xs,[])        -> (xs,[]) -- don't barf (like Posix.getEnvironment)
+    (name,_:value) -> (name,value)
diff --git a/libraries/base/System/Environment/ExecutablePath.hsc b/libraries/base/System/Environment/ExecutablePath.hsc
new file mode 100644
index 000000000000..22665f419bd7
--- /dev/null
+++ b/libraries/base/System/Environment/ExecutablePath.hsc
@@ -0,0 +1,175 @@
+{-# LANGUAGE Safe #-}
+{-# LANGUAGE CPP #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  System.Environment.ExecutablePath
+-- Copyright   :  (c) The University of Glasgow 2001
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+--
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  provisional
+-- Portability :  portable
+--
+-- Function to retrieve the absolute filepath of the current executable.
+--
+-- /Since: 4.6.0.0/
+-----------------------------------------------------------------------------
+
+module System.Environment.ExecutablePath ( getExecutablePath ) where
+
+-- The imports are purposely kept completely disjoint to prevent edits
+-- to one OS implementation from breaking another.
+
+#if defined(darwin_HOST_OS)
+import Data.Word
+import Foreign.C
+import Foreign.Marshal.Alloc
+import Foreign.Ptr
+import Foreign.Storable
+import System.Posix.Internals
+#elif defined(linux_HOST_OS)
+import Foreign.C
+import Foreign.Marshal.Array
+import System.Posix.Internals
+#elif defined(mingw32_HOST_OS)
+import Data.Word
+import Foreign.C
+import Foreign.Marshal.Array
+import Foreign.Ptr
+import System.Posix.Internals
+#else
+import Foreign.C
+import Foreign.Marshal.Alloc
+import Foreign.Ptr
+import Foreign.Storable
+import System.Posix.Internals
+#endif
+
+-- The exported function is defined outside any if-guard to make sure
+-- every OS implements it with the same type.
+
+-- | Returns the absolute pathname of the current executable.
+--
+-- Note that for scripts and interactive sessions, this is the path to
+-- the interpreter (e.g. ghci.)
+--
+-- /Since: 4.6.0.0/
+getExecutablePath :: IO FilePath
+
+--------------------------------------------------------------------------------
+-- Mac OS X
+
+#if defined(darwin_HOST_OS)
+
+type UInt32 = Word32
+
+foreign import ccall unsafe "mach-o/dyld.h _NSGetExecutablePath"
+    c__NSGetExecutablePath :: CString -> Ptr UInt32 -> IO CInt
+
+-- | Returns the path of the main executable. The path may be a
+-- symbolic link and not the real file.
+--
+-- See dyld(3)
+_NSGetExecutablePath :: IO FilePath
+_NSGetExecutablePath =
+    allocaBytes 1024 $ \ buf ->  -- PATH_MAX is 1024 on OS X
+    alloca $ \ bufsize -> do
+        poke bufsize 1024
+        status <- c__NSGetExecutablePath buf bufsize
+        if status == 0
+            then peekFilePath buf
+            else do reqBufsize <- fromIntegral `fmap` peek bufsize
+                    allocaBytes reqBufsize $ \ newBuf -> do
+                        status2 <- c__NSGetExecutablePath newBuf bufsize
+                        if status2 == 0
+                             then peekFilePath newBuf
+                             else error "_NSGetExecutablePath: buffer too small"
+
+foreign import ccall unsafe "stdlib.h realpath"
+    c_realpath :: CString -> CString -> IO CString
+
+-- | Resolves all symbolic links, extra \/ characters, and references
+-- to \/.\/ and \/..\/. Returns an absolute pathname.
+--
+-- See realpath(3)
+realpath :: FilePath -> IO FilePath
+realpath path =
+    withFilePath path $ \ fileName ->
+    allocaBytes 1024 $ \ resolvedName -> do
+        _ <- throwErrnoIfNull "realpath" $ c_realpath fileName resolvedName
+        peekFilePath resolvedName
+
+getExecutablePath = _NSGetExecutablePath >>= realpath
+
+--------------------------------------------------------------------------------
+-- Linux
+
+#elif defined(linux_HOST_OS)
+
+foreign import ccall unsafe "readlink"
+    c_readlink :: CString -> CString -> CSize -> IO CInt
+
+-- | Reads the @FilePath@ pointed to by the symbolic link and returns
+-- it.
+--
+-- See readlink(2)
+readSymbolicLink :: FilePath -> IO FilePath
+readSymbolicLink file =
+    allocaArray0 4096 $ \buf -> do
+        withFilePath file $ \s -> do
+            len <- throwErrnoPathIfMinus1 "readSymbolicLink" file $
+                   c_readlink s buf 4096
+            peekFilePathLen (buf,fromIntegral len)
+
+getExecutablePath = readSymbolicLink $ "/proc/self/exe"
+
+--------------------------------------------------------------------------------
+-- Windows
+
+#elif defined(mingw32_HOST_OS)
+
+# if defined(i386_HOST_ARCH)
+##  define WINDOWS_CCONV stdcall
+# elif defined(x86_64_HOST_ARCH)
+##  define WINDOWS_CCONV ccall
+# else
+#  error Unknown mingw32 arch
+# endif
+
+foreign import WINDOWS_CCONV unsafe "windows.h GetModuleFileNameW"
+    c_GetModuleFileName :: Ptr () -> CWString -> Word32 -> IO Word32
+
+getExecutablePath = go 2048  -- plenty, PATH_MAX is 512 under Win32
+  where
+    go size = allocaArray (fromIntegral size) $ \ buf -> do
+        ret <- c_GetModuleFileName nullPtr buf size
+        case ret of
+            0 -> error "getExecutablePath: GetModuleFileNameW returned an error"
+            _ | ret < size -> peekFilePath buf
+              | otherwise  -> go (size * 2)
+
+--------------------------------------------------------------------------------
+-- Fallback to argv[0]
+
+#else
+
+foreign import ccall unsafe "getFullProgArgv"
+    c_getFullProgArgv :: Ptr CInt -> Ptr (Ptr CString) -> IO ()
+
+getExecutablePath =
+    alloca $ \ p_argc ->
+    alloca $ \ p_argv -> do
+        c_getFullProgArgv p_argc p_argv
+        argc <- peek p_argc
+        if argc > 0
+            -- If argc > 0 then argv[0] is guaranteed by the standard
+            -- to be a pointer to a null-terminated string.
+            then peek p_argv >>= peek >>= peekFilePath
+            else error $ "getExecutablePath: " ++ msg
+  where msg = "no OS specific implementation and program name couldn't be " ++
+              "found in argv"
+
+--------------------------------------------------------------------------------
+
+#endif
diff --git a/libraries/base/System/Exit.hs b/libraries/base/System/Exit.hs
new file mode 100644
index 000000000000..932cbfbd0f6d
--- /dev/null
+++ b/libraries/base/System/Exit.hs
@@ -0,0 +1,83 @@
+{-# LANGUAGE Trustworthy #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  System.Exit
+-- Copyright   :  (c) The University of Glasgow 2001
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+-- 
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  provisional
+-- Portability :  portable
+--
+-- Exiting the program.
+--
+-----------------------------------------------------------------------------
+
+module System.Exit
+    (
+      ExitCode(ExitSuccess,ExitFailure)
+    , exitWith
+    , exitFailure
+    , exitSuccess
+    , die
+  ) where
+
+import Prelude
+import System.IO
+
+import GHC.IO
+import GHC.IO.Exception
+
+-- ---------------------------------------------------------------------------
+-- exitWith
+
+-- | Computation 'exitWith' @code@ throws 'ExitCode' @code@.
+-- Normally this terminates the program, returning @code@ to the
+-- program's caller.
+--
+-- On program termination, the standard 'Handle's 'stdout' and
+-- 'stderr' are flushed automatically; any other buffered 'Handle's
+-- need to be flushed manually, otherwise the buffered data will be
+-- discarded.
+--
+-- A program that fails in any other way is treated as if it had
+-- called 'exitFailure'.
+-- A program that terminates successfully without calling 'exitWith'
+-- explicitly is treated as it it had called 'exitWith' 'ExitSuccess'.
+--
+-- As an 'ExitCode' is not an 'IOError', 'exitWith' bypasses
+-- the error handling in the 'IO' monad and cannot be intercepted by
+-- 'catch' from the "Prelude".  However it is a 'SomeException', and can
+-- be caught using the functions of "Control.Exception".  This means
+-- that cleanup computations added with 'Control.Exception.bracket'
+-- (from "Control.Exception") are also executed properly on 'exitWith'.
+--
+-- Note: in GHC, 'exitWith' should be called from the main program
+-- thread in order to exit the process.  When called from another
+-- thread, 'exitWith' will throw an 'ExitException' as normal, but the
+-- exception will not cause the process itself to exit.
+--
+exitWith :: ExitCode -> IO a
+exitWith ExitSuccess = throwIO ExitSuccess
+exitWith code@(ExitFailure n)
+  | n /= 0 = throwIO code
+  | otherwise = ioError (IOError Nothing InvalidArgument "exitWith" "ExitFailure 0" Nothing Nothing)
+
+-- | The computation 'exitFailure' is equivalent to
+-- 'exitWith' @(@'ExitFailure' /exitfail/@)@,
+-- where /exitfail/ is implementation-dependent.
+exitFailure :: IO a
+exitFailure = exitWith (ExitFailure 1)
+
+-- | The computation 'exitSuccess' is equivalent to
+-- 'exitWith' 'ExitSuccess', It terminates the program
+-- successfully.
+exitSuccess :: IO a
+exitSuccess = exitWith ExitSuccess
+
+-- | Write given error message to `stderr` and terminate with `exitFailure`.
+--
+-- /Since: 4.7.1.0/
+die :: String -> IO a
+die err = hPutStrLn stderr err >> exitFailure
diff --git a/libraries/base/System/IO.hs b/libraries/base/System/IO.hs
new file mode 100644
index 000000000000..5cd0351fdbbb
--- /dev/null
+++ b/libraries/base/System/IO.hs
@@ -0,0 +1,596 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE CPP, NoImplicitPrelude #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  System.IO
+-- Copyright   :  (c) The University of Glasgow 2001
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+-- 
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  stable
+-- Portability :  portable
+--
+-- The standard IO library.
+--
+-----------------------------------------------------------------------------
+
+module System.IO (
+    -- * The IO monad
+
+    IO,
+    fixIO,
+
+    -- * Files and handles
+
+    FilePath,
+
+    Handle,             -- abstract, instance of: Eq, Show.
+
+    -- | GHC note: a 'Handle' will be automatically closed when the garbage
+    -- collector detects that it has become unreferenced by the program.
+    -- However, relying on this behaviour is not generally recommended:
+    -- the garbage collector is unpredictable.  If possible, use
+    -- an explicit 'hClose' to close 'Handle's when they are no longer
+    -- required.  GHC does not currently attempt to free up file
+    -- descriptors when they have run out, it is your responsibility to
+    -- ensure that this doesn't happen.
+
+    -- ** Standard handles
+
+    -- | Three handles are allocated during program initialisation,
+    -- and are initially open.
+
+    stdin, stdout, stderr,
+
+    -- * Opening and closing files
+
+    -- ** Opening files
+
+    withFile,
+    openFile,
+    IOMode(ReadMode,WriteMode,AppendMode,ReadWriteMode),
+
+    -- ** Closing files
+
+    hClose,
+
+    -- ** Special cases
+
+    -- | These functions are also exported by the "Prelude".
+
+    readFile,
+    writeFile,
+    appendFile,
+
+    -- ** File locking
+
+    -- $locking
+
+    -- * Operations on handles
+
+    -- ** Determining and changing the size of a file
+
+    hFileSize,
+    hSetFileSize,
+
+    -- ** Detecting the end of input
+
+    hIsEOF,
+    isEOF,
+
+    -- ** Buffering operations
+
+    BufferMode(NoBuffering,LineBuffering,BlockBuffering),
+    hSetBuffering,
+    hGetBuffering,
+    hFlush,
+
+    -- ** Repositioning handles
+
+    hGetPosn,
+    hSetPosn,
+    HandlePosn,                -- abstract, instance of: Eq, Show.
+
+    hSeek,
+    SeekMode(AbsoluteSeek,RelativeSeek,SeekFromEnd),
+    hTell,
+
+    -- ** Handle properties
+
+    hIsOpen, hIsClosed,
+    hIsReadable, hIsWritable,
+    hIsSeekable,
+
+    -- ** Terminal operations (not portable: GHC only)
+
+    hIsTerminalDevice,
+
+    hSetEcho,
+    hGetEcho,
+
+    -- ** Showing handle state (not portable: GHC only)
+
+    hShow,
+
+    -- * Text input and output
+
+    -- ** Text input
+
+    hWaitForInput,
+    hReady,
+    hGetChar,
+    hGetLine,
+    hLookAhead,
+    hGetContents,
+
+    -- ** Text output
+
+    hPutChar,
+    hPutStr,
+    hPutStrLn,
+    hPrint,
+
+    -- ** Special cases for standard input and output
+
+    -- | These functions are also exported by the "Prelude".
+
+    interact,
+    putChar,
+    putStr,
+    putStrLn,
+    print,
+    getChar,
+    getLine,
+    getContents,
+    readIO,
+    readLn,
+
+    -- * Binary input and output
+
+    withBinaryFile,
+    openBinaryFile,
+    hSetBinaryMode,
+    hPutBuf,
+    hGetBuf,
+    hGetBufSome,
+    hPutBufNonBlocking,
+    hGetBufNonBlocking,
+
+    -- * Temporary files
+
+    openTempFile,
+    openBinaryTempFile,
+    openTempFileWithDefaultPermissions,
+    openBinaryTempFileWithDefaultPermissions,
+
+    -- * Unicode encoding\/decoding
+
+    -- | A text-mode 'Handle' has an associated 'TextEncoding', which
+    -- is used to decode bytes into Unicode characters when reading,
+    -- and encode Unicode characters into bytes when writing.
+    --
+    -- The default 'TextEncoding' is the same as the default encoding
+    -- on your system, which is also available as 'localeEncoding'.
+    -- (GHC note: on Windows, we currently do not support double-byte
+    -- encodings; if the console\'s code page is unsupported, then
+    -- 'localeEncoding' will be 'latin1'.)
+    --
+    -- Encoding and decoding errors are always detected and reported,
+    -- except during lazy I/O ('hGetContents', 'getContents', and
+    -- 'readFile'), where a decoding error merely results in
+    -- termination of the character stream, as with other I/O errors.
+
+    hSetEncoding, 
+    hGetEncoding,
+
+    -- ** Unicode encodings
+    TextEncoding, 
+    latin1,
+    utf8, utf8_bom,
+    utf16, utf16le, utf16be,
+    utf32, utf32le, utf32be, 
+    localeEncoding,
+    char8,
+    mkTextEncoding,
+
+    -- * Newline conversion
+    
+    -- | In Haskell, a newline is always represented by the character
+    -- '\n'.  However, in files and external character streams, a
+    -- newline may be represented by another character sequence, such
+    -- as '\r\n'.
+    --
+    -- A text-mode 'Handle' has an associated 'NewlineMode' that
+    -- specifies how to transate newline characters.  The
+    -- 'NewlineMode' specifies the input and output translation
+    -- separately, so that for instance you can translate '\r\n'
+    -- to '\n' on input, but leave newlines as '\n' on output.
+    --
+    -- The default 'NewlineMode' for a 'Handle' is
+    -- 'nativeNewlineMode', which does no translation on Unix systems,
+    -- but translates '\r\n' to '\n' and back on Windows.
+    --
+    -- Binary-mode 'Handle's do no newline translation at all.
+    --
+    hSetNewlineMode, 
+    Newline(..), nativeNewline, 
+    NewlineMode(..), 
+    noNewlineTranslation, universalNewlineMode, nativeNewlineMode,
+  ) where
+
+import Control.Exception.Base
+
+import Data.Bits
+import Data.List
+import Data.Maybe
+import Foreign.C.Error
+#ifdef mingw32_HOST_OS
+import Foreign.C.String
+#endif
+import Foreign.C.Types
+import System.Posix.Internals
+import System.Posix.Types
+
+import GHC.Base
+import GHC.IO hiding ( bracket, onException )
+import GHC.IO.IOMode
+import GHC.IO.Handle.FD
+import qualified GHC.IO.FD as FD
+import GHC.IO.Handle
+import GHC.IO.Handle.Text ( hGetBufSome, hPutStrLn )
+import GHC.IO.Exception ( userError )
+import GHC.IO.Encoding
+import Text.Read
+import GHC.Show
+import GHC.MVar
+
+-- -----------------------------------------------------------------------------
+-- Standard IO
+
+-- | Write a character to the standard output device
+-- (same as 'hPutChar' 'stdout').
+
+putChar         :: Char -> IO ()
+putChar c       =  hPutChar stdout c
+
+-- | Write a string to the standard output device
+-- (same as 'hPutStr' 'stdout').
+
+putStr          :: String -> IO ()
+putStr s        =  hPutStr stdout s
+
+-- | The same as 'putStr', but adds a newline character.
+
+putStrLn        :: String -> IO ()
+putStrLn s      =  hPutStrLn stdout s
+
+-- | The 'print' function outputs a value of any printable type to the
+-- standard output device.
+-- Printable types are those that are instances of class 'Show'; 'print'
+-- converts values to strings for output using the 'show' operation and
+-- adds a newline.
+--
+-- For example, a program to print the first 20 integers and their
+-- powers of 2 could be written as:
+--
+-- > main = print ([(n, 2^n) | n <- [0..19]])
+
+print           :: Show a => a -> IO ()
+print x         =  putStrLn (show x)
+
+-- | Read a character from the standard input device
+-- (same as 'hGetChar' 'stdin').
+
+getChar         :: IO Char
+getChar         =  hGetChar stdin
+
+-- | Read a line from the standard input device
+-- (same as 'hGetLine' 'stdin').
+
+getLine         :: IO String
+getLine         =  hGetLine stdin
+
+-- | The 'getContents' operation returns all user input as a single string,
+-- which is read lazily as it is needed
+-- (same as 'hGetContents' 'stdin').
+
+getContents     :: IO String
+getContents     =  hGetContents stdin
+
+-- | The 'interact' function takes a function of type @String->String@
+-- as its argument.  The entire input from the standard input device is
+-- passed to this function as its argument, and the resulting string is
+-- output on the standard output device.
+
+interact        ::  (String -> String) -> IO ()
+interact f      =   do s <- getContents
+                       putStr (f s)
+
+-- | The 'readFile' function reads a file and
+-- returns the contents of the file as a string.
+-- The file is read lazily, on demand, as with 'getContents'.
+
+readFile        :: FilePath -> IO String
+readFile name   =  openFile name ReadMode >>= hGetContents
+
+-- | The computation 'writeFile' @file str@ function writes the string @str@,
+-- to the file @file@.
+writeFile :: FilePath -> String -> IO ()
+writeFile f txt = withFile f WriteMode (\ hdl -> hPutStr hdl txt)
+
+-- | The computation 'appendFile' @file str@ function appends the string @str@,
+-- to the file @file@.
+--
+-- Note that 'writeFile' and 'appendFile' write a literal string
+-- to a file.  To write a value of any printable type, as with 'print',
+-- use the 'show' function to convert the value to a string first.
+--
+-- > main = appendFile "squares" (show [(x,x*x) | x <- [0,0.1..2]])
+
+appendFile      :: FilePath -> String -> IO ()
+appendFile f txt = withFile f AppendMode (\ hdl -> hPutStr hdl txt)
+
+-- | The 'readLn' function combines 'getLine' and 'readIO'.
+
+readLn          :: Read a => IO a
+readLn          =  do l <- getLine
+                      r <- readIO l
+                      return r
+
+-- | The 'readIO' function is similar to 'read' except that it signals
+-- parse failure to the 'IO' monad instead of terminating the program.
+
+readIO          :: Read a => String -> IO a
+readIO s        =  case (do { (x,t) <- reads s ;
+                              ("","") <- lex t ;
+                              return x }) of
+                        [x]    -> return x
+                        []     -> ioError (userError "Prelude.readIO: no parse")
+                        _      -> ioError (userError "Prelude.readIO: ambiguous parse")
+
+-- | The Unicode encoding of the current locale
+--
+-- This is the initial locale encoding: if it has been subsequently changed by
+-- 'GHC.IO.Encoding.setLocaleEncoding' this value will not reflect that change.
+localeEncoding :: TextEncoding
+localeEncoding = initLocaleEncoding
+
+-- | Computation 'hReady' @hdl@ indicates whether at least one item is
+-- available for input from handle @hdl@.
+-- 
+-- This operation may fail with:
+--
+--  * 'System.IO.Error.isEOFError' if the end of file has been reached.
+
+hReady          :: Handle -> IO Bool
+hReady h        =  hWaitForInput h 0
+
+-- | Computation 'hPrint' @hdl t@ writes the string representation of @t@
+-- given by the 'shows' function to the file or channel managed by @hdl@
+-- and appends a newline.
+--
+-- This operation may fail with:
+--
+--  * 'System.IO.Error.isFullError' if the device is full; or
+--
+--  * 'System.IO.Error.isPermissionError' if another system resource limit would be exceeded.
+
+hPrint          :: Show a => Handle -> a -> IO ()
+hPrint hdl      =  hPutStrLn hdl . show
+
+-- | @'withFile' name mode act@ opens a file using 'openFile' and passes
+-- the resulting handle to the computation @act@.  The handle will be
+-- closed on exit from 'withFile', whether by normal termination or by
+-- raising an exception.  If closing the handle raises an exception, then
+-- this exception will be raised by 'withFile' rather than any exception
+-- raised by 'act'.
+withFile :: FilePath -> IOMode -> (Handle -> IO r) -> IO r
+withFile name mode = bracket (openFile name mode) hClose
+
+-- | @'withBinaryFile' name mode act@ opens a file using 'openBinaryFile'
+-- and passes the resulting handle to the computation @act@.  The handle
+-- will be closed on exit from 'withBinaryFile', whether by normal
+-- termination or by raising an exception.
+withBinaryFile :: FilePath -> IOMode -> (Handle -> IO r) -> IO r
+withBinaryFile name mode = bracket (openBinaryFile name mode) hClose
+
+-- ---------------------------------------------------------------------------
+-- fixIO
+
+fixIO :: (a -> IO a) -> IO a
+fixIO k = do
+    m <- newEmptyMVar
+    ans <- unsafeInterleaveIO (takeMVar m)
+    result <- k ans
+    putMVar m result
+    return result
+
+-- NOTE: we do our own explicit black holing here, because GHC's lazy
+-- blackholing isn't enough.  In an infinite loop, GHC may run the IO
+-- computation a few times before it notices the loop, which is wrong.
+--
+-- NOTE2: the explicit black-holing with an IORef ran into trouble
+-- with multiple threads (see #5421), so now we use an MVar.  I'm
+-- actually wondering whether we should use readMVar rather than
+-- takeMVar, just in case it ends up being executed multiple times,
+-- but even then it would have to be masked to protect against async
+-- exceptions.  Ugh.  What we really need here is an IVar, or an
+-- atomic readMVar, or even STM.  All these seem like overkill.
+--
+-- See also System.IO.Unsafe.unsafeFixIO.
+--
+
+-- | The function creates a temporary file in ReadWrite mode.
+-- The created file isn\'t deleted automatically, so you need to delete it manually.
+--
+-- The file is creates with permissions such that only the current
+-- user can read\/write it.
+--
+-- With some exceptions (see below), the file will be created securely
+-- in the sense that an attacker should not be able to cause
+-- openTempFile to overwrite another file on the filesystem using your
+-- credentials, by putting symbolic links (on Unix) in the place where
+-- the temporary file is to be created.  On Unix the @O_CREAT@ and
+-- @O_EXCL@ flags are used to prevent this attack, but note that
+-- @O_EXCL@ is sometimes not supported on NFS filesystems, so if you
+-- rely on this behaviour it is best to use local filesystems only.
+--
+openTempFile :: FilePath   -- ^ Directory in which to create the file
+             -> String     -- ^ File name template. If the template is \"foo.ext\" then
+                           -- the created file will be \"fooXXX.ext\" where XXX is some
+                           -- random number.
+             -> IO (FilePath, Handle)
+openTempFile tmp_dir template
+    = openTempFile' "openTempFile" tmp_dir template False 0o600
+
+-- | Like 'openTempFile', but opens the file in binary mode. See 'openBinaryFile' for more comments.
+openBinaryTempFile :: FilePath -> String -> IO (FilePath, Handle)
+openBinaryTempFile tmp_dir template
+    = openTempFile' "openBinaryTempFile" tmp_dir template True 0o600
+
+-- | Like 'openTempFile', but uses the default file permissions
+openTempFileWithDefaultPermissions :: FilePath -> String
+                                   -> IO (FilePath, Handle)
+openTempFileWithDefaultPermissions tmp_dir template
+    = openTempFile' "openBinaryTempFile" tmp_dir template False 0o666
+
+-- | Like 'openBinaryTempFile', but uses the default file permissions
+openBinaryTempFileWithDefaultPermissions :: FilePath -> String
+                                         -> IO (FilePath, Handle)
+openBinaryTempFileWithDefaultPermissions tmp_dir template
+    = openTempFile' "openBinaryTempFile" tmp_dir template True 0o666
+
+openTempFile' :: String -> FilePath -> String -> Bool -> CMode
+              -> IO (FilePath, Handle)
+openTempFile' loc tmp_dir template binary mode = findTempName
+  where
+    -- We split off the last extension, so we can use .foo.ext files
+    -- for temporary files (hidden on Unix OSes). Unfortunately we're
+    -- below filepath in the hierarchy here.
+    (prefix,suffix) =
+       case break (== '.') $ reverse template of
+         -- First case: template contains no '.'s. Just re-reverse it.
+         (rev_suffix, "")       -> (reverse rev_suffix, "")
+         -- Second case: template contains at least one '.'. Strip the
+         -- dot from the prefix and prepend it to the suffix (if we don't
+         -- do this, the unique number will get added after the '.' and
+         -- thus be part of the extension, which is wrong.)
+         (rev_suffix, '.':rest) -> (reverse rest, '.':reverse rev_suffix)
+         -- Otherwise, something is wrong, because (break (== '.')) should
+         -- always return a pair with either the empty string or a string
+         -- beginning with '.' as the second component.
+         _                      -> error "bug in System.IO.openTempFile"
+
+    findTempName = do
+      rs <- rand_string
+      let filename = prefix ++ rs ++ suffix
+          filepath = tmp_dir `combine` filename
+      r <- openNewFile filepath binary mode
+      case r of
+        FileExists -> findTempName
+        OpenNewError errno -> ioError (errnoToIOError loc errno Nothing (Just tmp_dir))
+        NewFileCreated fd -> do
+          (fD,fd_type) <- FD.mkFD fd ReadWriteMode Nothing{-no stat-}
+                               False{-is_socket-}
+                               True{-is_nonblock-}
+
+          enc <- getLocaleEncoding
+          h <- mkHandleFromFD fD fd_type filepath ReadWriteMode False{-set non-block-} (Just enc)
+
+          return (filepath, h)
+
+      where
+        -- XXX bits copied from System.FilePath, since that's not available here
+        combine a b
+                  | null b = a
+                  | null a = b
+                  | last a == pathSeparator = a ++ b
+                  | otherwise = a ++ [pathSeparator] ++ b
+
+-- int rand(void) from <stdlib.h>, limited by RAND_MAX (small value, 32768)
+foreign import ccall "rand" c_rand :: IO CInt
+
+-- build large digit-alike number
+rand_string :: IO String
+rand_string = do
+  r1 <- c_rand
+  r2 <- c_rand
+  return $ show r1 ++ show r2
+
+data OpenNewFileResult
+  = NewFileCreated CInt
+  | FileExists
+  | OpenNewError Errno
+
+openNewFile :: FilePath -> Bool -> CMode -> IO OpenNewFileResult
+openNewFile filepath binary mode = do
+  let oflags1 = rw_flags .|. o_EXCL
+
+      binary_flags
+        | binary    = o_BINARY
+        | otherwise = 0
+
+      oflags = oflags1 .|. binary_flags
+  fd <- withFilePath filepath $ \ f ->
+          c_open f oflags mode
+  if fd < 0
+    then do
+      errno <- getErrno
+      case errno of
+        _ | errno == eEXIST -> return FileExists
+#ifdef mingw32_HOST_OS
+        -- If c_open throws EACCES on windows, it could mean that filepath is a
+        -- directory. In this case, we want to return FileExists so that the
+        -- enclosing openTempFile can try again instead of failing outright.
+        -- See bug #4968.
+        _ | errno == eACCES -> do
+          withCString filepath $ \path -> do
+            -- There is a race here: the directory might have been moved or
+            -- deleted between the c_open call and the next line, but there
+            -- doesn't seem to be any direct way to detect that the c_open call
+            -- failed because of an existing directory.
+            exists <- c_fileExists path
+            return $ if exists
+              then FileExists
+              else OpenNewError errno
+#endif
+        _ -> return (OpenNewError errno)
+    else return (NewFileCreated fd)
+
+#ifdef mingw32_HOST_OS
+foreign import ccall "file_exists" c_fileExists :: CString -> IO Bool
+#endif
+
+-- XXX Should use filepath library
+pathSeparator :: Char
+#ifdef mingw32_HOST_OS
+pathSeparator = '\\'
+#else
+pathSeparator = '/'
+#endif
+
+-- XXX Copied from GHC.Handle
+std_flags, output_flags, rw_flags :: CInt
+std_flags    = o_NONBLOCK   .|. o_NOCTTY
+output_flags = std_flags    .|. o_CREAT
+rw_flags     = output_flags .|. o_RDWR
+
+-- $locking
+-- Implementations should enforce as far as possible, at least locally to the
+-- Haskell process, multiple-reader single-writer locking on files.
+-- That is, /there may either be many handles on the same file which manage input, or just one handle on the file which manages output/.  If any
+-- open or semi-closed handle is managing a file for output, no new
+-- handle can be allocated for that file.  If any open or semi-closed
+-- handle is managing a file for input, new handles can only be allocated
+-- if they do not manage output.  Whether two files are the same is
+-- implementation-dependent, but they should normally be the same if they
+-- have the same absolute path name and neither has been renamed, for
+-- example.
+--
+-- /Warning/: the 'readFile' operation holds a semi-closed handle on
+-- the file until the entire contents of the file have been consumed.
+-- It follows that an attempt to write to a file (using 'writeFile', for
+-- example) that was earlier opened by 'readFile' will usually result in
+-- failure with 'System.IO.Error.isAlreadyInUseError'.
+
diff --git a/libraries/base/System/IO/Error.hs b/libraries/base/System/IO/Error.hs
new file mode 100644
index 000000000000..6b926aedf571
--- /dev/null
+++ b/libraries/base/System/IO/Error.hs
@@ -0,0 +1,341 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  System.IO.Error
+-- Copyright   :  (c) The University of Glasgow 2001
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+-- 
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  provisional
+-- Portability :  portable
+--
+-- Standard IO Errors.
+--
+-----------------------------------------------------------------------------
+
+module System.IO.Error (
+
+    -- * I\/O errors
+    IOError,
+
+    userError,
+
+    mkIOError,
+
+    annotateIOError,
+
+    -- ** Classifying I\/O errors
+    isAlreadyExistsError,
+    isDoesNotExistError,
+    isAlreadyInUseError,
+    isFullError, 
+    isEOFError,
+    isIllegalOperation, 
+    isPermissionError,
+    isUserError,
+
+    -- ** Attributes of I\/O errors
+    ioeGetErrorType,
+    ioeGetLocation,
+    ioeGetErrorString,
+    ioeGetHandle,
+    ioeGetFileName,
+
+    ioeSetErrorType,
+    ioeSetErrorString,
+    ioeSetLocation,
+    ioeSetHandle,
+    ioeSetFileName,
+
+    -- * Types of I\/O error
+    IOErrorType,                -- abstract
+
+    alreadyExistsErrorType,
+    doesNotExistErrorType,
+    alreadyInUseErrorType,
+    fullErrorType,
+    eofErrorType,
+    illegalOperationErrorType, 
+    permissionErrorType,
+    userErrorType,
+
+    -- ** 'IOErrorType' predicates
+    isAlreadyExistsErrorType,
+    isDoesNotExistErrorType,
+    isAlreadyInUseErrorType,
+    isFullErrorType, 
+    isEOFErrorType,
+    isIllegalOperationErrorType, 
+    isPermissionErrorType,
+    isUserErrorType, 
+
+    -- * Throwing and catching I\/O errors
+
+    ioError,
+
+    catchIOError,
+    tryIOError,
+
+    modifyIOError,
+  ) where
+
+import Control.Exception.Base
+
+import Data.Either
+import Data.Maybe
+
+import GHC.Base
+import GHC.IO
+import GHC.IO.Exception
+import GHC.IO.Handle.Types
+import Text.Show
+
+-- | The construct 'tryIOError' @comp@ exposes IO errors which occur within a
+-- computation, and which are not fully handled.
+--
+-- Non-I\/O exceptions are not caught by this variant; to catch all
+-- exceptions, use 'Control.Exception.try' from "Control.Exception".
+--
+-- /Since: 4.4.0.0/
+tryIOError     :: IO a -> IO (Either IOError a)
+tryIOError f   =  catch (do r <- f
+                            return (Right r))
+                        (return . Left)
+
+-- -----------------------------------------------------------------------------
+-- Constructing an IOError
+
+-- | Construct an 'IOError' of the given type where the second argument
+-- describes the error location and the third and fourth argument
+-- contain the file handle and file path of the file involved in the
+-- error if applicable.
+mkIOError :: IOErrorType -> String -> Maybe Handle -> Maybe FilePath -> IOError
+mkIOError t location maybe_hdl maybe_filename =
+               IOError{ ioe_type = t, 
+                        ioe_location = location,
+                        ioe_description = "",
+                        ioe_errno = Nothing,
+                        ioe_handle = maybe_hdl, 
+                        ioe_filename = maybe_filename
+                        }
+
+-- -----------------------------------------------------------------------------
+-- IOErrorType
+
+-- | An error indicating that an 'IO' operation failed because
+-- one of its arguments already exists.
+isAlreadyExistsError :: IOError -> Bool
+isAlreadyExistsError = isAlreadyExistsErrorType    . ioeGetErrorType
+
+-- | An error indicating that an 'IO' operation failed because
+-- one of its arguments does not exist.
+isDoesNotExistError :: IOError -> Bool
+isDoesNotExistError  = isDoesNotExistErrorType     . ioeGetErrorType
+
+-- | An error indicating that an 'IO' operation failed because
+-- one of its arguments is a single-use resource, which is already
+-- being used (for example, opening the same file twice for writing
+-- might give this error).
+isAlreadyInUseError :: IOError -> Bool
+isAlreadyInUseError  = isAlreadyInUseErrorType     . ioeGetErrorType
+
+-- | An error indicating that an 'IO' operation failed because
+-- the device is full.
+isFullError         :: IOError -> Bool
+isFullError          = isFullErrorType             . ioeGetErrorType
+
+-- | An error indicating that an 'IO' operation failed because
+-- the end of file has been reached.
+isEOFError          :: IOError -> Bool
+isEOFError           = isEOFErrorType              . ioeGetErrorType
+
+-- | An error indicating that an 'IO' operation failed because
+-- the operation was not possible.
+-- Any computation which returns an 'IO' result may fail with
+-- 'isIllegalOperation'.  In some cases, an implementation will not be
+-- able to distinguish between the possible error causes.  In this case
+-- it should fail with 'isIllegalOperation'.
+isIllegalOperation  :: IOError -> Bool
+isIllegalOperation   = isIllegalOperationErrorType . ioeGetErrorType
+
+-- | An error indicating that an 'IO' operation failed because
+-- the user does not have sufficient operating system privilege
+-- to perform that operation.
+isPermissionError   :: IOError -> Bool
+isPermissionError    = isPermissionErrorType       . ioeGetErrorType
+
+-- | A programmer-defined error value constructed using 'userError'.
+isUserError         :: IOError -> Bool
+isUserError          = isUserErrorType             . ioeGetErrorType
+
+-- -----------------------------------------------------------------------------
+-- IOErrorTypes
+
+-- | I\/O error where the operation failed because one of its arguments
+-- already exists.
+alreadyExistsErrorType   :: IOErrorType
+alreadyExistsErrorType    = AlreadyExists
+
+-- | I\/O error where the operation failed because one of its arguments
+-- does not exist.
+doesNotExistErrorType    :: IOErrorType
+doesNotExistErrorType     = NoSuchThing
+
+-- | I\/O error where the operation failed because one of its arguments
+-- is a single-use resource, which is already being used.
+alreadyInUseErrorType    :: IOErrorType
+alreadyInUseErrorType     = ResourceBusy
+
+-- | I\/O error where the operation failed because the device is full.
+fullErrorType            :: IOErrorType
+fullErrorType             = ResourceExhausted
+
+-- | I\/O error where the operation failed because the end of file has
+-- been reached.
+eofErrorType             :: IOErrorType
+eofErrorType              = EOF
+
+-- | I\/O error where the operation is not possible.
+illegalOperationErrorType :: IOErrorType
+illegalOperationErrorType = IllegalOperation
+
+-- | I\/O error where the operation failed because the user does not
+-- have sufficient operating system privilege to perform that operation.
+permissionErrorType      :: IOErrorType
+permissionErrorType       = PermissionDenied
+
+-- | I\/O error that is programmer-defined.
+userErrorType            :: IOErrorType
+userErrorType             = UserError
+
+-- -----------------------------------------------------------------------------
+-- IOErrorType predicates
+
+-- | I\/O error where the operation failed because one of its arguments
+-- already exists.
+isAlreadyExistsErrorType :: IOErrorType -> Bool
+isAlreadyExistsErrorType AlreadyExists = True
+isAlreadyExistsErrorType _ = False
+
+-- | I\/O error where the operation failed because one of its arguments
+-- does not exist.
+isDoesNotExistErrorType :: IOErrorType -> Bool
+isDoesNotExistErrorType NoSuchThing = True
+isDoesNotExistErrorType _ = False
+
+-- | I\/O error where the operation failed because one of its arguments
+-- is a single-use resource, which is already being used.
+isAlreadyInUseErrorType :: IOErrorType -> Bool
+isAlreadyInUseErrorType ResourceBusy = True
+isAlreadyInUseErrorType _ = False
+
+-- | I\/O error where the operation failed because the device is full.
+isFullErrorType :: IOErrorType -> Bool
+isFullErrorType ResourceExhausted = True
+isFullErrorType _ = False
+
+-- | I\/O error where the operation failed because the end of file has
+-- been reached.
+isEOFErrorType :: IOErrorType -> Bool
+isEOFErrorType EOF = True
+isEOFErrorType _ = False
+
+-- | I\/O error where the operation is not possible.
+isIllegalOperationErrorType :: IOErrorType -> Bool
+isIllegalOperationErrorType IllegalOperation = True
+isIllegalOperationErrorType _ = False
+
+-- | I\/O error where the operation failed because the user does not
+-- have sufficient operating system privilege to perform that operation.
+isPermissionErrorType :: IOErrorType -> Bool
+isPermissionErrorType PermissionDenied = True
+isPermissionErrorType _ = False
+
+-- | I\/O error that is programmer-defined.
+isUserErrorType :: IOErrorType -> Bool
+isUserErrorType UserError = True
+isUserErrorType _ = False
+
+-- -----------------------------------------------------------------------------
+-- Miscellaneous
+
+ioeGetErrorType       :: IOError -> IOErrorType
+ioeGetErrorString     :: IOError -> String
+ioeGetLocation        :: IOError -> String
+ioeGetHandle          :: IOError -> Maybe Handle
+ioeGetFileName        :: IOError -> Maybe FilePath
+
+ioeGetErrorType ioe = ioe_type ioe
+
+ioeGetErrorString ioe
+   | isUserErrorType (ioe_type ioe) = ioe_description ioe
+   | otherwise                      = show (ioe_type ioe)
+
+ioeGetLocation ioe = ioe_location ioe
+
+ioeGetHandle ioe = ioe_handle ioe
+
+ioeGetFileName ioe = ioe_filename ioe
+
+ioeSetErrorType   :: IOError -> IOErrorType -> IOError
+ioeSetErrorString :: IOError -> String      -> IOError
+ioeSetLocation    :: IOError -> String      -> IOError
+ioeSetHandle      :: IOError -> Handle      -> IOError
+ioeSetFileName    :: IOError -> FilePath    -> IOError
+
+ioeSetErrorType   ioe errtype  = ioe{ ioe_type = errtype }
+ioeSetErrorString ioe str      = ioe{ ioe_description = str }
+ioeSetLocation    ioe str      = ioe{ ioe_location = str }
+ioeSetHandle      ioe hdl      = ioe{ ioe_handle = Just hdl }
+ioeSetFileName    ioe filename = ioe{ ioe_filename = Just filename }
+
+-- | Catch any 'IOError' that occurs in the computation and throw a
+-- modified version.
+modifyIOError :: (IOError -> IOError) -> IO a -> IO a
+modifyIOError f io = catch io (\e -> ioError (f e))
+
+-- -----------------------------------------------------------------------------
+-- annotating an IOError
+
+-- | Adds a location description and maybe a file path and file handle
+-- to an 'IOError'.  If any of the file handle or file path is not given
+-- the corresponding value in the 'IOError' remains unaltered.
+annotateIOError :: IOError 
+              -> String 
+              -> Maybe Handle 
+              -> Maybe FilePath 
+              -> IOError 
+annotateIOError ioe loc hdl path = 
+  ioe{ ioe_handle = hdl `mplus` ioe_handle ioe,
+       ioe_location = loc, ioe_filename = path `mplus` ioe_filename ioe }
+  where
+    mplus :: Maybe a -> Maybe a -> Maybe a
+    Nothing `mplus` ys = ys
+    xs      `mplus` _  = xs
+
+-- | The 'catchIOError' function establishes a handler that receives any
+-- 'IOError' raised in the action protected by 'catchIOError'.
+-- An 'IOError' is caught by
+-- the most recent handler established by one of the exception handling
+-- functions.  These handlers are
+-- not selective: all 'IOError's are caught.  Exception propagation
+-- must be explicitly provided in a handler by re-raising any unwanted
+-- exceptions.  For example, in
+--
+-- > f = catchIOError g (\e -> if IO.isEOFError e then return [] else ioError e)
+--
+-- the function @f@ returns @[]@ when an end-of-file exception
+-- (cf. 'System.IO.Error.isEOFError') occurs in @g@; otherwise, the
+-- exception is propagated to the next outer handler.
+--
+-- When an exception propagates outside the main program, the Haskell
+-- system prints the associated 'IOError' value and exits the program.
+--
+-- Non-I\/O exceptions are not caught by this variant; to catch all
+-- exceptions, use 'Control.Exception.catch' from "Control.Exception".
+--
+-- /Since: 4.4.0.0/
+catchIOError :: IO a -> (IOError -> IO a) -> IO a
+catchIOError = catch
diff --git a/libraries/base/System/IO/Unsafe.hs b/libraries/base/System/IO/Unsafe.hs
new file mode 100644
index 000000000000..91ce45c62bb6
--- /dev/null
+++ b/libraries/base/System/IO/Unsafe.hs
@@ -0,0 +1,50 @@
+{-# LANGUAGE Unsafe #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  System.IO.Unsafe
+-- Copyright   :  (c) The University of Glasgow 2001
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+-- 
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  provisional
+-- Portability :  portable
+--
+-- \"Unsafe\" IO operations.
+--
+-----------------------------------------------------------------------------
+
+module System.IO.Unsafe (
+   -- * Unsafe 'System.IO.IO' operations
+   unsafePerformIO,
+   unsafeDupablePerformIO,
+   unsafeInterleaveIO,
+   unsafeFixIO,
+  ) where
+
+import GHC.Base
+import GHC.IO
+import GHC.IORef
+import GHC.Exception
+import Control.Exception
+
+-- | A slightly faster version of `System.IO.fixIO` that may not be
+-- safe to use with multiple threads.  The unsafety arises when used
+-- like this:
+--
+-- >  unsafeFixIO $ \r -> do
+-- >     forkIO (print r)
+-- >     return (...)
+--
+-- In this case, the child thread will receive a @NonTermination@
+-- exception instead of waiting for the value of @r@ to be computed.
+--
+-- /Since: 4.5.0.0/
+unsafeFixIO :: (a -> IO a) -> IO a
+unsafeFixIO k = do
+  ref <- newIORef (throw NonTermination)
+  ans <- unsafeDupableInterleaveIO (readIORef ref)
+  result <- k ans
+  writeIORef ref result
+  return result
diff --git a/libraries/base/System/Info.hs b/libraries/base/System/Info.hs
new file mode 100644
index 000000000000..1d251bc37c46
--- /dev/null
+++ b/libraries/base/System/Info.hs
@@ -0,0 +1,52 @@
+{-# LANGUAGE Safe #-}
+{-# LANGUAGE CPP #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  System.Info
+-- Copyright   :  (c) The University of Glasgow 2001
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+-- 
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  experimental
+-- Portability :  portable
+--
+-- Information about the characteristics of the host 
+-- system lucky enough to run your program.
+--
+-----------------------------------------------------------------------------
+
+module System.Info
+   (
+       os,
+       arch,
+       compilerName,
+       compilerVersion
+   ) where
+
+import Prelude
+import Data.Version
+
+-- | The version of 'compilerName' with which the program was compiled
+-- or is being interpreted.
+compilerVersion :: Version
+compilerVersion = Version {versionBranch=[major, minor], versionTags=[]}
+  where (major, minor) = compilerVersionRaw `divMod` 100
+
+#include "ghcplatform.h"
+
+-- | The operating system on which the program is running.
+os :: String
+os = HOST_OS
+
+-- | The machine architecture on which the program is running.
+arch :: String
+arch = HOST_ARCH
+
+-- | The Haskell implementation with which the program was compiled
+-- or is being interpreted.
+compilerName :: String
+compilerName = "ghc"
+
+compilerVersionRaw :: Int
+compilerVersionRaw = __GLASGOW_HASKELL__
diff --git a/libraries/base/System/Mem.hs b/libraries/base/System/Mem.hs
new file mode 100644
index 000000000000..3674dcb2243b
--- /dev/null
+++ b/libraries/base/System/Mem.hs
@@ -0,0 +1,36 @@
+{-# LANGUAGE Safe #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  System.Mem
+-- Copyright   :  (c) The University of Glasgow 2001
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+-- 
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  provisional
+-- Portability :  portable
+--
+-- Memory-related system things.
+--
+-----------------------------------------------------------------------------
+
+module System.Mem
+       ( performGC
+       , performMajorGC
+       , performMinorGC
+       ) where
+import Prelude
+
+-- | Triggers an immediate garbage collection.
+performGC :: IO ()
+performGC = performMajorGC
+
+-- | Triggers an immediate garbage collection.
+--
+-- /Since: 4.7.0.0/
+foreign import ccall "performMajorGC" performMajorGC :: IO ()
+
+-- | Triggers an immediate minor garbage collection.
+--
+-- /Since: 4.7.0.0/
+foreign import ccall "performGC" performMinorGC :: IO ()
diff --git a/libraries/base/System/Mem/StableName.hs b/libraries/base/System/Mem/StableName.hs
new file mode 100644
index 000000000000..4f2cab81f8bf
--- /dev/null
+++ b/libraries/base/System/Mem/StableName.hs
@@ -0,0 +1,128 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE AutoDeriveTypeable, StandaloneDeriving #-}
+{-# LANGUAGE MagicHash #-}
+#if !defined(__PARALLEL_HASKELL__)
+{-# LANGUAGE UnboxedTuples #-}
+#endif
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  System.Mem.StableName
+-- Copyright   :  (c) The University of Glasgow 2001
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+-- 
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  experimental
+-- Portability :  non-portable
+--
+-- Stable names are a way of performing fast (O(1)), not-quite-exact
+-- comparison between objects.
+-- 
+-- Stable names solve the following problem: suppose you want to build
+-- a hash table with Haskell objects as keys, but you want to use
+-- pointer equality for comparison; maybe because the keys are large
+-- and hashing would be slow, or perhaps because the keys are infinite
+-- in size.  We can\'t build a hash table using the address of the
+-- object as the key, because objects get moved around by the garbage
+-- collector, meaning a re-hash would be necessary after every garbage
+-- collection.
+--
+-------------------------------------------------------------------------------
+
+module System.Mem.StableName (
+  -- * Stable Names
+  StableName,
+  makeStableName,
+  hashStableName,
+  eqStableName
+  ) where
+
+import Prelude
+
+import Data.Typeable
+
+import GHC.IO           ( IO(..) )
+import GHC.Base		( Int(..), StableName#, makeStableName#
+			, eqStableName#, stableNameToInt# )
+
+-----------------------------------------------------------------------------
+-- Stable Names
+
+{-|
+  An abstract name for an object, that supports equality and hashing.
+
+  Stable names have the following property:
+
+  * If @sn1 :: StableName@ and @sn2 :: StableName@ and @sn1 == sn2@
+   then @sn1@ and @sn2@ were created by calls to @makeStableName@ on 
+   the same object.
+
+  The reverse is not necessarily true: if two stable names are not
+  equal, then the objects they name may still be equal.  Note in particular
+  that `mkStableName` may return a different `StableName` after an
+  object is evaluated.
+
+  Stable Names are similar to Stable Pointers ("Foreign.StablePtr"),
+  but differ in the following ways:
+
+  * There is no @freeStableName@ operation, unlike "Foreign.StablePtr"s.
+    Stable names are reclaimed by the runtime system when they are no
+    longer needed.
+
+  * There is no @deRefStableName@ operation.  You can\'t get back from
+    a stable name to the original Haskell object.  The reason for
+    this is that the existence of a stable name for an object does not
+    guarantee the existence of the object itself; it can still be garbage
+    collected.
+-}
+
+data StableName a = StableName (StableName# a)
+                    deriving Typeable
+
+-- | Makes a 'StableName' for an arbitrary object.  The object passed as
+-- the first argument is not evaluated by 'makeStableName'.
+makeStableName  :: a -> IO (StableName a)
+#if defined(__PARALLEL_HASKELL__)
+makeStableName a = 
+  error "makeStableName not implemented in parallel Haskell"
+#else
+makeStableName a = IO $ \ s ->
+    case makeStableName# a s of (# s', sn #) -> (# s', StableName sn #)
+#endif
+
+-- | Convert a 'StableName' to an 'Int'.  The 'Int' returned is not
+-- necessarily unique; several 'StableName's may map to the same 'Int'
+-- (in practice however, the chances of this are small, so the result
+-- of 'hashStableName' makes a good hash key).
+hashStableName :: StableName a -> Int
+#if defined(__PARALLEL_HASKELL__)
+hashStableName (StableName sn) = 
+  error "hashStableName not implemented in parallel Haskell"
+#else
+hashStableName (StableName sn) = I# (stableNameToInt# sn)
+#endif
+
+instance Eq (StableName a) where 
+#if defined(__PARALLEL_HASKELL__)
+    (StableName sn1) == (StableName sn2) = 
+      error "eqStableName not implemented in parallel Haskell"
+#else
+    (StableName sn1) == (StableName sn2) = 
+       case eqStableName# sn1 sn2 of
+	 0# -> False
+	 _  -> True
+#endif
+
+-- | Equality on 'StableName' that does not require that the types of
+-- the arguments match.
+--
+-- /Since: 4.7.0.0/
+eqStableName :: StableName a -> StableName b -> Bool
+eqStableName (StableName sn1) (StableName sn2) =
+       case eqStableName# sn1 sn2 of
+	 0# -> False
+	 _  -> True
+  -- Requested by Emil Axelsson on glasgow-haskell-users, who wants to
+  -- use it for implementing observable sharing.
+
diff --git a/libraries/base/System/Mem/Weak.hs b/libraries/base/System/Mem/Weak.hs
new file mode 100644
index 000000000000..fc69019e6515
--- /dev/null
+++ b/libraries/base/System/Mem/Weak.hs
@@ -0,0 +1,142 @@
+{-# LANGUAGE Trustworthy #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  System.Mem.Weak
+-- Copyright   :  (c) The University of Glasgow 2001
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+-- 
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  experimental
+-- Portability :  non-portable
+--
+-- In general terms, a weak pointer is a reference to an object that is
+-- not followed by the garbage collector - that is, the existence of a
+-- weak pointer to an object has no effect on the lifetime of that
+-- object.  A weak pointer can be de-referenced to find out
+-- whether the object it refers to is still alive or not, and if so
+-- to return the object itself.
+-- 
+-- Weak pointers are particularly useful for caches and memo tables.
+-- To build a memo table, you build a data structure 
+-- mapping from the function argument (the key) to its result (the
+-- value).  When you apply the function to a new argument you first
+-- check whether the key\/value pair is already in the memo table.
+-- The key point is that the memo table itself should not keep the
+-- key and value alive.  So the table should contain a weak pointer
+-- to the key, not an ordinary pointer.  The pointer to the value must
+-- not be weak, because the only reference to the value might indeed be
+-- from the memo table.   
+-- 
+-- So it looks as if the memo table will keep all its values
+-- alive for ever.  One way to solve this is to purge the table
+-- occasionally, by deleting entries whose keys have died.
+-- 
+-- The weak pointers in this library
+-- support another approach, called /finalization/.
+-- When the key referred to by a weak pointer dies, the storage manager
+-- arranges to run a programmer-specified finalizer.  In the case of memo
+-- tables, for example, the finalizer could remove the key\/value pair
+-- from the memo table.  
+-- 
+-- Another difficulty with the memo table is that the value of a
+-- key\/value pair might itself contain a pointer to the key.
+-- So the memo table keeps the value alive, which keeps the key alive,
+-- even though there may be no other references to the key so both should
+-- die.  The weak pointers in this library provide a slight 
+-- generalisation of the basic weak-pointer idea, in which each
+-- weak pointer actually contains both a key and a value.
+--
+-----------------------------------------------------------------------------
+
+module System.Mem.Weak (
+	-- * The @Weak@ type
+	Weak,	    		-- abstract
+
+	-- * The general interface
+	mkWeak,
+	deRefWeak,
+	finalize,
+
+	-- * Specialised versions
+	mkWeakPtr,
+	addFinalizer,
+	mkWeakPair,
+	-- replaceFinaliser
+
+	-- * A precise semantics
+	
+	-- $precise
+   ) where
+
+import GHC.Weak
+
+-- | A specialised version of 'mkWeak', where the key and the value are
+-- the same object:
+--
+-- > mkWeakPtr key finalizer = mkWeak key key finalizer
+--
+mkWeakPtr :: k -> Maybe (IO ()) -> IO (Weak k)
+mkWeakPtr key finalizer = mkWeak key key finalizer
+
+{-|
+  A specialised version of 'mkWeakPtr', where the 'Weak' object
+  returned is simply thrown away (however the finalizer will be
+  remembered by the garbage collector, and will still be run
+  when the key becomes unreachable).
+
+  Note: adding a finalizer to a 'Foreign.ForeignPtr.ForeignPtr' using
+  'addFinalizer' won't work; use the specialised version
+  'Foreign.ForeignPtr.addForeignPtrFinalizer' instead.  For discussion
+  see the 'Weak' type.
+.
+-}
+addFinalizer :: key -> IO () -> IO ()
+addFinalizer key finalizer = do
+   _ <- mkWeakPtr key (Just finalizer) -- throw it away
+   return ()
+
+-- | A specialised version of 'mkWeak' where the value is actually a pair
+-- of the key and value passed to 'mkWeakPair':
+--
+-- > mkWeakPair key val finalizer = mkWeak key (key,val) finalizer
+--
+-- The advantage of this is that the key can be retrieved by 'deRefWeak'
+-- in addition to the value.
+mkWeakPair :: k -> v -> Maybe (IO ()) -> IO (Weak (k,v))
+mkWeakPair key val finalizer = mkWeak key (key,val) finalizer
+
+
+{- $precise
+
+The above informal specification is fine for simple situations, but
+matters can get complicated.  In particular, it needs to be clear
+exactly when a key dies, so that any weak pointers that refer to it
+can be finalized.  Suppose, for example, the value of one weak pointer
+refers to the key of another...does that keep the key alive?
+
+The behaviour is simply this:
+
+ *  If a weak pointer (object) refers to an /unreachable/
+    key, it may be finalized.
+
+ *  Finalization means (a) arrange that subsequent calls
+    to 'deRefWeak' return 'Nothing'; and (b) run the finalizer.
+
+This behaviour depends on what it means for a key to be reachable.
+Informally, something is reachable if it can be reached by following
+ordinary pointers from the root set, but not following weak pointers.
+We define reachability more precisely as follows.
+
+A heap object is /reachable/ if:
+
+ * It is a member of the /root set/.
+
+ * It is directly pointed to by a reachable object, other than
+   a weak pointer object.
+
+ * It is a weak pointer object whose key is reachable.
+
+ * It is the value or finalizer of a weak pointer object whose key is reachable.
+-}
+
diff --git a/libraries/base/System/Posix/Internals.hs b/libraries/base/System/Posix/Internals.hs
new file mode 100644
index 000000000000..89ef6f47a7e9
--- /dev/null
+++ b/libraries/base/System/Posix/Internals.hs
@@ -0,0 +1,568 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE CPP, NoImplicitPrelude, CApiFFI #-}
+{-# OPTIONS_HADDOCK hide #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  System.Posix.Internals
+-- Copyright   :  (c) The University of Glasgow, 1992-2002
+-- License     :  see libraries/base/LICENSE
+-- 
+-- Maintainer  :  cvs-ghc@haskell.org
+-- Stability   :  internal
+-- Portability :  non-portable (requires POSIX)
+--
+-- POSIX support layer for the standard libraries.
+-- This library is built on *every* platform, including Win32.
+--
+-- Non-posix compliant in order to support the following features:
+--      * S_ISSOCK (no sockets in POSIX)
+--
+-----------------------------------------------------------------------------
+
+module System.Posix.Internals where
+
+#include "HsBaseConfig.h"
+
+#if ! (defined(mingw32_HOST_OS) || defined(__MINGW32__))
+import Control.Monad
+#endif
+import System.Posix.Types
+
+import Foreign
+import Foreign.C
+
+-- import Data.Bits
+import Data.Maybe
+
+#if !defined(HTYPE_TCFLAG_T)
+import System.IO.Error
+#endif
+
+import GHC.Base
+import GHC.Num
+import GHC.Real
+import GHC.IO
+import GHC.IO.IOMode
+import GHC.IO.Exception
+import GHC.IO.Device
+#ifndef mingw32_HOST_OS
+import {-# SOURCE #-} GHC.IO.Encoding (getFileSystemEncoding)
+import qualified GHC.Foreign as GHC
+#endif
+
+-- ---------------------------------------------------------------------------
+-- Debugging the base package
+
+puts :: String -> IO ()
+puts s = withCAStringLen (s ++ "\n") $ \(p, len) -> do
+            -- In reality should be withCString, but assume ASCII to avoid loop
+            -- if this is called by GHC.Foreign
+           _ <- c_write 1 (castPtr p) (fromIntegral len)
+           return ()
+
+
+-- ---------------------------------------------------------------------------
+-- Types
+
+type CFLock     = ()
+type CGroup     = ()
+type CLconv     = ()
+type CPasswd    = ()
+type CSigaction = ()
+data {-# CTYPE "sigset_t" #-} CSigset
+type CStat      = ()
+type CTermios   = ()
+type CTm        = ()
+type CTms       = ()
+type CUtimbuf   = ()
+type CUtsname   = ()
+
+type FD = CInt
+
+-- ---------------------------------------------------------------------------
+-- stat()-related stuff
+
+fdFileSize :: FD -> IO Integer
+fdFileSize fd = 
+  allocaBytes sizeof_stat $ \ p_stat -> do
+    throwErrnoIfMinus1Retry_ "fileSize" $
+        c_fstat fd p_stat
+    c_mode <- st_mode p_stat :: IO CMode 
+    if not (s_isreg c_mode)
+        then return (-1)
+        else do
+      c_size <- st_size p_stat
+      return (fromIntegral c_size)
+
+fileType :: FilePath -> IO IODeviceType
+fileType file =
+  allocaBytes sizeof_stat $ \ p_stat -> do
+  withFilePath file $ \p_file -> do
+    throwErrnoIfMinus1Retry_ "fileType" $
+      c_stat p_file p_stat
+    statGetType p_stat
+
+-- NOTE: On Win32 platforms, this will only work with file descriptors
+-- referring to file handles. i.e., it'll fail for socket FDs.
+fdStat :: FD -> IO (IODeviceType, CDev, CIno)
+fdStat fd = 
+  allocaBytes sizeof_stat $ \ p_stat -> do
+    throwErrnoIfMinus1Retry_ "fdType" $
+        c_fstat fd p_stat
+    ty <- statGetType p_stat
+    dev <- st_dev p_stat
+    ino <- st_ino p_stat
+    return (ty,dev,ino)
+    
+fdType :: FD -> IO IODeviceType
+fdType fd = do (ty,_,_) <- fdStat fd; return ty
+
+statGetType :: Ptr CStat -> IO IODeviceType
+statGetType p_stat = do
+  c_mode <- st_mode p_stat :: IO CMode
+  case () of
+      _ | s_isdir c_mode        -> return Directory
+        | s_isfifo c_mode || s_issock c_mode || s_ischr  c_mode
+                                -> return Stream
+        | s_isreg c_mode        -> return RegularFile
+         -- Q: map char devices to RawDevice too?
+        | s_isblk c_mode        -> return RawDevice
+        | otherwise             -> ioError ioe_unknownfiletype
+    
+ioe_unknownfiletype :: IOException
+ioe_unknownfiletype = IOError Nothing UnsupportedOperation "fdType"
+                        "unknown file type"
+                        Nothing
+                        Nothing
+
+fdGetMode :: FD -> IO IOMode
+#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
+fdGetMode _ = do
+    -- We don't have a way of finding out which flags are set on FDs
+    -- on Windows, so make a handle that thinks that anything goes.
+    let flags = o_RDWR
+#else
+fdGetMode fd = do
+    flags <- throwErrnoIfMinus1Retry "fdGetMode" 
+                (c_fcntl_read fd const_f_getfl)
+#endif
+    let
+       wH  = (flags .&. o_WRONLY) /= 0
+       aH  = (flags .&. o_APPEND) /= 0
+       rwH = (flags .&. o_RDWR) /= 0
+
+       mode
+         | wH && aH  = AppendMode
+         | wH        = WriteMode
+         | rwH       = ReadWriteMode
+         | otherwise = ReadMode
+          
+    return mode
+
+#ifdef mingw32_HOST_OS
+withFilePath :: FilePath -> (CWString -> IO a) -> IO a
+withFilePath = withCWString
+
+newFilePath :: FilePath -> IO CWString
+newFilePath = newCWString
+
+peekFilePath :: CWString -> IO FilePath
+peekFilePath = peekCWString
+#else
+
+withFilePath :: FilePath -> (CString -> IO a) -> IO a
+newFilePath :: FilePath -> IO CString
+peekFilePath :: CString -> IO FilePath
+peekFilePathLen :: CStringLen -> IO FilePath
+
+withFilePath fp f = getFileSystemEncoding >>= \enc -> GHC.withCString enc fp f
+newFilePath fp = getFileSystemEncoding >>= \enc -> GHC.newCString enc fp
+peekFilePath fp = getFileSystemEncoding >>= \enc -> GHC.peekCString enc fp
+peekFilePathLen fp = getFileSystemEncoding >>= \enc -> GHC.peekCStringLen enc fp
+
+#endif
+
+-- ---------------------------------------------------------------------------
+-- Terminal-related stuff
+
+#if defined(HTYPE_TCFLAG_T)
+
+setEcho :: FD -> Bool -> IO ()
+setEcho fd on = do
+  tcSetAttr fd $ \ p_tios -> do
+    lflag <- c_lflag p_tios :: IO CTcflag
+    let new_lflag
+         | on        = lflag .|. fromIntegral const_echo
+         | otherwise = lflag .&. complement (fromIntegral const_echo)
+    poke_c_lflag p_tios (new_lflag :: CTcflag)
+
+getEcho :: FD -> IO Bool
+getEcho fd = do
+  tcSetAttr fd $ \ p_tios -> do
+    lflag <- c_lflag p_tios :: IO CTcflag
+    return ((lflag .&. fromIntegral const_echo) /= 0)
+
+setCooked :: FD -> Bool -> IO ()
+setCooked fd cooked = 
+  tcSetAttr fd $ \ p_tios -> do
+
+    -- turn on/off ICANON
+    lflag <- c_lflag p_tios :: IO CTcflag
+    let new_lflag | cooked    = lflag .|. (fromIntegral const_icanon)
+                  | otherwise = lflag .&. complement (fromIntegral const_icanon)
+    poke_c_lflag p_tios (new_lflag :: CTcflag)
+
+    -- set VMIN & VTIME to 1/0 respectively
+    when (not cooked) $ do
+            c_cc <- ptr_c_cc p_tios
+            let vmin  = (c_cc `plusPtr` (fromIntegral const_vmin))  :: Ptr Word8
+                vtime = (c_cc `plusPtr` (fromIntegral const_vtime)) :: Ptr Word8
+            poke vmin  1
+            poke vtime 0
+
+tcSetAttr :: FD -> (Ptr CTermios -> IO a) -> IO a
+tcSetAttr fd fun = do
+     allocaBytes sizeof_termios  $ \p_tios -> do
+        throwErrnoIfMinus1Retry_ "tcSetAttr"
+           (c_tcgetattr fd p_tios)
+
+        -- Save a copy of termios, if this is a standard file descriptor.
+        -- These terminal settings are restored in hs_exit().
+        when (fd <= 2) $ do
+          p <- get_saved_termios fd
+          when (p == nullPtr) $ do
+             saved_tios <- mallocBytes sizeof_termios
+             copyBytes saved_tios p_tios sizeof_termios
+             set_saved_termios fd saved_tios
+
+        -- tcsetattr() when invoked by a background process causes the process
+        -- to be sent SIGTTOU regardless of whether the process has TOSTOP set
+        -- in its terminal flags (try it...).  This function provides a
+        -- wrapper which temporarily blocks SIGTTOU around the call, making it
+        -- transparent.
+        allocaBytes sizeof_sigset_t $ \ p_sigset -> do
+          allocaBytes sizeof_sigset_t $ \ p_old_sigset -> do
+             throwErrnoIfMinus1_ "sigemptyset" $
+                 c_sigemptyset p_sigset
+             throwErrnoIfMinus1_ "sigaddset" $
+                 c_sigaddset   p_sigset const_sigttou
+             throwErrnoIfMinus1_ "sigprocmask" $
+                 c_sigprocmask const_sig_block p_sigset p_old_sigset
+             r <- fun p_tios  -- do the business
+             throwErrnoIfMinus1Retry_ "tcSetAttr" $
+                 c_tcsetattr fd const_tcsanow p_tios
+             throwErrnoIfMinus1_ "sigprocmask" $
+                 c_sigprocmask const_sig_setmask p_old_sigset nullPtr
+             return r
+
+foreign import ccall unsafe "HsBase.h __hscore_get_saved_termios"
+   get_saved_termios :: CInt -> IO (Ptr CTermios)
+
+foreign import ccall unsafe "HsBase.h __hscore_set_saved_termios"
+   set_saved_termios :: CInt -> (Ptr CTermios) -> IO ()
+
+#else
+
+-- 'raw' mode for Win32 means turn off 'line input' (=> buffering and
+-- character translation for the console.) The Win32 API for doing
+-- this is GetConsoleMode(), which also requires echoing to be disabled
+-- when turning off 'line input' processing. Notice that turning off
+-- 'line input' implies enter/return is reported as '\r' (and it won't
+-- report that character until another character is input..odd.) This
+-- latter feature doesn't sit too well with IO actions like IO.hGetLine..
+-- consider yourself warned.
+setCooked :: FD -> Bool -> IO ()
+setCooked fd cooked = do
+  x <- set_console_buffering fd (if cooked then 1 else 0)
+  if (x /= 0)
+   then ioError (ioe_unk_error "setCooked" "failed to set buffering")
+   else return ()
+
+ioe_unk_error :: String -> String -> IOException
+ioe_unk_error loc msg 
+ = ioeSetErrorString (mkIOError OtherError loc Nothing Nothing) msg
+
+-- Note: echoing goes hand in hand with enabling 'line input' / raw-ness
+-- for Win32 consoles, hence setEcho ends up being the inverse of setCooked.
+setEcho :: FD -> Bool -> IO ()
+setEcho fd on = do
+  x <- set_console_echo fd (if on then 1 else 0)
+  if (x /= 0)
+   then ioError (ioe_unk_error "setEcho" "failed to set echoing")
+   else return ()
+
+getEcho :: FD -> IO Bool
+getEcho fd = do
+  r <- get_console_echo fd
+  if (r == (-1))
+   then ioError (ioe_unk_error "getEcho" "failed to get echoing")
+   else return (r == 1)
+
+foreign import ccall unsafe "consUtils.h set_console_buffering__"
+   set_console_buffering :: CInt -> CInt -> IO CInt
+
+foreign import ccall unsafe "consUtils.h set_console_echo__"
+   set_console_echo :: CInt -> CInt -> IO CInt
+
+foreign import ccall unsafe "consUtils.h get_console_echo__"
+   get_console_echo :: CInt -> IO CInt
+
+foreign import ccall unsafe "consUtils.h is_console__"
+   is_console :: CInt -> IO CInt
+
+#endif
+
+-- ---------------------------------------------------------------------------
+-- Turning on non-blocking for a file descriptor
+
+setNonBlockingFD :: FD -> Bool -> IO ()
+#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)
+setNonBlockingFD fd set = do
+  flags <- throwErrnoIfMinus1Retry "setNonBlockingFD"
+                 (c_fcntl_read fd const_f_getfl)
+  let flags' | set       = flags .|. o_NONBLOCK
+             | otherwise = flags .&. complement o_NONBLOCK
+  unless (flags == flags') $ do
+    -- An error when setting O_NONBLOCK isn't fatal: on some systems
+    -- there are certain file handles on which this will fail (eg. /dev/null
+    -- on FreeBSD) so we throw away the return code from fcntl_write.
+    _ <- c_fcntl_write fd const_f_setfl (fromIntegral flags')
+    return ()
+#else
+
+-- bogus defns for win32
+setNonBlockingFD _ _ = return ()
+
+#endif
+
+-- -----------------------------------------------------------------------------
+-- Set close-on-exec for a file descriptor
+
+#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)
+setCloseOnExec :: FD -> IO ()
+setCloseOnExec fd = do
+  throwErrnoIfMinus1_ "setCloseOnExec" $
+    c_fcntl_write fd const_f_setfd const_fd_cloexec
+#endif
+
+-- -----------------------------------------------------------------------------
+-- foreign imports
+
+#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)
+type CFilePath = CString
+#else
+type CFilePath = CWString
+#endif
+
+foreign import ccall unsafe "HsBase.h access"
+   c_access :: CString -> CInt -> IO CInt
+
+foreign import ccall unsafe "HsBase.h chmod"
+   c_chmod :: CString -> CMode -> IO CInt
+
+foreign import ccall unsafe "HsBase.h close"
+   c_close :: CInt -> IO CInt
+
+foreign import ccall unsafe "HsBase.h creat"
+   c_creat :: CString -> CMode -> IO CInt
+
+foreign import ccall unsafe "HsBase.h dup"
+   c_dup :: CInt -> IO CInt
+
+foreign import ccall unsafe "HsBase.h dup2"
+   c_dup2 :: CInt -> CInt -> IO CInt
+
+foreign import ccall unsafe "HsBase.h __hscore_fstat"
+   c_fstat :: CInt -> Ptr CStat -> IO CInt
+
+foreign import ccall unsafe "HsBase.h isatty"
+   c_isatty :: CInt -> IO CInt
+
+#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
+foreign import ccall unsafe "io.h _lseeki64"
+   c_lseek :: CInt -> Int64 -> CInt -> IO Int64
+#else
+-- We use CAPI as on some OSs (eg. Linux) this is wrapped by a macro
+-- which redirects to the 64-bit-off_t versions when large file
+-- support is enabled.
+foreign import capi unsafe "unistd.h lseek"
+   c_lseek :: CInt -> COff -> CInt -> IO COff
+#endif
+
+foreign import ccall unsafe "HsBase.h __hscore_lstat"
+   lstat :: CFilePath -> Ptr CStat -> IO CInt
+
+foreign import ccall unsafe "HsBase.h __hscore_open"
+   c_open :: CFilePath -> CInt -> CMode -> IO CInt
+
+foreign import ccall safe "HsBase.h __hscore_open"
+   c_safe_open :: CFilePath -> CInt -> CMode -> IO CInt
+
+-- See Note: CSsize
+foreign import capi unsafe "HsBase.h read"
+   c_read :: CInt -> Ptr Word8 -> CSize -> IO CSsize
+
+-- See Note: CSsize
+foreign import capi safe "HsBase.h read"
+   c_safe_read :: CInt -> Ptr Word8 -> CSize -> IO CSsize
+
+foreign import ccall unsafe "HsBase.h __hscore_stat"
+   c_stat :: CFilePath -> Ptr CStat -> IO CInt
+
+foreign import ccall unsafe "HsBase.h umask"
+   c_umask :: CMode -> IO CMode
+
+-- See Note: CSsize
+foreign import capi unsafe "HsBase.h write"
+   c_write :: CInt -> Ptr Word8 -> CSize -> IO CSsize
+
+-- See Note: CSsize
+foreign import capi safe "HsBase.h write"
+   c_safe_write :: CInt -> Ptr Word8 -> CSize -> IO CSsize
+
+foreign import ccall unsafe "HsBase.h __hscore_ftruncate"
+   c_ftruncate :: CInt -> COff -> IO CInt
+
+foreign import ccall unsafe "HsBase.h unlink"
+   c_unlink :: CString -> IO CInt
+
+foreign import ccall unsafe "HsBase.h getpid"
+   c_getpid :: IO CPid
+
+#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)
+foreign import capi unsafe "HsBase.h fcntl"
+   c_fcntl_read  :: CInt -> CInt -> IO CInt
+
+foreign import capi unsafe "HsBase.h fcntl"
+   c_fcntl_write :: CInt -> CInt -> CLong -> IO CInt
+
+foreign import capi unsafe "HsBase.h fcntl"
+   c_fcntl_lock  :: CInt -> CInt -> Ptr CFLock -> IO CInt
+
+foreign import ccall unsafe "HsBase.h fork"
+   c_fork :: IO CPid 
+
+foreign import ccall unsafe "HsBase.h link"
+   c_link :: CString -> CString -> IO CInt
+
+-- capi is required at least on Android
+foreign import capi unsafe "HsBase.h mkfifo"
+   c_mkfifo :: CString -> CMode -> IO CInt
+
+foreign import ccall unsafe "HsBase.h pipe"
+   c_pipe :: Ptr CInt -> IO CInt
+
+foreign import capi unsafe "signal.h sigemptyset"
+   c_sigemptyset :: Ptr CSigset -> IO CInt
+
+foreign import capi unsafe "signal.h sigaddset"
+   c_sigaddset :: Ptr CSigset -> CInt -> IO CInt
+
+foreign import capi unsafe "signal.h sigprocmask"
+   c_sigprocmask :: CInt -> Ptr CSigset -> Ptr CSigset -> IO CInt
+
+-- capi is required at least on Android
+foreign import capi unsafe "HsBase.h tcgetattr"
+   c_tcgetattr :: CInt -> Ptr CTermios -> IO CInt
+
+-- capi is required at least on Android
+foreign import capi unsafe "HsBase.h tcsetattr"
+   c_tcsetattr :: CInt -> CInt -> Ptr CTermios -> IO CInt
+
+foreign import capi unsafe "HsBase.h utime"
+   c_utime :: CString -> Ptr CUtimbuf -> IO CInt
+
+foreign import ccall unsafe "HsBase.h waitpid"
+   c_waitpid :: CPid -> Ptr CInt -> CInt -> IO CPid
+#endif
+
+-- POSIX flags only:
+foreign import ccall unsafe "HsBase.h __hscore_o_rdonly" o_RDONLY :: CInt
+foreign import ccall unsafe "HsBase.h __hscore_o_wronly" o_WRONLY :: CInt
+foreign import ccall unsafe "HsBase.h __hscore_o_rdwr"   o_RDWR   :: CInt
+foreign import ccall unsafe "HsBase.h __hscore_o_append" o_APPEND :: CInt
+foreign import ccall unsafe "HsBase.h __hscore_o_creat"  o_CREAT  :: CInt
+foreign import ccall unsafe "HsBase.h __hscore_o_excl"   o_EXCL   :: CInt
+foreign import ccall unsafe "HsBase.h __hscore_o_trunc"  o_TRUNC  :: CInt
+
+-- non-POSIX flags.
+foreign import ccall unsafe "HsBase.h __hscore_o_noctty"   o_NOCTTY   :: CInt
+foreign import ccall unsafe "HsBase.h __hscore_o_nonblock" o_NONBLOCK :: CInt
+foreign import ccall unsafe "HsBase.h __hscore_o_binary"   o_BINARY   :: CInt
+
+foreign import capi unsafe "sys/stat.h S_ISREG"  c_s_isreg  :: CMode -> CInt
+foreign import capi unsafe "sys/stat.h S_ISCHR"  c_s_ischr  :: CMode -> CInt
+foreign import capi unsafe "sys/stat.h S_ISBLK"  c_s_isblk  :: CMode -> CInt
+foreign import capi unsafe "sys/stat.h S_ISDIR"  c_s_isdir  :: CMode -> CInt
+foreign import capi unsafe "sys/stat.h S_ISFIFO" c_s_isfifo :: CMode -> CInt
+
+s_isreg  :: CMode -> Bool
+s_isreg cm = c_s_isreg cm /= 0
+s_ischr  :: CMode -> Bool
+s_ischr cm = c_s_ischr cm /= 0
+s_isblk  :: CMode -> Bool
+s_isblk cm = c_s_isblk cm /= 0
+s_isdir  :: CMode -> Bool
+s_isdir cm = c_s_isdir cm /= 0
+s_isfifo :: CMode -> Bool
+s_isfifo cm = c_s_isfifo cm /= 0
+
+foreign import ccall unsafe "HsBase.h __hscore_sizeof_stat" sizeof_stat :: Int
+foreign import ccall unsafe "HsBase.h __hscore_st_mtime" st_mtime :: Ptr CStat -> IO CTime
+#ifdef mingw32_HOST_OS
+foreign import ccall unsafe "HsBase.h __hscore_st_size" st_size :: Ptr CStat -> IO Int64
+#else
+foreign import ccall unsafe "HsBase.h __hscore_st_size" st_size :: Ptr CStat -> IO COff
+#endif
+foreign import ccall unsafe "HsBase.h __hscore_st_mode" st_mode :: Ptr CStat -> IO CMode
+foreign import ccall unsafe "HsBase.h __hscore_st_dev" st_dev :: Ptr CStat -> IO CDev
+foreign import ccall unsafe "HsBase.h __hscore_st_ino" st_ino :: Ptr CStat -> IO CIno
+
+foreign import ccall unsafe "HsBase.h __hscore_echo"         const_echo :: CInt
+foreign import ccall unsafe "HsBase.h __hscore_tcsanow"      const_tcsanow :: CInt
+foreign import ccall unsafe "HsBase.h __hscore_icanon"       const_icanon :: CInt
+foreign import ccall unsafe "HsBase.h __hscore_vmin"         const_vmin   :: CInt
+foreign import ccall unsafe "HsBase.h __hscore_vtime"        const_vtime  :: CInt
+foreign import ccall unsafe "HsBase.h __hscore_sigttou"      const_sigttou :: CInt
+foreign import ccall unsafe "HsBase.h __hscore_sig_block"    const_sig_block :: CInt
+foreign import ccall unsafe "HsBase.h __hscore_sig_setmask"  const_sig_setmask :: CInt
+foreign import ccall unsafe "HsBase.h __hscore_f_getfl"      const_f_getfl :: CInt
+foreign import ccall unsafe "HsBase.h __hscore_f_setfl"      const_f_setfl :: CInt
+foreign import ccall unsafe "HsBase.h __hscore_f_setfd"      const_f_setfd :: CInt
+foreign import ccall unsafe "HsBase.h __hscore_fd_cloexec"   const_fd_cloexec :: CLong
+
+#if defined(HTYPE_TCFLAG_T)
+foreign import ccall unsafe "HsBase.h __hscore_sizeof_termios"  sizeof_termios :: Int
+foreign import ccall unsafe "HsBase.h __hscore_sizeof_sigset_t" sizeof_sigset_t :: Int
+
+foreign import ccall unsafe "HsBase.h __hscore_lflag" c_lflag :: Ptr CTermios -> IO CTcflag
+foreign import ccall unsafe "HsBase.h __hscore_poke_lflag" poke_c_lflag :: Ptr CTermios -> CTcflag -> IO ()
+foreign import ccall unsafe "HsBase.h __hscore_ptr_c_cc" ptr_c_cc  :: Ptr CTermios -> IO (Ptr Word8)
+#endif
+
+s_issock :: CMode -> Bool
+#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)
+s_issock cmode = c_s_issock cmode /= 0
+foreign import capi unsafe "sys/stat.h S_ISSOCK" c_s_issock :: CMode -> CInt
+#else
+s_issock _ = False
+#endif
+
+foreign import ccall unsafe "__hscore_bufsiz"  dEFAULT_BUFFER_SIZE :: Int
+foreign import capi  unsafe "stdio.h value SEEK_CUR" sEEK_CUR :: CInt
+foreign import capi  unsafe "stdio.h value SEEK_SET" sEEK_SET :: CInt
+foreign import capi  unsafe "stdio.h value SEEK_END" sEEK_END :: CInt
+
+{-
+Note: CSsize
+
+On Win64, ssize_t is 64 bit, but functions like read return 32 bit
+ints. The CAPI wrapper means the C compiler takes care of doing all
+the necessary casting.
+
+When using ccall instead, when the functions failed with -1, we thought
+they were returning with 4294967295, and so didn't throw an exception.
+This lead to a segfault in echo001(ghci).
+-}
+
diff --git a/libraries/base/System/Posix/Types.hs b/libraries/base/System/Posix/Types.hs
new file mode 100644
index 000000000000..8b95699b27d3
--- /dev/null
+++ b/libraries/base/System/Posix/Types.hs
@@ -0,0 +1,178 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE CPP
+           , NoImplicitPrelude
+           , MagicHash
+           , GeneralizedNewtypeDeriving
+  #-}
+{-# LANGUAGE AutoDeriveTypeable, StandaloneDeriving #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  System.Posix.Types
+-- Copyright   :  (c) The University of Glasgow 2002
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+-- 
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  provisional
+-- Portability :  non-portable (requires POSIX)
+--
+-- POSIX data types: Haskell equivalents of the types defined by the
+-- @\<sys\/types.h>@ C header on a POSIX system.
+--
+-----------------------------------------------------------------------------
+#include "HsBaseConfig.h"
+
+module System.Posix.Types (
+
+  -- * POSIX data types
+#if defined(HTYPE_DEV_T)
+  CDev(..),
+#endif
+#if defined(HTYPE_INO_T)
+  CIno(..),
+#endif
+#if defined(HTYPE_MODE_T)
+  CMode(..),
+#endif
+#if defined(HTYPE_OFF_T)
+  COff(..),
+#endif
+#if defined(HTYPE_PID_T)
+  CPid(..),
+#endif
+#if defined(HTYPE_SSIZE_T)
+  CSsize(..),
+#endif
+
+#if defined(HTYPE_GID_T)
+  CGid(..),
+#endif
+#if defined(HTYPE_NLINK_T)
+  CNlink(..),
+#endif
+#if defined(HTYPE_UID_T)
+  CUid(..),
+#endif
+#if defined(HTYPE_CC_T)
+  CCc(..),
+#endif
+#if defined(HTYPE_SPEED_T)
+  CSpeed(..),
+#endif
+#if defined(HTYPE_TCFLAG_T)
+  CTcflag(..),
+#endif
+#if defined(HTYPE_RLIM_T)
+  CRLim(..),
+#endif
+
+  Fd(..),
+
+#if defined(HTYPE_NLINK_T)
+  LinkCount,
+#endif
+#if defined(HTYPE_UID_T)
+  UserID,
+#endif
+#if defined(HTYPE_GID_T)
+  GroupID,
+#endif
+
+  ByteCount,
+  ClockTick,
+  EpochTime,
+  FileOffset,
+  ProcessID,
+  ProcessGroupID,
+  DeviceID,
+  FileID,
+  FileMode,
+  Limit
+ ) where
+
+import Foreign
+import Foreign.C
+import Data.Typeable
+-- import Data.Bits
+
+import GHC.Base
+import GHC.Enum
+import GHC.Num
+import GHC.Real
+-- import GHC.Prim
+import GHC.Read
+import GHC.Show
+
+#include "CTypes.h"
+
+#if defined(HTYPE_DEV_T)
+INTEGRAL_TYPE(CDev,HTYPE_DEV_T)
+#endif
+#if defined(HTYPE_INO_T)
+INTEGRAL_TYPE(CIno,HTYPE_INO_T)
+#endif
+#if defined(HTYPE_MODE_T)
+INTEGRAL_TYPE_WITH_CTYPE(CMode,mode_t,HTYPE_MODE_T)
+#endif
+#if defined(HTYPE_OFF_T)
+INTEGRAL_TYPE(COff,HTYPE_OFF_T)
+#endif
+#if defined(HTYPE_PID_T)
+INTEGRAL_TYPE(CPid,HTYPE_PID_T)
+#endif
+
+#if defined(HTYPE_SSIZE_T)
+INTEGRAL_TYPE(CSsize,HTYPE_SSIZE_T)
+#endif
+
+#if defined(HTYPE_GID_T)
+INTEGRAL_TYPE(CGid,HTYPE_GID_T)
+#endif
+#if defined(HTYPE_NLINK_T)
+INTEGRAL_TYPE(CNlink,HTYPE_NLINK_T)
+#endif
+
+#if defined(HTYPE_UID_T)
+INTEGRAL_TYPE(CUid,HTYPE_UID_T)
+#endif
+#if defined(HTYPE_CC_T)
+ARITHMETIC_TYPE(CCc,HTYPE_CC_T)
+#endif
+#if defined(HTYPE_SPEED_T)
+ARITHMETIC_TYPE(CSpeed,HTYPE_SPEED_T)
+#endif
+#if defined(HTYPE_TCFLAG_T)
+INTEGRAL_TYPE(CTcflag,HTYPE_TCFLAG_T)
+#endif
+#if defined(HTYPE_RLIM_T)
+INTEGRAL_TYPE(CRLim,HTYPE_RLIM_T)
+#endif
+
+-- ToDo: blksize_t, clockid_t, blkcnt_t, fsblkcnt_t, fsfilcnt_t, id_t, key_t
+-- suseconds_t, timer_t, useconds_t
+
+-- Make an Fd type rather than using CInt everywhere
+INTEGRAL_TYPE(Fd,CInt)
+
+-- nicer names, and backwards compatibility with POSIX library:
+#if defined(HTYPE_NLINK_T)
+type LinkCount      = CNlink
+#endif
+#if defined(HTYPE_UID_T)
+type UserID         = CUid
+#endif
+#if defined(HTYPE_GID_T)
+type GroupID        = CGid
+#endif
+
+type ByteCount      = CSize
+type ClockTick      = CClock
+type EpochTime      = CTime
+type DeviceID       = CDev
+type FileID         = CIno
+type FileMode       = CMode
+type ProcessID      = CPid
+type FileOffset     = COff
+type ProcessGroupID = CPid
+type Limit          = CLong
+
diff --git a/libraries/base/System/Timeout.hs b/libraries/base/System/Timeout.hs
new file mode 100644
index 000000000000..322a8423928b
--- /dev/null
+++ b/libraries/base/System/Timeout.hs
@@ -0,0 +1,122 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE AutoDeriveTypeable, StandaloneDeriving #-}
+
+-------------------------------------------------------------------------------
+-- |
+-- Module      :  System.Timeout
+-- Copyright   :  (c) The University of Glasgow 2007
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+--
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  experimental
+-- Portability :  non-portable
+--
+-- Attach a timeout event to arbitrary 'IO' computations.
+--
+-------------------------------------------------------------------------------
+
+module System.Timeout ( timeout ) where
+
+#ifndef mingw32_HOST_OS
+import Control.Monad
+import GHC.Event           (getSystemTimerManager,
+                            registerTimeout, unregisterTimeout)
+#endif
+
+import Control.Concurrent
+import Control.Exception   (Exception(..), handleJust, bracket,
+                            uninterruptibleMask_,
+                            asyncExceptionToException,
+                            asyncExceptionFromException)
+import Data.Typeable
+import Data.Unique         (Unique, newUnique)
+
+-- An internal type that is thrown as a dynamic exception to
+-- interrupt the running IO computation when the timeout has
+-- expired.
+
+newtype Timeout = Timeout Unique deriving (Eq, Typeable)
+
+instance Show Timeout where
+    show _ = "<<timeout>>"
+
+-- Timeout is a child of SomeAsyncException
+instance Exception Timeout where
+  toException = asyncExceptionToException
+  fromException = asyncExceptionFromException
+
+-- |Wrap an 'IO' computation to time out and return @Nothing@ in case no result
+-- is available within @n@ microseconds (@1\/10^6@ seconds). In case a result
+-- is available before the timeout expires, @Just a@ is returned. A negative
+-- timeout interval means \"wait indefinitely\". When specifying long timeouts,
+-- be careful not to exceed @maxBound :: Int@.
+--
+-- The design of this combinator was guided by the objective that @timeout n f@
+-- should behave exactly the same as @f@ as long as @f@ doesn't time out. This
+-- means that @f@ has the same 'myThreadId' it would have without the timeout
+-- wrapper. Any exceptions @f@ might throw cancel the timeout and propagate
+-- further up. It also possible for @f@ to receive exceptions thrown to it by
+-- another thread.
+--
+-- A tricky implementation detail is the question of how to abort an @IO@
+-- computation. This combinator relies on asynchronous exceptions internally.
+-- The technique works very well for computations executing inside of the
+-- Haskell runtime system, but it doesn't work at all for non-Haskell code.
+-- Foreign function calls, for example, cannot be timed out with this
+-- combinator simply because an arbitrary C function cannot receive
+-- asynchronous exceptions. When @timeout@ is used to wrap an FFI call that
+-- blocks, no timeout event can be delivered until the FFI call returns, which
+-- pretty much negates the purpose of the combinator. In practice, however,
+-- this limitation is less severe than it may sound. Standard I\/O functions
+-- like 'System.IO.hGetBuf', 'System.IO.hPutBuf', Network.Socket.accept, or
+-- 'System.IO.hWaitForInput' appear to be blocking, but they really don't
+-- because the runtime system uses scheduling mechanisms like @select(2)@ to
+-- perform asynchronous I\/O, so it is possible to interrupt standard socket
+-- I\/O or file I\/O using this combinator.
+
+timeout :: Int -> IO a -> IO (Maybe a)
+timeout n f
+    | n <  0    = fmap Just f
+    | n == 0    = return Nothing
+#ifndef mingw32_HOST_OS
+    | rtsSupportsBoundThreads = do
+        -- In the threaded RTS, we use the Timer Manager to delay the
+        -- (fairly expensive) 'forkIO' call until the timeout has expired.
+        --
+        -- An additional thread is required for the actual delivery of
+        -- the Timeout exception because killThread (or another throwTo)
+        -- is the only way to reliably interrupt a throwTo in flight.
+        pid <- myThreadId
+        ex  <- fmap Timeout newUnique
+        tm  <- getSystemTimerManager
+        -- 'lock' synchronizes the timeout handler and the main thread:
+        --  * the main thread can disable the handler by writing to 'lock';
+        --  * the handler communicates the spawned thread's id through 'lock'.
+        -- These two cases are mutually exclusive.
+        lock <- newEmptyMVar
+        let handleTimeout = do
+                v <- isEmptyMVar lock
+                when v $ void $ forkIOWithUnmask $ \unmask -> unmask $ do
+                    v2 <- tryPutMVar lock =<< myThreadId
+                    when v2 $ throwTo pid ex
+            cleanupTimeout key = uninterruptibleMask_ $ do
+                v <- tryPutMVar lock undefined
+                if v then unregisterTimeout tm key
+                     else takeMVar lock >>= killThread
+        handleJust (\e -> if e == ex then Just () else Nothing)
+                   (\_ -> return Nothing)
+                   (bracket (registerTimeout tm n handleTimeout)
+                            cleanupTimeout
+                            (\_ -> fmap Just f))
+#endif
+    | otherwise = do
+        pid <- myThreadId
+        ex  <- fmap Timeout newUnique
+        handleJust (\e -> if e == ex then Just () else Nothing)
+                   (\_ -> return Nothing)
+                   (bracket (forkIOWithUnmask $ \unmask ->
+                                 unmask $ threadDelay n >> throwTo pid ex)
+                            (uninterruptibleMask_ . killThread)
+                            (\_ -> fmap Just f))
+        -- #7719 explains why we need uninterruptibleMask_ above.
diff --git a/libraries/base/Text/ParserCombinators/ReadP.hs b/libraries/base/Text/ParserCombinators/ReadP.hs
new file mode 100644
index 000000000000..a0e6e2206249
--- /dev/null
+++ b/libraries/base/Text/ParserCombinators/ReadP.hs
@@ -0,0 +1,494 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE MagicHash #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Text.ParserCombinators.ReadP
+-- Copyright   :  (c) The University of Glasgow 2002
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+-- 
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  provisional
+-- Portability :  non-portable (local universal quantification)
+--
+-- This is a library of parser combinators, originally written by Koen Claessen.
+-- It parses all alternatives in parallel, so it never keeps hold of 
+-- the beginning of the input string, a common source of space leaks with
+-- other parsers.  The '(+++)' choice combinator is genuinely commutative;
+-- it makes no difference which branch is \"shorter\".
+
+-----------------------------------------------------------------------------
+
+module Text.ParserCombinators.ReadP
+  ( 
+  -- * The 'ReadP' type
+  ReadP,
+  
+  -- * Primitive operations
+  get,
+  look,
+  (+++),
+  (<++),
+  gather,
+  
+  -- * Other operations
+  pfail,
+  eof,
+  satisfy,
+  char,
+  string,
+  munch,
+  munch1,
+  skipSpaces,
+  choice,
+  count,
+  between,
+  option,
+  optional,
+  many,
+  many1,
+  skipMany,
+  skipMany1,
+  sepBy,
+  sepBy1,
+  endBy,
+  endBy1,
+  chainr,
+  chainl,
+  chainl1,
+  chainr1,
+  manyTill,
+  
+  -- * Running a parser
+  ReadS,
+  readP_to_S,
+  readS_to_P,
+  
+  -- * Properties
+  -- $properties
+  )
+ where
+
+import Control.Monad( MonadPlus(..), sequence, liftM2 )
+
+import {-# SOURCE #-} GHC.Unicode ( isSpace  )
+import GHC.List ( replicate, null )
+import GHC.Base
+
+infixr 5 +++, <++
+
+------------------------------------------------------------------------
+-- ReadS
+
+-- | A parser for a type @a@, represented as a function that takes a
+-- 'String' and returns a list of possible parses as @(a,'String')@ pairs.
+--
+-- Note that this kind of backtracking parser is very inefficient;
+-- reading a large structure may be quite slow (cf 'ReadP').
+type ReadS a = String -> [(a,String)]
+
+-- ---------------------------------------------------------------------------
+-- The P type
+-- is representation type -- should be kept abstract
+
+data P a
+  = Get (Char -> P a)
+  | Look (String -> P a)
+  | Fail
+  | Result a (P a)
+  | Final [(a,String)] -- invariant: list is non-empty!
+
+-- Monad, MonadPlus
+
+instance Monad P where
+  return x = Result x Fail
+
+  (Get f)      >>= k = Get (\c -> f c >>= k)
+  (Look f)     >>= k = Look (\s -> f s >>= k)
+  Fail         >>= _ = Fail
+  (Result x p) >>= k = k x `mplus` (p >>= k)
+  (Final r)    >>= k = final [ys' | (x,s) <- r, ys' <- run (k x) s]
+
+  fail _ = Fail
+
+instance MonadPlus P where
+  mzero = Fail
+
+  -- most common case: two gets are combined
+  Get f1     `mplus` Get f2     = Get (\c -> f1 c `mplus` f2 c)
+  
+  -- results are delivered as soon as possible
+  Result x p `mplus` q          = Result x (p `mplus` q)
+  p          `mplus` Result x q = Result x (p `mplus` q)
+
+  -- fail disappears
+  Fail       `mplus` p          = p
+  p          `mplus` Fail       = p
+
+  -- two finals are combined
+  -- final + look becomes one look and one final (=optimization)
+  -- final + sthg else becomes one look and one final
+  Final r    `mplus` Final t    = Final (r ++ t)
+  Final r    `mplus` Look f     = Look (\s -> Final (r ++ run (f s) s))
+  Final r    `mplus` p          = Look (\s -> Final (r ++ run p s))
+  Look f     `mplus` Final r    = Look (\s -> Final (run (f s) s ++ r))
+  p          `mplus` Final r    = Look (\s -> Final (run p s ++ r))
+
+  -- two looks are combined (=optimization)
+  -- look + sthg else floats upwards
+  Look f     `mplus` Look g     = Look (\s -> f s `mplus` g s)
+  Look f     `mplus` p          = Look (\s -> f s `mplus` p)
+  p          `mplus` Look f     = Look (\s -> p `mplus` f s)
+
+-- ---------------------------------------------------------------------------
+-- The ReadP type
+
+newtype ReadP a = R (forall b . (a -> P b) -> P b)
+
+-- Functor, Monad, MonadPlus
+
+instance Functor ReadP where
+  fmap h (R f) = R (\k -> f (k . h))
+
+instance Monad ReadP where
+  return x  = R (\k -> k x)
+  fail _    = R (\_ -> Fail)
+  R m >>= f = R (\k -> m (\a -> let R m' = f a in m' k))
+
+instance MonadPlus ReadP where
+  mzero = pfail
+  mplus = (+++)
+
+-- ---------------------------------------------------------------------------
+-- Operations over P
+
+final :: [(a,String)] -> P a
+-- Maintains invariant for Final constructor
+final [] = Fail
+final r  = Final r
+
+run :: P a -> ReadS a
+run (Get f)      (c:s) = run (f c) s
+run (Look f)     s     = run (f s) s
+run (Result x p) s     = (x,s) : run p s
+run (Final r)    _     = r
+run _            _     = []
+
+-- ---------------------------------------------------------------------------
+-- Operations over ReadP
+
+get :: ReadP Char
+-- ^ Consumes and returns the next character.
+--   Fails if there is no input left.
+get = R Get
+
+look :: ReadP String
+-- ^ Look-ahead: returns the part of the input that is left, without
+--   consuming it.
+look = R Look
+
+pfail :: ReadP a
+-- ^ Always fails.
+pfail = R (\_ -> Fail)
+
+(+++) :: ReadP a -> ReadP a -> ReadP a
+-- ^ Symmetric choice.
+R f1 +++ R f2 = R (\k -> f1 k `mplus` f2 k)
+
+(<++) :: ReadP a -> ReadP a -> ReadP a
+-- ^ Local, exclusive, left-biased choice: If left parser
+--   locally produces any result at all, then right parser is
+--   not used.
+R f0 <++ q =
+  do s <- look
+     probe (f0 return) s 0#
+ where
+  probe (Get f)        (c:s) n = probe (f c) s (n+#1#)
+  probe (Look f)       s     n = probe (f s) s n
+  probe p@(Result _ _) _     n = discard n >> R (p >>=)
+  probe (Final r)      _     _ = R (Final r >>=)
+  probe _              _     _ = q
+
+  discard 0# = return ()
+  discard n  = get >> discard (n-#1#)
+
+gather :: ReadP a -> ReadP (String, a)
+-- ^ Transforms a parser into one that does the same, but
+--   in addition returns the exact characters read.
+--   IMPORTANT NOTE: 'gather' gives a runtime error if its first argument
+--   is built using any occurrences of readS_to_P. 
+gather (R m)
+  = R (\k -> gath id (m (\a -> return (\s -> k (s,a)))))  
+ where
+  gath :: (String -> String) -> P (String -> P b) -> P b
+  gath l (Get f)      = Get (\c -> gath (l.(c:)) (f c))
+  gath _ Fail         = Fail
+  gath l (Look f)     = Look (\s -> gath l (f s))
+  gath l (Result k p) = k (l []) `mplus` gath l p
+  gath _ (Final _)    = error "do not use readS_to_P in gather!"
+
+-- ---------------------------------------------------------------------------
+-- Derived operations
+
+satisfy :: (Char -> Bool) -> ReadP Char
+-- ^ Consumes and returns the next character, if it satisfies the
+--   specified predicate.
+satisfy p = do c <- get; if p c then return c else pfail
+
+char :: Char -> ReadP Char
+-- ^ Parses and returns the specified character.
+char c = satisfy (c ==)
+
+eof :: ReadP ()
+-- ^ Succeeds iff we are at the end of input
+eof = do { s <- look 
+         ; if null s then return () 
+                     else pfail }
+
+string :: String -> ReadP String
+-- ^ Parses and returns the specified string.
+string this = do s <- look; scan this s
+ where
+  scan []     _               = do return this
+  scan (x:xs) (y:ys) | x == y = do _ <- get; scan xs ys
+  scan _      _               = do pfail
+
+munch :: (Char -> Bool) -> ReadP String
+-- ^ Parses the first zero or more characters satisfying the predicate.
+--   Always succeds, exactly once having consumed all the characters
+--   Hence NOT the same as (many (satisfy p))
+munch p =
+  do s <- look
+     scan s
+ where
+  scan (c:cs) | p c = do _ <- get; s <- scan cs; return (c:s)
+  scan _            = do return ""
+
+munch1 :: (Char -> Bool) -> ReadP String
+-- ^ Parses the first one or more characters satisfying the predicate.
+--   Fails if none, else succeeds exactly once having consumed all the characters
+--   Hence NOT the same as (many1 (satisfy p))
+munch1 p =
+  do c <- get
+     if p c then do s <- munch p; return (c:s)
+            else pfail
+
+choice :: [ReadP a] -> ReadP a
+-- ^ Combines all parsers in the specified list.
+choice []     = pfail
+choice [p]    = p
+choice (p:ps) = p +++ choice ps
+
+skipSpaces :: ReadP ()
+-- ^ Skips all whitespace.
+skipSpaces =
+  do s <- look
+     skip s
+ where
+  skip (c:s) | isSpace c = do _ <- get; skip s
+  skip _                 = do return ()
+
+count :: Int -> ReadP a -> ReadP [a]
+-- ^ @count n p@ parses @n@ occurrences of @p@ in sequence. A list of
+--   results is returned.
+count n p = sequence (replicate n p)
+
+between :: ReadP open -> ReadP close -> ReadP a -> ReadP a
+-- ^ @between open close p@ parses @open@, followed by @p@ and finally
+--   @close@. Only the value of @p@ is returned.
+between open close p = do _ <- open
+                          x <- p
+                          _ <- close
+                          return x
+
+option :: a -> ReadP a -> ReadP a
+-- ^ @option x p@ will either parse @p@ or return @x@ without consuming
+--   any input.
+option x p = p +++ return x
+
+optional :: ReadP a -> ReadP ()
+-- ^ @optional p@ optionally parses @p@ and always returns @()@.
+optional p = (p >> return ()) +++ return ()
+
+many :: ReadP a -> ReadP [a]
+-- ^ Parses zero or more occurrences of the given parser.
+many p = return [] +++ many1 p
+
+many1 :: ReadP a -> ReadP [a]
+-- ^ Parses one or more occurrences of the given parser.
+many1 p = liftM2 (:) p (many p)
+
+skipMany :: ReadP a -> ReadP ()
+-- ^ Like 'many', but discards the result.
+skipMany p = many p >> return ()
+
+skipMany1 :: ReadP a -> ReadP ()
+-- ^ Like 'many1', but discards the result.
+skipMany1 p = p >> skipMany p
+
+sepBy :: ReadP a -> ReadP sep -> ReadP [a]
+-- ^ @sepBy p sep@ parses zero or more occurrences of @p@, separated by @sep@.
+--   Returns a list of values returned by @p@.
+sepBy p sep = sepBy1 p sep +++ return []
+
+sepBy1 :: ReadP a -> ReadP sep -> ReadP [a]
+-- ^ @sepBy1 p sep@ parses one or more occurrences of @p@, separated by @sep@.
+--   Returns a list of values returned by @p@.
+sepBy1 p sep = liftM2 (:) p (many (sep >> p))
+
+endBy :: ReadP a -> ReadP sep -> ReadP [a]
+-- ^ @endBy p sep@ parses zero or more occurrences of @p@, separated and ended
+--   by @sep@.
+endBy p sep = many (do x <- p ; _ <- sep ; return x)
+
+endBy1 :: ReadP a -> ReadP sep -> ReadP [a]
+-- ^ @endBy p sep@ parses one or more occurrences of @p@, separated and ended
+--   by @sep@.
+endBy1 p sep = many1 (do x <- p ; _ <- sep ; return x)
+
+chainr :: ReadP a -> ReadP (a -> a -> a) -> a -> ReadP a
+-- ^ @chainr p op x@ parses zero or more occurrences of @p@, separated by @op@.
+--   Returns a value produced by a /right/ associative application of all
+--   functions returned by @op@. If there are no occurrences of @p@, @x@ is
+--   returned.
+chainr p op x = chainr1 p op +++ return x
+
+chainl :: ReadP a -> ReadP (a -> a -> a) -> a -> ReadP a
+-- ^ @chainl p op x@ parses zero or more occurrences of @p@, separated by @op@.
+--   Returns a value produced by a /left/ associative application of all
+--   functions returned by @op@. If there are no occurrences of @p@, @x@ is
+--   returned.
+chainl p op x = chainl1 p op +++ return x
+
+chainr1 :: ReadP a -> ReadP (a -> a -> a) -> ReadP a
+-- ^ Like 'chainr', but parses one or more occurrences of @p@.
+chainr1 p op = scan
+  where scan   = p >>= rest
+        rest x = do f <- op
+                    y <- scan
+                    return (f x y)
+                 +++ return x
+
+chainl1 :: ReadP a -> ReadP (a -> a -> a) -> ReadP a
+-- ^ Like 'chainl', but parses one or more occurrences of @p@.
+chainl1 p op = p >>= rest
+  where rest x = do f <- op
+                    y <- p
+                    rest (f x y)
+                 +++ return x
+
+manyTill :: ReadP a -> ReadP end -> ReadP [a]
+-- ^ @manyTill p end@ parses zero or more occurrences of @p@, until @end@
+--   succeeds. Returns a list of values returned by @p@.
+manyTill p end = scan
+  where scan = (end >> return []) <++ (liftM2 (:) p scan)
+
+-- ---------------------------------------------------------------------------
+-- Converting between ReadP and Read
+
+readP_to_S :: ReadP a -> ReadS a
+-- ^ Converts a parser into a Haskell ReadS-style function.
+--   This is the main way in which you can \"run\" a 'ReadP' parser:
+--   the expanded type is
+-- @ readP_to_S :: ReadP a -> String -> [(a,String)] @
+readP_to_S (R f) = run (f return)
+
+readS_to_P :: ReadS a -> ReadP a
+-- ^ Converts a Haskell ReadS-style function into a parser.
+--   Warning: This introduces local backtracking in the resulting
+--   parser, and therefore a possible inefficiency.
+readS_to_P r =
+  R (\k -> Look (\s -> final [bs'' | (a,s') <- r s, bs'' <- run (k a) s']))
+
+-- ---------------------------------------------------------------------------
+-- QuickCheck properties that hold for the combinators
+
+{- $properties
+The following are QuickCheck specifications of what the combinators do.
+These can be seen as formal specifications of the behavior of the
+combinators.
+
+We use bags to give semantics to the combinators.
+
+>  type Bag a = [a]
+
+Equality on bags does not care about the order of elements.
+
+>  (=~) :: Ord a => Bag a -> Bag a -> Bool
+>  xs =~ ys = sort xs == sort ys
+
+A special equality operator to avoid unresolved overloading
+when testing the properties.
+
+>  (=~.) :: Bag (Int,String) -> Bag (Int,String) -> Bool
+>  (=~.) = (=~)
+
+Here follow the properties:
+
+>  prop_Get_Nil =
+>    readP_to_S get [] =~ []
+>
+>  prop_Get_Cons c s =
+>    readP_to_S get (c:s) =~ [(c,s)]
+>
+>  prop_Look s =
+>    readP_to_S look s =~ [(s,s)]
+>
+>  prop_Fail s =
+>    readP_to_S pfail s =~. []
+>
+>  prop_Return x s =
+>    readP_to_S (return x) s =~. [(x,s)]
+>
+>  prop_Bind p k s =
+>    readP_to_S (p >>= k) s =~.
+>      [ ys''
+>      | (x,s') <- readP_to_S p s
+>      , ys''   <- readP_to_S (k (x::Int)) s'
+>      ]
+>
+>  prop_Plus p q s =
+>    readP_to_S (p +++ q) s =~.
+>      (readP_to_S p s ++ readP_to_S q s)
+>
+>  prop_LeftPlus p q s =
+>    readP_to_S (p <++ q) s =~.
+>      (readP_to_S p s +<+ readP_to_S q s)
+>   where
+>    [] +<+ ys = ys
+>    xs +<+ _  = xs
+>
+>  prop_Gather s =
+>    forAll readPWithoutReadS $ \p -> 
+>      readP_to_S (gather p) s =~
+>	 [ ((pre,x::Int),s')
+>	 | (x,s') <- readP_to_S p s
+>	 , let pre = take (length s - length s') s
+>	 ]
+>
+>  prop_String_Yes this s =
+>    readP_to_S (string this) (this ++ s) =~
+>      [(this,s)]
+>
+>  prop_String_Maybe this s =
+>    readP_to_S (string this) s =~
+>      [(this, drop (length this) s) | this `isPrefixOf` s]
+>
+>  prop_Munch p s =
+>    readP_to_S (munch p) s =~
+>      [(takeWhile p s, dropWhile p s)]
+>
+>  prop_Munch1 p s =
+>    readP_to_S (munch1 p) s =~
+>      [(res,s') | let (res,s') = (takeWhile p s, dropWhile p s), not (null res)]
+>
+>  prop_Choice ps s =
+>    readP_to_S (choice ps) s =~.
+>      readP_to_S (foldr (+++) pfail ps) s
+>
+>  prop_ReadS r s =
+>    readP_to_S (readS_to_P r) s =~. r s
+-}
+
diff --git a/libraries/base/Text/ParserCombinators/ReadPrec.hs b/libraries/base/Text/ParserCombinators/ReadPrec.hs
new file mode 100644
index 000000000000..235436c4d626
--- /dev/null
+++ b/libraries/base/Text/ParserCombinators/ReadPrec.hs
@@ -0,0 +1,163 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Text.ParserCombinators.ReadPrec
+-- Copyright   :  (c) The University of Glasgow 2002
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+-- 
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  provisional
+-- Portability :  non-portable (uses Text.ParserCombinators.ReadP)
+--
+-- This library defines parser combinators for precedence parsing.
+
+-----------------------------------------------------------------------------
+
+module Text.ParserCombinators.ReadPrec
+  ( 
+  ReadPrec,
+  
+  -- * Precedences
+  Prec,
+  minPrec,
+
+  -- * Precedence operations
+  lift,
+  prec,
+  step,
+  reset,
+
+  -- * Other operations
+  -- | All are based directly on their similarly-named 'ReadP' counterparts.
+  get,
+  look,
+  (+++),
+  (<++),
+  pfail,
+  choice,
+
+  -- * Converters
+  readPrec_to_P,
+  readP_to_Prec,
+  readPrec_to_S,
+  readS_to_Prec,
+  )
+ where
+
+
+import Text.ParserCombinators.ReadP
+  ( ReadP
+  , ReadS
+  , readP_to_S
+  , readS_to_P
+  )
+
+import qualified Text.ParserCombinators.ReadP as ReadP
+  ( get
+  , look
+  , (+++), (<++)
+  , pfail
+  )
+
+import Control.Monad( MonadPlus(..) )
+import GHC.Num( Num(..) )
+import GHC.Base
+
+-- ---------------------------------------------------------------------------
+-- The readPrec type
+
+newtype ReadPrec a = P (Prec -> ReadP a)
+
+-- Functor, Monad, MonadPlus
+
+instance Functor ReadPrec where
+  fmap h (P f) = P (\n -> fmap h (f n))
+
+instance Monad ReadPrec where
+  return x  = P (\_ -> return x)
+  fail s    = P (\_ -> fail s)
+  P f >>= k = P (\n -> do a <- f n; let P f' = k a in f' n)
+  
+instance MonadPlus ReadPrec where
+  mzero = pfail
+  mplus = (+++)
+
+-- precedences
+  
+type Prec = Int
+
+minPrec :: Prec
+minPrec = 0
+
+-- ---------------------------------------------------------------------------
+-- Operations over ReadPrec
+
+lift :: ReadP a -> ReadPrec a
+-- ^ Lift a precedence-insensitive 'ReadP' to a 'ReadPrec'.
+lift m = P (\_ -> m)
+
+step :: ReadPrec a -> ReadPrec a
+-- ^ Increases the precedence context by one.
+step (P f) = P (\n -> f (n+1))
+
+reset :: ReadPrec a -> ReadPrec a
+-- ^ Resets the precedence context to zero.
+reset (P f) = P (\_ -> f minPrec)
+
+prec :: Prec -> ReadPrec a -> ReadPrec a
+-- ^ @(prec n p)@ checks whether the precedence context is 
+--   less than or equal to @n@, and
+--
+--   * if not, fails
+--
+--   * if so, parses @p@ in context @n@.
+prec n (P f) = P (\c -> if c <= n then f n else ReadP.pfail)
+
+-- ---------------------------------------------------------------------------
+-- Derived operations
+
+get :: ReadPrec Char
+-- ^ Consumes and returns the next character.
+--   Fails if there is no input left.
+get = lift ReadP.get
+
+look :: ReadPrec String
+-- ^ Look-ahead: returns the part of the input that is left, without
+--   consuming it.
+look = lift ReadP.look
+
+(+++) :: ReadPrec a -> ReadPrec a -> ReadPrec a
+-- ^ Symmetric choice.
+P f1 +++ P f2 = P (\n -> f1 n ReadP.+++ f2 n)
+
+(<++) :: ReadPrec a -> ReadPrec a -> ReadPrec a
+-- ^ Local, exclusive, left-biased choice: If left parser
+--   locally produces any result at all, then right parser is
+--   not used.
+P f1 <++ P f2 = P (\n -> f1 n ReadP.<++ f2 n)
+
+pfail :: ReadPrec a
+-- ^ Always fails.
+pfail = lift ReadP.pfail
+
+choice :: [ReadPrec a] -> ReadPrec a
+-- ^ Combines all parsers in the specified list.
+choice ps = foldr (+++) pfail ps
+
+-- ---------------------------------------------------------------------------
+-- Converting between ReadPrec and Read
+
+readPrec_to_P :: ReadPrec a -> (Int -> ReadP a)
+readPrec_to_P (P f) = f
+
+readP_to_Prec :: (Int -> ReadP a) -> ReadPrec a
+readP_to_Prec f = P f
+
+readPrec_to_S :: ReadPrec a -> (Int -> ReadS a)
+readPrec_to_S (P f) n = readP_to_S (f n)
+
+readS_to_Prec :: (Int -> ReadS a) -> ReadPrec a
+readS_to_Prec f = P (\n -> readS_to_P (f n))
+
diff --git a/libraries/base/Text/Printf.hs b/libraries/base/Text/Printf.hs
new file mode 100644
index 000000000000..ec68edb64b04
--- /dev/null
+++ b/libraries/base/Text/Printf.hs
@@ -0,0 +1,914 @@
+{-# LANGUAGE Safe #-}
+{-# LANGUAGE CPP #-}
+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >=  700
+{-# LANGUAGE GADTs #-}
+#endif
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Text.Printf
+-- Copyright   :  (c) Lennart Augustsson and Bart Massey 2013
+-- License     :  BSD-style (see the file LICENSE in this distribution)
+--
+-- Maintainer  :  Bart Massey <bart@cs.pdx.edu>
+-- Stability   :  provisional
+-- Portability :  portable
+--
+-- A C @printf(3)@-like formatter. This version has been
+-- extended by Bart Massey as per the recommendations of
+-- John Meacham and Simon Marlow
+-- \<<http://comments.gmane.org/gmane.comp.lang.haskell.libraries/4726>\>
+-- to support extensible formatting for new datatypes.  It
+-- has also been extended to support almost all C
+-- @printf(3)@ syntax.
+-----------------------------------------------------------------------------
+
+module Text.Printf(
+-- * Printing Functions
+   printf, hPrintf,
+-- * Extending To New Types
+--
+-- | This 'printf' can be extended to format types
+-- other than those provided for by default. This
+-- is done by instancing 'PrintfArg' and providing
+-- a 'formatArg' for the type. It is possible to
+-- provide a 'parseFormat' to process type-specific
+-- modifiers, but the default instance is usually
+-- the best choice.
+--
+-- For example:
+--
+-- > instance PrintfArg () where
+-- >   formatArg x fmt | fmtChar (vFmt 'U' fmt) == 'U' =
+-- >     formatString "()" (fmt { fmtChar = 's', fmtPrecision = Nothing })
+-- >   formatArg _ fmt = errorBadFormat $ fmtChar fmt
+-- >
+-- > main :: IO ()
+-- > main = printf "[%-3.1U]\n" ()
+--
+-- prints \"@[() ]@\". Note the use of 'formatString' to
+-- take care of field formatting specifications in a convenient
+-- way.
+   PrintfArg(..),
+   FieldFormatter,
+   FieldFormat(..),
+   FormatAdjustment(..), FormatSign(..),
+   vFmt,
+-- ** Handling Type-specific Modifiers
+--
+-- | In the unlikely case that modifier characters of
+-- some kind are desirable for a user-provided type,
+-- a 'ModifierParser' can be provided to process these
+-- characters. The resulting modifiers will appear in
+-- the 'FieldFormat' for use by the type-specific formatter.
+   ModifierParser, FormatParse(..),
+-- ** Standard Formatters
+--
+-- | These formatters for standard types are provided for
+-- convenience in writting new type-specific formatters:
+-- a common pattern is to throw to 'formatString' or
+-- 'formatInteger' to do most of the format handling for
+-- a new type.
+   formatString, formatChar, formatInt,
+   formatInteger, formatRealFloat,
+-- ** Raising Errors
+--
+-- | These functions are used internally to raise various
+-- errors, and are exported for use by new type-specific
+-- formatters.
+  errorBadFormat, errorShortFormat, errorMissingArgument,
+  errorBadArgument,
+  perror,
+-- * Implementation Internals
+-- | These types are needed for implementing processing
+-- variable numbers of arguments to 'printf' and 'hPrintf'.
+-- Their implementation is intentionally not visible from
+-- this module. If you attempt to pass an argument of a type
+-- which is not an instance of the appropriate class to
+-- 'printf' or 'hPrintf', then the compiler will report it
+-- as a missing instance of 'PrintfArg'.  (All 'PrintfArg'
+-- instances are 'PrintfType' instances.)
+  PrintfType, HPrintfType,
+-- | This class is needed as a Haskell98 compatibility
+-- workaround for the lack of FlexibleInstances.
+  IsChar(..)
+) where
+
+import Prelude
+import Data.Char
+import Data.Int
+import Data.List
+import Data.Word
+import Numeric
+import System.IO
+
+-------------------
+
+-- | Format a variable number of arguments with the C-style formatting string.
+-- The return value is either 'String' or @('IO' a)@ (which
+-- should be @('IO' '()')@, but Haskell's type system
+-- makes this hard).
+--
+-- The format string consists of ordinary characters and
+-- /conversion specifications/, which specify how to format
+-- one of the arguments to 'printf' in the output string. A
+-- format specification is introduced by the @%@ character;
+-- this character can be self-escaped into the format string
+-- using @%%@. A format specification ends with a /format
+-- character/ that provides the primary information about
+-- how to format the value. The rest of the conversion
+-- specification is optional.  In order, one may have flag
+-- characters, a width specifier, a precision specifier, and
+-- type-specific modifier characters.
+--
+-- Unlike C @printf(3)@, the formatting of this 'printf'
+-- is driven by the argument type; formatting is type specific. The
+-- types formatted by 'printf' \"out of the box\" are:
+--
+--   * 'Integral' types, including 'Char'
+--
+--   * 'String'
+--
+--   * 'RealFloat' types
+--
+-- 'printf' is also extensible to support other types: see below.
+--
+-- A conversion specification begins with the
+-- character @%@, followed by zero or more of the following flags:
+--
+-- >    -      left adjust (default is right adjust)
+-- >    +      always use a sign (+ or -) for signed conversions
+-- >    space  leading space for positive numbers in signed conversions
+-- >    0      pad with zeros rather than spaces
+-- >    #      use an \"alternate form\": see below
+--
+-- When both flags are given, @-@ overrides @0@ and @+@ overrides space.
+-- A negative width specifier in a @*@ conversion is treated as
+-- positive but implies the left adjust flag.
+--
+-- The \"alternate form\" for unsigned radix conversions is
+-- as in C @printf(3)@:
+--
+-- >    %o           prefix with a leading 0 if needed
+-- >    %x           prefix with a leading 0x if nonzero
+-- >    %X           prefix with a leading 0X if nonzero
+-- >    %b           prefix with a leading 0b if nonzero
+-- >    %[eEfFgG]    ensure that the number contains a decimal point
+--
+-- Any flags are followed optionally by a field width:
+--
+-- >    num    field width
+-- >    *      as num, but taken from argument list
+--
+-- The field width is a minimum, not a maximum: it will be
+-- expanded as needed to avoid mutilating a value.
+--
+-- Any field width is followed optionally by a precision:
+--
+-- >    .num   precision
+-- >    .      same as .0
+-- >    .*     as num, but taken from argument list
+--
+-- Negative precision is taken as 0. The meaning of the
+-- precision depends on the conversion type.
+--
+-- >    Integral    minimum number of digits to show
+-- >    RealFloat   number of digits after the decimal point
+-- >    String      maximum number of characters
+--
+-- The precision for Integral types is accomplished by zero-padding.
+-- If both precision and zero-pad are given for an Integral field,
+-- the zero-pad is ignored.
+--
+-- Any precision is followed optionally for Integral types
+-- by a width modifier; the only use of this modifier being
+-- to set the implicit size of the operand for conversion of
+-- a negative operand to unsigned:
+--
+-- >    hh     Int8
+-- >    h      Int16
+-- >    l      Int32
+-- >    ll     Int64
+-- >    L      Int64
+--
+-- The specification ends with a format character:
+--
+-- >    c      character               Integral
+-- >    d      decimal                 Integral
+-- >    o      octal                   Integral
+-- >    x      hexadecimal             Integral
+-- >    X      hexadecimal             Integral
+-- >    b      binary                  Integral
+-- >    u      unsigned decimal        Integral
+-- >    f      floating point          RealFloat
+-- >    F      floating point          RealFloat
+-- >    g      general format float    RealFloat
+-- >    G      general format float    RealFloat
+-- >    e      exponent format float   RealFloat
+-- >    E      exponent format float   RealFloat
+-- >    s      string                  String
+-- >    v      default format          any type
+--
+-- The \"%v\" specifier is provided for all built-in types,
+-- and should be provided for user-defined type formatters
+-- as well. It picks a \"best\" representation for the given
+-- type. For the built-in types the \"%v\" specifier is
+-- converted as follows:
+--
+-- >    c      Char
+-- >    u      other unsigned Integral
+-- >    d      other signed Integral
+-- >    g      RealFloat
+-- >    s      String
+--
+-- Mismatch between the argument types and the format
+-- string, as well as any other syntactic or semantic errors
+-- in the format string, will cause an exception to be
+-- thrown at runtime.
+--
+-- Note that the formatting for 'RealFloat' types is
+-- currently a bit different from that of C @printf(3)@,
+-- conforming instead to 'Numeric.showEFloat',
+-- 'Numeric.showFFloat' and 'Numeric.showGFloat' (and their
+-- alternate versions 'Numeric.showFFloatAlt' and
+-- 'Numeric.showGFloatAlt'). This is hard to fix: the fixed
+-- versions would format in a backward-incompatible way.
+-- In any case the Haskell behavior is generally more
+-- sensible than the C behavior.  A brief summary of some
+-- key differences:
+--
+-- * Haskell 'printf' never uses the default \"6-digit\" precision
+--   used by C printf.
+--
+-- * Haskell 'printf' treats the \"precision\" specifier as
+--   indicating the number of digits after the decimal point.
+--
+-- * Haskell 'printf' prints the exponent of e-format
+--   numbers without a gratuitous plus sign, and with the
+--   minimum possible number of digits.
+--
+-- * Haskell 'printf' will place a zero after a decimal point when
+--   possible.
+--
+-- Examples:
+--
+-- >   > printf "%d\n" (23::Int)
+-- >   23
+-- >   > printf "%s %s\n" "Hello" "World"
+-- >   Hello World
+-- >   > printf "%.2f\n" pi
+-- >   3.14
+--
+printf :: (PrintfType r) => String -> r
+printf fmts = spr fmts []
+
+-- | Similar to 'printf', except that output is via the specified
+-- 'Handle'.  The return type is restricted to @('IO' a)@.
+hPrintf :: (HPrintfType r) => Handle -> String -> r
+hPrintf hdl fmts = hspr hdl fmts []
+
+-- |The 'PrintfType' class provides the variable argument magic for
+-- 'printf'.  Its implementation is intentionally not visible from
+-- this module. If you attempt to pass an argument of a type which
+-- is not an instance of this class to 'printf' or 'hPrintf', then
+-- the compiler will report it as a missing instance of 'PrintfArg'.
+class PrintfType t where
+    spr :: String -> [UPrintf] -> t
+
+-- | The 'HPrintfType' class provides the variable argument magic for
+-- 'hPrintf'.  Its implementation is intentionally not visible from
+-- this module.
+class HPrintfType t where
+    hspr :: Handle -> String -> [UPrintf] -> t
+
+{- not allowed in Haskell 2010
+instance PrintfType String where
+    spr fmt args = uprintf fmt (reverse args)
+-}
+instance (IsChar c) => PrintfType [c] where
+    spr fmts args = map fromChar (uprintf fmts (reverse args))
+
+-- Note that this should really be (IO ()), but GHC's
+-- type system won't readily let us say that without
+-- bringing the GADTs. So we go conditional for these defs.
+
+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >=  700
+
+instance (a ~ ()) => PrintfType (IO a) where
+    spr fmts args =
+        putStr $ map fromChar $ uprintf fmts $ reverse args
+
+instance (a ~ ()) => HPrintfType (IO a) where
+    hspr hdl fmts args = do
+        hPutStr hdl (uprintf fmts (reverse args))
+
+#else
+
+instance PrintfType (IO a) where
+    spr fmts args = do
+        putStr $ map fromChar $ uprintf fmts $ reverse args
+        return (error "PrintfType (IO a): result should not be used.")
+
+instance HPrintfType (IO a) where
+    hspr hdl fmts args = do
+        hPutStr hdl (uprintf fmts (reverse args))
+        return (error "HPrintfType (IO a): result should not be used.")
+
+#endif
+
+
+instance (PrintfArg a, PrintfType r) => PrintfType (a -> r) where
+    spr fmts args = \ a -> spr fmts
+                             ((parseFormat a, formatArg a) : args)
+
+instance (PrintfArg a, HPrintfType r) => HPrintfType (a -> r) where
+    hspr hdl fmts args = \ a -> hspr hdl fmts
+                                  ((parseFormat a, formatArg a) : args)
+
+-- | Typeclass of 'printf'-formattable values. The 'formatArg' method
+-- takes a value and a field format descriptor and either fails due
+-- to a bad descriptor or produces a 'ShowS' as the result. The
+-- default 'parseFormat' expects no modifiers: this is the normal
+-- case. Minimal instance: 'formatArg'.
+class PrintfArg a where
+    -- | /Since: 4.7.0.0/
+    formatArg :: a -> FieldFormatter
+    -- | /Since: 4.7.0.0/
+    parseFormat :: a -> ModifierParser
+    parseFormat _ (c : cs) = FormatParse "" c cs
+    parseFormat _ "" = errorShortFormat
+
+instance PrintfArg Char where
+    formatArg = formatChar
+    parseFormat _ cf = parseIntFormat (undefined :: Int) cf
+
+instance (IsChar c) => PrintfArg [c] where
+    formatArg = formatString
+
+instance PrintfArg Int where
+    formatArg = formatInt
+    parseFormat = parseIntFormat
+
+instance PrintfArg Int8 where
+    formatArg = formatInt
+    parseFormat = parseIntFormat
+
+instance PrintfArg Int16 where
+    formatArg = formatInt
+    parseFormat = parseIntFormat
+
+instance PrintfArg Int32 where
+    formatArg = formatInt
+    parseFormat = parseIntFormat
+
+instance PrintfArg Int64 where
+    formatArg = formatInt
+    parseFormat = parseIntFormat
+
+instance PrintfArg Word where
+    formatArg = formatInt
+    parseFormat = parseIntFormat
+
+instance PrintfArg Word8 where
+    formatArg = formatInt
+    parseFormat = parseIntFormat
+
+instance PrintfArg Word16 where
+    formatArg = formatInt
+    parseFormat = parseIntFormat
+
+instance PrintfArg Word32 where
+    formatArg = formatInt
+    parseFormat = parseIntFormat
+
+instance PrintfArg Word64 where
+    formatArg = formatInt
+    parseFormat = parseIntFormat
+
+instance PrintfArg Integer where
+    formatArg = formatInteger
+    parseFormat = parseIntFormat
+
+instance PrintfArg Float where
+    formatArg = formatRealFloat
+
+instance PrintfArg Double where
+    formatArg = formatRealFloat
+
+-- | This class, with only the one instance, is used as
+-- a workaround for the fact that 'String', as a concrete
+-- type, is not allowable as a typeclass instance. 'IsChar'
+-- is exported for backward-compatibility.
+class IsChar c where
+    -- | /Since: 4.7.0.0/
+    toChar :: c -> Char
+    -- | /Since: 4.7.0.0/
+    fromChar :: Char -> c
+
+instance IsChar Char where
+    toChar c = c
+    fromChar c = c
+
+-------------------
+
+-- | Whether to left-adjust or zero-pad a field. These are
+-- mutually exclusive, with 'LeftAdjust' taking precedence.
+--
+-- /Since: 4.7.0.0/
+data FormatAdjustment = LeftAdjust | ZeroPad
+
+-- | How to handle the sign of a numeric field.  These are
+-- mutually exclusive, with 'SignPlus' taking precedence.
+--
+-- /Since: 4.7.0.0/
+data FormatSign = SignPlus | SignSpace
+
+-- | Description of field formatting for 'formatArg'. See UNIX `printf`(3)
+-- for a description of how field formatting works.
+--
+-- /Since: 4.7.0.0/
+data FieldFormat = FieldFormat {
+  fmtWidth :: Maybe Int,       -- ^ Total width of the field.
+  fmtPrecision :: Maybe Int,   -- ^ Secondary field width specifier.
+  fmtAdjust :: Maybe FormatAdjustment,  -- ^ Kind of filling or padding
+                                        --   to be done.
+  fmtSign :: Maybe FormatSign, -- ^ Whether to insist on a
+                               -- plus sign for positive
+                               -- numbers.
+  fmtAlternate :: Bool,        -- ^ Indicates an "alternate
+                               -- format".  See printf(3)
+                               -- for the details, which
+                               -- vary by argument spec.
+  fmtModifiers :: String,      -- ^ Characters that appeared
+                               -- immediately to the left of
+                               -- 'fmtChar' in the format
+                               -- and were accepted by the
+                               -- type's 'parseFormat'.
+                               -- Normally the empty string.
+  fmtChar :: Char              -- ^ The format character
+                               -- 'printf' was invoked
+                               -- with. 'formatArg' should
+                               -- fail unless this character
+                               -- matches the type. It is
+                               -- normal to handle many
+                               -- different format
+                               -- characters for a single
+                               -- type.
+  }
+
+-- | The \"format parser\" walks over argument-type-specific
+-- modifier characters to find the primary format character.
+-- This is the type of its result.
+--
+-- /Since: 4.7.0.0/
+data FormatParse = FormatParse {
+  fpModifiers :: String,   -- ^ Any modifiers found.
+  fpChar :: Char,          -- ^ Primary format character.
+  fpRest :: String         -- ^ Rest of the format string.
+  }
+
+-- Contains the "modifier letters" that can precede an
+-- integer type.
+intModifierMap :: [(String, Integer)]
+intModifierMap = [
+  ("hh", toInteger (minBound :: Int8)),
+  ("h", toInteger (minBound :: Int16)),
+  ("l", toInteger (minBound :: Int32)),
+  ("ll", toInteger (minBound :: Int64)),
+  ("L", toInteger (minBound :: Int64)) ]
+
+parseIntFormat :: Integral a => a -> String -> FormatParse
+parseIntFormat _ s =
+  case foldr matchPrefix Nothing intModifierMap of
+    Just m -> m
+    Nothing ->
+      case s of
+        c : cs -> FormatParse "" c cs
+        "" -> errorShortFormat
+  where
+    matchPrefix (p, _) m@(Just (FormatParse p0 _ _))
+      | length p0 >= length p = m
+      | otherwise = case getFormat p of
+          Nothing -> m
+          Just fp -> Just fp
+    matchPrefix (p, _) Nothing =
+      getFormat p
+    getFormat p =
+      stripPrefix p s >>= fp
+      where
+        fp (c : cs) = Just $ FormatParse p c cs
+        fp "" = errorShortFormat
+
+-- | This is the type of a field formatter reified over its
+-- argument.
+--
+-- /Since: 4.7.0.0/
+type FieldFormatter = FieldFormat -> ShowS
+
+-- | Type of a function that will parse modifier characters
+-- from the format string.
+--
+-- /Since: 4.7.0.0/
+type ModifierParser = String -> FormatParse
+
+-- | Substitute a \'v\' format character with the given
+-- default format character in the 'FieldFormat'. A
+-- convenience for user-implemented types, which should
+-- support \"%v\".
+--
+-- /Since: 4.7.0.0/
+vFmt :: Char -> FieldFormat -> FieldFormat
+vFmt c ufmt@(FieldFormat {fmtChar = 'v'}) = ufmt {fmtChar = c}
+vFmt _ ufmt = ufmt
+
+-- | Formatter for 'Char' values.
+--
+-- /Since: 4.7.0.0/
+formatChar :: Char -> FieldFormatter
+formatChar x ufmt =
+  formatIntegral (Just 0) (toInteger $ ord x) $ vFmt 'c' ufmt
+
+-- | Formatter for 'String' values.
+--
+-- /Since: 4.7.0.0/
+formatString :: IsChar a => [a] -> FieldFormatter
+formatString x ufmt =
+  case fmtChar $ vFmt 's' ufmt of
+    's' -> map toChar . (adjust ufmt ("", ts) ++)
+           where
+             ts = map toChar $ trunc $ fmtPrecision ufmt
+               where
+                 trunc Nothing = x
+                 trunc (Just n) = take n x
+    c   -> errorBadFormat c
+
+-- Possibly apply the int modifiers to get a new
+-- int width for conversion.
+fixupMods :: FieldFormat -> Maybe Integer -> Maybe Integer
+fixupMods ufmt m =
+  let mods = fmtModifiers ufmt in
+  case mods of
+    "" -> m
+    _ -> case lookup mods intModifierMap of
+      Just m0 -> Just m0
+      Nothing -> perror "unknown format modifier"
+
+-- | Formatter for 'Int' values.
+--
+-- /Since: 4.7.0.0/
+formatInt :: (Integral a, Bounded a) => a -> FieldFormatter
+formatInt x ufmt =
+  let lb = toInteger $ minBound `asTypeOf` x
+      m = fixupMods ufmt (Just lb)
+      ufmt' = case lb of
+        0 -> vFmt 'u' ufmt
+        _ -> ufmt
+  in
+  formatIntegral m (toInteger x) ufmt'
+
+-- | Formatter for 'Integer' values.
+--
+-- /Since: 4.7.0.0/
+formatInteger :: Integer -> FieldFormatter
+formatInteger x ufmt =
+  let m = fixupMods ufmt Nothing in
+  formatIntegral m x ufmt
+
+-- All formatting for integral types is handled
+-- consistently.  The only difference is between Integer and
+-- bounded types; this difference is handled by the 'm'
+-- argument containing the lower bound.
+formatIntegral :: Maybe Integer -> Integer -> FieldFormatter
+formatIntegral m x ufmt0 =
+  let prec = fmtPrecision ufmt0 in
+  case fmtChar ufmt of
+    'd' -> (adjustSigned ufmt (fmti prec x) ++)
+    'i' -> (adjustSigned ufmt (fmti prec x) ++)
+    'x' -> (adjust ufmt (fmtu 16 (alt "0x" x) prec m x) ++)
+    'X' -> (adjust ufmt (upcase $ fmtu 16 (alt "0X" x) prec m x) ++)
+    'b' -> (adjust ufmt (fmtu 2 (alt "0b" x) prec m x) ++)
+    'o' -> (adjust ufmt (fmtu 8 (alt "0" x) prec m x) ++)
+    'u' -> (adjust ufmt (fmtu 10 Nothing prec m x) ++)
+    'c' | x >= fromIntegral (ord (minBound :: Char)) &&
+          x <= fromIntegral (ord (maxBound :: Char)) &&
+          fmtPrecision ufmt == Nothing &&
+          fmtModifiers ufmt == "" ->
+            formatString [chr $ fromIntegral x] (ufmt { fmtChar = 's' })
+    'c' -> perror "illegal char conversion"
+    c   -> errorBadFormat c
+  where
+    ufmt = vFmt 'd' $ case ufmt0 of
+      FieldFormat { fmtPrecision = Just _, fmtAdjust = Just ZeroPad } ->
+        ufmt0 { fmtAdjust = Nothing }
+      _ -> ufmt0
+    alt _ 0 = Nothing
+    alt p _ = case fmtAlternate ufmt of
+      True -> Just p
+      False -> Nothing
+    upcase (s1, s2) = (s1, map toUpper s2)
+
+-- | Formatter for 'RealFloat' values.
+--
+-- /Since: 4.7.0.0/
+formatRealFloat :: RealFloat a => a -> FieldFormatter
+formatRealFloat x ufmt =
+  let c = fmtChar $ vFmt 'g' ufmt
+      prec = fmtPrecision ufmt
+      alt = fmtAlternate ufmt
+  in
+   case c of
+     'e' -> (adjustSigned ufmt (dfmt c prec alt x) ++)
+     'E' -> (adjustSigned ufmt (dfmt c prec alt x) ++)
+     'f' -> (adjustSigned ufmt (dfmt c prec alt x) ++)
+     'F' -> (adjustSigned ufmt (dfmt c prec alt x) ++)
+     'g' -> (adjustSigned ufmt (dfmt c prec alt x) ++)
+     'G' -> (adjustSigned ufmt (dfmt c prec alt x) ++)
+     _   -> errorBadFormat c
+
+-- This is the type carried around for arguments in
+-- the varargs code.
+type UPrintf = (ModifierParser, FieldFormatter)
+
+-- Given a format string and a list of formatting functions
+-- (the actual argument value having already been baked into
+-- each of these functions before delivery), return the
+-- actual formatted text string.
+uprintf :: String -> [UPrintf] -> String
+uprintf s us = uprintfs s us ""
+
+-- This function does the actual work, producing a ShowS
+-- instead of a string, for future expansion and for
+-- misguided efficiency.
+uprintfs :: String -> [UPrintf] -> ShowS
+uprintfs ""       []       = id
+uprintfs ""       (_:_)    = errorShortFormat
+uprintfs ('%':'%':cs) us   = ('%' :) . uprintfs cs us
+uprintfs ('%':_)  []       = errorMissingArgument
+uprintfs ('%':cs) us@(_:_) = fmt cs us
+uprintfs (c:cs)   us       = (c :) . uprintfs cs us
+
+-- Given a suffix of the format string starting just after
+-- the percent sign, and the list of remaining unprocessed
+-- arguments in the form described above, format the portion
+-- of the output described by this field description, and
+-- then continue with 'uprintfs'.
+fmt :: String -> [UPrintf] -> ShowS
+fmt cs0 us0 =
+  case getSpecs False False Nothing False cs0 us0 of
+    (_, _, []) -> errorMissingArgument
+    (ufmt, cs, (_, u) : us) -> u ufmt . uprintfs cs us
+
+-- Given field formatting information, and a tuple
+-- consisting of a prefix (for example, a minus sign) that
+-- is supposed to go before the argument value and a string
+-- representing the value, return the properly padded and
+-- formatted result.
+adjust :: FieldFormat -> (String, String) -> String
+adjust ufmt (pre, str) =
+  let naturalWidth = length pre + length str
+      zero = case fmtAdjust ufmt of
+        Just ZeroPad -> True
+        _ -> False
+      left = case fmtAdjust ufmt of
+        Just LeftAdjust -> True
+        _ -> False
+      fill = case fmtWidth ufmt of
+        Just width | naturalWidth < width ->
+          let fillchar = if zero then '0' else ' ' in
+          replicate (width - naturalWidth) fillchar
+        _ -> ""
+  in
+   if left
+   then pre ++ str ++ fill
+   else if zero
+        then pre ++ fill ++ str
+        else fill ++ pre ++ str
+
+-- For positive numbers with an explicit sign field ("+" or
+-- " "), adjust accordingly.
+adjustSigned :: FieldFormat -> (String, String) -> String
+adjustSigned ufmt@(FieldFormat {fmtSign = Just SignPlus}) ("", str) =
+  adjust ufmt ("+", str)
+adjustSigned ufmt@(FieldFormat {fmtSign = Just SignSpace}) ("", str) =
+  adjust ufmt (" ", str)
+adjustSigned ufmt ps =
+  adjust ufmt ps
+
+-- Format a signed integer in the "default" fashion.
+-- This will be subjected to adjust subsequently.
+fmti :: Maybe Int -> Integer -> (String, String)
+fmti prec i
+  | i < 0 = ("-", integral_prec prec (show (-i)))
+  | otherwise = ("", integral_prec prec (show i))
+
+-- Format an unsigned integer in the "default" fashion.
+-- This will be subjected to adjust subsequently.  The 'b'
+-- argument is the base, the 'pre' argument is the prefix,
+-- and the '(Just m)' argument is the implicit lower-bound
+-- size of the operand for conversion from signed to
+-- unsigned. Thus, this function will refuse to convert an
+-- unbounded negative integer to an unsigned string.
+fmtu :: Integer -> Maybe String -> Maybe Int -> Maybe Integer -> Integer
+     -> (String, String)
+fmtu b (Just pre) prec m i =
+  let ("", s) = fmtu b Nothing prec m i in
+  case pre of
+    "0" -> case s of
+      '0' : _ -> ("", s)
+      _ -> (pre, s)
+    _ -> (pre, s)
+fmtu b Nothing prec0 m0 i0 =
+  case fmtu' prec0 m0 i0 of
+    Just s -> ("", s)
+    Nothing -> errorBadArgument
+  where
+    fmtu' :: Maybe Int -> Maybe Integer -> Integer -> Maybe String
+    fmtu' prec (Just m) i | i < 0 =
+      fmtu' prec Nothing (-2 * m + i)
+    fmtu' (Just prec) _ i | i >= 0 =
+      fmap (integral_prec (Just prec)) $ fmtu' Nothing Nothing i
+    fmtu' Nothing _ i | i >= 0 =
+      Just $ showIntAtBase b intToDigit i ""
+    fmtu' _ _ _ = Nothing
+
+
+-- This is used by 'fmtu' and 'fmti' to zero-pad an
+-- int-string to a required precision.
+integral_prec :: Maybe Int -> String -> String
+integral_prec Nothing integral = integral
+integral_prec (Just 0) "0" = ""
+integral_prec (Just prec) integral =
+  replicate (prec - length integral) '0' ++ integral
+
+stoi :: String -> (Int, String)
+stoi cs =
+  let (as, cs') = span isDigit cs in
+  case as of
+    "" -> (0, cs')
+    _ -> (read as, cs')
+
+-- Figure out the FormatAdjustment, given:
+--   width, precision, left-adjust, zero-fill
+adjustment :: Maybe Int -> Maybe a -> Bool -> Bool
+           -> Maybe FormatAdjustment
+adjustment w p l z =
+  case w of
+    Just n | n < 0 -> adjl p True z
+    _ -> adjl p l z
+  where
+    adjl _ True _ = Just LeftAdjust
+    adjl _ False True = Just ZeroPad
+    adjl _ _ _ = Nothing
+
+-- Parse the various format controls to get a format specification.
+getSpecs :: Bool -> Bool -> Maybe FormatSign -> Bool -> String -> [UPrintf]
+         -> (FieldFormat, String, [UPrintf])
+getSpecs _ z s a ('-' : cs0) us = getSpecs True z s a cs0 us
+getSpecs l z _ a ('+' : cs0) us = getSpecs l z (Just SignPlus) a cs0 us
+getSpecs l z s a (' ' : cs0) us =
+  getSpecs l z ss a cs0 us
+  where
+    ss = case s of
+      Just SignPlus -> Just SignPlus
+      _ -> Just SignSpace
+getSpecs l _ s a ('0' : cs0) us = getSpecs l True s a cs0 us
+getSpecs l z s _ ('#' : cs0) us = getSpecs l z s True cs0 us
+getSpecs l z s a ('*' : cs0) us =
+  let (us', n) = getStar us
+      ((p, cs''), us'') = case cs0 of
+        '.':'*':r ->
+          let (us''', p') = getStar us' in ((Just p', r), us''')
+        '.':r ->
+          let (p', r') = stoi r in ((Just p', r'), us')
+        _ ->
+          ((Nothing, cs0), us')
+      FormatParse ms c cs =
+        case us'' of
+          (ufmt, _) : _ -> ufmt cs''
+          [] -> errorMissingArgument
+  in
+   (FieldFormat {
+       fmtWidth = Just (abs n),
+       fmtPrecision = p,
+       fmtAdjust = adjustment (Just n) p l z,
+       fmtSign = s,
+       fmtAlternate = a,
+       fmtModifiers = ms,
+       fmtChar = c}, cs, us'')
+getSpecs l z s a ('.' : cs0) us =
+  let ((p, cs'), us') = case cs0 of
+        '*':cs'' -> let (us'', p') = getStar us in ((p', cs''), us'')
+        _ ->        (stoi cs0, us)
+      FormatParse ms c cs =
+        case us' of
+          (ufmt, _) : _ -> ufmt cs'
+          [] -> errorMissingArgument
+  in
+   (FieldFormat {
+       fmtWidth = Nothing,
+       fmtPrecision = Just p,
+       fmtAdjust = adjustment Nothing (Just p) l z,
+       fmtSign = s,
+       fmtAlternate = a,
+       fmtModifiers = ms,
+       fmtChar = c}, cs, us')
+getSpecs l z s a cs0@(c0 : _) us | isDigit c0 =
+  let (n, cs') = stoi cs0
+      ((p, cs''), us') = case cs' of
+        '.' : '*' : r ->
+          let (us'', p') = getStar us in ((Just p', r), us'')
+        '.' : r ->
+          let (p', r') = stoi r in ((Just p', r'), us)
+        _ ->
+          ((Nothing, cs'), us)
+      FormatParse ms c cs =
+        case us' of
+          (ufmt, _) : _ -> ufmt cs''
+          [] -> errorMissingArgument
+  in
+   (FieldFormat {
+       fmtWidth = Just (abs n),
+       fmtPrecision = p,
+       fmtAdjust = adjustment (Just n) p l z,
+       fmtSign = s,
+       fmtAlternate = a,
+       fmtModifiers = ms,
+       fmtChar = c}, cs, us')
+getSpecs l z s a cs0@(_ : _) us =
+  let FormatParse ms c cs =
+        case us of
+          (ufmt, _) : _ -> ufmt cs0
+          [] -> errorMissingArgument
+  in
+   (FieldFormat {
+       fmtWidth = Nothing,
+       fmtPrecision = Nothing,
+       fmtAdjust = adjustment Nothing Nothing l z,
+       fmtSign = s,
+       fmtAlternate = a,
+       fmtModifiers = ms,
+       fmtChar = c}, cs, us)
+getSpecs _ _ _ _ ""       _  =
+  errorShortFormat
+
+-- Process a star argument in a format specification.
+getStar :: [UPrintf] -> ([UPrintf], Int)
+getStar us =
+  let ufmt = FieldFormat {
+        fmtWidth = Nothing,
+        fmtPrecision = Nothing,
+        fmtAdjust = Nothing,
+        fmtSign = Nothing,
+        fmtAlternate = False,
+        fmtModifiers = "",
+        fmtChar = 'd' } in
+  case us of
+    [] -> errorMissingArgument
+    (_, nu) : us' -> (us', read (nu ufmt ""))
+
+-- Format a RealFloat value.
+dfmt :: (RealFloat a) => Char -> Maybe Int -> Bool -> a -> (String, String)
+dfmt c p a d =
+  let caseConvert = if isUpper c then map toUpper else id
+      showFunction = case toLower c of
+        'e' -> showEFloat
+        'f' -> if a then showFFloatAlt else showFFloat
+        'g' -> if a then showGFloatAlt else showGFloat
+        _   -> perror "internal error: impossible dfmt"
+      result = caseConvert $ showFunction p d ""
+  in
+   case result of
+     '-' : cs -> ("-", cs)
+     cs       -> ("" , cs)
+
+
+-- | Raises an 'error' with a printf-specific prefix on the
+-- message string.
+--
+-- /Since: 4.7.0.0/
+perror :: String -> a
+perror s = error $ "printf: " ++ s
+
+-- | Calls 'perror' to indicate an unknown format letter for
+-- a given type.
+--
+-- /Since: 4.7.0.0/
+errorBadFormat :: Char -> a
+errorBadFormat c = perror $ "bad formatting char " ++ show c
+
+errorShortFormat, errorMissingArgument, errorBadArgument :: a
+-- | Calls 'perror' to indicate that the format string ended
+-- early.
+--
+-- /Since: 4.7.0.0/
+errorShortFormat = perror "formatting string ended prematurely"
+-- | Calls 'perror' to indicate that there is a missing
+-- argument in the argument list.
+--
+-- /Since: 4.7.0.0/
+errorMissingArgument = perror "argument list ended prematurely"
+-- | Calls 'perror' to indicate that there is a type
+-- error or similar in the given argument.
+--
+-- /Since: 4.7.0.0/
+errorBadArgument = perror "bad argument"
diff --git a/libraries/base/Text/Read.hs b/libraries/base/Text/Read.hs
new file mode 100644
index 000000000000..6c9d89db76b0
--- /dev/null
+++ b/libraries/base/Text/Read.hs
@@ -0,0 +1,91 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Text.Read
+-- Copyright   :  (c) The University of Glasgow 2001
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+-- 
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  provisional
+-- Portability :  non-portable (uses Text.ParserCombinators.ReadP)
+--
+-- Converting strings to values.
+--
+-- The "Text.Read" library is the canonical library to import for
+-- 'Read'-class facilities.  For GHC only, it offers an extended and much
+-- improved 'Read' class, which constitutes a proposed alternative to the 
+-- Haskell 2010 'Read'.  In particular, writing parsers is easier, and
+-- the parsers are much more efficient.
+--
+-----------------------------------------------------------------------------
+
+module Text.Read (
+   -- * The 'Read' class
+   Read(..),
+   ReadS,
+
+   -- * Haskell 2010 functions
+   reads,
+   read,
+   readParen,
+   lex,
+
+   -- * New parsing functions
+   module Text.ParserCombinators.ReadPrec,
+   L.Lexeme(..),
+   lexP,
+   parens,
+   readListDefault,
+   readListPrecDefault,
+   readEither,
+   readMaybe
+
+ ) where
+
+import GHC.Base
+import GHC.Read
+import Data.Either
+import Data.Maybe
+import Text.ParserCombinators.ReadP as P
+import Text.ParserCombinators.ReadPrec
+import qualified Text.Read.Lex as L
+
+------------------------------------------------------------------------
+-- utility functions
+
+-- | equivalent to 'readsPrec' with a precedence of 0.
+reads :: Read a => ReadS a
+reads = readsPrec minPrec
+
+-- | Parse a string using the 'Read' instance.
+-- Succeeds if there is exactly one valid result.
+-- A 'Left' value indicates a parse error.
+--
+-- /Since: 4.6.0.0/
+readEither :: Read a => String -> Either String a
+readEither s =
+  case [ x | (x,"") <- readPrec_to_S read' minPrec s ] of
+    [x] -> Right x
+    []  -> Left "Prelude.read: no parse"
+    _   -> Left "Prelude.read: ambiguous parse"
+ where
+  read' =
+    do x <- readPrec
+       lift P.skipSpaces
+       return x
+
+-- | Parse a string using the 'Read' instance.
+-- Succeeds if there is exactly one valid result.
+--
+-- /Since: 4.6.0.0/
+readMaybe :: Read a => String -> Maybe a
+readMaybe s = case readEither s of
+                Left _  -> Nothing
+                Right a -> Just a
+
+-- | The 'read' function reads input from a string, which must be
+-- completely consumed by the input process.
+read :: Read a => String -> a
+read s = either error id (readEither s)
diff --git a/libraries/base/Text/Read/Lex.hs b/libraries/base/Text/Read/Lex.hs
new file mode 100644
index 000000000000..557637d8967b
--- /dev/null
+++ b/libraries/base/Text/Read/Lex.hs
@@ -0,0 +1,511 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Text.Read.Lex
+-- Copyright   :  (c) The University of Glasgow 2002
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+--
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  provisional
+-- Portability :  non-portable (uses Text.ParserCombinators.ReadP)
+--
+-- The cut-down Haskell lexer, used by Text.Read
+--
+-----------------------------------------------------------------------------
+
+module Text.Read.Lex
+  -- lexing types
+  ( Lexeme(..), Number
+
+  , numberToInteger, numberToFixed, numberToRational, numberToRangedRational
+
+  -- lexer
+  , lex, expect
+  , hsLex
+  , lexChar
+
+  , readIntP
+  , readOctP
+  , readDecP
+  , readHexP
+  )
+ where
+
+import Text.ParserCombinators.ReadP
+
+import GHC.Base
+import GHC.Char
+import GHC.Num( Num(..), Integer )
+import GHC.Show( Show(..) )
+import {-# SOURCE #-} GHC.Unicode ( isSpace, isAlpha, isAlphaNum )
+import GHC.Real( Rational, (%), fromIntegral,
+                 toInteger, (^) )
+import GHC.List
+import GHC.Enum( minBound, maxBound )
+import Data.Maybe
+import Control.Monad
+
+-- -----------------------------------------------------------------------------
+-- Lexing types
+
+-- ^ Haskell lexemes.
+data Lexeme
+  = Char   Char         -- ^ Character literal
+  | String String       -- ^ String literal, with escapes interpreted
+  | Punc   String       -- ^ Punctuation or reserved symbol, e.g. @(@, @::@
+  | Ident  String       -- ^ Haskell identifier, e.g. @foo@, @Baz@
+  | Symbol String       -- ^ Haskell symbol, e.g. @>>@, @:%@
+  | Number Number       -- ^ /Since: 4.6.0.0/
+  | EOF
+ deriving (Eq, Show)
+
+-- | /Since: 4.7.0.0/
+data Number = MkNumber Int              -- Base
+                       Digits           -- Integral part
+            | MkDecimal Digits          -- Integral part
+                        (Maybe Digits)  -- Fractional part
+                        (Maybe Integer) -- Exponent
+ deriving (Eq, Show)
+
+-- | /Since: 4.5.1.0/
+numberToInteger :: Number -> Maybe Integer
+numberToInteger (MkNumber base iPart) = Just (val (fromIntegral base) 0 iPart)
+numberToInteger (MkDecimal iPart Nothing Nothing) = Just (val 10 0 iPart)
+numberToInteger _ = Nothing
+
+-- | /Since: 4.7.0.0/
+numberToFixed :: Integer -> Number -> Maybe (Integer, Integer)
+numberToFixed _ (MkNumber base iPart) = Just (val (fromIntegral base) 0 iPart, 0)
+numberToFixed _ (MkDecimal iPart Nothing Nothing) = Just (val 10 0 iPart, 0)
+numberToFixed p (MkDecimal iPart (Just fPart) Nothing)
+    = let i = val 10 0 iPart
+          f = val 10 0 (integerTake p (fPart ++ repeat 0))
+          -- Sigh, we really want genericTake, but that's above us in
+          -- the hierarchy, so we define our own version here (actually
+          -- specialised to Integer)
+          integerTake             :: Integer -> [a] -> [a]
+          integerTake n _ | n <= 0 = []
+          integerTake _ []        =  []
+          integerTake n (x:xs)    =  x : integerTake (n-1) xs
+      in Just (i, f)
+numberToFixed _ _ = Nothing
+
+-- This takes a floatRange, and if the Rational would be outside of
+-- the floatRange then it may return Nothing. Not that it will not
+-- /necessarily/ return Nothing, but it is good enough to fix the
+-- space problems in #5688
+-- Ways this is conservative:
+-- * the floatRange is in base 2, but we pretend it is in base 10
+-- * we pad the floateRange a bit, just in case it is very small
+--   and we would otherwise hit an edge case
+-- * We only worry about numbers that have an exponent. If they don't
+--   have an exponent then the Rational won't be much larger than the
+--   Number, so there is no problem
+-- | /Since: 4.5.1.0/
+numberToRangedRational :: (Int, Int) -> Number
+                       -> Maybe Rational -- Nothing = Inf
+numberToRangedRational (neg, pos) n@(MkDecimal iPart mFPart (Just exp))
+    -- if exp is out of integer bounds,
+    -- then the number is definitely out of range
+    | exp > fromIntegral (maxBound :: Int) ||
+      exp < fromIntegral (minBound :: Int)
+    = Nothing
+    | otherwise
+    = let mFirstDigit = case dropWhile (0 ==) iPart of
+                        iPart'@(_ : _) -> Just (length iPart')
+                        [] -> case mFPart of
+                              Nothing -> Nothing
+                              Just fPart ->
+                                  case span (0 ==) fPart of
+                                  (_, []) -> Nothing
+                                  (zeroes, _) ->
+                                      Just (negate (length zeroes))
+      in case mFirstDigit of
+         Nothing -> Just 0
+         Just firstDigit ->
+             let firstDigit' = firstDigit + fromInteger exp
+             in if firstDigit' > (pos + 3)
+                then Nothing
+                else if firstDigit' < (neg - 3)
+                then Just 0
+                else Just (numberToRational n)
+numberToRangedRational _ n = Just (numberToRational n)
+
+-- | /Since: 4.6.0.0/
+numberToRational :: Number -> Rational
+numberToRational (MkNumber base iPart) = val (fromIntegral base) 0 iPart % 1
+numberToRational (MkDecimal iPart mFPart mExp)
+ = let i = val 10 0 iPart
+   in case (mFPart, mExp) of
+      (Nothing, Nothing)     -> i % 1
+      (Nothing, Just exp)
+       | exp >= 0            -> (i * (10 ^ exp)) % 1
+       | otherwise           -> i % (10 ^ (- exp))
+      (Just fPart, Nothing)  -> fracExp 0   i fPart
+      (Just fPart, Just exp) -> fracExp exp i fPart
+      -- fracExp is a bit more efficient in calculating the Rational.
+      -- Instead of calculating the fractional part alone, then
+      -- adding the integral part and finally multiplying with
+      -- 10 ^ exp if an exponent was given, do it all at once.
+
+-- -----------------------------------------------------------------------------
+-- Lexing
+
+lex :: ReadP Lexeme
+lex = skipSpaces >> lexToken
+
+-- | /Since: 4.7.0.0/
+expect :: Lexeme -> ReadP ()
+expect lexeme = do { skipSpaces 
+                   ; thing <- lexToken
+                   ; if thing == lexeme then return () else pfail }
+
+hsLex :: ReadP String
+-- ^ Haskell lexer: returns the lexed string, rather than the lexeme
+hsLex = do skipSpaces
+           (s,_) <- gather lexToken
+           return s
+
+lexToken :: ReadP Lexeme
+lexToken = lexEOF     +++
+           lexLitChar +++
+           lexString  +++
+           lexPunc    +++
+           lexSymbol  +++
+           lexId      +++
+           lexNumber
+
+
+-- ----------------------------------------------------------------------
+-- End of file
+lexEOF :: ReadP Lexeme
+lexEOF = do s <- look
+            guard (null s)
+            return EOF
+
+-- ---------------------------------------------------------------------------
+-- Single character lexemes
+
+lexPunc :: ReadP Lexeme
+lexPunc =
+  do c <- satisfy isPuncChar
+     return (Punc [c])
+ where
+  isPuncChar c = c `elem` ",;()[]{}`"
+
+-- ----------------------------------------------------------------------
+-- Symbols
+
+lexSymbol :: ReadP Lexeme
+lexSymbol =
+  do s <- munch1 isSymbolChar
+     if s `elem` reserved_ops then
+        return (Punc s)         -- Reserved-ops count as punctuation
+      else
+        return (Symbol s)
+ where
+  isSymbolChar c = c `elem` "!@#$%&*+./<=>?\\^|:-~"
+  reserved_ops   = ["..", "::", "=", "\\", "|", "<-", "->", "@", "~", "=>"]
+
+-- ----------------------------------------------------------------------
+-- identifiers
+
+lexId :: ReadP Lexeme
+lexId = do c <- satisfy isIdsChar
+           s <- munch isIdfChar
+           return (Ident (c:s))
+  where
+          -- Identifiers can start with a '_'
+    isIdsChar c = isAlpha c || c == '_'
+    isIdfChar c = isAlphaNum c || c `elem` "_'"
+
+-- ---------------------------------------------------------------------------
+-- Lexing character literals
+
+lexLitChar :: ReadP Lexeme
+lexLitChar =
+  do _ <- char '\''
+     (c,esc) <- lexCharE
+     guard (esc || c /= '\'')   -- Eliminate '' possibility
+     _ <- char '\''
+     return (Char c)
+
+lexChar :: ReadP Char
+lexChar = do { (c,_) <- lexCharE; return c }
+
+lexCharE :: ReadP (Char, Bool)  -- "escaped or not"?
+lexCharE =
+  do c1 <- get
+     if c1 == '\\'
+       then do c2 <- lexEsc; return (c2, True)
+       else do return (c1, False)
+ where
+  lexEsc =
+    lexEscChar
+      +++ lexNumeric
+        +++ lexCntrlChar
+          +++ lexAscii
+
+  lexEscChar =
+    do c <- get
+       case c of
+         'a'  -> return '\a'
+         'b'  -> return '\b'
+         'f'  -> return '\f'
+         'n'  -> return '\n'
+         'r'  -> return '\r'
+         't'  -> return '\t'
+         'v'  -> return '\v'
+         '\\' -> return '\\'
+         '\"' -> return '\"'
+         '\'' -> return '\''
+         _    -> pfail
+
+  lexNumeric =
+    do base <- lexBaseChar <++ return 10
+       n    <- lexInteger base
+       guard (n <= toInteger (ord maxBound))
+       return (chr (fromInteger n))
+
+  lexCntrlChar =
+    do _ <- char '^'
+       c <- get
+       case c of
+         '@'  -> return '\^@'
+         'A'  -> return '\^A'
+         'B'  -> return '\^B'
+         'C'  -> return '\^C'
+         'D'  -> return '\^D'
+         'E'  -> return '\^E'
+         'F'  -> return '\^F'
+         'G'  -> return '\^G'
+         'H'  -> return '\^H'
+         'I'  -> return '\^I'
+         'J'  -> return '\^J'
+         'K'  -> return '\^K'
+         'L'  -> return '\^L'
+         'M'  -> return '\^M'
+         'N'  -> return '\^N'
+         'O'  -> return '\^O'
+         'P'  -> return '\^P'
+         'Q'  -> return '\^Q'
+         'R'  -> return '\^R'
+         'S'  -> return '\^S'
+         'T'  -> return '\^T'
+         'U'  -> return '\^U'
+         'V'  -> return '\^V'
+         'W'  -> return '\^W'
+         'X'  -> return '\^X'
+         'Y'  -> return '\^Y'
+         'Z'  -> return '\^Z'
+         '['  -> return '\^['
+         '\\' -> return '\^\'
+         ']'  -> return '\^]'
+         '^'  -> return '\^^'
+         '_'  -> return '\^_'
+         _    -> pfail
+
+  lexAscii =
+    do choice
+         [ (string "SOH" >> return '\SOH') <++
+           (string "SO"  >> return '\SO')
+                -- \SO and \SOH need maximal-munch treatment
+                -- See the Haskell report Sect 2.6
+
+         , string "NUL" >> return '\NUL'
+         , string "STX" >> return '\STX'
+         , string "ETX" >> return '\ETX'
+         , string "EOT" >> return '\EOT'
+         , string "ENQ" >> return '\ENQ'
+         , string "ACK" >> return '\ACK'
+         , string "BEL" >> return '\BEL'
+         , string "BS"  >> return '\BS'
+         , string "HT"  >> return '\HT'
+         , string "LF"  >> return '\LF'
+         , string "VT"  >> return '\VT'
+         , string "FF"  >> return '\FF'
+         , string "CR"  >> return '\CR'
+         , string "SI"  >> return '\SI'
+         , string "DLE" >> return '\DLE'
+         , string "DC1" >> return '\DC1'
+         , string "DC2" >> return '\DC2'
+         , string "DC3" >> return '\DC3'
+         , string "DC4" >> return '\DC4'
+         , string "NAK" >> return '\NAK'
+         , string "SYN" >> return '\SYN'
+         , string "ETB" >> return '\ETB'
+         , string "CAN" >> return '\CAN'
+         , string "EM"  >> return '\EM'
+         , string "SUB" >> return '\SUB'
+         , string "ESC" >> return '\ESC'
+         , string "FS"  >> return '\FS'
+         , string "GS"  >> return '\GS'
+         , string "RS"  >> return '\RS'
+         , string "US"  >> return '\US'
+         , string "SP"  >> return '\SP'
+         , string "DEL" >> return '\DEL'
+         ]
+
+
+-- ---------------------------------------------------------------------------
+-- string literal
+
+lexString :: ReadP Lexeme
+lexString =
+  do _ <- char '"'
+     body id
+ where
+  body f =
+    do (c,esc) <- lexStrItem
+       if c /= '"' || esc
+         then body (f.(c:))
+         else let s = f "" in
+              return (String s)
+
+  lexStrItem = (lexEmpty >> lexStrItem)
+               +++ lexCharE
+
+  lexEmpty =
+    do _ <- char '\\'
+       c <- get
+       case c of
+         '&'           -> do return ()
+         _ | isSpace c -> do skipSpaces; _ <- char '\\'; return ()
+         _             -> do pfail
+
+-- ---------------------------------------------------------------------------
+--  Lexing numbers
+
+type Base   = Int
+type Digits = [Int]
+
+lexNumber :: ReadP Lexeme
+lexNumber
+  = lexHexOct  <++      -- First try for hex or octal 0x, 0o etc
+                        -- If that fails, try for a decimal number
+    lexDecNumber        -- Start with ordinary digits
+
+lexHexOct :: ReadP Lexeme
+lexHexOct
+  = do  _ <- char '0'
+        base <- lexBaseChar
+        digits <- lexDigits base
+        return (Number (MkNumber base digits))
+
+lexBaseChar :: ReadP Int
+-- Lex a single character indicating the base; fail if not there
+lexBaseChar = do { c <- get;
+                   case c of
+                        'o' -> return 8
+                        'O' -> return 8
+                        'x' -> return 16
+                        'X' -> return 16
+                        _   -> pfail }
+
+lexDecNumber :: ReadP Lexeme
+lexDecNumber =
+  do xs    <- lexDigits 10
+     mFrac <- lexFrac <++ return Nothing
+     mExp  <- lexExp  <++ return Nothing
+     return (Number (MkDecimal xs mFrac mExp))
+
+lexFrac :: ReadP (Maybe Digits)
+-- Read the fractional part; fail if it doesn't
+-- start ".d" where d is a digit
+lexFrac = do _ <- char '.'
+             fraction <- lexDigits 10
+             return (Just fraction)
+
+lexExp :: ReadP (Maybe Integer)
+lexExp = do _ <- char 'e' +++ char 'E'
+            exp <- signedExp +++ lexInteger 10
+            return (Just exp)
+ where
+   signedExp
+     = do c <- char '-' +++ char '+'
+          n <- lexInteger 10
+          return (if c == '-' then -n else n)
+
+lexDigits :: Int -> ReadP Digits
+-- Lex a non-empty sequence of digits in specified base
+lexDigits base =
+  do s  <- look
+     xs <- scan s id
+     guard (not (null xs))
+     return xs
+ where
+  scan (c:cs) f = case valDig base c of
+                    Just n  -> do _ <- get; scan cs (f.(n:))
+                    Nothing -> do return (f [])
+  scan []     f = do return (f [])
+
+lexInteger :: Base -> ReadP Integer
+lexInteger base =
+  do xs <- lexDigits base
+     return (val (fromIntegral base) 0 xs)
+
+val :: Num a => a -> a -> Digits -> a
+-- val base y [d1,..,dn] = y ++ [d1,..,dn], as it were
+val _    y []     = y
+val base y (x:xs) = y' `seq` val base y' xs
+ where
+  y' = y * base + fromIntegral x
+
+-- Calculate a Rational from the exponent [of 10 to multiply with],
+-- the integral part of the mantissa and the digits of the fractional
+-- part. Leaving the calculation of the power of 10 until the end,
+-- when we know the effective exponent, saves multiplications.
+-- More importantly, this way we need at most one gcd instead of three.
+--
+-- frac was never used with anything but Integer and base 10, so
+-- those are hardcoded now (trivial to change if necessary).
+fracExp :: Integer -> Integer -> Digits -> Rational
+fracExp exp mant []
+  | exp < 0     = mant % (10 ^ (-exp))
+  | otherwise   = fromInteger (mant * 10 ^ exp)
+fracExp exp mant (d:ds) = exp' `seq` mant' `seq` fracExp exp' mant' ds
+  where
+    exp'  = exp - 1
+    mant' = mant * 10 + fromIntegral d
+
+valDig :: (Eq a, Num a) => a -> Char -> Maybe Int
+valDig 8 c
+  | '0' <= c && c <= '7' = Just (ord c - ord '0')
+  | otherwise            = Nothing
+
+valDig 10 c = valDecDig c
+
+valDig 16 c
+  | '0' <= c && c <= '9' = Just (ord c - ord '0')
+  | 'a' <= c && c <= 'f' = Just (ord c - ord 'a' + 10)
+  | 'A' <= c && c <= 'F' = Just (ord c - ord 'A' + 10)
+  | otherwise            = Nothing
+
+valDig _ _ = error "valDig: Bad base"
+
+valDecDig :: Char -> Maybe Int
+valDecDig c
+  | '0' <= c && c <= '9' = Just (ord c - ord '0')
+  | otherwise            = Nothing
+
+-- ----------------------------------------------------------------------
+-- other numeric lexing functions
+
+readIntP :: Num a => a -> (Char -> Bool) -> (Char -> Int) -> ReadP a
+readIntP base isDigit valDigit =
+  do s <- munch1 isDigit
+     return (val base 0 (map valDigit s))
+
+readIntP' :: (Eq a, Num a) => a -> ReadP a
+readIntP' base = readIntP base isDigit valDigit
+ where
+  isDigit  c = maybe False (const True) (valDig base c)
+  valDigit c = maybe 0     id           (valDig base c)
+
+readOctP, readDecP, readHexP :: (Eq a, Num a) => ReadP a
+readOctP = readIntP' 8
+readDecP = readIntP' 10
+readHexP = readIntP' 16
+
diff --git a/libraries/base/Text/Show.hs b/libraries/base/Text/Show.hs
new file mode 100644
index 000000000000..6978a0ef6213
--- /dev/null
+++ b/libraries/base/Text/Show.hs
@@ -0,0 +1,34 @@
+{-# LANGUAGE Safe #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Text.Show
+-- Copyright   :  (c) The University of Glasgow 2001
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+-- 
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  provisional
+-- Portability :  portable
+--
+-- Converting values to readable strings:
+-- the 'Show' class and associated functions.
+--
+-----------------------------------------------------------------------------
+
+module Text.Show (
+   ShowS,
+   Show(showsPrec, show, showList),
+   shows,
+   showChar,
+   showString,
+   showParen,
+   showListWith,
+ ) where
+
+import GHC.Show
+
+-- | Show a list (using square brackets and commas), given a function
+-- for showing elements.
+showListWith :: (a -> ShowS) -> [a] -> ShowS
+showListWith = showList__
diff --git a/libraries/base/Text/Show/Functions.hs b/libraries/base/Text/Show/Functions.hs
new file mode 100644
index 000000000000..b34cbc67ce73
--- /dev/null
+++ b/libraries/base/Text/Show/Functions.hs
@@ -0,0 +1,28 @@
+{-# LANGUAGE Safe #-}
+-- This module deliberately declares orphan instances:
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Text.Show.Functions
+-- Copyright   :  (c) The University of Glasgow 2001
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+-- 
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  provisional
+-- Portability :  portable
+--
+-- Optional instance of 'Text.Show.Show' for functions:
+--
+-- > instance Show (a -> b) where
+-- > 	showsPrec _ _ = showString \"\<function\>\"
+--
+-----------------------------------------------------------------------------
+
+module Text.Show.Functions () where
+
+import Prelude
+
+instance Show (a -> b) where
+	showsPrec _ _ = showString "<function>"
+
diff --git a/libraries/base/Unsafe/Coerce.hs b/libraries/base/Unsafe/Coerce.hs
new file mode 100644
index 000000000000..684de5a20956
--- /dev/null
+++ b/libraries/base/Unsafe/Coerce.hs
@@ -0,0 +1,62 @@
+{-# LANGUAGE Unsafe #-}
+{-# LANGUAGE NoImplicitPrelude, MagicHash #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Unsafe.Coerce
+-- Copyright   :  Malcolm Wallace 2006
+-- License     :  BSD-style (see the LICENSE file in the distribution)
+--
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  experimental
+-- Portability :  portable
+--
+-- The highly unsafe primitive 'unsafeCoerce' converts a value from any
+-- type to any other type.  Needless to say, if you use this function,
+-- it is your responsibility to ensure that the old and new types have
+-- identical internal representations, in order to prevent runtime corruption.
+--
+-- The types for which 'unsafeCoerce' is representation-safe may differ
+-- from compiler to compiler (and version to version).
+--
+--   * Documentation for correct usage in GHC will be found under
+--     'unsafeCoerce#' in GHC.Base (around which 'unsafeCoerce' is just a
+--     trivial wrapper).
+--
+--   * In nhc98, the only representation-safe coercions are between Enum
+--     types with the same range (e.g. Int, Int32, Char, Word32),
+--     or between a newtype and the type that it wraps.
+--
+-----------------------------------------------------------------------------
+
+module Unsafe.Coerce (unsafeCoerce) where
+
+import GHC.Integer () -- for build ordering
+import GHC.Prim (unsafeCoerce#)
+
+local_id :: a -> a
+local_id x = x   -- See Note [Mega-hack for coerce]
+
+{- Note [Mega-hack for coerce]
+
+If we just say
+  unsafeCoerce x = unsafeCoerce# x
+then the simple-optimiser that the desugarer runs will eta-reduce to
+  unsafeCoerce :: forall (a:*) (b:*). a -> b
+  unsafeCoerce = unsafeCoerce#
+And that, sadly, is ill-typed because unsafeCoerce# has OpenKind type variables
+And rightly so, because we shouldn't be calling unsafeCoerce# in a higher
+order way; it has a compulsory unfolding 
+   unsafeCoerce# a b x = x |> UnsafeCo a b
+and we really rely on it being inlined pronto. But the simple-optimiser doesn't.
+The identity function local_id delays the eta reduction just long enough
+for unsafeCoerce# to get inlined.
+
+Sigh. This is horrible, but then so is unsafeCoerce.
+-}
+
+unsafeCoerce :: a -> b
+unsafeCoerce x = local_id (unsafeCoerce# x)
+  -- See Note [Unsafe coerce magic] in basicTypes/MkId
+  -- NB: Do not eta-reduce this definition, else the type checker 
+  -- give usafeCoerce the same (dangerous) type as unsafeCoerce#
diff --git a/libraries/base/aclocal.m4 b/libraries/base/aclocal.m4
new file mode 100644
index 000000000000..50d8168ec04d
--- /dev/null
+++ b/libraries/base/aclocal.m4
@@ -0,0 +1,229 @@
+# FP_COMPUTE_INT(EXPRESSION, VARIABLE, INCLUDES, IF-FAILS)
+# --------------------------------------------------------
+# Assign VARIABLE the value of the compile-time EXPRESSION using INCLUDES for
+# compilation. Execute IF-FAILS when unable to determine the value. Works for
+# cross-compilation, too.
+#
+# Implementation note: We are lazy and use an internal autoconf macro, but it
+# is supported in autoconf versions 2.50 up to the actual 2.57, so there is
+# little risk.
+# The public AC_COMPUTE_INT macro isn't supported by some versions of
+# autoconf.
+AC_DEFUN([FP_COMPUTE_INT],
+[_AC_COMPUTE_INT([$2], [$1], [$3], [$4])[]dnl
+])# FP_COMPUTE_INT
+
+
+# FP_CHECK_CONST(EXPRESSION, [INCLUDES = DEFAULT-INCLUDES], [VALUE-IF-FAIL = -1])
+# -------------------------------------------------------------------------------
+# Defines CONST_EXPRESSION to the value of the compile-time EXPRESSION, using
+# INCLUDES. If the value cannot be determined, use VALUE-IF-FAIL.
+AC_DEFUN([FP_CHECK_CONST],
+[AS_VAR_PUSHDEF([fp_Cache], [fp_cv_const_$1])[]dnl
+AC_CACHE_CHECK([value of $1], fp_Cache,
+[FP_COMPUTE_INT(fp_check_const_result, [$1], [AC_INCLUDES_DEFAULT([$2])],
+                [fp_check_const_result=m4_default([$3], ['-1'])])
+AS_VAR_SET(fp_Cache, [$fp_check_const_result])])[]dnl
+AC_DEFINE_UNQUOTED(AS_TR_CPP([CONST_$1]), AS_VAR_GET(fp_Cache), [The value of $1.])[]dnl
+AS_VAR_POPDEF([fp_Cache])[]dnl
+])# FP_CHECK_CONST
+
+
+# FP_CHECK_CONSTS_TEMPLATE(EXPRESSION...)
+# ---------------------------------------
+# autoheader helper for FP_CHECK_CONSTS
+m4_define([FP_CHECK_CONSTS_TEMPLATE],
+[AC_FOREACH([fp_Const], [$1],
+  [AH_TEMPLATE(AS_TR_CPP(CONST_[]fp_Const),
+               [The value of ]fp_Const[.])])[]dnl
+])# FP_CHECK_CONSTS_TEMPLATE
+
+
+# FP_CHECK_CONSTS(EXPRESSION..., [INCLUDES = DEFAULT-INCLUDES], [VALUE-IF-FAIL = -1])
+# -----------------------------------------------------------------------------------
+# List version of FP_CHECK_CONST
+AC_DEFUN([FP_CHECK_CONSTS],
+[FP_CHECK_CONSTS_TEMPLATE([$1])dnl
+for fp_const_name in $1
+do
+FP_CHECK_CONST([$fp_const_name], [$2], [$3])
+done
+])# FP_CHECK_CONSTS
+
+
+dnl FPTOOLS_HTYPE_INCLUDES
+AC_DEFUN([FPTOOLS_HTYPE_INCLUDES],
+[
+#include <stdio.h>
+#include <stddef.h>
+
+#if HAVE_SYS_TYPES_H
+# include <sys/types.h>
+#endif
+
+#if HAVE_UNISTD_H
+# include <unistd.h>
+#endif
+
+#if HAVE_SYS_STAT_H
+# include <sys/stat.h>
+#endif
+
+#if HAVE_FCNTL_H
+# include <fcntl.h>
+#endif
+
+#if HAVE_SIGNAL_H
+# include <signal.h>
+#endif
+
+#if HAVE_TIME_H
+# include <time.h>
+#endif
+
+#if HAVE_TERMIOS_H
+# include <termios.h>
+#endif
+
+#if HAVE_STRING_H
+# include <string.h>
+#endif
+
+#if HAVE_CTYPE_H
+# include <ctype.h>
+#endif
+
+#if HAVE_INTTYPES_H
+# include <inttypes.h>
+#else
+# if HAVE_STDINT_H
+#  include <stdint.h>
+# endif
+#endif
+
+#if HAVE_SYS_RESOURCE_H
+# include <sys/resource.h>
+#endif
+
+#include <stdlib.h>
+])
+
+
+dnl ** Map an arithmetic C type to a Haskell type.
+dnl    Based on autconf's AC_CHECK_SIZEOF.
+
+dnl FPTOOLS_CHECK_HTYPE_ELSE(TYPE, WHAT_TO_DO_IF_TYPE_DOES_NOT_EXIST)
+AC_DEFUN([FPTOOLS_CHECK_HTYPE_ELSE],[
+    changequote(<<, >>)
+    dnl The name to #define.
+    define(<<AC_TYPE_NAME>>, translit(htype_$1, [a-z *], [A-Z_P]))
+    dnl The cache variable names.
+    define(<<AC_CV_NAME>>, translit(fptools_cv_htype_$1, [ *], [_p]))
+    define(<<AC_CV_NAME_supported>>, translit(fptools_cv_htype_sup_$1, [ *], [_p]))
+    changequote([, ])
+
+    AC_MSG_CHECKING(Haskell type for $1)
+    AC_CACHE_VAL(AC_CV_NAME,[
+        AC_CV_NAME_supported=yes
+        FP_COMPUTE_INT([HTYPE_IS_INTEGRAL],
+                       [($1)0.2 - ($1)0.4 < 0 ? 0 : 1],
+                       [FPTOOLS_HTYPE_INCLUDES],[HTYPE_IS_INTEGRAL=0])
+
+        if test "$HTYPE_IS_INTEGRAL" -eq 0
+        then
+            FP_COMPUTE_INT([HTYPE_IS_FLOAT],[sizeof($1) == sizeof(float)],
+                           [FPTOOLS_HTYPE_INCLUDES],
+                           [AC_CV_NAME_supported=no])
+            FP_COMPUTE_INT([HTYPE_IS_DOUBLE],[sizeof($1) == sizeof(double)],
+                           [FPTOOLS_HTYPE_INCLUDES],
+                           [AC_CV_NAME_supported=no])
+            FP_COMPUTE_INT([HTYPE_IS_LDOUBLE],[sizeof($1) == sizeof(long double)],
+                           [FPTOOLS_HTYPE_INCLUDES],
+                           [AC_CV_NAME_supported=no])
+            if test "$HTYPE_IS_FLOAT" -eq 1
+            then
+                AC_CV_NAME=Float
+            elif test "$HTYPE_IS_DOUBLE" -eq 1
+            then
+                AC_CV_NAME=Double
+            elif test "$HTYPE_IS_LDOUBLE" -eq 1
+            then
+                AC_CV_NAME=LDouble
+            else
+                AC_CV_NAME_supported=no
+            fi
+        else
+            FP_COMPUTE_INT([HTYPE_IS_SIGNED],[(($1)(-1)) < (($1)0)],
+                           [FPTOOLS_HTYPE_INCLUDES],
+                           [AC_CV_NAME_supported=no])
+            FP_COMPUTE_INT([HTYPE_SIZE],[sizeof($1) * 8],
+                           [FPTOOLS_HTYPE_INCLUDES],
+                           [AC_CV_NAME_supported=no])
+            if test "$HTYPE_IS_SIGNED" -eq 0
+            then
+                AC_CV_NAME="Word$HTYPE_SIZE"
+            else
+                AC_CV_NAME="Int$HTYPE_SIZE"
+            fi
+        fi
+    ])
+    if test "$AC_CV_NAME_supported" = no
+    then
+        $2
+    fi
+
+    dnl Note: evaluating dollar-2 can change the value of
+    dnl $AC_CV_NAME_supported, so we might now get a different answer
+    if test "$AC_CV_NAME_supported" = yes; then
+        AC_MSG_RESULT($AC_CV_NAME)
+        AC_DEFINE_UNQUOTED(AC_TYPE_NAME, $AC_CV_NAME,
+                           [Define to Haskell type for $1])
+    fi
+    undefine([AC_TYPE_NAME])dnl
+    undefine([AC_CV_NAME])dnl
+    undefine([AC_CV_NAME_supported])dnl
+])
+
+dnl FPTOOLS_CHECK_HTYPE(TYPE)
+AC_DEFUN([FPTOOLS_CHECK_HTYPE],[
+    FPTOOLS_CHECK_HTYPE_ELSE([$1],[
+        AC_CV_NAME=NotReallyAType
+        AC_MSG_RESULT([not supported])
+    ])
+])
+
+
+# FP_SEARCH_LIBS_PROTO(WHAT, PROTOTYPE, FUNCTION, SEARCH-LIBS,
+#                [ACTION-IF-FOUND], [ACTION-IF-NOT-FOUND],
+#                [OTHER-LIBRARIES])
+# --------------------------------------------------------
+# Search for a library defining FUNC, if it's not already available.
+# This is a copy of the AC_SEARCH_LIBS definition, but extended to take
+# the name of the thing we are looking for as its first argument, and
+# prototype text as its second argument. It also calls AC_LANG_PROGRAM
+# instead of AC_LANG_CALL
+AC_DEFUN([FP_SEARCH_LIBS_PROTO],
+[AS_VAR_PUSHDEF([ac_Search], [ac_cv_search_$1])dnl
+AC_CACHE_CHECK([for library containing $1], [ac_Search],
+[ac_func_search_save_LIBS=$LIBS
+AC_LANG_CONFTEST([AC_LANG_PROGRAM([$2], [$3])])
+for ac_lib in '' $4; do
+  if test -z "$ac_lib"; then
+    ac_res="none required"
+  else
+    ac_res=-l$ac_lib
+    LIBS="-l$ac_lib $7 $ac_func_search_save_LIBS"
+  fi
+  AC_LINK_IFELSE([], [AS_VAR_SET([ac_Search], [$ac_res])])
+  AS_VAR_SET_IF([ac_Search], [break])
+done
+AS_VAR_SET_IF([ac_Search], , [AS_VAR_SET([ac_Search], [no])])
+rm conftest.$ac_ext
+LIBS=$ac_func_search_save_LIBS])
+ac_res=AS_VAR_GET([ac_Search])
+AS_IF([test "$ac_res" != no],
+  [test "$ac_res" = "none required" || LIBS="$ac_res $LIBS"
+  $5],
+      [$6])dnl
+AS_VAR_POPDEF([ac_Search])dnl
+])
diff --git a/libraries/base/base.buildinfo.in b/libraries/base/base.buildinfo.in
new file mode 100644
index 000000000000..ddf1bad57de3
--- /dev/null
+++ b/libraries/base/base.buildinfo.in
@@ -0,0 +1,4 @@
+extra-lib-dirs: @ICONV_LIB_DIRS@
+extra-libraries: @EXTRA_LIBS@
+include-dirs: @ICONV_INCLUDE_DIRS@
+install-includes: HsBaseConfig.h EventConfig.h
diff --git a/libraries/base/base.cabal b/libraries/base/base.cabal
new file mode 100644
index 000000000000..b7828a9c20fe
--- /dev/null
+++ b/libraries/base/base.cabal
@@ -0,0 +1,333 @@
+name:           base
+version:        4.7.1.0
+-- GHC 7.6.1 released with 4.6.0.0
+license:        BSD3
+license-file:   LICENSE
+maintainer:     libraries@haskell.org
+bug-reports:    http://ghc.haskell.org/trac/ghc/newticket?component=libraries/base
+synopsis:       Basic libraries
+category:       Prelude
+description:
+    This package contains the "Prelude" and its support libraries,
+    and a large collection of useful libraries ranging from data
+    structures to parsing combinators and debugging utilities.
+cabal-version:  >=1.10
+build-type:     Configure
+
+extra-tmp-files:
+    autom4te.cache
+    base.buildinfo
+    config.log
+    config.status
+    include/EventConfig.h
+    include/HsBaseConfig.h
+
+extra-source-files:
+    aclocal.m4
+    base.buildinfo.in
+    changelog.md
+    config.guess
+    config.sub
+    configure
+    configure.ac
+    include/CTypes.h
+    include/EventConfig.h.in
+    include/HsBaseConfig.h.in
+    include/ieee-flpt.h
+    include/md5.h
+    install-sh
+
+source-repository head
+    type:     git
+    location: http://git.haskell.org/ghc.git
+    subdir:   libraries/base
+
+Flag integer-simple
+    Description: Use integer-simple
+
+Library
+    default-language: Haskell2010
+    other-extensions:
+        AutoDeriveTypeable
+        BangPatterns
+        CApiFFI
+        CPP
+        ConstraintKinds
+        DataKinds
+        DeriveDataTypeable
+        DeriveGeneric
+        ExistentialQuantification
+        ExplicitForAll
+        FlexibleContexts
+        FlexibleInstances
+        FunctionalDependencies
+        GADTs
+        GeneralizedNewtypeDeriving
+        KindSignatures
+        MagicHash
+        MultiParamTypeClasses
+        NegativeLiterals
+        NoImplicitPrelude
+        NondecreasingIndentation
+        OverlappingInstances
+        OverloadedStrings
+        ParallelArrays
+        PolyKinds
+        RankNTypes
+        RecordWildCards
+        RoleAnnotations
+        Safe
+        ScopedTypeVariables
+        StandaloneDeriving
+        Trustworthy
+        TypeFamilies
+        TypeOperators
+        TypeSynonymInstances
+        UnboxedTuples
+        UndecidableInstances
+        UnliftedFFITypes
+        Unsafe
+
+    build-depends: rts == 1.0.*, ghc-prim >= 0.3.1 && < 0.4
+    if flag(integer-simple)
+        build-depends: integer-simple >= 0.1.1 && < 0.2
+    else
+        build-depends: integer-gmp >= 0.5.1 && < 0.6
+        cpp-options: -DOPTIMISE_INTEGER_GCD_LCM
+
+    exposed-modules:
+        Control.Applicative
+        Control.Arrow
+        Control.Category
+        Control.Concurrent
+        Control.Concurrent.Chan
+        Control.Concurrent.MVar
+        Control.Concurrent.QSem
+        Control.Concurrent.QSemN
+        Control.Exception
+        Control.Exception.Base
+        Control.Monad
+        Control.Monad.Fix
+        Control.Monad.Instances
+        Control.Monad.ST
+        Control.Monad.ST.Lazy
+        Control.Monad.ST.Lazy.Safe
+        Control.Monad.ST.Lazy.Unsafe
+        Control.Monad.ST.Safe
+        Control.Monad.ST.Strict
+        Control.Monad.ST.Unsafe
+        Control.Monad.Zip
+        Data.Bits
+        Data.Bool
+        Data.Char
+        Data.Coerce
+        Data.Complex
+        Data.Data
+        Data.Dynamic
+        Data.Either
+        Data.Eq
+        Data.Fixed
+        Data.Foldable
+        Data.Function
+        Data.Functor
+        Data.IORef
+        Data.Int
+        Data.Ix
+        Data.List
+        Data.Maybe
+        Data.Monoid
+        Data.OldTypeable
+        Data.OldTypeable.Internal
+        Data.Ord
+        Data.Proxy
+        Data.Ratio
+        Data.STRef
+        Data.STRef.Lazy
+        Data.STRef.Strict
+        Data.String
+        Data.Traversable
+        Data.Tuple
+        Data.Type.Bool
+        Data.Type.Coercion
+        Data.Type.Equality
+        Data.Typeable
+        Data.Typeable.Internal
+        Data.Unique
+        Data.Version
+        Data.Word
+        Debug.Trace
+        Foreign
+        Foreign.C
+        Foreign.C.Error
+        Foreign.C.String
+        Foreign.C.Types
+        Foreign.Concurrent
+        Foreign.ForeignPtr
+        Foreign.ForeignPtr.Safe
+        Foreign.ForeignPtr.Unsafe
+        Foreign.Marshal
+        Foreign.Marshal.Alloc
+        Foreign.Marshal.Array
+        Foreign.Marshal.Error
+        Foreign.Marshal.Pool
+        Foreign.Marshal.Safe
+        Foreign.Marshal.Unsafe
+        Foreign.Marshal.Utils
+        Foreign.Ptr
+        Foreign.Safe
+        Foreign.StablePtr
+        Foreign.Storable
+        GHC.Arr
+        GHC.Base
+        GHC.Char
+        GHC.Conc
+        GHC.Conc.IO
+        GHC.Conc.Signal
+        GHC.Conc.Sync
+        GHC.ConsoleHandler
+        GHC.Constants
+        GHC.Desugar
+        GHC.Enum
+        GHC.Environment
+        GHC.Err
+        GHC.Exception
+        GHC.Exts
+        GHC.Fingerprint
+        GHC.Fingerprint.Type
+        GHC.Float
+        GHC.Float.ConversionUtils
+        GHC.Float.RealFracMethods
+        GHC.Foreign
+        GHC.ForeignPtr
+        GHC.GHCi
+        GHC.Generics
+        GHC.IO
+        GHC.IO.Buffer
+        GHC.IO.BufferedIO
+        GHC.IO.Device
+        GHC.IO.Encoding
+        GHC.IO.Encoding.CodePage
+        GHC.IO.Encoding.Failure
+        GHC.IO.Encoding.Iconv
+        GHC.IO.Encoding.Latin1
+        GHC.IO.Encoding.Types
+        GHC.IO.Encoding.UTF16
+        GHC.IO.Encoding.UTF32
+        GHC.IO.Encoding.UTF8
+        GHC.IO.Exception
+        GHC.IO.FD
+        GHC.IO.Handle
+        GHC.IO.Handle.FD
+        GHC.IO.Handle.Internals
+        GHC.IO.Handle.Text
+        GHC.IO.Handle.Types
+        GHC.IO.IOMode
+        GHC.IOArray
+        GHC.IORef
+        GHC.IP
+        GHC.Int
+        GHC.List
+        GHC.MVar
+        GHC.Num
+        GHC.PArr
+        GHC.Pack
+        GHC.Profiling
+        GHC.Ptr
+        GHC.Read
+        GHC.Real
+        GHC.ST
+        GHC.STRef
+        GHC.Show
+        GHC.Stable
+        GHC.Stack
+        GHC.Stats
+        GHC.Storable
+        GHC.TopHandler
+        GHC.TypeLits
+        GHC.Unicode
+        GHC.Weak
+        GHC.Word
+        Numeric
+        Prelude
+        System.CPUTime
+        System.Console.GetOpt
+        System.Environment
+        System.Exit
+        System.IO
+        System.IO.Error
+        System.IO.Unsafe
+        System.Info
+        System.Mem
+        System.Mem.StableName
+        System.Mem.Weak
+        System.Posix.Internals
+        System.Posix.Types
+        System.Timeout
+        Text.ParserCombinators.ReadP
+        Text.ParserCombinators.ReadPrec
+        Text.Printf
+        Text.Read
+        Text.Read.Lex
+        Text.Show
+        Text.Show.Functions
+        Unsafe.Coerce
+
+    other-modules:
+        Control.Monad.ST.Imp
+        Control.Monad.ST.Lazy.Imp
+        Foreign.ForeignPtr.Imp
+        System.Environment.ExecutablePath
+
+    c-sources:
+        cbits/DarwinUtils.c
+        cbits/PrelIOUtils.c
+        cbits/SetEnv.c
+        cbits/WCsubst.c
+        cbits/Win32Utils.c
+        cbits/consUtils.c
+        cbits/iconv.c
+        cbits/inputReady.c
+        cbits/md5.c
+        cbits/primFloat.c
+        cbits/sysconf.c
+
+    include-dirs: include
+    includes:
+        HsBase.h
+    install-includes:
+        HsBase.h
+        WCsubst.h
+        consUtils.h
+        Typeable.h
+        OldTypeable.h
+
+    -- OS Specific
+    if os(windows)
+        extra-libraries: wsock32, user32, shell32
+        exposed-modules:
+            GHC.IO.Encoding.CodePage.API
+            GHC.IO.Encoding.CodePage.Table
+            GHC.Conc.Windows
+            GHC.Windows
+    else
+        exposed-modules:
+            GHC.Event
+        other-modules:
+            GHC.Event.Arr
+            GHC.Event.Array
+            GHC.Event.Clock
+            GHC.Event.Control
+            GHC.Event.EPoll
+            GHC.Event.IntTable
+            GHC.Event.Internal
+            GHC.Event.KQueue
+            GHC.Event.Manager
+            GHC.Event.PSQ
+            GHC.Event.Poll
+            GHC.Event.Thread
+            GHC.Event.TimerManager
+            GHC.Event.Unique
+
+    -- We need to set the package key to base (without a version number)
+    -- as it's magic.
+    ghc-options: -this-package-key base
diff --git a/libraries/base/cbits/DarwinUtils.c b/libraries/base/cbits/DarwinUtils.c
new file mode 100644
index 000000000000..d0809341040c
--- /dev/null
+++ b/libraries/base/cbits/DarwinUtils.c
@@ -0,0 +1,22 @@
+#include "HsBase.h"
+
+#if defined(darwin_HOST_OS) || defined(ios_HOST_OS)
+#include <mach/mach_time.h>
+
+static double scaling_factor = 0.0;
+
+void initialize_timer()
+{
+    mach_timebase_info_data_t info;
+    (void) mach_timebase_info(&info);
+    scaling_factor = (double)info.numer / (double)info.denom;
+    scaling_factor *= 1e-9;
+}
+
+void absolute_time(double *result)
+{
+    uint64_t time = mach_absolute_time();
+    *result = (double)time * scaling_factor;
+}
+
+#endif
diff --git a/libraries/base/cbits/PrelIOUtils.c b/libraries/base/cbits/PrelIOUtils.c
new file mode 100644
index 000000000000..9e05f08396be
--- /dev/null
+++ b/libraries/base/cbits/PrelIOUtils.c
@@ -0,0 +1,52 @@
+/* 
+ * (c) The University of Glasgow 2002
+ *
+ * static versions of the inline functions in HsCore.h
+ */
+
+#define INLINE
+
+#ifdef __GLASGOW_HASKELL__
+# include "Rts.h"
+#endif
+
+#include "HsBase.h"
+
+#ifdef __GLASGOW_HASKELL__
+
+void errorBelch2(const char*s, char *t)
+{
+    errorBelch(s,t);
+}
+
+void debugBelch2(const char*s, char *t)
+{
+    debugBelch(s,t);
+}
+
+#if defined(HAVE_LIBCHARSET)
+#  include <libcharset.h>
+#elif defined(HAVE_LANGINFO_H)
+#  include <langinfo.h>
+#endif
+
+#if !defined(mingw32_HOST_OS)
+const char* localeEncoding(void)
+{
+#if defined(HAVE_LIBCHARSET)
+    return locale_charset();
+
+#elif defined(HAVE_LANGINFO_H)
+    return nl_langinfo(CODESET);
+
+#else
+#warning Depending on the unportable behavior of GNU iconv due to absence of both libcharset and langinfo.h
+    /* GNU iconv accepts "" to mean the current locale's
+     * encoding. Warning: This isn't portable.
+     */
+    return "";
+#endif
+}
+#endif
+
+#endif /* __GLASGOW_HASKELL__ */
diff --git a/libraries/base/cbits/README.Unicode b/libraries/base/cbits/README.Unicode
new file mode 100644
index 000000000000..363aa4dc971c
--- /dev/null
+++ b/libraries/base/cbits/README.Unicode
@@ -0,0 +1,8 @@
+
+WCsubst.c is generated with:
+
+    sh ubconfc < UnicodeData.txt > WCsubst.c
+
+where UnicodeData.txt came from
+
+    http://www.unicode.org/Public/6.0.0/ucd/UnicodeData.txt
diff --git a/libraries/base/cbits/SetEnv.c b/libraries/base/cbits/SetEnv.c
new file mode 100644
index 000000000000..38f0ed52b8ad
--- /dev/null
+++ b/libraries/base/cbits/SetEnv.c
@@ -0,0 +1,11 @@
+#include "HsBase.h"
+#ifdef HAVE_UNSETENV
+int __hsbase_unsetenv(const char *name) {
+#ifdef UNSETENV_RETURNS_VOID
+    unsetenv(name);
+    return 0;
+#else
+    return unsetenv(name);
+#endif
+}
+#endif
diff --git a/libraries/base/cbits/WCsubst.c b/libraries/base/cbits/WCsubst.c
new file mode 100644
index 000000000000..0f6fcdf81498
--- /dev/null
+++ b/libraries/base/cbits/WCsubst.c
@@ -0,0 +1,4398 @@
+/*-------------------------------------------------------------------------
+This is an automatically generated file: do not edit
+Generated by ubconfc at Mon Feb  7 20:26:56 CET 2011
+-------------------------------------------------------------------------*/
+
+#include "WCsubst.h"
+
+/* Unicode general categories, listed in the same order as in the Unicode
+ * standard -- this must be the same order as in GHC.Unicode.
+ */
+
+enum {
+    NUMCAT_LU,  /* Letter, Uppercase */
+    NUMCAT_LL,  /* Letter, Lowercase */
+    NUMCAT_LT,  /* Letter, Titlecase */
+    NUMCAT_LM,  /* Letter, Modifier */
+    NUMCAT_LO,  /* Letter, Other */
+    NUMCAT_MN,  /* Mark, Non-Spacing */
+    NUMCAT_MC,  /* Mark, Spacing Combining */
+    NUMCAT_ME,  /* Mark, Enclosing */
+    NUMCAT_ND,  /* Number, Decimal */
+    NUMCAT_NL,  /* Number, Letter */
+    NUMCAT_NO,  /* Number, Other */
+    NUMCAT_PC,  /* Punctuation, Connector */
+    NUMCAT_PD,  /* Punctuation, Dash */
+    NUMCAT_PS,  /* Punctuation, Open */
+    NUMCAT_PE,  /* Punctuation, Close */
+    NUMCAT_PI,  /* Punctuation, Initial quote */
+    NUMCAT_PF,  /* Punctuation, Final quote */
+    NUMCAT_PO,  /* Punctuation, Other */
+    NUMCAT_SM,  /* Symbol, Math */
+    NUMCAT_SC,  /* Symbol, Currency */
+    NUMCAT_SK,  /* Symbol, Modifier */
+    NUMCAT_SO,  /* Symbol, Other */
+    NUMCAT_ZS,  /* Separator, Space */
+    NUMCAT_ZL,  /* Separator, Line */
+    NUMCAT_ZP,  /* Separator, Paragraph */
+    NUMCAT_CC,  /* Other, Control */
+    NUMCAT_CF,  /* Other, Format */
+    NUMCAT_CS,  /* Other, Surrogate */
+    NUMCAT_CO,  /* Other, Private Use */
+    NUMCAT_CN   /* Other, Not Assigned */
+};
+
+struct _convrule_ 
+{ 
+	unsigned int category;
+	unsigned int catnumber;
+	int possible;
+	int updist;
+	int lowdist; 
+	int titledist;
+};
+
+struct _charblock_ 
+{ 
+	int start;
+	int length;
+	const struct _convrule_ *rule;
+};
+
+#define GENCAT_LO 262144
+#define GENCAT_PC 2048
+#define GENCAT_PD 128
+#define GENCAT_MN 2097152
+#define GENCAT_PE 32
+#define GENCAT_NL 16777216
+#define GENCAT_PF 131072
+#define GENCAT_LT 524288
+#define GENCAT_NO 65536
+#define GENCAT_LU 512
+#define GENCAT_PI 16384
+#define GENCAT_SC 8
+#define GENCAT_PO 4
+#define GENCAT_PS 16
+#define GENCAT_SK 1024
+#define GENCAT_SM 64
+#define GENCAT_SO 8192
+#define GENCAT_CC 1
+#define GENCAT_CF 32768
+#define GENCAT_CO 268435456
+#define GENCAT_ZL 33554432
+#define GENCAT_CS 134217728
+#define GENCAT_ZP 67108864
+#define GENCAT_ZS 2
+#define GENCAT_MC 8388608
+#define GENCAT_ME 4194304
+#define GENCAT_ND 256
+#define GENCAT_LL 4096
+#define GENCAT_LM 1048576
+#define MAX_UNI_CHAR 1114109
+#define NUM_BLOCKS 2783
+#define NUM_CONVBLOCKS 1230
+#define NUM_SPACEBLOCKS 8
+#define NUM_LAT1BLOCKS 63
+#define NUM_RULES 167
+static const struct _convrule_ rule160={GENCAT_LL, NUMCAT_LL, 1, -7264, 0, -7264};
+static const struct _convrule_ rule36={GENCAT_LU, NUMCAT_LU, 1, 0, 211, 0};
+static const struct _convrule_ rule25={GENCAT_LU, NUMCAT_LU, 1, 0, -121, 0};
+static const struct _convrule_ rule18={GENCAT_LL, NUMCAT_LL, 1, 743, 0, 743};
+static const struct _convrule_ rule108={GENCAT_LU, NUMCAT_LU, 1, 0, 80, 0};
+static const struct _convrule_ rule50={GENCAT_LL, NUMCAT_LL, 1, -79, 0, -79};
+static const struct _convrule_ rule106={GENCAT_LL, NUMCAT_LL, 1, -96, 0, -96};
+static const struct _convrule_ rule79={GENCAT_LL, NUMCAT_LL, 1, -69, 0, -69};
+static const struct _convrule_ rule126={GENCAT_LL, NUMCAT_LL, 1, 128, 0, 128};
+static const struct _convrule_ rule119={GENCAT_LL, NUMCAT_LL, 1, -59, 0, -59};
+static const struct _convrule_ rule102={GENCAT_LL, NUMCAT_LL, 1, -86, 0, -86};
+static const struct _convrule_ rule38={GENCAT_LL, NUMCAT_LL, 1, 163, 0, 163};
+static const struct _convrule_ rule113={GENCAT_LL, NUMCAT_LL, 1, -48, 0, -48};
+static const struct _convrule_ rule133={GENCAT_LL, NUMCAT_LL, 1, -7205, 0, -7205};
+static const struct _convrule_ rule128={GENCAT_LL, NUMCAT_LL, 1, 126, 0, 126};
+static const struct _convrule_ rule97={GENCAT_LL, NUMCAT_LL, 1, -57, 0, -57};
+static const struct _convrule_ rule161={GENCAT_LU, NUMCAT_LU, 1, 0, -35332, 0};
+static const struct _convrule_ rule136={GENCAT_LU, NUMCAT_LU, 1, 0, -112, 0};
+static const struct _convrule_ rule99={GENCAT_LL, NUMCAT_LL, 1, -47, 0, -47};
+static const struct _convrule_ rule90={GENCAT_LL, NUMCAT_LL, 1, -38, 0, -38};
+static const struct _convrule_ rule32={GENCAT_LU, NUMCAT_LU, 1, 0, 202, 0};
+static const struct _convrule_ rule145={GENCAT_LL, NUMCAT_LL, 1, -28, 0, -28};
+static const struct _convrule_ rule93={GENCAT_LL, NUMCAT_LL, 1, -64, 0, -64};
+static const struct _convrule_ rule91={GENCAT_LL, NUMCAT_LL, 1, -37, 0, -37};
+static const struct _convrule_ rule60={GENCAT_LU, NUMCAT_LU, 1, 0, 71, 0};
+static const struct _convrule_ rule100={GENCAT_LL, NUMCAT_LL, 1, -54, 0, -54};
+static const struct _convrule_ rule94={GENCAT_LL, NUMCAT_LL, 1, -63, 0, -63};
+static const struct _convrule_ rule35={GENCAT_LL, NUMCAT_LL, 1, 97, 0, 97};
+static const struct _convrule_ rule149={GENCAT_SO, NUMCAT_SO, 1, -26, 0, -26};
+static const struct _convrule_ rule103={GENCAT_LL, NUMCAT_LL, 1, -80, 0, -80};
+static const struct _convrule_ rule96={GENCAT_LL, NUMCAT_LL, 1, -62, 0, -62};
+static const struct _convrule_ rule81={GENCAT_LL, NUMCAT_LL, 1, -71, 0, -71};
+static const struct _convrule_ rule9={GENCAT_LU, NUMCAT_LU, 1, 0, 32, 0};
+static const struct _convrule_ rule147={GENCAT_NL, NUMCAT_NL, 1, -16, 0, -16};
+static const struct _convrule_ rule143={GENCAT_LU, NUMCAT_LU, 1, 0, -8262, 0};
+static const struct _convrule_ rule127={GENCAT_LL, NUMCAT_LL, 1, 112, 0, 112};
+static const struct _convrule_ rule124={GENCAT_LL, NUMCAT_LL, 1, 86, 0, 86};
+static const struct _convrule_ rule40={GENCAT_LL, NUMCAT_LL, 1, 130, 0, 130};
+static const struct _convrule_ rule20={GENCAT_LL, NUMCAT_LL, 1, 121, 0, 121};
+static const struct _convrule_ rule158={GENCAT_LU, NUMCAT_LU, 1, 0, -10782, 0};
+static const struct _convrule_ rule111={GENCAT_LL, NUMCAT_LL, 1, -15, 0, -15};
+static const struct _convrule_ rule12={GENCAT_LL, NUMCAT_LL, 1, -32, 0, -32};
+static const struct _convrule_ rule85={GENCAT_MN, NUMCAT_MN, 1, 84, 0, 84};
+static const struct _convrule_ rule166={GENCAT_LL, NUMCAT_LL, 1, -40, 0, -40};
+static const struct _convrule_ rule125={GENCAT_LL, NUMCAT_LL, 1, 100, 0, 100};
+static const struct _convrule_ rule123={GENCAT_LL, NUMCAT_LL, 1, 74, 0, 74};
+static const struct _convrule_ rule92={GENCAT_LL, NUMCAT_LL, 1, -31, 0, -31};
+static const struct _convrule_ rule56={GENCAT_LU, NUMCAT_LU, 1, 0, 10792, 0};
+static const struct _convrule_ rule46={GENCAT_LL, NUMCAT_LL, 1, 56, 0, 56};
+static const struct _convrule_ rule33={GENCAT_LU, NUMCAT_LU, 1, 0, 203, 0};
+static const struct _convrule_ rule150={GENCAT_LU, NUMCAT_LU, 1, 0, -10743, 0};
+static const struct _convrule_ rule39={GENCAT_LU, NUMCAT_LU, 1, 0, 213, 0};
+static const struct _convrule_ rule57={GENCAT_LL, NUMCAT_LL, 1, 10815, 0, 10815};
+static const struct _convrule_ rule157={GENCAT_LU, NUMCAT_LU, 1, 0, -10783, 0};
+static const struct _convrule_ rule55={GENCAT_LU, NUMCAT_LU, 1, 0, -163, 0};
+static const struct _convrule_ rule151={GENCAT_LU, NUMCAT_LU, 1, 0, -3814, 0};
+static const struct _convrule_ rule142={GENCAT_LU, NUMCAT_LU, 1, 0, -8383, 0};
+static const struct _convrule_ rule101={GENCAT_LL, NUMCAT_LL, 1, -8, 0, -8};
+static const struct _convrule_ rule89={GENCAT_LU, NUMCAT_LU, 1, 0, 63, 0};
+static const struct _convrule_ rule41={GENCAT_LU, NUMCAT_LU, 1, 0, 214, 0};
+static const struct _convrule_ rule118={GENCAT_LL, NUMCAT_LL, 1, 3814, 0, 3814};
+static const struct _convrule_ rule26={GENCAT_LL, NUMCAT_LL, 1, -300, 0, -300};
+static const struct _convrule_ rule159={GENCAT_LU, NUMCAT_LU, 1, 0, -10815, 0};
+static const struct _convrule_ rule115={GENCAT_LU, NUMCAT_LU, 1, 0, 7264, 0};
+static const struct _convrule_ rule22={GENCAT_LL, NUMCAT_LL, 1, -1, 0, -1};
+static const struct _convrule_ rule120={GENCAT_LU, NUMCAT_LU, 1, 0, -7615, 0};
+static const struct _convrule_ rule49={GENCAT_LL, NUMCAT_LL, 1, -2, 0, -1};
+static const struct _convrule_ rule131={GENCAT_LU, NUMCAT_LU, 1, 0, -74, 0};
+static const struct _convrule_ rule88={GENCAT_LU, NUMCAT_LU, 1, 0, 64, 0};
+static const struct _convrule_ rule30={GENCAT_LU, NUMCAT_LU, 1, 0, 205, 0};
+static const struct _convrule_ rule117={GENCAT_LL, NUMCAT_LL, 1, 35332, 0, 35332};
+static const struct _convrule_ rule110={GENCAT_LU, NUMCAT_LU, 1, 0, 15, 0};
+static const struct _convrule_ rule130={GENCAT_LL, NUMCAT_LL, 1, 9, 0, 9};
+static const struct _convrule_ rule121={GENCAT_LL, NUMCAT_LL, 1, 8, 0, 8};
+static const struct _convrule_ rule95={GENCAT_LU, NUMCAT_LU, 1, 0, 8, 0};
+static const struct _convrule_ rule54={GENCAT_LU, NUMCAT_LU, 1, 0, 10795, 0};
+static const struct _convrule_ rule29={GENCAT_LU, NUMCAT_LU, 1, 0, 206, 0};
+static const struct _convrule_ rule138={GENCAT_LU, NUMCAT_LU, 1, 0, -126, 0};
+static const struct _convrule_ rule104={GENCAT_LL, NUMCAT_LL, 1, 7, 0, 7};
+static const struct _convrule_ rule58={GENCAT_LU, NUMCAT_LU, 1, 0, -195, 0};
+static const struct _convrule_ rule146={GENCAT_NL, NUMCAT_NL, 1, 0, 16, 0};
+static const struct _convrule_ rule148={GENCAT_SO, NUMCAT_SO, 1, 0, 26, 0};
+static const struct _convrule_ rule70={GENCAT_LL, NUMCAT_LL, 1, 42280, 0, 42280};
+static const struct _convrule_ rule107={GENCAT_LU, NUMCAT_LU, 1, 0, -7, 0};
+static const struct _convrule_ rule52={GENCAT_LU, NUMCAT_LU, 1, 0, -56, 0};
+static const struct _convrule_ rule153={GENCAT_LL, NUMCAT_LL, 1, -10795, 0, -10795};
+static const struct _convrule_ rule152={GENCAT_LU, NUMCAT_LU, 1, 0, -10727, 0};
+static const struct _convrule_ rule141={GENCAT_LU, NUMCAT_LU, 1, 0, -7517, 0};
+static const struct _convrule_ rule34={GENCAT_LU, NUMCAT_LU, 1, 0, 207, 0};
+static const struct _convrule_ rule164={GENCAT_CO, NUMCAT_CO, 0, 0, 0, 0};
+static const struct _convrule_ rule84={GENCAT_MN, NUMCAT_MN, 0, 0, 0, 0};
+static const struct _convrule_ rule16={GENCAT_CF, NUMCAT_CF, 0, 0, 0, 0};
+static const struct _convrule_ rule45={GENCAT_LO, NUMCAT_LO, 0, 0, 0, 0};
+static const struct _convrule_ rule13={GENCAT_SO, NUMCAT_SO, 0, 0, 0, 0};
+static const struct _convrule_ rule17={GENCAT_NO, NUMCAT_NO, 0, 0, 0, 0};
+static const struct _convrule_ rule8={GENCAT_ND, NUMCAT_ND, 0, 0, 0, 0};
+static const struct _convrule_ rule14={GENCAT_LL, NUMCAT_LL, 0, 0, 0, 0};
+static const struct _convrule_ rule98={GENCAT_LU, NUMCAT_LU, 0, 0, 0, 0};
+static const struct _convrule_ rule6={GENCAT_SM, NUMCAT_SM, 0, 0, 0, 0};
+static const struct _convrule_ rule114={GENCAT_MC, NUMCAT_MC, 0, 0, 0, 0};
+static const struct _convrule_ rule2={GENCAT_PO, NUMCAT_PO, 0, 0, 0, 0};
+static const struct _convrule_ rule116={GENCAT_NL, NUMCAT_NL, 0, 0, 0, 0};
+static const struct _convrule_ rule3={GENCAT_SC, NUMCAT_SC, 0, 0, 0, 0};
+static const struct _convrule_ rule10={GENCAT_SK, NUMCAT_SK, 0, 0, 0, 0};
+static const struct _convrule_ rule83={GENCAT_LM, NUMCAT_LM, 0, 0, 0, 0};
+static const struct _convrule_ rule5={GENCAT_PE, NUMCAT_PE, 0, 0, 0, 0};
+static const struct _convrule_ rule4={GENCAT_PS, NUMCAT_PS, 0, 0, 0, 0};
+static const struct _convrule_ rule11={GENCAT_PC, NUMCAT_PC, 0, 0, 0, 0};
+static const struct _convrule_ rule7={GENCAT_PD, NUMCAT_PD, 0, 0, 0, 0};
+static const struct _convrule_ rule163={GENCAT_CS, NUMCAT_CS, 0, 0, 0, 0};
+static const struct _convrule_ rule109={GENCAT_ME, NUMCAT_ME, 0, 0, 0, 0};
+static const struct _convrule_ rule1={GENCAT_ZS, NUMCAT_ZS, 0, 0, 0, 0};
+static const struct _convrule_ rule19={GENCAT_PF, NUMCAT_PF, 0, 0, 0, 0};
+static const struct _convrule_ rule15={GENCAT_PI, NUMCAT_PI, 0, 0, 0, 0};
+static const struct _convrule_ rule140={GENCAT_ZP, NUMCAT_ZP, 0, 0, 0, 0};
+static const struct _convrule_ rule139={GENCAT_ZL, NUMCAT_ZL, 0, 0, 0, 0};
+static const struct _convrule_ rule134={GENCAT_LU, NUMCAT_LU, 1, 0, -86, 0};
+static const struct _convrule_ rule43={GENCAT_LU, NUMCAT_LU, 1, 0, 217, 0};
+static const struct _convrule_ rule0={GENCAT_CC, NUMCAT_CC, 0, 0, 0, 0};
+static const struct _convrule_ rule154={GENCAT_LL, NUMCAT_LL, 1, -10792, 0, -10792};
+static const struct _convrule_ rule74={GENCAT_LL, NUMCAT_LL, 1, 10749, 0, 10749};
+static const struct _convrule_ rule87={GENCAT_LU, NUMCAT_LU, 1, 0, 37, 0};
+static const struct _convrule_ rule61={GENCAT_LL, NUMCAT_LL, 1, 10783, 0, 10783};
+static const struct _convrule_ rule122={GENCAT_LU, NUMCAT_LU, 1, 0, -8, 0};
+static const struct _convrule_ rule129={GENCAT_LT, NUMCAT_LT, 1, 0, -8, 0};
+static const struct _convrule_ rule63={GENCAT_LL, NUMCAT_LL, 1, 10782, 0, 10782};
+static const struct _convrule_ rule82={GENCAT_LL, NUMCAT_LL, 1, -219, 0, -219};
+static const struct _convrule_ rule77={GENCAT_LL, NUMCAT_LL, 1, 10727, 0, 10727};
+static const struct _convrule_ rule78={GENCAT_LL, NUMCAT_LL, 1, -218, 0, -218};
+static const struct _convrule_ rule71={GENCAT_LL, NUMCAT_LL, 1, -209, 0, -209};
+static const struct _convrule_ rule62={GENCAT_LL, NUMCAT_LL, 1, 10780, 0, 10780};
+static const struct _convrule_ rule48={GENCAT_LT, NUMCAT_LT, 1, -1, 1, 0};
+static const struct _convrule_ rule21={GENCAT_LU, NUMCAT_LU, 1, 0, 1, 0};
+static const struct _convrule_ rule137={GENCAT_LU, NUMCAT_LU, 1, 0, -128, 0};
+static const struct _convrule_ rule80={GENCAT_LL, NUMCAT_LL, 1, -217, 0, -217};
+static const struct _convrule_ rule73={GENCAT_LL, NUMCAT_LL, 1, 10743, 0, 10743};
+static const struct _convrule_ rule42={GENCAT_LU, NUMCAT_LU, 1, 0, 218, 0};
+static const struct _convrule_ rule69={GENCAT_LL, NUMCAT_LL, 1, -207, 0, -207};
+static const struct _convrule_ rule51={GENCAT_LU, NUMCAT_LU, 1, 0, -97, 0};
+static const struct _convrule_ rule144={GENCAT_LU, NUMCAT_LU, 1, 0, 28, 0};
+static const struct _convrule_ rule65={GENCAT_LL, NUMCAT_LL, 1, -206, 0, -206};
+static const struct _convrule_ rule86={GENCAT_LU, NUMCAT_LU, 1, 0, 38, 0};
+static const struct _convrule_ rule76={GENCAT_LL, NUMCAT_LL, 1, -214, 0, -214};
+static const struct _convrule_ rule66={GENCAT_LL, NUMCAT_LL, 1, -205, 0, -205};
+static const struct _convrule_ rule24={GENCAT_LL, NUMCAT_LL, 1, -232, 0, -232};
+static const struct _convrule_ rule112={GENCAT_LU, NUMCAT_LU, 1, 0, 48, 0};
+static const struct _convrule_ rule132={GENCAT_LT, NUMCAT_LT, 1, 0, -9, 0};
+static const struct _convrule_ rule75={GENCAT_LL, NUMCAT_LL, 1, -213, 0, -213};
+static const struct _convrule_ rule68={GENCAT_LL, NUMCAT_LL, 1, -203, 0, -203};
+static const struct _convrule_ rule135={GENCAT_LU, NUMCAT_LU, 1, 0, -100, 0};
+static const struct _convrule_ rule72={GENCAT_LL, NUMCAT_LL, 1, -211, 0, -211};
+static const struct _convrule_ rule67={GENCAT_LL, NUMCAT_LL, 1, -202, 0, -202};
+static const struct _convrule_ rule47={GENCAT_LU, NUMCAT_LU, 1, 0, 2, 1};
+static const struct _convrule_ rule37={GENCAT_LU, NUMCAT_LU, 1, 0, 209, 0};
+static const struct _convrule_ rule156={GENCAT_LU, NUMCAT_LU, 1, 0, -10749, 0};
+static const struct _convrule_ rule64={GENCAT_LL, NUMCAT_LL, 1, -210, 0, -210};
+static const struct _convrule_ rule44={GENCAT_LU, NUMCAT_LU, 1, 0, 219, 0};
+static const struct _convrule_ rule28={GENCAT_LU, NUMCAT_LU, 1, 0, 210, 0};
+static const struct _convrule_ rule53={GENCAT_LU, NUMCAT_LU, 1, 0, -130, 0};
+static const struct _convrule_ rule165={GENCAT_LU, NUMCAT_LU, 1, 0, 40, 0};
+static const struct _convrule_ rule162={GENCAT_LU, NUMCAT_LU, 1, 0, -42280, 0};
+static const struct _convrule_ rule155={GENCAT_LU, NUMCAT_LU, 1, 0, -10780, 0};
+static const struct _convrule_ rule105={GENCAT_LU, NUMCAT_LU, 1, 0, -60, 0};
+static const struct _convrule_ rule59={GENCAT_LU, NUMCAT_LU, 1, 0, 69, 0};
+static const struct _convrule_ rule31={GENCAT_LU, NUMCAT_LU, 1, 0, 79, 0};
+static const struct _convrule_ rule27={GENCAT_LL, NUMCAT_LL, 1, 195, 0, 195};
+static const struct _convrule_ rule23={GENCAT_LU, NUMCAT_LU, 1, 0, -199, 0};
+static const struct _charblock_ allchars[]={
+	{0, 32, &rule0},
+	{32, 1, &rule1},
+	{33, 3, &rule2},
+	{36, 1, &rule3},
+	{37, 3, &rule2},
+	{40, 1, &rule4},
+	{41, 1, &rule5},
+	{42, 1, &rule2},
+	{43, 1, &rule6},
+	{44, 1, &rule2},
+	{45, 1, &rule7},
+	{46, 2, &rule2},
+	{48, 10, &rule8},
+	{58, 2, &rule2},
+	{60, 3, &rule6},
+	{63, 2, &rule2},
+	{65, 26, &rule9},
+	{91, 1, &rule4},
+	{92, 1, &rule2},
+	{93, 1, &rule5},
+	{94, 1, &rule10},
+	{95, 1, &rule11},
+	{96, 1, &rule10},
+	{97, 26, &rule12},
+	{123, 1, &rule4},
+	{124, 1, &rule6},
+	{125, 1, &rule5},
+	{126, 1, &rule6},
+	{127, 33, &rule0},
+	{160, 1, &rule1},
+	{161, 1, &rule2},
+	{162, 4, &rule3},
+	{166, 2, &rule13},
+	{168, 1, &rule10},
+	{169, 1, &rule13},
+	{170, 1, &rule14},
+	{171, 1, &rule15},
+	{172, 1, &rule6},
+	{173, 1, &rule16},
+	{174, 1, &rule13},
+	{175, 1, &rule10},
+	{176, 1, &rule13},
+	{177, 1, &rule6},
+	{178, 2, &rule17},
+	{180, 1, &rule10},
+	{181, 1, &rule18},
+	{182, 1, &rule13},
+	{183, 1, &rule2},
+	{184, 1, &rule10},
+	{185, 1, &rule17},
+	{186, 1, &rule14},
+	{187, 1, &rule19},
+	{188, 3, &rule17},
+	{191, 1, &rule2},
+	{192, 23, &rule9},
+	{215, 1, &rule6},
+	{216, 7, &rule9},
+	{223, 1, &rule14},
+	{224, 23, &rule12},
+	{247, 1, &rule6},
+	{248, 7, &rule12},
+	{255, 1, &rule20},
+	{256, 1, &rule21},
+	{257, 1, &rule22},
+	{258, 1, &rule21},
+	{259, 1, &rule22},
+	{260, 1, &rule21},
+	{261, 1, &rule22},
+	{262, 1, &rule21},
+	{263, 1, &rule22},
+	{264, 1, &rule21},
+	{265, 1, &rule22},
+	{266, 1, &rule21},
+	{267, 1, &rule22},
+	{268, 1, &rule21},
+	{269, 1, &rule22},
+	{270, 1, &rule21},
+	{271, 1, &rule22},
+	{272, 1, &rule21},
+	{273, 1, &rule22},
+	{274, 1, &rule21},
+	{275, 1, &rule22},
+	{276, 1, &rule21},
+	{277, 1, &rule22},
+	{278, 1, &rule21},
+	{279, 1, &rule22},
+	{280, 1, &rule21},
+	{281, 1, &rule22},
+	{282, 1, &rule21},
+	{283, 1, &rule22},
+	{284, 1, &rule21},
+	{285, 1, &rule22},
+	{286, 1, &rule21},
+	{287, 1, &rule22},
+	{288, 1, &rule21},
+	{289, 1, &rule22},
+	{290, 1, &rule21},
+	{291, 1, &rule22},
+	{292, 1, &rule21},
+	{293, 1, &rule22},
+	{294, 1, &rule21},
+	{295, 1, &rule22},
+	{296, 1, &rule21},
+	{297, 1, &rule22},
+	{298, 1, &rule21},
+	{299, 1, &rule22},
+	{300, 1, &rule21},
+	{301, 1, &rule22},
+	{302, 1, &rule21},
+	{303, 1, &rule22},
+	{304, 1, &rule23},
+	{305, 1, &rule24},
+	{306, 1, &rule21},
+	{307, 1, &rule22},
+	{308, 1, &rule21},
+	{309, 1, &rule22},
+	{310, 1, &rule21},
+	{311, 1, &rule22},
+	{312, 1, &rule14},
+	{313, 1, &rule21},
+	{314, 1, &rule22},
+	{315, 1, &rule21},
+	{316, 1, &rule22},
+	{317, 1, &rule21},
+	{318, 1, &rule22},
+	{319, 1, &rule21},
+	{320, 1, &rule22},
+	{321, 1, &rule21},
+	{322, 1, &rule22},
+	{323, 1, &rule21},
+	{324, 1, &rule22},
+	{325, 1, &rule21},
+	{326, 1, &rule22},
+	{327, 1, &rule21},
+	{328, 1, &rule22},
+	{329, 1, &rule14},
+	{330, 1, &rule21},
+	{331, 1, &rule22},
+	{332, 1, &rule21},
+	{333, 1, &rule22},
+	{334, 1, &rule21},
+	{335, 1, &rule22},
+	{336, 1, &rule21},
+	{337, 1, &rule22},
+	{338, 1, &rule21},
+	{339, 1, &rule22},
+	{340, 1, &rule21},
+	{341, 1, &rule22},
+	{342, 1, &rule21},
+	{343, 1, &rule22},
+	{344, 1, &rule21},
+	{345, 1, &rule22},
+	{346, 1, &rule21},
+	{347, 1, &rule22},
+	{348, 1, &rule21},
+	{349, 1, &rule22},
+	{350, 1, &rule21},
+	{351, 1, &rule22},
+	{352, 1, &rule21},
+	{353, 1, &rule22},
+	{354, 1, &rule21},
+	{355, 1, &rule22},
+	{356, 1, &rule21},
+	{357, 1, &rule22},
+	{358, 1, &rule21},
+	{359, 1, &rule22},
+	{360, 1, &rule21},
+	{361, 1, &rule22},
+	{362, 1, &rule21},
+	{363, 1, &rule22},
+	{364, 1, &rule21},
+	{365, 1, &rule22},
+	{366, 1, &rule21},
+	{367, 1, &rule22},
+	{368, 1, &rule21},
+	{369, 1, &rule22},
+	{370, 1, &rule21},
+	{371, 1, &rule22},
+	{372, 1, &rule21},
+	{373, 1, &rule22},
+	{374, 1, &rule21},
+	{375, 1, &rule22},
+	{376, 1, &rule25},
+	{377, 1, &rule21},
+	{378, 1, &rule22},
+	{379, 1, &rule21},
+	{380, 1, &rule22},
+	{381, 1, &rule21},
+	{382, 1, &rule22},
+	{383, 1, &rule26},
+	{384, 1, &rule27},
+	{385, 1, &rule28},
+	{386, 1, &rule21},
+	{387, 1, &rule22},
+	{388, 1, &rule21},
+	{389, 1, &rule22},
+	{390, 1, &rule29},
+	{391, 1, &rule21},
+	{392, 1, &rule22},
+	{393, 2, &rule30},
+	{395, 1, &rule21},
+	{396, 1, &rule22},
+	{397, 1, &rule14},
+	{398, 1, &rule31},
+	{399, 1, &rule32},
+	{400, 1, &rule33},
+	{401, 1, &rule21},
+	{402, 1, &rule22},
+	{403, 1, &rule30},
+	{404, 1, &rule34},
+	{405, 1, &rule35},
+	{406, 1, &rule36},
+	{407, 1, &rule37},
+	{408, 1, &rule21},
+	{409, 1, &rule22},
+	{410, 1, &rule38},
+	{411, 1, &rule14},
+	{412, 1, &rule36},
+	{413, 1, &rule39},
+	{414, 1, &rule40},
+	{415, 1, &rule41},
+	{416, 1, &rule21},
+	{417, 1, &rule22},
+	{418, 1, &rule21},
+	{419, 1, &rule22},
+	{420, 1, &rule21},
+	{421, 1, &rule22},
+	{422, 1, &rule42},
+	{423, 1, &rule21},
+	{424, 1, &rule22},
+	{425, 1, &rule42},
+	{426, 2, &rule14},
+	{428, 1, &rule21},
+	{429, 1, &rule22},
+	{430, 1, &rule42},
+	{431, 1, &rule21},
+	{432, 1, &rule22},
+	{433, 2, &rule43},
+	{435, 1, &rule21},
+	{436, 1, &rule22},
+	{437, 1, &rule21},
+	{438, 1, &rule22},
+	{439, 1, &rule44},
+	{440, 1, &rule21},
+	{441, 1, &rule22},
+	{442, 1, &rule14},
+	{443, 1, &rule45},
+	{444, 1, &rule21},
+	{445, 1, &rule22},
+	{446, 1, &rule14},
+	{447, 1, &rule46},
+	{448, 4, &rule45},
+	{452, 1, &rule47},
+	{453, 1, &rule48},
+	{454, 1, &rule49},
+	{455, 1, &rule47},
+	{456, 1, &rule48},
+	{457, 1, &rule49},
+	{458, 1, &rule47},
+	{459, 1, &rule48},
+	{460, 1, &rule49},
+	{461, 1, &rule21},
+	{462, 1, &rule22},
+	{463, 1, &rule21},
+	{464, 1, &rule22},
+	{465, 1, &rule21},
+	{466, 1, &rule22},
+	{467, 1, &rule21},
+	{468, 1, &rule22},
+	{469, 1, &rule21},
+	{470, 1, &rule22},
+	{471, 1, &rule21},
+	{472, 1, &rule22},
+	{473, 1, &rule21},
+	{474, 1, &rule22},
+	{475, 1, &rule21},
+	{476, 1, &rule22},
+	{477, 1, &rule50},
+	{478, 1, &rule21},
+	{479, 1, &rule22},
+	{480, 1, &rule21},
+	{481, 1, &rule22},
+	{482, 1, &rule21},
+	{483, 1, &rule22},
+	{484, 1, &rule21},
+	{485, 1, &rule22},
+	{486, 1, &rule21},
+	{487, 1, &rule22},
+	{488, 1, &rule21},
+	{489, 1, &rule22},
+	{490, 1, &rule21},
+	{491, 1, &rule22},
+	{492, 1, &rule21},
+	{493, 1, &rule22},
+	{494, 1, &rule21},
+	{495, 1, &rule22},
+	{496, 1, &rule14},
+	{497, 1, &rule47},
+	{498, 1, &rule48},
+	{499, 1, &rule49},
+	{500, 1, &rule21},
+	{501, 1, &rule22},
+	{502, 1, &rule51},
+	{503, 1, &rule52},
+	{504, 1, &rule21},
+	{505, 1, &rule22},
+	{506, 1, &rule21},
+	{507, 1, &rule22},
+	{508, 1, &rule21},
+	{509, 1, &rule22},
+	{510, 1, &rule21},
+	{511, 1, &rule22},
+	{512, 1, &rule21},
+	{513, 1, &rule22},
+	{514, 1, &rule21},
+	{515, 1, &rule22},
+	{516, 1, &rule21},
+	{517, 1, &rule22},
+	{518, 1, &rule21},
+	{519, 1, &rule22},
+	{520, 1, &rule21},
+	{521, 1, &rule22},
+	{522, 1, &rule21},
+	{523, 1, &rule22},
+	{524, 1, &rule21},
+	{525, 1, &rule22},
+	{526, 1, &rule21},
+	{527, 1, &rule22},
+	{528, 1, &rule21},
+	{529, 1, &rule22},
+	{530, 1, &rule21},
+	{531, 1, &rule22},
+	{532, 1, &rule21},
+	{533, 1, &rule22},
+	{534, 1, &rule21},
+	{535, 1, &rule22},
+	{536, 1, &rule21},
+	{537, 1, &rule22},
+	{538, 1, &rule21},
+	{539, 1, &rule22},
+	{540, 1, &rule21},
+	{541, 1, &rule22},
+	{542, 1, &rule21},
+	{543, 1, &rule22},
+	{544, 1, &rule53},
+	{545, 1, &rule14},
+	{546, 1, &rule21},
+	{547, 1, &rule22},
+	{548, 1, &rule21},
+	{549, 1, &rule22},
+	{550, 1, &rule21},
+	{551, 1, &rule22},
+	{552, 1, &rule21},
+	{553, 1, &rule22},
+	{554, 1, &rule21},
+	{555, 1, &rule22},
+	{556, 1, &rule21},
+	{557, 1, &rule22},
+	{558, 1, &rule21},
+	{559, 1, &rule22},
+	{560, 1, &rule21},
+	{561, 1, &rule22},
+	{562, 1, &rule21},
+	{563, 1, &rule22},
+	{564, 6, &rule14},
+	{570, 1, &rule54},
+	{571, 1, &rule21},
+	{572, 1, &rule22},
+	{573, 1, &rule55},
+	{574, 1, &rule56},
+	{575, 2, &rule57},
+	{577, 1, &rule21},
+	{578, 1, &rule22},
+	{579, 1, &rule58},
+	{580, 1, &rule59},
+	{581, 1, &rule60},
+	{582, 1, &rule21},
+	{583, 1, &rule22},
+	{584, 1, &rule21},
+	{585, 1, &rule22},
+	{586, 1, &rule21},
+	{587, 1, &rule22},
+	{588, 1, &rule21},
+	{589, 1, &rule22},
+	{590, 1, &rule21},
+	{591, 1, &rule22},
+	{592, 1, &rule61},
+	{593, 1, &rule62},
+	{594, 1, &rule63},
+	{595, 1, &rule64},
+	{596, 1, &rule65},
+	{597, 1, &rule14},
+	{598, 2, &rule66},
+	{600, 1, &rule14},
+	{601, 1, &rule67},
+	{602, 1, &rule14},
+	{603, 1, &rule68},
+	{604, 4, &rule14},
+	{608, 1, &rule66},
+	{609, 2, &rule14},
+	{611, 1, &rule69},
+	{612, 1, &rule14},
+	{613, 1, &rule70},
+	{614, 2, &rule14},
+	{616, 1, &rule71},
+	{617, 1, &rule72},
+	{618, 1, &rule14},
+	{619, 1, &rule73},
+	{620, 3, &rule14},
+	{623, 1, &rule72},
+	{624, 1, &rule14},
+	{625, 1, &rule74},
+	{626, 1, &rule75},
+	{627, 2, &rule14},
+	{629, 1, &rule76},
+	{630, 7, &rule14},
+	{637, 1, &rule77},
+	{638, 2, &rule14},
+	{640, 1, &rule78},
+	{641, 2, &rule14},
+	{643, 1, &rule78},
+	{644, 4, &rule14},
+	{648, 1, &rule78},
+	{649, 1, &rule79},
+	{650, 2, &rule80},
+	{652, 1, &rule81},
+	{653, 5, &rule14},
+	{658, 1, &rule82},
+	{659, 1, &rule14},
+	{660, 1, &rule45},
+	{661, 27, &rule14},
+	{688, 18, &rule83},
+	{706, 4, &rule10},
+	{710, 12, &rule83},
+	{722, 14, &rule10},
+	{736, 5, &rule83},
+	{741, 7, &rule10},
+	{748, 1, &rule83},
+	{749, 1, &rule10},
+	{750, 1, &rule83},
+	{751, 17, &rule10},
+	{768, 69, &rule84},
+	{837, 1, &rule85},
+	{838, 42, &rule84},
+	{880, 1, &rule21},
+	{881, 1, &rule22},
+	{882, 1, &rule21},
+	{883, 1, &rule22},
+	{884, 1, &rule83},
+	{885, 1, &rule10},
+	{886, 1, &rule21},
+	{887, 1, &rule22},
+	{890, 1, &rule83},
+	{891, 3, &rule40},
+	{894, 1, &rule2},
+	{900, 2, &rule10},
+	{902, 1, &rule86},
+	{903, 1, &rule2},
+	{904, 3, &rule87},
+	{908, 1, &rule88},
+	{910, 2, &rule89},
+	{912, 1, &rule14},
+	{913, 17, &rule9},
+	{931, 9, &rule9},
+	{940, 1, &rule90},
+	{941, 3, &rule91},
+	{944, 1, &rule14},
+	{945, 17, &rule12},
+	{962, 1, &rule92},
+	{963, 9, &rule12},
+	{972, 1, &rule93},
+	{973, 2, &rule94},
+	{975, 1, &rule95},
+	{976, 1, &rule96},
+	{977, 1, &rule97},
+	{978, 3, &rule98},
+	{981, 1, &rule99},
+	{982, 1, &rule100},
+	{983, 1, &rule101},
+	{984, 1, &rule21},
+	{985, 1, &rule22},
+	{986, 1, &rule21},
+	{987, 1, &rule22},
+	{988, 1, &rule21},
+	{989, 1, &rule22},
+	{990, 1, &rule21},
+	{991, 1, &rule22},
+	{992, 1, &rule21},
+	{993, 1, &rule22},
+	{994, 1, &rule21},
+	{995, 1, &rule22},
+	{996, 1, &rule21},
+	{997, 1, &rule22},
+	{998, 1, &rule21},
+	{999, 1, &rule22},
+	{1000, 1, &rule21},
+	{1001, 1, &rule22},
+	{1002, 1, &rule21},
+	{1003, 1, &rule22},
+	{1004, 1, &rule21},
+	{1005, 1, &rule22},
+	{1006, 1, &rule21},
+	{1007, 1, &rule22},
+	{1008, 1, &rule102},
+	{1009, 1, &rule103},
+	{1010, 1, &rule104},
+	{1011, 1, &rule14},
+	{1012, 1, &rule105},
+	{1013, 1, &rule106},
+	{1014, 1, &rule6},
+	{1015, 1, &rule21},
+	{1016, 1, &rule22},
+	{1017, 1, &rule107},
+	{1018, 1, &rule21},
+	{1019, 1, &rule22},
+	{1020, 1, &rule14},
+	{1021, 3, &rule53},
+	{1024, 16, &rule108},
+	{1040, 32, &rule9},
+	{1072, 32, &rule12},
+	{1104, 16, &rule103},
+	{1120, 1, &rule21},
+	{1121, 1, &rule22},
+	{1122, 1, &rule21},
+	{1123, 1, &rule22},
+	{1124, 1, &rule21},
+	{1125, 1, &rule22},
+	{1126, 1, &rule21},
+	{1127, 1, &rule22},
+	{1128, 1, &rule21},
+	{1129, 1, &rule22},
+	{1130, 1, &rule21},
+	{1131, 1, &rule22},
+	{1132, 1, &rule21},
+	{1133, 1, &rule22},
+	{1134, 1, &rule21},
+	{1135, 1, &rule22},
+	{1136, 1, &rule21},
+	{1137, 1, &rule22},
+	{1138, 1, &rule21},
+	{1139, 1, &rule22},
+	{1140, 1, &rule21},
+	{1141, 1, &rule22},
+	{1142, 1, &rule21},
+	{1143, 1, &rule22},
+	{1144, 1, &rule21},
+	{1145, 1, &rule22},
+	{1146, 1, &rule21},
+	{1147, 1, &rule22},
+	{1148, 1, &rule21},
+	{1149, 1, &rule22},
+	{1150, 1, &rule21},
+	{1151, 1, &rule22},
+	{1152, 1, &rule21},
+	{1153, 1, &rule22},
+	{1154, 1, &rule13},
+	{1155, 5, &rule84},
+	{1160, 2, &rule109},
+	{1162, 1, &rule21},
+	{1163, 1, &rule22},
+	{1164, 1, &rule21},
+	{1165, 1, &rule22},
+	{1166, 1, &rule21},
+	{1167, 1, &rule22},
+	{1168, 1, &rule21},
+	{1169, 1, &rule22},
+	{1170, 1, &rule21},
+	{1171, 1, &rule22},
+	{1172, 1, &rule21},
+	{1173, 1, &rule22},
+	{1174, 1, &rule21},
+	{1175, 1, &rule22},
+	{1176, 1, &rule21},
+	{1177, 1, &rule22},
+	{1178, 1, &rule21},
+	{1179, 1, &rule22},
+	{1180, 1, &rule21},
+	{1181, 1, &rule22},
+	{1182, 1, &rule21},
+	{1183, 1, &rule22},
+	{1184, 1, &rule21},
+	{1185, 1, &rule22},
+	{1186, 1, &rule21},
+	{1187, 1, &rule22},
+	{1188, 1, &rule21},
+	{1189, 1, &rule22},
+	{1190, 1, &rule21},
+	{1191, 1, &rule22},
+	{1192, 1, &rule21},
+	{1193, 1, &rule22},
+	{1194, 1, &rule21},
+	{1195, 1, &rule22},
+	{1196, 1, &rule21},
+	{1197, 1, &rule22},
+	{1198, 1, &rule21},
+	{1199, 1, &rule22},
+	{1200, 1, &rule21},
+	{1201, 1, &rule22},
+	{1202, 1, &rule21},
+	{1203, 1, &rule22},
+	{1204, 1, &rule21},
+	{1205, 1, &rule22},
+	{1206, 1, &rule21},
+	{1207, 1, &rule22},
+	{1208, 1, &rule21},
+	{1209, 1, &rule22},
+	{1210, 1, &rule21},
+	{1211, 1, &rule22},
+	{1212, 1, &rule21},
+	{1213, 1, &rule22},
+	{1214, 1, &rule21},
+	{1215, 1, &rule22},
+	{1216, 1, &rule110},
+	{1217, 1, &rule21},
+	{1218, 1, &rule22},
+	{1219, 1, &rule21},
+	{1220, 1, &rule22},
+	{1221, 1, &rule21},
+	{1222, 1, &rule22},
+	{1223, 1, &rule21},
+	{1224, 1, &rule22},
+	{1225, 1, &rule21},
+	{1226, 1, &rule22},
+	{1227, 1, &rule21},
+	{1228, 1, &rule22},
+	{1229, 1, &rule21},
+	{1230, 1, &rule22},
+	{1231, 1, &rule111},
+	{1232, 1, &rule21},
+	{1233, 1, &rule22},
+	{1234, 1, &rule21},
+	{1235, 1, &rule22},
+	{1236, 1, &rule21},
+	{1237, 1, &rule22},
+	{1238, 1, &rule21},
+	{1239, 1, &rule22},
+	{1240, 1, &rule21},
+	{1241, 1, &rule22},
+	{1242, 1, &rule21},
+	{1243, 1, &rule22},
+	{1244, 1, &rule21},
+	{1245, 1, &rule22},
+	{1246, 1, &rule21},
+	{1247, 1, &rule22},
+	{1248, 1, &rule21},
+	{1249, 1, &rule22},
+	{1250, 1, &rule21},
+	{1251, 1, &rule22},
+	{1252, 1, &rule21},
+	{1253, 1, &rule22},
+	{1254, 1, &rule21},
+	{1255, 1, &rule22},
+	{1256, 1, &rule21},
+	{1257, 1, &rule22},
+	{1258, 1, &rule21},
+	{1259, 1, &rule22},
+	{1260, 1, &rule21},
+	{1261, 1, &rule22},
+	{1262, 1, &rule21},
+	{1263, 1, &rule22},
+	{1264, 1, &rule21},
+	{1265, 1, &rule22},
+	{1266, 1, &rule21},
+	{1267, 1, &rule22},
+	{1268, 1, &rule21},
+	{1269, 1, &rule22},
+	{1270, 1, &rule21},
+	{1271, 1, &rule22},
+	{1272, 1, &rule21},
+	{1273, 1, &rule22},
+	{1274, 1, &rule21},
+	{1275, 1, &rule22},
+	{1276, 1, &rule21},
+	{1277, 1, &rule22},
+	{1278, 1, &rule21},
+	{1279, 1, &rule22},
+	{1280, 1, &rule21},
+	{1281, 1, &rule22},
+	{1282, 1, &rule21},
+	{1283, 1, &rule22},
+	{1284, 1, &rule21},
+	{1285, 1, &rule22},
+	{1286, 1, &rule21},
+	{1287, 1, &rule22},
+	{1288, 1, &rule21},
+	{1289, 1, &rule22},
+	{1290, 1, &rule21},
+	{1291, 1, &rule22},
+	{1292, 1, &rule21},
+	{1293, 1, &rule22},
+	{1294, 1, &rule21},
+	{1295, 1, &rule22},
+	{1296, 1, &rule21},
+	{1297, 1, &rule22},
+	{1298, 1, &rule21},
+	{1299, 1, &rule22},
+	{1300, 1, &rule21},
+	{1301, 1, &rule22},
+	{1302, 1, &rule21},
+	{1303, 1, &rule22},
+	{1304, 1, &rule21},
+	{1305, 1, &rule22},
+	{1306, 1, &rule21},
+	{1307, 1, &rule22},
+	{1308, 1, &rule21},
+	{1309, 1, &rule22},
+	{1310, 1, &rule21},
+	{1311, 1, &rule22},
+	{1312, 1, &rule21},
+	{1313, 1, &rule22},
+	{1314, 1, &rule21},
+	{1315, 1, &rule22},
+	{1316, 1, &rule21},
+	{1317, 1, &rule22},
+	{1318, 1, &rule21},
+	{1319, 1, &rule22},
+	{1329, 38, &rule112},
+	{1369, 1, &rule83},
+	{1370, 6, &rule2},
+	{1377, 38, &rule113},
+	{1415, 1, &rule14},
+	{1417, 1, &rule2},
+	{1418, 1, &rule7},
+	{1425, 45, &rule84},
+	{1470, 1, &rule7},
+	{1471, 1, &rule84},
+	{1472, 1, &rule2},
+	{1473, 2, &rule84},
+	{1475, 1, &rule2},
+	{1476, 2, &rule84},
+	{1478, 1, &rule2},
+	{1479, 1, &rule84},
+	{1488, 27, &rule45},
+	{1520, 3, &rule45},
+	{1523, 2, &rule2},
+	{1536, 4, &rule16},
+	{1542, 3, &rule6},
+	{1545, 2, &rule2},
+	{1547, 1, &rule3},
+	{1548, 2, &rule2},
+	{1550, 2, &rule13},
+	{1552, 11, &rule84},
+	{1563, 1, &rule2},
+	{1566, 2, &rule2},
+	{1568, 32, &rule45},
+	{1600, 1, &rule83},
+	{1601, 10, &rule45},
+	{1611, 21, &rule84},
+	{1632, 10, &rule8},
+	{1642, 4, &rule2},
+	{1646, 2, &rule45},
+	{1648, 1, &rule84},
+	{1649, 99, &rule45},
+	{1748, 1, &rule2},
+	{1749, 1, &rule45},
+	{1750, 7, &rule84},
+	{1757, 1, &rule16},
+	{1758, 1, &rule13},
+	{1759, 6, &rule84},
+	{1765, 2, &rule83},
+	{1767, 2, &rule84},
+	{1769, 1, &rule13},
+	{1770, 4, &rule84},
+	{1774, 2, &rule45},
+	{1776, 10, &rule8},
+	{1786, 3, &rule45},
+	{1789, 2, &rule13},
+	{1791, 1, &rule45},
+	{1792, 14, &rule2},
+	{1807, 1, &rule16},
+	{1808, 1, &rule45},
+	{1809, 1, &rule84},
+	{1810, 30, &rule45},
+	{1840, 27, &rule84},
+	{1869, 89, &rule45},
+	{1958, 11, &rule84},
+	{1969, 1, &rule45},
+	{1984, 10, &rule8},
+	{1994, 33, &rule45},
+	{2027, 9, &rule84},
+	{2036, 2, &rule83},
+	{2038, 1, &rule13},
+	{2039, 3, &rule2},
+	{2042, 1, &rule83},
+	{2048, 22, &rule45},
+	{2070, 4, &rule84},
+	{2074, 1, &rule83},
+	{2075, 9, &rule84},
+	{2084, 1, &rule83},
+	{2085, 3, &rule84},
+	{2088, 1, &rule83},
+	{2089, 5, &rule84},
+	{2096, 15, &rule2},
+	{2112, 25, &rule45},
+	{2137, 3, &rule84},
+	{2142, 1, &rule2},
+	{2304, 3, &rule84},
+	{2307, 1, &rule114},
+	{2308, 54, &rule45},
+	{2362, 1, &rule84},
+	{2363, 1, &rule114},
+	{2364, 1, &rule84},
+	{2365, 1, &rule45},
+	{2366, 3, &rule114},
+	{2369, 8, &rule84},
+	{2377, 4, &rule114},
+	{2381, 1, &rule84},
+	{2382, 2, &rule114},
+	{2384, 1, &rule45},
+	{2385, 7, &rule84},
+	{2392, 10, &rule45},
+	{2402, 2, &rule84},
+	{2404, 2, &rule2},
+	{2406, 10, &rule8},
+	{2416, 1, &rule2},
+	{2417, 1, &rule83},
+	{2418, 6, &rule45},
+	{2425, 7, &rule45},
+	{2433, 1, &rule84},
+	{2434, 2, &rule114},
+	{2437, 8, &rule45},
+	{2447, 2, &rule45},
+	{2451, 22, &rule45},
+	{2474, 7, &rule45},
+	{2482, 1, &rule45},
+	{2486, 4, &rule45},
+	{2492, 1, &rule84},
+	{2493, 1, &rule45},
+	{2494, 3, &rule114},
+	{2497, 4, &rule84},
+	{2503, 2, &rule114},
+	{2507, 2, &rule114},
+	{2509, 1, &rule84},
+	{2510, 1, &rule45},
+	{2519, 1, &rule114},
+	{2524, 2, &rule45},
+	{2527, 3, &rule45},
+	{2530, 2, &rule84},
+	{2534, 10, &rule8},
+	{2544, 2, &rule45},
+	{2546, 2, &rule3},
+	{2548, 6, &rule17},
+	{2554, 1, &rule13},
+	{2555, 1, &rule3},
+	{2561, 2, &rule84},
+	{2563, 1, &rule114},
+	{2565, 6, &rule45},
+	{2575, 2, &rule45},
+	{2579, 22, &rule45},
+	{2602, 7, &rule45},
+	{2610, 2, &rule45},
+	{2613, 2, &rule45},
+	{2616, 2, &rule45},
+	{2620, 1, &rule84},
+	{2622, 3, &rule114},
+	{2625, 2, &rule84},
+	{2631, 2, &rule84},
+	{2635, 3, &rule84},
+	{2641, 1, &rule84},
+	{2649, 4, &rule45},
+	{2654, 1, &rule45},
+	{2662, 10, &rule8},
+	{2672, 2, &rule84},
+	{2674, 3, &rule45},
+	{2677, 1, &rule84},
+	{2689, 2, &rule84},
+	{2691, 1, &rule114},
+	{2693, 9, &rule45},
+	{2703, 3, &rule45},
+	{2707, 22, &rule45},
+	{2730, 7, &rule45},
+	{2738, 2, &rule45},
+	{2741, 5, &rule45},
+	{2748, 1, &rule84},
+	{2749, 1, &rule45},
+	{2750, 3, &rule114},
+	{2753, 5, &rule84},
+	{2759, 2, &rule84},
+	{2761, 1, &rule114},
+	{2763, 2, &rule114},
+	{2765, 1, &rule84},
+	{2768, 1, &rule45},
+	{2784, 2, &rule45},
+	{2786, 2, &rule84},
+	{2790, 10, &rule8},
+	{2801, 1, &rule3},
+	{2817, 1, &rule84},
+	{2818, 2, &rule114},
+	{2821, 8, &rule45},
+	{2831, 2, &rule45},
+	{2835, 22, &rule45},
+	{2858, 7, &rule45},
+	{2866, 2, &rule45},
+	{2869, 5, &rule45},
+	{2876, 1, &rule84},
+	{2877, 1, &rule45},
+	{2878, 1, &rule114},
+	{2879, 1, &rule84},
+	{2880, 1, &rule114},
+	{2881, 4, &rule84},
+	{2887, 2, &rule114},
+	{2891, 2, &rule114},
+	{2893, 1, &rule84},
+	{2902, 1, &rule84},
+	{2903, 1, &rule114},
+	{2908, 2, &rule45},
+	{2911, 3, &rule45},
+	{2914, 2, &rule84},
+	{2918, 10, &rule8},
+	{2928, 1, &rule13},
+	{2929, 1, &rule45},
+	{2930, 6, &rule17},
+	{2946, 1, &rule84},
+	{2947, 1, &rule45},
+	{2949, 6, &rule45},
+	{2958, 3, &rule45},
+	{2962, 4, &rule45},
+	{2969, 2, &rule45},
+	{2972, 1, &rule45},
+	{2974, 2, &rule45},
+	{2979, 2, &rule45},
+	{2984, 3, &rule45},
+	{2990, 12, &rule45},
+	{3006, 2, &rule114},
+	{3008, 1, &rule84},
+	{3009, 2, &rule114},
+	{3014, 3, &rule114},
+	{3018, 3, &rule114},
+	{3021, 1, &rule84},
+	{3024, 1, &rule45},
+	{3031, 1, &rule114},
+	{3046, 10, &rule8},
+	{3056, 3, &rule17},
+	{3059, 6, &rule13},
+	{3065, 1, &rule3},
+	{3066, 1, &rule13},
+	{3073, 3, &rule114},
+	{3077, 8, &rule45},
+	{3086, 3, &rule45},
+	{3090, 23, &rule45},
+	{3114, 10, &rule45},
+	{3125, 5, &rule45},
+	{3133, 1, &rule45},
+	{3134, 3, &rule84},
+	{3137, 4, &rule114},
+	{3142, 3, &rule84},
+	{3146, 4, &rule84},
+	{3157, 2, &rule84},
+	{3160, 2, &rule45},
+	{3168, 2, &rule45},
+	{3170, 2, &rule84},
+	{3174, 10, &rule8},
+	{3192, 7, &rule17},
+	{3199, 1, &rule13},
+	{3202, 2, &rule114},
+	{3205, 8, &rule45},
+	{3214, 3, &rule45},
+	{3218, 23, &rule45},
+	{3242, 10, &rule45},
+	{3253, 5, &rule45},
+	{3260, 1, &rule84},
+	{3261, 1, &rule45},
+	{3262, 1, &rule114},
+	{3263, 1, &rule84},
+	{3264, 5, &rule114},
+	{3270, 1, &rule84},
+	{3271, 2, &rule114},
+	{3274, 2, &rule114},
+	{3276, 2, &rule84},
+	{3285, 2, &rule114},
+	{3294, 1, &rule45},
+	{3296, 2, &rule45},
+	{3298, 2, &rule84},
+	{3302, 10, &rule8},
+	{3313, 2, &rule45},
+	{3330, 2, &rule114},
+	{3333, 8, &rule45},
+	{3342, 3, &rule45},
+	{3346, 41, &rule45},
+	{3389, 1, &rule45},
+	{3390, 3, &rule114},
+	{3393, 4, &rule84},
+	{3398, 3, &rule114},
+	{3402, 3, &rule114},
+	{3405, 1, &rule84},
+	{3406, 1, &rule45},
+	{3415, 1, &rule114},
+	{3424, 2, &rule45},
+	{3426, 2, &rule84},
+	{3430, 10, &rule8},
+	{3440, 6, &rule17},
+	{3449, 1, &rule13},
+	{3450, 6, &rule45},
+	{3458, 2, &rule114},
+	{3461, 18, &rule45},
+	{3482, 24, &rule45},
+	{3507, 9, &rule45},
+	{3517, 1, &rule45},
+	{3520, 7, &rule45},
+	{3530, 1, &rule84},
+	{3535, 3, &rule114},
+	{3538, 3, &rule84},
+	{3542, 1, &rule84},
+	{3544, 8, &rule114},
+	{3570, 2, &rule114},
+	{3572, 1, &rule2},
+	{3585, 48, &rule45},
+	{3633, 1, &rule84},
+	{3634, 2, &rule45},
+	{3636, 7, &rule84},
+	{3647, 1, &rule3},
+	{3648, 6, &rule45},
+	{3654, 1, &rule83},
+	{3655, 8, &rule84},
+	{3663, 1, &rule2},
+	{3664, 10, &rule8},
+	{3674, 2, &rule2},
+	{3713, 2, &rule45},
+	{3716, 1, &rule45},
+	{3719, 2, &rule45},
+	{3722, 1, &rule45},
+	{3725, 1, &rule45},
+	{3732, 4, &rule45},
+	{3737, 7, &rule45},
+	{3745, 3, &rule45},
+	{3749, 1, &rule45},
+	{3751, 1, &rule45},
+	{3754, 2, &rule45},
+	{3757, 4, &rule45},
+	{3761, 1, &rule84},
+	{3762, 2, &rule45},
+	{3764, 6, &rule84},
+	{3771, 2, &rule84},
+	{3773, 1, &rule45},
+	{3776, 5, &rule45},
+	{3782, 1, &rule83},
+	{3784, 6, &rule84},
+	{3792, 10, &rule8},
+	{3804, 2, &rule45},
+	{3840, 1, &rule45},
+	{3841, 3, &rule13},
+	{3844, 15, &rule2},
+	{3859, 5, &rule13},
+	{3864, 2, &rule84},
+	{3866, 6, &rule13},
+	{3872, 10, &rule8},
+	{3882, 10, &rule17},
+	{3892, 1, &rule13},
+	{3893, 1, &rule84},
+	{3894, 1, &rule13},
+	{3895, 1, &rule84},
+	{3896, 1, &rule13},
+	{3897, 1, &rule84},
+	{3898, 1, &rule4},
+	{3899, 1, &rule5},
+	{3900, 1, &rule4},
+	{3901, 1, &rule5},
+	{3902, 2, &rule114},
+	{3904, 8, &rule45},
+	{3913, 36, &rule45},
+	{3953, 14, &rule84},
+	{3967, 1, &rule114},
+	{3968, 5, &rule84},
+	{3973, 1, &rule2},
+	{3974, 2, &rule84},
+	{3976, 5, &rule45},
+	{3981, 11, &rule84},
+	{3993, 36, &rule84},
+	{4030, 8, &rule13},
+	{4038, 1, &rule84},
+	{4039, 6, &rule13},
+	{4046, 2, &rule13},
+	{4048, 5, &rule2},
+	{4053, 4, &rule13},
+	{4057, 2, &rule2},
+	{4096, 43, &rule45},
+	{4139, 2, &rule114},
+	{4141, 4, &rule84},
+	{4145, 1, &rule114},
+	{4146, 6, &rule84},
+	{4152, 1, &rule114},
+	{4153, 2, &rule84},
+	{4155, 2, &rule114},
+	{4157, 2, &rule84},
+	{4159, 1, &rule45},
+	{4160, 10, &rule8},
+	{4170, 6, &rule2},
+	{4176, 6, &rule45},
+	{4182, 2, &rule114},
+	{4184, 2, &rule84},
+	{4186, 4, &rule45},
+	{4190, 3, &rule84},
+	{4193, 1, &rule45},
+	{4194, 3, &rule114},
+	{4197, 2, &rule45},
+	{4199, 7, &rule114},
+	{4206, 3, &rule45},
+	{4209, 4, &rule84},
+	{4213, 13, &rule45},
+	{4226, 1, &rule84},
+	{4227, 2, &rule114},
+	{4229, 2, &rule84},
+	{4231, 6, &rule114},
+	{4237, 1, &rule84},
+	{4238, 1, &rule45},
+	{4239, 1, &rule114},
+	{4240, 10, &rule8},
+	{4250, 3, &rule114},
+	{4253, 1, &rule84},
+	{4254, 2, &rule13},
+	{4256, 38, &rule115},
+	{4304, 43, &rule45},
+	{4347, 1, &rule2},
+	{4348, 1, &rule83},
+	{4352, 329, &rule45},
+	{4682, 4, &rule45},
+	{4688, 7, &rule45},
+	{4696, 1, &rule45},
+	{4698, 4, &rule45},
+	{4704, 41, &rule45},
+	{4746, 4, &rule45},
+	{4752, 33, &rule45},
+	{4786, 4, &rule45},
+	{4792, 7, &rule45},
+	{4800, 1, &rule45},
+	{4802, 4, &rule45},
+	{4808, 15, &rule45},
+	{4824, 57, &rule45},
+	{4882, 4, &rule45},
+	{4888, 67, &rule45},
+	{4957, 3, &rule84},
+	{4960, 1, &rule13},
+	{4961, 8, &rule2},
+	{4969, 20, &rule17},
+	{4992, 16, &rule45},
+	{5008, 10, &rule13},
+	{5024, 85, &rule45},
+	{5120, 1, &rule7},
+	{5121, 620, &rule45},
+	{5741, 2, &rule2},
+	{5743, 17, &rule45},
+	{5760, 1, &rule1},
+	{5761, 26, &rule45},
+	{5787, 1, &rule4},
+	{5788, 1, &rule5},
+	{5792, 75, &rule45},
+	{5867, 3, &rule2},
+	{5870, 3, &rule116},
+	{5888, 13, &rule45},
+	{5902, 4, &rule45},
+	{5906, 3, &rule84},
+	{5920, 18, &rule45},
+	{5938, 3, &rule84},
+	{5941, 2, &rule2},
+	{5952, 18, &rule45},
+	{5970, 2, &rule84},
+	{5984, 13, &rule45},
+	{5998, 3, &rule45},
+	{6002, 2, &rule84},
+	{6016, 52, &rule45},
+	{6068, 2, &rule16},
+	{6070, 1, &rule114},
+	{6071, 7, &rule84},
+	{6078, 8, &rule114},
+	{6086, 1, &rule84},
+	{6087, 2, &rule114},
+	{6089, 11, &rule84},
+	{6100, 3, &rule2},
+	{6103, 1, &rule83},
+	{6104, 3, &rule2},
+	{6107, 1, &rule3},
+	{6108, 1, &rule45},
+	{6109, 1, &rule84},
+	{6112, 10, &rule8},
+	{6128, 10, &rule17},
+	{6144, 6, &rule2},
+	{6150, 1, &rule7},
+	{6151, 4, &rule2},
+	{6155, 3, &rule84},
+	{6158, 1, &rule1},
+	{6160, 10, &rule8},
+	{6176, 35, &rule45},
+	{6211, 1, &rule83},
+	{6212, 52, &rule45},
+	{6272, 41, &rule45},
+	{6313, 1, &rule84},
+	{6314, 1, &rule45},
+	{6320, 70, &rule45},
+	{6400, 29, &rule45},
+	{6432, 3, &rule84},
+	{6435, 4, &rule114},
+	{6439, 2, &rule84},
+	{6441, 3, &rule114},
+	{6448, 2, &rule114},
+	{6450, 1, &rule84},
+	{6451, 6, &rule114},
+	{6457, 3, &rule84},
+	{6464, 1, &rule13},
+	{6468, 2, &rule2},
+	{6470, 10, &rule8},
+	{6480, 30, &rule45},
+	{6512, 5, &rule45},
+	{6528, 44, &rule45},
+	{6576, 17, &rule114},
+	{6593, 7, &rule45},
+	{6600, 2, &rule114},
+	{6608, 10, &rule8},
+	{6618, 1, &rule17},
+	{6622, 34, &rule13},
+	{6656, 23, &rule45},
+	{6679, 2, &rule84},
+	{6681, 3, &rule114},
+	{6686, 2, &rule2},
+	{6688, 53, &rule45},
+	{6741, 1, &rule114},
+	{6742, 1, &rule84},
+	{6743, 1, &rule114},
+	{6744, 7, &rule84},
+	{6752, 1, &rule84},
+	{6753, 1, &rule114},
+	{6754, 1, &rule84},
+	{6755, 2, &rule114},
+	{6757, 8, &rule84},
+	{6765, 6, &rule114},
+	{6771, 10, &rule84},
+	{6783, 1, &rule84},
+	{6784, 10, &rule8},
+	{6800, 10, &rule8},
+	{6816, 7, &rule2},
+	{6823, 1, &rule83},
+	{6824, 6, &rule2},
+	{6912, 4, &rule84},
+	{6916, 1, &rule114},
+	{6917, 47, &rule45},
+	{6964, 1, &rule84},
+	{6965, 1, &rule114},
+	{6966, 5, &rule84},
+	{6971, 1, &rule114},
+	{6972, 1, &rule84},
+	{6973, 5, &rule114},
+	{6978, 1, &rule84},
+	{6979, 2, &rule114},
+	{6981, 7, &rule45},
+	{6992, 10, &rule8},
+	{7002, 7, &rule2},
+	{7009, 10, &rule13},
+	{7019, 9, &rule84},
+	{7028, 9, &rule13},
+	{7040, 2, &rule84},
+	{7042, 1, &rule114},
+	{7043, 30, &rule45},
+	{7073, 1, &rule114},
+	{7074, 4, &rule84},
+	{7078, 2, &rule114},
+	{7080, 2, &rule84},
+	{7082, 1, &rule114},
+	{7086, 2, &rule45},
+	{7088, 10, &rule8},
+	{7104, 38, &rule45},
+	{7142, 1, &rule84},
+	{7143, 1, &rule114},
+	{7144, 2, &rule84},
+	{7146, 3, &rule114},
+	{7149, 1, &rule84},
+	{7150, 1, &rule114},
+	{7151, 3, &rule84},
+	{7154, 2, &rule114},
+	{7164, 4, &rule2},
+	{7168, 36, &rule45},
+	{7204, 8, &rule114},
+	{7212, 8, &rule84},
+	{7220, 2, &rule114},
+	{7222, 2, &rule84},
+	{7227, 5, &rule2},
+	{7232, 10, &rule8},
+	{7245, 3, &rule45},
+	{7248, 10, &rule8},
+	{7258, 30, &rule45},
+	{7288, 6, &rule83},
+	{7294, 2, &rule2},
+	{7376, 3, &rule84},
+	{7379, 1, &rule2},
+	{7380, 13, &rule84},
+	{7393, 1, &rule114},
+	{7394, 7, &rule84},
+	{7401, 4, &rule45},
+	{7405, 1, &rule84},
+	{7406, 4, &rule45},
+	{7410, 1, &rule114},
+	{7424, 44, &rule14},
+	{7468, 54, &rule83},
+	{7522, 22, &rule14},
+	{7544, 1, &rule83},
+	{7545, 1, &rule117},
+	{7546, 3, &rule14},
+	{7549, 1, &rule118},
+	{7550, 29, &rule14},
+	{7579, 37, &rule83},
+	{7616, 39, &rule84},
+	{7676, 4, &rule84},
+	{7680, 1, &rule21},
+	{7681, 1, &rule22},
+	{7682, 1, &rule21},
+	{7683, 1, &rule22},
+	{7684, 1, &rule21},
+	{7685, 1, &rule22},
+	{7686, 1, &rule21},
+	{7687, 1, &rule22},
+	{7688, 1, &rule21},
+	{7689, 1, &rule22},
+	{7690, 1, &rule21},
+	{7691, 1, &rule22},
+	{7692, 1, &rule21},
+	{7693, 1, &rule22},
+	{7694, 1, &rule21},
+	{7695, 1, &rule22},
+	{7696, 1, &rule21},
+	{7697, 1, &rule22},
+	{7698, 1, &rule21},
+	{7699, 1, &rule22},
+	{7700, 1, &rule21},
+	{7701, 1, &rule22},
+	{7702, 1, &rule21},
+	{7703, 1, &rule22},
+	{7704, 1, &rule21},
+	{7705, 1, &rule22},
+	{7706, 1, &rule21},
+	{7707, 1, &rule22},
+	{7708, 1, &rule21},
+	{7709, 1, &rule22},
+	{7710, 1, &rule21},
+	{7711, 1, &rule22},
+	{7712, 1, &rule21},
+	{7713, 1, &rule22},
+	{7714, 1, &rule21},
+	{7715, 1, &rule22},
+	{7716, 1, &rule21},
+	{7717, 1, &rule22},
+	{7718, 1, &rule21},
+	{7719, 1, &rule22},
+	{7720, 1, &rule21},
+	{7721, 1, &rule22},
+	{7722, 1, &rule21},
+	{7723, 1, &rule22},
+	{7724, 1, &rule21},
+	{7725, 1, &rule22},
+	{7726, 1, &rule21},
+	{7727, 1, &rule22},
+	{7728, 1, &rule21},
+	{7729, 1, &rule22},
+	{7730, 1, &rule21},
+	{7731, 1, &rule22},
+	{7732, 1, &rule21},
+	{7733, 1, &rule22},
+	{7734, 1, &rule21},
+	{7735, 1, &rule22},
+	{7736, 1, &rule21},
+	{7737, 1, &rule22},
+	{7738, 1, &rule21},
+	{7739, 1, &rule22},
+	{7740, 1, &rule21},
+	{7741, 1, &rule22},
+	{7742, 1, &rule21},
+	{7743, 1, &rule22},
+	{7744, 1, &rule21},
+	{7745, 1, &rule22},
+	{7746, 1, &rule21},
+	{7747, 1, &rule22},
+	{7748, 1, &rule21},
+	{7749, 1, &rule22},
+	{7750, 1, &rule21},
+	{7751, 1, &rule22},
+	{7752, 1, &rule21},
+	{7753, 1, &rule22},
+	{7754, 1, &rule21},
+	{7755, 1, &rule22},
+	{7756, 1, &rule21},
+	{7757, 1, &rule22},
+	{7758, 1, &rule21},
+	{7759, 1, &rule22},
+	{7760, 1, &rule21},
+	{7761, 1, &rule22},
+	{7762, 1, &rule21},
+	{7763, 1, &rule22},
+	{7764, 1, &rule21},
+	{7765, 1, &rule22},
+	{7766, 1, &rule21},
+	{7767, 1, &rule22},
+	{7768, 1, &rule21},
+	{7769, 1, &rule22},
+	{7770, 1, &rule21},
+	{7771, 1, &rule22},
+	{7772, 1, &rule21},
+	{7773, 1, &rule22},
+	{7774, 1, &rule21},
+	{7775, 1, &rule22},
+	{7776, 1, &rule21},
+	{7777, 1, &rule22},
+	{7778, 1, &rule21},
+	{7779, 1, &rule22},
+	{7780, 1, &rule21},
+	{7781, 1, &rule22},
+	{7782, 1, &rule21},
+	{7783, 1, &rule22},
+	{7784, 1, &rule21},
+	{7785, 1, &rule22},
+	{7786, 1, &rule21},
+	{7787, 1, &rule22},
+	{7788, 1, &rule21},
+	{7789, 1, &rule22},
+	{7790, 1, &rule21},
+	{7791, 1, &rule22},
+	{7792, 1, &rule21},
+	{7793, 1, &rule22},
+	{7794, 1, &rule21},
+	{7795, 1, &rule22},
+	{7796, 1, &rule21},
+	{7797, 1, &rule22},
+	{7798, 1, &rule21},
+	{7799, 1, &rule22},
+	{7800, 1, &rule21},
+	{7801, 1, &rule22},
+	{7802, 1, &rule21},
+	{7803, 1, &rule22},
+	{7804, 1, &rule21},
+	{7805, 1, &rule22},
+	{7806, 1, &rule21},
+	{7807, 1, &rule22},
+	{7808, 1, &rule21},
+	{7809, 1, &rule22},
+	{7810, 1, &rule21},
+	{7811, 1, &rule22},
+	{7812, 1, &rule21},
+	{7813, 1, &rule22},
+	{7814, 1, &rule21},
+	{7815, 1, &rule22},
+	{7816, 1, &rule21},
+	{7817, 1, &rule22},
+	{7818, 1, &rule21},
+	{7819, 1, &rule22},
+	{7820, 1, &rule21},
+	{7821, 1, &rule22},
+	{7822, 1, &rule21},
+	{7823, 1, &rule22},
+	{7824, 1, &rule21},
+	{7825, 1, &rule22},
+	{7826, 1, &rule21},
+	{7827, 1, &rule22},
+	{7828, 1, &rule21},
+	{7829, 1, &rule22},
+	{7830, 5, &rule14},
+	{7835, 1, &rule119},
+	{7836, 2, &rule14},
+	{7838, 1, &rule120},
+	{7839, 1, &rule14},
+	{7840, 1, &rule21},
+	{7841, 1, &rule22},
+	{7842, 1, &rule21},
+	{7843, 1, &rule22},
+	{7844, 1, &rule21},
+	{7845, 1, &rule22},
+	{7846, 1, &rule21},
+	{7847, 1, &rule22},
+	{7848, 1, &rule21},
+	{7849, 1, &rule22},
+	{7850, 1, &rule21},
+	{7851, 1, &rule22},
+	{7852, 1, &rule21},
+	{7853, 1, &rule22},
+	{7854, 1, &rule21},
+	{7855, 1, &rule22},
+	{7856, 1, &rule21},
+	{7857, 1, &rule22},
+	{7858, 1, &rule21},
+	{7859, 1, &rule22},
+	{7860, 1, &rule21},
+	{7861, 1, &rule22},
+	{7862, 1, &rule21},
+	{7863, 1, &rule22},
+	{7864, 1, &rule21},
+	{7865, 1, &rule22},
+	{7866, 1, &rule21},
+	{7867, 1, &rule22},
+	{7868, 1, &rule21},
+	{7869, 1, &rule22},
+	{7870, 1, &rule21},
+	{7871, 1, &rule22},
+	{7872, 1, &rule21},
+	{7873, 1, &rule22},
+	{7874, 1, &rule21},
+	{7875, 1, &rule22},
+	{7876, 1, &rule21},
+	{7877, 1, &rule22},
+	{7878, 1, &rule21},
+	{7879, 1, &rule22},
+	{7880, 1, &rule21},
+	{7881, 1, &rule22},
+	{7882, 1, &rule21},
+	{7883, 1, &rule22},
+	{7884, 1, &rule21},
+	{7885, 1, &rule22},
+	{7886, 1, &rule21},
+	{7887, 1, &rule22},
+	{7888, 1, &rule21},
+	{7889, 1, &rule22},
+	{7890, 1, &rule21},
+	{7891, 1, &rule22},
+	{7892, 1, &rule21},
+	{7893, 1, &rule22},
+	{7894, 1, &rule21},
+	{7895, 1, &rule22},
+	{7896, 1, &rule21},
+	{7897, 1, &rule22},
+	{7898, 1, &rule21},
+	{7899, 1, &rule22},
+	{7900, 1, &rule21},
+	{7901, 1, &rule22},
+	{7902, 1, &rule21},
+	{7903, 1, &rule22},
+	{7904, 1, &rule21},
+	{7905, 1, &rule22},
+	{7906, 1, &rule21},
+	{7907, 1, &rule22},
+	{7908, 1, &rule21},
+	{7909, 1, &rule22},
+	{7910, 1, &rule21},
+	{7911, 1, &rule22},
+	{7912, 1, &rule21},
+	{7913, 1, &rule22},
+	{7914, 1, &rule21},
+	{7915, 1, &rule22},
+	{7916, 1, &rule21},
+	{7917, 1, &rule22},
+	{7918, 1, &rule21},
+	{7919, 1, &rule22},
+	{7920, 1, &rule21},
+	{7921, 1, &rule22},
+	{7922, 1, &rule21},
+	{7923, 1, &rule22},
+	{7924, 1, &rule21},
+	{7925, 1, &rule22},
+	{7926, 1, &rule21},
+	{7927, 1, &rule22},
+	{7928, 1, &rule21},
+	{7929, 1, &rule22},
+	{7930, 1, &rule21},
+	{7931, 1, &rule22},
+	{7932, 1, &rule21},
+	{7933, 1, &rule22},
+	{7934, 1, &rule21},
+	{7935, 1, &rule22},
+	{7936, 8, &rule121},
+	{7944, 8, &rule122},
+	{7952, 6, &rule121},
+	{7960, 6, &rule122},
+	{7968, 8, &rule121},
+	{7976, 8, &rule122},
+	{7984, 8, &rule121},
+	{7992, 8, &rule122},
+	{8000, 6, &rule121},
+	{8008, 6, &rule122},
+	{8016, 1, &rule14},
+	{8017, 1, &rule121},
+	{8018, 1, &rule14},
+	{8019, 1, &rule121},
+	{8020, 1, &rule14},
+	{8021, 1, &rule121},
+	{8022, 1, &rule14},
+	{8023, 1, &rule121},
+	{8025, 1, &rule122},
+	{8027, 1, &rule122},
+	{8029, 1, &rule122},
+	{8031, 1, &rule122},
+	{8032, 8, &rule121},
+	{8040, 8, &rule122},
+	{8048, 2, &rule123},
+	{8050, 4, &rule124},
+	{8054, 2, &rule125},
+	{8056, 2, &rule126},
+	{8058, 2, &rule127},
+	{8060, 2, &rule128},
+	{8064, 8, &rule121},
+	{8072, 8, &rule129},
+	{8080, 8, &rule121},
+	{8088, 8, &rule129},
+	{8096, 8, &rule121},
+	{8104, 8, &rule129},
+	{8112, 2, &rule121},
+	{8114, 1, &rule14},
+	{8115, 1, &rule130},
+	{8116, 1, &rule14},
+	{8118, 2, &rule14},
+	{8120, 2, &rule122},
+	{8122, 2, &rule131},
+	{8124, 1, &rule132},
+	{8125, 1, &rule10},
+	{8126, 1, &rule133},
+	{8127, 3, &rule10},
+	{8130, 1, &rule14},
+	{8131, 1, &rule130},
+	{8132, 1, &rule14},
+	{8134, 2, &rule14},
+	{8136, 4, &rule134},
+	{8140, 1, &rule132},
+	{8141, 3, &rule10},
+	{8144, 2, &rule121},
+	{8146, 2, &rule14},
+	{8150, 2, &rule14},
+	{8152, 2, &rule122},
+	{8154, 2, &rule135},
+	{8157, 3, &rule10},
+	{8160, 2, &rule121},
+	{8162, 3, &rule14},
+	{8165, 1, &rule104},
+	{8166, 2, &rule14},
+	{8168, 2, &rule122},
+	{8170, 2, &rule136},
+	{8172, 1, &rule107},
+	{8173, 3, &rule10},
+	{8178, 1, &rule14},
+	{8179, 1, &rule130},
+	{8180, 1, &rule14},
+	{8182, 2, &rule14},
+	{8184, 2, &rule137},
+	{8186, 2, &rule138},
+	{8188, 1, &rule132},
+	{8189, 2, &rule10},
+	{8192, 11, &rule1},
+	{8203, 5, &rule16},
+	{8208, 6, &rule7},
+	{8214, 2, &rule2},
+	{8216, 1, &rule15},
+	{8217, 1, &rule19},
+	{8218, 1, &rule4},
+	{8219, 2, &rule15},
+	{8221, 1, &rule19},
+	{8222, 1, &rule4},
+	{8223, 1, &rule15},
+	{8224, 8, &rule2},
+	{8232, 1, &rule139},
+	{8233, 1, &rule140},
+	{8234, 5, &rule16},
+	{8239, 1, &rule1},
+	{8240, 9, &rule2},
+	{8249, 1, &rule15},
+	{8250, 1, &rule19},
+	{8251, 4, &rule2},
+	{8255, 2, &rule11},
+	{8257, 3, &rule2},
+	{8260, 1, &rule6},
+	{8261, 1, &rule4},
+	{8262, 1, &rule5},
+	{8263, 11, &rule2},
+	{8274, 1, &rule6},
+	{8275, 1, &rule2},
+	{8276, 1, &rule11},
+	{8277, 10, &rule2},
+	{8287, 1, &rule1},
+	{8288, 5, &rule16},
+	{8298, 6, &rule16},
+	{8304, 1, &rule17},
+	{8305, 1, &rule83},
+	{8308, 6, &rule17},
+	{8314, 3, &rule6},
+	{8317, 1, &rule4},
+	{8318, 1, &rule5},
+	{8319, 1, &rule83},
+	{8320, 10, &rule17},
+	{8330, 3, &rule6},
+	{8333, 1, &rule4},
+	{8334, 1, &rule5},
+	{8336, 13, &rule83},
+	{8352, 26, &rule3},
+	{8400, 13, &rule84},
+	{8413, 4, &rule109},
+	{8417, 1, &rule84},
+	{8418, 3, &rule109},
+	{8421, 12, &rule84},
+	{8448, 2, &rule13},
+	{8450, 1, &rule98},
+	{8451, 4, &rule13},
+	{8455, 1, &rule98},
+	{8456, 2, &rule13},
+	{8458, 1, &rule14},
+	{8459, 3, &rule98},
+	{8462, 2, &rule14},
+	{8464, 3, &rule98},
+	{8467, 1, &rule14},
+	{8468, 1, &rule13},
+	{8469, 1, &rule98},
+	{8470, 2, &rule13},
+	{8472, 1, &rule6},
+	{8473, 5, &rule98},
+	{8478, 6, &rule13},
+	{8484, 1, &rule98},
+	{8485, 1, &rule13},
+	{8486, 1, &rule141},
+	{8487, 1, &rule13},
+	{8488, 1, &rule98},
+	{8489, 1, &rule13},
+	{8490, 1, &rule142},
+	{8491, 1, &rule143},
+	{8492, 2, &rule98},
+	{8494, 1, &rule13},
+	{8495, 1, &rule14},
+	{8496, 2, &rule98},
+	{8498, 1, &rule144},
+	{8499, 1, &rule98},
+	{8500, 1, &rule14},
+	{8501, 4, &rule45},
+	{8505, 1, &rule14},
+	{8506, 2, &rule13},
+	{8508, 2, &rule14},
+	{8510, 2, &rule98},
+	{8512, 5, &rule6},
+	{8517, 1, &rule98},
+	{8518, 4, &rule14},
+	{8522, 1, &rule13},
+	{8523, 1, &rule6},
+	{8524, 2, &rule13},
+	{8526, 1, &rule145},
+	{8527, 1, &rule13},
+	{8528, 16, &rule17},
+	{8544, 16, &rule146},
+	{8560, 16, &rule147},
+	{8576, 3, &rule116},
+	{8579, 1, &rule21},
+	{8580, 1, &rule22},
+	{8581, 4, &rule116},
+	{8585, 1, &rule17},
+	{8592, 5, &rule6},
+	{8597, 5, &rule13},
+	{8602, 2, &rule6},
+	{8604, 4, &rule13},
+	{8608, 1, &rule6},
+	{8609, 2, &rule13},
+	{8611, 1, &rule6},
+	{8612, 2, &rule13},
+	{8614, 1, &rule6},
+	{8615, 7, &rule13},
+	{8622, 1, &rule6},
+	{8623, 31, &rule13},
+	{8654, 2, &rule6},
+	{8656, 2, &rule13},
+	{8658, 1, &rule6},
+	{8659, 1, &rule13},
+	{8660, 1, &rule6},
+	{8661, 31, &rule13},
+	{8692, 268, &rule6},
+	{8960, 8, &rule13},
+	{8968, 4, &rule6},
+	{8972, 20, &rule13},
+	{8992, 2, &rule6},
+	{8994, 7, &rule13},
+	{9001, 1, &rule4},
+	{9002, 1, &rule5},
+	{9003, 81, &rule13},
+	{9084, 1, &rule6},
+	{9085, 30, &rule13},
+	{9115, 25, &rule6},
+	{9140, 40, &rule13},
+	{9180, 6, &rule6},
+	{9186, 18, &rule13},
+	{9216, 39, &rule13},
+	{9280, 11, &rule13},
+	{9312, 60, &rule17},
+	{9372, 26, &rule13},
+	{9398, 26, &rule148},
+	{9424, 26, &rule149},
+	{9450, 22, &rule17},
+	{9472, 183, &rule13},
+	{9655, 1, &rule6},
+	{9656, 9, &rule13},
+	{9665, 1, &rule6},
+	{9666, 54, &rule13},
+	{9720, 8, &rule6},
+	{9728, 111, &rule13},
+	{9839, 1, &rule6},
+	{9840, 144, &rule13},
+	{9985, 103, &rule13},
+	{10088, 1, &rule4},
+	{10089, 1, &rule5},
+	{10090, 1, &rule4},
+	{10091, 1, &rule5},
+	{10092, 1, &rule4},
+	{10093, 1, &rule5},
+	{10094, 1, &rule4},
+	{10095, 1, &rule5},
+	{10096, 1, &rule4},
+	{10097, 1, &rule5},
+	{10098, 1, &rule4},
+	{10099, 1, &rule5},
+	{10100, 1, &rule4},
+	{10101, 1, &rule5},
+	{10102, 30, &rule17},
+	{10132, 44, &rule13},
+	{10176, 5, &rule6},
+	{10181, 1, &rule4},
+	{10182, 1, &rule5},
+	{10183, 4, &rule6},
+	{10188, 1, &rule6},
+	{10190, 24, &rule6},
+	{10214, 1, &rule4},
+	{10215, 1, &rule5},
+	{10216, 1, &rule4},
+	{10217, 1, &rule5},
+	{10218, 1, &rule4},
+	{10219, 1, &rule5},
+	{10220, 1, &rule4},
+	{10221, 1, &rule5},
+	{10222, 1, &rule4},
+	{10223, 1, &rule5},
+	{10224, 16, &rule6},
+	{10240, 256, &rule13},
+	{10496, 131, &rule6},
+	{10627, 1, &rule4},
+	{10628, 1, &rule5},
+	{10629, 1, &rule4},
+	{10630, 1, &rule5},
+	{10631, 1, &rule4},
+	{10632, 1, &rule5},
+	{10633, 1, &rule4},
+	{10634, 1, &rule5},
+	{10635, 1, &rule4},
+	{10636, 1, &rule5},
+	{10637, 1, &rule4},
+	{10638, 1, &rule5},
+	{10639, 1, &rule4},
+	{10640, 1, &rule5},
+	{10641, 1, &rule4},
+	{10642, 1, &rule5},
+	{10643, 1, &rule4},
+	{10644, 1, &rule5},
+	{10645, 1, &rule4},
+	{10646, 1, &rule5},
+	{10647, 1, &rule4},
+	{10648, 1, &rule5},
+	{10649, 63, &rule6},
+	{10712, 1, &rule4},
+	{10713, 1, &rule5},
+	{10714, 1, &rule4},
+	{10715, 1, &rule5},
+	{10716, 32, &rule6},
+	{10748, 1, &rule4},
+	{10749, 1, &rule5},
+	{10750, 258, &rule6},
+	{11008, 48, &rule13},
+	{11056, 21, &rule6},
+	{11077, 2, &rule13},
+	{11079, 6, &rule6},
+	{11088, 10, &rule13},
+	{11264, 47, &rule112},
+	{11312, 47, &rule113},
+	{11360, 1, &rule21},
+	{11361, 1, &rule22},
+	{11362, 1, &rule150},
+	{11363, 1, &rule151},
+	{11364, 1, &rule152},
+	{11365, 1, &rule153},
+	{11366, 1, &rule154},
+	{11367, 1, &rule21},
+	{11368, 1, &rule22},
+	{11369, 1, &rule21},
+	{11370, 1, &rule22},
+	{11371, 1, &rule21},
+	{11372, 1, &rule22},
+	{11373, 1, &rule155},
+	{11374, 1, &rule156},
+	{11375, 1, &rule157},
+	{11376, 1, &rule158},
+	{11377, 1, &rule14},
+	{11378, 1, &rule21},
+	{11379, 1, &rule22},
+	{11380, 1, &rule14},
+	{11381, 1, &rule21},
+	{11382, 1, &rule22},
+	{11383, 6, &rule14},
+	{11389, 1, &rule83},
+	{11390, 2, &rule159},
+	{11392, 1, &rule21},
+	{11393, 1, &rule22},
+	{11394, 1, &rule21},
+	{11395, 1, &rule22},
+	{11396, 1, &rule21},
+	{11397, 1, &rule22},
+	{11398, 1, &rule21},
+	{11399, 1, &rule22},
+	{11400, 1, &rule21},
+	{11401, 1, &rule22},
+	{11402, 1, &rule21},
+	{11403, 1, &rule22},
+	{11404, 1, &rule21},
+	{11405, 1, &rule22},
+	{11406, 1, &rule21},
+	{11407, 1, &rule22},
+	{11408, 1, &rule21},
+	{11409, 1, &rule22},
+	{11410, 1, &rule21},
+	{11411, 1, &rule22},
+	{11412, 1, &rule21},
+	{11413, 1, &rule22},
+	{11414, 1, &rule21},
+	{11415, 1, &rule22},
+	{11416, 1, &rule21},
+	{11417, 1, &rule22},
+	{11418, 1, &rule21},
+	{11419, 1, &rule22},
+	{11420, 1, &rule21},
+	{11421, 1, &rule22},
+	{11422, 1, &rule21},
+	{11423, 1, &rule22},
+	{11424, 1, &rule21},
+	{11425, 1, &rule22},
+	{11426, 1, &rule21},
+	{11427, 1, &rule22},
+	{11428, 1, &rule21},
+	{11429, 1, &rule22},
+	{11430, 1, &rule21},
+	{11431, 1, &rule22},
+	{11432, 1, &rule21},
+	{11433, 1, &rule22},
+	{11434, 1, &rule21},
+	{11435, 1, &rule22},
+	{11436, 1, &rule21},
+	{11437, 1, &rule22},
+	{11438, 1, &rule21},
+	{11439, 1, &rule22},
+	{11440, 1, &rule21},
+	{11441, 1, &rule22},
+	{11442, 1, &rule21},
+	{11443, 1, &rule22},
+	{11444, 1, &rule21},
+	{11445, 1, &rule22},
+	{11446, 1, &rule21},
+	{11447, 1, &rule22},
+	{11448, 1, &rule21},
+	{11449, 1, &rule22},
+	{11450, 1, &rule21},
+	{11451, 1, &rule22},
+	{11452, 1, &rule21},
+	{11453, 1, &rule22},
+	{11454, 1, &rule21},
+	{11455, 1, &rule22},
+	{11456, 1, &rule21},
+	{11457, 1, &rule22},
+	{11458, 1, &rule21},
+	{11459, 1, &rule22},
+	{11460, 1, &rule21},
+	{11461, 1, &rule22},
+	{11462, 1, &rule21},
+	{11463, 1, &rule22},
+	{11464, 1, &rule21},
+	{11465, 1, &rule22},
+	{11466, 1, &rule21},
+	{11467, 1, &rule22},
+	{11468, 1, &rule21},
+	{11469, 1, &rule22},
+	{11470, 1, &rule21},
+	{11471, 1, &rule22},
+	{11472, 1, &rule21},
+	{11473, 1, &rule22},
+	{11474, 1, &rule21},
+	{11475, 1, &rule22},
+	{11476, 1, &rule21},
+	{11477, 1, &rule22},
+	{11478, 1, &rule21},
+	{11479, 1, &rule22},
+	{11480, 1, &rule21},
+	{11481, 1, &rule22},
+	{11482, 1, &rule21},
+	{11483, 1, &rule22},
+	{11484, 1, &rule21},
+	{11485, 1, &rule22},
+	{11486, 1, &rule21},
+	{11487, 1, &rule22},
+	{11488, 1, &rule21},
+	{11489, 1, &rule22},
+	{11490, 1, &rule21},
+	{11491, 1, &rule22},
+	{11492, 1, &rule14},
+	{11493, 6, &rule13},
+	{11499, 1, &rule21},
+	{11500, 1, &rule22},
+	{11501, 1, &rule21},
+	{11502, 1, &rule22},
+	{11503, 3, &rule84},
+	{11513, 4, &rule2},
+	{11517, 1, &rule17},
+	{11518, 2, &rule2},
+	{11520, 38, &rule160},
+	{11568, 54, &rule45},
+	{11631, 1, &rule83},
+	{11632, 1, &rule2},
+	{11647, 1, &rule84},
+	{11648, 23, &rule45},
+	{11680, 7, &rule45},
+	{11688, 7, &rule45},
+	{11696, 7, &rule45},
+	{11704, 7, &rule45},
+	{11712, 7, &rule45},
+	{11720, 7, &rule45},
+	{11728, 7, &rule45},
+	{11736, 7, &rule45},
+	{11744, 32, &rule84},
+	{11776, 2, &rule2},
+	{11778, 1, &rule15},
+	{11779, 1, &rule19},
+	{11780, 1, &rule15},
+	{11781, 1, &rule19},
+	{11782, 3, &rule2},
+	{11785, 1, &rule15},
+	{11786, 1, &rule19},
+	{11787, 1, &rule2},
+	{11788, 1, &rule15},
+	{11789, 1, &rule19},
+	{11790, 9, &rule2},
+	{11799, 1, &rule7},
+	{11800, 2, &rule2},
+	{11802, 1, &rule7},
+	{11803, 1, &rule2},
+	{11804, 1, &rule15},
+	{11805, 1, &rule19},
+	{11806, 2, &rule2},
+	{11808, 1, &rule15},
+	{11809, 1, &rule19},
+	{11810, 1, &rule4},
+	{11811, 1, &rule5},
+	{11812, 1, &rule4},
+	{11813, 1, &rule5},
+	{11814, 1, &rule4},
+	{11815, 1, &rule5},
+	{11816, 1, &rule4},
+	{11817, 1, &rule5},
+	{11818, 5, &rule2},
+	{11823, 1, &rule83},
+	{11824, 2, &rule2},
+	{11904, 26, &rule13},
+	{11931, 89, &rule13},
+	{12032, 214, &rule13},
+	{12272, 12, &rule13},
+	{12288, 1, &rule1},
+	{12289, 3, &rule2},
+	{12292, 1, &rule13},
+	{12293, 1, &rule83},
+	{12294, 1, &rule45},
+	{12295, 1, &rule116},
+	{12296, 1, &rule4},
+	{12297, 1, &rule5},
+	{12298, 1, &rule4},
+	{12299, 1, &rule5},
+	{12300, 1, &rule4},
+	{12301, 1, &rule5},
+	{12302, 1, &rule4},
+	{12303, 1, &rule5},
+	{12304, 1, &rule4},
+	{12305, 1, &rule5},
+	{12306, 2, &rule13},
+	{12308, 1, &rule4},
+	{12309, 1, &rule5},
+	{12310, 1, &rule4},
+	{12311, 1, &rule5},
+	{12312, 1, &rule4},
+	{12313, 1, &rule5},
+	{12314, 1, &rule4},
+	{12315, 1, &rule5},
+	{12316, 1, &rule7},
+	{12317, 1, &rule4},
+	{12318, 2, &rule5},
+	{12320, 1, &rule13},
+	{12321, 9, &rule116},
+	{12330, 6, &rule84},
+	{12336, 1, &rule7},
+	{12337, 5, &rule83},
+	{12342, 2, &rule13},
+	{12344, 3, &rule116},
+	{12347, 1, &rule83},
+	{12348, 1, &rule45},
+	{12349, 1, &rule2},
+	{12350, 2, &rule13},
+	{12353, 86, &rule45},
+	{12441, 2, &rule84},
+	{12443, 2, &rule10},
+	{12445, 2, &rule83},
+	{12447, 1, &rule45},
+	{12448, 1, &rule7},
+	{12449, 90, &rule45},
+	{12539, 1, &rule2},
+	{12540, 3, &rule83},
+	{12543, 1, &rule45},
+	{12549, 41, &rule45},
+	{12593, 94, &rule45},
+	{12688, 2, &rule13},
+	{12690, 4, &rule17},
+	{12694, 10, &rule13},
+	{12704, 27, &rule45},
+	{12736, 36, &rule13},
+	{12784, 16, &rule45},
+	{12800, 31, &rule13},
+	{12832, 10, &rule17},
+	{12842, 39, &rule13},
+	{12881, 15, &rule17},
+	{12896, 32, &rule13},
+	{12928, 10, &rule17},
+	{12938, 39, &rule13},
+	{12977, 15, &rule17},
+	{12992, 63, &rule13},
+	{13056, 256, &rule13},
+	{13312, 6582, &rule45},
+	{19904, 64, &rule13},
+	{19968, 20940, &rule45},
+	{40960, 21, &rule45},
+	{40981, 1, &rule83},
+	{40982, 1143, &rule45},
+	{42128, 55, &rule13},
+	{42192, 40, &rule45},
+	{42232, 6, &rule83},
+	{42238, 2, &rule2},
+	{42240, 268, &rule45},
+	{42508, 1, &rule83},
+	{42509, 3, &rule2},
+	{42512, 16, &rule45},
+	{42528, 10, &rule8},
+	{42538, 2, &rule45},
+	{42560, 1, &rule21},
+	{42561, 1, &rule22},
+	{42562, 1, &rule21},
+	{42563, 1, &rule22},
+	{42564, 1, &rule21},
+	{42565, 1, &rule22},
+	{42566, 1, &rule21},
+	{42567, 1, &rule22},
+	{42568, 1, &rule21},
+	{42569, 1, &rule22},
+	{42570, 1, &rule21},
+	{42571, 1, &rule22},
+	{42572, 1, &rule21},
+	{42573, 1, &rule22},
+	{42574, 1, &rule21},
+	{42575, 1, &rule22},
+	{42576, 1, &rule21},
+	{42577, 1, &rule22},
+	{42578, 1, &rule21},
+	{42579, 1, &rule22},
+	{42580, 1, &rule21},
+	{42581, 1, &rule22},
+	{42582, 1, &rule21},
+	{42583, 1, &rule22},
+	{42584, 1, &rule21},
+	{42585, 1, &rule22},
+	{42586, 1, &rule21},
+	{42587, 1, &rule22},
+	{42588, 1, &rule21},
+	{42589, 1, &rule22},
+	{42590, 1, &rule21},
+	{42591, 1, &rule22},
+	{42592, 1, &rule21},
+	{42593, 1, &rule22},
+	{42594, 1, &rule21},
+	{42595, 1, &rule22},
+	{42596, 1, &rule21},
+	{42597, 1, &rule22},
+	{42598, 1, &rule21},
+	{42599, 1, &rule22},
+	{42600, 1, &rule21},
+	{42601, 1, &rule22},
+	{42602, 1, &rule21},
+	{42603, 1, &rule22},
+	{42604, 1, &rule21},
+	{42605, 1, &rule22},
+	{42606, 1, &rule45},
+	{42607, 1, &rule84},
+	{42608, 3, &rule109},
+	{42611, 1, &rule2},
+	{42620, 2, &rule84},
+	{42622, 1, &rule2},
+	{42623, 1, &rule83},
+	{42624, 1, &rule21},
+	{42625, 1, &rule22},
+	{42626, 1, &rule21},
+	{42627, 1, &rule22},
+	{42628, 1, &rule21},
+	{42629, 1, &rule22},
+	{42630, 1, &rule21},
+	{42631, 1, &rule22},
+	{42632, 1, &rule21},
+	{42633, 1, &rule22},
+	{42634, 1, &rule21},
+	{42635, 1, &rule22},
+	{42636, 1, &rule21},
+	{42637, 1, &rule22},
+	{42638, 1, &rule21},
+	{42639, 1, &rule22},
+	{42640, 1, &rule21},
+	{42641, 1, &rule22},
+	{42642, 1, &rule21},
+	{42643, 1, &rule22},
+	{42644, 1, &rule21},
+	{42645, 1, &rule22},
+	{42646, 1, &rule21},
+	{42647, 1, &rule22},
+	{42656, 70, &rule45},
+	{42726, 10, &rule116},
+	{42736, 2, &rule84},
+	{42738, 6, &rule2},
+	{42752, 23, &rule10},
+	{42775, 9, &rule83},
+	{42784, 2, &rule10},
+	{42786, 1, &rule21},
+	{42787, 1, &rule22},
+	{42788, 1, &rule21},
+	{42789, 1, &rule22},
+	{42790, 1, &rule21},
+	{42791, 1, &rule22},
+	{42792, 1, &rule21},
+	{42793, 1, &rule22},
+	{42794, 1, &rule21},
+	{42795, 1, &rule22},
+	{42796, 1, &rule21},
+	{42797, 1, &rule22},
+	{42798, 1, &rule21},
+	{42799, 1, &rule22},
+	{42800, 2, &rule14},
+	{42802, 1, &rule21},
+	{42803, 1, &rule22},
+	{42804, 1, &rule21},
+	{42805, 1, &rule22},
+	{42806, 1, &rule21},
+	{42807, 1, &rule22},
+	{42808, 1, &rule21},
+	{42809, 1, &rule22},
+	{42810, 1, &rule21},
+	{42811, 1, &rule22},
+	{42812, 1, &rule21},
+	{42813, 1, &rule22},
+	{42814, 1, &rule21},
+	{42815, 1, &rule22},
+	{42816, 1, &rule21},
+	{42817, 1, &rule22},
+	{42818, 1, &rule21},
+	{42819, 1, &rule22},
+	{42820, 1, &rule21},
+	{42821, 1, &rule22},
+	{42822, 1, &rule21},
+	{42823, 1, &rule22},
+	{42824, 1, &rule21},
+	{42825, 1, &rule22},
+	{42826, 1, &rule21},
+	{42827, 1, &rule22},
+	{42828, 1, &rule21},
+	{42829, 1, &rule22},
+	{42830, 1, &rule21},
+	{42831, 1, &rule22},
+	{42832, 1, &rule21},
+	{42833, 1, &rule22},
+	{42834, 1, &rule21},
+	{42835, 1, &rule22},
+	{42836, 1, &rule21},
+	{42837, 1, &rule22},
+	{42838, 1, &rule21},
+	{42839, 1, &rule22},
+	{42840, 1, &rule21},
+	{42841, 1, &rule22},
+	{42842, 1, &rule21},
+	{42843, 1, &rule22},
+	{42844, 1, &rule21},
+	{42845, 1, &rule22},
+	{42846, 1, &rule21},
+	{42847, 1, &rule22},
+	{42848, 1, &rule21},
+	{42849, 1, &rule22},
+	{42850, 1, &rule21},
+	{42851, 1, &rule22},
+	{42852, 1, &rule21},
+	{42853, 1, &rule22},
+	{42854, 1, &rule21},
+	{42855, 1, &rule22},
+	{42856, 1, &rule21},
+	{42857, 1, &rule22},
+	{42858, 1, &rule21},
+	{42859, 1, &rule22},
+	{42860, 1, &rule21},
+	{42861, 1, &rule22},
+	{42862, 1, &rule21},
+	{42863, 1, &rule22},
+	{42864, 1, &rule83},
+	{42865, 8, &rule14},
+	{42873, 1, &rule21},
+	{42874, 1, &rule22},
+	{42875, 1, &rule21},
+	{42876, 1, &rule22},
+	{42877, 1, &rule161},
+	{42878, 1, &rule21},
+	{42879, 1, &rule22},
+	{42880, 1, &rule21},
+	{42881, 1, &rule22},
+	{42882, 1, &rule21},
+	{42883, 1, &rule22},
+	{42884, 1, &rule21},
+	{42885, 1, &rule22},
+	{42886, 1, &rule21},
+	{42887, 1, &rule22},
+	{42888, 1, &rule83},
+	{42889, 2, &rule10},
+	{42891, 1, &rule21},
+	{42892, 1, &rule22},
+	{42893, 1, &rule162},
+	{42894, 1, &rule14},
+	{42896, 1, &rule21},
+	{42897, 1, &rule22},
+	{42912, 1, &rule21},
+	{42913, 1, &rule22},
+	{42914, 1, &rule21},
+	{42915, 1, &rule22},
+	{42916, 1, &rule21},
+	{42917, 1, &rule22},
+	{42918, 1, &rule21},
+	{42919, 1, &rule22},
+	{42920, 1, &rule21},
+	{42921, 1, &rule22},
+	{43002, 1, &rule14},
+	{43003, 7, &rule45},
+	{43010, 1, &rule84},
+	{43011, 3, &rule45},
+	{43014, 1, &rule84},
+	{43015, 4, &rule45},
+	{43019, 1, &rule84},
+	{43020, 23, &rule45},
+	{43043, 2, &rule114},
+	{43045, 2, &rule84},
+	{43047, 1, &rule114},
+	{43048, 4, &rule13},
+	{43056, 6, &rule17},
+	{43062, 2, &rule13},
+	{43064, 1, &rule3},
+	{43065, 1, &rule13},
+	{43072, 52, &rule45},
+	{43124, 4, &rule2},
+	{43136, 2, &rule114},
+	{43138, 50, &rule45},
+	{43188, 16, &rule114},
+	{43204, 1, &rule84},
+	{43214, 2, &rule2},
+	{43216, 10, &rule8},
+	{43232, 18, &rule84},
+	{43250, 6, &rule45},
+	{43256, 3, &rule2},
+	{43259, 1, &rule45},
+	{43264, 10, &rule8},
+	{43274, 28, &rule45},
+	{43302, 8, &rule84},
+	{43310, 2, &rule2},
+	{43312, 23, &rule45},
+	{43335, 11, &rule84},
+	{43346, 2, &rule114},
+	{43359, 1, &rule2},
+	{43360, 29, &rule45},
+	{43392, 3, &rule84},
+	{43395, 1, &rule114},
+	{43396, 47, &rule45},
+	{43443, 1, &rule84},
+	{43444, 2, &rule114},
+	{43446, 4, &rule84},
+	{43450, 2, &rule114},
+	{43452, 1, &rule84},
+	{43453, 4, &rule114},
+	{43457, 13, &rule2},
+	{43471, 1, &rule83},
+	{43472, 10, &rule8},
+	{43486, 2, &rule2},
+	{43520, 41, &rule45},
+	{43561, 6, &rule84},
+	{43567, 2, &rule114},
+	{43569, 2, &rule84},
+	{43571, 2, &rule114},
+	{43573, 2, &rule84},
+	{43584, 3, &rule45},
+	{43587, 1, &rule84},
+	{43588, 8, &rule45},
+	{43596, 1, &rule84},
+	{43597, 1, &rule114},
+	{43600, 10, &rule8},
+	{43612, 4, &rule2},
+	{43616, 16, &rule45},
+	{43632, 1, &rule83},
+	{43633, 6, &rule45},
+	{43639, 3, &rule13},
+	{43642, 1, &rule45},
+	{43643, 1, &rule114},
+	{43648, 48, &rule45},
+	{43696, 1, &rule84},
+	{43697, 1, &rule45},
+	{43698, 3, &rule84},
+	{43701, 2, &rule45},
+	{43703, 2, &rule84},
+	{43705, 5, &rule45},
+	{43710, 2, &rule84},
+	{43712, 1, &rule45},
+	{43713, 1, &rule84},
+	{43714, 1, &rule45},
+	{43739, 2, &rule45},
+	{43741, 1, &rule83},
+	{43742, 2, &rule2},
+	{43777, 6, &rule45},
+	{43785, 6, &rule45},
+	{43793, 6, &rule45},
+	{43808, 7, &rule45},
+	{43816, 7, &rule45},
+	{43968, 35, &rule45},
+	{44003, 2, &rule114},
+	{44005, 1, &rule84},
+	{44006, 2, &rule114},
+	{44008, 1, &rule84},
+	{44009, 2, &rule114},
+	{44011, 1, &rule2},
+	{44012, 1, &rule114},
+	{44013, 1, &rule84},
+	{44016, 10, &rule8},
+	{44032, 11172, &rule45},
+	{55216, 23, &rule45},
+	{55243, 49, &rule45},
+	{55296, 896, &rule163},
+	{56192, 128, &rule163},
+	{56320, 1024, &rule163},
+	{57344, 6400, &rule164},
+	{63744, 302, &rule45},
+	{64048, 62, &rule45},
+	{64112, 106, &rule45},
+	{64256, 7, &rule14},
+	{64275, 5, &rule14},
+	{64285, 1, &rule45},
+	{64286, 1, &rule84},
+	{64287, 10, &rule45},
+	{64297, 1, &rule6},
+	{64298, 13, &rule45},
+	{64312, 5, &rule45},
+	{64318, 1, &rule45},
+	{64320, 2, &rule45},
+	{64323, 2, &rule45},
+	{64326, 108, &rule45},
+	{64434, 16, &rule10},
+	{64467, 363, &rule45},
+	{64830, 1, &rule4},
+	{64831, 1, &rule5},
+	{64848, 64, &rule45},
+	{64914, 54, &rule45},
+	{65008, 12, &rule45},
+	{65020, 1, &rule3},
+	{65021, 1, &rule13},
+	{65024, 16, &rule84},
+	{65040, 7, &rule2},
+	{65047, 1, &rule4},
+	{65048, 1, &rule5},
+	{65049, 1, &rule2},
+	{65056, 7, &rule84},
+	{65072, 1, &rule2},
+	{65073, 2, &rule7},
+	{65075, 2, &rule11},
+	{65077, 1, &rule4},
+	{65078, 1, &rule5},
+	{65079, 1, &rule4},
+	{65080, 1, &rule5},
+	{65081, 1, &rule4},
+	{65082, 1, &rule5},
+	{65083, 1, &rule4},
+	{65084, 1, &rule5},
+	{65085, 1, &rule4},
+	{65086, 1, &rule5},
+	{65087, 1, &rule4},
+	{65088, 1, &rule5},
+	{65089, 1, &rule4},
+	{65090, 1, &rule5},
+	{65091, 1, &rule4},
+	{65092, 1, &rule5},
+	{65093, 2, &rule2},
+	{65095, 1, &rule4},
+	{65096, 1, &rule5},
+	{65097, 4, &rule2},
+	{65101, 3, &rule11},
+	{65104, 3, &rule2},
+	{65108, 4, &rule2},
+	{65112, 1, &rule7},
+	{65113, 1, &rule4},
+	{65114, 1, &rule5},
+	{65115, 1, &rule4},
+	{65116, 1, &rule5},
+	{65117, 1, &rule4},
+	{65118, 1, &rule5},
+	{65119, 3, &rule2},
+	{65122, 1, &rule6},
+	{65123, 1, &rule7},
+	{65124, 3, &rule6},
+	{65128, 1, &rule2},
+	{65129, 1, &rule3},
+	{65130, 2, &rule2},
+	{65136, 5, &rule45},
+	{65142, 135, &rule45},
+	{65279, 1, &rule16},
+	{65281, 3, &rule2},
+	{65284, 1, &rule3},
+	{65285, 3, &rule2},
+	{65288, 1, &rule4},
+	{65289, 1, &rule5},
+	{65290, 1, &rule2},
+	{65291, 1, &rule6},
+	{65292, 1, &rule2},
+	{65293, 1, &rule7},
+	{65294, 2, &rule2},
+	{65296, 10, &rule8},
+	{65306, 2, &rule2},
+	{65308, 3, &rule6},
+	{65311, 2, &rule2},
+	{65313, 26, &rule9},
+	{65339, 1, &rule4},
+	{65340, 1, &rule2},
+	{65341, 1, &rule5},
+	{65342, 1, &rule10},
+	{65343, 1, &rule11},
+	{65344, 1, &rule10},
+	{65345, 26, &rule12},
+	{65371, 1, &rule4},
+	{65372, 1, &rule6},
+	{65373, 1, &rule5},
+	{65374, 1, &rule6},
+	{65375, 1, &rule4},
+	{65376, 1, &rule5},
+	{65377, 1, &rule2},
+	{65378, 1, &rule4},
+	{65379, 1, &rule5},
+	{65380, 2, &rule2},
+	{65382, 10, &rule45},
+	{65392, 1, &rule83},
+	{65393, 45, &rule45},
+	{65438, 2, &rule83},
+	{65440, 31, &rule45},
+	{65474, 6, &rule45},
+	{65482, 6, &rule45},
+	{65490, 6, &rule45},
+	{65498, 3, &rule45},
+	{65504, 2, &rule3},
+	{65506, 1, &rule6},
+	{65507, 1, &rule10},
+	{65508, 1, &rule13},
+	{65509, 2, &rule3},
+	{65512, 1, &rule13},
+	{65513, 4, &rule6},
+	{65517, 2, &rule13},
+	{65529, 3, &rule16},
+	{65532, 2, &rule13},
+	{65536, 12, &rule45},
+	{65549, 26, &rule45},
+	{65576, 19, &rule45},
+	{65596, 2, &rule45},
+	{65599, 15, &rule45},
+	{65616, 14, &rule45},
+	{65664, 123, &rule45},
+	{65792, 2, &rule2},
+	{65794, 1, &rule13},
+	{65799, 45, &rule17},
+	{65847, 9, &rule13},
+	{65856, 53, &rule116},
+	{65909, 4, &rule17},
+	{65913, 17, &rule13},
+	{65930, 1, &rule17},
+	{65936, 12, &rule13},
+	{66000, 45, &rule13},
+	{66045, 1, &rule84},
+	{66176, 29, &rule45},
+	{66208, 49, &rule45},
+	{66304, 31, &rule45},
+	{66336, 4, &rule17},
+	{66352, 17, &rule45},
+	{66369, 1, &rule116},
+	{66370, 8, &rule45},
+	{66378, 1, &rule116},
+	{66432, 30, &rule45},
+	{66463, 1, &rule2},
+	{66464, 36, &rule45},
+	{66504, 8, &rule45},
+	{66512, 1, &rule2},
+	{66513, 5, &rule116},
+	{66560, 40, &rule165},
+	{66600, 40, &rule166},
+	{66640, 78, &rule45},
+	{66720, 10, &rule8},
+	{67584, 6, &rule45},
+	{67592, 1, &rule45},
+	{67594, 44, &rule45},
+	{67639, 2, &rule45},
+	{67644, 1, &rule45},
+	{67647, 23, &rule45},
+	{67671, 1, &rule2},
+	{67672, 8, &rule17},
+	{67840, 22, &rule45},
+	{67862, 6, &rule17},
+	{67871, 1, &rule2},
+	{67872, 26, &rule45},
+	{67903, 1, &rule2},
+	{68096, 1, &rule45},
+	{68097, 3, &rule84},
+	{68101, 2, &rule84},
+	{68108, 4, &rule84},
+	{68112, 4, &rule45},
+	{68117, 3, &rule45},
+	{68121, 27, &rule45},
+	{68152, 3, &rule84},
+	{68159, 1, &rule84},
+	{68160, 8, &rule17},
+	{68176, 9, &rule2},
+	{68192, 29, &rule45},
+	{68221, 2, &rule17},
+	{68223, 1, &rule2},
+	{68352, 54, &rule45},
+	{68409, 7, &rule2},
+	{68416, 22, &rule45},
+	{68440, 8, &rule17},
+	{68448, 19, &rule45},
+	{68472, 8, &rule17},
+	{68608, 73, &rule45},
+	{69216, 31, &rule17},
+	{69632, 1, &rule114},
+	{69633, 1, &rule84},
+	{69634, 1, &rule114},
+	{69635, 53, &rule45},
+	{69688, 15, &rule84},
+	{69703, 7, &rule2},
+	{69714, 20, &rule17},
+	{69734, 10, &rule8},
+	{69760, 2, &rule84},
+	{69762, 1, &rule114},
+	{69763, 45, &rule45},
+	{69808, 3, &rule114},
+	{69811, 4, &rule84},
+	{69815, 2, &rule114},
+	{69817, 2, &rule84},
+	{69819, 2, &rule2},
+	{69821, 1, &rule16},
+	{69822, 4, &rule2},
+	{73728, 879, &rule45},
+	{74752, 99, &rule116},
+	{74864, 4, &rule2},
+	{77824, 1071, &rule45},
+	{92160, 569, &rule45},
+	{110592, 2, &rule45},
+	{118784, 246, &rule13},
+	{119040, 39, &rule13},
+	{119081, 60, &rule13},
+	{119141, 2, &rule114},
+	{119143, 3, &rule84},
+	{119146, 3, &rule13},
+	{119149, 6, &rule114},
+	{119155, 8, &rule16},
+	{119163, 8, &rule84},
+	{119171, 2, &rule13},
+	{119173, 7, &rule84},
+	{119180, 30, &rule13},
+	{119210, 4, &rule84},
+	{119214, 48, &rule13},
+	{119296, 66, &rule13},
+	{119362, 3, &rule84},
+	{119365, 1, &rule13},
+	{119552, 87, &rule13},
+	{119648, 18, &rule17},
+	{119808, 26, &rule98},
+	{119834, 26, &rule14},
+	{119860, 26, &rule98},
+	{119886, 7, &rule14},
+	{119894, 18, &rule14},
+	{119912, 26, &rule98},
+	{119938, 26, &rule14},
+	{119964, 1, &rule98},
+	{119966, 2, &rule98},
+	{119970, 1, &rule98},
+	{119973, 2, &rule98},
+	{119977, 4, &rule98},
+	{119982, 8, &rule98},
+	{119990, 4, &rule14},
+	{119995, 1, &rule14},
+	{119997, 7, &rule14},
+	{120005, 11, &rule14},
+	{120016, 26, &rule98},
+	{120042, 26, &rule14},
+	{120068, 2, &rule98},
+	{120071, 4, &rule98},
+	{120077, 8, &rule98},
+	{120086, 7, &rule98},
+	{120094, 26, &rule14},
+	{120120, 2, &rule98},
+	{120123, 4, &rule98},
+	{120128, 5, &rule98},
+	{120134, 1, &rule98},
+	{120138, 7, &rule98},
+	{120146, 26, &rule14},
+	{120172, 26, &rule98},
+	{120198, 26, &rule14},
+	{120224, 26, &rule98},
+	{120250, 26, &rule14},
+	{120276, 26, &rule98},
+	{120302, 26, &rule14},
+	{120328, 26, &rule98},
+	{120354, 26, &rule14},
+	{120380, 26, &rule98},
+	{120406, 26, &rule14},
+	{120432, 26, &rule98},
+	{120458, 28, &rule14},
+	{120488, 25, &rule98},
+	{120513, 1, &rule6},
+	{120514, 25, &rule14},
+	{120539, 1, &rule6},
+	{120540, 6, &rule14},
+	{120546, 25, &rule98},
+	{120571, 1, &rule6},
+	{120572, 25, &rule14},
+	{120597, 1, &rule6},
+	{120598, 6, &rule14},
+	{120604, 25, &rule98},
+	{120629, 1, &rule6},
+	{120630, 25, &rule14},
+	{120655, 1, &rule6},
+	{120656, 6, &rule14},
+	{120662, 25, &rule98},
+	{120687, 1, &rule6},
+	{120688, 25, &rule14},
+	{120713, 1, &rule6},
+	{120714, 6, &rule14},
+	{120720, 25, &rule98},
+	{120745, 1, &rule6},
+	{120746, 25, &rule14},
+	{120771, 1, &rule6},
+	{120772, 6, &rule14},
+	{120778, 1, &rule98},
+	{120779, 1, &rule14},
+	{120782, 50, &rule8},
+	{126976, 44, &rule13},
+	{127024, 100, &rule13},
+	{127136, 15, &rule13},
+	{127153, 14, &rule13},
+	{127169, 15, &rule13},
+	{127185, 15, &rule13},
+	{127232, 11, &rule17},
+	{127248, 31, &rule13},
+	{127280, 58, &rule13},
+	{127344, 43, &rule13},
+	{127462, 29, &rule13},
+	{127504, 43, &rule13},
+	{127552, 9, &rule13},
+	{127568, 2, &rule13},
+	{127744, 33, &rule13},
+	{127792, 6, &rule13},
+	{127799, 70, &rule13},
+	{127872, 20, &rule13},
+	{127904, 37, &rule13},
+	{127942, 5, &rule13},
+	{127968, 17, &rule13},
+	{128000, 63, &rule13},
+	{128064, 1, &rule13},
+	{128066, 182, &rule13},
+	{128249, 4, &rule13},
+	{128256, 62, &rule13},
+	{128336, 24, &rule13},
+	{128507, 5, &rule13},
+	{128513, 16, &rule13},
+	{128530, 3, &rule13},
+	{128534, 1, &rule13},
+	{128536, 1, &rule13},
+	{128538, 1, &rule13},
+	{128540, 3, &rule13},
+	{128544, 6, &rule13},
+	{128552, 4, &rule13},
+	{128557, 1, &rule13},
+	{128560, 4, &rule13},
+	{128565, 12, &rule13},
+	{128581, 11, &rule13},
+	{128640, 70, &rule13},
+	{128768, 116, &rule13},
+	{131072, 42711, &rule45},
+	{173824, 4149, &rule45},
+	{177984, 222, &rule45},
+	{194560, 542, &rule45},
+	{917505, 1, &rule16},
+	{917536, 96, &rule16},
+	{917760, 240, &rule84},
+	{983040, 65534, &rule164},
+	{1048576, 65534, &rule164}
+};
+static const struct _charblock_ convchars[]={
+	{65, 26, &rule9},
+	{97, 26, &rule12},
+	{181, 1, &rule18},
+	{192, 23, &rule9},
+	{216, 7, &rule9},
+	{224, 23, &rule12},
+	{248, 7, &rule12},
+	{255, 1, &rule20},
+	{256, 1, &rule21},
+	{257, 1, &rule22},
+	{258, 1, &rule21},
+	{259, 1, &rule22},
+	{260, 1, &rule21},
+	{261, 1, &rule22},
+	{262, 1, &rule21},
+	{263, 1, &rule22},
+	{264, 1, &rule21},
+	{265, 1, &rule22},
+	{266, 1, &rule21},
+	{267, 1, &rule22},
+	{268, 1, &rule21},
+	{269, 1, &rule22},
+	{270, 1, &rule21},
+	{271, 1, &rule22},
+	{272, 1, &rule21},
+	{273, 1, &rule22},
+	{274, 1, &rule21},
+	{275, 1, &rule22},
+	{276, 1, &rule21},
+	{277, 1, &rule22},
+	{278, 1, &rule21},
+	{279, 1, &rule22},
+	{280, 1, &rule21},
+	{281, 1, &rule22},
+	{282, 1, &rule21},
+	{283, 1, &rule22},
+	{284, 1, &rule21},
+	{285, 1, &rule22},
+	{286, 1, &rule21},
+	{287, 1, &rule22},
+	{288, 1, &rule21},
+	{289, 1, &rule22},
+	{290, 1, &rule21},
+	{291, 1, &rule22},
+	{292, 1, &rule21},
+	{293, 1, &rule22},
+	{294, 1, &rule21},
+	{295, 1, &rule22},
+	{296, 1, &rule21},
+	{297, 1, &rule22},
+	{298, 1, &rule21},
+	{299, 1, &rule22},
+	{300, 1, &rule21},
+	{301, 1, &rule22},
+	{302, 1, &rule21},
+	{303, 1, &rule22},
+	{304, 1, &rule23},
+	{305, 1, &rule24},
+	{306, 1, &rule21},
+	{307, 1, &rule22},
+	{308, 1, &rule21},
+	{309, 1, &rule22},
+	{310, 1, &rule21},
+	{311, 1, &rule22},
+	{313, 1, &rule21},
+	{314, 1, &rule22},
+	{315, 1, &rule21},
+	{316, 1, &rule22},
+	{317, 1, &rule21},
+	{318, 1, &rule22},
+	{319, 1, &rule21},
+	{320, 1, &rule22},
+	{321, 1, &rule21},
+	{322, 1, &rule22},
+	{323, 1, &rule21},
+	{324, 1, &rule22},
+	{325, 1, &rule21},
+	{326, 1, &rule22},
+	{327, 1, &rule21},
+	{328, 1, &rule22},
+	{330, 1, &rule21},
+	{331, 1, &rule22},
+	{332, 1, &rule21},
+	{333, 1, &rule22},
+	{334, 1, &rule21},
+	{335, 1, &rule22},
+	{336, 1, &rule21},
+	{337, 1, &rule22},
+	{338, 1, &rule21},
+	{339, 1, &rule22},
+	{340, 1, &rule21},
+	{341, 1, &rule22},
+	{342, 1, &rule21},
+	{343, 1, &rule22},
+	{344, 1, &rule21},
+	{345, 1, &rule22},
+	{346, 1, &rule21},
+	{347, 1, &rule22},
+	{348, 1, &rule21},
+	{349, 1, &rule22},
+	{350, 1, &rule21},
+	{351, 1, &rule22},
+	{352, 1, &rule21},
+	{353, 1, &rule22},
+	{354, 1, &rule21},
+	{355, 1, &rule22},
+	{356, 1, &rule21},
+	{357, 1, &rule22},
+	{358, 1, &rule21},
+	{359, 1, &rule22},
+	{360, 1, &rule21},
+	{361, 1, &rule22},
+	{362, 1, &rule21},
+	{363, 1, &rule22},
+	{364, 1, &rule21},
+	{365, 1, &rule22},
+	{366, 1, &rule21},
+	{367, 1, &rule22},
+	{368, 1, &rule21},
+	{369, 1, &rule22},
+	{370, 1, &rule21},
+	{371, 1, &rule22},
+	{372, 1, &rule21},
+	{373, 1, &rule22},
+	{374, 1, &rule21},
+	{375, 1, &rule22},
+	{376, 1, &rule25},
+	{377, 1, &rule21},
+	{378, 1, &rule22},
+	{379, 1, &rule21},
+	{380, 1, &rule22},
+	{381, 1, &rule21},
+	{382, 1, &rule22},
+	{383, 1, &rule26},
+	{384, 1, &rule27},
+	{385, 1, &rule28},
+	{386, 1, &rule21},
+	{387, 1, &rule22},
+	{388, 1, &rule21},
+	{389, 1, &rule22},
+	{390, 1, &rule29},
+	{391, 1, &rule21},
+	{392, 1, &rule22},
+	{393, 2, &rule30},
+	{395, 1, &rule21},
+	{396, 1, &rule22},
+	{398, 1, &rule31},
+	{399, 1, &rule32},
+	{400, 1, &rule33},
+	{401, 1, &rule21},
+	{402, 1, &rule22},
+	{403, 1, &rule30},
+	{404, 1, &rule34},
+	{405, 1, &rule35},
+	{406, 1, &rule36},
+	{407, 1, &rule37},
+	{408, 1, &rule21},
+	{409, 1, &rule22},
+	{410, 1, &rule38},
+	{412, 1, &rule36},
+	{413, 1, &rule39},
+	{414, 1, &rule40},
+	{415, 1, &rule41},
+	{416, 1, &rule21},
+	{417, 1, &rule22},
+	{418, 1, &rule21},
+	{419, 1, &rule22},
+	{420, 1, &rule21},
+	{421, 1, &rule22},
+	{422, 1, &rule42},
+	{423, 1, &rule21},
+	{424, 1, &rule22},
+	{425, 1, &rule42},
+	{428, 1, &rule21},
+	{429, 1, &rule22},
+	{430, 1, &rule42},
+	{431, 1, &rule21},
+	{432, 1, &rule22},
+	{433, 2, &rule43},
+	{435, 1, &rule21},
+	{436, 1, &rule22},
+	{437, 1, &rule21},
+	{438, 1, &rule22},
+	{439, 1, &rule44},
+	{440, 1, &rule21},
+	{441, 1, &rule22},
+	{444, 1, &rule21},
+	{445, 1, &rule22},
+	{447, 1, &rule46},
+	{452, 1, &rule47},
+	{453, 1, &rule48},
+	{454, 1, &rule49},
+	{455, 1, &rule47},
+	{456, 1, &rule48},
+	{457, 1, &rule49},
+	{458, 1, &rule47},
+	{459, 1, &rule48},
+	{460, 1, &rule49},
+	{461, 1, &rule21},
+	{462, 1, &rule22},
+	{463, 1, &rule21},
+	{464, 1, &rule22},
+	{465, 1, &rule21},
+	{466, 1, &rule22},
+	{467, 1, &rule21},
+	{468, 1, &rule22},
+	{469, 1, &rule21},
+	{470, 1, &rule22},
+	{471, 1, &rule21},
+	{472, 1, &rule22},
+	{473, 1, &rule21},
+	{474, 1, &rule22},
+	{475, 1, &rule21},
+	{476, 1, &rule22},
+	{477, 1, &rule50},
+	{478, 1, &rule21},
+	{479, 1, &rule22},
+	{480, 1, &rule21},
+	{481, 1, &rule22},
+	{482, 1, &rule21},
+	{483, 1, &rule22},
+	{484, 1, &rule21},
+	{485, 1, &rule22},
+	{486, 1, &rule21},
+	{487, 1, &rule22},
+	{488, 1, &rule21},
+	{489, 1, &rule22},
+	{490, 1, &rule21},
+	{491, 1, &rule22},
+	{492, 1, &rule21},
+	{493, 1, &rule22},
+	{494, 1, &rule21},
+	{495, 1, &rule22},
+	{497, 1, &rule47},
+	{498, 1, &rule48},
+	{499, 1, &rule49},
+	{500, 1, &rule21},
+	{501, 1, &rule22},
+	{502, 1, &rule51},
+	{503, 1, &rule52},
+	{504, 1, &rule21},
+	{505, 1, &rule22},
+	{506, 1, &rule21},
+	{507, 1, &rule22},
+	{508, 1, &rule21},
+	{509, 1, &rule22},
+	{510, 1, &rule21},
+	{511, 1, &rule22},
+	{512, 1, &rule21},
+	{513, 1, &rule22},
+	{514, 1, &rule21},
+	{515, 1, &rule22},
+	{516, 1, &rule21},
+	{517, 1, &rule22},
+	{518, 1, &rule21},
+	{519, 1, &rule22},
+	{520, 1, &rule21},
+	{521, 1, &rule22},
+	{522, 1, &rule21},
+	{523, 1, &rule22},
+	{524, 1, &rule21},
+	{525, 1, &rule22},
+	{526, 1, &rule21},
+	{527, 1, &rule22},
+	{528, 1, &rule21},
+	{529, 1, &rule22},
+	{530, 1, &rule21},
+	{531, 1, &rule22},
+	{532, 1, &rule21},
+	{533, 1, &rule22},
+	{534, 1, &rule21},
+	{535, 1, &rule22},
+	{536, 1, &rule21},
+	{537, 1, &rule22},
+	{538, 1, &rule21},
+	{539, 1, &rule22},
+	{540, 1, &rule21},
+	{541, 1, &rule22},
+	{542, 1, &rule21},
+	{543, 1, &rule22},
+	{544, 1, &rule53},
+	{546, 1, &rule21},
+	{547, 1, &rule22},
+	{548, 1, &rule21},
+	{549, 1, &rule22},
+	{550, 1, &rule21},
+	{551, 1, &rule22},
+	{552, 1, &rule21},
+	{553, 1, &rule22},
+	{554, 1, &rule21},
+	{555, 1, &rule22},
+	{556, 1, &rule21},
+	{557, 1, &rule22},
+	{558, 1, &rule21},
+	{559, 1, &rule22},
+	{560, 1, &rule21},
+	{561, 1, &rule22},
+	{562, 1, &rule21},
+	{563, 1, &rule22},
+	{570, 1, &rule54},
+	{571, 1, &rule21},
+	{572, 1, &rule22},
+	{573, 1, &rule55},
+	{574, 1, &rule56},
+	{575, 2, &rule57},
+	{577, 1, &rule21},
+	{578, 1, &rule22},
+	{579, 1, &rule58},
+	{580, 1, &rule59},
+	{581, 1, &rule60},
+	{582, 1, &rule21},
+	{583, 1, &rule22},
+	{584, 1, &rule21},
+	{585, 1, &rule22},
+	{586, 1, &rule21},
+	{587, 1, &rule22},
+	{588, 1, &rule21},
+	{589, 1, &rule22},
+	{590, 1, &rule21},
+	{591, 1, &rule22},
+	{592, 1, &rule61},
+	{593, 1, &rule62},
+	{594, 1, &rule63},
+	{595, 1, &rule64},
+	{596, 1, &rule65},
+	{598, 2, &rule66},
+	{601, 1, &rule67},
+	{603, 1, &rule68},
+	{608, 1, &rule66},
+	{611, 1, &rule69},
+	{613, 1, &rule70},
+	{616, 1, &rule71},
+	{617, 1, &rule72},
+	{619, 1, &rule73},
+	{623, 1, &rule72},
+	{625, 1, &rule74},
+	{626, 1, &rule75},
+	{629, 1, &rule76},
+	{637, 1, &rule77},
+	{640, 1, &rule78},
+	{643, 1, &rule78},
+	{648, 1, &rule78},
+	{649, 1, &rule79},
+	{650, 2, &rule80},
+	{652, 1, &rule81},
+	{658, 1, &rule82},
+	{837, 1, &rule85},
+	{880, 1, &rule21},
+	{881, 1, &rule22},
+	{882, 1, &rule21},
+	{883, 1, &rule22},
+	{886, 1, &rule21},
+	{887, 1, &rule22},
+	{891, 3, &rule40},
+	{902, 1, &rule86},
+	{904, 3, &rule87},
+	{908, 1, &rule88},
+	{910, 2, &rule89},
+	{913, 17, &rule9},
+	{931, 9, &rule9},
+	{940, 1, &rule90},
+	{941, 3, &rule91},
+	{945, 17, &rule12},
+	{962, 1, &rule92},
+	{963, 9, &rule12},
+	{972, 1, &rule93},
+	{973, 2, &rule94},
+	{975, 1, &rule95},
+	{976, 1, &rule96},
+	{977, 1, &rule97},
+	{981, 1, &rule99},
+	{982, 1, &rule100},
+	{983, 1, &rule101},
+	{984, 1, &rule21},
+	{985, 1, &rule22},
+	{986, 1, &rule21},
+	{987, 1, &rule22},
+	{988, 1, &rule21},
+	{989, 1, &rule22},
+	{990, 1, &rule21},
+	{991, 1, &rule22},
+	{992, 1, &rule21},
+	{993, 1, &rule22},
+	{994, 1, &rule21},
+	{995, 1, &rule22},
+	{996, 1, &rule21},
+	{997, 1, &rule22},
+	{998, 1, &rule21},
+	{999, 1, &rule22},
+	{1000, 1, &rule21},
+	{1001, 1, &rule22},
+	{1002, 1, &rule21},
+	{1003, 1, &rule22},
+	{1004, 1, &rule21},
+	{1005, 1, &rule22},
+	{1006, 1, &rule21},
+	{1007, 1, &rule22},
+	{1008, 1, &rule102},
+	{1009, 1, &rule103},
+	{1010, 1, &rule104},
+	{1012, 1, &rule105},
+	{1013, 1, &rule106},
+	{1015, 1, &rule21},
+	{1016, 1, &rule22},
+	{1017, 1, &rule107},
+	{1018, 1, &rule21},
+	{1019, 1, &rule22},
+	{1021, 3, &rule53},
+	{1024, 16, &rule108},
+	{1040, 32, &rule9},
+	{1072, 32, &rule12},
+	{1104, 16, &rule103},
+	{1120, 1, &rule21},
+	{1121, 1, &rule22},
+	{1122, 1, &rule21},
+	{1123, 1, &rule22},
+	{1124, 1, &rule21},
+	{1125, 1, &rule22},
+	{1126, 1, &rule21},
+	{1127, 1, &rule22},
+	{1128, 1, &rule21},
+	{1129, 1, &rule22},
+	{1130, 1, &rule21},
+	{1131, 1, &rule22},
+	{1132, 1, &rule21},
+	{1133, 1, &rule22},
+	{1134, 1, &rule21},
+	{1135, 1, &rule22},
+	{1136, 1, &rule21},
+	{1137, 1, &rule22},
+	{1138, 1, &rule21},
+	{1139, 1, &rule22},
+	{1140, 1, &rule21},
+	{1141, 1, &rule22},
+	{1142, 1, &rule21},
+	{1143, 1, &rule22},
+	{1144, 1, &rule21},
+	{1145, 1, &rule22},
+	{1146, 1, &rule21},
+	{1147, 1, &rule22},
+	{1148, 1, &rule21},
+	{1149, 1, &rule22},
+	{1150, 1, &rule21},
+	{1151, 1, &rule22},
+	{1152, 1, &rule21},
+	{1153, 1, &rule22},
+	{1162, 1, &rule21},
+	{1163, 1, &rule22},
+	{1164, 1, &rule21},
+	{1165, 1, &rule22},
+	{1166, 1, &rule21},
+	{1167, 1, &rule22},
+	{1168, 1, &rule21},
+	{1169, 1, &rule22},
+	{1170, 1, &rule21},
+	{1171, 1, &rule22},
+	{1172, 1, &rule21},
+	{1173, 1, &rule22},
+	{1174, 1, &rule21},
+	{1175, 1, &rule22},
+	{1176, 1, &rule21},
+	{1177, 1, &rule22},
+	{1178, 1, &rule21},
+	{1179, 1, &rule22},
+	{1180, 1, &rule21},
+	{1181, 1, &rule22},
+	{1182, 1, &rule21},
+	{1183, 1, &rule22},
+	{1184, 1, &rule21},
+	{1185, 1, &rule22},
+	{1186, 1, &rule21},
+	{1187, 1, &rule22},
+	{1188, 1, &rule21},
+	{1189, 1, &rule22},
+	{1190, 1, &rule21},
+	{1191, 1, &rule22},
+	{1192, 1, &rule21},
+	{1193, 1, &rule22},
+	{1194, 1, &rule21},
+	{1195, 1, &rule22},
+	{1196, 1, &rule21},
+	{1197, 1, &rule22},
+	{1198, 1, &rule21},
+	{1199, 1, &rule22},
+	{1200, 1, &rule21},
+	{1201, 1, &rule22},
+	{1202, 1, &rule21},
+	{1203, 1, &rule22},
+	{1204, 1, &rule21},
+	{1205, 1, &rule22},
+	{1206, 1, &rule21},
+	{1207, 1, &rule22},
+	{1208, 1, &rule21},
+	{1209, 1, &rule22},
+	{1210, 1, &rule21},
+	{1211, 1, &rule22},
+	{1212, 1, &rule21},
+	{1213, 1, &rule22},
+	{1214, 1, &rule21},
+	{1215, 1, &rule22},
+	{1216, 1, &rule110},
+	{1217, 1, &rule21},
+	{1218, 1, &rule22},
+	{1219, 1, &rule21},
+	{1220, 1, &rule22},
+	{1221, 1, &rule21},
+	{1222, 1, &rule22},
+	{1223, 1, &rule21},
+	{1224, 1, &rule22},
+	{1225, 1, &rule21},
+	{1226, 1, &rule22},
+	{1227, 1, &rule21},
+	{1228, 1, &rule22},
+	{1229, 1, &rule21},
+	{1230, 1, &rule22},
+	{1231, 1, &rule111},
+	{1232, 1, &rule21},
+	{1233, 1, &rule22},
+	{1234, 1, &rule21},
+	{1235, 1, &rule22},
+	{1236, 1, &rule21},
+	{1237, 1, &rule22},
+	{1238, 1, &rule21},
+	{1239, 1, &rule22},
+	{1240, 1, &rule21},
+	{1241, 1, &rule22},
+	{1242, 1, &rule21},
+	{1243, 1, &rule22},
+	{1244, 1, &rule21},
+	{1245, 1, &rule22},
+	{1246, 1, &rule21},
+	{1247, 1, &rule22},
+	{1248, 1, &rule21},
+	{1249, 1, &rule22},
+	{1250, 1, &rule21},
+	{1251, 1, &rule22},
+	{1252, 1, &rule21},
+	{1253, 1, &rule22},
+	{1254, 1, &rule21},
+	{1255, 1, &rule22},
+	{1256, 1, &rule21},
+	{1257, 1, &rule22},
+	{1258, 1, &rule21},
+	{1259, 1, &rule22},
+	{1260, 1, &rule21},
+	{1261, 1, &rule22},
+	{1262, 1, &rule21},
+	{1263, 1, &rule22},
+	{1264, 1, &rule21},
+	{1265, 1, &rule22},
+	{1266, 1, &rule21},
+	{1267, 1, &rule22},
+	{1268, 1, &rule21},
+	{1269, 1, &rule22},
+	{1270, 1, &rule21},
+	{1271, 1, &rule22},
+	{1272, 1, &rule21},
+	{1273, 1, &rule22},
+	{1274, 1, &rule21},
+	{1275, 1, &rule22},
+	{1276, 1, &rule21},
+	{1277, 1, &rule22},
+	{1278, 1, &rule21},
+	{1279, 1, &rule22},
+	{1280, 1, &rule21},
+	{1281, 1, &rule22},
+	{1282, 1, &rule21},
+	{1283, 1, &rule22},
+	{1284, 1, &rule21},
+	{1285, 1, &rule22},
+	{1286, 1, &rule21},
+	{1287, 1, &rule22},
+	{1288, 1, &rule21},
+	{1289, 1, &rule22},
+	{1290, 1, &rule21},
+	{1291, 1, &rule22},
+	{1292, 1, &rule21},
+	{1293, 1, &rule22},
+	{1294, 1, &rule21},
+	{1295, 1, &rule22},
+	{1296, 1, &rule21},
+	{1297, 1, &rule22},
+	{1298, 1, &rule21},
+	{1299, 1, &rule22},
+	{1300, 1, &rule21},
+	{1301, 1, &rule22},
+	{1302, 1, &rule21},
+	{1303, 1, &rule22},
+	{1304, 1, &rule21},
+	{1305, 1, &rule22},
+	{1306, 1, &rule21},
+	{1307, 1, &rule22},
+	{1308, 1, &rule21},
+	{1309, 1, &rule22},
+	{1310, 1, &rule21},
+	{1311, 1, &rule22},
+	{1312, 1, &rule21},
+	{1313, 1, &rule22},
+	{1314, 1, &rule21},
+	{1315, 1, &rule22},
+	{1316, 1, &rule21},
+	{1317, 1, &rule22},
+	{1318, 1, &rule21},
+	{1319, 1, &rule22},
+	{1329, 38, &rule112},
+	{1377, 38, &rule113},
+	{4256, 38, &rule115},
+	{7545, 1, &rule117},
+	{7549, 1, &rule118},
+	{7680, 1, &rule21},
+	{7681, 1, &rule22},
+	{7682, 1, &rule21},
+	{7683, 1, &rule22},
+	{7684, 1, &rule21},
+	{7685, 1, &rule22},
+	{7686, 1, &rule21},
+	{7687, 1, &rule22},
+	{7688, 1, &rule21},
+	{7689, 1, &rule22},
+	{7690, 1, &rule21},
+	{7691, 1, &rule22},
+	{7692, 1, &rule21},
+	{7693, 1, &rule22},
+	{7694, 1, &rule21},
+	{7695, 1, &rule22},
+	{7696, 1, &rule21},
+	{7697, 1, &rule22},
+	{7698, 1, &rule21},
+	{7699, 1, &rule22},
+	{7700, 1, &rule21},
+	{7701, 1, &rule22},
+	{7702, 1, &rule21},
+	{7703, 1, &rule22},
+	{7704, 1, &rule21},
+	{7705, 1, &rule22},
+	{7706, 1, &rule21},
+	{7707, 1, &rule22},
+	{7708, 1, &rule21},
+	{7709, 1, &rule22},
+	{7710, 1, &rule21},
+	{7711, 1, &rule22},
+	{7712, 1, &rule21},
+	{7713, 1, &rule22},
+	{7714, 1, &rule21},
+	{7715, 1, &rule22},
+	{7716, 1, &rule21},
+	{7717, 1, &rule22},
+	{7718, 1, &rule21},
+	{7719, 1, &rule22},
+	{7720, 1, &rule21},
+	{7721, 1, &rule22},
+	{7722, 1, &rule21},
+	{7723, 1, &rule22},
+	{7724, 1, &rule21},
+	{7725, 1, &rule22},
+	{7726, 1, &rule21},
+	{7727, 1, &rule22},
+	{7728, 1, &rule21},
+	{7729, 1, &rule22},
+	{7730, 1, &rule21},
+	{7731, 1, &rule22},
+	{7732, 1, &rule21},
+	{7733, 1, &rule22},
+	{7734, 1, &rule21},
+	{7735, 1, &rule22},
+	{7736, 1, &rule21},
+	{7737, 1, &rule22},
+	{7738, 1, &rule21},
+	{7739, 1, &rule22},
+	{7740, 1, &rule21},
+	{7741, 1, &rule22},
+	{7742, 1, &rule21},
+	{7743, 1, &rule22},
+	{7744, 1, &rule21},
+	{7745, 1, &rule22},
+	{7746, 1, &rule21},
+	{7747, 1, &rule22},
+	{7748, 1, &rule21},
+	{7749, 1, &rule22},
+	{7750, 1, &rule21},
+	{7751, 1, &rule22},
+	{7752, 1, &rule21},
+	{7753, 1, &rule22},
+	{7754, 1, &rule21},
+	{7755, 1, &rule22},
+	{7756, 1, &rule21},
+	{7757, 1, &rule22},
+	{7758, 1, &rule21},
+	{7759, 1, &rule22},
+	{7760, 1, &rule21},
+	{7761, 1, &rule22},
+	{7762, 1, &rule21},
+	{7763, 1, &rule22},
+	{7764, 1, &rule21},
+	{7765, 1, &rule22},
+	{7766, 1, &rule21},
+	{7767, 1, &rule22},
+	{7768, 1, &rule21},
+	{7769, 1, &rule22},
+	{7770, 1, &rule21},
+	{7771, 1, &rule22},
+	{7772, 1, &rule21},
+	{7773, 1, &rule22},
+	{7774, 1, &rule21},
+	{7775, 1, &rule22},
+	{7776, 1, &rule21},
+	{7777, 1, &rule22},
+	{7778, 1, &rule21},
+	{7779, 1, &rule22},
+	{7780, 1, &rule21},
+	{7781, 1, &rule22},
+	{7782, 1, &rule21},
+	{7783, 1, &rule22},
+	{7784, 1, &rule21},
+	{7785, 1, &rule22},
+	{7786, 1, &rule21},
+	{7787, 1, &rule22},
+	{7788, 1, &rule21},
+	{7789, 1, &rule22},
+	{7790, 1, &rule21},
+	{7791, 1, &rule22},
+	{7792, 1, &rule21},
+	{7793, 1, &rule22},
+	{7794, 1, &rule21},
+	{7795, 1, &rule22},
+	{7796, 1, &rule21},
+	{7797, 1, &rule22},
+	{7798, 1, &rule21},
+	{7799, 1, &rule22},
+	{7800, 1, &rule21},
+	{7801, 1, &rule22},
+	{7802, 1, &rule21},
+	{7803, 1, &rule22},
+	{7804, 1, &rule21},
+	{7805, 1, &rule22},
+	{7806, 1, &rule21},
+	{7807, 1, &rule22},
+	{7808, 1, &rule21},
+	{7809, 1, &rule22},
+	{7810, 1, &rule21},
+	{7811, 1, &rule22},
+	{7812, 1, &rule21},
+	{7813, 1, &rule22},
+	{7814, 1, &rule21},
+	{7815, 1, &rule22},
+	{7816, 1, &rule21},
+	{7817, 1, &rule22},
+	{7818, 1, &rule21},
+	{7819, 1, &rule22},
+	{7820, 1, &rule21},
+	{7821, 1, &rule22},
+	{7822, 1, &rule21},
+	{7823, 1, &rule22},
+	{7824, 1, &rule21},
+	{7825, 1, &rule22},
+	{7826, 1, &rule21},
+	{7827, 1, &rule22},
+	{7828, 1, &rule21},
+	{7829, 1, &rule22},
+	{7835, 1, &rule119},
+	{7838, 1, &rule120},
+	{7840, 1, &rule21},
+	{7841, 1, &rule22},
+	{7842, 1, &rule21},
+	{7843, 1, &rule22},
+	{7844, 1, &rule21},
+	{7845, 1, &rule22},
+	{7846, 1, &rule21},
+	{7847, 1, &rule22},
+	{7848, 1, &rule21},
+	{7849, 1, &rule22},
+	{7850, 1, &rule21},
+	{7851, 1, &rule22},
+	{7852, 1, &rule21},
+	{7853, 1, &rule22},
+	{7854, 1, &rule21},
+	{7855, 1, &rule22},
+	{7856, 1, &rule21},
+	{7857, 1, &rule22},
+	{7858, 1, &rule21},
+	{7859, 1, &rule22},
+	{7860, 1, &rule21},
+	{7861, 1, &rule22},
+	{7862, 1, &rule21},
+	{7863, 1, &rule22},
+	{7864, 1, &rule21},
+	{7865, 1, &rule22},
+	{7866, 1, &rule21},
+	{7867, 1, &rule22},
+	{7868, 1, &rule21},
+	{7869, 1, &rule22},
+	{7870, 1, &rule21},
+	{7871, 1, &rule22},
+	{7872, 1, &rule21},
+	{7873, 1, &rule22},
+	{7874, 1, &rule21},
+	{7875, 1, &rule22},
+	{7876, 1, &rule21},
+	{7877, 1, &rule22},
+	{7878, 1, &rule21},
+	{7879, 1, &rule22},
+	{7880, 1, &rule21},
+	{7881, 1, &rule22},
+	{7882, 1, &rule21},
+	{7883, 1, &rule22},
+	{7884, 1, &rule21},
+	{7885, 1, &rule22},
+	{7886, 1, &rule21},
+	{7887, 1, &rule22},
+	{7888, 1, &rule21},
+	{7889, 1, &rule22},
+	{7890, 1, &rule21},
+	{7891, 1, &rule22},
+	{7892, 1, &rule21},
+	{7893, 1, &rule22},
+	{7894, 1, &rule21},
+	{7895, 1, &rule22},
+	{7896, 1, &rule21},
+	{7897, 1, &rule22},
+	{7898, 1, &rule21},
+	{7899, 1, &rule22},
+	{7900, 1, &rule21},
+	{7901, 1, &rule22},
+	{7902, 1, &rule21},
+	{7903, 1, &rule22},
+	{7904, 1, &rule21},
+	{7905, 1, &rule22},
+	{7906, 1, &rule21},
+	{7907, 1, &rule22},
+	{7908, 1, &rule21},
+	{7909, 1, &rule22},
+	{7910, 1, &rule21},
+	{7911, 1, &rule22},
+	{7912, 1, &rule21},
+	{7913, 1, &rule22},
+	{7914, 1, &rule21},
+	{7915, 1, &rule22},
+	{7916, 1, &rule21},
+	{7917, 1, &rule22},
+	{7918, 1, &rule21},
+	{7919, 1, &rule22},
+	{7920, 1, &rule21},
+	{7921, 1, &rule22},
+	{7922, 1, &rule21},
+	{7923, 1, &rule22},
+	{7924, 1, &rule21},
+	{7925, 1, &rule22},
+	{7926, 1, &rule21},
+	{7927, 1, &rule22},
+	{7928, 1, &rule21},
+	{7929, 1, &rule22},
+	{7930, 1, &rule21},
+	{7931, 1, &rule22},
+	{7932, 1, &rule21},
+	{7933, 1, &rule22},
+	{7934, 1, &rule21},
+	{7935, 1, &rule22},
+	{7936, 8, &rule121},
+	{7944, 8, &rule122},
+	{7952, 6, &rule121},
+	{7960, 6, &rule122},
+	{7968, 8, &rule121},
+	{7976, 8, &rule122},
+	{7984, 8, &rule121},
+	{7992, 8, &rule122},
+	{8000, 6, &rule121},
+	{8008, 6, &rule122},
+	{8017, 1, &rule121},
+	{8019, 1, &rule121},
+	{8021, 1, &rule121},
+	{8023, 1, &rule121},
+	{8025, 1, &rule122},
+	{8027, 1, &rule122},
+	{8029, 1, &rule122},
+	{8031, 1, &rule122},
+	{8032, 8, &rule121},
+	{8040, 8, &rule122},
+	{8048, 2, &rule123},
+	{8050, 4, &rule124},
+	{8054, 2, &rule125},
+	{8056, 2, &rule126},
+	{8058, 2, &rule127},
+	{8060, 2, &rule128},
+	{8064, 8, &rule121},
+	{8072, 8, &rule129},
+	{8080, 8, &rule121},
+	{8088, 8, &rule129},
+	{8096, 8, &rule121},
+	{8104, 8, &rule129},
+	{8112, 2, &rule121},
+	{8115, 1, &rule130},
+	{8120, 2, &rule122},
+	{8122, 2, &rule131},
+	{8124, 1, &rule132},
+	{8126, 1, &rule133},
+	{8131, 1, &rule130},
+	{8136, 4, &rule134},
+	{8140, 1, &rule132},
+	{8144, 2, &rule121},
+	{8152, 2, &rule122},
+	{8154, 2, &rule135},
+	{8160, 2, &rule121},
+	{8165, 1, &rule104},
+	{8168, 2, &rule122},
+	{8170, 2, &rule136},
+	{8172, 1, &rule107},
+	{8179, 1, &rule130},
+	{8184, 2, &rule137},
+	{8186, 2, &rule138},
+	{8188, 1, &rule132},
+	{8486, 1, &rule141},
+	{8490, 1, &rule142},
+	{8491, 1, &rule143},
+	{8498, 1, &rule144},
+	{8526, 1, &rule145},
+	{8544, 16, &rule146},
+	{8560, 16, &rule147},
+	{8579, 1, &rule21},
+	{8580, 1, &rule22},
+	{9398, 26, &rule148},
+	{9424, 26, &rule149},
+	{11264, 47, &rule112},
+	{11312, 47, &rule113},
+	{11360, 1, &rule21},
+	{11361, 1, &rule22},
+	{11362, 1, &rule150},
+	{11363, 1, &rule151},
+	{11364, 1, &rule152},
+	{11365, 1, &rule153},
+	{11366, 1, &rule154},
+	{11367, 1, &rule21},
+	{11368, 1, &rule22},
+	{11369, 1, &rule21},
+	{11370, 1, &rule22},
+	{11371, 1, &rule21},
+	{11372, 1, &rule22},
+	{11373, 1, &rule155},
+	{11374, 1, &rule156},
+	{11375, 1, &rule157},
+	{11376, 1, &rule158},
+	{11378, 1, &rule21},
+	{11379, 1, &rule22},
+	{11381, 1, &rule21},
+	{11382, 1, &rule22},
+	{11390, 2, &rule159},
+	{11392, 1, &rule21},
+	{11393, 1, &rule22},
+	{11394, 1, &rule21},
+	{11395, 1, &rule22},
+	{11396, 1, &rule21},
+	{11397, 1, &rule22},
+	{11398, 1, &rule21},
+	{11399, 1, &rule22},
+	{11400, 1, &rule21},
+	{11401, 1, &rule22},
+	{11402, 1, &rule21},
+	{11403, 1, &rule22},
+	{11404, 1, &rule21},
+	{11405, 1, &rule22},
+	{11406, 1, &rule21},
+	{11407, 1, &rule22},
+	{11408, 1, &rule21},
+	{11409, 1, &rule22},
+	{11410, 1, &rule21},
+	{11411, 1, &rule22},
+	{11412, 1, &rule21},
+	{11413, 1, &rule22},
+	{11414, 1, &rule21},
+	{11415, 1, &rule22},
+	{11416, 1, &rule21},
+	{11417, 1, &rule22},
+	{11418, 1, &rule21},
+	{11419, 1, &rule22},
+	{11420, 1, &rule21},
+	{11421, 1, &rule22},
+	{11422, 1, &rule21},
+	{11423, 1, &rule22},
+	{11424, 1, &rule21},
+	{11425, 1, &rule22},
+	{11426, 1, &rule21},
+	{11427, 1, &rule22},
+	{11428, 1, &rule21},
+	{11429, 1, &rule22},
+	{11430, 1, &rule21},
+	{11431, 1, &rule22},
+	{11432, 1, &rule21},
+	{11433, 1, &rule22},
+	{11434, 1, &rule21},
+	{11435, 1, &rule22},
+	{11436, 1, &rule21},
+	{11437, 1, &rule22},
+	{11438, 1, &rule21},
+	{11439, 1, &rule22},
+	{11440, 1, &rule21},
+	{11441, 1, &rule22},
+	{11442, 1, &rule21},
+	{11443, 1, &rule22},
+	{11444, 1, &rule21},
+	{11445, 1, &rule22},
+	{11446, 1, &rule21},
+	{11447, 1, &rule22},
+	{11448, 1, &rule21},
+	{11449, 1, &rule22},
+	{11450, 1, &rule21},
+	{11451, 1, &rule22},
+	{11452, 1, &rule21},
+	{11453, 1, &rule22},
+	{11454, 1, &rule21},
+	{11455, 1, &rule22},
+	{11456, 1, &rule21},
+	{11457, 1, &rule22},
+	{11458, 1, &rule21},
+	{11459, 1, &rule22},
+	{11460, 1, &rule21},
+	{11461, 1, &rule22},
+	{11462, 1, &rule21},
+	{11463, 1, &rule22},
+	{11464, 1, &rule21},
+	{11465, 1, &rule22},
+	{11466, 1, &rule21},
+	{11467, 1, &rule22},
+	{11468, 1, &rule21},
+	{11469, 1, &rule22},
+	{11470, 1, &rule21},
+	{11471, 1, &rule22},
+	{11472, 1, &rule21},
+	{11473, 1, &rule22},
+	{11474, 1, &rule21},
+	{11475, 1, &rule22},
+	{11476, 1, &rule21},
+	{11477, 1, &rule22},
+	{11478, 1, &rule21},
+	{11479, 1, &rule22},
+	{11480, 1, &rule21},
+	{11481, 1, &rule22},
+	{11482, 1, &rule21},
+	{11483, 1, &rule22},
+	{11484, 1, &rule21},
+	{11485, 1, &rule22},
+	{11486, 1, &rule21},
+	{11487, 1, &rule22},
+	{11488, 1, &rule21},
+	{11489, 1, &rule22},
+	{11490, 1, &rule21},
+	{11491, 1, &rule22},
+	{11499, 1, &rule21},
+	{11500, 1, &rule22},
+	{11501, 1, &rule21},
+	{11502, 1, &rule22},
+	{11520, 38, &rule160},
+	{42560, 1, &rule21},
+	{42561, 1, &rule22},
+	{42562, 1, &rule21},
+	{42563, 1, &rule22},
+	{42564, 1, &rule21},
+	{42565, 1, &rule22},
+	{42566, 1, &rule21},
+	{42567, 1, &rule22},
+	{42568, 1, &rule21},
+	{42569, 1, &rule22},
+	{42570, 1, &rule21},
+	{42571, 1, &rule22},
+	{42572, 1, &rule21},
+	{42573, 1, &rule22},
+	{42574, 1, &rule21},
+	{42575, 1, &rule22},
+	{42576, 1, &rule21},
+	{42577, 1, &rule22},
+	{42578, 1, &rule21},
+	{42579, 1, &rule22},
+	{42580, 1, &rule21},
+	{42581, 1, &rule22},
+	{42582, 1, &rule21},
+	{42583, 1, &rule22},
+	{42584, 1, &rule21},
+	{42585, 1, &rule22},
+	{42586, 1, &rule21},
+	{42587, 1, &rule22},
+	{42588, 1, &rule21},
+	{42589, 1, &rule22},
+	{42590, 1, &rule21},
+	{42591, 1, &rule22},
+	{42592, 1, &rule21},
+	{42593, 1, &rule22},
+	{42594, 1, &rule21},
+	{42595, 1, &rule22},
+	{42596, 1, &rule21},
+	{42597, 1, &rule22},
+	{42598, 1, &rule21},
+	{42599, 1, &rule22},
+	{42600, 1, &rule21},
+	{42601, 1, &rule22},
+	{42602, 1, &rule21},
+	{42603, 1, &rule22},
+	{42604, 1, &rule21},
+	{42605, 1, &rule22},
+	{42624, 1, &rule21},
+	{42625, 1, &rule22},
+	{42626, 1, &rule21},
+	{42627, 1, &rule22},
+	{42628, 1, &rule21},
+	{42629, 1, &rule22},
+	{42630, 1, &rule21},
+	{42631, 1, &rule22},
+	{42632, 1, &rule21},
+	{42633, 1, &rule22},
+	{42634, 1, &rule21},
+	{42635, 1, &rule22},
+	{42636, 1, &rule21},
+	{42637, 1, &rule22},
+	{42638, 1, &rule21},
+	{42639, 1, &rule22},
+	{42640, 1, &rule21},
+	{42641, 1, &rule22},
+	{42642, 1, &rule21},
+	{42643, 1, &rule22},
+	{42644, 1, &rule21},
+	{42645, 1, &rule22},
+	{42646, 1, &rule21},
+	{42647, 1, &rule22},
+	{42786, 1, &rule21},
+	{42787, 1, &rule22},
+	{42788, 1, &rule21},
+	{42789, 1, &rule22},
+	{42790, 1, &rule21},
+	{42791, 1, &rule22},
+	{42792, 1, &rule21},
+	{42793, 1, &rule22},
+	{42794, 1, &rule21},
+	{42795, 1, &rule22},
+	{42796, 1, &rule21},
+	{42797, 1, &rule22},
+	{42798, 1, &rule21},
+	{42799, 1, &rule22},
+	{42802, 1, &rule21},
+	{42803, 1, &rule22},
+	{42804, 1, &rule21},
+	{42805, 1, &rule22},
+	{42806, 1, &rule21},
+	{42807, 1, &rule22},
+	{42808, 1, &rule21},
+	{42809, 1, &rule22},
+	{42810, 1, &rule21},
+	{42811, 1, &rule22},
+	{42812, 1, &rule21},
+	{42813, 1, &rule22},
+	{42814, 1, &rule21},
+	{42815, 1, &rule22},
+	{42816, 1, &rule21},
+	{42817, 1, &rule22},
+	{42818, 1, &rule21},
+	{42819, 1, &rule22},
+	{42820, 1, &rule21},
+	{42821, 1, &rule22},
+	{42822, 1, &rule21},
+	{42823, 1, &rule22},
+	{42824, 1, &rule21},
+	{42825, 1, &rule22},
+	{42826, 1, &rule21},
+	{42827, 1, &rule22},
+	{42828, 1, &rule21},
+	{42829, 1, &rule22},
+	{42830, 1, &rule21},
+	{42831, 1, &rule22},
+	{42832, 1, &rule21},
+	{42833, 1, &rule22},
+	{42834, 1, &rule21},
+	{42835, 1, &rule22},
+	{42836, 1, &rule21},
+	{42837, 1, &rule22},
+	{42838, 1, &rule21},
+	{42839, 1, &rule22},
+	{42840, 1, &rule21},
+	{42841, 1, &rule22},
+	{42842, 1, &rule21},
+	{42843, 1, &rule22},
+	{42844, 1, &rule21},
+	{42845, 1, &rule22},
+	{42846, 1, &rule21},
+	{42847, 1, &rule22},
+	{42848, 1, &rule21},
+	{42849, 1, &rule22},
+	{42850, 1, &rule21},
+	{42851, 1, &rule22},
+	{42852, 1, &rule21},
+	{42853, 1, &rule22},
+	{42854, 1, &rule21},
+	{42855, 1, &rule22},
+	{42856, 1, &rule21},
+	{42857, 1, &rule22},
+	{42858, 1, &rule21},
+	{42859, 1, &rule22},
+	{42860, 1, &rule21},
+	{42861, 1, &rule22},
+	{42862, 1, &rule21},
+	{42863, 1, &rule22},
+	{42873, 1, &rule21},
+	{42874, 1, &rule22},
+	{42875, 1, &rule21},
+	{42876, 1, &rule22},
+	{42877, 1, &rule161},
+	{42878, 1, &rule21},
+	{42879, 1, &rule22},
+	{42880, 1, &rule21},
+	{42881, 1, &rule22},
+	{42882, 1, &rule21},
+	{42883, 1, &rule22},
+	{42884, 1, &rule21},
+	{42885, 1, &rule22},
+	{42886, 1, &rule21},
+	{42887, 1, &rule22},
+	{42891, 1, &rule21},
+	{42892, 1, &rule22},
+	{42893, 1, &rule162},
+	{42896, 1, &rule21},
+	{42897, 1, &rule22},
+	{42912, 1, &rule21},
+	{42913, 1, &rule22},
+	{42914, 1, &rule21},
+	{42915, 1, &rule22},
+	{42916, 1, &rule21},
+	{42917, 1, &rule22},
+	{42918, 1, &rule21},
+	{42919, 1, &rule22},
+	{42920, 1, &rule21},
+	{42921, 1, &rule22},
+	{65313, 26, &rule9},
+	{65345, 26, &rule12},
+	{66560, 40, &rule165},
+	{66600, 40, &rule166}
+};
+static const struct _charblock_ spacechars[]={
+	{32, 1, &rule1},
+	{160, 1, &rule1},
+	{5760, 1, &rule1},
+	{6158, 1, &rule1},
+	{8192, 11, &rule1},
+	{8239, 1, &rule1},
+	{8287, 1, &rule1},
+	{12288, 1, &rule1}
+};
+
+/*
+	Obtain the reference to character rule by doing
+	binary search over the specified array of blocks.
+	To make checkattr shorter, the address of
+	nullrule is returned if the search fails:
+	this rule defines no category and no conversion
+	distances. The compare function returns 0 when
+	key->start is within the block. Otherwise
+	result of comparison of key->start and start of the
+	current block is returned as usual.
+*/
+
+static const struct _convrule_ nullrule={0,NUMCAT_CN,0,0,0,0};
+
+int blkcmp(const void *vk,const void *vb)
+{
+	const struct _charblock_ *key,*cur;
+	key=vk;
+	cur=vb;
+	if((key->start>=cur->start)&&(key->start<(cur->start+cur->length)))
+	{
+		return 0;
+	}
+	if(key->start>cur->start) return 1;
+	return -1;
+}
+
+static const struct _convrule_ *getrule(
+	const struct _charblock_ *blocks,
+	int numblocks,
+	int unichar)
+{
+	struct _charblock_ key={unichar,1,(void *)0};
+	struct _charblock_ *cb=bsearch(&key,blocks,numblocks,sizeof(key),blkcmp);
+	if(cb==(void *)0) return &nullrule;
+	return cb->rule;
+}
+	
+
+
+/*
+	Check whether a character (internal code) has certain attributes.
+	Attributes (category flags) may be ORed. The function ANDs
+	character category flags and the mask and returns the result.
+	If the character belongs to one of the categories requested,
+	the result will be nonzero.
+*/
+
+inline static int checkattr(int c,unsigned int catmask)
+{
+	return (catmask & (getrule(allchars,(c<256)?NUM_LAT1BLOCKS:NUM_BLOCKS,c)->category));
+}
+
+inline static int checkattr_s(int c,unsigned int catmask)
+{
+        return (catmask & (getrule(spacechars,NUM_SPACEBLOCKS,c)->category));
+}
+
+/*
+	Define predicate functions for some combinations of categories.
+*/
+
+#define unipred(p,m) \
+int p(int c) \
+{ \
+	return checkattr(c,m); \
+}
+
+#define unipred_s(p,m) \
+int p(int c) \
+{ \
+        return checkattr_s(c,m); \
+}
+
+/*
+	Make these rules as close to Hugs as possible.
+*/
+
+unipred(u_iswcntrl,GENCAT_CC)
+unipred(u_iswprint, (GENCAT_MC | GENCAT_NO | GENCAT_SK | GENCAT_ME | GENCAT_ND |   GENCAT_PO | GENCAT_LT | GENCAT_PC | GENCAT_SM | GENCAT_ZS |   GENCAT_LU | GENCAT_PD | GENCAT_SO | GENCAT_PE | GENCAT_PF |   GENCAT_PS | GENCAT_SC | GENCAT_LL | GENCAT_LM | GENCAT_PI |   GENCAT_NL | GENCAT_MN | GENCAT_LO))
+unipred_s(u_iswspace,GENCAT_ZS)
+unipred(u_iswupper,(GENCAT_LU|GENCAT_LT))
+unipred(u_iswlower,GENCAT_LL)
+unipred(u_iswalpha,(GENCAT_LL|GENCAT_LU|GENCAT_LT|GENCAT_LM|GENCAT_LO))
+unipred(u_iswdigit,GENCAT_ND)
+
+unipred(u_iswalnum,(GENCAT_LT|GENCAT_LU|GENCAT_LL|GENCAT_LM|GENCAT_LO|
+		    GENCAT_MC|GENCAT_ME|GENCAT_MN|
+		    GENCAT_NO|GENCAT_ND|GENCAT_NL))
+
+#define caseconv(p,to) \
+int p(int c) \
+{ \
+	const struct _convrule_ *rule=getrule(convchars,NUM_CONVBLOCKS,c);\
+	if(rule==&nullrule) return c;\
+	return c+rule->to;\
+}
+
+caseconv(u_towupper,updist)
+caseconv(u_towlower,lowdist)
+caseconv(u_towtitle,titledist)
+
+int u_gencat(int c)
+{
+	return getrule(allchars,NUM_BLOCKS,c)->catnumber;
+}
+
diff --git a/libraries/base/cbits/Win32Utils.c b/libraries/base/cbits/Win32Utils.c
new file mode 100644
index 000000000000..7038cbf48e7d
--- /dev/null
+++ b/libraries/base/cbits/Win32Utils.c
@@ -0,0 +1,151 @@
+/* ----------------------------------------------------------------------------
+   (c) The University of Glasgow 2006
+   
+   Useful Win32 bits
+   ------------------------------------------------------------------------- */
+
+#if defined(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32)
+
+#include "HsBase.h"
+
+/* This is the error table that defines the mapping between OS error
+   codes and errno values */
+
+struct errentry {
+        unsigned long oscode;           /* OS return value */
+        int errnocode;  /* System V error code */
+};
+
+static struct errentry errtable[] = {
+        {  ERROR_INVALID_FUNCTION,       EINVAL    },  /* 1 */
+        {  ERROR_FILE_NOT_FOUND,         ENOENT    },  /* 2 */
+        {  ERROR_PATH_NOT_FOUND,         ENOENT    },  /* 3 */
+        {  ERROR_TOO_MANY_OPEN_FILES,    EMFILE    },  /* 4 */
+        {  ERROR_ACCESS_DENIED,          EACCES    },  /* 5 */
+        {  ERROR_INVALID_HANDLE,         EBADF     },  /* 6 */
+        {  ERROR_ARENA_TRASHED,          ENOMEM    },  /* 7 */
+        {  ERROR_NOT_ENOUGH_MEMORY,      ENOMEM    },  /* 8 */
+        {  ERROR_INVALID_BLOCK,          ENOMEM    },  /* 9 */
+        {  ERROR_BAD_ENVIRONMENT,        E2BIG     },  /* 10 */
+        {  ERROR_BAD_FORMAT,             ENOEXEC   },  /* 11 */
+        {  ERROR_INVALID_ACCESS,         EINVAL    },  /* 12 */
+        {  ERROR_INVALID_DATA,           EINVAL    },  /* 13 */
+        {  ERROR_INVALID_DRIVE,          ENOENT    },  /* 15 */
+        {  ERROR_CURRENT_DIRECTORY,      EACCES    },  /* 16 */
+        {  ERROR_NOT_SAME_DEVICE,        EXDEV     },  /* 17 */
+        {  ERROR_NO_MORE_FILES,          ENOENT    },  /* 18 */
+        {  ERROR_LOCK_VIOLATION,         EACCES    },  /* 33 */
+        {  ERROR_BAD_NETPATH,            ENOENT    },  /* 53 */
+        {  ERROR_NETWORK_ACCESS_DENIED,  EACCES    },  /* 65 */
+        {  ERROR_BAD_NET_NAME,           ENOENT    },  /* 67 */
+        {  ERROR_FILE_EXISTS,            EEXIST    },  /* 80 */
+        {  ERROR_CANNOT_MAKE,            EACCES    },  /* 82 */
+        {  ERROR_FAIL_I24,               EACCES    },  /* 83 */
+        {  ERROR_INVALID_PARAMETER,      EINVAL    },  /* 87 */
+        {  ERROR_NO_PROC_SLOTS,          EAGAIN    },  /* 89 */
+        {  ERROR_DRIVE_LOCKED,           EACCES    },  /* 108 */
+        {  ERROR_BROKEN_PIPE,            EPIPE     },  /* 109 */
+        {  ERROR_DISK_FULL,              ENOSPC    },  /* 112 */
+        {  ERROR_INVALID_TARGET_HANDLE,  EBADF     },  /* 114 */
+        {  ERROR_INVALID_HANDLE,         EINVAL    },  /* 124 */
+        {  ERROR_WAIT_NO_CHILDREN,       ECHILD    },  /* 128 */
+        {  ERROR_CHILD_NOT_COMPLETE,     ECHILD    },  /* 129 */
+        {  ERROR_DIRECT_ACCESS_HANDLE,   EBADF     },  /* 130 */
+        {  ERROR_NEGATIVE_SEEK,          EINVAL    },  /* 131 */
+        {  ERROR_SEEK_ON_DEVICE,         EACCES    },  /* 132 */
+        {  ERROR_DIR_NOT_EMPTY,          ENOTEMPTY },  /* 145 */
+        {  ERROR_NOT_LOCKED,             EACCES    },  /* 158 */
+        {  ERROR_BAD_PATHNAME,           ENOENT    },  /* 161 */
+        {  ERROR_MAX_THRDS_REACHED,      EAGAIN    },  /* 164 */
+        {  ERROR_LOCK_FAILED,            EACCES    },  /* 167 */
+        {  ERROR_ALREADY_EXISTS,         EEXIST    },  /* 183 */
+        {  ERROR_FILENAME_EXCED_RANGE,   ENOENT    },  /* 206 */
+        {  ERROR_NESTING_NOT_ALLOWED,    EAGAIN    },  /* 215 */
+           /* Windows returns this when the read end of a pipe is
+            * closed (or closing) and we write to it. */
+        {  ERROR_NO_DATA,                EPIPE     },  /* 232 */
+        {  ERROR_NOT_ENOUGH_QUOTA,       ENOMEM    }  /* 1816 */
+};
+
+/* size of the table */
+#define ERRTABLESIZE (sizeof(errtable)/sizeof(errtable[0]))
+
+/* The following two constants must be the minimum and maximum
+   values in the (contiguous) range of Exec Failure errors. */
+#define MIN_EXEC_ERROR ERROR_INVALID_STARTING_CODESEG
+#define MAX_EXEC_ERROR ERROR_INFLOOP_IN_RELOC_CHAIN
+
+/* These are the low and high value in the range of errors that are
+   access violations */
+#define MIN_EACCES_RANGE ERROR_WRITE_PROTECT
+#define MAX_EACCES_RANGE ERROR_SHARING_BUFFER_EXCEEDED
+
+void maperrno(void)
+{
+    errno = maperrno_func(GetLastError());
+}
+
+int maperrno_func(DWORD dwErrorCode)
+{
+    int i;
+
+    /* check the table for the OS error code */
+    for (i = 0; i < ERRTABLESIZE; ++i)
+        if (dwErrorCode == errtable[i].oscode)
+            return errtable[i].errnocode;
+
+    /* The error code wasn't in the table.  We check for a range of */
+    /* EACCES errors or exec failure errors (ENOEXEC).  Otherwise   */
+    /* EINVAL is returned.                                          */
+
+    if (dwErrorCode >= MIN_EACCES_RANGE && dwErrorCode <= MAX_EACCES_RANGE)
+        return EACCES;
+    else if (dwErrorCode >= MIN_EXEC_ERROR && dwErrorCode <= MAX_EXEC_ERROR)
+        return ENOEXEC;
+    else
+        return EINVAL;
+}
+
+LPWSTR base_getErrorMessage(DWORD err)
+{
+    LPWSTR what;
+    DWORD res;
+
+    res = FormatMessageW(
+              (FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_ALLOCATE_BUFFER),
+              NULL,
+              err,
+              MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), /* Default language */
+              (LPWSTR) &what,
+              0,
+              NULL
+          );
+    if (res == 0)
+        return NULL;
+    return what;
+}
+
+int get_unique_file_info(int fd, HsWord64 *dev, HsWord64 *ino)
+{
+    HANDLE h = (HANDLE)_get_osfhandle(fd);
+    BY_HANDLE_FILE_INFORMATION info;
+
+    if (GetFileInformationByHandle(h, &info))
+    {
+        *dev = info.dwVolumeSerialNumber;
+        *ino = info.nFileIndexLow
+             | ((HsWord64)info.nFileIndexHigh << 32);
+
+        return 0;
+    }
+
+    return -1;
+}
+
+BOOL file_exists(LPCTSTR path)
+{
+    DWORD r = GetFileAttributes(path);
+    return r != INVALID_FILE_ATTRIBUTES;
+}
+
+#endif
diff --git a/libraries/base/cbits/consUtils.c b/libraries/base/cbits/consUtils.c
new file mode 100644
index 000000000000..b20eb7ae07c4
--- /dev/null
+++ b/libraries/base/cbits/consUtils.c
@@ -0,0 +1,111 @@
+/* 
+ * (c) The University of Glasgow 2002
+ *
+ * Win32 Console API support
+ */
+#if defined(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32) || defined(__CYGWIN__)
+/* to the end */
+
+#include "consUtils.h"
+#include <windows.h>
+#include <io.h>
+
+#if defined(__CYGWIN__)
+#define _get_osfhandle get_osfhandle
+#endif
+
+int is_console__(int fd) {
+    DWORD st;
+    HANDLE h;
+    if (!_isatty(fd)) {
+        /* TTY must be a character device */
+        return 0;
+    }
+    h = (HANDLE)_get_osfhandle(fd);
+    if (h == INVALID_HANDLE_VALUE) {
+        /* Broken handle can't be terminal */
+        return 0;
+    }
+    if (!GetConsoleMode(h, &st)) {
+        /* GetConsoleMode appears to fail when it's not a TTY.  In
+           particular, it's what most of our terminal functions
+           assume works, so if it doesn't work for all intents
+           and purposes we're not dealing with a terminal. */
+        return 0;
+    }
+    return 1;
+}
+
+
+int
+set_console_buffering__(int fd, int cooked)
+{
+    HANDLE h;
+    DWORD  st;
+    /* According to GetConsoleMode() docs, it is not possible to
+       leave ECHO_INPUT enabled without also having LINE_INPUT,
+       so we have to turn both off here. */
+    DWORD flgs = ENABLE_LINE_INPUT | ENABLE_ECHO_INPUT;
+    
+    if ( (h = (HANDLE)_get_osfhandle(fd)) != INVALID_HANDLE_VALUE ) {
+	if ( GetConsoleMode(h,&st) &&
+	     SetConsoleMode(h, cooked ? (st | ENABLE_LINE_INPUT) : st & ~flgs)  ) {
+	    return 0;
+	}
+    }
+    return -1;
+}
+
+int
+set_console_echo__(int fd, int on)
+{
+    HANDLE h;
+    DWORD  st;
+    DWORD flgs = ENABLE_LINE_INPUT | ENABLE_ECHO_INPUT;
+    
+    if ( (h = (HANDLE)_get_osfhandle(fd)) != INVALID_HANDLE_VALUE ) {
+	if ( GetConsoleMode(h,&st) && 
+	     SetConsoleMode(h,( on ? (st | flgs) : (st & ~ENABLE_ECHO_INPUT))) ) {
+	    return 0;
+	}
+    }
+    return -1;
+}
+
+int
+get_console_echo__(int fd)
+{
+    HANDLE h;
+    DWORD  st;
+    
+    if ( (h = (HANDLE)_get_osfhandle(fd)) != INVALID_HANDLE_VALUE ) {
+	if ( GetConsoleMode(h,&st) ) {
+	    return (st & ENABLE_ECHO_INPUT ? 1 : 0);
+	}
+    }
+    return -1;
+}
+
+int
+flush_input_console__(int fd)
+{
+    HANDLE h = (HANDLE)_get_osfhandle(fd);
+    
+    if ( h != INVALID_HANDLE_VALUE ) {
+	/* If the 'fd' isn't connected to a console; treat the flush
+	 * operation as a NOP.
+	 */
+	DWORD unused;
+	if ( !GetConsoleMode(h,&unused) &&
+	     GetLastError() == ERROR_INVALID_HANDLE ) {
+	    return 0;
+	}
+	if ( FlushConsoleInputBuffer(h) ) {
+	    return 0;
+	}
+    }
+    /* ToDo: translate GetLastError() into something errno-friendly */
+    return -1;
+}
+
+#endif /* defined(__MINGW32__) || ... */
diff --git a/libraries/base/cbits/iconv.c b/libraries/base/cbits/iconv.c
new file mode 100644
index 000000000000..4aedca858793
--- /dev/null
+++ b/libraries/base/cbits/iconv.c
@@ -0,0 +1,25 @@
+#ifndef __MINGW32__
+
+#include <stdlib.h>
+#include <iconv.h>
+
+iconv_t hs_iconv_open(const char* tocode,
+		      const char* fromcode)
+{
+	return iconv_open(tocode, fromcode);
+}
+
+size_t hs_iconv(iconv_t cd,
+		const char* * inbuf, size_t * inbytesleft,
+		char* * outbuf, size_t * outbytesleft)
+{
+    // (void*) cast avoids a warning.  Some iconvs use (const
+    // char**inbuf), other use (char **inbuf).
+    return iconv(cd, (void*)inbuf, inbytesleft, outbuf, outbytesleft);
+}
+
+int hs_iconv_close(iconv_t cd) {
+	return iconv_close(cd);
+}
+
+#endif
diff --git a/libraries/base/cbits/inputReady.c b/libraries/base/cbits/inputReady.c
new file mode 100644
index 000000000000..dac9d9b524ac
--- /dev/null
+++ b/libraries/base/cbits/inputReady.c
@@ -0,0 +1,172 @@
+/* 
+ * (c) The GRASP/AQUA Project, Glasgow University, 1994-2002
+ *
+ * hWaitForInput Runtime Support
+ */
+
+/* select and supporting types is not Posix */
+/* #include "PosixSource.h" */
+#include "HsBase.h"
+
+/*
+ * inputReady(fd) checks to see whether input is available on the file
+ * descriptor 'fd'.  Input meaning 'can I safely read at least a
+ * *character* from this file object without blocking?'
+ */
+int
+fdReady(int fd, int write, int msecs, int isSock)
+{
+    if 
+#if defined(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32)
+    ( isSock ) {
+#else
+    ( 1 ) {
+#endif
+	int maxfd, ready;
+	fd_set rfd, wfd;
+	struct timeval tv;
+        if ((fd >= (int)FD_SETSIZE) || (fd < 0)) {
+            /* avoid memory corruption on too large FDs */
+            errno = EINVAL;
+            return -1;
+        }
+	FD_ZERO(&rfd);
+	FD_ZERO(&wfd);
+        if (write) {
+            FD_SET(fd, &wfd);
+        } else {
+            FD_SET(fd, &rfd);
+        }
+	
+	/* select() will consider the descriptor set in the range of 0 to
+	 * (maxfd-1) 
+	 */
+	maxfd = fd + 1;
+	tv.tv_sec  = msecs / 1000;
+	tv.tv_usec = (msecs % 1000) * 1000;
+	
+	while ((ready = select(maxfd, &rfd, &wfd, NULL, &tv)) < 0 ) {
+	    if (errno != EINTR ) {
+		return -1;
+	    }
+	}
+	
+	/* 1 => Input ready, 0 => not ready, -1 => error */
+	return (ready);
+    }
+#if defined(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32)
+    else {
+	DWORD rc;
+	HANDLE hFile = (HANDLE)_get_osfhandle(fd);
+	DWORD avail;
+
+        switch (GetFileType(hFile)) {
+
+        case FILE_TYPE_CHAR:
+        {
+            INPUT_RECORD buf[1];
+            DWORD count;
+
+            // nightmare.  A Console Handle will appear to be ready
+            // (WaitForSingleObject() returned WAIT_OBJECT_0) when
+            // it has events in its input buffer, but these events might
+            // not be keyboard events, so when we read from the Handle the
+            // read() will block.  So here we try to discard non-keyboard
+            // events from a console handle's input buffer and then try
+            // the WaitForSingleObject() again.
+
+            while (1) // keep trying until we find a real key event
+            {
+                rc = WaitForSingleObject( hFile, msecs );
+                switch (rc) {
+                case WAIT_TIMEOUT: return 0;
+                case WAIT_OBJECT_0: break;
+                default: /* WAIT_FAILED */ maperrno(); return -1;
+                }
+
+                while (1) // discard non-key events
+                {
+                    rc = PeekConsoleInput(hFile, buf, 1, &count);
+                    // printf("peek, rc=%d, count=%d, type=%d\n", rc, count, buf[0].EventType);
+                    if (rc == 0) {
+                        rc = GetLastError();
+                        if (rc == ERROR_INVALID_HANDLE || rc == ERROR_INVALID_FUNCTION) {
+                            return 1;
+                        } else {
+                            maperrno();
+                            return -1;
+                        }
+                    }
+
+                    if (count == 0) break; // no more events => wait again
+
+                    // discard console events that are not "key down", because
+                    // these will also be discarded by ReadFile().
+                    if (buf[0].EventType == KEY_EVENT &&
+                        buf[0].Event.KeyEvent.bKeyDown &&
+                        buf[0].Event.KeyEvent.uChar.AsciiChar != '\0')
+                    {
+                        // it's a proper keypress:
+                        return 1;
+                    }
+                    else
+                    {
+                        // it's a non-key event, a key up event, or a
+                        // non-character key (e.g. shift).  discard it.
+                        rc = ReadConsoleInput(hFile, buf, 1, &count);
+                        if (rc == 0) {
+                            rc = GetLastError();
+                            if (rc == ERROR_INVALID_HANDLE || rc == ERROR_INVALID_FUNCTION) {
+                                return 1;
+                            } else {
+                                maperrno();
+                                return -1;
+                            }
+                        }
+                    }
+                }
+            }
+        }
+
+        case FILE_TYPE_DISK:
+            // assume that disk files are always ready:
+            return 1;
+
+        case FILE_TYPE_PIPE:
+            // WaitForMultipleObjects() doesn't work for pipes (it
+            // always returns WAIT_OBJECT_0 even when no data is
+            // available).  If the HANDLE is a pipe, therefore, we try
+            // PeekNamedPipe:
+            //
+            rc = PeekNamedPipe( hFile, NULL, 0, NULL, &avail, NULL );
+            if (rc != 0) {
+                if (avail != 0) {
+                    return 1;
+                } else {
+                    return 0;
+                }
+            } else {
+                rc = GetLastError();
+                if (rc == ERROR_BROKEN_PIPE) {
+                    return 1; // this is probably what we want
+                }
+                if (rc != ERROR_INVALID_HANDLE && rc != ERROR_INVALID_FUNCTION) {
+                    maperrno();
+                    return -1;
+                }
+            }
+            /* PeekNamedPipe didn't work - fall through to the general case */
+
+        default:
+            rc = WaitForSingleObject( hFile, msecs );
+
+            /* 1 => Input ready, 0 => not ready, -1 => error */
+            switch (rc) {
+            case WAIT_TIMEOUT: return 0;
+            case WAIT_OBJECT_0: return 1;
+            default: /* WAIT_FAILED */ maperrno(); return -1;
+            }
+        }
+    }
+#endif
+}    
diff --git a/libraries/base/cbits/md5.c b/libraries/base/cbits/md5.c
new file mode 100644
index 000000000000..0c019be290c4
--- /dev/null
+++ b/libraries/base/cbits/md5.c
@@ -0,0 +1,238 @@
+/*
+ * This code implements the MD5 message-digest algorithm.
+ * The algorithm is due to Ron Rivest.  This code was
+ * written by Colin Plumb in 1993, no copyright is claimed.
+ * This code is in the public domain; do with it what you wish.
+ *
+ * Equivalent code is available from RSA Data Security, Inc.
+ * This code has been tested against that, and is equivalent,
+ * except that you don't need to include two pages of legalese
+ * with every copy.
+ *
+ * To compute the message digest of a chunk of bytes, declare an
+ * MD5Context structure, pass it to MD5Init, call MD5Update as
+ * needed on buffers full of bytes, and then call MD5Final, which
+ * will fill a supplied 16-byte array with the digest.
+ */
+
+#include "HsFFI.h"
+#include "md5.h"
+#include <string.h>
+
+void __hsbase_MD5Init(struct MD5Context *context);
+void __hsbase_MD5Update(struct MD5Context *context, byte const *buf, int len);
+void __hsbase_MD5Final(byte digest[16], struct MD5Context *context);
+void __hsbase_MD5Transform(word32 buf[4], word32 const in[16]);
+
+
+/*
+ * Shuffle the bytes into little-endian order within words, as per the
+ * MD5 spec.  Note: this code works regardless of the byte order.
+ */
+static void
+byteSwap(word32 *buf, unsigned words)
+{
+	byte *p = (byte *)buf;
+
+	do {
+		*buf++ = (word32)((unsigned)p[3] << 8 | p[2]) << 16 |
+			((unsigned)p[1] << 8 | p[0]);
+		p += 4;
+	} while (--words);
+}
+
+/*
+ * Start MD5 accumulation.  Set bit count to 0 and buffer to mysterious
+ * initialization constants.
+ */
+void
+__hsbase_MD5Init(struct MD5Context *ctx)
+{
+	ctx->buf[0] = 0x67452301;
+	ctx->buf[1] = 0xefcdab89;
+	ctx->buf[2] = 0x98badcfe;
+	ctx->buf[3] = 0x10325476;
+
+	ctx->bytes[0] = 0;
+	ctx->bytes[1] = 0;
+}
+
+/*
+ * Update context to reflect the concatenation of another buffer full
+ * of bytes.
+ */
+void
+__hsbase_MD5Update(struct MD5Context *ctx, byte const *buf, int len)
+{
+	word32 t;
+
+	/* Update byte count */
+
+	t = ctx->bytes[0];
+	if ((ctx->bytes[0] = t + len) < t)
+		ctx->bytes[1]++;	/* Carry from low to high */
+
+	t = 64 - (t & 0x3f);	/* Space available in ctx->in (at least 1) */
+	if ((unsigned)t > len) {
+		memcpy((byte *)ctx->in + 64 - (unsigned)t, buf, len);
+		return;
+	}
+	/* First chunk is an odd size */
+	memcpy((byte *)ctx->in + 64 - (unsigned)t, buf, (unsigned)t);
+	byteSwap(ctx->in, 16);
+        __hsbase_MD5Transform(ctx->buf, ctx->in);
+	buf += (unsigned)t;
+	len -= (unsigned)t;
+
+	/* Process data in 64-byte chunks */
+	while (len >= 64) {
+		memcpy(ctx->in, buf, 64);
+		byteSwap(ctx->in, 16);
+                __hsbase_MD5Transform(ctx->buf, ctx->in);
+		buf += 64;
+		len -= 64;
+	}
+
+	/* Handle any remaining bytes of data. */
+	memcpy(ctx->in, buf, len);
+}
+
+/*
+ * Final wrapup - pad to 64-byte boundary with the bit pattern 
+ * 1 0* (64-bit count of bits processed, MSB-first)
+ */
+void
+__hsbase_MD5Final(byte digest[16], struct MD5Context *ctx)
+{
+	int count = (int)(ctx->bytes[0] & 0x3f); /* Bytes in ctx->in */
+	byte *p = (byte *)ctx->in + count;	/* First unused byte */
+
+	/* Set the first char of padding to 0x80.  There is always room. */
+	*p++ = 0x80;
+
+	/* Bytes of padding needed to make 56 bytes (-8..55) */
+	count = 56 - 1 - count;
+
+	if (count < 0) {	/* Padding forces an extra block */
+		memset(p, 0, count+8);
+		byteSwap(ctx->in, 16);
+                __hsbase_MD5Transform(ctx->buf, ctx->in);
+		p = (byte *)ctx->in;
+		count = 56;
+	}
+	memset(p, 0, count+8);
+	byteSwap(ctx->in, 14);
+
+	/* Append length in bits and transform */
+	ctx->in[14] = ctx->bytes[0] << 3;
+	ctx->in[15] = ctx->bytes[1] << 3 | ctx->bytes[0] >> 29;
+        __hsbase_MD5Transform(ctx->buf, ctx->in);
+
+	byteSwap(ctx->buf, 4);
+	memcpy(digest, ctx->buf, 16);
+	memset(ctx, 0, sizeof(*ctx));
+}
+
+
+/* The four core functions - F1 is optimized somewhat */
+
+/* #define F1(x, y, z) (x & y | ~x & z) */
+#define F1(x, y, z) (z ^ (x & (y ^ z)))
+#define F2(x, y, z) F1(z, x, y)
+#define F3(x, y, z) (x ^ y ^ z)
+#define F4(x, y, z) (y ^ (x | ~z))
+
+/* This is the central step in the MD5 algorithm. */
+#define MD5STEP(f,w,x,y,z,in,s) \
+	 (w += f(x,y,z) + in, w = (w<<s | w>>(32-s)) + x)
+
+/*
+ * The core of the MD5 algorithm, this alters an existing MD5 hash to
+ * reflect the addition of 16 longwords of new data.  MD5Update blocks
+ * the data and converts bytes into longwords for this routine.
+ */
+
+void
+__hsbase_MD5Transform(word32 buf[4], word32 const in[16])
+{
+	register word32 a, b, c, d;
+
+	a = buf[0];
+	b = buf[1];
+	c = buf[2];
+	d = buf[3];
+
+	MD5STEP(F1, a, b, c, d, in[0] + 0xd76aa478, 7);
+	MD5STEP(F1, d, a, b, c, in[1] + 0xe8c7b756, 12);
+	MD5STEP(F1, c, d, a, b, in[2] + 0x242070db, 17);
+	MD5STEP(F1, b, c, d, a, in[3] + 0xc1bdceee, 22);
+	MD5STEP(F1, a, b, c, d, in[4] + 0xf57c0faf, 7);
+	MD5STEP(F1, d, a, b, c, in[5] + 0x4787c62a, 12);
+	MD5STEP(F1, c, d, a, b, in[6] + 0xa8304613, 17);
+	MD5STEP(F1, b, c, d, a, in[7] + 0xfd469501, 22);
+	MD5STEP(F1, a, b, c, d, in[8] + 0x698098d8, 7);
+	MD5STEP(F1, d, a, b, c, in[9] + 0x8b44f7af, 12);
+	MD5STEP(F1, c, d, a, b, in[10] + 0xffff5bb1, 17);
+	MD5STEP(F1, b, c, d, a, in[11] + 0x895cd7be, 22);
+	MD5STEP(F1, a, b, c, d, in[12] + 0x6b901122, 7);
+	MD5STEP(F1, d, a, b, c, in[13] + 0xfd987193, 12);
+	MD5STEP(F1, c, d, a, b, in[14] + 0xa679438e, 17);
+	MD5STEP(F1, b, c, d, a, in[15] + 0x49b40821, 22);
+
+	MD5STEP(F2, a, b, c, d, in[1] + 0xf61e2562, 5);
+	MD5STEP(F2, d, a, b, c, in[6] + 0xc040b340, 9);
+	MD5STEP(F2, c, d, a, b, in[11] + 0x265e5a51, 14);
+	MD5STEP(F2, b, c, d, a, in[0] + 0xe9b6c7aa, 20);
+	MD5STEP(F2, a, b, c, d, in[5] + 0xd62f105d, 5);
+	MD5STEP(F2, d, a, b, c, in[10] + 0x02441453, 9);
+	MD5STEP(F2, c, d, a, b, in[15] + 0xd8a1e681, 14);
+	MD5STEP(F2, b, c, d, a, in[4] + 0xe7d3fbc8, 20);
+	MD5STEP(F2, a, b, c, d, in[9] + 0x21e1cde6, 5);
+	MD5STEP(F2, d, a, b, c, in[14] + 0xc33707d6, 9);
+	MD5STEP(F2, c, d, a, b, in[3] + 0xf4d50d87, 14);
+	MD5STEP(F2, b, c, d, a, in[8] + 0x455a14ed, 20);
+	MD5STEP(F2, a, b, c, d, in[13] + 0xa9e3e905, 5);
+	MD5STEP(F2, d, a, b, c, in[2] + 0xfcefa3f8, 9);
+	MD5STEP(F2, c, d, a, b, in[7] + 0x676f02d9, 14);
+	MD5STEP(F2, b, c, d, a, in[12] + 0x8d2a4c8a, 20);
+
+	MD5STEP(F3, a, b, c, d, in[5] + 0xfffa3942, 4);
+	MD5STEP(F3, d, a, b, c, in[8] + 0x8771f681, 11);
+	MD5STEP(F3, c, d, a, b, in[11] + 0x6d9d6122, 16);
+	MD5STEP(F3, b, c, d, a, in[14] + 0xfde5380c, 23);
+	MD5STEP(F3, a, b, c, d, in[1] + 0xa4beea44, 4);
+	MD5STEP(F3, d, a, b, c, in[4] + 0x4bdecfa9, 11);
+	MD5STEP(F3, c, d, a, b, in[7] + 0xf6bb4b60, 16);
+	MD5STEP(F3, b, c, d, a, in[10] + 0xbebfbc70, 23);
+	MD5STEP(F3, a, b, c, d, in[13] + 0x289b7ec6, 4);
+	MD5STEP(F3, d, a, b, c, in[0] + 0xeaa127fa, 11);
+	MD5STEP(F3, c, d, a, b, in[3] + 0xd4ef3085, 16);
+	MD5STEP(F3, b, c, d, a, in[6] + 0x04881d05, 23);
+	MD5STEP(F3, a, b, c, d, in[9] + 0xd9d4d039, 4);
+	MD5STEP(F3, d, a, b, c, in[12] + 0xe6db99e5, 11);
+	MD5STEP(F3, c, d, a, b, in[15] + 0x1fa27cf8, 16);
+	MD5STEP(F3, b, c, d, a, in[2] + 0xc4ac5665, 23);
+
+	MD5STEP(F4, a, b, c, d, in[0] + 0xf4292244, 6);
+	MD5STEP(F4, d, a, b, c, in[7] + 0x432aff97, 10);
+	MD5STEP(F4, c, d, a, b, in[14] + 0xab9423a7, 15);
+	MD5STEP(F4, b, c, d, a, in[5] + 0xfc93a039, 21);
+	MD5STEP(F4, a, b, c, d, in[12] + 0x655b59c3, 6);
+	MD5STEP(F4, d, a, b, c, in[3] + 0x8f0ccc92, 10);
+	MD5STEP(F4, c, d, a, b, in[10] + 0xffeff47d, 15);
+	MD5STEP(F4, b, c, d, a, in[1] + 0x85845dd1, 21);
+	MD5STEP(F4, a, b, c, d, in[8] + 0x6fa87e4f, 6);
+	MD5STEP(F4, d, a, b, c, in[15] + 0xfe2ce6e0, 10);
+	MD5STEP(F4, c, d, a, b, in[6] + 0xa3014314, 15);
+	MD5STEP(F4, b, c, d, a, in[13] + 0x4e0811a1, 21);
+	MD5STEP(F4, a, b, c, d, in[4] + 0xf7537e82, 6);
+	MD5STEP(F4, d, a, b, c, in[11] + 0xbd3af235, 10);
+	MD5STEP(F4, c, d, a, b, in[2] + 0x2ad7d2bb, 15);
+	MD5STEP(F4, b, c, d, a, in[9] + 0xeb86d391, 21);
+
+	buf[0] += a;
+	buf[1] += b;
+	buf[2] += c;
+	buf[3] += d;
+}
+
diff --git a/libraries/base/cbits/primFloat.c b/libraries/base/cbits/primFloat.c
new file mode 100644
index 000000000000..7ac03202f9f0
--- /dev/null
+++ b/libraries/base/cbits/primFloat.c
@@ -0,0 +1,532 @@
+/* -----------------------------------------------------------------------------
+ *
+ * (c) Lennart Augustsson
+ * (c) The GHC Team, 1998-2000
+ *
+ * Miscellaneous support for floating-point primitives
+ *
+ * ---------------------------------------------------------------------------*/
+
+#include "HsFFI.h"
+#include "Rts.h" // XXX wrong (for IEEE_FLOATING_POINT and WORDS_BIGENDIAN)
+
+#define IEEE_FLOATING_POINT 1
+
+union stg_ieee754_flt
+{
+   float f;
+   struct {
+
+#if WORDS_BIGENDIAN
+	unsigned int negative:1;
+	unsigned int exponent:8;
+	unsigned int mantissa:23;
+#else
+	unsigned int mantissa:23;
+	unsigned int exponent:8;
+	unsigned int negative:1;
+#endif
+   } ieee;
+   struct {
+
+#if WORDS_BIGENDIAN
+	unsigned int negative:1;
+	unsigned int exponent:8;
+	unsigned int quiet_nan:1;
+	unsigned int mantissa:22;
+#else
+	unsigned int mantissa:22;
+	unsigned int quiet_nan:1;
+	unsigned int exponent:8;
+	unsigned int negative:1;
+#endif
+   } ieee_nan;
+};
+
+/*
+
+ To recap, here's the representation of a double precision
+ IEEE floating point number:
+
+ sign         63           sign bit (0==positive, 1==negative)
+ exponent     62-52        exponent (biased by 1023)
+ fraction     51-0         fraction (bits to right of binary point)
+*/
+
+union stg_ieee754_dbl
+{
+   double d;
+   struct {
+
+#if WORDS_BIGENDIAN
+	unsigned int negative:1;
+	unsigned int exponent:11;
+	unsigned int mantissa0:20;
+	unsigned int mantissa1:32;
+#else
+#if FLOAT_WORDS_BIGENDIAN
+	unsigned int mantissa0:20;
+	unsigned int exponent:11;
+	unsigned int negative:1;
+	unsigned int mantissa1:32;
+#else
+	unsigned int mantissa1:32;
+	unsigned int mantissa0:20;
+	unsigned int exponent:11;
+	unsigned int negative:1;
+#endif
+#endif
+   } ieee;
+    /* This format makes it easier to see if a NaN is a signalling NaN.  */
+   struct {
+
+#if WORDS_BIGENDIAN
+	unsigned int negative:1;
+	unsigned int exponent:11;
+	unsigned int quiet_nan:1;
+	unsigned int mantissa0:19;
+	unsigned int mantissa1:32;
+#else
+#if FLOAT_WORDS_BIGENDIAN
+	unsigned int mantissa0:19;
+	unsigned int quiet_nan:1;
+	unsigned int exponent:11;
+	unsigned int negative:1;
+	unsigned int mantissa1:32;
+#else
+	unsigned int mantissa1:32;
+	unsigned int mantissa0:19;
+	unsigned int quiet_nan:1;
+	unsigned int exponent:11;
+	unsigned int negative:1;
+#endif
+#endif
+   } ieee_nan;
+};
+
+/*
+ * Predicates for testing for extreme IEEE fp values.
+ */
+
+/* In case you don't suppport IEEE, you'll just get dummy defs.. */
+#ifdef IEEE_FLOATING_POINT
+
+HsInt
+isDoubleFinite(HsDouble d)
+{
+  union stg_ieee754_dbl u;
+
+  u.d = d;
+
+  return u.ieee.exponent != 2047;
+}
+
+HsInt
+isDoubleNaN(HsDouble d)
+{
+  union stg_ieee754_dbl u;
+
+  u.d = d;
+
+  return (
+    u.ieee.exponent  == 2047 /* 2^11 - 1 */ &&  /* Is the exponent all ones? */
+    (u.ieee.mantissa0 != 0 || u.ieee.mantissa1 != 0)
+    	/* and the mantissa non-zero? */
+    );
+}
+
+HsInt
+isDoubleInfinite(HsDouble d)
+{
+    union stg_ieee754_dbl u;
+
+    u.d = d;
+
+    /* Inf iff exponent is all ones, mantissa all zeros */
+    return (
+        u.ieee.exponent  == 2047 /* 2^11 - 1 */ &&
+	u.ieee.mantissa0 == 0 		        &&
+	u.ieee.mantissa1 == 0
+      );
+}
+
+HsInt
+isDoubleDenormalized(HsDouble d)
+{
+    union stg_ieee754_dbl u;
+
+    u.d = d;
+
+    /* A (single/double/quad) precision floating point number
+       is denormalised iff:
+        - exponent is zero
+	- mantissa is non-zero.
+        - (don't care about setting of sign bit.)
+
+    */
+    return (
+	u.ieee.exponent  == 0 &&
+	(u.ieee.mantissa0 != 0 ||
+	 u.ieee.mantissa1 != 0)
+      );
+
+}
+
+HsInt
+isDoubleNegativeZero(HsDouble d)
+{
+    union stg_ieee754_dbl u;
+
+    u.d = d;
+    /* sign (bit 63) set (only) => negative zero */
+
+    return (
+    	u.ieee.negative  == 1 &&
+	u.ieee.exponent  == 0 &&
+	u.ieee.mantissa0 == 0 &&
+	u.ieee.mantissa1 == 0);
+}
+
+/* Same tests, this time for HsFloats. */
+
+/*
+ To recap, here's the representation of a single precision
+ IEEE floating point number:
+
+ sign         31           sign bit (0 == positive, 1 == negative)
+ exponent     30-23        exponent (biased by 127)
+ fraction     22-0         fraction (bits to right of binary point)
+*/
+
+
+HsInt
+isFloatFinite(HsFloat f)
+{
+    union stg_ieee754_flt u;
+    u.f = f;
+    return u.ieee.exponent != 255;
+}
+
+HsInt
+isFloatNaN(HsFloat f)
+{
+    union stg_ieee754_flt u;
+    u.f = f;
+
+   /* Floating point NaN iff exponent is all ones, mantissa is
+      non-zero (but see below.) */
+   return (
+   	u.ieee.exponent == 255 /* 2^8 - 1 */ &&
+	u.ieee.mantissa != 0);
+}
+
+HsInt
+isFloatInfinite(HsFloat f)
+{
+    union stg_ieee754_flt u;
+    u.f = f;
+
+    /* A float is Inf iff exponent is max (all ones),
+       and mantissa is min(all zeros.) */
+    return (
+    	u.ieee.exponent == 255 /* 2^8 - 1 */ &&
+	u.ieee.mantissa == 0);
+}
+
+HsInt
+isFloatDenormalized(HsFloat f)
+{
+    union stg_ieee754_flt u;
+    u.f = f;
+
+    /* A (single/double/quad) precision floating point number
+       is denormalised iff:
+        - exponent is zero
+	- mantissa is non-zero.
+        - (don't care about setting of sign bit.)
+
+    */
+    return (
+    	u.ieee.exponent == 0 &&
+	u.ieee.mantissa != 0);
+}
+
+HsInt
+isFloatNegativeZero(HsFloat f)
+{
+    union stg_ieee754_flt u;
+    u.f = f;
+
+    /* sign (bit 31) set (only) => negative zero */
+    return (
+	u.ieee.negative      &&
+	u.ieee.exponent == 0 &&
+	u.ieee.mantissa == 0);
+}
+
+/*
+ There are glibc versions around with buggy rintf or rint, hence we
+ provide our own. We always round ties to even, so we can be simpler.
+*/
+
+#define FLT_HIDDEN 0x800000
+#define FLT_POWER2 0x1000000
+
+HsFloat
+rintFloat(HsFloat f)
+{
+    union stg_ieee754_flt u;
+    u.f = f;
+    /* if real exponent > 22, it's already integral, infinite or nan */
+    if (u.ieee.exponent > 149)  /* 22 + 127 */
+    {
+        return u.f;
+    }
+    if (u.ieee.exponent < 126)  /* (-1) + 127, abs(f) < 0.5 */
+    {
+        /* only used for rounding to Integral a, so don't care about -0.0 */
+        return 0.0;
+    }
+    /* 0.5 <= abs(f) < 2^23 */
+    unsigned int half, mask, mant, frac;
+    half = 1 << (149 - u.ieee.exponent);    /* bit for 0.5 */
+    mask = 2*half - 1;                      /* fraction bits */
+    mant = u.ieee.mantissa | FLT_HIDDEN;    /* add hidden bit */
+    frac = mant & mask;                     /* get fraction */
+    mant ^= frac;                           /* truncate mantissa */
+    if ((frac < half) || ((frac == half) && ((mant & (2*half)) == 0)))
+    {
+        /* this means we have to truncate */
+        if (mant == 0)
+        {
+            /* f == ±0.5, return 0.0 */
+            return 0.0;
+        }
+        else
+        {
+            /* remove hidden bit and set mantissa */
+            u.ieee.mantissa = mant ^ FLT_HIDDEN;
+            return u.f;
+        }
+    }
+    else
+    {
+        /* round away from zero, increment mantissa */
+        mant += 2*half;
+        if (mant == FLT_POWER2)
+        {
+            /* next power of 2, increase exponent an set mantissa to 0 */
+            u.ieee.mantissa = 0;
+            u.ieee.exponent += 1;
+            return u.f;
+        }
+        else
+        {
+            /* remove hidden bit and set mantissa */
+            u.ieee.mantissa = mant ^ FLT_HIDDEN;
+            return u.f;
+        }
+    }
+}
+
+#define DBL_HIDDEN 0x100000
+#define DBL_POWER2 0x200000
+#define LTOP_BIT 0x80000000
+
+HsDouble
+rintDouble(HsDouble d)
+{
+    union stg_ieee754_dbl u;
+    u.d = d;
+    /* if real exponent > 51, it's already integral, infinite or nan */
+    if (u.ieee.exponent > 1074) /* 51 + 1023 */
+    {
+        return u.d;
+    }
+    if (u.ieee.exponent < 1022)  /* (-1) + 1023, abs(d) < 0.5 */
+    {
+        /* only used for rounding to Integral a, so don't care about -0.0 */
+        return 0.0;
+    }
+    unsigned int half, mask, mant, frac;
+    if (u.ieee.exponent < 1043) /* 20 + 1023, real exponent < 20 */
+    {
+        /* the fractional part meets the higher part of the mantissa */
+        half = 1 << (1042 - u.ieee.exponent);   /* bit for 0.5 */
+        mask = 2*half - 1;                      /* fraction bits */
+        mant = u.ieee.mantissa0 | DBL_HIDDEN;   /* add hidden bit */
+        frac = mant & mask;                     /* get fraction */
+        mant ^= frac;                           /* truncate mantissa */
+        if ((frac < half) ||
+            ((frac == half) && (u.ieee.mantissa1 == 0)  /* a tie */
+                && ((mant & (2*half)) == 0)))
+        {
+            /* truncate */
+            if (mant == 0)
+            {
+                /* d = ±0.5, return 0.0 */
+                return 0.0;
+            }
+            /* remove hidden bit and set mantissa */
+            u.ieee.mantissa0 = mant ^ DBL_HIDDEN;
+            u.ieee.mantissa1 = 0;
+            return u.d;
+        }
+        else    /* round away from zero */
+        {
+            /* zero low mantissa bits */
+            u.ieee.mantissa1 = 0;
+            /* increment integer part of mantissa */
+            mant += 2*half;
+            if (mant == DBL_POWER2)
+            {
+                /* power of 2, increment exponent and zero mantissa */
+                u.ieee.mantissa0 = 0;
+                u.ieee.exponent += 1;
+                return u.d;
+            }
+            /* remove hidden bit */
+            u.ieee.mantissa0 = mant ^ DBL_HIDDEN;
+            return u.d;
+        }
+    }
+    else
+    {
+        /* 20 <= real exponent < 52, fractional part entirely in mantissa1 */
+        half = 1 << (1074 - u.ieee.exponent);   /* bit for 0.5 */
+        mask = 2*half - 1;                      /* fraction bits */
+        mant = u.ieee.mantissa1;                /* no hidden bit here */
+        frac = mant & mask;                     /* get fraction */
+        mant ^= frac;                           /* truncate mantissa */
+        if ((frac < half) ||
+            ((frac == half) &&                  /* tie */
+            (((half == LTOP_BIT) ? (u.ieee.mantissa0 & 1)  /* yuck */
+                                : (mant & (2*half)))
+                                        == 0)))
+        {
+            /* truncate */
+            u.ieee.mantissa1 = mant;
+            return u.d;
+        }
+        else
+        {
+            /* round away from zero */
+            /* increment mantissa */
+            mant += 2*half;
+            u.ieee.mantissa1 = mant;
+            if (mant == 0)
+            {
+                /* low part of mantissa overflowed */
+                /* increment high part of mantissa */
+                mant = u.ieee.mantissa0 + 1;
+                if (mant == DBL_HIDDEN)
+                {
+                    /* hit power of 2 */
+                    /* zero mantissa */
+                    u.ieee.mantissa0 = 0;
+                    /* and increment exponent */
+                    u.ieee.exponent += 1;
+                    return u.d;
+                }
+                else
+                {
+                    u.ieee.mantissa0 = mant;
+                    return u.d;
+                }
+            }
+            else
+            {
+                return u.d;
+            }
+        }
+    }
+}
+
+#else /* ! IEEE_FLOATING_POINT */
+
+/* Dummy definitions of predicates - they all return "normal" values */
+HsInt isDoubleFinite(HsDouble d) { return 1;}
+HsInt isDoubleNaN(HsDouble d) { return 0; }
+HsInt isDoubleInfinite(HsDouble d) { return 0; }
+HsInt isDoubleDenormalized(HsDouble d) { return 0; }
+HsInt isDoubleNegativeZero(HsDouble d) { return 0; }
+HsInt isFloatFinite(HsFloat f) { return 1; }
+HsInt isFloatNaN(HsFloat f) { return 0; }
+HsInt isFloatInfinite(HsFloat f) { return 0; }
+HsInt isFloatDenormalized(HsFloat f) { return 0; }
+HsInt isFloatNegativeZero(HsFloat f) { return 0; }
+
+
+/* For exotic floating point formats, we can't do much */
+/* We suppose the format has not too many bits */
+/* I hope nobody tries to build GHC where this is wrong */
+
+#define FLT_UPP 536870912.0
+
+HsFloat
+rintFloat(HsFloat f)
+{
+    if ((f > FLT_UPP) || (f < (-FLT_UPP)))
+    {
+        return f;
+    }
+    else
+    {
+        int i = (int)f;
+        float g = i;
+        float d = f - g;
+        if (d > 0.5)
+        {
+            return g + 1.0;
+        }
+        if (d == 0.5)
+        {
+            return (i & 1) ? (g + 1.0) : g;
+        }
+        if (d == -0.5)
+        {
+            return (i & 1) ? (g - 1.0) : g;
+        }
+        if (d < -0.5)
+        {
+            return g - 1.0;
+        }
+        return g;
+    }
+}
+
+#define DBL_UPP 2305843009213693952.0
+
+HsDouble
+rintDouble(HsDouble d)
+{
+    if ((d > DBL_UPP) || (d < (-DBL_UPP)))
+    {
+        return d;
+    }
+    else
+    {
+        HsInt64 i = (HsInt64)d;
+        double e = i;
+        double r = d - e;
+        if (r > 0.5)
+        {
+            return e + 1.0;
+        }
+        if (r == 0.5)
+        {
+            return (i & 1) ? (e + 1.0) : e;
+        }
+        if (r == -0.5)
+        {
+            return (i & 1) ? (e - 1.0) : e;
+        }
+        if (r < -0.5)
+        {
+            return e - 1.0;
+        }
+        return e;
+    }
+}
+
+#endif /* ! IEEE_FLOATING_POINT */
diff --git a/libraries/base/cbits/sysconf.c b/libraries/base/cbits/sysconf.c
new file mode 100644
index 000000000000..bbf785326aa7
--- /dev/null
+++ b/libraries/base/cbits/sysconf.c
@@ -0,0 +1,19 @@
+#include "HsBaseConfig.h"
+
+/* For _SC_CLK_TCK */
+#if HAVE_UNISTD_H
+#include <unistd.h>
+#endif
+
+/* for CLK_TCK */
+#if HAVE_TIME_H
+#include <time.h>
+#endif
+
+long clk_tck(void) {
+#if defined(CLK_TCK)
+    return (CLK_TCK);
+#else
+    return sysconf(_SC_CLK_TCK);
+#endif
+}
diff --git a/libraries/base/cbits/ubconfc b/libraries/base/cbits/ubconfc
new file mode 100644
index 000000000000..47637a9ef48e
--- /dev/null
+++ b/libraries/base/cbits/ubconfc
@@ -0,0 +1,344 @@
+#!/bin/sh
+
+# --------------------------------------------------------------------------
+# This is the script to create the unicode chars property table 
+# Written by Dimitry Golubovsky (dimitry@golubovsky.org) as part
+# of the Partial Unicode Support patch
+#
+# Adopted for use with GHC.
+# License: see libraries/base/LICENSE
+#
+# -------------------------------------------------------------------------
+
+#	The script reads the file from the standard input,
+#	and outputs C code into the standard output.
+#	The C code contains the chars property table, and basic functions
+#	to access properties.
+
+#	Output the file header
+
+echo "/*-------------------------------------------------------------------------"
+echo "This is an automatically generated file: do not edit"
+echo "Generated by `basename $0` at `date`"
+echo "-------------------------------------------------------------------------*/"
+echo
+echo "#include \"WCsubst.h\""
+
+#	Define structures
+
+cat <<EOF
+
+/* Unicode general categories, listed in the same order as in the Unicode
+ * standard -- this must be the same order as in GHC.Unicode.
+ */
+
+enum {
+    NUMCAT_LU,  /* Letter, Uppercase */
+    NUMCAT_LL,  /* Letter, Lowercase */
+    NUMCAT_LT,  /* Letter, Titlecase */
+    NUMCAT_LM,  /* Letter, Modifier */
+    NUMCAT_LO,  /* Letter, Other */
+    NUMCAT_MN,  /* Mark, Non-Spacing */
+    NUMCAT_MC,  /* Mark, Spacing Combining */
+    NUMCAT_ME,  /* Mark, Enclosing */
+    NUMCAT_ND,  /* Number, Decimal */
+    NUMCAT_NL,  /* Number, Letter */
+    NUMCAT_NO,  /* Number, Other */
+    NUMCAT_PC,  /* Punctuation, Connector */
+    NUMCAT_PD,  /* Punctuation, Dash */
+    NUMCAT_PS,  /* Punctuation, Open */
+    NUMCAT_PE,  /* Punctuation, Close */
+    NUMCAT_PI,  /* Punctuation, Initial quote */
+    NUMCAT_PF,  /* Punctuation, Final quote */
+    NUMCAT_PO,  /* Punctuation, Other */
+    NUMCAT_SM,  /* Symbol, Math */
+    NUMCAT_SC,  /* Symbol, Currency */
+    NUMCAT_SK,  /* Symbol, Modifier */
+    NUMCAT_SO,  /* Symbol, Other */
+    NUMCAT_ZS,  /* Separator, Space */
+    NUMCAT_ZL,  /* Separator, Line */
+    NUMCAT_ZP,  /* Separator, Paragraph */
+    NUMCAT_CC,  /* Other, Control */
+    NUMCAT_CF,  /* Other, Format */
+    NUMCAT_CS,  /* Other, Surrogate */
+    NUMCAT_CO,  /* Other, Private Use */
+    NUMCAT_CN   /* Other, Not Assigned */
+};
+
+struct _convrule_ 
+{ 
+	unsigned int category;
+	unsigned int catnumber;
+	int possible;
+	int updist;
+	int lowdist; 
+	int titledist;
+};
+
+struct _charblock_ 
+{ 
+	int start;
+	int length;
+	const struct _convrule_ *rule;
+};
+
+EOF
+
+#	Convert the stdin file to the C table
+
+awk '
+BEGIN {
+	FS=";"
+	catidx=0
+	rulidx=0
+	blockidx=0
+	cblckidx=0
+	sblckidx=0
+	blockb=-1
+	blockl=0
+	digs="0123456789ABCDEF"
+	for(i=0;i<16;i++)
+	{
+		hex[substr(digs,i+1,1)]=i;
+	}
+}
+function em1(a)
+{
+	if(a=="") return "-1"
+	return "0x"a
+}
+function h2d(a)
+{
+	l=length(a)
+	acc=0
+	for(i=1;i<=l;i++)
+	{
+		acc=acc*16+hex[substr(a,i,1)];
+	}
+	return acc
+}
+function dumpblock()
+{
+	blkd=blockb ", " blockl ", &rule" rules[blockr]
+	blocks[blockidx]=blkd
+	blockidx++
+	if(blockb<=256) lat1idx++
+	split(blockr,rsp,",")
+	if(substr(rsp[3],2,1)=="1")
+	{
+		cblcks[cblckidx]=blkd
+		cblckidx++
+	}
+	if(rsp[1]=="GENCAT_ZS")
+	{
+		sblcks[sblckidx]=blkd
+		sblckidx++
+	}
+	blockb=self
+	blockl=1
+	blockr=rule
+}
+{
+	name=$2
+	cat=toupper($3)
+	self=h2d($1)
+	up=h2d($13)
+	low=h2d($14)
+	title=h2d($15)
+	convpos=1
+	if((up==0)&&(low==0)&&(title==0)) convpos=0
+	if(up==0) up=self
+	if(low==0) low=self
+	if(title==0) title=self
+	updist=up-self
+	lowdist=low-self
+	titledist=title-self
+	rule="GENCAT_"cat", NUMCAT_"cat", "((convpos==1)?                   \
+				("1, " updist ", " lowdist ", " titledist): \
+				("0, 0, 0, 0"))
+	if(cats[cat]=="")
+	{
+		cats[cat]=(2^catidx);
+		catidx++;
+	}
+	if(rules[rule]=="")
+	{
+		rules[rule]=rulidx;
+		rulidx++;
+	}
+	if(blockb==-1)
+	{
+		blockb=self
+		blockl=1
+		blockr=rule
+	}
+	else
+	{
+		if (index(name,"First>")!=0)
+		{
+			dumpblock()
+		}
+		else if (index(name,"Last>")!=0)
+		{
+			blockl+=(self-blockb)
+		}
+		else if((self==blockb+blockl)&&(rule==blockr)) blockl++
+		else
+		{
+			dumpblock()
+		}
+	}
+}
+END {
+	dumpblock()
+	for(c in cats) print "#define GENCAT_"c" "cats[c]
+	print "#define MAX_UNI_CHAR " self
+	print "#define NUM_BLOCKS " blockidx
+	print "#define NUM_CONVBLOCKS " cblckidx
+	print "#define NUM_SPACEBLOCKS " sblckidx
+	print "#define NUM_LAT1BLOCKS " lat1idx
+        print "#define NUM_RULES " rulidx
+	for(r in rules)
+	{
+		printf "static const struct _convrule_ rule" rules[r] "={" r "};\n"
+	}
+	print "static const struct _charblock_ allchars[]={"
+	for(i=0;i<blockidx;i++)
+	{
+		printf "\t{" blocks[i] "}"
+		print (i<(blockidx-1))?",":"" 
+	}
+	print "};"
+	print "static const struct _charblock_ convchars[]={"
+	for(i=0;i<cblckidx;i++)
+	{
+		printf "\t{" cblcks[i] "}"
+		print (i<(cblckidx-1))?",":""
+	}
+        print "};"
+        print "static const struct _charblock_ spacechars[]={"
+        for(i=0;i<sblckidx;i++)
+        {       
+                printf "\t{" sblcks[i] "}"
+                print (i<(sblckidx-1))?",":""
+        }       
+	print "};"
+}
+'
+#	Output the C procedures code
+
+cat <<EOF
+
+/*
+	Obtain the reference to character rule by doing
+	binary search over the specified array of blocks.
+	To make checkattr shorter, the address of
+	nullrule is returned if the search fails:
+	this rule defines no category and no conversion
+	distances. The compare function returns 0 when
+	key->start is within the block. Otherwise
+	result of comparison of key->start and start of the
+	current block is returned as usual.
+*/
+
+static const struct _convrule_ nullrule={0,NUMCAT_CN,0,0,0,0};
+
+int blkcmp(const void *vk,const void *vb)
+{
+	const struct _charblock_ *key,*cur;
+	key=vk;
+	cur=vb;
+	if((key->start>=cur->start)&&(key->start<(cur->start+cur->length)))
+	{
+		return 0;
+	}
+	if(key->start>cur->start) return 1;
+	return -1;
+}
+
+static const struct _convrule_ *getrule(
+	const struct _charblock_ *blocks,
+	int numblocks,
+	int unichar)
+{
+	struct _charblock_ key={unichar,1,(void *)0};
+	struct _charblock_ *cb=bsearch(&key,blocks,numblocks,sizeof(key),blkcmp);
+	if(cb==(void *)0) return &nullrule;
+	return cb->rule;
+}
+	
+
+
+/*
+	Check whether a character (internal code) has certain attributes.
+	Attributes (category flags) may be ORed. The function ANDs
+	character category flags and the mask and returns the result.
+	If the character belongs to one of the categories requested,
+	the result will be nonzero.
+*/
+
+inline static int checkattr(int c,unsigned int catmask)
+{
+	return (catmask & (getrule(allchars,(c<256)?NUM_LAT1BLOCKS:NUM_BLOCKS,c)->category));
+}
+
+inline static int checkattr_s(int c,unsigned int catmask)
+{
+        return (catmask & (getrule(spacechars,NUM_SPACEBLOCKS,c)->category));
+}
+
+/*
+	Define predicate functions for some combinations of categories.
+*/
+
+#define unipred(p,m) \\
+int p(int c) \\
+{ \\
+	return checkattr(c,m); \\
+}
+
+#define unipred_s(p,m) \\
+int p(int c) \\
+{ \\
+        return checkattr_s(c,m); \\
+}
+
+/*
+	Make these rules as close to Hugs as possible.
+*/
+
+unipred(u_iswcntrl,GENCAT_CC)
+unipred(u_iswprint, \
+(GENCAT_MC | GENCAT_NO | GENCAT_SK | GENCAT_ME | GENCAT_ND | \
+  GENCAT_PO | GENCAT_LT | GENCAT_PC | GENCAT_SM | GENCAT_ZS | \
+  GENCAT_LU | GENCAT_PD | GENCAT_SO | GENCAT_PE | GENCAT_PF | \
+  GENCAT_PS | GENCAT_SC | GENCAT_LL | GENCAT_LM | GENCAT_PI | \
+  GENCAT_NL | GENCAT_MN | GENCAT_LO))
+unipred_s(u_iswspace,GENCAT_ZS)
+unipred(u_iswupper,(GENCAT_LU|GENCAT_LT))
+unipred(u_iswlower,GENCAT_LL)
+unipred(u_iswalpha,(GENCAT_LL|GENCAT_LU|GENCAT_LT|GENCAT_LM|GENCAT_LO))
+unipred(u_iswdigit,GENCAT_ND)
+
+unipred(u_iswalnum,(GENCAT_LT|GENCAT_LU|GENCAT_LL|GENCAT_LM|GENCAT_LO|
+		    GENCAT_MC|GENCAT_ME|GENCAT_MN|
+		    GENCAT_NO|GENCAT_ND|GENCAT_NL))
+
+#define caseconv(p,to) \\
+int p(int c) \\
+{ \\
+	const struct _convrule_ *rule=getrule(convchars,NUM_CONVBLOCKS,c);\\
+	if(rule==&nullrule) return c;\\
+	return c+rule->to;\\
+}
+
+caseconv(u_towupper,updist)
+caseconv(u_towlower,lowdist)
+caseconv(u_towtitle,titledist)
+
+int u_gencat(int c)
+{
+	return getrule(allchars,NUM_BLOCKS,c)->catnumber;
+}
+
+EOF
diff --git a/libraries/base/changelog.md b/libraries/base/changelog.md
new file mode 100644
index 000000000000..06c9fa5a97d8
--- /dev/null
+++ b/libraries/base/changelog.md
@@ -0,0 +1,176 @@
+# Changelog for [`base` package](http://hackage.haskell.org/package/base)
+
+## 4.7.1.0 *TBA*
+
+  * Bundled with GHC 7.10.1
+
+  * Add reverse application operator `Data.Function.(&)`
+
+  * Add `Data.List.sortOn` sorting function
+
+  * Add `System.Exit.die`
+
+  * Weaken RealFloat constraints on some `Data.Complex` functions
+
+  * Add `Control.Monad.(<$!>)` as a strict version of `(<$>)`
+
+  * The `Data.Monoid` module now has the `PolyKinds` extension
+    enabled, so that the `Monoid` instance for `Proxy` are polykinded
+    like `Proxy` itself is.
+
+## 4.7.0.1  *Jul 2014*
+
+  * Bundled with GHC 7.8.3
+
+  * Unhide `Foreign.ForeignPtr` in Haddock (#8475)
+
+  * Fix recomputation of `TypeRep` in `Typeable` type-application instance
+    (#9203)
+
+  * Fix regression in Data.Fixed Read instance (#9231)
+
+  * Fix `fdReady` to honor `FD_SETSIZE` (#9168)
+
+## 4.7.0.0  *Apr 2014*
+
+  * Bundled with GHC 7.8.1
+
+  * Add `/Since: 4.[4567].0.0/` Haddock annotations to entities
+    denoting the package version, when the given entity was introduced
+    (or its type signature changed in a non-compatible way)
+
+  * The `Control.Category` module now has the `PolyKinds` extension
+    enabled, meaning that instances of `Category` no longer need be of
+    kind `* -> * -> *`.
+
+  * There are now `Foldable` and `Traversable` instances for `Either a`,
+   `Const r`, and `(,) a`.
+
+  * There is now a `Monoid`, `Generic`, and `Generic1` instance for `Const`.
+
+  * There is now a `Data` instance for `Data.Version`.
+
+  * A new `Data.Bits.FiniteBits` class has been added to represent
+    types with fixed bit-count. The existing `Bits` class is extended
+    with a `bitSizeMaybe` method to replace the now obsolete
+    `bitsize` method.
+
+  * `Data.Bits.Bits` gained a new `zeroBits` method which completes the
+    `Bits` API with a direct way to introduce a value with all bits cleared.
+
+  * There are now `Bits` and `FiniteBits` instances for `Bool`.
+
+  * There are now `Eq`, `Ord`, `Show`, `Read`, `Generic`. and `Generic1`
+    instances for `ZipList`.
+
+  * There are now `Eq`, `Ord`, `Show` and `Read` instances for `Down`.
+
+  * There are now `Eq`, `Ord`, `Show`, `Read` and `Generic` instances
+    for types in GHC.Generics (`U1`, `Par1`, `Rec1`, `K1`, `M1`,
+    `(:+:)`, `(:*:)`, `(:.:)`).
+
+  * `Data.Monoid`: There are now `Generic` instances for `Dual`, `Endo`,
+    `All`, `Any`, `Sum`, `Product`, `First`, and `Last`; as well as
+    `Generic1` instances for `Dual`, `Sum`, `Product`, `First`, and `Last`.
+
+  * The `Data.Monoid.{Product,Sum}` newtype wrappers now have `Num` instances.
+
+  * There are now `Functor` instances for `System.Console.GetOpt`'s
+    `ArgOrder`, `OptDescr`, and `ArgDescr`.
+
+  * A zero-width unboxed poly-kinded `Proxy#` was added to
+    `GHC.Prim`. It can be used to make it so that there is no the
+    operational overhead for passing around proxy arguments to model
+    type application.
+
+  * New `Data.Proxy` module providing a concrete, poly-kinded proxy type.
+
+  * New `Data.Coerce` module which exports the new `Coercible` class
+    together with the `coerce` primitive which provide safe coercion
+    (wrt role checking) between types with same representation.
+
+  * `Control.Concurrent.MVar` has a new implementation of `readMVar`,
+    which fixes a long-standing bug where `readMVar` is only atomic if
+    there are no other threads running `putMVar`.  `readMVar` now is
+    atomic, and is guaranteed to return the value from the first
+    `putMVar`.  There is also a new `tryReadMVar` which is a
+    non-blocking version.
+
+  * New `Control.Concurrent.MVar.withMVarMasked` which executes
+    `IO` action with asynchronous exceptions masked in the same style
+    as the existing `modifyMVarMasked` and `modifyMVarMasked_`.
+
+  * New `threadWait{Read,Write}STM :: Fd -> IO (STM (), IO ())`
+    functions added to `Control.Concurrent` for waiting on FD
+    readiness with STM actions.
+
+  * Expose `Data.Fixed.Fixed`'s constructor.
+
+  * There are now byte endian-swapping primitives
+    `byteSwap{16,32,64}` available in `Data.Word`, which use
+    optimized machine instructions when available.
+
+  * `Data.Bool` now exports `bool :: a -> a -> Bool -> a`, analogously
+    to `maybe` and `either` in their respective modules.
+
+  * `Data.Either` now exports `isLeft, isRight :: Either a b -> Bool`.
+
+  * `Debug.Trace` now exports `traceId`, `traceShowId`, `traceM`,
+    and `traceShowM`.
+
+  * `Data.Functor` now exports `($>)` and `void`.
+
+  * Rewrote portions of `Text.Printf`, and made changes to `Numeric`
+    (added `Numeric.showFFloatAlt` and `Numeric.showGFloatAlt`) and
+    `GHC.Float` (added `formatRealFloatAlt`) to support it.  The
+    rewritten version is extensible to user types, adds a "generic"
+    format specifier "`%v`", extends the `printf` spec to support much
+    of C's `printf(3)` functionality, and fixes the spurious warnings
+    about using `Text.Printf.printf` at `(IO a)` while ignoring the
+    return value.  These changes were contributed by Bart Massey.
+
+  * The minimal complete definitions for all type-classes with cyclic
+    default implementations have been explicitly annotated with the
+    new `{-# MINIMAL #-}` pragma.
+
+  * `Control.Applicative.WrappedMonad`, which can be used to convert a
+    `Monad` to an `Applicative`, has now a
+    `Monad m => Monad (WrappedMonad m)` instance.
+
+  * There is now a `Generic` and a `Generic1` instance for `WrappedMonad`
+    and `WrappedArrow`.
+
+  * Handle `ExitFailure (-sig)` on Unix by killing process with signal `sig`.
+
+  * New module `Data.Type.Bool` providing operations on type-level booleans.
+
+  * Expose `System.Mem.performMinorGC` for triggering minor GCs.
+
+  * New `System.Environment.{set,unset}Env` for manipulating
+    environment variables.
+
+  * Add `Typeable` instance for `(->)` and `RealWorld`.
+
+  * Declare CPP header `<Typeable.h>` officially obsolete as GHC 7.8+
+    does not support hand-written `Typeable` instances anymore.
+
+  * Remove (unmaintained) Hugs98 and NHC98 specific code.
+
+  * Optimize `System.Timeout.timeout` for the threaded RTS.
+
+  * Remove deprecated functions `unsafeInterleaveST`, `unsafeIOToST`,
+    and `unsafeSTToIO` from `Control.Monad.ST`.
+
+  * Add a new superclass `SomeAsyncException` for all asynchronous exceptions
+    and makes the existing `AsyncException` and `Timeout` exception children
+    of `SomeAsyncException` in the hierarchy.
+
+  * Remove deprecated functions `blocked`, `unblock`, and `block` from
+    `Control.Exception`.
+
+  * Remove deprecated function `forkIOUnmasked` from `Control.Concurrent`.
+
+  * Remove deprecated function `unsafePerformIO` export from `Foreign`
+    (still available via `System.IO.Unsafe.unsafePerformIO`).
+
+  * Various fixes and other improvements (see Git history for full details).
diff --git a/libraries/base/codepages/MakeTable.hs b/libraries/base/codepages/MakeTable.hs
new file mode 100644
index 000000000000..7b3328e2d839
--- /dev/null
+++ b/libraries/base/codepages/MakeTable.hs
@@ -0,0 +1,265 @@
+{--
+This is a script to generate the necessary tables to support Windows code page
+encoding/decoding.
+
+License: see libraries/base/LICENSE
+
+The code page tables are available from :
+http://www.unicode.org/Public/MAPPINGS/
+
+To run this script, use e.g.
+runghc MakeTable.hs <module-name> <output-file> <codepage-dir>/*.TXT
+
+Currently, this script only supports single-byte encodings, since the lookup
+tables required for the CJK double-byte codepages are too large to be
+statically linked into every executable.  We plan to add support for them once
+GHC is able to produce Windows DLLs.
+--}
+
+module Main where
+
+import System.FilePath
+import qualified Data.Map as Map
+import System.IO
+import Data.Maybe (mapMaybe)
+import Data.List (intersperse)
+import Data.Word
+import Numeric
+import Control.Monad.State
+import System.Environment
+import Control.Exception(evaluate)
+
+main :: IO ()
+main = do
+    moduleName:outFile:files <- getArgs
+    let badFiles = -- These fail with an error like
+                   --     MakeTable: Enum.toEnum{Word8}: tag (33088) is outside of bounds (0,255)
+                   -- I have no idea what's going on, so for now we just
+                   -- skip them.
+                   ["CPs/CP932.TXT",
+                    "CPs/CP936.TXT",
+                    "CPs/CP949.TXT",
+                    "CPs/CP950.TXT"]
+    let files' = filter (`notElem` badFiles) files
+    sbes <- mapM readMapAndIx files'
+    putStrLn "Writing output"
+    withBinaryFile outFile WriteMode $ flip hPutStr
+        $ unlines $ makeTableFile moduleName files' sbes
+  where
+    readMapAndIx f = do
+        putStrLn ("Reading " ++ f)
+        m <- readMap f
+        return (codePageNum f, m)
+
+-- filenames are assumed to be of the form "CP1250.TXT"
+codePageNum :: FilePath -> Int
+codePageNum = read . drop 2 . takeBaseName
+
+readMap :: (Ord a, Enum a) => FilePath -> IO (Map.Map a Char)
+readMap f  = withBinaryFile f ReadMode $ \h -> do
+    contents <- hGetContents h
+    let ms = Map.fromList $ mapMaybe parseLine $ lines contents
+    evaluate $ Map.size ms
+    return ms
+
+parseLine :: Enum a => String -> Maybe (a,Char)
+parseLine s = case words s of
+    ('#':_):_           -> Nothing
+    bs:"#DBCS":_        -> Just (readHex' bs, toEnum 0xDC00)
+    bs:"#UNDEFINED":_   -> Just (readHex' bs, toEnum 0)
+    bs:cs:('#':_):_     -> Just (readHex' bs, readCharHex cs)
+    _                   -> Nothing
+
+readHex' :: Enum a => String -> a
+readHex' ('0':'x':s) = case readHex s of
+    [(n,"")] -> toEnum n -- explicitly call toEnum to catch overflow errors.
+    _ -> error $ "Can't read hex: " ++ show s
+readHex' s = error $ "Can't read hex: " ++ show s
+
+readCharHex :: String -> Char
+readCharHex s = if c > fromEnum (maxBound :: Word16)
+                    then error "Can't handle non-BMP character."
+                    else toEnum c
+    where c = readHex' s
+
+
+-------------------------------------------
+-- Writing out the main data values.
+
+makeTableFile :: String -> [FilePath] -> [(Int,Map.Map Word8 Char)] -> [String]
+makeTableFile moduleName files maps = concat
+    [ languageDirectives, firstComment files, header,
+        theImports, theTypes, blockSizeText, tablePart]
+  where
+    header = [ "module " ++ moduleName ++ " where"
+             , ""
+             ]
+    tablePart = [ "codePageMap :: [(Word32, CodePageArrays)]"
+                , "codePageMap = ["
+                ] ++ (intersperse "\n    ," $ map mkTableEntry maps)
+                ++ ["    ]"]
+    mkTableEntry (i,m) = "    (" ++ show i ++ ", " ++ makeSBE m ++ "    )"
+    blockSizeText = ["blockBitSize :: Int", "blockBitSize = " ++ show blockBitSize]
+
+
+makeSBE :: Map.Map Word8 Char -> String
+makeSBE m = unlines
+                [ "SingleByteCP {"
+                , "     decoderArray = " ++ mkConvArray es
+                , "     , encoderArray = " ++ mkCompactArray (swapMap m)
+                , "   }"
+                ]
+  where
+    es = [Map.findWithDefault '\0' x m | x <- [minBound..maxBound]]
+
+swapMap :: (Ord a, Ord b, Enum a, Enum b) => Map.Map a b -> Map.Map b a
+swapMap = Map.insert (toEnum 0) (toEnum 0) . Map.fromList . map swap . Map.toList
+  where
+    swap (x,y) = (y,x)
+
+
+mkConvArray :: Embed a => [a] -> String
+mkConvArray xs = "ConvArray \"" ++ concatMap mkHex xs ++ "\"#"
+
+
+-------------------------------------------
+-- Compact arrays
+--
+-- The decoding map (from Word8 to Char) can be implemented with a simple array
+-- of 256 Word16's.  Bytes which do not belong to the code page are mapped to
+-- '\0'.
+--
+-- However, a naive table mapping Char to Word8 would require 2^16 Word8's.  We
+-- can use much less space with the right data structure, since at most 256 of
+-- those entries are nonzero.
+--
+-- We use "compact arrays", as described in "Unicode Demystified" by Richard
+-- Gillam.
+--
+-- Fix a block size S which is a power of two.  We compress an array of N
+-- entries (where N>>S) as follows.  First, split the array into blocks of size
+-- S, then remove all repeate blocks to form the "value" array.  Then construct
+-- a separate "index" array which maps the position of blocks in the old array
+-- to a position in the value array.
+--
+-- For example, assume that S=32 we have six blocks ABABCA, each with 32
+-- elements.
+--
+-- Then the compressed table consists of two arrays:
+-- 1) An array "values", concatenating the unique blocks ABC
+-- 2) An array "indices" which equals [0,1,0,1,2,0].
+--
+-- To look up '\100', first calculate divMod 100 32 = (3,4).  Since
+-- indices[3]=1, we look at the second unique block B; thus the encoded byte is
+-- B[4].
+--
+-- The upshot of this representation is that the lookup is very quick as it only
+-- requires two array accesses plus some bit masking/shifting.
+
+-- From testing, this is an optimal size.
+blockBitSize :: Int
+blockBitSize = 6
+
+mkCompactArray :: (Embed a, Embed b) => Map.Map a b -> String
+mkCompactArray m = unlines [
+            ""
+            , " CompactArray {"
+            , "        encoderIndices = " ++ mkConvArray is'
+            , "        , encoderValues = "
+                    ++ mkConvArray (concat $ Map.elems vs)
+            , "        , encoderMax = " ++ show (fst $ Map.findMax m)
+            , "        }"
+            ]
+  where
+    blockSize = 2 ^ blockBitSize
+    (is,(vs,_)) = compress blockSize $ m
+    is' = map (* blockSize) is
+
+type CompressState b = (Map.Map Int [b], Map.Map [b] Int)
+-- each entry in the list corresponds to a block of size n.
+compress :: (Bounded a, Enum a, Ord a, Bounded b, Ord b) => Int -> Map.Map a b
+        -> ([Int], CompressState b)
+compress n ms = runState (mapM lookupOrAdd chunks) (Map.empty, Map.empty)
+    where
+        chunks = mkChunks $ map (\i -> Map.findWithDefault minBound i ms)
+                    $ [minBound..fst (Map.findMax ms)]
+        mkChunks [] = []
+        mkChunks xs = take n xs : mkChunks (drop n xs)
+        lookupOrAdd xs = do
+            (m,rm) <- get
+            case Map.lookup xs rm of
+                Just i -> return i
+                Nothing -> do
+                    let i = if Map.null m
+                                then 0
+                                else 1 + fst (Map.findMax m)
+                    put (Map.insert i xs m, Map.insert xs i rm)
+                    return i
+
+-------------------------------------------
+-- Static parts of the generated module.
+
+languageDirectives :: [String]
+languageDirectives = ["{-# LANGUAGE MagicHash, NoImplicitPrelude #-}"]
+
+
+firstComment :: [FilePath] -> [String]
+firstComment files = map ("-- " ++) $
+    [ "Do not edit this file directly!"
+    , "It was generated by the MakeTable.hs script using the files below."
+    , "To regenerate it, run \"make\" in ../../../../codepages/"
+    , ""
+    , "Files:"
+    ] ++ map takeFileName files
+
+theImports :: [String]
+theImports = map ("import " ++ )
+    ["GHC.Prim", "GHC.Base", "GHC.Word"]
+
+theTypes :: [String]
+theTypes = [ "data ConvArray a = ConvArray Addr#"
+           , "data CompactArray a b = CompactArray {"
+           , "    encoderMax :: !a,"
+           , "    encoderIndices :: !(ConvArray Int),"
+           , "    encoderValues :: !(ConvArray b)"
+           , "  }"
+           , ""
+           , "data CodePageArrays = SingleByteCP {"
+           , "    decoderArray :: !(ConvArray Char),"
+           , "    encoderArray :: !(CompactArray Char Word8)"
+           , "  }"
+           , ""
+           ]
+
+-------------------------------------------
+-- Embed class and associated functions
+
+class (Ord a, Enum a, Bounded a, Show a) => Embed a where
+    mkHex :: a -> String
+
+instance Embed Word8 where
+    mkHex = showHex'
+
+instance Embed Word16 where
+    mkHex = repDualByte
+
+instance Embed Char where
+    mkHex = repDualByte
+
+-- this is used for the indices of the compressed array.
+instance Embed Int where
+    mkHex = repDualByte
+
+showHex' :: Integral a => a -> String
+showHex' s = "\\x" ++ showHex s ""
+
+repDualByte :: Enum c => c -> String
+repDualByte c
+    | n >= 2^(16::Int) = error "value is too high!"
+    -- NOTE : this assumes little-endian architecture.  But we're only using this on Windows,
+    -- so it's probably OK.
+    | otherwise = showHex' (n `mod` 256) ++ showHex' (n `div` 256)
+  where
+    n = fromEnum c
+
+
diff --git a/libraries/base/codepages/Makefile b/libraries/base/codepages/Makefile
new file mode 100644
index 000000000000..dab5cf5d5753
--- /dev/null
+++ b/libraries/base/codepages/Makefile
@@ -0,0 +1,19 @@
+
+.PHONY: default
+default:
+	$(MAKE) getCodepages
+	$(MAKE) genTable
+
+.PHONY: getCodepages
+getCodepages:
+	rm -rf www.unicode.org
+	rm -rf CPs
+	mkdir CPs
+	wget -r -np http://www.unicode.org/Public/MAPPINGS/VENDORS/MICSFT/
+	find www.unicode.org -name 'CP*' -exec cp {} CPs \;
+
+.PHONY: genTable
+genTable:
+	ghc --make MakeTable
+	./MakeTable GHC.IO.Encoding.CodePage.Table ../GHC/IO/Encoding/CodePage/Table.hs CPs/*
+
diff --git a/libraries/base/config.guess b/libraries/base/config.guess
new file mode 100644
index 000000000000..b79252d6b103
--- /dev/null
+++ b/libraries/base/config.guess
@@ -0,0 +1,1558 @@
+#! /bin/sh
+# Attempt to guess a canonical system name.
+#   Copyright 1992-2013 Free Software Foundation, Inc.
+
+timestamp='2013-06-10'
+
+# This file is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+# General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, see <http://www.gnu.org/licenses/>.
+#
+# As a special exception to the GNU General Public License, if you
+# distribute this file as part of a program that contains a
+# configuration script generated by Autoconf, you may include it under
+# the same distribution terms that you use for the rest of that
+# program.  This Exception is an additional permission under section 7
+# of the GNU General Public License, version 3 ("GPLv3").
+#
+# Originally written by Per Bothner.
+#
+# You can get the latest version of this script from:
+# http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.guess;hb=HEAD
+#
+# Please send patches with a ChangeLog entry to config-patches@gnu.org.
+
+
+me=`echo "$0" | sed -e 's,.*/,,'`
+
+usage="\
+Usage: $0 [OPTION]
+
+Output the configuration name of the system \`$me' is run on.
+
+Operation modes:
+  -h, --help         print this help, then exit
+  -t, --time-stamp   print date of last modification, then exit
+  -v, --version      print version number, then exit
+
+Report bugs and patches to <config-patches@gnu.org>."
+
+version="\
+GNU config.guess ($timestamp)
+
+Originally written by Per Bothner.
+Copyright 1992-2013 Free Software Foundation, Inc.
+
+This is free software; see the source for copying conditions.  There is NO
+warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE."
+
+help="
+Try \`$me --help' for more information."
+
+# Parse command line
+while test $# -gt 0 ; do
+  case $1 in
+    --time-stamp | --time* | -t )
+       echo "$timestamp" ; exit ;;
+    --version | -v )
+       echo "$version" ; exit ;;
+    --help | --h* | -h )
+       echo "$usage"; exit ;;
+    -- )     # Stop option processing
+       shift; break ;;
+    - )	# Use stdin as input.
+       break ;;
+    -* )
+       echo "$me: invalid option $1$help" >&2
+       exit 1 ;;
+    * )
+       break ;;
+  esac
+done
+
+if test $# != 0; then
+  echo "$me: too many arguments$help" >&2
+  exit 1
+fi
+
+trap 'exit 1' 1 2 15
+
+# CC_FOR_BUILD -- compiler used by this script. Note that the use of a
+# compiler to aid in system detection is discouraged as it requires
+# temporary files to be created and, as you can see below, it is a
+# headache to deal with in a portable fashion.
+
+# Historically, `CC_FOR_BUILD' used to be named `HOST_CC'. We still
+# use `HOST_CC' if defined, but it is deprecated.
+
+# Portable tmp directory creation inspired by the Autoconf team.
+
+set_cc_for_build='
+trap "exitcode=\$?; (rm -f \$tmpfiles 2>/dev/null; rmdir \$tmp 2>/dev/null) && exit \$exitcode" 0 ;
+trap "rm -f \$tmpfiles 2>/dev/null; rmdir \$tmp 2>/dev/null; exit 1" 1 2 13 15 ;
+: ${TMPDIR=/tmp} ;
+ { tmp=`(umask 077 && mktemp -d "$TMPDIR/cgXXXXXX") 2>/dev/null` && test -n "$tmp" && test -d "$tmp" ; } ||
+ { test -n "$RANDOM" && tmp=$TMPDIR/cg$$-$RANDOM && (umask 077 && mkdir $tmp) ; } ||
+ { tmp=$TMPDIR/cg-$$ && (umask 077 && mkdir $tmp) && echo "Warning: creating insecure temp directory" >&2 ; } ||
+ { echo "$me: cannot create a temporary directory in $TMPDIR" >&2 ; exit 1 ; } ;
+dummy=$tmp/dummy ;
+tmpfiles="$dummy.c $dummy.o $dummy.rel $dummy" ;
+case $CC_FOR_BUILD,$HOST_CC,$CC in
+ ,,)    echo "int x;" > $dummy.c ;
+	for c in cc gcc c89 c99 ; do
+	  if ($c -c -o $dummy.o $dummy.c) >/dev/null 2>&1 ; then
+	     CC_FOR_BUILD="$c"; break ;
+	  fi ;
+	done ;
+	if test x"$CC_FOR_BUILD" = x ; then
+	  CC_FOR_BUILD=no_compiler_found ;
+	fi
+	;;
+ ,,*)   CC_FOR_BUILD=$CC ;;
+ ,*,*)  CC_FOR_BUILD=$HOST_CC ;;
+esac ; set_cc_for_build= ;'
+
+# This is needed to find uname on a Pyramid OSx when run in the BSD universe.
+# (ghazi@noc.rutgers.edu 1994-08-24)
+if (test -f /.attbin/uname) >/dev/null 2>&1 ; then
+	PATH=$PATH:/.attbin ; export PATH
+fi
+
+UNAME_MACHINE=`(uname -m) 2>/dev/null` || UNAME_MACHINE=unknown
+UNAME_RELEASE=`(uname -r) 2>/dev/null` || UNAME_RELEASE=unknown
+UNAME_SYSTEM=`(uname -s) 2>/dev/null`  || UNAME_SYSTEM=unknown
+UNAME_VERSION=`(uname -v) 2>/dev/null` || UNAME_VERSION=unknown
+
+case "${UNAME_SYSTEM}" in
+Linux|GNU|GNU/*)
+	# If the system lacks a compiler, then just pick glibc.
+	# We could probably try harder.
+	LIBC=gnu
+
+	eval $set_cc_for_build
+	cat <<-EOF > $dummy.c
+	#include <features.h>
+	#if defined(__UCLIBC__)
+	LIBC=uclibc
+	#elif defined(__dietlibc__)
+	LIBC=dietlibc
+	#else
+	LIBC=gnu
+	#endif
+	EOF
+	eval `$CC_FOR_BUILD -E $dummy.c 2>/dev/null | grep '^LIBC'`
+	;;
+esac
+
+# Note: order is significant - the case branches are not exclusive.
+
+case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in
+    *:NetBSD:*:*)
+	# NetBSD (nbsd) targets should (where applicable) match one or
+	# more of the tuples: *-*-netbsdelf*, *-*-netbsdaout*,
+	# *-*-netbsdecoff* and *-*-netbsd*.  For targets that recently
+	# switched to ELF, *-*-netbsd* would select the old
+	# object file format.  This provides both forward
+	# compatibility and a consistent mechanism for selecting the
+	# object file format.
+	#
+	# Note: NetBSD doesn't particularly care about the vendor
+	# portion of the name.  We always set it to "unknown".
+	sysctl="sysctl -n hw.machine_arch"
+	UNAME_MACHINE_ARCH=`(/sbin/$sysctl 2>/dev/null || \
+	    /usr/sbin/$sysctl 2>/dev/null || echo unknown)`
+	case "${UNAME_MACHINE_ARCH}" in
+	    armeb) machine=armeb-unknown ;;
+	    arm*) machine=arm-unknown ;;
+	    sh3el) machine=shl-unknown ;;
+	    sh3eb) machine=sh-unknown ;;
+	    sh5el) machine=sh5le-unknown ;;
+	    *) machine=${UNAME_MACHINE_ARCH}-unknown ;;
+	esac
+	# The Operating System including object format, if it has switched
+	# to ELF recently, or will in the future.
+	case "${UNAME_MACHINE_ARCH}" in
+	    arm*|i386|m68k|ns32k|sh3*|sparc|vax)
+		eval $set_cc_for_build
+		if echo __ELF__ | $CC_FOR_BUILD -E - 2>/dev/null \
+			| grep -q __ELF__
+		then
+		    # Once all utilities can be ECOFF (netbsdecoff) or a.out (netbsdaout).
+		    # Return netbsd for either.  FIX?
+		    os=netbsd
+		else
+		    os=netbsdelf
+		fi
+		;;
+	    *)
+		os=netbsd
+		;;
+	esac
+	# The OS release
+	# Debian GNU/NetBSD machines have a different userland, and
+	# thus, need a distinct triplet. However, they do not need
+	# kernel version information, so it can be replaced with a
+	# suitable tag, in the style of linux-gnu.
+	case "${UNAME_VERSION}" in
+	    Debian*)
+		release='-gnu'
+		;;
+	    *)
+		release=`echo ${UNAME_RELEASE}|sed -e 's/[-_].*/\./'`
+		;;
+	esac
+	# Since CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM:
+	# contains redundant information, the shorter form:
+	# CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM is used.
+	echo "${machine}-${os}${release}"
+	exit ;;
+    *:Bitrig:*:*)
+	UNAME_MACHINE_ARCH=`arch | sed 's/Bitrig.//'`
+	echo ${UNAME_MACHINE_ARCH}-unknown-bitrig${UNAME_RELEASE}
+	exit ;;
+    *:OpenBSD:*:*)
+	UNAME_MACHINE_ARCH=`arch | sed 's/OpenBSD.//'`
+	echo ${UNAME_MACHINE_ARCH}-unknown-openbsd${UNAME_RELEASE}
+	exit ;;
+    *:ekkoBSD:*:*)
+	echo ${UNAME_MACHINE}-unknown-ekkobsd${UNAME_RELEASE}
+	exit ;;
+    *:SolidBSD:*:*)
+	echo ${UNAME_MACHINE}-unknown-solidbsd${UNAME_RELEASE}
+	exit ;;
+    macppc:MirBSD:*:*)
+	echo powerpc-unknown-mirbsd${UNAME_RELEASE}
+	exit ;;
+    *:MirBSD:*:*)
+	echo ${UNAME_MACHINE}-unknown-mirbsd${UNAME_RELEASE}
+	exit ;;
+    alpha:OSF1:*:*)
+	case $UNAME_RELEASE in
+	*4.0)
+		UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $3}'`
+		;;
+	*5.*)
+		UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $4}'`
+		;;
+	esac
+	# According to Compaq, /usr/sbin/psrinfo has been available on
+	# OSF/1 and Tru64 systems produced since 1995.  I hope that
+	# covers most systems running today.  This code pipes the CPU
+	# types through head -n 1, so we only detect the type of CPU 0.
+	ALPHA_CPU_TYPE=`/usr/sbin/psrinfo -v | sed -n -e 's/^  The alpha \(.*\) processor.*$/\1/p' | head -n 1`
+	case "$ALPHA_CPU_TYPE" in
+	    "EV4 (21064)")
+		UNAME_MACHINE="alpha" ;;
+	    "EV4.5 (21064)")
+		UNAME_MACHINE="alpha" ;;
+	    "LCA4 (21066/21068)")
+		UNAME_MACHINE="alpha" ;;
+	    "EV5 (21164)")
+		UNAME_MACHINE="alphaev5" ;;
+	    "EV5.6 (21164A)")
+		UNAME_MACHINE="alphaev56" ;;
+	    "EV5.6 (21164PC)")
+		UNAME_MACHINE="alphapca56" ;;
+	    "EV5.7 (21164PC)")
+		UNAME_MACHINE="alphapca57" ;;
+	    "EV6 (21264)")
+		UNAME_MACHINE="alphaev6" ;;
+	    "EV6.7 (21264A)")
+		UNAME_MACHINE="alphaev67" ;;
+	    "EV6.8CB (21264C)")
+		UNAME_MACHINE="alphaev68" ;;
+	    "EV6.8AL (21264B)")
+		UNAME_MACHINE="alphaev68" ;;
+	    "EV6.8CX (21264D)")
+		UNAME_MACHINE="alphaev68" ;;
+	    "EV6.9A (21264/EV69A)")
+		UNAME_MACHINE="alphaev69" ;;
+	    "EV7 (21364)")
+		UNAME_MACHINE="alphaev7" ;;
+	    "EV7.9 (21364A)")
+		UNAME_MACHINE="alphaev79" ;;
+	esac
+	# A Pn.n version is a patched version.
+	# A Vn.n version is a released version.
+	# A Tn.n version is a released field test version.
+	# A Xn.n version is an unreleased experimental baselevel.
+	# 1.2 uses "1.2" for uname -r.
+	echo ${UNAME_MACHINE}-dec-osf`echo ${UNAME_RELEASE} | sed -e 's/^[PVTX]//' | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'`
+	# Reset EXIT trap before exiting to avoid spurious non-zero exit code.
+	exitcode=$?
+	trap '' 0
+	exit $exitcode ;;
+    Alpha\ *:Windows_NT*:*)
+	# How do we know it's Interix rather than the generic POSIX subsystem?
+	# Should we change UNAME_MACHINE based on the output of uname instead
+	# of the specific Alpha model?
+	echo alpha-pc-interix
+	exit ;;
+    21064:Windows_NT:50:3)
+	echo alpha-dec-winnt3.5
+	exit ;;
+    Amiga*:UNIX_System_V:4.0:*)
+	echo m68k-unknown-sysv4
+	exit ;;
+    *:[Aa]miga[Oo][Ss]:*:*)
+	echo ${UNAME_MACHINE}-unknown-amigaos
+	exit ;;
+    *:[Mm]orph[Oo][Ss]:*:*)
+	echo ${UNAME_MACHINE}-unknown-morphos
+	exit ;;
+    *:OS/390:*:*)
+	echo i370-ibm-openedition
+	exit ;;
+    *:z/VM:*:*)
+	echo s390-ibm-zvmoe
+	exit ;;
+    *:OS400:*:*)
+	echo powerpc-ibm-os400
+	exit ;;
+    arm:RISC*:1.[012]*:*|arm:riscix:1.[012]*:*)
+	echo arm-acorn-riscix${UNAME_RELEASE}
+	exit ;;
+    arm*:riscos:*:*|arm*:RISCOS:*:*)
+	echo arm-unknown-riscos
+	exit ;;
+    SR2?01:HI-UX/MPP:*:* | SR8000:HI-UX/MPP:*:*)
+	echo hppa1.1-hitachi-hiuxmpp
+	exit ;;
+    Pyramid*:OSx*:*:* | MIS*:OSx*:*:* | MIS*:SMP_DC-OSx*:*:*)
+	# akee@wpdis03.wpafb.af.mil (Earle F. Ake) contributed MIS and NILE.
+	if test "`(/bin/universe) 2>/dev/null`" = att ; then
+		echo pyramid-pyramid-sysv3
+	else
+		echo pyramid-pyramid-bsd
+	fi
+	exit ;;
+    NILE*:*:*:dcosx)
+	echo pyramid-pyramid-svr4
+	exit ;;
+    DRS?6000:unix:4.0:6*)
+	echo sparc-icl-nx6
+	exit ;;
+    DRS?6000:UNIX_SV:4.2*:7* | DRS?6000:isis:4.2*:7*)
+	case `/usr/bin/uname -p` in
+	    sparc) echo sparc-icl-nx7; exit ;;
+	esac ;;
+    s390x:SunOS:*:*)
+	echo ${UNAME_MACHINE}-ibm-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`
+	exit ;;
+    sun4H:SunOS:5.*:*)
+	echo sparc-hal-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`
+	exit ;;
+    sun4*:SunOS:5.*:* | tadpole*:SunOS:5.*:*)
+	echo sparc-sun-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`
+	exit ;;
+    i86pc:AuroraUX:5.*:* | i86xen:AuroraUX:5.*:*)
+	echo i386-pc-auroraux${UNAME_RELEASE}
+	exit ;;
+    i86pc:SunOS:5.*:* | i86xen:SunOS:5.*:*)
+	eval $set_cc_for_build
+	SUN_ARCH="i386"
+	# If there is a compiler, see if it is configured for 64-bit objects.
+	# Note that the Sun cc does not turn __LP64__ into 1 like gcc does.
+	# This test works for both compilers.
+	if [ "$CC_FOR_BUILD" != 'no_compiler_found' ]; then
+	    if (echo '#ifdef __amd64'; echo IS_64BIT_ARCH; echo '#endif') | \
+		(CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | \
+		grep IS_64BIT_ARCH >/dev/null
+	    then
+		SUN_ARCH="x86_64"
+	    fi
+	fi
+	echo ${SUN_ARCH}-pc-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`
+	exit ;;
+    sun4*:SunOS:6*:*)
+	# According to config.sub, this is the proper way to canonicalize
+	# SunOS6.  Hard to guess exactly what SunOS6 will be like, but
+	# it's likely to be more like Solaris than SunOS4.
+	echo sparc-sun-solaris3`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`
+	exit ;;
+    sun4*:SunOS:*:*)
+	case "`/usr/bin/arch -k`" in
+	    Series*|S4*)
+		UNAME_RELEASE=`uname -v`
+		;;
+	esac
+	# Japanese Language versions have a version number like `4.1.3-JL'.
+	echo sparc-sun-sunos`echo ${UNAME_RELEASE}|sed -e 's/-/_/'`
+	exit ;;
+    sun3*:SunOS:*:*)
+	echo m68k-sun-sunos${UNAME_RELEASE}
+	exit ;;
+    sun*:*:4.2BSD:*)
+	UNAME_RELEASE=`(sed 1q /etc/motd | awk '{print substr($5,1,3)}') 2>/dev/null`
+	test "x${UNAME_RELEASE}" = "x" && UNAME_RELEASE=3
+	case "`/bin/arch`" in
+	    sun3)
+		echo m68k-sun-sunos${UNAME_RELEASE}
+		;;
+	    sun4)
+		echo sparc-sun-sunos${UNAME_RELEASE}
+		;;
+	esac
+	exit ;;
+    aushp:SunOS:*:*)
+	echo sparc-auspex-sunos${UNAME_RELEASE}
+	exit ;;
+    # The situation for MiNT is a little confusing.  The machine name
+    # can be virtually everything (everything which is not
+    # "atarist" or "atariste" at least should have a processor
+    # > m68000).  The system name ranges from "MiNT" over "FreeMiNT"
+    # to the lowercase version "mint" (or "freemint").  Finally
+    # the system name "TOS" denotes a system which is actually not
+    # MiNT.  But MiNT is downward compatible to TOS, so this should
+    # be no problem.
+    atarist[e]:*MiNT:*:* | atarist[e]:*mint:*:* | atarist[e]:*TOS:*:*)
+	echo m68k-atari-mint${UNAME_RELEASE}
+	exit ;;
+    atari*:*MiNT:*:* | atari*:*mint:*:* | atarist[e]:*TOS:*:*)
+	echo m68k-atari-mint${UNAME_RELEASE}
+	exit ;;
+    *falcon*:*MiNT:*:* | *falcon*:*mint:*:* | *falcon*:*TOS:*:*)
+	echo m68k-atari-mint${UNAME_RELEASE}
+	exit ;;
+    milan*:*MiNT:*:* | milan*:*mint:*:* | *milan*:*TOS:*:*)
+	echo m68k-milan-mint${UNAME_RELEASE}
+	exit ;;
+    hades*:*MiNT:*:* | hades*:*mint:*:* | *hades*:*TOS:*:*)
+	echo m68k-hades-mint${UNAME_RELEASE}
+	exit ;;
+    *:*MiNT:*:* | *:*mint:*:* | *:*TOS:*:*)
+	echo m68k-unknown-mint${UNAME_RELEASE}
+	exit ;;
+    m68k:machten:*:*)
+	echo m68k-apple-machten${UNAME_RELEASE}
+	exit ;;
+    powerpc:machten:*:*)
+	echo powerpc-apple-machten${UNAME_RELEASE}
+	exit ;;
+    RISC*:Mach:*:*)
+	echo mips-dec-mach_bsd4.3
+	exit ;;
+    RISC*:ULTRIX:*:*)
+	echo mips-dec-ultrix${UNAME_RELEASE}
+	exit ;;
+    VAX*:ULTRIX*:*:*)
+	echo vax-dec-ultrix${UNAME_RELEASE}
+	exit ;;
+    2020:CLIX:*:* | 2430:CLIX:*:*)
+	echo clipper-intergraph-clix${UNAME_RELEASE}
+	exit ;;
+    mips:*:*:UMIPS | mips:*:*:RISCos)
+	eval $set_cc_for_build
+	sed 's/^	//' << EOF >$dummy.c
+#ifdef __cplusplus
+#include <stdio.h>  /* for printf() prototype */
+	int main (int argc, char *argv[]) {
+#else
+	int main (argc, argv) int argc; char *argv[]; {
+#endif
+	#if defined (host_mips) && defined (MIPSEB)
+	#if defined (SYSTYPE_SYSV)
+	  printf ("mips-mips-riscos%ssysv\n", argv[1]); exit (0);
+	#endif
+	#if defined (SYSTYPE_SVR4)
+	  printf ("mips-mips-riscos%ssvr4\n", argv[1]); exit (0);
+	#endif
+	#if defined (SYSTYPE_BSD43) || defined(SYSTYPE_BSD)
+	  printf ("mips-mips-riscos%sbsd\n", argv[1]); exit (0);
+	#endif
+	#endif
+	  exit (-1);
+	}
+EOF
+	$CC_FOR_BUILD -o $dummy $dummy.c &&
+	  dummyarg=`echo "${UNAME_RELEASE}" | sed -n 's/\([0-9]*\).*/\1/p'` &&
+	  SYSTEM_NAME=`$dummy $dummyarg` &&
+	    { echo "$SYSTEM_NAME"; exit; }
+	echo mips-mips-riscos${UNAME_RELEASE}
+	exit ;;
+    Motorola:PowerMAX_OS:*:*)
+	echo powerpc-motorola-powermax
+	exit ;;
+    Motorola:*:4.3:PL8-*)
+	echo powerpc-harris-powermax
+	exit ;;
+    Night_Hawk:*:*:PowerMAX_OS | Synergy:PowerMAX_OS:*:*)
+	echo powerpc-harris-powermax
+	exit ;;
+    Night_Hawk:Power_UNIX:*:*)
+	echo powerpc-harris-powerunix
+	exit ;;
+    m88k:CX/UX:7*:*)
+	echo m88k-harris-cxux7
+	exit ;;
+    m88k:*:4*:R4*)
+	echo m88k-motorola-sysv4
+	exit ;;
+    m88k:*:3*:R3*)
+	echo m88k-motorola-sysv3
+	exit ;;
+    AViiON:dgux:*:*)
+	# DG/UX returns AViiON for all architectures
+	UNAME_PROCESSOR=`/usr/bin/uname -p`
+	if [ $UNAME_PROCESSOR = mc88100 ] || [ $UNAME_PROCESSOR = mc88110 ]
+	then
+	    if [ ${TARGET_BINARY_INTERFACE}x = m88kdguxelfx ] || \
+	       [ ${TARGET_BINARY_INTERFACE}x = x ]
+	    then
+		echo m88k-dg-dgux${UNAME_RELEASE}
+	    else
+		echo m88k-dg-dguxbcs${UNAME_RELEASE}
+	    fi
+	else
+	    echo i586-dg-dgux${UNAME_RELEASE}
+	fi
+	exit ;;
+    M88*:DolphinOS:*:*)	# DolphinOS (SVR3)
+	echo m88k-dolphin-sysv3
+	exit ;;
+    M88*:*:R3*:*)
+	# Delta 88k system running SVR3
+	echo m88k-motorola-sysv3
+	exit ;;
+    XD88*:*:*:*) # Tektronix XD88 system running UTekV (SVR3)
+	echo m88k-tektronix-sysv3
+	exit ;;
+    Tek43[0-9][0-9]:UTek:*:*) # Tektronix 4300 system running UTek (BSD)
+	echo m68k-tektronix-bsd
+	exit ;;
+    *:IRIX*:*:*)
+	echo mips-sgi-irix`echo ${UNAME_RELEASE}|sed -e 's/-/_/g'`
+	exit ;;
+    ????????:AIX?:[12].1:2)   # AIX 2.2.1 or AIX 2.1.1 is RT/PC AIX.
+	echo romp-ibm-aix     # uname -m gives an 8 hex-code CPU id
+	exit ;;               # Note that: echo "'`uname -s`'" gives 'AIX '
+    i*86:AIX:*:*)
+	echo i386-ibm-aix
+	exit ;;
+    ia64:AIX:*:*)
+	if [ -x /usr/bin/oslevel ] ; then
+		IBM_REV=`/usr/bin/oslevel`
+	else
+		IBM_REV=${UNAME_VERSION}.${UNAME_RELEASE}
+	fi
+	echo ${UNAME_MACHINE}-ibm-aix${IBM_REV}
+	exit ;;
+    *:AIX:2:3)
+	if grep bos325 /usr/include/stdio.h >/dev/null 2>&1; then
+		eval $set_cc_for_build
+		sed 's/^		//' << EOF >$dummy.c
+		#include <sys/systemcfg.h>
+
+		main()
+			{
+			if (!__power_pc())
+				exit(1);
+			puts("powerpc-ibm-aix3.2.5");
+			exit(0);
+			}
+EOF
+		if $CC_FOR_BUILD -o $dummy $dummy.c && SYSTEM_NAME=`$dummy`
+		then
+			echo "$SYSTEM_NAME"
+		else
+			echo rs6000-ibm-aix3.2.5
+		fi
+	elif grep bos324 /usr/include/stdio.h >/dev/null 2>&1; then
+		echo rs6000-ibm-aix3.2.4
+	else
+		echo rs6000-ibm-aix3.2
+	fi
+	exit ;;
+    *:AIX:*:[4567])
+	IBM_CPU_ID=`/usr/sbin/lsdev -C -c processor -S available | sed 1q | awk '{ print $1 }'`
+	if /usr/sbin/lsattr -El ${IBM_CPU_ID} | grep ' POWER' >/dev/null 2>&1; then
+		IBM_ARCH=rs6000
+	else
+		IBM_ARCH=powerpc
+	fi
+	if [ -x /usr/bin/oslevel ] ; then
+		IBM_REV=`/usr/bin/oslevel`
+	else
+		IBM_REV=${UNAME_VERSION}.${UNAME_RELEASE}
+	fi
+	echo ${IBM_ARCH}-ibm-aix${IBM_REV}
+	exit ;;
+    *:AIX:*:*)
+	echo rs6000-ibm-aix
+	exit ;;
+    ibmrt:4.4BSD:*|romp-ibm:BSD:*)
+	echo romp-ibm-bsd4.4
+	exit ;;
+    ibmrt:*BSD:*|romp-ibm:BSD:*)            # covers RT/PC BSD and
+	echo romp-ibm-bsd${UNAME_RELEASE}   # 4.3 with uname added to
+	exit ;;                             # report: romp-ibm BSD 4.3
+    *:BOSX:*:*)
+	echo rs6000-bull-bosx
+	exit ;;
+    DPX/2?00:B.O.S.:*:*)
+	echo m68k-bull-sysv3
+	exit ;;
+    9000/[34]??:4.3bsd:1.*:*)
+	echo m68k-hp-bsd
+	exit ;;
+    hp300:4.4BSD:*:* | 9000/[34]??:4.3bsd:2.*:*)
+	echo m68k-hp-bsd4.4
+	exit ;;
+    9000/[34678]??:HP-UX:*:*)
+	HPUX_REV=`echo ${UNAME_RELEASE}|sed -e 's/[^.]*.[0B]*//'`
+	case "${UNAME_MACHINE}" in
+	    9000/31? )            HP_ARCH=m68000 ;;
+	    9000/[34]?? )         HP_ARCH=m68k ;;
+	    9000/[678][0-9][0-9])
+		if [ -x /usr/bin/getconf ]; then
+		    sc_cpu_version=`/usr/bin/getconf SC_CPU_VERSION 2>/dev/null`
+		    sc_kernel_bits=`/usr/bin/getconf SC_KERNEL_BITS 2>/dev/null`
+		    case "${sc_cpu_version}" in
+		      523) HP_ARCH="hppa1.0" ;; # CPU_PA_RISC1_0
+		      528) HP_ARCH="hppa1.1" ;; # CPU_PA_RISC1_1
+		      532)                      # CPU_PA_RISC2_0
+			case "${sc_kernel_bits}" in
+			  32) HP_ARCH="hppa2.0n" ;;
+			  64) HP_ARCH="hppa2.0w" ;;
+			  '') HP_ARCH="hppa2.0" ;;   # HP-UX 10.20
+			esac ;;
+		    esac
+		fi
+		if [ "${HP_ARCH}" = "" ]; then
+		    eval $set_cc_for_build
+		    sed 's/^		//' << EOF >$dummy.c
+
+		#define _HPUX_SOURCE
+		#include <stdlib.h>
+		#include <unistd.h>
+
+		int main ()
+		{
+		#if defined(_SC_KERNEL_BITS)
+		    long bits = sysconf(_SC_KERNEL_BITS);
+		#endif
+		    long cpu  = sysconf (_SC_CPU_VERSION);
+
+		    switch (cpu)
+			{
+			case CPU_PA_RISC1_0: puts ("hppa1.0"); break;
+			case CPU_PA_RISC1_1: puts ("hppa1.1"); break;
+			case CPU_PA_RISC2_0:
+		#if defined(_SC_KERNEL_BITS)
+			    switch (bits)
+				{
+				case 64: puts ("hppa2.0w"); break;
+				case 32: puts ("hppa2.0n"); break;
+				default: puts ("hppa2.0"); break;
+				} break;
+		#else  /* !defined(_SC_KERNEL_BITS) */
+			    puts ("hppa2.0"); break;
+		#endif
+			default: puts ("hppa1.0"); break;
+			}
+		    exit (0);
+		}
+EOF
+		    (CCOPTS= $CC_FOR_BUILD -o $dummy $dummy.c 2>/dev/null) && HP_ARCH=`$dummy`
+		    test -z "$HP_ARCH" && HP_ARCH=hppa
+		fi ;;
+	esac
+	if [ ${HP_ARCH} = "hppa2.0w" ]
+	then
+	    eval $set_cc_for_build
+
+	    # hppa2.0w-hp-hpux* has a 64-bit kernel and a compiler generating
+	    # 32-bit code.  hppa64-hp-hpux* has the same kernel and a compiler
+	    # generating 64-bit code.  GNU and HP use different nomenclature:
+	    #
+	    # $ CC_FOR_BUILD=cc ./config.guess
+	    # => hppa2.0w-hp-hpux11.23
+	    # $ CC_FOR_BUILD="cc +DA2.0w" ./config.guess
+	    # => hppa64-hp-hpux11.23
+
+	    if echo __LP64__ | (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) |
+		grep -q __LP64__
+	    then
+		HP_ARCH="hppa2.0w"
+	    else
+		HP_ARCH="hppa64"
+	    fi
+	fi
+	echo ${HP_ARCH}-hp-hpux${HPUX_REV}
+	exit ;;
+    ia64:HP-UX:*:*)
+	HPUX_REV=`echo ${UNAME_RELEASE}|sed -e 's/[^.]*.[0B]*//'`
+	echo ia64-hp-hpux${HPUX_REV}
+	exit ;;
+    3050*:HI-UX:*:*)
+	eval $set_cc_for_build
+	sed 's/^	//' << EOF >$dummy.c
+	#include <unistd.h>
+	int
+	main ()
+	{
+	  long cpu = sysconf (_SC_CPU_VERSION);
+	  /* The order matters, because CPU_IS_HP_MC68K erroneously returns
+	     true for CPU_PA_RISC1_0.  CPU_IS_PA_RISC returns correct
+	     results, however.  */
+	  if (CPU_IS_PA_RISC (cpu))
+	    {
+	      switch (cpu)
+		{
+		  case CPU_PA_RISC1_0: puts ("hppa1.0-hitachi-hiuxwe2"); break;
+		  case CPU_PA_RISC1_1: puts ("hppa1.1-hitachi-hiuxwe2"); break;
+		  case CPU_PA_RISC2_0: puts ("hppa2.0-hitachi-hiuxwe2"); break;
+		  default: puts ("hppa-hitachi-hiuxwe2"); break;
+		}
+	    }
+	  else if (CPU_IS_HP_MC68K (cpu))
+	    puts ("m68k-hitachi-hiuxwe2");
+	  else puts ("unknown-hitachi-hiuxwe2");
+	  exit (0);
+	}
+EOF
+	$CC_FOR_BUILD -o $dummy $dummy.c && SYSTEM_NAME=`$dummy` &&
+		{ echo "$SYSTEM_NAME"; exit; }
+	echo unknown-hitachi-hiuxwe2
+	exit ;;
+    9000/7??:4.3bsd:*:* | 9000/8?[79]:4.3bsd:*:* )
+	echo hppa1.1-hp-bsd
+	exit ;;
+    9000/8??:4.3bsd:*:*)
+	echo hppa1.0-hp-bsd
+	exit ;;
+    *9??*:MPE/iX:*:* | *3000*:MPE/iX:*:*)
+	echo hppa1.0-hp-mpeix
+	exit ;;
+    hp7??:OSF1:*:* | hp8?[79]:OSF1:*:* )
+	echo hppa1.1-hp-osf
+	exit ;;
+    hp8??:OSF1:*:*)
+	echo hppa1.0-hp-osf
+	exit ;;
+    i*86:OSF1:*:*)
+	if [ -x /usr/sbin/sysversion ] ; then
+	    echo ${UNAME_MACHINE}-unknown-osf1mk
+	else
+	    echo ${UNAME_MACHINE}-unknown-osf1
+	fi
+	exit ;;
+    parisc*:Lites*:*:*)
+	echo hppa1.1-hp-lites
+	exit ;;
+    C1*:ConvexOS:*:* | convex:ConvexOS:C1*:*)
+	echo c1-convex-bsd
+	exit ;;
+    C2*:ConvexOS:*:* | convex:ConvexOS:C2*:*)
+	if getsysinfo -f scalar_acc
+	then echo c32-convex-bsd
+	else echo c2-convex-bsd
+	fi
+	exit ;;
+    C34*:ConvexOS:*:* | convex:ConvexOS:C34*:*)
+	echo c34-convex-bsd
+	exit ;;
+    C38*:ConvexOS:*:* | convex:ConvexOS:C38*:*)
+	echo c38-convex-bsd
+	exit ;;
+    C4*:ConvexOS:*:* | convex:ConvexOS:C4*:*)
+	echo c4-convex-bsd
+	exit ;;
+    CRAY*Y-MP:*:*:*)
+	echo ymp-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/'
+	exit ;;
+    CRAY*[A-Z]90:*:*:*)
+	echo ${UNAME_MACHINE}-cray-unicos${UNAME_RELEASE} \
+	| sed -e 's/CRAY.*\([A-Z]90\)/\1/' \
+	      -e y/ABCDEFGHIJKLMNOPQRSTUVWXYZ/abcdefghijklmnopqrstuvwxyz/ \
+	      -e 's/\.[^.]*$/.X/'
+	exit ;;
+    CRAY*TS:*:*:*)
+	echo t90-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/'
+	exit ;;
+    CRAY*T3E:*:*:*)
+	echo alphaev5-cray-unicosmk${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/'
+	exit ;;
+    CRAY*SV1:*:*:*)
+	echo sv1-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/'
+	exit ;;
+    *:UNICOS/mp:*:*)
+	echo craynv-cray-unicosmp${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/'
+	exit ;;
+    F30[01]:UNIX_System_V:*:* | F700:UNIX_System_V:*:*)
+	FUJITSU_PROC=`uname -m | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'`
+	FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'`
+	FUJITSU_REL=`echo ${UNAME_RELEASE} | sed -e 's/ /_/'`
+	echo "${FUJITSU_PROC}-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}"
+	exit ;;
+    5000:UNIX_System_V:4.*:*)
+	FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'`
+	FUJITSU_REL=`echo ${UNAME_RELEASE} | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/ /_/'`
+	echo "sparc-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}"
+	exit ;;
+    i*86:BSD/386:*:* | i*86:BSD/OS:*:* | *:Ascend\ Embedded/OS:*:*)
+	echo ${UNAME_MACHINE}-pc-bsdi${UNAME_RELEASE}
+	exit ;;
+    sparc*:BSD/OS:*:*)
+	echo sparc-unknown-bsdi${UNAME_RELEASE}
+	exit ;;
+    *:BSD/OS:*:*)
+	echo ${UNAME_MACHINE}-unknown-bsdi${UNAME_RELEASE}
+	exit ;;
+    *:FreeBSD:*:*)
+	UNAME_PROCESSOR=`/usr/bin/uname -p`
+	case ${UNAME_PROCESSOR} in
+	    amd64)
+		echo x86_64-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;;
+	    *)
+		echo ${UNAME_PROCESSOR}-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;;
+	esac
+	exit ;;
+    i*:CYGWIN*:*)
+	echo ${UNAME_MACHINE}-pc-cygwin
+	exit ;;
+    *:MINGW64*:*)
+	echo ${UNAME_MACHINE}-pc-mingw64
+	exit ;;
+    *:MINGW*:*)
+	echo ${UNAME_MACHINE}-pc-mingw32
+	exit ;;
+    i*:MSYS*:*)
+	echo ${UNAME_MACHINE}-pc-msys
+	exit ;;
+    i*:windows32*:*)
+	# uname -m includes "-pc" on this system.
+	echo ${UNAME_MACHINE}-mingw32
+	exit ;;
+    i*:PW*:*)
+	echo ${UNAME_MACHINE}-pc-pw32
+	exit ;;
+    *:Interix*:*)
+	case ${UNAME_MACHINE} in
+	    x86)
+		echo i586-pc-interix${UNAME_RELEASE}
+		exit ;;
+	    authenticamd | genuineintel | EM64T)
+		echo x86_64-unknown-interix${UNAME_RELEASE}
+		exit ;;
+	    IA64)
+		echo ia64-unknown-interix${UNAME_RELEASE}
+		exit ;;
+	esac ;;
+    [345]86:Windows_95:* | [345]86:Windows_98:* | [345]86:Windows_NT:*)
+	echo i${UNAME_MACHINE}-pc-mks
+	exit ;;
+    8664:Windows_NT:*)
+	echo x86_64-pc-mks
+	exit ;;
+    i*:Windows_NT*:* | Pentium*:Windows_NT*:*)
+	# How do we know it's Interix rather than the generic POSIX subsystem?
+	# It also conflicts with pre-2.0 versions of AT&T UWIN. Should we
+	# UNAME_MACHINE based on the output of uname instead of i386?
+	echo i586-pc-interix
+	exit ;;
+    i*:UWIN*:*)
+	echo ${UNAME_MACHINE}-pc-uwin
+	exit ;;
+    amd64:CYGWIN*:*:* | x86_64:CYGWIN*:*:*)
+	echo x86_64-unknown-cygwin
+	exit ;;
+    p*:CYGWIN*:*)
+	echo powerpcle-unknown-cygwin
+	exit ;;
+    prep*:SunOS:5.*:*)
+	echo powerpcle-unknown-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`
+	exit ;;
+    *:GNU:*:*)
+	# the GNU system
+	echo `echo ${UNAME_MACHINE}|sed -e 's,[-/].*$,,'`-unknown-${LIBC}`echo ${UNAME_RELEASE}|sed -e 's,/.*$,,'`
+	exit ;;
+    *:GNU/*:*:*)
+	# other systems with GNU libc and userland
+	echo ${UNAME_MACHINE}-unknown-`echo ${UNAME_SYSTEM} | sed 's,^[^/]*/,,' | tr '[A-Z]' '[a-z]'``echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'`-${LIBC}
+	exit ;;
+    i*86:Minix:*:*)
+	echo ${UNAME_MACHINE}-pc-minix
+	exit ;;
+    aarch64:Linux:*:*)
+	echo ${UNAME_MACHINE}-unknown-linux-${LIBC}
+	exit ;;
+    aarch64_be:Linux:*:*)
+	UNAME_MACHINE=aarch64_be
+	echo ${UNAME_MACHINE}-unknown-linux-${LIBC}
+	exit ;;
+    alpha:Linux:*:*)
+	case `sed -n '/^cpu model/s/^.*: \(.*\)/\1/p' < /proc/cpuinfo` in
+	  EV5)   UNAME_MACHINE=alphaev5 ;;
+	  EV56)  UNAME_MACHINE=alphaev56 ;;
+	  PCA56) UNAME_MACHINE=alphapca56 ;;
+	  PCA57) UNAME_MACHINE=alphapca56 ;;
+	  EV6)   UNAME_MACHINE=alphaev6 ;;
+	  EV67)  UNAME_MACHINE=alphaev67 ;;
+	  EV68*) UNAME_MACHINE=alphaev68 ;;
+	esac
+	objdump --private-headers /bin/sh | grep -q ld.so.1
+	if test "$?" = 0 ; then LIBC="gnulibc1" ; fi
+	echo ${UNAME_MACHINE}-unknown-linux-${LIBC}
+	exit ;;
+    arc:Linux:*:* | arceb:Linux:*:*)
+	echo ${UNAME_MACHINE}-unknown-linux-${LIBC}
+	exit ;;
+    arm*:Linux:*:*)
+	eval $set_cc_for_build
+	if echo __ARM_EABI__ | $CC_FOR_BUILD -E - 2>/dev/null \
+	    | grep -q __ARM_EABI__
+	then
+	    echo ${UNAME_MACHINE}-unknown-linux-${LIBC}
+	else
+	    if echo __ARM_PCS_VFP | $CC_FOR_BUILD -E - 2>/dev/null \
+		| grep -q __ARM_PCS_VFP
+	    then
+		echo ${UNAME_MACHINE}-unknown-linux-${LIBC}eabi
+	    else
+		echo ${UNAME_MACHINE}-unknown-linux-${LIBC}eabihf
+	    fi
+	fi
+	exit ;;
+    avr32*:Linux:*:*)
+	echo ${UNAME_MACHINE}-unknown-linux-${LIBC}
+	exit ;;
+    cris:Linux:*:*)
+	echo ${UNAME_MACHINE}-axis-linux-${LIBC}
+	exit ;;
+    crisv32:Linux:*:*)
+	echo ${UNAME_MACHINE}-axis-linux-${LIBC}
+	exit ;;
+    frv:Linux:*:*)
+	echo ${UNAME_MACHINE}-unknown-linux-${LIBC}
+	exit ;;
+    hexagon:Linux:*:*)
+	echo ${UNAME_MACHINE}-unknown-linux-${LIBC}
+	exit ;;
+    i*86:Linux:*:*)
+	echo ${UNAME_MACHINE}-pc-linux-${LIBC}
+	exit ;;
+    ia64:Linux:*:*)
+	echo ${UNAME_MACHINE}-unknown-linux-${LIBC}
+	exit ;;
+    m32r*:Linux:*:*)
+	echo ${UNAME_MACHINE}-unknown-linux-${LIBC}
+	exit ;;
+    m68*:Linux:*:*)
+	echo ${UNAME_MACHINE}-unknown-linux-${LIBC}
+	exit ;;
+    mips:Linux:*:* | mips64:Linux:*:*)
+	eval $set_cc_for_build
+	sed 's/^	//' << EOF >$dummy.c
+	#undef CPU
+	#undef ${UNAME_MACHINE}
+	#undef ${UNAME_MACHINE}el
+	#if defined(__MIPSEL__) || defined(__MIPSEL) || defined(_MIPSEL) || defined(MIPSEL)
+	CPU=${UNAME_MACHINE}el
+	#else
+	#if defined(__MIPSEB__) || defined(__MIPSEB) || defined(_MIPSEB) || defined(MIPSEB)
+	CPU=${UNAME_MACHINE}
+	#else
+	CPU=
+	#endif
+	#endif
+EOF
+	eval `$CC_FOR_BUILD -E $dummy.c 2>/dev/null | grep '^CPU'`
+	test x"${CPU}" != x && { echo "${CPU}-unknown-linux-${LIBC}"; exit; }
+	;;
+    or1k:Linux:*:*)
+	echo ${UNAME_MACHINE}-unknown-linux-${LIBC}
+	exit ;;
+    or32:Linux:*:*)
+	echo ${UNAME_MACHINE}-unknown-linux-${LIBC}
+	exit ;;
+    padre:Linux:*:*)
+	echo sparc-unknown-linux-${LIBC}
+	exit ;;
+    parisc64:Linux:*:* | hppa64:Linux:*:*)
+	echo hppa64-unknown-linux-${LIBC}
+	exit ;;
+    parisc:Linux:*:* | hppa:Linux:*:*)
+	# Look for CPU level
+	case `grep '^cpu[^a-z]*:' /proc/cpuinfo 2>/dev/null | cut -d' ' -f2` in
+	  PA7*) echo hppa1.1-unknown-linux-${LIBC} ;;
+	  PA8*) echo hppa2.0-unknown-linux-${LIBC} ;;
+	  *)    echo hppa-unknown-linux-${LIBC} ;;
+	esac
+	exit ;;
+    ppc64:Linux:*:*)
+	echo powerpc64-unknown-linux-${LIBC}
+	exit ;;
+    ppc:Linux:*:*)
+	echo powerpc-unknown-linux-${LIBC}
+	exit ;;
+    ppc64le:Linux:*:*)
+	echo powerpc64le-unknown-linux-${LIBC}
+	exit ;;
+    ppcle:Linux:*:*)
+	echo powerpcle-unknown-linux-${LIBC}
+	exit ;;
+    s390:Linux:*:* | s390x:Linux:*:*)
+	echo ${UNAME_MACHINE}-ibm-linux-${LIBC}
+	exit ;;
+    sh64*:Linux:*:*)
+	echo ${UNAME_MACHINE}-unknown-linux-${LIBC}
+	exit ;;
+    sh*:Linux:*:*)
+	echo ${UNAME_MACHINE}-unknown-linux-${LIBC}
+	exit ;;
+    sparc:Linux:*:* | sparc64:Linux:*:*)
+	echo ${UNAME_MACHINE}-unknown-linux-${LIBC}
+	exit ;;
+    tile*:Linux:*:*)
+	echo ${UNAME_MACHINE}-unknown-linux-${LIBC}
+	exit ;;
+    vax:Linux:*:*)
+	echo ${UNAME_MACHINE}-dec-linux-${LIBC}
+	exit ;;
+    x86_64:Linux:*:*)
+	echo ${UNAME_MACHINE}-unknown-linux-${LIBC}
+	exit ;;
+    xtensa*:Linux:*:*)
+	echo ${UNAME_MACHINE}-unknown-linux-${LIBC}
+	exit ;;
+    i*86:DYNIX/ptx:4*:*)
+	# ptx 4.0 does uname -s correctly, with DYNIX/ptx in there.
+	# earlier versions are messed up and put the nodename in both
+	# sysname and nodename.
+	echo i386-sequent-sysv4
+	exit ;;
+    i*86:UNIX_SV:4.2MP:2.*)
+	# Unixware is an offshoot of SVR4, but it has its own version
+	# number series starting with 2...
+	# I am not positive that other SVR4 systems won't match this,
+	# I just have to hope.  -- rms.
+	# Use sysv4.2uw... so that sysv4* matches it.
+	echo ${UNAME_MACHINE}-pc-sysv4.2uw${UNAME_VERSION}
+	exit ;;
+    i*86:OS/2:*:*)
+	# If we were able to find `uname', then EMX Unix compatibility
+	# is probably installed.
+	echo ${UNAME_MACHINE}-pc-os2-emx
+	exit ;;
+    i*86:XTS-300:*:STOP)
+	echo ${UNAME_MACHINE}-unknown-stop
+	exit ;;
+    i*86:atheos:*:*)
+	echo ${UNAME_MACHINE}-unknown-atheos
+	exit ;;
+    i*86:syllable:*:*)
+	echo ${UNAME_MACHINE}-pc-syllable
+	exit ;;
+    i*86:LynxOS:2.*:* | i*86:LynxOS:3.[01]*:* | i*86:LynxOS:4.[02]*:*)
+	echo i386-unknown-lynxos${UNAME_RELEASE}
+	exit ;;
+    i*86:*DOS:*:*)
+	echo ${UNAME_MACHINE}-pc-msdosdjgpp
+	exit ;;
+    i*86:*:4.*:* | i*86:SYSTEM_V:4.*:*)
+	UNAME_REL=`echo ${UNAME_RELEASE} | sed 's/\/MP$//'`
+	if grep Novell /usr/include/link.h >/dev/null 2>/dev/null; then
+		echo ${UNAME_MACHINE}-univel-sysv${UNAME_REL}
+	else
+		echo ${UNAME_MACHINE}-pc-sysv${UNAME_REL}
+	fi
+	exit ;;
+    i*86:*:5:[678]*)
+	# UnixWare 7.x, OpenUNIX and OpenServer 6.
+	case `/bin/uname -X | grep "^Machine"` in
+	    *486*)	     UNAME_MACHINE=i486 ;;
+	    *Pentium)	     UNAME_MACHINE=i586 ;;
+	    *Pent*|*Celeron) UNAME_MACHINE=i686 ;;
+	esac
+	echo ${UNAME_MACHINE}-unknown-sysv${UNAME_RELEASE}${UNAME_SYSTEM}${UNAME_VERSION}
+	exit ;;
+    i*86:*:3.2:*)
+	if test -f /usr/options/cb.name; then
+		UNAME_REL=`sed -n 's/.*Version //p' </usr/options/cb.name`
+		echo ${UNAME_MACHINE}-pc-isc$UNAME_REL
+	elif /bin/uname -X 2>/dev/null >/dev/null ; then
+		UNAME_REL=`(/bin/uname -X|grep Release|sed -e 's/.*= //')`
+		(/bin/uname -X|grep i80486 >/dev/null) && UNAME_MACHINE=i486
+		(/bin/uname -X|grep '^Machine.*Pentium' >/dev/null) \
+			&& UNAME_MACHINE=i586
+		(/bin/uname -X|grep '^Machine.*Pent *II' >/dev/null) \
+			&& UNAME_MACHINE=i686
+		(/bin/uname -X|grep '^Machine.*Pentium Pro' >/dev/null) \
+			&& UNAME_MACHINE=i686
+		echo ${UNAME_MACHINE}-pc-sco$UNAME_REL
+	else
+		echo ${UNAME_MACHINE}-pc-sysv32
+	fi
+	exit ;;
+    pc:*:*:*)
+	# Left here for compatibility:
+	# uname -m prints for DJGPP always 'pc', but it prints nothing about
+	# the processor, so we play safe by assuming i586.
+	# Note: whatever this is, it MUST be the same as what config.sub
+	# prints for the "djgpp" host, or else GDB configury will decide that
+	# this is a cross-build.
+	echo i586-pc-msdosdjgpp
+	exit ;;
+    Intel:Mach:3*:*)
+	echo i386-pc-mach3
+	exit ;;
+    paragon:*:*:*)
+	echo i860-intel-osf1
+	exit ;;
+    i860:*:4.*:*) # i860-SVR4
+	if grep Stardent /usr/include/sys/uadmin.h >/dev/null 2>&1 ; then
+	  echo i860-stardent-sysv${UNAME_RELEASE} # Stardent Vistra i860-SVR4
+	else # Add other i860-SVR4 vendors below as they are discovered.
+	  echo i860-unknown-sysv${UNAME_RELEASE}  # Unknown i860-SVR4
+	fi
+	exit ;;
+    mini*:CTIX:SYS*5:*)
+	# "miniframe"
+	echo m68010-convergent-sysv
+	exit ;;
+    mc68k:UNIX:SYSTEM5:3.51m)
+	echo m68k-convergent-sysv
+	exit ;;
+    M680?0:D-NIX:5.3:*)
+	echo m68k-diab-dnix
+	exit ;;
+    M68*:*:R3V[5678]*:*)
+	test -r /sysV68 && { echo 'm68k-motorola-sysv'; exit; } ;;
+    3[345]??:*:4.0:3.0 | 3[34]??A:*:4.0:3.0 | 3[34]??,*:*:4.0:3.0 | 3[34]??/*:*:4.0:3.0 | 4400:*:4.0:3.0 | 4850:*:4.0:3.0 | SKA40:*:4.0:3.0 | SDS2:*:4.0:3.0 | SHG2:*:4.0:3.0 | S7501*:*:4.0:3.0)
+	OS_REL=''
+	test -r /etc/.relid \
+	&& OS_REL=.`sed -n 's/[^ ]* [^ ]* \([0-9][0-9]\).*/\1/p' < /etc/.relid`
+	/bin/uname -p 2>/dev/null | grep 86 >/dev/null \
+	  && { echo i486-ncr-sysv4.3${OS_REL}; exit; }
+	/bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \
+	  && { echo i586-ncr-sysv4.3${OS_REL}; exit; } ;;
+    3[34]??:*:4.0:* | 3[34]??,*:*:4.0:*)
+	/bin/uname -p 2>/dev/null | grep 86 >/dev/null \
+	  && { echo i486-ncr-sysv4; exit; } ;;
+    NCR*:*:4.2:* | MPRAS*:*:4.2:*)
+	OS_REL='.3'
+	test -r /etc/.relid \
+	    && OS_REL=.`sed -n 's/[^ ]* [^ ]* \([0-9][0-9]\).*/\1/p' < /etc/.relid`
+	/bin/uname -p 2>/dev/null | grep 86 >/dev/null \
+	    && { echo i486-ncr-sysv4.3${OS_REL}; exit; }
+	/bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \
+	    && { echo i586-ncr-sysv4.3${OS_REL}; exit; }
+	/bin/uname -p 2>/dev/null | /bin/grep pteron >/dev/null \
+	    && { echo i586-ncr-sysv4.3${OS_REL}; exit; } ;;
+    m68*:LynxOS:2.*:* | m68*:LynxOS:3.0*:*)
+	echo m68k-unknown-lynxos${UNAME_RELEASE}
+	exit ;;
+    mc68030:UNIX_System_V:4.*:*)
+	echo m68k-atari-sysv4
+	exit ;;
+    TSUNAMI:LynxOS:2.*:*)
+	echo sparc-unknown-lynxos${UNAME_RELEASE}
+	exit ;;
+    rs6000:LynxOS:2.*:*)
+	echo rs6000-unknown-lynxos${UNAME_RELEASE}
+	exit ;;
+    PowerPC:LynxOS:2.*:* | PowerPC:LynxOS:3.[01]*:* | PowerPC:LynxOS:4.[02]*:*)
+	echo powerpc-unknown-lynxos${UNAME_RELEASE}
+	exit ;;
+    SM[BE]S:UNIX_SV:*:*)
+	echo mips-dde-sysv${UNAME_RELEASE}
+	exit ;;
+    RM*:ReliantUNIX-*:*:*)
+	echo mips-sni-sysv4
+	exit ;;
+    RM*:SINIX-*:*:*)
+	echo mips-sni-sysv4
+	exit ;;
+    *:SINIX-*:*:*)
+	if uname -p 2>/dev/null >/dev/null ; then
+		UNAME_MACHINE=`(uname -p) 2>/dev/null`
+		echo ${UNAME_MACHINE}-sni-sysv4
+	else
+		echo ns32k-sni-sysv
+	fi
+	exit ;;
+    PENTIUM:*:4.0*:*)	# Unisys `ClearPath HMP IX 4000' SVR4/MP effort
+			# says <Richard.M.Bartel@ccMail.Census.GOV>
+	echo i586-unisys-sysv4
+	exit ;;
+    *:UNIX_System_V:4*:FTX*)
+	# From Gerald Hewes <hewes@openmarket.com>.
+	# How about differentiating between stratus architectures? -djm
+	echo hppa1.1-stratus-sysv4
+	exit ;;
+    *:*:*:FTX*)
+	# From seanf@swdc.stratus.com.
+	echo i860-stratus-sysv4
+	exit ;;
+    i*86:VOS:*:*)
+	# From Paul.Green@stratus.com.
+	echo ${UNAME_MACHINE}-stratus-vos
+	exit ;;
+    *:VOS:*:*)
+	# From Paul.Green@stratus.com.
+	echo hppa1.1-stratus-vos
+	exit ;;
+    mc68*:A/UX:*:*)
+	echo m68k-apple-aux${UNAME_RELEASE}
+	exit ;;
+    news*:NEWS-OS:6*:*)
+	echo mips-sony-newsos6
+	exit ;;
+    R[34]000:*System_V*:*:* | R4000:UNIX_SYSV:*:* | R*000:UNIX_SV:*:*)
+	if [ -d /usr/nec ]; then
+		echo mips-nec-sysv${UNAME_RELEASE}
+	else
+		echo mips-unknown-sysv${UNAME_RELEASE}
+	fi
+	exit ;;
+    BeBox:BeOS:*:*)	# BeOS running on hardware made by Be, PPC only.
+	echo powerpc-be-beos
+	exit ;;
+    BeMac:BeOS:*:*)	# BeOS running on Mac or Mac clone, PPC only.
+	echo powerpc-apple-beos
+	exit ;;
+    BePC:BeOS:*:*)	# BeOS running on Intel PC compatible.
+	echo i586-pc-beos
+	exit ;;
+    BePC:Haiku:*:*)	# Haiku running on Intel PC compatible.
+	echo i586-pc-haiku
+	exit ;;
+    x86_64:Haiku:*:*)
+	echo x86_64-unknown-haiku
+	exit ;;
+    SX-4:SUPER-UX:*:*)
+	echo sx4-nec-superux${UNAME_RELEASE}
+	exit ;;
+    SX-5:SUPER-UX:*:*)
+	echo sx5-nec-superux${UNAME_RELEASE}
+	exit ;;
+    SX-6:SUPER-UX:*:*)
+	echo sx6-nec-superux${UNAME_RELEASE}
+	exit ;;
+    SX-7:SUPER-UX:*:*)
+	echo sx7-nec-superux${UNAME_RELEASE}
+	exit ;;
+    SX-8:SUPER-UX:*:*)
+	echo sx8-nec-superux${UNAME_RELEASE}
+	exit ;;
+    SX-8R:SUPER-UX:*:*)
+	echo sx8r-nec-superux${UNAME_RELEASE}
+	exit ;;
+    Power*:Rhapsody:*:*)
+	echo powerpc-apple-rhapsody${UNAME_RELEASE}
+	exit ;;
+    *:Rhapsody:*:*)
+	echo ${UNAME_MACHINE}-apple-rhapsody${UNAME_RELEASE}
+	exit ;;
+    *:Darwin:*:*)
+	UNAME_PROCESSOR=`uname -p` || UNAME_PROCESSOR=unknown
+	eval $set_cc_for_build
+	if test "$UNAME_PROCESSOR" = unknown ; then
+	    UNAME_PROCESSOR=powerpc
+	fi
+	if [ "$CC_FOR_BUILD" != 'no_compiler_found' ]; then
+	    if (echo '#ifdef __LP64__'; echo IS_64BIT_ARCH; echo '#endif') | \
+		(CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | \
+		grep IS_64BIT_ARCH >/dev/null
+	    then
+		case $UNAME_PROCESSOR in
+		    i386) UNAME_PROCESSOR=x86_64 ;;
+		    powerpc) UNAME_PROCESSOR=powerpc64 ;;
+		esac
+	    fi
+	fi
+	echo ${UNAME_PROCESSOR}-apple-darwin${UNAME_RELEASE}
+	exit ;;
+    *:procnto*:*:* | *:QNX:[0123456789]*:*)
+	UNAME_PROCESSOR=`uname -p`
+	if test "$UNAME_PROCESSOR" = "x86"; then
+		UNAME_PROCESSOR=i386
+		UNAME_MACHINE=pc
+	fi
+	echo ${UNAME_PROCESSOR}-${UNAME_MACHINE}-nto-qnx${UNAME_RELEASE}
+	exit ;;
+    *:QNX:*:4*)
+	echo i386-pc-qnx
+	exit ;;
+    NEO-?:NONSTOP_KERNEL:*:*)
+	echo neo-tandem-nsk${UNAME_RELEASE}
+	exit ;;
+    NSE-*:NONSTOP_KERNEL:*:*)
+	echo nse-tandem-nsk${UNAME_RELEASE}
+	exit ;;
+    NSR-?:NONSTOP_KERNEL:*:*)
+	echo nsr-tandem-nsk${UNAME_RELEASE}
+	exit ;;
+    *:NonStop-UX:*:*)
+	echo mips-compaq-nonstopux
+	exit ;;
+    BS2000:POSIX*:*:*)
+	echo bs2000-siemens-sysv
+	exit ;;
+    DS/*:UNIX_System_V:*:*)
+	echo ${UNAME_MACHINE}-${UNAME_SYSTEM}-${UNAME_RELEASE}
+	exit ;;
+    *:Plan9:*:*)
+	# "uname -m" is not consistent, so use $cputype instead. 386
+	# is converted to i386 for consistency with other x86
+	# operating systems.
+	if test "$cputype" = "386"; then
+	    UNAME_MACHINE=i386
+	else
+	    UNAME_MACHINE="$cputype"
+	fi
+	echo ${UNAME_MACHINE}-unknown-plan9
+	exit ;;
+    *:TOPS-10:*:*)
+	echo pdp10-unknown-tops10
+	exit ;;
+    *:TENEX:*:*)
+	echo pdp10-unknown-tenex
+	exit ;;
+    KS10:TOPS-20:*:* | KL10:TOPS-20:*:* | TYPE4:TOPS-20:*:*)
+	echo pdp10-dec-tops20
+	exit ;;
+    XKL-1:TOPS-20:*:* | TYPE5:TOPS-20:*:*)
+	echo pdp10-xkl-tops20
+	exit ;;
+    *:TOPS-20:*:*)
+	echo pdp10-unknown-tops20
+	exit ;;
+    *:ITS:*:*)
+	echo pdp10-unknown-its
+	exit ;;
+    SEI:*:*:SEIUX)
+	echo mips-sei-seiux${UNAME_RELEASE}
+	exit ;;
+    *:DragonFly:*:*)
+	echo ${UNAME_MACHINE}-unknown-dragonfly`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'`
+	exit ;;
+    *:*VMS:*:*)
+	UNAME_MACHINE=`(uname -p) 2>/dev/null`
+	case "${UNAME_MACHINE}" in
+	    A*) echo alpha-dec-vms ; exit ;;
+	    I*) echo ia64-dec-vms ; exit ;;
+	    V*) echo vax-dec-vms ; exit ;;
+	esac ;;
+    *:XENIX:*:SysV)
+	echo i386-pc-xenix
+	exit ;;
+    i*86:skyos:*:*)
+	echo ${UNAME_MACHINE}-pc-skyos`echo ${UNAME_RELEASE}` | sed -e 's/ .*$//'
+	exit ;;
+    i*86:rdos:*:*)
+	echo ${UNAME_MACHINE}-pc-rdos
+	exit ;;
+    i*86:AROS:*:*)
+	echo ${UNAME_MACHINE}-pc-aros
+	exit ;;
+    x86_64:VMkernel:*:*)
+	echo ${UNAME_MACHINE}-unknown-esx
+	exit ;;
+esac
+
+eval $set_cc_for_build
+cat >$dummy.c <<EOF
+#ifdef _SEQUENT_
+# include <sys/types.h>
+# include <sys/utsname.h>
+#endif
+main ()
+{
+#if defined (sony)
+#if defined (MIPSEB)
+  /* BFD wants "bsd" instead of "newsos".  Perhaps BFD should be changed,
+     I don't know....  */
+  printf ("mips-sony-bsd\n"); exit (0);
+#else
+#include <sys/param.h>
+  printf ("m68k-sony-newsos%s\n",
+#ifdef NEWSOS4
+	"4"
+#else
+	""
+#endif
+	); exit (0);
+#endif
+#endif
+
+#if defined (__arm) && defined (__acorn) && defined (__unix)
+  printf ("arm-acorn-riscix\n"); exit (0);
+#endif
+
+#if defined (hp300) && !defined (hpux)
+  printf ("m68k-hp-bsd\n"); exit (0);
+#endif
+
+#if defined (NeXT)
+#if !defined (__ARCHITECTURE__)
+#define __ARCHITECTURE__ "m68k"
+#endif
+  int version;
+  version=`(hostinfo | sed -n 's/.*NeXT Mach \([0-9]*\).*/\1/p') 2>/dev/null`;
+  if (version < 4)
+    printf ("%s-next-nextstep%d\n", __ARCHITECTURE__, version);
+  else
+    printf ("%s-next-openstep%d\n", __ARCHITECTURE__, version);
+  exit (0);
+#endif
+
+#if defined (MULTIMAX) || defined (n16)
+#if defined (UMAXV)
+  printf ("ns32k-encore-sysv\n"); exit (0);
+#else
+#if defined (CMU)
+  printf ("ns32k-encore-mach\n"); exit (0);
+#else
+  printf ("ns32k-encore-bsd\n"); exit (0);
+#endif
+#endif
+#endif
+
+#if defined (__386BSD__)
+  printf ("i386-pc-bsd\n"); exit (0);
+#endif
+
+#if defined (sequent)
+#if defined (i386)
+  printf ("i386-sequent-dynix\n"); exit (0);
+#endif
+#if defined (ns32000)
+  printf ("ns32k-sequent-dynix\n"); exit (0);
+#endif
+#endif
+
+#if defined (_SEQUENT_)
+    struct utsname un;
+
+    uname(&un);
+
+    if (strncmp(un.version, "V2", 2) == 0) {
+	printf ("i386-sequent-ptx2\n"); exit (0);
+    }
+    if (strncmp(un.version, "V1", 2) == 0) { /* XXX is V1 correct? */
+	printf ("i386-sequent-ptx1\n"); exit (0);
+    }
+    printf ("i386-sequent-ptx\n"); exit (0);
+
+#endif
+
+#if defined (vax)
+# if !defined (ultrix)
+#  include <sys/param.h>
+#  if defined (BSD)
+#   if BSD == 43
+      printf ("vax-dec-bsd4.3\n"); exit (0);
+#   else
+#    if BSD == 199006
+      printf ("vax-dec-bsd4.3reno\n"); exit (0);
+#    else
+      printf ("vax-dec-bsd\n"); exit (0);
+#    endif
+#   endif
+#  else
+    printf ("vax-dec-bsd\n"); exit (0);
+#  endif
+# else
+    printf ("vax-dec-ultrix\n"); exit (0);
+# endif
+#endif
+
+#if defined (alliant) && defined (i860)
+  printf ("i860-alliant-bsd\n"); exit (0);
+#endif
+
+  exit (1);
+}
+EOF
+
+$CC_FOR_BUILD -o $dummy $dummy.c 2>/dev/null && SYSTEM_NAME=`$dummy` &&
+	{ echo "$SYSTEM_NAME"; exit; }
+
+# Apollos put the system type in the environment.
+
+test -d /usr/apollo && { echo ${ISP}-apollo-${SYSTYPE}; exit; }
+
+# Convex versions that predate uname can use getsysinfo(1)
+
+if [ -x /usr/convex/getsysinfo ]
+then
+    case `getsysinfo -f cpu_type` in
+    c1*)
+	echo c1-convex-bsd
+	exit ;;
+    c2*)
+	if getsysinfo -f scalar_acc
+	then echo c32-convex-bsd
+	else echo c2-convex-bsd
+	fi
+	exit ;;
+    c34*)
+	echo c34-convex-bsd
+	exit ;;
+    c38*)
+	echo c38-convex-bsd
+	exit ;;
+    c4*)
+	echo c4-convex-bsd
+	exit ;;
+    esac
+fi
+
+cat >&2 <<EOF
+$0: unable to guess system type
+
+This script, last modified $timestamp, has failed to recognize
+the operating system you are using. It is advised that you
+download the most up to date version of the config scripts from
+
+  http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.guess;hb=HEAD
+and
+  http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.sub;hb=HEAD
+
+If the version you run ($0) is already up to date, please
+send the following data and any information you think might be
+pertinent to <config-patches@gnu.org> in order to provide the needed
+information to handle your system.
+
+config.guess timestamp = $timestamp
+
+uname -m = `(uname -m) 2>/dev/null || echo unknown`
+uname -r = `(uname -r) 2>/dev/null || echo unknown`
+uname -s = `(uname -s) 2>/dev/null || echo unknown`
+uname -v = `(uname -v) 2>/dev/null || echo unknown`
+
+/usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null`
+/bin/uname -X     = `(/bin/uname -X) 2>/dev/null`
+
+hostinfo               = `(hostinfo) 2>/dev/null`
+/bin/universe          = `(/bin/universe) 2>/dev/null`
+/usr/bin/arch -k       = `(/usr/bin/arch -k) 2>/dev/null`
+/bin/arch              = `(/bin/arch) 2>/dev/null`
+/usr/bin/oslevel       = `(/usr/bin/oslevel) 2>/dev/null`
+/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null`
+
+UNAME_MACHINE = ${UNAME_MACHINE}
+UNAME_RELEASE = ${UNAME_RELEASE}
+UNAME_SYSTEM  = ${UNAME_SYSTEM}
+UNAME_VERSION = ${UNAME_VERSION}
+EOF
+
+exit 1
+
+# Local variables:
+# eval: (add-hook 'write-file-hooks 'time-stamp)
+# time-stamp-start: "timestamp='"
+# time-stamp-format: "%:y-%02m-%02d"
+# time-stamp-end: "'"
+# End:
diff --git a/libraries/base/config.sub b/libraries/base/config.sub
new file mode 100644
index 000000000000..9633db704678
--- /dev/null
+++ b/libraries/base/config.sub
@@ -0,0 +1,1791 @@
+#! /bin/sh
+# Configuration validation subroutine script.
+#   Copyright 1992-2013 Free Software Foundation, Inc.
+
+timestamp='2013-08-10'
+
+# This file is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+# General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, see <http://www.gnu.org/licenses/>.
+#
+# As a special exception to the GNU General Public License, if you
+# distribute this file as part of a program that contains a
+# configuration script generated by Autoconf, you may include it under
+# the same distribution terms that you use for the rest of that
+# program.  This Exception is an additional permission under section 7
+# of the GNU General Public License, version 3 ("GPLv3").
+
+
+# Please send patches with a ChangeLog entry to config-patches@gnu.org.
+#
+# Configuration subroutine to validate and canonicalize a configuration type.
+# Supply the specified configuration type as an argument.
+# If it is invalid, we print an error message on stderr and exit with code 1.
+# Otherwise, we print the canonical config type on stdout and succeed.
+
+# You can get the latest version of this script from:
+# http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.sub;hb=HEAD
+
+# This file is supposed to be the same for all GNU packages
+# and recognize all the CPU types, system types and aliases
+# that are meaningful with *any* GNU software.
+# Each package is responsible for reporting which valid configurations
+# it does not support.  The user should be able to distinguish
+# a failure to support a valid configuration from a meaningless
+# configuration.
+
+# The goal of this file is to map all the various variations of a given
+# machine specification into a single specification in the form:
+#	CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM
+# or in some cases, the newer four-part form:
+#	CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM
+# It is wrong to echo any other type of specification.
+
+me=`echo "$0" | sed -e 's,.*/,,'`
+
+usage="\
+Usage: $0 [OPTION] CPU-MFR-OPSYS
+       $0 [OPTION] ALIAS
+
+Canonicalize a configuration name.
+
+Operation modes:
+  -h, --help         print this help, then exit
+  -t, --time-stamp   print date of last modification, then exit
+  -v, --version      print version number, then exit
+
+Report bugs and patches to <config-patches@gnu.org>."
+
+version="\
+GNU config.sub ($timestamp)
+
+Copyright 1992-2013 Free Software Foundation, Inc.
+
+This is free software; see the source for copying conditions.  There is NO
+warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE."
+
+help="
+Try \`$me --help' for more information."
+
+# Parse command line
+while test $# -gt 0 ; do
+  case $1 in
+    --time-stamp | --time* | -t )
+       echo "$timestamp" ; exit ;;
+    --version | -v )
+       echo "$version" ; exit ;;
+    --help | --h* | -h )
+       echo "$usage"; exit ;;
+    -- )     # Stop option processing
+       shift; break ;;
+    - )	# Use stdin as input.
+       break ;;
+    -* )
+       echo "$me: invalid option $1$help"
+       exit 1 ;;
+
+    *local*)
+       # First pass through any local machine types.
+       echo $1
+       exit ;;
+
+    * )
+       break ;;
+  esac
+done
+
+case $# in
+ 0) echo "$me: missing argument$help" >&2
+    exit 1;;
+ 1) ;;
+ *) echo "$me: too many arguments$help" >&2
+    exit 1;;
+esac
+
+# Separate what the user gave into CPU-COMPANY and OS or KERNEL-OS (if any).
+# Here we must recognize all the valid KERNEL-OS combinations.
+maybe_os=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\2/'`
+case $maybe_os in
+  nto-qnx* | linux-gnu* | linux-android* | linux-dietlibc | linux-newlib* | \
+  linux-musl* | linux-uclibc* | uclinux-uclibc* | uclinux-gnu* | kfreebsd*-gnu* | \
+  knetbsd*-gnu* | netbsd*-gnu* | \
+  kopensolaris*-gnu* | \
+  storm-chaos* | os2-emx* | rtmk-nova*)
+    os=-$maybe_os
+    basic_machine=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\1/'`
+    ;;
+  android-linux)
+    os=-linux-android
+    basic_machine=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\1/'`-unknown
+    ;;
+  *)
+    basic_machine=`echo $1 | sed 's/-[^-]*$//'`
+    if [ $basic_machine != $1 ]
+    then os=`echo $1 | sed 's/.*-/-/'`
+    else os=; fi
+    ;;
+esac
+
+### Let's recognize common machines as not being operating systems so
+### that things like config.sub decstation-3100 work.  We also
+### recognize some manufacturers as not being operating systems, so we
+### can provide default operating systems below.
+case $os in
+	-sun*os*)
+		# Prevent following clause from handling this invalid input.
+		;;
+	-dec* | -mips* | -sequent* | -encore* | -pc532* | -sgi* | -sony* | \
+	-att* | -7300* | -3300* | -delta* | -motorola* | -sun[234]* | \
+	-unicom* | -ibm* | -next | -hp | -isi* | -apollo | -altos* | \
+	-convergent* | -ncr* | -news | -32* | -3600* | -3100* | -hitachi* |\
+	-c[123]* | -convex* | -sun | -crds | -omron* | -dg | -ultra | -tti* | \
+	-harris | -dolphin | -highlevel | -gould | -cbm | -ns | -masscomp | \
+	-apple | -axis | -knuth | -cray | -microblaze*)
+		os=
+		basic_machine=$1
+		;;
+	-bluegene*)
+		os=-cnk
+		;;
+	-sim | -cisco | -oki | -wec | -winbond)
+		os=
+		basic_machine=$1
+		;;
+	-scout)
+		;;
+	-wrs)
+		os=-vxworks
+		basic_machine=$1
+		;;
+	-chorusos*)
+		os=-chorusos
+		basic_machine=$1
+		;;
+	-chorusrdb)
+		os=-chorusrdb
+		basic_machine=$1
+		;;
+	-hiux*)
+		os=-hiuxwe2
+		;;
+	-sco6)
+		os=-sco5v6
+		basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
+		;;
+	-sco5)
+		os=-sco3.2v5
+		basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
+		;;
+	-sco4)
+		os=-sco3.2v4
+		basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
+		;;
+	-sco3.2.[4-9]*)
+		os=`echo $os | sed -e 's/sco3.2./sco3.2v/'`
+		basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
+		;;
+	-sco3.2v[4-9]*)
+		# Don't forget version if it is 3.2v4 or newer.
+		basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
+		;;
+	-sco5v6*)
+		# Don't forget version if it is 3.2v4 or newer.
+		basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
+		;;
+	-sco*)
+		os=-sco3.2v2
+		basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
+		;;
+	-udk*)
+		basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
+		;;
+	-isc)
+		os=-isc2.2
+		basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
+		;;
+	-clix*)
+		basic_machine=clipper-intergraph
+		;;
+	-isc*)
+		basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
+		;;
+	-lynx*178)
+		os=-lynxos178
+		;;
+	-lynx*5)
+		os=-lynxos5
+		;;
+	-lynx*)
+		os=-lynxos
+		;;
+	-ptx*)
+		basic_machine=`echo $1 | sed -e 's/86-.*/86-sequent/'`
+		;;
+	-windowsnt*)
+		os=`echo $os | sed -e 's/windowsnt/winnt/'`
+		;;
+	-psos*)
+		os=-psos
+		;;
+	-mint | -mint[0-9]*)
+		basic_machine=m68k-atari
+		os=-mint
+		;;
+esac
+
+# Decode aliases for certain CPU-COMPANY combinations.
+case $basic_machine in
+	# Recognize the basic CPU types without company name.
+	# Some are omitted here because they have special meanings below.
+	1750a | 580 \
+	| a29k \
+	| aarch64 | aarch64_be \
+	| alpha | alphaev[4-8] | alphaev56 | alphaev6[78] | alphapca5[67] \
+	| alpha64 | alpha64ev[4-8] | alpha64ev56 | alpha64ev6[78] | alpha64pca5[67] \
+	| am33_2.0 \
+	| arc | arceb \
+	| arm | arm[bl]e | arme[lb] | armv[2-8] | armv[3-8][lb] | armv7[arm] \
+	| avr | avr32 \
+	| be32 | be64 \
+	| bfin \
+	| c4x | c8051 | clipper \
+	| d10v | d30v | dlx | dsp16xx \
+	| epiphany \
+	| fido | fr30 | frv \
+	| h8300 | h8500 | hppa | hppa1.[01] | hppa2.0 | hppa2.0[nw] | hppa64 \
+	| hexagon \
+	| i370 | i860 | i960 | ia64 \
+	| ip2k | iq2000 \
+	| le32 | le64 \
+	| lm32 \
+	| m32c | m32r | m32rle | m68000 | m68k | m88k \
+	| maxq | mb | microblaze | microblazeel | mcore | mep | metag \
+	| mips | mipsbe | mipseb | mipsel | mipsle \
+	| mips16 \
+	| mips64 | mips64el \
+	| mips64octeon | mips64octeonel \
+	| mips64orion | mips64orionel \
+	| mips64r5900 | mips64r5900el \
+	| mips64vr | mips64vrel \
+	| mips64vr4100 | mips64vr4100el \
+	| mips64vr4300 | mips64vr4300el \
+	| mips64vr5000 | mips64vr5000el \
+	| mips64vr5900 | mips64vr5900el \
+	| mipsisa32 | mipsisa32el \
+	| mipsisa32r2 | mipsisa32r2el \
+	| mipsisa64 | mipsisa64el \
+	| mipsisa64r2 | mipsisa64r2el \
+	| mipsisa64sb1 | mipsisa64sb1el \
+	| mipsisa64sr71k | mipsisa64sr71kel \
+	| mipsr5900 | mipsr5900el \
+	| mipstx39 | mipstx39el \
+	| mn10200 | mn10300 \
+	| moxie \
+	| mt \
+	| msp430 \
+	| nds32 | nds32le | nds32be \
+	| nios | nios2 | nios2eb | nios2el \
+	| ns16k | ns32k \
+	| open8 \
+	| or1k | or32 \
+	| pdp10 | pdp11 | pj | pjl \
+	| powerpc | powerpc64 | powerpc64le | powerpcle \
+	| pyramid \
+	| rl78 | rx \
+	| score \
+	| sh | sh[1234] | sh[24]a | sh[24]aeb | sh[23]e | sh[34]eb | sheb | shbe | shle | sh[1234]le | sh3ele \
+	| sh64 | sh64le \
+	| sparc | sparc64 | sparc64b | sparc64v | sparc86x | sparclet | sparclite \
+	| sparcv8 | sparcv9 | sparcv9b | sparcv9v \
+	| spu \
+	| tahoe | tic4x | tic54x | tic55x | tic6x | tic80 | tron \
+	| ubicom32 \
+	| v850 | v850e | v850e1 | v850e2 | v850es | v850e2v3 \
+	| we32k \
+	| x86 | xc16x | xstormy16 | xtensa \
+	| z8k | z80)
+		basic_machine=$basic_machine-unknown
+		;;
+	c54x)
+		basic_machine=tic54x-unknown
+		;;
+	c55x)
+		basic_machine=tic55x-unknown
+		;;
+	c6x)
+		basic_machine=tic6x-unknown
+		;;
+	m6811 | m68hc11 | m6812 | m68hc12 | m68hcs12x | picochip)
+		basic_machine=$basic_machine-unknown
+		os=-none
+		;;
+	m88110 | m680[12346]0 | m683?2 | m68360 | m5200 | v70 | w65 | z8k)
+		;;
+	ms1)
+		basic_machine=mt-unknown
+		;;
+
+	strongarm | thumb | xscale)
+		basic_machine=arm-unknown
+		;;
+	xgate)
+		basic_machine=$basic_machine-unknown
+		os=-none
+		;;
+	xscaleeb)
+		basic_machine=armeb-unknown
+		;;
+
+	xscaleel)
+		basic_machine=armel-unknown
+		;;
+
+	# We use `pc' rather than `unknown'
+	# because (1) that's what they normally are, and
+	# (2) the word "unknown" tends to confuse beginning users.
+	i*86 | x86_64)
+	  basic_machine=$basic_machine-pc
+	  ;;
+	# Object if more than one company name word.
+	*-*-*)
+		echo Invalid configuration \`$1\': machine \`$basic_machine\' not recognized 1>&2
+		exit 1
+		;;
+	# Recognize the basic CPU types with company name.
+	580-* \
+	| a29k-* \
+	| aarch64-* | aarch64_be-* \
+	| alpha-* | alphaev[4-8]-* | alphaev56-* | alphaev6[78]-* \
+	| alpha64-* | alpha64ev[4-8]-* | alpha64ev56-* | alpha64ev6[78]-* \
+	| alphapca5[67]-* | alpha64pca5[67]-* | arc-* | arceb-* \
+	| arm-*  | armbe-* | armle-* | armeb-* | armv*-* \
+	| avr-* | avr32-* \
+	| be32-* | be64-* \
+	| bfin-* | bs2000-* \
+	| c[123]* | c30-* | [cjt]90-* | c4x-* \
+	| c8051-* | clipper-* | craynv-* | cydra-* \
+	| d10v-* | d30v-* | dlx-* \
+	| elxsi-* \
+	| f30[01]-* | f700-* | fido-* | fr30-* | frv-* | fx80-* \
+	| h8300-* | h8500-* \
+	| hppa-* | hppa1.[01]-* | hppa2.0-* | hppa2.0[nw]-* | hppa64-* \
+	| hexagon-* \
+	| i*86-* | i860-* | i960-* | ia64-* \
+	| ip2k-* | iq2000-* \
+	| le32-* | le64-* \
+	| lm32-* \
+	| m32c-* | m32r-* | m32rle-* \
+	| m68000-* | m680[012346]0-* | m68360-* | m683?2-* | m68k-* \
+	| m88110-* | m88k-* | maxq-* | mcore-* | metag-* \
+	| microblaze-* | microblazeel-* \
+	| mips-* | mipsbe-* | mipseb-* | mipsel-* | mipsle-* \
+	| mips16-* \
+	| mips64-* | mips64el-* \
+	| mips64octeon-* | mips64octeonel-* \
+	| mips64orion-* | mips64orionel-* \
+	| mips64r5900-* | mips64r5900el-* \
+	| mips64vr-* | mips64vrel-* \
+	| mips64vr4100-* | mips64vr4100el-* \
+	| mips64vr4300-* | mips64vr4300el-* \
+	| mips64vr5000-* | mips64vr5000el-* \
+	| mips64vr5900-* | mips64vr5900el-* \
+	| mipsisa32-* | mipsisa32el-* \
+	| mipsisa32r2-* | mipsisa32r2el-* \
+	| mipsisa64-* | mipsisa64el-* \
+	| mipsisa64r2-* | mipsisa64r2el-* \
+	| mipsisa64sb1-* | mipsisa64sb1el-* \
+	| mipsisa64sr71k-* | mipsisa64sr71kel-* \
+	| mipsr5900-* | mipsr5900el-* \
+	| mipstx39-* | mipstx39el-* \
+	| mmix-* \
+	| mt-* \
+	| msp430-* \
+	| nds32-* | nds32le-* | nds32be-* \
+	| nios-* | nios2-* | nios2eb-* | nios2el-* \
+	| none-* | np1-* | ns16k-* | ns32k-* \
+	| open8-* \
+	| orion-* \
+	| pdp10-* | pdp11-* | pj-* | pjl-* | pn-* | power-* \
+	| powerpc-* | powerpc64-* | powerpc64le-* | powerpcle-* \
+	| pyramid-* \
+	| rl78-* | romp-* | rs6000-* | rx-* \
+	| sh-* | sh[1234]-* | sh[24]a-* | sh[24]aeb-* | sh[23]e-* | sh[34]eb-* | sheb-* | shbe-* \
+	| shle-* | sh[1234]le-* | sh3ele-* | sh64-* | sh64le-* \
+	| sparc-* | sparc64-* | sparc64b-* | sparc64v-* | sparc86x-* | sparclet-* \
+	| sparclite-* \
+	| sparcv8-* | sparcv9-* | sparcv9b-* | sparcv9v-* | sv1-* | sx?-* \
+	| tahoe-* \
+	| tic30-* | tic4x-* | tic54x-* | tic55x-* | tic6x-* | tic80-* \
+	| tile*-* \
+	| tron-* \
+	| ubicom32-* \
+	| v850-* | v850e-* | v850e1-* | v850es-* | v850e2-* | v850e2v3-* \
+	| vax-* \
+	| we32k-* \
+	| x86-* | x86_64-* | xc16x-* | xps100-* \
+	| xstormy16-* | xtensa*-* \
+	| ymp-* \
+	| z8k-* | z80-*)
+		;;
+	# Recognize the basic CPU types without company name, with glob match.
+	xtensa*)
+		basic_machine=$basic_machine-unknown
+		;;
+	# Recognize the various machine names and aliases which stand
+	# for a CPU type and a company and sometimes even an OS.
+	386bsd)
+		basic_machine=i386-unknown
+		os=-bsd
+		;;
+	3b1 | 7300 | 7300-att | att-7300 | pc7300 | safari | unixpc)
+		basic_machine=m68000-att
+		;;
+	3b*)
+		basic_machine=we32k-att
+		;;
+	a29khif)
+		basic_machine=a29k-amd
+		os=-udi
+		;;
+	abacus)
+		basic_machine=abacus-unknown
+		;;
+	adobe68k)
+		basic_machine=m68010-adobe
+		os=-scout
+		;;
+	alliant | fx80)
+		basic_machine=fx80-alliant
+		;;
+	altos | altos3068)
+		basic_machine=m68k-altos
+		;;
+	am29k)
+		basic_machine=a29k-none
+		os=-bsd
+		;;
+	amd64)
+		basic_machine=x86_64-pc
+		;;
+	amd64-*)
+		basic_machine=x86_64-`echo $basic_machine | sed 's/^[^-]*-//'`
+		;;
+	amdahl)
+		basic_machine=580-amdahl
+		os=-sysv
+		;;
+	amiga | amiga-*)
+		basic_machine=m68k-unknown
+		;;
+	amigaos | amigados)
+		basic_machine=m68k-unknown
+		os=-amigaos
+		;;
+	amigaunix | amix)
+		basic_machine=m68k-unknown
+		os=-sysv4
+		;;
+	apollo68)
+		basic_machine=m68k-apollo
+		os=-sysv
+		;;
+	apollo68bsd)
+		basic_machine=m68k-apollo
+		os=-bsd
+		;;
+	aros)
+		basic_machine=i386-pc
+		os=-aros
+		;;
+	aux)
+		basic_machine=m68k-apple
+		os=-aux
+		;;
+	balance)
+		basic_machine=ns32k-sequent
+		os=-dynix
+		;;
+	blackfin)
+		basic_machine=bfin-unknown
+		os=-linux
+		;;
+	blackfin-*)
+		basic_machine=bfin-`echo $basic_machine | sed 's/^[^-]*-//'`
+		os=-linux
+		;;
+	bluegene*)
+		basic_machine=powerpc-ibm
+		os=-cnk
+		;;
+	c54x-*)
+		basic_machine=tic54x-`echo $basic_machine | sed 's/^[^-]*-//'`
+		;;
+	c55x-*)
+		basic_machine=tic55x-`echo $basic_machine | sed 's/^[^-]*-//'`
+		;;
+	c6x-*)
+		basic_machine=tic6x-`echo $basic_machine | sed 's/^[^-]*-//'`
+		;;
+	c90)
+		basic_machine=c90-cray
+		os=-unicos
+		;;
+	cegcc)
+		basic_machine=arm-unknown
+		os=-cegcc
+		;;
+	convex-c1)
+		basic_machine=c1-convex
+		os=-bsd
+		;;
+	convex-c2)
+		basic_machine=c2-convex
+		os=-bsd
+		;;
+	convex-c32)
+		basic_machine=c32-convex
+		os=-bsd
+		;;
+	convex-c34)
+		basic_machine=c34-convex
+		os=-bsd
+		;;
+	convex-c38)
+		basic_machine=c38-convex
+		os=-bsd
+		;;
+	cray | j90)
+		basic_machine=j90-cray
+		os=-unicos
+		;;
+	craynv)
+		basic_machine=craynv-cray
+		os=-unicosmp
+		;;
+	cr16 | cr16-*)
+		basic_machine=cr16-unknown
+		os=-elf
+		;;
+	crds | unos)
+		basic_machine=m68k-crds
+		;;
+	crisv32 | crisv32-* | etraxfs*)
+		basic_machine=crisv32-axis
+		;;
+	cris | cris-* | etrax*)
+		basic_machine=cris-axis
+		;;
+	crx)
+		basic_machine=crx-unknown
+		os=-elf
+		;;
+	da30 | da30-*)
+		basic_machine=m68k-da30
+		;;
+	decstation | decstation-3100 | pmax | pmax-* | pmin | dec3100 | decstatn)
+		basic_machine=mips-dec
+		;;
+	decsystem10* | dec10*)
+		basic_machine=pdp10-dec
+		os=-tops10
+		;;
+	decsystem20* | dec20*)
+		basic_machine=pdp10-dec
+		os=-tops20
+		;;
+	delta | 3300 | motorola-3300 | motorola-delta \
+	      | 3300-motorola | delta-motorola)
+		basic_machine=m68k-motorola
+		;;
+	delta88)
+		basic_machine=m88k-motorola
+		os=-sysv3
+		;;
+	dicos)
+		basic_machine=i686-pc
+		os=-dicos
+		;;
+	djgpp)
+		basic_machine=i586-pc
+		os=-msdosdjgpp
+		;;
+	dpx20 | dpx20-*)
+		basic_machine=rs6000-bull
+		os=-bosx
+		;;
+	dpx2* | dpx2*-bull)
+		basic_machine=m68k-bull
+		os=-sysv3
+		;;
+	ebmon29k)
+		basic_machine=a29k-amd
+		os=-ebmon
+		;;
+	elxsi)
+		basic_machine=elxsi-elxsi
+		os=-bsd
+		;;
+	encore | umax | mmax)
+		basic_machine=ns32k-encore
+		;;
+	es1800 | OSE68k | ose68k | ose | OSE)
+		basic_machine=m68k-ericsson
+		os=-ose
+		;;
+	fx2800)
+		basic_machine=i860-alliant
+		;;
+	genix)
+		basic_machine=ns32k-ns
+		;;
+	gmicro)
+		basic_machine=tron-gmicro
+		os=-sysv
+		;;
+	go32)
+		basic_machine=i386-pc
+		os=-go32
+		;;
+	h3050r* | hiux*)
+		basic_machine=hppa1.1-hitachi
+		os=-hiuxwe2
+		;;
+	h8300hms)
+		basic_machine=h8300-hitachi
+		os=-hms
+		;;
+	h8300xray)
+		basic_machine=h8300-hitachi
+		os=-xray
+		;;
+	h8500hms)
+		basic_machine=h8500-hitachi
+		os=-hms
+		;;
+	harris)
+		basic_machine=m88k-harris
+		os=-sysv3
+		;;
+	hp300-*)
+		basic_machine=m68k-hp
+		;;
+	hp300bsd)
+		basic_machine=m68k-hp
+		os=-bsd
+		;;
+	hp300hpux)
+		basic_machine=m68k-hp
+		os=-hpux
+		;;
+	hp3k9[0-9][0-9] | hp9[0-9][0-9])
+		basic_machine=hppa1.0-hp
+		;;
+	hp9k2[0-9][0-9] | hp9k31[0-9])
+		basic_machine=m68000-hp
+		;;
+	hp9k3[2-9][0-9])
+		basic_machine=m68k-hp
+		;;
+	hp9k6[0-9][0-9] | hp6[0-9][0-9])
+		basic_machine=hppa1.0-hp
+		;;
+	hp9k7[0-79][0-9] | hp7[0-79][0-9])
+		basic_machine=hppa1.1-hp
+		;;
+	hp9k78[0-9] | hp78[0-9])
+		# FIXME: really hppa2.0-hp
+		basic_machine=hppa1.1-hp
+		;;
+	hp9k8[67]1 | hp8[67]1 | hp9k80[24] | hp80[24] | hp9k8[78]9 | hp8[78]9 | hp9k893 | hp893)
+		# FIXME: really hppa2.0-hp
+		basic_machine=hppa1.1-hp
+		;;
+	hp9k8[0-9][13679] | hp8[0-9][13679])
+		basic_machine=hppa1.1-hp
+		;;
+	hp9k8[0-9][0-9] | hp8[0-9][0-9])
+		basic_machine=hppa1.0-hp
+		;;
+	hppa-next)
+		os=-nextstep3
+		;;
+	hppaosf)
+		basic_machine=hppa1.1-hp
+		os=-osf
+		;;
+	hppro)
+		basic_machine=hppa1.1-hp
+		os=-proelf
+		;;
+	i370-ibm* | ibm*)
+		basic_machine=i370-ibm
+		;;
+	i*86v32)
+		basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'`
+		os=-sysv32
+		;;
+	i*86v4*)
+		basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'`
+		os=-sysv4
+		;;
+	i*86v)
+		basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'`
+		os=-sysv
+		;;
+	i*86sol2)
+		basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'`
+		os=-solaris2
+		;;
+	i386mach)
+		basic_machine=i386-mach
+		os=-mach
+		;;
+	i386-vsta | vsta)
+		basic_machine=i386-unknown
+		os=-vsta
+		;;
+	iris | iris4d)
+		basic_machine=mips-sgi
+		case $os in
+		    -irix*)
+			;;
+		    *)
+			os=-irix4
+			;;
+		esac
+		;;
+	isi68 | isi)
+		basic_machine=m68k-isi
+		os=-sysv
+		;;
+	m68knommu)
+		basic_machine=m68k-unknown
+		os=-linux
+		;;
+	m68knommu-*)
+		basic_machine=m68k-`echo $basic_machine | sed 's/^[^-]*-//'`
+		os=-linux
+		;;
+	m88k-omron*)
+		basic_machine=m88k-omron
+		;;
+	magnum | m3230)
+		basic_machine=mips-mips
+		os=-sysv
+		;;
+	merlin)
+		basic_machine=ns32k-utek
+		os=-sysv
+		;;
+	microblaze*)
+		basic_machine=microblaze-xilinx
+		;;
+	mingw64)
+		basic_machine=x86_64-pc
+		os=-mingw64
+		;;
+	mingw32)
+		basic_machine=i686-pc
+		os=-mingw32
+		;;
+	mingw32ce)
+		basic_machine=arm-unknown
+		os=-mingw32ce
+		;;
+	miniframe)
+		basic_machine=m68000-convergent
+		;;
+	*mint | -mint[0-9]* | *MiNT | *MiNT[0-9]*)
+		basic_machine=m68k-atari
+		os=-mint
+		;;
+	mips3*-*)
+		basic_machine=`echo $basic_machine | sed -e 's/mips3/mips64/'`
+		;;
+	mips3*)
+		basic_machine=`echo $basic_machine | sed -e 's/mips3/mips64/'`-unknown
+		;;
+	monitor)
+		basic_machine=m68k-rom68k
+		os=-coff
+		;;
+	morphos)
+		basic_machine=powerpc-unknown
+		os=-morphos
+		;;
+	msdos)
+		basic_machine=i386-pc
+		os=-msdos
+		;;
+	ms1-*)
+		basic_machine=`echo $basic_machine | sed -e 's/ms1-/mt-/'`
+		;;
+	msys)
+		basic_machine=i686-pc
+		os=-msys
+		;;
+	mvs)
+		basic_machine=i370-ibm
+		os=-mvs
+		;;
+	nacl)
+		basic_machine=le32-unknown
+		os=-nacl
+		;;
+	ncr3000)
+		basic_machine=i486-ncr
+		os=-sysv4
+		;;
+	netbsd386)
+		basic_machine=i386-unknown
+		os=-netbsd
+		;;
+	netwinder)
+		basic_machine=armv4l-rebel
+		os=-linux
+		;;
+	news | news700 | news800 | news900)
+		basic_machine=m68k-sony
+		os=-newsos
+		;;
+	news1000)
+		basic_machine=m68030-sony
+		os=-newsos
+		;;
+	news-3600 | risc-news)
+		basic_machine=mips-sony
+		os=-newsos
+		;;
+	necv70)
+		basic_machine=v70-nec
+		os=-sysv
+		;;
+	next | m*-next )
+		basic_machine=m68k-next
+		case $os in
+		    -nextstep* )
+			;;
+		    -ns2*)
+		      os=-nextstep2
+			;;
+		    *)
+		      os=-nextstep3
+			;;
+		esac
+		;;
+	nh3000)
+		basic_machine=m68k-harris
+		os=-cxux
+		;;
+	nh[45]000)
+		basic_machine=m88k-harris
+		os=-cxux
+		;;
+	nindy960)
+		basic_machine=i960-intel
+		os=-nindy
+		;;
+	mon960)
+		basic_machine=i960-intel
+		os=-mon960
+		;;
+	nonstopux)
+		basic_machine=mips-compaq
+		os=-nonstopux
+		;;
+	np1)
+		basic_machine=np1-gould
+		;;
+	neo-tandem)
+		basic_machine=neo-tandem
+		;;
+	nse-tandem)
+		basic_machine=nse-tandem
+		;;
+	nsr-tandem)
+		basic_machine=nsr-tandem
+		;;
+	op50n-* | op60c-*)
+		basic_machine=hppa1.1-oki
+		os=-proelf
+		;;
+	openrisc | openrisc-*)
+		basic_machine=or32-unknown
+		;;
+	os400)
+		basic_machine=powerpc-ibm
+		os=-os400
+		;;
+	OSE68000 | ose68000)
+		basic_machine=m68000-ericsson
+		os=-ose
+		;;
+	os68k)
+		basic_machine=m68k-none
+		os=-os68k
+		;;
+	pa-hitachi)
+		basic_machine=hppa1.1-hitachi
+		os=-hiuxwe2
+		;;
+	paragon)
+		basic_machine=i860-intel
+		os=-osf
+		;;
+	parisc)
+		basic_machine=hppa-unknown
+		os=-linux
+		;;
+	parisc-*)
+		basic_machine=hppa-`echo $basic_machine | sed 's/^[^-]*-//'`
+		os=-linux
+		;;
+	pbd)
+		basic_machine=sparc-tti
+		;;
+	pbb)
+		basic_machine=m68k-tti
+		;;
+	pc532 | pc532-*)
+		basic_machine=ns32k-pc532
+		;;
+	pc98)
+		basic_machine=i386-pc
+		;;
+	pc98-*)
+		basic_machine=i386-`echo $basic_machine | sed 's/^[^-]*-//'`
+		;;
+	pentium | p5 | k5 | k6 | nexgen | viac3)
+		basic_machine=i586-pc
+		;;
+	pentiumpro | p6 | 6x86 | athlon | athlon_*)
+		basic_machine=i686-pc
+		;;
+	pentiumii | pentium2 | pentiumiii | pentium3)
+		basic_machine=i686-pc
+		;;
+	pentium4)
+		basic_machine=i786-pc
+		;;
+	pentium-* | p5-* | k5-* | k6-* | nexgen-* | viac3-*)
+		basic_machine=i586-`echo $basic_machine | sed 's/^[^-]*-//'`
+		;;
+	pentiumpro-* | p6-* | 6x86-* | athlon-*)
+		basic_machine=i686-`echo $basic_machine | sed 's/^[^-]*-//'`
+		;;
+	pentiumii-* | pentium2-* | pentiumiii-* | pentium3-*)
+		basic_machine=i686-`echo $basic_machine | sed 's/^[^-]*-//'`
+		;;
+	pentium4-*)
+		basic_machine=i786-`echo $basic_machine | sed 's/^[^-]*-//'`
+		;;
+	pn)
+		basic_machine=pn-gould
+		;;
+	power)	basic_machine=power-ibm
+		;;
+	ppc | ppcbe)	basic_machine=powerpc-unknown
+		;;
+	ppc-* | ppcbe-*)
+		basic_machine=powerpc-`echo $basic_machine | sed 's/^[^-]*-//'`
+		;;
+	ppcle | powerpclittle | ppc-le | powerpc-little)
+		basic_machine=powerpcle-unknown
+		;;
+	ppcle-* | powerpclittle-*)
+		basic_machine=powerpcle-`echo $basic_machine | sed 's/^[^-]*-//'`
+		;;
+	ppc64)	basic_machine=powerpc64-unknown
+		;;
+	ppc64-*) basic_machine=powerpc64-`echo $basic_machine | sed 's/^[^-]*-//'`
+		;;
+	ppc64le | powerpc64little | ppc64-le | powerpc64-little)
+		basic_machine=powerpc64le-unknown
+		;;
+	ppc64le-* | powerpc64little-*)
+		basic_machine=powerpc64le-`echo $basic_machine | sed 's/^[^-]*-//'`
+		;;
+	ps2)
+		basic_machine=i386-ibm
+		;;
+	pw32)
+		basic_machine=i586-unknown
+		os=-pw32
+		;;
+	rdos | rdos64)
+		basic_machine=x86_64-pc
+		os=-rdos
+		;;
+	rdos32)
+		basic_machine=i386-pc
+		os=-rdos
+		;;
+	rom68k)
+		basic_machine=m68k-rom68k
+		os=-coff
+		;;
+	rm[46]00)
+		basic_machine=mips-siemens
+		;;
+	rtpc | rtpc-*)
+		basic_machine=romp-ibm
+		;;
+	s390 | s390-*)
+		basic_machine=s390-ibm
+		;;
+	s390x | s390x-*)
+		basic_machine=s390x-ibm
+		;;
+	sa29200)
+		basic_machine=a29k-amd
+		os=-udi
+		;;
+	sb1)
+		basic_machine=mipsisa64sb1-unknown
+		;;
+	sb1el)
+		basic_machine=mipsisa64sb1el-unknown
+		;;
+	sde)
+		basic_machine=mipsisa32-sde
+		os=-elf
+		;;
+	sei)
+		basic_machine=mips-sei
+		os=-seiux
+		;;
+	sequent)
+		basic_machine=i386-sequent
+		;;
+	sh)
+		basic_machine=sh-hitachi
+		os=-hms
+		;;
+	sh5el)
+		basic_machine=sh5le-unknown
+		;;
+	sh64)
+		basic_machine=sh64-unknown
+		;;
+	sparclite-wrs | simso-wrs)
+		basic_machine=sparclite-wrs
+		os=-vxworks
+		;;
+	sps7)
+		basic_machine=m68k-bull
+		os=-sysv2
+		;;
+	spur)
+		basic_machine=spur-unknown
+		;;
+	st2000)
+		basic_machine=m68k-tandem
+		;;
+	stratus)
+		basic_machine=i860-stratus
+		os=-sysv4
+		;;
+	strongarm-* | thumb-*)
+		basic_machine=arm-`echo $basic_machine | sed 's/^[^-]*-//'`
+		;;
+	sun2)
+		basic_machine=m68000-sun
+		;;
+	sun2os3)
+		basic_machine=m68000-sun
+		os=-sunos3
+		;;
+	sun2os4)
+		basic_machine=m68000-sun
+		os=-sunos4
+		;;
+	sun3os3)
+		basic_machine=m68k-sun
+		os=-sunos3
+		;;
+	sun3os4)
+		basic_machine=m68k-sun
+		os=-sunos4
+		;;
+	sun4os3)
+		basic_machine=sparc-sun
+		os=-sunos3
+		;;
+	sun4os4)
+		basic_machine=sparc-sun
+		os=-sunos4
+		;;
+	sun4sol2)
+		basic_machine=sparc-sun
+		os=-solaris2
+		;;
+	sun3 | sun3-*)
+		basic_machine=m68k-sun
+		;;
+	sun4)
+		basic_machine=sparc-sun
+		;;
+	sun386 | sun386i | roadrunner)
+		basic_machine=i386-sun
+		;;
+	sv1)
+		basic_machine=sv1-cray
+		os=-unicos
+		;;
+	symmetry)
+		basic_machine=i386-sequent
+		os=-dynix
+		;;
+	t3e)
+		basic_machine=alphaev5-cray
+		os=-unicos
+		;;
+	t90)
+		basic_machine=t90-cray
+		os=-unicos
+		;;
+	tile*)
+		basic_machine=$basic_machine-unknown
+		os=-linux-gnu
+		;;
+	tx39)
+		basic_machine=mipstx39-unknown
+		;;
+	tx39el)
+		basic_machine=mipstx39el-unknown
+		;;
+	toad1)
+		basic_machine=pdp10-xkl
+		os=-tops20
+		;;
+	tower | tower-32)
+		basic_machine=m68k-ncr
+		;;
+	tpf)
+		basic_machine=s390x-ibm
+		os=-tpf
+		;;
+	udi29k)
+		basic_machine=a29k-amd
+		os=-udi
+		;;
+	ultra3)
+		basic_machine=a29k-nyu
+		os=-sym1
+		;;
+	v810 | necv810)
+		basic_machine=v810-nec
+		os=-none
+		;;
+	vaxv)
+		basic_machine=vax-dec
+		os=-sysv
+		;;
+	vms)
+		basic_machine=vax-dec
+		os=-vms
+		;;
+	vpp*|vx|vx-*)
+		basic_machine=f301-fujitsu
+		;;
+	vxworks960)
+		basic_machine=i960-wrs
+		os=-vxworks
+		;;
+	vxworks68)
+		basic_machine=m68k-wrs
+		os=-vxworks
+		;;
+	vxworks29k)
+		basic_machine=a29k-wrs
+		os=-vxworks
+		;;
+	w65*)
+		basic_machine=w65-wdc
+		os=-none
+		;;
+	w89k-*)
+		basic_machine=hppa1.1-winbond
+		os=-proelf
+		;;
+	xbox)
+		basic_machine=i686-pc
+		os=-mingw32
+		;;
+	xps | xps100)
+		basic_machine=xps100-honeywell
+		;;
+	xscale-* | xscalee[bl]-*)
+		basic_machine=`echo $basic_machine | sed 's/^xscale/arm/'`
+		;;
+	ymp)
+		basic_machine=ymp-cray
+		os=-unicos
+		;;
+	z8k-*-coff)
+		basic_machine=z8k-unknown
+		os=-sim
+		;;
+	z80-*-coff)
+		basic_machine=z80-unknown
+		os=-sim
+		;;
+	none)
+		basic_machine=none-none
+		os=-none
+		;;
+
+# Here we handle the default manufacturer of certain CPU types.  It is in
+# some cases the only manufacturer, in others, it is the most popular.
+	w89k)
+		basic_machine=hppa1.1-winbond
+		;;
+	op50n)
+		basic_machine=hppa1.1-oki
+		;;
+	op60c)
+		basic_machine=hppa1.1-oki
+		;;
+	romp)
+		basic_machine=romp-ibm
+		;;
+	mmix)
+		basic_machine=mmix-knuth
+		;;
+	rs6000)
+		basic_machine=rs6000-ibm
+		;;
+	vax)
+		basic_machine=vax-dec
+		;;
+	pdp10)
+		# there are many clones, so DEC is not a safe bet
+		basic_machine=pdp10-unknown
+		;;
+	pdp11)
+		basic_machine=pdp11-dec
+		;;
+	we32k)
+		basic_machine=we32k-att
+		;;
+	sh[1234] | sh[24]a | sh[24]aeb | sh[34]eb | sh[1234]le | sh[23]ele)
+		basic_machine=sh-unknown
+		;;
+	sparc | sparcv8 | sparcv9 | sparcv9b | sparcv9v)
+		basic_machine=sparc-sun
+		;;
+	cydra)
+		basic_machine=cydra-cydrome
+		;;
+	orion)
+		basic_machine=orion-highlevel
+		;;
+	orion105)
+		basic_machine=clipper-highlevel
+		;;
+	mac | mpw | mac-mpw)
+		basic_machine=m68k-apple
+		;;
+	pmac | pmac-mpw)
+		basic_machine=powerpc-apple
+		;;
+	*-unknown)
+		# Make sure to match an already-canonicalized machine name.
+		;;
+	*)
+		echo Invalid configuration \`$1\': machine \`$basic_machine\' not recognized 1>&2
+		exit 1
+		;;
+esac
+
+# Here we canonicalize certain aliases for manufacturers.
+case $basic_machine in
+	*-digital*)
+		basic_machine=`echo $basic_machine | sed 's/digital.*/dec/'`
+		;;
+	*-commodore*)
+		basic_machine=`echo $basic_machine | sed 's/commodore.*/cbm/'`
+		;;
+	*)
+		;;
+esac
+
+# Decode manufacturer-specific aliases for certain operating systems.
+
+if [ x"$os" != x"" ]
+then
+case $os in
+	# First match some system type aliases
+	# that might get confused with valid system types.
+	# -solaris* is a basic system type, with this one exception.
+	-auroraux)
+		os=-auroraux
+		;;
+	-solaris1 | -solaris1.*)
+		os=`echo $os | sed -e 's|solaris1|sunos4|'`
+		;;
+	-solaris)
+		os=-solaris2
+		;;
+	-svr4*)
+		os=-sysv4
+		;;
+	-unixware*)
+		os=-sysv4.2uw
+		;;
+	-gnu/linux*)
+		os=`echo $os | sed -e 's|gnu/linux|linux-gnu|'`
+		;;
+	# First accept the basic system types.
+	# The portable systems comes first.
+	# Each alternative MUST END IN A *, to match a version number.
+	# -sysv* is not here because it comes later, after sysvr4.
+	-gnu* | -bsd* | -mach* | -minix* | -genix* | -ultrix* | -irix* \
+	      | -*vms* | -sco* | -esix* | -isc* | -aix* | -cnk* | -sunos | -sunos[34]*\
+	      | -hpux* | -unos* | -osf* | -luna* | -dgux* | -auroraux* | -solaris* \
+	      | -sym* | -kopensolaris* | -plan9* \
+	      | -amigaos* | -amigados* | -msdos* | -newsos* | -unicos* | -aof* \
+	      | -aos* | -aros* \
+	      | -nindy* | -vxsim* | -vxworks* | -ebmon* | -hms* | -mvs* \
+	      | -clix* | -riscos* | -uniplus* | -iris* | -rtu* | -xenix* \
+	      | -hiux* | -386bsd* | -knetbsd* | -mirbsd* | -netbsd* \
+	      | -bitrig* | -openbsd* | -solidbsd* \
+	      | -ekkobsd* | -kfreebsd* | -freebsd* | -riscix* | -lynxos* \
+	      | -bosx* | -nextstep* | -cxux* | -aout* | -elf* | -oabi* \
+	      | -ptx* | -coff* | -ecoff* | -winnt* | -domain* | -vsta* \
+	      | -udi* | -eabi* | -lites* | -ieee* | -go32* | -aux* \
+	      | -chorusos* | -chorusrdb* | -cegcc* \
+	      | -cygwin* | -msys* | -pe* | -psos* | -moss* | -proelf* | -rtems* \
+	      | -mingw32* | -mingw64* | -linux-gnu* | -linux-android* \
+	      | -linux-newlib* | -linux-musl* | -linux-uclibc* \
+	      | -uxpv* | -beos* | -mpeix* | -udk* \
+	      | -interix* | -uwin* | -mks* | -rhapsody* | -darwin* | -opened* \
+	      | -openstep* | -oskit* | -conix* | -pw32* | -nonstopux* \
+	      | -storm-chaos* | -tops10* | -tenex* | -tops20* | -its* \
+	      | -os2* | -vos* | -palmos* | -uclinux* | -nucleus* \
+	      | -morphos* | -superux* | -rtmk* | -rtmk-nova* | -windiss* \
+	      | -powermax* | -dnix* | -nx6 | -nx7 | -sei* | -dragonfly* \
+	      | -skyos* | -haiku* | -rdos* | -toppers* | -drops* | -es*)
+	# Remember, each alternative MUST END IN *, to match a version number.
+		;;
+	-qnx*)
+		case $basic_machine in
+		    x86-* | i*86-*)
+			;;
+		    *)
+			os=-nto$os
+			;;
+		esac
+		;;
+	-nto-qnx*)
+		;;
+	-nto*)
+		os=`echo $os | sed -e 's|nto|nto-qnx|'`
+		;;
+	-sim | -es1800* | -hms* | -xray | -os68k* | -none* | -v88r* \
+	      | -windows* | -osx | -abug | -netware* | -os9* | -beos* | -haiku* \
+	      | -macos* | -mpw* | -magic* | -mmixware* | -mon960* | -lnews*)
+		;;
+	-mac*)
+		os=`echo $os | sed -e 's|mac|macos|'`
+		;;
+	-linux-dietlibc)
+		os=-linux-dietlibc
+		;;
+	-linux*)
+		os=`echo $os | sed -e 's|linux|linux-gnu|'`
+		;;
+	-sunos5*)
+		os=`echo $os | sed -e 's|sunos5|solaris2|'`
+		;;
+	-sunos6*)
+		os=`echo $os | sed -e 's|sunos6|solaris3|'`
+		;;
+	-opened*)
+		os=-openedition
+		;;
+	-os400*)
+		os=-os400
+		;;
+	-wince*)
+		os=-wince
+		;;
+	-osfrose*)
+		os=-osfrose
+		;;
+	-osf*)
+		os=-osf
+		;;
+	-utek*)
+		os=-bsd
+		;;
+	-dynix*)
+		os=-bsd
+		;;
+	-acis*)
+		os=-aos
+		;;
+	-atheos*)
+		os=-atheos
+		;;
+	-syllable*)
+		os=-syllable
+		;;
+	-386bsd)
+		os=-bsd
+		;;
+	-ctix* | -uts*)
+		os=-sysv
+		;;
+	-nova*)
+		os=-rtmk-nova
+		;;
+	-ns2 )
+		os=-nextstep2
+		;;
+	-nsk*)
+		os=-nsk
+		;;
+	# Preserve the version number of sinix5.
+	-sinix5.*)
+		os=`echo $os | sed -e 's|sinix|sysv|'`
+		;;
+	-sinix*)
+		os=-sysv4
+		;;
+	-tpf*)
+		os=-tpf
+		;;
+	-triton*)
+		os=-sysv3
+		;;
+	-oss*)
+		os=-sysv3
+		;;
+	-svr4)
+		os=-sysv4
+		;;
+	-svr3)
+		os=-sysv3
+		;;
+	-sysvr4)
+		os=-sysv4
+		;;
+	# This must come after -sysvr4.
+	-sysv*)
+		;;
+	-ose*)
+		os=-ose
+		;;
+	-es1800*)
+		os=-ose
+		;;
+	-xenix)
+		os=-xenix
+		;;
+	-*mint | -mint[0-9]* | -*MiNT | -MiNT[0-9]*)
+		os=-mint
+		;;
+	-aros*)
+		os=-aros
+		;;
+	-zvmoe)
+		os=-zvmoe
+		;;
+	-dicos*)
+		os=-dicos
+		;;
+	-nacl*)
+		;;
+	-none)
+		;;
+	*)
+		# Get rid of the `-' at the beginning of $os.
+		os=`echo $os | sed 's/[^-]*-//'`
+		echo Invalid configuration \`$1\': system \`$os\' not recognized 1>&2
+		exit 1
+		;;
+esac
+else
+
+# Here we handle the default operating systems that come with various machines.
+# The value should be what the vendor currently ships out the door with their
+# machine or put another way, the most popular os provided with the machine.
+
+# Note that if you're going to try to match "-MANUFACTURER" here (say,
+# "-sun"), then you have to tell the case statement up towards the top
+# that MANUFACTURER isn't an operating system.  Otherwise, code above
+# will signal an error saying that MANUFACTURER isn't an operating
+# system, and we'll never get to this point.
+
+case $basic_machine in
+	score-*)
+		os=-elf
+		;;
+	spu-*)
+		os=-elf
+		;;
+	*-acorn)
+		os=-riscix1.2
+		;;
+	arm*-rebel)
+		os=-linux
+		;;
+	arm*-semi)
+		os=-aout
+		;;
+	c4x-* | tic4x-*)
+		os=-coff
+		;;
+	c8051-*)
+		os=-elf
+		;;
+	hexagon-*)
+		os=-elf
+		;;
+	tic54x-*)
+		os=-coff
+		;;
+	tic55x-*)
+		os=-coff
+		;;
+	tic6x-*)
+		os=-coff
+		;;
+	# This must come before the *-dec entry.
+	pdp10-*)
+		os=-tops20
+		;;
+	pdp11-*)
+		os=-none
+		;;
+	*-dec | vax-*)
+		os=-ultrix4.2
+		;;
+	m68*-apollo)
+		os=-domain
+		;;
+	i386-sun)
+		os=-sunos4.0.2
+		;;
+	m68000-sun)
+		os=-sunos3
+		;;
+	m68*-cisco)
+		os=-aout
+		;;
+	mep-*)
+		os=-elf
+		;;
+	mips*-cisco)
+		os=-elf
+		;;
+	mips*-*)
+		os=-elf
+		;;
+	or1k-*)
+		os=-elf
+		;;
+	or32-*)
+		os=-coff
+		;;
+	*-tti)	# must be before sparc entry or we get the wrong os.
+		os=-sysv3
+		;;
+	sparc-* | *-sun)
+		os=-sunos4.1.1
+		;;
+	*-be)
+		os=-beos
+		;;
+	*-haiku)
+		os=-haiku
+		;;
+	*-ibm)
+		os=-aix
+		;;
+	*-knuth)
+		os=-mmixware
+		;;
+	*-wec)
+		os=-proelf
+		;;
+	*-winbond)
+		os=-proelf
+		;;
+	*-oki)
+		os=-proelf
+		;;
+	*-hp)
+		os=-hpux
+		;;
+	*-hitachi)
+		os=-hiux
+		;;
+	i860-* | *-att | *-ncr | *-altos | *-motorola | *-convergent)
+		os=-sysv
+		;;
+	*-cbm)
+		os=-amigaos
+		;;
+	*-dg)
+		os=-dgux
+		;;
+	*-dolphin)
+		os=-sysv3
+		;;
+	m68k-ccur)
+		os=-rtu
+		;;
+	m88k-omron*)
+		os=-luna
+		;;
+	*-next )
+		os=-nextstep
+		;;
+	*-sequent)
+		os=-ptx
+		;;
+	*-crds)
+		os=-unos
+		;;
+	*-ns)
+		os=-genix
+		;;
+	i370-*)
+		os=-mvs
+		;;
+	*-next)
+		os=-nextstep3
+		;;
+	*-gould)
+		os=-sysv
+		;;
+	*-highlevel)
+		os=-bsd
+		;;
+	*-encore)
+		os=-bsd
+		;;
+	*-sgi)
+		os=-irix
+		;;
+	*-siemens)
+		os=-sysv4
+		;;
+	*-masscomp)
+		os=-rtu
+		;;
+	f30[01]-fujitsu | f700-fujitsu)
+		os=-uxpv
+		;;
+	*-rom68k)
+		os=-coff
+		;;
+	*-*bug)
+		os=-coff
+		;;
+	*-apple)
+		os=-macos
+		;;
+	*-atari*)
+		os=-mint
+		;;
+	*)
+		os=-none
+		;;
+esac
+fi
+
+# Here we handle the case where we know the os, and the CPU type, but not the
+# manufacturer.  We pick the logical manufacturer.
+vendor=unknown
+case $basic_machine in
+	*-unknown)
+		case $os in
+			-riscix*)
+				vendor=acorn
+				;;
+			-sunos*)
+				vendor=sun
+				;;
+			-cnk*|-aix*)
+				vendor=ibm
+				;;
+			-beos*)
+				vendor=be
+				;;
+			-hpux*)
+				vendor=hp
+				;;
+			-mpeix*)
+				vendor=hp
+				;;
+			-hiux*)
+				vendor=hitachi
+				;;
+			-unos*)
+				vendor=crds
+				;;
+			-dgux*)
+				vendor=dg
+				;;
+			-luna*)
+				vendor=omron
+				;;
+			-genix*)
+				vendor=ns
+				;;
+			-mvs* | -opened*)
+				vendor=ibm
+				;;
+			-os400*)
+				vendor=ibm
+				;;
+			-ptx*)
+				vendor=sequent
+				;;
+			-tpf*)
+				vendor=ibm
+				;;
+			-vxsim* | -vxworks* | -windiss*)
+				vendor=wrs
+				;;
+			-aux*)
+				vendor=apple
+				;;
+			-hms*)
+				vendor=hitachi
+				;;
+			-mpw* | -macos*)
+				vendor=apple
+				;;
+			-*mint | -mint[0-9]* | -*MiNT | -MiNT[0-9]*)
+				vendor=atari
+				;;
+			-vos*)
+				vendor=stratus
+				;;
+		esac
+		basic_machine=`echo $basic_machine | sed "s/unknown/$vendor/"`
+		;;
+esac
+
+echo $basic_machine$os
+exit
+
+# Local variables:
+# eval: (add-hook 'write-file-hooks 'time-stamp)
+# time-stamp-start: "timestamp='"
+# time-stamp-format: "%:y-%02m-%02d"
+# time-stamp-end: "'"
+# End:
diff --git a/libraries/base/configure.ac b/libraries/base/configure.ac
new file mode 100644
index 000000000000..06e8a5d1ed66
--- /dev/null
+++ b/libraries/base/configure.ac
@@ -0,0 +1,213 @@
+AC_INIT([Haskell base package], [1.0], [libraries@haskell.org], [base])
+
+# Safety check: Ensure that we are in the correct source directory.
+AC_CONFIG_SRCDIR([include/HsBase.h])
+
+AC_CONFIG_HEADERS([include/HsBaseConfig.h include/EventConfig.h])
+
+AC_CANONICAL_BUILD
+AC_CANONICAL_HOST
+AC_CANONICAL_TARGET
+
+AC_ARG_WITH([cc],
+            [C compiler],
+            [CC=$withval])
+AC_PROG_CC()
+
+AC_MSG_CHECKING(for WINDOWS platform)
+case $host in
+    *mingw32*|*mingw64*|*cygwin*)
+        WINDOWS=YES;;
+    *)
+        WINDOWS=NO;;
+esac
+AC_MSG_RESULT($WINDOWS)
+
+# do we have long longs?
+AC_CHECK_TYPES([long long])
+
+dnl ** check for full ANSI header (.h) files
+AC_HEADER_STDC
+
+# check for specific header (.h) files that we are interested in
+AC_CHECK_HEADERS([ctype.h errno.h fcntl.h inttypes.h limits.h signal.h sys/resource.h sys/select.h sys/stat.h sys/syscall.h sys/time.h sys/timeb.h sys/timers.h sys/times.h sys/types.h sys/utsname.h sys/wait.h termios.h time.h unistd.h utime.h windows.h winsock.h langinfo.h poll.h sys/epoll.h sys/event.h sys/eventfd.h])
+
+# Enable large file support. Do this before testing the types ino_t, off_t, and
+# rlim_t, because it will affect the result of that test.
+AC_SYS_LARGEFILE
+
+dnl ** check for wide-char classifications
+dnl FreeBSD has an emtpy wctype.h, so test one of the affected
+dnl functions if it's really there.
+AC_CHECK_HEADERS([wctype.h], [AC_CHECK_FUNCS(iswspace)])
+
+AC_CHECK_FUNCS([lstat])
+AC_CHECK_LIB([rt], [clock_gettime])
+AC_CHECK_FUNCS([clock_gettime])
+AC_CHECK_FUNCS([getclock getrusage times])
+AC_CHECK_FUNCS([_chsize ftruncate])
+
+AC_CHECK_FUNCS([epoll_ctl eventfd kevent kevent64 kqueue poll])
+
+# event-related fun
+
+if test "$ac_cv_header_sys_epoll_h" = yes -a "$ac_cv_func_epoll_ctl" = yes; then
+  AC_DEFINE([HAVE_EPOLL], [1], [Define if you have epoll support.])
+fi
+
+if test "$ac_cv_header_sys_event_h" = yes -a "$ac_cv_func_kqueue" = yes; then
+  AC_DEFINE([HAVE_KQUEUE], [1], [Define if you have kqueue support.])
+
+  AC_CHECK_SIZEOF([kev.filter], [], [#include <sys/event.h>
+struct kevent kev;])
+
+  AC_CHECK_SIZEOF([kev.flags], [], [#include <sys/event.h>
+struct kevent kev;])
+fi
+
+if test "$ac_cv_header_poll_h" = yes -a "$ac_cv_func_poll" = yes; then
+  AC_DEFINE([HAVE_POLL], [1], [Define if you have poll support.])
+fi
+
+# unsetenv
+AC_CHECK_FUNCS([unsetenv])
+
+###  POSIX.1003.1 unsetenv returns 0 or -1 (EINVAL), but older implementations
+###  in common use return void.
+AC_CACHE_CHECK([return type of unsetenv], fptools_cv_func_unsetenv_return_type,
+  [AC_EGREP_HEADER(changequote(<, >)<void[      ]+unsetenv>changequote([, ]),
+                   stdlib.h,
+                   [fptools_cv_func_unsetenv_return_type=void],
+                   [fptools_cv_func_unsetenv_return_type=int])])
+case "$fptools_cv_func_unsetenv_return_type" in
+  "void" )
+    AC_DEFINE([UNSETENV_RETURNS_VOID], [1], [Define if stdlib.h declares unsetenv to return void.])
+  ;;
+esac
+
+dnl--------------------------------------------------------------------
+dnl * Deal with arguments telling us iconv is somewhere odd
+dnl--------------------------------------------------------------------
+
+AC_ARG_WITH([iconv-includes],
+  [AC_HELP_STRING([--with-iconv-includes],
+    [directory containing iconv.h])],
+    [ICONV_INCLUDE_DIRS=$withval; CPPFLAGS="-I$withval"],
+    [ICONV_INCLUDE_DIRS=])
+
+AC_ARG_WITH([iconv-libraries],
+  [AC_HELP_STRING([--with-iconv-libraries],
+    [directory containing iconv library])],
+    [ICONV_LIB_DIRS=$withval; LDFLAGS="-L$withval"],
+    [ICONV_LIB_DIRS=])
+
+AC_SUBST(ICONV_INCLUDE_DIRS)
+AC_SUBST(ICONV_LIB_DIRS)
+
+# map standard C types and ISO types to Haskell types
+FPTOOLS_CHECK_HTYPE(char)
+FPTOOLS_CHECK_HTYPE(signed char)
+FPTOOLS_CHECK_HTYPE(unsigned char)
+FPTOOLS_CHECK_HTYPE(short)
+FPTOOLS_CHECK_HTYPE(unsigned short)
+FPTOOLS_CHECK_HTYPE(int)
+FPTOOLS_CHECK_HTYPE(unsigned int)
+FPTOOLS_CHECK_HTYPE(long)
+FPTOOLS_CHECK_HTYPE(unsigned long)
+if test "$ac_cv_type_long_long" = yes; then
+FPTOOLS_CHECK_HTYPE(long long)
+FPTOOLS_CHECK_HTYPE(unsigned long long)
+fi
+FPTOOLS_CHECK_HTYPE(float)
+FPTOOLS_CHECK_HTYPE(double)
+FPTOOLS_CHECK_HTYPE(ptrdiff_t)
+FPTOOLS_CHECK_HTYPE(size_t)
+FPTOOLS_CHECK_HTYPE(wchar_t)
+FPTOOLS_CHECK_HTYPE(sig_atomic_t)
+FPTOOLS_CHECK_HTYPE(clock_t)
+FPTOOLS_CHECK_HTYPE(time_t)
+FPTOOLS_CHECK_HTYPE(useconds_t)
+FPTOOLS_CHECK_HTYPE_ELSE(suseconds_t,
+                         [if test "$WINDOWS" = "YES"
+                          then
+                              AC_CV_NAME=Int32
+                              AC_CV_NAME_supported=yes
+                          else
+                              AC_MSG_ERROR([type not found])
+                          fi])
+FPTOOLS_CHECK_HTYPE(dev_t)
+FPTOOLS_CHECK_HTYPE(ino_t)
+FPTOOLS_CHECK_HTYPE(mode_t)
+FPTOOLS_CHECK_HTYPE(off_t)
+FPTOOLS_CHECK_HTYPE(pid_t)
+FPTOOLS_CHECK_HTYPE(gid_t)
+FPTOOLS_CHECK_HTYPE(uid_t)
+FPTOOLS_CHECK_HTYPE(cc_t)
+FPTOOLS_CHECK_HTYPE(speed_t)
+FPTOOLS_CHECK_HTYPE(tcflag_t)
+FPTOOLS_CHECK_HTYPE(nlink_t)
+FPTOOLS_CHECK_HTYPE(ssize_t)
+FPTOOLS_CHECK_HTYPE(rlim_t)
+
+FPTOOLS_CHECK_HTYPE(intptr_t)
+FPTOOLS_CHECK_HTYPE(uintptr_t)
+FPTOOLS_CHECK_HTYPE(intmax_t)
+FPTOOLS_CHECK_HTYPE(uintmax_t)
+
+# test errno values
+FP_CHECK_CONSTS([E2BIG EACCES EADDRINUSE EADDRNOTAVAIL EADV EAFNOSUPPORT EAGAIN EALREADY EBADF EBADMSG EBADRPC EBUSY ECHILD ECOMM ECONNABORTED ECONNREFUSED ECONNRESET EDEADLK EDESTADDRREQ EDIRTY EDOM EDQUOT EEXIST EFAULT EFBIG EFTYPE EHOSTDOWN EHOSTUNREACH EIDRM EILSEQ EINPROGRESS EINTR EINVAL EIO EISCONN EISDIR ELOOP EMFILE EMLINK EMSGSIZE EMULTIHOP ENAMETOOLONG ENETDOWN ENETRESET ENETUNREACH ENFILE ENOBUFS ENODATA ENODEV ENOENT ENOEXEC ENOLCK ENOLINK ENOMEM ENOMSG ENONET ENOPROTOOPT ENOSPC ENOSR ENOSTR ENOSYS ENOTBLK ENOTCONN ENOTDIR ENOTEMPTY ENOTSOCK ENOTTY ENXIO EOPNOTSUPP EPERM EPFNOSUPPORT EPIPE EPROCLIM EPROCUNAVAIL EPROGMISMATCH EPROGUNAVAIL EPROTO EPROTONOSUPPORT EPROTOTYPE ERANGE EREMCHG EREMOTE EROFS ERPCMISMATCH ERREMOTE ESHUTDOWN ESOCKTNOSUPPORT ESPIPE ESRCH ESRMNT ESTALE ETIME ETIMEDOUT ETOOMANYREFS ETXTBSY EUSERS EWOULDBLOCK EXDEV ENOCIGAR ENOTSUP], [#include <stdio.h>
+#include <errno.h>])
+
+# we need SIGINT in TopHandler.lhs
+FP_CHECK_CONSTS([SIGINT], [
+#if HAVE_SIGNAL_H
+#include <signal.h>
+#endif])
+
+dnl ** can we open files in binary mode?
+FP_CHECK_CONST([O_BINARY], [#include <fcntl.h>], [0])
+
+# We don't use iconv or libcharset on Windows, but if configure finds
+# them then it can cause problems. So we don't even try looking if
+# we are on Windows.
+# See http://www.haskell.org/pipermail/cvs-ghc/2011-September/065980.html
+if test "$WINDOWS" = "NO"
+then
+
+# We can't just use AC_SEARCH_LIBS for this, as on OpenBSD the iconv.h
+# header needs to be included as iconv_open is #define'd to something
+# else. We therefore use our own FP_SEARCH_LIBS_PROTO, which allows us
+# to give prototype text.
+FP_SEARCH_LIBS_PROTO(iconv,
+                     [
+#include <stddef.h>
+#include <iconv.h>
+                      ],
+                     [iconv_t cd;
+                      cd = iconv_open("", "");
+                      iconv(cd,NULL,NULL,NULL,NULL);
+                      iconv_close(cd);],
+                     iconv,
+                     [EXTRA_LIBS="$EXTRA_LIBS $ac_lib"],
+                     [AC_MSG_ERROR([iconv is required on non-Windows platforms])])
+
+# If possible, we use libcharset instead of nl_langinfo(CODESET) to
+# determine the current locale's character encoding.
+FP_SEARCH_LIBS_PROTO(
+    [locale_charset],
+    [#include <libcharset.h>],
+    [const char* charset = locale_charset();],
+    [charset],
+    [AC_DEFINE([HAVE_LIBCHARSET], [1], [Define to 1 if you have libcharset.])
+     EXTRA_LIBS="$EXTRA_LIBS $ac_lib"])
+
+fi
+
+# Hack - md5.h needs HsFFI.h.  Is there a better way to do this?
+CFLAGS="-I../../includes $CFLAGS"
+AC_CHECK_SIZEOF([struct MD5Context], ,[#include "include/md5.h"])
+
+AC_SUBST(EXTRA_LIBS)
+AC_CONFIG_FILES([base.buildinfo])
+
+AC_OUTPUT
diff --git a/libraries/base/include/CTypes.h b/libraries/base/include/CTypes.h
new file mode 100644
index 000000000000..ec1813152f67
--- /dev/null
+++ b/libraries/base/include/CTypes.h
@@ -0,0 +1,54 @@
+{- --------------------------------------------------------------------------
+// Dirty CPP hackery for CTypes/CTypesISO
+//
+// (c) The FFI task force, 2000
+// --------------------------------------------------------------------------
+-}
+
+#ifndef CTYPES__H
+#define CTYPES__H
+
+{-
+// As long as there is no automatic derivation of classes for newtypes we resort
+// to extremely dirty cpp-hackery.   :-P   Some care has to be taken when the
+// macros below are modified, otherwise the layout rule will bite you.
+-}
+
+--  // GHC can derive any class for a newtype, so we make use of that here...
+
+#define ARITHMETIC_CLASSES  Eq,Ord,Num,Enum,Storable,Real,Typeable
+#define INTEGRAL_CLASSES Bounded,Integral,Bits,FiniteBits
+#define FLOATING_CLASSES Fractional,Floating,RealFrac,RealFloat
+
+#define ARITHMETIC_TYPE(T,B) \
+newtype T = T B deriving (ARITHMETIC_CLASSES); \
+INSTANCE_READ(T,B); \
+INSTANCE_SHOW(T,B);
+
+#define INTEGRAL_TYPE(T,B) \
+newtype T = T B deriving (ARITHMETIC_CLASSES, INTEGRAL_CLASSES); \
+INSTANCE_READ(T,B); \
+INSTANCE_SHOW(T,B);
+
+#define INTEGRAL_TYPE_WITH_CTYPE(T,THE_CTYPE,B) \
+newtype {-# CTYPE "THE_CTYPE" #-} T = T B deriving (ARITHMETIC_CLASSES, INTEGRAL_CLASSES); \
+INSTANCE_READ(T,B); \
+INSTANCE_SHOW(T,B);
+
+#define FLOATING_TYPE(T,B) \
+newtype T = T B deriving (ARITHMETIC_CLASSES, FLOATING_CLASSES); \
+INSTANCE_READ(T,B); \
+INSTANCE_SHOW(T,B);
+
+#define INSTANCE_READ(T,B) \
+instance Read T where { \
+   readsPrec            = unsafeCoerce# (readsPrec :: Int -> ReadS B); \
+   readList             = unsafeCoerce# (readList  :: ReadS [B]); }
+
+#define INSTANCE_SHOW(T,B) \
+instance Show T where { \
+   showsPrec            = unsafeCoerce# (showsPrec :: Int -> B -> ShowS); \
+   show                 = unsafeCoerce# (show :: B -> String); \
+   showList             = unsafeCoerce# (showList :: [B] -> ShowS); }
+
+#endif
diff --git a/libraries/base/include/EventConfig.h.in b/libraries/base/include/EventConfig.h.in
new file mode 100644
index 000000000000..061b6aced368
--- /dev/null
+++ b/libraries/base/include/EventConfig.h.in
@@ -0,0 +1,91 @@
+/* include/EventConfig.h.in.  Generated from configure.ac by autoheader.  */
+
+/* Define if you have epoll support. */
+#undef HAVE_EPOLL
+
+/* Define to 1 if you have the `epoll_create1' function. */
+#undef HAVE_EPOLL_CREATE1
+
+/* Define to 1 if you have the `epoll_ctl' function. */
+#undef HAVE_EPOLL_CTL
+
+/* Define to 1 if you have the `eventfd' function. */
+#undef HAVE_EVENTFD
+
+/* Define to 1 if you have the <inttypes.h> header file. */
+#undef HAVE_INTTYPES_H
+
+/* Define to 1 if you have the `kevent' function. */
+#undef HAVE_KEVENT
+
+/* Define to 1 if you have the `kevent64' function. */
+#undef HAVE_KEVENT64
+
+/* Define if you have kqueue support. */
+#undef HAVE_KQUEUE
+
+/* Define to 1 if you have the <memory.h> header file. */
+#undef HAVE_MEMORY_H
+
+/* Define if you have poll support. */
+#undef HAVE_POLL
+
+/* Define to 1 if you have the <poll.h> header file. */
+#undef HAVE_POLL_H
+
+/* Define to 1 if you have the <signal.h> header file. */
+#undef HAVE_SIGNAL_H
+
+/* Define to 1 if you have the <stdint.h> header file. */
+#undef HAVE_STDINT_H
+
+/* Define to 1 if you have the <stdlib.h> header file. */
+#undef HAVE_STDLIB_H
+
+/* Define to 1 if you have the <strings.h> header file. */
+#undef HAVE_STRINGS_H
+
+/* Define to 1 if you have the <string.h> header file. */
+#undef HAVE_STRING_H
+
+/* Define to 1 if you have the <sys/epoll.h> header file. */
+#undef HAVE_SYS_EPOLL_H
+
+/* Define to 1 if you have the <sys/eventfd.h> header file. */
+#undef HAVE_SYS_EVENTFD_H
+
+/* Define to 1 if you have the <sys/event.h> header file. */
+#undef HAVE_SYS_EVENT_H
+
+/* Define to 1 if you have the <sys/stat.h> header file. */
+#undef HAVE_SYS_STAT_H
+
+/* Define to 1 if you have the <sys/types.h> header file. */
+#undef HAVE_SYS_TYPES_H
+
+/* Define to 1 if you have the <unistd.h> header file. */
+#undef HAVE_UNISTD_H
+
+/* Define to the address where bug reports for this package should be sent. */
+#undef PACKAGE_BUGREPORT
+
+/* Define to the full name of this package. */
+#undef PACKAGE_NAME
+
+/* Define to the full name and version of this package. */
+#undef PACKAGE_STRING
+
+/* Define to the one symbol short name of this package. */
+#undef PACKAGE_TARNAME
+
+/* Define to the version of this package. */
+#undef PACKAGE_VERSION
+
+/* Define to 1 if you have the ANSI C header files. */
+#undef STDC_HEADERS
+
+/* The size of `kev.filter', as computed by sizeof. */
+#undef SIZEOF_KEV_FILTER
+
+/* The size of `kev.flags', as computed by sizeof. */
+#undef SIZEOF_KEV_FLAGS
diff --git a/libraries/base/include/HsBase.h b/libraries/base/include/HsBase.h
new file mode 100644
index 000000000000..46d0f0c1027b
--- /dev/null
+++ b/libraries/base/include/HsBase.h
@@ -0,0 +1,559 @@
+/* -----------------------------------------------------------------------------
+ *
+ * (c) The University of Glasgow 2001-2004
+ *
+ * Definitions for package `base' which are visible in Haskell land.
+ *
+ * ---------------------------------------------------------------------------*/
+
+#ifndef __HSBASE_H__
+#define __HSBASE_H__
+
+#include "HsBaseConfig.h"
+
+/* ultra-evil... */
+#undef PACKAGE_BUGREPORT
+#undef PACKAGE_NAME
+#undef PACKAGE_STRING
+#undef PACKAGE_TARNAME
+#undef PACKAGE_VERSION
+
+/* Needed to get the macro version of errno on some OSs (eg. Solaris).
+   We must do this, because these libs are only compiled once, but
+   must work in both single-threaded and multi-threaded programs. */
+#define _REENTRANT 1
+
+#include "HsFFI.h"
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <math.h>
+
+#if HAVE_SYS_TYPES_H
+#include <sys/types.h>
+#endif
+#if HAVE_UNISTD_H
+#include <unistd.h>
+#endif
+#if HAVE_SYS_STAT_H
+#include <sys/stat.h>
+#endif
+#if HAVE_FCNTL_H
+# include <fcntl.h>
+#endif
+#if HAVE_TERMIOS_H
+#include <termios.h>
+#endif
+#if HAVE_SIGNAL_H
+#include <signal.h>
+/* Ultra-ugly: OpenBSD uses broken macros for sigemptyset and sigfillset (missing casts) */
+#if __OpenBSD__
+#undef sigemptyset
+#undef sigfillset
+#endif
+#endif
+#if HAVE_ERRNO_H
+#include <errno.h>
+#endif
+#if HAVE_STRING_H
+#include <string.h>
+#endif
+#if HAVE_UTIME_H
+#include <utime.h>
+#endif
+#if HAVE_SYS_UTSNAME_H
+#include <sys/utsname.h>
+#endif
+#if HAVE_GETTIMEOFDAY
+#  if HAVE_SYS_TIME_H
+#   include <sys/time.h>
+#  endif
+#elif HAVE_GETCLOCK
+# if HAVE_SYS_TIMERS_H
+#  define POSIX_4D9 1
+#  include <sys/timers.h>
+# endif
+#endif
+#if HAVE_TIME_H
+#include <time.h>
+#endif
+#if HAVE_SYS_TIMEB_H && !defined(__FreeBSD__)
+#include <sys/timeb.h>
+#endif
+#if HAVE_WINDOWS_H
+#include <windows.h>
+#endif
+#if HAVE_SYS_TIMES_H
+#include <sys/times.h>
+#endif
+#if HAVE_WINSOCK_H && defined(__MINGW32__)
+#include <winsock.h>
+#endif
+#if HAVE_LIMITS_H
+#include <limits.h>
+#endif
+#if HAVE_WCTYPE_H
+#include <wctype.h>
+#endif
+#if HAVE_INTTYPES_H
+# include <inttypes.h>
+#elif HAVE_STDINT_H
+# include <stdint.h>
+#endif
+#if HAVE_CLOCK_GETTIME
+# ifdef _POSIX_MONOTONIC_CLOCK
+#  define CLOCK_ID CLOCK_MONOTONIC
+# else
+#  define CLOCK_ID CLOCK_REALTIME
+# endif
+#elif defined(darwin_HOST_OS)
+# include <mach/mach.h>
+# include <mach/mach_time.h>
+#endif
+
+#if !defined(__MINGW32__) && !defined(irix_HOST_OS)
+# if HAVE_SYS_RESOURCE_H
+#  include <sys/resource.h>
+# endif
+#endif
+
+#if !HAVE_GETRUSAGE && HAVE_SYS_SYSCALL_H
+# include <sys/syscall.h>
+# if defined(SYS_GETRUSAGE)	/* hpux_HOST_OS */
+#  define getrusage(a, b)  syscall(SYS_GETRUSAGE, a, b)
+#  define HAVE_GETRUSAGE 1
+# endif
+#endif
+
+/* For System */
+#if HAVE_SYS_WAIT_H
+#include <sys/wait.h>
+#endif
+#if HAVE_VFORK_H
+#include <vfork.h>
+#endif
+#include "WCsubst.h"
+
+#if defined(__MINGW32__)
+/* in Win32Utils.c */
+extern void maperrno (void);
+extern int maperrno_func(DWORD dwErrorCode);
+extern HsWord64 getMonotonicUSec(void);
+#endif
+
+#if defined(__MINGW32__)
+#include <io.h>
+#include <fcntl.h>
+#include <shlobj.h>
+#include <share.h>
+#endif
+
+#if HAVE_SYS_SELECT_H
+#include <sys/select.h>
+#endif
+
+/* in inputReady.c */
+extern int fdReady(int fd, int write, int msecs, int isSock);
+
+/* -----------------------------------------------------------------------------
+   INLINE functions.
+
+   These functions are given as inlines here for when compiling via C,
+   but we also generate static versions into the cbits library for
+   when compiling to native code.
+   -------------------------------------------------------------------------- */
+
+#ifndef INLINE
+# if defined(_MSC_VER)
+#  define INLINE extern __inline
+# else
+#  define INLINE static inline
+# endif
+#endif
+
+INLINE int __hscore_get_errno(void) { return errno; }
+INLINE void __hscore_set_errno(int e) { errno = e; }
+
+INLINE HsInt
+__hscore_bufsiz(void)
+{
+  return BUFSIZ;
+}
+
+INLINE int
+__hscore_o_binary(void)
+{
+#if defined(_MSC_VER)
+  return O_BINARY;
+#else
+  return CONST_O_BINARY;
+#endif
+}
+
+INLINE int
+__hscore_o_rdonly(void)
+{
+#ifdef O_RDONLY
+  return O_RDONLY;
+#else
+  return 0;
+#endif
+}
+
+INLINE int
+__hscore_o_wronly( void )
+{
+#ifdef O_WRONLY
+  return O_WRONLY;
+#else
+  return 0;
+#endif
+}
+
+INLINE int
+__hscore_o_rdwr( void )
+{
+#ifdef O_RDWR
+  return O_RDWR;
+#else
+  return 0;
+#endif
+}
+
+INLINE int
+__hscore_o_append( void )
+{
+#ifdef O_APPEND
+  return O_APPEND;
+#else
+  return 0;
+#endif
+}
+
+INLINE int
+__hscore_o_creat( void )
+{
+#ifdef O_CREAT
+  return O_CREAT;
+#else
+  return 0;
+#endif
+}
+
+INLINE int
+__hscore_o_excl( void )
+{
+#ifdef O_EXCL
+  return O_EXCL;
+#else
+  return 0;
+#endif
+}
+
+INLINE int
+__hscore_o_trunc( void )
+{
+#ifdef O_TRUNC
+  return O_TRUNC;
+#else
+  return 0;
+#endif
+}
+
+INLINE int
+__hscore_o_noctty( void )
+{
+#ifdef O_NOCTTY
+  return O_NOCTTY;
+#else
+  return 0;
+#endif
+}
+
+INLINE int
+__hscore_o_nonblock( void )
+{
+#ifdef O_NONBLOCK
+  return O_NONBLOCK;
+#else
+  return 0;
+#endif
+}
+
+INLINE int
+__hscore_ftruncate( int fd, off_t where )
+{
+#if defined(HAVE_FTRUNCATE)
+  return ftruncate(fd,where);
+#elif defined(HAVE__CHSIZE)
+  return _chsize(fd,where);
+#else
+// ToDo: we should use _chsize_s() on Windows which allows a 64-bit
+// offset, but it doesn't seem to be available from mingw at this time 
+// --SDM (01/2008)
+#error at least ftruncate or _chsize functions are required to build
+#endif
+}
+
+INLINE int
+__hscore_setmode( int fd, HsBool toBin )
+{
+#if defined(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32)
+  return setmode(fd,(toBin == HS_BOOL_TRUE) ? _O_BINARY : _O_TEXT);
+#else
+  return 0;
+#endif
+}
+
+#if defined(__MINGW32__)
+// We want the versions of stat/fstat/lseek that use 64-bit offsets,
+// and you have to ask for those explicitly.  Unfortunately there
+// doesn't seem to be a 64-bit version of truncate/ftruncate, so while
+// hFileSize and hSeek will work with large files, hSetFileSize will not.
+typedef struct _stati64 struct_stat;
+typedef off64_t stsize_t;
+#else
+typedef struct stat struct_stat;
+typedef off_t stsize_t;
+#endif
+
+INLINE HsInt
+__hscore_sizeof_stat( void )
+{
+  return sizeof(struct_stat);
+}
+
+INLINE time_t __hscore_st_mtime ( struct_stat* st ) { return st->st_mtime; }
+INLINE stsize_t __hscore_st_size  ( struct_stat* st ) { return st->st_size; }
+#if !defined(_MSC_VER)
+INLINE mode_t __hscore_st_mode  ( struct_stat* st ) { return st->st_mode; }
+INLINE dev_t  __hscore_st_dev  ( struct_stat* st ) { return st->st_dev; }
+INLINE ino_t  __hscore_st_ino  ( struct_stat* st ) { return st->st_ino; }
+#endif
+
+#if defined(__MINGW32__)
+INLINE int __hscore_stat(wchar_t *file, struct_stat *buf) {
+	return _wstati64(file,buf);
+}
+
+INLINE int __hscore_fstat(int fd, struct_stat *buf) {
+	return _fstati64(fd,buf);
+}
+INLINE int __hscore_lstat(wchar_t *fname, struct_stat *buf )
+{
+	return _wstati64(fname,buf);
+}
+#else
+INLINE int __hscore_stat(char *file, struct_stat *buf) {
+	return stat(file,buf);
+}
+
+INLINE int __hscore_fstat(int fd, struct_stat *buf) {
+	return fstat(fd,buf);
+}
+
+INLINE int __hscore_lstat( const char *fname, struct stat *buf )
+{
+#if HAVE_LSTAT
+  return lstat(fname, buf);
+#else
+  return stat(fname, buf);
+#endif
+}
+#endif
+
+#if HAVE_TERMIOS_H
+INLINE tcflag_t __hscore_lflag( struct termios* ts ) { return ts->c_lflag; }
+
+INLINE void
+__hscore_poke_lflag( struct termios* ts, tcflag_t t ) { ts->c_lflag = t; }
+
+INLINE unsigned char*
+__hscore_ptr_c_cc( struct termios* ts )
+{ return (unsigned char*) &ts->c_cc; }
+
+INLINE HsInt
+__hscore_sizeof_termios( void )
+{
+#ifndef __MINGW32__
+  return sizeof(struct termios);
+#else
+  return 0;
+#endif
+}
+#endif
+
+#if !defined(_MSC_VER) && !defined(__MINGW32__) && !defined(_WIN32)
+INLINE HsInt
+__hscore_sizeof_sigset_t( void )
+{
+  return sizeof(sigset_t);
+}
+#endif
+
+INLINE int
+__hscore_echo( void )
+{
+#ifdef ECHO
+  return ECHO;
+#else
+  return 0;
+#endif
+
+}
+
+INLINE int
+__hscore_tcsanow( void )
+{
+#ifdef TCSANOW
+  return TCSANOW;
+#else
+  return 0;
+#endif
+
+}
+
+INLINE int
+__hscore_icanon( void )
+{
+#ifdef ICANON
+  return ICANON;
+#else
+  return 0;
+#endif
+}
+
+INLINE int __hscore_vmin( void )
+{
+#ifdef VMIN
+  return VMIN;
+#else
+  return 0;
+#endif
+}
+
+INLINE int __hscore_vtime( void )
+{
+#ifdef VTIME
+  return VTIME;
+#else
+  return 0;
+#endif
+}
+
+INLINE int __hscore_sigttou( void )
+{
+#ifdef SIGTTOU
+  return SIGTTOU;
+#else
+  return 0;
+#endif
+}
+
+INLINE int __hscore_sig_block( void )
+{
+#ifdef SIG_BLOCK
+  return SIG_BLOCK;
+#else
+  return 0;
+#endif
+}
+
+INLINE int __hscore_sig_setmask( void )
+{
+#ifdef SIG_SETMASK
+  return SIG_SETMASK;
+#else
+  return 0;
+#endif
+}
+
+#ifndef __MINGW32__
+INLINE size_t __hscore_sizeof_siginfo_t (void)
+{
+    return sizeof(siginfo_t);
+}
+#endif
+
+INLINE int
+__hscore_f_getfl( void )
+{
+#ifdef F_GETFL
+  return F_GETFL;
+#else
+  return 0;
+#endif
+}
+
+INLINE int
+__hscore_f_setfl( void )
+{
+#ifdef F_SETFL
+  return F_SETFL;
+#else
+  return 0;
+#endif
+}
+
+INLINE int
+__hscore_f_setfd( void )
+{
+#ifdef F_SETFD
+  return F_SETFD;
+#else
+  return 0;
+#endif
+}
+
+INLINE long
+__hscore_fd_cloexec( void )
+{
+#ifdef FD_CLOEXEC
+  return FD_CLOEXEC;
+#else
+  return 0;
+#endif
+}
+
+// defined in rts/RtsStartup.c.
+extern void* __hscore_get_saved_termios(int fd);
+extern void __hscore_set_saved_termios(int fd, void* ts);
+
+#ifdef __MINGW32__
+INLINE int __hscore_open(wchar_t *file, int how, mode_t mode) {
+	if ((how & O_WRONLY) || (how & O_RDWR) || (how & O_APPEND))
+	  return _wsopen(file,how | _O_NOINHERIT,_SH_DENYNO,mode);
+          // _O_NOINHERIT: see #2650
+	else
+	  return _wsopen(file,how | _O_NOINHERIT,_SH_DENYNO,mode);
+          // _O_NOINHERIT: see #2650
+}
+#else
+INLINE int __hscore_open(char *file, int how, mode_t mode) {
+	return open(file,how,mode);
+}
+#endif
+
+#if darwin_HOST_OS
+// You should not access _environ directly on Darwin in a bundle/shared library.
+// See #2458 and http://developer.apple.com/library/mac/#documentation/Darwin/Reference/ManPages/man7/environ.7.html
+#include <crt_externs.h>
+INLINE char **__hscore_environ(void) { return *(_NSGetEnviron()); }
+#else
+/* ToDo: write a feature test that doesn't assume 'environ' to
+ *    be in scope at link-time. */
+extern char** environ;
+INLINE char **__hscore_environ(void) { return environ; }
+#endif
+
+/* lossless conversions between pointers and integral types */
+INLINE void *    __hscore_from_uintptr(uintptr_t n) { return (void *)n; }
+INLINE void *    __hscore_from_intptr (intptr_t n)  { return (void *)n; }
+INLINE uintptr_t __hscore_to_uintptr  (void *p)     { return (uintptr_t)p; }
+INLINE intptr_t  __hscore_to_intptr   (void *p)     { return (intptr_t)p; }
+
+void errorBelch2(const char*s, char *t);
+void debugBelch2(const char*s, char *t);
+
+#endif /* __HSBASE_H__ */
+
diff --git a/libraries/base/include/HsEvent.h b/libraries/base/include/HsEvent.h
new file mode 100644
index 000000000000..fe0a7ca643e0
--- /dev/null
+++ b/libraries/base/include/HsEvent.h
@@ -0,0 +1,41 @@
+#ifndef __HS_EVENT_H__
+#define __HS_EVENT_H__
+
+#include "EventConfig.h"
+
+#include <signal.h>
+#include <pthread.h>
+
+#if !defined(INLINE)
+# if defined(_MSC_VER)
+#  define INLINE extern __inline
+# else
+#  define INLINE inline
+# endif
+#endif
+
+INLINE int __hsevent_num_signals(void)
+{
+#if defined(_NSIG)
+    return _NSIG;
+#else
+    return 128; /* best guess */
+#endif
+}
+
+INLINE void __hsevent_thread_self(pthread_t *tid)
+{
+    *tid = pthread_self();
+}
+
+INLINE int __hsevent_kill_thread(pthread_t *tid, int sig)
+{
+    return pthread_kill(*tid, sig);
+}
+
+#endif /* __HS_EVENT_H__ */
+/*
+ * Local Variables: 
+ * c-file-style: "stroustrup" 
+ * End: 
+ */
diff --git a/libraries/base/include/OldTypeable.h b/libraries/base/include/OldTypeable.h
new file mode 100644
index 000000000000..311edffe290c
--- /dev/null
+++ b/libraries/base/include/OldTypeable.h
@@ -0,0 +1,29 @@
+{- --------------------------------------------------------------------------
+// Macros to help make Typeable instances.
+//
+// INSTANCE_TYPEABLEn(tc,tcname,"tc") defines
+//
+//	instance Typeable/n/ tc
+//	instance Typeable a => Typeable/n-1/ (tc a)
+//	instance (Typeable a, Typeable b) => Typeable/n-2/ (tc a b)
+//	...
+//	instance (Typeable a1, ..., Typeable an) => Typeable (tc a1 ... an)
+// --------------------------------------------------------------------------
+-}
+
+#ifndef TYPEABLE_H
+#define TYPEABLE_H
+
+--  // For GHC, we can use DeriveDataTypeable + StandaloneDeriving to
+--  // generate the instances.
+
+#define INSTANCE_TYPEABLE0(tycon,tcname,str) deriving instance Typeable tycon
+#define INSTANCE_TYPEABLE1(tycon,tcname,str) deriving instance Typeable1 tycon
+#define INSTANCE_TYPEABLE2(tycon,tcname,str) deriving instance Typeable2 tycon
+#define INSTANCE_TYPEABLE3(tycon,tcname,str) deriving instance Typeable3 tycon
+#define INSTANCE_TYPEABLE4(tycon,tcname,str) deriving instance Typeable4 tycon
+#define INSTANCE_TYPEABLE5(tycon,tcname,str) deriving instance Typeable5 tycon
+#define INSTANCE_TYPEABLE6(tycon,tcname,str) deriving instance Typeable6 tycon
+#define INSTANCE_TYPEABLE7(tycon,tcname,str) deriving instance Typeable7 tycon
+
+#endif
diff --git a/libraries/base/include/Typeable.h b/libraries/base/include/Typeable.h
new file mode 100644
index 000000000000..1a3149885df2
--- /dev/null
+++ b/libraries/base/include/Typeable.h
@@ -0,0 +1,31 @@
+{- --------------------------------------------------------------------------
+// Macros to help make Typeable instances.
+//
+// INSTANCE_TYPEABLEn(tc,tcname,"tc") defines
+//
+//	instance Typeable/n/ tc
+//	instance Typeable a => Typeable/n-1/ (tc a)
+//	instance (Typeable a, Typeable b) => Typeable/n-2/ (tc a b)
+//	...
+//	instance (Typeable a1, ..., Typeable an) => Typeable (tc a1 ... an)
+// --------------------------------------------------------------------------
+-}
+
+#ifndef TYPEABLE_H
+#define TYPEABLE_H
+
+#warning <Typeable.h> is obsolete and will be removed in GHC 7.10
+
+--  // For GHC, we can use DeriveDataTypeable + StandaloneDeriving to
+--  // generate the instances.
+
+#define INSTANCE_TYPEABLE0(tycon,tcname,str) deriving instance Typeable tycon
+#define INSTANCE_TYPEABLE1(tycon,tcname,str) deriving instance Typeable tycon
+#define INSTANCE_TYPEABLE2(tycon,tcname,str) deriving instance Typeable tycon
+#define INSTANCE_TYPEABLE3(tycon,tcname,str) deriving instance Typeable tycon
+#define INSTANCE_TYPEABLE4(tycon,tcname,str) deriving instance Typeable tycon
+#define INSTANCE_TYPEABLE5(tycon,tcname,str) deriving instance Typeable tycon
+#define INSTANCE_TYPEABLE6(tycon,tcname,str) deriving instance Typeable tycon
+#define INSTANCE_TYPEABLE7(tycon,tcname,str) deriving instance Typeable tycon
+
+#endif
diff --git a/libraries/base/include/WCsubst.h b/libraries/base/include/WCsubst.h
new file mode 100644
index 000000000000..f2436dd38a32
--- /dev/null
+++ b/libraries/base/include/WCsubst.h
@@ -0,0 +1,24 @@
+#ifndef WCSUBST_INCL
+
+#define WCSUBST_INCL
+
+#include <stdlib.h>
+
+int u_iswupper(int wc);
+int u_iswdigit(int wc);
+int u_iswalpha(int wc);
+int u_iswcntrl(int wc);
+int u_iswspace(int wc);
+int u_iswprint(int wc);
+int u_iswlower(int wc);
+
+int u_iswalnum(int wc);
+
+int u_towlower(int wc);
+int u_towupper(int wc);
+int u_towtitle(int wc);
+
+int u_gencat(int wc);
+
+#endif
+
diff --git a/libraries/base/include/consUtils.h b/libraries/base/include/consUtils.h
new file mode 100644
index 000000000000..588139ce9274
--- /dev/null
+++ b/libraries/base/include/consUtils.h
@@ -0,0 +1,13 @@
+/* 
+ * (c) The University of Glasgow, 2000-2002
+ *
+ * Win32 Console API helpers.
+ */
+#ifndef __CONSUTILS_H__
+#define __CONSUTILS_H__
+extern int is_console__(int fd);
+extern int set_console_buffering__(int fd, int cooked);
+extern int set_console_echo__(int fd, int on);
+extern int get_console_echo__(int fd);
+extern int flush_input_console__ (int fd);
+#endif
diff --git a/libraries/base/include/ieee-flpt.h b/libraries/base/include/ieee-flpt.h
new file mode 100644
index 000000000000..a1fce3a8da23
--- /dev/null
+++ b/libraries/base/include/ieee-flpt.h
@@ -0,0 +1,35 @@
+/* this file is #included into both C (.c and .hc) and Haskell files */
+
+    /* IEEE format floating-point */
+#define IEEE_FLOATING_POINT 1
+
+   /* Radix of exponent representation */
+#ifndef FLT_RADIX
+# define FLT_RADIX 2
+#endif
+
+   /* Number of base-FLT_RADIX digits in the significand of a float */
+#ifndef FLT_MANT_DIG
+# define FLT_MANT_DIG 24
+#endif
+   /* Minimum int x such that FLT_RADIX**(x-1) is a normalised float */
+#ifndef FLT_MIN_EXP
+#  define FLT_MIN_EXP (-125)
+#endif
+   /* Maximum int x such that FLT_RADIX**(x-1) is a representable float */
+#ifndef FLT_MAX_EXP
+# define FLT_MAX_EXP 128
+#endif
+
+   /* Number of base-FLT_RADIX digits in the significand of a double */
+#ifndef DBL_MANT_DIG
+# define DBL_MANT_DIG 53
+#endif
+   /* Minimum int x such that FLT_RADIX**(x-1) is a normalised double */
+#ifndef DBL_MIN_EXP
+#  define DBL_MIN_EXP (-1021)
+#endif
+   /* Maximum int x such that FLT_RADIX**(x-1) is a representable double */
+#ifndef DBL_MAX_EXP
+# define DBL_MAX_EXP 1024
+#endif
diff --git a/libraries/base/include/md5.h b/libraries/base/include/md5.h
new file mode 100644
index 000000000000..486a96cbdd56
--- /dev/null
+++ b/libraries/base/include/md5.h
@@ -0,0 +1,24 @@
+/* MD5 message digest */
+#ifndef _MD5_H
+#define _MD5_H
+
+#include "HsFFI.h"
+
+typedef HsWord32 word32;
+typedef HsWord8  byte;
+
+struct MD5Context {
+	word32 buf[4];
+	word32 bytes[2];
+	word32 in[16];
+};
+
+void __hsbase_MD5Init(struct MD5Context *context);
+void __hsbase_MD5Update(struct MD5Context *context, byte const *buf, int len);
+void __hsbase_MD5Final(byte digest[16], struct MD5Context *context);
+void __hsbase_MD5Transform(word32 buf[4], word32 const in[16]);
+
+#endif /* _MD5_H */
+
+
+
diff --git a/libraries/base/install-sh b/libraries/base/install-sh
new file mode 100644
index 000000000000..377bb8687ffe
--- /dev/null
+++ b/libraries/base/install-sh
@@ -0,0 +1,527 @@
+#!/bin/sh
+# install - install a program, script, or datafile
+
+scriptversion=2011-11-20.07; # UTC
+
+# This originates from X11R5 (mit/util/scripts/install.sh), which was
+# later released in X11R6 (xc/config/util/install.sh) with the
+# following copyright and license.
+#
+# Copyright (C) 1994 X Consortium
+#
+# Permission is hereby granted, free of charge, to any person obtaining a copy
+# of this software and associated documentation files (the "Software"), to
+# deal in the Software without restriction, including without limitation the
+# rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
+# sell copies of the Software, and to permit persons to whom the Software is
+# furnished to do so, subject to the following conditions:
+#
+# The above copyright notice and this permission notice shall be included in
+# all copies or substantial portions of the Software.
+#
+# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL THE
+# X CONSORTIUM BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN
+# AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNEC-
+# TION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+#
+# Except as contained in this notice, the name of the X Consortium shall not
+# be used in advertising or otherwise to promote the sale, use or other deal-
+# ings in this Software without prior written authorization from the X Consor-
+# tium.
+#
+#
+# FSF changes to this file are in the public domain.
+#
+# Calling this script install-sh is preferred over install.sh, to prevent
+# 'make' implicit rules from creating a file called install from it
+# when there is no Makefile.
+#
+# This script is compatible with the BSD install script, but was written
+# from scratch.
+
+nl='
+'
+IFS=" ""	$nl"
+
+# set DOITPROG to echo to test this script
+
+# Don't use :- since 4.3BSD and earlier shells don't like it.
+doit=${DOITPROG-}
+if test -z "$doit"; then
+  doit_exec=exec
+else
+  doit_exec=$doit
+fi
+
+# Put in absolute file names if you don't have them in your path;
+# or use environment vars.
+
+chgrpprog=${CHGRPPROG-chgrp}
+chmodprog=${CHMODPROG-chmod}
+chownprog=${CHOWNPROG-chown}
+cmpprog=${CMPPROG-cmp}
+cpprog=${CPPROG-cp}
+mkdirprog=${MKDIRPROG-mkdir}
+mvprog=${MVPROG-mv}
+rmprog=${RMPROG-rm}
+stripprog=${STRIPPROG-strip}
+
+posix_glob='?'
+initialize_posix_glob='
+  test "$posix_glob" != "?" || {
+    if (set -f) 2>/dev/null; then
+      posix_glob=
+    else
+      posix_glob=:
+    fi
+  }
+'
+
+posix_mkdir=
+
+# Desired mode of installed file.
+mode=0755
+
+chgrpcmd=
+chmodcmd=$chmodprog
+chowncmd=
+mvcmd=$mvprog
+rmcmd="$rmprog -f"
+stripcmd=
+
+src=
+dst=
+dir_arg=
+dst_arg=
+
+copy_on_change=false
+no_target_directory=
+
+usage="\
+Usage: $0 [OPTION]... [-T] SRCFILE DSTFILE
+   or: $0 [OPTION]... SRCFILES... DIRECTORY
+   or: $0 [OPTION]... -t DIRECTORY SRCFILES...
+   or: $0 [OPTION]... -d DIRECTORIES...
+
+In the 1st form, copy SRCFILE to DSTFILE.
+In the 2nd and 3rd, copy all SRCFILES to DIRECTORY.
+In the 4th, create DIRECTORIES.
+
+Options:
+     --help     display this help and exit.
+     --version  display version info and exit.
+
+  -c            (ignored)
+  -C            install only if different (preserve the last data modification time)
+  -d            create directories instead of installing files.
+  -g GROUP      $chgrpprog installed files to GROUP.
+  -m MODE       $chmodprog installed files to MODE.
+  -o USER       $chownprog installed files to USER.
+  -s            $stripprog installed files.
+  -t DIRECTORY  install into DIRECTORY.
+  -T            report an error if DSTFILE is a directory.
+
+Environment variables override the default commands:
+  CHGRPPROG CHMODPROG CHOWNPROG CMPPROG CPPROG MKDIRPROG MVPROG
+  RMPROG STRIPPROG
+"
+
+while test $# -ne 0; do
+  case $1 in
+    -c) ;;
+
+    -C) copy_on_change=true;;
+
+    -d) dir_arg=true;;
+
+    -g) chgrpcmd="$chgrpprog $2"
+	shift;;
+
+    --help) echo "$usage"; exit $?;;
+
+    -m) mode=$2
+	case $mode in
+	  *' '* | *'	'* | *'
+'*	  | *'*'* | *'?'* | *'['*)
+	    echo "$0: invalid mode: $mode" >&2
+	    exit 1;;
+	esac
+	shift;;
+
+    -o) chowncmd="$chownprog $2"
+	shift;;
+
+    -s) stripcmd=$stripprog;;
+
+    -t) dst_arg=$2
+	# Protect names problematic for 'test' and other utilities.
+	case $dst_arg in
+	  -* | [=\(\)!]) dst_arg=./$dst_arg;;
+	esac
+	shift;;
+
+    -T) no_target_directory=true;;
+
+    --version) echo "$0 $scriptversion"; exit $?;;
+
+    --)	shift
+	break;;
+
+    -*)	echo "$0: invalid option: $1" >&2
+	exit 1;;
+
+    *)  break;;
+  esac
+  shift
+done
+
+if test $# -ne 0 && test -z "$dir_arg$dst_arg"; then
+  # When -d is used, all remaining arguments are directories to create.
+  # When -t is used, the destination is already specified.
+  # Otherwise, the last argument is the destination.  Remove it from $@.
+  for arg
+  do
+    if test -n "$dst_arg"; then
+      # $@ is not empty: it contains at least $arg.
+      set fnord "$@" "$dst_arg"
+      shift # fnord
+    fi
+    shift # arg
+    dst_arg=$arg
+    # Protect names problematic for 'test' and other utilities.
+    case $dst_arg in
+      -* | [=\(\)!]) dst_arg=./$dst_arg;;
+    esac
+  done
+fi
+
+if test $# -eq 0; then
+  if test -z "$dir_arg"; then
+    echo "$0: no input file specified." >&2
+    exit 1
+  fi
+  # It's OK to call 'install-sh -d' without argument.
+  # This can happen when creating conditional directories.
+  exit 0
+fi
+
+if test -z "$dir_arg"; then
+  do_exit='(exit $ret); exit $ret'
+  trap "ret=129; $do_exit" 1
+  trap "ret=130; $do_exit" 2
+  trap "ret=141; $do_exit" 13
+  trap "ret=143; $do_exit" 15
+
+  # Set umask so as not to create temps with too-generous modes.
+  # However, 'strip' requires both read and write access to temps.
+  case $mode in
+    # Optimize common cases.
+    *644) cp_umask=133;;
+    *755) cp_umask=22;;
+
+    *[0-7])
+      if test -z "$stripcmd"; then
+	u_plus_rw=
+      else
+	u_plus_rw='% 200'
+      fi
+      cp_umask=`expr '(' 777 - $mode % 1000 ')' $u_plus_rw`;;
+    *)
+      if test -z "$stripcmd"; then
+	u_plus_rw=
+      else
+	u_plus_rw=,u+rw
+      fi
+      cp_umask=$mode$u_plus_rw;;
+  esac
+fi
+
+for src
+do
+  # Protect names problematic for 'test' and other utilities.
+  case $src in
+    -* | [=\(\)!]) src=./$src;;
+  esac
+
+  if test -n "$dir_arg"; then
+    dst=$src
+    dstdir=$dst
+    test -d "$dstdir"
+    dstdir_status=$?
+  else
+
+    # Waiting for this to be detected by the "$cpprog $src $dsttmp" command
+    # might cause directories to be created, which would be especially bad
+    # if $src (and thus $dsttmp) contains '*'.
+    if test ! -f "$src" && test ! -d "$src"; then
+      echo "$0: $src does not exist." >&2
+      exit 1
+    fi
+
+    if test -z "$dst_arg"; then
+      echo "$0: no destination specified." >&2
+      exit 1
+    fi
+    dst=$dst_arg
+
+    # If destination is a directory, append the input filename; won't work
+    # if double slashes aren't ignored.
+    if test -d "$dst"; then
+      if test -n "$no_target_directory"; then
+	echo "$0: $dst_arg: Is a directory" >&2
+	exit 1
+      fi
+      dstdir=$dst
+      dst=$dstdir/`basename "$src"`
+      dstdir_status=0
+    else
+      # Prefer dirname, but fall back on a substitute if dirname fails.
+      dstdir=`
+	(dirname "$dst") 2>/dev/null ||
+	expr X"$dst" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
+	     X"$dst" : 'X\(//\)[^/]' \| \
+	     X"$dst" : 'X\(//\)$' \| \
+	     X"$dst" : 'X\(/\)' \| . 2>/dev/null ||
+	echo X"$dst" |
+	    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{
+		   s//\1/
+		   q
+		 }
+		 /^X\(\/\/\)[^/].*/{
+		   s//\1/
+		   q
+		 }
+		 /^X\(\/\/\)$/{
+		   s//\1/
+		   q
+		 }
+		 /^X\(\/\).*/{
+		   s//\1/
+		   q
+		 }
+		 s/.*/./; q'
+      `
+
+      test -d "$dstdir"
+      dstdir_status=$?
+    fi
+  fi
+
+  obsolete_mkdir_used=false
+
+  if test $dstdir_status != 0; then
+    case $posix_mkdir in
+      '')
+	# Create intermediate dirs using mode 755 as modified by the umask.
+	# This is like FreeBSD 'install' as of 1997-10-28.
+	umask=`umask`
+	case $stripcmd.$umask in
+	  # Optimize common cases.
+	  *[2367][2367]) mkdir_umask=$umask;;
+	  .*0[02][02] | .[02][02] | .[02]) mkdir_umask=22;;
+
+	  *[0-7])
+	    mkdir_umask=`expr $umask + 22 \
+	      - $umask % 100 % 40 + $umask % 20 \
+	      - $umask % 10 % 4 + $umask % 2
+	    `;;
+	  *) mkdir_umask=$umask,go-w;;
+	esac
+
+	# With -d, create the new directory with the user-specified mode.
+	# Otherwise, rely on $mkdir_umask.
+	if test -n "$dir_arg"; then
+	  mkdir_mode=-m$mode
+	else
+	  mkdir_mode=
+	fi
+
+	posix_mkdir=false
+	case $umask in
+	  *[123567][0-7][0-7])
+	    # POSIX mkdir -p sets u+wx bits regardless of umask, which
+	    # is incompatible with FreeBSD 'install' when (umask & 300) != 0.
+	    ;;
+	  *)
+	    tmpdir=${TMPDIR-/tmp}/ins$RANDOM-$$
+	    trap 'ret=$?; rmdir "$tmpdir/d" "$tmpdir" 2>/dev/null; exit $ret' 0
+
+	    if (umask $mkdir_umask &&
+		exec $mkdirprog $mkdir_mode -p -- "$tmpdir/d") >/dev/null 2>&1
+	    then
+	      if test -z "$dir_arg" || {
+		   # Check for POSIX incompatibilities with -m.
+		   # HP-UX 11.23 and IRIX 6.5 mkdir -m -p sets group- or
+		   # other-writable bit of parent directory when it shouldn't.
+		   # FreeBSD 6.1 mkdir -m -p sets mode of existing directory.
+		   ls_ld_tmpdir=`ls -ld "$tmpdir"`
+		   case $ls_ld_tmpdir in
+		     d????-?r-*) different_mode=700;;
+		     d????-?--*) different_mode=755;;
+		     *) false;;
+		   esac &&
+		   $mkdirprog -m$different_mode -p -- "$tmpdir" && {
+		     ls_ld_tmpdir_1=`ls -ld "$tmpdir"`
+		     test "$ls_ld_tmpdir" = "$ls_ld_tmpdir_1"
+		   }
+		 }
+	      then posix_mkdir=:
+	      fi
+	      rmdir "$tmpdir/d" "$tmpdir"
+	    else
+	      # Remove any dirs left behind by ancient mkdir implementations.
+	      rmdir ./$mkdir_mode ./-p ./-- 2>/dev/null
+	    fi
+	    trap '' 0;;
+	esac;;
+    esac
+
+    if
+      $posix_mkdir && (
+	umask $mkdir_umask &&
+	$doit_exec $mkdirprog $mkdir_mode -p -- "$dstdir"
+      )
+    then :
+    else
+
+      # The umask is ridiculous, or mkdir does not conform to POSIX,
+      # or it failed possibly due to a race condition.  Create the
+      # directory the slow way, step by step, checking for races as we go.
+
+      case $dstdir in
+	/*) prefix='/';;
+	[-=\(\)!]*) prefix='./';;
+	*)  prefix='';;
+      esac
+
+      eval "$initialize_posix_glob"
+
+      oIFS=$IFS
+      IFS=/
+      $posix_glob set -f
+      set fnord $dstdir
+      shift
+      $posix_glob set +f
+      IFS=$oIFS
+
+      prefixes=
+
+      for d
+      do
+	test X"$d" = X && continue
+
+	prefix=$prefix$d
+	if test -d "$prefix"; then
+	  prefixes=
+	else
+	  if $posix_mkdir; then
+	    (umask=$mkdir_umask &&
+	     $doit_exec $mkdirprog $mkdir_mode -p -- "$dstdir") && break
+	    # Don't fail if two instances are running concurrently.
+	    test -d "$prefix" || exit 1
+	  else
+	    case $prefix in
+	      *\'*) qprefix=`echo "$prefix" | sed "s/'/'\\\\\\\\''/g"`;;
+	      *) qprefix=$prefix;;
+	    esac
+	    prefixes="$prefixes '$qprefix'"
+	  fi
+	fi
+	prefix=$prefix/
+      done
+
+      if test -n "$prefixes"; then
+	# Don't fail if two instances are running concurrently.
+	(umask $mkdir_umask &&
+	 eval "\$doit_exec \$mkdirprog $prefixes") ||
+	  test -d "$dstdir" || exit 1
+	obsolete_mkdir_used=true
+      fi
+    fi
+  fi
+
+  if test -n "$dir_arg"; then
+    { test -z "$chowncmd" || $doit $chowncmd "$dst"; } &&
+    { test -z "$chgrpcmd" || $doit $chgrpcmd "$dst"; } &&
+    { test "$obsolete_mkdir_used$chowncmd$chgrpcmd" = false ||
+      test -z "$chmodcmd" || $doit $chmodcmd $mode "$dst"; } || exit 1
+  else
+
+    # Make a couple of temp file names in the proper directory.
+    dsttmp=$dstdir/_inst.$$_
+    rmtmp=$dstdir/_rm.$$_
+
+    # Trap to clean up those temp files at exit.
+    trap 'ret=$?; rm -f "$dsttmp" "$rmtmp" && exit $ret' 0
+
+    # Copy the file name to the temp name.
+    (umask $cp_umask && $doit_exec $cpprog "$src" "$dsttmp") &&
+
+    # and set any options; do chmod last to preserve setuid bits.
+    #
+    # If any of these fail, we abort the whole thing.  If we want to
+    # ignore errors from any of these, just make sure not to ignore
+    # errors from the above "$doit $cpprog $src $dsttmp" command.
+    #
+    { test -z "$chowncmd" || $doit $chowncmd "$dsttmp"; } &&
+    { test -z "$chgrpcmd" || $doit $chgrpcmd "$dsttmp"; } &&
+    { test -z "$stripcmd" || $doit $stripcmd "$dsttmp"; } &&
+    { test -z "$chmodcmd" || $doit $chmodcmd $mode "$dsttmp"; } &&
+
+    # If -C, don't bother to copy if it wouldn't change the file.
+    if $copy_on_change &&
+       old=`LC_ALL=C ls -dlL "$dst"	2>/dev/null` &&
+       new=`LC_ALL=C ls -dlL "$dsttmp"	2>/dev/null` &&
+
+       eval "$initialize_posix_glob" &&
+       $posix_glob set -f &&
+       set X $old && old=:$2:$4:$5:$6 &&
+       set X $new && new=:$2:$4:$5:$6 &&
+       $posix_glob set +f &&
+
+       test "$old" = "$new" &&
+       $cmpprog "$dst" "$dsttmp" >/dev/null 2>&1
+    then
+      rm -f "$dsttmp"
+    else
+      # Rename the file to the real destination.
+      $doit $mvcmd -f "$dsttmp" "$dst" 2>/dev/null ||
+
+      # The rename failed, perhaps because mv can't rename something else
+      # to itself, or perhaps because mv is so ancient that it does not
+      # support -f.
+      {
+	# Now remove or move aside any old file at destination location.
+	# We try this two ways since rm can't unlink itself on some
+	# systems and the destination file might be busy for other
+	# reasons.  In this case, the final cleanup might fail but the new
+	# file should still install successfully.
+	{
+	  test ! -f "$dst" ||
+	  $doit $rmcmd -f "$dst" 2>/dev/null ||
+	  { $doit $mvcmd -f "$dst" "$rmtmp" 2>/dev/null &&
+	    { $doit $rmcmd -f "$rmtmp" 2>/dev/null; :; }
+	  } ||
+	  { echo "$0: cannot unlink or rename $dst" >&2
+	    (exit 1); exit 1
+	  }
+	} &&
+
+	# Now rename the file to the real destination.
+	$doit $mvcmd "$dsttmp" "$dst"
+      }
+    fi || exit 1
+
+    trap '' 0
+  fi
+done
+
+# Local variables:
+# eval: (add-hook 'write-file-hooks 'time-stamp)
+# time-stamp-start: "scriptversion="
+# time-stamp-format: "%:y-%02m-%02d.%02H"
+# time-stamp-time-zone: "UTC"
+# time-stamp-end: "; # UTC"
+# End:
diff --git a/libraries/base/prologue.txt b/libraries/base/prologue.txt
new file mode 100644
index 000000000000..f3a7a3a80a3b
--- /dev/null
+++ b/libraries/base/prologue.txt
@@ -0,0 +1,3 @@
+This package contains the @Prelude@ and its support libraries, and a large
+collection of useful libraries ranging from data structures to parsing
+combinators and debugging utilities.
diff --git a/libraries/base/tests/.gitignore b/libraries/base/tests/.gitignore
new file mode 100644
index 000000000000..3115fd753c9b
--- /dev/null
+++ b/libraries/base/tests/.gitignore
@@ -0,0 +1,272 @@
+*.eventlog
+*.genscript
+
+*.stderr.normalised
+*.stdout.normalised
+*.comp.stderr
+*.comp.stdout
+*.interp.stderr
+*.interp.stdout
+*.run.stderr
+*.run.stdout
+
+.hpc.*/
+.hpc/
+
+# specific files
+/CPUTime001
+/Concurrent/4876
+/Concurrent/Chan002
+/Concurrent/Chan003
+/Concurrent/ThreadDelay001
+/IO/IOError001
+/IO/IOError002
+/IO/T2122
+/IO/T2122-test
+/IO/T3307
+/IO/T4144
+/IO/T4808
+/IO/T4808.test
+/IO/T4855
+/IO/T4895
+/IO/T7853
+/IO/chinese-file-*
+/IO/chinese-name
+/IO/concio002
+/IO/countReaders001
+/IO/countReaders001.txt
+/IO/decodingerror001
+/IO/decodingerror002
+/IO/encoding001
+/IO/encoding001.utf16
+/IO/encoding001.utf16.utf16be
+/IO/encoding001.utf16.utf16le
+/IO/encoding001.utf16.utf32
+/IO/encoding001.utf16.utf32be
+/IO/encoding001.utf16.utf32le
+/IO/encoding001.utf16.utf8
+/IO/encoding001.utf16.utf8_bom
+/IO/encoding001.utf16be
+/IO/encoding001.utf16be.utf16
+/IO/encoding001.utf16be.utf16le
+/IO/encoding001.utf16be.utf32
+/IO/encoding001.utf16be.utf32be
+/IO/encoding001.utf16be.utf32le
+/IO/encoding001.utf16be.utf8
+/IO/encoding001.utf16be.utf8_bom
+/IO/encoding001.utf16le
+/IO/encoding001.utf16le.utf16
+/IO/encoding001.utf16le.utf16be
+/IO/encoding001.utf16le.utf32
+/IO/encoding001.utf16le.utf32be
+/IO/encoding001.utf16le.utf32le
+/IO/encoding001.utf16le.utf8
+/IO/encoding001.utf16le.utf8_bom
+/IO/encoding001.utf32
+/IO/encoding001.utf32.utf16
+/IO/encoding001.utf32.utf16be
+/IO/encoding001.utf32.utf16le
+/IO/encoding001.utf32.utf32be
+/IO/encoding001.utf32.utf32le
+/IO/encoding001.utf32.utf8
+/IO/encoding001.utf32.utf8_bom
+/IO/encoding001.utf32be
+/IO/encoding001.utf32be.utf16
+/IO/encoding001.utf32be.utf16be
+/IO/encoding001.utf32be.utf16le
+/IO/encoding001.utf32be.utf32
+/IO/encoding001.utf32be.utf32le
+/IO/encoding001.utf32be.utf8
+/IO/encoding001.utf32be.utf8_bom
+/IO/encoding001.utf32le
+/IO/encoding001.utf32le.utf16
+/IO/encoding001.utf32le.utf16be
+/IO/encoding001.utf32le.utf16le
+/IO/encoding001.utf32le.utf32
+/IO/encoding001.utf32le.utf32be
+/IO/encoding001.utf32le.utf8
+/IO/encoding001.utf32le.utf8_bom
+/IO/encoding001.utf8
+/IO/encoding001.utf8.utf16
+/IO/encoding001.utf8.utf16be
+/IO/encoding001.utf8.utf16le
+/IO/encoding001.utf8.utf32
+/IO/encoding001.utf8.utf32be
+/IO/encoding001.utf8.utf32le
+/IO/encoding001.utf8.utf8_bom
+/IO/encoding001.utf8_bom
+/IO/encoding001.utf8_bom.utf16
+/IO/encoding001.utf8_bom.utf16be
+/IO/encoding001.utf8_bom.utf16le
+/IO/encoding001.utf8_bom.utf32
+/IO/encoding001.utf8_bom.utf32be
+/IO/encoding001.utf8_bom.utf32le
+/IO/encoding001.utf8_bom.utf8
+/IO/encoding002
+/IO/encoding003
+/IO/encoding004
+/IO/encodingerror001
+/IO/environment001
+/IO/finalization001
+/IO/hClose001
+/IO/hClose001.tmp
+/IO/hClose002
+/IO/hClose002.tmp
+/IO/hClose003
+/IO/hDuplicateTo001
+/IO/hFileSize001
+/IO/hFileSize002
+/IO/hFileSize002.out
+/IO/hFlush001
+/IO/hFlush001.out
+/IO/hGetBuf001
+/IO/hGetBuffering001
+/IO/hGetChar001
+/IO/hGetLine001
+/IO/hGetLine002
+/IO/hGetLine003
+/IO/hGetPosn001
+/IO/hGetPosn001.out
+/IO/hIsEOF001
+/IO/hIsEOF002
+/IO/hIsEOF002.out
+/IO/hReady001
+/IO/hReady002
+/IO/hSeek001
+/IO/hSeek002
+/IO/hSeek003
+/IO/hSeek004
+/IO/hSeek004.out
+/IO/hSetBuffering002
+/IO/hSetBuffering003
+/IO/hSetBuffering004
+/IO/hSetEncoding001
+/IO/ioeGetErrorString001
+/IO/ioeGetFileName001
+/IO/ioeGetHandle001
+/IO/isEOF001
+/IO/misc001
+/IO/misc001.out
+/IO/newline001
+/IO/newline001.out
+/IO/openFile001
+/IO/openFile002
+/IO/openFile003
+/IO/openFile003Dir
+/IO/openFile004
+/IO/openFile004.out
+/IO/openFile005
+/IO/openFile005.out1
+/IO/openFile005.out2
+/IO/openFile006
+/IO/openFile006.out
+/IO/openFile007
+/IO/openFile007.out
+/IO/openFile008
+/IO/openTempFile001
+/IO/putStr001
+/IO/readFile001
+/IO/readFile001.out
+/IO/readwrite001
+/IO/readwrite001.inout
+/IO/readwrite002
+/IO/readwrite002.inout
+/IO/readwrite003
+/IO/readwrite003.txt
+/IO/tmp
+/Numeric/num001
+/Numeric/num002
+/Numeric/num003
+/Numeric/num004
+/Numeric/num005
+/Numeric/num006
+/Numeric/num007
+/Numeric/num008
+/Numeric/num009
+/Numeric/num010
+/System/T5930
+/System/Timeout001
+/System/exitWith001
+/System/getArgs001
+/System/getEnv001
+/System/system001
+/T4006
+/T5943
+/T5962
+/T7034
+/T7457
+/T7653
+/T7773
+/T7787
+/T8766
+/T8766.stats
+/Text.Printf/T1548
+/addr001
+/assert
+/char001
+/char002
+/cstring001
+/data-fixed-show-read
+/dynamic001
+/dynamic002
+/dynamic003
+/dynamic004
+/dynamic005
+/echo001
+/enum01
+/enum02
+/enum03
+/enum04
+/enumDouble
+/enumRatio
+/exceptionsrun001
+/exceptionsrun002
+/fixed
+/genericNegative001
+/hGetBuf002
+/hGetBuf003
+/hPutBuf001
+/hPutBuf002
+/hPutBuf002.out
+/hTell001
+/hTell002
+/hash001
+/ioref001
+/ix001
+/length001
+/lex001
+/list001
+/list002
+/list003
+/memo001
+/memo002
+/performGC001
+/qsem001
+/qsemn001
+/quotOverflow
+/rand001
+/ratio001
+/readDouble001
+/readFixed001
+/readFloat
+/readInteger001
+/readLitChar
+/reads001
+/show001
+/showDouble
+/stableptr001
+/stableptr003
+/stableptr004
+/stableptr005
+/take001
+/tempfiles
+/text001
+/topHandler01
+/topHandler02
+/topHandler03
+/trace001
+/tup001
+/unicode001
+/unicode002
+/weak001
+/T9395
diff --git a/libraries/base/tests/CPUTime001.hs b/libraries/base/tests/CPUTime001.hs
new file mode 100644
index 000000000000..122e9ca68436
--- /dev/null
+++ b/libraries/base/tests/CPUTime001.hs
@@ -0,0 +1,26 @@
+-- !!! Test getCPUTime
+
+import System.CPUTime
+import System.IO
+
+main :: IO ()
+main = do
+    t28 <- timeFib 28
+    t29 <- timeFib 29
+    t30 <- timeFib 30
+    print (t28 <= t29, t29 <= t30)
+
+timeFib :: Integer -> IO Integer
+timeFib n = do
+    start <- getCPUTime
+    print (nfib n)
+    end <- getCPUTime
+    return (end - start)
+
+nfib :: Integer -> Integer
+nfib n
+  | n <= 1 = 1
+  | otherwise = (n1 + n2 + 1)
+  where
+    n1 = nfib (n-1)
+    n2 = nfib (n-2)
diff --git a/libraries/base/tests/CPUTime001.stdout b/libraries/base/tests/CPUTime001.stdout
new file mode 100644
index 000000000000..032e7595f0ca
--- /dev/null
+++ b/libraries/base/tests/CPUTime001.stdout
@@ -0,0 +1,4 @@
+1028457
+1664079
+2692537
+(True,True)
diff --git a/libraries/base/tests/CatEntail.hs b/libraries/base/tests/CatEntail.hs
new file mode 100644
index 000000000000..bc2d8d2f5599
--- /dev/null
+++ b/libraries/base/tests/CatEntail.hs
@@ -0,0 +1,27 @@
+{-# LANGUAGE ConstraintKinds, GADTs, RankNTypes #-}
+{-# LANGUAGE TypeOperators, KindSignatures #-}
+module CatEntail where
+import Prelude hiding (id, (.))
+import GHC.Prim (Constraint)
+import Control.Category
+
+-- One dictionary to rule them all.
+data Dict :: Constraint -> * where
+  Dict :: ctx => Dict ctx
+
+-- Entailment.
+-- Note the kind 'Constraint -> Constraint -> *'
+newtype (|-) a b = Sub (a => Dict b)
+
+(\\) :: a => (b => r) -> (a |- b) -> r
+r \\ Sub Dict = r
+
+reflexive :: a |- a
+reflexive = Sub Dict
+
+transitive :: (b |- c) -> (a |- b) -> a |- c
+transitive f g = Sub $ Dict \\ f \\ g
+
+instance Category (|-) where
+  id  = reflexive
+  (.) = transitive
diff --git a/libraries/base/tests/CatPairs.hs b/libraries/base/tests/CatPairs.hs
new file mode 100644
index 000000000000..6efa9cc5740c
--- /dev/null
+++ b/libraries/base/tests/CatPairs.hs
@@ -0,0 +1,34 @@
+{-# LANGUAGE PolyKinds, DataKinds, KindSignatures #-}
+{-# LANGUAGE MultiParamTypeClasses, TypeFamilies #-}
+module CatPairs where
+import Prelude hiding (id, (.))
+import Control.Monad ((>=>))
+import Control.Category
+
+-- Categories over pairs of types.
+-- Taken from Twan van Laarhoven:
+--   http://twanvl.nl/blog/haskell/categories-over-pairs-of-types
+
+type family Fst (xy :: (*,*)) :: *
+type family Snd (xy :: (*,*)) :: *
+type instance Fst '(x,y) = x
+type instance Snd '(x,y) = y
+
+-- Ceci n'est pas une pipe
+data Pipe i o u m r = Pipe { runPipe :: Either i u -> m (Either o r) }
+
+(>+>) :: Monad m
+      => Pipe io1 io2 ur1 m ur2
+      -> Pipe io2 io3 ur2 m ur3
+      -> Pipe io1 io3 ur1 m ur3
+(>+>) (Pipe f) (Pipe g) = Pipe (f >=> g)
+
+idP :: Monad m => Pipe i i r m r
+idP = Pipe return
+
+newtype WrapPipe m iu or = WrapPipe
+    { unWrapPipe :: Pipe (Fst iu) (Fst or) (Snd iu) m (Snd or) }
+
+instance Monad m => Category (WrapPipe m) where
+  id    = WrapPipe idP
+  x . y = WrapPipe (unWrapPipe y >+> unWrapPipe x)
diff --git a/libraries/base/tests/Concurrent/4876.stdout b/libraries/base/tests/Concurrent/4876.stdout
new file mode 100644
index 000000000000..00750edc07d6
--- /dev/null
+++ b/libraries/base/tests/Concurrent/4876.stdout
@@ -0,0 +1 @@
+3
diff --git a/libraries/base/tests/Concurrent/Chan001.hs b/libraries/base/tests/Concurrent/Chan001.hs
new file mode 100644
index 000000000000..e4b668ac4809
--- /dev/null
+++ b/libraries/base/tests/Concurrent/Chan001.hs
@@ -0,0 +1,109 @@
+import Debug.QuickCheck
+import System.IO.Unsafe
+import Control.Concurrent.Chan
+import Control.Concurrent
+import Control.Monad
+
+data Action = NewChan | ReadChan | WriteChan Int | IsEmptyChan | ReturnInt Int
+	    | ReturnBool Bool
+  deriving (Eq,Show)
+
+
+main = do 
+  t <- myThreadId
+  forkIO (threadDelay 1000000 >> killThread t)
+	-- just in case we deadlock
+  testChan
+
+testChan :: IO ()
+testChan = do
+  quickCheck prop_NewIs_NewRet
+  quickCheck prop_NewWriteIs_NewRet
+  quickCheck prop_NewWriteRead_NewRet
+
+
+prop_NewIs_NewRet = 
+  [NewChan,IsEmptyChan] =^ [NewChan,ReturnBool True]
+
+prop_NewWriteIs_NewRet n = 
+  [NewChan,WriteChan n,IsEmptyChan] =^ [NewChan,WriteChan n,ReturnBool False]
+
+prop_NewWriteRead_NewRet n = 
+  [NewChan,WriteChan n,ReadChan] =^ [NewChan,ReturnInt n]
+
+
+perform :: [Action] -> IO ([Bool],[Int])
+perform [] = return ([],[])
+
+perform (a:as) =
+  case a of
+    ReturnInt v	 -> liftM (\(b,l) -> (b,v:l)) (perform as)
+    ReturnBool v -> liftM (\(b,l) -> (v:b,l)) (perform as)
+    NewChan      -> newChan >>= \chan -> perform' chan as    
+    _		 -> error $ "Please use NewChan as first action"
+
+
+perform' :: Chan Int -> [Action] -> IO ([Bool],[Int])
+perform' _ [] = return ([],[])
+
+perform' chan (a:as) =
+  case a of
+    ReturnInt v	 -> liftM (\(b,l) -> (b,v:l)) (perform' chan as)
+    ReturnBool v -> liftM (\(b,l) -> (v:b,l)) (perform' chan as)
+    ReadChan     -> liftM2 (\v (b,l) -> (b,v:l)) (readChan chan) 
+			        (perform' chan as)
+    WriteChan n  -> writeChan chan n >> perform' chan as
+    IsEmptyChan  -> liftM2 (\v (b,l) -> (v:b,l)) (isEmptyChan chan)
+				(perform' chan as)
+    _		     -> error $ "If you want to use " ++ show a 
+				++ " please use the =^ operator"
+
+
+actions :: Gen [Action]
+actions =
+  liftM (NewChan:) (actions' 0)
+
+
+actions' :: Int -> Gen [Action]
+actions' contents =
+  oneof ([return [],
+	  liftM (IsEmptyChan:) (actions' contents),
+	  liftM2 (:) (liftM WriteChan arbitrary) (actions' (contents+1))]
+	  ++
+	  if contents==0
+	     then []
+	     else [liftM (ReadChan:) (actions' (contents-1))])
+
+
+(=^) :: [Action] -> [Action] -> Property
+c =^ c' =
+  forAll (actions' (delta 0 c))
+	 (\suff -> observe c suff == observe c' suff)
+  where observe x suff = unsafePerformIO (perform (x++suff))
+
+
+(^=^) :: [Action] -> [Action] -> Property
+c ^=^ c' =
+  forAll actions
+	 (\pref -> forAll (actions' (delta 0 (pref++c)))
+			  (\suff -> observe c pref suff == 
+				      observe c' pref suff))
+  where observe x pref suff = unsafePerformIO (perform (pref++x++suff))
+
+
+delta :: Int -> [Action] -> Int
+delta i [] = i
+
+delta i (ReturnInt _:as) = delta i as
+
+delta i (ReturnBool _:as) = delta i as
+
+delta _ (NewChan:as) = delta 0 as
+
+delta i (WriteChan _:as) = delta (i+1) as
+
+delta i (ReadChan:as) = delta (if i==0
+				  then error "read on empty Chan"
+				  else i-1) as
+
+delta i (IsEmptyChan:as) = delta i as
diff --git a/libraries/base/tests/Concurrent/Chan001.stdout b/libraries/base/tests/Concurrent/Chan001.stdout
new file mode 100644
index 000000000000..53bfa8a38142
--- /dev/null
+++ b/libraries/base/tests/Concurrent/Chan001.stdout
@@ -0,0 +1,3 @@
+0123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899OK, passed 100 tests.
+0123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899OK, passed 100 tests.
+0123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899OK, passed 100 tests.
diff --git a/libraries/base/tests/Concurrent/Chan002.hs b/libraries/base/tests/Concurrent/Chan002.hs
new file mode 100644
index 000000000000..812298ec655c
--- /dev/null
+++ b/libraries/base/tests/Concurrent/Chan002.hs
@@ -0,0 +1,19 @@
+import Control.Concurrent
+import Control.Exception
+import Control.Monad
+import System.IO
+import System.Environment
+
+-- test for deadlocks
+main = do
+  hSetBuffering stdout NoBuffering
+  [n] <- getArgs
+  replicateM_ (read n) $ do
+         chan <- newChan
+         wid <- forkIO $ forever $ writeChan chan (5::Int)
+         rid <- forkIO $ forever $ void $ readChan chan
+         threadDelay 1000
+         throwTo rid ThreadKilled
+         putStr "."
+         readChan chan
+         throwTo wid ThreadKilled
diff --git a/libraries/base/tests/Concurrent/Chan002.stdout b/libraries/base/tests/Concurrent/Chan002.stdout
new file mode 100644
index 000000000000..ab79b989a693
--- /dev/null
+++ b/libraries/base/tests/Concurrent/Chan002.stdout
@@ -0,0 +1 @@
+....................................................................................................
\ No newline at end of file
diff --git a/libraries/base/tests/Concurrent/Chan003.hs b/libraries/base/tests/Concurrent/Chan003.hs
new file mode 100644
index 000000000000..bfadaa85c7fc
--- /dev/null
+++ b/libraries/base/tests/Concurrent/Chan003.hs
@@ -0,0 +1,17 @@
+import Control.Concurrent
+import Control.Exception
+import Control.Monad
+import System.IO
+import System.Environment
+
+-- test for deadlocks
+main = do
+  hSetBuffering stdout NoBuffering
+  [n] <- getArgs
+  replicateM_ (read n) $ do
+         chan <- newChan
+         wid <- forkIO $ forever $ writeChan chan (5::Int)
+         threadDelay 3000
+         throwTo wid ThreadKilled
+         putStr "."
+         writeChan chan (3::Int)
diff --git a/libraries/base/tests/Concurrent/Chan003.stdout b/libraries/base/tests/Concurrent/Chan003.stdout
new file mode 100644
index 000000000000..e003cf11fad1
--- /dev/null
+++ b/libraries/base/tests/Concurrent/Chan003.stdout
@@ -0,0 +1 @@
+........................................................................................................................................................................................................
\ No newline at end of file
diff --git a/libraries/base/tests/Concurrent/MVar001.hs b/libraries/base/tests/Concurrent/MVar001.hs
new file mode 100644
index 000000000000..f787470c5199
--- /dev/null
+++ b/libraries/base/tests/Concurrent/MVar001.hs
@@ -0,0 +1,148 @@
+import Debug.QuickCheck
+import System.IO.Unsafe
+import Control.Concurrent.MVar
+import Control.Concurrent
+import Control.Monad
+
+
+data Action = NewEmptyMVar | NewMVar Int | TakeMVar | ReadMVar | PutMVar Int
+	    | SwapMVar Int | IsEmptyMVar | ReturnInt Int | ReturnBool Bool
+  deriving (Eq,Show)
+
+main = do 
+  t <- myThreadId
+  forkIO (threadDelay 1000000 >> killThread t)
+	-- just in case we deadlock
+  testMVar
+
+testMVar :: IO ()
+testMVar = do
+  quickCheck prop_NewEIs_NewERet
+  quickCheck prop_NewIs_NewRet
+  quickCheck prop_NewTake_NewRet
+  quickCheck prop_NewEPutTake_NewERet
+  quickCheck prop_NewRead_NewRet
+  quickCheck prop_NewSwap_New
+
+
+prop_NewEIs_NewERet = 
+  [NewEmptyMVar,IsEmptyMVar] =^ [NewEmptyMVar,ReturnBool True]
+
+prop_NewIs_NewRet n = 
+  [NewMVar n,IsEmptyMVar] =^ [NewMVar n,ReturnBool False]
+
+prop_NewTake_NewRet n =
+  [NewMVar n,TakeMVar] =^ [NewEmptyMVar,ReturnInt n]
+
+prop_NewEPutTake_NewERet n = 
+  [NewEmptyMVar,PutMVar n,TakeMVar] =^ 
+    [NewEmptyMVar,ReturnInt n]
+
+prop_NewRead_NewRet n = 
+  [NewMVar n,ReadMVar] =^ [NewMVar n,ReturnInt n]
+
+prop_NewSwap_New m n =
+  [NewMVar m,SwapMVar n] =^ [NewMVar n]
+
+
+perform :: [Action] -> IO ([Bool],[Int])
+perform [] = return ([],[])
+
+perform (a:as) =
+  case a of
+    ReturnInt v	 -> liftM (\(b,l) -> (b,v:l)) (perform as)
+    ReturnBool v -> liftM (\(b,l) -> (v:b,l)) (perform as)
+    NewEmptyMVar -> newEmptyMVar >>= \mv -> perform' mv as
+    NewMVar n    -> newMVar n >>= \mv -> perform' mv as    
+    _		 -> error $ "Please use NewMVar or NewEmptyMVar as first "
+			    ++ "action"
+
+
+perform' :: MVar Int -> [Action] -> IO ([Bool],[Int])
+perform' _ [] = return ([],[])
+
+perform' mv (a:as) =
+  case a of
+    ReturnInt v	 -> liftM (\(b,l) -> (b,v:l)) (perform' mv as)
+    ReturnBool v -> liftM (\(b,l) -> (v:b,l)) (perform' mv as)
+    TakeMVar     -> liftM2 (\v (b,l) -> (b,v:l)) (takeMVar mv) 
+			        (perform' mv as)
+    ReadMVar     -> liftM2 (\v (b,l) -> (b,v:l)) (readMVar mv) 
+			        (perform' mv as)
+    PutMVar n    -> putMVar mv n >> perform' mv as
+    SwapMVar n	 -> swapMVar mv n >> perform' mv as
+    IsEmptyMVar  -> liftM2 (\v (b,l) -> (v:b,l)) (isEmptyMVar mv)
+				(perform' mv as)
+    _		 -> error $ "If you want to use " ++ show a 
+			    ++ " please use the =^ operator"
+
+
+actions :: Gen [Action]
+actions = do
+  oneof [liftM (NewEmptyMVar:) (actions' True),
+	 liftM2 (:) (liftM NewMVar arbitrary) (actions' False)] 
+
+
+actions' :: Bool -> Gen [Action]
+actions' empty =
+  oneof ([return [],
+	  liftM (IsEmptyMVar:) (actions' empty)] ++
+	  if empty
+	     then [liftM2 (:) (liftM PutMVar arbitrary) (actions' False)]
+	     else []
+	  ++
+	  if empty
+	     then []
+	     else [liftM (TakeMVar:) (actions' True)]
+	  ++
+	  if empty
+	     then []
+	     else [liftM (ReadMVar:) (actions' False)]
+	  ++
+	  if empty
+	     then []
+	     else [liftM2 (:) (liftM SwapMVar arbitrary) (actions' False)]   )
+
+
+(=^) :: [Action] -> [Action] -> Property
+c =^ c' =
+  forAll (actions' (delta True c))
+	 (\suff -> observe c suff == observe c' suff)
+  where observe x suff = unsafePerformIO (perform (x++suff))
+
+
+(^=^) :: [Action] -> [Action] -> Property
+c ^=^ c' =
+  forAll actions
+	 (\pref -> forAll (actions' (delta True (pref++c)))
+			  (\suff -> observe c pref suff == 
+				      observe c' pref suff))
+  where observe x pref suff = unsafePerformIO (perform (pref++x++suff))
+
+
+delta :: Bool -> [Action] -> Bool
+delta b [] = b
+
+delta b (ReturnInt _:as) = delta b as
+
+delta b (ReturnBool _:as) = delta b as
+
+delta _ (NewEmptyMVar:as) = delta True as
+
+delta _ (NewMVar _:as) = delta False as
+
+delta b (TakeMVar:as) = delta (if b
+				  then error "take on empty MVar"
+				  else True) as
+
+delta b (ReadMVar:as) = delta (if b
+				  then error "read on empty MVar"
+				  else False) as
+
+delta _ (PutMVar _:as) = delta False as
+
+delta b (SwapMVar _:as) = delta (if b
+				  then error "swap on empty MVar"
+				  else False) as
+
+delta b (IsEmptyMVar:as) = delta b as
diff --git a/libraries/base/tests/Concurrent/MVar001.stdout b/libraries/base/tests/Concurrent/MVar001.stdout
new file mode 100644
index 000000000000..65be56c733ca
--- /dev/null
+++ b/libraries/base/tests/Concurrent/MVar001.stdout
@@ -0,0 +1,6 @@
+0123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899OK, passed 100 tests.
+0123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899OK, passed 100 tests.
+0123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899OK, passed 100 tests.
+0123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899OK, passed 100 tests.
+0123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899OK, passed 100 tests.
+0123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899OK, passed 100 tests.
diff --git a/libraries/base/tests/Concurrent/Makefile b/libraries/base/tests/Concurrent/Makefile
new file mode 100644
index 000000000000..4ca77510701c
--- /dev/null
+++ b/libraries/base/tests/Concurrent/Makefile
@@ -0,0 +1,7 @@
+# This Makefile runs the tests using GHC's testsuite framework.  It
+# assumes the package is part of a GHC build tree with the testsuite
+# installed in ../../../testsuite.
+
+TOP=../../../../testsuite
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
diff --git a/libraries/base/tests/Concurrent/ThreadDelay001.hs b/libraries/base/tests/Concurrent/ThreadDelay001.hs
new file mode 100644
index 000000000000..3b0f806e22bc
--- /dev/null
+++ b/libraries/base/tests/Concurrent/ThreadDelay001.hs
@@ -0,0 +1,27 @@
+
+-- Test that threadDelay actually sleeps for (at least) as long as we
+-- ask it
+
+module Main (main) where
+
+import Control.Concurrent
+import Control.Monad
+import Data.Time
+
+main :: IO ()
+main = mapM_ delay (0 : take 7 (iterate (*5) 100))
+
+delay :: Int -> IO ()
+delay n = do
+  tS <- getCurrentTime
+  threadDelay n
+  tE <- getCurrentTime
+
+  let req = fromIntegral n * 10 ^ (6 :: Int)
+      obs = floor (diffUTCTime tE tS * 10 ^ (12 :: Int))
+      diff = obs - req
+      diff' :: Double
+      diff' = fromIntegral diff /  10 ^ (12 :: Int)
+
+  when (obs < req) $ print (tS, tE, req, obs, diff, diff')
+
diff --git a/libraries/base/tests/Concurrent/all.T b/libraries/base/tests/Concurrent/all.T
new file mode 100644
index 000000000000..ae76fc77b168
--- /dev/null
+++ b/libraries/base/tests/Concurrent/all.T
@@ -0,0 +1,9 @@
+setTestOpts(only_compiler_types(['ghc']))
+
+test('Chan001',      reqlib('QuickCheck'), compile_and_run, ['-package QuickCheck'])
+
+test('Chan002',      extra_run_opts('100'), compile_and_run, [''])
+test('Chan003',      extra_run_opts('200'), compile_and_run, [''])
+
+test('MVar001',      reqlib('QuickCheck'), compile_and_run, ['-package QuickCheck'])
+test('ThreadDelay001', normal, compile_and_run, [''])
diff --git a/libraries/base/tests/IO/IOError001.hs b/libraries/base/tests/IO/IOError001.hs
new file mode 100644
index 000000000000..4f7c4b27d6c4
--- /dev/null
+++ b/libraries/base/tests/IO/IOError001.hs
@@ -0,0 +1,9 @@
+
+import System.IO.Error
+
+-- test for a bug in GHC <= 4.08.2: handles were being left locked after
+-- being shown in an error message.
+main = do
+  getContents
+  catchIOError getChar (\e -> print e >> return 'x')
+  catchIOError getChar (\e -> print e >> return 'x')
diff --git a/libraries/base/tests/IO/IOError001.stdout b/libraries/base/tests/IO/IOError001.stdout
new file mode 100644
index 000000000000..1e689bb0f96b
--- /dev/null
+++ b/libraries/base/tests/IO/IOError001.stdout
@@ -0,0 +1,2 @@
+<stdin>: hGetChar: illegal operation (handle is closed)
+<stdin>: hGetChar: illegal operation (handle is closed)
diff --git a/libraries/base/tests/IO/IOError001.stdout-hugs b/libraries/base/tests/IO/IOError001.stdout-hugs
new file mode 100644
index 000000000000..036084a006b0
--- /dev/null
+++ b/libraries/base/tests/IO/IOError001.stdout-hugs
@@ -0,0 +1,2 @@
+<stdin>: getChar: illegal operation (handle is semi-closed)
+<stdin>: getChar: illegal operation (handle is semi-closed)
diff --git a/libraries/base/tests/IO/IOError002.hs b/libraries/base/tests/IO/IOError002.hs
new file mode 100644
index 000000000000..144e62783b5a
--- /dev/null
+++ b/libraries/base/tests/IO/IOError002.hs
@@ -0,0 +1,5 @@
+-- !!! IOErrors should have Eq defined
+
+import System.IO
+
+main = print (userError "urk" == userError "urk")
diff --git a/libraries/base/tests/IO/IOError002.stdout b/libraries/base/tests/IO/IOError002.stdout
new file mode 100644
index 000000000000..0ca95142bb71
--- /dev/null
+++ b/libraries/base/tests/IO/IOError002.stdout
@@ -0,0 +1 @@
+True
diff --git a/libraries/base/tests/IO/Makefile b/libraries/base/tests/IO/Makefile
new file mode 100644
index 000000000000..9d5089d90e59
--- /dev/null
+++ b/libraries/base/tests/IO/Makefile
@@ -0,0 +1,52 @@
+# This Makefile runs the tests using GHC's testsuite framework.  It
+# assumes the package is part of a GHC build tree with the testsuite
+# installed in ../../../testsuite.
+
+TOP=../../../../testsuite
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
+
+test.concio001:
+	$(TEST_HC) $(TEST_HC_OPTS) --make -fforce-recomp -v0 concio001 -o concio001 
+	(sleep 1; echo x) | ./concio001
+
+test.concio001.thr:
+	$(TEST_HC) $(TEST_HC_OPTS) --make -fforce-recomp -v0 -threaded concio001 -o concio001 
+	(sleep 1; echo x) | ./concio001
+
+# NB. utf8-test should *not* have a final newline.  The last char should be 'X'.
+utf16-test: utf8-test
+	iconv -f UTF-8 -t UTF-16 <utf8-test >utf16-test
+
+utf16le-test: utf8-test
+	iconv -f UTF-8 -t UTF-16LE <utf8-test >utf16le-test
+
+utf16be-test: utf8-test
+	iconv -f UTF-8 -t UTF-16BE <utf8-test >utf16be-test
+
+utf32-test: utf8-test
+	iconv -f UTF-8 -t UTF-32 <utf8-test >utf32-test
+
+utf32le-test: utf8-test
+	iconv -f UTF-8 -t UTF-32LE <utf8-test >utf32le-test
+
+utf32be-test: utf8-test
+	iconv -f UTF-8 -t UTF-32BE <utf8-test >utf32be-test
+
+utf8-bom-test: utf16-test
+	iconv -f UTF-16LE -t UTF-8 <utf16-test >utf8-bom-test
+
+hSetEncoding001.in : latin1 utf8-test utf16le-test utf16be-test utf16-test utf32le-test utf32be-test utf32-test utf8-bom-test
+	cat >$@ latin1 utf8-test utf16le-test utf16be-test utf16-test utf32-test utf32le-test utf32be-test utf8-bom-test
+
+environment001-test:
+	"$(TEST_HC)" --make -fforce-recomp -v0 environment001.hs -o environment001 
+	GHC_TEST=马克斯 ./environment001 说
+
+T3307-test:
+	"$(TEST_HC)" --make -fforce-recomp -v0 T3307.hs -o T3307
+	echo Ni hao > chinese-file-�说
+	echo chinese-file-�说 > chinese-name
+	# The tests are run in whatever the default locale is. This is almost always UTF-8,
+	# but in cmd on Windows it will be the non-Unicode CP850 locale.
+	./T3307 chinese-file-�说
diff --git a/libraries/base/tests/IO/T2122.hs b/libraries/base/tests/IO/T2122.hs
new file mode 100644
index 000000000000..9a8badc2160a
--- /dev/null
+++ b/libraries/base/tests/IO/T2122.hs
@@ -0,0 +1,77 @@
+{-
+
+Before running this, check that /tmp/test does not exist and
+contain something important. Then do:
+
+ $ touch /tmp/test
+
+If you do:
+
+ $ runhaskell Test.hs
+
+it will work. If you do:
+
+ $ runhaskell Test.hs fail
+
+it will fail every time with:
+
+Test.hs: writeFile: /tmp/test: openFile: resource busy (file is locked)
+
+-}
+
+import Control.Monad
+import System.Directory
+import System.IO
+import System.IO.Error
+import System.Environment
+-- Used by test2:
+-- import System.Posix.IO
+
+fp = "T2122-test"
+
+main :: IO ()
+main = do
+   writeFile fp "test"
+   test True
+
+-- fails everytime when causeFailure is True in GHCi, with runhaskell,
+-- or when compiled.
+test :: Bool -> IO ()
+test causeFailure =
+    do h1 <- openFile fp ReadMode `catchIOError` (\e -> error ("openFile 1: " ++ show e))
+       when causeFailure $ do
+         h2 <- openFile fp ReadMode `catchIOError` (\e -> error ("openFile 2: " ++ show e))
+         hClose h2
+       hClose h1
+       removeFile fp
+       writeFile fp (show [1..100]) `catchIOError` (\e -> error ("writeFile: " ++ show e))
+
+{-
+-- this version never fails (except in GHCi, if test has previously failed).
+-- probably because openFd does not try to lock the file
+test2 :: Bool -> IO ()
+test2 causeFailure =
+    do fd1 <- openFd fp ReadOnly Nothing defaultFileFlags `catchIOError` (\e -> error ("openFile 1: " ++ show e))
+       when causeFailure $ do
+         fd2 <- openFd fp ReadOnly Nothing defaultFileFlags `catchIOError` (\e -> error ("openFile 2: " ++ show e))
+         closeFd fd2
+       closeFd fd1
+       removeFile fp
+       writeFile fp (show [1..100]) `catchIOError` (\e -> error ("writeFile: " ++ show e))
+-}
+
+{-
+-- fails sometimes when run repeated in GHCi, but seems fine with
+-- runhaskell or compiled
+test3 :: IO ()
+test3 =
+    do h1 <- openFile fp ReadMode `catchIOError` (\e -> error ("openFile 1: " ++ show e))
+       h2 <- openFile fp ReadMode `catchIOError` (\e -> error ("openFile 2: " ++ show e))
+       removeFile fp
+       writeFile fp (show [1..100]) `catchIOError` (\e -> error ("writeFile: " ++ show e))
+       print =<< hGetContents h1
+       print =<< hGetContents h2
+       hClose h2
+       hClose h1
+-}
+
diff --git a/libraries/base/tests/IO/T3307.hs b/libraries/base/tests/IO/T3307.hs
new file mode 100644
index 000000000000..fb1a360ea2af
--- /dev/null
+++ b/libraries/base/tests/IO/T3307.hs
@@ -0,0 +1,52 @@
+import Control.Exception
+
+import System.Directory
+import System.Environment
+import System.IO
+
+import Data.Char
+import Data.List
+
+import GHC.IO.Encoding
+
+main = do
+    hSetBuffering stdout NoBuffering
+
+    -- 1) A file name arriving via an argument
+    putStrLn "Test 1"
+    [file] <- getArgs
+    print $ map ord file
+    readFile file >>= putStr
+
+    -- 2) A file name arriving via getDirectoryContents
+    putStrLn "Test 2"
+    [file] <- fmap (filter ("chinese-file-" `isPrefixOf`)) $ getDirectoryContents "."
+    print $ map ord file
+    readFile file >>= putStr
+
+    -- 3) A file name occurring literally in the program
+    -- The file is created with a UTF-8 file name as well, so this will only work in Windows or a
+    -- UTF-8 locale, or this string will be encoded in some non-UTF-8 way and won't match.
+    putStrLn "Test 3"
+    let file = "chinese-file-�说"
+    print $ map ord file
+    readFile file >>= putStr
+
+    -- 4) A file name arriving via another file.
+    -- Again, the file is created with UTF-8 contents, so we read it in that encoding.
+    -- Once again, on non-Windows this may fail in a non-UTF-8 locale because we could encode the valid
+    -- filename string into a useless non-UTF-8 byte sequence.
+    putStrLn "Test 4"
+    str <- readFileAs utf8 "chinese-name"
+    let file = dropTrailingSpace str
+    print $ map ord file
+    readFile file >>= putStr
+
+readFileAs :: TextEncoding -> FilePath -> IO String
+readFileAs enc fp = do
+    h <- openFile fp ReadMode
+    hSetEncoding h enc
+    hGetContents h
+
+dropTrailingSpace :: String -> String
+dropTrailingSpace = reverse . dropWhile (not . isAlphaNum) . reverse
diff --git a/libraries/base/tests/IO/T3307.stdout b/libraries/base/tests/IO/T3307.stdout
new file mode 100644
index 000000000000..8b26b5ff1d9b
--- /dev/null
+++ b/libraries/base/tests/IO/T3307.stdout
@@ -0,0 +1,12 @@
+Test 1
+[99,104,105,110,101,115,101,45,102,105,108,101,45,23567,35828]
+Ni hao
+Test 2
+[99,104,105,110,101,115,101,45,102,105,108,101,45,23567,35828]
+Ni hao
+Test 3
+[99,104,105,110,101,115,101,45,102,105,108,101,45,23567,35828]
+Ni hao
+Test 4
+[99,104,105,110,101,115,101,45,102,105,108,101,45,23567,35828]
+Ni hao
diff --git a/libraries/base/tests/IO/T4144.hs b/libraries/base/tests/IO/T4144.hs
new file mode 100644
index 000000000000..ca14363682e9
--- /dev/null
+++ b/libraries/base/tests/IO/T4144.hs
@@ -0,0 +1,115 @@
+{-# LANGUAGE OverloadedStrings, DeriveDataTypeable #-}
+module Main (main) where
+
+import Control.Applicative
+import Control.Concurrent.MVar
+import Control.Monad
+
+import Data.ByteString (ByteString)
+import qualified Data.ByteString as B
+import qualified Data.ByteString.Char8
+import Data.ByteString.Char8()
+import Data.ByteString.Unsafe as B
+import Data.ByteString.Internal (memcpy)
+import Data.Typeable (Typeable)
+import Data.Word
+
+import Foreign
+
+import GHC.IO.Buffer
+import GHC.IO.BufferedIO
+import GHC.IO.Device
+import GHC.IO.Handle
+
+import System.IO
+
+-- | Create a seakable read-handle from a bytestring
+bsHandle :: ByteString -> FilePath -> IO Handle
+bsHandle bs fp
+    = newBsDevice bs >>= \dev ->
+      mkFileHandle dev fp ReadMode Nothing noNewlineTranslation
+
+data BSIODevice
+    = BSIODevice
+       ByteString
+       (MVar Int) -- Position
+ deriving Typeable
+
+newBsDevice :: ByteString -> IO BSIODevice
+newBsDevice bs = BSIODevice bs <$> newMVar 0
+
+remaining :: BSIODevice -> IO Int
+remaining (BSIODevice bs mPos)
+    = do
+  let bsLen = B.length bs
+  withMVar mPos $ \pos -> return (bsLen - pos)
+
+sizeBS :: BSIODevice -> Int
+sizeBS (BSIODevice bs _) = B.length bs
+
+seekBS :: BSIODevice -> SeekMode -> Int -> IO ()
+seekBS dev AbsoluteSeek pos
+    | pos < 0 = error "Cannot seek to a negative position!"
+    | pos > sizeBS dev = error "Cannot seek past end of handle!"
+    | otherwise = case dev of
+                    BSIODevice _ mPos
+                        -> modifyMVar_ mPos $ \_ -> return pos
+seekBS dev SeekFromEnd pos = seekBS dev AbsoluteSeek (sizeBS dev - pos)
+seekBS dev RelativeSeek pos
+    = case dev of
+        BSIODevice _bs mPos
+            -> modifyMVar_ mPos $ \curPos ->
+               let newPos = curPos + pos
+               in if newPos < 0 || newPos > sizeBS dev
+                  then error "Cannot seek outside of handle!"
+                  else return newPos
+
+tellBS :: BSIODevice -> IO Int
+tellBS (BSIODevice _ mPos) = readMVar mPos
+
+dupBS :: BSIODevice -> IO BSIODevice
+dupBS (BSIODevice bs mPos) = BSIODevice bs <$> (readMVar mPos >>= newMVar)
+
+readBS :: BSIODevice -> Ptr Word8 -> Int -> IO Int
+readBS dev@(BSIODevice bs mPos) buff amount
+    = do
+  rem <- remaining dev
+  if amount > rem
+   then readBS dev buff rem
+   else B.unsafeUseAsCString bs $ \ptr ->
+       do
+         memcpy buff (castPtr ptr) (fromIntegral amount)
+         modifyMVar_ mPos (return . (+amount))
+         return amount
+
+instance BufferedIO BSIODevice where
+    newBuffer dev buffState = newByteBuffer (sizeBS dev) buffState
+    fillReadBuffer dev buff = readBuf dev buff
+    fillReadBuffer0 dev buff
+        = do
+      (amount, buff') <- fillReadBuffer dev buff
+      return (if amount == 0 then Nothing else Just amount, buff')
+
+instance RawIO BSIODevice where
+    read = readBS
+    readNonBlocking dev buff n = Just `liftM` readBS dev buff n
+
+instance IODevice BSIODevice where
+    ready _ True _ = return False -- read only
+    ready _ False _ = return True -- always ready
+
+    close _ = return ()
+    isTerminal _ = return False
+    isSeekable _ = return True
+    seek dev seekMode pos = seekBS dev seekMode (fromIntegral pos)
+    tell dev = fromIntegral <$> tellBS dev
+    getSize dev = return $ fromIntegral $ sizeBS dev
+    setEcho _ _ = error "Not a terminal device"
+    getEcho _ = error "Not a terminal device"
+    setRaw _ _ = error "Raw mode not supported"
+    devType _ = return RegularFile
+    dup = dupBS
+    dup2 _ _ = error "Dup2 not supported"
+
+
+main = bsHandle "test" "<fake file>" >>= Data.ByteString.Char8.hGetContents >>= print
diff --git a/libraries/base/tests/IO/T4144.stdout b/libraries/base/tests/IO/T4144.stdout
new file mode 100644
index 000000000000..8b8441b91da7
--- /dev/null
+++ b/libraries/base/tests/IO/T4144.stdout
@@ -0,0 +1 @@
+"test"
diff --git a/libraries/base/tests/IO/T4808.hs b/libraries/base/tests/IO/T4808.hs
new file mode 100644
index 000000000000..652b792ed967
--- /dev/null
+++ b/libraries/base/tests/IO/T4808.hs
@@ -0,0 +1,13 @@
+import System.IO
+import GHC.IO.Handle
+import GHC.IO.FD as FD
+
+main = do
+  writeFile "T4808.test" "This is some test data"
+  (fd, _) <- FD.openFile "T4808.test" ReadWriteMode False
+  hdl <- mkDuplexHandle fd "T4808.test" Nothing nativeNewlineMode
+  hClose hdl
+  (fd2, _) <- FD.openFile "T4808.test" ReadWriteMode False
+  print (fdFD fd == fdFD fd2) -- should be True
+  hGetLine hdl >>= print -- should fail with an exception
+
diff --git a/libraries/base/tests/IO/T4808.stderr b/libraries/base/tests/IO/T4808.stderr
new file mode 100644
index 000000000000..0b7a89fb80f3
--- /dev/null
+++ b/libraries/base/tests/IO/T4808.stderr
@@ -0,0 +1 @@
+T4808: T4808.test: hGetLine: illegal operation (handle is closed)
diff --git a/libraries/base/tests/IO/T4808.stdout b/libraries/base/tests/IO/T4808.stdout
new file mode 100644
index 000000000000..0ca95142bb71
--- /dev/null
+++ b/libraries/base/tests/IO/T4808.stdout
@@ -0,0 +1 @@
+True
diff --git a/libraries/base/tests/IO/T4855.hs b/libraries/base/tests/IO/T4855.hs
new file mode 100644
index 000000000000..fa862aaf1451
--- /dev/null
+++ b/libraries/base/tests/IO/T4855.hs
@@ -0,0 +1,3 @@
+import Debug.Trace
+
+main = trace "我爱我的电脑" $ return ()
\ No newline at end of file
diff --git a/libraries/base/tests/IO/T4855.stderr b/libraries/base/tests/IO/T4855.stderr
new file mode 100644
index 000000000000..558550e22913
--- /dev/null
+++ b/libraries/base/tests/IO/T4855.stderr
@@ -0,0 +1 @@
+我爱我的电脑
diff --git a/libraries/base/tests/IO/T4895.hs b/libraries/base/tests/IO/T4895.hs
new file mode 100644
index 000000000000..486743463c8d
--- /dev/null
+++ b/libraries/base/tests/IO/T4895.hs
@@ -0,0 +1,9 @@
+module Main where
+import Foreign.Marshal.Alloc
+import System.IO
+
+main = do
+  h <- openBinaryFile "T4895.hs" ReadMode
+  allocaBytes 10 $ \ptr -> hGetBuf h ptr 10
+  some <- allocaBytes 10 $ \ptr -> hGetBufSome h ptr 10
+  print some
diff --git a/libraries/base/tests/IO/T4895.stdout b/libraries/base/tests/IO/T4895.stdout
new file mode 100644
index 000000000000..f599e28b8ab0
--- /dev/null
+++ b/libraries/base/tests/IO/T4895.stdout
@@ -0,0 +1 @@
+10
diff --git a/libraries/base/tests/IO/T7853.hs b/libraries/base/tests/IO/T7853.hs
new file mode 100644
index 000000000000..382942efffcc
--- /dev/null
+++ b/libraries/base/tests/IO/T7853.hs
@@ -0,0 +1,28 @@
+import qualified Data.ByteString as BS
+import System.IO
+import GHC.Foreign
+import Control.Exception
+import Data.Word
+
+decode :: TextEncoding -> BS.ByteString -> IO (Either SomeException String)
+decode enc bs = try $ BS.useAsCStringLen bs $ peekCStringLen enc
+
+main :: IO ()
+main = mapM_ go [ ["01111111"] -- (just fits into 1 byte)
+                , ["11000010", "10000000"] -- (just large enough for 2 bytes)
+                , ["11000001", "10111111"] -- (overlong: only 7 bits, so should fit into 1 byte)
+                , ["11011111", "10111111"] -- (just fits into 2 bytes)
+                , ["11100000", "10100000", "10000000"] -- (just large enough for 3 bytes)
+                , ["11100000", "10011111", "10111111"] -- (overlong: only 11 bits, so should fit into 2 bytes)
+                , ["11101111", "10111111", "10111111"] -- (just fits into 3 bytes)
+                , ["11110000", "10010000", "10000000", "10000000"] -- (just large enough for 4 bytes)
+                , ["11110000", "10001111", "10111111", "10111111"] -- (overlong: only 16 bits, so should fit into 3 bytes)
+                , ["11110100", "10001111", "10111111", "10111111"] -- (largest allowed codepoint)
+                , ["11110111", "10111111", "10111111", "10111111"] -- (just fits into 4 bytes but disallowed by RFC3629)
+                ]
+  where go xs = decode utf8 (BS.pack (map toByte xs)) >>= either (\_ -> putStrLn "Error") print
+
+toByte :: String -> Word8
+toByte [] = 0
+toByte ('1':xs) = (2 ^ length xs) + toByte xs
+toByte ('0':xs) = toByte xs
diff --git a/libraries/base/tests/IO/T7853.stdout b/libraries/base/tests/IO/T7853.stdout
new file mode 100644
index 000000000000..09b25da15f91
--- /dev/null
+++ b/libraries/base/tests/IO/T7853.stdout
@@ -0,0 +1,11 @@
+"\DEL"
+"\128"
+Error
+"\2047"
+"\2048"
+Error
+"\65535"
+"\65536"
+Error
+"\1114111"
+Error
diff --git a/libraries/base/tests/IO/all.T b/libraries/base/tests/IO/all.T
new file mode 100644
index 000000000000..e15c84d9f835
--- /dev/null
+++ b/libraries/base/tests/IO/all.T
@@ -0,0 +1,164 @@
+# -*- coding: utf-8 -*-
+
+def expect_fail_if_windows(name, opts):
+   f = when(opsys('mingw32'), expect_fail);
+   return f(normal, opts);
+
+test('IOError001', [omit_ways(['ghci']), set_stdin('IOError001.hs')],
+	compile_and_run, [''])
+
+test('IOError002',      normal, compile_and_run, [''])
+test('finalization001', normal, compile_and_run, [''])
+test('hClose001',       extra_clean(['hClose001.tmp']), compile_and_run, [''])
+test('hClose002',       extra_clean(['hClose002.tmp']), compile_and_run, [''])
+test('hClose003',       reqlib('unix'), compile_and_run, ['-package unix'])
+test('hFileSize001',    normal, compile_and_run, [''])
+test('hFileSize002',
+     [omit_ways(['ghci']),
+      extra_clean(['hFileSize002.out'])],
+     compile_and_run, [''])
+test('hFlush001',
+     extra_clean(['hFlush001.out']),
+     compile_and_run, [''])
+
+test('hGetBuffering001', 
+	[omit_ways(['ghci']), set_stdin('hGetBuffering001.hs')], 
+	compile_and_run, [''])
+
+test('hGetChar001', normal, compile_and_run, [''])
+test('hGetLine001', set_stdin('hGetLine001.hs'), compile_and_run, ['-cpp'])
+test('hGetLine002', normal, compile_and_run, [''])
+test('hGetLine003', normal, compile_and_run, [''])
+test('hGetPosn001',
+     extra_clean(['hGetPosn001.out']),
+     compile_and_run, ['-cpp'])
+test('hIsEOF001',   normal, compile_and_run, [''])
+test('hIsEOF002', extra_clean(['hIsEOF002.out']), compile_and_run, ['-cpp'])
+
+test('hReady001', normal, compile_and_run, ['-cpp'])
+
+# hReady002 tests that hReady returns False for a pipe that has no
+# data to read.  It relies on piping input from 'sleep 1', which doesn't
+# work for the 'ghci' way because in that case we already pipe input from
+# a script, so hence omit_ways(['ghci'])
+test('hReady002', [ no_stdin, cmd_prefix('sleep 1 |'),
+                    omit_ways(['ghci']) ],
+                   compile_and_run, [''])
+
+test('hSeek001', normal, compile_and_run, [''])
+test('hSeek002', normal, compile_and_run, ['-cpp'])
+test('hSeek003', normal, compile_and_run, ['-cpp'])
+test('hSeek004', extra_clean(['hSeek004.out']), compile_and_run, ['-cpp'])
+
+test('hSetBuffering002', set_stdin('hSetBuffering002.hs'), compile_and_run, [''])
+
+test('hSetBuffering003',
+    [omit_ways(['ghci']), set_stdin('hSetBuffering003.hs')], 
+	compile_and_run, [''])
+
+test('hSetBuffering004', set_stdin('hSetBuffering004.hs'), compile_and_run, [''])
+
+test('ioeGetErrorString001', normal, compile_and_run, ['-cpp'])
+test('ioeGetFileName001',    normal, compile_and_run, ['-cpp'])
+test('ioeGetHandle001',      normal, compile_and_run, ['-cpp'])
+test('isEOF001',     normal, compile_and_run, [''])
+
+test('misc001',
+     [extra_run_opts('misc001.hs misc001.out'),
+      extra_clean(['misc001.out'])],
+	compile_and_run, [''])
+
+test('openFile001',  normal, compile_and_run, [''])
+test('openFile002',  exit_code(1), compile_and_run, [''])
+test('openFile003',  extra_clean(['openFile003Dir']), compile_and_run, [''])
+test('openFile004',  extra_clean(['openFile004.out']), compile_and_run, [''])
+test('openFile005',
+     [when(compiler_type('hugs'), expect_fail),
+      extra_clean(['openFile005.out1', 'openFile005.out2'])],
+     compile_and_run, [''])
+test('openFile006', extra_clean(['openFile006.out']), compile_and_run, [''])
+test('openFile007',
+     [when(compiler_type('hugs'), expect_fail),
+      extra_clean(['openFile007.out'])],
+     compile_and_run, [''])
+test('openFile008', cmd_prefix('ulimit -n 1024; '), compile_and_run, [''])
+
+test('putStr001',    normal, compile_and_run, [''])
+test('readFile001',
+     [when(compiler_type('hugs'), expect_fail),
+      extra_clean(['readFile001.out'])],
+     compile_and_run, [''])
+test('readwrite001',
+     extra_clean(['readwrite001.inout']),
+     compile_and_run,
+     ['-cpp'])
+
+
+test('readwrite002',
+     [omit_ways(['ghci']), 
+      set_stdin('readwrite002.hs'),
+      extra_clean(['readwrite002.inout'])],
+     compile_and_run, ['-cpp'])
+
+test('readwrite003', extra_clean(['readwrite003.txt']), compile_and_run, [''])
+
+test('hGetBuf001',
+     [only_compiler_types(['ghc']),
+      when(fast(), skip),
+      expect_fail_if_windows],
+     compile_and_run, ['-package unix'])
+
+test('hDuplicateTo001', extra_clean(['tmp']), compile_and_run, [''])
+
+test('countReaders001',
+      extra_clean(['countReaders001.txt']),
+      compile_and_run, [''])
+
+test('concio001', skip, run_command, ['$MAKE -s --no-print-directory test.concio001'])
+test('concio001.thr', skip, run_command, ['$MAKE -s --no-print-directory test.concio001.thr'])
+
+test('concio002', reqlib('process'), compile_and_run, [''])
+
+test('T2122', extra_clean(['T2122-test']), compile_and_run, [''])
+test('T3307',
+     [extra_clean(['chinese-file-�说', 'chinese-name'])],
+     run_command,
+     ['$MAKE -s --no-print-directory T3307-test'])
+test('T4855', normal, compile_and_run, [''])
+
+test('hSetEncoding001',extra_run_opts('hSetEncoding001.in'), compile_and_run, [''])
+test('decodingerror001',normal, compile_and_run, [''])
+test('decodingerror002',normal, compile_and_run, [''])
+
+encoding001Encodings = ["utf8", "utf8_bom", "utf16", "utf16le",
+                        "utf16be", "utf32", "utf32le", "utf32be"]
+encoding001CleanFiles = []
+for e in encoding001Encodings:
+    encoding001CleanFiles.append('encoding001.' + e)
+for e1 in encoding001Encodings:
+    for e2 in encoding001Encodings:
+        encoding001CleanFiles.append('encoding001.' + e1 + '.' + e2)
+test('encoding001',
+     extra_clean(encoding001CleanFiles),
+     compile_and_run, [''])
+
+test('encoding002', normal, compile_and_run, [''])
+test('encoding003', normal, compile_and_run, [''])
+test('encoding004', normal, compile_and_run, [''])
+
+test('environment001',
+     [extra_clean(['environment001'])],
+     run_command,
+     ['$MAKE -s --no-print-directory environment001-test'])
+
+test('newline001', extra_clean(['newline001.out']), compile_and_run, [''])
+
+test('openTempFile001', normal, compile_and_run, [''])
+
+test('T4144', normal, compile_and_run, [''])
+
+test('encodingerror001', normal, compile_and_run, [''])
+
+test('T4808', [exit_code(1), extra_clean(['T4808.test'])], compile_and_run, [''])
+test('T4895', normal, compile_and_run, [''])
+test('T7853', normal, compile_and_run, [''])
diff --git a/libraries/base/tests/IO/concio001.hs b/libraries/base/tests/IO/concio001.hs
new file mode 100644
index 000000000000..786a311ce57f
--- /dev/null
+++ b/libraries/base/tests/IO/concio001.hs
@@ -0,0 +1,6 @@
+import Control.Concurrent
+
+main = do
+  forkIO $ do threadDelay  100000; putStrLn "child"
+  getLine
+  putStrLn "parent"
diff --git a/libraries/base/tests/IO/concio001.stdout b/libraries/base/tests/IO/concio001.stdout
new file mode 100644
index 000000000000..141a8cd80c53
--- /dev/null
+++ b/libraries/base/tests/IO/concio001.stdout
@@ -0,0 +1,2 @@
+child
+parent
diff --git a/libraries/base/tests/IO/concio001.thr.stdout b/libraries/base/tests/IO/concio001.thr.stdout
new file mode 100644
index 000000000000..141a8cd80c53
--- /dev/null
+++ b/libraries/base/tests/IO/concio001.thr.stdout
@@ -0,0 +1,2 @@
+child
+parent
diff --git a/libraries/base/tests/IO/concio002.hs b/libraries/base/tests/IO/concio002.hs
new file mode 100644
index 000000000000..60a2ed2a89f6
--- /dev/null
+++ b/libraries/base/tests/IO/concio002.hs
@@ -0,0 +1,14 @@
+import System.Process
+import System.IO
+import Control.Concurrent
+
+main = do
+  (hin,hout,herr,ph) <- runInteractiveProcess "cat" [] Nothing Nothing
+  forkIO $ do threadDelay 100000
+              putStrLn "child"
+              hFlush stdout
+              hPutStrLn hin "msg"
+              hFlush hin
+  putStrLn "parent1"
+  hGetLine hout >>= putStrLn
+  putStrLn "parent2"
diff --git a/libraries/base/tests/IO/concio002.stdout b/libraries/base/tests/IO/concio002.stdout
new file mode 100644
index 000000000000..32640aede51f
--- /dev/null
+++ b/libraries/base/tests/IO/concio002.stdout
@@ -0,0 +1,4 @@
+parent1
+child
+msg
+parent2
diff --git a/libraries/base/tests/IO/countReaders001.hs b/libraries/base/tests/IO/countReaders001.hs
new file mode 100644
index 000000000000..2648ae77ae40
--- /dev/null
+++ b/libraries/base/tests/IO/countReaders001.hs
@@ -0,0 +1,17 @@
+-- test for trac #629. We need to keep track of how many readers
+-- there are rather than closing the first read handle causing the
+-- lock to be released.
+
+import System.IO
+import System.IO.Error
+
+file = "countReaders001.txt"
+
+main = do
+  writeFile file "foo"
+
+  h1 <- openFile file ReadMode
+  h2 <- openFile file ReadMode
+  hClose h1
+  tryIOError (openFile file AppendMode) >>= print
+
diff --git a/libraries/base/tests/IO/countReaders001.stdout b/libraries/base/tests/IO/countReaders001.stdout
new file mode 100644
index 000000000000..41644bff373b
--- /dev/null
+++ b/libraries/base/tests/IO/countReaders001.stdout
@@ -0,0 +1 @@
+Left countReaders001.txt: openFile: resource busy (file is locked)
diff --git a/libraries/base/tests/IO/decodingerror001.hs b/libraries/base/tests/IO/decodingerror001.hs
new file mode 100644
index 000000000000..15663c412dba
--- /dev/null
+++ b/libraries/base/tests/IO/decodingerror001.hs
@@ -0,0 +1,22 @@
+import Control.Monad
+import System.IO
+import System.IO.Error
+import GHC.IO.Encoding (utf8)
+import GHC.IO.Handle (hSetEncoding)
+
+testfiles = ["decodingerror001.in1", "decodingerror001.in2"]
+
+main = mapM_ alltests testfiles
+
+alltests file = mapM (test file)  [NoBuffering,
+                                   LineBuffering,
+                                   BlockBuffering Nothing,
+                                   BlockBuffering (Just 9),
+                                   BlockBuffering (Just 23) ]
+
+test file bufmode = do
+  h <- openFile file ReadMode
+  hSetEncoding h utf8
+  hSetBuffering h bufmode
+  e <- tryIOError $ forever $ hGetChar h >>= putChar
+  print (e :: Either IOError ())
diff --git a/libraries/base/tests/IO/decodingerror001.in1 b/libraries/base/tests/IO/decodingerror001.in1
new file mode 100644
index 000000000000..7686e7b2f4f2
--- /dev/null
+++ b/libraries/base/tests/IO/decodingerror001.in1
@@ -0,0 +1 @@
+UTF8 error:€after error
diff --git a/libraries/base/tests/IO/decodingerror001.in2 b/libraries/base/tests/IO/decodingerror001.in2
new file mode 100644
index 000000000000..fe33bd3883d2
--- /dev/null
+++ b/libraries/base/tests/IO/decodingerror001.in2
@@ -0,0 +1 @@
+UTF8 incomplete sequence at end:ð�
\ No newline at end of file
diff --git a/libraries/base/tests/IO/decodingerror001.stdout b/libraries/base/tests/IO/decodingerror001.stdout
new file mode 100644
index 000000000000..24ca1a95b08c
--- /dev/null
+++ b/libraries/base/tests/IO/decodingerror001.stdout
@@ -0,0 +1,10 @@
+UTF8 error:Left decodingerror001.in1: hGetChar: invalid argument (invalid byte sequence)
+UTF8 error:Left decodingerror001.in1: hGetChar: invalid argument (invalid byte sequence)
+UTF8 error:Left decodingerror001.in1: hGetChar: invalid argument (invalid byte sequence)
+UTF8 error:Left decodingerror001.in1: hGetChar: invalid argument (invalid byte sequence)
+UTF8 error:Left decodingerror001.in1: hGetChar: invalid argument (invalid byte sequence)
+UTF8 incomplete sequence at end:Left decodingerror001.in2: hGetChar: invalid argument (invalid byte sequence)
+UTF8 incomplete sequence at end:Left decodingerror001.in2: hGetChar: invalid argument (invalid byte sequence)
+UTF8 incomplete sequence at end:Left decodingerror001.in2: hGetChar: invalid argument (invalid byte sequence)
+UTF8 incomplete sequence at end:Left decodingerror001.in2: hGetChar: invalid argument (invalid byte sequence)
+UTF8 incomplete sequence at end:Left decodingerror001.in2: hGetChar: invalid argument (invalid byte sequence)
diff --git a/libraries/base/tests/IO/decodingerror002.hs b/libraries/base/tests/IO/decodingerror002.hs
new file mode 100644
index 000000000000..06cc6fd45ec7
--- /dev/null
+++ b/libraries/base/tests/IO/decodingerror002.hs
@@ -0,0 +1,23 @@
+import Control.Monad
+import System.IO
+import System.IO.Error
+import GHC.IO.Handle (hSetEncoding)
+
+main = do
+  -- Explicitly set stdout encoding so that the UTF8//ROUNDTRIP
+  -- test is always able to write the surrogate byte out without error.
+  enc <- mkTextEncoding "UTF-8//ROUNDTRIP"
+  hSetEncoding stdout enc
+  alltests "decodingerror002.in"
+
+alltests file = mapM (test file)  ["UTF-8",
+                                   "UTF-8//IGNORE",
+                                   "UTF-8//TRANSLIT",
+                                   "UTF-8//ROUNDTRIP"]
+
+test file enc_name = do
+  h <- openFile file ReadMode
+  enc <- mkTextEncoding enc_name
+  hSetEncoding h enc
+  e <- tryIOError $ forever $ hGetChar h >>= putChar
+  print (e :: Either IOError ())
diff --git a/libraries/base/tests/IO/decodingerror002.in b/libraries/base/tests/IO/decodingerror002.in
new file mode 100644
index 000000000000..195ee38114e6
--- /dev/null
+++ b/libraries/base/tests/IO/decodingerror002.in
@@ -0,0 +1 @@
+È
\ No newline at end of file
diff --git a/libraries/base/tests/IO/decodingerror002.stdout b/libraries/base/tests/IO/decodingerror002.stdout
new file mode 100644
index 000000000000..e1cef33d0da3
--- /dev/null
+++ b/libraries/base/tests/IO/decodingerror002.stdout
@@ -0,0 +1,4 @@
+Left decodingerror002.in: hGetChar: invalid argument (invalid byte sequence)
+Left decodingerror002.in: hGetChar: end of file
+�Left decodingerror002.in: hGetChar: end of file
+ÈLeft decodingerror002.in: hGetChar: end of file
diff --git a/libraries/base/tests/IO/encoded-data/CP1251-UTF8.txt b/libraries/base/tests/IO/encoded-data/CP1251-UTF8.txt
new file mode 100644
index 000000000000..21564fb7dcaf
--- /dev/null
+++ b/libraries/base/tests/IO/encoded-data/CP1251-UTF8.txt
@@ -0,0 +1,34 @@
+В начале июл�, в чрезвычайно жаркое врем�, под вечер, один молодой человек вышел из �воей каморки, которую нанимал от жильцов в С-м переулке, на улицу и медленно, как бы в нерешимо�ти, отправил�� к К-ну мо�ту.
+Он благополучно избегнул в�тречи � �воею хоз�йкой на ле�тнице. Каморка его приходила�ь под �амою кровлей вы�окого п�ти�тажного дома и походила более на шкаф, чем на квартиру. Квартирна� же хоз�йка его, у которой он нанимал �ту каморку � обедом и при�лугой, помещала�ь одною ле�тницей ниже, в отдельной квартире, и каждый раз, при выходе на улицу, ему непременно надо было проходить мимо хоз�йкиной кухни, почти в�егда на�тежь отворенной на ле�тницу. И каждый раз молодой человек, проход� мимо, чув�твовал какое-то болезненное и тру�ливое ощущение, которого �тыдил�� и от которого морщил��. Он был должен кругом хоз�йке и бо�л�� � нею в�третить��.
+�е то чтоб он был так тру�лив и забит, �ов�ем даже напротив; но � некоторого времени он был в раздражительном и напр�женном �о�то�нии похожем на ипохондрию. Он до того углубил�� в �еб� и уединил�� от в�ех, что бо�л�� даже в��кой в�тречи, не только в�тречи � хоз�йкой. Он был задавлен бедно�тью; но даже �те�ненное положение пере�тало в по�леднее врем� т�готить его. �а�ущными делами �воими он �ов�ем пере�тал и не хотел занимать��. �икакой хоз�йки, в �ущно�ти, он не бо�л��, что бы та ни замышл�ла против него. �о о�танавливать�� на ле�тнице, �лушать в��кий взор про в�ю �ту обыденную дребедень, до которой ему нет никакого дела, в�е �ти при�тавани� о платеже, угрозы, жалобы, и при �том �амому изворачивать��, извин�ть��, лгать, — нет уж, лучше про�кользнуть как-нибудь кошкой по ле�тнице и улизнуть, чтобы никто не видал.
+Впрочем, на �тот раз �трах в�тречи � �воею кредиторшей даже его �амого поразил по выходе на улицу.
+«�а какое дело хочу поку�ить�� и в то же врем� каких пу�т�ков бою�ь! — подумал он � �транною улыбкой. — Гм… да… в�е в руках человека, и в�е-то он мимо но�у проно�ит, един�твенно от одной тру�о�ти… �то уж ак�иома… Любопытно, чего люди больше бо�т��? �ового шага, нового �об�твенного �лова они в�его больше бо�т��… � впрочем, � �лишком много болтаю. Оттого и ничего не делаю, что болтаю. Пожалуй, впрочем, и так: оттого болтаю, что ничего не делаю. Это � в �тот по�ледний ме��ц выучил�� болтать, лежа по целым �уткам в углу и дума�… о царе Горохе. �у зачем � теперь иду? Разве � �по�обен на �то? Разве �то �ерьезно? Сов�ем не �ерьезно. Так ради фантазии �ам �еб� тешу; игрушки! Да, пожалуй что и игрушки!»
+�а улице жара �то�ла �трашна�, к тому же духота, толкотн�, в�юду изве�тка, ле�а, кирпич, пыль и та о�обенна� летн�� вонь, �толь изве�тна� каждому петербуржцу, не имеющему возможно�ти нан�ть дачу, — в�е �то разом непри�тно потр��ло и без того уже ра��троенные нервы юноши. �е�терпима� же вонь из ра�пивочных, которых в �той ча�ти города о�обенное множе�тво, и пь�ные, поминутно попадавшие��, не�мотр� на буднее врем�, довершили отвратительный и гру�тный колорит картины. Чув�тво глубочайшего омерзени� мелькнуло на миг в тонких чертах молодого человека. К�тати, он был замечательно хорош �обою, � прекра�ными темными глазами, темно-ру�, ро�том выше �реднего, тонок и �троен. �о �коро он впал как бы в глубокую задумчиво�ть, даже, вернее �казать, как бы в какое-то забытье, и пошел, уже не замеча� окружающего, да и не жела� его замечать. Изредка только бормотал он что-то про �еб�, от �воей привычки к монологам, в которой он �ейча� �ам �ебе признал��. В �ту же минуту он и �ам �ознавал, что мы�ли его порою мешают�� и что он очень �лаб: второй день как уж он почти �ов�ем ничего не ел.
+Он был до того худо одет, что иной, даже и привычный человек, по�ове�тил�� бы днем выходить в таких лохмоть�х на улицу. Впрочем, квартал был таков, что ко�тюмом зде�ь было трудно кого-нибудь удивить. Близо�ть Сенной, обилие изве�тных заведений и, по преимуще�тву, цеховое и реме�ленное на�еление, �кученное в �тих �ерединных петербург�ких улицах и переулках, пе�трили иногда общую панораму такими �убъектами, что �транно было бы и удивл�ть�� при в�трече � иною фигурой. �о �только злобного презрени� уже накопило�ь в душе молодого человека, что, не�мотр� на в�ю �вою, иногда очень молодую, щекотливо�ть, он менее в�его �ове�тил�� �воих лохмотьев на улице. Другое дело при в�трече � иными знакомыми или � прежними товарищами, � которыми вообще он не любил в�тречать��… � между тем, когда один пь�ный, которого неизве�тно почему и куда провозили в �то врем� по улице в огромной телеге, запр�женной огромною ломовою лошадью, крикнул ему вдруг, проезжа�: «Эй ты, немецкий шл�пник!» — и заорал во в�е горло, указыва� на него рукой, — молодой человек вдруг о�тановил�� и �удорожно �хватил�� за �вою шл�пу. Шл�па �та была вы�ока�, кругла�, циммерманов�ка�, но в�� уже изношенна�, �ов�ем рыжа�, в�� в дырах и п�тнах, без полей и �амым безобразнейшим углом заломивша��� на �торону. �о не �тыд, а �ов�ем другое чув�тво, похожее даже на и�пуг, охватило его.
+— Я так и знал! — бормотал он в �мущении, — � так и думал! Это уж в�его �квернее! Вот �дака� кака�-нибудь глупо�ть, кака�-нибудь пошлейша� мелочь, ве�ь замы�ел может и�портить! Да, �лишком приметна� шл�па… Смешна�, потому и приметна�… К моим лохмоть�м непременно нужна фуражка, хот� бы �тарый блин какой-нибудь, а не �тот урод. �икто таких не но�ит, за вер�ту замет�т, запомн�т… главное, потом запомн�т, ан и улика. Тут нужно быть как можно неприметнее… Мелочи, мелочи главное!.. Вот �ти-то мелочи и губ�т в�егда и в�е…
+Идти ему было немного; он даже знал, �колько шагов от ворот его дома: ровно �емь�от тридцать. Как-то раз он их �о�читал, когда уж очень размечтал��. В то врем� он и �ам еще не верил �тим мечтам �воим и только раздражал �еб� их безобразною, но �облазнительною дерзо�тью. Теперь же, ме��ц �пу�т�, он уже начинал �мотреть иначе и, не�мотр� на в�е поддразнивающие монологи о �об�твенном бе��илии и нерешимо�ти, «безобразную» мечту как-то даже поневоле привык �читать уже предпри�тием, хот� в�е еще �ам �ебе не верил. Он даже шел теперь делать пробу �воему предпри�тию, и � каждым шагом волнение его возра�тало в�е �ильнее и �ильнее.
+С замиранием �ердца и нервною дрожью подошел он к преогромнейшему дому, выходившему одною �теной на канаву, а другою в -ю улицу. Этот дом �то�л ве�ь в мелких квартирах и за�елен был в��кими промышленниками — портными, �ле�ар�ми, кухарками, разными немцами, девицами, живущими от �еб�, мелким чиновниче�твом и проч. Вход�щие и выход�щие так и шмыгали под обоими воротами и на обоих дворах дома. Тут �лужили три или четыре дворника. Молодой человек был очень доволен, не в�третив ни которого из них, и неприметно про�кользнул �ейча� же из ворот направо на ле�тницу. Ле�тница была темна� и узка�, «черна�», но он в�е уже �то знал и изучил, и ему в�� �та об�тановка нравила�ь: в такой темноте даже и любопытный взгл�д был неопа�ен. «Е�ли о �ю пору � так бою�ь, что же было бы, е�ли б и дей�твительно как-нибудь �лучило�ь до �амого дела дойти?..» — подумал он невольно, проход� в четвертый �таж. Зде�ь загородили ему дорогу от�тавные �олдаты-но�ильщики, выно�ившие из одной квартиры мебель. Он уже прежде знал, что в �той квартире жил один �емейный немец, чиновник: «Стало быть, �тот немец теперь выезжает, и, �тало быть, в четвертом �таже, по �той ле�тнице и на �той площадке, о�тает��, на некоторое врем�, только одна �тарухина квартира зан�та�. Это хорошо… на в��кой �лучай…» — подумал он оп�ть и позвонил в �тарухину квартиру. Звонок бр�кнул �лабо, как будто был �делан из же�ти, а не из меди. В подобных мелких квартирах таких домов почти в�е такие звонки. Он уже забыл звон �того колокольчика, и теперь �тот о�обенный звон как будто вдруг ему что-то напомнил и ��но пред�тавил… Он так и вздрогнул, �лишком уж о�лабели нервы на �тот раз. �емного �пу�т� дверь приотворила�ь на крошечную щелочку: жилица огл�дывала из щели пришедшего � видимым недоверием, и только виднели�ь ее �веркавшие из темноты глазки. �о увидав на площадке много народу, она ободрила�ь и отворила �ов�ем. Молодой человек пере�тупил через порог в темную прихожую, разгороженную перегородкой, за которою была крошечна� кухн�. Старуха �то�ла перед ним молча и вопро�ительно на него гл�дела. Это была крошечна�, �уха� �тарушонка, лет ше�тиде��ти, � во�трыми и злыми глазками, � маленьким во�трым но�ом и про�товоло�а�. Белобры�ые, мало по�едевшие воло�ы ее были жирно �мазаны ма�лом. �а ее тонкой и длинной шее, похожей на куриную ногу, было наверчено какое-то фланелевое тр�пье, а на плечах, не�мотр� на жару, болтала�ь в�� и�трепанна� и пожелтела� мехова� кацавейка. Старушонка поминутно кашл�ла и кр�хтела. Должно быть, молодой человек взгл�нул на нее каким-нибудь о�обенным взгл�дом, потому что и в ее глазах мелькнула вдруг оп�ть прежн�� недоверчиво�ть.
+— Ра�кольников, �тудент, был у ва� назад тому ме��ц, — по�пешил пробормотать молодой человек � полупоклоном, в�помнив, что надо быть любезнее.
+— Помню, батюшка, очень хорошо помню, что вы были, — отчетливо проговорила �тарушка, по-прежнему не отвод� �воих вопрошающих глаз от его лица.
+— Так вот-�… и оп�ть, по такому же дельцу… — продолжал Ра�кольников, немного �мутивши�ь и удивл���ь недоверчиво�ти �тарухи.
+«Может, впрочем, она и в�егда така�, да � в тот раз не заметил», — подумал он � непри�тным чув�твом.
+Старуха помолчала, как бы в раздумье, потом от�тупила в �торону и, указыва� на дверь в комнату, произне�ла, пропу�ка� го�т� вперед: — Пройдите, батюшка.
+�ебольша� комната, в которую прошел молодой человек, � желтыми обо�ми, геран�ми и ки�ейными занаве�ками на окнах, была в �ту минуту �рко о�вещена заход�щим �олнцем. «И тогда, �тало быть, так же будет �олнце �ветить!..» — как бы невзначай мелькнуло в уме Ра�кольникова, и бы�трым взгл�дом окинул он в�е в комнате, чтобы по возможно�ти изучить и запомнить ра�положение. �о в комнате не было ничего о�обенного. Мебель, в�� очень �тара� и из желтого дерева, �о�то�ла из дивана � огромною выгнутою дерев�нною �пинкой, круглого �тола овальной формы перед диваном, туалета � зеркальцем в про�тенке, �тульев по �тенам на двухтрех грошовых картинок в желтых рамках, изображавших немецких барышень � птицами в руках, — вот и в�� мебель. В углу перед небольшим образом горела лампада. В�е было очень чи�то: и мебель, и полы были оттерты под ло�к; в�е бле�тело. «Лизаветина работа», — подумал молодой человек. �и пылинки нельз� было найти во в�ей квартире. «Это у злых и �тарых вдовиц бывает така� чи�тота», — продолжал про �еб� Ра�кольников и � любопыт�твом поко�ил�� на �итцевую занаве�ку перед дверью во вторую, крошечную комнатку, где �то�ли �тарухины по�тель и комод и куда он еще ни разу не загл�дывал. В�� квартира �о�то�ла из �тих двух комнат. — Что угодно? — �трого произне�ла �тарушонка, вход� в комнату и по-прежнему �танов��ь пр�мо перед ним, чтобы гл�деть ему пр�мо в лицо. — Заклад прине�, вот-�! — И он вынул из кармана �тарые пло�кие �еребр�ные ча�ы. �а оборотной дощечке их был изображен глобу�. Цепочка была �тальна�. — Да ведь и прежнему закладу �рок. Еще третьего дн� ме��ц как минул. — Я вам проценты еще за ме��ц вне�у; потерпите. — � в том мо� добра� вол�, батюшка, терпеть или вещь вашу теперь же продать. — Много ль за ча�ы-то, �лена Ивановна? — � � пу�т�ками ходишь, батюшка, ничего, почитай, не �тоит. За колечко вам прошлый раз два билетика вне�ла, а оно и купить-то его новое у ювелира за полтора рубл� можно. — Рубл�-то четыре дайте, � выкуплю, отцов�кие. Я �коро деньги получу. — Полтора рубл�-� и процент вперед, коли хотите-�. — Полтора рубл�! — в�крикнул молодой человек. — Ваша вол�. — И �таруха прот�нула ему обратно ча�ы. Молодой человек вз�л их и до того ра��ердил��, что хотел было уже уйти; но тотча� одумал��, в�помнив, что идти больше некуда и что он еще и за другим пришел. — Давайте! — �казал он грубо.
+Старуха полезла в карман за ключами и пошла в другую комнату за занаве�ки. Молодой человек, о�тавши�ь один �реди комнаты, любопытно при�лушивал�� и �оображал. Слышно было, как она отперла комод. «Должно быть, верхний �щик, — �оображал он. — Ключи она, �тало быть, в правом кармане но�ит… В�е на одной �в�зке, в �тальном кольце… И там один ключ е�ть в�ех больше, втрое, � зубчатою бородкой, конечно, не от комода… Стало быть, е�ть еще кака�-нибудь шкатулка, али укладка… Вот �то любопытно. У укладок в�е такие ключи… � впрочем, как �то подло в�е…» Старуха воротила�ь. — Вот-�, батюшка: коли по гривне в ме��ц � рубл�, так за полтора рубл� причтет�� � ва� п�тнадцать копеек, за ме��ц вперед-�. Да за два прежних рубл� � ва� еще причитает�� по �ему же �чету вперед двадцать копеек. � в�его, �тало быть тридцать п�ть. Приходит�� же вам теперь в�его получить за ча�ы ваши рубль п�тнадцать копеек. Вот получите-�. — Как! так уж теперь рубль п�тнадцать копеек! — Точно так-�. Молодой человек �порить не �тал и вз�л деньги. Он �мотрел на �таруху и не �пешил уходить, точно ему еще хотело�ь что-то �казать или �делать, но как будто он и �ам не знал, что именно… — Я вам, �лена Ивановна, может быть, на дн�х, еще одну вещь прине�у… �еребр�ную… хорошую… папиро�очницу одну… вот как от при�тел� ворочу… — Он �мутил�� и замолчал. — �у тогда и будем говорить, батюшка. — Прощайте-�… � вы в�е дома одни �идите, �е�трицы-то нет? — �про�ил он как можно разв�знее, выход� в переднюю. — � вам какое до нее, батюшка, дело? — Да ничего о�обенного. Я так �про�ил. Уж вы �ейча�… Прощайте, �лена Ивановна!
+Ра�кольников вышел в решительном �мущении. Смущение �то в�е более увеличивало�ь. Сход� по ле�тнице, он не�колько раз даже о�танавливал��, как будто чем-то внезапно пораженный. И наконец, уже на улице, он во�кликнул:
+«О боже! как �то в�е отвратительно! И неужели, неужели �… нет, �то вздор, �то нелепо�ть! — прибавил он решительно. — И неужели такой ужа� мог прийти мне в голову? �а какую гр�зь �по�обно, однако, мое �ердце! Главное: гр�зно, пако�тно, гадко, гадко!.. И �, целый ме��ц…»
+�о он не мог выразить ни �ловами, ни во�клицани�ми �воего волнени�. Чув�тво бе�конечного отвращени�, начинавшее давить и мутить его �ердце еще в то врем�, как он только шел к �тарухе, до�тигло теперь такого размера и так �рко вы��нило�ь, что он не знал, куда деть�� от то�ки �воей. Он шел по тротуару как пь�ный, не замеча� прохожих и �талкива��ь � ними, и опомнил�� уже в �ледующей улице. Огл�девши�ь, он заметил, что �тоит подле ра�пивочной, в которую вход был � тротуара по ле�тнице вниз, в подвальный �таж. Из дверей, как раз в �ту минуту, выходили двое пь�ных и, друг друга поддержива� и руга�, взбирали�ь на улицу. Долго не дума�, Ра�кольников тотча� же �пу�тил�� вниз. �икогда до �их пор не входил он в ра�пивочные, но теперь голова его кружила�ь, и к тому же пал�ща� жажда томила его. Ему захотело�ь выпить холодного пива, тем более что внезапную �лабо�ть �вою он отно�ил и к тому, что был голоден. Он у�ел�� в темном и гр�зном углу, за липким �толиком, �про�ил пива и � жадно�тию выпил первый �такан. Тотча� же в�е отлегло, и мы�ли его про��нели. «В�е �то вздор, — �казал он � надеждой, — и нечем тут было �мущать��! Про�то физиче�кое ра��трой�тво! Один какой-нибудь �такан пива, ку�ок �ухар�, — и вот, в один миг, крепнет ум, ��неет мы�ль, твердеют намерени�! Тьфу, какое в�е �то ничтоже�тво!..» �о, не�мотр� на �тот презрительный плевок, он гл�дел уже ве�ело, как будто внезапно о�вобод��ь от какого-то ужа�ного бремени, и дружелюбно окинул глазами при�ут�твующих. �о даже и в �ту минуту он отдаленно предчув�твовал, что в�� �та во�приимчиво�ть к лучшему была тоже болезненна�.
+В ра�пивочной на ту пору о�тавало�ь мало народу. Кроме тех двух пь�ных, что попали�ь на ле�тнице, в�лед за ними же вышла еще разом цела� ватага, человек в п�ть, � одною девкой и � гармонией. По�ле них �тало тихо и про�торно. О�тали�ь: один хмельной, но немного, �идевший за пивом, � виду мещанин; товарищ его, тол�тый, огромный, в �ибирке и � �едою бородой, очень захмелевший, задремавший на лавке и изредка, вдруг, как бы �про�онь�, начинавший прищелкивать пальцами, ра��тавив руки врозь, и подпрыгивать верхнею ча�тию корпу�а, не в�тава� � лавки, причем подпевал какую-то ерунду, �ил��ь припомнить �тихи, вроде:
+Целый год жену ла�кал,
+Цел-лый год же-ну ла�-кал…
+Или вдруг, про�нувши�ь, оп�ть:
+По Подь�че�кой пошел,
+Свою прежнюю нашел…
+�о никто не раздел�л его �ча�ти�; молчаливый товарищ его �мотрел на в�е �ти взрывы даже враждебно и � недоверчиво�тью. Был тут и еще один человек, � виду похожий как бы на от�тавного чиновника. Он �идел о�обо, перед �воею по�удинкой, изредка отпива� и по�матрива� кругом. Он был тоже как будто в некотором волнении.
+
+Ра�кольников не привык к толпе и, как уже �казано, бежал в��кого обще�тва, о�обенно в по�леднее врем�. �о теперь его вдруг что-то пот�нуло к люд�м. Что-то �овершало�ь в нем как бы новое, и вме�те � тем ощутила�ь кака�-то жажда людей. Он так у�тал от целого ме��ца �той �о�редоточенной то�ки �воей и мрачного возбуждени�, что хот� одну минуту хотело�ь ему вздохнуть в другом мире, хоть бы в каком бы то ни было, и, не�мотр� на в�ю гр�зь об�тановки, он � удоволь�твием о�тавал�� теперь в ра�пивочной.
+Хоз�ин заведени� был в другой комнате, но ча�то входил в главную, �пу�ка��ь в нее откуда-то по �тупенькам, причем прежде в�его выказывали�ь его щеголь�кие �мазные �апоги � большими кра�ными отворотами. Он был в поддевке и в �трашно за�аленном черном атла�ном жилете, без гал�тука, а в�е лицо его было как будто �мазано ма�лом, точно железный замок. За за�тойкой находил�� мальчишка лет четырнадцати, и был другой мальчишка моложе, который подавал, е�ли что �прашивали. Сто�ли крошеные огурцы, черные �ухари и резанна� ку�очками рыба; в�е �то очень дурно пахло. Было душно, так что было даже не�терпимо �идеть, и в�е до того было пропитано винным запахом, что, кажет��, от одного �того воздуха можно было в п�ть минут �делать�� пь�ным.
+Бывают иные в�тречи, �овершенно даже � незнакомыми нам людьми, которыми мы начинаем интере�овать�� � первого взгл�да, как-то вдруг, внезапно, прежде чем �кажем �лово. Такое точно впечатление произвел на Ра�кольникова тот го�ть, который �идел поодаль и походил на от�тавного чиновника. Молодой человек не�колько раз припоминал потом �то первое впечатление и даже припи�ывал его предчув�твию. Он бе�прерывно взгл�дывал на чиновника, конечно, и потому еще, что и �ам тот упорно �мотрел на него, и видно было, что тому очень хотело�ь начать разговор. �а о�тальных же, бывших в ра�пивочной, не и�ключа� и хоз�ина, чиновник �мотрел как-то привычно и даже �о �кукой, а вме�те � тем и � оттенком некоторого вы�окомерного пренебрежени�, как бы на людей низшего положени� и развити�, � которыми нечего ему говорить. Это был человек лет уже за п�тьде��т, �реднего ро�та и плотного �ложени�, � про�едью и � большою лы�иной, � отекшим от по�то�нного пь�н�тва желтым, даже зеленоватым лицом и � припухшими веками, из-за которых �и�ли крошечные, как щелочки, но одушевленные кра�новатые глазки. �о что-то было в нем очень �транное; во взгл�де его �ветила�ь как будто даже во�торженно�ть, — пожалуй, был и �мы�л и ум, — но в то же врем� мелькало как будто и безумие. Одет он был в �тарый, �овершенно оборванный черный фрак, � о�ыпавшими�� пуговицами. Одна только еще держала�ь кое-как, и на нее-то он и за�тегивал��, видимо жела� не удал�ть�� приличий. Из-под нанкового жилета торчала манишка, в�� �комканна�, запачканна� и залита�. Лицо было выбрито, по-чиновничьи, но давно уже, так что уже гу�то начала вы�тупать �иза� щетина. Да и в ухватках его дей�твительно было что-то �олидно-чиновничье. �о он был в бе�покой�тве, ерошил воло�ы и подпирал иногда, в то�ке, обеими руками голову, положа продранные локти на залитый и липкий �тол. �аконец он пр�мо по�мотрел на Ра�кольникова и громко и твердо проговорил: — � о�мелю�ь ли, мило�тивый го�ударь мой, обратить�� к вам � разговором приличным? Ибо хот� вы и не в значительном виде, но опытно�ть мо� отличает в ва� человека образованного и к напитку непривычного. Сам в�егда уважал образованно�ть, �оединенную � �ердечными чув�твами, и, кроме того, �о�тою титул�рным �оветником. Мармеладов — така� фамили�; титул�рный �оветник. О�мелю�ь узнать, �лужить изволили? — �ет, учу�ь… — отвечал молодой человек, отча�ти удивленный и о�обенным витиеватым тоном речи, и тем, что так пр�мо, в упор, обратили�ь к нему. �е�мотр� на недавнее мгновенное желание хот� какого бы ни было �ообще�тва � людьми, он при первом, дей�твительно обращенном к нему �лове вдруг ощутил �вое обычное непри�тное и раздражительное чув�тво отвращени� ко в��кому чужому лицу, ка�авшему�� или хотевшему только прико�нуть�� к его лично�ти. — Студент, �тало быть, или бывший �тудент! — в�кричал чиновник, — так � и думал! Опыт, мило�тивый го�ударь, неоднократный опыт! — и в знак похвальбы он приложил палец ко лбу. — Были �тудентом или прои�ходили ученую ча�ть! � позвольте… — Он прив�тал, покачнул��, захватил �вою по�удинку, �таканчик, и под�ел к молодому человеку, не�колько от него наи�ко�ь. Он был хмелен, но говорил речи�то и бойко, изредка только ме�тами �бива��ь немного и зат�гива� речь. С какою-то даже жадно�тию накинул�� он на Ра�кольникова, точно целый ме��ц тоже ни � кем не говорил. — Мило�тивый го�ударь, — начал он почти � торже�твенно�тию, — бедно�ть не порок, �то и�тина. Знаю �, что и пь�н�тво не добродетель, и �то тем паче. �о нищета, мило�тивый го�ударь, нищета — порок-�. В бедно�ти вы еще �охран�ете �вое благород�тво врожденных чув�тв, в нищете же никогда и никто. За нищету даже и не палкой выгон�ют, а метлой выметают из компании человече�кой, чтобы тем о�корбительнее было; и �праведливо, ибо в нищете � первый �ам готов о�корбл�ть �еб�. И от�юда питейное! Мило�тивый го�ударь, ме��ц назад тому �упругу мою избил го�подин Лебез�тников, а �упруга мо� не то что �! Понимаете-�? Позвольте еще ва� �про�ить, так, хот� бы в виде про�того любопыт�тва: изволили вы ночевать на �еве, на �енных барках? — �ет, не �лучало�ь, — отвечал Ра�кольников. — Это что такое? — �у-�, а � оттуда, и уже п�тую ночь-�…
+Он налил �таканчик, выпил и задумал��. Дей�твительно, на его платье и даже в воло�ах кое-где виднели�ь прилипшие былинки �ена. Очень веро�тно было, что он п�ть дней не раздевал�� и не умывал��. О�обенно руки были гр�зны, жирные, кра�ные, � черными ногт�ми.
+Его разговор, казало�ь, возбудил общее, хот� и ленивое внимание. Мальчишки за �тойкой �тали хихикать. Хоз�ин, кажет��, нарочно �ошел из верхней комнаты, чтобы по�лушать «забавника», и �ел поодаль, лениво, но важно позевыва�. Очевидно, Мармеладов был зде�ь давно изве�тен. Да и наклонно�ть к витиеватой речи приобрел, веро�тно, в�лед�твие привычки к ча�тым кабачным разговорам � различными незнакомцами. Эта привычка обращает�� у иных пьющих в потребно�ть, и преимуще�твенно у тех из них, � которыми дома обход�т�� �трого и которыми помыкают. Оттого-то в пьющей компании они и �тарают�� в�егда как будто выхлопотать �ебе оправдание, а е�ли можно, то даже и уважение. — Забавник! — громко проговорил хоз�ин. — � дл� ча не работаешь, дл� ча не �лужите, коли чиновник? — Дл� чего � не �лужу, мило�тивый го�ударь, — подхватил Мармеладов, и�ключительно обраща��ь к Ра�кольникову, как будто �то он ему задал вопро�, — дл� чего не �лужу? � разве �ердце у мен� не болит о том, что � пре�мыкаю�ь втуне? Когда го�подин Лебез�тников, тому ме��ц назад, �упругу мою �об�твенноручно избил, а � лежал пь�ненькой, разве � не �традал? Позвольте, молодой человек, �лучало�ь вам… гм… ну хоть и�прашивать денег взаймы безнадежно? — Случало�ь… то е�ть как безнадежно? — То е�ть безнадежно вполне-�, заранее зна�, что из �его ничего не выйдет. Вот вы знаете, например, заранее и до�конально, что �ей человек, �ей благонамереннейший и наиполезнейший гражданин, ни за что вам денег не да�т, ибо зачем, �прошу �, он да�т? Ведь он знает же, что � не отдам. Из �о�традани�? �о го�подин Лебез�тников, �лед�щий за новыми мы�л�ми, объ��н�л намедни, что �о�традание в наше врем� даже наукой во�прещено и что так уже делает�� в �нглии, где политиче�ка� �кономи�. Зачем же, �прошу �, он да�т? И вот, зна� вперед, что не да�т, вы в�е-таки отправл�ете�ь в путь и… — Дл� чего же ходить? — прибавил Ра�кольников. — � коли не к кому, коли идти больше некуда! Ведь надобно же, чтобы в��кому человеку хоть куда-нибудь можно было пойти. Ибо бывает такое врем�, когда непременно надо хоть куда-нибудь да пойти! Когда единородна дочь мо� в первый раз по желтому билету пошла, и � тоже тогда пошел… (ибо дочь мо� по желтому билету живет-�…) — прибавил он в �кобках, � некоторым бе�покой�твом �мотр� на молодого человека. — �ичего, мило�тивый го�ударь, ничего! — по�пешил он тотча� же, и по-видимому �покойно, за�вить, когда фыркнули оба мальчишки за �тойкой и улыбнул�� �ам хоз�ин. — �ичего-�! Сим покиванием глав не �мущаю�ь, ибо уже в�ем в�е изве�тно и в�е тайное �тановить�� �вным; и не � презрением, а �о �мирением к �ему отношу�ь. Пу�ть! пу�ть! «Се человек!» Позвольте, молодой человек: можете ли вы… �о нет, изъ��нить �ильнее и изобразительнее: не можете ли вы, а о�мелите�ь ли вы, взира� в �ей ча� на мен�, �казать утвердительно, что � не �винь�? Молодой человек не отвечал ни �лова.
+— �у-�, — продолжал оратор, �олидно и даже � у�иленным на �тот раз до�тоин�твом переждав оп�ть по�ледовавшее в комнате хихикание. — �у-�, � пу�ть �винь�, а она дама! Я звериный образ имею, а Катерина Ивановна, �упруга мо�, — о�оба образованна� и урожденна� штаб-офицер�ка� дочь. Пу�ть, пу�ть � подлец, она же и �ердца вы�окого, и чув�тв, облагороженных во�питанием, и�полнена. � между тем… о, е�ли б она пожалела мен�! Мило�тивый го�ударь, мило�тивый го�ударь, ведь надобно же, чтоб у в��кого человека было хоть одно такое ме�то, где бы и его пожалели! � Катерина Ивановна дама хот� и великодушна�, но не�праведлива�… И хот� � и �ам понимаю, что когда она и вихры мои дерет, то дерет их не иначе как от жало�ти �ердца (ибо, повтор�ю без �мущени�, она дерет мне вихры, молодой человек, — подтвердил он � �угубым до�тоин�твом, у�лышав оп�ть хихиканье), но, боже, что е�ли б она хот� один раз… �о нет! нет! в�е �ие втуне, и нечего говорить! нечего говорить!.. ибо и не один раз уже бывало желаемое, и не один уже раз жалели мен�, но… такова уже черта мо�, а � прирожденный �кот! — Еще бы! — заметил, зева�, хоз�ин. Мармеладов решительно �тукнул кулаком по �толу. — Такова уж черта мо�! Знаете ли, знаете ли вы, го�ударь мой, что � даже чулки ее пропил? �е башмаки-�, ибо �то хот� �колько-нибудь походило бы на пор�док вещей, а чулки, чулки ее пропил-�! Ко�ыночку ее из козьего пуха тоже пропил, дареную, прежнюю, ее �об�твенную, не мою; а живем мы в холодном угле, и она в �ту зиму про�тудила�ь и кашл�ть пошла, уже кровью. Детей же маленьких у на� трое, и Катерина Ивановна в работе � утра до ночи �кребет и моет и детей обмывает, ибо к чи�тоте � измалет�тва привыкла, а � грудью �лабою и к чахотке наклонною, и � �то чув�твую. Разве � не чув�твую? И чем более пью, тем более и чув�твую. Дл� того и пью, что в питии �ем �о�традани� и чув�тва ищу. �е ве�ель�, а единой �корби ищу… Пью, ибо �угубо �традать хочу! — И он, как бы в отча�нии, �клонил на �тол голову.
\ No newline at end of file
diff --git a/libraries/base/tests/IO/encoded-data/CP1251.txt b/libraries/base/tests/IO/encoded-data/CP1251.txt
new file mode 100644
index 000000000000..a9cb86b952ff
--- /dev/null
+++ b/libraries/base/tests/IO/encoded-data/CP1251.txt
@@ -0,0 +1,34 @@
+ íà÷àëå èþëÿ, â ÷ðåçâû÷àéíî æàðêîå âðåìÿ, ïîä âå÷åð, îäèí ìîëîäîé ÷åëîâåê âûøåë èç ñâîåé êàìîðêè, êîòîðóþ íàíèìàë îò æèëüöîâ â Ñ-ì ïåðåóëêå, íà óëèöó è ìåäëåííî, êàê áû â íåðåøèìîñòè, îòïðàâèëñÿ ê Ê-íó ìîñòó.
+Îí áëàãîïîëó÷íî èçáåãíóë âñòðå÷è ñ ñâîåþ õîçÿéêîé íà ëåñòíèöå. Êàìîðêà åãî ïðèõîäèëàñü ïîä ñàìîþ êðîâëåé âûñîêîãî ïÿòèýòàæíîãî äîìà è ïîõîäèëà áîëåå íà øêàô, ÷åì íà êâàðòèðó. Êâàðòèðíàÿ æå õîçÿéêà åãî, ó êîòîðîé îí íàíèìàë ýòó êàìîðêó ñ îáåäîì è ïðèñëóãîé, ïîìåùàëàñü îäíîþ ëåñòíèöåé íèæå, â îòäåëüíîé êâàðòèðå, è êàæäûé ðàç, ïðè âûõîäå íà óëèöó, åìó íåïðåìåííî íàäî áûëî ïðîõîäèòü ìèìî õîçÿéêèíîé êóõíè, ïî÷òè âñåãäà íàñòåæü îòâîðåííîé íà ëåñòíèöó. È êàæäûé ðàç ìîëîäîé ÷åëîâåê, ïðîõîäÿ ìèìî, ÷óâñòâîâàë êàêîå-òî áîëåçíåííîå è òðóñëèâîå îùóùåíèå, êîòîðîãî ñòûäèëñÿ è îò êîòîðîãî ìîðùèëñÿ. Îí áûë äîëæåí êðóãîì õîçÿéêå è áîÿëñÿ ñ íåþ âñòðåòèòüñÿ.
+Íå òî ÷òîá îí áûë òàê òðóñëèâ è çàáèò, ñîâñåì äàæå íàïðîòèâ; íî ñ íåêîòîðîãî âðåìåíè îí áûë â ðàçäðàæèòåëüíîì è íàïðÿæåííîì ñîñòîÿíèè ïîõîæåì íà èïîõîíäðèþ. Îí äî òîãî óãëóáèëñÿ â ñåáÿ è óåäèíèëñÿ îò âñåõ, ÷òî áîÿëñÿ äàæå âñÿêîé âñòðå÷è, íå òîëüêî âñòðå÷è ñ õîçÿéêîé. Îí áûë çàäàâëåí áåäíîñòüþ; íî äàæå ñòåñíåííîå ïîëîæåíèå ïåðåñòàëî â ïîñëåäíåå âðåìÿ òÿãîòèòü åãî. Íàñóùíûìè äåëàìè ñâîèìè îí ñîâñåì ïåðåñòàë è íå õîòåë çàíèìàòüñÿ. Íèêàêîé õîçÿéêè, â ñóùíîñòè, îí íå áîÿëñÿ, ÷òî áû òà íè çàìûøëÿëà ïðîòèâ íåãî. Íî îñòàíàâëèâàòüñÿ íà ëåñòíèöå, ñëóøàòü âñÿêèé âçîð ïðî âñþ ýòó îáûäåííóþ äðåáåäåíü, äî êîòîðîé åìó íåò íèêàêîãî äåëà, âñå ýòè ïðèñòàâàíèÿ î ïëàòåæå, óãðîçû, æàëîáû, è ïðè ýòîì ñàìîìó èçâîðà÷èâàòüñÿ, èçâèíÿòüñÿ, ëãàòü, — íåò óæ, ëó÷øå ïðîñêîëüçíóòü êàê-íèáóäü êîøêîé ïî ëåñòíèöå è óëèçíóòü, ÷òîáû íèêòî íå âèäàë.
+Âïðî÷åì, íà ýòîò ðàç ñòðàõ âñòðå÷è ñ ñâîåþ êðåäèòîðøåé äàæå åãî ñàìîãî ïîðàçèë ïî âûõîäå íà óëèöó.
+«Íà êàêîå äåëî õî÷ó ïîêóñèòüñÿ è â òî æå âðåìÿ êàêèõ ïóñòÿêîâ áîþñü! — ïîäóìàë îí ñ ñòðàííîþ óëûáêîé. — Ãì… äà… âñå â ðóêàõ ÷åëîâåêà, è âñå-òî îí ìèìî íîñó ïðîíîñèò, åäèíñòâåííî îò îäíîé òðóñîñòè… ýòî óæ àêñèîìà… Ëþáîïûòíî, ÷åãî ëþäè áîëüøå áîÿòñÿ? Íîâîãî øàãà, íîâîãî ñîáñòâåííîãî ñëîâà îíè âñåãî áîëüøå áîÿòñÿ… À âïðî÷åì, ÿ ñëèøêîì ìíîãî áîëòàþ. Îòòîãî è íè÷åãî íå äåëàþ, ÷òî áîëòàþ. Ïîæàëóé, âïðî÷åì, è òàê: îòòîãî áîëòàþ, ÷òî íè÷åãî íå äåëàþ. Ýòî ÿ â ýòîò ïîñëåäíèé ìåñÿö âûó÷èëñÿ áîëòàòü, ëåæà ïî öåëûì ñóòêàì â óãëó è äóìàÿ… î öàðå Ãîðîõå. Íó çà÷åì ÿ òåïåðü èäó? Ðàçâå ÿ ñïîñîáåí íà ýòî? Ðàçâå ýòî ñåðüåçíî? Ñîâñåì íå ñåðüåçíî. Òàê ðàäè ôàíòàçèè ñàì ñåáÿ òåøó; èãðóøêè! Äà, ïîæàëóé ÷òî è èãðóøêè!»
+Íà óëèöå æàðà ñòîÿëà ñòðàøíàÿ, ê òîìó æå äóõîòà, òîëêîòíÿ, âñþäó èçâåñòêà, ëåñà, êèðïè÷, ïûëü è òà îñîáåííàÿ ëåòíÿÿ âîíü, ñòîëü èçâåñòíàÿ êàæäîìó ïåòåðáóðæöó, íå èìåþùåìó âîçìîæíîñòè íàíÿòü äà÷ó, — âñå ýòî ðàçîì íåïðèÿòíî ïîòðÿñëî è áåç òîãî óæå ðàññòðîåííûå íåðâû þíîøè. Íåñòåðïèìàÿ æå âîíü èç ðàñïèâî÷íûõ, êîòîðûõ â ýòîé ÷àñòè ãîðîäà îñîáåííîå ìíîæåñòâî, è ïüÿíûå, ïîìèíóòíî ïîïàäàâøèåñÿ, íåñìîòðÿ íà áóäíåå âðåìÿ, äîâåðøèëè îòâðàòèòåëüíûé è ãðóñòíûé êîëîðèò êàðòèíû. ×óâñòâî ãëóáî÷àéøåãî îìåðçåíèÿ ìåëüêíóëî íà ìèã â òîíêèõ ÷åðòàõ ìîëîäîãî ÷åëîâåêà. Êñòàòè, îí áûë çàìå÷àòåëüíî õîðîø ñîáîþ, ñ ïðåêðàñíûìè òåìíûìè ãëàçàìè, òåìíî-ðóñ, ðîñòîì âûøå ñðåäíåãî, òîíîê è ñòðîåí. Íî ñêîðî îí âïàë êàê áû â ãëóáîêóþ çàäóì÷èâîñòü, äàæå, âåðíåå ñêàçàòü, êàê áû â êàêîå-òî çàáûòüå, è ïîøåë, óæå íå çàìå÷àÿ îêðóæàþùåãî, äà è íå æåëàÿ åãî çàìå÷àòü. Èçðåäêà òîëüêî áîðìîòàë îí ÷òî-òî ïðî ñåáÿ, îò ñâîåé ïðèâû÷êè ê ìîíîëîãàì, â êîòîðîé îí ñåé÷àñ ñàì ñåáå ïðèçíàëñÿ.  ýòó æå ìèíóòó îí è ñàì ñîçíàâàë, ÷òî ìûñëè åãî ïîðîþ ìåøàþòñÿ è ÷òî îí î÷åíü ñëàá: âòîðîé äåíü êàê óæ îí ïî÷òè ñîâñåì íè÷åãî íå åë.
+Îí áûë äî òîãî õóäî îäåò, ÷òî èíîé, äàæå è ïðèâû÷íûé ÷åëîâåê, ïîñîâåñòèëñÿ áû äíåì âûõîäèòü â òàêèõ ëîõìîòüÿõ íà óëèöó. Âïðî÷åì, êâàðòàë áûë òàêîâ, ÷òî êîñòþìîì çäåñü áûëî òðóäíî êîãî-íèáóäü óäèâèòü. Áëèçîñòü Ñåííîé, îáèëèå èçâåñòíûõ çàâåäåíèé è, ïî ïðåèìóùåñòâó, öåõîâîå è ðåìåñëåííîå íàñåëåíèå, ñêó÷åííîå â ýòèõ ñåðåäèííûõ ïåòåðáóðãñêèõ óëèöàõ è ïåðåóëêàõ, ïåñòðèëè èíîãäà îáùóþ ïàíîðàìó òàêèìè ñóáúåêòàìè, ÷òî ñòðàííî áûëî áû è óäèâëÿòüñÿ ïðè âñòðå÷å ñ èíîþ ôèãóðîé. Íî ñòîëüêî çëîáíîãî ïðåçðåíèÿ óæå íàêîïèëîñü â äóøå ìîëîäîãî ÷åëîâåêà, ÷òî, íåñìîòðÿ íà âñþ ñâîþ, èíîãäà î÷åíü ìîëîäóþ, ùåêîòëèâîñòü, îí ìåíåå âñåãî ñîâåñòèëñÿ ñâîèõ ëîõìîòüåâ íà óëèöå. Äðóãîå äåëî ïðè âñòðå÷å ñ èíûìè çíàêîìûìè èëè ñ ïðåæíèìè òîâàðèùàìè, ñ êîòîðûìè âîîáùå îí íå ëþáèë âñòðå÷àòüñÿ… À ìåæäó òåì, êîãäà îäèí ïüÿíûé, êîòîðîãî íåèçâåñòíî ïî÷åìó è êóäà ïðîâîçèëè â ýòî âðåìÿ ïî óëèöå â îãðîìíîé òåëåãå, çàïðÿæåííîé îãðîìíîþ ëîìîâîþ ëîøàäüþ, êðèêíóë åìó âäðóã, ïðîåçæàÿ: «Ýé òû, íåìåöêèé øëÿïíèê!» — è çàîðàë âî âñå ãîðëî, óêàçûâàÿ íà íåãî ðóêîé, — ìîëîäîé ÷åëîâåê âäðóã îñòàíîâèëñÿ è ñóäîðîæíî ñõâàòèëñÿ çà ñâîþ øëÿïó. Øëÿïà ýòà áûëà âûñîêàÿ, êðóãëàÿ, öèììåðìàíîâñêàÿ, íî âñÿ óæå èçíîøåííàÿ, ñîâñåì ðûæàÿ, âñÿ â äûðàõ è ïÿòíàõ, áåç ïîëåé è ñàìûì áåçîáðàçíåéøèì óãëîì çàëîìèâøàÿñÿ íà ñòîðîíó. Íî íå ñòûä, à ñîâñåì äðóãîå ÷óâñòâî, ïîõîæåå äàæå íà èñïóã, îõâàòèëî åãî.
+— ß òàê è çíàë! — áîðìîòàë îí â ñìóùåíèè, — ÿ òàê è äóìàë! Ýòî óæ âñåãî ñêâåðíåå! Âîò ýäàêàÿ êàêàÿ-íèáóäü ãëóïîñòü, êàêàÿ-íèáóäü ïîøëåéøàÿ ìåëî÷ü, âåñü çàìûñåë ìîæåò èñïîðòèòü! Äà, ñëèøêîì ïðèìåòíàÿ øëÿïà… Ñìåøíàÿ, ïîòîìó è ïðèìåòíàÿ… Ê ìîèì ëîõìîòüÿì íåïðåìåííî íóæíà ôóðàæêà, õîòÿ áû ñòàðûé áëèí êàêîé-íèáóäü, à íå ýòîò óðîä. Íèêòî òàêèõ íå íîñèò, çà âåðñòó çàìåòÿò, çàïîìíÿò… ãëàâíîå, ïîòîì çàïîìíÿò, àí è óëèêà. Òóò íóæíî áûòü êàê ìîæíî íåïðèìåòíåå… Ìåëî÷è, ìåëî÷è ãëàâíîå!.. Âîò ýòè-òî ìåëî÷è è ãóáÿò âñåãäà è âñå…
+Èäòè åìó áûëî íåìíîãî; îí äàæå çíàë, ñêîëüêî øàãîâ îò âîðîò åãî äîìà: ðîâíî ñåìüñîò òðèäöàòü. Êàê-òî ðàç îí èõ ñîñ÷èòàë, êîãäà óæ î÷åíü ðàçìå÷òàëñÿ.  òî âðåìÿ îí è ñàì åùå íå âåðèë ýòèì ìå÷òàì ñâîèì è òîëüêî ðàçäðàæàë ñåáÿ èõ áåçîáðàçíîþ, íî ñîáëàçíèòåëüíîþ äåðçîñòüþ. Òåïåðü æå, ìåñÿö ñïóñòÿ, îí óæå íà÷èíàë ñìîòðåòü èíà÷å è, íåñìîòðÿ íà âñå ïîääðàçíèâàþùèå ìîíîëîãè î ñîáñòâåííîì áåññèëèè è íåðåøèìîñòè, «áåçîáðàçíóþ» ìå÷òó êàê-òî äàæå ïîíåâîëå ïðèâûê ñ÷èòàòü óæå ïðåäïðèÿòèåì, õîòÿ âñå åùå ñàì ñåáå íå âåðèë. Îí äàæå øåë òåïåðü äåëàòü ïðîáó ñâîåìó ïðåäïðèÿòèþ, è ñ êàæäûì øàãîì âîëíåíèå åãî âîçðàñòàëî âñå ñèëüíåå è ñèëüíåå.
+Ñ çàìèðàíèåì ñåðäöà è íåðâíîþ äðîæüþ ïîäîøåë îí ê ïðåîãðîìíåéøåìó äîìó, âûõîäèâøåìó îäíîþ ñòåíîé íà êàíàâó, à äðóãîþ â -þ óëèöó. Ýòîò äîì ñòîÿë âåñü â ìåëêèõ êâàðòèðàõ è çàñåëåí áûë âñÿêèìè ïðîìûøëåííèêàìè — ïîðòíûìè, ñëåñàðÿìè, êóõàðêàìè, ðàçíûìè íåìöàìè, äåâèöàìè, æèâóùèìè îò ñåáÿ, ìåëêèì ÷èíîâíè÷åñòâîì è ïðî÷. Âõîäÿùèå è âûõîäÿùèå òàê è øìûãàëè ïîä îáîèìè âîðîòàìè è íà îáîèõ äâîðàõ äîìà. Òóò ñëóæèëè òðè èëè ÷åòûðå äâîðíèêà. Ìîëîäîé ÷åëîâåê áûë î÷åíü äîâîëåí, íå âñòðåòèâ íè êîòîðîãî èç íèõ, è íåïðèìåòíî ïðîñêîëüçíóë ñåé÷àñ æå èç âîðîò íàïðàâî íà ëåñòíèöó. Ëåñòíèöà áûëà òåìíàÿ è óçêàÿ, «÷åðíàÿ», íî îí âñå óæå ýòî çíàë è èçó÷èë, è åìó âñÿ ýòà îáñòàíîâêà íðàâèëàñü: â òàêîé òåìíîòå äàæå è ëþáîïûòíûé âçãëÿä áûë íåîïàñåí. «Åñëè î ñþ ïîðó ÿ òàê áîþñü, ÷òî æå áûëî áû, åñëè á è äåéñòâèòåëüíî êàê-íèáóäü ñëó÷èëîñü äî ñàìîãî äåëà äîéòè?..» — ïîäóìàë îí íåâîëüíî, ïðîõîäÿ â ÷åòâåðòûé ýòàæ. Çäåñü çàãîðîäèëè åìó äîðîãó îòñòàâíûå ñîëäàòû-íîñèëüùèêè, âûíîñèâøèå èç îäíîé êâàðòèðû ìåáåëü. Îí óæå ïðåæäå çíàë, ÷òî â ýòîé êâàðòèðå æèë îäèí ñåìåéíûé íåìåö, ÷èíîâíèê: «Ñòàëî áûòü, ýòîò íåìåö òåïåðü âûåçæàåò, è, ñòàëî áûòü, â ÷åòâåðòîì ýòàæå, ïî ýòîé ëåñòíèöå è íà ýòîé ïëîùàäêå, îñòàåòñÿ, íà íåêîòîðîå âðåìÿ, òîëüêî îäíà ñòàðóõèíà êâàðòèðà çàíÿòàÿ. Ýòî õîðîøî… íà âñÿêîé ñëó÷àé…» — ïîäóìàë îí îïÿòü è ïîçâîíèë â ñòàðóõèíó êâàðòèðó. Çâîíîê áðÿêíóë ñëàáî, êàê áóäòî áûë ñäåëàí èç æåñòè, à íå èç ìåäè.  ïîäîáíûõ ìåëêèõ êâàðòèðàõ òàêèõ äîìîâ ïî÷òè âñå òàêèå çâîíêè. Îí óæå çàáûë çâîí ýòîãî êîëîêîëü÷èêà, è òåïåðü ýòîò îñîáåííûé çâîí êàê áóäòî âäðóã åìó ÷òî-òî íàïîìíèë è ÿñíî ïðåäñòàâèë… Îí òàê è âçäðîãíóë, ñëèøêîì óæ îñëàáåëè íåðâû íà ýòîò ðàç. Íåìíîãî ñïóñòÿ äâåðü ïðèîòâîðèëàñü íà êðîøå÷íóþ ùåëî÷êó: æèëèöà îãëÿäûâàëà èç ùåëè ïðèøåäøåãî ñ âèäèìûì íåäîâåðèåì, è òîëüêî âèäíåëèñü åå ñâåðêàâøèå èç òåìíîòû ãëàçêè. Íî óâèäàâ íà ïëîùàäêå ìíîãî íàðîäó, îíà îáîäðèëàñü è îòâîðèëà ñîâñåì. Ìîëîäîé ÷åëîâåê ïåðåñòóïèë ÷åðåç ïîðîã â òåìíóþ ïðèõîæóþ, ðàçãîðîæåííóþ ïåðåãîðîäêîé, çà êîòîðîþ áûëà êðîøå÷íàÿ êóõíÿ. Ñòàðóõà ñòîÿëà ïåðåä íèì ìîë÷à è âîïðîñèòåëüíî íà íåãî ãëÿäåëà. Ýòî áûëà êðîøå÷íàÿ, ñóõàÿ ñòàðóøîíêà, ëåò øåñòèäåñÿòè, ñ âîñòðûìè è çëûìè ãëàçêàìè, ñ ìàëåíüêèì âîñòðûì íîñîì è ïðîñòîâîëîñàÿ. Áåëîáðûñûå, ìàëî ïîñåäåâøèå âîëîñû åå áûëè æèðíî ñìàçàíû ìàñëîì. Íà åå òîíêîé è äëèííîé øåå, ïîõîæåé íà êóðèíóþ íîãó, áûëî íàâåð÷åíî êàêîå-òî ôëàíåëåâîå òðÿïüå, à íà ïëå÷àõ, íåñìîòðÿ íà æàðó, áîëòàëàñü âñÿ èñòðåïàííàÿ è ïîæåëòåëàÿ ìåõîâàÿ êàöàâåéêà. Ñòàðóøîíêà ïîìèíóòíî êàøëÿëà è êðÿõòåëà. Äîëæíî áûòü, ìîëîäîé ÷åëîâåê âçãëÿíóë íà íåå êàêèì-íèáóäü îñîáåííûì âçãëÿäîì, ïîòîìó ÷òî è â åå ãëàçàõ ìåëüêíóëà âäðóã îïÿòü ïðåæíÿÿ íåäîâåð÷èâîñòü.
+— Ðàñêîëüíèêîâ, ñòóäåíò, áûë ó âàñ íàçàä òîìó ìåñÿö, — ïîñïåøèë ïðîáîðìîòàòü ìîëîäîé ÷åëîâåê ñ ïîëóïîêëîíîì, âñïîìíèâ, ÷òî íàäî áûòü ëþáåçíåå.
+— Ïîìíþ, áàòþøêà, î÷åíü õîðîøî ïîìíþ, ÷òî âû áûëè, — îò÷åòëèâî ïðîãîâîðèëà ñòàðóøêà, ïî-ïðåæíåìó íå îòâîäÿ ñâîèõ âîïðîøàþùèõ ãëàç îò åãî ëèöà.
+— Òàê âîò-ñ… è îïÿòü, ïî òàêîìó æå äåëüöó… — ïðîäîëæàë Ðàñêîëüíèêîâ, íåìíîãî ñìóòèâøèñü è óäèâëÿÿñü íåäîâåð÷èâîñòè ñòàðóõè.
+«Ìîæåò, âïðî÷åì, îíà è âñåãäà òàêàÿ, äà ÿ â òîò ðàç íå çàìåòèë», — ïîäóìàë îí ñ íåïðèÿòíûì ÷óâñòâîì.
+Ñòàðóõà ïîìîë÷àëà, êàê áû â ðàçäóìüå, ïîòîì îòñòóïèëà â ñòîðîíó è, óêàçûâàÿ íà äâåðü â êîìíàòó, ïðîèçíåñëà, ïðîïóñêàÿ ãîñòÿ âïåðåä: — Ïðîéäèòå, áàòþøêà.
+Íåáîëüøàÿ êîìíàòà, â êîòîðóþ ïðîøåë ìîëîäîé ÷åëîâåê, ñ æåëòûìè îáîÿìè, ãåðàíÿìè è êèñåéíûìè çàíàâåñêàìè íà îêíàõ, áûëà â ýòó ìèíóòó ÿðêî îñâåùåíà çàõîäÿùèì ñîëíöåì. «È òîãäà, ñòàëî áûòü, òàê æå áóäåò ñîëíöå ñâåòèòü!..» — êàê áû íåâçíà÷àé ìåëüêíóëî â óìå Ðàñêîëüíèêîâà, è áûñòðûì âçãëÿäîì îêèíóë îí âñå â êîìíàòå, ÷òîáû ïî âîçìîæíîñòè èçó÷èòü è çàïîìíèòü ðàñïîëîæåíèå. Íî â êîìíàòå íå áûëî íè÷åãî îñîáåííîãî. Ìåáåëü, âñÿ î÷åíü ñòàðàÿ è èç æåëòîãî äåðåâà, ñîñòîÿëà èç äèâàíà ñ îãðîìíîþ âûãíóòîþ äåðåâÿííîþ ñïèíêîé, êðóãëîãî ñòîëà îâàëüíîé ôîðìû ïåðåä äèâàíîì, òóàëåòà ñ çåðêàëüöåì â ïðîñòåíêå, ñòóëüåâ ïî ñòåíàì íà äâóõòðåõ ãðîøîâûõ êàðòèíîê â æåëòûõ ðàìêàõ, èçîáðàæàâøèõ íåìåöêèõ áàðûøåíü ñ ïòèöàìè â ðóêàõ, — âîò è âñÿ ìåáåëü.  óãëó ïåðåä íåáîëüøèì îáðàçîì ãîðåëà ëàìïàäà. Âñå áûëî î÷åíü ÷èñòî: è ìåáåëü, è ïîëû áûëè îòòåðòû ïîä ëîñê; âñå áëåñòåëî. «Ëèçàâåòèíà ðàáîòà», — ïîäóìàë ìîëîäîé ÷åëîâåê. Íè ïûëèíêè íåëüçÿ áûëî íàéòè âî âñåé êâàðòèðå. «Ýòî ó çëûõ è ñòàðûõ âäîâèö áûâàåò òàêàÿ ÷èñòîòà», — ïðîäîëæàë ïðî ñåáÿ Ðàñêîëüíèêîâ è ñ ëþáîïûòñòâîì ïîêîñèëñÿ íà ñèòöåâóþ çàíàâåñêó ïåðåä äâåðüþ âî âòîðóþ, êðîøå÷íóþ êîìíàòêó, ãäå ñòîÿëè ñòàðóõèíû ïîñòåëü è êîìîä è êóäà îí åùå íè ðàçó íå çàãëÿäûâàë. Âñÿ êâàðòèðà ñîñòîÿëà èç ýòèõ äâóõ êîìíàò. — ×òî óãîäíî? — ñòðîãî ïðîèçíåñëà ñòàðóøîíêà, âõîäÿ â êîìíàòó è ïî-ïðåæíåìó ñòàíîâÿñü ïðÿìî ïåðåä íèì, ÷òîáû ãëÿäåòü åìó ïðÿìî â ëèöî. — Çàêëàä ïðèíåñ, âîò-ñ! — È îí âûíóë èç êàðìàíà ñòàðûå ïëîñêèå ñåðåáðÿíûå ÷àñû. Íà îáîðîòíîé äîùå÷êå èõ áûë èçîáðàæåí ãëîáóñ. Öåïî÷êà áûëà ñòàëüíàÿ. — Äà âåäü è ïðåæíåìó çàêëàäó ñðîê. Åùå òðåòüåãî äíÿ ìåñÿö êàê ìèíóë. — ß âàì ïðîöåíòû åùå çà ìåñÿö âíåñó; ïîòåðïèòå. — À â òîì ìîÿ äîáðàÿ âîëÿ, áàòþøêà, òåðïåòü èëè âåùü âàøó òåïåðü æå ïðîäàòü. — Ìíîãî ëü çà ÷àñû-òî, Àëåíà Èâàíîâíà? — À ñ ïóñòÿêàìè õîäèøü, áàòþøêà, íè÷åãî, ïî÷èòàé, íå ñòîèò. Çà êîëå÷êî âàì ïðîøëûé ðàç äâà áèëåòèêà âíåñëà, à îíî è êóïèòü-òî åãî íîâîå ó þâåëèðà çà ïîëòîðà ðóáëÿ ìîæíî. — Ðóáëÿ-òî ÷åòûðå äàéòå, ÿ âûêóïëþ, îòöîâñêèå. ß ñêîðî äåíüãè ïîëó÷ó. — Ïîëòîðà ðóáëÿ-ñ è ïðîöåíò âïåðåä, êîëè õîòèòå-ñ. — Ïîëòîðà ðóáëÿ! — âñêðèêíóë ìîëîäîé ÷åëîâåê. — Âàøà âîëÿ. — È ñòàðóõà ïðîòÿíóëà åìó îáðàòíî ÷àñû. Ìîëîäîé ÷åëîâåê âçÿë èõ è äî òîãî ðàññåðäèëñÿ, ÷òî õîòåë áûëî óæå óéòè; íî òîò÷àñ îäóìàëñÿ, âñïîìíèâ, ÷òî èäòè áîëüøå íåêóäà è ÷òî îí åùå è çà äðóãèì ïðèøåë. — Äàâàéòå! — ñêàçàë îí ãðóáî.
+Ñòàðóõà ïîëåçëà â êàðìàí çà êëþ÷àìè è ïîøëà â äðóãóþ êîìíàòó çà çàíàâåñêè. Ìîëîäîé ÷åëîâåê, îñòàâøèñü îäèí ñðåäè êîìíàòû, ëþáîïûòíî ïðèñëóøèâàëñÿ è ñîîáðàæàë. Ñëûøíî áûëî, êàê îíà îòïåðëà êîìîä. «Äîëæíî áûòü, âåðõíèé ÿùèê, — ñîîáðàæàë îí. — Êëþ÷è îíà, ñòàëî áûòü, â ïðàâîì êàðìàíå íîñèò… Âñå íà îäíîé ñâÿçêå, â ñòàëüíîì êîëüöå… È òàì îäèí êëþ÷ åñòü âñåõ áîëüøå, âòðîå, ñ çóá÷àòîþ áîðîäêîé, êîíå÷íî, íå îò êîìîäà… Ñòàëî áûòü, åñòü åùå êàêàÿ-íèáóäü øêàòóëêà, àëè óêëàäêà… Âîò ýòî ëþáîïûòíî. Ó óêëàäîê âñå òàêèå êëþ÷è… À âïðî÷åì, êàê ýòî ïîäëî âñå…» Ñòàðóõà âîðîòèëàñü. — Âîò-ñ, áàòþøêà: êîëè ïî ãðèâíå â ìåñÿö ñ ðóáëÿ, òàê çà ïîëòîðà ðóáëÿ ïðè÷òåòñÿ ñ âàñ ïÿòíàäöàòü êîïååê, çà ìåñÿö âïåðåä-ñ. Äà çà äâà ïðåæíèõ ðóáëÿ ñ âàñ åùå ïðè÷èòàåòñÿ ïî ñåìó æå ñ÷åòó âïåðåä äâàäöàòü êîïååê. À âñåãî, ñòàëî áûòü òðèäöàòü ïÿòü. Ïðèõîäèòñÿ æå âàì òåïåðü âñåãî ïîëó÷èòü çà ÷àñû âàøè ðóáëü ïÿòíàäöàòü êîïååê. Âîò ïîëó÷èòå-ñ. — Êàê! òàê óæ òåïåðü ðóáëü ïÿòíàäöàòü êîïååê! — Òî÷íî òàê-ñ. Ìîëîäîé ÷åëîâåê ñïîðèòü íå ñòàë è âçÿë äåíüãè. Îí ñìîòðåë íà ñòàðóõó è íå ñïåøèë óõîäèòü, òî÷íî åìó åùå õîòåëîñü ÷òî-òî ñêàçàòü èëè ñäåëàòü, íî êàê áóäòî îí è ñàì íå çíàë, ÷òî èìåííî… — ß âàì, Àëåíà Èâàíîâíà, ìîæåò áûòü, íà äíÿõ, åùå îäíó âåùü ïðèíåñó… ñåðåáðÿíóþ… õîðîøóþ… ïàïèðîñî÷íèöó îäíó… âîò êàê îò ïðèÿòåëÿ âîðî÷ó… — Îí ñìóòèëñÿ è çàìîë÷àë. — Íó òîãäà è áóäåì ãîâîðèòü, áàòþøêà. — Ïðîùàéòå-ñ… À âû âñå äîìà îäíè ñèäèòå, ñåñòðèöû-òî íåò? — ñïðîñèë îí êàê ìîæíî ðàçâÿçíåå, âûõîäÿ â ïåðåäíþþ. — À âàì êàêîå äî íåå, áàòþøêà, äåëî? — Äà íè÷åãî îñîáåííîãî. ß òàê ñïðîñèë. Óæ âû ñåé÷àñ… Ïðîùàéòå, Àëåíà Èâàíîâíà!
+Ðàñêîëüíèêîâ âûøåë â ðåøèòåëüíîì ñìóùåíèè. Ñìóùåíèå ýòî âñå áîëåå óâåëè÷èâàëîñü. Ñõîäÿ ïî ëåñòíèöå, îí íåñêîëüêî ðàç äàæå îñòàíàâëèâàëñÿ, êàê áóäòî ÷åì-òî âíåçàïíî ïîðàæåííûé. È íàêîíåö, óæå íà óëèöå, îí âîñêëèêíóë:
+«Î áîæå! êàê ýòî âñå îòâðàòèòåëüíî! È íåóæåëè, íåóæåëè ÿ… íåò, ýòî âçäîð, ýòî íåëåïîñòü! — ïðèáàâèë îí ðåøèòåëüíî. — È íåóæåëè òàêîé óæàñ ìîã ïðèéòè ìíå â ãîëîâó? Íà êàêóþ ãðÿçü ñïîñîáíî, îäíàêî, ìîå ñåðäöå! Ãëàâíîå: ãðÿçíî, ïàêîñòíî, ãàäêî, ãàäêî!.. È ÿ, öåëûé ìåñÿö…»
+Íî îí íå ìîã âûðàçèòü íè ñëîâàìè, íè âîñêëèöàíèÿìè ñâîåãî âîëíåíèÿ. ×óâñòâî áåñêîíå÷íîãî îòâðàùåíèÿ, íà÷èíàâøåå äàâèòü è ìóòèòü åãî ñåðäöå åùå â òî âðåìÿ, êàê îí òîëüêî øåë ê ñòàðóõå, äîñòèãëî òåïåðü òàêîãî ðàçìåðà è òàê ÿðêî âûÿñíèëîñü, ÷òî îí íå çíàë, êóäà äåòüñÿ îò òîñêè ñâîåé. Îí øåë ïî òðîòóàðó êàê ïüÿíûé, íå çàìå÷àÿ ïðîõîæèõ è ñòàëêèâàÿñü ñ íèìè, è îïîìíèëñÿ óæå â ñëåäóþùåé óëèöå. Îãëÿäåâøèñü, îí çàìåòèë, ÷òî ñòîèò ïîäëå ðàñïèâî÷íîé, â êîòîðóþ âõîä áûë ñ òðîòóàðà ïî ëåñòíèöå âíèç, â ïîäâàëüíûé ýòàæ. Èç äâåðåé, êàê ðàç â ýòó ìèíóòó, âûõîäèëè äâîå ïüÿíûõ è, äðóã äðóãà ïîääåðæèâàÿ è ðóãàÿ, âçáèðàëèñü íà óëèöó. Äîëãî íå äóìàÿ, Ðàñêîëüíèêîâ òîò÷àñ æå ñïóñòèëñÿ âíèç. Íèêîãäà äî ñèõ ïîð íå âõîäèë îí â ðàñïèâî÷íûå, íî òåïåðü ãîëîâà åãî êðóæèëàñü, è ê òîìó æå ïàëÿùàÿ æàæäà òîìèëà åãî. Åìó çàõîòåëîñü âûïèòü õîëîäíîãî ïèâà, òåì áîëåå ÷òî âíåçàïíóþ ñëàáîñòü ñâîþ îí îòíîñèë è ê òîìó, ÷òî áûë ãîëîäåí. Îí óñåëñÿ â òåìíîì è ãðÿçíîì óãëó, çà ëèïêèì ñòîëèêîì, ñïðîñèë ïèâà è ñ æàäíîñòèþ âûïèë ïåðâûé ñòàêàí. Òîò÷àñ æå âñå îòëåãëî, è ìûñëè åãî ïðîÿñíåëè. «Âñå ýòî âçäîð, — ñêàçàë îí ñ íàäåæäîé, — è íå÷åì òóò áûëî ñìóùàòüñÿ! Ïðîñòî ôèçè÷åñêîå ðàññòðîéñòâî! Îäèí êàêîé-íèáóäü ñòàêàí ïèâà, êóñîê ñóõàðÿ, — è âîò, â îäèí ìèã, êðåïíåò óì, ÿñíååò ìûñëü, òâåðäåþò íàìåðåíèÿ! Òüôó, êàêîå âñå ýòî íè÷òîæåñòâî!..» Íî, íåñìîòðÿ íà ýòîò ïðåçðèòåëüíûé ïëåâîê, îí ãëÿäåë óæå âåñåëî, êàê áóäòî âíåçàïíî îñâîáîäÿñü îò êàêîãî-òî óæàñíîãî áðåìåíè, è äðóæåëþáíî îêèíóë ãëàçàìè ïðèñóòñòâóþùèõ. Íî äàæå è â ýòó ìèíóòó îí îòäàëåííî ïðåä÷óâñòâîâàë, ÷òî âñÿ ýòà âîñïðèèì÷èâîñòü ê ëó÷øåìó áûëà òîæå áîëåçíåííàÿ.
+ ðàñïèâî÷íîé íà òó ïîðó îñòàâàëîñü ìàëî íàðîäó. Êðîìå òåõ äâóõ ïüÿíûõ, ÷òî ïîïàëèñü íà ëåñòíèöå, âñëåä çà íèìè æå âûøëà åùå ðàçîì öåëàÿ âàòàãà, ÷åëîâåê â ïÿòü, ñ îäíîþ äåâêîé è ñ ãàðìîíèåé. Ïîñëå íèõ ñòàëî òèõî è ïðîñòîðíî. Îñòàëèñü: îäèí õìåëüíîé, íî íåìíîãî, ñèäåâøèé çà ïèâîì, ñ âèäó ìåùàíèí; òîâàðèù åãî, òîëñòûé, îãðîìíûé, â ñèáèðêå è ñ ñåäîþ áîðîäîé, î÷åíü çàõìåëåâøèé, çàäðåìàâøèé íà ëàâêå è èçðåäêà, âäðóã, êàê áû ñïðîñîíüÿ, íà÷èíàâøèé ïðèùåëêèâàòü ïàëüöàìè, ðàññòàâèâ ðóêè âðîçü, è ïîäïðûãèâàòü âåðõíåþ ÷àñòèþ êîðïóñà, íå âñòàâàÿ ñ ëàâêè, ïðè÷åì ïîäïåâàë êàêóþ-òî åðóíäó, ñèëÿñü ïðèïîìíèòü ñòèõè, âðîäå:
+Öåëûé ãîä æåíó ëàñêàë,
+Öåë-ëûé ãîä æå-íó ëàñ-êàë…
+Èëè âäðóã, ïðîñíóâøèñü, îïÿòü:
+Ïî Ïîäüÿ÷åñêîé ïîøåë,
+Ñâîþ ïðåæíþþ íàøåë…
+Íî íèêòî íå ðàçäåëÿë åãî ñ÷àñòèÿ; ìîë÷àëèâûé òîâàðèù åãî ñìîòðåë íà âñå ýòè âçðûâû äàæå âðàæäåáíî è ñ íåäîâåð÷èâîñòüþ. Áûë òóò è åùå îäèí ÷åëîâåê, ñ âèäó ïîõîæèé êàê áû íà îòñòàâíîãî ÷èíîâíèêà. Îí ñèäåë îñîáî, ïåðåä ñâîåþ ïîñóäèíêîé, èçðåäêà îòïèâàÿ è ïîñìàòðèâàÿ êðóãîì. Îí áûë òîæå êàê áóäòî â íåêîòîðîì âîëíåíèè.
+
+Ðàñêîëüíèêîâ íå ïðèâûê ê òîëïå è, êàê óæå ñêàçàíî, áåæàë âñÿêîãî îáùåñòâà, îñîáåííî â ïîñëåäíåå âðåìÿ. Íî òåïåðü åãî âäðóã ÷òî-òî ïîòÿíóëî ê ëþäÿì. ×òî-òî ñîâåðøàëîñü â íåì êàê áû íîâîå, è âìåñòå ñ òåì îùóòèëàñü êàêàÿ-òî æàæäà ëþäåé. Îí òàê óñòàë îò öåëîãî ìåñÿöà ýòîé ñîñðåäîòî÷åííîé òîñêè ñâîåé è ìðà÷íîãî âîçáóæäåíèÿ, ÷òî õîòÿ îäíó ìèíóòó õîòåëîñü åìó âçäîõíóòü â äðóãîì ìèðå, õîòü áû â êàêîì áû òî íè áûëî, è, íåñìîòðÿ íà âñþ ãðÿçü îáñòàíîâêè, îí ñ óäîâîëüñòâèåì îñòàâàëñÿ òåïåðü â ðàñïèâî÷íîé.
+Õîçÿèí çàâåäåíèÿ áûë â äðóãîé êîìíàòå, íî ÷àñòî âõîäèë â ãëàâíóþ, ñïóñêàÿñü â íåå îòêóäà-òî ïî ñòóïåíüêàì, ïðè÷åì ïðåæäå âñåãî âûêàçûâàëèñü åãî ùåãîëüñêèå ñìàçíûå ñàïîãè ñ áîëüøèìè êðàñíûìè îòâîðîòàìè. Îí áûë â ïîääåâêå è â ñòðàøíî çàñàëåííîì ÷åðíîì àòëàñíîì æèëåòå, áåç ãàëñòóêà, à âñå ëèöî åãî áûëî êàê áóäòî ñìàçàíî ìàñëîì, òî÷íî æåëåçíûé çàìîê. Çà çàñòîéêîé íàõîäèëñÿ ìàëü÷èøêà ëåò ÷åòûðíàäöàòè, è áûë äðóãîé ìàëü÷èøêà ìîëîæå, êîòîðûé ïîäàâàë, åñëè ÷òî ñïðàøèâàëè. Ñòîÿëè êðîøåíûå îãóðöû, ÷åðíûå ñóõàðè è ðåçàííàÿ êóñî÷êàìè ðûáà; âñå ýòî î÷åíü äóðíî ïàõëî. Áûëî äóøíî, òàê ÷òî áûëî äàæå íåñòåðïèìî ñèäåòü, è âñå äî òîãî áûëî ïðîïèòàíî âèííûì çàïàõîì, ÷òî, êàæåòñÿ, îò îäíîãî ýòîãî âîçäóõà ìîæíî áûëî â ïÿòü ìèíóò ñäåëàòüñÿ ïüÿíûì.
+Áûâàþò èíûå âñòðå÷è, ñîâåðøåííî äàæå ñ íåçíàêîìûìè íàì ëþäüìè, êîòîðûìè ìû íà÷èíàåì èíòåðåñîâàòüñÿ ñ ïåðâîãî âçãëÿäà, êàê-òî âäðóã, âíåçàïíî, ïðåæäå ÷åì ñêàæåì ñëîâî. Òàêîå òî÷íî âïå÷àòëåíèå ïðîèçâåë íà Ðàñêîëüíèêîâà òîò ãîñòü, êîòîðûé ñèäåë ïîîäàëü è ïîõîäèë íà îòñòàâíîãî ÷èíîâíèêà. Ìîëîäîé ÷åëîâåê íåñêîëüêî ðàç ïðèïîìèíàë ïîòîì ýòî ïåðâîå âïå÷àòëåíèå è äàæå ïðèïèñûâàë åãî ïðåä÷óâñòâèþ. Îí áåñïðåðûâíî âçãëÿäûâàë íà ÷èíîâíèêà, êîíå÷íî, è ïîòîìó åùå, ÷òî è ñàì òîò óïîðíî ñìîòðåë íà íåãî, è âèäíî áûëî, ÷òî òîìó î÷åíü õîòåëîñü íà÷àòü ðàçãîâîð. Íà îñòàëüíûõ æå, áûâøèõ â ðàñïèâî÷íîé, íå èñêëþ÷àÿ è õîçÿèíà, ÷èíîâíèê ñìîòðåë êàê-òî ïðèâû÷íî è äàæå ñî ñêóêîé, à âìåñòå ñ òåì è ñ îòòåíêîì íåêîòîðîãî âûñîêîìåðíîãî ïðåíåáðåæåíèÿ, êàê áû íà ëþäåé íèçøåãî ïîëîæåíèÿ è ðàçâèòèÿ, ñ êîòîðûìè íå÷åãî åìó ãîâîðèòü. Ýòî áûë ÷åëîâåê ëåò óæå çà ïÿòüäåñÿò, ñðåäíåãî ðîñòà è ïëîòíîãî ñëîæåíèÿ, ñ ïðîñåäüþ è ñ áîëüøîþ ëûñèíîé, ñ îòåêøèì îò ïîñòîÿííîãî ïüÿíñòâà æåëòûì, äàæå çåëåíîâàòûì ëèöîì è ñ ïðèïóõøèìè âåêàìè, èç-çà êîòîðûõ ñèÿëè êðîøå÷íûå, êàê ùåëî÷êè, íî îäóøåâëåííûå êðàñíîâàòûå ãëàçêè. Íî ÷òî-òî áûëî â íåì î÷åíü ñòðàííîå; âî âçãëÿäå åãî ñâåòèëàñü êàê áóäòî äàæå âîñòîðæåííîñòü, — ïîæàëóé, áûë è ñìûñë è óì, — íî â òî æå âðåìÿ ìåëüêàëî êàê áóäòî è áåçóìèå. Îäåò îí áûë â ñòàðûé, ñîâåðøåííî îáîðâàííûé ÷åðíûé ôðàê, ñ îñûïàâøèìèñÿ ïóãîâèöàìè. Îäíà òîëüêî åùå äåðæàëàñü êîå-êàê, è íà íåå-òî îí è çàñòåãèâàëñÿ, âèäèìî æåëàÿ íå óäàëÿòüñÿ ïðèëè÷èé. Èç-ïîä íàíêîâîãî æèëåòà òîð÷àëà ìàíèøêà, âñÿ ñêîìêàííàÿ, çàïà÷êàííàÿ è çàëèòàÿ. Ëèöî áûëî âûáðèòî, ïî-÷èíîâíè÷üè, íî äàâíî óæå, òàê ÷òî óæå ãóñòî íà÷àëà âûñòóïàòü ñèçàÿ ùåòèíà. Äà è â óõâàòêàõ åãî äåéñòâèòåëüíî áûëî ÷òî-òî ñîëèäíî-÷èíîâíè÷üå. Íî îí áûë â áåñïîêîéñòâå, åðîøèë âîëîñû è ïîäïèðàë èíîãäà, â òîñêå, îáåèìè ðóêàìè ãîëîâó, ïîëîæà ïðîäðàííûå ëîêòè íà çàëèòûé è ëèïêèé ñòîë. Íàêîíåö îí ïðÿìî ïîñìîòðåë íà Ðàñêîëüíèêîâà è ãðîìêî è òâåðäî ïðîãîâîðèë: — À îñìåëþñü ëè, ìèëîñòèâûé ãîñóäàðü ìîé, îáðàòèòüñÿ ê âàì ñ ðàçãîâîðîì ïðèëè÷íûì? Èáî õîòÿ âû è íå â çíà÷èòåëüíîì âèäå, íî îïûòíîñòü ìîÿ îòëè÷àåò â âàñ ÷åëîâåêà îáðàçîâàííîãî è ê íàïèòêó íåïðèâû÷íîãî. Ñàì âñåãäà óâàæàë îáðàçîâàííîñòü, ñîåäèíåííóþ ñ ñåðäå÷íûìè ÷óâñòâàìè, è, êðîìå òîãî, ñîñòîþ òèòóëÿðíûì ñîâåòíèêîì. Ìàðìåëàäîâ — òàêàÿ ôàìèëèÿ; òèòóëÿðíûé ñîâåòíèê. Îñìåëþñü óçíàòü, ñëóæèòü èçâîëèëè? — Íåò, ó÷óñü… — îòâå÷àë ìîëîäîé ÷åëîâåê, îò÷àñòè óäèâëåííûé è îñîáåííûì âèòèåâàòûì òîíîì ðå÷è, è òåì, ÷òî òàê ïðÿìî, â óïîð, îáðàòèëèñü ê íåìó. Íåñìîòðÿ íà íåäàâíåå ìãíîâåííîå æåëàíèå õîòÿ êàêîãî áû íè áûëî ñîîáùåñòâà ñ ëþäüìè, îí ïðè ïåðâîì, äåéñòâèòåëüíî îáðàùåííîì ê íåìó ñëîâå âäðóã îùóòèë ñâîå îáû÷íîå íåïðèÿòíîå è ðàçäðàæèòåëüíîå ÷óâñòâî îòâðàùåíèÿ êî âñÿêîìó ÷óæîìó ëèöó, êàñàâøåìóñÿ èëè õîòåâøåìó òîëüêî ïðèêîñíóòüñÿ ê åãî ëè÷íîñòè. — Ñòóäåíò, ñòàëî áûòü, èëè áûâøèé ñòóäåíò! — âñêðè÷àë ÷èíîâíèê, — òàê ÿ è äóìàë! Îïûò, ìèëîñòèâûé ãîñóäàðü, íåîäíîêðàòíûé îïûò! — è â çíàê ïîõâàëüáû îí ïðèëîæèë ïàëåö êî ëáó. — Áûëè ñòóäåíòîì èëè ïðîèñõîäèëè ó÷åíóþ ÷àñòü! À ïîçâîëüòå… — Îí ïðèâñòàë, ïîêà÷íóëñÿ, çàõâàòèë ñâîþ ïîñóäèíêó, ñòàêàí÷èê, è ïîäñåë ê ìîëîäîìó ÷åëîâåêó, íåñêîëüêî îò íåãî íàèñêîñü. Îí áûë õìåëåí, íî ãîâîðèë ðå÷èñòî è áîéêî, èçðåäêà òîëüêî ìåñòàìè ñáèâàÿñü íåìíîãî è çàòÿãèâàÿ ðå÷ü. Ñ êàêîþ-òî äàæå æàäíîñòèþ íàêèíóëñÿ îí íà Ðàñêîëüíèêîâà, òî÷íî öåëûé ìåñÿö òîæå íè ñ êåì íå ãîâîðèë. — Ìèëîñòèâûé ãîñóäàðü, — íà÷àë îí ïî÷òè ñ òîðæåñòâåííîñòèþ, — áåäíîñòü íå ïîðîê, ýòî èñòèíà. Çíàþ ÿ, ÷òî è ïüÿíñòâî íå äîáðîäåòåëü, è ýòî òåì ïà÷å. Íî íèùåòà, ìèëîñòèâûé ãîñóäàðü, íèùåòà — ïîðîê-ñ.  áåäíîñòè âû åùå ñîõðàíÿåòå ñâîå áëàãîðîäñòâî âðîæäåííûõ ÷óâñòâ, â íèùåòå æå íèêîãäà è íèêòî. Çà íèùåòó äàæå è íå ïàëêîé âûãîíÿþò, à ìåòëîé âûìåòàþò èç êîìïàíèè ÷åëîâå÷åñêîé, ÷òîáû òåì îñêîðáèòåëüíåå áûëî; è ñïðàâåäëèâî, èáî â íèùåòå ÿ ïåðâûé ñàì ãîòîâ îñêîðáëÿòü ñåáÿ. È îòñþäà ïèòåéíîå! Ìèëîñòèâûé ãîñóäàðü, ìåñÿö íàçàä òîìó ñóïðóãó ìîþ èçáèë ãîñïîäèí Ëåáåçÿòíèêîâ, à ñóïðóãà ìîÿ íå òî ÷òî ÿ! Ïîíèìàåòå-ñ? Ïîçâîëüòå åùå âàñ ñïðîñèòü, òàê, õîòÿ áû â âèäå ïðîñòîãî ëþáîïûòñòâà: èçâîëèëè âû íî÷åâàòü íà Íåâå, íà ñåííûõ áàðêàõ? — Íåò, íå ñëó÷àëîñü, — îòâå÷àë Ðàñêîëüíèêîâ. — Ýòî ÷òî òàêîå? — Íó-ñ, à ÿ îòòóäà, è óæå ïÿòóþ íî÷ü-ñ…
+Îí íàëèë ñòàêàí÷èê, âûïèë è çàäóìàëñÿ. Äåéñòâèòåëüíî, íà åãî ïëàòüå è äàæå â âîëîñàõ êîå-ãäå âèäíåëèñü ïðèëèïøèå áûëèíêè ñåíà. Î÷åíü âåðîÿòíî áûëî, ÷òî îí ïÿòü äíåé íå ðàçäåâàëñÿ è íå óìûâàëñÿ. Îñîáåííî ðóêè áûëè ãðÿçíû, æèðíûå, êðàñíûå, ñ ÷åðíûìè íîãòÿìè.
+Åãî ðàçãîâîð, êàçàëîñü, âîçáóäèë îáùåå, õîòÿ è ëåíèâîå âíèìàíèå. Ìàëü÷èøêè çà ñòîéêîé ñòàëè õèõèêàòü. Õîçÿèí, êàæåòñÿ, íàðî÷íî ñîøåë èç âåðõíåé êîìíàòû, ÷òîáû ïîñëóøàòü «çàáàâíèêà», è ñåë ïîîäàëü, ëåíèâî, íî âàæíî ïîçåâûâàÿ. Î÷åâèäíî, Ìàðìåëàäîâ áûë çäåñü äàâíî èçâåñòåí. Äà è íàêëîííîñòü ê âèòèåâàòîé ðå÷è ïðèîáðåë, âåðîÿòíî, âñëåäñòâèå ïðèâû÷êè ê ÷àñòûì êàáà÷íûì ðàçãîâîðàì ñ ðàçëè÷íûìè íåçíàêîìöàìè. Ýòà ïðèâû÷êà îáðàùàåòñÿ ó èíûõ ïüþùèõ â ïîòðåáíîñòü, è ïðåèìóùåñòâåííî ó òåõ èç íèõ, ñ êîòîðûìè äîìà îáõîäÿòñÿ ñòðîãî è êîòîðûìè ïîìûêàþò. Îòòîãî-òî â ïüþùåé êîìïàíèè îíè è ñòàðàþòñÿ âñåãäà êàê áóäòî âûõëîïîòàòü ñåáå îïðàâäàíèå, à åñëè ìîæíî, òî äàæå è óâàæåíèå. — Çàáàâíèê! — ãðîìêî ïðîãîâîðèë õîçÿèí. — À äëÿ ÷à íå ðàáîòàåøü, äëÿ ÷à íå ñëóæèòå, êîëè ÷èíîâíèê? — Äëÿ ÷åãî ÿ íå ñëóæó, ìèëîñòèâûé ãîñóäàðü, — ïîäõâàòèë Ìàðìåëàäîâ, èñêëþ÷èòåëüíî îáðàùàÿñü ê Ðàñêîëüíèêîâó, êàê áóäòî ýòî îí åìó çàäàë âîïðîñ, — äëÿ ÷åãî íå ñëóæó? À ðàçâå ñåðäöå ó ìåíÿ íå áîëèò î òîì, ÷òî ÿ ïðåñìûêàþñü âòóíå? Êîãäà ãîñïîäèí Ëåáåçÿòíèêîâ, òîìó ìåñÿö íàçàä, ñóïðóãó ìîþ ñîáñòâåííîðó÷íî èçáèë, à ÿ ëåæàë ïüÿíåíüêîé, ðàçâå ÿ íå ñòðàäàë? Ïîçâîëüòå, ìîëîäîé ÷åëîâåê, ñëó÷àëîñü âàì… ãì… íó õîòü èñïðàøèâàòü äåíåã âçàéìû áåçíàäåæíî? — Ñëó÷àëîñü… òî åñòü êàê áåçíàäåæíî? — Òî åñòü áåçíàäåæíî âïîëíå-ñ, çàðàíåå çíàÿ, ÷òî èç ñåãî íè÷åãî íå âûéäåò. Âîò âû çíàåòå, íàïðèìåð, çàðàíåå è äîñêîíàëüíî, ÷òî ñåé ÷åëîâåê, ñåé áëàãîíàìåðåííåéøèé è íàèïîëåçíåéøèé ãðàæäàíèí, íè çà ÷òî âàì äåíåã íå äàñò, èáî çà÷åì, ñïðîøó ÿ, îí äàñò? Âåäü îí çíàåò æå, ÷òî ÿ íå îòäàì. Èç ñîñòðàäàíèÿ? Íî ãîñïîäèí Ëåáåçÿòíèêîâ, ñëåäÿùèé çà íîâûìè ìûñëÿìè, îáúÿñíÿë íàìåäíè, ÷òî ñîñòðàäàíèå â íàøå âðåìÿ äàæå íàóêîé âîñïðåùåíî è ÷òî òàê óæå äåëàåòñÿ â Àíãëèè, ãäå ïîëèòè÷åñêàÿ ýêîíîìèÿ. Çà÷åì æå, ñïðîøó ÿ, îí äàñò? È âîò, çíàÿ âïåðåä, ÷òî íå äàñò, âû âñå-òàêè îòïðàâëÿåòåñü â ïóòü è… — Äëÿ ÷åãî æå õîäèòü? — ïðèáàâèë Ðàñêîëüíèêîâ. — À êîëè íå ê êîìó, êîëè èäòè áîëüøå íåêóäà! Âåäü íàäîáíî æå, ÷òîáû âñÿêîìó ÷åëîâåêó õîòü êóäà-íèáóäü ìîæíî áûëî ïîéòè. Èáî áûâàåò òàêîå âðåìÿ, êîãäà íåïðåìåííî íàäî õîòü êóäà-íèáóäü äà ïîéòè! Êîãäà åäèíîðîäíà äî÷ü ìîÿ â ïåðâûé ðàç ïî æåëòîìó áèëåòó ïîøëà, è ÿ òîæå òîãäà ïîøåë… (èáî äî÷ü ìîÿ ïî æåëòîìó áèëåòó æèâåò-ñ…) — ïðèáàâèë îí â ñêîáêàõ, ñ íåêîòîðûì áåñïîêîéñòâîì ñìîòðÿ íà ìîëîäîãî ÷åëîâåêà. — Íè÷åãî, ìèëîñòèâûé ãîñóäàðü, íè÷åãî! — ïîñïåøèë îí òîò÷àñ æå, è ïî-âèäèìîìó ñïîêîéíî, çàÿâèòü, êîãäà ôûðêíóëè îáà ìàëü÷èøêè çà ñòîéêîé è óëûáíóëñÿ ñàì õîçÿèí. — Íè÷åãî-ñ! Ñèì ïîêèâàíèåì ãëàâ íå ñìóùàþñü, èáî óæå âñåì âñå èçâåñòíî è âñå òàéíîå ñòàíîâèòüñÿ ÿâíûì; è íå ñ ïðåçðåíèåì, à ñî ñìèðåíèåì ê ñåìó îòíîøóñü. Ïóñòü! ïóñòü! «Ñå ÷åëîâåê!» Ïîçâîëüòå, ìîëîäîé ÷åëîâåê: ìîæåòå ëè âû… Íî íåò, èçúÿñíèòü ñèëüíåå è èçîáðàçèòåëüíåå: íå ìîæåòå ëè âû, à îñìåëèòåñü ëè âû, âçèðàÿ â ñåé ÷àñ íà ìåíÿ, ñêàçàòü óòâåðäèòåëüíî, ÷òî ÿ íå ñâèíüÿ? Ìîëîäîé ÷åëîâåê íå îòâå÷àë íè ñëîâà.
+— Íó-ñ, — ïðîäîëæàë îðàòîð, ñîëèäíî è äàæå ñ óñèëåííûì íà ýòîò ðàç äîñòîèíñòâîì ïåðåæäàâ îïÿòü ïîñëåäîâàâøåå â êîìíàòå õèõèêàíèå. — Íó-ñ, ÿ ïóñòü ñâèíüÿ, à îíà äàìà! ß çâåðèíûé îáðàç èìåþ, à Êàòåðèíà Èâàíîâíà, ñóïðóãà ìîÿ, — îñîáà îáðàçîâàííàÿ è óðîæäåííàÿ øòàá-îôèöåðñêàÿ äî÷ü. Ïóñòü, ïóñòü ÿ ïîäëåö, îíà æå è ñåðäöà âûñîêîãî, è ÷óâñòâ, îáëàãîðîæåííûõ âîñïèòàíèåì, èñïîëíåíà. À ìåæäó òåì… î, åñëè á îíà ïîæàëåëà ìåíÿ! Ìèëîñòèâûé ãîñóäàðü, ìèëîñòèâûé ãîñóäàðü, âåäü íàäîáíî æå, ÷òîá ó âñÿêîãî ÷åëîâåêà áûëî õîòü îäíî òàêîå ìåñòî, ãäå áû è åãî ïîæàëåëè! À Êàòåðèíà Èâàíîâíà äàìà õîòÿ è âåëèêîäóøíàÿ, íî íåñïðàâåäëèâàÿ… È õîòÿ ÿ è ñàì ïîíèìàþ, ÷òî êîãäà îíà è âèõðû ìîè äåðåò, òî äåðåò èõ íå èíà÷å êàê îò æàëîñòè ñåðäöà (èáî, ïîâòîðÿþ áåç ñìóùåíèÿ, îíà äåðåò ìíå âèõðû, ìîëîäîé ÷åëîâåê, — ïîäòâåðäèë îí ñ ñóãóáûì äîñòîèíñòâîì, óñëûøàâ îïÿòü õèõèêàíüå), íî, áîæå, ÷òî åñëè á îíà õîòÿ îäèí ðàç… Íî íåò! íåò! âñå ñèå âòóíå, è íå÷åãî ãîâîðèòü! íå÷åãî ãîâîðèòü!.. èáî è íå îäèí ðàç óæå áûâàëî æåëàåìîå, è íå îäèí óæå ðàç æàëåëè ìåíÿ, íî… òàêîâà óæå ÷åðòà ìîÿ, à ÿ ïðèðîæäåííûé ñêîò! — Åùå áû! — çàìåòèë, çåâàÿ, õîçÿèí. Ìàðìåëàäîâ ðåøèòåëüíî ñòóêíóë êóëàêîì ïî ñòîëó. — Òàêîâà óæ ÷åðòà ìîÿ! Çíàåòå ëè, çíàåòå ëè âû, ãîñóäàðü ìîé, ÷òî ÿ äàæå ÷óëêè åå ïðîïèë? Íå áàøìàêè-ñ, èáî ýòî õîòÿ ñêîëüêî-íèáóäü ïîõîäèëî áû íà ïîðÿäîê âåùåé, à ÷óëêè, ÷óëêè åå ïðîïèë-ñ! Êîñûíî÷êó åå èç êîçüåãî ïóõà òîæå ïðîïèë, äàðåíóþ, ïðåæíþþ, åå ñîáñòâåííóþ, íå ìîþ; à æèâåì ìû â õîëîäíîì óãëå, è îíà â ýòó çèìó ïðîñòóäèëàñü è êàøëÿòü ïîøëà, óæå êðîâüþ. Äåòåé æå ìàëåíüêèõ ó íàñ òðîå, è Êàòåðèíà Èâàíîâíà â ðàáîòå ñ óòðà äî íî÷è ñêðåáåò è ìîåò è äåòåé îáìûâàåò, èáî ê ÷èñòîòå ñ èçìàëåòñòâà ïðèâûêëà, à ñ ãðóäüþ ñëàáîþ è ê ÷àõîòêå íàêëîííîþ, è ÿ ýòî ÷óâñòâóþ. Ðàçâå ÿ íå ÷óâñòâóþ? È ÷åì áîëåå ïüþ, òåì áîëåå è ÷óâñòâóþ. Äëÿ òîãî è ïüþ, ÷òî â ïèòèè ñåì ñîñòðàäàíèÿ è ÷óâñòâà èùó. Íå âåñåëüÿ, à åäèíîé ñêîðáè èùó… Ïüþ, èáî ñóãóáî ñòðàäàòü õî÷ó! — È îí, êàê áû â îò÷àÿíèè, ñêëîíèë íà ñòîë ãîëîâó.
\ No newline at end of file
diff --git a/libraries/base/tests/IO/encoded-data/CP936-UTF8.txt b/libraries/base/tests/IO/encoded-data/CP936-UTF8.txt
new file mode 100644
index 000000000000..1e30cd4e7e28
--- /dev/null
+++ b/libraries/base/tests/IO/encoded-data/CP936-UTF8.txt
@@ -0,0 +1,153 @@
+《毛主席语录》全集(毛泽东语录)
+作者：毛泽东
+申明:本书由枫�文学网[www.fywxw.com]自网络收集整�制作,仅供预览交�学习使用,版�归原作者和出版社所有,如果喜欢,请支�订阅购买正版.
+
+《毛主席语录》�版�言
+
+(一�六六年�二月�六日)
+
+林彪
+
+毛泽东�志是当代最伟大的马克�列�主义者。毛泽东�志天�地�创造性地�全�地继承���和�展了马克�列�主义，把马克�列�主义�高到一个崭新的阶段。
+
+ 毛泽东�想是在�国主义走�全�崩溃，社会主义走�全世界胜利的时代的马克�列�主义。毛泽东�想是�对�国主义的强大的�想武器，是�对修正主义和教�主义的强大的�想武器。毛泽东�想是全党�全军和全国一切工作的指导方针。
+
+因此，永远高举毛泽东�想伟大红旗，用毛泽东�想武装全国人民的头脑，��在一切工作中用毛泽东�想挂帅，是我党政治�想工作最根本的任务。广大工农兵群众�广大�命干部和广大知识分�，都必须把毛泽东�想真正学到手，�到人人读毛主席的书，�毛主席的�，照毛主席的指示办事，�毛主席的好战士。
+
+学习毛主席著作，�带�问题学，活学活用，学用结�，急用先学，立竿�影，在“用�字上狠下功夫。为了把毛泽东�想真正学到手，���学习毛主席的许多基本观点，有些警�最好�背熟，��学习，���用。在报纸上，��常结�实际，刊登毛主席的语录，供大家学习和�用。几年�广大群众活学活用毛主席著作的�验，�明带�问题选学毛主席的语录，是一�学习毛泽东�想的好方法，容易收到立竿�影的效果。
+
+为了帮助广大群众更好地学习毛泽东�想，我们选编了这本《毛主席语录》。���在组织学习的时候，应当结�形势�任务�群众的�想情况和工作情况，选学有关的内容。
+
+现在我们伟大的祖国，正在出现一个工农兵掌�马克�列�主义�毛泽东�想的新时代。毛泽东�想为广大群众所掌�，就会��无穷无尽的力�，���力无比的精神原�弹。《毛主席语录》的大�出版，对广大群众掌�毛泽东�想，推动我国人民�想�命化，是一个�为��的措施。希望�个�志认真地�刻苦地学习，在全国范围内，掀起活学活用毛主席著作的新高潮，在毛泽东�想的伟大红旗下，为把我国建设�为一个具有现代农业，现代工业，现代科学文化和现代国防的伟大社会主义国家而奋斗�
+
+一�共产党
+
+领导我们事业的核心力�是中国共产党。
+
+指导我们�想的�论基础是马克�列�主义。
+
+          ——《中�人民共和国第一届全国人民代表大会第一次会议开幕�》（一�五四年�月�五日），一�五四年�月�六日《人民日报》
+
+
+
+既��命，就�有一个�命的党。没有一个�命的党，没有一个按照马克�列�主义的�命�论和�命风格建立起�的�命党，就��能领导工人阶级和广大人民群众战胜�国主义�其走狗。
+
+          ——《全世界�命力�团结起�，�对�国主义的侵略》（一�四八年�一月），《毛泽东选集》第四�第一三六零页。
+
+
+
+没有中国共产党的努力，没有中国共产党人�中国人民的中�砥柱，中国的独立和解放是��能的，中国的工业化和农业近代化也是��能的。
+
+          ——《论��政府》（一�四五年四月二�四日），《毛泽东选集》第三�第一零�八-一零��页。
+
+
+
+中国共产党是全中国人民的领导核心。没有这样一个核心，社会主义事业就�能胜利。
+
+          ——《在接�出席中国新民主主义�年团第三次全国代表大会的全体代表时的讲�》（一�五七年五月二�五日），《新��月刊》一�五七年第�二�第五七页。
+
+
+
+一个有纪律的，有马克�列�主义的�论武装的，采�自我批评方法的，�系人民群众的党。一个由这样的党领导的军队。一个由这样的党领导的��命阶级��命派别的统一战线。这三件是我们战胜敌人的主�武器。
+
+          ——《论人民民主专政》（一�四�年六月三�日），《毛泽东选集》第四�第一四八四页。
+
+
+
+我们应当相信群众，我们应当相信党，这是两�根本的原�。如果怀疑这两�原�，那就什么事情也���了。
+
+          ——《关于农业�作化问题》（一�五五年七月三�一日），人民出版社第�页。
+
+
+
+以马克�列�主义的�论�想武装起�的中国共产党，在中国人民中产生了新的工作作风，这主�的就是�论和实践相结�的作风，和人民群众紧密地�系在一起的作风以�自我批评的作风。
+
+          ——《论��政府》（一�四五年四月二�四日），《毛泽东选集》第三�第一零�四—一零�五页。
+
+
+
+指导一个伟大的�命�动的政党，如果没有�命�论，没有历�知识，没有对于实际�动的深刻的了解，��得胜利是��能的。
+
+          ——《中国共产党在民�战争中的地�》（一�三八年�月），《毛泽东选集》第二�第五二一页。
+
+我们过去说过，整风�动是一个“普�的马克�主义的教育�动�。整风就是全党通过批评和自我批评�学习马克�主义。在整风中间，我们一定�以更多地学到一些马克�主义。
+
+          ——《在中国共产党全国宣传工作会议上的讲�》（一�五七年三月�二日），人民出版社版第一一页。
+
+
+
+�使几亿人中的中国人生活得好，�把我们这个�济���文化��的国家，建设�为富裕的�强盛的�具有高度文化的国家，这是一个很艰巨的任务。我们所以�整风，现在�整风，将�还�整风，��断把我们身上的错误东西整掉，就是为了使我们能够更好地担负起这项任务，更好地�党外的一切立志改�的志士�人共�工作。
+
+          ——《在中国共产党全国宣传工作会议上的讲�》（一�五七年三月�二日），人民出版社版第一二页。
+
+
+
+政策是�命政党一切实际行动的出�点，并且表现于行动的过程和归宿。一个�命政党的任何行动都是实行政策。�是实行正确的政策，就是实行错误的政策；�是自觉地，就是盲目地实行��政策。所谓�验，就是实行政策的过程和归宿。政策必须在人民实践中，也就是�验中，�能�明其正确与�，�能确定其正确和错误的程度。但是，人们的实践，特别是�命政党和�命群众的实践，没有��这�或那�政策相�系的。因此，在�一行动之�，必须�党员和群众讲明我们按情况规定的政策。�则，党员和群众就会脱离我们政策的领导而盲目行动，执行错误的政策。
+
+          ——《关于工商业政策》（一�四八年二月二�七日），《毛泽东选集》第四�第一二八四页。
+
+
+
+我党规定了中国�命的总路线和总政策，�规定了�项具体的工作路线和�项具体的政策。但是，许多�志往往记�了我党的具体的个别的工作路线和政策，忘记了我党的总路线和总政策。而如果真正忘记了我党的总路线和总政策，我们就将是一个盲目的�完全的�清醒的�命者，在我们执行具体工作路线和具体政策的时候，就会迷失方�，就会左�摇摆，就会贻误我们的工作。
+
+          ——《在晋绥干部会议上的讲�》（一�四八年四月一日），《毛泽东选集》第四�第一三一四页。
+
+
+
+政策和策略是党的生命，�级领导�志务必充分注�，万万��粗心大�。
+
+          ——《关于情况的通报》（一�四八年三月二�日），《毛泽东选集》第四�第一二�六页。
+
+二�阶级和阶级斗争
+
+阶级斗争，一些阶级胜利了，一些阶级消�了。这就是历�，这就是几�年的文明�。拿这个观点解释历�的就��历�的唯物主义，站在这个观点的��的是历�的唯心主义。
+
+          ——《丢掉幻想，准备斗争》（一�四�年八月�四日），          ——《毛泽东选集》第四�第一四�一页
+
+在阶级社会中，�一个人都在一定的阶级地�中生活，���想无�打上阶级的烙�。
+
+          ——《实践论》（一�三七年七月），          ——《毛泽东选集》第一�第二七二页
+
+社会的�化，主�地是由于社会内部矛盾的�展，�生产力和生产关系的矛盾，阶级之间的矛盾，新旧之间的矛盾，由于这些矛盾的�展，推动了社会的�进，推动了新旧社会的代谢。
+
+          ——《矛盾论》（一�三七年八月），          ——《毛泽东选集》第一�第二�零页枫�文学网[www.fywxw.com]
+
+地主阶级对于农民的残酷的�济剥削和政治压迫，迫使农民多次地举行起义，以�抗地主阶级的统治。……在中国�建社会里，�有这�农民的阶级斗争�农民的起义和农民的战争，�是历��展的真正动力。
+
+          ——《中国�命和中国共产党》（一�三�年�二月），          ——《毛泽东选集》第二�第六一�页
+
+民�斗争，说到底，是一个阶级斗争问题。在美国压迫黑人的，�是白色人�中的�动统治集团。他们��能代表白色人�中��大多数的工人�农民��命的知识分�和其他开明人士。
+
+          ——《支�美国黑人�对美�国主义��歧视的正义斗争的声明》（一�六三年八月八日），          ——《全世界人民团结起�打败美国侵略者�其一切走狗》人民出版社版第四页
+
+人民�我们去组织。中国的�动分�，�我们组织起人民去�他打倒。凡是�动的东西，你�打，他就�倒。这也和扫地一样，扫帚�到，�尘照例�会自己跑掉。
+
+          ——《抗日战争胜利�的时局和我们的方针》（一�四五年八月�三日），          ——《毛泽东选集》第四�第一一三一页
+
+敌人是�会自行消�的。无论是中国的�动派，或是美国�国主义在中国的侵略势力，都�会自行退出历�舞�。
+
+          ——《将�命进行到底》（一�四八年�二月三�日），          ——《毛泽东选集》第四�第一三七�页
+
+�命�是请客�饭，�是�文章，�是绘画绣花，�能那样雅致，那样从容�迫，文质彬彬，那样温良�俭让。�命是暴动，是一个阶级推翻一个阶级的暴烈的行动。
+
+          ——《湖�农民�动考察报告》（一�二七年三月），          ——《毛泽东选集》第一�第一八页
+
+蒋介石对于人民是寸�必夺，寸利必得。我们呢？我们的方针是针锋相对，寸土必争。我们是按照蒋介石的办法办事。蒋介石总是�强迫人民接�战争，他左手拿�刀，�手也拿�刀。我们就按照他的办法，也拿起刀�。……现在蒋介石已�在磨刀了，因此，我们也�磨刀。
+
+          ——《抗日战争胜利�的时局和我们的方针》（一�四五年八月�三日），          ——《毛泽东选集》第四�第一一二六          ——一一二七页
+
+�是我们的敌人？�是我们的朋�？这个问题是�命的首�问题。中国过去一切�命斗争�效甚少，其基本原因就是因为�能团结真正的朋�，以攻击真正的敌人。�命党是群众的�导，在�命中未有�命党领错了路而�命�失败的。我们的�命�有�领错路和一定�功的把�，���注�团结我们的真正的朋�，以攻击我们的真正的敌人。我们�分辨真正的敌�，���将中国社会�阶级的�济地��其对于�命的�度，作一个大概的分�。
+
+          ——《中国社会�阶级的分�》（一�二六年三月），          ——《毛泽东选集》第一�第三页
+
+一切勾结�国主义的军阀�官僚�买办阶级�大地主阶级以�附属于他们的一部分�动知识界，是我们的敌人。工业无产阶级是我们�命的领导力�。一切�无产阶级��资产阶级，是我们最接近的朋�。那动摇�定的中产阶级，其�翼�能是我们的敌人，其左翼�能是我们的朋�          ——但我们�时常�防他们，��让他们扰乱了我们的阵线。
+
+          ——《中国社会�阶级的分�》（一�二六年三月），          ——《毛泽东选集》第一�第八          ——第�页
+
+什么人站在�命人民方�，他就是�命派，什么人站在�国主义�建主义官僚资本主义方�，他就是��命派。什么人�是�头上站在�命人民方�而在行动上则�是一样，他就是一个�头�命派，如果�但在�头上而且在行动上也站在�命人民方�，他就是一个完全的�命派。
+
+在中国人民政治�商会议第一届全国委员会第二次会议上的闭幕�（一�五零年六月二�三日），一�五零年六月二�四日          ——《人民日报》
+
+我认为，对我们�说，一个人，一个党，一个军队，或者一个学校，如若�被敌人�对，那就�好了那一定是�敌人���污了。如若被敌人�对，那就好了，那就�明我们�敌人划清界线了。如若敌人起劲地�对我们，把我们说得一塌糊涂，一无是处，那就更好了，那就�明我们�但�敌人划清了界线，而且�明我们的工作是很有�绩的了。
+
+          ——《被敌人�对是好事而�是�事》（一�
\ No newline at end of file
diff --git a/libraries/base/tests/IO/encoded-data/CP936.txt b/libraries/base/tests/IO/encoded-data/CP936.txt
new file mode 100644
index 000000000000..1a820477f2b6
--- /dev/null
+++ b/libraries/base/tests/IO/encoded-data/CP936.txt
@@ -0,0 +1,153 @@
+¡¶Ã«Ö÷ϯÓＡ·È«¼¯(ëÔó¶«Óï¼)
+×÷ÕߣºÃ«Ôó¶«
+ÉêÃ÷:±¾ÊéÓÉ·ãÒ¶ÎÄѧÍø[www.fywxw.com]×ÔÍøÂçÊÕ¼¯ÕûÀíÖÆ×÷,½ö¹©Ô¤ÀÀ½»Á÷ѧϰʹÓÃ,°æȨ¹éÔ­×÷Õߺͳö°æÉçËùÓÐ,Èç¹ûϲ»¶,ÇëÖ§³Ö¶©ÔĹºÂòÕý°æ.
+
+¡¶Ã«Ö÷ϯÓＡ·ÔÙ°æÇ°ÑÔ
+
+(Ò»¾ÅÁùÁùÄêÊ®¶þÔÂÊ®ÁùÈÕ)
+
+ÁÖ±ë
+
+ëÔó¶«Í¬Ö¾Êǵ±´ú×îΰ´óµÄÂí¿Ë˼ÁÐÄþÖ÷ÒåÕß¡£Ã«Ôó¶«Í¬Ö¾Ìì²ÅµØ¡¢´´ÔìÐԵء¢È«ÃæµØ¼Ì³Ð¡¢º´ÎÀºÍ·¢Õ¹ÁËÂí¿Ë˼ÁÐÄþÖ÷Ò壬°ÑÂí¿Ë˼ÁÐÄþÖ÷ÒåÌá¸ßµ½Ò»¸öոеĽ׶Ρ£
+
+ ëÔó¶«Ë¼ÏëÊÇÔÚµÛ¹úÖ÷Òå×ßÏòÈ«Ãæ±ÀÀ££¬Éç»áÖ÷Òå×ßÏòÈ«ÊÀ½çʤÀûµÄʱ´úµÄÂí¿Ë˼ÁÐÄþÖ÷Ò塣ëÔó¶«Ë¼ÏëÊÇ·´¶ÔµÛ¹úÖ÷ÒåµÄÇ¿´óµÄ˼ÏëÎäÆ÷£¬ÊÇ·´¶ÔÐÞÕýÖ÷ÒåºÍ½ÌÌõÖ÷ÒåµÄÇ¿´óµÄ˼ÏëÎäÆ÷¡£Ã«Ôó¶«Ë¼ÏëÊÇÈ«µ³¡¢È«¾üºÍÈ«¹úÒ»Çй¤×÷µÄÖ¸µ¼·½Õë¡£
+
+Òò´Ë£¬ÓÀÔ¶¸ß¾ÙëÔó¶«Ë¼Ïëΰ´óºìÆ죬ÓÃëÔó¶«Ë¼ÏëÎä×°È«¹úÈËÃñµÄÍ·ÄÔ£¬¼á³ÖÔÚÒ»Çй¤×÷ÖÐÓÃëÔó¶«Ë¼Ïë¹Ò˧£¬ÊÇÎÒµ³ÕþÖÎ˼Ï빤×÷×î¸ù±¾µÄÈÎÎñ¡£¹ã´ó¹¤Å©±øȺÖÚ¡¢¹ã´ó¸ïÃü¸É²¿ºÍ¹ã´ó֪ʶ·Ö×Ó£¬¶¼±ØÐë°ÑëÔó¶«Ë¼ÏëÕæÕýѧµ½ÊÖ£¬×öµ½ÈËÈ˶ÁëÖ÷ϯµÄÊ飬ÌýëÖ÷ϯµÄ»°£¬ÕÕëÖ÷ϯµÄָʾ°ìÊ£¬×öëÖ÷ϯµÄºÃսʿ¡£
+
+ѧϰëÖ÷ϯÖø×÷£¬Òª´ø×ÅÎÊÌâѧ£¬»îѧ»îÓã¬Ñ§ÓýáºÏ£¬¼±ÓÃÏÈѧ£¬Á¢¸Í¼ûÓ°£¬ÔÚ¡°Óá±×ÖÉϺÝϹ¦·ò¡£ÎªÁË°ÑëÔó¶«Ë¼ÏëÕæÕýѧµ½ÊÖ£¬Òª·´¸´Ñ§Ï°Ã«Ö÷ϯµÄÐí¶à»ù±¾¹Ûµã£¬ÓÐЩ¾¯¾ä×îºÃÒª±³Ê죬·´¸´Ñ§Ï°£¬·´¸´ÔËÓá£ÔÚ±¨Ö½ÉÏ£¬Òª¾­³£½áºÏʵ¼Ê£¬¿¯µÇëÖ÷ϯµÄÓï¼£¬¹©´ó¼ÒѧϰºÍÔËÓ᣼¸ÄêÀ´¹ã´óȺÖÚ»îѧ»îÓÃëÖ÷ϯÖø×÷µÄ¾­Ñ飬֤Ã÷´ø×ÅÎÊÌâѡѧëÖ÷ϯµÄÓï¼£¬ÊÇÒ»ÖÖѧϰëÔó¶«Ë¼ÏëµÄºÃ·½·¨£¬ÈÝÒ×ÊÕµ½Á¢¸Í¼ûÓ°µÄЧ¹û¡£
+
+ΪÁË°ïÖú¹ã´óȺÖÚ¸üºÃµØѧϰëÔó¶«Ë¼Ï룬ÎÒÃÇÑ¡±àÁËÕâ±¾¡¶Ã«Ö÷ϯÓＡ·¡£¸÷µ¥Î»ÔÚ×é֯ѧϰµÄʱºò£¬Ó¦µ±½áºÏÐÎÊÆ¡¢ÈÎÎñ¡¢ÈºÖÚµÄ˼ÏëÇé¿öºÍ¹¤×÷Çé¿ö£¬Ñ¡Ñ§ÓйصÄÄÚÈÝ¡£
+
+ÏÖÔÚÎÒÃÇΰ´óµÄ×æ¹ú£¬ÕýÔÚ³öÏÖÒ»¸ö¹¤Å©±øÕÆÎÕÂí¿Ë˼ÁÐÄþÖ÷Ò塢ëÔó¶«Ë¼ÏëµÄÐÂʱ´ú¡£Ã«Ôó¶«Ë¼ÏëΪ¹ã´óȺÖÚËùÕÆÎÕ£¬¾Í»á±ä³ÉÎÞÇîÎÞ¾¡µÄÁ¦Á¿£¬±ä³ÉÍþÁ¦Îޱȵľ«ÉñÔ­×Óµ¯¡£¡¶Ã«Ö÷ϯÓＡ·µÄ´óÁ¿³ö°æ£¬¶Ô¹ã´óȺÖÚÕÆÎÕëÔó¶«Ë¼Ï룬Íƶ¯ÎÒ¹úÈËÃñ˼Ïë¸ïÃü»¯£¬ÊÇÒ»¸ö¼«ÎªÖØÒªµÄ´ëÊ©¡£Ï£Íûÿ¸öͬ־ÈÏÕæµØ¡¢¿Ì¿àµØѧϰ£¬ÔÚÈ«¹ú·¶Î§ÄÚ£¬ÏÆÆð»îѧ»îÓÃëÖ÷ϯÖø×÷µÄи߳±£¬ÔÚëÔó¶«Ë¼ÏëµÄΰ´óºìÆìÏ£¬Îª°ÑÎÒ¹ú½¨Éè³ÉΪһ¸ö¾ßÓÐÏÖ´úÅ©Òµ£¬ÏÖ´ú¹¤Òµ£¬ÏÖ´ú¿ÆѧÎÄ»¯ºÍÏÖ´ú¹ú·ÀµÄΰ´óÉç»áÖ÷Òå¹ú¼Ò¶ø·Ü¶·£¡
+
+Ò»¡¢¹²²úµ³
+
+Áìµ¼ÎÒÃÇÊÂÒµµÄºËÐÄÁ¦Á¿ÊÇÖйú¹²²úµ³¡£
+
+Ö¸µ¼ÎÒÃÇ˼ÏëµÄÀíÂÛ»ù´¡ÊÇÂí¿Ë˼ÁÐÄþÖ÷Òå¡£
+
+          ¡ª¡ª¡¶ÖлªÈËÃñ¹²ºÍ¹úµÚÒ»½ìÈ«¹úÈËÃñ´ú±í´ó»áµÚÒ»´Î»áÒ鿪Ļ´Ê¡·£¨Ò»¾ÅÎåËÄÄê¾ÅÔÂÊ®ÎåÈÕ£©£¬Ò»¾ÅÎåËÄÄê¾ÅÔÂÊ®ÁùÈÕ¡¶ÈËÃñÈÕ±¨¡·
+
+
+
+¼ÈÒª¸ïÃü£¬¾ÍÒªÓÐÒ»¸ö¸ïÃüµÄµ³¡£Ã»ÓÐÒ»¸ö¸ïÃüµÄµ³£¬Ã»ÓÐÒ»¸ö°´ÕÕÂí¿Ë˼ÁÐÄþÖ÷ÒåµÄ¸ïÃüÀíÂۺ͸ïÃü·ç¸ñ½¨Á¢ÆðÀ´µÄ¸ïÃüµ³£¬¾Í²»¿ÉÄÜÁìµ¼¹¤È˽׼¶ºÍ¹ã´óÈËÃñȺÖÚսʤµÛ¹úÖ÷Òå¼°Æä×ß¹·¡£
+
+          ¡ª¡ª¡¶È«ÊÀ½ç¸ïÃüÁ¦Á¿ÍŽáÆðÀ´£¬·´¶ÔµÛ¹úÖ÷ÒåµÄÇÖÂÔ¡·£¨Ò»¾ÅËÄ°ËÄêʮһÔ£©£¬¡¶Ã«Ôó¶«Ñ¡¼¯¡·µÚËľíµÚÒ»ÈýÁùÁãÒ³¡£
+
+
+
+ûÓÐÖйú¹²²úµ³µÄŬÁ¦£¬Ã»ÓÐÖйú¹²²úµ³ÈË×öÖйúÈËÃñµÄÖÐÁ÷íÆÖù£¬ÖйúµÄ¶ÀÁ¢ºÍ½â·ÅÊDz»¿ÉÄܵģ¬ÖйúµÄ¹¤Òµ»¯ºÍÅ©Òµ½ü´ú»¯Ò²ÊDz»¿ÉÄܵġ£
+
+          ¡ª¡ª¡¶ÂÛÁªºÏÕþ¸®¡·£¨Ò»¾ÅËÄÎåÄêËÄÔ¶þÊ®ËÄÈÕ£©£¬¡¶Ã«Ôó¶«Ñ¡¼¯¡·µÚÈý¾íµÚÒ»Áã¾Å°Ë-Ò»Áã¾Å¾ÅÒ³¡£
+
+
+
+Öйú¹²²úµ³ÊÇÈ«ÖйúÈËÃñµÄÁìµ¼ºËÐÄ¡£Ã»ÓÐÕâÑùÒ»¸öºËÐÄ£¬Éç»áÖ÷ÒåÊÂÒµ¾Í²»ÄÜʤÀû¡£
+
+          ¡ª¡ª¡¶ÔÚ½Ó¼û³öϯÖйúÐÂÃñÖ÷Ö÷ÒåÇàÄêÍŵÚÈý´ÎÈ«¹ú´ú±í´ó»áµÄÈ«Ìå´ú±íʱµÄ½²»°¡·£¨Ò»¾ÅÎåÆßÄêÎåÔ¶þÊ®ÎåÈÕ£©£¬¡¶Ð»ª°ëÔ¿¯¡·Ò»¾ÅÎåÆßÄêµÚÊ®¶þºÅµÚÎåÆßÒ³¡£
+
+
+
+Ò»¸öÓмÍÂɵģ¬ÓÐÂí¿Ë˼ÁÐÄþÖ÷ÒåµÄÀíÂÛÎä×°µÄ£¬²ÉÈ¡×ÔÎÒÅúÆÀ·½·¨µÄ£¬ÁªÏµÈËÃñȺÖڵĵ³¡£Ò»¸öÓÉÕâÑùµÄµ³Áìµ¼µÄ¾ü¶Ó¡£Ò»¸öÓÉÕâÑùµÄµ³Áìµ¼µÄ¸÷¸ïÃü½×¼¶¸÷¸ïÃüÅɱðµÄͳһսÏß¡£ÕâÈý¼þÊÇÎÒÃÇսʤµÐÈ˵ÄÖ÷ÒªÎäÆ÷¡£
+
+          ¡ª¡ª¡¶ÂÛÈËÃñÃñÖ÷רÕþ¡·£¨Ò»¾ÅËľÅÄêÁùÔÂÈýÊ®ÈÕ£©£¬¡¶Ã«Ôó¶«Ñ¡¼¯¡·µÚËľíµÚÒ»ËÄ°ËËÄÒ³¡£
+
+
+
+ÎÒÃÇÓ¦µ±ÏàÐÅȺÖÚ£¬ÎÒÃÇÓ¦µ±ÏàÐŵ³£¬ÕâÊÇÁ½Ìõ¸ù±¾µÄÔ­Àí¡£Èç¹û»³ÒÉÕâÁ½ÌõÔ­Àí£¬ÄǾÍʲôÊÂÇéÒ²×ö²»³ÉÁË¡£
+
+          ¡ª¡ª¡¶¹ØÓÚÅ©ÒµºÏ×÷»¯ÎÊÌâ¡·£¨Ò»¾ÅÎåÎåÄêÆßÔÂÈýʮһÈÕ£©£¬ÈËÃñ³ö°æÉçµÚ¾ÅÒ³¡£
+
+
+
+ÒÔÂí¿Ë˼ÁÐÄþÖ÷ÒåµÄÀíÂÛ˼ÏëÎä×°ÆðÀ´µÄÖйú¹²²úµ³£¬ÔÚÖйúÈËÃñÖвúÉúÁËÐµĹ¤×÷×÷·ç£¬ÕâÖ÷ÒªµÄ¾ÍÊÇÀíÂÛºÍʵ¼ùÏà½áºÏµÄ×÷·ç£¬ºÍÈËÃñȺÖÚ½ôÃܵØÁªÏµÔÚÒ»ÆðµÄ×÷·çÒÔ¼°×ÔÎÒÅúÆÀµÄ×÷·ç¡£
+
+          ¡ª¡ª¡¶ÂÛÁªºÏÕþ¸®¡·£¨Ò»¾ÅËÄÎåÄêËÄÔ¶þÊ®ËÄÈÕ£©£¬¡¶Ã«Ôó¶«Ñ¡¼¯¡·µÚÈý¾íµÚÒ»Áã¾ÅËÄ¡ªÒ»Áã¾ÅÎåÒ³¡£
+
+
+
+Ö¸µ¼Ò»¸öΰ´óµÄ¸ïÃüÔ˶¯µÄÕþµ³£¬Èç¹ûûÓиïÃüÀíÂÛ£¬Ã»ÓÐÀúʷ֪ʶ£¬Ã»ÓжÔÓÚʵ¼ÊÔ˶¯µÄÉî¿ÌµÄÁ˽⣬ҪȡµÃʤÀûÊDz»¿ÉÄܵġ£
+
+          ¡ª¡ª¡¶Öйú¹²²úµ³ÔÚÃñ×åÕ½ÕùÖеĵØλ¡·£¨Ò»¾ÅÈý°ËÄêʮԣ©£¬¡¶Ã«Ôó¶«Ñ¡¼¯¡·µÚ¶þ¾íµÚÎå¶þÒ»Ò³¡£
+
+ÎÒÃǹýȥ˵¹ý£¬Õû·çÔ˶¯ÊÇÒ»¸ö¡°ÆÕ±éµÄÂí¿Ë˼Ö÷ÒåµÄ½ÌÓýÔ˶¯¡±¡£Õû·ç¾ÍÊÇÈ«µ³Í¨¹ýÅúÆÀºÍ×ÔÎÒÅúÆÀÀ´Ñ§Ï°Âí¿Ë˼Ö÷Òå¡£ÔÚÕû·çÖм䣬ÎÒÃÇÒ»¶¨¿ÉÒÔ¸ü¶àµØѧµ½Ò»Ð©Âí¿Ë˼Ö÷Òå¡£
+
+          ¡ª¡ª¡¶ÔÚÖйú¹²²úµ³È«¹úÐû´«¹¤×÷»áÒéÉϵĽ²»°¡·£¨Ò»¾ÅÎåÆßÄêÈýÔÂÊ®¶þÈÕ£©£¬ÈËÃñ³ö°æÉç°æµÚÒ»Ò»Ò³¡£
+
+
+
+Ҫʹ¼¸ÒÚÈËÖеÄÖйúÈËÉú»îµÃºÃ£¬Òª°ÑÎÒÃÇÕâ¸ö¾­¼ÃÂäºó¡¢ÎÄ»¯ÂäºóµÄ¹ú¼Ò£¬½¨Éè³ÉΪ¸»Ô£µÄ¡¢Ç¿Ê¢µÄ¡¢¾ßÓи߶ÈÎÄ»¯µÄ¹ú¼Ò£¬ÕâÊÇÒ»¸öºÜ¼è¾ÞµÄÈÎÎñ¡£ÎÒÃÇËùÒÔÒªÕû·ç£¬ÏÖÔÚÒªÕû·ç£¬½«À´»¹ÒªÕû·ç£¬Òª²»¶Ï°ÑÎÒÃÇÉíÉϵĴíÎó¶«Î÷Õûµô£¬¾ÍÊÇΪÁËʹÎÒÃÇÄܹ»¸üºÃµØµ£¸ºÆðÕâÏîÈÎÎñ£¬¸üºÃµØͬµ³ÍâµÄÒ»ÇÐÁ¢Ö¾¸Ä¸ïµÄ־ʿÈÊÈ˹²Í¬¹¤×÷¡£
+
+          ¡ª¡ª¡¶ÔÚÖйú¹²²úµ³È«¹úÐû´«¹¤×÷»áÒéÉϵĽ²»°¡·£¨Ò»¾ÅÎåÆßÄêÈýÔÂÊ®¶þÈÕ£©£¬ÈËÃñ³ö°æÉç°æµÚÒ»¶þÒ³¡£
+
+
+
+Õþ²ßÊǸïÃüÕþµ³Ò»ÇÐʵ¼ÊÐж¯µÄ³ö·¢µã£¬²¢ÇÒ±íÏÖÓÚÐж¯µÄ¹ý³ÌºÍ¹éËÞ¡£Ò»¸ö¸ïÃüÕþµ³µÄÈκÎÐж¯¶¼ÊÇʵÐÐÕþ²ß¡£²»ÊÇʵÐÐÕýÈ·µÄÕþ²ß£¬¾ÍÊÇʵÐдíÎóµÄÕþ²ß£»²»ÊÇ×Ô¾õµØ£¬¾ÍÊÇäĿµØʵÐÐijÖÖÕþ²ß¡£Ëùν¾­Ñ飬¾ÍÊÇʵÐÐÕþ²ßµÄ¹ý³ÌºÍ¹éËÞ¡£Õþ²ß±ØÐëÔÚÈËÃñʵ¼ùÖУ¬Ò²¾ÍÊǾ­ÑéÖУ¬²ÅÄÜÖ¤Ã÷ÆäÕýÈ·Óë·ñ£¬²ÅÄÜÈ·¶¨ÆäÕýÈ·ºÍ´íÎóµÄ³Ì¶È¡£µ«ÊÇ£¬ÈËÃǵÄʵ¼ù£¬ÌرðÊǸïÃüÕþµ³ºÍ¸ïÃüȺÖÚµÄʵ¼ù£¬Ã»Óв»Í¬ÕâÖÖ»òÄÇÖÖÕþ²ßÏàÁªÏµµÄ¡£Òò´Ë£¬ÔÚÿһÐж¯Ö®Ç°£¬±ØÐëÏòµ³Ô±ºÍȺÖÚ½²Ã÷ÎÒÃÇ°´Çé¿ö¹æ¶¨µÄÕþ²ß¡£·ñÔò£¬µ³Ô±ºÍȺÖھͻáÍÑÀëÎÒÃÇÕþ²ßµÄÁìµ¼¶øäĿÐж¯£¬Ö´ÐдíÎóµÄÕþ²ß¡£
+
+          ¡ª¡ª¡¶¹ØÓÚ¹¤ÉÌÒµÕþ²ß¡·£¨Ò»¾ÅËÄ°ËÄê¶þÔ¶þÊ®ÆßÈÕ£©£¬¡¶Ã«Ôó¶«Ñ¡¼¯¡·µÚËľíµÚÒ»¶þ°ËËÄÒ³¡£
+
+
+
+ÎÒµ³¹æ¶¨ÁËÖйú¸ïÃüµÄ×Ü·ÏߺÍ×ÜÕþ²ß£¬Óֹ涨Á˸÷Ïî¾ßÌåµÄ¹¤×÷·Ïߺ͸÷Ïî¾ßÌåµÄÕþ²ß¡£µ«ÊÇ£¬Ðí¶àͬ־ÍùÍù¼ÇסÁËÎÒµ³µÄ¾ßÌåµÄ¸ö±ðµÄ¹¤×÷·ÏߺÍÕþ²ß£¬Íü¼ÇÁËÎÒµ³µÄ×Ü·ÏߺÍ×ÜÕþ²ß¡£¶øÈç¹ûÕæÕýÍü¼ÇÁËÎÒµ³µÄ×Ü·ÏߺÍ×ÜÕþ²ß£¬ÎÒÃǾͽ«ÊÇÒ»¸öäĿµÄ²»ÍêÈ«µÄ²»ÇåÐѵĸïÃüÕߣ¬ÔÚÎÒÃÇÖ´ÐоßÌ幤×÷·Ïߺ;ßÌåÕþ²ßµÄʱºò£¬¾Í»áÃÔʧ·½Ïò£¬¾Í»á×óÓÒÒ¡°Ú£¬¾Í»áêÝÎóÎÒÃǵŤ×÷¡£
+
+          ¡ª¡ª¡¶ÔÚ½úËç¸É²¿»áÒéÉϵĽ²»°¡·£¨Ò»¾ÅËÄ°ËÄêËÄÔÂÒ»ÈÕ£©£¬¡¶Ã«Ôó¶«Ñ¡¼¯¡·µÚËľíµÚÒ»ÈýÒ»ËÄÒ³¡£
+
+
+
+Õþ²ßºÍ²ßÂÔÊǵ³µÄÉúÃü£¬¸÷¼¶Á쵼ͬ־Îñ±Ø³ä·Ö×¢Ò⣬ÍòÍò²»¿É´ÖÐÄ´óÒâ¡£
+
+          ¡ª¡ª¡¶¹ØÓÚÇé¿öµÄͨ±¨¡·£¨Ò»¾ÅËÄ°ËÄêÈýÔ¶þÊ®ÈÕ£©£¬¡¶Ã«Ôó¶«Ñ¡¼¯¡·µÚËľíµÚÒ»¶þ¾ÅÁùÒ³¡£
+
+¶þ¡¢½×¼¶ºÍ½×¼¶¶·Õù
+
+½×¼¶¶·Õù£¬Ò»Ð©½×¼¶Ê¤ÀûÁË£¬Ò»Ð©½×¼¶ÏûÃðÁË¡£Õâ¾ÍÊÇÀúÊ·£¬Õâ¾ÍÊǼ¸Ç§ÄêµÄÎÄÃ÷Ê·¡£ÄÃÕâ¸ö¹Ûµã½âÊÍÀúÊ·µÄ¾Í½Ð×öÀúÊ·µÄΨÎïÖ÷Ò壬վÔÚÕâ¸ö¹ÛµãµÄ·´ÃæµÄÊÇÀúÊ·µÄΨÐÄÖ÷Òå¡£
+
+          ¡ª¡ª¡¶¶ªµô»ÃÏ룬׼±¸¶·Õù¡·£¨Ò»¾ÅËľÅÄê°ËÔÂÊ®ËÄÈÕ£©£¬          ¡ª¡ª¡¶Ã«Ôó¶«Ñ¡¼¯¡·µÚËľíµÚÒ»ËľÅÒ»Ò³
+
+ÔÚ½×¼¶Éç»áÖУ¬Ã¿Ò»¸öÈ˶¼ÔÚÒ»¶¨µÄ½×¼¶µØλÖÐÉú»î£¬¸÷ÖÖ˼ÏëÎÞ²»´òÉϽ׼¶µÄÀÓÓ¡¡£
+
+          ¡ª¡ª¡¶Êµ¼ùÂÛ¡·£¨Ò»¾ÅÈýÆßÄêÆßÔ£©£¬          ¡ª¡ª¡¶Ã«Ôó¶«Ñ¡¼¯¡·µÚÒ»¾íµÚ¶þÆ߶þÒ³
+
+Éç»áµÄ±ä»¯£¬Ö÷ÒªµØÊÇÓÉÓÚÉç»áÄÚ²¿Ã¬¶ÜµÄ·¢Õ¹£¬¼´Éú²úÁ¦ºÍÉú²ú¹ØϵµÄì¶Ü£¬½×¼¶Ö®¼äµÄì¶Ü£¬Ð¾ÉÖ®¼äµÄì¶Ü£¬ÓÉÓÚÕâЩì¶ÜµÄ·¢Õ¹£¬Íƶ¯ÁËÉç»áµÄÇ°½ø£¬Íƶ¯ÁËоÉÉç»áµÄ´úл¡£
+
+          ¡ª¡ª¡¶Ã¬¶ÜÂÛ¡·£¨Ò»¾ÅÈýÆßÄê°ËÔ£©£¬          ¡ª¡ª¡¶Ã«Ôó¶«Ñ¡¼¯¡·µÚÒ»¾íµÚ¶þ¾ÅÁãÒ³·ãÒ¶ÎÄѧÍø[www.fywxw.com]
+
+µØÖ÷½×¼¶¶ÔÓÚÅ©ÃñµÄ²Ð¿áµÄ¾­¼Ã°þÏ÷ºÍÕþÖÎѹÆÈ£¬ÆÈʹũÃñ¶à´ÎµØ¾ÙÐÐÆðÒ壬ÒÔ·´¿¹µØÖ÷½×¼¶µÄͳÖΡ£¡­¡­ÔÚÖйú·â½¨Éç»áÀֻÓÐÕâÖÖÅ©ÃñµÄ½×¼¶¶·Õù¡¢Å©ÃñµÄÆðÒåºÍÅ©ÃñµÄÕ½Õù£¬²ÅÊÇÀúÊ··¢Õ¹µÄÕæÕý¶¯Á¦¡£
+
+          ¡ª¡ª¡¶Öйú¸ïÃüºÍÖйú¹²²úµ³¡·£¨Ò»¾ÅÈý¾ÅÄêÊ®¶þÔ£©£¬          ¡ª¡ª¡¶Ã«Ôó¶«Ñ¡¼¯¡·µÚ¶þ¾íµÚÁùÒ»¾ÅÒ³
+
+Ãñ×嶷Õù£¬Ëµµ½µ×£¬ÊÇÒ»¸ö½×¼¶¶·ÕùÎÊÌâ¡£ÔÚÃÀ¹úѹÆȺÚÈ˵ģ¬Ö»ÊÇ°×É«ÈËÖÖÖеķ´¶¯Í³Öμ¯ÍÅ¡£ËûÃǾø²»ÄÜ´ú±í°×É«ÈËÖÖÖÐÕ¼¾ø´ó¶àÊýµÄ¹¤ÈË¡¢Å©Ãñ¡¢¸ïÃüµÄ֪ʶ·Ö×ÓºÍÆäËû¿ªÃ÷ÈËÊ¿¡£
+
+          ¡ª¡ª¡¶Ö§³ÖÃÀ¹úºÚÈË·´¶ÔÃÀµÛ¹úÖ÷ÒåÖÖ×åÆçÊÓµÄÕýÒ嶷ÕùµÄÉùÃ÷¡·£¨Ò»¾ÅÁùÈýÄê°ËÔ°ËÈÕ£©£¬          ¡ª¡ª¡¶È«ÊÀ½çÈËÃñÍŽáÆðÀ´´ò°ÜÃÀ¹úÇÖÂÔÕß¼°ÆäÒ»ÇÐ×ß¹·¡·ÈËÃñ³ö°æÉç°æµÚËÄÒ³
+
+ÈËÃñ¿¿ÎÒÃÇÈ¥×éÖ¯¡£ÖйúµÄ·´¶¯·Ö×Ó£¬¿¿ÎÒÃÇ×éÖ¯ÆðÈËÃñÈ¥·´Ëû´òµ¹¡£·²ÊÇ·´¶¯µÄ¶«Î÷£¬Äã²»´ò£¬Ëû¾Í²»µ¹¡£ÕâÒ²ºÍɨµØÒ»Ñù£¬É¨Öã²»µ½£¬»Ò³¾ÕÕÀý²»»á×Ô¼ºÅܵô¡£
+
+          ¡ª¡ª¡¶¿¹ÈÕÕ½ÕùʤÀûºóµÄʱ¾ÖºÍÎÒÃǵķ½Õë¡·£¨Ò»¾ÅËÄÎåÄê°ËÔÂÊ®ÈýÈÕ£©£¬          ¡ª¡ª¡¶Ã«Ôó¶«Ñ¡¼¯¡·µÚËľíµÚÒ»Ò»ÈýÒ»Ò³
+
+µÐÈËÊDz»»á×ÔÐÐÏûÃðµÄ¡£ÎÞÂÛÊÇÖйúµÄ·´¶¯ÅÉ£¬»òÊÇÃÀ¹úµÛ¹úÖ÷ÒåÔÚÖйúµÄÇÖÂÔÊÆÁ¦£¬¶¼²»»á×ÔÐÐÍ˳öÀúÊ·Îę̀¡£
+
+          ¡ª¡ª¡¶½«¸ïÃü½øÐе½µ×¡·£¨Ò»¾ÅËÄ°ËÄêÊ®¶þÔÂÈýÊ®ÈÕ£©£¬          ¡ª¡ª¡¶Ã«Ôó¶«Ñ¡¼¯¡·µÚËľíµÚÒ»ÈýÆß¾ÅÒ³
+
+¸ïÃü²»ÊÇÇë¿Í³Ô·¹£¬²»ÊÇ×öÎÄÕ£¬²»Êǻ滭Ð廨£¬²»ÄÜÄÇÑùÑÅÖ£¬ÄÇÑù´ÓÈݲ»ÆÈ£¬ÎÄÖʱò±ò£¬ÄÇÑùÎÂÁ¼¹§¼óÈ᣸ïÃüÊDZ©¶¯£¬ÊÇÒ»¸ö½×¼¶ÍÆ·­Ò»¸ö½×¼¶µÄ±©ÁÒµÄÐж¯¡£
+
+          ¡ª¡ª¡¶ºþÄÏÅ©ÃñÔ˶¯¿¼²ì±¨¸æ¡·£¨Ò»¾Å¶þÆßÄêÈýÔ£©£¬          ¡ª¡ª¡¶Ã«Ôó¶«Ñ¡¼¯¡·µÚÒ»¾íµÚÒ»°ËÒ³
+
+½¯½éʯ¶ÔÓÚÈËÃñÊÇ´çȨ±Ø¶á£¬´çÀû±ØµÃ¡£ÎÒÃÇÄØ£¿ÎÒÃǵķ½ÕëÊÇÕë·æÏà¶Ô£¬´çÍÁ±ØÕù¡£ÎÒÃÇÊÇ°´ÕÕ½¯½éʯµÄ°ì·¨°ìÊ¡£½¯½éʯ×ÜÊÇҪǿÆÈÈËÃñ½ÓÊÜÕ½Õù£¬Ëû×óÊÖÄÃ×ŵ¶£¬ÓÒÊÖÒ²ÄÃ×ŵ¶¡£ÎÒÃǾͰ´ÕÕËûµÄ°ì·¨£¬Ò²ÄÃÆðµ¶À´¡£¡­¡­ÏÖÔÚ½¯½éʯÒѾ­ÔÚÄ¥µ¶ÁË£¬Òò´Ë£¬ÎÒÃÇҲҪĥµ¶¡£
+
+          ¡ª¡ª¡¶¿¹ÈÕÕ½ÕùʤÀûºóµÄʱ¾ÖºÍÎÒÃǵķ½Õë¡·£¨Ò»¾ÅËÄÎåÄê°ËÔÂÊ®ÈýÈÕ£©£¬          ¡ª¡ª¡¶Ã«Ôó¶«Ñ¡¼¯¡·µÚËľíµÚÒ»Ò»¶þÁù          ¡ª¡ªÒ»Ò»¶þÆßÒ³
+
+Ë­ÊÇÎÒÃǵĵÐÈË£¿Ë­ÊÇÎÒÃǵÄÅóÓÑ£¿Õâ¸öÎÊÌâÊǸïÃüµÄÊ×ÒªÎÊÌâ¡£Öйú¹ýÈ¥Ò»ÇиïÃü¶·Õù³ÉЧÉõÉÙ£¬Æä»ù±¾Ô­Òò¾ÍÊÇÒòΪ²»ÄÜÍŽáÕæÕýµÄÅóÓÑ£¬ÒÔ¹¥»÷ÕæÕýµÄµÐÈË¡£¸ïÃüµ³ÊÇȺÖÚµÄÏòµ¼£¬ÔÚ¸ïÃüÖÐδÓиïÃüµ³Áì´íÁË·¶ø¸ïÃü²»Ê§°ÜµÄ¡£ÎÒÃǵĸïÃüÒªÓв»Áì´í·ºÍÒ»¶¨³É¹¦µÄ°ÑÎÕ£¬²»¿É²»×¢ÒâÍŽáÎÒÃǵÄÕæÕýµÄÅóÓÑ£¬ÒÔ¹¥»÷ÎÒÃǵÄÕæÕýµÄµÐÈË¡£ÎÒÃÇÒª·Ö±æÕæÕýµÄµÐÓÑ£¬²»¿É²»½«ÖйúÉç»á¸÷½×¼¶µÄ¾­¼ÃµØλ¼°Æä¶ÔÓÚ¸ïÃüµÄ̬¶È£¬×÷Ò»¸ö´ó¸ÅµÄ·ÖÎö¡£
+
+          ¡ª¡ª¡¶ÖйúÉç»á¸÷½×¼¶µÄ·ÖÎö¡·£¨Ò»¾Å¶þÁùÄêÈýÔ£©£¬          ¡ª¡ª¡¶Ã«Ôó¶«Ñ¡¼¯¡·µÚÒ»¾íµÚÈýÒ³
+
+Ò»Çй´½áµÛ¹úÖ÷ÒåµÄ¾ü·§¡¢¹ÙÁÅ¡¢Âò°ì½×¼¶¡¢´óµØÖ÷½×¼¶ÒÔ¼°¸½ÊôÓÚËûÃǵÄÒ»²¿·Ö·´¶¯ÖªÊ¶½ç£¬ÊÇÎÒÃǵĵÐÈË¡£¹¤ÒµÎÞ²ú½×¼¶ÊÇÎÒÃǸïÃüµÄÁìµ¼Á¦Á¿¡£Ò»ÇаëÎÞ²ú½×¼¶¡¢Ð¡×ʲú½×¼¶£¬ÊÇÎÒÃÇ×î½Ó½üµÄÅóÓÑ¡£ÄǶ¯Ò¡²»¶¨µÄÖвú½×¼¶£¬ÆäÓÒÒí¿ÉÄÜÊÇÎÒÃǵĵÐÈË£¬Æä×óÒí¿ÉÄÜÊÇÎÒÃǵÄÅóÓÑ          ¡ª¡ªµ«ÎÒÃÇҪʱ³£Ìá·ÀËûÃÇ£¬²»ÒªÈÃËûÃÇÈÅÂÒÁËÎÒÃǵÄÕóÏß¡£
+
+          ¡ª¡ª¡¶ÖйúÉç»á¸÷½×¼¶µÄ·ÖÎö¡·£¨Ò»¾Å¶þÁùÄêÈýÔ£©£¬          ¡ª¡ª¡¶Ã«Ôó¶«Ñ¡¼¯¡·µÚÒ»¾íµÚ°Ë          ¡ª¡ªµÚ¾ÅÒ³
+
+ʲôÈËÕ¾ÔÚ¸ïÃüÈËÃñ·½Ã棬Ëû¾ÍÊǸïÃüÅÉ£¬Ê²Ã´ÈËÕ¾ÔÚµÛ¹úÖ÷Òå·â½¨Ö÷Òå¹ÙÁÅ×ʱ¾Ö÷Òå·½Ã棬Ëû¾ÍÊÇ·´¸ïÃüÅÉ¡£Ê²Ã´ÈËÖ»ÊÇ¿ÚÍ·ÉÏÕ¾ÔÚ¸ïÃüÈËÃñ·½Ãæ¶øÔÚÐж¯ÉÏÔòÁíÊÇÒ»Ñù£¬Ëû¾ÍÊÇÒ»¸ö¿ÚÍ·¸ïÃüÅÉ£¬Èç¹û²»µ«ÔÚ¿ÚÍ·É϶øÇÒÔÚÐж¯ÉÏÒ²Õ¾ÔÚ¸ïÃüÈËÃñ·½Ã棬Ëû¾ÍÊÇÒ»¸öÍêÈ«µÄ¸ïÃüÅÉ¡£
+
+ÔÚÖйúÈËÃñÕþÖÎЭÉÌ»áÒéµÚÒ»½ìÈ«¹úίԱ»áµÚ¶þ´Î»áÒéÉϵıÕÄ»´Ê£¨Ò»¾ÅÎåÁãÄêÁùÔ¶þÊ®ÈýÈÕ£©£¬Ò»¾ÅÎåÁãÄêÁùÔ¶þÊ®ËÄÈÕ          ¡ª¡ª¡¶ÈËÃñÈÕ±¨¡·
+
+ÎÒÈÏΪ£¬¶ÔÎÒÃÇÀ´Ëµ£¬Ò»¸öÈË£¬Ò»¸öµ³£¬Ò»¸ö¾ü¶Ó£¬»òÕßÒ»¸öѧУ£¬ÈçÈô²»±»µÐÈË·´¶Ô£¬ÄǾͲ»ºÃÁËÄÇÒ»¶¨ÊÇͬµÐÈËͬÁ÷ºÏÎÛÁË¡£ÈçÈô±»µÐÈË·´¶Ô£¬ÄǾͺÃÁË£¬ÄǾÍÖ¤Ã÷ÎÒÃÇͬµÐÈË»®Çå½çÏßÁË¡£ÈçÈôµÐÈËÆ𾢵ط´¶ÔÎÒÃÇ£¬°ÑÎÒÃÇ˵µÃÒ»ËúºýÍ¿£¬Ò»ÎÞÊÇ´¦£¬ÄǾ͸üºÃÁË£¬ÄǾÍÖ¤Ã÷ÎÒÃDz»µ«Í¬µÐÈË»®ÇåÁ˽çÏߣ¬¶øÇÒÖ¤Ã÷ÎÒÃǵŤ×÷ÊǺÜÓгɼ¨µÄÁË¡£
+
+          ¡ª¡ª¡¶±»µÐÈË·´¶ÔÊǺÃʶø²»ÊÇ»µÊ¡·£¨Ò»¾Å
\ No newline at end of file
diff --git a/libraries/base/tests/IO/encoding001.hs b/libraries/base/tests/IO/encoding001.hs
new file mode 100644
index 000000000000..9480abb09dd0
--- /dev/null
+++ b/libraries/base/tests/IO/encoding001.hs
@@ -0,0 +1,71 @@
+import Control.Monad
+import System.IO
+import GHC.IO.Encoding
+import GHC.IO.Handle
+import Data.Bits
+import Data.Word
+import Data.Char
+import System.FilePath
+import System.Exit
+
+file = "encoding001"
+
+encodings = [(utf8,     "utf8"),
+             (utf8_bom, "utf8_bom"),
+             (utf16,    "utf16"),
+             (utf16le,  "utf16le"),
+             (utf16be,  "utf16be"),
+             (utf32,    "utf32"),
+             (utf32le,  "utf32le"),
+             (utf32be,  "utf32be")]
+
+main = do
+  -- make a UTF-32BE file
+  h <- openBinaryFile (file <.> "utf32be") WriteMode
+  let expand32 :: Word32 -> [Char]
+      expand32 x = [
+          chr (fromIntegral (x `shiftR` 24) .&. 0xff),
+          chr (fromIntegral (x `shiftR` 16) .&. 0xff),
+          chr (fromIntegral (x `shiftR` 8)  .&. 0xff),
+          chr (fromIntegral x .&. 0xff) ]
+  hPutStr h (concatMap expand32 [ 0, 32 .. 0xD7ff ])
+  -- We avoid the private-use characters at 0xEF00..0xEFFF
+  -- that reserved for GHC's PEP383 roundtripping implementation.
+  --
+  -- The reason is that currently normal text containing those
+  -- characters will be mangled, even if we aren't using an encoding
+  -- created using //ROUNDTRIP.
+  hPutStr h (concatMap expand32 [ 0xE000, 0xE000+32 .. 0xEEFF ])
+  hPutStr h (concatMap expand32 [ 0xF000, 0xF000+32 .. 0x10FFFF ])
+  hClose h
+
+  -- convert the UTF-32BE file into each other encoding
+  forM_ encodings $ \(enc,name) -> do
+     when (name /=  "utf32be") $ do
+       hin <- openFile (file <.> "utf32be") ReadMode
+       hSetEncoding hin utf32be
+       hout <- openFile (file <.> name) WriteMode
+       hSetEncoding hout enc
+       hGetContents hin >>= hPutStr hout
+       hClose hin
+       hClose hout
+
+  forM_ [ (from,to) | from <- encodings, to <- encodings, snd from /= snd to ]
+      $ \((fromenc,fromname),(toenc,toname)) -> do
+     hin <- openFile (file <.> fromname) ReadMode
+     hSetEncoding hin fromenc
+     hout <- openFile (file <.> toname <.> fromname) WriteMode
+     hSetEncoding hout toenc
+     hGetContents hin >>= hPutStr hout
+     hClose hin
+     hClose hout
+
+     h1 <- openBinaryFile (file <.> toname) ReadMode
+     h2 <- openBinaryFile (file <.> toname <.> fromname) ReadMode
+     str1 <- hGetContents h1
+     str2 <- hGetContents h2
+     when (str1 /= str2) $ do
+       putStrLn (file <.> toname ++ " and " ++ file <.> toname <.> fromname ++ " differ")
+       exitWith (ExitFailure 1)
+     hClose h1
+     hClose h2
diff --git a/libraries/base/tests/IO/encoding002.hs b/libraries/base/tests/IO/encoding002.hs
new file mode 100644
index 000000000000..2a394582fb63
--- /dev/null
+++ b/libraries/base/tests/IO/encoding002.hs
@@ -0,0 +1,65 @@
+import Control.Monad
+
+import System.IO
+import Control.Exception
+
+import Foreign.Marshal.Array
+import Foreign.Ptr
+
+import GHC.Foreign
+import GHC.IO.Encoding (TextEncoding, mkTextEncoding)
+
+import Data.Char
+import Data.Word
+
+
+decode :: TextEncoding -> [Word8] -> IO String
+decode enc xs = withArrayLen xs (\sz p -> peekCStringLen enc (castPtr p, sz)) `catch` \e -> return (show (e :: IOException))
+
+encode :: TextEncoding -> String -> IO [Word8]
+encode enc cs = withCStringLen enc cs (\(p, sz) -> peekArray sz (castPtr p)) `catch` \e -> return (const [] (e :: IOException))
+
+asc :: Char -> Word8
+asc = fromIntegral . ord
+
+families = [ ([asc 'H', asc 'i', 0xED, 0xB2, 0x80, asc '!'],
+              ["UTF-8",    "UTF-8//IGNORE",    "UTF-8//TRANSLIT",    "UTF-8//ROUNDTRIP"])
+           , ([asc 'H', 0, asc 'i', 0, 0xFF, 0xDF, 0xFF, 0xDF, asc '!', 0],
+              ["UTF-16LE", "UTF-16LE//IGNORE", "UTF-16LE//TRANSLIT", "UTF-16LE//ROUNDTRIP"])
+           , ([0, asc 'H', 0, asc 'i', 0xDF, 0xFF, 0xDF, 0xFF, 0, asc '!'],
+              ["UTF-16BE", "UTF-16BE//IGNORE", "UTF-16BE//TRANSLIT", "UTF-16BE//ROUNDTRIP"])
+           , ([asc 'H', 0, 0, 0, asc 'i', 0, 0, 0, 0xED, 0xB2, 0x80, 0, asc '!', 0, 0, 0],
+              ["UTF-32LE", "UTF-32LE//IGNORE", "UTF-32LE//TRANSLIT", "UTF-32LE//ROUNDTRIP"])
+           , ([0, 0, 0, asc 'H', 0, 0, 0, asc 'i', 0, 0x80, 0xB2, 0xED, 0, 0, 0, asc '!'],
+              ["UTF-32BE", "UTF-32BE//IGNORE", "UTF-32BE//TRANSLIT", "UTF-32BE//ROUNDTRIP"])
+           ]
+
+main = do
+  surrogate_enc <- mkTextEncoding "UTF-8//ROUNDTRIP"
+    
+  -- Test that invalid input is correctly roundtripped as surrogates
+  -- This only works for the UTF-8 UTF since it is the only UTF which
+  -- is an ASCII superset.
+  putStrLn $ "== UTF-8: roundtripping"
+  let invalid_bytes = [asc 'H', asc 'i', 0xED, 0xB2, 0x80, asc '!']
+  surrogates <- decode surrogate_enc invalid_bytes
+  invalid_bytes' <- encode surrogate_enc surrogates
+  print invalid_bytes
+  print surrogates
+  print invalid_bytes'
+  print (invalid_bytes == invalid_bytes')
+  putStrLn ""
+  
+  forM families $ \(invalid_bytes, enc_names) -> do
+    encs <- mapM mkTextEncoding enc_names
+    let name = head enc_names
+    
+    -- How we deal with decoding errors in the various modes:
+    putStrLn $ "== " ++ name ++ ": decoding"
+    forM encs $ \enc -> decode enc invalid_bytes >>= print
+    
+    -- How about encoding errors, particularly those from embedded surrogates?
+    putStrLn $ "== " ++ name ++ ": encoding"
+    forM encs $ \enc -> encode enc "Hi\xDC80!" >>= print
+    
+    putStrLn ""
diff --git a/libraries/base/tests/IO/encoding002.stdout b/libraries/base/tests/IO/encoding002.stdout
new file mode 100644
index 000000000000..0cc885baa0ed
--- /dev/null
+++ b/libraries/base/tests/IO/encoding002.stdout
@@ -0,0 +1,61 @@
+== UTF-8: roundtripping
+[72,105,237,178,128,33]
+"Hi\56557\56498\56448!"
+[72,105,237,178,128,33]
+True
+
+== UTF-8: decoding
+"recoverDecode: invalid argument (invalid byte sequence)"
+"Hi!"
+"Hi\65533\65533\65533!"
+"Hi\56557\56498\56448!"
+== UTF-8: encoding
+[]
+[72,105,33]
+[72,105,63,33]
+[72,105,128,33]
+
+== UTF-16LE: decoding
+"recoverDecode: invalid argument (invalid byte sequence)"
+"Hi\65503\8671"
+"Hi\65533\65503\8671\65533"
+"Hi\56575\65503\8671\NUL"
+== UTF-16LE: encoding
+[]
+[72,0,105,0,33,0]
+[72,0,105,0,63,0,33,0]
+[72,0,105,0,128,33,0]
+
+== UTF-16BE: decoding
+"recoverDecode: invalid argument (invalid byte sequence)"
+"Hi\65503\65280"
+"Hi\65533\65503\65280\65533"
+"Hi\56543\65503\65280!"
+== UTF-16BE: encoding
+[]
+[0,72,0,105,0,33]
+[0,72,0,105,0,63,0,33]
+[0,72,0,105,128,0,33]
+
+== UTF-32LE: decoding
+"recoverDecode: invalid argument (invalid byte sequence)"
+"Hi\8448"
+"Hi\65533\65533\65533\8448\65533"
+"Hi\56557\56498\56448\8448\NUL"
+== UTF-32LE: encoding
+[]
+[72,0,0,0,105,0,0,0,33,0,0,0]
+[72,0,0,0,105,0,0,0,63,0,0,0,33,0,0,0]
+[72,0,0,0,105,0,0,0,128,33,0,0,0]
+
+== UTF-32BE: decoding
+"recoverDecode: invalid argument (invalid byte sequence)"
+"Hi!"
+"Hi\65533\65533\65533\65533!"
+"Hi\NUL\56448\56498\56557!"
+== UTF-32BE: encoding
+[]
+[0,0,0,72,0,0,0,105,0,0,0,33]
+[0,0,0,72,0,0,0,105,0,0,0,63,0,0,0,33]
+[0,0,0,72,0,0,0,105,128,0,0,0,33]
+
diff --git a/libraries/base/tests/IO/encoding003.hs b/libraries/base/tests/IO/encoding003.hs
new file mode 100644
index 000000000000..12ed28b6574b
--- /dev/null
+++ b/libraries/base/tests/IO/encoding003.hs
@@ -0,0 +1,23 @@
+import System.IO
+import System.Directory
+import Data.Char
+
+tempFile = "temp"
+
+create :: IO ()
+create = do
+    h <- openFile tempFile WriteMode
+    hSetEncoding h latin1
+    hPutStr h [chr 128]
+    hClose h
+
+main :: IO ()
+main = do
+    create
+
+    utf8Ignore <- mkTextEncoding "UTF8//IGNORE"
+    h <- openFile tempFile ReadMode
+    hSetEncoding h utf8Ignore
+    hGetContents h >>= putStrLn
+
+    removeFile tempFile
diff --git a/libraries/base/tests/IO/encoding003.stdout b/libraries/base/tests/IO/encoding003.stdout
new file mode 100644
index 000000000000..8b137891791f
--- /dev/null
+++ b/libraries/base/tests/IO/encoding003.stdout
@@ -0,0 +1 @@
+
diff --git a/libraries/base/tests/IO/encoding004.hs b/libraries/base/tests/IO/encoding004.hs
new file mode 100644
index 000000000000..1819df6d3717
--- /dev/null
+++ b/libraries/base/tests/IO/encoding004.hs
@@ -0,0 +1,107 @@
+import System.IO
+import System.Directory
+import Data.Char
+import System.Process
+import Control.Monad
+import qualified Data.ByteString as BS
+import System.Environment
+import System.Exit
+import System.FilePath
+import Data.Maybe
+import qualified Data.Map as M
+import GHC.Foreign
+import Control.Exception
+
+
+decode :: TextEncoding -> BS.ByteString -> IO (Either SomeException String)
+decode enc bs = try $ BS.useAsCStringLen bs $ peekCStringLen enc
+
+encode :: TextEncoding -> String -> IO (Either SomeException BS.ByteString)
+encode enc cs = try $ withCStringLen enc cs $ BS.packCStringLen
+
+decodeEncode :: TextEncoding -> BS.ByteString -> IO (Either SomeException BS.ByteString)
+decodeEncode enc bs = decode enc bs `bind` encode enc
+
+encodedecode :: TextEncoding -> String -> IO (Either SomeException String)
+encodedecode enc bs = encode enc bs `bind` decode enc
+
+bind mx fxmy = do
+    ei_e_cs <- mx
+    case ei_e_cs of
+        Left e   -> return (Left e)
+        Right cs -> fxmy cs
+
+
+main :: IO ()
+main = forM_ [ ("CP936",  2, "CP936",      Just "CP936-UTF8")  -- Representative (roundtrippable) DBCS
+             , ("CP1251", 1, "CP1251",     Just "CP1251-UTF8") -- Representative SBCS
+             , ("UTF-8",  4, "CP936-UTF8", Nothing)            -- Sanity check
+             ] $ \(enc_name, max_byte_length, file, mb_utf8_file) -> do
+    putStrLn $ "== " ++ enc_name
+
+    let fp = "encoded-data" </> file <.> "txt"
+    enc <- mkTextEncoding enc_name
+    bs <- BS.readFile fp
+    
+    -- In a DBCS you should never fail to encode truncated input for two consecutive truncation points,
+    -- assuming that the input file is actually error free:
+    testTruncations enc max_byte_length bs
+
+    -- Should be able to roundtrip arbitrary rubbish, as long as we use the right encoding
+    roundtrip_enc <- mkTextEncoding (enc_name ++ "//ROUNDTRIP")
+    testRoundtripping roundtrip_enc bs
+
+    -- Just check that we actually decode to the right thing, for good measure
+    case mb_utf8_file of
+      Nothing -> return ()
+      Just utf8_file -> do
+        utf8_bs <- BS.readFile ("encoded-data" </> utf8_file <.> "txt")
+        Right expected <- decode utf8 utf8_bs
+        Right actual   <- decode enc  bs
+        unless (expected == actual) $ do
+            putStrLn (bsDiff 0 actual expected)
+
+forTruncations :: BS.ByteString -> (BS.ByteString -> IO a) -> IO [a]
+forTruncations bs f = forSplits bs $ \before _ -> f before
+
+forSplits :: BS.ByteString -> (BS.ByteString -> BS.ByteString -> IO a) -> IO [a]
+forSplits bs f = forM [(800 * block) + ix | block <- [0..len `div` 800], ix <- [0..100]] $ \i -> uncurry f (BS.splitAt i bs)
+    where len = BS.length bs
+
+testTruncations :: TextEncoding -> Int -> BS.ByteString -> IO ()
+testTruncations enc max_byte_length bs = do
+    failures <- fmap catMaybes $ forTruncations bs $ testTruncation enc
+
+    let failure_map = M.fromList failures
+    forM_ failures $ \(i, e) -> do
+        let js = [i+1..i+(max_byte_length - 1)]
+        case sequence (map (`M.lookup` failure_map) js) of
+            Nothing -> return ()
+            Just es -> putStrLn ("Failed on consecutive truncated byte indexes " ++ show (i:js) ++ " (" ++ show (e:es) ++ ")")
+
+testTruncation :: TextEncoding -> BS.ByteString -> IO (Maybe (Int, SomeException))
+testTruncation enc expected = do
+        --putStr (show i ++ ": ") >> hFlush stdout
+        ei_e_actual <- decodeEncode enc expected
+        case ei_e_actual of
+            Left  e      -> return (Just (BS.length expected, e))
+            Right actual | expected /= actual -> error $ "Mismatch on success when truncating at byte index " ++ show (BS.length expected)
+                         | otherwise          -> return Nothing
+
+testRoundtripping :: TextEncoding -> BS.ByteString -> IO ()
+testRoundtripping roundtrip_enc bs = void $ forSplits bs $ \before after -> do
+    let expected = before `BS.append` (fromIntegral (BS.length before `mod` 256) `BS.cons` after)
+    Right actual <- decodeEncode roundtrip_enc expected
+    when (actual /= expected) $ do
+        let i_str = show (BS.length before)
+        putStrLn $ "Failed to roundtrip given mutant byte at index " ++ i_str ++ " (" ++ bsDiff 0 (BS.unpack actual) (BS.unpack expected) ++ ")"
+        -- Possibly useful for debugging porpoises:
+        --BS.writeFile (i_str ++ ".expected") expected
+        --BS.writeFile (i_str ++ ".actual")   actual
+
+bsDiff :: (Show a, Eq a) => Int -> [a] -> [a] -> String
+bsDiff _ [] [] = error "bsDiff"
+bsDiff _ [] bs = "actual " ++ show (length bs) ++ " elements shorter than expected"
+bsDiff _ as [] = "expected " ++ show (length as) ++ " elements shorter than actual"
+bsDiff i (a:as) (b:bs) | a == b    = bsDiff (i + 1) as bs
+                       | otherwise = show a ++ " /= " ++ show b ++ " at index " ++ show i
diff --git a/libraries/base/tests/IO/encoding004.stdout b/libraries/base/tests/IO/encoding004.stdout
new file mode 100644
index 000000000000..9c05f4ed5b25
--- /dev/null
+++ b/libraries/base/tests/IO/encoding004.stdout
@@ -0,0 +1,3 @@
+== CP936
+== CP1251
+== UTF-8
diff --git a/libraries/base/tests/IO/encodingerror001.hs b/libraries/base/tests/IO/encodingerror001.hs
new file mode 100644
index 000000000000..2cfc6e6a0129
--- /dev/null
+++ b/libraries/base/tests/IO/encodingerror001.hs
@@ -0,0 +1,27 @@
+import System.IO
+import System.IO.Error
+import Text.Printf
+import Control.Monad
+
+main = do
+  hSetEncoding stdout latin1
+  forM [NoBuffering,
+        LineBuffering,
+        BlockBuffering Nothing,
+        BlockBuffering (Just 3),
+        BlockBuffering (Just 9),
+        BlockBuffering (Just 32)] $ \b -> do
+     hSetBuffering stdout b
+     checkedPutStr "test 1\n"
+     checkedPutStr "Ä›\n" -- nothing gets written
+     checkedPutStr "test 2\n"
+     checkedPutStr "Hέllo\n" -- we should write at least the 'H'
+     checkedPutStr "test 3\n"
+     checkedPutStr "Hello αβγ\n" -- we should write at least the "Hello "
+
+checkedPutStr str = do
+  r <- tryIOError $ putStr str
+  case r of
+    Right _ -> return ()
+    Left  e -> printf "Caught %s while trying to write %s\n"
+                  (show e) (show str)
diff --git a/libraries/base/tests/IO/encodingerror001.stdout b/libraries/base/tests/IO/encodingerror001.stdout
new file mode 100644
index 000000000000..7406cd91687f
--- /dev/null
+++ b/libraries/base/tests/IO/encodingerror001.stdout
@@ -0,0 +1,36 @@
+test 1
+Caught <stdout>: hPutChar: invalid argument (invalid character) while trying to write "\283\n"
+test 2
+HCaught <stdout>: hPutChar: invalid argument (invalid character) while trying to write "H\941llo\n"
+test 3
+Hello Caught <stdout>: hPutChar: invalid argument (invalid character) while trying to write "Hello \945\946\947\n"
+test 1
+Caught <stdout>: commitBuffer: invalid argument (invalid character) while trying to write "\283\n"
+test 2
+HCaught <stdout>: commitBuffer: invalid argument (invalid character) while trying to write "H\941llo\n"
+test 3
+Hello Caught <stdout>: commitBuffer: invalid argument (invalid character) while trying to write "Hello \945\946\947\n"
+test 1
+Caught <stdout>: commitBuffer: invalid argument (invalid character) while trying to write "\283\n"
+test 2
+HCaught <stdout>: commitBuffer: invalid argument (invalid character) while trying to write "H\941llo\n"
+test 3
+Hello Caught <stdout>: commitBuffer: invalid argument (invalid character) while trying to write "Hello \945\946\947\n"
+test 1
+Caught <stdout>: commitBuffer: invalid argument (invalid character) while trying to write "\283\n"
+test 2
+HCaught <stdout>: commitBuffer: invalid argument (invalid character) while trying to write "H\941llo\n"
+test 3
+Hello Caught <stdout>: commitBuffer: invalid argument (invalid character) while trying to write "Hello \945\946\947\n"
+test 1
+Caught <stdout>: commitBuffer: invalid argument (invalid character) while trying to write "\283\n"
+test 2
+HCaught <stdout>: commitBuffer: invalid argument (invalid character) while trying to write "H\941llo\n"
+test 3
+Hello Caught <stdout>: commitBuffer: invalid argument (invalid character) while trying to write "Hello \945\946\947\n"
+test 1
+Caught <stdout>: commitBuffer: invalid argument (invalid character) while trying to write "\283\n"
+test 2
+HCaught <stdout>: commitBuffer: invalid argument (invalid character) while trying to write "H\941llo\n"
+test 3
+Hello Caught <stdout>: commitBuffer: invalid argument (invalid character) while trying to write "Hello \945\946\947\n"
diff --git a/libraries/base/tests/IO/environment001.hs b/libraries/base/tests/IO/environment001.hs
new file mode 100644
index 000000000000..11d7912cddc2
--- /dev/null
+++ b/libraries/base/tests/IO/environment001.hs
@@ -0,0 +1,16 @@
+import System.Environment
+
+main = do
+    var0 <- getEnv "GHC_TEST"
+    putStrLn var0
+    -- The length proves that we actually decoded it properly, not just read it
+    -- in as latin1 or something (#3308, #3307)
+    putStrLn ("Test 1: " ++ show (length var0))
+
+    [arg0] <- getArgs
+    putStrLn arg0
+    putStrLn ("Test 2: " ++ show (length arg0))
+
+    [arg1] <- withArgs ["你好!"] getArgs
+    putStrLn arg1
+    putStrLn ("Test 3: " ++ show (length arg1))
diff --git a/libraries/base/tests/IO/environment001.stdout b/libraries/base/tests/IO/environment001.stdout
new file mode 100644
index 000000000000..2434d0c14dba
--- /dev/null
+++ b/libraries/base/tests/IO/environment001.stdout
@@ -0,0 +1,6 @@
+马克斯
+Test 1: 3
+说
+Test 2: 1
+你好!
+Test 3: 3
diff --git a/libraries/base/tests/IO/finalization001.hs b/libraries/base/tests/IO/finalization001.hs
new file mode 100644
index 000000000000..44828a68c1f1
--- /dev/null
+++ b/libraries/base/tests/IO/finalization001.hs
@@ -0,0 +1,26 @@
+--- !!! test for bug in handle finalization fixed in 
+--- !!!  1.60      +1 -2      fptools/ghc/lib/std/PrelHandle.lhs
+--- !!!  1.15      +4 -10     fptools/ghc/lib/std/PrelIO.lhs
+
+module Main (main) where
+
+import System.IO
+
+doTest :: IO ()
+doTest = do
+  sd <- openFile "finalization001.hs" ReadMode
+  result <- hGetContents sd
+  slurp result
+  hClose sd
+  if "" `elem` lines (filter (/= '\r') result)
+   then
+    putStrLn "ok"
+   else
+    putStrLn "fail"
+
+slurp :: String -> IO ()
+slurp [] = return ()
+slurp (x:xs) = x `seq` slurp xs
+
+main :: IO ()
+main = sequence_ (take 200 (repeat doTest))
diff --git a/libraries/base/tests/IO/finalization001.stdout b/libraries/base/tests/IO/finalization001.stdout
new file mode 100644
index 000000000000..ec04732f9788
--- /dev/null
+++ b/libraries/base/tests/IO/finalization001.stdout
@@ -0,0 +1,200 @@
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
+ok
diff --git a/libraries/base/tests/IO/hClose001.hs b/libraries/base/tests/IO/hClose001.hs
new file mode 100644
index 000000000000..8d31447e95ee
--- /dev/null
+++ b/libraries/base/tests/IO/hClose001.hs
@@ -0,0 +1,8 @@
+import System.IO
+import System.IO.Error
+
+main = do
+  h <- openFile "hClose001.tmp" WriteMode
+  hPutStr h "junk" 
+  hClose h
+  hPutStr h "junk" `catchIOError` \ err -> if isIllegalOperation err then putStr "Okay\n" else error "Not okay\n"
diff --git a/libraries/base/tests/IO/hClose001.stdout b/libraries/base/tests/IO/hClose001.stdout
new file mode 100644
index 000000000000..1ddd42bbe7b0
--- /dev/null
+++ b/libraries/base/tests/IO/hClose001.stdout
@@ -0,0 +1 @@
+Okay
diff --git a/libraries/base/tests/IO/hClose002.hs b/libraries/base/tests/IO/hClose002.hs
new file mode 100644
index 000000000000..ebf26b46639a
--- /dev/null
+++ b/libraries/base/tests/IO/hClose002.hs
@@ -0,0 +1,32 @@
+import System.IO
+import Control.Exception
+
+import qualified GHC.IO.Device as IODevice
+import GHC.IO.Handle
+import GHC.IO.Handle.Internals
+import GHC.IO.Handle.Types
+import System.Posix.Internals
+
+main = do
+  h <- openFile "hClose002.tmp" WriteMode
+        -- close the FD without telling the IO library:
+  naughtyClose h
+        -- first hClose will raise an exception, but close the
+        -- Handle anyway:
+  showPossibleException (hClose h)
+        -- second hClose should success (Handle is already closed)
+  showPossibleException (hClose h)
+        -- this should succeed (checking that the lock on the file has
+        -- been released:
+  h <- openFile "hClose002.tmp" ReadMode
+  showPossibleException (hClose h)
+  showPossibleException (hClose h)
+
+showPossibleException :: IO () -> IO ()
+showPossibleException f = do e <- try f
+                             print (e :: Either SomeException ())
+
+naughtyClose h = 
+  withHandle_ "naughtyClose" h $ \ Handle__{haDevice=dev} -> do
+     IODevice.close dev
+
diff --git a/libraries/base/tests/IO/hClose002.stdout b/libraries/base/tests/IO/hClose002.stdout
new file mode 100644
index 000000000000..f26be4ab070a
--- /dev/null
+++ b/libraries/base/tests/IO/hClose002.stdout
@@ -0,0 +1,4 @@
+Left hClose002.tmp: hClose: invalid argument (Bad file descriptor)
+Right ()
+Right ()
+Right ()
diff --git a/libraries/base/tests/IO/hClose002.stdout-i386-unknown-solaris2 b/libraries/base/tests/IO/hClose002.stdout-i386-unknown-solaris2
new file mode 100644
index 000000000000..39a24de031fc
--- /dev/null
+++ b/libraries/base/tests/IO/hClose002.stdout-i386-unknown-solaris2
@@ -0,0 +1,4 @@
+Left hClose002.tmp: hClose: invalid argument (Bad file number)
+Right ()
+Right ()
+Right ()
diff --git a/libraries/base/tests/IO/hClose003.hs b/libraries/base/tests/IO/hClose003.hs
new file mode 100644
index 000000000000..cbaf49d6db54
--- /dev/null
+++ b/libraries/base/tests/IO/hClose003.hs
@@ -0,0 +1,42 @@
+-- Test for #3128, file descriptor leak when hClose fails
+
+import System.IO
+import Control.Exception
+import Data.Char
+
+import System.Posix
+import qualified GHC.IO.Device as IODevice
+import GHC.IO.Handle
+import GHC.IO.Handle.Internals
+import GHC.IO.Handle.Types
+import System.Posix.Internals
+
+main = do
+  (read,write) <- createPipe
+  hread <- fdToHandle read
+  hwrite <- fdToHandle write
+
+        -- close the FD without telling the IO library:
+  showPossibleException (hClose hread)
+  hIsOpen hread >>= print
+
+        -- put some data in the Handle's write buffer:
+  hPutStr hwrite "testing"
+        -- now try to close the Handle:
+  showPossibleException (hClose hwrite)
+  hIsOpen hwrite >>= print
+
+showPossibleException :: IO () -> IO ()
+showPossibleException f = do 
+  e <- try f
+  putStrLn (sanitise (show (e :: Either SomeException ())))
+ where
+  -- we don't care which file descriptor it is
+  sanitise [] = []
+  sanitise (x:xs) = if isDigit x then ('X':(sanitise' xs)) else (x:(sanitise xs))
+  sanitise' [] = []
+  sanitise' (x:xs) = if isDigit x then (sanitise' xs) else (x:(sanitise xs))
+
+naughtyClose h = 
+  withHandle_ "naughtyClose" h $ \ Handle__{haDevice=dev} -> do
+     IODevice.close dev
diff --git a/libraries/base/tests/IO/hClose003.stdout b/libraries/base/tests/IO/hClose003.stdout
new file mode 100644
index 000000000000..d12f84d7d7c8
--- /dev/null
+++ b/libraries/base/tests/IO/hClose003.stdout
@@ -0,0 +1,4 @@
+Right ()
+False
+Left <file descriptor: X>: hClose: resource vanished (Broken pipe)
+False
diff --git a/libraries/base/tests/IO/hDuplicateTo001.hs b/libraries/base/tests/IO/hDuplicateTo001.hs
new file mode 100644
index 000000000000..99f956a0dff5
--- /dev/null
+++ b/libraries/base/tests/IO/hDuplicateTo001.hs
@@ -0,0 +1,25 @@
+import GHC.IO
+import GHC.IO.Handle
+import GHC.IO.Handle.Types
+import System.IO
+import Control.Concurrent.MVar
+import Data.Typeable
+import qualified GHC.IO.FD as FD
+
+main = do
+   h <- openFile "tmp" WriteMode
+   hDuplicateTo h stdout
+   
+   fdh <- getfd h
+   fdstdout <- getfd stdout
+   hPutStrLn stderr ("h: " ++ show (fdh /= fdstdout) ++ "\nstdout: " ++ show fdstdout)
+
+   hClose h
+   putStrLn "bla"
+
+
+getfd h@(FileHandle _ mvar) = do
+  withMVar mvar $ \h__@Handle__{haDevice=dev} ->
+   case cast dev of
+     Just fd -> return (FD.fdFD fd)
+     Nothing -> error "getfd"
diff --git a/libraries/base/tests/IO/hDuplicateTo001.stderr b/libraries/base/tests/IO/hDuplicateTo001.stderr
new file mode 100644
index 000000000000..14a31438a62a
--- /dev/null
+++ b/libraries/base/tests/IO/hDuplicateTo001.stderr
@@ -0,0 +1,2 @@
+h: True
+stdout: 1
diff --git a/libraries/base/tests/IO/hFileSize001.hs b/libraries/base/tests/IO/hFileSize001.hs
new file mode 100644
index 000000000000..62b3e88b9c46
--- /dev/null
+++ b/libraries/base/tests/IO/hFileSize001.hs
@@ -0,0 +1,8 @@
+import System.IO
+
+-- !!! test hFileSize
+
+main = do
+    h  <- openFile "hFileSize001.hs" ReadMode
+    sz <- hFileSize h
+    print sz
diff --git a/libraries/base/tests/IO/hFileSize001.stdout b/libraries/base/tests/IO/hFileSize001.stdout
new file mode 100644
index 000000000000..94361d49fd91
--- /dev/null
+++ b/libraries/base/tests/IO/hFileSize001.stdout
@@ -0,0 +1 @@
+132
diff --git a/libraries/base/tests/IO/hFileSize002.hs b/libraries/base/tests/IO/hFileSize002.hs
new file mode 100644
index 000000000000..03caf1036a73
--- /dev/null
+++ b/libraries/base/tests/IO/hFileSize002.hs
@@ -0,0 +1,36 @@
+-- !!! Testing IO.hFileSize
+module Main(main) where
+
+import Control.Monad
+import System.Directory ( removeFile, doesFileExist )
+import System.IO
+import System.IO.Error
+
+main = do
+  sz <- hFileSize stdin `catchIOError` (\ _ -> return (-1))
+  print sz
+  let fn = "hFileSize002.out"
+  f <- doesFileExist fn
+  when f (removeFile fn)
+  hdl <- openFile fn WriteMode
+  hPutStr hdl "file_size"
+   -- with default buffering
+  sz <- hFileSize hdl
+  print sz
+
+  hSetBuffering hdl NoBuffering
+  hPutStr hdl "file_size"
+   -- with no buffering
+  sz <- hFileSize hdl
+  print sz
+  hSetBuffering hdl LineBuffering
+  hPutStr hdl "file_size"
+   -- with line buffering
+  sz <- hFileSize hdl
+  print sz
+  hSetBuffering hdl (BlockBuffering (Just 4))
+   -- with block buffering
+  hPutStr hdl "file_size"
+  sz <- hFileSize hdl
+  print sz
+  hClose hdl
diff --git a/libraries/base/tests/IO/hFileSize002.stdout b/libraries/base/tests/IO/hFileSize002.stdout
new file mode 100644
index 000000000000..23dd73404861
--- /dev/null
+++ b/libraries/base/tests/IO/hFileSize002.stdout
@@ -0,0 +1,5 @@
+-1
+9
+18
+27
+36
diff --git a/libraries/base/tests/IO/hFlush001.hs b/libraries/base/tests/IO/hFlush001.hs
new file mode 100644
index 000000000000..a061f9472dd0
--- /dev/null
+++ b/libraries/base/tests/IO/hFlush001.hs
@@ -0,0 +1,32 @@
+-- !!! Flushing
+module Main(main) where
+
+import Control.Monad
+import System.Directory ( removeFile, doesFileExist )
+import System.IO
+import System.IO.Error
+
+main = do
+  hFlush stdin `catchIOError` \ _ -> putStrLn "No can do - flushing read-only handles isn't legal"
+  putStr "Hello,"
+  hFlush stdout
+  putStr "Hello - "
+  hFlush stderr
+  hdl <- openFile "hFlush001.hs" ReadMode
+  hFlush hdl `catchIOError` \ _ -> putStrLn "No can do - flushing read-only handles isn't legal"
+  hClose hdl
+  remove
+  hdl <- openFile "hFlush001.out" WriteMode
+  hFlush hdl
+  hClose hdl
+  remove
+  hdl <- openFile "hFlush001.out" AppendMode
+  hFlush hdl
+  hClose hdl
+  remove
+  hdl <- openFile "hFlush001.out" ReadWriteMode
+  hFlush hdl
+  hClose hdl
+ where remove = do
+         f <- doesFileExist "hFlush001.out"
+         when f (removeFile "hFlush001.out")
diff --git a/libraries/base/tests/IO/hFlush001.stdout b/libraries/base/tests/IO/hFlush001.stdout
new file mode 100644
index 000000000000..0954a7a0b4b5
--- /dev/null
+++ b/libraries/base/tests/IO/hFlush001.stdout
@@ -0,0 +1,2 @@
+No can do - flushing read-only handles isn't legal
+Hello,Hello - No can do - flushing read-only handles isn't legal
diff --git a/libraries/base/tests/IO/hGetBuf001.hs b/libraries/base/tests/IO/hGetBuf001.hs
new file mode 100644
index 000000000000..eea599ea7493
--- /dev/null
+++ b/libraries/base/tests/IO/hGetBuf001.hs
@@ -0,0 +1,218 @@
+-- !!! Testing hGetBuf(NonBlocking), hPutBuf(NonBlocking)
+
+import System.Posix
+import System.IO
+import Control.Concurrent
+import Foreign
+import Foreign.C
+import System.Exit
+import Control.Exception
+import Control.Monad
+
+
+main = do
+  -- test should run quickly, but arrange to kill it if it hangs for any reason:
+  main_t <- myThreadId
+  forkIO $ do
+	threadDelay 10000000
+	throwTo main_t (ErrorCall "killed")
+
+  zipWithM_ ($) 
+	  [ f rbuf wbuf
+	    | f <- [hGetBufTest, hGetBufNBTest, hGetBufSomeTest],
+	      rbuf <- [buf1,buf2,buf3],
+	      wbuf <- [buf1,buf2,buf3]
+	    ]
+	  [1..]
+
+msg = "hello!"
+msg_length = length msg
+
+buf1 = NoBuffering
+buf2 = BlockBuffering (Just 5)
+buf3 = BlockBuffering (Just 10)
+
+-- chosen to be larger than buf2 & smaller than buf3, so that we exercise
+-- all code paths:
+read_size = 8 :: Int
+
+-- ----------------------------------------------------------------------------
+
+-- hGetBuf/hPutBuf:
+--   - test that it always reads all the data that is available
+--     (with buffer size <, =, > message size).
+--   - test that at the EOF, it returns a short read.
+--   - the writing end is using hPutBuf, with various buffer sizes, and
+--     doing an hFlush at the end of each write.
+
+hGetBufTest rbuf wbuf n = do
+  (read,write) <- createPipe
+  hread <- fdToHandle read
+  hwrite <- fdToHandle write
+  m1 <- newEmptyMVar
+  m2 <- newEmptyMVar
+  finished <- newEmptyMVar
+  hSetBuffering hread rbuf
+  hSetBuffering hwrite wbuf
+  forkIO (readProc m1 m2 finished hread)
+  writeProc m1 m2 hwrite
+  takeMVar finished
+  putStrLn ("test " ++ show n ++ " OK")
+
+
+readProc :: MVar () -> MVar () -> MVar () -> Handle -> IO ()
+readProc m1 m2 finished h = do
+  buf <- mallocBytes 20
+  let
+    loop 0 = return ()
+    loop n = do putMVar m2 (); takeMVar m1
+		r <- hGetBuf h buf msg_length
+		if (r /= msg_length) 
+			then do hPutStr stderr ("error: " ++ show r)
+			        exitFailure
+			else do s <- peekCStringLen (buf,r)
+			        hPutStr stdout (show n ++ " ")
+			        loop (n-1)
+  loop 100
+  hPutStr stdout "\n"
+  putMVar m2 (); takeMVar m1
+  r <- hGetBuf h buf read_size -- EOF, should get short read
+  s <- peekCStringLen (buf,r)
+  putStrLn ("got " ++ show r ++  ": " ++ s)
+  r <- hGetBuf h buf read_size -- EOF, should get zero-length read
+  s <- peekCStringLen (buf,r)
+  putStrLn ("got " ++ show r ++  ": " ++ s)
+  hClose h
+  putMVar finished ()
+
+writeProc :: MVar () -> MVar () -> Handle -> IO ()
+writeProc m1 m2 h = do
+  let
+    loop 0 = return ()
+    loop n =
+	withCStringLen msg  $ \ (s,len) -> do
+	  takeMVar m2
+	  hPutBuf h s len
+	  hFlush h
+	  putMVar m1 ()
+	  loop (n-1)
+
+  loop 100
+  takeMVar m2
+  withCString "end" $ \s -> do
+    hPutBuf h s 3
+    putMVar m1 ()
+  hClose h
+
+-- -----------------------------------------------------------------------------
+-- hGetBufNonBlocking:
+
+hGetBufNBTest rbuf wbuf n = do
+  (read,write) <- createPipe
+  hread <- fdToHandle read
+  hwrite <- fdToHandle write
+  m1 <- newEmptyMVar
+  m2 <- newEmptyMVar
+  finished <- newEmptyMVar
+  hSetBuffering hread rbuf
+  hSetBuffering hwrite wbuf
+  forkIO (readProcNB m1 m2 finished hread)
+  writeProcNB m1 m2 hwrite
+  takeMVar finished
+  putStrLn ("test " ++ show n ++ " OK")
+
+
+readProcNB :: MVar () -> MVar () -> MVar () -> Handle -> IO ()
+readProcNB m1 m2 finished h = do
+  buf <- mallocBytes 20
+
+  -- first, test that we can do a non-blocking read:
+  r <- hGetBufNonBlocking h buf read_size
+  s <- peekCStringLen (buf,r)
+  putStrLn ("got " ++ show r ++  ": " ++ s)
+
+  let
+    loop 0 = return ()
+    loop n = do putMVar m2 (); takeMVar m1
+		r <- hGetBufNonBlocking h buf read_size
+		if (r /= msg_length) 
+			then do hPutStr stderr ("error: " ++ show r)
+			        exitFailure
+			else do s <- peekCStringLen (buf,r)
+			        hPutStr stdout (show n ++ " ")
+			        loop (n-1)
+  loop 100
+  hPutStr stdout "\n"
+  putMVar m2 (); takeMVar m1
+  r <- hGetBufNonBlocking h buf read_size -- EOF, should get short read
+  s <- peekCStringLen (buf,r)
+  putStrLn ("got " ++ show r ++  ": " ++ s)
+  r <- hGetBufNonBlocking h buf read_size -- EOF, should get zero-length read
+  s <- peekCStringLen (buf,r)
+  putStrLn ("got " ++ show r ++  ": " ++ s)
+  hClose h
+  putMVar finished ()
+
+writeProcNB :: MVar () -> MVar () -> Handle -> IO ()
+writeProcNB m1 m2 h = do
+  let
+    loop 0 = return ()
+    loop n =
+	withCStringLen msg  $ \ (s,len) -> do
+	  takeMVar m2
+	  hPutBufNonBlocking h s len
+	  hFlush h
+	  putMVar m1 ()
+	  loop (n-1)
+
+  loop 100
+  takeMVar m2
+  withCString "end" $ \s -> do
+    hPutBuf h s 3
+    hFlush h
+    putMVar m1 ()
+  hClose h
+
+-- -----------------------------------------------------------------------------
+-- hGetBufSome:
+
+hGetBufSomeTest rbuf wbuf n = do
+  (read,write) <- createPipe
+  hread <- fdToHandle read
+  hwrite <- fdToHandle write
+  m1 <- newEmptyMVar
+  m2 <- newEmptyMVar
+  finished <- newEmptyMVar
+  hSetBuffering hread rbuf
+  hSetBuffering hwrite wbuf
+  forkIO (readProcSome m1 m2 finished hread)
+  writeProcNB m1 m2 hwrite
+  takeMVar finished
+  putStrLn ("test " ++ show n ++ " OK")
+
+
+readProcSome :: MVar () -> MVar () -> MVar () -> Handle -> IO ()
+readProcSome m1 m2 finished h = do
+  buf <- mallocBytes 20
+
+  let
+    loop 0 = return ()
+    loop n = do putMVar m2 (); takeMVar m1
+		r <- hGetBufSome h buf read_size
+		if (r /= msg_length) 
+			then do hPutStr stderr ("error: " ++ show r)
+			        exitFailure
+			else do s <- peekCStringLen (buf,r)
+			        hPutStr stdout (show n ++ " ")
+			        loop (n-1)
+  loop 100
+  hPutStr stdout "\n"
+  putMVar m2 (); takeMVar m1
+  r <- hGetBufSome h buf read_size -- EOF, should get short read
+  s <- peekCStringLen (buf,r)
+  putStrLn ("got " ++ show r ++  ": " ++ s)
+  r <- hGetBufSome h buf read_size -- EOF, should get zero-length read
+  s <- peekCStringLen (buf,r)
+  putStrLn ("got " ++ show r ++  ": " ++ s)
+  hClose h
+  putMVar finished ()
diff --git a/libraries/base/tests/IO/hGetBuf001.stdout b/libraries/base/tests/IO/hGetBuf001.stdout
new file mode 100644
index 000000000000..694ff4eedf24
--- /dev/null
+++ b/libraries/base/tests/IO/hGetBuf001.stdout
@@ -0,0 +1,117 @@
+100 99 98 97 96 95 94 93 92 91 90 89 88 87 86 85 84 83 82 81 80 79 78 77 76 75 74 73 72 71 70 69 68 67 66 65 64 63 62 61 60 59 58 57 56 55 54 53 52 51 50 49 48 47 46 45 44 43 42 41 40 39 38 37 36 35 34 33 32 31 30 29 28 27 26 25 24 23 22 21 20 19 18 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 
+got 3: end
+got 0: 
+test 1 OK
+100 99 98 97 96 95 94 93 92 91 90 89 88 87 86 85 84 83 82 81 80 79 78 77 76 75 74 73 72 71 70 69 68 67 66 65 64 63 62 61 60 59 58 57 56 55 54 53 52 51 50 49 48 47 46 45 44 43 42 41 40 39 38 37 36 35 34 33 32 31 30 29 28 27 26 25 24 23 22 21 20 19 18 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 
+got 3: end
+got 0: 
+test 2 OK
+100 99 98 97 96 95 94 93 92 91 90 89 88 87 86 85 84 83 82 81 80 79 78 77 76 75 74 73 72 71 70 69 68 67 66 65 64 63 62 61 60 59 58 57 56 55 54 53 52 51 50 49 48 47 46 45 44 43 42 41 40 39 38 37 36 35 34 33 32 31 30 29 28 27 26 25 24 23 22 21 20 19 18 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 
+got 3: end
+got 0: 
+test 3 OK
+100 99 98 97 96 95 94 93 92 91 90 89 88 87 86 85 84 83 82 81 80 79 78 77 76 75 74 73 72 71 70 69 68 67 66 65 64 63 62 61 60 59 58 57 56 55 54 53 52 51 50 49 48 47 46 45 44 43 42 41 40 39 38 37 36 35 34 33 32 31 30 29 28 27 26 25 24 23 22 21 20 19 18 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 
+got 3: end
+got 0: 
+test 4 OK
+100 99 98 97 96 95 94 93 92 91 90 89 88 87 86 85 84 83 82 81 80 79 78 77 76 75 74 73 72 71 70 69 68 67 66 65 64 63 62 61 60 59 58 57 56 55 54 53 52 51 50 49 48 47 46 45 44 43 42 41 40 39 38 37 36 35 34 33 32 31 30 29 28 27 26 25 24 23 22 21 20 19 18 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 
+got 3: end
+got 0: 
+test 5 OK
+100 99 98 97 96 95 94 93 92 91 90 89 88 87 86 85 84 83 82 81 80 79 78 77 76 75 74 73 72 71 70 69 68 67 66 65 64 63 62 61 60 59 58 57 56 55 54 53 52 51 50 49 48 47 46 45 44 43 42 41 40 39 38 37 36 35 34 33 32 31 30 29 28 27 26 25 24 23 22 21 20 19 18 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 
+got 3: end
+got 0: 
+test 6 OK
+100 99 98 97 96 95 94 93 92 91 90 89 88 87 86 85 84 83 82 81 80 79 78 77 76 75 74 73 72 71 70 69 68 67 66 65 64 63 62 61 60 59 58 57 56 55 54 53 52 51 50 49 48 47 46 45 44 43 42 41 40 39 38 37 36 35 34 33 32 31 30 29 28 27 26 25 24 23 22 21 20 19 18 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 
+got 3: end
+got 0: 
+test 7 OK
+100 99 98 97 96 95 94 93 92 91 90 89 88 87 86 85 84 83 82 81 80 79 78 77 76 75 74 73 72 71 70 69 68 67 66 65 64 63 62 61 60 59 58 57 56 55 54 53 52 51 50 49 48 47 46 45 44 43 42 41 40 39 38 37 36 35 34 33 32 31 30 29 28 27 26 25 24 23 22 21 20 19 18 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 
+got 3: end
+got 0: 
+test 8 OK
+100 99 98 97 96 95 94 93 92 91 90 89 88 87 86 85 84 83 82 81 80 79 78 77 76 75 74 73 72 71 70 69 68 67 66 65 64 63 62 61 60 59 58 57 56 55 54 53 52 51 50 49 48 47 46 45 44 43 42 41 40 39 38 37 36 35 34 33 32 31 30 29 28 27 26 25 24 23 22 21 20 19 18 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 
+got 3: end
+got 0: 
+test 9 OK
+got 0: 
+100 99 98 97 96 95 94 93 92 91 90 89 88 87 86 85 84 83 82 81 80 79 78 77 76 75 74 73 72 71 70 69 68 67 66 65 64 63 62 61 60 59 58 57 56 55 54 53 52 51 50 49 48 47 46 45 44 43 42 41 40 39 38 37 36 35 34 33 32 31 30 29 28 27 26 25 24 23 22 21 20 19 18 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 
+got 3: end
+got 0: 
+test 10 OK
+got 0: 
+100 99 98 97 96 95 94 93 92 91 90 89 88 87 86 85 84 83 82 81 80 79 78 77 76 75 74 73 72 71 70 69 68 67 66 65 64 63 62 61 60 59 58 57 56 55 54 53 52 51 50 49 48 47 46 45 44 43 42 41 40 39 38 37 36 35 34 33 32 31 30 29 28 27 26 25 24 23 22 21 20 19 18 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 
+got 3: end
+got 0: 
+test 11 OK
+got 0: 
+100 99 98 97 96 95 94 93 92 91 90 89 88 87 86 85 84 83 82 81 80 79 78 77 76 75 74 73 72 71 70 69 68 67 66 65 64 63 62 61 60 59 58 57 56 55 54 53 52 51 50 49 48 47 46 45 44 43 42 41 40 39 38 37 36 35 34 33 32 31 30 29 28 27 26 25 24 23 22 21 20 19 18 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 
+got 3: end
+got 0: 
+test 12 OK
+got 0: 
+100 99 98 97 96 95 94 93 92 91 90 89 88 87 86 85 84 83 82 81 80 79 78 77 76 75 74 73 72 71 70 69 68 67 66 65 64 63 62 61 60 59 58 57 56 55 54 53 52 51 50 49 48 47 46 45 44 43 42 41 40 39 38 37 36 35 34 33 32 31 30 29 28 27 26 25 24 23 22 21 20 19 18 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 
+got 3: end
+got 0: 
+test 13 OK
+got 0: 
+100 99 98 97 96 95 94 93 92 91 90 89 88 87 86 85 84 83 82 81 80 79 78 77 76 75 74 73 72 71 70 69 68 67 66 65 64 63 62 61 60 59 58 57 56 55 54 53 52 51 50 49 48 47 46 45 44 43 42 41 40 39 38 37 36 35 34 33 32 31 30 29 28 27 26 25 24 23 22 21 20 19 18 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 
+got 3: end
+got 0: 
+test 14 OK
+got 0: 
+100 99 98 97 96 95 94 93 92 91 90 89 88 87 86 85 84 83 82 81 80 79 78 77 76 75 74 73 72 71 70 69 68 67 66 65 64 63 62 61 60 59 58 57 56 55 54 53 52 51 50 49 48 47 46 45 44 43 42 41 40 39 38 37 36 35 34 33 32 31 30 29 28 27 26 25 24 23 22 21 20 19 18 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 
+got 3: end
+got 0: 
+test 15 OK
+got 0: 
+100 99 98 97 96 95 94 93 92 91 90 89 88 87 86 85 84 83 82 81 80 79 78 77 76 75 74 73 72 71 70 69 68 67 66 65 64 63 62 61 60 59 58 57 56 55 54 53 52 51 50 49 48 47 46 45 44 43 42 41 40 39 38 37 36 35 34 33 32 31 30 29 28 27 26 25 24 23 22 21 20 19 18 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 
+got 3: end
+got 0: 
+test 16 OK
+got 0: 
+100 99 98 97 96 95 94 93 92 91 90 89 88 87 86 85 84 83 82 81 80 79 78 77 76 75 74 73 72 71 70 69 68 67 66 65 64 63 62 61 60 59 58 57 56 55 54 53 52 51 50 49 48 47 46 45 44 43 42 41 40 39 38 37 36 35 34 33 32 31 30 29 28 27 26 25 24 23 22 21 20 19 18 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 
+got 3: end
+got 0: 
+test 17 OK
+got 0: 
+100 99 98 97 96 95 94 93 92 91 90 89 88 87 86 85 84 83 82 81 80 79 78 77 76 75 74 73 72 71 70 69 68 67 66 65 64 63 62 61 60 59 58 57 56 55 54 53 52 51 50 49 48 47 46 45 44 43 42 41 40 39 38 37 36 35 34 33 32 31 30 29 28 27 26 25 24 23 22 21 20 19 18 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 
+got 3: end
+got 0: 
+test 18 OK
+100 99 98 97 96 95 94 93 92 91 90 89 88 87 86 85 84 83 82 81 80 79 78 77 76 75 74 73 72 71 70 69 68 67 66 65 64 63 62 61 60 59 58 57 56 55 54 53 52 51 50 49 48 47 46 45 44 43 42 41 40 39 38 37 36 35 34 33 32 31 30 29 28 27 26 25 24 23 22 21 20 19 18 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 
+got 3: end
+got 0: 
+test 19 OK
+100 99 98 97 96 95 94 93 92 91 90 89 88 87 86 85 84 83 82 81 80 79 78 77 76 75 74 73 72 71 70 69 68 67 66 65 64 63 62 61 60 59 58 57 56 55 54 53 52 51 50 49 48 47 46 45 44 43 42 41 40 39 38 37 36 35 34 33 32 31 30 29 28 27 26 25 24 23 22 21 20 19 18 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 
+got 3: end
+got 0: 
+test 20 OK
+100 99 98 97 96 95 94 93 92 91 90 89 88 87 86 85 84 83 82 81 80 79 78 77 76 75 74 73 72 71 70 69 68 67 66 65 64 63 62 61 60 59 58 57 56 55 54 53 52 51 50 49 48 47 46 45 44 43 42 41 40 39 38 37 36 35 34 33 32 31 30 29 28 27 26 25 24 23 22 21 20 19 18 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 
+got 3: end
+got 0: 
+test 21 OK
+100 99 98 97 96 95 94 93 92 91 90 89 88 87 86 85 84 83 82 81 80 79 78 77 76 75 74 73 72 71 70 69 68 67 66 65 64 63 62 61 60 59 58 57 56 55 54 53 52 51 50 49 48 47 46 45 44 43 42 41 40 39 38 37 36 35 34 33 32 31 30 29 28 27 26 25 24 23 22 21 20 19 18 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 
+got 3: end
+got 0: 
+test 22 OK
+100 99 98 97 96 95 94 93 92 91 90 89 88 87 86 85 84 83 82 81 80 79 78 77 76 75 74 73 72 71 70 69 68 67 66 65 64 63 62 61 60 59 58 57 56 55 54 53 52 51 50 49 48 47 46 45 44 43 42 41 40 39 38 37 36 35 34 33 32 31 30 29 28 27 26 25 24 23 22 21 20 19 18 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 
+got 3: end
+got 0: 
+test 23 OK
+100 99 98 97 96 95 94 93 92 91 90 89 88 87 86 85 84 83 82 81 80 79 78 77 76 75 74 73 72 71 70 69 68 67 66 65 64 63 62 61 60 59 58 57 56 55 54 53 52 51 50 49 48 47 46 45 44 43 42 41 40 39 38 37 36 35 34 33 32 31 30 29 28 27 26 25 24 23 22 21 20 19 18 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 
+got 3: end
+got 0: 
+test 24 OK
+100 99 98 97 96 95 94 93 92 91 90 89 88 87 86 85 84 83 82 81 80 79 78 77 76 75 74 73 72 71 70 69 68 67 66 65 64 63 62 61 60 59 58 57 56 55 54 53 52 51 50 49 48 47 46 45 44 43 42 41 40 39 38 37 36 35 34 33 32 31 30 29 28 27 26 25 24 23 22 21 20 19 18 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 
+got 3: end
+got 0: 
+test 25 OK
+100 99 98 97 96 95 94 93 92 91 90 89 88 87 86 85 84 83 82 81 80 79 78 77 76 75 74 73 72 71 70 69 68 67 66 65 64 63 62 61 60 59 58 57 56 55 54 53 52 51 50 49 48 47 46 45 44 43 42 41 40 39 38 37 36 35 34 33 32 31 30 29 28 27 26 25 24 23 22 21 20 19 18 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 
+got 3: end
+got 0: 
+test 26 OK
+100 99 98 97 96 95 94 93 92 91 90 89 88 87 86 85 84 83 82 81 80 79 78 77 76 75 74 73 72 71 70 69 68 67 66 65 64 63 62 61 60 59 58 57 56 55 54 53 52 51 50 49 48 47 46 45 44 43 42 41 40 39 38 37 36 35 34 33 32 31 30 29 28 27 26 25 24 23 22 21 20 19 18 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 
+got 3: end
+got 0: 
+test 27 OK
diff --git a/libraries/base/tests/IO/hGetBuffering001.hs b/libraries/base/tests/IO/hGetBuffering001.hs
new file mode 100644
index 000000000000..83188b27960a
--- /dev/null
+++ b/libraries/base/tests/IO/hGetBuffering001.hs
@@ -0,0 +1,21 @@
+import System.IO
+
+main = 
+    sequence (map hIsOpen [stdin, stdout, stderr]) >>= \ opens ->
+    print opens >>
+    sequence (map hIsClosed [stdin, stdout, stderr]) >>= \ closeds ->
+    print closeds >>
+    sequence (map hIsReadable [stdin, stdout, stderr]) >>= \ readables ->
+    print readables >>
+    sequence (map hIsWritable [stdin, stdout, stderr]) >>= \ writables ->
+    print writables >>
+    sequence (map hIsBlockBuffered [stdin, stdout, stderr]) >>= \ buffereds ->
+    print buffereds >>
+    sequence (map hIsLineBuffered [stdin, stdout, stderr]) >>= \ buffereds ->
+    print buffereds >>
+    sequence (map hIsNotBuffered [stdin, stdout, stderr]) >>= \ buffereds ->
+    print buffereds
+  where
+    hIsBlockBuffered h = hGetBuffering h >>= \ b -> return $ case b of { BlockBuffering _ -> True; _ -> False }
+    hIsLineBuffered  h = hGetBuffering h >>= \ b -> return $ case b of { LineBuffering -> True; _ -> False }
+    hIsNotBuffered   h = hGetBuffering h >>= \ b -> return $ case b of { NoBuffering -> True; _ -> False }
diff --git a/libraries/base/tests/IO/hGetBuffering001.stdout b/libraries/base/tests/IO/hGetBuffering001.stdout
new file mode 100644
index 000000000000..75b9a133d9c1
--- /dev/null
+++ b/libraries/base/tests/IO/hGetBuffering001.stdout
@@ -0,0 +1,7 @@
+[True,True,True]
+[False,False,False]
+[True,False,False]
+[False,True,True]
+[True,True,False]
+[False,False,False]
+[False,False,True]
diff --git a/libraries/base/tests/IO/hGetChar001.hs b/libraries/base/tests/IO/hGetChar001.hs
new file mode 100644
index 000000000000..f5ca66682800
--- /dev/null
+++ b/libraries/base/tests/IO/hGetChar001.hs
@@ -0,0 +1,18 @@
+import System.IO
+
+main = do
+ hSetBuffering stdout NoBuffering
+ putStr   "Enter an integer: "
+ x1 <- readLine
+ putStr   "Enter another integer: "
+ x2 <- readLine
+ putStr  ("Their sum is " ++ show (read x1 + read x2 :: Int) ++ "\n")
+
+ where readLine = do
+           eof <- isEOF
+           if eof then return [] else do
+           c <- getChar
+   	   if c `elem` ['\n','\r'] 
+		then return []
+                else do cs <- readLine
+                        return (c:cs)
diff --git a/libraries/base/tests/IO/hGetChar001.stdin b/libraries/base/tests/IO/hGetChar001.stdin
new file mode 100644
index 000000000000..2510fcaec307
--- /dev/null
+++ b/libraries/base/tests/IO/hGetChar001.stdin
@@ -0,0 +1,2 @@
+42
+-7
diff --git a/libraries/base/tests/IO/hGetChar001.stdout b/libraries/base/tests/IO/hGetChar001.stdout
new file mode 100644
index 000000000000..47d4185c647b
--- /dev/null
+++ b/libraries/base/tests/IO/hGetChar001.stdout
@@ -0,0 +1 @@
+Enter an integer: Enter another integer: Their sum is 35
diff --git a/libraries/base/tests/IO/hGetLine001.hs b/libraries/base/tests/IO/hGetLine001.hs
new file mode 100644
index 000000000000..b5950623eaca
--- /dev/null
+++ b/libraries/base/tests/IO/hGetLine001.hs
@@ -0,0 +1,25 @@
+-- !!! testing hGetLine
+
+import System.IO
+
+-- one version of 'cat'
+main = do
+  let loop h = do b <- hIsEOF h
+        	  if b then return ()
+		       else do l <- hGetLine h; putStrLn l; loop h
+  loop stdin 
+
+  h <- openFile "hGetLine001.hs" ReadMode
+
+  hSetBinaryMode stdout True
+
+  hSetBuffering h NoBuffering
+  loop h
+
+  hSeek h AbsoluteSeek 0
+  hSetBuffering h LineBuffering
+  loop h
+
+  hSeek h AbsoluteSeek 0
+  hSetBuffering h (BlockBuffering (Just 83))
+  loop h
diff --git a/libraries/base/tests/IO/hGetLine001.stdout b/libraries/base/tests/IO/hGetLine001.stdout
new file mode 100644
index 000000000000..3e023db8f593
--- /dev/null
+++ b/libraries/base/tests/IO/hGetLine001.stdout
@@ -0,0 +1,100 @@
+-- !!! testing hGetLine
+
+import System.IO
+
+-- one version of 'cat'
+main = do
+  let loop h = do b <- hIsEOF h
+        	  if b then return ()
+		       else do l <- hGetLine h; putStrLn l; loop h
+  loop stdin 
+
+  h <- openFile "hGetLine001.hs" ReadMode
+
+  hSetBinaryMode stdout True
+
+  hSetBuffering h NoBuffering
+  loop h
+
+  hSeek h AbsoluteSeek 0
+  hSetBuffering h LineBuffering
+  loop h
+
+  hSeek h AbsoluteSeek 0
+  hSetBuffering h (BlockBuffering (Just 83))
+  loop h
+-- !!! testing hGetLine
+
+import System.IO
+
+-- one version of 'cat'
+main = do
+  let loop h = do b <- hIsEOF h
+        	  if b then return ()
+		       else do l <- hGetLine h; putStrLn l; loop h
+  loop stdin 
+
+  h <- openFile "hGetLine001.hs" ReadMode
+
+  hSetBinaryMode stdout True
+
+  hSetBuffering h NoBuffering
+  loop h
+
+  hSeek h AbsoluteSeek 0
+  hSetBuffering h LineBuffering
+  loop h
+
+  hSeek h AbsoluteSeek 0
+  hSetBuffering h (BlockBuffering (Just 83))
+  loop h
+-- !!! testing hGetLine
+
+import System.IO
+
+-- one version of 'cat'
+main = do
+  let loop h = do b <- hIsEOF h
+        	  if b then return ()
+		       else do l <- hGetLine h; putStrLn l; loop h
+  loop stdin 
+
+  h <- openFile "hGetLine001.hs" ReadMode
+
+  hSetBinaryMode stdout True
+
+  hSetBuffering h NoBuffering
+  loop h
+
+  hSeek h AbsoluteSeek 0
+  hSetBuffering h LineBuffering
+  loop h
+
+  hSeek h AbsoluteSeek 0
+  hSetBuffering h (BlockBuffering (Just 83))
+  loop h
+-- !!! testing hGetLine
+
+import System.IO
+
+-- one version of 'cat'
+main = do
+  let loop h = do b <- hIsEOF h
+        	  if b then return ()
+		       else do l <- hGetLine h; putStrLn l; loop h
+  loop stdin 
+
+  h <- openFile "hGetLine001.hs" ReadMode
+
+  hSetBinaryMode stdout True
+
+  hSetBuffering h NoBuffering
+  loop h
+
+  hSeek h AbsoluteSeek 0
+  hSetBuffering h LineBuffering
+  loop h
+
+  hSeek h AbsoluteSeek 0
+  hSetBuffering h (BlockBuffering (Just 83))
+  loop h
diff --git a/libraries/base/tests/IO/hGetLine002.hs b/libraries/base/tests/IO/hGetLine002.hs
new file mode 100644
index 000000000000..5185d9eea9b7
--- /dev/null
+++ b/libraries/base/tests/IO/hGetLine002.hs
@@ -0,0 +1,17 @@
+-- !!! testing hGetLine on a file without a final '\n'.
+
+-- According to the Haskell 98 report, getLine should discard a line without a
+-- closing newline character (see implementation of getLine). 
+--
+-- However, we don't believe that this is the right behaviour.
+
+import System.IO
+import System.IO.Error
+
+main = catchIOError loop (\e -> print e)
+
+loop = do 
+  hSetBuffering stdin LineBuffering
+  l <- hGetLine stdin
+  putStrLn l
+  loop
diff --git a/libraries/base/tests/IO/hGetLine002.stdin b/libraries/base/tests/IO/hGetLine002.stdin
new file mode 100644
index 000000000000..808eafd54bda
--- /dev/null
+++ b/libraries/base/tests/IO/hGetLine002.stdin
@@ -0,0 +1 @@
+this line doesn't end with a newline
\ No newline at end of file
diff --git a/libraries/base/tests/IO/hGetLine002.stdout b/libraries/base/tests/IO/hGetLine002.stdout
new file mode 100644
index 000000000000..0ec29ade8f5a
--- /dev/null
+++ b/libraries/base/tests/IO/hGetLine002.stdout
@@ -0,0 +1,2 @@
+this line doesn't end with a newline
+<stdin>: hGetLine: end of file
diff --git a/libraries/base/tests/IO/hGetLine002.stdout-hugs b/libraries/base/tests/IO/hGetLine002.stdout-hugs
new file mode 100644
index 000000000000..ed871357b73b
--- /dev/null
+++ b/libraries/base/tests/IO/hGetLine002.stdout-hugs
@@ -0,0 +1,2 @@
+this line doesn't end with a newline
+<stdin>: IO.hGetChar: end of file (end of file)
diff --git a/libraries/base/tests/IO/hGetLine003.hs b/libraries/base/tests/IO/hGetLine003.hs
new file mode 100644
index 000000000000..cc03c604aa04
--- /dev/null
+++ b/libraries/base/tests/IO/hGetLine003.hs
@@ -0,0 +1,9 @@
+import System.IO
+
+main = f stdin
+  where f h = do p <- hIsEOF h
+		 if p then putStrLn "done" 
+		      else do l <- hGetLine h
+			      putStrLn l
+			      f h
+
diff --git a/libraries/base/tests/IO/hGetLine003.stdin b/libraries/base/tests/IO/hGetLine003.stdin
new file mode 100644
index 000000000000..b8b74a4b1e55
--- /dev/null
+++ b/libraries/base/tests/IO/hGetLine003.stdin
@@ -0,0 +1 @@
+this line doesn't end with a newline
diff --git a/libraries/base/tests/IO/hGetLine003.stdout b/libraries/base/tests/IO/hGetLine003.stdout
new file mode 100644
index 000000000000..6daac48252bb
--- /dev/null
+++ b/libraries/base/tests/IO/hGetLine003.stdout
@@ -0,0 +1,2 @@
+this line doesn't end with a newline
+done
diff --git a/libraries/base/tests/IO/hGetPosn001.hs b/libraries/base/tests/IO/hGetPosn001.hs
new file mode 100644
index 000000000000..0a1a39b72548
--- /dev/null
+++ b/libraries/base/tests/IO/hGetPosn001.hs
@@ -0,0 +1,28 @@
+-- !!! Test file positioning
+
+module Main(main) where
+
+import Control.Monad
+import System.Directory (removeFile, doesFileExist)
+import System.IO
+import System.IO.Error
+
+main = do
+  hIn <- openFile "hGetPosn001.in" ReadMode
+  f <- doesFileExist "hGetPosn001.out"
+  when f (removeFile "hGetPosn001.out")
+  hOut <- openFile "hGetPosn001.out" ReadWriteMode
+  bof <- hGetPosn hIn
+  putStrLn (show bof)  -- you can show HandlePosns
+  copy hIn hOut
+  hSetPosn bof
+  copy hIn hOut
+  hSeek hOut AbsoluteSeek 0
+  stuff <- hGetContents hOut
+  putStr stuff
+
+copy :: Handle -> Handle -> IO ()
+copy hIn hOut =
+    tryIOError (hGetChar hIn) >>=
+    either (\ err -> if isEOFError err then return () else error "copy")
+	   ( \ x -> hPutChar hOut x >> copy hIn hOut)
diff --git a/libraries/base/tests/IO/hGetPosn001.in b/libraries/base/tests/IO/hGetPosn001.in
new file mode 100644
index 000000000000..2e2537150ff3
--- /dev/null
+++ b/libraries/base/tests/IO/hGetPosn001.in
@@ -0,0 +1,2 @@
+123456789*123456789*123456789*123456789*123456789*123456789*123456789*12
+         1         2         3         4         5         6         7  
diff --git a/libraries/base/tests/IO/hGetPosn001.stdout b/libraries/base/tests/IO/hGetPosn001.stdout
new file mode 100644
index 000000000000..10adafd9335d
--- /dev/null
+++ b/libraries/base/tests/IO/hGetPosn001.stdout
@@ -0,0 +1,5 @@
+{handle: hGetPosn001.in} at position 0
+123456789*123456789*123456789*123456789*123456789*123456789*123456789*12
+         1         2         3         4         5         6         7  
+123456789*123456789*123456789*123456789*123456789*123456789*123456789*12
+         1         2         3         4         5         6         7  
diff --git a/libraries/base/tests/IO/hGetPosn001.stdout-hugs b/libraries/base/tests/IO/hGetPosn001.stdout-hugs
new file mode 100644
index 000000000000..56e989c49389
--- /dev/null
+++ b/libraries/base/tests/IO/hGetPosn001.stdout-hugs
@@ -0,0 +1,5 @@
+<handle> at position 0
+123456789*123456789*123456789*123456789*123456789*123456789*123456789*12
+         1         2         3         4         5         6         7  
+123456789*123456789*123456789*123456789*123456789*123456789*123456789*12
+         1         2         3         4         5         6         7  
diff --git a/libraries/base/tests/IO/hIsEOF001.hs b/libraries/base/tests/IO/hIsEOF001.hs
new file mode 100644
index 000000000000..2230687edb88
--- /dev/null
+++ b/libraries/base/tests/IO/hIsEOF001.hs
@@ -0,0 +1,8 @@
+-- !!! hIsEOF (on stdout)
+
+import System.IO ( hIsEOF, stdout )
+import System.IO.Error
+
+main = do
+  flg <- hIsEOF stdout `catchIOError` \ _ -> putStrLn "hIsEOF failed" >> return False
+  print flg
diff --git a/libraries/base/tests/IO/hIsEOF001.stdout b/libraries/base/tests/IO/hIsEOF001.stdout
new file mode 100644
index 000000000000..76460ac50add
--- /dev/null
+++ b/libraries/base/tests/IO/hIsEOF001.stdout
@@ -0,0 +1,2 @@
+hIsEOF failed
+False
diff --git a/libraries/base/tests/IO/hIsEOF002.hs b/libraries/base/tests/IO/hIsEOF002.hs
new file mode 100644
index 000000000000..26f5abd9a747
--- /dev/null
+++ b/libraries/base/tests/IO/hIsEOF002.hs
@@ -0,0 +1,48 @@
+-- !!! test hIsEOF in various buffering situations
+
+import System.IO
+
+main = do
+  h <- openFile "hIsEOF002.hs" ReadMode
+  hSetBuffering h NoBuffering
+  hSeek h SeekFromEnd 0
+  hIsEOF h >>= print
+  hSeek h SeekFromEnd (-1)
+  hIsEOF h >>= print
+  hGetChar h >>= print 
+
+  hSetBuffering h LineBuffering
+  hSeek h SeekFromEnd 0
+  hIsEOF h >>= print
+  hSeek h SeekFromEnd (-1)
+  hIsEOF h >>= print
+  hGetChar h >>= print  
+
+  hSetBuffering h (BlockBuffering (Just 1))
+  hSeek h SeekFromEnd 0
+  hIsEOF h >>= print
+  hSeek h SeekFromEnd (-1)
+  hIsEOF h >>= print
+  hGetChar h >>= print  
+
+  hSetBuffering h (BlockBuffering Nothing)
+  hSeek h SeekFromEnd 0
+  hIsEOF h >>= print
+  hSeek h SeekFromEnd (-1)
+  hIsEOF h >>= print
+  hGetChar h >>= print  
+  hClose h
+
+  h <- openFile "hIsEOF002.out" WriteMode
+  hPutStrLn h "hello, world"
+  hClose h
+
+  h <- openFile "hIsEOF002.out" ReadWriteMode
+  hSetBuffering h NoBuffering
+  hSeek h SeekFromEnd 0
+  hIsEOF h >>= print
+  hPutChar h 'x'
+  hIsEOF h >>= print
+  hSeek h SeekFromEnd (-1)
+  hIsEOF h >>= print
+  hGetChar h >>= print 
diff --git a/libraries/base/tests/IO/hIsEOF002.stdout b/libraries/base/tests/IO/hIsEOF002.stdout
new file mode 100644
index 000000000000..3aa5e1a64da7
--- /dev/null
+++ b/libraries/base/tests/IO/hIsEOF002.stdout
@@ -0,0 +1,16 @@
+True
+False
+'\n'
+True
+False
+'\n'
+True
+False
+'\n'
+True
+False
+'\n'
+True
+True
+False
+'x'
diff --git a/libraries/base/tests/IO/hReady001.hs b/libraries/base/tests/IO/hReady001.hs
new file mode 100644
index 000000000000..bb7be1c78b55
--- /dev/null
+++ b/libraries/base/tests/IO/hReady001.hs
@@ -0,0 +1,12 @@
+-- !!! hReady test
+
+ -- hReady should throw and EOF exception at the end of a file. Trac #1063.
+
+import System.IO
+import System.IO.Error
+
+main = do
+ h <- openFile "hReady001.hs" ReadMode
+ hReady h >>= print
+ hSeek h SeekFromEnd 0
+ (hReady h >> return ()) `catchIOError` print
diff --git a/libraries/base/tests/IO/hReady001.stdout b/libraries/base/tests/IO/hReady001.stdout
new file mode 100644
index 000000000000..af35f80533df
--- /dev/null
+++ b/libraries/base/tests/IO/hReady001.stdout
@@ -0,0 +1,2 @@
+True
+hReady001.hs: hWaitForInput: end of file
diff --git a/libraries/base/tests/IO/hReady002.hs b/libraries/base/tests/IO/hReady002.hs
new file mode 100644
index 000000000000..6db22a13fc16
--- /dev/null
+++ b/libraries/base/tests/IO/hReady002.hs
@@ -0,0 +1,10 @@
+-- test for bug #4078
+import System.IO
+import Control.Concurrent
+import System.Exit
+
+main = do
+  m <- newEmptyMVar
+  forkIO $ do threadDelay 500000; putMVar m Nothing
+  forkIO $ do hReady stdin >>= putMVar m . Just
+  takeMVar m >>= print
diff --git a/libraries/base/tests/IO/hReady002.stdout b/libraries/base/tests/IO/hReady002.stdout
new file mode 100644
index 000000000000..6217d00e1007
--- /dev/null
+++ b/libraries/base/tests/IO/hReady002.stdout
@@ -0,0 +1 @@
+Just False
diff --git a/libraries/base/tests/IO/hSeek001.hs b/libraries/base/tests/IO/hSeek001.hs
new file mode 100644
index 000000000000..dc7313face41
--- /dev/null
+++ b/libraries/base/tests/IO/hSeek001.hs
@@ -0,0 +1,29 @@
+-- !!! Test seeking
+
+import System.IO
+
+main = do
+    h  <- openFile "hSeek001.in" ReadMode
+    True <- hIsSeekable h
+    hSeek h SeekFromEnd (-1)
+    z <- hGetChar h
+    putStr (z:"\n")
+    hSeek h SeekFromEnd (-3)
+    x <- hGetChar h
+    putStr (x:"\n")
+    hSeek h RelativeSeek (-2)
+    w <- hGetChar h
+    putStr (w:"\n")
+    hSeek h RelativeSeek 2
+    z <- hGetChar h
+    putStr (z:"\n")
+    hSeek h AbsoluteSeek (0)
+    a <- hGetChar h
+    putStr (a:"\n")
+    hSeek h AbsoluteSeek (10)
+    k <- hGetChar h
+    putStr (k:"\n")
+    hSeek h AbsoluteSeek (25)
+    z <- hGetChar h
+    putStr (z:"\n")
+    hClose h
diff --git a/libraries/base/tests/IO/hSeek001.in b/libraries/base/tests/IO/hSeek001.in
new file mode 100644
index 000000000000..e85d5b45283a
--- /dev/null
+++ b/libraries/base/tests/IO/hSeek001.in
@@ -0,0 +1 @@
+abcdefghijklmnopqrstuvwxyz
\ No newline at end of file
diff --git a/libraries/base/tests/IO/hSeek001.stdout b/libraries/base/tests/IO/hSeek001.stdout
new file mode 100644
index 000000000000..ab6c1d751b66
--- /dev/null
+++ b/libraries/base/tests/IO/hSeek001.stdout
@@ -0,0 +1,7 @@
+z
+x
+w
+z
+a
+k
+z
diff --git a/libraries/base/tests/IO/hSeek002.hs b/libraries/base/tests/IO/hSeek002.hs
new file mode 100644
index 000000000000..8c9153cfaa15
--- /dev/null
+++ b/libraries/base/tests/IO/hSeek002.hs
@@ -0,0 +1,25 @@
+-- !!! Testing EOF (and the clearing of it)
+
+module Main(main) where
+
+import System.IO
+import System.Directory ( removeFile )
+
+main :: IO ()
+main = do
+   hdl <- openFile "hSeek002.hs" ReadMode
+   flg <- hIsEOF hdl
+   print flg
+   hSeek hdl SeekFromEnd 0
+   flg <- hIsEOF hdl
+   print flg
+   hSeek hdl SeekFromEnd (-1)
+   flg <- hIsEOF hdl
+   print flg
+   hGetChar hdl
+   flg <- hIsEOF hdl
+   print flg
+   hSeek hdl SeekFromEnd (-1)
+   flg <- hIsEOF hdl
+   print flg
+   hClose hdl
diff --git a/libraries/base/tests/IO/hSeek002.stdout b/libraries/base/tests/IO/hSeek002.stdout
new file mode 100644
index 000000000000..8069fe32b0f8
--- /dev/null
+++ b/libraries/base/tests/IO/hSeek002.stdout
@@ -0,0 +1,5 @@
+False
+True
+False
+True
+False
diff --git a/libraries/base/tests/IO/hSeek003.hs b/libraries/base/tests/IO/hSeek003.hs
new file mode 100644
index 000000000000..03400573c4b4
--- /dev/null
+++ b/libraries/base/tests/IO/hSeek003.hs
@@ -0,0 +1,51 @@
+-- !!! file positions (hGetPosn and hSetPosn)
+
+module Main(main) where
+
+import System.IO
+import Control.Monad ( sequence )
+
+testPosns :: Handle -> BufferMode -> IO ()
+testPosns hdl bmo = do
+   hSetBuffering hdl bmo
+   putStrLn ("Testing positioning with buffer mode set to: " ++ show bmo)
+   testPositioning hdl
+
+bmo_ls = [NoBuffering, LineBuffering, BlockBuffering Nothing, 
+          BlockBuffering (Just 511),BlockBuffering (Just 3), BlockBuffering (Just 11)]
+
+main = do
+  hdl  <- openFile "hSeek003.hs" ReadMode
+  sequence (zipWith testPosns (repeat hdl) bmo_ls)
+  hClose hdl
+
+testPositioning hdl = do
+  hSeek hdl AbsoluteSeek 0  -- go to the beginning of the file again.
+  ps   <- getFilePosns 10 hdl
+  hSeek hdl AbsoluteSeek 0
+  putStr "First ten chars: "
+  ls   <- hGetChars 10 hdl
+  putStrLn ls
+    -- go to the end
+  hSeek hdl SeekFromEnd 0  
+  ls   <- sequence (map (\ p -> hSetPosn p >> hGetChar hdl) ps)
+  putStr "First ten chars: "
+  putStrLn ls
+
+    -- position ourselves in the middle.
+  sz <- hFileSize hdl
+  hSeek hdl AbsoluteSeek (sz `div` 2)
+  ls   <- sequence (map (\ p -> hSetPosn p >> hGetChar hdl) ps)
+  putStr "First ten chars: "
+  putStrLn ls
+
+hGetChars :: Int -> Handle -> IO String
+hGetChars n h = sequence (replicate n (hGetChar h))
+
+getFilePosns :: Int -> Handle -> IO [HandlePosn]
+getFilePosns 0 h = return []
+getFilePosns x h = do
+   p <- hGetPosn h
+   hGetChar h
+   ps <- getFilePosns (x-1) h
+   return (p:ps)
diff --git a/libraries/base/tests/IO/hSeek003.stdout b/libraries/base/tests/IO/hSeek003.stdout
new file mode 100644
index 000000000000..7c765c5bc539
--- /dev/null
+++ b/libraries/base/tests/IO/hSeek003.stdout
@@ -0,0 +1,24 @@
+Testing positioning with buffer mode set to: NoBuffering
+First ten chars: -- !!! fil
+First ten chars: -- !!! fil
+First ten chars: -- !!! fil
+Testing positioning with buffer mode set to: LineBuffering
+First ten chars: -- !!! fil
+First ten chars: -- !!! fil
+First ten chars: -- !!! fil
+Testing positioning with buffer mode set to: BlockBuffering Nothing
+First ten chars: -- !!! fil
+First ten chars: -- !!! fil
+First ten chars: -- !!! fil
+Testing positioning with buffer mode set to: BlockBuffering (Just 511)
+First ten chars: -- !!! fil
+First ten chars: -- !!! fil
+First ten chars: -- !!! fil
+Testing positioning with buffer mode set to: BlockBuffering (Just 3)
+First ten chars: -- !!! fil
+First ten chars: -- !!! fil
+First ten chars: -- !!! fil
+Testing positioning with buffer mode set to: BlockBuffering (Just 11)
+First ten chars: -- !!! fil
+First ten chars: -- !!! fil
+First ten chars: -- !!! fil
diff --git a/libraries/base/tests/IO/hSeek004.hs b/libraries/base/tests/IO/hSeek004.hs
new file mode 100644
index 000000000000..fd59741bc815
--- /dev/null
+++ b/libraries/base/tests/IO/hSeek004.hs
@@ -0,0 +1,8 @@
+-- !!! can't seek an AppendMode handle
+
+import System.IO
+import System.IO.Error
+
+main = do
+  h <- openFile "hSeek004.out" AppendMode
+  tryIOError (hSeek h AbsoluteSeek 0) >>= print
diff --git a/libraries/base/tests/IO/hSeek004.stdout b/libraries/base/tests/IO/hSeek004.stdout
new file mode 100644
index 000000000000..d2671a63613b
--- /dev/null
+++ b/libraries/base/tests/IO/hSeek004.stdout
@@ -0,0 +1 @@
+Left hSeek004.out: hSeek: illegal operation (handle is not seekable)
diff --git a/libraries/base/tests/IO/hSetBuffering002.hs b/libraries/base/tests/IO/hSetBuffering002.hs
new file mode 100644
index 000000000000..3f553029daf1
--- /dev/null
+++ b/libraries/base/tests/IO/hSetBuffering002.hs
@@ -0,0 +1,6 @@
+import System.IO
+
+main = 
+    hSetBuffering stdin NoBuffering	>>
+    hSetBuffering stdout NoBuffering	>>
+    interact id
diff --git a/libraries/base/tests/IO/hSetBuffering002.stdout b/libraries/base/tests/IO/hSetBuffering002.stdout
new file mode 100644
index 000000000000..3f553029daf1
--- /dev/null
+++ b/libraries/base/tests/IO/hSetBuffering002.stdout
@@ -0,0 +1,6 @@
+import System.IO
+
+main = 
+    hSetBuffering stdin NoBuffering	>>
+    hSetBuffering stdout NoBuffering	>>
+    interact id
diff --git a/libraries/base/tests/IO/hSetBuffering003.hs b/libraries/base/tests/IO/hSetBuffering003.hs
new file mode 100644
index 000000000000..3e66f6e52480
--- /dev/null
+++ b/libraries/base/tests/IO/hSetBuffering003.hs
@@ -0,0 +1,80 @@
+-- !!! Reconfiguring the buffering of a handle
+module Main(main) where
+
+import System.IO
+import System.IO.Error
+
+queryBuffering :: String -> Handle -> IO ()
+queryBuffering handle_nm handle = do
+  bufm  <- hGetBuffering handle
+  putStrLn ("Buffering for " ++ handle_nm ++ " is: " ++ show bufm)
+   
+main = do
+  queryBuffering "stdin" stdin
+  queryBuffering "stdout" stdout
+  queryBuffering "stderr" stderr
+
+   -- twiddling the setting for stdin.
+  hSetBuffering stdin NoBuffering
+  queryBuffering "stdin" stdin
+  hSetBuffering stdin LineBuffering
+  queryBuffering "stdin" stdin
+  hSetBuffering stdin (BlockBuffering (Just 2))
+  queryBuffering "stdin" stdin
+  hSetBuffering stdin (BlockBuffering Nothing)
+  queryBuffering "stdin" stdin
+  let bmo = BlockBuffering (Just (-3))
+  hSetBuffering stdin bmo `catchIOError` \ _ -> putStrLn ("Caught illegal op: hSetBuffering stdin " ++ showParen True (showsPrec 9 bmo) [])
+
+  putChar '\n'
+
+   -- twiddling the buffering for stdout
+  hPutStr stdout "Hello stdout 1"
+  hSetBuffering stdout NoBuffering
+  queryBuffering "stdout" stdout
+  hPutStr stdout "Hello stdout 2"
+  hSetBuffering stdout LineBuffering
+  queryBuffering "stdout" stdout
+  hPutStr stdout "Hello stdout 3"
+  hSetBuffering stdout (BlockBuffering (Just 2))
+  queryBuffering "stdout" stdout
+  hPutStr stdout "Hello stdout 4"
+  hSetBuffering stdout (BlockBuffering Nothing)
+  queryBuffering "stdout" stdout
+  hPutStr stdout "Hello stdout 5"
+  let bmo = BlockBuffering (Just (-3))
+  hSetBuffering stdout bmo `catchIOError` \ _ -> putStrLn ("Caught illegal op: hSetBuffering stdout " ++ showParen True (showsPrec 9 bmo) [])
+
+  putChar '\n'
+
+   -- twiddling the buffering for stderr
+  hPutStr stderr "Hello stderr 1"
+  hSetBuffering stderr NoBuffering
+  queryBuffering "stderr" stderr
+  hPutStr stderr "Hello stderr 2"
+  hSetBuffering stderr LineBuffering
+  queryBuffering "stderr" stderr
+  hPutStr stderr "Hello stderr 3"
+  hSetBuffering stderr (BlockBuffering (Just 2))
+  queryBuffering "stderr" stderr
+  hPutStr stderr "Hello stderr 4"
+  hSetBuffering stderr (BlockBuffering Nothing)
+  queryBuffering "stderr" stderr
+  hPutStr stderr "Hello stderr 5"
+  let bmo = BlockBuffering (Just (-3))
+  hSetBuffering stderr bmo `catchIOError` \ _ -> putStrLn ("Caught illegal op: hSetBuffering stderr " ++ showParen True (showsPrec 9 bmo) [])
+
+  ls  <- hGetContents stdin
+  ls' <- putLine ls
+  hSetBuffering stdin NoBuffering
+  putLine ls'
+  return ()
+
+putLine :: String -> IO String
+putLine [] = return []
+putLine (x:xs) = do
+   putChar x
+   case x of
+     '\n' -> return xs
+     _    -> putLine xs
+  
diff --git a/libraries/base/tests/IO/hSetBuffering003.stderr b/libraries/base/tests/IO/hSetBuffering003.stderr
new file mode 100644
index 000000000000..a4cf8779b4e2
--- /dev/null
+++ b/libraries/base/tests/IO/hSetBuffering003.stderr
@@ -0,0 +1 @@
+Hello stderr 1Hello stderr 2Hello stderr 3Hello stderr 4Hello stderr 5
\ No newline at end of file
diff --git a/libraries/base/tests/IO/hSetBuffering003.stdout b/libraries/base/tests/IO/hSetBuffering003.stdout
new file mode 100644
index 000000000000..776877319888
--- /dev/null
+++ b/libraries/base/tests/IO/hSetBuffering003.stdout
@@ -0,0 +1,22 @@
+Buffering for stdin is: BlockBuffering Nothing
+Buffering for stdout is: BlockBuffering Nothing
+Buffering for stderr is: NoBuffering
+Buffering for stdin is: NoBuffering
+Buffering for stdin is: LineBuffering
+Buffering for stdin is: BlockBuffering (Just 2)
+Buffering for stdin is: BlockBuffering Nothing
+Caught illegal op: hSetBuffering stdin (BlockBuffering (Just (-3)))
+
+Hello stdout 1Buffering for stdout is: NoBuffering
+Hello stdout 2Buffering for stdout is: LineBuffering
+Hello stdout 3Buffering for stdout is: BlockBuffering (Just 2)
+Hello stdout 4Buffering for stdout is: BlockBuffering Nothing
+Hello stdout 5Caught illegal op: hSetBuffering stdout (BlockBuffering (Just (-3)))
+
+Buffering for stderr is: NoBuffering
+Buffering for stderr is: LineBuffering
+Buffering for stderr is: BlockBuffering (Just 2)
+Buffering for stderr is: BlockBuffering Nothing
+Caught illegal op: hSetBuffering stderr (BlockBuffering (Just (-3)))
+-- !!! Reconfiguring the buffering of a handle
+module Main(main) where
diff --git a/libraries/base/tests/IO/hSetBuffering004.hs b/libraries/base/tests/IO/hSetBuffering004.hs
new file mode 100644
index 000000000000..01b9aaed42ff
--- /dev/null
+++ b/libraries/base/tests/IO/hSetBuffering004.hs
@@ -0,0 +1,10 @@
+-- test for #2678
+module Main (main) where
+
+import System.IO
+
+main :: IO ()
+main = do hSetBuffering stdin NoBuffering
+          hLookAhead stdin >>= print
+          hSetBuffering stdin LineBuffering
+          getContents >>= print
diff --git a/libraries/base/tests/IO/hSetBuffering004.stdout b/libraries/base/tests/IO/hSetBuffering004.stdout
new file mode 100644
index 000000000000..a7c394642ce2
--- /dev/null
+++ b/libraries/base/tests/IO/hSetBuffering004.stdout
@@ -0,0 +1,2 @@
+'-'
+"-- test for #2678\nmodule Main (main) where\n\nimport System.IO\n\nmain :: IO ()\nmain = do hSetBuffering stdin NoBuffering\n          hLookAhead stdin >>= print\n          hSetBuffering stdin LineBuffering\n          getContents >>= print\n"
diff --git a/libraries/base/tests/IO/hSetEncoding001.hs b/libraries/base/tests/IO/hSetEncoding001.hs
new file mode 100644
index 000000000000..95f570d0946d
--- /dev/null
+++ b/libraries/base/tests/IO/hSetEncoding001.hs
@@ -0,0 +1,49 @@
+import System.IO
+import GHC.IO.Handle
+import GHC.IO.Encoding
+import System.Environment
+
+-- Test switching encodings
+-- The test file is built by the Makefile
+
+main = do
+  [file] <- getArgs
+  test file NoBuffering
+  test file (BlockBuffering Nothing)
+  test file (BlockBuffering (Just 5))
+
+test file buf = do
+  hSetEncoding stdout utf8
+  h <- openBinaryFile file ReadMode
+  hSetBuffering stdout buf
+  putStrLn "no encoding:"
+  getUntilX h
+  hSetEncoding h utf8
+  putStrLn "UTF8:"
+  getUntilX h
+  hSetEncoding h utf16le
+  putStrLn "UTF16LE:"
+  getUntilX h
+  hSetEncoding h utf16be
+  putStrLn "UTF16BE:"
+  getUntilX h
+  hSetEncoding h utf16
+  putStrLn "UTF16:"
+  getUntilX h
+  hSetEncoding h utf32
+  putStrLn "UTF32:"
+  getUntilX h
+  hSetEncoding h utf32le
+  putStrLn "UTF32LE:"
+  getUntilX h
+  hSetEncoding h utf32be
+  putStrLn "UTF32BE:"
+  getUntilX h
+  hSetEncoding h utf8_bom
+  putStrLn "UTF8-BOM:"
+  getUntilX h
+  hIsEOF h >>= print
+
+getUntilX h = do
+  c <- hGetChar h
+  if c == 'X' then return () else do putChar c; getUntilX h
diff --git a/libraries/base/tests/IO/hSetEncoding001.in b/libraries/base/tests/IO/hSetEncoding001.in
new file mode 100644
index 000000000000..03f297441dd2
Binary files /dev/null and b/libraries/base/tests/IO/hSetEncoding001.in differ
diff --git a/libraries/base/tests/IO/hSetEncoding001.stdout b/libraries/base/tests/IO/hSetEncoding001.stdout
new file mode 100644
index 000000000000..a1d38ffd77d8
--- /dev/null
+++ b/libraries/base/tests/IO/hSetEncoding001.stdout
@@ -0,0 +1,90 @@
+no encoding:
+c0    | À   �   Â   Ã   Ä   Å   Æ   Ç   È   É   Ê   Ë   Ì   �   Î   �
+d0    | �   Ñ   Ò   Ó   Ô   Õ   Ö   ×   Ø   Ù   Ú   Û   Ü   �   Þ   ß
+e0    | à   á   â   ã   ä   å   æ   ç   è   é   ê   ë   ì   í   î   ï
+f0    | ð   ñ   ò   ó   ô   õ   ö   ÷   ø   ù   ú   û   ü   ý   þ   ÿ
+UTF8:
+(∘) :: ∀ α β γ . (β → γ) → (α → β) → (α → γ)
+�������������������������
+UTF16LE:
+(∘) :: ∀ α β γ . (β → γ) → (α → β) → (α → γ)
+�������������������������
+UTF16BE:
+(∘) :: ∀ α β γ . (β → γ) → (α → β) → (α → γ)
+�������������������������
+UTF16:
+(∘) :: ∀ α β γ . (β → γ) → (α → β) → (α → γ)
+�������������������������
+UTF32:
+(∘) :: ∀ α β γ . (β → γ) → (α → β) → (α → γ)
+�������������������������
+UTF32LE:
+(∘) :: ∀ α β γ . (β → γ) → (α → β) → (α → γ)
+�������������������������
+UTF32BE:
+(∘) :: ∀ α β γ . (β → γ) → (α → β) → (α → γ)
+�������������������������
+UTF8-BOM:
+(∘) :: ∀ α β γ . (β → γ) → (α → β) → (α → γ)
+�������������������������
+True
+no encoding:
+c0    | À   �   Â   Ã   Ä   Å   Æ   Ç   È   É   Ê   Ë   Ì   �   Î   �
+d0    | �   Ñ   Ò   Ó   Ô   Õ   Ö   ×   Ø   Ù   Ú   Û   Ü   �   Þ   ß
+e0    | à   á   â   ã   ä   å   æ   ç   è   é   ê   ë   ì   í   î   ï
+f0    | ð   ñ   ò   ó   ô   õ   ö   ÷   ø   ù   ú   û   ü   ý   þ   ÿ
+UTF8:
+(∘) :: ∀ α β γ . (β → γ) → (α → β) → (α → γ)
+�������������������������
+UTF16LE:
+(∘) :: ∀ α β γ . (β → γ) → (α → β) → (α → γ)
+�������������������������
+UTF16BE:
+(∘) :: ∀ α β γ . (β → γ) → (α → β) → (α → γ)
+�������������������������
+UTF16:
+(∘) :: ∀ α β γ . (β → γ) → (α → β) → (α → γ)
+�������������������������
+UTF32:
+(∘) :: ∀ α β γ . (β → γ) → (α → β) → (α → γ)
+�������������������������
+UTF32LE:
+(∘) :: ∀ α β γ . (β → γ) → (α → β) → (α → γ)
+�������������������������
+UTF32BE:
+(∘) :: ∀ α β γ . (β → γ) → (α → β) → (α → γ)
+�������������������������
+UTF8-BOM:
+(∘) :: ∀ α β γ . (β → γ) → (α → β) → (α → γ)
+�������������������������
+True
+no encoding:
+c0    | À   �   Â   Ã   Ä   Å   Æ   Ç   È   É   Ê   Ë   Ì   �   Î   �
+d0    | �   Ñ   Ò   Ó   Ô   Õ   Ö   ×   Ø   Ù   Ú   Û   Ü   �   Þ   ß
+e0    | à   á   â   ã   ä   å   æ   ç   è   é   ê   ë   ì   í   î   ï
+f0    | ð   ñ   ò   ó   ô   õ   ö   ÷   ø   ù   ú   û   ü   ý   þ   ÿ
+UTF8:
+(∘) :: ∀ α β γ . (β → γ) → (α → β) → (α → γ)
+�������������������������
+UTF16LE:
+(∘) :: ∀ α β γ . (β → γ) → (α → β) → (α → γ)
+�������������������������
+UTF16BE:
+(∘) :: ∀ α β γ . (β → γ) → (α → β) → (α → γ)
+�������������������������
+UTF16:
+(∘) :: ∀ α β γ . (β → γ) → (α → β) → (α → γ)
+�������������������������
+UTF32:
+(∘) :: ∀ α β γ . (β → γ) → (α → β) → (α → γ)
+�������������������������
+UTF32LE:
+(∘) :: ∀ α β γ . (β → γ) → (α → β) → (α → γ)
+�������������������������
+UTF32BE:
+(∘) :: ∀ α β γ . (β → γ) → (α → β) → (α → γ)
+�������������������������
+UTF8-BOM:
+(∘) :: ∀ α β γ . (β → γ) → (α → β) → (α → γ)
+�������������������������
+True
diff --git a/libraries/base/tests/IO/hSetEncoding002.hs b/libraries/base/tests/IO/hSetEncoding002.hs
new file mode 100644
index 000000000000..35c4e1ce19d0
--- /dev/null
+++ b/libraries/base/tests/IO/hSetEncoding002.hs
@@ -0,0 +1,13 @@
+-- test for #4066
+
+import System.IO
+
+import GHC.IO.FD as FD (stdout)
+import GHC.IO.Handle.FD as FD (fdToHandle)
+import GHC.IO.Handle ( mkDuplexHandle )
+
+main = do
+  h <- mkDuplexHandle FD.stdout "stdout" Nothing noNewlineTranslation
+  hSetEncoding h utf8
+  hPutStrLn h "ö"
+  hClose h
diff --git a/libraries/base/tests/IO/hSetEncoding002.stdout b/libraries/base/tests/IO/hSetEncoding002.stdout
new file mode 100644
index 000000000000..d3b4b915a14a
--- /dev/null
+++ b/libraries/base/tests/IO/hSetEncoding002.stdout
@@ -0,0 +1 @@
+ö
diff --git a/libraries/base/tests/IO/ioeGetErrorString001.hs b/libraries/base/tests/IO/ioeGetErrorString001.hs
new file mode 100644
index 000000000000..361ae624374b
--- /dev/null
+++ b/libraries/base/tests/IO/ioeGetErrorString001.hs
@@ -0,0 +1,13 @@
+-- !!! test ioeGetErrorString
+
+import System.IO
+import System.IO.Error
+import Data.Maybe
+
+main = do
+  h <- openFile "ioeGetErrorString001.hs" ReadMode
+  hSeek h SeekFromEnd 0
+  (hGetChar h >> return ()) `catchIOError`
+	\e -> if isEOFError e
+		then print (ioeGetErrorString e)
+		else putStrLn "failed."
diff --git a/libraries/base/tests/IO/ioeGetErrorString001.stdout b/libraries/base/tests/IO/ioeGetErrorString001.stdout
new file mode 100644
index 000000000000..0b8daea55ae6
--- /dev/null
+++ b/libraries/base/tests/IO/ioeGetErrorString001.stdout
@@ -0,0 +1 @@
+"end of file"
diff --git a/libraries/base/tests/IO/ioeGetFileName001.hs b/libraries/base/tests/IO/ioeGetFileName001.hs
new file mode 100644
index 000000000000..410093f027b3
--- /dev/null
+++ b/libraries/base/tests/IO/ioeGetFileName001.hs
@@ -0,0 +1,12 @@
+-- !!! test ioeGetFileName
+
+import System.IO
+import System.IO.Error
+
+main = do
+  h <- openFile "ioeGetFileName001.hs" ReadMode
+  hSeek h SeekFromEnd 0
+  (hGetChar h >> return ()) `catchIOError`
+	\e -> if isEOFError e 
+		then print (ioeGetFileName e)
+		else putStrLn "failed."
diff --git a/libraries/base/tests/IO/ioeGetFileName001.stdout b/libraries/base/tests/IO/ioeGetFileName001.stdout
new file mode 100644
index 000000000000..7377ad409d12
--- /dev/null
+++ b/libraries/base/tests/IO/ioeGetFileName001.stdout
@@ -0,0 +1 @@
+Just "ioeGetFileName001.hs"
diff --git a/libraries/base/tests/IO/ioeGetHandle001.hs b/libraries/base/tests/IO/ioeGetHandle001.hs
new file mode 100644
index 000000000000..1f9c22e20dea
--- /dev/null
+++ b/libraries/base/tests/IO/ioeGetHandle001.hs
@@ -0,0 +1,13 @@
+-- !!! test ioeGetHandle
+
+import System.IO
+import System.IO.Error
+import Data.Maybe
+
+main = do
+  h <- openFile "ioeGetHandle001.hs" ReadMode
+  hSeek h SeekFromEnd 0
+  (hGetChar h >> return ()) `catchIOError`
+	\e -> if isEOFError e && fromJust (ioeGetHandle e) == h
+		then putStrLn "ok."
+		else putStrLn "failed."
diff --git a/libraries/base/tests/IO/ioeGetHandle001.stdout b/libraries/base/tests/IO/ioeGetHandle001.stdout
new file mode 100644
index 000000000000..90b5016eff5b
--- /dev/null
+++ b/libraries/base/tests/IO/ioeGetHandle001.stdout
@@ -0,0 +1 @@
+ok.
diff --git a/libraries/base/tests/IO/isEOF001.hs b/libraries/base/tests/IO/isEOF001.hs
new file mode 100644
index 000000000000..bb205703f85e
--- /dev/null
+++ b/libraries/base/tests/IO/isEOF001.hs
@@ -0,0 +1,3 @@
+import System.IO
+
+main = isEOF >>= print
diff --git a/libraries/base/tests/IO/isEOF001.stdout b/libraries/base/tests/IO/isEOF001.stdout
new file mode 100644
index 000000000000..0ca95142bb71
--- /dev/null
+++ b/libraries/base/tests/IO/isEOF001.stdout
@@ -0,0 +1 @@
+True
diff --git a/libraries/base/tests/IO/latin1 b/libraries/base/tests/IO/latin1
new file mode 100644
index 000000000000..a634257fbf7d
--- /dev/null
+++ b/libraries/base/tests/IO/latin1
@@ -0,0 +1,5 @@
+c0    | À   Á   Â   Ã   Ä   Å   Æ   Ç   È   É   Ê   Ë   Ì   Í   Î   Ï
+d0    | Ð   Ñ   Ò   Ó   Ô   Õ   Ö   ×   Ø   Ù   Ú   Û   Ü   Ý   Þ   ß
+e0    | à   á   â   ã   ä   å   æ   ç   è   é   ê   ë   ì   í   î   ï
+f0    | ð   ñ   ò   ó   ô   õ   ö   ÷   ø   ù   ú   û   ü   ý   þ   ÿ
+X
\ No newline at end of file
diff --git a/libraries/base/tests/IO/misc001.hs b/libraries/base/tests/IO/misc001.hs
new file mode 100644
index 000000000000..9f9f3e98d0a9
--- /dev/null
+++ b/libraries/base/tests/IO/misc001.hs
@@ -0,0 +1,24 @@
+import System.IO
+
+import Data.Char          (toUpper)
+import System.Directory   (removeFile, doesFileExist)
+import System.Environment (getArgs)
+
+main   =  do
+  [f1,f2] <- getArgs
+  h1 <- openFile f1 ReadMode
+  f <- doesFileExist f2
+  if f then removeFile f2 else return ()
+  h2 <- openFile f2 WriteMode
+  copyFile h1 h2
+  hClose h1
+  hClose h2
+
+copyFile h1 h2 = do
+  eof <- hIsEOF h1
+  if eof 
+	then return ()
+    	else do
+  c <- hGetChar h1
+  c <- hPutChar h2 (toUpper c)
+  copyFile h1 h2
diff --git a/libraries/base/tests/IO/misc001.stdout b/libraries/base/tests/IO/misc001.stdout
new file mode 100644
index 000000000000..e69de29bb2d1
diff --git a/libraries/base/tests/IO/newline001.hs b/libraries/base/tests/IO/newline001.hs
new file mode 100644
index 000000000000..b12a65bcaa87
--- /dev/null
+++ b/libraries/base/tests/IO/newline001.hs
@@ -0,0 +1,121 @@
+import System.IO
+import GHC.IO.Handle
+import Control.Monad
+import Data.List
+
+newlines = ["\n","\r","\r\n","\n\r","\n\n","\r\r"]
+
+-- make sure the file ends in '\r': that's a tricky case for CRLF
+-- conversion, because the IO library has to check whether there's a
+-- following \n before returning the \r.
+content = concat [ show i ++ t | (i,t) <- zip [1..100] (cycle newlines) ]
+
+filename = "newline001.out"
+
+fromCRLF [] = []
+fromCRLF ('\r':'\n':cs) = '\n' : fromCRLF cs
+fromCRLF (c:cs) = c : fromCRLF cs
+
+toCRLF [] = []
+toCRLF ('\n':cs) = '\r':'\n': toCRLF cs
+toCRLF (c:cs) = c : toCRLF cs
+
+main = do
+  h <- openBinaryFile filename WriteMode
+  hPutStr h content
+  hClose h
+  testinput NoBuffering
+  testinput LineBuffering
+  testinput (BlockBuffering Nothing)
+  testinput (BlockBuffering (Just 3))
+  testinput (BlockBuffering (Just 7))
+  testinput (BlockBuffering (Just 16))
+  testoutput NoBuffering
+  testoutput LineBuffering
+  testoutput (BlockBuffering Nothing)
+  testoutput (BlockBuffering (Just 3))
+  testoutput (BlockBuffering (Just 7))
+  testoutput (BlockBuffering (Just 16))
+
+testinput b = do
+  h <- openFile filename ReadMode
+  hSetBuffering h b
+  hSetNewlineMode h noNewlineTranslation
+  str <- hGetContents h
+  check "in1" b str content
+  hClose h
+
+  h <- openFile filename ReadMode
+  hSetBuffering h b
+  hSetNewlineMode h noNewlineTranslation
+  str <- read_chars h
+  check "in2" b str content
+  hClose h
+
+  h <- openFile filename ReadMode
+  hSetBuffering h b
+  hSetNewlineMode h noNewlineTranslation
+  str <- read_lines h
+  check "in3" b str content
+  hClose h
+
+  h <- openFile filename ReadMode
+  hSetBuffering h b
+  hSetNewlineMode h NewlineMode{ inputNL=CRLF, outputNL=LF }
+  str <- hGetContents h
+  check "in4" b str (fromCRLF content)
+  hClose h
+
+  h <- openFile filename ReadMode
+  hSetBuffering h b
+  hSetNewlineMode h NewlineMode{ inputNL=CRLF, outputNL=LF }
+  str <- read_chars  h
+  check "in5" b str (fromCRLF content)
+  hClose h
+
+  h <- openFile filename ReadMode
+  hSetBuffering h b
+  hSetNewlineMode h NewlineMode{ inputNL=CRLF, outputNL=LF }
+  str <- read_lines  h
+  check "in6" b str (fromCRLF content)
+  hClose h
+
+testoutput b = do
+  h <- openFile filename WriteMode
+  hSetBuffering h b
+  hSetNewlineMode h NewlineMode{ inputNL=LF, outputNL=CRLF }
+  hPutStr h content
+  hClose h
+  h <- openBinaryFile filename ReadMode
+  str <- hGetContents h
+  check "out1" b (toCRLF content) str
+  hClose h
+
+  h <- openFile filename WriteMode
+  hSetBuffering h b
+  hSetNewlineMode h NewlineMode{ inputNL=LF, outputNL=CRLF }
+  mapM_ (hPutChar h) content
+  hClose h
+  h <- openBinaryFile filename ReadMode
+  str <- hGetContents h
+  check "out2" b (toCRLF content) str
+  hClose h
+
+check s b str1 str2 = do
+  when (str1 /= str2) $ error ("failed: " ++ s ++ ", " ++ show b ++ '\n':show str1 ++ '\n':show str2)
+
+read_chars :: Handle -> IO String
+read_chars h = loop h ""
+  where loop h acc = do
+          b <- hIsEOF h
+          if b then return (reverse acc) else do
+          c <- hGetChar h
+          loop h (c:acc)
+
+read_lines :: Handle -> IO String
+read_lines h = loop h []
+  where loop h acc = do
+          b <- hIsEOF h
+          if b then return (intercalate "\n" (reverse acc)) else do
+          l <- hGetLine h
+          loop h (l : acc)
diff --git a/libraries/base/tests/IO/openFile001.hs b/libraries/base/tests/IO/openFile001.hs
new file mode 100644
index 000000000000..f34f093d38dc
--- /dev/null
+++ b/libraries/base/tests/IO/openFile001.hs
@@ -0,0 +1,11 @@
+-- !!! test that a file opened in ReadMode can't be written to
+
+import System.IO
+import System.IO.Error
+
+main = do
+  hIn <- openFile "openFile001.hs" ReadMode
+  hPutStr hIn "test" `catchIOError` \ err ->
+      if isIllegalOperation err 
+	then putStrLn "ok."
+	else error "Oh dear\n"
diff --git a/libraries/base/tests/IO/openFile001.stdout b/libraries/base/tests/IO/openFile001.stdout
new file mode 100644
index 000000000000..90b5016eff5b
--- /dev/null
+++ b/libraries/base/tests/IO/openFile001.stdout
@@ -0,0 +1 @@
+ok.
diff --git a/libraries/base/tests/IO/openFile002.hs b/libraries/base/tests/IO/openFile002.hs
new file mode 100644
index 000000000000..83822621f618
--- /dev/null
+++ b/libraries/base/tests/IO/openFile002.hs
@@ -0,0 +1,6 @@
+import Data.Char
+import System.IO
+
+-- !!! Open a non-existent file for reading (should fail)
+
+main = openFile "nonexistent" ReadMode
diff --git a/libraries/base/tests/IO/openFile002.stderr b/libraries/base/tests/IO/openFile002.stderr
new file mode 100644
index 000000000000..b011f34146a0
--- /dev/null
+++ b/libraries/base/tests/IO/openFile002.stderr
@@ -0,0 +1 @@
+openFile002: nonexistent: openFile: does not exist (No such file or directory)
diff --git a/libraries/base/tests/IO/openFile002.stderr-hugs b/libraries/base/tests/IO/openFile002.stderr-hugs
new file mode 100644
index 000000000000..aa76710e44a6
--- /dev/null
+++ b/libraries/base/tests/IO/openFile002.stderr-hugs
@@ -0,0 +1 @@
+openFile002: nonexistent: IO.openFile: does not exist (file does not exist)
diff --git a/libraries/base/tests/IO/openFile003.hs b/libraries/base/tests/IO/openFile003.hs
new file mode 100644
index 000000000000..f3c640f2956c
--- /dev/null
+++ b/libraries/base/tests/IO/openFile003.hs
@@ -0,0 +1,17 @@
+import System.Directory
+import System.IO
+import System.IO.Error
+
+-- !!! Open a directory (should fail)
+
+main = do
+  let dir = "openFile003Dir"
+  createDirectoryIfMissing False dir
+  r <- tryIOError (openFile dir ReadMode)
+  print r
+  r <- tryIOError (openFile dir WriteMode)
+  print r
+  r <- tryIOError (openFile dir AppendMode)
+  print r
+  r <- tryIOError (openFile dir ReadWriteMode)
+  print r
diff --git a/libraries/base/tests/IO/openFile003.stdout b/libraries/base/tests/IO/openFile003.stdout
new file mode 100644
index 000000000000..3621518cdbe5
--- /dev/null
+++ b/libraries/base/tests/IO/openFile003.stdout
@@ -0,0 +1,4 @@
+Left openFile003Dir: openFile: inappropriate type (is a directory)
+Left openFile003Dir: openFile: inappropriate type (Is a directory)
+Left openFile003Dir: openFile: inappropriate type (Is a directory)
+Left openFile003Dir: openFile: inappropriate type (Is a directory)
diff --git a/libraries/base/tests/IO/openFile003.stdout-mingw32 b/libraries/base/tests/IO/openFile003.stdout-mingw32
new file mode 100644
index 000000000000..bf99bcf80dda
--- /dev/null
+++ b/libraries/base/tests/IO/openFile003.stdout-mingw32
@@ -0,0 +1,4 @@
+Left openFile003Dir: openFile: permission denied (Permission denied)
+Left openFile003Dir: openFile: permission denied (Permission denied)
+Left openFile003Dir: openFile: permission denied (Permission denied)
+Left openFile003Dir: openFile: permission denied (Permission denied)
diff --git a/libraries/base/tests/IO/openFile003.stdout-mips-sgi-irix b/libraries/base/tests/IO/openFile003.stdout-mips-sgi-irix
new file mode 100644
index 000000000000..6a78a2a8917a
--- /dev/null
+++ b/libraries/base/tests/IO/openFile003.stdout-mips-sgi-irix
@@ -0,0 +1,4 @@
+Left openFile003Dir: openFile: inappropriate type (is a directory)
+Left openFile003Dir: openFile: invalid argument (Invalid argument)
+Left openFile003Dir: openFile: invalid argument (Invalid argument)
+Left openFile003Dir: openFile: invalid argument (Invalid argument)
diff --git a/libraries/base/tests/IO/openFile003.stdout-sparc-sun-solaris2 b/libraries/base/tests/IO/openFile003.stdout-sparc-sun-solaris2
new file mode 100644
index 000000000000..6a78a2a8917a
--- /dev/null
+++ b/libraries/base/tests/IO/openFile003.stdout-sparc-sun-solaris2
@@ -0,0 +1,4 @@
+Left openFile003Dir: openFile: inappropriate type (is a directory)
+Left openFile003Dir: openFile: invalid argument (Invalid argument)
+Left openFile003Dir: openFile: invalid argument (Invalid argument)
+Left openFile003Dir: openFile: invalid argument (Invalid argument)
diff --git a/libraries/base/tests/IO/openFile004.hs b/libraries/base/tests/IO/openFile004.hs
new file mode 100644
index 000000000000..4124abb0debe
--- /dev/null
+++ b/libraries/base/tests/IO/openFile004.hs
@@ -0,0 +1,23 @@
+-- !!! Open a non-existent file for writing
+
+import Control.Monad
+import Data.Char
+import System.Directory
+import System.IO
+
+file = "openFile004.out"
+
+main = do
+  b <- doesFileExist file
+  when b (removeFile file)
+
+  h <- openFile file WriteMode
+  hPutStr h "hello world\n"
+  hClose h
+
+  h <- openFile file ReadMode
+  let loop = do
+	b <- hIsEOF h 
+	if b then return () 
+	     else do c <- hGetChar h; putChar c; loop
+  loop
diff --git a/libraries/base/tests/IO/openFile004.stdout b/libraries/base/tests/IO/openFile004.stdout
new file mode 100644
index 000000000000..3b18e512dba7
--- /dev/null
+++ b/libraries/base/tests/IO/openFile004.stdout
@@ -0,0 +1 @@
+hello world
diff --git a/libraries/base/tests/IO/openFile005.hs b/libraries/base/tests/IO/openFile005.hs
new file mode 100644
index 000000000000..d8a8f8345331
--- /dev/null
+++ b/libraries/base/tests/IO/openFile005.hs
@@ -0,0 +1,45 @@
+-- !!! test multiple-reader single-writer locking semantics
+
+import System.IO
+import System.IO.Error
+
+file1 = "openFile005.out1"
+file2 = "openFile005.out2"
+
+main = do
+  putStrLn "two writes (should fail)"
+  h <- openFile file1 WriteMode
+  tryIOError (openFile file1 WriteMode) >>= print
+  hClose h
+
+  putStrLn "write and an append (should fail)"
+  h <- openFile file1 WriteMode
+  tryIOError (openFile file1 AppendMode) >>= print
+  hClose h
+
+  putStrLn "read/write and a write (should fail)"
+  h <- openFile file1 ReadWriteMode
+  tryIOError (openFile file1 WriteMode) >>= print
+  hClose h
+
+  putStrLn "read and a read/write (should fail)"
+  h <- openFile file1 ReadMode
+  tryIOError (openFile file1 ReadWriteMode) >>= print
+  hClose h
+
+  putStrLn "write and a read (should fail)"
+  h <- openFile file1 WriteMode
+  tryIOError (openFile file1 ReadMode) >>= print
+  hClose h
+
+  putStrLn "two writes, different files (silly, but should succeed)"
+  h1 <- openFile file1 WriteMode
+  h2 <- openFile file2 WriteMode
+  hClose h1
+  hClose h2
+
+  putStrLn "two reads, should succeed"
+  h1 <- openFile file1 ReadMode
+  h2 <- openFile file1 ReadMode
+  hClose h1
+  hClose h2
diff --git a/libraries/base/tests/IO/openFile005.stdout b/libraries/base/tests/IO/openFile005.stdout
new file mode 100644
index 000000000000..1a4b843be0a7
--- /dev/null
+++ b/libraries/base/tests/IO/openFile005.stdout
@@ -0,0 +1,12 @@
+two writes (should fail)
+Left openFile005.out1: openFile: resource busy (file is locked)
+write and an append (should fail)
+Left openFile005.out1: openFile: resource busy (file is locked)
+read/write and a write (should fail)
+Left openFile005.out1: openFile: resource busy (file is locked)
+read and a read/write (should fail)
+Left openFile005.out1: openFile: resource busy (file is locked)
+write and a read (should fail)
+Left openFile005.out1: openFile: resource busy (file is locked)
+two writes, different files (silly, but should succeed)
+two reads, should succeed
diff --git a/libraries/base/tests/IO/openFile006.hs b/libraries/base/tests/IO/openFile006.hs
new file mode 100644
index 000000000000..63cfea1a8767
--- /dev/null
+++ b/libraries/base/tests/IO/openFile006.hs
@@ -0,0 +1,14 @@
+-- !!! opening a file in WriteMode better truncate it
+
+import System.IO
+
+main = do
+  h <- openFile "openFile006.out" AppendMode
+  hPutStr h "hello, world"
+  size <- hFileSize h
+  print size
+  hClose h
+ 
+  h <- openFile "openFile006.out" WriteMode
+  size <- hFileSize h
+  print size
diff --git a/libraries/base/tests/IO/openFile006.stdout b/libraries/base/tests/IO/openFile006.stdout
new file mode 100644
index 000000000000..368283eb3dc6
--- /dev/null
+++ b/libraries/base/tests/IO/openFile006.stdout
@@ -0,0 +1,2 @@
+12
+0
diff --git a/libraries/base/tests/IO/openFile007.hs b/libraries/base/tests/IO/openFile007.hs
new file mode 100644
index 000000000000..e39ed6538f4e
--- /dev/null
+++ b/libraries/base/tests/IO/openFile007.hs
@@ -0,0 +1,18 @@
+-- !!! check that we don't truncate files if the open fails
+
+import Control.Monad
+import System.IO
+import System.IO.Error
+
+tmp = "openFile007.out"
+
+main = do
+  h <- openFile tmp WriteMode
+  hPutStrLn h "hello, world"
+
+  -- second open in write mode better fail, but better not truncate the file
+  tryIOError (openFile tmp WriteMode) >>= print
+  
+  hClose h
+  s <- readFile tmp -- make sure our "hello, world" is still there
+  putStr s
diff --git a/libraries/base/tests/IO/openFile007.stdout b/libraries/base/tests/IO/openFile007.stdout
new file mode 100644
index 000000000000..49669047fff9
--- /dev/null
+++ b/libraries/base/tests/IO/openFile007.stdout
@@ -0,0 +1,2 @@
+Left openFile007.out: openFile: resource busy (file is locked)
+hello, world
diff --git a/libraries/base/tests/IO/openFile008.hs b/libraries/base/tests/IO/openFile008.hs
new file mode 100644
index 000000000000..9c1a1c47f8a2
--- /dev/null
+++ b/libraries/base/tests/IO/openFile008.hs
@@ -0,0 +1,22 @@
+import System.IO
+import System.Cmd
+import System.FilePath
+import Text.Printf
+import System.Directory
+import Control.Monad
+
+testdir = "openFile008_testdir"
+
+-- Test repeated opening/closing of 1000 files.  This is useful for guaging
+-- the performance of open/close and file locking.
+main = do
+  system ("rm -rf " ++ testdir)
+  createDirectory testdir
+  let filenames = [testdir </> printf "file%03d" (n::Int) | n <- [1..1000]]
+
+  forM_ [1..50] $ \_ -> do
+    hs <- mapM (\f -> openFile f WriteMode) filenames
+    mapM_ hClose hs
+
+  mapM_ removeFile filenames
+  removeDirectory testdir
diff --git a/libraries/base/tests/IO/openTempFile001.hs b/libraries/base/tests/IO/openTempFile001.hs
new file mode 100644
index 000000000000..36598e6d5b93
--- /dev/null
+++ b/libraries/base/tests/IO/openTempFile001.hs
@@ -0,0 +1,13 @@
+module Main where
+
+import System.IO
+import Control.Exception
+import System.Directory
+
+main = bracket 
+          (openTempFile "." "test.txt")
+          (\(f,_) -> removeFile f)
+          (\(f,h) -> do hPutStrLn h $ "\xa9" -- Copyright symbol
+                        hClose h
+                        s <- readFile f
+                        if (s /= "\xa9\n") then error ("failed: " ++ s) else return ())
diff --git a/libraries/base/tests/IO/putStr001.hs b/libraries/base/tests/IO/putStr001.hs
new file mode 100644
index 000000000000..48b3add3f377
--- /dev/null
+++ b/libraries/base/tests/IO/putStr001.hs
@@ -0,0 +1,6 @@
+-- !!! Testing output on stdout
+
+-- stdout is buffered, so test if its buffer
+-- is flushed upon program termination.
+
+main = putStr "Hello, world\n"
diff --git a/libraries/base/tests/IO/putStr001.stdout b/libraries/base/tests/IO/putStr001.stdout
new file mode 100644
index 000000000000..a5c196677102
--- /dev/null
+++ b/libraries/base/tests/IO/putStr001.stdout
@@ -0,0 +1 @@
+Hello, world
diff --git a/libraries/base/tests/IO/readFile001.hs b/libraries/base/tests/IO/readFile001.hs
new file mode 100644
index 000000000000..e4a2b34cb70b
--- /dev/null
+++ b/libraries/base/tests/IO/readFile001.hs
@@ -0,0 +1,26 @@
+-- !!! readFile test
+
+import System.IO
+import System.IO.Error
+
+source   = "readFile001.hs"
+filename = "readFile001.out"
+
+main = do
+  s <- readFile source
+  h <- openFile filename WriteMode
+  hPutStrLn h s
+  hClose h
+  s <- readFile filename
+
+  -- This open should fail, because the readFile hasn't been forced
+  -- and the file is therefore still locked.
+  tryIOError (openFile filename WriteMode) >>= print
+
+  putStrLn s
+
+  -- should be able to open it for writing now, because we've forced the
+  -- whole file.
+  h <- openFile filename WriteMode
+
+  print h
diff --git a/libraries/base/tests/IO/readFile001.stdout b/libraries/base/tests/IO/readFile001.stdout
new file mode 100644
index 000000000000..cfb75708f925
--- /dev/null
+++ b/libraries/base/tests/IO/readFile001.stdout
@@ -0,0 +1,30 @@
+Left readFile001.out: openFile: resource busy (file is locked)
+-- !!! readFile test
+
+import System.IO
+import System.IO.Error
+
+source   = "readFile001.hs"
+filename = "readFile001.out"
+
+main = do
+  s <- readFile source
+  h <- openFile filename WriteMode
+  hPutStrLn h s
+  hClose h
+  s <- readFile filename
+
+  -- This open should fail, because the readFile hasn't been forced
+  -- and the file is therefore still locked.
+  tryIOError (openFile filename WriteMode) >>= print
+
+  putStrLn s
+
+  -- should be able to open it for writing now, because we've forced the
+  -- whole file.
+  h <- openFile filename WriteMode
+
+  print h
+
+
+{handle: readFile001.out}
diff --git a/libraries/base/tests/IO/readwrite001.hs b/libraries/base/tests/IO/readwrite001.hs
new file mode 100644
index 000000000000..4a94ef10eb08
--- /dev/null
+++ b/libraries/base/tests/IO/readwrite001.hs
@@ -0,0 +1,23 @@
+-- !!! RW files 
+
+module Main(main) where
+
+import System.IO
+import System.Directory ( removeFile, doesFileExist )
+import Control.Monad
+
+main = do
+  f <- doesFileExist "readwrite001.inout" 
+  when f (removeFile "readwrite001.inout")
+  hdl <- openFile "readwrite001.inout" ReadWriteMode
+  hSetBuffering hdl LineBuffering
+  hPutStr hdl "as"
+  hSeek hdl AbsoluteSeek 0
+  ch <- hGetChar hdl
+  print ch
+  hPutStr hdl "ase"
+  hSeek hdl AbsoluteSeek 0
+  putChar '\n'
+  ls <- hGetContents hdl
+  putStrLn ls
+
diff --git a/libraries/base/tests/IO/readwrite001.stdout b/libraries/base/tests/IO/readwrite001.stdout
new file mode 100644
index 000000000000..e33ba0613ded
--- /dev/null
+++ b/libraries/base/tests/IO/readwrite001.stdout
@@ -0,0 +1,3 @@
+'a'
+
+aase
diff --git a/libraries/base/tests/IO/readwrite002.hs b/libraries/base/tests/IO/readwrite002.hs
new file mode 100644
index 000000000000..4623f430a98b
--- /dev/null
+++ b/libraries/base/tests/IO/readwrite002.hs
@@ -0,0 +1,49 @@
+-- !!! Testing RW handles 
+
+import System.IO
+import System.IO.Error
+import System.Directory (removeFile, doesFileExist)
+import Control.Monad
+import System.Cmd
+
+-- This test is weird, full marks to whoever dreamt it up!
+
+main :: IO ()
+main = do
+   let username = "readwrite002.inout"
+   f <- doesFileExist username
+   when f (removeFile username)
+   cd <- openFile username ReadWriteMode
+
+   -- binary mode needed, otherwise newline translation gives
+   -- unpredictable results.
+   hSetBinaryMode cd True
+
+-- Leva buffering on to make things more interesting:
+--   hSetBuffering stdin NoBuffering
+--   hSetBuffering stdout NoBuffering
+--   hSetBuffering cd NoBuffering
+   hPutStr cd speakString
+   hSeek cd AbsoluteSeek 0
+   speak cd  `catchIOError` \ err -> if isEOFError err then putStrLn "\nCaught EOF" else ioError err
+   hSeek cd AbsoluteSeek 0
+   hSetBuffering cd LineBuffering
+   speak cd  `catchIOError` \ err -> if isEOFError err then putStrLn "\nCaught EOF" else ioError err
+   return ()
+   hSeek cd AbsoluteSeek 0
+   hSetBuffering cd (BlockBuffering Nothing)
+   speak cd  `catchIOError` \ err -> if isEOFError err then putStrLn "\nCaught EOF" else ioError err
+
+speakString = "##############################\n"
+
+speak cd = do
+     (do
+        ready <- hReady cd
+        if ready then 
+	   hGetChar cd >>= putChar
+	 else
+	   return ()
+        ready <- hReady stdin
+        if ready then (do { ch <- getChar; hPutChar cd ch})
+         else return ())
+     speak cd
diff --git a/libraries/base/tests/IO/readwrite002.stdout b/libraries/base/tests/IO/readwrite002.stdout
new file mode 100644
index 000000000000..9aed0284d702
--- /dev/null
+++ b/libraries/base/tests/IO/readwrite002.stdout
@@ -0,0 +1,9 @@
+###############
+
+Caught EOF
+###############
+
+Caught EOF
+###############
+
+Caught EOF
diff --git a/libraries/base/tests/IO/readwrite003.hs b/libraries/base/tests/IO/readwrite003.hs
new file mode 100644
index 000000000000..d7ee78d637db
--- /dev/null
+++ b/libraries/base/tests/IO/readwrite003.hs
@@ -0,0 +1,12 @@
+import System.IO
+
+file = "readwrite003.txt"
+
+main = do
+  writeFile file "ab\ncd\nef\ngh"
+  h <- openFile file ReadWriteMode
+  hGetLine h
+  hPutStrLn h "yz"
+  hClose h
+  h <- openBinaryFile file ReadMode
+  hGetContents h >>= putStr
diff --git a/libraries/base/tests/IO/readwrite003.stdout b/libraries/base/tests/IO/readwrite003.stdout
new file mode 100644
index 000000000000..6b4522804e93
--- /dev/null
+++ b/libraries/base/tests/IO/readwrite003.stdout
@@ -0,0 +1,4 @@
+ab
+yz
+ef
+gh
\ No newline at end of file
diff --git a/libraries/base/tests/IO/utf8-test b/libraries/base/tests/IO/utf8-test
new file mode 100644
index 000000000000..7d0f35a448d6
--- /dev/null
+++ b/libraries/base/tests/IO/utf8-test
@@ -0,0 +1,3 @@
+(∘) :: ∀ α β γ . (β → γ) → (α → β) → (α → γ)
+�������������������������
+X
\ No newline at end of file
diff --git a/libraries/base/tests/Makefile b/libraries/base/tests/Makefile
new file mode 100644
index 000000000000..6a0abcf1cf7f
--- /dev/null
+++ b/libraries/base/tests/Makefile
@@ -0,0 +1,7 @@
+# This Makefile runs the tests using GHC's testsuite framework.  It
+# assumes the package is part of a GHC build tree with the testsuite
+# installed in ../../../testsuite.
+
+TOP=../../../testsuite
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
diff --git a/libraries/base/tests/Memo1.lhs b/libraries/base/tests/Memo1.lhs
new file mode 100644
index 000000000000..b723480d4d63
--- /dev/null
+++ b/libraries/base/tests/Memo1.lhs
@@ -0,0 +1,141 @@
+% $Id: Memo.lhs,v 1.1 2005/12/16 10:46:05 simonmar Exp $
+%
+% (c) The GHC Team, 1999
+%
+% Hashing memo tables.
+
+\begin{code}
+{-# LANGUAGE CPP #-}
+
+module Memo1
+#ifndef __PARALLEL_HASKELL__
+	( memo  	-- :: (a -> b) -> a -> b
+	, memoSized 	-- :: Int -> (a -> b) -> a -> b
+ 	) 
+#endif
+	where
+
+#ifndef __PARALLEL_HASKELL__
+
+import System.Mem.StableName	( StableName, makeStableName, hashStableName )
+import System.Mem.Weak		( Weak, mkWeakPtr, mkWeak, deRefWeak, finalize )
+import Data.Array.IO		( IOArray, newArray, readArray, writeArray )
+import System.IO.Unsafe		( unsafePerformIO )
+import Control.Concurrent.MVar	( MVar, newMVar, putMVar, takeMVar )
+\end{code}
+
+-----------------------------------------------------------------------------
+Memo table representation.
+
+The representation is this: a fixed-size hash table where each bucket
+is a list of table entries, of the form (key,value).
+
+The key in this case is (StableName key), and we use hashStableName to
+hash it.
+
+It's important that we can garbage collect old entries in the table
+when the key is no longer reachable in the heap.  Hence the value part
+of each table entry is (Weak val), where the weak pointer "key" is the
+key for our memo table, and 'val' is the value of this memo table
+entry.  When the key becomes unreachable, a finalizer will fire and
+remove this entry from the hash bucket, and further attempts to
+dereference the weak pointer will return Nothing.  References from
+'val' to the key are ignored (see the semantics of weak pointers in
+the documentation).
+
+\begin{code}
+type MemoTable key val
+	= MVar (
+	    Int,	-- current table size
+	    IOArray Int [MemoEntry key val]   -- hash table
+	   )
+
+-- a memo table entry: compile with -funbox-strict-fields to eliminate
+-- the boxes around the StableName and Weak fields.
+data MemoEntry key val = MemoEntry !(StableName key) !(Weak val)
+\end{code}
+
+We use an MVar to the hash table, so that several threads may safely
+access it concurrently.  This includes the finalization threads that
+remove entries from the table.
+
+ToDo: Can efficiency be improved at all?
+
+\begin{code}
+memo :: (a -> b) -> a -> b
+memo f = memoSized default_table_size f
+
+default_table_size = 1001
+
+-- Our memo functions are *strict*.  Lazy memo functions tend to be
+-- less useful because it is less likely you'll get a memo table hit
+-- for a thunk.  This change was made to match Hugs's Memo
+-- implementation, and as the result of feedback from Conal Elliot
+-- <conal@microsoft.com>.
+
+memoSized :: Int -> (a -> b) -> a -> b
+memoSized size f = strict (lazyMemoSized size f)
+
+strict = ($!)
+
+lazyMemoSized :: Int -> (a -> b) -> a -> b
+lazyMemoSized size f =
+   let (table,weak) = unsafePerformIO (
+		do { tbl <- newArray (0,size) []
+		   ; mvar <- newMVar (size,tbl)
+		   ; weak <- mkWeakPtr mvar (Just (table_finalizer tbl size))
+		   ; return (mvar,weak)
+		   })
+   in  memo' f table weak
+
+table_finalizer :: IOArray Int [MemoEntry key val] -> Int -> IO ()
+table_finalizer table size = 
+   sequence_ [ finalizeBucket i | i <- [0..size] ]
+ where
+   finalizeBucket i = do
+      bucket <- readArray table i 
+      sequence_ [ finalize w | MemoEntry _ w <- bucket ]
+
+memo' :: (a -> b) -> MemoTable a b -> Weak (MemoTable a b) -> a -> b
+memo' f ref weak_ref = \k -> unsafePerformIO $ do
+   stable_key <- makeStableName k
+   (size, table) <- takeMVar ref
+   let hash_key = hashStableName stable_key `mod` size
+   bucket <- readArray table hash_key
+   lkp <- lookupSN stable_key bucket
+
+   case lkp of
+     Just result -> do
+	putMVar ref (size,table)
+	return result
+     Nothing -> do
+	let result = f k
+	weak <- mkWeak k result (Just (finalizer hash_key stable_key weak_ref))
+	writeArray table hash_key (MemoEntry stable_key weak : bucket)
+	putMVar ref (size,table)
+	return result
+
+finalizer :: Int -> StableName a -> Weak (MemoTable a b) -> IO ()
+finalizer hash_key stable_key weak_ref = 
+  do r <- deRefWeak weak_ref 
+     case r of
+	Nothing -> return ()
+	Just mvar -> do
+        	(size,table) <- takeMVar mvar
+		bucket <- readArray table hash_key
+		let new_bucket = [ e | e@(MemoEntry sn weak) <- bucket, 
+				       sn /= stable_key ]
+		writeArray table hash_key new_bucket
+		putMVar mvar (size,table)
+
+lookupSN :: StableName key -> [MemoEntry key val] -> IO (Maybe val)
+lookupSN sn [] = sn `seq` return Nothing -- make it strict in sn
+lookupSN sn (MemoEntry sn' weak : xs)
+   | sn == sn'  = do maybe_item <- deRefWeak weak
+		     case maybe_item of
+			Nothing -> error ("dead weak pair: " ++ 
+						show (hashStableName sn))
+			Just v  -> return (Just v)
+   | otherwise  = lookupSN sn xs
+#endif
+\end{code}
diff --git a/libraries/base/tests/Memo2.lhs b/libraries/base/tests/Memo2.lhs
new file mode 100644
index 000000000000..69f2992266ae
--- /dev/null
+++ b/libraries/base/tests/Memo2.lhs
@@ -0,0 +1,141 @@
+% $Id: Memo.lhs,v 1.1 2005/12/16 10:46:05 simonmar Exp $
+%
+% (c) The GHC Team, 1999
+%
+% Hashing memo tables.
+
+\begin{code}
+{-# LANGUAGE CPP #-}
+
+module Memo2
+#ifndef __PARALLEL_HASKELL__
+	( memo  	-- :: (a -> b) -> a -> b
+	, memoSized 	-- :: Int -> (a -> b) -> a -> b
+ 	) 
+#endif
+	where
+
+#ifndef __PARALLEL_HASKELL__
+
+import System.Mem.StableName	( StableName, makeStableName, hashStableName )
+import System.Mem.Weak		( Weak, mkWeakPtr, mkWeak, deRefWeak, finalize )
+import Data.Array.IO		( IOArray, newArray, readArray, writeArray )
+import System.IO.Unsafe		( unsafePerformIO )
+import Control.Concurrent.MVar	( MVar, newMVar, putMVar, takeMVar )
+\end{code}
+
+-----------------------------------------------------------------------------
+Memo table representation.
+
+The representation is this: a fixed-size hash table where each bucket
+is a list of table entries, of the form (key,value).
+
+The key in this case is (StableName key), and we use hashStableName to
+hash it.
+
+It's important that we can garbage collect old entries in the table
+when the key is no longer reachable in the heap.  Hence the value part
+of each table entry is (Weak val), where the weak pointer "key" is the
+key for our memo table, and 'val' is the value of this memo table
+entry.  When the key becomes unreachable, a finalizer will fire and
+remove this entry from the hash bucket, and further attempts to
+dereference the weak pointer will return Nothing.  References from
+'val' to the key are ignored (see the semantics of weak pointers in
+the documentation).
+
+\begin{code}
+type MemoTable key val
+	= MVar (
+	    Int,	-- current table size
+	    IOArray Int [MemoEntry key val]   -- hash table
+	   )
+
+-- a memo table entry: compile with -funbox-strict-fields to eliminate
+-- the boxes around the StableName and Weak fields.
+data MemoEntry key val = MemoEntry !(StableName key) !(Weak val)
+\end{code}
+
+We use an MVar to the hash table, so that several threads may safely
+access it concurrently.  This includes the finalization threads that
+remove entries from the table.
+
+ToDo: Can efficiency be improved at all?
+
+\begin{code}
+memo :: (a -> b) -> a -> b
+memo f = memoSized default_table_size f
+
+default_table_size = 1001
+
+-- Our memo functions are *strict*.  Lazy memo functions tend to be
+-- less useful because it is less likely you'll get a memo table hit
+-- for a thunk.  This change was made to match Hugs's Memo
+-- implementation, and as the result of feedback from Conal Elliot
+-- <conal@microsoft.com>.
+
+memoSized :: Int -> (a -> b) -> a -> b
+memoSized size f = strict (lazyMemoSized size f)
+
+strict = ($!)
+
+lazyMemoSized :: Int -> (a -> b) -> a -> b
+lazyMemoSized size f =
+   let (table,weak) = unsafePerformIO (
+		do { tbl <- newArray (0,size) []
+		   ; mvar <- newMVar (size,tbl)
+		   ; weak <- mkWeakPtr mvar (Just (table_finalizer tbl size))
+		   ; return (mvar,weak)
+		   })
+   in  memo' f table weak
+
+table_finalizer :: IOArray Int [MemoEntry key val] -> Int -> IO ()
+table_finalizer table size = 
+   sequence_ [ finalizeBucket i | i <- [0..size] ]
+ where
+   finalizeBucket i = do
+      bucket <- readArray table i 
+      sequence_ [ finalize w | MemoEntry _ w <- bucket ]
+
+memo' :: (a -> b) -> MemoTable a b -> Weak (MemoTable a b) -> a -> b
+memo' f ref weak_ref = \k -> unsafePerformIO $ do
+   stable_key <- makeStableName k
+   (size, table) <- takeMVar ref
+   let hash_key = hashStableName stable_key `mod` size
+   bucket <- readArray table hash_key
+   lkp <- lookupSN stable_key bucket
+
+   case lkp of
+     Just result -> do
+	putMVar ref (size,table)
+	return result
+     Nothing -> do
+	let result = f k
+	weak <- mkWeak k result (Just (finalizer hash_key stable_key weak_ref))
+	writeArray table hash_key (MemoEntry stable_key weak : bucket)
+	putMVar ref (size,table)
+	return result
+
+finalizer :: Int -> StableName a -> Weak (MemoTable a b) -> IO ()
+finalizer hash_key stable_key weak_ref = 
+  do r <- deRefWeak weak_ref 
+     case r of
+	Nothing -> return ()
+	Just mvar -> do
+        	(size,table) <- takeMVar mvar
+		bucket <- readArray table hash_key
+		let new_bucket = [ e | e@(MemoEntry sn weak) <- bucket, 
+				       sn /= stable_key ]
+		writeArray table hash_key new_bucket
+		putMVar mvar (size,table)
+
+lookupSN :: StableName key -> [MemoEntry key val] -> IO (Maybe val)
+lookupSN sn [] = sn `seq` return Nothing -- make it strict in sn
+lookupSN sn (MemoEntry sn' weak : xs)
+   | sn == sn'  = do maybe_item <- deRefWeak weak
+		     case maybe_item of
+			Nothing -> error ("dead weak pair: " ++ 
+						show (hashStableName sn))
+			Just v  -> return (Just v)
+   | otherwise  = lookupSN sn xs
+#endif
+\end{code}
diff --git a/libraries/base/tests/Numeric/Makefile b/libraries/base/tests/Numeric/Makefile
new file mode 100644
index 000000000000..4ca77510701c
--- /dev/null
+++ b/libraries/base/tests/Numeric/Makefile
@@ -0,0 +1,7 @@
+# This Makefile runs the tests using GHC's testsuite framework.  It
+# assumes the package is part of a GHC build tree with the testsuite
+# installed in ../../../testsuite.
+
+TOP=../../../../testsuite
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
diff --git a/libraries/base/tests/Numeric/all.T b/libraries/base/tests/Numeric/all.T
new file mode 100644
index 000000000000..36b2d6f0d662
--- /dev/null
+++ b/libraries/base/tests/Numeric/all.T
@@ -0,0 +1,21 @@
+test('num001', normal, compile_and_run, [''])
+test('num002', normal, compile_and_run, [''])
+test('num003', normal, compile_and_run, [''])
+test('num004', normal, compile_and_run, [''])
+test('num005', normal, compile_and_run, [''])
+test('num006', normal, compile_and_run, [''])
+test('num007', normal, compile_and_run, [''])
+test('num008', normal, compile_and_run, [''])
+test('num009', [ when(fast(), skip)
+               , when(platform('i386-apple-darwin'), expect_broken(2370))
+               , when(opsys('mingw32'), omit_ways(['ghci'])) ],
+               # We get different results at 1e20 on x86/Windows, so there is
+               # a special output file for that.  I (SDM) don't think these are
+               # serious, since the results for lower numbers are all fine.
+               # We also get another set of results for 1e02 with GHCi, so
+               # I'm skipping that way altogether.
+             compile_and_run, [''])
+test('num010',
+     when(platform('i386-apple-darwin'), expect_broken_for(7043, 'ghci')),
+     compile_and_run,
+     [''])
diff --git a/libraries/base/tests/Numeric/num001.hs b/libraries/base/tests/Numeric/num001.hs
new file mode 100644
index 000000000000..8a8c97a11b5a
--- /dev/null
+++ b/libraries/base/tests/Numeric/num001.hs
@@ -0,0 +1,6 @@
+module Main(main) where
+
+import Numeric
+import Data.Ratio
+
+main = print ((fromRat (132874 % 23849))::Double)
diff --git a/libraries/base/tests/Numeric/num001.stdout b/libraries/base/tests/Numeric/num001.stdout
new file mode 100644
index 000000000000..6d2f0c7a77ef
--- /dev/null
+++ b/libraries/base/tests/Numeric/num001.stdout
@@ -0,0 +1 @@
+5.571470501907837
diff --git a/libraries/base/tests/Numeric/num002.hs b/libraries/base/tests/Numeric/num002.hs
new file mode 100644
index 000000000000..887960753158
--- /dev/null
+++ b/libraries/base/tests/Numeric/num002.hs
@@ -0,0 +1,20 @@
+-- Testing showInt, lightly.
+
+module Main(main) where
+
+import Numeric
+
+showSignedInt :: Integral a => a -> String
+showSignedInt x = showSigned (showInt) 0 x ""
+
+main =
+  do
+   putStrLn (showInt (343023920121::Integer) [])
+   putStrLn (showInt (3430239::Int) [])
+   putStrLn (showInt (1212 :: Int) [])
+   putStrLn (showSignedInt (591125662431 `div` (517::Int)))
+   -- showInt just works over naturals, wrap it up inside
+   -- a use of Numeric.showSigned to show negative nums.
+   putStrLn (showSignedInt (-111::Int))
+   putStrLn (showInt (232189458241::Integer) [])
+
diff --git a/libraries/base/tests/Numeric/num002.stdout b/libraries/base/tests/Numeric/num002.stdout
new file mode 100644
index 000000000000..ce14dec313e2
--- /dev/null
+++ b/libraries/base/tests/Numeric/num002.stdout
@@ -0,0 +1,6 @@
+343023920121
+3430239
+1212
+-3055754
+-111
+232189458241
diff --git a/libraries/base/tests/Numeric/num002.stdout-alpha-dec-osf3 b/libraries/base/tests/Numeric/num002.stdout-alpha-dec-osf3
new file mode 100644
index 000000000000..b81876f76366
--- /dev/null
+++ b/libraries/base/tests/Numeric/num002.stdout-alpha-dec-osf3
@@ -0,0 +1,6 @@
+343023920121
+3430239
+1212
+1143376523
+-111
+232189458241
diff --git a/libraries/base/tests/Numeric/num002.stdout-mips-sgi-irix b/libraries/base/tests/Numeric/num002.stdout-mips-sgi-irix
new file mode 100644
index 000000000000..b81876f76366
--- /dev/null
+++ b/libraries/base/tests/Numeric/num002.stdout-mips-sgi-irix
@@ -0,0 +1,6 @@
+343023920121
+3430239
+1212
+1143376523
+-111
+232189458241
diff --git a/libraries/base/tests/Numeric/num002.stdout-ws-64 b/libraries/base/tests/Numeric/num002.stdout-ws-64
new file mode 100644
index 000000000000..b81876f76366
--- /dev/null
+++ b/libraries/base/tests/Numeric/num002.stdout-ws-64
@@ -0,0 +1,6 @@
+343023920121
+3430239
+1212
+1143376523
+-111
+232189458241
diff --git a/libraries/base/tests/Numeric/num002.stdout-x86_64-unknown-openbsd b/libraries/base/tests/Numeric/num002.stdout-x86_64-unknown-openbsd
new file mode 100644
index 000000000000..b81876f76366
--- /dev/null
+++ b/libraries/base/tests/Numeric/num002.stdout-x86_64-unknown-openbsd
@@ -0,0 +1,6 @@
+343023920121
+3430239
+1212
+1143376523
+-111
+232189458241
diff --git a/libraries/base/tests/Numeric/num003.hs b/libraries/base/tests/Numeric/num003.hs
new file mode 100644
index 000000000000..01ca4926a53e
--- /dev/null
+++ b/libraries/base/tests/Numeric/num003.hs
@@ -0,0 +1,20 @@
+-- Testing readInt, lightly.
+--
+module Main(main) where
+
+import Numeric
+import Data.Char
+
+main =
+  let
+   rd :: ReadS Integer
+   rd = readSigned (readInt 10 (isDigit) (digitToInt))
+  in
+  do
+   print (rd (show (343023920121::Integer)))
+   print (rd (show (3430239::Int)))
+   print (rd (show (1212 :: Int)))
+   print (rd (show (591125662431 `div` (517::Int))))
+   print (rd (show (-111::Int)))
+   print (rd (show (232189458241::Integer)))
+
diff --git a/libraries/base/tests/Numeric/num003.stdout b/libraries/base/tests/Numeric/num003.stdout
new file mode 100644
index 000000000000..1266b608b303
--- /dev/null
+++ b/libraries/base/tests/Numeric/num003.stdout
@@ -0,0 +1,6 @@
+[(343023920121,"")]
+[(3430239,"")]
+[(1212,"")]
+[(-3055754,"")]
+[(-111,"")]
+[(232189458241,"")]
diff --git a/libraries/base/tests/Numeric/num003.stdout-alpha-dec-osf3 b/libraries/base/tests/Numeric/num003.stdout-alpha-dec-osf3
new file mode 100644
index 000000000000..ae95d2aa0a74
--- /dev/null
+++ b/libraries/base/tests/Numeric/num003.stdout-alpha-dec-osf3
@@ -0,0 +1,6 @@
+[(343023920121,"")]
+[(3430239,"")]
+[(1212,"")]
+[(1143376523,"")]
+[(-111,"")]
+[(232189458241,"")]
diff --git a/libraries/base/tests/Numeric/num003.stdout-mips-sgi-irix b/libraries/base/tests/Numeric/num003.stdout-mips-sgi-irix
new file mode 100644
index 000000000000..ae95d2aa0a74
--- /dev/null
+++ b/libraries/base/tests/Numeric/num003.stdout-mips-sgi-irix
@@ -0,0 +1,6 @@
+[(343023920121,"")]
+[(3430239,"")]
+[(1212,"")]
+[(1143376523,"")]
+[(-111,"")]
+[(232189458241,"")]
diff --git a/libraries/base/tests/Numeric/num003.stdout-ws-64 b/libraries/base/tests/Numeric/num003.stdout-ws-64
new file mode 100644
index 000000000000..ae95d2aa0a74
--- /dev/null
+++ b/libraries/base/tests/Numeric/num003.stdout-ws-64
@@ -0,0 +1,6 @@
+[(343023920121,"")]
+[(3430239,"")]
+[(1212,"")]
+[(1143376523,"")]
+[(-111,"")]
+[(232189458241,"")]
diff --git a/libraries/base/tests/Numeric/num003.stdout-x86_64-unknown-openbsd b/libraries/base/tests/Numeric/num003.stdout-x86_64-unknown-openbsd
new file mode 100644
index 000000000000..ae95d2aa0a74
--- /dev/null
+++ b/libraries/base/tests/Numeric/num003.stdout-x86_64-unknown-openbsd
@@ -0,0 +1,6 @@
+[(343023920121,"")]
+[(3430239,"")]
+[(1212,"")]
+[(1143376523,"")]
+[(-111,"")]
+[(232189458241,"")]
diff --git a/libraries/base/tests/Numeric/num004.hs b/libraries/base/tests/Numeric/num004.hs
new file mode 100644
index 000000000000..815998819dea
--- /dev/null
+++ b/libraries/base/tests/Numeric/num004.hs
@@ -0,0 +1,20 @@
+-- Exercising Numeric.readSigned a bit
+--
+module Main(main) where
+
+import Numeric
+import Data.Char
+
+main =
+  let
+   rd :: ReadS Integer
+   rd = readSigned (readInt 10 (isDigit) (digitToInt))
+  in
+  do
+   print (rd (show (343023920121::Integer)))
+   print (rd (show (3430239::Int)))
+   print (rd (show (-0 :: Int)))
+   print (rd (show (591125662431 `div` (517::Int))))
+   print (rd (show (-111::Int)))
+   print (rd (show (232189458241::Integer)))
+
diff --git a/libraries/base/tests/Numeric/num004.stdout b/libraries/base/tests/Numeric/num004.stdout
new file mode 100644
index 000000000000..12610a153d31
--- /dev/null
+++ b/libraries/base/tests/Numeric/num004.stdout
@@ -0,0 +1,6 @@
+[(343023920121,"")]
+[(3430239,"")]
+[(0,"")]
+[(-3055754,"")]
+[(-111,"")]
+[(232189458241,"")]
diff --git a/libraries/base/tests/Numeric/num004.stdout-alpha-dec-osf3 b/libraries/base/tests/Numeric/num004.stdout-alpha-dec-osf3
new file mode 100644
index 000000000000..150f98e1ea4f
--- /dev/null
+++ b/libraries/base/tests/Numeric/num004.stdout-alpha-dec-osf3
@@ -0,0 +1,6 @@
+[(343023920121,"")]
+[(3430239,"")]
+[(0,"")]
+[(1143376523,"")]
+[(-111,"")]
+[(232189458241,"")]
diff --git a/libraries/base/tests/Numeric/num004.stdout-mips-sgi-irix b/libraries/base/tests/Numeric/num004.stdout-mips-sgi-irix
new file mode 100644
index 000000000000..150f98e1ea4f
--- /dev/null
+++ b/libraries/base/tests/Numeric/num004.stdout-mips-sgi-irix
@@ -0,0 +1,6 @@
+[(343023920121,"")]
+[(3430239,"")]
+[(0,"")]
+[(1143376523,"")]
+[(-111,"")]
+[(232189458241,"")]
diff --git a/libraries/base/tests/Numeric/num004.stdout-ws-64 b/libraries/base/tests/Numeric/num004.stdout-ws-64
new file mode 100644
index 000000000000..150f98e1ea4f
--- /dev/null
+++ b/libraries/base/tests/Numeric/num004.stdout-ws-64
@@ -0,0 +1,6 @@
+[(343023920121,"")]
+[(3430239,"")]
+[(0,"")]
+[(1143376523,"")]
+[(-111,"")]
+[(232189458241,"")]
diff --git a/libraries/base/tests/Numeric/num004.stdout-x86_64-unknown-openbsd b/libraries/base/tests/Numeric/num004.stdout-x86_64-unknown-openbsd
new file mode 100644
index 000000000000..150f98e1ea4f
--- /dev/null
+++ b/libraries/base/tests/Numeric/num004.stdout-x86_64-unknown-openbsd
@@ -0,0 +1,6 @@
+[(343023920121,"")]
+[(3430239,"")]
+[(0,"")]
+[(1143376523,"")]
+[(-111,"")]
+[(232189458241,"")]
diff --git a/libraries/base/tests/Numeric/num005.hs b/libraries/base/tests/Numeric/num005.hs
new file mode 100644
index 000000000000..49ed09243631
--- /dev/null
+++ b/libraries/base/tests/Numeric/num005.hs
@@ -0,0 +1,23 @@
+-- Exercising Numeric.readSigned a bit
+--
+module Main(main) where
+
+import Numeric
+
+main =
+  let
+   ls = ["3489348394032498320438240938403","0","-1","1","34323","2L","012","0x23","3243ab"]
+   present str f ls =
+    sequence (map (\ v -> putStr ('\n':str ++
+                                  ' ': v   ++
+                                  " = "    ++
+                                  (show (f v)))) ls)
+  in
+  do
+   present "(readDec::ReadS Integer)" (readDec::ReadS Integer) ls
+   present "(readDec::ReadS Int)"     (readDec::ReadS Int) ls
+   present "(readOct::ReadS Integer)" (readOct::ReadS Integer) ls
+   present "(readOct::ReadS Int)"     (readOct::ReadS Int) ls
+   present "(readHex::ReadS Integer)" (readHex::ReadS Integer) ls
+   present "(readHex::ReadS Int)"     (readHex::ReadS Int) ls
+   putStrLn ""
diff --git a/libraries/base/tests/Numeric/num005.stdout b/libraries/base/tests/Numeric/num005.stdout
new file mode 100644
index 000000000000..f6ba218eb870
--- /dev/null
+++ b/libraries/base/tests/Numeric/num005.stdout
@@ -0,0 +1,55 @@
+
+(readDec::ReadS Integer) 3489348394032498320438240938403 = [(3489348394032498320438240938403,"")]
+(readDec::ReadS Integer) 0 = [(0,"")]
+(readDec::ReadS Integer) -1 = []
+(readDec::ReadS Integer) 1 = [(1,"")]
+(readDec::ReadS Integer) 34323 = [(34323,"")]
+(readDec::ReadS Integer) 2L = [(2,"L")]
+(readDec::ReadS Integer) 012 = [(12,"")]
+(readDec::ReadS Integer) 0x23 = [(0,"x23")]
+(readDec::ReadS Integer) 3243ab = [(3243,"ab")]
+(readDec::ReadS Int) 3489348394032498320438240938403 = [(-1268053597,"")]
+(readDec::ReadS Int) 0 = [(0,"")]
+(readDec::ReadS Int) -1 = []
+(readDec::ReadS Int) 1 = [(1,"")]
+(readDec::ReadS Int) 34323 = [(34323,"")]
+(readDec::ReadS Int) 2L = [(2,"L")]
+(readDec::ReadS Int) 012 = [(12,"")]
+(readDec::ReadS Int) 0x23 = [(0,"x23")]
+(readDec::ReadS Int) 3243ab = [(3243,"ab")]
+(readOct::ReadS Integer) 3489348394032498320438240938403 = [(28,"89348394032498320438240938403")]
+(readOct::ReadS Integer) 0 = [(0,"")]
+(readOct::ReadS Integer) -1 = []
+(readOct::ReadS Integer) 1 = [(1,"")]
+(readOct::ReadS Integer) 34323 = [(14547,"")]
+(readOct::ReadS Integer) 2L = [(2,"L")]
+(readOct::ReadS Integer) 012 = [(10,"")]
+(readOct::ReadS Integer) 0x23 = [(0,"x23")]
+(readOct::ReadS Integer) 3243ab = [(1699,"ab")]
+(readOct::ReadS Int) 3489348394032498320438240938403 = [(28,"89348394032498320438240938403")]
+(readOct::ReadS Int) 0 = [(0,"")]
+(readOct::ReadS Int) -1 = []
+(readOct::ReadS Int) 1 = [(1,"")]
+(readOct::ReadS Int) 34323 = [(14547,"")]
+(readOct::ReadS Int) 2L = [(2,"L")]
+(readOct::ReadS Int) 012 = [(10,"")]
+(readOct::ReadS Int) 0x23 = [(0,"x23")]
+(readOct::ReadS Int) 3243ab = [(1699,"ab")]
+(readHex::ReadS Integer) 3489348394032498320438240938403 = [(4364516597526947317207336190131536899,"")]
+(readHex::ReadS Integer) 0 = [(0,"")]
+(readHex::ReadS Integer) -1 = []
+(readHex::ReadS Integer) 1 = [(1,"")]
+(readHex::ReadS Integer) 34323 = [(213795,"")]
+(readHex::ReadS Integer) 2L = [(2,"L")]
+(readHex::ReadS Integer) 012 = [(18,"")]
+(readHex::ReadS Integer) 0x23 = [(0,"x23")]
+(readHex::ReadS Integer) 3243ab = [(3294123,"")]
+(readHex::ReadS Int) 3489348394032498320438240938403 = [(1083409411,"")]
+(readHex::ReadS Int) 0 = [(0,"")]
+(readHex::ReadS Int) -1 = []
+(readHex::ReadS Int) 1 = [(1,"")]
+(readHex::ReadS Int) 34323 = [(213795,"")]
+(readHex::ReadS Int) 2L = [(2,"L")]
+(readHex::ReadS Int) 012 = [(18,"")]
+(readHex::ReadS Int) 0x23 = [(0,"x23")]
+(readHex::ReadS Int) 3243ab = [(3294123,"")]
diff --git a/libraries/base/tests/Numeric/num005.stdout-alpha-dec-osf3 b/libraries/base/tests/Numeric/num005.stdout-alpha-dec-osf3
new file mode 100644
index 000000000000..35678af82f60
--- /dev/null
+++ b/libraries/base/tests/Numeric/num005.stdout-alpha-dec-osf3
@@ -0,0 +1,55 @@
+
+(readDec::ReadS Integer) 3489348394032498320438240938403 = [(3489348394032498320438240938403,"")]
+(readDec::ReadS Integer) 0 = [(0,"")]
+(readDec::ReadS Integer) -1 = []
+(readDec::ReadS Integer) 1 = [(1,"")]
+(readDec::ReadS Integer) 34323 = [(34323,"")]
+(readDec::ReadS Integer) 2L = [(2,"L")]
+(readDec::ReadS Integer) 012 = [(12,"")]
+(readDec::ReadS Integer) 0x23 = [(0,"x23")]
+(readDec::ReadS Integer) 3243ab = [(3243,"ab")]
+(readDec::ReadS Int) 3489348394032498320438240938403 = [(8154046292665502115,"")]
+(readDec::ReadS Int) 0 = [(0,"")]
+(readDec::ReadS Int) -1 = []
+(readDec::ReadS Int) 1 = [(1,"")]
+(readDec::ReadS Int) 34323 = [(34323,"")]
+(readDec::ReadS Int) 2L = [(2,"L")]
+(readDec::ReadS Int) 012 = [(12,"")]
+(readDec::ReadS Int) 0x23 = [(0,"x23")]
+(readDec::ReadS Int) 3243ab = [(3243,"ab")]
+(readOct::ReadS Integer) 3489348394032498320438240938403 = [(28,"89348394032498320438240938403")]
+(readOct::ReadS Integer) 0 = [(0,"")]
+(readOct::ReadS Integer) -1 = []
+(readOct::ReadS Integer) 1 = [(1,"")]
+(readOct::ReadS Integer) 34323 = [(14547,"")]
+(readOct::ReadS Integer) 2L = [(2,"L")]
+(readOct::ReadS Integer) 012 = [(10,"")]
+(readOct::ReadS Integer) 0x23 = [(0,"x23")]
+(readOct::ReadS Integer) 3243ab = [(1699,"ab")]
+(readOct::ReadS Int) 3489348394032498320438240938403 = [(28,"89348394032498320438240938403")]
+(readOct::ReadS Int) 0 = [(0,"")]
+(readOct::ReadS Int) -1 = []
+(readOct::ReadS Int) 1 = [(1,"")]
+(readOct::ReadS Int) 34323 = [(14547,"")]
+(readOct::ReadS Int) 2L = [(2,"L")]
+(readOct::ReadS Int) 012 = [(10,"")]
+(readOct::ReadS Int) 0x23 = [(0,"x23")]
+(readOct::ReadS Int) 3243ab = [(1699,"ab")]
+(readHex::ReadS Integer) 3489348394032498320438240938403 = [(4364516597526947317207336190131536899,"")]
+(readHex::ReadS Integer) 0 = [(0,"")]
+(readHex::ReadS Integer) -1 = []
+(readHex::ReadS Integer) 1 = [(1,"")]
+(readHex::ReadS Integer) 34323 = [(213795,"")]
+(readHex::ReadS Integer) 2L = [(2,"L")]
+(readHex::ReadS Integer) 012 = [(18,"")]
+(readHex::ReadS Integer) 0x23 = [(0,"x23")]
+(readHex::ReadS Integer) 3243ab = [(3294123,"")]
+(readHex::ReadS Int) 3489348394032498320438240938403 = [(-8998117828778032125,"")]
+(readHex::ReadS Int) 0 = [(0,"")]
+(readHex::ReadS Int) -1 = []
+(readHex::ReadS Int) 1 = [(1,"")]
+(readHex::ReadS Int) 34323 = [(213795,"")]
+(readHex::ReadS Int) 2L = [(2,"L")]
+(readHex::ReadS Int) 012 = [(18,"")]
+(readHex::ReadS Int) 0x23 = [(0,"x23")]
+(readHex::ReadS Int) 3243ab = [(3294123,"")]
diff --git a/libraries/base/tests/Numeric/num005.stdout-mips-sgi-irix b/libraries/base/tests/Numeric/num005.stdout-mips-sgi-irix
new file mode 100644
index 000000000000..35678af82f60
--- /dev/null
+++ b/libraries/base/tests/Numeric/num005.stdout-mips-sgi-irix
@@ -0,0 +1,55 @@
+
+(readDec::ReadS Integer) 3489348394032498320438240938403 = [(3489348394032498320438240938403,"")]
+(readDec::ReadS Integer) 0 = [(0,"")]
+(readDec::ReadS Integer) -1 = []
+(readDec::ReadS Integer) 1 = [(1,"")]
+(readDec::ReadS Integer) 34323 = [(34323,"")]
+(readDec::ReadS Integer) 2L = [(2,"L")]
+(readDec::ReadS Integer) 012 = [(12,"")]
+(readDec::ReadS Integer) 0x23 = [(0,"x23")]
+(readDec::ReadS Integer) 3243ab = [(3243,"ab")]
+(readDec::ReadS Int) 3489348394032498320438240938403 = [(8154046292665502115,"")]
+(readDec::ReadS Int) 0 = [(0,"")]
+(readDec::ReadS Int) -1 = []
+(readDec::ReadS Int) 1 = [(1,"")]
+(readDec::ReadS Int) 34323 = [(34323,"")]
+(readDec::ReadS Int) 2L = [(2,"L")]
+(readDec::ReadS Int) 012 = [(12,"")]
+(readDec::ReadS Int) 0x23 = [(0,"x23")]
+(readDec::ReadS Int) 3243ab = [(3243,"ab")]
+(readOct::ReadS Integer) 3489348394032498320438240938403 = [(28,"89348394032498320438240938403")]
+(readOct::ReadS Integer) 0 = [(0,"")]
+(readOct::ReadS Integer) -1 = []
+(readOct::ReadS Integer) 1 = [(1,"")]
+(readOct::ReadS Integer) 34323 = [(14547,"")]
+(readOct::ReadS Integer) 2L = [(2,"L")]
+(readOct::ReadS Integer) 012 = [(10,"")]
+(readOct::ReadS Integer) 0x23 = [(0,"x23")]
+(readOct::ReadS Integer) 3243ab = [(1699,"ab")]
+(readOct::ReadS Int) 3489348394032498320438240938403 = [(28,"89348394032498320438240938403")]
+(readOct::ReadS Int) 0 = [(0,"")]
+(readOct::ReadS Int) -1 = []
+(readOct::ReadS Int) 1 = [(1,"")]
+(readOct::ReadS Int) 34323 = [(14547,"")]
+(readOct::ReadS Int) 2L = [(2,"L")]
+(readOct::ReadS Int) 012 = [(10,"")]
+(readOct::ReadS Int) 0x23 = [(0,"x23")]
+(readOct::ReadS Int) 3243ab = [(1699,"ab")]
+(readHex::ReadS Integer) 3489348394032498320438240938403 = [(4364516597526947317207336190131536899,"")]
+(readHex::ReadS Integer) 0 = [(0,"")]
+(readHex::ReadS Integer) -1 = []
+(readHex::ReadS Integer) 1 = [(1,"")]
+(readHex::ReadS Integer) 34323 = [(213795,"")]
+(readHex::ReadS Integer) 2L = [(2,"L")]
+(readHex::ReadS Integer) 012 = [(18,"")]
+(readHex::ReadS Integer) 0x23 = [(0,"x23")]
+(readHex::ReadS Integer) 3243ab = [(3294123,"")]
+(readHex::ReadS Int) 3489348394032498320438240938403 = [(-8998117828778032125,"")]
+(readHex::ReadS Int) 0 = [(0,"")]
+(readHex::ReadS Int) -1 = []
+(readHex::ReadS Int) 1 = [(1,"")]
+(readHex::ReadS Int) 34323 = [(213795,"")]
+(readHex::ReadS Int) 2L = [(2,"L")]
+(readHex::ReadS Int) 012 = [(18,"")]
+(readHex::ReadS Int) 0x23 = [(0,"x23")]
+(readHex::ReadS Int) 3243ab = [(3294123,"")]
diff --git a/libraries/base/tests/Numeric/num005.stdout-ws-64 b/libraries/base/tests/Numeric/num005.stdout-ws-64
new file mode 100644
index 000000000000..35678af82f60
--- /dev/null
+++ b/libraries/base/tests/Numeric/num005.stdout-ws-64
@@ -0,0 +1,55 @@
+
+(readDec::ReadS Integer) 3489348394032498320438240938403 = [(3489348394032498320438240938403,"")]
+(readDec::ReadS Integer) 0 = [(0,"")]
+(readDec::ReadS Integer) -1 = []
+(readDec::ReadS Integer) 1 = [(1,"")]
+(readDec::ReadS Integer) 34323 = [(34323,"")]
+(readDec::ReadS Integer) 2L = [(2,"L")]
+(readDec::ReadS Integer) 012 = [(12,"")]
+(readDec::ReadS Integer) 0x23 = [(0,"x23")]
+(readDec::ReadS Integer) 3243ab = [(3243,"ab")]
+(readDec::ReadS Int) 3489348394032498320438240938403 = [(8154046292665502115,"")]
+(readDec::ReadS Int) 0 = [(0,"")]
+(readDec::ReadS Int) -1 = []
+(readDec::ReadS Int) 1 = [(1,"")]
+(readDec::ReadS Int) 34323 = [(34323,"")]
+(readDec::ReadS Int) 2L = [(2,"L")]
+(readDec::ReadS Int) 012 = [(12,"")]
+(readDec::ReadS Int) 0x23 = [(0,"x23")]
+(readDec::ReadS Int) 3243ab = [(3243,"ab")]
+(readOct::ReadS Integer) 3489348394032498320438240938403 = [(28,"89348394032498320438240938403")]
+(readOct::ReadS Integer) 0 = [(0,"")]
+(readOct::ReadS Integer) -1 = []
+(readOct::ReadS Integer) 1 = [(1,"")]
+(readOct::ReadS Integer) 34323 = [(14547,"")]
+(readOct::ReadS Integer) 2L = [(2,"L")]
+(readOct::ReadS Integer) 012 = [(10,"")]
+(readOct::ReadS Integer) 0x23 = [(0,"x23")]
+(readOct::ReadS Integer) 3243ab = [(1699,"ab")]
+(readOct::ReadS Int) 3489348394032498320438240938403 = [(28,"89348394032498320438240938403")]
+(readOct::ReadS Int) 0 = [(0,"")]
+(readOct::ReadS Int) -1 = []
+(readOct::ReadS Int) 1 = [(1,"")]
+(readOct::ReadS Int) 34323 = [(14547,"")]
+(readOct::ReadS Int) 2L = [(2,"L")]
+(readOct::ReadS Int) 012 = [(10,"")]
+(readOct::ReadS Int) 0x23 = [(0,"x23")]
+(readOct::ReadS Int) 3243ab = [(1699,"ab")]
+(readHex::ReadS Integer) 3489348394032498320438240938403 = [(4364516597526947317207336190131536899,"")]
+(readHex::ReadS Integer) 0 = [(0,"")]
+(readHex::ReadS Integer) -1 = []
+(readHex::ReadS Integer) 1 = [(1,"")]
+(readHex::ReadS Integer) 34323 = [(213795,"")]
+(readHex::ReadS Integer) 2L = [(2,"L")]
+(readHex::ReadS Integer) 012 = [(18,"")]
+(readHex::ReadS Integer) 0x23 = [(0,"x23")]
+(readHex::ReadS Integer) 3243ab = [(3294123,"")]
+(readHex::ReadS Int) 3489348394032498320438240938403 = [(-8998117828778032125,"")]
+(readHex::ReadS Int) 0 = [(0,"")]
+(readHex::ReadS Int) -1 = []
+(readHex::ReadS Int) 1 = [(1,"")]
+(readHex::ReadS Int) 34323 = [(213795,"")]
+(readHex::ReadS Int) 2L = [(2,"L")]
+(readHex::ReadS Int) 012 = [(18,"")]
+(readHex::ReadS Int) 0x23 = [(0,"x23")]
+(readHex::ReadS Int) 3243ab = [(3294123,"")]
diff --git a/libraries/base/tests/Numeric/num005.stdout-x86_64-unknown-openbsd b/libraries/base/tests/Numeric/num005.stdout-x86_64-unknown-openbsd
new file mode 100644
index 000000000000..35678af82f60
--- /dev/null
+++ b/libraries/base/tests/Numeric/num005.stdout-x86_64-unknown-openbsd
@@ -0,0 +1,55 @@
+
+(readDec::ReadS Integer) 3489348394032498320438240938403 = [(3489348394032498320438240938403,"")]
+(readDec::ReadS Integer) 0 = [(0,"")]
+(readDec::ReadS Integer) -1 = []
+(readDec::ReadS Integer) 1 = [(1,"")]
+(readDec::ReadS Integer) 34323 = [(34323,"")]
+(readDec::ReadS Integer) 2L = [(2,"L")]
+(readDec::ReadS Integer) 012 = [(12,"")]
+(readDec::ReadS Integer) 0x23 = [(0,"x23")]
+(readDec::ReadS Integer) 3243ab = [(3243,"ab")]
+(readDec::ReadS Int) 3489348394032498320438240938403 = [(8154046292665502115,"")]
+(readDec::ReadS Int) 0 = [(0,"")]
+(readDec::ReadS Int) -1 = []
+(readDec::ReadS Int) 1 = [(1,"")]
+(readDec::ReadS Int) 34323 = [(34323,"")]
+(readDec::ReadS Int) 2L = [(2,"L")]
+(readDec::ReadS Int) 012 = [(12,"")]
+(readDec::ReadS Int) 0x23 = [(0,"x23")]
+(readDec::ReadS Int) 3243ab = [(3243,"ab")]
+(readOct::ReadS Integer) 3489348394032498320438240938403 = [(28,"89348394032498320438240938403")]
+(readOct::ReadS Integer) 0 = [(0,"")]
+(readOct::ReadS Integer) -1 = []
+(readOct::ReadS Integer) 1 = [(1,"")]
+(readOct::ReadS Integer) 34323 = [(14547,"")]
+(readOct::ReadS Integer) 2L = [(2,"L")]
+(readOct::ReadS Integer) 012 = [(10,"")]
+(readOct::ReadS Integer) 0x23 = [(0,"x23")]
+(readOct::ReadS Integer) 3243ab = [(1699,"ab")]
+(readOct::ReadS Int) 3489348394032498320438240938403 = [(28,"89348394032498320438240938403")]
+(readOct::ReadS Int) 0 = [(0,"")]
+(readOct::ReadS Int) -1 = []
+(readOct::ReadS Int) 1 = [(1,"")]
+(readOct::ReadS Int) 34323 = [(14547,"")]
+(readOct::ReadS Int) 2L = [(2,"L")]
+(readOct::ReadS Int) 012 = [(10,"")]
+(readOct::ReadS Int) 0x23 = [(0,"x23")]
+(readOct::ReadS Int) 3243ab = [(1699,"ab")]
+(readHex::ReadS Integer) 3489348394032498320438240938403 = [(4364516597526947317207336190131536899,"")]
+(readHex::ReadS Integer) 0 = [(0,"")]
+(readHex::ReadS Integer) -1 = []
+(readHex::ReadS Integer) 1 = [(1,"")]
+(readHex::ReadS Integer) 34323 = [(213795,"")]
+(readHex::ReadS Integer) 2L = [(2,"L")]
+(readHex::ReadS Integer) 012 = [(18,"")]
+(readHex::ReadS Integer) 0x23 = [(0,"x23")]
+(readHex::ReadS Integer) 3243ab = [(3294123,"")]
+(readHex::ReadS Int) 3489348394032498320438240938403 = [(-8998117828778032125,"")]
+(readHex::ReadS Int) 0 = [(0,"")]
+(readHex::ReadS Int) -1 = []
+(readHex::ReadS Int) 1 = [(1,"")]
+(readHex::ReadS Int) 34323 = [(213795,"")]
+(readHex::ReadS Int) 2L = [(2,"L")]
+(readHex::ReadS Int) 012 = [(18,"")]
+(readHex::ReadS Int) 0x23 = [(0,"x23")]
+(readHex::ReadS Int) 3243ab = [(3294123,"")]
diff --git a/libraries/base/tests/Numeric/num006.hs b/libraries/base/tests/Numeric/num006.hs
new file mode 100644
index 000000000000..65347dd8aaa0
--- /dev/null
+++ b/libraries/base/tests/Numeric/num006.hs
@@ -0,0 +1,28 @@
+-- Exercising the showing of positive numbers at various bases.
+--
+module Main(main) where
+
+import Numeric
+import Data.Char
+
+--showDec :: Integral a => a -> ShowS
+showDec = showInt
+
+{-
+--showBinary :: Integral a => a -> ShowS
+showBinary n r =
+ showString "0b" $
+ showIntAtBase 2 (toChr) n r
+ where toChr d = chr (ord '0' + fromIntegral d)
+-}
+
+main =
+ do
+  print (map (\ x -> showOct x []) [1..32])
+  print (map (\ x -> showDec x []) [1..32])
+  print (map (\ x -> showHex x []) [1..32])
+--  print (map (\ x -> showBinary x []) [1..32])
+  putStrLn (showOct (241324784::Int) [])
+  putStrLn (showDec (241324784::Int) [])
+  putStrLn (showHex (241324784::Int) [])
+---  putStrLn (showBinary (241324784::Int) [])
diff --git a/libraries/base/tests/Numeric/num006.stdout b/libraries/base/tests/Numeric/num006.stdout
new file mode 100644
index 000000000000..e0c45403ec5a
--- /dev/null
+++ b/libraries/base/tests/Numeric/num006.stdout
@@ -0,0 +1,6 @@
+["1","2","3","4","5","6","7","10","11","12","13","14","15","16","17","20","21","22","23","24","25","26","27","30","31","32","33","34","35","36","37","40"]
+["1","2","3","4","5","6","7","8","9","10","11","12","13","14","15","16","17","18","19","20","21","22","23","24","25","26","27","28","29","30","31","32"]
+["1","2","3","4","5","6","7","8","9","a","b","c","d","e","f","10","11","12","13","14","15","16","17","18","19","1a","1b","1c","1d","1e","1f","20"]
+1630451360
+241324784
+e6252f0
diff --git a/libraries/base/tests/Numeric/num007.hs b/libraries/base/tests/Numeric/num007.hs
new file mode 100644
index 000000000000..e02bd41d6453
--- /dev/null
+++ b/libraries/base/tests/Numeric/num007.hs
@@ -0,0 +1,17 @@
+-- Exercising the reading of positive numbers at various bases.
+--
+module Main(main) where
+
+import Numeric
+
+main =
+ do
+  putStrLn (show (readOct "00000111"))
+  putStrLn (show (readDec "00000111"))
+  putStrLn (show (readHex "00000111"))
+  putStrLn (show (readOct "-24"))
+  putStrLn (show (readDec "-24"))
+  putStrLn (show (readHex "-24"))
+  putStrLn (show ((readOct ::ReadS Integer) "3248784372843778438743"))
+  putStrLn (show ((readDec ::ReadS Integer) "3248784372843778438743"))
+  putStrLn (show ((readHex ::ReadS Integer) "3248784372843778438743"))
diff --git a/libraries/base/tests/Numeric/num007.stdout b/libraries/base/tests/Numeric/num007.stdout
new file mode 100644
index 000000000000..ef600218278e
--- /dev/null
+++ b/libraries/base/tests/Numeric/num007.stdout
@@ -0,0 +1,9 @@
+[(73,"")]
+[(111,"")]
+[(273,"")]
+[]
+[]
+[]
+[(212,"8784372843778438743")]
+[(3248784372843778438743,"")]
+[(60788519836879239998834499,"")]
diff --git a/libraries/base/tests/Numeric/num008.hs b/libraries/base/tests/Numeric/num008.hs
new file mode 100644
index 000000000000..fa081321e041
--- /dev/null
+++ b/libraries/base/tests/Numeric/num008.hs
@@ -0,0 +1,57 @@
+-- showing/reading floats
+--
+module Main(main) where
+
+import Numeric
+
+main = do
+  let dbls   =  map (shEFloat (Just 7)) doubles
+             ++ map (shEFloat (Just 0)) doubles
+             ++ map (shEFloat Nothing)  doubles
+             ++ map (shFFloat (Just 7)) doubles
+             ++ map (shFFloat (Just 0)) doubles
+             ++ map (shFFloat Nothing)  doubles
+             ++ map (shGFloat (Just 7)) doubles
+             ++ map (shGFloat (Just 0)) doubles
+             ++ map (shGFloat Nothing)  doubles
+
+      flts   =  map (shEFloat (Just 7)) floats
+             ++ map (shEFloat (Just 0)) floats
+             ++ map (shEFloat Nothing)  floats
+             ++ map (shFFloat (Just 7)) floats
+             ++ map (shFFloat (Just 0)) floats
+             ++ map (shFFloat Nothing)  floats
+             ++ map (shGFloat (Just 7)) floats
+             ++ map (shGFloat (Just 0)) floats
+             ++ map (shGFloat Nothing)  floats
+
+  putStrLn (unlines dbls)
+  putStrLn (unlines flts)
+  print (map read dbls :: [Double])
+  print (map read flts :: [Double])
+
+shEFloat p f = showEFloat p f ""
+shFFloat p f = showFFloat p f ""
+shGFloat p f = showGFloat p f ""
+
+doubles :: [ Double ]
+doubles = [ 0.0
+          , 420
+          ,  42
+          ,   4.2
+          ,   0.42
+          ,   0.042
+          , 1.82173691287639817263897126389712638972163
+          , 1.82173691287639817263897126389712638972163e-300
+          ]
+
+floats :: [ Float ]
+floats = [ 0.0
+          , 420
+          ,  42
+          ,   4.2
+          ,   0.42
+          ,   0.042
+          , 1.82173691287639817263897126389712638972163
+          , 1.82173691287639817263897126389712638972163e-300
+          ]
diff --git a/libraries/base/tests/Numeric/num008.stdout b/libraries/base/tests/Numeric/num008.stdout
new file mode 100644
index 000000000000..5086442f0f7f
--- /dev/null
+++ b/libraries/base/tests/Numeric/num008.stdout
@@ -0,0 +1,148 @@
+0.0000000e0
+4.2000000e2
+4.2000000e1
+4.2000000e0
+4.2000000e-1
+4.2000000e-2
+1.8217369e0
+1.8217369e-300
+0.0e0
+4.2e2
+4.2e1
+4.2e0
+4.2e-1
+4.2e-2
+1.8e0
+1.8e-300
+0.0e0
+4.2e2
+4.2e1
+4.2e0
+4.2e-1
+4.2e-2
+1.8217369128763983e0
+1.821736912876398e-300
+0.0000000
+420.0000000
+42.0000000
+4.2000000
+0.4200000
+0.0420000
+1.8217369
+0.0000000
+0
+420
+42
+4
+0
+0
+2
+0
+0.0
+420.0
+42.0
+4.2
+0.42
+0.042
+1.8217369128763983
+0.000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001821736912876398
+0.0000000
+420.0000000
+42.0000000
+4.2000000
+0.4200000
+4.2000000e-2
+1.8217369
+1.8217369e-300
+0
+420
+42
+4
+0
+4.2e-2
+2
+1.8e-300
+0.0
+420.0
+42.0
+4.2
+0.42
+4.2e-2
+1.8217369128763983
+1.821736912876398e-300
+
+0.0000000e0
+4.2000000e2
+4.2000000e1
+4.2000000e0
+4.2000000e-1
+4.2000000e-2
+1.8217369e0
+0.0000000e0
+0.0e0
+4.2e2
+4.2e1
+4.2e0
+4.2e-1
+4.2e-2
+1.8e0
+0.0e0
+0.0e0
+4.2e2
+4.2e1
+4.2e0
+4.2e-1
+4.2e-2
+1.8217369e0
+0.0e0
+0.0000000
+420.0000000
+42.0000000
+4.2000000
+0.4200000
+0.0420000
+1.8217369
+0.0000000
+0
+420
+42
+4
+0
+0
+2
+0
+0.0
+420.0
+42.0
+4.2
+0.42
+0.042
+1.8217369
+0.0
+0.0000000
+420.0000000
+42.0000000
+4.2000000
+0.4200000
+4.2000000e-2
+1.8217369
+0.0000000
+0
+420
+42
+4
+0
+4.2e-2
+2
+0
+0.0
+420.0
+42.0
+4.2
+0.42
+4.2e-2
+1.8217369
+0.0
+
+[0.0,420.0,42.0,4.2,0.42,4.2e-2,1.8217369,1.8217369e-300,0.0,420.0,42.0,4.2,0.42,4.2e-2,1.8,1.8e-300,0.0,420.0,42.0,4.2,0.42,4.2e-2,1.8217369128763983,1.821736912876398e-300,0.0,420.0,42.0,4.2,0.42,4.2e-2,1.8217369,0.0,0.0,420.0,42.0,4.0,0.0,0.0,2.0,0.0,0.0,420.0,42.0,4.2,0.42,4.2e-2,1.8217369128763983,1.821736912876398e-300,0.0,420.0,42.0,4.2,0.42,4.2e-2,1.8217369,1.8217369e-300,0.0,420.0,42.0,4.0,0.0,4.2e-2,2.0,1.8e-300,0.0,420.0,42.0,4.2,0.42,4.2e-2,1.8217369128763983,1.821736912876398e-300]
+[0.0,420.0,42.0,4.2,0.42,4.2e-2,1.8217369,0.0,0.0,420.0,42.0,4.2,0.42,4.2e-2,1.8,0.0,0.0,420.0,42.0,4.2,0.42,4.2e-2,1.8217369,0.0,0.0,420.0,42.0,4.2,0.42,4.2e-2,1.8217369,0.0,0.0,420.0,42.0,4.0,0.0,0.0,2.0,0.0,0.0,420.0,42.0,4.2,0.42,4.2e-2,1.8217369,0.0,0.0,420.0,42.0,4.2,0.42,4.2e-2,1.8217369,0.0,0.0,420.0,42.0,4.0,0.0,4.2e-2,2.0,0.0,0.0,420.0,42.0,4.2,0.42,4.2e-2,1.8217369,0.0]
diff --git a/libraries/base/tests/Numeric/num009.hs b/libraries/base/tests/Numeric/num009.hs
new file mode 100644
index 000000000000..429f0bf3c21b
--- /dev/null
+++ b/libraries/base/tests/Numeric/num009.hs
@@ -0,0 +1,37 @@
+-- trac #2059
+
+module Main(main) where
+
+import Control.Monad
+import Foreign.C
+
+main = do let d = [0, pi, pi/2, pi/3, 1e10, 1e20] :: [Double]
+              f = [0, pi, pi/2, pi/3, 1e10, 1e20] :: [Float]
+          mapM_ (test "sind" sind sin) d
+          mapM_ (test "sinf" sinf sin) f
+          mapM_ (test "cosd" cosd cos) d
+          mapM_ (test "cosf" cosf cos) f
+          mapM_ (test "tand" tand tan) d
+          mapM_ (test "tanf" tanf tan) f
+          putStrLn "Done"
+
+test :: (RealFloat a, Floating a, RealFloat b, Floating b, Show b)
+     => String -> (a -> a) -> (b -> b) -> b -> IO ()
+test s f g x = do let y = realToFrac (f (realToFrac x))
+                      z = g x
+                  unless (y == z) $ do
+                      putStrLn (s ++ ' ':show x)
+                      print y
+                      print z
+                      print $ decodeFloat y
+                      print $ decodeFloat z
+
+foreign import ccall "math.h sin"  sind :: CDouble -> CDouble
+foreign import ccall "math.h sinf" sinf :: CFloat  -> CFloat
+
+foreign import ccall "math.h cos"  cosd :: CDouble -> CDouble
+foreign import ccall "math.h cosf" cosf :: CFloat  -> CFloat
+
+foreign import ccall "math.h tan"  tand :: CDouble -> CDouble
+foreign import ccall "math.h tanf" tanf :: CFloat  -> CFloat
+
diff --git a/libraries/base/tests/Numeric/num009.stdout b/libraries/base/tests/Numeric/num009.stdout
new file mode 100644
index 000000000000..a965a70ed4ed
--- /dev/null
+++ b/libraries/base/tests/Numeric/num009.stdout
@@ -0,0 +1 @@
+Done
diff --git a/libraries/base/tests/Numeric/num009.stdout-i386-unknown-mingw32 b/libraries/base/tests/Numeric/num009.stdout-i386-unknown-mingw32
new file mode 100644
index 000000000000..d01a5a1d5dde
--- /dev/null
+++ b/libraries/base/tests/Numeric/num009.stdout-i386-unknown-mingw32
@@ -0,0 +1,16 @@
+sind 1.0e20
+-0.7304509250633894
+-0.7469218912594929
+(-6579317027855829,-53)
+(-6727674302302237,-53)
+cosd 1.0e20
+-0.6829651865754496
+-0.6649117899070088
+(-6151603519536432,-53)
+(-5988992978518909,-53)
+tand 1.0e20
+1.0695287833425957
+1.123339821307656
+(4816729430123734,-52)
+(5059072800651599,-52)
+Done
diff --git a/libraries/base/tests/Numeric/num010.hs b/libraries/base/tests/Numeric/num010.hs
new file mode 100644
index 000000000000..bf1d5a2734c3
--- /dev/null
+++ b/libraries/base/tests/Numeric/num010.hs
@@ -0,0 +1,29 @@
+
+module Main(main) where
+
+main = sequence_ [ f x y | x <- [0,
+                                 1000,
+                                 1000000000000,              -- > 2^32
+                                 1000000000000000000000000,  -- > 2^64
+                                 -1000,
+                                 -1000000000000,             -- < -2^32
+                                 -1000000000000000000000000] -- < -2^64
+                         , y <- [0, -10, 10] ]
+
+f :: Integer -> Int -> IO ()
+f x y = do putStrLn "------------------------"
+           print x
+           print y
+           let d :: Double
+               d = encodeFloat x y
+               (xd, yd) = decodeFloat d
+           let f :: Float
+               f = encodeFloat x y
+               (xf, yf) = decodeFloat f
+           print d
+           print xd
+           print yd
+           print f
+           print xf
+           print yf
+
diff --git a/libraries/base/tests/Numeric/num010.stdout b/libraries/base/tests/Numeric/num010.stdout
new file mode 100644
index 000000000000..877d35c722ce
--- /dev/null
+++ b/libraries/base/tests/Numeric/num010.stdout
@@ -0,0 +1,189 @@
+------------------------
+0
+0
+0.0
+0
+0
+0.0
+0
+0
+------------------------
+0
+-10
+0.0
+0
+0
+0.0
+0
+0
+------------------------
+0
+10
+0.0
+0
+0
+0.0
+0
+0
+------------------------
+1000
+0
+1000.0
+8796093022208000
+-43
+1000.0
+16384000
+-14
+------------------------
+1000
+-10
+0.9765625
+8796093022208000
+-53
+0.9765625
+16384000
+-24
+------------------------
+1000
+10
+1024000.0
+8796093022208000
+-33
+1024000.0
+16384000
+-4
+------------------------
+1000000000000
+0
+1.0e12
+8192000000000000
+-13
+1.0e12
+15258789
+16
+------------------------
+1000000000000
+-10
+9.765625e8
+8192000000000000
+-23
+9.765625e8
+15258789
+6
+------------------------
+1000000000000
+10
+1.024e15
+8192000000000000
+-3
+1.024e15
+15258789
+26
+------------------------
+1000000000000000000000000
+0
+1.0e24
+7450580596923828
+27
+1.0e24
+13877788
+56
+------------------------
+1000000000000000000000000
+-10
+9.765625e20
+7450580596923828
+17
+9.765625e20
+13877788
+46
+------------------------
+1000000000000000000000000
+10
+1.024e27
+7450580596923828
+37
+1.024e27
+13877788
+66
+------------------------
+-1000
+0
+-1000.0
+-8796093022208000
+-43
+-1000.0
+-16384000
+-14
+------------------------
+-1000
+-10
+-0.9765625
+-8796093022208000
+-53
+-0.9765625
+-16384000
+-24
+------------------------
+-1000
+10
+-1024000.0
+-8796093022208000
+-33
+-1024000.0
+-16384000
+-4
+------------------------
+-1000000000000
+0
+-1.0e12
+-8192000000000000
+-13
+-1.0e12
+-15258789
+16
+------------------------
+-1000000000000
+-10
+-9.765625e8
+-8192000000000000
+-23
+-9.765625e8
+-15258789
+6
+------------------------
+-1000000000000
+10
+-1.024e15
+-8192000000000000
+-3
+-1.024e15
+-15258789
+26
+------------------------
+-1000000000000000000000000
+0
+-1.0e24
+-7450580596923828
+27
+-1.0e24
+-13877788
+56
+------------------------
+-1000000000000000000000000
+-10
+-9.765625e20
+-7450580596923828
+17
+-9.765625e20
+-13877788
+46
+------------------------
+-1000000000000000000000000
+10
+-1.024e27
+-7450580596923828
+37
+-1.024e27
+-13877788
+66
diff --git a/libraries/base/tests/System/Makefile b/libraries/base/tests/System/Makefile
new file mode 100644
index 000000000000..4ca77510701c
--- /dev/null
+++ b/libraries/base/tests/System/Makefile
@@ -0,0 +1,7 @@
+# This Makefile runs the tests using GHC's testsuite framework.  It
+# assumes the package is part of a GHC build tree with the testsuite
+# installed in ../../../testsuite.
+
+TOP=../../../../testsuite
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
diff --git a/libraries/base/tests/System/T5930.hs b/libraries/base/tests/System/T5930.hs
new file mode 100644
index 000000000000..a46054f54917
--- /dev/null
+++ b/libraries/base/tests/System/T5930.hs
@@ -0,0 +1,10 @@
+import Control.Monad (when)
+import Data.Maybe (isJust)
+import System.Environment (lookupEnv)
+
+main :: IO ()
+main = do
+    term <- lookupEnv "PATH"
+    when (isJust term) $ putStrLn "Got PATH"
+    fish <- lookupEnv "One fish, two fish, red fish, blue fish"
+    print fish
diff --git a/libraries/base/tests/System/T5930.stdout b/libraries/base/tests/System/T5930.stdout
new file mode 100644
index 000000000000..0ee0b42bf448
--- /dev/null
+++ b/libraries/base/tests/System/T5930.stdout
@@ -0,0 +1,2 @@
+Got PATH
+Nothing
diff --git a/libraries/base/tests/System/Timeout001.hs b/libraries/base/tests/System/Timeout001.hs
new file mode 100644
index 000000000000..c086ae766bbf
--- /dev/null
+++ b/libraries/base/tests/System/Timeout001.hs
@@ -0,0 +1,10 @@
+-- test for escaping Timeout exceptions, see #7719
+
+import System.Timeout
+import Control.Monad
+import Control.Concurrent
+
+t d = timeout d $ timeout d $ timeout d $ timeout d $ timeout d $ timeout (10^9) $ threadDelay 100
+
+main = forM_ [1..20] $ \_ -> forM_ [1..40] t
+
diff --git a/libraries/base/tests/System/all.T b/libraries/base/tests/System/all.T
new file mode 100644
index 000000000000..a6894fa95ac8
--- /dev/null
+++ b/libraries/base/tests/System/all.T
@@ -0,0 +1,9 @@
+
+test('exitWith001', exit_code(42), compile_and_run, [''])
+test('getArgs001',  normal, compile_and_run, [''])
+test('getEnv001',   normal, compile_and_run, [''])
+test('T5930',   normal, compile_and_run, [''])
+
+test('system001',   when(opsys("mingw32"), expect_fail), \
+	compile_and_run, [''])
+test('Timeout001', normal, compile_and_run, [''])
diff --git a/libraries/base/tests/System/exitWith001.hs b/libraries/base/tests/System/exitWith001.hs
new file mode 100644
index 000000000000..38dc38a9d564
--- /dev/null
+++ b/libraries/base/tests/System/exitWith001.hs
@@ -0,0 +1,3 @@
+import System.Exit (exitWith, ExitCode(..))
+
+main = exitWith (ExitFailure 42)
diff --git a/libraries/base/tests/System/exitWith001.stdout b/libraries/base/tests/System/exitWith001.stdout
new file mode 100644
index 000000000000..e69de29bb2d1
diff --git a/libraries/base/tests/System/getArgs001.hs b/libraries/base/tests/System/getArgs001.hs
new file mode 100644
index 000000000000..8441fb7127bf
--- /dev/null
+++ b/libraries/base/tests/System/getArgs001.hs
@@ -0,0 +1,8 @@
+import System.Environment (getProgName, getArgs)
+
+main = do argv0 <- getProgName
+          putStr argv0
+          argv <- getArgs
+          mapM_ (\ x -> putChar ' ' >> putStr x) argv
+          putChar '\n'
+
diff --git a/libraries/base/tests/System/getArgs001.stdout b/libraries/base/tests/System/getArgs001.stdout
new file mode 100644
index 000000000000..e7320877137c
--- /dev/null
+++ b/libraries/base/tests/System/getArgs001.stdout
@@ -0,0 +1 @@
+getArgs001
diff --git a/libraries/base/tests/System/getEnv001.hs b/libraries/base/tests/System/getEnv001.hs
new file mode 100644
index 000000000000..b30db0fb51d0
--- /dev/null
+++ b/libraries/base/tests/System/getEnv001.hs
@@ -0,0 +1,15 @@
+
+import System.Environment (getEnv)
+import System.IO.Error (catchIOError, isDoesNotExistError)
+
+main :: IO ()
+main = do
+    term <- getEnv "PATH"
+    putStrLn "Got $PATH"
+    fish <- getEnv "One fish, two fish, red fish, blue fish" `catchIOError` getEnv_except
+    putStrLn fish
+
+getEnv_except :: IOError -> IO String
+getEnv_except ioe
+ | isDoesNotExistError ioe = return ""
+ | otherwise               = ioError ioe
diff --git a/libraries/base/tests/System/getEnv001.stdout b/libraries/base/tests/System/getEnv001.stdout
new file mode 100644
index 000000000000..b191cc3dd171
--- /dev/null
+++ b/libraries/base/tests/System/getEnv001.stdout
@@ -0,0 +1,2 @@
+Got $PATH
+
diff --git a/libraries/base/tests/System/system001.hs b/libraries/base/tests/System/system001.hs
new file mode 100644
index 000000000000..7d5c0bde9352
--- /dev/null
+++ b/libraries/base/tests/System/system001.hs
@@ -0,0 +1,18 @@
+-- Not run on mingw, because of /dev/null use
+
+import System.Cmd (system)
+import System.Exit (ExitCode(..), exitWith)
+
+main = do ec <- system "cat dog 1>/dev/null 2>&1"
+          case ec of
+              ExitSuccess ->
+                  do putStr "What?!?\n"
+                     ioError (userError "dog succeeded")
+              ExitFailure _ ->
+                  do ec <- system "cat system001.hs 2>/dev/null"
+                     case ec of
+                         ExitSuccess ->
+                             exitWith ExitSuccess
+                         ExitFailure _ ->
+                             do putStr "What?!?\n"
+                                ioError (userError "cat failed")
diff --git a/libraries/base/tests/System/system001.stdout b/libraries/base/tests/System/system001.stdout
new file mode 100644
index 000000000000..7d5c0bde9352
--- /dev/null
+++ b/libraries/base/tests/System/system001.stdout
@@ -0,0 +1,18 @@
+-- Not run on mingw, because of /dev/null use
+
+import System.Cmd (system)
+import System.Exit (ExitCode(..), exitWith)
+
+main = do ec <- system "cat dog 1>/dev/null 2>&1"
+          case ec of
+              ExitSuccess ->
+                  do putStr "What?!?\n"
+                     ioError (userError "dog succeeded")
+              ExitFailure _ ->
+                  do ec <- system "cat system001.hs 2>/dev/null"
+                     case ec of
+                         ExitSuccess ->
+                             exitWith ExitSuccess
+                         ExitFailure _ ->
+                             do putStr "What?!?\n"
+                                ioError (userError "cat failed")
diff --git a/libraries/base/tests/T4006.hs b/libraries/base/tests/T4006.hs
new file mode 100644
index 000000000000..662b0f62e3a1
--- /dev/null
+++ b/libraries/base/tests/T4006.hs
@@ -0,0 +1,8 @@
+import System.Process
+
+testUnicode :: String -> IO String
+testUnicode str = readProcess "printf" ["%s", str] ""
+
+main = do
+    testUnicode "It works here" >>= putStrLn
+    testUnicode "� зде�ь �ломало�ь" >>= putStrLn
diff --git a/libraries/base/tests/T4006.stdout b/libraries/base/tests/T4006.stdout
new file mode 100644
index 000000000000..9db8a8ced23c
--- /dev/null
+++ b/libraries/base/tests/T4006.stdout
@@ -0,0 +1,2 @@
+It works here
+� зде�ь �ломало�ь
diff --git a/libraries/base/tests/T5943.hs b/libraries/base/tests/T5943.hs
new file mode 100644
index 000000000000..88fa24d65b77
--- /dev/null
+++ b/libraries/base/tests/T5943.hs
@@ -0,0 +1,36 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
+import Control.Monad
+import Control.Monad.Fix
+import Data.IORef
+import Prelude hiding (until)
+
+data Phase a = Ready a | Updated a a
+
+delay :: IO Int               -- ^ the signal to delay
+      -> IO (IO (), IO (), IO Int)   -- ^ the delayed signal
+delay s = do
+  ref <- newIORef (Ready 0)
+  let
+      upd = do v <- readIORef ref
+               case v of
+                 Ready x -> do putStrLn "upd: Ready"; x' <- s; putStrLn (show x'); writeIORef ref (Updated x' x)
+                 _       -> return ()
+
+      fin = do v <- readIORef ref
+               case v of
+                 Updated x _ -> do putStrLn "fin: Updated"; writeIORef ref $! Ready x
+                 _           -> error "Signal not updated!"
+
+      sig = do v <- readIORef ref
+               case v of
+                 Ready x     -> do putStrLn "sig: Ready"; return x
+                 Updated _ x -> do putStrLn "sig: Updated"; return x
+
+  return (upd,fin,sig)
+
+main = do
+    (upd,fin,_) <- mfix $ \ ~(_,_,sig) -> delay (fmap (1+) sig)
+    upd
+    fin
+    upd
diff --git a/libraries/base/tests/T5943.stdout b/libraries/base/tests/T5943.stdout
new file mode 100644
index 000000000000..d24cba159954
--- /dev/null
+++ b/libraries/base/tests/T5943.stdout
@@ -0,0 +1,7 @@
+upd: Ready
+sig: Ready
+1
+fin: Updated
+upd: Ready
+sig: Ready
+2
diff --git a/libraries/base/tests/T5962.hs b/libraries/base/tests/T5962.hs
new file mode 100644
index 000000000000..92a130dd44b3
--- /dev/null
+++ b/libraries/base/tests/T5962.hs
@@ -0,0 +1,8 @@
+module Main where
+
+import Data.Typeable
+
+unitToUnit_a = typeOf (\() -> ())
+unitToUnit_b = mkFunTy (typeOf ()) (typeOf ())
+
+main = print (unitToUnit_a == unitToUnit_b)
diff --git a/libraries/base/tests/T5962.stdout b/libraries/base/tests/T5962.stdout
new file mode 100644
index 000000000000..0ca95142bb71
--- /dev/null
+++ b/libraries/base/tests/T5962.stdout
@@ -0,0 +1 @@
+True
diff --git a/libraries/base/tests/T7034.hs b/libraries/base/tests/T7034.hs
new file mode 100644
index 000000000000..b862bd86f2ad
--- /dev/null
+++ b/libraries/base/tests/T7034.hs
@@ -0,0 +1,11 @@
+main :: IO ()
+main = do
+  print $ r "1E100000"
+  print $ r "1E100000000"
+  print $ r "1E100000000000"
+  print $ r "1E100000000000000"
+  print $ r "1E100000000000000000"
+  print $ r "1E100000000000000000000"
+
+r :: String -> Double
+r = read
diff --git a/libraries/base/tests/T7034.stdout b/libraries/base/tests/T7034.stdout
new file mode 100644
index 000000000000..26751539c9ad
--- /dev/null
+++ b/libraries/base/tests/T7034.stdout
@@ -0,0 +1,6 @@
+Infinity
+Infinity
+Infinity
+Infinity
+Infinity
+Infinity
diff --git a/libraries/base/tests/T7457.hs b/libraries/base/tests/T7457.hs
new file mode 100644
index 000000000000..5f73aadc963f
--- /dev/null
+++ b/libraries/base/tests/T7457.hs
@@ -0,0 +1,2 @@
+import Text.Printf
+main = printf "%*sx\n" (-(3::Int)) "hi"
diff --git a/libraries/base/tests/T7457.stdout b/libraries/base/tests/T7457.stdout
new file mode 100644
index 000000000000..93b570a6d8bf
--- /dev/null
+++ b/libraries/base/tests/T7457.stdout
@@ -0,0 +1 @@
+hi x
diff --git a/libraries/base/tests/T7653.hs b/libraries/base/tests/T7653.hs
new file mode 100644
index 000000000000..4ab867427fc9
--- /dev/null
+++ b/libraries/base/tests/T7653.hs
@@ -0,0 +1,7 @@
+
+import Control.Monad;
+import Control.Concurrent
+
+main :: IO ()
+main = replicateM_ 1000000 (forkIO (threadDelay 1))
+
diff --git a/libraries/base/tests/T7773.hs b/libraries/base/tests/T7773.hs
new file mode 100644
index 000000000000..495cd7abd97e
--- /dev/null
+++ b/libraries/base/tests/T7773.hs
@@ -0,0 +1,9 @@
+import Control.Concurrent
+import System.Posix.IO
+
+main = do
+  putStrLn "hello"
+  fd <- openFd "/dev/random" ReadOnly Nothing defaultFileFlags
+  threadWaitRead fd
+  putStrLn "goodbye"
+  
\ No newline at end of file
diff --git a/libraries/base/tests/T7773.stdout b/libraries/base/tests/T7773.stdout
new file mode 100644
index 000000000000..a32119c8aa4c
--- /dev/null
+++ b/libraries/base/tests/T7773.stdout
@@ -0,0 +1,2 @@
+hello
+goodbye
diff --git a/libraries/base/tests/T7787.hs b/libraries/base/tests/T7787.hs
new file mode 100644
index 000000000000..883f4a9b96fb
--- /dev/null
+++ b/libraries/base/tests/T7787.hs
@@ -0,0 +1,8 @@
+import Control.Concurrent.MVar
+import Control.Exception
+
+main = do
+  mv <- newMVar 'x'
+  e <- try (modifyMVar mv $ \_ -> return undefined)
+  let _ = e :: Either SomeException ()
+  withMVar mv print -- should not hang
diff --git a/libraries/base/tests/T7787.stdout b/libraries/base/tests/T7787.stdout
new file mode 100644
index 000000000000..44cf16f8da03
--- /dev/null
+++ b/libraries/base/tests/T7787.stdout
@@ -0,0 +1 @@
+'x'
diff --git a/libraries/base/tests/T8766.hs b/libraries/base/tests/T8766.hs
new file mode 100644
index 000000000000..48f2b23abe06
--- /dev/null
+++ b/libraries/base/tests/T8766.hs
@@ -0,0 +1,4 @@
+module Main where
+
+main :: IO()
+main = print $ length [1..(2^(20::Int)::Integer)]
diff --git a/libraries/base/tests/T8766.stdout b/libraries/base/tests/T8766.stdout
new file mode 100644
index 000000000000..6820bf1779b1
--- /dev/null
+++ b/libraries/base/tests/T8766.stdout
@@ -0,0 +1 @@
+1048576
diff --git a/libraries/base/tests/T9111.hs b/libraries/base/tests/T9111.hs
new file mode 100644
index 000000000000..b2d1716ccdb8
--- /dev/null
+++ b/libraries/base/tests/T9111.hs
@@ -0,0 +1,10 @@
+{-# LANGUAGE DataKinds #-}
+
+module T9111 where
+
+import Data.Typeable
+
+a = typeRep (Proxy :: Proxy 'True)
+b = typeRep (Proxy :: Proxy Typeable)
+c = typeRep (Proxy :: Proxy (~))
+d = typeRep (Proxy :: Proxy 'Left)
diff --git a/libraries/base/tests/T9395.hs b/libraries/base/tests/T9395.hs
new file mode 100644
index 000000000000..c86b1279b4df
--- /dev/null
+++ b/libraries/base/tests/T9395.hs
@@ -0,0 +1,2 @@
+import Debug.Trace
+main = trace "333\0UUUU" $ return ()
diff --git a/libraries/base/tests/T9395.stderr b/libraries/base/tests/T9395.stderr
new file mode 100644
index 000000000000..4a4fb3f7c120
--- /dev/null
+++ b/libraries/base/tests/T9395.stderr
@@ -0,0 +1,2 @@
+333UUUU
+WARNING: previous trace message had null bytes
diff --git a/libraries/base/tests/Text.Printf/Makefile b/libraries/base/tests/Text.Printf/Makefile
new file mode 100644
index 000000000000..4ca77510701c
--- /dev/null
+++ b/libraries/base/tests/Text.Printf/Makefile
@@ -0,0 +1,7 @@
+# This Makefile runs the tests using GHC's testsuite framework.  It
+# assumes the package is part of a GHC build tree with the testsuite
+# installed in ../../../testsuite.
+
+TOP=../../../../testsuite
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
diff --git a/libraries/base/tests/Text.Printf/T1548.hs b/libraries/base/tests/Text.Printf/T1548.hs
new file mode 100644
index 000000000000..68cec0548faf
--- /dev/null
+++ b/libraries/base/tests/Text.Printf/T1548.hs
@@ -0,0 +1,11 @@
+import Text.Printf
+
+main = do
+   printf "%.*f\n" (2::Int) ((1/3) :: Double)
+   -- (expected: "0.33")
+
+   printf "%.3s\n" "foobar"
+   -- (expected: "foo")
+
+   printf "%10.5d\n" (4::Int)
+   -- (expected: "     00004")
diff --git a/libraries/base/tests/Text.Printf/T1548.stdout b/libraries/base/tests/Text.Printf/T1548.stdout
new file mode 100644
index 000000000000..4976334b4f35
--- /dev/null
+++ b/libraries/base/tests/Text.Printf/T1548.stdout
@@ -0,0 +1,3 @@
+0.33
+foo
+     00004
diff --git a/libraries/base/tests/Text.Printf/all.T b/libraries/base/tests/Text.Printf/all.T
new file mode 100644
index 000000000000..461d3b7e558d
--- /dev/null
+++ b/libraries/base/tests/Text.Printf/all.T
@@ -0,0 +1 @@
+test('T1548', normal, compile_and_run, [''])
diff --git a/libraries/base/tests/addr001.hs b/libraries/base/tests/addr001.hs
new file mode 100644
index 000000000000..436a066063e8
--- /dev/null
+++ b/libraries/base/tests/addr001.hs
@@ -0,0 +1,10 @@
+-- !!! Testing that Show for Addr is OK..
+module Main(main) where
+
+import Foreign.Ptr
+
+main :: IO ()
+main = do
+  print (nullPtr `plusPtr` maxBound)
+  print (nullPtr `plusPtr` minBound)
+
diff --git a/libraries/base/tests/addr001.stdout b/libraries/base/tests/addr001.stdout
new file mode 100644
index 000000000000..e098b1be4913
--- /dev/null
+++ b/libraries/base/tests/addr001.stdout
@@ -0,0 +1,2 @@
+0x7fffffff
+0x80000000
diff --git a/libraries/base/tests/addr001.stdout-alpha-dec-osf3 b/libraries/base/tests/addr001.stdout-alpha-dec-osf3
new file mode 100644
index 000000000000..f38ea7186128
--- /dev/null
+++ b/libraries/base/tests/addr001.stdout-alpha-dec-osf3
@@ -0,0 +1,2 @@
+0x7fffffffffffffff
+0x8000000000000000
diff --git a/libraries/base/tests/addr001.stdout-mips-sgi-irix b/libraries/base/tests/addr001.stdout-mips-sgi-irix
new file mode 100644
index 000000000000..f38ea7186128
--- /dev/null
+++ b/libraries/base/tests/addr001.stdout-mips-sgi-irix
@@ -0,0 +1,2 @@
+0x7fffffffffffffff
+0x8000000000000000
diff --git a/libraries/base/tests/addr001.stdout-ws-64 b/libraries/base/tests/addr001.stdout-ws-64
new file mode 100644
index 000000000000..f38ea7186128
--- /dev/null
+++ b/libraries/base/tests/addr001.stdout-ws-64
@@ -0,0 +1,2 @@
+0x7fffffffffffffff
+0x8000000000000000
diff --git a/libraries/base/tests/addr001.stdout-x86_64-unknown-openbsd b/libraries/base/tests/addr001.stdout-x86_64-unknown-openbsd
new file mode 100644
index 000000000000..f38ea7186128
--- /dev/null
+++ b/libraries/base/tests/addr001.stdout-x86_64-unknown-openbsd
@@ -0,0 +1,2 @@
+0x7fffffffffffffff
+0x8000000000000000
diff --git a/libraries/base/tests/all.T b/libraries/base/tests/all.T
new file mode 100644
index 000000000000..8b18d63f01a6
--- /dev/null
+++ b/libraries/base/tests/all.T
@@ -0,0 +1,171 @@
+
+test('readFloat', exit_code(1), compile_and_run, [''])
+test('enumDouble', normal, compile_and_run, [''])
+test('enumRatio', normal, compile_and_run, [''])
+test('tempfiles', normal, compile_and_run, [''])
+test('fixed', normal, compile_and_run, [''])
+test('quotOverflow', normal, compile_and_run, [''])
+test('assert', exit_code(1), compile_and_run, ['-fno-ignore-asserts'])
+test('CPUTime001', normal, compile_and_run, [''])
+test('readLitChar',   normal, compile_and_run, [''])
+test('unicode001',
+     when(platform('i386-unknown-openbsd'), expect_fail),
+     compile_and_run,
+     [''])
+test('unicode002',
+     when(platform('i386-unknown-openbsd'), expect_fail),
+     compile_and_run,
+     [''])
+test('data-fixed-show-read', normal, compile_and_run, [''])
+test('showDouble', normal, compile_and_run, [''])
+test('readDouble001', normal, compile_and_run, [''])
+test('readInteger001', normal, compile_and_run, [''])
+test('readFixed001', normal, compile_and_run, [''])
+test('lex001', normal, compile_and_run, [''])
+test('take001', extra_run_opts('1'), compile_and_run, [''])
+test('genericNegative001', extra_run_opts('-1'), compile_and_run, [''])
+test('ix001', normal, compile_and_run, [''])
+
+# need to add -K64m to the compiler opts, so that GHCi gets it too
+test('ioref001',
+     [when(fast(), skip),extra_run_opts('+RTS -K64m -RTS')],
+     compile_and_run,
+     ['+RTS -K64m -RTS'])
+
+test('echo001', set_stdin("echo001.hs"), compile_and_run, [''])
+
+test('hTell001', normal, compile_and_run, [''])
+
+test('hTell002', normal, compile_and_run, [''])
+
+test('performGC001', normal, compile_and_run, [''])
+
+# optimisation screws up this test because some of the traces get commoned up
+test('trace001', normal, compile_and_run, [''])
+
+test('hGetBuf002', normal, compile_and_run, [''])
+test('hGetBuf003', normal, compile_and_run, [''])
+test('hPutBuf001', normal, compile_and_run, [''])
+test('hPutBuf002', extra_clean(['hPutBuf002.out']), compile_and_run, [''])
+
+test('char001', 	normal, compile_and_run, [''])
+test('char002', 	normal, compile_and_run, [''])
+
+test('cstring001', 	normal, compile_and_run, [''])
+
+test('length001',
+     # length001 depends on a RULE being applied, and without -O takes
+     # excessive amounts of stack space. So we specifically set a low
+     # stack limit and mark it as failing under a few conditions.
+     [extra_run_opts('+RTS -K8m -RTS'),
+     expect_fail_for(['normal', 'threaded1', 'llvm'])],
+     compile_and_run, [''])
+
+test('ratio001', 	normal, compile_and_run, [''])
+
+test('rand001',		reqlib('random'), compile_and_run, [''])
+test('reads001',		normal, compile_and_run, [''])
+test('show001',		normal, compile_and_run, [''])
+test('text001',		normal, compile_and_run, [''])
+
+test('tup001',		normal, compile_and_run, [''])
+
+test('addr001',		normal, compile_and_run, [''])
+test('dynamic001',      normal, compile_and_run, [''])
+test('dynamic002',      normal, compile_and_run, [''])
+test('dynamic003',      extra_run_opts('+RTS -K32m -RTS'), compile_and_run, [''])
+test('dynamic004',      omit_ways(['normal', 'threaded1', 'ghci']), compile_and_run, [''])
+test('dynamic005',      normal, compile_and_run, [''])
+test('enum01',          when(fast(), skip), compile_and_run, ['-cpp'])
+test('enum02', 		when(fast(), skip), compile_and_run, ['-cpp'])
+test('enum03', 		when(fast(), skip), compile_and_run, ['-cpp'])
+test('enum04', 		normal, compile_and_run, [''])
+test('exceptionsrun001', 	normal, compile_and_run, [''])
+test('exceptionsrun002', 	normal, compile_and_run, [''])
+test('list001'	,	when(fast(), skip), compile_and_run, [''])
+test('list002', when(fast(), skip), compile_and_run, [''])
+test('list003', when(fast(), skip), compile_and_run, [''])
+
+test('memo001',
+     [extra_run_opts('+RTS -A10k -RTS'),
+      extra_clean(['Memo1.hi', 'Memo1.o'])],
+     multimod_compile_and_run,
+     ['memo001',''])
+
+test('memo002',
+     [extra_run_opts('20'),
+      extra_clean(['Memo2.hi', 'Memo2.o'])],
+	multimod_compile_and_run, ['memo002',''])
+
+test('packedstring001', reqlib('packedstring'), compile_and_run, ['-package packedstring'])
+
+test('stableptr001',
+     [when(fast(), skip), extra_run_opts('+RTS -K8m -RTS')],
+     compile_and_run, [''])
+test('stableptr003', normal, compile_and_run, [''])
+test('stableptr004', extra_run_opts('+RTS -K4m -RTS'), compile_and_run, [''])
+test('stableptr005', normal, compile_and_run, [''])
+
+test('weak001', normal, compile_and_run, [''])
+
+# In the 65001 codepage, we can't even cat the expected output on msys:
+#     $ cat 4006.stdout
+#     It works here
+#     cat: write error: Permission denied
+# Seems to be a known problem, e.g.
+#     http://mingw-users.1079350.n2.nabble.com/Bug-re-Unicode-on-the-console-td3121717.html
+# May 2014: seems to work on msys2
+test('T4006', normal, compile_and_run, [''])
+
+test('T5943', normal, compile_and_run, [''])
+test('T5962', normal, compile_and_run, [''])
+test('T7034', normal, compile_and_run, [''])
+
+test('qsem001', normal, compile_and_run, [''])
+test('qsemn001', normal, compile_and_run, [''])
+
+test('T7457', normal, compile_and_run, [''])
+
+test('T7773', when(opsys('mingw32'), skip), compile_and_run, [''])
+# Andreas says that T7773 will not (and should not) work on Windows
+
+# Tests for kind-polymorphic Category
+test('CatPairs', normal, compile, [''])
+test('CatEntail', normal, compile, [''])
+
+test('T7653', normal, compile_and_run, [''])
+test('T7787', normal, compile_and_run, [''])
+
+test('topHandler01', when(opsys('mingw32'), skip), compile_and_run, [''])
+test('topHandler02',
+     [when(opsys('mingw32'), skip),
+      omit_ways(['ghci']),
+      # Irritatingly, the test driver calls the programs via a shell, and
+      # depending on the shell, they can add their own "helpful" commentary,
+      # pretty printing the name of the signal that killed the process. So we
+      # ignore the stdout here, we only care about the exit code (which itself
+      # is messed up because of the shell, using 128+sig encoding)
+      ignore_output,
+      signal_exit_code(2)
+     ], compile_and_run, [''])
+test('topHandler03',
+     [when(opsys('mingw32'), skip),
+      # As above, shells, grrr.
+      ignore_output,
+      signal_exit_code(15)
+     ], compile_and_run, [''])
+
+
+test('T8766',
+        [ stats_num_field('bytes allocated', 
+                          [ (wordsize(64), 16828144, 5)
+	# with GHC-7.6.3: 83937384 (but faster execution than the next line)
+	# before:         58771216 (without call-arity-analysis)
+	# expected value: 16828144 (2014-01-14)
+                          , (wordsize(32), 8433644, 5) ]) 
+        , only_ways(['normal'])],
+      compile_and_run,
+      ['-O'])
+
+test('T9111', normal, compile, [''])
+test('T9395', normal, compile_and_run, [''])
diff --git a/libraries/base/tests/assert.hs b/libraries/base/tests/assert.hs
new file mode 100644
index 000000000000..f6e3c904159d
--- /dev/null
+++ b/libraries/base/tests/assert.hs
@@ -0,0 +1,9 @@
+
+import Control.Exception
+
+-- We want to get the assertion failure, not the overflow exception.
+-- trac #5561.
+
+main :: IO ()
+main = let e1 i = throw Overflow
+       in assert False (e1 5)
diff --git a/libraries/base/tests/assert.stderr b/libraries/base/tests/assert.stderr
new file mode 100644
index 000000000000..8d99aa0a6482
--- /dev/null
+++ b/libraries/base/tests/assert.stderr
@@ -0,0 +1,2 @@
+assert: assert.hs:9:11-16: Assertion failed
+
diff --git a/libraries/base/tests/char001.hs b/libraries/base/tests/char001.hs
new file mode 100644
index 000000000000..2fb0edce0fb3
--- /dev/null
+++ b/libraries/base/tests/char001.hs
@@ -0,0 +1,43 @@
+-- !!! Testing the behaviour of Char.lexLitChar a little..
+
+-- [March 2003]  We now allow \X and \O as escapes although the 
+-- spec only permits \x and \o.  Seems more consistent. 
+
+module Main where
+
+import Data.Char
+
+lex' str = do
+  putStr ("lex " ++ str ++ " = ")
+  print (lex str)
+
+hexes = do
+  lex' "'\\X00'"
+  lex' "'\\x0f2'"
+  lex' "'\\xf2'"
+  lex' "'\\xf2t'"
+  lex' "'\\X24'"
+  lex' "'\\x24b'"
+  lex' "'\\Xa4b'"
+  lex' "'\\xa4bg'"
+
+octs = do
+  lex' "'\\o00'"
+  lex' "'\\o05'"
+  lex' "'\\o50'"
+  lex' "'\\o72'"
+  lex' "'\\o82'"
+  lex' "'\\O24'"
+  lex' "'\\O000024'"
+  lex' "'\\024b'"
+  lex' "'\\o14b'"
+  lex' "'\\0a4bg'"
+
+main = do
+  hexes
+  octs
+
+
+
+
+
diff --git a/libraries/base/tests/char001.stdout b/libraries/base/tests/char001.stdout
new file mode 100644
index 000000000000..0c13ac7c03f5
--- /dev/null
+++ b/libraries/base/tests/char001.stdout
@@ -0,0 +1,18 @@
+lex '\X00' = [("'\\X00'","")]
+lex '\x0f2' = [("'\\x0f2'","")]
+lex '\xf2' = [("'\\xf2'","")]
+lex '\xf2t' = []
+lex '\X24' = [("'\\X24'","")]
+lex '\x24b' = [("'\\x24b'","")]
+lex '\Xa4b' = [("'\\Xa4b'","")]
+lex '\xa4bg' = []
+lex '\o00' = [("'\\o00'","")]
+lex '\o05' = [("'\\o05'","")]
+lex '\o50' = [("'\\o50'","")]
+lex '\o72' = [("'\\o72'","")]
+lex '\o82' = []
+lex '\O24' = [("'\\O24'","")]
+lex '\O000024' = [("'\\O000024'","")]
+lex '\024b' = []
+lex '\o14b' = []
+lex '\0a4bg' = []
diff --git a/libraries/base/tests/char002.hs b/libraries/base/tests/char002.hs
new file mode 100644
index 000000000000..60b8b03cdac4
--- /dev/null
+++ b/libraries/base/tests/char002.hs
@@ -0,0 +1,7 @@
+-- !!! tests for large character values in literals
+import Data.Char
+main = do
+  print (ord '\xffff')
+  print (ord '\o7777')
+  print (ord '\65535')
+  print (map ord "\xffff\o7777\65535")
diff --git a/libraries/base/tests/char002.stdout b/libraries/base/tests/char002.stdout
new file mode 100644
index 000000000000..5190ad9c530c
--- /dev/null
+++ b/libraries/base/tests/char002.stdout
@@ -0,0 +1,4 @@
+65535
+4095
+65535
+[65535,4095,65535]
diff --git a/libraries/base/tests/cstring001.hs b/libraries/base/tests/cstring001.hs
new file mode 100644
index 000000000000..38d0d25db26e
--- /dev/null
+++ b/libraries/base/tests/cstring001.hs
@@ -0,0 +1,18 @@
+import Control.Monad
+import Foreign.C.String
+
+test_strings = ["Hello World", replicate 10000 'a']
+
+assertEqual :: (Eq a, Show a) => a -> a -> IO ()
+assertEqual x y = if x == y then return () else error $ "assertEqual: " ++ show x ++ " /= " ++ show y
+
+main = do
+    -- Try roundtripping some ASCII strings through the locale encoding
+    forM test_strings $ \try_str -> do
+        got_str <- withCString try_str peekCString
+        got_str `assertEqual` try_str
+
+    -- Try roundtripping some ASCII strings with lengths through the locale encoding
+    forM test_strings $ \try_str -> do
+        got_str <- withCStringLen try_str peekCStringLen
+        got_str `assertEqual` try_str
diff --git a/libraries/base/tests/data-fixed-show-read.hs b/libraries/base/tests/data-fixed-show-read.hs
new file mode 100644
index 000000000000..349f639f2c8a
--- /dev/null
+++ b/libraries/base/tests/data-fixed-show-read.hs
@@ -0,0 +1,22 @@
+
+module Main (main) where
+
+import Data.Fixed
+
+main :: IO ()
+main = do doit 38.001
+          doit 38.009
+          doit 38.01
+          doit 38.09
+          print (read "38" :: Centi)
+          doit (-38.001)
+          doit (-38.009)
+          doit (-38.01)
+          doit (-38.09)
+          print (read "-38" :: Centi)
+
+doit :: Centi -> IO ()
+doit c = do let s = show c
+                r = read s :: Centi
+            putStrLn s
+            print r
diff --git a/libraries/base/tests/data-fixed-show-read.stdout b/libraries/base/tests/data-fixed-show-read.stdout
new file mode 100644
index 000000000000..0e5d7caef506
--- /dev/null
+++ b/libraries/base/tests/data-fixed-show-read.stdout
@@ -0,0 +1,18 @@
+38.00
+38.00
+38.00
+38.00
+38.01
+38.01
+38.09
+38.09
+38.00
+-38.00
+-38.00
+-38.00
+-38.00
+-38.01
+-38.01
+-38.09
+-38.09
+-38.00
diff --git a/libraries/base/tests/dynamic001.hs b/libraries/base/tests/dynamic001.hs
new file mode 100644
index 000000000000..7a3fd515e9da
--- /dev/null
+++ b/libraries/base/tests/dynamic001.hs
@@ -0,0 +1,107 @@
+-- !!! Dynamic library regression tests
+module Main(main) where
+
+import Data.Dynamic
+
+main :: IO ()
+main = do
+   test   "toDyn"   toDyn_list
+   testIO "fromDyn" fromDyn_test
+
+toDyn_list :: [Dynamic]
+toDyn_list =
+    [ toDyn (1::Int)
+    , toDyn ('a')
+    , toDyn False
+    , toDyn ((-1.0)::Float)
+    , toDyn (0.0::Double)
+    , toDyn (1394::Integer)
+    , toDyn (print "hello")
+    , toDyn toDyn_list
+    , toDyn ([]::[Int])
+    , toDyn (Nothing  :: Maybe Int)
+    , toDyn ((Just 2) :: Maybe Int)
+    , toDyn ((Just 2) :: Maybe Int)
+    , toDyn ((Left 3) :: Either Int Bool)
+    , toDyn ((Right 3) :: Either Char Int)
+    , toDyn ()
+    , toDyn LT
+    , toDyn ((),2::Int)
+    , toDyn ((),2::Int,'a')
+    , toDyn ((),2::Int,'a',1.0::Double)
+    , toDyn ((),2::Int,'a',1.0::Double,Nothing::Maybe Bool)
+    , toDyn ((+) :: Int -> Int -> Int)
+    , toDyn ((+) :: Integer -> Integer -> Integer)
+    , toDyn ((++) :: [Char] -> [Char] -> [Char])
+    ]
+
+-- Testing the conversion from Dynamic values:
+fromDyn_test :: IO ()
+fromDyn_test = do
+   print (fromDyn (toDyn (1::Int)) (0::Int))
+   print (fromDyn (toDyn ('a'::Char)) (0::Int))
+   print (fromDyn (toDyn 'a') 'b')
+   print (fromDyn (toDyn (1::Float)) (0::Float))
+   print (fromDyn (toDyn (2::Float)) (0::Int))
+   print (fromDyn (toDyn (3::Double)) (0::Double))
+   print (fromDyn (toDyn (4::Double)) (0::Int))
+   print (fromDyn (toDyn (5::Integer)) (0::Integer))
+   print (fromDyn (toDyn (6::Integer)) False)
+   print (fromDyn (toDyn [1,3,5::Integer]) ([]::[Integer]))
+   print (fromDyn (toDyn (Just True)) (Nothing::Maybe Bool))
+   print (fromDyn (toDyn (Left True::Either Bool Bool)) (Right False :: Either Bool Bool))
+   print (fromDyn (toDyn LT) GT)
+   print (fromDyn (toDyn ((+1)::Int->Int)) False)
+   print ((fromDyn (toDyn ((+1)::Int->Int)) ((+2)::Int->Int)) 3)
+   print ((fromDyn (toDyn ((++)::[Int]->[Int]->[Int])) ((undefined)::[Int]->[Int]->[Int])) [1] [2])
+
+    
+-- Misc test utilities:
+test :: Show a => String -> [a] -> IO ()
+test str ls = do
+  putStrLn ("*** Testing: " ++ str ++ " ***")
+  putStrLn (showListLn ls)
+
+testIO :: String -> IO () -> IO ()
+testIO str tst = do
+  putStrLn ("*** Testing: " ++ str ++ " ***")
+  tst
+
+
+-- showListLn presents a list in a diff-friendly format.
+-- showListLn [a1,..an]
+--  =>
+--      [ a1
+--      , a2
+--      ..
+--      , an
+--      ]
+--   
+showListLn :: Show a => [a] -> String
+showListLn [] = ""
+showListLn ls = '[' : ' ' : go ls
+ where
+   go    [x] = show x ++ "\n]"
+   go (x:xs) = show x ++ '\n':',':' ':go xs
+
+{-
+test8 = toDyn (mkAppTy listTc)
+test9 :: Float
+test9 = fromDyn test8 0
+
+printf :: String -> [Dynamic] -> IO ()
+printf str args = putStr (decode str args)
+ where
+  decode [] [] = []
+  decode ('%':'n':cs) (d:ds) =
+    (\ v -> show v++decode cs ds) (fromDyn  d (0::Int))
+  decode ('%':'c':cs) (d:ds) =
+    (\ v -> show v++decode cs ds) (fromDyn  d ('\0'))
+  decode ('%':'b':cs) (d:ds) =
+    (\ v -> show v++decode cs ds) (fromDyn  d (False::Bool))
+  decode (x:xs) ds = x:decode xs ds
+
+test10 :: IO ()
+test10 = printf "%n = %c, that much is %b\n" [toDyn (3::Int),toDyn 'a', toDyn False]
+
+-}
diff --git a/libraries/base/tests/dynamic001.stdout b/libraries/base/tests/dynamic001.stdout
new file mode 100644
index 000000000000..c2d365a7c652
--- /dev/null
+++ b/libraries/base/tests/dynamic001.stdout
@@ -0,0 +1,42 @@
+*** Testing: toDyn ***
+[ <<Int>>
+, <<Char>>
+, <<Bool>>
+, <<Float>>
+, <<Double>>
+, <<Integer>>
+, <<IO ()>>
+, <<[Dynamic]>>
+, <<[Int]>>
+, <<Maybe Int>>
+, <<Maybe Int>>
+, <<Maybe Int>>
+, <<Either Int Bool>>
+, <<Either Char Int>>
+, <<()>>
+, <<Ordering>>
+, <<((),Int)>>
+, <<((),Int,Char)>>
+, <<((),Int,Char,Double)>>
+, <<((),Int,Char,Double,(Maybe Bool))>>
+, <<Int -> Int -> Int>>
+, <<Integer -> Integer -> Integer>>
+, <<[Char] -> [Char] -> [Char]>>
+]
+*** Testing: fromDyn ***
+1
+0
+'a'
+1.0
+0
+3.0
+0
+5
+False
+[1,3,5]
+Just True
+Left True
+LT
+False
+4
+[1,2]
diff --git a/libraries/base/tests/dynamic002.hs b/libraries/base/tests/dynamic002.hs
new file mode 100644
index 000000000000..6d53d2ed1ea4
--- /dev/null
+++ b/libraries/base/tests/dynamic002.hs
@@ -0,0 +1,91 @@
+-- !!! Testing Typeable instances
+module Main(main) where
+
+import Data.Dynamic
+import Data.Array
+import Data.Array.MArray
+import Data.Array.ST
+import Data.Array.IO
+import Data.Array.Unboxed
+import Data.Complex
+import Data.Int
+import Data.Word
+import Data.IORef
+import System.IO
+import Control.Monad.ST
+import System.Mem.StableName
+import System.Mem.Weak
+import Foreign.StablePtr
+import Control.Exception
+import Foreign.C.Types
+
+main :: IO ()
+main = do
+   print (typeOf (undefined :: [()]))
+   print (typeOf (undefined :: ()))
+   print (typeOf (undefined :: ((),())))
+   print (typeOf (undefined :: ((),(),())))
+   print (typeOf (undefined :: ((),(),(),())))
+   print (typeOf (undefined :: ((),(),(),(),())))
+   print (typeOf (undefined :: (() -> ())))
+   print (typeOf (undefined :: (Array () ())))
+   print (typeOf (undefined :: Bool))
+   print (typeOf (undefined :: Char))
+   print (typeOf (undefined :: (Complex ())))
+   print (typeOf (undefined :: Double))
+   print (typeOf (undefined :: (Either () ())))
+   print (typeOf (undefined :: Float))
+   print (typeOf (undefined :: Handle))
+   print (typeOf (undefined :: Int))
+   print (typeOf (undefined :: Integer))
+   print (typeOf (undefined :: IO ()))
+   print (typeOf (undefined :: (Maybe ())))
+   print (typeOf (undefined :: Ordering))
+
+   print (typeOf (undefined :: Dynamic))
+   print (typeOf (undefined :: (IORef ())))
+   print (typeOf (undefined :: Int8))
+   print (typeOf (undefined :: Int16))
+   print (typeOf (undefined :: Int32))
+   print (typeOf (undefined :: Int64))
+   print (typeOf (undefined :: (ST () ())))
+   print (typeOf (undefined :: (StableName ())))
+   print (typeOf (undefined :: (StablePtr ())))
+   print (typeOf (undefined :: TyCon))
+   print (typeOf (undefined :: TypeRep))
+   print (typeOf (undefined :: Word8))
+   print (typeOf (undefined :: Word16))
+   print (typeOf (undefined :: Word32))
+   print (typeOf (undefined :: Word64))
+
+   print (typeOf (undefined :: ArithException))
+   print (typeOf (undefined :: AsyncException))
+   print (typeOf (undefined :: (IOArray () ())))
+   print (typeOf (undefined :: (IOUArray () ())))
+   print (typeOf (undefined :: (STArray () () ())))
+   print (typeOf (undefined :: (STUArray () () ())))
+   print (typeOf (undefined :: (StableName ())))
+   print (typeOf (undefined :: (StablePtr ())))
+   print (typeOf (undefined :: (UArray () ())))
+   print (typeOf (undefined :: (Weak ())))
+
+   print (typeOf (undefined :: CChar))
+   print (typeOf (undefined :: CSChar))
+   print (typeOf (undefined :: CUChar))
+   print (typeOf (undefined :: CShort))
+   print (typeOf (undefined :: CUShort))
+   print (typeOf (undefined :: CInt))
+   print (typeOf (undefined :: CUInt))
+   print (typeOf (undefined :: CLong))
+   print (typeOf (undefined :: CULong))
+   print (typeOf (undefined :: CLLong))
+   print (typeOf (undefined :: CULLong))
+   print (typeOf (undefined :: CFloat))
+   print (typeOf (undefined :: CDouble))
+
+   print (typeOf (undefined :: CPtrdiff))
+   print (typeOf (undefined :: CSize))
+   print (typeOf (undefined :: CWchar))
+   print (typeOf (undefined :: CSigAtomic))
+   print (typeOf (undefined :: CClock))
+   print (typeOf (undefined :: CTime))
diff --git a/libraries/base/tests/dynamic002.stdout b/libraries/base/tests/dynamic002.stdout
new file mode 100644
index 000000000000..8b55566ada96
--- /dev/null
+++ b/libraries/base/tests/dynamic002.stdout
@@ -0,0 +1,64 @@
+[()]
+()
+((),())
+((),(),())
+((),(),(),())
+((),(),(),(),())
+() -> ()
+Array () ()
+Bool
+Char
+Complex ()
+Double
+Either () ()
+Float
+Handle
+Int
+Integer
+IO ()
+Maybe ()
+Ordering
+Dynamic
+IORef ()
+Int8
+Int16
+Int32
+Int64
+ST () ()
+StableName ()
+StablePtr ()
+TyCon
+TypeRep
+Word8
+Word16
+Word32
+Word64
+ArithException
+AsyncException
+IOArray () ()
+IOUArray () ()
+STArray () () ()
+STUArray () () ()
+StableName ()
+StablePtr ()
+UArray () ()
+Weak ()
+CChar
+CSChar
+CUChar
+CShort
+CUShort
+CInt
+CUInt
+CLong
+CULong
+CLLong
+CULLong
+CFloat
+CDouble
+CPtrdiff
+CSize
+CWchar
+CSigAtomic
+CClock
+CTime
diff --git a/libraries/base/tests/dynamic003.hs b/libraries/base/tests/dynamic003.hs
new file mode 100644
index 000000000000..fae8bdb27683
--- /dev/null
+++ b/libraries/base/tests/dynamic003.hs
@@ -0,0 +1,12 @@
+module Main where
+
+-- Test generation of large TypeReps
+-- (can be used as a benchmark)
+
+import Data.Typeable
+
+f :: Typeable a => Int -> a -> TypeRep
+f 0 a = typeOf a
+f n a = f (n-1) [a]
+
+main = print (f 50000 () == f 50001 ())
diff --git a/libraries/base/tests/dynamic003.stdout b/libraries/base/tests/dynamic003.stdout
new file mode 100644
index 000000000000..bc59c12aa16b
--- /dev/null
+++ b/libraries/base/tests/dynamic003.stdout
@@ -0,0 +1 @@
+False
diff --git a/libraries/base/tests/dynamic004.hs b/libraries/base/tests/dynamic004.hs
new file mode 100644
index 000000000000..e6b7a82bfd40
--- /dev/null
+++ b/libraries/base/tests/dynamic004.hs
@@ -0,0 +1,36 @@
+module Main where
+
+import Data.Typeable
+import Data.Typeable.Internal
+import GHC.Fingerprint
+import Text.Printf
+
+f :: Typeable a => Int -> a -> [TypeRep]
+f 0 a = []
+f n a = typeOf a : f (n-1) [a]
+
+-- pointwise compare 1000x1001 TypeReps, there should be exactly 1000 equalities
+-- (can be used as a benchmark)
+main = print $ length [ t1 | t1 <- f 1000 (), t2 <- f 1001 (), t1 == t2 ]
+
+{-
+ DEBUGGING code to help find bugs in the TypeRep implementation when
+ this test fails:
+
+ where
+   g (x:xs) (y:ys)
+     | x == y = g xs ys
+     | otherwise = do
+         print x
+         case x of
+           TypeRep f1 (TyCon f2 _ _ _) [TypeRep f3 _ _] ->
+              printf "f1: %s\nf2: %s\nf3: %s\n" (show_fp f1) (show_fp f2) (show_fp f3)
+         case y of
+           TypeRep f1 (TyCon f2 _ _ _) [TypeRep f3 _ _] ->
+              printf "f1: %s\nf2: %s\nf3: %s\n" (show_fp f1) (show_fp f2) (show_fp f3)
+   g _ _ = return ()
+
+   show_fp :: Fingerprint -> String
+   show_fp (Fingerprint h l) =
+       printf "%x %x" h l
+-}
diff --git a/libraries/base/tests/dynamic004.stdout b/libraries/base/tests/dynamic004.stdout
new file mode 100644
index 000000000000..83b33d238dab
--- /dev/null
+++ b/libraries/base/tests/dynamic004.stdout
@@ -0,0 +1 @@
+1000
diff --git a/libraries/base/tests/dynamic005.hs b/libraries/base/tests/dynamic005.hs
new file mode 100644
index 000000000000..e90aeea96043
--- /dev/null
+++ b/libraries/base/tests/dynamic005.hs
@@ -0,0 +1,14 @@
+module Main where
+
+import Data.Typeable
+
+f :: Typeable a => Int -> a -> [TypeRep]
+f 0 a = []
+f n a = typeOf a : f (n-1) [a]
+
+-- pointwise compare 1000x1000 different TypeReps, there should be no equalities
+-- (can be used as a benchmark)
+
+main = print $ length [ t1 | t1 <- replicate 1000 (f 10 ()),
+                             t2 <- replicate 1000 (f 10 'a'),
+                             t1 == t2 ]
diff --git a/libraries/base/tests/dynamic005.stdout b/libraries/base/tests/dynamic005.stdout
new file mode 100644
index 000000000000..573541ac9702
--- /dev/null
+++ b/libraries/base/tests/dynamic005.stdout
@@ -0,0 +1 @@
+0
diff --git a/libraries/base/tests/echo001.hs b/libraries/base/tests/echo001.hs
new file mode 100644
index 000000000000..7c803589bfbf
--- /dev/null
+++ b/libraries/base/tests/echo001.hs
@@ -0,0 +1,13 @@
+module Main(main) where
+
+import System.IO
+import Data.Char
+
+main = do
+  isT <- hIsTerminalDevice stdin
+  flg <- if not isT then return False else hGetEcho stdin
+  print flg
+  if not isT then hSetEcho stdin False else return ()
+  hSetBuffering stdin NoBuffering
+  interact (map toUpper)
+  
diff --git a/libraries/base/tests/echo001.stdout b/libraries/base/tests/echo001.stdout
new file mode 100644
index 000000000000..a9d7699954de
--- /dev/null
+++ b/libraries/base/tests/echo001.stdout
@@ -0,0 +1,14 @@
+False
+MODULE MAIN(MAIN) WHERE
+
+IMPORT SYSTEM.IO
+IMPORT DATA.CHAR
+
+MAIN = DO
+  IST <- HISTERMINALDEVICE STDIN
+  FLG <- IF NOT IST THEN RETURN FALSE ELSE HGETECHO STDIN
+  PRINT FLG
+  IF NOT IST THEN HSETECHO STDIN FALSE ELSE RETURN ()
+  HSETBUFFERING STDIN NOBUFFERING
+  INTERACT (MAP TOUPPER)
+  
diff --git a/libraries/base/tests/enum01.hs b/libraries/base/tests/enum01.hs
new file mode 100644
index 000000000000..8b490bb54909
--- /dev/null
+++ b/libraries/base/tests/enum01.hs
@@ -0,0 +1,529 @@
+-- !!! Testing the Prelude's Enum instances.
+{-# LANGUAGE CPP #-}
+module Main(main) where
+
+import Control.Exception
+#if __GLASGOW_HASKELL__ < 705
+import Prelude hiding (catch)
+#endif
+import Data.Char
+import Data.Ratio
+
+main = do
+   -- Enum Int
+  putStrLn "Testing Enum Int: "
+  testEnumInt
+   -- Enum Integer
+  putStrLn "Testing Enum Integer: "
+  testEnumInteger
+   -- Enum Char
+  putStrLn "Testing Enum Char: "
+  testEnumChar
+   -- Enum ()
+  putStrLn "Testing Enum (): "
+  testEnumUnit
+   -- Enum Ordering
+  putStrLn "Testing Enum Ordering (derived): "
+  testEnumOrdering
+   -- Enum Bool
+  putStrLn "Testing Enum Bool: "
+  testEnumBool
+   -- Enum Rational
+  putStrLn "Testing Enum Rational: "
+  testEnumRational
+   -- Enum (Ratio Int)
+  putStrLn "Testing Enum (Ratio Int): "
+  testEnumRatioInt
+
+{- 
+  Here's the properties that's supposed to
+  hold for arithmetic sequences over Int:
+
+   - [e1..]    = [e1, (e1+1), (e1+2), ..., maxBound]
+
+   - [e1,e2..] = [e1, (e1+i), (e1+2*i), ... upper]
+                 where
+		  i = e2 - e1
+		  upper
+		   | i >  0 = maxBound
+		   | i <  0 = minBound
+		   | i == 0 = maxBound -- this really shouldn't matter (I feel.)
+   - [e1..e3] = [e1, (e1+i), (e1+2*i),..e3]
+                where
+		 i
+		  | e3 >= e1 = 1
+		  | e3 <  e1 = (-1)
+    
+   - [e1,e2..e3] = res
+                   where
+		    i = e2 - e1
+		    
+		    res
+		     | i >= 0 && e3 <  e1 = []
+		     | i <  0 && e3 >= e1 = []  -- (*)
+		     | otherwise          = [e1, (e1+i), (e1 + 2*i), .. e3]
+
+   Note:
+     (*) - I think this instead should be (i < 0 && e3 > e1), since, as is,
+
+            [x,(x+1) ..x] = [x] 
+            [x,(x-1) ..x] = []
+
+           which does not look right, symmetrically speaking.
+
+
+   The same properties hold for other Prelude types that
+   are instances of Enum as well as being Bounded.
+   
+   For non-Bounded types (e.g., Float and Double), the properties are similar,
+   except that the boundary tests become slightly different, i.e., when an
+   element becomes greater than (e3 + i/2) (or less than (e3 + i/2) for negative
+   i.)
+
+  Q - does [(x::Double)..] have an upper bound? (ditto for Float.)
+
+  OK - on with the regression testing.
+-}
+
+#define printTest(x) (do{ putStr ( "    " ++ "x" ++ " = " ) ; print (x) })
+
+
+testEnumInt :: IO ()
+testEnumInt = do
+     -- succ
+  printTest ((succ (0::Int)))
+  printTest ((succ (minBound::Int)))
+  mayBomb   (printTest ((succ (maxBound::Int))))
+
+     -- pred
+  printTest (pred (1::Int))
+  printTest (pred (maxBound::Int))
+  mayBomb   (printTest (pred (minBound::Int))) 
+
+     -- toEnum
+  printTest ((map (toEnum::Int->Int) [1,minBound,maxBound]))
+
+     -- fromEnum
+  printTest ((map fromEnum [(1::Int),minBound,maxBound]))
+
+     -- [x..] aka enumFrom
+  printTest ((take 7 [(1::Int)..]))
+  printTest ((take 7 [((maxBound::Int)-5)..])) -- just in case it doesn't catch the upper bound..
+  
+     -- [x,y..] aka enumFromThen
+  printTest ((take 7 [(1::Int),2..]))
+  printTest ((take 7 [(1::Int),7..]))
+  printTest ((take 7 [(1::Int),1..]))
+  printTest ((take 7 [(1::Int),0..]))
+  printTest ((take 7 [(5::Int),2..]))
+  let x = (minBound::Int) + 1
+  printTest ((take 7 [x, x-1 ..]))
+  let x = (minBound::Int) + 5
+  printTest ((take 7 [x, x-1 ..]))
+  let x = (maxBound::Int) - 5
+  printTest ((take 7 [x, (x+1) ..]))
+
+	-- Test overflow conditions
+  printTest (([minBound::Int,1..]))
+  printTest (([minBound::Int,0..]))
+  printTest (([minBound::Int,-1..]))
+  printTest (([maxBound::Int,1..]))
+  printTest (([maxBound::Int,0..]))
+  printTest (([maxBound::Int,-1..]))
+
+     -- [x..y] aka enumFromTo
+  printTest ((take 7 ([(1::Int) .. 5])))
+  printTest ((take 4 ([(1::Int) .. 1])))
+  printTest ((take 7 ([(1::Int) .. 0])))
+  printTest ((take 7 ([(5::Int) .. 0])))
+  printTest ((take 7 ([(maxBound-(5::Int)) .. maxBound])))
+  printTest ((take 7 ([(minBound+(5::Int)) .. minBound])))
+
+     -- [x,y..z] aka enumFromThenTo
+  printTest ((take 7 [(5::Int),4..1]))
+  printTest ((take 7 [(5::Int),3..1]))
+  printTest ((take 7 [(5::Int),3..2]))
+  printTest ((take 7 [(1::Int),2..1]))
+  printTest ((take 7 [(2::Int),1..2]))
+  printTest ((take 7 [(2::Int),1..1]))
+  printTest ((take 7 [(2::Int),3..1]))
+
+	-- Test overflow conditions
+  printTest (([minBound, 1..maxBound::Int]))
+  printTest (([minBound, 0..maxBound::Int]))
+  printTest (([minBound,-1..maxBound::Int]))
+  printTest (([minBound,-1..maxBound-1::Int]))
+  printTest (([minBound,-1..maxBound-2::Int]))
+
+  printTest (([maxBound, 1..minBound::Int]))
+  printTest (([maxBound, 0..minBound::Int]))
+  printTest (([maxBound, 0..minBound+1::Int]))
+  printTest (([maxBound, 0..minBound+2::Int]))
+  printTest (([maxBound,-1..minBound::Int]))
+
+  let x = (maxBound::Int) - 4
+  printTest ((take 7 [x,(x+1)..maxBound]))
+  let x = (minBound::Int) + 5
+  printTest ((take 7 [x,(x-1)..minBound]))
+
+testEnumChar :: IO ()
+testEnumChar = do
+     -- succ
+  printTest ((succ 'a'))
+  printTest ((succ (minBound::Char)))
+  mayBomb (printTest ((succ (maxBound::Char))))
+
+     -- pred
+  printTest ((pred 'b'))
+  printTest (pred (maxBound::Char))
+  mayBomb (printTest (pred (minBound::Char)))
+
+     -- toEnum
+  printTest ((map (toEnum::Int->Char) [123,ord (minBound::Char), ord(maxBound::Char)]))
+  mayBomb (printTest ((toEnum::Int->Char) (minBound::Int)))
+
+     -- fromEnum
+  printTest ((map fromEnum ['X',minBound,maxBound]))
+
+     -- [x..] aka enumFrom
+  -- printTest ((take 7 ['\NUL' .. ]))
+  do{ putStr ( "    " ++ "(take 7 ['\\NUL' .. ])" ++ " = " ) ; print (take 7 ['\NUL' .. ]) }
+  -- printTest ((take 7 ['\250' .. ]))
+  do{ putStr ( "    " ++ "(take 7 ['\\250' .. ])" ++ " = " ) ; print (take 7 ['\250' .. ]) }
+  
+     -- [x,y..] aka enumFromThen
+  printTest ((take 7 ['a','b'..]))
+  printTest ((take 7 ['a','e'..]))
+  printTest ((take 7 ['a','a'..]))
+  printTest ((take 7 ['z','y'..]))
+  printTest ((take 7 ['z','v'..]))
+  let x = '\1'
+  -- printTest ((take 7 ['\1', '\0' ..]))
+  do{ putStr ( "    " ++ "(take 7 ['\\1', '\\0' ..])" ++ " = " ) ; print (take 7 ['\1', '\0' ..]) }
+  let x = '\5'
+  -- printTest ((take 7 ['\5', '\4' ..]))
+  do{ putStr ( "    " ++ "(take 7 ['\\5', '\\4' ..])" ++ " = " ) ; print (take 7 ['\5', '\4' ..]) }
+  let x = (maxBound::Int) - 5
+  -- printTest ((take 7 ['\250', '\251' ..]))
+  do{ putStr ( "    " ++ "(take 7 ['\\250', '\\251' ..])" ++ " = " ) ; print (take 7 ['\250', '\251' ..]) }
+
+     -- [x..y] aka enumFromTo
+  printTest ((take 7 (['a' .. 'e'])))
+  printTest ((take 4 (['a' .. 'a'])))
+  printTest ((take 7 (['b' .. 'a'])))
+  printTest ((take 7 (['e' .. 'a'])))
+  -- printTest ((take 7 (['\250' .. '\255'])))
+  do{ putStr ( "    " ++ "(take 7 (['\\250' .. '\\255']))" ++ " = " ) ; print (take 7 (['\250' .. '\255'])) }
+  -- printTest ((take 7 (['\5' .. '\0'])))
+  do{ putStr ( "    " ++ "(take 7 (['\\5' .. '\\0']))" ++ " = " ) ; print (take 7 (['\5' .. '\0'])) }
+
+     -- [x,y..z] aka enumFromThenTo
+  printTest ((take 7 ['f','e' .. 'b']))
+  printTest ((take 7 ['g','e' .. 'b']))
+  printTest ((take 7 ['g','d' .. 'c']))
+  printTest ((take 7 ['b','c' .. 'b']))
+  printTest ((take 7 ['c','b' .. 'c']))
+  printTest ((take 7 ['c','b' .. 'b']))
+  printTest ((take 7 ['c','d' .. 'b']))
+  -- printTest ((take 7 ['\251', '\252' .. maxBound]))
+  do{ putStr ( "    " ++ "(take 7 ['\\251', '\\252' .. maxBound])" ++ " = " ) ; print (take 7 ['\251', '\252' .. maxBound]) }
+  -- printTest ((take 7 ['\5', '\4' .. minBound]))
+  do{ putStr ( "    " ++ "(take 7 ['\\5', '\\4' .. minBound])" ++ " = " ) ; print (take 7 ['\5', '\4' .. minBound]) }
+
+
+testEnumUnit :: IO ()
+testEnumUnit = do
+   -- succ:
+  mayBomb (printTest ((succ ())))
+  mayBomb (printTest ((succ (minBound::()))))
+  mayBomb (printTest ((succ (maxBound::()))))
+       
+   -- pred:
+  mayBomb (printTest ((pred ())))
+  mayBomb (printTest ((pred (minBound::()))))
+  mayBomb (printTest ((pred (maxBound::()))))
+
+   -- toEnum:
+  printTest ((toEnum 0)::())
+  mayBomb   (printTest ((toEnum 1)::()))
+
+   -- fromEnum:
+  printTest ((fromEnum ()))
+
+   -- enumFrom:
+  printTest ((take 7 [()..]))
+
+   -- enumFromThen:
+  printTest ((take 7 [(),()..]))
+
+   -- enumFromTo
+  printTest ((take 7 [()..()]))
+
+   -- enumFromThenTo
+  printTest ((take 7 [(),()..()]))
+
+testEnumOrdering :: IO ()
+testEnumOrdering = do
+   -- succ:
+  printTest ((succ LT))
+  printTest ((succ (minBound::Ordering)))
+  mayBomb (printTest ((succ (maxBound::Ordering))))
+       
+   -- pred:
+  printTest ((pred GT))
+  printTest ((pred (maxBound::Ordering)))
+  mayBomb (printTest ((pred (minBound::Ordering))))
+
+   -- toEnum:
+  printTest ((toEnum 0)::Ordering)
+  mayBomb   (printTest ((toEnum 5)::Ordering))
+
+   -- fromEnum:
+  printTest ((fromEnum LT))
+  printTest ((fromEnum EQ))
+  printTest ((fromEnum GT))
+
+   -- enumFrom:
+  printTest (([LT ..]))
+  printTest (([EQ ..]))
+  printTest (([GT ..]))
+
+   -- enumFromThen:
+  printTest (([LT,EQ ..]))
+  printTest (([EQ,GT ..]))
+  printTest (([EQ,LT ..]))
+  printTest (([LT,GT ..]))
+  printTest (([GT,LT ..]))
+  printTest (take 7 (([GT,GT ..])))
+  printTest (take 7 (([LT,LT ..])))
+
+   -- enumFromTo
+  printTest (([LT .. GT]))
+  printTest (([LT .. EQ]))
+  printTest (([LT .. LT]))
+  printTest (([GT .. LT]))
+  printTest (([GT .. EQ]))
+  printTest (([GT .. GT]))
+
+   -- enumFromThenTo
+  printTest (([LT,EQ .. GT]))
+  printTest (([GT,EQ .. LT]))
+  printTest (([GT,EQ .. EQ]))
+  printTest (([GT,EQ .. GT]))
+  printTest (([GT,EQ .. LT]))
+  printTest (([LT,EQ .. LT]))
+  printTest (([LT,EQ .. GT]))
+  printTest (take 7 (([LT,LT .. GT])))
+  printTest (take 7 (([GT,GT .. LT])))
+
+testEnumBool :: IO ()
+testEnumBool = do
+   -- succ:
+  printTest ((succ False))
+  printTest ((succ (minBound::Bool)))
+  mayBomb (printTest ((succ (maxBound::Bool))))
+       
+   -- pred:
+  printTest ((pred True))
+  printTest ((pred (maxBound::Bool)))
+  mayBomb (printTest ((pred (minBound::Bool))))
+
+   -- toEnum:
+  printTest ((toEnum 0)::Bool)
+  mayBomb   (printTest ((toEnum 5)::Bool))
+
+   -- fromEnum:
+  printTest ((fromEnum False))
+  printTest ((fromEnum True))
+
+   -- enumFrom:
+  printTest (([False ..]))
+  printTest (([True ..]))
+
+   -- enumFromThen:
+  printTest (([False,True ..]))
+  printTest (([True,False ..]))
+  printTest ((take 7 ([False,False ..])))
+  printTest ((take 7 ([True,True ..])))
+
+   -- enumFromTo
+  printTest (([False .. True]))
+  printTest (([True .. False]))
+
+   -- enumFromThenTo
+  printTest (take 7 ([False,False .. False]))
+  printTest (take 7 ([False,False .. True]))
+  printTest (take 7 ([False,True .. False]))
+  printTest (take 7 ([False,True .. True]))
+  printTest (take 7 ([True,False .. False]))
+  printTest (take 7 ([True,False .. True]))
+  printTest (take 7 ([True,True .. False]))
+  printTest (take 7 ([True,True .. True]))
+
+
+testEnumInteger :: IO ()
+testEnumInteger = do
+     -- succ
+  printTest ((succ (0::Integer)))
+  printTest ((succ ((-1)::Integer)))
+
+     -- pred
+  printTest (pred (1::Integer))
+  printTest (pred (0::Integer))
+
+     -- toEnum
+  printTest ((map (toEnum::Int->Integer) [1,minBound,maxBound]))
+
+     -- fromEnum
+  printTest ((map fromEnum [(1::Integer),42,45]))
+
+     -- [x..] aka enumFrom
+  printTest ((take 7 [(1::Integer)..]))
+  printTest ((take 7 [(-5::Integer)..]))
+  
+     -- [x,y..] aka enumFromThen
+  printTest ((take 7 [(1::Integer),2..]))
+  printTest ((take 7 [(1::Integer),7..]))
+  printTest ((take 7 [(1::Integer),1..]))
+  printTest ((take 7 [(1::Integer),0..]))
+  printTest ((take 7 [(5::Integer),2..]))
+
+     -- [x..y] aka enumFromTo
+  printTest ((take 7 ([(1::Integer) .. 5])))
+  printTest ((take 4 ([(1::Integer) .. 1])))
+  printTest ((take 7 ([(1::Integer) .. 0])))
+  printTest ((take 7 ([(5::Integer) .. 0])))
+
+     -- [x,y..z] aka enumFromThenTo
+  printTest ((take 7 [(5::Integer),4..1]))
+  printTest ((take 7 [(5::Integer),3..1]))
+  printTest ((take 7 [(5::Integer),3..2]))
+  printTest ((take 7 [(1::Integer),2..1]))
+  printTest ((take 7 [(2::Integer),1..2]))
+  printTest ((take 7 [(2::Integer),1..1]))
+  printTest ((take 7 [(2::Integer),3..1]))
+
+testEnumRational :: IO ()
+testEnumRational = do
+     -- succ
+  printTest ((succ (0::Rational)))
+  printTest ((succ ((-1)::Rational)))
+
+     -- pred
+  printTest (pred (1::Rational))
+  printTest (pred (0::Rational))
+
+     -- toEnum
+  printTest ((map (toEnum::Int->Rational) [1,minBound,maxBound]))
+
+     -- fromEnum
+  printTest ((map fromEnum [(1::Rational),42,45]))
+
+     -- [x..] aka enumFrom
+  printTest ((take 7 [(1::Rational)..]))
+  printTest ((take 7 [(-5::Rational)..]))
+  
+     -- [x,y..] aka enumFromThen
+  printTest ((take 7 [(1::Rational),2..]))
+  printTest ((take 7 [(1::Rational),7..]))
+  printTest ((take 7 [(1::Rational),1..]))
+  printTest ((take 7 [(1::Rational),0..]))
+  printTest ((take 7 [(5::Rational),2..]))
+
+     -- [x..y] aka enumFromTo
+  printTest ((take 7 ([(1::Rational) .. 5])))
+  printTest ((take 4 ([(1::Rational) .. 1])))
+  printTest ((take 7 ([(1::Rational) .. 0])))
+  printTest ((take 7 ([(5::Rational) .. 0])))
+
+     -- [x,y..z] aka enumFromThenTo
+  printTest ((take 7 [(5::Rational),4..1]))
+  printTest ((take 7 [(5::Rational),3..1]))
+  printTest ((take 7 [(5::Rational),3..2]))
+  printTest ((take 7 [(1::Rational),2..1]))
+  printTest ((take 7 [(2::Rational),1..2]))
+  printTest ((take 7 [(2::Rational),1..1]))
+  printTest ((take 7 [(2::Rational),3..1]))
+
+testEnumRatioInt :: IO ()
+testEnumRatioInt = do
+     -- succ
+  printTest ((succ (0::Ratio Int)))
+  printTest ((succ ((-1)::Ratio Int)))
+
+     -- pred
+  printTest (pred (1::Ratio Int))
+  printTest (pred (0::Ratio Int))
+
+     -- toEnum
+  printTest ((map (toEnum::Int->Ratio Int) [1,minBound,maxBound]))
+
+     -- fromEnum
+  printTest ((map fromEnum [(1::Ratio Int),42,45]))
+
+     -- [x..] aka enumFrom
+  printTest ((take 7 [(1::Ratio Int)..]))
+  printTest ((take 7 [(-5::Ratio Int)..]))
+  printTest ((take 7 [((toEnum ((maxBound::Int)-5))::Ratio Int)..]))
+  
+     -- [x,y..] aka enumFromThen
+  printTest ((take 7 [(1::Ratio Int),2..]))
+  printTest ((take 7 [(1::Ratio Int),7..]))
+  printTest ((take 7 [(1::Ratio Int),1..]))
+  printTest ((take 7 [(1::Ratio Int),0..]))
+  printTest ((take 7 [(5::Ratio Int),2..]))
+  let x = (toEnum ((minBound::Int) + 1))::Ratio Int
+  printTest ((take 7 [x, x-1 ..]))
+  let x = (toEnum ((minBound::Int) + 5))::Ratio Int
+  printTest ((take 7 [x, x-1 ..]))
+  let x = (toEnum ((maxBound::Int) - 5))::Ratio Int
+  printTest ((take 7 [x, (x+1) ..]))
+
+     -- [x..y] aka enumFromTo
+  printTest ((take 7 ([(1::Ratio Int) .. 5])))
+  printTest ((take 4 ([(1::Ratio Int) .. 1])))
+  printTest ((take 7 ([(1::Ratio Int) .. 0])))
+  printTest ((take 7 ([(5::Ratio Int) .. 0])))
+  let x = (toEnum (maxBound - (5::Int))) :: Ratio Int
+  let y = (toEnum (maxBound::Int)) :: Ratio Int
+  printTest ((take 7 ([x..y])))
+  let x = (toEnum (minBound + (5::Int))) :: Ratio Int
+  let y = (toEnum (minBound::Int)) :: Ratio Int
+  printTest ((take 7 ([x..y])))
+
+     -- [x,y..z] aka enumFromThenTo
+  printTest ((take 7 [(5::Ratio Int),4..1]))
+  printTest ((take 7 [(5::Ratio Int),3..1]))
+  printTest ((take 7 [(5::Ratio Int),3..2]))
+  printTest ((take 7 [(1::Ratio Int),2..1]))
+  printTest ((take 7 [(2::Ratio Int),1..2]))
+  printTest ((take 7 [(2::Ratio Int),1..1]))
+  printTest ((take 7 [(2::Ratio Int),3..1]))
+
+  let x = (toEnum ((maxBound::Int) - 4)) :: Ratio Int
+  let y = (toEnum (maxBound::Int)) :: Ratio Int
+  printTest ((take 7 [x,(x+1)..y]))
+  let x = (toEnum ((minBound::Int) + 5)) :: Ratio Int
+  let y = (toEnum (minBound::Int)) :: Ratio Int
+  printTest ((take 7 [x,(x-1)..y]))
+
+--
+--
+--  Utils
+--
+--
+
+
+mayBomb x = catch x (\(ErrorCall e) -> putStrLn ("error " ++ show e))
+   `catch` (\e -> putStrLn ("Fail: " ++ show (e :: SomeException)))
+
+test :: Show a => String -> String -> a -> IO ()
+test test_nm expected val = do
+   putStr test_nm
+   if expected == got then
+      putStrLn ": SUCCEEDED"
+    else do
+      putStr   ": FAILED"
+      putStrLn ("( expected: " ++ show expected ++ " , got: " ++ show got ++ " )")
+  where
+   got = show val
diff --git a/libraries/base/tests/enum01.stdout b/libraries/base/tests/enum01.stdout
new file mode 100644
index 000000000000..71e5bd6d1adf
--- /dev/null
+++ b/libraries/base/tests/enum01.stdout
@@ -0,0 +1,246 @@
+Testing Enum Int: 
+    (succ (0::Int)) = 1
+    (succ (minBound::Int)) = -2147483647
+    (succ (maxBound::Int)) = error "Prelude.Enum.succ{Int}: tried to take `succ' of maxBound"
+    pred (1::Int) = 0
+    pred (maxBound::Int) = 2147483646
+    pred (minBound::Int) = error "Prelude.Enum.pred{Int}: tried to take `pred' of minBound"
+    (map (toEnum::Int->Int) [1,minBound,maxBound]) = [1,-2147483648,2147483647]
+    (map fromEnum [(1::Int),minBound,maxBound]) = [1,-2147483648,2147483647]
+    (take 7 [(1::Int)..]) = [1,2,3,4,5,6,7]
+    (take 7 [((maxBound::Int)-5)..]) = [2147483642,2147483643,2147483644,2147483645,2147483646,2147483647]
+    (take 7 [(1::Int),2..]) = [1,2,3,4,5,6,7]
+    (take 7 [(1::Int),7..]) = [1,7,13,19,25,31,37]
+    (take 7 [(1::Int),1..]) = [1,1,1,1,1,1,1]
+    (take 7 [(1::Int),0..]) = [1,0,-1,-2,-3,-4,-5]
+    (take 7 [(5::Int),2..]) = [5,2,-1,-4,-7,-10,-13]
+    (take 7 [x, x-1 ..]) = [-2147483647,-2147483648]
+    (take 7 [x, x-1 ..]) = [-2147483643,-2147483644,-2147483645,-2147483646,-2147483647,-2147483648]
+    (take 7 [x, (x+1) ..]) = [2147483642,2147483643,2147483644,2147483645,2147483646,2147483647]
+    ([minBound::Int,1..]) = [-2147483648,1]
+    ([minBound::Int,0..]) = [-2147483648,0]
+    ([minBound::Int,-1..]) = [-2147483648,-1,2147483646]
+    ([maxBound::Int,1..]) = [2147483647,1,-2147483645]
+    ([maxBound::Int,0..]) = [2147483647,0,-2147483647]
+    ([maxBound::Int,-1..]) = [2147483647,-1]
+    (take 7 ([(1::Int) .. 5])) = [1,2,3,4,5]
+    (take 4 ([(1::Int) .. 1])) = [1]
+    (take 7 ([(1::Int) .. 0])) = []
+    (take 7 ([(5::Int) .. 0])) = []
+    (take 7 ([(maxBound-(5::Int)) .. maxBound])) = [2147483642,2147483643,2147483644,2147483645,2147483646,2147483647]
+    (take 7 ([(minBound+(5::Int)) .. minBound])) = []
+    (take 7 [(5::Int),4..1]) = [5,4,3,2,1]
+    (take 7 [(5::Int),3..1]) = [5,3,1]
+    (take 7 [(5::Int),3..2]) = [5,3]
+    (take 7 [(1::Int),2..1]) = [1]
+    (take 7 [(2::Int),1..2]) = [2]
+    (take 7 [(2::Int),1..1]) = [2,1]
+    (take 7 [(2::Int),3..1]) = []
+    ([minBound, 1..maxBound::Int]) = [-2147483648,1]
+    ([minBound, 0..maxBound::Int]) = [-2147483648,0]
+    ([minBound,-1..maxBound::Int]) = [-2147483648,-1,2147483646]
+    ([minBound,-1..maxBound-1::Int]) = [-2147483648,-1,2147483646]
+    ([minBound,-1..maxBound-2::Int]) = [-2147483648,-1]
+    ([maxBound, 1..minBound::Int]) = [2147483647,1,-2147483645]
+    ([maxBound, 0..minBound::Int]) = [2147483647,0,-2147483647]
+    ([maxBound, 0..minBound+1::Int]) = [2147483647,0,-2147483647]
+    ([maxBound, 0..minBound+2::Int]) = [2147483647,0]
+    ([maxBound,-1..minBound::Int]) = [2147483647,-1]
+    (take 7 [x,(x+1)..maxBound]) = [2147483643,2147483644,2147483645,2147483646,2147483647]
+    (take 7 [x,(x-1)..minBound]) = [-2147483643,-2147483644,-2147483645,-2147483646,-2147483647,-2147483648]
+Testing Enum Integer: 
+    (succ (0::Integer)) = 1
+    (succ ((-1)::Integer)) = 0
+    pred (1::Integer) = 0
+    pred (0::Integer) = -1
+    (map (toEnum::Int->Integer) [1,minBound,maxBound]) = [1,-2147483648,2147483647]
+    (map fromEnum [(1::Integer),42,45]) = [1,42,45]
+    (take 7 [(1::Integer)..]) = [1,2,3,4,5,6,7]
+    (take 7 [(-5::Integer)..]) = [-5,-4,-3,-2,-1,0,1]
+    (take 7 [(1::Integer),2..]) = [1,2,3,4,5,6,7]
+    (take 7 [(1::Integer),7..]) = [1,7,13,19,25,31,37]
+    (take 7 [(1::Integer),1..]) = [1,1,1,1,1,1,1]
+    (take 7 [(1::Integer),0..]) = [1,0,-1,-2,-3,-4,-5]
+    (take 7 [(5::Integer),2..]) = [5,2,-1,-4,-7,-10,-13]
+    (take 7 ([(1::Integer) .. 5])) = [1,2,3,4,5]
+    (take 4 ([(1::Integer) .. 1])) = [1]
+    (take 7 ([(1::Integer) .. 0])) = []
+    (take 7 ([(5::Integer) .. 0])) = []
+    (take 7 [(5::Integer),4..1]) = [5,4,3,2,1]
+    (take 7 [(5::Integer),3..1]) = [5,3,1]
+    (take 7 [(5::Integer),3..2]) = [5,3]
+    (take 7 [(1::Integer),2..1]) = [1]
+    (take 7 [(2::Integer),1..2]) = [2]
+    (take 7 [(2::Integer),1..1]) = [2,1]
+    (take 7 [(2::Integer),3..1]) = []
+Testing Enum Char: 
+    (succ 'a') = 'b'
+    (succ (minBound::Char)) = '\SOH'
+    (succ (maxBound::Char)) = error "Prelude.Enum.Char.succ: bad argument"
+    (pred 'b') = 'a'
+    pred (maxBound::Char) = '\1114110'
+    pred (minBound::Char) = error "Prelude.Enum.Char.pred: bad argument"
+    (map (toEnum::Int->Char) [123,ord (minBound::Char), ord(maxBound::Char)]) = "{\NUL\1114111"
+    (toEnum::Int->Char) (minBound::Int) = error "Prelude.chr: bad argument: (-2147483648)"
+    (map fromEnum ['X',minBound,maxBound]) = [88,0,1114111]
+    (take 7 ['\NUL' .. ]) = "\NUL\SOH\STX\ETX\EOT\ENQ\ACK"
+    (take 7 ['\250' .. ]) = "\250\251\252\253\254\255\256"
+    (take 7 ['a','b'..]) = "abcdefg"
+    (take 7 ['a','e'..]) = "aeimquy"
+    (take 7 ['a','a'..]) = "aaaaaaa"
+    (take 7 ['z','y'..]) = "zyxwvut"
+    (take 7 ['z','v'..]) = "zvrnjfb"
+    (take 7 ['\1', '\0' ..]) = "\SOH\NUL"
+    (take 7 ['\5', '\4' ..]) = "\ENQ\EOT\ETX\STX\SOH\NUL"
+    (take 7 ['\250', '\251' ..]) = "\250\251\252\253\254\255\256"
+    (take 7 (['a' .. 'e'])) = "abcde"
+    (take 4 (['a' .. 'a'])) = "a"
+    (take 7 (['b' .. 'a'])) = ""
+    (take 7 (['e' .. 'a'])) = ""
+    (take 7 (['\250' .. '\255'])) = "\250\251\252\253\254\255"
+    (take 7 (['\5' .. '\0'])) = ""
+    (take 7 ['f','e' .. 'b']) = "fedcb"
+    (take 7 ['g','e' .. 'b']) = "gec"
+    (take 7 ['g','d' .. 'c']) = "gd"
+    (take 7 ['b','c' .. 'b']) = "b"
+    (take 7 ['c','b' .. 'c']) = "c"
+    (take 7 ['c','b' .. 'b']) = "cb"
+    (take 7 ['c','d' .. 'b']) = ""
+    (take 7 ['\251', '\252' .. maxBound]) = "\251\252\253\254\255\256\257"
+    (take 7 ['\5', '\4' .. minBound]) = "\ENQ\EOT\ETX\STX\SOH\NUL"
+Testing Enum (): 
+    (succ ()) = error "Prelude.Enum.().succ: bad argument"
+    (succ (minBound::())) = error "Prelude.Enum.().succ: bad argument"
+    (succ (maxBound::())) = error "Prelude.Enum.().succ: bad argument"
+    (pred ()) = error "Prelude.Enum.().pred: bad argument"
+    (pred (minBound::())) = error "Prelude.Enum.().pred: bad argument"
+    (pred (maxBound::())) = error "Prelude.Enum.().pred: bad argument"
+    (toEnum 0)::() = ()
+    (toEnum 1)::() = error "Prelude.Enum.().toEnum: bad argument"
+    (fromEnum ()) = 0
+    (take 7 [()..]) = [()]
+    (take 7 [(),()..]) = [(),(),(),(),(),(),()]
+    (take 7 [()..()]) = [()]
+    (take 7 [(),()..()]) = [(),(),(),(),(),(),()]
+Testing Enum Ordering (derived): 
+    (succ LT) = EQ
+    (succ (minBound::Ordering)) = EQ
+    (succ (maxBound::Ordering)) = error "Prelude.Enum.Ordering.succ: bad argument"
+    (pred GT) = EQ
+    (pred (maxBound::Ordering)) = EQ
+    (pred (minBound::Ordering)) = error "Prelude.Enum.Ordering.pred: bad argument"
+    (toEnum 0)::Ordering = LT
+    (toEnum 5)::Ordering = error "Prelude.Enum.Ordering.toEnum: bad argument"
+    (fromEnum LT) = 0
+    (fromEnum EQ) = 1
+    (fromEnum GT) = 2
+    ([LT ..]) = [LT,EQ,GT]
+    ([EQ ..]) = [EQ,GT]
+    ([GT ..]) = [GT]
+    ([LT,EQ ..]) = [LT,EQ,GT]
+    ([EQ,GT ..]) = [EQ,GT]
+    ([EQ,LT ..]) = [EQ,LT]
+    ([LT,GT ..]) = [LT,GT]
+    ([GT,LT ..]) = [GT,LT]
+    take 7 (([GT,GT ..])) = [GT,GT,GT,GT,GT,GT,GT]
+    take 7 (([LT,LT ..])) = [LT,LT,LT,LT,LT,LT,LT]
+    ([LT .. GT]) = [LT,EQ,GT]
+    ([LT .. EQ]) = [LT,EQ]
+    ([LT .. LT]) = [LT]
+    ([GT .. LT]) = []
+    ([GT .. EQ]) = []
+    ([GT .. GT]) = [GT]
+    ([LT,EQ .. GT]) = [LT,EQ,GT]
+    ([GT,EQ .. LT]) = [GT,EQ,LT]
+    ([GT,EQ .. EQ]) = [GT,EQ]
+    ([GT,EQ .. GT]) = [GT]
+    ([GT,EQ .. LT]) = [GT,EQ,LT]
+    ([LT,EQ .. LT]) = [LT]
+    ([LT,EQ .. GT]) = [LT,EQ,GT]
+    take 7 (([LT,LT .. GT])) = [LT,LT,LT,LT,LT,LT,LT]
+    take 7 (([GT,GT .. LT])) = []
+Testing Enum Bool: 
+    (succ False) = True
+    (succ (minBound::Bool)) = True
+    (succ (maxBound::Bool)) = error "Prelude.Enum.Bool.succ: bad argument"
+    (pred True) = False
+    (pred (maxBound::Bool)) = False
+    (pred (minBound::Bool)) = error "Prelude.Enum.Bool.pred: bad argument"
+    (toEnum 0)::Bool = False
+    (toEnum 5)::Bool = error "Prelude.Enum.Bool.toEnum: bad argument"
+    (fromEnum False) = 0
+    (fromEnum True) = 1
+    ([False ..]) = [False,True]
+    ([True ..]) = [True]
+    ([False,True ..]) = [False,True]
+    ([True,False ..]) = [True,False]
+    (take 7 ([False,False ..])) = [False,False,False,False,False,False,False]
+    (take 7 ([True,True ..])) = [True,True,True,True,True,True,True]
+    ([False .. True]) = [False,True]
+    ([True .. False]) = []
+    take 7 ([False,False .. False]) = [False,False,False,False,False,False,False]
+    take 7 ([False,False .. True]) = [False,False,False,False,False,False,False]
+    take 7 ([False,True .. False]) = [False]
+    take 7 ([False,True .. True]) = [False,True]
+    take 7 ([True,False .. False]) = [True,False]
+    take 7 ([True,False .. True]) = [True]
+    take 7 ([True,True .. False]) = []
+    take 7 ([True,True .. True]) = [True,True,True,True,True,True,True]
+Testing Enum Rational: 
+    (succ (0::Rational)) = 1 % 1
+    (succ ((-1)::Rational)) = 0 % 1
+    pred (1::Rational) = 0 % 1
+    pred (0::Rational) = (-1) % 1
+    (map (toEnum::Int->Rational) [1,minBound,maxBound]) = [1 % 1,(-2147483648) % 1,2147483647 % 1]
+    (map fromEnum [(1::Rational),42,45]) = [1,42,45]
+    (take 7 [(1::Rational)..]) = [1 % 1,2 % 1,3 % 1,4 % 1,5 % 1,6 % 1,7 % 1]
+    (take 7 [(-5::Rational)..]) = [(-5) % 1,(-4) % 1,(-3) % 1,(-2) % 1,(-1) % 1,0 % 1,1 % 1]
+    (take 7 [(1::Rational),2..]) = [1 % 1,2 % 1,3 % 1,4 % 1,5 % 1,6 % 1,7 % 1]
+    (take 7 [(1::Rational),7..]) = [1 % 1,7 % 1,13 % 1,19 % 1,25 % 1,31 % 1,37 % 1]
+    (take 7 [(1::Rational),1..]) = [1 % 1,1 % 1,1 % 1,1 % 1,1 % 1,1 % 1,1 % 1]
+    (take 7 [(1::Rational),0..]) = [1 % 1,0 % 1,(-1) % 1,(-2) % 1,(-3) % 1,(-4) % 1,(-5) % 1]
+    (take 7 [(5::Rational),2..]) = [5 % 1,2 % 1,(-1) % 1,(-4) % 1,(-7) % 1,(-10) % 1,(-13) % 1]
+    (take 7 ([(1::Rational) .. 5])) = [1 % 1,2 % 1,3 % 1,4 % 1,5 % 1]
+    (take 4 ([(1::Rational) .. 1])) = [1 % 1]
+    (take 7 ([(1::Rational) .. 0])) = []
+    (take 7 ([(5::Rational) .. 0])) = []
+    (take 7 [(5::Rational),4..1]) = [5 % 1,4 % 1,3 % 1,2 % 1,1 % 1]
+    (take 7 [(5::Rational),3..1]) = [5 % 1,3 % 1,1 % 1]
+    (take 7 [(5::Rational),3..2]) = [5 % 1,3 % 1,1 % 1]
+    (take 7 [(1::Rational),2..1]) = [1 % 1]
+    (take 7 [(2::Rational),1..2]) = [2 % 1]
+    (take 7 [(2::Rational),1..1]) = [2 % 1,1 % 1]
+    (take 7 [(2::Rational),3..1]) = []
+Testing Enum (Ratio Int): 
+    (succ (0::Ratio Int)) = 1 % 1
+    (succ ((-1)::Ratio Int)) = 0 % 1
+    pred (1::Ratio Int) = 0 % 1
+    pred (0::Ratio Int) = (-1) % 1
+    (map (toEnum::Int->Ratio Int) [1,minBound,maxBound]) = [1 % 1,(-2147483648) % 1,2147483647 % 1]
+    (map fromEnum [(1::Ratio Int),42,45]) = [1,42,45]
+    (take 7 [(1::Ratio Int)..]) = [1 % 1,2 % 1,3 % 1,4 % 1,5 % 1,6 % 1,7 % 1]
+    (take 7 [(-5::Ratio Int)..]) = [(-5) % 1,(-4) % 1,(-3) % 1,(-2) % 1,(-1) % 1,0 % 1,1 % 1]
+    (take 7 [((toEnum ((maxBound::Int)-5))::Ratio Int)..]) = [2147483642 % 1,2147483643 % 1,2147483644 % 1,2147483645 % 1,2147483646 % 1,2147483647 % 1,(-2147483648) % 1]
+    (take 7 [(1::Ratio Int),2..]) = [1 % 1,2 % 1,3 % 1,4 % 1,5 % 1,6 % 1,7 % 1]
+    (take 7 [(1::Ratio Int),7..]) = [1 % 1,7 % 1,13 % 1,19 % 1,25 % 1,31 % 1,37 % 1]
+    (take 7 [(1::Ratio Int),1..]) = [1 % 1,1 % 1,1 % 1,1 % 1,1 % 1,1 % 1,1 % 1]
+    (take 7 [(1::Ratio Int),0..]) = [1 % 1,0 % 1,(-1) % 1,(-2) % 1,(-3) % 1,(-4) % 1,(-5) % 1]
+    (take 7 [(5::Ratio Int),2..]) = [5 % 1,2 % 1,(-1) % 1,(-4) % 1,(-7) % 1,(-10) % 1,(-13) % 1]
+    (take 7 [x, x-1 ..]) = [(-2147483647) % 1,(-2147483648) % 1,2147483647 % 1,2147483646 % 1,2147483645 % 1,2147483644 % 1,2147483643 % 1]
+    (take 7 [x, x-1 ..]) = [(-2147483643) % 1,(-2147483644) % 1,(-2147483645) % 1,(-2147483646) % 1,(-2147483647) % 1,(-2147483648) % 1,2147483647 % 1]
+    (take 7 [x, (x+1) ..]) = [2147483642 % 1,2147483643 % 1,2147483644 % 1,2147483645 % 1,2147483646 % 1,2147483647 % 1,(-2147483648) % 1]
+    (take 7 ([(1::Ratio Int) .. 5])) = [1 % 1,2 % 1,3 % 1,4 % 1,5 % 1]
+    (take 4 ([(1::Ratio Int) .. 1])) = [1 % 1]
+    (take 7 ([(1::Ratio Int) .. 0])) = []
+    (take 7 ([(5::Ratio Int) .. 0])) = []
+    (take 7 ([x..y])) = [2147483642 % 1,2147483643 % 1,2147483644 % 1,2147483645 % 1,2147483646 % 1,2147483647 % 1]
+    (take 7 ([x..y])) = []
+    (take 7 [(5::Ratio Int),4..1]) = [5 % 1,4 % 1,3 % 1,2 % 1,1 % 1]
+    (take 7 [(5::Ratio Int),3..1]) = [5 % 1,3 % 1,1 % 1]
+    (take 7 [(5::Ratio Int),3..2]) = [5 % 1,3 % 1,1 % 1]
+    (take 7 [(1::Ratio Int),2..1]) = [1 % 1]
+    (take 7 [(2::Ratio Int),1..2]) = [2 % 1]
+    (take 7 [(2::Ratio Int),1..1]) = [2 % 1,1 % 1]
+    (take 7 [(2::Ratio Int),3..1]) = []
+    (take 7 [x,(x+1)..y]) = [2147483643 % 1,2147483644 % 1,2147483645 % 1,2147483646 % 1,2147483647 % 1]
+    (take 7 [x,(x-1)..y]) = [(-2147483643) % 1,(-2147483644) % 1,(-2147483645) % 1,(-2147483646) % 1,(-2147483647) % 1,(-2147483648) % 1]
diff --git a/libraries/base/tests/enum01.stdout-alpha-dec-osf3 b/libraries/base/tests/enum01.stdout-alpha-dec-osf3
new file mode 100644
index 000000000000..63ba3e2fb38d
--- /dev/null
+++ b/libraries/base/tests/enum01.stdout-alpha-dec-osf3
@@ -0,0 +1,230 @@
+Testing Enum Int: 
+    (succ (0::Int)) = 1
+    (succ (minBound::Int)) = -9223372036854775807
+    (succ (maxBound::Int)) = error "Prelude.Enum.succ{Int}: tried to take `succ' of maxBound"
+    pred (1::Int) = 0
+    pred (maxBound::Int) = 9223372036854775806
+    pred (minBound::Int) = error "Prelude.Enum.pred{Int}: tried to take `pred' of minBound"
+    (map (toEnum::Int->Int) [1,minBound,maxBound]) = [1,-9223372036854775808,9223372036854775807]
+    (map fromEnum [(1::Int),minBound,maxBound]) = [1,-9223372036854775808,9223372036854775807]
+    (take 7 [(1::Int)..]) = [1,2,3,4,5,6,7]
+    (take 7 [((maxBound::Int)-5)..]) = [9223372036854775802,9223372036854775803,9223372036854775804,9223372036854775805,9223372036854775806,9223372036854775807]
+    (take 7 [(1::Int),2..]) = [1,2,3,4,5,6,7]
+    (take 7 [(1::Int),7..]) = [1,7,13,19,25,31,37]
+    (take 7 [(1::Int),1..]) = [1,1,1,1,1,1,1]
+    (take 7 [(1::Int),0..]) = [1,0,-1,-2,-3,-4,-5]
+    (take 7 [(5::Int),2..]) = [5,2,-1,-4,-7,-10,-13]
+    (take 7 [x, x-1 ..]) = [-9223372036854775807,-9223372036854775808]
+    (take 7 [x, x-1 ..]) = [-9223372036854775803,-9223372036854775804,-9223372036854775805,-9223372036854775806,-9223372036854775807,-9223372036854775808]
+    (take 7 [x, (x+1) ..]) = [9223372036854775802,9223372036854775803,9223372036854775804,9223372036854775805,9223372036854775806,9223372036854775807]
+    (take 7 ([(1::Int) .. 5])) = [1,2,3,4,5]
+    (take 4 ([(1::Int) .. 1])) = [1]
+    (take 7 ([(1::Int) .. 0])) = []
+    (take 7 ([(5::Int) .. 0])) = []
+    (take 7 ([(maxBound-(5::Int)) .. maxBound])) = [9223372036854775802,9223372036854775803,9223372036854775804,9223372036854775805,9223372036854775806,9223372036854775807]
+    (take 7 ([(minBound+(5::Int)) .. minBound])) = []
+    (take 7 [(5::Int),4..1]) = [5,4,3,2,1]
+    (take 7 [(5::Int),3..1]) = [5,3,1]
+    (take 7 [(5::Int),3..2]) = [5,3]
+    (take 7 [(1::Int),2..1]) = [1]
+    (take 7 [(2::Int),1..2]) = [2]
+    (take 7 [(2::Int),1..1]) = [2,1]
+    (take 7 [(2::Int),3..1]) = []
+    (take 7 [x,(x+1)..maxBound]) = [9223372036854775803,9223372036854775804,9223372036854775805,9223372036854775806,9223372036854775807]
+    (take 7 [x,(x-1)..minBound]) = [-9223372036854775803,-9223372036854775804,-9223372036854775805,-9223372036854775806,-9223372036854775807,-9223372036854775808]
+Testing Enum Integer: 
+    (succ (0::Integer)) = 1
+    (succ ((-1)::Integer)) = 0
+    pred (1::Integer) = 0
+    pred (0::Integer) = -1
+    (map (toEnum::Int->Integer) [1,minBound,maxBound]) = [1,-9223372036854775808,9223372036854775807]
+    (map fromEnum [(1::Integer),42,45]) = [1,42,45]
+    (take 7 [(1::Integer)..]) = [1,2,3,4,5,6,7]
+    (take 7 [(-5::Integer)..]) = [-5,-4,-3,-2,-1,0,1]
+    (take 7 [(1::Integer),2..]) = [1,2,3,4,5,6,7]
+    (take 7 [(1::Integer),7..]) = [1,7,13,19,25,31,37]
+    (take 7 [(1::Integer),1..]) = [1,1,1,1,1,1,1]
+    (take 7 [(1::Integer),0..]) = [1,0,-1,-2,-3,-4,-5]
+    (take 7 [(5::Integer),2..]) = [5,2,-1,-4,-7,-10,-13]
+    (take 7 ([(1::Integer) .. 5])) = [1,2,3,4,5]
+    (take 4 ([(1::Integer) .. 1])) = [1]
+    (take 7 ([(1::Integer) .. 0])) = []
+    (take 7 ([(5::Integer) .. 0])) = []
+    (take 7 [(5::Integer),4..1]) = [5,4,3,2,1]
+    (take 7 [(5::Integer),3..1]) = [5,3,1]
+    (take 7 [(5::Integer),3..2]) = [5,3]
+    (take 7 [(1::Integer),2..1]) = [1]
+    (take 7 [(2::Integer),1..2]) = [2]
+    (take 7 [(2::Integer),1..1]) = [2,1]
+    (take 7 [(2::Integer),3..1]) = []
+Testing Enum Char: 
+    (succ 'a') = 'b'
+    (succ (minBound::Char)) = '\SOH'
+    (succ (maxBound::Char)) = error "Prelude.Enum.Char.succ: bad argument"
+    (pred 'b') = 'a'
+    pred (maxBound::Char) = '\1114110'
+    pred (minBound::Char) = error "Prelude.Enum.Char.pred: bad argument"
+    (map (toEnum::Int->Char) [123,ord (minBound::Char), ord(maxBound::Char)]) = "{\NUL\1114111"
+    (toEnum::Int->Char) (minBound::Int) = error "Prelude.chr: bad argument"
+    (map fromEnum ['X',minBound,maxBound]) = [88,0,1114111]
+    (take 7 ['\NUL' .. ]) = "\NUL\SOH\STX\ETX\EOT\ENQ\ACK"
+    (take 7 ['\250' .. ]) = "\250\251\252\253\254\255\256"
+    (take 7 ['a','b'..]) = "abcdefg"
+    (take 7 ['a','e'..]) = "aeimquy"
+    (take 7 ['a','a'..]) = "aaaaaaa"
+    (take 7 ['z','y'..]) = "zyxwvut"
+    (take 7 ['z','v'..]) = "zvrnjfb"
+    (take 7 ['\1', '\0' ..]) = "\SOH\NUL"
+    (take 7 ['\5', '\4' ..]) = "\ENQ\EOT\ETX\STX\SOH\NUL"
+    (take 7 ['\250', '\251' ..]) = "\250\251\252\253\254\255\256"
+    (take 7 (['a' .. 'e'])) = "abcde"
+    (take 4 (['a' .. 'a'])) = "a"
+    (take 7 (['b' .. 'a'])) = ""
+    (take 7 (['e' .. 'a'])) = ""
+    (take 7 (['\250' .. '\255'])) = "\250\251\252\253\254\255"
+    (take 7 (['\5' .. '\0'])) = ""
+    (take 7 ['f','e' .. 'b']) = "fedcb"
+    (take 7 ['g','e' .. 'b']) = "gec"
+    (take 7 ['g','d' .. 'c']) = "gd"
+    (take 7 ['b','c' .. 'b']) = "b"
+    (take 7 ['c','b' .. 'c']) = "c"
+    (take 7 ['c','b' .. 'b']) = "cb"
+    (take 7 ['c','d' .. 'b']) = ""
+    (take 7 ['\251', '\252' .. maxBound]) = "\251\252\253\254\255\256\257"
+    (take 7 ['\5', '\4' .. minBound]) = "\ENQ\EOT\ETX\STX\SOH\NUL"
+Testing Enum (): 
+    (succ ()) = error "Prelude.Enum.().succ: bad argument"
+    (succ (minBound::())) = error "Prelude.Enum.().succ: bad argument"
+    (succ (maxBound::())) = error "Prelude.Enum.().succ: bad argument"
+    (pred ()) = error "Prelude.Enum.().pred: bad argument"
+    (pred (minBound::())) = error "Prelude.Enum.().pred: bad argument"
+    (pred (maxBound::())) = error "Prelude.Enum.().pred: bad argument"
+    (toEnum 0)::() = ()
+    (toEnum 1)::() = error "Prelude.Enum.().toEnum: bad argument"
+    (fromEnum ()) = 0
+    (take 7 [()..]) = [()]
+    (take 7 [(),()..]) = [(),(),(),(),(),(),()]
+    (take 7 [()..()]) = [()]
+    (take 7 [(),()..()]) = [(),(),(),(),(),(),()]
+Testing Enum Ordering (derived): 
+    (succ LT) = EQ
+    (succ (minBound::Ordering)) = EQ
+    (succ (maxBound::Ordering)) = error "Prelude.Enum.Ordering.succ: bad argument"
+    (pred GT) = EQ
+    (pred (maxBound::Ordering)) = EQ
+    (pred (minBound::Ordering)) = error "Prelude.Enum.Ordering.pred: bad argument"
+    (toEnum 0)::Ordering = LT
+    (toEnum 5)::Ordering = error "Prelude.Enum.Ordering.toEnum: bad argument"
+    (fromEnum LT) = 0
+    (fromEnum EQ) = 1
+    (fromEnum GT) = 2
+    ([LT ..]) = [LT,EQ,GT]
+    ([EQ ..]) = [EQ,GT]
+    ([GT ..]) = [GT]
+    ([LT,EQ ..]) = [LT,EQ,GT]
+    ([EQ,GT ..]) = [EQ,GT]
+    ([EQ,LT ..]) = [EQ,LT]
+    ([LT,GT ..]) = [LT,GT]
+    ([GT,LT ..]) = [GT,LT]
+    take 7 (([GT,GT ..])) = [GT,GT,GT,GT,GT,GT,GT]
+    take 7 (([LT,LT ..])) = [LT,LT,LT,LT,LT,LT,LT]
+    ([LT .. GT]) = [LT,EQ,GT]
+    ([LT .. EQ]) = [LT,EQ]
+    ([LT .. LT]) = [LT]
+    ([GT .. LT]) = []
+    ([GT .. EQ]) = []
+    ([GT .. GT]) = [GT]
+    ([LT,EQ .. GT]) = [LT,EQ,GT]
+    ([GT,EQ .. LT]) = [GT,EQ,LT]
+    ([GT,EQ .. EQ]) = [GT,EQ]
+    ([GT,EQ .. GT]) = [GT]
+    ([GT,EQ .. LT]) = [GT,EQ,LT]
+    ([LT,EQ .. LT]) = [LT]
+    ([LT,EQ .. GT]) = [LT,EQ,GT]
+    take 7 (([LT,LT .. GT])) = [LT,LT,LT,LT,LT,LT,LT]
+    take 7 (([GT,GT .. LT])) = []
+Testing Enum Bool: 
+    (succ False) = True
+    (succ (minBound::Bool)) = True
+    (succ (maxBound::Bool)) = error "Prelude.Enum.Bool.succ: bad argument"
+    (pred True) = False
+    (pred (maxBound::Bool)) = False
+    (pred (minBound::Bool)) = error "Prelude.Enum.Bool.pred: bad argument"
+    (toEnum 0)::Bool = False
+    (toEnum 5)::Bool = error "Prelude.Enum.Bool.toEnum: bad argument"
+    (fromEnum False) = 0
+    (fromEnum True) = 1
+    ([False ..]) = [False,True]
+    ([True ..]) = [True]
+    ([False,True ..]) = [False,True]
+    ([True,False ..]) = [True,False]
+    (take 7 ([False,False ..])) = [False,False,False,False,False,False,False]
+    (take 7 ([True,True ..])) = [True,True,True,True,True,True,True]
+    ([False .. True]) = [False,True]
+    ([True .. False]) = []
+    take 7 ([False,False .. False]) = [False,False,False,False,False,False,False]
+    take 7 ([False,False .. True]) = [False,False,False,False,False,False,False]
+    take 7 ([False,True .. False]) = [False]
+    take 7 ([False,True .. True]) = [False,True]
+    take 7 ([True,False .. False]) = [True,False]
+    take 7 ([True,False .. True]) = [True]
+    take 7 ([True,True .. False]) = []
+    take 7 ([True,True .. True]) = [True,True,True,True,True,True,True]
+Testing Enum Rational: 
+    (succ (0::Rational)) = 1%1
+    (succ ((-1)::Rational)) = 0%1
+    pred (1::Rational) = 0%1
+    pred (0::Rational) = (-1)%1
+    (map (toEnum::Int->Rational) [1,minBound,maxBound]) = [1%1,(-9223372036854775808)%1,9223372036854775807%1]
+    (map fromEnum [(1::Rational),42,45]) = [1,42,45]
+    (take 7 [(1::Rational)..]) = [1%1,2%1,3%1,4%1,5%1,6%1,7%1]
+    (take 7 [(-5::Rational)..]) = [(-5)%1,(-4)%1,(-3)%1,(-2)%1,(-1)%1,0%1,1%1]
+    (take 7 [(1::Rational),2..]) = [1%1,2%1,3%1,4%1,5%1,6%1,7%1]
+    (take 7 [(1::Rational),7..]) = [1%1,7%1,13%1,19%1,25%1,31%1,37%1]
+    (take 7 [(1::Rational),1..]) = [1%1,1%1,1%1,1%1,1%1,1%1,1%1]
+    (take 7 [(1::Rational),0..]) = [1%1,0%1,(-1)%1,(-2)%1,(-3)%1,(-4)%1,(-5)%1]
+    (take 7 [(5::Rational),2..]) = [5%1,2%1,(-1)%1,(-4)%1,(-7)%1,(-10)%1,(-13)%1]
+    (take 7 ([(1::Rational) .. 5])) = [1%1,2%1,3%1,4%1,5%1]
+    (take 4 ([(1::Rational) .. 1])) = [1%1]
+    (take 7 ([(1::Rational) .. 0])) = []
+    (take 7 ([(5::Rational) .. 0])) = []
+    (take 7 [(5::Rational),4..1]) = [5%1,4%1,3%1,2%1,1%1]
+    (take 7 [(5::Rational),3..1]) = [5%1,3%1,1%1]
+    (take 7 [(5::Rational),3..2]) = [5%1,3%1,1%1]
+    (take 7 [(1::Rational),2..1]) = [1%1]
+    (take 7 [(2::Rational),1..2]) = [2%1]
+    (take 7 [(2::Rational),1..1]) = [2%1,1%1]
+    (take 7 [(2::Rational),3..1]) = []
+Testing Enum (Ratio Int): 
+    (succ (0::Ratio Int)) = 1%1
+    (succ ((-1)::Ratio Int)) = 0%1
+    pred (1::Ratio Int) = 0%1
+    pred (0::Ratio Int) = (-1)%1
+    (map (toEnum::Int->Ratio Int) [1,minBound,maxBound]) = [1%1,(-9223372036854775808)%1,9223372036854775807%1]
+    (map fromEnum [(1::Ratio Int),42,45]) = [1,42,45]
+    (take 7 [(1::Ratio Int)..]) = [1%1,2%1,3%1,4%1,5%1,6%1,7%1]
+    (take 7 [(-5::Ratio Int)..]) = [(-5)%1,(-4)%1,(-3)%1,(-2)%1,(-1)%1,0%1,1%1]
+    (take 7 [((toEnum ((maxBound::Int)-5))::Ratio Int)..]) = [9223372036854775802%1,9223372036854775803%1,9223372036854775804%1,9223372036854775805%1,9223372036854775806%1,9223372036854775807%1,(-9223372036854775808)%1]
+    (take 7 [(1::Ratio Int),2..]) = [1%1,2%1,3%1,4%1,5%1,6%1,7%1]
+    (take 7 [(1::Ratio Int),7..]) = [1%1,7%1,13%1,19%1,25%1,31%1,37%1]
+    (take 7 [(1::Ratio Int),1..]) = [1%1,1%1,1%1,1%1,1%1,1%1,1%1]
+    (take 7 [(1::Ratio Int),0..]) = [1%1,0%1,(-1)%1,(-2)%1,(-3)%1,(-4)%1,(-5)%1]
+    (take 7 [(5::Ratio Int),2..]) = [5%1,2%1,(-1)%1,(-4)%1,(-7)%1,(-10)%1,(-13)%1]
+    (take 7 [x, x-1 ..]) = [(-9223372036854775807)%1,(-9223372036854775808)%1,9223372036854775807%1,9223372036854775806%1,9223372036854775805%1,9223372036854775804%1,9223372036854775803%1]
+    (take 7 [x, x-1 ..]) = [(-9223372036854775803)%1,(-9223372036854775804)%1,(-9223372036854775805)%1,(-9223372036854775806)%1,(-9223372036854775807)%1,(-9223372036854775808)%1,9223372036854775807%1]
+    (take 7 [x, (x+1) ..]) = [9223372036854775802%1,9223372036854775803%1,9223372036854775804%1,9223372036854775805%1,9223372036854775806%1,9223372036854775807%1,(-9223372036854775808)%1]
+    (take 7 ([(1::Ratio Int) .. 5])) = [1%1,2%1,3%1,4%1,5%1]
+    (take 4 ([(1::Ratio Int) .. 1])) = [1%1]
+    (take 7 ([(1::Ratio Int) .. 0])) = []
+    (take 7 ([(5::Ratio Int) .. 0])) = []
+    (take 7 ([x..y])) = [9223372036854775802%1,9223372036854775803%1,9223372036854775804%1,9223372036854775805%1,9223372036854775806%1,9223372036854775807%1]
+    (take 7 ([x..y])) = []
+    (take 7 [(5::Ratio Int),4..1]) = [5%1,4%1,3%1,2%1,1%1]
+    (take 7 [(5::Ratio Int),3..1]) = [5%1,3%1,1%1]
+    (take 7 [(5::Ratio Int),3..2]) = [5%1,3%1,1%1]
+    (take 7 [(1::Ratio Int),2..1]) = [1%1]
+    (take 7 [(2::Ratio Int),1..2]) = [2%1]
+    (take 7 [(2::Ratio Int),1..1]) = [2%1,1%1]
+    (take 7 [(2::Ratio Int),3..1]) = []
+    (take 7 [x,(x+1)..y]) = [9223372036854775803%1,9223372036854775804%1,9223372036854775805%1,9223372036854775806%1,9223372036854775807%1]
+    (take 7 [x,(x-1)..y]) = [(-9223372036854775803)%1,(-9223372036854775804)%1,(-9223372036854775805)%1,(-9223372036854775806)%1,(-9223372036854775807)%1,(-9223372036854775808)%1]
diff --git a/libraries/base/tests/enum01.stdout-hugs b/libraries/base/tests/enum01.stdout-hugs
new file mode 100644
index 000000000000..41bb64d59861
--- /dev/null
+++ b/libraries/base/tests/enum01.stdout-hugs
@@ -0,0 +1,246 @@
+Testing Enum Int: 
+    (succ (0::Int)) = 1
+    (succ (minBound::Int)) = -2147483647
+    (succ (maxBound::Int)) = error "succ: applied to maxBound"
+    pred (1::Int) = 0
+    pred (maxBound::Int) = 2147483646
+    pred (minBound::Int) = error "pred: applied to minBound"
+    (map (toEnum::Int->Int) [1,minBound,maxBound]) = [1,-2147483648,2147483647]
+    (map fromEnum [(1::Int),minBound,maxBound]) = [1,-2147483648,2147483647]
+    (take 7 [(1::Int)..]) = [1,2,3,4,5,6,7]
+    (take 7 [((maxBound::Int)-5)..]) = [2147483642,2147483643,2147483644,2147483645,2147483646,2147483647]
+    (take 7 [(1::Int),2..]) = [1,2,3,4,5,6,7]
+    (take 7 [(1::Int),7..]) = [1,7,13,19,25,31,37]
+    (take 7 [(1::Int),1..]) = [1,1,1,1,1,1,1]
+    (take 7 [(1::Int),0..]) = [1,0,-1,-2,-3,-4,-5]
+    (take 7 [(5::Int),2..]) = [5,2,-1,-4,-7,-10,-13]
+    (take 7 [x, x-1 ..]) = [-2147483647,-2147483648]
+    (take 7 [x, x-1 ..]) = [-2147483643,-2147483644,-2147483645,-2147483646,-2147483647,-2147483648]
+    (take 7 [x, (x+1) ..]) = [2147483642,2147483643,2147483644,2147483645,2147483646,2147483647]
+    ([minBound::Int,1..]) = [-2147483648,1]
+    ([minBound::Int,0..]) = [-2147483648,0]
+    ([minBound::Int,-1..]) = [-2147483648,-1,2147483646]
+    ([maxBound::Int,1..]) = [2147483647,1,-2147483645]
+    ([maxBound::Int,0..]) = [2147483647,0,-2147483647]
+    ([maxBound::Int,-1..]) = [2147483647,-1]
+    (take 7 ([(1::Int) .. 5])) = [1,2,3,4,5]
+    (take 4 ([(1::Int) .. 1])) = [1]
+    (take 7 ([(1::Int) .. 0])) = []
+    (take 7 ([(5::Int) .. 0])) = []
+    (take 7 ([(maxBound-(5::Int)) .. maxBound])) = [2147483642,2147483643,2147483644,2147483645,2147483646,2147483647]
+    (take 7 ([(minBound+(5::Int)) .. minBound])) = []
+    (take 7 [(5::Int),4..1]) = [5,4,3,2,1]
+    (take 7 [(5::Int),3..1]) = [5,3,1]
+    (take 7 [(5::Int),3..2]) = [5,3]
+    (take 7 [(1::Int),2..1]) = [1]
+    (take 7 [(2::Int),1..2]) = [2]
+    (take 7 [(2::Int),1..1]) = [2,1]
+    (take 7 [(2::Int),3..1]) = []
+    ([minBound, 1..maxBound::Int]) = [-2147483648,1]
+    ([minBound, 0..maxBound::Int]) = [-2147483648,0]
+    ([minBound,-1..maxBound::Int]) = [-2147483648,-1,2147483646]
+    ([minBound,-1..maxBound-1::Int]) = [-2147483648,-1,2147483646]
+    ([minBound,-1..maxBound-2::Int]) = [-2147483648,-1]
+    ([maxBound, 1..minBound::Int]) = [2147483647,1,-2147483645]
+    ([maxBound, 0..minBound::Int]) = [2147483647,0,-2147483647]
+    ([maxBound, 0..minBound+1::Int]) = [2147483647,0,-2147483647]
+    ([maxBound, 0..minBound+2::Int]) = [2147483647,0]
+    ([maxBound,-1..minBound::Int]) = [2147483647,-1]
+    (take 7 [x,(x+1)..maxBound]) = [2147483643,2147483644,2147483645,2147483646,2147483647]
+    (take 7 [x,(x-1)..minBound]) = [-2147483643,-2147483644,-2147483645,-2147483646,-2147483647,-2147483648]
+Testing Enum Integer: 
+    (succ (0::Integer)) = 1
+    (succ ((-1)::Integer)) = 0
+    pred (1::Integer) = 0
+    pred (0::Integer) = -1
+    (map (toEnum::Int->Integer) [1,minBound,maxBound]) = [1,-2147483648,2147483647]
+    (map fromEnum [(1::Integer),42,45]) = [1,42,45]
+    (take 7 [(1::Integer)..]) = [1,2,3,4,5,6,7]
+    (take 7 [(-5::Integer)..]) = [-5,-4,-3,-2,-1,0,1]
+    (take 7 [(1::Integer),2..]) = [1,2,3,4,5,6,7]
+    (take 7 [(1::Integer),7..]) = [1,7,13,19,25,31,37]
+    (take 7 [(1::Integer),1..]) = [1,1,1,1,1,1,1]
+    (take 7 [(1::Integer),0..]) = [1,0,-1,-2,-3,-4,-5]
+    (take 7 [(5::Integer),2..]) = [5,2,-1,-4,-7,-10,-13]
+    (take 7 ([(1::Integer) .. 5])) = [1,2,3,4,5]
+    (take 4 ([(1::Integer) .. 1])) = [1]
+    (take 7 ([(1::Integer) .. 0])) = []
+    (take 7 ([(5::Integer) .. 0])) = []
+    (take 7 [(5::Integer),4..1]) = [5,4,3,2,1]
+    (take 7 [(5::Integer),3..1]) = [5,3,1]
+    (take 7 [(5::Integer),3..2]) = [5,3]
+    (take 7 [(1::Integer),2..1]) = [1]
+    (take 7 [(2::Integer),1..2]) = [2]
+    (take 7 [(2::Integer),1..1]) = [2,1]
+    (take 7 [(2::Integer),3..1]) = []
+Testing Enum Char: 
+    (succ 'a') = 'b'
+    (succ (minBound::Char)) = '\SOH'
+    (succ (maxBound::Char)) = error "chr: out of range"
+    (pred 'b') = 'a'
+    pred (maxBound::Char) = '\1114110'
+    pred (minBound::Char) = error "chr: out of range"
+    (map (toEnum::Int->Char) [123,ord (minBound::Char), ord(maxBound::Char)]) = "{\NUL\1114111"
+    (toEnum::Int->Char) (minBound::Int) = error "chr: out of range"
+    (map fromEnum ['X',minBound,maxBound]) = [88,0,1114111]
+    (take 7 ['\NUL' .. ]) = "\NUL\SOH\STX\ETX\EOT\ENQ\ACK"
+    (take 7 ['\250' .. ]) = "\250\251\252\253\254\255\256"
+    (take 7 ['a','b'..]) = "abcdefg"
+    (take 7 ['a','e'..]) = "aeimquy"
+    (take 7 ['a','a'..]) = "aaaaaaa"
+    (take 7 ['z','y'..]) = "zyxwvut"
+    (take 7 ['z','v'..]) = "zvrnjfb"
+    (take 7 ['\1', '\0' ..]) = "\SOH\NUL"
+    (take 7 ['\5', '\4' ..]) = "\ENQ\EOT\ETX\STX\SOH\NUL"
+    (take 7 ['\250', '\251' ..]) = "\250\251\252\253\254\255\256"
+    (take 7 (['a' .. 'e'])) = "abcde"
+    (take 4 (['a' .. 'a'])) = "a"
+    (take 7 (['b' .. 'a'])) = ""
+    (take 7 (['e' .. 'a'])) = ""
+    (take 7 (['\250' .. '\255'])) = "\250\251\252\253\254\255"
+    (take 7 (['\5' .. '\0'])) = ""
+    (take 7 ['f','e' .. 'b']) = "fedcb"
+    (take 7 ['g','e' .. 'b']) = "gec"
+    (take 7 ['g','d' .. 'c']) = "gd"
+    (take 7 ['b','c' .. 'b']) = "b"
+    (take 7 ['c','b' .. 'c']) = "c"
+    (take 7 ['c','b' .. 'b']) = "cb"
+    (take 7 ['c','d' .. 'b']) = ""
+    (take 7 ['\251', '\252' .. maxBound]) = "\251\252\253\254\255\256\257"
+    (take 7 ['\5', '\4' .. minBound]) = "\ENQ\EOT\ETX\STX\SOH\NUL"
+Testing Enum (): 
+    (succ ()) = Fail: pattern match failure
+    (succ (minBound::())) = Fail: pattern match failure
+    (succ (maxBound::())) = Fail: pattern match failure
+    (pred ()) = Fail: pattern match failure
+    (pred (minBound::())) = Fail: pattern match failure
+    (pred (maxBound::())) = Fail: pattern match failure
+    (toEnum 0)::() = ()
+    (toEnum 1)::() = Fail: pattern match failure
+    (fromEnum ()) = 0
+    (take 7 [()..]) = [()]
+    (take 7 [(),()..]) = [(),(),(),(),(),(),()]
+    (take 7 [()..()]) = [()]
+    (take 7 [(),()..()]) = [(),(),(),(),(),(),()]
+Testing Enum Ordering (derived): 
+    (succ LT) = EQ
+    (succ (minBound::Ordering)) = EQ
+    (succ (maxBound::Ordering)) = error "toEnum: out of range"
+    (pred GT) = EQ
+    (pred (maxBound::Ordering)) = EQ
+    (pred (minBound::Ordering)) = error "toEnum: out of range"
+    (toEnum 0)::Ordering = LT
+    (toEnum 5)::Ordering = error "toEnum: out of range"
+    (fromEnum LT) = 0
+    (fromEnum EQ) = 1
+    (fromEnum GT) = 2
+    ([LT ..]) = [LT,EQ,GT]
+    ([EQ ..]) = [EQ,GT]
+    ([GT ..]) = [GT]
+    ([LT,EQ ..]) = [LT,EQ,GT]
+    ([EQ,GT ..]) = [EQ,GT]
+    ([EQ,LT ..]) = [EQ,LT]
+    ([LT,GT ..]) = [LT,GT]
+    ([GT,LT ..]) = [GT,LT]
+    take 7 (([GT,GT ..])) = [GT,GT,GT,GT,GT,GT,GT]
+    take 7 (([LT,LT ..])) = [LT,LT,LT,LT,LT,LT,LT]
+    ([LT .. GT]) = [LT,EQ,GT]
+    ([LT .. EQ]) = [LT,EQ]
+    ([LT .. LT]) = [LT]
+    ([GT .. LT]) = []
+    ([GT .. EQ]) = []
+    ([GT .. GT]) = [GT]
+    ([LT,EQ .. GT]) = [LT,EQ,GT]
+    ([GT,EQ .. LT]) = [GT,EQ,LT]
+    ([GT,EQ .. EQ]) = [GT,EQ]
+    ([GT,EQ .. GT]) = [GT]
+    ([GT,EQ .. LT]) = [GT,EQ,LT]
+    ([LT,EQ .. LT]) = [LT]
+    ([LT,EQ .. GT]) = [LT,EQ,GT]
+    take 7 (([LT,LT .. GT])) = [LT,LT,LT,LT,LT,LT,LT]
+    take 7 (([GT,GT .. LT])) = []
+Testing Enum Bool: 
+    (succ False) = True
+    (succ (minBound::Bool)) = True
+    (succ (maxBound::Bool)) = error "toEnum: out of range"
+    (pred True) = False
+    (pred (maxBound::Bool)) = False
+    (pred (minBound::Bool)) = error "toEnum: out of range"
+    (toEnum 0)::Bool = False
+    (toEnum 5)::Bool = error "toEnum: out of range"
+    (fromEnum False) = 0
+    (fromEnum True) = 1
+    ([False ..]) = [False,True]
+    ([True ..]) = [True]
+    ([False,True ..]) = [False,True]
+    ([True,False ..]) = [True,False]
+    (take 7 ([False,False ..])) = [False,False,False,False,False,False,False]
+    (take 7 ([True,True ..])) = [True,True,True,True,True,True,True]
+    ([False .. True]) = [False,True]
+    ([True .. False]) = []
+    take 7 ([False,False .. False]) = [False,False,False,False,False,False,False]
+    take 7 ([False,False .. True]) = [False,False,False,False,False,False,False]
+    take 7 ([False,True .. False]) = [False]
+    take 7 ([False,True .. True]) = [False,True]
+    take 7 ([True,False .. False]) = [True,False]
+    take 7 ([True,False .. True]) = [True]
+    take 7 ([True,True .. False]) = []
+    take 7 ([True,True .. True]) = [True,True,True,True,True,True,True]
+Testing Enum Rational: 
+    (succ (0::Rational)) = 1 % 1
+    (succ ((-1)::Rational)) = 0 % 1
+    pred (1::Rational) = 0 % 1
+    pred (0::Rational) = (-1) % 1
+    (map (toEnum::Int->Rational) [1,minBound,maxBound]) = [1 % 1,(-2147483648) % 1,2147483647 % 1]
+    (map fromEnum [(1::Rational),42,45]) = [1,42,45]
+    (take 7 [(1::Rational)..]) = [1 % 1,2 % 1,3 % 1,4 % 1,5 % 1,6 % 1,7 % 1]
+    (take 7 [(-5::Rational)..]) = [(-5) % 1,(-4) % 1,(-3) % 1,(-2) % 1,(-1) % 1,0 % 1,1 % 1]
+    (take 7 [(1::Rational),2..]) = [1 % 1,2 % 1,3 % 1,4 % 1,5 % 1,6 % 1,7 % 1]
+    (take 7 [(1::Rational),7..]) = [1 % 1,7 % 1,13 % 1,19 % 1,25 % 1,31 % 1,37 % 1]
+    (take 7 [(1::Rational),1..]) = [1 % 1,1 % 1,1 % 1,1 % 1,1 % 1,1 % 1,1 % 1]
+    (take 7 [(1::Rational),0..]) = [1 % 1,0 % 1,(-1) % 1,(-2) % 1,(-3) % 1,(-4) % 1,(-5) % 1]
+    (take 7 [(5::Rational),2..]) = [5 % 1,2 % 1,(-1) % 1,(-4) % 1,(-7) % 1,(-10) % 1,(-13) % 1]
+    (take 7 ([(1::Rational) .. 5])) = [1 % 1,2 % 1,3 % 1,4 % 1,5 % 1]
+    (take 4 ([(1::Rational) .. 1])) = [1 % 1]
+    (take 7 ([(1::Rational) .. 0])) = []
+    (take 7 ([(5::Rational) .. 0])) = []
+    (take 7 [(5::Rational),4..1]) = [5 % 1,4 % 1,3 % 1,2 % 1,1 % 1]
+    (take 7 [(5::Rational),3..1]) = [5 % 1,3 % 1,1 % 1]
+    (take 7 [(5::Rational),3..2]) = [5 % 1,3 % 1,1 % 1]
+    (take 7 [(1::Rational),2..1]) = [1 % 1]
+    (take 7 [(2::Rational),1..2]) = [2 % 1]
+    (take 7 [(2::Rational),1..1]) = [2 % 1,1 % 1]
+    (take 7 [(2::Rational),3..1]) = []
+Testing Enum (Ratio Int): 
+    (succ (0::Ratio Int)) = 1 % 1
+    (succ ((-1)::Ratio Int)) = 0 % 1
+    pred (1::Ratio Int) = 0 % 1
+    pred (0::Ratio Int) = (-1) % 1
+    (map (toEnum::Int->Ratio Int) [1,minBound,maxBound]) = [1 % 1,(-2147483648) % 1,2147483647 % 1]
+    (map fromEnum [(1::Ratio Int),42,45]) = [1,42,45]
+    (take 7 [(1::Ratio Int)..]) = [1 % 1,2 % 1,3 % 1,4 % 1,5 % 1,6 % 1,7 % 1]
+    (take 7 [(-5::Ratio Int)..]) = [(-5) % 1,(-4) % 1,(-3) % 1,(-2) % 1,(-1) % 1,0 % 1,1 % 1]
+    (take 7 [((toEnum ((maxBound::Int)-5))::Ratio Int)..]) = [2147483642 % 1,2147483643 % 1,2147483644 % 1,2147483645 % 1,2147483646 % 1,2147483647 % 1,(-2147483648) % 1]
+    (take 7 [(1::Ratio Int),2..]) = [1 % 1,2 % 1,3 % 1,4 % 1,5 % 1,6 % 1,7 % 1]
+    (take 7 [(1::Ratio Int),7..]) = [1 % 1,7 % 1,13 % 1,19 % 1,25 % 1,31 % 1,37 % 1]
+    (take 7 [(1::Ratio Int),1..]) = [1 % 1,1 % 1,1 % 1,1 % 1,1 % 1,1 % 1,1 % 1]
+    (take 7 [(1::Ratio Int),0..]) = [1 % 1,0 % 1,(-1) % 1,(-2) % 1,(-3) % 1,(-4) % 1,(-5) % 1]
+    (take 7 [(5::Ratio Int),2..]) = [5 % 1,2 % 1,(-1) % 1,(-4) % 1,(-7) % 1,(-10) % 1,(-13) % 1]
+    (take 7 [x, x-1 ..]) = [(-2147483647) % 1,(-2147483648) % 1,2147483647 % 1,2147483646 % 1,2147483645 % 1,2147483644 % 1,2147483643 % 1]
+    (take 7 [x, x-1 ..]) = [(-2147483643) % 1,(-2147483644) % 1,(-2147483645) % 1,(-2147483646) % 1,(-2147483647) % 1,(-2147483648) % 1,2147483647 % 1]
+    (take 7 [x, (x+1) ..]) = [2147483642 % 1,2147483643 % 1,2147483644 % 1,2147483645 % 1,2147483646 % 1,2147483647 % 1,(-2147483648) % 1]
+    (take 7 ([(1::Ratio Int) .. 5])) = [1 % 1,2 % 1,3 % 1,4 % 1,5 % 1]
+    (take 4 ([(1::Ratio Int) .. 1])) = [1 % 1]
+    (take 7 ([(1::Ratio Int) .. 0])) = []
+    (take 7 ([(5::Ratio Int) .. 0])) = []
+    (take 7 ([x..y])) = [2147483642 % 1,2147483643 % 1,2147483644 % 1,2147483645 % 1,2147483646 % 1,2147483647 % 1]
+    (take 7 ([x..y])) = []
+    (take 7 [(5::Ratio Int),4..1]) = [5 % 1,4 % 1,3 % 1,2 % 1,1 % 1]
+    (take 7 [(5::Ratio Int),3..1]) = [5 % 1,3 % 1,1 % 1]
+    (take 7 [(5::Ratio Int),3..2]) = [5 % 1,3 % 1,1 % 1]
+    (take 7 [(1::Ratio Int),2..1]) = [1 % 1]
+    (take 7 [(2::Ratio Int),1..2]) = [2 % 1]
+    (take 7 [(2::Ratio Int),1..1]) = [2 % 1,1 % 1]
+    (take 7 [(2::Ratio Int),3..1]) = []
+    (take 7 [x,(x+1)..y]) = [2147483643 % 1,2147483644 % 1,2147483645 % 1,2147483646 % 1,2147483647 % 1]
+    (take 7 [x,(x-1)..y]) = [(-2147483643) % 1,(-2147483644) % 1,(-2147483645) % 1,(-2147483646) % 1,(-2147483647) % 1,(-2147483648) % 1]
diff --git a/libraries/base/tests/enum01.stdout-ws-64 b/libraries/base/tests/enum01.stdout-ws-64
new file mode 100644
index 000000000000..3804dd2470a2
--- /dev/null
+++ b/libraries/base/tests/enum01.stdout-ws-64
@@ -0,0 +1,246 @@
+Testing Enum Int: 
+    (succ (0::Int)) = 1
+    (succ (minBound::Int)) = -9223372036854775807
+    (succ (maxBound::Int)) = error "Prelude.Enum.succ{Int}: tried to take `succ' of maxBound"
+    pred (1::Int) = 0
+    pred (maxBound::Int) = 9223372036854775806
+    pred (minBound::Int) = error "Prelude.Enum.pred{Int}: tried to take `pred' of minBound"
+    (map (toEnum::Int->Int) [1,minBound,maxBound]) = [1,-9223372036854775808,9223372036854775807]
+    (map fromEnum [(1::Int),minBound,maxBound]) = [1,-9223372036854775808,9223372036854775807]
+    (take 7 [(1::Int)..]) = [1,2,3,4,5,6,7]
+    (take 7 [((maxBound::Int)-5)..]) = [9223372036854775802,9223372036854775803,9223372036854775804,9223372036854775805,9223372036854775806,9223372036854775807]
+    (take 7 [(1::Int),2..]) = [1,2,3,4,5,6,7]
+    (take 7 [(1::Int),7..]) = [1,7,13,19,25,31,37]
+    (take 7 [(1::Int),1..]) = [1,1,1,1,1,1,1]
+    (take 7 [(1::Int),0..]) = [1,0,-1,-2,-3,-4,-5]
+    (take 7 [(5::Int),2..]) = [5,2,-1,-4,-7,-10,-13]
+    (take 7 [x, x-1 ..]) = [-9223372036854775807,-9223372036854775808]
+    (take 7 [x, x-1 ..]) = [-9223372036854775803,-9223372036854775804,-9223372036854775805,-9223372036854775806,-9223372036854775807,-9223372036854775808]
+    (take 7 [x, (x+1) ..]) = [9223372036854775802,9223372036854775803,9223372036854775804,9223372036854775805,9223372036854775806,9223372036854775807]
+    ([minBound::Int,1..]) = [-9223372036854775808,1]
+    ([minBound::Int,0..]) = [-9223372036854775808,0]
+    ([minBound::Int,-1..]) = [-9223372036854775808,-1,9223372036854775806]
+    ([maxBound::Int,1..]) = [9223372036854775807,1,-9223372036854775805]
+    ([maxBound::Int,0..]) = [9223372036854775807,0,-9223372036854775807]
+    ([maxBound::Int,-1..]) = [9223372036854775807,-1]
+    (take 7 ([(1::Int) .. 5])) = [1,2,3,4,5]
+    (take 4 ([(1::Int) .. 1])) = [1]
+    (take 7 ([(1::Int) .. 0])) = []
+    (take 7 ([(5::Int) .. 0])) = []
+    (take 7 ([(maxBound-(5::Int)) .. maxBound])) = [9223372036854775802,9223372036854775803,9223372036854775804,9223372036854775805,9223372036854775806,9223372036854775807]
+    (take 7 ([(minBound+(5::Int)) .. minBound])) = []
+    (take 7 [(5::Int),4..1]) = [5,4,3,2,1]
+    (take 7 [(5::Int),3..1]) = [5,3,1]
+    (take 7 [(5::Int),3..2]) = [5,3]
+    (take 7 [(1::Int),2..1]) = [1]
+    (take 7 [(2::Int),1..2]) = [2]
+    (take 7 [(2::Int),1..1]) = [2,1]
+    (take 7 [(2::Int),3..1]) = []
+    ([minBound, 1..maxBound::Int]) = [-9223372036854775808,1]
+    ([minBound, 0..maxBound::Int]) = [-9223372036854775808,0]
+    ([minBound,-1..maxBound::Int]) = [-9223372036854775808,-1,9223372036854775806]
+    ([minBound,-1..maxBound-1::Int]) = [-9223372036854775808,-1,9223372036854775806]
+    ([minBound,-1..maxBound-2::Int]) = [-9223372036854775808,-1]
+    ([maxBound, 1..minBound::Int]) = [9223372036854775807,1,-9223372036854775805]
+    ([maxBound, 0..minBound::Int]) = [9223372036854775807,0,-9223372036854775807]
+    ([maxBound, 0..minBound+1::Int]) = [9223372036854775807,0,-9223372036854775807]
+    ([maxBound, 0..minBound+2::Int]) = [9223372036854775807,0]
+    ([maxBound,-1..minBound::Int]) = [9223372036854775807,-1]
+    (take 7 [x,(x+1)..maxBound]) = [9223372036854775803,9223372036854775804,9223372036854775805,9223372036854775806,9223372036854775807]
+    (take 7 [x,(x-1)..minBound]) = [-9223372036854775803,-9223372036854775804,-9223372036854775805,-9223372036854775806,-9223372036854775807,-9223372036854775808]
+Testing Enum Integer: 
+    (succ (0::Integer)) = 1
+    (succ ((-1)::Integer)) = 0
+    pred (1::Integer) = 0
+    pred (0::Integer) = -1
+    (map (toEnum::Int->Integer) [1,minBound,maxBound]) = [1,-9223372036854775808,9223372036854775807]
+    (map fromEnum [(1::Integer),42,45]) = [1,42,45]
+    (take 7 [(1::Integer)..]) = [1,2,3,4,5,6,7]
+    (take 7 [(-5::Integer)..]) = [-5,-4,-3,-2,-1,0,1]
+    (take 7 [(1::Integer),2..]) = [1,2,3,4,5,6,7]
+    (take 7 [(1::Integer),7..]) = [1,7,13,19,25,31,37]
+    (take 7 [(1::Integer),1..]) = [1,1,1,1,1,1,1]
+    (take 7 [(1::Integer),0..]) = [1,0,-1,-2,-3,-4,-5]
+    (take 7 [(5::Integer),2..]) = [5,2,-1,-4,-7,-10,-13]
+    (take 7 ([(1::Integer) .. 5])) = [1,2,3,4,5]
+    (take 4 ([(1::Integer) .. 1])) = [1]
+    (take 7 ([(1::Integer) .. 0])) = []
+    (take 7 ([(5::Integer) .. 0])) = []
+    (take 7 [(5::Integer),4..1]) = [5,4,3,2,1]
+    (take 7 [(5::Integer),3..1]) = [5,3,1]
+    (take 7 [(5::Integer),3..2]) = [5,3]
+    (take 7 [(1::Integer),2..1]) = [1]
+    (take 7 [(2::Integer),1..2]) = [2]
+    (take 7 [(2::Integer),1..1]) = [2,1]
+    (take 7 [(2::Integer),3..1]) = []
+Testing Enum Char: 
+    (succ 'a') = 'b'
+    (succ (minBound::Char)) = '\SOH'
+    (succ (maxBound::Char)) = error "Prelude.Enum.Char.succ: bad argument"
+    (pred 'b') = 'a'
+    pred (maxBound::Char) = '\1114110'
+    pred (minBound::Char) = error "Prelude.Enum.Char.pred: bad argument"
+    (map (toEnum::Int->Char) [123,ord (minBound::Char), ord(maxBound::Char)]) = "{\NUL\1114111"
+    (toEnum::Int->Char) (minBound::Int) = error "Prelude.chr: bad argument: (-9223372036854775808)"
+    (map fromEnum ['X',minBound,maxBound]) = [88,0,1114111]
+    (take 7 ['\NUL' .. ]) = "\NUL\SOH\STX\ETX\EOT\ENQ\ACK"
+    (take 7 ['\250' .. ]) = "\250\251\252\253\254\255\256"
+    (take 7 ['a','b'..]) = "abcdefg"
+    (take 7 ['a','e'..]) = "aeimquy"
+    (take 7 ['a','a'..]) = "aaaaaaa"
+    (take 7 ['z','y'..]) = "zyxwvut"
+    (take 7 ['z','v'..]) = "zvrnjfb"
+    (take 7 ['\1', '\0' ..]) = "\SOH\NUL"
+    (take 7 ['\5', '\4' ..]) = "\ENQ\EOT\ETX\STX\SOH\NUL"
+    (take 7 ['\250', '\251' ..]) = "\250\251\252\253\254\255\256"
+    (take 7 (['a' .. 'e'])) = "abcde"
+    (take 4 (['a' .. 'a'])) = "a"
+    (take 7 (['b' .. 'a'])) = ""
+    (take 7 (['e' .. 'a'])) = ""
+    (take 7 (['\250' .. '\255'])) = "\250\251\252\253\254\255"
+    (take 7 (['\5' .. '\0'])) = ""
+    (take 7 ['f','e' .. 'b']) = "fedcb"
+    (take 7 ['g','e' .. 'b']) = "gec"
+    (take 7 ['g','d' .. 'c']) = "gd"
+    (take 7 ['b','c' .. 'b']) = "b"
+    (take 7 ['c','b' .. 'c']) = "c"
+    (take 7 ['c','b' .. 'b']) = "cb"
+    (take 7 ['c','d' .. 'b']) = ""
+    (take 7 ['\251', '\252' .. maxBound]) = "\251\252\253\254\255\256\257"
+    (take 7 ['\5', '\4' .. minBound]) = "\ENQ\EOT\ETX\STX\SOH\NUL"
+Testing Enum (): 
+    (succ ()) = error "Prelude.Enum.().succ: bad argument"
+    (succ (minBound::())) = error "Prelude.Enum.().succ: bad argument"
+    (succ (maxBound::())) = error "Prelude.Enum.().succ: bad argument"
+    (pred ()) = error "Prelude.Enum.().pred: bad argument"
+    (pred (minBound::())) = error "Prelude.Enum.().pred: bad argument"
+    (pred (maxBound::())) = error "Prelude.Enum.().pred: bad argument"
+    (toEnum 0)::() = ()
+    (toEnum 1)::() = error "Prelude.Enum.().toEnum: bad argument"
+    (fromEnum ()) = 0
+    (take 7 [()..]) = [()]
+    (take 7 [(),()..]) = [(),(),(),(),(),(),()]
+    (take 7 [()..()]) = [()]
+    (take 7 [(),()..()]) = [(),(),(),(),(),(),()]
+Testing Enum Ordering (derived): 
+    (succ LT) = EQ
+    (succ (minBound::Ordering)) = EQ
+    (succ (maxBound::Ordering)) = error "Prelude.Enum.Ordering.succ: bad argument"
+    (pred GT) = EQ
+    (pred (maxBound::Ordering)) = EQ
+    (pred (minBound::Ordering)) = error "Prelude.Enum.Ordering.pred: bad argument"
+    (toEnum 0)::Ordering = LT
+    (toEnum 5)::Ordering = error "Prelude.Enum.Ordering.toEnum: bad argument"
+    (fromEnum LT) = 0
+    (fromEnum EQ) = 1
+    (fromEnum GT) = 2
+    ([LT ..]) = [LT,EQ,GT]
+    ([EQ ..]) = [EQ,GT]
+    ([GT ..]) = [GT]
+    ([LT,EQ ..]) = [LT,EQ,GT]
+    ([EQ,GT ..]) = [EQ,GT]
+    ([EQ,LT ..]) = [EQ,LT]
+    ([LT,GT ..]) = [LT,GT]
+    ([GT,LT ..]) = [GT,LT]
+    take 7 (([GT,GT ..])) = [GT,GT,GT,GT,GT,GT,GT]
+    take 7 (([LT,LT ..])) = [LT,LT,LT,LT,LT,LT,LT]
+    ([LT .. GT]) = [LT,EQ,GT]
+    ([LT .. EQ]) = [LT,EQ]
+    ([LT .. LT]) = [LT]
+    ([GT .. LT]) = []
+    ([GT .. EQ]) = []
+    ([GT .. GT]) = [GT]
+    ([LT,EQ .. GT]) = [LT,EQ,GT]
+    ([GT,EQ .. LT]) = [GT,EQ,LT]
+    ([GT,EQ .. EQ]) = [GT,EQ]
+    ([GT,EQ .. GT]) = [GT]
+    ([GT,EQ .. LT]) = [GT,EQ,LT]
+    ([LT,EQ .. LT]) = [LT]
+    ([LT,EQ .. GT]) = [LT,EQ,GT]
+    take 7 (([LT,LT .. GT])) = [LT,LT,LT,LT,LT,LT,LT]
+    take 7 (([GT,GT .. LT])) = []
+Testing Enum Bool: 
+    (succ False) = True
+    (succ (minBound::Bool)) = True
+    (succ (maxBound::Bool)) = error "Prelude.Enum.Bool.succ: bad argument"
+    (pred True) = False
+    (pred (maxBound::Bool)) = False
+    (pred (minBound::Bool)) = error "Prelude.Enum.Bool.pred: bad argument"
+    (toEnum 0)::Bool = False
+    (toEnum 5)::Bool = error "Prelude.Enum.Bool.toEnum: bad argument"
+    (fromEnum False) = 0
+    (fromEnum True) = 1
+    ([False ..]) = [False,True]
+    ([True ..]) = [True]
+    ([False,True ..]) = [False,True]
+    ([True,False ..]) = [True,False]
+    (take 7 ([False,False ..])) = [False,False,False,False,False,False,False]
+    (take 7 ([True,True ..])) = [True,True,True,True,True,True,True]
+    ([False .. True]) = [False,True]
+    ([True .. False]) = []
+    take 7 ([False,False .. False]) = [False,False,False,False,False,False,False]
+    take 7 ([False,False .. True]) = [False,False,False,False,False,False,False]
+    take 7 ([False,True .. False]) = [False]
+    take 7 ([False,True .. True]) = [False,True]
+    take 7 ([True,False .. False]) = [True,False]
+    take 7 ([True,False .. True]) = [True]
+    take 7 ([True,True .. False]) = []
+    take 7 ([True,True .. True]) = [True,True,True,True,True,True,True]
+Testing Enum Rational: 
+    (succ (0::Rational)) = 1 % 1
+    (succ ((-1)::Rational)) = 0 % 1
+    pred (1::Rational) = 0 % 1
+    pred (0::Rational) = (-1) % 1
+    (map (toEnum::Int->Rational) [1,minBound,maxBound]) = [1 % 1,(-9223372036854775808) % 1,9223372036854775807 % 1]
+    (map fromEnum [(1::Rational),42,45]) = [1,42,45]
+    (take 7 [(1::Rational)..]) = [1 % 1,2 % 1,3 % 1,4 % 1,5 % 1,6 % 1,7 % 1]
+    (take 7 [(-5::Rational)..]) = [(-5) % 1,(-4) % 1,(-3) % 1,(-2) % 1,(-1) % 1,0 % 1,1 % 1]
+    (take 7 [(1::Rational),2..]) = [1 % 1,2 % 1,3 % 1,4 % 1,5 % 1,6 % 1,7 % 1]
+    (take 7 [(1::Rational),7..]) = [1 % 1,7 % 1,13 % 1,19 % 1,25 % 1,31 % 1,37 % 1]
+    (take 7 [(1::Rational),1..]) = [1 % 1,1 % 1,1 % 1,1 % 1,1 % 1,1 % 1,1 % 1]
+    (take 7 [(1::Rational),0..]) = [1 % 1,0 % 1,(-1) % 1,(-2) % 1,(-3) % 1,(-4) % 1,(-5) % 1]
+    (take 7 [(5::Rational),2..]) = [5 % 1,2 % 1,(-1) % 1,(-4) % 1,(-7) % 1,(-10) % 1,(-13) % 1]
+    (take 7 ([(1::Rational) .. 5])) = [1 % 1,2 % 1,3 % 1,4 % 1,5 % 1]
+    (take 4 ([(1::Rational) .. 1])) = [1 % 1]
+    (take 7 ([(1::Rational) .. 0])) = []
+    (take 7 ([(5::Rational) .. 0])) = []
+    (take 7 [(5::Rational),4..1]) = [5 % 1,4 % 1,3 % 1,2 % 1,1 % 1]
+    (take 7 [(5::Rational),3..1]) = [5 % 1,3 % 1,1 % 1]
+    (take 7 [(5::Rational),3..2]) = [5 % 1,3 % 1,1 % 1]
+    (take 7 [(1::Rational),2..1]) = [1 % 1]
+    (take 7 [(2::Rational),1..2]) = [2 % 1]
+    (take 7 [(2::Rational),1..1]) = [2 % 1,1 % 1]
+    (take 7 [(2::Rational),3..1]) = []
+Testing Enum (Ratio Int): 
+    (succ (0::Ratio Int)) = 1 % 1
+    (succ ((-1)::Ratio Int)) = 0 % 1
+    pred (1::Ratio Int) = 0 % 1
+    pred (0::Ratio Int) = (-1) % 1
+    (map (toEnum::Int->Ratio Int) [1,minBound,maxBound]) = [1 % 1,(-9223372036854775808) % 1,9223372036854775807 % 1]
+    (map fromEnum [(1::Ratio Int),42,45]) = [1,42,45]
+    (take 7 [(1::Ratio Int)..]) = [1 % 1,2 % 1,3 % 1,4 % 1,5 % 1,6 % 1,7 % 1]
+    (take 7 [(-5::Ratio Int)..]) = [(-5) % 1,(-4) % 1,(-3) % 1,(-2) % 1,(-1) % 1,0 % 1,1 % 1]
+    (take 7 [((toEnum ((maxBound::Int)-5))::Ratio Int)..]) = [9223372036854775802 % 1,9223372036854775803 % 1,9223372036854775804 % 1,9223372036854775805 % 1,9223372036854775806 % 1,9223372036854775807 % 1,(-9223372036854775808) % 1]
+    (take 7 [(1::Ratio Int),2..]) = [1 % 1,2 % 1,3 % 1,4 % 1,5 % 1,6 % 1,7 % 1]
+    (take 7 [(1::Ratio Int),7..]) = [1 % 1,7 % 1,13 % 1,19 % 1,25 % 1,31 % 1,37 % 1]
+    (take 7 [(1::Ratio Int),1..]) = [1 % 1,1 % 1,1 % 1,1 % 1,1 % 1,1 % 1,1 % 1]
+    (take 7 [(1::Ratio Int),0..]) = [1 % 1,0 % 1,(-1) % 1,(-2) % 1,(-3) % 1,(-4) % 1,(-5) % 1]
+    (take 7 [(5::Ratio Int),2..]) = [5 % 1,2 % 1,(-1) % 1,(-4) % 1,(-7) % 1,(-10) % 1,(-13) % 1]
+    (take 7 [x, x-1 ..]) = [(-9223372036854775807) % 1,(-9223372036854775808) % 1,9223372036854775807 % 1,9223372036854775806 % 1,9223372036854775805 % 1,9223372036854775804 % 1,9223372036854775803 % 1]
+    (take 7 [x, x-1 ..]) = [(-9223372036854775803) % 1,(-9223372036854775804) % 1,(-9223372036854775805) % 1,(-9223372036854775806) % 1,(-9223372036854775807) % 1,(-9223372036854775808) % 1,9223372036854775807 % 1]
+    (take 7 [x, (x+1) ..]) = [9223372036854775802 % 1,9223372036854775803 % 1,9223372036854775804 % 1,9223372036854775805 % 1,9223372036854775806 % 1,9223372036854775807 % 1,(-9223372036854775808) % 1]
+    (take 7 ([(1::Ratio Int) .. 5])) = [1 % 1,2 % 1,3 % 1,4 % 1,5 % 1]
+    (take 4 ([(1::Ratio Int) .. 1])) = [1 % 1]
+    (take 7 ([(1::Ratio Int) .. 0])) = []
+    (take 7 ([(5::Ratio Int) .. 0])) = []
+    (take 7 ([x..y])) = [9223372036854775802 % 1,9223372036854775803 % 1,9223372036854775804 % 1,9223372036854775805 % 1,9223372036854775806 % 1,9223372036854775807 % 1]
+    (take 7 ([x..y])) = []
+    (take 7 [(5::Ratio Int),4..1]) = [5 % 1,4 % 1,3 % 1,2 % 1,1 % 1]
+    (take 7 [(5::Ratio Int),3..1]) = [5 % 1,3 % 1,1 % 1]
+    (take 7 [(5::Ratio Int),3..2]) = [5 % 1,3 % 1,1 % 1]
+    (take 7 [(1::Ratio Int),2..1]) = [1 % 1]
+    (take 7 [(2::Ratio Int),1..2]) = [2 % 1]
+    (take 7 [(2::Ratio Int),1..1]) = [2 % 1,1 % 1]
+    (take 7 [(2::Ratio Int),3..1]) = []
+    (take 7 [x,(x+1)..y]) = [9223372036854775803 % 1,9223372036854775804 % 1,9223372036854775805 % 1,9223372036854775806 % 1,9223372036854775807 % 1]
+    (take 7 [x,(x-1)..y]) = [(-9223372036854775803) % 1,(-9223372036854775804) % 1,(-9223372036854775805) % 1,(-9223372036854775806) % 1,(-9223372036854775807) % 1,(-9223372036854775808) % 1]
diff --git a/libraries/base/tests/enum02.hs b/libraries/base/tests/enum02.hs
new file mode 100644
index 000000000000..95812e592dac
--- /dev/null
+++ b/libraries/base/tests/enum02.hs
@@ -0,0 +1,266 @@
+-- !!! Testing the Int Enum instances.
+{-# LANGUAGE CPP #-}
+module Main(main) where
+
+import Control.Exception
+#if __GLASGOW_HASKELL__ < 705
+import Prelude hiding (catch)
+#endif
+import Data.Int
+
+main = do
+  putStrLn "Testing Enum Int8:"
+  testEnumInt8
+  putStrLn "Testing Enum Int16:"
+  testEnumInt16
+  putStrLn "Testing Enum Int32:"
+  testEnumInt32
+  putStrLn "Testing Enum Int64:"
+  testEnumInt64
+
+#define printTest(x) (do{ putStr ( "    " ++ "x" ++ " = " ) ; print (x) })
+
+testEnumInt8 :: IO ()
+testEnumInt8 = do
+     -- succ
+  printTest ((succ (0::Int8)))
+  printTest ((succ (minBound::Int8)))
+  mayBomb   (printTest ((succ (maxBound::Int8))))
+
+     -- pred
+  printTest (pred (1::Int8))
+  printTest (pred (maxBound::Int8))
+  mayBomb   (printTest (pred (minBound::Int8))) 
+
+     -- toEnum
+  printTest ((map (toEnum::Int->Int8) [1, fromIntegral (minBound::Int8), fromIntegral (maxBound::Int8)]))
+  mayBomb   (printTest ((toEnum (maxBound::Int))::Int8))
+
+     -- fromEnum
+  printTest ((map fromEnum [(1::Int8),minBound,maxBound]))
+
+     -- [x..] aka enumFrom
+  printTest ((take 7 [(1::Int8)..]))
+  printTest ((take 7 [((maxBound::Int8)-5)..])) -- just in case it doesn't catch the upper bound..
+  
+     -- [x,y..] aka enumFromThen
+  printTest ((take 7 [(1::Int8),2..]))
+  printTest ((take 7 [(1::Int8),7..]))
+  printTest ((take 7 [(1::Int8),1..]))
+  printTest ((take 7 [(1::Int8),0..]))
+  printTest ((take 7 [(5::Int8),2..]))
+  let x = (minBound::Int8) + 1
+  printTest ((take 7 [x, x-1 ..]))
+  let x = (minBound::Int8) + 5
+  printTest ((take 7 [x, x-1 ..]))
+  let x = (maxBound::Int8) - 5
+  printTest ((take 7 [x, (x+1) ..]))
+
+     -- [x..y] aka enumFromTo
+  printTest ((take 7 ([(1::Int8) .. 5])))
+  printTest ((take 4 ([(1::Int8) .. 1])))
+  printTest ((take 7 ([(1::Int8) .. 0])))
+  printTest ((take 7 ([(5::Int8) .. 0])))
+  printTest ((take 7 ([(maxBound-(5::Int8)) .. maxBound])))
+  printTest ((take 7 ([(minBound+(5::Int8)) .. minBound])))
+
+     -- [x,y..z] aka enumFromThenTo
+  printTest ((take 7 [(5::Int8),4..1]))
+  printTest ((take 7 [(5::Int8),3..1]))
+  printTest ((take 7 [(5::Int8),3..2]))
+  printTest ((take 7 [(1::Int8),2..1]))
+  printTest ((take 7 [(2::Int8),1..2]))
+  printTest ((take 7 [(2::Int8),1..1]))
+  printTest ((take 7 [(2::Int8),3..1]))
+
+  let x = (maxBound::Int8) - 4
+  printTest ((take 7 [x,(x+1)..maxBound]))
+  let x = (minBound::Int8) + 5
+  printTest ((take 7 [x,(x-1)..minBound]))
+
+testEnumInt16 :: IO ()
+testEnumInt16 = do
+     -- succ
+  printTest ((succ (0::Int16)))
+  printTest ((succ (minBound::Int16)))
+  mayBomb   (printTest ((succ (maxBound::Int16))))
+
+     -- pred
+  printTest (pred (1::Int16))
+  printTest (pred (maxBound::Int16))
+  mayBomb   (printTest (pred (minBound::Int16))) 
+
+     -- toEnum
+  printTest ((map (toEnum::Int->Int16) [1, fromIntegral (minBound::Int16), fromIntegral (maxBound::Int16)]))
+  mayBomb   (printTest ((toEnum (maxBound::Int))::Int16))
+
+
+     -- fromEnum
+  printTest ((map fromEnum [(1::Int16),minBound,maxBound]))
+
+     -- [x..] aka enumFrom
+  printTest ((take 7 [(1::Int16)..]))
+  printTest ((take 7 [((maxBound::Int16)-5)..])) -- just in case it doesn't catch the upper bound..
+  
+     -- [x,y..] aka enumFromThen
+  printTest ((take 7 [(1::Int16),2..]))
+  printTest ((take 7 [(1::Int16),7..]))
+  printTest ((take 7 [(1::Int16),1..]))
+  printTest ((take 7 [(1::Int16),0..]))
+  printTest ((take 7 [(5::Int16),2..]))
+  let x = (minBound::Int16) + 1
+  printTest ((take 7 [x, x-1 ..]))
+  let x = (minBound::Int16) + 5
+  printTest ((take 7 [x, x-1 ..]))
+  let x = (maxBound::Int16) - 5
+  printTest ((take 7 [x, (x+1) ..]))
+
+     -- [x..y] aka enumFromTo
+  printTest ((take 7 ([(1::Int16) .. 5])))
+  printTest ((take 4 ([(1::Int16) .. 1])))
+  printTest ((take 7 ([(1::Int16) .. 0])))
+  printTest ((take 7 ([(5::Int16) .. 0])))
+  printTest ((take 7 ([(maxBound-(5::Int16)) .. maxBound])))
+  printTest ((take 7 ([(minBound+(5::Int16)) .. minBound])))
+
+     -- [x,y..z] aka enumFromThenTo
+  printTest ((take 7 [(5::Int16),4..1]))
+  printTest ((take 7 [(5::Int16),3..1]))
+  printTest ((take 7 [(5::Int16),3..2]))
+  printTest ((take 7 [(1::Int16),2..1]))
+  printTest ((take 7 [(2::Int16),1..2]))
+  printTest ((take 7 [(2::Int16),1..1]))
+  printTest ((take 7 [(2::Int16),3..1]))
+
+  let x = (maxBound::Int16) - 4
+  printTest ((take 7 [x,(x+1)..maxBound]))
+  let x = (minBound::Int16) + 5
+  printTest ((take 7 [x,(x-1)..minBound]))
+
+testEnumInt32 :: IO ()
+testEnumInt32 = do
+     -- succ
+  printTest ((succ (0::Int32)))
+  printTest ((succ (minBound::Int32)))
+  mayBomb   (printTest ((succ (maxBound::Int32))))
+
+     -- pred
+  printTest (pred (1::Int32))
+  printTest (pred (maxBound::Int32))
+  mayBomb   (printTest (pred (minBound::Int32))) 
+
+     -- toEnum
+  printTest ((map (toEnum::Int->Int32) [1, fromIntegral (minBound::Int32), fromIntegral (maxBound::Int32)]))
+  mayBomb   (printTest ((toEnum (maxBound::Int))::Int32))
+
+     -- fromEnum
+  printTest ((map fromEnum [(1::Int32),minBound,maxBound]))
+
+     -- [x..] aka enumFrom
+  printTest ((take 7 [(1::Int32)..]))
+  printTest ((take 7 [((maxBound::Int32)-5)..])) -- just in case it doesn't catch the upper bound..
+  
+     -- [x,y..] aka enumFromThen
+  printTest ((take 7 [(1::Int32),2..]))
+  printTest ((take 7 [(1::Int32),7..]))
+  printTest ((take 7 [(1::Int32),1..]))
+  printTest ((take 7 [(1::Int32),0..]))
+  printTest ((take 7 [(5::Int32),2..]))
+  let x = (minBound::Int32) + 1
+  printTest ((take 7 [x, x-1 ..]))
+  let x = (minBound::Int32) + 5
+  printTest ((take 7 [x, x-1 ..]))
+  let x = (maxBound::Int32) - 5
+  printTest ((take 7 [x, (x+1) ..]))
+
+     -- [x..y] aka enumFromTo
+  printTest ((take 7 ([(1::Int32) .. 5])))
+  printTest ((take 4 ([(1::Int32) .. 1])))
+  printTest ((take 7 ([(1::Int32) .. 0])))
+  printTest ((take 7 ([(5::Int32) .. 0])))
+  printTest ((take 7 ([(maxBound-(5::Int32)) .. maxBound])))
+  printTest ((take 7 ([(minBound+(5::Int32)) .. minBound])))
+
+     -- [x,y..z] aka enumFromThenTo
+  printTest ((take 7 [(5::Int32),4..1]))
+  printTest ((take 7 [(5::Int32),3..1]))
+  printTest ((take 7 [(5::Int32),3..2]))
+  printTest ((take 7 [(1::Int32),2..1]))
+  printTest ((take 7 [(2::Int32),1..2]))
+  printTest ((take 7 [(2::Int32),1..1]))
+  printTest ((take 7 [(2::Int32),3..1]))
+
+  let x = (maxBound::Int32) - 4
+  printTest ((take 7 [x,(x+1)..maxBound]))
+  let x = (minBound::Int32) + 5
+  printTest ((take 7 [x,(x-1)..minBound]))
+
+testEnumInt64 :: IO ()
+testEnumInt64 = do
+     -- succ
+  printTest ((succ (0::Int64)))
+  printTest ((succ (minBound::Int64)))
+  mayBomb   (printTest ((succ (maxBound::Int64))))
+
+     -- pred
+  printTest (pred (1::Int64))
+  printTest (pred (maxBound::Int64))
+  mayBomb   (printTest (pred (minBound::Int64))) 
+
+     -- toEnum
+  mayBomb   (printTest ((map (toEnum::Int->Int64) [1, fromIntegral (minBound::Int64), fromIntegral (maxBound::Int64)])))
+  mayBomb   (printTest ((toEnum (maxBound::Int))::Int64))
+
+     -- fromEnum
+  printTest ((map fromEnum [(1::Int64),fromIntegral (minBound::Int) ,fromIntegral (maxBound::Int)]))
+  mayBomb   (printTest (fromEnum (maxBound::Int64)))
+
+     -- [x..] aka enumFrom
+  printTest ((take 7 [(1::Int64)..]))
+  printTest ((take 7 [((maxBound::Int64)-5)..])) -- just in case it doesn't catch the upper bound..
+
+     -- [x,y..] aka enumFromThen
+  printTest ((take 7 [(1::Int64),2..]))
+  printTest ((take 7 [(1::Int64),7..]))
+  printTest ((take 7 [(1::Int64),1..]))
+  printTest ((take 7 [(1::Int64),0..]))
+  printTest ((take 7 [(5::Int64),2..]))
+  let x = (minBound::Int64) + 1
+  printTest ((take 7 [x, x-1 ..]))
+  let x = (minBound::Int64) + 5
+  printTest ((take 7 [x, x-1 ..]))
+  let x = (maxBound::Int64) - 5
+  printTest ((take 7 [x, (x+1) ..]))
+
+     -- [x..y] aka enumFromTo
+  printTest ((take 7 ([(1::Int64) .. 5])))
+  printTest ((take 4 ([(1::Int64) .. 1])))
+  printTest ((take 7 ([(1::Int64) .. 0])))
+  printTest ((take 7 ([(5::Int64) .. 0])))
+  printTest ((take 7 ([(maxBound-(5::Int64)) .. maxBound])))
+  printTest ((take 7 ([(minBound+(5::Int64)) .. minBound])))
+
+     -- [x,y..z] aka enumFromThenTo
+  printTest ((take 7 [(5::Int64),4..1]))
+  printTest ((take 7 [(5::Int64),3..1]))
+  printTest ((take 7 [(5::Int64),3..2]))
+  printTest ((take 7 [(1::Int64),2..1]))
+  printTest ((take 7 [(2::Int64),1..2]))
+  printTest ((take 7 [(2::Int64),1..1]))
+  printTest ((take 7 [(2::Int64),3..1]))
+
+  let x = (maxBound::Int64) - 4
+  printTest ((take 7 [x,(x+1)..maxBound]))
+  let x = (minBound::Int64) + 5
+  printTest ((take 7 [x,(x-1)..minBound]))
+
+
+--
+--
+--  Utils
+--
+--
+
+
+mayBomb x = catch x (\(ErrorCall e) -> putStrLn ("error " ++ show e))
+  `catch` (\e -> putStrLn ("Fail: " ++ show (e :: SomeException)))
diff --git a/libraries/base/tests/enum02.stdout b/libraries/base/tests/enum02.stdout
new file mode 100644
index 000000000000..06d3bb5caef1
--- /dev/null
+++ b/libraries/base/tests/enum02.stdout
@@ -0,0 +1,141 @@
+Testing Enum Int8:
+    (succ (0::Int8)) = 1
+    (succ (minBound::Int8)) = -127
+    (succ (maxBound::Int8)) = error "Enum.succ{Int8}: tried to take `succ' of maxBound"
+    pred (1::Int8) = 0
+    pred (maxBound::Int8) = 126
+    pred (minBound::Int8) = error "Enum.pred{Int8}: tried to take `pred' of minBound"
+    (map (toEnum::Int->Int8) [1, fromIntegral (minBound::Int8), fromIntegral (maxBound::Int8)]) = [1,-128,127]
+    (toEnum (maxBound::Int))::Int8 = error "Enum.toEnum{Int8}: tag (2147483647) is outside of bounds (-128,127)"
+    (map fromEnum [(1::Int8),minBound,maxBound]) = [1,-128,127]
+    (take 7 [(1::Int8)..]) = [1,2,3,4,5,6,7]
+    (take 7 [((maxBound::Int8)-5)..]) = [122,123,124,125,126,127]
+    (take 7 [(1::Int8),2..]) = [1,2,3,4,5,6,7]
+    (take 7 [(1::Int8),7..]) = [1,7,13,19,25,31,37]
+    (take 7 [(1::Int8),1..]) = [1,1,1,1,1,1,1]
+    (take 7 [(1::Int8),0..]) = [1,0,-1,-2,-3,-4,-5]
+    (take 7 [(5::Int8),2..]) = [5,2,-1,-4,-7,-10,-13]
+    (take 7 [x, x-1 ..]) = [-127,-128]
+    (take 7 [x, x-1 ..]) = [-123,-124,-125,-126,-127,-128]
+    (take 7 [x, (x+1) ..]) = [122,123,124,125,126,127]
+    (take 7 ([(1::Int8) .. 5])) = [1,2,3,4,5]
+    (take 4 ([(1::Int8) .. 1])) = [1]
+    (take 7 ([(1::Int8) .. 0])) = []
+    (take 7 ([(5::Int8) .. 0])) = []
+    (take 7 ([(maxBound-(5::Int8)) .. maxBound])) = [122,123,124,125,126,127]
+    (take 7 ([(minBound+(5::Int8)) .. minBound])) = []
+    (take 7 [(5::Int8),4..1]) = [5,4,3,2,1]
+    (take 7 [(5::Int8),3..1]) = [5,3,1]
+    (take 7 [(5::Int8),3..2]) = [5,3]
+    (take 7 [(1::Int8),2..1]) = [1]
+    (take 7 [(2::Int8),1..2]) = [2]
+    (take 7 [(2::Int8),1..1]) = [2,1]
+    (take 7 [(2::Int8),3..1]) = []
+    (take 7 [x,(x+1)..maxBound]) = [123,124,125,126,127]
+    (take 7 [x,(x-1)..minBound]) = [-123,-124,-125,-126,-127,-128]
+Testing Enum Int16:
+    (succ (0::Int16)) = 1
+    (succ (minBound::Int16)) = -32767
+    (succ (maxBound::Int16)) = error "Enum.succ{Int16}: tried to take `succ' of maxBound"
+    pred (1::Int16) = 0
+    pred (maxBound::Int16) = 32766
+    pred (minBound::Int16) = error "Enum.pred{Int16}: tried to take `pred' of minBound"
+    (map (toEnum::Int->Int16) [1, fromIntegral (minBound::Int16), fromIntegral (maxBound::Int16)]) = [1,-32768,32767]
+    (toEnum (maxBound::Int))::Int16 = error "Enum.toEnum{Int16}: tag (2147483647) is outside of bounds (-32768,32767)"
+    (map fromEnum [(1::Int16),minBound,maxBound]) = [1,-32768,32767]
+    (take 7 [(1::Int16)..]) = [1,2,3,4,5,6,7]
+    (take 7 [((maxBound::Int16)-5)..]) = [32762,32763,32764,32765,32766,32767]
+    (take 7 [(1::Int16),2..]) = [1,2,3,4,5,6,7]
+    (take 7 [(1::Int16),7..]) = [1,7,13,19,25,31,37]
+    (take 7 [(1::Int16),1..]) = [1,1,1,1,1,1,1]
+    (take 7 [(1::Int16),0..]) = [1,0,-1,-2,-3,-4,-5]
+    (take 7 [(5::Int16),2..]) = [5,2,-1,-4,-7,-10,-13]
+    (take 7 [x, x-1 ..]) = [-32767,-32768]
+    (take 7 [x, x-1 ..]) = [-32763,-32764,-32765,-32766,-32767,-32768]
+    (take 7 [x, (x+1) ..]) = [32762,32763,32764,32765,32766,32767]
+    (take 7 ([(1::Int16) .. 5])) = [1,2,3,4,5]
+    (take 4 ([(1::Int16) .. 1])) = [1]
+    (take 7 ([(1::Int16) .. 0])) = []
+    (take 7 ([(5::Int16) .. 0])) = []
+    (take 7 ([(maxBound-(5::Int16)) .. maxBound])) = [32762,32763,32764,32765,32766,32767]
+    (take 7 ([(minBound+(5::Int16)) .. minBound])) = []
+    (take 7 [(5::Int16),4..1]) = [5,4,3,2,1]
+    (take 7 [(5::Int16),3..1]) = [5,3,1]
+    (take 7 [(5::Int16),3..2]) = [5,3]
+    (take 7 [(1::Int16),2..1]) = [1]
+    (take 7 [(2::Int16),1..2]) = [2]
+    (take 7 [(2::Int16),1..1]) = [2,1]
+    (take 7 [(2::Int16),3..1]) = []
+    (take 7 [x,(x+1)..maxBound]) = [32763,32764,32765,32766,32767]
+    (take 7 [x,(x-1)..minBound]) = [-32763,-32764,-32765,-32766,-32767,-32768]
+Testing Enum Int32:
+    (succ (0::Int32)) = 1
+    (succ (minBound::Int32)) = -2147483647
+    (succ (maxBound::Int32)) = error "Enum.succ{Int32}: tried to take `succ' of maxBound"
+    pred (1::Int32) = 0
+    pred (maxBound::Int32) = 2147483646
+    pred (minBound::Int32) = error "Enum.pred{Int32}: tried to take `pred' of minBound"
+    (map (toEnum::Int->Int32) [1, fromIntegral (minBound::Int32), fromIntegral (maxBound::Int32)]) = [1,-2147483648,2147483647]
+    (toEnum (maxBound::Int))::Int32 = 2147483647
+    (map fromEnum [(1::Int32),minBound,maxBound]) = [1,-2147483648,2147483647]
+    (take 7 [(1::Int32)..]) = [1,2,3,4,5,6,7]
+    (take 7 [((maxBound::Int32)-5)..]) = [2147483642,2147483643,2147483644,2147483645,2147483646,2147483647]
+    (take 7 [(1::Int32),2..]) = [1,2,3,4,5,6,7]
+    (take 7 [(1::Int32),7..]) = [1,7,13,19,25,31,37]
+    (take 7 [(1::Int32),1..]) = [1,1,1,1,1,1,1]
+    (take 7 [(1::Int32),0..]) = [1,0,-1,-2,-3,-4,-5]
+    (take 7 [(5::Int32),2..]) = [5,2,-1,-4,-7,-10,-13]
+    (take 7 [x, x-1 ..]) = [-2147483647,-2147483648]
+    (take 7 [x, x-1 ..]) = [-2147483643,-2147483644,-2147483645,-2147483646,-2147483647,-2147483648]
+    (take 7 [x, (x+1) ..]) = [2147483642,2147483643,2147483644,2147483645,2147483646,2147483647]
+    (take 7 ([(1::Int32) .. 5])) = [1,2,3,4,5]
+    (take 4 ([(1::Int32) .. 1])) = [1]
+    (take 7 ([(1::Int32) .. 0])) = []
+    (take 7 ([(5::Int32) .. 0])) = []
+    (take 7 ([(maxBound-(5::Int32)) .. maxBound])) = [2147483642,2147483643,2147483644,2147483645,2147483646,2147483647]
+    (take 7 ([(minBound+(5::Int32)) .. minBound])) = []
+    (take 7 [(5::Int32),4..1]) = [5,4,3,2,1]
+    (take 7 [(5::Int32),3..1]) = [5,3,1]
+    (take 7 [(5::Int32),3..2]) = [5,3]
+    (take 7 [(1::Int32),2..1]) = [1]
+    (take 7 [(2::Int32),1..2]) = [2]
+    (take 7 [(2::Int32),1..1]) = [2,1]
+    (take 7 [(2::Int32),3..1]) = []
+    (take 7 [x,(x+1)..maxBound]) = [2147483643,2147483644,2147483645,2147483646,2147483647]
+    (take 7 [x,(x-1)..minBound]) = [-2147483643,-2147483644,-2147483645,-2147483646,-2147483647,-2147483648]
+Testing Enum Int64:
+    (succ (0::Int64)) = 1
+    (succ (minBound::Int64)) = -9223372036854775807
+    (succ (maxBound::Int64)) = error "Enum.succ{Int64}: tried to take `succ' of maxBound"
+    pred (1::Int64) = 0
+    pred (maxBound::Int64) = 9223372036854775806
+    pred (minBound::Int64) = error "Enum.pred{Int64}: tried to take `pred' of minBound"
+    (map (toEnum::Int->Int64) [1, fromIntegral (minBound::Int64), fromIntegral (maxBound::Int64)]) = [1,0,-1]
+    (toEnum (maxBound::Int))::Int64 = 2147483647
+    (map fromEnum [(1::Int64),fromIntegral (minBound::Int) ,fromIntegral (maxBound::Int)]) = [1,-2147483648,2147483647]
+    fromEnum (maxBound::Int64) = error "Enum.fromEnum{Int64}: value (9223372036854775807) is outside of Int's bounds (-2147483648,2147483647)"
+    (take 7 [(1::Int64)..]) = [1,2,3,4,5,6,7]
+    (take 7 [((maxBound::Int64)-5)..]) = [9223372036854775802,9223372036854775803,9223372036854775804,9223372036854775805,9223372036854775806,9223372036854775807]
+    (take 7 [(1::Int64),2..]) = [1,2,3,4,5,6,7]
+    (take 7 [(1::Int64),7..]) = [1,7,13,19,25,31,37]
+    (take 7 [(1::Int64),1..]) = [1,1,1,1,1,1,1]
+    (take 7 [(1::Int64),0..]) = [1,0,-1,-2,-3,-4,-5]
+    (take 7 [(5::Int64),2..]) = [5,2,-1,-4,-7,-10,-13]
+    (take 7 [x, x-1 ..]) = [-9223372036854775807,-9223372036854775808]
+    (take 7 [x, x-1 ..]) = [-9223372036854775803,-9223372036854775804,-9223372036854775805,-9223372036854775806,-9223372036854775807,-9223372036854775808]
+    (take 7 [x, (x+1) ..]) = [9223372036854775802,9223372036854775803,9223372036854775804,9223372036854775805,9223372036854775806,9223372036854775807]
+    (take 7 ([(1::Int64) .. 5])) = [1,2,3,4,5]
+    (take 4 ([(1::Int64) .. 1])) = [1]
+    (take 7 ([(1::Int64) .. 0])) = []
+    (take 7 ([(5::Int64) .. 0])) = []
+    (take 7 ([(maxBound-(5::Int64)) .. maxBound])) = [9223372036854775802,9223372036854775803,9223372036854775804,9223372036854775805,9223372036854775806,9223372036854775807]
+    (take 7 ([(minBound+(5::Int64)) .. minBound])) = []
+    (take 7 [(5::Int64),4..1]) = [5,4,3,2,1]
+    (take 7 [(5::Int64),3..1]) = [5,3,1]
+    (take 7 [(5::Int64),3..2]) = [5,3]
+    (take 7 [(1::Int64),2..1]) = [1]
+    (take 7 [(2::Int64),1..2]) = [2]
+    (take 7 [(2::Int64),1..1]) = [2,1]
+    (take 7 [(2::Int64),3..1]) = []
+    (take 7 [x,(x+1)..maxBound]) = [9223372036854775803,9223372036854775804,9223372036854775805,9223372036854775806,9223372036854775807]
+    (take 7 [x,(x-1)..minBound]) = [-9223372036854775803,-9223372036854775804,-9223372036854775805,-9223372036854775806,-9223372036854775807,-9223372036854775808]
diff --git a/libraries/base/tests/enum02.stdout-alpha-dec-osf3 b/libraries/base/tests/enum02.stdout-alpha-dec-osf3
new file mode 100644
index 000000000000..23222450b583
--- /dev/null
+++ b/libraries/base/tests/enum02.stdout-alpha-dec-osf3
@@ -0,0 +1,141 @@
+Testing Enum Int8:
+    (succ (0::Int8)) = 1
+    (succ (minBound::Int8)) = -127
+    (succ (maxBound::Int8)) = error "Enum.succ{Int8}: tried to take `succ' of maxBound"
+    pred (1::Int8) = 0
+    pred (maxBound::Int8) = 126
+    pred (minBound::Int8) = error "Enum.pred{Int8}: tried to take `pred' of minBound"
+    (map (toEnum::Int->Int8) [1, toInt (minBound::Int8), toInt (maxBound::Int8)]) = [1,-128,127]
+    (toEnum (maxBound::Int))::Int8 = error "Enum.toEnum{Int8}: tag (9223372036854775807) is outside of bounds (-128,127)"
+    (map fromEnum [(1::Int8),minBound,maxBound]) = [1,-128,127]
+    (take 7 [(1::Int8)..]) = [1,2,3,4,5,6,7]
+    (take 7 [((maxBound::Int8)-5)..]) = [122,123,124,125,126,127]
+    (take 7 [(1::Int8),2..]) = [1,2,3,4,5,6,7]
+    (take 7 [(1::Int8),7..]) = [1,7,13,19,25,31,37]
+    (take 7 [(1::Int8),1..]) = [1,1,1,1,1,1,1]
+    (take 7 [(1::Int8),0..]) = [1,0,-1,-2,-3,-4,-5]
+    (take 7 [(5::Int8),2..]) = [5,2,-1,-4,-7,-10,-13]
+    (take 7 [x, x-1 ..]) = [-127,-128]
+    (take 7 [x, x-1 ..]) = [-123,-124,-125,-126,-127,-128]
+    (take 7 [x, (x+1) ..]) = [122,123,124,125,126,127]
+    (take 7 ([(1::Int8) .. 5])) = [1,2,3,4,5]
+    (take 4 ([(1::Int8) .. 1])) = [1]
+    (take 7 ([(1::Int8) .. 0])) = []
+    (take 7 ([(5::Int8) .. 0])) = []
+    (take 7 ([(maxBound-(5::Int8)) .. maxBound])) = [122,123,124,125,126,127]
+    (take 7 ([(minBound+(5::Int8)) .. minBound])) = []
+    (take 7 [(5::Int8),4..1]) = [5,4,3,2,1]
+    (take 7 [(5::Int8),3..1]) = [5,3,1]
+    (take 7 [(5::Int8),3..2]) = [5,3]
+    (take 7 [(1::Int8),2..1]) = [1]
+    (take 7 [(2::Int8),1..2]) = [2]
+    (take 7 [(2::Int8),1..1]) = [2,1]
+    (take 7 [(2::Int8),3..1]) = []
+    (take 7 [x,(x+1)..maxBound]) = [123,124,125,126,127]
+    (take 7 [x,(x-1)..minBound]) = [-123,-124,-125,-126,-127,-128]
+Testing Enum Int16:
+    (succ (0::Int16)) = 1
+    (succ (minBound::Int16)) = -32767
+    (succ (maxBound::Int16)) = error "Enum.succ{Int16}: tried to take `succ' of maxBound"
+    pred (1::Int16) = 0
+    pred (maxBound::Int16) = 32766
+    pred (minBound::Int16) = error "Enum.pred{Int16}: tried to take `pred' of minBound"
+    (map (toEnum::Int->Int16) [1, toInt (minBound::Int16), toInt (maxBound::Int16)]) = [1,-32768,32767]
+    (toEnum (maxBound::Int))::Int16 = error "Enum.toEnum{Int16}: tag (9223372036854775807) is outside of bounds (-32768,32767)"
+    (map fromEnum [(1::Int16),minBound,maxBound]) = [1,-32768,32767]
+    (take 7 [(1::Int16)..]) = [1,2,3,4,5,6,7]
+    (take 7 [((maxBound::Int16)-5)..]) = [32762,32763,32764,32765,32766,32767]
+    (take 7 [(1::Int16),2..]) = [1,2,3,4,5,6,7]
+    (take 7 [(1::Int16),7..]) = [1,7,13,19,25,31,37]
+    (take 7 [(1::Int16),1..]) = [1,1,1,1,1,1,1]
+    (take 7 [(1::Int16),0..]) = [1,0,-1,-2,-3,-4,-5]
+    (take 7 [(5::Int16),2..]) = [5,2,-1,-4,-7,-10,-13]
+    (take 7 [x, x-1 ..]) = [-32767,-32768]
+    (take 7 [x, x-1 ..]) = [-32763,-32764,-32765,-32766,-32767,-32768]
+    (take 7 [x, (x+1) ..]) = [32762,32763,32764,32765,32766,32767]
+    (take 7 ([(1::Int16) .. 5])) = [1,2,3,4,5]
+    (take 4 ([(1::Int16) .. 1])) = [1]
+    (take 7 ([(1::Int16) .. 0])) = []
+    (take 7 ([(5::Int16) .. 0])) = []
+    (take 7 ([(maxBound-(5::Int16)) .. maxBound])) = [32762,32763,32764,32765,32766,32767]
+    (take 7 ([(minBound+(5::Int16)) .. minBound])) = []
+    (take 7 [(5::Int16),4..1]) = [5,4,3,2,1]
+    (take 7 [(5::Int16),3..1]) = [5,3,1]
+    (take 7 [(5::Int16),3..2]) = [5,3]
+    (take 7 [(1::Int16),2..1]) = [1]
+    (take 7 [(2::Int16),1..2]) = [2]
+    (take 7 [(2::Int16),1..1]) = [2,1]
+    (take 7 [(2::Int16),3..1]) = []
+    (take 7 [x,(x+1)..maxBound]) = [32763,32764,32765,32766,32767]
+    (take 7 [x,(x-1)..minBound]) = [-32763,-32764,-32765,-32766,-32767,-32768]
+Testing Enum Int32:
+    (succ (0::Int32)) = 1
+    (succ (minBound::Int32)) = -2147483647
+    (succ (maxBound::Int32)) = error "Enum.succ{Int32}: tried to take `succ' of maxBound"
+    pred (1::Int32) = 0
+    pred (maxBound::Int32) = 2147483646
+    pred (minBound::Int32) = error "Enum.pred{Int32}: tried to take `pred' of minBound"
+    (map (toEnum::Int->Int32) [1, toInt (minBound::Int32), toInt (maxBound::Int32)]) = [1,-2147483648,2147483647]
+    (toEnum (maxBound::Int))::Int32 = error "Enum.toEnum{Int32}: tag (9223372036854775807) is outside of bounds (-2147483648,2147483647)"
+    (map fromEnum [(1::Int32),minBound,maxBound]) = [1,-2147483648,2147483647]
+    (take 7 [(1::Int32)..]) = [1,2,3,4,5,6,7]
+    (take 7 [((maxBound::Int32)-5)..]) = [2147483642,2147483643,2147483644,2147483645,2147483646,2147483647]
+    (take 7 [(1::Int32),2..]) = [1,2,3,4,5,6,7]
+    (take 7 [(1::Int32),7..]) = [1,7,13,19,25,31,37]
+    (take 7 [(1::Int32),1..]) = [1,1,1,1,1,1,1]
+    (take 7 [(1::Int32),0..]) = [1,0,-1,-2,-3,-4,-5]
+    (take 7 [(5::Int32),2..]) = [5,2,-1,-4,-7,-10,-13]
+    (take 7 [x, x-1 ..]) = [-2147483647,-2147483648]
+    (take 7 [x, x-1 ..]) = [-2147483643,-2147483644,-2147483645,-2147483646,-2147483647,-2147483648]
+    (take 7 [x, (x+1) ..]) = [2147483642,2147483643,2147483644,2147483645,2147483646,2147483647]
+    (take 7 ([(1::Int32) .. 5])) = [1,2,3,4,5]
+    (take 4 ([(1::Int32) .. 1])) = [1]
+    (take 7 ([(1::Int32) .. 0])) = []
+    (take 7 ([(5::Int32) .. 0])) = []
+    (take 7 ([(maxBound-(5::Int32)) .. maxBound])) = [2147483642,2147483643,2147483644,2147483645,2147483646,2147483647]
+    (take 7 ([(minBound+(5::Int32)) .. minBound])) = []
+    (take 7 [(5::Int32),4..1]) = [5,4,3,2,1]
+    (take 7 [(5::Int32),3..1]) = [5,3,1]
+    (take 7 [(5::Int32),3..2]) = [5,3]
+    (take 7 [(1::Int32),2..1]) = [1]
+    (take 7 [(2::Int32),1..2]) = [2]
+    (take 7 [(2::Int32),1..1]) = [2,1]
+    (take 7 [(2::Int32),3..1]) = []
+    (take 7 [x,(x+1)..maxBound]) = [2147483643,2147483644,2147483645,2147483646,2147483647]
+    (take 7 [x,(x-1)..minBound]) = [-2147483643,-2147483644,-2147483645,-2147483646,-2147483647,-2147483648]
+Testing Enum Int64:
+    (succ (0::Int64)) = 1
+    (succ (minBound::Int64)) = -9223372036854775807
+    (succ (maxBound::Int64)) = error "Enum.succ{Int64}: tried to take `succ' of maxBound"
+    pred (1::Int64) = 0
+    pred (maxBound::Int64) = 9223372036854775806
+    pred (minBound::Int64) = error "Enum.pred{Int64}: tried to take `pred' of minBound"
+    (map (toEnum::Int->Int64) [1, toInt (minBound::Int64), toInt (maxBound::Int64)]) = [1,-9223372036854775808,9223372036854775807]
+    (toEnum (maxBound::Int))::Int64 = 9223372036854775807
+    (map fromEnum [(1::Int64),fromInt (minBound::Int) ,fromInt (maxBound::Int)]) = [1,-9223372036854775808,9223372036854775807]
+    fromEnum (maxBound::Int64) = 9223372036854775807
+    (take 7 [(1::Int64)..]) = [1,2,3,4,5,6,7]
+    (take 7 [((maxBound::Int64)-5)..]) = [9223372036854775802,9223372036854775803,9223372036854775804,9223372036854775805,9223372036854775806,9223372036854775807]
+    (take 7 [(1::Int64),2..]) = [1,2,3,4,5,6,7]
+    (take 7 [(1::Int64),7..]) = [1,7,13,19,25,31,37]
+    (take 7 [(1::Int64),1..]) = [1,1,1,1,1,1,1]
+    (take 7 [(1::Int64),0..]) = [1,0,-1,-2,-3,-4,-5]
+    (take 7 [(5::Int64),2..]) = [5,2,-1,-4,-7,-10,-13]
+    (take 7 [x, x-1 ..]) = [-9223372036854775807,-9223372036854775808]
+    (take 7 [x, x-1 ..]) = [-9223372036854775803,-9223372036854775804,-9223372036854775805,-9223372036854775806,-9223372036854775807,-9223372036854775808]
+    (take 7 [x, (x+1) ..]) = [9223372036854775802,9223372036854775803,9223372036854775804,9223372036854775805,9223372036854775806,9223372036854775807]
+    (take 7 ([(1::Int64) .. 5])) = [1,2,3,4,5]
+    (take 4 ([(1::Int64) .. 1])) = [1]
+    (take 7 ([(1::Int64) .. 0])) = []
+    (take 7 ([(5::Int64) .. 0])) = []
+    (take 7 ([(maxBound-(5::Int64)) .. maxBound])) = [9223372036854775802,9223372036854775803,9223372036854775804,9223372036854775805,9223372036854775806,9223372036854775807]
+    (take 7 ([(minBound+(5::Int64)) .. minBound])) = []
+    (take 7 [(5::Int64),4..1]) = [5,4,3,2,1]
+    (take 7 [(5::Int64),3..1]) = [5,3,1]
+    (take 7 [(5::Int64),3..2]) = [5,3]
+    (take 7 [(1::Int64),2..1]) = [1]
+    (take 7 [(2::Int64),1..2]) = [2]
+    (take 7 [(2::Int64),1..1]) = [2,1]
+    (take 7 [(2::Int64),3..1]) = []
+    (take 7 [x,(x+1)..maxBound]) = [9223372036854775803,9223372036854775804,9223372036854775805,9223372036854775806,9223372036854775807]
+    (take 7 [x,(x-1)..minBound]) = [-9223372036854775803,-9223372036854775804,-9223372036854775805,-9223372036854775806,-9223372036854775807,-9223372036854775808]
diff --git a/libraries/base/tests/enum02.stdout-hugs b/libraries/base/tests/enum02.stdout-hugs
new file mode 100644
index 000000000000..a28b84b1878c
--- /dev/null
+++ b/libraries/base/tests/enum02.stdout-hugs
@@ -0,0 +1,141 @@
+Testing Enum Int8:
+    (succ (0::Int8)) = 1
+    (succ (minBound::Int8)) = -127
+    (succ (maxBound::Int8)) = error "succ: applied to maxBound"
+    pred (1::Int8) = 0
+    pred (maxBound::Int8) = 126
+    pred (minBound::Int8) = error "pred: applied to minBound"
+    (map (toEnum::Int->Int8) [1, fromIntegral (minBound::Int8), fromIntegral (maxBound::Int8)]) = [1,-128,127]
+    (toEnum (maxBound::Int))::Int8 = -1
+    (map fromEnum [(1::Int8),minBound,maxBound]) = [1,-128,127]
+    (take 7 [(1::Int8)..]) = [1,2,3,4,5,6,7]
+    (take 7 [((maxBound::Int8)-5)..]) = [122,123,124,125,126,127]
+    (take 7 [(1::Int8),2..]) = [1,2,3,4,5,6,7]
+    (take 7 [(1::Int8),7..]) = [1,7,13,19,25,31,37]
+    (take 7 [(1::Int8),1..]) = [1,1,1,1,1,1,1]
+    (take 7 [(1::Int8),0..]) = [1,0,-1,-2,-3,-4,-5]
+    (take 7 [(5::Int8),2..]) = [5,2,-1,-4,-7,-10,-13]
+    (take 7 [x, x-1 ..]) = [-127,-128]
+    (take 7 [x, x-1 ..]) = [-123,-124,-125,-126,-127,-128]
+    (take 7 [x, (x+1) ..]) = [122,123,124,125,126,127]
+    (take 7 ([(1::Int8) .. 5])) = [1,2,3,4,5]
+    (take 4 ([(1::Int8) .. 1])) = [1]
+    (take 7 ([(1::Int8) .. 0])) = []
+    (take 7 ([(5::Int8) .. 0])) = []
+    (take 7 ([(maxBound-(5::Int8)) .. maxBound])) = [122,123,124,125,126,127]
+    (take 7 ([(minBound+(5::Int8)) .. minBound])) = []
+    (take 7 [(5::Int8),4..1]) = [5,4,3,2,1]
+    (take 7 [(5::Int8),3..1]) = [5,3,1]
+    (take 7 [(5::Int8),3..2]) = [5,3]
+    (take 7 [(1::Int8),2..1]) = [1]
+    (take 7 [(2::Int8),1..2]) = [2]
+    (take 7 [(2::Int8),1..1]) = [2,1]
+    (take 7 [(2::Int8),3..1]) = []
+    (take 7 [x,(x+1)..maxBound]) = [123,124,125,126,127]
+    (take 7 [x,(x-1)..minBound]) = [-123,-124,-125,-126,-127,-128]
+Testing Enum Int16:
+    (succ (0::Int16)) = 1
+    (succ (minBound::Int16)) = -32767
+    (succ (maxBound::Int16)) = error "succ: applied to maxBound"
+    pred (1::Int16) = 0
+    pred (maxBound::Int16) = 32766
+    pred (minBound::Int16) = error "pred: applied to minBound"
+    (map (toEnum::Int->Int16) [1, fromIntegral (minBound::Int16), fromIntegral (maxBound::Int16)]) = [1,-32768,32767]
+    (toEnum (maxBound::Int))::Int16 = -1
+    (map fromEnum [(1::Int16),minBound,maxBound]) = [1,-32768,32767]
+    (take 7 [(1::Int16)..]) = [1,2,3,4,5,6,7]
+    (take 7 [((maxBound::Int16)-5)..]) = [32762,32763,32764,32765,32766,32767]
+    (take 7 [(1::Int16),2..]) = [1,2,3,4,5,6,7]
+    (take 7 [(1::Int16),7..]) = [1,7,13,19,25,31,37]
+    (take 7 [(1::Int16),1..]) = [1,1,1,1,1,1,1]
+    (take 7 [(1::Int16),0..]) = [1,0,-1,-2,-3,-4,-5]
+    (take 7 [(5::Int16),2..]) = [5,2,-1,-4,-7,-10,-13]
+    (take 7 [x, x-1 ..]) = [-32767,-32768]
+    (take 7 [x, x-1 ..]) = [-32763,-32764,-32765,-32766,-32767,-32768]
+    (take 7 [x, (x+1) ..]) = [32762,32763,32764,32765,32766,32767]
+    (take 7 ([(1::Int16) .. 5])) = [1,2,3,4,5]
+    (take 4 ([(1::Int16) .. 1])) = [1]
+    (take 7 ([(1::Int16) .. 0])) = []
+    (take 7 ([(5::Int16) .. 0])) = []
+    (take 7 ([(maxBound-(5::Int16)) .. maxBound])) = [32762,32763,32764,32765,32766,32767]
+    (take 7 ([(minBound+(5::Int16)) .. minBound])) = []
+    (take 7 [(5::Int16),4..1]) = [5,4,3,2,1]
+    (take 7 [(5::Int16),3..1]) = [5,3,1]
+    (take 7 [(5::Int16),3..2]) = [5,3]
+    (take 7 [(1::Int16),2..1]) = [1]
+    (take 7 [(2::Int16),1..2]) = [2]
+    (take 7 [(2::Int16),1..1]) = [2,1]
+    (take 7 [(2::Int16),3..1]) = []
+    (take 7 [x,(x+1)..maxBound]) = [32763,32764,32765,32766,32767]
+    (take 7 [x,(x-1)..minBound]) = [-32763,-32764,-32765,-32766,-32767,-32768]
+Testing Enum Int32:
+    (succ (0::Int32)) = 1
+    (succ (minBound::Int32)) = -2147483647
+    (succ (maxBound::Int32)) = error "succ: applied to maxBound"
+    pred (1::Int32) = 0
+    pred (maxBound::Int32) = 2147483646
+    pred (minBound::Int32) = error "pred: applied to minBound"
+    (map (toEnum::Int->Int32) [1, fromIntegral (minBound::Int32), fromIntegral (maxBound::Int32)]) = [1,-2147483648,2147483647]
+    (toEnum (maxBound::Int))::Int32 = 2147483647
+    (map fromEnum [(1::Int32),minBound,maxBound]) = [1,-2147483648,2147483647]
+    (take 7 [(1::Int32)..]) = [1,2,3,4,5,6,7]
+    (take 7 [((maxBound::Int32)-5)..]) = [2147483642,2147483643,2147483644,2147483645,2147483646,2147483647]
+    (take 7 [(1::Int32),2..]) = [1,2,3,4,5,6,7]
+    (take 7 [(1::Int32),7..]) = [1,7,13,19,25,31,37]
+    (take 7 [(1::Int32),1..]) = [1,1,1,1,1,1,1]
+    (take 7 [(1::Int32),0..]) = [1,0,-1,-2,-3,-4,-5]
+    (take 7 [(5::Int32),2..]) = [5,2,-1,-4,-7,-10,-13]
+    (take 7 [x, x-1 ..]) = [-2147483647,-2147483648]
+    (take 7 [x, x-1 ..]) = [-2147483643,-2147483644,-2147483645,-2147483646,-2147483647,-2147483648]
+    (take 7 [x, (x+1) ..]) = [2147483642,2147483643,2147483644,2147483645,2147483646,2147483647]
+    (take 7 ([(1::Int32) .. 5])) = [1,2,3,4,5]
+    (take 4 ([(1::Int32) .. 1])) = [1]
+    (take 7 ([(1::Int32) .. 0])) = []
+    (take 7 ([(5::Int32) .. 0])) = []
+    (take 7 ([(maxBound-(5::Int32)) .. maxBound])) = [2147483642,2147483643,2147483644,2147483645,2147483646,2147483647]
+    (take 7 ([(minBound+(5::Int32)) .. minBound])) = []
+    (take 7 [(5::Int32),4..1]) = [5,4,3,2,1]
+    (take 7 [(5::Int32),3..1]) = [5,3,1]
+    (take 7 [(5::Int32),3..2]) = [5,3]
+    (take 7 [(1::Int32),2..1]) = [1]
+    (take 7 [(2::Int32),1..2]) = [2]
+    (take 7 [(2::Int32),1..1]) = [2,1]
+    (take 7 [(2::Int32),3..1]) = []
+    (take 7 [x,(x+1)..maxBound]) = [2147483643,2147483644,2147483645,2147483646,2147483647]
+    (take 7 [x,(x-1)..minBound]) = [-2147483643,-2147483644,-2147483645,-2147483646,-2147483647,-2147483648]
+Testing Enum Int64:
+    (succ (0::Int64)) = 1
+    (succ (minBound::Int64)) = -9223372036854775807
+    (succ (maxBound::Int64)) = error "succ: applied to maxBound"
+    pred (1::Int64) = 0
+    pred (maxBound::Int64) = 9223372036854775806
+    pred (minBound::Int64) = error "pred: applied to minBound"
+    (map (toEnum::Int->Int64) [1, fromIntegral (minBound::Int64), fromIntegral (maxBound::Int64)]) = [1,Fail: arithmetic overflow
+    (toEnum (maxBound::Int))::Int64 = 2147483647
+    (map fromEnum [(1::Int64),fromIntegral (minBound::Int) ,fromIntegral (maxBound::Int)]) = [1,-2147483648,2147483647]
+    fromEnum (maxBound::Int64) = Fail: arithmetic overflow
+    (take 7 [(1::Int64)..]) = [1,2,3,4,5,6,7]
+    (take 7 [((maxBound::Int64)-5)..]) = [9223372036854775802,9223372036854775803,9223372036854775804,9223372036854775805,9223372036854775806,9223372036854775807]
+    (take 7 [(1::Int64),2..]) = [1,2,3,4,5,6,7]
+    (take 7 [(1::Int64),7..]) = [1,7,13,19,25,31,37]
+    (take 7 [(1::Int64),1..]) = [1,1,1,1,1,1,1]
+    (take 7 [(1::Int64),0..]) = [1,0,-1,-2,-3,-4,-5]
+    (take 7 [(5::Int64),2..]) = [5,2,-1,-4,-7,-10,-13]
+    (take 7 [x, x-1 ..]) = [-9223372036854775807,-9223372036854775808]
+    (take 7 [x, x-1 ..]) = [-9223372036854775803,-9223372036854775804,-9223372036854775805,-9223372036854775806,-9223372036854775807,-9223372036854775808]
+    (take 7 [x, (x+1) ..]) = [9223372036854775802,9223372036854775803,9223372036854775804,9223372036854775805,9223372036854775806,9223372036854775807]
+    (take 7 ([(1::Int64) .. 5])) = [1,2,3,4,5]
+    (take 4 ([(1::Int64) .. 1])) = [1]
+    (take 7 ([(1::Int64) .. 0])) = []
+    (take 7 ([(5::Int64) .. 0])) = []
+    (take 7 ([(maxBound-(5::Int64)) .. maxBound])) = [9223372036854775802,9223372036854775803,9223372036854775804,9223372036854775805,9223372036854775806,9223372036854775807]
+    (take 7 ([(minBound+(5::Int64)) .. minBound])) = []
+    (take 7 [(5::Int64),4..1]) = [5,4,3,2,1]
+    (take 7 [(5::Int64),3..1]) = [5,3,1]
+    (take 7 [(5::Int64),3..2]) = [5,3]
+    (take 7 [(1::Int64),2..1]) = [1]
+    (take 7 [(2::Int64),1..2]) = [2]
+    (take 7 [(2::Int64),1..1]) = [2,1]
+    (take 7 [(2::Int64),3..1]) = []
+    (take 7 [x,(x+1)..maxBound]) = [9223372036854775803,9223372036854775804,9223372036854775805,9223372036854775806,9223372036854775807]
+    (take 7 [x,(x-1)..minBound]) = [-9223372036854775803,-9223372036854775804,-9223372036854775805,-9223372036854775806,-9223372036854775807,-9223372036854775808]
diff --git a/libraries/base/tests/enum02.stdout-mips-sgi-irix b/libraries/base/tests/enum02.stdout-mips-sgi-irix
new file mode 100644
index 000000000000..3177d541f405
--- /dev/null
+++ b/libraries/base/tests/enum02.stdout-mips-sgi-irix
@@ -0,0 +1,141 @@
+Testing Enum Int8:
+    (succ (0::Int8)) = 1
+    (succ (minBound::Int8)) = -127
+    (succ (maxBound::Int8)) = error "Enum.succ{Int8}: tried to take `succ' of maxBound"
+    pred (1::Int8) = 0
+    pred (maxBound::Int8) = 126
+    pred (minBound::Int8) = error "Enum.pred{Int8}: tried to take `pred' of minBound"
+    (map (toEnum::Int->Int8) [1, fromIntegral (minBound::Int8), fromIntegral (maxBound::Int8)]) = [1,-128,127]
+    (toEnum (maxBound::Int))::Int8 = error "Enum.toEnum{Int8}: tag (9223372036854775807) is outside of bounds (-128,127)"
+    (map fromEnum [(1::Int8),minBound,maxBound]) = [1,-128,127]
+    (take 7 [(1::Int8)..]) = [1,2,3,4,5,6,7]
+    (take 7 [((maxBound::Int8)-5)..]) = [122,123,124,125,126,127]
+    (take 7 [(1::Int8),2..]) = [1,2,3,4,5,6,7]
+    (take 7 [(1::Int8),7..]) = [1,7,13,19,25,31,37]
+    (take 7 [(1::Int8),1..]) = [1,1,1,1,1,1,1]
+    (take 7 [(1::Int8),0..]) = [1,0,-1,-2,-3,-4,-5]
+    (take 7 [(5::Int8),2..]) = [5,2,-1,-4,-7,-10,-13]
+    (take 7 [x, x-1 ..]) = [-127,-128]
+    (take 7 [x, x-1 ..]) = [-123,-124,-125,-126,-127,-128]
+    (take 7 [x, (x+1) ..]) = [122,123,124,125,126,127]
+    (take 7 ([(1::Int8) .. 5])) = [1,2,3,4,5]
+    (take 4 ([(1::Int8) .. 1])) = [1]
+    (take 7 ([(1::Int8) .. 0])) = []
+    (take 7 ([(5::Int8) .. 0])) = []
+    (take 7 ([(maxBound-(5::Int8)) .. maxBound])) = [122,123,124,125,126,127]
+    (take 7 ([(minBound+(5::Int8)) .. minBound])) = []
+    (take 7 [(5::Int8),4..1]) = [5,4,3,2,1]
+    (take 7 [(5::Int8),3..1]) = [5,3,1]
+    (take 7 [(5::Int8),3..2]) = [5,3]
+    (take 7 [(1::Int8),2..1]) = [1]
+    (take 7 [(2::Int8),1..2]) = [2]
+    (take 7 [(2::Int8),1..1]) = [2,1]
+    (take 7 [(2::Int8),3..1]) = []
+    (take 7 [x,(x+1)..maxBound]) = [123,124,125,126,127]
+    (take 7 [x,(x-1)..minBound]) = [-123,-124,-125,-126,-127,-128]
+Testing Enum Int16:
+    (succ (0::Int16)) = 1
+    (succ (minBound::Int16)) = -32767
+    (succ (maxBound::Int16)) = error "Enum.succ{Int16}: tried to take `succ' of maxBound"
+    pred (1::Int16) = 0
+    pred (maxBound::Int16) = 32766
+    pred (minBound::Int16) = error "Enum.pred{Int16}: tried to take `pred' of minBound"
+    (map (toEnum::Int->Int16) [1, fromIntegral (minBound::Int16), fromIntegral (maxBound::Int16)]) = [1,-32768,32767]
+    (toEnum (maxBound::Int))::Int16 = error "Enum.toEnum{Int16}: tag (9223372036854775807) is outside of bounds (-32768,32767)"
+    (map fromEnum [(1::Int16),minBound,maxBound]) = [1,-32768,32767]
+    (take 7 [(1::Int16)..]) = [1,2,3,4,5,6,7]
+    (take 7 [((maxBound::Int16)-5)..]) = [32762,32763,32764,32765,32766,32767]
+    (take 7 [(1::Int16),2..]) = [1,2,3,4,5,6,7]
+    (take 7 [(1::Int16),7..]) = [1,7,13,19,25,31,37]
+    (take 7 [(1::Int16),1..]) = [1,1,1,1,1,1,1]
+    (take 7 [(1::Int16),0..]) = [1,0,-1,-2,-3,-4,-5]
+    (take 7 [(5::Int16),2..]) = [5,2,-1,-4,-7,-10,-13]
+    (take 7 [x, x-1 ..]) = [-32767,-32768]
+    (take 7 [x, x-1 ..]) = [-32763,-32764,-32765,-32766,-32767,-32768]
+    (take 7 [x, (x+1) ..]) = [32762,32763,32764,32765,32766,32767]
+    (take 7 ([(1::Int16) .. 5])) = [1,2,3,4,5]
+    (take 4 ([(1::Int16) .. 1])) = [1]
+    (take 7 ([(1::Int16) .. 0])) = []
+    (take 7 ([(5::Int16) .. 0])) = []
+    (take 7 ([(maxBound-(5::Int16)) .. maxBound])) = [32762,32763,32764,32765,32766,32767]
+    (take 7 ([(minBound+(5::Int16)) .. minBound])) = []
+    (take 7 [(5::Int16),4..1]) = [5,4,3,2,1]
+    (take 7 [(5::Int16),3..1]) = [5,3,1]
+    (take 7 [(5::Int16),3..2]) = [5,3]
+    (take 7 [(1::Int16),2..1]) = [1]
+    (take 7 [(2::Int16),1..2]) = [2]
+    (take 7 [(2::Int16),1..1]) = [2,1]
+    (take 7 [(2::Int16),3..1]) = []
+    (take 7 [x,(x+1)..maxBound]) = [32763,32764,32765,32766,32767]
+    (take 7 [x,(x-1)..minBound]) = [-32763,-32764,-32765,-32766,-32767,-32768]
+Testing Enum Int32:
+    (succ (0::Int32)) = 1
+    (succ (minBound::Int32)) = -2147483647
+    (succ (maxBound::Int32)) = error "Enum.succ{Int32}: tried to take `succ' of maxBound"
+    pred (1::Int32) = 0
+    pred (maxBound::Int32) = 2147483646
+    pred (minBound::Int32) = error "Enum.pred{Int32}: tried to take `pred' of minBound"
+    (map (toEnum::Int->Int32) [1, fromIntegral (minBound::Int32), fromIntegral (maxBound::Int32)]) = [1,-2147483648,2147483647]
+    (toEnum (maxBound::Int))::Int32 = error "Enum.toEnum{Int32}: tag (9223372036854775807) is outside of bounds (-2147483648,2147483647)"
+    (map fromEnum [(1::Int32),minBound,maxBound]) = [1,-2147483648,2147483647]
+    (take 7 [(1::Int32)..]) = [1,2,3,4,5,6,7]
+    (take 7 [((maxBound::Int32)-5)..]) = [2147483642,2147483643,2147483644,2147483645,2147483646,2147483647]
+    (take 7 [(1::Int32),2..]) = [1,2,3,4,5,6,7]
+    (take 7 [(1::Int32),7..]) = [1,7,13,19,25,31,37]
+    (take 7 [(1::Int32),1..]) = [1,1,1,1,1,1,1]
+    (take 7 [(1::Int32),0..]) = [1,0,-1,-2,-3,-4,-5]
+    (take 7 [(5::Int32),2..]) = [5,2,-1,-4,-7,-10,-13]
+    (take 7 [x, x-1 ..]) = [-2147483647,-2147483648]
+    (take 7 [x, x-1 ..]) = [-2147483643,-2147483644,-2147483645,-2147483646,-2147483647,-2147483648]
+    (take 7 [x, (x+1) ..]) = [2147483642,2147483643,2147483644,2147483645,2147483646,2147483647]
+    (take 7 ([(1::Int32) .. 5])) = [1,2,3,4,5]
+    (take 4 ([(1::Int32) .. 1])) = [1]
+    (take 7 ([(1::Int32) .. 0])) = []
+    (take 7 ([(5::Int32) .. 0])) = []
+    (take 7 ([(maxBound-(5::Int32)) .. maxBound])) = [2147483642,2147483643,2147483644,2147483645,2147483646,2147483647]
+    (take 7 ([(minBound+(5::Int32)) .. minBound])) = []
+    (take 7 [(5::Int32),4..1]) = [5,4,3,2,1]
+    (take 7 [(5::Int32),3..1]) = [5,3,1]
+    (take 7 [(5::Int32),3..2]) = [5,3]
+    (take 7 [(1::Int32),2..1]) = [1]
+    (take 7 [(2::Int32),1..2]) = [2]
+    (take 7 [(2::Int32),1..1]) = [2,1]
+    (take 7 [(2::Int32),3..1]) = []
+    (take 7 [x,(x+1)..maxBound]) = [2147483643,2147483644,2147483645,2147483646,2147483647]
+    (take 7 [x,(x-1)..minBound]) = [-2147483643,-2147483644,-2147483645,-2147483646,-2147483647,-2147483648]
+Testing Enum Int64:
+    (succ (0::Int64)) = 1
+    (succ (minBound::Int64)) = -9223372036854775807
+    (succ (maxBound::Int64)) = error "Enum.succ{Int64}: tried to take `succ' of maxBound"
+    pred (1::Int64) = 0
+    pred (maxBound::Int64) = 9223372036854775806
+    pred (minBound::Int64) = error "Enum.pred{Int64}: tried to take `pred' of minBound"
+    (map (toEnum::Int->Int64) [1, fromIntegral (minBound::Int64), fromIntegral (maxBound::Int64)]) = [1,-9223372036854775808,9223372036854775807]
+    (toEnum (maxBound::Int))::Int64 = 9223372036854775807
+    (map fromEnum [(1::Int64),fromIntegral (minBound::Int) ,fromIntegral (maxBound::Int)]) = [1,-9223372036854775808,9223372036854775807]
+    fromEnum (maxBound::Int64) = 9223372036854775807
+    (take 7 [(1::Int64)..]) = [1,2,3,4,5,6,7]
+    (take 7 [((maxBound::Int64)-5)..]) = [9223372036854775802,9223372036854775803,9223372036854775804,9223372036854775805,9223372036854775806,9223372036854775807]
+    (take 7 [(1::Int64),2..]) = [1,2,3,4,5,6,7]
+    (take 7 [(1::Int64),7..]) = [1,7,13,19,25,31,37]
+    (take 7 [(1::Int64),1..]) = [1,1,1,1,1,1,1]
+    (take 7 [(1::Int64),0..]) = [1,0,-1,-2,-3,-4,-5]
+    (take 7 [(5::Int64),2..]) = [5,2,-1,-4,-7,-10,-13]
+    (take 7 [x, x-1 ..]) = [-9223372036854775807,-9223372036854775808]
+    (take 7 [x, x-1 ..]) = [-9223372036854775803,-9223372036854775804,-9223372036854775805,-9223372036854775806,-9223372036854775807,-9223372036854775808]
+    (take 7 [x, (x+1) ..]) = [9223372036854775802,9223372036854775803,9223372036854775804,9223372036854775805,9223372036854775806,9223372036854775807]
+    (take 7 ([(1::Int64) .. 5])) = [1,2,3,4,5]
+    (take 4 ([(1::Int64) .. 1])) = [1]
+    (take 7 ([(1::Int64) .. 0])) = []
+    (take 7 ([(5::Int64) .. 0])) = []
+    (take 7 ([(maxBound-(5::Int64)) .. maxBound])) = [9223372036854775802,9223372036854775803,9223372036854775804,9223372036854775805,9223372036854775806,9223372036854775807]
+    (take 7 ([(minBound+(5::Int64)) .. minBound])) = []
+    (take 7 [(5::Int64),4..1]) = [5,4,3,2,1]
+    (take 7 [(5::Int64),3..1]) = [5,3,1]
+    (take 7 [(5::Int64),3..2]) = [5,3]
+    (take 7 [(1::Int64),2..1]) = [1]
+    (take 7 [(2::Int64),1..2]) = [2]
+    (take 7 [(2::Int64),1..1]) = [2,1]
+    (take 7 [(2::Int64),3..1]) = []
+    (take 7 [x,(x+1)..maxBound]) = [9223372036854775803,9223372036854775804,9223372036854775805,9223372036854775806,9223372036854775807]
+    (take 7 [x,(x-1)..minBound]) = [-9223372036854775803,-9223372036854775804,-9223372036854775805,-9223372036854775806,-9223372036854775807,-9223372036854775808]
diff --git a/libraries/base/tests/enum02.stdout-ws-64 b/libraries/base/tests/enum02.stdout-ws-64
new file mode 100644
index 000000000000..3177d541f405
--- /dev/null
+++ b/libraries/base/tests/enum02.stdout-ws-64
@@ -0,0 +1,141 @@
+Testing Enum Int8:
+    (succ (0::Int8)) = 1
+    (succ (minBound::Int8)) = -127
+    (succ (maxBound::Int8)) = error "Enum.succ{Int8}: tried to take `succ' of maxBound"
+    pred (1::Int8) = 0
+    pred (maxBound::Int8) = 126
+    pred (minBound::Int8) = error "Enum.pred{Int8}: tried to take `pred' of minBound"
+    (map (toEnum::Int->Int8) [1, fromIntegral (minBound::Int8), fromIntegral (maxBound::Int8)]) = [1,-128,127]
+    (toEnum (maxBound::Int))::Int8 = error "Enum.toEnum{Int8}: tag (9223372036854775807) is outside of bounds (-128,127)"
+    (map fromEnum [(1::Int8),minBound,maxBound]) = [1,-128,127]
+    (take 7 [(1::Int8)..]) = [1,2,3,4,5,6,7]
+    (take 7 [((maxBound::Int8)-5)..]) = [122,123,124,125,126,127]
+    (take 7 [(1::Int8),2..]) = [1,2,3,4,5,6,7]
+    (take 7 [(1::Int8),7..]) = [1,7,13,19,25,31,37]
+    (take 7 [(1::Int8),1..]) = [1,1,1,1,1,1,1]
+    (take 7 [(1::Int8),0..]) = [1,0,-1,-2,-3,-4,-5]
+    (take 7 [(5::Int8),2..]) = [5,2,-1,-4,-7,-10,-13]
+    (take 7 [x, x-1 ..]) = [-127,-128]
+    (take 7 [x, x-1 ..]) = [-123,-124,-125,-126,-127,-128]
+    (take 7 [x, (x+1) ..]) = [122,123,124,125,126,127]
+    (take 7 ([(1::Int8) .. 5])) = [1,2,3,4,5]
+    (take 4 ([(1::Int8) .. 1])) = [1]
+    (take 7 ([(1::Int8) .. 0])) = []
+    (take 7 ([(5::Int8) .. 0])) = []
+    (take 7 ([(maxBound-(5::Int8)) .. maxBound])) = [122,123,124,125,126,127]
+    (take 7 ([(minBound+(5::Int8)) .. minBound])) = []
+    (take 7 [(5::Int8),4..1]) = [5,4,3,2,1]
+    (take 7 [(5::Int8),3..1]) = [5,3,1]
+    (take 7 [(5::Int8),3..2]) = [5,3]
+    (take 7 [(1::Int8),2..1]) = [1]
+    (take 7 [(2::Int8),1..2]) = [2]
+    (take 7 [(2::Int8),1..1]) = [2,1]
+    (take 7 [(2::Int8),3..1]) = []
+    (take 7 [x,(x+1)..maxBound]) = [123,124,125,126,127]
+    (take 7 [x,(x-1)..minBound]) = [-123,-124,-125,-126,-127,-128]
+Testing Enum Int16:
+    (succ (0::Int16)) = 1
+    (succ (minBound::Int16)) = -32767
+    (succ (maxBound::Int16)) = error "Enum.succ{Int16}: tried to take `succ' of maxBound"
+    pred (1::Int16) = 0
+    pred (maxBound::Int16) = 32766
+    pred (minBound::Int16) = error "Enum.pred{Int16}: tried to take `pred' of minBound"
+    (map (toEnum::Int->Int16) [1, fromIntegral (minBound::Int16), fromIntegral (maxBound::Int16)]) = [1,-32768,32767]
+    (toEnum (maxBound::Int))::Int16 = error "Enum.toEnum{Int16}: tag (9223372036854775807) is outside of bounds (-32768,32767)"
+    (map fromEnum [(1::Int16),minBound,maxBound]) = [1,-32768,32767]
+    (take 7 [(1::Int16)..]) = [1,2,3,4,5,6,7]
+    (take 7 [((maxBound::Int16)-5)..]) = [32762,32763,32764,32765,32766,32767]
+    (take 7 [(1::Int16),2..]) = [1,2,3,4,5,6,7]
+    (take 7 [(1::Int16),7..]) = [1,7,13,19,25,31,37]
+    (take 7 [(1::Int16),1..]) = [1,1,1,1,1,1,1]
+    (take 7 [(1::Int16),0..]) = [1,0,-1,-2,-3,-4,-5]
+    (take 7 [(5::Int16),2..]) = [5,2,-1,-4,-7,-10,-13]
+    (take 7 [x, x-1 ..]) = [-32767,-32768]
+    (take 7 [x, x-1 ..]) = [-32763,-32764,-32765,-32766,-32767,-32768]
+    (take 7 [x, (x+1) ..]) = [32762,32763,32764,32765,32766,32767]
+    (take 7 ([(1::Int16) .. 5])) = [1,2,3,4,5]
+    (take 4 ([(1::Int16) .. 1])) = [1]
+    (take 7 ([(1::Int16) .. 0])) = []
+    (take 7 ([(5::Int16) .. 0])) = []
+    (take 7 ([(maxBound-(5::Int16)) .. maxBound])) = [32762,32763,32764,32765,32766,32767]
+    (take 7 ([(minBound+(5::Int16)) .. minBound])) = []
+    (take 7 [(5::Int16),4..1]) = [5,4,3,2,1]
+    (take 7 [(5::Int16),3..1]) = [5,3,1]
+    (take 7 [(5::Int16),3..2]) = [5,3]
+    (take 7 [(1::Int16),2..1]) = [1]
+    (take 7 [(2::Int16),1..2]) = [2]
+    (take 7 [(2::Int16),1..1]) = [2,1]
+    (take 7 [(2::Int16),3..1]) = []
+    (take 7 [x,(x+1)..maxBound]) = [32763,32764,32765,32766,32767]
+    (take 7 [x,(x-1)..minBound]) = [-32763,-32764,-32765,-32766,-32767,-32768]
+Testing Enum Int32:
+    (succ (0::Int32)) = 1
+    (succ (minBound::Int32)) = -2147483647
+    (succ (maxBound::Int32)) = error "Enum.succ{Int32}: tried to take `succ' of maxBound"
+    pred (1::Int32) = 0
+    pred (maxBound::Int32) = 2147483646
+    pred (minBound::Int32) = error "Enum.pred{Int32}: tried to take `pred' of minBound"
+    (map (toEnum::Int->Int32) [1, fromIntegral (minBound::Int32), fromIntegral (maxBound::Int32)]) = [1,-2147483648,2147483647]
+    (toEnum (maxBound::Int))::Int32 = error "Enum.toEnum{Int32}: tag (9223372036854775807) is outside of bounds (-2147483648,2147483647)"
+    (map fromEnum [(1::Int32),minBound,maxBound]) = [1,-2147483648,2147483647]
+    (take 7 [(1::Int32)..]) = [1,2,3,4,5,6,7]
+    (take 7 [((maxBound::Int32)-5)..]) = [2147483642,2147483643,2147483644,2147483645,2147483646,2147483647]
+    (take 7 [(1::Int32),2..]) = [1,2,3,4,5,6,7]
+    (take 7 [(1::Int32),7..]) = [1,7,13,19,25,31,37]
+    (take 7 [(1::Int32),1..]) = [1,1,1,1,1,1,1]
+    (take 7 [(1::Int32),0..]) = [1,0,-1,-2,-3,-4,-5]
+    (take 7 [(5::Int32),2..]) = [5,2,-1,-4,-7,-10,-13]
+    (take 7 [x, x-1 ..]) = [-2147483647,-2147483648]
+    (take 7 [x, x-1 ..]) = [-2147483643,-2147483644,-2147483645,-2147483646,-2147483647,-2147483648]
+    (take 7 [x, (x+1) ..]) = [2147483642,2147483643,2147483644,2147483645,2147483646,2147483647]
+    (take 7 ([(1::Int32) .. 5])) = [1,2,3,4,5]
+    (take 4 ([(1::Int32) .. 1])) = [1]
+    (take 7 ([(1::Int32) .. 0])) = []
+    (take 7 ([(5::Int32) .. 0])) = []
+    (take 7 ([(maxBound-(5::Int32)) .. maxBound])) = [2147483642,2147483643,2147483644,2147483645,2147483646,2147483647]
+    (take 7 ([(minBound+(5::Int32)) .. minBound])) = []
+    (take 7 [(5::Int32),4..1]) = [5,4,3,2,1]
+    (take 7 [(5::Int32),3..1]) = [5,3,1]
+    (take 7 [(5::Int32),3..2]) = [5,3]
+    (take 7 [(1::Int32),2..1]) = [1]
+    (take 7 [(2::Int32),1..2]) = [2]
+    (take 7 [(2::Int32),1..1]) = [2,1]
+    (take 7 [(2::Int32),3..1]) = []
+    (take 7 [x,(x+1)..maxBound]) = [2147483643,2147483644,2147483645,2147483646,2147483647]
+    (take 7 [x,(x-1)..minBound]) = [-2147483643,-2147483644,-2147483645,-2147483646,-2147483647,-2147483648]
+Testing Enum Int64:
+    (succ (0::Int64)) = 1
+    (succ (minBound::Int64)) = -9223372036854775807
+    (succ (maxBound::Int64)) = error "Enum.succ{Int64}: tried to take `succ' of maxBound"
+    pred (1::Int64) = 0
+    pred (maxBound::Int64) = 9223372036854775806
+    pred (minBound::Int64) = error "Enum.pred{Int64}: tried to take `pred' of minBound"
+    (map (toEnum::Int->Int64) [1, fromIntegral (minBound::Int64), fromIntegral (maxBound::Int64)]) = [1,-9223372036854775808,9223372036854775807]
+    (toEnum (maxBound::Int))::Int64 = 9223372036854775807
+    (map fromEnum [(1::Int64),fromIntegral (minBound::Int) ,fromIntegral (maxBound::Int)]) = [1,-9223372036854775808,9223372036854775807]
+    fromEnum (maxBound::Int64) = 9223372036854775807
+    (take 7 [(1::Int64)..]) = [1,2,3,4,5,6,7]
+    (take 7 [((maxBound::Int64)-5)..]) = [9223372036854775802,9223372036854775803,9223372036854775804,9223372036854775805,9223372036854775806,9223372036854775807]
+    (take 7 [(1::Int64),2..]) = [1,2,3,4,5,6,7]
+    (take 7 [(1::Int64),7..]) = [1,7,13,19,25,31,37]
+    (take 7 [(1::Int64),1..]) = [1,1,1,1,1,1,1]
+    (take 7 [(1::Int64),0..]) = [1,0,-1,-2,-3,-4,-5]
+    (take 7 [(5::Int64),2..]) = [5,2,-1,-4,-7,-10,-13]
+    (take 7 [x, x-1 ..]) = [-9223372036854775807,-9223372036854775808]
+    (take 7 [x, x-1 ..]) = [-9223372036854775803,-9223372036854775804,-9223372036854775805,-9223372036854775806,-9223372036854775807,-9223372036854775808]
+    (take 7 [x, (x+1) ..]) = [9223372036854775802,9223372036854775803,9223372036854775804,9223372036854775805,9223372036854775806,9223372036854775807]
+    (take 7 ([(1::Int64) .. 5])) = [1,2,3,4,5]
+    (take 4 ([(1::Int64) .. 1])) = [1]
+    (take 7 ([(1::Int64) .. 0])) = []
+    (take 7 ([(5::Int64) .. 0])) = []
+    (take 7 ([(maxBound-(5::Int64)) .. maxBound])) = [9223372036854775802,9223372036854775803,9223372036854775804,9223372036854775805,9223372036854775806,9223372036854775807]
+    (take 7 ([(minBound+(5::Int64)) .. minBound])) = []
+    (take 7 [(5::Int64),4..1]) = [5,4,3,2,1]
+    (take 7 [(5::Int64),3..1]) = [5,3,1]
+    (take 7 [(5::Int64),3..2]) = [5,3]
+    (take 7 [(1::Int64),2..1]) = [1]
+    (take 7 [(2::Int64),1..2]) = [2]
+    (take 7 [(2::Int64),1..1]) = [2,1]
+    (take 7 [(2::Int64),3..1]) = []
+    (take 7 [x,(x+1)..maxBound]) = [9223372036854775803,9223372036854775804,9223372036854775805,9223372036854775806,9223372036854775807]
+    (take 7 [x,(x-1)..minBound]) = [-9223372036854775803,-9223372036854775804,-9223372036854775805,-9223372036854775806,-9223372036854775807,-9223372036854775808]
diff --git a/libraries/base/tests/enum02.stdout-x86_64-unknown-openbsd b/libraries/base/tests/enum02.stdout-x86_64-unknown-openbsd
new file mode 100644
index 000000000000..3177d541f405
--- /dev/null
+++ b/libraries/base/tests/enum02.stdout-x86_64-unknown-openbsd
@@ -0,0 +1,141 @@
+Testing Enum Int8:
+    (succ (0::Int8)) = 1
+    (succ (minBound::Int8)) = -127
+    (succ (maxBound::Int8)) = error "Enum.succ{Int8}: tried to take `succ' of maxBound"
+    pred (1::Int8) = 0
+    pred (maxBound::Int8) = 126
+    pred (minBound::Int8) = error "Enum.pred{Int8}: tried to take `pred' of minBound"
+    (map (toEnum::Int->Int8) [1, fromIntegral (minBound::Int8), fromIntegral (maxBound::Int8)]) = [1,-128,127]
+    (toEnum (maxBound::Int))::Int8 = error "Enum.toEnum{Int8}: tag (9223372036854775807) is outside of bounds (-128,127)"
+    (map fromEnum [(1::Int8),minBound,maxBound]) = [1,-128,127]
+    (take 7 [(1::Int8)..]) = [1,2,3,4,5,6,7]
+    (take 7 [((maxBound::Int8)-5)..]) = [122,123,124,125,126,127]
+    (take 7 [(1::Int8),2..]) = [1,2,3,4,5,6,7]
+    (take 7 [(1::Int8),7..]) = [1,7,13,19,25,31,37]
+    (take 7 [(1::Int8),1..]) = [1,1,1,1,1,1,1]
+    (take 7 [(1::Int8),0..]) = [1,0,-1,-2,-3,-4,-5]
+    (take 7 [(5::Int8),2..]) = [5,2,-1,-4,-7,-10,-13]
+    (take 7 [x, x-1 ..]) = [-127,-128]
+    (take 7 [x, x-1 ..]) = [-123,-124,-125,-126,-127,-128]
+    (take 7 [x, (x+1) ..]) = [122,123,124,125,126,127]
+    (take 7 ([(1::Int8) .. 5])) = [1,2,3,4,5]
+    (take 4 ([(1::Int8) .. 1])) = [1]
+    (take 7 ([(1::Int8) .. 0])) = []
+    (take 7 ([(5::Int8) .. 0])) = []
+    (take 7 ([(maxBound-(5::Int8)) .. maxBound])) = [122,123,124,125,126,127]
+    (take 7 ([(minBound+(5::Int8)) .. minBound])) = []
+    (take 7 [(5::Int8),4..1]) = [5,4,3,2,1]
+    (take 7 [(5::Int8),3..1]) = [5,3,1]
+    (take 7 [(5::Int8),3..2]) = [5,3]
+    (take 7 [(1::Int8),2..1]) = [1]
+    (take 7 [(2::Int8),1..2]) = [2]
+    (take 7 [(2::Int8),1..1]) = [2,1]
+    (take 7 [(2::Int8),3..1]) = []
+    (take 7 [x,(x+1)..maxBound]) = [123,124,125,126,127]
+    (take 7 [x,(x-1)..minBound]) = [-123,-124,-125,-126,-127,-128]
+Testing Enum Int16:
+    (succ (0::Int16)) = 1
+    (succ (minBound::Int16)) = -32767
+    (succ (maxBound::Int16)) = error "Enum.succ{Int16}: tried to take `succ' of maxBound"
+    pred (1::Int16) = 0
+    pred (maxBound::Int16) = 32766
+    pred (minBound::Int16) = error "Enum.pred{Int16}: tried to take `pred' of minBound"
+    (map (toEnum::Int->Int16) [1, fromIntegral (minBound::Int16), fromIntegral (maxBound::Int16)]) = [1,-32768,32767]
+    (toEnum (maxBound::Int))::Int16 = error "Enum.toEnum{Int16}: tag (9223372036854775807) is outside of bounds (-32768,32767)"
+    (map fromEnum [(1::Int16),minBound,maxBound]) = [1,-32768,32767]
+    (take 7 [(1::Int16)..]) = [1,2,3,4,5,6,7]
+    (take 7 [((maxBound::Int16)-5)..]) = [32762,32763,32764,32765,32766,32767]
+    (take 7 [(1::Int16),2..]) = [1,2,3,4,5,6,7]
+    (take 7 [(1::Int16),7..]) = [1,7,13,19,25,31,37]
+    (take 7 [(1::Int16),1..]) = [1,1,1,1,1,1,1]
+    (take 7 [(1::Int16),0..]) = [1,0,-1,-2,-3,-4,-5]
+    (take 7 [(5::Int16),2..]) = [5,2,-1,-4,-7,-10,-13]
+    (take 7 [x, x-1 ..]) = [-32767,-32768]
+    (take 7 [x, x-1 ..]) = [-32763,-32764,-32765,-32766,-32767,-32768]
+    (take 7 [x, (x+1) ..]) = [32762,32763,32764,32765,32766,32767]
+    (take 7 ([(1::Int16) .. 5])) = [1,2,3,4,5]
+    (take 4 ([(1::Int16) .. 1])) = [1]
+    (take 7 ([(1::Int16) .. 0])) = []
+    (take 7 ([(5::Int16) .. 0])) = []
+    (take 7 ([(maxBound-(5::Int16)) .. maxBound])) = [32762,32763,32764,32765,32766,32767]
+    (take 7 ([(minBound+(5::Int16)) .. minBound])) = []
+    (take 7 [(5::Int16),4..1]) = [5,4,3,2,1]
+    (take 7 [(5::Int16),3..1]) = [5,3,1]
+    (take 7 [(5::Int16),3..2]) = [5,3]
+    (take 7 [(1::Int16),2..1]) = [1]
+    (take 7 [(2::Int16),1..2]) = [2]
+    (take 7 [(2::Int16),1..1]) = [2,1]
+    (take 7 [(2::Int16),3..1]) = []
+    (take 7 [x,(x+1)..maxBound]) = [32763,32764,32765,32766,32767]
+    (take 7 [x,(x-1)..minBound]) = [-32763,-32764,-32765,-32766,-32767,-32768]
+Testing Enum Int32:
+    (succ (0::Int32)) = 1
+    (succ (minBound::Int32)) = -2147483647
+    (succ (maxBound::Int32)) = error "Enum.succ{Int32}: tried to take `succ' of maxBound"
+    pred (1::Int32) = 0
+    pred (maxBound::Int32) = 2147483646
+    pred (minBound::Int32) = error "Enum.pred{Int32}: tried to take `pred' of minBound"
+    (map (toEnum::Int->Int32) [1, fromIntegral (minBound::Int32), fromIntegral (maxBound::Int32)]) = [1,-2147483648,2147483647]
+    (toEnum (maxBound::Int))::Int32 = error "Enum.toEnum{Int32}: tag (9223372036854775807) is outside of bounds (-2147483648,2147483647)"
+    (map fromEnum [(1::Int32),minBound,maxBound]) = [1,-2147483648,2147483647]
+    (take 7 [(1::Int32)..]) = [1,2,3,4,5,6,7]
+    (take 7 [((maxBound::Int32)-5)..]) = [2147483642,2147483643,2147483644,2147483645,2147483646,2147483647]
+    (take 7 [(1::Int32),2..]) = [1,2,3,4,5,6,7]
+    (take 7 [(1::Int32),7..]) = [1,7,13,19,25,31,37]
+    (take 7 [(1::Int32),1..]) = [1,1,1,1,1,1,1]
+    (take 7 [(1::Int32),0..]) = [1,0,-1,-2,-3,-4,-5]
+    (take 7 [(5::Int32),2..]) = [5,2,-1,-4,-7,-10,-13]
+    (take 7 [x, x-1 ..]) = [-2147483647,-2147483648]
+    (take 7 [x, x-1 ..]) = [-2147483643,-2147483644,-2147483645,-2147483646,-2147483647,-2147483648]
+    (take 7 [x, (x+1) ..]) = [2147483642,2147483643,2147483644,2147483645,2147483646,2147483647]
+    (take 7 ([(1::Int32) .. 5])) = [1,2,3,4,5]
+    (take 4 ([(1::Int32) .. 1])) = [1]
+    (take 7 ([(1::Int32) .. 0])) = []
+    (take 7 ([(5::Int32) .. 0])) = []
+    (take 7 ([(maxBound-(5::Int32)) .. maxBound])) = [2147483642,2147483643,2147483644,2147483645,2147483646,2147483647]
+    (take 7 ([(minBound+(5::Int32)) .. minBound])) = []
+    (take 7 [(5::Int32),4..1]) = [5,4,3,2,1]
+    (take 7 [(5::Int32),3..1]) = [5,3,1]
+    (take 7 [(5::Int32),3..2]) = [5,3]
+    (take 7 [(1::Int32),2..1]) = [1]
+    (take 7 [(2::Int32),1..2]) = [2]
+    (take 7 [(2::Int32),1..1]) = [2,1]
+    (take 7 [(2::Int32),3..1]) = []
+    (take 7 [x,(x+1)..maxBound]) = [2147483643,2147483644,2147483645,2147483646,2147483647]
+    (take 7 [x,(x-1)..minBound]) = [-2147483643,-2147483644,-2147483645,-2147483646,-2147483647,-2147483648]
+Testing Enum Int64:
+    (succ (0::Int64)) = 1
+    (succ (minBound::Int64)) = -9223372036854775807
+    (succ (maxBound::Int64)) = error "Enum.succ{Int64}: tried to take `succ' of maxBound"
+    pred (1::Int64) = 0
+    pred (maxBound::Int64) = 9223372036854775806
+    pred (minBound::Int64) = error "Enum.pred{Int64}: tried to take `pred' of minBound"
+    (map (toEnum::Int->Int64) [1, fromIntegral (minBound::Int64), fromIntegral (maxBound::Int64)]) = [1,-9223372036854775808,9223372036854775807]
+    (toEnum (maxBound::Int))::Int64 = 9223372036854775807
+    (map fromEnum [(1::Int64),fromIntegral (minBound::Int) ,fromIntegral (maxBound::Int)]) = [1,-9223372036854775808,9223372036854775807]
+    fromEnum (maxBound::Int64) = 9223372036854775807
+    (take 7 [(1::Int64)..]) = [1,2,3,4,5,6,7]
+    (take 7 [((maxBound::Int64)-5)..]) = [9223372036854775802,9223372036854775803,9223372036854775804,9223372036854775805,9223372036854775806,9223372036854775807]
+    (take 7 [(1::Int64),2..]) = [1,2,3,4,5,6,7]
+    (take 7 [(1::Int64),7..]) = [1,7,13,19,25,31,37]
+    (take 7 [(1::Int64),1..]) = [1,1,1,1,1,1,1]
+    (take 7 [(1::Int64),0..]) = [1,0,-1,-2,-3,-4,-5]
+    (take 7 [(5::Int64),2..]) = [5,2,-1,-4,-7,-10,-13]
+    (take 7 [x, x-1 ..]) = [-9223372036854775807,-9223372036854775808]
+    (take 7 [x, x-1 ..]) = [-9223372036854775803,-9223372036854775804,-9223372036854775805,-9223372036854775806,-9223372036854775807,-9223372036854775808]
+    (take 7 [x, (x+1) ..]) = [9223372036854775802,9223372036854775803,9223372036854775804,9223372036854775805,9223372036854775806,9223372036854775807]
+    (take 7 ([(1::Int64) .. 5])) = [1,2,3,4,5]
+    (take 4 ([(1::Int64) .. 1])) = [1]
+    (take 7 ([(1::Int64) .. 0])) = []
+    (take 7 ([(5::Int64) .. 0])) = []
+    (take 7 ([(maxBound-(5::Int64)) .. maxBound])) = [9223372036854775802,9223372036854775803,9223372036854775804,9223372036854775805,9223372036854775806,9223372036854775807]
+    (take 7 ([(minBound+(5::Int64)) .. minBound])) = []
+    (take 7 [(5::Int64),4..1]) = [5,4,3,2,1]
+    (take 7 [(5::Int64),3..1]) = [5,3,1]
+    (take 7 [(5::Int64),3..2]) = [5,3]
+    (take 7 [(1::Int64),2..1]) = [1]
+    (take 7 [(2::Int64),1..2]) = [2]
+    (take 7 [(2::Int64),1..1]) = [2,1]
+    (take 7 [(2::Int64),3..1]) = []
+    (take 7 [x,(x+1)..maxBound]) = [9223372036854775803,9223372036854775804,9223372036854775805,9223372036854775806,9223372036854775807]
+    (take 7 [x,(x-1)..minBound]) = [-9223372036854775803,-9223372036854775804,-9223372036854775805,-9223372036854775806,-9223372036854775807,-9223372036854775808]
diff --git a/libraries/base/tests/enum03.hs b/libraries/base/tests/enum03.hs
new file mode 100644
index 000000000000..9f730a9aa12b
--- /dev/null
+++ b/libraries/base/tests/enum03.hs
@@ -0,0 +1,269 @@
+-- !!! Testing the Word Enum instances.
+{-# LANGUAGE CPP #-}
+module Main(main) where
+
+#if __GLASGOW_HASKELL__ < 705
+import Prelude hiding (catch)
+#endif
+import Control.Exception
+import Data.Word
+import Data.Int
+
+main = do
+  putStrLn "Testing Enum Word8:"
+  testEnumWord8
+  putStrLn "Testing Enum Word16:"
+  testEnumWord16
+  putStrLn "Testing Enum Word32:"
+  testEnumWord32
+  putStrLn "Testing Enum Word64:"
+  testEnumWord64
+
+
+#define printTest(x) (do{ putStr ( "    " ++ "x" ++ " = " ) ; print (x) })
+
+testEnumWord8 :: IO ()
+testEnumWord8 = do
+     -- succ
+  printTest ((succ (0::Word8)))
+  printTest ((succ (minBound::Word8)))
+  mayBomb   (printTest ((succ (maxBound::Word8))))
+
+     -- pred
+  printTest (pred (1::Word8))
+  printTest (pred (maxBound::Word8))
+  mayBomb   (printTest (pred (minBound::Word8))) 
+
+     -- toEnum
+  printTest ((map (toEnum::Int->Word8) [1, fromIntegral (minBound::Word8)::Int, fromIntegral (maxBound::Word8)::Int]))
+  mayBomb   (printTest ((toEnum (maxBound::Int))::Word8))
+
+     -- fromEnum
+  printTest ((map fromEnum [(1::Word8),minBound,maxBound]))
+
+     -- [x..] aka enumFrom
+  printTest ((take 7 [(1::Word8)..]))
+  printTest ((take 7 [((maxBound::Word8)-5)..])) -- just in case it doesn't catch the upper bound..
+
+     -- [x,y..] aka enumFromThen
+  printTest ((take 7 [(1::Word8),2..]))
+  printTest ((take 7 [(1::Word8),7..]))
+  printTest ((take 7 [(1::Word8),1..]))
+  printTest ((take 7 [(1::Word8),0..]))
+  printTest ((take 7 [(5::Word8),2..]))
+  let x = (minBound::Word8) + 1
+  printTest ((take 7 [x, x-1 ..]))
+  let x = (minBound::Word8) + 5
+  printTest ((take 7 [x, x-1 ..]))
+  let x = (maxBound::Word8) - 5
+  printTest ((take 7 [x, (x+1) ..]))
+
+     -- [x..y] aka enumFromTo
+  printTest ((take 7 ([(1::Word8) .. 5])))
+  printTest ((take 4 ([(1::Word8) .. 1])))
+  printTest ((take 7 ([(1::Word8) .. 0])))
+  printTest ((take 7 ([(5::Word8) .. 0])))
+  printTest ((take 7 ([(maxBound-(5::Word8)) .. maxBound])))
+  printTest ((take 7 ([(minBound+(5::Word8)) .. minBound])))
+
+     -- [x,y..z] aka enumFromThenTo
+  printTest ((take 7 [(5::Word8),4..1]))
+  printTest ((take 7 [(5::Word8),3..1]))
+  printTest ((take 7 [(5::Word8),3..2]))
+  printTest ((take 7 [(1::Word8),2..1]))
+  printTest ((take 7 [(2::Word8),1..2]))
+  printTest ((take 7 [(2::Word8),1..1]))
+  printTest ((take 7 [(2::Word8),3..1]))
+
+  let x = (maxBound::Word8) - 4
+  printTest ((take 7 [x,(x+1)..maxBound]))
+  let x = (minBound::Word8) + 5
+  printTest ((take 7 [x,(x-1)..minBound]))
+
+testEnumWord16 :: IO ()
+testEnumWord16 = do
+     -- succ
+  printTest ((succ (0::Word16)))
+  printTest ((succ (minBound::Word16)))
+  mayBomb   (printTest ((succ (maxBound::Word16))))
+
+     -- pred
+  printTest (pred (1::Word16))
+  printTest (pred (maxBound::Word16))
+  mayBomb   (printTest (pred (minBound::Word16))) 
+
+     -- toEnum
+  printTest ((map (toEnum::Int->Word16) [1, fromIntegral (minBound::Word16)::Int, fromIntegral (maxBound::Word16)::Int]))
+  mayBomb   (printTest ((toEnum (maxBound::Int))::Word16))
+
+
+     -- fromEnum
+  printTest ((map fromEnum [(1::Word16),minBound,maxBound]))
+
+     -- [x..] aka enumFrom
+  printTest ((take 7 [(1::Word16)..]))
+  printTest ((take 7 [((maxBound::Word16)-5)..])) -- just in case it doesn't catch the upper bound..
+  
+     -- [x,y..] aka enumFromThen
+  printTest ((take 7 [(1::Word16),2..]))
+  printTest ((take 7 [(1::Word16),7..]))
+  printTest ((take 7 [(1::Word16),1..]))
+  printTest ((take 7 [(1::Word16),0..]))
+  printTest ((take 7 [(5::Word16),2..]))
+  let x = (minBound::Word16) + 1
+  printTest ((take 7 [x, x-1 ..]))
+  let x = (minBound::Word16) + 5
+  printTest ((take 7 [x, x-1 ..]))
+  let x = (maxBound::Word16) - 5
+  printTest ((take 7 [x, (x+1) ..]))
+
+     -- [x..y] aka enumFromTo
+  printTest ((take 7 ([(1::Word16) .. 5])))
+  printTest ((take 4 ([(1::Word16) .. 1])))
+  printTest ((take 7 ([(1::Word16) .. 0])))
+  printTest ((take 7 ([(5::Word16) .. 0])))
+  printTest ((take 7 ([(maxBound-(5::Word16)) .. maxBound])))
+  printTest ((take 7 ([(minBound+(5::Word16)) .. minBound])))
+
+     -- [x,y..z] aka enumFromThenTo
+  printTest ((take 7 [(5::Word16),4..1]))
+  printTest ((take 7 [(5::Word16),3..1]))
+  printTest ((take 7 [(5::Word16),3..2]))
+  printTest ((take 7 [(1::Word16),2..1]))
+  printTest ((take 7 [(2::Word16),1..2]))
+  printTest ((take 7 [(2::Word16),1..1]))
+  printTest ((take 7 [(2::Word16),3..1]))
+
+  let x = (maxBound::Word16) - 4
+  printTest ((take 7 [x,(x+1)..maxBound]))
+  let x = (minBound::Word16) + 5
+  printTest ((take 7 [x,(x-1)..minBound]))
+
+testEnumWord32 :: IO ()
+testEnumWord32 = do
+     -- succ
+  printTest ((succ (0::Word32)))
+  printTest ((succ (minBound::Word32)))
+  mayBomb   (printTest ((succ (maxBound::Word32))))
+
+     -- pred
+  printTest (pred (1::Word32))
+  printTest (pred (maxBound::Word32))
+  mayBomb   (printTest (pred (minBound::Word32))) 
+
+     -- toEnum
+  printTest ((map (toEnum::Int->Word32) [1, fromIntegral (minBound::Word32)::Int, fromIntegral (maxBound::Int32)::Int]))
+  mayBomb   (printTest ((toEnum (maxBound::Int))::Word32))
+
+     -- fromEnum
+  printTest ((map fromEnum [(1::Word32),minBound,fromIntegral (maxBound::Int)]))
+  mayBomb   (printTest (fromEnum (maxBound::Word32)))
+
+     -- [x..] aka enumFrom
+  printTest ((take 7 [(1::Word32)..]))
+  printTest ((take 7 [((maxBound::Word32)-5)..])) -- just in case it doesn't catch the upper bound..
+  
+     -- [x,y..] aka enumFromThen
+  printTest ((take 7 [(1::Word32),2..]))
+  printTest ((take 7 [(1::Word32),7..]))
+  printTest ((take 7 [(1::Word32),1..]))
+  printTest ((take 7 [(1::Word32),0..]))
+  printTest ((take 7 [(5::Word32),2..]))
+  let x = (minBound::Word32) + 1
+  printTest ((take 7 [x, x-1 ..]))
+  let x = (minBound::Word32) + 5
+  printTest ((take 7 [x, x-1 ..]))
+  let x = (maxBound::Word32) - 5
+  printTest ((take 7 [x, (x+1) ..]))
+
+     -- [x..y] aka enumFromTo
+  printTest ((take 7 ([(1::Word32) .. 5])))
+  printTest ((take 4 ([(1::Word32) .. 1])))
+  printTest ((take 7 ([(1::Word32) .. 0])))
+  printTest ((take 7 ([(5::Word32) .. 0])))
+  printTest ((take 7 ([(maxBound-(5::Word32)) .. maxBound])))
+  printTest ((take 7 ([(minBound+(5::Word32)) .. minBound])))
+
+     -- [x,y..z] aka enumFromThenTo
+  printTest ((take 7 [(5::Word32),4..1]))
+  printTest ((take 7 [(5::Word32),3..1]))
+  printTest ((take 7 [(5::Word32),3..2]))
+  printTest ((take 7 [(1::Word32),2..1]))
+  printTest ((take 7 [(2::Word32),1..2]))
+  printTest ((take 7 [(2::Word32),1..1]))
+  printTest ((take 7 [(2::Word32),3..1]))
+
+  let x = (maxBound::Word32) - 4
+  printTest ((take 7 [x,(x+1)..maxBound]))
+  let x = (minBound::Word32) + 5
+  printTest ((take 7 [x,(x-1)..minBound]))
+
+testEnumWord64 :: IO ()
+testEnumWord64 = do
+     -- succ
+  printTest ((succ (0::Word64)))
+  printTest ((succ (minBound::Word64)))
+  mayBomb   (printTest ((succ (maxBound::Word64))))
+
+     -- pred
+  printTest (pred (1::Word64))
+  printTest (pred (maxBound::Word64))
+  mayBomb   (printTest (pred (minBound::Word64))) 
+
+     -- toEnum
+  mayBomb   (printTest ((map (toEnum::Int->Word64) [1, fromIntegral (minBound::Word64)::Int, maxBound::Int])))
+  mayBomb   (printTest ((toEnum (maxBound::Int))::Word64))
+
+     -- fromEnum
+  printTest ((map fromEnum [(1::Word64),minBound,fromIntegral (maxBound::Int)]))
+  mayBomb   (printTest (fromEnum (maxBound::Word64)))
+
+     -- [x..] aka enumFrom
+  printTest ((take 7 [(1::Word64)..]))
+  printTest ((take 7 [((maxBound::Word64)-5)..])) -- just in case it doesn't catch the upper bound..
+
+     -- [x,y..] aka enumFromThen
+  printTest ((take 7 [(1::Word64),2..]))
+  printTest ((take 7 [(1::Word64),7..]))
+  printTest ((take 7 [(1::Word64),1..]))
+  printTest ((take 7 [(1::Word64),0..]))
+  printTest ((take 7 [(5::Word64),2..]))
+  let x = (minBound::Word64) + 1
+  printTest ((take 7 [x, x-1 ..]))
+  let x = (minBound::Word64) + 5
+  printTest ((take 7 [x, x-1 ..]))
+  let x = (maxBound::Word64) - 5
+  printTest ((take 7 [x, (x+1) ..]))
+
+     -- [x..y] aka enumFromTo
+  printTest ((take 7 ([(1::Word64) .. 5])))
+  printTest ((take 4 ([(1::Word64) .. 1])))
+  printTest ((take 7 ([(1::Word64) .. 0])))
+  printTest ((take 7 ([(5::Word64) .. 0])))
+  printTest ((take 7 ([(maxBound-(5::Word64)) .. maxBound])))
+  printTest ((take 7 ([(minBound+(5::Word64)) .. minBound])))
+
+     -- [x,y..z] aka enumFromThenTo
+  printTest ((take 7 [(5::Word64),4..1]))
+  printTest ((take 7 [(5::Word64),3..1]))
+  printTest ((take 7 [(5::Word64),3..2]))
+  printTest ((take 7 [(1::Word64),2..1]))
+  printTest ((take 7 [(2::Word64),1..2]))
+  printTest ((take 7 [(2::Word64),1..1]))
+  printTest ((take 7 [(2::Word64),3..1]))
+
+  let x = (maxBound::Word64) - 4
+  printTest ((take 7 [x,(x+1)..maxBound]))
+  let x = (minBound::Word64) + 5
+  printTest ((take 7 [x,(x-1)..minBound]))
+
+
+--
+--
+--  Utils
+--
+--
+
+
+mayBomb x = catch x (\(ErrorCall e) -> putStrLn ("error " ++ show e))
+  `catch` (\e -> putStrLn ("Fail: " ++ show (e :: SomeException)))
diff --git a/libraries/base/tests/enum03.stdout b/libraries/base/tests/enum03.stdout
new file mode 100644
index 000000000000..d6db561a720b
--- /dev/null
+++ b/libraries/base/tests/enum03.stdout
@@ -0,0 +1,142 @@
+Testing Enum Word8:
+    (succ (0::Word8)) = 1
+    (succ (minBound::Word8)) = 1
+    (succ (maxBound::Word8)) = error "Enum.succ{Word8}: tried to take `succ' of maxBound"
+    pred (1::Word8) = 0
+    pred (maxBound::Word8) = 254
+    pred (minBound::Word8) = error "Enum.pred{Word8}: tried to take `pred' of minBound"
+    (map (toEnum::Int->Word8) [1, fromIntegral (minBound::Word8)::Int, fromIntegral (maxBound::Word8)::Int]) = [1,0,255]
+    (toEnum (maxBound::Int))::Word8 = error "Enum.toEnum{Word8}: tag (2147483647) is outside of bounds (0,255)"
+    (map fromEnum [(1::Word8),minBound,maxBound]) = [1,0,255]
+    (take 7 [(1::Word8)..]) = [1,2,3,4,5,6,7]
+    (take 7 [((maxBound::Word8)-5)..]) = [250,251,252,253,254,255]
+    (take 7 [(1::Word8),2..]) = [1,2,3,4,5,6,7]
+    (take 7 [(1::Word8),7..]) = [1,7,13,19,25,31,37]
+    (take 7 [(1::Word8),1..]) = [1,1,1,1,1,1,1]
+    (take 7 [(1::Word8),0..]) = [1,0]
+    (take 7 [(5::Word8),2..]) = [5,2]
+    (take 7 [x, x-1 ..]) = [1,0]
+    (take 7 [x, x-1 ..]) = [5,4,3,2,1,0]
+    (take 7 [x, (x+1) ..]) = [250,251,252,253,254,255]
+    (take 7 ([(1::Word8) .. 5])) = [1,2,3,4,5]
+    (take 4 ([(1::Word8) .. 1])) = [1]
+    (take 7 ([(1::Word8) .. 0])) = []
+    (take 7 ([(5::Word8) .. 0])) = []
+    (take 7 ([(maxBound-(5::Word8)) .. maxBound])) = [250,251,252,253,254,255]
+    (take 7 ([(minBound+(5::Word8)) .. minBound])) = []
+    (take 7 [(5::Word8),4..1]) = [5,4,3,2,1]
+    (take 7 [(5::Word8),3..1]) = [5,3,1]
+    (take 7 [(5::Word8),3..2]) = [5,3]
+    (take 7 [(1::Word8),2..1]) = [1]
+    (take 7 [(2::Word8),1..2]) = [2]
+    (take 7 [(2::Word8),1..1]) = [2,1]
+    (take 7 [(2::Word8),3..1]) = []
+    (take 7 [x,(x+1)..maxBound]) = [251,252,253,254,255]
+    (take 7 [x,(x-1)..minBound]) = [5,4,3,2,1,0]
+Testing Enum Word16:
+    (succ (0::Word16)) = 1
+    (succ (minBound::Word16)) = 1
+    (succ (maxBound::Word16)) = error "Enum.succ{Word16}: tried to take `succ' of maxBound"
+    pred (1::Word16) = 0
+    pred (maxBound::Word16) = 65534
+    pred (minBound::Word16) = error "Enum.pred{Word16}: tried to take `pred' of minBound"
+    (map (toEnum::Int->Word16) [1, fromIntegral (minBound::Word16)::Int, fromIntegral (maxBound::Word16)::Int]) = [1,0,65535]
+    (toEnum (maxBound::Int))::Word16 = error "Enum.toEnum{Word16}: tag (2147483647) is outside of bounds (0,65535)"
+    (map fromEnum [(1::Word16),minBound,maxBound]) = [1,0,65535]
+    (take 7 [(1::Word16)..]) = [1,2,3,4,5,6,7]
+    (take 7 [((maxBound::Word16)-5)..]) = [65530,65531,65532,65533,65534,65535]
+    (take 7 [(1::Word16),2..]) = [1,2,3,4,5,6,7]
+    (take 7 [(1::Word16),7..]) = [1,7,13,19,25,31,37]
+    (take 7 [(1::Word16),1..]) = [1,1,1,1,1,1,1]
+    (take 7 [(1::Word16),0..]) = [1,0]
+    (take 7 [(5::Word16),2..]) = [5,2]
+    (take 7 [x, x-1 ..]) = [1,0]
+    (take 7 [x, x-1 ..]) = [5,4,3,2,1,0]
+    (take 7 [x, (x+1) ..]) = [65530,65531,65532,65533,65534,65535]
+    (take 7 ([(1::Word16) .. 5])) = [1,2,3,4,5]
+    (take 4 ([(1::Word16) .. 1])) = [1]
+    (take 7 ([(1::Word16) .. 0])) = []
+    (take 7 ([(5::Word16) .. 0])) = []
+    (take 7 ([(maxBound-(5::Word16)) .. maxBound])) = [65530,65531,65532,65533,65534,65535]
+    (take 7 ([(minBound+(5::Word16)) .. minBound])) = []
+    (take 7 [(5::Word16),4..1]) = [5,4,3,2,1]
+    (take 7 [(5::Word16),3..1]) = [5,3,1]
+    (take 7 [(5::Word16),3..2]) = [5,3]
+    (take 7 [(1::Word16),2..1]) = [1]
+    (take 7 [(2::Word16),1..2]) = [2]
+    (take 7 [(2::Word16),1..1]) = [2,1]
+    (take 7 [(2::Word16),3..1]) = []
+    (take 7 [x,(x+1)..maxBound]) = [65531,65532,65533,65534,65535]
+    (take 7 [x,(x-1)..minBound]) = [5,4,3,2,1,0]
+Testing Enum Word32:
+    (succ (0::Word32)) = 1
+    (succ (minBound::Word32)) = 1
+    (succ (maxBound::Word32)) = error "Enum.succ{Word32}: tried to take `succ' of maxBound"
+    pred (1::Word32) = 0
+    pred (maxBound::Word32) = 4294967294
+    pred (minBound::Word32) = error "Enum.pred{Word32}: tried to take `pred' of minBound"
+    (map (toEnum::Int->Word32) [1, fromIntegral (minBound::Word32)::Int, fromIntegral (maxBound::Int32)::Int]) = [1,0,2147483647]
+    (toEnum (maxBound::Int))::Word32 = 2147483647
+    (map fromEnum [(1::Word32),minBound,fromIntegral (maxBound::Int)]) = [1,0,2147483647]
+    fromEnum (maxBound::Word32) = error "Enum.fromEnum{Word32}: value (4294967295) is outside of Int's bounds (-2147483648,2147483647)"
+    (take 7 [(1::Word32)..]) = [1,2,3,4,5,6,7]
+    (take 7 [((maxBound::Word32)-5)..]) = [4294967290,4294967291,4294967292,4294967293,4294967294,4294967295]
+    (take 7 [(1::Word32),2..]) = [1,2,3,4,5,6,7]
+    (take 7 [(1::Word32),7..]) = [1,7,13,19,25,31,37]
+    (take 7 [(1::Word32),1..]) = [1,1,1,1,1,1,1]
+    (take 7 [(1::Word32),0..]) = [1,0]
+    (take 7 [(5::Word32),2..]) = [5,2]
+    (take 7 [x, x-1 ..]) = [1,0]
+    (take 7 [x, x-1 ..]) = [5,4,3,2,1,0]
+    (take 7 [x, (x+1) ..]) = [4294967290,4294967291,4294967292,4294967293,4294967294,4294967295]
+    (take 7 ([(1::Word32) .. 5])) = [1,2,3,4,5]
+    (take 4 ([(1::Word32) .. 1])) = [1]
+    (take 7 ([(1::Word32) .. 0])) = []
+    (take 7 ([(5::Word32) .. 0])) = []
+    (take 7 ([(maxBound-(5::Word32)) .. maxBound])) = [4294967290,4294967291,4294967292,4294967293,4294967294,4294967295]
+    (take 7 ([(minBound+(5::Word32)) .. minBound])) = []
+    (take 7 [(5::Word32),4..1]) = [5,4,3,2,1]
+    (take 7 [(5::Word32),3..1]) = [5,3,1]
+    (take 7 [(5::Word32),3..2]) = [5,3]
+    (take 7 [(1::Word32),2..1]) = [1]
+    (take 7 [(2::Word32),1..2]) = [2]
+    (take 7 [(2::Word32),1..1]) = [2,1]
+    (take 7 [(2::Word32),3..1]) = []
+    (take 7 [x,(x+1)..maxBound]) = [4294967291,4294967292,4294967293,4294967294,4294967295]
+    (take 7 [x,(x-1)..minBound]) = [5,4,3,2,1,0]
+Testing Enum Word64:
+    (succ (0::Word64)) = 1
+    (succ (minBound::Word64)) = 1
+    (succ (maxBound::Word64)) = error "Enum.succ{Word64}: tried to take `succ' of maxBound"
+    pred (1::Word64) = 0
+    pred (maxBound::Word64) = 18446744073709551614
+    pred (minBound::Word64) = error "Enum.pred{Word64}: tried to take `pred' of minBound"
+    (map (toEnum::Int->Word64) [1, fromIntegral (minBound::Word64)::Int, maxBound::Int]) = [1,0,2147483647]
+    (toEnum (maxBound::Int))::Word64 = 2147483647
+    (map fromEnum [(1::Word64),minBound,fromIntegral (maxBound::Int)]) = [1,0,2147483647]
+    fromEnum (maxBound::Word64) = error "Enum.fromEnum{Word64}: value (18446744073709551615) is outside of Int's bounds (-2147483648,2147483647)"
+    (take 7 [(1::Word64)..]) = [1,2,3,4,5,6,7]
+    (take 7 [((maxBound::Word64)-5)..]) = [18446744073709551610,18446744073709551611,18446744073709551612,18446744073709551613,18446744073709551614,18446744073709551615]
+    (take 7 [(1::Word64),2..]) = [1,2,3,4,5,6,7]
+    (take 7 [(1::Word64),7..]) = [1,7,13,19,25,31,37]
+    (take 7 [(1::Word64),1..]) = [1,1,1,1,1,1,1]
+    (take 7 [(1::Word64),0..]) = [1,0]
+    (take 7 [(5::Word64),2..]) = [5,2]
+    (take 7 [x, x-1 ..]) = [1,0]
+    (take 7 [x, x-1 ..]) = [5,4,3,2,1,0]
+    (take 7 [x, (x+1) ..]) = [18446744073709551610,18446744073709551611,18446744073709551612,18446744073709551613,18446744073709551614,18446744073709551615]
+    (take 7 ([(1::Word64) .. 5])) = [1,2,3,4,5]
+    (take 4 ([(1::Word64) .. 1])) = [1]
+    (take 7 ([(1::Word64) .. 0])) = []
+    (take 7 ([(5::Word64) .. 0])) = []
+    (take 7 ([(maxBound-(5::Word64)) .. maxBound])) = [18446744073709551610,18446744073709551611,18446744073709551612,18446744073709551613,18446744073709551614,18446744073709551615]
+    (take 7 ([(minBound+(5::Word64)) .. minBound])) = []
+    (take 7 [(5::Word64),4..1]) = [5,4,3,2,1]
+    (take 7 [(5::Word64),3..1]) = [5,3,1]
+    (take 7 [(5::Word64),3..2]) = [5,3]
+    (take 7 [(1::Word64),2..1]) = [1]
+    (take 7 [(2::Word64),1..2]) = [2]
+    (take 7 [(2::Word64),1..1]) = [2,1]
+    (take 7 [(2::Word64),3..1]) = []
+    (take 7 [x,(x+1)..maxBound]) = [18446744073709551611,18446744073709551612,18446744073709551613,18446744073709551614,18446744073709551615]
+    (take 7 [x,(x-1)..minBound]) = [5,4,3,2,1,0]
diff --git a/libraries/base/tests/enum03.stdout-alpha-dec-osf3 b/libraries/base/tests/enum03.stdout-alpha-dec-osf3
new file mode 100644
index 000000000000..716782c46ad7
--- /dev/null
+++ b/libraries/base/tests/enum03.stdout-alpha-dec-osf3
@@ -0,0 +1,142 @@
+Testing Enum Word8:
+    (succ (0::Word8)) = 1
+    (succ (minBound::Word8)) = 1
+    (succ (maxBound::Word8)) = error "Enum.succ{Word8}: tried to take `succ' of maxBound"
+    pred (1::Word8) = 0
+    pred (maxBound::Word8) = 254
+    pred (minBound::Word8) = error "Enum.pred{Word8}: tried to take `pred' of minBound"
+    (map (toEnum::Int->Word8) [1, fromIntegral (minBound::Word8)::Int, fromIntegral (maxBound::Word8)::Int]) = [1,0,255]
+    (toEnum (maxBound::Int))::Word8 = error "Enum.toEnum{Word8}: tag (9223372036854775807) is outside of bounds (0,255)"
+    (map fromEnum [(1::Word8),minBound,maxBound]) = [1,0,255]
+    (take 7 [(1::Word8)..]) = [1,2,3,4,5,6,7]
+    (take 7 [((maxBound::Word8)-5)..]) = [250,251,252,253,254,255]
+    (take 7 [(1::Word8),2..]) = [1,2,3,4,5,6,7]
+    (take 7 [(1::Word8),7..]) = [1,7,13,19,25,31,37]
+    (take 7 [(1::Word8),1..]) = [1,1,1,1,1,1,1]
+    (take 7 [(1::Word8),0..]) = [1,0]
+    (take 7 [(5::Word8),2..]) = [5,2]
+    (take 7 [x, x-1 ..]) = [1,0]
+    (take 7 [x, x-1 ..]) = [5,4,3,2,1,0]
+    (take 7 [x, (x+1) ..]) = [250,251,252,253,254,255]
+    (take 7 ([(1::Word8) .. 5])) = [1,2,3,4,5]
+    (take 4 ([(1::Word8) .. 1])) = [1]
+    (take 7 ([(1::Word8) .. 0])) = []
+    (take 7 ([(5::Word8) .. 0])) = []
+    (take 7 ([(maxBound-(5::Word8)) .. maxBound])) = [250,251,252,253,254,255]
+    (take 7 ([(minBound+(5::Word8)) .. minBound])) = []
+    (take 7 [(5::Word8),4..1]) = [5,4,3,2,1]
+    (take 7 [(5::Word8),3..1]) = [5,3,1]
+    (take 7 [(5::Word8),3..2]) = [5,3]
+    (take 7 [(1::Word8),2..1]) = [1]
+    (take 7 [(2::Word8),1..2]) = [2]
+    (take 7 [(2::Word8),1..1]) = [2,1]
+    (take 7 [(2::Word8),3..1]) = []
+    (take 7 [x,(x+1)..maxBound]) = [251,252,253,254,255]
+    (take 7 [x,(x-1)..minBound]) = [5,4,3,2,1,0]
+Testing Enum Word16:
+    (succ (0::Word16)) = 1
+    (succ (minBound::Word16)) = 1
+    (succ (maxBound::Word16)) = error "Enum.succ{Word16}: tried to take `succ' of maxBound"
+    pred (1::Word16) = 0
+    pred (maxBound::Word16) = 65534
+    pred (minBound::Word16) = error "Enum.pred{Word16}: tried to take `pred' of minBound"
+    (map (toEnum::Int->Word16) [1, fromIntegral (minBound::Word16)::Int, fromIntegral (maxBound::Word16)::Int]) = [1,0,65535]
+    (toEnum (maxBound::Int))::Word16 = error "Enum.toEnum{Word16}: tag (9223372036854775807) is outside of bounds (0,65535)"
+    (map fromEnum [(1::Word16),minBound,maxBound]) = [1,0,65535]
+    (take 7 [(1::Word16)..]) = [1,2,3,4,5,6,7]
+    (take 7 [((maxBound::Word16)-5)..]) = [65530,65531,65532,65533,65534,65535]
+    (take 7 [(1::Word16),2..]) = [1,2,3,4,5,6,7]
+    (take 7 [(1::Word16),7..]) = [1,7,13,19,25,31,37]
+    (take 7 [(1::Word16),1..]) = [1,1,1,1,1,1,1]
+    (take 7 [(1::Word16),0..]) = [1,0]
+    (take 7 [(5::Word16),2..]) = [5,2]
+    (take 7 [x, x-1 ..]) = [1,0]
+    (take 7 [x, x-1 ..]) = [5,4,3,2,1,0]
+    (take 7 [x, (x+1) ..]) = [65530,65531,65532,65533,65534,65535]
+    (take 7 ([(1::Word16) .. 5])) = [1,2,3,4,5]
+    (take 4 ([(1::Word16) .. 1])) = [1]
+    (take 7 ([(1::Word16) .. 0])) = []
+    (take 7 ([(5::Word16) .. 0])) = []
+    (take 7 ([(maxBound-(5::Word16)) .. maxBound])) = [65530,65531,65532,65533,65534,65535]
+    (take 7 ([(minBound+(5::Word16)) .. minBound])) = []
+    (take 7 [(5::Word16),4..1]) = [5,4,3,2,1]
+    (take 7 [(5::Word16),3..1]) = [5,3,1]
+    (take 7 [(5::Word16),3..2]) = [5,3]
+    (take 7 [(1::Word16),2..1]) = [1]
+    (take 7 [(2::Word16),1..2]) = [2]
+    (take 7 [(2::Word16),1..1]) = [2,1]
+    (take 7 [(2::Word16),3..1]) = []
+    (take 7 [x,(x+1)..maxBound]) = [65531,65532,65533,65534,65535]
+    (take 7 [x,(x-1)..minBound]) = [5,4,3,2,1,0]
+Testing Enum Word32:
+    (succ (0::Word32)) = 1
+    (succ (minBound::Word32)) = 1
+    (succ (maxBound::Word32)) = error "Enum.succ{Word32}: tried to take `succ' of maxBound"
+    pred (1::Word32) = 0
+    pred (maxBound::Word32) = 4294967294
+    pred (minBound::Word32) = error "Enum.pred{Word32}: tried to take `pred' of minBound"
+    (map (toEnum::Int->Word32) [1, fromIntegral (minBound::Word32)::Int, fromIntegral (maxBound::Int32)::Int]) = [1,0,2147483647]
+    (toEnum (maxBound::Int))::Word32 = error "Enum.toEnum{Word32}: tag (9223372036854775807) is outside of bounds (0,4294967295)"
+    (map fromEnum [(1::Word32),minBound,fromIntegral (maxBound::Int)]) = [1,0,4294967295]
+    fromEnum (maxBound::Word32) = 4294967295
+    (take 7 [(1::Word32)..]) = [1,2,3,4,5,6,7]
+    (take 7 [((maxBound::Word32)-5)..]) = [4294967290,4294967291,4294967292,4294967293,4294967294,4294967295]
+    (take 7 [(1::Word32),2..]) = [1,2,3,4,5,6,7]
+    (take 7 [(1::Word32),7..]) = [1,7,13,19,25,31,37]
+    (take 7 [(1::Word32),1..]) = [1,1,1,1,1,1,1]
+    (take 7 [(1::Word32),0..]) = [1,0]
+    (take 7 [(5::Word32),2..]) = [5,2]
+    (take 7 [x, x-1 ..]) = [1,0]
+    (take 7 [x, x-1 ..]) = [5,4,3,2,1,0]
+    (take 7 [x, (x+1) ..]) = [4294967290,4294967291,4294967292,4294967293,4294967294,4294967295]
+    (take 7 ([(1::Word32) .. 5])) = [1,2,3,4,5]
+    (take 4 ([(1::Word32) .. 1])) = [1]
+    (take 7 ([(1::Word32) .. 0])) = []
+    (take 7 ([(5::Word32) .. 0])) = []
+    (take 7 ([(maxBound-(5::Word32)) .. maxBound])) = [4294967290,4294967291,4294967292,4294967293,4294967294,4294967295]
+    (take 7 ([(minBound+(5::Word32)) .. minBound])) = []
+    (take 7 [(5::Word32),4..1]) = [5,4,3,2,1]
+    (take 7 [(5::Word32),3..1]) = [5,3,1]
+    (take 7 [(5::Word32),3..2]) = [5,3]
+    (take 7 [(1::Word32),2..1]) = [1]
+    (take 7 [(2::Word32),1..2]) = [2]
+    (take 7 [(2::Word32),1..1]) = [2,1]
+    (take 7 [(2::Word32),3..1]) = []
+    (take 7 [x,(x+1)..maxBound]) = [4294967291,4294967292,4294967293,4294967294,4294967295]
+    (take 7 [x,(x-1)..minBound]) = [5,4,3,2,1,0]
+Testing Enum Word64:
+    (succ (0::Word64)) = 1
+    (succ (minBound::Word64)) = 1
+    (succ (maxBound::Word64)) = error "Enum.succ{Word64}: tried to take `succ' of maxBound"
+    pred (1::Word64) = 0
+    pred (maxBound::Word64) = 18446744073709551614
+    pred (minBound::Word64) = error "Enum.pred{Word64}: tried to take `pred' of minBound"
+    (map (toEnum::Int->Word64) [1, fromIntegral (minBound::Word64)::Int, maxBound::Int]) = [1,0,9223372036854775807]
+    (toEnum (maxBound::Int))::Word64 = 9223372036854775807
+    (map fromEnum [(1::Word64),minBound,fromIntegral (maxBound::Int)]) = [1,0,9223372036854775807]
+    fromEnum (maxBound::Word64) = error "Enum.fromEnum{Word64}: value (18446744073709551615) is outside of Int's bounds (-9223372036854775808,9223372036854775807)"
+    (take 7 [(1::Word64)..]) = [1,2,3,4,5,6,7]
+    (take 7 [((maxBound::Word64)-5)..]) = [18446744073709551610,18446744073709551611,18446744073709551612,18446744073709551613,18446744073709551614,18446744073709551615]
+    (take 7 [(1::Word64),2..]) = [1,2,3,4,5,6,7]
+    (take 7 [(1::Word64),7..]) = [1,7,13,19,25,31,37]
+    (take 7 [(1::Word64),1..]) = [1,1,1,1,1,1,1]
+    (take 7 [(1::Word64),0..]) = [1,0]
+    (take 7 [(5::Word64),2..]) = [5,2]
+    (take 7 [x, x-1 ..]) = [1,0]
+    (take 7 [x, x-1 ..]) = [5,4,3,2,1,0]
+    (take 7 [x, (x+1) ..]) = [18446744073709551610,18446744073709551611,18446744073709551612,18446744073709551613,18446744073709551614,18446744073709551615]
+    (take 7 ([(1::Word64) .. 5])) = [1,2,3,4,5]
+    (take 4 ([(1::Word64) .. 1])) = [1]
+    (take 7 ([(1::Word64) .. 0])) = []
+    (take 7 ([(5::Word64) .. 0])) = []
+    (take 7 ([(maxBound-(5::Word64)) .. maxBound])) = [18446744073709551610,18446744073709551611,18446744073709551612,18446744073709551613,18446744073709551614,18446744073709551615]
+    (take 7 ([(minBound+(5::Word64)) .. minBound])) = []
+    (take 7 [(5::Word64),4..1]) = [5,4,3,2,1]
+    (take 7 [(5::Word64),3..1]) = [5,3,1]
+    (take 7 [(5::Word64),3..2]) = [5,3]
+    (take 7 [(1::Word64),2..1]) = [1]
+    (take 7 [(2::Word64),1..2]) = [2]
+    (take 7 [(2::Word64),1..1]) = [2,1]
+    (take 7 [(2::Word64),3..1]) = []
+    (take 7 [x,(x+1)..maxBound]) = [18446744073709551611,18446744073709551612,18446744073709551613,18446744073709551614,18446744073709551615]
+    (take 7 [x,(x-1)..minBound]) = [5,4,3,2,1,0]
diff --git a/libraries/base/tests/enum03.stdout-hugs b/libraries/base/tests/enum03.stdout-hugs
new file mode 100644
index 000000000000..babc1c2e9ed7
--- /dev/null
+++ b/libraries/base/tests/enum03.stdout-hugs
@@ -0,0 +1,142 @@
+Testing Enum Word8:
+    (succ (0::Word8)) = 1
+    (succ (minBound::Word8)) = 1
+    (succ (maxBound::Word8)) = error "succ: applied to maxBound"
+    pred (1::Word8) = 0
+    pred (maxBound::Word8) = 254
+    pred (minBound::Word8) = error "pred: applied to minBound"
+    (map (toEnum::Int->Word8) [1, fromIntegral (minBound::Word8)::Int, fromIntegral (maxBound::Word8)::Int]) = [1,0,255]
+    (toEnum (maxBound::Int))::Word8 = 255
+    (map fromEnum [(1::Word8),minBound,maxBound]) = [1,0,255]
+    (take 7 [(1::Word8)..]) = [1,2,3,4,5,6,7]
+    (take 7 [((maxBound::Word8)-5)..]) = [250,251,252,253,254,255]
+    (take 7 [(1::Word8),2..]) = [1,2,3,4,5,6,7]
+    (take 7 [(1::Word8),7..]) = [1,7,13,19,25,31,37]
+    (take 7 [(1::Word8),1..]) = [1,1,1,1,1,1,1]
+    (take 7 [(1::Word8),0..]) = [1,0]
+    (take 7 [(5::Word8),2..]) = [5,2]
+    (take 7 [x, x-1 ..]) = [1,0]
+    (take 7 [x, x-1 ..]) = [5,4,3,2,1,0]
+    (take 7 [x, (x+1) ..]) = [250,251,252,253,254,255]
+    (take 7 ([(1::Word8) .. 5])) = [1,2,3,4,5]
+    (take 4 ([(1::Word8) .. 1])) = [1]
+    (take 7 ([(1::Word8) .. 0])) = []
+    (take 7 ([(5::Word8) .. 0])) = []
+    (take 7 ([(maxBound-(5::Word8)) .. maxBound])) = [250,251,252,253,254,255]
+    (take 7 ([(minBound+(5::Word8)) .. minBound])) = []
+    (take 7 [(5::Word8),4..1]) = [5,4,3,2,1]
+    (take 7 [(5::Word8),3..1]) = [5,3,1]
+    (take 7 [(5::Word8),3..2]) = [5,3]
+    (take 7 [(1::Word8),2..1]) = [1]
+    (take 7 [(2::Word8),1..2]) = [2]
+    (take 7 [(2::Word8),1..1]) = [2,1]
+    (take 7 [(2::Word8),3..1]) = []
+    (take 7 [x,(x+1)..maxBound]) = [251,252,253,254,255]
+    (take 7 [x,(x-1)..minBound]) = [5,4,3,2,1,0]
+Testing Enum Word16:
+    (succ (0::Word16)) = 1
+    (succ (minBound::Word16)) = 1
+    (succ (maxBound::Word16)) = error "succ: applied to maxBound"
+    pred (1::Word16) = 0
+    pred (maxBound::Word16) = 65534
+    pred (minBound::Word16) = error "pred: applied to minBound"
+    (map (toEnum::Int->Word16) [1, fromIntegral (minBound::Word16)::Int, fromIntegral (maxBound::Word16)::Int]) = [1,0,65535]
+    (toEnum (maxBound::Int))::Word16 = 65535
+    (map fromEnum [(1::Word16),minBound,maxBound]) = [1,0,65535]
+    (take 7 [(1::Word16)..]) = [1,2,3,4,5,6,7]
+    (take 7 [((maxBound::Word16)-5)..]) = [65530,65531,65532,65533,65534,65535]
+    (take 7 [(1::Word16),2..]) = [1,2,3,4,5,6,7]
+    (take 7 [(1::Word16),7..]) = [1,7,13,19,25,31,37]
+    (take 7 [(1::Word16),1..]) = [1,1,1,1,1,1,1]
+    (take 7 [(1::Word16),0..]) = [1,0]
+    (take 7 [(5::Word16),2..]) = [5,2]
+    (take 7 [x, x-1 ..]) = [1,0]
+    (take 7 [x, x-1 ..]) = [5,4,3,2,1,0]
+    (take 7 [x, (x+1) ..]) = [65530,65531,65532,65533,65534,65535]
+    (take 7 ([(1::Word16) .. 5])) = [1,2,3,4,5]
+    (take 4 ([(1::Word16) .. 1])) = [1]
+    (take 7 ([(1::Word16) .. 0])) = []
+    (take 7 ([(5::Word16) .. 0])) = []
+    (take 7 ([(maxBound-(5::Word16)) .. maxBound])) = [65530,65531,65532,65533,65534,65535]
+    (take 7 ([(minBound+(5::Word16)) .. minBound])) = []
+    (take 7 [(5::Word16),4..1]) = [5,4,3,2,1]
+    (take 7 [(5::Word16),3..1]) = [5,3,1]
+    (take 7 [(5::Word16),3..2]) = [5,3]
+    (take 7 [(1::Word16),2..1]) = [1]
+    (take 7 [(2::Word16),1..2]) = [2]
+    (take 7 [(2::Word16),1..1]) = [2,1]
+    (take 7 [(2::Word16),3..1]) = []
+    (take 7 [x,(x+1)..maxBound]) = [65531,65532,65533,65534,65535]
+    (take 7 [x,(x-1)..minBound]) = [5,4,3,2,1,0]
+Testing Enum Word32:
+    (succ (0::Word32)) = 1
+    (succ (minBound::Word32)) = 1
+    (succ (maxBound::Word32)) = error "succ: applied to maxBound"
+    pred (1::Word32) = 0
+    pred (maxBound::Word32) = 4294967294
+    pred (minBound::Word32) = error "pred: applied to minBound"
+    (map (toEnum::Int->Word32) [1, fromIntegral (minBound::Word32)::Int, fromIntegral (maxBound::Int32)::Int]) = [1,0,2147483647]
+    (toEnum (maxBound::Int))::Word32 = 2147483647
+    (map fromEnum [(1::Word32),minBound,fromIntegral (maxBound::Int)]) = [1,0,2147483647]
+    fromEnum (maxBound::Word32) = -1
+    (take 7 [(1::Word32)..]) = [1,2,3,4,5,6,7]
+    (take 7 [((maxBound::Word32)-5)..]) = [4294967290,4294967291,4294967292,4294967293,4294967294,4294967295]
+    (take 7 [(1::Word32),2..]) = [1,2,3,4,5,6,7]
+    (take 7 [(1::Word32),7..]) = [1,7,13,19,25,31,37]
+    (take 7 [(1::Word32),1..]) = [1,1,1,1,1,1,1]
+    (take 7 [(1::Word32),0..]) = [1,0]
+    (take 7 [(5::Word32),2..]) = [5,2]
+    (take 7 [x, x-1 ..]) = [1,0]
+    (take 7 [x, x-1 ..]) = [5,4,3,2,1,0]
+    (take 7 [x, (x+1) ..]) = [4294967290,4294967291,4294967292,4294967293,4294967294,4294967295]
+    (take 7 ([(1::Word32) .. 5])) = [1,2,3,4,5]
+    (take 4 ([(1::Word32) .. 1])) = [1]
+    (take 7 ([(1::Word32) .. 0])) = []
+    (take 7 ([(5::Word32) .. 0])) = []
+    (take 7 ([(maxBound-(5::Word32)) .. maxBound])) = [4294967290,4294967291,4294967292,4294967293,4294967294,4294967295]
+    (take 7 ([(minBound+(5::Word32)) .. minBound])) = []
+    (take 7 [(5::Word32),4..1]) = [5,4,3,2,1]
+    (take 7 [(5::Word32),3..1]) = [5,3,1]
+    (take 7 [(5::Word32),3..2]) = [5,3]
+    (take 7 [(1::Word32),2..1]) = [1]
+    (take 7 [(2::Word32),1..2]) = [2]
+    (take 7 [(2::Word32),1..1]) = [2,1]
+    (take 7 [(2::Word32),3..1]) = []
+    (take 7 [x,(x+1)..maxBound]) = [4294967291,4294967292,4294967293,4294967294,4294967295]
+    (take 7 [x,(x-1)..minBound]) = [5,4,3,2,1,0]
+Testing Enum Word64:
+    (succ (0::Word64)) = 1
+    (succ (minBound::Word64)) = 1
+    (succ (maxBound::Word64)) = error "succ: applied to maxBound"
+    pred (1::Word64) = 0
+    pred (maxBound::Word64) = 18446744073709551614
+    pred (minBound::Word64) = error "pred: applied to minBound"
+    (map (toEnum::Int->Word64) [1, fromIntegral (minBound::Word64)::Int, maxBound::Int]) = [1,0,2147483647]
+    (toEnum (maxBound::Int))::Word64 = 2147483647
+    (map fromEnum [(1::Word64),minBound,fromIntegral (maxBound::Int)]) = [1,0,2147483647]
+    fromEnum (maxBound::Word64) = Fail: arithmetic overflow
+    (take 7 [(1::Word64)..]) = [1,2,3,4,5,6,7]
+    (take 7 [((maxBound::Word64)-5)..]) = [18446744073709551610,18446744073709551611,18446744073709551612,18446744073709551613,18446744073709551614,18446744073709551615]
+    (take 7 [(1::Word64),2..]) = [1,2,3,4,5,6,7]
+    (take 7 [(1::Word64),7..]) = [1,7,13,19,25,31,37]
+    (take 7 [(1::Word64),1..]) = [1,1,1,1,1,1,1]
+    (take 7 [(1::Word64),0..]) = [1,0]
+    (take 7 [(5::Word64),2..]) = [5,2]
+    (take 7 [x, x-1 ..]) = [1,0]
+    (take 7 [x, x-1 ..]) = [5,4,3,2,1,0]
+    (take 7 [x, (x+1) ..]) = [18446744073709551610,18446744073709551611,18446744073709551612,18446744073709551613,18446744073709551614,18446744073709551615]
+    (take 7 ([(1::Word64) .. 5])) = [1,2,3,4,5]
+    (take 4 ([(1::Word64) .. 1])) = [1]
+    (take 7 ([(1::Word64) .. 0])) = []
+    (take 7 ([(5::Word64) .. 0])) = []
+    (take 7 ([(maxBound-(5::Word64)) .. maxBound])) = [18446744073709551610,18446744073709551611,18446744073709551612,18446744073709551613,18446744073709551614,18446744073709551615]
+    (take 7 ([(minBound+(5::Word64)) .. minBound])) = []
+    (take 7 [(5::Word64),4..1]) = [5,4,3,2,1]
+    (take 7 [(5::Word64),3..1]) = [5,3,1]
+    (take 7 [(5::Word64),3..2]) = [5,3]
+    (take 7 [(1::Word64),2..1]) = [1]
+    (take 7 [(2::Word64),1..2]) = [2]
+    (take 7 [(2::Word64),1..1]) = [2,1]
+    (take 7 [(2::Word64),3..1]) = []
+    (take 7 [x,(x+1)..maxBound]) = [18446744073709551611,18446744073709551612,18446744073709551613,18446744073709551614,18446744073709551615]
+    (take 7 [x,(x-1)..minBound]) = [5,4,3,2,1,0]
diff --git a/libraries/base/tests/enum03.stdout-mips-sgi-irix b/libraries/base/tests/enum03.stdout-mips-sgi-irix
new file mode 100644
index 000000000000..716782c46ad7
--- /dev/null
+++ b/libraries/base/tests/enum03.stdout-mips-sgi-irix
@@ -0,0 +1,142 @@
+Testing Enum Word8:
+    (succ (0::Word8)) = 1
+    (succ (minBound::Word8)) = 1
+    (succ (maxBound::Word8)) = error "Enum.succ{Word8}: tried to take `succ' of maxBound"
+    pred (1::Word8) = 0
+    pred (maxBound::Word8) = 254
+    pred (minBound::Word8) = error "Enum.pred{Word8}: tried to take `pred' of minBound"
+    (map (toEnum::Int->Word8) [1, fromIntegral (minBound::Word8)::Int, fromIntegral (maxBound::Word8)::Int]) = [1,0,255]
+    (toEnum (maxBound::Int))::Word8 = error "Enum.toEnum{Word8}: tag (9223372036854775807) is outside of bounds (0,255)"
+    (map fromEnum [(1::Word8),minBound,maxBound]) = [1,0,255]
+    (take 7 [(1::Word8)..]) = [1,2,3,4,5,6,7]
+    (take 7 [((maxBound::Word8)-5)..]) = [250,251,252,253,254,255]
+    (take 7 [(1::Word8),2..]) = [1,2,3,4,5,6,7]
+    (take 7 [(1::Word8),7..]) = [1,7,13,19,25,31,37]
+    (take 7 [(1::Word8),1..]) = [1,1,1,1,1,1,1]
+    (take 7 [(1::Word8),0..]) = [1,0]
+    (take 7 [(5::Word8),2..]) = [5,2]
+    (take 7 [x, x-1 ..]) = [1,0]
+    (take 7 [x, x-1 ..]) = [5,4,3,2,1,0]
+    (take 7 [x, (x+1) ..]) = [250,251,252,253,254,255]
+    (take 7 ([(1::Word8) .. 5])) = [1,2,3,4,5]
+    (take 4 ([(1::Word8) .. 1])) = [1]
+    (take 7 ([(1::Word8) .. 0])) = []
+    (take 7 ([(5::Word8) .. 0])) = []
+    (take 7 ([(maxBound-(5::Word8)) .. maxBound])) = [250,251,252,253,254,255]
+    (take 7 ([(minBound+(5::Word8)) .. minBound])) = []
+    (take 7 [(5::Word8),4..1]) = [5,4,3,2,1]
+    (take 7 [(5::Word8),3..1]) = [5,3,1]
+    (take 7 [(5::Word8),3..2]) = [5,3]
+    (take 7 [(1::Word8),2..1]) = [1]
+    (take 7 [(2::Word8),1..2]) = [2]
+    (take 7 [(2::Word8),1..1]) = [2,1]
+    (take 7 [(2::Word8),3..1]) = []
+    (take 7 [x,(x+1)..maxBound]) = [251,252,253,254,255]
+    (take 7 [x,(x-1)..minBound]) = [5,4,3,2,1,0]
+Testing Enum Word16:
+    (succ (0::Word16)) = 1
+    (succ (minBound::Word16)) = 1
+    (succ (maxBound::Word16)) = error "Enum.succ{Word16}: tried to take `succ' of maxBound"
+    pred (1::Word16) = 0
+    pred (maxBound::Word16) = 65534
+    pred (minBound::Word16) = error "Enum.pred{Word16}: tried to take `pred' of minBound"
+    (map (toEnum::Int->Word16) [1, fromIntegral (minBound::Word16)::Int, fromIntegral (maxBound::Word16)::Int]) = [1,0,65535]
+    (toEnum (maxBound::Int))::Word16 = error "Enum.toEnum{Word16}: tag (9223372036854775807) is outside of bounds (0,65535)"
+    (map fromEnum [(1::Word16),minBound,maxBound]) = [1,0,65535]
+    (take 7 [(1::Word16)..]) = [1,2,3,4,5,6,7]
+    (take 7 [((maxBound::Word16)-5)..]) = [65530,65531,65532,65533,65534,65535]
+    (take 7 [(1::Word16),2..]) = [1,2,3,4,5,6,7]
+    (take 7 [(1::Word16),7..]) = [1,7,13,19,25,31,37]
+    (take 7 [(1::Word16),1..]) = [1,1,1,1,1,1,1]
+    (take 7 [(1::Word16),0..]) = [1,0]
+    (take 7 [(5::Word16),2..]) = [5,2]
+    (take 7 [x, x-1 ..]) = [1,0]
+    (take 7 [x, x-1 ..]) = [5,4,3,2,1,0]
+    (take 7 [x, (x+1) ..]) = [65530,65531,65532,65533,65534,65535]
+    (take 7 ([(1::Word16) .. 5])) = [1,2,3,4,5]
+    (take 4 ([(1::Word16) .. 1])) = [1]
+    (take 7 ([(1::Word16) .. 0])) = []
+    (take 7 ([(5::Word16) .. 0])) = []
+    (take 7 ([(maxBound-(5::Word16)) .. maxBound])) = [65530,65531,65532,65533,65534,65535]
+    (take 7 ([(minBound+(5::Word16)) .. minBound])) = []
+    (take 7 [(5::Word16),4..1]) = [5,4,3,2,1]
+    (take 7 [(5::Word16),3..1]) = [5,3,1]
+    (take 7 [(5::Word16),3..2]) = [5,3]
+    (take 7 [(1::Word16),2..1]) = [1]
+    (take 7 [(2::Word16),1..2]) = [2]
+    (take 7 [(2::Word16),1..1]) = [2,1]
+    (take 7 [(2::Word16),3..1]) = []
+    (take 7 [x,(x+1)..maxBound]) = [65531,65532,65533,65534,65535]
+    (take 7 [x,(x-1)..minBound]) = [5,4,3,2,1,0]
+Testing Enum Word32:
+    (succ (0::Word32)) = 1
+    (succ (minBound::Word32)) = 1
+    (succ (maxBound::Word32)) = error "Enum.succ{Word32}: tried to take `succ' of maxBound"
+    pred (1::Word32) = 0
+    pred (maxBound::Word32) = 4294967294
+    pred (minBound::Word32) = error "Enum.pred{Word32}: tried to take `pred' of minBound"
+    (map (toEnum::Int->Word32) [1, fromIntegral (minBound::Word32)::Int, fromIntegral (maxBound::Int32)::Int]) = [1,0,2147483647]
+    (toEnum (maxBound::Int))::Word32 = error "Enum.toEnum{Word32}: tag (9223372036854775807) is outside of bounds (0,4294967295)"
+    (map fromEnum [(1::Word32),minBound,fromIntegral (maxBound::Int)]) = [1,0,4294967295]
+    fromEnum (maxBound::Word32) = 4294967295
+    (take 7 [(1::Word32)..]) = [1,2,3,4,5,6,7]
+    (take 7 [((maxBound::Word32)-5)..]) = [4294967290,4294967291,4294967292,4294967293,4294967294,4294967295]
+    (take 7 [(1::Word32),2..]) = [1,2,3,4,5,6,7]
+    (take 7 [(1::Word32),7..]) = [1,7,13,19,25,31,37]
+    (take 7 [(1::Word32),1..]) = [1,1,1,1,1,1,1]
+    (take 7 [(1::Word32),0..]) = [1,0]
+    (take 7 [(5::Word32),2..]) = [5,2]
+    (take 7 [x, x-1 ..]) = [1,0]
+    (take 7 [x, x-1 ..]) = [5,4,3,2,1,0]
+    (take 7 [x, (x+1) ..]) = [4294967290,4294967291,4294967292,4294967293,4294967294,4294967295]
+    (take 7 ([(1::Word32) .. 5])) = [1,2,3,4,5]
+    (take 4 ([(1::Word32) .. 1])) = [1]
+    (take 7 ([(1::Word32) .. 0])) = []
+    (take 7 ([(5::Word32) .. 0])) = []
+    (take 7 ([(maxBound-(5::Word32)) .. maxBound])) = [4294967290,4294967291,4294967292,4294967293,4294967294,4294967295]
+    (take 7 ([(minBound+(5::Word32)) .. minBound])) = []
+    (take 7 [(5::Word32),4..1]) = [5,4,3,2,1]
+    (take 7 [(5::Word32),3..1]) = [5,3,1]
+    (take 7 [(5::Word32),3..2]) = [5,3]
+    (take 7 [(1::Word32),2..1]) = [1]
+    (take 7 [(2::Word32),1..2]) = [2]
+    (take 7 [(2::Word32),1..1]) = [2,1]
+    (take 7 [(2::Word32),3..1]) = []
+    (take 7 [x,(x+1)..maxBound]) = [4294967291,4294967292,4294967293,4294967294,4294967295]
+    (take 7 [x,(x-1)..minBound]) = [5,4,3,2,1,0]
+Testing Enum Word64:
+    (succ (0::Word64)) = 1
+    (succ (minBound::Word64)) = 1
+    (succ (maxBound::Word64)) = error "Enum.succ{Word64}: tried to take `succ' of maxBound"
+    pred (1::Word64) = 0
+    pred (maxBound::Word64) = 18446744073709551614
+    pred (minBound::Word64) = error "Enum.pred{Word64}: tried to take `pred' of minBound"
+    (map (toEnum::Int->Word64) [1, fromIntegral (minBound::Word64)::Int, maxBound::Int]) = [1,0,9223372036854775807]
+    (toEnum (maxBound::Int))::Word64 = 9223372036854775807
+    (map fromEnum [(1::Word64),minBound,fromIntegral (maxBound::Int)]) = [1,0,9223372036854775807]
+    fromEnum (maxBound::Word64) = error "Enum.fromEnum{Word64}: value (18446744073709551615) is outside of Int's bounds (-9223372036854775808,9223372036854775807)"
+    (take 7 [(1::Word64)..]) = [1,2,3,4,5,6,7]
+    (take 7 [((maxBound::Word64)-5)..]) = [18446744073709551610,18446744073709551611,18446744073709551612,18446744073709551613,18446744073709551614,18446744073709551615]
+    (take 7 [(1::Word64),2..]) = [1,2,3,4,5,6,7]
+    (take 7 [(1::Word64),7..]) = [1,7,13,19,25,31,37]
+    (take 7 [(1::Word64),1..]) = [1,1,1,1,1,1,1]
+    (take 7 [(1::Word64),0..]) = [1,0]
+    (take 7 [(5::Word64),2..]) = [5,2]
+    (take 7 [x, x-1 ..]) = [1,0]
+    (take 7 [x, x-1 ..]) = [5,4,3,2,1,0]
+    (take 7 [x, (x+1) ..]) = [18446744073709551610,18446744073709551611,18446744073709551612,18446744073709551613,18446744073709551614,18446744073709551615]
+    (take 7 ([(1::Word64) .. 5])) = [1,2,3,4,5]
+    (take 4 ([(1::Word64) .. 1])) = [1]
+    (take 7 ([(1::Word64) .. 0])) = []
+    (take 7 ([(5::Word64) .. 0])) = []
+    (take 7 ([(maxBound-(5::Word64)) .. maxBound])) = [18446744073709551610,18446744073709551611,18446744073709551612,18446744073709551613,18446744073709551614,18446744073709551615]
+    (take 7 ([(minBound+(5::Word64)) .. minBound])) = []
+    (take 7 [(5::Word64),4..1]) = [5,4,3,2,1]
+    (take 7 [(5::Word64),3..1]) = [5,3,1]
+    (take 7 [(5::Word64),3..2]) = [5,3]
+    (take 7 [(1::Word64),2..1]) = [1]
+    (take 7 [(2::Word64),1..2]) = [2]
+    (take 7 [(2::Word64),1..1]) = [2,1]
+    (take 7 [(2::Word64),3..1]) = []
+    (take 7 [x,(x+1)..maxBound]) = [18446744073709551611,18446744073709551612,18446744073709551613,18446744073709551614,18446744073709551615]
+    (take 7 [x,(x-1)..minBound]) = [5,4,3,2,1,0]
diff --git a/libraries/base/tests/enum03.stdout-ws-64 b/libraries/base/tests/enum03.stdout-ws-64
new file mode 100644
index 000000000000..716782c46ad7
--- /dev/null
+++ b/libraries/base/tests/enum03.stdout-ws-64
@@ -0,0 +1,142 @@
+Testing Enum Word8:
+    (succ (0::Word8)) = 1
+    (succ (minBound::Word8)) = 1
+    (succ (maxBound::Word8)) = error "Enum.succ{Word8}: tried to take `succ' of maxBound"
+    pred (1::Word8) = 0
+    pred (maxBound::Word8) = 254
+    pred (minBound::Word8) = error "Enum.pred{Word8}: tried to take `pred' of minBound"
+    (map (toEnum::Int->Word8) [1, fromIntegral (minBound::Word8)::Int, fromIntegral (maxBound::Word8)::Int]) = [1,0,255]
+    (toEnum (maxBound::Int))::Word8 = error "Enum.toEnum{Word8}: tag (9223372036854775807) is outside of bounds (0,255)"
+    (map fromEnum [(1::Word8),minBound,maxBound]) = [1,0,255]
+    (take 7 [(1::Word8)..]) = [1,2,3,4,5,6,7]
+    (take 7 [((maxBound::Word8)-5)..]) = [250,251,252,253,254,255]
+    (take 7 [(1::Word8),2..]) = [1,2,3,4,5,6,7]
+    (take 7 [(1::Word8),7..]) = [1,7,13,19,25,31,37]
+    (take 7 [(1::Word8),1..]) = [1,1,1,1,1,1,1]
+    (take 7 [(1::Word8),0..]) = [1,0]
+    (take 7 [(5::Word8),2..]) = [5,2]
+    (take 7 [x, x-1 ..]) = [1,0]
+    (take 7 [x, x-1 ..]) = [5,4,3,2,1,0]
+    (take 7 [x, (x+1) ..]) = [250,251,252,253,254,255]
+    (take 7 ([(1::Word8) .. 5])) = [1,2,3,4,5]
+    (take 4 ([(1::Word8) .. 1])) = [1]
+    (take 7 ([(1::Word8) .. 0])) = []
+    (take 7 ([(5::Word8) .. 0])) = []
+    (take 7 ([(maxBound-(5::Word8)) .. maxBound])) = [250,251,252,253,254,255]
+    (take 7 ([(minBound+(5::Word8)) .. minBound])) = []
+    (take 7 [(5::Word8),4..1]) = [5,4,3,2,1]
+    (take 7 [(5::Word8),3..1]) = [5,3,1]
+    (take 7 [(5::Word8),3..2]) = [5,3]
+    (take 7 [(1::Word8),2..1]) = [1]
+    (take 7 [(2::Word8),1..2]) = [2]
+    (take 7 [(2::Word8),1..1]) = [2,1]
+    (take 7 [(2::Word8),3..1]) = []
+    (take 7 [x,(x+1)..maxBound]) = [251,252,253,254,255]
+    (take 7 [x,(x-1)..minBound]) = [5,4,3,2,1,0]
+Testing Enum Word16:
+    (succ (0::Word16)) = 1
+    (succ (minBound::Word16)) = 1
+    (succ (maxBound::Word16)) = error "Enum.succ{Word16}: tried to take `succ' of maxBound"
+    pred (1::Word16) = 0
+    pred (maxBound::Word16) = 65534
+    pred (minBound::Word16) = error "Enum.pred{Word16}: tried to take `pred' of minBound"
+    (map (toEnum::Int->Word16) [1, fromIntegral (minBound::Word16)::Int, fromIntegral (maxBound::Word16)::Int]) = [1,0,65535]
+    (toEnum (maxBound::Int))::Word16 = error "Enum.toEnum{Word16}: tag (9223372036854775807) is outside of bounds (0,65535)"
+    (map fromEnum [(1::Word16),minBound,maxBound]) = [1,0,65535]
+    (take 7 [(1::Word16)..]) = [1,2,3,4,5,6,7]
+    (take 7 [((maxBound::Word16)-5)..]) = [65530,65531,65532,65533,65534,65535]
+    (take 7 [(1::Word16),2..]) = [1,2,3,4,5,6,7]
+    (take 7 [(1::Word16),7..]) = [1,7,13,19,25,31,37]
+    (take 7 [(1::Word16),1..]) = [1,1,1,1,1,1,1]
+    (take 7 [(1::Word16),0..]) = [1,0]
+    (take 7 [(5::Word16),2..]) = [5,2]
+    (take 7 [x, x-1 ..]) = [1,0]
+    (take 7 [x, x-1 ..]) = [5,4,3,2,1,0]
+    (take 7 [x, (x+1) ..]) = [65530,65531,65532,65533,65534,65535]
+    (take 7 ([(1::Word16) .. 5])) = [1,2,3,4,5]
+    (take 4 ([(1::Word16) .. 1])) = [1]
+    (take 7 ([(1::Word16) .. 0])) = []
+    (take 7 ([(5::Word16) .. 0])) = []
+    (take 7 ([(maxBound-(5::Word16)) .. maxBound])) = [65530,65531,65532,65533,65534,65535]
+    (take 7 ([(minBound+(5::Word16)) .. minBound])) = []
+    (take 7 [(5::Word16),4..1]) = [5,4,3,2,1]
+    (take 7 [(5::Word16),3..1]) = [5,3,1]
+    (take 7 [(5::Word16),3..2]) = [5,3]
+    (take 7 [(1::Word16),2..1]) = [1]
+    (take 7 [(2::Word16),1..2]) = [2]
+    (take 7 [(2::Word16),1..1]) = [2,1]
+    (take 7 [(2::Word16),3..1]) = []
+    (take 7 [x,(x+1)..maxBound]) = [65531,65532,65533,65534,65535]
+    (take 7 [x,(x-1)..minBound]) = [5,4,3,2,1,0]
+Testing Enum Word32:
+    (succ (0::Word32)) = 1
+    (succ (minBound::Word32)) = 1
+    (succ (maxBound::Word32)) = error "Enum.succ{Word32}: tried to take `succ' of maxBound"
+    pred (1::Word32) = 0
+    pred (maxBound::Word32) = 4294967294
+    pred (minBound::Word32) = error "Enum.pred{Word32}: tried to take `pred' of minBound"
+    (map (toEnum::Int->Word32) [1, fromIntegral (minBound::Word32)::Int, fromIntegral (maxBound::Int32)::Int]) = [1,0,2147483647]
+    (toEnum (maxBound::Int))::Word32 = error "Enum.toEnum{Word32}: tag (9223372036854775807) is outside of bounds (0,4294967295)"
+    (map fromEnum [(1::Word32),minBound,fromIntegral (maxBound::Int)]) = [1,0,4294967295]
+    fromEnum (maxBound::Word32) = 4294967295
+    (take 7 [(1::Word32)..]) = [1,2,3,4,5,6,7]
+    (take 7 [((maxBound::Word32)-5)..]) = [4294967290,4294967291,4294967292,4294967293,4294967294,4294967295]
+    (take 7 [(1::Word32),2..]) = [1,2,3,4,5,6,7]
+    (take 7 [(1::Word32),7..]) = [1,7,13,19,25,31,37]
+    (take 7 [(1::Word32),1..]) = [1,1,1,1,1,1,1]
+    (take 7 [(1::Word32),0..]) = [1,0]
+    (take 7 [(5::Word32),2..]) = [5,2]
+    (take 7 [x, x-1 ..]) = [1,0]
+    (take 7 [x, x-1 ..]) = [5,4,3,2,1,0]
+    (take 7 [x, (x+1) ..]) = [4294967290,4294967291,4294967292,4294967293,4294967294,4294967295]
+    (take 7 ([(1::Word32) .. 5])) = [1,2,3,4,5]
+    (take 4 ([(1::Word32) .. 1])) = [1]
+    (take 7 ([(1::Word32) .. 0])) = []
+    (take 7 ([(5::Word32) .. 0])) = []
+    (take 7 ([(maxBound-(5::Word32)) .. maxBound])) = [4294967290,4294967291,4294967292,4294967293,4294967294,4294967295]
+    (take 7 ([(minBound+(5::Word32)) .. minBound])) = []
+    (take 7 [(5::Word32),4..1]) = [5,4,3,2,1]
+    (take 7 [(5::Word32),3..1]) = [5,3,1]
+    (take 7 [(5::Word32),3..2]) = [5,3]
+    (take 7 [(1::Word32),2..1]) = [1]
+    (take 7 [(2::Word32),1..2]) = [2]
+    (take 7 [(2::Word32),1..1]) = [2,1]
+    (take 7 [(2::Word32),3..1]) = []
+    (take 7 [x,(x+1)..maxBound]) = [4294967291,4294967292,4294967293,4294967294,4294967295]
+    (take 7 [x,(x-1)..minBound]) = [5,4,3,2,1,0]
+Testing Enum Word64:
+    (succ (0::Word64)) = 1
+    (succ (minBound::Word64)) = 1
+    (succ (maxBound::Word64)) = error "Enum.succ{Word64}: tried to take `succ' of maxBound"
+    pred (1::Word64) = 0
+    pred (maxBound::Word64) = 18446744073709551614
+    pred (minBound::Word64) = error "Enum.pred{Word64}: tried to take `pred' of minBound"
+    (map (toEnum::Int->Word64) [1, fromIntegral (minBound::Word64)::Int, maxBound::Int]) = [1,0,9223372036854775807]
+    (toEnum (maxBound::Int))::Word64 = 9223372036854775807
+    (map fromEnum [(1::Word64),minBound,fromIntegral (maxBound::Int)]) = [1,0,9223372036854775807]
+    fromEnum (maxBound::Word64) = error "Enum.fromEnum{Word64}: value (18446744073709551615) is outside of Int's bounds (-9223372036854775808,9223372036854775807)"
+    (take 7 [(1::Word64)..]) = [1,2,3,4,5,6,7]
+    (take 7 [((maxBound::Word64)-5)..]) = [18446744073709551610,18446744073709551611,18446744073709551612,18446744073709551613,18446744073709551614,18446744073709551615]
+    (take 7 [(1::Word64),2..]) = [1,2,3,4,5,6,7]
+    (take 7 [(1::Word64),7..]) = [1,7,13,19,25,31,37]
+    (take 7 [(1::Word64),1..]) = [1,1,1,1,1,1,1]
+    (take 7 [(1::Word64),0..]) = [1,0]
+    (take 7 [(5::Word64),2..]) = [5,2]
+    (take 7 [x, x-1 ..]) = [1,0]
+    (take 7 [x, x-1 ..]) = [5,4,3,2,1,0]
+    (take 7 [x, (x+1) ..]) = [18446744073709551610,18446744073709551611,18446744073709551612,18446744073709551613,18446744073709551614,18446744073709551615]
+    (take 7 ([(1::Word64) .. 5])) = [1,2,3,4,5]
+    (take 4 ([(1::Word64) .. 1])) = [1]
+    (take 7 ([(1::Word64) .. 0])) = []
+    (take 7 ([(5::Word64) .. 0])) = []
+    (take 7 ([(maxBound-(5::Word64)) .. maxBound])) = [18446744073709551610,18446744073709551611,18446744073709551612,18446744073709551613,18446744073709551614,18446744073709551615]
+    (take 7 ([(minBound+(5::Word64)) .. minBound])) = []
+    (take 7 [(5::Word64),4..1]) = [5,4,3,2,1]
+    (take 7 [(5::Word64),3..1]) = [5,3,1]
+    (take 7 [(5::Word64),3..2]) = [5,3]
+    (take 7 [(1::Word64),2..1]) = [1]
+    (take 7 [(2::Word64),1..2]) = [2]
+    (take 7 [(2::Word64),1..1]) = [2,1]
+    (take 7 [(2::Word64),3..1]) = []
+    (take 7 [x,(x+1)..maxBound]) = [18446744073709551611,18446744073709551612,18446744073709551613,18446744073709551614,18446744073709551615]
+    (take 7 [x,(x-1)..minBound]) = [5,4,3,2,1,0]
diff --git a/libraries/base/tests/enum03.stdout-x86_64-unknown-openbsd b/libraries/base/tests/enum03.stdout-x86_64-unknown-openbsd
new file mode 100644
index 000000000000..716782c46ad7
--- /dev/null
+++ b/libraries/base/tests/enum03.stdout-x86_64-unknown-openbsd
@@ -0,0 +1,142 @@
+Testing Enum Word8:
+    (succ (0::Word8)) = 1
+    (succ (minBound::Word8)) = 1
+    (succ (maxBound::Word8)) = error "Enum.succ{Word8}: tried to take `succ' of maxBound"
+    pred (1::Word8) = 0
+    pred (maxBound::Word8) = 254
+    pred (minBound::Word8) = error "Enum.pred{Word8}: tried to take `pred' of minBound"
+    (map (toEnum::Int->Word8) [1, fromIntegral (minBound::Word8)::Int, fromIntegral (maxBound::Word8)::Int]) = [1,0,255]
+    (toEnum (maxBound::Int))::Word8 = error "Enum.toEnum{Word8}: tag (9223372036854775807) is outside of bounds (0,255)"
+    (map fromEnum [(1::Word8),minBound,maxBound]) = [1,0,255]
+    (take 7 [(1::Word8)..]) = [1,2,3,4,5,6,7]
+    (take 7 [((maxBound::Word8)-5)..]) = [250,251,252,253,254,255]
+    (take 7 [(1::Word8),2..]) = [1,2,3,4,5,6,7]
+    (take 7 [(1::Word8),7..]) = [1,7,13,19,25,31,37]
+    (take 7 [(1::Word8),1..]) = [1,1,1,1,1,1,1]
+    (take 7 [(1::Word8),0..]) = [1,0]
+    (take 7 [(5::Word8),2..]) = [5,2]
+    (take 7 [x, x-1 ..]) = [1,0]
+    (take 7 [x, x-1 ..]) = [5,4,3,2,1,0]
+    (take 7 [x, (x+1) ..]) = [250,251,252,253,254,255]
+    (take 7 ([(1::Word8) .. 5])) = [1,2,3,4,5]
+    (take 4 ([(1::Word8) .. 1])) = [1]
+    (take 7 ([(1::Word8) .. 0])) = []
+    (take 7 ([(5::Word8) .. 0])) = []
+    (take 7 ([(maxBound-(5::Word8)) .. maxBound])) = [250,251,252,253,254,255]
+    (take 7 ([(minBound+(5::Word8)) .. minBound])) = []
+    (take 7 [(5::Word8),4..1]) = [5,4,3,2,1]
+    (take 7 [(5::Word8),3..1]) = [5,3,1]
+    (take 7 [(5::Word8),3..2]) = [5,3]
+    (take 7 [(1::Word8),2..1]) = [1]
+    (take 7 [(2::Word8),1..2]) = [2]
+    (take 7 [(2::Word8),1..1]) = [2,1]
+    (take 7 [(2::Word8),3..1]) = []
+    (take 7 [x,(x+1)..maxBound]) = [251,252,253,254,255]
+    (take 7 [x,(x-1)..minBound]) = [5,4,3,2,1,0]
+Testing Enum Word16:
+    (succ (0::Word16)) = 1
+    (succ (minBound::Word16)) = 1
+    (succ (maxBound::Word16)) = error "Enum.succ{Word16}: tried to take `succ' of maxBound"
+    pred (1::Word16) = 0
+    pred (maxBound::Word16) = 65534
+    pred (minBound::Word16) = error "Enum.pred{Word16}: tried to take `pred' of minBound"
+    (map (toEnum::Int->Word16) [1, fromIntegral (minBound::Word16)::Int, fromIntegral (maxBound::Word16)::Int]) = [1,0,65535]
+    (toEnum (maxBound::Int))::Word16 = error "Enum.toEnum{Word16}: tag (9223372036854775807) is outside of bounds (0,65535)"
+    (map fromEnum [(1::Word16),minBound,maxBound]) = [1,0,65535]
+    (take 7 [(1::Word16)..]) = [1,2,3,4,5,6,7]
+    (take 7 [((maxBound::Word16)-5)..]) = [65530,65531,65532,65533,65534,65535]
+    (take 7 [(1::Word16),2..]) = [1,2,3,4,5,6,7]
+    (take 7 [(1::Word16),7..]) = [1,7,13,19,25,31,37]
+    (take 7 [(1::Word16),1..]) = [1,1,1,1,1,1,1]
+    (take 7 [(1::Word16),0..]) = [1,0]
+    (take 7 [(5::Word16),2..]) = [5,2]
+    (take 7 [x, x-1 ..]) = [1,0]
+    (take 7 [x, x-1 ..]) = [5,4,3,2,1,0]
+    (take 7 [x, (x+1) ..]) = [65530,65531,65532,65533,65534,65535]
+    (take 7 ([(1::Word16) .. 5])) = [1,2,3,4,5]
+    (take 4 ([(1::Word16) .. 1])) = [1]
+    (take 7 ([(1::Word16) .. 0])) = []
+    (take 7 ([(5::Word16) .. 0])) = []
+    (take 7 ([(maxBound-(5::Word16)) .. maxBound])) = [65530,65531,65532,65533,65534,65535]
+    (take 7 ([(minBound+(5::Word16)) .. minBound])) = []
+    (take 7 [(5::Word16),4..1]) = [5,4,3,2,1]
+    (take 7 [(5::Word16),3..1]) = [5,3,1]
+    (take 7 [(5::Word16),3..2]) = [5,3]
+    (take 7 [(1::Word16),2..1]) = [1]
+    (take 7 [(2::Word16),1..2]) = [2]
+    (take 7 [(2::Word16),1..1]) = [2,1]
+    (take 7 [(2::Word16),3..1]) = []
+    (take 7 [x,(x+1)..maxBound]) = [65531,65532,65533,65534,65535]
+    (take 7 [x,(x-1)..minBound]) = [5,4,3,2,1,0]
+Testing Enum Word32:
+    (succ (0::Word32)) = 1
+    (succ (minBound::Word32)) = 1
+    (succ (maxBound::Word32)) = error "Enum.succ{Word32}: tried to take `succ' of maxBound"
+    pred (1::Word32) = 0
+    pred (maxBound::Word32) = 4294967294
+    pred (minBound::Word32) = error "Enum.pred{Word32}: tried to take `pred' of minBound"
+    (map (toEnum::Int->Word32) [1, fromIntegral (minBound::Word32)::Int, fromIntegral (maxBound::Int32)::Int]) = [1,0,2147483647]
+    (toEnum (maxBound::Int))::Word32 = error "Enum.toEnum{Word32}: tag (9223372036854775807) is outside of bounds (0,4294967295)"
+    (map fromEnum [(1::Word32),minBound,fromIntegral (maxBound::Int)]) = [1,0,4294967295]
+    fromEnum (maxBound::Word32) = 4294967295
+    (take 7 [(1::Word32)..]) = [1,2,3,4,5,6,7]
+    (take 7 [((maxBound::Word32)-5)..]) = [4294967290,4294967291,4294967292,4294967293,4294967294,4294967295]
+    (take 7 [(1::Word32),2..]) = [1,2,3,4,5,6,7]
+    (take 7 [(1::Word32),7..]) = [1,7,13,19,25,31,37]
+    (take 7 [(1::Word32),1..]) = [1,1,1,1,1,1,1]
+    (take 7 [(1::Word32),0..]) = [1,0]
+    (take 7 [(5::Word32),2..]) = [5,2]
+    (take 7 [x, x-1 ..]) = [1,0]
+    (take 7 [x, x-1 ..]) = [5,4,3,2,1,0]
+    (take 7 [x, (x+1) ..]) = [4294967290,4294967291,4294967292,4294967293,4294967294,4294967295]
+    (take 7 ([(1::Word32) .. 5])) = [1,2,3,4,5]
+    (take 4 ([(1::Word32) .. 1])) = [1]
+    (take 7 ([(1::Word32) .. 0])) = []
+    (take 7 ([(5::Word32) .. 0])) = []
+    (take 7 ([(maxBound-(5::Word32)) .. maxBound])) = [4294967290,4294967291,4294967292,4294967293,4294967294,4294967295]
+    (take 7 ([(minBound+(5::Word32)) .. minBound])) = []
+    (take 7 [(5::Word32),4..1]) = [5,4,3,2,1]
+    (take 7 [(5::Word32),3..1]) = [5,3,1]
+    (take 7 [(5::Word32),3..2]) = [5,3]
+    (take 7 [(1::Word32),2..1]) = [1]
+    (take 7 [(2::Word32),1..2]) = [2]
+    (take 7 [(2::Word32),1..1]) = [2,1]
+    (take 7 [(2::Word32),3..1]) = []
+    (take 7 [x,(x+1)..maxBound]) = [4294967291,4294967292,4294967293,4294967294,4294967295]
+    (take 7 [x,(x-1)..minBound]) = [5,4,3,2,1,0]
+Testing Enum Word64:
+    (succ (0::Word64)) = 1
+    (succ (minBound::Word64)) = 1
+    (succ (maxBound::Word64)) = error "Enum.succ{Word64}: tried to take `succ' of maxBound"
+    pred (1::Word64) = 0
+    pred (maxBound::Word64) = 18446744073709551614
+    pred (minBound::Word64) = error "Enum.pred{Word64}: tried to take `pred' of minBound"
+    (map (toEnum::Int->Word64) [1, fromIntegral (minBound::Word64)::Int, maxBound::Int]) = [1,0,9223372036854775807]
+    (toEnum (maxBound::Int))::Word64 = 9223372036854775807
+    (map fromEnum [(1::Word64),minBound,fromIntegral (maxBound::Int)]) = [1,0,9223372036854775807]
+    fromEnum (maxBound::Word64) = error "Enum.fromEnum{Word64}: value (18446744073709551615) is outside of Int's bounds (-9223372036854775808,9223372036854775807)"
+    (take 7 [(1::Word64)..]) = [1,2,3,4,5,6,7]
+    (take 7 [((maxBound::Word64)-5)..]) = [18446744073709551610,18446744073709551611,18446744073709551612,18446744073709551613,18446744073709551614,18446744073709551615]
+    (take 7 [(1::Word64),2..]) = [1,2,3,4,5,6,7]
+    (take 7 [(1::Word64),7..]) = [1,7,13,19,25,31,37]
+    (take 7 [(1::Word64),1..]) = [1,1,1,1,1,1,1]
+    (take 7 [(1::Word64),0..]) = [1,0]
+    (take 7 [(5::Word64),2..]) = [5,2]
+    (take 7 [x, x-1 ..]) = [1,0]
+    (take 7 [x, x-1 ..]) = [5,4,3,2,1,0]
+    (take 7 [x, (x+1) ..]) = [18446744073709551610,18446744073709551611,18446744073709551612,18446744073709551613,18446744073709551614,18446744073709551615]
+    (take 7 ([(1::Word64) .. 5])) = [1,2,3,4,5]
+    (take 4 ([(1::Word64) .. 1])) = [1]
+    (take 7 ([(1::Word64) .. 0])) = []
+    (take 7 ([(5::Word64) .. 0])) = []
+    (take 7 ([(maxBound-(5::Word64)) .. maxBound])) = [18446744073709551610,18446744073709551611,18446744073709551612,18446744073709551613,18446744073709551614,18446744073709551615]
+    (take 7 ([(minBound+(5::Word64)) .. minBound])) = []
+    (take 7 [(5::Word64),4..1]) = [5,4,3,2,1]
+    (take 7 [(5::Word64),3..1]) = [5,3,1]
+    (take 7 [(5::Word64),3..2]) = [5,3]
+    (take 7 [(1::Word64),2..1]) = [1]
+    (take 7 [(2::Word64),1..2]) = [2]
+    (take 7 [(2::Word64),1..1]) = [2,1]
+    (take 7 [(2::Word64),3..1]) = []
+    (take 7 [x,(x+1)..maxBound]) = [18446744073709551611,18446744073709551612,18446744073709551613,18446744073709551614,18446744073709551615]
+    (take 7 [x,(x-1)..minBound]) = [5,4,3,2,1,0]
diff --git a/libraries/base/tests/enum04.hs b/libraries/base/tests/enum04.hs
new file mode 100644
index 000000000000..8120a5bb21a5
--- /dev/null
+++ b/libraries/base/tests/enum04.hs
@@ -0,0 +1,14 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+import Control.Exception
+
+-- enumFrom on basic numeric types should be strict
+-- (possibly a bug in the Haskell Report: it specifies that
+-- these ops should be strict in the section on Enum, but the
+-- sample code in the Prelude doesn't agree, at least for
+-- Float and Double).
+
+main = do 
+  catch	(evaluate [error "" :: Int ..] >> return ())     (\(e::SomeException) -> putStrLn "ok1")
+  catch	(evaluate [error "" :: Integer ..] >> return ()) (\(e::SomeException) -> putStrLn "ok2")
+  catch	(evaluate [error "" :: Float ..] >> return ())   (\(e::SomeException) -> putStrLn "ok3")
+  catch	(evaluate [error "" :: Double ..] >> return ())  (\(e::SomeException) -> putStrLn "ok4")
diff --git a/libraries/base/tests/enum04.stdout b/libraries/base/tests/enum04.stdout
new file mode 100644
index 000000000000..c8a3e21e6de3
--- /dev/null
+++ b/libraries/base/tests/enum04.stdout
@@ -0,0 +1,4 @@
+ok1
+ok2
+ok3
+ok4
diff --git a/libraries/base/tests/enumDouble.hs b/libraries/base/tests/enumDouble.hs
new file mode 100644
index 000000000000..458607da7598
--- /dev/null
+++ b/libraries/base/tests/enumDouble.hs
@@ -0,0 +1,3 @@
+
+main :: IO ()
+main = print (succ (1.0e20 :: Double))
diff --git a/libraries/base/tests/enumDouble.stdout b/libraries/base/tests/enumDouble.stdout
new file mode 100644
index 000000000000..a5093aa08868
--- /dev/null
+++ b/libraries/base/tests/enumDouble.stdout
@@ -0,0 +1 @@
+1.0e20
diff --git a/libraries/base/tests/enumRatio.hs b/libraries/base/tests/enumRatio.hs
new file mode 100644
index 000000000000..79b733ebedbc
--- /dev/null
+++ b/libraries/base/tests/enumRatio.hs
@@ -0,0 +1,3 @@
+
+import Data.Ratio
+main = print [ 1, 4%(3::Int) .. 1 ]
diff --git a/libraries/base/tests/enumRatio.stdout b/libraries/base/tests/enumRatio.stdout
new file mode 100644
index 000000000000..0d5cbafde62d
--- /dev/null
+++ b/libraries/base/tests/enumRatio.stdout
@@ -0,0 +1 @@
+[1 % 1]
diff --git a/libraries/base/tests/exceptionsrun001.hs b/libraries/base/tests/exceptionsrun001.hs
new file mode 100644
index 000000000000..46ab9fa6cc48
--- /dev/null
+++ b/libraries/base/tests/exceptionsrun001.hs
@@ -0,0 +1,46 @@
+module Main where
+
+import Control.Exception
+import System.IO.Error
+
+main = do
+  ioTest
+  errorTest
+  noMethodTest
+  patMatchTest
+  guardTest
+
+ioTest :: IO ()
+ioTest = catchJust (\e -> if isUserError e then Just () else Nothing)
+                   (ioError (userError "wibble"))
+                   (\() -> putStrLn "user exception caught")
+
+errorTest :: IO ()
+errorTest = do r <- try (evaluate (1 + error "call to 'error'"))
+               case r of
+                   Left (ErrorCall _) -> putStrLn "error call caught"
+                   Right _            -> error "help!"
+
+instance (Show a, Eq a) => Num (Maybe a) where {}
+
+noMethodTest :: IO ()
+noMethodTest = do r <- try (evaluate (Just () + Just ()))
+                  case r of
+                      Left (NoMethodError err) -> putStrLn "no method error"
+                      Right _                  -> error "help!"
+
+patMatchTest :: IO ()
+patMatchTest = catch (case test1 [1..10] of () -> return ())
+  (\ex -> case ex of
+          PatternMatchFail err -> putStr err
+          _                    -> error "help!")
+
+test1 [] = ()
+
+guardTest = catch (case test2 of () -> return ())
+                  (\ex -> case ex of
+                          PatternMatchFail err -> putStr err
+                          _                    -> error "help!")
+
+test2 | all (==0) [1] = ()
+
diff --git a/libraries/base/tests/exceptionsrun001.stdout b/libraries/base/tests/exceptionsrun001.stdout
new file mode 100644
index 000000000000..4c3fa006b19a
--- /dev/null
+++ b/libraries/base/tests/exceptionsrun001.stdout
@@ -0,0 +1,5 @@
+user exception caught
+error call caught
+no method error
+exceptionsrun001.hs:38:1-13: Non-exhaustive patterns in function test1
+exceptionsrun001.hs:45:1-26: Non-exhaustive patterns in function test2
diff --git a/libraries/base/tests/exceptionsrun002.hs b/libraries/base/tests/exceptionsrun002.hs
new file mode 100644
index 000000000000..0dae46117d03
--- /dev/null
+++ b/libraries/base/tests/exceptionsrun002.hs
@@ -0,0 +1,95 @@
+module Main where
+
+import qualified Control.Exception as Exception
+import System.IO.Error (mkIOError, catchIOError)
+import Data.IORef
+
+safeCatch :: IO () -> IO ()
+safeCatch f = Exception.catch f
+                  ((\_ -> return ()) :: Exception.SomeException -> IO ())
+
+type Thrower = IO Bool
+
+type Catcher = IO Bool -> IO () -> IO ()
+
+checkCatch :: Catcher -> Thrower -> IO Bool
+checkCatch catcher thrower = do
+    ref <- newIORef False
+    safeCatch (catcher thrower (writeIORef ref True))
+    readIORef ref
+
+data Named a = MkNamed String a
+
+checkNamedCatch :: Named Catcher -> Named Thrower -> IO ()
+checkNamedCatch (MkNamed cname catcher) (MkNamed tname thrower) = do
+    didCatch <- checkCatch catcher thrower
+    putStrLn (cname ++ (if didCatch then " CAUGHT " else " MISSED ") ++ tname)
+
+checkNamedCatches :: [Named Catcher] -> [Named Thrower] -> IO ()
+checkNamedCatches []     _      = return ()
+checkNamedCatches _      []     = return ()
+checkNamedCatches [c]    (t:tr) = do checkNamedCatch c t
+                                     checkNamedCatches [c] tr
+checkNamedCatches (c:cr) ts     = do checkNamedCatches [c] ts
+                                     checkNamedCatches cr ts
+
+
+-- throwers
+
+returnThrower :: Named Thrower
+returnThrower = MkNamed "return" (return True)
+
+returnUndefinedThrower :: Named Thrower
+returnUndefinedThrower = MkNamed "return undefined" (return undefined)
+
+returnErrorThrower :: Named Thrower
+returnErrorThrower = MkNamed "return error" (return (error "some error"))
+
+undefinedThrower :: Named Thrower
+undefinedThrower = MkNamed "undefined" undefined
+
+failThrower :: Named Thrower
+failThrower = MkNamed "fail" (fail "some failure")
+
+errorThrower :: Named Thrower
+errorThrower = MkNamed "error" (error "some error")
+
+throwThrower :: Named Thrower
+throwThrower = MkNamed "Exception.throw"
+ (Exception.throw (Exception.ErrorCall "throw error"))
+
+ioErrorErrorCallThrower :: Named Thrower
+ioErrorErrorCallThrower = MkNamed "ioError ErrorCall"
+ (Exception.throwIO (Exception.ErrorCall "throw error"))
+
+ioErrorIOExceptionThrower :: Named Thrower
+ioErrorIOExceptionThrower = MkNamed "ioError IOException"
+ (Exception.throwIO (mkIOError undefined undefined undefined undefined))
+
+returnThrowThrower :: Named Thrower
+returnThrowThrower = MkNamed "return Exception.throw"
+ (return (Exception.throw (Exception.ErrorCall "throw error")))
+
+
+-- catchers
+
+bindCatcher :: Named Catcher
+bindCatcher = MkNamed ">>" (>>)
+
+preludeCatchCatcher :: Named Catcher
+preludeCatchCatcher = MkNamed "Prelude.catch"
+ (\f cc -> catchIOError (f >> (return ())) (const cc))
+
+ceCatchCatcher :: Named Catcher
+ceCatchCatcher = MkNamed "Exception.catch"
+ (\f cc -> Exception.catch (f >> (return ())) (const cc :: Exception.SomeException -> IO ()))
+
+finallyCatcher :: Named Catcher
+finallyCatcher = MkNamed "Exception.finally"
+ (\f cc -> Exception.finally (f >> (return ())) cc)
+
+main = checkNamedCatches
+        [bindCatcher,preludeCatchCatcher,ceCatchCatcher,finallyCatcher]
+        [returnThrower,returnUndefinedThrower,returnThrowThrower,returnErrorThrower,failThrower,
+        errorThrower,throwThrower,ioErrorErrorCallThrower,ioErrorIOExceptionThrower,undefinedThrower]
+
diff --git a/libraries/base/tests/exceptionsrun002.stdout b/libraries/base/tests/exceptionsrun002.stdout
new file mode 100644
index 000000000000..e15116f5c0ad
--- /dev/null
+++ b/libraries/base/tests/exceptionsrun002.stdout
@@ -0,0 +1,40 @@
+>> CAUGHT return
+>> CAUGHT return undefined
+>> CAUGHT return Exception.throw
+>> CAUGHT return error
+>> MISSED fail
+>> MISSED error
+>> MISSED Exception.throw
+>> MISSED ioError ErrorCall
+>> MISSED ioError IOException
+>> MISSED undefined
+Prelude.catch MISSED return
+Prelude.catch MISSED return undefined
+Prelude.catch MISSED return Exception.throw
+Prelude.catch MISSED return error
+Prelude.catch CAUGHT fail
+Prelude.catch MISSED error
+Prelude.catch MISSED Exception.throw
+Prelude.catch MISSED ioError ErrorCall
+Prelude.catch CAUGHT ioError IOException
+Prelude.catch MISSED undefined
+Exception.catch MISSED return
+Exception.catch MISSED return undefined
+Exception.catch MISSED return Exception.throw
+Exception.catch MISSED return error
+Exception.catch CAUGHT fail
+Exception.catch CAUGHT error
+Exception.catch CAUGHT Exception.throw
+Exception.catch CAUGHT ioError ErrorCall
+Exception.catch CAUGHT ioError IOException
+Exception.catch CAUGHT undefined
+Exception.finally CAUGHT return
+Exception.finally CAUGHT return undefined
+Exception.finally CAUGHT return Exception.throw
+Exception.finally CAUGHT return error
+Exception.finally CAUGHT fail
+Exception.finally CAUGHT error
+Exception.finally CAUGHT Exception.throw
+Exception.finally CAUGHT ioError ErrorCall
+Exception.finally CAUGHT ioError IOException
+Exception.finally CAUGHT undefined
diff --git a/libraries/base/tests/fixed.hs b/libraries/base/tests/fixed.hs
new file mode 100644
index 000000000000..d19bda0b926c
--- /dev/null
+++ b/libraries/base/tests/fixed.hs
@@ -0,0 +1,19 @@
+{-# OPTIONS_GHC -Wall -Werror #-}
+
+module Main where
+
+import Data.Fixed
+
+nums :: Fractional a => [a]
+nums = [0,7,7.1,7.01,7.9,7.09,5 + 7,3.2 - 7.8,5.75 * (-2)]
+
+main :: IO ()
+main = do mapM_ putStrLn $ doit (nums :: [Micro])
+          mapM_ putStrLn $ doit (nums :: [Pico])
+
+doit :: HasResolution a => [Fixed a] -> [String]
+doit xs = [ showFun (signFun x)
+          | showFun <- [show, showFixed True]
+          , signFun <- [id, negate]
+          , x <- xs ]
+
diff --git a/libraries/base/tests/fixed.stdout b/libraries/base/tests/fixed.stdout
new file mode 100644
index 000000000000..3c4296523c7e
--- /dev/null
+++ b/libraries/base/tests/fixed.stdout
@@ -0,0 +1,72 @@
+0.000000
+7.000000
+7.100000
+7.010000
+7.900000
+7.090000
+12.000000
+-4.600000
+-11.500000
+0.000000
+-7.000000
+-7.100000
+-7.010000
+-7.900000
+-7.090000
+-12.000000
+4.600000
+11.500000
+0
+7
+7.1
+7.01
+7.9
+7.09
+12
+-4.6
+-11.5
+0
+-7
+-7.1
+-7.01
+-7.9
+-7.09
+-12
+4.6
+11.5
+0.000000000000
+7.000000000000
+7.100000000000
+7.010000000000
+7.900000000000
+7.090000000000
+12.000000000000
+-4.600000000000
+-11.500000000000
+0.000000000000
+-7.000000000000
+-7.100000000000
+-7.010000000000
+-7.900000000000
+-7.090000000000
+-12.000000000000
+4.600000000000
+11.500000000000
+0
+7
+7.1
+7.01
+7.9
+7.09
+12
+-4.6
+-11.5
+0
+-7
+-7.1
+-7.01
+-7.9
+-7.09
+-12
+4.6
+11.5
diff --git a/libraries/base/tests/genericNegative001.hs b/libraries/base/tests/genericNegative001.hs
new file mode 100644
index 000000000000..7fb8192557a6
--- /dev/null
+++ b/libraries/base/tests/genericNegative001.hs
@@ -0,0 +1,8 @@
+-- Test for http://ghc.haskell.org/trac/ghc/ticket/2533
+import System.Environment
+import Data.List
+main = do
+ (n:_) <- getArgs
+ print (genericTake (read n) "none taken")
+ print (genericDrop (read n) "none dropped")
+ print (genericSplitAt (read n) "none split")
diff --git a/libraries/base/tests/genericNegative001.stdout b/libraries/base/tests/genericNegative001.stdout
new file mode 100644
index 000000000000..b8a090716c3d
--- /dev/null
+++ b/libraries/base/tests/genericNegative001.stdout
@@ -0,0 +1,3 @@
+""
+"none dropped"
+("","none split")
diff --git a/libraries/base/tests/hGetBuf002.hs b/libraries/base/tests/hGetBuf002.hs
new file mode 100644
index 000000000000..525eeb8e3697
--- /dev/null
+++ b/libraries/base/tests/hGetBuf002.hs
@@ -0,0 +1,22 @@
+import System.IO
+import Foreign
+import Foreign.C
+
+main = do test True; test False
+
+test blocking = do
+  h <- openBinaryFile "hGetBuf002.hs" ReadMode
+
+  let sz = 42
+      loop = do
+  	 b <- allocaBytes sz $ \ptr -> do
+                r <- (if blocking then hGetBuf else hGetBufNonBlocking) h ptr sz
+         	if (r == 0)
+		   then return True
+		   else do s <- peekCStringLen (ptr,r)
+			   putStr s
+			   return False
+	 if b then return () else loop -- tail call
+
+  loop
+
diff --git a/libraries/base/tests/hGetBuf002.stdout b/libraries/base/tests/hGetBuf002.stdout
new file mode 100644
index 000000000000..9cbe498c5ce4
--- /dev/null
+++ b/libraries/base/tests/hGetBuf002.stdout
@@ -0,0 +1,44 @@
+import System.IO
+import Foreign
+import Foreign.C
+
+main = do test True; test False
+
+test blocking = do
+  h <- openBinaryFile "hGetBuf002.hs" ReadMode
+
+  let sz = 42
+      loop = do
+  	 b <- allocaBytes sz $ \ptr -> do
+                r <- (if blocking then hGetBuf else hGetBufNonBlocking) h ptr sz
+         	if (r == 0)
+		   then return True
+		   else do s <- peekCStringLen (ptr,r)
+			   putStr s
+			   return False
+	 if b then return () else loop -- tail call
+
+  loop
+
+import System.IO
+import Foreign
+import Foreign.C
+
+main = do test True; test False
+
+test blocking = do
+  h <- openBinaryFile "hGetBuf002.hs" ReadMode
+
+  let sz = 42
+      loop = do
+  	 b <- allocaBytes sz $ \ptr -> do
+                r <- (if blocking then hGetBuf else hGetBufNonBlocking) h ptr sz
+         	if (r == 0)
+		   then return True
+		   else do s <- peekCStringLen (ptr,r)
+			   putStr s
+			   return False
+	 if b then return () else loop -- tail call
+
+  loop
+
diff --git a/libraries/base/tests/hGetBuf003.hs b/libraries/base/tests/hGetBuf003.hs
new file mode 100644
index 000000000000..6eefdf90e82a
--- /dev/null
+++ b/libraries/base/tests/hGetBuf003.hs
@@ -0,0 +1,26 @@
+import System.IO
+import Foreign
+import Foreign.C
+import Control.Monad
+
+main = do test True; test False
+
+test blocking = do
+  h <- openBinaryFile "hGetBuf003.hs" ReadMode
+
+  let sz = 42
+      loop = do
+         -- mix ordinary char buffering with hGetBuf
+         eof <- hIsEOF h
+         when (not eof) $ hGetChar h >>= putChar
+  	 b <- allocaBytes sz $ \ptr -> do
+                r <- (if blocking then hGetBuf else hGetBufNonBlocking) h ptr sz
+         	if (r == 0)
+		   then return True
+		   else do s <- peekCStringLen (ptr,r)
+			   putStr s
+			   return False
+	 if b then return () else loop -- tail call
+
+  loop
+
diff --git a/libraries/base/tests/hGetBuf003.stdout b/libraries/base/tests/hGetBuf003.stdout
new file mode 100644
index 000000000000..ffeb29156378
--- /dev/null
+++ b/libraries/base/tests/hGetBuf003.stdout
@@ -0,0 +1,52 @@
+import System.IO
+import Foreign
+import Foreign.C
+import Control.Monad
+
+main = do test True; test False
+
+test blocking = do
+  h <- openBinaryFile "hGetBuf003.hs" ReadMode
+
+  let sz = 42
+      loop = do
+         -- mix ordinary char buffering with hGetBuf
+         eof <- hIsEOF h
+         when (not eof) $ hGetChar h >>= putChar
+  	 b <- allocaBytes sz $ \ptr -> do
+                r <- (if blocking then hGetBuf else hGetBufNonBlocking) h ptr sz
+         	if (r == 0)
+		   then return True
+		   else do s <- peekCStringLen (ptr,r)
+			   putStr s
+			   return False
+	 if b then return () else loop -- tail call
+
+  loop
+
+import System.IO
+import Foreign
+import Foreign.C
+import Control.Monad
+
+main = do test True; test False
+
+test blocking = do
+  h <- openBinaryFile "hGetBuf003.hs" ReadMode
+
+  let sz = 42
+      loop = do
+         -- mix ordinary char buffering with hGetBuf
+         eof <- hIsEOF h
+         when (not eof) $ hGetChar h >>= putChar
+  	 b <- allocaBytes sz $ \ptr -> do
+                r <- (if blocking then hGetBuf else hGetBufNonBlocking) h ptr sz
+         	if (r == 0)
+		   then return True
+		   else do s <- peekCStringLen (ptr,r)
+			   putStr s
+			   return False
+	 if b then return () else loop -- tail call
+
+  loop
+
diff --git a/libraries/base/tests/hPutBuf001.hs b/libraries/base/tests/hPutBuf001.hs
new file mode 100644
index 000000000000..fa7e076d4198
--- /dev/null
+++ b/libraries/base/tests/hPutBuf001.hs
@@ -0,0 +1,7 @@
+import System.IO
+import Foreign
+import Foreign.C
+
+main = do
+  hSetBinaryMode stdout True
+  withCStringLen "hello world\n" $ \(ptr,len) -> hPutBuf stdout ptr len
diff --git a/libraries/base/tests/hPutBuf001.stdout b/libraries/base/tests/hPutBuf001.stdout
new file mode 100644
index 000000000000..3b18e512dba7
--- /dev/null
+++ b/libraries/base/tests/hPutBuf001.stdout
@@ -0,0 +1 @@
+hello world
diff --git a/libraries/base/tests/hPutBuf002.hs b/libraries/base/tests/hPutBuf002.hs
new file mode 100644
index 000000000000..a7ea2eed0355
--- /dev/null
+++ b/libraries/base/tests/hPutBuf002.hs
@@ -0,0 +1,9 @@
+import System.IO
+import Foreign
+import Foreign.C
+
+-- !!! this test failed to write anything in GHC 5.00.2
+main = do
+  h <- openBinaryFile "hPutBuf002.out" ReadWriteMode
+  withCStringLen "hello world\n" $ \(ptr,len) -> hPutBuf h ptr len
+  hFileSize h >>= print
diff --git a/libraries/base/tests/hPutBuf002.stdout b/libraries/base/tests/hPutBuf002.stdout
new file mode 100644
index 000000000000..48082f72f087
--- /dev/null
+++ b/libraries/base/tests/hPutBuf002.stdout
@@ -0,0 +1 @@
+12
diff --git a/libraries/base/tests/hTell001.hs b/libraries/base/tests/hTell001.hs
new file mode 100644
index 000000000000..6b26eecb9720
--- /dev/null
+++ b/libraries/base/tests/hTell001.hs
@@ -0,0 +1,63 @@
+-- !!! Testing hGetPosn and hSetPosn
+module Main(main) where
+
+import System.IO
+
+getPosnAndPrint h = do
+  x <- hTell h
+  v <- hGetChar h
+  putStrLn ("At position: " ++ show x ++ ", found: " ++ show v)
+  return x
+
+recordDoAndRepos h a = do
+  x <- getPosnAndPrint h
+  a 
+  hSeek h AbsoluteSeek x
+  getPosnAndPrint h
+  return ()
+
+recordDoAndRepos2 h a = do
+  x <- getPosnAndPrint h
+  a 
+  hSeek h AbsoluteSeek x
+  getPosnAndPrint h
+  return ()
+
+recordDoAndRepos3 h a = do
+  x <- getPosnAndPrint h
+  a 
+  hSeek h SeekFromEnd (negate (x + 1))
+  getPosnAndPrint h
+  return ()
+
+file = "hTell001.hs"
+
+main :: IO ()
+main = do
+  h  <- openBinaryFile file ReadMode
+  recordDoAndRepos h $
+   recordDoAndRepos h $
+    recordDoAndRepos h $
+     recordDoAndRepos h $
+      recordDoAndRepos h $
+       putStrLn ""
+  hClose h
+  putStrLn "\nUsing hSeek/AbsoluteSeek: "
+  h  <- openBinaryFile file ReadMode
+  recordDoAndRepos2 h $
+   recordDoAndRepos2 h $
+    recordDoAndRepos2 h $
+     recordDoAndRepos2 h $
+      recordDoAndRepos2 h $
+       putStrLn ""
+
+  hClose h
+  putStrLn "\nUsing hSeek/SeekFromEnd: "
+  putStrLn "(Don't worry if you're seeing differing numbers here, it might be down to '\\n' vs '\\r\\n')"
+  h  <- openBinaryFile file ReadMode
+  recordDoAndRepos3 h $
+   recordDoAndRepos3 h $
+    recordDoAndRepos3 h $
+     recordDoAndRepos3 h $
+      recordDoAndRepos3 h $
+       putStrLn ""
diff --git a/libraries/base/tests/hTell001.stdout b/libraries/base/tests/hTell001.stdout
new file mode 100644
index 000000000000..7e22e69a9349
--- /dev/null
+++ b/libraries/base/tests/hTell001.stdout
@@ -0,0 +1,38 @@
+At position: 0, found: '-'
+At position: 1, found: '-'
+At position: 2, found: ' '
+At position: 3, found: '!'
+At position: 4, found: '!'
+
+At position: 4, found: '!'
+At position: 3, found: '!'
+At position: 2, found: ' '
+At position: 1, found: '-'
+At position: 0, found: '-'
+
+Using hSeek/AbsoluteSeek: 
+At position: 0, found: '-'
+At position: 1, found: '-'
+At position: 2, found: ' '
+At position: 3, found: '!'
+At position: 4, found: '!'
+
+At position: 4, found: '!'
+At position: 3, found: '!'
+At position: 2, found: ' '
+At position: 1, found: '-'
+At position: 0, found: '-'
+
+Using hSeek/SeekFromEnd: 
+(Don't worry if you're seeing differing numbers here, it might be down to '\n' vs '\r\n')
+At position: 0, found: '-'
+At position: 1, found: '-'
+At position: 2, found: ' '
+At position: 3, found: '!'
+At position: 4, found: '!'
+
+At position: 1376, found: 'n'
+At position: 1377, found: ' '
+At position: 1378, found: '"'
+At position: 1379, found: '"'
+At position: 1380, found: '\n'
diff --git a/libraries/base/tests/hTell002.hs b/libraries/base/tests/hTell002.hs
new file mode 100644
index 000000000000..b790db8fe88b
--- /dev/null
+++ b/libraries/base/tests/hTell002.hs
@@ -0,0 +1,33 @@
+-- !!! Testing hSeek
+module Main(main) where
+
+import System.Directory
+import System.IO
+
+main :: IO ()
+main = do
+  h <- openFile "tst-seek" WriteMode
+  hSetEncoding h utf8 -- hSeek/hTell work with Unicode streams
+  hPutStr h "test string1"
+   -- seek to EOF should be cool..
+  hSeek h SeekFromEnd 0
+  hPutStr h "test string2"
+   -- seek past EOF should now also be cool..
+  hSeek h SeekFromEnd 3
+  hPutStr h "test string3"
+  hSeek h AbsoluteSeek 13
+  hPutStr h "test string4"
+  x <- hTell h
+  print x
+  hSeek h AbsoluteSeek 30
+  x1 <- hTell h
+  hPutStr h "人間虫" -- we should be able to output Unicode too
+  x2 <- hTell h
+  print (x2 - x1)
+  hPutStr h "filler"
+  hClose h
+  h <- openFile "tst-seek" ReadMode
+  hSetEncoding h utf8
+  str <- hGetContents h
+  putStrLn str
+  removeFile "tst-seek"
diff --git a/libraries/base/tests/hTell002.stdout b/libraries/base/tests/hTell002.stdout
new file mode 100644
index 000000000000..52696f8a2c33
Binary files /dev/null and b/libraries/base/tests/hTell002.stdout differ
diff --git a/libraries/base/tests/ioref001.hs b/libraries/base/tests/ioref001.hs
new file mode 100644
index 000000000000..837b82e0c169
--- /dev/null
+++ b/libraries/base/tests/ioref001.hs
@@ -0,0 +1,9 @@
+
+module Main where
+
+import Data.IORef
+
+loop r 0 = return ()
+loop r c = loop r (c-1) >> writeIORef r 42
+
+main = newIORef 0 >>= \r -> loop r 1000000 >> putStrLn "done"
diff --git a/libraries/base/tests/ioref001.stdout b/libraries/base/tests/ioref001.stdout
new file mode 100644
index 000000000000..19f86f493ab1
--- /dev/null
+++ b/libraries/base/tests/ioref001.stdout
@@ -0,0 +1 @@
+done
diff --git a/libraries/base/tests/ix001.hs b/libraries/base/tests/ix001.hs
new file mode 100644
index 000000000000..c723472bce63
--- /dev/null
+++ b/libraries/base/tests/ix001.hs
@@ -0,0 +1,4 @@
+import Data.Ix
+import Data.Int
+
+main = print (index (minBound::Int16,maxBound) maxBound)
diff --git a/libraries/base/tests/ix001.stdout b/libraries/base/tests/ix001.stdout
new file mode 100644
index 000000000000..7a53b35687b2
--- /dev/null
+++ b/libraries/base/tests/ix001.stdout
@@ -0,0 +1 @@
+65535
diff --git a/libraries/base/tests/length001.hs b/libraries/base/tests/length001.hs
new file mode 100644
index 000000000000..321a1b9dfce8
--- /dev/null
+++ b/libraries/base/tests/length001.hs
@@ -0,0 +1,8 @@
+
+module Main (main) where
+
+import Data.List
+
+main :: IO ()
+main = do print (genericLength [1..10000000] :: Int)
+          print (genericLength [1..10000000] :: Integer)
diff --git a/libraries/base/tests/length001.stdout b/libraries/base/tests/length001.stdout
new file mode 100644
index 000000000000..4e65c4e0d23e
--- /dev/null
+++ b/libraries/base/tests/length001.stdout
@@ -0,0 +1,2 @@
+10000000
+10000000
diff --git a/libraries/base/tests/lex001.hs b/libraries/base/tests/lex001.hs
new file mode 100644
index 000000000000..7acb54762a2e
--- /dev/null
+++ b/libraries/base/tests/lex001.hs
@@ -0,0 +1,39 @@
+module Main where
+
+import Text.ParserCombinators.ReadP
+import qualified Text.Read.Lex
+
+testStrings
+ = [    "0x3y",
+        "0X3abx",
+        "0o39y",
+        "0O334z",
+
+        "NaN",
+        "NaNx",
+        "Infinity",
+        "Infinityx",
+
+        "Wibble Foo",
+        "Wibble8_+",
+
+        "34yy",
+        "34.4x",
+        "034.4x",
+        "31.45e-6y",
+        "49.2v",
+        "049.2v",
+        "35e-3x",
+        "035e-3x",
+        "35e+3y",
+        "83.3e-22",
+        "083.3e-22"
+   ]
+
+main = mapM test testStrings
+
+test s = do print s
+            print (lex s)
+            print (readP_to_S Text.Read.Lex.lex s)
+            putStrLn ""
+
diff --git a/libraries/base/tests/lex001.stdout b/libraries/base/tests/lex001.stdout
new file mode 100644
index 000000000000..eafc596a4b7f
--- /dev/null
+++ b/libraries/base/tests/lex001.stdout
@@ -0,0 +1,84 @@
+"0x3y"
+[("0x3","y")]
+[(Number (MkNumber 16 [3]),"y")]
+
+"0X3abx"
+[("0X3ab","x")]
+[(Number (MkNumber 16 [3,10,11]),"x")]
+
+"0o39y"
+[("0o3","9y")]
+[(Number (MkNumber 8 [3]),"9y")]
+
+"0O334z"
+[("0O334","z")]
+[(Number (MkNumber 8 [3,3,4]),"z")]
+
+"NaN"
+[("NaN","")]
+[(Ident "NaN","")]
+
+"NaNx"
+[("NaNx","")]
+[(Ident "NaNx","")]
+
+"Infinity"
+[("Infinity","")]
+[(Ident "Infinity","")]
+
+"Infinityx"
+[("Infinityx","")]
+[(Ident "Infinityx","")]
+
+"Wibble Foo"
+[("Wibble"," Foo")]
+[(Ident "Wibble"," Foo")]
+
+"Wibble8_+"
+[("Wibble8_","+")]
+[(Ident "Wibble8_","+")]
+
+"34yy"
+[("34","yy")]
+[(Number (MkDecimal [3,4] Nothing Nothing),"yy")]
+
+"34.4x"
+[("34.4","x")]
+[(Number (MkDecimal [3,4] (Just [4]) Nothing),"x")]
+
+"034.4x"
+[("034.4","x")]
+[(Number (MkDecimal [0,3,4] (Just [4]) Nothing),"x")]
+
+"31.45e-6y"
+[("31.45e-6","y")]
+[(Number (MkDecimal [3,1] (Just [4,5]) (Just (-6))),"y")]
+
+"49.2v"
+[("49.2","v")]
+[(Number (MkDecimal [4,9] (Just [2]) Nothing),"v")]
+
+"049.2v"
+[("049.2","v")]
+[(Number (MkDecimal [0,4,9] (Just [2]) Nothing),"v")]
+
+"35e-3x"
+[("35e-3","x")]
+[(Number (MkDecimal [3,5] Nothing (Just (-3))),"x")]
+
+"035e-3x"
+[("035e-3","x")]
+[(Number (MkDecimal [0,3,5] Nothing (Just (-3))),"x")]
+
+"35e+3y"
+[("35e+3","y")]
+[(Number (MkDecimal [3,5] Nothing (Just 3)),"y")]
+
+"83.3e-22"
+[("83.3e-22","")]
+[(Number (MkDecimal [8,3] (Just [3]) (Just (-22))),"")]
+
+"083.3e-22"
+[("083.3e-22","")]
+[(Number (MkDecimal [0,8,3] (Just [3]) (Just (-22))),"")]
+
diff --git a/libraries/base/tests/list001.hs b/libraries/base/tests/list001.hs
new file mode 100644
index 000000000000..cec5f9940ead
--- /dev/null
+++ b/libraries/base/tests/list001.hs
@@ -0,0 +1,155 @@
+{-# LANGUAGE CPP #-}
+module Main where
+
+import Data.List
+import Control.Exception
+#if __GLASGOW_HASKELL__ < 705
+import Prelude hiding (catch)
+#endif
+
+-- This module briefly tests all the functions in PrelList and a few
+-- from List.
+
+-- ToDo: test strictness properties.
+
+main = do
+
+  -- head
+  print (head [1,2,3,4], head "a")
+  catch (print (head [] :: String)) (\(ErrorCall _) -> putStr "head []\n")
+
+  -- tail
+  print (tail [1,2,3,4], tail "a")
+  catch (print (tail [] :: String)) (\(ErrorCall _) -> putStr "tail []\n")
+
+  -- init
+  print (init [1,2,3,4], init "a")
+  catch (print (init [] :: String)) (\(ErrorCall _) -> putStr "init []\n")
+
+  -- last
+  print (last [1,2,3,4], last "a")
+  catch (print (last [] :: String)) (\(ErrorCall _) -> putStr "last []\n")
+
+  -- null
+  print [null [], null "abc"]
+
+  -- length
+  print (length [1..10])
+
+  -- foldl
+  print (foldl  (+) 1 [1..10])
+
+  -- foldl1
+  print (foldl1 (+) [1..10])
+  catch (print (foldl1 (+) [] :: Int)) (\(ErrorCall _) -> putStr "foldl1 []\n")
+
+  -- scanl
+  print (scanl  (+) 1 [1..10])
+
+  -- scanl1
+  print (scanl1 (+) [1..10])
+  print (scanl1 (+) [] :: [Int])
+
+  -- foldr1
+  print (foldr1 (+) [1..10])
+  catch (print (foldr1 (+) [] :: Int)) (\(ErrorCall _) -> putStr "foldr1 []\n")
+
+  -- scanr
+  print (scanr  (+) 1 [1..10])
+
+  -- scanr1
+  print (scanr1 (+) [1..10])
+  print (scanr1 (+) [] :: [Int])
+
+  -- iterate
+  print (take 10 (cycle (take 4 (iterate (+1) 1))))
+
+  -- take
+  print (take 4 (repeat "x"), take 0 (repeat "x"), take 5 [1..4])
+  catch (print (take (-1) [1..10])) (\(ErrorCall _) -> putStr "take (-1)\n")
+
+  -- replicate
+  print [replicate 2 "abc", replicate 0 "abc", replicate 3 []]
+
+  -- drop
+  print [drop 5 [1..10], drop 0 [1..10], drop 5 [1..4]]
+  catch (print (drop (-1) [1..10])) (\(ErrorCall _) -> putStr "drop (-1)\n")
+
+  -- splitAt
+  print [splitAt 5 [1..10], splitAt 5 [1..4]]
+  catch (print (splitAt (-1) [1..10])) (\(ErrorCall _) -> putStr "splitAt (-1)\n")
+
+  -- scan
+  print (span (<5) [1..10])
+
+  -- break
+  print (break (<5) [1..10])
+
+  -- reverse
+  print [reverse [1..10], reverse []]
+
+  -- and
+  print [and [], and [True], and [False]]
+
+  -- or
+  print [or [], or [True], or [False]]
+
+  -- elem
+  print [elem 5 [1..10], elem 0 [1..10], elem 1 []]
+
+  -- notElem
+  print [notElem 5 [1..10], notElem 0 [1..10], notElem 1 []]
+
+  -- lookkup
+  print (lookup 4 (zip [1..10] (reverse [1..10])))
+
+  -- sum
+  print [sum [1..10], sum []]
+
+  -- product
+  print [product [1..10], product []]
+
+  -- maximum
+  print (maximum [1..10])
+  catch (print (maximum [] :: Int)) (\(ErrorCall _) -> putStr "maximum []\n")
+
+  -- minimum
+  print (minimum [1..10])
+  catch (print (minimum [] :: Int)) (\(ErrorCall _) -> putStr "minimum []\n")
+
+  -- concatMap
+  print (concatMap (:[]) [(1::Int)..10])
+
+  -- zip
+  print [zip [1] [2], zip [1] [], zip [] [2], zip [1..5] [2..6]]
+
+  -- zip3
+  print (zip3 [1,2] [3,4] [5,6])
+
+  -- zipWith
+  print [zipWith (+) [1,2] [3,4], zipWith (+) [1] [], zipWith (+) [] []]
+
+  -- unzip
+  print [unzip [(1,2),(3,4)], unzip []]
+
+  -- unzip3
+  print [unzip3 [(1,2,3),(3,4,5)], unzip3 []]
+
+  -- unlines
+  print (unlines (lines "a\nb\nc\n"), lines "", unlines [])
+
+  -- words
+  print (unwords (words "a b c d"),   words "", unwords [])
+
+  -- deleteBy
+  print [deleteBy (==) 1 [0,1,1,2,3,4], 
+	 deleteBy (==) (error "deleteBy") []]
+
+  -- delete
+  print [delete 1 [0,1,1,2,3,4], 
+	 delete (error "delete") []]
+  
+  -- (\\)
+  print [ [0,1,1,2,3,4] \\ [3,2,1],
+          [1,2,3,4] \\ [],
+	  [] \\ [error "\\\\"] ]
diff --git a/libraries/base/tests/list001.stdout b/libraries/base/tests/list001.stdout
new file mode 100644
index 000000000000..b8254f066efe
--- /dev/null
+++ b/libraries/base/tests/list001.stdout
@@ -0,0 +1,54 @@
+(1,'a')
+"head []
+([2,3,4],"")
+"tail []
+([1,2,3],"")
+"init []
+(4,'a')
+"last []
+[True,False]
+10
+56
+55
+foldl1 []
+[1,2,4,7,11,16,22,29,37,46,56]
+[1,3,6,10,15,21,28,36,45,55]
+[]
+55
+foldr1 []
+[56,55,53,50,46,41,35,28,20,11,1]
+[55,54,52,49,45,40,34,27,19,10]
+[]
+[1,2,3,4,1,2,3,4,1,2]
+(["x","x","x","x"],[],[1,2,3,4])
+[]
+[["abc","abc"],[],["","",""]]
+[[6,7,8,9,10],[1,2,3,4,5,6,7,8,9,10],[]]
+[1,2,3,4,5,6,7,8,9,10]
+[([1,2,3,4,5],[6,7,8,9,10]),([1,2,3,4],[])]
+([],[1,2,3,4,5,6,7,8,9,10])
+([1,2,3,4],[5,6,7,8,9,10])
+([],[1,2,3,4,5,6,7,8,9,10])
+[[10,9,8,7,6,5,4,3,2,1],[]]
+[True,True,False]
+[False,True,False]
+[True,False,False]
+[False,True,True]
+Just 7
+[55,0]
+[3628800,1]
+10
+maximum []
+1
+minimum []
+[1,2,3,4,5,6,7,8,9,10]
+[[(1,2)],[],[],[(1,2),(2,3),(3,4),(4,5),(5,6)]]
+[(1,3,5),(2,4,6)]
+[[4,6],[],[]]
+[([1,3],[2,4]),([],[])]
+[([1,3],[2,4],[3,5]),([],[],[])]
+("a\nb\nc\n",[],"")
+("a b c d",[],"")
+[[0,1,2,3,4],[]]
+[[0,1,2,3,4],[]]
+[[0,1,4],[1,2,3,4],[]]
diff --git a/libraries/base/tests/list001.stdout-ghc b/libraries/base/tests/list001.stdout-ghc
new file mode 100644
index 000000000000..16e780ac7bf7
--- /dev/null
+++ b/libraries/base/tests/list001.stdout-ghc
@@ -0,0 +1,54 @@
+(1,'a')
+head []
+([2,3,4],"")
+tail []
+([1,2,3],"")
+init []
+(4,'a')
+last []
+[True,False]
+10
+56
+55
+foldl1 []
+[1,2,4,7,11,16,22,29,37,46,56]
+[1,3,6,10,15,21,28,36,45,55]
+[]
+55
+foldr1 []
+[56,55,53,50,46,41,35,28,20,11,1]
+[55,54,52,49,45,40,34,27,19,10]
+[]
+[1,2,3,4,1,2,3,4,1,2]
+(["x","x","x","x"],[],[1,2,3,4])
+[]
+[["abc","abc"],[],["","",""]]
+[[6,7,8,9,10],[1,2,3,4,5,6,7,8,9,10],[]]
+[1,2,3,4,5,6,7,8,9,10]
+[([1,2,3,4,5],[6,7,8,9,10]),([1,2,3,4],[])]
+([],[1,2,3,4,5,6,7,8,9,10])
+([1,2,3,4],[5,6,7,8,9,10])
+([],[1,2,3,4,5,6,7,8,9,10])
+[[10,9,8,7,6,5,4,3,2,1],[]]
+[True,True,False]
+[False,True,False]
+[True,False,False]
+[False,True,True]
+Just 7
+[55,0]
+[3628800,1]
+10
+maximum []
+1
+minimum []
+[1,2,3,4,5,6,7,8,9,10]
+[[(1,2)],[],[],[(1,2),(2,3),(3,4),(4,5),(5,6)]]
+[(1,3,5),(2,4,6)]
+[[4,6],[],[]]
+[([1,3],[2,4]),([],[])]
+[([1,3],[2,4],[3,5]),([],[],[])]
+("a\nb\nc\n",[],"")
+("a b c d",[],"")
+[[0,1,2,3,4],[]]
+[[0,1,2,3,4],[]]
+[[0,1,4],[1,2,3,4],[]]
diff --git a/libraries/base/tests/list002.hs b/libraries/base/tests/list002.hs
new file mode 100644
index 000000000000..188ff8953d2c
--- /dev/null
+++ b/libraries/base/tests/list002.hs
@@ -0,0 +1,6 @@
+-- !!! Test that List.sortBy is stable.
+
+import Data.List
+
+main = print (sortBy (\(a,b) (a',b')->compare a a')
+		([1,1,1,1,1,1,1,1,1,1]`zip`[1..10]))
diff --git a/libraries/base/tests/list002.stdout b/libraries/base/tests/list002.stdout
new file mode 100644
index 000000000000..18e1fcad8a49
--- /dev/null
+++ b/libraries/base/tests/list002.stdout
@@ -0,0 +1 @@
+[(1,1),(1,2),(1,3),(1,4),(1,5),(1,6),(1,7),(1,8),(1,9),(1,10)]
diff --git a/libraries/base/tests/list003.hs b/libraries/base/tests/list003.hs
new file mode 100644
index 000000000000..a79209443838
--- /dev/null
+++ b/libraries/base/tests/list003.hs
@@ -0,0 +1,7 @@
+-- !!! Test that length doesn't give a stack overflow
+
+module Main (main) where
+
+main :: IO ()
+main = print $ length $ filter odd [0 .. 9999999]
+
diff --git a/libraries/base/tests/list003.stdout b/libraries/base/tests/list003.stdout
new file mode 100644
index 000000000000..447a331b1b27
--- /dev/null
+++ b/libraries/base/tests/list003.stdout
@@ -0,0 +1 @@
+5000000
diff --git a/libraries/base/tests/memo001.hs b/libraries/base/tests/memo001.hs
new file mode 100644
index 000000000000..551bcd8cf4f1
--- /dev/null
+++ b/libraries/base/tests/memo001.hs
@@ -0,0 +1,19 @@
+module Main(main) where
+
+import Memo1
+
+testMemo = do
+   let keys = [ [1..n] | n <- [1..1000] ]
+       keys2 = [ [n,n-1..1] | n <- [1..1000] ]
+       mlength = memo length
+   putStr (show (map mlength (keys ++ keys ++ keys2 ++ keys2)))
+   putStr (show (mlength [1..100000]))
+
+-- mlength will memoize itself over each element of 'keys', returning
+-- the memoized result the second time around.  Then we move onto
+-- keys2, and while we're doing this the first lot of memo table
+-- entries can be purged.  Finally, we do a a large computation
+-- (length [1..10000]) to allow time for the memo table to be fully
+-- purged.
+
+main = testMemo
diff --git a/libraries/base/tests/memo001.stdout b/libraries/base/tests/memo001.stdout
new file mode 100644
index 000000000000..0e1bce964700
--- /dev/null
+++ b/libraries/base/tests/memo001.stdout
@@ -0,0 +1 @@
+[1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,64,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,91,92,93,94,95,96,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,120,121,122,123,124,125,126,127,128,129,130,131,132,133,134,135,136,137,138,139,140,141,142,143,144,145,146,147,148,149,150,151,152,153,154,155,156,157,158,159,160,161,162,163,164,165,166,167,168,169,170,171,172,173,174,175,176,177,178,179,180,181,182,183,184,185,186,187,188,189,190,191,192,193,194,195,196,197,198,199,200,201,202,203,204,205,206,207,208,209,210,211,212,213,214,215,216,217,218,219,220,221,222,223,224,225,226,227,228,229,230,231,232,233,234,235,236,237,238,239,240,241,242,243,244,245,246,247,248,249,250,251,252,253,254,255,256,257,258,259,260,261,262,263,264,265,266,267,268,269,270,271,272,273,274,275,276,277,278,279,280,281,282,283,284,285,286,287,288,289,290,291,292,293,294,295,296,297,298,299,300,301,302,303,304,305,306,307,308,309,310,311,312,313,314,315,316,317,318,319,320,321,322,323,324,325,326,327,328,329,330,331,332,333,334,335,336,337,338,339,340,341,342,343,344,345,346,347,348,349,350,351,352,353,354,355,356,357,358,359,360,361,362,363,364,365,366,367,368,369,370,371,372,373,374,375,376,377,378,379,380,381,382,383,384,385,386,387,388,389,390,391,392,393,394,395,396,397,398,399,400,401,402,403,404,405,406,407,408,409,410,411,412,413,414,415,416,417,418,419,420,421,422,423,424,425,426,427,428,429,430,431,432,433,434,435,436,437,438,439,440,441,442,443,444,445,446,447,448,449,450,451,452,453,454,455,456,457,458,459,460,461,462,463,464,465,466,467,468,469,470,471,472,473,474,475,476,477,478,479,480,481,482,483,484,485,486,487,488,489,490,491,492,493,494,495,496,497,498,499,500,501,502,503,504,505,506,507,508,509,510,511,512,513,514,515,516,517,518,519,520,521,522,523,524,525,526,527,528,529,530,531,532,533,534,535,536,537,538,539,540,541,542,543,544,545,546,547,548,549,550,551,552,553,554,555,556,557,558,559,560,561,562,563,564,565,566,567,568,569,570,571,572,573,574,575,576,577,578,579,580,581,582,583,584,585,586,587,588,589,590,591,592,593,594,595,596,597,598,599,600,601,602,603,604,605,606,607,608,609,610,611,612,613,614,615,616,617,618,619,620,621,622,623,624,625,626,627,628,629,630,631,632,633,634,635,636,637,638,639,640,641,642,643,644,645,646,647,648,649,650,651,652,653,654,655,656,657,658,659,660,661,662,663,664,665,666,667,668,669,670,671,672,673,674,675,676,677,678,679,680,681,682,683,684,685,686,687,688,689,690,691,692,693,694,695,696,697,698,699,700,701,702,703,704,705,706,707,708,709,710,711,712,713,714,715,716,717,718,719,720,721,722,723,724,725,726,727,728,729,730,731,732,733,734,735,736,737,738,739,740,741,742,743,744,745,746,747,748,749,750,751,752,753,754,755,756,757,758,759,760,761,762,763,764,765,766,767,768,769,770,771,772,773,774,775,776,777,778,779,780,781,782,783,784,785,786,787,788,789,790,791,792,793,794,795,796,797,798,799,800,801,802,803,804,805,806,807,808,809,810,811,812,813,814,815,816,817,818,819,820,821,822,823,824,825,826,827,828,829,830,831,832,833,834,835,836,837,838,839,840,841,842,843,844,845,846,847,848,849,850,851,852,853,854,855,856,857,858,859,860,861,862,863,864,865,866,867,868,869,870,871,872,873,874,875,876,877,878,879,880,881,882,883,884,885,886,887,888,889,890,891,892,893,894,895,896,897,898,899,900,901,902,903,904,905,906,907,908,909,910,911,912,913,914,915,916,917,918,919,920,921,922,923,924,925,926,927,928,929,930,931,932,933,934,935,936,937,938,939,940,941,942,943,944,945,946,947,948,949,950,951,952,953,954,955,956,957,958,959,960,961,962,963,964,965,966,967,968,969,970,971,972,973,974,975,976,977,978,979,980,981,982,983,984,985,986,987,988,989,990,991,992,993,994,995,996,997,998,999,1000,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,64,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,91,92,93,94,95,96,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,120,121,122,123,124,125,126,127,128,129,130,131,132,133,134,135,136,137,138,139,140,141,142,143,144,145,146,147,148,149,150,151,152,153,154,155,156,157,158,159,160,161,162,163,164,165,166,167,168,169,170,171,172,173,174,175,176,177,178,179,180,181,182,183,184,185,186,187,188,189,190,191,192,193,194,195,196,197,198,199,200,201,202,203,204,205,206,207,208,209,210,211,212,213,214,215,216,217,218,219,220,221,222,223,224,225,226,227,228,229,230,231,232,233,234,235,236,237,238,239,240,241,242,243,244,245,246,247,248,249,250,251,252,253,254,255,256,257,258,259,260,261,262,263,264,265,266,267,268,269,270,271,272,273,274,275,276,277,278,279,280,281,282,283,284,285,286,287,288,289,290,291,292,293,294,295,296,297,298,299,300,301,302,303,304,305,306,307,308,309,310,311,312,313,314,315,316,317,318,319,320,321,322,323,324,325,326,327,328,329,330,331,332,333,334,335,336,337,338,339,340,341,342,343,344,345,346,347,348,349,350,351,352,353,354,355,356,357,358,359,360,361,362,363,364,365,366,367,368,369,370,371,372,373,374,375,376,377,378,379,380,381,382,383,384,385,386,387,388,389,390,391,392,393,394,395,396,397,398,399,400,401,402,403,404,405,406,407,408,409,410,411,412,413,414,415,416,417,418,419,420,421,422,423,424,425,426,427,428,429,430,431,432,433,434,435,436,437,438,439,440,441,442,443,444,445,446,447,448,449,450,451,452,453,454,455,456,457,458,459,460,461,462,463,464,465,466,467,468,469,470,471,472,473,474,475,476,477,478,479,480,481,482,483,484,485,486,487,488,489,490,491,492,493,494,495,496,497,498,499,500,501,502,503,504,505,506,507,508,509,510,511,512,513,514,515,516,517,518,519,520,521,522,523,524,525,526,527,528,529,530,531,532,533,534,535,536,537,538,539,540,541,542,543,544,545,546,547,548,549,550,551,552,553,554,555,556,557,558,559,560,561,562,563,564,565,566,567,568,569,570,571,572,573,574,575,576,577,578,579,580,581,582,583,584,585,586,587,588,589,590,591,592,593,594,595,596,597,598,599,600,601,602,603,604,605,606,607,608,609,610,611,612,613,614,615,616,617,618,619,620,621,622,623,624,625,626,627,628,629,630,631,632,633,634,635,636,637,638,639,640,641,642,643,644,645,646,647,648,649,650,651,652,653,654,655,656,657,658,659,660,661,662,663,664,665,666,667,668,669,670,671,672,673,674,675,676,677,678,679,680,681,682,683,684,685,686,687,688,689,690,691,692,693,694,695,696,697,698,699,700,701,702,703,704,705,706,707,708,709,710,711,712,713,714,715,716,717,718,719,720,721,722,723,724,725,726,727,728,729,730,731,732,733,734,735,736,737,738,739,740,741,742,743,744,745,746,747,748,749,750,751,752,753,754,755,756,757,758,759,760,761,762,763,764,765,766,767,768,769,770,771,772,773,774,775,776,777,778,779,780,781,782,783,784,785,786,787,788,789,790,791,792,793,794,795,796,797,798,799,800,801,802,803,804,805,806,807,808,809,810,811,812,813,814,815,816,817,818,819,820,821,822,823,824,825,826,827,828,829,830,831,832,833,834,835,836,837,838,839,840,841,842,843,844,845,846,847,848,849,850,851,852,853,854,855,856,857,858,859,860,861,862,863,864,865,866,867,868,869,870,871,872,873,874,875,876,877,878,879,880,881,882,883,884,885,886,887,888,889,890,891,892,893,894,895,896,897,898,899,900,901,902,903,904,905,906,907,908,909,910,911,912,913,914,915,916,917,918,919,920,921,922,923,924,925,926,927,928,929,930,931,932,933,934,935,936,937,938,939,940,941,942,943,944,945,946,947,948,949,950,951,952,953,954,955,956,957,958,959,960,961,962,963,964,965,966,967,968,969,970,971,972,973,974,975,976,977,978,979,980,981,982,983,984,985,986,987,988,989,990,991,992,993,994,995,996,997,998,999,1000,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,64,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,91,92,93,94,95,96,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,120,121,122,123,124,125,126,127,128,129,130,131,132,133,134,135,136,137,138,139,140,141,142,143,144,145,146,147,148,149,150,151,152,153,154,155,156,157,158,159,160,161,162,163,164,165,166,167,168,169,170,171,172,173,174,175,176,177,178,179,180,181,182,183,184,185,186,187,188,189,190,191,192,193,194,195,196,197,198,199,200,201,202,203,204,205,206,207,208,209,210,211,212,213,214,215,216,217,218,219,220,221,222,223,224,225,226,227,228,229,230,231,232,233,234,235,236,237,238,239,240,241,242,243,244,245,246,247,248,249,250,251,252,253,254,255,256,257,258,259,260,261,262,263,264,265,266,267,268,269,270,271,272,273,274,275,276,277,278,279,280,281,282,283,284,285,286,287,288,289,290,291,292,293,294,295,296,297,298,299,300,301,302,303,304,305,306,307,308,309,310,311,312,313,314,315,316,317,318,319,320,321,322,323,324,325,326,327,328,329,330,331,332,333,334,335,336,337,338,339,340,341,342,343,344,345,346,347,348,349,350,351,352,353,354,355,356,357,358,359,360,361,362,363,364,365,366,367,368,369,370,371,372,373,374,375,376,377,378,379,380,381,382,383,384,385,386,387,388,389,390,391,392,393,394,395,396,397,398,399,400,401,402,403,404,405,406,407,408,409,410,411,412,413,414,415,416,417,418,419,420,421,422,423,424,425,426,427,428,429,430,431,432,433,434,435,436,437,438,439,440,441,442,443,444,445,446,447,448,449,450,451,452,453,454,455,456,457,458,459,460,461,462,463,464,465,466,467,468,469,470,471,472,473,474,475,476,477,478,479,480,481,482,483,484,485,486,487,488,489,490,491,492,493,494,495,496,497,498,499,500,501,502,503,504,505,506,507,508,509,510,511,512,513,514,515,516,517,518,519,520,521,522,523,524,525,526,527,528,529,530,531,532,533,534,535,536,537,538,539,540,541,542,543,544,545,546,547,548,549,550,551,552,553,554,555,556,557,558,559,560,561,562,563,564,565,566,567,568,569,570,571,572,573,574,575,576,577,578,579,580,581,582,583,584,585,586,587,588,589,590,591,592,593,594,595,596,597,598,599,600,601,602,603,604,605,606,607,608,609,610,611,612,613,614,615,616,617,618,619,620,621,622,623,624,625,626,627,628,629,630,631,632,633,634,635,636,637,638,639,640,641,642,643,644,645,646,647,648,649,650,651,652,653,654,655,656,657,658,659,660,661,662,663,664,665,666,667,668,669,670,671,672,673,674,675,676,677,678,679,680,681,682,683,684,685,686,687,688,689,690,691,692,693,694,695,696,697,698,699,700,701,702,703,704,705,706,707,708,709,710,711,712,713,714,715,716,717,718,719,720,721,722,723,724,725,726,727,728,729,730,731,732,733,734,735,736,737,738,739,740,741,742,743,744,745,746,747,748,749,750,751,752,753,754,755,756,757,758,759,760,761,762,763,764,765,766,767,768,769,770,771,772,773,774,775,776,777,778,779,780,781,782,783,784,785,786,787,788,789,790,791,792,793,794,795,796,797,798,799,800,801,802,803,804,805,806,807,808,809,810,811,812,813,814,815,816,817,818,819,820,821,822,823,824,825,826,827,828,829,830,831,832,833,834,835,836,837,838,839,840,841,842,843,844,845,846,847,848,849,850,851,852,853,854,855,856,857,858,859,860,861,862,863,864,865,866,867,868,869,870,871,872,873,874,875,876,877,878,879,880,881,882,883,884,885,886,887,888,889,890,891,892,893,894,895,896,897,898,899,900,901,902,903,904,905,906,907,908,909,910,911,912,913,914,915,916,917,918,919,920,921,922,923,924,925,926,927,928,929,930,931,932,933,934,935,936,937,938,939,940,941,942,943,944,945,946,947,948,949,950,951,952,953,954,955,956,957,958,959,960,961,962,963,964,965,966,967,968,969,970,971,972,973,974,975,976,977,978,979,980,981,982,983,984,985,986,987,988,989,990,991,992,993,994,995,996,997,998,999,1000,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,64,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,91,92,93,94,95,96,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,120,121,122,123,124,125,126,127,128,129,130,131,132,133,134,135,136,137,138,139,140,141,142,143,144,145,146,147,148,149,150,151,152,153,154,155,156,157,158,159,160,161,162,163,164,165,166,167,168,169,170,171,172,173,174,175,176,177,178,179,180,181,182,183,184,185,186,187,188,189,190,191,192,193,194,195,196,197,198,199,200,201,202,203,204,205,206,207,208,209,210,211,212,213,214,215,216,217,218,219,220,221,222,223,224,225,226,227,228,229,230,231,232,233,234,235,236,237,238,239,240,241,242,243,244,245,246,247,248,249,250,251,252,253,254,255,256,257,258,259,260,261,262,263,264,265,266,267,268,269,270,271,272,273,274,275,276,277,278,279,280,281,282,283,284,285,286,287,288,289,290,291,292,293,294,295,296,297,298,299,300,301,302,303,304,305,306,307,308,309,310,311,312,313,314,315,316,317,318,319,320,321,322,323,324,325,326,327,328,329,330,331,332,333,334,335,336,337,338,339,340,341,342,343,344,345,346,347,348,349,350,351,352,353,354,355,356,357,358,359,360,361,362,363,364,365,366,367,368,369,370,371,372,373,374,375,376,377,378,379,380,381,382,383,384,385,386,387,388,389,390,391,392,393,394,395,396,397,398,399,400,401,402,403,404,405,406,407,408,409,410,411,412,413,414,415,416,417,418,419,420,421,422,423,424,425,426,427,428,429,430,431,432,433,434,435,436,437,438,439,440,441,442,443,444,445,446,447,448,449,450,451,452,453,454,455,456,457,458,459,460,461,462,463,464,465,466,467,468,469,470,471,472,473,474,475,476,477,478,479,480,481,482,483,484,485,486,487,488,489,490,491,492,493,494,495,496,497,498,499,500,501,502,503,504,505,506,507,508,509,510,511,512,513,514,515,516,517,518,519,520,521,522,523,524,525,526,527,528,529,530,531,532,533,534,535,536,537,538,539,540,541,542,543,544,545,546,547,548,549,550,551,552,553,554,555,556,557,558,559,560,561,562,563,564,565,566,567,568,569,570,571,572,573,574,575,576,577,578,579,580,581,582,583,584,585,586,587,588,589,590,591,592,593,594,595,596,597,598,599,600,601,602,603,604,605,606,607,608,609,610,611,612,613,614,615,616,617,618,619,620,621,622,623,624,625,626,627,628,629,630,631,632,633,634,635,636,637,638,639,640,641,642,643,644,645,646,647,648,649,650,651,652,653,654,655,656,657,658,659,660,661,662,663,664,665,666,667,668,669,670,671,672,673,674,675,676,677,678,679,680,681,682,683,684,685,686,687,688,689,690,691,692,693,694,695,696,697,698,699,700,701,702,703,704,705,706,707,708,709,710,711,712,713,714,715,716,717,718,719,720,721,722,723,724,725,726,727,728,729,730,731,732,733,734,735,736,737,738,739,740,741,742,743,744,745,746,747,748,749,750,751,752,753,754,755,756,757,758,759,760,761,762,763,764,765,766,767,768,769,770,771,772,773,774,775,776,777,778,779,780,781,782,783,784,785,786,787,788,789,790,791,792,793,794,795,796,797,798,799,800,801,802,803,804,805,806,807,808,809,810,811,812,813,814,815,816,817,818,819,820,821,822,823,824,825,826,827,828,829,830,831,832,833,834,835,836,837,838,839,840,841,842,843,844,845,846,847,848,849,850,851,852,853,854,855,856,857,858,859,860,861,862,863,864,865,866,867,868,869,870,871,872,873,874,875,876,877,878,879,880,881,882,883,884,885,886,887,888,889,890,891,892,893,894,895,896,897,898,899,900,901,902,903,904,905,906,907,908,909,910,911,912,913,914,915,916,917,918,919,920,921,922,923,924,925,926,927,928,929,930,931,932,933,934,935,936,937,938,939,940,941,942,943,944,945,946,947,948,949,950,951,952,953,954,955,956,957,958,959,960,961,962,963,964,965,966,967,968,969,970,971,972,973,974,975,976,977,978,979,980,981,982,983,984,985,986,987,988,989,990,991,992,993,994,995,996,997,998,999,1000]100000
\ No newline at end of file
diff --git a/libraries/base/tests/memo002.hs b/libraries/base/tests/memo002.hs
new file mode 100644
index 000000000000..aa0a1d27c9c7
--- /dev/null
+++ b/libraries/base/tests/memo002.hs
@@ -0,0 +1,30 @@
+module Main where
+
+import Memo2              ( memo )
+import Data.List          ( genericLength, genericReplicate )
+import System.Environment ( getArgs )
+
+main :: IO ()
+main = do (arg:_) <- getArgs
+	  mapM_ printTriple [ (i,fib i,mfib i) | i <- [10..read arg] ]
+  where printTriple (i,fi,mfi) = do print i
+				    print fi
+				    print mfi
+				    putStrLn ""
+
+-- There is not much point in memoising Integers, so we use unary "numbers" instead
+mfib :: Integer -> Integer
+mfib = genericLength . mfib' . flip genericReplicate ()
+
+mfib' :: [()] -> [()]
+mfib' = memo ufib
+
+ufib :: [()] -> [()]
+ufib []              = [()]
+ufib [()]            = [()]
+ufib (():n1@(():n2)) = mfib' n1 ++ mfib' n2
+
+fib :: Integer -> Integer
+fib 0 = 1
+fib 1 = 1
+fib n = fib (n-1) + fib (n-2)
diff --git a/libraries/base/tests/memo002.stdout b/libraries/base/tests/memo002.stdout
new file mode 100644
index 000000000000..7369b408ef0e
--- /dev/null
+++ b/libraries/base/tests/memo002.stdout
@@ -0,0 +1,44 @@
+10
+89
+89
+
+11
+144
+144
+
+12
+233
+233
+
+13
+377
+377
+
+14
+610
+610
+
+15
+987
+987
+
+16
+1597
+1597
+
+17
+2584
+2584
+
+18
+4181
+4181
+
+19
+6765
+6765
+
+20
+10946
+10946
+
diff --git a/libraries/base/tests/packedstring001.hs b/libraries/base/tests/packedstring001.hs
new file mode 100644
index 000000000000..9ee24e232c42
--- /dev/null
+++ b/libraries/base/tests/packedstring001.hs
@@ -0,0 +1,11 @@
+
+module Main (main) where
+
+import Char (isSpace)
+import Data.PackedString
+
+-- Bug in PackedString.lhs (fixed in rev 1.5)
+
+foo = packString "this is a test"
+main = print (filterPS (not.isSpace) foo)
+
diff --git a/libraries/base/tests/packedstring001.stdout b/libraries/base/tests/packedstring001.stdout
new file mode 100644
index 000000000000..fbd5abc3a05d
--- /dev/null
+++ b/libraries/base/tests/packedstring001.stdout
@@ -0,0 +1 @@
+"thisisatest"
diff --git a/libraries/base/tests/performGC001.hs b/libraries/base/tests/performGC001.hs
new file mode 100644
index 000000000000..f14dab004cca
--- /dev/null
+++ b/libraries/base/tests/performGC001.hs
@@ -0,0 +1,5 @@
+-- !!! test System.Mem.performGC
+
+import System.Mem
+
+main = performGC
diff --git a/libraries/base/tests/performGC001.stdout b/libraries/base/tests/performGC001.stdout
new file mode 100644
index 000000000000..e69de29bb2d1
diff --git a/libraries/base/tests/qsem001.hs b/libraries/base/tests/qsem001.hs
new file mode 100644
index 000000000000..0088c6e9895b
--- /dev/null
+++ b/libraries/base/tests/qsem001.hs
@@ -0,0 +1,87 @@
+import Control.Concurrent.QSem as OldQ
+
+import Control.Concurrent.Chan
+import Control.Concurrent (forkIO, threadDelay, killThread, yield)
+import Control.Concurrent.MVar
+import Control.Exception
+import Control.Monad
+
+new = newQSem
+wait = waitQSem
+signal = signalQSem
+
+--------
+-- dummy test-framework
+
+type Assertion = IO ()
+
+x @?= y = when (x /= y) $ error (show x ++ " /= " ++ show y)
+
+testCase :: String -> IO () -> IO ()
+testCase n io = putStrLn ("test " ++ n) >> io
+
+defaultMain = sequence
+------
+
+main = defaultMain tests
+
+tests = [
+    testCase "sem1" sem1,
+    testCase "sem2" sem2,
+    testCase "sem_kill" sem_kill,
+    testCase "sem_fifo" sem_fifo,
+    testCase "sem_bracket" sem_bracket
+ ]
+
+sem1 :: Assertion
+sem1 = do
+  q <- new 0
+  signal q
+  wait q
+
+sem2 :: Assertion
+sem2 = do
+  q <- new 0
+  signal q
+  signal q
+  wait q
+  wait q
+
+sem_fifo :: Assertion
+sem_fifo = do
+  c <- newChan
+  q <- new 0
+  t1 <- forkIO $ do wait q; writeChan c 'a'
+  threadDelay 10000
+  t2 <- forkIO $ do wait q; writeChan c 'b'
+  threadDelay 10000
+  t3 <- forkIO $ do wait q; writeChan c 'c'
+  threadDelay 10000
+  signal q
+  a <- readChan c
+  signal q
+  b <- readChan c
+  signal q
+  c <- readChan c
+  [a,b,c] @?= "abc"
+
+sem_kill :: Assertion
+sem_kill  = do
+  q <- new 0
+  t <- forkIO $ do wait q
+  threadDelay 100000
+  killThread t
+  m <- newEmptyMVar
+  t <- forkIO $ do wait q; putMVar m ()
+  signal q
+  takeMVar m
+
+
+sem_bracket :: Assertion
+sem_bracket = do
+  q <- new 1
+  ts <- forM [1..100000] $ \n -> do
+     forkIO $ do bracket_ (wait q) (signal q) (return ())
+  mapM_ killThread ts
+  wait q
+
diff --git a/libraries/base/tests/qsem001.stdout b/libraries/base/tests/qsem001.stdout
new file mode 100644
index 000000000000..5a569f77a8fc
--- /dev/null
+++ b/libraries/base/tests/qsem001.stdout
@@ -0,0 +1,5 @@
+test sem1
+test sem2
+test sem_kill
+test sem_fifo
+test sem_bracket
diff --git a/libraries/base/tests/qsemn001.hs b/libraries/base/tests/qsemn001.hs
new file mode 100644
index 000000000000..165efa508300
--- /dev/null
+++ b/libraries/base/tests/qsemn001.hs
@@ -0,0 +1,109 @@
+import Control.Concurrent
+import Control.Exception
+import Control.Monad
+import Data.List
+
+new = newQSemN
+wait = waitQSemN
+signal = signalQSemN
+
+--------
+-- dummy test-framework
+
+type Assertion = IO ()
+
+x @?= y = when (x /= y) $ error (show x ++ " /= " ++ show y)
+
+testCase :: String -> IO () -> IO ()
+testCase n io = putStrLn ("test " ++ n) >> io
+
+defaultMain = sequence
+------
+
+main = defaultMain tests
+
+tests = [
+    testCase "semn" semn,
+    testCase "semn2" semn2,
+    testCase "semn3" semn3,
+    testCase "semn_kill" semn_kill,
+    testCase "semn_bracket" sem_bracket
+ ]
+
+semn :: Assertion
+semn = do
+  c <- newEmptyMVar
+  q <- new 0
+  t1 <- forkIO $ do wait q 1;  putMVar c 'a'
+  threadDelay 10000
+  t2 <- forkIO $ do wait q 2;  putMVar c 'b'
+  threadDelay 10000
+  t3 <- forkIO $ do wait q 3;  putMVar c 'c'
+  threadDelay 10000
+  signal q 1
+  a <-  takeMVar c
+  signal q 2
+  b <-  takeMVar c
+  signal q 3
+  c <-  takeMVar c
+  [a,b,c] @?= "abc"
+
+semn2 :: Assertion
+semn2 = do
+  c <- newEmptyMVar
+  q <- new 0
+  t1 <- forkIO $ do wait q 1; putMVar c 'a'
+  threadDelay 10000
+  t2 <- forkIO $ do wait q 2; putMVar c 'b'
+  threadDelay 10000
+  t3 <- forkIO $ do wait q 3; putMVar c 'c'
+  threadDelay 10000
+  signal q 6
+  a <-  takeMVar c
+  b <-  takeMVar c
+  c <-  takeMVar c
+  sort [a,b,c] @?= "abc"
+
+semn3 :: Assertion
+semn3 = do
+  c <- newEmptyMVar
+  q <- new 0
+  t1 <- forkIO $ do wait q 1; putMVar c 'a'
+  threadDelay 10000
+  t2 <- forkIO $ do wait q 2; putMVar c 'b'
+  threadDelay 10000
+  t3 <- forkIO $ do wait q 3; putMVar c 'c'
+  threadDelay 10000
+  signal q 3
+  a <-  takeMVar c
+  b <-  takeMVar c
+  threadDelay 10000
+  sort [a,b] @?= "ab"
+  d <-  isEmptyMVar c
+  d @?= True
+  signal q 1
+  threadDelay 10000
+  d <-  isEmptyMVar c
+  d @?= True
+  signal q 2
+  x <-  takeMVar c
+  x @?= 'c'
+
+semn_kill :: Assertion
+semn_kill  = do
+  q <- new 0
+  t <- forkIO $ do wait q 1
+  threadDelay 10000
+  killThread t
+  m <- newEmptyMVar
+  t <- forkIO $ do wait q 1; putMVar m ()
+  signal q 1
+  takeMVar m
+
+sem_bracket :: Assertion
+sem_bracket = do
+  q <- new 1
+  ts <- forM [1..100000] $ \n -> do
+     forkIO $ do bracket_ (wait q 1) (signal q 1) (return ())
+  mapM_ killThread ts
+  wait q 1
diff --git a/libraries/base/tests/qsemn001.stdout b/libraries/base/tests/qsemn001.stdout
new file mode 100644
index 000000000000..7b7dd9497ee6
--- /dev/null
+++ b/libraries/base/tests/qsemn001.stdout
@@ -0,0 +1,5 @@
+test semn
+test semn2
+test semn3
+test semn_kill
+test semn_bracket
diff --git a/libraries/base/tests/quotOverflow.hs b/libraries/base/tests/quotOverflow.hs
new file mode 100644
index 000000000000..8d958f88698f
--- /dev/null
+++ b/libraries/base/tests/quotOverflow.hs
@@ -0,0 +1,33 @@
+
+import Control.Exception as E
+
+import Data.Int
+
+main :: IO ()
+main = do putStrLn "Int8"
+          mapM_ p =<< (f :: IO [Either Int8 String])
+          putStrLn "Int16"
+          mapM_ p =<< (f :: IO [Either Int16 String])
+          putStrLn "Int32"
+          mapM_ p =<< (f :: IO [Either Int32 String])
+          putStrLn "Int64"
+          mapM_ p =<< (f :: IO [Either Int64 String])
+          putStrLn "Int"
+          mapM_ p =<< (f :: IO [Either Int String])
+    where p (Left x) = print x
+          p (Right e) = putStrLn e
+
+f :: (Integral a, Bounded a) => IO [Either a String]
+f = sequence [ g (minBound `div` (-1)),
+               g (minBound `mod` (-1)),
+               g (case minBound `divMod` (-1) of (x, _) -> x),
+               g (case minBound `divMod` (-1) of (_, x) -> x),
+               g (minBound `quot` (-1)),
+               g (minBound `rem` (-1)),
+               g (case minBound `quotRem` (-1) of (x, _) -> x),
+               g (case minBound `quotRem` (-1) of (_, x) -> x) ]
+    where g x = do x' <- evaluate x
+                   return (Left x')
+                `E.catch`
+                   \e -> return (Right (show (e :: SomeException)))
+
diff --git a/libraries/base/tests/quotOverflow.stdout b/libraries/base/tests/quotOverflow.stdout
new file mode 100644
index 000000000000..10e77ac2cb90
--- /dev/null
+++ b/libraries/base/tests/quotOverflow.stdout
@@ -0,0 +1,45 @@
+Int8
+arithmetic overflow
+0
+arithmetic overflow
+0
+arithmetic overflow
+0
+arithmetic overflow
+0
+Int16
+arithmetic overflow
+0
+arithmetic overflow
+0
+arithmetic overflow
+0
+arithmetic overflow
+0
+Int32
+arithmetic overflow
+0
+arithmetic overflow
+0
+arithmetic overflow
+0
+arithmetic overflow
+0
+Int64
+arithmetic overflow
+0
+arithmetic overflow
+0
+arithmetic overflow
+0
+arithmetic overflow
+0
+Int
+arithmetic overflow
+0
+arithmetic overflow
+0
+arithmetic overflow
+0
+arithmetic overflow
+0
diff --git a/libraries/base/tests/rand001.hs b/libraries/base/tests/rand001.hs
new file mode 100644
index 000000000000..3567ae0dd8e7
--- /dev/null
+++ b/libraries/base/tests/rand001.hs
@@ -0,0 +1,22 @@
+module Main(main) where
+
+import System.Random
+
+tstRnd rng = checkRange rng (genRnd 50 rng)
+ 
+genRnd n rng = take n (randomRs rng (mkStdGen 2))
+ 
+checkRange (lo,hi) = all pred
+  where
+   pred
+    | lo <= hi  = \ x -> x >= lo && x <= hi
+    | otherwise = \ x -> x >= hi && x <= lo
+
+main :: IO ()
+main = do
+  print (tstRnd (1,5::Double))
+  print (tstRnd (1,5::Int))
+  print (tstRnd (10,54::Integer))
+  print (tstRnd ((-6),2::Int))
+  print (tstRnd (2,(-6)::Int))
+
diff --git a/libraries/base/tests/rand001.stdout b/libraries/base/tests/rand001.stdout
new file mode 100644
index 000000000000..2e883c51de61
--- /dev/null
+++ b/libraries/base/tests/rand001.stdout
@@ -0,0 +1,5 @@
+True
+True
+True
+True
+True
diff --git a/libraries/base/tests/ratio001.hs b/libraries/base/tests/ratio001.hs
new file mode 100644
index 000000000000..4d65dfbccfc0
--- /dev/null
+++ b/libraries/base/tests/ratio001.hs
@@ -0,0 +1,4 @@
+import Data.Ratio
+
+-- !!! Test that (%) has the right fixity
+main = print (2^3%5)
diff --git a/libraries/base/tests/ratio001.stdout b/libraries/base/tests/ratio001.stdout
new file mode 100644
index 000000000000..f7355f9a4a4d
--- /dev/null
+++ b/libraries/base/tests/ratio001.stdout
@@ -0,0 +1 @@
+8 % 5
diff --git a/libraries/base/tests/ratio001.stdout-ghc b/libraries/base/tests/ratio001.stdout-ghc
new file mode 100644
index 000000000000..f7355f9a4a4d
--- /dev/null
+++ b/libraries/base/tests/ratio001.stdout-ghc
@@ -0,0 +1 @@
+8 % 5
diff --git a/libraries/base/tests/readDouble001.hs b/libraries/base/tests/readDouble001.hs
new file mode 100644
index 000000000000..f111ac5a549e
--- /dev/null
+++ b/libraries/base/tests/readDouble001.hs
@@ -0,0 +1,11 @@
+
+main :: IO ()
+main = do f "Infinity"
+          f "-Infinity"
+          f "  -  Infinity  "
+          f "NaN"
+          f "-NaN"
+          f "  -  NaN  "
+
+f :: String -> IO ()
+f str = print (reads str :: [(Double, String)])
diff --git a/libraries/base/tests/readDouble001.stdout b/libraries/base/tests/readDouble001.stdout
new file mode 100644
index 000000000000..ddbbe1e88b7a
--- /dev/null
+++ b/libraries/base/tests/readDouble001.stdout
@@ -0,0 +1,6 @@
+[(Infinity,"")]
+[(-Infinity,"")]
+[(-Infinity,"  ")]
+[(NaN,"")]
+[(NaN,"")]
+[(NaN,"  ")]
diff --git a/libraries/base/tests/readFixed001.hs b/libraries/base/tests/readFixed001.hs
new file mode 100644
index 000000000000..5336f9b7b840
--- /dev/null
+++ b/libraries/base/tests/readFixed001.hs
@@ -0,0 +1,13 @@
+
+import Data.Fixed
+
+main :: IO ()
+main = do f "  (( (  12.3456  ) )  )  "
+          f "  (( (  12.3     ) )  )  "
+          f "  (( (  12.      ) )  )  "
+          f "  (( (  12       ) )  )  "
+          f "  (( - (  12.3456  ) )  )  "
+          f "  (( (  -12.3456  ) )  )  "
+
+f :: String -> IO ()
+f str = print (reads str :: [(Centi, String)])
diff --git a/libraries/base/tests/readFixed001.stdout b/libraries/base/tests/readFixed001.stdout
new file mode 100644
index 000000000000..82b2030d6388
--- /dev/null
+++ b/libraries/base/tests/readFixed001.stdout
@@ -0,0 +1,6 @@
+[(12.34,"  ")]
+[(12.30,"  ")]
+[]
+[(12.00,"  ")]
+[]
+[(-12.34,"  ")]
diff --git a/libraries/base/tests/readFloat.hs b/libraries/base/tests/readFloat.hs
new file mode 100644
index 000000000000..02fd48ec91c7
--- /dev/null
+++ b/libraries/base/tests/readFloat.hs
@@ -0,0 +1,5 @@
+
+import Numeric
+
+main :: IO ()
+main = putStrLn $ showFloat (read "" :: Float) ""
diff --git a/libraries/base/tests/readFloat.stderr b/libraries/base/tests/readFloat.stderr
new file mode 100644
index 000000000000..929906187eed
--- /dev/null
+++ b/libraries/base/tests/readFloat.stderr
@@ -0,0 +1 @@
+readFloat: Prelude.read: no parse
diff --git a/libraries/base/tests/readInteger001.hs b/libraries/base/tests/readInteger001.hs
new file mode 100644
index 000000000000..10391e419a0a
--- /dev/null
+++ b/libraries/base/tests/readInteger001.hs
@@ -0,0 +1,7 @@
+
+main :: IO ()
+main = do f "100e12"
+          f "00123.456"
+
+f :: String -> IO ()
+f str = print (reads str :: [(Integer, String)])
diff --git a/libraries/base/tests/readInteger001.stdout b/libraries/base/tests/readInteger001.stdout
new file mode 100644
index 000000000000..c71bf50e82fd
--- /dev/null
+++ b/libraries/base/tests/readInteger001.stdout
@@ -0,0 +1,2 @@
+[]
+[]
diff --git a/libraries/base/tests/readLitChar.hs b/libraries/base/tests/readLitChar.hs
new file mode 100644
index 000000000000..7dc01e36e472
--- /dev/null
+++ b/libraries/base/tests/readLitChar.hs
@@ -0,0 +1,12 @@
+module Main (main)
+where
+
+import Data.Char (digitToInt, lexLitChar, readLitChar)
+
+main :: IO ()
+main =
+    do putStrLn (show $ readLitChar "A")
+       putStrLn (show $ readLitChar "'A'")
+       putStrLn (show $ lexLitChar "A")
+       putStrLn (show $ lexLitChar "'A'")
+
diff --git a/libraries/base/tests/readLitChar.stdout b/libraries/base/tests/readLitChar.stdout
new file mode 100644
index 000000000000..649c342e4a77
--- /dev/null
+++ b/libraries/base/tests/readLitChar.stdout
@@ -0,0 +1,4 @@
+[('A',"")]
+[('\'',"A'")]
+[("A","")]
+[("'","A'")]
diff --git a/libraries/base/tests/reads001.hs b/libraries/base/tests/reads001.hs
new file mode 100644
index 000000000000..318367e7f4d2
--- /dev/null
+++ b/libraries/base/tests/reads001.hs
@@ -0,0 +1,10 @@
+-- Test the classic "\SOH" ambiguity
+
+module Main(main) where
+
+main = do { print soh ; print (length (fst (head soh))) ;
+	    print so  ; print (length (fst (head so))) }
+     where
+	so, soh :: [(String,String)]
+ 	soh = reads "\"\\SOH\""	-- Should read \SOH
+	so  = reads "\"\\SOx\""	-- Should read \SO followed by x
diff --git a/libraries/base/tests/reads001.stdout b/libraries/base/tests/reads001.stdout
new file mode 100644
index 000000000000..23639933e8eb
--- /dev/null
+++ b/libraries/base/tests/reads001.stdout
@@ -0,0 +1,4 @@
+[("\SOH","")]
+1
+[("\SOx","")]
+2
diff --git a/libraries/base/tests/show001.hs b/libraries/base/tests/show001.hs
new file mode 100644
index 000000000000..69c27d01ea08
--- /dev/null
+++ b/libraries/base/tests/show001.hs
@@ -0,0 +1,24 @@
+-- !!! Testing Show on Maybes and Eithers
+module Main(main) where
+
+x :: Maybe ()
+x = Nothing
+
+main :: IO ()
+main = do
+  print x
+  print (Just ())
+  print ((Just (Just ())) :: Maybe (Maybe ()))
+  print (Just x)
+  print ((Left 'a')  :: Either Char Int)
+  print ((Right 'b') :: Either Int Char)
+  print ((Right x)   :: Either Int (Maybe ()))
+  print ((Right (Just  'c')) :: Either Int (Maybe Char))
+  print ((Right (Right 'd')) :: Either Int (Either Char Char))
+  print ((Right (Left  'e')) :: Either Int (Either Char Int))
+  print ((Left 'f') :: Either Char Int)
+  print ((Left x) :: Either (Maybe ()) Char)
+  print ((Left (Just  'g')) :: Either (Maybe Char) ())
+  print ((Left (Right 'h')) :: Either (Either Int Char) Char)
+  print ((Left (Right 'i')) :: Either (Either Int Char) ())
+
diff --git a/libraries/base/tests/show001.stdout b/libraries/base/tests/show001.stdout
new file mode 100644
index 000000000000..3be0062e8755
--- /dev/null
+++ b/libraries/base/tests/show001.stdout
@@ -0,0 +1,15 @@
+Nothing
+Just ()
+Just (Just ())
+Just Nothing
+Left 'a'
+Right 'b'
+Right Nothing
+Right (Just 'c')
+Right (Right 'd')
+Right (Left 'e')
+Left 'f'
+Left Nothing
+Left (Just 'g')
+Left (Right 'h')
+Left (Right 'i')
diff --git a/libraries/base/tests/showDouble.hs b/libraries/base/tests/showDouble.hs
new file mode 100644
index 000000000000..399af28450ad
--- /dev/null
+++ b/libraries/base/tests/showDouble.hs
@@ -0,0 +1,41 @@
+
+module Main (main) where
+
+main :: IO ()
+main = do let xs = [p0, p01, p3, p31, n0, n01, n3, n31, pinf, ninf, nan]
+          mapM_ print xs
+          mapM_ (print . Just) xs
+
+p0 :: Double
+p0 = 0
+
+p01 :: Double
+p01 = 0.1
+
+p3 :: Double
+p3 = 3
+
+p31 :: Double
+p31 = 3.1
+
+n0 :: Double
+n0 = -0
+
+n01 :: Double
+n01 = -0.1
+
+n3 :: Double
+n3 = -3
+
+n31 :: Double
+n31 = -3.1
+
+pinf :: Double
+pinf = 1 / 0
+
+ninf :: Double
+ninf = - 1 / 0
+
+nan :: Double
+nan = 0 / 0
+
diff --git a/libraries/base/tests/showDouble.stdout b/libraries/base/tests/showDouble.stdout
new file mode 100644
index 000000000000..fb1b4de5e4d0
--- /dev/null
+++ b/libraries/base/tests/showDouble.stdout
@@ -0,0 +1,22 @@
+0.0
+0.1
+3.0
+3.1
+-0.0
+-0.1
+-3.0
+-3.1
+Infinity
+-Infinity
+NaN
+Just 0.0
+Just 0.1
+Just 3.0
+Just 3.1
+Just (-0.0)
+Just (-0.1)
+Just (-3.0)
+Just (-3.1)
+Just Infinity
+Just (-Infinity)
+Just NaN
diff --git a/libraries/base/tests/stableptr001.hs b/libraries/base/tests/stableptr001.hs
new file mode 100644
index 000000000000..1bc857aba6f9
--- /dev/null
+++ b/libraries/base/tests/stableptr001.hs
@@ -0,0 +1,19 @@
+
+module Main where
+
+import Foreign
+
+-- simple test for building/dereferencing stable ptrs
+
+main 
+  = do	l <- mapM newStablePtr [1..100000]
+   	sum <- stable_sum l
+   	print sum
+
+stable_sum :: [StablePtr Integer] -> IO Integer
+stable_sum [] = return 0
+stable_sum (x:xs) 
+  = do 	x'  <- deRefStablePtr x
+	freeStablePtr x
+       	xs' <- stable_sum xs
+        return (x' + xs')
diff --git a/libraries/base/tests/stableptr001.stdout b/libraries/base/tests/stableptr001.stdout
new file mode 100644
index 000000000000..90ee71a08984
--- /dev/null
+++ b/libraries/base/tests/stableptr001.stdout
@@ -0,0 +1 @@
+5000050000
diff --git a/libraries/base/tests/stableptr003.hs b/libraries/base/tests/stableptr003.hs
new file mode 100644
index 000000000000..77f4e3c9dcb2
--- /dev/null
+++ b/libraries/base/tests/stableptr003.hs
@@ -0,0 +1,16 @@
+module Main where
+
+import Control.Monad
+import System.Mem.StableName
+import Control.Exception
+
+main = do
+  mapM_ evaluate list
+  stable_list1 <- mapM makeStableName list
+  stable_list2 <- mapM makeStableName list
+  unless (stable_list1 == stable_list2) $ do
+    let l1 = map hashStableName stable_list1
+    let l2 = map hashStableName stable_list2
+    print $ zip l1 l2
+
+list = [1..10000] :: [Integer]
diff --git a/libraries/base/tests/stableptr004.hs b/libraries/base/tests/stableptr004.hs
new file mode 100644
index 000000000000..2d6f567cae2d
--- /dev/null
+++ b/libraries/base/tests/stableptr004.hs
@@ -0,0 +1,12 @@
+import Foreign.StablePtr
+
+-- compile without optimisation.
+-- run with +RTS -D256 to see the stable pointer being garbage collected.
+
+main = do
+  let xs = [ 1 .. 50000 ]
+  let ys = [ 1 .. 60000 ]
+  s1 <- newStablePtr xs
+  print (sum xs)
+  freeStablePtr s1
+  print (sum ys)
diff --git a/libraries/base/tests/stableptr004.stdout b/libraries/base/tests/stableptr004.stdout
new file mode 100644
index 000000000000..30e717b5bd5c
--- /dev/null
+++ b/libraries/base/tests/stableptr004.stdout
@@ -0,0 +1,2 @@
+1250025000
+1800030000
diff --git a/libraries/base/tests/stableptr005.hs b/libraries/base/tests/stableptr005.hs
new file mode 100644
index 000000000000..dc4928ab6c6b
--- /dev/null
+++ b/libraries/base/tests/stableptr005.hs
@@ -0,0 +1,22 @@
+-- !!! triggered a temporary bug in freeStablePtr around 20020424
+
+module Main where
+import Foreign.StablePtr (newStablePtr, freeStablePtr)
+
+data Foo = A | B | C | D
+
+main :: IO ()
+main = do aSPtr <- newStablePtr A
+          bSPtr <- newStablePtr B
+          cSPtr <- newStablePtr C
+          cSPtr' <- newStablePtr C
+          freeStablePtr aSPtr
+          freeStablePtr bSPtr
+          freeStablePtr cSPtr
+          freeStablePtr cSPtr'
+          aSPtr <- newStablePtr A
+          bSPtr <- newStablePtr B
+          cSPtr <- newStablePtr C
+          dSPtr <- newStablePtr D
+          print "Hello World"
+      
diff --git a/libraries/base/tests/stableptr005.stdout b/libraries/base/tests/stableptr005.stdout
new file mode 100644
index 000000000000..06ae699f22d4
--- /dev/null
+++ b/libraries/base/tests/stableptr005.stdout
@@ -0,0 +1 @@
+"Hello World"
diff --git a/libraries/base/tests/take001.hs b/libraries/base/tests/take001.hs
new file mode 100644
index 000000000000..789dfc68111e
--- /dev/null
+++ b/libraries/base/tests/take001.hs
@@ -0,0 +1,5 @@
+-- Test for bug #1219, F/B rule for take was too strict
+import System.Environment
+main = do
+ (n:_) <- getArgs
+ print (map (const 'x') (take (read n) (undefined:undefined)))
diff --git a/libraries/base/tests/take001.stdout b/libraries/base/tests/take001.stdout
new file mode 100644
index 000000000000..92232f694ab6
--- /dev/null
+++ b/libraries/base/tests/take001.stdout
@@ -0,0 +1 @@
+"x"
diff --git a/libraries/base/tests/tempfiles.hs b/libraries/base/tests/tempfiles.hs
new file mode 100644
index 000000000000..2fc156034f7e
--- /dev/null
+++ b/libraries/base/tests/tempfiles.hs
@@ -0,0 +1,36 @@
+
+import Control.Exception
+import Data.List
+import System.FilePath
+import System.Directory
+import System.IO
+
+-- Checks that openTempFile returns filenames with the right structure
+main :: IO ()
+main = do
+ fp0 <- otf ".no_prefix.hs"
+ print (".hs"        `isSuffixOf` fp0)
+ print (".no_prefix" `isPrefixOf` takeFileName fp0)
+
+ fp1 <- otf "no_suffix"
+ print (not ('.' `elem` fp1))
+ print ("no_suffix" `isPrefixOf` takeFileName fp1)
+
+ fp2 <- otf "one_suffix.hs"
+ print (".hs"        `isSuffixOf` fp2)
+ print ("one_suffix" `isPrefixOf` takeFileName fp2)
+
+ fp3 <- otf "two_suffixes.hs.blah"
+ print (".blah"           `isSuffixOf` fp3)
+ print ("two_suffixes.hs" `isPrefixOf` takeFileName fp3)
+
+otf :: FilePath -> IO FilePath
+otf fp = do putStrLn fp
+            bracket (openTempFile "." fp)
+                    (\(fp', h) -> do hClose h
+                                     removeFile fp')
+                    (\(fp', _) -> case fp' of
+                                  '.' : '/'  : fp'' -> return fp''
+                                  '.' : '\\' : fp'' -> return fp''
+                                  _                 -> return fp')
+
diff --git a/libraries/base/tests/tempfiles.stdout b/libraries/base/tests/tempfiles.stdout
new file mode 100644
index 000000000000..4dc72ce4881b
--- /dev/null
+++ b/libraries/base/tests/tempfiles.stdout
@@ -0,0 +1,12 @@
+.no_prefix.hs
+True
+True
+no_suffix
+True
+True
+one_suffix.hs
+True
+True
+two_suffixes.hs.blah
+True
+True
diff --git a/libraries/base/tests/text001.hs b/libraries/base/tests/text001.hs
new file mode 100644
index 000000000000..18aab82dd993
--- /dev/null
+++ b/libraries/base/tests/text001.hs
@@ -0,0 +1,15 @@
+{-	Bug report 28 May 99
+
+When compiled with ghc-4.02, everything's fine, it outputs "Value 7" as
+expected. But compiled with ghc-pre-4.03 it yields this error message.
+
+   Fail: Prelude.read: no parse
+-}
+
+module Main where
+
+data Msg = Value Int | Inc   deriving (Show, Read)
+  
+main = do let v = read "Value 7"::Msg
+          print v
+
diff --git a/libraries/base/tests/text001.stdout b/libraries/base/tests/text001.stdout
new file mode 100644
index 000000000000..a0c782242e3d
--- /dev/null
+++ b/libraries/base/tests/text001.stdout
@@ -0,0 +1 @@
+Value 7
diff --git a/libraries/base/tests/topHandler01.hs b/libraries/base/tests/topHandler01.hs
new file mode 100644
index 000000000000..0ee4bcb1ce18
--- /dev/null
+++ b/libraries/base/tests/topHandler01.hs
@@ -0,0 +1,16 @@
+import System.Posix.Process
+import System.Posix.Signals
+import Control.Exception
+import Control.Concurrent
+
+-- Test that a simulated ^C sends an async UserInterrupt
+-- exception to the main thread.
+
+main = handle userInterrupt $ do
+  us <- getProcessID
+  signalProcess sigINT us
+  threadDelay 1000000
+  putStrLn "Fail: never received  exception"
+
+userInterrupt UserInterrupt = putStrLn "Success: caught UserInterrupt"
+userInterrupt e             = putStrLn "Fail: caught unexpected exception"
diff --git a/libraries/base/tests/topHandler01.stdout b/libraries/base/tests/topHandler01.stdout
new file mode 100644
index 000000000000..16794111b7fc
--- /dev/null
+++ b/libraries/base/tests/topHandler01.stdout
@@ -0,0 +1 @@
+Success: caught UserInterrupt
diff --git a/libraries/base/tests/topHandler02.hs b/libraries/base/tests/topHandler02.hs
new file mode 100644
index 000000000000..270239c77f8c
--- /dev/null
+++ b/libraries/base/tests/topHandler02.hs
@@ -0,0 +1,7 @@
+import Control.Exception
+import Control.Concurrent
+
+-- Test that a UserInterrupt exception that propagates to the top level
+-- causes the process to terminate by killing itself with SIGINT
+
+main = throwIO UserInterrupt
diff --git a/libraries/base/tests/topHandler03.hs b/libraries/base/tests/topHandler03.hs
new file mode 100644
index 000000000000..01f69af6a75c
--- /dev/null
+++ b/libraries/base/tests/topHandler03.hs
@@ -0,0 +1,8 @@
+import System.Posix.Signals
+import System.Exit
+import Data.Bits
+
+-- Test that a ExitFailure representing SIGTERM causes
+-- the process to terminate by killing itself with SIGTERM
+
+main = exitWith (ExitFailure (fromIntegral (-sigTERM)))
diff --git a/libraries/base/tests/trace001.hs b/libraries/base/tests/trace001.hs
new file mode 100644
index 000000000000..2ed61d486e70
--- /dev/null
+++ b/libraries/base/tests/trace001.hs
@@ -0,0 +1,10 @@
+import System.IO
+import Debug.Trace
+
+main = do
+   hPutStr stderr
+	(trace (trace (trace (trace (trace (trace (trace
+	  "one" "fish") "two") "fish") "red") "fish") "blue") "fish")
+   hPutStr stdout
+	(trace (trace (trace (trace (trace (trace (trace
+	  "ONE" "FISH") "TWO") "FISH") "RED") "FISH") "BLUE") "FISH")
diff --git a/libraries/base/tests/trace001.stderr b/libraries/base/tests/trace001.stderr
new file mode 100644
index 000000000000..dfe965af2128
--- /dev/null
+++ b/libraries/base/tests/trace001.stderr
@@ -0,0 +1,14 @@
+one
+fish
+two
+fish
+red
+fish
+blue
+fishONE
+FISH
+TWO
+FISH
+RED
+FISH
+BLUE
diff --git a/libraries/base/tests/trace001.stdout b/libraries/base/tests/trace001.stdout
new file mode 100644
index 000000000000..23ddbb45508a
--- /dev/null
+++ b/libraries/base/tests/trace001.stdout
@@ -0,0 +1 @@
+FISH
\ No newline at end of file
diff --git a/libraries/base/tests/tup001.hs b/libraries/base/tests/tup001.hs
new file mode 100644
index 000000000000..a70e09027aeb
--- /dev/null
+++ b/libraries/base/tests/tup001.hs
@@ -0,0 +1,33 @@
+-- Test instances for tuples up to 15
+-- For Read, Show, Eq, Ord, Bounded
+
+module Main where
+
+data T = A | B | C | D | E | F | G | H | I | J | K | L | M | N | O
+       deriving( Eq, Ord, Show, Read, Bounded )
+
+t15 = (A,B,C,D,E,F,G,H,I,J,K,L,M,N,O)
+t14 = (A,B,C,D,E,F,G,H,I,J,K,L,M,N)
+t13 = (A,B,C,D,E,F,G,H,I,J,K,L,M)
+t12 = (A,B,C,D,E,F,G,H,I,J,K,L)
+t11 = (A,B,C,D,E,F,G,H,I,J,K)
+t10 = (A,B,C,D,E,F,G,H,I,J)
+t9  = (A,B,C,D,E,F,G,H,I)
+t8  = (A,B,C,D,E,F,G,H)
+t7  = (A,B,C,D,E,F,G)
+t6  = (A,B,C,D,E,F)
+t5  = (A,B,C,D,E)
+t4  = (A,B,C,D)
+t3  = (A,B,C)
+t2  = (A,B)
+t0  = ()
+
+big = (t0,t2,t3,t4,t5,t6,t7,t8,t9,t10,t11,t12,t13,t14,t15)
+
+main = do print big
+	  print (read (show big) `asTypeOf` big)
+	  print (big == big)
+	  print (big < big)
+	  print (big > big)
+	  print (minBound `asTypeOf` big)
+	  print (maxBound `asTypeOf` big)
\ No newline at end of file
diff --git a/libraries/base/tests/tup001.stdout b/libraries/base/tests/tup001.stdout
new file mode 100644
index 000000000000..540340b816c0
--- /dev/null
+++ b/libraries/base/tests/tup001.stdout
@@ -0,0 +1,7 @@
+((),(A,B),(A,B,C),(A,B,C,D),(A,B,C,D,E),(A,B,C,D,E,F),(A,B,C,D,E,F,G),(A,B,C,D,E,F,G,H),(A,B,C,D,E,F,G,H,I),(A,B,C,D,E,F,G,H,I,J),(A,B,C,D,E,F,G,H,I,J,K),(A,B,C,D,E,F,G,H,I,J,K,L),(A,B,C,D,E,F,G,H,I,J,K,L,M),(A,B,C,D,E,F,G,H,I,J,K,L,M,N),(A,B,C,D,E,F,G,H,I,J,K,L,M,N,O))
+((),(A,B),(A,B,C),(A,B,C,D),(A,B,C,D,E),(A,B,C,D,E,F),(A,B,C,D,E,F,G),(A,B,C,D,E,F,G,H),(A,B,C,D,E,F,G,H,I),(A,B,C,D,E,F,G,H,I,J),(A,B,C,D,E,F,G,H,I,J,K),(A,B,C,D,E,F,G,H,I,J,K,L),(A,B,C,D,E,F,G,H,I,J,K,L,M),(A,B,C,D,E,F,G,H,I,J,K,L,M,N),(A,B,C,D,E,F,G,H,I,J,K,L,M,N,O))
+True
+False
+False
+((),(A,A),(A,A,A),(A,A,A,A),(A,A,A,A,A),(A,A,A,A,A,A),(A,A,A,A,A,A,A),(A,A,A,A,A,A,A,A),(A,A,A,A,A,A,A,A,A),(A,A,A,A,A,A,A,A,A,A),(A,A,A,A,A,A,A,A,A,A,A),(A,A,A,A,A,A,A,A,A,A,A,A),(A,A,A,A,A,A,A,A,A,A,A,A,A),(A,A,A,A,A,A,A,A,A,A,A,A,A,A),(A,A,A,A,A,A,A,A,A,A,A,A,A,A,A))
+((),(O,O),(O,O,O),(O,O,O,O),(O,O,O,O,O),(O,O,O,O,O,O),(O,O,O,O,O,O,O),(O,O,O,O,O,O,O,O),(O,O,O,O,O,O,O,O,O),(O,O,O,O,O,O,O,O,O,O),(O,O,O,O,O,O,O,O,O,O,O),(O,O,O,O,O,O,O,O,O,O,O,O),(O,O,O,O,O,O,O,O,O,O,O,O,O),(O,O,O,O,O,O,O,O,O,O,O,O,O,O),(O,O,O,O,O,O,O,O,O,O,O,O,O,O,O))
diff --git a/libraries/base/tests/unicode001.hs b/libraries/base/tests/unicode001.hs
new file mode 100644
index 000000000000..ceac9a526522
--- /dev/null
+++ b/libraries/base/tests/unicode001.hs
@@ -0,0 +1,46 @@
+-- !!! Tests the various character classifiactions for a selection of Unicode
+-- characters.
+
+module Main where
+
+import Data.Char
+
+main = do
+  putStrLn ("            " ++ concat (map (++" ") strs))
+  mapM putStrLn (map do_char chars)
+ where
+  do_char char = s ++ (take (12-length s) (repeat ' ')) ++ concat (map f bs)
+    where
+          s = show char
+          bs = map ($char) functions
+          f True  = "X     "
+          f False = "      "
+
+strs = ["upper","lower","alpha","alnum","digit","print","space","cntrl"]
+
+functions = [isUpper,isLower,isAlpha,isAlphaNum,isDigit,isPrint,isSpace,isControl]
+
+chars = [backspace,tab,space,zero,lower_a,upper_a,delete,
+        right_pointing_double_angle_quotation_mark,
+        greek_capital_letter_alpha,
+        bengali_digit_zero,
+        en_space,
+        gothic_letter_ahsa,
+        monospaced_digit_zero
+        ]
+
+backspace             = '\x08'
+tab                   = '\t'
+space                 = ' '
+zero                  = '0'
+lower_a               = 'a'
+upper_a               = 'A'
+delete                = '\x7f'
+right_pointing_double_angle_quotation_mark = '\xBB'
+latin_small_letter_i_with_caron = '\x1D0'
+combining_acute_accent = '\x301'
+greek_capital_letter_alpha = '\x0391'
+bengali_digit_zero    = '\x09E6'
+en_space              = '\x2002'
+gothic_letter_ahsa    = '\x10330'
+monospaced_digit_zero = '\x1D7F6'
diff --git a/libraries/base/tests/unicode001.stdout b/libraries/base/tests/unicode001.stdout
new file mode 100644
index 000000000000..86163abae1de
--- /dev/null
+++ b/libraries/base/tests/unicode001.stdout
@@ -0,0 +1,14 @@
+            upper lower alpha alnum digit print space cntrl 
+'\b'                                                  X     
+'\t'                                            X     X     
+' '                                       X     X           
+'0'                           X     X     X                 
+'a'               X     X     X           X                 
+'A'         X           X     X           X                 
+'\DEL'                                                X     
+'\187'                                    X                 
+'\913'      X           X     X           X                 
+'\2534'                       X           X                 
+'\8194'                                   X     X           
+'\66352'                X     X           X                 
+'\120822'                     X           X                 
diff --git a/libraries/base/tests/unicode001.stdout-hugs b/libraries/base/tests/unicode001.stdout-hugs
new file mode 100644
index 000000000000..98c9568f8e1c
--- /dev/null
+++ b/libraries/base/tests/unicode001.stdout-hugs
@@ -0,0 +1,14 @@
+            upper lower alpha alnum digit print space cntrl 
+'\b'                                                  X     
+'\t'                                            X     X     
+' '                                       X     X           
+'0'                           X     X     X                 
+'a'               X     X     X           X                 
+'A'         X           X     X           X                 
+'\DEL'                                                X     
+'\187'                                    X                 
+'\913'      X           X     X           X                 
+'\2534'                       X           X                 
+'\8194'                                   X                 
+'\66352'                X     X           X                 
+'\120822'                     X           X                 
diff --git a/libraries/base/tests/unicode002.hs b/libraries/base/tests/unicode002.hs
new file mode 100644
index 000000000000..f7b9187971d0
--- /dev/null
+++ b/libraries/base/tests/unicode002.hs
@@ -0,0 +1,44 @@
+module Main where
+
+
+import Data.Char
+import Numeric
+
+header = "Code C P S U L A D"
+
+preds = [
+  isControl,
+  isPrint,
+  isSpace,
+  isUpper,
+  isLower,
+  isAlpha,
+  isDigit]
+
+prtBool :: Bool -> String
+
+prtBool True  = "T "
+prtBool False = "F "
+
+showCode :: Char -> Int -> String
+
+showCode c w = code ++ pad
+  where
+    code = show (ord c)
+    l = length code
+    spaces = map anytospace [1..]
+    anytospace _ = ' '
+    pad  | l >= w = ""
+         | otherwise = take (w - l) spaces
+
+charCode :: Char -> String
+
+rapply a b = b a
+
+charCode c = (showCode c 5) ++ (foldr1 (++) $ map prtBool $ map (rapply c) preds)
+
+main = do
+    putStrLn header
+    mapM (putStrLn . charCode) [ (chr 0) .. (chr 6553) ]
+
+
diff --git a/libraries/base/tests/unicode002.stdout b/libraries/base/tests/unicode002.stdout
new file mode 100644
index 000000000000..5c1f4c3342a7
--- /dev/null
+++ b/libraries/base/tests/unicode002.stdout
@@ -0,0 +1,6555 @@
+Code C P S U L A D
+0    T F F F F F F 
+1    T F F F F F F 
+2    T F F F F F F 
+3    T F F F F F F 
+4    T F F F F F F 
+5    T F F F F F F 
+6    T F F F F F F 
+7    T F F F F F F 
+8    T F F F F F F 
+9    T F T F F F F 
+10   T F T F F F F 
+11   T F T F F F F 
+12   T F T F F F F 
+13   T F T F F F F 
+14   T F F F F F F 
+15   T F F F F F F 
+16   T F F F F F F 
+17   T F F F F F F 
+18   T F F F F F F 
+19   T F F F F F F 
+20   T F F F F F F 
+21   T F F F F F F 
+22   T F F F F F F 
+23   T F F F F F F 
+24   T F F F F F F 
+25   T F F F F F F 
+26   T F F F F F F 
+27   T F F F F F F 
+28   T F F F F F F 
+29   T F F F F F F 
+30   T F F F F F F 
+31   T F F F F F F 
+32   F T T F F F F 
+33   F T F F F F F 
+34   F T F F F F F 
+35   F T F F F F F 
+36   F T F F F F F 
+37   F T F F F F F 
+38   F T F F F F F 
+39   F T F F F F F 
+40   F T F F F F F 
+41   F T F F F F F 
+42   F T F F F F F 
+43   F T F F F F F 
+44   F T F F F F F 
+45   F T F F F F F 
+46   F T F F F F F 
+47   F T F F F F F 
+48   F T F F F F T 
+49   F T F F F F T 
+50   F T F F F F T 
+51   F T F F F F T 
+52   F T F F F F T 
+53   F T F F F F T 
+54   F T F F F F T 
+55   F T F F F F T 
+56   F T F F F F T 
+57   F T F F F F T 
+58   F T F F F F F 
+59   F T F F F F F 
+60   F T F F F F F 
+61   F T F F F F F 
+62   F T F F F F F 
+63   F T F F F F F 
+64   F T F F F F F 
+65   F T F T F T F 
+66   F T F T F T F 
+67   F T F T F T F 
+68   F T F T F T F 
+69   F T F T F T F 
+70   F T F T F T F 
+71   F T F T F T F 
+72   F T F T F T F 
+73   F T F T F T F 
+74   F T F T F T F 
+75   F T F T F T F 
+76   F T F T F T F 
+77   F T F T F T F 
+78   F T F T F T F 
+79   F T F T F T F 
+80   F T F T F T F 
+81   F T F T F T F 
+82   F T F T F T F 
+83   F T F T F T F 
+84   F T F T F T F 
+85   F T F T F T F 
+86   F T F T F T F 
+87   F T F T F T F 
+88   F T F T F T F 
+89   F T F T F T F 
+90   F T F T F T F 
+91   F T F F F F F 
+92   F T F F F F F 
+93   F T F F F F F 
+94   F T F F F F F 
+95   F T F F F F F 
+96   F T F F F F F 
+97   F T F F T T F 
+98   F T F F T T F 
+99   F T F F T T F 
+100  F T F F T T F 
+101  F T F F T T F 
+102  F T F F T T F 
+103  F T F F T T F 
+104  F T F F T T F 
+105  F T F F T T F 
+106  F T F F T T F 
+107  F T F F T T F 
+108  F T F F T T F 
+109  F T F F T T F 
+110  F T F F T T F 
+111  F T F F T T F 
+112  F T F F T T F 
+113  F T F F T T F 
+114  F T F F T T F 
+115  F T F F T T F 
+116  F T F F T T F 
+117  F T F F T T F 
+118  F T F F T T F 
+119  F T F F T T F 
+120  F T F F T T F 
+121  F T F F T T F 
+122  F T F F T T F 
+123  F T F F F F F 
+124  F T F F F F F 
+125  F T F F F F F 
+126  F T F F F F F 
+127  T F F F F F F 
+128  T F F F F F F 
+129  T F F F F F F 
+130  T F F F F F F 
+131  T F F F F F F 
+132  T F F F F F F 
+133  T F F F F F F 
+134  T F F F F F F 
+135  T F F F F F F 
+136  T F F F F F F 
+137  T F F F F F F 
+138  T F F F F F F 
+139  T F F F F F F 
+140  T F F F F F F 
+141  T F F F F F F 
+142  T F F F F F F 
+143  T F F F F F F 
+144  T F F F F F F 
+145  T F F F F F F 
+146  T F F F F F F 
+147  T F F F F F F 
+148  T F F F F F F 
+149  T F F F F F F 
+150  T F F F F F F 
+151  T F F F F F F 
+152  T F F F F F F 
+153  T F F F F F F 
+154  T F F F F F F 
+155  T F F F F F F 
+156  T F F F F F F 
+157  T F F F F F F 
+158  T F F F F F F 
+159  T F F F F F F 
+160  F T T F F F F 
+161  F T F F F F F 
+162  F T F F F F F 
+163  F T F F F F F 
+164  F T F F F F F 
+165  F T F F F F F 
+166  F T F F F F F 
+167  F T F F F F F 
+168  F T F F F F F 
+169  F T F F F F F 
+170  F T F F T T F 
+171  F T F F F F F 
+172  F T F F F F F 
+173  F F F F F F F 
+174  F T F F F F F 
+175  F T F F F F F 
+176  F T F F F F F 
+177  F T F F F F F 
+178  F T F F F F F 
+179  F T F F F F F 
+180  F T F F F F F 
+181  F T F F T T F 
+182  F T F F F F F 
+183  F T F F F F F 
+184  F T F F F F F 
+185  F T F F F F F 
+186  F T F F T T F 
+187  F T F F F F F 
+188  F T F F F F F 
+189  F T F F F F F 
+190  F T F F F F F 
+191  F T F F F F F 
+192  F T F T F T F 
+193  F T F T F T F 
+194  F T F T F T F 
+195  F T F T F T F 
+196  F T F T F T F 
+197  F T F T F T F 
+198  F T F T F T F 
+199  F T F T F T F 
+200  F T F T F T F 
+201  F T F T F T F 
+202  F T F T F T F 
+203  F T F T F T F 
+204  F T F T F T F 
+205  F T F T F T F 
+206  F T F T F T F 
+207  F T F T F T F 
+208  F T F T F T F 
+209  F T F T F T F 
+210  F T F T F T F 
+211  F T F T F T F 
+212  F T F T F T F 
+213  F T F T F T F 
+214  F T F T F T F 
+215  F T F F F F F 
+216  F T F T F T F 
+217  F T F T F T F 
+218  F T F T F T F 
+219  F T F T F T F 
+220  F T F T F T F 
+221  F T F T F T F 
+222  F T F T F T F 
+223  F T F F T T F 
+224  F T F F T T F 
+225  F T F F T T F 
+226  F T F F T T F 
+227  F T F F T T F 
+228  F T F F T T F 
+229  F T F F T T F 
+230  F T F F T T F 
+231  F T F F T T F 
+232  F T F F T T F 
+233  F T F F T T F 
+234  F T F F T T F 
+235  F T F F T T F 
+236  F T F F T T F 
+237  F T F F T T F 
+238  F T F F T T F 
+239  F T F F T T F 
+240  F T F F T T F 
+241  F T F F T T F 
+242  F T F F T T F 
+243  F T F F T T F 
+244  F T F F T T F 
+245  F T F F T T F 
+246  F T F F T T F 
+247  F T F F F F F 
+248  F T F F T T F 
+249  F T F F T T F 
+250  F T F F T T F 
+251  F T F F T T F 
+252  F T F F T T F 
+253  F T F F T T F 
+254  F T F F T T F 
+255  F T F F T T F 
+256  F T F T F T F 
+257  F T F F T T F 
+258  F T F T F T F 
+259  F T F F T T F 
+260  F T F T F T F 
+261  F T F F T T F 
+262  F T F T F T F 
+263  F T F F T T F 
+264  F T F T F T F 
+265  F T F F T T F 
+266  F T F T F T F 
+267  F T F F T T F 
+268  F T F T F T F 
+269  F T F F T T F 
+270  F T F T F T F 
+271  F T F F T T F 
+272  F T F T F T F 
+273  F T F F T T F 
+274  F T F T F T F 
+275  F T F F T T F 
+276  F T F T F T F 
+277  F T F F T T F 
+278  F T F T F T F 
+279  F T F F T T F 
+280  F T F T F T F 
+281  F T F F T T F 
+282  F T F T F T F 
+283  F T F F T T F 
+284  F T F T F T F 
+285  F T F F T T F 
+286  F T F T F T F 
+287  F T F F T T F 
+288  F T F T F T F 
+289  F T F F T T F 
+290  F T F T F T F 
+291  F T F F T T F 
+292  F T F T F T F 
+293  F T F F T T F 
+294  F T F T F T F 
+295  F T F F T T F 
+296  F T F T F T F 
+297  F T F F T T F 
+298  F T F T F T F 
+299  F T F F T T F 
+300  F T F T F T F 
+301  F T F F T T F 
+302  F T F T F T F 
+303  F T F F T T F 
+304  F T F T F T F 
+305  F T F F T T F 
+306  F T F T F T F 
+307  F T F F T T F 
+308  F T F T F T F 
+309  F T F F T T F 
+310  F T F T F T F 
+311  F T F F T T F 
+312  F T F F T T F 
+313  F T F T F T F 
+314  F T F F T T F 
+315  F T F T F T F 
+316  F T F F T T F 
+317  F T F T F T F 
+318  F T F F T T F 
+319  F T F T F T F 
+320  F T F F T T F 
+321  F T F T F T F 
+322  F T F F T T F 
+323  F T F T F T F 
+324  F T F F T T F 
+325  F T F T F T F 
+326  F T F F T T F 
+327  F T F T F T F 
+328  F T F F T T F 
+329  F T F F T T F 
+330  F T F T F T F 
+331  F T F F T T F 
+332  F T F T F T F 
+333  F T F F T T F 
+334  F T F T F T F 
+335  F T F F T T F 
+336  F T F T F T F 
+337  F T F F T T F 
+338  F T F T F T F 
+339  F T F F T T F 
+340  F T F T F T F 
+341  F T F F T T F 
+342  F T F T F T F 
+343  F T F F T T F 
+344  F T F T F T F 
+345  F T F F T T F 
+346  F T F T F T F 
+347  F T F F T T F 
+348  F T F T F T F 
+349  F T F F T T F 
+350  F T F T F T F 
+351  F T F F T T F 
+352  F T F T F T F 
+353  F T F F T T F 
+354  F T F T F T F 
+355  F T F F T T F 
+356  F T F T F T F 
+357  F T F F T T F 
+358  F T F T F T F 
+359  F T F F T T F 
+360  F T F T F T F 
+361  F T F F T T F 
+362  F T F T F T F 
+363  F T F F T T F 
+364  F T F T F T F 
+365  F T F F T T F 
+366  F T F T F T F 
+367  F T F F T T F 
+368  F T F T F T F 
+369  F T F F T T F 
+370  F T F T F T F 
+371  F T F F T T F 
+372  F T F T F T F 
+373  F T F F T T F 
+374  F T F T F T F 
+375  F T F F T T F 
+376  F T F T F T F 
+377  F T F T F T F 
+378  F T F F T T F 
+379  F T F T F T F 
+380  F T F F T T F 
+381  F T F T F T F 
+382  F T F F T T F 
+383  F T F F T T F 
+384  F T F F T T F 
+385  F T F T F T F 
+386  F T F T F T F 
+387  F T F F T T F 
+388  F T F T F T F 
+389  F T F F T T F 
+390  F T F T F T F 
+391  F T F T F T F 
+392  F T F F T T F 
+393  F T F T F T F 
+394  F T F T F T F 
+395  F T F T F T F 
+396  F T F F T T F 
+397  F T F F T T F 
+398  F T F T F T F 
+399  F T F T F T F 
+400  F T F T F T F 
+401  F T F T F T F 
+402  F T F F T T F 
+403  F T F T F T F 
+404  F T F T F T F 
+405  F T F F T T F 
+406  F T F T F T F 
+407  F T F T F T F 
+408  F T F T F T F 
+409  F T F F T T F 
+410  F T F F T T F 
+411  F T F F T T F 
+412  F T F T F T F 
+413  F T F T F T F 
+414  F T F F T T F 
+415  F T F T F T F 
+416  F T F T F T F 
+417  F T F F T T F 
+418  F T F T F T F 
+419  F T F F T T F 
+420  F T F T F T F 
+421  F T F F T T F 
+422  F T F T F T F 
+423  F T F T F T F 
+424  F T F F T T F 
+425  F T F T F T F 
+426  F T F F T T F 
+427  F T F F T T F 
+428  F T F T F T F 
+429  F T F F T T F 
+430  F T F T F T F 
+431  F T F T F T F 
+432  F T F F T T F 
+433  F T F T F T F 
+434  F T F T F T F 
+435  F T F T F T F 
+436  F T F F T T F 
+437  F T F T F T F 
+438  F T F F T T F 
+439  F T F T F T F 
+440  F T F T F T F 
+441  F T F F T T F 
+442  F T F F T T F 
+443  F T F F F T F 
+444  F T F T F T F 
+445  F T F F T T F 
+446  F T F F T T F 
+447  F T F F T T F 
+448  F T F F F T F 
+449  F T F F F T F 
+450  F T F F F T F 
+451  F T F F F T F 
+452  F T F T F T F 
+453  F T F T F T F 
+454  F T F F T T F 
+455  F T F T F T F 
+456  F T F T F T F 
+457  F T F F T T F 
+458  F T F T F T F 
+459  F T F T F T F 
+460  F T F F T T F 
+461  F T F T F T F 
+462  F T F F T T F 
+463  F T F T F T F 
+464  F T F F T T F 
+465  F T F T F T F 
+466  F T F F T T F 
+467  F T F T F T F 
+468  F T F F T T F 
+469  F T F T F T F 
+470  F T F F T T F 
+471  F T F T F T F 
+472  F T F F T T F 
+473  F T F T F T F 
+474  F T F F T T F 
+475  F T F T F T F 
+476  F T F F T T F 
+477  F T F F T T F 
+478  F T F T F T F 
+479  F T F F T T F 
+480  F T F T F T F 
+481  F T F F T T F 
+482  F T F T F T F 
+483  F T F F T T F 
+484  F T F T F T F 
+485  F T F F T T F 
+486  F T F T F T F 
+487  F T F F T T F 
+488  F T F T F T F 
+489  F T F F T T F 
+490  F T F T F T F 
+491  F T F F T T F 
+492  F T F T F T F 
+493  F T F F T T F 
+494  F T F T F T F 
+495  F T F F T T F 
+496  F T F F T T F 
+497  F T F T F T F 
+498  F T F T F T F 
+499  F T F F T T F 
+500  F T F T F T F 
+501  F T F F T T F 
+502  F T F T F T F 
+503  F T F T F T F 
+504  F T F T F T F 
+505  F T F F T T F 
+506  F T F T F T F 
+507  F T F F T T F 
+508  F T F T F T F 
+509  F T F F T T F 
+510  F T F T F T F 
+511  F T F F T T F 
+512  F T F T F T F 
+513  F T F F T T F 
+514  F T F T F T F 
+515  F T F F T T F 
+516  F T F T F T F 
+517  F T F F T T F 
+518  F T F T F T F 
+519  F T F F T T F 
+520  F T F T F T F 
+521  F T F F T T F 
+522  F T F T F T F 
+523  F T F F T T F 
+524  F T F T F T F 
+525  F T F F T T F 
+526  F T F T F T F 
+527  F T F F T T F 
+528  F T F T F T F 
+529  F T F F T T F 
+530  F T F T F T F 
+531  F T F F T T F 
+532  F T F T F T F 
+533  F T F F T T F 
+534  F T F T F T F 
+535  F T F F T T F 
+536  F T F T F T F 
+537  F T F F T T F 
+538  F T F T F T F 
+539  F T F F T T F 
+540  F T F T F T F 
+541  F T F F T T F 
+542  F T F T F T F 
+543  F T F F T T F 
+544  F T F T F T F 
+545  F T F F T T F 
+546  F T F T F T F 
+547  F T F F T T F 
+548  F T F T F T F 
+549  F T F F T T F 
+550  F T F T F T F 
+551  F T F F T T F 
+552  F T F T F T F 
+553  F T F F T T F 
+554  F T F T F T F 
+555  F T F F T T F 
+556  F T F T F T F 
+557  F T F F T T F 
+558  F T F T F T F 
+559  F T F F T T F 
+560  F T F T F T F 
+561  F T F F T T F 
+562  F T F T F T F 
+563  F T F F T T F 
+564  F T F F T T F 
+565  F T F F T T F 
+566  F T F F T T F 
+567  F T F F T T F 
+568  F T F F T T F 
+569  F T F F T T F 
+570  F T F T F T F 
+571  F T F T F T F 
+572  F T F F T T F 
+573  F T F T F T F 
+574  F T F T F T F 
+575  F T F F T T F 
+576  F T F F T T F 
+577  F T F T F T F 
+578  F T F F T T F 
+579  F T F T F T F 
+580  F T F T F T F 
+581  F T F T F T F 
+582  F T F T F T F 
+583  F T F F T T F 
+584  F T F T F T F 
+585  F T F F T T F 
+586  F T F T F T F 
+587  F T F F T T F 
+588  F T F T F T F 
+589  F T F F T T F 
+590  F T F T F T F 
+591  F T F F T T F 
+592  F T F F T T F 
+593  F T F F T T F 
+594  F T F F T T F 
+595  F T F F T T F 
+596  F T F F T T F 
+597  F T F F T T F 
+598  F T F F T T F 
+599  F T F F T T F 
+600  F T F F T T F 
+601  F T F F T T F 
+602  F T F F T T F 
+603  F T F F T T F 
+604  F T F F T T F 
+605  F T F F T T F 
+606  F T F F T T F 
+607  F T F F T T F 
+608  F T F F T T F 
+609  F T F F T T F 
+610  F T F F T T F 
+611  F T F F T T F 
+612  F T F F T T F 
+613  F T F F T T F 
+614  F T F F T T F 
+615  F T F F T T F 
+616  F T F F T T F 
+617  F T F F T T F 
+618  F T F F T T F 
+619  F T F F T T F 
+620  F T F F T T F 
+621  F T F F T T F 
+622  F T F F T T F 
+623  F T F F T T F 
+624  F T F F T T F 
+625  F T F F T T F 
+626  F T F F T T F 
+627  F T F F T T F 
+628  F T F F T T F 
+629  F T F F T T F 
+630  F T F F T T F 
+631  F T F F T T F 
+632  F T F F T T F 
+633  F T F F T T F 
+634  F T F F T T F 
+635  F T F F T T F 
+636  F T F F T T F 
+637  F T F F T T F 
+638  F T F F T T F 
+639  F T F F T T F 
+640  F T F F T T F 
+641  F T F F T T F 
+642  F T F F T T F 
+643  F T F F T T F 
+644  F T F F T T F 
+645  F T F F T T F 
+646  F T F F T T F 
+647  F T F F T T F 
+648  F T F F T T F 
+649  F T F F T T F 
+650  F T F F T T F 
+651  F T F F T T F 
+652  F T F F T T F 
+653  F T F F T T F 
+654  F T F F T T F 
+655  F T F F T T F 
+656  F T F F T T F 
+657  F T F F T T F 
+658  F T F F T T F 
+659  F T F F T T F 
+660  F T F F F T F 
+661  F T F F T T F 
+662  F T F F T T F 
+663  F T F F T T F 
+664  F T F F T T F 
+665  F T F F T T F 
+666  F T F F T T F 
+667  F T F F T T F 
+668  F T F F T T F 
+669  F T F F T T F 
+670  F T F F T T F 
+671  F T F F T T F 
+672  F T F F T T F 
+673  F T F F T T F 
+674  F T F F T T F 
+675  F T F F T T F 
+676  F T F F T T F 
+677  F T F F T T F 
+678  F T F F T T F 
+679  F T F F T T F 
+680  F T F F T T F 
+681  F T F F T T F 
+682  F T F F T T F 
+683  F T F F T T F 
+684  F T F F T T F 
+685  F T F F T T F 
+686  F T F F T T F 
+687  F T F F T T F 
+688  F T F F F T F 
+689  F T F F F T F 
+690  F T F F F T F 
+691  F T F F F T F 
+692  F T F F F T F 
+693  F T F F F T F 
+694  F T F F F T F 
+695  F T F F F T F 
+696  F T F F F T F 
+697  F T F F F T F 
+698  F T F F F T F 
+699  F T F F F T F 
+700  F T F F F T F 
+701  F T F F F T F 
+702  F T F F F T F 
+703  F T F F F T F 
+704  F T F F F T F 
+705  F T F F F T F 
+706  F T F F F F F 
+707  F T F F F F F 
+708  F T F F F F F 
+709  F T F F F F F 
+710  F T F F F T F 
+711  F T F F F T F 
+712  F T F F F T F 
+713  F T F F F T F 
+714  F T F F F T F 
+715  F T F F F T F 
+716  F T F F F T F 
+717  F T F F F T F 
+718  F T F F F T F 
+719  F T F F F T F 
+720  F T F F F T F 
+721  F T F F F T F 
+722  F T F F F F F 
+723  F T F F F F F 
+724  F T F F F F F 
+725  F T F F F F F 
+726  F T F F F F F 
+727  F T F F F F F 
+728  F T F F F F F 
+729  F T F F F F F 
+730  F T F F F F F 
+731  F T F F F F F 
+732  F T F F F F F 
+733  F T F F F F F 
+734  F T F F F F F 
+735  F T F F F F F 
+736  F T F F F T F 
+737  F T F F F T F 
+738  F T F F F T F 
+739  F T F F F T F 
+740  F T F F F T F 
+741  F T F F F F F 
+742  F T F F F F F 
+743  F T F F F F F 
+744  F T F F F F F 
+745  F T F F F F F 
+746  F T F F F F F 
+747  F T F F F F F 
+748  F T F F F T F 
+749  F T F F F F F 
+750  F T F F F T F 
+751  F T F F F F F 
+752  F T F F F F F 
+753  F T F F F F F 
+754  F T F F F F F 
+755  F T F F F F F 
+756  F T F F F F F 
+757  F T F F F F F 
+758  F T F F F F F 
+759  F T F F F F F 
+760  F T F F F F F 
+761  F T F F F F F 
+762  F T F F F F F 
+763  F T F F F F F 
+764  F T F F F F F 
+765  F T F F F F F 
+766  F T F F F F F 
+767  F T F F F F F 
+768  F T F F F F F 
+769  F T F F F F F 
+770  F T F F F F F 
+771  F T F F F F F 
+772  F T F F F F F 
+773  F T F F F F F 
+774  F T F F F F F 
+775  F T F F F F F 
+776  F T F F F F F 
+777  F T F F F F F 
+778  F T F F F F F 
+779  F T F F F F F 
+780  F T F F F F F 
+781  F T F F F F F 
+782  F T F F F F F 
+783  F T F F F F F 
+784  F T F F F F F 
+785  F T F F F F F 
+786  F T F F F F F 
+787  F T F F F F F 
+788  F T F F F F F 
+789  F T F F F F F 
+790  F T F F F F F 
+791  F T F F F F F 
+792  F T F F F F F 
+793  F T F F F F F 
+794  F T F F F F F 
+795  F T F F F F F 
+796  F T F F F F F 
+797  F T F F F F F 
+798  F T F F F F F 
+799  F T F F F F F 
+800  F T F F F F F 
+801  F T F F F F F 
+802  F T F F F F F 
+803  F T F F F F F 
+804  F T F F F F F 
+805  F T F F F F F 
+806  F T F F F F F 
+807  F T F F F F F 
+808  F T F F F F F 
+809  F T F F F F F 
+810  F T F F F F F 
+811  F T F F F F F 
+812  F T F F F F F 
+813  F T F F F F F 
+814  F T F F F F F 
+815  F T F F F F F 
+816  F T F F F F F 
+817  F T F F F F F 
+818  F T F F F F F 
+819  F T F F F F F 
+820  F T F F F F F 
+821  F T F F F F F 
+822  F T F F F F F 
+823  F T F F F F F 
+824  F T F F F F F 
+825  F T F F F F F 
+826  F T F F F F F 
+827  F T F F F F F 
+828  F T F F F F F 
+829  F T F F F F F 
+830  F T F F F F F 
+831  F T F F F F F 
+832  F T F F F F F 
+833  F T F F F F F 
+834  F T F F F F F 
+835  F T F F F F F 
+836  F T F F F F F 
+837  F T F F F F F 
+838  F T F F F F F 
+839  F T F F F F F 
+840  F T F F F F F 
+841  F T F F F F F 
+842  F T F F F F F 
+843  F T F F F F F 
+844  F T F F F F F 
+845  F T F F F F F 
+846  F T F F F F F 
+847  F T F F F F F 
+848  F T F F F F F 
+849  F T F F F F F 
+850  F T F F F F F 
+851  F T F F F F F 
+852  F T F F F F F 
+853  F T F F F F F 
+854  F T F F F F F 
+855  F T F F F F F 
+856  F T F F F F F 
+857  F T F F F F F 
+858  F T F F F F F 
+859  F T F F F F F 
+860  F T F F F F F 
+861  F T F F F F F 
+862  F T F F F F F 
+863  F T F F F F F 
+864  F T F F F F F 
+865  F T F F F F F 
+866  F T F F F F F 
+867  F T F F F F F 
+868  F T F F F F F 
+869  F T F F F F F 
+870  F T F F F F F 
+871  F T F F F F F 
+872  F T F F F F F 
+873  F T F F F F F 
+874  F T F F F F F 
+875  F T F F F F F 
+876  F T F F F F F 
+877  F T F F F F F 
+878  F T F F F F F 
+879  F T F F F F F 
+880  F T F T F T F 
+881  F T F F T T F 
+882  F T F T F T F 
+883  F T F F T T F 
+884  F T F F F T F 
+885  F T F F F F F 
+886  F T F T F T F 
+887  F T F F T T F 
+888  F F F F F F F 
+889  F F F F F F F 
+890  F T F F F T F 
+891  F T F F T T F 
+892  F T F F T T F 
+893  F T F F T T F 
+894  F T F F F F F 
+895  F F F F F F F 
+896  F F F F F F F 
+897  F F F F F F F 
+898  F F F F F F F 
+899  F F F F F F F 
+900  F T F F F F F 
+901  F T F F F F F 
+902  F T F T F T F 
+903  F T F F F F F 
+904  F T F T F T F 
+905  F T F T F T F 
+906  F T F T F T F 
+907  F F F F F F F 
+908  F T F T F T F 
+909  F F F F F F F 
+910  F T F T F T F 
+911  F T F T F T F 
+912  F T F F T T F 
+913  F T F T F T F 
+914  F T F T F T F 
+915  F T F T F T F 
+916  F T F T F T F 
+917  F T F T F T F 
+918  F T F T F T F 
+919  F T F T F T F 
+920  F T F T F T F 
+921  F T F T F T F 
+922  F T F T F T F 
+923  F T F T F T F 
+924  F T F T F T F 
+925  F T F T F T F 
+926  F T F T F T F 
+927  F T F T F T F 
+928  F T F T F T F 
+929  F T F T F T F 
+930  F F F F F F F 
+931  F T F T F T F 
+932  F T F T F T F 
+933  F T F T F T F 
+934  F T F T F T F 
+935  F T F T F T F 
+936  F T F T F T F 
+937  F T F T F T F 
+938  F T F T F T F 
+939  F T F T F T F 
+940  F T F F T T F 
+941  F T F F T T F 
+942  F T F F T T F 
+943  F T F F T T F 
+944  F T F F T T F 
+945  F T F F T T F 
+946  F T F F T T F 
+947  F T F F T T F 
+948  F T F F T T F 
+949  F T F F T T F 
+950  F T F F T T F 
+951  F T F F T T F 
+952  F T F F T T F 
+953  F T F F T T F 
+954  F T F F T T F 
+955  F T F F T T F 
+956  F T F F T T F 
+957  F T F F T T F 
+958  F T F F T T F 
+959  F T F F T T F 
+960  F T F F T T F 
+961  F T F F T T F 
+962  F T F F T T F 
+963  F T F F T T F 
+964  F T F F T T F 
+965  F T F F T T F 
+966  F T F F T T F 
+967  F T F F T T F 
+968  F T F F T T F 
+969  F T F F T T F 
+970  F T F F T T F 
+971  F T F F T T F 
+972  F T F F T T F 
+973  F T F F T T F 
+974  F T F F T T F 
+975  F T F T F T F 
+976  F T F F T T F 
+977  F T F F T T F 
+978  F T F T F T F 
+979  F T F T F T F 
+980  F T F T F T F 
+981  F T F F T T F 
+982  F T F F T T F 
+983  F T F F T T F 
+984  F T F T F T F 
+985  F T F F T T F 
+986  F T F T F T F 
+987  F T F F T T F 
+988  F T F T F T F 
+989  F T F F T T F 
+990  F T F T F T F 
+991  F T F F T T F 
+992  F T F T F T F 
+993  F T F F T T F 
+994  F T F T F T F 
+995  F T F F T T F 
+996  F T F T F T F 
+997  F T F F T T F 
+998  F T F T F T F 
+999  F T F F T T F 
+1000 F T F T F T F 
+1001 F T F F T T F 
+1002 F T F T F T F 
+1003 F T F F T T F 
+1004 F T F T F T F 
+1005 F T F F T T F 
+1006 F T F T F T F 
+1007 F T F F T T F 
+1008 F T F F T T F 
+1009 F T F F T T F 
+1010 F T F F T T F 
+1011 F T F F T T F 
+1012 F T F T F T F 
+1013 F T F F T T F 
+1014 F T F F F F F 
+1015 F T F T F T F 
+1016 F T F F T T F 
+1017 F T F T F T F 
+1018 F T F T F T F 
+1019 F T F F T T F 
+1020 F T F F T T F 
+1021 F T F T F T F 
+1022 F T F T F T F 
+1023 F T F T F T F 
+1024 F T F T F T F 
+1025 F T F T F T F 
+1026 F T F T F T F 
+1027 F T F T F T F 
+1028 F T F T F T F 
+1029 F T F T F T F 
+1030 F T F T F T F 
+1031 F T F T F T F 
+1032 F T F T F T F 
+1033 F T F T F T F 
+1034 F T F T F T F 
+1035 F T F T F T F 
+1036 F T F T F T F 
+1037 F T F T F T F 
+1038 F T F T F T F 
+1039 F T F T F T F 
+1040 F T F T F T F 
+1041 F T F T F T F 
+1042 F T F T F T F 
+1043 F T F T F T F 
+1044 F T F T F T F 
+1045 F T F T F T F 
+1046 F T F T F T F 
+1047 F T F T F T F 
+1048 F T F T F T F 
+1049 F T F T F T F 
+1050 F T F T F T F 
+1051 F T F T F T F 
+1052 F T F T F T F 
+1053 F T F T F T F 
+1054 F T F T F T F 
+1055 F T F T F T F 
+1056 F T F T F T F 
+1057 F T F T F T F 
+1058 F T F T F T F 
+1059 F T F T F T F 
+1060 F T F T F T F 
+1061 F T F T F T F 
+1062 F T F T F T F 
+1063 F T F T F T F 
+1064 F T F T F T F 
+1065 F T F T F T F 
+1066 F T F T F T F 
+1067 F T F T F T F 
+1068 F T F T F T F 
+1069 F T F T F T F 
+1070 F T F T F T F 
+1071 F T F T F T F 
+1072 F T F F T T F 
+1073 F T F F T T F 
+1074 F T F F T T F 
+1075 F T F F T T F 
+1076 F T F F T T F 
+1077 F T F F T T F 
+1078 F T F F T T F 
+1079 F T F F T T F 
+1080 F T F F T T F 
+1081 F T F F T T F 
+1082 F T F F T T F 
+1083 F T F F T T F 
+1084 F T F F T T F 
+1085 F T F F T T F 
+1086 F T F F T T F 
+1087 F T F F T T F 
+1088 F T F F T T F 
+1089 F T F F T T F 
+1090 F T F F T T F 
+1091 F T F F T T F 
+1092 F T F F T T F 
+1093 F T F F T T F 
+1094 F T F F T T F 
+1095 F T F F T T F 
+1096 F T F F T T F 
+1097 F T F F T T F 
+1098 F T F F T T F 
+1099 F T F F T T F 
+1100 F T F F T T F 
+1101 F T F F T T F 
+1102 F T F F T T F 
+1103 F T F F T T F 
+1104 F T F F T T F 
+1105 F T F F T T F 
+1106 F T F F T T F 
+1107 F T F F T T F 
+1108 F T F F T T F 
+1109 F T F F T T F 
+1110 F T F F T T F 
+1111 F T F F T T F 
+1112 F T F F T T F 
+1113 F T F F T T F 
+1114 F T F F T T F 
+1115 F T F F T T F 
+1116 F T F F T T F 
+1117 F T F F T T F 
+1118 F T F F T T F 
+1119 F T F F T T F 
+1120 F T F T F T F 
+1121 F T F F T T F 
+1122 F T F T F T F 
+1123 F T F F T T F 
+1124 F T F T F T F 
+1125 F T F F T T F 
+1126 F T F T F T F 
+1127 F T F F T T F 
+1128 F T F T F T F 
+1129 F T F F T T F 
+1130 F T F T F T F 
+1131 F T F F T T F 
+1132 F T F T F T F 
+1133 F T F F T T F 
+1134 F T F T F T F 
+1135 F T F F T T F 
+1136 F T F T F T F 
+1137 F T F F T T F 
+1138 F T F T F T F 
+1139 F T F F T T F 
+1140 F T F T F T F 
+1141 F T F F T T F 
+1142 F T F T F T F 
+1143 F T F F T T F 
+1144 F T F T F T F 
+1145 F T F F T T F 
+1146 F T F T F T F 
+1147 F T F F T T F 
+1148 F T F T F T F 
+1149 F T F F T T F 
+1150 F T F T F T F 
+1151 F T F F T T F 
+1152 F T F T F T F 
+1153 F T F F T T F 
+1154 F T F F F F F 
+1155 F T F F F F F 
+1156 F T F F F F F 
+1157 F T F F F F F 
+1158 F T F F F F F 
+1159 F T F F F F F 
+1160 F T F F F F F 
+1161 F T F F F F F 
+1162 F T F T F T F 
+1163 F T F F T T F 
+1164 F T F T F T F 
+1165 F T F F T T F 
+1166 F T F T F T F 
+1167 F T F F T T F 
+1168 F T F T F T F 
+1169 F T F F T T F 
+1170 F T F T F T F 
+1171 F T F F T T F 
+1172 F T F T F T F 
+1173 F T F F T T F 
+1174 F T F T F T F 
+1175 F T F F T T F 
+1176 F T F T F T F 
+1177 F T F F T T F 
+1178 F T F T F T F 
+1179 F T F F T T F 
+1180 F T F T F T F 
+1181 F T F F T T F 
+1182 F T F T F T F 
+1183 F T F F T T F 
+1184 F T F T F T F 
+1185 F T F F T T F 
+1186 F T F T F T F 
+1187 F T F F T T F 
+1188 F T F T F T F 
+1189 F T F F T T F 
+1190 F T F T F T F 
+1191 F T F F T T F 
+1192 F T F T F T F 
+1193 F T F F T T F 
+1194 F T F T F T F 
+1195 F T F F T T F 
+1196 F T F T F T F 
+1197 F T F F T T F 
+1198 F T F T F T F 
+1199 F T F F T T F 
+1200 F T F T F T F 
+1201 F T F F T T F 
+1202 F T F T F T F 
+1203 F T F F T T F 
+1204 F T F T F T F 
+1205 F T F F T T F 
+1206 F T F T F T F 
+1207 F T F F T T F 
+1208 F T F T F T F 
+1209 F T F F T T F 
+1210 F T F T F T F 
+1211 F T F F T T F 
+1212 F T F T F T F 
+1213 F T F F T T F 
+1214 F T F T F T F 
+1215 F T F F T T F 
+1216 F T F T F T F 
+1217 F T F T F T F 
+1218 F T F F T T F 
+1219 F T F T F T F 
+1220 F T F F T T F 
+1221 F T F T F T F 
+1222 F T F F T T F 
+1223 F T F T F T F 
+1224 F T F F T T F 
+1225 F T F T F T F 
+1226 F T F F T T F 
+1227 F T F T F T F 
+1228 F T F F T T F 
+1229 F T F T F T F 
+1230 F T F F T T F 
+1231 F T F F T T F 
+1232 F T F T F T F 
+1233 F T F F T T F 
+1234 F T F T F T F 
+1235 F T F F T T F 
+1236 F T F T F T F 
+1237 F T F F T T F 
+1238 F T F T F T F 
+1239 F T F F T T F 
+1240 F T F T F T F 
+1241 F T F F T T F 
+1242 F T F T F T F 
+1243 F T F F T T F 
+1244 F T F T F T F 
+1245 F T F F T T F 
+1246 F T F T F T F 
+1247 F T F F T T F 
+1248 F T F T F T F 
+1249 F T F F T T F 
+1250 F T F T F T F 
+1251 F T F F T T F 
+1252 F T F T F T F 
+1253 F T F F T T F 
+1254 F T F T F T F 
+1255 F T F F T T F 
+1256 F T F T F T F 
+1257 F T F F T T F 
+1258 F T F T F T F 
+1259 F T F F T T F 
+1260 F T F T F T F 
+1261 F T F F T T F 
+1262 F T F T F T F 
+1263 F T F F T T F 
+1264 F T F T F T F 
+1265 F T F F T T F 
+1266 F T F T F T F 
+1267 F T F F T T F 
+1268 F T F T F T F 
+1269 F T F F T T F 
+1270 F T F T F T F 
+1271 F T F F T T F 
+1272 F T F T F T F 
+1273 F T F F T T F 
+1274 F T F T F T F 
+1275 F T F F T T F 
+1276 F T F T F T F 
+1277 F T F F T T F 
+1278 F T F T F T F 
+1279 F T F F T T F 
+1280 F T F T F T F 
+1281 F T F F T T F 
+1282 F T F T F T F 
+1283 F T F F T T F 
+1284 F T F T F T F 
+1285 F T F F T T F 
+1286 F T F T F T F 
+1287 F T F F T T F 
+1288 F T F T F T F 
+1289 F T F F T T F 
+1290 F T F T F T F 
+1291 F T F F T T F 
+1292 F T F T F T F 
+1293 F T F F T T F 
+1294 F T F T F T F 
+1295 F T F F T T F 
+1296 F T F T F T F 
+1297 F T F F T T F 
+1298 F T F T F T F 
+1299 F T F F T T F 
+1300 F T F T F T F 
+1301 F T F F T T F 
+1302 F T F T F T F 
+1303 F T F F T T F 
+1304 F T F T F T F 
+1305 F T F F T T F 
+1306 F T F T F T F 
+1307 F T F F T T F 
+1308 F T F T F T F 
+1309 F T F F T T F 
+1310 F T F T F T F 
+1311 F T F F T T F 
+1312 F T F T F T F 
+1313 F T F F T T F 
+1314 F T F T F T F 
+1315 F T F F T T F 
+1316 F T F T F T F 
+1317 F T F F T T F 
+1318 F T F T F T F 
+1319 F T F F T T F 
+1320 F F F F F F F 
+1321 F F F F F F F 
+1322 F F F F F F F 
+1323 F F F F F F F 
+1324 F F F F F F F 
+1325 F F F F F F F 
+1326 F F F F F F F 
+1327 F F F F F F F 
+1328 F F F F F F F 
+1329 F T F T F T F 
+1330 F T F T F T F 
+1331 F T F T F T F 
+1332 F T F T F T F 
+1333 F T F T F T F 
+1334 F T F T F T F 
+1335 F T F T F T F 
+1336 F T F T F T F 
+1337 F T F T F T F 
+1338 F T F T F T F 
+1339 F T F T F T F 
+1340 F T F T F T F 
+1341 F T F T F T F 
+1342 F T F T F T F 
+1343 F T F T F T F 
+1344 F T F T F T F 
+1345 F T F T F T F 
+1346 F T F T F T F 
+1347 F T F T F T F 
+1348 F T F T F T F 
+1349 F T F T F T F 
+1350 F T F T F T F 
+1351 F T F T F T F 
+1352 F T F T F T F 
+1353 F T F T F T F 
+1354 F T F T F T F 
+1355 F T F T F T F 
+1356 F T F T F T F 
+1357 F T F T F T F 
+1358 F T F T F T F 
+1359 F T F T F T F 
+1360 F T F T F T F 
+1361 F T F T F T F 
+1362 F T F T F T F 
+1363 F T F T F T F 
+1364 F T F T F T F 
+1365 F T F T F T F 
+1366 F T F T F T F 
+1367 F F F F F F F 
+1368 F F F F F F F 
+1369 F T F F F T F 
+1370 F T F F F F F 
+1371 F T F F F F F 
+1372 F T F F F F F 
+1373 F T F F F F F 
+1374 F T F F F F F 
+1375 F T F F F F F 
+1376 F F F F F F F 
+1377 F T F F T T F 
+1378 F T F F T T F 
+1379 F T F F T T F 
+1380 F T F F T T F 
+1381 F T F F T T F 
+1382 F T F F T T F 
+1383 F T F F T T F 
+1384 F T F F T T F 
+1385 F T F F T T F 
+1386 F T F F T T F 
+1387 F T F F T T F 
+1388 F T F F T T F 
+1389 F T F F T T F 
+1390 F T F F T T F 
+1391 F T F F T T F 
+1392 F T F F T T F 
+1393 F T F F T T F 
+1394 F T F F T T F 
+1395 F T F F T T F 
+1396 F T F F T T F 
+1397 F T F F T T F 
+1398 F T F F T T F 
+1399 F T F F T T F 
+1400 F T F F T T F 
+1401 F T F F T T F 
+1402 F T F F T T F 
+1403 F T F F T T F 
+1404 F T F F T T F 
+1405 F T F F T T F 
+1406 F T F F T T F 
+1407 F T F F T T F 
+1408 F T F F T T F 
+1409 F T F F T T F 
+1410 F T F F T T F 
+1411 F T F F T T F 
+1412 F T F F T T F 
+1413 F T F F T T F 
+1414 F T F F T T F 
+1415 F T F F T T F 
+1416 F F F F F F F 
+1417 F T F F F F F 
+1418 F T F F F F F 
+1419 F F F F F F F 
+1420 F F F F F F F 
+1421 F F F F F F F 
+1422 F F F F F F F 
+1423 F F F F F F F 
+1424 F F F F F F F 
+1425 F T F F F F F 
+1426 F T F F F F F 
+1427 F T F F F F F 
+1428 F T F F F F F 
+1429 F T F F F F F 
+1430 F T F F F F F 
+1431 F T F F F F F 
+1432 F T F F F F F 
+1433 F T F F F F F 
+1434 F T F F F F F 
+1435 F T F F F F F 
+1436 F T F F F F F 
+1437 F T F F F F F 
+1438 F T F F F F F 
+1439 F T F F F F F 
+1440 F T F F F F F 
+1441 F T F F F F F 
+1442 F T F F F F F 
+1443 F T F F F F F 
+1444 F T F F F F F 
+1445 F T F F F F F 
+1446 F T F F F F F 
+1447 F T F F F F F 
+1448 F T F F F F F 
+1449 F T F F F F F 
+1450 F T F F F F F 
+1451 F T F F F F F 
+1452 F T F F F F F 
+1453 F T F F F F F 
+1454 F T F F F F F 
+1455 F T F F F F F 
+1456 F T F F F F F 
+1457 F T F F F F F 
+1458 F T F F F F F 
+1459 F T F F F F F 
+1460 F T F F F F F 
+1461 F T F F F F F 
+1462 F T F F F F F 
+1463 F T F F F F F 
+1464 F T F F F F F 
+1465 F T F F F F F 
+1466 F T F F F F F 
+1467 F T F F F F F 
+1468 F T F F F F F 
+1469 F T F F F F F 
+1470 F T F F F F F 
+1471 F T F F F F F 
+1472 F T F F F F F 
+1473 F T F F F F F 
+1474 F T F F F F F 
+1475 F T F F F F F 
+1476 F T F F F F F 
+1477 F T F F F F F 
+1478 F T F F F F F 
+1479 F T F F F F F 
+1480 F F F F F F F 
+1481 F F F F F F F 
+1482 F F F F F F F 
+1483 F F F F F F F 
+1484 F F F F F F F 
+1485 F F F F F F F 
+1486 F F F F F F F 
+1487 F F F F F F F 
+1488 F T F F F T F 
+1489 F T F F F T F 
+1490 F T F F F T F 
+1491 F T F F F T F 
+1492 F T F F F T F 
+1493 F T F F F T F 
+1494 F T F F F T F 
+1495 F T F F F T F 
+1496 F T F F F T F 
+1497 F T F F F T F 
+1498 F T F F F T F 
+1499 F T F F F T F 
+1500 F T F F F T F 
+1501 F T F F F T F 
+1502 F T F F F T F 
+1503 F T F F F T F 
+1504 F T F F F T F 
+1505 F T F F F T F 
+1506 F T F F F T F 
+1507 F T F F F T F 
+1508 F T F F F T F 
+1509 F T F F F T F 
+1510 F T F F F T F 
+1511 F T F F F T F 
+1512 F T F F F T F 
+1513 F T F F F T F 
+1514 F T F F F T F 
+1515 F F F F F F F 
+1516 F F F F F F F 
+1517 F F F F F F F 
+1518 F F F F F F F 
+1519 F F F F F F F 
+1520 F T F F F T F 
+1521 F T F F F T F 
+1522 F T F F F T F 
+1523 F T F F F F F 
+1524 F T F F F F F 
+1525 F F F F F F F 
+1526 F F F F F F F 
+1527 F F F F F F F 
+1528 F F F F F F F 
+1529 F F F F F F F 
+1530 F F F F F F F 
+1531 F F F F F F F 
+1532 F F F F F F F 
+1533 F F F F F F F 
+1534 F F F F F F F 
+1535 F F F F F F F 
+1536 F F F F F F F 
+1537 F F F F F F F 
+1538 F F F F F F F 
+1539 F F F F F F F 
+1540 F F F F F F F 
+1541 F F F F F F F 
+1542 F T F F F F F 
+1543 F T F F F F F 
+1544 F T F F F F F 
+1545 F T F F F F F 
+1546 F T F F F F F 
+1547 F T F F F F F 
+1548 F T F F F F F 
+1549 F T F F F F F 
+1550 F T F F F F F 
+1551 F T F F F F F 
+1552 F T F F F F F 
+1553 F T F F F F F 
+1554 F T F F F F F 
+1555 F T F F F F F 
+1556 F T F F F F F 
+1557 F T F F F F F 
+1558 F T F F F F F 
+1559 F T F F F F F 
+1560 F T F F F F F 
+1561 F T F F F F F 
+1562 F T F F F F F 
+1563 F T F F F F F 
+1564 F F F F F F F 
+1565 F F F F F F F 
+1566 F T F F F F F 
+1567 F T F F F F F 
+1568 F T F F F T F 
+1569 F T F F F T F 
+1570 F T F F F T F 
+1571 F T F F F T F 
+1572 F T F F F T F 
+1573 F T F F F T F 
+1574 F T F F F T F 
+1575 F T F F F T F 
+1576 F T F F F T F 
+1577 F T F F F T F 
+1578 F T F F F T F 
+1579 F T F F F T F 
+1580 F T F F F T F 
+1581 F T F F F T F 
+1582 F T F F F T F 
+1583 F T F F F T F 
+1584 F T F F F T F 
+1585 F T F F F T F 
+1586 F T F F F T F 
+1587 F T F F F T F 
+1588 F T F F F T F 
+1589 F T F F F T F 
+1590 F T F F F T F 
+1591 F T F F F T F 
+1592 F T F F F T F 
+1593 F T F F F T F 
+1594 F T F F F T F 
+1595 F T F F F T F 
+1596 F T F F F T F 
+1597 F T F F F T F 
+1598 F T F F F T F 
+1599 F T F F F T F 
+1600 F T F F F T F 
+1601 F T F F F T F 
+1602 F T F F F T F 
+1603 F T F F F T F 
+1604 F T F F F T F 
+1605 F T F F F T F 
+1606 F T F F F T F 
+1607 F T F F F T F 
+1608 F T F F F T F 
+1609 F T F F F T F 
+1610 F T F F F T F 
+1611 F T F F F F F 
+1612 F T F F F F F 
+1613 F T F F F F F 
+1614 F T F F F F F 
+1615 F T F F F F F 
+1616 F T F F F F F 
+1617 F T F F F F F 
+1618 F T F F F F F 
+1619 F T F F F F F 
+1620 F T F F F F F 
+1621 F T F F F F F 
+1622 F T F F F F F 
+1623 F T F F F F F 
+1624 F T F F F F F 
+1625 F T F F F F F 
+1626 F T F F F F F 
+1627 F T F F F F F 
+1628 F T F F F F F 
+1629 F T F F F F F 
+1630 F T F F F F F 
+1631 F T F F F F F 
+1632 F T F F F F F 
+1633 F T F F F F F 
+1634 F T F F F F F 
+1635 F T F F F F F 
+1636 F T F F F F F 
+1637 F T F F F F F 
+1638 F T F F F F F 
+1639 F T F F F F F 
+1640 F T F F F F F 
+1641 F T F F F F F 
+1642 F T F F F F F 
+1643 F T F F F F F 
+1644 F T F F F F F 
+1645 F T F F F F F 
+1646 F T F F F T F 
+1647 F T F F F T F 
+1648 F T F F F F F 
+1649 F T F F F T F 
+1650 F T F F F T F 
+1651 F T F F F T F 
+1652 F T F F F T F 
+1653 F T F F F T F 
+1654 F T F F F T F 
+1655 F T F F F T F 
+1656 F T F F F T F 
+1657 F T F F F T F 
+1658 F T F F F T F 
+1659 F T F F F T F 
+1660 F T F F F T F 
+1661 F T F F F T F 
+1662 F T F F F T F 
+1663 F T F F F T F 
+1664 F T F F F T F 
+1665 F T F F F T F 
+1666 F T F F F T F 
+1667 F T F F F T F 
+1668 F T F F F T F 
+1669 F T F F F T F 
+1670 F T F F F T F 
+1671 F T F F F T F 
+1672 F T F F F T F 
+1673 F T F F F T F 
+1674 F T F F F T F 
+1675 F T F F F T F 
+1676 F T F F F T F 
+1677 F T F F F T F 
+1678 F T F F F T F 
+1679 F T F F F T F 
+1680 F T F F F T F 
+1681 F T F F F T F 
+1682 F T F F F T F 
+1683 F T F F F T F 
+1684 F T F F F T F 
+1685 F T F F F T F 
+1686 F T F F F T F 
+1687 F T F F F T F 
+1688 F T F F F T F 
+1689 F T F F F T F 
+1690 F T F F F T F 
+1691 F T F F F T F 
+1692 F T F F F T F 
+1693 F T F F F T F 
+1694 F T F F F T F 
+1695 F T F F F T F 
+1696 F T F F F T F 
+1697 F T F F F T F 
+1698 F T F F F T F 
+1699 F T F F F T F 
+1700 F T F F F T F 
+1701 F T F F F T F 
+1702 F T F F F T F 
+1703 F T F F F T F 
+1704 F T F F F T F 
+1705 F T F F F T F 
+1706 F T F F F T F 
+1707 F T F F F T F 
+1708 F T F F F T F 
+1709 F T F F F T F 
+1710 F T F F F T F 
+1711 F T F F F T F 
+1712 F T F F F T F 
+1713 F T F F F T F 
+1714 F T F F F T F 
+1715 F T F F F T F 
+1716 F T F F F T F 
+1717 F T F F F T F 
+1718 F T F F F T F 
+1719 F T F F F T F 
+1720 F T F F F T F 
+1721 F T F F F T F 
+1722 F T F F F T F 
+1723 F T F F F T F 
+1724 F T F F F T F 
+1725 F T F F F T F 
+1726 F T F F F T F 
+1727 F T F F F T F 
+1728 F T F F F T F 
+1729 F T F F F T F 
+1730 F T F F F T F 
+1731 F T F F F T F 
+1732 F T F F F T F 
+1733 F T F F F T F 
+1734 F T F F F T F 
+1735 F T F F F T F 
+1736 F T F F F T F 
+1737 F T F F F T F 
+1738 F T F F F T F 
+1739 F T F F F T F 
+1740 F T F F F T F 
+1741 F T F F F T F 
+1742 F T F F F T F 
+1743 F T F F F T F 
+1744 F T F F F T F 
+1745 F T F F F T F 
+1746 F T F F F T F 
+1747 F T F F F T F 
+1748 F T F F F F F 
+1749 F T F F F T F 
+1750 F T F F F F F 
+1751 F T F F F F F 
+1752 F T F F F F F 
+1753 F T F F F F F 
+1754 F T F F F F F 
+1755 F T F F F F F 
+1756 F T F F F F F 
+1757 F F F F F F F 
+1758 F T F F F F F 
+1759 F T F F F F F 
+1760 F T F F F F F 
+1761 F T F F F F F 
+1762 F T F F F F F 
+1763 F T F F F F F 
+1764 F T F F F F F 
+1765 F T F F F T F 
+1766 F T F F F T F 
+1767 F T F F F F F 
+1768 F T F F F F F 
+1769 F T F F F F F 
+1770 F T F F F F F 
+1771 F T F F F F F 
+1772 F T F F F F F 
+1773 F T F F F F F 
+1774 F T F F F T F 
+1775 F T F F F T F 
+1776 F T F F F F F 
+1777 F T F F F F F 
+1778 F T F F F F F 
+1779 F T F F F F F 
+1780 F T F F F F F 
+1781 F T F F F F F 
+1782 F T F F F F F 
+1783 F T F F F F F 
+1784 F T F F F F F 
+1785 F T F F F F F 
+1786 F T F F F T F 
+1787 F T F F F T F 
+1788 F T F F F T F 
+1789 F T F F F F F 
+1790 F T F F F F F 
+1791 F T F F F T F 
+1792 F T F F F F F 
+1793 F T F F F F F 
+1794 F T F F F F F 
+1795 F T F F F F F 
+1796 F T F F F F F 
+1797 F T F F F F F 
+1798 F T F F F F F 
+1799 F T F F F F F 
+1800 F T F F F F F 
+1801 F T F F F F F 
+1802 F T F F F F F 
+1803 F T F F F F F 
+1804 F T F F F F F 
+1805 F T F F F F F 
+1806 F F F F F F F 
+1807 F F F F F F F 
+1808 F T F F F T F 
+1809 F T F F F F F 
+1810 F T F F F T F 
+1811 F T F F F T F 
+1812 F T F F F T F 
+1813 F T F F F T F 
+1814 F T F F F T F 
+1815 F T F F F T F 
+1816 F T F F F T F 
+1817 F T F F F T F 
+1818 F T F F F T F 
+1819 F T F F F T F 
+1820 F T F F F T F 
+1821 F T F F F T F 
+1822 F T F F F T F 
+1823 F T F F F T F 
+1824 F T F F F T F 
+1825 F T F F F T F 
+1826 F T F F F T F 
+1827 F T F F F T F 
+1828 F T F F F T F 
+1829 F T F F F T F 
+1830 F T F F F T F 
+1831 F T F F F T F 
+1832 F T F F F T F 
+1833 F T F F F T F 
+1834 F T F F F T F 
+1835 F T F F F T F 
+1836 F T F F F T F 
+1837 F T F F F T F 
+1838 F T F F F T F 
+1839 F T F F F T F 
+1840 F T F F F F F 
+1841 F T F F F F F 
+1842 F T F F F F F 
+1843 F T F F F F F 
+1844 F T F F F F F 
+1845 F T F F F F F 
+1846 F T F F F F F 
+1847 F T F F F F F 
+1848 F T F F F F F 
+1849 F T F F F F F 
+1850 F T F F F F F 
+1851 F T F F F F F 
+1852 F T F F F F F 
+1853 F T F F F F F 
+1854 F T F F F F F 
+1855 F T F F F F F 
+1856 F T F F F F F 
+1857 F T F F F F F 
+1858 F T F F F F F 
+1859 F T F F F F F 
+1860 F T F F F F F 
+1861 F T F F F F F 
+1862 F T F F F F F 
+1863 F T F F F F F 
+1864 F T F F F F F 
+1865 F T F F F F F 
+1866 F T F F F F F 
+1867 F F F F F F F 
+1868 F F F F F F F 
+1869 F T F F F T F 
+1870 F T F F F T F 
+1871 F T F F F T F 
+1872 F T F F F T F 
+1873 F T F F F T F 
+1874 F T F F F T F 
+1875 F T F F F T F 
+1876 F T F F F T F 
+1877 F T F F F T F 
+1878 F T F F F T F 
+1879 F T F F F T F 
+1880 F T F F F T F 
+1881 F T F F F T F 
+1882 F T F F F T F 
+1883 F T F F F T F 
+1884 F T F F F T F 
+1885 F T F F F T F 
+1886 F T F F F T F 
+1887 F T F F F T F 
+1888 F T F F F T F 
+1889 F T F F F T F 
+1890 F T F F F T F 
+1891 F T F F F T F 
+1892 F T F F F T F 
+1893 F T F F F T F 
+1894 F T F F F T F 
+1895 F T F F F T F 
+1896 F T F F F T F 
+1897 F T F F F T F 
+1898 F T F F F T F 
+1899 F T F F F T F 
+1900 F T F F F T F 
+1901 F T F F F T F 
+1902 F T F F F T F 
+1903 F T F F F T F 
+1904 F T F F F T F 
+1905 F T F F F T F 
+1906 F T F F F T F 
+1907 F T F F F T F 
+1908 F T F F F T F 
+1909 F T F F F T F 
+1910 F T F F F T F 
+1911 F T F F F T F 
+1912 F T F F F T F 
+1913 F T F F F T F 
+1914 F T F F F T F 
+1915 F T F F F T F 
+1916 F T F F F T F 
+1917 F T F F F T F 
+1918 F T F F F T F 
+1919 F T F F F T F 
+1920 F T F F F T F 
+1921 F T F F F T F 
+1922 F T F F F T F 
+1923 F T F F F T F 
+1924 F T F F F T F 
+1925 F T F F F T F 
+1926 F T F F F T F 
+1927 F T F F F T F 
+1928 F T F F F T F 
+1929 F T F F F T F 
+1930 F T F F F T F 
+1931 F T F F F T F 
+1932 F T F F F T F 
+1933 F T F F F T F 
+1934 F T F F F T F 
+1935 F T F F F T F 
+1936 F T F F F T F 
+1937 F T F F F T F 
+1938 F T F F F T F 
+1939 F T F F F T F 
+1940 F T F F F T F 
+1941 F T F F F T F 
+1942 F T F F F T F 
+1943 F T F F F T F 
+1944 F T F F F T F 
+1945 F T F F F T F 
+1946 F T F F F T F 
+1947 F T F F F T F 
+1948 F T F F F T F 
+1949 F T F F F T F 
+1950 F T F F F T F 
+1951 F T F F F T F 
+1952 F T F F F T F 
+1953 F T F F F T F 
+1954 F T F F F T F 
+1955 F T F F F T F 
+1956 F T F F F T F 
+1957 F T F F F T F 
+1958 F T F F F F F 
+1959 F T F F F F F 
+1960 F T F F F F F 
+1961 F T F F F F F 
+1962 F T F F F F F 
+1963 F T F F F F F 
+1964 F T F F F F F 
+1965 F T F F F F F 
+1966 F T F F F F F 
+1967 F T F F F F F 
+1968 F T F F F F F 
+1969 F T F F F T F 
+1970 F F F F F F F 
+1971 F F F F F F F 
+1972 F F F F F F F 
+1973 F F F F F F F 
+1974 F F F F F F F 
+1975 F F F F F F F 
+1976 F F F F F F F 
+1977 F F F F F F F 
+1978 F F F F F F F 
+1979 F F F F F F F 
+1980 F F F F F F F 
+1981 F F F F F F F 
+1982 F F F F F F F 
+1983 F F F F F F F 
+1984 F T F F F F F 
+1985 F T F F F F F 
+1986 F T F F F F F 
+1987 F T F F F F F 
+1988 F T F F F F F 
+1989 F T F F F F F 
+1990 F T F F F F F 
+1991 F T F F F F F 
+1992 F T F F F F F 
+1993 F T F F F F F 
+1994 F T F F F T F 
+1995 F T F F F T F 
+1996 F T F F F T F 
+1997 F T F F F T F 
+1998 F T F F F T F 
+1999 F T F F F T F 
+2000 F T F F F T F 
+2001 F T F F F T F 
+2002 F T F F F T F 
+2003 F T F F F T F 
+2004 F T F F F T F 
+2005 F T F F F T F 
+2006 F T F F F T F 
+2007 F T F F F T F 
+2008 F T F F F T F 
+2009 F T F F F T F 
+2010 F T F F F T F 
+2011 F T F F F T F 
+2012 F T F F F T F 
+2013 F T F F F T F 
+2014 F T F F F T F 
+2015 F T F F F T F 
+2016 F T F F F T F 
+2017 F T F F F T F 
+2018 F T F F F T F 
+2019 F T F F F T F 
+2020 F T F F F T F 
+2021 F T F F F T F 
+2022 F T F F F T F 
+2023 F T F F F T F 
+2024 F T F F F T F 
+2025 F T F F F T F 
+2026 F T F F F T F 
+2027 F T F F F F F 
+2028 F T F F F F F 
+2029 F T F F F F F 
+2030 F T F F F F F 
+2031 F T F F F F F 
+2032 F T F F F F F 
+2033 F T F F F F F 
+2034 F T F F F F F 
+2035 F T F F F F F 
+2036 F T F F F T F 
+2037 F T F F F T F 
+2038 F T F F F F F 
+2039 F T F F F F F 
+2040 F T F F F F F 
+2041 F T F F F F F 
+2042 F T F F F T F 
+2043 F F F F F F F 
+2044 F F F F F F F 
+2045 F F F F F F F 
+2046 F F F F F F F 
+2047 F F F F F F F 
+2048 F T F F F T F 
+2049 F T F F F T F 
+2050 F T F F F T F 
+2051 F T F F F T F 
+2052 F T F F F T F 
+2053 F T F F F T F 
+2054 F T F F F T F 
+2055 F T F F F T F 
+2056 F T F F F T F 
+2057 F T F F F T F 
+2058 F T F F F T F 
+2059 F T F F F T F 
+2060 F T F F F T F 
+2061 F T F F F T F 
+2062 F T F F F T F 
+2063 F T F F F T F 
+2064 F T F F F T F 
+2065 F T F F F T F 
+2066 F T F F F T F 
+2067 F T F F F T F 
+2068 F T F F F T F 
+2069 F T F F F T F 
+2070 F T F F F F F 
+2071 F T F F F F F 
+2072 F T F F F F F 
+2073 F T F F F F F 
+2074 F T F F F T F 
+2075 F T F F F F F 
+2076 F T F F F F F 
+2077 F T F F F F F 
+2078 F T F F F F F 
+2079 F T F F F F F 
+2080 F T F F F F F 
+2081 F T F F F F F 
+2082 F T F F F F F 
+2083 F T F F F F F 
+2084 F T F F F T F 
+2085 F T F F F F F 
+2086 F T F F F F F 
+2087 F T F F F F F 
+2088 F T F F F T F 
+2089 F T F F F F F 
+2090 F T F F F F F 
+2091 F T F F F F F 
+2092 F T F F F F F 
+2093 F T F F F F F 
+2094 F F F F F F F 
+2095 F F F F F F F 
+2096 F T F F F F F 
+2097 F T F F F F F 
+2098 F T F F F F F 
+2099 F T F F F F F 
+2100 F T F F F F F 
+2101 F T F F F F F 
+2102 F T F F F F F 
+2103 F T F F F F F 
+2104 F T F F F F F 
+2105 F T F F F F F 
+2106 F T F F F F F 
+2107 F T F F F F F 
+2108 F T F F F F F 
+2109 F T F F F F F 
+2110 F T F F F F F 
+2111 F F F F F F F 
+2112 F T F F F T F 
+2113 F T F F F T F 
+2114 F T F F F T F 
+2115 F T F F F T F 
+2116 F T F F F T F 
+2117 F T F F F T F 
+2118 F T F F F T F 
+2119 F T F F F T F 
+2120 F T F F F T F 
+2121 F T F F F T F 
+2122 F T F F F T F 
+2123 F T F F F T F 
+2124 F T F F F T F 
+2125 F T F F F T F 
+2126 F T F F F T F 
+2127 F T F F F T F 
+2128 F T F F F T F 
+2129 F T F F F T F 
+2130 F T F F F T F 
+2131 F T F F F T F 
+2132 F T F F F T F 
+2133 F T F F F T F 
+2134 F T F F F T F 
+2135 F T F F F T F 
+2136 F T F F F T F 
+2137 F T F F F F F 
+2138 F T F F F F F 
+2139 F T F F F F F 
+2140 F F F F F F F 
+2141 F F F F F F F 
+2142 F T F F F F F 
+2143 F F F F F F F 
+2144 F F F F F F F 
+2145 F F F F F F F 
+2146 F F F F F F F 
+2147 F F F F F F F 
+2148 F F F F F F F 
+2149 F F F F F F F 
+2150 F F F F F F F 
+2151 F F F F F F F 
+2152 F F F F F F F 
+2153 F F F F F F F 
+2154 F F F F F F F 
+2155 F F F F F F F 
+2156 F F F F F F F 
+2157 F F F F F F F 
+2158 F F F F F F F 
+2159 F F F F F F F 
+2160 F F F F F F F 
+2161 F F F F F F F 
+2162 F F F F F F F 
+2163 F F F F F F F 
+2164 F F F F F F F 
+2165 F F F F F F F 
+2166 F F F F F F F 
+2167 F F F F F F F 
+2168 F F F F F F F 
+2169 F F F F F F F 
+2170 F F F F F F F 
+2171 F F F F F F F 
+2172 F F F F F F F 
+2173 F F F F F F F 
+2174 F F F F F F F 
+2175 F F F F F F F 
+2176 F F F F F F F 
+2177 F F F F F F F 
+2178 F F F F F F F 
+2179 F F F F F F F 
+2180 F F F F F F F 
+2181 F F F F F F F 
+2182 F F F F F F F 
+2183 F F F F F F F 
+2184 F F F F F F F 
+2185 F F F F F F F 
+2186 F F F F F F F 
+2187 F F F F F F F 
+2188 F F F F F F F 
+2189 F F F F F F F 
+2190 F F F F F F F 
+2191 F F F F F F F 
+2192 F F F F F F F 
+2193 F F F F F F F 
+2194 F F F F F F F 
+2195 F F F F F F F 
+2196 F F F F F F F 
+2197 F F F F F F F 
+2198 F F F F F F F 
+2199 F F F F F F F 
+2200 F F F F F F F 
+2201 F F F F F F F 
+2202 F F F F F F F 
+2203 F F F F F F F 
+2204 F F F F F F F 
+2205 F F F F F F F 
+2206 F F F F F F F 
+2207 F F F F F F F 
+2208 F F F F F F F 
+2209 F F F F F F F 
+2210 F F F F F F F 
+2211 F F F F F F F 
+2212 F F F F F F F 
+2213 F F F F F F F 
+2214 F F F F F F F 
+2215 F F F F F F F 
+2216 F F F F F F F 
+2217 F F F F F F F 
+2218 F F F F F F F 
+2219 F F F F F F F 
+2220 F F F F F F F 
+2221 F F F F F F F 
+2222 F F F F F F F 
+2223 F F F F F F F 
+2224 F F F F F F F 
+2225 F F F F F F F 
+2226 F F F F F F F 
+2227 F F F F F F F 
+2228 F F F F F F F 
+2229 F F F F F F F 
+2230 F F F F F F F 
+2231 F F F F F F F 
+2232 F F F F F F F 
+2233 F F F F F F F 
+2234 F F F F F F F 
+2235 F F F F F F F 
+2236 F F F F F F F 
+2237 F F F F F F F 
+2238 F F F F F F F 
+2239 F F F F F F F 
+2240 F F F F F F F 
+2241 F F F F F F F 
+2242 F F F F F F F 
+2243 F F F F F F F 
+2244 F F F F F F F 
+2245 F F F F F F F 
+2246 F F F F F F F 
+2247 F F F F F F F 
+2248 F F F F F F F 
+2249 F F F F F F F 
+2250 F F F F F F F 
+2251 F F F F F F F 
+2252 F F F F F F F 
+2253 F F F F F F F 
+2254 F F F F F F F 
+2255 F F F F F F F 
+2256 F F F F F F F 
+2257 F F F F F F F 
+2258 F F F F F F F 
+2259 F F F F F F F 
+2260 F F F F F F F 
+2261 F F F F F F F 
+2262 F F F F F F F 
+2263 F F F F F F F 
+2264 F F F F F F F 
+2265 F F F F F F F 
+2266 F F F F F F F 
+2267 F F F F F F F 
+2268 F F F F F F F 
+2269 F F F F F F F 
+2270 F F F F F F F 
+2271 F F F F F F F 
+2272 F F F F F F F 
+2273 F F F F F F F 
+2274 F F F F F F F 
+2275 F F F F F F F 
+2276 F F F F F F F 
+2277 F F F F F F F 
+2278 F F F F F F F 
+2279 F F F F F F F 
+2280 F F F F F F F 
+2281 F F F F F F F 
+2282 F F F F F F F 
+2283 F F F F F F F 
+2284 F F F F F F F 
+2285 F F F F F F F 
+2286 F F F F F F F 
+2287 F F F F F F F 
+2288 F F F F F F F 
+2289 F F F F F F F 
+2290 F F F F F F F 
+2291 F F F F F F F 
+2292 F F F F F F F 
+2293 F F F F F F F 
+2294 F F F F F F F 
+2295 F F F F F F F 
+2296 F F F F F F F 
+2297 F F F F F F F 
+2298 F F F F F F F 
+2299 F F F F F F F 
+2300 F F F F F F F 
+2301 F F F F F F F 
+2302 F F F F F F F 
+2303 F F F F F F F 
+2304 F T F F F F F 
+2305 F T F F F F F 
+2306 F T F F F F F 
+2307 F T F F F F F 
+2308 F T F F F T F 
+2309 F T F F F T F 
+2310 F T F F F T F 
+2311 F T F F F T F 
+2312 F T F F F T F 
+2313 F T F F F T F 
+2314 F T F F F T F 
+2315 F T F F F T F 
+2316 F T F F F T F 
+2317 F T F F F T F 
+2318 F T F F F T F 
+2319 F T F F F T F 
+2320 F T F F F T F 
+2321 F T F F F T F 
+2322 F T F F F T F 
+2323 F T F F F T F 
+2324 F T F F F T F 
+2325 F T F F F T F 
+2326 F T F F F T F 
+2327 F T F F F T F 
+2328 F T F F F T F 
+2329 F T F F F T F 
+2330 F T F F F T F 
+2331 F T F F F T F 
+2332 F T F F F T F 
+2333 F T F F F T F 
+2334 F T F F F T F 
+2335 F T F F F T F 
+2336 F T F F F T F 
+2337 F T F F F T F 
+2338 F T F F F T F 
+2339 F T F F F T F 
+2340 F T F F F T F 
+2341 F T F F F T F 
+2342 F T F F F T F 
+2343 F T F F F T F 
+2344 F T F F F T F 
+2345 F T F F F T F 
+2346 F T F F F T F 
+2347 F T F F F T F 
+2348 F T F F F T F 
+2349 F T F F F T F 
+2350 F T F F F T F 
+2351 F T F F F T F 
+2352 F T F F F T F 
+2353 F T F F F T F 
+2354 F T F F F T F 
+2355 F T F F F T F 
+2356 F T F F F T F 
+2357 F T F F F T F 
+2358 F T F F F T F 
+2359 F T F F F T F 
+2360 F T F F F T F 
+2361 F T F F F T F 
+2362 F T F F F F F 
+2363 F T F F F F F 
+2364 F T F F F F F 
+2365 F T F F F T F 
+2366 F T F F F F F 
+2367 F T F F F F F 
+2368 F T F F F F F 
+2369 F T F F F F F 
+2370 F T F F F F F 
+2371 F T F F F F F 
+2372 F T F F F F F 
+2373 F T F F F F F 
+2374 F T F F F F F 
+2375 F T F F F F F 
+2376 F T F F F F F 
+2377 F T F F F F F 
+2378 F T F F F F F 
+2379 F T F F F F F 
+2380 F T F F F F F 
+2381 F T F F F F F 
+2382 F T F F F F F 
+2383 F T F F F F F 
+2384 F T F F F T F 
+2385 F T F F F F F 
+2386 F T F F F F F 
+2387 F T F F F F F 
+2388 F T F F F F F 
+2389 F T F F F F F 
+2390 F T F F F F F 
+2391 F T F F F F F 
+2392 F T F F F T F 
+2393 F T F F F T F 
+2394 F T F F F T F 
+2395 F T F F F T F 
+2396 F T F F F T F 
+2397 F T F F F T F 
+2398 F T F F F T F 
+2399 F T F F F T F 
+2400 F T F F F T F 
+2401 F T F F F T F 
+2402 F T F F F F F 
+2403 F T F F F F F 
+2404 F T F F F F F 
+2405 F T F F F F F 
+2406 F T F F F F F 
+2407 F T F F F F F 
+2408 F T F F F F F 
+2409 F T F F F F F 
+2410 F T F F F F F 
+2411 F T F F F F F 
+2412 F T F F F F F 
+2413 F T F F F F F 
+2414 F T F F F F F 
+2415 F T F F F F F 
+2416 F T F F F F F 
+2417 F T F F F T F 
+2418 F T F F F T F 
+2419 F T F F F T F 
+2420 F T F F F T F 
+2421 F T F F F T F 
+2422 F T F F F T F 
+2423 F T F F F T F 
+2424 F F F F F F F 
+2425 F T F F F T F 
+2426 F T F F F T F 
+2427 F T F F F T F 
+2428 F T F F F T F 
+2429 F T F F F T F 
+2430 F T F F F T F 
+2431 F T F F F T F 
+2432 F F F F F F F 
+2433 F T F F F F F 
+2434 F T F F F F F 
+2435 F T F F F F F 
+2436 F F F F F F F 
+2437 F T F F F T F 
+2438 F T F F F T F 
+2439 F T F F F T F 
+2440 F T F F F T F 
+2441 F T F F F T F 
+2442 F T F F F T F 
+2443 F T F F F T F 
+2444 F T F F F T F 
+2445 F F F F F F F 
+2446 F F F F F F F 
+2447 F T F F F T F 
+2448 F T F F F T F 
+2449 F F F F F F F 
+2450 F F F F F F F 
+2451 F T F F F T F 
+2452 F T F F F T F 
+2453 F T F F F T F 
+2454 F T F F F T F 
+2455 F T F F F T F 
+2456 F T F F F T F 
+2457 F T F F F T F 
+2458 F T F F F T F 
+2459 F T F F F T F 
+2460 F T F F F T F 
+2461 F T F F F T F 
+2462 F T F F F T F 
+2463 F T F F F T F 
+2464 F T F F F T F 
+2465 F T F F F T F 
+2466 F T F F F T F 
+2467 F T F F F T F 
+2468 F T F F F T F 
+2469 F T F F F T F 
+2470 F T F F F T F 
+2471 F T F F F T F 
+2472 F T F F F T F 
+2473 F F F F F F F 
+2474 F T F F F T F 
+2475 F T F F F T F 
+2476 F T F F F T F 
+2477 F T F F F T F 
+2478 F T F F F T F 
+2479 F T F F F T F 
+2480 F T F F F T F 
+2481 F F F F F F F 
+2482 F T F F F T F 
+2483 F F F F F F F 
+2484 F F F F F F F 
+2485 F F F F F F F 
+2486 F T F F F T F 
+2487 F T F F F T F 
+2488 F T F F F T F 
+2489 F T F F F T F 
+2490 F F F F F F F 
+2491 F F F F F F F 
+2492 F T F F F F F 
+2493 F T F F F T F 
+2494 F T F F F F F 
+2495 F T F F F F F 
+2496 F T F F F F F 
+2497 F T F F F F F 
+2498 F T F F F F F 
+2499 F T F F F F F 
+2500 F T F F F F F 
+2501 F F F F F F F 
+2502 F F F F F F F 
+2503 F T F F F F F 
+2504 F T F F F F F 
+2505 F F F F F F F 
+2506 F F F F F F F 
+2507 F T F F F F F 
+2508 F T F F F F F 
+2509 F T F F F F F 
+2510 F T F F F T F 
+2511 F F F F F F F 
+2512 F F F F F F F 
+2513 F F F F F F F 
+2514 F F F F F F F 
+2515 F F F F F F F 
+2516 F F F F F F F 
+2517 F F F F F F F 
+2518 F F F F F F F 
+2519 F T F F F F F 
+2520 F F F F F F F 
+2521 F F F F F F F 
+2522 F F F F F F F 
+2523 F F F F F F F 
+2524 F T F F F T F 
+2525 F T F F F T F 
+2526 F F F F F F F 
+2527 F T F F F T F 
+2528 F T F F F T F 
+2529 F T F F F T F 
+2530 F T F F F F F 
+2531 F T F F F F F 
+2532 F F F F F F F 
+2533 F F F F F F F 
+2534 F T F F F F F 
+2535 F T F F F F F 
+2536 F T F F F F F 
+2537 F T F F F F F 
+2538 F T F F F F F 
+2539 F T F F F F F 
+2540 F T F F F F F 
+2541 F T F F F F F 
+2542 F T F F F F F 
+2543 F T F F F F F 
+2544 F T F F F T F 
+2545 F T F F F T F 
+2546 F T F F F F F 
+2547 F T F F F F F 
+2548 F T F F F F F 
+2549 F T F F F F F 
+2550 F T F F F F F 
+2551 F T F F F F F 
+2552 F T F F F F F 
+2553 F T F F F F F 
+2554 F T F F F F F 
+2555 F T F F F F F 
+2556 F F F F F F F 
+2557 F F F F F F F 
+2558 F F F F F F F 
+2559 F F F F F F F 
+2560 F F F F F F F 
+2561 F T F F F F F 
+2562 F T F F F F F 
+2563 F T F F F F F 
+2564 F F F F F F F 
+2565 F T F F F T F 
+2566 F T F F F T F 
+2567 F T F F F T F 
+2568 F T F F F T F 
+2569 F T F F F T F 
+2570 F T F F F T F 
+2571 F F F F F F F 
+2572 F F F F F F F 
+2573 F F F F F F F 
+2574 F F F F F F F 
+2575 F T F F F T F 
+2576 F T F F F T F 
+2577 F F F F F F F 
+2578 F F F F F F F 
+2579 F T F F F T F 
+2580 F T F F F T F 
+2581 F T F F F T F 
+2582 F T F F F T F 
+2583 F T F F F T F 
+2584 F T F F F T F 
+2585 F T F F F T F 
+2586 F T F F F T F 
+2587 F T F F F T F 
+2588 F T F F F T F 
+2589 F T F F F T F 
+2590 F T F F F T F 
+2591 F T F F F T F 
+2592 F T F F F T F 
+2593 F T F F F T F 
+2594 F T F F F T F 
+2595 F T F F F T F 
+2596 F T F F F T F 
+2597 F T F F F T F 
+2598 F T F F F T F 
+2599 F T F F F T F 
+2600 F T F F F T F 
+2601 F F F F F F F 
+2602 F T F F F T F 
+2603 F T F F F T F 
+2604 F T F F F T F 
+2605 F T F F F T F 
+2606 F T F F F T F 
+2607 F T F F F T F 
+2608 F T F F F T F 
+2609 F F F F F F F 
+2610 F T F F F T F 
+2611 F T F F F T F 
+2612 F F F F F F F 
+2613 F T F F F T F 
+2614 F T F F F T F 
+2615 F F F F F F F 
+2616 F T F F F T F 
+2617 F T F F F T F 
+2618 F F F F F F F 
+2619 F F F F F F F 
+2620 F T F F F F F 
+2621 F F F F F F F 
+2622 F T F F F F F 
+2623 F T F F F F F 
+2624 F T F F F F F 
+2625 F T F F F F F 
+2626 F T F F F F F 
+2627 F F F F F F F 
+2628 F F F F F F F 
+2629 F F F F F F F 
+2630 F F F F F F F 
+2631 F T F F F F F 
+2632 F T F F F F F 
+2633 F F F F F F F 
+2634 F F F F F F F 
+2635 F T F F F F F 
+2636 F T F F F F F 
+2637 F T F F F F F 
+2638 F F F F F F F 
+2639 F F F F F F F 
+2640 F F F F F F F 
+2641 F T F F F F F 
+2642 F F F F F F F 
+2643 F F F F F F F 
+2644 F F F F F F F 
+2645 F F F F F F F 
+2646 F F F F F F F 
+2647 F F F F F F F 
+2648 F F F F F F F 
+2649 F T F F F T F 
+2650 F T F F F T F 
+2651 F T F F F T F 
+2652 F T F F F T F 
+2653 F F F F F F F 
+2654 F T F F F T F 
+2655 F F F F F F F 
+2656 F F F F F F F 
+2657 F F F F F F F 
+2658 F F F F F F F 
+2659 F F F F F F F 
+2660 F F F F F F F 
+2661 F F F F F F F 
+2662 F T F F F F F 
+2663 F T F F F F F 
+2664 F T F F F F F 
+2665 F T F F F F F 
+2666 F T F F F F F 
+2667 F T F F F F F 
+2668 F T F F F F F 
+2669 F T F F F F F 
+2670 F T F F F F F 
+2671 F T F F F F F 
+2672 F T F F F F F 
+2673 F T F F F F F 
+2674 F T F F F T F 
+2675 F T F F F T F 
+2676 F T F F F T F 
+2677 F T F F F F F 
+2678 F F F F F F F 
+2679 F F F F F F F 
+2680 F F F F F F F 
+2681 F F F F F F F 
+2682 F F F F F F F 
+2683 F F F F F F F 
+2684 F F F F F F F 
+2685 F F F F F F F 
+2686 F F F F F F F 
+2687 F F F F F F F 
+2688 F F F F F F F 
+2689 F T F F F F F 
+2690 F T F F F F F 
+2691 F T F F F F F 
+2692 F F F F F F F 
+2693 F T F F F T F 
+2694 F T F F F T F 
+2695 F T F F F T F 
+2696 F T F F F T F 
+2697 F T F F F T F 
+2698 F T F F F T F 
+2699 F T F F F T F 
+2700 F T F F F T F 
+2701 F T F F F T F 
+2702 F F F F F F F 
+2703 F T F F F T F 
+2704 F T F F F T F 
+2705 F T F F F T F 
+2706 F F F F F F F 
+2707 F T F F F T F 
+2708 F T F F F T F 
+2709 F T F F F T F 
+2710 F T F F F T F 
+2711 F T F F F T F 
+2712 F T F F F T F 
+2713 F T F F F T F 
+2714 F T F F F T F 
+2715 F T F F F T F 
+2716 F T F F F T F 
+2717 F T F F F T F 
+2718 F T F F F T F 
+2719 F T F F F T F 
+2720 F T F F F T F 
+2721 F T F F F T F 
+2722 F T F F F T F 
+2723 F T F F F T F 
+2724 F T F F F T F 
+2725 F T F F F T F 
+2726 F T F F F T F 
+2727 F T F F F T F 
+2728 F T F F F T F 
+2729 F F F F F F F 
+2730 F T F F F T F 
+2731 F T F F F T F 
+2732 F T F F F T F 
+2733 F T F F F T F 
+2734 F T F F F T F 
+2735 F T F F F T F 
+2736 F T F F F T F 
+2737 F F F F F F F 
+2738 F T F F F T F 
+2739 F T F F F T F 
+2740 F F F F F F F 
+2741 F T F F F T F 
+2742 F T F F F T F 
+2743 F T F F F T F 
+2744 F T F F F T F 
+2745 F T F F F T F 
+2746 F F F F F F F 
+2747 F F F F F F F 
+2748 F T F F F F F 
+2749 F T F F F T F 
+2750 F T F F F F F 
+2751 F T F F F F F 
+2752 F T F F F F F 
+2753 F T F F F F F 
+2754 F T F F F F F 
+2755 F T F F F F F 
+2756 F T F F F F F 
+2757 F T F F F F F 
+2758 F F F F F F F 
+2759 F T F F F F F 
+2760 F T F F F F F 
+2761 F T F F F F F 
+2762 F F F F F F F 
+2763 F T F F F F F 
+2764 F T F F F F F 
+2765 F T F F F F F 
+2766 F F F F F F F 
+2767 F F F F F F F 
+2768 F T F F F T F 
+2769 F F F F F F F 
+2770 F F F F F F F 
+2771 F F F F F F F 
+2772 F F F F F F F 
+2773 F F F F F F F 
+2774 F F F F F F F 
+2775 F F F F F F F 
+2776 F F F F F F F 
+2777 F F F F F F F 
+2778 F F F F F F F 
+2779 F F F F F F F 
+2780 F F F F F F F 
+2781 F F F F F F F 
+2782 F F F F F F F 
+2783 F F F F F F F 
+2784 F T F F F T F 
+2785 F T F F F T F 
+2786 F T F F F F F 
+2787 F T F F F F F 
+2788 F F F F F F F 
+2789 F F F F F F F 
+2790 F T F F F F F 
+2791 F T F F F F F 
+2792 F T F F F F F 
+2793 F T F F F F F 
+2794 F T F F F F F 
+2795 F T F F F F F 
+2796 F T F F F F F 
+2797 F T F F F F F 
+2798 F T F F F F F 
+2799 F T F F F F F 
+2800 F F F F F F F 
+2801 F T F F F F F 
+2802 F F F F F F F 
+2803 F F F F F F F 
+2804 F F F F F F F 
+2805 F F F F F F F 
+2806 F F F F F F F 
+2807 F F F F F F F 
+2808 F F F F F F F 
+2809 F F F F F F F 
+2810 F F F F F F F 
+2811 F F F F F F F 
+2812 F F F F F F F 
+2813 F F F F F F F 
+2814 F F F F F F F 
+2815 F F F F F F F 
+2816 F F F F F F F 
+2817 F T F F F F F 
+2818 F T F F F F F 
+2819 F T F F F F F 
+2820 F F F F F F F 
+2821 F T F F F T F 
+2822 F T F F F T F 
+2823 F T F F F T F 
+2824 F T F F F T F 
+2825 F T F F F T F 
+2826 F T F F F T F 
+2827 F T F F F T F 
+2828 F T F F F T F 
+2829 F F F F F F F 
+2830 F F F F F F F 
+2831 F T F F F T F 
+2832 F T F F F T F 
+2833 F F F F F F F 
+2834 F F F F F F F 
+2835 F T F F F T F 
+2836 F T F F F T F 
+2837 F T F F F T F 
+2838 F T F F F T F 
+2839 F T F F F T F 
+2840 F T F F F T F 
+2841 F T F F F T F 
+2842 F T F F F T F 
+2843 F T F F F T F 
+2844 F T F F F T F 
+2845 F T F F F T F 
+2846 F T F F F T F 
+2847 F T F F F T F 
+2848 F T F F F T F 
+2849 F T F F F T F 
+2850 F T F F F T F 
+2851 F T F F F T F 
+2852 F T F F F T F 
+2853 F T F F F T F 
+2854 F T F F F T F 
+2855 F T F F F T F 
+2856 F T F F F T F 
+2857 F F F F F F F 
+2858 F T F F F T F 
+2859 F T F F F T F 
+2860 F T F F F T F 
+2861 F T F F F T F 
+2862 F T F F F T F 
+2863 F T F F F T F 
+2864 F T F F F T F 
+2865 F F F F F F F 
+2866 F T F F F T F 
+2867 F T F F F T F 
+2868 F F F F F F F 
+2869 F T F F F T F 
+2870 F T F F F T F 
+2871 F T F F F T F 
+2872 F T F F F T F 
+2873 F T F F F T F 
+2874 F F F F F F F 
+2875 F F F F F F F 
+2876 F T F F F F F 
+2877 F T F F F T F 
+2878 F T F F F F F 
+2879 F T F F F F F 
+2880 F T F F F F F 
+2881 F T F F F F F 
+2882 F T F F F F F 
+2883 F T F F F F F 
+2884 F T F F F F F 
+2885 F F F F F F F 
+2886 F F F F F F F 
+2887 F T F F F F F 
+2888 F T F F F F F 
+2889 F F F F F F F 
+2890 F F F F F F F 
+2891 F T F F F F F 
+2892 F T F F F F F 
+2893 F T F F F F F 
+2894 F F F F F F F 
+2895 F F F F F F F 
+2896 F F F F F F F 
+2897 F F F F F F F 
+2898 F F F F F F F 
+2899 F F F F F F F 
+2900 F F F F F F F 
+2901 F F F F F F F 
+2902 F T F F F F F 
+2903 F T F F F F F 
+2904 F F F F F F F 
+2905 F F F F F F F 
+2906 F F F F F F F 
+2907 F F F F F F F 
+2908 F T F F F T F 
+2909 F T F F F T F 
+2910 F F F F F F F 
+2911 F T F F F T F 
+2912 F T F F F T F 
+2913 F T F F F T F 
+2914 F T F F F F F 
+2915 F T F F F F F 
+2916 F F F F F F F 
+2917 F F F F F F F 
+2918 F T F F F F F 
+2919 F T F F F F F 
+2920 F T F F F F F 
+2921 F T F F F F F 
+2922 F T F F F F F 
+2923 F T F F F F F 
+2924 F T F F F F F 
+2925 F T F F F F F 
+2926 F T F F F F F 
+2927 F T F F F F F 
+2928 F T F F F F F 
+2929 F T F F F T F 
+2930 F T F F F F F 
+2931 F T F F F F F 
+2932 F T F F F F F 
+2933 F T F F F F F 
+2934 F T F F F F F 
+2935 F T F F F F F 
+2936 F F F F F F F 
+2937 F F F F F F F 
+2938 F F F F F F F 
+2939 F F F F F F F 
+2940 F F F F F F F 
+2941 F F F F F F F 
+2942 F F F F F F F 
+2943 F F F F F F F 
+2944 F F F F F F F 
+2945 F F F F F F F 
+2946 F T F F F F F 
+2947 F T F F F T F 
+2948 F F F F F F F 
+2949 F T F F F T F 
+2950 F T F F F T F 
+2951 F T F F F T F 
+2952 F T F F F T F 
+2953 F T F F F T F 
+2954 F T F F F T F 
+2955 F F F F F F F 
+2956 F F F F F F F 
+2957 F F F F F F F 
+2958 F T F F F T F 
+2959 F T F F F T F 
+2960 F T F F F T F 
+2961 F F F F F F F 
+2962 F T F F F T F 
+2963 F T F F F T F 
+2964 F T F F F T F 
+2965 F T F F F T F 
+2966 F F F F F F F 
+2967 F F F F F F F 
+2968 F F F F F F F 
+2969 F T F F F T F 
+2970 F T F F F T F 
+2971 F F F F F F F 
+2972 F T F F F T F 
+2973 F F F F F F F 
+2974 F T F F F T F 
+2975 F T F F F T F 
+2976 F F F F F F F 
+2977 F F F F F F F 
+2978 F F F F F F F 
+2979 F T F F F T F 
+2980 F T F F F T F 
+2981 F F F F F F F 
+2982 F F F F F F F 
+2983 F F F F F F F 
+2984 F T F F F T F 
+2985 F T F F F T F 
+2986 F T F F F T F 
+2987 F F F F F F F 
+2988 F F F F F F F 
+2989 F F F F F F F 
+2990 F T F F F T F 
+2991 F T F F F T F 
+2992 F T F F F T F 
+2993 F T F F F T F 
+2994 F T F F F T F 
+2995 F T F F F T F 
+2996 F T F F F T F 
+2997 F T F F F T F 
+2998 F T F F F T F 
+2999 F T F F F T F 
+3000 F T F F F T F 
+3001 F T F F F T F 
+3002 F F F F F F F 
+3003 F F F F F F F 
+3004 F F F F F F F 
+3005 F F F F F F F 
+3006 F T F F F F F 
+3007 F T F F F F F 
+3008 F T F F F F F 
+3009 F T F F F F F 
+3010 F T F F F F F 
+3011 F F F F F F F 
+3012 F F F F F F F 
+3013 F F F F F F F 
+3014 F T F F F F F 
+3015 F T F F F F F 
+3016 F T F F F F F 
+3017 F F F F F F F 
+3018 F T F F F F F 
+3019 F T F F F F F 
+3020 F T F F F F F 
+3021 F T F F F F F 
+3022 F F F F F F F 
+3023 F F F F F F F 
+3024 F T F F F T F 
+3025 F F F F F F F 
+3026 F F F F F F F 
+3027 F F F F F F F 
+3028 F F F F F F F 
+3029 F F F F F F F 
+3030 F F F F F F F 
+3031 F T F F F F F 
+3032 F F F F F F F 
+3033 F F F F F F F 
+3034 F F F F F F F 
+3035 F F F F F F F 
+3036 F F F F F F F 
+3037 F F F F F F F 
+3038 F F F F F F F 
+3039 F F F F F F F 
+3040 F F F F F F F 
+3041 F F F F F F F 
+3042 F F F F F F F 
+3043 F F F F F F F 
+3044 F F F F F F F 
+3045 F F F F F F F 
+3046 F T F F F F F 
+3047 F T F F F F F 
+3048 F T F F F F F 
+3049 F T F F F F F 
+3050 F T F F F F F 
+3051 F T F F F F F 
+3052 F T F F F F F 
+3053 F T F F F F F 
+3054 F T F F F F F 
+3055 F T F F F F F 
+3056 F T F F F F F 
+3057 F T F F F F F 
+3058 F T F F F F F 
+3059 F T F F F F F 
+3060 F T F F F F F 
+3061 F T F F F F F 
+3062 F T F F F F F 
+3063 F T F F F F F 
+3064 F T F F F F F 
+3065 F T F F F F F 
+3066 F T F F F F F 
+3067 F F F F F F F 
+3068 F F F F F F F 
+3069 F F F F F F F 
+3070 F F F F F F F 
+3071 F F F F F F F 
+3072 F F F F F F F 
+3073 F T F F F F F 
+3074 F T F F F F F 
+3075 F T F F F F F 
+3076 F F F F F F F 
+3077 F T F F F T F 
+3078 F T F F F T F 
+3079 F T F F F T F 
+3080 F T F F F T F 
+3081 F T F F F T F 
+3082 F T F F F T F 
+3083 F T F F F T F 
+3084 F T F F F T F 
+3085 F F F F F F F 
+3086 F T F F F T F 
+3087 F T F F F T F 
+3088 F T F F F T F 
+3089 F F F F F F F 
+3090 F T F F F T F 
+3091 F T F F F T F 
+3092 F T F F F T F 
+3093 F T F F F T F 
+3094 F T F F F T F 
+3095 F T F F F T F 
+3096 F T F F F T F 
+3097 F T F F F T F 
+3098 F T F F F T F 
+3099 F T F F F T F 
+3100 F T F F F T F 
+3101 F T F F F T F 
+3102 F T F F F T F 
+3103 F T F F F T F 
+3104 F T F F F T F 
+3105 F T F F F T F 
+3106 F T F F F T F 
+3107 F T F F F T F 
+3108 F T F F F T F 
+3109 F T F F F T F 
+3110 F T F F F T F 
+3111 F T F F F T F 
+3112 F T F F F T F 
+3113 F F F F F F F 
+3114 F T F F F T F 
+3115 F T F F F T F 
+3116 F T F F F T F 
+3117 F T F F F T F 
+3118 F T F F F T F 
+3119 F T F F F T F 
+3120 F T F F F T F 
+3121 F T F F F T F 
+3122 F T F F F T F 
+3123 F T F F F T F 
+3124 F F F F F F F 
+3125 F T F F F T F 
+3126 F T F F F T F 
+3127 F T F F F T F 
+3128 F T F F F T F 
+3129 F T F F F T F 
+3130 F F F F F F F 
+3131 F F F F F F F 
+3132 F F F F F F F 
+3133 F T F F F T F 
+3134 F T F F F F F 
+3135 F T F F F F F 
+3136 F T F F F F F 
+3137 F T F F F F F 
+3138 F T F F F F F 
+3139 F T F F F F F 
+3140 F T F F F F F 
+3141 F F F F F F F 
+3142 F T F F F F F 
+3143 F T F F F F F 
+3144 F T F F F F F 
+3145 F F F F F F F 
+3146 F T F F F F F 
+3147 F T F F F F F 
+3148 F T F F F F F 
+3149 F T F F F F F 
+3150 F F F F F F F 
+3151 F F F F F F F 
+3152 F F F F F F F 
+3153 F F F F F F F 
+3154 F F F F F F F 
+3155 F F F F F F F 
+3156 F F F F F F F 
+3157 F T F F F F F 
+3158 F T F F F F F 
+3159 F F F F F F F 
+3160 F T F F F T F 
+3161 F T F F F T F 
+3162 F F F F F F F 
+3163 F F F F F F F 
+3164 F F F F F F F 
+3165 F F F F F F F 
+3166 F F F F F F F 
+3167 F F F F F F F 
+3168 F T F F F T F 
+3169 F T F F F T F 
+3170 F T F F F F F 
+3171 F T F F F F F 
+3172 F F F F F F F 
+3173 F F F F F F F 
+3174 F T F F F F F 
+3175 F T F F F F F 
+3176 F T F F F F F 
+3177 F T F F F F F 
+3178 F T F F F F F 
+3179 F T F F F F F 
+3180 F T F F F F F 
+3181 F T F F F F F 
+3182 F T F F F F F 
+3183 F T F F F F F 
+3184 F F F F F F F 
+3185 F F F F F F F 
+3186 F F F F F F F 
+3187 F F F F F F F 
+3188 F F F F F F F 
+3189 F F F F F F F 
+3190 F F F F F F F 
+3191 F F F F F F F 
+3192 F T F F F F F 
+3193 F T F F F F F 
+3194 F T F F F F F 
+3195 F T F F F F F 
+3196 F T F F F F F 
+3197 F T F F F F F 
+3198 F T F F F F F 
+3199 F T F F F F F 
+3200 F F F F F F F 
+3201 F F F F F F F 
+3202 F T F F F F F 
+3203 F T F F F F F 
+3204 F F F F F F F 
+3205 F T F F F T F 
+3206 F T F F F T F 
+3207 F T F F F T F 
+3208 F T F F F T F 
+3209 F T F F F T F 
+3210 F T F F F T F 
+3211 F T F F F T F 
+3212 F T F F F T F 
+3213 F F F F F F F 
+3214 F T F F F T F 
+3215 F T F F F T F 
+3216 F T F F F T F 
+3217 F F F F F F F 
+3218 F T F F F T F 
+3219 F T F F F T F 
+3220 F T F F F T F 
+3221 F T F F F T F 
+3222 F T F F F T F 
+3223 F T F F F T F 
+3224 F T F F F T F 
+3225 F T F F F T F 
+3226 F T F F F T F 
+3227 F T F F F T F 
+3228 F T F F F T F 
+3229 F T F F F T F 
+3230 F T F F F T F 
+3231 F T F F F T F 
+3232 F T F F F T F 
+3233 F T F F F T F 
+3234 F T F F F T F 
+3235 F T F F F T F 
+3236 F T F F F T F 
+3237 F T F F F T F 
+3238 F T F F F T F 
+3239 F T F F F T F 
+3240 F T F F F T F 
+3241 F F F F F F F 
+3242 F T F F F T F 
+3243 F T F F F T F 
+3244 F T F F F T F 
+3245 F T F F F T F 
+3246 F T F F F T F 
+3247 F T F F F T F 
+3248 F T F F F T F 
+3249 F T F F F T F 
+3250 F T F F F T F 
+3251 F T F F F T F 
+3252 F F F F F F F 
+3253 F T F F F T F 
+3254 F T F F F T F 
+3255 F T F F F T F 
+3256 F T F F F T F 
+3257 F T F F F T F 
+3258 F F F F F F F 
+3259 F F F F F F F 
+3260 F T F F F F F 
+3261 F T F F F T F 
+3262 F T F F F F F 
+3263 F T F F F F F 
+3264 F T F F F F F 
+3265 F T F F F F F 
+3266 F T F F F F F 
+3267 F T F F F F F 
+3268 F T F F F F F 
+3269 F F F F F F F 
+3270 F T F F F F F 
+3271 F T F F F F F 
+3272 F T F F F F F 
+3273 F F F F F F F 
+3274 F T F F F F F 
+3275 F T F F F F F 
+3276 F T F F F F F 
+3277 F T F F F F F 
+3278 F F F F F F F 
+3279 F F F F F F F 
+3280 F F F F F F F 
+3281 F F F F F F F 
+3282 F F F F F F F 
+3283 F F F F F F F 
+3284 F F F F F F F 
+3285 F T F F F F F 
+3286 F T F F F F F 
+3287 F F F F F F F 
+3288 F F F F F F F 
+3289 F F F F F F F 
+3290 F F F F F F F 
+3291 F F F F F F F 
+3292 F F F F F F F 
+3293 F F F F F F F 
+3294 F T F F F T F 
+3295 F F F F F F F 
+3296 F T F F F T F 
+3297 F T F F F T F 
+3298 F T F F F F F 
+3299 F T F F F F F 
+3300 F F F F F F F 
+3301 F F F F F F F 
+3302 F T F F F F F 
+3303 F T F F F F F 
+3304 F T F F F F F 
+3305 F T F F F F F 
+3306 F T F F F F F 
+3307 F T F F F F F 
+3308 F T F F F F F 
+3309 F T F F F F F 
+3310 F T F F F F F 
+3311 F T F F F F F 
+3312 F F F F F F F 
+3313 F T F F F T F 
+3314 F T F F F T F 
+3315 F F F F F F F 
+3316 F F F F F F F 
+3317 F F F F F F F 
+3318 F F F F F F F 
+3319 F F F F F F F 
+3320 F F F F F F F 
+3321 F F F F F F F 
+3322 F F F F F F F 
+3323 F F F F F F F 
+3324 F F F F F F F 
+3325 F F F F F F F 
+3326 F F F F F F F 
+3327 F F F F F F F 
+3328 F F F F F F F 
+3329 F F F F F F F 
+3330 F T F F F F F 
+3331 F T F F F F F 
+3332 F F F F F F F 
+3333 F T F F F T F 
+3334 F T F F F T F 
+3335 F T F F F T F 
+3336 F T F F F T F 
+3337 F T F F F T F 
+3338 F T F F F T F 
+3339 F T F F F T F 
+3340 F T F F F T F 
+3341 F F F F F F F 
+3342 F T F F F T F 
+3343 F T F F F T F 
+3344 F T F F F T F 
+3345 F F F F F F F 
+3346 F T F F F T F 
+3347 F T F F F T F 
+3348 F T F F F T F 
+3349 F T F F F T F 
+3350 F T F F F T F 
+3351 F T F F F T F 
+3352 F T F F F T F 
+3353 F T F F F T F 
+3354 F T F F F T F 
+3355 F T F F F T F 
+3356 F T F F F T F 
+3357 F T F F F T F 
+3358 F T F F F T F 
+3359 F T F F F T F 
+3360 F T F F F T F 
+3361 F T F F F T F 
+3362 F T F F F T F 
+3363 F T F F F T F 
+3364 F T F F F T F 
+3365 F T F F F T F 
+3366 F T F F F T F 
+3367 F T F F F T F 
+3368 F T F F F T F 
+3369 F T F F F T F 
+3370 F T F F F T F 
+3371 F T F F F T F 
+3372 F T F F F T F 
+3373 F T F F F T F 
+3374 F T F F F T F 
+3375 F T F F F T F 
+3376 F T F F F T F 
+3377 F T F F F T F 
+3378 F T F F F T F 
+3379 F T F F F T F 
+3380 F T F F F T F 
+3381 F T F F F T F 
+3382 F T F F F T F 
+3383 F T F F F T F 
+3384 F T F F F T F 
+3385 F T F F F T F 
+3386 F T F F F T F 
+3387 F F F F F F F 
+3388 F F F F F F F 
+3389 F T F F F T F 
+3390 F T F F F F F 
+3391 F T F F F F F 
+3392 F T F F F F F 
+3393 F T F F F F F 
+3394 F T F F F F F 
+3395 F T F F F F F 
+3396 F T F F F F F 
+3397 F F F F F F F 
+3398 F T F F F F F 
+3399 F T F F F F F 
+3400 F T F F F F F 
+3401 F F F F F F F 
+3402 F T F F F F F 
+3403 F T F F F F F 
+3404 F T F F F F F 
+3405 F T F F F F F 
+3406 F T F F F T F 
+3407 F F F F F F F 
+3408 F F F F F F F 
+3409 F F F F F F F 
+3410 F F F F F F F 
+3411 F F F F F F F 
+3412 F F F F F F F 
+3413 F F F F F F F 
+3414 F F F F F F F 
+3415 F T F F F F F 
+3416 F F F F F F F 
+3417 F F F F F F F 
+3418 F F F F F F F 
+3419 F F F F F F F 
+3420 F F F F F F F 
+3421 F F F F F F F 
+3422 F F F F F F F 
+3423 F F F F F F F 
+3424 F T F F F T F 
+3425 F T F F F T F 
+3426 F T F F F F F 
+3427 F T F F F F F 
+3428 F F F F F F F 
+3429 F F F F F F F 
+3430 F T F F F F F 
+3431 F T F F F F F 
+3432 F T F F F F F 
+3433 F T F F F F F 
+3434 F T F F F F F 
+3435 F T F F F F F 
+3436 F T F F F F F 
+3437 F T F F F F F 
+3438 F T F F F F F 
+3439 F T F F F F F 
+3440 F T F F F F F 
+3441 F T F F F F F 
+3442 F T F F F F F 
+3443 F T F F F F F 
+3444 F T F F F F F 
+3445 F T F F F F F 
+3446 F F F F F F F 
+3447 F F F F F F F 
+3448 F F F F F F F 
+3449 F T F F F F F 
+3450 F T F F F T F 
+3451 F T F F F T F 
+3452 F T F F F T F 
+3453 F T F F F T F 
+3454 F T F F F T F 
+3455 F T F F F T F 
+3456 F F F F F F F 
+3457 F F F F F F F 
+3458 F T F F F F F 
+3459 F T F F F F F 
+3460 F F F F F F F 
+3461 F T F F F T F 
+3462 F T F F F T F 
+3463 F T F F F T F 
+3464 F T F F F T F 
+3465 F T F F F T F 
+3466 F T F F F T F 
+3467 F T F F F T F 
+3468 F T F F F T F 
+3469 F T F F F T F 
+3470 F T F F F T F 
+3471 F T F F F T F 
+3472 F T F F F T F 
+3473 F T F F F T F 
+3474 F T F F F T F 
+3475 F T F F F T F 
+3476 F T F F F T F 
+3477 F T F F F T F 
+3478 F T F F F T F 
+3479 F F F F F F F 
+3480 F F F F F F F 
+3481 F F F F F F F 
+3482 F T F F F T F 
+3483 F T F F F T F 
+3484 F T F F F T F 
+3485 F T F F F T F 
+3486 F T F F F T F 
+3487 F T F F F T F 
+3488 F T F F F T F 
+3489 F T F F F T F 
+3490 F T F F F T F 
+3491 F T F F F T F 
+3492 F T F F F T F 
+3493 F T F F F T F 
+3494 F T F F F T F 
+3495 F T F F F T F 
+3496 F T F F F T F 
+3497 F T F F F T F 
+3498 F T F F F T F 
+3499 F T F F F T F 
+3500 F T F F F T F 
+3501 F T F F F T F 
+3502 F T F F F T F 
+3503 F T F F F T F 
+3504 F T F F F T F 
+3505 F T F F F T F 
+3506 F F F F F F F 
+3507 F T F F F T F 
+3508 F T F F F T F 
+3509 F T F F F T F 
+3510 F T F F F T F 
+3511 F T F F F T F 
+3512 F T F F F T F 
+3513 F T F F F T F 
+3514 F T F F F T F 
+3515 F T F F F T F 
+3516 F F F F F F F 
+3517 F T F F F T F 
+3518 F F F F F F F 
+3519 F F F F F F F 
+3520 F T F F F T F 
+3521 F T F F F T F 
+3522 F T F F F T F 
+3523 F T F F F T F 
+3524 F T F F F T F 
+3525 F T F F F T F 
+3526 F T F F F T F 
+3527 F F F F F F F 
+3528 F F F F F F F 
+3529 F F F F F F F 
+3530 F T F F F F F 
+3531 F F F F F F F 
+3532 F F F F F F F 
+3533 F F F F F F F 
+3534 F F F F F F F 
+3535 F T F F F F F 
+3536 F T F F F F F 
+3537 F T F F F F F 
+3538 F T F F F F F 
+3539 F T F F F F F 
+3540 F T F F F F F 
+3541 F F F F F F F 
+3542 F T F F F F F 
+3543 F F F F F F F 
+3544 F T F F F F F 
+3545 F T F F F F F 
+3546 F T F F F F F 
+3547 F T F F F F F 
+3548 F T F F F F F 
+3549 F T F F F F F 
+3550 F T F F F F F 
+3551 F T F F F F F 
+3552 F F F F F F F 
+3553 F F F F F F F 
+3554 F F F F F F F 
+3555 F F F F F F F 
+3556 F F F F F F F 
+3557 F F F F F F F 
+3558 F F F F F F F 
+3559 F F F F F F F 
+3560 F F F F F F F 
+3561 F F F F F F F 
+3562 F F F F F F F 
+3563 F F F F F F F 
+3564 F F F F F F F 
+3565 F F F F F F F 
+3566 F F F F F F F 
+3567 F F F F F F F 
+3568 F F F F F F F 
+3569 F F F F F F F 
+3570 F T F F F F F 
+3571 F T F F F F F 
+3572 F T F F F F F 
+3573 F F F F F F F 
+3574 F F F F F F F 
+3575 F F F F F F F 
+3576 F F F F F F F 
+3577 F F F F F F F 
+3578 F F F F F F F 
+3579 F F F F F F F 
+3580 F F F F F F F 
+3581 F F F F F F F 
+3582 F F F F F F F 
+3583 F F F F F F F 
+3584 F F F F F F F 
+3585 F T F F F T F 
+3586 F T F F F T F 
+3587 F T F F F T F 
+3588 F T F F F T F 
+3589 F T F F F T F 
+3590 F T F F F T F 
+3591 F T F F F T F 
+3592 F T F F F T F 
+3593 F T F F F T F 
+3594 F T F F F T F 
+3595 F T F F F T F 
+3596 F T F F F T F 
+3597 F T F F F T F 
+3598 F T F F F T F 
+3599 F T F F F T F 
+3600 F T F F F T F 
+3601 F T F F F T F 
+3602 F T F F F T F 
+3603 F T F F F T F 
+3604 F T F F F T F 
+3605 F T F F F T F 
+3606 F T F F F T F 
+3607 F T F F F T F 
+3608 F T F F F T F 
+3609 F T F F F T F 
+3610 F T F F F T F 
+3611 F T F F F T F 
+3612 F T F F F T F 
+3613 F T F F F T F 
+3614 F T F F F T F 
+3615 F T F F F T F 
+3616 F T F F F T F 
+3617 F T F F F T F 
+3618 F T F F F T F 
+3619 F T F F F T F 
+3620 F T F F F T F 
+3621 F T F F F T F 
+3622 F T F F F T F 
+3623 F T F F F T F 
+3624 F T F F F T F 
+3625 F T F F F T F 
+3626 F T F F F T F 
+3627 F T F F F T F 
+3628 F T F F F T F 
+3629 F T F F F T F 
+3630 F T F F F T F 
+3631 F T F F F T F 
+3632 F T F F F T F 
+3633 F T F F F F F 
+3634 F T F F F T F 
+3635 F T F F F T F 
+3636 F T F F F F F 
+3637 F T F F F F F 
+3638 F T F F F F F 
+3639 F T F F F F F 
+3640 F T F F F F F 
+3641 F T F F F F F 
+3642 F T F F F F F 
+3643 F F F F F F F 
+3644 F F F F F F F 
+3645 F F F F F F F 
+3646 F F F F F F F 
+3647 F T F F F F F 
+3648 F T F F F T F 
+3649 F T F F F T F 
+3650 F T F F F T F 
+3651 F T F F F T F 
+3652 F T F F F T F 
+3653 F T F F F T F 
+3654 F T F F F T F 
+3655 F T F F F F F 
+3656 F T F F F F F 
+3657 F T F F F F F 
+3658 F T F F F F F 
+3659 F T F F F F F 
+3660 F T F F F F F 
+3661 F T F F F F F 
+3662 F T F F F F F 
+3663 F T F F F F F 
+3664 F T F F F F F 
+3665 F T F F F F F 
+3666 F T F F F F F 
+3667 F T F F F F F 
+3668 F T F F F F F 
+3669 F T F F F F F 
+3670 F T F F F F F 
+3671 F T F F F F F 
+3672 F T F F F F F 
+3673 F T F F F F F 
+3674 F T F F F F F 
+3675 F T F F F F F 
+3676 F F F F F F F 
+3677 F F F F F F F 
+3678 F F F F F F F 
+3679 F F F F F F F 
+3680 F F F F F F F 
+3681 F F F F F F F 
+3682 F F F F F F F 
+3683 F F F F F F F 
+3684 F F F F F F F 
+3685 F F F F F F F 
+3686 F F F F F F F 
+3687 F F F F F F F 
+3688 F F F F F F F 
+3689 F F F F F F F 
+3690 F F F F F F F 
+3691 F F F F F F F 
+3692 F F F F F F F 
+3693 F F F F F F F 
+3694 F F F F F F F 
+3695 F F F F F F F 
+3696 F F F F F F F 
+3697 F F F F F F F 
+3698 F F F F F F F 
+3699 F F F F F F F 
+3700 F F F F F F F 
+3701 F F F F F F F 
+3702 F F F F F F F 
+3703 F F F F F F F 
+3704 F F F F F F F 
+3705 F F F F F F F 
+3706 F F F F F F F 
+3707 F F F F F F F 
+3708 F F F F F F F 
+3709 F F F F F F F 
+3710 F F F F F F F 
+3711 F F F F F F F 
+3712 F F F F F F F 
+3713 F T F F F T F 
+3714 F T F F F T F 
+3715 F F F F F F F 
+3716 F T F F F T F 
+3717 F F F F F F F 
+3718 F F F F F F F 
+3719 F T F F F T F 
+3720 F T F F F T F 
+3721 F F F F F F F 
+3722 F T F F F T F 
+3723 F F F F F F F 
+3724 F F F F F F F 
+3725 F T F F F T F 
+3726 F F F F F F F 
+3727 F F F F F F F 
+3728 F F F F F F F 
+3729 F F F F F F F 
+3730 F F F F F F F 
+3731 F F F F F F F 
+3732 F T F F F T F 
+3733 F T F F F T F 
+3734 F T F F F T F 
+3735 F T F F F T F 
+3736 F F F F F F F 
+3737 F T F F F T F 
+3738 F T F F F T F 
+3739 F T F F F T F 
+3740 F T F F F T F 
+3741 F T F F F T F 
+3742 F T F F F T F 
+3743 F T F F F T F 
+3744 F F F F F F F 
+3745 F T F F F T F 
+3746 F T F F F T F 
+3747 F T F F F T F 
+3748 F F F F F F F 
+3749 F T F F F T F 
+3750 F F F F F F F 
+3751 F T F F F T F 
+3752 F F F F F F F 
+3753 F F F F F F F 
+3754 F T F F F T F 
+3755 F T F F F T F 
+3756 F F F F F F F 
+3757 F T F F F T F 
+3758 F T F F F T F 
+3759 F T F F F T F 
+3760 F T F F F T F 
+3761 F T F F F F F 
+3762 F T F F F T F 
+3763 F T F F F T F 
+3764 F T F F F F F 
+3765 F T F F F F F 
+3766 F T F F F F F 
+3767 F T F F F F F 
+3768 F T F F F F F 
+3769 F T F F F F F 
+3770 F F F F F F F 
+3771 F T F F F F F 
+3772 F T F F F F F 
+3773 F T F F F T F 
+3774 F F F F F F F 
+3775 F F F F F F F 
+3776 F T F F F T F 
+3777 F T F F F T F 
+3778 F T F F F T F 
+3779 F T F F F T F 
+3780 F T F F F T F 
+3781 F F F F F F F 
+3782 F T F F F T F 
+3783 F F F F F F F 
+3784 F T F F F F F 
+3785 F T F F F F F 
+3786 F T F F F F F 
+3787 F T F F F F F 
+3788 F T F F F F F 
+3789 F T F F F F F 
+3790 F F F F F F F 
+3791 F F F F F F F 
+3792 F T F F F F F 
+3793 F T F F F F F 
+3794 F T F F F F F 
+3795 F T F F F F F 
+3796 F T F F F F F 
+3797 F T F F F F F 
+3798 F T F F F F F 
+3799 F T F F F F F 
+3800 F T F F F F F 
+3801 F T F F F F F 
+3802 F F F F F F F 
+3803 F F F F F F F 
+3804 F T F F F T F 
+3805 F T F F F T F 
+3806 F F F F F F F 
+3807 F F F F F F F 
+3808 F F F F F F F 
+3809 F F F F F F F 
+3810 F F F F F F F 
+3811 F F F F F F F 
+3812 F F F F F F F 
+3813 F F F F F F F 
+3814 F F F F F F F 
+3815 F F F F F F F 
+3816 F F F F F F F 
+3817 F F F F F F F 
+3818 F F F F F F F 
+3819 F F F F F F F 
+3820 F F F F F F F 
+3821 F F F F F F F 
+3822 F F F F F F F 
+3823 F F F F F F F 
+3824 F F F F F F F 
+3825 F F F F F F F 
+3826 F F F F F F F 
+3827 F F F F F F F 
+3828 F F F F F F F 
+3829 F F F F F F F 
+3830 F F F F F F F 
+3831 F F F F F F F 
+3832 F F F F F F F 
+3833 F F F F F F F 
+3834 F F F F F F F 
+3835 F F F F F F F 
+3836 F F F F F F F 
+3837 F F F F F F F 
+3838 F F F F F F F 
+3839 F F F F F F F 
+3840 F T F F F T F 
+3841 F T F F F F F 
+3842 F T F F F F F 
+3843 F T F F F F F 
+3844 F T F F F F F 
+3845 F T F F F F F 
+3846 F T F F F F F 
+3847 F T F F F F F 
+3848 F T F F F F F 
+3849 F T F F F F F 
+3850 F T F F F F F 
+3851 F T F F F F F 
+3852 F T F F F F F 
+3853 F T F F F F F 
+3854 F T F F F F F 
+3855 F T F F F F F 
+3856 F T F F F F F 
+3857 F T F F F F F 
+3858 F T F F F F F 
+3859 F T F F F F F 
+3860 F T F F F F F 
+3861 F T F F F F F 
+3862 F T F F F F F 
+3863 F T F F F F F 
+3864 F T F F F F F 
+3865 F T F F F F F 
+3866 F T F F F F F 
+3867 F T F F F F F 
+3868 F T F F F F F 
+3869 F T F F F F F 
+3870 F T F F F F F 
+3871 F T F F F F F 
+3872 F T F F F F F 
+3873 F T F F F F F 
+3874 F T F F F F F 
+3875 F T F F F F F 
+3876 F T F F F F F 
+3877 F T F F F F F 
+3878 F T F F F F F 
+3879 F T F F F F F 
+3880 F T F F F F F 
+3881 F T F F F F F 
+3882 F T F F F F F 
+3883 F T F F F F F 
+3884 F T F F F F F 
+3885 F T F F F F F 
+3886 F T F F F F F 
+3887 F T F F F F F 
+3888 F T F F F F F 
+3889 F T F F F F F 
+3890 F T F F F F F 
+3891 F T F F F F F 
+3892 F T F F F F F 
+3893 F T F F F F F 
+3894 F T F F F F F 
+3895 F T F F F F F 
+3896 F T F F F F F 
+3897 F T F F F F F 
+3898 F T F F F F F 
+3899 F T F F F F F 
+3900 F T F F F F F 
+3901 F T F F F F F 
+3902 F T F F F F F 
+3903 F T F F F F F 
+3904 F T F F F T F 
+3905 F T F F F T F 
+3906 F T F F F T F 
+3907 F T F F F T F 
+3908 F T F F F T F 
+3909 F T F F F T F 
+3910 F T F F F T F 
+3911 F T F F F T F 
+3912 F F F F F F F 
+3913 F T F F F T F 
+3914 F T F F F T F 
+3915 F T F F F T F 
+3916 F T F F F T F 
+3917 F T F F F T F 
+3918 F T F F F T F 
+3919 F T F F F T F 
+3920 F T F F F T F 
+3921 F T F F F T F 
+3922 F T F F F T F 
+3923 F T F F F T F 
+3924 F T F F F T F 
+3925 F T F F F T F 
+3926 F T F F F T F 
+3927 F T F F F T F 
+3928 F T F F F T F 
+3929 F T F F F T F 
+3930 F T F F F T F 
+3931 F T F F F T F 
+3932 F T F F F T F 
+3933 F T F F F T F 
+3934 F T F F F T F 
+3935 F T F F F T F 
+3936 F T F F F T F 
+3937 F T F F F T F 
+3938 F T F F F T F 
+3939 F T F F F T F 
+3940 F T F F F T F 
+3941 F T F F F T F 
+3942 F T F F F T F 
+3943 F T F F F T F 
+3944 F T F F F T F 
+3945 F T F F F T F 
+3946 F T F F F T F 
+3947 F T F F F T F 
+3948 F T F F F T F 
+3949 F F F F F F F 
+3950 F F F F F F F 
+3951 F F F F F F F 
+3952 F F F F F F F 
+3953 F T F F F F F 
+3954 F T F F F F F 
+3955 F T F F F F F 
+3956 F T F F F F F 
+3957 F T F F F F F 
+3958 F T F F F F F 
+3959 F T F F F F F 
+3960 F T F F F F F 
+3961 F T F F F F F 
+3962 F T F F F F F 
+3963 F T F F F F F 
+3964 F T F F F F F 
+3965 F T F F F F F 
+3966 F T F F F F F 
+3967 F T F F F F F 
+3968 F T F F F F F 
+3969 F T F F F F F 
+3970 F T F F F F F 
+3971 F T F F F F F 
+3972 F T F F F F F 
+3973 F T F F F F F 
+3974 F T F F F F F 
+3975 F T F F F F F 
+3976 F T F F F T F 
+3977 F T F F F T F 
+3978 F T F F F T F 
+3979 F T F F F T F 
+3980 F T F F F T F 
+3981 F T F F F F F 
+3982 F T F F F F F 
+3983 F T F F F F F 
+3984 F T F F F F F 
+3985 F T F F F F F 
+3986 F T F F F F F 
+3987 F T F F F F F 
+3988 F T F F F F F 
+3989 F T F F F F F 
+3990 F T F F F F F 
+3991 F T F F F F F 
+3992 F F F F F F F 
+3993 F T F F F F F 
+3994 F T F F F F F 
+3995 F T F F F F F 
+3996 F T F F F F F 
+3997 F T F F F F F 
+3998 F T F F F F F 
+3999 F T F F F F F 
+4000 F T F F F F F 
+4001 F T F F F F F 
+4002 F T F F F F F 
+4003 F T F F F F F 
+4004 F T F F F F F 
+4005 F T F F F F F 
+4006 F T F F F F F 
+4007 F T F F F F F 
+4008 F T F F F F F 
+4009 F T F F F F F 
+4010 F T F F F F F 
+4011 F T F F F F F 
+4012 F T F F F F F 
+4013 F T F F F F F 
+4014 F T F F F F F 
+4015 F T F F F F F 
+4016 F T F F F F F 
+4017 F T F F F F F 
+4018 F T F F F F F 
+4019 F T F F F F F 
+4020 F T F F F F F 
+4021 F T F F F F F 
+4022 F T F F F F F 
+4023 F T F F F F F 
+4024 F T F F F F F 
+4025 F T F F F F F 
+4026 F T F F F F F 
+4027 F T F F F F F 
+4028 F T F F F F F 
+4029 F F F F F F F 
+4030 F T F F F F F 
+4031 F T F F F F F 
+4032 F T F F F F F 
+4033 F T F F F F F 
+4034 F T F F F F F 
+4035 F T F F F F F 
+4036 F T F F F F F 
+4037 F T F F F F F 
+4038 F T F F F F F 
+4039 F T F F F F F 
+4040 F T F F F F F 
+4041 F T F F F F F 
+4042 F T F F F F F 
+4043 F T F F F F F 
+4044 F T F F F F F 
+4045 F F F F F F F 
+4046 F T F F F F F 
+4047 F T F F F F F 
+4048 F T F F F F F 
+4049 F T F F F F F 
+4050 F T F F F F F 
+4051 F T F F F F F 
+4052 F T F F F F F 
+4053 F T F F F F F 
+4054 F T F F F F F 
+4055 F T F F F F F 
+4056 F T F F F F F 
+4057 F T F F F F F 
+4058 F T F F F F F 
+4059 F F F F F F F 
+4060 F F F F F F F 
+4061 F F F F F F F 
+4062 F F F F F F F 
+4063 F F F F F F F 
+4064 F F F F F F F 
+4065 F F F F F F F 
+4066 F F F F F F F 
+4067 F F F F F F F 
+4068 F F F F F F F 
+4069 F F F F F F F 
+4070 F F F F F F F 
+4071 F F F F F F F 
+4072 F F F F F F F 
+4073 F F F F F F F 
+4074 F F F F F F F 
+4075 F F F F F F F 
+4076 F F F F F F F 
+4077 F F F F F F F 
+4078 F F F F F F F 
+4079 F F F F F F F 
+4080 F F F F F F F 
+4081 F F F F F F F 
+4082 F F F F F F F 
+4083 F F F F F F F 
+4084 F F F F F F F 
+4085 F F F F F F F 
+4086 F F F F F F F 
+4087 F F F F F F F 
+4088 F F F F F F F 
+4089 F F F F F F F 
+4090 F F F F F F F 
+4091 F F F F F F F 
+4092 F F F F F F F 
+4093 F F F F F F F 
+4094 F F F F F F F 
+4095 F F F F F F F 
+4096 F T F F F T F 
+4097 F T F F F T F 
+4098 F T F F F T F 
+4099 F T F F F T F 
+4100 F T F F F T F 
+4101 F T F F F T F 
+4102 F T F F F T F 
+4103 F T F F F T F 
+4104 F T F F F T F 
+4105 F T F F F T F 
+4106 F T F F F T F 
+4107 F T F F F T F 
+4108 F T F F F T F 
+4109 F T F F F T F 
+4110 F T F F F T F 
+4111 F T F F F T F 
+4112 F T F F F T F 
+4113 F T F F F T F 
+4114 F T F F F T F 
+4115 F T F F F T F 
+4116 F T F F F T F 
+4117 F T F F F T F 
+4118 F T F F F T F 
+4119 F T F F F T F 
+4120 F T F F F T F 
+4121 F T F F F T F 
+4122 F T F F F T F 
+4123 F T F F F T F 
+4124 F T F F F T F 
+4125 F T F F F T F 
+4126 F T F F F T F 
+4127 F T F F F T F 
+4128 F T F F F T F 
+4129 F T F F F T F 
+4130 F T F F F T F 
+4131 F T F F F T F 
+4132 F T F F F T F 
+4133 F T F F F T F 
+4134 F T F F F T F 
+4135 F T F F F T F 
+4136 F T F F F T F 
+4137 F T F F F T F 
+4138 F T F F F T F 
+4139 F T F F F F F 
+4140 F T F F F F F 
+4141 F T F F F F F 
+4142 F T F F F F F 
+4143 F T F F F F F 
+4144 F T F F F F F 
+4145 F T F F F F F 
+4146 F T F F F F F 
+4147 F T F F F F F 
+4148 F T F F F F F 
+4149 F T F F F F F 
+4150 F T F F F F F 
+4151 F T F F F F F 
+4152 F T F F F F F 
+4153 F T F F F F F 
+4154 F T F F F F F 
+4155 F T F F F F F 
+4156 F T F F F F F 
+4157 F T F F F F F 
+4158 F T F F F F F 
+4159 F T F F F T F 
+4160 F T F F F F F 
+4161 F T F F F F F 
+4162 F T F F F F F 
+4163 F T F F F F F 
+4164 F T F F F F F 
+4165 F T F F F F F 
+4166 F T F F F F F 
+4167 F T F F F F F 
+4168 F T F F F F F 
+4169 F T F F F F F 
+4170 F T F F F F F 
+4171 F T F F F F F 
+4172 F T F F F F F 
+4173 F T F F F F F 
+4174 F T F F F F F 
+4175 F T F F F F F 
+4176 F T F F F T F 
+4177 F T F F F T F 
+4178 F T F F F T F 
+4179 F T F F F T F 
+4180 F T F F F T F 
+4181 F T F F F T F 
+4182 F T F F F F F 
+4183 F T F F F F F 
+4184 F T F F F F F 
+4185 F T F F F F F 
+4186 F T F F F T F 
+4187 F T F F F T F 
+4188 F T F F F T F 
+4189 F T F F F T F 
+4190 F T F F F F F 
+4191 F T F F F F F 
+4192 F T F F F F F 
+4193 F T F F F T F 
+4194 F T F F F F F 
+4195 F T F F F F F 
+4196 F T F F F F F 
+4197 F T F F F T F 
+4198 F T F F F T F 
+4199 F T F F F F F 
+4200 F T F F F F F 
+4201 F T F F F F F 
+4202 F T F F F F F 
+4203 F T F F F F F 
+4204 F T F F F F F 
+4205 F T F F F F F 
+4206 F T F F F T F 
+4207 F T F F F T F 
+4208 F T F F F T F 
+4209 F T F F F F F 
+4210 F T F F F F F 
+4211 F T F F F F F 
+4212 F T F F F F F 
+4213 F T F F F T F 
+4214 F T F F F T F 
+4215 F T F F F T F 
+4216 F T F F F T F 
+4217 F T F F F T F 
+4218 F T F F F T F 
+4219 F T F F F T F 
+4220 F T F F F T F 
+4221 F T F F F T F 
+4222 F T F F F T F 
+4223 F T F F F T F 
+4224 F T F F F T F 
+4225 F T F F F T F 
+4226 F T F F F F F 
+4227 F T F F F F F 
+4228 F T F F F F F 
+4229 F T F F F F F 
+4230 F T F F F F F 
+4231 F T F F F F F 
+4232 F T F F F F F 
+4233 F T F F F F F 
+4234 F T F F F F F 
+4235 F T F F F F F 
+4236 F T F F F F F 
+4237 F T F F F F F 
+4238 F T F F F T F 
+4239 F T F F F F F 
+4240 F T F F F F F 
+4241 F T F F F F F 
+4242 F T F F F F F 
+4243 F T F F F F F 
+4244 F T F F F F F 
+4245 F T F F F F F 
+4246 F T F F F F F 
+4247 F T F F F F F 
+4248 F T F F F F F 
+4249 F T F F F F F 
+4250 F T F F F F F 
+4251 F T F F F F F 
+4252 F T F F F F F 
+4253 F T F F F F F 
+4254 F T F F F F F 
+4255 F T F F F F F 
+4256 F T F T F T F 
+4257 F T F T F T F 
+4258 F T F T F T F 
+4259 F T F T F T F 
+4260 F T F T F T F 
+4261 F T F T F T F 
+4262 F T F T F T F 
+4263 F T F T F T F 
+4264 F T F T F T F 
+4265 F T F T F T F 
+4266 F T F T F T F 
+4267 F T F T F T F 
+4268 F T F T F T F 
+4269 F T F T F T F 
+4270 F T F T F T F 
+4271 F T F T F T F 
+4272 F T F T F T F 
+4273 F T F T F T F 
+4274 F T F T F T F 
+4275 F T F T F T F 
+4276 F T F T F T F 
+4277 F T F T F T F 
+4278 F T F T F T F 
+4279 F T F T F T F 
+4280 F T F T F T F 
+4281 F T F T F T F 
+4282 F T F T F T F 
+4283 F T F T F T F 
+4284 F T F T F T F 
+4285 F T F T F T F 
+4286 F T F T F T F 
+4287 F T F T F T F 
+4288 F T F T F T F 
+4289 F T F T F T F 
+4290 F T F T F T F 
+4291 F T F T F T F 
+4292 F T F T F T F 
+4293 F T F T F T F 
+4294 F F F F F F F 
+4295 F F F F F F F 
+4296 F F F F F F F 
+4297 F F F F F F F 
+4298 F F F F F F F 
+4299 F F F F F F F 
+4300 F F F F F F F 
+4301 F F F F F F F 
+4302 F F F F F F F 
+4303 F F F F F F F 
+4304 F T F F F T F 
+4305 F T F F F T F 
+4306 F T F F F T F 
+4307 F T F F F T F 
+4308 F T F F F T F 
+4309 F T F F F T F 
+4310 F T F F F T F 
+4311 F T F F F T F 
+4312 F T F F F T F 
+4313 F T F F F T F 
+4314 F T F F F T F 
+4315 F T F F F T F 
+4316 F T F F F T F 
+4317 F T F F F T F 
+4318 F T F F F T F 
+4319 F T F F F T F 
+4320 F T F F F T F 
+4321 F T F F F T F 
+4322 F T F F F T F 
+4323 F T F F F T F 
+4324 F T F F F T F 
+4325 F T F F F T F 
+4326 F T F F F T F 
+4327 F T F F F T F 
+4328 F T F F F T F 
+4329 F T F F F T F 
+4330 F T F F F T F 
+4331 F T F F F T F 
+4332 F T F F F T F 
+4333 F T F F F T F 
+4334 F T F F F T F 
+4335 F T F F F T F 
+4336 F T F F F T F 
+4337 F T F F F T F 
+4338 F T F F F T F 
+4339 F T F F F T F 
+4340 F T F F F T F 
+4341 F T F F F T F 
+4342 F T F F F T F 
+4343 F T F F F T F 
+4344 F T F F F T F 
+4345 F T F F F T F 
+4346 F T F F F T F 
+4347 F T F F F F F 
+4348 F T F F F T F 
+4349 F F F F F F F 
+4350 F F F F F F F 
+4351 F F F F F F F 
+4352 F T F F F T F 
+4353 F T F F F T F 
+4354 F T F F F T F 
+4355 F T F F F T F 
+4356 F T F F F T F 
+4357 F T F F F T F 
+4358 F T F F F T F 
+4359 F T F F F T F 
+4360 F T F F F T F 
+4361 F T F F F T F 
+4362 F T F F F T F 
+4363 F T F F F T F 
+4364 F T F F F T F 
+4365 F T F F F T F 
+4366 F T F F F T F 
+4367 F T F F F T F 
+4368 F T F F F T F 
+4369 F T F F F T F 
+4370 F T F F F T F 
+4371 F T F F F T F 
+4372 F T F F F T F 
+4373 F T F F F T F 
+4374 F T F F F T F 
+4375 F T F F F T F 
+4376 F T F F F T F 
+4377 F T F F F T F 
+4378 F T F F F T F 
+4379 F T F F F T F 
+4380 F T F F F T F 
+4381 F T F F F T F 
+4382 F T F F F T F 
+4383 F T F F F T F 
+4384 F T F F F T F 
+4385 F T F F F T F 
+4386 F T F F F T F 
+4387 F T F F F T F 
+4388 F T F F F T F 
+4389 F T F F F T F 
+4390 F T F F F T F 
+4391 F T F F F T F 
+4392 F T F F F T F 
+4393 F T F F F T F 
+4394 F T F F F T F 
+4395 F T F F F T F 
+4396 F T F F F T F 
+4397 F T F F F T F 
+4398 F T F F F T F 
+4399 F T F F F T F 
+4400 F T F F F T F 
+4401 F T F F F T F 
+4402 F T F F F T F 
+4403 F T F F F T F 
+4404 F T F F F T F 
+4405 F T F F F T F 
+4406 F T F F F T F 
+4407 F T F F F T F 
+4408 F T F F F T F 
+4409 F T F F F T F 
+4410 F T F F F T F 
+4411 F T F F F T F 
+4412 F T F F F T F 
+4413 F T F F F T F 
+4414 F T F F F T F 
+4415 F T F F F T F 
+4416 F T F F F T F 
+4417 F T F F F T F 
+4418 F T F F F T F 
+4419 F T F F F T F 
+4420 F T F F F T F 
+4421 F T F F F T F 
+4422 F T F F F T F 
+4423 F T F F F T F 
+4424 F T F F F T F 
+4425 F T F F F T F 
+4426 F T F F F T F 
+4427 F T F F F T F 
+4428 F T F F F T F 
+4429 F T F F F T F 
+4430 F T F F F T F 
+4431 F T F F F T F 
+4432 F T F F F T F 
+4433 F T F F F T F 
+4434 F T F F F T F 
+4435 F T F F F T F 
+4436 F T F F F T F 
+4437 F T F F F T F 
+4438 F T F F F T F 
+4439 F T F F F T F 
+4440 F T F F F T F 
+4441 F T F F F T F 
+4442 F T F F F T F 
+4443 F T F F F T F 
+4444 F T F F F T F 
+4445 F T F F F T F 
+4446 F T F F F T F 
+4447 F T F F F T F 
+4448 F T F F F T F 
+4449 F T F F F T F 
+4450 F T F F F T F 
+4451 F T F F F T F 
+4452 F T F F F T F 
+4453 F T F F F T F 
+4454 F T F F F T F 
+4455 F T F F F T F 
+4456 F T F F F T F 
+4457 F T F F F T F 
+4458 F T F F F T F 
+4459 F T F F F T F 
+4460 F T F F F T F 
+4461 F T F F F T F 
+4462 F T F F F T F 
+4463 F T F F F T F 
+4464 F T F F F T F 
+4465 F T F F F T F 
+4466 F T F F F T F 
+4467 F T F F F T F 
+4468 F T F F F T F 
+4469 F T F F F T F 
+4470 F T F F F T F 
+4471 F T F F F T F 
+4472 F T F F F T F 
+4473 F T F F F T F 
+4474 F T F F F T F 
+4475 F T F F F T F 
+4476 F T F F F T F 
+4477 F T F F F T F 
+4478 F T F F F T F 
+4479 F T F F F T F 
+4480 F T F F F T F 
+4481 F T F F F T F 
+4482 F T F F F T F 
+4483 F T F F F T F 
+4484 F T F F F T F 
+4485 F T F F F T F 
+4486 F T F F F T F 
+4487 F T F F F T F 
+4488 F T F F F T F 
+4489 F T F F F T F 
+4490 F T F F F T F 
+4491 F T F F F T F 
+4492 F T F F F T F 
+4493 F T F F F T F 
+4494 F T F F F T F 
+4495 F T F F F T F 
+4496 F T F F F T F 
+4497 F T F F F T F 
+4498 F T F F F T F 
+4499 F T F F F T F 
+4500 F T F F F T F 
+4501 F T F F F T F 
+4502 F T F F F T F 
+4503 F T F F F T F 
+4504 F T F F F T F 
+4505 F T F F F T F 
+4506 F T F F F T F 
+4507 F T F F F T F 
+4508 F T F F F T F 
+4509 F T F F F T F 
+4510 F T F F F T F 
+4511 F T F F F T F 
+4512 F T F F F T F 
+4513 F T F F F T F 
+4514 F T F F F T F 
+4515 F T F F F T F 
+4516 F T F F F T F 
+4517 F T F F F T F 
+4518 F T F F F T F 
+4519 F T F F F T F 
+4520 F T F F F T F 
+4521 F T F F F T F 
+4522 F T F F F T F 
+4523 F T F F F T F 
+4524 F T F F F T F 
+4525 F T F F F T F 
+4526 F T F F F T F 
+4527 F T F F F T F 
+4528 F T F F F T F 
+4529 F T F F F T F 
+4530 F T F F F T F 
+4531 F T F F F T F 
+4532 F T F F F T F 
+4533 F T F F F T F 
+4534 F T F F F T F 
+4535 F T F F F T F 
+4536 F T F F F T F 
+4537 F T F F F T F 
+4538 F T F F F T F 
+4539 F T F F F T F 
+4540 F T F F F T F 
+4541 F T F F F T F 
+4542 F T F F F T F 
+4543 F T F F F T F 
+4544 F T F F F T F 
+4545 F T F F F T F 
+4546 F T F F F T F 
+4547 F T F F F T F 
+4548 F T F F F T F 
+4549 F T F F F T F 
+4550 F T F F F T F 
+4551 F T F F F T F 
+4552 F T F F F T F 
+4553 F T F F F T F 
+4554 F T F F F T F 
+4555 F T F F F T F 
+4556 F T F F F T F 
+4557 F T F F F T F 
+4558 F T F F F T F 
+4559 F T F F F T F 
+4560 F T F F F T F 
+4561 F T F F F T F 
+4562 F T F F F T F 
+4563 F T F F F T F 
+4564 F T F F F T F 
+4565 F T F F F T F 
+4566 F T F F F T F 
+4567 F T F F F T F 
+4568 F T F F F T F 
+4569 F T F F F T F 
+4570 F T F F F T F 
+4571 F T F F F T F 
+4572 F T F F F T F 
+4573 F T F F F T F 
+4574 F T F F F T F 
+4575 F T F F F T F 
+4576 F T F F F T F 
+4577 F T F F F T F 
+4578 F T F F F T F 
+4579 F T F F F T F 
+4580 F T F F F T F 
+4581 F T F F F T F 
+4582 F T F F F T F 
+4583 F T F F F T F 
+4584 F T F F F T F 
+4585 F T F F F T F 
+4586 F T F F F T F 
+4587 F T F F F T F 
+4588 F T F F F T F 
+4589 F T F F F T F 
+4590 F T F F F T F 
+4591 F T F F F T F 
+4592 F T F F F T F 
+4593 F T F F F T F 
+4594 F T F F F T F 
+4595 F T F F F T F 
+4596 F T F F F T F 
+4597 F T F F F T F 
+4598 F T F F F T F 
+4599 F T F F F T F 
+4600 F T F F F T F 
+4601 F T F F F T F 
+4602 F T F F F T F 
+4603 F T F F F T F 
+4604 F T F F F T F 
+4605 F T F F F T F 
+4606 F T F F F T F 
+4607 F T F F F T F 
+4608 F T F F F T F 
+4609 F T F F F T F 
+4610 F T F F F T F 
+4611 F T F F F T F 
+4612 F T F F F T F 
+4613 F T F F F T F 
+4614 F T F F F T F 
+4615 F T F F F T F 
+4616 F T F F F T F 
+4617 F T F F F T F 
+4618 F T F F F T F 
+4619 F T F F F T F 
+4620 F T F F F T F 
+4621 F T F F F T F 
+4622 F T F F F T F 
+4623 F T F F F T F 
+4624 F T F F F T F 
+4625 F T F F F T F 
+4626 F T F F F T F 
+4627 F T F F F T F 
+4628 F T F F F T F 
+4629 F T F F F T F 
+4630 F T F F F T F 
+4631 F T F F F T F 
+4632 F T F F F T F 
+4633 F T F F F T F 
+4634 F T F F F T F 
+4635 F T F F F T F 
+4636 F T F F F T F 
+4637 F T F F F T F 
+4638 F T F F F T F 
+4639 F T F F F T F 
+4640 F T F F F T F 
+4641 F T F F F T F 
+4642 F T F F F T F 
+4643 F T F F F T F 
+4644 F T F F F T F 
+4645 F T F F F T F 
+4646 F T F F F T F 
+4647 F T F F F T F 
+4648 F T F F F T F 
+4649 F T F F F T F 
+4650 F T F F F T F 
+4651 F T F F F T F 
+4652 F T F F F T F 
+4653 F T F F F T F 
+4654 F T F F F T F 
+4655 F T F F F T F 
+4656 F T F F F T F 
+4657 F T F F F T F 
+4658 F T F F F T F 
+4659 F T F F F T F 
+4660 F T F F F T F 
+4661 F T F F F T F 
+4662 F T F F F T F 
+4663 F T F F F T F 
+4664 F T F F F T F 
+4665 F T F F F T F 
+4666 F T F F F T F 
+4667 F T F F F T F 
+4668 F T F F F T F 
+4669 F T F F F T F 
+4670 F T F F F T F 
+4671 F T F F F T F 
+4672 F T F F F T F 
+4673 F T F F F T F 
+4674 F T F F F T F 
+4675 F T F F F T F 
+4676 F T F F F T F 
+4677 F T F F F T F 
+4678 F T F F F T F 
+4679 F T F F F T F 
+4680 F T F F F T F 
+4681 F F F F F F F 
+4682 F T F F F T F 
+4683 F T F F F T F 
+4684 F T F F F T F 
+4685 F T F F F T F 
+4686 F F F F F F F 
+4687 F F F F F F F 
+4688 F T F F F T F 
+4689 F T F F F T F 
+4690 F T F F F T F 
+4691 F T F F F T F 
+4692 F T F F F T F 
+4693 F T F F F T F 
+4694 F T F F F T F 
+4695 F F F F F F F 
+4696 F T F F F T F 
+4697 F F F F F F F 
+4698 F T F F F T F 
+4699 F T F F F T F 
+4700 F T F F F T F 
+4701 F T F F F T F 
+4702 F F F F F F F 
+4703 F F F F F F F 
+4704 F T F F F T F 
+4705 F T F F F T F 
+4706 F T F F F T F 
+4707 F T F F F T F 
+4708 F T F F F T F 
+4709 F T F F F T F 
+4710 F T F F F T F 
+4711 F T F F F T F 
+4712 F T F F F T F 
+4713 F T F F F T F 
+4714 F T F F F T F 
+4715 F T F F F T F 
+4716 F T F F F T F 
+4717 F T F F F T F 
+4718 F T F F F T F 
+4719 F T F F F T F 
+4720 F T F F F T F 
+4721 F T F F F T F 
+4722 F T F F F T F 
+4723 F T F F F T F 
+4724 F T F F F T F 
+4725 F T F F F T F 
+4726 F T F F F T F 
+4727 F T F F F T F 
+4728 F T F F F T F 
+4729 F T F F F T F 
+4730 F T F F F T F 
+4731 F T F F F T F 
+4732 F T F F F T F 
+4733 F T F F F T F 
+4734 F T F F F T F 
+4735 F T F F F T F 
+4736 F T F F F T F 
+4737 F T F F F T F 
+4738 F T F F F T F 
+4739 F T F F F T F 
+4740 F T F F F T F 
+4741 F T F F F T F 
+4742 F T F F F T F 
+4743 F T F F F T F 
+4744 F T F F F T F 
+4745 F F F F F F F 
+4746 F T F F F T F 
+4747 F T F F F T F 
+4748 F T F F F T F 
+4749 F T F F F T F 
+4750 F F F F F F F 
+4751 F F F F F F F 
+4752 F T F F F T F 
+4753 F T F F F T F 
+4754 F T F F F T F 
+4755 F T F F F T F 
+4756 F T F F F T F 
+4757 F T F F F T F 
+4758 F T F F F T F 
+4759 F T F F F T F 
+4760 F T F F F T F 
+4761 F T F F F T F 
+4762 F T F F F T F 
+4763 F T F F F T F 
+4764 F T F F F T F 
+4765 F T F F F T F 
+4766 F T F F F T F 
+4767 F T F F F T F 
+4768 F T F F F T F 
+4769 F T F F F T F 
+4770 F T F F F T F 
+4771 F T F F F T F 
+4772 F T F F F T F 
+4773 F T F F F T F 
+4774 F T F F F T F 
+4775 F T F F F T F 
+4776 F T F F F T F 
+4777 F T F F F T F 
+4778 F T F F F T F 
+4779 F T F F F T F 
+4780 F T F F F T F 
+4781 F T F F F T F 
+4782 F T F F F T F 
+4783 F T F F F T F 
+4784 F T F F F T F 
+4785 F F F F F F F 
+4786 F T F F F T F 
+4787 F T F F F T F 
+4788 F T F F F T F 
+4789 F T F F F T F 
+4790 F F F F F F F 
+4791 F F F F F F F 
+4792 F T F F F T F 
+4793 F T F F F T F 
+4794 F T F F F T F 
+4795 F T F F F T F 
+4796 F T F F F T F 
+4797 F T F F F T F 
+4798 F T F F F T F 
+4799 F F F F F F F 
+4800 F T F F F T F 
+4801 F F F F F F F 
+4802 F T F F F T F 
+4803 F T F F F T F 
+4804 F T F F F T F 
+4805 F T F F F T F 
+4806 F F F F F F F 
+4807 F F F F F F F 
+4808 F T F F F T F 
+4809 F T F F F T F 
+4810 F T F F F T F 
+4811 F T F F F T F 
+4812 F T F F F T F 
+4813 F T F F F T F 
+4814 F T F F F T F 
+4815 F T F F F T F 
+4816 F T F F F T F 
+4817 F T F F F T F 
+4818 F T F F F T F 
+4819 F T F F F T F 
+4820 F T F F F T F 
+4821 F T F F F T F 
+4822 F T F F F T F 
+4823 F F F F F F F 
+4824 F T F F F T F 
+4825 F T F F F T F 
+4826 F T F F F T F 
+4827 F T F F F T F 
+4828 F T F F F T F 
+4829 F T F F F T F 
+4830 F T F F F T F 
+4831 F T F F F T F 
+4832 F T F F F T F 
+4833 F T F F F T F 
+4834 F T F F F T F 
+4835 F T F F F T F 
+4836 F T F F F T F 
+4837 F T F F F T F 
+4838 F T F F F T F 
+4839 F T F F F T F 
+4840 F T F F F T F 
+4841 F T F F F T F 
+4842 F T F F F T F 
+4843 F T F F F T F 
+4844 F T F F F T F 
+4845 F T F F F T F 
+4846 F T F F F T F 
+4847 F T F F F T F 
+4848 F T F F F T F 
+4849 F T F F F T F 
+4850 F T F F F T F 
+4851 F T F F F T F 
+4852 F T F F F T F 
+4853 F T F F F T F 
+4854 F T F F F T F 
+4855 F T F F F T F 
+4856 F T F F F T F 
+4857 F T F F F T F 
+4858 F T F F F T F 
+4859 F T F F F T F 
+4860 F T F F F T F 
+4861 F T F F F T F 
+4862 F T F F F T F 
+4863 F T F F F T F 
+4864 F T F F F T F 
+4865 F T F F F T F 
+4866 F T F F F T F 
+4867 F T F F F T F 
+4868 F T F F F T F 
+4869 F T F F F T F 
+4870 F T F F F T F 
+4871 F T F F F T F 
+4872 F T F F F T F 
+4873 F T F F F T F 
+4874 F T F F F T F 
+4875 F T F F F T F 
+4876 F T F F F T F 
+4877 F T F F F T F 
+4878 F T F F F T F 
+4879 F T F F F T F 
+4880 F T F F F T F 
+4881 F F F F F F F 
+4882 F T F F F T F 
+4883 F T F F F T F 
+4884 F T F F F T F 
+4885 F T F F F T F 
+4886 F F F F F F F 
+4887 F F F F F F F 
+4888 F T F F F T F 
+4889 F T F F F T F 
+4890 F T F F F T F 
+4891 F T F F F T F 
+4892 F T F F F T F 
+4893 F T F F F T F 
+4894 F T F F F T F 
+4895 F T F F F T F 
+4896 F T F F F T F 
+4897 F T F F F T F 
+4898 F T F F F T F 
+4899 F T F F F T F 
+4900 F T F F F T F 
+4901 F T F F F T F 
+4902 F T F F F T F 
+4903 F T F F F T F 
+4904 F T F F F T F 
+4905 F T F F F T F 
+4906 F T F F F T F 
+4907 F T F F F T F 
+4908 F T F F F T F 
+4909 F T F F F T F 
+4910 F T F F F T F 
+4911 F T F F F T F 
+4912 F T F F F T F 
+4913 F T F F F T F 
+4914 F T F F F T F 
+4915 F T F F F T F 
+4916 F T F F F T F 
+4917 F T F F F T F 
+4918 F T F F F T F 
+4919 F T F F F T F 
+4920 F T F F F T F 
+4921 F T F F F T F 
+4922 F T F F F T F 
+4923 F T F F F T F 
+4924 F T F F F T F 
+4925 F T F F F T F 
+4926 F T F F F T F 
+4927 F T F F F T F 
+4928 F T F F F T F 
+4929 F T F F F T F 
+4930 F T F F F T F 
+4931 F T F F F T F 
+4932 F T F F F T F 
+4933 F T F F F T F 
+4934 F T F F F T F 
+4935 F T F F F T F 
+4936 F T F F F T F 
+4937 F T F F F T F 
+4938 F T F F F T F 
+4939 F T F F F T F 
+4940 F T F F F T F 
+4941 F T F F F T F 
+4942 F T F F F T F 
+4943 F T F F F T F 
+4944 F T F F F T F 
+4945 F T F F F T F 
+4946 F T F F F T F 
+4947 F T F F F T F 
+4948 F T F F F T F 
+4949 F T F F F T F 
+4950 F T F F F T F 
+4951 F T F F F T F 
+4952 F T F F F T F 
+4953 F T F F F T F 
+4954 F T F F F T F 
+4955 F F F F F F F 
+4956 F F F F F F F 
+4957 F T F F F F F 
+4958 F T F F F F F 
+4959 F T F F F F F 
+4960 F T F F F F F 
+4961 F T F F F F F 
+4962 F T F F F F F 
+4963 F T F F F F F 
+4964 F T F F F F F 
+4965 F T F F F F F 
+4966 F T F F F F F 
+4967 F T F F F F F 
+4968 F T F F F F F 
+4969 F T F F F F F 
+4970 F T F F F F F 
+4971 F T F F F F F 
+4972 F T F F F F F 
+4973 F T F F F F F 
+4974 F T F F F F F 
+4975 F T F F F F F 
+4976 F T F F F F F 
+4977 F T F F F F F 
+4978 F T F F F F F 
+4979 F T F F F F F 
+4980 F T F F F F F 
+4981 F T F F F F F 
+4982 F T F F F F F 
+4983 F T F F F F F 
+4984 F T F F F F F 
+4985 F T F F F F F 
+4986 F T F F F F F 
+4987 F T F F F F F 
+4988 F T F F F F F 
+4989 F F F F F F F 
+4990 F F F F F F F 
+4991 F F F F F F F 
+4992 F T F F F T F 
+4993 F T F F F T F 
+4994 F T F F F T F 
+4995 F T F F F T F 
+4996 F T F F F T F 
+4997 F T F F F T F 
+4998 F T F F F T F 
+4999 F T F F F T F 
+5000 F T F F F T F 
+5001 F T F F F T F 
+5002 F T F F F T F 
+5003 F T F F F T F 
+5004 F T F F F T F 
+5005 F T F F F T F 
+5006 F T F F F T F 
+5007 F T F F F T F 
+5008 F T F F F F F 
+5009 F T F F F F F 
+5010 F T F F F F F 
+5011 F T F F F F F 
+5012 F T F F F F F 
+5013 F T F F F F F 
+5014 F T F F F F F 
+5015 F T F F F F F 
+5016 F T F F F F F 
+5017 F T F F F F F 
+5018 F F F F F F F 
+5019 F F F F F F F 
+5020 F F F F F F F 
+5021 F F F F F F F 
+5022 F F F F F F F 
+5023 F F F F F F F 
+5024 F T F F F T F 
+5025 F T F F F T F 
+5026 F T F F F T F 
+5027 F T F F F T F 
+5028 F T F F F T F 
+5029 F T F F F T F 
+5030 F T F F F T F 
+5031 F T F F F T F 
+5032 F T F F F T F 
+5033 F T F F F T F 
+5034 F T F F F T F 
+5035 F T F F F T F 
+5036 F T F F F T F 
+5037 F T F F F T F 
+5038 F T F F F T F 
+5039 F T F F F T F 
+5040 F T F F F T F 
+5041 F T F F F T F 
+5042 F T F F F T F 
+5043 F T F F F T F 
+5044 F T F F F T F 
+5045 F T F F F T F 
+5046 F T F F F T F 
+5047 F T F F F T F 
+5048 F T F F F T F 
+5049 F T F F F T F 
+5050 F T F F F T F 
+5051 F T F F F T F 
+5052 F T F F F T F 
+5053 F T F F F T F 
+5054 F T F F F T F 
+5055 F T F F F T F 
+5056 F T F F F T F 
+5057 F T F F F T F 
+5058 F T F F F T F 
+5059 F T F F F T F 
+5060 F T F F F T F 
+5061 F T F F F T F 
+5062 F T F F F T F 
+5063 F T F F F T F 
+5064 F T F F F T F 
+5065 F T F F F T F 
+5066 F T F F F T F 
+5067 F T F F F T F 
+5068 F T F F F T F 
+5069 F T F F F T F 
+5070 F T F F F T F 
+5071 F T F F F T F 
+5072 F T F F F T F 
+5073 F T F F F T F 
+5074 F T F F F T F 
+5075 F T F F F T F 
+5076 F T F F F T F 
+5077 F T F F F T F 
+5078 F T F F F T F 
+5079 F T F F F T F 
+5080 F T F F F T F 
+5081 F T F F F T F 
+5082 F T F F F T F 
+5083 F T F F F T F 
+5084 F T F F F T F 
+5085 F T F F F T F 
+5086 F T F F F T F 
+5087 F T F F F T F 
+5088 F T F F F T F 
+5089 F T F F F T F 
+5090 F T F F F T F 
+5091 F T F F F T F 
+5092 F T F F F T F 
+5093 F T F F F T F 
+5094 F T F F F T F 
+5095 F T F F F T F 
+5096 F T F F F T F 
+5097 F T F F F T F 
+5098 F T F F F T F 
+5099 F T F F F T F 
+5100 F T F F F T F 
+5101 F T F F F T F 
+5102 F T F F F T F 
+5103 F T F F F T F 
+5104 F T F F F T F 
+5105 F T F F F T F 
+5106 F T F F F T F 
+5107 F T F F F T F 
+5108 F T F F F T F 
+5109 F F F F F F F 
+5110 F F F F F F F 
+5111 F F F F F F F 
+5112 F F F F F F F 
+5113 F F F F F F F 
+5114 F F F F F F F 
+5115 F F F F F F F 
+5116 F F F F F F F 
+5117 F F F F F F F 
+5118 F F F F F F F 
+5119 F F F F F F F 
+5120 F T F F F F F 
+5121 F T F F F T F 
+5122 F T F F F T F 
+5123 F T F F F T F 
+5124 F T F F F T F 
+5125 F T F F F T F 
+5126 F T F F F T F 
+5127 F T F F F T F 
+5128 F T F F F T F 
+5129 F T F F F T F 
+5130 F T F F F T F 
+5131 F T F F F T F 
+5132 F T F F F T F 
+5133 F T F F F T F 
+5134 F T F F F T F 
+5135 F T F F F T F 
+5136 F T F F F T F 
+5137 F T F F F T F 
+5138 F T F F F T F 
+5139 F T F F F T F 
+5140 F T F F F T F 
+5141 F T F F F T F 
+5142 F T F F F T F 
+5143 F T F F F T F 
+5144 F T F F F T F 
+5145 F T F F F T F 
+5146 F T F F F T F 
+5147 F T F F F T F 
+5148 F T F F F T F 
+5149 F T F F F T F 
+5150 F T F F F T F 
+5151 F T F F F T F 
+5152 F T F F F T F 
+5153 F T F F F T F 
+5154 F T F F F T F 
+5155 F T F F F T F 
+5156 F T F F F T F 
+5157 F T F F F T F 
+5158 F T F F F T F 
+5159 F T F F F T F 
+5160 F T F F F T F 
+5161 F T F F F T F 
+5162 F T F F F T F 
+5163 F T F F F T F 
+5164 F T F F F T F 
+5165 F T F F F T F 
+5166 F T F F F T F 
+5167 F T F F F T F 
+5168 F T F F F T F 
+5169 F T F F F T F 
+5170 F T F F F T F 
+5171 F T F F F T F 
+5172 F T F F F T F 
+5173 F T F F F T F 
+5174 F T F F F T F 
+5175 F T F F F T F 
+5176 F T F F F T F 
+5177 F T F F F T F 
+5178 F T F F F T F 
+5179 F T F F F T F 
+5180 F T F F F T F 
+5181 F T F F F T F 
+5182 F T F F F T F 
+5183 F T F F F T F 
+5184 F T F F F T F 
+5185 F T F F F T F 
+5186 F T F F F T F 
+5187 F T F F F T F 
+5188 F T F F F T F 
+5189 F T F F F T F 
+5190 F T F F F T F 
+5191 F T F F F T F 
+5192 F T F F F T F 
+5193 F T F F F T F 
+5194 F T F F F T F 
+5195 F T F F F T F 
+5196 F T F F F T F 
+5197 F T F F F T F 
+5198 F T F F F T F 
+5199 F T F F F T F 
+5200 F T F F F T F 
+5201 F T F F F T F 
+5202 F T F F F T F 
+5203 F T F F F T F 
+5204 F T F F F T F 
+5205 F T F F F T F 
+5206 F T F F F T F 
+5207 F T F F F T F 
+5208 F T F F F T F 
+5209 F T F F F T F 
+5210 F T F F F T F 
+5211 F T F F F T F 
+5212 F T F F F T F 
+5213 F T F F F T F 
+5214 F T F F F T F 
+5215 F T F F F T F 
+5216 F T F F F T F 
+5217 F T F F F T F 
+5218 F T F F F T F 
+5219 F T F F F T F 
+5220 F T F F F T F 
+5221 F T F F F T F 
+5222 F T F F F T F 
+5223 F T F F F T F 
+5224 F T F F F T F 
+5225 F T F F F T F 
+5226 F T F F F T F 
+5227 F T F F F T F 
+5228 F T F F F T F 
+5229 F T F F F T F 
+5230 F T F F F T F 
+5231 F T F F F T F 
+5232 F T F F F T F 
+5233 F T F F F T F 
+5234 F T F F F T F 
+5235 F T F F F T F 
+5236 F T F F F T F 
+5237 F T F F F T F 
+5238 F T F F F T F 
+5239 F T F F F T F 
+5240 F T F F F T F 
+5241 F T F F F T F 
+5242 F T F F F T F 
+5243 F T F F F T F 
+5244 F T F F F T F 
+5245 F T F F F T F 
+5246 F T F F F T F 
+5247 F T F F F T F 
+5248 F T F F F T F 
+5249 F T F F F T F 
+5250 F T F F F T F 
+5251 F T F F F T F 
+5252 F T F F F T F 
+5253 F T F F F T F 
+5254 F T F F F T F 
+5255 F T F F F T F 
+5256 F T F F F T F 
+5257 F T F F F T F 
+5258 F T F F F T F 
+5259 F T F F F T F 
+5260 F T F F F T F 
+5261 F T F F F T F 
+5262 F T F F F T F 
+5263 F T F F F T F 
+5264 F T F F F T F 
+5265 F T F F F T F 
+5266 F T F F F T F 
+5267 F T F F F T F 
+5268 F T F F F T F 
+5269 F T F F F T F 
+5270 F T F F F T F 
+5271 F T F F F T F 
+5272 F T F F F T F 
+5273 F T F F F T F 
+5274 F T F F F T F 
+5275 F T F F F T F 
+5276 F T F F F T F 
+5277 F T F F F T F 
+5278 F T F F F T F 
+5279 F T F F F T F 
+5280 F T F F F T F 
+5281 F T F F F T F 
+5282 F T F F F T F 
+5283 F T F F F T F 
+5284 F T F F F T F 
+5285 F T F F F T F 
+5286 F T F F F T F 
+5287 F T F F F T F 
+5288 F T F F F T F 
+5289 F T F F F T F 
+5290 F T F F F T F 
+5291 F T F F F T F 
+5292 F T F F F T F 
+5293 F T F F F T F 
+5294 F T F F F T F 
+5295 F T F F F T F 
+5296 F T F F F T F 
+5297 F T F F F T F 
+5298 F T F F F T F 
+5299 F T F F F T F 
+5300 F T F F F T F 
+5301 F T F F F T F 
+5302 F T F F F T F 
+5303 F T F F F T F 
+5304 F T F F F T F 
+5305 F T F F F T F 
+5306 F T F F F T F 
+5307 F T F F F T F 
+5308 F T F F F T F 
+5309 F T F F F T F 
+5310 F T F F F T F 
+5311 F T F F F T F 
+5312 F T F F F T F 
+5313 F T F F F T F 
+5314 F T F F F T F 
+5315 F T F F F T F 
+5316 F T F F F T F 
+5317 F T F F F T F 
+5318 F T F F F T F 
+5319 F T F F F T F 
+5320 F T F F F T F 
+5321 F T F F F T F 
+5322 F T F F F T F 
+5323 F T F F F T F 
+5324 F T F F F T F 
+5325 F T F F F T F 
+5326 F T F F F T F 
+5327 F T F F F T F 
+5328 F T F F F T F 
+5329 F T F F F T F 
+5330 F T F F F T F 
+5331 F T F F F T F 
+5332 F T F F F T F 
+5333 F T F F F T F 
+5334 F T F F F T F 
+5335 F T F F F T F 
+5336 F T F F F T F 
+5337 F T F F F T F 
+5338 F T F F F T F 
+5339 F T F F F T F 
+5340 F T F F F T F 
+5341 F T F F F T F 
+5342 F T F F F T F 
+5343 F T F F F T F 
+5344 F T F F F T F 
+5345 F T F F F T F 
+5346 F T F F F T F 
+5347 F T F F F T F 
+5348 F T F F F T F 
+5349 F T F F F T F 
+5350 F T F F F T F 
+5351 F T F F F T F 
+5352 F T F F F T F 
+5353 F T F F F T F 
+5354 F T F F F T F 
+5355 F T F F F T F 
+5356 F T F F F T F 
+5357 F T F F F T F 
+5358 F T F F F T F 
+5359 F T F F F T F 
+5360 F T F F F T F 
+5361 F T F F F T F 
+5362 F T F F F T F 
+5363 F T F F F T F 
+5364 F T F F F T F 
+5365 F T F F F T F 
+5366 F T F F F T F 
+5367 F T F F F T F 
+5368 F T F F F T F 
+5369 F T F F F T F 
+5370 F T F F F T F 
+5371 F T F F F T F 
+5372 F T F F F T F 
+5373 F T F F F T F 
+5374 F T F F F T F 
+5375 F T F F F T F 
+5376 F T F F F T F 
+5377 F T F F F T F 
+5378 F T F F F T F 
+5379 F T F F F T F 
+5380 F T F F F T F 
+5381 F T F F F T F 
+5382 F T F F F T F 
+5383 F T F F F T F 
+5384 F T F F F T F 
+5385 F T F F F T F 
+5386 F T F F F T F 
+5387 F T F F F T F 
+5388 F T F F F T F 
+5389 F T F F F T F 
+5390 F T F F F T F 
+5391 F T F F F T F 
+5392 F T F F F T F 
+5393 F T F F F T F 
+5394 F T F F F T F 
+5395 F T F F F T F 
+5396 F T F F F T F 
+5397 F T F F F T F 
+5398 F T F F F T F 
+5399 F T F F F T F 
+5400 F T F F F T F 
+5401 F T F F F T F 
+5402 F T F F F T F 
+5403 F T F F F T F 
+5404 F T F F F T F 
+5405 F T F F F T F 
+5406 F T F F F T F 
+5407 F T F F F T F 
+5408 F T F F F T F 
+5409 F T F F F T F 
+5410 F T F F F T F 
+5411 F T F F F T F 
+5412 F T F F F T F 
+5413 F T F F F T F 
+5414 F T F F F T F 
+5415 F T F F F T F 
+5416 F T F F F T F 
+5417 F T F F F T F 
+5418 F T F F F T F 
+5419 F T F F F T F 
+5420 F T F F F T F 
+5421 F T F F F T F 
+5422 F T F F F T F 
+5423 F T F F F T F 
+5424 F T F F F T F 
+5425 F T F F F T F 
+5426 F T F F F T F 
+5427 F T F F F T F 
+5428 F T F F F T F 
+5429 F T F F F T F 
+5430 F T F F F T F 
+5431 F T F F F T F 
+5432 F T F F F T F 
+5433 F T F F F T F 
+5434 F T F F F T F 
+5435 F T F F F T F 
+5436 F T F F F T F 
+5437 F T F F F T F 
+5438 F T F F F T F 
+5439 F T F F F T F 
+5440 F T F F F T F 
+5441 F T F F F T F 
+5442 F T F F F T F 
+5443 F T F F F T F 
+5444 F T F F F T F 
+5445 F T F F F T F 
+5446 F T F F F T F 
+5447 F T F F F T F 
+5448 F T F F F T F 
+5449 F T F F F T F 
+5450 F T F F F T F 
+5451 F T F F F T F 
+5452 F T F F F T F 
+5453 F T F F F T F 
+5454 F T F F F T F 
+5455 F T F F F T F 
+5456 F T F F F T F 
+5457 F T F F F T F 
+5458 F T F F F T F 
+5459 F T F F F T F 
+5460 F T F F F T F 
+5461 F T F F F T F 
+5462 F T F F F T F 
+5463 F T F F F T F 
+5464 F T F F F T F 
+5465 F T F F F T F 
+5466 F T F F F T F 
+5467 F T F F F T F 
+5468 F T F F F T F 
+5469 F T F F F T F 
+5470 F T F F F T F 
+5471 F T F F F T F 
+5472 F T F F F T F 
+5473 F T F F F T F 
+5474 F T F F F T F 
+5475 F T F F F T F 
+5476 F T F F F T F 
+5477 F T F F F T F 
+5478 F T F F F T F 
+5479 F T F F F T F 
+5480 F T F F F T F 
+5481 F T F F F T F 
+5482 F T F F F T F 
+5483 F T F F F T F 
+5484 F T F F F T F 
+5485 F T F F F T F 
+5486 F T F F F T F 
+5487 F T F F F T F 
+5488 F T F F F T F 
+5489 F T F F F T F 
+5490 F T F F F T F 
+5491 F T F F F T F 
+5492 F T F F F T F 
+5493 F T F F F T F 
+5494 F T F F F T F 
+5495 F T F F F T F 
+5496 F T F F F T F 
+5497 F T F F F T F 
+5498 F T F F F T F 
+5499 F T F F F T F 
+5500 F T F F F T F 
+5501 F T F F F T F 
+5502 F T F F F T F 
+5503 F T F F F T F 
+5504 F T F F F T F 
+5505 F T F F F T F 
+5506 F T F F F T F 
+5507 F T F F F T F 
+5508 F T F F F T F 
+5509 F T F F F T F 
+5510 F T F F F T F 
+5511 F T F F F T F 
+5512 F T F F F T F 
+5513 F T F F F T F 
+5514 F T F F F T F 
+5515 F T F F F T F 
+5516 F T F F F T F 
+5517 F T F F F T F 
+5518 F T F F F T F 
+5519 F T F F F T F 
+5520 F T F F F T F 
+5521 F T F F F T F 
+5522 F T F F F T F 
+5523 F T F F F T F 
+5524 F T F F F T F 
+5525 F T F F F T F 
+5526 F T F F F T F 
+5527 F T F F F T F 
+5528 F T F F F T F 
+5529 F T F F F T F 
+5530 F T F F F T F 
+5531 F T F F F T F 
+5532 F T F F F T F 
+5533 F T F F F T F 
+5534 F T F F F T F 
+5535 F T F F F T F 
+5536 F T F F F T F 
+5537 F T F F F T F 
+5538 F T F F F T F 
+5539 F T F F F T F 
+5540 F T F F F T F 
+5541 F T F F F T F 
+5542 F T F F F T F 
+5543 F T F F F T F 
+5544 F T F F F T F 
+5545 F T F F F T F 
+5546 F T F F F T F 
+5547 F T F F F T F 
+5548 F T F F F T F 
+5549 F T F F F T F 
+5550 F T F F F T F 
+5551 F T F F F T F 
+5552 F T F F F T F 
+5553 F T F F F T F 
+5554 F T F F F T F 
+5555 F T F F F T F 
+5556 F T F F F T F 
+5557 F T F F F T F 
+5558 F T F F F T F 
+5559 F T F F F T F 
+5560 F T F F F T F 
+5561 F T F F F T F 
+5562 F T F F F T F 
+5563 F T F F F T F 
+5564 F T F F F T F 
+5565 F T F F F T F 
+5566 F T F F F T F 
+5567 F T F F F T F 
+5568 F T F F F T F 
+5569 F T F F F T F 
+5570 F T F F F T F 
+5571 F T F F F T F 
+5572 F T F F F T F 
+5573 F T F F F T F 
+5574 F T F F F T F 
+5575 F T F F F T F 
+5576 F T F F F T F 
+5577 F T F F F T F 
+5578 F T F F F T F 
+5579 F T F F F T F 
+5580 F T F F F T F 
+5581 F T F F F T F 
+5582 F T F F F T F 
+5583 F T F F F T F 
+5584 F T F F F T F 
+5585 F T F F F T F 
+5586 F T F F F T F 
+5587 F T F F F T F 
+5588 F T F F F T F 
+5589 F T F F F T F 
+5590 F T F F F T F 
+5591 F T F F F T F 
+5592 F T F F F T F 
+5593 F T F F F T F 
+5594 F T F F F T F 
+5595 F T F F F T F 
+5596 F T F F F T F 
+5597 F T F F F T F 
+5598 F T F F F T F 
+5599 F T F F F T F 
+5600 F T F F F T F 
+5601 F T F F F T F 
+5602 F T F F F T F 
+5603 F T F F F T F 
+5604 F T F F F T F 
+5605 F T F F F T F 
+5606 F T F F F T F 
+5607 F T F F F T F 
+5608 F T F F F T F 
+5609 F T F F F T F 
+5610 F T F F F T F 
+5611 F T F F F T F 
+5612 F T F F F T F 
+5613 F T F F F T F 
+5614 F T F F F T F 
+5615 F T F F F T F 
+5616 F T F F F T F 
+5617 F T F F F T F 
+5618 F T F F F T F 
+5619 F T F F F T F 
+5620 F T F F F T F 
+5621 F T F F F T F 
+5622 F T F F F T F 
+5623 F T F F F T F 
+5624 F T F F F T F 
+5625 F T F F F T F 
+5626 F T F F F T F 
+5627 F T F F F T F 
+5628 F T F F F T F 
+5629 F T F F F T F 
+5630 F T F F F T F 
+5631 F T F F F T F 
+5632 F T F F F T F 
+5633 F T F F F T F 
+5634 F T F F F T F 
+5635 F T F F F T F 
+5636 F T F F F T F 
+5637 F T F F F T F 
+5638 F T F F F T F 
+5639 F T F F F T F 
+5640 F T F F F T F 
+5641 F T F F F T F 
+5642 F T F F F T F 
+5643 F T F F F T F 
+5644 F T F F F T F 
+5645 F T F F F T F 
+5646 F T F F F T F 
+5647 F T F F F T F 
+5648 F T F F F T F 
+5649 F T F F F T F 
+5650 F T F F F T F 
+5651 F T F F F T F 
+5652 F T F F F T F 
+5653 F T F F F T F 
+5654 F T F F F T F 
+5655 F T F F F T F 
+5656 F T F F F T F 
+5657 F T F F F T F 
+5658 F T F F F T F 
+5659 F T F F F T F 
+5660 F T F F F T F 
+5661 F T F F F T F 
+5662 F T F F F T F 
+5663 F T F F F T F 
+5664 F T F F F T F 
+5665 F T F F F T F 
+5666 F T F F F T F 
+5667 F T F F F T F 
+5668 F T F F F T F 
+5669 F T F F F T F 
+5670 F T F F F T F 
+5671 F T F F F T F 
+5672 F T F F F T F 
+5673 F T F F F T F 
+5674 F T F F F T F 
+5675 F T F F F T F 
+5676 F T F F F T F 
+5677 F T F F F T F 
+5678 F T F F F T F 
+5679 F T F F F T F 
+5680 F T F F F T F 
+5681 F T F F F T F 
+5682 F T F F F T F 
+5683 F T F F F T F 
+5684 F T F F F T F 
+5685 F T F F F T F 
+5686 F T F F F T F 
+5687 F T F F F T F 
+5688 F T F F F T F 
+5689 F T F F F T F 
+5690 F T F F F T F 
+5691 F T F F F T F 
+5692 F T F F F T F 
+5693 F T F F F T F 
+5694 F T F F F T F 
+5695 F T F F F T F 
+5696 F T F F F T F 
+5697 F T F F F T F 
+5698 F T F F F T F 
+5699 F T F F F T F 
+5700 F T F F F T F 
+5701 F T F F F T F 
+5702 F T F F F T F 
+5703 F T F F F T F 
+5704 F T F F F T F 
+5705 F T F F F T F 
+5706 F T F F F T F 
+5707 F T F F F T F 
+5708 F T F F F T F 
+5709 F T F F F T F 
+5710 F T F F F T F 
+5711 F T F F F T F 
+5712 F T F F F T F 
+5713 F T F F F T F 
+5714 F T F F F T F 
+5715 F T F F F T F 
+5716 F T F F F T F 
+5717 F T F F F T F 
+5718 F T F F F T F 
+5719 F T F F F T F 
+5720 F T F F F T F 
+5721 F T F F F T F 
+5722 F T F F F T F 
+5723 F T F F F T F 
+5724 F T F F F T F 
+5725 F T F F F T F 
+5726 F T F F F T F 
+5727 F T F F F T F 
+5728 F T F F F T F 
+5729 F T F F F T F 
+5730 F T F F F T F 
+5731 F T F F F T F 
+5732 F T F F F T F 
+5733 F T F F F T F 
+5734 F T F F F T F 
+5735 F T F F F T F 
+5736 F T F F F T F 
+5737 F T F F F T F 
+5738 F T F F F T F 
+5739 F T F F F T F 
+5740 F T F F F T F 
+5741 F T F F F F F 
+5742 F T F F F F F 
+5743 F T F F F T F 
+5744 F T F F F T F 
+5745 F T F F F T F 
+5746 F T F F F T F 
+5747 F T F F F T F 
+5748 F T F F F T F 
+5749 F T F F F T F 
+5750 F T F F F T F 
+5751 F T F F F T F 
+5752 F T F F F T F 
+5753 F T F F F T F 
+5754 F T F F F T F 
+5755 F T F F F T F 
+5756 F T F F F T F 
+5757 F T F F F T F 
+5758 F T F F F T F 
+5759 F T F F F T F 
+5760 F T T F F F F 
+5761 F T F F F T F 
+5762 F T F F F T F 
+5763 F T F F F T F 
+5764 F T F F F T F 
+5765 F T F F F T F 
+5766 F T F F F T F 
+5767 F T F F F T F 
+5768 F T F F F T F 
+5769 F T F F F T F 
+5770 F T F F F T F 
+5771 F T F F F T F 
+5772 F T F F F T F 
+5773 F T F F F T F 
+5774 F T F F F T F 
+5775 F T F F F T F 
+5776 F T F F F T F 
+5777 F T F F F T F 
+5778 F T F F F T F 
+5779 F T F F F T F 
+5780 F T F F F T F 
+5781 F T F F F T F 
+5782 F T F F F T F 
+5783 F T F F F T F 
+5784 F T F F F T F 
+5785 F T F F F T F 
+5786 F T F F F T F 
+5787 F T F F F F F 
+5788 F T F F F F F 
+5789 F F F F F F F 
+5790 F F F F F F F 
+5791 F F F F F F F 
+5792 F T F F F T F 
+5793 F T F F F T F 
+5794 F T F F F T F 
+5795 F T F F F T F 
+5796 F T F F F T F 
+5797 F T F F F T F 
+5798 F T F F F T F 
+5799 F T F F F T F 
+5800 F T F F F T F 
+5801 F T F F F T F 
+5802 F T F F F T F 
+5803 F T F F F T F 
+5804 F T F F F T F 
+5805 F T F F F T F 
+5806 F T F F F T F 
+5807 F T F F F T F 
+5808 F T F F F T F 
+5809 F T F F F T F 
+5810 F T F F F T F 
+5811 F T F F F T F 
+5812 F T F F F T F 
+5813 F T F F F T F 
+5814 F T F F F T F 
+5815 F T F F F T F 
+5816 F T F F F T F 
+5817 F T F F F T F 
+5818 F T F F F T F 
+5819 F T F F F T F 
+5820 F T F F F T F 
+5821 F T F F F T F 
+5822 F T F F F T F 
+5823 F T F F F T F 
+5824 F T F F F T F 
+5825 F T F F F T F 
+5826 F T F F F T F 
+5827 F T F F F T F 
+5828 F T F F F T F 
+5829 F T F F F T F 
+5830 F T F F F T F 
+5831 F T F F F T F 
+5832 F T F F F T F 
+5833 F T F F F T F 
+5834 F T F F F T F 
+5835 F T F F F T F 
+5836 F T F F F T F 
+5837 F T F F F T F 
+5838 F T F F F T F 
+5839 F T F F F T F 
+5840 F T F F F T F 
+5841 F T F F F T F 
+5842 F T F F F T F 
+5843 F T F F F T F 
+5844 F T F F F T F 
+5845 F T F F F T F 
+5846 F T F F F T F 
+5847 F T F F F T F 
+5848 F T F F F T F 
+5849 F T F F F T F 
+5850 F T F F F T F 
+5851 F T F F F T F 
+5852 F T F F F T F 
+5853 F T F F F T F 
+5854 F T F F F T F 
+5855 F T F F F T F 
+5856 F T F F F T F 
+5857 F T F F F T F 
+5858 F T F F F T F 
+5859 F T F F F T F 
+5860 F T F F F T F 
+5861 F T F F F T F 
+5862 F T F F F T F 
+5863 F T F F F T F 
+5864 F T F F F T F 
+5865 F T F F F T F 
+5866 F T F F F T F 
+5867 F T F F F F F 
+5868 F T F F F F F 
+5869 F T F F F F F 
+5870 F T F F F F F 
+5871 F T F F F F F 
+5872 F T F F F F F 
+5873 F F F F F F F 
+5874 F F F F F F F 
+5875 F F F F F F F 
+5876 F F F F F F F 
+5877 F F F F F F F 
+5878 F F F F F F F 
+5879 F F F F F F F 
+5880 F F F F F F F 
+5881 F F F F F F F 
+5882 F F F F F F F 
+5883 F F F F F F F 
+5884 F F F F F F F 
+5885 F F F F F F F 
+5886 F F F F F F F 
+5887 F F F F F F F 
+5888 F T F F F T F 
+5889 F T F F F T F 
+5890 F T F F F T F 
+5891 F T F F F T F 
+5892 F T F F F T F 
+5893 F T F F F T F 
+5894 F T F F F T F 
+5895 F T F F F T F 
+5896 F T F F F T F 
+5897 F T F F F T F 
+5898 F T F F F T F 
+5899 F T F F F T F 
+5900 F T F F F T F 
+5901 F F F F F F F 
+5902 F T F F F T F 
+5903 F T F F F T F 
+5904 F T F F F T F 
+5905 F T F F F T F 
+5906 F T F F F F F 
+5907 F T F F F F F 
+5908 F T F F F F F 
+5909 F F F F F F F 
+5910 F F F F F F F 
+5911 F F F F F F F 
+5912 F F F F F F F 
+5913 F F F F F F F 
+5914 F F F F F F F 
+5915 F F F F F F F 
+5916 F F F F F F F 
+5917 F F F F F F F 
+5918 F F F F F F F 
+5919 F F F F F F F 
+5920 F T F F F T F 
+5921 F T F F F T F 
+5922 F T F F F T F 
+5923 F T F F F T F 
+5924 F T F F F T F 
+5925 F T F F F T F 
+5926 F T F F F T F 
+5927 F T F F F T F 
+5928 F T F F F T F 
+5929 F T F F F T F 
+5930 F T F F F T F 
+5931 F T F F F T F 
+5932 F T F F F T F 
+5933 F T F F F T F 
+5934 F T F F F T F 
+5935 F T F F F T F 
+5936 F T F F F T F 
+5937 F T F F F T F 
+5938 F T F F F F F 
+5939 F T F F F F F 
+5940 F T F F F F F 
+5941 F T F F F F F 
+5942 F T F F F F F 
+5943 F F F F F F F 
+5944 F F F F F F F 
+5945 F F F F F F F 
+5946 F F F F F F F 
+5947 F F F F F F F 
+5948 F F F F F F F 
+5949 F F F F F F F 
+5950 F F F F F F F 
+5951 F F F F F F F 
+5952 F T F F F T F 
+5953 F T F F F T F 
+5954 F T F F F T F 
+5955 F T F F F T F 
+5956 F T F F F T F 
+5957 F T F F F T F 
+5958 F T F F F T F 
+5959 F T F F F T F 
+5960 F T F F F T F 
+5961 F T F F F T F 
+5962 F T F F F T F 
+5963 F T F F F T F 
+5964 F T F F F T F 
+5965 F T F F F T F 
+5966 F T F F F T F 
+5967 F T F F F T F 
+5968 F T F F F T F 
+5969 F T F F F T F 
+5970 F T F F F F F 
+5971 F T F F F F F 
+5972 F F F F F F F 
+5973 F F F F F F F 
+5974 F F F F F F F 
+5975 F F F F F F F 
+5976 F F F F F F F 
+5977 F F F F F F F 
+5978 F F F F F F F 
+5979 F F F F F F F 
+5980 F F F F F F F 
+5981 F F F F F F F 
+5982 F F F F F F F 
+5983 F F F F F F F 
+5984 F T F F F T F 
+5985 F T F F F T F 
+5986 F T F F F T F 
+5987 F T F F F T F 
+5988 F T F F F T F 
+5989 F T F F F T F 
+5990 F T F F F T F 
+5991 F T F F F T F 
+5992 F T F F F T F 
+5993 F T F F F T F 
+5994 F T F F F T F 
+5995 F T F F F T F 
+5996 F T F F F T F 
+5997 F F F F F F F 
+5998 F T F F F T F 
+5999 F T F F F T F 
+6000 F T F F F T F 
+6001 F F F F F F F 
+6002 F T F F F F F 
+6003 F T F F F F F 
+6004 F F F F F F F 
+6005 F F F F F F F 
+6006 F F F F F F F 
+6007 F F F F F F F 
+6008 F F F F F F F 
+6009 F F F F F F F 
+6010 F F F F F F F 
+6011 F F F F F F F 
+6012 F F F F F F F 
+6013 F F F F F F F 
+6014 F F F F F F F 
+6015 F F F F F F F 
+6016 F T F F F T F 
+6017 F T F F F T F 
+6018 F T F F F T F 
+6019 F T F F F T F 
+6020 F T F F F T F 
+6021 F T F F F T F 
+6022 F T F F F T F 
+6023 F T F F F T F 
+6024 F T F F F T F 
+6025 F T F F F T F 
+6026 F T F F F T F 
+6027 F T F F F T F 
+6028 F T F F F T F 
+6029 F T F F F T F 
+6030 F T F F F T F 
+6031 F T F F F T F 
+6032 F T F F F T F 
+6033 F T F F F T F 
+6034 F T F F F T F 
+6035 F T F F F T F 
+6036 F T F F F T F 
+6037 F T F F F T F 
+6038 F T F F F T F 
+6039 F T F F F T F 
+6040 F T F F F T F 
+6041 F T F F F T F 
+6042 F T F F F T F 
+6043 F T F F F T F 
+6044 F T F F F T F 
+6045 F T F F F T F 
+6046 F T F F F T F 
+6047 F T F F F T F 
+6048 F T F F F T F 
+6049 F T F F F T F 
+6050 F T F F F T F 
+6051 F T F F F T F 
+6052 F T F F F T F 
+6053 F T F F F T F 
+6054 F T F F F T F 
+6055 F T F F F T F 
+6056 F T F F F T F 
+6057 F T F F F T F 
+6058 F T F F F T F 
+6059 F T F F F T F 
+6060 F T F F F T F 
+6061 F T F F F T F 
+6062 F T F F F T F 
+6063 F T F F F T F 
+6064 F T F F F T F 
+6065 F T F F F T F 
+6066 F T F F F T F 
+6067 F T F F F T F 
+6068 F F F F F F F 
+6069 F F F F F F F 
+6070 F T F F F F F 
+6071 F T F F F F F 
+6072 F T F F F F F 
+6073 F T F F F F F 
+6074 F T F F F F F 
+6075 F T F F F F F 
+6076 F T F F F F F 
+6077 F T F F F F F 
+6078 F T F F F F F 
+6079 F T F F F F F 
+6080 F T F F F F F 
+6081 F T F F F F F 
+6082 F T F F F F F 
+6083 F T F F F F F 
+6084 F T F F F F F 
+6085 F T F F F F F 
+6086 F T F F F F F 
+6087 F T F F F F F 
+6088 F T F F F F F 
+6089 F T F F F F F 
+6090 F T F F F F F 
+6091 F T F F F F F 
+6092 F T F F F F F 
+6093 F T F F F F F 
+6094 F T F F F F F 
+6095 F T F F F F F 
+6096 F T F F F F F 
+6097 F T F F F F F 
+6098 F T F F F F F 
+6099 F T F F F F F 
+6100 F T F F F F F 
+6101 F T F F F F F 
+6102 F T F F F F F 
+6103 F T F F F T F 
+6104 F T F F F F F 
+6105 F T F F F F F 
+6106 F T F F F F F 
+6107 F T F F F F F 
+6108 F T F F F T F 
+6109 F T F F F F F 
+6110 F F F F F F F 
+6111 F F F F F F F 
+6112 F T F F F F F 
+6113 F T F F F F F 
+6114 F T F F F F F 
+6115 F T F F F F F 
+6116 F T F F F F F 
+6117 F T F F F F F 
+6118 F T F F F F F 
+6119 F T F F F F F 
+6120 F T F F F F F 
+6121 F T F F F F F 
+6122 F F F F F F F 
+6123 F F F F F F F 
+6124 F F F F F F F 
+6125 F F F F F F F 
+6126 F F F F F F F 
+6127 F F F F F F F 
+6128 F T F F F F F 
+6129 F T F F F F F 
+6130 F T F F F F F 
+6131 F T F F F F F 
+6132 F T F F F F F 
+6133 F T F F F F F 
+6134 F T F F F F F 
+6135 F T F F F F F 
+6136 F T F F F F F 
+6137 F T F F F F F 
+6138 F F F F F F F 
+6139 F F F F F F F 
+6140 F F F F F F F 
+6141 F F F F F F F 
+6142 F F F F F F F 
+6143 F F F F F F F 
+6144 F T F F F F F 
+6145 F T F F F F F 
+6146 F T F F F F F 
+6147 F T F F F F F 
+6148 F T F F F F F 
+6149 F T F F F F F 
+6150 F T F F F F F 
+6151 F T F F F F F 
+6152 F T F F F F F 
+6153 F T F F F F F 
+6154 F T F F F F F 
+6155 F T F F F F F 
+6156 F T F F F F F 
+6157 F T F F F F F 
+6158 F T T F F F F 
+6159 F F F F F F F 
+6160 F T F F F F F 
+6161 F T F F F F F 
+6162 F T F F F F F 
+6163 F T F F F F F 
+6164 F T F F F F F 
+6165 F T F F F F F 
+6166 F T F F F F F 
+6167 F T F F F F F 
+6168 F T F F F F F 
+6169 F T F F F F F 
+6170 F F F F F F F 
+6171 F F F F F F F 
+6172 F F F F F F F 
+6173 F F F F F F F 
+6174 F F F F F F F 
+6175 F F F F F F F 
+6176 F T F F F T F 
+6177 F T F F F T F 
+6178 F T F F F T F 
+6179 F T F F F T F 
+6180 F T F F F T F 
+6181 F T F F F T F 
+6182 F T F F F T F 
+6183 F T F F F T F 
+6184 F T F F F T F 
+6185 F T F F F T F 
+6186 F T F F F T F 
+6187 F T F F F T F 
+6188 F T F F F T F 
+6189 F T F F F T F 
+6190 F T F F F T F 
+6191 F T F F F T F 
+6192 F T F F F T F 
+6193 F T F F F T F 
+6194 F T F F F T F 
+6195 F T F F F T F 
+6196 F T F F F T F 
+6197 F T F F F T F 
+6198 F T F F F T F 
+6199 F T F F F T F 
+6200 F T F F F T F 
+6201 F T F F F T F 
+6202 F T F F F T F 
+6203 F T F F F T F 
+6204 F T F F F T F 
+6205 F T F F F T F 
+6206 F T F F F T F 
+6207 F T F F F T F 
+6208 F T F F F T F 
+6209 F T F F F T F 
+6210 F T F F F T F 
+6211 F T F F F T F 
+6212 F T F F F T F 
+6213 F T F F F T F 
+6214 F T F F F T F 
+6215 F T F F F T F 
+6216 F T F F F T F 
+6217 F T F F F T F 
+6218 F T F F F T F 
+6219 F T F F F T F 
+6220 F T F F F T F 
+6221 F T F F F T F 
+6222 F T F F F T F 
+6223 F T F F F T F 
+6224 F T F F F T F 
+6225 F T F F F T F 
+6226 F T F F F T F 
+6227 F T F F F T F 
+6228 F T F F F T F 
+6229 F T F F F T F 
+6230 F T F F F T F 
+6231 F T F F F T F 
+6232 F T F F F T F 
+6233 F T F F F T F 
+6234 F T F F F T F 
+6235 F T F F F T F 
+6236 F T F F F T F 
+6237 F T F F F T F 
+6238 F T F F F T F 
+6239 F T F F F T F 
+6240 F T F F F T F 
+6241 F T F F F T F 
+6242 F T F F F T F 
+6243 F T F F F T F 
+6244 F T F F F T F 
+6245 F T F F F T F 
+6246 F T F F F T F 
+6247 F T F F F T F 
+6248 F T F F F T F 
+6249 F T F F F T F 
+6250 F T F F F T F 
+6251 F T F F F T F 
+6252 F T F F F T F 
+6253 F T F F F T F 
+6254 F T F F F T F 
+6255 F T F F F T F 
+6256 F T F F F T F 
+6257 F T F F F T F 
+6258 F T F F F T F 
+6259 F T F F F T F 
+6260 F T F F F T F 
+6261 F T F F F T F 
+6262 F T F F F T F 
+6263 F T F F F T F 
+6264 F F F F F F F 
+6265 F F F F F F F 
+6266 F F F F F F F 
+6267 F F F F F F F 
+6268 F F F F F F F 
+6269 F F F F F F F 
+6270 F F F F F F F 
+6271 F F F F F F F 
+6272 F T F F F T F 
+6273 F T F F F T F 
+6274 F T F F F T F 
+6275 F T F F F T F 
+6276 F T F F F T F 
+6277 F T F F F T F 
+6278 F T F F F T F 
+6279 F T F F F T F 
+6280 F T F F F T F 
+6281 F T F F F T F 
+6282 F T F F F T F 
+6283 F T F F F T F 
+6284 F T F F F T F 
+6285 F T F F F T F 
+6286 F T F F F T F 
+6287 F T F F F T F 
+6288 F T F F F T F 
+6289 F T F F F T F 
+6290 F T F F F T F 
+6291 F T F F F T F 
+6292 F T F F F T F 
+6293 F T F F F T F 
+6294 F T F F F T F 
+6295 F T F F F T F 
+6296 F T F F F T F 
+6297 F T F F F T F 
+6298 F T F F F T F 
+6299 F T F F F T F 
+6300 F T F F F T F 
+6301 F T F F F T F 
+6302 F T F F F T F 
+6303 F T F F F T F 
+6304 F T F F F T F 
+6305 F T F F F T F 
+6306 F T F F F T F 
+6307 F T F F F T F 
+6308 F T F F F T F 
+6309 F T F F F T F 
+6310 F T F F F T F 
+6311 F T F F F T F 
+6312 F T F F F T F 
+6313 F T F F F F F 
+6314 F T F F F T F 
+6315 F F F F F F F 
+6316 F F F F F F F 
+6317 F F F F F F F 
+6318 F F F F F F F 
+6319 F F F F F F F 
+6320 F T F F F T F 
+6321 F T F F F T F 
+6322 F T F F F T F 
+6323 F T F F F T F 
+6324 F T F F F T F 
+6325 F T F F F T F 
+6326 F T F F F T F 
+6327 F T F F F T F 
+6328 F T F F F T F 
+6329 F T F F F T F 
+6330 F T F F F T F 
+6331 F T F F F T F 
+6332 F T F F F T F 
+6333 F T F F F T F 
+6334 F T F F F T F 
+6335 F T F F F T F 
+6336 F T F F F T F 
+6337 F T F F F T F 
+6338 F T F F F T F 
+6339 F T F F F T F 
+6340 F T F F F T F 
+6341 F T F F F T F 
+6342 F T F F F T F 
+6343 F T F F F T F 
+6344 F T F F F T F 
+6345 F T F F F T F 
+6346 F T F F F T F 
+6347 F T F F F T F 
+6348 F T F F F T F 
+6349 F T F F F T F 
+6350 F T F F F T F 
+6351 F T F F F T F 
+6352 F T F F F T F 
+6353 F T F F F T F 
+6354 F T F F F T F 
+6355 F T F F F T F 
+6356 F T F F F T F 
+6357 F T F F F T F 
+6358 F T F F F T F 
+6359 F T F F F T F 
+6360 F T F F F T F 
+6361 F T F F F T F 
+6362 F T F F F T F 
+6363 F T F F F T F 
+6364 F T F F F T F 
+6365 F T F F F T F 
+6366 F T F F F T F 
+6367 F T F F F T F 
+6368 F T F F F T F 
+6369 F T F F F T F 
+6370 F T F F F T F 
+6371 F T F F F T F 
+6372 F T F F F T F 
+6373 F T F F F T F 
+6374 F T F F F T F 
+6375 F T F F F T F 
+6376 F T F F F T F 
+6377 F T F F F T F 
+6378 F T F F F T F 
+6379 F T F F F T F 
+6380 F T F F F T F 
+6381 F T F F F T F 
+6382 F T F F F T F 
+6383 F T F F F T F 
+6384 F T F F F T F 
+6385 F T F F F T F 
+6386 F T F F F T F 
+6387 F T F F F T F 
+6388 F T F F F T F 
+6389 F T F F F T F 
+6390 F F F F F F F 
+6391 F F F F F F F 
+6392 F F F F F F F 
+6393 F F F F F F F 
+6394 F F F F F F F 
+6395 F F F F F F F 
+6396 F F F F F F F 
+6397 F F F F F F F 
+6398 F F F F F F F 
+6399 F F F F F F F 
+6400 F T F F F T F 
+6401 F T F F F T F 
+6402 F T F F F T F 
+6403 F T F F F T F 
+6404 F T F F F T F 
+6405 F T F F F T F 
+6406 F T F F F T F 
+6407 F T F F F T F 
+6408 F T F F F T F 
+6409 F T F F F T F 
+6410 F T F F F T F 
+6411 F T F F F T F 
+6412 F T F F F T F 
+6413 F T F F F T F 
+6414 F T F F F T F 
+6415 F T F F F T F 
+6416 F T F F F T F 
+6417 F T F F F T F 
+6418 F T F F F T F 
+6419 F T F F F T F 
+6420 F T F F F T F 
+6421 F T F F F T F 
+6422 F T F F F T F 
+6423 F T F F F T F 
+6424 F T F F F T F 
+6425 F T F F F T F 
+6426 F T F F F T F 
+6427 F T F F F T F 
+6428 F T F F F T F 
+6429 F F F F F F F 
+6430 F F F F F F F 
+6431 F F F F F F F 
+6432 F T F F F F F 
+6433 F T F F F F F 
+6434 F T F F F F F 
+6435 F T F F F F F 
+6436 F T F F F F F 
+6437 F T F F F F F 
+6438 F T F F F F F 
+6439 F T F F F F F 
+6440 F T F F F F F 
+6441 F T F F F F F 
+6442 F T F F F F F 
+6443 F T F F F F F 
+6444 F F F F F F F 
+6445 F F F F F F F 
+6446 F F F F F F F 
+6447 F F F F F F F 
+6448 F T F F F F F 
+6449 F T F F F F F 
+6450 F T F F F F F 
+6451 F T F F F F F 
+6452 F T F F F F F 
+6453 F T F F F F F 
+6454 F T F F F F F 
+6455 F T F F F F F 
+6456 F T F F F F F 
+6457 F T F F F F F 
+6458 F T F F F F F 
+6459 F T F F F F F 
+6460 F F F F F F F 
+6461 F F F F F F F 
+6462 F F F F F F F 
+6463 F F F F F F F 
+6464 F T F F F F F 
+6465 F F F F F F F 
+6466 F F F F F F F 
+6467 F F F F F F F 
+6468 F T F F F F F 
+6469 F T F F F F F 
+6470 F T F F F F F 
+6471 F T F F F F F 
+6472 F T F F F F F 
+6473 F T F F F F F 
+6474 F T F F F F F 
+6475 F T F F F F F 
+6476 F T F F F F F 
+6477 F T F F F F F 
+6478 F T F F F F F 
+6479 F T F F F F F 
+6480 F T F F F T F 
+6481 F T F F F T F 
+6482 F T F F F T F 
+6483 F T F F F T F 
+6484 F T F F F T F 
+6485 F T F F F T F 
+6486 F T F F F T F 
+6487 F T F F F T F 
+6488 F T F F F T F 
+6489 F T F F F T F 
+6490 F T F F F T F 
+6491 F T F F F T F 
+6492 F T F F F T F 
+6493 F T F F F T F 
+6494 F T F F F T F 
+6495 F T F F F T F 
+6496 F T F F F T F 
+6497 F T F F F T F 
+6498 F T F F F T F 
+6499 F T F F F T F 
+6500 F T F F F T F 
+6501 F T F F F T F 
+6502 F T F F F T F 
+6503 F T F F F T F 
+6504 F T F F F T F 
+6505 F T F F F T F 
+6506 F T F F F T F 
+6507 F T F F F T F 
+6508 F T F F F T F 
+6509 F T F F F T F 
+6510 F F F F F F F 
+6511 F F F F F F F 
+6512 F T F F F T F 
+6513 F T F F F T F 
+6514 F T F F F T F 
+6515 F T F F F T F 
+6516 F T F F F T F 
+6517 F F F F F F F 
+6518 F F F F F F F 
+6519 F F F F F F F 
+6520 F F F F F F F 
+6521 F F F F F F F 
+6522 F F F F F F F 
+6523 F F F F F F F 
+6524 F F F F F F F 
+6525 F F F F F F F 
+6526 F F F F F F F 
+6527 F F F F F F F 
+6528 F T F F F T F 
+6529 F T F F F T F 
+6530 F T F F F T F 
+6531 F T F F F T F 
+6532 F T F F F T F 
+6533 F T F F F T F 
+6534 F T F F F T F 
+6535 F T F F F T F 
+6536 F T F F F T F 
+6537 F T F F F T F 
+6538 F T F F F T F 
+6539 F T F F F T F 
+6540 F T F F F T F 
+6541 F T F F F T F 
+6542 F T F F F T F 
+6543 F T F F F T F 
+6544 F T F F F T F 
+6545 F T F F F T F 
+6546 F T F F F T F 
+6547 F T F F F T F 
+6548 F T F F F T F 
+6549 F T F F F T F 
+6550 F T F F F T F 
+6551 F T F F F T F 
+6552 F T F F F T F 
+6553 F T F F F T F 
diff --git a/libraries/base/tests/weak001.hs b/libraries/base/tests/weak001.hs
new file mode 100644
index 000000000000..60dc9c4a1208
--- /dev/null
+++ b/libraries/base/tests/weak001.hs
@@ -0,0 +1,12 @@
+import Foreign
+import System.Mem.Weak
+
+kill:: Ptr a -> IO ()
+kill a = do
+    w <- mkWeakPtr a Nothing
+    addFinalizer a $
+        deRefWeak w >> return ()
+
+main:: IO ()
+main = sequence_ . take 10000 . repeat $
+    mallocBytes 100 >>= kill >> return ()
diff --git a/libraries/bin-package-db/Distribution/InstalledPackageInfo/Binary.hs b/libraries/bin-package-db/Distribution/InstalledPackageInfo/Binary.hs
index 27e23d8959b4..baf8a05159a7 100644
--- a/libraries/bin-package-db/Distribution/InstalledPackageInfo/Binary.hs
+++ b/libraries/bin-package-db/Distribution/InstalledPackageInfo/Binary.hs
@@ -1,11 +1,10 @@
-{-# LANGUAGE CPP, RecordWildCards, TypeSynonymInstances, StandaloneDeriving, GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE RecordWildCards, Trustworthy, TypeSynonymInstances, StandaloneDeriving,
+             GeneralizedNewtypeDeriving #-}
 {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
 -- This module deliberately defines orphan instances for now. Should
 -- become unnecessary once we move to using the binary package properly:
 {-# OPTIONS_GHC -fno-warn-orphans #-}
-#if __GLASGOW_HASKELL__ >= 701
-{-# LANGUAGE Trustworthy #-}
-#endif
+
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Distribution.InstalledPackageInfo.Binary
@@ -23,6 +22,7 @@ module Distribution.InstalledPackageInfo.Binary (
 import Distribution.Version
 import Distribution.Package hiding (depends)
 import Distribution.License
+import Distribution.ModuleExport
 import Distribution.InstalledPackageInfo as IPI
 import Data.Binary as Bin
 import Control.Exception as Exception
@@ -49,6 +49,7 @@ putInstalledPackageInfo :: Binary m => InstalledPackageInfo_ m -> Put
 putInstalledPackageInfo ipi = do
   put (sourcePackageId ipi)
   put (installedPackageId ipi)
+  put (packageKey ipi)
   put (license ipi)
   put (copyright ipi)
   put (maintainer ipi)
@@ -61,6 +62,7 @@ putInstalledPackageInfo ipi = do
   put (category ipi)
   put (exposed ipi)
   put (exposedModules ipi)
+  put (reexportedModules ipi)
   put (hiddenModules ipi)
   put (trusted ipi)
   put (importDirs ipi)
@@ -83,6 +85,7 @@ getInstalledPackageInfo :: Binary m => Get (InstalledPackageInfo_ m)
 getInstalledPackageInfo = do
   sourcePackageId <- get
   installedPackageId <- get
+  packageKey <- get
   license <- get
   copyright <- get
   maintainer <- get
@@ -95,6 +98,7 @@ getInstalledPackageInfo = do
   category <- get
   exposed <- get
   exposedModules <- get
+  reexportedModules <- get
   hiddenModules <- get
   trusted <- get
   importDirs <- get
@@ -132,7 +136,9 @@ instance Binary License where
   put OtherLicense         = do putWord8 7
   put (Apache v)           = do putWord8 8; put v
   put (AGPL v)             = do putWord8 9; put v
-  put (UnknownLicense str) = do putWord8 10; put str
+  put BSD2                 = do putWord8 10
+  put (MPL v)              = do putWord8 11; put v
+  put (UnknownLicense str) = do putWord8 12; put str
 
   get = do
     n <- getWord8
@@ -147,6 +153,8 @@ instance Binary License where
       7 -> return OtherLicense
       8 -> do v <- get; return (Apache v)
       9 -> do v <- get; return (AGPL v)
+      10 -> return BSD2
+      11 -> do v <- get; return (MPL v)
       _ -> do str <- get; return (UnknownLicense str)
 
 instance Binary Version where
@@ -155,3 +163,17 @@ instance Binary Version where
 
 deriving instance Binary PackageName
 deriving instance Binary InstalledPackageId
+
+instance Binary m => Binary (ModuleExport m) where
+  put (ModuleExport a b c d) = do put a; put b; put c; put d
+  get = do a <- get; b <- get; c <- get; d <- get;
+           return (ModuleExport a b c d)
+
+instance Binary PackageKey where
+  put (PackageKey a b c) = do putWord8 0; put a; put b; put c
+  put (OldPackageKey a) = do putWord8 1; put a
+  get = do n <- getWord8
+           case n of
+            0 -> do a <- get; b <- get; c <- get; return (PackageKey a b c)
+            1 -> do a <- get; return (OldPackageKey a)
+            _ -> error ("Binary PackageKey: bad branch " ++ show n)
diff --git a/libraries/bin-package-db/bin-package-db.cabal b/libraries/bin-package-db/bin-package-db.cabal
index 1d3054ce85f5..e8b4fd45ee44 100644
--- a/libraries/bin-package-db/bin-package-db.cabal
+++ b/libraries/bin-package-db/bin-package-db.cabal
@@ -4,22 +4,27 @@ license:        BSD3
 maintainer:     ghc-devs@haskell.org
 bug-reports:    glasgow-haskell-bugs@haskell.org
 synopsis:       A binary format for the package database
-cabal-version:  >=1.6
-build-type: Simple
+cabal-version:  >=1.10
+build-type:     Simple
 
 source-repository head
     type:     git
     location: http://git.haskell.org/ghc.git
     subdir:   libraries/bin-package-db
 
-Library {
+Library
+    default-language: Haskell2010
+    other-extensions:
+            GeneralizedNewtypeDeriving
+            RecordWildCards
+            StandaloneDeriving
+            Trustworthy
+            TypeSynonymInstances
+
     exposed-modules:
             Distribution.InstalledPackageInfo.Binary
 
-    build-depends: base >= 4 && < 5
-
-    build-depends: binary >= 0.5 && < 0.8,
-                   Cabal >= 1.18 && < 1.19
+    build-depends: base >= 4 && < 5,
+                   binary >= 0.5 && < 0.8,
+                   Cabal >= 1.20 && < 1.22
 
-    extensions: CPP
-}
diff --git a/libraries/binary b/libraries/binary
index 2799c25d85b4..2647d42f19be 160000
--- a/libraries/binary
+++ b/libraries/binary
@@ -1 +1 @@
-Subproject commit 2799c25d85b4627200f2e4dcb30d2128488780c3
+Subproject commit 2647d42f19bedae46c020fc3af029073f5690d5b
diff --git a/libraries/containers b/libraries/containers
index 13902bd436b5..e84c5d214541 160000
--- a/libraries/containers
+++ b/libraries/containers
@@ -1 +1 @@
-Subproject commit 13902bd436b54f400a1ddddba6f4ee4e9e517a26
+Subproject commit e84c5d2145415cb0beacce0909a551ae5e28d396
diff --git a/libraries/deepseq b/libraries/deepseq
new file mode 160000
index 000000000000..3a9c431e4c89
--- /dev/null
+++ b/libraries/deepseq
@@ -0,0 +1 @@
+Subproject commit 3a9c431e4c89ca506aae8e80867cfcde8c099724
diff --git a/libraries/directory b/libraries/directory
new file mode 160000
index 000000000000..54c677d227b2
--- /dev/null
+++ b/libraries/directory
@@ -0,0 +1 @@
+Subproject commit 54c677d227b278de694b10398404981d64ece62f
diff --git a/libraries/dph b/libraries/dph
new file mode 160000
index 000000000000..3ebad521cd1e
--- /dev/null
+++ b/libraries/dph
@@ -0,0 +1 @@
+Subproject commit 3ebad521cd1e3b5573d97b483305ca465a9cba69
diff --git a/libraries/filepath b/libraries/filepath
new file mode 160000
index 000000000000..57d9b11e4a55
--- /dev/null
+++ b/libraries/filepath
@@ -0,0 +1 @@
+Subproject commit 57d9b11e4a551588ae5df4013e192ff6ec7812f3
diff --git a/libraries/ghc-prim/.gitignore b/libraries/ghc-prim/.gitignore
new file mode 100644
index 000000000000..896a42e0ae14
--- /dev/null
+++ b/libraries/ghc-prim/.gitignore
@@ -0,0 +1,3 @@
+/dist-install/
+/ghc.mk
+/GNUmakefile
\ No newline at end of file
diff --git a/libraries/ghc-prim/GHC/CString.hs b/libraries/ghc-prim/GHC/CString.hs
new file mode 100644
index 000000000000..53d1ddd371e1
--- /dev/null
+++ b/libraries/ghc-prim/GHC/CString.hs
@@ -0,0 +1,122 @@
+{-# LANGUAGE MagicHash, NoImplicitPrelude, BangPatterns #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.CString
+-- Copyright   :  (c) The University of Glasgow 2011
+-- License     :  see libraries/ghc-prim/LICENSE
+--
+-- Maintainer  :  cvs-ghc@haskell.org
+-- Stability   :  internal
+-- Portability :  non-portable (GHC Extensions)
+--
+-- GHC C strings definitions (previously in GHC.Base).
+-- Use GHC.Exts from the base package instead of importing this
+-- module directly.
+--
+-----------------------------------------------------------------------------
+
+module GHC.CString (
+        unpackCString#, unpackAppendCString#, unpackFoldrCString#,
+        unpackCStringUtf8#, unpackNBytes#
+    ) where
+
+import GHC.Types
+import GHC.Prim
+
+-----------------------------------------------------------------------------
+-- Unpacking C strings}
+-----------------------------------------------------------------------------
+
+-- This code is needed for virtually all programs, since it's used for
+-- unpacking the strings of error messages.
+
+-- Used to be in GHC.Base, but was moved to ghc-prim because the new generics
+-- stuff uses Strings in the representation, so to give representations for
+-- ghc-prim types we need unpackCString#
+
+unpackCString# :: Addr# -> [Char]
+{-# NOINLINE unpackCString# #-}
+    -- There's really no point in inlining this, ever, as the loop doesn't
+    -- specialise in an interesting But it's pretty small, so there's a danger
+    -- that it'll be inlined at every literal, which is a waste
+unpackCString# addr
+  = unpack 0#
+  where
+    unpack nh
+      | isTrue# (ch `eqChar#` '\0'#) = []
+      | True                         = C# ch : unpack (nh +# 1#)
+      where
+        !ch = indexCharOffAddr# addr nh
+
+unpackAppendCString# :: Addr# -> [Char] -> [Char]
+{-# NOINLINE unpackAppendCString# #-}
+     -- See the NOINLINE note on unpackCString#
+unpackAppendCString# addr rest
+  = unpack 0#
+  where
+    unpack nh
+      | isTrue# (ch `eqChar#` '\0'#) = rest
+      | True                         = C# ch : unpack (nh +# 1#)
+      where
+        !ch = indexCharOffAddr# addr nh
+
+unpackFoldrCString# :: Addr# -> (Char  -> a -> a) -> a -> a
+
+-- Usually the unpack-list rule turns unpackFoldrCString# into unpackCString#
+
+-- It also has a BuiltInRule in PrelRules.lhs:
+--      unpackFoldrCString# "foo" c (unpackFoldrCString# "baz" c n)
+--        =  unpackFoldrCString# "foobaz" c n
+
+{-# NOINLINE unpackFoldrCString# #-}
+-- At one stage I had NOINLINE [0] on the grounds that, unlike
+-- unpackCString#, there *is* some point in inlining
+-- unpackFoldrCString#, because we get better code for the
+-- higher-order function call.  BUT there may be a lot of
+-- literal strings, and making a separate 'unpack' loop for
+-- each is highly gratuitous.  See nofib/real/anna/PrettyPrint.
+
+unpackFoldrCString# addr f z
+  = unpack 0#
+  where
+    unpack nh
+      | isTrue# (ch `eqChar#` '\0'#) = z
+      | True                         = C# ch `f` unpack (nh +# 1#)
+      where
+        !ch = indexCharOffAddr# addr nh
+
+unpackCStringUtf8# :: Addr# -> [Char]
+unpackCStringUtf8# addr
+  = unpack 0#
+  where
+    unpack nh
+      | isTrue# (ch `eqChar#` '\0'#  ) = []
+      | isTrue# (ch `leChar#` '\x7F'#) = C# ch : unpack (nh +# 1#)
+      | isTrue# (ch `leChar#` '\xDF'#) =
+          C# (chr# (((ord# ch                                  -# 0xC0#) `uncheckedIShiftL#`  6#) +#
+                     (ord# (indexCharOffAddr# addr (nh +# 1#)) -# 0x80#))) :
+          unpack (nh +# 2#)
+      | isTrue# (ch `leChar#` '\xEF'#) =
+          C# (chr# (((ord# ch                                  -# 0xE0#) `uncheckedIShiftL#` 12#) +#
+                    ((ord# (indexCharOffAddr# addr (nh +# 1#)) -# 0x80#) `uncheckedIShiftL#`  6#) +#
+                     (ord# (indexCharOffAddr# addr (nh +# 2#)) -# 0x80#))) :
+          unpack (nh +# 3#)
+      | True                           =
+          C# (chr# (((ord# ch                                  -# 0xF0#) `uncheckedIShiftL#` 18#) +#
+                    ((ord# (indexCharOffAddr# addr (nh +# 1#)) -# 0x80#) `uncheckedIShiftL#` 12#) +#
+                    ((ord# (indexCharOffAddr# addr (nh +# 2#)) -# 0x80#) `uncheckedIShiftL#`  6#) +#
+                     (ord# (indexCharOffAddr# addr (nh +# 3#)) -# 0x80#))) :
+          unpack (nh +# 4#)
+      where
+        !ch = indexCharOffAddr# addr nh
+
+unpackNBytes# :: Addr# -> Int# -> [Char]
+unpackNBytes# _addr 0#   = []
+unpackNBytes#  addr len# = unpack [] (len# -# 1#)
+    where
+     unpack acc i#
+      | isTrue# (i# <# 0#)  = acc
+      | True                =
+         case indexCharOffAddr# addr i# of
+            ch -> unpack (C# ch : acc) (i# -# 1#)
+
diff --git a/libraries/ghc-prim/GHC/Classes.hs b/libraries/ghc-prim/GHC/Classes.hs
new file mode 100644
index 000000000000..5bb4cb681c50
--- /dev/null
+++ b/libraries/ghc-prim/GHC/Classes.hs
@@ -0,0 +1,295 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE NoImplicitPrelude, MagicHash, StandaloneDeriving, BangPatterns #-}
+{-# OPTIONS_GHC -fno-warn-unused-imports #-}
+-- XXX -fno-warn-unused-imports needed for the GHC.Tuple import below. Sigh.
+{-# OPTIONS_HADDOCK hide #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.Classes
+-- Copyright   :  (c) The University of Glasgow, 1992-2002
+-- License     :  see libraries/base/LICENSE
+--
+-- Maintainer  :  cvs-ghc@haskell.org
+-- Stability   :  internal
+-- Portability :  non-portable (GHC extensions)
+--
+-- Basic classes.
+--
+-----------------------------------------------------------------------------
+
+module GHC.Classes where
+
+-- GHC.Magic is used in some derived instances
+import GHC.Magic ()
+import GHC.Prim
+import GHC.Tuple
+import GHC.Types
+
+
+infix  4  ==, /=, <, <=, >=, >
+infixr 3  &&
+infixr 2  ||
+
+default ()              -- Double isn't available yet
+
+-- | The 'Eq' class defines equality ('==') and inequality ('/=').
+-- All the basic datatypes exported by the "Prelude" are instances of 'Eq',
+-- and 'Eq' may be derived for any datatype whose constituents are also
+-- instances of 'Eq'.
+--
+-- Minimal complete definition: either '==' or '/='.
+--
+class  Eq a  where
+    (==), (/=)           :: a -> a -> Bool
+
+    {-# INLINE (/=) #-}
+    {-# INLINE (==) #-}
+    x /= y               = not (x == y)
+    x == y               = not (x /= y)
+    {-# MINIMAL (==) | (/=) #-}
+
+deriving instance Eq ()
+deriving instance (Eq  a, Eq  b) => Eq  (a, b)
+deriving instance (Eq  a, Eq  b, Eq  c) => Eq  (a, b, c)
+deriving instance (Eq  a, Eq  b, Eq  c, Eq  d) => Eq  (a, b, c, d)
+deriving instance (Eq  a, Eq  b, Eq  c, Eq  d, Eq  e) => Eq  (a, b, c, d, e)
+deriving instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f)
+               => Eq (a, b, c, d, e, f)
+deriving instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g)
+               => Eq (a, b, c, d, e, f, g)
+deriving instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g,
+                   Eq h)
+               => Eq (a, b, c, d, e, f, g, h)
+deriving instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g,
+                   Eq h, Eq i)
+               => Eq (a, b, c, d, e, f, g, h, i)
+deriving instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g,
+                   Eq h, Eq i, Eq j)
+               => Eq (a, b, c, d, e, f, g, h, i, j)
+deriving instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g,
+                   Eq h, Eq i, Eq j, Eq k)
+               => Eq (a, b, c, d, e, f, g, h, i, j, k)
+deriving instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g,
+                   Eq h, Eq i, Eq j, Eq k, Eq l)
+               => Eq (a, b, c, d, e, f, g, h, i, j, k, l)
+deriving instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g,
+                   Eq h, Eq i, Eq j, Eq k, Eq l, Eq m)
+               => Eq (a, b, c, d, e, f, g, h, i, j, k, l, m)
+deriving instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g,
+                   Eq h, Eq i, Eq j, Eq k, Eq l, Eq m, Eq n)
+               => Eq (a, b, c, d, e, f, g, h, i, j, k, l, m, n)
+deriving instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g,
+                   Eq h, Eq i, Eq j, Eq k, Eq l, Eq m, Eq n, Eq o)
+               => Eq (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o)
+
+instance (Eq a) => Eq [a] where
+    {-# SPECIALISE instance Eq [Char] #-}
+    []     == []     = True
+    (x:xs) == (y:ys) = x == y && xs == ys
+    _xs    == _ys    = False
+
+deriving instance Eq Bool
+deriving instance Eq Ordering
+deriving instance Eq Word
+
+instance Eq Char where
+    (C# c1) == (C# c2) = isTrue# (c1 `eqChar#` c2)
+    (C# c1) /= (C# c2) = isTrue# (c1 `neChar#` c2)
+
+instance Eq Float where
+    (F# x) == (F# y) = isTrue# (x `eqFloat#` y)
+
+instance Eq Double where
+    (D# x) == (D# y) = isTrue# (x ==## y)
+
+instance Eq Int where
+    (==) = eqInt
+    (/=) = neInt
+
+{-# INLINE eqInt #-}
+{-# INLINE neInt #-}
+eqInt, neInt :: Int -> Int -> Bool
+(I# x) `eqInt` (I# y) = isTrue# (x ==# y)
+(I# x) `neInt` (I# y) = isTrue# (x /=# y)
+
+-- | The 'Ord' class is used for totally ordered datatypes.
+--
+-- Instances of 'Ord' can be derived for any user-defined
+-- datatype whose constituent types are in 'Ord'.  The declared order
+-- of the constructors in the data declaration determines the ordering
+-- in derived 'Ord' instances.  The 'Ordering' datatype allows a single
+-- comparison to determine the precise ordering of two objects.
+--
+-- Minimal complete definition: either 'compare' or '<='.
+-- Using 'compare' can be more efficient for complex types.
+--
+class  (Eq a) => Ord a  where
+    compare              :: a -> a -> Ordering
+    (<), (<=), (>), (>=) :: a -> a -> Bool
+    max, min             :: a -> a -> a
+
+    compare x y = if x == y then EQ
+                  -- NB: must be '<=' not '<' to validate the
+                  -- above claim about the minimal things that
+                  -- can be defined for an instance of Ord:
+                  else if x <= y then LT
+                  else GT
+
+    x <  y = case compare x y of { LT -> True;  _ -> False }
+    x <= y = case compare x y of { GT -> False; _ -> True }
+    x >  y = case compare x y of { GT -> True;  _ -> False }
+    x >= y = case compare x y of { LT -> False; _ -> True }
+
+        -- These two default methods use '<=' rather than 'compare'
+        -- because the latter is often more expensive
+    max x y = if x <= y then y else x
+    min x y = if x <= y then x else y
+    {-# MINIMAL compare | (<=) #-}
+
+deriving instance Ord ()
+deriving instance (Ord a, Ord b) => Ord (a, b)
+deriving instance (Ord a, Ord b, Ord c) => Ord (a, b, c)
+deriving instance (Ord a, Ord b, Ord c, Ord d) => Ord (a, b, c, d)
+deriving instance (Ord a, Ord b, Ord c, Ord d, Ord e) => Ord (a, b, c, d, e)
+deriving instance (Ord a, Ord b, Ord c, Ord d, Ord e, Ord f)
+               => Ord (a, b, c, d, e, f)
+deriving instance (Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g)
+               => Ord (a, b, c, d, e, f, g)
+deriving instance (Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g,
+                   Ord h)
+               => Ord (a, b, c, d, e, f, g, h)
+deriving instance (Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g,
+                   Ord h, Ord i)
+               => Ord (a, b, c, d, e, f, g, h, i)
+deriving instance (Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g,
+                   Ord h, Ord i, Ord j)
+               => Ord (a, b, c, d, e, f, g, h, i, j)
+deriving instance (Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g,
+                   Ord h, Ord i, Ord j, Ord k)
+               => Ord (a, b, c, d, e, f, g, h, i, j, k)
+deriving instance (Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g,
+                   Ord h, Ord i, Ord j, Ord k, Ord l)
+               => Ord (a, b, c, d, e, f, g, h, i, j, k, l)
+deriving instance (Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g,
+                   Ord h, Ord i, Ord j, Ord k, Ord l, Ord m)
+               => Ord (a, b, c, d, e, f, g, h, i, j, k, l, m)
+deriving instance (Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g,
+                   Ord h, Ord i, Ord j, Ord k, Ord l, Ord m, Ord n)
+               => Ord (a, b, c, d, e, f, g, h, i, j, k, l, m, n)
+deriving instance (Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g,
+                   Ord h, Ord i, Ord j, Ord k, Ord l, Ord m, Ord n, Ord o)
+               => Ord (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o)
+
+instance (Ord a) => Ord [a] where
+    {-# SPECIALISE instance Ord [Char] #-}
+    compare []     []     = EQ
+    compare []     (_:_)  = LT
+    compare (_:_)  []     = GT
+    compare (x:xs) (y:ys) = case compare x y of
+                                EQ    -> compare xs ys
+                                other -> other
+
+deriving instance Ord Bool
+deriving instance Ord Ordering
+deriving instance Ord Word
+
+-- We don't use deriving for Ord Char, because for Ord the derived
+-- instance defines only compare, which takes two primops.  Then
+-- '>' uses compare, and therefore takes two primops instead of one.
+instance Ord Char where
+    (C# c1) >  (C# c2) = isTrue# (c1 `gtChar#` c2)
+    (C# c1) >= (C# c2) = isTrue# (c1 `geChar#` c2)
+    (C# c1) <= (C# c2) = isTrue# (c1 `leChar#` c2)
+    (C# c1) <  (C# c2) = isTrue# (c1 `ltChar#` c2)
+
+instance Ord Float where
+    (F# x) `compare` (F# y)
+        = if      isTrue# (x `ltFloat#` y) then LT
+          else if isTrue# (x `eqFloat#` y) then EQ
+          else                                  GT
+
+    (F# x) <  (F# y) = isTrue# (x `ltFloat#` y)
+    (F# x) <= (F# y) = isTrue# (x `leFloat#` y)
+    (F# x) >= (F# y) = isTrue# (x `geFloat#` y)
+    (F# x) >  (F# y) = isTrue# (x `gtFloat#` y)
+
+instance Ord Double where
+    (D# x) `compare` (D# y)
+        = if      isTrue# (x <##  y) then LT
+          else if isTrue# (x ==## y) then EQ
+          else                            GT
+
+    (D# x) <  (D# y) = isTrue# (x <##  y)
+    (D# x) <= (D# y) = isTrue# (x <=## y)
+    (D# x) >= (D# y) = isTrue# (x >=## y)
+    (D# x) >  (D# y) = isTrue# (x >##  y)
+
+instance Ord Int where
+    compare = compareInt
+    (<)     = ltInt
+    (<=)    = leInt
+    (>=)    = geInt
+    (>)     = gtInt
+
+{-# INLINE gtInt #-}
+{-# INLINE geInt #-}
+{-# INLINE ltInt #-}
+{-# INLINE leInt #-}
+gtInt, geInt, ltInt, leInt :: Int -> Int -> Bool
+(I# x) `gtInt` (I# y) = isTrue# (x >#  y)
+(I# x) `geInt` (I# y) = isTrue# (x >=# y)
+(I# x) `ltInt` (I# y) = isTrue# (x <#  y)
+(I# x) `leInt` (I# y) = isTrue# (x <=# y)
+
+compareInt :: Int -> Int -> Ordering
+(I# x#) `compareInt` (I# y#) = compareInt# x# y#
+
+compareInt# :: Int# -> Int# -> Ordering
+compareInt# x# y#
+    | isTrue# (x# <#  y#) = LT
+    | isTrue# (x# ==# y#) = EQ
+    | True                = GT
+
+-- OK, so they're technically not part of a class...:
+
+-- Boolean functions
+
+-- | Boolean \"and\"
+(&&)                    :: Bool -> Bool -> Bool
+True  && x              =  x
+False && _              =  False
+
+-- | Boolean \"or\"
+(||)                    :: Bool -> Bool -> Bool
+True  || _              =  True
+False || x              =  x
+
+-- | Boolean \"not\"
+not                     :: Bool -> Bool
+not True                =  False
+not False               =  True
+
+
+------------------------------------------------------------------------
+-- These don't really belong here, but we don't have a better place to
+-- put them
+
+divInt# :: Int# -> Int# -> Int#
+x# `divInt#` y#
+        -- Be careful NOT to overflow if we do any additional arithmetic
+        -- on the arguments...  the following  previous version of this
+        -- code has problems with overflow:
+--    | (x# ># 0#) && (y# <# 0#) = ((x# -# y#) -# 1#) `quotInt#` y#
+--    | (x# <# 0#) && (y# ># 0#) = ((x# -# y#) +# 1#) `quotInt#` y#
+    =      if isTrue# (x# ># 0#) && isTrue# (y# <# 0#) then ((x# -# 1#) `quotInt#` y#) -# 1#
+      else if isTrue# (x# <# 0#) && isTrue# (y# ># 0#) then ((x# +# 1#) `quotInt#` y#) -# 1#
+      else x# `quotInt#` y#
+
+modInt# :: Int# -> Int# -> Int#
+x# `modInt#` y#
+    = if isTrue# (x# ># 0#) && isTrue# (y# <# 0#) ||
+         isTrue# (x# <# 0#) && isTrue# (y# ># 0#)
+      then if isTrue# (r# /=# 0#) then r# +# y# else 0#
+      else r#
+    where
+    !r# = x# `remInt#` y#
diff --git a/libraries/ghc-prim/GHC/Debug.hs b/libraries/ghc-prim/GHC/Debug.hs
new file mode 100644
index 000000000000..a5b43859c029
--- /dev/null
+++ b/libraries/ghc-prim/GHC/Debug.hs
@@ -0,0 +1,47 @@
+{-# LANGUAGE MagicHash, NoImplicitPrelude, UnboxedTuples, UnliftedFFITypes, Trustworthy #-}
+
+module GHC.Debug ( debugLn, debugErrLn ) where
+
+import GHC.Prim
+import GHC.Types
+import GHC.Tuple ()
+
+debugLn :: [Char] -> IO ()
+debugLn xs = IO (\s0 ->
+                 case mkMBA s0 xs of
+                 (# s1, mba #) ->
+                     case c_debugLn mba of
+                     IO f -> f s1)
+
+debugErrLn :: [Char] -> IO ()
+debugErrLn xs = IO (\s0 ->
+                    case mkMBA s0 xs of
+                    (# s1, mba #) ->
+                        case c_debugErrLn mba of
+                        IO f -> f s1)
+
+foreign import ccall unsafe "debugLn"
+    c_debugLn :: MutableByteArray# RealWorld -> IO ()
+
+foreign import ccall unsafe "debugErrLn"
+    c_debugErrLn :: MutableByteArray# RealWorld -> IO ()
+
+mkMBA :: State# RealWorld -> [Char] ->
+         (# State# RealWorld, MutableByteArray# RealWorld #)
+mkMBA s0 xs = -- Start with 1 so that we have space to put in a \0 at
+              -- the end
+              case len 1# xs of
+              l ->
+                  case newByteArray# l s0 of
+                  (# s1, mba #) ->
+                      case write mba 0# xs s1 of
+                      s2 -> (# s2, mba #)
+    where len l [] = l
+          len l (_ : xs') = len (l +# 1#) xs'
+
+          write mba offset [] s = writeCharArray# mba offset '\0'# s
+          write mba offset (C# x : xs') s
+              = case writeCharArray# mba offset x s of
+                s' ->
+                    write mba (offset +# 1#) xs' s'
+
diff --git a/libraries/ghc-prim/GHC/IntWord64.hs b/libraries/ghc-prim/GHC/IntWord64.hs
new file mode 100644
index 000000000000..52dc08efc507
--- /dev/null
+++ b/libraries/ghc-prim/GHC/IntWord64.hs
@@ -0,0 +1,71 @@
+{-# LANGUAGE CPP, MagicHash, NoImplicitPrelude, UnliftedFFITypes #-}
+{-# OPTIONS_HADDOCK hide #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.IntWord64
+-- Copyright   :  (c) The University of Glasgow, 1997-2008
+-- License     :  see libraries/ghc-prim/LICENSE
+--
+-- Maintainer  :  cvs-ghc@haskell.org
+-- Stability   :  internal
+-- Portability :  non-portable (GHC Extensions)
+--
+-- Primitive operations on Int64# and Word64# on platforms where
+-- WORD_SIZE_IN_BITS < 64.
+--
+-----------------------------------------------------------------------------
+
+#include "MachDeps.h"
+
+module GHC.IntWord64 (
+#if WORD_SIZE_IN_BITS < 64
+        Int64#, Word64#, module GHC.IntWord64
+#endif
+    ) where
+
+#if WORD_SIZE_IN_BITS < 64
+import GHC.Prim
+
+foreign import ccall unsafe "hs_eqWord64"    eqWord64#     :: Word64# -> Word64# -> Int#
+foreign import ccall unsafe "hs_neWord64"    neWord64#     :: Word64# -> Word64# -> Int#
+foreign import ccall unsafe "hs_ltWord64"    ltWord64#     :: Word64# -> Word64# -> Int#
+foreign import ccall unsafe "hs_leWord64"    leWord64#     :: Word64# -> Word64# -> Int#
+foreign import ccall unsafe "hs_gtWord64"    gtWord64#     :: Word64# -> Word64# -> Int#
+foreign import ccall unsafe "hs_geWord64"    geWord64#     :: Word64# -> Word64# -> Int#
+
+foreign import ccall unsafe "hs_eqInt64"     eqInt64#      :: Int64# -> Int64# -> Int#
+foreign import ccall unsafe "hs_neInt64"     neInt64#      :: Int64# -> Int64# -> Int#
+foreign import ccall unsafe "hs_ltInt64"     ltInt64#      :: Int64# -> Int64# -> Int#
+foreign import ccall unsafe "hs_leInt64"     leInt64#      :: Int64# -> Int64# -> Int#
+foreign import ccall unsafe "hs_gtInt64"     gtInt64#      :: Int64# -> Int64# -> Int#
+foreign import ccall unsafe "hs_geInt64"     geInt64#      :: Int64# -> Int64# -> Int#
+foreign import ccall unsafe "hs_quotInt64"   quotInt64#    :: Int64# -> Int64# -> Int64#
+foreign import ccall unsafe "hs_remInt64"    remInt64#     :: Int64# -> Int64# -> Int64#
+
+foreign import ccall unsafe "hs_plusInt64"   plusInt64#    :: Int64# -> Int64# -> Int64#
+foreign import ccall unsafe "hs_minusInt64"  minusInt64#   :: Int64# -> Int64# -> Int64#
+foreign import ccall unsafe "hs_timesInt64"  timesInt64#   :: Int64# -> Int64# -> Int64#
+foreign import ccall unsafe "hs_negateInt64" negateInt64#  :: Int64# -> Int64#
+foreign import ccall unsafe "hs_quotWord64"  quotWord64#   :: Word64# -> Word64# -> Word64#
+foreign import ccall unsafe "hs_remWord64"   remWord64#    :: Word64# -> Word64# -> Word64#
+
+foreign import ccall unsafe "hs_and64"       and64#        :: Word64# -> Word64# -> Word64#
+foreign import ccall unsafe "hs_or64"        or64#         :: Word64# -> Word64# -> Word64#
+foreign import ccall unsafe "hs_xor64"       xor64#        :: Word64# -> Word64# -> Word64#
+foreign import ccall unsafe "hs_not64"       not64#        :: Word64# -> Word64#
+
+foreign import ccall unsafe "hs_uncheckedShiftL64"   uncheckedShiftL64#   :: Word64# -> Int# -> Word64#
+foreign import ccall unsafe "hs_uncheckedShiftRL64"  uncheckedShiftRL64#  :: Word64# -> Int# -> Word64#
+foreign import ccall unsafe "hs_uncheckedIShiftL64"  uncheckedIShiftL64#  :: Int64# -> Int# -> Int64#
+foreign import ccall unsafe "hs_uncheckedIShiftRA64" uncheckedIShiftRA64# :: Int64# -> Int# -> Int64#
+foreign import ccall unsafe "hs_uncheckedIShiftRL64" uncheckedIShiftRL64# :: Int64# -> Int# -> Int64#
+
+foreign import ccall unsafe "hs_int64ToWord64"   int64ToWord64#   :: Int64# -> Word64#
+foreign import ccall unsafe "hs_word64ToInt64"   word64ToInt64#   :: Word64# -> Int64#
+foreign import ccall unsafe "hs_intToInt64"      intToInt64#      :: Int# -> Int64#
+foreign import ccall unsafe "hs_int64ToInt"      int64ToInt#      :: Int64# -> Int#
+foreign import ccall unsafe "hs_wordToWord64"    wordToWord64#    :: Word# -> Word64#
+foreign import ccall unsafe "hs_word64ToWord"    word64ToWord#    :: Word64# -> Word#
+
+#endif
+
diff --git a/libraries/ghc-prim/GHC/Magic.hs b/libraries/ghc-prim/GHC/Magic.hs
new file mode 100644
index 000000000000..081b838c4661
--- /dev/null
+++ b/libraries/ghc-prim/GHC/Magic.hs
@@ -0,0 +1,66 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.Magic
+-- Copyright   :  (c) The University of Glasgow 2009
+-- License     :  see libraries/ghc-prim/LICENSE
+--
+-- Maintainer  :  cvs-ghc@haskell.org
+-- Stability   :  internal
+-- Portability :  non-portable (GHC Extensions)
+--
+-- GHC magic.
+--
+-- Use GHC.Exts from the base package instead of importing this
+-- module directly.
+--
+-----------------------------------------------------------------------------
+
+module GHC.Magic ( inline, lazy ) where
+
+-- | The call @inline f@ arranges that 'f' is inlined, regardless of
+-- its size. More precisely, the call @inline f@ rewrites to the
+-- right-hand side of @f@'s definition. This allows the programmer to
+-- control inlining from a particular call site rather than the
+-- definition site of the function (c.f. 'INLINE' pragmas).
+--
+-- This inlining occurs regardless of the argument to the call or the
+-- size of @f@'s definition; it is unconditional. The main caveat is
+-- that @f@'s definition must be visible to the compiler; it is
+-- therefore recommended to mark the function with an 'INLINABLE'
+-- pragma at its definition so that GHC guarantees to record its
+-- unfolding regardless of size.
+--
+-- If no inlining takes place, the 'inline' function expands to the
+-- identity function in Phase zero, so its use imposes no overhead.
+{-# NOINLINE[0] inline #-}
+inline :: a -> a
+inline x = x
+
+-- | The 'lazy' function restrains strictness analysis a little. The
+-- call @lazy e@ means the same as 'e', but 'lazy' has a magical
+-- property so far as strictness analysis is concerned: it is lazy in
+-- its first argument, even though its semantics is strict. After
+-- strictness analysis has run, calls to 'lazy' are inlined to be the
+-- identity function.
+--
+-- This behaviour is occasionally useful when controlling evaluation
+-- order. Notably, 'lazy' is used in the library definition of
+-- 'Control.Parallel.par':
+--
+-- > par :: a -> b -> b
+-- > par x y = case (par# x) of _ -> lazy y
+--
+-- If 'lazy' were not lazy, 'par' would look strict in 'y' which
+-- would defeat the whole purpose of 'par'.
+--
+-- Like 'seq', the argument of 'lazy' can have an unboxed type.
+lazy :: a -> a
+lazy x = x
+-- Implementation note: its strictness and unfolding are over-ridden
+-- by the definition in MkId.lhs; in both cases to nothing at all.
+-- That way, 'lazy' does not get inlined, and the strictness analyser
+-- sees it as lazy.  Then the worker/wrapper phase inlines it.
+-- Result: happiness
+
diff --git a/libraries/ghc-prim/GHC/Tuple.hs b/libraries/ghc-prim/GHC/Tuple.hs
new file mode 100644
index 000000000000..3c4c8c2bc18c
--- /dev/null
+++ b/libraries/ghc-prim/GHC/Tuple.hs
@@ -0,0 +1,211 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE NoImplicitPrelude, DeriveGeneric #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.Tuple
+-- Copyright   :  (c) The University of Glasgow 2001
+-- License     :  BSD-style (see the file libraries/ghc-prim/LICENSE)
+-- 
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  experimental
+-- Portability :  non-portable (GHC extensions)
+--
+-- The tuple data types
+--
+-----------------------------------------------------------------------------
+
+module GHC.Tuple where
+
+
+default () -- Double and Integer aren't available yet
+
+-- | The unit datatype @()@ has one non-undefined member, the nullary
+-- constructor @()@.
+data () = ()
+
+data (,) a b = (,) a b
+data (,,) a b c = (,,) a b c
+data (,,,) a b c d = (,,,) a b c d
+data (,,,,) a b c d e = (,,,,) a b c d e
+data (,,,,,) a b c d e f = (,,,,,) a b c d e f
+data (,,,,,,) a b c d e f g = (,,,,,,) a b c d e f g
+data (,,,,,,,) a b c d e f g h = (,,,,,,,) a b c d e f g h
+data (,,,,,,,,) a b c d e f g h i = (,,,,,,,,) a b c d e f g h i
+data (,,,,,,,,,) a b c d e f g h i j = (,,,,,,,,,) a b c d e f g h i j
+data (,,,,,,,,,,) a b c d e f g h i j k = (,,,,,,,,,,) a b c d e f g h i j k
+data (,,,,,,,,,,,) a b c d e f g h i j k l = (,,,,,,,,,,,) a b c d e f g h i j k l
+data (,,,,,,,,,,,,) a b c d e f g h i j k l m = (,,,,,,,,,,,,) a b c d e f g h i j k l m
+data (,,,,,,,,,,,,,) a b c d e f g h i j k l m n = (,,,,,,,,,,,,,) a b c d e f g h i j k l m n
+data (,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o = (,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o
+data (,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p = (,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p
+data (,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q
+ = (,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q
+data (,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r
+ = (,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r
+data (,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s
+ = (,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s
+data (,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t
+ = (,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t
+data (,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u
+ = (,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u
+data (,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v
+ = (,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v
+data (,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w
+ = (,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w
+data (,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x
+ = (,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x
+data (,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y
+ = (,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y
+data (,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z
+ = (,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z
+data (,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_
+ = (,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_
+data (,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_
+ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_
+data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_
+ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_
+data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_
+ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_
+data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_
+ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_
+data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_
+ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_
+data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_
+ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_
+data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_
+ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_
+data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_
+ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_
+data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_
+ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_
+data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_
+ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_
+data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_
+ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_
+data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_
+ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_
+data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_
+ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_
+data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_
+ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_
+data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_
+ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_
+data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_
+ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_
+data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_
+ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_
+data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_
+ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_
+data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_
+ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_
+data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_
+ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_
+data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_
+ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_
+data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_
+ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_
+data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_
+ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_
+data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_
+ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_
+data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_
+ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_
+data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__
+ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__
+data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__
+ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__
+data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__
+ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__
+data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__
+ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__
+data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__
+ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__
+data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__
+ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__
+data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__
+ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__
+data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__
+ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__
+data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__
+ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__
+data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__
+ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__
+
+{- Manuel says: Including one more declaration gives a segmentation fault.
+data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__
+ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__
+data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__
+ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__
+data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__
+ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__
+data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__
+ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__
+data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__
+ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__
+data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__
+ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__
+data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__
+ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__
+data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__
+ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__
+data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__
+ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__
+data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__
+ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__
+data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__
+ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__
+data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__
+ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__
+data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__
+ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__
+data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__
+ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__
+data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__
+ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__
+data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__
+ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__
+data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___
+ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___
+data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___
+ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___
+data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___
+ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___
+data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___
+ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___
+data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___
+ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___
+data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___
+ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___
+data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___
+ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___
+data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___
+ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___
+data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___
+ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___
+data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___
+ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___
+data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___
+ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___
+data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___
+ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___
+data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ m___
+ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ m___
+data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ m___ n___
+ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ m___ n___
+data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ m___ n___ o___
+ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ m___ n___ o___
+data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ m___ n___ o___ p___
+ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ m___ n___ o___ p___
+data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ m___ n___ o___ p___ q___
+ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ m___ n___ o___ p___ q___
+data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ m___ n___ o___ p___ q___ r___
+ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ m___ n___ o___ p___ q___ r___
+data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ m___ n___ o___ p___ q___ r___ s___
+ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ m___ n___ o___ p___ q___ r___ s___
+data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ m___ n___ o___ p___ q___ r___ s___ t___ 
+ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ m___ n___ o___ p___ q___ r___ s___ t___
+data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ m___ n___ o___ p___ q___ r___ s___ t___  u___
+ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ m___ n___ o___ p___ q___ r___ s___ t___ u___
+data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ m___ n___ o___ p___ q___ r___ s___ t___  u___ v___
+ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ m___ n___ o___ p___ q___ r___ s___ t___ u___ v___
+-}
diff --git a/libraries/ghc-prim/GHC/Types.hs b/libraries/ghc-prim/GHC/Types.hs
new file mode 100644
index 000000000000..e9f142805f9b
--- /dev/null
+++ b/libraries/ghc-prim/GHC/Types.hs
@@ -0,0 +1,235 @@
+{-# LANGUAGE MagicHash, NoImplicitPrelude, TypeFamilies, UnboxedTuples,
+             RoleAnnotations #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.Types
+-- Copyright   :  (c) The University of Glasgow 2009
+-- License     :  see libraries/ghc-prim/LICENSE
+--
+-- Maintainer  :  cvs-ghc@haskell.org
+-- Stability   :  internal
+-- Portability :  non-portable (GHC Extensions)
+--
+-- GHC type definitions.
+-- Use GHC.Exts from the base package instead of importing this
+-- module directly.
+--
+-----------------------------------------------------------------------------
+
+module GHC.Types (
+        Bool(..), Char(..), Int(..), Word(..),
+        Float(..), Double(..),
+        Ordering(..), IO(..),
+        isTrue#,
+        SPEC(..),
+        Coercible,
+    ) where
+
+import GHC.Prim
+
+
+infixr 5 :
+
+data [] a = [] | a : [a]
+
+data {-# CTYPE "HsBool" #-} Bool = False | True
+
+{- | The character type 'Char' is an enumeration whose values represent
+Unicode (or equivalently ISO\/IEC 10646) characters (see
+<http://www.unicode.org/> for details).  This set extends the ISO 8859-1
+(Latin-1) character set (the first 256 characters), which is itself an extension
+of the ASCII character set (the first 128 characters).  A character literal in
+Haskell has type 'Char'.
+
+To convert a 'Char' to or from the corresponding 'Int' value defined
+by Unicode, use 'Prelude.toEnum' and 'Prelude.fromEnum' from the
+'Prelude.Enum' class respectively (or equivalently 'ord' and 'chr').
+-}
+data {-# CTYPE "HsChar" #-} Char = C# Char#
+
+-- | A fixed-precision integer type with at least the range @[-2^29 .. 2^29-1]@.
+-- The exact range for a given implementation can be determined by using
+-- 'Prelude.minBound' and 'Prelude.maxBound' from the 'Prelude.Bounded' class.
+data {-# CTYPE "HsInt" #-} Int = I# Int#
+
+-- |A 'Word' is an unsigned integral type, with the same size as 'Int'.
+data {-# CTYPE "HsWord" #-} Word = W# Word#
+
+-- | Single-precision floating point numbers.
+-- It is desirable that this type be at least equal in range and precision
+-- to the IEEE single-precision type.
+data {-# CTYPE "HsFloat" #-} Float = F# Float#
+
+-- | Double-precision floating point numbers.
+-- It is desirable that this type be at least equal in range and precision
+-- to the IEEE double-precision type.
+data {-# CTYPE "HsDouble" #-} Double = D# Double#
+
+data Ordering = LT | EQ | GT
+
+{- |
+A value of type @'IO' a@ is a computation which, when performed,
+does some I\/O before returning a value of type @a@.
+
+There is really only one way to \"perform\" an I\/O action: bind it to
+@Main.main@ in your program.  When your program is run, the I\/O will
+be performed.  It isn't possible to perform I\/O from an arbitrary
+function, unless that function is itself in the 'IO' monad and called
+at some point, directly or indirectly, from @Main.main@.
+
+'IO' is a monad, so 'IO' actions can be combined using either the do-notation
+or the '>>' and '>>=' operations from the 'Monad' class.
+-}
+newtype IO a = IO (State# RealWorld -> (# State# RealWorld, a #))
+type role IO representational
+{-
+The above role annotation is redundant but is included because this role
+is significant in the normalisation of FFI types. Specifically, if this
+role were to become nominal (which would be very strange, indeed!), changes
+elsewhere in GHC would be necessary. See [FFI type roles] in TcForeign.
+-}
+
+{-
+Note [Kind-changing of (~) and Coercible]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+(~) and Coercible are tricky to define. To the user, they must appear as
+constraints, but we cannot define them as such in Haskell. But we also cannot
+just define them only in GHC.Prim (like (->)), because we need a real module
+for them, e.g. to compile the constructor's info table.
+
+Furthermore the type of MkCoercible cannot be written in Haskell (no syntax for
+~#R).
+
+So we define them as regular data types in GHC.Types, and do magic in GHC to
+change the kind and type, in tysWiredIn.
+-}
+
+
+-- | A data constructor used to box up all unlifted equalities
+--
+-- The type constructor is special in that GHC pretends that it
+-- has kind (? -> ? -> Fact) rather than (* -> * -> *)
+data (~) a b = Eq# ((~#) a b)
+
+
+-- | This two-parameter class has instances for types @a@ and @b@ if
+--      the compiler can infer that they have the same representation. This class
+--      does not have regular instances; instead they are created on-the-fly during
+--      type-checking. Trying to manually declare an instance of @Coercible@
+--      is an error.
+--
+--      Nevertheless one can pretend that the following three kinds of instances
+--      exist. First, as a trivial base-case:
+--
+--      @instance a a@
+--
+--      Furthermore, for every type constructor there is
+--      an instance that allows to coerce under the type constructor. For
+--      example, let @D@ be a prototypical type constructor (@data@ or
+--      @newtype@) with three type arguments, which have roles @nominal@,
+--      @representational@ resp. @phantom@. Then there is an instance of
+--      the form
+--
+--      @instance Coercible b b\' => Coercible (D a b c) (D a b\' c\')@
+--
+--      Note that the @nominal@ type arguments are equal, the
+--      @representational@ type arguments can differ, but need to have a
+--      @Coercible@ instance themself, and the @phantom@ type arguments can be
+--      changed arbitrarily.
+--
+--      The third kind of instance exists for every @newtype NT = MkNT T@ and
+--      comes in two variants, namely
+--
+--      @instance Coercible a T => Coercible a NT@
+--
+--      @instance Coercible T b => Coercible NT b@
+--
+--      This instance is only usable if the constructor @MkNT@ is in scope.
+--
+--      If, as a library author of a type constructor like @Set a@, you
+--      want to prevent a user of your module to write
+--      @coerce :: Set T -> Set NT@,
+--      you need to set the role of @Set@\'s type parameter to @nominal@,
+--      by writing
+--
+--      @type role Set nominal@
+--
+--      For more details about this feature, please refer to
+--      <http://www.cis.upenn.edu/~eir/papers/2014/coercible/coercible.pdf Safe Coercions>
+--      by Joachim Breitner, Richard A. Eisenberg, Simon Peyton Jones and Stephanie Weirich.
+--
+--      /Since: 4.7.0.0/
+data Coercible a b = MkCoercible ((~#) a b)
+-- Also see Note [Kind-changing of (~) and Coercible]
+
+-- | Alias for 'tagToEnum#'. Returns True if its parameter is 1# and False
+--   if it is 0#.
+
+{-# INLINE isTrue# #-}
+isTrue# :: Int# -> Bool   -- See Note [Optimizing isTrue#]
+isTrue# x = tagToEnum# x
+
+-- Note [Optimizing isTrue#]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+--
+-- Current definition of isTrue# is a temporary workaround. We would like to
+-- have functions isTrue# and isFalse# defined like this:
+--
+--     isTrue# :: Int# -> Bool
+--     isTrue# 1# = True
+--     isTrue# _  = False
+--
+--     isFalse# :: Int# -> Bool
+--     isFalse# 0# = True
+--     isFalse# _  = False
+--
+-- These functions would allow us to safely check if a tag can represent True
+-- or False. Using isTrue# and isFalse# as defined above will not introduce
+-- additional case into the code. When we scrutinize return value of isTrue#
+-- or isFalse#, either explicitly in a case expression or implicitly in a guard,
+-- the result will always be a single case expression (given that optimizations
+-- are turned on). This results from case-of-case transformation. Consider this
+-- code (this is both valid Haskell and Core):
+--
+-- case isTrue# (a ># b) of
+--     True  -> e1
+--     False -> e2
+--
+-- Inlining isTrue# gives:
+--
+-- case (case (a ># b) of { 1# -> True; _ -> False } ) of
+--     True  -> e1
+--     False -> e2
+--
+-- Case-of-case transforms that to:
+--
+-- case (a ># b) of
+--   1# -> case True of
+--           True  -> e1
+--           False -> e2
+--   _  -> case False of
+--           True  -> e1
+--           False -> e2
+--
+-- Which is then simplified by case-of-known-constructor:
+--
+-- case (a ># b) of
+--   1# -> e1
+--   _  -> e2
+--
+-- While we get good Core here, the code generator will generate very bad Cmm
+-- if e1 or e2 do allocation. It will push heap checks into case alternatives
+-- which results in about 2.5% increase in code size. Until this is improved we
+-- just make isTrue# an alias to tagToEnum#. This is a temporary solution (if
+-- you're reading this in 2023 then things went wrong). See #8326.
+--
+
+-- | 'SPEC' is used by GHC in the @SpecConstr@ pass in order to inform
+-- the compiler when to be particularly aggressive. In particular, it
+-- tells GHC to specialize regardless of size or the number of
+-- specializations. However, not all loops fall into this category.
+--
+-- Libraries can specify this by using 'SPEC' data type to inform which
+-- loops should be aggressively specialized.
+data SPEC = SPEC | SPEC2
diff --git a/libraries/ghc-prim/LICENSE b/libraries/ghc-prim/LICENSE
new file mode 100644
index 000000000000..fe00a83ea949
--- /dev/null
+++ b/libraries/ghc-prim/LICENSE
@@ -0,0 +1,62 @@
+This library (libraries/ghc-prim) is derived from code from several
+sources: 
+
+  * Code from the GHC project which is largely (c) The University of
+    Glasgow, and distributable under a BSD-style license (see below),
+
+  * Code from the Haskell 98 Report which is (c) Simon Peyton Jones
+    and freely redistributable (but see the full license for
+    restrictions).
+
+The full text of these licenses is reproduced below.  All of the
+licenses are BSD-style or compatible.
+
+-----------------------------------------------------------------------------
+
+The Glasgow Haskell Compiler License
+
+Copyright 2004, The University Court of the University of Glasgow. 
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+- Redistributions of source code must retain the above copyright notice,
+this list of conditions and the following disclaimer.
+ 
+- Redistributions in binary form must reproduce the above copyright notice,
+this list of conditions and the following disclaimer in the documentation
+and/or other materials provided with the distribution.
+ 
+- Neither name of the University nor the names of its contributors may be
+used to endorse or promote products derived from this software without
+specific prior written permission. 
+
+THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
+GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
+DAMAGE.
+
+-----------------------------------------------------------------------------
+
+Code derived from the document "Report on the Programming Language
+Haskell 98", is distributed under the following license:
+
+  Copyright (c) 2002 Simon Peyton Jones
+
+  The authors intend this Report to belong to the entire Haskell
+  community, and so we grant permission to copy and distribute it for
+  any purpose, provided that it is reproduced in its entirety,
+  including this Notice.  Modified versions of this Report may also be
+  copied and distributed for any purpose, provided that the modified
+  version is clearly presented as such, and that it does not claim to
+  be a definition of the Haskell 98 Language.
+
diff --git a/libraries/ghc-prim/Setup.hs b/libraries/ghc-prim/Setup.hs
new file mode 100644
index 000000000000..5bb17e239228
--- /dev/null
+++ b/libraries/ghc-prim/Setup.hs
@@ -0,0 +1,88 @@
+
+-- We need to do some ugly hacks here because of GHC magic
+
+module Main (main) where
+
+import Control.Monad
+import Data.List
+import Data.Maybe
+import Distribution.PackageDescription
+import Distribution.Simple
+import Distribution.Simple.LocalBuildInfo
+import Distribution.Simple.Program
+import Distribution.Simple.Utils
+import Distribution.Text
+import System.Cmd
+import System.FilePath
+import System.Exit
+import System.Directory
+
+main :: IO ()
+main = do let hooks = simpleUserHooks {
+                  regHook = addPrimModule
+                          $ regHook simpleUserHooks,
+                  buildHook = build_primitive_sources
+                            $ buildHook simpleUserHooks,
+                  haddockHook = addPrimModuleForHaddock
+                              $ build_primitive_sources
+                              $ haddockHook simpleUserHooks }
+          defaultMainWithHooks hooks
+
+type Hook a = PackageDescription -> LocalBuildInfo -> UserHooks -> a -> IO ()
+
+addPrimModule :: Hook a -> Hook a
+addPrimModule f pd lbi uhs x =
+    do let -- I'm not sure which one of these we actually need to change.
+           -- It seems bad that there are two.
+           pd' = addPrimModuleToPD pd
+           lpd = addPrimModuleToPD (localPkgDescr lbi)
+           lbi' = lbi { localPkgDescr = lpd }
+       f pd' lbi' uhs x
+
+addPrimModuleForHaddock :: Hook a -> Hook a
+addPrimModuleForHaddock f pd lbi uhs x =
+    do let pc = withPrograms lbi
+           pc' = userSpecifyArgs "haddock" ["GHC/Prim.hs"] pc
+           lbi' = lbi { withPrograms = pc' }
+       f pd lbi' uhs x
+
+addPrimModuleToPD :: PackageDescription -> PackageDescription
+addPrimModuleToPD pd =
+    case library pd of
+    Just lib ->
+        let ems = fromJust (simpleParse "GHC.Prim") : exposedModules lib
+            lib' = lib { exposedModules = ems }
+        in pd { library = Just lib' }
+    Nothing ->
+        error "Expected a library, but none found"
+
+build_primitive_sources :: Hook a -> Hook a
+build_primitive_sources f pd lbi uhs x
+ = do when (compilerFlavor (compiler lbi) == GHC) $ do
+          let genprimopcode = joinPath ["..", "..", "utils",
+                                        "genprimopcode", "genprimopcode"]
+              primops = joinPath ["..", "..", "compiler", "prelude",
+                                  "primops.txt"]
+              primhs = joinPath ["GHC", "Prim.hs"]
+              primopwrappers = joinPath ["GHC", "PrimopWrappers.hs"]
+              primhs_tmp = addExtension primhs "tmp"
+              primopwrappers_tmp = addExtension primopwrappers "tmp"
+          maybeExit $ system (genprimopcode ++ " --make-haskell-source < "
+                           ++ primops ++ " > " ++ primhs_tmp)
+          maybeUpdateFile primhs_tmp primhs
+          maybeExit $ system (genprimopcode ++ " --make-haskell-wrappers < "
+                           ++ primops ++ " > " ++ primopwrappers_tmp)
+          maybeUpdateFile primopwrappers_tmp primopwrappers
+      f pd lbi uhs x
+
+-- Replace a file only if the new version is different from the old.
+-- This prevents make from doing unnecessary work after we run 'setup makefile'
+maybeUpdateFile :: FilePath -> FilePath -> IO ()
+maybeUpdateFile source target = do
+  r <- rawSystem "cmp" ["-s" {-quiet-}, source, target]
+  case r of
+    ExitSuccess   -> removeFile source
+    ExitFailure _ -> do exists <- doesFileExist target
+                        when exists $ removeFile target
+                        renameFile source target
+
diff --git a/libraries/ghc-prim/cbits/atomic.c b/libraries/ghc-prim/cbits/atomic.c
new file mode 100644
index 000000000000..e3d6cc1e95b2
--- /dev/null
+++ b/libraries/ghc-prim/cbits/atomic.c
@@ -0,0 +1,306 @@
+#include "Rts.h"
+
+// Fallbacks for atomic primops on byte arrays. The builtins used
+// below are supported on both GCC and LLVM.
+//
+// Ideally these function would take StgWord8, StgWord16, etc but
+// older GCC versions incorrectly assume that the register that the
+// argument is passed in has been zero extended, which is incorrect
+// according to the ABI and is not what GHC does when it generates
+// calls to these functions.
+
+// FetchAddByteArrayOp_Int
+
+extern StgWord hs_atomic_add8(volatile StgWord8 *x, StgWord val);
+StgWord
+hs_atomic_add8(volatile StgWord8 *x, StgWord val)
+{
+  return __sync_fetch_and_add(x, (StgWord8) val);
+}
+
+extern StgWord hs_atomic_add16(volatile StgWord16 *x, StgWord val);
+StgWord
+hs_atomic_add16(volatile StgWord16 *x, StgWord val)
+{
+  return __sync_fetch_and_add(x, (StgWord16) val);
+}
+
+extern StgWord hs_atomic_add32(volatile StgWord32 *x, StgWord val);
+StgWord
+hs_atomic_add32(volatile StgWord32 *x, StgWord val)
+{
+  return __sync_fetch_and_add(x, (StgWord32) val);
+}
+
+extern StgWord64 hs_atomic_add64(volatile StgWord64 *x, StgWord64 val);
+StgWord64
+hs_atomic_add64(volatile StgWord64 *x, StgWord64 val)
+{
+  return __sync_fetch_and_add(x, val);
+}
+
+// FetchSubByteArrayOp_Int
+
+extern StgWord hs_atomic_sub8(volatile StgWord8 *x, StgWord val);
+StgWord
+hs_atomic_sub8(volatile StgWord8 *x, StgWord val)
+{
+  return __sync_fetch_and_sub(x, (StgWord8) val);
+}
+
+extern StgWord hs_atomic_sub16(volatile StgWord16 *x, StgWord val);
+StgWord
+hs_atomic_sub16(volatile StgWord16 *x, StgWord val)
+{
+  return __sync_fetch_and_sub(x, (StgWord16) val);
+}
+
+extern StgWord hs_atomic_sub32(volatile StgWord32 *x, StgWord val);
+StgWord
+hs_atomic_sub32(volatile StgWord32 *x, StgWord val)
+{
+  return __sync_fetch_and_sub(x, (StgWord32) val);
+}
+
+extern StgWord64 hs_atomic_sub64(volatile StgWord64 *x, StgWord64 val);
+StgWord64
+hs_atomic_sub64(volatile StgWord64 *x, StgWord64 val)
+{
+  return __sync_fetch_and_sub(x, val);
+}
+
+// FetchAndByteArrayOp_Int
+
+extern StgWord hs_atomic_and8(volatile StgWord8 *x, StgWord val);
+StgWord
+hs_atomic_and8(volatile StgWord8 *x, StgWord val)
+{
+  return __sync_fetch_and_and(x, (StgWord8) val);
+}
+
+extern StgWord hs_atomic_and16(volatile StgWord16 *x, StgWord val);
+StgWord
+hs_atomic_and16(volatile StgWord16 *x, StgWord val)
+{
+  return __sync_fetch_and_and(x, (StgWord16) val);
+}
+
+extern StgWord hs_atomic_and32(volatile StgWord32 *x, StgWord val);
+StgWord
+hs_atomic_and32(volatile StgWord32 *x, StgWord val)
+{
+  return __sync_fetch_and_and(x, (StgWord32) val);
+}
+
+extern StgWord64 hs_atomic_and64(volatile StgWord64 *x, StgWord64 val);
+StgWord64
+hs_atomic_and64(volatile StgWord64 *x, StgWord64 val)
+{
+  return __sync_fetch_and_and(x, val);
+}
+
+// FetchNandByteArrayOp_Int
+
+// Workaround for http://llvm.org/bugs/show_bug.cgi?id=8842
+#define CAS_NAND(x, val)                                            \
+  {                                                                 \
+    __typeof__ (*(x)) tmp = *(x);                                   \
+    while (!__sync_bool_compare_and_swap(x, tmp, ~(tmp & (val)))) { \
+      tmp = *(x);                                                   \
+    }                                                               \
+    return tmp;                                                     \
+  }
+
+extern StgWord hs_atomic_nand8(volatile StgWord8 *x, StgWord val);
+StgWord
+hs_atomic_nand8(volatile StgWord8 *x, StgWord val)
+{
+#ifdef __clang__
+  CAS_NAND(x, (StgWord8) val)
+#else
+  return __sync_fetch_and_nand(x, (StgWord8) val);
+#endif
+}
+
+extern StgWord hs_atomic_nand16(volatile StgWord16 *x, StgWord val);
+StgWord
+hs_atomic_nand16(volatile StgWord16 *x, StgWord val)
+{
+#ifdef __clang__
+  CAS_NAND(x, (StgWord16) val);
+#else
+  return __sync_fetch_and_nand(x, (StgWord16) val);
+#endif
+}
+
+extern StgWord hs_atomic_nand32(volatile StgWord32 *x, StgWord val);
+StgWord
+hs_atomic_nand32(volatile StgWord32 *x, StgWord val)
+{
+#ifdef __clang__
+  CAS_NAND(x, (StgWord32) val);
+#else
+  return __sync_fetch_and_nand(x, (StgWord32) val);
+#endif
+}
+
+extern StgWord64 hs_atomic_nand64(volatile StgWord64 *x, StgWord64 val);
+StgWord64
+hs_atomic_nand64(volatile StgWord64 *x, StgWord64 val)
+{
+#ifdef __clang__
+  CAS_NAND(x, val);
+#else
+  return __sync_fetch_and_nand(x, val);
+#endif
+}
+
+// FetchOrByteArrayOp_Int
+
+extern StgWord hs_atomic_or8(volatile StgWord8 *x, StgWord val);
+StgWord
+hs_atomic_or8(volatile StgWord8 *x, StgWord val)
+{
+  return __sync_fetch_and_or(x, (StgWord8) val);
+}
+
+extern StgWord hs_atomic_or16(volatile StgWord16 *x, StgWord val);
+StgWord
+hs_atomic_or16(volatile StgWord16 *x, StgWord val)
+{
+  return __sync_fetch_and_or(x, (StgWord16) val);
+}
+
+extern StgWord hs_atomic_or32(volatile StgWord32 *x, StgWord val);
+StgWord
+hs_atomic_or32(volatile StgWord32 *x, StgWord val)
+{
+  return __sync_fetch_and_or(x, (StgWord32) val);
+}
+
+extern StgWord64 hs_atomic_or64(volatile StgWord64 *x, StgWord64 val);
+StgWord64
+hs_atomic_or64(volatile StgWord64 *x, StgWord64 val)
+{
+  return __sync_fetch_and_or(x, val);
+}
+
+// FetchXorByteArrayOp_Int
+
+extern StgWord hs_atomic_xor8(volatile StgWord8 *x, StgWord val);
+StgWord
+hs_atomic_xor8(volatile StgWord8 *x, StgWord val)
+{
+  return __sync_fetch_and_xor(x, (StgWord8) val);
+}
+
+extern StgWord hs_atomic_xor16(volatile StgWord16 *x, StgWord val);
+StgWord
+hs_atomic_xor16(volatile StgWord16 *x, StgWord val)
+{
+  return __sync_fetch_and_xor(x, (StgWord16) val);
+}
+
+extern StgWord hs_atomic_xor32(volatile StgWord32 *x, StgWord val);
+StgWord
+hs_atomic_xor32(volatile StgWord32 *x, StgWord val)
+{
+  return __sync_fetch_and_xor(x, (StgWord32) val);
+}
+
+extern StgWord64 hs_atomic_xor64(volatile StgWord64 *x, StgWord64 val);
+StgWord64
+hs_atomic_xor64(volatile StgWord64 *x, StgWord64 val)
+{
+  return __sync_fetch_and_xor(x, val);
+}
+
+// CasByteArrayOp_Int
+
+extern StgWord hs_cmpxchg8(volatile StgWord8 *x, StgWord old, StgWord new);
+StgWord
+hs_cmpxchg8(volatile StgWord8 *x, StgWord old, StgWord new)
+{
+  return __sync_val_compare_and_swap(x, (StgWord8) old, (StgWord8) new);
+}
+
+extern StgWord hs_cmpxchg16(volatile StgWord16 *x, StgWord old, StgWord new);
+StgWord
+hs_cmpxchg16(volatile StgWord16 *x, StgWord old, StgWord new)
+{
+  return __sync_val_compare_and_swap(x, (StgWord16) old, (StgWord16) new);
+}
+
+extern StgWord hs_cmpxchg32(volatile StgWord32 *x, StgWord old, StgWord new);
+StgWord
+hs_cmpxchg32(volatile StgWord32 *x, StgWord old, StgWord new)
+{
+  return __sync_val_compare_and_swap(x, (StgWord32) old, (StgWord32) new);
+}
+
+extern StgWord hs_cmpxchg64(volatile StgWord64 *x, StgWord64 old, StgWord64 new);
+StgWord
+hs_cmpxchg64(volatile StgWord64 *x, StgWord64 old, StgWord64 new)
+{
+  return __sync_val_compare_and_swap(x, old, new);
+}
+
+// AtomicReadByteArrayOp_Int
+
+extern StgWord hs_atomicread8(volatile StgWord8 *x);
+StgWord
+hs_atomicread8(volatile StgWord8 *x)
+{
+  return *x;
+}
+
+extern StgWord hs_atomicread16(volatile StgWord16 *x);
+StgWord
+hs_atomicread16(volatile StgWord16 *x)
+{
+  return *x;
+}
+
+extern StgWord hs_atomicread32(volatile StgWord32 *x);
+StgWord
+hs_atomicread32(volatile StgWord32 *x)
+{
+  return *x;
+}
+
+extern StgWord64 hs_atomicread64(volatile StgWord64 *x);
+StgWord64
+hs_atomicread64(volatile StgWord64 *x)
+{
+  return *x;
+}
+
+// AtomicWriteByteArrayOp_Int
+
+extern void hs_atomicwrite8(volatile StgWord8 *x, StgWord val);
+void
+hs_atomicwrite8(volatile StgWord8 *x, StgWord val)
+{
+  *x = (StgWord8) val;
+}
+
+extern void hs_atomicwrite16(volatile StgWord16 *x, StgWord val);
+void
+hs_atomicwrite16(volatile StgWord16 *x, StgWord val)
+{
+  *x = (StgWord16) val;
+}
+
+extern void hs_atomicwrite32(volatile StgWord32 *x, StgWord val);
+void
+hs_atomicwrite32(volatile StgWord32 *x, StgWord val)
+{
+  *x = (StgWord32) val;
+}
+
+extern void hs_atomicwrite64(volatile StgWord64 *x, StgWord64 val);
+void
+hs_atomicwrite64(volatile StgWord64 *x, StgWord64 val)
+{
+  *x = (StgWord64) val;
+}
diff --git a/libraries/ghc-prim/cbits/bswap.c b/libraries/ghc-prim/cbits/bswap.c
new file mode 100644
index 000000000000..9f920b3edaad
--- /dev/null
+++ b/libraries/ghc-prim/cbits/bswap.c
@@ -0,0 +1,27 @@
+#include "Rts.h"
+
+extern StgWord16 hs_bswap16(StgWord16 x);
+StgWord16
+hs_bswap16(StgWord16 x)
+{
+  return ((x >> 8) | (x << 8));
+}
+
+extern StgWord32 hs_bswap32(StgWord32 x);
+StgWord32
+hs_bswap32(StgWord32 x)
+{
+  return ((x >> 24) | ((x >> 8) & 0xff00) |
+          (x << 24) | ((x & 0xff00) << 8));
+}
+
+extern StgWord64 hs_bswap64(StgWord64 x);
+StgWord64
+hs_bswap64(StgWord64 x)
+{
+  return ( (x >> 56)                | (x << 56)
+         | ((x >> 40) & 0xff00)     | ((x & 0xff00) << 40)
+         | ((x >> 24) & 0xff0000)   | ((x & 0xff0000) << 24)
+         | ((x >> 8)  & 0xff000000) | ((x & 0xff000000) << 8)
+         );
+}
diff --git a/libraries/ghc-prim/cbits/clz.c b/libraries/ghc-prim/cbits/clz.c
new file mode 100644
index 000000000000..b0637b5dfe02
--- /dev/null
+++ b/libraries/ghc-prim/cbits/clz.c
@@ -0,0 +1,41 @@
+#include "MachDeps.h"
+#include "Rts.h"
+#include <stdint.h>
+
+// Fall-back implementations for count-leading-zeros primop
+//
+// __builtin_clz*() is supported by GCC and Clang
+
+#if SIZEOF_UNSIGNED_INT == 4
+StgWord
+hs_clz8(StgWord x)
+{
+  return (uint8_t)x ? __builtin_clz((uint8_t)x)-24 : 8;
+}
+
+StgWord
+hs_clz16(StgWord x)
+{
+  return (uint16_t)x ? __builtin_clz((uint16_t)x)-16 : 16;
+}
+
+StgWord
+hs_clz32(StgWord x)
+{
+  return (uint32_t)x ? __builtin_clz((uint32_t)x) : 32;
+}
+#else
+# error no suitable __builtin_clz() found
+#endif
+
+StgWord
+hs_clz64(StgWord64 x)
+{
+#if SIZEOF_UNSIGNED_LONG == 8
+  return x ? __builtin_clzl(x) : 64;
+#elif SIZEOF_UNSIGNED_LONG_LONG == 8
+  return x ? __builtin_clzll(x) : 64;
+#else
+# error no suitable __builtin_clz() found
+#endif
+}
diff --git a/libraries/ghc-prim/cbits/ctz.c b/libraries/ghc-prim/cbits/ctz.c
new file mode 100644
index 000000000000..f68f628bd3bf
--- /dev/null
+++ b/libraries/ghc-prim/cbits/ctz.c
@@ -0,0 +1,57 @@
+#include "MachDeps.h"
+#include "Rts.h"
+#include <stdint.h>
+
+// Fall-back implementations for count-trailing-zeros primop
+//
+// __builtin_ctz*() is supported by GCC and Clang
+
+#if SIZEOF_UNSIGNED_INT == 4
+StgWord
+hs_ctz8(StgWord x)
+{
+  return (uint8_t)x ? __builtin_ctz(x) : 8;
+}
+
+StgWord
+hs_ctz16(StgWord x)
+{
+  return (uint16_t)x ? __builtin_ctz(x) : 16;
+}
+
+StgWord
+hs_ctz32(StgWord x)
+{
+  return (uint32_t)x ? __builtin_ctz(x) : 32;
+}
+#else
+# error no suitable __builtin_ctz() found
+#endif
+
+StgWord
+hs_ctz64(StgWord64 x)
+{
+#if defined(__GNUC__) && defined(i386_HOST_ARCH)
+  /* On Linux/i386, the 64bit `__builtin_ctzll()` instrinsic doesn't
+     get inlined by GCC but rather a short `__ctzdi2` runtime function
+     is inserted when needed into compiled object files.
+
+     This workaround forces GCC on 32bit x86 to to express `hs_ctz64` in
+     terms of the 32bit `__builtin_ctz()` (this is no loss, as there's no
+     64bit BSF instruction on i686 anyway) and thus avoid the problematic
+     out-of-line runtime function.
+  */
+
+  if (!x) return 64;
+
+  return ((uint32_t)x ? __builtin_ctz((uint32_t)x)
+                      : (__builtin_ctz(x >> 32) + 32));
+
+#elif SIZEOF_UNSIGNED_LONG == 8
+  return x ? __builtin_ctzl(x) : 64;
+#elif SIZEOF_UNSIGNED_LONG_LONG == 8
+  return x ? __builtin_ctzll(x) : 64;
+#else
+# error no suitable __builtin_ctz() found
+#endif
+}
diff --git a/libraries/ghc-prim/cbits/debug.c b/libraries/ghc-prim/cbits/debug.c
new file mode 100644
index 000000000000..3a570989e631
--- /dev/null
+++ b/libraries/ghc-prim/cbits/debug.c
@@ -0,0 +1,10 @@
+
+#include <stdio.h>
+
+void debugLn(char *s) {
+    printf("%s\n", s);
+}
+
+void debugErrLn(char *s) {
+    fprintf(stderr, "%s\n", s);
+}
diff --git a/libraries/ghc-prim/cbits/longlong.c b/libraries/ghc-prim/cbits/longlong.c
new file mode 100644
index 000000000000..7f3554b93006
--- /dev/null
+++ b/libraries/ghc-prim/cbits/longlong.c
@@ -0,0 +1,89 @@
+/* -----------------------------------------------------------------------------
+ * $Id: longlong.c,v 1.4 2002/12/13 14:23:42 simonmar Exp $
+ *
+ * (c) The GHC Team, 1998-1999
+ *
+ * Primitive operations over (64-bit) long longs
+ * (only used on 32-bit platforms.)
+ *
+ * ---------------------------------------------------------------------------*/
+
+
+/*
+Miscellaneous primitive operations on HsInt64 and HsWord64s.
+N.B. These are not primops!
+
+Instead of going the normal (boring) route of making the list
+of primitive operations even longer to cope with operations
+over 64-bit entities, we implement them instead 'out-of-line'.
+
+The primitive ops get their own routine (in C) that implements
+the operation, requiring the caller to _ccall_ out. This has
+performance implications of course, but we currently don't
+expect intensive use of either Int64 or Word64 types.
+
+The exceptions to the rule are primops that cast to and from
+64-bit entities (these are defined in PrimOps.h)
+*/
+
+#include "Rts.h"
+
+#if WORD_SIZE_IN_BITS < 64
+
+/* Relational operators */
+
+HsInt hs_gtWord64 (HsWord64 a, HsWord64 b) {return a >  b;}
+HsInt hs_geWord64 (HsWord64 a, HsWord64 b) {return a >= b;}
+HsInt hs_eqWord64 (HsWord64 a, HsWord64 b) {return a == b;}
+HsInt hs_neWord64 (HsWord64 a, HsWord64 b) {return a != b;}
+HsInt hs_ltWord64 (HsWord64 a, HsWord64 b) {return a <  b;}
+HsInt hs_leWord64 (HsWord64 a, HsWord64 b) {return a <= b;}
+
+HsInt hs_gtInt64 (HsInt64 a, HsInt64 b) {return a >  b;}
+HsInt hs_geInt64 (HsInt64 a, HsInt64 b) {return a >= b;}
+HsInt hs_eqInt64 (HsInt64 a, HsInt64 b) {return a == b;}
+HsInt hs_neInt64 (HsInt64 a, HsInt64 b) {return a != b;}
+HsInt hs_ltInt64 (HsInt64 a, HsInt64 b) {return a <  b;}
+HsInt hs_leInt64 (HsInt64 a, HsInt64 b) {return a <= b;}
+
+/* Arithmetic operators */
+
+HsWord64 hs_remWord64  (HsWord64 a, HsWord64 b) {return a % b;}
+HsWord64 hs_quotWord64 (HsWord64 a, HsWord64 b) {return a / b;}
+
+HsInt64 hs_remInt64    (HsInt64 a, HsInt64 b)   {return a % b;}
+HsInt64 hs_quotInt64   (HsInt64 a, HsInt64 b)   {return a / b;}
+HsInt64 hs_negateInt64 (HsInt64 a)              {return -a;}
+HsInt64 hs_plusInt64   (HsInt64 a, HsInt64 b)   {return a + b;}
+HsInt64 hs_minusInt64  (HsInt64 a, HsInt64 b)   {return a - b;}
+HsInt64 hs_timesInt64  (HsInt64 a, HsInt64 b)   {return a * b;}
+
+/* Logical operators: */
+
+HsWord64 hs_and64      (HsWord64 a, HsWord64 b) {return a & b;}
+HsWord64 hs_or64       (HsWord64 a, HsWord64 b) {return a | b;}
+HsWord64 hs_xor64      (HsWord64 a, HsWord64 b) {return a ^ b;}
+HsWord64 hs_not64      (HsWord64 a)             {return ~a;}
+
+HsWord64 hs_uncheckedShiftL64   (HsWord64 a, HsInt b)    {return a << b;}
+HsWord64 hs_uncheckedShiftRL64  (HsWord64 a, HsInt b)    {return a >> b;}
+/* Right shifting of signed quantities is not portable in C, so
+   the behaviour you'll get from using these primops depends
+   on the whatever your C compiler is doing. ToDo: fix. -- sof 8/98
+*/
+HsInt64  hs_uncheckedIShiftL64  (HsInt64 a,  HsInt b)    {return a << b;}
+HsInt64  hs_uncheckedIShiftRA64 (HsInt64 a,  HsInt b)    {return a >> b;}
+HsInt64  hs_uncheckedIShiftRL64 (HsInt64 a,  HsInt b)
+                                    {return (HsInt64) ((HsWord64) a >> b);}
+
+/* Casting between longs and longer longs.
+*/
+
+HsInt64  hs_intToInt64    (HsInt    i) {return (HsInt64)  i;}
+HsInt    hs_int64ToInt    (HsInt64  i) {return (HsInt)    i;}
+HsWord64 hs_int64ToWord64 (HsInt64  i) {return (HsWord64) i;}
+HsWord64 hs_wordToWord64  (HsWord   w) {return (HsWord64) w;}
+HsWord   hs_word64ToWord  (HsWord64 w) {return (HsWord)   w;}
+HsInt64  hs_word64ToInt64 (HsWord64 w) {return (HsInt64)  w;}
+
+#endif /* SUPPORT_LONG_LONGS */
diff --git a/libraries/ghc-prim/cbits/popcnt.c b/libraries/ghc-prim/cbits/popcnt.c
new file mode 100644
index 000000000000..fc44ee75a2ca
--- /dev/null
+++ b/libraries/ghc-prim/cbits/popcnt.c
@@ -0,0 +1,82 @@
+#include "Rts.h"
+
+static const unsigned char popcount_tab[] =
+{
+    0,1,1,2,1,2,2,3,1,2,2,3,2,3,3,4,1,2,2,3,2,3,3,4,2,3,3,4,3,4,4,5,
+    1,2,2,3,2,3,3,4,2,3,3,4,3,4,4,5,2,3,3,4,3,4,4,5,3,4,4,5,4,5,5,6,
+    1,2,2,3,2,3,3,4,2,3,3,4,3,4,4,5,2,3,3,4,3,4,4,5,3,4,4,5,4,5,5,6,
+    2,3,3,4,3,4,4,5,3,4,4,5,4,5,5,6,3,4,4,5,4,5,5,6,4,5,5,6,5,6,6,7,
+    1,2,2,3,2,3,3,4,2,3,3,4,3,4,4,5,2,3,3,4,3,4,4,5,3,4,4,5,4,5,5,6,
+    2,3,3,4,3,4,4,5,3,4,4,5,4,5,5,6,3,4,4,5,4,5,5,6,4,5,5,6,5,6,6,7,
+    2,3,3,4,3,4,4,5,3,4,4,5,4,5,5,6,3,4,4,5,4,5,5,6,4,5,5,6,5,6,6,7,
+    3,4,4,5,4,5,5,6,4,5,5,6,5,6,6,7,4,5,5,6,5,6,6,7,5,6,6,7,6,7,7,8,
+};
+
+extern StgWord hs_popcnt8(StgWord x);
+StgWord
+hs_popcnt8(StgWord x)
+{
+  return popcount_tab[(unsigned char)x];
+}
+
+extern StgWord hs_popcnt16(StgWord x);
+StgWord
+hs_popcnt16(StgWord x)
+{
+  return popcount_tab[(unsigned char)x] +
+      popcount_tab[(unsigned char)(x >> 8)];
+}
+
+extern StgWord hs_popcnt32(StgWord x);
+StgWord
+hs_popcnt32(StgWord x)
+{
+  return popcount_tab[(unsigned char)x] +
+      popcount_tab[(unsigned char)(x >> 8)] +
+      popcount_tab[(unsigned char)(x >> 16)] +
+      popcount_tab[(unsigned char)(x >> 24)];
+}
+
+extern StgWord hs_popcnt64(StgWord64 x);
+StgWord
+hs_popcnt64(StgWord64 x)
+{
+  return popcount_tab[(unsigned char)x] +
+      popcount_tab[(unsigned char)(x >> 8)] +
+      popcount_tab[(unsigned char)(x >> 16)] +
+      popcount_tab[(unsigned char)(x >> 24)] +
+      popcount_tab[(unsigned char)(x >> 32)] +
+      popcount_tab[(unsigned char)(x >> 40)] +
+      popcount_tab[(unsigned char)(x >> 48)] +
+      popcount_tab[(unsigned char)(x >> 56)];
+}
+
+#ifdef i386_HOST_ARCH
+
+extern StgWord hs_popcnt(StgWord x);
+StgWord
+hs_popcnt(StgWord x)
+{
+  return popcount_tab[(unsigned char)x] +
+      popcount_tab[(unsigned char)(x >> 8)] +
+      popcount_tab[(unsigned char)(x >> 16)] +
+      popcount_tab[(unsigned char)(x >> 24)];
+}
+
+#else
+
+extern StgWord hs_popcnt(StgWord x);
+StgWord
+hs_popcnt(StgWord x)
+{
+  return popcount_tab[(unsigned char)x] +
+      popcount_tab[(unsigned char)(x >> 8)] +
+      popcount_tab[(unsigned char)(x >> 16)] +
+      popcount_tab[(unsigned char)(x >> 24)] +
+      popcount_tab[(unsigned char)(x >> 32)] +
+      popcount_tab[(unsigned char)(x >> 40)] +
+      popcount_tab[(unsigned char)(x >> 48)] +
+      popcount_tab[(unsigned char)(x >> 56)];
+}
+
+#endif
diff --git a/libraries/ghc-prim/cbits/word2float.c b/libraries/ghc-prim/cbits/word2float.c
new file mode 100644
index 000000000000..2ca7feacf975
--- /dev/null
+++ b/libraries/ghc-prim/cbits/word2float.c
@@ -0,0 +1,15 @@
+#include "Rts.h"
+
+extern StgFloat hs_word2float32(StgWord x);
+StgFloat
+hs_word2float32(StgWord x)
+{
+  return x;
+}
+
+extern StgDouble hs_word2float64(StgWord x);
+StgDouble
+hs_word2float64(StgWord x)
+{
+  return x;
+}
diff --git a/libraries/ghc-prim/ghc-prim.cabal b/libraries/ghc-prim/ghc-prim.cabal
new file mode 100644
index 000000000000..c87f3363c347
--- /dev/null
+++ b/libraries/ghc-prim/ghc-prim.cabal
@@ -0,0 +1,66 @@
+name:           ghc-prim
+version:        0.3.1.0
+-- GHC 7.6.1 released with 0.3.0.0
+license:        BSD3
+license-file:   LICENSE
+category:       GHC
+maintainer:     libraries@haskell.org
+bug-reports:    http://ghc.haskell.org/trac/ghc/newticket?component=libraries%20%28other%29&keywords=ghc-prim
+synopsis:       GHC primitives
+cabal-version:  >=1.10
+build-type:     Custom
+description:
+    GHC primitives.
+
+source-repository head
+    type:     git
+    location: http://git.haskell.org/ghc.git
+    subdir:   libraries/ghc-prim
+
+flag include-ghc-prim
+    Description: Include GHC.Prim in exposed-modules
+    default: False
+
+Library
+    default-language: Haskell2010
+    other-extensions:
+        BangPatterns
+        CPP
+        DeriveGeneric
+        MagicHash
+        MultiParamTypeClasses
+        NoImplicitPrelude
+        StandaloneDeriving
+        Trustworthy
+        TypeFamilies
+        UnboxedTuples
+        UnliftedFFITypes
+
+    build-depends: rts == 1.0.*
+
+    exposed-modules:
+        GHC.CString
+        GHC.Classes
+        GHC.Debug
+        GHC.IntWord64
+        GHC.Magic
+        GHC.PrimopWrappers
+        GHC.Tuple
+        GHC.Types
+
+    if flag(include-ghc-prim)
+        exposed-modules: GHC.Prim
+
+    c-sources:
+        cbits/atomic.c
+        cbits/bswap.c
+        cbits/clz.c
+        cbits/ctz.c
+        cbits/debug.c
+        cbits/longlong.c
+        cbits/popcnt.c
+        cbits/word2float.c
+
+    -- We need to set the package key to ghc-prim (without a version number)
+    -- as it's magic.
+    ghc-options: -this-package-key ghc-prim
diff --git a/libraries/ghc-prim/tests/T6026.hs b/libraries/ghc-prim/tests/T6026.hs
new file mode 100644
index 000000000000..d59e7f028873
--- /dev/null
+++ b/libraries/ghc-prim/tests/T6026.hs
@@ -0,0 +1,10 @@
+{-# LANGUAGE MagicHash #-}
+
+module Main (main) where
+
+import GHC.Prim
+import GHC.Types
+
+main :: IO ()
+main = print (I# (1# +# 2# *# 3# +# 4#))
+
diff --git a/libraries/ghc-prim/tests/T6026.stdout b/libraries/ghc-prim/tests/T6026.stdout
new file mode 100644
index 000000000000..b4de39476753
--- /dev/null
+++ b/libraries/ghc-prim/tests/T6026.stdout
@@ -0,0 +1 @@
+11
diff --git a/libraries/haskeline b/libraries/haskeline
index 9a1d72aa30b0..5579fc2a2949 160000
--- a/libraries/haskeline
+++ b/libraries/haskeline
@@ -1 +1 @@
-Subproject commit 9a1d72aa30b093e27abbeed8cd0c863f0f109fee
+Subproject commit 5579fc2a2949a143ec8946b9bc9dd2ba957bf091
diff --git a/libraries/haskell2010 b/libraries/haskell2010
new file mode 160000
index 000000000000..c0c87ad53e37
--- /dev/null
+++ b/libraries/haskell2010
@@ -0,0 +1 @@
+Subproject commit c0c87ad53e377aa00f4897bc729c261459b6048a
diff --git a/libraries/haskell98 b/libraries/haskell98
new file mode 160000
index 000000000000..cc6bbbf2bf4e
--- /dev/null
+++ b/libraries/haskell98
@@ -0,0 +1 @@
+Subproject commit cc6bbbf2bf4eaea57062043cbb6e7c5d6c2f42a9
diff --git a/libraries/hoopl b/libraries/hoopl
new file mode 160000
index 000000000000..a2e34db038b7
--- /dev/null
+++ b/libraries/hoopl
@@ -0,0 +1 @@
+Subproject commit a2e34db038b737365c4126f69b1a32eae84dae6b
diff --git a/libraries/hpc b/libraries/hpc
new file mode 160000
index 000000000000..5a1ee4e8a205
--- /dev/null
+++ b/libraries/hpc
@@ -0,0 +1 @@
+Subproject commit 5a1ee4e8a2056beff16f0a3cac2c4da61b96f317
diff --git a/libraries/integer-gmp/.gitignore b/libraries/integer-gmp/.gitignore
new file mode 100644
index 000000000000..4e7da368da79
--- /dev/null
+++ b/libraries/integer-gmp/.gitignore
@@ -0,0 +1,16 @@
+/autom4te.cache/
+/cbits/GmpDerivedConstants.h
+/cbits/mkGmpDerivedConstants
+/config.log
+/config.status
+/configure
+/dist-install/
+/ghc.mk
+/gmp/config.mk
+/GNUmakefile
+/include/HsIntegerGmp.h
+/integer-gmp.buildinfo
+/mkGmpDerivedConstants/dist/
+
+/gmp/gmp.h
+/gmp/gmpbuild
diff --git a/libraries/integer-gmp/GHC/Integer.lhs b/libraries/integer-gmp/GHC/Integer.lhs
new file mode 100644
index 000000000000..392a94a0828c
--- /dev/null
+++ b/libraries/integer-gmp/GHC/Integer.lhs
@@ -0,0 +1,66 @@
+\begin{code}
+{-# LANGUAGE CPP, MagicHash, NoImplicitPrelude #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.Integer
+-- Copyright   :  (c) The University of Glasgow 1994-2008
+-- License     :  see libraries/integer-gmp/LICENSE
+--
+-- Maintainer  :  cvs-ghc@haskell.org
+-- Stability   :  internal
+-- Portability :  non-portable (GHC Extensions)
+--
+-- The 'Integer' type.
+--
+-- This module exposes the /portable/ 'Integer' API.  See
+-- "GHC.Integer.GMP.Internals" for the GMP-specific internal
+-- representation of 'Integer' as well as optimized GMP-specific
+-- operations.
+-----------------------------------------------------------------------------
+
+#include "MachDeps.h"
+
+module GHC.Integer (
+    Integer,
+
+    -- * Construct 'Integer's
+    mkInteger, smallInteger, wordToInteger,
+#if WORD_SIZE_IN_BITS < 64
+    word64ToInteger, int64ToInteger,
+#endif
+    -- * Conversion to other integral types
+    integerToWord, integerToInt,
+#if WORD_SIZE_IN_BITS < 64
+    integerToWord64, integerToInt64,
+#endif
+
+    -- * Helpers for 'RealFloat' type-class operations
+    encodeFloatInteger, floatFromInteger,
+    encodeDoubleInteger, decodeDoubleInteger, doubleFromInteger,
+
+    -- * Arithmetic operations
+    plusInteger, minusInteger, timesInteger, negateInteger,
+ absInteger, signumInteger,
+    divModInteger, divInteger, modInteger,
+    quotRemInteger, quotInteger, remInteger,
+
+    -- * Comparison predicates
+    eqInteger, neqInteger,
+    leInteger, gtInteger, ltInteger, geInteger, compareInteger,
+    eqInteger#, neqInteger#,
+    leInteger#, gtInteger#, ltInteger#, geInteger#,
+
+    -- * Bit-operations
+    andInteger, orInteger, xorInteger, complementInteger,
+    shiftLInteger, shiftRInteger, testBitInteger,
+
+    -- * Hashing
+    hashInteger,
+ ) where
+
+import GHC.Integer.Type
+
+default ()
+\end{code}
+
diff --git a/libraries/integer-gmp/GHC/Integer/GMP/Internals.hs b/libraries/integer-gmp/GHC/Integer/GMP/Internals.hs
new file mode 100644
index 000000000000..0a212f712e2e
--- /dev/null
+++ b/libraries/integer-gmp/GHC/Integer/GMP/Internals.hs
@@ -0,0 +1,40 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+
+-- | This modules provides access to the 'Integer' constructors and
+-- exposes some highly optimized GMP-operations.
+--
+-- Note that since @integer-gmp@ does not depend on `base`, error
+-- reporting via exceptions, 'error', or 'undefined' is not
+-- available. Instead, the low-level functions will crash the runtime
+-- if called with invalid arguments.
+--
+-- See also
+-- <https://ghc.haskell.org/trac/ghc/wiki/Commentary/Libraries/Integer GHC Commentary: Libraries/Integer>.
+
+module GHC.Integer.GMP.Internals
+    ( -- * The 'Integer' type
+      Integer(..)
+
+      -- * Number theoretic functions
+    , gcdInt
+    , gcdInteger
+    , gcdExtInteger
+    , lcmInteger
+    , nextPrimeInteger
+    , testPrimeInteger
+
+      -- * Exponentiation functions
+    , powInteger
+    , powModInteger
+    , powModSecInteger
+    , recipModInteger
+
+    -- * Import/export functions
+    , sizeInBaseInteger
+    , importIntegerFromByteArray
+    , importIntegerFromAddr
+    , exportIntegerToMutableByteArray
+    , exportIntegerToAddr
+    ) where
+
+import GHC.Integer.Type
diff --git a/libraries/integer-gmp/GHC/Integer/GMP/Prim.hs b/libraries/integer-gmp/GHC/Integer/GMP/Prim.hs
new file mode 100644
index 000000000000..4137dd5da945
--- /dev/null
+++ b/libraries/integer-gmp/GHC/Integer/GMP/Prim.hs
@@ -0,0 +1,372 @@
+{-# LANGUAGE BangPatterns, CPP, MagicHash, NoImplicitPrelude, UnboxedTuples
+           , UnliftedFFITypes, GHCForeignImportPrim #-}
+{-# OPTIONS_HADDOCK hide #-}
+
+#include "MachDeps.h"
+module GHC.Integer.GMP.Prim (
+    MPZ#,
+
+    cmpInteger#,
+    cmpIntegerInt#,
+
+    plusInteger#,
+    plusIntegerInt#,
+    minusInteger#,
+    minusIntegerInt#,
+    timesInteger#,
+    timesIntegerInt#,
+
+    quotRemInteger#,
+    quotRemIntegerWord#,
+    quotInteger#,
+    quotIntegerWord#,
+    remInteger#,
+    remIntegerWord#,
+
+    divModInteger#,
+    divModIntegerWord#,
+    divInteger#,
+    divIntegerWord#,
+    modInteger#,
+    modIntegerWord#,
+    divExactInteger#,
+    divExactIntegerWord#,
+
+    gcdInteger#,
+    gcdExtInteger#,
+    gcdIntegerInt#,
+    gcdInt#,
+
+    decodeDouble#,
+
+    int2Integer#,
+    integer2Int#,
+
+    word2Integer#,
+    integer2Word#,
+
+    andInteger#,
+    orInteger#,
+    xorInteger#,
+    complementInteger#,
+
+    testBitInteger#,
+    mul2ExpInteger#,
+    fdivQ2ExpInteger#,
+
+    powInteger#,
+    powModInteger#,
+    powModSecInteger#,
+    recipModInteger#,
+
+    nextPrimeInteger#,
+    testPrimeInteger#,
+
+    sizeInBaseInteger#,
+    importIntegerFromByteArray#,
+    importIntegerFromAddr#,
+    exportIntegerToMutableByteArray#,
+    exportIntegerToAddr#,
+
+#if WORD_SIZE_IN_BITS < 64
+    int64ToInteger#,  integerToInt64#,
+    word64ToInteger#, integerToWord64#,
+#endif
+
+#ifndef WORD_SIZE_IN_BITS
+#error WORD_SIZE_IN_BITS not defined!!!
+#endif
+
+  ) where
+
+import GHC.Prim
+import GHC.Types
+
+-- Double isn't available yet, and we shouldn't be using defaults anyway:
+default ()
+
+-- | This is represents a @mpz_t@ value in a heap-saving way.
+--
+-- The first tuple element, @/s/@, encodes the sign of the integer
+-- @/i/@ (i.e. @signum /s/ == signum /i/@), and the number of /limbs/
+-- used to represent the magnitude. If @abs /s/ > 1@, the 'ByteArray#'
+-- contains @abs /s/@ limbs encoding the integer. Otherwise, if @abs
+-- /s/ < 2@, the single limb is stored in the 'Word#' element instead
+-- (and the 'ByteArray#' element is undefined and MUST NOT be accessed
+-- as it doesn't point to a proper 'ByteArray#' but rather to an
+-- unsafe-coerced 'Int' in order be polite to the GC -- see
+-- @DUMMY_BYTE_ARR@ in gmp-wrappers.cmm)
+--
+-- More specifically, the following encoding is used (where `⊥` means
+-- undefined/unused):
+--
+-- * (#  0#, ⊥, 0## #) -> value = 0
+-- * (#  1#, ⊥, w   #) -> value = w
+-- * (# -1#, ⊥, w   #) -> value = -w
+-- * (#  s#, d, 0## #) -> value = J# s d
+--
+-- This representation allows to avoid temporary heap allocations
+-- (-> Trac #8647) of 1-limb 'ByteArray#'s which fit into the
+-- 'S#'-constructor. Moreover, this allows to delays 1-limb
+-- 'ByteArray#' heap allocations, as such 1-limb `mpz_t`s can be
+-- optimistically allocated on the Cmm stack and returned as a @#word@
+-- in case the `mpz_t` wasn't grown beyond 1 limb by the GMP
+-- operation.
+--
+-- See also the 'GHC.Integer.Type.mpzToInteger' function which ought
+-- to be used for converting 'MPZ#'s to 'Integer's and the
+-- @MP_INT_1LIMB_RETURN()@ macro in @gmp-wrappers.cmm@ which
+-- constructs 'MPZ#' values in the first place for implementation
+-- details.
+type MPZ# = (# Int#, ByteArray#, Word# #)
+
+-- | Returns -1,0,1 according as first argument is less than, equal to, or greater than second argument.
+--
+foreign import prim "integer_cmm_cmpIntegerzh" cmpInteger#
+  :: Int# -> ByteArray# -> Int# -> ByteArray# -> Int#
+
+-- | Returns -1,0,1 according as first argument is less than, equal to, or greater than second argument, which
+--   is an ordinary Int\#.
+foreign import prim "integer_cmm_cmpIntegerIntzh" cmpIntegerInt#
+  :: Int# -> ByteArray# -> Int# -> Int#
+
+-- |
+--
+foreign import prim "integer_cmm_plusIntegerzh" plusInteger#
+  :: Int# -> ByteArray# -> Int# -> ByteArray# -> MPZ#
+
+-- | Optimized version of 'plusInteger#' for summing big-ints with small-ints
+--
+foreign import prim "integer_cmm_plusIntegerIntzh" plusIntegerInt#
+  :: Int# -> ByteArray# -> Int# -> MPZ#
+
+-- |
+--
+foreign import prim "integer_cmm_minusIntegerzh" minusInteger#
+  :: Int# -> ByteArray# -> Int# -> ByteArray# -> MPZ#
+
+-- | Optimized version of 'minusInteger#' for substracting small-ints from big-ints
+--
+foreign import prim "integer_cmm_minusIntegerIntzh" minusIntegerInt#
+  :: Int# -> ByteArray# -> Int# -> MPZ#
+
+-- |
+--
+foreign import prim "integer_cmm_timesIntegerzh" timesInteger#
+  :: Int# -> ByteArray# -> Int# -> ByteArray# -> MPZ#
+
+-- | Optimized version of 'timesInteger#' for multiplying big-ints with small-ints
+--
+foreign import prim "integer_cmm_timesIntegerIntzh" timesIntegerInt#
+  :: Int# -> ByteArray# -> Int# -> MPZ#
+
+-- | Compute div and mod simultaneously, where div rounds towards negative
+-- infinity and\ @(q,r) = divModInteger#(x,y)@ implies
+-- @plusInteger# (timesInteger# q y) r = x@.
+--
+foreign import prim "integer_cmm_quotRemIntegerzh" quotRemInteger#
+  :: Int# -> ByteArray# -> Int# -> ByteArray# -> (# MPZ#, MPZ# #)
+
+-- | Variant of 'quotRemInteger#'
+--
+foreign import prim "integer_cmm_quotRemIntegerWordzh" quotRemIntegerWord#
+  :: Int# -> ByteArray# -> Word# -> (# MPZ#, MPZ# #)
+
+-- | Rounds towards zero.
+--
+foreign import prim "integer_cmm_quotIntegerzh" quotInteger#
+  :: Int# -> ByteArray# -> Int# -> ByteArray# -> MPZ#
+
+-- | Rounds towards zero.
+foreign import prim "integer_cmm_quotIntegerWordzh" quotIntegerWord#
+  :: Int# -> ByteArray# -> Word# -> MPZ#
+
+-- | Satisfies \texttt{plusInteger\# (timesInteger\# (quotInteger\# x y) y) (remInteger\# x y) == x}.
+--
+foreign import prim "integer_cmm_remIntegerzh" remInteger#
+  :: Int# -> ByteArray# -> Int# -> ByteArray# -> MPZ#
+
+-- | Variant of 'remInteger#'
+foreign import prim "integer_cmm_remIntegerWordzh" remIntegerWord#
+  :: Int# -> ByteArray# -> Word# -> MPZ#
+
+-- | Compute div and mod simultaneously, where div rounds towards negative infinity
+-- and\texttt{(q,r) = divModInteger\#(x,y)} implies \texttt{plusInteger\# (timesInteger\# q y) r = x}.
+--
+foreign import prim "integer_cmm_divModIntegerzh" divModInteger#
+  :: Int# -> ByteArray# -> Int# -> ByteArray# -> (# MPZ#, MPZ# #)
+foreign import prim "integer_cmm_divModIntegerWordzh" divModIntegerWord#
+  :: Int# -> ByteArray# -> Word# -> (# MPZ#, MPZ# #)
+foreign import prim "integer_cmm_divIntegerzh" divInteger#
+  :: Int# -> ByteArray# -> Int# -> ByteArray# -> MPZ#
+foreign import prim "integer_cmm_divIntegerWordzh" divIntegerWord#
+  :: Int# -> ByteArray# -> Word# -> MPZ#
+foreign import prim "integer_cmm_modIntegerzh" modInteger#
+  :: Int# -> ByteArray# -> Int# -> ByteArray# -> MPZ#
+foreign import prim "integer_cmm_modIntegerWordzh" modIntegerWord#
+  :: Int# -> ByteArray# -> Word# -> MPZ#
+
+-- | Divisor is guaranteed to be a factor of dividend.
+--
+foreign import prim "integer_cmm_divExactIntegerzh" divExactInteger#
+  :: Int# -> ByteArray# -> Int# -> ByteArray# -> MPZ#
+
+foreign import prim "integer_cmm_divExactIntegerWordzh" divExactIntegerWord#
+  :: Int# -> ByteArray# -> Word# -> MPZ#
+
+-- | Greatest common divisor.
+--
+foreign import prim "integer_cmm_gcdIntegerzh" gcdInteger#
+  :: Int# -> ByteArray# -> Int# -> ByteArray# -> MPZ#
+
+-- | Extended greatest common divisor.
+--
+foreign import prim "integer_cmm_gcdExtIntegerzh" gcdExtInteger#
+  :: Int# -> ByteArray# -> Int# -> ByteArray# -> (# MPZ#, MPZ# #)
+
+-- | Greatest common divisor, where second argument is an ordinary {\tt Int\#}.
+--
+foreign import prim "integer_cmm_gcdIntegerIntzh" gcdIntegerInt#
+  :: Int# -> ByteArray# -> Int# -> Int#
+
+-- |
+--
+foreign import prim "integer_cmm_gcdIntzh" gcdInt#
+  :: Int# -> Int# -> Int#
+
+-- | Convert to arbitrary-precision integer.
+--    First {\tt Int\#} in result is the exponent; second {\tt Int\#} and {\tt ByteArray\#}
+--  represent an {\tt Integer\#} holding the mantissa.
+--
+foreign import prim "integer_cmm_decodeDoublezh" decodeDouble#
+  :: Double# -> (# Int#, MPZ# #)
+
+-- |
+--
+-- Note: This primitive doesn't use 'MPZ#' because its purpose is to instantiate a 'J#'-value.
+foreign import prim "integer_cmm_int2Integerzh" int2Integer#
+  :: Int# -> (# Int#, ByteArray# #)
+
+-- |
+--
+-- Note: This primitive doesn't use 'MPZ#' because its purpose is to instantiate a 'J#'-value.
+foreign import prim "integer_cmm_word2Integerzh" word2Integer#
+  :: Word# -> (# Int#, ByteArray# #)
+
+-- |
+--
+foreign import prim "integer_cmm_andIntegerzh" andInteger#
+  :: Int# -> ByteArray# -> Int# -> ByteArray# -> MPZ#
+
+-- |
+--
+foreign import prim "integer_cmm_orIntegerzh" orInteger#
+  :: Int# -> ByteArray# -> Int# -> ByteArray# -> MPZ#
+
+-- |
+--
+foreign import prim "integer_cmm_xorIntegerzh" xorInteger#
+  :: Int# -> ByteArray# -> Int# -> ByteArray# -> MPZ#
+
+-- |
+--
+foreign import prim "integer_cmm_testBitIntegerzh" testBitInteger#
+  :: Int# -> ByteArray# -> Int# -> Int#
+
+-- |
+--
+foreign import prim "integer_cmm_mul2ExpIntegerzh" mul2ExpInteger#
+  :: Int# -> ByteArray# -> Int# -> MPZ#
+
+-- |
+--
+foreign import prim "integer_cmm_fdivQ2ExpIntegerzh" fdivQ2ExpInteger#
+  :: Int# -> ByteArray# -> Int# -> MPZ#
+
+-- |
+--
+foreign import prim "integer_cmm_powIntegerzh" powInteger#
+  :: Int# -> ByteArray# -> Word# -> MPZ#
+
+-- |
+--
+foreign import prim "integer_cmm_powModIntegerzh" powModInteger#
+  :: Int# -> ByteArray# -> Int# -> ByteArray# -> Int# -> ByteArray# -> MPZ#
+
+-- |
+--
+foreign import prim "integer_cmm_powModSecIntegerzh" powModSecInteger#
+  :: Int# -> ByteArray# -> Int# -> ByteArray# -> Int# -> ByteArray# -> MPZ#
+
+-- |
+--
+foreign import prim "integer_cmm_recipModIntegerzh" recipModInteger#
+  :: Int# -> ByteArray# -> Int# -> ByteArray# -> MPZ#
+
+-- |
+--
+foreign import prim "integer_cmm_nextPrimeIntegerzh" nextPrimeInteger#
+  :: Int# -> ByteArray# -> MPZ#
+
+-- |
+--
+foreign import prim "integer_cmm_testPrimeIntegerzh" testPrimeInteger#
+  :: Int# -> ByteArray# -> Int# -> Int#
+
+-- |
+--
+foreign import prim "integer_cmm_sizeInBasezh" sizeInBaseInteger#
+  :: Int# -> ByteArray# -> Int# -> Word#
+
+-- |
+--
+foreign import prim "integer_cmm_importIntegerFromByteArrayzh" importIntegerFromByteArray#
+  :: ByteArray# -> Word# -> Word# -> Int# -> MPZ#
+
+-- |
+--
+foreign import prim "integer_cmm_importIntegerFromAddrzh" importIntegerFromAddr#
+  :: Addr# -> Word# -> Int# -> State# s -> (# State# s, MPZ# #)
+
+-- |
+--
+foreign import prim "integer_cmm_exportIntegerToMutableByteArrayzh" exportIntegerToMutableByteArray#
+  :: Int# -> ByteArray# -> MutableByteArray# s -> Word# -> Int# -> State# s -> (# State# s, Word# #)
+
+-- |
+--
+foreign import prim "integer_cmm_exportIntegerToAddrzh" exportIntegerToAddr#
+  :: Int# -> ByteArray# -> Addr# -> Int# -> State# s -> (# State# s, Word# #)
+
+-- |
+--
+foreign import prim "integer_cmm_complementIntegerzh" complementInteger#
+  :: Int# -> ByteArray# -> MPZ#
+
+#if WORD_SIZE_IN_BITS < 64
+-- Note: This primitive doesn't use 'MPZ#' because its purpose is to instantiate a 'J#'-value.
+foreign import prim "integer_cmm_int64ToIntegerzh" int64ToInteger#
+  :: Int64# -> (# Int#, ByteArray# #)
+
+-- Note: This primitive doesn't use 'MPZ#' because its purpose is to instantiate a 'J#'-value.
+foreign import prim "integer_cmm_word64ToIntegerzh" word64ToInteger#
+  :: Word64# -> (# Int#, ByteArray# #)
+
+foreign import ccall unsafe "hs_integerToInt64"
+    integerToInt64#  :: Int# -> ByteArray# -> Int64#
+
+foreign import ccall unsafe "hs_integerToWord64"
+    integerToWord64# :: Int# -> ByteArray# -> Word64#
+#endif
+
+-- used to be primops:
+integer2Int# :: Int# -> ByteArray# -> Int#
+integer2Int# s d = if isTrue# (s ==# 0#)
+                       then 0#
+                       else let !v = indexIntArray# d 0# in
+                            if isTrue# (s <# 0#)
+                               then negateInt# v
+                               else v
+
+integer2Word# :: Int# -> ByteArray# -> Word#
+integer2Word# s d = int2Word# (integer2Int# s d)
diff --git a/libraries/integer-gmp/GHC/Integer/Logarithms.hs b/libraries/integer-gmp/GHC/Integer/Logarithms.hs
new file mode 100644
index 000000000000..cfafe14226a4
--- /dev/null
+++ b/libraries/integer-gmp/GHC/Integer/Logarithms.hs
@@ -0,0 +1,43 @@
+{-# LANGUAGE MagicHash, UnboxedTuples, NoImplicitPrelude #-}
+module GHC.Integer.Logarithms
+    ( integerLogBase#
+    , integerLog2#
+    , wordLog2#
+    ) where
+
+import GHC.Prim
+import GHC.Integer
+import qualified GHC.Integer.Logarithms.Internals as I
+
+-- | Calculate the integer logarithm for an arbitrary base.
+--   The base must be greater than 1, the second argument, the number
+--   whose logarithm is sought, should be positive, otherwise the
+--   result is meaningless.
+--
+-- > base ^ integerLogBase# base m <= m < base ^ (integerLogBase# base m + 1)
+--
+-- for @base > 1@ and @m > 0@.
+integerLogBase# :: Integer -> Integer -> Int#
+integerLogBase# b m = case step b of
+                        (# _, e #) -> e
+  where
+    step pw =
+      if m `ltInteger` pw
+        then (# m, 0# #)
+        else case step (pw `timesInteger` pw) of
+               (# q, e #) ->
+                 if q `ltInteger` pw
+                   then (# q, 2# *# e #)
+                   else (# q `quotInteger` pw, 2# *# e +# 1# #)
+
+-- | Calculate the integer base 2 logarithm of an 'Integer'.
+--   The calculation is more efficient than for the general case,
+--   on platforms with 32- or 64-bit words much more efficient.
+--
+--  The argument must be strictly positive, that condition is /not/ checked.
+integerLog2# :: Integer -> Int#
+integerLog2# = I.integerLog2#
+
+-- | This function calculates the integer base 2 logarithm of a 'Word#'.
+wordLog2# :: Word# -> Int#
+wordLog2# = I.wordLog2#
diff --git a/libraries/integer-gmp/GHC/Integer/Logarithms/Internals.hs b/libraries/integer-gmp/GHC/Integer/Logarithms/Internals.hs
new file mode 100644
index 000000000000..59c800a3f9d1
--- /dev/null
+++ b/libraries/integer-gmp/GHC/Integer/Logarithms/Internals.hs
@@ -0,0 +1,260 @@
+{-# LANGUAGE CPP, MagicHash, UnboxedTuples, NoImplicitPrelude #-}
+{-# OPTIONS_HADDOCK hide #-}
+
+#include "MachDeps.h"
+
+-- Fast integer logarithms to base 2.
+-- integerLog2# and wordLog2# are of general usefulness,
+-- the others are only needed for a fast implementation of
+-- fromRational.
+-- Since they are needed in GHC.Float, we must expose this
+-- module, but it should not show up in the docs.
+
+module GHC.Integer.Logarithms.Internals
+    ( integerLog2#
+    , integerLog2IsPowerOf2#
+    , wordLog2#
+    , roundingMode#
+    ) where
+
+import GHC.Prim
+import GHC.Types (isTrue#)
+import GHC.Integer.Type
+
+-- When larger word sizes become common, add support for those,
+-- it is not hard, just tedious.
+#if (WORD_SIZE_IN_BITS != 32) && (WORD_SIZE_IN_BITS != 64)
+
+-- Less than ideal implementations for strange word sizes
+
+import GHC.Integer
+
+default ()
+
+-- We do not know whether the word has 30 bits or 128 or even more,
+-- so we cannot start from the top, although that would be much more
+-- efficient.
+-- Count the bits until the highest set bit is found.
+wordLog2# :: Word# -> Int#
+wordLog2# w = go 8# w
+  where
+    go acc u = case u `uncheckedShiftRL#` 8# of
+                0## -> case leadingZeros of
+                        BA ba -> acc -# indexInt8Array# ba (word2Int# u)
+                v   -> go (acc +# 8#) v
+
+-- Assumption: Integer is strictly positive
+integerLog2# :: Integer -> Int#
+integerLog2# (S# i) = wordLog2# (int2Word# i) -- that is easy
+integerLog2# m = case step m (smallInteger 2#) 1# of
+                    (# _, l #) -> l
+  where
+    -- Invariants:
+    -- pw = 2 ^ lg
+    -- case step n pw lg of
+    --   (q, e) -> pw^(2*e) <= n < pw^(2*e+2)
+    --              && q <= n/pw^(2*e) < (q+1)
+    --              && q < pw^2
+    step n pw lg =
+      if n `ltInteger` pw
+        then (# n, 0# #)
+        else case step n (shiftLInteger pw lg) (2# *# lg) of
+              (# q, e #) ->
+                if q `ltInteger` pw
+                  then (# q, 2# *# e #)
+                  else (# q `shiftRInteger` lg, 2# *# e +# 1# #)
+
+-- Calculate the log2 of a positive integer and check
+-- whether it is a power of 2.
+-- By coincidence, the presence of a power of 2 is
+-- signalled by zero and not one.
+integerLog2IsPowerOf2# :: Integer -> (# Int#, Int# #)
+integerLog2IsPowerOf2# m =
+    case integerLog2# m of
+      lg -> if m `eqInteger` (smallInteger 1# `shiftLInteger` lg)
+              then (# lg, 0# #)
+              else (# lg, 1# #)
+
+-- Detect the rounding mode,
+-- 0# means round to zero,
+-- 1# means round to even,
+-- 2# means round away from zero
+roundingMode# :: Integer -> Int# -> Int#
+roundingMode# m h =
+    case smallInteger 1# `shiftLInteger` h of
+      c -> case m `andInteger`
+                ((c `plusInteger` c) `minusInteger` smallInteger 1#) of
+             r ->
+               if c `ltInteger` r
+                 then 2#
+                 else if c `gtInteger` r
+                        then 0#
+                        else 1#
+
+#else
+
+default ()
+
+-- We have a nice word size, we can do much better now.
+
+#if WORD_SIZE_IN_BITS == 32
+
+#define WSHIFT 5
+#define MMASK 31
+
+#else
+
+#define WSHIFT 6
+#define MMASK 63
+
+#endif
+
+-- Assumption: Integer is strictly positive
+-- For small integers, use wordLog#,
+-- in the general case, check words from the most
+-- significant down, once a nonzero word is found,
+-- calculate its log2 and add the number of following bits.
+integerLog2# :: Integer -> Int#
+integerLog2# (S# i) = wordLog2# (int2Word# i)
+integerLog2# (J# s ba) = check (s -# 1#)
+  where
+    check i = case indexWordArray# ba i of
+                0## -> check (i -# 1#)
+                w   -> wordLog2# w +# (uncheckedIShiftL# i WSHIFT#)
+
+-- Assumption: Integer is strictly positive
+-- First component is log2 n, second is 0# iff n is a power of two
+integerLog2IsPowerOf2# :: Integer -> (# Int#, Int# #)
+-- The power of 2 test is n&(n-1) == 0, thus powers of 2
+-- are indicated bythe second component being zero.
+integerLog2IsPowerOf2# (S# i) =
+    case int2Word# i of
+      w -> (# wordLog2# w, word2Int# (w `and#` (w `minusWord#` 1##)) #)
+-- Find the log2 as above, test whether that word is a power
+-- of 2, if so, check whether only zero bits follow.
+integerLog2IsPowerOf2# (J# s ba) = check (s -# 1#)
+  where
+    check :: Int# -> (# Int#, Int# #)
+    check i = case indexWordArray# ba i of
+                0## -> check (i -# 1#)
+                w   -> (# wordLog2# w +# (uncheckedIShiftL# i WSHIFT#)
+                        , case w `and#` (w `minusWord#` 1##) of
+                            0## -> test (i -# 1#)
+                            _   -> 1# #)
+    test :: Int# -> Int#
+    test i = if isTrue# (i <# 0#)
+                then 0#
+                else case indexWordArray# ba i of
+                        0## -> test (i -# 1#)
+                        _   -> 1#
+
+-- Assumption: Integer and Int# are strictly positive, Int# is less
+-- than logBase 2 of Integer, otherwise havoc ensues.
+-- Used only for the numerator in fromRational when the denominator
+-- is a power of 2.
+-- The Int# argument is log2 n minus the number of bits in the mantissa
+-- of the target type, i.e. the index of the first non-integral bit in
+-- the quotient.
+--
+-- 0# means round down (towards zero)
+-- 1# means we have a half-integer, round to even
+-- 2# means round up (away from zero)
+roundingMode# :: Integer -> Int# -> Int#
+roundingMode# (S# i) t =
+    case int2Word# i `and#` ((uncheckedShiftL# 2## t) `minusWord#` 1##) of
+      k -> case uncheckedShiftL# 1## t of
+            c -> if isTrue# (c `gtWord#` k)
+                    then 0#
+                    else if isTrue# (c `ltWord#` k)
+                            then 2#
+                            else 1#
+roundingMode# (J# _ ba) t =
+    case word2Int# (int2Word# t `and#` MMASK##) of
+      j ->      -- index of relevant bit in word
+        case uncheckedIShiftRA# t WSHIFT# of
+          k ->  -- index of relevant word
+            case indexWordArray# ba k `and#`
+                    ((uncheckedShiftL# 2## j) `minusWord#` 1##) of
+              r ->
+                case uncheckedShiftL# 1## j of
+                  c -> if isTrue# (c `gtWord#` r)
+                        then 0#
+                        else if isTrue# (c `ltWord#` r)
+                                then 2#
+                                else test (k -# 1#)
+  where
+    test i = if isTrue# (i <# 0#)
+                then 1#
+                else case indexWordArray# ba i of
+                        0## -> test (i -# 1#)
+                        _   -> 2#
+
+-- wordLog2# 0## = -1#
+{-# INLINE wordLog2# #-}
+wordLog2# :: Word# -> Int#
+wordLog2# w =
+  case leadingZeros of
+   BA lz ->
+    let zeros u = indexInt8Array# lz (word2Int# u) in
+#if WORD_SIZE_IN_BITS == 64
+    case uncheckedShiftRL# w 56# of
+     a ->
+      if isTrue# (a `neWord#` 0##)
+       then 64# -# zeros a
+       else
+        case uncheckedShiftRL# w 48# of
+         b ->
+          if isTrue# (b `neWord#` 0##)
+           then 56# -# zeros b
+           else
+            case uncheckedShiftRL# w 40# of
+             c ->
+              if isTrue# (c `neWord#` 0##)
+               then 48# -# zeros c
+               else
+                case uncheckedShiftRL# w 32# of
+                 d ->
+                  if isTrue# (d `neWord#` 0##)
+                   then 40# -# zeros d
+                   else
+#endif
+                    case uncheckedShiftRL# w 24# of
+                     e ->
+                      if isTrue# (e `neWord#` 0##)
+                       then 32# -# zeros e
+                       else
+                        case uncheckedShiftRL# w 16# of
+                         f ->
+                          if isTrue# (f `neWord#` 0##)
+                           then 24# -# zeros f
+                           else
+                            case uncheckedShiftRL# w 8# of
+                             g ->
+                              if isTrue# (g `neWord#` 0##)
+                               then 16# -# zeros g
+                               else 8# -# zeros w
+
+#endif
+
+-- Lookup table
+data BA = BA ByteArray#
+
+leadingZeros :: BA
+leadingZeros =
+    let mkArr s =
+          case newByteArray# 256# s of
+            (# s1, mba #) ->
+              case writeInt8Array# mba 0# 9# s1 of
+                s2 ->
+                  let fillA lim val idx st =
+                        if isTrue# (idx ==# 256#)
+                          then st
+                          else if isTrue# (idx <# lim)
+                                then case writeInt8Array# mba idx val st of
+                                        nx -> fillA lim val (idx +# 1#) nx
+                                else fillA (2# *# lim) (val -# 1#) idx st
+                  in case fillA 2# 8# 1# s2 of
+                      s3 -> case unsafeFreezeByteArray# mba s3 of
+                              (# _, ba #) -> ba
+    in case mkArr realWorld# of
+        b -> BA b
diff --git a/libraries/integer-gmp/GHC/Integer/Type.lhs b/libraries/integer-gmp/GHC/Integer/Type.lhs
new file mode 100644
index 000000000000..0f408ff0a0ea
--- /dev/null
+++ b/libraries/integer-gmp/GHC/Integer/Type.lhs
@@ -0,0 +1,1021 @@
+\begin{code}
+{-# LANGUAGE BangPatterns, CPP, UnboxedTuples, UnliftedFFITypes, MagicHash, NoImplicitPrelude #-}
+{-# OPTIONS_HADDOCK hide #-}
+
+-- Commentary of Integer library is located on the wiki:
+-- http://ghc.haskell.org/trac/ghc/wiki/Commentary/Libraries/Integer
+--
+-- It gives an in-depth description of implementation details and
+-- decisions.
+--
+-- TODO: Try to use optimized big/small int primops on IL32P64 archs
+-- (mostly Windows/x86_64). Currently, we have to fall back to
+-- unoptimized code-paths for most big/small-int primops, due to
+-- @mpz_*()@ functions using @long@ types, which is smaller than
+-- @mp_limb_t@ on IL32P64. The @mpn_*()@ functions are often safe to
+-- use, as they use @mb_limb_t@ instead of @long@.
+-- (look out for @#if SIZEOF_HSWORD == SIZEOF_LONG@ occurences)
+--
+
+#include "MachDeps.h"
+#include "HsIntegerGmp.h"
+
+#if SIZEOF_HSWORD == 4
+#define INT_MINBOUND (-2147483648#)
+#define NEG_INT_MINBOUND (S# 2147483647# `plusInteger` S# 1#)
+#elif SIZEOF_HSWORD == 8
+#define INT_MINBOUND (-9223372036854775808#)
+#define NEG_INT_MINBOUND (S# 9223372036854775807# `plusInteger` S# 1#)
+#else
+#error Unknown SIZEOF_HSWORD; can't define INT_MINBOUND and NEG_INT_MINBOUND
+#endif
+
+module GHC.Integer.Type where
+
+import GHC.Prim (
+    -- Other types we use, convert from, or convert to
+    Int#, Word#, Double#, Float#, ByteArray#, MutableByteArray#, Addr#, State#,
+    indexIntArray#,
+    -- Conversions between those types
+    int2Word#, int2Double#, int2Float#, word2Int#,
+    -- Operations on Int# that we use for operations on S#
+    quotInt#, remInt#, quotRemInt#, negateInt#,
+    (*#), (-#),
+    (==#), (/=#), (<=#), (>=#), (<#), (>#),
+    mulIntMayOflo#, addIntC#, subIntC#,
+    and#, or#, xor#,
+ )
+
+import GHC.Integer.GMP.Prim (
+    -- GMP-related primitives
+    MPZ#,
+    cmpInteger#, cmpIntegerInt#,
+    plusInteger#, minusInteger#,
+    timesInteger#,
+    quotRemInteger#, quotInteger#, remInteger#,
+    divModInteger#, divInteger#, modInteger#,
+    divExactInteger#,
+    gcdInteger#, gcdExtInteger#, gcdIntegerInt#, gcdInt#,
+    decodeDouble#,
+    int2Integer#, integer2Int#, word2Integer#, integer2Word#,
+    andInteger#, orInteger#, xorInteger#, complementInteger#,
+    testBitInteger#, mul2ExpInteger#, fdivQ2ExpInteger#,
+    powInteger#, powModInteger#, powModSecInteger#, recipModInteger#,
+    nextPrimeInteger#, testPrimeInteger#,
+    sizeInBaseInteger#,
+    importIntegerFromByteArray#, importIntegerFromAddr#,
+    exportIntegerToMutableByteArray#, exportIntegerToAddr#,
+
+#if SIZEOF_HSWORD == SIZEOF_LONG
+    plusIntegerInt#, minusIntegerInt#,
+    timesIntegerInt#,
+    divIntegerWord#, modIntegerWord#, divModIntegerWord#,
+    divExactIntegerWord#,
+    quotIntegerWord#, remIntegerWord#, quotRemIntegerWord#,
+#endif
+
+#if WORD_SIZE_IN_BITS < 64
+    int64ToInteger#,  integerToInt64#,
+    word64ToInteger#, integerToWord64#,
+#endif
+ )
+
+#if WORD_SIZE_IN_BITS < 64
+import GHC.IntWord64 (
+            Int64#, Word64#,
+            int64ToWord64#, intToInt64#,
+            int64ToInt#, word64ToInt64#,
+            geInt64#, leInt64#, leWord64#,
+       )
+#endif
+
+import GHC.Classes
+import GHC.Types
+
+default ()
+\end{code}
+
+%*********************************************************
+%*                                                      *
+\subsection{The @Integer@ type}
+%*                                                      *
+%*********************************************************
+
+Convenient boxed Integer PrimOps.
+
+\begin{code}
+-- | Arbitrary-precision integers.
+data Integer
+   = S# Int#            -- ^ \"small\" integers fitting into an 'Int#'
+   | J# Int# ByteArray# -- ^ \"big\" integers represented as GMP's @mpz_t@ structure.
+     --
+     -- The 'Int#' field corresponds to @mpz_t@'s @_mp_size@ field,
+     -- which encodes the sign and the number of /limbs/ stored in the
+     -- 'ByteArray#' field (i.e. @mpz_t@'s @_mp_d@ field). Note: The
+     -- 'ByteArray#' may have been over-allocated, and thus larger
+     -- than the size denoted by the 'Int#' field.
+     --
+     -- This representation tries to avoid using the GMP number
+     -- representation for small integers that fit into a native
+     -- 'Int#'. This allows to reduce (or at least defer) calling into GMP
+     -- for operations whose results remain in the 'Int#'-domain.
+     --
+     -- Note: It does __not__ constitute a violation of invariants to
+     -- represent an integer which would fit into an 'Int#' with the
+     -- 'J#'-constructor. For instance, the value @0@ has (only) two valid
+     -- representations, either @'S#' 0#@ or @'J#' 0 _@.
+
+-- | Construct 'Integer' value from list of 'Int's.
+--
+-- This function is used by GHC for constructing 'Integer' literals.
+mkInteger :: Bool   -- ^ sign of integer ('True' if non-negative)
+          -> [Int]  -- ^ absolute value expressed in 31 bit chunks, least significant first
+
+                    -- (ideally these would be machine-word 'Word's rather than 31-bit truncated 'Int's)
+          -> Integer
+mkInteger nonNegative is = let abs = f is
+                           in if nonNegative then abs else negateInteger abs
+    where f [] = S# 0#
+          f (I# i : is') = S# i `orInteger` shiftLInteger (f is') 31#
+
+{-# NOINLINE smallInteger #-}
+smallInteger :: Int# -> Integer
+smallInteger i = S# i
+
+{-# NOINLINE wordToInteger #-}
+wordToInteger :: Word# -> Integer
+wordToInteger w = if isTrue# (i >=# 0#)
+                  then S# i
+                  else case word2Integer# w of (# s, d #) -> J# s d
+    where
+      !i = word2Int# w
+
+{-# NOINLINE integerToWord #-}
+integerToWord :: Integer -> Word#
+integerToWord (S# i) = int2Word# i
+integerToWord (J# s d) = integer2Word# s d
+
+#if WORD_SIZE_IN_BITS < 64
+{-# NOINLINE integerToWord64 #-}
+integerToWord64 :: Integer -> Word64#
+integerToWord64 (S# i) = int64ToWord64# (intToInt64# i)
+integerToWord64 (J# s d) = integerToWord64# s d
+
+{-# NOINLINE word64ToInteger #-}
+word64ToInteger :: Word64# -> Integer
+word64ToInteger w = if isTrue# (w `leWord64#` int64ToWord64# (intToInt64# 0x7FFFFFFF#))
+                    then S# (int64ToInt# (word64ToInt64# w))
+                    else case word64ToInteger# w of
+                         (# s, d #) -> J# s d
+
+{-# NOINLINE integerToInt64 #-}
+integerToInt64 :: Integer -> Int64#
+integerToInt64 (S# i) = intToInt64# i
+integerToInt64 (J# s d) = integerToInt64# s d
+
+{-# NOINLINE int64ToInteger #-}
+int64ToInteger :: Int64# -> Integer
+int64ToInteger i = if isTrue# (i `leInt64#` intToInt64# 0x7FFFFFFF#) &&
+                      isTrue# (i `geInt64#` intToInt64# -0x80000000#)
+                   then smallInteger (int64ToInt# i)
+                   else case int64ToInteger# i of
+                        (# s, d #) -> J# s d
+#endif
+
+integerToInt :: Integer -> Int#
+{-# NOINLINE integerToInt #-}
+integerToInt (S# i)   = i
+integerToInt (J# s d) = integer2Int# s d
+
+-- This manually floated out constant is needed as GHC doesn't do it on its own
+minIntAsBig :: Integer
+minIntAsBig = case int2Integer# INT_MINBOUND of { (# s, d #) -> J# s d }
+
+-- | Promote 'S#' to 'J#'
+toBig :: Integer -> Integer
+toBig (S# i)     = case int2Integer# i of { (# s, d #) -> J# s d }
+toBig i@(J# _ _) = i
+
+-- | Demote 'J#' to 'S#' if possible. See also 'smartJ#'.
+toSmall :: Integer -> Integer
+toSmall i@(S# _)    = i
+toSmall (J# s# mb#) = smartJ# s# mb#
+
+
+-- | Smart 'J#' constructor which tries to construct 'S#' if possible
+smartJ# :: Int# -> ByteArray# -> Integer
+smartJ# 0# _ = S# 0#
+smartJ# 1# mb#  | isTrue# (v ># 0#) = S# v
+    where
+      v = indexIntArray# mb# 0#
+smartJ# (-1#) mb# | isTrue# (v <# 0#) = S# v
+    where
+      v = negateInt# (indexIntArray# mb# 0#)
+smartJ# s# mb# = J# s# mb#
+
+-- |Construct 'Integer' out of a 'MPZ#' as returned by GMP wrapper primops
+--
+-- IMPORTANT: The 'ByteArray#' element MUST NOT be accessed unless the
+-- size-element indicates more than one limb!
+--
+-- See notes at definition site of 'MPZ#' in "GHC.Integer.GMP.Prim"
+-- for more details.
+mpzToInteger :: MPZ# -> Integer
+mpzToInteger (# 0#, _, _ #) = S# 0#
+mpzToInteger (# 1#, _, w# #) | isTrue# (v# >=# 0#) = S# v#
+                             | True = case word2Integer# w# of (# _, d #) -> J# 1# d
+    where
+      v# = word2Int# w#
+mpzToInteger (# -1#, _, w# #) | isTrue# (v# <=# 0#) = S# v#
+                              | True = case word2Integer# w# of (# _, d #) -> J# -1# d
+    where
+      v# = negateInt# (word2Int# w#)
+mpzToInteger (# s#, mb#, _ #) = J# s# mb#
+
+-- | Variant of 'mpzToInteger' for pairs of 'Integer's
+mpzToInteger2 :: (# MPZ#, MPZ# #) -> (# Integer, Integer #)
+mpzToInteger2 (# mpz1, mpz2 #) = (# i1, i2 #)
+    where
+      !i1 = mpzToInteger mpz1 -- This use of `!` avoids creating thunks,
+      !i2 = mpzToInteger mpz2 -- see also Note [Use S# if possible].
+
+-- |Negate MPZ#
+mpzNeg :: MPZ# -> MPZ#
+mpzNeg (# s#, mb#, w# #) = (# negateInt# s#, mb#, w# #)
+
+\end{code}
+
+Note [Use S# if possible]
+~~~~~~~~~~~~~~~~~~~~~~~~~
+It's a big win to use S#, rather than J#, whenever possible.  Not only
+does it take less space, but (probably more important) subsequent
+operations are more efficient. See Trac #8638.
+
+'smartJ#' is the smart constructor for J# that performs the necessary
+tests.  When returning a nested result, we always use smartJ# strictly,
+thus
+       let !r = smartJ# a b in (# r, somthing_else #)
+to avoid creating a thunk that is subsequently evaluated to a J#.
+smartJ# itself does a pretty small amount of work, so it's not worth
+thunking it.
+
+We call 'smartJ#' in places like quotRemInteger where a big input
+might produce a small output.
+
+Just using smartJ# in this way has good results:
+
+        Program           Size    Allocs   Runtime   Elapsed  TotalMem
+--------------------------------------------------------------------------------
+         gamteb          +0.1%    -19.0%      0.03      0.03     +0.0%
+          kahan          +0.2%     -1.2%      0.17      0.17     +0.0%
+         mandel          +0.1%     -7.7%      0.05      0.05     +0.0%
+          power          +0.1%    -40.8%    -32.5%    -32.5%     +0.0%
+         symalg          +0.2%     -0.5%      0.01      0.01     +0.0%
+--------------------------------------------------------------------------------
+            Min          +0.0%    -40.8%    -32.5%    -32.5%     -5.1%
+            Max          +0.2%     +0.1%     +2.0%     +2.0%     +0.0%
+ Geometric Mean          +0.1%     -1.0%     -2.5%     -2.5%     -0.1%
+
+%*********************************************************
+%*                                                      *
+\subsection{Dividing @Integers@}
+%*                                                      *
+%*********************************************************
+
+\begin{code}
+-- XXX There's no good reason for us using unboxed tuples for the
+-- results, but we don't have Data.Tuple available.
+
+-- Note that we don't check for divide-by-zero here. That needs
+-- to be done where it's used.
+-- (we don't have error)
+
+{-# NOINLINE quotRemInteger #-}
+quotRemInteger :: Integer -> Integer -> (# Integer, Integer #)
+quotRemInteger (S# INT_MINBOUND) b = quotRemInteger minIntAsBig b
+quotRemInteger (S# i) (S# j) = case quotRemInt# i j of
+                                   (# q, r #) -> (# S# q, S# r #)
+#if SIZEOF_HSWORD == SIZEOF_LONG
+quotRemInteger (J# s1 d1) (S# b) | isTrue# (b <# 0#)
+  = case quotRemIntegerWord# s1 d1 (int2Word# (negateInt# b)) of
+          (# q, r #) -> let !q' = mpzToInteger (mpzNeg q)
+                            !r' = mpzToInteger r
+                        in (# q', r' #) -- see also Trac #8726
+quotRemInteger (J# s1 d1) (S# b)
+  = mpzToInteger2 (quotRemIntegerWord# s1 d1 (int2Word# b))
+#else
+quotRemInteger i1@(J# _ _) i2@(S# _) = quotRemInteger i1 (toBig i2)
+#endif
+quotRemInteger i1@(S# _) i2@(J# _ _) = quotRemInteger (toBig i1) i2
+quotRemInteger (J# s1 d1) (J# s2 d2)
+  = mpzToInteger2(quotRemInteger# s1 d1 s2 d2) -- See Note [Use S# if possible]
+
+{-# NOINLINE divModInteger #-}
+divModInteger :: Integer -> Integer -> (# Integer, Integer #)
+divModInteger (S# INT_MINBOUND) b = divModInteger minIntAsBig b
+divModInteger (S# i) (S# j) = (# S# d, S# m #)
+    where
+      -- NB. don't inline these.  (# S# (i `quotInt#` j), ... #) means
+      -- (# let q = i `quotInt#` j in S# q, ... #) which builds a
+      -- useless thunk.  Placing the bindings here means they'll be
+      -- evaluated strictly.
+      !d = i `divInt#` j
+      !m = i `modInt#` j
+#if SIZEOF_HSWORD == SIZEOF_LONG
+divModInteger (J# s1 d1) (S# b) | isTrue# (b <# 0#)
+  = case divModIntegerWord# (negateInt# s1) d1 (int2Word# (negateInt# b)) of
+          (# q, r #) -> let !q' = mpzToInteger q
+                            !r' = mpzToInteger (mpzNeg r)
+                        in (# q', r' #) -- see also Trac #8726
+divModInteger (J# s1 d1) (S# b)
+  = mpzToInteger2(divModIntegerWord# s1 d1 (int2Word# b))
+#else
+divModInteger i1@(J# _ _) i2@(S# _) = divModInteger i1 (toBig i2)
+#endif
+divModInteger i1@(S# _) i2@(J# _ _) = divModInteger (toBig i1) i2
+divModInteger (J# s1 d1) (J# s2 d2) = mpzToInteger2 (divModInteger# s1 d1 s2 d2)
+
+{-# NOINLINE remInteger #-}
+remInteger :: Integer -> Integer -> Integer
+remInteger (S# INT_MINBOUND) b = remInteger minIntAsBig b
+remInteger (S# a) (S# b) = S# (remInt# a b)
+{- Special case doesn't work, because a 1-element J# has the range
+   -(2^32-1) -- 2^32-1, whereas S# has the range -2^31 -- (2^31-1)
+remInteger ia@(S# a) (J# sb b)
+  | sb ==# 1#  = S# (remInt# a (word2Int# (integer2Word# sb b)))
+  | sb ==# -1# = S# (remInt# a (0# -# (word2Int# (integer2Word# sb b))))
+  | 0# <# sb   = ia
+  | otherwise  = S# (0# -# a)
+-}
+remInteger ia@(S# _) ib@(J# _ _) = remInteger (toBig ia) ib
+#if SIZEOF_HSWORD == SIZEOF_LONG
+remInteger (J# sa a) (S# b)
+  = mpzToInteger (remIntegerWord# sa a w)
+  where
+    w = int2Word# (if isTrue# (b <# 0#) then negateInt# b else b)
+#else
+remInteger i1@(J# _ _) i2@(S# _) = remInteger i1 (toBig i2)
+#endif
+remInteger (J# sa a) (J# sb b)
+  = mpzToInteger (remInteger# sa a sb b)
+
+{-# NOINLINE quotInteger #-}
+quotInteger :: Integer -> Integer -> Integer
+quotInteger (S# INT_MINBOUND) b = quotInteger minIntAsBig b
+quotInteger (S# a) (S# b) = S# (quotInt# a b)
+{- Special case disabled, see remInteger above
+quotInteger (S# a) (J# sb b)
+  | sb ==# 1#  = S# (quotInt# a (word2Int# (integer2Word# sb b)))
+  | sb ==# -1# = S# (quotInt# a (0# -# (word2Int# (integer2Word# sb b))))
+  | otherwise  = S# 0
+-}
+quotInteger ia@(S# _) ib@(J# _ _) = quotInteger (toBig ia) ib
+#if SIZEOF_HSWORD == SIZEOF_LONG
+quotInteger (J# sa a) (S# b) | isTrue# (b <# 0#)
+  = mpzToInteger (mpzNeg (quotIntegerWord# sa a (int2Word# (negateInt# b))))
+quotInteger (J# sa a) (S# b)
+  = mpzToInteger (quotIntegerWord# sa a (int2Word# b))
+#else
+quotInteger i1@(J# _ _) i2@(S# _) = quotInteger i1 (toBig i2)
+#endif
+quotInteger (J# sa a) (J# sb b)
+  = mpzToInteger (quotInteger# sa a sb b)
+
+{-# NOINLINE modInteger #-}
+modInteger :: Integer -> Integer -> Integer
+modInteger (S# INT_MINBOUND) b = modInteger minIntAsBig b
+modInteger (S# a) (S# b) = S# (modInt# a b)
+modInteger ia@(S# _) ib@(J# _ _) = modInteger (toBig ia) ib
+#if SIZEOF_HSWORD == SIZEOF_LONG
+modInteger (J# sa a) (S# b) | isTrue# (b <# 0#)
+  = mpzToInteger (mpzNeg (modIntegerWord# (negateInt# sa) a (int2Word# (negateInt# b))))
+modInteger (J# sa a) (S# b)
+  = mpzToInteger (modIntegerWord# sa a (int2Word# b))
+#else
+modInteger i1@(J# _ _) i2@(S# _) = modInteger i1 (toBig i2)
+#endif
+modInteger (J# sa a) (J# sb b)
+  = mpzToInteger (modInteger# sa a sb b)
+
+{-# NOINLINE divInteger #-}
+divInteger :: Integer -> Integer -> Integer
+divInteger (S# INT_MINBOUND) b = divInteger minIntAsBig b
+divInteger (S# a) (S# b) = S# (divInt# a b)
+divInteger ia@(S# _) ib@(J# _ _) = divInteger (toBig ia) ib
+#if SIZEOF_HSWORD == SIZEOF_LONG
+divInteger (J# sa a) (S# b) | isTrue# (b <# 0#)
+  = mpzToInteger (divIntegerWord# (negateInt# sa) a (int2Word# (negateInt# b)))
+divInteger (J# sa a) (S# b)
+  = mpzToInteger (divIntegerWord# sa a (int2Word# b))
+#else
+divInteger i1@(J# _ _) i2@(S# _) = divInteger i1 (toBig i2)
+#endif
+divInteger (J# sa a) (J# sb b)
+  = mpzToInteger (divInteger# sa a sb b)
+\end{code}
+
+
+
+\begin{code}
+-- | Compute greatest common divisor.
+{-# NOINLINE gcdInteger #-}
+gcdInteger :: Integer -> Integer -> Integer
+-- SUP: Do we really need the first two cases?
+gcdInteger (S# INT_MINBOUND) b = gcdInteger minIntAsBig b
+gcdInteger a (S# INT_MINBOUND) = gcdInteger a minIntAsBig
+gcdInteger (S# a) (S# b) = S# (gcdInt a b)
+gcdInteger ia@(S# a)  ib@(J# sb b)
+ =      if isTrue# (a  ==# 0#) then absInteger ib
+   else if isTrue# (sb ==# 0#) then absInteger ia
+   else                             S# (gcdIntegerInt# absSb b absA)
+       where !absA  = if isTrue# (a  <# 0#) then negateInt# a  else a
+             !absSb = if isTrue# (sb <# 0#) then negateInt# sb else sb
+gcdInteger ia@(J# _ _) ib@(S# _) = gcdInteger ib ia
+gcdInteger (J# sa a) (J# sb b)   = mpzToInteger (gcdInteger# sa a sb b)
+
+-- | Extended euclidean algorithm.
+--
+-- For @/a/@ and @/b/@, compute their greatest common divisor @/g/@
+-- and the coefficient @/s/@ satisfying @/a//s/ + /b//t/ = /g/@.
+--
+-- /Since: 0.5.1.0/
+{-# NOINLINE gcdExtInteger #-}
+gcdExtInteger :: Integer -> Integer -> (# Integer, Integer #)
+gcdExtInteger a@(S# _)   b@(S# _) = gcdExtInteger (toBig a) (toBig b)
+gcdExtInteger a@(S# _) b@(J# _ _) = gcdExtInteger (toBig a) b
+gcdExtInteger a@(J# _ _) b@(S# _) = gcdExtInteger a (toBig b)
+gcdExtInteger (J# sa a) (J# sb b) = mpzToInteger2 (gcdExtInteger# sa a sb b)
+
+-- | Compute least common multiple.
+{-# NOINLINE lcmInteger #-}
+lcmInteger :: Integer -> Integer -> Integer
+lcmInteger a b =      if a `eqInteger` S# 0# then S# 0#
+                 else if b `eqInteger` S# 0# then S# 0#
+                 else (divExact aa (gcdInteger aa ab)) `timesInteger` ab
+  where aa = absInteger a
+        ab = absInteger b
+
+-- | Compute greatest common divisor.
+gcdInt :: Int# -> Int# -> Int#
+gcdInt 0# y  = absInt y
+gcdInt x  0# = absInt x
+gcdInt x  y  = gcdInt# (absInt x) (absInt y)
+
+absInt :: Int# -> Int#
+absInt x = if isTrue# (x <# 0#) then negateInt# x else x
+
+divExact :: Integer -> Integer -> Integer
+divExact (S# INT_MINBOUND) b = divExact minIntAsBig b
+divExact (S# a) (S# b) = S# (quotInt# a b)
+divExact (S# a) (J# sb b)
+  = S# (quotInt# a (integer2Int# sb b))
+#if SIZEOF_HSWORD == SIZEOF_LONG
+divExact (J# sa a) (S# b) | isTrue# (b <# 0#)
+  = mpzToInteger (divExactIntegerWord# (negateInt# sa) a (int2Word# (negateInt# b)))
+divExact (J# sa a) (S# b) = mpzToInteger (divExactIntegerWord# sa a (int2Word# b))
+#else
+divExact i1@(J# _ _) i2@(S# _) = divExact i1 (toBig i2)
+#endif
+divExact (J# sa a) (J# sb b) = mpzToInteger (divExactInteger# sa a sb b)
+\end{code}
+
+
+%*********************************************************
+%*                                                      *
+\subsection{The @Integer@ instances for @Eq@, @Ord@}
+%*                                                      *
+%*********************************************************
+
+\begin{code}
+
+-- | /Since: 0.5.1.0/
+{-# NOINLINE eqInteger# #-}
+eqInteger# :: Integer -> Integer -> Int#
+eqInteger# (S# i)     (S# j)     = i ==# j
+eqInteger# (S# i)     (J# s d)   = cmpIntegerInt# s d i ==# 0#
+eqInteger# (J# s d)   (S# i)     = cmpIntegerInt# s d i ==# 0#
+eqInteger# (J# s1 d1) (J# s2 d2) = (cmpInteger# s1 d1 s2 d2) ==# 0#
+
+-- | /Since: 0.5.1.0/
+{-# NOINLINE neqInteger# #-}
+neqInteger# :: Integer -> Integer -> Int#
+neqInteger# (S# i)     (S# j)     = i /=# j
+neqInteger# (S# i)     (J# s d)   = cmpIntegerInt# s d i /=# 0#
+neqInteger# (J# s d)   (S# i)     = cmpIntegerInt# s d i /=# 0#
+neqInteger# (J# s1 d1) (J# s2 d2) = (cmpInteger# s1 d1 s2 d2) /=# 0#
+
+{-# INLINE eqInteger  #-}
+{-# INLINE neqInteger #-}
+eqInteger, neqInteger :: Integer -> Integer -> Bool
+eqInteger  a b = isTrue# (a `eqInteger#`  b)
+neqInteger a b = isTrue# (a `neqInteger#` b)
+
+instance  Eq Integer  where
+    (==) = eqInteger
+    (/=) = neqInteger
+
+------------------------------------------------------------------------
+
+-- | /Since: 0.5.1.0/
+{-# NOINLINE leInteger# #-}
+leInteger# :: Integer -> Integer -> Int#
+leInteger# (S# i)     (S# j)     = i <=# j
+leInteger# (J# s d)   (S# i)     = cmpIntegerInt# s d i <=# 0#
+leInteger# (S# i)     (J# s d)   = cmpIntegerInt# s d i >=# 0#
+leInteger# (J# s1 d1) (J# s2 d2) = (cmpInteger# s1 d1 s2 d2) <=# 0#
+
+-- | /Since: 0.5.1.0/
+{-# NOINLINE gtInteger# #-}
+gtInteger# :: Integer -> Integer -> Int#
+gtInteger# (S# i)     (S# j)     = i ># j
+gtInteger# (J# s d)   (S# i)     = cmpIntegerInt# s d i ># 0#
+gtInteger# (S# i)     (J# s d)   = cmpIntegerInt# s d i <# 0#
+gtInteger# (J# s1 d1) (J# s2 d2) = (cmpInteger# s1 d1 s2 d2) ># 0#
+
+-- | /Since: 0.5.1.0/
+{-# NOINLINE ltInteger# #-}
+ltInteger# :: Integer -> Integer -> Int#
+ltInteger# (S# i)     (S# j)     = i <# j
+ltInteger# (J# s d)   (S# i)     = cmpIntegerInt# s d i <# 0#
+ltInteger# (S# i)     (J# s d)   = cmpIntegerInt# s d i ># 0#
+ltInteger# (J# s1 d1) (J# s2 d2) = (cmpInteger# s1 d1 s2 d2) <# 0#
+
+-- | /Since: 0.5.1.0/
+{-# NOINLINE geInteger# #-}
+geInteger# :: Integer -> Integer -> Int#
+geInteger# (S# i)     (S# j)     = i >=# j
+geInteger# (J# s d)   (S# i)     = cmpIntegerInt# s d i >=# 0#
+geInteger# (S# i)     (J# s d)   = cmpIntegerInt# s d i <=# 0#
+geInteger# (J# s1 d1) (J# s2 d2) = (cmpInteger# s1 d1 s2 d2) >=# 0#
+
+{-# INLINE leInteger #-}
+{-# INLINE ltInteger #-}
+{-# INLINE geInteger #-}
+{-# INLINE gtInteger #-}
+leInteger, gtInteger, ltInteger, geInteger :: Integer -> Integer -> Bool
+leInteger a b = isTrue# (a `leInteger#` b)
+gtInteger a b = isTrue# (a `gtInteger#` b)
+ltInteger a b = isTrue# (a `ltInteger#` b)
+geInteger a b = isTrue# (a `geInteger#` b)
+
+{-# NOINLINE compareInteger #-}
+compareInteger :: Integer -> Integer -> Ordering
+compareInteger (S# i)  (S# j)
+   =      if isTrue# (i ==# j) then EQ
+     else if isTrue# (i <=# j) then LT
+     else                           GT
+compareInteger (J# s d) (S# i)
+   = case cmpIntegerInt# s d i of { res# ->
+     if isTrue# (res# <# 0#) then LT else
+     if isTrue# (res# ># 0#) then GT else EQ
+     }
+compareInteger (S# i) (J# s d)
+   = case cmpIntegerInt# s d i of { res# ->
+     if isTrue# (res# ># 0#) then LT else
+     if isTrue# (res# <# 0#) then GT else EQ
+     }
+compareInteger (J# s1 d1) (J# s2 d2)
+   = case cmpInteger# s1 d1 s2 d2 of { res# ->
+     if isTrue# (res# <# 0#) then LT else
+     if isTrue# (res# ># 0#) then GT else EQ
+     }
+
+instance Ord Integer where
+    (<=) = leInteger
+    (<)  = ltInteger
+    (>)  = gtInteger
+    (>=) = geInteger
+    compare = compareInteger
+\end{code}
+
+
+%*********************************************************
+%*                                                      *
+\subsection{The @Integer@ instances for @Num@}
+%*                                                      *
+%*********************************************************
+
+\begin{code}
+{-# NOINLINE absInteger #-}
+absInteger :: Integer -> Integer
+absInteger (S# INT_MINBOUND) = NEG_INT_MINBOUND
+absInteger n@(S# i)   = if isTrue# (i >=# 0#) then n else S# (negateInt# i)
+absInteger n@(J# s d) = if isTrue# (s >=# 0#) then n else J# (negateInt# s) d
+
+{-# NOINLINE signumInteger #-}
+signumInteger :: Integer -> Integer
+signumInteger (S# i) = if isTrue# (i <# 0#) then S# -1#
+                       else if isTrue# (i ==# 0#) then S# 0#
+                       else S# 1#
+signumInteger (J# s d)
+  = let
+        !cmp = cmpIntegerInt# s d 0#
+    in
+    if      isTrue# (cmp >#  0#) then S# 1#
+    else if isTrue# (cmp ==# 0#) then S# 0#
+    else                              S# (negateInt# 1#)
+
+{-# NOINLINE plusInteger #-}
+plusInteger :: Integer -> Integer -> Integer
+plusInteger (S# i)      (S# j)   = case addIntC# i j of
+                                   (# r, c #) ->
+                                       if isTrue# (c ==# 0#)
+                                       then S# r
+#if SIZEOF_HSWORD == SIZEOF_LONG
+                                       else case int2Integer# i of
+                                            (# s, d #) -> mpzToInteger (plusIntegerInt# s d j)
+#else
+                                       else plusInteger (toBig (S# i)) (toBig (S# j))
+#endif
+plusInteger i1@(J# _ _) (S# 0#)   = i1
+#if SIZEOF_HSWORD == SIZEOF_LONG
+plusInteger (J# s1 d1)  (S# j)    = mpzToInteger (plusIntegerInt# s1 d1 j)
+#else
+plusInteger i1@(J# _ _) i2@(S# _) = plusInteger i1 (toBig i2)
+#endif
+plusInteger i1@(S# _) i2@(J# _ _) = plusInteger i2 i1
+plusInteger (J# s1 d1) (J# s2 d2) = mpzToInteger (plusInteger# s1 d1 s2 d2)
+
+{-# NOINLINE minusInteger #-}
+minusInteger :: Integer -> Integer -> Integer
+minusInteger (S# i)      (S# j)    = case subIntC# i j of
+                                     (# r, c #) ->
+                                         if isTrue# (c ==# 0#) then S# r
+#if SIZEOF_HSWORD == SIZEOF_LONG
+                                         else case int2Integer# i of
+                                              (# s, d #) -> mpzToInteger (minusIntegerInt# s d j)
+#else
+                                         else minusInteger (toBig (S# i)) (toBig (S# j))
+#endif
+minusInteger i1@(J# _ _) (S# 0#)   = i1
+minusInteger (S# 0#)    (J# s2 d2) = J# (negateInt# s2) d2
+#if SIZEOF_HSWORD == SIZEOF_LONG
+minusInteger (J# s1 d1)  (S# j)    = mpzToInteger (minusIntegerInt# s1 d1 j)
+minusInteger (S# i)     (J# s2 d2) = mpzToInteger (plusIntegerInt# (negateInt# s2) d2 i)
+#else
+minusInteger i1@(J# _ _) i2@(S# _) = minusInteger i1 (toBig i2)
+minusInteger i1@(S# _) i2@(J# _ _) = minusInteger (toBig i1) i2
+#endif
+minusInteger (J# s1 d1) (J# s2 d2) = mpzToInteger (minusInteger# s1 d1 s2 d2)
+
+{-# NOINLINE timesInteger #-}
+timesInteger :: Integer -> Integer -> Integer
+timesInteger (S# i) (S# j)         = if isTrue# (mulIntMayOflo# i j ==# 0#)
+                                     then S# (i *# j)
+#if SIZEOF_HSWORD == SIZEOF_LONG
+                                     else case int2Integer# i of
+                                          (# s, d #) -> mpzToInteger (timesIntegerInt# s d j)
+#else
+                                     else timesInteger (toBig (S# i)) (toBig (S# j))
+#endif
+timesInteger (S# 0#)     _         = S# 0#
+timesInteger (S# -1#)    i2        = negateInteger i2
+timesInteger (S# 1#)     i2        = i2
+#if SIZEOF_HSWORD == SIZEOF_LONG
+timesInteger (S# i1)    (J# s2 d2) = mpzToInteger (timesIntegerInt# s2 d2 i1)
+#else
+timesInteger i1@(S# _) i2@(J# _ _) = timesInteger (toBig i1) i2
+#endif
+timesInteger i1@(J# _ _) i2@(S# _) = timesInteger i2 i1 -- swap args & retry
+timesInteger (J# s1 d1) (J# s2 d2) = mpzToInteger (timesInteger# s1 d1 s2 d2)
+
+{-# NOINLINE negateInteger #-}
+negateInteger :: Integer -> Integer
+negateInteger (S# INT_MINBOUND) = NEG_INT_MINBOUND
+negateInteger (S# i)            = S# (negateInt# i)
+negateInteger (J# s d)          = J# (negateInt# s) d
+\end{code}
+
+
+%*********************************************************
+%*                                                      *
+\subsection{The @Integer@ stuff for Double@}
+%*                                                      *
+%*********************************************************
+
+\begin{code}
+{-# NOINLINE encodeFloatInteger #-}
+encodeFloatInteger :: Integer -> Int# -> Float#
+encodeFloatInteger (S# i) j     = int_encodeFloat# i j
+encodeFloatInteger (J# s# d#) e = encodeFloat# s# d# e
+
+{-# NOINLINE encodeDoubleInteger #-}
+encodeDoubleInteger :: Integer -> Int# -> Double#
+encodeDoubleInteger (S# i) j     = int_encodeDouble# i j
+encodeDoubleInteger (J# s# d#) e = encodeDouble# s# d# e
+
+{-# NOINLINE decodeDoubleInteger #-}
+decodeDoubleInteger :: Double# -> (# Integer, Int# #)
+decodeDoubleInteger d = case decodeDouble# d of
+                        (# exp#, man# #) -> let !man = mpzToInteger man#
+                                            in (# man, exp# #)
+
+-- previous code: doubleFromInteger n = fromInteger n = encodeFloat n 0
+-- doesn't work too well, because encodeFloat is defined in
+-- terms of ccalls which can never be simplified away.  We
+-- want simple literals like (fromInteger 3 :: Float) to turn
+-- into (F# 3.0), hence the special case for S# here.
+
+{-# NOINLINE doubleFromInteger #-}
+doubleFromInteger :: Integer -> Double#
+doubleFromInteger (S# i#) = int2Double# i#
+doubleFromInteger (J# s# d#) = encodeDouble# s# d# 0#
+
+{-# NOINLINE floatFromInteger #-}
+floatFromInteger :: Integer -> Float#
+floatFromInteger (S# i#) = int2Float# i#
+floatFromInteger (J# s# d#) = encodeFloat# s# d# 0#
+
+foreign import ccall unsafe "integer_cbits_encodeFloat"
+        encodeFloat# :: Int# -> ByteArray# -> Int# -> Float#
+foreign import ccall unsafe "__int_encodeFloat"
+        int_encodeFloat# :: Int# -> Int# -> Float#
+
+foreign import ccall unsafe "integer_cbits_encodeDouble"
+        encodeDouble# :: Int# -> ByteArray# -> Int# -> Double#
+foreign import ccall unsafe "__int_encodeDouble"
+        int_encodeDouble# :: Int# -> Int# -> Double#
+\end{code}
+
+%*********************************************************
+%*                                                      *
+\subsection{The @Integer@ Bit definitions@}
+%*                                                      *
+%*********************************************************
+
+We explicitly pattern match against J# and S# in order to produce
+Core that doesn't have pattern matching errors, as that would
+introduce a spurious dependency to base.
+
+\begin{code}
+{-# NOINLINE andInteger #-}
+andInteger :: Integer -> Integer -> Integer
+(S# x)     `andInteger`   (S# y)     = S# (word2Int# (int2Word# x `and#` int2Word# y))
+x@(S# _)   `andInteger` y@(J# _ _)   = toBig x `andInteger` y
+x@(J# _ _) `andInteger` y@(S# _)     = x `andInteger` toBig y
+(J# s1 d1) `andInteger`   (J# s2 d2) =
+     mpzToInteger (andInteger# s1 d1 s2 d2)
+
+{-# NOINLINE orInteger #-}
+orInteger :: Integer -> Integer -> Integer
+(S# x)     `orInteger`   (S# y)     = S# (word2Int# (int2Word# x `or#` int2Word# y))
+x@(S# _)   `orInteger` y@(J# _ _)   = toBig x `orInteger` y
+x@(J# _ _) `orInteger` y@(S# _)     = x `orInteger` toBig y
+(J# s1 d1) `orInteger`   (J# s2 d2) =
+     mpzToInteger (orInteger# s1 d1 s2 d2)
+
+{-# NOINLINE xorInteger #-}
+xorInteger :: Integer -> Integer -> Integer
+(S# x)     `xorInteger`   (S# y)     = S# (word2Int# (int2Word# x `xor#` int2Word# y))
+x@(S# _)   `xorInteger` y@(J# _ _)   = toBig x `xorInteger` y
+x@(J# _ _) `xorInteger` y@(S# _)     = x `xorInteger` toBig y
+(J# s1 d1) `xorInteger`   (J# s2 d2) =
+     mpzToInteger (xorInteger# s1 d1 s2 d2)
+
+{-# NOINLINE complementInteger #-}
+complementInteger :: Integer -> Integer
+complementInteger (S# x)
+    = S# (word2Int# (int2Word# x `xor#` int2Word# (0# -# 1#)))
+complementInteger (J# s d)
+    = mpzToInteger (complementInteger# s d)
+
+{-# NOINLINE shiftLInteger #-}
+shiftLInteger :: Integer -> Int# -> Integer
+shiftLInteger j@(S# _) i = shiftLInteger (toBig j) i
+shiftLInteger (J# s d) i = mpzToInteger (mul2ExpInteger# s d i)
+
+{-# NOINLINE shiftRInteger #-}
+shiftRInteger :: Integer -> Int# -> Integer
+shiftRInteger j@(S# _) i = shiftRInteger (toBig j) i
+shiftRInteger (J# s d) i = mpzToInteger (fdivQ2ExpInteger# s d i)
+
+-- | /Since: 0.5.1.0/
+{-# NOINLINE testBitInteger #-}
+testBitInteger :: Integer -> Int# -> Bool
+testBitInteger j@(S# _) i = testBitInteger (toBig j) i
+testBitInteger (J# s d) i = isTrue# (testBitInteger# s d i /=# 0#)
+
+-- | \"@'powInteger' /b/ /e/@\" computes base @/b/@ raised to exponent @/e/@.
+--
+-- /Since: 0.5.1.0/
+{-# NOINLINE powInteger #-}
+powInteger :: Integer -> Word# -> Integer
+powInteger j@(S# _) e = powInteger (toBig j) e
+powInteger (J# s d) e = mpzToInteger (powInteger# s d e)
+
+-- | \"@'powModInteger' /b/ /e/ /m/@\" computes base @/b/@ raised to
+-- exponent @/e/@ modulo @/m/@.
+--
+-- Negative exponents are supported if an inverse modulo @/m/@
+-- exists. It's advised to avoid calling this primitive with negative
+-- exponents unless it is guaranteed the inverse exists, as failure to
+-- do so will likely cause program abortion due to a divide-by-zero
+-- fault. See also 'recipModInteger'.
+--
+-- /Since: 0.5.1.0/
+{-# NOINLINE powModInteger #-}
+powModInteger :: Integer -> Integer -> Integer -> Integer
+powModInteger (J# s1 d1) (J# s2 d2) (J# s3 d3) =
+    mpzToInteger (powModInteger# s1 d1 s2 d2 s3 d3)
+powModInteger b e m = powModInteger (toBig b) (toBig e) (toBig m)
+
+-- | \"@'powModSecInteger' /b/ /e/ /m/@\" computes base @/b/@ raised to
+-- exponent @/e/@ modulo @/m/@. It is required that @/e/ > 0@ and
+-- @/m/@ is odd.
+--
+-- This is a \"secure\" variant of 'powModInteger' using the
+-- @mpz_powm_sec()@ function which is designed to be resilient to side
+-- channel attacks and is therefore intended for cryptographic
+-- applications.
+--
+-- This primitive is only available when the underlying GMP library
+-- supports it (GMP >= 5). Otherwise, it internally falls back to
+-- @'powModInteger'@, and a warning will be emitted when used.
+--
+-- /Since: 0.5.1.0/
+{-# NOINLINE powModSecInteger #-}
+powModSecInteger :: Integer -> Integer -> Integer -> Integer
+powModSecInteger (J# s1 d1) (J# s2 d2) (J# s3 d3) =
+    mpzToInteger (powModSecInteger# s1 d1 s2 d2 s3 d3)
+powModSecInteger b e m = powModSecInteger (toBig b) (toBig e) (toBig m)
+
+#if HAVE_SECURE_POWM == 0
+{-# WARNING powModSecInteger "The underlying GMP library does not support a secure version of powModInteger which is side-channel resistant - you need at least GMP version 5 to support this" #-}
+#endif
+
+-- | \"@'recipModInteger' /x/ /m/@\" computes the inverse of @/x/@ modulo @/m/@. If
+-- the inverse exists, the return value @/y/@ will satisfy @0 < /y/ <
+-- abs(/m/)@, otherwise the result is @0@.
+--
+-- Note: The implementation exploits the undocumented property of
+-- @mpz_invert()@ to not mangle the result operand (which is initialized
+-- to 0) in case of non-existence of the inverse.
+--
+-- /Since: 0.5.1.0/
+{-# NOINLINE recipModInteger #-}
+recipModInteger :: Integer -> Integer -> Integer
+recipModInteger j@(S# _) m@(S# _)   = recipModInteger (toBig j) (toBig m)
+recipModInteger j@(S# _) m@(J# _ _) = recipModInteger (toBig j) m
+recipModInteger j@(J# _ _) m@(S# _) = recipModInteger j (toBig m)
+recipModInteger (J# s d) (J# ms md) = mpzToInteger (recipModInteger# s d ms md)
+
+-- | Probalistic Miller-Rabin primality test.
+--
+-- \"@'testPrimeInteger' /n/ /k/@\" determines whether @/n/@ is prime
+-- and returns one of the following results:
+--
+-- * @2#@ is returned if @/n/@ is definitely prime,
+--
+-- * @1#@ if @/n/@ is a /probable prime/, or
+--
+-- * @0#@ if @/n/@ is definitely not a prime.
+--
+-- The @/k/@ argument controls how many test rounds are performed for
+-- determining a /probable prime/. For more details, see
+-- <http://gmplib.org/manual/Number-Theoretic-Functions.html#index-mpz_005fprobab_005fprime_005fp-360 GMP documentation for `mpz_probab_prime_p()`>.
+--
+-- /Since: 0.5.1.0/
+{-# NOINLINE testPrimeInteger #-}
+testPrimeInteger :: Integer -> Int# -> Int#
+testPrimeInteger j@(S# _) reps = testPrimeInteger (toBig j) reps
+testPrimeInteger (J# s d) reps = testPrimeInteger# s d reps
+
+-- | Compute next prime greater than @/n/@ probalistically.
+--
+-- According to the GMP documentation, the underlying function
+-- @mpz_nextprime()@ \"uses a probabilistic algorithm to identify
+-- primes. For practical purposes it's adequate, the chance of a
+-- composite passing will be extremely small.\"
+--
+-- /Since: 0.5.1.0/
+{-# NOINLINE nextPrimeInteger #-}
+nextPrimeInteger :: Integer -> Integer
+nextPrimeInteger j@(S# _) = nextPrimeInteger (toBig j)
+nextPrimeInteger (J# s d) = mpzToInteger (nextPrimeInteger# s d)
+
+-- | Compute number of digits (without sign) in given @/base/@.
+--
+-- It's recommended to avoid calling 'sizeInBaseInteger' for small
+-- integers as this function would currently convert those to big
+-- integers in order to call @mpz_sizeinbase()@.
+--
+-- This function wraps @mpz_sizeinbase()@ which has some
+-- implementation pecularities to take into account:
+--
+-- * \"@'sizeInBaseInteger' 0 /base/ = 1@\" (see also comment in 'exportIntegerToMutableByteArray').
+--
+-- * This function is only defined if @/base/ >= 2#@ and @/base/ <= 256#@
+--   (Note: the documentation claims that only @/base/ <= 62#@ is
+--   supported, however the actual implementation supports up to base 256).
+--
+-- * If @/base/@ is a power of 2, the result will be exact. In other
+--   cases (e.g. for @/base/ = 10#@), the result /may/ be 1 digit too large
+--   sometimes.
+--
+-- * \"@'sizeInBaseInteger' /i/ 2#@\" can be used to determine the most
+--   significant bit of @/i/@.
+--
+-- /Since: 0.5.1.0/
+{-# NOINLINE sizeInBaseInteger #-}
+sizeInBaseInteger :: Integer -> Int# -> Word#
+sizeInBaseInteger (J# s d) b = sizeInBaseInteger# s d b
+sizeInBaseInteger j@(S# _) b = sizeInBaseInteger (toBig j) b -- TODO
+
+-- | Dump 'Integer' (without sign) to mutable byte-array in base-256 representation.
+--
+-- The call
+--
+-- @'exportIntegerToMutableByteArray' /i/ /mba/ /offset/ /order/@
+--
+-- writes
+--
+-- * the 'Integer' @/i/@
+--
+-- * into the 'MutableByteArray#' @/mba/@ starting at @/offset/@
+--
+-- * with most significant byte first if @order@ is @1#@ or least
+--   significant byte first if @order@ is @-1#@, and
+--
+-- * returns number of bytes written.
+--
+-- Use \"@'sizeInBaseInteger' /i/ 256#@\" to compute the exact number of
+-- bytes written in advance for @/i/ /= 0@. In case of @/i/ == 0@,
+-- 'exportIntegerToMutableByteArray' will write and report zero bytes
+-- written, whereas 'sizeInBaseInteger' report one byte.
+--
+-- It's recommended to avoid calling 'exportIntegerToMutableByteArray' for small
+-- integers as this function would currently convert those to big
+-- integers in order to call @mpz_export()@.
+--
+-- /Since: 0.5.1.0/
+{-# NOINLINE exportIntegerToMutableByteArray #-}
+exportIntegerToMutableByteArray :: Integer -> MutableByteArray# s -> Word# -> Int# -> State# s -> (# State# s, Word# #)
+exportIntegerToMutableByteArray (J# s d) mba o e = exportIntegerToMutableByteArray# s d mba o e
+exportIntegerToMutableByteArray j@(S# _) mba o e = exportIntegerToMutableByteArray (toBig j) mba o e -- TODO
+
+-- | Dump 'Integer' (without sign) to @/addr/@ in base-256 representation.
+--
+-- @'exportIntegerToAddr' /addr/ /o/ /e/@
+--
+-- See description of 'exportIntegerToMutableByteArray' for more details.
+--
+-- /Since: 0.5.1.0/
+{-# NOINLINE exportIntegerToAddr #-}
+exportIntegerToAddr :: Integer -> Addr# -> Int# -> State# s -> (# State# s, Word# #)
+exportIntegerToAddr (J# s d) addr o e = exportIntegerToAddr# s d addr o e
+exportIntegerToAddr j@(S# _) addr o e = exportIntegerToAddr (toBig j) addr o e -- TODO
+
+-- | Read 'Integer' (without sign) from byte-array in base-256 representation.
+--
+-- The call
+--
+-- @'importIntegerFromByteArray' /ba/ /offset/ /size/ /order/@
+--
+-- reads
+--
+-- * @/size/@ bytes from the 'ByteArray#' @/ba/@ starting at @/offset/@
+--
+-- * with most significant byte first if @/order/@ is @1#@ or least
+--   significant byte first if @/order/@ is @-1#@, and
+--
+-- * returns a new 'Integer'
+--
+-- /Since: 0.5.1.0/
+{-# NOINLINE importIntegerFromByteArray #-}
+importIntegerFromByteArray :: ByteArray# -> Word# -> Word# -> Int# -> Integer
+importIntegerFromByteArray ba o l e = mpzToInteger (importIntegerFromByteArray# ba o l e)
+
+-- | Read 'Integer' (without sign) from memory location at @/addr/@ in
+-- base-256 representation.
+--
+-- @'importIntegerFromAddr' /addr/ /size/ /order/@
+--
+-- See description of 'importIntegerFromByteArray' for more details.
+--
+-- /Since: 0.5.1.0/
+{-# NOINLINE importIntegerFromAddr #-}
+importIntegerFromAddr :: Addr# -> Word# -> Int# -> State# s -> (# State# s, Integer #)
+importIntegerFromAddr addr l e st = case importIntegerFromAddr# addr l e st of
+                                      (# st', mpz #) -> let !j = mpzToInteger mpz in (# st', j #)
+
+\end{code}
+
+%*********************************************************
+%*                                                      *
+\subsection{The @Integer@ hashing@}
+%*                                                      *
+%*********************************************************
+
+\begin{code}
+-- This is used by hashUnique
+
+-- | 'hashInteger' returns the same value as 'fromIntegral', although in
+-- unboxed form.  It might be a reasonable hash function for 'Integer',
+-- given a suitable distribution of 'Integer' values.
+--
+-- Note: 'hashInteger' is currently just an alias for 'integerToInt'.
+
+hashInteger :: Integer -> Int#
+hashInteger = integerToInt
+\end{code}
+
diff --git a/libraries/integer-gmp/LICENSE b/libraries/integer-gmp/LICENSE
new file mode 100644
index 000000000000..7ac76a6db4ab
--- /dev/null
+++ b/libraries/integer-gmp/LICENSE
@@ -0,0 +1,62 @@
+This library (libraries/integer(-gmp)) is derived from code from several
+sources: 
+
+  * Code from the GHC project which is largely (c) The University of
+    Glasgow, and distributable under a BSD-style license (see below),
+
+  * Code from the Haskell 98 Report which is (c) Simon Peyton Jones
+    and freely redistributable (but see the full license for
+    restrictions).
+
+The full text of these licenses is reproduced below.  All of the
+licenses are BSD-style or compatible.
+
+-----------------------------------------------------------------------------
+
+The Glasgow Haskell Compiler License
+
+Copyright 2004, The University Court of the University of Glasgow. 
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+- Redistributions of source code must retain the above copyright notice,
+this list of conditions and the following disclaimer.
+ 
+- Redistributions in binary form must reproduce the above copyright notice,
+this list of conditions and the following disclaimer in the documentation
+and/or other materials provided with the distribution.
+ 
+- Neither name of the University nor the names of its contributors may be
+used to endorse or promote products derived from this software without
+specific prior written permission. 
+
+THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
+GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
+DAMAGE.
+
+-----------------------------------------------------------------------------
+
+Code derived from the document "Report on the Programming Language
+Haskell 98", is distributed under the following license:
+
+  Copyright (c) 2002 Simon Peyton Jones
+
+  The authors intend this Report to belong to the entire Haskell
+  community, and so we grant permission to copy and distribute it for
+  any purpose, provided that it is reproduced in its entirety,
+  including this Notice.  Modified versions of this Report may also be
+  copied and distributed for any purpose, provided that the modified
+  version is clearly presented as such, and that it does not claim to
+  be a definition of the Haskell 98 Language.
+
diff --git a/libraries/integer-gmp/Setup.hs b/libraries/integer-gmp/Setup.hs
new file mode 100644
index 000000000000..6fa548caf71c
--- /dev/null
+++ b/libraries/integer-gmp/Setup.hs
@@ -0,0 +1,6 @@
+module Main (main) where
+
+import Distribution.Simple
+
+main :: IO ()
+main = defaultMain
diff --git a/libraries/integer-gmp/aclocal.m4 b/libraries/integer-gmp/aclocal.m4
new file mode 100644
index 000000000000..be248615f583
--- /dev/null
+++ b/libraries/integer-gmp/aclocal.m4
@@ -0,0 +1,44 @@
+
+dnl--------------------------------------------------------------------
+dnl * Check whether this machine has gmp/gmp3 installed
+dnl--------------------------------------------------------------------
+
+AC_DEFUN([LOOK_FOR_GMP_LIB],[
+    if test "$HaveFrameworkGMP" = "NO"
+    then
+        AC_CHECK_LIB([gmp],  [__gmpz_powm],
+                     [HaveLibGmp=YES; GMP_LIBS=gmp])
+        if test "$HaveLibGmp" = "NO"
+        then
+            AC_CHECK_LIB([gmp3], [__gmpz_powm],
+                         [HaveLibGmp=YES; GMP_LIBS=gmp3])
+        fi
+        if test "$HaveLibGmp" = "YES"
+        then
+            AC_CHECK_LIB([$GMP_LIBS], [__gmpz_powm_sec],
+                         [HaveSecurePowm=1])
+        fi
+    fi
+])
+
+dnl--------------------------------------------------------------------
+dnl * Mac OS X only: check for GMP.framework
+dnl--------------------------------------------------------------------
+
+AC_DEFUN([LOOK_FOR_GMP_FRAMEWORK],[
+    if test "$HaveLibGmp" = "NO"
+    then
+        case $target_os in
+        darwin*)
+            AC_MSG_CHECKING([for GMP.framework])
+            save_libs="$LIBS"
+            LIBS="-framework GMP"
+            AC_TRY_LINK_FUNC(__gmpz_powm_sec,
+                             [HaveFrameworkGMP=YES; GMP_FRAMEWORK=GMP])
+            LIBS="$save_libs"
+            AC_MSG_RESULT([$HaveFrameworkGMP])
+            ;;
+        esac
+    fi
+])
+
diff --git a/libraries/integer-gmp/cbits/alloc.c b/libraries/integer-gmp/cbits/alloc.c
new file mode 100644
index 000000000000..e7111109c7ae
--- /dev/null
+++ b/libraries/integer-gmp/cbits/alloc.c
@@ -0,0 +1,97 @@
+/* -----------------------------------------------------------------------------
+ *
+ * (c) The GHC Team, 1998-2012
+ *
+ * ---------------------------------------------------------------------------*/
+
+#include <string.h>
+
+#include "Rts.h"
+
+#include "gmp.h"
+
+void * stgAllocForGMP   (size_t size_in_bytes);
+void * stgReallocForGMP (void *ptr, size_t old_size, size_t new_size);
+void   stgDeallocForGMP (void *ptr STG_UNUSED, size_t size STG_UNUSED);
+
+static void initAllocForGMP( void ) __attribute__((constructor));
+
+/* -----------------------------------------------------------------------------
+   Tell GMP to use our custom heap allocation functions.
+
+   Our allocation strategy is to use GHC heap allocations rather than malloc
+   and co. The heap objects we use are ByteArray#s which of course have their
+   usual header word or two. But gmp doesn't know about ghc heap objects and
+   header words. So our allocator has to make a ByteArray# and return a pointer
+   to its interior! When the gmp function returns we receive that interior
+   pointer. Then we look back a couple words to get the proper ByteArray#
+   pointer (which then gets returned as a ByteArray# and thus get tracked
+   properly by the GC).
+
+   WARNING!! WARNING!! WARNING!!
+
+     It is absolutely vital that this initialisation function be called before
+     any of the gmp functions are called. We'd still be looking back a couple
+     words for the ByteArray# header, but if we were accidentally using malloc
+     then it'd all go wrong because of course there would be no ByteArray#
+     header, just malloc's own internal book keeping info. To make things worse
+     we would not notice immediately, it'd only be when the GC comes round to
+     inspect things... BANG!
+
+     > Program received signal SIGSEGV, Segmentation fault.
+     > [Switching to Thread 0x7f5a9ebc76f0 (LWP 17838)]
+     > evacuate1 (p=0x7f5a99acd2e0) at rts/sm/Evac.c:375
+     > 375       switch (info->type) {
+
+   -------------------------------------------------------------------------- */
+
+static void initAllocForGMP( void )
+{
+  mp_set_memory_functions(stgAllocForGMP, stgReallocForGMP, stgDeallocForGMP);
+}
+
+
+/* -----------------------------------------------------------------------------
+   Allocation functions for GMP.
+
+   These all use the allocate() interface - we can't have any garbage
+   collection going on during a gmp operation, so we use allocate()
+   which always succeeds.  The gmp operations which might need to
+   allocate will ask the storage manager (via doYouWantToGC()) whether
+   a garbage collection is required, in case we get into a loop doing
+   only allocate() style allocation.
+   -------------------------------------------------------------------------- */
+
+void *
+stgAllocForGMP (size_t size_in_bytes)
+{
+  StgArrWords* arr;
+  nat data_size_in_words, total_size_in_words;
+  Capability *cap;
+
+  /* round up to a whole number of words */
+  data_size_in_words  = ROUNDUP_BYTES_TO_WDS(size_in_bytes);
+  total_size_in_words = sizeofW(StgArrWords) + data_size_in_words;
+
+  /* allocate and fill it in. */
+  cap = rts_unsafeGetMyCapability();
+  arr = (StgArrWords *)allocate(cap, total_size_in_words);
+  SET_ARR_HDR(arr, &stg_ARR_WORDS_info, ((CapabilityPublic*)cap)->r.rCCCS, size_in_bytes);
+
+  /* and return a ptr to the goods inside the array */
+  return arr->payload;
+}
+
+void *
+stgReallocForGMP (void *ptr, size_t old_size, size_t new_size)
+{
+  size_t min_size = old_size < new_size ? old_size : new_size;
+
+  return memcpy(stgAllocForGMP(new_size), ptr, min_size);
+}
+
+void
+stgDeallocForGMP (void *ptr STG_UNUSED, size_t size STG_UNUSED)
+{
+    /* easy for us: the garbage collector does the dealloc'n */
+}
diff --git a/libraries/integer-gmp/cbits/cbits.c b/libraries/integer-gmp/cbits/cbits.c
new file mode 100644
index 000000000000..3d53c6ba6248
--- /dev/null
+++ b/libraries/integer-gmp/cbits/cbits.c
@@ -0,0 +1,14 @@
+
+/* We combine the C files here.
+ *
+ * There is actually a good reason for this, really!
+ * The alloc file contains a __attribute__((constructor)) function. We must
+ * have this function in the same .o file as other stuff that actually gets
+ * used otherwise the static linker doesn't bother to pull in the .o file
+ * containing the constructor function. While we could just stick them in
+ * the same .c file that'd be a bit annoying. So we combine them here.
+ * */
+
+#include "alloc.c"
+#include "float.c"
+#include "longlong.c"
diff --git a/libraries/integer-gmp/cbits/float.c b/libraries/integer-gmp/cbits/float.c
new file mode 100644
index 000000000000..73a89f577a31
--- /dev/null
+++ b/libraries/integer-gmp/cbits/float.c
@@ -0,0 +1,249 @@
+/* -----------------------------------------------------------------------------
+ *
+ * (c) Lennart Augustsson
+ * (c) The GHC Team, 1998-2000
+ *
+ * Support for floating-point <-> gmp integer primitives
+ *
+ * ---------------------------------------------------------------------------*/
+
+/* TODO: do we need PosixSource.h ? it lives in rts/ not public includes/ */
+/* #include "PosixSource.h" */
+#include "Rts.h"
+#include "gmp.h"
+#include "GmpDerivedConstants.h"
+
+#include <math.h>
+
+#define IEEE_FLOATING_POINT 1
+
+/*
+ * Encoding and decoding Doubles.  Code based on the HBC code
+ * (lib/fltcode.c).
+ */
+
+#define SIZEOF_LIMB_T SIZEOF_MP_LIMB_T
+
+#if SIZEOF_LIMB_T == 4
+#define GMP_BASE 4294967296.0
+#define LIMBBITS_LOG_2 5
+#elif SIZEOF_LIMB_T == 8
+#define GMP_BASE 18446744073709551616.0
+#define LIMBBITS_LOG_2 6
+#else
+#error Cannot cope with SIZEOF_LIMB_T -- please add definition of GMP_BASE
+#endif
+
+#define DNBIGIT  ((SIZEOF_DOUBLE+SIZEOF_LIMB_T-1)/SIZEOF_LIMB_T)
+#define FNBIGIT  ((SIZEOF_FLOAT +SIZEOF_LIMB_T-1)/SIZEOF_LIMB_T)
+
+#if IEEE_FLOATING_POINT
+#define MY_DMINEXP  ((DBL_MIN_EXP) - (DBL_MANT_DIG) - 1)
+/* DMINEXP is defined in values.h on Linux (for example) */
+#define DHIGHBIT 0x00100000
+#define DMSBIT   0x80000000
+
+#define MY_FMINEXP  ((FLT_MIN_EXP) - (FLT_MANT_DIG) - 1)
+#define FHIGHBIT 0x00800000
+#define FMSBIT   0x80000000
+#endif
+
+#if defined(WORDS_BIGENDIAN) || defined(FLOAT_WORDS_BIGENDIAN)
+#define L 1
+#define H 0
+#else
+#define L 0
+#define H 1
+#endif
+
+#define __abs(a)                (( (a) >= 0 ) ? (a) : (-(a)))
+
+StgDouble
+integer_cbits_encodeDouble (I_ size, StgByteArray ba, I_ e) /* result = s * 2^e */
+{
+    StgDouble r;
+    const mp_limb_t *const arr = (const mp_limb_t *)ba;
+    I_ i;
+
+    /* Convert MP_INT to a double; knows a lot about internal rep! */
+    i = __abs(size)-1;
+    if ((i < 15) || (e >= 0)) /* overflows only if the final result does */
+    {
+        /* This would cause overflow if a large MP_INT is passed, even if the
+         * exponent would scale it back into range, so we do it only when it's safe. */
+        for(r = 0.0; i >= 0; i--)
+            r = (r * GMP_BASE) + arr[i];
+
+    } else { /* possibly more than 1024 bits in the MP_INT, but gets scaled down */
+
+        /* Find the first nonzero limb; normally it would be the first */
+        r = 0.0;
+        while((i >= 0) && (r == 0.0))
+        {
+            r = arr[i--];
+        }
+        if (i >= 0)
+            r = (r * GMP_BASE) + arr[i];
+#if SIZEOF_LIMB_T < 8
+        if (i > 0)
+            r = (r * GMP_BASE) + arr[--i];
+#endif
+        /* Now we have at least the 65 leading bits of the MP_INT or all of it.
+         * Any further bits would be rounded down, so from now on everything is
+         * multiplication by powers of 2.
+         * If i is positive, arr contains i limbs we haven't looked at yet, so
+         * adjust the exponent by i*8*SIZEOF_LIMB_T. Unfortunately, we must
+         * beware of overflow, so we can't simply add this to e. */
+        if (i > 0)
+        {
+            /* first add the number of whole limbs that would be cancelled */
+            i = i + e / (8 * SIZEOF_LIMB_T);
+            /* check for overflow */
+            if ((i > 0) && ((i >> (8*sizeof(I_) - 1 - LIMBBITS_LOG_2)) > 0))
+            {
+                /* overflow, give e a large dummy value */
+                e = 2147483647;
+            } else {
+                /* no overflow, get the exact value */
+                e = i * (8 * SIZEOF_LIMB_T) + (e % (8 * SIZEOF_LIMB_T));
+            }
+        }
+    }
+
+    /* Now raise to the exponent */
+    if ( r != 0.0 ) /* Lennart suggests this avoids a bug in MIPS's ldexp */
+        r = ldexp(r, e);
+
+    /* sign is encoded in the size */
+    if (size < 0)
+        r = -r;
+
+    return r;
+}
+
+StgFloat
+integer_cbits_encodeFloat (I_ size, StgByteArray ba, I_ e) /* result = s * 2^e */
+{
+    StgFloat r;
+    const mp_limb_t *arr = (const mp_limb_t *)ba;
+    I_ i;
+
+    /* Convert MP_INT to a float; knows a lot about internal rep! */
+    i = __abs(size)-1;
+    /* just in case StgFloat is a double, check sizes */
+#if SIZEOF_FLOAT == 4
+    if ((i < 2) || (e >= 0))
+#else
+    if ((i < 15) || (e >= 0))
+#endif
+    {
+        for(r = 0.0; i >= 0; i--)
+            r = (r * GMP_BASE) + arr[i];
+    } else {
+
+        /* Find the first nonzero limb; normally it would be the first */
+        r = 0.0;
+        while((i >= 0) && (r == 0.0))
+        {
+            r = arr[i--];
+        }
+        if (i >= 0)
+            r = (r * GMP_BASE) + arr[i];
+#if (SIZEOF_LIMB_T < 8) && (SIZEOF_FLOAT > 4)
+        if (i > 0)
+            r = (r * GMP_BASE) + arr[--i];
+#endif
+        /* Now we have enough leading bits of the MP_INT.
+         * Any further bits would be rounded down, so from now on everything is
+         * multiplication by powers of 2.
+         * If i is positive, arr contains i limbs we haven't looked at yet, so
+         * adjust the exponent by i*8*SIZEOF_LIMB_T. Unfortunately, we must
+         * beware of overflow, so we can't simply add this to e. */
+        if (i > 0)
+        {
+            /* first add the number of whole limbs that would be cancelled */
+            i = i + e / (8 * SIZEOF_LIMB_T);
+            /* check for overflow */
+            if ((i > 0) && ((i >> (8*sizeof(I_) - 1 - LIMBBITS_LOG_2)) > 0))
+            {
+                /* overflow, give e a large dummy value */
+                e = 2147483647;
+            } else {
+                /* no overflow, get the exact value */
+                e = i * (8 * SIZEOF_LIMB_T) + (e % (8 * SIZEOF_LIMB_T));
+            }
+        }
+    }
+
+    /* Now raise to the exponent */
+    if ( r != 0.0 ) /* Lennart suggests this avoids a bug in MIPS's ldexp */
+        r = ldexp(r, e);
+
+    /* sign is encoded in the size */
+    if (size < 0)
+        r = -r;
+
+    return r;
+}
+
+/* This only supports IEEE floating point */
+
+void
+integer_cbits_decodeDouble (MP_INT *man, I_ *exp, StgDouble dbl)
+{
+    /* Do some bit fiddling on IEEE */
+    unsigned int low, high;                      /* assuming 32 bit ints */
+    int sign, iexp;
+    union { double d; unsigned int i[2]; } u;    /* assuming 32 bit ints, 64 bit double */
+
+    ASSERT(sizeof(unsigned int ) == 4            );
+    ASSERT(sizeof(dbl          ) == SIZEOF_DOUBLE);
+    ASSERT(sizeof(man->_mp_d[0]) == SIZEOF_LIMB_T);
+    ASSERT(DNBIGIT*SIZEOF_LIMB_T >= SIZEOF_DOUBLE);
+
+    u.d = dbl;            /* grab chunks of the double */
+    low = u.i[L];
+    high = u.i[H];
+
+    /* we know the MP_INT* passed in has size zero, so we realloc
+            no matter what.
+    */
+    man->_mp_alloc = DNBIGIT;
+
+    if (low == 0 && (high & ~DMSBIT) == 0) {
+        man->_mp_size = 0;
+        *exp = 0L;
+    } else {
+        man->_mp_size = DNBIGIT;
+        iexp = ((high >> 20) & 0x7ff) + MY_DMINEXP;
+        sign = high;
+
+        high &= DHIGHBIT-1;
+        if (iexp != MY_DMINEXP)        /* don't add hidden bit to denorms */
+            high |= DHIGHBIT;
+        else {
+            iexp++;
+            /* A denorm, normalize the mantissa */
+            while (! (high & DHIGHBIT)) {
+                high <<= 1;
+                if (low & DMSBIT)
+                    high++;
+                low <<= 1;
+                iexp--;
+            }
+        }
+        *exp = (I_) iexp;
+#if DNBIGIT == 2
+        man->_mp_d[0] = (mp_limb_t)low;
+        man->_mp_d[1] = (mp_limb_t)high;
+#else
+#if DNBIGIT == 1
+        man->_mp_d[0] = ((mp_limb_t)high) << 32 | (mp_limb_t)low;
+#else
+#error Cannot cope with DNBIGIT
+#endif
+#endif
+        if (sign < 0)
+            man->_mp_size = -man->_mp_size;
+    }
+}
diff --git a/libraries/integer-gmp/cbits/gmp-wrappers.cmm b/libraries/integer-gmp/cbits/gmp-wrappers.cmm
new file mode 100644
index 000000000000..a5652511bd96
--- /dev/null
+++ b/libraries/integer-gmp/cbits/gmp-wrappers.cmm
@@ -0,0 +1,823 @@
+/* -----------------------------------------------------------------------------
+ *
+ * (c) The GHC Team, 1998-2012
+ *
+ * Out-of-line primitive operations
+ *
+ * This file contains the implementations of all the primitive
+ * operations ("primops") which are not expanded inline.  See
+ * ghc/compiler/prelude/primops.txt.pp for a list of all the primops;
+ * this file contains code for most of those with the attribute
+ * out_of_line=True.
+ *
+ * Entry convention: the entry convention for a primop is that all the
+ * args are in Stg registers (R1, R2, etc.).  This is to make writing
+ * the primops easier.  (see compiler/codeGen/CgCallConv.hs).
+ *
+ * Return convention: results from a primop are generally returned
+ * using the ordinary unboxed tuple return convention.  The C-- parser
+ * implements the RET_xxxx() macros to perform unboxed-tuple returns
+ * based on the prevailing return convention.
+ *
+ * This file is written in a subset of C--, extended with various
+ * features specific to GHC.  It is compiled by GHC directly.  For the
+ * syntax of .cmm files, see the parser in ghc/compiler/cmm/CmmParse.y.
+ *
+ * ---------------------------------------------------------------------------*/
+
+#include "Cmm.h"
+#include "GmpDerivedConstants.h"
+#include "HsIntegerGmp.h"
+
+import "integer-gmp" __gmpz_add;
+import "integer-gmp" __gmpz_add_ui;
+import "integer-gmp" __gmpz_sub;
+import "integer-gmp" __gmpz_sub_ui;
+import "integer-gmp" __gmpz_mul;
+import "integer-gmp" __gmpz_mul_2exp;
+import "integer-gmp" __gmpz_mul_si;
+import "integer-gmp" __gmpz_tstbit;
+import "integer-gmp" __gmpz_fdiv_q_2exp;
+import "integer-gmp" __gmpz_gcd;
+import "integer-gmp" __gmpz_gcdext;
+import "integer-gmp" __gmpn_gcd_1;
+import "integer-gmp" __gmpn_cmp;
+import "integer-gmp" __gmpz_tdiv_q;
+import "integer-gmp" __gmpz_tdiv_q_ui;
+import "integer-gmp" __gmpz_tdiv_r;
+import "integer-gmp" __gmpz_tdiv_r_ui;
+import "integer-gmp" __gmpz_fdiv_q;
+import "integer-gmp" __gmpz_fdiv_q_ui;
+import "integer-gmp" __gmpz_fdiv_r;
+import "integer-gmp" __gmpz_fdiv_r_ui;
+import "integer-gmp" __gmpz_tdiv_qr;
+import "integer-gmp" __gmpz_tdiv_qr_ui;
+import "integer-gmp" __gmpz_fdiv_qr;
+import "integer-gmp" __gmpz_fdiv_qr_ui;
+import "integer-gmp" __gmpz_divexact;
+import "integer-gmp" __gmpz_divexact_ui;
+import "integer-gmp" __gmpz_and;
+import "integer-gmp" __gmpz_xor;
+import "integer-gmp" __gmpz_ior;
+import "integer-gmp" __gmpz_com;
+import "integer-gmp" __gmpz_pow_ui;
+import "integer-gmp" __gmpz_powm;
+#if HAVE_SECURE_POWM == 1
+import "integer-gmp" __gmpz_powm_sec;
+#endif
+import "integer-gmp" __gmpz_invert;
+import "integer-gmp" __gmpz_nextprime;
+import "integer-gmp" __gmpz_probab_prime_p;
+import "integer-gmp" __gmpz_sizeinbase;
+import "integer-gmp" __gmpz_import;
+import "integer-gmp" __gmpz_export;
+
+import "integer-gmp" integer_cbits_decodeDouble;
+
+import "rts" stg_INTLIKE_closure;
+
+/* -----------------------------------------------------------------------------
+   Arbitrary-precision Integer operations.
+
+   There are some assumptions in this code that mp_limb_t == W_.  This is
+   the case for all the platforms that GHC supports, currently.
+   -------------------------------------------------------------------------- */
+
+#if SIZEOF_MP_LIMB_T != SIZEOF_W
+#error "sizeof(mp_limb_t) != sizeof(W_)"
+#endif
+
+/* This is used when a dummy pointer is needed for a ByteArray# return value
+
+   Ideally this would be a statically allocated 'ByteArray#'
+   containing SIZEOF_W 0-bytes. However, since in those cases when a
+   dummy value is needed, the 'ByteArray#' is not supposed to be
+   accessed anyway, this is should be a tolerable hack.
+ */
+#define DUMMY_BYTE_ARR (stg_INTLIKE_closure+1)
+
+/* set mpz_t from Int#/ByteArray# */
+#define MP_INT_SET_FROM_BA(mp_ptr,i,ba)                  \
+  MP_INT__mp_alloc(mp_ptr) = W_TO_INT(BYTE_ARR_WDS(ba)); \
+  MP_INT__mp_size(mp_ptr)  = W_TO_INT(i);                \
+  MP_INT__mp_d(mp_ptr)     = BYTE_ARR_CTS(ba)
+
+/* convert mpz_t to Int#/ByteArray# return pair */
+#define MP_INT_AS_PAIR(mp_ptr) \
+  TO_W_(MP_INT__mp_size(mp_ptr)),(MP_INT__mp_d(mp_ptr)-SIZEOF_StgArrWords)
+
+#define MP_INT_TO_BA(mp_ptr) \
+  (MP_INT__mp_d(mp_ptr)-SIZEOF_StgArrWords)
+
+/* Size of mpz_t with single limb */
+#define SIZEOF_MP_INT_1LIMB (SIZEOF_MP_INT+WDS(1))
+
+/* Initialize 0-valued single-limb mpz_t at mp_ptr */
+#define MP_INT_1LIMB_INIT0(mp_ptr)                       \
+  MP_INT__mp_alloc(mp_ptr) = W_TO_INT(1);                \
+  MP_INT__mp_size(mp_ptr)  = W_TO_INT(0);                \
+  MP_INT__mp_d(mp_ptr)     = (mp_ptr+SIZEOF_MP_INT)
+
+
+/* return mpz_t as (# s::Int#, d::ByteArray#, l1::Word# #) tuple
+ *
+ * semantics:
+ *
+ *  (#  0, _, 0 #) -> value = 0
+ *  (#  1, _, w #) -> value =  w
+ *  (# -1, _, w #) -> value = -w
+ *  (#  s, d, 0 #) -> value =  J# s d
+ *
+ */
+#define MP_INT_1LIMB_RETURN(mp_ptr)                    \
+  CInt __mp_s;                                         \
+  __mp_s = MP_INT__mp_size(mp_ptr);                    \
+                                                       \
+  if (__mp_s == W_TO_INT(0))                           \
+  {                                                    \
+    return (0,DUMMY_BYTE_ARR,0);                       \
+  }                                                    \
+                                                       \
+  if (__mp_s == W_TO_INT(-1) || __mp_s == W_TO_INT(1)) \
+  {                                                    \
+    return (TO_W_(__mp_s),DUMMY_BYTE_ARR,W_[MP_INT__mp_d(mp_ptr)]); \
+  }                                                    \
+                                                       \
+  return (TO_W_(__mp_s),MP_INT_TO_BA(mp_ptr),0)
+
+/* Helper macro used by MP_INT_1LIMB_RETURN2 */
+#define MP_INT_1LIMB_AS_TUP3(s,d,w,mp_ptr) \
+  CInt s; P_ d; W_ w;                            \
+  s = MP_INT__mp_size(mp_ptr);                   \
+                                                 \
+  if (s == W_TO_INT(0))                          \
+  {                                              \
+    d = DUMMY_BYTE_ARR; w = 0;                            \
+  } else {                                       \
+    if (s == W_TO_INT(-1) || s == W_TO_INT(1))   \
+    {                                            \
+      d = DUMMY_BYTE_ARR; w = W_[MP_INT__mp_d(mp_ptr)];   \
+    } else {                                     \
+      d = MP_INT_TO_BA(mp_ptr); w = 0;           \
+    }                                            \
+  }
+
+#define MP_INT_1LIMB_RETURN2(mp_ptr1,mp_ptr2)         \
+  MP_INT_1LIMB_AS_TUP3(__r1s,__r1d,__r1w,mp_ptr1);    \
+  MP_INT_1LIMB_AS_TUP3(__r2s,__r2d,__r2w,mp_ptr2);    \
+  return (TO_W_(__r1s),__r1d,__r1w, TO_W_(__r2s),__r2d,__r2w)
+
+/* :: ByteArray# -> Word# -> Word# -> Int# -> (# Int#, ByteArray#, Word# #) */
+integer_cmm_importIntegerFromByteArrayzh (P_ ba, W_ of, W_ sz, W_ e)
+{
+  W_ src_ptr;
+  W_ mp_result;
+
+again:
+  STK_CHK_GEN_N (SIZEOF_MP_INT_1LIMB);
+  MAYBE_GC(again);
+
+  mp_result = Sp - SIZEOF_MP_INT_1LIMB;
+  MP_INT_1LIMB_INIT0(mp_result);
+
+  src_ptr = BYTE_ARR_CTS(ba) + of;
+
+  ccall __gmpz_import(mp_result "ptr", sz, W_TO_INT(e), W_TO_INT(1), W_TO_INT(0), 0, src_ptr "ptr");
+
+  MP_INT_1LIMB_RETURN(mp_result);
+}
+
+/* :: Addr# -> Word# -> Int# -> State# s -> (# State# s, Int#, ByteArray#, Word# #) */
+integer_cmm_importIntegerFromAddrzh (W_ src_ptr, W_ sz, W_ e)
+{
+  W_ mp_result;
+
+again:
+  STK_CHK_GEN_N (SIZEOF_MP_INT_1LIMB);
+  MAYBE_GC(again);
+
+  mp_result = Sp - SIZEOF_MP_INT_1LIMB;
+
+  MP_INT_1LIMB_INIT0(mp_result);
+
+  ccall __gmpz_import(mp_result "ptr", sz, W_TO_INT(e), W_TO_INT(1), W_TO_INT(0), 0, src_ptr "ptr");
+
+  MP_INT_1LIMB_RETURN(mp_result);
+}
+
+/* :: Int# -> ByteArray# -> MutableByteArray# s -> Word# -> Int# -> State# s -> (# State# s, Word# #) */
+integer_cmm_exportIntegerToMutableByteArrayzh (W_ ws1, P_ d1, P_ mba, W_ of, W_ e)
+{
+  W_ dst_ptr;
+  W_ mp_tmp;
+  W_ cnt_result;
+
+again:
+  STK_CHK_GEN_N (SIZEOF_MP_INT + SIZEOF_W);
+  MAYBE_GC(again);
+
+  mp_tmp = Sp - SIZEOF_MP_INT;
+  MP_INT_SET_FROM_BA(mp_tmp, ws1, d1);
+
+  cnt_result = Sp - (SIZEOF_MP_INT + SIZEOF_W);
+  W_[cnt_result] = 0;
+
+  dst_ptr = BYTE_ARR_CTS(mba) + of;
+
+  ccall __gmpz_export(dst_ptr "ptr", cnt_result "ptr", W_TO_INT(e), W_TO_INT(1), W_TO_INT(0), 0, mp_tmp "ptr");
+
+  return (W_[cnt_result]);
+}
+
+/* :: Int# -> ByteArray# -> Addr# -> Int# -> State# s -> (# State# s, Word# #) */
+integer_cmm_exportIntegerToAddrzh (W_ ws1, P_ d1, W_ dst_ptr, W_ e)
+{
+  W_ mp_tmp;
+  W_ cnt_result;
+
+again:
+  STK_CHK_GEN_N (SIZEOF_MP_INT + SIZEOF_W);
+  MAYBE_GC(again);
+
+  mp_tmp = Sp - SIZEOF_MP_INT;
+  MP_INT_SET_FROM_BA(mp_tmp, ws1, d1);
+
+  cnt_result = Sp - (SIZEOF_MP_INT + SIZEOF_W);
+  W_[cnt_result] = 0;
+
+  ccall __gmpz_export(dst_ptr "ptr", cnt_result "ptr", W_TO_INT(e), W_TO_INT(1), W_TO_INT(0), 0, mp_tmp "ptr");
+
+  return (W_[cnt_result]);
+}
+
+integer_cmm_int2Integerzh (W_ val)
+{
+   W_ s, p; /* to avoid aliasing */
+
+   ALLOC_PRIM_N (SIZEOF_StgArrWords + WDS(1), integer_cmm_int2Integerzh, val);
+
+   p = Hp - SIZEOF_StgArrWords;
+   SET_HDR(p, stg_ARR_WORDS_info, CCCS);
+   StgArrWords_bytes(p) = SIZEOF_W;
+
+   /* mpz_set_si is inlined here, makes things simpler */
+   if (%lt(val,0)) {
+        s  = -1;
+        Hp(0) = -val;
+   } else {
+     if (%gt(val,0)) {
+        s = 1;
+        Hp(0) = val;
+     } else {
+        s = 0;
+     }
+  }
+
+   /* returns (# size  :: Int#,
+                 data  :: ByteArray#
+               #)
+   */
+   return (s,p);
+}
+
+integer_cmm_word2Integerzh (W_ val)
+{
+   W_ s, p; /* to avoid aliasing */
+
+   ALLOC_PRIM_N (SIZEOF_StgArrWords + WDS(1), integer_cmm_word2Integerzh, val);
+
+   p = Hp - SIZEOF_StgArrWords;
+   SET_HDR(p, stg_ARR_WORDS_info, CCCS);
+   StgArrWords_bytes(p) = SIZEOF_W;
+
+   if (val != 0) {
+        s = 1;
+        W_[Hp] = val;
+   } else {
+        s = 0;
+   }
+
+   /* returns (# size  :: Int#,
+                 data  :: ByteArray# #)
+   */
+   return (s,p);
+}
+
+
+/*
+ * 'long long' primops for converting to/from Integers.
+ */
+
+#if WORD_SIZE_IN_BITS < 64
+
+integer_cmm_int64ToIntegerzh (L_ val)
+{
+   W_ hi, lo, s, neg, words_needed, p;
+
+   neg = 0;
+
+   hi = TO_W_(val >> 32);
+   lo = TO_W_(val);
+
+   if ( hi == 0 || (hi == 0xFFFFFFFF && lo != 0) )  {
+       // minimum is one word
+       words_needed = 1;
+   } else {
+       words_needed = 2;
+   }
+
+   ALLOC_PRIM (SIZEOF_StgArrWords + WDS(words_needed));
+
+   p = Hp - SIZEOF_StgArrWords - WDS(words_needed) + WDS(1);
+   SET_HDR(p, stg_ARR_WORDS_info, CCCS);
+   StgArrWords_bytes(p) = WDS(words_needed);
+
+   if ( %lt(hi,0) ) {
+     neg = 1;
+     lo = -lo;
+     if(lo == 0) {
+       hi = -hi;
+     } else {
+       hi = -hi - 1;
+     }
+   }
+
+   if ( words_needed == 2 )  {
+      s = 2;
+      Hp(-1) = lo;
+      Hp(0) = hi;
+   } else {
+       if ( lo != 0 ) {
+           s = 1;
+           Hp(0) = lo;
+       } else /* val==0 */  {
+           s = 0;
+       }
+   }
+   if ( neg != 0 ) {
+        s = -s;
+   }
+
+   /* returns (# size  :: Int#,
+                 data  :: ByteArray# #)
+   */
+   return (s,p);
+}
+integer_cmm_word64ToIntegerzh (L_ val)
+{
+   W_ hi, lo, s, words_needed, p;
+
+   hi = TO_W_(val >> 32);
+   lo = TO_W_(val);
+
+   if ( hi != 0 ) {
+      words_needed = 2;
+   } else {
+      words_needed = 1;
+   }
+
+   ALLOC_PRIM (SIZEOF_StgArrWords + WDS(words_needed));
+
+   p = Hp - SIZEOF_StgArrWords - WDS(words_needed) + WDS(1);
+   SET_HDR(p, stg_ARR_WORDS_info, CCCS);
+   StgArrWords_bytes(p) = WDS(words_needed);
+
+   if ( hi != 0 ) {
+     s = 2;
+     Hp(-1) = lo;
+     Hp(0)  = hi;
+   } else {
+      if ( lo != 0 ) {
+        s = 1;
+        Hp(0) = lo;
+     } else /* val==0 */  {
+      s = 0;
+     }
+  }
+
+   /* returns (# size  :: Int#,
+                 data  :: ByteArray# #)
+   */
+   return (s,p);
+}
+
+#endif /* WORD_SIZE_IN_BITS < 64 */
+
+#define GMP_TAKE2_RET1(name,mp_fun)                             \
+name (W_ ws1, P_ d1, W_ ws2, P_ d2)                             \
+{                                                               \
+  W_ mp_tmp1;                                                   \
+  W_ mp_tmp2;                                                   \
+  W_ mp_result1;                                                \
+                                                                \
+again:                                                          \
+  STK_CHK_GEN_N (2*SIZEOF_MP_INT + SIZEOF_MP_INT_1LIMB);        \
+  MAYBE_GC(again);                                              \
+                                                                \
+  mp_tmp1    = Sp - 1*SIZEOF_MP_INT;                            \
+  mp_tmp2    = Sp - 2*SIZEOF_MP_INT;                            \
+  mp_result1 = Sp - 2*SIZEOF_MP_INT - SIZEOF_MP_INT_1LIMB;      \
+                                                                \
+  MP_INT_SET_FROM_BA(mp_tmp1,ws1,d1);                           \
+  MP_INT_SET_FROM_BA(mp_tmp2,ws2,d2);                           \
+                                                                \
+  MP_INT_1LIMB_INIT0(mp_result1);                               \
+                                                                \
+  /* Perform the operation */                                   \
+  ccall mp_fun(mp_result1 "ptr",mp_tmp1  "ptr",mp_tmp2  "ptr"); \
+                                                                \
+  MP_INT_1LIMB_RETURN(mp_result1);                              \
+}
+
+#define GMP_TAKE3_RET1(name,mp_fun)                             \
+name (W_ ws1, P_ d1, W_ ws2, P_ d2, W_ ws3, P_ d3)              \
+{                                                               \
+  W_ mp_tmp1;                                                   \
+  W_ mp_tmp2;                                                   \
+  W_ mp_tmp3;                                                   \
+  W_ mp_result1;                                                \
+                                                                \
+again:                                                          \
+  STK_CHK_GEN_N (3*SIZEOF_MP_INT + SIZEOF_MP_INT_1LIMB);        \
+  MAYBE_GC(again);                                              \
+                                                                \
+  mp_tmp1    = Sp - 1*SIZEOF_MP_INT;                            \
+  mp_tmp2    = Sp - 2*SIZEOF_MP_INT;                            \
+  mp_tmp3    = Sp - 3*SIZEOF_MP_INT;                            \
+  mp_result1 = Sp - 3*SIZEOF_MP_INT - SIZEOF_MP_INT_1LIMB;      \
+                                                                \
+  MP_INT_SET_FROM_BA(mp_tmp1,ws1,d1);                           \
+  MP_INT_SET_FROM_BA(mp_tmp2,ws2,d2);                           \
+  MP_INT_SET_FROM_BA(mp_tmp3,ws3,d3);                           \
+                                                                \
+  MP_INT_1LIMB_INIT0(mp_result1);                               \
+                                                                \
+  /* Perform the operation */                                   \
+  ccall mp_fun(mp_result1 "ptr",                                \
+               mp_tmp1 "ptr", mp_tmp2 "ptr", mp_tmp3 "ptr");    \
+                                                                \
+  MP_INT_1LIMB_RETURN(mp_result1);                              \
+}
+
+#define GMP_TAKE1_UL1_RET1(name,mp_fun)                         \
+name (W_ ws1, P_ d1, W_ wul)                                    \
+{                                                               \
+  W_ mp_tmp;                                                    \
+  W_ mp_result;                                                 \
+                                                                \
+  /* call doYouWantToGC() */                                    \
+again:                                                          \
+  STK_CHK_GEN_N (SIZEOF_MP_INT + SIZEOF_MP_INT_1LIMB);          \
+  MAYBE_GC(again);                                              \
+                                                                \
+  mp_tmp     = Sp - SIZEOF_MP_INT;                              \
+  mp_result  = Sp - SIZEOF_MP_INT - SIZEOF_MP_INT_1LIMB;        \
+                                                                \
+  MP_INT_SET_FROM_BA(mp_tmp,ws1,d1);                            \
+                                                                \
+  MP_INT_1LIMB_INIT0(mp_result);                                \
+                                                                \
+  /* Perform the operation */                                   \
+  ccall mp_fun(mp_result "ptr", mp_tmp "ptr", W_TO_LONG(wul));  \
+                                                                \
+  MP_INT_1LIMB_RETURN(mp_result);                               \
+}
+
+#define GMP_TAKE1_I1_RETI1(name,mp_fun)                         \
+name (W_ ws1, P_ d1, W_ wi)                                     \
+{                                                               \
+  CInt res;                                                     \
+  W_ mp_tmp;                                                    \
+                                                                \
+again:                                                          \
+  STK_CHK_GEN_N (SIZEOF_MP_INT);                                \
+  MAYBE_GC(again);                                              \
+                                                                \
+  mp_tmp     = Sp - 1 * SIZEOF_MP_INT;                          \
+  MP_INT_SET_FROM_BA(mp_tmp,ws1,d1);                            \
+                                                                \
+  /* Perform the operation */                                   \
+  (res) = ccall mp_fun(mp_tmp "ptr", W_TO_INT(wi));             \
+                                                                \
+  return (TO_W_(res));                                          \
+}
+
+#define GMP_TAKE1_UL1_RETI1(name,mp_fun)                        \
+name (W_ ws1, P_ d1, W_ wul)                                    \
+{                                                               \
+  CInt res;                                                     \
+  W_ mp_tmp;                                                    \
+                                                                \
+again:                                                          \
+  STK_CHK_GEN_N (SIZEOF_MP_INT);                                \
+  MAYBE_GC(again);                                              \
+                                                                \
+  mp_tmp     = Sp - 1 * SIZEOF_MP_INT;                          \
+  MP_INT_SET_FROM_BA(mp_tmp,ws1,d1);                            \
+                                                                \
+  /* Perform the operation */                                   \
+  (res) = ccall mp_fun(mp_tmp "ptr", W_TO_LONG(wul));           \
+                                                                \
+  return (TO_W_(res));                                          \
+}
+
+#define GMP_TAKE1_RET1(name,mp_fun)                             \
+name (W_ ws1, P_ d1)                                            \
+{                                                               \
+  W_ mp_tmp1;                                                   \
+  W_ mp_result1;                                                \
+                                                                \
+again:                                                          \
+  STK_CHK_GEN_N (SIZEOF_MP_INT + SIZEOF_MP_INT_1LIMB);          \
+  MAYBE_GC(again);                                              \
+                                                                \
+  mp_tmp1    = Sp - SIZEOF_MP_INT;                              \
+  mp_result1 = Sp - SIZEOF_MP_INT - SIZEOF_MP_INT_1LIMB;        \
+                                                                \
+  MP_INT_SET_FROM_BA(mp_tmp1,ws1,d1);                           \
+                                                                \
+  MP_INT_1LIMB_INIT0(mp_result1);                               \
+                                                                \
+  /* Perform the operation */                                   \
+  ccall mp_fun(mp_result1 "ptr",mp_tmp1 "ptr");                 \
+                                                                \
+  MP_INT_1LIMB_RETURN(mp_result1);                              \
+}
+
+#define GMP_TAKE2_RET2(name,mp_fun)                                     \
+name (W_ ws1, P_ d1, W_ ws2, P_ d2)                                     \
+{                                                                       \
+  W_ mp_tmp1;                                                           \
+  W_ mp_tmp2;                                                           \
+  W_ mp_result1;                                                        \
+  W_ mp_result2;                                                        \
+                                                                        \
+again:                                                                  \
+  STK_CHK_GEN_N (2*SIZEOF_MP_INT + 2*SIZEOF_MP_INT_1LIMB);              \
+  MAYBE_GC(again);                                                      \
+                                                                        \
+  mp_tmp1    = Sp - 1*SIZEOF_MP_INT;                                    \
+  mp_tmp2    = Sp - 2*SIZEOF_MP_INT;                                    \
+  mp_result1 = Sp - 2*SIZEOF_MP_INT - 1*SIZEOF_MP_INT_1LIMB;            \
+  mp_result2 = Sp - 2*SIZEOF_MP_INT - 2*SIZEOF_MP_INT_1LIMB;            \
+                                                                        \
+  MP_INT_SET_FROM_BA(mp_tmp1,ws1,d1);                                   \
+  MP_INT_SET_FROM_BA(mp_tmp2,ws2,d2);                                   \
+                                                                        \
+  MP_INT_1LIMB_INIT0(mp_result1);                                       \
+  MP_INT_1LIMB_INIT0(mp_result2);                                       \
+                                                                        \
+  /* Perform the operation */                                           \
+  ccall mp_fun(mp_result1 "ptr", mp_result2 "ptr",                      \
+               mp_tmp1 "ptr", mp_tmp2 "ptr");                           \
+                                                                        \
+  MP_INT_1LIMB_RETURN2(mp_result1, mp_result2);                         \
+}
+
+#define GMP_TAKE1_UL1_RET2(name,mp_fun)                                 \
+name (W_ ws1, P_ d1, W_ wul2)                                           \
+{                                                                       \
+  W_ mp_tmp1;                                                           \
+  W_ mp_result1;                                                        \
+  W_ mp_result2;                                                        \
+                                                                        \
+again:                                                                  \
+  STK_CHK_GEN_N (SIZEOF_MP_INT + 2*SIZEOF_MP_INT_1LIMB);                \
+  MAYBE_GC(again);                                                      \
+                                                                        \
+  mp_tmp1    = Sp - SIZEOF_MP_INT;                                      \
+  mp_result1 = Sp - SIZEOF_MP_INT - 1*SIZEOF_MP_INT_1LIMB;              \
+  mp_result2 = Sp - SIZEOF_MP_INT - 2*SIZEOF_MP_INT_1LIMB;              \
+                                                                        \
+  MP_INT_SET_FROM_BA(mp_tmp1,ws1,d1);                                   \
+                                                                        \
+  MP_INT_1LIMB_INIT0(mp_result1);                                       \
+  MP_INT_1LIMB_INIT0(mp_result2);                                       \
+                                                                        \
+  /* Perform the operation */                                           \
+  ccall mp_fun(mp_result1 "ptr", mp_result2 "ptr",                      \
+               mp_tmp1 "ptr", W_TO_LONG(wul2));                         \
+                                                                        \
+  MP_INT_1LIMB_RETURN2(mp_result1, mp_result2);                         \
+}
+
+GMP_TAKE2_RET1(integer_cmm_plusIntegerzh,           __gmpz_add)
+GMP_TAKE2_RET1(integer_cmm_minusIntegerzh,          __gmpz_sub)
+GMP_TAKE2_RET1(integer_cmm_timesIntegerzh,          __gmpz_mul)
+GMP_TAKE1_UL1_RET1(integer_cmm_timesIntegerIntzh,   __gmpz_mul_si)
+GMP_TAKE2_RET1(integer_cmm_gcdIntegerzh,            __gmpz_gcd)
+#define CMM_GMPZ_GCDEXT(g,s,a,b) __gmpz_gcdext(g,s,NULL,a,b)
+GMP_TAKE2_RET2(integer_cmm_gcdExtIntegerzh,         CMM_GMPZ_GCDEXT)
+GMP_TAKE2_RET1(integer_cmm_quotIntegerzh,           __gmpz_tdiv_q)
+GMP_TAKE1_UL1_RET1(integer_cmm_quotIntegerWordzh,   __gmpz_tdiv_q_ui)
+GMP_TAKE2_RET1(integer_cmm_remIntegerzh,            __gmpz_tdiv_r)
+GMP_TAKE1_UL1_RET1(integer_cmm_remIntegerWordzh,    __gmpz_tdiv_r_ui)
+GMP_TAKE2_RET1(integer_cmm_divIntegerzh,            __gmpz_fdiv_q)
+GMP_TAKE1_UL1_RET1(integer_cmm_divIntegerWordzh,    __gmpz_fdiv_q_ui)
+GMP_TAKE2_RET1(integer_cmm_modIntegerzh,            __gmpz_fdiv_r)
+GMP_TAKE1_UL1_RET1(integer_cmm_modIntegerWordzh,    __gmpz_fdiv_r_ui)
+GMP_TAKE2_RET1(integer_cmm_divExactIntegerzh,       __gmpz_divexact)
+GMP_TAKE1_UL1_RET1(integer_cmm_divExactIntegerWordzh, __gmpz_divexact_ui)
+GMP_TAKE2_RET1(integer_cmm_andIntegerzh,            __gmpz_and)
+GMP_TAKE2_RET1(integer_cmm_orIntegerzh,             __gmpz_ior)
+GMP_TAKE2_RET1(integer_cmm_xorIntegerzh,            __gmpz_xor)
+GMP_TAKE1_UL1_RETI1(integer_cmm_testBitIntegerzh,   __gmpz_tstbit)
+GMP_TAKE1_UL1_RET1(integer_cmm_mul2ExpIntegerzh,    __gmpz_mul_2exp)
+GMP_TAKE1_UL1_RET1(integer_cmm_fdivQ2ExpIntegerzh,  __gmpz_fdiv_q_2exp)
+GMP_TAKE1_RET1(integer_cmm_complementIntegerzh,     __gmpz_com)
+
+GMP_TAKE2_RET2(integer_cmm_quotRemIntegerzh,        __gmpz_tdiv_qr)
+GMP_TAKE1_UL1_RET2(integer_cmm_quotRemIntegerWordzh,__gmpz_tdiv_qr_ui)
+GMP_TAKE2_RET2(integer_cmm_divModIntegerzh,         __gmpz_fdiv_qr)
+GMP_TAKE1_UL1_RET2(integer_cmm_divModIntegerWordzh, __gmpz_fdiv_qr_ui)
+
+GMP_TAKE3_RET1(integer_cmm_powModIntegerzh,         __gmpz_powm)
+#if HAVE_SECURE_POWM == 1
+GMP_TAKE3_RET1(integer_cmm_powModSecIntegerzh,      __gmpz_powm_sec)
+#else
+GMP_TAKE3_RET1(integer_cmm_powModSecIntegerzh,      __gmpz_powm)
+#endif
+
+GMP_TAKE2_RET1(integer_cmm_recipModIntegerzh,       __gmpz_invert)
+GMP_TAKE1_UL1_RET1(integer_cmm_powIntegerzh,        __gmpz_pow_ui)
+
+GMP_TAKE1_RET1(integer_cmm_nextPrimeIntegerzh,      __gmpz_nextprime)
+GMP_TAKE1_I1_RETI1(integer_cmm_testPrimeIntegerzh,  __gmpz_probab_prime_p)
+
+GMP_TAKE1_I1_RETI1(integer_cmm_sizeInBasezh,        __gmpz_sizeinbase)
+
+integer_cmm_gcdIntzh (W_ int1, W_ int2)
+{
+    W_ r;
+    W_ mp_tmp_w;
+
+    STK_CHK_GEN_N (1 * SIZEOF_W);
+
+    mp_tmp_w = Sp - 1 * SIZEOF_W;
+
+    W_[mp_tmp_w] = int1;
+    (r) = ccall __gmpn_gcd_1(mp_tmp_w "ptr", 1, int2);
+
+    return (r);
+}
+
+
+integer_cmm_gcdIntegerIntzh (W_ s1, P_ d1, W_ int)
+{
+    W_ r;
+    (r) = ccall __gmpn_gcd_1 (BYTE_ARR_CTS(d1) "ptr", s1, int);
+    return (r);
+}
+
+
+integer_cmm_cmpIntegerIntzh (W_ usize, P_ d1, W_ v_digit)
+{
+    W_ vsize, u_digit;
+
+    vsize = 0;
+
+    // paraphrased from __gmpz_cmp_si() in the GMP sources
+    if (%gt(v_digit,0)) {
+        vsize = 1;
+    } else {
+        if (%lt(v_digit,0)) {
+            vsize = -1;
+            v_digit = -v_digit;
+        }
+    }
+
+    if (usize != vsize) {
+        return (usize - vsize);
+    }
+
+    if (usize == 0) {
+        return (0);
+    }
+
+    u_digit = W_[BYTE_ARR_CTS(d1)];
+
+    if (u_digit == v_digit) {
+        return (0);
+    }
+
+    if (%gtu(u_digit,v_digit)) { // NB. unsigned: these are mp_limb_t's
+        return (usize);
+    } else {
+        return (-usize);
+    }
+}
+
+integer_cmm_cmpIntegerzh (W_ usize, P_ d1, W_ vsize, P_ d2)
+{
+    W_ size, up, vp;
+    CInt cmp;
+
+    // paraphrased from __gmpz_cmp() in the GMP sources
+
+    if (usize != vsize) {
+        return (usize - vsize);
+    }
+
+    if (usize == 0) {
+        return (0);
+    }
+
+    if (%lt(usize,0)) { // NB. not <, which is unsigned
+        size = -usize;
+    } else {
+        size = usize;
+    }
+
+    up = BYTE_ARR_CTS(d1);
+    vp = BYTE_ARR_CTS(d2);
+
+    (cmp) = ccall __gmpn_cmp(up "ptr", vp "ptr", size);
+
+    if (cmp == 0 :: CInt) {
+        return (0);
+    }
+
+    if (%lt(cmp,0 :: CInt) == %lt(usize,0)) {
+        return (1);
+    } else {
+        return (-1);
+    }
+}
+
+#define DOUBLE_MANTISSA_SIZE SIZEOF_DOUBLE
+#define ARR_SIZE (SIZEOF_StgArrWords + DOUBLE_MANTISSA_SIZE)
+
+integer_cmm_decodeDoublezh (D_ arg)
+{
+    W_ mp_tmp1;
+    W_ mp_tmp_w;
+
+#if SIZEOF_DOUBLE != SIZEOF_W
+    W_ p;
+
+    STK_CHK_GEN_N (SIZEOF_MP_INT + SIZEOF_W);
+    ALLOC_PRIM (ARR_SIZE);
+
+    mp_tmp1  = Sp - SIZEOF_MP_INT;
+    mp_tmp_w = Sp - SIZEOF_MP_INT - SIZEOF_W;
+
+    /* Be prepared to tell Lennart-coded integer_cbits_decodeDouble
+       where mantissa.d can be put (it does not care about the rest) */
+    p = Hp - ARR_SIZE + WDS(1);
+    SET_HDR(p, stg_ARR_WORDS_info, CCCS);
+    StgArrWords_bytes(p) = DOUBLE_MANTISSA_SIZE;
+    MP_INT__mp_d(mp_tmp1) = BYTE_ARR_CTS(p);
+
+#else
+    /* When SIZEOF_DOUBLE == SIZEOF_W == 8, the result will fit into a
+       single 8-byte limb, and so we avoid allocating on the Heap and
+       use only the Stack instead */
+
+    STK_CHK_GEN_N (SIZEOF_MP_INT_1LIMB + SIZEOF_W);
+
+    mp_tmp1  = Sp - SIZEOF_MP_INT_1LIMB;
+    mp_tmp_w = Sp - SIZEOF_MP_INT_1LIMB - SIZEOF_W;
+
+    MP_INT_1LIMB_INIT0(mp_tmp1);
+#endif
+
+    /* Perform the operation */
+    ccall integer_cbits_decodeDouble(mp_tmp1 "ptr", mp_tmp_w "ptr", arg);
+
+    /* returns: (Int# (expn), MPZ#) */
+    MP_INT_1LIMB_AS_TUP3(r1s, r1d, r1w, mp_tmp1);
+
+    return (W_[mp_tmp_w], TO_W_(r1s), r1d, r1w);
+}
+
+/* :: Int# -> ByteArray# -> Int# -> (# Int#, ByteArray#, Word# #) */
+#define GMPX_TAKE1_UL1_RET1(name,pos_arg_fun,neg_arg_fun)               \
+name(W_ ws1, P_ d1, W_ wl)                                              \
+{                                                                       \
+  W_ mp_tmp;                                                            \
+  W_ mp_result;                                                         \
+                                                                        \
+again:                                                                  \
+  STK_CHK_GEN_N (SIZEOF_MP_INT + SIZEOF_MP_INT_1LIMB);                  \
+  MAYBE_GC(again);                                                      \
+                                                                        \
+  mp_tmp     = Sp - SIZEOF_MP_INT;                                      \
+  mp_result  = Sp - SIZEOF_MP_INT - SIZEOF_MP_INT_1LIMB;                \
+                                                                        \
+  MP_INT_SET_FROM_BA(mp_tmp,ws1,d1);                                    \
+                                                                        \
+  MP_INT_1LIMB_INIT0(mp_result);                                        \
+                                                                        \
+  if(%lt(wl,0)) {                                                       \
+      ccall neg_arg_fun(mp_result "ptr", mp_tmp "ptr", W_TO_LONG(-wl)); \
+  } else {                                                              \
+      ccall pos_arg_fun(mp_result "ptr", mp_tmp "ptr", W_TO_LONG(wl));  \
+  }                                                                     \
+                                                                        \
+  MP_INT_1LIMB_RETURN(mp_result);                                       \
+}
+
+/* NB: We need both primitives as we can't express 'minusIntegerInt#'
+   in terms of 'plusIntegerInt#' for @minBound :: Int@ */
+GMPX_TAKE1_UL1_RET1(integer_cmm_plusIntegerIntzh,__gmpz_add_ui,__gmpz_sub_ui)
+GMPX_TAKE1_UL1_RET1(integer_cmm_minusIntegerIntzh,__gmpz_sub_ui,__gmpz_add_ui)
diff --git a/libraries/integer-gmp/cbits/longlong.c b/libraries/integer-gmp/cbits/longlong.c
new file mode 100644
index 000000000000..1bf101819c2f
--- /dev/null
+++ b/libraries/integer-gmp/cbits/longlong.c
@@ -0,0 +1,66 @@
+/* -----------------------------------------------------------------------------
+ * $Id: longlong.c,v 1.4 2002/12/13 14:23:42 simonmar Exp $
+ *
+ * (c) The GHC Team, 1998-1999
+ *
+ * Primitive operations over (64-bit) long longs
+ * (only used on 32-bit platforms.)
+ *
+ * ---------------------------------------------------------------------------*/
+
+
+/*
+Primitive Integer conversions to/from HsInt64 and HsWord64s.
+N.B. These are not primops!
+
+Instead of going the normal (boring) route of making the list
+of primitive operations even longer to cope with operations
+over 64-bit entities, we implement them instead 'out-of-line'.
+
+The primitive ops get their own routine (in C) that implements
+the operation, requiring the caller to _ccall_ out. This has
+performance implications of course, but we currently don't
+expect intensive use of either Int64 or Word64 types.
+*/
+
+#include "Rts.h"
+
+#if WORD_SIZE_IN_BITS < 64
+
+HsWord64 hs_integerToWord64 (HsInt sa, StgByteArray /* Really: mp_limb_t* */ da)
+{
+  mp_limb_t* d;
+  HsInt s;
+  HsWord64 res;
+  d = (mp_limb_t *)da;
+  s = sa;
+  switch (s) {
+    case  0: res = 0;     break;
+    case  1: res = d[0];  break;
+    case -1: res = -(HsWord64)d[0]; break;
+    default:
+      res = (HsWord64)d[0] + ((HsWord64)d[1] << (BITS_IN (mp_limb_t)));
+      if (s < 0) res = -res;
+  }
+  return res;
+}
+
+HsInt64 hs_integerToInt64 (HsInt sa, StgByteArray /* Really: mp_limb_t* */ da)
+{
+  mp_limb_t* d;
+  HsInt s;
+  HsInt64 res;
+  d = (mp_limb_t *)da;
+  s = (sa);
+  switch (s) {
+    case  0: res = 0;     break;
+    case  1: res = d[0];  break;
+    case -1: res = -(HsInt64)d[0]; break;
+    default:
+      res = (HsInt64)d[0] + ((HsWord64)d[1] << (BITS_IN (mp_limb_t)));
+      if (s < 0) res = -res;
+  }
+  return res;
+}
+
+#endif /* WORD_SIZE_IN_BITS < 64 */
diff --git a/libraries/integer-gmp/changelog.md b/libraries/integer-gmp/changelog.md
new file mode 100644
index 000000000000..28e662bcea3e
--- /dev/null
+++ b/libraries/integer-gmp/changelog.md
@@ -0,0 +1,44 @@
+# Changelog for [`integer-gmp` package](http://hackage.haskell.org/package/integer-gmp)
+
+## 0.5.1.0  *Feb 2014*
+
+  * Bundled with GHC 7.8.1
+
+  * Improved Haddock documentation
+
+  * New [PrimBool](https://ghc.haskell.org/trac/ghc/wiki/PrimBool)
+    versions of comparison predicates in `GHC.Integer`:
+
+        eqInteger# :: Integer -> Integer -> Int#
+        geInteger# :: Integer -> Integer -> Int#
+        gtInteger# :: Integer -> Integer -> Int#
+        leInteger# :: Integer -> Integer -> Int#
+        ltInteger# :: Integer -> Integer -> Int#
+        neqInteger# :: Integer -> Integer -> Int#
+
+  * New `GHC.Integer.testBitInteger` primitive for use with `Data.Bits`
+
+  * Reduce short-lived heap allocation and try to demote `J#` back
+    to `S#` more aggressively.  See also
+    [#8647](https://ghc.haskell.org/trac/ghc/ticket/8647)
+    for more details.
+
+  * New GMP-specific binary (de)serialization primitives added to
+    `GHC.Integer.GMP.Internals`:
+
+        importIntegerFromByteArray
+        importIntegerFromAddr
+        exportIntegerToAddr
+        exportIntegerToMutableByteArray
+        sizeInBaseInteger
+
+  * New GMP-implemented number-theoretic operations added to
+    `GHC.Integer.GMP.Internals`:
+
+        gcdExtInteger
+        nextPrimeInteger
+        testPrimeInteger
+        powInteger
+        powModInteger
+        powModSecInteger
+        recipModInteger
diff --git a/libraries/integer-gmp/config.guess b/libraries/integer-gmp/config.guess
new file mode 100755
index 000000000000..b79252d6b103
--- /dev/null
+++ b/libraries/integer-gmp/config.guess
@@ -0,0 +1,1558 @@
+#! /bin/sh
+# Attempt to guess a canonical system name.
+#   Copyright 1992-2013 Free Software Foundation, Inc.
+
+timestamp='2013-06-10'
+
+# This file is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+# General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, see <http://www.gnu.org/licenses/>.
+#
+# As a special exception to the GNU General Public License, if you
+# distribute this file as part of a program that contains a
+# configuration script generated by Autoconf, you may include it under
+# the same distribution terms that you use for the rest of that
+# program.  This Exception is an additional permission under section 7
+# of the GNU General Public License, version 3 ("GPLv3").
+#
+# Originally written by Per Bothner.
+#
+# You can get the latest version of this script from:
+# http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.guess;hb=HEAD
+#
+# Please send patches with a ChangeLog entry to config-patches@gnu.org.
+
+
+me=`echo "$0" | sed -e 's,.*/,,'`
+
+usage="\
+Usage: $0 [OPTION]
+
+Output the configuration name of the system \`$me' is run on.
+
+Operation modes:
+  -h, --help         print this help, then exit
+  -t, --time-stamp   print date of last modification, then exit
+  -v, --version      print version number, then exit
+
+Report bugs and patches to <config-patches@gnu.org>."
+
+version="\
+GNU config.guess ($timestamp)
+
+Originally written by Per Bothner.
+Copyright 1992-2013 Free Software Foundation, Inc.
+
+This is free software; see the source for copying conditions.  There is NO
+warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE."
+
+help="
+Try \`$me --help' for more information."
+
+# Parse command line
+while test $# -gt 0 ; do
+  case $1 in
+    --time-stamp | --time* | -t )
+       echo "$timestamp" ; exit ;;
+    --version | -v )
+       echo "$version" ; exit ;;
+    --help | --h* | -h )
+       echo "$usage"; exit ;;
+    -- )     # Stop option processing
+       shift; break ;;
+    - )	# Use stdin as input.
+       break ;;
+    -* )
+       echo "$me: invalid option $1$help" >&2
+       exit 1 ;;
+    * )
+       break ;;
+  esac
+done
+
+if test $# != 0; then
+  echo "$me: too many arguments$help" >&2
+  exit 1
+fi
+
+trap 'exit 1' 1 2 15
+
+# CC_FOR_BUILD -- compiler used by this script. Note that the use of a
+# compiler to aid in system detection is discouraged as it requires
+# temporary files to be created and, as you can see below, it is a
+# headache to deal with in a portable fashion.
+
+# Historically, `CC_FOR_BUILD' used to be named `HOST_CC'. We still
+# use `HOST_CC' if defined, but it is deprecated.
+
+# Portable tmp directory creation inspired by the Autoconf team.
+
+set_cc_for_build='
+trap "exitcode=\$?; (rm -f \$tmpfiles 2>/dev/null; rmdir \$tmp 2>/dev/null) && exit \$exitcode" 0 ;
+trap "rm -f \$tmpfiles 2>/dev/null; rmdir \$tmp 2>/dev/null; exit 1" 1 2 13 15 ;
+: ${TMPDIR=/tmp} ;
+ { tmp=`(umask 077 && mktemp -d "$TMPDIR/cgXXXXXX") 2>/dev/null` && test -n "$tmp" && test -d "$tmp" ; } ||
+ { test -n "$RANDOM" && tmp=$TMPDIR/cg$$-$RANDOM && (umask 077 && mkdir $tmp) ; } ||
+ { tmp=$TMPDIR/cg-$$ && (umask 077 && mkdir $tmp) && echo "Warning: creating insecure temp directory" >&2 ; } ||
+ { echo "$me: cannot create a temporary directory in $TMPDIR" >&2 ; exit 1 ; } ;
+dummy=$tmp/dummy ;
+tmpfiles="$dummy.c $dummy.o $dummy.rel $dummy" ;
+case $CC_FOR_BUILD,$HOST_CC,$CC in
+ ,,)    echo "int x;" > $dummy.c ;
+	for c in cc gcc c89 c99 ; do
+	  if ($c -c -o $dummy.o $dummy.c) >/dev/null 2>&1 ; then
+	     CC_FOR_BUILD="$c"; break ;
+	  fi ;
+	done ;
+	if test x"$CC_FOR_BUILD" = x ; then
+	  CC_FOR_BUILD=no_compiler_found ;
+	fi
+	;;
+ ,,*)   CC_FOR_BUILD=$CC ;;
+ ,*,*)  CC_FOR_BUILD=$HOST_CC ;;
+esac ; set_cc_for_build= ;'
+
+# This is needed to find uname on a Pyramid OSx when run in the BSD universe.
+# (ghazi@noc.rutgers.edu 1994-08-24)
+if (test -f /.attbin/uname) >/dev/null 2>&1 ; then
+	PATH=$PATH:/.attbin ; export PATH
+fi
+
+UNAME_MACHINE=`(uname -m) 2>/dev/null` || UNAME_MACHINE=unknown
+UNAME_RELEASE=`(uname -r) 2>/dev/null` || UNAME_RELEASE=unknown
+UNAME_SYSTEM=`(uname -s) 2>/dev/null`  || UNAME_SYSTEM=unknown
+UNAME_VERSION=`(uname -v) 2>/dev/null` || UNAME_VERSION=unknown
+
+case "${UNAME_SYSTEM}" in
+Linux|GNU|GNU/*)
+	# If the system lacks a compiler, then just pick glibc.
+	# We could probably try harder.
+	LIBC=gnu
+
+	eval $set_cc_for_build
+	cat <<-EOF > $dummy.c
+	#include <features.h>
+	#if defined(__UCLIBC__)
+	LIBC=uclibc
+	#elif defined(__dietlibc__)
+	LIBC=dietlibc
+	#else
+	LIBC=gnu
+	#endif
+	EOF
+	eval `$CC_FOR_BUILD -E $dummy.c 2>/dev/null | grep '^LIBC'`
+	;;
+esac
+
+# Note: order is significant - the case branches are not exclusive.
+
+case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in
+    *:NetBSD:*:*)
+	# NetBSD (nbsd) targets should (where applicable) match one or
+	# more of the tuples: *-*-netbsdelf*, *-*-netbsdaout*,
+	# *-*-netbsdecoff* and *-*-netbsd*.  For targets that recently
+	# switched to ELF, *-*-netbsd* would select the old
+	# object file format.  This provides both forward
+	# compatibility and a consistent mechanism for selecting the
+	# object file format.
+	#
+	# Note: NetBSD doesn't particularly care about the vendor
+	# portion of the name.  We always set it to "unknown".
+	sysctl="sysctl -n hw.machine_arch"
+	UNAME_MACHINE_ARCH=`(/sbin/$sysctl 2>/dev/null || \
+	    /usr/sbin/$sysctl 2>/dev/null || echo unknown)`
+	case "${UNAME_MACHINE_ARCH}" in
+	    armeb) machine=armeb-unknown ;;
+	    arm*) machine=arm-unknown ;;
+	    sh3el) machine=shl-unknown ;;
+	    sh3eb) machine=sh-unknown ;;
+	    sh5el) machine=sh5le-unknown ;;
+	    *) machine=${UNAME_MACHINE_ARCH}-unknown ;;
+	esac
+	# The Operating System including object format, if it has switched
+	# to ELF recently, or will in the future.
+	case "${UNAME_MACHINE_ARCH}" in
+	    arm*|i386|m68k|ns32k|sh3*|sparc|vax)
+		eval $set_cc_for_build
+		if echo __ELF__ | $CC_FOR_BUILD -E - 2>/dev/null \
+			| grep -q __ELF__
+		then
+		    # Once all utilities can be ECOFF (netbsdecoff) or a.out (netbsdaout).
+		    # Return netbsd for either.  FIX?
+		    os=netbsd
+		else
+		    os=netbsdelf
+		fi
+		;;
+	    *)
+		os=netbsd
+		;;
+	esac
+	# The OS release
+	# Debian GNU/NetBSD machines have a different userland, and
+	# thus, need a distinct triplet. However, they do not need
+	# kernel version information, so it can be replaced with a
+	# suitable tag, in the style of linux-gnu.
+	case "${UNAME_VERSION}" in
+	    Debian*)
+		release='-gnu'
+		;;
+	    *)
+		release=`echo ${UNAME_RELEASE}|sed -e 's/[-_].*/\./'`
+		;;
+	esac
+	# Since CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM:
+	# contains redundant information, the shorter form:
+	# CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM is used.
+	echo "${machine}-${os}${release}"
+	exit ;;
+    *:Bitrig:*:*)
+	UNAME_MACHINE_ARCH=`arch | sed 's/Bitrig.//'`
+	echo ${UNAME_MACHINE_ARCH}-unknown-bitrig${UNAME_RELEASE}
+	exit ;;
+    *:OpenBSD:*:*)
+	UNAME_MACHINE_ARCH=`arch | sed 's/OpenBSD.//'`
+	echo ${UNAME_MACHINE_ARCH}-unknown-openbsd${UNAME_RELEASE}
+	exit ;;
+    *:ekkoBSD:*:*)
+	echo ${UNAME_MACHINE}-unknown-ekkobsd${UNAME_RELEASE}
+	exit ;;
+    *:SolidBSD:*:*)
+	echo ${UNAME_MACHINE}-unknown-solidbsd${UNAME_RELEASE}
+	exit ;;
+    macppc:MirBSD:*:*)
+	echo powerpc-unknown-mirbsd${UNAME_RELEASE}
+	exit ;;
+    *:MirBSD:*:*)
+	echo ${UNAME_MACHINE}-unknown-mirbsd${UNAME_RELEASE}
+	exit ;;
+    alpha:OSF1:*:*)
+	case $UNAME_RELEASE in
+	*4.0)
+		UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $3}'`
+		;;
+	*5.*)
+		UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $4}'`
+		;;
+	esac
+	# According to Compaq, /usr/sbin/psrinfo has been available on
+	# OSF/1 and Tru64 systems produced since 1995.  I hope that
+	# covers most systems running today.  This code pipes the CPU
+	# types through head -n 1, so we only detect the type of CPU 0.
+	ALPHA_CPU_TYPE=`/usr/sbin/psrinfo -v | sed -n -e 's/^  The alpha \(.*\) processor.*$/\1/p' | head -n 1`
+	case "$ALPHA_CPU_TYPE" in
+	    "EV4 (21064)")
+		UNAME_MACHINE="alpha" ;;
+	    "EV4.5 (21064)")
+		UNAME_MACHINE="alpha" ;;
+	    "LCA4 (21066/21068)")
+		UNAME_MACHINE="alpha" ;;
+	    "EV5 (21164)")
+		UNAME_MACHINE="alphaev5" ;;
+	    "EV5.6 (21164A)")
+		UNAME_MACHINE="alphaev56" ;;
+	    "EV5.6 (21164PC)")
+		UNAME_MACHINE="alphapca56" ;;
+	    "EV5.7 (21164PC)")
+		UNAME_MACHINE="alphapca57" ;;
+	    "EV6 (21264)")
+		UNAME_MACHINE="alphaev6" ;;
+	    "EV6.7 (21264A)")
+		UNAME_MACHINE="alphaev67" ;;
+	    "EV6.8CB (21264C)")
+		UNAME_MACHINE="alphaev68" ;;
+	    "EV6.8AL (21264B)")
+		UNAME_MACHINE="alphaev68" ;;
+	    "EV6.8CX (21264D)")
+		UNAME_MACHINE="alphaev68" ;;
+	    "EV6.9A (21264/EV69A)")
+		UNAME_MACHINE="alphaev69" ;;
+	    "EV7 (21364)")
+		UNAME_MACHINE="alphaev7" ;;
+	    "EV7.9 (21364A)")
+		UNAME_MACHINE="alphaev79" ;;
+	esac
+	# A Pn.n version is a patched version.
+	# A Vn.n version is a released version.
+	# A Tn.n version is a released field test version.
+	# A Xn.n version is an unreleased experimental baselevel.
+	# 1.2 uses "1.2" for uname -r.
+	echo ${UNAME_MACHINE}-dec-osf`echo ${UNAME_RELEASE} | sed -e 's/^[PVTX]//' | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'`
+	# Reset EXIT trap before exiting to avoid spurious non-zero exit code.
+	exitcode=$?
+	trap '' 0
+	exit $exitcode ;;
+    Alpha\ *:Windows_NT*:*)
+	# How do we know it's Interix rather than the generic POSIX subsystem?
+	# Should we change UNAME_MACHINE based on the output of uname instead
+	# of the specific Alpha model?
+	echo alpha-pc-interix
+	exit ;;
+    21064:Windows_NT:50:3)
+	echo alpha-dec-winnt3.5
+	exit ;;
+    Amiga*:UNIX_System_V:4.0:*)
+	echo m68k-unknown-sysv4
+	exit ;;
+    *:[Aa]miga[Oo][Ss]:*:*)
+	echo ${UNAME_MACHINE}-unknown-amigaos
+	exit ;;
+    *:[Mm]orph[Oo][Ss]:*:*)
+	echo ${UNAME_MACHINE}-unknown-morphos
+	exit ;;
+    *:OS/390:*:*)
+	echo i370-ibm-openedition
+	exit ;;
+    *:z/VM:*:*)
+	echo s390-ibm-zvmoe
+	exit ;;
+    *:OS400:*:*)
+	echo powerpc-ibm-os400
+	exit ;;
+    arm:RISC*:1.[012]*:*|arm:riscix:1.[012]*:*)
+	echo arm-acorn-riscix${UNAME_RELEASE}
+	exit ;;
+    arm*:riscos:*:*|arm*:RISCOS:*:*)
+	echo arm-unknown-riscos
+	exit ;;
+    SR2?01:HI-UX/MPP:*:* | SR8000:HI-UX/MPP:*:*)
+	echo hppa1.1-hitachi-hiuxmpp
+	exit ;;
+    Pyramid*:OSx*:*:* | MIS*:OSx*:*:* | MIS*:SMP_DC-OSx*:*:*)
+	# akee@wpdis03.wpafb.af.mil (Earle F. Ake) contributed MIS and NILE.
+	if test "`(/bin/universe) 2>/dev/null`" = att ; then
+		echo pyramid-pyramid-sysv3
+	else
+		echo pyramid-pyramid-bsd
+	fi
+	exit ;;
+    NILE*:*:*:dcosx)
+	echo pyramid-pyramid-svr4
+	exit ;;
+    DRS?6000:unix:4.0:6*)
+	echo sparc-icl-nx6
+	exit ;;
+    DRS?6000:UNIX_SV:4.2*:7* | DRS?6000:isis:4.2*:7*)
+	case `/usr/bin/uname -p` in
+	    sparc) echo sparc-icl-nx7; exit ;;
+	esac ;;
+    s390x:SunOS:*:*)
+	echo ${UNAME_MACHINE}-ibm-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`
+	exit ;;
+    sun4H:SunOS:5.*:*)
+	echo sparc-hal-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`
+	exit ;;
+    sun4*:SunOS:5.*:* | tadpole*:SunOS:5.*:*)
+	echo sparc-sun-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`
+	exit ;;
+    i86pc:AuroraUX:5.*:* | i86xen:AuroraUX:5.*:*)
+	echo i386-pc-auroraux${UNAME_RELEASE}
+	exit ;;
+    i86pc:SunOS:5.*:* | i86xen:SunOS:5.*:*)
+	eval $set_cc_for_build
+	SUN_ARCH="i386"
+	# If there is a compiler, see if it is configured for 64-bit objects.
+	# Note that the Sun cc does not turn __LP64__ into 1 like gcc does.
+	# This test works for both compilers.
+	if [ "$CC_FOR_BUILD" != 'no_compiler_found' ]; then
+	    if (echo '#ifdef __amd64'; echo IS_64BIT_ARCH; echo '#endif') | \
+		(CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | \
+		grep IS_64BIT_ARCH >/dev/null
+	    then
+		SUN_ARCH="x86_64"
+	    fi
+	fi
+	echo ${SUN_ARCH}-pc-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`
+	exit ;;
+    sun4*:SunOS:6*:*)
+	# According to config.sub, this is the proper way to canonicalize
+	# SunOS6.  Hard to guess exactly what SunOS6 will be like, but
+	# it's likely to be more like Solaris than SunOS4.
+	echo sparc-sun-solaris3`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`
+	exit ;;
+    sun4*:SunOS:*:*)
+	case "`/usr/bin/arch -k`" in
+	    Series*|S4*)
+		UNAME_RELEASE=`uname -v`
+		;;
+	esac
+	# Japanese Language versions have a version number like `4.1.3-JL'.
+	echo sparc-sun-sunos`echo ${UNAME_RELEASE}|sed -e 's/-/_/'`
+	exit ;;
+    sun3*:SunOS:*:*)
+	echo m68k-sun-sunos${UNAME_RELEASE}
+	exit ;;
+    sun*:*:4.2BSD:*)
+	UNAME_RELEASE=`(sed 1q /etc/motd | awk '{print substr($5,1,3)}') 2>/dev/null`
+	test "x${UNAME_RELEASE}" = "x" && UNAME_RELEASE=3
+	case "`/bin/arch`" in
+	    sun3)
+		echo m68k-sun-sunos${UNAME_RELEASE}
+		;;
+	    sun4)
+		echo sparc-sun-sunos${UNAME_RELEASE}
+		;;
+	esac
+	exit ;;
+    aushp:SunOS:*:*)
+	echo sparc-auspex-sunos${UNAME_RELEASE}
+	exit ;;
+    # The situation for MiNT is a little confusing.  The machine name
+    # can be virtually everything (everything which is not
+    # "atarist" or "atariste" at least should have a processor
+    # > m68000).  The system name ranges from "MiNT" over "FreeMiNT"
+    # to the lowercase version "mint" (or "freemint").  Finally
+    # the system name "TOS" denotes a system which is actually not
+    # MiNT.  But MiNT is downward compatible to TOS, so this should
+    # be no problem.
+    atarist[e]:*MiNT:*:* | atarist[e]:*mint:*:* | atarist[e]:*TOS:*:*)
+	echo m68k-atari-mint${UNAME_RELEASE}
+	exit ;;
+    atari*:*MiNT:*:* | atari*:*mint:*:* | atarist[e]:*TOS:*:*)
+	echo m68k-atari-mint${UNAME_RELEASE}
+	exit ;;
+    *falcon*:*MiNT:*:* | *falcon*:*mint:*:* | *falcon*:*TOS:*:*)
+	echo m68k-atari-mint${UNAME_RELEASE}
+	exit ;;
+    milan*:*MiNT:*:* | milan*:*mint:*:* | *milan*:*TOS:*:*)
+	echo m68k-milan-mint${UNAME_RELEASE}
+	exit ;;
+    hades*:*MiNT:*:* | hades*:*mint:*:* | *hades*:*TOS:*:*)
+	echo m68k-hades-mint${UNAME_RELEASE}
+	exit ;;
+    *:*MiNT:*:* | *:*mint:*:* | *:*TOS:*:*)
+	echo m68k-unknown-mint${UNAME_RELEASE}
+	exit ;;
+    m68k:machten:*:*)
+	echo m68k-apple-machten${UNAME_RELEASE}
+	exit ;;
+    powerpc:machten:*:*)
+	echo powerpc-apple-machten${UNAME_RELEASE}
+	exit ;;
+    RISC*:Mach:*:*)
+	echo mips-dec-mach_bsd4.3
+	exit ;;
+    RISC*:ULTRIX:*:*)
+	echo mips-dec-ultrix${UNAME_RELEASE}
+	exit ;;
+    VAX*:ULTRIX*:*:*)
+	echo vax-dec-ultrix${UNAME_RELEASE}
+	exit ;;
+    2020:CLIX:*:* | 2430:CLIX:*:*)
+	echo clipper-intergraph-clix${UNAME_RELEASE}
+	exit ;;
+    mips:*:*:UMIPS | mips:*:*:RISCos)
+	eval $set_cc_for_build
+	sed 's/^	//' << EOF >$dummy.c
+#ifdef __cplusplus
+#include <stdio.h>  /* for printf() prototype */
+	int main (int argc, char *argv[]) {
+#else
+	int main (argc, argv) int argc; char *argv[]; {
+#endif
+	#if defined (host_mips) && defined (MIPSEB)
+	#if defined (SYSTYPE_SYSV)
+	  printf ("mips-mips-riscos%ssysv\n", argv[1]); exit (0);
+	#endif
+	#if defined (SYSTYPE_SVR4)
+	  printf ("mips-mips-riscos%ssvr4\n", argv[1]); exit (0);
+	#endif
+	#if defined (SYSTYPE_BSD43) || defined(SYSTYPE_BSD)
+	  printf ("mips-mips-riscos%sbsd\n", argv[1]); exit (0);
+	#endif
+	#endif
+	  exit (-1);
+	}
+EOF
+	$CC_FOR_BUILD -o $dummy $dummy.c &&
+	  dummyarg=`echo "${UNAME_RELEASE}" | sed -n 's/\([0-9]*\).*/\1/p'` &&
+	  SYSTEM_NAME=`$dummy $dummyarg` &&
+	    { echo "$SYSTEM_NAME"; exit; }
+	echo mips-mips-riscos${UNAME_RELEASE}
+	exit ;;
+    Motorola:PowerMAX_OS:*:*)
+	echo powerpc-motorola-powermax
+	exit ;;
+    Motorola:*:4.3:PL8-*)
+	echo powerpc-harris-powermax
+	exit ;;
+    Night_Hawk:*:*:PowerMAX_OS | Synergy:PowerMAX_OS:*:*)
+	echo powerpc-harris-powermax
+	exit ;;
+    Night_Hawk:Power_UNIX:*:*)
+	echo powerpc-harris-powerunix
+	exit ;;
+    m88k:CX/UX:7*:*)
+	echo m88k-harris-cxux7
+	exit ;;
+    m88k:*:4*:R4*)
+	echo m88k-motorola-sysv4
+	exit ;;
+    m88k:*:3*:R3*)
+	echo m88k-motorola-sysv3
+	exit ;;
+    AViiON:dgux:*:*)
+	# DG/UX returns AViiON for all architectures
+	UNAME_PROCESSOR=`/usr/bin/uname -p`
+	if [ $UNAME_PROCESSOR = mc88100 ] || [ $UNAME_PROCESSOR = mc88110 ]
+	then
+	    if [ ${TARGET_BINARY_INTERFACE}x = m88kdguxelfx ] || \
+	       [ ${TARGET_BINARY_INTERFACE}x = x ]
+	    then
+		echo m88k-dg-dgux${UNAME_RELEASE}
+	    else
+		echo m88k-dg-dguxbcs${UNAME_RELEASE}
+	    fi
+	else
+	    echo i586-dg-dgux${UNAME_RELEASE}
+	fi
+	exit ;;
+    M88*:DolphinOS:*:*)	# DolphinOS (SVR3)
+	echo m88k-dolphin-sysv3
+	exit ;;
+    M88*:*:R3*:*)
+	# Delta 88k system running SVR3
+	echo m88k-motorola-sysv3
+	exit ;;
+    XD88*:*:*:*) # Tektronix XD88 system running UTekV (SVR3)
+	echo m88k-tektronix-sysv3
+	exit ;;
+    Tek43[0-9][0-9]:UTek:*:*) # Tektronix 4300 system running UTek (BSD)
+	echo m68k-tektronix-bsd
+	exit ;;
+    *:IRIX*:*:*)
+	echo mips-sgi-irix`echo ${UNAME_RELEASE}|sed -e 's/-/_/g'`
+	exit ;;
+    ????????:AIX?:[12].1:2)   # AIX 2.2.1 or AIX 2.1.1 is RT/PC AIX.
+	echo romp-ibm-aix     # uname -m gives an 8 hex-code CPU id
+	exit ;;               # Note that: echo "'`uname -s`'" gives 'AIX '
+    i*86:AIX:*:*)
+	echo i386-ibm-aix
+	exit ;;
+    ia64:AIX:*:*)
+	if [ -x /usr/bin/oslevel ] ; then
+		IBM_REV=`/usr/bin/oslevel`
+	else
+		IBM_REV=${UNAME_VERSION}.${UNAME_RELEASE}
+	fi
+	echo ${UNAME_MACHINE}-ibm-aix${IBM_REV}
+	exit ;;
+    *:AIX:2:3)
+	if grep bos325 /usr/include/stdio.h >/dev/null 2>&1; then
+		eval $set_cc_for_build
+		sed 's/^		//' << EOF >$dummy.c
+		#include <sys/systemcfg.h>
+
+		main()
+			{
+			if (!__power_pc())
+				exit(1);
+			puts("powerpc-ibm-aix3.2.5");
+			exit(0);
+			}
+EOF
+		if $CC_FOR_BUILD -o $dummy $dummy.c && SYSTEM_NAME=`$dummy`
+		then
+			echo "$SYSTEM_NAME"
+		else
+			echo rs6000-ibm-aix3.2.5
+		fi
+	elif grep bos324 /usr/include/stdio.h >/dev/null 2>&1; then
+		echo rs6000-ibm-aix3.2.4
+	else
+		echo rs6000-ibm-aix3.2
+	fi
+	exit ;;
+    *:AIX:*:[4567])
+	IBM_CPU_ID=`/usr/sbin/lsdev -C -c processor -S available | sed 1q | awk '{ print $1 }'`
+	if /usr/sbin/lsattr -El ${IBM_CPU_ID} | grep ' POWER' >/dev/null 2>&1; then
+		IBM_ARCH=rs6000
+	else
+		IBM_ARCH=powerpc
+	fi
+	if [ -x /usr/bin/oslevel ] ; then
+		IBM_REV=`/usr/bin/oslevel`
+	else
+		IBM_REV=${UNAME_VERSION}.${UNAME_RELEASE}
+	fi
+	echo ${IBM_ARCH}-ibm-aix${IBM_REV}
+	exit ;;
+    *:AIX:*:*)
+	echo rs6000-ibm-aix
+	exit ;;
+    ibmrt:4.4BSD:*|romp-ibm:BSD:*)
+	echo romp-ibm-bsd4.4
+	exit ;;
+    ibmrt:*BSD:*|romp-ibm:BSD:*)            # covers RT/PC BSD and
+	echo romp-ibm-bsd${UNAME_RELEASE}   # 4.3 with uname added to
+	exit ;;                             # report: romp-ibm BSD 4.3
+    *:BOSX:*:*)
+	echo rs6000-bull-bosx
+	exit ;;
+    DPX/2?00:B.O.S.:*:*)
+	echo m68k-bull-sysv3
+	exit ;;
+    9000/[34]??:4.3bsd:1.*:*)
+	echo m68k-hp-bsd
+	exit ;;
+    hp300:4.4BSD:*:* | 9000/[34]??:4.3bsd:2.*:*)
+	echo m68k-hp-bsd4.4
+	exit ;;
+    9000/[34678]??:HP-UX:*:*)
+	HPUX_REV=`echo ${UNAME_RELEASE}|sed -e 's/[^.]*.[0B]*//'`
+	case "${UNAME_MACHINE}" in
+	    9000/31? )            HP_ARCH=m68000 ;;
+	    9000/[34]?? )         HP_ARCH=m68k ;;
+	    9000/[678][0-9][0-9])
+		if [ -x /usr/bin/getconf ]; then
+		    sc_cpu_version=`/usr/bin/getconf SC_CPU_VERSION 2>/dev/null`
+		    sc_kernel_bits=`/usr/bin/getconf SC_KERNEL_BITS 2>/dev/null`
+		    case "${sc_cpu_version}" in
+		      523) HP_ARCH="hppa1.0" ;; # CPU_PA_RISC1_0
+		      528) HP_ARCH="hppa1.1" ;; # CPU_PA_RISC1_1
+		      532)                      # CPU_PA_RISC2_0
+			case "${sc_kernel_bits}" in
+			  32) HP_ARCH="hppa2.0n" ;;
+			  64) HP_ARCH="hppa2.0w" ;;
+			  '') HP_ARCH="hppa2.0" ;;   # HP-UX 10.20
+			esac ;;
+		    esac
+		fi
+		if [ "${HP_ARCH}" = "" ]; then
+		    eval $set_cc_for_build
+		    sed 's/^		//' << EOF >$dummy.c
+
+		#define _HPUX_SOURCE
+		#include <stdlib.h>
+		#include <unistd.h>
+
+		int main ()
+		{
+		#if defined(_SC_KERNEL_BITS)
+		    long bits = sysconf(_SC_KERNEL_BITS);
+		#endif
+		    long cpu  = sysconf (_SC_CPU_VERSION);
+
+		    switch (cpu)
+			{
+			case CPU_PA_RISC1_0: puts ("hppa1.0"); break;
+			case CPU_PA_RISC1_1: puts ("hppa1.1"); break;
+			case CPU_PA_RISC2_0:
+		#if defined(_SC_KERNEL_BITS)
+			    switch (bits)
+				{
+				case 64: puts ("hppa2.0w"); break;
+				case 32: puts ("hppa2.0n"); break;
+				default: puts ("hppa2.0"); break;
+				} break;
+		#else  /* !defined(_SC_KERNEL_BITS) */
+			    puts ("hppa2.0"); break;
+		#endif
+			default: puts ("hppa1.0"); break;
+			}
+		    exit (0);
+		}
+EOF
+		    (CCOPTS= $CC_FOR_BUILD -o $dummy $dummy.c 2>/dev/null) && HP_ARCH=`$dummy`
+		    test -z "$HP_ARCH" && HP_ARCH=hppa
+		fi ;;
+	esac
+	if [ ${HP_ARCH} = "hppa2.0w" ]
+	then
+	    eval $set_cc_for_build
+
+	    # hppa2.0w-hp-hpux* has a 64-bit kernel and a compiler generating
+	    # 32-bit code.  hppa64-hp-hpux* has the same kernel and a compiler
+	    # generating 64-bit code.  GNU and HP use different nomenclature:
+	    #
+	    # $ CC_FOR_BUILD=cc ./config.guess
+	    # => hppa2.0w-hp-hpux11.23
+	    # $ CC_FOR_BUILD="cc +DA2.0w" ./config.guess
+	    # => hppa64-hp-hpux11.23
+
+	    if echo __LP64__ | (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) |
+		grep -q __LP64__
+	    then
+		HP_ARCH="hppa2.0w"
+	    else
+		HP_ARCH="hppa64"
+	    fi
+	fi
+	echo ${HP_ARCH}-hp-hpux${HPUX_REV}
+	exit ;;
+    ia64:HP-UX:*:*)
+	HPUX_REV=`echo ${UNAME_RELEASE}|sed -e 's/[^.]*.[0B]*//'`
+	echo ia64-hp-hpux${HPUX_REV}
+	exit ;;
+    3050*:HI-UX:*:*)
+	eval $set_cc_for_build
+	sed 's/^	//' << EOF >$dummy.c
+	#include <unistd.h>
+	int
+	main ()
+	{
+	  long cpu = sysconf (_SC_CPU_VERSION);
+	  /* The order matters, because CPU_IS_HP_MC68K erroneously returns
+	     true for CPU_PA_RISC1_0.  CPU_IS_PA_RISC returns correct
+	     results, however.  */
+	  if (CPU_IS_PA_RISC (cpu))
+	    {
+	      switch (cpu)
+		{
+		  case CPU_PA_RISC1_0: puts ("hppa1.0-hitachi-hiuxwe2"); break;
+		  case CPU_PA_RISC1_1: puts ("hppa1.1-hitachi-hiuxwe2"); break;
+		  case CPU_PA_RISC2_0: puts ("hppa2.0-hitachi-hiuxwe2"); break;
+		  default: puts ("hppa-hitachi-hiuxwe2"); break;
+		}
+	    }
+	  else if (CPU_IS_HP_MC68K (cpu))
+	    puts ("m68k-hitachi-hiuxwe2");
+	  else puts ("unknown-hitachi-hiuxwe2");
+	  exit (0);
+	}
+EOF
+	$CC_FOR_BUILD -o $dummy $dummy.c && SYSTEM_NAME=`$dummy` &&
+		{ echo "$SYSTEM_NAME"; exit; }
+	echo unknown-hitachi-hiuxwe2
+	exit ;;
+    9000/7??:4.3bsd:*:* | 9000/8?[79]:4.3bsd:*:* )
+	echo hppa1.1-hp-bsd
+	exit ;;
+    9000/8??:4.3bsd:*:*)
+	echo hppa1.0-hp-bsd
+	exit ;;
+    *9??*:MPE/iX:*:* | *3000*:MPE/iX:*:*)
+	echo hppa1.0-hp-mpeix
+	exit ;;
+    hp7??:OSF1:*:* | hp8?[79]:OSF1:*:* )
+	echo hppa1.1-hp-osf
+	exit ;;
+    hp8??:OSF1:*:*)
+	echo hppa1.0-hp-osf
+	exit ;;
+    i*86:OSF1:*:*)
+	if [ -x /usr/sbin/sysversion ] ; then
+	    echo ${UNAME_MACHINE}-unknown-osf1mk
+	else
+	    echo ${UNAME_MACHINE}-unknown-osf1
+	fi
+	exit ;;
+    parisc*:Lites*:*:*)
+	echo hppa1.1-hp-lites
+	exit ;;
+    C1*:ConvexOS:*:* | convex:ConvexOS:C1*:*)
+	echo c1-convex-bsd
+	exit ;;
+    C2*:ConvexOS:*:* | convex:ConvexOS:C2*:*)
+	if getsysinfo -f scalar_acc
+	then echo c32-convex-bsd
+	else echo c2-convex-bsd
+	fi
+	exit ;;
+    C34*:ConvexOS:*:* | convex:ConvexOS:C34*:*)
+	echo c34-convex-bsd
+	exit ;;
+    C38*:ConvexOS:*:* | convex:ConvexOS:C38*:*)
+	echo c38-convex-bsd
+	exit ;;
+    C4*:ConvexOS:*:* | convex:ConvexOS:C4*:*)
+	echo c4-convex-bsd
+	exit ;;
+    CRAY*Y-MP:*:*:*)
+	echo ymp-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/'
+	exit ;;
+    CRAY*[A-Z]90:*:*:*)
+	echo ${UNAME_MACHINE}-cray-unicos${UNAME_RELEASE} \
+	| sed -e 's/CRAY.*\([A-Z]90\)/\1/' \
+	      -e y/ABCDEFGHIJKLMNOPQRSTUVWXYZ/abcdefghijklmnopqrstuvwxyz/ \
+	      -e 's/\.[^.]*$/.X/'
+	exit ;;
+    CRAY*TS:*:*:*)
+	echo t90-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/'
+	exit ;;
+    CRAY*T3E:*:*:*)
+	echo alphaev5-cray-unicosmk${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/'
+	exit ;;
+    CRAY*SV1:*:*:*)
+	echo sv1-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/'
+	exit ;;
+    *:UNICOS/mp:*:*)
+	echo craynv-cray-unicosmp${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/'
+	exit ;;
+    F30[01]:UNIX_System_V:*:* | F700:UNIX_System_V:*:*)
+	FUJITSU_PROC=`uname -m | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'`
+	FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'`
+	FUJITSU_REL=`echo ${UNAME_RELEASE} | sed -e 's/ /_/'`
+	echo "${FUJITSU_PROC}-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}"
+	exit ;;
+    5000:UNIX_System_V:4.*:*)
+	FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'`
+	FUJITSU_REL=`echo ${UNAME_RELEASE} | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/ /_/'`
+	echo "sparc-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}"
+	exit ;;
+    i*86:BSD/386:*:* | i*86:BSD/OS:*:* | *:Ascend\ Embedded/OS:*:*)
+	echo ${UNAME_MACHINE}-pc-bsdi${UNAME_RELEASE}
+	exit ;;
+    sparc*:BSD/OS:*:*)
+	echo sparc-unknown-bsdi${UNAME_RELEASE}
+	exit ;;
+    *:BSD/OS:*:*)
+	echo ${UNAME_MACHINE}-unknown-bsdi${UNAME_RELEASE}
+	exit ;;
+    *:FreeBSD:*:*)
+	UNAME_PROCESSOR=`/usr/bin/uname -p`
+	case ${UNAME_PROCESSOR} in
+	    amd64)
+		echo x86_64-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;;
+	    *)
+		echo ${UNAME_PROCESSOR}-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;;
+	esac
+	exit ;;
+    i*:CYGWIN*:*)
+	echo ${UNAME_MACHINE}-pc-cygwin
+	exit ;;
+    *:MINGW64*:*)
+	echo ${UNAME_MACHINE}-pc-mingw64
+	exit ;;
+    *:MINGW*:*)
+	echo ${UNAME_MACHINE}-pc-mingw32
+	exit ;;
+    i*:MSYS*:*)
+	echo ${UNAME_MACHINE}-pc-msys
+	exit ;;
+    i*:windows32*:*)
+	# uname -m includes "-pc" on this system.
+	echo ${UNAME_MACHINE}-mingw32
+	exit ;;
+    i*:PW*:*)
+	echo ${UNAME_MACHINE}-pc-pw32
+	exit ;;
+    *:Interix*:*)
+	case ${UNAME_MACHINE} in
+	    x86)
+		echo i586-pc-interix${UNAME_RELEASE}
+		exit ;;
+	    authenticamd | genuineintel | EM64T)
+		echo x86_64-unknown-interix${UNAME_RELEASE}
+		exit ;;
+	    IA64)
+		echo ia64-unknown-interix${UNAME_RELEASE}
+		exit ;;
+	esac ;;
+    [345]86:Windows_95:* | [345]86:Windows_98:* | [345]86:Windows_NT:*)
+	echo i${UNAME_MACHINE}-pc-mks
+	exit ;;
+    8664:Windows_NT:*)
+	echo x86_64-pc-mks
+	exit ;;
+    i*:Windows_NT*:* | Pentium*:Windows_NT*:*)
+	# How do we know it's Interix rather than the generic POSIX subsystem?
+	# It also conflicts with pre-2.0 versions of AT&T UWIN. Should we
+	# UNAME_MACHINE based on the output of uname instead of i386?
+	echo i586-pc-interix
+	exit ;;
+    i*:UWIN*:*)
+	echo ${UNAME_MACHINE}-pc-uwin
+	exit ;;
+    amd64:CYGWIN*:*:* | x86_64:CYGWIN*:*:*)
+	echo x86_64-unknown-cygwin
+	exit ;;
+    p*:CYGWIN*:*)
+	echo powerpcle-unknown-cygwin
+	exit ;;
+    prep*:SunOS:5.*:*)
+	echo powerpcle-unknown-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`
+	exit ;;
+    *:GNU:*:*)
+	# the GNU system
+	echo `echo ${UNAME_MACHINE}|sed -e 's,[-/].*$,,'`-unknown-${LIBC}`echo ${UNAME_RELEASE}|sed -e 's,/.*$,,'`
+	exit ;;
+    *:GNU/*:*:*)
+	# other systems with GNU libc and userland
+	echo ${UNAME_MACHINE}-unknown-`echo ${UNAME_SYSTEM} | sed 's,^[^/]*/,,' | tr '[A-Z]' '[a-z]'``echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'`-${LIBC}
+	exit ;;
+    i*86:Minix:*:*)
+	echo ${UNAME_MACHINE}-pc-minix
+	exit ;;
+    aarch64:Linux:*:*)
+	echo ${UNAME_MACHINE}-unknown-linux-${LIBC}
+	exit ;;
+    aarch64_be:Linux:*:*)
+	UNAME_MACHINE=aarch64_be
+	echo ${UNAME_MACHINE}-unknown-linux-${LIBC}
+	exit ;;
+    alpha:Linux:*:*)
+	case `sed -n '/^cpu model/s/^.*: \(.*\)/\1/p' < /proc/cpuinfo` in
+	  EV5)   UNAME_MACHINE=alphaev5 ;;
+	  EV56)  UNAME_MACHINE=alphaev56 ;;
+	  PCA56) UNAME_MACHINE=alphapca56 ;;
+	  PCA57) UNAME_MACHINE=alphapca56 ;;
+	  EV6)   UNAME_MACHINE=alphaev6 ;;
+	  EV67)  UNAME_MACHINE=alphaev67 ;;
+	  EV68*) UNAME_MACHINE=alphaev68 ;;
+	esac
+	objdump --private-headers /bin/sh | grep -q ld.so.1
+	if test "$?" = 0 ; then LIBC="gnulibc1" ; fi
+	echo ${UNAME_MACHINE}-unknown-linux-${LIBC}
+	exit ;;
+    arc:Linux:*:* | arceb:Linux:*:*)
+	echo ${UNAME_MACHINE}-unknown-linux-${LIBC}
+	exit ;;
+    arm*:Linux:*:*)
+	eval $set_cc_for_build
+	if echo __ARM_EABI__ | $CC_FOR_BUILD -E - 2>/dev/null \
+	    | grep -q __ARM_EABI__
+	then
+	    echo ${UNAME_MACHINE}-unknown-linux-${LIBC}
+	else
+	    if echo __ARM_PCS_VFP | $CC_FOR_BUILD -E - 2>/dev/null \
+		| grep -q __ARM_PCS_VFP
+	    then
+		echo ${UNAME_MACHINE}-unknown-linux-${LIBC}eabi
+	    else
+		echo ${UNAME_MACHINE}-unknown-linux-${LIBC}eabihf
+	    fi
+	fi
+	exit ;;
+    avr32*:Linux:*:*)
+	echo ${UNAME_MACHINE}-unknown-linux-${LIBC}
+	exit ;;
+    cris:Linux:*:*)
+	echo ${UNAME_MACHINE}-axis-linux-${LIBC}
+	exit ;;
+    crisv32:Linux:*:*)
+	echo ${UNAME_MACHINE}-axis-linux-${LIBC}
+	exit ;;
+    frv:Linux:*:*)
+	echo ${UNAME_MACHINE}-unknown-linux-${LIBC}
+	exit ;;
+    hexagon:Linux:*:*)
+	echo ${UNAME_MACHINE}-unknown-linux-${LIBC}
+	exit ;;
+    i*86:Linux:*:*)
+	echo ${UNAME_MACHINE}-pc-linux-${LIBC}
+	exit ;;
+    ia64:Linux:*:*)
+	echo ${UNAME_MACHINE}-unknown-linux-${LIBC}
+	exit ;;
+    m32r*:Linux:*:*)
+	echo ${UNAME_MACHINE}-unknown-linux-${LIBC}
+	exit ;;
+    m68*:Linux:*:*)
+	echo ${UNAME_MACHINE}-unknown-linux-${LIBC}
+	exit ;;
+    mips:Linux:*:* | mips64:Linux:*:*)
+	eval $set_cc_for_build
+	sed 's/^	//' << EOF >$dummy.c
+	#undef CPU
+	#undef ${UNAME_MACHINE}
+	#undef ${UNAME_MACHINE}el
+	#if defined(__MIPSEL__) || defined(__MIPSEL) || defined(_MIPSEL) || defined(MIPSEL)
+	CPU=${UNAME_MACHINE}el
+	#else
+	#if defined(__MIPSEB__) || defined(__MIPSEB) || defined(_MIPSEB) || defined(MIPSEB)
+	CPU=${UNAME_MACHINE}
+	#else
+	CPU=
+	#endif
+	#endif
+EOF
+	eval `$CC_FOR_BUILD -E $dummy.c 2>/dev/null | grep '^CPU'`
+	test x"${CPU}" != x && { echo "${CPU}-unknown-linux-${LIBC}"; exit; }
+	;;
+    or1k:Linux:*:*)
+	echo ${UNAME_MACHINE}-unknown-linux-${LIBC}
+	exit ;;
+    or32:Linux:*:*)
+	echo ${UNAME_MACHINE}-unknown-linux-${LIBC}
+	exit ;;
+    padre:Linux:*:*)
+	echo sparc-unknown-linux-${LIBC}
+	exit ;;
+    parisc64:Linux:*:* | hppa64:Linux:*:*)
+	echo hppa64-unknown-linux-${LIBC}
+	exit ;;
+    parisc:Linux:*:* | hppa:Linux:*:*)
+	# Look for CPU level
+	case `grep '^cpu[^a-z]*:' /proc/cpuinfo 2>/dev/null | cut -d' ' -f2` in
+	  PA7*) echo hppa1.1-unknown-linux-${LIBC} ;;
+	  PA8*) echo hppa2.0-unknown-linux-${LIBC} ;;
+	  *)    echo hppa-unknown-linux-${LIBC} ;;
+	esac
+	exit ;;
+    ppc64:Linux:*:*)
+	echo powerpc64-unknown-linux-${LIBC}
+	exit ;;
+    ppc:Linux:*:*)
+	echo powerpc-unknown-linux-${LIBC}
+	exit ;;
+    ppc64le:Linux:*:*)
+	echo powerpc64le-unknown-linux-${LIBC}
+	exit ;;
+    ppcle:Linux:*:*)
+	echo powerpcle-unknown-linux-${LIBC}
+	exit ;;
+    s390:Linux:*:* | s390x:Linux:*:*)
+	echo ${UNAME_MACHINE}-ibm-linux-${LIBC}
+	exit ;;
+    sh64*:Linux:*:*)
+	echo ${UNAME_MACHINE}-unknown-linux-${LIBC}
+	exit ;;
+    sh*:Linux:*:*)
+	echo ${UNAME_MACHINE}-unknown-linux-${LIBC}
+	exit ;;
+    sparc:Linux:*:* | sparc64:Linux:*:*)
+	echo ${UNAME_MACHINE}-unknown-linux-${LIBC}
+	exit ;;
+    tile*:Linux:*:*)
+	echo ${UNAME_MACHINE}-unknown-linux-${LIBC}
+	exit ;;
+    vax:Linux:*:*)
+	echo ${UNAME_MACHINE}-dec-linux-${LIBC}
+	exit ;;
+    x86_64:Linux:*:*)
+	echo ${UNAME_MACHINE}-unknown-linux-${LIBC}
+	exit ;;
+    xtensa*:Linux:*:*)
+	echo ${UNAME_MACHINE}-unknown-linux-${LIBC}
+	exit ;;
+    i*86:DYNIX/ptx:4*:*)
+	# ptx 4.0 does uname -s correctly, with DYNIX/ptx in there.
+	# earlier versions are messed up and put the nodename in both
+	# sysname and nodename.
+	echo i386-sequent-sysv4
+	exit ;;
+    i*86:UNIX_SV:4.2MP:2.*)
+	# Unixware is an offshoot of SVR4, but it has its own version
+	# number series starting with 2...
+	# I am not positive that other SVR4 systems won't match this,
+	# I just have to hope.  -- rms.
+	# Use sysv4.2uw... so that sysv4* matches it.
+	echo ${UNAME_MACHINE}-pc-sysv4.2uw${UNAME_VERSION}
+	exit ;;
+    i*86:OS/2:*:*)
+	# If we were able to find `uname', then EMX Unix compatibility
+	# is probably installed.
+	echo ${UNAME_MACHINE}-pc-os2-emx
+	exit ;;
+    i*86:XTS-300:*:STOP)
+	echo ${UNAME_MACHINE}-unknown-stop
+	exit ;;
+    i*86:atheos:*:*)
+	echo ${UNAME_MACHINE}-unknown-atheos
+	exit ;;
+    i*86:syllable:*:*)
+	echo ${UNAME_MACHINE}-pc-syllable
+	exit ;;
+    i*86:LynxOS:2.*:* | i*86:LynxOS:3.[01]*:* | i*86:LynxOS:4.[02]*:*)
+	echo i386-unknown-lynxos${UNAME_RELEASE}
+	exit ;;
+    i*86:*DOS:*:*)
+	echo ${UNAME_MACHINE}-pc-msdosdjgpp
+	exit ;;
+    i*86:*:4.*:* | i*86:SYSTEM_V:4.*:*)
+	UNAME_REL=`echo ${UNAME_RELEASE} | sed 's/\/MP$//'`
+	if grep Novell /usr/include/link.h >/dev/null 2>/dev/null; then
+		echo ${UNAME_MACHINE}-univel-sysv${UNAME_REL}
+	else
+		echo ${UNAME_MACHINE}-pc-sysv${UNAME_REL}
+	fi
+	exit ;;
+    i*86:*:5:[678]*)
+	# UnixWare 7.x, OpenUNIX and OpenServer 6.
+	case `/bin/uname -X | grep "^Machine"` in
+	    *486*)	     UNAME_MACHINE=i486 ;;
+	    *Pentium)	     UNAME_MACHINE=i586 ;;
+	    *Pent*|*Celeron) UNAME_MACHINE=i686 ;;
+	esac
+	echo ${UNAME_MACHINE}-unknown-sysv${UNAME_RELEASE}${UNAME_SYSTEM}${UNAME_VERSION}
+	exit ;;
+    i*86:*:3.2:*)
+	if test -f /usr/options/cb.name; then
+		UNAME_REL=`sed -n 's/.*Version //p' </usr/options/cb.name`
+		echo ${UNAME_MACHINE}-pc-isc$UNAME_REL
+	elif /bin/uname -X 2>/dev/null >/dev/null ; then
+		UNAME_REL=`(/bin/uname -X|grep Release|sed -e 's/.*= //')`
+		(/bin/uname -X|grep i80486 >/dev/null) && UNAME_MACHINE=i486
+		(/bin/uname -X|grep '^Machine.*Pentium' >/dev/null) \
+			&& UNAME_MACHINE=i586
+		(/bin/uname -X|grep '^Machine.*Pent *II' >/dev/null) \
+			&& UNAME_MACHINE=i686
+		(/bin/uname -X|grep '^Machine.*Pentium Pro' >/dev/null) \
+			&& UNAME_MACHINE=i686
+		echo ${UNAME_MACHINE}-pc-sco$UNAME_REL
+	else
+		echo ${UNAME_MACHINE}-pc-sysv32
+	fi
+	exit ;;
+    pc:*:*:*)
+	# Left here for compatibility:
+	# uname -m prints for DJGPP always 'pc', but it prints nothing about
+	# the processor, so we play safe by assuming i586.
+	# Note: whatever this is, it MUST be the same as what config.sub
+	# prints for the "djgpp" host, or else GDB configury will decide that
+	# this is a cross-build.
+	echo i586-pc-msdosdjgpp
+	exit ;;
+    Intel:Mach:3*:*)
+	echo i386-pc-mach3
+	exit ;;
+    paragon:*:*:*)
+	echo i860-intel-osf1
+	exit ;;
+    i860:*:4.*:*) # i860-SVR4
+	if grep Stardent /usr/include/sys/uadmin.h >/dev/null 2>&1 ; then
+	  echo i860-stardent-sysv${UNAME_RELEASE} # Stardent Vistra i860-SVR4
+	else # Add other i860-SVR4 vendors below as they are discovered.
+	  echo i860-unknown-sysv${UNAME_RELEASE}  # Unknown i860-SVR4
+	fi
+	exit ;;
+    mini*:CTIX:SYS*5:*)
+	# "miniframe"
+	echo m68010-convergent-sysv
+	exit ;;
+    mc68k:UNIX:SYSTEM5:3.51m)
+	echo m68k-convergent-sysv
+	exit ;;
+    M680?0:D-NIX:5.3:*)
+	echo m68k-diab-dnix
+	exit ;;
+    M68*:*:R3V[5678]*:*)
+	test -r /sysV68 && { echo 'm68k-motorola-sysv'; exit; } ;;
+    3[345]??:*:4.0:3.0 | 3[34]??A:*:4.0:3.0 | 3[34]??,*:*:4.0:3.0 | 3[34]??/*:*:4.0:3.0 | 4400:*:4.0:3.0 | 4850:*:4.0:3.0 | SKA40:*:4.0:3.0 | SDS2:*:4.0:3.0 | SHG2:*:4.0:3.0 | S7501*:*:4.0:3.0)
+	OS_REL=''
+	test -r /etc/.relid \
+	&& OS_REL=.`sed -n 's/[^ ]* [^ ]* \([0-9][0-9]\).*/\1/p' < /etc/.relid`
+	/bin/uname -p 2>/dev/null | grep 86 >/dev/null \
+	  && { echo i486-ncr-sysv4.3${OS_REL}; exit; }
+	/bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \
+	  && { echo i586-ncr-sysv4.3${OS_REL}; exit; } ;;
+    3[34]??:*:4.0:* | 3[34]??,*:*:4.0:*)
+	/bin/uname -p 2>/dev/null | grep 86 >/dev/null \
+	  && { echo i486-ncr-sysv4; exit; } ;;
+    NCR*:*:4.2:* | MPRAS*:*:4.2:*)
+	OS_REL='.3'
+	test -r /etc/.relid \
+	    && OS_REL=.`sed -n 's/[^ ]* [^ ]* \([0-9][0-9]\).*/\1/p' < /etc/.relid`
+	/bin/uname -p 2>/dev/null | grep 86 >/dev/null \
+	    && { echo i486-ncr-sysv4.3${OS_REL}; exit; }
+	/bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \
+	    && { echo i586-ncr-sysv4.3${OS_REL}; exit; }
+	/bin/uname -p 2>/dev/null | /bin/grep pteron >/dev/null \
+	    && { echo i586-ncr-sysv4.3${OS_REL}; exit; } ;;
+    m68*:LynxOS:2.*:* | m68*:LynxOS:3.0*:*)
+	echo m68k-unknown-lynxos${UNAME_RELEASE}
+	exit ;;
+    mc68030:UNIX_System_V:4.*:*)
+	echo m68k-atari-sysv4
+	exit ;;
+    TSUNAMI:LynxOS:2.*:*)
+	echo sparc-unknown-lynxos${UNAME_RELEASE}
+	exit ;;
+    rs6000:LynxOS:2.*:*)
+	echo rs6000-unknown-lynxos${UNAME_RELEASE}
+	exit ;;
+    PowerPC:LynxOS:2.*:* | PowerPC:LynxOS:3.[01]*:* | PowerPC:LynxOS:4.[02]*:*)
+	echo powerpc-unknown-lynxos${UNAME_RELEASE}
+	exit ;;
+    SM[BE]S:UNIX_SV:*:*)
+	echo mips-dde-sysv${UNAME_RELEASE}
+	exit ;;
+    RM*:ReliantUNIX-*:*:*)
+	echo mips-sni-sysv4
+	exit ;;
+    RM*:SINIX-*:*:*)
+	echo mips-sni-sysv4
+	exit ;;
+    *:SINIX-*:*:*)
+	if uname -p 2>/dev/null >/dev/null ; then
+		UNAME_MACHINE=`(uname -p) 2>/dev/null`
+		echo ${UNAME_MACHINE}-sni-sysv4
+	else
+		echo ns32k-sni-sysv
+	fi
+	exit ;;
+    PENTIUM:*:4.0*:*)	# Unisys `ClearPath HMP IX 4000' SVR4/MP effort
+			# says <Richard.M.Bartel@ccMail.Census.GOV>
+	echo i586-unisys-sysv4
+	exit ;;
+    *:UNIX_System_V:4*:FTX*)
+	# From Gerald Hewes <hewes@openmarket.com>.
+	# How about differentiating between stratus architectures? -djm
+	echo hppa1.1-stratus-sysv4
+	exit ;;
+    *:*:*:FTX*)
+	# From seanf@swdc.stratus.com.
+	echo i860-stratus-sysv4
+	exit ;;
+    i*86:VOS:*:*)
+	# From Paul.Green@stratus.com.
+	echo ${UNAME_MACHINE}-stratus-vos
+	exit ;;
+    *:VOS:*:*)
+	# From Paul.Green@stratus.com.
+	echo hppa1.1-stratus-vos
+	exit ;;
+    mc68*:A/UX:*:*)
+	echo m68k-apple-aux${UNAME_RELEASE}
+	exit ;;
+    news*:NEWS-OS:6*:*)
+	echo mips-sony-newsos6
+	exit ;;
+    R[34]000:*System_V*:*:* | R4000:UNIX_SYSV:*:* | R*000:UNIX_SV:*:*)
+	if [ -d /usr/nec ]; then
+		echo mips-nec-sysv${UNAME_RELEASE}
+	else
+		echo mips-unknown-sysv${UNAME_RELEASE}
+	fi
+	exit ;;
+    BeBox:BeOS:*:*)	# BeOS running on hardware made by Be, PPC only.
+	echo powerpc-be-beos
+	exit ;;
+    BeMac:BeOS:*:*)	# BeOS running on Mac or Mac clone, PPC only.
+	echo powerpc-apple-beos
+	exit ;;
+    BePC:BeOS:*:*)	# BeOS running on Intel PC compatible.
+	echo i586-pc-beos
+	exit ;;
+    BePC:Haiku:*:*)	# Haiku running on Intel PC compatible.
+	echo i586-pc-haiku
+	exit ;;
+    x86_64:Haiku:*:*)
+	echo x86_64-unknown-haiku
+	exit ;;
+    SX-4:SUPER-UX:*:*)
+	echo sx4-nec-superux${UNAME_RELEASE}
+	exit ;;
+    SX-5:SUPER-UX:*:*)
+	echo sx5-nec-superux${UNAME_RELEASE}
+	exit ;;
+    SX-6:SUPER-UX:*:*)
+	echo sx6-nec-superux${UNAME_RELEASE}
+	exit ;;
+    SX-7:SUPER-UX:*:*)
+	echo sx7-nec-superux${UNAME_RELEASE}
+	exit ;;
+    SX-8:SUPER-UX:*:*)
+	echo sx8-nec-superux${UNAME_RELEASE}
+	exit ;;
+    SX-8R:SUPER-UX:*:*)
+	echo sx8r-nec-superux${UNAME_RELEASE}
+	exit ;;
+    Power*:Rhapsody:*:*)
+	echo powerpc-apple-rhapsody${UNAME_RELEASE}
+	exit ;;
+    *:Rhapsody:*:*)
+	echo ${UNAME_MACHINE}-apple-rhapsody${UNAME_RELEASE}
+	exit ;;
+    *:Darwin:*:*)
+	UNAME_PROCESSOR=`uname -p` || UNAME_PROCESSOR=unknown
+	eval $set_cc_for_build
+	if test "$UNAME_PROCESSOR" = unknown ; then
+	    UNAME_PROCESSOR=powerpc
+	fi
+	if [ "$CC_FOR_BUILD" != 'no_compiler_found' ]; then
+	    if (echo '#ifdef __LP64__'; echo IS_64BIT_ARCH; echo '#endif') | \
+		(CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | \
+		grep IS_64BIT_ARCH >/dev/null
+	    then
+		case $UNAME_PROCESSOR in
+		    i386) UNAME_PROCESSOR=x86_64 ;;
+		    powerpc) UNAME_PROCESSOR=powerpc64 ;;
+		esac
+	    fi
+	fi
+	echo ${UNAME_PROCESSOR}-apple-darwin${UNAME_RELEASE}
+	exit ;;
+    *:procnto*:*:* | *:QNX:[0123456789]*:*)
+	UNAME_PROCESSOR=`uname -p`
+	if test "$UNAME_PROCESSOR" = "x86"; then
+		UNAME_PROCESSOR=i386
+		UNAME_MACHINE=pc
+	fi
+	echo ${UNAME_PROCESSOR}-${UNAME_MACHINE}-nto-qnx${UNAME_RELEASE}
+	exit ;;
+    *:QNX:*:4*)
+	echo i386-pc-qnx
+	exit ;;
+    NEO-?:NONSTOP_KERNEL:*:*)
+	echo neo-tandem-nsk${UNAME_RELEASE}
+	exit ;;
+    NSE-*:NONSTOP_KERNEL:*:*)
+	echo nse-tandem-nsk${UNAME_RELEASE}
+	exit ;;
+    NSR-?:NONSTOP_KERNEL:*:*)
+	echo nsr-tandem-nsk${UNAME_RELEASE}
+	exit ;;
+    *:NonStop-UX:*:*)
+	echo mips-compaq-nonstopux
+	exit ;;
+    BS2000:POSIX*:*:*)
+	echo bs2000-siemens-sysv
+	exit ;;
+    DS/*:UNIX_System_V:*:*)
+	echo ${UNAME_MACHINE}-${UNAME_SYSTEM}-${UNAME_RELEASE}
+	exit ;;
+    *:Plan9:*:*)
+	# "uname -m" is not consistent, so use $cputype instead. 386
+	# is converted to i386 for consistency with other x86
+	# operating systems.
+	if test "$cputype" = "386"; then
+	    UNAME_MACHINE=i386
+	else
+	    UNAME_MACHINE="$cputype"
+	fi
+	echo ${UNAME_MACHINE}-unknown-plan9
+	exit ;;
+    *:TOPS-10:*:*)
+	echo pdp10-unknown-tops10
+	exit ;;
+    *:TENEX:*:*)
+	echo pdp10-unknown-tenex
+	exit ;;
+    KS10:TOPS-20:*:* | KL10:TOPS-20:*:* | TYPE4:TOPS-20:*:*)
+	echo pdp10-dec-tops20
+	exit ;;
+    XKL-1:TOPS-20:*:* | TYPE5:TOPS-20:*:*)
+	echo pdp10-xkl-tops20
+	exit ;;
+    *:TOPS-20:*:*)
+	echo pdp10-unknown-tops20
+	exit ;;
+    *:ITS:*:*)
+	echo pdp10-unknown-its
+	exit ;;
+    SEI:*:*:SEIUX)
+	echo mips-sei-seiux${UNAME_RELEASE}
+	exit ;;
+    *:DragonFly:*:*)
+	echo ${UNAME_MACHINE}-unknown-dragonfly`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'`
+	exit ;;
+    *:*VMS:*:*)
+	UNAME_MACHINE=`(uname -p) 2>/dev/null`
+	case "${UNAME_MACHINE}" in
+	    A*) echo alpha-dec-vms ; exit ;;
+	    I*) echo ia64-dec-vms ; exit ;;
+	    V*) echo vax-dec-vms ; exit ;;
+	esac ;;
+    *:XENIX:*:SysV)
+	echo i386-pc-xenix
+	exit ;;
+    i*86:skyos:*:*)
+	echo ${UNAME_MACHINE}-pc-skyos`echo ${UNAME_RELEASE}` | sed -e 's/ .*$//'
+	exit ;;
+    i*86:rdos:*:*)
+	echo ${UNAME_MACHINE}-pc-rdos
+	exit ;;
+    i*86:AROS:*:*)
+	echo ${UNAME_MACHINE}-pc-aros
+	exit ;;
+    x86_64:VMkernel:*:*)
+	echo ${UNAME_MACHINE}-unknown-esx
+	exit ;;
+esac
+
+eval $set_cc_for_build
+cat >$dummy.c <<EOF
+#ifdef _SEQUENT_
+# include <sys/types.h>
+# include <sys/utsname.h>
+#endif
+main ()
+{
+#if defined (sony)
+#if defined (MIPSEB)
+  /* BFD wants "bsd" instead of "newsos".  Perhaps BFD should be changed,
+     I don't know....  */
+  printf ("mips-sony-bsd\n"); exit (0);
+#else
+#include <sys/param.h>
+  printf ("m68k-sony-newsos%s\n",
+#ifdef NEWSOS4
+	"4"
+#else
+	""
+#endif
+	); exit (0);
+#endif
+#endif
+
+#if defined (__arm) && defined (__acorn) && defined (__unix)
+  printf ("arm-acorn-riscix\n"); exit (0);
+#endif
+
+#if defined (hp300) && !defined (hpux)
+  printf ("m68k-hp-bsd\n"); exit (0);
+#endif
+
+#if defined (NeXT)
+#if !defined (__ARCHITECTURE__)
+#define __ARCHITECTURE__ "m68k"
+#endif
+  int version;
+  version=`(hostinfo | sed -n 's/.*NeXT Mach \([0-9]*\).*/\1/p') 2>/dev/null`;
+  if (version < 4)
+    printf ("%s-next-nextstep%d\n", __ARCHITECTURE__, version);
+  else
+    printf ("%s-next-openstep%d\n", __ARCHITECTURE__, version);
+  exit (0);
+#endif
+
+#if defined (MULTIMAX) || defined (n16)
+#if defined (UMAXV)
+  printf ("ns32k-encore-sysv\n"); exit (0);
+#else
+#if defined (CMU)
+  printf ("ns32k-encore-mach\n"); exit (0);
+#else
+  printf ("ns32k-encore-bsd\n"); exit (0);
+#endif
+#endif
+#endif
+
+#if defined (__386BSD__)
+  printf ("i386-pc-bsd\n"); exit (0);
+#endif
+
+#if defined (sequent)
+#if defined (i386)
+  printf ("i386-sequent-dynix\n"); exit (0);
+#endif
+#if defined (ns32000)
+  printf ("ns32k-sequent-dynix\n"); exit (0);
+#endif
+#endif
+
+#if defined (_SEQUENT_)
+    struct utsname un;
+
+    uname(&un);
+
+    if (strncmp(un.version, "V2", 2) == 0) {
+	printf ("i386-sequent-ptx2\n"); exit (0);
+    }
+    if (strncmp(un.version, "V1", 2) == 0) { /* XXX is V1 correct? */
+	printf ("i386-sequent-ptx1\n"); exit (0);
+    }
+    printf ("i386-sequent-ptx\n"); exit (0);
+
+#endif
+
+#if defined (vax)
+# if !defined (ultrix)
+#  include <sys/param.h>
+#  if defined (BSD)
+#   if BSD == 43
+      printf ("vax-dec-bsd4.3\n"); exit (0);
+#   else
+#    if BSD == 199006
+      printf ("vax-dec-bsd4.3reno\n"); exit (0);
+#    else
+      printf ("vax-dec-bsd\n"); exit (0);
+#    endif
+#   endif
+#  else
+    printf ("vax-dec-bsd\n"); exit (0);
+#  endif
+# else
+    printf ("vax-dec-ultrix\n"); exit (0);
+# endif
+#endif
+
+#if defined (alliant) && defined (i860)
+  printf ("i860-alliant-bsd\n"); exit (0);
+#endif
+
+  exit (1);
+}
+EOF
+
+$CC_FOR_BUILD -o $dummy $dummy.c 2>/dev/null && SYSTEM_NAME=`$dummy` &&
+	{ echo "$SYSTEM_NAME"; exit; }
+
+# Apollos put the system type in the environment.
+
+test -d /usr/apollo && { echo ${ISP}-apollo-${SYSTYPE}; exit; }
+
+# Convex versions that predate uname can use getsysinfo(1)
+
+if [ -x /usr/convex/getsysinfo ]
+then
+    case `getsysinfo -f cpu_type` in
+    c1*)
+	echo c1-convex-bsd
+	exit ;;
+    c2*)
+	if getsysinfo -f scalar_acc
+	then echo c32-convex-bsd
+	else echo c2-convex-bsd
+	fi
+	exit ;;
+    c34*)
+	echo c34-convex-bsd
+	exit ;;
+    c38*)
+	echo c38-convex-bsd
+	exit ;;
+    c4*)
+	echo c4-convex-bsd
+	exit ;;
+    esac
+fi
+
+cat >&2 <<EOF
+$0: unable to guess system type
+
+This script, last modified $timestamp, has failed to recognize
+the operating system you are using. It is advised that you
+download the most up to date version of the config scripts from
+
+  http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.guess;hb=HEAD
+and
+  http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.sub;hb=HEAD
+
+If the version you run ($0) is already up to date, please
+send the following data and any information you think might be
+pertinent to <config-patches@gnu.org> in order to provide the needed
+information to handle your system.
+
+config.guess timestamp = $timestamp
+
+uname -m = `(uname -m) 2>/dev/null || echo unknown`
+uname -r = `(uname -r) 2>/dev/null || echo unknown`
+uname -s = `(uname -s) 2>/dev/null || echo unknown`
+uname -v = `(uname -v) 2>/dev/null || echo unknown`
+
+/usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null`
+/bin/uname -X     = `(/bin/uname -X) 2>/dev/null`
+
+hostinfo               = `(hostinfo) 2>/dev/null`
+/bin/universe          = `(/bin/universe) 2>/dev/null`
+/usr/bin/arch -k       = `(/usr/bin/arch -k) 2>/dev/null`
+/bin/arch              = `(/bin/arch) 2>/dev/null`
+/usr/bin/oslevel       = `(/usr/bin/oslevel) 2>/dev/null`
+/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null`
+
+UNAME_MACHINE = ${UNAME_MACHINE}
+UNAME_RELEASE = ${UNAME_RELEASE}
+UNAME_SYSTEM  = ${UNAME_SYSTEM}
+UNAME_VERSION = ${UNAME_VERSION}
+EOF
+
+exit 1
+
+# Local variables:
+# eval: (add-hook 'write-file-hooks 'time-stamp)
+# time-stamp-start: "timestamp='"
+# time-stamp-format: "%:y-%02m-%02d"
+# time-stamp-end: "'"
+# End:
diff --git a/libraries/integer-gmp/config.sub b/libraries/integer-gmp/config.sub
new file mode 100755
index 000000000000..9633db704678
--- /dev/null
+++ b/libraries/integer-gmp/config.sub
@@ -0,0 +1,1791 @@
+#! /bin/sh
+# Configuration validation subroutine script.
+#   Copyright 1992-2013 Free Software Foundation, Inc.
+
+timestamp='2013-08-10'
+
+# This file is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+# General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, see <http://www.gnu.org/licenses/>.
+#
+# As a special exception to the GNU General Public License, if you
+# distribute this file as part of a program that contains a
+# configuration script generated by Autoconf, you may include it under
+# the same distribution terms that you use for the rest of that
+# program.  This Exception is an additional permission under section 7
+# of the GNU General Public License, version 3 ("GPLv3").
+
+
+# Please send patches with a ChangeLog entry to config-patches@gnu.org.
+#
+# Configuration subroutine to validate and canonicalize a configuration type.
+# Supply the specified configuration type as an argument.
+# If it is invalid, we print an error message on stderr and exit with code 1.
+# Otherwise, we print the canonical config type on stdout and succeed.
+
+# You can get the latest version of this script from:
+# http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.sub;hb=HEAD
+
+# This file is supposed to be the same for all GNU packages
+# and recognize all the CPU types, system types and aliases
+# that are meaningful with *any* GNU software.
+# Each package is responsible for reporting which valid configurations
+# it does not support.  The user should be able to distinguish
+# a failure to support a valid configuration from a meaningless
+# configuration.
+
+# The goal of this file is to map all the various variations of a given
+# machine specification into a single specification in the form:
+#	CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM
+# or in some cases, the newer four-part form:
+#	CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM
+# It is wrong to echo any other type of specification.
+
+me=`echo "$0" | sed -e 's,.*/,,'`
+
+usage="\
+Usage: $0 [OPTION] CPU-MFR-OPSYS
+       $0 [OPTION] ALIAS
+
+Canonicalize a configuration name.
+
+Operation modes:
+  -h, --help         print this help, then exit
+  -t, --time-stamp   print date of last modification, then exit
+  -v, --version      print version number, then exit
+
+Report bugs and patches to <config-patches@gnu.org>."
+
+version="\
+GNU config.sub ($timestamp)
+
+Copyright 1992-2013 Free Software Foundation, Inc.
+
+This is free software; see the source for copying conditions.  There is NO
+warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE."
+
+help="
+Try \`$me --help' for more information."
+
+# Parse command line
+while test $# -gt 0 ; do
+  case $1 in
+    --time-stamp | --time* | -t )
+       echo "$timestamp" ; exit ;;
+    --version | -v )
+       echo "$version" ; exit ;;
+    --help | --h* | -h )
+       echo "$usage"; exit ;;
+    -- )     # Stop option processing
+       shift; break ;;
+    - )	# Use stdin as input.
+       break ;;
+    -* )
+       echo "$me: invalid option $1$help"
+       exit 1 ;;
+
+    *local*)
+       # First pass through any local machine types.
+       echo $1
+       exit ;;
+
+    * )
+       break ;;
+  esac
+done
+
+case $# in
+ 0) echo "$me: missing argument$help" >&2
+    exit 1;;
+ 1) ;;
+ *) echo "$me: too many arguments$help" >&2
+    exit 1;;
+esac
+
+# Separate what the user gave into CPU-COMPANY and OS or KERNEL-OS (if any).
+# Here we must recognize all the valid KERNEL-OS combinations.
+maybe_os=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\2/'`
+case $maybe_os in
+  nto-qnx* | linux-gnu* | linux-android* | linux-dietlibc | linux-newlib* | \
+  linux-musl* | linux-uclibc* | uclinux-uclibc* | uclinux-gnu* | kfreebsd*-gnu* | \
+  knetbsd*-gnu* | netbsd*-gnu* | \
+  kopensolaris*-gnu* | \
+  storm-chaos* | os2-emx* | rtmk-nova*)
+    os=-$maybe_os
+    basic_machine=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\1/'`
+    ;;
+  android-linux)
+    os=-linux-android
+    basic_machine=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\1/'`-unknown
+    ;;
+  *)
+    basic_machine=`echo $1 | sed 's/-[^-]*$//'`
+    if [ $basic_machine != $1 ]
+    then os=`echo $1 | sed 's/.*-/-/'`
+    else os=; fi
+    ;;
+esac
+
+### Let's recognize common machines as not being operating systems so
+### that things like config.sub decstation-3100 work.  We also
+### recognize some manufacturers as not being operating systems, so we
+### can provide default operating systems below.
+case $os in
+	-sun*os*)
+		# Prevent following clause from handling this invalid input.
+		;;
+	-dec* | -mips* | -sequent* | -encore* | -pc532* | -sgi* | -sony* | \
+	-att* | -7300* | -3300* | -delta* | -motorola* | -sun[234]* | \
+	-unicom* | -ibm* | -next | -hp | -isi* | -apollo | -altos* | \
+	-convergent* | -ncr* | -news | -32* | -3600* | -3100* | -hitachi* |\
+	-c[123]* | -convex* | -sun | -crds | -omron* | -dg | -ultra | -tti* | \
+	-harris | -dolphin | -highlevel | -gould | -cbm | -ns | -masscomp | \
+	-apple | -axis | -knuth | -cray | -microblaze*)
+		os=
+		basic_machine=$1
+		;;
+	-bluegene*)
+		os=-cnk
+		;;
+	-sim | -cisco | -oki | -wec | -winbond)
+		os=
+		basic_machine=$1
+		;;
+	-scout)
+		;;
+	-wrs)
+		os=-vxworks
+		basic_machine=$1
+		;;
+	-chorusos*)
+		os=-chorusos
+		basic_machine=$1
+		;;
+	-chorusrdb)
+		os=-chorusrdb
+		basic_machine=$1
+		;;
+	-hiux*)
+		os=-hiuxwe2
+		;;
+	-sco6)
+		os=-sco5v6
+		basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
+		;;
+	-sco5)
+		os=-sco3.2v5
+		basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
+		;;
+	-sco4)
+		os=-sco3.2v4
+		basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
+		;;
+	-sco3.2.[4-9]*)
+		os=`echo $os | sed -e 's/sco3.2./sco3.2v/'`
+		basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
+		;;
+	-sco3.2v[4-9]*)
+		# Don't forget version if it is 3.2v4 or newer.
+		basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
+		;;
+	-sco5v6*)
+		# Don't forget version if it is 3.2v4 or newer.
+		basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
+		;;
+	-sco*)
+		os=-sco3.2v2
+		basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
+		;;
+	-udk*)
+		basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
+		;;
+	-isc)
+		os=-isc2.2
+		basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
+		;;
+	-clix*)
+		basic_machine=clipper-intergraph
+		;;
+	-isc*)
+		basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
+		;;
+	-lynx*178)
+		os=-lynxos178
+		;;
+	-lynx*5)
+		os=-lynxos5
+		;;
+	-lynx*)
+		os=-lynxos
+		;;
+	-ptx*)
+		basic_machine=`echo $1 | sed -e 's/86-.*/86-sequent/'`
+		;;
+	-windowsnt*)
+		os=`echo $os | sed -e 's/windowsnt/winnt/'`
+		;;
+	-psos*)
+		os=-psos
+		;;
+	-mint | -mint[0-9]*)
+		basic_machine=m68k-atari
+		os=-mint
+		;;
+esac
+
+# Decode aliases for certain CPU-COMPANY combinations.
+case $basic_machine in
+	# Recognize the basic CPU types without company name.
+	# Some are omitted here because they have special meanings below.
+	1750a | 580 \
+	| a29k \
+	| aarch64 | aarch64_be \
+	| alpha | alphaev[4-8] | alphaev56 | alphaev6[78] | alphapca5[67] \
+	| alpha64 | alpha64ev[4-8] | alpha64ev56 | alpha64ev6[78] | alpha64pca5[67] \
+	| am33_2.0 \
+	| arc | arceb \
+	| arm | arm[bl]e | arme[lb] | armv[2-8] | armv[3-8][lb] | armv7[arm] \
+	| avr | avr32 \
+	| be32 | be64 \
+	| bfin \
+	| c4x | c8051 | clipper \
+	| d10v | d30v | dlx | dsp16xx \
+	| epiphany \
+	| fido | fr30 | frv \
+	| h8300 | h8500 | hppa | hppa1.[01] | hppa2.0 | hppa2.0[nw] | hppa64 \
+	| hexagon \
+	| i370 | i860 | i960 | ia64 \
+	| ip2k | iq2000 \
+	| le32 | le64 \
+	| lm32 \
+	| m32c | m32r | m32rle | m68000 | m68k | m88k \
+	| maxq | mb | microblaze | microblazeel | mcore | mep | metag \
+	| mips | mipsbe | mipseb | mipsel | mipsle \
+	| mips16 \
+	| mips64 | mips64el \
+	| mips64octeon | mips64octeonel \
+	| mips64orion | mips64orionel \
+	| mips64r5900 | mips64r5900el \
+	| mips64vr | mips64vrel \
+	| mips64vr4100 | mips64vr4100el \
+	| mips64vr4300 | mips64vr4300el \
+	| mips64vr5000 | mips64vr5000el \
+	| mips64vr5900 | mips64vr5900el \
+	| mipsisa32 | mipsisa32el \
+	| mipsisa32r2 | mipsisa32r2el \
+	| mipsisa64 | mipsisa64el \
+	| mipsisa64r2 | mipsisa64r2el \
+	| mipsisa64sb1 | mipsisa64sb1el \
+	| mipsisa64sr71k | mipsisa64sr71kel \
+	| mipsr5900 | mipsr5900el \
+	| mipstx39 | mipstx39el \
+	| mn10200 | mn10300 \
+	| moxie \
+	| mt \
+	| msp430 \
+	| nds32 | nds32le | nds32be \
+	| nios | nios2 | nios2eb | nios2el \
+	| ns16k | ns32k \
+	| open8 \
+	| or1k | or32 \
+	| pdp10 | pdp11 | pj | pjl \
+	| powerpc | powerpc64 | powerpc64le | powerpcle \
+	| pyramid \
+	| rl78 | rx \
+	| score \
+	| sh | sh[1234] | sh[24]a | sh[24]aeb | sh[23]e | sh[34]eb | sheb | shbe | shle | sh[1234]le | sh3ele \
+	| sh64 | sh64le \
+	| sparc | sparc64 | sparc64b | sparc64v | sparc86x | sparclet | sparclite \
+	| sparcv8 | sparcv9 | sparcv9b | sparcv9v \
+	| spu \
+	| tahoe | tic4x | tic54x | tic55x | tic6x | tic80 | tron \
+	| ubicom32 \
+	| v850 | v850e | v850e1 | v850e2 | v850es | v850e2v3 \
+	| we32k \
+	| x86 | xc16x | xstormy16 | xtensa \
+	| z8k | z80)
+		basic_machine=$basic_machine-unknown
+		;;
+	c54x)
+		basic_machine=tic54x-unknown
+		;;
+	c55x)
+		basic_machine=tic55x-unknown
+		;;
+	c6x)
+		basic_machine=tic6x-unknown
+		;;
+	m6811 | m68hc11 | m6812 | m68hc12 | m68hcs12x | picochip)
+		basic_machine=$basic_machine-unknown
+		os=-none
+		;;
+	m88110 | m680[12346]0 | m683?2 | m68360 | m5200 | v70 | w65 | z8k)
+		;;
+	ms1)
+		basic_machine=mt-unknown
+		;;
+
+	strongarm | thumb | xscale)
+		basic_machine=arm-unknown
+		;;
+	xgate)
+		basic_machine=$basic_machine-unknown
+		os=-none
+		;;
+	xscaleeb)
+		basic_machine=armeb-unknown
+		;;
+
+	xscaleel)
+		basic_machine=armel-unknown
+		;;
+
+	# We use `pc' rather than `unknown'
+	# because (1) that's what they normally are, and
+	# (2) the word "unknown" tends to confuse beginning users.
+	i*86 | x86_64)
+	  basic_machine=$basic_machine-pc
+	  ;;
+	# Object if more than one company name word.
+	*-*-*)
+		echo Invalid configuration \`$1\': machine \`$basic_machine\' not recognized 1>&2
+		exit 1
+		;;
+	# Recognize the basic CPU types with company name.
+	580-* \
+	| a29k-* \
+	| aarch64-* | aarch64_be-* \
+	| alpha-* | alphaev[4-8]-* | alphaev56-* | alphaev6[78]-* \
+	| alpha64-* | alpha64ev[4-8]-* | alpha64ev56-* | alpha64ev6[78]-* \
+	| alphapca5[67]-* | alpha64pca5[67]-* | arc-* | arceb-* \
+	| arm-*  | armbe-* | armle-* | armeb-* | armv*-* \
+	| avr-* | avr32-* \
+	| be32-* | be64-* \
+	| bfin-* | bs2000-* \
+	| c[123]* | c30-* | [cjt]90-* | c4x-* \
+	| c8051-* | clipper-* | craynv-* | cydra-* \
+	| d10v-* | d30v-* | dlx-* \
+	| elxsi-* \
+	| f30[01]-* | f700-* | fido-* | fr30-* | frv-* | fx80-* \
+	| h8300-* | h8500-* \
+	| hppa-* | hppa1.[01]-* | hppa2.0-* | hppa2.0[nw]-* | hppa64-* \
+	| hexagon-* \
+	| i*86-* | i860-* | i960-* | ia64-* \
+	| ip2k-* | iq2000-* \
+	| le32-* | le64-* \
+	| lm32-* \
+	| m32c-* | m32r-* | m32rle-* \
+	| m68000-* | m680[012346]0-* | m68360-* | m683?2-* | m68k-* \
+	| m88110-* | m88k-* | maxq-* | mcore-* | metag-* \
+	| microblaze-* | microblazeel-* \
+	| mips-* | mipsbe-* | mipseb-* | mipsel-* | mipsle-* \
+	| mips16-* \
+	| mips64-* | mips64el-* \
+	| mips64octeon-* | mips64octeonel-* \
+	| mips64orion-* | mips64orionel-* \
+	| mips64r5900-* | mips64r5900el-* \
+	| mips64vr-* | mips64vrel-* \
+	| mips64vr4100-* | mips64vr4100el-* \
+	| mips64vr4300-* | mips64vr4300el-* \
+	| mips64vr5000-* | mips64vr5000el-* \
+	| mips64vr5900-* | mips64vr5900el-* \
+	| mipsisa32-* | mipsisa32el-* \
+	| mipsisa32r2-* | mipsisa32r2el-* \
+	| mipsisa64-* | mipsisa64el-* \
+	| mipsisa64r2-* | mipsisa64r2el-* \
+	| mipsisa64sb1-* | mipsisa64sb1el-* \
+	| mipsisa64sr71k-* | mipsisa64sr71kel-* \
+	| mipsr5900-* | mipsr5900el-* \
+	| mipstx39-* | mipstx39el-* \
+	| mmix-* \
+	| mt-* \
+	| msp430-* \
+	| nds32-* | nds32le-* | nds32be-* \
+	| nios-* | nios2-* | nios2eb-* | nios2el-* \
+	| none-* | np1-* | ns16k-* | ns32k-* \
+	| open8-* \
+	| orion-* \
+	| pdp10-* | pdp11-* | pj-* | pjl-* | pn-* | power-* \
+	| powerpc-* | powerpc64-* | powerpc64le-* | powerpcle-* \
+	| pyramid-* \
+	| rl78-* | romp-* | rs6000-* | rx-* \
+	| sh-* | sh[1234]-* | sh[24]a-* | sh[24]aeb-* | sh[23]e-* | sh[34]eb-* | sheb-* | shbe-* \
+	| shle-* | sh[1234]le-* | sh3ele-* | sh64-* | sh64le-* \
+	| sparc-* | sparc64-* | sparc64b-* | sparc64v-* | sparc86x-* | sparclet-* \
+	| sparclite-* \
+	| sparcv8-* | sparcv9-* | sparcv9b-* | sparcv9v-* | sv1-* | sx?-* \
+	| tahoe-* \
+	| tic30-* | tic4x-* | tic54x-* | tic55x-* | tic6x-* | tic80-* \
+	| tile*-* \
+	| tron-* \
+	| ubicom32-* \
+	| v850-* | v850e-* | v850e1-* | v850es-* | v850e2-* | v850e2v3-* \
+	| vax-* \
+	| we32k-* \
+	| x86-* | x86_64-* | xc16x-* | xps100-* \
+	| xstormy16-* | xtensa*-* \
+	| ymp-* \
+	| z8k-* | z80-*)
+		;;
+	# Recognize the basic CPU types without company name, with glob match.
+	xtensa*)
+		basic_machine=$basic_machine-unknown
+		;;
+	# Recognize the various machine names and aliases which stand
+	# for a CPU type and a company and sometimes even an OS.
+	386bsd)
+		basic_machine=i386-unknown
+		os=-bsd
+		;;
+	3b1 | 7300 | 7300-att | att-7300 | pc7300 | safari | unixpc)
+		basic_machine=m68000-att
+		;;
+	3b*)
+		basic_machine=we32k-att
+		;;
+	a29khif)
+		basic_machine=a29k-amd
+		os=-udi
+		;;
+	abacus)
+		basic_machine=abacus-unknown
+		;;
+	adobe68k)
+		basic_machine=m68010-adobe
+		os=-scout
+		;;
+	alliant | fx80)
+		basic_machine=fx80-alliant
+		;;
+	altos | altos3068)
+		basic_machine=m68k-altos
+		;;
+	am29k)
+		basic_machine=a29k-none
+		os=-bsd
+		;;
+	amd64)
+		basic_machine=x86_64-pc
+		;;
+	amd64-*)
+		basic_machine=x86_64-`echo $basic_machine | sed 's/^[^-]*-//'`
+		;;
+	amdahl)
+		basic_machine=580-amdahl
+		os=-sysv
+		;;
+	amiga | amiga-*)
+		basic_machine=m68k-unknown
+		;;
+	amigaos | amigados)
+		basic_machine=m68k-unknown
+		os=-amigaos
+		;;
+	amigaunix | amix)
+		basic_machine=m68k-unknown
+		os=-sysv4
+		;;
+	apollo68)
+		basic_machine=m68k-apollo
+		os=-sysv
+		;;
+	apollo68bsd)
+		basic_machine=m68k-apollo
+		os=-bsd
+		;;
+	aros)
+		basic_machine=i386-pc
+		os=-aros
+		;;
+	aux)
+		basic_machine=m68k-apple
+		os=-aux
+		;;
+	balance)
+		basic_machine=ns32k-sequent
+		os=-dynix
+		;;
+	blackfin)
+		basic_machine=bfin-unknown
+		os=-linux
+		;;
+	blackfin-*)
+		basic_machine=bfin-`echo $basic_machine | sed 's/^[^-]*-//'`
+		os=-linux
+		;;
+	bluegene*)
+		basic_machine=powerpc-ibm
+		os=-cnk
+		;;
+	c54x-*)
+		basic_machine=tic54x-`echo $basic_machine | sed 's/^[^-]*-//'`
+		;;
+	c55x-*)
+		basic_machine=tic55x-`echo $basic_machine | sed 's/^[^-]*-//'`
+		;;
+	c6x-*)
+		basic_machine=tic6x-`echo $basic_machine | sed 's/^[^-]*-//'`
+		;;
+	c90)
+		basic_machine=c90-cray
+		os=-unicos
+		;;
+	cegcc)
+		basic_machine=arm-unknown
+		os=-cegcc
+		;;
+	convex-c1)
+		basic_machine=c1-convex
+		os=-bsd
+		;;
+	convex-c2)
+		basic_machine=c2-convex
+		os=-bsd
+		;;
+	convex-c32)
+		basic_machine=c32-convex
+		os=-bsd
+		;;
+	convex-c34)
+		basic_machine=c34-convex
+		os=-bsd
+		;;
+	convex-c38)
+		basic_machine=c38-convex
+		os=-bsd
+		;;
+	cray | j90)
+		basic_machine=j90-cray
+		os=-unicos
+		;;
+	craynv)
+		basic_machine=craynv-cray
+		os=-unicosmp
+		;;
+	cr16 | cr16-*)
+		basic_machine=cr16-unknown
+		os=-elf
+		;;
+	crds | unos)
+		basic_machine=m68k-crds
+		;;
+	crisv32 | crisv32-* | etraxfs*)
+		basic_machine=crisv32-axis
+		;;
+	cris | cris-* | etrax*)
+		basic_machine=cris-axis
+		;;
+	crx)
+		basic_machine=crx-unknown
+		os=-elf
+		;;
+	da30 | da30-*)
+		basic_machine=m68k-da30
+		;;
+	decstation | decstation-3100 | pmax | pmax-* | pmin | dec3100 | decstatn)
+		basic_machine=mips-dec
+		;;
+	decsystem10* | dec10*)
+		basic_machine=pdp10-dec
+		os=-tops10
+		;;
+	decsystem20* | dec20*)
+		basic_machine=pdp10-dec
+		os=-tops20
+		;;
+	delta | 3300 | motorola-3300 | motorola-delta \
+	      | 3300-motorola | delta-motorola)
+		basic_machine=m68k-motorola
+		;;
+	delta88)
+		basic_machine=m88k-motorola
+		os=-sysv3
+		;;
+	dicos)
+		basic_machine=i686-pc
+		os=-dicos
+		;;
+	djgpp)
+		basic_machine=i586-pc
+		os=-msdosdjgpp
+		;;
+	dpx20 | dpx20-*)
+		basic_machine=rs6000-bull
+		os=-bosx
+		;;
+	dpx2* | dpx2*-bull)
+		basic_machine=m68k-bull
+		os=-sysv3
+		;;
+	ebmon29k)
+		basic_machine=a29k-amd
+		os=-ebmon
+		;;
+	elxsi)
+		basic_machine=elxsi-elxsi
+		os=-bsd
+		;;
+	encore | umax | mmax)
+		basic_machine=ns32k-encore
+		;;
+	es1800 | OSE68k | ose68k | ose | OSE)
+		basic_machine=m68k-ericsson
+		os=-ose
+		;;
+	fx2800)
+		basic_machine=i860-alliant
+		;;
+	genix)
+		basic_machine=ns32k-ns
+		;;
+	gmicro)
+		basic_machine=tron-gmicro
+		os=-sysv
+		;;
+	go32)
+		basic_machine=i386-pc
+		os=-go32
+		;;
+	h3050r* | hiux*)
+		basic_machine=hppa1.1-hitachi
+		os=-hiuxwe2
+		;;
+	h8300hms)
+		basic_machine=h8300-hitachi
+		os=-hms
+		;;
+	h8300xray)
+		basic_machine=h8300-hitachi
+		os=-xray
+		;;
+	h8500hms)
+		basic_machine=h8500-hitachi
+		os=-hms
+		;;
+	harris)
+		basic_machine=m88k-harris
+		os=-sysv3
+		;;
+	hp300-*)
+		basic_machine=m68k-hp
+		;;
+	hp300bsd)
+		basic_machine=m68k-hp
+		os=-bsd
+		;;
+	hp300hpux)
+		basic_machine=m68k-hp
+		os=-hpux
+		;;
+	hp3k9[0-9][0-9] | hp9[0-9][0-9])
+		basic_machine=hppa1.0-hp
+		;;
+	hp9k2[0-9][0-9] | hp9k31[0-9])
+		basic_machine=m68000-hp
+		;;
+	hp9k3[2-9][0-9])
+		basic_machine=m68k-hp
+		;;
+	hp9k6[0-9][0-9] | hp6[0-9][0-9])
+		basic_machine=hppa1.0-hp
+		;;
+	hp9k7[0-79][0-9] | hp7[0-79][0-9])
+		basic_machine=hppa1.1-hp
+		;;
+	hp9k78[0-9] | hp78[0-9])
+		# FIXME: really hppa2.0-hp
+		basic_machine=hppa1.1-hp
+		;;
+	hp9k8[67]1 | hp8[67]1 | hp9k80[24] | hp80[24] | hp9k8[78]9 | hp8[78]9 | hp9k893 | hp893)
+		# FIXME: really hppa2.0-hp
+		basic_machine=hppa1.1-hp
+		;;
+	hp9k8[0-9][13679] | hp8[0-9][13679])
+		basic_machine=hppa1.1-hp
+		;;
+	hp9k8[0-9][0-9] | hp8[0-9][0-9])
+		basic_machine=hppa1.0-hp
+		;;
+	hppa-next)
+		os=-nextstep3
+		;;
+	hppaosf)
+		basic_machine=hppa1.1-hp
+		os=-osf
+		;;
+	hppro)
+		basic_machine=hppa1.1-hp
+		os=-proelf
+		;;
+	i370-ibm* | ibm*)
+		basic_machine=i370-ibm
+		;;
+	i*86v32)
+		basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'`
+		os=-sysv32
+		;;
+	i*86v4*)
+		basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'`
+		os=-sysv4
+		;;
+	i*86v)
+		basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'`
+		os=-sysv
+		;;
+	i*86sol2)
+		basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'`
+		os=-solaris2
+		;;
+	i386mach)
+		basic_machine=i386-mach
+		os=-mach
+		;;
+	i386-vsta | vsta)
+		basic_machine=i386-unknown
+		os=-vsta
+		;;
+	iris | iris4d)
+		basic_machine=mips-sgi
+		case $os in
+		    -irix*)
+			;;
+		    *)
+			os=-irix4
+			;;
+		esac
+		;;
+	isi68 | isi)
+		basic_machine=m68k-isi
+		os=-sysv
+		;;
+	m68knommu)
+		basic_machine=m68k-unknown
+		os=-linux
+		;;
+	m68knommu-*)
+		basic_machine=m68k-`echo $basic_machine | sed 's/^[^-]*-//'`
+		os=-linux
+		;;
+	m88k-omron*)
+		basic_machine=m88k-omron
+		;;
+	magnum | m3230)
+		basic_machine=mips-mips
+		os=-sysv
+		;;
+	merlin)
+		basic_machine=ns32k-utek
+		os=-sysv
+		;;
+	microblaze*)
+		basic_machine=microblaze-xilinx
+		;;
+	mingw64)
+		basic_machine=x86_64-pc
+		os=-mingw64
+		;;
+	mingw32)
+		basic_machine=i686-pc
+		os=-mingw32
+		;;
+	mingw32ce)
+		basic_machine=arm-unknown
+		os=-mingw32ce
+		;;
+	miniframe)
+		basic_machine=m68000-convergent
+		;;
+	*mint | -mint[0-9]* | *MiNT | *MiNT[0-9]*)
+		basic_machine=m68k-atari
+		os=-mint
+		;;
+	mips3*-*)
+		basic_machine=`echo $basic_machine | sed -e 's/mips3/mips64/'`
+		;;
+	mips3*)
+		basic_machine=`echo $basic_machine | sed -e 's/mips3/mips64/'`-unknown
+		;;
+	monitor)
+		basic_machine=m68k-rom68k
+		os=-coff
+		;;
+	morphos)
+		basic_machine=powerpc-unknown
+		os=-morphos
+		;;
+	msdos)
+		basic_machine=i386-pc
+		os=-msdos
+		;;
+	ms1-*)
+		basic_machine=`echo $basic_machine | sed -e 's/ms1-/mt-/'`
+		;;
+	msys)
+		basic_machine=i686-pc
+		os=-msys
+		;;
+	mvs)
+		basic_machine=i370-ibm
+		os=-mvs
+		;;
+	nacl)
+		basic_machine=le32-unknown
+		os=-nacl
+		;;
+	ncr3000)
+		basic_machine=i486-ncr
+		os=-sysv4
+		;;
+	netbsd386)
+		basic_machine=i386-unknown
+		os=-netbsd
+		;;
+	netwinder)
+		basic_machine=armv4l-rebel
+		os=-linux
+		;;
+	news | news700 | news800 | news900)
+		basic_machine=m68k-sony
+		os=-newsos
+		;;
+	news1000)
+		basic_machine=m68030-sony
+		os=-newsos
+		;;
+	news-3600 | risc-news)
+		basic_machine=mips-sony
+		os=-newsos
+		;;
+	necv70)
+		basic_machine=v70-nec
+		os=-sysv
+		;;
+	next | m*-next )
+		basic_machine=m68k-next
+		case $os in
+		    -nextstep* )
+			;;
+		    -ns2*)
+		      os=-nextstep2
+			;;
+		    *)
+		      os=-nextstep3
+			;;
+		esac
+		;;
+	nh3000)
+		basic_machine=m68k-harris
+		os=-cxux
+		;;
+	nh[45]000)
+		basic_machine=m88k-harris
+		os=-cxux
+		;;
+	nindy960)
+		basic_machine=i960-intel
+		os=-nindy
+		;;
+	mon960)
+		basic_machine=i960-intel
+		os=-mon960
+		;;
+	nonstopux)
+		basic_machine=mips-compaq
+		os=-nonstopux
+		;;
+	np1)
+		basic_machine=np1-gould
+		;;
+	neo-tandem)
+		basic_machine=neo-tandem
+		;;
+	nse-tandem)
+		basic_machine=nse-tandem
+		;;
+	nsr-tandem)
+		basic_machine=nsr-tandem
+		;;
+	op50n-* | op60c-*)
+		basic_machine=hppa1.1-oki
+		os=-proelf
+		;;
+	openrisc | openrisc-*)
+		basic_machine=or32-unknown
+		;;
+	os400)
+		basic_machine=powerpc-ibm
+		os=-os400
+		;;
+	OSE68000 | ose68000)
+		basic_machine=m68000-ericsson
+		os=-ose
+		;;
+	os68k)
+		basic_machine=m68k-none
+		os=-os68k
+		;;
+	pa-hitachi)
+		basic_machine=hppa1.1-hitachi
+		os=-hiuxwe2
+		;;
+	paragon)
+		basic_machine=i860-intel
+		os=-osf
+		;;
+	parisc)
+		basic_machine=hppa-unknown
+		os=-linux
+		;;
+	parisc-*)
+		basic_machine=hppa-`echo $basic_machine | sed 's/^[^-]*-//'`
+		os=-linux
+		;;
+	pbd)
+		basic_machine=sparc-tti
+		;;
+	pbb)
+		basic_machine=m68k-tti
+		;;
+	pc532 | pc532-*)
+		basic_machine=ns32k-pc532
+		;;
+	pc98)
+		basic_machine=i386-pc
+		;;
+	pc98-*)
+		basic_machine=i386-`echo $basic_machine | sed 's/^[^-]*-//'`
+		;;
+	pentium | p5 | k5 | k6 | nexgen | viac3)
+		basic_machine=i586-pc
+		;;
+	pentiumpro | p6 | 6x86 | athlon | athlon_*)
+		basic_machine=i686-pc
+		;;
+	pentiumii | pentium2 | pentiumiii | pentium3)
+		basic_machine=i686-pc
+		;;
+	pentium4)
+		basic_machine=i786-pc
+		;;
+	pentium-* | p5-* | k5-* | k6-* | nexgen-* | viac3-*)
+		basic_machine=i586-`echo $basic_machine | sed 's/^[^-]*-//'`
+		;;
+	pentiumpro-* | p6-* | 6x86-* | athlon-*)
+		basic_machine=i686-`echo $basic_machine | sed 's/^[^-]*-//'`
+		;;
+	pentiumii-* | pentium2-* | pentiumiii-* | pentium3-*)
+		basic_machine=i686-`echo $basic_machine | sed 's/^[^-]*-//'`
+		;;
+	pentium4-*)
+		basic_machine=i786-`echo $basic_machine | sed 's/^[^-]*-//'`
+		;;
+	pn)
+		basic_machine=pn-gould
+		;;
+	power)	basic_machine=power-ibm
+		;;
+	ppc | ppcbe)	basic_machine=powerpc-unknown
+		;;
+	ppc-* | ppcbe-*)
+		basic_machine=powerpc-`echo $basic_machine | sed 's/^[^-]*-//'`
+		;;
+	ppcle | powerpclittle | ppc-le | powerpc-little)
+		basic_machine=powerpcle-unknown
+		;;
+	ppcle-* | powerpclittle-*)
+		basic_machine=powerpcle-`echo $basic_machine | sed 's/^[^-]*-//'`
+		;;
+	ppc64)	basic_machine=powerpc64-unknown
+		;;
+	ppc64-*) basic_machine=powerpc64-`echo $basic_machine | sed 's/^[^-]*-//'`
+		;;
+	ppc64le | powerpc64little | ppc64-le | powerpc64-little)
+		basic_machine=powerpc64le-unknown
+		;;
+	ppc64le-* | powerpc64little-*)
+		basic_machine=powerpc64le-`echo $basic_machine | sed 's/^[^-]*-//'`
+		;;
+	ps2)
+		basic_machine=i386-ibm
+		;;
+	pw32)
+		basic_machine=i586-unknown
+		os=-pw32
+		;;
+	rdos | rdos64)
+		basic_machine=x86_64-pc
+		os=-rdos
+		;;
+	rdos32)
+		basic_machine=i386-pc
+		os=-rdos
+		;;
+	rom68k)
+		basic_machine=m68k-rom68k
+		os=-coff
+		;;
+	rm[46]00)
+		basic_machine=mips-siemens
+		;;
+	rtpc | rtpc-*)
+		basic_machine=romp-ibm
+		;;
+	s390 | s390-*)
+		basic_machine=s390-ibm
+		;;
+	s390x | s390x-*)
+		basic_machine=s390x-ibm
+		;;
+	sa29200)
+		basic_machine=a29k-amd
+		os=-udi
+		;;
+	sb1)
+		basic_machine=mipsisa64sb1-unknown
+		;;
+	sb1el)
+		basic_machine=mipsisa64sb1el-unknown
+		;;
+	sde)
+		basic_machine=mipsisa32-sde
+		os=-elf
+		;;
+	sei)
+		basic_machine=mips-sei
+		os=-seiux
+		;;
+	sequent)
+		basic_machine=i386-sequent
+		;;
+	sh)
+		basic_machine=sh-hitachi
+		os=-hms
+		;;
+	sh5el)
+		basic_machine=sh5le-unknown
+		;;
+	sh64)
+		basic_machine=sh64-unknown
+		;;
+	sparclite-wrs | simso-wrs)
+		basic_machine=sparclite-wrs
+		os=-vxworks
+		;;
+	sps7)
+		basic_machine=m68k-bull
+		os=-sysv2
+		;;
+	spur)
+		basic_machine=spur-unknown
+		;;
+	st2000)
+		basic_machine=m68k-tandem
+		;;
+	stratus)
+		basic_machine=i860-stratus
+		os=-sysv4
+		;;
+	strongarm-* | thumb-*)
+		basic_machine=arm-`echo $basic_machine | sed 's/^[^-]*-//'`
+		;;
+	sun2)
+		basic_machine=m68000-sun
+		;;
+	sun2os3)
+		basic_machine=m68000-sun
+		os=-sunos3
+		;;
+	sun2os4)
+		basic_machine=m68000-sun
+		os=-sunos4
+		;;
+	sun3os3)
+		basic_machine=m68k-sun
+		os=-sunos3
+		;;
+	sun3os4)
+		basic_machine=m68k-sun
+		os=-sunos4
+		;;
+	sun4os3)
+		basic_machine=sparc-sun
+		os=-sunos3
+		;;
+	sun4os4)
+		basic_machine=sparc-sun
+		os=-sunos4
+		;;
+	sun4sol2)
+		basic_machine=sparc-sun
+		os=-solaris2
+		;;
+	sun3 | sun3-*)
+		basic_machine=m68k-sun
+		;;
+	sun4)
+		basic_machine=sparc-sun
+		;;
+	sun386 | sun386i | roadrunner)
+		basic_machine=i386-sun
+		;;
+	sv1)
+		basic_machine=sv1-cray
+		os=-unicos
+		;;
+	symmetry)
+		basic_machine=i386-sequent
+		os=-dynix
+		;;
+	t3e)
+		basic_machine=alphaev5-cray
+		os=-unicos
+		;;
+	t90)
+		basic_machine=t90-cray
+		os=-unicos
+		;;
+	tile*)
+		basic_machine=$basic_machine-unknown
+		os=-linux-gnu
+		;;
+	tx39)
+		basic_machine=mipstx39-unknown
+		;;
+	tx39el)
+		basic_machine=mipstx39el-unknown
+		;;
+	toad1)
+		basic_machine=pdp10-xkl
+		os=-tops20
+		;;
+	tower | tower-32)
+		basic_machine=m68k-ncr
+		;;
+	tpf)
+		basic_machine=s390x-ibm
+		os=-tpf
+		;;
+	udi29k)
+		basic_machine=a29k-amd
+		os=-udi
+		;;
+	ultra3)
+		basic_machine=a29k-nyu
+		os=-sym1
+		;;
+	v810 | necv810)
+		basic_machine=v810-nec
+		os=-none
+		;;
+	vaxv)
+		basic_machine=vax-dec
+		os=-sysv
+		;;
+	vms)
+		basic_machine=vax-dec
+		os=-vms
+		;;
+	vpp*|vx|vx-*)
+		basic_machine=f301-fujitsu
+		;;
+	vxworks960)
+		basic_machine=i960-wrs
+		os=-vxworks
+		;;
+	vxworks68)
+		basic_machine=m68k-wrs
+		os=-vxworks
+		;;
+	vxworks29k)
+		basic_machine=a29k-wrs
+		os=-vxworks
+		;;
+	w65*)
+		basic_machine=w65-wdc
+		os=-none
+		;;
+	w89k-*)
+		basic_machine=hppa1.1-winbond
+		os=-proelf
+		;;
+	xbox)
+		basic_machine=i686-pc
+		os=-mingw32
+		;;
+	xps | xps100)
+		basic_machine=xps100-honeywell
+		;;
+	xscale-* | xscalee[bl]-*)
+		basic_machine=`echo $basic_machine | sed 's/^xscale/arm/'`
+		;;
+	ymp)
+		basic_machine=ymp-cray
+		os=-unicos
+		;;
+	z8k-*-coff)
+		basic_machine=z8k-unknown
+		os=-sim
+		;;
+	z80-*-coff)
+		basic_machine=z80-unknown
+		os=-sim
+		;;
+	none)
+		basic_machine=none-none
+		os=-none
+		;;
+
+# Here we handle the default manufacturer of certain CPU types.  It is in
+# some cases the only manufacturer, in others, it is the most popular.
+	w89k)
+		basic_machine=hppa1.1-winbond
+		;;
+	op50n)
+		basic_machine=hppa1.1-oki
+		;;
+	op60c)
+		basic_machine=hppa1.1-oki
+		;;
+	romp)
+		basic_machine=romp-ibm
+		;;
+	mmix)
+		basic_machine=mmix-knuth
+		;;
+	rs6000)
+		basic_machine=rs6000-ibm
+		;;
+	vax)
+		basic_machine=vax-dec
+		;;
+	pdp10)
+		# there are many clones, so DEC is not a safe bet
+		basic_machine=pdp10-unknown
+		;;
+	pdp11)
+		basic_machine=pdp11-dec
+		;;
+	we32k)
+		basic_machine=we32k-att
+		;;
+	sh[1234] | sh[24]a | sh[24]aeb | sh[34]eb | sh[1234]le | sh[23]ele)
+		basic_machine=sh-unknown
+		;;
+	sparc | sparcv8 | sparcv9 | sparcv9b | sparcv9v)
+		basic_machine=sparc-sun
+		;;
+	cydra)
+		basic_machine=cydra-cydrome
+		;;
+	orion)
+		basic_machine=orion-highlevel
+		;;
+	orion105)
+		basic_machine=clipper-highlevel
+		;;
+	mac | mpw | mac-mpw)
+		basic_machine=m68k-apple
+		;;
+	pmac | pmac-mpw)
+		basic_machine=powerpc-apple
+		;;
+	*-unknown)
+		# Make sure to match an already-canonicalized machine name.
+		;;
+	*)
+		echo Invalid configuration \`$1\': machine \`$basic_machine\' not recognized 1>&2
+		exit 1
+		;;
+esac
+
+# Here we canonicalize certain aliases for manufacturers.
+case $basic_machine in
+	*-digital*)
+		basic_machine=`echo $basic_machine | sed 's/digital.*/dec/'`
+		;;
+	*-commodore*)
+		basic_machine=`echo $basic_machine | sed 's/commodore.*/cbm/'`
+		;;
+	*)
+		;;
+esac
+
+# Decode manufacturer-specific aliases for certain operating systems.
+
+if [ x"$os" != x"" ]
+then
+case $os in
+	# First match some system type aliases
+	# that might get confused with valid system types.
+	# -solaris* is a basic system type, with this one exception.
+	-auroraux)
+		os=-auroraux
+		;;
+	-solaris1 | -solaris1.*)
+		os=`echo $os | sed -e 's|solaris1|sunos4|'`
+		;;
+	-solaris)
+		os=-solaris2
+		;;
+	-svr4*)
+		os=-sysv4
+		;;
+	-unixware*)
+		os=-sysv4.2uw
+		;;
+	-gnu/linux*)
+		os=`echo $os | sed -e 's|gnu/linux|linux-gnu|'`
+		;;
+	# First accept the basic system types.
+	# The portable systems comes first.
+	# Each alternative MUST END IN A *, to match a version number.
+	# -sysv* is not here because it comes later, after sysvr4.
+	-gnu* | -bsd* | -mach* | -minix* | -genix* | -ultrix* | -irix* \
+	      | -*vms* | -sco* | -esix* | -isc* | -aix* | -cnk* | -sunos | -sunos[34]*\
+	      | -hpux* | -unos* | -osf* | -luna* | -dgux* | -auroraux* | -solaris* \
+	      | -sym* | -kopensolaris* | -plan9* \
+	      | -amigaos* | -amigados* | -msdos* | -newsos* | -unicos* | -aof* \
+	      | -aos* | -aros* \
+	      | -nindy* | -vxsim* | -vxworks* | -ebmon* | -hms* | -mvs* \
+	      | -clix* | -riscos* | -uniplus* | -iris* | -rtu* | -xenix* \
+	      | -hiux* | -386bsd* | -knetbsd* | -mirbsd* | -netbsd* \
+	      | -bitrig* | -openbsd* | -solidbsd* \
+	      | -ekkobsd* | -kfreebsd* | -freebsd* | -riscix* | -lynxos* \
+	      | -bosx* | -nextstep* | -cxux* | -aout* | -elf* | -oabi* \
+	      | -ptx* | -coff* | -ecoff* | -winnt* | -domain* | -vsta* \
+	      | -udi* | -eabi* | -lites* | -ieee* | -go32* | -aux* \
+	      | -chorusos* | -chorusrdb* | -cegcc* \
+	      | -cygwin* | -msys* | -pe* | -psos* | -moss* | -proelf* | -rtems* \
+	      | -mingw32* | -mingw64* | -linux-gnu* | -linux-android* \
+	      | -linux-newlib* | -linux-musl* | -linux-uclibc* \
+	      | -uxpv* | -beos* | -mpeix* | -udk* \
+	      | -interix* | -uwin* | -mks* | -rhapsody* | -darwin* | -opened* \
+	      | -openstep* | -oskit* | -conix* | -pw32* | -nonstopux* \
+	      | -storm-chaos* | -tops10* | -tenex* | -tops20* | -its* \
+	      | -os2* | -vos* | -palmos* | -uclinux* | -nucleus* \
+	      | -morphos* | -superux* | -rtmk* | -rtmk-nova* | -windiss* \
+	      | -powermax* | -dnix* | -nx6 | -nx7 | -sei* | -dragonfly* \
+	      | -skyos* | -haiku* | -rdos* | -toppers* | -drops* | -es*)
+	# Remember, each alternative MUST END IN *, to match a version number.
+		;;
+	-qnx*)
+		case $basic_machine in
+		    x86-* | i*86-*)
+			;;
+		    *)
+			os=-nto$os
+			;;
+		esac
+		;;
+	-nto-qnx*)
+		;;
+	-nto*)
+		os=`echo $os | sed -e 's|nto|nto-qnx|'`
+		;;
+	-sim | -es1800* | -hms* | -xray | -os68k* | -none* | -v88r* \
+	      | -windows* | -osx | -abug | -netware* | -os9* | -beos* | -haiku* \
+	      | -macos* | -mpw* | -magic* | -mmixware* | -mon960* | -lnews*)
+		;;
+	-mac*)
+		os=`echo $os | sed -e 's|mac|macos|'`
+		;;
+	-linux-dietlibc)
+		os=-linux-dietlibc
+		;;
+	-linux*)
+		os=`echo $os | sed -e 's|linux|linux-gnu|'`
+		;;
+	-sunos5*)
+		os=`echo $os | sed -e 's|sunos5|solaris2|'`
+		;;
+	-sunos6*)
+		os=`echo $os | sed -e 's|sunos6|solaris3|'`
+		;;
+	-opened*)
+		os=-openedition
+		;;
+	-os400*)
+		os=-os400
+		;;
+	-wince*)
+		os=-wince
+		;;
+	-osfrose*)
+		os=-osfrose
+		;;
+	-osf*)
+		os=-osf
+		;;
+	-utek*)
+		os=-bsd
+		;;
+	-dynix*)
+		os=-bsd
+		;;
+	-acis*)
+		os=-aos
+		;;
+	-atheos*)
+		os=-atheos
+		;;
+	-syllable*)
+		os=-syllable
+		;;
+	-386bsd)
+		os=-bsd
+		;;
+	-ctix* | -uts*)
+		os=-sysv
+		;;
+	-nova*)
+		os=-rtmk-nova
+		;;
+	-ns2 )
+		os=-nextstep2
+		;;
+	-nsk*)
+		os=-nsk
+		;;
+	# Preserve the version number of sinix5.
+	-sinix5.*)
+		os=`echo $os | sed -e 's|sinix|sysv|'`
+		;;
+	-sinix*)
+		os=-sysv4
+		;;
+	-tpf*)
+		os=-tpf
+		;;
+	-triton*)
+		os=-sysv3
+		;;
+	-oss*)
+		os=-sysv3
+		;;
+	-svr4)
+		os=-sysv4
+		;;
+	-svr3)
+		os=-sysv3
+		;;
+	-sysvr4)
+		os=-sysv4
+		;;
+	# This must come after -sysvr4.
+	-sysv*)
+		;;
+	-ose*)
+		os=-ose
+		;;
+	-es1800*)
+		os=-ose
+		;;
+	-xenix)
+		os=-xenix
+		;;
+	-*mint | -mint[0-9]* | -*MiNT | -MiNT[0-9]*)
+		os=-mint
+		;;
+	-aros*)
+		os=-aros
+		;;
+	-zvmoe)
+		os=-zvmoe
+		;;
+	-dicos*)
+		os=-dicos
+		;;
+	-nacl*)
+		;;
+	-none)
+		;;
+	*)
+		# Get rid of the `-' at the beginning of $os.
+		os=`echo $os | sed 's/[^-]*-//'`
+		echo Invalid configuration \`$1\': system \`$os\' not recognized 1>&2
+		exit 1
+		;;
+esac
+else
+
+# Here we handle the default operating systems that come with various machines.
+# The value should be what the vendor currently ships out the door with their
+# machine or put another way, the most popular os provided with the machine.
+
+# Note that if you're going to try to match "-MANUFACTURER" here (say,
+# "-sun"), then you have to tell the case statement up towards the top
+# that MANUFACTURER isn't an operating system.  Otherwise, code above
+# will signal an error saying that MANUFACTURER isn't an operating
+# system, and we'll never get to this point.
+
+case $basic_machine in
+	score-*)
+		os=-elf
+		;;
+	spu-*)
+		os=-elf
+		;;
+	*-acorn)
+		os=-riscix1.2
+		;;
+	arm*-rebel)
+		os=-linux
+		;;
+	arm*-semi)
+		os=-aout
+		;;
+	c4x-* | tic4x-*)
+		os=-coff
+		;;
+	c8051-*)
+		os=-elf
+		;;
+	hexagon-*)
+		os=-elf
+		;;
+	tic54x-*)
+		os=-coff
+		;;
+	tic55x-*)
+		os=-coff
+		;;
+	tic6x-*)
+		os=-coff
+		;;
+	# This must come before the *-dec entry.
+	pdp10-*)
+		os=-tops20
+		;;
+	pdp11-*)
+		os=-none
+		;;
+	*-dec | vax-*)
+		os=-ultrix4.2
+		;;
+	m68*-apollo)
+		os=-domain
+		;;
+	i386-sun)
+		os=-sunos4.0.2
+		;;
+	m68000-sun)
+		os=-sunos3
+		;;
+	m68*-cisco)
+		os=-aout
+		;;
+	mep-*)
+		os=-elf
+		;;
+	mips*-cisco)
+		os=-elf
+		;;
+	mips*-*)
+		os=-elf
+		;;
+	or1k-*)
+		os=-elf
+		;;
+	or32-*)
+		os=-coff
+		;;
+	*-tti)	# must be before sparc entry or we get the wrong os.
+		os=-sysv3
+		;;
+	sparc-* | *-sun)
+		os=-sunos4.1.1
+		;;
+	*-be)
+		os=-beos
+		;;
+	*-haiku)
+		os=-haiku
+		;;
+	*-ibm)
+		os=-aix
+		;;
+	*-knuth)
+		os=-mmixware
+		;;
+	*-wec)
+		os=-proelf
+		;;
+	*-winbond)
+		os=-proelf
+		;;
+	*-oki)
+		os=-proelf
+		;;
+	*-hp)
+		os=-hpux
+		;;
+	*-hitachi)
+		os=-hiux
+		;;
+	i860-* | *-att | *-ncr | *-altos | *-motorola | *-convergent)
+		os=-sysv
+		;;
+	*-cbm)
+		os=-amigaos
+		;;
+	*-dg)
+		os=-dgux
+		;;
+	*-dolphin)
+		os=-sysv3
+		;;
+	m68k-ccur)
+		os=-rtu
+		;;
+	m88k-omron*)
+		os=-luna
+		;;
+	*-next )
+		os=-nextstep
+		;;
+	*-sequent)
+		os=-ptx
+		;;
+	*-crds)
+		os=-unos
+		;;
+	*-ns)
+		os=-genix
+		;;
+	i370-*)
+		os=-mvs
+		;;
+	*-next)
+		os=-nextstep3
+		;;
+	*-gould)
+		os=-sysv
+		;;
+	*-highlevel)
+		os=-bsd
+		;;
+	*-encore)
+		os=-bsd
+		;;
+	*-sgi)
+		os=-irix
+		;;
+	*-siemens)
+		os=-sysv4
+		;;
+	*-masscomp)
+		os=-rtu
+		;;
+	f30[01]-fujitsu | f700-fujitsu)
+		os=-uxpv
+		;;
+	*-rom68k)
+		os=-coff
+		;;
+	*-*bug)
+		os=-coff
+		;;
+	*-apple)
+		os=-macos
+		;;
+	*-atari*)
+		os=-mint
+		;;
+	*)
+		os=-none
+		;;
+esac
+fi
+
+# Here we handle the case where we know the os, and the CPU type, but not the
+# manufacturer.  We pick the logical manufacturer.
+vendor=unknown
+case $basic_machine in
+	*-unknown)
+		case $os in
+			-riscix*)
+				vendor=acorn
+				;;
+			-sunos*)
+				vendor=sun
+				;;
+			-cnk*|-aix*)
+				vendor=ibm
+				;;
+			-beos*)
+				vendor=be
+				;;
+			-hpux*)
+				vendor=hp
+				;;
+			-mpeix*)
+				vendor=hp
+				;;
+			-hiux*)
+				vendor=hitachi
+				;;
+			-unos*)
+				vendor=crds
+				;;
+			-dgux*)
+				vendor=dg
+				;;
+			-luna*)
+				vendor=omron
+				;;
+			-genix*)
+				vendor=ns
+				;;
+			-mvs* | -opened*)
+				vendor=ibm
+				;;
+			-os400*)
+				vendor=ibm
+				;;
+			-ptx*)
+				vendor=sequent
+				;;
+			-tpf*)
+				vendor=ibm
+				;;
+			-vxsim* | -vxworks* | -windiss*)
+				vendor=wrs
+				;;
+			-aux*)
+				vendor=apple
+				;;
+			-hms*)
+				vendor=hitachi
+				;;
+			-mpw* | -macos*)
+				vendor=apple
+				;;
+			-*mint | -mint[0-9]* | -*MiNT | -MiNT[0-9]*)
+				vendor=atari
+				;;
+			-vos*)
+				vendor=stratus
+				;;
+		esac
+		basic_machine=`echo $basic_machine | sed "s/unknown/$vendor/"`
+		;;
+esac
+
+echo $basic_machine$os
+exit
+
+# Local variables:
+# eval: (add-hook 'write-file-hooks 'time-stamp)
+# time-stamp-start: "timestamp='"
+# time-stamp-format: "%:y-%02m-%02d"
+# time-stamp-end: "'"
+# End:
diff --git a/libraries/integer-gmp/configure.ac b/libraries/integer-gmp/configure.ac
new file mode 100644
index 000000000000..d5eb3b23d30d
--- /dev/null
+++ b/libraries/integer-gmp/configure.ac
@@ -0,0 +1,86 @@
+AC_INIT([Haskell integer (GMP)], [0.1], [libraries@haskell.org], [integer])
+
+# Safety check: Ensure that we are in the correct source directory.
+AC_CONFIG_SRCDIR([cbits/gmp-wrappers.cmm])
+
+AC_CANONICAL_TARGET
+
+AC_ARG_WITH([cc],
+            [C compiler],
+            [CC=$withval])
+AC_PROG_CC()
+
+
+dnl--------------------------------------------------------------------
+dnl * Deal with arguments telling us gmp is somewhere odd
+dnl--------------------------------------------------------------------
+
+AC_ARG_WITH([gmp-includes],
+  [AC_HELP_STRING([--with-gmp-includes],
+    [directory containing gmp.h])],
+    [GMP_INCLUDE_DIRS=$withval; CPPFLAGS="-I$withval"],
+    [GMP_INCLUDE_DIRS=])
+
+AC_ARG_WITH([gmp-libraries],
+  [AC_HELP_STRING([--with-gmp-libraries],
+    [directory containing gmp library])],
+    [GMP_LIB_DIRS=$withval; LDFLAGS="-L$withval"],
+    [GMP_LIB_DIRS=])
+
+AC_ARG_WITH([gmp-framework-preferred],
+  [AC_HELP_STRING([--with-gmp-framework-preferred],
+    [on OSX, prefer the GMP framework to the gmp lib])],
+    [GMP_PREFER_FRAMEWORK=YES],
+    [GMP_PREFER_FRAMEWORK=NO])
+
+AC_ARG_WITH([intree-gmp],
+  [AC_HELP_STRING([--with-intree-gmp],
+    [force using the in-tree GMP])],
+    [GMP_FORCE_INTREE=YES],
+    [GMP_FORCE_INTREE=NO])
+
+dnl--------------------------------------------------------------------
+dnl * Detect gmp
+dnl--------------------------------------------------------------------
+
+HaveLibGmp=NO
+GMP_LIBS=
+HaveFrameworkGMP=NO
+GMP_FRAMEWORK=
+HaveSecurePowm=0
+
+if test "$GMP_FORCE_INTREE" != "YES"
+then
+    if test "$GMP_PREFER_FRAMEWORK" = "YES"
+    then
+        LOOK_FOR_GMP_FRAMEWORK
+        LOOK_FOR_GMP_LIB
+    else
+        LOOK_FOR_GMP_LIB
+        LOOK_FOR_GMP_FRAMEWORK
+    fi
+fi
+if test "$HaveFrameworkGMP" = "YES" || test "$HaveLibGmp" = "YES"
+then
+    AC_CHECK_HEADER([gmp.h], , [AC_MSG_ERROR([Cannot find gmp.h])])
+fi
+
+dnl--------------------------------------------------------------------
+dnl * Make sure we got some form of gmp
+dnl--------------------------------------------------------------------
+
+AC_SUBST(GMP_INCLUDE_DIRS)
+AC_SUBST(GMP_LIBS)
+AC_SUBST(GMP_LIB_DIRS)
+AC_SUBST(GMP_FRAMEWORK)
+AC_SUBST(HaveLibGmp)
+AC_SUBST(HaveFrameworkGMP)
+AC_SUBST(HaveSecurePowm)
+
+AC_CONFIG_FILES([integer-gmp.buildinfo gmp/config.mk include/HsIntegerGmp.h])
+
+dnl--------------------------------------------------------------------
+dnl * Generate the header cbits/GmpDerivedConstants.h
+dnl--------------------------------------------------------------------
+
+AC_OUTPUT
diff --git a/libraries/integer-gmp/gmp/config.mk.in b/libraries/integer-gmp/gmp/config.mk.in
new file mode 100644
index 000000000000..93a4f5369b71
--- /dev/null
+++ b/libraries/integer-gmp/gmp/config.mk.in
@@ -0,0 +1,11 @@
+ifeq "$(HaveLibGmp)" ""
+ HaveLibGmp = @HaveLibGmp@
+endif
+
+ifeq "$(HaveFrameworkGMP)" ""
+ HaveFrameworkGMP = @HaveFrameworkGMP@
+endif
+
+GMP_INCLUDE_DIRS = @GMP_INCLUDE_DIRS@
+GMP_LIB_DIRS = @GMP_LIB_DIRS@
+
diff --git a/libraries/integer-gmp/gmp/ghc.mk b/libraries/integer-gmp/gmp/ghc.mk
new file mode 100644
index 000000000000..139ae93515ef
--- /dev/null
+++ b/libraries/integer-gmp/gmp/ghc.mk
@@ -0,0 +1,197 @@
+# -----------------------------------------------------------------------------
+#
+# (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://ghc.haskell.org/trac/ghc/wiki/Building/Architecture
+#      http://ghc.haskell.org/trac/ghc/wiki/Building/Modifying
+#
+# -----------------------------------------------------------------------------
+
+# We use a tarball like gmp-4.2.4-nodoc.tar.bz2, which is
+# gmp-4.2.4.tar.bz2 repacked without the doc/ directory contents.
+# That's because the doc/ directory contents are under the GFDL,
+# which causes problems for Debian.
+
+GMP_TARBALL := $(wildcard libraries/integer-gmp/gmp/tarball/gmp*.tar.bz2)
+GMP_DIR := $(patsubst libraries/integer-gmp/gmp/tarball/%-nodoc-patched.tar.bz2,%,$(GMP_TARBALL))
+
+ifneq "$(NO_CLEAN_GMP)" "YES"
+$(eval $(call clean-target,gmp,,\
+  libraries/integer-gmp/gmp/config.mk \
+  libraries/integer-gmp/gmp/libgmp.a \
+  libraries/integer-gmp/gmp/gmp.h \
+  libraries/integer-gmp/gmp/gmpbuild \
+  libraries/integer-gmp/gmp/$(GMP_DIR)))
+
+clean : clean_gmp
+.PHONY: clean_gmp
+clean_gmp:
+	$(call removeTrees,libraries/integer-gmp/gmp/objs)
+	$(call removeTrees,libraries/integer-gmp/gmp/gmpbuild)
+endif
+
+ifeq "$(Windows_Host)" "YES"
+# Apparently building on Windows fails when there is a system gmp
+# available, so we never try to use the system gmp on Windows
+libraries/integer-gmp_CONFIGURE_OPTS += --configure-option=--with-intree-gmp
+endif
+
+ifeq "$(GMP_PREFER_FRAMEWORK)" "YES"
+libraries/integer-gmp_CONFIGURE_OPTS += --with-gmp-framework-preferred
+endif
+
+ifeq "$(phase)" "final"
+
+ifeq "$(findstring clean,$(MAKECMDGOALS))" ""
+include libraries/integer-gmp/gmp/config.mk
+endif
+
+libraries/integer-gmp_dist-install_EXTRA_CC_OPTS += -Ilibraries/integer-gmp/mkGmpDerivedConstants/dist
+libraries/integer-gmp_dist-install_EXTRA_HC_OPTS += -Ilibraries/integer-gmp/mkGmpDerivedConstants/dist
+
+gmp_CC_OPTS += $(addprefix -I,$(GMP_INCLUDE_DIRS))
+gmp_CC_OPTS += $(addprefix -L,$(GMP_LIB_DIRS))
+
+# Compile GMP only if we don't have it already
+#
+# We use GMP's own configuration stuff, because it's all rather hairy
+# and not worth re-implementing in our Makefile framework.
+
+ifeq "$(findstring dyn, $(GhcRTSWays))" "dyn"
+BUILD_SHARED=yes
+else
+BUILD_SHARED=no
+endif
+
+# In a bindist, we don't want to know whether /this/ machine has gmp,
+# but whether the machine the bindist was built on had gmp.
+ifeq "$(BINDIST)" "YES"
+ifeq "$(wildcard libraries/integer-gmp/gmp/libgmp.a)" ""
+HaveLibGmp = YES
+HaveFrameworkGMP = YES
+else
+HaveLibGmp = NO
+HaveFrameworkGMP = NO
+endif
+endif
+
+$(libraries/integer-gmp_dist-install_depfile_c_asm): $$(GmpDerivedConstants_HEADER)
+
+ifneq "$(HaveLibGmp)" "YES"
+ifneq "$(HaveFrameworkGMP)" "YES"
+$(libraries/integer-gmp_dist-install_depfile_c_asm): libraries/integer-gmp/gmp/gmp.h
+
+gmp_CC_OPTS += -Ilibraries/integer-gmp/gmp
+gmp_CC_OPTS += -Ilibraries/integer-gmp/mkGmpDerivedConstants/dist
+
+libraries/integer-gmp_dist-install_EXTRA_OBJS += libraries/integer-gmp/gmp/objs/*.o
+
+#INSTALL_LIBS += libraries/integer-gmp/gmp/libgmp.a
+#INSTALL_HEADERS += libraries/integer-gmp/gmp/gmp.h
+#
+#$(eval $(call all-target,gmp_dynamic,libraries/integer-gmp/gmp/libgmp.a))
+#
+#ifeq "$(BUILD_SHARED)" "yes"
+#$(eval $(call all-target,gmp_dynamic,libraries/integer-gmp/gmp/libgmp.dll.a libraries/integer-gmp/gmp/libgmp-3.dll))
+#endif
+
+endif
+endif
+
+libraries/integer-gmp_dist-install_EXTRA_CC_OPTS += $(gmp_CC_OPTS)
+
+CLANG = $(findstring clang, $(shell $(CC_STAGE1) --version))
+
+ifeq "$(CLANG)" "clang"
+CCX = $(CLANG)
+else
+CCX = $(CC_STAGE1)
+endif
+
+# 2007-09-26
+#     set -o igncr 
+# is not a valid command on non-Cygwin-systems.
+# Let it fail silently instead of aborting the build.
+#
+# 2007-07-05
+# We do
+#     set -o igncr; export SHELLOPTS
+# here as otherwise checking the size of limbs
+# makes the build fall over on Cygwin. See the thread
+# http://www.cygwin.com/ml/cygwin/2006-12/msg00011.html
+# for more details.
+
+# 2007-07-05
+# Passing
+#     as_ln_s='cp -p'
+# isn't sufficient to stop cygwin using symlinks the mingw gcc can't
+# follow, as it isn't used consistently. Instead we put an ln.bat in
+# path that always fails.
+
+libraries/integer-gmp/gmp/libgmp.a libraries/integer-gmp/gmp/gmp.h:
+	$(RM) -rf libraries/integer-gmp/gmp/$(GMP_DIR) libraries/integer-gmp/gmp/gmpbuild libraries/integer-gmp/gmp/objs
+	cat $(GMP_TARBALL) | $(BZIP2_CMD) -d | { cd libraries/integer-gmp/gmp && $(TAR_CMD) -xf - ; }
+	mv libraries/integer-gmp/gmp/$(GMP_DIR) libraries/integer-gmp/gmp/gmpbuild
+	chmod +x libraries/integer-gmp/gmp/ln
+
+	# Their cmd invocation only works on msys. On cygwin it starts
+	# a cmd interactive shell. The replacement works in both environments.
+	mv libraries/integer-gmp/gmp/gmpbuild/ltmain.sh libraries/integer-gmp/gmp/gmpbuild/ltmain.sh.orig
+	sed 's#cmd //c echo "\$$1"#cmd /c "echo $$1"#' < libraries/integer-gmp/gmp/gmpbuild/ltmain.sh.orig > libraries/integer-gmp/gmp/gmpbuild/ltmain.sh
+
+	cd libraries/integer-gmp/gmp; (set -o igncr 2>/dev/null) && set -o igncr; export SHELLOPTS; \
+	    PATH=`pwd`:$$PATH; \
+	    export PATH; \
+	    cd gmpbuild && \
+	    CC=$(CCX) NM=$(NM) AR=$(AR_STAGE1) ./configure \
+	          --enable-shared=no \
+	          --host=$(HOSTPLATFORM) --build=$(BUILDPLATFORM)
+	$(MAKE) -C libraries/integer-gmp/gmp/gmpbuild MAKEFLAGS=
+	$(CP) libraries/integer-gmp/gmp/gmpbuild/gmp.h libraries/integer-gmp/gmp/
+	$(CP) libraries/integer-gmp/gmp/gmpbuild/.libs/libgmp.a libraries/integer-gmp/gmp/
+	$(MKDIRHIER) libraries/integer-gmp/gmp/objs
+	cd libraries/integer-gmp/gmp/objs && $(AR_STAGE1) x ../libgmp.a
+	$(RANLIB_CMD) libraries/integer-gmp/gmp/libgmp.a
+
+# XXX TODO:
+#stamp.gmp.shared:
+#	$(RM) -rf $(GMP_DIR) gmpbuild-shared
+#	$(TAR_CMD) -zxf $(GMP_TARBALL)
+#	mv $(GMP_DIR) gmpbuild-shared
+#	chmod +x ln
+#	(set -o igncr 2>/dev/null) && set -o igncr; export SHELLOPTS; \
+#	    PATH=`pwd`:$$PATH; \
+#	    export PATH; \
+#	    cd gmpbuild-shared && \
+#	    CC=$(CC_STAGE1) $(SHELL) ./configure \
+#	          --enable-shared=yes --disable-static \
+#	          --host=$(HOSTPLATFORM) --build=$(BUILDPLATFORM)
+#	"$(TOUCH_CMD)" $@
+#
+#gmp.h: stamp.gmp.static
+#	$(CP) gmpbuild/gmp.h .
+#
+#libgmp.a: stamp.gmp.static
+#
+#libgmp-3.dll: stamp.gmp.shared
+#	$(MAKE) -C gmpbuild-shared MAKEFLAGS=
+#	$(CP) gmpbuild-shared/.libs/libgmp-3.dll .
+#
+#libgmp.dll.a: libgmp-3.dll
+#	$(CP) gmpbuild-shared/.libs/libgmp.dll.a .
+
+## GMP takes a long time to build, but changes rarely.  Hence we don't
+## bother cleaning it before validating, because that adds a
+## significant overhead to validation.
+#ifeq "$(Validating)" "NO"
+#clean distclean maintainer-clean ::
+#	$(RM) -f stamp.gmp.static stamp.gmp.shared
+#	$(RM) -rf gmpbuild
+#	$(RM) -rf gmpbuild-shared
+#endif
+
+endif
+
diff --git a/libraries/integer-gmp/gmp/ln b/libraries/integer-gmp/gmp/ln
new file mode 100755
index 000000000000..a3a297ccdbe9
--- /dev/null
+++ b/libraries/integer-gmp/gmp/ln
@@ -0,0 +1,3 @@
+#!/bin/sh
+exit 1
+
diff --git a/libraries/integer-gmp/gmp/tarball/README b/libraries/integer-gmp/gmp/tarball/README
new file mode 100644
index 000000000000..0693ecd87477
--- /dev/null
+++ b/libraries/integer-gmp/gmp/tarball/README
@@ -0,0 +1,8 @@
+
+Download linked from http://gmplib.org/
+
+Untar.
+Remove doc/ directory.
+Apply patch.
+Re-tar.
+
diff --git a/libraries/integer-gmp/gmp/tarball/gmp-5.0.3-nodoc-patched.tar.bz2 b/libraries/integer-gmp/gmp/tarball/gmp-5.0.3-nodoc-patched.tar.bz2
new file mode 100644
index 000000000000..baf99e6ee57c
Binary files /dev/null and b/libraries/integer-gmp/gmp/tarball/gmp-5.0.3-nodoc-patched.tar.bz2 differ
diff --git a/libraries/integer-gmp/gmp/tarball/patch b/libraries/integer-gmp/gmp/tarball/patch
new file mode 100644
index 000000000000..c7c5e7eef205
--- /dev/null
+++ b/libraries/integer-gmp/gmp/tarball/patch
@@ -0,0 +1,103 @@
+diff -ur gmp-5.0.2.orig/Makefile.am gmp-5.0.2/Makefile.am
+--- gmp-5.0.2.orig/Makefile.am	2011-05-08 10:49:29.000000000 +0100
++++ gmp-5.0.2/Makefile.am	2011-07-27 17:58:20.000000000 +0100
+@@ -93,7 +93,7 @@
+ LIBMP_LT_AGE =      1
+ 
+ 
+-SUBDIRS = tests mpn mpz mpq mpf printf scanf cxx mpbsd demos tune doc
++SUBDIRS = tests mpn mpz mpq mpf printf scanf cxx mpbsd demos tune
+ 
+ EXTRA_DIST = configfsf.guess configfsf.sub .gdbinit INSTALL.autoconf
+ 
+diff -ur gmp-5.0.2.orig/Makefile.in gmp-5.0.2/Makefile.in
+--- gmp-5.0.2.orig/Makefile.in	2011-05-08 10:49:35.000000000 +0100
++++ gmp-5.0.2/Makefile.in	2011-07-27 17:58:13.000000000 +0100
+@@ -435,7 +435,7 @@
+ LIBMP_LT_CURRENT = 4
+ LIBMP_LT_REVISION = 22
+ LIBMP_LT_AGE = 1
+-SUBDIRS = tests mpn mpz mpq mpf printf scanf cxx mpbsd demos tune doc
++SUBDIRS = tests mpn mpz mpq mpf printf scanf cxx mpbsd demos tune
+ 
+ # The ansi2knr setups for the build programs are the same as the normal
+ # automake ansi2knr rules, but using $(CC_FOR_BUILD) instead of $(CC).
+diff -ur gmp-5.0.2.orig/configure gmp-5.0.2/configure
+--- gmp-5.0.2.orig/configure	2011-05-08 10:49:33.000000000 +0100
++++ gmp-5.0.2/configure	2011-07-27 18:00:11.000000000 +0100
+@@ -28478,7 +28478,7 @@
+ # FIXME: Upcoming version of autoconf/automake may not like broken lines.
+ #        Right now automake isn't accepting the new AC_CONFIG_FILES scheme.
+ 
+-ac_config_files="$ac_config_files Makefile mpbsd/Makefile mpf/Makefile mpn/Makefile mpq/Makefile mpz/Makefile printf/Makefile scanf/Makefile cxx/Makefile tests/Makefile tests/devel/Makefile tests/mpbsd/Makefile tests/mpf/Makefile tests/mpn/Makefile tests/mpq/Makefile tests/mpz/Makefile tests/rand/Makefile tests/misc/Makefile tests/cxx/Makefile doc/Makefile tune/Makefile demos/Makefile demos/calc/Makefile demos/expr/Makefile gmp.h:gmp-h.in mp.h:mp-h.in"
++ac_config_files="$ac_config_files Makefile mpbsd/Makefile mpf/Makefile mpn/Makefile mpq/Makefile mpz/Makefile printf/Makefile scanf/Makefile cxx/Makefile tests/Makefile tests/devel/Makefile tests/mpbsd/Makefile tests/mpf/Makefile tests/mpn/Makefile tests/mpq/Makefile tests/mpz/Makefile tests/rand/Makefile tests/misc/Makefile tests/cxx/Makefile tune/Makefile demos/Makefile demos/calc/Makefile demos/expr/Makefile gmp.h:gmp-h.in mp.h:mp-h.in"
+ 
+ cat >confcache <<\_ACEOF
+ # This file is a shell script that caches the results of configure
+@@ -29665,7 +29665,6 @@
+     "tests/rand/Makefile") CONFIG_FILES="$CONFIG_FILES tests/rand/Makefile" ;;
+     "tests/misc/Makefile") CONFIG_FILES="$CONFIG_FILES tests/misc/Makefile" ;;
+     "tests/cxx/Makefile") CONFIG_FILES="$CONFIG_FILES tests/cxx/Makefile" ;;
+-    "doc/Makefile") CONFIG_FILES="$CONFIG_FILES doc/Makefile" ;;
+     "tune/Makefile") CONFIG_FILES="$CONFIG_FILES tune/Makefile" ;;
+     "demos/Makefile") CONFIG_FILES="$CONFIG_FILES demos/Makefile" ;;
+     "demos/calc/Makefile") CONFIG_FILES="$CONFIG_FILES demos/calc/Makefile" ;;
+Only in gmp-5.0.2.orig: doc
+diff -ur gmp-5.0.2.orig/memory.c gmp-5.0.2/memory.c
+--- gmp-5.0.2.orig/memory.c	2011-05-08 10:49:29.000000000 +0100
++++ gmp-5.0.2/memory.c	2011-07-27 15:18:21.000000000 +0100
+@@ -24,10 +24,21 @@
+ #include "gmp-impl.h"
+ 
+ 
++/* Patched for GHC: */
++void * stgAllocForGMP   (size_t size_in_bytes);
++void * stgReallocForGMP (void *ptr, size_t old_size, size_t new_size);
++void   stgDeallocForGMP (void *ptr, size_t size);
++
++void *  (*__gmp_allocate_func) __GMP_PROTO ((size_t)) = stgAllocForGMP;
++void *  (*__gmp_reallocate_func) __GMP_PROTO ((void *, size_t, size_t))
++     = stgReallocForGMP;
++void    (*__gmp_free_func) __GMP_PROTO ((void *, size_t)) = stgDeallocForGMP;
++/*
+ void *	(*__gmp_allocate_func) __GMP_PROTO ((size_t)) = __gmp_default_allocate;
+ void *	(*__gmp_reallocate_func) __GMP_PROTO ((void *, size_t, size_t))
+      = __gmp_default_reallocate;
+ void	(*__gmp_free_func) __GMP_PROTO ((void *, size_t)) = __gmp_default_free;
++*/
+ 
+ 
+ /* Default allocation functions.  In case of failure to allocate/reallocate
+--- gmp-5.0.2.orig/configure.in	2011-08-04 16:35:01.000000000 +1000
++++ gmp-5.0.2/configure.in	2011-08-04 16:39:03.000000000 +1000
+@@ -3178,6 +3178,7 @@
+           AC_DEFINE(HAVE_HOST_CPU_FAMILY_x86_64)
+ 	  case $host in
+ 	    *-*-darwin*)
++	      GMP_DEFINE_RAW(["define(<PIC_ALWAYS>,<yes>)"])
+ 	      GMP_INCLUDE_MPN(x86_64/darwin.m4) ;;
+ 	  esac
+           ;;
+--- gmp-5.0.2.orig/configure	2011-08-04 17:38:22.000000000 +1000
++++ gmp-5.0.2/configure	2011-08-04 17:39:04.000000000 +1000
+@@ -27567,6 +27567,9 @@
+ 	  case $host in
+ 	    *-*-darwin*)
+ 
++echo "define(<PIC_ALWAYS>,<yes>)" >> $gmp_tmpconfigm4
++
++
+ echo "include_mpn(\`x86_64/darwin.m4')" >> $gmp_tmpconfigm4i
+  ;;
+ 	  esac
+--- gmp-5.0.2.orig/mpn/asm-defs.m4	2011-08-04 23:11:19.000000000 +1000
++++ gmp-5.0.2/mpn/asm-defs.m4	2011-08-04 23:11:59.000000000 +1000
+@@ -1041,7 +1041,7 @@
+ dnl  systems which are always PIC.  PIC_ALWAYS established in config.m4
+ dnl  identifies these for us.
+ 
+-ifelse(`PIC_ALWAYS',`yes',`define(`PIC')')
++ifelse(PIC_ALWAYS,yes,`define(`PIC')')
+ 
+ 
+ dnl  Various possible defines passed from the Makefile that are to be tested
diff --git a/libraries/integer-gmp/include/HsIntegerGmp.h.in b/libraries/integer-gmp/include/HsIntegerGmp.h.in
new file mode 100644
index 000000000000..11c64677e890
--- /dev/null
+++ b/libraries/integer-gmp/include/HsIntegerGmp.h.in
@@ -0,0 +1,6 @@
+#ifndef _HS_INTEGER_GMP_H_
+#define _HS_INTEGER_GMP_H_
+
+#define HAVE_SECURE_POWM @HaveSecurePowm@
+
+#endif /* _HS_INTEGER_GMP_H_ */
diff --git a/libraries/integer-gmp/install-sh b/libraries/integer-gmp/install-sh
new file mode 100755
index 000000000000..377bb8687ffe
--- /dev/null
+++ b/libraries/integer-gmp/install-sh
@@ -0,0 +1,527 @@
+#!/bin/sh
+# install - install a program, script, or datafile
+
+scriptversion=2011-11-20.07; # UTC
+
+# This originates from X11R5 (mit/util/scripts/install.sh), which was
+# later released in X11R6 (xc/config/util/install.sh) with the
+# following copyright and license.
+#
+# Copyright (C) 1994 X Consortium
+#
+# Permission is hereby granted, free of charge, to any person obtaining a copy
+# of this software and associated documentation files (the "Software"), to
+# deal in the Software without restriction, including without limitation the
+# rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
+# sell copies of the Software, and to permit persons to whom the Software is
+# furnished to do so, subject to the following conditions:
+#
+# The above copyright notice and this permission notice shall be included in
+# all copies or substantial portions of the Software.
+#
+# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL THE
+# X CONSORTIUM BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN
+# AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNEC-
+# TION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+#
+# Except as contained in this notice, the name of the X Consortium shall not
+# be used in advertising or otherwise to promote the sale, use or other deal-
+# ings in this Software without prior written authorization from the X Consor-
+# tium.
+#
+#
+# FSF changes to this file are in the public domain.
+#
+# Calling this script install-sh is preferred over install.sh, to prevent
+# 'make' implicit rules from creating a file called install from it
+# when there is no Makefile.
+#
+# This script is compatible with the BSD install script, but was written
+# from scratch.
+
+nl='
+'
+IFS=" ""	$nl"
+
+# set DOITPROG to echo to test this script
+
+# Don't use :- since 4.3BSD and earlier shells don't like it.
+doit=${DOITPROG-}
+if test -z "$doit"; then
+  doit_exec=exec
+else
+  doit_exec=$doit
+fi
+
+# Put in absolute file names if you don't have them in your path;
+# or use environment vars.
+
+chgrpprog=${CHGRPPROG-chgrp}
+chmodprog=${CHMODPROG-chmod}
+chownprog=${CHOWNPROG-chown}
+cmpprog=${CMPPROG-cmp}
+cpprog=${CPPROG-cp}
+mkdirprog=${MKDIRPROG-mkdir}
+mvprog=${MVPROG-mv}
+rmprog=${RMPROG-rm}
+stripprog=${STRIPPROG-strip}
+
+posix_glob='?'
+initialize_posix_glob='
+  test "$posix_glob" != "?" || {
+    if (set -f) 2>/dev/null; then
+      posix_glob=
+    else
+      posix_glob=:
+    fi
+  }
+'
+
+posix_mkdir=
+
+# Desired mode of installed file.
+mode=0755
+
+chgrpcmd=
+chmodcmd=$chmodprog
+chowncmd=
+mvcmd=$mvprog
+rmcmd="$rmprog -f"
+stripcmd=
+
+src=
+dst=
+dir_arg=
+dst_arg=
+
+copy_on_change=false
+no_target_directory=
+
+usage="\
+Usage: $0 [OPTION]... [-T] SRCFILE DSTFILE
+   or: $0 [OPTION]... SRCFILES... DIRECTORY
+   or: $0 [OPTION]... -t DIRECTORY SRCFILES...
+   or: $0 [OPTION]... -d DIRECTORIES...
+
+In the 1st form, copy SRCFILE to DSTFILE.
+In the 2nd and 3rd, copy all SRCFILES to DIRECTORY.
+In the 4th, create DIRECTORIES.
+
+Options:
+     --help     display this help and exit.
+     --version  display version info and exit.
+
+  -c            (ignored)
+  -C            install only if different (preserve the last data modification time)
+  -d            create directories instead of installing files.
+  -g GROUP      $chgrpprog installed files to GROUP.
+  -m MODE       $chmodprog installed files to MODE.
+  -o USER       $chownprog installed files to USER.
+  -s            $stripprog installed files.
+  -t DIRECTORY  install into DIRECTORY.
+  -T            report an error if DSTFILE is a directory.
+
+Environment variables override the default commands:
+  CHGRPPROG CHMODPROG CHOWNPROG CMPPROG CPPROG MKDIRPROG MVPROG
+  RMPROG STRIPPROG
+"
+
+while test $# -ne 0; do
+  case $1 in
+    -c) ;;
+
+    -C) copy_on_change=true;;
+
+    -d) dir_arg=true;;
+
+    -g) chgrpcmd="$chgrpprog $2"
+	shift;;
+
+    --help) echo "$usage"; exit $?;;
+
+    -m) mode=$2
+	case $mode in
+	  *' '* | *'	'* | *'
+'*	  | *'*'* | *'?'* | *'['*)
+	    echo "$0: invalid mode: $mode" >&2
+	    exit 1;;
+	esac
+	shift;;
+
+    -o) chowncmd="$chownprog $2"
+	shift;;
+
+    -s) stripcmd=$stripprog;;
+
+    -t) dst_arg=$2
+	# Protect names problematic for 'test' and other utilities.
+	case $dst_arg in
+	  -* | [=\(\)!]) dst_arg=./$dst_arg;;
+	esac
+	shift;;
+
+    -T) no_target_directory=true;;
+
+    --version) echo "$0 $scriptversion"; exit $?;;
+
+    --)	shift
+	break;;
+
+    -*)	echo "$0: invalid option: $1" >&2
+	exit 1;;
+
+    *)  break;;
+  esac
+  shift
+done
+
+if test $# -ne 0 && test -z "$dir_arg$dst_arg"; then
+  # When -d is used, all remaining arguments are directories to create.
+  # When -t is used, the destination is already specified.
+  # Otherwise, the last argument is the destination.  Remove it from $@.
+  for arg
+  do
+    if test -n "$dst_arg"; then
+      # $@ is not empty: it contains at least $arg.
+      set fnord "$@" "$dst_arg"
+      shift # fnord
+    fi
+    shift # arg
+    dst_arg=$arg
+    # Protect names problematic for 'test' and other utilities.
+    case $dst_arg in
+      -* | [=\(\)!]) dst_arg=./$dst_arg;;
+    esac
+  done
+fi
+
+if test $# -eq 0; then
+  if test -z "$dir_arg"; then
+    echo "$0: no input file specified." >&2
+    exit 1
+  fi
+  # It's OK to call 'install-sh -d' without argument.
+  # This can happen when creating conditional directories.
+  exit 0
+fi
+
+if test -z "$dir_arg"; then
+  do_exit='(exit $ret); exit $ret'
+  trap "ret=129; $do_exit" 1
+  trap "ret=130; $do_exit" 2
+  trap "ret=141; $do_exit" 13
+  trap "ret=143; $do_exit" 15
+
+  # Set umask so as not to create temps with too-generous modes.
+  # However, 'strip' requires both read and write access to temps.
+  case $mode in
+    # Optimize common cases.
+    *644) cp_umask=133;;
+    *755) cp_umask=22;;
+
+    *[0-7])
+      if test -z "$stripcmd"; then
+	u_plus_rw=
+      else
+	u_plus_rw='% 200'
+      fi
+      cp_umask=`expr '(' 777 - $mode % 1000 ')' $u_plus_rw`;;
+    *)
+      if test -z "$stripcmd"; then
+	u_plus_rw=
+      else
+	u_plus_rw=,u+rw
+      fi
+      cp_umask=$mode$u_plus_rw;;
+  esac
+fi
+
+for src
+do
+  # Protect names problematic for 'test' and other utilities.
+  case $src in
+    -* | [=\(\)!]) src=./$src;;
+  esac
+
+  if test -n "$dir_arg"; then
+    dst=$src
+    dstdir=$dst
+    test -d "$dstdir"
+    dstdir_status=$?
+  else
+
+    # Waiting for this to be detected by the "$cpprog $src $dsttmp" command
+    # might cause directories to be created, which would be especially bad
+    # if $src (and thus $dsttmp) contains '*'.
+    if test ! -f "$src" && test ! -d "$src"; then
+      echo "$0: $src does not exist." >&2
+      exit 1
+    fi
+
+    if test -z "$dst_arg"; then
+      echo "$0: no destination specified." >&2
+      exit 1
+    fi
+    dst=$dst_arg
+
+    # If destination is a directory, append the input filename; won't work
+    # if double slashes aren't ignored.
+    if test -d "$dst"; then
+      if test -n "$no_target_directory"; then
+	echo "$0: $dst_arg: Is a directory" >&2
+	exit 1
+      fi
+      dstdir=$dst
+      dst=$dstdir/`basename "$src"`
+      dstdir_status=0
+    else
+      # Prefer dirname, but fall back on a substitute if dirname fails.
+      dstdir=`
+	(dirname "$dst") 2>/dev/null ||
+	expr X"$dst" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
+	     X"$dst" : 'X\(//\)[^/]' \| \
+	     X"$dst" : 'X\(//\)$' \| \
+	     X"$dst" : 'X\(/\)' \| . 2>/dev/null ||
+	echo X"$dst" |
+	    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{
+		   s//\1/
+		   q
+		 }
+		 /^X\(\/\/\)[^/].*/{
+		   s//\1/
+		   q
+		 }
+		 /^X\(\/\/\)$/{
+		   s//\1/
+		   q
+		 }
+		 /^X\(\/\).*/{
+		   s//\1/
+		   q
+		 }
+		 s/.*/./; q'
+      `
+
+      test -d "$dstdir"
+      dstdir_status=$?
+    fi
+  fi
+
+  obsolete_mkdir_used=false
+
+  if test $dstdir_status != 0; then
+    case $posix_mkdir in
+      '')
+	# Create intermediate dirs using mode 755 as modified by the umask.
+	# This is like FreeBSD 'install' as of 1997-10-28.
+	umask=`umask`
+	case $stripcmd.$umask in
+	  # Optimize common cases.
+	  *[2367][2367]) mkdir_umask=$umask;;
+	  .*0[02][02] | .[02][02] | .[02]) mkdir_umask=22;;
+
+	  *[0-7])
+	    mkdir_umask=`expr $umask + 22 \
+	      - $umask % 100 % 40 + $umask % 20 \
+	      - $umask % 10 % 4 + $umask % 2
+	    `;;
+	  *) mkdir_umask=$umask,go-w;;
+	esac
+
+	# With -d, create the new directory with the user-specified mode.
+	# Otherwise, rely on $mkdir_umask.
+	if test -n "$dir_arg"; then
+	  mkdir_mode=-m$mode
+	else
+	  mkdir_mode=
+	fi
+
+	posix_mkdir=false
+	case $umask in
+	  *[123567][0-7][0-7])
+	    # POSIX mkdir -p sets u+wx bits regardless of umask, which
+	    # is incompatible with FreeBSD 'install' when (umask & 300) != 0.
+	    ;;
+	  *)
+	    tmpdir=${TMPDIR-/tmp}/ins$RANDOM-$$
+	    trap 'ret=$?; rmdir "$tmpdir/d" "$tmpdir" 2>/dev/null; exit $ret' 0
+
+	    if (umask $mkdir_umask &&
+		exec $mkdirprog $mkdir_mode -p -- "$tmpdir/d") >/dev/null 2>&1
+	    then
+	      if test -z "$dir_arg" || {
+		   # Check for POSIX incompatibilities with -m.
+		   # HP-UX 11.23 and IRIX 6.5 mkdir -m -p sets group- or
+		   # other-writable bit of parent directory when it shouldn't.
+		   # FreeBSD 6.1 mkdir -m -p sets mode of existing directory.
+		   ls_ld_tmpdir=`ls -ld "$tmpdir"`
+		   case $ls_ld_tmpdir in
+		     d????-?r-*) different_mode=700;;
+		     d????-?--*) different_mode=755;;
+		     *) false;;
+		   esac &&
+		   $mkdirprog -m$different_mode -p -- "$tmpdir" && {
+		     ls_ld_tmpdir_1=`ls -ld "$tmpdir"`
+		     test "$ls_ld_tmpdir" = "$ls_ld_tmpdir_1"
+		   }
+		 }
+	      then posix_mkdir=:
+	      fi
+	      rmdir "$tmpdir/d" "$tmpdir"
+	    else
+	      # Remove any dirs left behind by ancient mkdir implementations.
+	      rmdir ./$mkdir_mode ./-p ./-- 2>/dev/null
+	    fi
+	    trap '' 0;;
+	esac;;
+    esac
+
+    if
+      $posix_mkdir && (
+	umask $mkdir_umask &&
+	$doit_exec $mkdirprog $mkdir_mode -p -- "$dstdir"
+      )
+    then :
+    else
+
+      # The umask is ridiculous, or mkdir does not conform to POSIX,
+      # or it failed possibly due to a race condition.  Create the
+      # directory the slow way, step by step, checking for races as we go.
+
+      case $dstdir in
+	/*) prefix='/';;
+	[-=\(\)!]*) prefix='./';;
+	*)  prefix='';;
+      esac
+
+      eval "$initialize_posix_glob"
+
+      oIFS=$IFS
+      IFS=/
+      $posix_glob set -f
+      set fnord $dstdir
+      shift
+      $posix_glob set +f
+      IFS=$oIFS
+
+      prefixes=
+
+      for d
+      do
+	test X"$d" = X && continue
+
+	prefix=$prefix$d
+	if test -d "$prefix"; then
+	  prefixes=
+	else
+	  if $posix_mkdir; then
+	    (umask=$mkdir_umask &&
+	     $doit_exec $mkdirprog $mkdir_mode -p -- "$dstdir") && break
+	    # Don't fail if two instances are running concurrently.
+	    test -d "$prefix" || exit 1
+	  else
+	    case $prefix in
+	      *\'*) qprefix=`echo "$prefix" | sed "s/'/'\\\\\\\\''/g"`;;
+	      *) qprefix=$prefix;;
+	    esac
+	    prefixes="$prefixes '$qprefix'"
+	  fi
+	fi
+	prefix=$prefix/
+      done
+
+      if test -n "$prefixes"; then
+	# Don't fail if two instances are running concurrently.
+	(umask $mkdir_umask &&
+	 eval "\$doit_exec \$mkdirprog $prefixes") ||
+	  test -d "$dstdir" || exit 1
+	obsolete_mkdir_used=true
+      fi
+    fi
+  fi
+
+  if test -n "$dir_arg"; then
+    { test -z "$chowncmd" || $doit $chowncmd "$dst"; } &&
+    { test -z "$chgrpcmd" || $doit $chgrpcmd "$dst"; } &&
+    { test "$obsolete_mkdir_used$chowncmd$chgrpcmd" = false ||
+      test -z "$chmodcmd" || $doit $chmodcmd $mode "$dst"; } || exit 1
+  else
+
+    # Make a couple of temp file names in the proper directory.
+    dsttmp=$dstdir/_inst.$$_
+    rmtmp=$dstdir/_rm.$$_
+
+    # Trap to clean up those temp files at exit.
+    trap 'ret=$?; rm -f "$dsttmp" "$rmtmp" && exit $ret' 0
+
+    # Copy the file name to the temp name.
+    (umask $cp_umask && $doit_exec $cpprog "$src" "$dsttmp") &&
+
+    # and set any options; do chmod last to preserve setuid bits.
+    #
+    # If any of these fail, we abort the whole thing.  If we want to
+    # ignore errors from any of these, just make sure not to ignore
+    # errors from the above "$doit $cpprog $src $dsttmp" command.
+    #
+    { test -z "$chowncmd" || $doit $chowncmd "$dsttmp"; } &&
+    { test -z "$chgrpcmd" || $doit $chgrpcmd "$dsttmp"; } &&
+    { test -z "$stripcmd" || $doit $stripcmd "$dsttmp"; } &&
+    { test -z "$chmodcmd" || $doit $chmodcmd $mode "$dsttmp"; } &&
+
+    # If -C, don't bother to copy if it wouldn't change the file.
+    if $copy_on_change &&
+       old=`LC_ALL=C ls -dlL "$dst"	2>/dev/null` &&
+       new=`LC_ALL=C ls -dlL "$dsttmp"	2>/dev/null` &&
+
+       eval "$initialize_posix_glob" &&
+       $posix_glob set -f &&
+       set X $old && old=:$2:$4:$5:$6 &&
+       set X $new && new=:$2:$4:$5:$6 &&
+       $posix_glob set +f &&
+
+       test "$old" = "$new" &&
+       $cmpprog "$dst" "$dsttmp" >/dev/null 2>&1
+    then
+      rm -f "$dsttmp"
+    else
+      # Rename the file to the real destination.
+      $doit $mvcmd -f "$dsttmp" "$dst" 2>/dev/null ||
+
+      # The rename failed, perhaps because mv can't rename something else
+      # to itself, or perhaps because mv is so ancient that it does not
+      # support -f.
+      {
+	# Now remove or move aside any old file at destination location.
+	# We try this two ways since rm can't unlink itself on some
+	# systems and the destination file might be busy for other
+	# reasons.  In this case, the final cleanup might fail but the new
+	# file should still install successfully.
+	{
+	  test ! -f "$dst" ||
+	  $doit $rmcmd -f "$dst" 2>/dev/null ||
+	  { $doit $mvcmd -f "$dst" "$rmtmp" 2>/dev/null &&
+	    { $doit $rmcmd -f "$rmtmp" 2>/dev/null; :; }
+	  } ||
+	  { echo "$0: cannot unlink or rename $dst" >&2
+	    (exit 1); exit 1
+	  }
+	} &&
+
+	# Now rename the file to the real destination.
+	$doit $mvcmd "$dsttmp" "$dst"
+      }
+    fi || exit 1
+
+    trap '' 0
+  fi
+done
+
+# Local variables:
+# eval: (add-hook 'write-file-hooks 'time-stamp)
+# time-stamp-start: "scriptversion="
+# time-stamp-format: "%:y-%02m-%02d.%02H"
+# time-stamp-time-zone: "UTC"
+# time-stamp-end: "; # UTC"
+# End:
diff --git a/libraries/integer-gmp/integer-gmp.buildinfo.in b/libraries/integer-gmp/integer-gmp.buildinfo.in
new file mode 100644
index 000000000000..9b2bad99d770
--- /dev/null
+++ b/libraries/integer-gmp/integer-gmp.buildinfo.in
@@ -0,0 +1,5 @@
+include-dirs: @GMP_INCLUDE_DIRS@
+extra-lib-dirs: @GMP_LIB_DIRS@
+extra-libraries: @GMP_LIBS@
+frameworks: @GMP_FRAMEWORK@
+install-includes: HsIntegerGmp.h
\ No newline at end of file
diff --git a/libraries/integer-gmp/integer-gmp.cabal b/libraries/integer-gmp/integer-gmp.cabal
new file mode 100644
index 000000000000..376139f10242
--- /dev/null
+++ b/libraries/integer-gmp/integer-gmp.cabal
@@ -0,0 +1,80 @@
+name:           integer-gmp
+version:        0.5.1.0
+-- GHC 7.6.1 released with 0.5.0.0
+license:        BSD3
+license-file:   LICENSE
+category:       Numerical
+maintainer:     libraries@haskell.org
+bug-reports:    http://ghc.haskell.org/trac/ghc/newticket?component=libraries%20%28other%29&keywords=integer-gmp
+synopsis:       Integer library based on GMP
+description:
+    This package provides the low-level implementation of the standard
+    'Integer' type based on the
+    <http://gmplib.org/ GNU Multiple Precision Arithmetic Library (GMP)>.
+    .
+    This package provides access to the internal representation of
+    'Integer' as well as primitive operations with no proper error
+    handling, and should only be used directly with the utmost care.
+    .
+    For more details about the design of @integer-gmp@, see
+    <https://ghc.haskell.org/trac/ghc/wiki/Commentary/Libraries/Integer GHC Commentary: Libraries/Integer>.
+build-type:     Configure
+cabal-version:  >=1.10
+
+extra-source-files:
+    aclocal.m4
+    cbits/alloc.c
+    cbits/float.c
+    cbits/gmp-wrappers.cmm
+    cbits/longlong.c
+    changelog.md
+    config.guess
+    config.sub
+    configure
+    configure.ac
+    gmp/config.mk.in
+    install-sh
+    integer-gmp.buildinfo.in
+    include/HsIntegerGmp.h.in
+
+extra-tmp-files:
+    autom4te.cache
+    config.log
+    config.status
+    gmp/config.mk
+    integer-gmp.buildinfo
+    include/HsIntegerGmp.h
+
+source-repository head
+    type:     git
+    location: http://git.haskell.org/ghc.git
+    subdir:   libraries/integer-gmp
+
+Library
+    default-language: Haskell2010
+    other-extensions:
+        BangPatterns
+        CPP
+        GHCForeignImportPrim
+        MagicHash
+        NoImplicitPrelude
+        UnboxedTuples
+        UnliftedFFITypes
+
+    exposed-modules:
+        GHC.Integer
+        GHC.Integer.GMP.Internals
+        GHC.Integer.GMP.Prim
+        GHC.Integer.Logarithms
+        GHC.Integer.Logarithms.Internals
+    other-modules:
+        GHC.Integer.Type
+
+    c-sources: cbits/cbits.c
+    include-dirs: include
+
+    build-depends: ghc-prim >= 0.3.1 && < 0.4
+
+    -- We need to set the package key to integer-gmp
+    -- (without a version number) as it's magic.
+    ghc-options: -Wall -this-package-key integer-gmp
diff --git a/libraries/integer-gmp/mkGmpDerivedConstants/Makefile b/libraries/integer-gmp/mkGmpDerivedConstants/Makefile
new file mode 100644
index 000000000000..ce66e201b49f
--- /dev/null
+++ b/libraries/integer-gmp/mkGmpDerivedConstants/Makefile
@@ -0,0 +1,15 @@
+# -----------------------------------------------------------------------------
+#
+# (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://ghc.haskell.org/trac/ghc/wiki/Building/Architecture
+#      http://ghc.haskell.org/trac/ghc/wiki/Building/Modifying
+#
+# -----------------------------------------------------------------------------
+
+dir = libraries/integer-gmp/mkGmpDerivedConstants
+TOP = ../../..
+include $(TOP)/mk/sub-makefile.mk
diff --git a/libraries/integer-gmp/mkGmpDerivedConstants/ghc.mk b/libraries/integer-gmp/mkGmpDerivedConstants/ghc.mk
new file mode 100644
index 000000000000..fcf19fa4a083
--- /dev/null
+++ b/libraries/integer-gmp/mkGmpDerivedConstants/ghc.mk
@@ -0,0 +1,39 @@
+# -----------------------------------------------------------------------------
+#
+# (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://ghc.haskell.org/trac/ghc/wiki/Building/Architecture
+#      http://ghc.haskell.org/trac/ghc/wiki/Building/Modifying
+#
+# -----------------------------------------------------------------------------
+
+libraries/integer-gmp/mkGmpDerivedConstants_dist_C_SRCS          = mkGmpDerivedConstants.c
+libraries/integer-gmp/mkGmpDerivedConstants_dist_PROGNAME        = mkGmpDerivedConstants
+libraries/integer-gmp/mkGmpDerivedConstants_dist_TOPDIR          = YES
+libraries/integer-gmp/mkGmpDerivedConstants_dist_INSTALL         = YES
+libraries/integer-gmp/mkGmpDerivedConstants_dist_INSTALL_INPLACE = YES
+libraries/integer-gmp/mkGmpDerivedConstants_dist_EXTRA_CC_OPTS += $(gmp_CC_OPTS)
+
+$(eval $(call build-prog,libraries/integer-gmp/mkGmpDerivedConstants,dist,1))
+
+GmpDerivedConstants_HEADER = libraries/integer-gmp/mkGmpDerivedConstants/dist/GmpDerivedConstants.h
+
+$(GmpDerivedConstants_HEADER): $(mkGmpDerivedConstants_INPLACE)
+	$< > $@
+
+ifneq "$(HaveLibGmp)" "YES"
+ifneq "$(HaveFrameworkGMP)" "YES"
+# NOTE: we should really be referring to the depfile generated by the build
+# system here, but due to an awkward contortion I can't figure out, the build
+# system follows an implied from somewhere else to directly build the C file
+# instead (independent of the depfile rules), which doesn't have a built gmp.h
+# dependency. This race causes the parallel build to fail.
+#
+# See #8102
+libraries/integer-gmp/mkGmpDerivedConstants/mkGmpDerivedConstants.c: libraries/integer-gmp/gmp/gmp.h
+endif
+endif
+
diff --git a/libraries/integer-gmp/mkGmpDerivedConstants/mkGmpDerivedConstants.c b/libraries/integer-gmp/mkGmpDerivedConstants/mkGmpDerivedConstants.c
new file mode 100644
index 000000000000..fb7290f6826b
--- /dev/null
+++ b/libraries/integer-gmp/mkGmpDerivedConstants/mkGmpDerivedConstants.c
@@ -0,0 +1,75 @@
+/* --------------------------------------------------------------------------
+ *
+ * (c) The GHC Team, 1992-2004
+ *
+ * mkDerivedConstants.c
+ *
+ * Basically this is a C program that extracts information from the C
+ * declarations in the header files (primarily struct field offsets)
+ * and generates a header file that can be #included into non-C source
+ * containing this information.
+ *
+ * ------------------------------------------------------------------------*/
+
+#include <stdio.h>
+#include "gmp.h"
+
+
+#define str(a,b) #a "_" #b
+
+#define OFFSET(s_type, field) ((size_t)&(((s_type*)0)->field))
+
+/* struct_size(TYPE)
+ *
+ */
+#define def_size(str, size) \
+    printf("#define SIZEOF_" str " %lu\n", (unsigned long)size);
+
+#define struct_size(s_type) \
+    def_size(#s_type, sizeof(s_type));
+
+
+
+/* struct_field(TYPE, FIELD)
+ *
+ */
+#define def_offset(str, offset) \
+    printf("#define OFFSET_" str " %d\n", (int)(offset));
+
+#define field_offset_(str, s_type, field) \
+    def_offset(str, OFFSET(s_type,field));
+
+#define field_offset(s_type, field) \
+    field_offset_(str(s_type,field),s_type,field);
+
+#define field_type_(str, s_type, field) \
+    printf("#define REP_" str " b"); \
+    printf("%lu\n", (unsigned long)sizeof (__typeof__(((((s_type*)0)->field)))) * 8);
+
+#define field_type(s_type, field) \
+    field_type_(str(s_type,field),s_type,field);
+
+/* An access macro for use in C-- sources. */
+#define struct_field_macro(str) \
+    printf("#define " str "(__ptr__)  REP_" str "[__ptr__+OFFSET_" str "]\n");
+
+/* Outputs the byte offset and MachRep for a field */
+#define struct_field(s_type, field)		\
+    field_offset(s_type, field);		\
+    field_type(s_type, field);			\
+    struct_field_macro(str(s_type,field))
+
+
+int
+main(int argc, char *argv[])
+{
+    printf("/* This file is created automatically.  Do not edit by hand.*/\n\n");
+
+    struct_size(MP_INT);
+    struct_field(MP_INT,_mp_alloc);
+    struct_field(MP_INT,_mp_size);
+    struct_field(MP_INT,_mp_d);
+    def_size("MP_LIMB_T", sizeof(mp_limb_t));
+
+    return 0;
+}
diff --git a/libraries/integer-simple/.gitignore b/libraries/integer-simple/.gitignore
new file mode 100644
index 000000000000..8f4d26768c89
--- /dev/null
+++ b/libraries/integer-simple/.gitignore
@@ -0,0 +1,3 @@
+GNUmakefile
+dist-install
+ghc.mk
diff --git a/libraries/integer-simple/GHC/Integer.hs b/libraries/integer-simple/GHC/Integer.hs
new file mode 100644
index 000000000000..f419b2f5923c
--- /dev/null
+++ b/libraries/integer-simple/GHC/Integer.hs
@@ -0,0 +1,43 @@
+
+{-# LANGUAGE CPP, MagicHash, NoImplicitPrelude #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.Integer
+-- Copyright   :  (c) Ian Lynagh 2007-2012
+-- License     :  BSD3
+--
+-- Maintainer  :  igloo@earth.li
+-- Stability   :  internal
+-- Portability :  non-portable (GHC Extensions)
+--
+-- An simple definition of the 'Integer' type.
+--
+-----------------------------------------------------------------------------
+
+#include "MachDeps.h"
+
+module GHC.Integer (
+    Integer, mkInteger,
+    smallInteger, wordToInteger, integerToWord, integerToInt,
+#if WORD_SIZE_IN_BITS < 64
+    integerToWord64, word64ToInteger,
+    integerToInt64, int64ToInteger,
+#endif
+    plusInteger, minusInteger, timesInteger, negateInteger,
+    eqInteger, neqInteger, absInteger, signumInteger,
+    leInteger, gtInteger, ltInteger, geInteger, compareInteger,
+    eqInteger#, neqInteger#,
+    leInteger#, gtInteger#, ltInteger#, geInteger#,
+    divInteger, modInteger,
+    divModInteger, quotRemInteger, quotInteger, remInteger,
+    encodeFloatInteger, decodeFloatInteger, floatFromInteger,
+    encodeDoubleInteger, decodeDoubleInteger, doubleFromInteger,
+    -- gcdInteger, lcmInteger, -- XXX
+    andInteger, orInteger, xorInteger, complementInteger,
+    shiftLInteger, shiftRInteger, testBitInteger,
+    hashInteger,
+ ) where
+
+import GHC.Integer.Type
+
diff --git a/libraries/integer-simple/GHC/Integer/Logarithms.hs b/libraries/integer-simple/GHC/Integer/Logarithms.hs
new file mode 100644
index 000000000000..cfafe14226a4
--- /dev/null
+++ b/libraries/integer-simple/GHC/Integer/Logarithms.hs
@@ -0,0 +1,43 @@
+{-# LANGUAGE MagicHash, UnboxedTuples, NoImplicitPrelude #-}
+module GHC.Integer.Logarithms
+    ( integerLogBase#
+    , integerLog2#
+    , wordLog2#
+    ) where
+
+import GHC.Prim
+import GHC.Integer
+import qualified GHC.Integer.Logarithms.Internals as I
+
+-- | Calculate the integer logarithm for an arbitrary base.
+--   The base must be greater than 1, the second argument, the number
+--   whose logarithm is sought, should be positive, otherwise the
+--   result is meaningless.
+--
+-- > base ^ integerLogBase# base m <= m < base ^ (integerLogBase# base m + 1)
+--
+-- for @base > 1@ and @m > 0@.
+integerLogBase# :: Integer -> Integer -> Int#
+integerLogBase# b m = case step b of
+                        (# _, e #) -> e
+  where
+    step pw =
+      if m `ltInteger` pw
+        then (# m, 0# #)
+        else case step (pw `timesInteger` pw) of
+               (# q, e #) ->
+                 if q `ltInteger` pw
+                   then (# q, 2# *# e #)
+                   else (# q `quotInteger` pw, 2# *# e +# 1# #)
+
+-- | Calculate the integer base 2 logarithm of an 'Integer'.
+--   The calculation is more efficient than for the general case,
+--   on platforms with 32- or 64-bit words much more efficient.
+--
+--  The argument must be strictly positive, that condition is /not/ checked.
+integerLog2# :: Integer -> Int#
+integerLog2# = I.integerLog2#
+
+-- | This function calculates the integer base 2 logarithm of a 'Word#'.
+wordLog2# :: Word# -> Int#
+wordLog2# = I.wordLog2#
diff --git a/libraries/integer-simple/GHC/Integer/Logarithms/Internals.hs b/libraries/integer-simple/GHC/Integer/Logarithms/Internals.hs
new file mode 100644
index 000000000000..fea7f7941a4b
--- /dev/null
+++ b/libraries/integer-simple/GHC/Integer/Logarithms/Internals.hs
@@ -0,0 +1,166 @@
+{-# LANGUAGE CPP, MagicHash, UnboxedTuples, NoImplicitPrelude #-}
+{-# OPTIONS_HADDOCK hide #-}
+
+#include "MachDeps.h"
+
+-- (Hopefully) Fast integer logarithms to base 2.
+-- integerLog2# and wordLog2# are of general usefulness,
+-- the others are only needed for a fast implementation of
+-- fromRational.
+-- Since they are needed in GHC.Float, we must expose this
+-- module, but it should not show up in the docs.
+
+module GHC.Integer.Logarithms.Internals
+    ( integerLog2#
+    , integerLog2IsPowerOf2#
+    , wordLog2#
+    , roundingMode#
+    ) where
+
+import GHC.Prim
+import GHC.Integer.Type
+import GHC.Types
+
+default ()
+
+-- When larger word sizes become common, add support for those,
+-- it's not hard, just tedious.
+#if (WORD_SIZE_IN_BITS != 32) && (WORD_SIZE_IN_BITS != 64)
+
+-- We don't know whether the word has 30 bits or 128 or even more,
+-- so we can't start from the top, although that would be much more
+-- efficient.
+wordLog2# :: Word# -> Int#
+wordLog2# w = go 8# w
+  where
+    go acc u = case u `uncheckedShiftRL#` 8# of
+                0## -> case leadingZeros of
+                        BA ba -> acc -# indexInt8Array# ba (word2Int# u)
+                v   -> go (acc +# 8#) v
+
+#else
+
+-- This one at least can also be done efficiently.
+-- wordLog2# 0## = -1#
+{-# INLINE wordLog2# #-}
+wordLog2# :: Word# -> Int#
+wordLog2# w =
+  case leadingZeros of
+   BA lz ->
+    let zeros u = indexInt8Array# lz (word2Int# u) in
+#if WORD_SIZE_IN_BITS == 64
+    case uncheckedShiftRL# w 56# of
+     a ->
+      if isTrue# (a `neWord#` 0##)
+       then 64# -# zeros a
+       else
+        case uncheckedShiftRL# w 48# of
+         b ->
+          if isTrue# (b `neWord#` 0##)
+           then 56# -# zeros b
+           else
+            case uncheckedShiftRL# w 40# of
+             c ->
+              if isTrue# (c `neWord#` 0##)
+               then 48# -# zeros c
+               else
+                case uncheckedShiftRL# w 32# of
+                 d ->
+                  if isTrue# (d `neWord#` 0##)
+                   then 40# -# zeros d
+                   else
+#endif
+                    case uncheckedShiftRL# w 24# of
+                     e ->
+                      if isTrue# (e `neWord#` 0##)
+                       then 32# -# zeros e
+                       else
+                        case uncheckedShiftRL# w 16# of
+                         f ->
+                          if isTrue# (f `neWord#` 0##)
+                           then 24# -# zeros f
+                           else
+                            case uncheckedShiftRL# w 8# of
+                             g ->
+                              if isTrue# (g `neWord#` 0##)
+                               then 16# -# zeros g
+                               else  8# -# zeros w
+
+#endif
+
+-- Assumption: Integer is strictly positive,
+-- otherwise return -1# arbitrarily
+-- Going up in word-sized steps should not be too bad.
+integerLog2# :: Integer -> Int#
+integerLog2# (Positive digits) = step 0# digits
+  where
+    step acc (Some dig None) = acc +# wordLog2# dig
+    step acc (Some _ digs)   =
+        step (acc +# WORD_SIZE_IN_BITS#) digs
+    step acc None = acc     -- should be impossible, throw error?
+integerLog2# _ = negateInt# 1#
+
+-- Again, integer should be strictly positive
+integerLog2IsPowerOf2# :: Integer -> (# Int#, Int# #)
+integerLog2IsPowerOf2# (Positive digits) = couldBe 0# digits
+  where
+    couldBe acc (Some dig None) =
+        (# acc +# wordLog2# dig, word2Int# (and# dig (minusWord# dig 1##)) #)
+    couldBe acc (Some dig digs) =
+        if isTrue# (eqWord# dig 0##)
+           then couldBe (acc +# WORD_SIZE_IN_BITS#) digs
+           else noPower (acc +# WORD_SIZE_IN_BITS#) digs
+    couldBe acc None = (# acc, 1# #) -- should be impossible, error?
+    noPower acc (Some dig None) =
+        (# acc +# wordLog2# dig, 1# #)
+    noPower acc (Some _ digs)   =
+        noPower (acc +# WORD_SIZE_IN_BITS#) digs
+    noPower acc None = (# acc, 1# #) -- should be impossible, error?
+integerLog2IsPowerOf2# _ = (# negateInt# 1#, 1# #)
+
+-- Assumption: Integer and Int# are strictly positive, Int# is less
+-- than logBase 2 of Integer, otherwise havoc ensues.
+-- Used only for the numerator in fromRational when the denominator
+-- is a power of 2.
+-- The Int# argument is log2 n minus the number of bits in the mantissa
+-- of the target type, i.e. the index of the first non-integral bit in
+-- the quotient.
+--
+-- 0# means round down (towards zero)
+-- 1# means we have a half-integer, round to even
+-- 2# means round up (away from zero)
+-- This function should probably be improved.
+roundingMode# :: Integer -> Int# -> Int#
+roundingMode# m h =
+    case oneInteger `shiftLInteger` h of
+      c -> case m `andInteger`
+                ((c `plusInteger` c) `minusInteger` oneInteger) of
+             r ->
+               if c `ltInteger` r
+                 then 2#
+                 else if c `gtInteger` r
+                        then 0#
+                        else 1#
+
+-- Lookup table
+data BA = BA ByteArray#
+
+leadingZeros :: BA
+leadingZeros =
+    let mkArr s =
+          case newByteArray# 256# s of
+            (# s1, mba #) ->
+              case writeInt8Array# mba 0# 9# s1 of
+                s2 ->
+                  let fillA lim val idx st =
+                        if isTrue# (idx ==# 256#)
+                          then st
+                          else if isTrue# (idx <# lim)
+                                then case writeInt8Array# mba idx val st of
+                                        nx -> fillA lim val (idx +# 1#) nx
+                                else fillA (2# *# lim) (val -# 1#) idx st
+                  in case fillA 2# 8# 1# s2 of
+                      s3 -> case unsafeFreezeByteArray# mba s3 of
+                              (# _, ba #) -> ba
+    in case mkArr realWorld# of
+        b -> BA b
diff --git a/libraries/integer-simple/GHC/Integer/Simple/Internals.hs b/libraries/integer-simple/GHC/Integer/Simple/Internals.hs
new file mode 100644
index 000000000000..64d0d6fd7941
--- /dev/null
+++ b/libraries/integer-simple/GHC/Integer/Simple/Internals.hs
@@ -0,0 +1,23 @@
+
+{-# LANGUAGE NoImplicitPrelude #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.Integer.Simple.Internals
+-- Copyright   :  (c) Ian Lynagh 2007-2008
+-- License     :  BSD3
+--
+-- Maintainer  :  igloo@earth.li
+-- Stability   :  internal
+-- Portability :  non-portable (GHC Extensions)
+--
+-- An simple definition of the 'Integer' type.
+--
+-----------------------------------------------------------------------------
+
+module GHC.Integer.Simple.Internals (
+    module GHC.Integer.Type
+ ) where
+
+import GHC.Integer.Type
+
diff --git a/libraries/integer-simple/GHC/Integer/Type.hs b/libraries/integer-simple/GHC/Integer/Type.hs
new file mode 100644
index 000000000000..cd39b7d6bd24
--- /dev/null
+++ b/libraries/integer-simple/GHC/Integer/Type.hs
@@ -0,0 +1,895 @@
+
+{-# LANGUAGE CPP, MagicHash, NoImplicitPrelude, BangPatterns, UnboxedTuples,
+             UnliftedFFITypes #-}
+
+-- Commentary of Integer library is located on the wiki:
+-- http://ghc.haskell.org/trac/ghc/wiki/Commentary/Libraries/Integer
+--
+-- It gives an in-depth description of implementation details and
+-- decisions.
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.Integer.Type
+-- Copyright   :  (c) Ian Lynagh 2007-2012
+-- License     :  BSD3
+--
+-- Maintainer  :  igloo@earth.li
+-- Stability   :  internal
+-- Portability :  non-portable (GHC Extensions)
+--
+-- An simple definition of the 'Integer' type.
+--
+-----------------------------------------------------------------------------
+
+#include "MachDeps.h"
+
+module GHC.Integer.Type where
+
+import GHC.Prim
+import GHC.Classes
+import GHC.Types
+import GHC.Tuple ()
+#if WORD_SIZE_IN_BITS < 64
+import GHC.IntWord64
+#endif
+
+#if !defined(__HADDOCK__)
+
+data Integer = Positive !Positive | Negative !Positive | Naught
+
+-------------------------------------------------------------------
+-- The hard work is done on positive numbers
+
+-- Least significant bit is first
+
+-- Positive's have the property that they contain at least one Bit,
+-- and their last Bit is One.
+type Positive = Digits
+type Positives = List Positive
+
+data Digits = Some !Digit !Digits
+            | None
+type Digit = Word#
+
+-- XXX Could move [] above us
+data List a = Nil | Cons a (List a)
+
+mkInteger :: Bool   -- non-negative?
+          -> [Int]  -- absolute value in 31 bit chunks, least significant first
+                    -- ideally these would be Words rather than Ints, but
+                    -- we don't have Word available at the moment.
+          -> Integer
+mkInteger nonNegative is = let abs = f is
+                           in if nonNegative then abs else negateInteger abs
+    where f [] = Naught
+          f (I# i : is') = smallInteger i `orInteger` shiftLInteger (f is') 31#
+
+errorInteger :: Integer
+errorInteger = Positive errorPositive
+
+errorPositive :: Positive
+errorPositive = Some 47## None -- Random number
+
+{-# NOINLINE smallInteger #-}
+smallInteger :: Int# -> Integer
+smallInteger i = if isTrue# (i >=# 0#) then wordToInteger (int2Word# i)
+                 else -- XXX is this right for -minBound?
+                      negateInteger (wordToInteger (int2Word# (negateInt# i)))
+
+{-# NOINLINE wordToInteger #-}
+wordToInteger :: Word# -> Integer
+wordToInteger w = if isTrue# (w `eqWord#` 0##)
+                  then Naught
+                  else Positive (Some w None)
+
+{-# NOINLINE integerToWord #-}
+integerToWord :: Integer -> Word#
+integerToWord (Positive (Some w _)) = w
+integerToWord (Negative (Some w _)) = 0## `minusWord#` w
+-- Must be Naught by the invariant:
+integerToWord _ = 0##
+
+{-# NOINLINE integerToInt #-}
+integerToInt :: Integer -> Int#
+integerToInt i = word2Int# (integerToWord i)
+
+#if WORD_SIZE_IN_BITS == 64
+-- Nothing
+#elif WORD_SIZE_IN_BITS == 32
+{-# NOINLINE integerToWord64 #-}
+integerToWord64 :: Integer -> Word64#
+integerToWord64 i = int64ToWord64# (integerToInt64 i)
+
+{-# NOINLINE word64ToInteger #-}
+word64ToInteger:: Word64# -> Integer
+word64ToInteger w = if isTrue# (w `eqWord64#` wordToWord64# 0##)
+                    then Naught
+                    else Positive (word64ToPositive w)
+
+{-# NOINLINE integerToInt64 #-}
+integerToInt64 :: Integer -> Int64#
+integerToInt64 Naught = intToInt64# 0#
+integerToInt64 (Positive p) = word64ToInt64# (positiveToWord64 p)
+integerToInt64 (Negative p)
+    = negateInt64# (word64ToInt64# (positiveToWord64 p))
+
+{-# NOINLINE int64ToInteger #-}
+int64ToInteger :: Int64# -> Integer
+int64ToInteger i
+ = if isTrue# (i `eqInt64#` intToInt64# 0#)
+   then Naught
+   else if isTrue# (i `gtInt64#` intToInt64# 0#)
+   then Positive (word64ToPositive (int64ToWord64# i))
+   else Negative (word64ToPositive (int64ToWord64# (negateInt64# i)))
+#else
+#error WORD_SIZE_IN_BITS not supported
+#endif
+
+oneInteger :: Integer
+oneInteger = Positive onePositive
+
+negativeOneInteger :: Integer
+negativeOneInteger = Negative onePositive
+
+twoToTheThirtytwoInteger :: Integer
+twoToTheThirtytwoInteger = Positive twoToTheThirtytwoPositive
+
+{-# NOINLINE encodeDoubleInteger #-}
+encodeDoubleInteger :: Integer -> Int# -> Double#
+encodeDoubleInteger (Positive ds0) e0 = f 0.0## ds0 e0
+    where f !acc None        (!_) = acc
+          f !acc (Some d ds) !e   = f (acc +## encodeDouble# d e)
+                                      ds
+                                      -- XXX We assume that this adding to e
+                                      -- isn't going to overflow
+                                      (e +# WORD_SIZE_IN_BITS#)
+encodeDoubleInteger (Negative ds) e
+    = negateDouble# (encodeDoubleInteger (Positive ds) e)
+encodeDoubleInteger Naught _ = 0.0##
+
+foreign import ccall unsafe "__word_encodeDouble"
+        encodeDouble# :: Word# -> Int# -> Double#
+
+{-# NOINLINE encodeFloatInteger #-}
+encodeFloatInteger :: Integer -> Int# -> Float#
+encodeFloatInteger (Positive ds0) e0 = f 0.0# ds0 e0
+    where f !acc None        (!_) = acc
+          f !acc (Some d ds) !e   = f (acc `plusFloat#` encodeFloat# d e)
+                                      ds
+                                      -- XXX We assume that this adding to e
+                                      -- isn't going to overflow
+                                      (e +# WORD_SIZE_IN_BITS#)
+encodeFloatInteger (Negative ds) e
+    = negateFloat# (encodeFloatInteger (Positive ds) e)
+encodeFloatInteger Naught _ = 0.0#
+
+foreign import ccall unsafe "__word_encodeFloat"
+    encodeFloat# :: Word# -> Int# -> Float#
+
+{-# NOINLINE decodeFloatInteger #-}
+decodeFloatInteger :: Float# -> (# Integer, Int# #)
+decodeFloatInteger f = case decodeFloat_Int# f of
+                       (# mant, exp #) -> (# smallInteger mant, exp #)
+
+-- XXX This could be optimised better, by either (word-size dependent)
+-- using single 64bit value for the mantissa, or doing the multiplication
+-- by just building the Digits directly
+{-# NOINLINE decodeDoubleInteger #-}
+decodeDoubleInteger :: Double# -> (# Integer, Int# #)
+decodeDoubleInteger d
+ = case decodeDouble_2Int# d of
+   (# mantSign, mantHigh, mantLow, exp #) ->
+       (# (smallInteger mantSign) `timesInteger`
+          (  (wordToInteger mantHigh `timesInteger` twoToTheThirtytwoInteger)
+             `plusInteger` wordToInteger mantLow),
+          exp #)
+
+{-# NOINLINE doubleFromInteger #-}
+doubleFromInteger :: Integer -> Double#
+doubleFromInteger Naught = 0.0##
+doubleFromInteger (Positive p) = doubleFromPositive p
+doubleFromInteger (Negative p) = negateDouble# (doubleFromPositive p)
+
+{-# NOINLINE floatFromInteger #-}
+floatFromInteger :: Integer -> Float#
+floatFromInteger Naught = 0.0#
+floatFromInteger (Positive p) = floatFromPositive p
+floatFromInteger (Negative p) = negateFloat# (floatFromPositive p)
+
+{-# NOINLINE andInteger #-}
+andInteger :: Integer -> Integer -> Integer
+Naught     `andInteger` (!_)       = Naught
+(!_)       `andInteger` Naught     = Naught
+Positive x `andInteger` Positive y = digitsToInteger (x `andDigits` y)
+{-
+To calculate x & -y we need to calculate
+    x & twosComplement y
+The (imaginary) sign bits are 0 and 1, so &ing them give 0, i.e. positive.
+Note that
+    twosComplement y
+has infinitely many 1s, but x has a finite number of digits, so andDigits
+will return a finite result.
+-}
+Positive x `andInteger` Negative y = let y' = twosComplementPositive y
+                                         z = y' `andDigitsOnes` x
+                                     in digitsToInteger z
+Negative x `andInteger` Positive y = Positive y `andInteger` Negative x
+{-
+To calculate -x & -y, naively we need to calculate
+    twosComplement (twosComplement x & twosComplement y)
+but
+    twosComplement x & twosComplement y
+has infinitely many 1s, so this won't work. Thus we use de Morgan's law
+to get
+    -x & -y = !(!(-x) | !(-y))
+            = !(!(twosComplement x) | !(twosComplement y))
+            = !(!(!x + 1) | (!y + 1))
+            = !((x - 1) | (y - 1))
+but the result is negative, so we need to take the two's complement of
+this in order to get the magnitude of the result.
+    twosComplement !((x - 1) | (y - 1))
+            = !(!((x - 1) | (y - 1))) + 1
+            = ((x - 1) | (y - 1)) + 1
+-}
+-- We don't know that x and y are /strictly/ greater than 1, but
+-- minusPositive gives us the required answer anyway.
+Negative x `andInteger` Negative y = let x' = x `minusPositive` onePositive
+                                         y' = y `minusPositive` onePositive
+                                         z = x' `orDigits` y'
+                                         -- XXX Cheating the precondition:
+                                         z' = succPositive z
+                                     in digitsToNegativeInteger z'
+
+{-# NOINLINE orInteger #-}
+orInteger :: Integer -> Integer -> Integer
+Naught     `orInteger` (!i)       = i
+(!i)       `orInteger` Naught     = i
+Positive x `orInteger` Positive y = Positive (x `orDigits` y)
+{-
+x | -y = - (twosComplement (x | twosComplement y))
+       = - (twosComplement !(!x & !(twosComplement y)))
+       = - (twosComplement !(!x & !(!y + 1)))
+       = - (twosComplement !(!x & (y - 1)))
+       = - ((!x & (y - 1)) + 1)
+-}
+Positive x `orInteger` Negative y = let x' = flipBits x
+                                        y' = y `minusPositive` onePositive
+                                        z = x' `andDigitsOnes` y'
+                                        z' = succPositive z
+                                    in digitsToNegativeInteger z'
+Negative x `orInteger` Positive y = Positive y `orInteger` Negative x
+{-
+-x | -y = - (twosComplement (twosComplement x | twosComplement y))
+        = - (twosComplement !(!(twosComplement x) & !(twosComplement y)))
+        = - (twosComplement !(!(!x + 1) & !(!y + 1)))
+        = - (twosComplement !((x - 1) & (y - 1)))
+        = - (((x - 1) & (y - 1)) + 1)
+-}
+Negative x `orInteger` Negative y = let x' = x `minusPositive` onePositive
+                                        y' = y `minusPositive` onePositive
+                                        z = x' `andDigits` y'
+                                        z' = succPositive z
+                                    in digitsToNegativeInteger z'
+
+{-# NOINLINE xorInteger #-}
+xorInteger :: Integer -> Integer -> Integer
+Naught     `xorInteger` (!i)       = i
+(!i)       `xorInteger` Naught     = i
+Positive x `xorInteger` Positive y = digitsToInteger (x `xorDigits` y)
+{-
+x ^ -y = - (twosComplement (x ^ twosComplement y))
+       = - (twosComplement !(x ^ !(twosComplement y)))
+       = - (twosComplement !(x ^ !(!y + 1)))
+       = - (twosComplement !(x ^ (y - 1)))
+       = - ((x ^ (y - 1)) + 1)
+-}
+Positive x `xorInteger` Negative y = let y' = y `minusPositive` onePositive
+                                         z = x `xorDigits` y'
+                                         z' = succPositive z
+                                     in digitsToNegativeInteger z'
+Negative x `xorInteger` Positive y = Positive y `xorInteger` Negative x
+{-
+-x ^ -y = twosComplement x ^ twosComplement y
+        = (!x + 1) ^ (!y + 1)
+        = (!x + 1) ^ (!y + 1)
+        = !(!x + 1) ^ !(!y + 1)
+        = (x - 1) ^ (y - 1)
+-}
+Negative x `xorInteger` Negative y = let x' = x `minusPositive` onePositive
+                                         y' = y `minusPositive` onePositive
+                                         z = x' `xorDigits` y'
+                                     in digitsToInteger z
+
+{-# NOINLINE complementInteger #-}
+complementInteger :: Integer -> Integer
+complementInteger x = negativeOneInteger `minusInteger` x
+
+{-# NOINLINE shiftLInteger #-}
+shiftLInteger :: Integer -> Int# -> Integer
+shiftLInteger (Positive p) i = Positive (shiftLPositive p i)
+shiftLInteger (Negative n) i = Negative (shiftLPositive n i)
+shiftLInteger Naught       _ = Naught
+
+{-# NOINLINE shiftRInteger #-}
+shiftRInteger :: Integer -> Int# -> Integer
+shiftRInteger (Positive p)   i = shiftRPositive p i
+shiftRInteger j@(Negative _) i
+    = complementInteger (shiftRInteger (complementInteger j) i)
+shiftRInteger Naught         _ = Naught
+
+-- XXX this could be a lot more efficient, but this is a quick
+-- reimplementation of the default Data.Bits instance, so that we can
+-- implement the Integer interface
+testBitInteger :: Integer -> Int# -> Bool
+testBitInteger x i = (x `andInteger` (oneInteger `shiftLInteger` i))
+        `neqInteger` Naught
+
+twosComplementPositive :: Positive -> DigitsOnes
+twosComplementPositive p = flipBits (p `minusPositive` onePositive)
+
+flipBits :: Digits -> DigitsOnes
+flipBits ds = DigitsOnes (flipBitsDigits ds)
+
+flipBitsDigits :: Digits -> Digits
+flipBitsDigits None = None
+flipBitsDigits (Some w ws) = Some (not# w) (flipBitsDigits ws)
+
+{-# NOINLINE negateInteger #-}
+negateInteger :: Integer -> Integer
+negateInteger (Positive p) = Negative p
+negateInteger (Negative p) = Positive p
+negateInteger Naught       = Naught
+
+-- Note [Avoid patError]
+{-# NOINLINE plusInteger #-}
+plusInteger :: Integer -> Integer -> Integer
+Positive p1    `plusInteger` Positive p2 = Positive (p1 `plusPositive` p2)
+Negative p1    `plusInteger` Negative p2 = Negative (p1 `plusPositive` p2)
+Positive p1    `plusInteger` Negative p2
+    = case p1 `comparePositive` p2 of
+      GT -> Positive (p1 `minusPositive` p2)
+      EQ -> Naught
+      LT -> Negative (p2 `minusPositive` p1)
+Negative p1    `plusInteger` Positive p2
+    = Positive p2 `plusInteger` Negative p1
+Naught         `plusInteger` Naught         = Naught
+Naught         `plusInteger` i@(Positive _) = i
+Naught         `plusInteger` i@(Negative _) = i
+i@(Positive _) `plusInteger` Naught         = i
+i@(Negative _) `plusInteger` Naught         = i
+
+{-# NOINLINE minusInteger #-}
+minusInteger :: Integer -> Integer -> Integer
+i1 `minusInteger` i2 = i1 `plusInteger` negateInteger i2
+
+{-# NOINLINE timesInteger #-}
+timesInteger :: Integer -> Integer -> Integer
+Positive p1 `timesInteger` Positive p2 = Positive (p1 `timesPositive` p2)
+Negative p1 `timesInteger` Negative p2 = Positive (p1 `timesPositive` p2)
+Positive p1 `timesInteger` Negative p2 = Negative (p1 `timesPositive` p2)
+Negative p1 `timesInteger` Positive p2 = Negative (p1 `timesPositive` p2)
+(!_)        `timesInteger` (!_)        = Naught
+
+{-# NOINLINE divModInteger #-}
+divModInteger :: Integer -> Integer -> (# Integer, Integer #)
+n `divModInteger` d =
+    case n `quotRemInteger` d of
+        (# q, r #) ->
+            if signumInteger r `eqInteger`
+               negateInteger (signumInteger d)
+            then (# q `minusInteger` oneInteger, r `plusInteger` d #)
+            else (# q, r #)
+
+{-# NOINLINE divInteger #-}
+divInteger :: Integer -> Integer -> Integer
+n `divInteger` d = quotient
+    where (# quotient, _ #) = n `divModInteger` d
+
+{-# NOINLINE modInteger #-}
+modInteger :: Integer -> Integer -> Integer
+n `modInteger` d = modulus
+    where (# _, modulus #) = n `divModInteger` d
+
+{-# NOINLINE quotRemInteger #-}
+quotRemInteger :: Integer -> Integer -> (# Integer, Integer #)
+Naught      `quotRemInteger` (!_)        = (# Naught, Naught #)
+(!_)        `quotRemInteger` Naught
+    = (# errorInteger, errorInteger #) -- XXX Can't happen
+-- XXX _            `quotRemInteger` Naught     = error "Division by zero"
+Positive p1 `quotRemInteger` Positive p2 = p1 `quotRemPositive` p2
+Negative p1 `quotRemInteger` Positive p2 = case p1 `quotRemPositive` p2 of
+                                           (# q, r #) ->
+                                               (# negateInteger q,
+                                                  negateInteger r #)
+Positive p1 `quotRemInteger` Negative p2 = case p1 `quotRemPositive` p2 of
+                                           (# q, r #) ->
+                                               (# negateInteger q, r #)
+Negative p1 `quotRemInteger` Negative p2 = case p1 `quotRemPositive` p2 of
+                                           (# q, r #) ->
+                                               (# q, negateInteger r #)
+
+{-# NOINLINE quotInteger #-}
+quotInteger :: Integer -> Integer -> Integer
+x `quotInteger` y = case x `quotRemInteger` y of
+                    (# q, _ #) -> q
+
+{-# NOINLINE remInteger #-}
+remInteger :: Integer -> Integer -> Integer
+x `remInteger` y = case x `quotRemInteger` y of
+                   (# _, r #) -> r
+
+{-# NOINLINE compareInteger #-}
+compareInteger :: Integer -> Integer -> Ordering
+Positive x `compareInteger` Positive y = x `comparePositive` y
+Positive _ `compareInteger` (!_)       = GT
+Naught     `compareInteger` Naught     = EQ
+Naught     `compareInteger` Negative _ = GT
+Negative x `compareInteger` Negative y = y `comparePositive` x
+(!_)       `compareInteger` (!_)       = LT
+
+{-# NOINLINE eqInteger# #-}
+eqInteger# :: Integer -> Integer -> Int#
+x `eqInteger#` y = case x `compareInteger` y of
+                        EQ -> 1#
+                        _  -> 0#
+
+{-# NOINLINE neqInteger# #-}
+neqInteger# :: Integer -> Integer -> Int#
+x `neqInteger#` y = case x `compareInteger` y of
+                         EQ -> 0#
+                         _  -> 1#
+
+{-# INLINE eqInteger  #-}
+{-# INLINE neqInteger #-}
+eqInteger, neqInteger :: Integer -> Integer -> Bool
+eqInteger  a b = isTrue# (a `eqInteger#`  b)
+neqInteger a b = isTrue# (a `neqInteger#` b)
+
+instance  Eq Integer  where
+    (==) = eqInteger
+    (/=) = neqInteger
+
+{-# NOINLINE ltInteger# #-}
+ltInteger# :: Integer -> Integer -> Int#
+x `ltInteger#` y = case x `compareInteger` y of
+                        LT -> 1#
+                        _  -> 0#
+
+{-# NOINLINE gtInteger# #-}
+gtInteger# :: Integer -> Integer -> Int#
+x `gtInteger#` y = case x `compareInteger` y of
+                        GT -> 1#
+                        _  -> 0#
+
+{-# NOINLINE leInteger# #-}
+leInteger# :: Integer -> Integer -> Int#
+x `leInteger#` y = case x `compareInteger` y of
+                        GT -> 0#
+                        _  -> 1#
+
+{-# NOINLINE geInteger# #-}
+geInteger# :: Integer -> Integer -> Int#
+x `geInteger#` y = case x `compareInteger` y of
+                        LT -> 0#
+                        _  -> 1#
+
+{-# INLINE leInteger #-}
+{-# INLINE ltInteger #-}
+{-# INLINE geInteger #-}
+{-# INLINE gtInteger #-}
+leInteger, gtInteger, ltInteger, geInteger :: Integer -> Integer -> Bool
+leInteger a b = isTrue# (a `leInteger#` b)
+gtInteger a b = isTrue# (a `gtInteger#` b)
+ltInteger a b = isTrue# (a `ltInteger#` b)
+geInteger a b = isTrue# (a `geInteger#` b)
+
+instance Ord Integer where
+    (<=) = leInteger
+    (>)  = gtInteger
+    (<)  = ltInteger
+    (>=) = geInteger
+    compare = compareInteger
+
+{-# NOINLINE absInteger #-}
+absInteger :: Integer -> Integer
+absInteger (Negative x) = Positive x
+absInteger x = x
+
+{-# NOINLINE signumInteger #-}
+signumInteger :: Integer -> Integer
+signumInteger (Negative _) = negativeOneInteger
+signumInteger Naught       = Naught
+signumInteger (Positive _) = oneInteger
+
+{-# NOINLINE hashInteger #-}
+hashInteger :: Integer -> Int#
+hashInteger = integerToInt
+
+-------------------------------------------------------------------
+-- The hard work is done on positive numbers
+
+onePositive :: Positive
+onePositive = Some 1## None
+
+halfBoundUp, fullBound :: () -> Digit
+lowHalfMask :: () -> Digit
+highHalfShift :: () -> Int#
+twoToTheThirtytwoPositive :: Positive
+#if WORD_SIZE_IN_BITS == 64
+halfBoundUp   () = 0x8000000000000000##
+fullBound     () = 0xFFFFFFFFFFFFFFFF##
+lowHalfMask   () = 0xFFFFFFFF##
+highHalfShift () = 32#
+twoToTheThirtytwoPositive = Some 0x100000000## None
+#elif WORD_SIZE_IN_BITS == 32
+halfBoundUp   () = 0x80000000##
+fullBound     () = 0xFFFFFFFF##
+lowHalfMask   () = 0xFFFF##
+highHalfShift () = 16#
+twoToTheThirtytwoPositive = Some 0## (Some 1## None)
+#else
+#error Unhandled WORD_SIZE_IN_BITS
+#endif
+
+digitsMaybeZeroToInteger :: Digits -> Integer
+digitsMaybeZeroToInteger None = Naught
+digitsMaybeZeroToInteger ds = Positive ds
+
+digitsToInteger :: Digits -> Integer
+digitsToInteger ds = case removeZeroTails ds of
+                     None -> Naught
+                     ds' -> Positive ds'
+
+digitsToNegativeInteger :: Digits -> Integer
+digitsToNegativeInteger ds = case removeZeroTails ds of
+                             None -> Naught
+                             ds' -> Negative ds'
+
+removeZeroTails :: Digits -> Digits
+removeZeroTails (Some w ds) = if isTrue# (w `eqWord#` 0##)
+                              then case removeZeroTails ds of
+                                   None -> None
+                                   ds' -> Some w ds'
+                              else Some w (removeZeroTails ds)
+removeZeroTails None = None
+
+#if WORD_SIZE_IN_BITS < 64
+word64ToPositive :: Word64# -> Positive
+word64ToPositive w
+ = if isTrue# (w `eqWord64#` wordToWord64# 0##)
+   then None
+   else Some (word64ToWord# w) (word64ToPositive (w `uncheckedShiftRL64#` 32#))
+
+positiveToWord64 :: Positive -> Word64#
+positiveToWord64 None = wordToWord64# 0## -- XXX Can't happen
+positiveToWord64 (Some w None) = wordToWord64# w
+positiveToWord64 (Some low (Some high _))
+    = wordToWord64# low `or64#` (wordToWord64# high `uncheckedShiftL64#` 32#)
+#endif
+
+-- Note [Avoid patError]
+comparePositive :: Positive -> Positive -> Ordering
+Some x xs `comparePositive` Some y ys = case xs `comparePositive` ys of
+                                        EQ ->      if isTrue# (x `ltWord#` y) then LT
+                                              else if isTrue# (x `gtWord#` y) then GT
+                                              else                                 EQ
+                                        res -> res
+None      `comparePositive` None      = EQ
+(Some {}) `comparePositive` None      = GT
+None      `comparePositive` (Some {}) = LT
+
+plusPositive :: Positive -> Positive -> Positive
+plusPositive x0 y0 = addWithCarry 0## x0 y0
+ where -- digit `elem` [0, 1]
+       -- Note [Avoid patError]
+       addWithCarry :: Digit -> Positive -> Positive -> Positive
+       addWithCarry c None            None            = addOnCarry c None
+       addWithCarry c xs@(Some {})    None            = addOnCarry c xs
+       addWithCarry c None            ys@(Some {})    = addOnCarry c ys
+       addWithCarry c xs@(Some x xs') ys@(Some y ys')
+        = if isTrue# (x `ltWord#` y) then addWithCarry c ys xs
+          -- Now x >= y
+          else if isTrue# (y `geWord#` halfBoundUp ())
+               -- So they are both at least halfBoundUp, so we subtract
+               -- halfBoundUp from each and thus carry 1
+               then case x `minusWord#` halfBoundUp () of
+                    x' ->
+                     case y `minusWord#` halfBoundUp () of
+                     y' ->
+                      case x' `plusWord#` y' `plusWord#` c of
+                      this ->
+                       Some this withCarry
+          else if isTrue# (x `geWord#` halfBoundUp ())
+               then case x `minusWord#` halfBoundUp () of
+                    x' ->
+                     case x' `plusWord#` y `plusWord#` c of
+                     z ->
+                      -- We've taken off halfBoundUp, so now we need to
+                      -- add it back on
+                      if isTrue# (z `ltWord#` halfBoundUp ())
+                       then Some (z `plusWord#`  halfBoundUp ()) withoutCarry
+                       else Some (z `minusWord#` halfBoundUp ()) withCarry
+          else Some (x `plusWord#` y `plusWord#` c) withoutCarry
+           where withCarry    = addWithCarry 1## xs' ys'
+                 withoutCarry = addWithCarry 0## xs' ys'
+
+       -- digit `elem` [0, 1]
+       addOnCarry :: Digit -> Positive -> Positive
+       addOnCarry (!c) (!ws) = if isTrue# (c `eqWord#` 0##)
+                               then ws
+                               else succPositive ws
+
+-- digit `elem` [0, 1]
+succPositive :: Positive -> Positive
+succPositive None = Some 1## None
+succPositive (Some w ws) = if isTrue# (w `eqWord#` fullBound ())
+                           then Some 0## (succPositive ws)
+                           else Some (w `plusWord#` 1##) ws
+
+-- Requires x > y
+-- In recursive calls, x >= y and x == y => result is None
+-- Note [Avoid patError]
+minusPositive :: Positive -> Positive -> Positive
+Some x xs `minusPositive` Some y ys
+ = if isTrue# (x `eqWord#` y)
+   then case xs `minusPositive` ys of
+        None -> None
+        s -> Some 0## s
+   else if isTrue# (x `gtWord#` y) then
+        Some (x `minusWord#` y) (xs `minusPositive` ys)
+   else case (fullBound () `minusWord#` y) `plusWord#` 1## of
+        z -> -- z = 2^n - y, calculated without overflow
+         case z `plusWord#` x of
+         z' -> -- z = 2^n + (x - y), calculated without overflow
+          Some z' ((xs `minusPositive` ys) `minusPositive` onePositive)
+xs@(Some {}) `minusPositive` None      = xs
+None         `minusPositive` None      = None
+None         `minusPositive` (Some {}) = errorPositive -- XXX Can't happen
+-- XXX None `minusPositive` _ = error "minusPositive: Requirement x > y not met"
+
+-- Note [Avoid patError]
+timesPositive :: Positive -> Positive -> Positive
+-- XXX None's can't happen here:
+None            `timesPositive` None        = errorPositive
+None            `timesPositive` (Some {})   = errorPositive
+(Some {})       `timesPositive` None        = errorPositive
+-- x and y are the last digits in Positive numbers, so are not 0:
+xs@(Some x xs') `timesPositive` ys@(Some y ys')
+ = case xs' of
+   None ->
+       case ys' of
+           None ->
+               x `timesDigit` y
+           Some {} ->
+               ys `timesPositive` xs
+   Some {} ->
+       case ys' of
+       None ->
+           -- y is the last digit in a Positive number, so is not 0.
+           let zs = Some 0## (xs' `timesPositive` ys)
+           in -- We could actually skip this test, and everything would
+              -- turn out OK. We already play tricks like that in timesPositive.
+              if isTrue# (x `eqWord#` 0##)
+              then zs
+              else (x `timesDigit` y) `plusPositive` zs
+       Some {} ->
+           (Some x None `timesPositive` ys) `plusPositive`
+           Some 0## (xs' `timesPositive` ys)
+
+{-
+-- Requires arguments /= 0
+Suppose we have 2n bits in a Word. Then
+    x = 2^n xh + xl
+    y = 2^n yh + yl
+    x * y = (2^n xh + xl) * (2^n yh + yl)
+          = 2^(2n) (xh yh)
+          + 2^n    (xh yl)
+          + 2^n    (xl yh)
+          +        (xl yl)
+                   ~~~~~~~ - all fit in 2n bits
+-}
+timesDigit :: Digit -> Digit -> Positive
+timesDigit (!x) (!y)
+ = case splitHalves x of
+   (# xh, xl #) ->
+    case splitHalves y of
+    (# yh, yl #) ->
+     case xh `timesWord#` yh of
+     xhyh ->
+      case splitHalves (xh `timesWord#` yl) of
+      (# xhylh, xhyll #) ->
+       case xhyll `uncheckedShiftL#` highHalfShift () of
+       xhyll' ->
+        case splitHalves (xl `timesWord#` yh) of
+        (# xlyhh, xlyhl #) ->
+         case xlyhl `uncheckedShiftL#` highHalfShift () of
+         xlyhl' ->
+          case xl `timesWord#` yl of
+          xlyl ->
+           -- Add up all the high word results. As the result fits in
+           -- 4n bits this can't overflow.
+           case xhyh `plusWord#` xhylh `plusWord#` xlyhh of
+           high ->
+           -- low: xhyll<<n + xlyhl<<n + xlyl
+            -- From this point we might make (Some 0 None), but we know
+            -- that the final result will be positive and the addition
+            -- will work out OK, so everything will work out in the end.
+            -- One thing we do need to be careful of is avoiding returning
+            -- Some 0 (Some 0 None) + Some n None, as this will result in
+            -- Some n (Some 0 None) instead of Some n None.
+            let low = Some xhyll' None `plusPositive`
+                      Some xlyhl' None `plusPositive`
+                      Some xlyl   None
+            in if isTrue# (high `eqWord#` 0##)
+               then low
+               else Some 0## (Some high None) `plusPositive` low
+
+splitHalves :: Digit -> (# {- High -} Digit, {- Low -} Digit #)
+splitHalves (!x) = (# x `uncheckedShiftRL#` highHalfShift (),
+                      x `and#` lowHalfMask () #)
+
+-- Assumes 0 <= i
+shiftLPositive :: Positive -> Int# -> Positive
+shiftLPositive p i
+    = if isTrue# (i >=# WORD_SIZE_IN_BITS#)
+      then shiftLPositive (Some 0## p) (i -# WORD_SIZE_IN_BITS#)
+      else smallShiftLPositive p i
+
+-- Assumes 0 <= i < WORD_SIZE_IN_BITS#
+smallShiftLPositive :: Positive -> Int# -> Positive
+smallShiftLPositive (!p) 0# = p
+smallShiftLPositive (!p) (!i) =
+    case WORD_SIZE_IN_BITS# -# i of
+    j -> let f carry None = if isTrue# (carry `eqWord#` 0##)
+                            then None
+                            else Some carry None
+             f carry (Some w ws) = case w `uncheckedShiftRL#` j of
+                                   carry' ->
+                                    case w `uncheckedShiftL#` i of
+                                    me ->
+                                     Some (me `or#` carry) (f carry' ws)
+         in f 0## p
+
+-- Assumes 0 <= i
+shiftRPositive :: Positive -> Int# -> Integer
+shiftRPositive None _ = Naught
+shiftRPositive p@(Some _ q) i
+    = if isTrue# (i >=# WORD_SIZE_IN_BITS#)
+      then shiftRPositive q (i -# WORD_SIZE_IN_BITS#)
+      else smallShiftRPositive p i
+
+-- Assumes 0 <= i < WORD_SIZE_IN_BITS#
+smallShiftRPositive :: Positive -> Int# -> Integer
+smallShiftRPositive (!p) (!i) =
+    if isTrue# (i ==# 0#)
+    then Positive p
+    else case smallShiftLPositive p (WORD_SIZE_IN_BITS# -# i) of
+         Some _ p'@(Some _ _) -> Positive p'
+         _                    -> Naught
+
+-- Long division
+quotRemPositive :: Positive -> Positive -> (# Integer, Integer #)
+(!xs) `quotRemPositive` (!ys)
+    = case f xs of
+      (# d, m #) -> (# digitsMaybeZeroToInteger d,
+                       digitsMaybeZeroToInteger m #)
+    where
+          subtractors :: Positives
+          subtractors = mkSubtractors (WORD_SIZE_IN_BITS# -# 1#)
+
+          mkSubtractors (!n) = if isTrue# (n ==# 0#)
+                               then Cons ys Nil
+                               else Cons (ys `smallShiftLPositive` n)
+                                         (mkSubtractors (n -# 1#))
+
+          -- The main function. Go the the end of xs, then walk
+          -- back trying to divide the number we accumulate by ys.
+          f :: Positive -> (# Digits, Digits #)
+          f None = (# None, None #)
+          f (Some z zs)
+              = case f zs of
+                (# ds, m #) ->
+                    let -- We need to avoid making (Some Zero None) here
+                        m' = some z m
+                    in case g 0## subtractors m' of
+                       (# d, m'' #) ->
+                        (# some d ds, m'' #)
+
+          g :: Digit -> Positives -> Digits -> (# Digit, Digits #)
+          g (!d) Nil             (!m) = (# d, m #)
+          g (!d) (Cons sub subs) (!m)
+              = case d `uncheckedShiftL#` 1# of
+                d' ->
+                 case m `comparePositive` sub of
+                 LT -> g d' subs m
+                 _  -> g (d' `plusWord#` 1##)
+                         subs
+                         (m `minusPositive` sub)
+
+some :: Digit -> Digits -> Digits
+some (!w) None  = if isTrue# (w `eqWord#` 0##) then None else Some w None
+some (!w) (!ws) = Some w ws
+
+-- Note [Avoid patError]
+andDigits :: Digits -> Digits -> Digits
+andDigits None          None          = None
+andDigits (Some {})     None          = None
+andDigits None          (Some {})     = None
+andDigits (Some w1 ws1) (Some w2 ws2) = Some (w1 `and#` w2) (andDigits ws1 ws2)
+
+-- DigitsOnes is just like Digits, only None is really 0xFFFFFFF...,
+-- i.e. ones off to infinity. This makes sense when we want to "and"
+-- a DigitOnes with a Digits, as the latter will bound the size of the
+-- result.
+newtype DigitsOnes = DigitsOnes Digits
+
+-- Note [Avoid patError]
+andDigitsOnes :: DigitsOnes -> Digits -> Digits
+andDigitsOnes (DigitsOnes None)          None          = None
+andDigitsOnes (DigitsOnes None)          ws2@(Some {}) = ws2
+andDigitsOnes (DigitsOnes (Some {}))     None          = None
+andDigitsOnes (DigitsOnes (Some w1 ws1)) (Some w2 ws2)
+    = Some (w1 `and#` w2) (andDigitsOnes (DigitsOnes ws1) ws2)
+
+-- Note [Avoid patError]
+orDigits :: Digits -> Digits -> Digits
+orDigits None          None          = None
+orDigits None          ds@(Some {})  = ds
+orDigits ds@(Some {})  None          = ds
+orDigits (Some w1 ds1) (Some w2 ds2) = Some (w1 `or#` w2) (orDigits ds1 ds2)
+
+-- Note [Avoid patError]
+xorDigits :: Digits -> Digits -> Digits
+xorDigits None          None          = None
+xorDigits None          ds@(Some {})  = ds
+xorDigits ds@(Some {})  None          = ds
+xorDigits (Some w1 ds1) (Some w2 ds2) = Some (w1 `xor#` w2) (xorDigits ds1 ds2)
+
+-- XXX We'd really like word2Double# for this
+doubleFromPositive :: Positive -> Double#
+doubleFromPositive None = 0.0##
+doubleFromPositive (Some w ds)
+    = case splitHalves w of
+      (# h, l #) ->
+       (doubleFromPositive ds *## (2.0## **## WORD_SIZE_IN_BITS_FLOAT##))
+       +## (int2Double# (word2Int# h) *##
+              (2.0## **## int2Double# (highHalfShift ())))
+       +## int2Double# (word2Int# l)
+
+-- XXX We'd really like word2Float# for this
+floatFromPositive :: Positive -> Float#
+floatFromPositive None = 0.0#
+floatFromPositive (Some w ds)
+    = case splitHalves w of
+      (# h, l #) ->
+       (floatFromPositive ds `timesFloat#` (2.0# `powerFloat#` WORD_SIZE_IN_BITS_FLOAT#))
+       `plusFloat#` (int2Float# (word2Int# h) `timesFloat#`
+             (2.0# `powerFloat#` int2Float# (highHalfShift ())))
+       `plusFloat#` int2Float# (word2Int# l)
+
+#endif
+
+{-
+Note [Avoid patError]
+
+If we use the natural set of definitions for functions, e.g.:
+
+    orDigits None          ds            = ds
+    orDigits ds            None          = ds
+    orDigits (Some w1 ds1) (Some w2 ds2) = Some ... ...
+
+then GHC may not be smart enough (especially when compiling with -O0)
+to see that all the cases are handled, and will thus insert calls to
+base:Control.Exception.Base.patError. But we are below base in the
+package hierarchy, so this causes build failure!
+
+We therefore help GHC out, by being more explicit about what all the
+cases are:
+
+    orDigits None          None          = None
+    orDigits None          ds@(Some {})  = ds
+    orDigits ds@(Some {})  None          = ds
+    orDigits (Some w1 ds1) (Some w2 ds2) = Some ... ...
+-}
+
diff --git a/libraries/integer-simple/LICENSE b/libraries/integer-simple/LICENSE
new file mode 100644
index 000000000000..7b87ed8855af
--- /dev/null
+++ b/libraries/integer-simple/LICENSE
@@ -0,0 +1,26 @@
+Copyright (c) Ian Lynagh, 2007-2008.
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions
+are met:
+1. Redistributions of source code must retain the above copyright
+   notice, this list of conditions and the following disclaimer.
+2. Redistributions in binary form must reproduce the above copyright
+   notice, this list of conditions and the following disclaimer in the
+   documentation and/or other materials provided with the distribution.
+3. Neither the name of the author nor the names of its contributors
+   may be used to endorse or promote products derived from this software
+   without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+SUCH DAMAGE.
diff --git a/libraries/integer-simple/Setup.hs b/libraries/integer-simple/Setup.hs
new file mode 100644
index 000000000000..6fa548caf71c
--- /dev/null
+++ b/libraries/integer-simple/Setup.hs
@@ -0,0 +1,6 @@
+module Main (main) where
+
+import Distribution.Simple
+
+main :: IO ()
+main = defaultMain
diff --git a/libraries/integer-simple/integer-simple.cabal b/libraries/integer-simple/integer-simple.cabal
new file mode 100644
index 000000000000..d18a18201294
--- /dev/null
+++ b/libraries/integer-simple/integer-simple.cabal
@@ -0,0 +1,31 @@
+name:           integer-simple
+version:        0.1.1.0
+-- GHC 7.6.1 released with 0.1.0.1
+license:        BSD3
+license-file:   LICENSE
+maintainer:     igloo@earth.li
+synopsis:       Simple Integer library
+description:
+    This package contains an simple Integer library.
+cabal-version:  >=1.10
+build-type: Simple
+
+source-repository head
+    type:     git
+    location: http://git.haskell.org/ghc.git
+    subdir:   libraries/integer-simple
+
+Library
+    default-language: Haskell2010
+
+    build-depends: ghc-prim
+    exposed-modules: GHC.Integer
+                     GHC.Integer.Simple.Internals
+                     GHC.Integer.Logarithms
+                     GHC.Integer.Logarithms.Internals
+    other-modules: GHC.Integer.Type
+    default-extensions: CPP, MagicHash, BangPatterns, UnboxedTuples,
+                UnliftedFFITypes, NoImplicitPrelude
+    -- We need to set the package name to integer-simple
+    -- (without a version number) as it's magic.
+    ghc-options: -this-package-key integer-simple -Wall
diff --git a/libraries/old-locale b/libraries/old-locale
new file mode 160000
index 000000000000..7e7f6722895a
--- /dev/null
+++ b/libraries/old-locale
@@ -0,0 +1 @@
+Subproject commit 7e7f6722895af36ca4e2f60f2fdfdc056b70db0b
diff --git a/libraries/old-time b/libraries/old-time
new file mode 160000
index 000000000000..e816d30ae8c6
--- /dev/null
+++ b/libraries/old-time
@@ -0,0 +1 @@
+Subproject commit e816d30ae8c64ccde2dde3063a7420abc922a0d4
diff --git a/libraries/parallel b/libraries/parallel
new file mode 160000
index 000000000000..8df9de914ea3
--- /dev/null
+++ b/libraries/parallel
@@ -0,0 +1 @@
+Subproject commit 8df9de914ea3ab7f47874e53b7e9d7c6af4d7f8e
diff --git a/libraries/primitive b/libraries/primitive
index 5ae8fbb8131c..be63ee15d961 160000
--- a/libraries/primitive
+++ b/libraries/primitive
@@ -1 +1 @@
-Subproject commit 5ae8fbb8131ccc934cadd29cc1d17298cfdaef4b
+Subproject commit be63ee15d961dc1b08bc8853b9ff97708551ef36
diff --git a/libraries/process b/libraries/process
new file mode 160000
index 000000000000..35bf51cb72ba
--- /dev/null
+++ b/libraries/process
@@ -0,0 +1 @@
+Subproject commit 35bf51cb72baaaeaad22fb340aa9d8c957d2186c
diff --git a/libraries/stm b/libraries/stm
new file mode 160000
index 000000000000..e8a901fddc88
--- /dev/null
+++ b/libraries/stm
@@ -0,0 +1 @@
+Subproject commit e8a901fddc88c6560af34e18a5201deeb8d51557
diff --git a/libraries/template-haskell/.gitignore b/libraries/template-haskell/.gitignore
new file mode 100644
index 000000000000..8f4d26768c89
--- /dev/null
+++ b/libraries/template-haskell/.gitignore
@@ -0,0 +1,3 @@
+GNUmakefile
+dist-install
+ghc.mk
diff --git a/libraries/template-haskell/LICENSE b/libraries/template-haskell/LICENSE
new file mode 100644
index 000000000000..6030e1d69cc7
--- /dev/null
+++ b/libraries/template-haskell/LICENSE
@@ -0,0 +1,33 @@
+
+The Glasgow Haskell Compiler License
+
+Copyright 2002-2007, The University Court of the University of Glasgow.
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+- Redistributions of source code must retain the above copyright notice,
+this list of conditions and the following disclaimer.
+
+- Redistributions in binary form must reproduce the above copyright notice,
+this list of conditions and the following disclaimer in the documentation
+and/or other materials provided with the distribution.
+
+- Neither name of the University nor the names of its contributors may be
+used to endorse or promote products derived from this software without
+specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
+GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
+DAMAGE.
+
diff --git a/libraries/template-haskell/Language/Haskell/TH.hs b/libraries/template-haskell/Language/Haskell/TH.hs
new file mode 100644
index 000000000000..29e3787bd0ed
--- /dev/null
+++ b/libraries/template-haskell/Language/Haskell/TH.hs
@@ -0,0 +1,148 @@
+{- | The public face of Template Haskell
+
+For other documentation, refer to:
+<http://www.haskell.org/haskellwiki/Template_Haskell>
+
+-}
+module Language.Haskell.TH(
+        -- * The monad and its operations
+        Q,
+        runQ,
+        -- ** Administration: errors, locations and IO
+        reportError,              -- :: String -> Q ()
+        reportWarning,            -- :: String -> Q ()
+        report,                   -- :: Bool -> String -> Q ()
+        recover,          -- :: Q a -> Q a -> Q a
+        location,         -- :: Q Loc
+        Loc(..),
+        runIO,            -- :: IO a -> Q a
+        -- ** Querying the compiler
+        -- *** Reify
+        reify,            -- :: Name -> Q Info
+        reifyModule,
+        thisModule,
+        Info(..), ModuleInfo(..),
+        InstanceDec,
+        ParentName,
+        Arity,
+        Unlifted,
+        -- *** Name lookup
+        lookupTypeName,  -- :: String -> Q (Maybe Name)
+        lookupValueName, -- :: String -> Q (Maybe Name)
+        -- *** Instance lookup
+        reifyInstances,
+        isInstance,
+        -- *** Roles lookup
+        reifyRoles,
+        -- *** Annotation lookup
+        reifyAnnotations, AnnLookup(..),
+
+        -- * Typed expressions
+        TExp, unType,
+
+        -- * Names
+        Name, NameSpace,	-- Abstract
+        -- ** Constructing names
+        mkName,         -- :: String -> Name
+        newName,        -- :: String -> Q Name
+        -- ** Deconstructing names
+        nameBase,	-- :: Name -> String
+        nameModule,	-- :: Name -> Maybe String
+        -- ** Built-in names
+        tupleTypeName, tupleDataName,	-- Int -> Name
+        unboxedTupleTypeName, unboxedTupleDataName, -- :: Int -> Name
+
+    -- * The algebraic data types
+    -- | The lowercase versions (/syntax operators/) of these constructors are
+    -- preferred to these constructors, since they compose better with
+    -- quotations (@[| |]@) and splices (@$( ... )@)
+
+    -- ** Declarations
+        Dec(..), Con(..), Clause(..),
+        Strict(..), Foreign(..), Callconv(..), Safety(..), Pragma(..),
+        Inline(..), RuleMatch(..), Phases(..), RuleBndr(..), AnnTarget(..),
+        FunDep(..), FamFlavour(..), TySynEqn(..),
+        Fixity(..), FixityDirection(..), defaultFixity, maxPrecedence,
+    -- ** Expressions
+        Exp(..), Match(..), Body(..), Guard(..), Stmt(..), Range(..), Lit(..),
+    -- ** Patterns
+        Pat(..), FieldExp, FieldPat,
+    -- ** Types
+        Type(..), TyVarBndr(..), TyLit(..), Kind, Cxt, Pred, Syntax.Role(..),
+
+    -- * Library functions
+    -- ** Abbreviations
+        InfoQ, ExpQ, DecQ, DecsQ, ConQ, TypeQ, TyLitQ, CxtQ, PredQ, MatchQ, ClauseQ,
+        BodyQ, GuardQ, StmtQ, RangeQ, StrictTypeQ, VarStrictTypeQ, PatQ, FieldPatQ,
+        RuleBndrQ, TySynEqnQ,
+
+    -- ** Constructors lifted to 'Q'
+    -- *** Literals
+        intPrimL, wordPrimL, floatPrimL, doublePrimL, integerL, rationalL,
+        charL, stringL, stringPrimL,
+    -- *** Patterns
+        litP, varP, tupP, conP, uInfixP, parensP, infixP,
+        tildeP, bangP, asP, wildP, recP,
+        listP, sigP, viewP,
+        fieldPat,
+
+    -- *** Pattern Guards
+        normalB, guardedB, normalG, normalGE, patG, patGE, match, clause,
+
+    -- *** Expressions
+        dyn, global, varE, conE, litE, appE, uInfixE, parensE,
+        infixE, infixApp, sectionL, sectionR,
+        lamE, lam1E, lamCaseE, tupE, condE, multiIfE, letE, caseE, appsE,
+        listE, sigE, recConE, recUpdE, stringE, fieldExp,
+    -- **** Ranges
+    fromE, fromThenE, fromToE, fromThenToE,
+
+    -- ***** Ranges with more indirection
+    arithSeqE,
+    fromR, fromThenR, fromToR, fromThenToR,
+    -- **** Statements
+    doE, compE,
+    bindS, letS, noBindS, parS,
+
+    -- *** Types
+        forallT, varT, conT, appT, arrowT, equalityT, listT, tupleT, sigT, litT,
+    promotedT, promotedTupleT, promotedNilT, promotedConsT,
+    -- **** Type literals
+    numTyLit, strTyLit,
+    -- **** Strictness
+        isStrict, notStrict, strictType, varStrictType,
+    -- **** Class Contexts
+    cxt, classP, equalP, normalC, recC, infixC, forallC,
+
+    -- *** Kinds
+    varK, conK, tupleK, arrowK, listK, appK, starK, constraintK,
+
+    -- *** Roles
+    nominalR, representationalR, phantomR, inferR,
+
+    -- *** Top Level Declarations
+    -- **** Data
+        valD, funD, tySynD, dataD, newtypeD,
+    -- **** Class
+    classD, instanceD, sigD,
+    -- **** Role annotations
+    roleAnnotD,
+    -- **** Type Family / Data Family
+    familyNoKindD, familyKindD, dataInstD,
+    closedTypeFamilyNoKindD, closedTypeFamilyKindD,
+    newtypeInstD, tySynInstD,
+    typeFam, dataFam, tySynEqn,
+    -- **** Foreign Function Interface (FFI)
+    cCall, stdCall, unsafe, safe, forImpD,
+    -- **** Pragmas
+    ruleVar, typedRuleVar,
+    pragInlD, pragSpecD, pragSpecInlD, pragSpecInstD, pragRuleD, pragAnnD,
+
+        -- * Pretty-printer
+    Ppr(..), pprint, pprExp, pprLit, pprPat, pprParendType
+
+   ) where
+
+import Language.Haskell.TH.Syntax as Syntax
+import Language.Haskell.TH.Lib
+import Language.Haskell.TH.Ppr
diff --git a/libraries/template-haskell/Language/Haskell/TH/Lib.hs b/libraries/template-haskell/Language/Haskell/TH/Lib.hs
new file mode 100644
index 000000000000..3ac16d1dba57
--- /dev/null
+++ b/libraries/template-haskell/Language/Haskell/TH/Lib.hs
@@ -0,0 +1,671 @@
+-- |
+-- TH.Lib contains lots of useful helper functions for
+-- generating and manipulating Template Haskell terms
+
+module Language.Haskell.TH.Lib where
+    -- All of the exports from this module should
+    -- be "public" functions.  The main module TH
+    -- re-exports them all.
+
+import Language.Haskell.TH.Syntax hiding (Role)
+import qualified Language.Haskell.TH.Syntax as TH
+import Control.Monad( liftM, liftM2 )
+import Data.Word( Word8 )
+
+----------------------------------------------------------
+-- * Type synonyms
+----------------------------------------------------------
+
+type InfoQ          = Q Info
+type PatQ           = Q Pat
+type FieldPatQ      = Q FieldPat
+type ExpQ           = Q Exp
+type TExpQ a        = Q (TExp a)
+type DecQ           = Q Dec
+type DecsQ          = Q [Dec]
+type ConQ           = Q Con
+type TypeQ          = Q Type
+type TyLitQ         = Q TyLit
+type CxtQ           = Q Cxt
+type PredQ          = Q Pred
+type MatchQ         = Q Match
+type ClauseQ        = Q Clause
+type BodyQ          = Q Body
+type GuardQ         = Q Guard
+type StmtQ          = Q Stmt
+type RangeQ         = Q Range
+type StrictTypeQ    = Q StrictType
+type VarStrictTypeQ = Q VarStrictType
+type FieldExpQ      = Q FieldExp
+type RuleBndrQ      = Q RuleBndr
+type TySynEqnQ      = Q TySynEqn
+type Role           = TH.Role       -- must be defined here for DsMeta to find it
+
+----------------------------------------------------------
+-- * Lowercase pattern syntax functions
+----------------------------------------------------------
+
+intPrimL    :: Integer -> Lit
+intPrimL    = IntPrimL
+wordPrimL    :: Integer -> Lit
+wordPrimL    = WordPrimL
+floatPrimL  :: Rational -> Lit
+floatPrimL  = FloatPrimL
+doublePrimL :: Rational -> Lit
+doublePrimL = DoublePrimL
+integerL    :: Integer -> Lit
+integerL    = IntegerL
+charL       :: Char -> Lit
+charL       = CharL
+stringL     :: String -> Lit
+stringL     = StringL
+stringPrimL :: [Word8] -> Lit
+stringPrimL = StringPrimL
+rationalL   :: Rational -> Lit
+rationalL   = RationalL
+
+litP :: Lit -> PatQ
+litP l = return (LitP l)
+varP :: Name -> PatQ
+varP v = return (VarP v)
+tupP :: [PatQ] -> PatQ
+tupP ps = do { ps1 <- sequence ps; return (TupP ps1)}
+unboxedTupP :: [PatQ] -> PatQ
+unboxedTupP ps = do { ps1 <- sequence ps; return (UnboxedTupP ps1)}
+conP :: Name -> [PatQ] -> PatQ
+conP n ps = do ps' <- sequence ps
+               return (ConP n ps')
+infixP :: PatQ -> Name -> PatQ -> PatQ
+infixP p1 n p2 = do p1' <- p1
+                    p2' <- p2
+                    return (InfixP p1' n p2')
+uInfixP :: PatQ -> Name -> PatQ -> PatQ
+uInfixP p1 n p2 = do p1' <- p1
+                     p2' <- p2
+                     return (UInfixP p1' n p2')
+parensP :: PatQ -> PatQ
+parensP p = do p' <- p
+               return (ParensP p')
+
+tildeP :: PatQ -> PatQ
+tildeP p = do p' <- p
+              return (TildeP p')
+bangP :: PatQ -> PatQ
+bangP p = do p' <- p
+             return (BangP p')
+asP :: Name -> PatQ -> PatQ
+asP n p = do p' <- p
+             return (AsP n p')
+wildP :: PatQ
+wildP = return WildP
+recP :: Name -> [FieldPatQ] -> PatQ
+recP n fps = do fps' <- sequence fps
+                return (RecP n fps')
+listP :: [PatQ] -> PatQ
+listP ps = do ps' <- sequence ps
+              return (ListP ps')
+sigP :: PatQ -> TypeQ -> PatQ
+sigP p t = do p' <- p
+              t' <- t
+              return (SigP p' t')
+viewP :: ExpQ -> PatQ -> PatQ
+viewP e p = do e' <- e
+               p' <- p
+               return (ViewP e' p')
+
+fieldPat :: Name -> PatQ -> FieldPatQ
+fieldPat n p = do p' <- p
+                  return (n, p')
+
+
+-------------------------------------------------------------------------------
+-- *   Stmt
+
+bindS :: PatQ -> ExpQ -> StmtQ
+bindS p e = liftM2 BindS p e
+
+letS :: [DecQ] -> StmtQ
+letS ds = do { ds1 <- sequence ds; return (LetS ds1) }
+
+noBindS :: ExpQ -> StmtQ
+noBindS e = do { e1 <- e; return (NoBindS e1) }
+
+parS :: [[StmtQ]] -> StmtQ
+parS sss = do { sss1 <- mapM sequence sss; return (ParS sss1) }
+
+-------------------------------------------------------------------------------
+-- *   Range
+
+fromR :: ExpQ -> RangeQ
+fromR x = do { a <- x; return (FromR a) }
+
+fromThenR :: ExpQ -> ExpQ -> RangeQ
+fromThenR x y = do { a <- x; b <- y; return (FromThenR a b) }
+
+fromToR :: ExpQ -> ExpQ -> RangeQ
+fromToR x y = do { a <- x; b <- y; return (FromToR a b) }
+
+fromThenToR :: ExpQ -> ExpQ -> ExpQ -> RangeQ
+fromThenToR x y z = do { a <- x; b <- y; c <- z;
+                         return (FromThenToR a b c) }
+-------------------------------------------------------------------------------
+-- *   Body
+
+normalB :: ExpQ -> BodyQ
+normalB e = do { e1 <- e; return (NormalB e1) }
+
+guardedB :: [Q (Guard,Exp)] -> BodyQ
+guardedB ges = do { ges' <- sequence ges; return (GuardedB ges') }
+
+-------------------------------------------------------------------------------
+-- *   Guard
+
+normalG :: ExpQ -> GuardQ
+normalG e = do { e1 <- e; return (NormalG e1) }
+
+normalGE :: ExpQ -> ExpQ -> Q (Guard, Exp)
+normalGE g e = do { g1 <- g; e1 <- e; return (NormalG g1, e1) }
+
+patG :: [StmtQ] -> GuardQ
+patG ss = do { ss' <- sequence ss; return (PatG ss') }
+
+patGE :: [StmtQ] -> ExpQ -> Q (Guard, Exp)
+patGE ss e = do { ss' <- sequence ss;
+		  e'  <- e;
+                  return (PatG ss', e') }
+
+-------------------------------------------------------------------------------
+-- *   Match and Clause
+
+-- | Use with 'caseE'
+match :: PatQ -> BodyQ -> [DecQ] -> MatchQ
+match p rhs ds = do { p' <- p;
+                      r' <- rhs;
+                      ds' <- sequence ds;
+                      return (Match p' r' ds') }
+
+-- | Use with 'funD'
+clause :: [PatQ] -> BodyQ -> [DecQ] -> ClauseQ
+clause ps r ds = do { ps' <- sequence ps;
+                      r' <- r;
+                      ds' <- sequence ds;
+                      return (Clause ps' r' ds') }
+
+
+---------------------------------------------------------------------------
+-- *   Exp
+
+-- | Dynamically binding a variable (unhygenic)
+dyn :: String -> ExpQ
+dyn s = return (VarE (mkName s))
+
+global :: Name -> ExpQ
+{-# DEPRECATED global "Use varE instead" #-}
+-- Trac #8656; I have no idea why this function is duplicated
+global s = return (VarE s)
+
+varE :: Name -> ExpQ
+varE s = return (VarE s)
+
+conE :: Name -> ExpQ
+conE s =  return (ConE s)
+
+litE :: Lit -> ExpQ
+litE c = return (LitE c)
+
+appE :: ExpQ -> ExpQ -> ExpQ
+appE x y = do { a <- x; b <- y; return (AppE a b)}
+
+parensE :: ExpQ -> ExpQ
+parensE x = do { x' <- x; return (ParensE x') }
+
+uInfixE :: ExpQ -> ExpQ -> ExpQ -> ExpQ
+uInfixE x s y = do { x' <- x; s' <- s; y' <- y;
+                     return (UInfixE x' s' y') }
+
+infixE :: Maybe ExpQ -> ExpQ -> Maybe ExpQ -> ExpQ
+infixE (Just x) s (Just y) = do { a <- x; s' <- s; b <- y;
+                                  return (InfixE (Just a) s' (Just b))}
+infixE Nothing  s (Just y) = do { s' <- s; b <- y;
+                                  return (InfixE Nothing s' (Just b))}
+infixE (Just x) s Nothing  = do { a <- x; s' <- s;
+                                  return (InfixE (Just a) s' Nothing)}
+infixE Nothing  s Nothing  = do { s' <- s; return (InfixE Nothing s' Nothing) }
+
+infixApp :: ExpQ -> ExpQ -> ExpQ -> ExpQ
+infixApp x y z = infixE (Just x) y (Just z)
+sectionL :: ExpQ -> ExpQ -> ExpQ
+sectionL x y = infixE (Just x) y Nothing
+sectionR :: ExpQ -> ExpQ -> ExpQ
+sectionR x y = infixE Nothing x (Just y)
+
+lamE :: [PatQ] -> ExpQ -> ExpQ
+lamE ps e = do ps' <- sequence ps
+               e' <- e
+               return (LamE ps' e')
+
+-- | Single-arg lambda
+lam1E :: PatQ -> ExpQ -> ExpQ
+lam1E p e = lamE [p] e
+
+lamCaseE :: [MatchQ] -> ExpQ
+lamCaseE ms = sequence ms >>= return . LamCaseE
+
+tupE :: [ExpQ] -> ExpQ
+tupE es = do { es1 <- sequence es; return (TupE es1)}
+
+unboxedTupE :: [ExpQ] -> ExpQ
+unboxedTupE es = do { es1 <- sequence es; return (UnboxedTupE es1)}
+
+condE :: ExpQ -> ExpQ -> ExpQ -> ExpQ
+condE x y z =  do { a <- x; b <- y; c <- z; return (CondE a b c)}
+
+multiIfE :: [Q (Guard, Exp)] -> ExpQ
+multiIfE alts = sequence alts >>= return . MultiIfE
+
+letE :: [DecQ] -> ExpQ -> ExpQ
+letE ds e = do { ds2 <- sequence ds; e2 <- e; return (LetE ds2 e2) }
+
+caseE :: ExpQ -> [MatchQ] -> ExpQ
+caseE e ms = do { e1 <- e; ms1 <- sequence ms; return (CaseE e1 ms1) }
+
+doE :: [StmtQ] -> ExpQ
+doE ss = do { ss1 <- sequence ss; return (DoE ss1) }
+
+compE :: [StmtQ] -> ExpQ
+compE ss = do { ss1 <- sequence ss; return (CompE ss1) }
+
+arithSeqE :: RangeQ -> ExpQ
+arithSeqE r = do { r' <- r; return (ArithSeqE r') }
+
+listE :: [ExpQ] -> ExpQ
+listE es = do { es1 <- sequence es; return (ListE es1) }
+
+sigE :: ExpQ -> TypeQ -> ExpQ
+sigE e t = do { e1 <- e; t1 <- t; return (SigE e1 t1) }
+
+recConE :: Name -> [Q (Name,Exp)] -> ExpQ
+recConE c fs = do { flds <- sequence fs; return (RecConE c flds) }
+
+recUpdE :: ExpQ -> [Q (Name,Exp)] -> ExpQ
+recUpdE e fs = do { e1 <- e; flds <- sequence fs; return (RecUpdE e1 flds) }
+
+stringE :: String -> ExpQ
+stringE = litE . stringL
+
+fieldExp :: Name -> ExpQ -> Q (Name, Exp)
+fieldExp s e = do { e' <- e; return (s,e') }
+
+-- ** 'arithSeqE' Shortcuts
+fromE :: ExpQ -> ExpQ
+fromE x = do { a <- x; return (ArithSeqE (FromR a)) }
+
+fromThenE :: ExpQ -> ExpQ -> ExpQ
+fromThenE x y = do { a <- x; b <- y; return (ArithSeqE (FromThenR a b)) }
+
+fromToE :: ExpQ -> ExpQ -> ExpQ
+fromToE x y = do { a <- x; b <- y; return (ArithSeqE (FromToR a b)) }
+
+fromThenToE :: ExpQ -> ExpQ -> ExpQ -> ExpQ
+fromThenToE x y z = do { a <- x; b <- y; c <- z;
+                         return (ArithSeqE (FromThenToR a b c)) }
+
+
+-------------------------------------------------------------------------------
+-- *   Dec
+
+valD :: PatQ -> BodyQ -> [DecQ] -> DecQ
+valD p b ds =
+  do { p' <- p
+     ; ds' <- sequence ds
+     ; b' <- b
+     ; return (ValD p' b' ds')
+     }
+
+funD :: Name -> [ClauseQ] -> DecQ
+funD nm cs =
+ do { cs1 <- sequence cs
+    ; return (FunD nm cs1)
+    }
+
+tySynD :: Name -> [TyVarBndr] -> TypeQ -> DecQ
+tySynD tc tvs rhs = do { rhs1 <- rhs; return (TySynD tc tvs rhs1) }
+
+dataD :: CxtQ -> Name -> [TyVarBndr] -> [ConQ] -> [Name] -> DecQ
+dataD ctxt tc tvs cons derivs =
+  do
+    ctxt1 <- ctxt
+    cons1 <- sequence cons
+    return (DataD ctxt1 tc tvs cons1 derivs)
+
+newtypeD :: CxtQ -> Name -> [TyVarBndr] -> ConQ -> [Name] -> DecQ
+newtypeD ctxt tc tvs con derivs =
+  do
+    ctxt1 <- ctxt
+    con1 <- con
+    return (NewtypeD ctxt1 tc tvs con1 derivs)
+
+classD :: CxtQ -> Name -> [TyVarBndr] -> [FunDep] -> [DecQ] -> DecQ
+classD ctxt cls tvs fds decs =
+  do
+    decs1 <- sequence decs
+    ctxt1 <- ctxt
+    return $ ClassD ctxt1 cls tvs fds decs1
+
+instanceD :: CxtQ -> TypeQ -> [DecQ] -> DecQ
+instanceD ctxt ty decs =
+  do
+    ctxt1 <- ctxt
+    decs1 <- sequence decs
+    ty1   <- ty
+    return $ InstanceD ctxt1 ty1 decs1
+
+sigD :: Name -> TypeQ -> DecQ
+sigD fun ty = liftM (SigD fun) $ ty
+
+forImpD :: Callconv -> Safety -> String -> Name -> TypeQ -> DecQ
+forImpD cc s str n ty
+ = do ty' <- ty
+      return $ ForeignD (ImportF cc s str n ty')
+
+infixLD :: Int -> Name -> DecQ
+infixLD prec nm = return (InfixD (Fixity prec InfixL) nm)
+
+infixRD :: Int -> Name -> DecQ
+infixRD prec nm = return (InfixD (Fixity prec InfixR) nm)
+
+infixND :: Int -> Name -> DecQ
+infixND prec nm = return (InfixD (Fixity prec InfixN) nm)
+
+pragInlD :: Name -> Inline -> RuleMatch -> Phases -> DecQ
+pragInlD name inline rm phases
+  = return $ PragmaD $ InlineP name inline rm phases
+
+pragSpecD :: Name -> TypeQ -> Phases -> DecQ
+pragSpecD n ty phases
+  = do
+      ty1    <- ty
+      return $ PragmaD $ SpecialiseP n ty1 Nothing phases
+
+pragSpecInlD :: Name -> TypeQ -> Inline -> Phases -> DecQ
+pragSpecInlD n ty inline phases
+  = do
+      ty1    <- ty
+      return $ PragmaD $ SpecialiseP n ty1 (Just inline) phases
+
+pragSpecInstD :: TypeQ -> DecQ
+pragSpecInstD ty
+  = do
+      ty1    <- ty
+      return $ PragmaD $ SpecialiseInstP ty1
+
+pragRuleD :: String -> [RuleBndrQ] -> ExpQ -> ExpQ -> Phases -> DecQ
+pragRuleD n bndrs lhs rhs phases
+  = do
+      bndrs1 <- sequence bndrs
+      lhs1   <- lhs
+      rhs1   <- rhs
+      return $ PragmaD $ RuleP n bndrs1 lhs1 rhs1 phases
+
+pragAnnD :: AnnTarget -> ExpQ -> DecQ
+pragAnnD target expr
+  = do
+      exp1 <- expr
+      return $ PragmaD $ AnnP target exp1
+
+familyNoKindD :: FamFlavour -> Name -> [TyVarBndr] -> DecQ
+familyNoKindD flav tc tvs = return $ FamilyD flav tc tvs Nothing
+
+familyKindD :: FamFlavour -> Name -> [TyVarBndr] -> Kind -> DecQ
+familyKindD flav tc tvs k = return $ FamilyD flav tc tvs (Just k)
+
+dataInstD :: CxtQ -> Name -> [TypeQ] -> [ConQ] -> [Name] -> DecQ
+dataInstD ctxt tc tys cons derivs =
+  do
+    ctxt1 <- ctxt
+    tys1  <- sequence tys
+    cons1 <- sequence cons
+    return (DataInstD ctxt1 tc tys1 cons1 derivs)
+
+newtypeInstD :: CxtQ -> Name -> [TypeQ] -> ConQ -> [Name] -> DecQ
+newtypeInstD ctxt tc tys con derivs =
+  do
+    ctxt1 <- ctxt
+    tys1  <- sequence tys
+    con1  <- con
+    return (NewtypeInstD ctxt1 tc tys1 con1 derivs)
+
+tySynInstD :: Name -> TySynEqnQ -> DecQ
+tySynInstD tc eqn =
+  do
+    eqn1 <- eqn
+    return (TySynInstD tc eqn1)
+
+closedTypeFamilyNoKindD :: Name -> [TyVarBndr] -> [TySynEqnQ] -> DecQ
+closedTypeFamilyNoKindD tc tvs eqns =
+  do
+    eqns1 <- sequence eqns
+    return (ClosedTypeFamilyD tc tvs Nothing eqns1)
+
+closedTypeFamilyKindD :: Name -> [TyVarBndr] -> Kind -> [TySynEqnQ] -> DecQ
+closedTypeFamilyKindD tc tvs kind eqns =
+  do
+    eqns1 <- sequence eqns
+    return (ClosedTypeFamilyD tc tvs (Just kind) eqns1)
+
+roleAnnotD :: Name -> [Role] -> DecQ
+roleAnnotD name roles = return $ RoleAnnotD name roles
+
+tySynEqn :: [TypeQ] -> TypeQ -> TySynEqnQ
+tySynEqn lhs rhs =
+  do
+    lhs1 <- sequence lhs
+    rhs1 <- rhs
+    return (TySynEqn lhs1 rhs1)
+
+cxt :: [PredQ] -> CxtQ
+cxt = sequence
+
+normalC :: Name -> [StrictTypeQ] -> ConQ
+normalC con strtys = liftM (NormalC con) $ sequence strtys
+
+recC :: Name -> [VarStrictTypeQ] -> ConQ
+recC con varstrtys = liftM (RecC con) $ sequence varstrtys
+
+infixC :: Q (Strict, Type) -> Name -> Q (Strict, Type) -> ConQ
+infixC st1 con st2 = do st1' <- st1
+                        st2' <- st2
+                        return $ InfixC st1' con st2'
+
+forallC :: [TyVarBndr] -> CxtQ -> ConQ -> ConQ
+forallC ns ctxt con = liftM2 (ForallC ns) ctxt con
+
+
+-------------------------------------------------------------------------------
+-- *   Type
+
+forallT :: [TyVarBndr] -> CxtQ -> TypeQ -> TypeQ
+forallT tvars ctxt ty = do
+    ctxt1 <- ctxt
+    ty1   <- ty
+    return $ ForallT tvars ctxt1 ty1
+
+varT :: Name -> TypeQ
+varT = return . VarT
+
+conT :: Name -> TypeQ
+conT = return . ConT
+
+appT :: TypeQ -> TypeQ -> TypeQ
+appT t1 t2 = do
+           t1' <- t1
+           t2' <- t2
+           return $ AppT t1' t2'
+
+arrowT :: TypeQ
+arrowT = return ArrowT
+
+listT :: TypeQ
+listT = return ListT
+
+litT :: TyLitQ -> TypeQ
+litT l = fmap LitT l
+
+tupleT :: Int -> TypeQ
+tupleT i = return (TupleT i)
+
+unboxedTupleT :: Int -> TypeQ
+unboxedTupleT i = return (UnboxedTupleT i)
+
+sigT :: TypeQ -> Kind -> TypeQ
+sigT t k
+  = do
+      t' <- t
+      return $ SigT t' k
+
+equalityT :: TypeQ
+equalityT = return EqualityT
+
+{-# DEPRECATED classP "As of template-haskell-2.10, constraint predicates (Pred) are just types (Type), in keeping with ConstraintKinds. Please use 'conT' and 'appT'." #-}
+classP :: Name -> [Q Type] -> Q Pred
+classP cla tys
+  = do
+      tysl <- sequence tys
+      return (foldl AppT (ConT cla) tysl)
+
+{-# DEPRECATED equalP "As of template-haskell-2.10, constraint predicates (Pred) are just types (Type), in keeping with ConstraintKinds. Please see 'equalityT'." #-}
+equalP :: TypeQ -> TypeQ -> PredQ
+equalP tleft tright
+  = do
+      tleft1  <- tleft
+      tright1 <- tright
+      eqT <- equalityT
+      return (foldl AppT eqT [tleft1, tright1])
+
+promotedT :: Name -> TypeQ
+promotedT = return . PromotedT
+
+promotedTupleT :: Int -> TypeQ
+promotedTupleT i = return (PromotedTupleT i)
+
+promotedNilT :: TypeQ
+promotedNilT = return PromotedNilT
+
+promotedConsT :: TypeQ
+promotedConsT = return PromotedConsT
+
+isStrict, notStrict, unpacked :: Q Strict
+isStrict = return $ IsStrict
+notStrict = return $ NotStrict
+unpacked = return Unpacked
+
+strictType :: Q Strict -> TypeQ -> StrictTypeQ
+strictType = liftM2 (,)
+
+varStrictType :: Name -> StrictTypeQ -> VarStrictTypeQ
+varStrictType v st = do (s, t) <- st
+                        return (v, s, t)
+
+-- * Type Literals
+
+numTyLit :: Integer -> TyLitQ
+numTyLit n = if n >= 0 then return (NumTyLit n)
+                       else fail ("Negative type-level number: " ++ show n)
+
+strTyLit :: String -> TyLitQ
+strTyLit s = return (StrTyLit s)
+
+
+
+-------------------------------------------------------------------------------
+-- *   Kind
+
+plainTV :: Name -> TyVarBndr
+plainTV = PlainTV
+
+kindedTV :: Name -> Kind -> TyVarBndr
+kindedTV = KindedTV
+
+varK :: Name -> Kind
+varK = VarT
+
+conK :: Name -> Kind
+conK = ConT
+
+tupleK :: Int -> Kind
+tupleK = TupleT
+
+arrowK :: Kind
+arrowK = ArrowT
+
+listK :: Kind
+listK = ListT
+
+appK :: Kind -> Kind -> Kind
+appK = AppT
+
+starK :: Kind
+starK = StarT
+
+constraintK :: Kind
+constraintK = ConstraintT
+
+-------------------------------------------------------------------------------
+-- *   Role
+
+nominalR, representationalR, phantomR, inferR :: Role
+nominalR          = NominalR
+representationalR = RepresentationalR
+phantomR          = PhantomR
+inferR            = InferR
+
+-------------------------------------------------------------------------------
+-- *   Callconv
+
+cCall, stdCall :: Callconv
+cCall = CCall
+stdCall = StdCall
+
+-------------------------------------------------------------------------------
+-- *   Safety
+
+unsafe, safe, interruptible :: Safety
+unsafe = Unsafe
+safe = Safe
+interruptible = Interruptible
+
+-------------------------------------------------------------------------------
+-- *   FunDep
+
+funDep :: [Name] -> [Name] -> FunDep
+funDep = FunDep
+
+-------------------------------------------------------------------------------
+-- *   FamFlavour
+
+typeFam, dataFam :: FamFlavour
+typeFam = TypeFam
+dataFam = DataFam
+
+-------------------------------------------------------------------------------
+-- *   RuleBndr
+ruleVar :: Name -> RuleBndrQ
+ruleVar = return . RuleVar
+
+typedRuleVar :: Name -> TypeQ -> RuleBndrQ
+typedRuleVar n ty = ty >>= return . TypedRuleVar n
+
+--------------------------------------------------------------
+-- * Useful helper function
+
+appsE :: [ExpQ] -> ExpQ
+appsE [] = error "appsE []"
+appsE [x] = x
+appsE (x:y:zs) = appsE ( (appE x y) : zs )
+
+-- | Return the Module at the place of splicing.  Can be used as an
+-- input for 'reifyModule'.
+thisModule :: Q Module
+thisModule = do
+  loc <- location
+  return $ Module (mkPkgName $ loc_package loc) (mkModName $ loc_module loc)
diff --git a/libraries/template-haskell/Language/Haskell/TH/Lib/Map.hs b/libraries/template-haskell/Language/Haskell/TH/Lib/Map.hs
new file mode 100644
index 000000000000..ac241515b8a9
--- /dev/null
+++ b/libraries/template-haskell/Language/Haskell/TH/Lib/Map.hs
@@ -0,0 +1,108 @@
+{-# LANGUAGE BangPatterns #-}
+
+-- This is a non-exposed internal module
+--
+-- The code in this module has been ripped from containers-0.5.5.1:Data.Map.Base [1] almost
+-- verbatimely to avoid a dependency of 'template-haskell' on the containers package.
+--
+-- [1] see https://hackage.haskell.org/package/containers-0.5.5.1
+--
+-- The original code is BSD-licensed and copyrighted by Daan Leijen, Andriy Palamarchuk, et al.
+
+module Language.Haskell.TH.Lib.Map
+    ( Map
+    , empty
+    , insert
+    , Language.Haskell.TH.Lib.Map.lookup
+    ) where
+
+data Map k a  = Bin {-# UNPACK #-} !Size !k a !(Map k a) !(Map k a)
+              | Tip
+
+type Size     = Int
+
+empty :: Map k a
+empty = Tip
+{-# INLINE empty #-}
+
+singleton :: k -> a -> Map k a
+singleton k x = Bin 1 k x Tip Tip
+{-# INLINE singleton #-}
+
+size :: Map k a -> Int
+size Tip              = 0
+size (Bin sz _ _ _ _) = sz
+{-# INLINE size #-}
+
+lookup :: Ord k => k -> Map k a -> Maybe a
+lookup = go
+  where
+    go _ Tip = Nothing
+    go !k (Bin _ kx x l r) = case compare k kx of
+      LT -> go k l
+      GT -> go k r
+      EQ -> Just x
+{-# INLINABLE lookup #-}
+
+
+insert :: Ord k => k -> a -> Map k a -> Map k a
+insert = go
+  where
+    go :: Ord k => k -> a -> Map k a -> Map k a
+    go !kx x Tip = singleton kx x
+    go !kx x (Bin sz ky y l r) =
+        case compare kx ky of
+            LT -> balanceL ky y (go kx x l) r
+            GT -> balanceR ky y l (go kx x r)
+            EQ -> Bin sz kx x l r
+{-# INLINABLE insert #-}
+
+balanceL :: k -> a -> Map k a -> Map k a -> Map k a
+balanceL k x l r = case r of
+  Tip -> case l of
+           Tip -> Bin 1 k x Tip Tip
+           (Bin _ _ _ Tip Tip) -> Bin 2 k x l Tip
+           (Bin _ lk lx Tip (Bin _ lrk lrx _ _)) -> Bin 3 lrk lrx (Bin 1 lk lx Tip Tip) (Bin 1 k x Tip Tip)
+           (Bin _ lk lx ll@(Bin _ _ _ _ _) Tip) -> Bin 3 lk lx ll (Bin 1 k x Tip Tip)
+           (Bin ls lk lx ll@(Bin lls _ _ _ _) lr@(Bin lrs lrk lrx lrl lrr))
+             | lrs < ratio*lls -> Bin (1+ls) lk lx ll (Bin (1+lrs) k x lr Tip)
+             | otherwise -> Bin (1+ls) lrk lrx (Bin (1+lls+size lrl) lk lx ll lrl) (Bin (1+size lrr) k x lrr Tip)
+
+  (Bin rs _ _ _ _) -> case l of
+           Tip -> Bin (1+rs) k x Tip r
+
+           (Bin ls lk lx ll lr)
+              | ls > delta*rs  -> case (ll, lr) of
+                   (Bin lls _ _ _ _, Bin lrs lrk lrx lrl lrr)
+                     | lrs < ratio*lls -> Bin (1+ls+rs) lk lx ll (Bin (1+rs+lrs) k x lr r)
+                     | otherwise -> Bin (1+ls+rs) lrk lrx (Bin (1+lls+size lrl) lk lx ll lrl) (Bin (1+rs+size lrr) k x lrr r)
+                   (_, _) -> error "Failure in Data.Map.balanceL"
+              | otherwise -> Bin (1+ls+rs) k x l r
+{-# NOINLINE balanceL #-}
+
+balanceR :: k -> a -> Map k a -> Map k a -> Map k a
+balanceR k x l r = case l of
+  Tip -> case r of
+           Tip -> Bin 1 k x Tip Tip
+           (Bin _ _ _ Tip Tip) -> Bin 2 k x Tip r
+           (Bin _ rk rx Tip rr@(Bin _ _ _ _ _)) -> Bin 3 rk rx (Bin 1 k x Tip Tip) rr
+           (Bin _ rk rx (Bin _ rlk rlx _ _) Tip) -> Bin 3 rlk rlx (Bin 1 k x Tip Tip) (Bin 1 rk rx Tip Tip)
+           (Bin rs rk rx rl@(Bin rls rlk rlx rll rlr) rr@(Bin rrs _ _ _ _))
+             | rls < ratio*rrs -> Bin (1+rs) rk rx (Bin (1+rls) k x Tip rl) rr
+             | otherwise -> Bin (1+rs) rlk rlx (Bin (1+size rll) k x Tip rll) (Bin (1+rrs+size rlr) rk rx rlr rr)
+
+  (Bin ls _ _ _ _) -> case r of
+           Tip -> Bin (1+ls) k x l Tip
+
+           (Bin rs rk rx rl rr)
+              | rs > delta*ls  -> case (rl, rr) of
+                   (Bin rls rlk rlx rll rlr, Bin rrs _ _ _ _)
+                     | rls < ratio*rrs -> Bin (1+ls+rs) rk rx (Bin (1+ls+rls) k x l rl) rr
+                     | otherwise -> Bin (1+ls+rs) rlk rlx (Bin (1+ls+size rll) k x l rll) (Bin (1+rrs+size rlr) rk rx rlr rr)
+                   (_, _) -> error "Failure in Data.Map.balanceR"
+              | otherwise -> Bin (1+ls+rs) k x l r
+{-# NOINLINE balanceR #-}
+
+delta,ratio :: Int
+delta = 3
+ratio = 2
diff --git a/libraries/template-haskell/Language/Haskell/TH/Ppr.hs b/libraries/template-haskell/Language/Haskell/TH/Ppr.hs
new file mode 100644
index 000000000000..e2370666e4cd
--- /dev/null
+++ b/libraries/template-haskell/Language/Haskell/TH/Ppr.hs
@@ -0,0 +1,568 @@
+-- | contains a prettyprinter for the
+-- Template Haskell datatypes
+
+module Language.Haskell.TH.Ppr where
+    -- All of the exports from this module should
+    -- be "public" functions.  The main module TH
+    -- re-exports them all.
+
+import Text.PrettyPrint (render)
+import Language.Haskell.TH.PprLib
+import Language.Haskell.TH.Syntax
+import Data.Word ( Word8 )
+import Data.Char ( toLower, chr, ord, isSymbol )
+import GHC.Show  ( showMultiLineString )
+import Data.Ratio ( numerator, denominator )
+
+nestDepth :: Int
+nestDepth = 4
+
+type Precedence = Int
+appPrec, unopPrec, opPrec, noPrec :: Precedence
+appPrec = 3    -- Argument of a function application
+opPrec  = 2    -- Argument of an infix operator
+unopPrec = 1   -- Argument of an unresolved infix operator
+noPrec  = 0    -- Others
+
+parensIf :: Bool -> Doc -> Doc
+parensIf True d = parens d
+parensIf False d = d
+
+------------------------------
+
+pprint :: Ppr a => a -> String
+pprint x = render $ to_HPJ_Doc $ ppr x
+
+class Ppr a where
+    ppr :: a -> Doc
+    ppr_list :: [a] -> Doc
+    ppr_list = vcat . map ppr
+
+instance Ppr a => Ppr [a] where
+    ppr x = ppr_list x
+
+------------------------------
+instance Ppr Name where
+    ppr v = pprName v
+
+------------------------------
+instance Ppr Info where
+    ppr (TyConI d)     = ppr d
+    ppr (ClassI d is)  = ppr d $$ vcat (map ppr is)
+    ppr (FamilyI d is) = ppr d $$ vcat (map ppr is)
+    ppr (PrimTyConI name arity is_unlifted)
+      = text "Primitive"
+	<+> (if is_unlifted then text "unlifted" else empty)
+	<+> text "type constructor" <+> quotes (ppr name)
+	<+> parens (text "arity" <+> int arity)
+    ppr (ClassOpI v ty cls fix)
+      = text "Class op from" <+> ppr cls <> colon <+>
+        vcat [ppr_sig v ty, pprFixity v fix]
+    ppr (DataConI v ty tc fix)
+      = text "Constructor from" <+> ppr tc <> colon <+>
+        vcat [ppr_sig v ty, pprFixity v fix]
+    ppr (TyVarI v ty)
+      = text "Type variable" <+> ppr v <+> equals <+> ppr ty
+    ppr (VarI v ty mb_d fix)
+      = vcat [ppr_sig v ty, pprFixity v fix,
+              case mb_d of { Nothing -> empty; Just d -> ppr d }]
+
+ppr_sig :: Name -> Type -> Doc
+ppr_sig v ty = ppr v <+> text "::" <+> ppr ty
+
+pprFixity :: Name -> Fixity -> Doc
+pprFixity _ f | f == defaultFixity = empty
+pprFixity v (Fixity i d) = ppr_fix d <+> int i <+> ppr v
+    where ppr_fix InfixR = text "infixr"
+          ppr_fix InfixL = text "infixl"
+          ppr_fix InfixN = text "infix"
+
+
+------------------------------
+instance Ppr Module where
+  ppr (Module pkg m) = text (pkgString pkg) <+> text (modString m)
+
+instance Ppr ModuleInfo where
+  ppr (ModuleInfo imps) = text "Module" <+> vcat (map ppr imps)
+
+------------------------------
+instance Ppr Exp where
+    ppr = pprExp noPrec
+
+pprPrefixOcc :: Name -> Doc
+-- Print operators with parens around them
+pprPrefixOcc n = parensIf (isSymOcc n) (ppr n)
+
+isSymOcc :: Name -> Bool
+isSymOcc n
+  = case nameBase n of
+      []    -> True  -- Empty name; weird
+      (c:_) -> isSymbolASCII c || (ord c > 0x7f && isSymbol c)
+                   -- c.f. OccName.startsVarSym in GHC itself
+
+isSymbolASCII :: Char -> Bool
+isSymbolASCII c = c `elem` "!#$%&*+./<=>?@\\^|~-"
+
+pprInfixExp :: Exp -> Doc
+pprInfixExp (VarE v) = pprName' Infix v
+pprInfixExp (ConE v) = pprName' Infix v
+pprInfixExp _        = text "<<Non-variable/constructor in infix context>>"
+
+pprExp :: Precedence -> Exp -> Doc
+pprExp _ (VarE v)     = pprName' Applied v
+pprExp _ (ConE c)     = pprName' Applied c
+pprExp i (LitE l)     = pprLit i l
+pprExp i (AppE e1 e2) = parensIf (i >= appPrec) $ pprExp opPrec e1
+                                              <+> pprExp appPrec e2
+pprExp _ (ParensE e)  = parens (pprExp noPrec e)
+pprExp i (UInfixE e1 op e2)
+ = parensIf (i > unopPrec) $ pprExp unopPrec e1
+                         <+> pprInfixExp op
+                         <+> pprExp unopPrec e2
+pprExp i (InfixE (Just e1) op (Just e2))
+ = parensIf (i >= opPrec) $ pprExp opPrec e1
+                        <+> pprInfixExp op
+                        <+> pprExp opPrec e2
+pprExp _ (InfixE me1 op me2) = parens $ pprMaybeExp noPrec me1
+                                    <+> pprInfixExp op
+                                    <+> pprMaybeExp noPrec me2
+pprExp i (LamE ps e) = parensIf (i > noPrec) $ char '\\' <> hsep (map (pprPat appPrec) ps)
+                                           <+> text "->" <+> ppr e
+pprExp i (LamCaseE ms) = parensIf (i > noPrec)
+                       $ text "\\case" $$ nest nestDepth (ppr ms)
+pprExp _ (TupE es) = parens $ sep $ punctuate comma $ map ppr es
+pprExp _ (UnboxedTupE es) = hashParens $ sep $ punctuate comma $ map ppr es
+-- Nesting in Cond is to avoid potential problems in do statments
+pprExp i (CondE guard true false)
+ = parensIf (i > noPrec) $ sep [text "if"   <+> ppr guard,
+                       nest 1 $ text "then" <+> ppr true,
+                       nest 1 $ text "else" <+> ppr false]
+pprExp i (MultiIfE alts)
+  = parensIf (i > noPrec) $ vcat $
+      case alts of
+        []            -> [text "if {}"]
+        (alt : alts') -> text "if" <+> pprGuarded arrow alt
+                         : map (nest 3 . pprGuarded arrow) alts'
+pprExp i (LetE ds_ e) = parensIf (i > noPrec) $ text "let" <+> pprDecs ds_
+                                             $$ text " in" <+> ppr e
+  where
+    pprDecs []  = empty
+    pprDecs [d] = ppr d
+    pprDecs ds  = braces $ sep $ punctuate semi $ map ppr ds
+
+pprExp i (CaseE e ms)
+ = parensIf (i > noPrec) $ text "case" <+> ppr e <+> text "of"
+                        $$ nest nestDepth (ppr ms)
+pprExp i (DoE ss_) = parensIf (i > noPrec) $ text "do" <+> pprStms ss_
+  where
+    pprStms []  = empty
+    pprStms [s] = ppr s
+    pprStms ss  = braces $ sep $ punctuate semi $ map ppr ss
+
+pprExp _ (CompE []) = text "<<Empty CompExp>>"
+-- This will probably break with fixity declarations - would need a ';'
+pprExp _ (CompE ss) = text "[" <> ppr s
+                  <+> text "|"
+                  <+> (sep $ punctuate comma $ map ppr ss')
+                   <> text "]"
+    where s = last ss
+          ss' = init ss
+pprExp _ (ArithSeqE d) = ppr d
+pprExp _ (ListE es) = brackets $ sep $ punctuate comma $ map ppr es
+pprExp i (SigE e t) = parensIf (i > noPrec) $ ppr e <+> text "::" <+> ppr t
+pprExp _ (RecConE nm fs) = ppr nm <> braces (pprFields fs)
+pprExp _ (RecUpdE e fs) = pprExp appPrec e <> braces (pprFields fs)
+
+pprFields :: [(Name,Exp)] -> Doc
+pprFields = sep . punctuate comma . map (\(s,e) -> ppr s <+> equals <+> ppr e)
+
+pprMaybeExp :: Precedence -> Maybe Exp -> Doc
+pprMaybeExp _ Nothing = empty
+pprMaybeExp i (Just e) = pprExp i e
+
+------------------------------
+instance Ppr Stmt where
+    ppr (BindS p e) = ppr p <+> text "<-" <+> ppr e
+    ppr (LetS ds) = text "let" <+> ppr ds
+    ppr (NoBindS e) = ppr e
+    ppr (ParS sss) = sep $ punctuate (text "|")
+                         $ map (sep . punctuate comma . map ppr) sss
+
+------------------------------
+instance Ppr Match where
+    ppr (Match p rhs ds) = ppr p <+> pprBody False rhs
+                        $$ where_clause ds
+
+------------------------------
+pprGuarded :: Doc -> (Guard, Exp) -> Doc
+pprGuarded eqDoc (guard, expr) = case guard of
+  NormalG guardExpr -> char '|' <+> ppr guardExpr <+> eqDoc <+> ppr expr
+  PatG    stmts     -> char '|' <+> vcat (punctuate comma $ map ppr stmts) $$
+                         nest nestDepth (eqDoc <+> ppr expr)
+
+------------------------------
+pprBody :: Bool -> Body -> Doc
+pprBody eq body = case body of
+    GuardedB xs -> nest nestDepth $ vcat $ map (pprGuarded eqDoc) xs
+    NormalB  e  -> eqDoc <+> ppr e
+  where eqDoc | eq        = equals
+              | otherwise = arrow
+
+------------------------------
+pprLit :: Precedence -> Lit -> Doc
+pprLit i (IntPrimL x)    = parensIf (i > noPrec && x < 0)
+                                    (integer x <> char '#')
+pprLit _ (WordPrimL x)    = integer x <> text "##"
+pprLit i (FloatPrimL x)  = parensIf (i > noPrec && x < 0)
+                                    (float (fromRational x) <> char '#')
+pprLit i (DoublePrimL x) = parensIf (i > noPrec && x < 0)
+                                    (double (fromRational x) <> text "##")
+pprLit i (IntegerL x)    = parensIf (i > noPrec && x < 0) (integer x)
+pprLit _ (CharL c)       = text (show c)
+pprLit _ (StringL s)     = pprString s
+pprLit _ (StringPrimL s) = pprString (bytesToString s) <> char '#'
+pprLit i (RationalL rat) = parensIf (i > noPrec) $
+                           integer (numerator rat) <+> char '/'
+                              <+> integer (denominator rat)
+
+bytesToString :: [Word8] -> String
+bytesToString = map (chr . fromIntegral)
+
+pprString :: String -> Doc
+-- Print newlines as newlines with Haskell string escape notation,
+-- not as '\n'.  For other non-printables use regular escape notation.
+pprString s = vcat (map text (showMultiLineString s))
+
+------------------------------
+instance Ppr Pat where
+    ppr = pprPat noPrec
+
+pprPat :: Precedence -> Pat -> Doc
+pprPat i (LitP l)     = pprLit i l
+pprPat _ (VarP v)     = pprName' Applied v
+pprPat _ (TupP ps)    = parens $ sep $ punctuate comma $ map ppr ps
+pprPat _ (UnboxedTupP ps) = hashParens $ sep $ punctuate comma $ map ppr ps
+pprPat i (ConP s ps)  = parensIf (i >= appPrec) $ pprName' Applied s
+                                              <+> sep (map (pprPat appPrec) ps)
+pprPat _ (ParensP p)  = parens $ pprPat noPrec p
+pprPat i (UInfixP p1 n p2)
+                      = parensIf (i > unopPrec) (pprPat unopPrec p1 <+>
+                                                 pprName' Infix n   <+>
+                                                 pprPat unopPrec p2)
+pprPat i (InfixP p1 n p2)
+                      = parensIf (i >= opPrec) (pprPat opPrec p1 <+>
+                                                pprName' Infix n <+>
+                                                pprPat opPrec p2)
+pprPat i (TildeP p)   = parensIf (i > noPrec) $ char '~' <> pprPat appPrec p
+pprPat i (BangP p)    = parensIf (i > noPrec) $ char '!' <> pprPat appPrec p
+pprPat i (AsP v p)    = parensIf (i > noPrec) $ ppr v <> text "@"
+                                                      <> pprPat appPrec p
+pprPat _ WildP        = text "_"
+pprPat _ (RecP nm fs)
+ = parens $     ppr nm
+            <+> braces (sep $ punctuate comma $
+                        map (\(s,p) -> ppr s <+> equals <+> ppr p) fs)
+pprPat _ (ListP ps) = brackets $ sep $ punctuate comma $ map ppr ps
+pprPat i (SigP p t) = parensIf (i > noPrec) $ ppr p <+> text "::" <+> ppr t
+pprPat _ (ViewP e p) = parens $ pprExp noPrec e <+> text "->" <+> pprPat noPrec p
+
+------------------------------
+instance Ppr Dec where
+    ppr = ppr_dec True
+
+ppr_dec :: Bool     -- declaration on the toplevel?
+        -> Dec
+        -> Doc
+ppr_dec _ (FunD f cs)   = vcat $ map (\c -> pprPrefixOcc f <+> ppr c) cs
+ppr_dec _ (ValD p r ds) = ppr p <+> pprBody True r
+                          $$ where_clause ds
+ppr_dec _ (TySynD t xs rhs)
+  = ppr_tySyn empty t (hsep (map ppr xs)) rhs
+ppr_dec _ (DataD ctxt t xs cs decs)
+  = ppr_data empty ctxt t (hsep (map ppr xs)) cs decs
+ppr_dec _ (NewtypeD ctxt t xs c decs)
+  = ppr_newtype empty ctxt t (sep (map ppr xs)) c decs
+ppr_dec _  (ClassD ctxt c xs fds ds)
+  = text "class" <+> pprCxt ctxt <+> ppr c <+> hsep (map ppr xs) <+> ppr fds
+    $$ where_clause ds
+ppr_dec _ (InstanceD ctxt i ds) = text "instance" <+> pprCxt ctxt <+> ppr i
+                                  $$ where_clause ds
+ppr_dec _ (SigD f t)    = pprPrefixOcc f <+> text "::" <+> ppr t
+ppr_dec _ (ForeignD f)  = ppr f
+ppr_dec _ (InfixD fx n) = pprFixity n fx
+ppr_dec _ (PragmaD p)   = ppr p
+ppr_dec isTop (FamilyD flav tc tvs k)
+  = ppr flav <+> maybeFamily <+> ppr tc <+> hsep (map ppr tvs) <+> maybeKind
+  where
+    maybeFamily | isTop     = text "family"
+                | otherwise = empty
+
+    maybeKind | (Just k') <- k = text "::" <+> ppr k'
+              | otherwise      = empty
+ppr_dec isTop (DataInstD ctxt tc tys cs decs)
+  = ppr_data maybeInst ctxt tc (sep (map pprParendType tys)) cs decs
+  where
+    maybeInst | isTop     = text "instance"
+              | otherwise = empty
+ppr_dec isTop (NewtypeInstD ctxt tc tys c decs)
+  = ppr_newtype maybeInst ctxt tc (sep (map pprParendType tys)) c decs
+  where
+    maybeInst | isTop     = text "instance"
+              | otherwise = empty
+ppr_dec isTop (TySynInstD tc (TySynEqn tys rhs))
+  = ppr_tySyn maybeInst tc (sep (map pprParendType tys)) rhs
+  where
+    maybeInst | isTop     = text "instance"
+              | otherwise = empty
+ppr_dec _ (ClosedTypeFamilyD tc tvs mkind eqns)
+  = hang (hsep [ text "type family", ppr tc, hsep (map ppr tvs), maybeKind
+               , text "where" ])
+      nestDepth (vcat (map ppr_eqn eqns))
+  where
+    maybeKind | (Just k') <- mkind = text "::" <+> ppr k'
+              | otherwise          = empty
+    ppr_eqn (TySynEqn lhs rhs)
+      = ppr tc <+> sep (map pprParendType lhs) <+> text "=" <+> ppr rhs
+
+ppr_dec _ (RoleAnnotD name roles)
+  = hsep [ text "type role", ppr name ] <+> hsep (map ppr roles)
+
+ppr_data :: Doc -> Cxt -> Name -> Doc -> [Con] -> [Name] -> Doc
+ppr_data maybeInst ctxt t argsDoc cs decs
+  = sep [text "data" <+> maybeInst
+    	    <+> pprCxt ctxt
+    	    <+> ppr t <+> argsDoc,
+         nest nestDepth (sep (pref $ map ppr cs)),
+         if null decs
+           then empty
+           else nest nestDepth
+              $ text "deriving"
+                <+> parens (hsep $ punctuate comma $ map ppr decs)]
+  where
+    pref :: [Doc] -> [Doc]
+    pref []     = []      -- No constructors; can't happen in H98
+    pref (d:ds) = (char '=' <+> d):map (char '|' <+>) ds
+
+ppr_newtype :: Doc -> Cxt -> Name -> Doc -> Con -> [Name] -> Doc
+ppr_newtype maybeInst ctxt t argsDoc c decs
+  = sep [text "newtype" <+> maybeInst
+    	    <+> pprCxt ctxt
+    	    <+> ppr t <+> argsDoc,
+         nest 2 (char '=' <+> ppr c),
+         if null decs
+       	   then empty
+       	   else nest nestDepth
+       	        $ text "deriving"
+       	          <+> parens (hsep $ punctuate comma $ map ppr decs)]
+
+ppr_tySyn :: Doc -> Name -> Doc -> Type -> Doc
+ppr_tySyn maybeInst t argsDoc rhs
+  = text "type" <+> maybeInst <+> ppr t <+> argsDoc <+> text "=" <+> ppr rhs
+
+------------------------------
+instance Ppr FunDep where
+    ppr (FunDep xs ys) = hsep (map ppr xs) <+> text "->" <+> hsep (map ppr ys)
+    ppr_list [] = empty
+    ppr_list xs = char '|' <+> sep (punctuate (text ", ") (map ppr xs))
+
+------------------------------
+instance Ppr FamFlavour where
+    ppr DataFam = text "data"
+    ppr TypeFam = text "type"
+
+------------------------------
+instance Ppr Foreign where
+    ppr (ImportF callconv safety impent as typ)
+       = text "foreign import"
+     <+> showtextl callconv
+     <+> showtextl safety
+     <+> text (show impent)
+     <+> ppr as
+     <+> text "::" <+> ppr typ
+    ppr (ExportF callconv expent as typ)
+        = text "foreign export"
+      <+> showtextl callconv
+      <+> text (show expent)
+      <+> ppr as
+      <+> text "::" <+> ppr typ
+
+------------------------------
+instance Ppr Pragma where
+    ppr (InlineP n inline rm phases)
+       = text "{-#"
+     <+> ppr inline
+     <+> ppr rm
+     <+> ppr phases
+     <+> ppr n
+     <+> text "#-}"
+    ppr (SpecialiseP n ty inline phases)
+       =   text "{-# SPECIALISE"
+       <+> maybe empty ppr inline
+       <+> ppr phases
+       <+> sep [ ppr n <+> text "::"
+               , nest 2 $ ppr ty ]
+       <+> text "#-}"
+    ppr (SpecialiseInstP inst)
+       = text "{-# SPECIALISE instance" <+> ppr inst <+> text "#-}"
+    ppr (RuleP n bndrs lhs rhs phases)
+       = sep [ text "{-# RULES" <+> pprString n <+> ppr phases
+             , nest 4 $ ppr_forall <+> ppr lhs
+             , nest 4 $ char '=' <+> ppr rhs <+> text "#-}" ]
+      where ppr_forall | null bndrs =   empty
+                       | otherwise  =   text "forall"
+                                    <+> fsep (map ppr bndrs)
+                                    <+> char '.'
+    ppr (AnnP tgt expr)
+       = text "{-# ANN" <+> target1 tgt <+> ppr expr <+> text "#-}"
+      where target1 ModuleAnnotation    = text "module"
+            target1 (TypeAnnotation t)  = text "type" <+> ppr t
+            target1 (ValueAnnotation v) = ppr v
+
+------------------------------
+instance Ppr Inline where
+    ppr NoInline  = text "NOINLINE"
+    ppr Inline    = text "INLINE"
+    ppr Inlinable = text "INLINABLE"
+
+------------------------------
+instance Ppr RuleMatch where
+    ppr ConLike = text "CONLIKE"
+    ppr FunLike = empty
+
+------------------------------
+instance Ppr Phases where
+    ppr AllPhases       = empty
+    ppr (FromPhase i)   = brackets $ int i
+    ppr (BeforePhase i) = brackets $ char '~' <> int i
+
+------------------------------
+instance Ppr RuleBndr where
+    ppr (RuleVar n)         = ppr n
+    ppr (TypedRuleVar n ty) = parens $ ppr n <+> text "::" <+> ppr ty
+
+------------------------------
+instance Ppr Clause where
+    ppr (Clause ps rhs ds) = hsep (map (pprPat appPrec) ps) <+> pprBody True rhs
+                             $$ where_clause ds
+
+------------------------------
+instance Ppr Con where
+    ppr (NormalC c sts) = ppr c <+> sep (map pprStrictType sts)
+    ppr (RecC c vsts)
+        = ppr c <+> braces (sep (punctuate comma $ map pprVarStrictType vsts))
+    ppr (InfixC st1 c st2) = pprStrictType st1
+                         <+> pprName' Infix c
+                         <+> pprStrictType st2
+    ppr (ForallC ns ctxt con) = text "forall" <+> hsep (map ppr ns)
+                            <+> char '.' <+> sep [pprCxt ctxt, ppr con]
+
+------------------------------
+pprVarStrictType :: (Name, Strict, Type) -> Doc
+-- Slight infelicity: with print non-atomic type with parens
+pprVarStrictType (v, str, t) = ppr v <+> text "::" <+> pprStrictType (str, t)
+
+------------------------------
+pprStrictType :: (Strict, Type) -> Doc
+-- Prints with parens if not already atomic
+pprStrictType (IsStrict, t) = char '!' <> pprParendType t
+pprStrictType (NotStrict, t) = pprParendType t
+pprStrictType (Unpacked, t) = text "{-# UNPACK #-} !" <> pprParendType t
+
+------------------------------
+pprParendType :: Type -> Doc
+pprParendType (VarT v)            = ppr v
+pprParendType (ConT c)            = ppr c
+pprParendType (TupleT 0)          = text "()"
+pprParendType (TupleT n)          = parens (hcat (replicate (n-1) comma))
+pprParendType (UnboxedTupleT n)   = hashParens $ hcat $ replicate (n-1) comma
+pprParendType ArrowT              = parens (text "->")
+pprParendType ListT               = text "[]"
+pprParendType (LitT l)            = pprTyLit l
+pprParendType (PromotedT c)       = text "'" <> ppr c
+pprParendType (PromotedTupleT 0)  = text "'()"
+pprParendType (PromotedTupleT n)  = quoteParens (hcat (replicate (n-1) comma))
+pprParendType PromotedNilT        = text "'[]"
+pprParendType PromotedConsT       = text "(':)"
+pprParendType StarT               = char '*'
+pprParendType ConstraintT         = text "Constraint"
+pprParendType other               = parens (ppr other)
+
+instance Ppr Type where
+    ppr (ForallT tvars ctxt ty)
+      = text "forall" <+> hsep (map ppr tvars) <+> text "."
+                      <+> sep [pprCxt ctxt, ppr ty]
+    ppr (SigT ty k) = ppr ty <+> text "::" <+> ppr k
+    ppr ty          = pprTyApp (split ty)
+
+pprTyApp :: (Type, [Type]) -> Doc
+pprTyApp (ArrowT, [arg1,arg2]) = sep [pprFunArgType arg1 <+> text "->", ppr arg2]
+pprTyApp (EqualityT, [arg1, arg2]) =
+    sep [pprFunArgType arg1 <+> text "~", ppr arg2]
+pprTyApp (ListT, [arg]) = brackets (ppr arg)
+pprTyApp (TupleT n, args)
+ | length args == n = parens (sep (punctuate comma (map ppr args)))
+pprTyApp (PromotedTupleT n, args)
+ | length args == n = quoteParens (sep (punctuate comma (map ppr args)))
+pprTyApp (fun, args) = pprParendType fun <+> sep (map pprParendType args)
+
+pprFunArgType :: Type -> Doc	-- Should really use a precedence argument
+-- Everything except forall and (->) binds more tightly than (->)
+pprFunArgType ty@(ForallT {})                 = parens (ppr ty)
+pprFunArgType ty@((ArrowT `AppT` _) `AppT` _) = parens (ppr ty)
+pprFunArgType ty@(SigT _ _)                   = parens (ppr ty)
+pprFunArgType ty                              = ppr ty
+
+split :: Type -> (Type, [Type])    -- Split into function and args
+split t = go t []
+    where go (AppT t1 t2) args = go t1 (t2:args)
+          go ty           args = (ty, args)
+
+pprTyLit :: TyLit -> Doc
+pprTyLit (NumTyLit n) = integer n
+pprTyLit (StrTyLit s) = text (show s)
+
+instance Ppr TyLit where
+  ppr = pprTyLit
+
+------------------------------
+instance Ppr TyVarBndr where
+    ppr (PlainTV nm)    = ppr nm
+    ppr (KindedTV nm k) = parens (ppr nm <+> text "::" <+> ppr k)
+
+instance Ppr Role where
+    ppr NominalR          = text "nominal"
+    ppr RepresentationalR = text "representational"
+    ppr PhantomR          = text "phantom"
+    ppr InferR            = text "_"
+
+------------------------------
+pprCxt :: Cxt -> Doc
+pprCxt [] = empty
+pprCxt [t] = ppr t <+> text "=>"
+pprCxt ts = parens (sep $ punctuate comma $ map ppr ts) <+> text "=>"
+
+------------------------------
+instance Ppr Range where
+    ppr = brackets . pprRange
+        where pprRange :: Range -> Doc
+              pprRange (FromR e) = ppr e <> text ".."
+              pprRange (FromThenR e1 e2) = ppr e1 <> text ","
+                                        <> ppr e2 <> text ".."
+              pprRange (FromToR e1 e2) = ppr e1 <> text ".." <> ppr e2
+              pprRange (FromThenToR e1 e2 e3) = ppr e1 <> text ","
+                                             <> ppr e2 <> text ".."
+                                             <> ppr e3
+
+------------------------------
+where_clause :: [Dec] -> Doc
+where_clause [] = empty
+where_clause ds = nest nestDepth $ text "where" <+> vcat (map (ppr_dec False) ds)
+
+showtextl :: Show a => a -> Doc
+showtextl = text . map toLower . show
+
+hashParens :: Doc -> Doc
+hashParens d = text "(# " <> d <> text " #)"
+
+quoteParens :: Doc -> Doc
+quoteParens d = text "'(" <> d <> text ")"
diff --git a/libraries/template-haskell/Language/Haskell/TH/PprLib.hs b/libraries/template-haskell/Language/Haskell/TH/PprLib.hs
new file mode 100644
index 000000000000..c4b0b7743044
--- /dev/null
+++ b/libraries/template-haskell/Language/Haskell/TH/PprLib.hs
@@ -0,0 +1,227 @@
+{-# LANGUAGE FlexibleInstances, MagicHash #-}
+
+-- | Monadic front-end to Text.PrettyPrint
+
+module Language.Haskell.TH.PprLib (
+
+	-- * The document type
+        Doc,            -- Abstract, instance of Show
+        PprM,
+
+	-- * Primitive Documents
+        empty,
+        semi, comma, colon, space, equals, arrow,
+        lparen, rparen, lbrack, rbrack, lbrace, rbrace,
+
+	-- * Converting values into documents
+        text, char, ptext,
+        int, integer, float, double, rational,
+
+	-- * Wrapping documents in delimiters
+        parens, brackets, braces, quotes, doubleQuotes,
+
+	-- * Combining documents
+        (<>), (<+>), hcat, hsep, 
+        ($$), ($+$), vcat, 
+        sep, cat, 
+        fsep, fcat, 
+	nest,
+        hang, punctuate,
+        
+	-- * Predicates on documents
+	isEmpty,
+
+    to_HPJ_Doc, pprName, pprName'
+  ) where
+
+
+import Language.Haskell.TH.Syntax
+    (Name(..), showName', NameFlavour(..), NameIs(..))
+import qualified Text.PrettyPrint as HPJ
+import Control.Applicative (Applicative(..))
+import Control.Monad (liftM, liftM2, ap)
+import Language.Haskell.TH.Lib.Map ( Map )
+import qualified Language.Haskell.TH.Lib.Map as Map ( lookup, insert, empty )
+import GHC.Base (Int(..))
+
+infixl 6 <> 
+infixl 6 <+>
+infixl 5 $$, $+$
+
+-- ---------------------------------------------------------------------------
+-- The interface
+
+-- The primitive Doc values
+
+instance Show Doc where
+   show d = HPJ.render (to_HPJ_Doc d)
+
+isEmpty :: Doc    -> PprM Bool;  -- ^ Returns 'True' if the document is empty
+
+empty   :: Doc;			-- ^ An empty document
+semi	:: Doc;			-- ^ A ';' character
+comma	:: Doc;			-- ^ A ',' character
+colon	:: Doc;			-- ^ A ':' character
+space	:: Doc;			-- ^ A space character
+equals	:: Doc;			-- ^ A '=' character
+arrow	:: Doc;			-- ^ A "->" string
+lparen	:: Doc;			-- ^ A '(' character
+rparen	:: Doc;			-- ^ A ')' character
+lbrack	:: Doc;			-- ^ A '[' character
+rbrack	:: Doc;			-- ^ A ']' character
+lbrace	:: Doc;			-- ^ A '{' character
+rbrace	:: Doc;			-- ^ A '}' character
+
+text	 :: String   -> Doc
+ptext	 :: String   -> Doc
+char 	 :: Char     -> Doc
+int      :: Int      -> Doc
+integer  :: Integer  -> Doc
+float    :: Float    -> Doc
+double   :: Double   -> Doc
+rational :: Rational -> Doc
+
+
+parens       :: Doc -> Doc; 	-- ^ Wrap document in @(...)@
+brackets     :: Doc -> Doc;  	-- ^ Wrap document in @[...]@
+braces	     :: Doc -> Doc;   	-- ^ Wrap document in @{...}@
+quotes	     :: Doc -> Doc;	-- ^ Wrap document in @\'...\'@
+doubleQuotes :: Doc -> Doc;	-- ^ Wrap document in @\"...\"@
+
+-- Combining @Doc@ values
+
+(<>)   :: Doc -> Doc -> Doc;     -- ^Beside
+hcat   :: [Doc] -> Doc;          -- ^List version of '<>'
+(<+>)  :: Doc -> Doc -> Doc;     -- ^Beside, separated by space
+hsep   :: [Doc] -> Doc;          -- ^List version of '<+>'
+
+($$)   :: Doc -> Doc -> Doc;     -- ^Above; if there is no
+                                -- overlap it \"dovetails\" the two
+($+$)   :: Doc -> Doc -> Doc;	 -- ^Above, without dovetailing.
+vcat   :: [Doc] -> Doc;          -- ^List version of '$$'
+
+cat    :: [Doc] -> Doc;          -- ^ Either hcat or vcat
+sep    :: [Doc] -> Doc;          -- ^ Either hsep or vcat
+fcat   :: [Doc] -> Doc;          -- ^ \"Paragraph fill\" version of cat
+fsep   :: [Doc] -> Doc;          -- ^ \"Paragraph fill\" version of sep
+
+nest   :: Int -> Doc -> Doc;     -- ^ Nested
+
+
+-- GHC-specific ones.
+
+hang :: Doc -> Int -> Doc -> Doc;	-- ^ @hang d1 n d2 = sep [d1, nest n d2]@
+punctuate :: Doc -> [Doc] -> [Doc];      -- ^ @punctuate p [d1, ... dn] = [d1 \<> p, d2 \<> p, ... dn-1 \<> p, dn]@
+
+
+-- ---------------------------------------------------------------------------
+-- The "implementation"
+
+type State = (Map Name Name, Int)
+data PprM a = PprM { runPprM :: State -> (a, State) }
+
+pprName :: Name -> Doc
+pprName = pprName' Alone
+
+pprName' :: NameIs -> Name -> Doc
+pprName' ni n@(Name o (NameU _))
+ = PprM $ \s@(fm, i@(I# i'))
+        -> let (n', s') = case Map.lookup n fm of
+                         Just d -> (d, s)
+                         Nothing -> let n'' = Name o (NameU i')
+                                    in (n'', (Map.insert n n'' fm, i + 1))
+           in (HPJ.text $ showName' ni n', s')
+pprName' ni n = text $ showName' ni n
+
+{-
+instance Show Name where
+  show (Name occ (NameU u))    = occString occ ++ "_" ++ show (I# u)
+  show (Name occ NameS)        = occString occ
+  show (Name occ (NameG ns m)) = modString m ++ "." ++ occString occ
+      
+data Name = Name OccName NameFlavour
+
+data NameFlavour
+  | NameU Int#			-- A unique local name
+-}
+
+to_HPJ_Doc :: Doc -> HPJ.Doc
+to_HPJ_Doc d = fst $ runPprM d (Map.empty, 0)
+
+instance Functor PprM where
+      fmap = liftM
+
+instance Applicative PprM where
+      pure = return
+      (<*>) = ap
+
+instance Monad PprM where
+    return x = PprM $ \s -> (x, s)
+    m >>= k  = PprM $ \s -> let (x, s') = runPprM m s
+                            in runPprM (k x) s'
+
+type Doc = PprM HPJ.Doc
+
+-- The primitive Doc values
+
+isEmpty = liftM HPJ.isEmpty
+
+empty = return HPJ.empty
+semi = return HPJ.semi
+comma = return HPJ.comma
+colon = return HPJ.colon
+space = return HPJ.space
+equals = return HPJ.equals
+arrow = return $ HPJ.text "->"
+lparen = return HPJ.lparen
+rparen = return HPJ.rparen
+lbrack = return HPJ.lbrack
+rbrack = return HPJ.rbrack
+lbrace = return HPJ.lbrace
+rbrace = return HPJ.rbrace
+
+text = return . HPJ.text
+ptext = return . HPJ.ptext
+char = return . HPJ.char
+int = return . HPJ.int
+integer = return . HPJ.integer
+float = return . HPJ.float
+double = return . HPJ.double
+rational = return . HPJ.rational
+
+
+parens = liftM HPJ.parens
+brackets = liftM HPJ.brackets
+braces = liftM HPJ.braces
+quotes = liftM HPJ.quotes
+doubleQuotes = liftM HPJ.doubleQuotes
+
+-- Combining @Doc@ values
+
+(<>) = liftM2 (HPJ.<>)
+hcat = liftM HPJ.hcat . sequence
+(<+>) = liftM2 (HPJ.<+>)
+hsep = liftM HPJ.hsep . sequence
+
+($$) = liftM2 (HPJ.$$)
+($+$) = liftM2 (HPJ.$+$)
+vcat = liftM HPJ.vcat . sequence
+
+cat  = liftM HPJ.cat . sequence
+sep  = liftM HPJ.sep . sequence
+fcat = liftM HPJ.fcat . sequence
+fsep = liftM HPJ.fsep . sequence
+
+nest n = liftM (HPJ.nest n)
+
+hang d1 n d2 = do d1' <- d1
+                  d2' <- d2
+                  return (HPJ.hang d1' n d2')
+
+-- punctuate uses the same definition as Text.PrettyPrint
+punctuate _ []     = []
+punctuate p (d:ds) = go d ds
+                   where
+                     go d' [] = [d']
+                     go d' (e:es) = (d' <> p) : go e es
+
diff --git a/libraries/template-haskell/Language/Haskell/TH/Quote.hs b/libraries/template-haskell/Language/Haskell/TH/Quote.hs
new file mode 100644
index 000000000000..b9c0d25d2bab
--- /dev/null
+++ b/libraries/template-haskell/Language/Haskell/TH/Quote.hs
@@ -0,0 +1,87 @@
+{-# LANGUAGE RankNTypes, ScopedTypeVariables #-}
+module Language.Haskell.TH.Quote(
+	QuasiQuoter(..),
+        dataToQa, dataToExpQ, dataToPatQ,
+        quoteFile
+    ) where
+
+import Data.Data
+import Language.Haskell.TH.Lib
+import Language.Haskell.TH.Syntax
+
+data QuasiQuoter = QuasiQuoter { quoteExp  :: String -> Q Exp,
+                                 quotePat  :: String -> Q Pat,
+                                 quoteType :: String -> Q Type,
+                                 quoteDec  :: String -> Q [Dec] }
+
+dataToQa  ::  forall a k q. Data a
+          =>  (Name -> k)
+          ->  (Lit -> Q q)
+          ->  (k -> [Q q] -> Q q)
+          ->  (forall b . Data b => b -> Maybe (Q q))
+          ->  a
+          ->  Q q
+dataToQa mkCon mkLit appCon antiQ t =
+    case antiQ t of
+      Nothing ->
+          case constrRep constr of
+            AlgConstr _ ->
+                appCon (mkCon conName) conArgs
+              where
+                conName :: Name
+                conName =
+                    case showConstr constr of
+                      "(:)"       -> Name (mkOccName ":") (NameG DataName (mkPkgName "ghc-prim") (mkModName "GHC.Types"))
+                      con@"[]"    -> Name (mkOccName con) (NameG DataName (mkPkgName "ghc-prim") (mkModName "GHC.Types"))
+                      con@('(':_) -> Name (mkOccName con) (NameG DataName (mkPkgName "ghc-prim") (mkModName "GHC.Tuple"))
+                      con         -> mkNameG_d (tyConPackage tycon)
+                                               (tyConModule tycon)
+                                               con
+                  where
+                    tycon :: TyCon
+                    tycon = (typeRepTyCon . typeOf) t
+
+                conArgs :: [Q q]
+                conArgs = gmapQ (dataToQa mkCon mkLit appCon antiQ) t
+            IntConstr n ->
+                mkLit $ integerL n
+            FloatConstr n ->
+                mkLit $ rationalL n
+            CharConstr c ->
+                mkLit $ charL c
+        where
+          constr :: Constr
+          constr = toConstr t
+
+      Just y -> y
+
+-- | 'dataToExpQ' converts a value to a 'Q Exp' representation of the same
+-- value. It takes a function to handle type-specific cases.
+dataToExpQ  ::  Data a
+            =>  (forall b . Data b => b -> Maybe (Q Exp))
+            ->  a
+            ->  Q Exp
+dataToExpQ = dataToQa conE litE (foldl appE)
+
+-- | 'dataToPatQ' converts a value to a 'Q Pat' representation of the same
+-- value. It takes a function to handle type-specific cases.
+dataToPatQ  ::  Data a
+            =>  (forall b . Data b => b -> Maybe (Q Pat))
+            ->  a
+            ->  Q Pat
+dataToPatQ = dataToQa id litP conP
+
+-- | 'quoteFile' takes a 'QuasiQuoter' and lifts it into one that read
+-- the data out of a file.  For example, suppose 'asmq' is an 
+-- assembly-language quoter, so that you can write [asmq| ld r1, r2 |]
+-- as an expression. Then if you define @asmq_f = quoteFile asmq@, then
+-- the quote [asmq_f|foo.s|] will take input from file @"foo.s"@ instead
+-- of the inline text
+quoteFile :: QuasiQuoter -> QuasiQuoter
+quoteFile (QuasiQuoter { quoteExp = qe, quotePat = qp, quoteType = qt, quoteDec = qd }) 
+  = QuasiQuoter { quoteExp = get qe, quotePat = get qp, quoteType = get qt, quoteDec = get qd }
+  where
+   get :: (String -> Q a) -> String -> Q a
+   get old_quoter file_name = do { file_cts <- runIO (readFile file_name) 
+                                 ; addDependentFile file_name
+                                 ; old_quoter file_cts }
diff --git a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
new file mode 100644
index 000000000000..3172cbbced2c
--- /dev/null
+++ b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
@@ -0,0 +1,1457 @@
+{-# LANGUAGE DeriveDataTypeable, MagicHash, PolymorphicComponents, RoleAnnotations, UnboxedTuples #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Language.Haskell.Syntax
+-- Copyright   :  (c) The University of Glasgow 2003
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+--
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  experimental
+-- Portability :  portable
+--
+-- Abstract syntax definitions for Template Haskell.
+--
+-----------------------------------------------------------------------------
+
+module Language.Haskell.TH.Syntax where
+
+import GHC.Exts
+import Data.Data (Data(..), Typeable, mkConstr, mkDataType, constrIndex)
+import qualified Data.Data as Data
+import Control.Applicative( Applicative(..) )
+import Data.IORef
+import System.IO.Unsafe	( unsafePerformIO )
+import Control.Monad (liftM)
+import System.IO	( hPutStrLn, stderr )
+import Data.Char        ( isAlpha, isAlphaNum, isUpper )
+import Data.Word        ( Word8 )
+
+-----------------------------------------------------
+--
+--		The Quasi class
+--
+-----------------------------------------------------
+
+class (Monad m, Applicative m) => Quasi m where
+  qNewName :: String -> m Name
+	-- ^ Fresh names
+
+	-- Error reporting and recovery
+  qReport  :: Bool -> String -> m ()	-- ^ Report an error (True) or warning (False)
+					-- ...but carry on; use 'fail' to stop
+  qRecover :: m a -- ^ the error handler
+           -> m a -- ^ action which may fail
+           -> m a		-- ^ Recover from the monadic 'fail'
+
+	-- Inspect the type-checker's environment
+  qLookupName :: Bool -> String -> m (Maybe Name)
+       -- True <=> type namespace, False <=> value namespace
+  qReify          :: Name -> m Info
+  qReifyInstances :: Name -> [Type] -> m [Dec]
+       -- Is (n tys) an instance?
+       -- Returns list of matching instance Decs
+       --    (with empty sub-Decs)
+       -- Works for classes and type functions
+  qReifyRoles       :: Name -> m [Role]
+  qReifyAnnotations :: Data a => AnnLookup -> m [a]
+  qReifyModule      :: Module -> m ModuleInfo
+
+  qLocation :: m Loc
+
+  qRunIO :: IO a -> m a
+  -- ^ Input/output (dangerous)
+
+  qAddDependentFile :: FilePath -> m ()
+
+  qAddTopDecls :: [Dec] -> m ()
+
+  qAddModFinalizer :: Q () -> m ()
+
+  qGetQ :: Typeable a => m (Maybe a)
+
+  qPutQ :: Typeable a => a -> m ()
+
+-----------------------------------------------------
+--	The IO instance of Quasi
+--
+--  This instance is used only when running a Q
+--  computation in the IO monad, usually just to
+--  print the result.  There is no interesting
+--  type environment, so reification isn't going to
+--  work.
+--
+-----------------------------------------------------
+
+instance Quasi IO where
+  qNewName s = do { n <- readIORef counter
+                 ; writeIORef counter (n+1)
+                 ; return (mkNameU s n) }
+
+  qReport True  msg = hPutStrLn stderr ("Template Haskell error: " ++ msg)
+  qReport False msg = hPutStrLn stderr ("Template Haskell error: " ++ msg)
+
+  qLookupName _ _     = badIO "lookupName"
+  qReify _            = badIO "reify"
+  qReifyInstances _ _ = badIO "reifyInstances"
+  qReifyRoles _       = badIO "reifyRoles"
+  qReifyAnnotations _ = badIO "reifyAnnotations"
+  qReifyModule _      = badIO "reifyModule"
+  qLocation    	      = badIO "currentLocation"
+  qRecover _ _ 	      = badIO "recover" -- Maybe we could fix this?
+  qAddDependentFile _ = badIO "addDependentFile"
+  qAddTopDecls _      = badIO "addTopDecls"
+  qAddModFinalizer _  = badIO "addModFinalizer"
+  qGetQ               = badIO "getQ"
+  qPutQ _             = badIO "putQ"
+
+  qRunIO m = m
+
+badIO :: String -> IO a
+badIO op = do	{ qReport True ("Can't do `" ++ op ++ "' in the IO monad")
+		; fail "Template Haskell failure" }
+
+-- Global variable to generate unique symbols
+counter :: IORef Int
+{-# NOINLINE counter #-}
+counter = unsafePerformIO (newIORef 0)
+
+
+-----------------------------------------------------
+--
+--		The Q monad
+--
+-----------------------------------------------------
+
+newtype Q a = Q { unQ :: forall m. Quasi m => m a }
+
+-- \"Runs\" the 'Q' monad. Normal users of Template Haskell
+-- should not need this function, as the splice brackets @$( ... )@
+-- are the usual way of running a 'Q' computation.
+--
+-- This function is primarily used in GHC internals, and for debugging
+-- splices by running them in 'IO'.
+--
+-- Note that many functions in 'Q', such as 'reify' and other compiler
+-- queries, are not supported when running 'Q' in 'IO'; these operations
+-- simply fail at runtime. Indeed, the only operations guaranteed to succeed
+-- are 'newName', 'runIO', 'reportError' and 'reportWarning'.
+runQ :: Quasi m => Q a -> m a
+runQ (Q m) = m
+
+instance Monad Q where
+  return x   = Q (return x)
+  Q m >>= k  = Q (m >>= \x -> unQ (k x))
+  Q m >> Q n = Q (m >> n)
+  fail s     = report True s >> Q (fail "Q monad failure")
+
+instance Functor Q where
+  fmap f (Q x) = Q (fmap f x)
+
+instance Applicative Q where
+  pure x = Q (pure x)
+  Q f <*> Q x = Q (f <*> x)
+
+-----------------------------------------------------
+--
+--		The TExp type
+--
+-----------------------------------------------------
+
+type role TExp nominal   -- See Note [Role of TExp]
+newtype TExp a = TExp { unType :: Exp }
+
+unTypeQ :: Q (TExp a) -> Q Exp
+unTypeQ m = do { TExp e <- m
+               ; return e }
+
+unsafeTExpCoerce :: Q Exp -> Q (TExp a)
+unsafeTExpCoerce m = do { e <- m
+                        ; return (TExp e) }
+
+{- Note [Role of TExp]
+~~~~~~~~~~~~~~~~~~~~~~
+TExp's argument must have a nominal role, not phantom as would
+be inferred (Trac #8459).  Consider
+
+  e :: TExp Age
+  e = MkAge 3
+
+  foo = $(coerce e) + 4::Int
+
+The splice will evaluate to (MkAge 3) and you can't add that to
+4::Int. So you can't coerce a (TExp Age) to a (TExp Int). -}
+
+----------------------------------------------------
+-- Packaged versions for the programmer, hiding the Quasi-ness
+
+{- |
+Generate a fresh name, which cannot be captured.
+
+For example, this:
+
+@f = $(do
+  nm1 <- newName \"x\"
+  let nm2 = 'mkName' \"x\"
+  return ('LamE' ['VarP' nm1] (LamE [VarP nm2] ('VarE' nm1)))
+ )@
+
+will produce the splice
+
+>f = \x0 -> \x -> x0
+
+In particular, the occurrence @VarE nm1@ refers to the binding @VarP nm1@,
+and is not captured by the binding @VarP nm2@.
+
+Although names generated by @newName@ cannot /be captured/, they can
+/capture/ other names. For example, this:
+
+>g = $(do
+>  nm1 <- newName "x"
+>  let nm2 = mkName "x"
+>  return (LamE [VarP nm2] (LamE [VarP nm1] (VarE nm2)))
+> )
+
+will produce the splice
+
+>g = \x -> \x0 -> x0
+
+since the occurrence @VarE nm2@ is captured by the innermost binding
+of @x@, namely @VarP nm1@.
+-}
+newName :: String -> Q Name
+newName s = Q (qNewName s)
+
+-- | Report an error (True) or warning (False),
+-- but carry on; use 'fail' to stop.
+report  :: Bool -> String -> Q ()
+report b s = Q (qReport b s)
+{-# DEPRECATED report "Use reportError or reportWarning instead" #-} -- deprecated in 7.6
+
+-- | Report an error to the user, but allow the current splice's computation to carry on. To abort the computation, use 'fail'.
+reportError :: String -> Q ()
+reportError = report True
+
+-- | Report a warning to the user, and carry on.
+reportWarning :: String -> Q ()
+reportWarning = report False
+
+-- | Recover from errors raised by 'reportError' or 'fail'.
+recover :: Q a -- ^ handler to invoke on failure
+        -> Q a -- ^ computation to run
+        -> Q a
+recover (Q r) (Q m) = Q (qRecover r m)
+
+-- We don't export lookupName; the Bool isn't a great API
+-- Instead we export lookupTypeName, lookupValueName
+lookupName :: Bool -> String -> Q (Maybe Name)
+lookupName ns s = Q (qLookupName ns s)
+
+-- | Look up the given name in the (type namespace of the) current splice's scope. See "Language.Haskell.TH.Syntax#namelookup" for more details.
+lookupTypeName :: String -> Q (Maybe Name)
+lookupTypeName  s = Q (qLookupName True s)
+
+-- | Look up the given name in the (value namespace of the) current splice's scope. See "Language.Haskell.TH.Syntax#namelookup" for more details.
+lookupValueName :: String -> Q (Maybe Name)
+lookupValueName s = Q (qLookupName False s)
+
+{-
+Note [Name lookup]
+~~~~~~~~~~~~~~~~~~
+-}
+{- $namelookup #namelookup#
+The functions 'lookupTypeName' and 'lookupValueName' provide
+a way to query the current splice's context for what names
+are in scope. The function 'lookupTypeName' queries the type
+namespace, whereas 'lookupValueName' queries the value namespace,
+but the functions are otherwise identical.
+
+A call @lookupValueName s@ will check if there is a value
+with name @s@ in scope at the current splice's location. If
+there is, the @Name@ of this value is returned;
+if not, then @Nothing@ is returned.
+
+The returned name cannot be \"captured\".
+For example:
+
+> f = "global"
+> g = $( do
+>          Just nm <- lookupValueName "f"
+>          [| let f = "local" in $( varE nm ) |]
+
+In this case, @g = \"global\"@; the call to @lookupValueName@
+returned the global @f@, and this name was /not/ captured by
+the local definition of @f@.
+
+The lookup is performed in the context of the /top-level/ splice
+being run. For example:
+
+> f = "global"
+> g = $( [| let f = "local" in
+>            $(do
+>                Just nm <- lookupValueName "f"
+>                varE nm
+>             ) |] )
+
+Again in this example, @g = \"global\"@, because the call to
+@lookupValueName@ queries the context of the outer-most @$(...)@.
+
+Operators should be queried without any surrounding parentheses, like so:
+
+> lookupValueName "+"
+
+Qualified names are also supported, like so:
+
+> lookupValueName "Prelude.+"
+> lookupValueName "Prelude.map"
+
+-}
+
+
+{- | 'reify' looks up information about the 'Name'.
+
+It is sometimes useful to construct the argument name using 'lookupTypeName' or 'lookupValueName'
+to ensure that we are reifying from the right namespace. For instance, in this context:
+
+> data D = D
+
+which @D@ does @reify (mkName \"D\")@ return information about? (Answer: @D@-the-type, but don't rely on it.)
+To ensure we get information about @D@-the-value, use 'lookupValueName':
+
+> do
+>   Just nm <- lookupValueName "D"
+>   reify nm
+
+and to get information about @D@-the-type, use 'lookupTypeName'.
+-}
+reify :: Name -> Q Info
+reify v = Q (qReify v)
+
+{- | @reifyInstances nm tys@ returns a list of visible instances of @nm tys@. That is,
+if @nm@ is the name of a type class, then all instances of this class at the types @tys@
+are returned. Alternatively, if @nm@ is the name of a data family or type family,
+all instances of this family at the types @tys@ are returned.
+-}
+reifyInstances :: Name -> [Type] -> Q [InstanceDec]
+reifyInstances cls tys = Q (qReifyInstances cls tys)
+
+{- | @reifyRoles nm@ returns the list of roles associated with the parameters of
+the tycon @nm@. Fails if @nm@ cannot be found or is not a tycon.
+The returned list should never contain 'InferR'.
+-}
+reifyRoles :: Name -> Q [Role]
+reifyRoles nm = Q (qReifyRoles nm)
+
+-- | @reifyAnnotations target@ returns the list of annotations
+-- associated with @target@.  Only the annotations that are
+-- appropriately typed is returned.  So if you have @Int@ and @String@
+-- annotations for the same target, you have to call this function twice.
+reifyAnnotations :: Data a => AnnLookup -> Q [a]
+reifyAnnotations an = Q (qReifyAnnotations an)
+
+-- | @reifyModule mod@ looks up information about module @mod@.  To
+-- look up the current module, call this function with the return
+-- value of @thisModule@.
+reifyModule :: Module -> Q ModuleInfo
+reifyModule m = Q (qReifyModule m)
+
+-- | Is the list of instances returned by 'reifyInstances' nonempty?
+isInstance :: Name -> [Type] -> Q Bool
+isInstance nm tys = do { decs <- reifyInstances nm tys
+                       ; return (not (null decs)) }
+
+-- | The location at which this computation is spliced.
+location :: Q Loc
+location = Q qLocation
+
+-- |The 'runIO' function lets you run an I\/O computation in the 'Q' monad.
+-- Take care: you are guaranteed the ordering of calls to 'runIO' within
+-- a single 'Q' computation, but not about the order in which splices are run.
+--
+-- Note: for various murky reasons, stdout and stderr handles are not
+-- necessarily flushed when the compiler finishes running, so you should
+-- flush them yourself.
+runIO :: IO a -> Q a
+runIO m = Q (qRunIO m)
+
+-- | Record external files that runIO is using (dependent upon).
+-- The compiler can then recognize that it should re-compile the file using this TH when the external file changes.
+-- Note that ghc -M will still not know about these dependencies - it does not execute TH.
+-- Expects an absolute file path.
+addDependentFile :: FilePath -> Q ()
+addDependentFile fp = Q (qAddDependentFile fp)
+
+-- | Add additional top-level declarations. The added declarations will be type
+-- checked along with the current declaration group.
+addTopDecls :: [Dec] -> Q ()
+addTopDecls ds = Q (qAddTopDecls ds)
+
+-- | Add a finalizer that will run in the Q monad after the current module has
+-- been type checked. This only makes sense when run within a top-level splice.
+addModFinalizer :: Q () -> Q ()
+addModFinalizer act = Q (qAddModFinalizer (unQ act))
+
+-- | Get state from the Q monad.
+getQ :: Typeable a => Q (Maybe a)
+getQ = Q qGetQ
+
+-- | Replace the state in the Q monad.
+putQ :: Typeable a => a -> Q ()
+putQ x = Q (qPutQ x)
+
+instance Quasi Q where
+  qNewName  	    = newName
+  qReport   	    = report
+  qRecover  	    = recover
+  qReify    	    = reify
+  qReifyInstances   = reifyInstances
+  qReifyRoles       = reifyRoles
+  qReifyAnnotations = reifyAnnotations
+  qReifyModule      = reifyModule
+  qLookupName       = lookupName
+  qLocation 	    = location
+  qRunIO    	    = runIO
+  qAddDependentFile = addDependentFile
+  qAddTopDecls      = addTopDecls
+  qAddModFinalizer  = addModFinalizer
+  qGetQ             = getQ
+  qPutQ             = putQ
+
+
+----------------------------------------------------
+-- The following operations are used solely in DsMeta when desugaring brackets
+-- They are not necessary for the user, who can use ordinary return and (>>=) etc
+
+returnQ :: a -> Q a
+returnQ = return
+
+bindQ :: Q a -> (a -> Q b) -> Q b
+bindQ = (>>=)
+
+sequenceQ :: [Q a] -> Q [a]
+sequenceQ = sequence
+
+
+-----------------------------------------------------
+--
+--		The Lift class
+--
+-----------------------------------------------------
+
+class Lift t where
+  lift :: t -> Q Exp
+
+instance Lift Integer where
+  lift x = return (LitE (IntegerL x))
+
+instance Lift Int where
+  lift x= return (LitE (IntegerL (fromIntegral x)))
+
+instance Lift Char where
+  lift x = return (LitE (CharL x))
+
+instance Lift Bool where
+  lift True  = return (ConE trueName)
+  lift False = return (ConE falseName)
+
+instance Lift a => Lift (Maybe a) where
+  lift Nothing  = return (ConE nothingName)
+  lift (Just x) = liftM (ConE justName `AppE`) (lift x)
+
+instance (Lift a, Lift b) => Lift (Either a b) where
+  lift (Left x)  = liftM (ConE leftName  `AppE`) (lift x)
+  lift (Right y) = liftM (ConE rightName `AppE`) (lift y)
+
+instance Lift a => Lift [a] where
+  lift xs = do { xs' <- mapM lift xs; return (ListE xs') }
+
+liftString :: String -> Q Exp
+-- Used in TcExpr to short-circuit the lifting for strings
+liftString s = return (LitE (StringL s))
+
+instance (Lift a, Lift b) => Lift (a, b) where
+  lift (a, b)
+    = liftM TupE $ sequence [lift a, lift b]
+
+instance (Lift a, Lift b, Lift c) => Lift (a, b, c) where
+  lift (a, b, c)
+    = liftM TupE $ sequence [lift a, lift b, lift c]
+
+instance (Lift a, Lift b, Lift c, Lift d) => Lift (a, b, c, d) where
+  lift (a, b, c, d)
+    = liftM TupE $ sequence [lift a, lift b, lift c, lift d]
+
+instance (Lift a, Lift b, Lift c, Lift d, Lift e)
+      => Lift (a, b, c, d, e) where
+  lift (a, b, c, d, e)
+    = liftM TupE $ sequence [lift a, lift b, lift c, lift d, lift e]
+
+instance (Lift a, Lift b, Lift c, Lift d, Lift e, Lift f)
+      => Lift (a, b, c, d, e, f) where
+  lift (a, b, c, d, e, f)
+    = liftM TupE $ sequence [lift a, lift b, lift c, lift d, lift e, lift f]
+
+instance (Lift a, Lift b, Lift c, Lift d, Lift e, Lift f, Lift g)
+      => Lift (a, b, c, d, e, f, g) where
+  lift (a, b, c, d, e, f, g)
+    = liftM TupE $ sequence [lift a, lift b, lift c, lift d, lift e, lift f, lift g]
+
+-- TH has a special form for literal strings,
+-- which we should take advantage of.
+-- NB: the lhs of the rule has no args, so that
+--     the rule will apply to a 'lift' all on its own
+--     which happens to be the way the type checker
+--     creates it.
+{-# RULES "TH:liftString" lift = \s -> return (LitE (StringL s)) #-}
+
+
+trueName, falseName :: Name
+trueName  = mkNameG DataName "ghc-prim" "GHC.Types" "True"
+falseName = mkNameG DataName "ghc-prim" "GHC.Types" "False"
+
+nothingName, justName :: Name
+nothingName = mkNameG DataName "base" "Data.Maybe" "Nothing"
+justName    = mkNameG DataName "base" "Data.Maybe" "Just"
+
+leftName, rightName :: Name
+leftName  = mkNameG DataName "base" "Data.Either" "Left"
+rightName = mkNameG DataName "base" "Data.Either" "Right"
+
+
+-----------------------------------------------------
+--		Names and uniques
+-----------------------------------------------------
+
+newtype ModName = ModName String	-- Module name
+ deriving (Show,Eq,Ord,Typeable,Data)
+
+newtype PkgName = PkgName String	-- package name
+ deriving (Show,Eq,Ord,Typeable,Data)
+
+-- | Obtained from 'reifyModule' and 'thisModule'.
+data Module = Module PkgName ModName -- package qualified module name
+ deriving (Show,Eq,Ord,Typeable,Data)
+
+newtype OccName = OccName String
+ deriving (Show,Eq,Ord,Typeable,Data)
+
+mkModName :: String -> ModName
+mkModName s = ModName s
+
+modString :: ModName -> String
+modString (ModName m) = m
+
+
+mkPkgName :: String -> PkgName
+mkPkgName s = PkgName s
+
+pkgString :: PkgName -> String
+pkgString (PkgName m) = m
+
+
+-----------------------------------------------------
+--		OccName
+-----------------------------------------------------
+
+mkOccName :: String -> OccName
+mkOccName s = OccName s
+
+occString :: OccName -> String
+occString (OccName occ) = occ
+
+
+-----------------------------------------------------
+--		 Names
+-----------------------------------------------------
+--
+-- For "global" names ('NameG') we need a totally unique name,
+-- so we must include the name-space of the thing
+--
+-- For unique-numbered things ('NameU'), we've got a unique reference
+-- anyway, so no need for name space
+--
+-- For dynamically bound thing ('NameS') we probably want them to
+-- in a context-dependent way, so again we don't want the name
+-- space.  For example:
+--
+-- > let v = mkName "T" in [| data $v = $v |]
+--
+-- Here we use the same Name for both type constructor and data constructor
+--
+--
+-- NameL and NameG are bound *outside* the TH syntax tree
+-- either globally (NameG) or locally (NameL). Ex:
+--
+-- > f x = $(h [| (map, x) |])
+--
+-- The 'map' will be a NameG, and 'x' wil be a NameL
+--
+-- These Names should never appear in a binding position in a TH syntax tree
+
+{- $namecapture #namecapture#
+Much of 'Name' API is concerned with the problem of /name capture/, which
+can be seen in the following example.
+
+> f expr = [| let x = 0 in $expr |]
+> ...
+> g x = $( f [| x |] )
+> h y = $( f [| y |] )
+
+A naive desugaring of this would yield:
+
+> g x = let x = 0 in x
+> h y = let x = 0 in y
+
+All of a sudden, @g@ and @h@ have different meanings! In this case,
+we say that the @x@ in the RHS of @g@ has been /captured/
+by the binding of @x@ in @f@.
+
+What we actually want is for the @x@ in @f@ to be distinct from the
+@x@ in @g@, so we get the following desugaring:
+
+> g x = let x' = 0 in x
+> h y = let x' = 0 in y
+
+which avoids name capture as desired.
+
+In the general case, we say that a @Name@ can be captured if
+the thing it refers to can be changed by adding new declarations.
+-}
+
+{- |
+An abstract type representing names in the syntax tree.
+
+'Name's can be constructed in several ways, which come with different
+name-capture guarantees (see "Language.Haskell.TH.Syntax#namecapture" for
+an explanation of name capture):
+
+  * the built-in syntax @'f@ and @''T@ can be used to construct names,
+    The expression @'f@ gives a @Name@ which refers to the value @f@
+    currently in scope, and @''T@ gives a @Name@ which refers to the
+    type @T@ currently in scope. These names can never be captured.
+
+  * 'lookupValueName' and 'lookupTypeName' are similar to @'f@ and
+     @''T@ respectively, but the @Name@s are looked up at the point
+     where the current splice is being run. These names can never be
+     captured.
+
+  * 'newName' monadically generates a new name, which can never
+     be captured.
+
+  * 'mkName' generates a capturable name.
+
+Names constructed using @newName@ and @mkName@ may be used in bindings
+(such as @let x = ...@ or @\x -> ...@), but names constructed using
+@lookupValueName@, @lookupTypeName@, @'f@, @''T@ may not.
+-}
+data Name = Name OccName NameFlavour deriving (Typeable, Data)
+
+data NameFlavour
+  = NameS           -- ^ An unqualified name; dynamically bound
+  | NameQ ModName   -- ^ A qualified name; dynamically bound
+  | NameU Int#      -- ^ A unique local name
+  | NameL Int#      -- ^ Local name bound outside of the TH AST
+  | NameG NameSpace PkgName ModName -- ^ Global name bound outside of the TH AST:
+                -- An original name (occurrences only, not binders)
+		-- Need the namespace too to be sure which
+		-- thing we are naming
+  deriving ( Typeable )
+
+-- |
+-- Although the NameFlavour type is abstract, the Data instance is not. The reason for this
+-- is that currently we use Data to serialize values in annotations, and in order for that to
+-- work for Template Haskell names introduced via the 'x syntax we need gunfold on NameFlavour
+-- to work. Bleh!
+--
+-- The long term solution to this is to use the binary package for annotation serialization and
+-- then remove this instance. However, to do _that_ we need to wait on binary to become stable, since
+-- boot libraries cannot be upgraded separately from GHC itself.
+--
+-- This instance cannot be derived automatically due to bug #2701
+instance Data NameFlavour where
+     gfoldl _ z NameS          = z NameS
+     gfoldl k z (NameQ mn)     = z NameQ `k` mn
+     gfoldl k z (NameU i)      = z (\(I# i') -> NameU i') `k` (I# i)
+     gfoldl k z (NameL i)      = z (\(I# i') -> NameL i') `k` (I# i)
+     gfoldl k z (NameG ns p m) = z NameG `k` ns `k` p `k` m
+     gunfold k z c = case constrIndex c of
+         1 -> z NameS
+         2 -> k $ z NameQ
+         3 -> k $ z (\(I# i) -> NameU i)
+         4 -> k $ z (\(I# i) -> NameL i)
+         5 -> k $ k $ k $ z NameG
+         _ -> error "gunfold: NameFlavour"
+     toConstr NameS = con_NameS
+     toConstr (NameQ _) = con_NameQ
+     toConstr (NameU _) = con_NameU
+     toConstr (NameL _) = con_NameL
+     toConstr (NameG _ _ _) = con_NameG
+     dataTypeOf _ = ty_NameFlavour
+
+con_NameS, con_NameQ, con_NameU, con_NameL, con_NameG :: Data.Constr
+con_NameS = mkConstr ty_NameFlavour "NameS" [] Data.Prefix
+con_NameQ = mkConstr ty_NameFlavour "NameQ" [] Data.Prefix
+con_NameU = mkConstr ty_NameFlavour "NameU" [] Data.Prefix
+con_NameL = mkConstr ty_NameFlavour "NameL" [] Data.Prefix
+con_NameG = mkConstr ty_NameFlavour "NameG" [] Data.Prefix
+
+ty_NameFlavour :: Data.DataType
+ty_NameFlavour = mkDataType "Language.Haskell.TH.Syntax.NameFlavour"
+                            [con_NameS, con_NameQ, con_NameU,
+                             con_NameL, con_NameG]
+
+data NameSpace = VarName	-- ^ Variables
+	       | DataName	-- ^ Data constructors
+	       | TcClsName	-- ^ Type constructors and classes; Haskell has them
+				-- in the same name space for now.
+	       deriving( Eq, Ord, Data, Typeable )
+
+type Uniq = Int
+
+-- | The name without its module prefix
+nameBase :: Name -> String
+nameBase (Name occ _) = occString occ
+
+-- | Module prefix of a name, if it exists
+nameModule :: Name -> Maybe String
+nameModule (Name _ (NameQ m))     = Just (modString m)
+nameModule (Name _ (NameG _ _ m)) = Just (modString m)
+nameModule _                      = Nothing
+
+{- |
+Generate a capturable name. Occurrences of such names will be
+resolved according to the Haskell scoping rules at the occurrence
+site.
+
+For example:
+
+> f = [| pi + $(varE (mkName "pi")) |]
+> ...
+> g = let pi = 3 in $f
+
+In this case, @g@ is desugared to
+
+> g = Prelude.pi + 3
+
+Note that @mkName@ may be used with qualified names:
+
+> mkName "Prelude.pi"
+
+See also 'Language.Haskell.TH.Lib.dyn' for a useful combinator. The above example could
+be rewritten using 'dyn' as
+
+> f = [| pi + $(dyn "pi") |]
+-}
+mkName :: String -> Name
+-- The string can have a '.', thus "Foo.baz",
+-- giving a dynamically-bound qualified name,
+-- in which case we want to generate a NameQ
+--
+-- Parse the string to see if it has a "." in it
+-- so we know whether to generate a qualified or unqualified name
+-- It's a bit tricky because we need to parse
+--
+-- > Foo.Baz.x   as    Qual Foo.Baz x
+--
+-- So we parse it from back to front
+mkName str
+  = split [] (reverse str)
+  where
+    split occ []        = Name (mkOccName occ) NameS
+    split occ ('.':rev)	| not (null occ)
+			, is_rev_mod_name rev
+			= Name (mkOccName occ) (NameQ (mkModName (reverse rev)))
+	-- The 'not (null occ)' guard ensures that
+	-- 	mkName "&." = Name "&." NameS
+	-- The 'is_rev_mod' guards ensure that
+	--	mkName ".&" = Name ".&" NameS
+	--	mkName "^.." = Name "^.." NameS      -- Trac #8633
+	--	mkName "Data.Bits..&" = Name ".&" (NameQ "Data.Bits")
+	-- This rather bizarre case actually happened; (.&.) is in Data.Bits
+    split occ (c:rev)   = split (c:occ) rev
+
+    -- Recognises a reversed module name xA.yB.C,
+    -- with at least one component,
+    -- and each component looks like a module name
+    --   (i.e. non-empty, starts with capital, all alpha)
+    is_rev_mod_name rev_mod_str
+      | (compt, rest) <- break (== '.') rev_mod_str
+      , not (null compt), isUpper (last compt), all is_mod_char compt
+      = case rest of
+          []             -> True
+          (_dot : rest') -> is_rev_mod_name rest'
+      | otherwise
+      = False
+
+    is_mod_char c = isAlphaNum c || c == '_' || c == '\''
+
+-- | Only used internally
+mkNameU :: String -> Uniq -> Name
+mkNameU s (I# u) = Name (mkOccName s) (NameU u)
+
+-- | Only used internally
+mkNameL :: String -> Uniq -> Name
+mkNameL s (I# u) = Name (mkOccName s) (NameL u)
+
+-- | Used for 'x etc, but not available to the programmer
+mkNameG :: NameSpace -> String -> String -> String -> Name
+mkNameG ns pkg modu occ
+  = Name (mkOccName occ) (NameG ns (mkPkgName pkg) (mkModName modu))
+
+mkNameG_v, mkNameG_tc, mkNameG_d :: String -> String -> String -> Name
+mkNameG_v  = mkNameG VarName
+mkNameG_tc = mkNameG TcClsName
+mkNameG_d  = mkNameG DataName
+
+instance Eq Name where
+  v1 == v2 = cmpEq (v1 `compare` v2)
+
+instance Ord Name where
+  (Name o1 f1) `compare` (Name o2 f2) = (f1 `compare` f2)   `thenCmp`
+				        (o1 `compare` o2)
+
+instance Eq NameFlavour where
+  f1 == f2 = cmpEq (f1 `compare` f2)
+
+instance Ord NameFlavour where
+	-- NameS < NameQ < NameU < NameL < NameG
+  NameS `compare` NameS = EQ
+  NameS `compare` _     = LT
+
+  (NameQ _)  `compare` NameS      = GT
+  (NameQ m1) `compare` (NameQ m2) = m1 `compare` m2
+  (NameQ _)  `compare` _          = LT
+
+  (NameU _)  `compare` NameS      = GT
+  (NameU _)  `compare` (NameQ _)  = GT
+  (NameU u1) `compare` (NameU u2) | isTrue# (u1  <# u2) = LT
+				  | isTrue# (u1 ==# u2) = EQ
+				  | otherwise           = GT
+  (NameU _)  `compare` _     = LT
+
+  (NameL _)  `compare` NameS      = GT
+  (NameL _)  `compare` (NameQ _)  = GT
+  (NameL _)  `compare` (NameU _)  = GT
+  (NameL u1) `compare` (NameL u2) | isTrue# (u1  <# u2) = LT
+				  | isTrue# (u1 ==# u2) = EQ
+				  | otherwise           = GT
+  (NameL _)  `compare` _          = LT
+
+  (NameG ns1 p1 m1) `compare` (NameG ns2 p2 m2) = (ns1 `compare` ns2) `thenCmp`
+                                            (p1 `compare` p2) `thenCmp`
+					    (m1 `compare` m2)
+  (NameG _ _ _)    `compare` _ = GT
+
+data NameIs = Alone | Applied | Infix
+
+showName :: Name -> String
+showName = showName' Alone
+
+showName' :: NameIs -> Name -> String
+showName' ni nm
+ = case ni of
+       Alone        -> nms
+       Applied
+        | pnam      -> nms
+        | otherwise -> "(" ++ nms ++ ")"
+       Infix
+        | pnam      -> "`" ++ nms ++ "`"
+        | otherwise -> nms
+    where
+	-- For now, we make the NameQ and NameG print the same, even though
+	-- NameQ is a qualified name (so what it means depends on what the
+	-- current scope is), and NameG is an original name (so its meaning
+	-- should be independent of what's in scope.
+	-- We may well want to distinguish them in the end.
+	-- Ditto NameU and NameL
+        nms = case nm of
+                    Name occ NameS         -> occString occ
+                    Name occ (NameQ m)     -> modString m ++ "." ++ occString occ
+                    Name occ (NameG _ _ m) -> modString m ++ "." ++ occString occ
+                    Name occ (NameU u)     -> occString occ ++ "_" ++ show (I# u)
+                    Name occ (NameL u)     -> occString occ ++ "_" ++ show (I# u)
+
+        pnam = classify nms
+
+        -- True if we are function style, e.g. f, [], (,)
+        -- False if we are operator style, e.g. +, :+
+        classify "" = False -- shouldn't happen; . operator is handled below
+        classify (x:xs) | isAlpha x || (x `elem` "_[]()") =
+                            case dropWhile (/='.') xs of
+                                  (_:xs') -> classify xs'
+                                  []      -> True
+                        | otherwise = False
+
+instance Show Name where
+  show = showName
+
+-- Tuple data and type constructors
+-- | Tuple data constructor
+tupleDataName :: Int -> Name
+-- | Tuple type constructor
+tupleTypeName :: Int -> Name
+
+tupleDataName 0 = mk_tup_name 0 DataName
+tupleDataName 1 = error "tupleDataName 1"
+tupleDataName n = mk_tup_name (n-1) DataName
+
+tupleTypeName 0 = mk_tup_name 0 TcClsName
+tupleTypeName 1 = error "tupleTypeName 1"
+tupleTypeName n = mk_tup_name (n-1) TcClsName
+
+mk_tup_name :: Int -> NameSpace -> Name
+mk_tup_name n_commas space
+  = Name occ (NameG space (mkPkgName "ghc-prim") tup_mod)
+  where
+    occ = mkOccName ('(' : replicate n_commas ',' ++ ")")
+    tup_mod = mkModName "GHC.Tuple"
+
+-- Unboxed tuple data and type constructors
+-- | Unboxed tuple data constructor
+unboxedTupleDataName :: Int -> Name
+-- | Unboxed tuple type constructor
+unboxedTupleTypeName :: Int -> Name
+
+unboxedTupleDataName 0 = error "unboxedTupleDataName 0"
+unboxedTupleDataName 1 = error "unboxedTupleDataName 1"
+unboxedTupleDataName n = mk_unboxed_tup_name (n-1) DataName
+
+unboxedTupleTypeName 0 = error "unboxedTupleTypeName 0"
+unboxedTupleTypeName 1 = error "unboxedTupleTypeName 1"
+unboxedTupleTypeName n = mk_unboxed_tup_name (n-1) TcClsName
+
+mk_unboxed_tup_name :: Int -> NameSpace -> Name
+mk_unboxed_tup_name n_commas space
+  = Name occ (NameG space (mkPkgName "ghc-prim") tup_mod)
+  where
+    occ = mkOccName ("(#" ++ replicate n_commas ',' ++ "#)")
+    tup_mod = mkModName "GHC.Tuple"
+
+
+
+-----------------------------------------------------
+--		Locations
+-----------------------------------------------------
+
+data Loc
+  = Loc { loc_filename :: String
+	, loc_package  :: String
+	, loc_module   :: String
+	, loc_start    :: CharPos
+	, loc_end      :: CharPos }
+
+type CharPos = (Int, Int)	-- ^ Line and character position
+
+
+-----------------------------------------------------
+--
+--	The Info returned by reification
+--
+-----------------------------------------------------
+
+-- | Obtained from 'reify' in the 'Q' Monad.
+data Info
+  =
+  -- | A class, with a list of its visible instances
+  ClassI
+      Dec
+      [InstanceDec]
+
+  -- | A class method
+  | ClassOpI
+       Name
+       Type
+       ParentName
+       Fixity
+
+  -- | A \"plain\" type constructor. \"Fancier\" type constructors are returned using 'PrimTyConI' or 'FamilyI' as appropriate
+  | TyConI
+        Dec
+
+  -- | A type or data family, with a list of its visible instances. A closed
+  -- type family is returned with 0 instances.
+  | FamilyI
+        Dec
+        [InstanceDec]
+
+  -- | A \"primitive\" type constructor, which can't be expressed with a 'Dec'. Examples: @(->)@, @Int#@.
+  | PrimTyConI
+       Name
+       Arity
+       Unlifted
+
+  -- | A data constructor
+  | DataConI
+       Name
+       Type
+       ParentName
+       Fixity
+
+  {- |
+  A \"value\" variable (as opposed to a type variable, see 'TyVarI').
+
+  The @Maybe Dec@ field contains @Just@ the declaration which
+  defined the variable -- including the RHS of the declaration --
+  or else @Nothing@, in the case where the RHS is unavailable to
+  the compiler. At present, this value is _always_ @Nothing@:
+  returning the RHS has not yet been implemented because of
+  lack of interest.
+  -}
+  | VarI
+       Name
+       Type
+       (Maybe Dec)
+       Fixity
+
+  {- |
+  A type variable.
+
+  The @Type@ field contains the type which underlies the variable.
+  At present, this is always @'VarT' theName@, but future changes
+  may permit refinement of this.
+  -}
+  | TyVarI 	-- Scoped type variable
+	Name
+	Type	-- What it is bound to
+  deriving( Show, Data, Typeable )
+
+-- | Obtained from 'reifyModule' in the 'Q' Monad.
+data ModuleInfo =
+  -- | Contains the import list of the module.
+  ModuleInfo [Module]
+  deriving( Show, Data, Typeable )
+
+{- |
+In 'ClassOpI' and 'DataConI', name of the parent class or type
+-}
+type ParentName = Name
+
+-- | In 'PrimTyConI', arity of the type constructor
+type Arity = Int
+
+-- | In 'PrimTyConI', is the type constructor unlifted?
+type Unlifted = Bool
+
+-- | 'InstanceDec' desribes a single instance of a class or type function.
+-- It is just a 'Dec', but guaranteed to be one of the following:
+--
+--   * 'InstanceD' (with empty @['Dec']@)
+--
+--   * 'DataInstD' or 'NewtypeInstD' (with empty derived @['Name']@)
+--
+--   * 'TySynInstD'
+type InstanceDec = Dec
+
+data Fixity          = Fixity Int FixityDirection
+    deriving( Eq, Show, Data, Typeable )
+data FixityDirection = InfixL | InfixR | InfixN
+    deriving( Eq, Show, Data, Typeable )
+
+-- | Highest allowed operator precedence for 'Fixity' constructor (answer: 9)
+maxPrecedence :: Int
+maxPrecedence = (9::Int)
+
+-- | Default fixity: @infixl 9@
+defaultFixity :: Fixity
+defaultFixity = Fixity maxPrecedence InfixL
+
+
+{-
+Note [Unresolved infix]
+~~~~~~~~~~~~~~~~~~~~~~~
+-}
+{- $infix #infix#
+When implementing antiquotation for quasiquoters, one often wants
+to parse strings into expressions:
+
+> parse :: String -> Maybe Exp
+
+But how should we parse @a + b * c@? If we don't know the fixities of
+@+@ and @*@, we don't know whether to parse it as @a + (b * c)@ or @(a
++ b) * c@.
+
+In cases like this, use 'UInfixE' or 'UInfixP', which stand for
+\"unresolved infix expression\" and \"unresolved infix pattern\". When
+the compiler is given a splice containing a tree of @UInfixE@
+applications such as
+
+> UInfixE
+>   (UInfixE e1 op1 e2)
+>   op2
+>   (UInfixE e3 op3 e4)
+
+it will look up and the fixities of the relevant operators and
+reassociate the tree as necessary.
+
+  * trees will not be reassociated across 'ParensE' or 'ParensP',
+    which are of use for parsing expressions like
+
+    > (a + b * c) + d * e
+
+  * 'InfixE' and 'InfixP' expressions are never reassociated.
+
+  * The 'UInfixE' constructor doesn't support sections. Sections
+    such as @(a *)@ have no ambiguity, so 'InfixE' suffices. For longer
+    sections such as @(a + b * c -)@, use an 'InfixE' constructor for the
+    outer-most section, and use 'UInfixE' constructors for all
+    other operators:
+
+    > InfixE
+    >   Just (UInfixE ...a + b * c...)
+    >   op
+    >   Nothing
+
+    Sections such as @(a + b +)@ and @((a + b) +)@ should be rendered
+    into 'Exp's differently:
+
+    > (+ a + b)   ---> InfixE Nothing + (Just $ UInfixE a + b)
+    >                    -- will result in a fixity error if (+) is left-infix
+    > (+ (a + b)) ---> InfixE Nothing + (Just $ ParensE $ UInfixE a + b)
+    >                    -- no fixity errors
+
+  * Quoted expressions such as
+
+    > [| a * b + c |] :: Q Exp
+    > [p| a : b : c |] :: Q Pat
+
+    will never contain 'UInfixE', 'UInfixP', 'ParensE', or 'ParensP'
+    constructors.
+
+-}
+
+-----------------------------------------------------
+--
+--	The main syntax data types
+--
+-----------------------------------------------------
+
+data Lit = CharL Char
+         | StringL String
+         | IntegerL Integer     -- ^ Used for overloaded and non-overloaded
+                                -- literals. We don't have a good way to
+                                -- represent non-overloaded literals at
+                                -- the moment. Maybe that doesn't matter?
+         | RationalL Rational   -- Ditto
+         | IntPrimL Integer
+         | WordPrimL Integer
+         | FloatPrimL Rational
+         | DoublePrimL Rational
+         | StringPrimL [Word8]	-- ^ A primitive C-style string, type Addr#
+    deriving( Show, Eq, Data, Typeable )
+
+    -- We could add Int, Float, Double etc, as we do in HsLit,
+    -- but that could complicate the
+    -- suppposedly-simple TH.Syntax literal type
+
+-- | Pattern in Haskell given in @{}@
+data Pat
+  = LitP Lit                      -- ^ @{ 5 or 'c' }@
+  | VarP Name                     -- ^ @{ x }@
+  | TupP [Pat]                    -- ^ @{ (p1,p2) }@
+  | UnboxedTupP [Pat]             -- ^ @{ (# p1,p2 #) }@
+  | ConP Name [Pat]               -- ^ @data T1 = C1 t1 t2; {C1 p1 p1} = e@
+  | InfixP Pat Name Pat           -- ^ @foo ({x :+ y}) = e@
+  | UInfixP Pat Name Pat          -- ^ @foo ({x :+ y}) = e@
+                                  --
+                                  -- See "Language.Haskell.TH.Syntax#infix"
+  | ParensP Pat                   -- ^ @{(p)}@
+                                  --
+                                  -- See "Language.Haskell.TH.Syntax#infix"
+  | TildeP Pat                    -- ^ @{ ~p }@
+  | BangP Pat                     -- ^ @{ !p }@
+  | AsP Name Pat                  -- ^ @{ x \@ p }@
+  | WildP                         -- ^ @{ _ }@
+  | RecP Name [FieldPat]          -- ^ @f (Pt { pointx = x }) = g x@
+  | ListP [ Pat ]                 -- ^ @{ [1,2,3] }@
+  | SigP Pat Type                 -- ^ @{ p :: t }@
+  | ViewP Exp Pat                 -- ^ @{ e -> p }@
+  deriving( Show, Eq, Data, Typeable )
+
+type FieldPat = (Name,Pat)
+
+data Match = Match Pat Body [Dec] -- ^ @case e of { pat -> body where decs }@
+    deriving( Show, Eq, Data, Typeable )
+data Clause = Clause [Pat] Body [Dec]
+                                  -- ^ @f { p1 p2 = body where decs }@
+    deriving( Show, Eq, Data, Typeable )
+
+data Exp
+  = VarE Name                          -- ^ @{ x }@
+  | ConE Name                          -- ^ @data T1 = C1 t1 t2; p = {C1} e1 e2  @
+  | LitE Lit                           -- ^ @{ 5 or 'c'}@
+  | AppE Exp Exp                       -- ^ @{ f x }@
+
+  | InfixE (Maybe Exp) Exp (Maybe Exp) -- ^ @{x + y} or {(x+)} or {(+ x)} or {(+)}@
+
+    -- It's a bit gruesome to use an Exp as the
+    -- operator, but how else can we distinguish
+    -- constructors from non-constructors?
+    -- Maybe there should be a var-or-con type?
+    -- Or maybe we should leave it to the String itself?
+
+  | UInfixE Exp Exp Exp                -- ^ @{x + y}@
+                                       --
+                                       -- See "Language.Haskell.TH.Syntax#infix"
+  | ParensE Exp                        -- ^ @{ (e) }@
+                                       --
+                                       -- See "Language.Haskell.TH.Syntax#infix"
+  | LamE [Pat] Exp                     -- ^ @{ \ p1 p2 -> e }@
+  | LamCaseE [Match]                   -- ^ @{ \case m1; m2 }@
+  | TupE [Exp]                         -- ^ @{ (e1,e2) }  @
+  | UnboxedTupE [Exp]                  -- ^ @{ (# e1,e2 #) }  @
+  | CondE Exp Exp Exp                  -- ^ @{ if e1 then e2 else e3 }@
+  | MultiIfE [(Guard, Exp)]            -- ^ @{ if | g1 -> e1 | g2 -> e2 }@
+  | LetE [Dec] Exp                     -- ^ @{ let x=e1;   y=e2 in e3 }@
+  | CaseE Exp [Match]                  -- ^ @{ case e of m1; m2 }@
+  | DoE [Stmt]                         -- ^ @{ do { p <- e1; e2 }  }@
+  | CompE [Stmt]                       -- ^ @{ [ (x,y) | x <- xs, y <- ys ] }@
+      --
+      -- The result expression of the comprehension is
+      -- the /last/ of the @'Stmt'@s, and should be a 'NoBindS'.
+      --
+      -- E.g. translation:
+      --
+      -- > [ f x | x <- xs ]
+      --
+      -- > CompE [BindS (VarP x) (VarE xs), NoBindS (AppE (VarE f) (VarE x))]
+
+  | ArithSeqE Range                    -- ^ @{ [ 1 ,2 .. 10 ] }@
+  | ListE [ Exp ]                      -- ^ @{ [1,2,3] }@
+  | SigE Exp Type                      -- ^ @{ e :: t }@
+  | RecConE Name [FieldExp]            -- ^ @{ T { x = y, z = w } }@
+  | RecUpdE Exp [FieldExp]             -- ^ @{ (f x) { z = w } }@
+  deriving( Show, Eq, Data, Typeable )
+
+type FieldExp = (Name,Exp)
+
+-- Omitted: implicit parameters
+
+data Body
+  = GuardedB [(Guard,Exp)]   -- ^ @f p { | e1 = e2
+                                 --      | e3 = e4 }
+                                 -- where ds@
+  | NormalB Exp              -- ^ @f p { = e } where ds@
+  deriving( Show, Eq, Data, Typeable )
+
+data Guard
+  = NormalG Exp -- ^ @f x { | odd x } = x@
+  | PatG [Stmt] -- ^ @f x { | Just y <- x, Just z <- y } = z@
+  deriving( Show, Eq, Data, Typeable )
+
+data Stmt
+  = BindS Pat Exp
+  | LetS [ Dec ]
+  | NoBindS Exp
+  | ParS [[Stmt]]
+  deriving( Show, Eq, Data, Typeable )
+
+data Range = FromR Exp | FromThenR Exp Exp
+           | FromToR Exp Exp | FromThenToR Exp Exp Exp
+          deriving( Show, Eq, Data, Typeable )
+
+data Dec
+  = FunD Name [Clause]            -- ^ @{ f p1 p2 = b where decs }@
+  | ValD Pat Body [Dec]           -- ^ @{ p = b where decs }@
+  | DataD Cxt Name [TyVarBndr]
+         [Con] [Name]             -- ^ @{ data Cxt x => T x = A x | B (T x)
+                                  --       deriving (Z,W)}@
+  | NewtypeD Cxt Name [TyVarBndr]
+         Con [Name]               -- ^ @{ newtype Cxt x => T x = A (B x)
+                                  --       deriving (Z,W)}@
+  | TySynD Name [TyVarBndr] Type  -- ^ @{ type T x = (x,x) }@
+  | ClassD Cxt Name [TyVarBndr]
+         [FunDep] [Dec]           -- ^ @{ class Eq a => Ord a where ds }@
+  | InstanceD Cxt Type [Dec]      -- ^ @{ instance Show w => Show [w]
+                                  --       where ds }@
+  | SigD Name Type                -- ^ @{ length :: [a] -> Int }@
+  | ForeignD Foreign              -- ^ @{ foreign import ... }
+                                  --{ foreign export ... }@
+
+  | InfixD Fixity Name            -- ^ @{ infix 3 foo }@
+
+  -- | pragmas
+  | PragmaD Pragma                -- ^ @{ {\-# INLINE [1] foo #-\} }@
+
+  -- | type families (may also appear in [Dec] of 'ClassD' and 'InstanceD')
+  | FamilyD FamFlavour Name
+         [TyVarBndr] (Maybe Kind) -- ^ @{ type family T a b c :: * }@
+
+  | DataInstD Cxt Name [Type]
+         [Con] [Name]             -- ^ @{ data instance Cxt x => T [x] = A x
+                                  --                                | B (T x)
+                                  --       deriving (Z,W)}@
+  | NewtypeInstD Cxt Name [Type]
+         Con [Name]               -- ^ @{ newtype instance Cxt x => T [x] = A (B x)
+                                  --       deriving (Z,W)}@
+  | TySynInstD Name TySynEqn      -- ^ @{ type instance ... }@
+
+  | ClosedTypeFamilyD Name
+      [TyVarBndr] (Maybe Kind)
+      [TySynEqn]                  -- ^ @{ type family F a b :: * where ... }@
+
+  | RoleAnnotD Name [Role]        -- ^ @{ type role T nominal representational }@
+  deriving( Show, Eq, Data, Typeable )
+
+-- | One equation of a type family instance or closed type family. The
+-- arguments are the left-hand-side type patterns and the right-hand-side
+-- result.
+data TySynEqn = TySynEqn [Type] Type
+  deriving( Show, Eq, Data, Typeable )
+
+data FunDep = FunDep [Name] [Name]
+  deriving( Show, Eq, Data, Typeable )
+
+data FamFlavour = TypeFam | DataFam
+  deriving( Show, Eq, Data, Typeable )
+
+data Foreign = ImportF Callconv Safety String Name Type
+             | ExportF Callconv        String Name Type
+         deriving( Show, Eq, Data, Typeable )
+
+data Callconv = CCall | StdCall
+          deriving( Show, Eq, Data, Typeable )
+
+data Safety = Unsafe | Safe | Interruptible
+        deriving( Show, Eq, Data, Typeable )
+
+data Pragma = InlineP         Name Inline RuleMatch Phases
+            | SpecialiseP     Name Type (Maybe Inline) Phases
+            | SpecialiseInstP Type
+            | RuleP           String [RuleBndr] Exp Exp Phases
+            | AnnP            AnnTarget Exp
+        deriving( Show, Eq, Data, Typeable )
+
+data Inline = NoInline
+            | Inline
+            | Inlinable
+            deriving (Show, Eq, Data, Typeable)
+
+data RuleMatch = ConLike
+               | FunLike
+               deriving (Show, Eq, Data, Typeable)
+
+data Phases = AllPhases
+            | FromPhase Int
+            | BeforePhase Int
+            deriving (Show, Eq, Data, Typeable)
+
+data RuleBndr = RuleVar Name
+              | TypedRuleVar Name Type
+              deriving (Show, Eq, Data, Typeable)
+
+data AnnTarget = ModuleAnnotation
+               | TypeAnnotation Name
+               | ValueAnnotation Name
+              deriving (Show, Eq, Data, Typeable)
+
+type Cxt = [Pred]                 -- ^ @(Eq a, Ord b)@
+
+-- | Since the advent of @ConstraintKinds@, constraints are really just types.
+-- Equality constraints use the 'EqualityT' constructor. Constraints may also
+-- be tuples of other constraints.
+type Pred = Type
+
+data Strict = IsStrict | NotStrict | Unpacked
+         deriving( Show, Eq, Data, Typeable )
+
+data Con = NormalC Name [StrictType]          -- ^ @C Int a@
+         | RecC Name [VarStrictType]          -- ^ @C { v :: Int, w :: a }@
+         | InfixC StrictType Name StrictType  -- ^ @Int :+ a@
+         | ForallC [TyVarBndr] Cxt Con        -- ^ @forall a. Eq a => C [a]@
+         deriving( Show, Eq, Data, Typeable )
+
+type StrictType = (Strict, Type)
+type VarStrictType = (Name, Strict, Type)
+
+data Type = ForallT [TyVarBndr] Cxt Type  -- ^ @forall \<vars\>. \<ctxt\> -> \<type\>@
+          | AppT Type Type                -- ^ @T a b@
+          | SigT Type Kind                -- ^ @t :: k@
+          | VarT Name                     -- ^ @a@
+          | ConT Name                     -- ^ @T@
+          | PromotedT Name                -- ^ @'T@
+
+          -- See Note [Representing concrete syntax in types]
+          | TupleT Int                    -- ^ @(,), (,,), etc.@
+          | UnboxedTupleT Int             -- ^ @(#,#), (#,,#), etc.@
+          | ArrowT                        -- ^ @->@
+          | EqualityT                     -- ^ @~@
+          | ListT                         -- ^ @[]@
+          | PromotedTupleT Int            -- ^ @'(), '(,), '(,,), etc.@
+          | PromotedNilT                  -- ^ @'[]@
+          | PromotedConsT                 -- ^ @(':)@
+          | StarT                         -- ^ @*@
+          | ConstraintT                   -- ^ @Constraint@
+          | LitT TyLit                    -- ^ @0,1,2, etc.@
+      deriving( Show, Eq, Data, Typeable )
+
+data TyVarBndr = PlainTV  Name            -- ^ @a@
+               | KindedTV Name Kind       -- ^ @(a :: k)@
+      deriving( Show, Eq, Data, Typeable )
+
+data TyLit = NumTyLit Integer             -- ^ @2@
+           | StrTyLit String              -- ^ @"Hello"@
+  deriving ( Show, Eq, Data, Typeable )
+
+-- | Role annotations
+data Role = NominalR            -- ^ @nominal@
+          | RepresentationalR   -- ^ @representational@
+          | PhantomR            -- ^ @phantom@
+          | InferR              -- ^ @_@
+  deriving( Show, Eq, Data, Typeable )
+
+-- | Annotation target for reifyAnnotations
+data AnnLookup = AnnLookupModule Module
+               | AnnLookupName Name
+               deriving( Show, Eq, Data, Typeable )
+
+-- | To avoid duplication between kinds and types, they
+-- are defined to be the same. Naturally, you would never
+-- have a type be 'StarT' and you would never have a kind
+-- be 'SigT', but many of the other constructors are shared.
+-- Note that the kind @Bool@ is denoted with 'ConT', not
+-- 'PromotedT'. Similarly, tuple kinds are made with 'TupleT',
+-- not 'PromotedTupleT'.
+
+type Kind = Type
+
+{- Note [Representing concrete syntax in types]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Haskell has a rich concrete syntax for types, including
+  t1 -> t2, (t1,t2), [t], and so on
+In TH we represent all of this using AppT, with a distinguished
+type constructor at the head.  So,
+  Type              TH representation
+  -----------------------------------------------
+  t1 -> t2          ArrowT `AppT` t2 `AppT` t2
+  [t]               ListT `AppT` t
+  (t1,t2)	    TupleT 2 `AppT` t1 `AppT` t2
+  '(t1,t2)          PromotedTupleT 2 `AppT` t1 `AppT` t2
+
+But if the original HsSyn used prefix application, we won't use
+these special TH constructors.  For example
+  [] t              ConT "[]" `AppT` t
+  (->) t            ConT "->" `AppT` t
+In this way we can faithfully represent in TH whether the original
+HsType used concrete syntax or not.
+
+The one case that doesn't fit this pattern is that of promoted lists
+  '[ Maybe, IO ]    PromotedListT 2 `AppT` t1 `AppT` t2
+but it's very smelly because there really is no type constructor
+corresponding to PromotedListT. So we encode HsExplicitListTy with
+PromotedConsT and PromotedNilT (which *do* have underlying type
+constructors):
+  '[ Maybe, IO ]    PromotedConsT `AppT` Maybe `AppT`
+                    (PromotedConsT  `AppT` IO `AppT` PromotedNilT)
+-}
+
+-----------------------------------------------------
+--		Internal helper functions
+-----------------------------------------------------
+
+cmpEq :: Ordering -> Bool
+cmpEq EQ = True
+cmpEq _  = False
+
+thenCmp :: Ordering -> Ordering -> Ordering
+thenCmp EQ o2 = o2
+thenCmp o1 _  = o1
diff --git a/libraries/template-haskell/Setup.hs b/libraries/template-haskell/Setup.hs
new file mode 100644
index 000000000000..6fa548caf71c
--- /dev/null
+++ b/libraries/template-haskell/Setup.hs
@@ -0,0 +1,6 @@
+module Main (main) where
+
+import Distribution.Simple
+
+main :: IO ()
+main = defaultMain
diff --git a/libraries/template-haskell/prologue.txt b/libraries/template-haskell/prologue.txt
new file mode 100644
index 000000000000..a7b2f021eca5
--- /dev/null
+++ b/libraries/template-haskell/prologue.txt
@@ -0,0 +1 @@
+Facilities for manipulating Haskell source code using Template Haskell.
diff --git a/libraries/template-haskell/template-haskell.cabal b/libraries/template-haskell/template-haskell.cabal
new file mode 100644
index 000000000000..db268be2128d
--- /dev/null
+++ b/libraries/template-haskell/template-haskell.cabal
@@ -0,0 +1,54 @@
+name:           template-haskell
+version:        2.10.0.0
+-- GHC 7.8.1 released with 2.9.0.0
+license:        BSD3
+license-file:   LICENSE
+category:       Template Haskell
+maintainer:     libraries@haskell.org
+bug-reports:    http://ghc.haskell.org/trac/ghc/newticket?component=Template%20Haskell
+synopsis:       Support library for Template Haskell
+build-type:     Simple
+Cabal-Version:  >= 1.10
+description:
+    This package provides modules containing facilities for manipulating
+    Haskell source code using Template Haskell.
+    .
+    See <http://www.haskell.org/haskellwiki/Template_Haskell> for more
+    information.
+
+source-repository head
+    type:     git
+    location: http://git.haskell.org/ghc.git
+    subdir:   libraries/template-haskell
+
+Library
+    default-language: Haskell2010
+    other-extensions:
+        DeriveDataTypeable
+        FlexibleInstances
+        MagicHash
+        PolymorphicComponents
+        RankNTypes
+        RoleAnnotations
+        ScopedTypeVariables
+        TemplateHaskell
+        UnboxedTuples
+
+    exposed-modules:
+        Language.Haskell.TH
+        Language.Haskell.TH.Lib
+        Language.Haskell.TH.Ppr
+        Language.Haskell.TH.PprLib
+        Language.Haskell.TH.Quote
+        Language.Haskell.TH.Syntax
+
+    other-modules:
+        Language.Haskell.TH.Lib.Map
+
+    build-depends:
+        base       == 4.7.*,
+        pretty     == 1.1.*
+
+    -- We need to set the package key to template-haskell (without a
+    -- version number) as it's magic.
+    ghc-options: -Wall -this-package-key template-haskell
diff --git a/libraries/template-haskell/tests/.gitignore b/libraries/template-haskell/tests/.gitignore
new file mode 100644
index 000000000000..f847e98adada
--- /dev/null
+++ b/libraries/template-haskell/tests/.gitignore
@@ -0,0 +1,16 @@
+*.eventlog
+*.genscript
+
+*.stderr.normalised
+*.stdout.normalised
+*.comp.stderr
+*.comp.stdout
+*.interp.stderr
+*.interp.stdout
+*.run.stderr
+*.run.stdout
+
+.hpc.*/
+.hpc/
+
+# specific files
diff --git a/libraries/template-haskell/tests/Makefile b/libraries/template-haskell/tests/Makefile
new file mode 100644
index 000000000000..6a0abcf1cf7f
--- /dev/null
+++ b/libraries/template-haskell/tests/Makefile
@@ -0,0 +1,7 @@
+# This Makefile runs the tests using GHC's testsuite framework.  It
+# assumes the package is part of a GHC build tree with the testsuite
+# installed in ../../../testsuite.
+
+TOP=../../../testsuite
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
diff --git a/libraries/template-haskell/tests/all.T b/libraries/template-haskell/tests/all.T
new file mode 100644
index 000000000000..716742a20ca6
--- /dev/null
+++ b/libraries/template-haskell/tests/all.T
@@ -0,0 +1,2 @@
+# difficult to test TH with profiling, because we have to build twice
+test('dataToExpQUnit', omit_ways(prof_ways), compile, ['-v0'])
diff --git a/libraries/template-haskell/tests/dataToExpQUnit.hs b/libraries/template-haskell/tests/dataToExpQUnit.hs
new file mode 100644
index 000000000000..1fac18776100
--- /dev/null
+++ b/libraries/template-haskell/tests/dataToExpQUnit.hs
@@ -0,0 +1,15 @@
+
+{-# LANGUAGE TemplateHaskell #-}
+
+module Foo where
+
+import Language.Haskell.TH
+import Language.Haskell.TH.Quote
+import System.IO
+
+$( do u1 <- runQ (dataToExpQ (const Nothing) ())
+      u2 <- runQ [| () |]
+      runIO $ print (u1 == u2)
+      runIO $ hFlush stdout
+      return []
+ )
diff --git a/libraries/template-haskell/tests/dataToExpQUnit.stderr b/libraries/template-haskell/tests/dataToExpQUnit.stderr
new file mode 100644
index 000000000000..0ca95142bb71
--- /dev/null
+++ b/libraries/template-haskell/tests/dataToExpQUnit.stderr
@@ -0,0 +1 @@
+True
diff --git a/libraries/time b/libraries/time
index d4f019b2c6a3..adafac26307c 160000
--- a/libraries/time
+++ b/libraries/time
@@ -1 +1 @@
-Subproject commit d4f019b2c6a332be5443b5bf88d0c7fef91523c6
+Subproject commit adafac26307cffab0be20c126385ab161c259237
diff --git a/libraries/transformers b/libraries/transformers
index a59fb93860f8..87d9892a604b 160000
--- a/libraries/transformers
+++ b/libraries/transformers
@@ -1 +1 @@
-Subproject commit a59fb93860f84ccd44178dcbbb82cfea7e02cd07
+Subproject commit 87d9892a604b56d687ce70f1d1abc7848f78c6e4
diff --git a/libraries/unix b/libraries/unix
new file mode 160000
index 000000000000..54fbbdecb673
--- /dev/null
+++ b/libraries/unix
@@ -0,0 +1 @@
+Subproject commit 54fbbdecb673705a67d5b9594503cf86d53265c9
diff --git a/libraries/vector b/libraries/vector
index 9baab444a57c..a6049abce040 160000
--- a/libraries/vector
+++ b/libraries/vector
@@ -1 +1 @@
-Subproject commit 9baab444a57c4a225ee247fea27187d1892d90bf
+Subproject commit a6049abce040713e9a5f175887cf70d12b9057c6
diff --git a/mk/build.mk.sample b/mk/build.mk.sample
index 94d09e147ddb..418988275898 100644
--- a/mk/build.mk.sample
+++ b/mk/build.mk.sample
@@ -14,6 +14,9 @@
 # As above but build GHC using the LLVM backend
 #BuildFlavour = perf-llvm
 
+# Perf build configured for a cross-compiler
+#BuildFlavour = perf-cross
+
 # Fast build with optimised libraries, no profiling (RECOMMENDED):
 #BuildFlavour = quick
 
@@ -37,6 +40,17 @@
 # A development build, working on the stage 2 compiler:
 #BuildFlavour = devel2
 
+# A build with max optimisation that still builds the stage2 compiler
+# quickly. Compiled code will be the same as with "perf". Programs
+# will compile more slowly.
+#BuildFlavour = bench
+
+# As above but build GHC using the LLVM backend
+#BuildFlavour = bench-llvm
+
+# Bench build configured for a cross-compiler
+#BuildFlavour = bench-cross
+
 # -------- Miscellaneous variables --------------------------------------------
 
 # Set to V = 0 to get prettier build output.
@@ -52,6 +66,9 @@ V = 1
 # working on stage 2 and want to freeze stage 1 and the libraries for
 # a while.
 
+# Uncomment the following line to enable building DPH
+#BUILD_DPH=YES
+
 GhcLibWays = $(if $(filter $(DYNAMIC_GHC_PROGRAMS),YES),v dyn,v)
 
 # ----------- A Performance/Distribution build --------------------------------
@@ -84,6 +101,26 @@ GhcHcOpts       = -Rghc-timing
 GhcLibHcOpts    = -O2
 GhcLibWays     += p
 
+endif
+
+# ------- A Perf build configured for cross-compilation ----------------------
+
+ifeq "$(BuildFlavour)" "perf-cross"
+
+SRC_HC_OPTS     = -O -H64m -fllvm
+GhcStage1HcOpts = -O2 -fllvm
+GhcStage2HcOpts = -O2 -fllvm
+GhcHcOpts       = -Rghc-timing
+GhcLibHcOpts    = -O2
+GhcLibWays     += p
+INTEGER_LIBRARY    = integer-simple
+Stage1Only         = YES
+
+HADDOCK_DOCS       = NO
+BUILD_DOCBOOK_HTML = NO
+BUILD_DOCBOOK_PS   = NO
+BUILD_DOCBOOK_PDF  = NO
+
 DYNAMIC_BY_DEFAULT   = NO
 DYNAMIC_GHC_PROGRAMS = NO
 
@@ -135,9 +172,6 @@ BUILD_DOCBOOK_HTML = NO
 BUILD_DOCBOOK_PS   = NO
 BUILD_DOCBOOK_PDF  = NO
 
-DYNAMIC_BY_DEFAULT   = NO
-DYNAMIC_GHC_PROGRAMS = NO
-
 endif
 
 # -------- A Fast build configured for cross-compilation ----------------------
@@ -215,6 +249,59 @@ LAX_DEPENDENCIES   = YES
 
 endif
 
+# -------- A bench build with optimised libs -----------------------------------
+
+ifeq "$(BuildFlavour)" "bench"
+
+SRC_HC_OPTS        = -O -H64m
+GhcStage1HcOpts    = -O -fasm
+GhcStage2HcOpts    = -O0 -fasm
+GhcLibHcOpts       = -O2 -fasm
+SplitObjs          = NO
+HADDOCK_DOCS       = NO
+BUILD_DOCBOOK_HTML = NO
+BUILD_DOCBOOK_PS   = NO
+BUILD_DOCBOOK_PDF  = NO
+
+endif
+
+# ---------------- Bench build using LLVM --------------------------------------
+
+ifeq "$(BuildFlavour)" "bench-llvm"
+
+SRC_HC_OPTS        = -O -H64m
+GhcStage1HcOpts    = -O -fllvm
+GhcStage2HcOpts    = -O0 -fllvm
+GhcLibHcOpts       = -O2 -fllvm
+SplitObjs          = NO
+HADDOCK_DOCS       = NO
+BUILD_DOCBOOK_HTML = NO
+BUILD_DOCBOOK_PS   = NO
+BUILD_DOCBOOK_PDF  = NO
+
+endif
+
+# ------- A Bench build configured for cross-compilation ----------------------
+
+ifeq "$(BuildFlavour)" "bench-cross"
+
+SRC_HC_OPTS        = -O -H64m
+GhcStage1HcOpts    = -O -fasm
+GhcStage2HcOpts    = -O0 -fasm
+GhcLibHcOpts       = -O2 -fasm
+SplitObjs          = NO
+INTEGER_LIBRARY    = integer-simple
+Stage1Only         = YES
+HADDOCK_DOCS       = NO
+BUILD_DOCBOOK_HTML = NO
+BUILD_DOCBOOK_PS   = NO
+BUILD_DOCBOOK_PDF  = NO
+
+DYNAMIC_BY_DEFAULT   = NO
+DYNAMIC_GHC_PROGRAMS = NO
+
+endif
+
 # -----------------------------------------------------------------------------
 # Other settings that might be useful
 
diff --git a/mk/config.mk.in b/mk/config.mk.in
index b3d699521635..cad260b32e2e 100644
--- a/mk/config.mk.in
+++ b/mk/config.mk.in
@@ -95,10 +95,11 @@ TargetElf = YES
 endif
 
 # Some platforms don't support shared libraries
-NoSharedLibsPlatformList = arm-unknown-linux \
-	powerpc-unknown-linux \
+NoSharedLibsPlatformList = powerpc-unknown-linux \
 	x86_64-unknown-mingw32 \
-	i386-unknown-mingw32
+	i386-unknown-mingw32 \
+	sparc-sun-solaris2 \
+	sparc-unknown-linux
 
 ifeq "$(SOLARIS_BROKEN_SHLD)" "YES"
 NoSharedLibsPlatformList += i386-unknown-solaris2
@@ -359,6 +360,11 @@ UseSystemLibFFI=@UseSystemLibFFI@
 FFILibDir=@FFILibDir@
 FFIIncludeDir=@FFIIncludeDir@
 
+# Include support for Linux perf_event?
+GhcRtsWithPerfEvent = @HavePerfEvent@
+
+# Include support for reading DWARF debugging information?
+GhcRtsWithDwarf = @HaveLibDwarf@
 
 ################################################################################
 #
@@ -387,8 +393,8 @@ endif
 BIN_DIST_NAME         = ghc-$(ProjectVersion)
 BIN_DIST_PREP_DIR     = bindistprep/$(BIN_DIST_NAME)
 BIN_DIST_PREP_TAR     = bindistprep/$(BIN_DIST_NAME)-$(TARGETPLATFORM).tar
-BIN_DIST_PREP_TAR_BZ2 = $(BIN_DIST_PREP_TAR).bz2
-BIN_DIST_TAR_BZ2      = $(BIN_DIST_NAME)-$(TARGETPLATFORM).tar.bz2
+BIN_DIST_PREP_TAR_COMP = $(BIN_DIST_PREP_TAR).$(TAR_COMP_EXT)
+BIN_DIST_TAR_COMP     = $(BIN_DIST_NAME)-$(TARGETPLATFORM).tar.$(TAR_COMP_EXT)
 
 # -----------------------------------------------------------------------------
 # Utilities programs: flags
@@ -422,6 +428,16 @@ BIN_DIST_TAR_BZ2      = $(BIN_DIST_NAME)-$(TARGETPLATFORM).tar.bz2
 #
 SRC_HC_OPTS += -H32m -O
 
+# Disable -O2 optimization. Otherwise amount of generated C code
+# makes things very slow to compile (~5 minutes on core-i7 for 'compiler/hsSyn/HsExpr.lhs')
+# and sometimes not compile at all (powerpc64 overflows something
+# on 'compiler/hsSyn/HsExpr.lhs').
+ifeq "$(GhcUnregisterised)" "YES"
+GhcStage1HcOpts=
+GhcStage2HcOpts=
+GhcStage3HcOpts=
+endif
+
 # -----------------------------------------------------------------------------
 # Names of programs in the GHC tree
 
@@ -473,6 +489,8 @@ GHC_PACKAGE_DB_FLAG = @GHC_PACKAGE_DB_FLAG@
 
 CMM_SINK_BOOTSTRAP_IS_NEEDED = @CMM_SINK_BOOTSTRAP_IS_NEEDED@
 
+SUPPORTS_PACKAGE_KEY = @SUPPORTS_PACKAGE_KEY@
+
 #-----------------------------------------------------------------------------
 # C compiler
 #
@@ -642,7 +660,7 @@ PIC			= pic
 RANLIB_CMD = @RANLIB_CMD@
 REAL_RANLIB_CMD = @REAL_RANLIB_CMD@
 SED			= @SedCmd@
-SHELL			= /bin/sh
+SHELL			= @SHELL@
 
 HaveDtrace		= @HaveDtrace@
 USE_DTRACE = $(HaveDtrace)
@@ -650,6 +668,7 @@ DTRACE			= @DtraceCmd@
 
 LD = @LdCmd@
 NM = @NmCmd@
+AR = @ArCmd@
 OBJDUMP = @ObjdumpCmd@
 
 LLC = @LlcCmd@
@@ -687,6 +706,24 @@ PATCH_CMD      = @PatchCmd@
 TAR_CMD        = @TarCmd@
 BZIP2_CMD      = bzip2
 GZIP_CMD       = gzip
+XZ_CMD         = xz -9e
+
+# bzip2 is default compression
+TAR_COMP      = bzip2
+
+# select compression command and .tar extension based on TAR_COMP value
+ifeq "$(TAR_COMP)" "bzip2"
+TAR_COMP_CMD  = $(BZIP2_CMD)
+TAR_COMP_EXT  = bz2
+else ifeq "$(TAR_COMP)" "gzip"
+TAR_COMP_CMD  = $(GZIP_CMD)
+TAR_COMP_EXT  = gz
+else ifeq "$(TAR_COMP)" "xz"
+TAR_COMP_CMD  = $(XZ_CMD)
+TAR_COMP_EXT  = xz
+else
+$(error $$(TAR_COMP) set to unknown value "$(TAR_COMP)" (supported: "bzip2", "gzip", "xz"))
+endif
 
 ifeq "$(Windows_Host)" "YES"
 TOUCH_CMD      = $(utils/touchy_dist_INPLACE)
@@ -760,24 +797,8 @@ else
 HSCOLOUR_SRCS = YES
 endif
 
-################################################################################
-#
-#		31-bit-Int Core files
-#
-################################################################################
-
-#
-# It is possible to configure the compiler and prelude to support 31-bit
-# integers, suitable for a back-end and RTS using a tag bit on a 32-bit
-# architecture.  Currently the only useful output from this option is external Core
-# files.  The following additions to your build.mk will produce the
-# 31-bit core output.  Note that this is *not* just a library "way"; the
-# compiler must be built a special way too.
-
-# GhcCppOpts +=-DWORD_SIZE_IN_BITS=31
-# GhcLibHcOpts +=-fext-core -fno-code -DWORD_SIZE_IN_BITS=31
-# GhcLibCppOpts += -DWORD_SIZE_IN_BITS=31
-# SplitObjs=NO
+# Build DPH?
+BUILD_DPH = NO
 
 ################################################################################
 #
diff --git a/mk/fptools.css b/mk/fptools.css
index 97f276c8d550..7a2b39b10cdb 100644
--- a/mk/fptools.css
+++ b/mk/fptools.css
@@ -23,6 +23,8 @@ pre {
 pre.screen         { color: #006400 }
 pre.programlisting { color: maroon }
 
+code.option { white-space: nowrap }
+
 div.example {
   margin: 1ex 0em;
   border: solid #412e25 1px;
diff --git a/mk/validate-settings.mk b/mk/validate-settings.mk
index 8797bf9a7368..cac938dbdeba 100644
--- a/mk/validate-settings.mk
+++ b/mk/validate-settings.mk
@@ -32,7 +32,6 @@ SRC_HC_OPTS     += $(WERROR) -Wall
 
 GhcStage1HcOpts += -fwarn-tabs
 GhcStage2HcOpts += -fwarn-tabs
-GhcStage2HcOpts += -fno-warn-amp # Temporary sledgehammer until we sync upstream.
 
 utils/hpc_dist-install_EXTRA_HC_OPTS += -fwarn-tabs
 
@@ -46,7 +45,6 @@ GhcStage2HcOpts += -O -dcore-lint
 # running of the tests, and faster building of the utils to be installed
 
 GhcLibHcOpts    += -O -dcore-lint
-GhcLibHcOpts    += -fno-warn-amp # Temporary sledgehammer until we sync upstream.
 
 # We define DefaultFastGhcLibWays in this style so that the value is
 # correct even if the user alters DYNAMIC_GHC_PROGRAMS.
diff --git a/nofib b/nofib
new file mode 160000
index 000000000000..5bc1c75db2c7
--- /dev/null
+++ b/nofib
@@ -0,0 +1 @@
+Subproject commit 5bc1c75db2c74413959772c85d43f8171fdd7b8c
diff --git a/packages b/packages
index 616dfc1d8912..e3855c2c49f5 100644
--- a/packages
+++ b/packages
@@ -26,7 +26,10 @@
 #   * 'remotepath' is where the repository is in the central repository.
 #     It is - for submodules.
 #   * 'upstreamurl' is the upstream Git repo location for packages
-#     maintained outside of GHC HQ.
+#     maintained outside of GHC HQ. Repositories which are hosted on
+#     GitHub and GHC developers are granted push-rights for are denoted by
+#     being specified with the `ssh://` scheme. Thus, `https://`
+#     repo urls denote read-only access.
 #
 #   * The 'tag' determines when "sync-all get" will get the
 #     repo. If the tag is "-" then it will always get it, but if there
@@ -45,42 +48,37 @@
 # localpath                  tag         remotepath                      upstreamurl
 # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 ghc-tarballs                 windows     ghc-tarballs.git                -
-libffi-tarballs              -           libffi-tarballs.git             -
-utils/hsc2hs                 -           hsc2hs.git                      -
-utils/haddock                -           haddock.git                     -
-libraries/array              -           packages/array.git              -
-libraries/base               -           packages/base.git               -
+libffi-tarballs              -           -                               -
+utils/hsc2hs                 -           -                               -
+utils/haddock                -           -                               ssh://git@github.com/haskell/haddock.git
+libraries/array              -           -                               -
 libraries/binary             -           -                               https://github.com/kolmodin/binary.git
 libraries/bytestring         -           -                               https://github.com/haskell/bytestring.git
 libraries/Cabal              -           -                               https://github.com/haskell/cabal.git
 libraries/containers         -           -                               https://github.com/haskell/containers.git
-libraries/deepseq            -           packages/deepseq.git            -
-libraries/directory          -           packages/directory.git          -
-libraries/filepath           -           packages/filepath.git           -
-libraries/ghc-prim           -           packages/ghc-prim.git           -
+libraries/deepseq            -           -                               -
+libraries/directory          -           -                               -
+libraries/filepath           -           -                               -
 libraries/haskeline          -           -                               https://github.com/judah/haskeline.git
-libraries/haskell98          -           packages/haskell98.git          -
-libraries/haskell2010        -           packages/haskell2010.git        -
-libraries/hoopl              -           packages/hoopl.git              -
-libraries/hpc                -           packages/hpc.git                -
-libraries/integer-gmp        -           packages/integer-gmp.git        -
-libraries/integer-simple     -           packages/integer-simple.git     -
-libraries/old-locale         -           packages/old-locale.git         -
-libraries/old-time           -           packages/old-time.git           -
+libraries/haskell98          -           -                               -
+libraries/haskell2010        -           -                               -
+libraries/hoopl              -           -                               -
+libraries/hpc                -           -                               -
+libraries/old-locale         -           -                               -
+libraries/old-time           -           -                               -
 libraries/pretty             -           -                               https://github.com/haskell/pretty.git
-libraries/process            -           packages/process.git            -
-libraries/template-haskell   -           packages/template-haskell.git   -
+libraries/process            -           -                               -
 libraries/terminfo           -           -                               https://github.com/judah/terminfo.git
-libraries/time               -           -                               http://git.haskell.org/darcs-mirrors/time.git
+libraries/time               -           -                               https://github.com/haskell/time.git
 libraries/transformers       -           -                               http://git.haskell.org/darcs-mirrors/transformers.git
-libraries/unix               -           packages/unix.git               -
+libraries/unix               -           -                               ssh://git@github.com/haskell/unix.git
 libraries/Win32              -           -                               https://github.com/haskell/win32.git
 libraries/xhtml              -           -                               https://github.com/haskell/xhtml.git
-nofib                        nofib       nofib.git                       -
-libraries/parallel           extra       packages/parallel.git           -
-libraries/stm                extra       packages/stm.git                -
+nofib                        nofib       -                               -
+libraries/parallel           extra       -                               -
+libraries/stm                extra       -                               -
 libraries/random             dph         -                               https://github.com/haskell/random.git
 libraries/primitive          dph         -                               https://github.com/haskell/primitive.git
 libraries/vector             dph         -                               https://github.com/haskell/vector.git
-libraries/dph                dph         packages/dph.git                -
+libraries/dph                dph         -                               -
 .                            -           ghc.git                         -
diff --git a/rts/Adjustor.c b/rts/Adjustor.c
index 83d5a73cf5d9..3c65da6784c8 100644
--- a/rts/Adjustor.c
+++ b/rts/Adjustor.c
@@ -1321,3 +1321,11 @@ freeHaskellFunctionPtr(void* ptr)
 }
 
 #endif // !USE_LIBFFI_FOR_ADJUSTORS
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/Apply.h b/rts/Apply.h
index 1c0b1623d913..4df567feee28 100644
--- a/rts/Apply.h
+++ b/rts/Apply.h
@@ -24,3 +24,11 @@ extern RTS_PRIVATE StgFun *stg_stack_save_entries[];
 #endif
 
 #endif /* APPLY_H */
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/Arena.c b/rts/Arena.c
index 361c6c41be1b..92e479b89d64 100644
--- a/rts/Arena.c
+++ b/rts/Arena.c
@@ -8,7 +8,7 @@
 
    Do not assume that sequentially allocated objects will be adjacent
    in memory.
-   
+
    Quirks: this allocator makes use of the RTS block allocator.  If
    the current block doesn't have enough room for the requested
    object, then a new block is allocated.  This means that allocating
@@ -27,11 +27,11 @@
 // Each arena struct is allocated using malloc().
 struct _Arena {
     bdescr *current;
-    StgWord *free;		// ptr to next free byte in current block
-    StgWord *lim;		// limit (== last free byte + 1)
+    StgWord *free;              // ptr to next free byte in current block
+    StgWord *lim;               // limit (== last free byte + 1)
 };
 
-// We like to keep track of how many blocks we've allocated for 
+// We like to keep track of how many blocks we've allocated for
 // Storage.c:memInventory().
 static long arena_blocks = 0;
 
@@ -74,26 +74,26 @@ arenaAlloc( Arena *arena, size_t size )
     size_w = B_TO_W(size);
 
     if ( arena->free + size_w < arena->lim ) {
-	// enough room in the current block...
-	p = arena->free;
-	arena->free += size_w;
-	return p;
+        // enough room in the current block...
+        p = arena->free;
+        arena->free += size_w;
+        return p;
     } else {
-	// allocate a fresh block...
-	req_blocks =  (W_)BLOCK_ROUND_UP(size) / BLOCK_SIZE;
-	bd = allocGroup_lock(req_blocks);
-	arena_blocks += req_blocks;
+        // allocate a fresh block...
+        req_blocks =  (W_)BLOCK_ROUND_UP(size) / BLOCK_SIZE;
+        bd = allocGroup_lock(req_blocks);
+        arena_blocks += req_blocks;
 
-	bd->gen_no  = 0;
-	bd->gen     = NULL;
+        bd->gen_no  = 0;
+        bd->gen     = NULL;
         bd->dest_no = 0;
-	bd->flags   = 0;
-	bd->free    = bd->start;
-	bd->link    = arena->current;
-	arena->current = bd;
-	arena->free = bd->free + size_w;
-	arena->lim = bd->free + bd->blocks * BLOCK_SIZE_W;
-	return bd->start;
+        bd->flags   = 0;
+        bd->free    = bd->start;
+        bd->link    = arena->current;
+        arena->current = bd;
+        arena->free = bd->free + size_w;
+        arena->lim = bd->free + bd->blocks * BLOCK_SIZE_W;
+        return bd->start;
     }
 }
 
@@ -104,10 +104,10 @@ arenaFree( Arena *arena )
     bdescr *bd, *next;
 
     for (bd = arena->current; bd != NULL; bd = next) {
-	next = bd->link;
-	arena_blocks -= bd->blocks;
-	ASSERT(arena_blocks >= 0);
-	freeGroup_lock(bd);
+        next = bd->link;
+        arena_blocks -= bd->blocks;
+        ASSERT(arena_blocks >= 0);
+        freeGroup_lock(bd);
     }
     stgFree(arena);
 }
@@ -118,3 +118,10 @@ arenaBlocks( void )
     return arena_blocks;
 }
 
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/Arena.h b/rts/Arena.h
index 086a0200adcc..ac62c6cf3811 100644
--- a/rts/Arena.h
+++ b/rts/Arena.h
@@ -23,3 +23,11 @@ RTS_PRIVATE void arenaFree  ( Arena * );
 RTS_PRIVATE unsigned long arenaBlocks( void );
 
 #endif /* ARENA_H */
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/AutoApply.h b/rts/AutoApply.h
index f64bc6d894f6..ee756be02b6f 100644
--- a/rts/AutoApply.h
+++ b/rts/AutoApply.h
@@ -89,3 +89,11 @@
 
 #endif /* APPLY_H */
 
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/AwaitEvent.h b/rts/AwaitEvent.h
index ecc13b8ff298..e80d351ab44e 100644
--- a/rts/AwaitEvent.h
+++ b/rts/AwaitEvent.h
@@ -22,3 +22,11 @@ RTS_PRIVATE void awaitEvent(rtsBool wait);  /* In posix/Select.c or
 #endif
 
 #endif /* AWAITEVENT_H */
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/BeginPrivate.h b/rts/BeginPrivate.h
index 6471b92a4076..f7b7d198f0c0 100644
--- a/rts/BeginPrivate.h
+++ b/rts/BeginPrivate.h
@@ -8,3 +8,11 @@
 #if defined(HAS_VISIBILITY_HIDDEN) && !defined(freebsd_HOST_OS)
 #pragma GCC visibility push(hidden)
 #endif
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/Capability.c b/rts/Capability.c
index 5988d4205cd4..605a1397634a 100644
--- a/rts/Capability.c
+++ b/rts/Capability.c
@@ -273,6 +273,8 @@ initCapability( Capability *cap, nat i )
 	cap->mut_lists[g] = NULL;
     }
 
+    cap->weak_ptr_list_hd = NULL;
+    cap->weak_ptr_list_tl = NULL;
     cap->free_tvar_watch_queues = END_STM_WATCH_QUEUE;
     cap->free_invariant_check_queues = END_INVARIANT_CHECK_QUEUE;
     cap->free_trec_chunks = END_STM_CHUNK_LIST;
@@ -288,6 +290,23 @@ initCapability( Capability *cap, nat i )
     cap->r.rCCCS = NULL;
 #endif
 
+#ifdef TRACING
+    if (RtsFlags.TraceFlags.allocSampling) {
+        switch(RtsFlags.TraceFlags.allocSampling) {
+        case SAMPLE_BY_HEAP_ALLOC: cap->heap_ip_sample_count = 0; break;
+        case SAMPLE_BY_STACK_ALLOC:
+            cap->heap_ip_sample_count = 2*HEAP_ALLOC_MAX_SAMPLES; break;
+        default: barf("Unknown allocation sampling method %d", RtsFlags.TraceFlags.allocSampling);
+        }
+        cap->heap_ip_samples = stgMallocBytes(
+            sizeof(void *) * HEAP_ALLOC_MAX_SAMPLES,
+            "initCapability");
+    } else {
+        cap->heap_ip_sample_count = HEAP_ALLOC_MAX_SAMPLES; // "full"
+        cap->heap_ip_samples = NULL;
+    }
+#endif
+
     traceCapCreate(cap);
     traceCapsetAssignCap(CAPSET_OSPROCESS_DEFAULT, i);
     traceCapsetAssignCap(CAPSET_CLOCKDOMAIN_DEFAULT, i);
@@ -357,15 +376,18 @@ moreCapabilities (nat from USED_IF_THREADS, nat to USED_IF_THREADS)
         // BaseReg (eg. unregisterised), so in this case
 	// capabilities[0] must coincide with &MainCapability.
         capabilities[0] = &MainCapability;
+        initCapability(&MainCapability, 0);
     }
-
-    for (i = 0; i < to; i++) {
-        if (i < from) {
-            capabilities[i] = old_capabilities[i];
-        } else {
-            capabilities[i] = stgMallocBytes(sizeof(Capability),
-                                             "moreCapabilities");
-            initCapability(capabilities[i], i);
+    else
+    {
+        for (i = 0; i < to; i++) {
+            if (i < from) {
+                capabilities[i] = old_capabilities[i];
+            } else {
+                capabilities[i] = stgMallocBytes(sizeof(Capability),
+                                                 "moreCapabilities");
+                initCapability(capabilities[i], i);
+            }
         }
     }
 
@@ -983,7 +1005,8 @@ freeCapabilities (void)
     nat i;
     for (i=0; i < n_capabilities; i++) {
         freeCapability(capabilities[i]);
-        stgFree(capabilities[i]);
+        if (capabilities[i] != &MainCapability)
+            stgFree(capabilities[i]);
     }
 #else
     freeCapability(&MainCapability);
@@ -1069,3 +1092,11 @@ rtsBool checkSparkCountInvariant (void)
 
 }
 #endif
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/Capability.h b/rts/Capability.h
index f342d9224453..800445d2a495 100644
--- a/rts/Capability.h
+++ b/rts/Capability.h
@@ -79,6 +79,11 @@ struct Capability_ {
     // full pinned object blocks allocated since the last GC
     bdescr *pinned_object_blocks;
 
+    // per-capability weak pointer list associated with nursery (older
+    // lists stored in generation object)
+    StgWeak *weak_ptr_list_hd;
+    StgWeak *weak_ptr_list_tl;
+
     // Context switch flag.  When non-zero, this means: stop running
     // Haskell code, and switch threads.
     int context_switch;
@@ -93,6 +98,11 @@ struct Capability_ {
     // reset after we have executed the context switch.
     int interrupt;
 
+    // Heap instruction pointer profiling (only active with TRACING,
+    // but we need offsets to always be valid)
+    StgWord heap_ip_sample_count;
+    void **heap_ip_samples;
+
 #if defined(THREADED_RTS)
     // Worker Tasks waiting in the wings.  Singly-linked.
     Task *spare_workers;
@@ -421,3 +431,11 @@ INLINE_HEADER rtsBool emptyInbox(Capability *cap)
 #include "EndPrivate.h"
 
 #endif /* CAPABILITY_H */
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/CheckUnload.c b/rts/CheckUnload.c
index 8692dea8bf7e..170e8861f09b 100644
--- a/rts/CheckUnload.c
+++ b/rts/CheckUnload.c
@@ -198,6 +198,14 @@ static void searchHeapBlocks (HashTable *addrs, bdescr *bd)
 		prim = rtsTrue;
 		size = mut_arr_ptrs_sizeW((StgMutArrPtrs *)p);
 		break;
+
+	    case SMALL_MUT_ARR_PTRS_CLEAN:
+	    case SMALL_MUT_ARR_PTRS_DIRTY:
+	    case SMALL_MUT_ARR_PTRS_FROZEN:
+	    case SMALL_MUT_ARR_PTRS_FROZEN0:
+		prim = rtsTrue;
+		size = small_mut_arr_ptrs_sizeW((StgSmallMutArrPtrs *)p);
+		break;
 		
 	    case TSO:
 		prim = rtsTrue;
@@ -290,7 +298,7 @@ void checkUnload (StgClosure *static_objects)
   // marked as unreferenced can be physically unloaded, because we
   // have no references to it.
   prev = NULL;
-  for (oc = unloaded_objects; oc; prev = oc, oc = next) {
+  for (oc = unloaded_objects; oc; oc = next) {
       next = oc->next;
       if (oc->referenced == 0) {
           if (prev == NULL) {
@@ -304,8 +312,17 @@ void checkUnload (StgClosure *static_objects)
       } else {
           IF_DEBUG(linker, debugBelch("Object file still in use: %"
                                       PATH_FMT "\n", oc->fileName));
+          prev = oc;
       }
   }
 
   freeHashTable(addrs, NULL);
 }
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/CheckUnload.h b/rts/CheckUnload.h
index 7d2e5b1321cd..9c2bac89f1c6 100644
--- a/rts/CheckUnload.h
+++ b/rts/CheckUnload.h
@@ -18,3 +18,11 @@ void checkUnload (StgClosure *static_objects);
 #include "EndPrivate.h"
 
 #endif // CHECKUNLOAD_H
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/ClosureFlags.c b/rts/ClosureFlags.c
index 020f28438ab1..def33eb9a9ae 100644
--- a/rts/ClosureFlags.c
+++ b/rts/ClosureFlags.c
@@ -81,9 +81,21 @@ StgWord16 closure_flags[] = {
  [ATOMICALLY_FRAME]     =  (     _BTM                                  ),
  [CATCH_RETRY_FRAME]    =  (     _BTM                                  ),
  [CATCH_STM_FRAME]      =  (     _BTM                                  ),
- [WHITEHOLE]            =  ( 0                                         )
+ [WHITEHOLE]            =  ( 0                                         ),
+ [SMALL_MUT_ARR_PTRS_CLEAN]   =  (_HNF|     _NS|         _MUT|_UPT           ),
+ [SMALL_MUT_ARR_PTRS_DIRTY]   =  (_HNF|     _NS|         _MUT|_UPT           ),
+ [SMALL_MUT_ARR_PTRS_FROZEN0] =  (_HNF|     _NS|         _MUT|_UPT           ),
+ [SMALL_MUT_ARR_PTRS_FROZEN]  =  (_HNF|     _NS|              _UPT           )
 };
 
-#if N_CLOSURE_TYPES != 61
+#if N_CLOSURE_TYPES != 65
 #error Closure types changed: update ClosureFlags.c!
 #endif
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/Disassembler.c b/rts/Disassembler.c
index 44f487da899b..36cd7b559554 100644
--- a/rts/Disassembler.c
+++ b/rts/Disassembler.c
@@ -316,3 +316,11 @@ void disassemble( StgBCO *bco )
 }
 
 #endif /* DEBUG */
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/Disassembler.h b/rts/Disassembler.h
index c6f71564c48a..277361bc6bf2 100644
--- a/rts/Disassembler.h
+++ b/rts/Disassembler.h
@@ -17,3 +17,11 @@ RTS_PRIVATE void disassemble( StgBCO *bco );
 #endif
 
 #endif /* DISASSEMBLER_H */
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/Dwarf.c b/rts/Dwarf.c
new file mode 100644
index 000000000000..81fa1bfa6a8d
--- /dev/null
+++ b/rts/Dwarf.c
@@ -0,0 +1,1206 @@
+
+// For reading DWARF debug data of our own executable as well as all
+// dynamically linked-in libraries. Uses libdwarf, this is
+// roughly adapted from their simplereader.c example.
+
+#ifdef USE_DWARF /* ugly? */
+
+#include "Rts.h"
+#include "RtsUtils.h"
+
+#include "Dwarf.h"
+#include "Trace.h"
+
+#include "dwarf.h"
+#include "libdwarf.h"
+#include "gelf.h"
+
+#include <sys/types.h>
+#include <sys/stat.h>
+#include <unistd.h>
+#include <stdio.h>
+#include <fcntl.h>
+#include <string.h>
+
+
+// As far as I know, there are two ways for getting at the program's
+// memory map on Linux:
+//
+//  1. Read /proc/self/maps
+//
+//  2. Use dl_iterate_phdr
+//
+// I am a bit unsure what the "preferred" method is here, given that
+// both aren't portable. For now I use the /proc/self/maps method
+// by default, as it also solves the problem of where to get the
+// location of the executable from.
+
+// #define USE_DL_ITERATE_PHDR
+
+
+#ifdef USE_DL_ITERATE_PHDR
+#define _GNU_SOURCE
+#include <link.h>
+#endif //USE_DL_ITERATE_PHDR
+
+// Global compilation unit list
+DwarfUnit *dwarf_units = 0;
+
+// Debugging data
+size_t dwarf_ghc_debug_data_size = 0;
+void *dwarf_ghc_debug_data = 0;
+
+#define GHC_DEBUG_DATA_SECTION ".debug_ghc"
+
+#define GHC_DEBUG_NO_ID ((StgWord16) 0xffff)
+
+struct seg_space_
+{
+    void *base;         // Add this to position in file to get virtual address
+    void *start, *end;  // Limits of segment address space
+    size_t file_offset; // Where in the file the mapping begins
+    struct seg_space_ *next;
+};
+typedef struct seg_space_ seg_space;
+
+static void dwarf_get_code_bases(Elf *elf, seg_space *seg);
+static void dwarf_load_ghc_debug_data(Elf *elf);
+static void dwarf_load_symbols(char *file, Elf *elf, seg_space *seg);
+
+static void dwarf_load_file(char *module_path, seg_space *seg);
+static void dwarf_load_dies(DwarfUnit *unit, Dwarf_Debug dbg, Dwarf_Die die, seg_space *seg);
+static void dwarf_load_proc_die(DwarfUnit *unit, Dwarf_Debug dbg, Dwarf_Die die, seg_space *seg);
+static void dwarf_load_block_die(DwarfUnit *unit, Dwarf_Debug dbg, Dwarf_Die die, seg_space *seg);
+static char *dwarf_findname(Dwarf_Die die);
+
+static DwarfUnit *dwarf_new_unit(char *name, char *comp_dir);
+static DwarfProc *dwarf_new_proc(DwarfUnit *unit, char *name, Dwarf_Addr low_pc, Dwarf_Addr high_pc,
+                                 DwarfSource source, seg_space *seg);
+
+StgWord16 word16LE(StgWord8 *p);
+
+static void dwarf_associate_debug_data(StgBool trace);
+#ifdef TRACING
+static void dwarf_trace_unaccounted(DwarfUnit *unit, StgBool put_module);
+#endif
+
+#ifndef USE_DL_ITERATE_PHDR
+
+void dwarf_load()
+{
+	// Clear previous data, if any
+	dwarf_free();
+
+	// Initialize ELF library
+	if (elf_version(EV_CURRENT) == EV_NONE) {
+		errorBelch("libelf version too old!");
+		return;
+	}
+
+	// Open our process' memory map
+	FILE *map_file = fopen("/proc/self/maps", "r");
+	if (!map_file) {
+		sysErrorBelch("Could not read /proc/self/map!");
+		return;
+	}
+
+	// Accumulated segments for the same file. We assume that all
+	// segments for a file are going to be listed together, so we
+	// don't have to maintain a real map.
+	seg_space *segs = NULL;
+	char *cur_module = NULL;
+
+	// Read out mappings
+	char line[1025];
+	while (!feof(map_file)) {
+
+		// Read a line
+		void *seg_start = 0, *seg_end = 0;
+		char exec_perm = '-';
+		char module_path[255+1] = "";
+		unsigned int offset;
+		if (!fgets(line, 1024, map_file))
+			break;
+		if (!sscanf(line, "%p-%p %*c%*c%c%*c %x %*x:%*x %*d %255s",
+		            &seg_start, &seg_end, &exec_perm, &offset, module_path) > 0)
+			break;
+
+		// Different module? Load its segments
+		if (segs && strcmp(cur_module, module_path)) {
+			dwarf_load_file(cur_module, segs);
+			free(cur_module); cur_module = NULL;
+			seg_space *seg;
+			while ((seg = segs)) {
+				segs = seg->next;
+				stgFree(seg);
+			}
+		}
+
+		// Add to list, if it is an executable section
+		if (exec_perm == 'x' && module_path[0] && module_path[0] != '[') {
+			if (!cur_module) cur_module = strdup(module_path);
+			seg_space *seg = (seg_space *)stgMallocBytes(sizeof(seg_space), "dwarf_new_seg_space");
+			seg->base = NULL; // Might get corrected later
+			seg->start = seg_start;
+			seg->end = seg_end;
+			seg->file_offset = offset;
+			seg->next = segs;
+			segs = seg;
+		}
+
+	}
+
+	// Process any remaining segments
+	if (segs) {
+		dwarf_load_file(cur_module, segs);
+		free(cur_module); cur_module = NULL;
+		seg_space *seg;
+		while ((seg = segs)) {
+			segs = seg->next;
+			stgFree(seg);
+		}
+	}
+
+	fclose(map_file);
+}
+
+#else // USE_DL_ITERATE_PHDR
+
+int dwarf_load_by_phdr(struct dl_phdr_info *info, size_t size, void *data);
+
+void dwarf_load()
+{
+	// Initialize ELF library
+	if (elf_version(EV_CURRENT) == EV_NONE) {
+		errorBelch("libelf version too old!");
+		return;
+	}
+
+	// Get own executable path
+	char exe_path[1024+1];
+	int len = readlink("/proc/self/exe", exe_path, sizeof(exe_path)-1);
+	if (len < 0) {
+		sysErrorBelch("Could not read /proc/self/exe!");
+		return;
+	}
+	exe_path[len] = '\0';
+
+	// Iterate over our memory sections
+	struct dwarf_state state = { exe_path };
+	dl_iterate_phdr(&dwarf_load_by_phdr, &state);
+
+}
+
+int dwarf_load_by_phdr(struct dl_phdr_info *info, size_t size, void *data)
+{
+	struct dwarf_state *state = (struct dwarf_state *)data;
+
+	// Find range of executable code
+	void *code_start = 0, *code_end = 0;
+	void *code_base = 0;
+	int i;
+	for (i = 0; i < info->dlpi_phnum; i++) {
+		if (info->dlpi_phdr[i].p_type == PT_LOAD &&
+		    info->dlpi_phdr[i].p_flags & PF_X) {
+
+			// Start and end of (relevant part of) section
+			void *start = (void *)(info->dlpi_addr + info->dlpi_phdr[i].p_paddr);
+			void *end = start + info->dlpi_phdr[i].p_filesz;
+
+			// Find minimum, maximum
+			if (!code_start || start < code_start)
+				code_start = start;
+			if (end > code_end)
+				code_end = end;
+			code_base = start - info->dlpi_phdr[i].p_offset;
+		}
+	}
+
+	// No code found?
+	if (code_start >= code_end)
+		return 0;
+
+	// Open file
+	char *file = (char *)info->dlpi_name;
+	if (!*file) {
+		file = state->exe;
+		state->exe = 0;
+	}
+
+	// Only first entry without name is this file. Others is boring
+	// stuff like the stack.
+	if (!file)
+		return 0;
+
+	dwarf_load_file(file, code_base, 0);
+	return 0;
+}
+
+#endif // USE_DL_ITERATE_PHDR
+
+void dwarf_load_file(char *module_path, seg_space *seg)
+{
+
+	// Open the module
+	int fd = open(module_path, O_RDONLY);
+	if (fd < 0) {
+		sysErrorBelch("Could not open %s for reading debug data", module_path);
+		return;
+	}
+
+	// Open using libelf (no archives, don't need elf_next)
+	Elf *elf = elf_begin(fd, ELF_C_READ, 0);
+	if(!elf) {
+		errorBelch("Could not open ELF file: %s", elf_errmsg(elf_errno()));
+		close(fd);
+		return;
+	}
+
+	// Not actually an ELF file? That's okay, we are attempting this
+	// for pretty much all memory-mapped files, so we can expect to
+	// come across a few non-object files.
+	if (elf_kind(elf) != ELF_K_ELF) {
+		elf_end(elf);
+		close(fd);
+		return;
+	}
+
+	// Load debug data
+	dwarf_load_ghc_debug_data(elf);
+
+	// Find symbol address offset
+	dwarf_get_code_bases(elf, seg);
+
+	// Load symbols
+	dwarf_load_symbols(module_path, elf, seg);
+
+	// Open using libdwarf
+	Dwarf_Debug dbg; Dwarf_Error err;
+	if (dwarf_elf_init(elf, DW_DLC_READ, 0, 0, &dbg, &err) != DW_DLV_OK) {
+		errorBelch("Could not read debug data from %s: %s", module_path, dwarf_errmsg(err));
+		elf_end(elf);
+		close(fd);
+		return;
+	}
+
+	// Read compilation units
+	nat cu;
+	for (cu = 0; cu < 10000; cu++) {
+
+		Dwarf_Unsigned cu_header_length = 0;
+		Dwarf_Half version_stamp = 0;
+		Dwarf_Off abbrev_offset = 0;
+		Dwarf_Half address_size = 0;
+		Dwarf_Unsigned next_cu_header = 0;
+		Dwarf_Error error;
+
+		// Get compilation unit header
+		int res = dwarf_next_cu_header(dbg, &cu_header_length, &version_stamp,
+									   &abbrev_offset, &address_size,
+									   &next_cu_header, &error);
+		if (res == DW_DLV_NO_ENTRY)
+			break;
+		if (res != DW_DLV_OK) {
+			errorBelch("Could not read unit debug data from %s!", module_path);
+			break;
+		}
+
+		// Get root die
+		Dwarf_Die cu_die = 0;
+		if (dwarf_siblingof(dbg, 0, &cu_die, &error) != DW_DLV_OK) {
+			errorBelch("Could not a read root die from %s!", module_path);
+			break;
+		}
+
+		// Check that it is, in fact, a compilation unit die
+		Dwarf_Half tag = 0;
+		if (dwarf_tag(cu_die, &tag, &error) != DW_DLV_OK
+			|| tag != DW_TAG_compile_unit)
+			continue;
+
+		// Get name
+		char *name = 0;
+		if (dwarf_diename(cu_die, &name, &error) != DW_DLV_OK)
+			continue;
+
+		// Get compilation directory
+		Dwarf_Attribute attr;
+		char *comp_dir = 0;
+		if (dwarf_attr(cu_die, DW_AT_comp_dir, &attr, &error) != DW_DLV_OK
+			|| dwarf_formstring(attr, &comp_dir, &error) != DW_DLV_OK) {
+			continue;
+		}
+
+		// Create unit, if necessary
+		DwarfUnit *unit = dwarf_get_unit(name);
+		if (!unit) unit = dwarf_new_unit(name, comp_dir);
+
+		// Go through tree, log all ranges found
+		dwarf_load_dies(unit, dbg, cu_die, seg);
+
+	}
+
+	// Done with DWARF
+	Dwarf_Error error;
+	dwarf_finish(dbg, &error);
+
+	elf_end(elf);
+	close(fd);
+}
+
+void dwarf_get_code_bases(Elf *elf, seg_space *segs)
+{
+
+	// Process all segments
+	seg_space *seg;
+	for (seg = segs; seg; seg = seg->next) {
+
+		// Go through sections
+		Elf_Scn *scn = 0;
+		while ((scn = elf_nextscn(elf, scn))) {
+
+			// Get section header
+			GElf_Shdr hdr;
+			if (!gelf_getshdr(scn, &hdr))
+				continue;
+
+			// Ignore non-executable sections
+			if (!(hdr.sh_flags & SHF_EXECINSTR))
+				continue;
+
+			// This section not contained in the segment?
+			size_t seg_len = (StgWord8 *)seg->end - (StgWord8 *)seg->start;
+			if (hdr.sh_offset < seg->file_offset  ||
+				hdr.sh_offset >= seg->file_offset + seg_len)
+				continue;
+
+			// Calculate the symbol offset.
+			seg->base = (char *)seg->start - seg->file_offset - hdr.sh_addr + hdr.sh_offset;
+			break;
+		}
+	}
+}
+
+void dwarf_load_ghc_debug_data(Elf *elf)
+{
+
+	// Get section header string table index
+	size_t shdrstrndx;
+	if (elf_getshdrstrndx(elf, &shdrstrndx))
+		return;
+
+	// Iterate over all sections
+	Elf_Scn *scn = 0;
+	while ((scn = elf_nextscn(elf, scn))) {
+
+		// Get section header
+		GElf_Shdr hdr;
+		if (!gelf_getshdr(scn, &hdr))
+			return;
+
+		// Right name?
+		char *name = elf_strptr(elf, shdrstrndx, hdr.sh_name);
+		if (!name || strcmp(name, GHC_DEBUG_DATA_SECTION))
+			continue;
+
+		// Copy section contents to memory
+		Elf_Data *data = 0;
+		while ((data = elf_getdata(scn, data))) {
+			if (!data->d_buf)
+				continue;
+			// Enlarge buffer, append data block
+			dwarf_ghc_debug_data =
+			    stgReallocBytes(dwarf_ghc_debug_data,
+			                    dwarf_ghc_debug_data_size + data->d_size,
+			                    "dwarf_load_ghc_debug_data");
+			memcpy(((char *)dwarf_ghc_debug_data) + dwarf_ghc_debug_data_size,
+			       data->d_buf,
+			       data->d_size);
+			dwarf_ghc_debug_data_size += data->d_size;
+		}
+
+		// Try to find more sections with matching name - this might
+		// happen for example when compiling object files from LLVM
+		// and the native back-end together: They set different section
+		// flags, so they don't end up merged.
+	}
+
+}
+
+// Use "FILE" type annotations in symbol table to find out which files
+// the symbols originally came from. Sadly, this is not very useful
+// until
+//
+// 1. The backend starts generating proper .file directives
+//    into the assembler files. Probably straightforward for NCG,
+//    sadly less easy for LLVM, where it would have to be hacked in
+//    by the mangler, I think.
+//
+// 2. The linking stops discarding the generated FILE entries in
+//    the symbol tables. Right now the -x flag to ld has them all
+//    removed.
+//
+// On the other hand, being able to support this would make us
+// independent from another dependency...
+
+// #define GET_FILE_FROM_SYMTAB
+
+
+// Catch-all unit to use where we don't have (or chose to ignore) a
+// "file" entry in the symtab
+#define SYMTAB_UNIT_NAME "SYMTAB: %s"
+
+void dwarf_load_symbols(char *file, Elf *elf, seg_space *seg)
+{
+
+	// Locate symbol table section
+	Elf_Scn *scn = 0; GElf_Shdr hdr;
+	GElf_Shdr sym_shdr;
+	GElf_Half sym_shndx = ~0;
+	while ((scn = elf_nextscn(elf, scn))) {
+		if (!gelf_getshdr(scn, &hdr))
+			return;
+		if (hdr.sh_type != SHT_SYMTAB && hdr.sh_type != SHT_DYNSYM)
+			continue;
+		// Get data
+		Elf_Data *data = elf_getdata(scn, 0);
+		if (!data)
+			return;
+
+		// Find or create the catch-all unit for symtab entries
+		char symtab_unit_name[1024];
+		snprintf (symtab_unit_name, 1024, SYMTAB_UNIT_NAME, file);
+		DwarfUnit *unit = dwarf_get_unit(symtab_unit_name);
+		if (!unit) unit = dwarf_new_unit(symtab_unit_name, "");
+
+		// Iterate over symbols
+		nat ndx;
+		for (ndx = 1; ndx < hdr.sh_size / hdr.sh_entsize; ndx++) {
+
+			// Get symbol data
+			GElf_Sym sym;
+			if (gelf_getsym(data, ndx, &sym) != &sym) {
+				errorBelch("DWARF: Could not read symbol %d: %s\n", ndx, elf_errmsg(elf_errno()));
+				continue;
+			}
+
+			// Look up string
+			char *name = elf_strptr(elf, hdr.sh_link, sym.st_name);
+			if (!name) {
+				errorBelch("DWARF: Could not lookup name for symbol no %d: %s\n", ndx, elf_errmsg(elf_errno()));
+				continue;
+			}
+
+			// Load associated section header. Use cached one where
+			// applicable.
+			if (sym.st_shndx != sym_shndx) {
+				if (sym.st_shndx == SHN_ABS) {
+					memset(&sym_shdr, 0, sizeof(sym_shdr));
+				} else if(sym.st_shndx == SHN_UNDEF) {
+					continue;
+				} else {
+
+					Elf_Scn *sym_scn = elf_getscn(elf, sym.st_shndx);
+					if (gelf_getshdr(sym_scn, &sym_shdr) != &sym_shdr) {
+						memset(&sym_shdr, 0, sizeof(sym_shdr));
+					}
+				}
+				sym_shndx = sym.st_shndx;
+			}
+
+			// Type?
+			switch (GELF_ST_TYPE(sym.st_info)) {
+
+#ifdef GET_FILE_FROM_SYMTAB
+			case STT_FILE:
+
+				// Create unit, if necessary
+				unit = dwarf_get_unit(name);
+				if (!unit) unit = dwarf_new_unit(name, "");
+				break;
+#endif
+
+			// Haskell symbols can appear in the symbol table flagged as
+			// just about anything.
+			case STT_NOTYPE:
+			case STT_FUNC:
+			case STT_OBJECT:
+
+				// Only look at symbols from executable sections
+				if (!(sym_shdr.sh_flags & SHF_EXECINSTR) ||
+				    !(sym_shdr.sh_flags & SHF_ALLOC))
+					continue;
+
+				// Need a compilation unit to add name to. Ignore
+				// unaccounted-for names.
+				if (!unit)
+					break;
+
+				// Add procedure
+				dwarf_new_proc(unit, name,
+				               sym.st_value, sym.st_value+sym.st_size,
+				               DwarfSourceSymtab, seg);
+
+				break;
+			}
+		}
+
+	}
+}
+
+
+void dwarf_load_dies(DwarfUnit *unit, Dwarf_Debug dbg, Dwarf_Die die, seg_space *seg)
+{
+
+	// Load data from node
+	dwarf_load_proc_die(unit, dbg, die, seg);
+	dwarf_load_block_die(unit, dbg, die, seg);
+
+	// Recurse
+	Dwarf_Error error; Dwarf_Die child;
+	int res;
+	for (res = dwarf_child(die, &child, &error);
+	     res == DW_DLV_OK;
+	     res = dwarf_siblingof(dbg, child, &child, &error)) {
+
+		dwarf_load_dies(unit, dbg, child, seg);
+
+	}
+
+}
+
+static char *dwarf_findname(Dwarf_Die die) {
+
+	// Try MIPS_linkage_name first
+	char *name;
+	Dwarf_Attribute attr;
+	Dwarf_Error error;
+	if (dwarf_attr(die, DW_AT_MIPS_linkage_name, &attr, &error) == DW_DLV_OK
+	    && dwarf_formstring(attr, &name, &error) == DW_DLV_OK)
+		return name;
+
+	// Then the "normal" name
+	if (dwarf_diename(die, &name, &error) == DW_DLV_OK)
+		return name;
+
+	return 0;
+}
+
+void dwarf_load_proc_die(DwarfUnit *unit, Dwarf_Debug dbg, Dwarf_Die die, seg_space *seg)
+{
+
+	// Get node tag
+	Dwarf_Half tag = 0;
+	Dwarf_Error error;
+	if (dwarf_tag(die, &tag, &error) != DW_DLV_OK)
+		return;
+
+	// Only interested in procedures (inlined or not)
+	char *name = 0;
+	if (tag != DW_TAG_subprogram && tag != DW_TAG_inlined_subroutine)
+		return;
+
+	// Try to get name directly
+	Dwarf_Attribute attr;
+	if ( !(name = dwarf_findname(die)) ) {
+
+		// Locate abstract origin node, get name from there
+		Dwarf_Off ref; Dwarf_Die proc_die;
+		if (dwarf_attr(die, DW_AT_abstract_origin, &attr, &error) != DW_DLV_OK
+		    || dwarf_global_formref(attr, &ref, &error) != DW_DLV_OK
+		    || dwarf_offdie(dbg, ref, &proc_die, &error) != DW_DLV_OK
+		    || !(name = dwarf_findname(proc_die))) {
+
+			ref = 0;
+			dwarf_dieoffset(die, &ref, &error);
+			errorBelch("DWARF <%x>: subroutine without name or abstract origin!\n", (unsigned int)ref);
+			return;
+		}
+	}
+
+	// Get IP range
+	Dwarf_Addr low_pc, high_pc;
+	if (dwarf_attr(die, DW_AT_low_pc, &attr, &error) != DW_DLV_OK
+	    || dwarf_formaddr(attr, &low_pc, &error) != DW_DLV_OK
+	    || dwarf_attr(die, DW_AT_high_pc, &attr, &error) != DW_DLV_OK
+	    || dwarf_formaddr(attr, &high_pc, &error) != DW_DLV_OK) {
+
+		// This might happen for subroutines which only appear
+		// inlined. Those will have a DW_TAG_inlined_subroutine entry
+		// somewhere pointing here, so we can safely ignore the node
+		// for now.
+		return;
+	}
+
+	// Create the new procedure entry
+	dwarf_new_proc(unit, name, low_pc, high_pc, DwarfSourceDwarf, seg);
+
+}
+
+void dwarf_load_block_die(DwarfUnit *unit, Dwarf_Debug dbg, Dwarf_Die die, seg_space *seg)
+{
+
+    // Only interested in lexical blocks here
+    Dwarf_Half tag = 0;
+    Dwarf_Error error;
+    if (dwarf_tag(die, &tag, &error) != DW_DLV_OK
+        || tag != DW_TAG_lexical_block)
+        return;
+
+    // Block has a name?
+    char *bname = 0;
+    if (dwarf_diename(die, &bname, &error) != DW_DLV_OK) {
+
+        // Fallback to looking for a variable starting with
+        // "__debug_ghc_" (marker inserted by LLVM backend, as we
+        // can't name blocks there).
+        char *MARKER_PREFIX = "__debug_ghc_";
+        int marker_len = strlen(MARKER_PREFIX);
+        Dwarf_Die bchild;
+        Dwarf_Half btag = 0;
+        int res;
+        for (res = dwarf_child(die, &bchild, &error);
+             res == DW_DLV_OK;
+             res = dwarf_siblingof(dbg, bchild, &bchild, &error)) {
+
+            if (dwarf_tag(bchild, &btag, &error) != DW_DLV_OK
+                || btag != DW_TAG_variable)
+                continue;
+
+            // Get name, check prefix
+            if (dwarf_diename(bchild, &bname, &error) != DW_DLV_OK
+                || strncmp(bname, MARKER_PREFIX, marker_len)) {
+                bname = 0;
+                continue;
+            }
+
+            // Go over prefix - the rest of the string is the name of
+            // the block this code was generated from.
+            bname += marker_len;
+            break;
+        }
+
+    }
+
+    // Marker not found? Then this lexical block isn't interesting to
+    // us.
+    if (!bname)
+        return;
+
+    // Check if there is a simple low-pc/high-pc pair annotation
+	Dwarf_Attribute attr;
+    Dwarf_Addr low_pc, high_pc;
+    if (dwarf_attr(die, DW_AT_low_pc, &attr, &error) != DW_DLV_OK
+        || dwarf_formaddr(attr, &low_pc, &error) != DW_DLV_OK
+        || dwarf_attr(die, DW_AT_high_pc, &attr, &error) != DW_DLV_OK
+        || dwarf_formaddr(attr, &high_pc, &error) != DW_DLV_OK) {
+
+        // ... or possibly a more cumbersome range list
+        Dwarf_Off range_off;
+        if (dwarf_attr(die, DW_AT_ranges, &attr, &error) != DW_DLV_OK
+            || dwarf_global_formref(attr, &range_off, &error) != DW_DLV_OK) {
+
+            // No info? stop
+            return;
+
+        }
+
+        // Get range list
+        Dwarf_Ranges *ranges = 0;
+        Dwarf_Signed cnt = 0;
+        Dwarf_Unsigned bytes = 0;
+        if (dwarf_get_ranges_a(dbg,range_off,die,
+                               &ranges,&cnt,&bytes,&error) != DW_DLV_OK)
+            return;
+
+        // Emit a procedure for each range. Note this is pretty
+        // inefficient - but we don't expect this to happen too often,
+        // so it should be okay.
+        Dwarf_Signed i;
+        for (i = 0; i < cnt; i++) {
+            dwarf_new_proc(unit, bname, ranges[i].dwr_addr1, ranges[i].dwr_addr2,
+                           DwarfSourceDwarfBlock, seg);
+        }
+
+        // Dealloc range list
+        dwarf_ranges_dealloc(dbg, ranges, cnt);
+
+    } else {
+
+        // So we have a block with simple high_pc/low_pc
+        // annotation. Emit an entry for it.
+        dwarf_new_proc(unit, bname, low_pc, high_pc, DwarfSourceDwarfBlock, seg);
+
+
+    }
+
+}
+
+DwarfUnit *dwarf_get_unit(char *name)
+{
+	DwarfUnit *unit;
+	for (unit = dwarf_units; unit; unit = unit->next)
+		if (!strcmp(name, unit->name))
+			return unit;
+	return 0;
+}
+
+DwarfUnit *dwarf_new_unit(char *name, char *comp_dir)
+{
+	DwarfUnit *unit = (DwarfUnit *)stgMallocBytes(sizeof(DwarfUnit), "dwarf_new_unit");
+	unit->name = strdup(name);
+	unit->comp_dir = strdup(comp_dir);
+	unit->low_pc = NULL;
+	unit->high_pc = NULL;
+	unit->debug_data = NULL;
+	unit->procs = NULL;
+	unit->proc_count = 0;
+	unit->max_proc_id = 0;
+	unit->proc_table = allocStrHashTable();
+	unit->procs_by_id = NULL;
+	unit->procs_by_pc = NULL;
+	unit->next = dwarf_units;
+	dwarf_units = unit;
+	return unit;
+}
+
+DwarfProc *dwarf_get_proc(DwarfUnit *unit, char *name)
+{
+	return lookupStrHashTable(unit->proc_table, name);
+}
+
+DwarfProc *dwarf_new_proc(DwarfUnit *unit, char *name,
+                          Dwarf_Addr low_pc, Dwarf_Addr high_pc,
+                          DwarfSource source,
+                          seg_space *segs)
+{
+	// Security
+	if (high_pc <= low_pc)
+		return NULL;
+
+	// Apply offset to translate into our address space, then
+	// range-check so we don't associate it with the wrong
+	// memory region.
+	void *low_pc_ptr = NULL, *high_pc_ptr = NULL;
+	seg_space *seg;
+	for (seg = segs; seg; seg = seg->next) {
+		low_pc_ptr = (char *)seg->base + low_pc;
+		high_pc_ptr = (char *)seg->base + high_pc;
+
+		if ((char *)low_pc_ptr < (char *)seg->start ||
+			(char *)high_pc_ptr > (char *)seg->end) {
+
+			low_pc_ptr = high_pc_ptr = NULL;
+		}
+	}
+	if (!low_pc_ptr)
+		return NULL;
+
+	// Already have the proc? This can happen when there are multiple
+	// inlinings.
+	DwarfProc *after = dwarf_get_proc(unit, name);
+
+    // Always create new procedure entry no matter whether we already
+    // have the procedure or not (could optimize this in future...)
+	DwarfProc *proc = (DwarfProc *)stgMallocBytes(sizeof(DwarfProc), "dwarf_new_proc");
+	proc->name = strdup(name);
+	proc->id = proc->parent_id = GHC_DEBUG_NO_ID;
+	proc->low_pc = low_pc_ptr;
+	proc->high_pc = high_pc_ptr;
+	proc->source = source;
+	proc->debug_data = NULL;
+	proc->copied = 0;
+
+	proc->next = (after ? after->next : unit->procs);
+	*(after ? &after->next : &unit->procs) = proc;
+
+	// Update unit data
+	if (!after)
+		insertStrHashTable(unit->proc_table, proc->name, proc);
+	if (!unit->low_pc || low_pc_ptr < unit->low_pc)
+		unit->low_pc = low_pc_ptr;
+	if (!unit->high_pc || high_pc_ptr > unit->high_pc)
+		unit->high_pc = high_pc_ptr;
+	unit->proc_count++;
+
+	return proc;
+}
+
+void dwarf_free()
+{
+	DwarfUnit *unit;
+	while ((unit = dwarf_units)) {
+		dwarf_units = unit->next;
+		freeHashTable(unit->proc_table, NULL);
+		free(unit->procs_by_id);
+		free(unit->procs_by_pc);
+
+		DwarfProc *proc;
+		while ((proc = unit->procs)) {
+			unit->procs = proc->next;
+			free(proc->name);
+			free(proc);
+		}
+
+		free(unit->name);
+		free(unit->comp_dir);
+		free(unit);
+	}
+	free(dwarf_ghc_debug_data);
+	dwarf_ghc_debug_data = 0;
+}
+
+// Read a little-endian StgWord16
+StgWord16 word16LE(StgWord8 *p) {
+	StgWord8 high = *p++;
+	StgWord8 low = *p;
+	return (((StgWord16) high) << 8) + low;
+}
+
+// Builds up associations between debug and DWARF data. If "trace"
+// parameter is set, we also trace all information (presumably
+// to copy it into an eventlog).
+
+void dwarf_associate_debug_data(StgBool trace)
+{
+#ifndef TRACING
+	(void) trace;
+#endif
+
+	// Go through available debugging data
+	StgWord8 *dbg = (StgWord8 *)dwarf_ghc_debug_data;
+	StgWord8 *dbg_limit = dbg + dwarf_ghc_debug_data_size;
+	DwarfUnit *unit = 0;
+	while (dbg && dbg < dbg_limit) {
+
+		// Ignore zeroes
+		if (!*dbg) {
+			dbg++;
+			continue;
+		}
+		StgWord8 *debug_data = dbg;
+
+		// Get event type and size. Note that utils/Binary.hs writes
+		// StdWord16 as little-endian.
+		EventTypeNum num = (EventTypeNum) *dbg; dbg++;
+		StgWord16 size = word16LE(dbg); dbg += 2;
+
+		// Sanity-check size
+		if (dbg + size > dbg_limit) {
+			errorBelch("Debug data packet num %d exceeds section size! Probably corrupt debug data.", num);
+			break;
+		}
+
+		// Follow data
+		char *proc_name = 0, *unit_name = 0;
+		StgWord16 proc_id = GHC_DEBUG_NO_ID, proc_parent_id = GHC_DEBUG_NO_ID;
+		DwarfProc *proc = 0;
+		switch (num) {
+
+		case EVENT_DEBUG_MODULE: // package, name, ...
+
+			// Get unit (with minimal added security)
+			if (strlen((char *)dbg) >= size) break;
+			unit_name = ((char *)dbg) + strlen((char *)dbg) + 1;
+			if (strlen((char *)dbg) + strlen(unit_name) + 1 >= size) {
+				errorBelch("Missing string terminator for module record! Probably corrupt debug data.");
+				return;
+			}
+			unit = dwarf_get_unit(unit_name);
+			if (unit) unit->debug_data = debug_data;
+			break;
+
+		case EVENT_DEBUG_BLOCK: // instr, parent, name, ...
+			if (!unit) break;
+			proc_id = word16LE(dbg);
+			if (proc_id > unit->max_proc_id)
+				unit->max_proc_id = proc_id;
+			proc_parent_id = word16LE(dbg + 2);
+			proc_name = (char *)dbg + 4;
+			proc = dwarf_get_proc(unit, proc_name);
+			break;
+
+		default: break;
+		}
+
+		// Post data
+#ifdef TRACING
+		if (trace) {
+			traceDebugData(num, size, dbg);
+		}
+#endif
+		dbg += size;
+
+		// Post debug data of procedure. Note we might have
+		// multiple entries and therefore IP ranges!
+		if (!proc) continue;
+		do {
+#ifdef TRACING
+			if (trace) {
+				traceSampleRange(proc->low_pc, proc->high_pc);
+				proc->copied = 1;
+			}
+#endif
+			proc->id = proc_id;
+			proc->parent_id = proc_parent_id;
+			proc->debug_data = debug_data;
+			proc = proc->next;
+		}
+        while (proc && !strcmp(proc_name, proc->name));
+	}
+
+#ifdef TRACING
+	// Add all left-over DWARF/symbol table entries that we did not
+	// find anything about in .ghc_debug
+	if (trace && unit) {
+		dwarf_trace_unaccounted(unit, 0);
+	}
+#endif
+
+}
+
+int compare_low_pc(const void *a, const void *b);
+int compare_low_pc(const void *a, const void *b) {
+	DwarfProc *proca = *(DwarfProc **)a;
+	DwarfProc *procb = *(DwarfProc **)b;
+	if (proca->low_pc < procb->low_pc) return -1;
+	if (proca->low_pc == procb->low_pc) {
+		if (procb->source == DwarfSourceDwarfBlock)
+			return -1;
+		else if(proca->source == DwarfSourceDwarfBlock)
+			return 1;
+		else
+			return 0;
+	}
+	return 1;
+}
+
+void dwarf_dump_tables(DwarfUnit *unit);
+void dwarf_dump_tables(DwarfUnit *unit)
+{
+	StgWord i;
+	printf(" Unit %s (%lu procs, %d max id) %p-%p:\n",
+	       unit->name, unit->proc_count, unit->max_proc_id,
+	       unit->low_pc, unit->high_pc);
+	for (i = 0; i < unit->proc_count; i++) {
+		printf("%p-%p: %s\n",
+			   unit->procs_by_pc[i]->low_pc, unit->procs_by_pc[i]->high_pc,
+			       unit->procs_by_pc[i]->name);
+	}
+	for (i = 0; i <= unit->max_proc_id; i++)
+		if (unit->procs_by_id[i]) {
+			printf("%5lu: %s (p %d)\n", i,
+			       unit->procs_by_id[i]->name, unit->procs_by_id[i]->parent_id);
+		} else {
+			printf("%5lu: (null)\n", i);
+		}
+}
+
+#ifdef TRACING
+void dwarf_trace_debug_data(void)
+{
+
+	// Align as much DWARF data with debug data as possible
+	dwarf_associate_debug_data(1);
+
+	DwarfUnit *unit;
+	for (unit = dwarf_units; unit; unit = unit->next) {
+		dwarf_trace_unaccounted(unit, 1);
+	}
+
+}
+
+void dwarf_trace_unaccounted(DwarfUnit *unit, StgBool put_module)
+{
+	DwarfProc *proc;
+
+	for (proc = unit->procs; proc; proc = proc->next) {
+		if (!proc->debug_data) {
+
+			// Need to put module header?
+			if (put_module) {
+				traceDebugModule(unit->name);
+				put_module = 0;
+			}
+
+			// Print everything we know about the procedure
+			traceDebugBlock(proc->name);
+			traceSampleRange(proc->low_pc, proc->high_pc);
+			proc->copied = 1;
+
+		}
+    }
+}
+#endif
+
+void dwarf_init_lookup(void)
+{
+	// Read debug data - will be used later in actual lookups. For the
+	// moment, we primarily want the procedure IDs so we can build the
+	// table.
+	dwarf_associate_debug_data(0);
+
+	// Build procedure tables for every unit
+	DwarfUnit *unit;
+	for (unit = dwarf_units; unit; unit = unit->next) {
+
+		// Just in case we run this twice for some reason
+		free(unit->procs_by_id); unit->procs_by_id = NULL;
+		free(unit->procs_by_pc); unit->procs_by_pc = NULL;
+
+		// Allocate tables
+		StgWord pcTableSize = unit->proc_count * sizeof(DwarfProc *);
+		StgWord idTableSize = (unit->max_proc_id + 1) * sizeof(DwarfProc *);
+		unit->procs_by_pc = (DwarfProc **)stgMallocBytes(pcTableSize, "dwarf_init_pc_table");
+		unit->procs_by_id = (DwarfProc **)stgMallocBytes(idTableSize, "dwarf_init_id_table");
+		memset(unit->procs_by_id, 0, idTableSize);
+
+		// Populate
+		StgWord i = 0;
+		DwarfProc *proc;
+		for (proc = unit->procs; proc; proc = proc->next) {
+			unit->procs_by_pc[i++] = proc;
+			if (proc->id != GHC_DEBUG_NO_ID && proc->id <= unit->max_proc_id)
+				unit->procs_by_id[proc->id] = proc;
+		}
+
+		// Sort PC table by low_pc
+		qsort(unit->procs_by_pc, unit->proc_count, sizeof(DwarfProc *), compare_low_pc);
+
+	}
+}
+
+DwarfProc *dwarf_lookup_proc(void *ip, DwarfUnit **punit)
+{
+	DwarfUnit *unit;
+	for (unit = dwarf_units; unit; unit = unit->next) {
+
+		// Pointer in unit range?
+		if (ip < unit->low_pc || ip >= unit->high_pc)
+			continue;
+		if (!unit->proc_count || !unit->procs_by_pc)
+			continue;
+
+		// Find first entry with low_pc < ip in table (using binary search)
+		StgWord low = 0, high = unit->proc_count;
+		while (low < high) {
+			int mid = (low + high) / 2;
+			if (unit->procs_by_pc[mid]->low_pc <= ip)
+				low = mid + 1;
+			else
+				high = mid;
+		}
+
+		// Find an entry covering it
+		while (low > 0) {
+			DwarfProc *proc = unit->procs_by_pc[low-1];
+
+			// Security
+			if (ip < proc->low_pc) {
+				debugBelch("DWARF lookup: PC table corruption!");
+				break;
+			}
+
+			// In bounds? Then we have found it
+			if (ip <= proc->high_pc) {
+				if (punit)
+					*punit = unit;
+				return proc;
+			}
+
+			// Not a block? Stop search
+			if (proc->source != DwarfSourceDwarfBlock)
+				break;
+
+			// Otherwise backtrack
+			low--;
+		}
+
+	}
+
+	return NULL;
+}
+
+StgWord dwarf_get_debug_info(DwarfUnit *unit, DwarfProc *proc, DebugInfo *infos, StgWord max_infos)
+{
+	// Read debug information
+	StgWord8 *dbg = proc->debug_data;
+	StgWord8 *dbg_limit = (StgWord8 *)dwarf_ghc_debug_data + dwarf_ghc_debug_data_size;
+	StgBool gotProc = 0;
+	StgBool stopRecurse = 0;
+	StgWord info = 0;
+	StgWord depth = 0;
+	while (dbg && dbg <= dbg_limit && info < max_infos) {
+
+		// Get ID and size
+		EventTypeNum num = (EventTypeNum) *dbg; dbg++;
+		StgWord16 size = word16LE(dbg); dbg += 2;
+
+		// Check record type
+		StgBool done = 0;
+		switch (num) {
+		case EVENT_DEBUG_BLOCK:
+			// First time is expected, next means we have reached the
+			// end of records belonging to this proc
+			if (!gotProc)
+				gotProc = 1;
+			else
+				done = 1;
+			break;
+
+		// This is what we are looking for: Data to copy
+		case EVENT_DEBUG_SOURCE: {
+			infos[info].sline = word16LE(dbg);
+			infos[info].scol  = word16LE(dbg+2);
+			infos[info].eline = word16LE(dbg+4);
+			infos[info].ecol  = word16LE(dbg+6);
+			int len = strlen((char *)dbg+8),
+			    len2 = strlen((char *)dbg+9+len);
+			if (10 + len + len2 > size) {
+				errorBelch("Missing string terminator for module record! Probably corrupt debug data.");
+				return info;
+			}
+			infos[info].file = (char *)dbg+8;
+			infos[info].name = (char *)dbg+9+len;
+			infos[info].depth = depth;
+			info++;
+			// Did we find a source annotation for our own module?
+			if (!strcmp(infos[info-1].file, unit->name)) {
+				// Stop recursing to parents then - that would only
+				// dull the precision.
+				stopRecurse = 1;
+				return info;
+			}
+			break;
+		}
+
+		// These can be safely ignored
+		case EVENT_DEBUG_CORE:
+		   break;
+
+		// Unknown events must be considered stoppers.
+		default:
+		   done = 1;
+		}
+		dbg += size;
+
+		// Finished with this proc?
+		if (done) {
+			// Try to jump to parent
+			if (!stopRecurse &&
+			    proc->parent_id <= unit->max_proc_id &&
+			    (proc = unit->procs_by_id[proc->parent_id])) {
+
+				// Continue at parent
+				dbg = proc->debug_data;
+				gotProc = 0;
+				depth++;
+			} else {
+				break;
+			}
+		}
+	}
+	return info;
+}
+
+#endif /* USE_DWARF */
diff --git a/rts/Dwarf.h b/rts/Dwarf.h
new file mode 100644
index 000000000000..8566f67df185
--- /dev/null
+++ b/rts/Dwarf.h
@@ -0,0 +1,74 @@
+
+#ifndef DWARF_H
+#define DWARF_H
+
+#include "BeginPrivate.h"
+
+#ifdef USE_DWARF
+
+#include "Hash.h"
+
+typedef struct DwarfUnit_ DwarfUnit;
+typedef struct DwarfProc_ DwarfProc;
+typedef enum DwarfSource_ DwarfSource;
+typedef struct DebugInfo_ DebugInfo;
+
+struct DwarfUnit_ {
+	char *name;
+	char *comp_dir;
+	void *low_pc, *high_pc;
+	StgWord8 *debug_data;
+	DwarfProc *procs;
+	StgWord proc_count;
+	StgWord16 max_proc_id;
+
+	HashTable *proc_table; // by name
+	DwarfProc **procs_by_id; // by id
+	DwarfProc **procs_by_pc; // by low_pc
+
+	DwarfUnit *next;
+};
+
+enum DwarfSource_ {
+	DwarfSourceDwarf,
+	DwarfSourceDwarfBlock,
+	DwarfSourceSymtab,
+};
+
+struct DwarfProc_ {
+	char *name;
+	StgWord16 id;
+	StgWord16 parent_id;
+	void *low_pc;
+	void *high_pc;
+	StgWord8 *debug_data;
+	DwarfSource source;
+	StgBool copied;
+	struct DwarfProc_ *next;
+};
+
+extern DwarfUnit *dwarf_units;
+
+void dwarf_load(void);
+void dwarf_trace_debug_data(void);
+DwarfUnit *dwarf_get_unit(char *name);
+DwarfProc *dwarf_get_proc(DwarfUnit *unit, char *name);
+void dwarf_free(void);
+
+void dwarf_init_lookup(void);
+DwarfProc *dwarf_lookup_proc(void *ip, DwarfUnit **unit);
+
+struct DebugInfo_ {
+	StgWord16 sline, scol, eline, ecol;
+	char *file;
+	char *name;
+	StgWord depth;
+};
+
+StgWord dwarf_get_debug_info(DwarfUnit *unit, DwarfProc *proc, DebugInfo *infos, StgWord max_infos);
+
+#endif // USE_DWARF
+
+#include "EndPrivate.h"
+
+#endif // DWARF_H
diff --git a/rts/EndPrivate.h b/rts/EndPrivate.h
index 4cfb68f0ba87..61d56fb3e143 100644
--- a/rts/EndPrivate.h
+++ b/rts/EndPrivate.h
@@ -1,3 +1,11 @@
 #if defined(HAS_VISIBILITY_HIDDEN) && !defined(freebsd_HOST_OS)
 #pragma GCC visibility pop
 #endif
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/Exception.cmm b/rts/Exception.cmm
index e2fc5543bf0f..0f628214d492 100644
--- a/rts/Exception.cmm
+++ b/rts/Exception.cmm
@@ -53,6 +53,7 @@ import ghczmprim_GHCziTypes_True_closure;
 INFO_TABLE_RET(stg_unmaskAsyncExceptionszh_ret, RET_SMALL, W_ info_ptr)
     /* explicit stack */
 {
+    unwind Sp = Sp + WDS(1);
     CInt r;
 
     P_ ret;
@@ -157,7 +158,7 @@ stg_maskAsyncExceptionszh /* explicit stack */
 stg_maskUninterruptiblezh /* explicit stack */
 {
     /* Args: R1 :: IO a */
-    STK_CHK_P_LL (WDS(1)/* worst case */, stg_maskAsyncExceptionszh, R1);
+    STK_CHK_P_LL (WDS(1)/* worst case */, stg_maskUninterruptiblezh, R1);
 
     if ((TO_W_(StgTSO_flags(CurrentTSO)) & TSO_BLOCKEX) == 0) {
         /* avoid growing the stack unnecessarily */
diff --git a/rts/FileLock.c b/rts/FileLock.c
index 44ff67140c8a..8a8dc86b2803 100644
--- a/rts/FileLock.c
+++ b/rts/FileLock.c
@@ -5,7 +5,7 @@
  * File locking support as required by Haskell
  *
  * ---------------------------------------------------------------------------*/
- 
+
 #include "PosixSource.h"
 #include "Rts.h"
 
@@ -44,8 +44,9 @@ static int cmpLocks(StgWord w1, StgWord w2)
 static int hashLock(HashTable *table, StgWord w)
 {
     Lock *l = (Lock *)w;
+    StgWord key = l->inode ^ (l->inode >> 32) ^ l->device ^ (l->device >> 32);
     // Just xor all 32-bit words of inode and device, hope this is good enough.
-    return hashWord(table, l->inode ^ (l->inode >> 32) ^ l->device ^ (l->device >> 32));
+    return hashWord(table, key);
 }
 
 void
@@ -120,7 +121,7 @@ unlockFile(int fd)
 
     lock = lookupHashTable(fd_hash, fd);
     if (lock == NULL) {
-        // errorBelch("unlockFile: fd %d not found", fd); 
+        // errorBelch("unlockFile: fd %d not found", fd);
         // This is normal: we didn't know when calling unlockFile
         // whether this FD referred to a locked file or not.
         RELEASE_LOCK(&file_lock_mutex);
@@ -142,3 +143,11 @@ unlockFile(int fd)
     RELEASE_LOCK(&file_lock_mutex);
     return 0;
 }
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/FileLock.h b/rts/FileLock.h
index 72ab170437b9..fe9c52a5748f 100644
--- a/rts/FileLock.h
+++ b/rts/FileLock.h
@@ -13,3 +13,11 @@ RTS_PRIVATE void initFileLocking(void);
 RTS_PRIVATE void freeFileLocking(void);
 
 #endif /* POSIX_FILELOCK_H */
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/GetEnv.h b/rts/GetEnv.h
index 5e3d0cf18418..497fcc9712ec 100644
--- a/rts/GetEnv.h
+++ b/rts/GetEnv.h
@@ -21,3 +21,11 @@ void freeProgEnvv (int envc, char *envv[]);
 #include "EndPrivate.h"
 
 #endif /* GETENV_H */
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/GetTime.h b/rts/GetTime.h
index 32c375482957..8e293a8d2265 100644
--- a/rts/GetTime.h
+++ b/rts/GetTime.h
@@ -29,3 +29,11 @@ W_    getPageFaults         (void);
 #include "EndPrivate.h"
 
 #endif /* GETTIME_H */
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/Globals.c b/rts/Globals.c
index 2e4b99474f9a..d839e44f4abe 100644
--- a/rts/Globals.c
+++ b/rts/Globals.c
@@ -140,3 +140,11 @@ getOrSetLibHSghcFastStringTable(StgStablePtr ptr)
 {
     return getOrSetKey(LibHSghcFastStringTable,ptr);
 }
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/Globals.h b/rts/Globals.h
index 445072ca3433..ee62f2f7c101 100644
--- a/rts/Globals.h
+++ b/rts/Globals.h
@@ -17,3 +17,10 @@ RTS_PRIVATE void exitGlobalStore(void);
 
 #endif
 
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/Hash.c b/rts/Hash.c
index 9ab8ffb53e1f..1c5897cb723b 100644
--- a/rts/Hash.c
+++ b/rts/Hash.c
@@ -17,13 +17,13 @@
 #include <string.h>
 
 #define HSEGSIZE    1024    /* Size of a single hash table segment */
-			    /* Also the minimum size of a hash table */
+                            /* Also the minimum size of a hash table */
 #define HDIRSIZE    1024    /* Size of the segment directory */
-			    /* Maximum hash table size is HSEGSIZE * HDIRSIZE */
-#define HLOAD	    5	    /* Maximum average load of a single hash bucket */
+                            /* Maximum hash table size is HSEGSIZE * HDIRSIZE */
+#define HLOAD       5       /* Maximum average load of a single hash bucket */
 
-#define HCHUNK	    (1024 * sizeof(W_) / sizeof(HashList))
-			    /* Number of HashList cells to allocate in one go */
+#define HCHUNK      (1024 * sizeof(W_) / sizeof(HashList))
+                            /* Number of HashList cells to allocate in one go */
 
 
 /* Linked list of (key, data) pairs for separate chaining */
@@ -39,13 +39,13 @@ typedef struct chunklist {
 } HashListChunk;
 
 struct hashtable {
-    int split;		    /* Next bucket to split when expanding */
-    int max;		    /* Max bucket of smaller table */
-    int mask1;		    /* Mask for doing the mod of h_1 (smaller table) */
-    int mask2;		    /* Mask for doing the mod of h_2 (larger table) */
-    int kcount;		    /* Number of keys */
-    int bcount;		    /* Number of buckets */
-    HashList **dir[HDIRSIZE];	/* Directory of segments */
+    int split;              /* Next bucket to split when expanding */
+    int max;                /* Max bucket of smaller table */
+    int mask1;              /* Mask for doing the mod of h_1 (smaller table) */
+    int mask2;              /* Mask for doing the mod of h_2 (larger table) */
+    int kcount;             /* Number of keys */
+    int bcount;             /* Number of buckets */
+    HashList **dir[HDIRSIZE];   /* Directory of segments */
     HashList *freeList;         /* free list of HashLists */
     HashListChunk *chunks;
     HashFunction *hash;         /* hash function */
@@ -69,8 +69,8 @@ hashWord(HashTable *table, StgWord key)
     bucket = key & table->mask1;
 
     if (bucket < table->split) {
-	/* Mod the size of the expanded hash table (also a power of 2) */
-	bucket = key & table->mask2;
+        /* Mod the size of the expanded hash table (also a power of 2) */
+        bucket = key & table->mask2;
     }
     return bucket;
 }
@@ -83,17 +83,17 @@ hashStr(HashTable *table, char *key)
 
     s = key;
     for (h=0; *s; s++) {
-	h *= 128;
-	h += *s;
-	h = h % 1048583;	/* some random large prime */
+        h *= 128;
+        h += *s;
+        h = h % 1048583;        /* some random large prime */
     }
 
     /* Mod the size of the hash table (a power of 2) */
     bucket = h & table->mask1;
 
     if (bucket < table->split) {
-	/* Mod the size of the expanded hash table (also a power of 2) */
-	bucket = h & table->mask2;
+        /* Mod the size of the expanded hash table (also a power of 2) */
+        bucket = h & table->mask2;
     }
 
     return bucket;
@@ -119,8 +119,8 @@ compareStr(StgWord key1, StgWord key2)
 static void
 allocSegment(HashTable *table, int segment)
 {
-    table->dir[segment] = stgMallocBytes(HSEGSIZE * sizeof(HashList *), 
-					 "allocSegment");
+    table->dir[segment] = stgMallocBytes(HSEGSIZE * sizeof(HashList *),
+                                         "allocSegment");
 }
 
 
@@ -143,8 +143,8 @@ expand(HashTable *table)
     HashList *old, *new;
 
     if (table->split + table->max >= HDIRSIZE * HSEGSIZE)
-	/* Wow!  That's big.  Too big, so don't expand. */
-	return;
+        /* Wow!  That's big.  Too big, so don't expand. */
+        return;
 
     /* Calculate indices of bucket to split */
     oldsegment = table->split / HSEGSIZE;
@@ -157,13 +157,13 @@ expand(HashTable *table)
     newindex = newbucket % HSEGSIZE;
 
     if (newindex == 0)
-	allocSegment(table, newsegment);
+        allocSegment(table, newsegment);
 
     if (++table->split == table->max) {
-	table->split = 0;
-	table->max *= 2;
-	table->mask1 = table->mask2;
-	table->mask2 = table->mask2 << 1 | 1;
+        table->split = 0;
+        table->max *= 2;
+        table->mask1 = table->mask2;
+        table->mask2 = table->mask2 << 1 | 1;
     }
     table->bcount++;
 
@@ -171,14 +171,14 @@ expand(HashTable *table)
 
     old = new = NULL;
     for (hl = table->dir[oldsegment][oldindex]; hl != NULL; hl = next) {
-	next = hl->next;
-	if (table->hash(table, hl->key) == newbucket) {
-	    hl->next = new;
-	    new = hl;
-	} else {
-	    hl->next = old;
-	    old = hl;
-	}
+        next = hl->next;
+        if (table->hash(table, hl->key) == newbucket) {
+            hl->next = new;
+            new = hl;
+        } else {
+            hl->next = old;
+            old = hl;
+        }
     }
     table->dir[oldsegment][oldindex] = old;
     table->dir[newsegment][newindex] = new;
@@ -199,8 +199,8 @@ lookupHashTable(HashTable *table, StgWord key)
     index = bucket % HSEGSIZE;
 
     for (hl = table->dir[segment][index]; hl != NULL; hl = hl->next)
-	if (table->compare(hl->key, key))
-	    return hl->data;
+        if (table->compare(hl->key, key))
+            return hl->data;
 
     /* It's not there */
     return NULL;
@@ -222,15 +222,15 @@ allocHashList (HashTable *table)
         table->freeList = hl->next;
     } else {
         hl = stgMallocBytes(HCHUNK * sizeof(HashList), "allocHashList");
-	cl = stgMallocBytes(sizeof (*cl), "allocHashList: chunkList");
+        cl = stgMallocBytes(sizeof (*cl), "allocHashList: chunkList");
         cl->chunk = hl;
         cl->next = table->chunks;
         table->chunks = cl;
 
         table->freeList = hl + 1;
         for (p = table->freeList; p < hl + HCHUNK - 1; p++)
-	    p->next = p + 1;
-	p->next = NULL;
+            p->next = p + 1;
+        p->next = NULL;
     }
     return hl;
 }
@@ -256,7 +256,7 @@ insertHashTable(HashTable *table, StgWord key, void *data)
 
     /* When the average load gets too high, we expand the table */
     if (++table->kcount >= HLOAD * table->bcount)
-	expand(table);
+        expand(table);
 
     bucket = table->hash(table, key);
     segment = bucket / HSEGSIZE;
@@ -285,16 +285,16 @@ removeHashTable(HashTable *table, StgWord key, void *data)
     index = bucket % HSEGSIZE;
 
     for (hl = table->dir[segment][index]; hl != NULL; hl = hl->next) {
-	if (table->compare(hl->key,key) && (data == NULL || hl->data == data)) {
-	    if (prev == NULL)
-		table->dir[segment][index] = hl->next;
-	    else
-		prev->next = hl->next;
+        if (table->compare(hl->key,key) && (data == NULL || hl->data == data)) {
+            if (prev == NULL)
+                table->dir[segment][index] = hl->next;
+            else
+                prev->next = hl->next;
             freeHashList(table,hl);
-	    table->kcount--;
-	    return hl->data;
-	}
-	prev = hl;
+            table->kcount--;
+            return hl->data;
+        }
+        prev = hl;
     }
 
     /* It's not there */
@@ -322,17 +322,17 @@ freeHashTable(HashTable *table, void (*freeDataFun)(void *) )
     index = (table->max + table->split - 1) % HSEGSIZE;
 
     while (segment >= 0) {
-	while (index >= 0) {
-	    for (hl = table->dir[segment][index]; hl != NULL; hl = next) {
-		next = hl->next;
-		if (freeDataFun != NULL)
-		    (*freeDataFun)(hl->data);
+        while (index >= 0) {
+            for (hl = table->dir[segment][index]; hl != NULL; hl = next) {
+                next = hl->next;
+                if (freeDataFun != NULL)
+                    (*freeDataFun)(hl->data);
             }
-	    index--;
-	}
-	stgFree(table->dir[segment]);
-	segment--;
-	index = HSEGSIZE - 1;
+            index--;
+        }
+        stgFree(table->dir[segment]);
+        segment--;
+        index = HSEGSIZE - 1;
     }
     for (cl = table->chunks; cl != NULL; cl = cl_next) {
         cl_next = cl->next;
@@ -358,7 +358,7 @@ allocHashTable_(HashFunction *hash, CompareFunction *compare)
     allocSegment(table, 0);
 
     for (hb = table->dir[0]; hb < table->dir[0] + HSEGSIZE; hb++)
-	*hb = NULL;
+        *hb = NULL;
 
     table->split = 0;
     table->max = HSEGSIZE;
@@ -383,8 +383,8 @@ allocHashTable(void)
 HashTable *
 allocStrHashTable(void)
 {
-    return allocHashTable_((HashFunction *)hashStr, 
-			   (CompareFunction *)compareStr);
+    return allocHashTable_((HashFunction *)hashStr,
+                           (CompareFunction *)compareStr);
 }
 
 void
@@ -397,3 +397,11 @@ int keyCountHashTable (HashTable *table)
 {
     return table->kcount;
 }
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/Hash.h b/rts/Hash.h
index d22caba55526..167000c33607 100644
--- a/rts/Hash.h
+++ b/rts/Hash.h
@@ -52,3 +52,11 @@ void exitHashTable ( void );
 #include "EndPrivate.h"
 
 #endif /* HASH_H */
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/HeapStackCheck.cmm b/rts/HeapStackCheck.cmm
index d826529aefef..89e1afc8135f 100644
--- a/rts/HeapStackCheck.cmm
+++ b/rts/HeapStackCheck.cmm
@@ -72,7 +72,13 @@ import LeaveCriticalSection;
  * will either increase the size of our stack, or raise an exception if
  * the stack is already too big.
  */
- 
+
+#ifdef TRACING
+#define IF_TRACING(x) x
+#else
+#define IF_TRACING(x)
+#endif
+
 #define PRE_RETURN(why,what_next)			\
   StgTSO_what_next(CurrentTSO) = what_next::I16;	\
   StgRegTable_rRet(BaseReg) = why;           	        \
@@ -81,10 +87,13 @@ import LeaveCriticalSection;
 /* Remember that the return address is *removed* when returning to a
  * ThreadRunGHC thread.
  */
-
 stg_gc_noregs
 {
     W_ ret;
+#ifdef TRACING
+    W_ n; W_ sample; sample = R1;
+#define Capability_heap_sample(cap,n) W_[Capability_heap_ip_samples(cap)+WDS(n)]
+#endif
 
     DEBUG_ONLY(foreign "C" heapCheckFail());
     if (Hp > HpLim) {
@@ -93,6 +102,15 @@ stg_gc_noregs
                 ret = ThreadYielding;
                 goto sched;
         }
+
+#ifdef TRACING
+        n = Capability_heap_ip_sample_count(MyCapability());
+        if (n < HEAP_ALLOC_MAX_SAMPLES) {
+            Capability_heap_ip_sample_count(MyCapability()) = n+1;
+            Capability_heap_sample(MyCapability(), n) = sample;
+        }
+#endif
+
         if (HpAlloc <= BLOCK_SIZE
             && bdescr_link(CurrentNursery) != NULL) {
             HpAlloc = 0;
@@ -114,6 +132,16 @@ stg_gc_noregs
         if (CHECK_GC()) {
             ret = HeapOverflow;
         } else {
+
+#ifdef TRACING
+            n = Capability_heap_ip_sample_count(MyCapability());
+            if (n > HEAP_ALLOC_MAX_SAMPLES) {
+                Capability_heap_ip_sample_count(MyCapability()) = n-1;
+                n = 2*HEAP_ALLOC_MAX_SAMPLES - n;
+                Capability_heap_sample(MyCapability(), n) = sample;
+            }
+#endif
+
             ret = StackOverflow;
         }
     }
@@ -161,7 +189,8 @@ INFO_TABLE_RET ( stg_enter, RET_SMALL, W_ info_ptr, P_ closure )
 
 __stg_gc_enter_1 (P_ node)
 {
-    jump stg_gc_noregs (stg_enter_info, node) ();
+    jump stg_gc_noregs (stg_enter_info, node)
+        (IF_TRACING(%ENTRY_CODE(%INFO_PTR(UNTAG(node)))));
 }
 
 /* -----------------------------------------------------------------------------
@@ -174,29 +203,30 @@ __stg_gc_enter_1 (P_ node)
 
 stg_gc_prim (W_ fun)
 {
-    call stg_gc_noregs ();
+    call stg_gc_noregs (IF_TRACING(fun));
     jump fun();
 }
 
 stg_gc_prim_p (P_ arg, W_ fun)
 {
-    call stg_gc_noregs ();
+    call stg_gc_noregs (IF_TRACING(fun));
     jump fun(arg);
 }
 
 stg_gc_prim_pp (P_ arg1, P_ arg2, W_ fun)
 {
-    call stg_gc_noregs ();
+    call stg_gc_noregs (IF_TRACING(fun));
     jump fun(arg1,arg2);
 }
 
 stg_gc_prim_n (W_ arg, W_ fun)
 {
-    call stg_gc_noregs ();
+    call stg_gc_noregs (IF_TRACING(fun));
     jump fun(arg);
 }
 
-stg_gc_prim_p_ll_ret
+INFO_TABLE_RET(stg_gc_prim_p_ll, RET_SMALL, W_ info, P_ arg, W_ fun)
+    /* explicit stack */
 {
     W_ fun;
     P_ arg;
@@ -216,8 +246,9 @@ stg_gc_prim_p_ll
     Sp_adj(-3);
     Sp(2) = fun;
     Sp(1) = arg;
-    Sp(0) = stg_gc_prim_p_ll_ret;
-    jump stg_gc_noregs [];
+    Sp(0) = stg_gc_prim_p_ll_info;
+    IF_TRACING(R1 = fun;)
+    jump stg_gc_noregs [IF_TRACING(R1)];
 }
 
 /* -----------------------------------------------------------------------------
@@ -299,28 +330,32 @@ INFO_TABLE_RET ( stg_ret_l, RET_SMALL, W_ info_ptr, L_ l )
 
 stg_gc_unpt_r1 return (P_ ptr) /* NB. return convention */
 {
-    jump stg_gc_noregs (stg_ret_p_info, ptr) ();
+    jump stg_gc_noregs (stg_ret_p_info, ptr)
+        (IF_TRACING(%ENTRY_CODE(Sp(0))));
 }
 
 /*-- R1 is unboxed -------------------------------------------------- */
 
 stg_gc_unbx_r1 return (W_ nptr) /* NB. return convention */
 {
-    jump stg_gc_noregs (stg_ret_n_info, nptr) ();
+    jump stg_gc_noregs (stg_ret_n_info, nptr)
+        (IF_TRACING(%ENTRY_CODE(Sp(0))));
 }
 
 /*-- F1 contains a float ------------------------------------------------- */
 
 stg_gc_f1 return (F_ f)
 {
-    jump stg_gc_noregs (stg_ret_f_info, f) ();
+    jump stg_gc_noregs (stg_ret_f_info, f)
+        (IF_TRACING(%ENTRY_CODE(Sp(0))));
 }
 
 /*-- D1 contains a double ------------------------------------------------- */
 
 stg_gc_d1 return (D_ d)
 {
-    jump stg_gc_noregs (stg_ret_d_info, d) ();
+    jump stg_gc_noregs (stg_ret_d_info, d)
+        (IF_TRACING(%ENTRY_CODE(Sp(0))));
 }
 
 
@@ -328,26 +363,27 @@ stg_gc_d1 return (D_ d)
 
 stg_gc_l1 return (L_ l)
 {
-    jump stg_gc_noregs (stg_ret_l_info, l) ();
+    jump stg_gc_noregs (stg_ret_l_info, l)
+        (IF_TRACING(%ENTRY_CODE(Sp(0))));
 }
 
 /*-- Unboxed tuples with multiple pointers -------------------------------- */
 
 stg_gc_pp return (P_ arg1, P_ arg2)
 {
-    call stg_gc_noregs();
+    call stg_gc_noregs(IF_TRACING(%ENTRY_CODE(Sp(0))));
     return (arg1,arg2);
 }
 
 stg_gc_ppp return (P_ arg1, P_ arg2, P_ arg3)
 {
-    call stg_gc_noregs();
+    call stg_gc_noregs(IF_TRACING(%ENTRY_CODE(Sp(0))));
     return (arg1,arg2,arg3);
 }
 
 stg_gc_pppp return (P_ arg1, P_ arg2, P_ arg3, P_ arg4)
 {
-    call stg_gc_noregs();
+    call stg_gc_noregs(IF_TRACING(%ENTRY_CODE(Sp(0))));
     return (arg1,arg2,arg3,arg4);
 }
 
@@ -413,7 +449,8 @@ __stg_gc_fun /* explicit stack */
     Sp(2) = R1;
     Sp(1) = size;
     Sp(0) = stg_gc_fun_info;
-    jump stg_gc_noregs [];
+    IF_TRACING(R1 = %GET_ENTRY(UNTAG(R1));)
+    jump stg_gc_noregs [IF_TRACING(R1)];
 #else
     W_ type;
     type = TO_W_(StgFunInfoExtra_fun_type(info));
@@ -425,7 +462,8 @@ __stg_gc_fun /* explicit stack */
         Sp(1) = size;
         Sp(0) = stg_gc_fun_info;
         // DEBUG_ONLY(foreign "C" debugBelch("stg_fun_gc_gen(ARG_GEN)"););
-        jump stg_gc_noregs [];
+        IF_TRACING(R1 = %GET_ENTRY(UNTAG(R1));)
+        jump stg_gc_noregs [IF_TRACING(R1)];
     } else { 
         jump W_[stg_stack_save_entries + WDS(type)] [*]; // all regs live
 	    // jumps to stg_gc_noregs after saving stuff
@@ -680,13 +718,24 @@ stg_block_async_void
    STM-specific waiting
    -------------------------------------------------------------------------- */
 
-stg_block_stmwait_finally
-{
-    ccall stmWaitUnlock(MyCapability() "ptr", R3 "ptr");
-    jump StgReturn [R1];
-}
-
 stg_block_stmwait
 {
-    BLOCK_BUT_FIRST(stg_block_stmwait_finally);
+    // When blocking on an MVar we have to be careful to only release
+    // the lock on the MVar at the very last moment (using
+    // BLOCK_BUT_FIRST()), since when we release the lock another
+    // Capability can wake up the thread, which modifies its stack and
+    // other state.  This is not a problem for STM, because STM
+    // wakeups are non-destructive; the waker simply calls
+    // tryWakeupThread() which sends a message to the owner
+    // Capability.  So the moment we release this lock we might start
+    // getting wakeup messages, but that's perfectly harmless.
+    //
+    // Furthermore, we *must* release these locks, just in case an
+    // exception is raised in this thread by
+    // maybePerformBlockedException() while exiting to the scheduler,
+    // which will abort the transaction, which needs to obtain a lock
+    // on all the TVars to remove the thread from the queues.
+    //
+    ccall stmWaitUnlock(MyCapability() "ptr", R3 "ptr");
+    BLOCK_GENERIC;
 }
diff --git a/rts/Hpc.c b/rts/Hpc.c
index c4ff8d3be1e2..c4f43cd9d0ac 100644
--- a/rts/Hpc.c
+++ b/rts/Hpc.c
@@ -151,7 +151,7 @@ readTix(void) {
     ws();
     
     lookup = lookupHashTable(moduleHash, (StgWord)tmpModule->modName);
-    if (tmpModule == NULL) {
+    if (lookup == NULL) {
         debugTrace(DEBUG_hpc,"readTix: new HpcModuleInfo for %s",
                    tmpModule->modName);
         insertHashTable(moduleHash, (StgWord)tmpModule->modName, tmpModule);
@@ -404,3 +404,11 @@ exitHpc(void) {
 HpcModuleInfo *hs_hpc_rootModule(void) {
   return modules;
 }
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/HsFFI.c b/rts/HsFFI.c
index 856536f5aa95..d1c0964d7af8 100644
--- a/rts/HsFFI.c
+++ b/rts/HsFFI.c
@@ -11,6 +11,7 @@
 #include "Rts.h"
 
 #include "Stable.h"
+#include "Task.h"
 
 // hs_init and hs_exit are defined in RtsStartup.c
 
@@ -59,3 +60,17 @@ hs_free_fun_ptr(HsFunPtr fp)
     /* I simply *love* all these similar names... */
     freeHaskellFunctionPtr(fp);
 }
+
+void
+hs_thread_done(void)
+{
+    freeMyTask();
+}
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/Inlines.c b/rts/Inlines.c
index e6f29b6e1b8b..3810e4d5a20c 100644
--- a/rts/Inlines.c
+++ b/rts/Inlines.c
@@ -7,3 +7,11 @@
 #include "Schedule.h"
 #include "Capability.h"
 #include "WSDeque.h"
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/Interpreter.c b/rts/Interpreter.c
index f4fe816d28db..f3a5c783cd0f 100644
--- a/rts/Interpreter.c
+++ b/rts/Interpreter.c
@@ -1516,3 +1516,11 @@ interpretBCO (Capability* cap)
 
     barf("interpretBCO: fell off end of the interpreter");
 }
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/Interpreter.h b/rts/Interpreter.h
index fd4f7b98c370..b95c61af7471 100644
--- a/rts/Interpreter.h
+++ b/rts/Interpreter.h
@@ -12,3 +12,11 @@
 RTS_PRIVATE Capability *interpretBCO (Capability* cap);
 
 #endif /* INTERPRETER_H */
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/LdvProfile.c b/rts/LdvProfile.c
index d077f3caf723..677263efbe8d 100644
--- a/rts/LdvProfile.c
+++ b/rts/LdvProfile.c
@@ -68,6 +68,10 @@ processHeapClosureForDead( StgClosure *c )
     case MUT_ARR_PTRS_DIRTY:
     case MUT_ARR_PTRS_FROZEN:
     case MUT_ARR_PTRS_FROZEN0:
+    case SMALL_MUT_ARR_PTRS_CLEAN:
+    case SMALL_MUT_ARR_PTRS_DIRTY:
+    case SMALL_MUT_ARR_PTRS_FROZEN:
+    case SMALL_MUT_ARR_PTRS_FROZEN0:
     case ARR_WORDS:
     case WEAK:
     case MUT_VAR_CLEAN:
@@ -245,3 +249,11 @@ LdvCensusKillAll( void )
 }
 
 #endif /* PROFILING */
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/LdvProfile.h b/rts/LdvProfile.h
index b4418046ba91..8f633225b90e 100644
--- a/rts/LdvProfile.h
+++ b/rts/LdvProfile.h
@@ -39,3 +39,11 @@ RTS_PRIVATE void LdvCensusKillAll ( void );
 #endif /* PROFILING */
 
 #endif /* LDVPROFILE_H */
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/Linker.c b/rts/Linker.c
index 14ebac36832f..a0ad90c6fe91 100644
--- a/rts/Linker.c
+++ b/rts/Linker.c
@@ -47,6 +47,7 @@
 #include <string.h>
 #include <stdio.h>
 #include <assert.h>
+#include <libgen.h>
 
 #ifdef HAVE_SYS_STAT_H
 #include <sys/stat.h>
@@ -157,6 +158,7 @@ ObjectCode *unloaded_objects = NULL; /* initially empty */
 /* Type of the initializer */
 typedef void (*init_t) (int argc, char **argv, char **env);
 
+static HsInt isAlreadyLoaded( pathchar *path );
 static HsInt loadOc( ObjectCode* oc );
 static ObjectCode* mkOc( pathchar *path, char *image, int imageSize,
                          char *archiveMemberName
@@ -214,6 +216,18 @@ static int ocResolve_PEi386     ( ObjectCode* oc );
 static int ocRunInit_PEi386     ( ObjectCode* oc );
 static void *lookupSymbolInDLLs ( unsigned char *lbl );
 static void zapTrailingAtSign   ( unsigned char *sym );
+static char *allocateImageAndTrampolines (
+#if defined(x86_64_HOST_ARCH)
+   FILE* f, pathchar* arch_name, char* member_name,
+#endif
+   int size );
+#if defined(x86_64_HOST_ARCH)
+static int ocAllocateSymbolExtras_PEi386 ( ObjectCode* oc );
+static size_t makeSymbolExtra_PEi386( ObjectCode* oc, size_t, char* symbol );
+#define PEi386_IMAGE_OFFSET 4
+#else
+#define PEi386_IMAGE_OFFSET 0
+#endif
 #elif defined(OBJFORMAT_MACHO)
 static int ocVerifyImage_MachO    ( ObjectCode* oc );
 static int ocGetNames_MachO       ( ObjectCode* oc );
@@ -1150,12 +1164,28 @@ typedef struct _RtsSymbolVal {
       SymI_HasProto(stg_myThreadIdzh)                                   \
       SymI_HasProto(stg_labelThreadzh)                                  \
       SymI_HasProto(stg_newArrayzh)                                     \
+      SymI_HasProto(stg_copyArrayzh)                                    \
+      SymI_HasProto(stg_copyMutableArrayzh)                             \
+      SymI_HasProto(stg_copyArrayArrayzh)                               \
+      SymI_HasProto(stg_copyMutableArrayArrayzh)                        \
+      SymI_HasProto(stg_cloneArrayzh)                                   \
+      SymI_HasProto(stg_cloneMutableArrayzh)                            \
+      SymI_HasProto(stg_freezzeArrayzh)                                 \
+      SymI_HasProto(stg_thawArrayzh)                                    \
       SymI_HasProto(stg_newArrayArrayzh)                                \
       SymI_HasProto(stg_casArrayzh)                                     \
+      SymI_HasProto(stg_newSmallArrayzh)                                \
+      SymI_HasProto(stg_unsafeThawSmallArrayzh)                         \
+      SymI_HasProto(stg_cloneSmallArrayzh)                              \
+      SymI_HasProto(stg_cloneSmallMutableArrayzh)                       \
+      SymI_HasProto(stg_freezzeSmallArrayzh)                            \
+      SymI_HasProto(stg_thawSmallArrayzh)                               \
+      SymI_HasProto(stg_copySmallArrayzh)                               \
+      SymI_HasProto(stg_copySmallMutableArrayzh)                        \
+      SymI_HasProto(stg_casSmallArrayzh)                                \
       SymI_HasProto(stg_newBCOzh)                                       \
       SymI_HasProto(stg_newByteArrayzh)                                 \
       SymI_HasProto(stg_casIntArrayzh)                                  \
-      SymI_HasProto(stg_fetchAddIntArrayzh)                             \
       SymI_HasProto(stg_newMVarzh)                                      \
       SymI_HasProto(stg_newMutVarzh)                                    \
       SymI_HasProto(stg_newTVarzh)                                      \
@@ -1164,6 +1194,8 @@ typedef struct _RtsSymbolVal {
       SymI_HasProto(stg_casMutVarzh)                                    \
       SymI_HasProto(stg_newPinnedByteArrayzh)                           \
       SymI_HasProto(stg_newAlignedPinnedByteArrayzh)                    \
+      SymI_HasProto(stg_shrinkMutableByteArrayzh)                       \
+      SymI_HasProto(stg_resizzeMutableByteArrayzh)                      \
       SymI_HasProto(newSpark)                                           \
       SymI_HasProto(performGC)                                          \
       SymI_HasProto(performMajorGC)                                     \
@@ -1250,6 +1282,9 @@ typedef struct _RtsSymbolVal {
       SymI_HasProto(stg_MUT_ARR_PTRS_DIRTY_info)                        \
       SymI_HasProto(stg_MUT_ARR_PTRS_FROZEN_info)                       \
       SymI_HasProto(stg_MUT_ARR_PTRS_FROZEN0_info)                      \
+      SymI_HasProto(stg_SMALL_MUT_ARR_PTRS_DIRTY_info)                  \
+      SymI_HasProto(stg_SMALL_MUT_ARR_PTRS_FROZEN_info)                 \
+      SymI_HasProto(stg_SMALL_MUT_ARR_PTRS_FROZEN0_info)                \
       SymI_HasProto(stg_MUT_VAR_CLEAN_info)                             \
       SymI_HasProto(stg_MUT_VAR_DIRTY_info)                             \
       SymI_HasProto(stg_WEAK_info)                                      \
@@ -1706,6 +1741,18 @@ typedef
 
 /* A list thereof. */
 static OpenedDLL* opened_dlls = NULL;
+
+/* A record for storing indirectly linked functions from DLLs. */
+typedef
+   struct _IndirectAddr {
+      void*                 addr;
+      struct _IndirectAddr* next;
+   }
+   IndirectAddr;
+
+/* A list thereof. */
+static IndirectAddr* indirects = NULL;
+
 #endif
 
 #  if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
@@ -1854,6 +1901,7 @@ addDLL( pathchar *dll_name )
             // success -- try to dlopen the first named file
             IF_DEBUG(linker, debugBelch("match%s\n",""));
             line[match[2].rm_eo] = '\0';
+            stgFree((void*)errmsg); // Free old message before creating new one
             errmsg = internal_dlopen(line+match[2].rm_so);
             break;
          }
@@ -2173,7 +2221,20 @@ void freeObjectCode (ObjectCode *oc)
 
 #else
 
+#ifndef mingw32_HOST_OS
     stgFree(oc->image);
+#else
+    VirtualFree(oc->image - PEi386_IMAGE_OFFSET, 0, MEM_RELEASE);
+
+    IndirectAddr *ia, *ia_next;
+    ia = indirects;
+    while (ia != NULL) {
+      ia_next = ia->next;
+      stgFree(ia);
+      ia = ia_next;
+    }
+
+#endif
 
 #if defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH) || defined(arm_HOST_ARCH)
 #if !defined(x86_64_HOST_ARCH) || !defined(mingw32_HOST_OS)
@@ -2245,6 +2306,23 @@ mkOc( pathchar *path, char *image, int imageSize,
    return oc;
 }
 
+/* -----------------------------------------------------------------------------
+ * Check if an object or archive is already loaded.
+ *
+ * Returns: 1 if the path is already loaded, 0 otherwise.
+ */
+static HsInt
+isAlreadyLoaded( pathchar *path )
+{
+    ObjectCode *o;
+    for (o = objects; o; o = o->next) {
+       if (0 == pathcmp(o->fileName, path)) {
+           return 1; /* already loaded */
+       }
+    }
+    return 0; /* not loaded yet */
+}
+
 HsInt
 loadArchive( pathchar *path )
 {
@@ -2256,7 +2334,7 @@ loadArchive( pathchar *path )
     size_t thisFileNameSize;
     char *fileName;
     size_t fileNameSize;
-    int isObject, isGnuIndex;
+    int isObject, isGnuIndex, isThin;
     char tmp[20];
     char *gnuFileIndex;
     int gnuFileIndexSize;
@@ -2283,15 +2361,27 @@ loadArchive( pathchar *path )
 #endif
 #endif
 
+    initLinker();
+
     IF_DEBUG(linker, debugBelch("loadArchive: start\n"));
     IF_DEBUG(linker, debugBelch("loadArchive: Loading archive `%" PATH_FMT" '\n", path));
 
+    /* Check that we haven't already loaded this archive.
+       Ignore requests to load multiple times */
+    if (isAlreadyLoaded(path)) {
+        IF_DEBUG(linker,
+                 debugBelch("ignoring repeated load of %" PATH_FMT "\n", path));
+        return 1; /* success */
+    }
+
     gnuFileIndex = NULL;
     gnuFileIndexSize = 0;
 
     fileNameSize = 32;
     fileName = stgMallocBytes(fileNameSize, "loadArchive(fileName)");
 
+    isThin = 0;
+
     f = pathopen(path, WSTR("rb"));
     if (!f)
         barf("loadObj: can't read `%s'", path);
@@ -2318,53 +2408,58 @@ loadArchive( pathchar *path )
     n = fread ( tmp, 1, 8, f );
     if (n != 8)
         barf("loadArchive: Failed reading header from `%s'", path);
-    if (strncmp(tmp, "!<arch>\n", 8) != 0) {
-
+    if (strncmp(tmp, "!<arch>\n", 8) == 0) {}
+#if !defined(mingw32_HOST_OS)
+    /* See Note [thin archives on Windows] */
+    else if (strncmp(tmp, "!<thin>\n", 8) == 0) {
+        isThin = 1;
+    }
+#endif
 #if defined(darwin_HOST_OS)
-        /* Not a standard archive, look for a fat archive magic number: */
-        if (ntohl(*(uint32_t *)tmp) == FAT_MAGIC) {
-            nfat_arch = ntohl(*(uint32_t *)(tmp + 4));
-            IF_DEBUG(linker, debugBelch("loadArchive: found a fat archive containing %d architectures\n", nfat_arch));
-            nfat_offset = 0;
-
-            for (i = 0; i < (int)nfat_arch; i++) {
-                /* search for the right arch */
-                n = fread( tmp, 1, 20, f );
-                if (n != 8)
-                    barf("loadArchive: Failed reading arch from `%s'", path);
-                cputype = ntohl(*(uint32_t *)tmp);
-                cpusubtype = ntohl(*(uint32_t *)(tmp + 4));
-
-                if (cputype == mycputype && cpusubtype == mycpusubtype) {
-                    IF_DEBUG(linker, debugBelch("loadArchive: found my archive in a fat archive\n"));
-                    nfat_offset = ntohl(*(uint32_t *)(tmp + 8));
-                    break;
-                }
+    /* Not a standard archive, look for a fat archive magic number: */
+    else if (ntohl(*(uint32_t *)tmp) == FAT_MAGIC) {
+        nfat_arch = ntohl(*(uint32_t *)(tmp + 4));
+        IF_DEBUG(linker, debugBelch("loadArchive: found a fat archive containing %d architectures\n", nfat_arch));
+        nfat_offset = 0;
+
+        for (i = 0; i < (int)nfat_arch; i++) {
+            /* search for the right arch */
+            n = fread( tmp, 1, 20, f );
+            if (n != 8)
+                barf("loadArchive: Failed reading arch from `%s'", path);
+            cputype = ntohl(*(uint32_t *)tmp);
+            cpusubtype = ntohl(*(uint32_t *)(tmp + 4));
+
+            if (cputype == mycputype && cpusubtype == mycpusubtype) {
+                IF_DEBUG(linker, debugBelch("loadArchive: found my archive in a fat archive\n"));
+                nfat_offset = ntohl(*(uint32_t *)(tmp + 8));
+                break;
             }
+        }
 
-            if (nfat_offset == 0) {
-               barf ("loadArchive: searched %d architectures, but no host arch found", (int)nfat_arch);
-            }
-            else {
-                n = fseek( f, nfat_offset, SEEK_SET );
-                if (n != 0)
-                    barf("loadArchive: Failed to seek to arch in `%s'", path);
-                n = fread ( tmp, 1, 8, f );
-                if (n != 8)
-                    barf("loadArchive: Failed reading header from `%s'", path);
-                if (strncmp(tmp, "!<arch>\n", 8) != 0) {
-                    barf("loadArchive: couldn't find archive in `%s' at offset %d", path, nfat_offset);
-                }
-            }
+        if (nfat_offset == 0) {
+           barf ("loadArchive: searched %d architectures, but no host arch found", (int)nfat_arch);
         }
         else {
-            barf("loadArchive: Neither an archive, nor a fat archive: `%s'", path);
+            n = fseek( f, nfat_offset, SEEK_SET );
+            if (n != 0)
+                barf("loadArchive: Failed to seek to arch in `%s'", path);
+            n = fread ( tmp, 1, 8, f );
+            if (n != 8)
+                barf("loadArchive: Failed reading header from `%s'", path);
+            if (strncmp(tmp, "!<arch>\n", 8) != 0) {
+                barf("loadArchive: couldn't find archive in `%s' at offset %d", path, nfat_offset);
+            }
         }
-
+    }
+    else {
+        barf("loadArchive: Neither an archive, nor a fat archive: `%s'", path);
+    }
 #else
+    else {
         barf("loadArchive: Not an archive: `%s'", path);
-#endif
     }
+#endif
 
     IF_DEBUG(linker, debugBelch("loadArchive: loading archive contents\n"));
 
@@ -2470,8 +2565,8 @@ loadArchive( pathchar *path )
                 if (n != 0 && gnuFileIndex[n - 1] != '\n') {
                     barf("loadArchive: GNU-variant filename offset %d invalid (range [0..%d]) while reading filename from `%s'", n, gnuFileIndexSize, path);
                 }
-                for (i = n; gnuFileIndex[i] != '/'; i++);
-                thisFileNameSize = i - n;
+                for (i = n; gnuFileIndex[i] != '\n'; i++);
+                thisFileNameSize = i - n - 1;
                 if (thisFileNameSize >= fileNameSize) {
                     /* Double it to avoid potentially continually
                        increasing it by 1 */
@@ -2546,23 +2641,11 @@ loadArchive( pathchar *path )
 #elif defined(mingw32_HOST_OS)
         // TODO: We would like to use allocateExec here, but allocateExec
         //       cannot currently allocate blocks large enough.
-            {
-                int offset;
+            image = allocateImageAndTrampolines(
 #if defined(x86_64_HOST_ARCH)
-                /* We get back 8-byte aligned memory (is that guaranteed?), but
-                   the offsets to the sections within the file are all 4 mod 8
-                   (is that guaranteed?). We therefore need to offset the image
-                   by 4, so that all the pointers are 8-byte aligned, so that
-                   pointer tagging works. */
-                offset = 4;
-#else
-                offset = 0;
+               f, path, fileName,
 #endif
-                image = VirtualAlloc(NULL, memberSize + offset,
-                                     MEM_RESERVE | MEM_COMMIT,
-                                     PAGE_EXECUTE_READWRITE);
-                image += offset;
-            }
+               memberSize);
 #elif defined(darwin_HOST_OS)
             /* See loadObj() */
             misalignment = machoGetMisalignment(f);
@@ -2571,9 +2654,53 @@ loadArchive( pathchar *path )
 #else
             image = stgMallocBytes(memberSize, "loadArchive(image)");
 #endif
-            n = fread ( image, 1, memberSize, f );
-            if (n != memberSize) {
-                barf("loadArchive: error whilst reading `%s'", path);
+
+#if !defined(mingw32_HOST_OS)
+            /*
+             * Note [thin archives on Windows]
+             * This doesn't compile on Windows because it assumes
+             * char* pathnames, and we use wchar_t* on Windows.  It's
+             * not trivial to fix, so I'm leaving it disabled on
+             * Windows for now --SDM
+             */
+            if (isThin) {
+                FILE *member;
+                char *pathCopy, *dirName, *memberPath;
+
+                /* Allocate and setup the dirname of the archive.  We'll need
+                   this to locate the thin member */
+                pathCopy = stgMallocBytes(strlen(path) + 1, "loadArchive(file)");
+                strcpy(pathCopy, path);
+                dirName = dirname(pathCopy);
+
+                /* Append the relative member name to the dirname.  This should be
+                   be the full path to the actual thin member. */
+                memberPath = stgMallocBytes(
+                    strlen(path) + 1 + strlen(fileName) + 1, "loadArchive(file)");
+                strcpy(memberPath, dirName);
+                memberPath[strlen(dirName)] = '/';
+                strcpy(memberPath + strlen(dirName) + 1, fileName);
+
+                member = pathopen(memberPath, WSTR("rb"));
+                if (!member)
+                    barf("loadObj: can't read `%s'", path);
+
+                n = fread ( image, 1, memberSize, member );
+                if (n != memberSize) {
+                    barf("loadArchive: error whilst reading `%s'", fileName);
+                }
+
+                fclose(member);
+                stgFree(memberPath);
+                stgFree(pathCopy);
+            }
+            else
+#endif
+            {
+                n = fread ( image, 1, memberSize, f );
+                if (n != memberSize) {
+                    barf("loadArchive: error whilst reading `%s'", path);
+                }
             }
 
             archiveMemberName = stgMallocBytes(pathlen(path) + thisFileNameSize + 3,
@@ -2593,6 +2720,7 @@ loadArchive( pathchar *path )
 
             if (0 == loadOc(oc)) {
                 stgFree(fileName);
+                fclose(f);
                 return 0;
             }
         }
@@ -2615,14 +2743,16 @@ loadArchive( pathchar *path )
         }
         else {
             IF_DEBUG(linker, debugBelch("loadArchive: '%s' does not appear to be an object file\n", fileName));
-            n = fseek(f, memberSize, SEEK_CUR);
-            if (n != 0)
-                barf("loadArchive: error whilst seeking by %d in `%s'",
-                     memberSize, path);
+            if (!isThin || thisFileNameSize == 0) {
+                n = fseek(f, memberSize, SEEK_CUR);
+                if (n != 0)
+                    barf("loadArchive: error whilst seeking by %d in `%s'",
+                         memberSize, path);
+            }
         }
 
         /* .ar files are 2-byte aligned */
-        if (memberSize % 2) {
+        if (!(isThin && thisFileNameSize > 0) && memberSize % 2) {
             IF_DEBUG(linker, debugBelch("loadArchive: trying to read one pad byte\n"));
             n = fread ( tmp, 1, 1, f );
             if (n != 1) {
@@ -2683,24 +2813,11 @@ loadObj( pathchar *path )
 
    /* Check that we haven't already loaded this object.
       Ignore requests to load multiple times */
-   {
-       ObjectCode *o;
-       int is_dup = 0;
-       for (o = objects; o; o = o->next) {
-          if (0 == pathcmp(o->fileName, path)) {
-             is_dup = 1;
-             break; /* don't need to search further */
-          }
-       }
-       if (is_dup) {
-          IF_DEBUG(linker, debugBelch(
-            "GHCi runtime linker: warning: looks like you're trying to load the\n"
-            "same object file twice:\n"
-            "   %" PATH_FMT "\n"
-            "GHCi will ignore this, but be warned.\n"
-            , path));
-          return 1; /* success */
-       }
+
+   if (isAlreadyLoaded(path)) {
+       IF_DEBUG(linker,
+                debugBelch("ignoring repeated load of %" PATH_FMT "\n", path));
+       return 1; /* success */
    }
 
    r = pathstat(path, &st);
@@ -2715,8 +2832,10 @@ loadObj( pathchar *path )
    /* On many architectures malloc'd memory isn't executable, so we need to use mmap. */
 
 #if defined(openbsd_HOST_OS)
+   /* coverity[toctou] */
    fd = open(path, O_RDONLY, S_IRUSR);
 #else
+   /* coverity[toctou] */
    fd = open(path, O_RDONLY);
 #endif
    if (fd == -1)
@@ -2728,6 +2847,7 @@ loadObj( pathchar *path )
 
 #else /* !USE_MMAP */
    /* load the image into memory */
+   /* coverity[toctou] */
    f = pathopen(path, WSTR("rb"));
    if (!f)
        barf("loadObj: can't read `%" PATH_FMT "'", path);
@@ -2735,22 +2855,11 @@ loadObj( pathchar *path )
 #   if defined(mingw32_HOST_OS)
         // TODO: We would like to use allocateExec here, but allocateExec
         //       cannot currently allocate blocks large enough.
-    {
-        int offset;
+    image = allocateImageAndTrampolines(
 #if defined(x86_64_HOST_ARCH)
-        /* We get back 8-byte aligned memory (is that guaranteed?), but
-           the offsets to the sections within the file are all 4 mod 8
-           (is that guaranteed?). We therefore need to offset the image
-           by 4, so that all the pointers are 8-byte aligned, so that
-           pointer tagging works. */
-        offset = 4;
-#else
-        offset = 0;
+       f, path, "itself",
 #endif
-      image = VirtualAlloc(NULL, fileSize + offset, MEM_RESERVE | MEM_COMMIT,
-                           PAGE_EXECUTE_READWRITE);
-      image += offset;
-    }
+       fileSize);
 #   elif defined(darwin_HOST_OS)
     // In a Mach-O .o file, all sections can and will be misaligned
     // if the total size of the headers is not a multiple of the
@@ -2806,6 +2915,8 @@ loadOc( ObjectCode* oc ) {
        IF_DEBUG(linker, debugBelch("loadOc: ocAllocateSymbolExtras_ELF failed\n"));
        return r;
    }
+#  elif defined(OBJFORMAT_PEi386) && defined(x86_64_HOST_ARCH)
+   ocAllocateSymbolExtras_PEi386 ( oc );
 #endif
 
    /* verify the in-memory image */
@@ -2912,8 +3023,8 @@ unloadObj( pathchar *path )
     IF_DEBUG(linker, debugBelch("unloadObj: %" PATH_FMT "\n", path));
 
     prev = NULL;
-    for (oc = objects; oc; prev = oc, oc = next) {
-        next = oc->next;
+    for (oc = objects; oc; oc = next) {
+        next = oc->next; // oc might be freed
 
         if (!pathcmp(oc->fileName,path)) {
 
@@ -2971,6 +3082,8 @@ unloadObj( pathchar *path )
             /* This could be a member of an archive so continue
              * unloading other members. */
             unloadedAnyObj = HS_BOOL_TRUE;
+        } else {
+            prev = oc;
         }
     }
 
@@ -3460,6 +3573,46 @@ typedef
 #define MYIMAGE_REL_I386_DIR32           0x0006
 #define MYIMAGE_REL_I386_REL32           0x0014
 
+/* We assume file pointer is right at the
+   beginning of COFF object.
+ */
+static char *
+allocateImageAndTrampolines (
+#if defined(x86_64_HOST_ARCH)
+   FILE* f, pathchar* arch_name, char* member_name,
+#endif
+   int size )
+{
+   char* image;
+#if defined(x86_64_HOST_ARCH)
+   /* PeCoff contains number of symbols right in it's header, so
+      we can reserve the room for symbolExtras right here. */
+   COFF_header hdr;
+   size_t n;
+
+   n = fread ( &hdr, 1, sizeof_COFF_header, f );
+   if (n != sizeof( COFF_header ))
+       barf("getNumberOfSymbols: error whilst reading `%s' header in `%S'",
+             member_name, arch_name);
+   fseek( f, -sizeof_COFF_header, SEEK_CUR );
+   
+   /* We get back 8-byte aligned memory (is that guaranteed?), but
+      the offsets to the sections within the file are all 4 mod 8
+      (is that guaranteed?). We therefore need to offset the image
+      by 4, so that all the pointers are 8-byte aligned, so that
+      pointer tagging works. */
+   /* For 32-bit case we don't need this, hence we use macro PEi386_IMAGE_OFFSET,
+      which equals to 4 for 64-bit case and 0 for 32-bit case. */
+   /* We allocate trampolines area for all symbols right behind
+      image data, aligned on 8. */
+   size = ((PEi386_IMAGE_OFFSET + size + 0x7) & ~0x7)
+              + hdr.NumberOfSymbols * sizeof(SymbolExtra);
+#endif
+   image = VirtualAlloc(NULL, size,
+                        MEM_RESERVE | MEM_COMMIT,
+                        PAGE_EXECUTE_READWRITE);
+   return image + PEi386_IMAGE_OFFSET;
+}
 
 /* We use myindex to calculate array addresses, rather than
    simply doing the normal subscript thing.  That's because
@@ -3568,9 +3721,10 @@ cstring_from_section_name (UChar* name, UChar* strtab)
 
 /* Just compares the short names (first 8 chars) */
 static COFF_section *
-findPEi386SectionCalled ( ObjectCode* oc,  UChar* name )
+findPEi386SectionCalled ( ObjectCode* oc,  UChar* name, UChar* strtab )
 {
    int i;
+   rtsBool long_name = rtsFalse;
    COFF_header* hdr
       = (COFF_header*)(oc->image);
    COFF_section* sectab
@@ -3578,6 +3732,14 @@ findPEi386SectionCalled ( ObjectCode* oc,  UChar* name )
            ((UChar*)(oc->image))
            + sizeof_COFF_header + hdr->SizeOfOptionalHeader
         );
+   // String is longer than 8 bytes, swap in the proper
+   // (NULL-terminated) version, and make a note that this
+   // is a long name.
+   if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
+      UInt32 strtab_offset = * (UInt32*)(name+4);
+      name = ((UChar*)strtab) + strtab_offset;
+      long_name = rtsTrue;
+   }
    for (i = 0; i < hdr->NumberOfSections; i++) {
       UChar* n1;
       UChar* n2;
@@ -3586,10 +3748,28 @@ findPEi386SectionCalled ( ObjectCode* oc,  UChar* name )
            myindex ( sizeof_COFF_section, sectab, i );
       n1 = (UChar*) &(section_i->Name);
       n2 = name;
-      if (n1[0]==n2[0] && n1[1]==n2[1] && n1[2]==n2[2] &&
-          n1[3]==n2[3] && n1[4]==n2[4] && n1[5]==n2[5] &&
-          n1[6]==n2[6] && n1[7]==n2[7])
-         return section_i;
+      // Long section names are prefixed with a slash, see
+      // also cstring_from_section_name
+      if (n1[0] == '/' && long_name) {
+         // Long name check
+         // We don't really want to make an assumption that the string
+         // table indexes are the same, so we'll do a proper check.
+         int n1_strtab_offset = strtol((char*)n1+1,NULL,10);
+         n1 = (UChar*) (((char*)strtab) + n1_strtab_offset);
+         if (0==strcmp((const char*)n1, (const char*)n2)) {
+            return section_i;
+         }
+      } else if (n1[0] != '/' && !long_name) {
+         // Short name check
+         if (n1[0]==n2[0] && n1[1]==n2[1] && n1[2]==n2[2] &&
+             n1[3]==n2[3] && n1[4]==n2[4] && n1[5]==n2[5] &&
+             n1[6]==n2[6] && n1[7]==n2[7]) {
+            return section_i;
+         }
+      } else {
+         // guaranteed to mismatch, because we never attempt to link
+         // in an executable where the section name may be truncated
+      }
    }
 
    return NULL;
@@ -3631,6 +3811,28 @@ lookupSymbolInDLLs ( UChar *lbl )
                 return sym;
             }
         }
+
+        /* Ticket #2283.
+           Long description: http://support.microsoft.com/kb/132044
+           tl;dr:
+             If C/C++ compiler sees __declspec(dllimport) ... foo ...
+             it generates call *__imp_foo, and __imp_foo here has exactly
+             the same semantics as in __imp_foo = GetProcAddress(..., "foo")
+         */
+        if (sym == NULL && strncmp ((const char*)lbl, "__imp_", 6) == 0) {
+            sym = GetProcAddress(o_dll->instance, (char*)(lbl+6));
+            if (sym != NULL) {
+                IndirectAddr* ret;
+                ret = stgMallocBytes( sizeof(IndirectAddr), "lookupSymbolInDLLs" );
+                ret->addr = sym;
+                ret->next = indirects;
+                indirects = ret;
+                errorBelch("warning: %s from %S is linked instead of %s",
+                              (char*)(lbl+6), o_dll->name, (char*)lbl);
+                return (void*) & ret->addr;
+               }
+        }
+
         sym = GetProcAddress(o_dll->instance, (char*)lbl);
         if (sym != NULL) {
             /*debugBelch("found %s in %s\n", lbl,o_dll->name);*/
@@ -3944,6 +4146,7 @@ ocGetNames_PEi386 ( ObjectCode* oc )
 
       if (0==strcmp(".text",(char*)secname) ||
           0==strcmp(".text.startup",(char*)secname) ||
+          0==strcmp(".text.unlikely", (char*)secname) ||
           0==strcmp(".rdata",(char*)secname)||
           0==strcmp(".eh_frame", (char*)secname)||
           0==strcmp(".rodata",(char*)secname))
@@ -3967,8 +4170,8 @@ ocGetNames_PEi386 ( ObjectCode* oc )
           && 0 != strcmp(".stab", (char*)secname)
           && 0 != strcmp(".stabstr", (char*)secname)
           /* Ignore sections called which contain exception information. */
-          && 0 != strcmp(".pdata", (char*)secname)
-          && 0 != strcmp(".xdata", (char*)secname)
+          && 0 != strncmp(".pdata", (char*)secname, 6)
+          && 0 != strncmp(".xdata", (char*)secname, 6)
           /* ignore section generated from .ident */
           && 0!= strncmp(".debug", (char*)secname, 6)
           /* ignore unknown section that appeared in gcc 3.4.5(?) */
@@ -3983,8 +4186,8 @@ ocGetNames_PEi386 ( ObjectCode* oc )
       }
 
       if (kind != SECTIONKIND_OTHER && end >= start) {
-          if ((((size_t)(start)) % sizeof(void *)) != 0) {
-              barf("Misaligned section: %p", start);
+          if ((((size_t)(start)) % 4) != 0) {
+              barf("Misaligned section %s: %p", (char*)secname, start);
           }
 
          addSection(oc, kind, start, end);
@@ -4081,6 +4284,46 @@ ocGetNames_PEi386 ( ObjectCode* oc )
    return 1;
 }
 
+#if defined(x86_64_HOST_ARCH)
+
+/* We've already reserved a room for symbol extras in loadObj,
+ * so simply set correct pointer here.
+ */
+static int
+ocAllocateSymbolExtras_PEi386 ( ObjectCode* oc )
+{
+   oc->symbol_extras = (SymbolExtra*)(oc->image - PEi386_IMAGE_OFFSET
+                                      + ((PEi386_IMAGE_OFFSET + oc->fileSize + 0x7) & ~0x7));
+   oc->first_symbol_extra = 0;
+   oc->n_symbol_extras = ((COFF_header*)oc->image)->NumberOfSymbols;
+
+   return 1;
+}
+
+static size_t
+makeSymbolExtra_PEi386( ObjectCode* oc, size_t s, char* symbol )
+{
+    unsigned int curr_thunk;
+    SymbolExtra *extra;
+
+    curr_thunk = oc->first_symbol_extra;
+    if (curr_thunk >= oc->n_symbol_extras) {
+      barf("Can't allocate thunk for %s", symbol);
+    }
+
+    extra = oc->symbol_extras + curr_thunk;
+
+    // jmp *-14(%rip)
+    static uint8_t jmp[] = { 0xFF, 0x25, 0xF2, 0xFF, 0xFF, 0xFF };
+    extra->addr = (uint64_t)s;
+    memcpy(extra->jumpIsland, jmp, 6);
+
+    oc->first_symbol_extra++;
+
+    return (size_t)extra->jumpIsland;
+}
+
+#endif
 
 static int
 ocResolve_PEi386 ( ObjectCode* oc )
@@ -4130,8 +4373,8 @@ ocResolve_PEi386 ( ObjectCode* oc )
          information. */
       if (0 == strcmp(".stab", (char*)secname)
           || 0 == strcmp(".stabstr", (char*)secname)
-          || 0 == strcmp(".pdata", (char*)secname)
-          || 0 == strcmp(".xdata", (char*)secname)
+          || 0 == strncmp(".pdata", (char*)secname, 6)
+          || 0 == strncmp(".xdata", (char*)secname, 6)
           || 0 == strncmp(".debug", (char*)secname, 6)
           || 0 == strcmp(".rdata$zzz", (char*)secname)) {
           stgFree(secname);
@@ -4199,9 +4442,11 @@ ocResolve_PEi386 ( ObjectCode* oc )
 
          if (sym->StorageClass == MYIMAGE_SYM_CLASS_STATIC) {
             COFF_section* section_sym
-               = findPEi386SectionCalled ( oc, sym->Name );
+               = findPEi386SectionCalled ( oc, sym->Name, strtab );
             if (!section_sym) {
-               errorBelch("%" PATH_FMT ": can't find section `%s'", oc->fileName, sym->Name);
+               errorBelch("%" PATH_FMT ": can't find section named: ", oc->fileName);
+               printName(sym->Name, strtab);
+               errorBelch(" in %s", secname);
                return 0;
             }
             S = ((size_t)(oc->image))
@@ -4258,8 +4503,13 @@ ocResolve_PEi386 ( ObjectCode* oc )
                    v = S + ((size_t)A);
                    if (v >> 32) {
                        copyName ( sym->Name, strtab, symbol, 1000-1 );
-                       barf("R_X86_64_32[S]: High bits are set in %zx for %s",
-                            v, (char *)symbol);
+                       S = makeSymbolExtra_PEi386(oc, S, (char *)symbol);
+                       /* And retry */
+                       v = S + ((size_t)A);
+                       if (v >> 32) {
+                           barf("R_X86_64_32[S]: High bits are set in %zx for %s",
+                                v, (char *)symbol);
+                       }
                    }
                    *(UInt32 *)pP = (UInt32)v;
                    break;
@@ -4269,9 +4519,15 @@ ocResolve_PEi386 ( ObjectCode* oc )
                    intptr_t v;
                    v = ((intptr_t)S) + ((intptr_t)(Int32)A) - ((intptr_t)pP) - 4;
                    if ((v >> 32) && ((-v) >> 32)) {
+                       /* Make the trampoline then */
                        copyName ( sym->Name, strtab, symbol, 1000-1 );
-                       barf("R_X86_64_PC32: High bits are set in %zx for %s",
-                            v, (char *)symbol);
+                       S = makeSymbolExtra_PEi386(oc, S, (char *)symbol);
+                       /* And retry */
+                       v = ((intptr_t)S) + ((intptr_t)(Int32)A) - ((intptr_t)pP) - 4;
+                       if ((v >> 32) && ((-v) >> 32)) {
+                           barf("R_X86_64_PC32: High bits are set in %zx for %s",
+                                v, (char *)symbol);
+                       }
                    }
                    *(UInt32 *)pP = (UInt32)v;
                    break;
@@ -6909,3 +7165,11 @@ machoGetMisalignment( FILE * f )
 #endif
 
 #endif
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/LinkerInternals.h b/rts/LinkerInternals.h
index e1942bc8aec8..1a203ded7e15 100644
--- a/rts/LinkerInternals.h
+++ b/rts/LinkerInternals.h
@@ -149,3 +149,11 @@ void exitLinker( void );
 void freeObjectCode (ObjectCode *oc);
 
 #endif /* LINKERINTERNALS_H */
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/Messages.c b/rts/Messages.c
index c5988f8b25e3..2f03ae60c083 100644
--- a/rts/Messages.c
+++ b/rts/Messages.c
@@ -25,7 +25,7 @@ void sendMessage(Capability *from_cap, Capability *to_cap, Message *msg)
 {
     ACQUIRE_LOCK(&to_cap->lock);
 
-#ifdef DEBUG    
+#ifdef DEBUG
     {
         const StgInfoTable *i = msg->header.info;
         if (i != &stg_MSG_THROWTO_info &&
@@ -44,7 +44,7 @@ void sendMessage(Capability *from_cap, Capability *to_cap, Message *msg)
     recordClosureMutated(from_cap,(StgClosure*)msg);
 
     if (to_cap->running_task == NULL) {
-	to_cap->running_task = myTask(); 
+        to_cap->running_task = myTask();
             // precond for releaseCapability_()
         releaseCapability_(to_cap,rtsFalse);
     } else {
@@ -73,7 +73,7 @@ executeMessage (Capability *cap, Message *m)
     if (i == &stg_MSG_TRY_WAKEUP_info)
     {
         StgTSO *tso = ((MessageWakeup *)m)->tso;
-        debugTraceCap(DEBUG_sched, cap, "message: try wakeup thread %ld", 
+        debugTraceCap(DEBUG_sched, cap, "message: try wakeup thread %ld",
                       (W_)tso->id);
         tryWakeupThread(cap, tso);
     }
@@ -89,7 +89,7 @@ executeMessage (Capability *cap, Message *m)
             goto loop;
         }
 
-        debugTraceCap(DEBUG_sched, cap, "message: throwTo %ld -> %ld", 
+        debugTraceCap(DEBUG_sched, cap, "message: throwTo %ld -> %ld",
                       (W_)t->source->id, (W_)t->target->id);
 
         ASSERT(t->source->why_blocked == BlockedOnMsgThrowTo);
@@ -144,10 +144,10 @@ executeMessage (Capability *cap, Message *m)
 
    This is called from two places: either we just entered a BLACKHOLE
    (stg_BLACKHOLE_info), or we received a MSG_BLACKHOLE in our
-   cap->inbox.  
+   cap->inbox.
 
    We need to establish whether the BLACKHOLE belongs to
-   this Capability, and 
+   this Capability, and
      - if so, arrange to block the current thread on it
      - otherwise, forward the message to the right place
 
@@ -166,8 +166,8 @@ nat messageBlackHole(Capability *cap, MessageBlackHole *msg)
     StgClosure *bh = UNTAG_CLOSURE(msg->bh);
     StgTSO *owner;
 
-    debugTraceCap(DEBUG_sched, cap, "message: thread %d blocking on blackhole %p", 
-                  (W_)msg->tso->id, msg->bh);
+    debugTraceCap(DEBUG_sched, cap, "message: thread %d blocking on "
+                  "blackhole %p", (W_)msg->tso->id, msg->bh);
 
     info = bh->header.info;
 
@@ -175,8 +175,8 @@ nat messageBlackHole(Capability *cap, MessageBlackHole *msg)
     // BLACKHOLE has already been updated, and GC has shorted out the
     // indirection, so the pointer no longer points to a BLACKHOLE at
     // all.
-    if (info != &stg_BLACKHOLE_info && 
-        info != &stg_CAF_BLACKHOLE_info && 
+    if (info != &stg_BLACKHOLE_info &&
+        info != &stg_CAF_BLACKHOLE_info &&
         info != &__stg_EAGER_BLACKHOLE_info &&
         info != &stg_WHITEHOLE_info) {
         // if it is a WHITEHOLE, then a thread is in the process of
@@ -210,7 +210,8 @@ nat messageBlackHole(Capability *cap, MessageBlackHole *msg)
 #ifdef THREADED_RTS
         if (owner->cap != cap) {
             sendMessage(cap, owner->cap, (Message*)msg);
-            debugTraceCap(DEBUG_sched, cap, "forwarding message to cap %d", owner->cap->no);
+            debugTraceCap(DEBUG_sched, cap, "forwarding message to cap %d",
+                          owner->cap->no);
             return 1;
         }
 #endif
@@ -219,15 +220,15 @@ nat messageBlackHole(Capability *cap, MessageBlackHole *msg)
         // BLACKHOLE, so we first create a BLOCKING_QUEUE object.
 
         bq = (StgBlockingQueue*)allocate(cap, sizeofW(StgBlockingQueue));
-            
+
         // initialise the BLOCKING_QUEUE object
         SET_HDR(bq, &stg_BLOCKING_QUEUE_DIRTY_info, CCS_SYSTEM);
         bq->bh = bh;
         bq->queue = msg;
         bq->owner = owner;
-        
+
         msg->link = (MessageBlackHole*)END_TSO_QUEUE;
-        
+
         // All BLOCKING_QUEUES are linked in a list on owner->bq, so
         // that we can search through them in the event that there is
         // a collision to update a BLACKHOLE and a BLOCKING_QUEUE
@@ -254,12 +255,12 @@ nat messageBlackHole(Capability *cap, MessageBlackHole *msg)
         ((StgInd*)bh)->indirectee = (StgClosure *)bq;
         recordClosureMutated(cap,bh); // bh was mutated
 
-        debugTraceCap(DEBUG_sched, cap, "thread %d blocked on thread %d", 
+        debugTraceCap(DEBUG_sched, cap, "thread %d blocked on thread %d",
                       (W_)msg->tso->id, (W_)owner->id);
 
         return 1; // blocked
     }
-    else if (info == &stg_BLOCKING_QUEUE_CLEAN_info || 
+    else if (info == &stg_BLOCKING_QUEUE_CLEAN_info ||
              info == &stg_BLOCKING_QUEUE_DIRTY_info)
     {
         StgBlockingQueue *bq = (StgBlockingQueue *)p;
@@ -273,7 +274,8 @@ nat messageBlackHole(Capability *cap, MessageBlackHole *msg)
 #ifdef THREADED_RTS
         if (owner->cap != cap) {
             sendMessage(cap, owner->cap, (Message*)msg);
-            debugTraceCap(DEBUG_sched, cap, "forwarding message to cap %d", owner->cap->no);
+            debugTraceCap(DEBUG_sched, cap, "forwarding message to cap %d",
+                          owner->cap->no);
             return 1;
         }
 #endif
@@ -287,7 +289,7 @@ nat messageBlackHole(Capability *cap, MessageBlackHole *msg)
             recordClosureMutated(cap,(StgClosure*)bq);
         }
 
-        debugTraceCap(DEBUG_sched, cap, "thread %d blocked on thread %d", 
+        debugTraceCap(DEBUG_sched, cap, "thread %d blocked on thread %d",
                       (W_)msg->tso->id, (W_)owner->id);
 
         // See above, #3838
@@ -297,7 +299,7 @@ nat messageBlackHole(Capability *cap, MessageBlackHole *msg)
 
         return 1; // blocked
     }
-    
+
     return 0; // not blocked
 }
 
@@ -313,7 +315,7 @@ StgTSO * blackHoleOwner (StgClosure *bh)
     info = bh->header.info;
 
     if (info != &stg_BLACKHOLE_info &&
-        info != &stg_CAF_BLACKHOLE_info && 
+        info != &stg_CAF_BLACKHOLE_info &&
         info != &__stg_EAGER_BLACKHOLE_info &&
         info != &stg_WHITEHOLE_info) {
         return NULL;
@@ -333,14 +335,20 @@ StgTSO * blackHoleOwner (StgClosure *bh)
     {
         return (StgTSO*)p;
     }
-    else if (info == &stg_BLOCKING_QUEUE_CLEAN_info || 
+    else if (info == &stg_BLOCKING_QUEUE_CLEAN_info ||
              info == &stg_BLOCKING_QUEUE_DIRTY_info)
     {
         StgBlockingQueue *bq = (StgBlockingQueue *)p;
         return bq->owner;
     }
-    
+
     return NULL; // not blocked
 }
 
-
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/Messages.h b/rts/Messages.h
index 4121364b21dc..c965511abfac 100644
--- a/rts/Messages.h
+++ b/rts/Messages.h
@@ -28,3 +28,11 @@ doneWithMsgThrowTo (MessageThrowTo *m)
 }
 
 #include "EndPrivate.h"
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/OldARMAtomic.c b/rts/OldARMAtomic.c
index b2c52fc1da4a..949e72b041ac 100644
--- a/rts/OldARMAtomic.c
+++ b/rts/OldARMAtomic.c
@@ -48,9 +48,16 @@ void arm_atomic_spin_lock()
 void arm_atomic_spin_unlock()
 {
   atomic_spin = 0;
-} 
+}
 
 #endif  /* arm_HOST_ARCH && defined(arm_HOST_ARCH_PRE_ARMv6) */
 
 #endif  /* defined(THREADED_RTS) */
 
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/Papi.c b/rts/Papi.c
index 62f5d0d3963b..39b9ee75f138 100644
--- a/rts/Papi.c
+++ b/rts/Papi.c
@@ -1,6 +1,6 @@
 /* -----------------------------------------------------------------------------
  * (c) The GHC Team 2006
- * 
+ *
  * Initialization and use of the PAPI performance monitoring library
  *
  *
@@ -61,10 +61,11 @@ struct _papi_events {
 #define BIG_STRING_LEN 512
 
 
-#define PAPI_CHECK(CALL) \
-  if((papi_error=(CALL)) != PAPI_OK) { \
-   debugBelch("PAPI function failed in module %s at line %d with error code %d\n", \
-	      __FILE__,__LINE__,papi_error);				\
+#define PAPI_CHECK(CALL)                                                \
+  if((papi_error=(CALL)) != PAPI_OK) {                                  \
+    debugBelch("PAPI function failed in module %s at line %d "          \
+               "with error code %d\n",                                  \
+              __FILE__,__LINE__,papi_error);                            \
   }
 
 /* While PAPI reporting is going on this flag is on */
@@ -113,41 +114,42 @@ static nat max_hardware_counters = 2;
 static void papi_add_event(const char *name, int code)
 {
     if (n_papi_events >= max_hardware_counters) {
-        errorBelch("too many PAPI events for this CPU (max: %d)", 
+        errorBelch("too many PAPI events for this CPU (max: %d)",
                    max_hardware_counters);
         stg_exit(EXIT_FAILURE);
     }
     papi_events[n_papi_events].event_code = code;
     papi_events[n_papi_events].event_name = name;
     n_papi_events++;
-}    
+}
 
 static void
-init_countable_events(void) 
+init_countable_events(void)
 {
     max_hardware_counters = PAPI_num_counters();
 
 #define PAPI_ADD_EVENT(EVENT) papi_add_event(#EVENT,EVENT)
 
     if (RtsFlags.PapiFlags.eventType==PAPI_FLAG_BRANCH) {
-	PAPI_ADD_EVENT(FR_BR);
-	PAPI_ADD_EVENT(FR_BR_MIS);
-	/* Docs are wrong? Opteron does not count indirect branch misses exclusively */
-	PAPI_ADD_EVENT(FR_BR_MISCOMPARE);
+        PAPI_ADD_EVENT(FR_BR);
+        PAPI_ADD_EVENT(FR_BR_MIS);
+        // Docs are wrong? Opteron does not count indirect branch
+        // misses exclusively
+        PAPI_ADD_EVENT(FR_BR_MISCOMPARE);
     } else if (RtsFlags.PapiFlags.eventType==PAPI_FLAG_STALLS) {
-	PAPI_ADD_EVENT(FR_DISPATCH_STALLS);
-	PAPI_ADD_EVENT(FR_DISPATCH_STALLS_BR);
-	PAPI_ADD_EVENT(FR_DISPATCH_STALLS_FULL_LS);
+        PAPI_ADD_EVENT(FR_DISPATCH_STALLS);
+        PAPI_ADD_EVENT(FR_DISPATCH_STALLS_BR);
+        PAPI_ADD_EVENT(FR_DISPATCH_STALLS_FULL_LS);
     } else if (RtsFlags.PapiFlags.eventType==PAPI_FLAG_CACHE_L1) {
-	PAPI_ADD_EVENT(PAPI_L1_DCA);
-	PAPI_ADD_EVENT(PAPI_L1_DCM);
+        PAPI_ADD_EVENT(PAPI_L1_DCA);
+        PAPI_ADD_EVENT(PAPI_L1_DCM);
     } else if (RtsFlags.PapiFlags.eventType==PAPI_FLAG_CACHE_L2) {
-	PAPI_ADD_EVENT(PAPI_L2_DCA);
-	PAPI_ADD_EVENT(PAPI_L2_DCM);
+        PAPI_ADD_EVENT(PAPI_L2_DCA);
+        PAPI_ADD_EVENT(PAPI_L2_DCM);
     } else if (RtsFlags.PapiFlags.eventType==PAPI_FLAG_CB_EVENTS) {
-	PAPI_ADD_EVENT(DC_L2_REFILL_MOES);
-	PAPI_ADD_EVENT(DC_SYS_REFILL_MOES);
-	PAPI_ADD_EVENT(FR_BR_MIS);
+        PAPI_ADD_EVENT(DC_L2_REFILL_MOES);
+        PAPI_ADD_EVENT(DC_SYS_REFILL_MOES);
+        PAPI_ADD_EVENT(FR_BR_MIS);
     } else if (RtsFlags.PapiFlags.eventType==PAPI_USER_EVENTS) {
         nat i;
         char *name;
@@ -167,25 +169,25 @@ init_countable_events(void)
           papi_add_event(name, code);
         }
     } else {
-	// PAPI_ADD_EVENT(PAPI_L1_DCA); // L1 data cache accesses
-	// PAPI_ADD_EVENT(PAPI_L1_ICR); // L1 instruction cache reads
-	// PAPI_ADD_EVENT(PAPI_L1_ICM); // L1 instruction cache misses
-	// PAPI_ADD_EVENT(PAPI_L1_STM); // L1 store misses
-	// PAPI_ADD_EVENT(PAPI_L1_DCM); // L1 data cache misses
-	// PAPI_ADD_EVENT(PAPI_L1_LDM); // L1 load misses
-	// PAPI_ADD_EVENT(PAPI_L2_TCM); // L2 cache misses
-	// PAPI_ADD_EVENT(PAPI_L2_STM); // L2 store misses
-	// PAPI_ADD_EVENT(PAPI_L2_DCW); // L2 data cache writes
-	// PAPI_ADD_EVENT(PAPI_L2_DCR); // L2 data cache reads
-	// PAPI_ADD_EVENT(PAPI_L2_TCW); // L2 cache writes
-	// PAPI_ADD_EVENT(PAPI_L2_TCR); // L2 cache reads
-	// PAPI_ADD_EVENT(PAPI_CA_CLN); // exclusive access to clean cache line
-	// PAPI_ADD_EVENT(PAPI_TLB_DM); // TLB misses
+        // PAPI_ADD_EVENT(PAPI_L1_DCA); // L1 data cache accesses
+        // PAPI_ADD_EVENT(PAPI_L1_ICR); // L1 instruction cache reads
+        // PAPI_ADD_EVENT(PAPI_L1_ICM); // L1 instruction cache misses
+        // PAPI_ADD_EVENT(PAPI_L1_STM); // L1 store misses
+        // PAPI_ADD_EVENT(PAPI_L1_DCM); // L1 data cache misses
+        // PAPI_ADD_EVENT(PAPI_L1_LDM); // L1 load misses
+        // PAPI_ADD_EVENT(PAPI_L2_TCM); // L2 cache misses
+        // PAPI_ADD_EVENT(PAPI_L2_STM); // L2 store misses
+        // PAPI_ADD_EVENT(PAPI_L2_DCW); // L2 data cache writes
+        // PAPI_ADD_EVENT(PAPI_L2_DCR); // L2 data cache reads
+        // PAPI_ADD_EVENT(PAPI_L2_TCW); // L2 cache writes
+        // PAPI_ADD_EVENT(PAPI_L2_TCR); // L2 cache reads
+        // PAPI_ADD_EVENT(PAPI_CA_CLN); // exclusive access to clean cache line
+        // PAPI_ADD_EVENT(PAPI_TLB_DM); // TLB misses
         PAPI_ADD_EVENT(PAPI_TOT_INS); // Total instructions
         PAPI_ADD_EVENT(PAPI_TOT_CYC); // Total instructions
-	// PAPI_ADD_EVENT(PAPI_CA_SHR); // exclusive access to shared cache line
-	// PAPI_ADD_EVENT(PAPI_RES_STL); // Cycles stalled on any resource
-        
+        // PAPI_ADD_EVENT(PAPI_CA_SHR); // exclusive access to shared cache line
+        // PAPI_ADD_EVENT(PAPI_RES_STL); // Cycles stalled on any resource
+
     }
 
     // We might also consider:
@@ -198,7 +200,7 @@ static void
 papi_report_event(const char *name, StgWord64 value)
 {
     static char temp[BIG_STRING_LEN];
-    showStgWord64(value,temp,rtsTrue/*commas*/); 
+    showStgWord64(value,temp,rtsTrue/*commas*/);
     statsPrintf("  %15s  %15s\n", name, temp);
 }
 
@@ -219,16 +221,16 @@ papi_report(long_long counters[])
     }
 
     if (RtsFlags.PapiFlags.eventType==PAPI_FLAG_BRANCH) {
-	PAPI_REPORT_PCT(counters,FR_BR_MIS,FR_BR);
-	PAPI_REPORT_PCT(counters,FR_BR_MISCOMPARE,FR_BR);
+        PAPI_REPORT_PCT(counters,FR_BR_MIS,FR_BR);
+        PAPI_REPORT_PCT(counters,FR_BR_MISCOMPARE,FR_BR);
     }
 
     else if (RtsFlags.PapiFlags.eventType==PAPI_FLAG_CACHE_L1) {
-	PAPI_REPORT_PCT(counters,PAPI_L1_DCM,PAPI_L1_DCA);
+        PAPI_REPORT_PCT(counters,PAPI_L1_DCM,PAPI_L1_DCA);
     }
 
     else if (RtsFlags.PapiFlags.eventType==PAPI_FLAG_CACHE_L2) {
-	PAPI_REPORT_PCT(counters,PAPI_L2_DCM,PAPI_L2_DCA);
+        PAPI_REPORT_PCT(counters,PAPI_L2_DCM,PAPI_L2_DCA);
     }
 }
 
@@ -238,7 +240,7 @@ papi_stats_report (void)
     statsPrintf("  Mutator CPU counters\n");
     papi_report_event("CYCLES", mutator_cycles);
     papi_report(MutatorCounters);
-    
+
     statsPrintf("\n  GC(0) CPU counters\n");
     papi_report_event("CYCLES", gc0_cycles);
     papi_report(GC0Counters);
@@ -247,7 +249,7 @@ papi_stats_report (void)
     papi_report_event("CYCLES", gc1_cycles);
     papi_report(GC1Counters);
 }
-    
+
 void
 papi_init_eventset (int *event_set)
 {
@@ -310,10 +312,10 @@ papi_add_events(int EventSet)
   nat i;
   for(i=0;i<n_papi_events;i++) {
     if((papi_error=PAPI_add_event(EventSet,
-				  papi_events[i].event_code))
+                                  papi_events[i].event_code))
        != PAPI_OK)
       debugBelch("Failed adding %s to event set with error code %d\n",
-		 papi_events[i].event_name,papi_error);
+                 papi_events[i].event_name,papi_error);
   }
 }
 
@@ -392,3 +394,11 @@ papi_thread_stop_gc1_count(int event_set)
 }
 
 #endif /* USE_PAPI */
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/Papi.h b/rts/Papi.h
index 7e58c6fbbe9e..1aa1b3138114 100644
--- a/rts/Papi.h
+++ b/rts/Papi.h
@@ -1,6 +1,6 @@
 /* -----------------------------------------------------------------------------
  * (c) The GHC Team 2006
- * 
+ *
  * Initialization and use of the PAPI performance monitoring library
  *
  * ---------------------------------------------------------------------------*/
@@ -34,3 +34,11 @@ void papi_thread_stop_gc1_count(int event_set);
 #include "EndPrivate.h"
 
 #endif /* PAPI_H */
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/PerfEvent.c b/rts/PerfEvent.c
new file mode 100644
index 000000000000..2b5bdc8550dc
--- /dev/null
+++ b/rts/PerfEvent.c
@@ -0,0 +1,285 @@
+
+#ifdef USE_PERF_EVENT
+
+#include "Rts.h"
+
+#include "PerfEvent.h"
+#include "Task.h"
+#include "RtsUtils.h"
+#include "Trace.h"
+
+#include <string.h>
+#include <sys/types.h>
+#include <sys/mman.h>
+#include <sys/ioctl.h>
+
+// Linux-specific includes required for perf_events
+#include <unistd.h>
+#include <sys/syscall.h>
+#include <linux/perf_event.h>
+
+// Some parts adapted from perf.h (tools/perf/perf.h in linux kernel tree)
+#ifdef i386_HOST_ARCH
+#define rmb()		asm volatile("lock; addl $0,0(%%esp)" ::: "memory")
+#endif
+#ifdef x86_64_HOST_ARCH
+#define rmb()		asm volatile("lfence" ::: "memory")
+#endif
+#ifdef powerpc_HOST_ARCH
+#define rmb()		asm volatile ("sync" ::: "memory")
+#endif
+#ifdef hppa1_1_HOST_ARCH
+#define rmb()		asm volatile("" ::: "memory")
+#endif
+#ifdef sparc_HOST_ARCH
+#define rmb()		asm volatile("":::"memory")
+#endif
+#ifndef rmb
+#error perf_event backend does not support this architecture!
+#endif
+
+// Number of pages used for capturing perf_events samples.
+// Note 1: Must be a power of 2!
+// Note 2: The kernel seems to object if we grab too much memory, so
+//         having this set too high will cause EPERMs with too many tasks!
+#define PERF_EVENT_MMAP_PAGES 32
+
+#ifdef TRACING
+static size_t get_page_size(void);
+static void perf_event_stream(Task *task, StgBool own_task);
+#endif
+
+static inline int
+sys_perf_event_open(struct perf_event_attr *attr,
+		      pid_t pid, int cpu, int group_fd,
+		      unsigned long flags)
+{
+	attr->size = sizeof(*attr);
+	return syscall(__NR_perf_event_open, attr, pid, cpu,
+	               group_fd, flags);
+}
+
+
+#ifdef TRACING
+static size_t get_page_size(void)
+{
+	static size_t page_size = 0;
+	if (0 == page_size)
+		return page_size = sysconf(_SC_PAGE_SIZE);
+	return page_size;
+}
+#endif
+
+void perf_event_init(Task *task)
+{
+	// Clear
+	task->perf_event_fd = -1;
+	task->perf_event_mmap = NULL;
+	task->perf_event_last_head = 0;
+
+#ifdef TRACING
+	// Enabled?
+	if (0 == RtsFlags.PerfEventFlags.sampleType) {
+		return;
+	}
+
+	// Initialize perf_event attributes
+	struct perf_event_attr attr;
+	memset(&attr, 0, sizeof(attr));
+	attr.type = PERF_TYPE_HARDWARE;
+	switch (RtsFlags.PerfEventFlags.sampleType) {
+	case PERF_EVENT_SAMPLE_BY_CYCLE:
+	default:
+		attr.config = PERF_COUNT_HW_CPU_CYCLES;
+		attr.sample_period = 1000000;
+		task->perf_event_sample_type = SAMPLE_BY_CYCLE;
+		break;
+	case PERF_EVENT_SAMPLE_BY_CACHE:
+		attr.config = PERF_COUNT_HW_CACHE_REFERENCES;
+		attr.sample_period = 10000;
+		task->perf_event_sample_type = SAMPLE_BY_CACHE;
+		break;
+	case PERF_EVENT_SAMPLE_BY_CACHE_MISS:
+		attr.config = PERF_COUNT_HW_CACHE_MISSES;
+		attr.sample_period = 1000;
+		task->perf_event_sample_type = SAMPLE_BY_CACHE_MISS;
+		break;
+	case PERF_EVENT_SAMPLE_BY_BRANCH:
+		attr.config = PERF_COUNT_HW_BRANCH_INSTRUCTIONS;
+		attr.sample_period = 1000000;
+		task->perf_event_sample_type = SAMPLE_BY_BRANCH;
+		break;
+	case PERF_EVENT_SAMPLE_BY_BRANCH_MISS:
+		attr.config = PERF_COUNT_HW_BRANCH_MISSES;
+		attr.sample_period = 10000;
+		task->perf_event_sample_type = SAMPLE_BY_BRANCH_MISS;
+		break;
+	case PERF_EVENT_SAMPLE_BY_STALLED_FE:
+		attr.config = PERF_COUNT_HW_STALLED_CYCLES_FRONTEND;
+		attr.sample_period = 100000;
+		task->perf_event_sample_type = SAMPLE_BY_STALLED_FE;
+		break;
+	case PERF_EVENT_SAMPLE_BY_STALLED_BE:
+		attr.config = PERF_COUNT_HW_STALLED_CYCLES_BACKEND;
+		attr.sample_period = 100000;
+		task->perf_event_sample_type = SAMPLE_BY_STALLED_BE;
+		break;
+	}
+	if (RtsFlags.PerfEventFlags.samplePeriod > 0) {
+		attr.sample_period = RtsFlags.PerfEventFlags.samplePeriod;
+	}
+
+	attr.sample_type = PERF_SAMPLE_IP | PERF_SAMPLE_TID;
+	attr.exclude_kernel = 1;
+
+	// Start enabled - not strictly right, as we aren't in the mutator
+	// here, but we will only get a perf_event_start_mutator_count()
+	// call on the next garbage collection. FIXME: improve
+	//attr.disabled = 1;
+
+	// Allocate counter
+	task->perf_event_fd = sys_perf_event_open(&attr, 0, -1, -1, 0);
+	if (task->perf_event_fd < 0) {
+		sysErrorBelch("Could not open perf_event");
+		return;
+	}
+
+	// Test
+	StgWord64 val;
+	if (read(task->perf_event_fd, &val, sizeof(val)) <= 0) {
+		sysErrorBelch("Could not read from perf_event");
+		close(task->perf_event_fd);
+		task->perf_event_fd = -1;
+		return;
+	}
+
+	// Associate a memory map
+	size_t mmap_length = get_page_size() * (PERF_EVENT_MMAP_PAGES + 1);
+	task->perf_event_mmap =
+		mmap(NULL, mmap_length, PROT_READ | PROT_WRITE, MAP_SHARED, task->perf_event_fd, 0);
+	if (task->perf_event_mmap == MAP_FAILED) {
+		sysErrorBelch("Could not allocate memory-map for perf_event");
+		return;
+	}
+
+	// Start following the stream
+	task->perf_event_last_head = task->perf_event_data->data_head;
+	task->perf_event_data->data_tail = task->perf_event_last_head;
+#endif
+
+}
+
+#ifdef TRACING
+void perf_event_stream(Task *task, StgBool own_task) {
+	if (!task->cap) return;
+
+	// Read new head pointer
+	StgWord64 last_head = task->perf_event_last_head;
+	StgWord64 new_head = task->perf_event_data->data_head;
+	if (last_head >= new_head) return;
+
+	// Write barrier
+	rmb();
+
+	// Buffer data
+	StgWord64 buf_size = get_page_size() * PERF_EVENT_MMAP_PAGES;
+	StgWord64 buf_mask = buf_size - 1; // Assuming page size is a power of 2, obviously.
+	StgWord8 *data_base = ((StgWord8 *)task->perf_event_mmap) + get_page_size();
+	StgWord8 *data = data_base + (last_head & buf_mask);
+	StgBool free_data = 0;
+
+	// Wrap around? Play it safe: Assemble into a new buffer
+	if ((last_head & ~buf_mask) != (new_head & ~buf_mask)) {
+
+		StgWord64 bytes_before_wrap = buf_size - (last_head & buf_mask);
+		StgWord64 bytes_after_wrap  = new_head & buf_mask;
+
+		StgWord8 *new_data = stgMallocBytes(new_head - last_head, "perf_event_stream wrap buffer");
+		memcpy(new_data, data, bytes_before_wrap);
+		memcpy(new_data + bytes_before_wrap, data_base, bytes_after_wrap);
+		data = new_data;
+		free_data = 1;
+	}
+
+	// Count number of samples
+	StgWord32 n_samples = 0;
+	StgWord8 *pos = data;
+	StgWord32 hdr_size = sizeof(struct perf_event_header);
+	while (pos + hdr_size <= data + (new_head - last_head)) {
+		struct perf_event_header *hdr = (struct perf_event_header *) pos;
+		if (pos + hdr->size > data + (new_head - last_head)) {
+			break;
+		}
+		if (hdr->type == PERF_RECORD_SAMPLE) {
+			n_samples++;
+		}
+		pos += hdr->size;
+	}
+	StgWord8 *end_pos = pos;
+
+	// Read samples
+	pos = data;
+	void **ips = (void **) stgMallocBytes(sizeof(void *) * n_samples, "perf_event_stream samples");
+	StgWord32 i = 0;
+	while (pos != end_pos) {
+		struct perf_event_header *hdr = (struct perf_event_header *) pos;
+		if (hdr->type == PERF_RECORD_SAMPLE) {
+			ips[i++] = (void *) *((StgWord64 *) (pos + hdr_size));
+		}
+		pos += hdr->size;
+	}
+
+	// Output samples
+	traceSamples(task->cap, own_task, task->perf_event_sample_type, SAMPLE_INSTR_PTR, n_samples, ips, NULL);
+	stgFree(ips);
+
+	// Our final head (for incomplete data we might not have read everyhing!)
+	// Note corrupt data might cause us to get stuck here...
+	StgWord64 final_head = last_head + (end_pos - data);
+
+	// Free buffer
+	if (free_data)
+		stgFree(data);
+
+	// Advance head pointer
+	task->perf_event_last_head = final_head;
+	task->perf_event_data->data_tail = final_head;
+}
+
+#endif // TRACING
+
+void perf_event_start_mutator_count(void)
+{
+	Task *task = myTask();
+	if(!task || task->perf_event_fd == -1) return;
+	ioctl(task->perf_event_fd, PERF_EVENT_IOC_ENABLE);
+}
+
+void perf_event_stop_mutator_count(void)
+{
+	Task *task = myTask();
+	if(!task || task->perf_event_fd == -1) return;
+	ioctl(task->perf_event_fd, PERF_EVENT_IOC_DISABLE);
+#ifdef TRACING
+	perf_event_stream(task, 1);
+#endif
+}
+
+void
+perf_event_timer(void)
+{
+
+#ifdef TRACING
+	Task *task = all_tasks;
+
+	// This is slightly unsafe. One of the tasks in question might get
+	// an overflow, and then we have duplicated instruction
+	// pointer samples.
+	for (task = all_tasks; task; task = task->next) {
+		perf_event_stream(task, 0);
+	}
+#endif
+
+}
+
+#endif // USE_PERF_EVENT
diff --git a/rts/PerfEvent.h b/rts/PerfEvent.h
new file mode 100644
index 000000000000..edb8332369e7
--- /dev/null
+++ b/rts/PerfEvent.h
@@ -0,0 +1,18 @@
+
+#ifndef PERF_EVENT_H
+#define PERF_EVENT_H
+
+#include "BeginPrivate.h"
+
+#include "Task.h"
+
+void perf_event_init(Task *task);
+
+void perf_event_start_mutator_count(void);
+void perf_event_stop_mutator_count(void);
+
+void perf_event_timer(void);
+
+#include "EndPrivate.h"
+
+#endif // PERF_EVENT_H
diff --git a/rts/PosixSource.h b/rts/PosixSource.h
index da7b69e85d79..7803dd237241 100644
--- a/rts/PosixSource.h
+++ b/rts/PosixSource.h
@@ -20,7 +20,7 @@
 #define _XOPEN_SOURCE   500
 // FreeBSD takes a different approach to _ISOC99_SOURCE: on FreeBSD it
 // means "I want *just* C99 things", whereas on GNU libc and Solaris
-// it means "I also want C99 things".  
+// it means "I also want C99 things".
 //
 // On both GNU libc and FreeBSD, _ISOC99_SOURCE is implied by
 // _XOPEN_SOURCE==600, but on Solaris it is an error to omit it.
@@ -40,3 +40,11 @@
 #endif
 
 #endif /* POSIXSOURCE_H */
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/Prelude.h b/rts/Prelude.h
index 89e80a0a3d96..adbb5535bf16 100644
--- a/rts/Prelude.h
+++ b/rts/Prelude.h
@@ -42,6 +42,7 @@ PRELUDE_CLOSURE(base_GHCziIOziException_blockedIndefinitelyOnMVar_closure);
 PRELUDE_CLOSURE(base_GHCziIOziException_blockedIndefinitelyOnSTM_closure);
 PRELUDE_CLOSURE(base_ControlziExceptionziBase_nonTermination_closure);
 PRELUDE_CLOSURE(base_ControlziExceptionziBase_nestedAtomically_closure);
+PRELUDE_CLOSURE(base_GHCziEventziThread_blockedOnBadFD_closure);
 
 PRELUDE_CLOSURE(base_GHCziConcziSync_runSparks_closure);
 PRELUDE_CLOSURE(base_GHCziConcziIO_ensureIOManagerIsRunning_closure);
@@ -104,6 +105,7 @@ PRELUDE_INFO(base_GHCziStable_StablePtr_con_info);
 #define blockedIndefinitelyOnSTM_closure DLL_IMPORT_DATA_REF(base_GHCziIOziException_blockedIndefinitelyOnSTM_closure)
 #define nonTermination_closure    DLL_IMPORT_DATA_REF(base_ControlziExceptionziBase_nonTermination_closure)
 #define nestedAtomically_closure  DLL_IMPORT_DATA_REF(base_ControlziExceptionziBase_nestedAtomically_closure)
+#define blockedOnBadFD_closure    DLL_IMPORT_DATA_REF(base_GHCziEventziThread_blockedOnBadFD_closure)
 
 #define Czh_static_info           DLL_IMPORT_DATA_REF(ghczmprim_GHCziTypes_Czh_static_info)
 #define Fzh_static_info           DLL_IMPORT_DATA_REF(ghczmprim_GHCziTypes_Fzh_static_info)
@@ -142,3 +144,11 @@ PRELUDE_INFO(base_GHCziStable_StablePtr_con_info);
 #define StablePtr_con_info        DLL_IMPORT_DATA_REF(base_GHCziStable_StablePtr_con_info)
 
 #endif /* PRELUDE_H */
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/PrimOps.cmm b/rts/PrimOps.cmm
index db65a4a2687e..ee50f7fed52e 100644
--- a/rts/PrimOps.cmm
+++ b/rts/PrimOps.cmm
@@ -137,29 +137,69 @@ stg_newAlignedPinnedByteArrayzh ( W_ n, W_ alignment )
     return (p);
 }
 
-// RRN: This one does not use the "ticketing" approach because it
-// deals in unboxed scalars, not heap pointers.
-stg_casIntArrayzh( gcptr arr, W_ ind, W_ old, W_ new )
-/* MutableByteArray# s -> Int# -> Int# -> Int# -> State# s -> (# State# s, Int# #) */
+// shrink size of MutableByteArray in-place
+stg_shrinkMutableByteArrayzh ( gcptr mba, W_ new_size )
+// MutableByteArray# s -> Int# -> State# s -> State# s
 {
-    gcptr p;
-    W_ h;
+   ASSERT(new_size >= 0);
+   ASSERT(new_size <= StgArrWords_bytes(mba));
 
-    p = arr + SIZEOF_StgArrWords + WDS(ind);
-    (h) = ccall cas(p, old, new);
+   OVERWRITING_CLOSURE_OFS(mba, (BYTES_TO_WDS(SIZEOF_StgArrWords) +
+                                 ROUNDUP_BYTES_TO_WDS(new_size)));
+   StgArrWords_bytes(mba) = new_size;
+   LDV_RECORD_CREATE(mba);
 
-    return(h);
+   return ();
 }
 
+// resize MutableByteArray
+//
+// The returned MutableByteArray is either the original
+// MutableByteArray resized in-place or, if not possible, a newly
+// allocated (unpinned) MutableByteArray (with the original content
+// copied over)
+stg_resizzeMutableByteArrayzh ( gcptr mba, W_ new_size )
+// MutableByteArray# s -> Int# -> State# s -> (# State# s,MutableByteArray# s #)
+{
+   W_ new_size_wds;
+
+   ASSERT(new_size >= 0);
+
+   new_size_wds = ROUNDUP_BYTES_TO_WDS(new_size);
+
+   if (new_size_wds <= BYTE_ARR_WDS(mba)) {
+      OVERWRITING_CLOSURE_OFS(mba, (BYTES_TO_WDS(SIZEOF_StgArrWords) +
+                                    new_size_wds));
+      StgArrWords_bytes(mba) = new_size;
+      LDV_RECORD_CREATE(mba);
 
-stg_fetchAddIntArrayzh( gcptr arr, W_ ind, W_ incr )
-/* MutableByteArray# s -> Int# -> Int# -> State# s -> (# State# s, Int# #) */
+      return (mba);
+   } else {
+      (P_ new_mba) = call stg_newByteArrayzh(new_size);
+
+      // maybe at some point in the future we may be able to grow the
+      // MBA in-place w/o copying if we know the space after the
+      // current MBA is still available, as often we want to grow the
+      // MBA shortly after we allocated the original MBA. So maybe no
+      // further allocations have occurred by then.
+
+      // copy over old content
+      prim %memcpy(BYTE_ARR_CTS(new_mba), BYTE_ARR_CTS(mba),
+                   StgArrWords_bytes(mba), WDS(1));
+
+      return (new_mba);
+   }
+}
+
+// RRN: This one does not use the "ticketing" approach because it
+// deals in unboxed scalars, not heap pointers.
+stg_casIntArrayzh( gcptr arr, W_ ind, W_ old, W_ new )
+/* MutableByteArray# s -> Int# -> Int# -> Int# -> State# s -> (# State# s, Int# #) */
 {
-    gcptr p;
-    W_ h;
+    W_ p, h;
 
     p = arr + SIZEOF_StgArrWords + WDS(ind);
-    (h) = ccall atomic_inc(p, incr);
+    (h) = ccall cas(p, old, new);
 
     return(h);
 }
@@ -167,8 +207,8 @@ stg_fetchAddIntArrayzh( gcptr arr, W_ ind, W_ incr )
 
 stg_newArrayzh ( W_ n /* words */, gcptr init )
 {
-    W_ words, size;
-    gcptr p, arr;
+    W_ words, size, p;
+    gcptr arr;
 
     again: MAYBE_GC(again);
 
@@ -178,7 +218,7 @@ stg_newArrayzh ( W_ n /* words */, gcptr init )
     size = n + mutArrPtrsCardWords(n);
     words = BYTES_TO_WDS(SIZEOF_StgMutArrPtrs) + size;
     ("ptr" arr) = ccall allocate(MyCapability() "ptr",words);
-    TICK_ALLOC_PRIM(SIZEOF_StgMutArrPtrs, WDS(n), 0);
+    TICK_ALLOC_PRIM(SIZEOF_StgMutArrPtrs, WDS(size), 0);
 
     SET_HDR(arr, stg_MUT_ARR_PTRS_DIRTY_info, CCCS);
     StgMutArrPtrs_ptrs(arr) = n;
@@ -187,59 +227,93 @@ stg_newArrayzh ( W_ n /* words */, gcptr init )
     // Initialise all elements of the the array with the value in R2
     p = arr + SIZEOF_StgMutArrPtrs;
   for:
-    if (p < arr + WDS(words)) {
+    if (p < arr + SIZEOF_StgMutArrPtrs + WDS(n)) {
         W_[p] = init;
         p = p + WDS(1);
         goto for;
     }
-    // Initialise the mark bits with 0
-  for2:
-    if (p < arr + WDS(size)) {
-        W_[p] = 0;
-        p = p + WDS(1);
-        goto for2;
-    }
 
     return (arr);
 }
 
 stg_unsafeThawArrayzh ( gcptr arr )
 {
-  // SUBTLETY TO DO WITH THE OLD GEN MUTABLE LIST
-  //
-  // A MUT_ARR_PTRS lives on the mutable list, but a MUT_ARR_PTRS_FROZEN
-  // normally doesn't.  However, when we freeze a MUT_ARR_PTRS, we leave
-  // it on the mutable list for the GC to remove (removing something from
-  // the mutable list is not easy).
-  //
-  // So that we can tell whether a MUT_ARR_PTRS_FROZEN is on the mutable list,
-  // when we freeze it we set the info ptr to be MUT_ARR_PTRS_FROZEN0
-  // to indicate that it is still on the mutable list.
-  //
-  // So, when we thaw a MUT_ARR_PTRS_FROZEN, we must cope with two cases:
-  // either it is on a mut_list, or it isn't.  We adopt the convention that
-  // the closure type is MUT_ARR_PTRS_FROZEN0 if it is on the mutable list,
-  // and MUT_ARR_PTRS_FROZEN otherwise.  In fact it wouldn't matter if
-  // we put it on the mutable list more than once, but it would get scavenged
-  // multiple times during GC, which would be unnecessarily slow.
-  //
-  if (StgHeader_info(arr) != stg_MUT_ARR_PTRS_FROZEN0_info) {
+    // SUBTLETY TO DO WITH THE OLD GEN MUTABLE LIST
+    //
+    // A MUT_ARR_PTRS lives on the mutable list, but a MUT_ARR_PTRS_FROZEN
+    // normally doesn't.  However, when we freeze a MUT_ARR_PTRS, we leave
+    // it on the mutable list for the GC to remove (removing something from
+    // the mutable list is not easy).
+    //
+    // So that we can tell whether a MUT_ARR_PTRS_FROZEN is on the mutable list,
+    // when we freeze it we set the info ptr to be MUT_ARR_PTRS_FROZEN0
+    // to indicate that it is still on the mutable list.
+    //
+    // So, when we thaw a MUT_ARR_PTRS_FROZEN, we must cope with two cases:
+    // either it is on a mut_list, or it isn't.  We adopt the convention that
+    // the closure type is MUT_ARR_PTRS_FROZEN0 if it is on the mutable list,
+    // and MUT_ARR_PTRS_FROZEN otherwise.  In fact it wouldn't matter if
+    // we put it on the mutable list more than once, but it would get scavenged
+    // multiple times during GC, which would be unnecessarily slow.
+    //
+    if (StgHeader_info(arr) != stg_MUT_ARR_PTRS_FROZEN0_info) {
         SET_INFO(arr,stg_MUT_ARR_PTRS_DIRTY_info);
         recordMutable(arr);
         // must be done after SET_INFO, because it ASSERTs closure_MUTABLE()
         return (arr);
-  } else {
+    } else {
         SET_INFO(arr,stg_MUT_ARR_PTRS_DIRTY_info);
         return (arr);
-  }
+    }
+}
+
+stg_copyArrayzh ( gcptr src, W_ src_off, gcptr dst, W_ dst_off, W_ n )
+{
+    copyArray(src, src_off, dst, dst_off, n)
+}
+
+stg_copyMutableArrayzh ( gcptr src, W_ src_off, gcptr dst, W_ dst_off, W_ n )
+{
+    copyMutableArray(src, src_off, dst, dst_off, n)
+}
+
+stg_copyArrayArrayzh ( gcptr src, W_ src_off, gcptr dst, W_ dst_off, W_ n )
+{
+    copyArray(src, src_off, dst, dst_off, n)
+}
+
+stg_copyMutableArrayArrayzh ( gcptr src, W_ src_off, gcptr dst, W_ dst_off, W_ n )
+{
+    copyMutableArray(src, src_off, dst, dst_off, n)
+}
+
+stg_cloneArrayzh ( gcptr src, W_ offset, W_ n )
+{
+    cloneArray(stg_MUT_ARR_PTRS_FROZEN_info, src, offset, n)
+}
+
+stg_cloneMutableArrayzh ( gcptr src, W_ offset, W_ n )
+{
+    cloneArray(stg_MUT_ARR_PTRS_DIRTY_info, src, offset, n)
+}
+
+// We have to escape the "z" in the name.
+stg_freezzeArrayzh ( gcptr src, W_ offset, W_ n )
+{
+    cloneArray(stg_MUT_ARR_PTRS_FROZEN_info, src, offset, n)
+}
+
+stg_thawArrayzh ( gcptr src, W_ offset, W_ n )
+{
+    cloneArray(stg_MUT_ARR_PTRS_DIRTY_info, src, offset, n)
 }
 
 // RRN: Uses the ticketed approach; see casMutVar
 stg_casArrayzh ( gcptr arr, W_ ind, gcptr old, gcptr new )
 /* MutableArray# s a -> Int# -> a -> a -> State# s -> (# State# s, Int#, Any a #) */
 {
-    gcptr p, h;
-    W_ len;
+    gcptr h;
+    W_ p, len;
 
     p = arr + SIZEOF_StgMutArrPtrs + WDS(ind);
     (h) = ccall cas(p, old, new);
@@ -259,8 +333,8 @@ stg_casArrayzh ( gcptr arr, W_ ind, gcptr old, gcptr new )
 
 stg_newArrayArrayzh ( W_ n /* words */ )
 {
-    W_ words, size;
-    gcptr p, arr;
+    W_ words, size, p;
+    gcptr arr;
 
     MAYBE_GC_N(stg_newArrayArrayzh, n);
 
@@ -270,7 +344,7 @@ stg_newArrayArrayzh ( W_ n /* words */ )
     size = n + mutArrPtrsCardWords(n);
     words = BYTES_TO_WDS(SIZEOF_StgMutArrPtrs) + size;
     ("ptr" arr) = ccall allocate(MyCapability() "ptr",words);
-    TICK_ALLOC_PRIM(SIZEOF_StgMutArrPtrs, WDS(n), 0);
+    TICK_ALLOC_PRIM(SIZEOF_StgMutArrPtrs, WDS(size), 0);
 
     SET_HDR(arr, stg_MUT_ARR_PTRS_DIRTY_info, W_[CCCS]);
     StgMutArrPtrs_ptrs(arr) = n;
@@ -279,22 +353,133 @@ stg_newArrayArrayzh ( W_ n /* words */ )
     // Initialise all elements of the array with a pointer to the new array
     p = arr + SIZEOF_StgMutArrPtrs;
   for:
-    if (p < arr + WDS(words)) {
+    if (p < arr + SIZEOF_StgMutArrPtrs + WDS(n)) {
         W_[p] = arr;
         p = p + WDS(1);
         goto for;
     }
-    // Initialise the mark bits with 0
-  for2:
-    if (p < arr + WDS(size)) {
-        W_[p] = 0;
+
+    return (arr);
+}
+
+
+/* -----------------------------------------------------------------------------
+   SmallArray primitives
+   -------------------------------------------------------------------------- */
+
+stg_newSmallArrayzh ( W_ n /* words */, gcptr init )
+{
+    W_ words, size, p;
+    gcptr arr;
+
+    again: MAYBE_GC(again);
+
+    words = BYTES_TO_WDS(SIZEOF_StgSmallMutArrPtrs) + n;
+    ("ptr" arr) = ccall allocate(MyCapability() "ptr",words);
+    TICK_ALLOC_PRIM(SIZEOF_StgSmallMutArrPtrs, WDS(n), 0);
+
+    SET_HDR(arr, stg_SMALL_MUT_ARR_PTRS_DIRTY_info, CCCS);
+    StgSmallMutArrPtrs_ptrs(arr) = n;
+
+    // Initialise all elements of the the array with the value in R2
+    p = arr + SIZEOF_StgSmallMutArrPtrs;
+  for:
+    if (p < arr + SIZEOF_StgSmallMutArrPtrs + WDS(n)) {
+        W_[p] = init;
         p = p + WDS(1);
-        goto for2;
+        goto for;
     }
 
     return (arr);
 }
 
+stg_unsafeThawSmallArrayzh ( gcptr arr )
+{
+    // See stg_unsafeThawArrayzh
+    if (StgHeader_info(arr) != stg_SMALL_MUT_ARR_PTRS_FROZEN0_info) {
+        SET_INFO(arr, stg_SMALL_MUT_ARR_PTRS_DIRTY_info);
+        recordMutable(arr);
+        // must be done after SET_INFO, because it ASSERTs closure_MUTABLE()
+        return (arr);
+    } else {
+        SET_INFO(arr, stg_SMALL_MUT_ARR_PTRS_DIRTY_info);
+        return (arr);
+    }
+}
+
+stg_cloneSmallArrayzh ( gcptr src, W_ offset, W_ n )
+{
+    cloneSmallArray(stg_SMALL_MUT_ARR_PTRS_FROZEN_info, src, offset, n)
+}
+
+stg_cloneSmallMutableArrayzh ( gcptr src, W_ offset, W_ n )
+{
+    cloneSmallArray(stg_SMALL_MUT_ARR_PTRS_DIRTY_info, src, offset, n)
+}
+
+// We have to escape the "z" in the name.
+stg_freezzeSmallArrayzh ( gcptr src, W_ offset, W_ n )
+{
+    cloneSmallArray(stg_SMALL_MUT_ARR_PTRS_FROZEN_info, src, offset, n)
+}
+
+stg_thawSmallArrayzh ( gcptr src, W_ offset, W_ n )
+{
+    cloneSmallArray(stg_SMALL_MUT_ARR_PTRS_DIRTY_info, src, offset, n)
+}
+
+stg_copySmallArrayzh ( gcptr src, W_ src_off, gcptr dst, W_ dst_off, W_ n)
+{
+    W_ dst_p, src_p, bytes;
+
+    SET_INFO(dst, stg_SMALL_MUT_ARR_PTRS_DIRTY_info);
+
+    dst_p = dst + SIZEOF_StgSmallMutArrPtrs + WDS(dst_off);
+    src_p = src + SIZEOF_StgSmallMutArrPtrs + WDS(src_off);
+    bytes = WDS(n);
+    prim %memcpy(dst_p, src_p, bytes, WDS(1));
+
+    return ();
+}
+
+stg_copySmallMutableArrayzh ( gcptr src, W_ src_off, gcptr dst, W_ dst_off, W_ n)
+{
+    W_ dst_p, src_p, bytes;
+
+    SET_INFO(dst, stg_SMALL_MUT_ARR_PTRS_DIRTY_info);
+
+    dst_p = dst + SIZEOF_StgSmallMutArrPtrs + WDS(dst_off);
+    src_p = src + SIZEOF_StgSmallMutArrPtrs + WDS(src_off);
+    bytes = WDS(n);
+    if (src == dst) {
+        prim %memmove(dst_p, src_p, bytes, WDS(1));
+    } else {
+        prim %memcpy(dst_p, src_p, bytes, WDS(1));
+    }
+
+    return ();
+}
+
+// RRN: Uses the ticketed approach; see casMutVar
+stg_casSmallArrayzh ( gcptr arr, W_ ind, gcptr old, gcptr new )
+/* SmallMutableArray# s a -> Int# -> a -> a -> State# s -> (# State# s, Int#, Any a #) */
+{
+    gcptr h;
+    W_ p, len;
+
+    p = arr + SIZEOF_StgSmallMutArrPtrs + WDS(ind);
+    (h) = ccall cas(p, old, new);
+
+    if (h != old) {
+        // Failure, return what was there instead of 'old':
+        return (1,h);
+    } else {
+        // Compare and Swap Succeeded:
+        SET_HDR(arr, stg_SMALL_MUT_ARR_PTRS_DIRTY_info, CCCS);
+        return (0,new);
+    }
+}
+
 
 /* -----------------------------------------------------------------------------
    MutVar primitives
@@ -323,13 +508,12 @@ stg_casMutVarzh ( gcptr mv, gcptr old, gcptr new )
 {
     gcptr h;
 
-    (h) = ccall cas(mv + SIZEOF_StgHeader + OFFSET_StgMutVar_var,
-                          old, new);
+    (h) = ccall cas(mv + SIZEOF_StgHeader + OFFSET_StgMutVar_var, old, new);
     if (h != old) {
         return (1,h);
     } else {
         if (GET_INFO(mv) == stg_MUT_VAR_CLEAN_info) {
-           ccall dirty_MUT_VAR(BaseReg "ptr", mv "ptr");
+            ccall dirty_MUT_VAR(BaseReg "ptr", mv "ptr");
         }
         return (0,new);
     }
@@ -373,44 +557,44 @@ stg_atomicModifyMutVarzh ( gcptr mv, gcptr f )
 
 #define SIZE (THUNK_2_SIZE + THUNK_1_SIZE + THUNK_1_SIZE)
 
-   HP_CHK_GEN_TICKY(SIZE);
-
-   TICK_ALLOC_THUNK_2();
-   CCCS_ALLOC(THUNK_2_SIZE);
-   z = Hp - THUNK_2_SIZE + WDS(1);
-   SET_HDR(z, stg_ap_2_upd_info, CCCS);
-   LDV_RECORD_CREATE(z);
-   StgThunk_payload(z,0) = f;
-
-   TICK_ALLOC_THUNK_1();
-   CCCS_ALLOC(THUNK_1_SIZE);
-   y = z - THUNK_1_SIZE;
-   SET_HDR(y, stg_sel_0_upd_info, CCCS);
-   LDV_RECORD_CREATE(y);
-   StgThunk_payload(y,0) = z;
-
-   TICK_ALLOC_THUNK_1();
-   CCCS_ALLOC(THUNK_1_SIZE);
-   r = y - THUNK_1_SIZE;
-   SET_HDR(r, stg_sel_1_upd_info, CCCS);
-   LDV_RECORD_CREATE(r);
-   StgThunk_payload(r,0) = z;
-
- retry:
-   x = StgMutVar_var(mv);
-   StgThunk_payload(z,1) = x;
+    HP_CHK_GEN_TICKY(SIZE);
+
+    TICK_ALLOC_THUNK_2();
+    CCCS_ALLOC(THUNK_2_SIZE);
+    z = Hp - THUNK_2_SIZE + WDS(1);
+    SET_HDR(z, stg_ap_2_upd_info, CCCS);
+    LDV_RECORD_CREATE(z);
+    StgThunk_payload(z,0) = f;
+
+    TICK_ALLOC_THUNK_1();
+    CCCS_ALLOC(THUNK_1_SIZE);
+    y = z - THUNK_1_SIZE;
+    SET_HDR(y, stg_sel_0_upd_info, CCCS);
+    LDV_RECORD_CREATE(y);
+    StgThunk_payload(y,0) = z;
+
+    TICK_ALLOC_THUNK_1();
+    CCCS_ALLOC(THUNK_1_SIZE);
+    r = y - THUNK_1_SIZE;
+    SET_HDR(r, stg_sel_1_upd_info, CCCS);
+    LDV_RECORD_CREATE(r);
+    StgThunk_payload(r,0) = z;
+
+  retry:
+    x = StgMutVar_var(mv);
+    StgThunk_payload(z,1) = x;
 #ifdef THREADED_RTS
-   (h) = ccall cas(mv + SIZEOF_StgHeader + OFFSET_StgMutVar_var, x, y);
-   if (h != x) { goto retry; }
+    (h) = ccall cas(mv + SIZEOF_StgHeader + OFFSET_StgMutVar_var, x, y);
+    if (h != x) { goto retry; }
 #else
-   StgMutVar_var(mv) = y;
+    StgMutVar_var(mv) = y;
 #endif
 
-   if (GET_INFO(mv) == stg_MUT_VAR_CLEAN_info) {
-     ccall dirty_MUT_VAR(BaseReg "ptr", mv "ptr");
-   }
+    if (GET_INFO(mv) == stg_MUT_VAR_CLEAN_info) {
+        ccall dirty_MUT_VAR(BaseReg "ptr", mv "ptr");
+    }
 
-   return (r);
+    return (r);
 }
 
 /* -----------------------------------------------------------------------------
@@ -423,31 +607,32 @@ stg_mkWeakzh ( gcptr key,
                gcptr value,
                gcptr finalizer /* or stg_NO_FINALIZER_closure */ )
 {
-  gcptr w;
+    gcptr w;
 
-  ALLOC_PRIM (SIZEOF_StgWeak)
+    ALLOC_PRIM (SIZEOF_StgWeak)
 
-  w = Hp - SIZEOF_StgWeak + WDS(1);
-  SET_HDR(w, stg_WEAK_info, CCCS);
+    w = Hp - SIZEOF_StgWeak + WDS(1);
+    SET_HDR(w, stg_WEAK_info, CCCS);
 
-  StgWeak_key(w)         = key;
-  StgWeak_value(w)       = value;
-  StgWeak_finalizer(w)   = finalizer;
-  StgWeak_cfinalizers(w) = stg_NO_FINALIZER_closure;
+    StgWeak_key(w)         = key;
+    StgWeak_value(w)       = value;
+    StgWeak_finalizer(w)   = finalizer;
+    StgWeak_cfinalizers(w) = stg_NO_FINALIZER_closure;
 
-  ACQUIRE_LOCK(sm_mutex);
-  StgWeak_link(w) = generation_weak_ptr_list(W_[g0]);
-  generation_weak_ptr_list(W_[g0]) = w;
-  RELEASE_LOCK(sm_mutex);
+    StgWeak_link(w) = Capability_weak_ptr_list_hd(MyCapability());
+    Capability_weak_ptr_list_hd(MyCapability()) = w;
+    if (Capability_weak_ptr_list_tl(MyCapability()) == NULL) {
+        Capability_weak_ptr_list_tl(MyCapability()) = w;
+    }
 
-  IF_DEBUG(weak, ccall debugBelch(stg_weak_msg,w));
+    IF_DEBUG(weak, ccall debugBelch(stg_weak_msg,w));
 
-  return (w);
+    return (w);
 }
 
 stg_mkWeakNoFinalizzerzh ( gcptr key, gcptr value )
 {
-  jump stg_mkWeakzh (key, value, stg_NO_FINALIZER_closure);
+    jump stg_mkWeakzh (key, value, stg_NO_FINALIZER_closure);
 }
 
 STRING(stg_cfinalizer_msg,"Adding a finalizer to %p\n")
@@ -458,110 +643,110 @@ stg_addCFinalizzerToWeakzh ( W_ fptr,   // finalizer
                              W_ eptr,
                              gcptr w )
 {
-  W_ c, info;
+    W_ c, info;
 
-  ALLOC_PRIM (SIZEOF_StgCFinalizerList)
+    ALLOC_PRIM (SIZEOF_StgCFinalizerList)
 
-  c = Hp - SIZEOF_StgCFinalizerList + WDS(1);
-  SET_HDR(c, stg_C_FINALIZER_LIST_info, CCCS);
+    c = Hp - SIZEOF_StgCFinalizerList + WDS(1);
+    SET_HDR(c, stg_C_FINALIZER_LIST_info, CCCS);
 
-  StgCFinalizerList_fptr(c) = fptr;
-  StgCFinalizerList_ptr(c) = ptr;
-  StgCFinalizerList_eptr(c) = eptr;
-  StgCFinalizerList_flag(c) = flag;
+    StgCFinalizerList_fptr(c) = fptr;
+    StgCFinalizerList_ptr(c) = ptr;
+    StgCFinalizerList_eptr(c) = eptr;
+    StgCFinalizerList_flag(c) = flag;
 
-  LOCK_CLOSURE(w, info);
+    LOCK_CLOSURE(w, info);
 
-  if (info == stg_DEAD_WEAK_info) {
-    // Already dead.
-    unlockClosure(w, info);
-    return (0);
-  }
+    if (info == stg_DEAD_WEAK_info) {
+        // Already dead.
+        unlockClosure(w, info);
+        return (0);
+    }
 
-  StgCFinalizerList_link(c) = StgWeak_cfinalizers(w);
-  StgWeak_cfinalizers(w) = c;
+    StgCFinalizerList_link(c) = StgWeak_cfinalizers(w);
+    StgWeak_cfinalizers(w) = c;
 
-  unlockClosure(w, info);
+    unlockClosure(w, info);
 
-  recordMutable(w);
+    recordMutable(w);
 
-  IF_DEBUG(weak, ccall debugBelch(stg_cfinalizer_msg,w));
+    IF_DEBUG(weak, ccall debugBelch(stg_cfinalizer_msg,w));
 
-  return (1);
+    return (1);
 }
 
 stg_finalizzeWeakzh ( gcptr w )
 {
-  gcptr f, list;
-  W_ info;
+    gcptr f, list;
+    W_ info;
 
-  LOCK_CLOSURE(w, info);
+    LOCK_CLOSURE(w, info);
 
-  // already dead?
-  if (info == stg_DEAD_WEAK_info) {
-      unlockClosure(w, info);
-      return (0,stg_NO_FINALIZER_closure);
-  }
+    // already dead?
+    if (info == stg_DEAD_WEAK_info) {
+        unlockClosure(w, info);
+        return (0,stg_NO_FINALIZER_closure);
+    }
 
-  f    = StgWeak_finalizer(w);
-  list = StgWeak_cfinalizers(w);
+    f    = StgWeak_finalizer(w);
+    list = StgWeak_cfinalizers(w);
 
-  // kill it
+    // kill it
 #ifdef PROFILING
-  // @LDV profiling
-  // A weak pointer is inherently used, so we do not need to call
-  // LDV_recordDead_FILL_SLOP_DYNAMIC():
-  //    LDV_recordDead_FILL_SLOP_DYNAMIC((StgClosure *)w);
-  // or, LDV_recordDead():
-  //    LDV_recordDead((StgClosure *)w, sizeofW(StgWeak) - sizeofW(StgProfHeader));
-  // Furthermore, when PROFILING is turned on, dead weak pointers are exactly as
-  // large as weak pointers, so there is no need to fill the slop, either.
-  // See stg_DEAD_WEAK_info in StgMiscClosures.hc.
+    // @LDV profiling
+    // A weak pointer is inherently used, so we do not need to call
+    // LDV_recordDead_FILL_SLOP_DYNAMIC():
+    //    LDV_recordDead_FILL_SLOP_DYNAMIC((StgClosure *)w);
+    // or, LDV_recordDead():
+    //    LDV_recordDead((StgClosure *)w, sizeofW(StgWeak) - sizeofW(StgProfHeader));
+    // Furthermore, when PROFILING is turned on, dead weak pointers are exactly as
+    // large as weak pointers, so there is no need to fill the slop, either.
+    // See stg_DEAD_WEAK_info in StgMiscClosures.hc.
 #endif
 
-  //
-  // Todo: maybe use SET_HDR() and remove LDV_recordCreate()?
-  //
-  unlockClosure(w, stg_DEAD_WEAK_info);
+    //
+    // Todo: maybe use SET_HDR() and remove LDV_recordCreate()?
+    //
+    unlockClosure(w, stg_DEAD_WEAK_info);
 
-  LDV_RECORD_CREATE(w);
+    LDV_RECORD_CREATE(w);
 
-  if (list != stg_NO_FINALIZER_closure) {
-    ccall runCFinalizers(list);
-  }
+    if (list != stg_NO_FINALIZER_closure) {
+      ccall runCFinalizers(list);
+    }
 
-  /* return the finalizer */
-  if (f == stg_NO_FINALIZER_closure) {
-      return (0,stg_NO_FINALIZER_closure);
-  } else {
-      return (1,f);
-  }
+    /* return the finalizer */
+    if (f == stg_NO_FINALIZER_closure) {
+        return (0,stg_NO_FINALIZER_closure);
+    } else {
+        return (1,f);
+    }
 }
 
 stg_deRefWeakzh ( gcptr w )
 {
-  W_ code, info;
-  gcptr val;
+    W_ code, info;
+    gcptr val;
 
-  info = GET_INFO(w);
+    info = GET_INFO(w);
 
-  if (info == stg_WHITEHOLE_info) {
-    // w is locked by another thread. Now it's not immediately clear if w is
-    // alive or not. We use lockClosure to wait for the info pointer to become
-    // something other than stg_WHITEHOLE_info.
+    if (info == stg_WHITEHOLE_info) {
+        // w is locked by another thread. Now it's not immediately clear if w is
+        // alive or not. We use lockClosure to wait for the info pointer to become
+        // something other than stg_WHITEHOLE_info.
 
-    LOCK_CLOSURE(w, info);
-    unlockClosure(w, info);
-  }
+        LOCK_CLOSURE(w, info);
+        unlockClosure(w, info);
+    }
 
-  if (info == stg_WEAK_info) {
-    code = 1;
-    val = StgWeak_value(w);
-  } else {
-    code = 0;
-    val = w;
-  }
-  return (code,val);
+    if (info == stg_WEAK_info) {
+        code = 1;
+        val = StgWeak_value(w);
+    } else {
+        code = 0;
+        val = w;
+    }
+    return (code,val);
 }
 
 /* -----------------------------------------------------------------------------
@@ -577,14 +762,14 @@ stg_decodeFloatzuIntzh ( F_ arg )
 
     reserve 2 = tmp {
 
-      mp_tmp1  = tmp + WDS(1);
-      mp_tmp_w = tmp;
+        mp_tmp1  = tmp + WDS(1);
+        mp_tmp_w = tmp;
 
-      /* Perform the operation */
-      ccall __decodeFloat_Int(mp_tmp1 "ptr", mp_tmp_w "ptr", arg);
+        /* Perform the operation */
+        ccall __decodeFloat_Int(mp_tmp1 "ptr", mp_tmp_w "ptr", arg);
 
-      r1 = W_[mp_tmp1];
-      r2 = W_[mp_tmp_w];
+        r1 = W_[mp_tmp1];
+        r2 = W_[mp_tmp_w];
     }
 
     /* returns: (Int# (mantissa), Int# (exponent)) */
@@ -601,20 +786,20 @@ stg_decodeDoublezu2Intzh ( D_ arg )
 
     reserve 4 = tmp {
 
-      mp_tmp1    = tmp + WDS(3);
-      mp_tmp2    = tmp + WDS(2);
-      mp_result1 = tmp + WDS(1);
-      mp_result2 = tmp;
+        mp_tmp1    = tmp + WDS(3);
+        mp_tmp2    = tmp + WDS(2);
+        mp_result1 = tmp + WDS(1);
+        mp_result2 = tmp;
   
-      /* Perform the operation */
-      ccall __decodeDouble_2Int(mp_tmp1 "ptr", mp_tmp2 "ptr",
-                                      mp_result1 "ptr", mp_result2 "ptr",
-                                      arg);
-
-      r1 = W_[mp_tmp1];
-      r2 = W_[mp_tmp2];
-      r3 = W_[mp_result1];
-      r4 = W_[mp_result2];
+        /* Perform the operation */
+        ccall __decodeDouble_2Int(mp_tmp1 "ptr", mp_tmp2 "ptr",
+                                  mp_result1 "ptr", mp_result2 "ptr",
+                                  arg);
+
+        r1 = W_[mp_tmp1];
+        r2 = W_[mp_tmp2];
+        r3 = W_[mp_result1];
+        r4 = W_[mp_result2];
     }
 
     /* returns:
@@ -628,80 +813,81 @@ stg_decodeDoublezu2Intzh ( D_ arg )
 
 stg_forkzh ( gcptr closure )
 {
-  MAYBE_GC_P(stg_forkzh, closure);
+    MAYBE_GC_P(stg_forkzh, closure);
 
-  gcptr threadid;
+    gcptr threadid;
 
-  ("ptr" threadid) = ccall createIOThread( MyCapability() "ptr",
-                                RtsFlags_GcFlags_initialStkSize(RtsFlags),
-                                closure "ptr");
+    ("ptr" threadid) = ccall createIOThread( MyCapability() "ptr",
+                                  RtsFlags_GcFlags_initialStkSize(RtsFlags),
+                                  closure "ptr");
 
-  /* start blocked if the current thread is blocked */
-  StgTSO_flags(threadid) = %lobits16(
-     TO_W_(StgTSO_flags(threadid)) |
-     TO_W_(StgTSO_flags(CurrentTSO)) & (TSO_BLOCKEX | TSO_INTERRUPTIBLE));
+    /* start blocked if the current thread is blocked */
+    StgTSO_flags(threadid) = %lobits16(
+        TO_W_(StgTSO_flags(threadid)) |
+        TO_W_(StgTSO_flags(CurrentTSO)) & (TSO_BLOCKEX | TSO_INTERRUPTIBLE));
 
-  ccall scheduleThread(MyCapability() "ptr", threadid "ptr");
+    ccall scheduleThread(MyCapability() "ptr", threadid "ptr");
 
-  // context switch soon, but not immediately: we don't want every
-  // forkIO to force a context-switch.
-  Capability_context_switch(MyCapability()) = 1 :: CInt;
+    // context switch soon, but not immediately: we don't want every
+    // forkIO to force a context-switch.
+    Capability_context_switch(MyCapability()) = 1 :: CInt;
 
-  return (threadid);
+    return (threadid);
 }
 
 stg_forkOnzh ( W_ cpu, gcptr closure )
 {
 again: MAYBE_GC(again);
 
-  gcptr threadid;
+    gcptr threadid;
 
-  ("ptr" threadid) = ccall createIOThread( MyCapability() "ptr",
-                                RtsFlags_GcFlags_initialStkSize(RtsFlags),
-                                closure "ptr");
+    ("ptr" threadid) = ccall createIOThread(
+        MyCapability() "ptr",
+        RtsFlags_GcFlags_initialStkSize(RtsFlags),
+        closure "ptr");
 
-  /* start blocked if the current thread is blocked */
-  StgTSO_flags(threadid) = %lobits16(
-     TO_W_(StgTSO_flags(threadid)) |
-     TO_W_(StgTSO_flags(CurrentTSO)) & (TSO_BLOCKEX | TSO_INTERRUPTIBLE));
+    /* start blocked if the current thread is blocked */
+    StgTSO_flags(threadid) = %lobits16(
+        TO_W_(StgTSO_flags(threadid)) |
+        TO_W_(StgTSO_flags(CurrentTSO)) & (TSO_BLOCKEX | TSO_INTERRUPTIBLE));
 
-  ccall scheduleThreadOn(MyCapability() "ptr", cpu, threadid "ptr");
+    ccall scheduleThreadOn(MyCapability() "ptr", cpu, threadid "ptr");
 
-  // context switch soon, but not immediately: we don't want every
-  // forkIO to force a context-switch.
-  Capability_context_switch(MyCapability()) = 1 :: CInt;
+    // context switch soon, but not immediately: we don't want every
+    // forkIO to force a context-switch.
+    Capability_context_switch(MyCapability()) = 1 :: CInt;
 
-  return (threadid);
+    return (threadid);
 }
 
 stg_yieldzh ()
 {
-  // when we yield to the scheduler, we have to tell it to put the
-  // current thread to the back of the queue by setting the
-  // context_switch flag.  If we don't do this, it will run the same
-  // thread again.
-  Capability_context_switch(MyCapability()) = 1 :: CInt;
-  jump stg_yield_noregs();
+    // when we yield to the scheduler, we have to tell it to put the
+    // current thread to the back of the queue by setting the
+    // context_switch flag.  If we don't do this, it will run the same
+    // thread again.
+    Capability_context_switch(MyCapability()) = 1 :: CInt;
+    jump stg_yield_noregs();
 }
 
 stg_myThreadIdzh ()
 {
-  return (CurrentTSO);
+    return (CurrentTSO);
 }
 
 stg_labelThreadzh ( gcptr threadid, W_ addr )
 {
 #if defined(DEBUG) || defined(TRACING) || defined(DTRACE)
-  ccall labelThread(MyCapability() "ptr", threadid "ptr", addr "ptr");
+    ccall labelThread(MyCapability() "ptr", threadid "ptr", addr "ptr");
 #endif
-  return ();
+    return ();
 }
 
 stg_isCurrentThreadBoundzh (/* no args */)
 {
-  W_ r;
-  (r) = ccall isThreadBound(CurrentTSO);
-  return (r);
+    W_ r;
+    (r) = ccall isThreadBound(CurrentTSO);
+    return (r);
 }
 
 stg_threadStatuszh ( gcptr tso )
@@ -802,11 +988,11 @@ INFO_TABLE_RET(stg_catch_retry_frame, CATCH_RETRY_FRAME,
 
 // This must match StgAtomicallyFrame in Closures.h
 #define ATOMICALLY_FRAME_FIELDS(w_,p_,info_ptr,p1,p2,code,next,result)  \
-  w_ info_ptr,                                                          \
-  PROF_HDR_FIELDS(w_,p1,p2)                                             \
-  p_ code,                                                              \
-  p_ next,                                                              \
-  p_ result
+    w_ info_ptr,                                                        \
+    PROF_HDR_FIELDS(w_,p1,p2)                                           \
+    p_ code,                                                            \
+    p_ next,                                                            \
+    p_ result
 
 
 INFO_TABLE_RET(stg_atomically_frame, ATOMICALLY_FRAME,
@@ -818,63 +1004,64 @@ INFO_TABLE_RET(stg_atomically_frame, ATOMICALLY_FRAME,
                                        frame_result))
     return (P_ result) // value returned to the frame
 {
-  W_ valid;
-  gcptr trec, outer, next_invariant, q;
-
-  trec   = StgTSO_trec(CurrentTSO);
-  outer  = StgTRecHeader_enclosing_trec(trec);
-
-  if (outer == NO_TREC) {
-    /* First time back at the atomically frame -- pick up invariants */
-    ("ptr" next_invariant) =
-        ccall stmGetInvariantsToCheck(MyCapability() "ptr", trec "ptr");
-    frame_result = result;
-
-  } else {
-    /* Second/subsequent time back at the atomically frame -- abort the
-     * tx that's checking the invariant and move on to the next one */
-    StgTSO_trec(CurrentTSO) = outer;
-    StgInvariantCheckQueue_my_execution(next_invariant) = trec;
-    ccall stmAbortTransaction(MyCapability() "ptr", trec "ptr");
-    /* Don't free trec -- it's linked from q and will be stashed in the
-     * invariant if we eventually commit. */
-    next_invariant =
-       StgInvariantCheckQueue_next_queue_entry(next_invariant);
-    trec = outer;
-  }
-
-  if (next_invariant != END_INVARIANT_CHECK_QUEUE) {
-    /* We can't commit yet: another invariant to check */
-    ("ptr" trec) = ccall stmStartTransaction(MyCapability() "ptr", trec "ptr");
-    StgTSO_trec(CurrentTSO) = trec;
-    q = StgInvariantCheckQueue_invariant(next_invariant);
-    jump stg_ap_v_fast
-        (ATOMICALLY_FRAME_FIELDS(,,info_ptr,p1,p2,
-                                 code,next_invariant,frame_result))
-        (StgAtomicInvariant_code(q));
+    W_ valid;
+    gcptr trec, outer, next_invariant, q;
 
-  } else {
+    trec   = StgTSO_trec(CurrentTSO);
+    outer  = StgTRecHeader_enclosing_trec(trec);
+
+    if (outer == NO_TREC) {
+        /* First time back at the atomically frame -- pick up invariants */
+        ("ptr" next_invariant) =
+            ccall stmGetInvariantsToCheck(MyCapability() "ptr", trec "ptr");
+        frame_result = result;
+
+    } else {
+        /* Second/subsequent time back at the atomically frame -- abort the
+         * tx that's checking the invariant and move on to the next one */
+        StgTSO_trec(CurrentTSO) = outer;
+        StgInvariantCheckQueue_my_execution(next_invariant) = trec;
+        ccall stmAbortTransaction(MyCapability() "ptr", trec "ptr");
+        /* Don't free trec -- it's linked from q and will be stashed in the
+         * invariant if we eventually commit. */
+        next_invariant =
+           StgInvariantCheckQueue_next_queue_entry(next_invariant);
+        trec = outer;
+    }
+
+    if (next_invariant != END_INVARIANT_CHECK_QUEUE) {
+        /* We can't commit yet: another invariant to check */
+        ("ptr" trec) = ccall stmStartTransaction(MyCapability() "ptr", trec "ptr");
+        StgTSO_trec(CurrentTSO) = trec;
+        q = StgInvariantCheckQueue_invariant(next_invariant);
+        jump stg_ap_v_fast
+            (ATOMICALLY_FRAME_FIELDS(,,info_ptr,p1,p2,
+                                     code,next_invariant,frame_result))
+            (StgAtomicInvariant_code(q));
 
-    /* We've got no more invariants to check, try to commit */
-    (valid) = ccall stmCommitTransaction(MyCapability() "ptr", trec "ptr");
-    if (valid != 0) {
-      /* Transaction was valid: commit succeeded */
-      StgTSO_trec(CurrentTSO) = NO_TREC;
-      return (frame_result);
     } else {
-      /* Transaction was not valid: try again */
-      ("ptr" trec) = ccall stmStartTransaction(MyCapability() "ptr", NO_TREC "ptr");
-      StgTSO_trec(CurrentTSO) = trec;
-      next_invariant = END_INVARIANT_CHECK_QUEUE;
 
-      jump stg_ap_v_fast
-          // push the StgAtomicallyFrame again: the code generator is
-          // clever enough to only assign the fields that have changed.
-          (ATOMICALLY_FRAME_FIELDS(,,info_ptr,p1,p2,
-                                   code,next_invariant,frame_result))
-          (code);
+        /* We've got no more invariants to check, try to commit */
+        (valid) = ccall stmCommitTransaction(MyCapability() "ptr", trec "ptr");
+        if (valid != 0) {
+            /* Transaction was valid: commit succeeded */
+            StgTSO_trec(CurrentTSO) = NO_TREC;
+            return (frame_result);
+        } else {
+            /* Transaction was not valid: try again */
+            ("ptr" trec) = ccall stmStartTransaction(MyCapability() "ptr",
+                                                     NO_TREC "ptr");
+            StgTSO_trec(CurrentTSO) = trec;
+            next_invariant = END_INVARIANT_CHECK_QUEUE;
+
+            jump stg_ap_v_fast
+                // push the StgAtomicallyFrame again: the code generator is
+                // clever enough to only assign the fields that have changed.
+                (ATOMICALLY_FRAME_FIELDS(,,info_ptr,p1,p2,
+                                         code,next_invariant,frame_result))
+                (code);
+        }
     }
-  }
 }
 
 
@@ -887,27 +1074,27 @@ INFO_TABLE_RET(stg_atomically_waiting_frame, ATOMICALLY_FRAME,
                                        frame_result))
     return (/* no return values */)
 {
-  W_ trec, valid;
-
-  /* The TSO is currently waiting: should we stop waiting? */
-  (valid) = ccall stmReWait(MyCapability() "ptr", CurrentTSO "ptr");
-  if (valid != 0) {
-      /* Previous attempt is still valid: no point trying again yet */
-      jump stg_block_noregs
-          (ATOMICALLY_FRAME_FIELDS(,,info_ptr, p1, p2,
-                                   code,next_invariant,frame_result))
-          ();
-  } else {
-    /* Previous attempt is no longer valid: try again */
-    ("ptr" trec) = ccall stmStartTransaction(MyCapability() "ptr", NO_TREC "ptr");
-    StgTSO_trec(CurrentTSO) = trec;
-
-    // change the frame header to stg_atomically_frame_info
-    jump stg_ap_v_fast
-        (ATOMICALLY_FRAME_FIELDS(,,stg_atomically_frame_info, p1, p2,
-                                 code,next_invariant,frame_result))
-        (code);
-  }
+    W_ trec, valid;
+
+    /* The TSO is currently waiting: should we stop waiting? */
+    (valid) = ccall stmReWait(MyCapability() "ptr", CurrentTSO "ptr");
+    if (valid != 0) {
+        /* Previous attempt is still valid: no point trying again yet */
+        jump stg_block_noregs
+            (ATOMICALLY_FRAME_FIELDS(,,info_ptr, p1, p2,
+                                     code,next_invariant,frame_result))
+            ();
+    } else {
+        /* Previous attempt is no longer valid: try again */
+        ("ptr" trec) = ccall stmStartTransaction(MyCapability() "ptr", NO_TREC "ptr");
+        StgTSO_trec(CurrentTSO) = trec;
+
+        // change the frame header to stg_atomically_frame_info
+        jump stg_ap_v_fast
+            (ATOMICALLY_FRAME_FIELDS(,,stg_atomically_frame_info, p1, p2,
+                                     code,next_invariant,frame_result))
+            (code);
+    }
 }
 
 // STM catch frame -------------------------------------------------------------
@@ -918,10 +1105,10 @@ INFO_TABLE_RET(stg_atomically_waiting_frame, ATOMICALLY_FRAME,
  */
 
 #define CATCH_STM_FRAME_FIELDS(w_,p_,info_ptr,p1,p2,code,handler) \
-  w_ info_ptr,                                                  \
-  PROF_HDR_FIELDS(w_,p1,p2)                                     \
-  p_ code,                                                      \
-  p_ handler
+    w_ info_ptr,                                                  \
+    PROF_HDR_FIELDS(w_,p1,p2)                                     \
+    p_ code,                                                      \
+    p_ handler
 
 INFO_TABLE_RET(stg_catch_stm_frame, CATCH_STM_FRAME,
                // layout of the frame, and bind the field names
@@ -954,34 +1141,34 @@ INFO_TABLE_RET(stg_catch_stm_frame, CATCH_STM_FRAME,
 
 stg_atomicallyzh (P_ stm)
 {
-  P_ old_trec;
-  P_ new_trec;
-  P_ code, next_invariant, frame_result;
+    P_ old_trec;
+    P_ new_trec;
+    P_ code, next_invariant, frame_result;
 
-  // stmStartTransaction may allocate
-  MAYBE_GC_P(stg_atomicallyzh, stm);
+    // stmStartTransaction may allocate
+    MAYBE_GC_P(stg_atomicallyzh, stm);
 
-  STK_CHK_GEN();
+    STK_CHK_GEN();
 
-  old_trec = StgTSO_trec(CurrentTSO);
+    old_trec = StgTSO_trec(CurrentTSO);
 
-  /* Nested transactions are not allowed; raise an exception */
-  if (old_trec != NO_TREC) {
-     jump stg_raisezh(base_ControlziExceptionziBase_nestedAtomically_closure);
-  }
+    /* Nested transactions are not allowed; raise an exception */
+    if (old_trec != NO_TREC) {
+        jump stg_raisezh(base_ControlziExceptionziBase_nestedAtomically_closure);
+    }
 
-  code = stm;
-  next_invariant = END_INVARIANT_CHECK_QUEUE;
-  frame_result = NO_TREC;
+    code = stm;
+    next_invariant = END_INVARIANT_CHECK_QUEUE;
+    frame_result = NO_TREC;
 
-  /* Start the memory transcation */
-  ("ptr" new_trec) = ccall stmStartTransaction(MyCapability() "ptr", old_trec "ptr");
-  StgTSO_trec(CurrentTSO) = new_trec;
+    /* Start the memory transcation */
+    ("ptr" new_trec) = ccall stmStartTransaction(MyCapability() "ptr", old_trec "ptr");
+    StgTSO_trec(CurrentTSO) = new_trec;
 
-  jump stg_ap_v_fast
-      (ATOMICALLY_FRAME_FIELDS(,,stg_atomically_frame_info, CCCS, 0,
-                               code,next_invariant,frame_result))
-      (stm);
+    jump stg_ap_v_fast
+        (ATOMICALLY_FRAME_FIELDS(,,stg_atomically_frame_info, CCCS, 0,
+                                 code,next_invariant,frame_result))
+        (stm);
 }
 
 // A closure representing "atomically x".  This is used when a thread
@@ -1018,99 +1205,99 @@ stg_catchSTMzh (P_ code    /* :: STM a */,
 stg_catchRetryzh (P_ first_code, /* :: STM a */
                   P_ alt_code    /* :: STM a */)
 {
-  W_ new_trec;
+    W_ new_trec;
 
-  // stmStartTransaction may allocate
-  MAYBE_GC_PP (stg_catchRetryzh, first_code, alt_code);
+    // stmStartTransaction may allocate
+    MAYBE_GC_PP (stg_catchRetryzh, first_code, alt_code);
 
-  STK_CHK_GEN();
+    STK_CHK_GEN();
 
-  /* Start a nested transaction within which to run the first code */
-  ("ptr" new_trec) = ccall stmStartTransaction(MyCapability() "ptr",
-                                               StgTSO_trec(CurrentTSO) "ptr");
-  StgTSO_trec(CurrentTSO) = new_trec;
+    /* Start a nested transaction within which to run the first code */
+    ("ptr" new_trec) = ccall stmStartTransaction(MyCapability() "ptr",
+                                                 StgTSO_trec(CurrentTSO) "ptr");
+    StgTSO_trec(CurrentTSO) = new_trec;
 
-  // push the CATCH_RETRY stack frame, and apply first_code to realWorld#
-  jump stg_ap_v_fast
-      (CATCH_RETRY_FRAME_FIELDS(,, stg_catch_retry_frame_info, CCCS, 0,
-                                0, /* not running_alt_code */
-                                first_code,
-                                alt_code))
-      (first_code);
+    // push the CATCH_RETRY stack frame, and apply first_code to realWorld#
+    jump stg_ap_v_fast
+        (CATCH_RETRY_FRAME_FIELDS(,, stg_catch_retry_frame_info, CCCS, 0,
+                                  0, /* not running_alt_code */
+                                  first_code,
+                                  alt_code))
+        (first_code);
 }
 
 
 stg_retryzh /* no arg list: explicit stack layout */
 {
-  W_ frame_type;
-  W_ frame;
-  W_ trec;
-  W_ outer;
-  W_ r;
+    W_ frame_type;
+    W_ frame;
+    W_ trec;
+    W_ outer;
+    W_ r;
 
-  // STM operations may allocate
-  MAYBE_GC_ (stg_retryzh); // NB. not MAYBE_GC(), we cannot make a
-                           // function call in an explicit-stack proc
+    // STM operations may allocate
+    MAYBE_GC_ (stg_retryzh); // NB. not MAYBE_GC(), we cannot make a
+                             // function call in an explicit-stack proc
 
-  // Find the enclosing ATOMICALLY_FRAME or CATCH_RETRY_FRAME
+    // Find the enclosing ATOMICALLY_FRAME or CATCH_RETRY_FRAME
 retry_pop_stack:
-  SAVE_THREAD_STATE();
-  (frame_type) = ccall findRetryFrameHelper(MyCapability(), CurrentTSO "ptr");
-  LOAD_THREAD_STATE();
-  frame = Sp;
-  trec = StgTSO_trec(CurrentTSO);
-  outer  = StgTRecHeader_enclosing_trec(trec);
-
-  if (frame_type == CATCH_RETRY_FRAME) {
-    // The retry reaches a CATCH_RETRY_FRAME before the atomic frame
-    ASSERT(outer != NO_TREC);
-    // Abort the transaction attempting the current branch
-    ccall stmAbortTransaction(MyCapability() "ptr", trec "ptr");
-    ccall stmFreeAbortedTRec(MyCapability() "ptr", trec "ptr");
-    if (!StgCatchRetryFrame_running_alt_code(frame) != 0) {
-      // Retry in the first branch: try the alternative
-      ("ptr" trec) = ccall stmStartTransaction(MyCapability() "ptr", outer "ptr");
-      StgTSO_trec(CurrentTSO) = trec;
-      StgCatchRetryFrame_running_alt_code(frame) = 1 :: CInt; // true;
-      R1 = StgCatchRetryFrame_alt_code(frame);
-      jump stg_ap_v_fast [R1];
-    } else {
-      // Retry in the alternative code: propagate the retry
-      StgTSO_trec(CurrentTSO) = outer;
-      Sp = Sp + SIZEOF_StgCatchRetryFrame;
-      goto retry_pop_stack;
-    }
-  }
-
-  // We've reached the ATOMICALLY_FRAME: attempt to wait
-  ASSERT(frame_type == ATOMICALLY_FRAME);
-  if (outer != NO_TREC) {
-    // We called retry while checking invariants, so abort the current
-    // invariant check (merging its TVar accesses into the parents read
-    // set so we'll wait on them)
-    ccall stmAbortTransaction(MyCapability() "ptr", trec "ptr");
-    ccall stmFreeAbortedTRec(MyCapability() "ptr", trec "ptr");
-    trec = outer;
-    StgTSO_trec(CurrentTSO) = trec;
+    SAVE_THREAD_STATE();
+    (frame_type) = ccall findRetryFrameHelper(MyCapability(), CurrentTSO "ptr");
+    LOAD_THREAD_STATE();
+    frame = Sp;
+    trec = StgTSO_trec(CurrentTSO);
     outer  = StgTRecHeader_enclosing_trec(trec);
-  }
-  ASSERT(outer == NO_TREC);
-
-  (r) = ccall stmWait(MyCapability() "ptr", CurrentTSO "ptr", trec "ptr");
-  if (r != 0) {
-    // Transaction was valid: stmWait put us on the TVars' queues, we now block
-    StgHeader_info(frame) = stg_atomically_waiting_frame_info;
-    Sp = frame;
-    R3 = trec; // passing to stmWaitUnblock()
-    jump stg_block_stmwait [R3];
-  } else {
-    // Transaction was not valid: retry immediately
-    ("ptr" trec) = ccall stmStartTransaction(MyCapability() "ptr", outer "ptr");
-    StgTSO_trec(CurrentTSO) = trec;
-    Sp = frame;
-    R1 = StgAtomicallyFrame_code(frame);
-    jump stg_ap_v_fast [R1];
-  }
+
+    if (frame_type == CATCH_RETRY_FRAME) {
+        // The retry reaches a CATCH_RETRY_FRAME before the atomic frame
+        ASSERT(outer != NO_TREC);
+        // Abort the transaction attempting the current branch
+        ccall stmAbortTransaction(MyCapability() "ptr", trec "ptr");
+        ccall stmFreeAbortedTRec(MyCapability() "ptr", trec "ptr");
+        if (!StgCatchRetryFrame_running_alt_code(frame) != 0) {
+            // Retry in the first branch: try the alternative
+            ("ptr" trec) = ccall stmStartTransaction(MyCapability() "ptr", outer "ptr");
+            StgTSO_trec(CurrentTSO) = trec;
+            StgCatchRetryFrame_running_alt_code(frame) = 1 :: CInt; // true;
+            R1 = StgCatchRetryFrame_alt_code(frame);
+            jump stg_ap_v_fast [R1];
+        } else {
+            // Retry in the alternative code: propagate the retry
+            StgTSO_trec(CurrentTSO) = outer;
+            Sp = Sp + SIZEOF_StgCatchRetryFrame;
+            goto retry_pop_stack;
+        }
+    }
+
+    // We've reached the ATOMICALLY_FRAME: attempt to wait
+    ASSERT(frame_type == ATOMICALLY_FRAME);
+    if (outer != NO_TREC) {
+        // We called retry while checking invariants, so abort the current
+        // invariant check (merging its TVar accesses into the parents read
+        // set so we'll wait on them)
+        ccall stmAbortTransaction(MyCapability() "ptr", trec "ptr");
+        ccall stmFreeAbortedTRec(MyCapability() "ptr", trec "ptr");
+        trec = outer;
+        StgTSO_trec(CurrentTSO) = trec;
+        outer  = StgTRecHeader_enclosing_trec(trec);
+    }
+    ASSERT(outer == NO_TREC);
+
+    (r) = ccall stmWait(MyCapability() "ptr", CurrentTSO "ptr", trec "ptr");
+    if (r != 0) {
+        // Transaction was valid: stmWait put us on the TVars' queues, we now block
+        StgHeader_info(frame) = stg_atomically_waiting_frame_info;
+        Sp = frame;
+        R3 = trec; // passing to stmWaitUnblock()
+        jump stg_block_stmwait [R3];
+    } else {
+        // Transaction was not valid: retry immediately
+        ("ptr" trec) = ccall stmStartTransaction(MyCapability() "ptr", outer "ptr");
+        StgTSO_trec(CurrentTSO) = trec;
+        Sp = frame;
+        R1 = StgAtomicallyFrame_code(frame);
+        jump stg_ap_v_fast [R1];
+    }
 }
 
 stg_checkzh (P_ closure /* STM a */)
@@ -1146,16 +1333,16 @@ stg_newTVarzh (P_ init)
 
 stg_readTVarzh (P_ tvar)
 {
-  P_ trec;
-  P_ result;
+    P_ trec;
+    P_ result;
 
-  // Call to stmReadTVar may allocate
-  MAYBE_GC_P (stg_readTVarzh, tvar);
+    // Call to stmReadTVar may allocate
+    MAYBE_GC_P (stg_readTVarzh, tvar);
 
-  trec = StgTSO_trec(CurrentTSO);
-  ("ptr" result) = ccall stmReadTVar(MyCapability() "ptr", trec "ptr",
-                                     tvar "ptr");
-  return (result);
+    trec = StgTSO_trec(CurrentTSO);
+    ("ptr" result) = ccall stmReadTVar(MyCapability() "ptr", trec "ptr",
+                                       tvar "ptr");
+    return (result);
 }
 
 stg_readTVarIOzh ( P_ tvar /* :: TVar a */ )
@@ -1641,6 +1828,7 @@ stg_tryReadMVarzh ( P_ mvar, /* :: MVar a */ )
     LOCK_CLOSURE(mvar, info);
 
     if (StgMVar_value(mvar) == stg_END_TSO_QUEUE_closure) {
+        unlockClosure(mvar, info);
         return (0, stg_NO_FINALIZER_closure);
     }
 
@@ -1832,9 +2020,9 @@ for2:
 #define APPEND_TO_BLOCKED_QUEUE(tso)                    \
     ASSERT(StgTSO__link(tso) == END_TSO_QUEUE);         \
     if (W_[blocked_queue_hd] == END_TSO_QUEUE) {        \
-      W_[blocked_queue_hd] = tso;                       \
+        W_[blocked_queue_hd] = tso;                     \
     } else {                                            \
-      ccall setTSOLink(MyCapability() "ptr", W_[blocked_queue_tl] "ptr", tso); \
+        ccall setTSOLink(MyCapability() "ptr", W_[blocked_queue_tl] "ptr", tso); \
     }                                                   \
     W_[blocked_queue_tl] = tso;
 
@@ -2134,64 +2322,64 @@ stg_traceCcszh ( P_ obj, P_ ret )
 
 stg_getSparkzh ()
 {
-   W_ spark;
+    W_ spark;
 
 #ifndef THREADED_RTS
-   return (0,ghczmprim_GHCziTypes_False_closure);
+    return (0,ghczmprim_GHCziTypes_False_closure);
 #else
-   (spark) = ccall findSpark(MyCapability());
-   if (spark != 0) {
-      return (1,spark);
-   } else {
-      return (0,ghczmprim_GHCziTypes_False_closure);
-   }
+    (spark) = ccall findSpark(MyCapability());
+    if (spark != 0) {
+        return (1,spark);
+    } else {
+        return (0,ghczmprim_GHCziTypes_False_closure);
+    }
 #endif
 }
 
 stg_numSparkszh ()
 {
-  W_ n;
+    W_ n;
 #ifdef THREADED_RTS
-  (n) = ccall dequeElements(Capability_sparks(MyCapability()));
+    (n) = ccall dequeElements(Capability_sparks(MyCapability()));
 #else
-  n = 0;
+    n = 0;
 #endif
-  return (n);
+    return (n);
 }
 
 stg_traceEventzh ( W_ msg )
 {
 #if defined(TRACING) || defined(DEBUG)
 
-   ccall traceUserMsg(MyCapability() "ptr", msg "ptr");
+    ccall traceUserMsg(MyCapability() "ptr", msg "ptr");
 
 #elif defined(DTRACE)
 
-   W_ enabled;
+    W_ enabled;
 
-   // We should go through the macro HASKELLEVENT_USER_MSG_ENABLED from
-   // RtsProbes.h, but that header file includes unistd.h, which doesn't
-   // work in Cmm
+    // We should go through the macro HASKELLEVENT_USER_MSG_ENABLED from
+    // RtsProbes.h, but that header file includes unistd.h, which doesn't
+    // work in Cmm
 #if !defined(solaris2_TARGET_OS)
    (enabled) = ccall __dtrace_isenabled$HaskellEvent$user__msg$v1();
 #else
-   // Solaris' DTrace can't handle the
-   //     __dtrace_isenabled$HaskellEvent$user__msg$v1
-   // call above. This call is just for testing whether the user__msg
-   // probe is enabled, and is here for just performance optimization.
-   // Since preparation for the probe is not that complex I disable usage of
-   // this test above for Solaris and enable the probe usage manually
-   // here. Please note that this does not mean that the probe will be
-   // used during the runtime! You still need to enable it by consumption
-   // in your dtrace script as you do with any other probe.
-   enabled = 1;
+    // Solaris' DTrace can't handle the
+    //     __dtrace_isenabled$HaskellEvent$user__msg$v1
+    // call above. This call is just for testing whether the user__msg
+    // probe is enabled, and is here for just performance optimization.
+    // Since preparation for the probe is not that complex I disable usage of
+    // this test above for Solaris and enable the probe usage manually
+    // here. Please note that this does not mean that the probe will be
+    // used during the runtime! You still need to enable it by consumption
+    // in your dtrace script as you do with any other probe.
+    enabled = 1;
 #endif
-   if (enabled != 0) {
-     ccall dtraceUserMsgWrapper(MyCapability() "ptr", msg "ptr");
-   }
+    if (enabled != 0) {
+      ccall dtraceUserMsgWrapper(MyCapability() "ptr", msg "ptr");
+    }
 
 #endif
-   return ();
+    return ();
 }
 
 // Same code as stg_traceEventzh above but a different kind of event
@@ -2200,22 +2388,22 @@ stg_traceMarkerzh ( W_ msg )
 {
 #if defined(TRACING) || defined(DEBUG)
 
-   ccall traceUserMarker(MyCapability() "ptr", msg "ptr");
+    ccall traceUserMarker(MyCapability() "ptr", msg "ptr");
 
 #elif defined(DTRACE)
 
-   W_ enabled;
+    W_ enabled;
 
 #if !defined(solaris2_TARGET_OS)
-   (enabled) = ccall __dtrace_isenabled$HaskellEvent$user__marker$v1();
+    (enabled) = ccall __dtrace_isenabled$HaskellEvent$user__marker$v1();
 #else
-   enabled = 1;
+    enabled = 1;
 #endif
-   if (enabled != 0) {
-     ccall dtraceUserMarkerWrapper(MyCapability() "ptr", msg "ptr");
-   }
+    if (enabled != 0) {
+        ccall dtraceUserMarkerWrapper(MyCapability() "ptr", msg "ptr");
+    }
 
 #endif
-   return ();
+    return ();
 }
 
diff --git a/rts/Printer.c b/rts/Printer.c
index ca9ca496b51b..cd4b9a1bb32f 100644
--- a/rts/Printer.c
+++ b/rts/Printer.c
@@ -3,7 +3,7 @@
  * (c) The GHC Team, 1994-2000.
  *
  * Heap printer
- * 
+ *
  * ---------------------------------------------------------------------------*/
 
 #include "PosixSource.h"
@@ -33,10 +33,7 @@ static void    insert        ( StgWord value, const char *name );
 #endif
 #if 0 /* unused but might be useful sometime */
 static rtsBool lookup_name   ( char *name, StgWord *result );
-static void    enZcode       ( char *in, char *out );
 #endif
-static char    unZcode       ( char ch );
-static void    printZcoded   ( const char *raw );
 
 /* --------------------------------------------------------------------------
  * Printer
@@ -47,12 +44,13 @@ void printPtr( StgPtr p )
     const char *raw;
     raw = lookupGHCName(p);
     if (raw != NULL) {
-        printZcoded(raw);
+        debugBelch("<%s>", raw);
+        debugBelch("[%p]", p);
     } else {
         debugBelch("%p", p);
     }
 }
-  
+
 void printObj( StgClosure *obj )
 {
     debugBelch("Object "); printPtr((StgPtr)obj); debugBelch(" = ");
@@ -133,11 +131,11 @@ printClosure( StgClosure *obj )
 
             debugBelch("%s(", GET_CON_DESC(con_info));
             for (i = 0; i < info->layout.payload.ptrs; ++i) {
-		if (i != 0) debugBelch(", ");
+                if (i != 0) debugBelch(", ");
                 printPtr((StgPtr)obj->payload[i]);
             }
             for (j = 0; j < info->layout.payload.nptrs; ++j) {
-		if (i != 0 || j != 0) debugBelch(", ");
+                if (i != 0 || j != 0) debugBelch(", ");
                 debugBelch("%p#", obj->payload[i+j]);
             }
             debugBelch(")\n");
@@ -145,28 +143,28 @@ printClosure( StgClosure *obj )
         }
 
     case FUN:
-    case FUN_1_0: case FUN_0_1: 
+    case FUN_1_0: case FUN_0_1:
     case FUN_1_1: case FUN_0_2: case FUN_2_0:
     case FUN_STATIC:
-	debugBelch("FUN/%d(",(int)itbl_to_fun_itbl(info)->f.arity);
-	printPtr((StgPtr)obj->header.info);
+        debugBelch("FUN/%d(",(int)itbl_to_fun_itbl(info)->f.arity);
+        printPtr((StgPtr)obj->header.info);
 #ifdef PROFILING
-	debugBelch(", %s", obj->header.prof.ccs->cc->label);
+        debugBelch(", %s", obj->header.prof.ccs->cc->label);
 #endif
-	printStdObjPayload(obj);
-	break;
+        printStdObjPayload(obj);
+        break;
 
     case PRIM:
-	debugBelch("PRIM(");
-	printPtr((StgPtr)obj->header.info);
-	printStdObjPayload(obj);
-	break;
+        debugBelch("PRIM(");
+        printPtr((StgPtr)obj->header.info);
+        printStdObjPayload(obj);
+        break;
 
     case MUT_PRIM:
         debugBelch("MUT_PRIM(");
-	printPtr((StgPtr)obj->header.info);
-	printStdObjPayload(obj);
-	break;
+        printPtr((StgPtr)obj->header.info);
+        printStdObjPayload(obj);
+        break;
 
     case THUNK:
     case THUNK_1_0: case THUNK_0_1:
@@ -181,9 +179,9 @@ printClosure( StgClosure *obj )
             break;
 
     case THUNK_SELECTOR:
-	printStdObjHdr(obj, "THUNK_SELECTOR");
-	debugBelch(", %p)\n", ((StgSelector *)obj)->selectee);
-	break;
+        printStdObjHdr(obj, "THUNK_SELECTOR");
+        debugBelch(", %p)\n", ((StgSelector *)obj)->selectee);
+        break;
 
     case BCO:
             disassemble( (StgBCO*)obj );
@@ -191,7 +189,7 @@ printClosure( StgClosure *obj )
 
     case AP:
         {
-	    StgAP* ap = (StgAP*)obj;
+            StgAP* ap = (StgAP*)obj;
             StgWord i;
             debugBelch("AP("); printPtr((StgPtr)ap->fun);
             for (i = 0; i < ap->n_args; ++i) {
@@ -204,10 +202,10 @@ printClosure( StgClosure *obj )
 
     case PAP:
         {
-	    StgPAP* pap = (StgPAP*)obj;
+            StgPAP* pap = (StgPAP*)obj;
             StgWord i;
-            debugBelch("PAP/%d(",(int)pap->arity); 
-	    printPtr((StgPtr)pap->fun);
+            debugBelch("PAP/%d(",(int)pap->arity);
+            printPtr((StgPtr)pap->fun);
             for (i = 0; i < pap->n_args; ++i) {
                 debugBelch(", ");
                 printPtr((StgPtr)pap->payload[i]);
@@ -218,7 +216,7 @@ printClosure( StgClosure *obj )
 
     case AP_STACK:
         {
-	    StgAP_STACK* ap = (StgAP_STACK*)obj;
+            StgAP_STACK* ap = (StgAP_STACK*)obj;
             StgWord i;
             debugBelch("AP_STACK("); printPtr((StgPtr)ap->fun);
             for (i = 0; i < ap->size; ++i) {
@@ -230,27 +228,27 @@ printClosure( StgClosure *obj )
         }
 
     case IND:
-            debugBelch("IND("); 
+            debugBelch("IND(");
             printPtr((StgPtr)((StgInd*)obj)->indirectee);
-            debugBelch(")\n"); 
+            debugBelch(")\n");
             break;
 
     case IND_PERM:
-            debugBelch("IND("); 
+            debugBelch("IND(");
             printPtr((StgPtr)((StgInd*)obj)->indirectee);
-            debugBelch(")\n"); 
+            debugBelch(")\n");
             break;
 
     case IND_STATIC:
-            debugBelch("IND_STATIC("); 
+            debugBelch("IND_STATIC(");
             printPtr((StgPtr)((StgInd*)obj)->indirectee);
-            debugBelch(")\n"); 
+            debugBelch(")\n");
             break;
 
     case BLACKHOLE:
-            debugBelch("BLACKHOLE("); 
+            debugBelch("BLACKHOLE(");
             printPtr((StgPtr)((StgInd*)obj)->indirectee);
-            debugBelch(")\n"); 
+            debugBelch(")\n");
             break;
 
     /* Cannot happen -- use default case.
@@ -267,7 +265,7 @@ printClosure( StgClosure *obj )
             printPtr((StgPtr)GET_INFO((StgClosure *)u));
             debugBelch(",");
             printPtr((StgPtr)u->updatee);
-            debugBelch(")\n"); 
+            debugBelch(")\n");
             break;
         }
 
@@ -278,7 +276,7 @@ printClosure( StgClosure *obj )
             printPtr((StgPtr)GET_INFO((StgClosure *)u));
             debugBelch(",");
             printPtr((StgPtr)u->handler);
-            debugBelch(")\n"); 
+            debugBelch(")\n");
             break;
         }
 
@@ -287,7 +285,7 @@ printClosure( StgClosure *obj )
             StgUnderflowFrame* u = (StgUnderflowFrame*)obj;
             debugBelch("UNDERFLOW_FRAME(");
             printPtr((StgPtr)u->next_chunk);
-            debugBelch(")\n"); 
+            debugBelch(")\n");
             break;
         }
 
@@ -296,7 +294,7 @@ printClosure( StgClosure *obj )
             StgStopFrame* u = (StgStopFrame*)obj;
             debugBelch("STOP_FRAME(");
             printPtr((StgPtr)GET_INFO((StgClosure *)u));
-            debugBelch(")\n"); 
+            debugBelch(")\n");
             break;
         }
 
@@ -304,29 +302,44 @@ printClosure( StgClosure *obj )
         {
             StgWord i;
             debugBelch("ARR_WORDS(\"");
-	    for (i=0; i<arr_words_words((StgArrWords *)obj); i++)
-	      debugBelch("%" FMT_Word, (W_)((StgArrWords *)obj)->payload[i]);
+            for (i=0; i<arr_words_words((StgArrWords *)obj); i++)
+              debugBelch("%" FMT_Word, (W_)((StgArrWords *)obj)->payload[i]);
             debugBelch("\")\n");
             break;
         }
 
     case MUT_ARR_PTRS_CLEAN:
-	debugBelch("MUT_ARR_PTRS_CLEAN(size=%" FMT_Word ")\n", (W_)((StgMutArrPtrs *)obj)->ptrs);
-	break;
+        debugBelch("MUT_ARR_PTRS_CLEAN(size=%" FMT_Word ")\n", (W_)((StgMutArrPtrs *)obj)->ptrs);
+        break;
 
     case MUT_ARR_PTRS_DIRTY:
-	debugBelch("MUT_ARR_PTRS_DIRTY(size=%" FMT_Word ")\n", (W_)((StgMutArrPtrs *)obj)->ptrs);
-	break;
+        debugBelch("MUT_ARR_PTRS_DIRTY(size=%" FMT_Word ")\n", (W_)((StgMutArrPtrs *)obj)->ptrs);
+        break;
 
     case MUT_ARR_PTRS_FROZEN:
-	debugBelch("MUT_ARR_PTRS_FROZEN(size=%" FMT_Word ")\n", (W_)((StgMutArrPtrs *)obj)->ptrs);
-	break;
+        debugBelch("MUT_ARR_PTRS_FROZEN(size=%" FMT_Word ")\n", (W_)((StgMutArrPtrs *)obj)->ptrs);
+        break;
+
+    case SMALL_MUT_ARR_PTRS_CLEAN:
+        debugBelch("SMALL_MUT_ARR_PTRS_CLEAN(size=%" FMT_Word ")\n",
+                   (W_)((StgSmallMutArrPtrs *)obj)->ptrs);
+        break;
+
+    case SMALL_MUT_ARR_PTRS_DIRTY:
+        debugBelch("SMALL_MUT_ARR_PTRS_DIRTY(size=%" FMT_Word ")\n",
+                   (W_)((StgSmallMutArrPtrs *)obj)->ptrs);
+        break;
+
+    case SMALL_MUT_ARR_PTRS_FROZEN:
+        debugBelch("SMALL_MUT_ARR_PTRS_FROZEN(size=%" FMT_Word ")\n",
+                   (W_)((StgSmallMutArrPtrs *)obj)->ptrs);
+        break;
 
     case MVAR_CLEAN:
     case MVAR_DIRTY:
         {
-	  StgMVar* mv = (StgMVar*)obj;
-	  debugBelch("MVAR(head=%p, tail=%p, value=%p)\n", mv->head, mv->tail, mv->value);
+          StgMVar* mv = (StgMVar*)obj;
+          debugBelch("MVAR(head=%p, tail=%p, value=%p)\n", mv->head, mv->tail, mv->value);
           break;
         }
 
@@ -339,32 +352,32 @@ printClosure( StgClosure *obj )
 
     case MUT_VAR_CLEAN:
         {
-	  StgMutVar* mv = (StgMutVar*)obj;
-	  debugBelch("MUT_VAR_CLEAN(var=%p)\n", mv->var);
+          StgMutVar* mv = (StgMutVar*)obj;
+          debugBelch("MUT_VAR_CLEAN(var=%p)\n", mv->var);
           break;
         }
 
     case MUT_VAR_DIRTY:
         {
-	  StgMutVar* mv = (StgMutVar*)obj;
-	  debugBelch("MUT_VAR_DIRTY(var=%p)\n", mv->var);
+          StgMutVar* mv = (StgMutVar*)obj;
+          debugBelch("MUT_VAR_DIRTY(var=%p)\n", mv->var);
           break;
         }
 
     case WEAK:
-            debugBelch("WEAK("); 
-	    debugBelch(" key=%p value=%p finalizer=%p", 
-		    (StgPtr)(((StgWeak*)obj)->key),
-		    (StgPtr)(((StgWeak*)obj)->value),
-		    (StgPtr)(((StgWeak*)obj)->finalizer));
-            debugBelch(")\n"); 
-	    /* ToDo: chase 'link' ? */
+            debugBelch("WEAK(");
+            debugBelch(" key=%p value=%p finalizer=%p",
+                    (StgPtr)(((StgWeak*)obj)->key),
+                    (StgPtr)(((StgWeak*)obj)->value),
+                    (StgPtr)(((StgWeak*)obj)->finalizer));
+            debugBelch(")\n");
+            /* ToDo: chase 'link' ? */
             break;
 
     case TSO:
-      debugBelch("TSO("); 
+      debugBelch("TSO(");
       debugBelch("%lu (%p)",(unsigned long)(((StgTSO*)obj)->id), (StgTSO*)obj);
-      debugBelch(")\n"); 
+      debugBelch(")\n");
       break;
 
     case STACK:
@@ -374,9 +387,9 @@ printClosure( StgClosure *obj )
 #if 0
       /* Symptomatic of a problem elsewhere, have it fall-through & fail */
     case EVACUATED:
-      debugBelch("EVACUATED("); 
+      debugBelch("EVACUATED(");
       printClosure((StgEvacuated*)obj->evacuee);
-      debugBelch(")\n"); 
+      debugBelch(")\n");
       break;
 #endif
 
@@ -423,22 +436,22 @@ printStackObj( StgPtr sp )
         printPtr((StgPtr)*sp);
         if (c == (StgClosure*)&stg_ctoi_R1p_info) {
            debugBelch("\t\t\tstg_ctoi_ret_R1p_info\n" );
-	} else
+        } else
         if (c == (StgClosure*)&stg_ctoi_R1n_info) {
            debugBelch("\t\t\tstg_ctoi_ret_R1n_info\n" );
-	} else
+        } else
         if (c == (StgClosure*)&stg_ctoi_F1_info) {
            debugBelch("\t\t\tstg_ctoi_ret_F1_info\n" );
-	} else
+        } else
         if (c == (StgClosure*)&stg_ctoi_D1_info) {
            debugBelch("\t\t\tstg_ctoi_ret_D1_info\n" );
-	} else
+        } else
         if (c == (StgClosure*)&stg_ctoi_V_info) {
            debugBelch("\t\t\tstg_ctoi_ret_V_info\n" );
-	} else
+        } else
         if (get_itbl(c)->type == BCO) {
            debugBelch("\t\t\t");
-           debugBelch("BCO(...)\n"); 
+           debugBelch("BCO(...)\n");
         }
         else {
            debugBelch("\t\t\t");
@@ -447,7 +460,7 @@ printStackObj( StgPtr sp )
         sp += 1;
 
     return sp;
-    
+
 }
 
 static void
@@ -456,13 +469,13 @@ printSmallBitmap( StgPtr spBottom, StgPtr payload, StgWord bitmap, nat size )
     nat i;
 
     for(i = 0; i < size; i++, bitmap >>= 1 ) {
-	debugBelch("   stk[%ld] (%p) = ", (long)(spBottom-(payload+i)), payload+i);
-	if ((bitmap & 1) == 0) {
-	    printPtr((P_)payload[i]);
-	    debugBelch("\n");
-	} else {
-	    debugBelch("Word# %" FMT_Word "\n", (W_)payload[i]);
-	}
+        debugBelch("   stk[%ld] (%p) = ", (long)(spBottom-(payload+i)), payload+i);
+        if ((bitmap & 1) == 0) {
+            printPtr((P_)payload[i]);
+            debugBelch("\n");
+        } else {
+            debugBelch("Word# %" FMT_Word "\n", (W_)payload[i]);
+        }
     }
 }
 
@@ -474,17 +487,17 @@ printLargeBitmap( StgPtr spBottom, StgPtr payload, StgLargeBitmap* large_bitmap,
 
     i = 0;
     for (bmp=0; i < size; bmp++) {
-	StgWord bitmap = large_bitmap->bitmap[bmp];
-	j = 0;
-	for(; i < size && j < BITS_IN(W_); j++, i++, bitmap >>= 1 ) {
-	    debugBelch("   stk[%" FMT_Word "] (%p) = ", (W_)(spBottom-(payload+i)), payload+i);
-	    if ((bitmap & 1) == 0) {
-		printPtr((P_)payload[i]);
-		debugBelch("\n");
-	    } else {
-		debugBelch("Word# %" FMT_Word "\n", (W_)payload[i]);
-	    }
-	}
+        StgWord bitmap = large_bitmap->bitmap[bmp];
+        j = 0;
+        for(; i < size && j < BITS_IN(W_); j++, i++, bitmap >>= 1 ) {
+            debugBelch("   stk[%" FMT_Word "] (%p) = ", (W_)(spBottom-(payload+i)), payload+i);
+            if ((bitmap & 1) == 0) {
+                printPtr((P_)payload[i]);
+                debugBelch("\n");
+            } else {
+                debugBelch("Word# %" FMT_Word "\n", (W_)payload[i]);
+            }
+        }
     }
 }
 
@@ -497,70 +510,70 @@ printStackChunk( StgPtr sp, StgPtr spBottom )
     ASSERT(sp <= spBottom);
     for (; sp < spBottom; sp += stack_frame_sizeW((StgClosure *)sp)) {
 
-	info = get_itbl((StgClosure *)sp);
+        info = get_itbl((StgClosure *)sp);
 
-	switch (info->type) {
-	    
-	case UPDATE_FRAME:
-	case CATCH_FRAME:
+        switch (info->type) {
+
+        case UPDATE_FRAME:
+        case CATCH_FRAME:
         case UNDERFLOW_FRAME:
         case STOP_FRAME:
             printObj((StgClosure*)sp);
-	    continue;
+            continue;
 
         case RET_SMALL:
-	    debugBelch("RET_SMALL (%p)\n", info);
-	    bitmap = info->layout.bitmap;
-	    printSmallBitmap(spBottom, sp+1, 
-			     BITMAP_BITS(bitmap), BITMAP_SIZE(bitmap));
-	    continue;
-
-	case RET_BCO: {
-	    StgBCO *bco;
-	    
-	    bco = ((StgBCO *)sp[1]);
-
-	    debugBelch("RET_BCO (%p)\n", sp);
-	    printLargeBitmap(spBottom, sp+2,
-			     BCO_BITMAP(bco), BCO_BITMAP_SIZE(bco));
-	    continue;
-	}
-
-	case RET_BIG:
-	    barf("todo");
-
-	case RET_FUN:
-	{
-	    StgFunInfoTable *fun_info;
-	    StgRetFun *ret_fun;
-
-	    ret_fun = (StgRetFun *)sp;
-	    fun_info = get_fun_itbl(ret_fun->fun);
-	    debugBelch("RET_FUN (%p) (type=%d)\n", ret_fun->fun, (int)fun_info->f.fun_type);
-	    switch (fun_info->f.fun_type) {
-	    case ARG_GEN:
-		printSmallBitmap(spBottom, sp+2,
-				 BITMAP_BITS(fun_info->f.b.bitmap),
-				 BITMAP_SIZE(fun_info->f.b.bitmap));
-		break;
-	    case ARG_GEN_BIG:
-		printLargeBitmap(spBottom, sp+2,
-				 GET_FUN_LARGE_BITMAP(fun_info),
-				 GET_FUN_LARGE_BITMAP(fun_info)->size);
-		break;
-	    default:
-		printSmallBitmap(spBottom, sp+2,
-				 BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]),
-				 BITMAP_SIZE(stg_arg_bitmaps[fun_info->f.fun_type]));
-		break;
-	    }
-	    continue;
-	}
-	   
-	default:
-	    debugBelch("unknown object %d\n", (int)info->type);
-	    barf("printStackChunk");
-	}
+            debugBelch("RET_SMALL (%p)\n", info);
+            bitmap = info->layout.bitmap;
+            printSmallBitmap(spBottom, sp+1,
+                             BITMAP_BITS(bitmap), BITMAP_SIZE(bitmap));
+            continue;
+
+        case RET_BCO: {
+            StgBCO *bco;
+
+            bco = ((StgBCO *)sp[1]);
+
+            debugBelch("RET_BCO (%p)\n", sp);
+            printLargeBitmap(spBottom, sp+2,
+                             BCO_BITMAP(bco), BCO_BITMAP_SIZE(bco));
+            continue;
+        }
+
+        case RET_BIG:
+            barf("todo");
+
+        case RET_FUN:
+        {
+            StgFunInfoTable *fun_info;
+            StgRetFun *ret_fun;
+
+            ret_fun = (StgRetFun *)sp;
+            fun_info = get_fun_itbl(ret_fun->fun);
+            debugBelch("RET_FUN (%p) (type=%d)\n", ret_fun->fun, (int)fun_info->f.fun_type);
+            switch (fun_info->f.fun_type) {
+            case ARG_GEN:
+                printSmallBitmap(spBottom, sp+2,
+                                 BITMAP_BITS(fun_info->f.b.bitmap),
+                                 BITMAP_SIZE(fun_info->f.b.bitmap));
+                break;
+            case ARG_GEN_BIG:
+                printLargeBitmap(spBottom, sp+2,
+                                 GET_FUN_LARGE_BITMAP(fun_info),
+                                 GET_FUN_LARGE_BITMAP(fun_info)->size);
+                break;
+            default:
+                printSmallBitmap(spBottom, sp+2,
+                                 BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]),
+                                 BITMAP_SIZE(stg_arg_bitmaps[fun_info->f.fun_type]));
+                break;
+            }
+            continue;
+        }
+
+        default:
+            debugBelch("unknown object %d\n", (int)info->type);
+            barf("printStackChunk");
+        }
     }
 }
 
@@ -631,134 +644,6 @@ static rtsBool lookup_name( char *name, StgWord *result )
 }
 #endif
 
-/* Code from somewhere inside GHC (circa 1994)
- * * Z-escapes:
- *     "std"++xs -> "Zstd"++xs
- *     char_to_c 'Z'  = "ZZ"
- *     char_to_c '&'  = "Za"
- *     char_to_c '|'  = "Zb"
- *     char_to_c ':'  = "Zc"
- *     char_to_c '/'  = "Zd"
- *     char_to_c '='  = "Ze"
- *     char_to_c '>'  = "Zg"
- *     char_to_c '#'  = "Zh"
- *     char_to_c '<'  = "Zl"
- *     char_to_c '-'  = "Zm"
- *     char_to_c '!'  = "Zn"
- *     char_to_c '.'  = "Zo"
- *     char_to_c '+'  = "Zp"
- *     char_to_c '\'' = "Zq"
- *     char_to_c '*'  = "Zt"
- *     char_to_c '_'  = "Zu"
- *     char_to_c c    = "Z" ++ show (ord c)
- */
-static char unZcode( char ch )
-{
-    switch (ch) {
-    case 'a'  : return ('&');
-    case 'b'  : return ('|');
-    case 'c'  : return (':');
-    case 'd'  : return ('/');
-    case 'e'  : return ('=');
-    case 'g'  : return ('>');
-    case 'h'  : return ('#');
-    case 'l'  : return ('<');
-    case 'm'  : return ('-');
-    case 'n'  : return ('!');
-    case 'o'  : return ('.');
-    case 'p'  : return ('+');
-    case 'q'  : return ('\'');
-    case 't'  : return ('*');
-    case 'u'  : return ('_');
-    case 'Z'  :
-    case '\0' : return ('Z');
-    default   : return (ch);
-    }
-}
-
-#if 0
-/* Precondition: out big enough to handle output (about twice length of in) */
-static void enZcode( char *in, char *out )
-{
-    int i, j;
-
-    j = 0;
-    out[ j++ ] = '_';
-    for( i = 0; in[i] != '\0'; ++i ) {
-        switch (in[i]) {
-        case 'Z'  : 
-                out[j++] = 'Z';
-                out[j++] = 'Z';
-                break;
-        case '&'  : 
-                out[j++] = 'Z';
-                out[j++] = 'a';
-                break;
-        case '|'  : 
-                out[j++] = 'Z';
-                out[j++] = 'b';
-                break;
-        case ':'  : 
-                out[j++] = 'Z';
-                out[j++] = 'c';
-                break;
-        case '/'  : 
-                out[j++] = 'Z';
-                out[j++] = 'd';
-                break;
-        case '='  : 
-                out[j++] = 'Z';
-                out[j++] = 'e';
-                break;
-        case '>'  : 
-                out[j++] = 'Z';
-                out[j++] = 'g';
-                break;
-        case '#'  : 
-                out[j++] = 'Z';
-                out[j++] = 'h';
-                break;
-        case '<'  : 
-                out[j++] = 'Z';
-                out[j++] = 'l';
-                break;
-        case '-'  : 
-                out[j++] = 'Z';
-                out[j++] = 'm';
-                break;
-        case '!'  : 
-                out[j++] = 'Z';
-                out[j++] = 'n';
-                break;
-        case '.'  : 
-                out[j++] = 'Z';
-                out[j++] = 'o';
-                break;
-        case '+'  : 
-                out[j++] = 'Z';
-                out[j++] = 'p';
-                break;
-        case '\'' : 
-                out[j++] = 'Z';
-                out[j++] = 'q';
-                break;
-        case '*'  : 
-                out[j++] = 'Z';
-                out[j++] = 't';
-                break;
-        case '_'  : 
-                out[j++] = 'Z';
-                out[j++] = 'u';
-                break;
-        default :
-                out[j++] = in[i];
-                break;
-        }
-    }
-    out[j] = '\0';
-}
-#endif
-
 const char *lookupGHCName( void *addr )
 {
     nat i;
@@ -771,27 +656,12 @@ const char *lookupGHCName( void *addr )
     }
 }
 
-static void printZcoded( const char *raw )
-{
-    nat j = 0;
-    
-    while ( raw[j] != '\0' ) {
-        if (raw[j] == 'Z') {
-            debugBelch("%c", unZcode(raw[j+1]));
-            j = j + 2;
-        } else {
-            debugBelch("%c", unZcode(raw[j+1]));
-            j = j + 1;
-        }
-    }
-}
-
 /* --------------------------------------------------------------------------
  * Symbol table loading
  * ------------------------------------------------------------------------*/
 
 /* Causing linking trouble on Win32 plats, so I'm
-   disabling this for now. 
+   disabling this for now.
 */
 #ifdef USING_LIBBFD
 
@@ -805,17 +675,17 @@ static rtsBool isReal( flagword flags STG_UNUSED, const char *name )
 {
 #if 0
     /* ToDo: make this work on BFD */
-    int tp = type & N_TYPE;    
+    int tp = type & N_TYPE;
     if (tp == N_TEXT || tp == N_DATA) {
         return (name[0] == '_' && name[1] != '_');
     } else {
         return rtsFalse;
     }
 #else
-    if (*name == '\0'  || 
-	(name[0] == 'g' && name[1] == 'c' && name[2] == 'c') ||
-	(name[0] == 'c' && name[1] == 'c' && name[2] == '.')) {
-	return rtsFalse;
+    if (*name == '\0'  ||
+        (name[0] == 'g' && name[1] == 'c' && name[2] == 'c') ||
+        (name[0] == 'c' && name[1] == 'c' && name[2] == '.')) {
+        return rtsFalse;
     }
     return rtsTrue;
 #endif
@@ -829,36 +699,36 @@ extern void DEBUG_LoadSymbols( char *name )
     bfd_init();
     abfd = bfd_openr(name, "default");
     if (abfd == NULL) {
-	barf("can't open executable %s to get symbol table", name);
+        barf("can't open executable %s to get symbol table", name);
     }
     if (!bfd_check_format_matches (abfd, bfd_object, &matching)) {
-	barf("mismatch");
+        barf("mismatch");
     }
 
     {
-	long storage_needed;
-	asymbol **symbol_table;
-	long number_of_symbols;
+        long storage_needed;
+        asymbol **symbol_table;
+        long number_of_symbols;
         long num_real_syms = 0;
-	long i;
-     
-	storage_needed = bfd_get_symtab_upper_bound (abfd);
-     
-	if (storage_needed < 0) {
-	    barf("can't read symbol table");
-	}     
+        long i;
+
+        storage_needed = bfd_get_symtab_upper_bound (abfd);
+
+        if (storage_needed < 0) {
+            barf("can't read symbol table");
+        }
 #if 0
-	if (storage_needed == 0) {
-	    debugBelch("no storage needed");
-	}
+        if (storage_needed == 0) {
+            debugBelch("no storage needed");
+        }
 #endif
-	symbol_table = (asymbol **) stgMallocBytes(storage_needed,"DEBUG_LoadSymbols");
+        symbol_table = (asymbol **) stgMallocBytes(storage_needed,"DEBUG_LoadSymbols");
+
+        number_of_symbols = bfd_canonicalize_symtab (abfd, symbol_table);
 
-	number_of_symbols = bfd_canonicalize_symtab (abfd, symbol_table);
-     
-	if (number_of_symbols < 0) {
-	    barf("can't canonicalise symbol table");
-	}
+        if (number_of_symbols < 0) {
+            barf("can't canonicalise symbol table");
+        }
 
         for( i = 0; i != number_of_symbols; ++i ) {
             symbol_info info;
@@ -868,14 +738,14 @@ extern void DEBUG_LoadSymbols( char *name )
                 num_real_syms += 1;
             }
         }
-    
+
         IF_DEBUG(interpreter,
-                 debugBelch("Loaded %ld symbols. Of which %ld are real symbols\n", 
+                 debugBelch("Loaded %ld symbols. Of which %ld are real symbols\n",
                          number_of_symbols, num_real_syms)
                  );
 
         reset_table( num_real_syms );
-    
+
         for( i = 0; i != number_of_symbols; ++i ) {
             symbol_info info;
             bfd_get_symbol_info(abfd,symbol_table[i],&info);
@@ -898,7 +768,7 @@ extern void DEBUG_LoadSymbols( char *name STG_UNUSED )
 
 #endif /* HAVE_BFD_H */
 
-void findPtr(P_ p, int);		/* keep gcc -Wall happy */
+void findPtr(P_ p, int);                /* keep gcc -Wall happy */
 
 int searched = 0;
 
@@ -974,7 +844,7 @@ findPtr(P_ p, int follow)
 
    Todo: support for more closure types, and support for non pointer fields in the
    payload.
-*/ 
+*/
 
 void prettyPrintClosure_ (StgClosure *);
 
@@ -992,7 +862,7 @@ void prettyPrintClosure_ (StgClosure *obj)
     /* collapse any indirections */
     unsigned int type;
     type = get_itbl(obj)->type;
-           
+
     while (type == IND ||
            type == IND_STATIC ||
            type == IND_PERM)
@@ -1005,19 +875,19 @@ void prettyPrintClosure_ (StgClosure *obj)
     info = get_itbl(obj);
 
     /* determine what kind of object we have */
-    switch (info->type) 
+    switch (info->type)
     {
         /* full applications of data constructors */
         case CONSTR:
-        case CONSTR_1_0: 
+        case CONSTR_1_0:
         case CONSTR_0_1:
-        case CONSTR_1_1: 
-        case CONSTR_0_2: 
+        case CONSTR_1_1:
+        case CONSTR_0_2:
         case CONSTR_2_0:
         case CONSTR_STATIC:
-        case CONSTR_NOCAF_STATIC: 
+        case CONSTR_NOCAF_STATIC:
         {
-           nat i; 
+           nat i;
            char *descriptor;
 
            /* find the con_info for the constructor */
@@ -1061,7 +931,7 @@ void printPtr( StgPtr p )
 {
     debugBelch("ptr 0x%p (enable -DDEBUG for more info) " , p );
 }
-  
+
 void printObj( StgClosure *obj )
 {
     debugBelch("obj 0x%p (enable -DDEBUG for more info) " , obj );
@@ -1072,7 +942,7 @@ void printObj( StgClosure *obj )
 
 /* -----------------------------------------------------------------------------
    Closure types
-   
+
    NOTE: must be kept in sync with the closure types in includes/ClosureTypes.h
    -------------------------------------------------------------------------- */
 
@@ -1129,7 +999,7 @@ char *closure_type_names[] = {
  [MUT_VAR_CLEAN]         = "MUT_VAR_CLEAN",
  [MUT_VAR_DIRTY]         = "MUT_VAR_DIRTY",
  [WEAK]                  = "WEAK",
- [PRIM]	                 = "PRIM",
+ [PRIM]                  = "PRIM",
  [MUT_PRIM]              = "MUT_PRIM",
  [TSO]                   = "TSO",
  [STACK]                 = "STACK",
@@ -1141,17 +1011,25 @@ char *closure_type_names[] = {
 };
 
 char *
-info_type(StgClosure *closure){ 
+info_type(StgClosure *closure){
   return closure_type_names[get_itbl(closure)->type];
 }
 
 char *
-info_type_by_ip(StgInfoTable *ip){ 
+info_type_by_ip(StgInfoTable *ip){
   return closure_type_names[ip->type];
 }
 
 void
-info_hdr_type(StgClosure *closure, char *res){ 
+info_hdr_type(StgClosure *closure, char *res){
   strcpy(res,closure_type_names[get_itbl(closure)->type]);
 }
 
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/Printer.h b/rts/Printer.h
index 0dae89641476..2a35f7a36191 100644
--- a/rts/Printer.h
+++ b/rts/Printer.h
@@ -39,3 +39,11 @@ extern char *what_next_strs[];
 
 #endif /* PRINTER_H */
 
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/ProfHeap.c b/rts/ProfHeap.c
index 6d78886e39c7..067ac2305168 100644
--- a/rts/ProfHeap.c
+++ b/rts/ProfHeap.c
@@ -19,6 +19,7 @@
 #include "Arena.h"
 #include "Printer.h"
 #include "sm/GCThread.h"
+#include "Trace.h"
 
 #include <string.h>
 
@@ -142,6 +143,14 @@ closureIdentity( StgClosure *p )
             return closure_type_names[info->type];
         }
     }
+    case TRACE_HEAP_BY_CODE_PTR:
+        // FIXME: This should really not be hard-coded here, but
+        //        GET_ENTRY seems to be unusable?
+#if defined(TABLES_NEXT_TO_CODE)
+        return (void *)GET_INFO(p);
+#else
+        return (void *)GET_INFO(p)->entry;
+#endif
 
 #endif
     default:
@@ -331,16 +340,17 @@ void initProfiling2 (void)
     /* Initialise the log file name */
     hp_filename = stgMallocBytes(strlen(prog) + 6, "hpFileName");
     sprintf(hp_filename, "%s.hp", prog);
-    
+
     /* open the log file */
     if ((hp_file = fopen(hp_filename, "w")) == NULL) {
-      debugBelch("Can't open profiling report file %s\n", 
+      debugBelch("Can't open profiling report file %s\n",
 	      hp_filename);
       RtsFlags.ProfFlags.doHeapProfile = 0;
+      stgFree(prog);
       return;
     }
   }
-  
+
   stgFree(prog);
 
   initHeapProfiling();
@@ -830,6 +840,41 @@ dumpCensus( Census *census )
     printSample(rtsFalse, census->time);
 }
 
+#ifdef TRACING
+
+static void
+traceCensus( Census *census )
+{
+    counter *ctr;
+
+    // Count samples
+    nat count = 0;
+    for (ctr = census->ctrs; ctr != NULL; ctr = ctr->next)
+        count++;
+
+    // Allocate buffer for samples + weights
+    nat size = count * (sizeof(void*) + sizeof(nat));
+    StgWord8 *buf = stgMallocBytes(size, "traceCensus");
+    void **samples = (void **)buf;
+    nat *weights = (nat *)(buf + count * sizeof(void *));
+
+    // Fill
+    nat i = 0;
+    for (ctr = census->ctrs; ctr != NULL; ctr = ctr->next) {
+        samples[i] = ctr->identity;
+        weights[i] = ctr->c.resid;
+        i++;
+    }
+
+    // Trace
+    traceSamples(myTask()->cap, 1, SAMPLE_BY_HEAP_LIFE, SAMPLE_INSTR_PTR,
+                 count, samples, weights);
+
+    // Free
+    stgFree(buf);
+}
+
+#endif
 
 static void heapProfObject(Census *census, StgClosure *p, nat size,
                            rtsBool prim
@@ -1025,6 +1070,14 @@ heapCensusChain( Census *census, bdescr *bd )
 		prim = rtsTrue;
 		size = mut_arr_ptrs_sizeW((StgMutArrPtrs *)p);
 		break;
+
+	    case SMALL_MUT_ARR_PTRS_CLEAN:
+	    case SMALL_MUT_ARR_PTRS_DIRTY:
+	    case SMALL_MUT_ARR_PTRS_FROZEN:
+	    case SMALL_MUT_ARR_PTRS_FROZEN0:
+		prim = rtsTrue;
+		size = small_mut_arr_ptrs_sizeW((StgSmallMutArrPtrs *)p);
+		break;
 		
 	    case TSO:
 		prim = rtsTrue;
@@ -1110,6 +1163,7 @@ void heapCensus (Time t)
   }
 
   // dump out the census info
+  if (RtsFlags.ProfFlags.doHeapProfile < TRACE_HEAP_START) {
 #ifdef PROFILING
     // We can't generate any info for LDV profiling until
     // the end of the run...
@@ -1118,6 +1172,12 @@ void heapCensus (Time t)
 #else
     dumpCensus( census );
 #endif
+  }
+#ifdef TRACING
+  else {
+    traceCensus( census) ;
+  }
+#endif
 
 
   // free our storage, unless we're keeping all the census info for
@@ -1139,3 +1199,11 @@ void heapCensus (Time t)
 #endif
 }    
 
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/ProfHeap.h b/rts/ProfHeap.h
index b3bed903b54c..4aa3bcd05708 100644
--- a/rts/ProfHeap.h
+++ b/rts/ProfHeap.h
@@ -19,3 +19,11 @@ rtsBool strMatchesSelector (char* str, char* sel);
 #include "EndPrivate.h"
 
 #endif /* PROFHEAP_H */
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/Profiling.c b/rts/Profiling.c
index 50c9c391e71f..41c2aa5f8a12 100644
--- a/rts/Profiling.c
+++ b/rts/Profiling.c
@@ -619,10 +619,8 @@ actualPush_ (CostCentreStack *ccs, CostCentre *cc, CostCentreStack *new_ccs)
     ccsSetSelected(new_ccs);
 
     /* update the memoization table for the parent stack */
-    if (ccs != EMPTY_STACK) {
-        ccs->indexTable = addToIndexTable(ccs->indexTable, new_ccs, cc,
-                                          0/*not a back edge*/);
-    }
+    ccs->indexTable = addToIndexTable(ccs->indexTable, new_ccs, cc,
+                                      0/*not a back edge*/);
 
     /* return a pointer to the new stack */
     return new_ccs;
@@ -1147,3 +1145,11 @@ debugCCS( CostCentreStack *ccs )
 #endif /* DEBUG */
 
 #endif /* PROFILING */
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/Profiling.h b/rts/Profiling.h
index 8c365220fb98..6d5950c62bbc 100644
--- a/rts/Profiling.h
+++ b/rts/Profiling.h
@@ -46,3 +46,11 @@ void debugCCS( CostCentreStack *ccs );
 #include "EndPrivate.h"
 
 #endif /* PROFILING_H */
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/Proftimer.c b/rts/Proftimer.c
index 6458f6e0956f..d0e6aa79d511 100644
--- a/rts/Proftimer.c
+++ b/rts/Proftimer.c
@@ -89,3 +89,11 @@ handleProfTick(void)
 	}
     }
 }
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/Proftimer.h b/rts/Proftimer.h
index 4bb063fbbcc4..b8f2aa80c55e 100644
--- a/rts/Proftimer.h
+++ b/rts/Proftimer.h
@@ -22,3 +22,11 @@ extern rtsBool performHeapProfile;
 #include "EndPrivate.h"
 
 #endif /* PROFTIMER_H */
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/RaiseAsync.c b/rts/RaiseAsync.c
index a5440e40adbf..7da3e6452d7e 100644
--- a/rts/RaiseAsync.c
+++ b/rts/RaiseAsync.c
@@ -1051,3 +1051,11 @@ raiseAsync(Capability *cap, StgTSO *tso, StgClosure *exception,
 }
 
 
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/RaiseAsync.h b/rts/RaiseAsync.h
index 1f61b8c72dfc..d0c9efcbee2c 100644
--- a/rts/RaiseAsync.h
+++ b/rts/RaiseAsync.h
@@ -52,6 +52,7 @@ interruptible(StgTSO *t)
 {
   switch (t->why_blocked) {
   case BlockedOnMVar:
+  case BlockedOnSTM:
   case BlockedOnMVarRead:
   case BlockedOnMsgThrowTo:
   case BlockedOnRead:
@@ -74,3 +75,11 @@ interruptible(StgTSO *t)
 
 #endif /* RAISEASYNC_H */
 
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/RetainerProfile.c b/rts/RetainerProfile.c
index 8cf88487f2c6..d0e95d8ebb03 100644
--- a/rts/RetainerProfile.c
+++ b/rts/RetainerProfile.c
@@ -30,6 +30,7 @@
 #include "Stats.h"
 #include "ProfHeap.h"
 #include "Apply.h"
+#include "Stable.h" /* markStableTables */
 #include "sm/Storage.h" // for END_OF_STATIC_LIST
 
 /*
@@ -530,6 +531,18 @@ push( StgClosure *c, retainer c_child_r, StgClosure **first_child )
 	    return;
 	break;
 
+	// StgMutArrPtr.ptrs, no SRT
+    case SMALL_MUT_ARR_PTRS_CLEAN:
+    case SMALL_MUT_ARR_PTRS_DIRTY:
+    case SMALL_MUT_ARR_PTRS_FROZEN:
+    case SMALL_MUT_ARR_PTRS_FROZEN0:
+	init_ptrs(&se.info, ((StgSmallMutArrPtrs *)c)->ptrs,
+		  (StgPtr)(((StgSmallMutArrPtrs *)c)->payload));
+	*first_child = find_ptrs(&se.info);
+	if (*first_child == NULL)
+	    return;
+	break;
+
     // layout.payload.ptrs, SRT
     case FUN:           // *c is a heap object.
     case FUN_2_0:
@@ -1768,6 +1781,12 @@ computeRetainerSet( void )
     //
     // The following code assumes that WEAK objects are considered to be roots
     // for retainer profilng.
+    for (n = 0; n < n_capabilities; n++) {
+        // NB: after a GC, all nursery weak_ptr_lists have been migrated
+        // to the global lists living in the generations
+        ASSERT(capabilities[n]->weak_ptr_list_hd == NULL);
+        ASSERT(capabilities[n]->weak_ptr_list_tl == NULL);
+    }
     for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
         for (weak = generations[g].weak_ptr_list; weak != NULL; weak = weak->link) {
             // retainRoot((StgClosure *)weak);
@@ -2267,3 +2286,11 @@ belongToHeap(StgPtr p)
 #endif /* DEBUG_RETAINER */
 
 #endif /* PROFILING */
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/RetainerProfile.h b/rts/RetainerProfile.h
index d92563ffbb1b..d24f99428c63 100644
--- a/rts/RetainerProfile.h
+++ b/rts/RetainerProfile.h
@@ -51,3 +51,11 @@ extern W_ retainerStackBlocks ( void );
 #endif /* PROFILING */
 
 #endif /* RETAINERPROFILE_H */
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/RetainerSet.c b/rts/RetainerSet.c
index d93ae4bd1660..075dd7560f70 100644
--- a/rts/RetainerSet.c
+++ b/rts/RetainerSet.c
@@ -24,17 +24,17 @@
 #define hash(hk)  (hk % HASH_TABLE_SIZE)
 static RetainerSet *hashTable[HASH_TABLE_SIZE];
 
-static Arena *arena;		// arena in which we store retainer sets
+static Arena *arena;            // arena in which we store retainer sets
 
-static int nextId;              // id of next retainer set       
+static int nextId;              // id of next retainer set
 
 /* -----------------------------------------------------------------------------
  * rs_MANY is a distinguished retainer set, such that
  *
  *        isMember(e, rs_MANY)   = True
  *
- *	  addElement(e, rs)      = rs_MANY,   if rs->num >= maxRetainerSetSize
- *	  addElement(e, rs_MANY) = rs_MANY
+ *        addElement(e, rs)      = rs_MANY,   if rs->num >= maxRetainerSetSize
+ *        addElement(e, rs_MANY) = rs_MANY
  *
  * The point of rs_MANY is to keep the total number of retainer sets
  * from growing too large.
@@ -68,7 +68,7 @@ initializeAllRetainerSet(void)
     arena = newArena();
 
     for (i = 0; i < HASH_TABLE_SIZE; i++)
-	hashTable[i] = NULL;
+        hashTable[i] = NULL;
     nextId = 2;   // Initial value must be positive, 2 is MANY.
 }
 
@@ -86,7 +86,7 @@ refreshAllRetainerSet(void)
     arena = newArena();
 
     for (i = 0; i < HASH_TABLE_SIZE; i++)
-	hashTable[i] = NULL;
+        hashTable[i] = NULL;
     nextId = 2;
 #endif /* FIRST_APPROACH */
 }
@@ -111,7 +111,7 @@ singleton(retainer r)
 
     hk = hashKeySingleton(r);
     for (rs = hashTable[hash(hk)]; rs != NULL; rs = rs->link)
-	if (rs->num == 1 &&  rs->element[0] == r) return rs;    // found it
+        if (rs->num == 1 &&  rs->element[0] == r) return rs;    // found it
 
     // create it
     rs = arenaAlloc( arena, sizeofRetainerSet(1) );
@@ -153,13 +153,13 @@ addElement(retainer r, RetainerSet *rs)
     ASSERT(rs->num <= RtsFlags.ProfFlags.maxRetainerSetSize);
 
     if (rs == &rs_MANY || rs->num == RtsFlags.ProfFlags.maxRetainerSetSize) {
-	return &rs_MANY;
+        return &rs_MANY;
     }
 
     ASSERT(!isMember(r, rs));
 
     for (nl = 0; nl < rs->num; nl++)
-	if (r < rs->element[nl]) break;
+        if (r < rs->element[nl]) break;
     // Now nl is the index for r into the new set.
     // Also it denotes the number of retainers less than r in *rs.
     // Thus, compare the first nl retainers, then r itself, and finally the
@@ -167,29 +167,29 @@ addElement(retainer r, RetainerSet *rs)
 
     hk = hashKeyAddElement(r, rs);
     for (nrs = hashTable[hash(hk)]; nrs != NULL; nrs = nrs->link) {
-	// test *rs and *nrs for equality
+        // test *rs and *nrs for equality
 
-	// check their size
-	if (rs->num + 1 != nrs->num) continue;
+        // check their size
+        if (rs->num + 1 != nrs->num) continue;
 
-	// compare the first nl retainers and find the first non-matching one.
-	for (i = 0; i < nl; i++)
-	    if (rs->element[i] != nrs->element[i]) break;
-	if (i < nl) continue;
+        // compare the first nl retainers and find the first non-matching one.
+        for (i = 0; i < nl; i++)
+            if (rs->element[i] != nrs->element[i]) break;
+        if (i < nl) continue;
 
-	// compare r itself
-	if (r != nrs->element[i]) continue;       // i == nl
+        // compare r itself
+        if (r != nrs->element[i]) continue;       // i == nl
 
-	// compare the remaining retainers
-	for (; i < rs->num; i++)
-	    if (rs->element[i] != nrs->element[i + 1]) break;
-	if (i < rs->num) continue;
+        // compare the remaining retainers
+        for (; i < rs->num; i++)
+            if (rs->element[i] != nrs->element[i + 1]) break;
+        if (i < rs->num) continue;
 
 #ifdef DEBUG_RETAINER
-	// debugBelch("%p\n", nrs);
+        // debugBelch("%p\n", nrs);
 #endif
-	// The set we are seeking already exists!
-	return nrs;
+        // The set we are seeking already exists!
+        return nrs;
     }
 
     // create a new retainer set
@@ -199,11 +199,11 @@ addElement(retainer r, RetainerSet *rs)
     nrs->link = hashTable[hash(hk)];
     nrs->id = nextId++;
     for (i = 0; i < nl; i++) {              // copy the first nl retainers
-	nrs->element[i] = rs->element[i];
+        nrs->element[i] = rs->element[i];
     }
     nrs->element[i] = r;                    // copy r
     for (; i < rs->num; i++) {              // copy the remaining retainers
-	nrs->element[i + 1] = rs->element[i];
+        nrs->element[i + 1] = rs->element[i];
     }
 
     hashTable[hash(hk)] = nrs;
@@ -225,8 +225,8 @@ traverseAllRetainerSet(void (*f)(RetainerSet *))
 
     (*f)(&rs_MANY);
     for (i = 0; i < HASH_TABLE_SIZE; i++)
-	for (rs = hashTable[i]; rs != NULL; rs = rs->link)
-	    (*f)(rs);
+        for (rs = hashTable[i]; rs != NULL; rs = rs->link)
+            (*f)(rs);
 }
 
 
@@ -281,20 +281,20 @@ printRetainerSetShort(FILE *f, RetainerSet *rs, nat max_length)
     ASSERT(size < max_length);
 
     for (j = 0; j < rs->num; j++) {
-	if (j < rs->num - 1) {
-	    strncpy(tmp + size, GET_PROF_DESC(rs->element[j]), max_length - size);
-	    size = strlen(tmp);
-	    if (size == max_length)
-		break;
-	    strncpy(tmp + size, ",", max_length - size);
-	    size = strlen(tmp);
-	    if (size == max_length)
-		break;
-	}
-	else {
-	    strncpy(tmp + size, GET_PROF_DESC(rs->element[j]), max_length - size);
-	    // size = strlen(tmp);
-	}
+        if (j < rs->num - 1) {
+            strncpy(tmp + size, GET_PROF_DESC(rs->element[j]), max_length - size);
+            size = strlen(tmp);
+            if (size == max_length)
+                break;
+            strncpy(tmp + size, ",", max_length - size);
+            size = strlen(tmp);
+            if (size == max_length)
+                break;
+        }
+        else {
+            strncpy(tmp + size, GET_PROF_DESC(rs->element[j]), max_length - size);
+            // size = strlen(tmp);
+        }
     }
     fprintf(f, tmp);
 }
@@ -327,20 +327,20 @@ printRetainerSetShort(FILE *f, RetainerSet *rs, nat max_length)
     ASSERT(size < max_length);
 
     for (j = 0; j < rs->num; j++) {
-	if (j < rs->num - 1) {
-	    strncpy(tmp + size, rs->element[j]->cc->label, max_length - size);
-	    size = strlen(tmp);
-	    if (size == max_length)
-		break;
-	    strncpy(tmp + size, ",", max_length - size);
-	    size = strlen(tmp);
-	    if (size == max_length)
-		break;
-	}
-	else {
-	    strncpy(tmp + size, rs->element[j]->cc->label, max_length - size);
-	    // size = strlen(tmp);
-	}
+        if (j < rs->num - 1) {
+            strncpy(tmp + size, rs->element[j]->cc->label, max_length - size);
+            size = strlen(tmp);
+            if (size == max_length)
+                break;
+            strncpy(tmp + size, ",", max_length - size);
+            size = strlen(tmp);
+            if (size == max_length)
+                break;
+        }
+        else {
+            strncpy(tmp + size, rs->element[j]->cc->label, max_length - size);
+            // size = strlen(tmp);
+        }
     }
     fputs(tmp, f);
 }
@@ -363,22 +363,22 @@ printRetainerSetShort(FILE *f, retainerSet *rs, nat max_length)
     ASSERT(size < max_length);
 
     for (j = 0; j < rs->num; j++) {
-	if (j < rs->num - 1) {
-	    strncpy(tmp + size, rs->element[j]->label,
-		    max_length - size);
-	    size = strlen(tmp);
-	    if (size == max_length)
-		break;
-	    strncpy(tmp + size, ",", max_length - size);
-	    size = strlen(tmp);
-	    if (size == max_length)
-		break;
-	}
-	else {
-	    strncpy(tmp + size, rs->element[j]->label,
-		    max_length - size);
-	    // size = strlen(tmp);
-	}
+        if (j < rs->num - 1) {
+            strncpy(tmp + size, rs->element[j]->label,
+                    max_length - size);
+            size = strlen(tmp);
+            if (size == max_length)
+                break;
+            strncpy(tmp + size, ",", max_length - size);
+            size = strlen(tmp);
+            if (size == max_length)
+                break;
+        }
+        else {
+            strncpy(tmp + size, rs->element[j]->label,
+                    max_length - size);
+            // size = strlen(tmp);
+        }
     }
     fprintf(f, tmp);
 /*
@@ -426,7 +426,7 @@ printRetainerSetShort(FILE *f, retainerSet *rs, nat max_length)
  * Dump the contents of each retainer set into the log file at the end
  * of the run, so the user can find out for a given retainer set ID
  * the full contents of that set.
- * --------------------------------------------------------------------------- */
+ * -------------------------------------------------------------------------- */
 #ifdef SECOND_APPROACH
 void
 outputAllRetainerSet(FILE *prof_file)
@@ -439,51 +439,51 @@ outputAllRetainerSet(FILE *prof_file)
     // least once during retainer profiling
     numSet = 0;
     for (i = 0; i < HASH_TABLE_SIZE; i++)
-	for (rs = hashTable[i]; rs != NULL; rs = rs->link) {
-	    if (rs->id < 0)
-		numSet++;
-	}
+        for (rs = hashTable[i]; rs != NULL; rs = rs->link) {
+            if (rs->id < 0)
+                numSet++;
+        }
 
     if (numSet == 0)      // retainer profiling was not done at all.
-	return;
+        return;
 
     // allocate memory
     rsArray = stgMallocBytes(numSet * sizeof(RetainerSet *),
-			     "outputAllRetainerSet()");
+                             "outputAllRetainerSet()");
 
     // prepare for sorting
     j = 0;
     for (i = 0; i < HASH_TABLE_SIZE; i++)
-	for (rs = hashTable[i]; rs != NULL; rs = rs->link) {
-	    if (rs->id < 0) {
-		rsArray[j] = rs;
-		j++;
-	    }
-	}
+        for (rs = hashTable[i]; rs != NULL; rs = rs->link) {
+            if (rs->id < 0) {
+                rsArray[j] = rs;
+                j++;
+            }
+        }
 
     ASSERT(j == numSet);
 
     // sort rsArray[] according to the id of each retainer set
     for (i = numSet - 1; i > 0; i--) {
-	for (j = 0; j <= i - 1; j++) {
-	    // if (-(rsArray[j]->id) < -(rsArray[j + 1]->id))
-	    if (rsArray[j]->id < rsArray[j + 1]->id) {
-		tmp = rsArray[j];
-		rsArray[j] = rsArray[j + 1];
-		rsArray[j + 1] = tmp;
-	    }
-	}
+        for (j = 0; j <= i - 1; j++) {
+            // if (-(rsArray[j]->id) < -(rsArray[j + 1]->id))
+            if (rsArray[j]->id < rsArray[j + 1]->id) {
+                tmp = rsArray[j];
+                rsArray[j] = rsArray[j + 1];
+                rsArray[j + 1] = tmp;
+            }
+        }
     }
 
     fprintf(prof_file, "\nRetainer sets created during profiling:\n");
     for (i = 0;i < numSet; i++) {
-	fprintf(prof_file, "SET %u = {", -(rsArray[i]->id));
-	for (j = 0; j < rsArray[i]->num - 1; j++) {
-	    printRetainer(prof_file, rsArray[i]->element[j]);
-	    fprintf(prof_file, ", ");
-	}
-	printRetainer(prof_file, rsArray[i]->element[j]);
-	fprintf(prof_file, "}\n");
+        fprintf(prof_file, "SET %u = {", -(rsArray[i]->id));
+        for (j = 0; j < rsArray[i]->num - 1; j++) {
+            printRetainer(prof_file, rsArray[i]->element[j]);
+            fprintf(prof_file, ", ");
+        }
+        printRetainer(prof_file, rsArray[i]->element[j]);
+        fprintf(prof_file, "}\n");
     }
 
     stgFree(rsArray);
@@ -491,3 +491,11 @@ outputAllRetainerSet(FILE *prof_file)
 #endif /* SECOND_APPROACH */
 
 #endif /* PROFILING */
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/RetainerSet.h b/rts/RetainerSet.h
index 5004527d2173..5f24d84063c1 100644
--- a/rts/RetainerSet.h
+++ b/rts/RetainerSet.h
@@ -20,7 +20,7 @@
   Type 'retainer' defines the retainer identity.
 
   Invariant:
-    1. The retainer identity of a given retainer cannot change during 
+    1. The retainer identity of a given retainer cannot change during
     program execution, no matter where it is actually stored.
     For instance, the memory address of a retainer cannot be used as
     its retainer identity because its location may change during garbage
@@ -56,7 +56,7 @@ typedef CostCentre *retainer;
 #endif
 
 /*
-  Type 'retainerSet' defines an abstract datatype for sets of retainers.  
+  Type 'retainerSet' defines an abstract datatype for sets of retainers.
 
   Invariants:
     A retainer set stores its elements in increasing order (in element[] array).
@@ -75,13 +75,13 @@ typedef struct _RetainerSet {
 } RetainerSet;
 
 /*
-  Note: 
+  Note:
     There are two ways of maintaining all retainer sets. The first is simply by
     freeing all the retainer sets and re-initialize the hash table at each
-    retainer profiling. The second is by setting the cost field of each 
-    retainer set. The second is preferred to the first if most retainer sets 
-    are likely to be observed again during the next retainer profiling. Note 
-    that in the first approach, we do not free the memory allocated for 
+    retainer profiling. The second is by setting the cost field of each
+    retainer set. The second is preferred to the first if most retainer sets
+    are likely to be observed again during the next retainer profiling. Note
+    that in the first approach, we do not free the memory allocated for
     retainer sets; we just invalidate all retainer sets.
  */
 #ifdef DEBUG_RETAINER
@@ -108,12 +108,12 @@ RetainerSet *singleton(retainer r);
 extern RetainerSet rs_MANY;
 
 // Checks if a given retainer is a memeber of the retainer set.
-// 
+//
 // Note & (maybe) Todo:
 //   This function needs to be declared as an inline function, so it is declared
 //   as an inline static function here.
 //   This make the interface really bad, but isMember() returns a value, so
-//   it is not easy either to write it as a macro (due to my lack of C 
+//   it is not easy either to write it as a macro (due to my lack of C
 //   programming experience). Sungwoo
 //
 // rtsBool isMember(retainer, retainerSet *);
@@ -124,7 +124,7 @@ extern RetainerSet rs_MANY;
   Note:
     The efficiency of this function is subject to the typical size of
     retainer sets. If it is small, linear scan is better. If it
-    is large in most cases, binary scan is better. 
+    is large in most cases, binary scan is better.
     The current implementation mixes the two search strategies.
  */
 
@@ -169,7 +169,7 @@ void printRetainerSetShort(FILE *, RetainerSet *, nat);
 #endif
 
 // Print the statistics on all the retainer sets.
-// store the sum of all costs and the number of all retainer sets. 
+// store the sum of all costs and the number of all retainer sets.
 void outputRetainerSet(FILE *, nat *, nat *);
 
 #ifdef SECOND_APPROACH
@@ -203,3 +203,11 @@ void printRetainer(FILE *, retainer);
 
 #endif /* PROFILING */
 #endif /* RETAINERSET_H */
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/RtsAPI.c b/rts/RtsAPI.c
index 725bfeb0b564..7062306c7431 100644
--- a/rts/RtsAPI.c
+++ b/rts/RtsAPI.c
@@ -614,3 +614,17 @@ rts_unlock (Capability *cap)
       traceTaskDelete(task);
     }
 }
+
+void rts_done (void)
+{
+    freeMyTask();
+}
+
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/RtsDllMain.c b/rts/RtsDllMain.c
index 06c565588f01..6bb3db1bd681 100644
--- a/rts/RtsDllMain.c
+++ b/rts/RtsDllMain.c
@@ -21,8 +21,8 @@ BOOL
 WINAPI
 DllMain ( HINSTANCE hInstance STG_UNUSED
         , DWORD reason
-	, LPVOID reserved STG_UNUSED
-	)
+        , LPVOID reserved STG_UNUSED
+        )
 {
   /*
    * Note: the DllMain() doesn't call startupHaskell() for you,
@@ -31,13 +31,21 @@ DllMain ( HINSTANCE hInstance STG_UNUSED
    *       you pass to the RTS.
    */
   switch (reason) {
-  
+
   // shutdownHaskelAndExit() is already being called,
-  //	so I don't think we need this. BL 2009/11/17
- 
+  //    so I don't think we need this. BL 2009/11/17
+
   //case DLL_PROCESS_DETACH: shutdownHaskell();
   }
   return TRUE;
 }
 
 #endif
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/RtsDllMain.h b/rts/RtsDllMain.h
index d781127079d0..514796278022 100644
--- a/rts/RtsDllMain.h
+++ b/rts/RtsDllMain.h
@@ -1,4 +1,3 @@
-
 #include "Rts.h"
 
 #ifdef HAVE_WINDOWS_H
@@ -15,3 +14,10 @@ DllMain ( HINSTANCE hInstance
        );
 #endif
 
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/RtsFlags.c b/rts/RtsFlags.c
index 573e701dc76a..67e9721b8d78 100644
--- a/rts/RtsFlags.c
+++ b/rts/RtsFlags.c
@@ -29,6 +29,10 @@
 #include <sys/types.h>
 #endif
 
+#ifdef TRACING
+#include "Trace.h"
+#endif
+
 // Flag Structure
 RTS_FLAGS RtsFlags;
 
@@ -97,12 +101,12 @@ void initRtsFlagsDefaults(void)
     StgWord64 maxStkSize = 8 * getPhysicalMemorySize() / 10;
     // if getPhysicalMemorySize fails just move along with an 8MB limit
     if (maxStkSize == 0)
-        maxStkSize = (8 * 1024 * 1024) / sizeof(W_);
+        maxStkSize = 8 * 1024 * 1024;
 
     RtsFlags.GcFlags.statsFile          = NULL;
     RtsFlags.GcFlags.giveStats          = NO_GC_STATS;
 
-    RtsFlags.GcFlags.maxStkSize         = maxStkSize;
+    RtsFlags.GcFlags.maxStkSize         = maxStkSize / sizeof(W_);
     RtsFlags.GcFlags.initialStkSize     = 1024 / sizeof(W_);
     RtsFlags.GcFlags.stkChunkSize       = (32 * 1024) / sizeof(W_);
     RtsFlags.GcFlags.stkChunkBufferSize = (1 * 1024) / sizeof(W_);
@@ -185,6 +189,9 @@ void initRtsFlagsDefaults(void)
     RtsFlags.TraceFlags.sparks_sampled= rtsFalse;
     RtsFlags.TraceFlags.sparks_full   = rtsFalse;
     RtsFlags.TraceFlags.user          = rtsFalse;
+
+    RtsFlags.TraceFlags.allocSampling = rtsFalse;
+    RtsFlags.TraceFlags.timerSampling = rtsFalse;
 #endif
 
 #ifdef PROFILING
@@ -224,6 +231,13 @@ void initRtsFlagsDefaults(void)
     RtsFlags.PapiFlags.eventType        = 0;
     RtsFlags.PapiFlags.numUserEvents    = 0;
 #endif
+
+#ifdef USE_PERF_EVENT
+#ifdef TRACING
+    RtsFlags.PerfEventFlags.sampleType   = 0;
+    RtsFlags.PerfEventFlags.samplePeriod = 0;
+#endif
+#endif
 }
 
 static const char *
@@ -241,7 +255,8 @@ usage_text[] = {
 "  -?       Prints this message and exits; the program is not executed",
 "  --info   Print information about the RTS used by this program",
 "",
-"  -K<size> Sets the maximum stack size (default 8M)  Egs: -K32k   -K512k",
+"  -K<size>  Sets the maximum stack size (default: 80% of the heap)",
+"            Egs: -K32k -K512k -K8M",
 "  -ki<size> Sets the initial thread stack size (default 1k)  Egs: -ki4k -ki2m",
 "  -kc<size> Sets the stack chunk size (default 32k)",
 "  -kb<size> Sets the stack chunk buffer size (default 1k)",
@@ -402,6 +417,25 @@ usage_text[] = {
 "            +PAPI_EVENT   - collect papi preset event PAPI_EVENT",
 "            #NATIVE_EVENT - collect native event NATIVE_EVENT (in hex)",
 #endif
+#ifdef TRACING
+"  -E[<x>][<p>] Sample instruction pointers for profiling (use with -l)",
+"            Samples are taken at intervals of <p> by <x>:",
+#ifdef USE_PERF_EVENT
+"             t   - time",
+"             h   - heap residency",
+"             a   - heap allocation",
+"             s   - stack allocation",
+"             y   - cycles (default)",
+"             c/C - cache access / miss",
+"             b/B - branch / branch mispredict",
+"             l/L - stalled in frontend / backend",
+#else
+"             t   - time (default)",
+"             h   - heap residency",
+"             a   - heap allocation (default)",
+"             s   - stack allocation",
+#endif
+#endif
 "",
 "RTS options may also be specified using the GHCRTS environment variable.",
 "",
@@ -775,6 +809,95 @@ error = rtsTrue;
                 break;
 #endif
 
+#ifdef TRACING
+            case 'E':
+                OPTION_UNSAFE;
+                {
+                    char *p = rts_argv[arg] + 2;
+                    nat period = 0;
+                    if (*p) {
+                        // Get desired period, if any
+                        char *next=p+1;
+                        if (isdigit(*next)) {
+                            period = strtol(next, &next, 10);
+                        }
+                        if (*next) {
+                            bad_option(rts_argv[arg]);
+                            break;
+                        }
+                    }
+                    switch(*p) {
+#ifdef USE_PERF_EVENT
+                    case 'c':
+                        RtsFlags.PerfEventFlags.sampleType =
+                            PERF_EVENT_SAMPLE_BY_CACHE;
+                        RtsFlags.PerfEventFlags.samplePeriod = period;
+                        break;
+                    case 'C':
+                        RtsFlags.PerfEventFlags.sampleType =
+                            PERF_EVENT_SAMPLE_BY_CACHE_MISS;
+                        RtsFlags.PerfEventFlags.samplePeriod = period;
+                        break;
+                    case 'b':
+                        RtsFlags.PerfEventFlags.sampleType =
+                            PERF_EVENT_SAMPLE_BY_BRANCH;
+                        RtsFlags.PerfEventFlags.samplePeriod = period;
+                        break;
+                    case 'B':
+                        RtsFlags.PerfEventFlags.sampleType =
+                            PERF_EVENT_SAMPLE_BY_BRANCH_MISS;
+                        RtsFlags.PerfEventFlags.samplePeriod = period;
+                        break;
+                    case 'l':
+                        RtsFlags.PerfEventFlags.sampleType =
+                            PERF_EVENT_SAMPLE_BY_STALLED_FE;
+                        RtsFlags.PerfEventFlags.samplePeriod = period;
+                        break;
+                    case 'L':
+                        RtsFlags.PerfEventFlags.sampleType =
+                            PERF_EVENT_SAMPLE_BY_STALLED_BE;
+                        RtsFlags.PerfEventFlags.samplePeriod = period;
+                        break;
+                    case 0:
+                    case 'y':
+                        RtsFlags.PerfEventFlags.sampleType =
+                            PERF_EVENT_SAMPLE_BY_CYCLE;
+                        RtsFlags.PerfEventFlags.samplePeriod = period;
+                        break;
+#else
+                    case 0:
+#endif
+                    case 't':
+                        RtsFlags.TraceFlags.timerSampling = rtsTrue;
+                        if (period != 0) {
+                            errorBelch("Custom periods not supported for timer sampling, try -V!");
+                        }
+                        break;
+                    case 'a':
+                        RtsFlags.TraceFlags.allocSampling = SAMPLE_BY_HEAP_ALLOC;
+                        if (period != 0) {
+                            errorBelch("Custom periods not supported for heap allocation sampling, try -A!");
+                        }
+                        break;
+                    case 's':
+                        RtsFlags.TraceFlags.allocSampling = SAMPLE_BY_STACK_ALLOC;
+                        if (period != 0) {
+                            errorBelch("Custom periods not supported for stack allocation sampling, try -kc!");
+                        }
+                        break;
+                    case 'h':
+                        RtsFlags.ProfFlags.doHeapProfile = TRACE_HEAP_BY_CODE_PTR;
+                        if (period != 0) {
+                            errorBelch("Custom periods not supported for heap residency sampling, try -i!");
+                        }
+                        break;
+                    default:
+                        bad_option(rts_argv[arg]);
+                    }
+                }
+                break;
+#endif
+
               case 'B':
                 OPTION_UNSAFE;
                 RtsFlags.GcFlags.ringBell = rtsTrue;
@@ -1858,3 +1981,11 @@ void freeRtsArgs(void)
     freeProgArgv();
     freeRtsArgv();
 }
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/RtsFlags.h b/rts/RtsFlags.h
index b3627e0e487e..0e212b4ca93e 100644
--- a/rts/RtsFlags.h
+++ b/rts/RtsFlags.h
@@ -25,3 +25,11 @@ void freeRtsArgs          (void);
 #include "EndPrivate.h"
 
 #endif /* RTSFLAGS_H */
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/RtsMain.c b/rts/RtsMain.c
index df637169f8eb..ea45d6f0508e 100644
--- a/rts/RtsMain.c
+++ b/rts/RtsMain.c
@@ -117,3 +117,11 @@ int hs_main (int argc, char *argv[],     // program args
 #endif
 }
 # endif /* BATCH_MODE */
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/RtsMessages.c b/rts/RtsMessages.c
index 6e75abc8a5b2..83758175e2f5 100644
--- a/rts/RtsMessages.c
+++ b/rts/RtsMessages.c
@@ -283,3 +283,11 @@ rtsDebugMsgFn(const char *s, va_list ap)
      fflush(stderr);
   }
 }
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/RtsSignals.h b/rts/RtsSignals.h
index be21765dd699..a319713dbe17 100644
--- a/rts/RtsSignals.h
+++ b/rts/RtsSignals.h
@@ -65,3 +65,11 @@ void markSignalHandlers (evac_fn evac, void *user);
 #endif /* RTS_USER_SIGNALS */
 
 #endif /* RTSSIGNALS_H */
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/RtsStartup.c b/rts/RtsStartup.c
index aa7306f88a33..9260c92ec5b4 100644
--- a/rts/RtsStartup.c
+++ b/rts/RtsStartup.c
@@ -62,6 +62,10 @@ void exitLinker( void );	// there is no Linker.h file to include
 #include "Papi.h"
 #endif
 
+#if USE_DWARF
+#include "Dwarf.h"
+#endif
+
 // Count of how many outstanding hs_init()s there have been.
 static int hs_init_count = 0;
 
@@ -214,6 +218,7 @@ hs_init_ghc(int *argc, char **argv[], RtsConfig rts_config)
     getStablePtr((StgPtr)ensureIOManagerIsRunning_closure);
     getStablePtr((StgPtr)ioManagerCapabilitiesChanged_closure);
 #ifndef mingw32_HOST_OS
+    getStablePtr((StgPtr)blockedOnBadFD_closure);
     getStablePtr((StgPtr)runHandlers_closure);
 #endif
 
@@ -251,6 +256,18 @@ hs_init_ghc(int *argc, char **argv[], RtsConfig rts_config)
     x86_init_fpu();
 #endif
 
+
+#ifdef USE_DWARF
+#ifdef TRACING
+    // If tracing is active, load and write out debuging information
+    if (RtsFlags.TraceFlags.tracing) {
+        dwarf_load();
+        dwarf_trace_debug_data();
+        dwarf_free();
+    }
+#endif
+#endif
+
     startupHpc();
 
     // This must be done after module initialisation.
@@ -304,7 +321,7 @@ hs_add_root(void (*init_root)(void) STG_UNUSED)
 static void
 hs_exit_(rtsBool wait_foreign)
 {
-    nat g;
+    nat g, i;
 
     if (hs_init_count <= 0) {
 	errorBelch("warning: too many hs_exit()s");
@@ -336,6 +353,9 @@ hs_exit_(rtsBool wait_foreign)
     exitScheduler(wait_foreign);
 
     /* run C finalizers for all active weak pointers */
+    for (i = 0; i < n_capabilities; i++) {
+        runAllCFinalizers(capabilities[i]->weak_ptr_list_hd);
+    }
     for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
         runAllCFinalizers(generations[g].weak_ptr_list);
     }
@@ -355,8 +375,12 @@ hs_exit_(rtsBool wait_foreign)
     resetTerminalSettings();
 #endif
 
-    // uninstall signal handlers
-    resetDefaultHandlers();
+#if defined(RTS_USER_SIGNALS)
+    if (RtsFlags.MiscFlags.install_signal_handlers) {
+        // uninstall signal handlers
+        resetDefaultHandlers();
+    }
+#endif
 
     /* stop timing the shutdown, we're about to print stats */
     stat_endExit();
@@ -535,3 +559,11 @@ stg_exit(int n)
     (*exitFn)(n);
   exit(n);
 }
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/RtsUtils.c b/rts/RtsUtils.c
index 185f1e8bdd1f..811dcf1b4c80 100644
--- a/rts/RtsUtils.c
+++ b/rts/RtsUtils.c
@@ -329,3 +329,11 @@ void checkFPUStack(void)
 #endif
 }
 
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/RtsUtils.h b/rts/RtsUtils.h
index 5d825a2118e1..88b0af285c8e 100644
--- a/rts/RtsUtils.h
+++ b/rts/RtsUtils.h
@@ -48,3 +48,11 @@ void checkFPUStack(void);
 #include "EndPrivate.h"
 
 #endif /* RTSUTILS_H */
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/STM.c b/rts/STM.c
index bea0356403cf..6dc3e40c4e5a 100644
--- a/rts/STM.c
+++ b/rts/STM.c
@@ -1696,3 +1696,11 @@ void stmWriteTVar(Capability *cap,
 }
 
 /*......................................................................*/
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/STM.h b/rts/STM.h
index ffec009577f9..fc5523ea9cf9 100644
--- a/rts/STM.h
+++ b/rts/STM.h
@@ -221,3 +221,11 @@ void stmWriteTVar(Capability *cap,
 
 #endif /* STM_H */
 
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/Schedule.c b/rts/Schedule.c
index adf2b5cb398a..6d8e4585ea56 100644
--- a/rts/Schedule.c
+++ b/rts/Schedule.c
@@ -400,6 +400,26 @@ schedule (Capability *initialCapability, Task *task)
 
     startHeapProfTimer();
 
+#ifdef TRACING
+    switch(RtsFlags.TraceFlags.allocSampling) {
+    case 0: break;
+    case SAMPLE_BY_HEAP_ALLOC:
+        if (!cap->heap_ip_sample_count) break;
+        traceSamples(cap, 1, RtsFlags.TraceFlags.allocSampling, SAMPLE_INSTR_PTR,
+                     cap->heap_ip_sample_count, cap->heap_ip_samples, NULL);
+        cap->heap_ip_sample_count = 0;
+        break;
+    case SAMPLE_BY_STACK_ALLOC:
+        if (cap->heap_ip_sample_count >= 2*HEAP_ALLOC_MAX_SAMPLES) break;
+        traceSamples(cap, 1, RtsFlags.TraceFlags.allocSampling, SAMPLE_INSTR_PTR,
+                     2*HEAP_ALLOC_MAX_SAMPLES-cap->heap_ip_sample_count, cap->heap_ip_samples, NULL);
+        cap->heap_ip_sample_count = 2*HEAP_ALLOC_MAX_SAMPLES;
+        break;
+    default:
+        barf("Unknown allocation sampling method %d", RtsFlags.TraceFlags.allocSampling);
+    }
+#endif
+
     // ----------------------------------------------------------------------
     // Run the current thread 
 
@@ -1802,6 +1822,10 @@ forkProcess(HsStablePtr *entry
         ACQUIRE_LOCK(&capabilities[i]->lock);
     }
 
+#ifdef THREADED_RTS
+    ACQUIRE_LOCK(&all_tasks_mutex);
+#endif
+
     stopTimer(); // See #4074
 
 #if defined(TRACING)
@@ -1823,13 +1847,18 @@ forkProcess(HsStablePtr *entry
             releaseCapability_(capabilities[i],rtsFalse);
             RELEASE_LOCK(&capabilities[i]->lock);
         }
+
+#ifdef THREADED_RTS
+        RELEASE_LOCK(&all_tasks_mutex);
+#endif
+
         boundTaskExiting(task);
 
 	// just return the pid
         return pid;
 	
     } else { // child
-	
+
 #if defined(THREADED_RTS)
         initMutex(&sched_mutex);
         initMutex(&sm_mutex);
@@ -1839,6 +1868,8 @@ forkProcess(HsStablePtr *entry
         for (i=0; i < n_capabilities; i++) {
             initMutex(&capabilities[i]->lock);
         }
+
+        initMutex(&all_tasks_mutex);
 #endif
 
 #ifdef TRACING
@@ -1926,8 +1957,7 @@ forkProcess(HsStablePtr *entry
 	rts_checkSchedStatus("forkProcess",cap);
 	
 	rts_unlock(cap);
-	hs_exit();                      // clean up and exit
-	stg_exit(EXIT_SUCCESS);
+        shutdownHaskellAndExit(EXIT_SUCCESS, 0 /* !fastExit */);
     }
 #else /* !FORKPROCESS_PRIMOP_SUPPORTED */
     barf("forkProcess#: primop not supported on this platform, sorry!\n");
@@ -2858,3 +2888,11 @@ resurrectThreads (StgTSO *threads)
 	}
     }
 }
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/Schedule.h b/rts/Schedule.h
index 015cc1cefc17..f788aec9ce2e 100644
--- a/rts/Schedule.h
+++ b/rts/Schedule.h
@@ -259,3 +259,11 @@ emptyThreadQueues(Capability *cap)
 
 #endif /* SCHEDULE_H */
 
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/Sparks.c b/rts/Sparks.c
index 424165679573..d54a1f1aaac3 100644
--- a/rts/Sparks.c
+++ b/rts/Sparks.c
@@ -310,3 +310,11 @@ newSpark (StgRegTable *reg STG_UNUSED, StgClosure *p STG_UNUSED)
 }
 
 #endif /* THREADED_RTS */
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/Sparks.h b/rts/Sparks.h
index e381dd540fb3..6bc28795d8d3 100644
--- a/rts/Sparks.h
+++ b/rts/Sparks.h
@@ -106,3 +106,11 @@ INLINE_HEADER rtsBool fizzledSpark (StgClosure *spark)
 #include "EndPrivate.h"
 
 #endif /* SPARKS_H */
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/Stable.c b/rts/Stable.c
index ec74b0da13ca..229d707a831b 100644
--- a/rts/Stable.c
+++ b/rts/Stable.c
@@ -246,6 +246,7 @@ STATIC_INLINE void
 freeSnEntry(snEntry *sn)
 {
   ASSERT(sn->sn_obj == NULL);
+  removeHashTable(addrToStableHash, (W_)sn->old, NULL);
   sn->addr = (P_)stable_name_free;
   stable_name_free = sn;
 }
@@ -548,3 +549,11 @@ updateStableTables(rtsBool full)
             });
     }
 }
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/Stable.h b/rts/Stable.h
index 4786d477f3f2..0a1cc0dd2f5b 100644
--- a/rts/Stable.h
+++ b/rts/Stable.h
@@ -52,3 +52,11 @@ extern Mutex stable_mutex;
 #include "EndPrivate.h"
 
 #endif /* STABLE_H */
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/Stats.c b/rts/Stats.c
index 48c320c8f7d2..9038fb5c79a8 100644
--- a/rts/Stats.c
+++ b/rts/Stats.c
@@ -18,11 +18,16 @@
 #include "sm/GC.h" // gc_alloc_block_sync, whitehole_spin
 #include "sm/GCThread.h"
 #include "sm/BlockAlloc.h"
+#include "Ticker.h"
 
 #if USE_PAPI
 #include "Papi.h"
 #endif
 
+#if USE_PERF_EVENT
+#include "PerfEvent.h"
+#endif
+
 /* huh? */
 #define BIG_STRING_LEN              512
 
@@ -173,8 +178,8 @@ initStats1 (void)
     nat i;
   
     if (RtsFlags.GcFlags.giveStats >= VERBOSE_GC_STATS) {
-	statsPrintf("    Alloc    Copied     Live    GC    GC     TOT     TOT  Page Flts\n");
-	statsPrintf("    bytes     bytes     bytes  user  elap    user    elap\n");
+        statsPrintf("    Alloc    Copied     Live     GC     GC      TOT      TOT  Page Flts\n");
+        statsPrintf("    bytes     bytes     bytes   user   elap     user     elap\n");
     }
     GC_coll_cpu = 
 	(Time *)stgMallocBytes(
@@ -241,6 +246,14 @@ stat_startExit(void)
     /* This flag is needed, because GC is run once more after this function */
     papi_is_reporting = 0;
 #endif
+
+#ifdef USE_PERF_EVENT
+    perf_event_stop_mutator_count();
+#endif
+
+#ifdef TRACING
+    stopTickerSampling();
+#endif
 }
 
 void
@@ -277,6 +290,14 @@ stat_startGC (Capability *cap, gc_thread *gct)
     }
 #endif
 
+#ifdef USE_PERF_EVENT
+    perf_event_stop_mutator_count();
+#endif
+
+#ifdef TRACING
+    stopTickerSampling();
+#endif
+
     getProcessTimes(&gct->gc_start_cpu, &gct->gc_start_elapsed);
 
     // Post EVENT_GC_START with the same timestamp as used for stats
@@ -287,53 +308,12 @@ stat_startGC (Capability *cap, gc_thread *gct)
     traceEventGcStartAtT(cap,
                          TimeToNS(gct->gc_start_elapsed - start_init_elapsed));
 
-    gct->gc_start_thread_cpu = getThreadCPUTime();
-
     if (RtsFlags.GcFlags.giveStats != NO_GC_STATS)
     {
         gct->gc_start_faults = getPageFaults();
     }
 }
 
-void
-stat_gcWorkerThreadStart (gc_thread *gct STG_UNUSED)
-{
-#if 0
-    /*
-     * We dont' collect per-thread GC stats any more, but this code
-     * could be used to do that if we want to in the future:
-     */
-    if (RtsFlags.GcFlags.giveStats != NO_GC_STATS)
-    {
-        getProcessTimes(&gct->gc_start_cpu, &gct->gc_start_elapsed);
-        gct->gc_start_thread_cpu  = getThreadCPUTime();
-    }
-#endif
-}
-
-void
-stat_gcWorkerThreadDone (gc_thread *gct STG_UNUSED)
-{
-#if 0
-    /*
-     * We dont' collect per-thread GC stats any more, but this code
-     * could be used to do that if we want to in the future:
-     */
-    Time thread_cpu, elapsed, gc_cpu, gc_elapsed;
-
-    if (RtsFlags.GcFlags.giveStats != NO_GC_STATS)
-    {
-        elapsed    = getProcessElapsedTime();
-        thread_cpu = getThreadCPUTime();
-
-        gc_cpu     = thread_cpu - gct->gc_start_thread_cpu;
-        gc_elapsed = elapsed    - gct->gc_start_elapsed;
-    
-        taskDoneGC(gct->cap->running_task, gc_cpu, gc_elapsed);
-    }
-#endif
-}
-
 /* -----------------------------------------------------------------------------
  * Calculate the total allocated memory since the start of the
  * program.  Also emits events reporting the per-cap allocation
@@ -421,7 +401,7 @@ stat_endGC (Capability *cap, gc_thread *gct,
 	    statsPrintf("%9" FMT_SizeT " %9" FMT_SizeT " %9" FMT_SizeT,
 		    alloc*sizeof(W_), copied*sizeof(W_), 
 			live*sizeof(W_));
-            statsPrintf(" %5.2f %5.2f %7.2f %7.2f %4" FMT_Word " %4" FMT_Word "  (Gen: %2d)\n",
+            statsPrintf(" %6.3f %6.3f %8.3f %8.3f %4" FMT_Word " %4" FMT_Word "  (Gen: %2d)\n",
                     TimeToSecondsDbl(gc_cpu),
 		    TimeToSecondsDbl(gc_elapsed),
 		    TimeToSecondsDbl(cpu),
@@ -480,6 +460,14 @@ stat_endGC (Capability *cap, gc_thread *gct,
       papi_start_mutator_count();
     }
 #endif
+
+#ifdef USE_PERF_EVENT
+    perf_event_start_mutator_count();
+#endif
+
+#ifdef TRACING
+    startTickerSampling();
+#endif
 }
 
 /* -----------------------------------------------------------------------------
@@ -645,7 +633,7 @@ stat_exit (void)
 	
 	if (RtsFlags.GcFlags.giveStats >= VERBOSE_GC_STATS) {
 	    statsPrintf("%9" FMT_SizeT " %9.9s %9.9s", (W_)alloc*sizeof(W_), "", "");
-	    statsPrintf(" %5.2f %5.2f\n\n", 0.0, 0.0);
+	    statsPrintf(" %6.3f %6.3f\n\n", 0.0, 0.0);
 	}
 
         for (i = 0; i < RtsFlags.GcFlags.generations; i++) {
@@ -695,10 +683,10 @@ stat_exit (void)
                         (size_t)(peak_mblocks_allocated * BLOCKS_PER_MBLOCK * BLOCK_SIZE_W - hw_alloc_blocks * BLOCK_SIZE_W) / (1024 * 1024 / sizeof(W_)));
 
 	    /* Print garbage collections in each gen */
-            statsPrintf("                                    Tot time (elapsed)  Avg pause  Max pause\n");
+            statsPrintf("                                     Tot time (elapsed)  Avg pause  Max pause\n");
             for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
                 gen = &generations[g];
-                statsPrintf("  Gen %2d     %5d colls, %5d par   %5.2fs   %5.2fs     %3.4fs    %3.4fs\n",
+                statsPrintf("  Gen %2d     %5d colls, %5d par   %6.3fs  %6.3fs     %3.4fs    %3.4fs\n",
                             gen->no,
                             gen->collections,
                             gen->par_collections,
@@ -745,23 +733,23 @@ stat_exit (void)
             }
 #endif
 
-	    statsPrintf("  INIT    time  %6.2fs  (%6.2fs elapsed)\n",
+	    statsPrintf("  INIT    time  %7.3fs  (%7.3fs elapsed)\n",
                         TimeToSecondsDbl(init_cpu), TimeToSecondsDbl(init_elapsed));
 
-            statsPrintf("  MUT     time  %6.2fs  (%6.2fs elapsed)\n",
+            statsPrintf("  MUT     time  %7.3fs  (%7.3fs elapsed)\n",
                         TimeToSecondsDbl(mut_cpu), TimeToSecondsDbl(mut_elapsed));
-            statsPrintf("  GC      time  %6.2fs  (%6.2fs elapsed)\n",
+            statsPrintf("  GC      time  %7.3fs  (%7.3fs elapsed)\n",
                         TimeToSecondsDbl(gc_cpu), TimeToSecondsDbl(gc_elapsed));
 
 #ifdef PROFILING
-	    statsPrintf("  RP      time  %6.2fs  (%6.2fs elapsed)\n",
+	    statsPrintf("  RP      time  %7.3fs  (%7.3fs elapsed)\n",
 		    TimeToSecondsDbl(RP_tot_time), TimeToSecondsDbl(RPe_tot_time));
-	    statsPrintf("  PROF    time  %6.2fs  (%6.2fs elapsed)\n",
+	    statsPrintf("  PROF    time  %7.3fs  (%7.3fs elapsed)\n",
 		    TimeToSecondsDbl(HC_tot_time), TimeToSecondsDbl(HCe_tot_time));
 #endif 
-	    statsPrintf("  EXIT    time  %6.2fs  (%6.2fs elapsed)\n",
+	    statsPrintf("  EXIT    time  %7.3fs  (%7.3fs elapsed)\n",
 		    TimeToSecondsDbl(exit_cpu), TimeToSecondsDbl(exit_elapsed));
-	    statsPrintf("  Total   time  %6.2fs  (%6.2fs elapsed)\n\n",
+	    statsPrintf("  Total   time  %7.3fs  (%7.3fs elapsed)\n\n",
 		    TimeToSecondsDbl(tot_cpu), TimeToSecondsDbl(tot_elapsed));
 #ifndef THREADED_RTS
 	    statsPrintf("  %%GC     time     %5.1f%%  (%.1f%% elapsed)\n\n",
@@ -820,17 +808,17 @@ stat_exit (void)
                  " ,(\"max_bytes_used\", \"%ld\")\n"
                  " ,(\"num_byte_usage_samples\", \"%ld\")\n"
                  " ,(\"peak_megabytes_allocated\", \"%lu\")\n"
-                 " ,(\"init_cpu_seconds\", \"%.2f\")\n"
-                 " ,(\"init_wall_seconds\", \"%.2f\")\n"
-                 " ,(\"mutator_cpu_seconds\", \"%.2f\")\n"
-                 " ,(\"mutator_wall_seconds\", \"%.2f\")\n"
-                 " ,(\"GC_cpu_seconds\", \"%.2f\")\n"
-                 " ,(\"GC_wall_seconds\", \"%.2f\")\n"
+                 " ,(\"init_cpu_seconds\", \"%.3f\")\n"
+                 " ,(\"init_wall_seconds\", \"%.3f\")\n"
+                 " ,(\"mutator_cpu_seconds\", \"%.3f\")\n"
+                 " ,(\"mutator_wall_seconds\", \"%.3f\")\n"
+                 " ,(\"GC_cpu_seconds\", \"%.3f\")\n"
+                 " ,(\"GC_wall_seconds\", \"%.3f\")\n"
                  " ]\n";
       }
       else {
           fmt1 = "<<ghc: %llu bytes, ";
-          fmt2 = "%d GCs, %ld/%ld avg/max bytes residency (%ld samples), %luM in use, %.2f INIT (%.2f elapsed), %.2f MUT (%.2f elapsed), %.2f GC (%.2f elapsed) :ghc>>\n";
+          fmt2 = "%d GCs, %ld/%ld avg/max bytes residency (%ld samples), %luM in use, %.3f INIT (%.3f elapsed), %.3f MUT (%.3f elapsed), %.3f GC (%.3f elapsed) :ghc>>\n";
       }
 	  /* print the long long separately to avoid bugginess on mingwin (2001-07-02, mingw-0.5) */
 	  statsPrintf(fmt1, GC_tot_alloc*(StgWord64)sizeof(W_));
@@ -1045,3 +1033,11 @@ statsClose( void )
 	fclose(sf);
     }
 }
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/Stats.h b/rts/Stats.h
index 9839e5cf2a06..0bbd7afb4ac3 100644
--- a/rts/Stats.h
+++ b/rts/Stats.h
@@ -32,9 +32,6 @@ void      stat_endGC  (Capability *cap, struct gc_thread_ *_gct,
                        W_ live, W_ copied, W_ slop, nat gen,
                        nat n_gc_threads, W_ par_max_copied, W_ par_tot_copied);
 
-void stat_gcWorkerThreadStart (struct gc_thread_ *_gct);
-void stat_gcWorkerThreadDone  (struct gc_thread_ *_gct);
-
 #ifdef PROFILING
 void      stat_startRP(void);
 void      stat_endRP(nat, 
@@ -78,3 +75,11 @@ void statsPrintf( char *s, ... )
 #include "EndPrivate.h"
 
 #endif /* STATS_H */
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/StgCRun.c b/rts/StgCRun.c
index 940e16dec1f4..244cdb428b25 100644
--- a/rts/StgCRun.c
+++ b/rts/StgCRun.c
@@ -748,4 +748,78 @@ StgRun(StgFunPtr f, StgRegTable *basereg) {
 }
 #endif
 
+#ifdef aarch64_HOST_ARCH
+
+StgRegTable *
+StgRun(StgFunPtr f, StgRegTable *basereg) {
+    StgRegTable * r;
+    __asm__ volatile (
+        /*
+         * save callee-saves registers on behalf of the STG code.
+         */
+        "stp x19, x20, [sp, #-16]!\n\t"
+        "stp x21, x22, [sp, #-16]!\n\t"
+        "stp x23, x24, [sp, #-16]!\n\t"
+        "stp x25, x26, [sp, #-16]!\n\t"
+        "stp x27, x28, [sp, #-16]!\n\t" 
+        "stp ip0, ip1, [sp, #-16]!\n\t"
+        "str lr, [sp, #-8]!\n\t"
+
+        /*
+         * allocate some space for Stg machine's temporary storage.
+         * Note: RESERVER_C_STACK_BYTES has to be a round number here or
+         * the assembler can't assemble it.
+         */
+        "str lr, [sp, %3]"
+        /* "sub sp, sp, %3\n\t" */
+        /*
+         * Set BaseReg
+         */
+        "mov x19, %2\n\t"
+        /*
+         * Jump to function argument.
+         */
+        "bx %1\n\t"
+
+        ".globl " STG_RETURN "\n\t"
+        ".type " STG_RETURN ", %%function\n"
+        STG_RETURN ":\n\t"
+        /*
+         * Free the space we allocated
+         */
+        "ldr lr, [sp], %3\n\t"
+        /* "add sp, sp, %3\n\t" */
+        /*
+         * Return the new register table, taking it from Stg's R1 (ARM64's R22).
+         */
+        "mov %0, x22\n\t"
+        /*
+         * restore callee-saves registers.
+         */
+        "ldr lr, [sp], #8\n\t"
+        "ldp ip0, ip1, [sp], #16\n\t"
+        "ldp x27, x28, [sp], #16\n\t"
+        "ldp x25, x26, [sp], #16\n\t"
+        "ldp x23, x24, [sp], #16\n\t"
+        "ldp x21, x22, [sp], #16\n\t"
+        "ldp x19, x20, [sp], #16\n\t"
+
+      : "=r" (r)
+      : "r" (f), "r" (basereg), "i" (RESERVED_C_STACK_BYTES)
+        : "%x19", "%x20", "%x21", "%x22", "%x23", "%x24", "%x25", "%x26", "%x27", "%x28",
+          "%ip0", "%ip1", "%lr"
+    );
+    return r;
+}
+
+#endif
+
 #endif /* !USE_MINIINTERPRETER */
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/StgMiscClosures.cmm b/rts/StgMiscClosures.cmm
index 450b2d96c676..9b7b37860307 100644
--- a/rts/StgMiscClosures.cmm
+++ b/rts/StgMiscClosures.cmm
@@ -47,6 +47,7 @@ INFO_TABLE_RET (stg_stack_underflow_frame, UNDERFLOW_FRAME,
 
 INFO_TABLE_RET (stg_restore_cccs, RET_SMALL, W_ info_ptr, W_ cccs)
 {
+    unwind Sp = Sp + WDS(2);
 #if defined(PROFILING)
     CCCS = Sp(1);
 #endif
@@ -604,6 +605,18 @@ INFO_TABLE(stg_MUT_ARR_PTRS_FROZEN, 0, 0, MUT_ARR_PTRS_FROZEN, "MUT_ARR_PTRS_FRO
 INFO_TABLE(stg_MUT_ARR_PTRS_FROZEN0, 0, 0, MUT_ARR_PTRS_FROZEN0, "MUT_ARR_PTRS_FROZEN0", "MUT_ARR_PTRS_FROZEN0")
 { foreign "C" barf("MUT_ARR_PTRS_FROZEN0 object entered!") never returns; }
 
+INFO_TABLE(stg_SMALL_MUT_ARR_PTRS_CLEAN, 0, 0, SMALL_MUT_ARR_PTRS_CLEAN, "SMALL_MUT_ARR_PTRS_CLEAN", "SMALL_MUT_ARR_PTRS_CLEAN")
+{ foreign "C" barf("SMALL_MUT_ARR_PTRS_CLEAN object entered!") never returns; }
+
+INFO_TABLE(stg_SMALL_MUT_ARR_PTRS_DIRTY, 0, 0, SMALL_MUT_ARR_PTRS_DIRTY, "SMALL_MUT_ARR_PTRS_DIRTY", "SMALL_MUT_ARR_PTRS_DIRTY")
+{ foreign "C" barf("SMALL_MUT_ARR_PTRS_DIRTY object entered!") never returns; }
+
+INFO_TABLE(stg_SMALL_MUT_ARR_PTRS_FROZEN, 0, 0, SMALL_MUT_ARR_PTRS_FROZEN, "SMALL_MUT_ARR_PTRS_FROZEN", "SMALL_MUT_ARR_PTRS_FROZEN")
+{ foreign "C" barf("SMALL_MUT_ARR_PTRS_FROZEN object entered!") never returns; }
+
+INFO_TABLE(stg_SMALL_MUT_ARR_PTRS_FROZEN0, 0, 0, SMALL_MUT_ARR_PTRS_FROZEN0, "SMALL_MUT_ARR_PTRS_FROZEN0", "SMALL_MUT_ARR_PTRS_FROZEN0")
+{ foreign "C" barf("SMALL_MUT_ARR_PTRS_FROZEN0 object entered!") never returns; }
+
 /* ----------------------------------------------------------------------------
    Mutable Variables
    ------------------------------------------------------------------------- */
diff --git a/rts/StgPrimFloat.c b/rts/StgPrimFloat.c
index 3b80d6f3886a..63fe52ec8064 100644
--- a/rts/StgPrimFloat.c
+++ b/rts/StgPrimFloat.c
@@ -200,3 +200,11 @@ __decodeFloat_Int (I_ *man, I_ *exp, StgFloat flt)
     }
 }
 
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/StgPrimFloat.h b/rts/StgPrimFloat.h
index edd7b472b751..fefe8c9b7a42 100644
--- a/rts/StgPrimFloat.h
+++ b/rts/StgPrimFloat.h
@@ -21,3 +21,11 @@ void      __decodeFloat_Int (I_ *man, I_ *exp, StgFloat flt);
 #include "EndPrivate.h"
 
 #endif /* STGPRIMFLOAT_H */
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/StgRun.h b/rts/StgRun.h
index 71b92e2d88d8..0ce72935d6bc 100644
--- a/rts/StgRun.h
+++ b/rts/StgRun.h
@@ -3,7 +3,7 @@
  * (c) The GHC Team, 1998-2004
  *
  * Tiny assembler 'layer' between the C and STG worlds.
- * 
+ *
  ---------------------------------------------------------------------------- */
 
 #ifndef STGRUN_H
@@ -16,3 +16,11 @@ StgWord8 *win32AllocStack(void);
 #endif
 
 #endif /* STGRUN_H */
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/StgStartup.cmm b/rts/StgStartup.cmm
index dcc038374c00..d9acb8e75373 100644
--- a/rts/StgStartup.cmm
+++ b/rts/StgStartup.cmm
@@ -96,8 +96,8 @@ stg_returnToStackTop /* no args: explicit stack layout */
 stg_returnToSched /* no args: explicit stack layout */
 {
   W_ r1;
-  r1 = R1; // foreign calls may clobber R1
   SAVE_THREAD_STATE();
+  r1 = R1; // foreign calls may clobber R1
   foreign "C" threadPaused(MyCapability() "ptr", CurrentTSO);
   R1 = r1;
   jump StgReturn [R1];
@@ -120,10 +120,10 @@ stg_returnToSchedNotPaused /* no args: explicit stack layout */
 stg_returnToSchedButFirst /* no args: explicit stack layout */
 {
   W_ r1, r2, r3;
+  SAVE_THREAD_STATE();
   r1 = R1;
   r2 = R2;
   r3 = R3;
-  SAVE_THREAD_STATE();
   // foreign calls may clobber R1/R2/.., so we save them above
   foreign "C" threadPaused(MyCapability() "ptr", CurrentTSO);
   R1 = r1;
diff --git a/rts/Task.c b/rts/Task.c
index a044bc3672e7..d459d394b70a 100644
--- a/rts/Task.c
+++ b/rts/Task.c
@@ -18,6 +18,8 @@
 #include "Schedule.h"
 #include "Hash.h"
 #include "Trace.h"
+#include "PerfEvent.h"
+#include "Ticker.h"
 
 #if HAVE_SIGNAL_H
 #include <signal.h>
@@ -39,7 +41,7 @@ static Task * allocTask (void);
 static Task * newTask   (rtsBool);
 
 #if defined(THREADED_RTS)
-static Mutex all_tasks_mutex;
+Mutex all_tasks_mutex;
 #endif
 
 /* -----------------------------------------------------------------------------
@@ -128,12 +130,56 @@ allocTask (void)
         task = newTask(rtsFalse);
 #if defined(THREADED_RTS)
         task->id = osThreadId();
+#endif
+#if defined(USE_PERF_EVENT)
+        perf_event_init(task);
+#endif
+#ifdef TRACING
+        initTickerSampling(task);
 #endif
         setMyTask(task);
         return task;
     }
 }
 
+void freeMyTask (void)
+{
+    Task *task;
+
+    task = myTask();
+
+    if (task == NULL) return;
+
+    if (!task->stopped) {
+        errorBelch(
+            "freeMyTask() called, but the Task is not stopped; ignoring");
+        return;
+    }
+
+    if (task->worker) {
+        errorBelch("freeMyTask() called on a worker; ignoring");
+        return;
+    }
+
+    ACQUIRE_LOCK(&all_tasks_mutex);
+
+    if (task->all_prev) {
+        task->all_prev->all_next = task->all_next;
+    } else {
+        all_tasks = task->all_next;
+    }
+    if (task->all_next) {
+        task->all_next->all_prev = task->all_prev;
+    }
+
+    taskCount--;
+
+    RELEASE_LOCK(&all_tasks_mutex);
+
+    freeTask(task);
+    setMyTask(NULL);
+}
+
 static void
 freeTask (Task *task)
 {
@@ -182,6 +228,11 @@ newTask (rtsBool worker)
     task->wakeup = rtsFalse;
 #endif
 
+#ifdef TRACING
+    task->timer_ip_sample_count = 0;
+    task->timer_ip_samples = NULL;
+#endif
+
     task->next = NULL;
 
     ACQUIRE_LOCK(&all_tasks_mutex);
@@ -219,7 +270,7 @@ newInCall (Task *task)
         task->spare_incalls = incall->next;
         task->n_spare_incalls--;
     } else {
-        incall = stgMallocBytes((sizeof(InCall)), "newBoundTask");
+        incall = stgMallocBytes((sizeof(InCall)), "newInCall");
     }
 
     incall->tso = NULL;
@@ -312,6 +363,20 @@ discardTasksExcept (Task *keep)
         next = task->all_next;
         if (task != keep) {
             debugTrace(DEBUG_sched, "discarding task %" FMT_SizeT "", (size_t)TASK_ID(task));
+#if defined(THREADED_RTS)
+            // It is possible that some of these tasks are currently blocked
+            // (in the parent process) either on their condition variable
+            // `cond` or on their mutex `lock`. If they are we may deadlock
+            // when `freeTask` attempts to call `closeCondition` or
+            // `closeMutex` (the behaviour of these functions is documented to
+            // be undefined in the case that there are threads blocked on
+            // them). To avoid this, we re-initialize both the condition
+            // variable and the mutex before calling `freeTask` (we do
+            // precisely the same for all global locks in `forkProcess`).
+            initCondition(&task->cond);
+            initMutex(&task->lock);
+#endif
+
             // Note that we do not traceTaskDelete here because
             // we are not really deleting a task.
             // The OS threads for all these tasks do not exist in
@@ -374,6 +439,14 @@ workerStart(Task *task)
         setThreadAffinity(cap->no, n_capabilities);
     }
 
+#ifdef USE_PERF_EVENT
+    perf_event_init(task);
+#endif
+
+#ifdef TRACING
+    initTickerSampling(task);
+#endif
+
     // set the thread-local pointer to the Task:
     setMyTask(task);
 
@@ -464,3 +537,11 @@ printAllTasks(void)
 
 #endif
 
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/Task.h b/rts/Task.h
index 4e0e13e93cb6..f9d081528827 100644
--- a/rts/Task.h
+++ b/rts/Task.h
@@ -37,12 +37,20 @@
    Ownership of Task
    -----------------
 
-   The OS thread named in the Task structure has exclusive access to
-   the structure, as long as it is the running_task of its Capability.
-   That is, if (task->cap->running_task == task), then task->id owns
-   the Task.  Otherwise the Task is owned by the owner of the parent
-   data structure on which it is sleeping; for example, if the task is
-   sleeping on spare_workers field of a Capability, then the owner of the
+   Task ownership is a little tricky.  The default situation is that
+   the Task is an OS-thread-local structure that is owned by the OS
+   thread named in task->id.  An OS thread not currently executing
+   Haskell code might call newBoundTask() at any time, which assumes
+   that it has access to the Task for the current OS thread.
+
+   The all_next and all_prev fields of a Task are owned by
+   all_tasks_mutex, which must also be taken if we want to create or
+   free a Task.
+
+   For an OS thread in Haskell, if (task->cap->running_task != task),
+   then the Task is owned by the owner of the parent data structure on
+   which it is sleeping; for example, if the task is sleeping on
+   spare_workers field of a Capability, then the owner of the
    Capability has access to the Task.
 
    When a task is migrated from sleeping on one Capability to another,
@@ -147,10 +155,27 @@ typedef struct Task_ {
     // on spare_workers.
     struct Task_ *next;
 
-    // Links tasks on the all_tasks list
+    // Links tasks on the all_tasks list; need ACQUIRE_LOCK(&all_tasks_mutex)
     struct Task_ *all_next;
     struct Task_ *all_prev;
 
+#ifdef USE_PERF_EVENT
+    // Associated perf_events memory map for collecting profiling data
+    int perf_event_fd;
+    union {
+        void *perf_event_mmap;
+        struct perf_event_mmap_page *perf_event_data;
+    };
+    StgWord64 perf_event_last_head;
+    StgWord32 perf_event_sample_type;
+#endif
+
+#ifdef TRACING
+    // Timer instruction pointer profiling
+    int timer_ip_sample_count;
+    void **timer_ip_samples;
+#endif
+
 } Task;
 
 INLINE_HEADER rtsBool
@@ -163,22 +188,35 @@ isBoundTask (Task *task)
 //
 extern Task *all_tasks;
 
+// The all_tasks list is protected by the all_tasks_mutex
+#if defined(THREADED_RTS)
+extern Mutex all_tasks_mutex;
+#endif
+
 // Start and stop the task manager.
 // Requires: sched_mutex.
 //
 void initTaskManager (void);
 nat  freeTaskManager (void);
 
-// Create a new Task for a bound thread
-// Requires: sched_mutex.
+// Create a new Task for a bound thread.  This Task must be released
+// by calling boundTaskExiting.  The Task is cached in
+// thread-local storage and will remain even after boundTaskExiting()
+// has been called; to free the memory, see freeMyTask().
 //
 Task *newBoundTask (void);
 
 // The current task is a bound task that is exiting.
-// Requires: sched_mutex.
 //
 void boundTaskExiting (Task *task);
 
+// Free a Task if one was previously allocated by newBoundTask().
+// This is not necessary unless the thread that called newBoundTask()
+// will be exiting, or if this thread has finished calling Haskell
+// functions.
+//
+void freeMyTask(void);
+
 // Notify the task manager that a task has stopped.  This is used
 // mainly for stats-gathering purposes.
 // Requires: sched_mutex.
@@ -308,3 +346,11 @@ serialisableTaskId (Task *task
 #include "EndPrivate.h"
 
 #endif /* TASK_H */
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/ThreadLabels.c b/rts/ThreadLabels.c
index 8838042a83bd..5d891a005e88 100644
--- a/rts/ThreadLabels.c
+++ b/rts/ThreadLabels.c
@@ -59,7 +59,7 @@ removeThreadLabel(StgWord key)
   if ((old = lookupHashTable(threadLabels,key))) {
     removeHashTable(threadLabels,key,old);
     stgFree(old);
-  }  
+  }
 }
 
 #endif /* DEBUG */
@@ -83,3 +83,10 @@ labelThread(Capability *cap   STG_UNUSED,
   traceThreadLabel(cap, tso, label);
 }
 
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/ThreadLabels.h b/rts/ThreadLabels.h
index 742e77ae5858..ee482312fffc 100644
--- a/rts/ThreadLabels.h
+++ b/rts/ThreadLabels.h
@@ -25,3 +25,11 @@ void    labelThread          (Capability *cap,
 #include "EndPrivate.h"
 
 #endif /* THREADLABELS_H */
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/ThreadPaused.c b/rts/ThreadPaused.c
index 0507880e6a14..bf7def458383 100644
--- a/rts/ThreadPaused.c
+++ b/rts/ThreadPaused.c
@@ -82,7 +82,7 @@ stackSqueeze(Capability *cap, StgTSO *tso, StgPtr bottom)
     nat adjacent_update_frames;
     struct stack_gap *gap;
 
-    // Stage 1: 
+    // Stage 1:
     //    Traverse the stack upwards, replacing adjacent update frames
     //    with a single update frame and a "stack gap".  A stack gap
     //    contains two values: the size of the gap, and the distance
@@ -91,7 +91,7 @@ stackSqueeze(Capability *cap, StgTSO *tso, StgPtr bottom)
     frame = tso->stackobj->sp;
 
     ASSERT(frame < bottom);
-    
+
     adjacent_update_frames = 0;
     gap = (struct stack_gap *) (frame - sizeofW(StgUpdateFrame));
 
@@ -100,7 +100,7 @@ stackSqueeze(Capability *cap, StgTSO *tso, StgPtr bottom)
         switch (get_ret_itbl((StgClosure *)frame)->i.type) {
 
         case UPDATE_FRAME:
-	{ 
+        {
             if (adjacent_update_frames > 0) {
                 TICK_UPD_SQUEEZED();
             }
@@ -109,10 +109,10 @@ stackSqueeze(Capability *cap, StgTSO *tso, StgPtr bottom)
             frame += sizeofW(StgUpdateFrame);
             continue;
         }
-	    
-	default:
+
+        default:
             // we're not in a gap... check whether this is the end of a gap
-	    // (an update frame can't be the end of a gap).
+            // (an update frame can't be the end of a gap).
             if (adjacent_update_frames > 1) {
                 gap = updateAdjacentFrames(cap, tso,
                                            (StgUpdateFrame*)(frame - sizeofW(StgUpdateFrame)),
@@ -120,9 +120,9 @@ stackSqueeze(Capability *cap, StgTSO *tso, StgPtr bottom)
             }
             adjacent_update_frames = 0;
 
-	    frame += stack_frame_sizeW((StgClosure *)frame);
-	    continue;
-	}
+            frame += stack_frame_sizeW((StgClosure *)frame);
+            continue;
+        }
     }
 
     if (adjacent_update_frames > 1) {
@@ -141,12 +141,12 @@ stackSqueeze(Capability *cap, StgTSO *tso, StgPtr bottom)
     //     |           | <- gap_start
     //     | ......... |                |
     //     | stack_gap | <- gap         | chunk_size
-    //     | ......... |                | 
+    //     | ......... |                |
     //     | ......... | <- gap_end     v
-    //     | ********* | 
-    //     | ********* | 
-    //     | ********* | 
-    //    -| ********* | 
+    //     | ********* |
+    //     | ********* |
+    //     | ********* |
+    //    -| ********* |
     //
     // 'sp'  points the the current top-of-stack
     // 'gap' points to the stack_gap structure inside the gap
@@ -155,34 +155,34 @@ stackSqueeze(Capability *cap, StgTSO *tso, StgPtr bottom)
     // <empty> indicates unused
     //
     {
-	StgWord8 *sp;
-	StgWord8 *gap_start, *next_gap_start, *gap_end;
-	nat chunk_size;
+        StgWord8 *sp;
+        StgWord8 *gap_start, *next_gap_start, *gap_end;
+        nat chunk_size;
 
-	next_gap_start = (StgWord8*)gap + sizeof(StgUpdateFrame);
-	sp = next_gap_start;
+        next_gap_start = (StgWord8*)gap + sizeof(StgUpdateFrame);
+        sp = next_gap_start;
 
         while ((StgPtr)gap > tso->stackobj->sp) {
 
-	    // we're working in *bytes* now...
-	    gap_start = next_gap_start;
-	    gap_end = gap_start - gap->gap_size * sizeof(W_);
+            // we're working in *bytes* now...
+            gap_start = next_gap_start;
+            gap_end = gap_start - gap->gap_size * sizeof(W_);
 
-	    gap = gap->next_gap;
-	    next_gap_start = (StgWord8*)gap + sizeof(StgUpdateFrame);
+            gap = gap->next_gap;
+            next_gap_start = (StgWord8*)gap + sizeof(StgUpdateFrame);
 
-	    chunk_size = gap_end - next_gap_start;
-	    sp -= chunk_size;
-	    memmove(sp, next_gap_start, chunk_size);
-	}
+            chunk_size = gap_end - next_gap_start;
+            sp -= chunk_size;
+            memmove(sp, next_gap_start, chunk_size);
+        }
 
         tso->stackobj->sp = (StgPtr)sp;
     }
-}    
+}
 
 /* -----------------------------------------------------------------------------
  * Pausing a thread
- * 
+ *
  * We have to prepare for GC - this means doing lazy black holing
  * here.  We also take the opportunity to do stack squeezing if it's
  * turned on.
@@ -200,7 +200,7 @@ threadPaused(Capability *cap, StgTSO *tso)
     nat weight           = 0;
     nat weight_pending   = 0;
     rtsBool prev_was_update_frame = rtsFalse;
-    
+
     // Check to see whether we have threads waiting to raise
     // exceptions, and we're not blocking exceptions, or are blocked
     // interruptibly.  This is important; if a thread is running with
@@ -214,15 +214,15 @@ threadPaused(Capability *cap, StgTSO *tso)
     // [upd-black-hole] in sm/Scav.c.
 
     stack_end = tso->stackobj->stack + tso->stackobj->stack_size;
-    
+
     frame = (StgClosure *)tso->stackobj->sp;
 
     while ((P_)frame < stack_end) {
         info = get_ret_itbl(frame);
-	
-	switch (info->i.type) {
 
-	case UPDATE_FRAME:
+        switch (info->i.type) {
+
+        case UPDATE_FRAME:
 
             // If we've already marked this frame, then stop here.
             if (frame->header.info == (StgInfoTable *)&stg_marked_upd_frame_info) {
@@ -234,9 +234,9 @@ threadPaused(Capability *cap, StgTSO *tso)
                 goto end;
             }
 
-	    SET_INFO(frame, (StgInfoTable *)&stg_marked_upd_frame_info);
+            SET_INFO(frame, (StgInfoTable *)&stg_marked_upd_frame_info);
 
-	    bh = ((StgUpdateFrame *)frame)->updatee;
+            bh = ((StgUpdateFrame *)frame)->updatee;
             bh_info = bh->header.info;
 
 #ifdef THREADED_RTS
@@ -277,29 +277,29 @@ threadPaused(Capability *cap, StgTSO *tso)
                 &&
                 ((StgInd*)bh)->indirectee != (StgClosure*)tso)
             {
-		debugTrace(DEBUG_squeeze,
-			   "suspending duplicate work: %ld words of stack",
+                debugTrace(DEBUG_squeeze,
+                           "suspending duplicate work: %ld words of stack",
                            (long)((StgPtr)frame - tso->stackobj->sp));
 
-		// If this closure is already an indirection, then
-		// suspend the computation up to this point.
-		// NB. check raiseAsync() to see what happens when
-		// we're in a loop (#2783).
-		suspendComputation(cap,tso,(StgUpdateFrame*)frame);
+                // If this closure is already an indirection, then
+                // suspend the computation up to this point.
+                // NB. check raiseAsync() to see what happens when
+                // we're in a loop (#2783).
+                suspendComputation(cap,tso,(StgUpdateFrame*)frame);
 
-		// Now drop the update frame, and arrange to return
-		// the value to the frame underneath:
+                // Now drop the update frame, and arrange to return
+                // the value to the frame underneath:
                 tso->stackobj->sp = (StgPtr)frame + sizeofW(StgUpdateFrame) - 2;
                 tso->stackobj->sp[1] = (StgWord)bh;
                 ASSERT(bh->header.info != &stg_TSO_info);
                 tso->stackobj->sp[0] = (W_)&stg_enter_info;
 
-		// And continue with threadPaused; there might be
-		// yet more computation to suspend.
+                // And continue with threadPaused; there might be
+                // yet more computation to suspend.
                 frame = (StgClosure *)(tso->stackobj->sp + 2);
                 prev_was_update_frame = rtsFalse;
                 continue;
-	    }
+            }
 
 
             // zero out the slop so that the sanity checker can tell
@@ -312,10 +312,10 @@ threadPaused(Capability *cap, StgTSO *tso)
             // first we turn it into a WHITEHOLE to claim it, and if
             // successful we write our TSO and then the BLACKHOLE info pointer.
             cur_bh_info = (const StgInfoTable *)
-                cas((StgVolatilePtr)&bh->header.info, 
-                    (StgWord)bh_info, 
+                cas((StgVolatilePtr)&bh->header.info,
+                    (StgWord)bh_info,
                     (StgWord)&stg_WHITEHOLE_info);
-            
+
             if (cur_bh_info != bh_info) {
                 bh_info = cur_bh_info;
                 goto retry;
@@ -332,44 +332,44 @@ threadPaused(Capability *cap, StgTSO *tso)
 
             // We pretend that bh has just been created.
             LDV_RECORD_CREATE(bh);
-	    
-	    frame = (StgClosure *) ((StgUpdateFrame *)frame + 1);
-	    if (prev_was_update_frame) {
-		words_to_squeeze += sizeofW(StgUpdateFrame);
-		weight += weight_pending;
-		weight_pending = 0;
-	    }
-	    prev_was_update_frame = rtsTrue;
-	    break;
-	    
+
+            frame = (StgClosure *) ((StgUpdateFrame *)frame + 1);
+            if (prev_was_update_frame) {
+                words_to_squeeze += sizeofW(StgUpdateFrame);
+                weight += weight_pending;
+                weight_pending = 0;
+            }
+            prev_was_update_frame = rtsTrue;
+            break;
+
         case UNDERFLOW_FRAME:
         case STOP_FRAME:
-	    goto end;
-	    
-	    // normal stack frames; do nothing except advance the pointer
-	default:
-	{
-	    nat frame_size = stack_frame_sizeW(frame);
-	    weight_pending += frame_size;
-	    frame = (StgClosure *)((StgPtr)frame + frame_size);
-	    prev_was_update_frame = rtsFalse;
-	}
-	}
+            goto end;
+
+            // normal stack frames; do nothing except advance the pointer
+        default:
+        {
+            nat frame_size = stack_frame_sizeW(frame);
+            weight_pending += frame_size;
+            frame = (StgClosure *)((StgPtr)frame + frame_size);
+            prev_was_update_frame = rtsFalse;
+        }
+        }
     }
 
 end:
-    debugTrace(DEBUG_squeeze, 
-	       "words_to_squeeze: %d, weight: %d, squeeze: %s", 
-	       words_to_squeeze, weight, 
+    debugTrace(DEBUG_squeeze,
+               "words_to_squeeze: %d, weight: %d, squeeze: %s",
+               words_to_squeeze, weight,
                ((weight <= 8 && words_to_squeeze > 0) || weight < words_to_squeeze) ? "YES" : "NO");
 
     // Should we squeeze or not?  Arbitrary heuristic: we squeeze if
     // the number of words we have to shift down is less than the
     // number of stack words we squeeze away by doing so.
     if (RtsFlags.GcFlags.squeezeUpdFrames == rtsTrue &&
-	((weight <= 8 && words_to_squeeze > 0) || weight < words_to_squeeze)) {
+        ((weight <= 8 && words_to_squeeze > 0) || weight < words_to_squeeze)) {
         // threshold above bumped from 5 to 8 as a result of #2797
-	stackSqueeze(cap, tso, (StgPtr)frame);
+        stackSqueeze(cap, tso, (StgPtr)frame);
         tso->flags |= TSO_SQUEEZED;
         // This flag tells threadStackOverflow() that the stack was
         // squeezed, because it may not need to be expanded.
@@ -377,3 +377,11 @@ threadPaused(Capability *cap, StgTSO *tso)
         tso->flags &= ~TSO_SQUEEZED;
     }
 }
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/ThreadPaused.h b/rts/ThreadPaused.h
index 197b8d3257fb..16cca35feab5 100644
--- a/rts/ThreadPaused.h
+++ b/rts/ThreadPaused.h
@@ -12,3 +12,11 @@
 RTS_PRIVATE void threadPaused ( Capability *cap, StgTSO * );
 
 #endif /* THREADPAUSED_H */
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/Threads.c b/rts/Threads.c
index af4353fc49b0..b1912d83f405 100644
--- a/rts/Threads.c
+++ b/rts/Threads.c
@@ -221,7 +221,7 @@ removeThreadFromDeQueue (Capability *cap,
             }
 	}
     }
-    barf("removeThreadFromMVarQueue: not found");
+    barf("removeThreadFromDeQueue: not found");
 }
 
 /* ----------------------------------------------------------------------------
@@ -880,3 +880,11 @@ printThreadQueue(StgTSO *t)
 }
 
 #endif /* DEBUG */
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/Threads.h b/rts/Threads.h
index 6d2661033419..a1ff0803c4ec 100644
--- a/rts/Threads.h
+++ b/rts/Threads.h
@@ -52,3 +52,11 @@ void printThreadQueue (StgTSO *t);
 #include "EndPrivate.h"
 
 #endif /* THREADS_H */
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/Ticker.h b/rts/Ticker.h
index 685a79e5d2a6..ed1c3bc48179 100644
--- a/rts/Ticker.h
+++ b/rts/Ticker.h
@@ -11,13 +11,27 @@
 
 #include "BeginPrivate.h"
 
-typedef void (*TickProc)(int);
+typedef void (*TickProc)(StgBool, void *);
 
 void initTicker  (Time interval, TickProc handle_tick);
 void startTicker (void);
 void stopTicker  (void);
 void exitTicker  (rtsBool wait);
 
+#ifdef TRACING
+void initTickerSampling (Task *task);
+void startTickerSampling (void);
+void stopTickerSampling (void);
+#endif
+
 #include "EndPrivate.h"
 
 #endif /* TICKER_H */
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/Ticky.c b/rts/Ticky.c
index 4547c0b249a5..b1581f01f89e 100644
--- a/rts/Ticky.c
+++ b/rts/Ticky.c
@@ -619,3 +619,11 @@ printRegisteredCounterInfo (FILE *tf)
 }
 #endif /* TICKY_TICKY */
 
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/Ticky.h b/rts/Ticky.h
index a32a7a6542b1..e666a9b2daad 100644
--- a/rts/Ticky.h
+++ b/rts/Ticky.h
@@ -12,3 +12,11 @@
 RTS_PRIVATE void PrintTickyInfo(void);
 
 #endif /* TICKY_H */
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/Timer.c b/rts/Timer.c
index b7762f985ca9..90cccaafac4f 100644
--- a/rts/Timer.c
+++ b/rts/Timer.c
@@ -24,6 +24,10 @@
 #include "Ticker.h"
 #include "Capability.h"
 #include "RtsSignals.h"
+#include "Trace.h"
+
+// TODO...
+#include "posix/Itimer.h"
 
 /* ticks left before next pre-emptive context switch */
 static int ticks_to_ctxt_switch = 0;
@@ -31,16 +35,31 @@ static int ticks_to_ctxt_switch = 0;
 /* idle ticks left before we perform a GC */
 static int ticks_to_gc = 0;
 
+#ifdef TRACING
+static void handleSamplingTick(StgBool isManual, void *pIP);
+#endif
+
 /*
  * Function: handle_tick()
  *
  * At each occurrence of a tick, the OS timer will invoke
- * handle_tick().
+ * handle_tick(). If available, we also get information
+ * about the thread's instruction pointer when the signal
+ * got raised.
  */
 static
 void
-handle_tick(int unused STG_UNUSED)
+handle_tick(StgBool isManual, void *pIP)
 {
+#ifdef TRACING
+  // Manually replicated signals are for being able to sample the
+  // thread state only, ignore them on other threads.
+  handleSamplingTick(isManual, pIP);
+#else
+  (void) pIP;
+#endif
+  if (isManual) { return; }
+
   handleProfTick();
   if (RtsFlags.ConcFlags.ctxtSwitchTicks > 0) {
       ticks_to_ctxt_switch--;
@@ -75,7 +94,13 @@ handle_tick(int unused STG_UNUSED)
               // disable timer signals (see #1623, #5991)
               // but only if we're not profiling
 #ifndef PROFILING
-              stopTimer();
+#ifdef TRACING
+              if (!RtsFlags.TraceFlags.timerSampling) {
+#endif
+                  stopTimer();
+#ifdef TRACING
+              }
+#endif
 #endif
           }
       } else {
@@ -85,7 +110,66 @@ handle_tick(int unused STG_UNUSED)
   default:
       break;
   }
+
+#ifdef TRACING
+#ifdef USE_PERF_EVENTS
+  if(RtsFlags.PerfEventFlags.sampleType) {
+      perf_event_timer();
+  }
+#endif
+#endif
+
+}
+
+#ifdef TRACING
+static StgBool do_ticker_sampling = rtsTrue;
+
+static void
+flushTickerSamples(Task *task, Capability *cap)
+{
+    if (task->timer_ip_sample_count <= 0) { return; }
+    traceSamples(cap, 1, SAMPLE_BY_TIME, SAMPLE_INSTR_PTR,
+                 task->timer_ip_sample_count, task->timer_ip_samples, NULL);
+    task->timer_ip_sample_count = 0;
+}
+
+static void
+handleSamplingTick(StgBool isManual, void *pIP)
+{
+    (void) isManual; (void) pIP;
+    if (!RtsFlags.TraceFlags.timerSampling ||
+        !do_ticker_sampling) { return; }
+
+    // Figure out where we are
+    Task *task = myTask();
+    Capability *cap = (task ? myTask()->cap : NULL);
+    if (RtsFlags.TraceFlags.timerSampling && cap) {
+
+        // Take a sample, handle overflow
+        task->timer_ip_samples[task->timer_ip_sample_count++] = pIP;
+        if (task->timer_ip_sample_count >= TIMER_MAX_SAMPLES) {
+            flushTickerSamples(task, cap);
+        }
+    }
+
+#if defined(THREADED_RTS) && defined(HAVE_PTHREAD_H) && !defined(mingw32_HOST_OS)
+    if (!isManual) {
+        // Replicate the signal to all other capabilities
+        nat i;
+        for (i = 0; i < n_capabilities; i++)
+            if (capabilities[i] != cap) {
+                Task *t = capabilities[i]->running_task;
+                if (t && t->timer_ip_samples) {
+                    pthread_kill(t->id, ITIMER_SIGNAL);
+                }
+            }
+    }
+#else
+    (void) isManual;
+#endif
 }
+#endif
+
 
 // This global counter is used to allow multiple threads to stop the
 // timer temporarily with a stopTimer()/startTimer() pair.  If 
@@ -111,6 +195,9 @@ startTimer(void)
 {
     if (atomic_dec(&timer_disabled) == 0) {
         if (RtsFlags.MiscFlags.tickInterval != 0) {
+#ifdef TRACING
+            do_ticker_sampling = RtsFlags.TraceFlags.timerSampling;
+#endif
             startTicker();
         }
     }
@@ -133,3 +220,30 @@ exitTimer (rtsBool wait)
         exitTicker(wait);
     }
 }
+
+#ifdef TRACING
+void
+stopTickerSampling( void )
+{
+    do_ticker_sampling = rtsFalse;
+    // also flush, if applicable
+    Task *task = myTask();
+    if (RtsFlags.TraceFlags.timerSampling && task && task->cap) {
+        flushTickerSamples(task, task->cap);
+    }
+}
+
+void
+startTickerSampling( void )
+{
+    do_ticker_sampling = rtsTrue;
+}
+#endif
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/Timer.h b/rts/Timer.h
index b03ef0680f11..8bd7da4d546e 100644
--- a/rts/Timer.h
+++ b/rts/Timer.h
@@ -13,3 +13,11 @@ RTS_PRIVATE void initTimer (void);
 RTS_PRIVATE void exitTimer (rtsBool wait);
 
 #endif /* TIMER_H */
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/Trace.c b/rts/Trace.c
index 21901891cb45..9fde552c0c51 100644
--- a/rts/Trace.c
+++ b/rts/Trace.c
@@ -709,6 +709,57 @@ void traceUserMsg(Capability *cap, char *msg)
     traceFormatUserMsg(cap, "%s", msg);
 }
 
+void traceDebugData(EventTypeNum num, StgWord16 size, StgWord8 *dbg)
+{
+    if (eventlog_enabled) {
+        postDebugData(num, size, dbg);
+    }
+}
+
+void traceDebugModule(char *mod_name)
+{
+	if (eventlog_enabled)
+		postDebugModule(mod_name);
+}
+
+void traceDebugBlock(char *label)
+{
+	if (eventlog_enabled)
+		postDebugBlock(label);
+}
+
+void traceSampleRange(void *low, void *high)
+{
+    if (eventlog_enabled) {
+        postSampleRange(low, high);
+    }
+}
+
+void traceSamples(Capability *cap, StgBool own_cap,
+                 StgWord32 sample_by, StgWord32 sample_type,
+                 StgWord32 cnt, void **samples, nat *weights)
+{
+#ifdef DEBUG
+    StgWord32 i;
+    if (RtsFlags.TraceFlags.tracing == TRACE_STDERR) {
+        // Maybe sort this somewhen so it looks more useful...
+        tracePreface();
+        debugBelch("cap %d sample %d by %d:", cap->no, sample_type, sample_by);
+        for (i = 0; i < cnt; i++) {
+            debugBelch((i ? ", %p" : " %p"), samples[i]);
+            if (weights)
+                debugBelch(" (x%d)", weights[i]);
+        }
+        debugBelch("\n");
+    } else
+#endif
+    {
+        if (eventlog_enabled) {
+            postSamples(cap, own_cap, sample_by, sample_type, cnt, samples, weights);
+        }
+    }
+}
+
 void traceUserMarker(Capability *cap, char *markername)
 {
     /* Note: traceUserMarker is special since it has no wrapper (it's called
@@ -805,3 +856,11 @@ void dtraceUserMarkerWrapper(Capability *cap, char *msg)
 }
 
 #endif /* !defined(DEBUG) && !defined(TRACING) && defined(DTRACE) */
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/Trace.h b/rts/Trace.h
index 31aefcb58d9f..f66a77222319 100644
--- a/rts/Trace.h
+++ b/rts/Trace.h
@@ -203,6 +203,32 @@ void traceUserMsg(Capability *cap, char *msg);
  */
 void traceUserMarker(Capability *cap, char *msg);
 
+/*
+ * Profiling
+ */
+
+#define SAMPLE_BY_TIME         0
+#define SAMPLE_BY_CYCLE        1
+#define SAMPLE_BY_STACK_ALLOC  2
+#define SAMPLE_BY_HEAP_ALLOC   3
+#define SAMPLE_BY_HEAP_LIFE    4
+#define SAMPLE_BY_CACHE        5
+#define SAMPLE_BY_CACHE_MISS   6
+#define SAMPLE_BY_BRANCH       7
+#define SAMPLE_BY_BRANCH_MISS  8
+#define SAMPLE_BY_STALLED_FE   9
+#define SAMPLE_BY_STALLED_BE   10
+
+#define SAMPLE_INSTR_PTR       0
+
+void traceDebugData(EventTypeNum num, StgWord16 size, StgWord8 *dbg);
+void traceDebugModule(char *unit_name);
+void traceDebugBlock(char *label);
+void traceSampleRange(void *low, void *high);
+void traceSamples(Capability *cap, StgBool own_cap,
+                  StgWord32 sample_by, StgWord32 sample_type,
+                  StgWord32 cnt, void **samples, nat *weights);
+
 /*
  * An event to record a Haskell thread's label/name
  * Used by GHC.Conc.labelThread
@@ -880,3 +906,11 @@ INLINE_HEADER void traceTaskDelete(Task *task STG_UNUSED)
 #include "EndPrivate.h"
 
 #endif /* TRACE_H */
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/Updates.h b/rts/Updates.h
index 1bd742a7465f..36280b5b12eb 100644
--- a/rts/Updates.h
+++ b/rts/Updates.h
@@ -91,3 +91,11 @@ INLINE_HEADER void updateWithIndirection (Capability *cap,
 #endif
 
 #endif /* UPDATES_H */
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/WSDeque.c b/rts/WSDeque.c
index 8efd1bbe487e..ef8c22072b45 100644
--- a/rts/WSDeque.c
+++ b/rts/WSDeque.c
@@ -3,7 +3,7 @@
  * (c) The GHC Team, 2009
  *
  * Work-stealing Deque data structure
- * 
+ *
  * The implementation uses Double-Ended Queues with lock-free access
  * (thereby often called "deque") as described in
  *
@@ -18,24 +18,24 @@
  * array is accessed with indices modulo array-size. While this bears
  * the risk of overflow, we assume that (with 64 bit indices), a
  * program must run very long to reach that point.
- * 
+ *
  * The write end of the queue (position bottom) can only be used with
  * mutual exclusion, i.e. by exactly one caller at a time.  At this
  * end, new items can be enqueued using pushBottom()/newSpark(), and
  * removed using popBottom()/reclaimSpark() (the latter implying a cas
  * synchronisation with potential concurrent readers for the case of
  * just one element).
- * 
+ *
  * Multiple readers can steal from the read end (position top), and
  * are synchronised without a lock, based on a cas of the top
  * position. One reader wins, the others return NULL for a failure.
- * 
+ *
  * Both popWSDeque and stealWSDeque also return NULL when the queue is empty.
  *
  * Testing: see testsuite/tests/rts/testwsdeque.c.  If
  * there's anything wrong with the deque implementation, this test
  * will probably catch it.
- * 
+ *
  * ---------------------------------------------------------------------------*/
 
 #include "PosixSource.h"
@@ -56,7 +56,7 @@ static StgWord
 roundUp2(StgWord val)
 {
     StgWord rounded = 1;
-    
+
     /* StgWord is unsigned anyway, only catch 0 */
     if (val == 0) {
         barf("DeQue,roundUp2: invalid size 0 requested");
@@ -71,11 +71,11 @@ roundUp2(StgWord val)
 WSDeque *
 newWSDeque (nat size)
 {
-    StgWord realsize; 
+    StgWord realsize;
     WSDeque *q;
-    
+
     realsize = roundUp2(size); /* to compute modulo as a bitwise & */
-    
+
     q = (WSDeque*) stgMallocBytes(sizeof(WSDeque),   /* admin fields */
                                   "newWSDeque");
     q->elements = stgMallocBytes(realsize * sizeof(StgClosurePtr), /* dataspace */
@@ -83,11 +83,11 @@ newWSDeque (nat size)
     q->top=0;
     q->bottom=0;
     q->topBound=0; /* read by writer, updated each time top is read */
-    
+
     q->size = realsize;  /* power of 2 */
     q->moduloSize = realsize - 1; /* n % size == n & moduloSize  */
-    
-    ASSERT_WSDEQUE_INVARIANTS(q); 
+
+    ASSERT_WSDEQUE_INVARIANTS(q);
     return q;
 }
 
@@ -103,7 +103,7 @@ freeWSDeque (WSDeque *q)
 }
 
 /* -----------------------------------------------------------------------------
- * 
+ *
  * popWSDeque: remove an element from the write end of the queue.
  * Returns the removed spark, and NULL if a race is lost or the pool
  * empty.
@@ -123,9 +123,9 @@ popWSDeque (WSDeque *q)
     StgWord t, b;
     long  currSize;
     void * removed;
-    
-    ASSERT_WSDEQUE_INVARIANTS(q); 
-    
+
+    ASSERT_WSDEQUE_INVARIANTS(q);
+
     b = q->bottom;
 
     // "decrement b as a test, see what happens"
@@ -153,7 +153,7 @@ popWSDeque (WSDeque *q)
     if (currSize > 0) { /* no danger, still elements in buffer after b-- */
         // debugBelch("popWSDeque: t=%ld b=%ld = %ld\n", t, b, removed);
         return removed;
-    } 
+    }
     /* otherwise, has someone meanwhile stolen the same (last) element?
        Check and increment top value to know  */
     if ( !(CASTOP(&(q->top),t,t+1)) ) {
@@ -161,10 +161,10 @@ popWSDeque (WSDeque *q)
     }
     q->bottom = t+1; /* anyway, empty now. Adjust bottom consistently. */
     q->topBound = t+1; /* ...and cached top value as well */
-    
-    ASSERT_WSDEQUE_INVARIANTS(q); 
+
+    ASSERT_WSDEQUE_INVARIANTS(q);
     ASSERT(q->bottom >= q->top);
-    
+
     // debugBelch("popWSDeque: t=%ld b=%ld = %ld\n", t, b, removed);
 
     return removed;
@@ -178,27 +178,27 @@ void *
 stealWSDeque_ (WSDeque *q)
 {
     void * stolen;
-    StgWord b,t; 
-    
+    StgWord b,t;
+
 // Can't do this on someone else's spark pool:
-// ASSERT_WSDEQUE_INVARIANTS(q); 
-    
+// ASSERT_WSDEQUE_INVARIANTS(q);
+
     // NB. these loads must be ordered, otherwise there is a race
     // between steal and pop.
     t = q->top;
     load_load_barrier();
     b = q->bottom;
-    
+
     // NB. b and t are unsigned; we need a signed value for the test
     // below, because it is possible that t > b during a
     // concurrent popWSQueue() operation.
-    if ((long)b - (long)t <= 0 ) { 
+    if ((long)b - (long)t <= 0 ) {
         return NULL; /* already looks empty, abort */
   }
-    
+
     /* now access array, see pushBottom() */
     stolen = q->elements[t & q->moduloSize];
-    
+
     /* now decide whether we have won */
     if ( !(CASTOP(&(q->top),t,t+1)) ) {
         /* lost the race, someon else has changed top in the meantime */
@@ -208,8 +208,8 @@ stealWSDeque_ (WSDeque *q)
     // debugBelch("stealWSDeque_: t=%d b=%d\n", t, b);
 
 // Can't do this on someone else's spark pool:
-// ASSERT_WSDEQUE_INVARIANTS(q); 
-    
+// ASSERT_WSDEQUE_INVARIANTS(q);
+
     return stolen;
 }
 
@@ -217,11 +217,11 @@ void *
 stealWSDeque (WSDeque *q)
 {
     void *stolen;
-    
-    do { 
+
+    do {
         stolen = stealWSDeque_(q);
     } while (stolen == NULL && !looksEmptyWSDeque(q));
-    
+
     return stolen;
 }
 
@@ -238,17 +238,17 @@ pushWSDeque (WSDeque* q, void * elem)
 {
     StgWord t;
     StgWord b;
-    StgWord sz = q->moduloSize; 
-    
-    ASSERT_WSDEQUE_INVARIANTS(q); 
-    
+    StgWord sz = q->moduloSize;
+
+    ASSERT_WSDEQUE_INVARIANTS(q);
+
     /* we try to avoid reading q->top (accessed by all) and use
-       q->topBound (accessed only by writer) instead. 
+       q->topBound (accessed only by writer) instead.
        This is why we do not just call empty(q) here.
     */
     b = q->bottom;
     t = q->topBound;
-    if ( (StgInt)b - (StgInt)t >= (StgInt)sz ) { 
+    if ( (StgInt)b - (StgInt)t >= (StgInt)sz ) {
         /* NB. 1. sz == q->size - 1, thus ">="
            2. signed comparison, it is possible that t > b
         */
@@ -260,20 +260,20 @@ pushWSDeque (WSDeque* q, void * elem)
                will in the meantime use the old one and modify only top.
                This means: we cannot safely free the old space! Can keep it
                on a free list internally here...
-               
+
                Potential bug in combination with steal(): if array is
                replaced, it is unclear which one concurrent steal operations
                use. Must read the array base address in advance in steal().
             */
 #if defined(DISCARD_NEW)
-            ASSERT_WSDEQUE_INVARIANTS(q); 
+            ASSERT_WSDEQUE_INVARIANTS(q);
             return rtsFalse; // we didn't push anything
 #else
             /* could make room by incrementing the top position here.  In
              * this case, should use CASTOP. If this fails, someone else has
              * removed something, and new room will be available.
              */
-            ASSERT_WSDEQUE_INVARIANTS(q); 
+            ASSERT_WSDEQUE_INVARIANTS(q);
 #endif
         }
     }
@@ -289,7 +289,15 @@ pushWSDeque (WSDeque* q, void * elem)
      */
     write_barrier();
     q->bottom = b + 1;
-    
-    ASSERT_WSDEQUE_INVARIANTS(q); 
+
+    ASSERT_WSDEQUE_INVARIANTS(q);
     return rtsTrue;
 }
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/WSDeque.h b/rts/WSDeque.h
index 9c6247811363..15e925a24d41 100644
--- a/rts/WSDeque.h
+++ b/rts/WSDeque.h
@@ -3,7 +3,7 @@
  * (c) The GHC Team, 2009
  *
  * Work-stealing Deque data structure
- * 
+ *
  * ---------------------------------------------------------------------------*/
 
 #ifndef WSDEQUE_H
@@ -11,8 +11,8 @@
 
 typedef struct WSDeque_ {
     // Size of elements array. Used for modulo calculation: we round up
-    // to powers of 2 and use the dyadic log (modulo == bitwise &) 
-    StgWord size; 
+    // to powers of 2 and use the dyadic log (modulo == bitwise &)
+    StgWord size;
     StgWord moduloSize; /* bitmask for modulo */
 
     // top, index where multiple readers steal() (protected by a cas)
@@ -24,7 +24,7 @@ typedef struct WSDeque_ {
 
     // both top and bottom are continuously incremented, and used as
     // an index modulo the current array size.
-  
+
     // lower bound on the current top value. This is an internal
     // optimisation to avoid unnecessarily accessing the top field
     // inside pushBottom
@@ -41,7 +41,7 @@ typedef struct WSDeque_ {
 
 /* INVARIANTS, in this order: reasonable size,
    topBound consistent, space pointer, space accessible to us.
-   
+
    NB. This is safe to use only (a) on a spark pool owned by the
    current thread, or (b) when there's only one thread running, or no
    stealing going on (e.g. during GC).
@@ -54,7 +54,7 @@ typedef struct WSDeque_ {
   ASSERT(*((p)->elements - 1  + ((p)->size)) || 1);
 
 // No: it is possible that top > bottom when using pop()
-//  ASSERT((p)->bottom >= (p)->top);           
+//  ASSERT((p)->bottom >= (p)->top);
 //  ASSERT((p)->size > (p)->bottom - (p)->top);
 
 /* -----------------------------------------------------------------------------
@@ -124,3 +124,11 @@ discardElements (WSDeque *q)
 }
 
 #endif // WSDEQUE_H
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/Weak.c b/rts/Weak.c
index 98ac7603b7cc..5ee38cca7048 100644
--- a/rts/Weak.c
+++ b/rts/Weak.c
@@ -144,3 +144,11 @@ scheduleFinalizers(Capability *cap, StgWeak *list)
 	);
     scheduleThread(cap,t);
 }
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/Weak.h b/rts/Weak.h
index fbdf18a861ff..81210991161b 100644
--- a/rts/Weak.h
+++ b/rts/Weak.h
@@ -25,3 +25,11 @@ void markWeakList(void);
 
 #endif /* WEAK_H */
 
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/eventlog/EventLog.c b/rts/eventlog/EventLog.c
index ef6f69c6dd3b..26033f666999 100644
--- a/rts/eventlog/EventLog.c
+++ b/rts/eventlog/EventLog.c
@@ -106,9 +106,16 @@ char *EventDesc[] = {
   [EVENT_TASK_CREATE]         = "Task create",
   [EVENT_TASK_MIGRATE]        = "Task migrate",
   [EVENT_TASK_DELETE]         = "Task delete",
+  [EVENT_HACK_BUG_T9003]      = "Empty event for bug #9003",
+  [EVENT_DEBUG_MODULE]        = "Debug Module",
+  [EVENT_DEBUG_BLOCK]         = "Debug Block",
+  [EVENT_DEBUG_SOURCE]        = "Debug Source",
+  [EVENT_DEBUG_CORE]          = "Debug Core",
+  [EVENT_DEBUG_SAMPLE_RANGE]  = "Debug Pointer Range",
+  [EVENT_SAMPLES]             = "Profiling samples",
 };
 
-// Event type. 
+// Event type.
 
 typedef struct _EventType {
   EventTypeNum etNum;  // Event Type number.
@@ -132,9 +139,17 @@ static void closeBlockMarker(EventsBuf *ebuf);
 static StgBool hasRoomForEvent(EventsBuf *eb, EventTypeNum eNum);
 static StgBool hasRoomForVariableEvent(EventsBuf *eb, nat payload_bytes);
 
+static StgBool ensureRoomForEvent(EventsBuf *eb, EventTypeNum eNum);
+static StgBool ensureRoomForVariableEvent(EventsBuf *eb, nat payload_bytes);
+
 static inline void postWord8(EventsBuf *eb, StgWord8 i)
 {
-    *(eb->pos++) = i; 
+    *(eb->pos++) = i;
+}
+static inline void postWord8at(EventsBuf *eb STG_UNUSED, StgWord8 i, StgInt8 *pos)
+{
+    ASSERT(pos >= eb->begin && pos < eb->pos);
+    *pos = i;
 }
 
 static inline void postWord16(EventsBuf *eb, StgWord16 i)
@@ -142,6 +157,11 @@ static inline void postWord16(EventsBuf *eb, StgWord16 i)
     postWord8(eb, (StgWord8)(i >> 8));
     postWord8(eb, (StgWord8)i);
 }
+static inline void postWord16at(EventsBuf *eb, StgWord16 i, StgInt8 *pos)
+{
+    postWord8at(eb, (StgWord8)(i >> 8), pos);
+    postWord8at(eb, (StgWord8)i,        pos+1);
+}
 
 static inline void postWord32(EventsBuf *eb, StgWord32 i)
 {
@@ -198,20 +218,137 @@ static inline void postEventHeader(EventsBuf *eb, EventTypeNum type)
 {
     postEventTypeNum(eb, type);
     postTimestamp(eb);
-}    
+}
 
 static inline void postInt8(EventsBuf *eb, StgInt8 i)
 { postWord8(eb, (StgWord8)i); }
 
-static inline void postInt16(EventsBuf *eb, StgInt16 i)
-{ postWord16(eb, (StgWord16)i); }
-
 static inline void postInt32(EventsBuf *eb, StgInt32 i)
 { postWord32(eb, (StgWord32)i); }
 
-static inline void postInt64(EventsBuf *eb, StgInt64 i)
-{ postWord64(eb, (StgWord64)i); }
+// Magic event size constants
+#define EVENT_SIZE_VARIABLE   ((StgWord16) 0xffff)
+#define EVENT_SIZE_DEPRECATED ((StgWord16) 0xfffe)
 
+static StgWord16 getEventSize(EventTypeNum t)
+{
+    switch (t) {
+    case EVENT_CREATE_THREAD:   // (cap, thread)
+    case EVENT_RUN_THREAD:      // (cap, thread)
+    case EVENT_THREAD_RUNNABLE: // (cap, thread)
+    case EVENT_CREATE_SPARK_THREAD: // (cap, spark_thread)
+        return sizeof(EventThreadID);
+
+    case EVENT_MIGRATE_THREAD:  // (cap, thread, new_cap)
+    case EVENT_THREAD_WAKEUP:   // (cap, thread, other_cap)
+        return sizeof(EventThreadID) + sizeof(EventCapNo);
+
+    case EVENT_STOP_THREAD:     // (cap, thread, status)
+        return sizeof(EventThreadID) + sizeof(StgWord16) + sizeof(EventThreadID);
+
+    case EVENT_STARTUP:         // (cap count)
+    case EVENT_CAP_CREATE:      // (cap)
+    case EVENT_CAP_DELETE:      // (cap)
+    case EVENT_CAP_ENABLE:      // (cap)
+    case EVENT_CAP_DISABLE:     // (cap)
+        return sizeof(EventCapNo);
+
+    case EVENT_CAPSET_CREATE:   // (capset, capset_type)
+        return sizeof(EventCapsetID) + sizeof(EventCapsetType);
+
+    case EVENT_CAPSET_DELETE:   // (capset)
+        return sizeof(EventCapsetID);
+
+    case EVENT_CAPSET_ASSIGN_CAP:  // (capset, cap)
+    case EVENT_CAPSET_REMOVE_CAP:
+        return sizeof(EventCapsetID) + sizeof(EventCapNo);
+
+    case EVENT_OSPROCESS_PID:   // (cap, pid)
+    case EVENT_OSPROCESS_PPID:
+        return sizeof(EventCapsetID) + sizeof(StgWord32);
+
+    case EVENT_SPARK_STEAL:     // (cap, victim_cap)
+        return sizeof(EventCapNo);
+
+    case EVENT_REQUEST_SEQ_GC:  // (cap)
+    case EVENT_REQUEST_PAR_GC:  // (cap)
+    case EVENT_GC_START:        // (cap)
+    case EVENT_GC_END:          // (cap)
+    case EVENT_GC_IDLE:
+    case EVENT_GC_WORK:
+    case EVENT_GC_DONE:
+    case EVENT_GC_GLOBAL_SYNC:  // (cap)
+    case EVENT_SPARK_CREATE:    // (cap)
+    case EVENT_SPARK_DUD:       // (cap)
+    case EVENT_SPARK_OVERFLOW:  // (cap)
+    case EVENT_SPARK_RUN:       // (cap)
+    case EVENT_SPARK_FIZZLE:    // (cap)
+    case EVENT_SPARK_GC:        // (cap)
+        return 0;
+
+    case EVENT_LOG_MSG:          // (msg)
+    case EVENT_USER_MSG:         // (msg)
+    case EVENT_USER_MARKER:      // (markername)
+    case EVENT_RTS_IDENTIFIER:   // (capset, str)
+    case EVENT_PROGRAM_ARGS:     // (capset, strvec)
+    case EVENT_PROGRAM_ENV:      // (capset, strvec)
+    case EVENT_THREAD_LABEL:     // (thread, str)
+    case EVENT_DEBUG_MODULE:     // (variable)
+    case EVENT_DEBUG_BLOCK:      // (variable)
+    case EVENT_DEBUG_SOURCE:     // (variable)
+    case EVENT_DEBUG_CORE:       // (variable)
+    case EVENT_SAMPLES:          // (variable)
+        return EVENT_SIZE_VARIABLE;
+
+    case EVENT_SPARK_COUNTERS:   // (cap, 7*counter)
+        return 7 * sizeof(StgWord64);
+
+    case EVENT_HEAP_ALLOCATED:    // (heap_capset, alloc_bytes)
+    case EVENT_HEAP_SIZE:         // (heap_capset, size_bytes)
+    case EVENT_HEAP_LIVE:         // (heap_capset, live_bytes)
+        return sizeof(EventCapsetID) + sizeof(StgWord64);
+
+    case EVENT_HEAP_INFO_GHC:     // (heap_capset, n_generations,
+                                  //  max_heap_size, alloc_area_size,
+                                  //  mblock_size, block_size)
+        return sizeof(EventCapsetID)
+                           + sizeof(StgWord16)
+                           + sizeof(StgWord64) * 4;
+
+    case EVENT_GC_STATS_GHC:      // (heap_capset, generation,
+                                  //  copied_bytes, slop_bytes, frag_bytes,
+                                  //  par_n_threads,
+                                  //  par_max_copied, par_tot_copied)
+        return sizeof(EventCapsetID)
+                           + sizeof(StgWord16)
+                           + sizeof(StgWord64) * 3
+                           + sizeof(StgWord32)
+                           + sizeof(StgWord64) * 2;
+
+    case EVENT_TASK_CREATE:   // (taskId, cap, tid)
+        return sizeof(EventTaskId) + sizeof(EventCapNo) + sizeof(EventKernelThreadId);
+
+    case EVENT_TASK_MIGRATE:   // (taskId, cap, new_cap)
+        return sizeof(EventTaskId) + sizeof(EventCapNo) + sizeof(EventCapNo);
+
+    case EVENT_TASK_DELETE:   // (taskId)
+        return sizeof(EventTaskId);
+
+    case EVENT_BLOCK_MARKER:
+        return sizeof(StgWord32) + sizeof(EventTimestamp) + 
+            sizeof(EventCapNo);
+
+    case EVENT_DEBUG_SAMPLE_RANGE:
+        return sizeof(StgWord64) + sizeof(StgWord64);
+
+    case EVENT_WALL_CLOCK_TIME: // (capset, unix_epoch_seconds, nanoseconds)
+        return sizeof(EventCapsetID) + sizeof(StgWord64) + sizeof(StgWord32);
+
+    default:
+        return EVENT_SIZE_DEPRECATED; /* ignore deprecated events */
+    }
+
+}
 
 void
 initEventLogging(void)
@@ -253,24 +390,25 @@ initEventLogging(void)
         // We don't have a FMT* symbol for pid_t, so we go via Word64
         // to be sure of not losing range. It would be nicer to have a
         // FMT* symbol or similar, though.
-        sprintf(event_log_filename, "%s.%" FMT_Word64 ".eventlog", prog, (StgWord64)event_log_pid);
+        sprintf(event_log_filename, "%s.%" FMT_Word64 ".eventlog",
+                prog, (StgWord64)event_log_pid);
     }
     stgFree(prog);
 
     /* Open event log file for writing. */
     if ((event_log_file = fopen(event_log_filename, "wb")) == NULL) {
         sysErrorBelch("initEventLogging: can't open %s", event_log_filename);
-        stg_exit(EXIT_FAILURE);    
+        stg_exit(EXIT_FAILURE);
     }
 
-    /* 
+    /*
      * Allocate buffer(s) to store events.
      * Create buffer large enough for the header begin marker, all event
      * types, and header end marker to prevent checking if buffer has room
      * for each of these steps, and remove the need to flush the buffer to
      * disk during initialization.
      *
-     * Use a single buffer to store the header with event types, then flush 
+     * Use a single buffer to store the header with event types, then flush
      * the buffer so all buffers are empty for writing events.
      */
 #ifdef THREADED_RTS
@@ -292,143 +430,10 @@ initEventLogging(void)
 
         eventTypes[t].etNum = t;
         eventTypes[t].desc = EventDesc[t];
+        eventTypes[t].size = getEventSize(t);
 
-        switch (t) {
-        case EVENT_CREATE_THREAD:   // (cap, thread)
-        case EVENT_RUN_THREAD:      // (cap, thread)
-        case EVENT_THREAD_RUNNABLE: // (cap, thread)
-        case EVENT_CREATE_SPARK_THREAD: // (cap, spark_thread)
-            eventTypes[t].size = sizeof(EventThreadID);
-            break;
-
-        case EVENT_MIGRATE_THREAD:  // (cap, thread, new_cap)
-        case EVENT_THREAD_WAKEUP:   // (cap, thread, other_cap)
-            eventTypes[t].size =
-                sizeof(EventThreadID) + sizeof(EventCapNo);
-            break;
-
-        case EVENT_STOP_THREAD:     // (cap, thread, status)
-            eventTypes[t].size =
-                sizeof(EventThreadID) + sizeof(StgWord16) + sizeof(EventThreadID);
-            break;
-
-        case EVENT_STARTUP:         // (cap_count)
-        case EVENT_CAP_CREATE:      // (cap)
-        case EVENT_CAP_DELETE:      // (cap)
-        case EVENT_CAP_ENABLE:      // (cap)
-        case EVENT_CAP_DISABLE:     // (cap)
-            eventTypes[t].size = sizeof(EventCapNo);
-            break;
-
-        case EVENT_CAPSET_CREATE:   // (capset, capset_type)
-            eventTypes[t].size =
-                sizeof(EventCapsetID) + sizeof(EventCapsetType);
-            break;
-
-        case EVENT_CAPSET_DELETE:   // (capset)
-            eventTypes[t].size = sizeof(EventCapsetID);
-            break;
-
-        case EVENT_CAPSET_ASSIGN_CAP:  // (capset, cap)
-        case EVENT_CAPSET_REMOVE_CAP:
-            eventTypes[t].size =
-                sizeof(EventCapsetID) + sizeof(EventCapNo);
-            break;
-
-        case EVENT_OSPROCESS_PID:   // (cap, pid)
-        case EVENT_OSPROCESS_PPID:
-            eventTypes[t].size =
-                sizeof(EventCapsetID) + sizeof(StgWord32);
-            break;
-
-        case EVENT_WALL_CLOCK_TIME: // (capset, unix_epoch_seconds, nanoseconds)
-            eventTypes[t].size =
-                sizeof(EventCapsetID) + sizeof(StgWord64) + sizeof(StgWord32);
-            break;
-
-        case EVENT_SPARK_STEAL:     // (cap, victim_cap)
-            eventTypes[t].size =
-                sizeof(EventCapNo);
-            break;
-
-        case EVENT_REQUEST_SEQ_GC:  // (cap)
-        case EVENT_REQUEST_PAR_GC:  // (cap)
-        case EVENT_GC_START:        // (cap)
-        case EVENT_GC_END:          // (cap)
-        case EVENT_GC_IDLE:
-        case EVENT_GC_WORK:
-        case EVENT_GC_DONE:
-        case EVENT_GC_GLOBAL_SYNC:  // (cap)
-        case EVENT_SPARK_CREATE:    // (cap)
-        case EVENT_SPARK_DUD:       // (cap)
-        case EVENT_SPARK_OVERFLOW:  // (cap)
-        case EVENT_SPARK_RUN:       // (cap)
-        case EVENT_SPARK_FIZZLE:    // (cap)
-        case EVENT_SPARK_GC:        // (cap)
-            eventTypes[t].size = 0;
-            break;
-
-        case EVENT_LOG_MSG:          // (msg)
-        case EVENT_USER_MSG:         // (msg)
-        case EVENT_USER_MARKER:      // (markername)
-        case EVENT_RTS_IDENTIFIER:   // (capset, str)
-        case EVENT_PROGRAM_ARGS:     // (capset, strvec)
-        case EVENT_PROGRAM_ENV:      // (capset, strvec)
-        case EVENT_THREAD_LABEL:     // (thread, str)
-            eventTypes[t].size = 0xffff;
-            break;
-
-        case EVENT_SPARK_COUNTERS:   // (cap, 7*counter)
-            eventTypes[t].size = 7 * sizeof(StgWord64);
-            break;
-
-        case EVENT_HEAP_ALLOCATED:    // (heap_capset, alloc_bytes)
-        case EVENT_HEAP_SIZE:         // (heap_capset, size_bytes)
-        case EVENT_HEAP_LIVE:         // (heap_capset, live_bytes)
-            eventTypes[t].size = sizeof(EventCapsetID) + sizeof(StgWord64);
-            break;
-
-        case EVENT_HEAP_INFO_GHC:     // (heap_capset, n_generations,
-                                      //  max_heap_size, alloc_area_size,
-                                      //  mblock_size, block_size)
-            eventTypes[t].size = sizeof(EventCapsetID)
-                               + sizeof(StgWord16)
-                               + sizeof(StgWord64) * 4;
-            break;
-
-        case EVENT_GC_STATS_GHC:      // (heap_capset, generation,
-                                      //  copied_bytes, slop_bytes, frag_bytes,
-                                      //  par_n_threads,
-                                      //  par_max_copied, par_tot_copied)
-            eventTypes[t].size = sizeof(EventCapsetID)
-                               + sizeof(StgWord16)
-                               + sizeof(StgWord64) * 3
-                               + sizeof(StgWord32)
-                               + sizeof(StgWord64) * 2;
-            break;
-
-        case EVENT_TASK_CREATE:   // (taskId, cap, tid)
-            eventTypes[t].size =
-                sizeof(EventTaskId) + sizeof(EventCapNo) + sizeof(EventKernelThreadId);
-            break;
-
-        case EVENT_TASK_MIGRATE:   // (taskId, cap, new_cap)
-            eventTypes[t].size =
-                sizeof(EventTaskId) + sizeof(EventCapNo) + sizeof(EventCapNo);
-            break;
-
-        case EVENT_TASK_DELETE:   // (taskId)
-            eventTypes[t].size = sizeof(EventTaskId);
-            break;
-
-        case EVENT_BLOCK_MARKER:
-            eventTypes[t].size = sizeof(StgWord32) + sizeof(EventTimestamp) + 
-                sizeof(EventCapNo);
-            break;
-
-        default:
-            continue; /* ignore deprecated events */
-        }
+        // Ignore deprecated and undefined events
+        if (eventTypes[t].size == EVENT_SIZE_DEPRECATED) continue;
 
         // Write in buffer: the start event type.
         postEventType(&eventBuf, &eventTypes[t]);
@@ -436,10 +441,10 @@ initEventLogging(void)
 
     // Mark end of event types in the header.
     postInt32(&eventBuf, EVENT_HET_END);
-    
+
     // Write in buffer: the header end marker.
     postInt32(&eventBuf, EVENT_HEADER_END);
-    
+
     // Prepare event buffer for events (data).
     postInt32(&eventBuf, EVENT_DATA_BEGIN);
 
@@ -505,10 +510,10 @@ void
 freeEventLogging(void)
 {
     StgWord8 c;
-    
+
     // Free events buffer.
     for (c = 0; c < n_capabilities; ++c) {
-        if (capEventBuf[c].begin != NULL) 
+        if (capEventBuf[c].begin != NULL)
             stgFree(capEventBuf[c].begin);
     }
     if (capEventBuf != NULL)  {
@@ -519,7 +524,7 @@ freeEventLogging(void)
     }
 }
 
-void 
+void
 flushEventLog(void)
 {
     if (event_log_file != NULL) {
@@ -527,7 +532,7 @@ flushEventLog(void)
     }
 }
 
-void 
+void
 abortEventLogging(void)
 {
     freeEventLogging();
@@ -540,9 +545,9 @@ abortEventLogging(void)
  * If the buffer is full, prints out the buffer and clears it.
  */
 void
-postSchedEvent (Capability *cap, 
-                EventTypeNum tag, 
-                StgThreadID thread, 
+postSchedEvent (Capability *cap,
+                EventTypeNum tag,
+                StgThreadID thread,
                 StgWord info1,
                 StgWord info2)
 {
@@ -550,11 +555,10 @@ postSchedEvent (Capability *cap,
 
     eb = &capEventBuf[cap->no];
 
-    if (!hasRoomForEvent(eb, tag)) {
-        // Flush event buffer to make room for new event.
-        printAndClearEventBuf(eb);
+    if (!ensureRoomForEvent(eb, tag)) {
+        return;
     }
-    
+
     postEventHeader(eb, tag);
 
     switch (tag) {
@@ -602,9 +606,8 @@ postSparkEvent (Capability *cap,
 
     eb = &capEventBuf[cap->no];
 
-    if (!hasRoomForEvent(eb, tag)) {
-        // Flush event buffer to make room for new event.
-        printAndClearEventBuf(eb);
+    if (!ensureRoomForEvent(&eventBuf, tag)) {
+        return;
     }
 
     postEventHeader(eb, tag);
@@ -638,7 +641,7 @@ postSparkEvent (Capability *cap,
 }
 
 void
-postSparkCountersEvent (Capability *cap, 
+postSparkCountersEvent (Capability *cap,
                         SparkCounters counters,
                         StgWord remaining)
 {
@@ -646,11 +649,10 @@ postSparkCountersEvent (Capability *cap,
 
     eb = &capEventBuf[cap->no];
 
-    if (!hasRoomForEvent(eb, EVENT_SPARK_COUNTERS)) {
-        // Flush event buffer to make room for new event.
-        printAndClearEventBuf(eb);
+    if (!ensureRoomForEvent(&eventBuf, EVENT_SPARK_COUNTERS)) {
+        return;
     }
-    
+
     postEventHeader(eb, EVENT_SPARK_COUNTERS);
     /* EVENT_SPARK_COUNTERS (crt,dud,ovf,cnv,gcd,fiz,rem) */
     postWord64(eb,counters.created);
@@ -668,11 +670,10 @@ postCapEvent (EventTypeNum  tag,
 {
     ACQUIRE_LOCK(&eventBufMutex);
 
-    if (!hasRoomForEvent(&eventBuf, tag)) {
-        // Flush event buffer to make room for new event.
-        printAndClearEventBuf(&eventBuf);
+    if (!ensureRoomForEvent(&eventBuf, tag)) {
+        return;
     }
-    
+
     postEventHeader(&eventBuf, tag);
 
     switch (tag) {
@@ -698,9 +699,8 @@ void postCapsetEvent (EventTypeNum tag,
 {
     ACQUIRE_LOCK(&eventBufMutex);
 
-    if (!hasRoomForEvent(&eventBuf, tag)) {
-        // Flush event buffer to make room for new event.
-        printAndClearEventBuf(&eventBuf);
+    if (!ensureRoomForEvent(&eventBuf, tag)) {
+        return;
     }
 
     postEventHeader(&eventBuf, tag);
@@ -808,7 +808,7 @@ void postWallClockTime (EventCapsetID capset)
     StgWord32 nsec;
 
     ACQUIRE_LOCK(&eventBufMutex);
-    
+
     /* The EVENT_WALL_CLOCK_TIME event is intended to allow programs
        reading the eventlog to match up the event timestamps with wall
        clock time. The normal event timestamps measure time since the
@@ -824,13 +824,12 @@ void postWallClockTime (EventCapsetID capset)
        the elapsed time vs the wall clock time. So to minimise the
        difference we just call them very close together.
      */
-    
+
     getUnixEpochTime(&sec, &nsec);  /* Get the wall clock time */
     ts = time_ns();                 /* Get the eventlog timestamp */
 
-    if (!hasRoomForEvent(&eventBuf, EVENT_WALL_CLOCK_TIME)) {
-        // Flush event buffer to make room for new event.
-        printAndClearEventBuf(&eventBuf);
+    if (!ensureRoomForEvent(&eventBuf, EVENT_WALL_CLOCK_TIME)) {
+        return;
     }
 
     /* Normally we'd call postEventHeader(), but that generates its own
@@ -838,7 +837,7 @@ void postWallClockTime (EventCapsetID capset)
        timestamp we already generated above. */
     postEventTypeNum(&eventBuf, EVENT_WALL_CLOCK_TIME);
     postWord64(&eventBuf, ts);
-    
+
     /* EVENT_WALL_CLOCK_TIME (capset, unix_epoch_seconds, nanoseconds) */
     postCapsetID(&eventBuf, capset);
     postWord64(&eventBuf, sec);
@@ -859,11 +858,10 @@ void postHeapEvent (Capability    *cap,
 
     eb = &capEventBuf[cap->no];
 
-    if (!hasRoomForEvent(eb, tag)) {
-        // Flush event buffer to make room for new event.
-        printAndClearEventBuf(eb);
+    if (!ensureRoomForEvent(&eventBuf, tag)) {
+        return;
     }
-    
+
     postEventHeader(eb, tag);
 
     switch (tag) {
@@ -890,9 +888,8 @@ void postEventHeapInfo (EventCapsetID heap_capset,
 {
     ACQUIRE_LOCK(&eventBufMutex);
 
-    if (!hasRoomForEvent(&eventBuf, EVENT_HEAP_INFO_GHC)) {
-        // Flush event buffer to make room for new event.
-        printAndClearEventBuf(&eventBuf);
+    if (!ensureRoomForEvent(&eventBuf, EVENT_HEAP_INFO_GHC)) {
+        return;
     }
 
     postEventHeader(&eventBuf, EVENT_HEAP_INFO_GHC);
@@ -923,11 +920,10 @@ void postEventGcStats  (Capability    *cap,
 
     eb = &capEventBuf[cap->no];
 
-    if (!hasRoomForEvent(eb, EVENT_GC_STATS_GHC)) {
-        // Flush event buffer to make room for new event.
-        printAndClearEventBuf(eb);
+    if (!ensureRoomForEvent(&eventBuf, EVENT_GC_STATS_GHC)) {
+        return;
     }
-    
+
     postEventHeader(eb, EVENT_GC_STATS_GHC);
     /* EVENT_GC_STATS_GHC (heap_capset, generation,
                            copied_bytes, slop_bytes, frag_bytes,
@@ -948,9 +944,8 @@ void postTaskCreateEvent (EventTaskId taskId,
 {
     ACQUIRE_LOCK(&eventBufMutex);
 
-    if (!hasRoomForEvent(&eventBuf, EVENT_TASK_CREATE)) {
-        // Flush event buffer to make room for new event.
-        printAndClearEventBuf(&eventBuf);
+    if (!ensureRoomForEvent(&eventBuf, EVENT_TASK_CREATE)) {
+        return;
     }
 
     postEventHeader(&eventBuf, EVENT_TASK_CREATE);
@@ -968,9 +963,8 @@ void postTaskMigrateEvent (EventTaskId taskId,
 {
     ACQUIRE_LOCK(&eventBufMutex);
 
-    if (!hasRoomForEvent(&eventBuf, EVENT_TASK_MIGRATE)) {
-        // Flush event buffer to make room for new event.
-        printAndClearEventBuf(&eventBuf);
+    if (!ensureRoomForEvent(&eventBuf, EVENT_TASK_MIGRATE)) {
+        return;
     }
 
     postEventHeader(&eventBuf, EVENT_TASK_MIGRATE);
@@ -986,9 +980,8 @@ void postTaskDeleteEvent (EventTaskId taskId)
 {
     ACQUIRE_LOCK(&eventBufMutex);
 
-    if (!hasRoomForEvent(&eventBuf, EVENT_TASK_DELETE)) {
-        // Flush event buffer to make room for new event.
-        printAndClearEventBuf(&eventBuf);
+    if (!ensureRoomForEvent(&eventBuf, EVENT_TASK_DELETE)) {
+        return;
     }
 
     postEventHeader(&eventBuf, EVENT_TASK_DELETE);
@@ -1005,9 +998,8 @@ postEvent (Capability *cap, EventTypeNum tag)
 
     eb = &capEventBuf[cap->no];
 
-    if (!hasRoomForEvent(eb, tag)) {
-        // Flush event buffer to make room for new event.
-        printAndClearEventBuf(eb);
+    if (!ensureRoomForEvent(eb, tag)) {
+        return;
     }
 
     postEventHeader(eb, tag);
@@ -1020,9 +1012,8 @@ postEventAtTimestamp (Capability *cap, EventTimestamp ts, EventTypeNum tag)
 
     eb = &capEventBuf[cap->no];
 
-    if (!hasRoomForEvent(eb, tag)) {
-        // Flush event buffer to make room for new event.
-        printAndClearEventBuf(eb);
+    if (!ensureRoomForEvent(&eventBuf, tag)) {
+        return;
     }
 
     /* Normally we'd call postEventHeader(), but that generates its own
@@ -1045,9 +1036,8 @@ void postLogMsg(EventsBuf *eb, EventTypeNum type, char *msg, va_list ap)
         size = BUF;
     }
 
-    if (!hasRoomForVariableEvent(eb, size)) {
-        // Flush event buffer to make room for new event.
-        printAndClearEventBuf(eb);
+    if (!ensureRoomForVariableEvent(eb, size)) {
+        return;
     }
 
     postEventHeader(eb, type);
@@ -1070,15 +1060,195 @@ void postCapMsg(Capability *cap, char *msg, va_list ap)
 void postUserMsg(Capability *cap, char *msg, va_list ap)
 {
     postLogMsg(&capEventBuf[cap->no], EVENT_USER_MSG, msg, ap);
-}    
+}
+
+void postDebugData(EventTypeNum num, StgWord16 size, StgWord8 *dbg)
+{
+
+    // Check event size
+    StgWord16 spec_size = getEventSize(num);
+    if (spec_size == EVENT_SIZE_DEPRECATED) {
+        barf("Invalid debug type num %d. Probably corrupt debug data.", num);
+        return;
+    }
+    if (spec_size != EVENT_SIZE_VARIABLE && size != spec_size) {
+        barf("Debug data %d has size %d, but %d expected!",
+             num, size, spec_size);
+        return;
+    }
+
+    EventsBuf *eb = &eventBuf; // Should be safe without locking
+
+    // Flush buffer if necessary
+    if (!ensureRoomForVariableEvent(eb, size)) {
+        return;
+    }
+
+    // Post header
+    postEventHeader(eb, num);
+    if (spec_size == EVENT_SIZE_VARIABLE)
+        postPayloadSize(eb, size);
+
+    // Post data
+    postBuf(eb, dbg, size);
+    dbg += size;
+
+}
+
+void postDebugModule(char *mod_name)
+{
+	EventsBuf *eb = &eventBuf; // Should be safe without locking
+
+	// Check for flush
+	nat size = strlen(mod_name) + 2;
+	if (!ensureRoomForVariableEvent(eb, size)) {
+		return;
+	}
+
+	// Write out
+	postEventHeader(eb, EVENT_DEBUG_MODULE);
+	postPayloadSize(eb, size);
+	postWord8(eb, 0); // No package name
+	postBuf(eb, (StgWord8 *)mod_name, (int) size-1);
+
+}
+
+void postDebugBlock(char *label)
+{
+	EventsBuf *eb = &eventBuf; // Should be safe without locking
+
+	// Check for flush
+	nat size = sizeof(StgWord16) + sizeof(StgWord16) + strlen(label) + 1;
+	if (!ensureRoomForVariableEvent(eb, size)) {
+		return;
+	}
+
+	// Write out
+	postEventHeader(eb, EVENT_DEBUG_BLOCK);
+	postPayloadSize(eb, size);
+	postWord16(eb, (StgWord16)0xffff);
+	postWord16(eb, (StgWord16)0xffff);
+	postBuf(eb, (StgWord8 *)label, (int) strlen(label) + 1);
+
+}
+
+void postSampleRange(void *low, void *high)
+{
+    EventsBuf *eb = &eventBuf; // Should be safe without locking
+
+    if (!ensureRoomForEvent(&eventBuf, EVENT_DEBUG_SAMPLE_RANGE)) {
+        return;
+    }
+
+    // Post data
+    postEventHeader(eb, EVENT_DEBUG_SAMPLE_RANGE);
+    postWord64(eb, (StgWord64) low);
+    postWord64(eb, (StgWord64) high);
+}
+
+void postSamples(Capability *cap, StgBool own_cap,
+                 StgWord32 sample_by, StgWord32 sample_type,
+                 StgWord32 cnt, void **samples, nat *weights)
+{
+
+    // (size:16, cap:16, verb:8, noun:8, various )
+    nat hdr_size = sizeof(EventCapNo) + 2 * sizeof(StgWord8);
+    nat est_size = hdr_size + cnt * sizeof(StgWord64);
+    EventsBuf *eb = own_cap ? &capEventBuf[cap->no] : &eventBuf;
+    if (!ensureRoomForVariableEvent(eb, est_size)) {
+        return;
+    }
+    postEventHeader(eb, EVENT_SAMPLES);
+    StgInt8 *size_pos = eb->pos;
+    postPayloadSize(eb, 0);
+    postCapNo(eb, cap->no);
+    postWord8(eb, sample_by);
+    postWord8(eb, sample_type);
+
+    // We actually put quite a bit of effort into compressing the
+    // samples here. The basic idea is that we will often have samples
+    // in very close proximity, which can be exploited. Note that we
+    // *might* end up using more space than estimated, in which case
+    // this event might get split up.The encoding is:
+    //  (sample_encoding:4, weight_encoding:4, sample, weight)
+    // with sample encoding types being:
+    //  0  = 8-bit offset to previous address
+    //  1  = reverse 8-bit offset to previous address
+    //  4  = 32-bit offset to previous address
+    //  5  = reverse 32-bit offset to previous address
+    //  15 = direct encoding
+    // and weight encoding being simply the number of bytes used to
+    // encode the weight. If zero bytes are used for a weight, this
+    // implies weight 1.
+    nat i = 0, done = 0, weight = 0;
+    StgWord64 last = 0;
+    for (; i < cnt; i++) {
+        weight += (weights ? weights[i] : 1);
+        // Next entry the same? compress
+        if (i+1 < cnt && samples[i] == samples[i+1])
+            continue;
+        // Weight encoding
+        nat wbytes;
+        if (weight == 1)               wbytes = 0;
+        else if (weight <= 0xff)       wbytes = 1;
+        else if (weight <= 0xffff)     wbytes = 2;
+        else if (weight <= 0xffffffff) wbytes = 4;
+        else                           wbytes = 8;
+        // Similar to last entry?
+        StgWord64 cur = (StgWord64) samples[i];
+        #define CHECK_WRITE(n) \
+            if(eb->pos + (n) >= eb->begin + eb->size) break;
+        if (cur - last <= 0xff) {
+            CHECK_WRITE(2 + wbytes);
+            postWord8(eb, 0x00 | wbytes);
+            postWord8(eb, (StgWord8) (cur - last));
+        } else if (last - cur <= 0xff) {
+            CHECK_WRITE(2 + wbytes);
+            postWord8(eb, 0x10 | wbytes);
+            postWord8(eb, (StgWord8) (last - cur));
+        } else if (cur - last <= 0xffffffff) {
+            CHECK_WRITE(2 + wbytes);
+            postWord8(eb, 0x40 | wbytes);
+            postWord32(eb, (StgWord32) (cur - last));
+        } else if (last - cur <= 0xffffffff) {
+            CHECK_WRITE(2 + wbytes);
+            postWord8(eb, 0x50 | wbytes);
+            postWord32(eb, (StgWord32) (last - cur));
+        } else {
+            CHECK_WRITE(9 + wbytes);
+            postWord8(eb, 0xf0 | wbytes);
+            postWord64(eb, cur);
+        }
+        #undef CHECK_WRITE
+        switch(wbytes) {
+        case 0: break;
+        case 1: postWord8(eb, (StgWord8) weight); break;
+        case 2: postWord16(eb, (StgWord16) weight); break;
+        case 4: postWord32(eb, (StgWord32) weight); break;
+        case 8: postWord64(eb, (StgWord64) weight); break;
+        }
+        // Prepare writing next entry
+        last = cur;
+        weight = 0;
+        done = i+1;
+    }
+    // Determine and write final length
+    EventPayloadSize size = eb->pos - size_pos - sizeof(EventPayloadSize);
+    postWord16at(eb, size, size_pos);
+    // Samples left for output? Generate another message
+    if (done < cnt) {
+        printAndClearEventBuf(eb);
+        postSamples(cap, own_cap, sample_by, sample_type, cnt-done, samples+done, weights+done);
+    }
+}
+
 
 void postEventStartup(EventCapNo n_caps)
 {
     ACQUIRE_LOCK(&eventBufMutex);
 
-    if (!hasRoomForEvent(&eventBuf, EVENT_STARTUP)) {
-        // Flush event buffer to make room for new event.
-        printAndClearEventBuf(&eventBuf);
+    if (!ensureRoomForEvent(&eventBuf, EVENT_STARTUP)) {
+        return;
     }
 
     // Post a STARTUP event with the number of capabilities
@@ -1119,13 +1289,8 @@ void postThreadLabel(Capability    *cap,
 
     eb = &capEventBuf[cap->no];
 
-    if (!hasRoomForVariableEvent(eb, size)){
-        printAndClearEventBuf(eb);
-
-        if (!hasRoomForVariableEvent(eb, size)){
-            // Event size exceeds buffer size, bail out:
-            return;
-        }
+    if (!ensureRoomForVariableEvent(eb, size)){
+       return;
     }
 
     postEventHeader(eb, EVENT_THREAD_LABEL);
@@ -1155,8 +1320,8 @@ void closeBlockMarker (EventsBuf *ebuf)
 
 void postBlockMarker (EventsBuf *eb)
 {
-    if (!hasRoomForEvent(eb, EVENT_BLOCK_MARKER)) {
-        printAndClearEventBuf(eb);
+    if (!ensureRoomForEvent(eb, EVENT_BLOCK_MARKER)) {
+        return;
     }
 
     closeBlockMarker(eb);
@@ -1177,7 +1342,7 @@ void printAndClearEventBuf (EventsBuf *ebuf)
     if (ebuf->begin != NULL && ebuf->pos != ebuf->begin)
     {
         numBytes = ebuf->pos - ebuf->begin;
-        
+
         written = fwrite(ebuf->begin, 1, numBytes, event_log_file);
         if (written != numBytes) {
             debugBelch(
@@ -1185,7 +1350,7 @@ void printAndClearEventBuf (EventsBuf *ebuf)
                 " doesn't match numBytes=%" FMT_Word64, written, numBytes);
             return;
         }
-        
+
         resetEventsBuf(ebuf);
         flushCount++;
 
@@ -1232,7 +1397,39 @@ StgBool hasRoomForVariableEvent(EventsBuf *eb, nat payload_bytes)
   } else  {
       return 1; // Buf has enough space for the event.
   }
-}    
+}
+
+StgBool ensureRoomForEvent(EventsBuf *eb, EventTypeNum eNum)
+{
+    if (!hasRoomForEvent(eb, eNum)) {
+        // Flush event buffer to make room for new event.
+        printAndClearEventBuf(eb);
+    }
+    return 1;
+}
+
+StgBool ensureRoomForVariableEvent(EventsBuf *eb, nat payload_bytes)
+{
+
+    // Safety - messages of this size can't be printed at all because
+    // there's no way to write their length in 16 bits.
+    if (payload_bytes > (1 << 16)) {
+        barf("Oversized event of size %d had to be dropped!", payload_bytes);
+        return 0;
+    }
+
+    if (!hasRoomForVariableEvent(eb, payload_bytes)) {
+        // Flush event buffer to make room for new event.
+        printAndClearEventBuf(eb);
+        // Recheck. This actually shouldn't happen given an event log buffer larger than the above-checked maximum event size
+        if (!hasRoomForVariableEvent(eb, payload_bytes)) {
+            barf("Event of size %d is dropped!",
+                 payload_bytes);
+            return 0;
+        }
+    }
+    return 1;
+}
 
 void postEventType(EventsBuf *eb, EventType *et)
 {
@@ -1252,3 +1449,11 @@ void postEventType(EventsBuf *eb, EventType *et)
 }
 
 #endif /* TRACING */
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/eventlog/EventLog.h b/rts/eventlog/EventLog.h
index 85370e984387..23d314152adc 100644
--- a/rts/eventlog/EventLog.h
+++ b/rts/eventlog/EventLog.h
@@ -137,6 +137,18 @@ void postTaskMigrateEvent (EventTaskId taskId,
 
 void postTaskDeleteEvent (EventTaskId taskId);
 
+/*
+ * Sample-based profiling
+ */
+
+void postDebugData(EventTypeNum num, StgWord16 size, StgWord8 *dbg);
+void postDebugModule(char *unit_name);
+void postDebugBlock(char *label);
+void postSampleRange(void *low, void *high);
+void postSamples(Capability *cap, StgBool own_cap,
+                 StgWord32 sample_by, StgWord32 sample_type,
+                 StgWord32 cnt, void **samples, nat *weights);
+
 #else /* !TRACING */
 
 INLINE_HEADER void postSchedEvent (Capability *cap  STG_UNUSED,
@@ -170,3 +182,11 @@ INLINE_HEADER void postThreadLabel(Capability    *cap   STG_UNUSED,
 #include "EndPrivate.h"
 
 #endif /* TRACING_H */
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/ghc.mk b/rts/ghc.mk
index 1e0b6def87fc..378f8aa82884 100644
--- a/rts/ghc.mk
+++ b/rts/ghc.mk
@@ -117,7 +117,7 @@ else
 rts/dist/build/lib$(LIBFFI_NAME)$(soext): libffi/build/inst/lib/lib$(LIBFFI_NAME)$(soext)
 	cp libffi/build/inst/lib/lib$(LIBFFI_NAME)$(soext)* rts/dist/build
 ifeq "$(TargetOS_CPP)" "darwin"
-	install_name_tool -id @rpath/rts-$(rts_VERSION)/lib$(LIBFFI_NAME)$(soext) rts/dist/build/lib$(LIBFFI_NAME)$(soext)
+	install_name_tool -id @rpath/lib$(LIBFFI_NAME)$(soext) rts/dist/build/lib$(LIBFFI_NAME)$(soext)
 endif
 endif
 endif
@@ -188,15 +188,20 @@ ifneq "$$(findstring dyn, $1)" ""
 ifeq "$$(HostOS_CPP)" "mingw32" 
 $$(rts_$1_LIB) : $$(rts_$1_OBJS) $$(ALL_RTS_DEF_LIBS) rts/dist/libs.depend rts/dist/build/$$(LIBFFI_DLL)
 	"$$(RM)" $$(RM_OPTS) $$@
-	"$$(rts_dist_HC)" -package-name rts -shared -dynamic -dynload deploy \
+	"$$(rts_dist_HC)" -this-package-key rts -shared -dynamic -dynload deploy \
 	  -no-auto-link-packages -Lrts/dist/build -l$$(LIBFFI_NAME) \
-	  `cat rts/dist/libs.depend` $$(rts_$1_OBJS) $$(ALL_RTS_DEF_LIBS) -o $$@
+         `cat rts/dist/libs.depend` $$(rts_$1_OBJS) $$(ALL_RTS_DEF_LIBS) \
+         $$(rts_dist_$1_GHC_LD_OPTS) \
+         -o $$@
 else
 ifneq "$$(UseSystemLibFFI)" "YES"
 LIBFFI_LIBS = -Lrts/dist/build -l$$(LIBFFI_NAME)
 ifeq "$$(TargetElf)" "YES"
 LIBFFI_LIBS += -optl-Wl,-rpath -optl-Wl,'$$$$ORIGIN' -optl-Wl,-zorigin
 endif
+ifeq "$(TargetOS_CPP)" "darwin"
+LIBFFI_LIBS += -optl-Wl,-rpath -optl-Wl,@loader_path
+endif
 
 else
 # flags will be taken care of in rts/dist/libs.depend
@@ -204,10 +209,10 @@ LIBFFI_LIBS =
 endif
 $$(rts_$1_LIB) : $$(rts_$1_OBJS) $$(rts_$1_DTRACE_OBJS) rts/dist/libs.depend $$(rts_dist_FFI_SO)
 	"$$(RM)" $$(RM_OPTS) $$@
-	"$$(rts_dist_HC)" -package-name rts -shared -dynamic -dynload deploy \
+	"$$(rts_dist_HC)" -this-package-key rts -shared -dynamic -dynload deploy \
 	  -no-auto-link-packages $$(LIBFFI_LIBS) `cat rts/dist/libs.depend` $$(rts_$1_OBJS) \
+          $$(rts_dist_$1_GHC_LD_OPTS) \
 	  $$(rts_$1_DTRACE_OBJS) -o $$@
-	$(call relative-dynlib-references,rts,dist,1,$1)
 endif
 else
 $$(rts_$1_LIB) : $$(rts_$1_OBJS) $$(rts_$1_DTRACE_OBJS)
@@ -278,7 +283,7 @@ STANDARD_OPTS += -DCOMPILING_RTS
 rts_CC_OPTS += $(WARNING_OPTS)
 rts_CC_OPTS += $(STANDARD_OPTS)
 
-rts_HC_OPTS += $(STANDARD_OPTS) -package-name rts
+rts_HC_OPTS += $(STANDARD_OPTS) -this-package-key rts
 
 ifneq "$(GhcWithSMP)" "YES"
 rts_CC_OPTS += -DNOSMP
@@ -481,6 +486,26 @@ rts_PACKAGE_CPP_OPTS += '-DFFI_LIB="C$(LIBFFI_NAME)"'
 
 endif
 
+#-----------------------------------------------------------------------------
+# Add perf_event profiling interface, if available
+
+ifeq "$(GhcRtsWithPerfEvent)" "YES"
+rts_CC_OPTS += -DUSE_PERF_EVENT
+endif
+
+#-----------------------------------------------------------------------------
+# Add support for reading DWARF debugging information, if available
+
+ifeq "$(GhcRtsWithDwarf)" "YES"
+rts_CC_OPTS += -DUSE_DWARF
+rts_PACKAGE_CPP_OPTS += -DUSE_DWARF
+rts_PACKAGE_CPP_OPTS += -DDWARF_INCLUDE_DIR=$(DwarfIncludeDir)
+rts_PACKAGE_CPP_OPTS += -DDWARF_LIB_DIR=$(DwarfLibDir)
+else
+rts_PACKAGE_CPP_OPTS += -DDWARF_INCLUDE_DIR=
+rts_PACKAGE_CPP_OPTS += -DDWARF_LIB_DIR=
+endif
+
 # -----------------------------------------------------------------------------
 # dependencies
 
diff --git a/rts/hooks/FlagDefaults.c b/rts/hooks/FlagDefaults.c
index ce1666f06d95..18cc76c8f951 100644
--- a/rts/hooks/FlagDefaults.c
+++ b/rts/hooks/FlagDefaults.c
@@ -19,3 +19,11 @@ defaultsHook (void)
   */
 }
 
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/hooks/MallocFail.c b/rts/hooks/MallocFail.c
index 6c3a1a0faf9c..2c63f8847276 100644
--- a/rts/hooks/MallocFail.c
+++ b/rts/hooks/MallocFail.c
@@ -15,3 +15,11 @@ MallocFailHook (W_ request_size /* in bytes */, char *msg)
     fprintf(stderr, "malloc: failed on request for %" FMT_Word " bytes; message: %s\n", request_size, msg);
 }
 
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/hooks/OnExit.c b/rts/hooks/OnExit.c
index 30764acba290..d99cb83ac390 100644
--- a/rts/hooks/OnExit.c
+++ b/rts/hooks/OnExit.c
@@ -18,3 +18,11 @@ void
 OnExitHook (void)
 {
 }
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/hooks/OutOfHeap.c b/rts/hooks/OutOfHeap.c
index ec4697b54711..8998b4d176ed 100644
--- a/rts/hooks/OutOfHeap.c
+++ b/rts/hooks/OutOfHeap.c
@@ -22,3 +22,11 @@ OutOfHeapHook (W_ request_size, W_ heap_size) /* both sizes in bytes */
   }
 }
 
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/hooks/StackOverflow.c b/rts/hooks/StackOverflow.c
index 407293902d87..50995b843006 100644
--- a/rts/hooks/StackOverflow.c
+++ b/rts/hooks/StackOverflow.c
@@ -15,3 +15,11 @@ StackOverflowHook (W_ stack_size)    /* in bytes */
     fprintf(stderr, "Stack space overflow: current size %" FMT_Word " bytes.\nUse `+RTS -Ksize -RTS' to increase it.\n", stack_size);
 }
 
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/package.conf.in b/rts/package.conf.in
index 010305f83dec..340d4bea8876 100644
--- a/rts/package.conf.in
+++ b/rts/package.conf.in
@@ -6,6 +6,7 @@
 name:           rts
 version:        1.0
 id:             builtin_rts
+key:            rts
 license:        BSD3
 maintainer:     glasgow-haskell-users@haskell.org
 exposed:        True
@@ -16,9 +17,9 @@ hidden-modules:
 import-dirs:
 
 #ifdef INSTALLING
-library-dirs:           LIB_DIR"/rts-1.0" PAPI_LIB_DIR FFI_LIB_DIR
+library-dirs:           LIB_DIR"/rts" PAPI_LIB_DIR FFI_LIB_DIR DWARF_LIB_DIR
 #else /* !INSTALLING */
-library-dirs:           TOP"/rts/dist/build" PAPI_LIB_DIR FFI_LIB_DIR
+library-dirs:           TOP"/rts/dist/build" PAPI_LIB_DIR FFI_LIB_DIR DWARF_LIB_DIR
 #endif
 
 hs-libraries:   "HSrts" FFI_LIB
@@ -55,11 +56,15 @@ extra-libraries:
 #if USE_PAPI
                              , "papi"
 #endif
+#if USE_DWARF
+                             , "dwarf"
+                             , "elf"
+#endif
 
 #ifdef INSTALLING
-include-dirs:           INCLUDE_DIR PAPI_INCLUDE_DIR
+include-dirs:           INCLUDE_DIR PAPI_INCLUDE_DIR FFI_INCLUDE_DIR DWARF_INCLUDE_DIR
 #else /* !INSTALLING */
-include-dirs:           TOP"/rts/dist/build" TOP"/includes" TOP"/includes/dist-derivedconstants/header"
+include-dirs:           TOP"/rts/dist/build" TOP"/includes" TOP"/includes/dist-derivedconstants/header" FFI_INCLUDE_DIR DWARF_INCLUDE_DIR
 #endif
 
 includes:               Stg.h
@@ -99,6 +104,7 @@ ld-options:
          , "-Wl,-u,_base_GHCziIOziException_blockedIndefinitelyOnMVar_closure"
          , "-Wl,-u,_base_GHCziIOziException_blockedIndefinitelyOnSTM_closure"
          , "-Wl,-u,_base_ControlziExceptionziBase_nestedAtomically_closure"
+         , "-Wl,-u,_base_GHCziEventziThread_blockedOnBadFD_closure"
          , "-Wl,-u,_base_GHCziWeak_runFinalizzerBatch_closure"
          , "-Wl,-u,_base_GHCziTopHandler_flushStdHandles_closure"
          , "-Wl,-u,_base_GHCziTopHandler_runIO_closure"
@@ -139,6 +145,7 @@ ld-options:
          , "-Wl,-u,base_GHCziIOziException_blockedIndefinitelyOnMVar_closure"
          , "-Wl,-u,base_GHCziIOziException_blockedIndefinitelyOnSTM_closure"
          , "-Wl,-u,base_ControlziExceptionziBase_nestedAtomically_closure"
+         , "-Wl,-u,base_GHCziEventziThread_blockedOnBadFD_closure"
          , "-Wl,-u,base_GHCziWeak_runFinalizzerBatch_closure"
          , "-Wl,-u,base_GHCziTopHandler_flushStdHandles_closure"
          , "-Wl,-u,base_GHCziTopHandler_runIO_closure"
@@ -161,6 +168,10 @@ ld-options:
          , "-read_only_relocs", "warning"
 #endif
 
+#if defined(USE_DWARF)
+         , "-Wl,-rpath="DWARF_LIB_DIR_S
+#endif
+
 framework-dirs:
 
 haddock-interfaces:
diff --git a/rts/posix/Clock.h b/rts/posix/Clock.h
index 2c71d7a75d89..16d9252460ab 100644
--- a/rts/posix/Clock.h
+++ b/rts/posix/Clock.h
@@ -33,3 +33,11 @@
 #endif
 
 #endif /* POSIX_CLOCK_H */
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/posix/GetEnv.c b/rts/posix/GetEnv.c
index 4d5c7e248e0c..de6d5cd98980 100644
--- a/rts/posix/GetEnv.c
+++ b/rts/posix/GetEnv.c
@@ -32,7 +32,7 @@ static char** get_environ(void) { return environ; }
 void getProgEnvv(int *out_envc, char **out_envv[]) {
     int envc;
     char **environ = get_environ();
-    
+
     for (envc = 0; environ[envc] != NULL; envc++) {};
 
     *out_envc = envc;
@@ -42,3 +42,11 @@ void getProgEnvv(int *out_envc, char **out_envv[]) {
 void freeProgEnvv(int envc STG_UNUSED, char *envv[] STG_UNUSED) {
     /* nothing */
 }
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/posix/GetTime.c b/rts/posix/GetTime.c
index bcee6ce127c1..d44fc9a56621 100644
--- a/rts/posix/GetTime.c
+++ b/rts/posix/GetTime.c
@@ -50,7 +50,11 @@ void initializeTimer()
 
 Time getProcessCPUTime(void)
 {
-#if !defined(BE_CONSERVATIVE) && defined(HAVE_CLOCK_GETTIME) && defined (_SC_CPUTIME) && defined(CLOCK_PROCESS_CPUTIME_ID) && defined(HAVE_SYSCONF)
+#if !defined(BE_CONSERVATIVE)            &&  \
+       defined(HAVE_CLOCK_GETTIME)       &&  \
+       defined(_SC_CPUTIME)             &&  \
+       defined(CLOCK_PROCESS_CPUTIME_ID) &&  \
+       defined(HAVE_SYSCONF)
     static int checked_sysconf = 0;
     static int sysconf_result = 0;
 
@@ -81,21 +85,31 @@ Time getProcessCPUTime(void)
 
 StgWord64 getMonotonicNSec(void)
 {
-#ifdef HAVE_CLOCK_GETTIME
+#if defined(HAVE_CLOCK_GETTIME)
     struct timespec ts;
+    int res;
 
-    clock_gettime(CLOCK_ID, &ts);
+    res = clock_gettime(CLOCK_ID, &ts);
+    if (res != 0) {
+        sysErrorBelch("clock_gettime");
+        stg_exit(EXIT_FAILURE);
+    }
     return (StgWord64)ts.tv_sec * 1000000000 +
            (StgWord64)ts.tv_nsec;
+
 #elif defined(darwin_HOST_OS)
+
     uint64_t time = mach_absolute_time();
     return (time * timer_scaling_factor_numer) / timer_scaling_factor_denom;
-#else
+
+#else // use gettimeofday()
+
     struct timeval tv;
 
     gettimeofday(&tv, (struct timezone *) NULL);
     return (StgWord64)tv.tv_sec * 1000000000 +
            (StgWord64)tv.tv_usec * 1000;
+
 #endif
 }
 
@@ -119,7 +133,7 @@ Time getProcessCPUTime(void)
 #if !defined(THREADED_RTS) && USE_PAPI
     long long usec;
     if ((usec = PAPI_get_virt_usec()) < 0) {
-	barf("PAPI_get_virt_usec: %lld", usec);
+        barf("PAPI_get_virt_usec: %lld", usec);
     }
     return USToTime(usec);
 #else
@@ -142,22 +156,22 @@ void getProcessTimes(Time *user, Time *elapsed)
 
     if (ClockFreq == 0) {
 #if defined(HAVE_SYSCONF)
-	long ticks;
-	ticks = sysconf(_SC_CLK_TCK);
-	if ( ticks == -1 ) {
-	    sysErrorBelch("sysconf");
-	    stg_exit(EXIT_FAILURE);
-	}
-	ClockFreq = ticks;
-#elif defined(CLK_TCK)		/* defined by POSIX */
-	ClockFreq = CLK_TCK;
+        long ticks;
+        ticks = sysconf(_SC_CLK_TCK);
+        if ( ticks == -1 ) {
+            sysErrorBelch("sysconf");
+            stg_exit(EXIT_FAILURE);
+        }
+        ClockFreq = ticks;
+#elif defined(CLK_TCK)          /* defined by POSIX */
+        ClockFreq = CLK_TCK;
 #elif defined(HZ)
-	ClockFreq = HZ;
+        ClockFreq = HZ;
 #elif defined(CLOCKS_PER_SEC)
-	ClockFreq = CLOCKS_PER_SEC;
+        ClockFreq = CLOCKS_PER_SEC;
 #else
-	errorBelch("can't get clock resolution");
-	stg_exit(EXIT_FAILURE);
+        errorBelch("can't get clock resolution");
+        stg_exit(EXIT_FAILURE);
 #endif
     }
 
@@ -174,15 +188,19 @@ Time getThreadCPUTime(void)
 #if USE_PAPI
     long long usec;
     if ((usec = PAPI_get_virt_usec()) < 0) {
-	barf("PAPI_get_virt_usec: %lld", usec);
+        barf("PAPI_get_virt_usec: %lld", usec);
     }
     return USToTime(usec);
 
-#elif !defined(BE_CONSERVATIVE) && defined(HAVE_CLOCK_GETTIME) && defined (_SC_THREAD_CPUTIME) && defined(CLOCK_THREAD_CPUTIME_ID) && defined(HAVE_SYSCONF)
+#elif !defined(BE_CONSERVATIVE)            &&  \
+       defined(HAVE_CLOCK_GETTIME)       &&  \
+       defined(_SC_CPUTIME)             &&  \
+       defined(CLOCK_PROCESS_CPUTIME_ID) &&  \
+       defined(HAVE_SYSCONF)
     {
         static int checked_sysconf = 0;
         static int sysconf_result = 0;
-        
+
         if (!checked_sysconf) {
             sysconf_result = sysconf(_SC_THREAD_CPUTIME);
             checked_sysconf = 1;
@@ -230,3 +248,10 @@ getPageFaults(void)
 #endif
 }
 
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/posix/Itimer.c b/rts/posix/Itimer.c
index 4bcc3a1c2e65..acb48d34eef2 100644
--- a/rts/posix/Itimer.c
+++ b/rts/posix/Itimer.c
@@ -9,10 +9,10 @@
 /*
  * The interval timer is used for profiling and for context switching in the
  * threaded build.  Though POSIX 1003.1b includes a standard interface for
- * such things, no one really seems to be implementing them yet.  Even 
+ * such things, no one really seems to be implementing them yet.  Even
  * Solaris 2.3 only seems to provide support for @CLOCK_REAL@, whereas we're
  * keen on getting access to @CLOCK_VIRTUAL@.
- * 
+ *
  * Hence, we use the old-fashioned @setitimer@ that just about everyone seems
  * to support.  So much for standards.
  */
@@ -20,11 +20,16 @@
 #include "PosixSource.h"
 #include "Rts.h"
 
+#define __USE_GNU
+#include <xlocale.h>
+
+#include "Task.h"
 #include "Ticker.h"
 #include "Itimer.h"
 #include "Proftimer.h"
 #include "Schedule.h"
 #include "Clock.h"
+#include "RtsUtils.h"
 
 /* As recommended in the autoconf manual */
 # ifdef TIME_WITH_SYS_TIME
@@ -105,29 +110,30 @@ ghc-stage2: timer_create: Not owner
 #undef USE_TIMER_CREATE
 #endif /* solaris2_HOST_OS */
 
-#if defined(USE_TIMER_CREATE)
-#  define ITIMER_SIGNAL SIGVTALRM
-#elif defined(HAVE_SETITIMER)
-#  define ITIMER_SIGNAL  SIGALRM
-   // Using SIGALRM can leads to problems, see #850.  But we have no
-   // option if timer_create() is not available.
-#else
-#  error No way to set an interval timer.
-#endif
-
 #if defined(USE_TIMER_CREATE)
 static timer_t timer;
 #endif
 
 static Time itimer_interval = DEFAULT_TICK_INTERVAL;
 
+#define USE_SIGACTION
+
+#ifdef USE_SIGACTION
+
+TickProc current_handle_tick = NULL;
+
+static void handle_sigaction(int signum STG_UNUSED, siginfo_t *siginfo, void *ctx) {
+    ucontext_t *uctx = (ucontext_t *) ctx;
+    current_handle_tick(siginfo->si_code != SI_TIMER, (void *)uctx->uc_mcontext.gregs[REG_RIP]);
+}
+
+#endif
+
 #if !defined(USE_PTHREAD_FOR_ITIMER)
 static void install_vtalrm_handler(TickProc handle_tick)
 {
     struct sigaction action;
 
-    action.sa_handler = handle_tick;
-
     sigemptyset(&action.sa_mask);
 
 #ifdef SA_RESTART
@@ -142,11 +148,42 @@ static void install_vtalrm_handler(TickProc handle_tick)
     action.sa_flags = 0;
 #endif
 
+#ifdef USE_SIGACTION
+    // Redirect using sa_sigaction, to gain more information about the
+    // signal.
+    current_handle_tick = handle_tick;
+    action.sa_flags |= SA_SIGINFO;
+    action.sa_sigaction = handle_sigaction;
+#else
+    action.sa_handler = handle_tick;
+#endif
+
     if (sigaction(ITIMER_SIGNAL, &action, NULL) == -1) {
         sysErrorBelch("sigaction");
         stg_exit(EXIT_FAILURE);
     }
 }
+
+#ifdef TRACING
+void
+initTickerSampling (Task *task)
+{
+    if (!RtsFlags.TraceFlags.timerSampling) { return; }
+
+    // Install the SIGALRM handler
+    install_vtalrm_handler(current_handle_tick);
+
+    // Initialize fields. This marks the task as willing to accept
+    // timer signals as well.
+    if (!task->timer_ip_samples) {
+        task->timer_ip_sample_count = 0;
+        task->timer_ip_samples = stgMallocBytes(
+            sizeof(void *) * TIMER_MAX_SAMPLES,
+            "newTask");
+    }
+}
+#endif
+
 #endif
 
 #if defined(USE_PTHREAD_FOR_ITIMER)
@@ -202,11 +239,11 @@ startTicker(void)
 #elif defined(USE_TIMER_CREATE)
     {
         struct itimerspec it;
-        
+
         it.it_value.tv_sec  = TimeToSeconds(itimer_interval);
         it.it_value.tv_nsec = TimeToNS(itimer_interval) % 1000000000;
         it.it_interval = it.it_value;
-        
+
         if (timer_settime(timer, 0, &it, NULL) != 0) {
             sysErrorBelch("timer_settime");
             stg_exit(EXIT_FAILURE);
@@ -219,7 +256,7 @@ startTicker(void)
         it.it_value.tv_sec = TimeToSeconds(itimer_interval);
         it.it_value.tv_usec = TimeToUS(itimer_interval) % 1000000;
         it.it_interval = it.it_value;
-        
+
         if (setitimer(ITIMER_REAL, &it, NULL) != 0) {
             sysErrorBelch("setitimer");
             stg_exit(EXIT_FAILURE);
@@ -280,3 +317,11 @@ rtsTimerSignal(void)
 {
     return ITIMER_SIGNAL;
 }
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/posix/Itimer.h b/rts/posix/Itimer.h
index 7996da7c9488..21dfbcb11a98 100644
--- a/rts/posix/Itimer.h
+++ b/rts/posix/Itimer.h
@@ -9,4 +9,22 @@
 #ifndef ITIMER_H
 #define ITIMER_H
 
+#if defined(USE_TIMER_CREATE)
+#  define ITIMER_SIGNAL SIGVTALRM
+#elif defined(HAVE_SETITIMER)
+#  define ITIMER_SIGNAL  SIGALRM
+   // Using SIGALRM can leads to problems, see #850.  But we have no
+   // option if timer_create() is not available.
+#else
+#  error No way to set an interval timer.
+#endif
+
 #endif /* ITIMER_H */
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/posix/OSMem.c b/rts/posix/OSMem.c
index 69140a914ce8..eb51e98e72da 100644
--- a/rts/posix/OSMem.c
+++ b/rts/posix/OSMem.c
@@ -81,13 +81,13 @@ my_mmap (void *addr, W_ size)
     void *ret;
 
 #if defined(solaris2_HOST_OS) || defined(irix_HOST_OS)
-    { 
+    {
         int fd = open("/dev/zero",O_RDONLY);
         ret = mmap(addr, size, PROT_READ | PROT_WRITE, MAP_PRIVATE, fd, 0);
         close(fd);
     }
 #elif hpux_HOST_OS
-    ret = mmap(addr, size, PROT_READ | PROT_WRITE, 
+    ret = mmap(addr, size, PROT_READ | PROT_WRITE,
                MAP_ANONYMOUS | MAP_PRIVATE, -1, 0);
 #elif darwin_HOST_OS
     // Without MAP_FIXED, Apple's mmap ignores addr.
@@ -97,21 +97,23 @@ my_mmap (void *addr, W_ size)
     // This behaviour seems to be conformant with IEEE Std 1003.1-2001.
     // Let's just use the underlying Mach Microkernel calls directly,
     // they're much nicer.
-    
+
     kern_return_t err = 0;
     ret = addr;
     if(addr)    // try to allocate at address
         err = vm_allocate(mach_task_self(),(vm_address_t*) &ret, size, FALSE);
     if(!addr || err)    // try to allocate anywhere
         err = vm_allocate(mach_task_self(),(vm_address_t*) &ret, size, TRUE);
-        
+
     if(err) {
         // don't know what the error codes mean exactly, assume it's
         // not our problem though.
-        errorBelch("memory allocation failed (requested %" FMT_Word " bytes)", size);
+        errorBelch("memory allocation failed (requested %" FMT_Word " bytes)",
+                   size);
         stg_exit(EXIT_FAILURE);
     } else {
-        vm_protect(mach_task_self(),(vm_address_t)ret,size,FALSE,VM_PROT_READ|VM_PROT_WRITE);
+        vm_protect(mach_task_self(), (vm_address_t)ret, size, FALSE,
+                   VM_PROT_READ|VM_PROT_WRITE);
     }
 #elif linux_HOST_OS
     ret = mmap(addr, size, PROT_READ | PROT_WRITE,
@@ -135,12 +137,12 @@ my_mmap (void *addr, W_ size)
         }
     }
 #else
-    ret = mmap(addr, size, PROT_READ | PROT_WRITE, 
+    ret = mmap(addr, size, PROT_READ | PROT_WRITE,
                MAP_ANON | MAP_PRIVATE, -1, 0);
 #endif
 
     if (ret == (void *)-1) {
-        if (errno == ENOMEM || 
+        if (errno == ENOMEM ||
             (errno == EINVAL && sizeof(void*)==4 && size >= 0xc0000000)) {
             // If we request more than 3Gig, then we get EINVAL
             // instead of ENOMEM (at least on Linux).
@@ -167,10 +169,10 @@ gen_map_mblocks (W_ size)
     // it (unmap the rest).
     size += MBLOCK_SIZE;
     ret = my_mmap(0, size);
-    
+
     // unmap the slop bits around the chunk we allocated
     slop = (W_)ret & MBLOCK_MASK;
-    
+
     if (munmap((void*)ret, MBLOCK_SIZE - slop) == -1) {
       barf("gen_map_mblocks: munmap failed");
     }
@@ -188,7 +190,7 @@ gen_map_mblocks (W_ size)
     //       you unmap the extra mblock mmap()ed here (or simply
     //       satisfy yourself that the slop introduced isn't worth
     //       salvaging.)
-    // 
+    //
 
     // next time, try after the block we just got.
     ret += MBLOCK_SIZE - slop;
@@ -210,7 +212,9 @@ osGetMBlocks(nat n)
       if (((W_)ret & MBLOCK_MASK) != 0) {
           // misaligned block!
 #if 0 // defined(DEBUG)
-          errorBelch("warning: getMBlock: misaligned block %p returned when allocating %d megablock(s) at %p", ret, n, next_request);
+          errorBelch("warning: getMBlock: misaligned block %p returned "
+                     "when allocating %d megablock(s) at %p",
+                     ret, n, next_request);
 #endif
 
           // unmap this block...
@@ -289,7 +293,8 @@ StgWord64 getPhysicalMemorySize (void)
         long ret = sysconf(_SC_PHYS_PAGES);
         if (ret == -1) {
 #if defined(DEBUG)
-            errorBelch("warning: getPhysicalMemorySize: cannot get physical memory size");
+            errorBelch("warning: getPhysicalMemorySize: cannot get "
+                       "physical memory size");
 #endif
             return 0;
         }
@@ -308,8 +313,16 @@ void setExecutable (void *p, W_ len, rtsBool exec)
     StgWord startOfFirstPage = ((StgWord)p          ) & mask;
     StgWord startOfLastPage  = ((StgWord)p + len - 1) & mask;
     StgWord size             = startOfLastPage - startOfFirstPage + pageSize;
-    if (mprotect((void*)startOfFirstPage, (size_t)size, 
+    if (mprotect((void*)startOfFirstPage, (size_t)size,
                  (exec ? PROT_EXEC : 0) | PROT_READ | PROT_WRITE) != 0) {
         barf("setExecutable: failed to protect 0x%p\n", p);
     }
 }
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/posix/OSThreads.c b/rts/posix/OSThreads.c
index 13a176c9d235..f42b4e964c6b 100644
--- a/rts/posix/OSThreads.c
+++ b/rts/posix/OSThreads.c
@@ -3,7 +3,7 @@
  * (c) The GHC Team, 2001-2005
  *
  * Accessing OS threads functionality in a (mostly) OS-independent
- * manner. 
+ * manner.
  *
  * --------------------------------------------------------------------------*/
 
@@ -18,7 +18,7 @@
 #if defined(freebsd_HOST_OS)
 /* Inclusion of system headers usually requires __BSD_VISIBLE on FreeBSD,
  * because of some specific types, like u_char, u_int, etc. */
-#define __BSD_VISIBLE	1
+#define __BSD_VISIBLE   1
 #endif
 
 #include "Rts.h"
@@ -175,7 +175,7 @@ newThreadLocalKey (ThreadLocalKey *key)
 {
     int r;
     if ((r = pthread_key_create(key, NULL)) != 0) {
-	barf("newThreadLocalKey: %s", strerror(r));
+        barf("newThreadLocalKey: %s", strerror(r));
     }
 }
 
@@ -194,7 +194,7 @@ setThreadLocalVar (ThreadLocalKey *key, void *value)
 {
     int r;
     if ((r = pthread_setspecific(*key,value)) != 0) {
-	barf("setThreadLocalVar: %s", strerror(r));
+        barf("setThreadLocalVar: %s", strerror(r));
     }
 }
 
@@ -203,7 +203,7 @@ freeThreadLocalKey (ThreadLocalKey *key)
 {
     int r;
     if ((r = pthread_key_delete(*key)) != 0) {
-	barf("freeThreadLocalKey: %s", strerror(r));
+        barf("freeThreadLocalKey: %s", strerror(r));
     }
 }
 
@@ -222,7 +222,7 @@ forkOS_createThread ( HsStablePtr entry )
 {
     pthread_t tid;
     int result = pthread_create(&tid, NULL,
-				forkOS_createThreadWrapper, (void*)entry);
+                                forkOS_createThreadWrapper, (void*)entry);
     if(!result)
         pthread_detach(tid);
     return result;
@@ -277,33 +277,34 @@ setThreadAffinity (nat n, nat m GNUC3_ATTRIBUTE(__unused__))
     thread_affinity_policy_data_t policy;
 
     policy.affinity_tag = n;
-    thread_policy_set(mach_thread_self(), 
-		      THREAD_AFFINITY_POLICY,
-		      (thread_policy_t) &policy,
-		      THREAD_AFFINITY_POLICY_COUNT);
+    thread_policy_set(mach_thread_self(),
+                      THREAD_AFFINITY_POLICY,
+                      (thread_policy_t) &policy,
+                      THREAD_AFFINITY_POLICY_COUNT);
 }
 
 #elif defined(HAVE_SYS_CPUSET_H) /* FreeBSD 7.1+ */
 void
 setThreadAffinity(nat n, nat m)
 {
-	nat nproc;
-	cpuset_t cs;
-	nat i;
+        nat nproc;
+        cpuset_t cs;
+        nat i;
 
-	nproc = getNumberOfProcessors();
-	CPU_ZERO(&cs);
+        nproc = getNumberOfProcessors();
+        CPU_ZERO(&cs);
 
-	for (i = n; i < nproc; i += m)
-		CPU_SET(i, &cs);
+        for (i = n; i < nproc; i += m)
+                CPU_SET(i, &cs);
 
-	cpuset_setaffinity(CPU_LEVEL_WHICH, CPU_WHICH_TID, -1, sizeof(cpuset_t), &cs);
+        cpuset_setaffinity(CPU_LEVEL_WHICH, CPU_WHICH_TID,
+                           -1, sizeof(cpuset_t), &cs);
 }
 
 #else
 void
-setThreadAffinity (nat n GNUC3_ATTRIBUTE(__unused__), 
-		   nat m GNUC3_ATTRIBUTE(__unused__))
+setThreadAffinity (nat n GNUC3_ATTRIBUTE(__unused__),
+                   nat m GNUC3_ATTRIBUTE(__unused__))
 {
 }
 #endif
@@ -340,7 +341,9 @@ KernelThreadId kernelThreadId (void)
     return pthread_getthreadid_np();
 
 // Check for OS X >= 10.6 (see #7356)
-#elif defined(darwin_HOST_OS) && !(defined(__MAC_OS_X_VERSION_MIN_REQUIRED) && __MAC_OS_X_VERSION_MIN_REQUIRED < 1060)
+#elif defined(darwin_HOST_OS) && \
+       !(defined(__MAC_OS_X_VERSION_MIN_REQUIRED) && \
+         __MAC_OS_X_VERSION_MIN_REQUIRED < 1060)
     uint64_t ktid;
     pthread_threadid_np(NULL, &ktid);
     return ktid;
@@ -350,3 +353,11 @@ KernelThreadId kernelThreadId (void)
     return 0;
 #endif
 }
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/posix/Select.c b/rts/posix/Select.c
index 3d92a4666a4a..29a1dd144d7c 100644
--- a/rts/posix/Select.c
+++ b/rts/posix/Select.c
@@ -14,6 +14,8 @@
 
 #include "Signals.h"
 #include "Schedule.h"
+#include "Prelude.h"
+#include "RaiseAsync.h"
 #include "RtsUtils.h"
 #include "Itimer.h"
 #include "Capability.h"
@@ -98,17 +100,18 @@ static rtsBool wakeUpSleepingThreads (LowResTime now)
     rtsBool flag = rtsFalse;
 
     while (sleeping_queue != END_TSO_QUEUE) {
-	tso = sleeping_queue;
+        tso = sleeping_queue;
         if (((long)now - (long)tso->block_info.target) < 0) {
             break;
         }
-	sleeping_queue = tso->_link;
-	tso->why_blocked = NotBlocked;
-	tso->_link = END_TSO_QUEUE;
-	IF_DEBUG(scheduler,debugBelch("Waking up sleeping thread %lu\n", (unsigned long)tso->id));
-	// MainCapability: this code is !THREADED_RTS
-	pushOnRunQueue(&MainCapability,tso);
-	flag = rtsTrue;
+        sleeping_queue = tso->_link;
+        tso->why_blocked = NotBlocked;
+        tso->_link = END_TSO_QUEUE;
+        IF_DEBUG(scheduler, debugBelch("Waking up sleeping thread %lu\n",
+                                       (unsigned long)tso->id));
+        // MainCapability: this code is !THREADED_RTS
+        pushOnRunQueue(&MainCapability,tso);
+        flag = rtsTrue;
     }
     return flag;
 }
@@ -116,10 +119,91 @@ static rtsBool wakeUpSleepingThreads (LowResTime now)
 static void GNUC3_ATTRIBUTE(__noreturn__)
 fdOutOfRange (int fd)
 {
-    errorBelch("file descriptor %d out of range for select (0--%d).\nRecompile with -threaded to work around this.", fd, (int)FD_SETSIZE);
+    errorBelch("file descriptor %d out of range for select (0--%d).\n"
+               "Recompile with -threaded to work around this.",
+               fd, (int)FD_SETSIZE);
     stg_exit(EXIT_FAILURE);
 }
 
+/*
+ * State of individual file descriptor after a 'select()' poll.
+ */
+enum FdState {
+    RTS_FD_IS_READY = 0,
+    RTS_FD_IS_BLOCKING,
+    RTS_FD_IS_INVALID,
+};
+
+static enum FdState fdPollReadState (int fd)
+{
+    int r;
+    fd_set rfd;
+    struct timeval now;
+
+    FD_ZERO(&rfd);
+    FD_SET(fd, &rfd);
+
+    /* only poll */
+    now.tv_sec  = 0;
+    now.tv_usec = 0;
+    for (;;)
+    {
+        r = select(fd+1, &rfd, NULL, NULL, &now);
+        /* the descriptor is sane */
+        if (r != -1)
+            break;
+
+        switch (errno)
+        {
+            case EBADF: return RTS_FD_IS_INVALID;
+            case EINTR: continue;
+            default:
+                sysErrorBelch("select");
+                stg_exit(EXIT_FAILURE);
+        }
+    }
+
+    if (r == 0)
+        return RTS_FD_IS_BLOCKING;
+    else
+        return RTS_FD_IS_READY;
+}
+
+static enum FdState fdPollWriteState (int fd)
+{
+    int r;
+    fd_set wfd;
+    struct timeval now;
+
+    FD_ZERO(&wfd);
+    FD_SET(fd, &wfd);
+
+    /* only poll */
+    now.tv_sec  = 0;
+    now.tv_usec = 0;
+    for (;;)
+    {
+        r = select(fd+1, NULL, &wfd, NULL, &now);
+        /* the descriptor is sane */
+        if (r != -1)
+            break;
+
+        switch (errno)
+        {
+            case EBADF: return RTS_FD_IS_INVALID;
+            case EINTR: continue;
+            default:
+                sysErrorBelch("select");
+                stg_exit(EXIT_FAILURE);
+        }
+    }
+
+    if (r == 0)
+        return RTS_FD_IS_BLOCKING;
+    else
+        return RTS_FD_IS_READY;
+}
+
 /* Argument 'wait' says whether to wait for I/O to become available,
  * or whether to just check and return immediately.  If there are
  * other threads ready to run, we normally do the non-waiting variety,
@@ -137,22 +221,20 @@ void
 awaitEvent(rtsBool wait)
 {
     StgTSO *tso, *prev, *next;
-    rtsBool ready;
     fd_set rfd,wfd;
     int numFound;
     int maxfd = -1;
-    rtsBool select_succeeded = rtsTrue;
-    rtsBool unblock_all = rtsFalse;
+    rtsBool seen_bad_fd = rtsFalse;
     struct timeval tv, *ptv;
     LowResTime now;
 
     IF_DEBUG(scheduler,
-	     debugBelch("scheduler: checking for threads blocked on I/O");
-	     if (wait) {
-		 debugBelch(" (waiting)");
-	     }
-	     debugBelch("\n");
-	     );
+             debugBelch("scheduler: checking for threads blocked on I/O");
+             if (wait) {
+                 debugBelch(" (waiting)");
+             }
+             debugBelch("\n");
+             );
 
     /* loop until we've woken up some threads.  This loop is needed
      * because the select timing isn't accurate, we sometimes sleep
@@ -163,7 +245,7 @@ awaitEvent(rtsBool wait)
 
       now = getLowResTimeOfDay();
       if (wakeUpSleepingThreads(now)) {
-	  return;
+          return;
       }
 
       /*
@@ -173,38 +255,38 @@ awaitEvent(rtsBool wait)
       FD_ZERO(&wfd);
 
       for(tso = blocked_queue_hd; tso != END_TSO_QUEUE; tso = next) {
-	next = tso->_link;
+        next = tso->_link;
 
       /* On FreeBSD FD_SETSIZE is unsigned. Cast it to signed int
        * in order to switch off the 'comparison between signed and
        * unsigned error message
        */
-	switch (tso->why_blocked) {
-	case BlockedOnRead:
-	  { 
-	    int fd = tso->block_info.fd;
-	    if ((fd >= (int)FD_SETSIZE) || (fd < 0)) {
+        switch (tso->why_blocked) {
+        case BlockedOnRead:
+          {
+            int fd = tso->block_info.fd;
+            if ((fd >= (int)FD_SETSIZE) || (fd < 0)) {
                 fdOutOfRange(fd);
-	    }
-	    maxfd = (fd > maxfd) ? fd : maxfd;
-	    FD_SET(fd, &rfd);
-	    continue;
-	  }
-
-	case BlockedOnWrite:
-	  { 
-	    int fd = tso->block_info.fd;
-	    if ((fd >= (int)FD_SETSIZE) || (fd < 0)) {
+            }
+            maxfd = (fd > maxfd) ? fd : maxfd;
+            FD_SET(fd, &rfd);
+            continue;
+          }
+
+        case BlockedOnWrite:
+          {
+            int fd = tso->block_info.fd;
+            if ((fd >= (int)FD_SETSIZE) || (fd < 0)) {
                 fdOutOfRange(fd);
-	    }
-	    maxfd = (fd > maxfd) ? fd : maxfd;
-	    FD_SET(fd, &wfd);
-	    continue;
-	  }
-
-	default:
-	  barf("AwaitEvent");
-	}
+            }
+            maxfd = (fd > maxfd) ? fd : maxfd;
+            FD_SET(fd, &wfd);
+            continue;
+          }
+
+        default:
+          barf("AwaitEvent");
+        }
       }
 
       if (!wait) {
@@ -222,63 +304,46 @@ awaitEvent(rtsBool wait)
       }
 
       /* Check for any interesting events */
-      
+
       while ((numFound = select(maxfd+1, &rfd, &wfd, NULL, ptv)) < 0) {
-	  if (errno != EINTR) {
-	    /* Handle bad file descriptors by unblocking all the
-	       waiting threads. Why? Because a thread might have been
-	       a bit naughty and closed a file descriptor while another
-	       was blocked waiting. This is less-than-good programming
-	       practice, but having the RTS as a result fall over isn't
-	       acceptable, so we simply unblock all the waiting threads
-	       should we see a bad file descriptor & give the threads
-	       a chance to clean up their act. 
-	       
-	       Note: assume here that threads becoming unblocked
-	       will try to read/write the file descriptor before trying
-	       to issue a threadWaitRead/threadWaitWrite again (==> an
-	       IOError will result for the thread that's got the bad
-	       file descriptor.) Hence, there's no danger of a bad
-	       file descriptor being repeatedly select()'ed on, so
-	       the RTS won't loop.
-	    */
-	    if ( errno == EBADF ) {
-                unblock_all = rtsTrue;
+          if (errno != EINTR) {
+            if ( errno == EBADF ) {
+                seen_bad_fd = rtsTrue;
                 break;
-	    } else {
+            } else {
                 sysErrorBelch("select");
                 stg_exit(EXIT_FAILURE);
             }
-	  }
+          }
 
-	  /* We got a signal; could be one of ours.  If so, we need
-	   * to start up the signal handler straight away, otherwise
-	   * we could block for a long time before the signal is
-	   * serviced.
-	   */
+          /* We got a signal; could be one of ours.  If so, we need
+           * to start up the signal handler straight away, otherwise
+           * we could block for a long time before the signal is
+           * serviced.
+           */
 #if defined(RTS_USER_SIGNALS)
-	  if (RtsFlags.MiscFlags.install_signal_handlers && signals_pending()) {
-	      startSignalHandlers(&MainCapability);
-	      return; /* still hold the lock */
-	  }
+          if (RtsFlags.MiscFlags.install_signal_handlers && signals_pending()) {
+              startSignalHandlers(&MainCapability);
+              return; /* still hold the lock */
+          }
 #endif
 
-	  /* we were interrupted, return to the scheduler immediately.
-	   */
-	  if (sched_state >= SCHED_INTERRUPTING) {
-	      return; /* still hold the lock */
-	  }
-	  
-	  /* check for threads that need waking up 
-	   */
+          /* we were interrupted, return to the scheduler immediately.
+           */
+          if (sched_state >= SCHED_INTERRUPTING) {
+              return; /* still hold the lock */
+          }
+
+          /* check for threads that need waking up
+           */
           wakeUpSleepingThreads(getLowResTimeOfDay());
 
-	  /* If new runnable threads have arrived, stop waiting for
-	   * I/O and run them.
-	   */
-	  if (!emptyRunQueue(&MainCapability)) {
-	      return; /* still hold the lock */
-	  }
+          /* If new runnable threads have arrived, stop waiting for
+           * I/O and run them.
+           */
+          if (!emptyRunQueue(&MainCapability)) {
+              return; /* still hold the lock */
+          }
       }
 
       /* Step through the waiting queue, unblocking every thread that now has
@@ -286,46 +351,83 @@ awaitEvent(rtsBool wait)
        */
 
       prev = NULL;
-      if (select_succeeded || unblock_all) {
-	  for(tso = blocked_queue_hd; tso != END_TSO_QUEUE; tso = next) {
-	      next = tso->_link;
+      {
+          for(tso = blocked_queue_hd; tso != END_TSO_QUEUE; tso = next) {
+              next = tso->_link;
+              int fd;
+              enum FdState fd_state = RTS_FD_IS_BLOCKING;
 
               switch (tso->why_blocked) {
-	      case BlockedOnRead:
-		  ready = unblock_all || FD_ISSET(tso->block_info.fd, &rfd);
-		  break;
-	      case BlockedOnWrite:
-		  ready = unblock_all || FD_ISSET(tso->block_info.fd, &wfd);
-		  break;
-	      default:
-		  barf("awaitEvent");
-	      }
-      
-	      if (ready) {
-		IF_DEBUG(scheduler,debugBelch("Waking up blocked thread %lu\n", (unsigned long)tso->id));
-		  tso->why_blocked = NotBlocked;
-		  tso->_link = END_TSO_QUEUE;
-		  pushOnRunQueue(&MainCapability,tso);
-	      } else {
-		  if (prev == NULL)
-		      blocked_queue_hd = tso;
-		  else
-		      setTSOLink(&MainCapability, prev, tso);
-		  prev = tso;
-	      }
-	  }
-
-	  if (prev == NULL)
-	      blocked_queue_hd = blocked_queue_tl = END_TSO_QUEUE;
-	  else {
-	      prev->_link = END_TSO_QUEUE;
-	      blocked_queue_tl = prev;
-	  }
+              case BlockedOnRead:
+                  fd = tso->block_info.fd;
+
+                  if (seen_bad_fd) {
+                      fd_state = fdPollReadState (fd);
+                  } else if (FD_ISSET(fd, &rfd)) {
+                      fd_state = RTS_FD_IS_READY;
+                  }
+                  break;
+              case BlockedOnWrite:
+                  fd = tso->block_info.fd;
+
+                  if (seen_bad_fd) {
+                      fd_state = fdPollWriteState (fd);
+                  } else if (FD_ISSET(fd, &wfd)) {
+                      fd_state = RTS_FD_IS_READY;
+                  }
+                  break;
+              default:
+                  barf("awaitEvent");
+              }
+
+              switch (fd_state) {
+              case RTS_FD_IS_INVALID:
+                  /*
+                   * Don't let RTS loop on such descriptors,
+                   * pass an IOError to blocked threads (Trac #4934)
+                   */
+                  IF_DEBUG(scheduler,
+                      debugBelch("Killing blocked thread %lu on bad fd=%i\n",
+                                 (unsigned long)tso->id, fd));
+                  throwToSingleThreaded(&MainCapability, tso,
+                                        (StgClosure *)blockedOnBadFD_closure);
+                  break;
+              case RTS_FD_IS_READY:
+                  IF_DEBUG(scheduler,
+                      debugBelch("Waking up blocked thread %lu\n",
+                                 (unsigned long)tso->id));
+                  tso->why_blocked = NotBlocked;
+                  tso->_link = END_TSO_QUEUE;
+                  pushOnRunQueue(&MainCapability,tso);
+                  break;
+              case RTS_FD_IS_BLOCKING:
+                  if (prev == NULL)
+                      blocked_queue_hd = tso;
+                  else
+                      setTSOLink(&MainCapability, prev, tso);
+                  prev = tso;
+                  break;
+              }
+          }
+
+          if (prev == NULL)
+              blocked_queue_hd = blocked_queue_tl = END_TSO_QUEUE;
+          else {
+              prev->_link = END_TSO_QUEUE;
+              blocked_queue_tl = prev;
+          }
       }
-      
+
     } while (wait && sched_state == SCHED_RUNNING
-	     && emptyRunQueue(&MainCapability));
+             && emptyRunQueue(&MainCapability));
 }
 
 #endif /* THREADED_RTS */
 
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/posix/Select.h b/rts/posix/Select.h
index 50d49d4ba5ab..b63e45a1ae25 100644
--- a/rts/posix/Select.h
+++ b/rts/posix/Select.h
@@ -15,3 +15,11 @@ typedef StgWord LowResTime;
 RTS_PRIVATE LowResTime getDelayTarget (HsInt us);
 
 #endif /* POSIX_SELECT_H */
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/posix/Signals.c b/rts/posix/Signals.c
index 01d5347ae7a1..d5129f0996ef 100644
--- a/rts/posix/Signals.c
+++ b/rts/posix/Signals.c
@@ -6,7 +6,7 @@
  *
  * ---------------------------------------------------------------------------*/
 
-#include "PosixSource.h" 
+#include "PosixSource.h"
 #include "Rts.h"
 
 #include "Schedule.h"
@@ -49,7 +49,7 @@
 
 /* This curious flag is provided for the benefit of the Haskell binding
  * to POSIX.1 to control whether or not to include SA_NOCLDSTOP when
- * installing a SIGCHLD handler. 
+ * installing a SIGCHLD handler.
  */
 HsInt nocldstop = 0;
 
@@ -108,16 +108,19 @@ more_handlers(int sig)
     StgInt i;
 
     if (sig < nHandlers)
-	return;
+        return;
 
     if (signal_handlers == NULL)
-	signal_handlers = (StgInt *)stgMallocBytes((sig + 1) * sizeof(StgInt), "more_handlers");
+        signal_handlers = (StgInt *)stgMallocBytes((sig + 1) * sizeof(StgInt),
+                                                   "more_handlers");
     else
-	signal_handlers = (StgInt *)stgReallocBytes(signal_handlers, (sig + 1) * sizeof(StgInt), "more_handlers");
+        signal_handlers = (StgInt *)stgReallocBytes(signal_handlers,
+                                                    (sig + 1) * sizeof(StgInt),
+                                                    "more_handlers");
 
     for(i = nHandlers; i <= sig; i++)
-	// Fill in the new slots with default actions
-	signal_handlers[i] = STG_SIG_DFL;
+        // Fill in the new slots with default actions
+        signal_handlers[i] = STG_SIG_DFL;
 
     nHandlers = sig + 1;
 }
@@ -153,11 +156,11 @@ ioManagerWakeup (void)
     // Wake up the IO Manager thread by sending a byte down its pipe
     if (io_manager_wakeup_fd >= 0) {
 #if defined(HAVE_EVENTFD)
-	StgWord64 n = (StgWord64)IO_MANAGER_WAKEUP;
-	r = write(io_manager_wakeup_fd, (char *) &n, 8);
+        StgWord64 n = (StgWord64)IO_MANAGER_WAKEUP;
+        r = write(io_manager_wakeup_fd, (char *) &n, 8);
 #else
-	StgWord8 byte = (StgWord8)IO_MANAGER_WAKEUP;
-	r = write(io_manager_wakeup_fd, &byte, 1);
+        StgWord8 byte = (StgWord8)IO_MANAGER_WAKEUP;
+        r = write(io_manager_wakeup_fd, &byte, 1);
 #endif
         if (r == -1) { sysErrorBelch("ioManagerWakeup: write"); }
     }
@@ -170,8 +173,8 @@ ioManagerDie (void)
     int r;
     // Ask the IO Manager thread to exit
     if (io_manager_control_fd >= 0) {
-	StgWord8 byte = (StgWord8)IO_MANAGER_DIE;
-	r = write(io_manager_control_fd, &byte, 1);
+        StgWord8 byte = (StgWord8)IO_MANAGER_DIE;
+        r = write(io_manager_control_fd, &byte, 1);
         if (r == -1) { sysErrorBelch("ioManagerDie: write"); }
         io_manager_control_fd = -1;
         io_manager_wakeup_fd = -1;
@@ -190,9 +193,9 @@ ioManagerStart (void)
     // Make sure the IO manager thread is running
     Capability *cap;
     if (io_manager_control_fd < 0 || io_manager_wakeup_fd < 0) {
-	cap = rts_lock();
+        cap = rts_lock();
         ioManagerStartCap(&cap);
-	rts_unlock(cap);
+        rts_unlock(cap);
     }
 }
 #endif
@@ -227,14 +230,14 @@ generic_handler(int sig USED_IF_THREADS,
 
         buf[0] = sig;
 
-	if (info == NULL) {
-	    // info may be NULL on Solaris (see #3790)
-	    memset(buf+1, 0, sizeof(siginfo_t));
-	} else {
-	    memcpy(buf+1, info, sizeof(siginfo_t));
-	}
+        if (info == NULL) {
+            // info may be NULL on Solaris (see #3790)
+            memset(buf+1, 0, sizeof(siginfo_t));
+        } else {
+            memcpy(buf+1, info, sizeof(siginfo_t));
+        }
 
-	r = write(io_manager_control_fd, buf, sizeof(siginfo_t)+1);
+        r = write(io_manager_control_fd, buf, sizeof(siginfo_t)+1);
         if (r == -1 && errno == EAGAIN)
         {
             errorBelch("lost signal due to full pipe: %d\n", sig);
@@ -255,7 +258,7 @@ generic_handler(int sig USED_IF_THREADS,
 
        We need some kind of locking, but with low overhead (i.e. no
        blocking signals every time around the scheduler).
-       
+
        Signal Handlers are atomic (i.e. they can't be interrupted), and
        we can make use of this.  We just need to make sure the
        critical section of the scheduler can't be interrupted - the
@@ -264,14 +267,14 @@ generic_handler(int sig USED_IF_THREADS,
        handlers to run, i.e. the set of pending handlers is
        non-empty.
     */
-       
+
     /* We use a stack to store the pending signals.  We can't
        dynamically grow this since we can't allocate any memory from
        within a signal handler.
 
        Hence unfortunately we have to bomb out if the buffer
        overflows.  It might be acceptable to carry on in certain
-       circumstances, depending on the signal.  
+       circumstances, depending on the signal.
     */
 
     memcpy(next_pending_handler, info, sizeof(siginfo_t));
@@ -280,10 +283,10 @@ generic_handler(int sig USED_IF_THREADS,
 
     // stack full?
     if (next_pending_handler == &pending_handler_buf[N_PENDING_HANDLERS]) {
-	errorBelch("too many pending signals");
-	stg_exit(EXIT_FAILURE);
+        errorBelch("too many pending signals");
+        stg_exit(EXIT_FAILURE);
     }
-    
+
     interruptCapability(&MainCapability);
 
 #endif /* THREADED_RTS */
@@ -316,7 +319,7 @@ void
 awaitUserSignals(void)
 {
     while (!signals_pending() && sched_state == SCHED_RUNNING) {
-	pause();
+        pause();
     }
 }
 #endif
@@ -340,34 +343,36 @@ stg_sig_install(int sig, int spi, void *mask)
 
     // Block the signal until we figure out what to do
     // Count on this to fail if the signal number is invalid
-    if (sig < 0 || sigemptyset(&signals) ||
-	sigaddset(&signals, sig) || sigprocmask(SIG_BLOCK, &signals, &osignals)) {
+    if (sig < 0 ||
+          sigemptyset(&signals) ||
+          sigaddset(&signals, sig) ||
+          sigprocmask(SIG_BLOCK, &signals, &osignals)) {
         RELEASE_LOCK(&sig_mutex);
         return STG_SIG_ERR;
     }
-    
+
     more_handlers(sig);
 
     previous_spi = signal_handlers[sig];
 
     action.sa_flags = 0;
-    
+
     switch(spi) {
     case STG_SIG_IGN:
         action.sa_handler = SIG_IGN;
-    	break;
+        break;
 
     case STG_SIG_DFL:
         action.sa_handler = SIG_DFL;
-    	break;
+        break;
 
     case STG_SIG_RST:
         action.sa_flags |= SA_RESETHAND;
         /* fall through */
     case STG_SIG_HAN:
-    	action.sa_sigaction = generic_handler;
+        action.sa_sigaction = generic_handler;
         action.sa_flags |= SA_SIGINFO;
-    	break;
+        break;
 
     default:
         barf("stg_sig_install: bad spi");
@@ -376,7 +381,7 @@ stg_sig_install(int sig, int spi, void *mask)
     if (mask != NULL)
         action.sa_mask = *(sigset_t *)mask;
     else
-	sigemptyset(&action.sa_mask);
+        sigemptyset(&action.sa_mask);
 
     action.sa_flags |= sig == SIGCHLD && nocldstop ? SA_NOCLDSTOP : 0;
 
@@ -392,14 +397,14 @@ stg_sig_install(int sig, int spi, void *mask)
     switch(spi) {
     case STG_SIG_RST:
     case STG_SIG_HAN:
-	sigaddset(&userSignals, sig);
+        sigaddset(&userSignals, sig);
         if (previous_spi != STG_SIG_HAN && previous_spi != STG_SIG_RST) {
             n_haskell_handlers++;
         }
-    	break;
+        break;
 
     default:
-	sigdelset(&userSignals, sig);
+        sigdelset(&userSignals, sig);
         if (previous_spi == STG_SIG_HAN || previous_spi == STG_SIG_RST) {
             n_haskell_handlers--;
         }
@@ -429,7 +434,7 @@ startSignalHandlers(Capability *cap)
   int sig;
 
   blockUserSignals();
-  
+
   while (next_pending_handler != pending_handler_buf) {
 
     next_pending_handler--;
@@ -439,18 +444,18 @@ startSignalHandlers(Capability *cap)
         continue; // handler has been changed.
     }
 
-    info = stgMallocBytes(sizeof(siginfo_t), "startSignalHandlers"); 
+    info = stgMallocBytes(sizeof(siginfo_t), "startSignalHandlers");
            // freed by runHandler
     memcpy(info, next_pending_handler, sizeof(siginfo_t));
 
-    scheduleThread (cap,
-	createIOThread(cap,
-		       RtsFlags.GcFlags.initialStkSize, 
-                       rts_apply(cap,
-                                 rts_apply(cap,
-                                           &base_GHCziConcziSignal_runHandlers_closure,
-                                           rts_mkPtr(cap, info)),
-                                 rts_mkInt(cap, info->si_signo))));
+    scheduleThread(cap,
+        createIOThread(cap,
+          RtsFlags.GcFlags.initialStkSize,
+              rts_apply(cap,
+                  rts_apply(cap,
+                      &base_GHCziConcziSignal_runHandlers_closure,
+                      rts_mkPtr(cap, info)),
+                  rts_mkInt(cap, info->si_signo))));
   }
 
   unblockUserSignals();
@@ -468,10 +473,10 @@ markSignalHandlers (evac_fn evac STG_UNUSED, void *user STG_UNUSED)
 }
 
 #else /* !RTS_USER_SIGNALS */
-StgInt 
+StgInt
 stg_sig_install(StgInt sig STG_UNUSED,
-		StgInt spi STG_UNUSED,
-		void* mask STG_UNUSED)
+                StgInt spi STG_UNUSED,
+                void* mask STG_UNUSED)
 {
   //barf("User signals not supported");
   return STG_SIG_DFL;
@@ -493,9 +498,9 @@ shutdown_handler(int sig STG_UNUSED)
     // extreme prejudice.  So the first ^C tries to exit the program
     // cleanly, and the second one just kills it.
     if (sched_state >= SCHED_INTERRUPTING) {
-	stg_exit(EXIT_INTERRUPTED);
+        stg_exit(EXIT_INTERRUPTED);
     } else {
-	interruptStgRts();
+        interruptStgRts();
     }
 }
 
@@ -574,7 +579,9 @@ set_sigtstp_action (rtsBool handle)
     }
     sa.sa_flags = 0;
     sigemptyset(&sa.sa_mask);
-    sigaction(SIGTSTP, &sa, NULL);
+    if (sigaction(SIGTSTP, &sa, NULL) != 0) {
+        sysErrorBelch("warning: failed to install SIGTSTP handler");
+    }
 }
 
 /* -----------------------------------------------------------------------------
@@ -602,11 +609,11 @@ initDefaultHandlers(void)
     sigemptyset(&action.sa_mask);
     action.sa_flags = 0;
     if (sigaction(SIGINT, &action, &oact) != 0) {
-	sysErrorBelch("warning: failed to install SIGINT handler");
+        sysErrorBelch("warning: failed to install SIGINT handler");
     }
 
 #if defined(HAVE_SIGINTERRUPT)
-    siginterrupt(SIGINT, 1);	// isn't this the default? --SDM
+    siginterrupt(SIGINT, 1);    // isn't this the default? --SDM
 #endif
 
     // install the SIGFPE handler
@@ -624,7 +631,7 @@ initDefaultHandlers(void)
     sigemptyset(&action.sa_mask);
     action.sa_flags = 0;
     if (sigaction(SIGFPE, &action, &oact) != 0) {
-	sysErrorBelch("warning: failed to install SIGFPE handler");
+        sysErrorBelch("warning: failed to install SIGFPE handler");
     }
 #endif
 
@@ -639,7 +646,7 @@ initDefaultHandlers(void)
     sigemptyset(&action.sa_mask);
     action.sa_flags = 0;
     if (sigaction(SIGPIPE, &action, &oact) != 0) {
-	sysErrorBelch("warning: failed to install SIGPIPE handler");
+        sysErrorBelch("warning: failed to install SIGPIPE handler");
     }
 
     set_sigtstp_action(rtsTrue);
@@ -656,14 +663,22 @@ resetDefaultHandlers(void)
 
     // restore SIGINT
     if (sigaction(SIGINT, &action, NULL) != 0) {
-	sysErrorBelch("warning: failed to uninstall SIGINT handler");
+        sysErrorBelch("warning: failed to uninstall SIGINT handler");
     }
     // restore SIGPIPE
     if (sigaction(SIGPIPE, &action, NULL) != 0) {
-	sysErrorBelch("warning: failed to uninstall SIGPIPE handler");
+        sysErrorBelch("warning: failed to uninstall SIGPIPE handler");
     }
 
     set_sigtstp_action(rtsFalse);
 }
 
 #endif /* RTS_USER_SIGNALS */
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/posix/Signals.h b/rts/posix/Signals.h
index 387d688912b5..9500fceeb468 100644
--- a/rts/posix/Signals.h
+++ b/rts/posix/Signals.h
@@ -32,3 +32,10 @@ extern StgInt *signal_handlers;
 
 #endif /* POSIX_SIGNALS_H */
 
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/posix/TTY.c b/rts/posix/TTY.c
index d39ef37b8647..009ebd659251 100644
--- a/rts/posix/TTY.c
+++ b/rts/posix/TTY.c
@@ -27,8 +27,9 @@ static void *saved_termios[3] = {NULL,NULL,NULL};
 void*
 __hscore_get_saved_termios(int fd)
 {
-  return (0 <= fd && fd < (int)(sizeof(saved_termios) / sizeof(*saved_termios))) ?
-    saved_termios[fd] : NULL;
+  return (0 <= fd &&
+            fd < (int)(sizeof(saved_termios) / sizeof(*saved_termios))) ?
+  saved_termios[fd] : NULL;
 }
 
 void
@@ -47,19 +48,28 @@ resetTerminalSettings (void)
     // if we changed them.  See System.Posix.Internals.tcSetAttr for
     // more details, including the reason we termporarily disable
     // SIGTTOU here.
-    { 
-	int fd;
-	sigset_t sigset, old_sigset;
-	sigemptyset(&sigset);
-	sigaddset(&sigset, SIGTTOU);
-	sigprocmask(SIG_BLOCK, &sigset, &old_sigset);
-	for (fd = 0; fd <= 2; fd++) {
-	    struct termios* ts = (struct termios*)__hscore_get_saved_termios(fd);
-	    if (ts != NULL) {
-		tcsetattr(fd,TCSANOW,ts);
-	    }
-	}
-	sigprocmask(SIG_SETMASK, &old_sigset, NULL);
+    {
+        int fd;
+        sigset_t sigset, old_sigset;
+        sigemptyset(&sigset);
+        sigaddset(&sigset, SIGTTOU);
+        sigprocmask(SIG_BLOCK, &sigset, &old_sigset);
+        for (fd = 0; fd <= 2; fd++) {
+            struct termios* ts =
+                (struct termios*)__hscore_get_saved_termios(fd);
+            if (ts != NULL) {
+                tcsetattr(fd,TCSANOW,ts);
+            }
+        }
+        sigprocmask(SIG_SETMASK, &old_sigset, NULL);
     }
 #endif
 }
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/posix/TTY.h b/rts/posix/TTY.h
index 7b8e16bb9281..fe3e55b5790d 100644
--- a/rts/posix/TTY.h
+++ b/rts/posix/TTY.h
@@ -12,3 +12,11 @@
 RTS_PRIVATE void resetTerminalSettings (void);
 
 #endif /* POSIX_TTY_H */
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/sm/BlockAlloc.c b/rts/sm/BlockAlloc.c
index 4d2685bb2c64..55310fdf9f62 100644
--- a/rts/sm/BlockAlloc.c
+++ b/rts/sm/BlockAlloc.c
@@ -45,7 +45,7 @@ static void  initMBlock(void *mblock);
    bd->free is either:
       - zero for a non-group-head; bd->link points to the head
       - (-1) for the head of a free block group
-      - or it points within the block
+      - or it points within the block (group)
 
    bd->blocks is either:
       - zero for a non-group-head; bd->link points to the head
@@ -894,3 +894,11 @@ reportUnmarkedBlocks (void)
 }
 
 #endif
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/sm/BlockAlloc.h b/rts/sm/BlockAlloc.h
index aebb71a91302..42b064fed8d9 100644
--- a/rts/sm/BlockAlloc.h
+++ b/rts/sm/BlockAlloc.h
@@ -32,3 +32,11 @@ extern W_ hw_alloc_blocks;  // high-water allocated blocks
 #include "EndPrivate.h"
 
 #endif /* BLOCK_ALLOC_H */
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/sm/Compact.c b/rts/sm/Compact.c
index e9973d3f8af8..e430d97002a2 100644
--- a/rts/sm/Compact.c
+++ b/rts/sm/Compact.c
@@ -183,7 +183,7 @@ get_threaded_info( StgPtr p )
 // A word-aligned memmove will be faster for small objects than libc's or gcc's.
 // Remember, the two regions *might* overlap, but: to <= from.
 STATIC_INLINE void
-move(StgPtr to, StgPtr from, W_ size)
+move(StgPtr to, StgPtr from, StgWord size)
 {
     for(; size > 0; --size) {
 	*to++ = *from++;
@@ -225,7 +225,7 @@ thread_static( StgClosure* p )
 }
 
 STATIC_INLINE void
-thread_large_bitmap( StgPtr p, StgLargeBitmap *large_bitmap, W_ size )
+thread_large_bitmap( StgPtr p, StgLargeBitmap *large_bitmap, StgWord size )
 {
     W_ i, b;
     StgWord bitmap;
@@ -247,12 +247,26 @@ thread_large_bitmap( StgPtr p, StgLargeBitmap *large_bitmap, W_ size )
     }
 }
 
+STATIC_INLINE StgPtr
+thread_small_bitmap (StgPtr p, StgWord size, StgWord bitmap)
+{
+    while (size > 0) {
+        if ((bitmap & 1) == 0) {
+            thread((StgClosure **)p);
+        }
+        p++;
+        bitmap = bitmap >> 1;
+        size--;
+    }
+    return p;
+}
+
 STATIC_INLINE StgPtr
 thread_arg_block (StgFunInfoTable *fun_info, StgClosure **args)
 {
     StgPtr p;
     StgWord bitmap;
-    W_ size;
+    StgWord size;
 
     p = (StgPtr)args;
     switch (fun_info->f.fun_type) {
@@ -269,14 +283,7 @@ thread_arg_block (StgFunInfoTable *fun_info, StgClosure **args)
 	bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]);
 	size = BITMAP_SIZE(stg_arg_bitmaps[fun_info->f.fun_type]);
     small_bitmap:
-	while (size > 0) {
-	    if ((bitmap & 1) == 0) {
-		thread((StgClosure **)p);
-	    }
-	    p++;
-	    bitmap = bitmap >> 1;
-	    size--;
-	}
+        p = thread_small_bitmap(p, size, bitmap);
 	break;
     }
     return p;
@@ -287,7 +294,7 @@ thread_stack(StgPtr p, StgPtr stack_end)
 {
     const StgRetInfoTable* info;
     StgWord bitmap;
-    W_ size;
+    StgWord size;
     
     // highly similar to scavenge_stack, but we do pointer threading here.
     
@@ -315,19 +322,11 @@ thread_stack(StgPtr p, StgPtr stack_end)
 	    p++;
 	    // NOTE: the payload starts immediately after the info-ptr, we
 	    // don't have an StgHeader in the same sense as a heap closure.
-	    while (size > 0) {
-		if ((bitmap & 1) == 0) {
-		    thread((StgClosure **)p);
-		}
-		p++;
-		bitmap = bitmap >> 1;
-		size--;
-	    }
+            p = thread_small_bitmap(p, size, bitmap);
 	    continue;
 
 	case RET_BCO: {
 	    StgBCO *bco;
-	    nat size;
 	    
 	    p++;
 	    bco = (StgBCO *)*p;
@@ -395,14 +394,7 @@ thread_PAP_payload (StgClosure *fun, StgClosure **payload, StgWord size)
     default:
 	bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]);
     small_bitmap:
-	while (size > 0) {
-	    if ((bitmap & 1) == 0) {
-		thread((StgClosure **)p);
-	    }
-	    p++;
-	    bitmap = bitmap >> 1;
-	    size--;
-	}
+        p = thread_small_bitmap(p, size, bitmap);
 	break;
     }
 
@@ -495,6 +487,21 @@ update_fwd_large( bdescr *bd )
           continue;
       }
 
+    case SMALL_MUT_ARR_PTRS_CLEAN:
+    case SMALL_MUT_ARR_PTRS_DIRTY:
+    case SMALL_MUT_ARR_PTRS_FROZEN:
+    case SMALL_MUT_ARR_PTRS_FROZEN0:
+      // follow everything 
+      {
+          StgSmallMutArrPtrs *a;
+
+          a = (StgSmallMutArrPtrs*)p;
+          for (p = (P_)a->payload; p < (P_)&a->payload[a->ptrs]; p++) {
+              thread((StgClosure **)p);
+          }
+          continue;
+      }
+
     case STACK:
     {
         StgStack *stack = (StgStack*)p;
@@ -680,6 +687,22 @@ thread_obj (StgInfoTable *info, StgPtr p)
 
 	return (StgPtr)a + mut_arr_ptrs_sizeW(a);
     }
+
+    case SMALL_MUT_ARR_PTRS_CLEAN:
+    case SMALL_MUT_ARR_PTRS_DIRTY:
+    case SMALL_MUT_ARR_PTRS_FROZEN:
+    case SMALL_MUT_ARR_PTRS_FROZEN0:
+	// follow everything 
+    {
+        StgSmallMutArrPtrs *a;
+
+        a = (StgSmallMutArrPtrs *)p;
+	for (p = (P_)a->payload; p < (P_)&a->payload[a->ptrs]; p++) {
+	    thread((StgClosure **)p);
+	}
+
+	return (StgPtr)a + small_mut_arr_ptrs_sizeW(a);
+    }
     
     case TSO:
 	return thread_TSO((StgTSO *)p);
@@ -742,7 +765,7 @@ update_fwd_compact( bdescr *blocks )
 #endif
     bdescr *bd, *free_bd;
     StgInfoTable *info;
-    nat size;
+    StgWord size;
     StgWord iptr;
 
     bd = blocks;
@@ -827,7 +850,8 @@ update_bkwd_compact( generation *gen )
 #endif
     bdescr *bd, *free_bd;
     StgInfoTable *info;
-    W_ size, free_blocks;
+    StgWord size;
+    W_ free_blocks;
     StgWord iptr;
 
     bd = free_bd = gen->old_blocks;
@@ -1000,3 +1024,11 @@ compact(StgClosure *static_objects)
 	gen->n_old_blocks = blocks;
     }
 }
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/sm/Compact.h b/rts/sm/Compact.h
index 1ec915f49a3e..306138415a77 100644
--- a/rts/sm/Compact.h
+++ b/rts/sm/Compact.h
@@ -51,3 +51,11 @@ void compact (StgClosure *static_objects);
 #include "EndPrivate.h"
 
 #endif /* SM_COMPACT_H */
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/sm/Evac.c b/rts/sm/Evac.c
index 577edc38f502..e90d3e085722 100644
--- a/rts/sm/Evac.c
+++ b/rts/sm/Evac.c
@@ -716,6 +716,14 @@ evacuate(StgClosure **p)
       copy(p,info,q,mut_arr_ptrs_sizeW((StgMutArrPtrs *)q),gen_no);
       return;
 
+  case SMALL_MUT_ARR_PTRS_CLEAN:
+  case SMALL_MUT_ARR_PTRS_DIRTY:
+  case SMALL_MUT_ARR_PTRS_FROZEN:
+  case SMALL_MUT_ARR_PTRS_FROZEN0:
+      // just copy the block 
+      copy(p,info,q,small_mut_arr_ptrs_sizeW((StgSmallMutArrPtrs *)q),gen_no);
+      return;
+
   case TSO:
       copy(p,info,q,sizeofW(StgTSO),gen_no);
       return;
@@ -1100,3 +1108,11 @@ eval_thunk_selector (StgClosure **q, StgSelector * p, rtsBool evac)
     unchain_thunk_selectors(prev_thunk_selector, *q);
     return;
 }
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/sm/Evac.h b/rts/sm/Evac.h
index 62d54eb7b9c2..26d0c9eddb52 100644
--- a/rts/sm/Evac.h
+++ b/rts/sm/Evac.h
@@ -41,3 +41,11 @@ extern W_ thunk_selector_depth;
 
 #endif /* SM_EVAC_H */
 
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/sm/GC.c b/rts/sm/GC.c
index 1ecbaf5ab135..97463746a233 100644
--- a/rts/sm/GC.c
+++ b/rts/sm/GC.c
@@ -286,6 +286,9 @@ GarbageCollect (nat collect_gen,
   memInventory(DEBUG_gc);
 #endif
 
+  // do this *before* we start scavenging
+  collectFreshWeakPtrs();
+
   // check sanity *before* GC
   IF_DEBUG(sanity, checkSanity(rtsFalse /* before GC */, major_gc));
 
@@ -1038,8 +1041,6 @@ gcWorkerThread (Capability *cap)
     SET_GCT(gc_threads[cap->no]);
     gct->id = osThreadId();
 
-    stat_gcWorkerThreadStart(gct);
-
     // Wait until we're told to wake up
     RELEASE_SPIN_LOCK(&gct->mut_spin);
     // yieldThread();
@@ -1097,9 +1098,6 @@ gcWorkerThread (Capability *cap)
     ACQUIRE_SPIN_LOCK(&gct->mut_spin);
     debugTrace(DEBUG_gc, "GC thread %d on my way...", gct->thread_index);
 
-    // record the time spent doing GC in the Task structure
-    stat_gcWorkerThreadDone(gct);
-
     SET_GCT(saved_gct);
 }
 
@@ -1613,7 +1611,8 @@ resize_generations (void)
 static void
 resize_nursery (void)
 {
-    const StgWord min_nursery = RtsFlags.GcFlags.minAllocAreaSize * n_capabilities;
+    const StgWord min_nursery =
+      RtsFlags.GcFlags.minAllocAreaSize * (StgWord)n_capabilities;
 
     if (RtsFlags.GcFlags.generations == 1)
     {   // Two-space collector:
@@ -1771,3 +1770,11 @@ static void gcCAFs(void)
     debugTrace(DEBUG_gccafs, "%d CAFs live", i);
 }
 #endif
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/sm/GC.h b/rts/sm/GC.h
index 571aa0711054..0f0b94e784cd 100644
--- a/rts/sm/GC.h
+++ b/rts/sm/GC.h
@@ -64,3 +64,11 @@ void releaseGCThreads (Capability *cap);
 #include "EndPrivate.h"
 
 #endif /* SM_GC_H */
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/sm/GCAux.c b/rts/sm/GCAux.c
index 10df9dd84be1..145ff630d23b 100644
--- a/rts/sm/GCAux.c
+++ b/rts/sm/GCAux.c
@@ -146,3 +146,11 @@ markCAFs (evac_fn evac, void *user)
 	evac(user, &c->indirectee);
     }
 }
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/sm/GCTDecl.h b/rts/sm/GCTDecl.h
index 2c08e10783a5..74b788012ccf 100644
--- a/rts/sm/GCTDecl.h
+++ b/rts/sm/GCTDecl.h
@@ -1,10 +1,10 @@
 /* -----------------------------------------------------------------------------
  *
- * (c) The GHC Team 1998-2009
+ * (c) The GHC Team 1998-2014
  *
  * Documentation on the architecture of the Garbage Collector can be
  * found in the online commentary:
- * 
+ *
  *   http://ghc.haskell.org/trac/ghc/wiki/Commentary/Rts/Storage/GC
  *
  * ---------------------------------------------------------------------------*/
@@ -14,96 +14,141 @@
 
 #include "BeginPrivate.h"
 
-/* -----------------------------------------------------------------------------
-   The gct variable is thread-local and points to the current thread's
-   gc_thread structure.  It is heavily accessed, so we try to put gct
-   into a global register variable if possible; if we don't have a
-   register then use gcc's __thread extension to create a thread-local
-   variable.
-   -------------------------------------------------------------------------- */
+/* The gct variable is thread-local and points to the current thread's
+   gc_thread structure. It is heavily accessed, and thus high
+   performance access is crucial to parallel (-threaded) workloads.
+
+   First, we try to use a 'global register variable' which is a GCC
+   extension. This reserves the register globally.
+
+   If that's not possible, then we need to use __thread, which is a
+   compiler/OS specific TLS storage mechanism (assumed to be Fast
+   Enough.)
+
+   BUT, some older versions of OS X compilers (llvm-gcc, older Clangs)
+   do not support __thread at all. Modern clang however, does - but on
+   OS X it's not as fast as the Linux (which can write directly into a
+   segment register - see #7602.)
+
+   If we don't support __thread then we do the absolute worst thing:
+   we just use pthread_getspecific and pthread_setspecific (which are
+   horribly slow.)
+*/
+
+#define GCT_REG_DECL(type,name,reg) register type name REG(reg);
+
+
+/* -------------------------------------------------------------------------- */
+
+/* First: if we're not using the threaded RTS, it's easy: just fake it. */
+#if !defined(THREADED_RTS)
+extern StgWord8 the_gc_thread[];
+#define gct ((gc_thread*)&the_gc_thread)
+#define SET_GCT(to) /*nothing*/
+#define DECLARE_GCT /*nothing*/
+
+#else /* defined(THREADED_RTS) */
 
-#if defined(THREADED_RTS)
+/* -------------------------------------------------------------------------- */
 
-#define GLOBAL_REG_DECL(type,name,reg) register type name REG(reg);
+/* Now, llvm-gcc and some older Clang compilers do not support
+   __thread. So we have to fallback to the extremely slow case,
+   unfortunately. Note: clang_CC_FLAVOR implies llvm_CC_FLAVOR.
 
-#ifdef llvm_CC_FLAVOR
+   Also, the iOS Clang compiler doesn't support __thread either for
+   some bizarre reason, so there's not much we can do about that... */
+#if defined(llvm_CC_FLAVOR) && (CC_SUPPORTS_TLS == 0)
+#define gct ((gc_thread *)(pthread_getspecific(gctKey)))
 #define SET_GCT(to) (pthread_setspecific(gctKey, to))
-#else
-#define SET_GCT(to) gct = (to)
-#endif
+#define DECLARE_GCT ThreadLocalKey gctKey;
 
+/* -------------------------------------------------------------------------- */
 
+/* However, if we *are* using an LLVM based compiler with __thread
+   support, then use that (since LLVM doesn't support global register
+   variables.) */
+#elif defined(llvm_CC_FLAVOR) && (CC_SUPPORTS_TLS == 1)
+extern __thread gc_thread* gct;
+#define SET_GCT(to) gct = (to)
+#define DECLARE_GCT __thread gc_thread* gct;
 
-#if (defined(i386_HOST_ARCH) && defined(linux_HOST_OS))
-// Using __thread is better than stealing a register on x86/Linux, because
-// we have too few registers available.  In my tests it was worth
-// about 5% in GC performance, but of course that might change as gcc
-// improves. -- SDM 2009/04/03
-//
-// For MacOSX, we can use an llvm-based C compiler which will store the gct
-// in a thread local variable using pthreads.
+/* -------------------------------------------------------------------------- */
 
+/* Next up: Using __thread is better than stealing a register on
+   x86/Linux, because we have too few registers available. In my
+   tests it was worth about 5% in GC performance, but of course that
+   might change as gcc improves. -- SDM 2009/04/03 */
+#elif (defined(i386_HOST_ARCH) && defined(linux_HOST_OS))
 extern __thread gc_thread* gct;
+#define SET_GCT(to) gct = (to)
 #define DECLARE_GCT __thread gc_thread* gct;
 
-#elif defined(llvm_CC_FLAVOR)
-// LLVM does not support the __thread extension and will generate
-// incorrect code for global register variables. If we are compiling
-// with a C compiler that uses an LLVM back end (clang or llvm-gcc) then we
-// use pthread_getspecific() to handle the thread local storage for gct.
-#define gct ((gc_thread *)(pthread_getspecific(gctKey)))
-#define DECLARE_GCT ThreadLocalKey gctKey;
+/* -------------------------------------------------------------------------- */
 
-#elif defined(sparc_HOST_ARCH)
-// On SPARC we can't pin gct to a register. Names like %l1 are just offsets
-//	into the register window, which change on each function call.
-//	
-//	There are eight global (non-window) registers, but they're used for other purposes.
-//	%g0     -- always zero
-//	%g1     -- volatile over function calls, used by the linker
-//	%g2-%g3 -- used as scratch regs by the C compiler (caller saves)
-//	%g4	-- volatile over function calls, used by the linker
-//	%g5-%g7	-- reserved by the OS
+/* Next up: On SPARC we can't pin gct to a register. Names like %l1
+   are just offsets into the register window, which change on each
+   function call.
 
+   There are eight global (non-window) registers, but they're used for other
+   purposes:
+
+    %g0     -- always zero
+    %g1     -- volatile over function calls, used by the linker
+    %g2-%g3 -- used as scratch regs by the C compiler (caller saves)
+    %g4     -- volatile over function calls, used by the linker
+    %g5-%g7 -- reserved by the OS
+*/
+#elif defined(sparc_HOST_ARCH)
 extern __thread gc_thread* gct;
+#define SET_GCT(to) gct = (to)
 #define DECLARE_GCT __thread gc_thread* gct;
 
+/* -------------------------------------------------------------------------- */
 
+/* Next up: generally, if REG_Base is defined and we're *not* using
+   i386, then actually declare the needed register. The catch for i386
+   here is that REG_Base is %ebx, but that is also used for -fPIC, so
+   it can't be stolen */
 #elif defined(REG_Base) && !defined(i386_HOST_ARCH)
-// on i386, REG_Base is %ebx which is also used for PIC, so we don't
-// want to steal it
-
-GLOBAL_REG_DECL(gc_thread*, gct, REG_Base)
+GCT_REG_DECL(gc_thread*, gct, REG_Base);
+#define SET_GCT(to) gct = (to)
 #define DECLARE_GCT /* nothing */
 
+/* -------------------------------------------------------------------------- */
 
+/* Next up: if REG_R1 is available after checking REG_Base, we're
+   gonna steal it in every case we can. */
 #elif defined(REG_R1)
-
-GLOBAL_REG_DECL(gc_thread*, gct, REG_R1)
+GCT_REG_DECL(gc_thread*, gct, REG_R1);
+#define SET_GCT(to) gct = (to)
 #define DECLARE_GCT /* nothing */
 
+/* -------------------------------------------------------------------------- */
 
-#elif defined(__GNUC__)
-
+/* Finally, as an absolute fallback, if none of the above tests check
+   out but we *do* have __thread support, then use that. */
+#elif CC_SUPPORTS_TLS == 1
 extern __thread gc_thread* gct;
+#define SET_GCT(to) gct = (to)
 #define DECLARE_GCT __thread gc_thread* gct;
 
-#else
-
-#error Cannot find a way to declare the thread-local gct
+/* -------------------------------------------------------------------------- */
 
+/* Impossible! */
+#else
+#error Cannot find a way to declare the thread-local gc variable!
 #endif
 
-#else  // not the threaded RTS
-
-extern StgWord8 the_gc_thread[];
-
-#define gct ((gc_thread*)&the_gc_thread)
-#define SET_GCT(to) /*nothing*/
-#define DECLARE_GCT /*nothing*/
-
 #endif // THREADED_RTS
 
 #include "EndPrivate.h"
 
 #endif // SM_GCTDECL_H
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/sm/GCThread.h b/rts/sm/GCThread.h
index 12ef999a9bf6..8ed8afe055e1 100644
--- a/rts/sm/GCThread.h
+++ b/rts/sm/GCThread.h
@@ -77,7 +77,7 @@
    ------------------------------------------------------------------------- */
 
 typedef struct gen_workspace_ {
-    generation * gen;		// the gen for this workspace 
+    generation * gen;           // the gen for this workspace
     struct gc_thread_ * my_gct; // the gc_thread that contains this workspace
 
     // where objects to be scavenged go
@@ -184,7 +184,6 @@ typedef struct gc_thread_ {
 
     Time gc_start_cpu;   // process CPU time
     Time gc_start_elapsed;  // process elapsed time
-    Time gc_start_thread_cpu; // thread CPU time
     W_ gc_start_faults;
 
     // -------------------
@@ -211,3 +210,11 @@ extern ThreadLocalKey gctKey;
 
 #endif // SM_GCTHREAD_H
 
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/sm/GCUtils.c b/rts/sm/GCUtils.c
index 11345e92c802..078da12d947c 100644
--- a/rts/sm/GCUtils.c
+++ b/rts/sm/GCUtils.c
@@ -343,3 +343,11 @@ printMutableList(bdescr *bd)
     debugBelch("\n");
 }
 #endif /* DEBUG */
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/sm/GCUtils.h b/rts/sm/GCUtils.h
index 1d217adbddc4..de5aefca6a16 100644
--- a/rts/sm/GCUtils.h
+++ b/rts/sm/GCUtils.h
@@ -66,3 +66,11 @@ recordMutableGen_GC (StgClosure *p, nat gen_no)
 #include "EndPrivate.h"
 
 #endif /* SM_GCUTILS_H */
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/sm/MBlock.c b/rts/sm/MBlock.c
index 6bc4049959a2..20b301552c77 100644
--- a/rts/sm/MBlock.c
+++ b/rts/sm/MBlock.c
@@ -286,3 +286,11 @@ initMBlocks(void)
     memset(mblock_cache,0xff,sizeof(mblock_cache));
 #endif
 }
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/sm/MarkStack.h b/rts/sm/MarkStack.h
index f978a32563ab..081a189bc624 100644
--- a/rts/sm/MarkStack.h
+++ b/rts/sm/MarkStack.h
@@ -69,3 +69,11 @@ mark_stack_empty(void)
 #include "EndPrivate.h"
 
 #endif /* SM_MARKSTACK_H */
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/sm/MarkWeak.c b/rts/sm/MarkWeak.c
index 4e0c1369a10c..b8ec4532b4d5 100644
--- a/rts/sm/MarkWeak.c
+++ b/rts/sm/MarkWeak.c
@@ -25,6 +25,8 @@
 #include "Storage.h"
 #include "Threads.h"
 
+#include "sm/Sanity.h"
+
 /* -----------------------------------------------------------------------------
    Weak Pointers
 
@@ -39,10 +41,8 @@
    new live weak pointers, then all the currently unreachable ones are
    dead.
 
-   For generational GC: we just don't try to finalize weak pointers in
-   older generations than the one we're collecting.  This could
-   probably be optimised by keeping per-generation lists of weak
-   pointers, but for a few weak pointers this scheme will work.
+   For generational GC: we don't try to finalize weak pointers in
+   older generations than the one we're collecting.
 
    There are three distinct stages to processing weak pointers:
 
@@ -343,6 +343,39 @@ static void tidyThreadList (generation *gen)
     }
 }
 
+#ifdef DEBUG
+static void checkWeakPtrSanity(StgWeak *hd, StgWeak *tl)
+{
+    StgWeak *w, *prev;
+    for (w = hd; w != NULL; prev = w, w = w->link) {
+        ASSERT(INFO_PTR_TO_STRUCT(UNTAG_CLOSURE((StgClosure*)w)->header.info)->type == WEAK);
+        checkClosure((StgClosure*)w);
+    }
+    if (tl != NULL) {
+        ASSERT(prev == tl);
+    }
+}
+#endif
+
+void collectFreshWeakPtrs()
+{
+    nat i;
+    generation *gen = &generations[0];
+    // move recently allocated weak_ptr_list to the old list as well
+    for (i = 0; i < n_capabilities; i++) {
+        Capability *cap = capabilities[i];
+        if (cap->weak_ptr_list_tl != NULL) {
+            IF_DEBUG(sanity, checkWeakPtrSanity(cap->weak_ptr_list_hd, cap->weak_ptr_list_tl));
+            cap->weak_ptr_list_tl->link = gen->weak_ptr_list;
+            gen->weak_ptr_list = cap->weak_ptr_list_hd;
+            cap->weak_ptr_list_tl = NULL;
+            cap->weak_ptr_list_hd = NULL;
+        } else {
+            ASSERT(cap->weak_ptr_list_hd == NULL);
+        }
+    }
+}
+
 /* -----------------------------------------------------------------------------
    Evacuate every weak pointer object on the weak_ptr_list, and update
    the link fields.
@@ -383,3 +416,11 @@ markWeakPtrList ( void )
     }
 }
 
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/sm/MarkWeak.h b/rts/sm/MarkWeak.h
index f9bacfa0dab7..ee94eebba61a 100644
--- a/rts/sm/MarkWeak.h
+++ b/rts/sm/MarkWeak.h
@@ -20,6 +20,7 @@ extern StgWeak *old_weak_ptr_list;
 extern StgTSO *resurrected_threads;
 extern StgTSO *exception_threads;
 
+void    collectFreshWeakPtrs   ( void );
 void    initWeakForGC          ( void );
 rtsBool traverseWeakPtrList    ( void );
 void    markWeakPtrList        ( void );
@@ -27,3 +28,11 @@ void    markWeakPtrList        ( void );
 #include "EndPrivate.h"
 
 #endif /* SM_MARKWEAK_H */
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/sm/OSMem.h b/rts/sm/OSMem.h
index db704fc78bb3..e5c97ecceabb 100644
--- a/rts/sm/OSMem.h
+++ b/rts/sm/OSMem.h
@@ -23,3 +23,11 @@ void setExecutable (void *p, W_ len, rtsBool exec);
 #include "EndPrivate.h"
 
 #endif /* SM_OSMEM_H */
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/sm/Sanity.c b/rts/sm/Sanity.c
index c65333116477..07230afd4a83 100644
--- a/rts/sm/Sanity.c
+++ b/rts/sm/Sanity.c
@@ -931,3 +931,11 @@ memInventory (rtsBool show)
 
 
 #endif /* DEBUG */
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/sm/Sanity.h b/rts/sm/Sanity.h
index f302bc22b184..9a2d2697daf1 100644
--- a/rts/sm/Sanity.h
+++ b/rts/sm/Sanity.h
@@ -44,3 +44,11 @@ void checkBQ (StgTSO *bqe, StgClosure *closure);
 #endif /* DEBUG */
  
 #endif /* SANITY_H */
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/sm/Scav.c b/rts/sm/Scav.c
index 5b1e5d0fc834..abebb3ca96fe 100644
--- a/rts/sm/Scav.c
+++ b/rts/sm/Scav.c
@@ -32,7 +32,7 @@ static void scavenge_stack (StgPtr p, StgPtr stack_end);
 
 static void scavenge_large_bitmap (StgPtr p, 
 				   StgLargeBitmap *large_bitmap, 
-				   nat size );
+				   StgWord size );
 
 #if defined(THREADED_RTS) && !defined(PARALLEL_GC)
 # define evacuate(a) evacuate1(a)
@@ -168,6 +168,20 @@ static StgPtr scavenge_mut_arr_ptrs_marked (StgMutArrPtrs *a)
     return (StgPtr)a + mut_arr_ptrs_sizeW(a);
 }
 
+STATIC_INLINE StgPtr
+scavenge_small_bitmap (StgPtr p, StgWord size, StgWord bitmap)
+{
+    while (size > 0) {
+        if ((bitmap & 1) == 0) {
+            evacuate((StgClosure **)p);
+        }
+        p++;
+        bitmap = bitmap >> 1;
+        size--;
+    }
+    return p;
+}
+
 /* -----------------------------------------------------------------------------
    Blocks of function args occur on the stack (at the top) and
    in PAPs.
@@ -178,7 +192,7 @@ scavenge_arg_block (StgFunInfoTable *fun_info, StgClosure **args)
 {
     StgPtr p;
     StgWord bitmap;
-    nat size;
+    StgWord size;
 
     p = (StgPtr)args;
     switch (fun_info->f.fun_type) {
@@ -195,14 +209,7 @@ scavenge_arg_block (StgFunInfoTable *fun_info, StgClosure **args)
 	bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]);
 	size = BITMAP_SIZE(stg_arg_bitmaps[fun_info->f.fun_type]);
     small_bitmap:
-	while (size > 0) {
-	    if ((bitmap & 1) == 0) {
-		evacuate((StgClosure **)p);
-	    }
-	    p++;
-	    bitmap = bitmap >> 1;
-	    size--;
-	}
+        p = scavenge_small_bitmap(p, size, bitmap);
 	break;
     }
     return p;
@@ -234,14 +241,7 @@ scavenge_PAP_payload (StgClosure *fun, StgClosure **payload, StgWord size)
     default:
 	bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]);
     small_bitmap:
-	while (size > 0) {
-	    if ((bitmap & 1) == 0) {
-		evacuate((StgClosure **)p);
-	    }
-	    p++;
-	    bitmap = bitmap >> 1;
-	    size--;
-	}
+        p = scavenge_small_bitmap(p, size, bitmap);
 	break;
     }
     return p;
@@ -661,6 +661,54 @@ scavenge_block (bdescr *bd)
 	break;
     }
 
+    case SMALL_MUT_ARR_PTRS_CLEAN:
+    case SMALL_MUT_ARR_PTRS_DIRTY:
+        // follow everything
+    {
+        StgPtr next;
+
+        // We don't eagerly promote objects pointed to by a mutable
+        // array, but if we find the array only points to objects in
+        // the same or an older generation, we mark it "clean" and
+        // avoid traversing it during minor GCs.
+        gct->eager_promotion = rtsFalse;
+        next = p + small_mut_arr_ptrs_sizeW((StgSmallMutArrPtrs*)p);
+        for (p = (P_)((StgSmallMutArrPtrs *)p)->payload; p < next; p++) {
+            evacuate((StgClosure **)p);
+        }
+        gct->eager_promotion = saved_eager_promotion;
+
+        if (gct->failed_to_evac) {
+            ((StgClosure *)q)->header.info = &stg_SMALL_MUT_ARR_PTRS_DIRTY_info;
+        } else {
+            ((StgClosure *)q)->header.info = &stg_SMALL_MUT_ARR_PTRS_CLEAN_info;
+        }
+
+        gct->failed_to_evac = rtsTrue; // always put it on the mutable list.
+        break;
+    }
+
+    case SMALL_MUT_ARR_PTRS_FROZEN:
+    case SMALL_MUT_ARR_PTRS_FROZEN0:
+        // follow everything
+    {
+        StgPtr next;
+
+        next = p + small_mut_arr_ptrs_sizeW((StgSmallMutArrPtrs*)p);
+        for (p = (P_)((StgSmallMutArrPtrs *)p)->payload; p < next; p++) {
+            evacuate((StgClosure **)p);
+        }
+
+        // If we're going to put this object on the mutable list, then
+        // set its info ptr to SMALL_MUT_ARR_PTRS_FROZEN0 to indicate that.
+        if (gct->failed_to_evac) {
+            ((StgClosure *)q)->header.info = &stg_SMALL_MUT_ARR_PTRS_FROZEN0_info;
+        } else {
+            ((StgClosure *)q)->header.info = &stg_SMALL_MUT_ARR_PTRS_FROZEN_info;
+        }
+        break;
+    }
+
     case TSO:
     { 
         scavengeTSO((StgTSO *)p);
@@ -1016,6 +1064,56 @@ scavenge_mark_stack(void)
 	    break;
 	}
 
+        case SMALL_MUT_ARR_PTRS_CLEAN:
+        case SMALL_MUT_ARR_PTRS_DIRTY:
+            // follow everything
+        {
+            StgPtr next;
+            rtsBool saved_eager;
+
+            // We don't eagerly promote objects pointed to by a mutable
+            // array, but if we find the array only points to objects in
+            // the same or an older generation, we mark it "clean" and
+            // avoid traversing it during minor GCs.
+            saved_eager = gct->eager_promotion;
+            gct->eager_promotion = rtsFalse;
+            next = p + small_mut_arr_ptrs_sizeW((StgSmallMutArrPtrs*)p);
+            for (p = (P_)((StgSmallMutArrPtrs *)p)->payload; p < next; p++) {
+                evacuate((StgClosure **)p);
+            }
+            gct->eager_promotion = saved_eager;
+
+            if (gct->failed_to_evac) {
+                ((StgClosure *)q)->header.info = &stg_SMALL_MUT_ARR_PTRS_DIRTY_info;
+            } else {
+                ((StgClosure *)q)->header.info = &stg_SMALL_MUT_ARR_PTRS_CLEAN_info;
+            }
+
+            gct->failed_to_evac = rtsTrue; // mutable anyhow.
+            break;
+        }
+
+        case SMALL_MUT_ARR_PTRS_FROZEN:
+        case SMALL_MUT_ARR_PTRS_FROZEN0:
+            // follow everything
+        {
+            StgPtr next, q = p;
+           
+            next = p + small_mut_arr_ptrs_sizeW((StgSmallMutArrPtrs*)p);
+            for (p = (P_)((StgSmallMutArrPtrs *)p)->payload; p < next; p++) {
+                evacuate((StgClosure **)p);
+            }
+
+            // If we're going to put this object on the mutable list, then
+            // set its info ptr to SMALL_MUT_ARR_PTRS_FROZEN0 to indicate that.
+            if (gct->failed_to_evac) {
+                ((StgClosure *)q)->header.info = &stg_SMALL_MUT_ARR_PTRS_FROZEN0_info;
+            } else {
+                ((StgClosure *)q)->header.info = &stg_SMALL_MUT_ARR_PTRS_FROZEN_info;
+            }
+            break;
+        }
+
 	case TSO:
 	{ 
             scavengeTSO((StgTSO*)p);
@@ -1281,6 +1379,56 @@ scavenge_one(StgPtr p)
 	break;
     }
 
+    case SMALL_MUT_ARR_PTRS_CLEAN:
+    case SMALL_MUT_ARR_PTRS_DIRTY:
+    {
+        StgPtr next, q;
+        rtsBool saved_eager;
+
+        // We don't eagerly promote objects pointed to by a mutable
+        // array, but if we find the array only points to objects in
+        // the same or an older generation, we mark it "clean" and
+        // avoid traversing it during minor GCs.
+        saved_eager = gct->eager_promotion;
+        gct->eager_promotion = rtsFalse;
+        q = p;
+        next = p + small_mut_arr_ptrs_sizeW((StgSmallMutArrPtrs*)p);
+        for (p = (P_)((StgSmallMutArrPtrs *)p)->payload; p < next; p++) {
+            evacuate((StgClosure **)p);
+        }
+        gct->eager_promotion = saved_eager;
+
+        if (gct->failed_to_evac) {
+            ((StgClosure *)q)->header.info = &stg_SMALL_MUT_ARR_PTRS_DIRTY_info;
+        } else {
+            ((StgClosure *)q)->header.info = &stg_SMALL_MUT_ARR_PTRS_CLEAN_info;
+        }
+
+        gct->failed_to_evac = rtsTrue;
+        break;
+    }
+
+    case SMALL_MUT_ARR_PTRS_FROZEN:
+    case SMALL_MUT_ARR_PTRS_FROZEN0:
+    {
+        // follow everything
+        StgPtr next, q=p;
+     
+        next = p + small_mut_arr_ptrs_sizeW((StgSmallMutArrPtrs*)p);
+        for (p = (P_)((StgSmallMutArrPtrs *)p)->payload; p < next; p++) {
+            evacuate((StgClosure **)p);
+        }
+
+        // If we're going to put this object on the mutable list, then
+        // set its info ptr to SMALL_MUT_ARR_PTRS_FROZEN0 to indicate that.
+        if (gct->failed_to_evac) {
+            ((StgClosure *)q)->header.info = &stg_SMALL_MUT_ARR_PTRS_FROZEN0_info;
+        } else {
+            ((StgClosure *)q)->header.info = &stg_SMALL_MUT_ARR_PTRS_FROZEN_info;
+        }
+        break;
+    }
+
     case TSO:
     {
 	scavengeTSO((StgTSO*)p);
@@ -1350,7 +1498,7 @@ scavenge_one(StgPtr p)
       { 
 	StgPtr start = gen->scan;
 	bdescr *start_bd = gen->scan_bd;
-	nat size = 0;
+	StgWord size = 0;
 	scavenge(&gen);
 	if (start_bd != gen->scan_bd) {
 	  size += (P_)BLOCK_ROUND_UP(start) - start;
@@ -1597,7 +1745,7 @@ scavenge_static(void)
    -------------------------------------------------------------------------- */
 
 static void
-scavenge_large_bitmap( StgPtr p, StgLargeBitmap *large_bitmap, nat size )
+scavenge_large_bitmap( StgPtr p, StgLargeBitmap *large_bitmap, StgWord size )
 {
     nat i, j, b;
     StgWord bitmap;
@@ -1617,19 +1765,6 @@ scavenge_large_bitmap( StgPtr p, StgLargeBitmap *large_bitmap, nat size )
     }
 }
 
-STATIC_INLINE StgPtr
-scavenge_small_bitmap (StgPtr p, nat size, StgWord bitmap)
-{
-    while (size > 0) {
-	if ((bitmap & 1) == 0) {
-	    evacuate((StgClosure **)p);
-	}
-	p++;
-	bitmap = bitmap >> 1;
-	size--;
-    }
-    return p;
-}
 
 /* -----------------------------------------------------------------------------
    scavenge_stack walks over a section of stack and evacuates all the
@@ -1642,7 +1777,7 @@ scavenge_stack(StgPtr p, StgPtr stack_end)
 {
   const StgRetInfoTable* info;
   StgWord bitmap;
-  nat size;
+  StgWord size;
 
   /* 
    * Each time around this loop, we are looking at a chunk of stack
@@ -1726,7 +1861,7 @@ scavenge_stack(StgPtr p, StgPtr stack_end)
 
     case RET_BCO: {
 	StgBCO *bco;
-	nat size;
+	StgWord size;
 
 	p++;
 	evacuate((StgClosure **)p);
@@ -1741,7 +1876,7 @@ scavenge_stack(StgPtr p, StgPtr stack_end)
       // large bitmap (> 32 entries, or > 64 on a 64-bit machine) 
     case RET_BIG:
     {
-	nat size;
+	StgWord size;
 
 	size = GET_LARGE_BITMAP(&info->i)->size;
 	p++;
@@ -1935,3 +2070,11 @@ scavenge_loop(void)
     if (work_to_do) goto loop;
 }
 
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/sm/Scav.h b/rts/sm/Scav.h
index 725d27ccf1e4..c755f39a8eb7 100644
--- a/rts/sm/Scav.h
+++ b/rts/sm/Scav.h
@@ -30,3 +30,11 @@ void    scavenge_capability_mut_Lists1 (Capability *cap);
 
 #endif /* SM_SCAV_H */
 
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/sm/Storage.c b/rts/sm/Storage.c
index c7126fe32fef..5d0cbacec8d8 100644
--- a/rts/sm/Storage.c
+++ b/rts/sm/Storage.c
@@ -237,7 +237,7 @@ void storageAddCapabilities (nat from, nat to)
         }
     }
 
-#if defined(THREADED_RTS) && defined(llvm_CC_FLAVOR)
+#if defined(THREADED_RTS) && defined(llvm_CC_FLAVOR) && (CC_SUPPORTS_TLS == 0)
     newThreadLocalKey(&gctKey);
 #endif
 
@@ -261,7 +261,7 @@ freeStorage (rtsBool free_heap)
     closeMutex(&sm_mutex);
 #endif
     stgFree(nurseries);
-#if defined(THREADED_RTS) && defined(llvm_CC_FLAVOR)
+#if defined(THREADED_RTS) && defined(llvm_CC_FLAVOR) && (CC_SUPPORTS_TLS == 0)
     freeThreadLocalKey(&gctKey);
 #endif
     freeGcThreads();
@@ -662,20 +662,22 @@ move_STACK (StgStack *src, StgStack *dest)
 }
 
 /* -----------------------------------------------------------------------------
-   allocate()
-
-   This allocates memory in the current thread - it is intended for
-   use primarily from STG-land where we have a Capability.  It is
-   better than allocate() because it doesn't require taking the
-   sm_mutex lock in the common case.
-
-   Memory is allocated directly from the nursery if possible (but not
-   from the current nursery block, so as not to interfere with
-   Hp/HpLim).
+   StgPtr allocate (Capability *cap, W_ n)
+
+   Allocates an area of memory n *words* large, from the nursery of
+   the supplied Capability, or from the global block pool if the area
+   requested is larger than LARGE_OBJECT_THRESHOLD.  Memory is not
+   allocated from the current nursery block, so as not to interfere
+   with Hp/HpLim.
+
+   The address of the allocated memory is returned. allocate() never
+   fails; if it returns, the returned value is a valid address.  If
+   the nursery is already full, then another block is allocated from
+   the global block pool.  If we need to get memory from the OS and
+   that operation fails, then the whole process will be killed.
    -------------------------------------------------------------------------- */
 
-StgPtr
-allocate (Capability *cap, W_ n)
+StgPtr allocate (Capability *cap, W_ n)
 {
     bdescr *bd;
     StgPtr p;
@@ -684,7 +686,15 @@ allocate (Capability *cap, W_ n)
     CCS_ALLOC(cap->r.rCCCS,n);
     
     if (n >= LARGE_OBJECT_THRESHOLD/sizeof(W_)) {
-        W_ req_blocks =  (W_)BLOCK_ROUND_UP(n*sizeof(W_)) / BLOCK_SIZE;
+        // The largest number of words such that
+        // the computation of req_blocks will not overflow.
+        W_ max_words = (HS_WORD_MAX & ~(BLOCK_SIZE-1)) / sizeof(W_);
+        W_ req_blocks;
+
+        if (n > max_words)
+            req_blocks = HS_WORD_MAX; // signal overflow below
+        else
+            req_blocks = (W_)BLOCK_ROUND_UP(n*sizeof(W_)) / BLOCK_SIZE;
 
         // Attempting to allocate an object larger than maxHeapSize
         // should definitely be disallowed.  (bug #1791)
@@ -1342,3 +1352,11 @@ _bdescr (StgPtr p)
 }
 
 #endif
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/sm/Storage.h b/rts/sm/Storage.h
index e433c2b8fec0..c1a92aca3570 100644
--- a/rts/sm/Storage.h
+++ b/rts/sm/Storage.h
@@ -141,3 +141,11 @@ extern StgIndStatic * revertible_caf_list;
 #include "EndPrivate.h"
 
 #endif /* SM_STORAGE_H */
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/sm/Sweep.c b/rts/sm/Sweep.c
index c927f300d722..842ede243ed9 100644
--- a/rts/sm/Sweep.c
+++ b/rts/sm/Sweep.c
@@ -84,3 +84,11 @@ sweep(generation *gen)
 
     ASSERT(countBlocks(gen->old_blocks) == gen->n_old_blocks);
 }
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/sm/Sweep.h b/rts/sm/Sweep.h
index b590faa80372..29b29f363853 100644
--- a/rts/sm/Sweep.h
+++ b/rts/sm/Sweep.h
@@ -17,3 +17,11 @@
 RTS_PRIVATE void sweep(generation *gen);
 
 #endif /* SM_SWEEP_H */
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/win32/AsyncIO.c b/rts/win32/AsyncIO.c
index 9f45317d3898..412f31b43ed7 100644
--- a/rts/win32/AsyncIO.c
+++ b/rts/win32/AsyncIO.c
@@ -19,7 +19,7 @@
 /*
  * Overview:
  *
- * Haskell code issue asynchronous I/O requests via the 
+ * Haskell code issue asynchronous I/O requests via the
  * async{Read,Write,DoOp}# primops. These cause addIORequest()
  * to be invoked, which forwards the request to the underlying
  * asynchronous I/O subsystem. Each request is tagged with a unique
@@ -30,7 +30,7 @@
  * it. Upon completion of an I/O request, the async I/O handling
  * code makes a back-call to signal its completion; the local
  * onIOComplete() routine. It adds the IO request ID (along with
- * its result data) to a queue of completed requests before returning. 
+ * its result data) to a queue of completed requests before returning.
  *
  * The queue of completed IO request is read by the thread operating
  * the RTS scheduler. It de-queues the CH threads corresponding
@@ -57,62 +57,66 @@ static int              issued_reqs;
 
 static void
 onIOComplete(unsigned int reqID,
-	     int   fd STG_UNUSED,
-	     int   len,
-	     void* buf STG_UNUSED,
-	     int   errCode)
+             int   fd STG_UNUSED,
+             int   len,
+             void* buf STG_UNUSED,
+             int   errCode)
 {
     DWORD dwRes;
     /* Deposit result of request in queue/table..when there's room. */
     dwRes = WaitForSingleObject(completed_table_sema, INFINITE);
     switch (dwRes) {
     case WAIT_OBJECT_0:
-	break;
+        break;
     default:
-	/* Not likely */
-	fprintf(stderr, "onIOComplete: failed to grab table semaphore, dropping request 0x%x\n", reqID);
-	fflush(stderr);
-	return;
+        /* Not likely */
+        fprintf(stderr,
+                "onIOComplete: failed to grab table semaphore, "
+                "dropping request 0x%x\n", reqID);
+        fflush(stderr);
+        return;
     }
     EnterCriticalSection(&queue_lock);
     if (completed_hw == MAX_REQUESTS) {
-	/* Shouldn't happen */
-	fprintf(stderr, "onIOComplete: ERROR -- Request table overflow (%d); dropping.\n", reqID);
-	fflush(stderr);
+        /* Shouldn't happen */
+        fprintf(stderr, "onIOComplete: ERROR -- Request table overflow (%d); "
+                        "dropping.\n", reqID);
+        fflush(stderr);
     } else {
 #if 0
-	fprintf(stderr, "onCompl: %d %d %d %d %d\n", 
-		reqID, len, errCode, issued_reqs, completed_hw); 
-	fflush(stderr);
+        fprintf(stderr, "onCompl: %d %d %d %d %d\n",
+                reqID, len, errCode, issued_reqs, completed_hw);
+        fflush(stderr);
 #endif
-	completedTable[completed_hw].reqID   = reqID;
-	completedTable[completed_hw].len     = len;
-	completedTable[completed_hw].errCode = errCode;
-	completed_hw++;
-	issued_reqs--;
-	if (completed_hw == 1) {
-	    /* The event is used to wake up the scheduler thread should it
-	     * be blocked waiting for requests to complete. The event resets once
-	     * that thread has cleared out the request queue/table.
-	     */
-	    SetEvent(completed_req_event);
-	}
+        completedTable[completed_hw].reqID   = reqID;
+        completedTable[completed_hw].len     = len;
+        completedTable[completed_hw].errCode = errCode;
+        completed_hw++;
+        issued_reqs--;
+        if (completed_hw == 1) {
+            /* The event is used to wake up the scheduler thread should it
+             * be blocked waiting for requests to complete. The event resets
+             * once that thread has cleared out the request queue/table.
+             */
+            SetEvent(completed_req_event);
+        }
     }
     LeaveCriticalSection(&queue_lock);
 }
 
 unsigned int
 addIORequest(int   fd,
-	     int   forWriting,
-	     int   isSock,
-	     int   len,
-	     char* buf)
+             int   forWriting,
+             int   isSock,
+             int   len,
+             char* buf)
 {
     EnterCriticalSection(&queue_lock);
     issued_reqs++;
     LeaveCriticalSection(&queue_lock);
 #if 0
-    fprintf(stderr, "addIOReq: %d %d %d\n", fd, forWriting, len); fflush(stderr);
+    fprintf(stderr, "addIOReq: %d %d %d\n", fd, forWriting, len);
+    fflush(stderr);
 #endif
     return AddIORequest(fd,forWriting,isSock,len,buf,onIOComplete);
 }
@@ -146,30 +150,34 @@ int
 startupAsyncIO()
 {
     if (!StartIOManager()) {
-	return 0;
+        return 0;
     }
     InitializeCriticalSection(&queue_lock);
     /* Create a pair of events:
      *
-     *    - completed_req_event  -- signals the deposit of request result; manual reset.
-     *    - abandon_req_wait     -- external OS thread tells current RTS/Scheduler
-     *                              thread to abandon wait for IO request completion.
-     *                              Auto reset.
+     *    - completed_req_event -- signals the deposit of request result;
+     *                             manual reset.
+     *    - abandon_req_wait    -- external OS thread tells current
+     *                             RTS/Scheduler thread to abandon wait
+     *                             for IO request completion.
+     *                             Auto reset.
      */
     completed_req_event = CreateEvent (NULL, TRUE,  FALSE, NULL);
     abandon_req_wait    = CreateEvent (NULL, FALSE, FALSE, NULL);
     wait_handles[0] = completed_req_event;
     wait_handles[1] = abandon_req_wait;
     completed_hw = 0;
-    if ( !(completed_table_sema = CreateSemaphore (NULL, MAX_REQUESTS, MAX_REQUESTS, NULL)) ) {
-	DWORD rc = GetLastError();
-	fprintf(stderr, "startupAsyncIO: CreateSemaphore failed 0x%x\n", (int)rc);
-	fflush(stderr);
+    if ( !(completed_table_sema = CreateSemaphore(NULL, MAX_REQUESTS,
+                                                  MAX_REQUESTS, NULL)) ) {
+        DWORD rc = GetLastError();
+        fprintf(stderr, "startupAsyncIO: CreateSemaphore failed 0x%x\n",
+                (int)rc);
+        fflush(stderr);
     }
 
     return ( completed_req_event  != INVALID_HANDLE_VALUE &&
-	     abandon_req_wait     != INVALID_HANDLE_VALUE &&
-	     completed_table_sema != NULL );
+             abandon_req_wait     != INVALID_HANDLE_VALUE &&
+             completed_table_sema != NULL );
 }
 
 void
@@ -178,15 +186,15 @@ shutdownAsyncIO(rtsBool wait_threads)
     ShutdownIOManager(wait_threads);
     if (completed_req_event != INVALID_HANDLE_VALUE) {
         CloseHandle(completed_req_event);
-	completed_req_event = INVALID_HANDLE_VALUE;
+        completed_req_event = INVALID_HANDLE_VALUE;
     }
     if (abandon_req_wait != INVALID_HANDLE_VALUE) {
         CloseHandle(abandon_req_wait);
-	abandon_req_wait = INVALID_HANDLE_VALUE;
+        abandon_req_wait = INVALID_HANDLE_VALUE;
     }
     if (completed_table_sema != NULL) {
         CloseHandle(completed_table_sema);
-	completed_table_sema = NULL;
+        completed_table_sema = NULL;
     }
     DeleteCriticalSection(&queue_lock);
 }
@@ -196,15 +204,15 @@ shutdownAsyncIO(rtsBool wait_threads)
  *
  * Check for the completion of external IO work requests. Worker
  * threads signal completion of IO requests by depositing them
- * in a table (completedTable). awaitRequests() matches up 
- * requests in that table with threads on the blocked_queue, 
+ * in a table (completedTable). awaitRequests() matches up
+ * requests in that table with threads on the blocked_queue,
  * making the threads whose IO requests have completed runnable
  * again.
- * 
+ *
  * awaitRequests() is called by the scheduler periodically _or_ if
  * it is out of work, and need to wait for the completion of IO
- * requests to make further progress. In the latter scenario, 
- * awaitRequests() will simply block waiting for worker threads 
+ * requests to make further progress. In the latter scenario,
+ * awaitRequests() will simply block waiting for worker threads
  * to complete if the 'completedTable' is empty.
  */
 int
@@ -215,120 +223,128 @@ awaitRequests(rtsBool wait)
 
 start:
 #if 0
-    fprintf(stderr, "awaitRequests(): %d %d %d\n", issued_reqs, completed_hw, wait);
+    fprintf(stderr, "awaitRequests(): %d %d %d\n",
+            issued_reqs, completed_hw, wait);
     fflush(stderr);
 #endif
     EnterCriticalSection(&queue_lock);
-    /* Nothing immediately available & we won't wait */
+    // Nothing immediately available & we won't wait
     if ((!wait && completed_hw == 0)
 #if 0
-	// If we just return when wait==rtsFalse, we'll go into a busy
-	// wait loop, so I disabled this condition --SDM 18/12/2003
-	(issued_reqs == 0 && completed_hw == 0)
+        // If we just return when wait==rtsFalse, we'll go into a busy
+        // wait loop, so I disabled this condition --SDM 18/12/2003
+        (issued_reqs == 0 && completed_hw == 0)
 #endif
-	) {
-	LeaveCriticalSection(&queue_lock);
-	return 0;
+        ) {
+        LeaveCriticalSection(&queue_lock);
+        return 0;
     }
     if (completed_hw == 0) {
-	/* empty table, drop lock and wait */
-	LeaveCriticalSection(&queue_lock);
-	if ( wait && sched_state == SCHED_RUNNING ) {
-	    DWORD dwRes = WaitForMultipleObjects(2, wait_handles, FALSE, INFINITE);
-	    switch (dwRes) {
-	    case WAIT_OBJECT_0:
-		/* a request was completed */
-		break;
-	    case WAIT_OBJECT_0 + 1:
-	    case WAIT_TIMEOUT:
-		/* timeout (unlikely) or told to abandon waiting */
-		return 0;
-	    case WAIT_FAILED: {
-		DWORD dw = GetLastError();
-		fprintf(stderr, "awaitRequests: wait failed -- error code: %lu\n", dw); fflush(stderr);
-		return 0;
-	    }
-	    default:
-		fprintf(stderr, "awaitRequests: unexpected wait return code %lu\n", dwRes); fflush(stderr);
-		return 0;
-	    }
-	} else {
-	    return 0;
-	}
-	goto start;
+        // empty table, drop lock and wait
+        LeaveCriticalSection(&queue_lock);
+        if ( wait && sched_state == SCHED_RUNNING ) {
+            DWORD dwRes = WaitForMultipleObjects(2, wait_handles,
+                                                 FALSE, INFINITE);
+            switch (dwRes) {
+            case WAIT_OBJECT_0:
+                // a request was completed
+                break;
+            case WAIT_OBJECT_0 + 1:
+            case WAIT_TIMEOUT:
+                // timeout (unlikely) or told to abandon waiting
+                return 0;
+            case WAIT_FAILED: {
+                DWORD dw = GetLastError();
+                fprintf(stderr, "awaitRequests: wait failed -- "
+                                "error code: %lu\n", dw); fflush(stderr);
+                return 0;
+            }
+            default:
+                fprintf(stderr, "awaitRequests: unexpected wait return "
+                                "code %lu\n", dwRes); fflush(stderr);
+                return 0;
+            }
+        } else {
+            return 0;
+        }
+        goto start;
     } else {
-	int i;
-	StgTSO *tso, *prev;
-	
-	for (i=0; i < completed_hw; i++) {
-	    /* For each of the completed requests, match up their Ids
-	     * with those of the threads on the blocked_queue. If the
-	     * thread that made the IO request has been subsequently
-	     * killed (and removed from blocked_queue), no match will
-	     * be found for that request Id. 
-	     *
-	     * i.e., killing a Haskell thread doesn't attempt to cancel
-	     * the IO request it is blocked on.
-	     *
-	     */
-	    unsigned int rID = completedTable[i].reqID;
-	    
-	    prev = NULL;
-	    for(tso = blocked_queue_hd ; tso != END_TSO_QUEUE; tso = tso->_link) {
-	
+        int i;
+        StgTSO *tso, *prev;
+
+        for (i=0; i < completed_hw; i++) {
+            /* For each of the completed requests, match up their Ids
+             * with those of the threads on the blocked_queue. If the
+             * thread that made the IO request has been subsequently
+             * killed (and removed from blocked_queue), no match will
+             * be found for that request Id.
+             *
+             * i.e., killing a Haskell thread doesn't attempt to cancel
+             * the IO request it is blocked on.
+             *
+             */
+            unsigned int rID = completedTable[i].reqID;
+
+            prev = NULL;
+            for(tso = blocked_queue_hd; tso != END_TSO_QUEUE;
+                  tso = tso->_link) {
+
                 switch(tso->why_blocked) {
-		case BlockedOnRead:
-		case BlockedOnWrite:
-		case BlockedOnDoProc:
-		    if (tso->block_info.async_result->reqID == rID) {
-			/* Found the thread blocked waiting on request; stodgily fill 
-			 * in its result block. 
-			 */
-			tso->block_info.async_result->len = completedTable[i].len;
-			tso->block_info.async_result->errCode = completedTable[i].errCode;
-			
-			/* Drop the matched TSO from blocked_queue */
-			if (prev) {
-			    setTSOLink(&MainCapability, prev, tso->_link);
-			} else {
-			    blocked_queue_hd = tso->_link;
-			}
-			if (blocked_queue_tl == tso) {
-			    blocked_queue_tl = prev ? prev : END_TSO_QUEUE;
-			}
-		    
-			/* Terminates the run queue + this inner for-loop. */
-			tso->_link = END_TSO_QUEUE;
-			tso->why_blocked = NotBlocked;
+                case BlockedOnRead:
+                case BlockedOnWrite:
+                case BlockedOnDoProc:
+                    if (tso->block_info.async_result->reqID == rID) {
+                        // Found the thread blocked waiting on request;
+                        // stodgily fill
+                        // in its result block.
+                        tso->block_info.async_result->len =
+                          completedTable[i].len;
+                        tso->block_info.async_result->errCode =
+                          completedTable[i].errCode;
+
+                        // Drop the matched TSO from blocked_queue
+                        if (prev) {
+                            setTSOLink(&MainCapability, prev, tso->_link);
+                        } else {
+                            blocked_queue_hd = tso->_link;
+                        }
+                        if (blocked_queue_tl == tso) {
+                            blocked_queue_tl = prev ? prev : END_TSO_QUEUE;
+                        }
+
+                        // Terminates the run queue + this inner for-loop.
+                        tso->_link = END_TSO_QUEUE;
+                        tso->why_blocked = NotBlocked;
                         // save the StgAsyncIOResult in the
                         // stg_block_async_info stack frame, because
                         // the block_info field will be overwritten by
                         // pushOnRunQueue().
                         tso->stackobj->sp[1] = (W_)tso->block_info.async_result;
-			pushOnRunQueue(&MainCapability, tso);
-			break;
-		    }
-		    break;
-		default:
-		    if (tso->why_blocked != NotBlocked) {
-			barf("awaitRequests: odd thread state");
-		    }
-		    break;
-		}
+                        pushOnRunQueue(&MainCapability, tso);
+                        break;
+                    }
+                    break;
+                default:
+                    if (tso->why_blocked != NotBlocked) {
+                        barf("awaitRequests: odd thread state");
+                    }
+                    break;
+                }
 
                 prev = tso;
-	    }
-	    /* Signal that there's completed table slots available */
-	    if ( !ReleaseSemaphore(completed_table_sema, 1, NULL) ) {
-		DWORD dw = GetLastError();
-		fprintf(stderr, "awaitRequests: failed to signal semaphore (error code=0x%x)\n", (int)dw);
-		fflush(stderr);
-	    }
-	}
-	completed_hw = 0;
-	ResetEvent(completed_req_event);
-	LeaveCriticalSection(&queue_lock);
-	return 1;
+            }
+            /* Signal that there's completed table slots available */
+            if ( !ReleaseSemaphore(completed_table_sema, 1, NULL) ) {
+                DWORD dw = GetLastError();
+                fprintf(stderr, "awaitRequests: failed to signal semaphore "
+                                "(error code=0x%x)\n", (int)dw);
+                fflush(stderr);
+            }
+        }
+        completed_hw = 0;
+        ResetEvent(completed_req_event);
+        LeaveCriticalSection(&queue_lock);
+        return 1;
     }
 #endif /* !THREADED_RTS */
 }
@@ -365,3 +381,11 @@ resetAbandonRequestWait( void )
 }
 
 #endif /* !defined(THREADED_RTS) */
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/win32/AsyncIO.h b/rts/win32/AsyncIO.h
index 8d99c0acdec8..ee3178d078cb 100644
--- a/rts/win32/AsyncIO.h
+++ b/rts/win32/AsyncIO.h
@@ -10,10 +10,10 @@
 
 extern unsigned int
 addIORequest(int   fd,
-	     int   forWriting,
-	     int   isSock,
-	     int   len,
-	     char* buf);
+             int   forWriting,
+             int   isSock,
+             int   len,
+             char* buf);
 extern unsigned int addDelayRequest(int   usecs);
 extern unsigned int addDoProcRequest(void* proc, void* param);
 extern int  startupAsyncIO(void);
@@ -25,3 +25,11 @@ extern void abandonRequestWait(void);
 extern void resetAbandonRequestWait(void);
 
 #endif /* WIN32_ASYNCHIO_H */
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/win32/AwaitEvent.c b/rts/win32/AwaitEvent.c
index af9c658e021b..eb254d981dc9 100644
--- a/rts/win32/AwaitEvent.c
+++ b/rts/win32/AwaitEvent.c
@@ -8,7 +8,7 @@
  * If the Scheduler is otherwise out of work, it'll block
  * herein waiting for external events to occur.
  *
- * This file mirrors the select()-based functionality 
+ * This file mirrors the select()-based functionality
  * for POSIX / Unix platforms in rts/Select.c, but for
  * Win32.
  *
@@ -50,8 +50,16 @@ awaitEvent(rtsBool wait)
     //  - the run-queue is now non- empty
 
   } while (wait
-	   && sched_state == SCHED_RUNNING
-	   && emptyRunQueue(&MainCapability)
+           && sched_state == SCHED_RUNNING
+           && emptyRunQueue(&MainCapability)
       );
 }
 #endif
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/win32/ConsoleHandler.c b/rts/win32/ConsoleHandler.c
index 19057a3d8d5c..c72a11230fb6 100644
--- a/rts/win32/ConsoleHandler.c
+++ b/rts/win32/ConsoleHandler.c
@@ -40,11 +40,11 @@ initUserSignals(void)
 #if !defined (THREADED_RTS)
     stg_pending_events = 0;
     if (hConsoleEvent == INVALID_HANDLE_VALUE) {
-	hConsoleEvent = 
-	    CreateEvent ( NULL,  /* default security attributes */
-			  TRUE,  /* manual-reset event */
-			  FALSE, /* initially non-signalled */
-			  NULL); /* no name */
+        hConsoleEvent =
+            CreateEvent ( NULL,  /* default security attributes */
+                          TRUE,  /* manual-reset event */
+                          FALSE, /* initially non-signalled */
+                          NULL); /* no name */
     }
 #endif
     return;
@@ -75,31 +75,31 @@ finiUserSignals(void)
  * To repeat Signals.c remark -- user code may choose to override the
  * default handler. Which is fine, assuming they put back the default
  * handler when/if they de-install the custom handler.
- * 
+ *
  */
 static BOOL WINAPI shutdown_handler(DWORD dwCtrlType)
 {
     switch (dwCtrlType) {
-    
+
     case CTRL_CLOSE_EVENT:
-	/* see generic_handler() comment re: this event */
-	return FALSE;
+        /* see generic_handler() comment re: this event */
+        return FALSE;
     case CTRL_C_EVENT:
     case CTRL_BREAK_EVENT:
 
-	// If we're already trying to interrupt the RTS, terminate with
-	// extreme prejudice.  So the first ^C tries to exit the program
-	// cleanly, and the second one just kills it.
-	if (sched_state >= SCHED_INTERRUPTING) {
-	    stg_exit(EXIT_INTERRUPTED);
-	} else {
-	    interruptStgRts();
-	}
-	return TRUE;
-
-	/* shutdown + logoff events are not handled here. */
+        // If we're already trying to interrupt the RTS, terminate with
+        // extreme prejudice.  So the first ^C tries to exit the program
+        // cleanly, and the second one just kills it.
+        if (sched_state >= SCHED_INTERRUPTING) {
+            stg_exit(EXIT_INTERRUPTED);
+        } else {
+            interruptStgRts();
+        }
+        return TRUE;
+
+        /* shutdown + logoff events are not handled here. */
     default:
-	return FALSE;
+        return FALSE;
     }
 }
 
@@ -113,14 +113,14 @@ static BOOL WINAPI shutdown_handler(DWORD dwCtrlType)
 void initDefaultHandlers(void)
 {
     if ( !SetConsoleCtrlHandler(shutdown_handler, TRUE) ) {
-	errorBelch("warning: failed to install default console handler");
+        errorBelch("warning: failed to install default console handler");
     }
 }
 
 void resetDefaultHandlers(void)
 {
     if ( !SetConsoleCtrlHandler(shutdown_handler, FALSE) ) {
-	errorBelch("warning: failed to uninstall default console handler");
+        errorBelch("warning: failed to uninstall default console handler");
     }
 }
 
@@ -130,7 +130,7 @@ void resetDefaultHandlers(void)
  * Temporarily block the delivery of further console events. Needed to
  * avoid race conditions when GCing the stack of outstanding handlers or
  * when emptying the stack by running the handlers.
- * 
+ *
  */
 void
 blockUserSignals(void)
@@ -174,24 +174,24 @@ void startSignalHandlers(Capability *cap)
     StgStablePtr handler;
 
     if (console_handler < 0) {
-	return;
+        return;
     }
 
     blockUserSignals();
     ACQUIRE_LOCK(&sched_mutex);
-    
+
     handler = deRefStablePtr((StgStablePtr)console_handler);
     while (stg_pending_events > 0) {
-	stg_pending_events--;
-	scheduleThread(cap,
-	    createIOThread(cap,
-			   RtsFlags.GcFlags.initialStkSize, 
-			   rts_apply(cap,
-				     (StgClosure *)handler,
-				     rts_mkInt(cap,
-					       stg_pending_buf[stg_pending_events]))));
+        stg_pending_events--;
+        scheduleThread(cap,
+            createIOThread(cap,
+                RtsFlags.GcFlags.initialStkSize,
+                rts_apply(cap,
+                    (StgClosure *)handler,
+                    rts_mkInt(cap,
+                        stg_pending_buf[stg_pending_events]))));
     }
-    
+
     RELEASE_LOCK(&sched_mutex);
     unblockUserSignals();
 }
@@ -210,39 +210,39 @@ void markSignalHandlers (evac_fn evac STG_UNUSED, void *user STG_UNUSED)
 }
 
 
-/* 
+/*
  * Function: generic_handler()
  *
- * Local function which handles incoming console event (done in a sep OS thread),
- * recording the event in stg_pending_events. 
+ * Local function which handles incoming console event (done in a separate
+ * OS thread), recording the event in stg_pending_events.
  */
 static BOOL WINAPI generic_handler(DWORD dwCtrlType)
 {
     /* Ultra-simple -- up the counter + signal a switch. */
     switch(dwCtrlType) {
     case CTRL_CLOSE_EVENT:
-	/* Don't support the delivery of this event; if we
-	 * indicate that we've handled it here and the Haskell handler
-	 * doesn't take proper action (e.g., terminate the OS process),
-	 * the user of the app will be unable to kill/close it. Not
-	 * good, so disable the delivery for now.
-	 */
-	return FALSE;
+        /* Don't support the delivery of this event; if we
+         * indicate that we've handled it here and the Haskell handler
+         * doesn't take proper action (e.g., terminate the OS process),
+         * the user of the app will be unable to kill/close it. Not
+         * good, so disable the delivery for now.
+         */
+        return FALSE;
     default:
-	if (!deliver_event) return TRUE;
+        if (!deliver_event) return TRUE;
 
 #if defined(THREADED_RTS)
         sendIOManagerEvent((StgWord8) ((dwCtrlType<<1) | 1));
 #else
-	if ( stg_pending_events < N_PENDING_EVENTS ) {
-	    stg_pending_buf[stg_pending_events] = dwCtrlType;
-	    stg_pending_events++;
-	}
+        if ( stg_pending_events < N_PENDING_EVENTS ) {
+            stg_pending_buf[stg_pending_events] = dwCtrlType;
+            stg_pending_events++;
+        }
 
         // we need to wake up awaitEvent()
         abandonRequestWait();
 #endif
-	return TRUE;
+        return TRUE;
     }
 }
 
@@ -259,42 +259,43 @@ rts_InstallConsoleEvent(int action, StgStablePtr *handler)
 
     switch (action) {
     case STG_SIG_IGN:
-	console_handler = STG_SIG_IGN;
-	if ( !SetConsoleCtrlHandler(NULL, TRUE) ) {
-	    errorBelch("warning: unable to ignore console events");
-	}
-	break;
+        console_handler = STG_SIG_IGN;
+        if ( !SetConsoleCtrlHandler(NULL, TRUE) ) {
+            errorBelch("warning: unable to ignore console events");
+        }
+        break;
     case STG_SIG_DFL:
-	console_handler = STG_SIG_IGN;
-	if ( !SetConsoleCtrlHandler(NULL, FALSE) ) {
-	    errorBelch("warning: unable to restore default console event handling");
-	}
-	break;
+        console_handler = STG_SIG_IGN;
+        if ( !SetConsoleCtrlHandler(NULL, FALSE) ) {
+            errorBelch("warning: unable to restore default console event "
+                       "handling");
+        }
+        break;
     case STG_SIG_HAN:
 #ifdef THREADED_RTS
         // handler is stored in an MVar in the threaded RTS
-	console_handler = STG_SIG_HAN;
+        console_handler = STG_SIG_HAN;
 #else
-	console_handler = (StgInt)*handler;
+        console_handler = (StgInt)*handler;
 #endif
-	if (previous_hdlr < 0 || previous_hdlr == STG_SIG_HAN) {
-	  /* Only install generic_handler() once */
-	  if ( !SetConsoleCtrlHandler(generic_handler, TRUE) ) {
-	    errorBelch("warning: unable to install console event handler");
-	  }
-	}
-	break;
+        if (previous_hdlr < 0 || previous_hdlr == STG_SIG_HAN) {
+          /* Only install generic_handler() once */
+          if ( !SetConsoleCtrlHandler(generic_handler, TRUE) ) {
+            errorBelch("warning: unable to install console event handler");
+          }
+        }
+        break;
     }
-    
-    if (previous_hdlr == STG_SIG_DFL || 
-	previous_hdlr == STG_SIG_IGN ||
+
+    if (previous_hdlr == STG_SIG_DFL ||
+        previous_hdlr == STG_SIG_IGN ||
         previous_hdlr == STG_SIG_HAN) {
-	return previous_hdlr;
+        return previous_hdlr;
     } else {
-	if (handler != NULL) {
+        if (handler != NULL) {
             *handler = (StgStablePtr)previous_hdlr;
         }
-	return STG_SIG_HAN;
+        return STG_SIG_HAN;
     }
 }
 
@@ -302,18 +303,18 @@ rts_InstallConsoleEvent(int action, StgStablePtr *handler)
  * Function: rts_HandledConsoleEvent()
  *
  * Signal that a Haskell console event handler has completed its run.
- * The explicit notification that a Haskell handler has completed is 
+ * The explicit notification that a Haskell handler has completed is
  * required to better handle the delivery of Ctrl-C/Break events whilst
- * an async worker thread is handling a read request on stdin. The 
+ * an async worker thread is handling a read request on stdin. The
  * Win32 console implementation will abort such a read request when Ctrl-C
- * is delivered. That leaves the worker thread in a bind: should it 
- * abandon the request (the Haskell thread reading from stdin has been 
- * thrown an exception to signal the delivery of Ctrl-C & hence have 
+ * is delivered. That leaves the worker thread in a bind: should it
+ * abandon the request (the Haskell thread reading from stdin has been
+ * thrown an exception to signal the delivery of Ctrl-C & hence have
  * aborted the I/O request) or simply ignore the aborted read and retry?
  * (the Haskell thread reading from stdin isn't concerned with the
  * delivery and handling of Ctrl-C.) With both scenarios being
  * possible, the worker thread needs to be told -- that is, did the
- * console event handler cause the IO request to be abandoned? 
+ * console event handler cause the IO request to be abandoned?
  *
  */
 void
@@ -321,11 +322,11 @@ rts_ConsoleHandlerDone (int ev USED_IF_NOT_THREADS)
 {
 #if !defined(THREADED_RTS)
     if ( (DWORD)ev == CTRL_BREAK_EVENT ||
-	 (DWORD)ev == CTRL_C_EVENT ) {
-	/* only these two cause stdin system calls to abort.. */
-	SetEvent(hConsoleEvent); /* event is manual-reset */
-	Sleep(0); /* yield */
-	ResetEvent(hConsoleEvent); /* turn it back off again */
+         (DWORD)ev == CTRL_C_EVENT ) {
+        /* only these two cause stdin system calls to abort.. */
+        SetEvent(hConsoleEvent); /* event is manual-reset */
+        Sleep(0); /* yield */
+        ResetEvent(hConsoleEvent); /* turn it back off again */
         // SDM: yeuch, this can't possibly work reliably.
         // I'm not having it in THREADED_RTS.
     }
@@ -348,3 +349,11 @@ rts_waitConsoleHandlerCompletion()
     return (WaitForSingleObject(hConsoleEvent, INFINITE) == WAIT_OBJECT_0);
 }
 #endif
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/win32/ConsoleHandler.h b/rts/win32/ConsoleHandler.h
index 0d09a67b94f8..f9bb6568c3e1 100644
--- a/rts/win32/ConsoleHandler.h
+++ b/rts/win32/ConsoleHandler.h
@@ -62,3 +62,11 @@ extern int rts_waitConsoleHandlerCompletion(void);
 #endif /* THREADED_RTS */
 
 #endif /* Win32_CONSOLEHANDLER_H */
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/win32/GetEnv.c b/rts/win32/GetEnv.c
index c4720961d3aa..7bcfe4a12b5e 100644
--- a/rts/win32/GetEnv.c
+++ b/rts/win32/GetEnv.c
@@ -18,7 +18,7 @@
  *   Var1=Value1\0
  *   Var2=Value2\0
  *   ...
- *   VarN=ValueN\0\0 
+ *   VarN=ValueN\0\0
  * But because everyone else (ie POSIX) uses a vector of strings, we convert
  * to that format. Fortunately this is just a matter of making an array of
  * offsets into the environment block.
@@ -60,3 +60,11 @@ void freeProgEnvv(int envc, char *envv[]) {
     FreeEnvironmentStringsA(envv[envc]);
     stgFree(envv);
 }
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/win32/GetTime.c b/rts/win32/GetTime.c
index bfab43a9cce9..0af0306b54c5 100644
--- a/rts/win32/GetTime.c
+++ b/rts/win32/GetTime.c
@@ -25,7 +25,7 @@ fileTimeToRtsTime(FILETIME ft)
     t = NSToTime(t * 100);
     /* FILETIMES are in units of 100ns */
     return t;
-}    
+}
 
 void
 getProcessTimes(Time *user, Time *elapsed)
@@ -40,8 +40,8 @@ getProcessCPUTime(void)
     FILETIME creationTime, exitTime, userTime, kernelTime = {0,0};
 
     if (!GetProcessTimes(GetCurrentProcess(), &creationTime,
-			 &exitTime, &kernelTime, &userTime)) {
-	return 0;
+                         &exitTime, &kernelTime, &userTime)) {
+        return 0;
     }
 
     return fileTimeToRtsTime(userTime);
@@ -106,8 +106,8 @@ getThreadCPUTime(void)
     FILETIME creationTime, exitTime, userTime, kernelTime = {0,0};
 
     if (!GetThreadTimes(GetCurrentThread(), &creationTime,
-			&exitTime, &kernelTime, &userTime)) {
-	return 0;
+                        &exitTime, &kernelTime, &userTime)) {
+        return 0;
     }
 
     return fileTimeToRtsTime(userTime);
@@ -136,16 +136,16 @@ getUnixEpochTime(StgWord64 *sec, StgWord32 *nsec)
        ULARGE_INTEGER struct which is a handy union type */
     unixtime.LowPart  = filetime.dwLowDateTime;
     unixtime.HighPart = filetime.dwHighDateTime;
-    
+
     /* We have to do an epoch conversion, since FILETIME uses 1601
        while we want unix epoch of 1970. In case you were wondering,
        there were 11,644,473,600 seconds between 1601 and 1970, then
        multiply by 10^7 for units of 100 nanoseconds. */
     unixtime.QuadPart = unixtime.QuadPart - 116444736000000000ull;
-    
+
     /* For the seconds part we use integer division by 10^7 */
     *sec  = unixtime.QuadPart / 10000000ull;
-    
+
     /* The remainder from integer division by 10^7 gives us
        the sub-second component in units of 100 nanoseconds.
        So for nanoseconds we just multiply by 100.
@@ -160,3 +160,11 @@ getPageFaults(void)
      that's stored in the registry. */
     return 0;
 }
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/win32/IOManager.c b/rts/win32/IOManager.c
index 0091f23b3c83..2427687136c9 100644
--- a/rts/win32/IOManager.c
+++ b/rts/win32/IOManager.c
@@ -60,130 +60,150 @@ IOWorkerProc(PVOID param)
 
     hWaits[0] = (HANDLE)iom->hExitEvent;
     hWaits[1] = GetWorkQueueHandle(pq);
-  
+
     while (1) {
-	/* The error code is communicated back on completion of request; reset. */
-	errCode = 0;
-	
-	EnterCriticalSection(&iom->manLock);
-	/* Signal that the worker is idle.
-	 *
-	 * 'workersIdle' is used when determining whether or not to
-	 * increase the worker thread pool when adding a new request.
-	 * (see addIORequest().)
-	 */
-	iom->workersIdle++;
-	LeaveCriticalSection(&iom->manLock);
-	
-	/*
-	 * A possible future refinement is to make long-term idle threads
-	 * wake up and decide to shut down should the number of idle threads
-	 * be above some threshold.
-	 *
-	 */
-	rc = WaitForMultipleObjects( 2, hWaits, FALSE, INFINITE );
-
-	if (rc == WAIT_OBJECT_0) {
-	    // we received the exit event
-	    EnterCriticalSection(&iom->manLock);
-	    ioMan->numWorkers--;
-	    LeaveCriticalSection(&iom->manLock);
-	    return 0;
-	}
-
-	EnterCriticalSection(&iom->manLock);
-	/* Signal that the thread is 'non-idle' and about to consume 
-	 * a work item.
-	 */
-	iom->workersIdle--;
-	iom->queueSize--;
-	LeaveCriticalSection(&iom->manLock);
-    
-	if ( rc == (WAIT_OBJECT_0 + 1) ) {
-	    /* work item available, fetch it. */
-	    if (FetchWork(pq,(void**)&work)) {
-		work->abandonOp = 0;
-		RegisterWorkItem(iom,work);
-		if ( work->workKind & WORKER_READ ) {
-		    if ( work->workKind & WORKER_FOR_SOCKET ) {
-			len = recv(work->workData.ioData.fd, 
-				   work->workData.ioData.buf,
-				   work->workData.ioData.len,
-				   0);
-			if (len == SOCKET_ERROR) {
-			    errCode = WSAGetLastError();
-			}
-		    } else {
-			while (1) {
-			/* Do the read(), with extra-special handling for Ctrl+C */
-			len = read(work->workData.ioData.fd,
-				   work->workData.ioData.buf,
-				   work->workData.ioData.len);
-			if ( len == 0 && work->workData.ioData.len != 0 ) {
-			    /* Given the following scenario:
-			     *     - a console handler has been registered that handles Ctrl+C
-			     *       events.
-			     *     - we've not tweaked the 'console mode' settings to turn on
-			     *       ENABLE_PROCESSED_INPUT.
-			     *     - we're blocked waiting on input from standard input.
-			     *     - the user hits Ctrl+C.
-			     *
-			     * The OS will invoke the console handler (in a separate OS thread),
-			     * and the above read() (i.e., under the hood, a ReadFile() op) returns
-			     * 0, with the error set to ERROR_OPERATION_ABORTED. We don't
-			     * want to percolate this error condition back to the Haskell user.
-			     * Do this by waiting for the completion of the Haskell console handler.
-			     * If upon completion of the console handler routine, the Haskell thread 
-			     * that issued the request is found to have been thrown an exception, 
-			     * the worker abandons the request (since that's what the Haskell thread 
-			     * has done.) If the Haskell thread hasn't been interrupted, the worker 
-			     * retries the read request as if nothing happened.
-			     */
-			    if ( (GetLastError()) == ERROR_OPERATION_ABORTED ) {
-				/* For now, only abort when dealing with the standard input handle.
-				 * i.e., for all others, an error is raised.
-				 */
-				HANDLE h  = (HANDLE)GetStdHandle(STD_INPUT_HANDLE);
-				if ( _get_osfhandle(work->workData.ioData.fd) == (intptr_t)h ) {
-				    if (rts_waitConsoleHandlerCompletion()) {
-					/* If the Scheduler has set work->abandonOp, the Haskell thread has 
-					 * been thrown an exception (=> the worker must abandon this request.)
-					 * We test for this below before invoking the on-completion routine.
-					 */
-					if (work->abandonOp) {
-					    break;
-					} else {
-					    continue;
-					}
-				    } 
-				} else { 
-				    break; /* Treat it like an error */
-				}
-			    } else {
-				break;
-			    }
-			} else {
-			    break;
-			}
-			}
-			if (len == -1) { errCode = errno; }
-		    }
-		    complData = work->workData.ioData.buf;
-		    fd = work->workData.ioData.fd;
-		} else if ( work->workKind & WORKER_WRITE ) {
-		    if ( work->workKind & WORKER_FOR_SOCKET ) {
-			len = send(work->workData.ioData.fd,
-				   work->workData.ioData.buf,
-				   work->workData.ioData.len,
-				   0);
-			if (len == SOCKET_ERROR) {
-			    errCode = WSAGetLastError();
-			}
-		    } else {
-			len = write(work->workData.ioData.fd,
-				    work->workData.ioData.buf,
-				    work->workData.ioData.len);
-			if (len == -1) {
+        // The error code is communicated back on completion of request; reset.
+        errCode = 0;
+
+        EnterCriticalSection(&iom->manLock);
+        /* Signal that the worker is idle.
+         *
+         * 'workersIdle' is used when determining whether or not to
+         * increase the worker thread pool when adding a new request.
+         * (see addIORequest().)
+         */
+        iom->workersIdle++;
+        LeaveCriticalSection(&iom->manLock);
+
+        /*
+         * A possible future refinement is to make long-term idle threads
+         * wake up and decide to shut down should the number of idle threads
+         * be above some threshold.
+         *
+         */
+        rc = WaitForMultipleObjects( 2, hWaits, FALSE, INFINITE );
+
+        if (rc == WAIT_OBJECT_0) {
+            // we received the exit event
+            EnterCriticalSection(&iom->manLock);
+            ioMan->numWorkers--;
+            LeaveCriticalSection(&iom->manLock);
+            return 0;
+        }
+
+        EnterCriticalSection(&iom->manLock);
+        /* Signal that the thread is 'non-idle' and about to consume
+         * a work item.
+         */
+        iom->workersIdle--;
+        iom->queueSize--;
+        LeaveCriticalSection(&iom->manLock);
+
+        if ( rc == (WAIT_OBJECT_0 + 1) ) {
+            /* work item available, fetch it. */
+            if (FetchWork(pq,(void**)&work)) {
+                work->abandonOp = 0;
+                RegisterWorkItem(iom,work);
+                if ( work->workKind & WORKER_READ ) {
+                    if ( work->workKind & WORKER_FOR_SOCKET ) {
+                        len = recv(work->workData.ioData.fd,
+                                   work->workData.ioData.buf,
+                                   work->workData.ioData.len,
+                                   0);
+                        if (len == SOCKET_ERROR) {
+                            errCode = WSAGetLastError();
+                        }
+                    } else {
+                        while (1) {
+                        // Do the read(), with extra-special handling for Ctrl+C
+                        len = read(work->workData.ioData.fd,
+                                   work->workData.ioData.buf,
+                                   work->workData.ioData.len);
+                        if ( len == 0 && work->workData.ioData.len != 0 ) {
+                            /* Given the following scenario:
+                             * - a console handler has been registered
+                             *   that handles Ctrl+C events.
+                             * - we've not tweaked the 'console mode'
+                             *   settings to turn on
+                             *   ENABLE_PROCESSED_INPUT.
+                             * - we're blocked waiting on input from
+                                 standard input.
+                             * - the user hits Ctrl+C.
+                             *
+                             * The OS will invoke the console handler
+                             * (in a separate OS thread), and the
+                             * above read() (i.e., under the hood, a
+                             * ReadFile() op) returns 0, with the
+                             * error set to
+                             * ERROR_OPERATION_ABORTED. We don't want
+                             * to percolate this error condition back
+                             * to the Haskell user.  Do this by
+                             * waiting for the completion of the
+                             * Haskell console handler. If upon
+                             * completion of the console handler
+                             * routine, the Haskell thread that issued
+                             * the request is found to have been
+                             * thrown an exception, the worker
+                             * abandons the request (since that's what
+                             * the Haskell thread has done.) If the
+                             * Haskell thread hasn't been interrupted,
+                             * the worker retries the read request as
+                             * if nothing happened.
+                             */
+                            if ( (GetLastError()) == ERROR_OPERATION_ABORTED ) {
+                                /* For now, only abort when dealing
+                                 * with the standard input handle.
+                                 * i.e., for all others, an error is
+                                 * raised.
+                                 */
+                                HANDLE h =
+                                    (HANDLE)GetStdHandle(STD_INPUT_HANDLE);
+                                int iofd = work->workData.ioData.fd;
+                                if ( _get_osfhandle(iofd) == (intptr_t)h ) {
+                                    if (rts_waitConsoleHandlerCompletion()) {
+                                        /* If the Scheduler has set
+                                         * work->abandonOp, the
+                                         * Haskell thread has been
+                                         * thrown an exception (=> the
+                                         * worker must abandon this
+                                         * request.)  We test for this
+                                         * below before invoking the
+                                         * on-completion routine.
+                                         */
+                                        if (work->abandonOp) {
+                                            break;
+                                        } else {
+                                            continue;
+                                        }
+                                    }
+                                } else {
+                                    break; /* Treat it like an error */
+                                }
+                            } else {
+                                break;
+                            }
+                        } else {
+                            break;
+                        }
+                        }
+                        if (len == -1) { errCode = errno; }
+                    }
+                    complData = work->workData.ioData.buf;
+                    fd = work->workData.ioData.fd;
+                } else if ( work->workKind & WORKER_WRITE ) {
+                    if ( work->workKind & WORKER_FOR_SOCKET ) {
+                        len = send(work->workData.ioData.fd,
+                                   work->workData.ioData.buf,
+                                   work->workData.ioData.len,
+                                   0);
+                        if (len == SOCKET_ERROR) {
+                            errCode = WSAGetLastError();
+                        }
+                    } else {
+                        len = write(work->workData.ioData.fd,
+                                    work->workData.ioData.buf,
+                                    work->workData.ioData.len);
+                        if (len == -1) {
                             errCode = errno;
                             // write() gets errno wrong for
                             // ERROR_NO_DATA, we have to fix it here:
@@ -192,13 +212,13 @@ IOWorkerProc(PVOID param)
                                 errCode = EPIPE;
                             }
                         }
-		    }
-		    complData = work->workData.ioData.buf;
-		    fd = work->workData.ioData.fd;
-		} else if ( work->workKind & WORKER_DELAY ) {
-		    /* Approximate implementation of threadDelay;
-		     * 
-		     * Note: Sleep() is in milliseconds, not micros.
+                    }
+                    complData = work->workData.ioData.buf;
+                    fd = work->workData.ioData.fd;
+                } else if ( work->workKind & WORKER_DELAY ) {
+                    /* Approximate implementation of threadDelay;
+                     *
+                     * Note: Sleep() is in milliseconds, not micros.
                      *
                      * MSDN says of Sleep:
                      *   If dwMilliseconds is greater than one tick
@@ -210,66 +230,70 @@ IOWorkerProc(PVOID param)
                      *
                      * test ThreadDelay001 fails if we get this wrong.
                      */
-		    Sleep(((work->workData.delayData.usecs + 999) / 1000) + iom->sleepResolution - 1);
-		    len = work->workData.delayData.usecs;
-		    complData = NULL;
-		    fd = 0;
-		    errCode = 0;
-		} else if ( work->workKind & WORKER_DO_PROC ) {
-		    /* perform operation/proc on behalf of Haskell thread. */
-		    if (work->workData.procData.proc) {
-			/* The procedure is assumed to encode result + success/failure
-			 * via its param.
-			 */
-			errCode=work->workData.procData.proc(work->workData.procData.param);
-		    } else {
-			errCode=1;
-		    }
-		    complData = work->workData.procData.param;
-		} else {
-		    fprintf(stderr, "unknown work request type (%d) , ignoring.\n", work->workKind);
-		    fflush(stderr);
-		    continue;
-		}
-		if (!work->abandonOp) {
-		    work->onCompletion(work->requestID,
-				       fd,
-				       len,
-				       complData,
-				       errCode);
-		}
-		/* Free the WorkItem */
-		DeregisterWorkItem(iom,work);
-		free(work);
-	    } else {
-		fprintf(stderr, "unable to fetch work; fatal.\n"); fflush(stderr);
-		EnterCriticalSection(&iom->manLock);
-		ioMan->numWorkers--;
-		LeaveCriticalSection(&iom->manLock);
-		return 1;
-	    }
-	} else {
-	    fprintf(stderr, "waiting failed (%lu); fatal.\n", rc); fflush(stderr);
-	    EnterCriticalSection(&iom->manLock);
-	    ioMan->numWorkers--;
-	    LeaveCriticalSection(&iom->manLock);
-	    return 1;
-	}
+                    Sleep(((work->workData.delayData.usecs + 999) / 1000)
+                            + iom->sleepResolution - 1);
+                    len = work->workData.delayData.usecs;
+                    complData = NULL;
+                    fd = 0;
+                    errCode = 0;
+                } else if ( work->workKind & WORKER_DO_PROC ) {
+                    // perform operation/proc on behalf of Haskell thread.
+                    if (work->workData.procData.proc) {
+                        // The procedure is assumed to encode result +
+                        // success/failure via its param.
+                        void* param = work->workData.procData.param;
+                        errCode=work->workData.procData.proc(param);
+                    } else {
+                        errCode=1;
+                    }
+                    complData = work->workData.procData.param;
+                } else {
+                    fprintf(stderr, "unknown work request type (%d), "
+                                    "ignoring.\n", work->workKind);
+                    fflush(stderr);
+                    continue;
+                }
+                if (!work->abandonOp) {
+                    work->onCompletion(work->requestID,
+                                       fd,
+                                       len,
+                                       complData,
+                                       errCode);
+                }
+                // Free the WorkItem
+                DeregisterWorkItem(iom,work);
+                free(work);
+            } else {
+                fprintf(stderr, "unable to fetch work; fatal.\n");
+                fflush(stderr);
+                EnterCriticalSection(&iom->manLock);
+                ioMan->numWorkers--;
+                LeaveCriticalSection(&iom->manLock);
+                return 1;
+            }
+        } else {
+            fprintf(stderr, "waiting failed (%lu); fatal.\n", rc);
+            fflush(stderr);
+            EnterCriticalSection(&iom->manLock);
+            ioMan->numWorkers--;
+            LeaveCriticalSection(&iom->manLock);
+            return 1;
+        }
     }
     return 0;
 }
 
-static 
+static
 BOOL
 NewIOWorkerThread(IOManagerState* iom)
 {
     unsigned threadId;
     return ( 0 != _beginthreadex(NULL,
-				 0,
-				 IOWorkerProc,
-				 (LPVOID)iom,
-				 0,
-				 &threadId) );
+                                 0,
+                                 IOWorkerProc,
+                                 (LPVOID)iom,
+                                 0,
+                                 &threadId) );
 }
 
 BOOL
@@ -292,21 +316,21 @@ StartIOManager(void)
     }
 
     wq = NewWorkQueue();
-    if ( !wq ) return FALSE;  
-  
+    if ( !wq ) return FALSE;
+
     ioMan = (IOManagerState*)malloc(sizeof(IOManagerState));
-  
+
     if (!ioMan) {
-	FreeWorkQueue(wq);
-	return FALSE;
+        FreeWorkQueue(wq);
+        return FALSE;
     }
 
     /* A manual-reset event */
     hExit = CreateEvent ( NULL, TRUE, FALSE, NULL );
     if ( !hExit ) {
-	FreeWorkQueue(wq);
-	free(ioMan);
-	return FALSE;
+        FreeWorkQueue(wq);
+        free(ioMan);
+        return FALSE;
     }
 
     ioMan->hExitEvent = hExit;
@@ -319,7 +343,7 @@ StartIOManager(void)
     InitializeCriticalSection(&ioMan->active_work_lock);
     ioMan->active_work_items = NULL;
     ioMan->sleepResolution = sleepResolution;
- 
+
     return TRUE;
 }
 
@@ -334,63 +358,65 @@ StartIOManager(void)
 static
 int
 depositWorkItem( unsigned int reqID,
-		 WorkItem* wItem )
+                 WorkItem* wItem )
 {
     EnterCriticalSection(&ioMan->manLock);
 
 #if 0
-    fprintf(stderr, "depositWorkItem: %d/%d\n", ioMan->workersIdle, ioMan->numWorkers); 
+    fprintf(stderr, "depositWorkItem: %d/%d\n",
+            ioMan->workersIdle, ioMan->numWorkers);
     fflush(stderr);
 #endif
     /* A new worker thread is created when there are fewer idle threads
      * than non-consumed queue requests. This ensures that requests will
      * be dealt with in a timely manner.
      *
-     * [Long explanation of why the previous thread pool policy lead to 
+     * [Long explanation of why the previous thread pool policy lead to
      * trouble]
      *
      * Previously, the thread pool was augmented iff no idle worker threads
      * were available. That strategy runs the risk of repeatedly adding to
      * the request queue without expanding the thread pool to handle this
-     * sudden spike in queued requests. 
-     * [How? Assume workersIdle is 1, and addIORequest() is called. No new 
+     * sudden spike in queued requests.
+     * [How? Assume workersIdle is 1, and addIORequest() is called. No new
      * thread is created and the request is simply queued. If addIORequest()
      * is called again _before the OS schedules a worker thread to pull the
-     * request off the queue_, workersIdle is still 1 and another request is 
+     * request off the queue_, workersIdle is still 1 and another request is
      * simply added to the queue. Once the worker thread is run, only one
      * request is de-queued, leaving the 2nd request in the queue]
-     * 
-     * Assuming none of the queued requests take an inordinate amount of to 
-     * complete, the request queue would eventually be drained. But if that's 
-     * not the case, the later requests will end up languishing in the queue 
-     * indefinitely. The non-timely handling of requests may cause CH applications
-     * to misbehave / hang; bad.
+     *
+     * Assuming none of the queued requests take an inordinate amount
+     * of to complete, the request queue would eventually be
+     * drained. But if that's not the case, the later requests will
+     * end up languishing in the queue indefinitely. The non-timely
+     * handling of requests may cause CH applications to misbehave /
+     * hang; bad.
      *
      */
     ioMan->queueSize++;
     if ( (ioMan->workersIdle < ioMan->queueSize) ) {
-	/* see if giving up our quantum ferrets out some idle threads.
-	 */
-	LeaveCriticalSection(&ioMan->manLock);
-	Sleep(0);
-	EnterCriticalSection(&ioMan->manLock);
-	if ( (ioMan->workersIdle < ioMan->queueSize) ) {
-	    /* No, go ahead and create another. */
-	    ioMan->numWorkers++;
-	    if (!NewIOWorkerThread(ioMan)) {
-		ioMan->numWorkers--;
-	    }
-	}
+        /* see if giving up our quantum ferrets out some idle threads.
+         */
+        LeaveCriticalSection(&ioMan->manLock);
+        Sleep(0);
+        EnterCriticalSection(&ioMan->manLock);
+        if ( (ioMan->workersIdle < ioMan->queueSize) ) {
+            /* No, go ahead and create another. */
+            ioMan->numWorkers++;
+            if (!NewIOWorkerThread(ioMan)) {
+                ioMan->numWorkers--;
+            }
+        }
     }
     LeaveCriticalSection(&ioMan->manLock);
-  
+
     if (SubmitWork(ioMan->workQueue,wItem)) {
-	/* Note: the work item has potentially been consumed by a worker thread
-	 *       (and freed) at this point, so we cannot use wItem's requestID.
-	 */
-	return reqID;
+        /* Note: the work item has potentially been consumed by a worker thread
+         *       (and freed) at this point, so we cannot use wItem's requestID.
+         */
+        return reqID;
     } else {
-	return 0;
+        return 0;
     }
 }
 
@@ -399,23 +425,23 @@ depositWorkItem( unsigned int reqID,
  *
  * Conduit to underlying WorkQueue's SubmitWork(); adds IO
  * request to work queue, deciding whether or not to augment
- * the thread pool in the process. 
+ * the thread pool in the process.
  */
 int
 AddIORequest ( int   fd,
-	       BOOL  forWriting,
-	       BOOL  isSocket,
-	       int   len,
-	       char* buffer,
-	       CompletionProc onCompletion)
+               BOOL  forWriting,
+               BOOL  isSocket,
+               int   len,
+               char* buffer,
+               CompletionProc onCompletion)
 {
     WorkItem* wItem    = (WorkItem*)malloc(sizeof(WorkItem));
     unsigned int reqID = ioMan->requestID++;
     if (!ioMan || !wItem) return 0;
-  
+
     /* Fill in the blanks */
-    wItem->workKind     = ( isSocket   ? WORKER_FOR_SOCKET : 0 ) | 
-	                  ( forWriting ? WORKER_WRITE : WORKER_READ );
+    wItem->workKind     = ( isSocket   ? WORKER_FOR_SOCKET : 0 ) |
+                          ( forWriting ? WORKER_WRITE : WORKER_READ );
     wItem->workData.ioData.fd  = fd;
     wItem->workData.ioData.len = len;
     wItem->workData.ioData.buf = buffer;
@@ -423,9 +449,9 @@ AddIORequest ( int   fd,
 
     wItem->onCompletion        = onCompletion;
     wItem->requestID           = reqID;
-  
+
     return depositWorkItem(reqID, wItem);
-}       
+}
 
 /*
  * Function: AddDelayRequest()
@@ -435,12 +461,12 @@ AddIORequest ( int   fd,
  */
 BOOL
 AddDelayRequest ( unsigned int   usecs,
-		  CompletionProc onCompletion)
+                  CompletionProc onCompletion)
 {
     WorkItem* wItem = (WorkItem*)malloc(sizeof(WorkItem));
     unsigned int reqID = ioMan->requestID++;
     if (!ioMan || !wItem) return FALSE;
-  
+
     /* Fill in the blanks */
     wItem->workKind     = WORKER_DELAY;
     wItem->workData.delayData.usecs = usecs;
@@ -458,13 +484,13 @@ AddDelayRequest ( unsigned int   usecs,
  */
 BOOL
 AddProcRequest ( void* proc,
-		 void* param,
-		 CompletionProc onCompletion)
+                 void* param,
+                 CompletionProc onCompletion)
 {
     WorkItem* wItem = (WorkItem*)malloc(sizeof(WorkItem));
     unsigned int reqID = ioMan->requestID++;
     if (!ioMan || !wItem) return FALSE;
-  
+
     /* Fill in the blanks */
     wItem->workKind     = WORKER_DO_PROC;
     wItem->workData.procData.proc  = proc;
@@ -483,7 +509,7 @@ void ShutdownIOManager ( rtsBool wait_threads )
     MMRESULT mmresult;
 
     SetEvent(ioMan->hExitEvent);
-  
+
     if (wait_threads) {
         /* Wait for all worker threads to die. */
         for (;;) {
@@ -510,10 +536,10 @@ void ShutdownIOManager ( rtsBool wait_threads )
 }
 
 /* Keep track of WorkItems currently being serviced. */
-static 
+static
 void
-RegisterWorkItem(IOManagerState* ioMan, 
-		 WorkItem* wi)
+RegisterWorkItem(IOManagerState* ioMan,
+                 WorkItem* wi)
 {
     EnterCriticalSection(&ioMan->active_work_lock);
     wi->link = ioMan->active_work_items;
@@ -521,26 +547,27 @@ RegisterWorkItem(IOManagerState* ioMan,
     LeaveCriticalSection(&ioMan->active_work_lock);
 }
 
-static 
+static
 void
-DeregisterWorkItem(IOManagerState* ioMan, 
-		   WorkItem* wi)
+DeregisterWorkItem(IOManagerState* ioMan,
+                   WorkItem* wi)
 {
     WorkItem *ptr, *prev;
-    
+
     EnterCriticalSection(&ioMan->active_work_lock);
     for(prev=NULL,ptr=ioMan->active_work_items;ptr;prev=ptr,ptr=ptr->link) {
-	if (wi->requestID == ptr->requestID) {
-	    if (prev==NULL) {
-		ioMan->active_work_items = ptr->link;
-	    } else {
-		prev->link = ptr->link;
-	    }
-	    LeaveCriticalSection(&ioMan->active_work_lock);
-	    return;
-	}
+        if (wi->requestID == ptr->requestID) {
+            if (prev==NULL) {
+                ioMan->active_work_items = ptr->link;
+            } else {
+                prev->link = ptr->link;
+            }
+            LeaveCriticalSection(&ioMan->active_work_lock);
+            return;
+        }
     }
-    fprintf(stderr, "DeregisterWorkItem: unable to locate work item %d\n", wi->requestID);
+    fprintf(stderr, "DeregisterWorkItem: unable to locate work item %d\n",
+            wi->requestID);
     LeaveCriticalSection(&ioMan->active_work_lock);
 }
 
@@ -562,11 +589,11 @@ abandonWorkRequest ( int reqID )
     WorkItem *ptr;
     EnterCriticalSection(&ioMan->active_work_lock);
     for(ptr=ioMan->active_work_items;ptr;ptr=ptr->link) {
-	if (ptr->requestID == (unsigned int)reqID ) {
-	    ptr->abandonOp = 1;
-	    LeaveCriticalSection(&ioMan->active_work_lock);
-	    return;
-	}
+        if (ptr->requestID == (unsigned int)reqID ) {
+            ptr->abandonOp = 1;
+            LeaveCriticalSection(&ioMan->active_work_lock);
+            return;
+        }
     }
     /* Note: if the request ID isn't present, the worker will have
      * finished sometime since awaitRequests() last drained the completed
@@ -576,3 +603,11 @@ abandonWorkRequest ( int reqID )
 }
 
 #endif
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/win32/IOManager.h b/rts/win32/IOManager.h
index 866e950f4a9b..4ef5c9659b50 100644
--- a/rts/win32/IOManager.h
+++ b/rts/win32/IOManager.h
@@ -13,7 +13,7 @@
 /*
  The IOManager subsystem provides a non-blocking view
  of I/O operations. It lets one (or more) OS thread(s)
- issue multiple I/O requests, which the IOManager then 
+ issue multiple I/O requests, which the IOManager then
  handles independently of/concurrent to the thread(s)
  that issued the request. Upon completion, the issuing
  thread can inspect the result of the I/O operation &
@@ -29,30 +29,30 @@
  *
  */
 typedef void (*CompletionProc)(unsigned int requestID,
-			       int   fd,
-			       int   len,
-			       void* buf,
-			       int   errCode);
+                               int   fd,
+                               int   len,
+                               void* buf,
+                               int   errCode);
 
-/* 
+/*
  * Asynchronous procedure calls executed by a worker thread
- * take a generic state argument pointer and return an int by 
- * default. 
+ * take a generic state argument pointer and return an int by
+ * default.
  */
 typedef int (*DoProcProc)(void *param);
 
 typedef union workData {
     struct {
-	int   fd;
-	int   len;
-	char *buf; 
+        int   fd;
+        int   len;
+        char *buf;
     } ioData;
-    struct { 
-	int   usecs;
+    struct {
+        int   usecs;
     } delayData;
-    struct { 
-	DoProcProc proc;
-	void* param;
+    struct {
+        DoProcProc proc;
+        void* param;
     } procData;
 } WorkData;
 
@@ -78,8 +78,8 @@ extern CompletionProc onComplete;
 #define WORKER_DO_PROC    16
 
 /*
- * Starting up and shutting down. 
- */ 
+ * Starting up and shutting down.
+ */
 extern BOOL StartIOManager     ( void );
 extern void ShutdownIOManager  ( rtsBool wait_threads );
 
@@ -89,19 +89,27 @@ extern void ShutdownIOManager  ( rtsBool wait_threads );
  * will invoke upon completion.
  */
 extern int AddDelayRequest ( unsigned int   usecs,
-			     CompletionProc onCompletion);
+                             CompletionProc onCompletion);
 
 extern int AddIORequest ( int            fd,
-			  BOOL           forWriting,
-			  BOOL           isSocket,
-			  int            len,
-			  char*          buffer,
-			  CompletionProc onCompletion);
+                          BOOL           forWriting,
+                          BOOL           isSocket,
+                          int            len,
+                          char*          buffer,
+                          CompletionProc onCompletion);
 
 extern int AddProcRequest ( void*          proc,
-			    void*          data,
-			    CompletionProc onCompletion);
+                            void*          data,
+                            CompletionProc onCompletion);
 
 extern void abandonWorkRequest ( int reqID );
 
 #endif /* WIN32_IOMANAGER_H */
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/win32/OSMem.c b/rts/win32/OSMem.c
index 082b8dec7f5c..0ee8d48d9556 100644
--- a/rts/win32/OSMem.c
+++ b/rts/win32/OSMem.c
@@ -17,14 +17,14 @@
 #endif
 
 typedef struct alloc_rec_ {
-    char* base;     /* non-aligned base address, directly from VirtualAlloc */
-    W_ size;       /* Size in bytes */
+    char* base;    // non-aligned base address, directly from VirtualAlloc
+    W_ size;       // Size in bytes
     struct alloc_rec_* next;
 } alloc_rec;
 
 typedef struct block_rec_ {
-    char* base;         /* base address, non-MBLOCK-aligned */
-    W_ size;           /* size in bytes */
+    char* base;        // base address, non-MBLOCK-aligned
+    W_ size;           // size in bytes
     struct block_rec_* next;
 } block_rec;
 
@@ -89,19 +89,20 @@ insertFree(char* alloc_base, W_ alloc_size) {
     for( ; it!=0 && it->base<alloc_base; prev=it, it=it->next) {}
 
     if(it!=0 && alloc_base+alloc_size == it->base) {
-        if(prev->base + prev->size == alloc_base) {        /* Merge it, alloc, prev */
+        if(prev->base + prev->size == alloc_base) { /* Merge it, alloc, prev */
             prev->size += alloc_size + it->size;
             prev->next = it->next;
             stgFree(it);
-        } else {                                            /* Merge it, alloc */
+        } else {                                    /* Merge it, alloc */
             it->base = alloc_base;
             it->size += alloc_size;
         }
-    } else if(prev->base + prev->size == alloc_base) {     /* Merge alloc, prev */
+    } else if(prev->base + prev->size == alloc_base) { /* Merge alloc, prev */
         prev->size += alloc_size;
-    } else {                                                /* Merge none */
+    } else {                                           /* Merge none */
         block_rec* rec;
-        rec = (block_rec*)stgMallocBytes(sizeof(block_rec),"getMBlocks: insertFree");
+        rec = (block_rec*)stgMallocBytes(sizeof(block_rec),
+                                         "getMBlocks: insertFree");
         rec->base=alloc_base;
         rec->size=alloc_size;
         rec->next = it;
@@ -139,7 +140,8 @@ findFreeBlocks(nat n) {
             char* need_base;
             block_rec* next;
             int new_size;
-            need_base = (char*)(((W_)it->base) & ((W_)~MBLOCK_MASK)) + MBLOCK_SIZE;
+            need_base =
+                (char*)(((W_)it->base) & ((W_)~MBLOCK_MASK)) + MBLOCK_SIZE;
             next = (block_rec*)stgMallocBytes(
                     sizeof(block_rec)
                     , "getMBlocks: findFreeBlocks: splitting");
@@ -305,7 +307,9 @@ void osReleaseFreeMemory(void)
                     if (fb->base != a->base) {
                         block_rec *new_fb;
 
-                        new_fb = (block_rec *)stgMallocBytes(sizeof(block_rec),"osReleaseFreeMemory");
+                        new_fb =
+                            (block_rec *)stgMallocBytes(sizeof(block_rec),
+                                                        "osReleaseFreeMemory");
                         new_fb->base = fb->base;
                         new_fb->size = a->base - fb->base;
                         new_fb->next = fb;
@@ -317,7 +321,8 @@ void osReleaseFreeMemory(void)
                 /* Now we can free the alloc */
                 prev_a->next = a->next;
                 if(!VirtualFree((void *)a->base, 0, MEM_RELEASE)) {
-                    sysErrorBelch("freeAllMBlocks: VirtualFree MEM_RELEASE failed");
+                    sysErrorBelch("freeAllMBlocks: VirtualFree MEM_RELEASE "
+                                  "failed");
                     stg_exit(EXIT_FAILURE);
                 }
                 stgFree(a);
@@ -389,7 +394,8 @@ StgWord64 getPhysicalMemorySize (void)
         status.dwLength = sizeof(status);
         if (!GlobalMemoryStatusEx(&status)) {
 #if defined(DEBUG)
-            errorBelch("warning: getPhysicalMemorySize: cannot get physical memory size");
+            errorBelch("warning: getPhysicalMemorySize: cannot get physical "
+                       "memory size");
 #endif
             return 0;
         }
@@ -405,8 +411,16 @@ void setExecutable (void *p, W_ len, rtsBool exec)
                         exec ? PAGE_EXECUTE_READWRITE : PAGE_READWRITE,
                         &dwOldProtect) == 0)
     {
-        sysErrorBelch("setExecutable: failed to protect 0x%p; old protection: %lu\n",
-                      p, (unsigned long)dwOldProtect);
+        sysErrorBelch("setExecutable: failed to protect 0x%p; old protection: "
+                      "%lu\n", p, (unsigned long)dwOldProtect);
         stg_exit(EXIT_FAILURE);
     }
 }
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/win32/OSThreads.c b/rts/win32/OSThreads.c
index 7183313ef492..9f434d696fde 100644
--- a/rts/win32/OSThreads.c
+++ b/rts/win32/OSThreads.c
@@ -291,7 +291,8 @@ interruptOSThread (OSThreadId id)
         sysErrorBelch("interruptOSThread: OpenThread");
         stg_exit(EXIT_FAILURE);
     }
-    pCSIO = (PCSIO) GetProcAddress(GetModuleHandle(TEXT("Kernel32.dll")), "CancelSynchronousIo");
+    pCSIO = (PCSIO) GetProcAddress(GetModuleHandle(TEXT("Kernel32.dll")),
+                                   "CancelSynchronousIo");
     if ( NULL != pCSIO ) {
         pCSIO(hdl);
     } else {
@@ -320,3 +321,11 @@ KernelThreadId kernelThreadId (void)
     DWORD tid = GetCurrentThreadId();
     return tid;
 }
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/win32/ThrIOManager.c b/rts/win32/ThrIOManager.c
index c4974016c1cc..05741789cf31 100644
--- a/rts/win32/ThrIOManager.c
+++ b/rts/win32/ThrIOManager.c
@@ -2,7 +2,7 @@
  *
  * (c) The GHC Team, 1998-2006
  *
- * The IO manager thread in THREADED_RTS.  
+ * The IO manager thread in THREADED_RTS.
  * See also libraries/base/GHC/Conc.lhs.
  *
  * ---------------------------------------------------------------------------*/
@@ -66,7 +66,7 @@ getIOManagerEvent (void)
 HsWord32
 readIOManagerEvent (void)
 {
-    // This function must exist even in non-THREADED_RTS, 
+    // This function must exist even in non-THREADED_RTS,
     // see getIOManagerEvent() above.
 #if defined(THREADED_RTS)
     HsWord32 res;
@@ -112,14 +112,14 @@ sendIOManagerEvent (HsWord32 event)
             if (!SetEvent(io_manager_event)) {
                 sysErrorBelch("sendIOManagerEvent");
                 stg_exit(EXIT_FAILURE);
-            }        
+            }
             event_buf[next_event++] = (StgWord32)event;
         }
     }
 
     RELEASE_LOCK(&event_buf_mutex);
 #endif
-}    
+}
 
 void
 ioManagerWakeup (void)
@@ -151,9 +151,17 @@ ioManagerStart (void)
     // Make sure the IO manager thread is running
     Capability *cap;
     if (io_manager_event == INVALID_HANDLE_VALUE) {
-	cap = rts_lock();
-        rts_evalIO(&cap,ensureIOManagerIsRunning_closure,NULL);
-	rts_unlock(cap);
+        cap = rts_lock();
+        rts_evalIO(&cap, ensureIOManagerIsRunning_closure, NULL);
+        rts_unlock(cap);
     }
 }
 #endif
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/win32/Ticker.c b/rts/win32/Ticker.c
index 89902e568d69..b1c7b657e68b 100644
--- a/rts/win32/Ticker.c
+++ b/rts/win32/Ticker.c
@@ -20,7 +20,7 @@ static VOID CALLBACK tick_callback(
   BOOLEAN TimerOrWaitFired STG_UNUSED
   )
 {
-    tick_proc(0);
+    tick_proc(0, NULL);
 }
 
 // We use the CreateTimerQueue() API which has been around since
@@ -79,3 +79,11 @@ exitTicker (rtsBool wait)
         timer_queue = NULL;
     }
 }
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/win32/WorkQueue.c b/rts/win32/WorkQueue.c
index b676072c967a..b7793df32272 100644
--- a/rts/win32/WorkQueue.c
+++ b/rts/win32/WorkQueue.c
@@ -1,6 +1,6 @@
 /*
  * A fixed-size queue; MT-friendly.
- * 
+ *
  * (c) sof, 2002-2003.
  */
 #include "WorkQueue.h"
@@ -18,9 +18,9 @@ newSemaphore(int initCount, int max)
 {
   Semaphore s;
   s = CreateSemaphore ( NULL,       /* LPSECURITY_ATTRIBUTES (default) */
-			initCount,  /* LONG lInitialCount */
-			max,        /* LONG lMaxCount */
-			NULL);      /* LPCTSTR (anonymous / no object name) */
+                        initCount,  /* LONG lInitialCount */
+                        max,        /* LONG lMaxCount */
+                        NULL);      /* LPCTSTR (anonymous / no object name) */
   if ( NULL == s) {
     queue_error_rc("newSemaphore", GetLastError());
     return NULL;
@@ -33,24 +33,24 @@ newSemaphore(int initCount, int max)
  *
  * The queue constructor - semaphores are initialised to match
  * max number of queue entries.
- * 
+ *
  */
 WorkQueue*
 NewWorkQueue()
 {
   WorkQueue* wq = (WorkQueue*)malloc(sizeof(WorkQueue));
-  
+
   if (!wq) {
     queue_error("NewWorkQueue", "malloc() failed");
     return wq;
   }
-    
+
   memset(wq, 0, sizeof *wq);
-  
+
   InitializeCriticalSection(&wq->queueLock);
   wq->workAvailable = newSemaphore(0, WORKQUEUE_SIZE);
   wq->roomAvailable = newSemaphore(WORKQUEUE_SIZE, WORKQUEUE_SIZE);
-  
+
   /* Fail if we were unable to create any of the sync objects. */
   if ( NULL == wq->workAvailable ||
        NULL == wq->roomAvailable ) {
@@ -75,7 +75,7 @@ FreeWorkQueue ( WorkQueue* pq )
 
   /* Close the semaphores; any threads blocked waiting
    * on either will as a result be woken up.
-   */ 
+   */
   if ( pq->workAvailable ) {
     CloseHandle(pq->workAvailable);
   }
@@ -91,7 +91,7 @@ HANDLE
 GetWorkQueueHandle ( WorkQueue* pq )
 {
   if (!pq) return NULL;
-  
+
   return pq->workAvailable;
 }
 
@@ -114,14 +114,15 @@ GetWork ( WorkQueue* pq, void** ppw )
     queue_error("GetWork", "NULL WorkItem object");
     return FALSE;
   }
-  
+
   /* Block waiting for work item to become available */
-  if ( (rc = WaitForSingleObject( pq->workAvailable, INFINITE)) != WAIT_OBJECT_0 ) {
-    queue_error_rc("GetWork.WaitForSingleObject(workAvailable)", 
-		   ( (WAIT_FAILED == rc) ? GetLastError() : rc));
+  if ( (rc = WaitForSingleObject( pq->workAvailable, INFINITE))
+         != WAIT_OBJECT_0 ) {
+    queue_error_rc("GetWork.WaitForSingleObject(workAvailable)",
+                   ( (WAIT_FAILED == rc) ? GetLastError() : rc));
     return FALSE;
   }
-  
+
   return FetchWork(pq,ppw);
 }
 
@@ -144,7 +145,7 @@ FetchWork ( WorkQueue* pq, void** ppw )
     queue_error("FetchWork", "NULL WorkItem object");
     return FALSE;
   }
-  
+
   EnterCriticalSection(&pq->queueLock);
   *ppw = pq->items[pq->head];
   /* For sanity's sake, zero out the pointer. */
@@ -179,15 +180,16 @@ SubmitWork ( WorkQueue* pq, void* pw )
     queue_error("SubmitWork", "NULL WorkItem object");
     return FALSE;
   }
-  
+
   /* Block waiting for work item to become available */
-  if ( (rc = WaitForSingleObject( pq->roomAvailable, INFINITE)) != WAIT_OBJECT_0 ) {
-    queue_error_rc("SubmitWork.WaitForSingleObject(workAvailable)", 
-		   ( (WAIT_FAILED == rc) ? GetLastError() : rc));
+  if ( (rc = WaitForSingleObject( pq->roomAvailable, INFINITE))
+         != WAIT_OBJECT_0 ) {
+    queue_error_rc("SubmitWork.WaitForSingleObject(workAvailable)",
+                   ( (WAIT_FAILED == rc) ? GetLastError() : rc));
 
     return FALSE;
   }
-  
+
   EnterCriticalSection(&pq->queueLock);
   pq->items[pq->tail] = pw;
   pq->tail = (pq->tail + 1) % WORKQUEUE_SIZE;
@@ -205,20 +207,27 @@ SubmitWork ( WorkQueue* pq, void* pw )
 
 static void
 queue_error_rc( char* loc,
-		DWORD err)
+                DWORD err)
 {
   fprintf(stderr, "%s failed: return code = 0x%lx\n", loc, err);
   fflush(stderr);
   return;
 }
-			    
+
 
 static void
 queue_error( char* loc,
-	     char* reason)
+             char* reason)
 {
   fprintf(stderr, "%s failed: %s\n", loc, reason);
   fflush(stderr);
   return;
 }
 
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/win32/WorkQueue.h b/rts/win32/WorkQueue.h
index 3ed2385ec942..3875915c2e52 100644
--- a/rts/win32/WorkQueue.h
+++ b/rts/win32/WorkQueue.h
@@ -1,7 +1,7 @@
 /* WorkQueue.h
  *
  * A fixed-size queue; MT-friendly.
- * 
+ *
  * (c) sof, 2002-2003
  *
  */
@@ -36,3 +36,11 @@ extern BOOL       FetchWork          ( WorkQueue* pq, void** ppw );
 extern int        SubmitWork         ( WorkQueue* pq, void*   pw );
 
 #endif /* WIN32_WORKQUEUE_H */
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/win32/libHSbase.def b/rts/win32/libHSbase.def
index 119237b6521e..8140528c7064 100644
--- a/rts/win32/libHSbase.def
+++ b/rts/win32/libHSbase.def
@@ -40,5 +40,4 @@ EXPORTS
 
 	base_ControlziExceptionziBase_nonTermination_closure
 	base_ControlziExceptionziBase_nestedAtomically_closure
-
-
+	base_GHCziEventziThread_blockedOnBadFD_closure
diff --git a/rts/win32/seh_excn.c b/rts/win32/seh_excn.c
index da5f64d81206..4934a7def0e2 100644
--- a/rts/win32/seh_excn.c
+++ b/rts/win32/seh_excn.c
@@ -43,3 +43,11 @@ catchDivZero(struct _EXCEPTION_RECORD* rec,
 #endif
 #endif
 
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rts/win32/seh_excn.h b/rts/win32/seh_excn.h
index 8829e840b7aa..90a0ddcda09a 100644
--- a/rts/win32/seh_excn.h
+++ b/rts/win32/seh_excn.h
@@ -90,3 +90,11 @@ catchDivZero(struct _EXCEPTION_RECORD*,
 
 #endif /* WIN32_SEH_EXCN_H */
 
+
+// Local Variables:
+// mode: C
+// fill-column: 80
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// End:
diff --git a/rules/build-dependencies.mk b/rules/build-dependencies.mk
index 79350c053f4e..cdc1edff56e7 100644
--- a/rules/build-dependencies.mk
+++ b/rules/build-dependencies.mk
@@ -53,18 +53,15 @@ endif
 #     Foo.dyn_o Foo.o : Foo.hs
 # lines, and create corresponding hi-rule lines
 #     <dollar>(eval <dollar>(call hi-rule,Foo.dyn_hi Foo.hi : %hi: %o Foo.hs))
-	sed '/hs$$$$/ p                                      ; \
-	     /hs$$$$/ s/o /hi /g                             ; \
-	     /hs$$$$/ s/:/ : %hi: %o /                       ; \
-	     /hs$$$$/ s/^/$$$$(eval $$$$(call hi-rule,/      ; \
-	     /hs$$$$/ s/$$$$/))/                             ; \
-	     /hs-boot$$$$/ p                                 ; \
-	     /hs-boot$$$$/ s/o-boot /hi-boot /g              ; \
-	     /hs-boot$$$$/ s/:/ : %hi-boot: %o-boot /        ; \
-	     /hs-boot$$$$/ s/^/$$$$(eval $$$$(call hi-rule,/ ; \
-	     /hs-boot$$$$/ s/$$$$/))/'                         \
-	    $$@.tmp2 > $$@
-
+	sed -e '/hs$$$$/ p' -e '/hs$$$$/ s/o /hi /g' \
+             -e '/hs$$$$/ s/:/ : %hi: %o /'                       \
+             -e '/hs$$$$/ s/^/$$$$(eval $$$$(call hi-rule,/'      \
+             -e '/hs$$$$/ s/$$$$/))/'                             \
+             -e '/hs-boot$$$$/ p' -e '/hs-boot$$$$/ s/o-boot /hi-boot /g' \
+             -e '/hs-boot$$$$/ s/:/ : %hi-boot: %o-boot /'        \
+             -e '/hs-boot$$$$/ s/^/$$$$(eval $$$$(call hi-rule,/' \
+             -e '/hs-boot$$$$/ s/$$$$/))/'                        \
+             $$@.tmp2 > $$@
 # Some of the C files (directly or indirectly) include the generated
 # includes files.
 $$($1_$2_depfile_c_asm) : $$(includes_H_CONFIG) $$(includes_H_PLATFORM)
diff --git a/rules/build-package-data.mk b/rules/build-package-data.mk
index c53a084cee4e..2e610014a25a 100644
--- a/rules/build-package-data.mk
+++ b/rules/build-package-data.mk
@@ -49,9 +49,17 @@ endif
 # We filter out -Werror from SRC_CC_OPTS, because when configure tests
 # for a feature it may not generate warning-free C code, and thus may
 # think that the feature doesn't exist if -Werror is on.
-$1_$2_CONFIGURE_OPTS += --configure-option=CFLAGS="$$(filter-out -Werror,$$(SRC_CC_OPTS)) $$(CONF_CC_OPTS_STAGE$3) $$($1_CC_OPTS) $$($1_$2_CC_OPTS) $$(SRC_CC_WARNING_OPTS)"
-$1_$2_CONFIGURE_OPTS += --configure-option=LDFLAGS="$$(SRC_LD_OPTS) $$(CONF_GCC_LINKER_OPTS_STAGE$3) $$($1_LD_OPTS) $$($1_$2_LD_OPTS)"
-$1_$2_CONFIGURE_OPTS += --configure-option=CPPFLAGS="$$(SRC_CPP_OPTS) $$(CONF_CPP_OPTS_STAGE$3) $$($1_CPP_OPTS) $$($1_$2_CPP_OPTS)"
+$1_$2_CONFIGURE_CFLAGS = $$(filter-out -Werror,$$(SRC_CC_OPTS)) $$(CONF_CC_OPTS_STAGE$3) $$($1_CC_OPTS) $$($1_$2_CC_OPTS) $$(SRC_CC_WARNING_OPTS)
+$1_$2_CONFIGURE_LDFLAGS = $$(SRC_LD_OPTS) $$(CONF_GCC_LINKER_OPTS_STAGE$3) $$($1_LD_OPTS) $$($1_$2_LD_OPTS)
+$1_$2_CONFIGURE_CPPFLAGS = $$(SRC_CPP_OPTS) $$(CONF_CPP_OPTS_STAGE$3) $$($1_CPP_OPTS) $$($1_$2_CPP_OPTS)
+
+$1_$2_CONFIGURE_OPTS += --configure-option=CFLAGS="$$($1_$2_CONFIGURE_CFLAGS)"
+$1_$2_CONFIGURE_OPTS += --configure-option=LDFLAGS="$$($1_$2_CONFIGURE_LDFLAGS)"
+$1_$2_CONFIGURE_OPTS += --configure-option=CPPFLAGS="$$($1_$2_CONFIGURE_CPPFLAGS)"
+
+# Also pass these as gcc-options, because Cabal uses them to check for
+# the existence of foreign libraries.
+$1_$2_CONFIGURE_OPTS += --gcc-options="$$($1_$2_CONFIGURE_CFLAGS) $$($1_$2_CONFIGURE_LDFLAGS)"
 
 ifneq "$$(ICONV_INCLUDE_DIRS)" ""
 $1_$2_CONFIGURE_OPTS += --configure-option=--with-iconv-includes="$$(ICONV_INCLUDE_DIRS)"
@@ -86,7 +94,6 @@ endif
 
 $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="$$(REAL_RANLIB_CMD)"
 $1_$2_CONFIGURE_OPTS += $$(if $$(ALEX),--with-alex="$$(ALEX)")
 $1_$2_CONFIGURE_OPTS += $$(if $$(HAPPY),--with-happy="$$(HAPPY)")
 
diff --git a/rules/build-package-way.mk b/rules/build-package-way.mk
index 305252be47e4..3efe501451b9 100644
--- a/rules/build-package-way.mk
+++ b/rules/build-package-way.mk
@@ -23,13 +23,13 @@ $(call hs-objs,$1,$2,$3)
 # The .a/.so library file, indexed by two different sets of vars:
 # the first is indexed by the dir, distdir and way
 # the second is indexed by the package id, distdir and way
-$1_$2_$3_LIB_NAME = libHS$$($1_PACKAGE)-$$($1_$2_VERSION)$$($3_libsuf)
+$1_$2_$3_LIB_NAME = libHS$$($1_$2_PACKAGE_KEY)$$($3_libsuf)
 $1_$2_$3_LIB = $1/$2/build/$$($1_$2_$3_LIB_NAME)
-$$($1_PACKAGE)-$$($1_$2_VERSION)_$2_$3_LIB = $$($1_$2_$3_LIB)
+$$($1_$2_PACKAGE_KEY)_$2_$3_LIB = $$($1_$2_$3_LIB)
 
 ifeq "$$(HostOS_CPP)" "mingw32"
 ifneq "$$($1_$2_dll0_HS_OBJS)" ""
-$1_$2_$3_LIB0_ROOT = HS$$($1_PACKAGE)-$$($1_$2_VERSION)-0$$($3_libsuf)
+$1_$2_$3_LIB0_ROOT = HS$$($1_$2_PACKAGE_KEY)-0$$($3_libsuf)
 $1_$2_$3_LIB0_NAME = lib$$($1_$2_$3_LIB0_ROOT)
 $1_$2_$3_LIB0 = $1/$2/build/$$($1_$2_$3_LIB0_NAME)
 endif
@@ -42,14 +42,16 @@ endif
 # Really we should use a consistent scheme for distdirs, but in the
 # meantime we work around it by defining ghc-<ver>_dist-install_way_LIB:
 ifeq "$$($1_PACKAGE) $2" "ghc stage2"
-$$($1_PACKAGE)-$$($1_$2_VERSION)_dist-install_$3_LIB = $$($1_$2_$3_LIB)
+$$($1_$2_PACKAGE_KEY)_dist-install_$3_LIB = $$($1_$2_$3_LIB)
 endif
 
 # All the .a/.so library file dependencies for this library.
 #
 # The $(subst stage2,dist-install,..) is needed due to Note
 # [inconsistent distdirs].
-$1_$2_$3_DEPS_LIBS=$$(foreach dep,$$($1_$2_DEPS),$$($$(dep)_$(subst stage2,dist-install,$2)_$3_LIB))
+#
+# NB: Use DEP_KEYS, since DEPS only contains package IDs
+$1_$2_$3_DEPS_LIBS=$$(foreach dep,$$($1_$2_DEP_KEYS),$$($$(dep)_$(subst stage2,dist-install,$2)_$3_LIB))
 
 $1_$2_$3_NON_HS_OBJS = $$($1_$2_$3_CMM_OBJS) $$($1_$2_$3_C_OBJS)  $$($1_$2_$3_S_OBJS) $$($1_$2_EXTRA_OBJS)
 $1_$2_$3_ALL_OBJS = $$($1_$2_$3_HS_OBJS) $$($1_$2_$3_NON_HS_OBJS)
@@ -91,7 +93,6 @@ $$($1_$2_$3_LIB) : $$($1_$2_$3_ALL_OBJS) $$(ALL_RTS_LIBS) $$($1_$2_$3_DEPS_LIBS)
 	 $$(addprefix -l,$$($1_$2_EXTRA_LIBRARIES)) $$(addprefix -L,$$($1_$2_EXTRA_LIBDIRS)) \
          -no-auto-link-packages \
          -o $$@
-	$(call relative-dynlib-references,$1,$2,$4)
 endif
 else
 # Build the ordinary .a library
@@ -135,7 +136,7 @@ ifeq "$$(DYNAMIC_GHC_PROGRAMS)" "YES"
 $1_$2_GHCI_LIB = $$($1_$2_dyn_LIB)
 else
 ifeq "$3" "v"
-$1_$2_GHCI_LIB = $1/$2/build/HS$$($1_PACKAGE)-$$($1_$2_VERSION).$$($3_osuf)
+$1_$2_GHCI_LIB = $1/$2/build/HS$$($1_$2_PACKAGE_KEY).$$($3_osuf)
 ifeq "$$($1_$2_BUILD_GHCI_LIB)" "YES"
 # Don't put bootstrapping packages in the bindist
 ifneq "$4" "0"
diff --git a/rules/build-perl.mk b/rules/build-perl.mk
index 994c765cb740..3f7a0269d111 100644
--- a/rules/build-perl.mk
+++ b/rules/build-perl.mk
@@ -56,7 +56,6 @@ ifeq "$(findstring clean,$(MAKECMDGOALS))" ""
 ifneq "$$(BINDIST)" "YES"
 $1/$2/$$($1_$2_PROG).prl: $1/$$($1_PERL_SRC) $$$$(unlit_INPLACE) | $$$$(dir $$$$@)/.
 	"$$(unlit_INPLACE)" $$(UNLIT_OPTS) $$< $$@
-endif
 
 $1/$2/$$($1_$2_PROG): $1/$2/$$($1_$2_PROG).prl
 	$$(call removeFiles,$$@)
@@ -70,6 +69,15 @@ $$($1_$2_INPLACE): $1/$2/$$($1_$2_PROG) | $$$$(dir $$$$@)/.
 	$$(EXECUTABLE_FILE) $$@
 
 endif
+endif
+
+ifeq "$$($1_$2_INSTALL)" "YES"
+ifeq "$$($1_$2_TOPDIR)" "YES"
+INSTALL_TOPDIRS  += $$($1_$2_INPLACE)
+else
+INSTALL_BINS     += $$($1_$2_INPLACE)
+endif
+endif
 
 $(call profEnd, build-perl($1,$2))
 endef
diff --git a/rules/build-prog.mk b/rules/build-prog.mk
index 5837bb0c8417..f93b99d5f8fc 100644
--- a/rules/build-prog.mk
+++ b/rules/build-prog.mk
@@ -240,7 +240,7 @@ $1/$2/build/tmp/$$($1_$2_PROG)-wrapper.c: driver/utils/dynwrapper.c | $$$$(dir $
 	echo '#include <Windows.h>' >> $$@
 	echo '#include "Rts.h"' >> $$@
 	echo 'LPTSTR path_dirs[] = {' >> $$@
-	$$(foreach p,$$($1_$2_TRANSITIVE_DEPS),$$(call make-command,echo '    TEXT("/../lib/$$p")$$(comma)' >> $$@))
+	$$(foreach p,$$($1_$2_TRANSITIVE_DEP_KEYS),$$(call make-command,echo '    TEXT("/../lib/$$p")$$(comma)' >> $$@))
 	echo '    TEXT("/../lib/"),' >> $$@
 	echo '    NULL};' >> $$@
 	echo 'LPTSTR progDll = TEXT("../lib/$$($1_$2_PROG).dll");' >> $$@
@@ -259,15 +259,11 @@ $1/$2/build/tmp/$$($1_$2_PROG).dll : $$($1_$2_$$($1_$2_PROGRAM_WAY)_HS_OBJS) $$(
 else
 ifeq "$$($1_$2_LINK_WITH_GCC)" "NO"
 $1/$2/build/tmp/$$($1_$2_PROG) : $$($1_$2_$$($1_$2_PROGRAM_WAY)_HS_OBJS) $$($1_$2_$$($1_$2_PROGRAM_WAY)_C_OBJS) $$($1_$2_$$($1_$2_PROGRAM_WAY)_S_OBJS) $$($1_$2_OTHER_OBJS) | $$$$(dir $$$$@)/.
-	$$(call cmd,$1_$2_HC) -o $$@ $$($1_$2_$$($1_$2_PROGRAM_WAY)_ALL_HC_OPTS) $$(LD_OPTS) $$($1_$2_$$($1_$2_PROGRAM_WAY)_GHC_LD_OPTS) $$($1_$2_$$($1_$2_PROGRAM_WAY)_HS_OBJS) $$($1_$2_$$($1_$2_PROGRAM_WAY)_C_OBJS) $$($1_$2_$$($1_$2_PROGRAM_WAY)_S_OBJS) $$($1_$2_OTHER_OBJS) $$(addprefix -l,$$($1_$2_EXTRA_LIBRARIES))
+	$$(call cmd,$1_$2_HC) -o $$@ $$($1_$2_$$($1_$2_PROGRAM_WAY)_ALL_HC_OPTS) $$($1_$2_$$($1_$2_PROGRAM_WAY)_GHC_LD_OPTS) $$($1_$2_$$($1_$2_PROGRAM_WAY)_HS_OBJS) $$($1_$2_$$($1_$2_PROGRAM_WAY)_C_OBJS) $$($1_$2_$$($1_$2_PROGRAM_WAY)_S_OBJS) $$($1_$2_OTHER_OBJS) $$(addprefix -l,$$($1_$2_EXTRA_LIBRARIES))
 
-ifeq "$$($1_$2_PROGRAM_WAY)" "dyn"
-	$(call relative-dynlib-references,$1,$2,$3)
-	$(call relative-dynlib-path,$3)
-endif
 else
 $1/$2/build/tmp/$$($1_$2_PROG) : $$($1_$2_$$($1_$2_PROGRAM_WAY)_HS_OBJS) $$($1_$2_$$($1_$2_PROGRAM_WAY)_C_OBJS) $$($1_$2_$$($1_$2_PROGRAM_WAY)_S_OBJS) $$($1_$2_OTHER_OBJS) | $$$$(dir $$$$@)/.
-	$$(call cmd,$1_$2_CC) -o $$@ $$($1_$2_$$($1_$2_PROGRAM_WAY)_ALL_CC_OPTS) $$(LD_OPTS) $$($1_$2_$$($1_$2_PROGRAM_WAY)_HS_OBJS) $$($1_$2_$$($1_$2_PROGRAM_WAY)_C_OBJS) $$($1_$2_$$($1_$2_PROGRAM_WAY)_S_OBJS) $$($1_$2_OTHER_OBJS) $$($1_$2_$$($1_$2_PROGRAM_WAY)_EXTRA_CC_OPTS) $$(addprefix -l,$$($1_$2_EXTRA_LIBRARIES))
+	$$(call cmd,$1_$2_CC) -o $$@ $$($1_$2_$$($1_$2_PROGRAM_WAY)_ALL_CC_OPTS) $$($1_$2_$$($1_$2_PROGRAM_WAY)_ALL_LD_OPTS) $$($1_$2_$$($1_$2_PROGRAM_WAY)_HS_OBJS) $$($1_$2_$$($1_$2_PROGRAM_WAY)_C_OBJS) $$($1_$2_$$($1_$2_PROGRAM_WAY)_S_OBJS) $$($1_$2_OTHER_OBJS) $$($1_$2_$$($1_$2_PROGRAM_WAY)_EXTRA_CC_OPTS) $$(addprefix -l,$$($1_$2_EXTRA_LIBRARIES))
 endif
 endif
 
@@ -290,7 +286,7 @@ endif
 ifeq "$(findstring clean,$(MAKECMDGOALS))" ""
 ifeq "$$($1_$2_INSTALL_INPLACE)" "YES"
 $$($1_$2_INPLACE) : $1/$2/build/tmp/$$($1_$2_PROG_INPLACE) | $$$$(dir $$$$@)/.
-	"$$(CP)" -p $$< $$@
+	$$(INSTALL) -m 755 $$< $$@
 endif
 endif
 
diff --git a/rules/distdir-way-opts.mk b/rules/distdir-way-opts.mk
index a4f525e89653..99f7ce93cfb4 100644
--- a/rules/distdir-way-opts.mk
+++ b/rules/distdir-way-opts.mk
@@ -81,6 +81,22 @@ define distdir-way-opts # args: $1 = dir, $2 = distdir, $3 = way, $4 = stage
 # $1_$2_$3_MOST_HC_OPTS is also passed to C compilations when we use
 # GHC as the C compiler.
 
+ifeq "$(SUPPORTS_PACKAGE_KEY)" "NO"
+ifeq "$4" "0"
+$4_USE_PACKAGE_KEY=NO
+endif
+endif
+
+ifeq "$($4_USE_PACKAGE_KEY)" "NO"
+$1_$2_$4_DEP_OPTS = \
+ $$(foreach pkg,$$($1_$2_DEPS),-package $$(pkg))
+$4_THIS_PACKAGE_KEY = -package-name
+else
+$1_$2_$4_DEP_OPTS = \
+ $$(foreach pkg,$$($1_$2_DEP_KEYS),-package-key $$(pkg))
+$4_THIS_PACKAGE_KEY = -this-package-key
+endif
+
 $1_$2_$3_MOST_HC_OPTS = \
  $$(WAY_$3_HC_OPTS) \
  $$(CONF_HC_OPTS) \
@@ -88,7 +104,7 @@ $1_$2_$3_MOST_HC_OPTS = \
  $$($1_HC_OPTS) \
  $$($1_$2_HC_PKGCONF) \
  $$(if $$($1_$2_PROG),, \
-        $$(if $$($1_PACKAGE),-package-name $$($1_PACKAGE)-$$($1_$2_VERSION))) \
+        $$(if $$($1_PACKAGE),$$($4_THIS_PACKAGE_KEY) $$($1_$2_PACKAGE_KEY))) \
  $$(if $$($1_PACKAGE),-hide-all-packages) \
  -i $$(if $$($1_$2_HS_SRC_DIRS),$$(foreach dir,$$($1_$2_HS_SRC_DIRS),-i$1/$$(dir)),-i$1) \
  -i$1/$2/build -i$1/$2/build/autogen \
@@ -98,7 +114,7 @@ $1_$2_$3_MOST_HC_OPTS = \
  $$(foreach inc,$$($1_$2_INCLUDE),-\#include "$$(inc)") \
  $$(foreach opt,$$($1_$2_CPP_OPTS),-optP$$(opt)) \
  $$(if $$($1_PACKAGE),-optP-include -optP$1/$2/build/autogen/cabal_macros.h) \
- $$(foreach pkg,$$($1_$2_DEPS),-package $$(pkg)) \
+ $$($1_$2_$4_DEP_OPTS) \
  $$($1_$2_HC_OPTS) \
  $$(CONF_HC_OPTS_STAGE$4) \
  $$($1_$2_MORE_HC_OPTS) \
@@ -131,18 +147,6 @@ endif
 endif
 endif
 
-ifeq "$3" "dyn"
-ifneq "$4" "0"
-ifeq "$$(TargetElf)" "YES"
-$1_$2_$3_GHC_LD_OPTS += \
-    -fno-use-rpaths \
-    $$(foreach d,$$($1_$2_TRANSITIVE_DEPS),-optl-Wl$$(comma)-rpath -optl-Wl$$(comma)'$$$$ORIGIN/../$$d') -optl-Wl,-zorigin
-else ifeq "$$(TargetOS_CPP)" "darwin"
-$1_$2_$3_GHC_LD_OPTS += -optl-Wl,-headerpad_max_install_names
-endif
-endif
-endif
-
 $1_$2_$3_ALL_CC_OPTS = \
  $$(WAY_$3_CC_OPTS) \
  $$($1_$2_DIST_GCC_CC_OPTS) \
@@ -152,13 +156,20 @@ $1_$2_$3_ALL_CC_OPTS = \
  $$(EXTRA_CC_OPTS)
 
 $1_$2_$3_GHC_CC_OPTS = \
- $$(addprefix -optc, \
-     $$(WAY_$3_CC_OPTS) \
-     $$($1_$2_DIST_CC_OPTS) \
-     $$($1_$2_$3_CC_OPTS) \
-     $$($$(basename $$<)_CC_OPTS) \
-     $$($1_$2_EXTRA_CC_OPTS) \
-     $$(EXTRA_CC_OPTS)) \
+ $$(addprefix -optc, $$($1_$2_$3_ALL_CC_OPTS)) \
+ $$($1_$2_$3_MOST_HC_OPTS)
+
+# Options for passing to plain ld
+$1_$2_$3_ALL_LD_OPTS = \
+ $$(WAY_$3_LD_OPTS) \
+ $$($1_$2_DIST_LD_OPTS) \
+ $$($1_$2_$3_LD_OPTS) \
+ $$($1_$2_EXTRA_LD_OPTS) \
+ $$(EXTRA_LD_OPTS)
+
+# Options for passing to GHC when we use it for linking
+$1_$2_$3_GHC_LD_OPTS = \
+ $$(addprefix -optl, $$($1_$2_$3_ALL_LD_OPTS)) \
  $$($1_$2_$3_MOST_HC_OPTS)
 
 $1_$2_$3_ALL_AS_OPTS = \
@@ -170,5 +181,19 @@ $1_$2_$3_ALL_AS_OPTS = \
  $$($1_$2_$3_AS_OPTS) \
  $$(EXTRA_AS_OPTS)
 
+ifeq "$3" "dyn"
+ifneq "$4" "0"
+ifeq "$$(TargetElf)" "YES"
+$1_$2_$3_GHC_LD_OPTS += \
+    -fno-use-rpaths \
+    $$(foreach d,$$($1_$2_TRANSITIVE_DEP_KEYS),-optl-Wl$$(comma)-rpath -optl-Wl$$(comma)'$$$$ORIGIN/../$$d') -optl-Wl,-zorigin
+else ifeq "$$(TargetOS_CPP)" "darwin"
+$1_$2_$3_GHC_LD_OPTS += \
+    -fno-use-rpaths \
+    $$(foreach d,$$($1_$2_TRANSITIVE_DEP_KEYS),-optl-Wl$$(comma)-rpath -optl-Wl$$(comma)'@loader_path/../$$d')
+endif
+endif
+endif
+
 endef
 
diff --git a/rules/foreachLibrary.mk b/rules/foreachLibrary.mk
index b2353a0ac30d..cdd54962db7b 100644
--- a/rules/foreachLibrary.mk
+++ b/rules/foreachLibrary.mk
@@ -23,13 +23,26 @@
 # We use an FEL_ prefix for the variable names, to avoid trampling on
 # other variables, as make has no concept of local variables.
 
-# We need to handle bin-package-db specially, as it doesn't have an
-# entry in the packages file, as it isn't in its own repository.
+# We need to handle the following packages specially, as those don't
+# have an entry in the packages file, since they don't live in
+# repositories of their own:
+#
+#  - base
+#  - bin-package-db
+#  - ghc-prim
+#  - integer-gmp
+#  - integer-simple
+#  - template-haskell
 
 define foreachLibrary
 # $1 = function to call for each library
 # We will give it the package path and the tag as arguments
 $$(foreach hashline,libraries/bin-package-db#-#no-remote-repo#no-vcs        \
+                    libraries/base#-#no-remote-repo#no-vcs                  \
+                    libraries/ghc-prim#-#no-remote-repo#no-vcs              \
+                    libraries/integer-gmp#-#no-remote-repo#no-vcs           \
+                    libraries/integer-simple#-#no-remote-repo#no-vcs        \
+                    libraries/template-haskell#-#no-remote-repo#no-vcs      \
                     $$(shell grep '^libraries/' packages | sed 's/  */#/g'),\
     $$(eval FEL_line    := $$(subst #,$$(space),$$(hashline)))              \
     $$(eval FEL_libdir  := $$(word 1,$$(FEL_line)))                         \
diff --git a/rules/manual-package-config.mk b/rules/manual-package-config.mk
index 10629aaa2fc1..dd23e15c18d1 100644
--- a/rules/manual-package-config.mk
+++ b/rules/manual-package-config.mk
@@ -18,6 +18,7 @@ $(call profStart, manual-package-config($1))
 $1/dist/package.conf.inplace : $1/package.conf.in $$$$(ghc-pkg_INPLACE) | $$$$(dir $$$$@)/.
 	$$(CPP) $$(RAWCPP_FLAGS) -P \
 		-DTOP='"$$(TOP)"' \
+		-DDWARF_LIB_DIR_S='"$$(DwarfLibDir)"' \
 		$$($1_PACKAGE_CPP_OPTS) \
 		-x c $$(addprefix -I,$$(GHC_INCLUDE_DIRS)) $$< -o $$@.raw
 	grep -v '^#pragma GCC' $$@.raw | \
@@ -33,6 +34,7 @@ $1/dist/package.conf.install: | $$$$(dir $$$$@)/.
 		-DINSTALLING \
 		-DLIB_DIR='"$$(if $$(filter YES,$$(RelocatableBuild)),$$$$topdir,$$(ghclibdir))"' \
 		-DINCLUDE_DIR='"$$(if $$(filter YES,$$(RelocatableBuild)),$$$$topdir,$$(ghclibdir))/include"' \
+		-DDWARF_LIB_DIR_S='"$$(DwarfLibDir)"' \
 		$$($1_PACKAGE_CPP_OPTS) \
 		-x c $$(addprefix -I,$$(GHC_INCLUDE_DIRS)) $1/package.conf.in -o $$@.raw
 	grep -v '^#pragma GCC' $$@.raw | \
diff --git a/rules/relative-dynlib-references.mk b/rules/relative-dynlib-references.mk
deleted file mode 100644
index e117ddefb4ba..000000000000
--- a/rules/relative-dynlib-references.mk
+++ /dev/null
@@ -1,55 +0,0 @@
-# -----------------------------------------------------------------------------
-#
-# (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://ghc.haskell.org/trac/ghc/wiki/Building/Architecture
-#      http://ghc.haskell.org/trac/ghc/wiki/Building/Modifying
-#
-# -----------------------------------------------------------------------------
-
-
-# Make dynlib references use relative paths, so that everything works
-# without the build tree.
-
-define relative-dynlib-references
-# $1 = dir
-# $2 = distdir
-# $3 = GHC stage to use (0 == bootstrapping compiler)
-# $4 = RTSway
-
-ifeq "$$(TargetOS_CPP)" "darwin"
-ifneq "$3" "0"
-# Use relative paths for all the libraries
-ifneq "$$($1_$2_TRANSITIVE_DEP_NAMES)" ""
-	install_name_tool $$(foreach d,$$($1_$2_TRANSITIVE_DEP_NAMES), -change $$(TOP)/$$($$($$d_INSTALL_INFO)_dyn_LIB) @rpath/$$d-$$($$($$d_INSTALL_INFO)_VERSION)/$$($$($$d_INSTALL_INFO)_dyn_LIB_NAME)) $$@
-endif
-# Change absolute library name/path to a relative name/path
-ifeq "$$($1_$2_PROGNAME)" ""
-ifeq "$1" "rts"
-	install_name_tool -id @rpath/rts-$$(rts_VERSION)/$$(rts_$4_LIB_NAME) $$@
-else
-	install_name_tool -id @rpath/$$($1_PACKAGE)-$$($1_$2_VERSION)/$$($1_$2_dyn_LIB_NAME) $$@
-endif
-endif
-# Use relative paths for the RTS. Rather than try to work out which RTS
-# way is being linked, we just change it for all ways
-	install_name_tool $$(foreach w,$$(rts_WAYS), -change $$(TOP)/$$(rts_$$w_LIB) @rpath/rts-$$(rts_VERSION)/$$(rts_$$w_LIB_NAME)) $$@
-	install_name_tool -change $$(TOP)/$$(wildcard libffi/build/inst/lib/libffi.*.dylib) @rpath/rts-$$(rts_VERSION)/libffi.dylib $$@
-endif
-endif
-
-endef
-
-define relative-dynlib-path
-# $1 = GHC stage to use (0 == bootstrapping compiler)
-
-ifeq "$$(TargetOS_CPP)" "darwin"
-ifneq "$1" "0"
-	install_name_tool -rpath $$(TOP)/inplace/lib @loader_path/.. $$@
-endif
-endif
-
-endef
diff --git a/settings.in b/settings.in
index 9f9654c6892a..1bcb4aebc9fa 100644
--- a/settings.in
+++ b/settings.in
@@ -2,6 +2,8 @@
  ("C compiler command", "@SettingsCCompilerCommand@"),
  ("C compiler flags", "@SettingsCCompilerFlags@"),
  ("C compiler link flags", "@SettingsCCompilerLinkFlags@"),
+ ("Haskell CPP command","@SettingsHaskellCPPCommand@"),
+ ("Haskell CPP flags","@SettingsHaskellCPPFlags@"),
  ("ld command", "@SettingsLdCommand@"),
  ("ld flags", "@SettingsLdFlags@"),
  ("ld supports compact unwind", "@LdHasNoCompactUnwind@"),
diff --git a/sync-all b/sync-all
index f88ad2b85b93..355e16a562ec 100755
--- a/sync-all
+++ b/sync-all
@@ -1,5 +1,6 @@
-#!/usr/bin/perl -w
+#!/usr/bin/env perl
 
+use warnings;
 use strict;
 use Cwd;
 use English;
@@ -7,6 +8,7 @@ use English;
 $| = 1; # autoflush stdout after each print, to avoid output after die
 
 my $initial_working_directory;
+my $exit_via_die;
 
 my $defaultrepo;
 my @packages;
@@ -14,11 +16,12 @@ my $verbose = 2;
 my $try_to_resume = 0;
 my $ignore_failure = 0;
 my $checked_out_flag = 0; # NOT the opposite of bare_flag (describes remote repo state)
-my $get_mode;
 my $bare_flag = ""; # NOT the opposite of checked_out_flag (describes local repo state)
 
 my %tags;
 
+my $GITHUB = qr!(?:git@|git://|https://|http://|ssh://git@)github.com!;
+
 sub inDir {
     my $dir = shift;
     my $code = shift;
@@ -66,16 +69,6 @@ sub parsePackages {
     }
 }
 
-sub tryReadFile {
-    my $filename = shift;
-    my @lines;
-
-    open (FH, $filename) or return "";
-    @lines = <FH>;
-    close FH;
-    return join('', @lines);
-}
-
 sub message {
     if ($verbose >= 2) {
         print "@_\n";
@@ -123,7 +116,7 @@ sub git {
     });
 }
 
-sub readgit {
+sub readgitline {
     my $dir = shift;
     my @args = @_;
 
@@ -138,14 +131,28 @@ sub readgit {
     });
 }
 
+sub readgit {
+    my $dir = shift;
+    my @args = @_;
+
+    &inDir($dir, sub {
+        open my $fh, '-|', 'git', @args
+            or die "Executing git @args failed: $!";
+        my $ret;
+        $ret .= $_ while <$fh>;
+        close $fh;
+        return $ret;
+    });
+}
+
 sub configure_repository {
     my $localpath = shift;
 
-    &git($localpath, "config", "--local", "core.ignorecase", "true");
+    &git($localpath, "config", "core.ignorecase", "true");
 
-    my $autocrlf = &readgit($localpath, 'config', '--get', 'core.autocrlf');
+    my $autocrlf = &readgitline($localpath, 'config', '--get', 'core.autocrlf');
     if ($autocrlf eq "true") {
-        &git($localpath, "config", "--local", "core.autocrlf", "false");
+        &git($localpath, "config", "core.autocrlf", "false");
         &git($localpath, "reset", "--hard");
     }
 }
@@ -161,17 +168,17 @@ sub getrepo {
         # Figure out where to get the other repositories from,
         # based on where this GHC repo came from.
         my $git_dir = $bare_flag ? "ghc.git" : ".";
-        my $branch = &readgit($git_dir, "rev-parse", "--abbrev-ref", "HEAD");
+        my $branch = &readgitline($git_dir, "rev-parse", "--abbrev-ref", "HEAD");
         die "Bad branch: $branch"
             unless $branch =~ m!^[a-zA-Z][a-zA-Z0-9./-]*$!;
-        my $remote = &readgit($git_dir, "config", "branch.$branch.remote");
+        my $remote = &readgitline($git_dir, "config", "--get", "branch.$branch.remote");
         if ($remote eq "") {
             # remotes are not mandatory for branches (e.g. not recorded by default for bare repos)
             $remote = "origin";
         }
         die "Bad remote: $remote"
             unless $remote =~ m!^[a-zA-Z][a-zA-Z0-9./-]*$!;
-        $repo = &readgit($git_dir, "config", "remote.$remote.url");
+        $repo = &readgitline($git_dir, "config", "--get", "remote.$remote.url");
     }
 
     my $repo_base;
@@ -186,11 +193,7 @@ sub getrepo {
 
         # --checked-out is needed if you want to use a checked-out repo
         # over SSH or HTTP
-        if ($checked_out_flag) {
-            $checked_out_tree = 1;
-        } else {
-            $checked_out_tree = 0;
-        }
+        $checked_out_tree = $checked_out_flag;
 
         # Don't drop the last part of the path if specified with -r, as
         # it expects repos of the form:
@@ -235,6 +238,7 @@ sub gitall {
     my $tag;
     my $remotepath;
     my $line;
+    my $repo_is_submodule;
     my $branch_name;
     my $subcommand;
 
@@ -248,7 +252,7 @@ sub gitall {
 
     my ($repo_base, $checked_out_tree, $repo_local) = getrepo();
 
-    my $is_github_repo = $repo_base =~ m/(git@|git:\/\/|https:\/\/)github.com/;
+    my $is_github_repo = $repo_base =~ $GITHUB;
 
     @args = ();
 
@@ -304,11 +308,13 @@ sub gitall {
 
     for $line (@packages) {
         $tag        = $$line{"tag"};
+        if ($tags{$tag} == 0) {
+            next;
+        }
+
         # Use the "remote" structure for bare git repositories
         $localpath  = ($bare_flag) ?
                       $$line{"remotepath"} : $$line{"localpath"};
-        $remotepath = ($checked_out_tree) ?
-                      $$line{"localpath"}  : $$line{"remotepath"};
 
         if (!$started) {
             if ($start_repo eq $localpath) {
@@ -325,6 +331,19 @@ sub gitall {
         close RESUME;
         rename "resume.tmp", "resume";
 
+        $repo_is_submodule = $$line{"remotepath"} eq "-";
+
+        if ($checked_out_tree) {
+            $remotepath = $$line{"localpath"};
+        }
+        elsif ($repo_is_submodule) {
+            $remotepath = &readgitline(".", 'config', '-f', '.gitmodules', '--get', "submodule.$localpath.url");
+            $remotepath =~ s/\.\.\///;
+        }
+        else {
+            $remotepath = $$line{"remotepath"};
+        }
+
         # We can't create directories on GitHub, so we translate
         # "packages/foo" into "package-foo".
         if ($is_github_repo) {
@@ -335,15 +354,7 @@ sub gitall {
         $path = "$repo_base/$remotepath";
 
         if ($command eq "get") {
-            next if $remotepath eq "-"; # "git submodule init/update" will get this later
-
-            # Skip any repositories we have not included the tag for
-            if (not defined($tags{$tag})) {
-                $tags{$tag} = 0;
-            }
-            if ($tags{$tag} == 0) {
-                next;
-            }
+            next if $repo_is_submodule; # "git submodule init/update" will get this later
 
             if (-d $localpath) {
                 warning("$localpath already present; omitting")
@@ -363,8 +374,8 @@ sub gitall {
 
         my $git_repo_present = 1 if -e "$localpath/.git" || ($bare_flag && -d "$localpath");
         if (not $git_repo_present) {
-            if ($tag eq "") {
-                die "Required repo $localpath is missing";
+            if ($tag eq "-") {
+                die "Required repo $localpath is missing. Please first run './sync-all get'.\n";
             }
             else {
                  message "== $localpath repo not present; skipping";
@@ -383,7 +394,7 @@ sub gitall {
         }
         elsif ($command eq "check_submodules") {
             # If we have a submodule then check whether it is up-to-date
-            if ($remotepath eq "-") {
+            if ($repo_is_submodule) {
                 my %remote_heads;
 
                 message "== Checking sub-module $localpath";
@@ -402,7 +413,7 @@ sub gitall {
                 }
                 close($lsremote);
 
-                my $myhead = &readgit('.', 'rev-parse', '--verify', 'HEAD');
+                my $myhead = &readgitline('.', 'rev-parse', '--verify', 'HEAD');
 
                 if (not defined($remote_heads{$myhead})) {
                     die "Sub module $localpath needs to be pushed; see http://ghc.haskell.org/trac/ghc/wiki/Repositories/Upstream";
@@ -416,14 +427,14 @@ sub gitall {
             # to push to them then you need to use a special command, as
             # described on
             # http://ghc.haskell.org/trac/ghc/wiki/Repositories/Upstream
-            if ($remotepath ne "-") {
+            if (!$repo_is_submodule) {
                 &git($localpath, "push", @args);
             }
         }
         elsif ($command eq "pull") {
             my $realcmd;
             my @realargs;
-            if ($remotepath eq "-") {
+            if ($repo_is_submodule) {
                 # Only fetch for the submodules. "git submodule update"
                 # will take care of making us point to the right commit.
                 $realcmd = "fetch";
@@ -455,30 +466,15 @@ sub gitall {
         }
         elsif ($command eq "remote") {
             my @scm_args;
-            my $rpath;
             $ignore_failure = 1;
-            if ($remotepath eq '-') {
-                $rpath = "$localpath.git"; # N.B.: $localpath lacks the .git suffix
-                if ($localpath =~ /^libraries\//) {
-                    # FIXME: This is just a simple heuristic to
-                    # infer the remotepath for Git submodules. A
-                    # proper solution would require to parse the
-                    # .gitmodules file to obtain the actual
-                    # localpath<->remotepath mapping.
-                    $rpath =~ s/^libraries\//packages\//;
-                }
-                $rpath = "$repo_base/$rpath";
-            } else {
-                $rpath = $path;
-            }
             if ($subcommand eq 'add') {
-                @scm_args = ("remote", "add", $branch_name, $rpath);
+                @scm_args = ("remote", "add", $branch_name, $path);
             } elsif ($subcommand eq 'rm') {
                 @scm_args = ("remote", "rm", $branch_name);
             } elsif ($subcommand eq 'set-branches') {
                 @scm_args = ("remote", "set-branches", $branch_name);
             } elsif ($subcommand eq 'set-url') {
-                @scm_args = ("remote", "set-url", $branch_name, $rpath);
+                @scm_args = ("remote", "set-url", $branch_name, $path);
             }
             &git($localpath, @scm_args, @args);
         }
@@ -522,7 +518,7 @@ sub gitall {
         elsif ($command eq "compare") {
             # Don't compare the subrepos; it doesn't work properly as
             # they aren't on a branch.
-            next if $remotepath eq "-";
+            next if $repo_is_submodule;
 
             my $compareto;
             if ($#args eq -1) {
@@ -539,11 +535,11 @@ sub gitall {
             }
             print "$localpath";
             print (' ' x (40 - length($localpath)));
-            my $branch = &readgit($localpath, "rev-parse", "--abbrev-ref", "HEAD");
+            my $branch = &readgitline($localpath, "rev-parse", "--abbrev-ref", "HEAD");
             die "Bad branch: $branch"
                 unless $branch =~ m!^[a-zA-Z][a-zA-Z0-9./-]*$!;
-            my $us   = &readgit(".", "ls-remote", $localpath, "refs/heads/$branch");
-            my $them = &readgit(".", "ls-remote", $compareto, "refs/heads/$branch");
+            my $us   = &readgitline(".", "ls-remote", $localpath, "refs/heads/$branch");
+            my $them = &readgitline(".", "ls-remote", $compareto, "refs/heads/$branch");
             $us   =~ s/[[:space:]].*//;
             $them =~ s/[[:space:]].*//;
             die "Bad commit of mine: $us"     unless (length($us)   eq 40);
@@ -567,22 +563,26 @@ sub gitInitSubmodules {
     &git(".", "submodule", "init", @_);
 
     my ($repo_base, $checked_out_tree, $repo_local) = getrepo();
+
+    my $submodulespaths = &readgit(".", "config", "--get-regexp", "^submodule[.].*[.]url");
+    # if we came from github, change the urls appropriately
+    while ($submodulespaths =~ m!^(submodule.(?:libraries/|utils/)?[a-zA-Z0-9-]+.url) ($GITHUB)/ghc/packages/([a-zA-Z0-9-]+).git$!gm) {
+        &git(".", "config", $1, "$2/ghc/packages-$3");
+    }
+
     # if we came from a local repository, grab our submodules from their
     # checkouts over there, if they exist.
     if ($repo_local) {
-        my $gitConfig = &tryReadFile(".git/config");
-        foreach $_ (split /^/, $gitConfig) {
-            if ($_ =~ /^\[submodule "(.*)"\]$/ and -e "$repo_base/$1/.git") {
-                &git(".", "config", "submodule.$1.url", "$repo_base/$1");
+        while ($submodulespaths =~ m!^(submodule.((?:libraries/|utils/)?[a-zA-Z0-9-]+).url) .*$!gm) {
+            if (-e "$repo_base/$2/.git") {
+                &git(".", "config", $1, "$repo_base/$2");
             }
         }
     }
 }
 
 sub checkCurrentBranchIsMaster {
-    my $branch = `git symbolic-ref HEAD`;
-    $branch =~ s/refs\/heads\///;
-    $branch =~ s/\n//;
+    my $branch = &readgitline(".", "rev-parse", "--abbrev-ref", "HEAD");
 
     if ($branch !~ /master/) {
         print "\nWarning: You are trying to 'pull' while on branch '$branch'.\n"
@@ -597,8 +597,7 @@ sub help
 
         my $tags = join ' ', sort (grep !/^-$/, keys %tags);
 
-        # Get the built in help
-        my $help = <<END;
+        print <<END;
 Usage:
 
 ./sync-all [-q] [-s] [--ignore-failure] [-r repo] [--checked-out] [--bare]
@@ -766,30 +765,9 @@ sync-all *ignores* the defaultrepo of all repos other than the root one. So the
 remote repos must be laid out in one of the two formats given by <local-path>
 and <remote-path> in the file 'packages'.
 
-Available package-tags are:
-END
+Available package-tags are: $tags
 
-        # Collect all the tags in the packages file
-        my %available_tags;
-        open IN, "< packages.conf"
-            or open IN, "< packages" # clashes with packages directory when using --bare
-            or die "Can't open packages file (or packages.conf)";
-        while (<IN>) {
-            chomp;
-            if (/^([^# ]+) +(?:([^ ]+) +)?([^ ]+) +([^ ]+)/) {
-                if (defined($2) && $2 ne "-") {
-                    $available_tags{$2} = 1;
-                }
-            }
-            elsif (! /^(#.*)?$/) {
-                die "Bad line: $_";
-            }
-        }
-        close IN;
-
-        # Show those tags and the help text
-        my @available_tags = keys %available_tags;
-        print "$help@available_tags\n\n";
+END
         exit $exit;
 }
 
@@ -822,9 +800,6 @@ sub main {
         elsif ($arg eq "--ignore-failure") {
             $ignore_failure = 1;
         }
-        elsif ($arg eq "--complete" || $arg eq "--partial") {
-            $get_mode = $arg;
-        }
         # Use --checked-out if the _remote_ repos are a checked-out tree,
         # rather than the master trees.
         elsif ($arg eq "--checked-out") {
@@ -911,17 +886,7 @@ sub main {
             &gitInitSubmodules(@submodule_args);
         }
 
-        if ($command eq "pull") {
-            my $gitConfig = &tryReadFile(".git/config");
-            if ($gitConfig !~ /submodule/) {
-                &gitInitSubmodules(@submodule_args);
-            }
-        }
         if ($command eq "get" or $command eq "pull") {
-            my $gitConfig = &tryReadFile(".git/config");
-            if ($gitConfig !~ /submodule/) {
-                &gitInitSubmodules(@submodule_args);
-            }
             &git(".", "submodule", "update", @submodule_args);
         }
     }
@@ -934,100 +899,70 @@ BEGIN {
     }
     $initial_working_directory = getcwd();
 
-    #message "== Checking for left-over testsuite/.git folder";
-    if (-d "testsuite/.git") {
-        print <<EOF;
+    $SIG{__DIE__} = sub {
+      die @_ if $^S;
+      $exit_via_die = 1;
+    };
+
+    my @obsolete_dirs = qw!
+        testsuite
+        libraries/base
+        libraries/ghc-prim
+        libraries/template-haskell
+        libraries/integer-gmp
+        libraries/integer-simple
+        !;
+    for my $dir (@obsolete_dirs) {
+        if (-d "$dir/.git") {
+            print <<EOF;
 ============================
 ATTENTION!
 
-You have a left-over testsuite/.git folder in your GHC tree!
+You have a left-over $dir/.git folder in your GHC tree!
 
-Please backup or remove it (e.g. "rm -r testsuite/.git") before
-proceeding as the testsuite Git repository is now tracked as part of
+Please backup or remove it (e.g. "rm -r $dir/.git") before
+proceeding as the aforesaid Git repository is now tracked as part of
 the ghc Git repository (see #8545 for more details)
 ============================
 EOF
-        die "detected obsolete testsuite/.git folder"
+            die "detected obsolete $dir/.git folder"
+        }
     }
 }
 
 END {
+    return if $exit_via_die;
     my $ec = $?;
 
     chdir($initial_working_directory);
 
-    message "== Checking for old haddock repo";
-    if (-d "utils/haddock/.git") {
-        chdir("utils/haddock");
-        if ((system "git log -1 87e2ca11c3d1b1bc49900fba0b5c5c6f85650718 > /dev/null 2> /dev/null") == 0) {
-            print <<EOF;
-============================
-ATTENTION!
-
-You have an old haddock repository in your GHC tree!
-
-Please remove it (e.g. "rm -r utils/haddock"), and then run
-"./sync-all get" to get the new repository.
-============================
-EOF
-        }
-        chdir($initial_working_directory);
-    }
-
-    message "== Checking for old binary repo";
-    if (-d "libraries/binary/.git") {
-        chdir("libraries/binary");
-        if ((system "git log -1 749ac0efbde3b14901417364a872796598747aaf > /dev/null 2> /dev/null") == 0) {
-            print <<EOF;
-============================
-ATTENTION!
-
-You have an old binary repository in your GHC tree!
-
-Please remove it (e.g. "rm -r libraries/binary"), and then run
-"./sync-all get" to get the new repository.
-============================
-EOF
-        }
-        chdir($initial_working_directory);
-    }
-
-    message "== Checking for old mtl repo";
-    if (-d "libraries/mtl/.git") {
-        chdir("libraries/mtl");
-        if ((system "git log -1 c67d8f7247c612dc35242bc67e616f7ea35eadb9 > /dev/null 2> /dev/null") == 0) {
-            print <<EOF;
+    my @obsolete_dirs = (
+        ["utils/haddock",    "87e2ca11c3d1b1bc49900fba0b5c5c6f85650718"],
+        ["libraries/binary", "749ac0efbde3b14901417364a872796598747aaf"],
+        ["libraries/mtl",    "c67d8f7247c612dc35242bc67e616f7ea35eadb9"],
+        ["libraries/Cabal",  "c8ebd66a32865f72ae03ee0663c62df3d77f08fe"],
+        );
+    for (@obsolete_dirs) {
+        my ($dir, $hash) = @$_;
+        my ($name) = $dir =~ m!/([^/]+)$!;
+        message "== Checking for old $name repo";
+        if (-d "$dir/.git") {
+            chdir($dir);
+            if ((system "git log -1 $hash > /dev/null 2> /dev/null") == 0) {
+                print <<EOF;
 ============================
 ATTENTION!
 
-You have an old mtl repository in your GHC tree!
+You have an old $name repository in your GHC tree!
 
-Please remove it (e.g. "rm -r libraries/mtl"), and then run
-"./sync-all get" to get the new repository.
-============================
-EOF
-        }
-        chdir($initial_working_directory);
-    }
-
-    message "== Checking for old Cabal repo";
-    if (-d "libraries/Cabal/.git") {
-        chdir("libraries/Cabal");
-        if ((system "git log -1 c8ebd66a32865f72ae03ee0663c62df3d77f08fe > /dev/null 2> /dev/null") == 0) {
-            print <<EOF;
-============================
-ATTENTION!
-
-You have an old Cabal repository in your GHC tree!
-
-Please remove it (e.g. "rm -r libraries/Cabal"), and then run
+Please remove it (e.g. "rm -r $dir"), and then run
 "./sync-all get" to get the new repository.
 ============================
 EOF
+            }
+            chdir($initial_working_directory);
         }
-        chdir($initial_working_directory);
     }
-
     message "== Checking for old time from tarball";
     if (-d "libraries/time" and ! -e "libraries/time/.git") {
             print <<EOF;
@@ -1043,7 +978,7 @@ EOF
     }
 
     message "== Checking for obsolete Git repo URL";
-    my $repo_url = &readgit(".", 'config', '--get', 'remote.origin.url');
+    my $repo_url = &readgitline(".", 'config', '--get', 'remote.origin.url');
     if ($repo_url =~ /^http:\/\/darcs.haskell.org/) {
             print <<EOF;
 ============================
@@ -1068,4 +1003,3 @@ EOF
 }
 
 main(@ARGV);
-
diff --git a/testsuite/.gitignore b/testsuite/.gitignore
index 1e14dc151fd7..5631eebef49e 100644
--- a/testsuite/.gitignore
+++ b/testsuite/.gitignore
@@ -22,13 +22,16 @@ Thumbs.db
 *.o
 *.o-boot
 *.pyc
-*.normalised
 *.eventlog
 *.comp.std*
 
-.hpc
+.hpc/
+.hpc.*/
 
 *.genscript
+*.stderr.normalised
+*.stderr-ghc.normalised
+*.stdout.normalised
 *.interp.stdout
 *.interp.stderr
 *.run.stdout
@@ -37,18 +40,20 @@ Thumbs.db
 *.hp
 tests/**/*.ps
 *.stats
+Setup
+dist
+tmp.d
 
 *.dyn_o
 *.dyn_hi
 *.dyn_hi-boot
 *o
-*.hi
 *.dll
 *.dylib
 *.so
-*.hpc.*
 *bindisttest_install___dir_bin_ghc.mk
 *bindisttest_install___dir_bin_ghc.exe.mk
+mk/ghcconfig_*_inplace_bin_ghc-stage1.mk
 mk/ghcconfig_*_inplace_bin_ghc-stage2.mk
 mk/ghcconfig_*_inplace_bin_ghc-stage2.exe.mk
 *.imports
@@ -56,1350 +61,1456 @@ mk/ghcconfig_*_inplace_bin_ghc-stage2.exe.mk
 # -----------------------------------------------------------------------------
 # specific generated files
 
+/mk/ghc-config
+/tests/annotations/should_compile/th/build_make
+/tests/annotations/should_run/Config.hs
+/tests/annotations/should_run/annrun01
+/tests/array/should_run/arr001
+/tests/array/should_run/arr002
+/tests/array/should_run/arr003
+/tests/array/should_run/arr004
+/tests/array/should_run/arr005
+/tests/array/should_run/arr006
+/tests/array/should_run/arr007
+/tests/array/should_run/arr008
+/tests/array/should_run/arr009
+/tests/array/should_run/arr010
+/tests/array/should_run/arr011
+/tests/array/should_run/arr012
+/tests/array/should_run/arr013
+/tests/array/should_run/arr014
+/tests/array/should_run/arr015
+/tests/array/should_run/arr016
+/tests/array/should_run/arr017
+/tests/array/should_run/arr018
+/tests/array/should_run/arr019
+/tests/array/should_run/arr020
+/tests/arrows/should_run/T3822
+/tests/arrows/should_run/arrowrun001
+/tests/arrows/should_run/arrowrun002
+/tests/arrows/should_run/arrowrun003
+/tests/arrows/should_run/arrowrun004
+/tests/boxy/T2193
+/tests/cabal/1750.hs
+/tests/cabal/1750.out
+/tests/cabal/T1750.hs
+/tests/cabal/T1750.out
+/tests/cabal/cabal01/dist/
+/tests/cabal/cabal01/install/
+/tests/cabal/cabal01/local.db/
+/tests/cabal/cabal01/setup
+/tests/cabal/cabal03/Setup
+/tests/cabal/cabal03/p/dist/
+/tests/cabal/cabal03/q/dist/
+/tests/cabal/cabal03/tmp.d/
+/tests/cabal/cabal04/Setup
+/tests/cabal/cabal04/dist/
+/tests/cabal/cabal04/err
+/tests/cabal/cabal05/p-0.1.0.0/
+/tests/cabal/cabal05/q-0.1.0.0/
+/tests/cabal/cabal05/r-0.1.0.0/
+/tests/cabal/cabal06/inst-*/
+/tests/cabal/cabal06/tmp*
+/tests/cabal/local01.package.conf/
+/tests/cabal/local03.package.conf/
+/tests/cabal/local04.package.conf/
+/tests/cabal/local05a.package.conf/
+/tests/cabal/local05b.package.conf/
+/tests/cabal/local06.package.conf/
+/tests/cabal/local07.package.conf/
+/tests/cabal/local1750.package.conf/
+/tests/cabal/localT1750.package.conf/
+/tests/cabal/localshadow1.package.conf/
+/tests/cabal/localshadow2.package.conf/
+/tests/cabal/package.conf.*/
+/tests/cabal/recache_reexport_db/package.cache
+/tests/cabal/shadow.hs
+/tests/cabal/shadow1.out
+/tests/cabal/shadow2.out
+/tests/cabal/shadow3.out
+/tests/callarity/perf/T3924
+/tests/callarity/should_run/StrictLet
+/tests/callarity/unittest/CallArity1
+/tests/codeGen/should_compile/2578
+/tests/codeGen/should_compile/T2578
+/tests/codeGen/should_gen_asm/memcpy-unroll-conprop.s
+/tests/codeGen/should_gen_asm/memcpy-unroll.s
+/tests/codeGen/should_gen_asm/memcpy.s
+/tests/codeGen/should_gen_asm/memset-unroll.s
+/tests/codeGen/should_run/1852
+/tests/codeGen/should_run/1861
+/tests/codeGen/should_run/2080
+/tests/codeGen/should_run/2838
+/tests/codeGen/should_run/3207
+/tests/codeGen/should_run/3561
+/tests/codeGen/should_run/3677
+/tests/codeGen/should_run/4441
+/tests/codeGen/should_run/5129
+/tests/codeGen/should_run/5149
+/tests/codeGen/should_run/5626
+/tests/codeGen/should_run/5747
+/tests/codeGen/should_run/5785
+/tests/codeGen/should_run/6146
+/tests/codeGen/should_run/CopySmallArray
+/tests/codeGen/should_run/CopySmallArrayStressTest
+/tests/codeGen/should_run/SizeOfSmallArray
+/tests/codeGen/should_run/StaticArraySize
+/tests/codeGen/should_run/StaticByteArraySize
+/tests/codeGen/should_run/T1852
+/tests/codeGen/should_run/T1861
+/tests/codeGen/should_run/T2080
+/tests/codeGen/should_run/T2838
+/tests/codeGen/should_run/T3207
+/tests/codeGen/should_run/T3561
+/tests/codeGen/should_run/T3677
+/tests/codeGen/should_run/T4441
+/tests/codeGen/should_run/T5129
+/tests/codeGen/should_run/T5149
+/tests/codeGen/should_run/T5626
+/tests/codeGen/should_run/T5747
+/tests/codeGen/should_run/T5785
+/tests/codeGen/should_run/T5900
+/tests/codeGen/should_run/T6084
+/tests/codeGen/should_run/T6146
+/tests/codeGen/should_run/T7163
+/tests/codeGen/should_run/T7319
+/tests/codeGen/should_run/T7361
+/tests/codeGen/should_run/T7600
+/tests/codeGen/should_run/T7953
+/tests/codeGen/should_run/T8103
+/tests/codeGen/should_run/T8256
+/tests/codeGen/should_run/T9001
+/tests/codeGen/should_run/T9013
+/tests/codeGen/should_run/T9340
+/tests/codeGen/should_run/Word2Float64
+/tests/codeGen/should_run/cgrun001
+/tests/codeGen/should_run/cgrun002
+/tests/codeGen/should_run/cgrun003
+/tests/codeGen/should_run/cgrun004
+/tests/codeGen/should_run/cgrun005
+/tests/codeGen/should_run/cgrun006
+/tests/codeGen/should_run/cgrun007
+/tests/codeGen/should_run/cgrun008
+/tests/codeGen/should_run/cgrun009
+/tests/codeGen/should_run/cgrun010
+/tests/codeGen/should_run/cgrun011
+/tests/codeGen/should_run/cgrun012
+/tests/codeGen/should_run/cgrun013
+/tests/codeGen/should_run/cgrun014
+/tests/codeGen/should_run/cgrun015
+/tests/codeGen/should_run/cgrun016
+/tests/codeGen/should_run/cgrun017
+/tests/codeGen/should_run/cgrun018
+/tests/codeGen/should_run/cgrun019
+/tests/codeGen/should_run/cgrun020
+/tests/codeGen/should_run/cgrun021
+/tests/codeGen/should_run/cgrun022
+/tests/codeGen/should_run/cgrun024
+/tests/codeGen/should_run/cgrun026
+/tests/codeGen/should_run/cgrun027
+/tests/codeGen/should_run/cgrun028
+/tests/codeGen/should_run/cgrun031
+/tests/codeGen/should_run/cgrun032
+/tests/codeGen/should_run/cgrun033
+/tests/codeGen/should_run/cgrun034
+/tests/codeGen/should_run/cgrun035
+/tests/codeGen/should_run/cgrun036
+/tests/codeGen/should_run/cgrun037
+/tests/codeGen/should_run/cgrun038
+/tests/codeGen/should_run/cgrun039
+/tests/codeGen/should_run/cgrun040
+/tests/codeGen/should_run/cgrun043
+/tests/codeGen/should_run/cgrun044
+/tests/codeGen/should_run/cgrun045
+/tests/codeGen/should_run/cgrun046
+/tests/codeGen/should_run/cgrun047
+/tests/codeGen/should_run/cgrun048
+/tests/codeGen/should_run/cgrun049
+/tests/codeGen/should_run/cgrun050
+/tests/codeGen/should_run/cgrun051
+/tests/codeGen/should_run/cgrun052
+/tests/codeGen/should_run/cgrun053
+/tests/codeGen/should_run/cgrun054
+/tests/codeGen/should_run/cgrun055
+/tests/codeGen/should_run/cgrun056
+/tests/codeGen/should_run/cgrun057
+/tests/codeGen/should_run/cgrun058
+/tests/codeGen/should_run/cgrun059
+/tests/codeGen/should_run/cgrun060
+/tests/codeGen/should_run/cgrun061
+/tests/codeGen/should_run/cgrun062
+/tests/codeGen/should_run/cgrun063
+/tests/codeGen/should_run/cgrun064
+/tests/codeGen/should_run/cgrun065
+/tests/codeGen/should_run/cgrun066
+/tests/codeGen/should_run/cgrun067
+/tests/codeGen/should_run/cgrun068
+/tests/codeGen/should_run/cgrun069
+/tests/codeGen/should_run/cgrun070
+/tests/codeGen/should_run/cgrun071
+/tests/codeGen/should_run/cgrun072
+/tests/codeGen/should_run/setByteArray
+/tests/concurrent/T2317/T2317
+/tests/concurrent/prog001/concprog001
+/tests/concurrent/prog002/concprog002
+/tests/concurrent/prog002/concprog002.aux
+/tests/concurrent/prog002/concprog002.hp
+/tests/concurrent/prog002/concprog002.ps
+/tests/concurrent/prog003/concprog003
+/tests/concurrent/should_run/1980
+/tests/concurrent/should_run/2910
+/tests/concurrent/should_run/2910a
+/tests/concurrent/should_run/3279
+/tests/concurrent/should_run/3429
+/tests/concurrent/should_run/367
+/tests/concurrent/should_run/367_letnoescape
+/tests/concurrent/should_run/4030
+/tests/concurrent/should_run/4811
+/tests/concurrent/should_run/4813
+/tests/concurrent/should_run/5238
+/tests/concurrent/should_run/5421
+/tests/concurrent/should_run/5558
+/tests/concurrent/should_run/5611
+/tests/concurrent/should_run/5866
+/tests/concurrent/should_run/T1980
+/tests/concurrent/should_run/T2910
+/tests/concurrent/should_run/T2910a
+/tests/concurrent/should_run/T3279
+/tests/concurrent/should_run/T3429
+/tests/concurrent/should_run/T367
+/tests/concurrent/should_run/T367_letnoescape
+/tests/concurrent/should_run/T4030
+/tests/concurrent/should_run/T4811
+/tests/concurrent/should_run/T4813
+/tests/concurrent/should_run/T5238
+/tests/concurrent/should_run/T5421
+/tests/concurrent/should_run/T5558
+/tests/concurrent/should_run/T5611
+/tests/concurrent/should_run/T5866
+/tests/concurrent/should_run/T7970
+/tests/concurrent/should_run/AtomicPrimops
+/tests/concurrent/should_run/allowinterrupt001
+/tests/concurrent/should_run/async001
+/tests/concurrent/should_run/compareAndSwap
+/tests/concurrent/should_run/conc001
+/tests/concurrent/should_run/conc002
+/tests/concurrent/should_run/conc003
+/tests/concurrent/should_run/conc004
+/tests/concurrent/should_run/conc006
+/tests/concurrent/should_run/conc007
+/tests/concurrent/should_run/conc008
+/tests/concurrent/should_run/conc009
+/tests/concurrent/should_run/conc010
+/tests/concurrent/should_run/conc012
+/tests/concurrent/should_run/conc013
+/tests/concurrent/should_run/conc014
+/tests/concurrent/should_run/conc015
+/tests/concurrent/should_run/conc015a
+/tests/concurrent/should_run/conc016
+/tests/concurrent/should_run/conc017
+/tests/concurrent/should_run/conc017a
+/tests/concurrent/should_run/conc018
+/tests/concurrent/should_run/conc019
+/tests/concurrent/should_run/conc020
+/tests/concurrent/should_run/conc021
+/tests/concurrent/should_run/conc022
+/tests/concurrent/should_run/conc023
+/tests/concurrent/should_run/conc024
+/tests/concurrent/should_run/conc025
+/tests/concurrent/should_run/conc026
+/tests/concurrent/should_run/conc027
+/tests/concurrent/should_run/conc028
+/tests/concurrent/should_run/conc029
+/tests/concurrent/should_run/conc030
+/tests/concurrent/should_run/conc031
+/tests/concurrent/should_run/conc032
+/tests/concurrent/should_run/conc033
+/tests/concurrent/should_run/conc034
+/tests/concurrent/should_run/conc035
+/tests/concurrent/should_run/conc036
+/tests/concurrent/should_run/conc037
+/tests/concurrent/should_run/conc038
+/tests/concurrent/should_run/conc039
+/tests/concurrent/should_run/conc040
+/tests/concurrent/should_run/conc041
+/tests/concurrent/should_run/conc042
+/tests/concurrent/should_run/conc043
+/tests/concurrent/should_run/conc044
+/tests/concurrent/should_run/conc045
+/tests/concurrent/should_run/conc051
+/tests/concurrent/should_run/conc058
+/tests/concurrent/should_run/conc059
+/tests/concurrent/should_run/conc064
+/tests/concurrent/should_run/conc065
+/tests/concurrent/should_run/conc066
+/tests/concurrent/should_run/conc067
+/tests/concurrent/should_run/conc068
+/tests/concurrent/should_run/conc069
+/tests/concurrent/should_run/conc069a
+/tests/concurrent/should_run/conc070
+/tests/concurrent/should_run/conc071
+/tests/concurrent/should_run/conc072
+/tests/concurrent/should_run/conc073
+/tests/concurrent/should_run/foreignInterruptible
+/tests/concurrent/should_run/mask001
+/tests/concurrent/should_run/mask002
+/tests/concurrent/should_run/numsparks001
+/tests/concurrent/should_run/readMVar1
+/tests/concurrent/should_run/readMVar2
+/tests/concurrent/should_run/readMVar3
+/tests/concurrent/should_run/setnumcapabilities001
+/tests/concurrent/should_run/throwto001
+/tests/concurrent/should_run/throwto002
+/tests/concurrent/should_run/throwto003
+/tests/concurrent/should_run/tryReadMVar1
+/tests/concurrent/should_run/tryReadMVar2
+/tests/concurrent/should_run/threadstatus-9333
+/tests/cpranal/should_run/CPRRepeat
+/tests/deSugar/should_run/DsLambdaCase
+/tests/deSugar/should_run/DsMultiWayIf
+/tests/deSugar/should_run/T246
+/tests/deSugar/should_run/T3126
+/tests/deSugar/should_run/T3382
+/tests/deSugar/should_run/T5742
+/tests/deSugar/should_run/T8952
+/tests/deSugar/should_run/dsrun001
+/tests/deSugar/should_run/dsrun002
+/tests/deSugar/should_run/dsrun003
+/tests/deSugar/should_run/dsrun004
+/tests/deSugar/should_run/dsrun005
+/tests/deSugar/should_run/dsrun006
+/tests/deSugar/should_run/dsrun007
+/tests/deSugar/should_run/dsrun008
+/tests/deSugar/should_run/dsrun009
+/tests/deSugar/should_run/dsrun010
+/tests/deSugar/should_run/dsrun011
+/tests/deSugar/should_run/dsrun012
+/tests/deSugar/should_run/dsrun013
+/tests/deSugar/should_run/dsrun014
+/tests/deSugar/should_run/dsrun015
+/tests/deSugar/should_run/dsrun016
+/tests/deSugar/should_run/dsrun017
+/tests/deSugar/should_run/dsrun018
+/tests/deSugar/should_run/dsrun019
+/tests/deSugar/should_run/dsrun020
+/tests/deSugar/should_run/dsrun021
+/tests/deSugar/should_run/dsrun022
+/tests/deSugar/should_run/dsrun023
+/tests/deSugar/should_run/mc01
+/tests/deSugar/should_run/mc02
+/tests/deSugar/should_run/mc03
+/tests/deSugar/should_run/mc04
+/tests/deSugar/should_run/mc05
+/tests/deSugar/should_run/mc06
+/tests/deSugar/should_run/mc07
+/tests/deSugar/should_run/mc08
+/tests/deriving/should_run/T2529
+/tests/deriving/should_run/T4136
+/tests/deriving/should_run/T4528a
+/tests/deriving/should_run/T5041
+/tests/deriving/should_run/T5628
+/tests/deriving/should_run/T5712
+/tests/deriving/should_run/T7931
+/tests/deriving/should_run/T8280
+/tests/deriving/should_run/drvrun-foldable1
+/tests/deriving/should_run/drvrun-functor1
+/tests/deriving/should_run/drvrun001
+/tests/deriving/should_run/drvrun002
+/tests/deriving/should_run/drvrun003
+/tests/deriving/should_run/drvrun004
+/tests/deriving/should_run/drvrun005
+/tests/deriving/should_run/drvrun006
+/tests/deriving/should_run/drvrun007
+/tests/deriving/should_run/drvrun008
+/tests/deriving/should_run/drvrun009
+/tests/deriving/should_run/drvrun010
+/tests/deriving/should_run/drvrun011
+/tests/deriving/should_run/drvrun012
+/tests/deriving/should_run/drvrun013
+/tests/deriving/should_run/drvrun014
+/tests/deriving/should_run/drvrun015
+/tests/deriving/should_run/drvrun016
+/tests/deriving/should_run/drvrun017
+/tests/deriving/should_run/drvrun018
+/tests/deriving/should_run/drvrun019
+/tests/deriving/should_run/drvrun020
+/tests/deriving/should_run/drvrun021
+/tests/dph/classes/dph-classes-copy-fast
+/tests/dph/classes/dph-classes-fast
+/tests/dph/classes/dph-classes-vseg-fast
+/tests/dph/diophantine/dph-diophantine-copy-fast
+/tests/dph/diophantine/dph-diophantine-copy-opt
 /tests/dph/diophantine/dph-diophantine-fast
 /tests/dph/diophantine/dph-diophantine-opt
+/tests/dph/dotp/dph-dotp-copy-fast
+/tests/dph/dotp/dph-dotp-copy-opt
 /tests/dph/dotp/dph-dotp-fast
+/tests/dph/dotp/dph-dotp-opt
+/tests/dph/dotp/dph-dotp-vseg-fast
+/tests/dph/dotp/dph-dotp-vseg-opt
+/tests/dph/nbody/dph-nbody-copy-fast
+/tests/dph/nbody/dph-nbody-copy-opt
+/tests/dph/nbody/dph-nbody-vseg-fast
+/tests/dph/nbody/dph-nbody-vseg-opt
+/tests/dph/primespj/dph-primespj-copy-fast
+/tests/dph/primespj/dph-primespj-copy-opt
 /tests/dph/primespj/dph-primespj-fast
+/tests/dph/primespj/dph-primespj-opt
+/tests/dph/quickhull/dph-quickhull-copy-fast
+/tests/dph/quickhull/dph-quickhull-copy-opt
 /tests/dph/quickhull/dph-quickhull-fast
+/tests/dph/quickhull/dph-quickhull-opt
+/tests/dph/quickhull/dph-quickhull-vseg-fast
+/tests/dph/quickhull/dph-quickhull-vseg-opt
 /tests/dph/smvm/dph-smvm
+/tests/dph/smvm/dph-smvm-copy
+/tests/dph/smvm/dph-smvm-vseg
 /tests/dph/sumnats/dph-sumnats
+/tests/dph/sumnats/dph-sumnats-copy
+/tests/dph/sumnats/dph-sumnats-vseg
+/tests/dph/words/dph-words-copy-fast
+/tests/dph/words/dph-words-copy-opt
 /tests/dph/words/dph-words-fast
+/tests/dph/words/dph-words-opt
+/tests/dph/words/dph-words-vseg-fast
+/tests/dph/words/dph-words-vseg-opt
+/tests/driver/1959/E.hs
+/tests/driver/1959/prog
+/tests/driver/3674_pre
+/tests/driver/437/Test
+/tests/driver/437/Test2
+/tests/driver/5313
+/tests/driver/A012.ooo
+/tests/driver/A013.xhi
+/tests/driver/A061a.s
+/tests/driver/A061b.s
+/tests/driver/A064.hspp
+/tests/driver/A065.hspp
+/tests/driver/A066.tmp
+/tests/driver/A067.tmp
+/tests/driver/A070.s
+/tests/driver/A071.tmp
+/tests/driver/B022/C.ooo
+/tests/driver/B023/C.xhi
+/tests/driver/B024a/
+/tests/driver/B062d/
+/tests/driver/B062e/
+/tests/driver/F018a.obj.018
+/tests/driver/F018a_stub.obj.018
+/tests/driver/Hello062a.hs
+/tests/driver/Hello062b.hs
+/tests/driver/Hello062c.hs
+/tests/driver/T1959/E.hs
+/tests/driver/T1959/prog
+/tests/driver/T3007/A/Setup
+/tests/driver/T3007/A/dist/
+/tests/driver/T3007/B/Setup
+/tests/driver/T3007/B/dist/
+/tests/driver/T3007/package.conf
+/tests/driver/T3389
+/tests/driver/T3674_pre
+/tests/driver/T437/Test
+/tests/driver/T437/Test2
+/tests/driver/T4437
+/tests/driver/T5147/B.hs
+/tests/driver/T5198dump/
+/tests/driver/T5313
+/tests/driver/T5584/A.hi-boot
+/tests/driver/T5584_out/
+/tests/driver/T703
+/tests/driver/T706.hs
+/tests/driver/T7060dump/
+/tests/driver/T7373/package.conf
+/tests/driver/T7373/pkg/Setup
+/tests/driver/T7373/pkg/dist/
+/tests/driver/T7835/Test
+/tests/driver/T8526/A.inc
+/tests/driver/T8602/t8602.sh
+/tests/driver/Test.081b
+/tests/driver/Test.081b.hs
+/tests/driver/Test_081a
+/tests/driver/Test_081a.hs
+/tests/driver/depend200
+/tests/driver/dynHelloWorld
+/tests/driver/dynamicToo/A001.dyn_hi
+/tests/driver/dynamicToo/A001.dyn_o
+/tests/driver/dynamicToo/A002.dyn_hi
+/tests/driver/dynamicToo/A002.dyn_o
+/tests/driver/dynamicToo/A003.dyn_hi
+/tests/driver/dynamicToo/A003.dyn_o
+/tests/driver/dynamicToo/B001.dyn_hi
+/tests/driver/dynamicToo/B001.dyn_o
+/tests/driver/dynamicToo/B002.dyn_hi
+/tests/driver/dynamicToo/B002.dyn_o
+/tests/driver/dynamicToo/C001.dyn_hi
+/tests/driver/dynamicToo/C001.dyn_o
+/tests/driver/dynamicToo/C002.dyn_hi
+/tests/driver/dynamicToo/C002.dyn_o
+/tests/driver/dynamicToo/d001
+/tests/driver/dynamicToo/dynamicToo004/Setup
+/tests/driver/dynamicToo/dynamicToo004/local.package.conf/
+/tests/driver/dynamicToo/dynamicToo004/pkg1/dist/
+/tests/driver/dynamicToo/dynamicToo004/pkg1dyn/dist/
+/tests/driver/dynamicToo/dynamicToo004/pkg2/dist/
+/tests/driver/dynamicToo/dynamicToo004/progstatic
+/tests/driver/dynamicToo/s001
+/tests/driver/dynamic_flags_001/C
+/tests/driver/hello062a
+/tests/driver/hello062b
+/tests/driver/hello062c
+/tests/driver/hello062d
+/tests/driver/hello062e
+/tests/driver/objc/objc-hi
+/tests/driver/objc/objcpp-hi
+/tests/driver/out019/
+/tests/driver/recomp001/B.hs
+/tests/driver/recomp001/C
+/tests/driver/recomp003/Data/
+/tests/driver/recomp003/err
+/tests/driver/recomp004/MainX
+/tests/driver/recomp004/MainX.hs
+/tests/driver/recomp004/c.c
+/tests/driver/recomp005/C.hs
+/tests/driver/recomp006/B.hs
+/tests/driver/recomp006/err
+/tests/driver/recomp006/out
+/tests/driver/recomp007/Setup
+/tests/driver/recomp007/a1/dist/
+/tests/driver/recomp007/a2/dist/
+/tests/driver/recomp007/b/dist/
+/tests/driver/recomp007/local.package.conf/
+/tests/driver/recomp008/A.hs
+/tests/driver/recomp008/prog
 /tests/driver/recomp009/Main
 /tests/driver/recomp009/Sub.hs
+/tests/driver/recomp010/Main
+/tests/driver/recomp010/X.hs
+/tests/driver/recomp011/A.hsinc
+/tests/driver/recomp011/B.hsinc
+/tests/driver/recomp011/Main
+/tests/driver/recomp012/Foo.hs
+/tests/driver/recomp012/Main
+/tests/driver/recomp012/Main.hs
+/tests/driver/recomp012/MyBool.hs
+/tests/driver/rtsOpts
+/tests/driver/rtsopts002
+/tests/driver/spacesInArgs
+/tests/driver/stub017/
+/tests/driver/stub028/
+/tests/driver/stub035/
+/tests/driver/stub045/
+/tests/driver/withRtsOpts
+/tests/driver/withRtsOpts.out
+/tests/dynlibs/T3807-load
+/tests/dynlibs/T3807test.so
+/tests/dynlibs/T5373A
+/tests/dynlibs/T5373B
+/tests/dynlibs/T5373C
+/tests/dynlibs/T5373D
+/tests/ext-core/T7239.hcr
+/tests/ffi/should_run/1288
+/tests/ffi/should_run/1679
+/tests/ffi/should_run/2276
+/tests/ffi/should_run/2469
+/tests/ffi/should_run/2594
+/tests/ffi/should_run/2917a
+/tests/ffi/should_run/4038
+/tests/ffi/should_run/4221
+/tests/ffi/should_run/5402
+/tests/ffi/should_run/5594
+/tests/ffi/should_run/7170
+/tests/ffi/should_run/Capi_Ctype_001
+/tests/ffi/should_run/Capi_Ctype_001.hs
+/tests/ffi/should_run/Capi_Ctype_002
+/tests/ffi/should_run/Capi_Ctype_A_001.hs
+/tests/ffi/should_run/Capi_Ctype_A_002.hs
+/tests/ffi/should_run/T1288
+/tests/ffi/should_run/T1679
+/tests/ffi/should_run/T2276
+/tests/ffi/should_run/T2469
+/tests/ffi/should_run/T2594
+/tests/ffi/should_run/T2917a
+/tests/ffi/should_run/T4012
+/tests/ffi/should_run/T4038
+/tests/ffi/should_run/T4221
+/tests/ffi/should_run/T5402
+/tests/ffi/should_run/T5594
+/tests/ffi/should_run/T7170
+/tests/ffi/should_run/T8083
+/tests/ffi/should_run/capi_value
+/tests/ffi/should_run/fed001
+/tests/ffi/should_run/ffi001
+/tests/ffi/should_run/ffi002
+/tests/ffi/should_run/ffi003
+/tests/ffi/should_run/ffi005
+/tests/ffi/should_run/ffi006
+/tests/ffi/should_run/ffi007
+/tests/ffi/should_run/ffi008
+/tests/ffi/should_run/ffi009
+/tests/ffi/should_run/ffi010
+/tests/ffi/should_run/ffi011
+/tests/ffi/should_run/ffi013
+/tests/ffi/should_run/ffi014
+/tests/ffi/should_run/ffi015
+/tests/ffi/should_run/ffi016
+/tests/ffi/should_run/ffi017
+/tests/ffi/should_run/ffi018
+/tests/ffi/should_run/ffi019
+/tests/ffi/should_run/ffi020
+/tests/ffi/should_run/ffi021
+/tests/ffi/should_run/ffi022
+/tests/ffi/should_run/ffi_parsing_001
+/tests/ffi/should_run/fptr01
+/tests/ffi/should_run/fptr02
+/tests/ffi/should_run/fptrfail01
+/tests/gadt/CasePrune
+/tests/gadt/Session
+/tests/gadt/T9380
+/tests/gadt/gadt2
+/tests/gadt/gadt23
+/tests/gadt/gadt4
+/tests/gadt/gadt5
+/tests/gadt/records
+/tests/gadt/tc
+/tests/gadt/type-rep
+/tests/gadt/ubx-records
+/tests/gadt/while
+/tests/generics/GEq/GEq1
+/tests/generics/GEq/GEq2
+/tests/generics/GFunctor/GFunctor1
+/tests/generics/GMap/GMap1
+/tests/generics/GShow/GShow1
+/tests/generics/GenNewtype
+/tests/generics/Uniplate/GUniplate1
+/tests/ghc-api/T4891/T4891
+/tests/ghc-api/T6145
+/tests/ghc-api/T7478/A
+/tests/ghc-api/T7478/T7478
+/tests/ghc-api/T8628
+/tests/ghc-api/T8639_api
+/tests/ghc-api/apirecomp001/myghc
+/tests/ghc-api/dynCompileExpr/dynCompileExpr
+/tests/ghc-api/ghcApi
+/tests/ghci.debugger/scripts/break022/A.hs
+/tests/ghci.debugger/scripts/break023/A.hs
+/tests/ghci/linking/dir001/
+/tests/ghci/linking/dir002/
+/tests/ghci/linking/dir004/
+/tests/ghci/linking/dir005/
+/tests/ghci/linking/dir006/
+/tests/ghci/prog001/C.hs
+/tests/ghci/prog001/D.hs
+/tests/ghci/prog002/A.hs
+/tests/ghci/prog003/D.hs
+/tests/ghci/prog004/ctest.c
+/tests/ghci/prog005/A.hs
+/tests/ghci/prog006/Boot.hs
+/tests/ghci/prog009/A.hs
+/tests/ghci/prog012/Bar.hs
+/tests/ghci/scripts/Ghci058.hs
+/tests/ghci/scripts/T1914A.hs
+/tests/ghci/scripts/T1914B.hs
+/tests/ghci/scripts/T6106.hs
+/tests/ghci/scripts/T6106_preproc
+/tests/ghci/scripts/föøbàr1.hs
+/tests/ghci/scripts/föøbàr2.hs
+/tests/ghci/scripts/ghci027.hs
+/tests/ghci/should_run/3171.err
+/tests/hsc2hs/3837.hs
+/tests/hsc2hs/T3837.hs
+/tests/hsc2hs/hsc2hs001.hs
+/tests/hsc2hs/hsc2hs002.hs
+/tests/hsc2hs/hsc2hs003
+/tests/hsc2hs/hsc2hs003.hs
+/tests/hsc2hs/hsc2hs004
+/tests/hsc2hs/hsc2hs004.hs
+/tests/indexed-types/should_fail/T8129.trace
+/tests/indexed-types/should_run/GMapAssoc
+/tests/indexed-types/should_run/GMapTop
+/tests/indexed-types/should_run/T2985
+/tests/indexed-types/should_run/T4235
+/tests/indexed-types/should_run/T5719
+/tests/lib/Concurrent/4876
+/tests/lib/Concurrent/ThreadDelay001
+/tests/lib/Data.ByteString/bytestring002
+/tests/lib/Data.ByteString/bytestring003
+/tests/lib/Data.ByteString/bytestring006
+/tests/lib/IO/2122
+/tests/lib/IO/2122-test
+/tests/lib/IO/3307
+/tests/lib/IO/4808
+/tests/lib/IO/4808.test
+/tests/lib/IO/4855
+/tests/lib/IO/4895
+/tests/lib/IO/IOError001
+/tests/lib/IO/IOError002
+/tests/lib/IO/T4113
+/tests/lib/IO/T4144
+/tests/lib/IO/chinese-file-*
+/tests/lib/IO/chinese-name
+/tests/lib/IO/concio002
+/tests/lib/IO/countReaders001
+/tests/lib/IO/countReaders001.txt
+/tests/lib/IO/decodingerror001
+/tests/lib/IO/decodingerror002
+/tests/lib/IO/encoding001
+/tests/lib/IO/encoding001.utf16
+/tests/lib/IO/encoding001.utf16.utf16be
+/tests/lib/IO/encoding001.utf16.utf16le
+/tests/lib/IO/encoding001.utf16.utf32
+/tests/lib/IO/encoding001.utf16.utf32be
+/tests/lib/IO/encoding001.utf16.utf32le
+/tests/lib/IO/encoding001.utf16.utf8
+/tests/lib/IO/encoding001.utf16.utf8_bom
+/tests/lib/IO/encoding001.utf16be
+/tests/lib/IO/encoding001.utf16be.utf16
+/tests/lib/IO/encoding001.utf16be.utf16le
+/tests/lib/IO/encoding001.utf16be.utf32
+/tests/lib/IO/encoding001.utf16be.utf32be
+/tests/lib/IO/encoding001.utf16be.utf32le
+/tests/lib/IO/encoding001.utf16be.utf8
+/tests/lib/IO/encoding001.utf16be.utf8_bom
+/tests/lib/IO/encoding001.utf16le
+/tests/lib/IO/encoding001.utf16le.utf16
+/tests/lib/IO/encoding001.utf16le.utf16be
+/tests/lib/IO/encoding001.utf16le.utf32
+/tests/lib/IO/encoding001.utf16le.utf32be
+/tests/lib/IO/encoding001.utf16le.utf32le
+/tests/lib/IO/encoding001.utf16le.utf8
+/tests/lib/IO/encoding001.utf16le.utf8_bom
+/tests/lib/IO/encoding001.utf32
+/tests/lib/IO/encoding001.utf32.utf16
+/tests/lib/IO/encoding001.utf32.utf16be
+/tests/lib/IO/encoding001.utf32.utf16le
+/tests/lib/IO/encoding001.utf32.utf32be
+/tests/lib/IO/encoding001.utf32.utf32le
+/tests/lib/IO/encoding001.utf32.utf8
+/tests/lib/IO/encoding001.utf32.utf8_bom
+/tests/lib/IO/encoding001.utf32be
+/tests/lib/IO/encoding001.utf32be.utf16
+/tests/lib/IO/encoding001.utf32be.utf16be
+/tests/lib/IO/encoding001.utf32be.utf16le
+/tests/lib/IO/encoding001.utf32be.utf32
+/tests/lib/IO/encoding001.utf32be.utf32le
+/tests/lib/IO/encoding001.utf32be.utf8
+/tests/lib/IO/encoding001.utf32be.utf8_bom
+/tests/lib/IO/encoding001.utf32le
+/tests/lib/IO/encoding001.utf32le.utf16
+/tests/lib/IO/encoding001.utf32le.utf16be
+/tests/lib/IO/encoding001.utf32le.utf16le
+/tests/lib/IO/encoding001.utf32le.utf32
+/tests/lib/IO/encoding001.utf32le.utf32be
+/tests/lib/IO/encoding001.utf32le.utf8
+/tests/lib/IO/encoding001.utf32le.utf8_bom
+/tests/lib/IO/encoding001.utf8
+/tests/lib/IO/encoding001.utf8.utf16
+/tests/lib/IO/encoding001.utf8.utf16be
+/tests/lib/IO/encoding001.utf8.utf16le
+/tests/lib/IO/encoding001.utf8.utf32
+/tests/lib/IO/encoding001.utf8.utf32be
+/tests/lib/IO/encoding001.utf8.utf32le
+/tests/lib/IO/encoding001.utf8.utf8_bom
+/tests/lib/IO/encoding001.utf8_bom
+/tests/lib/IO/encoding001.utf8_bom.utf16
+/tests/lib/IO/encoding001.utf8_bom.utf16be
+/tests/lib/IO/encoding001.utf8_bom.utf16le
+/tests/lib/IO/encoding001.utf8_bom.utf32
+/tests/lib/IO/encoding001.utf8_bom.utf32be
+/tests/lib/IO/encoding001.utf8_bom.utf32le
+/tests/lib/IO/encoding001.utf8_bom.utf8
+/tests/lib/IO/encoding002
+/tests/lib/IO/encodingerror001
+/tests/lib/IO/environment001
+/tests/lib/IO/finalization001
+/tests/lib/IO/hClose001
+/tests/lib/IO/hClose001.tmp
+/tests/lib/IO/hClose002
+/tests/lib/IO/hClose002.tmp
+/tests/lib/IO/hClose003
+/tests/lib/IO/hDuplicateTo001
+/tests/lib/IO/hFileSize001
+/tests/lib/IO/hFileSize002
+/tests/lib/IO/hFileSize002.out
+/tests/lib/IO/hFlush001
+/tests/lib/IO/hFlush001.out
+/tests/lib/IO/hGetBuf001
+/tests/lib/IO/hGetBuffering001
+/tests/lib/IO/hGetChar001
+/tests/lib/IO/hGetLine001
+/tests/lib/IO/hGetLine002
+/tests/lib/IO/hGetLine003
+/tests/lib/IO/hGetPosn001
+/tests/lib/IO/hGetPosn001.out
+/tests/lib/IO/hIsEOF001
+/tests/lib/IO/hIsEOF002
+/tests/lib/IO/hIsEOF002.out
+/tests/lib/IO/hReady001
+/tests/lib/IO/hReady002
+/tests/lib/IO/hSeek001
+/tests/lib/IO/hSeek002
+/tests/lib/IO/hSeek003
+/tests/lib/IO/hSeek004
+/tests/lib/IO/hSeek004.out
+/tests/lib/IO/hSetBuffering002
+/tests/lib/IO/hSetBuffering003
+/tests/lib/IO/hSetBuffering004
+/tests/lib/IO/hSetEncoding001
+/tests/lib/IO/ioeGetErrorString001
+/tests/lib/IO/ioeGetFileName001
+/tests/lib/IO/ioeGetHandle001
+/tests/lib/IO/isEOF001
+/tests/lib/IO/misc001
+/tests/lib/IO/misc001.out
+/tests/lib/IO/newline001
+/tests/lib/IO/newline001.out
+/tests/lib/IO/openFile001
+/tests/lib/IO/openFile002
+/tests/lib/IO/openFile003
+/tests/lib/IO/openFile004
+/tests/lib/IO/openFile004.out
+/tests/lib/IO/openFile005
+/tests/lib/IO/openFile005.out1
+/tests/lib/IO/openFile005.out2
+/tests/lib/IO/openFile006
+/tests/lib/IO/openFile006.out
+/tests/lib/IO/openFile007
+/tests/lib/IO/openFile007.out
+/tests/lib/IO/openFile008
+/tests/lib/IO/openTempFile001
+/tests/lib/IO/putStr001
+/tests/lib/IO/readFile001
+/tests/lib/IO/readFile001.out
+/tests/lib/IO/readwrite001
+/tests/lib/IO/readwrite001.inout
+/tests/lib/IO/readwrite002
+/tests/lib/IO/readwrite002.inout
+/tests/lib/IO/readwrite003
+/tests/lib/IO/readwrite003.txt
+/tests/lib/IO/tmp
+/tests/lib/IOExts/echo001
+/tests/lib/IOExts/hGetBuf002
+/tests/lib/IOExts/hGetBuf003
+/tests/lib/IOExts/hPutBuf001
+/tests/lib/IOExts/hPutBuf002
+/tests/lib/IOExts/hPutBuf002.out
+/tests/lib/IOExts/hTell001
+/tests/lib/IOExts/hTell002
+/tests/lib/IOExts/performGC001
+/tests/lib/IOExts/trace001
+/tests/lib/IORef/
+/tests/lib/Numeric/
+/tests/lib/OldException/OldException001
+/tests/lib/PrettyPrint/T3911
+/tests/lib/PrettyPrint/pp1
+/tests/lib/Text.Printf/1548
+/tests/lib/Time/T5430
+/tests/lib/Time/time002
+/tests/lib/Time/time003
+/tests/lib/Time/time004
+/tests/lib/exceptions/exceptions001
+/tests/lib/integer/IntegerConversionRules.simpl
+/tests/lib/integer/fromToInteger.simpl
+/tests/lib/integer/gcdInteger
+/tests/lib/integer/integerBits
+/tests/lib/integer/integerConstantFolding
+/tests/lib/integer/integerConstantFolding.simpl
+/tests/lib/integer/integerConversions
+/tests/lib/integer/integerGmpInternals
+/tests/lib/libposix/po003.out
+/tests/lib/libposix/posix002
+/tests/lib/libposix/posix003
+/tests/lib/libposix/posix004
+/tests/lib/libposix/posix006
+/tests/lib/libposix/posix009
+/tests/lib/libposix/posix010
+/tests/lib/libposix/posix014
+/tests/lib/should_run/4006
+/tests/lib/should_run/addr001
+/tests/lib/should_run/array001
+/tests/lib/should_run/array001.data
+/tests/lib/should_run/char001
+/tests/lib/should_run/char002
+/tests/lib/should_run/cstring001
+/tests/lib/should_run/dynamic001
+/tests/lib/should_run/dynamic002
+/tests/lib/should_run/dynamic003
+/tests/lib/should_run/dynamic004
+/tests/lib/should_run/dynamic005
+/tests/lib/should_run/enum01
+/tests/lib/should_run/enum02
+/tests/lib/should_run/enum03
+/tests/lib/should_run/enum04
+/tests/lib/should_run/exceptionsrun001
+/tests/lib/should_run/exceptionsrun002
+/tests/lib/should_run/length001
+/tests/lib/should_run/list001
+/tests/lib/should_run/list002
+/tests/lib/should_run/list003
+/tests/lib/should_run/memo001
+/tests/lib/should_run/memo002
+/tests/lib/should_run/rand001
+/tests/lib/should_run/ratio001
+/tests/lib/should_run/reads001
+/tests/lib/should_run/show001
+/tests/lib/should_run/stableptr001
+/tests/lib/should_run/stableptr003
+/tests/lib/should_run/stableptr004
+/tests/lib/should_run/stableptr005
+/tests/lib/should_run/text001
+/tests/lib/should_run/tup001
+/tests/lib/should_run/weak001
+/tests/mdo/should_compile/mdo001
+/tests/mdo/should_compile/mdo002
+/tests/mdo/should_compile/mdo003
+/tests/mdo/should_compile/mdo004
+/tests/mdo/should_compile/mdo005
+/tests/mdo/should_fail/mdofail006
+/tests/mdo/should_run/mdorun001
+/tests/mdo/should_run/mdorun002
+/tests/mdo/should_run/mdorun003
+/tests/mdo/should_run/mdorun004
+/tests/mdo/should_run/mdorun005
+/tests/module/Mod145_A.mod146_hi
+/tests/module/Mod145_A.mod146_o
+/tests/module/Mod157_A.mod158_hi
+/tests/module/Mod157_A.mod158_o
+/tests/module/Mod157_B.mod158_hi
+/tests/module/Mod157_B.mod158_o
+/tests/module/Mod157_C.mod158_hi
+/tests/module/Mod157_C.mod158_o
+/tests/module/Mod157_D.mod158_hi
+/tests/module/Mod157_D.mod158_o
+/tests/module/Mod159_A.mod160_hi
+/tests/module/Mod159_A.mod160_o
+/tests/module/Mod159_B.mod160_hi
+/tests/module/Mod159_B.mod160_o
+/tests/module/Mod159_C.mod160_hi
+/tests/module/Mod159_C.mod160_o
+/tests/module/Mod159_D.mod160_hi
+/tests/module/Mod159_D.mod160_o
+/tests/module/Mod164_A.mod165_hi
+/tests/module/Mod164_A.mod165_o
+/tests/module/Mod164_A.mod166_hi
+/tests/module/Mod164_A.mod166_o
+/tests/module/Mod164_A.mod167_hi
+/tests/module/Mod164_A.mod167_o
+/tests/module/Mod164_B.mod165_hi
+/tests/module/Mod164_B.mod165_o
+/tests/module/Mod164_B.mod166_hi
+/tests/module/Mod164_B.mod166_o
+/tests/module/Mod164_B.mod167_hi
+/tests/module/Mod164_B.mod167_o
+/tests/module/mod166.mod166_hi
+/tests/module/mod166.mod166_o
+/tests/module/mod167.mod167_hi
+/tests/module/mod167.mod167_o
+/tests/module/mod175/test
+/tests/module/mod175/test2
+/tests/module/mod179
+/tests/numeric/should_run/3676
+/tests/numeric/should_run/4381
+/tests/numeric/should_run/4383
+/tests/numeric/should_run/CarryOverflow
+/tests/numeric/should_run/NumDecimals
+/tests/numeric/should_run/T3676
+/tests/numeric/should_run/T4381
+/tests/numeric/should_run/T4383
+/tests/numeric/should_run/T5863
+/tests/numeric/should_run/T7014
+/tests/numeric/should_run/T7014.simpl
+/tests/numeric/should_run/T7233
+/tests/numeric/should_run/T7689
+/tests/numeric/should_run/T8726
+/tests/numeric/should_run/add2
+/tests/numeric/should_run/arith001
+/tests/numeric/should_run/arith002
+/tests/numeric/should_run/arith003
+/tests/numeric/should_run/arith004
+/tests/numeric/should_run/arith005
+/tests/numeric/should_run/arith006
+/tests/numeric/should_run/arith007
+/tests/numeric/should_run/arith008
+/tests/numeric/should_run/arith009
+/tests/numeric/should_run/arith010
+/tests/numeric/should_run/arith011
+/tests/numeric/should_run/arith012
+/tests/numeric/should_run/arith013
+/tests/numeric/should_run/arith014
+/tests/numeric/should_run/arith015
+/tests/numeric/should_run/arith016
+/tests/numeric/should_run/arith017
+/tests/numeric/should_run/arith018
+/tests/numeric/should_run/arith019
+/tests/numeric/should_run/expfloat
+/tests/numeric/should_run/mul2
+/tests/numeric/should_run/numrun009
+/tests/numeric/should_run/numrun010
+/tests/numeric/should_run/numrun011
+/tests/numeric/should_run/numrun012
+/tests/numeric/should_run/numrun013
+/tests/numeric/should_run/numrun014
+/tests/numeric/should_run/quotRem2
+/tests/optasm-log
+/tests/optllvm-32-log
+/tests/optllvm-log
+/tests/overloadedlists/should_run/overloadedlistsrun01
+/tests/overloadedlists/should_run/overloadedlistsrun02
+/tests/overloadedlists/should_run/overloadedlistsrun03
+/tests/overloadedlists/should_run/overloadedlistsrun04
+/tests/overloadedlists/should_run/overloadedlistsrun05
+/tests/parser/should_compile/T5243
+/tests/parser/should_compile/T7476/Main.imports
+/tests/parser/should_compile/T7476/T7476
+/tests/parser/should_run/BinaryLiterals0
+/tests/parser/should_run/BinaryLiterals1
+/tests/parser/should_run/BinaryLiterals2
+/tests/parser/should_run/ParserMultiWayIf
+/tests/parser/should_run/T1344
+/tests/parser/should_run/operator
+/tests/parser/should_run/operator2
+/tests/parser/should_run/readRun001
+/tests/parser/should_run/readRun002
+/tests/parser/should_run/readRun003
+/tests/parser/should_run/readRun004
+/tests/parser/unicode/1744
+/tests/parser/unicode/T1744
+/tests/parser/unicode/utf8_024
+/tests/patsyn/should_run/bidir-explicit
+/tests/patsyn/should_run/bidir-explicit-scope
+/tests/patsyn/should_run/eval
+/tests/patsyn/should_run/ex-prov
+/tests/patsyn/should_run/ex-prov-run
+/tests/patsyn/should_run/match
+/tests/perf/compiler/T1969.comp.stats
+/tests/perf/compiler/T3064.comp.stats
+/tests/perf/compiler/T3294.comp.stats
+/tests/perf/compiler/T4801.comp.stats
+/tests/perf/compiler/T5030.comp.stats
+/tests/perf/compiler/T5321FD.comp.stats
+/tests/perf/compiler/T5321Fun.comp.stats
+/tests/perf/compiler/T5631.comp.stats
+/tests/perf/compiler/T5642.comp.stats
+/tests/perf/compiler/T5837.comp.stats
+/tests/perf/compiler/T6048.comp.stats
+/tests/perf/compiler/T783.comp.stats
+/tests/perf/compiler/parsing001.comp.stats
+/tests/perf/should_run/3586
+/tests/perf/should_run/3586.stats
+/tests/perf/should_run/Conversions
+/tests/perf/should_run/Conversions.stats
+/tests/perf/should_run/InlineArrayAlloc
+/tests/perf/should_run/InlineByteArrayAlloc
+/tests/perf/should_run/InlineCloneArrayAlloc
+/tests/perf/should_run/MethSharing
+/tests/perf/should_run/MethSharing.stats
+/tests/perf/should_run/T149_A
+/tests/perf/should_run/T149_B
+/tests/perf/should_run/T2902_A
+/tests/perf/should_run/T2902_B
+/tests/perf/should_run/T3245
+/tests/perf/should_run/T3586
+/tests/perf/should_run/T3736
+/tests/perf/should_run/T3736.speed.f32
+/tests/perf/should_run/T3738
+/tests/perf/should_run/T3738.stats
+/tests/perf/should_run/T4267
+/tests/perf/should_run/T4321
+/tests/perf/should_run/T4474a
+/tests/perf/should_run/T4474a.stats
+/tests/perf/should_run/T4474b
+/tests/perf/should_run/T4474b.stats
+/tests/perf/should_run/T4474c
+/tests/perf/should_run/T4474c.stats
+/tests/perf/should_run/T4830
+/tests/perf/should_run/T4830.stats
+/tests/perf/should_run/T4978
+/tests/perf/should_run/T4978.stats
+/tests/perf/should_run/T5113
+/tests/perf/should_run/T5113.stats
+/tests/perf/should_run/T5205
+/tests/perf/should_run/T5205.stats
+/tests/perf/should_run/T5237
+/tests/perf/should_run/T5237.stats
+/tests/perf/should_run/T5536
+/tests/perf/should_run/T5536.data
+/tests/perf/should_run/T5536.stats
+/tests/perf/should_run/T5549
+/tests/perf/should_run/T5549.stats
+/tests/perf/should_run/T5949
+/tests/perf/should_run/T7257
+/tests/perf/should_run/T7257.stats
+/tests/perf/should_run/T7436
+/tests/perf/should_run/T7436.stats
+/tests/perf/should_run/T7507
+/tests/perf/should_run/T7619
+/tests/perf/should_run/T7797
+/tests/perf/should_run/T7850
+/tests/perf/should_run/T7954
+/tests/perf/should_run/T876
+/tests/perf/should_run/T9203
+/tests/perf/should_run/T9339
+/tests/perf/should_run/lazy-bs-alloc
+/tests/perf/should_run/lazy-bs-alloc.stats
+/tests/perf/should_run/speed.f32
+/tests/perf/space_leaks/T2762
+/tests/perf/space_leaks/T2762.stats
+/tests/perf/space_leaks/T4018
+/tests/perf/space_leaks/T4334
+/tests/perf/space_leaks/T4334.stats
+/tests/perf/space_leaks/space_leak_001
+/tests/perf/space_leaks/space_leak_001.stats
+/tests/plugins/plugins01
+/tests/plugins/plugins05
+/tests/plugins/plugins06
 /tests/plugins/simple-plugin/dist/
 /tests/plugins/simple-plugin/install/
 /tests/plugins/simple-plugin/local.package.conf
+/tests/plugins/simple-plugin/pkg.plugins01/
+/tests/plugins/simple-plugin/pkg.plugins02/
+/tests/plugins/simple-plugin/pkg.plugins03/
 /tests/plugins/simple-plugin/setup
+/tests/polykinds/Freeman
+/tests/polykinds/MonoidsFD
+/tests/polykinds/MonoidsTF
+/tests/polykinds/PolyKinds09
+/tests/polykinds/PolyKinds10
+/tests/primops/should_run/T6135
+/tests/primops/should_run/T7689
+/tests/profiling/should_compile/prof001
+/tests/profiling/should_compile/prof002
+/tests/profiling/should_run/2592
+/tests/profiling/should_run/2592.aux
+/tests/profiling/should_run/2592.hp
+/tests/profiling/should_run/2592.ps
+/tests/profiling/should_run/5314
+/tests/profiling/should_run/5314.hp
+/tests/profiling/should_run/5314.ps
+/tests/profiling/should_run/T2552
+/tests/profiling/should_run/T2592
+/tests/profiling/should_run/T3001
+/tests/profiling/should_run/T3001-2
+/tests/profiling/should_run/T3001-2.hp
+/tests/profiling/should_run/T3001-2.ps
+/tests/profiling/should_run/T3001.hp
+/tests/profiling/should_run/T3001.ps
+/tests/profiling/should_run/T5314
+/tests/profiling/should_run/T5363
+/tests/profiling/should_run/T5559
+/tests/profiling/should_run/T680
+/tests/profiling/should_run/T949
+/tests/profiling/should_run/T949.hp
+/tests/profiling/should_run/T949.ps
+/tests/profiling/should_run/callstack001
+/tests/profiling/should_run/callstack002
+/tests/profiling/should_run/heapprof001
+/tests/profiling/should_run/heapprof001.hp
+/tests/profiling/should_run/heapprof001.ps
+/tests/profiling/should_run/ioprof
+/tests/profiling/should_run/prof-doc-fib
+/tests/profiling/should_run/prof-doc-last
+/tests/profiling/should_run/profinline001
+/tests/profiling/should_run/scc001
+/tests/profiling/should_run/scc002
+/tests/profiling/should_run/scc003
+/tests/profiling/should_run/scc004
+/tests/profiling/should_run/test.bin
+/tests/programs/10queens/10queens
+/tests/programs/Queens/queens
+/tests/programs/andre_monad/andre_monad
+/tests/programs/andy_cherry/andy_cherry
+/tests/programs/barton-mangler-bug/barton-mangler-bug
+/tests/programs/cholewo-eval/cholewo-eval
+/tests/programs/cvh_unboxing/cvh_unboxing
+/tests/programs/fast2haskell/fast2haskell
+/tests/programs/fun_insts/fun_insts
 /tests/programs/hs-boot/Main
+/tests/programs/jl_defaults/jl_defaults
+/tests/programs/joao-circular/joao-circular
+/tests/programs/jq_readsPrec/jq_readsPrec
+/tests/programs/jtod_circint/jtod_circint
+/tests/programs/jules_xref/jules_xref
+/tests/programs/jules_xref2/jules_xref2
+/tests/programs/launchbury/launchbury
+/tests/programs/lennart_range/lennart_range
+/tests/programs/lex/lex
+/tests/programs/life_space_leak/life_space_leak
+/tests/programs/north_array/north_array
+/tests/programs/record_upd/record_upd
+/tests/programs/rittri/rittri
+/tests/programs/sanders_array/sanders_array
+/tests/programs/seward-space-leak/seward-space-leak
+/tests/programs/strict_anns/strict_anns
+/tests/programs/thurston-modular-arith/thurston-modular-arith
+/tests/quasiquotation/T4491/T4491
+/tests/quasiquotation/T7918
+/tests/rebindable/T5038
+/tests/rebindable/rebindable10
+/tests/rebindable/rebindable2
+/tests/rebindable/rebindable3
+/tests/rebindable/rebindable4
+/tests/rebindable/rebindable5
+/tests/rebindable/rebindable7
+/tests/rename/prog006/local.package.conf
+/tests/rename/prog006/pkg.conf
+/tests/rename/prog006/pwd
+/tests/rename/should_compile/T1792_imports.imports
+/tests/rename/should_compile/T4239.imports
+/tests/rename/should_compile/T4240.imports
+/tests/rename/should_compile/T5592
+/tests/rts/2047
+/tests/rts/2783
+/tests/rts/3236
+/tests/rts/3424
+/tests/rts/4059
+/tests/rts/4850
+/tests/rts/5250
+/tests/rts/5644/5644
+/tests/rts/5993
+/tests/rts/7087
+/tests/rts/T2047
+/tests/rts/T2615
+/tests/rts/T2783
+/tests/rts/T3236
+/tests/rts/T3424
+/tests/rts/T4059
+/tests/rts/T4850
+/tests/rts/T5250
+/tests/rts/T5423
+/tests/rts/T5435*.so
+/tests/rts/T5435*_o
+/tests/rts/T5435_dyn_asm
+/tests/rts/T5435_dyn_gcc
+/tests/rts/T5435_v_asm
+/tests/rts/T5435_v_gcc
+/tests/rts/T5644/T5644
+/tests/rts/T5993
+/tests/rts/T6006
+/tests/rts/T7037
+/tests/rts/T7037_main
+/tests/rts/T7040
+/tests/rts/T7087
+/tests/rts/T7160
+/tests/rts/T7227
+/tests/rts/T7227.stat
+/tests/rts/T7636
+/tests/rts/T7815
+/tests/rts/T7919
+/tests/rts/T8035
+/tests/rts/T8124
+/tests/rts/T8209
+/tests/rts/T8242
+/tests/rts/T9045
+/tests/rts/T9078
+/tests/rts/atomicinc
+/tests/rts/bug1010
+/tests/rts/derefnull
+/tests/rts/divbyzero
+/tests/rts/exec_signals
+/tests/rts/exec_signals_child
+/tests/rts/exec_signals_prepare
+/tests/rts/ffishutdown
+/tests/rts/libfoo_T2615.so
+/tests/rts/linker_unload
+/tests/rts/outofmem
+/tests/rts/outofmem2
+/tests/rts/overflow1
+/tests/rts/overflow2
+/tests/rts/overflow3
+/tests/rts/prep.out
+/tests/rts/return_mem_to_os
+/tests/rts/rtsflags001
+/tests/rts/rtsflags002
+/tests/rts/stablename001
+/tests/rts/stack001
+/tests/rts/stack002
+/tests/rts/stack003
+/tests/rts/testblockalloc
+/tests/rts/testwsdeque
+/tests/rts/traceEvent
+/tests/safeHaskell/check/Check04
 /tests/safeHaskell/check/pkg01/dist/
 /tests/safeHaskell/check/pkg01/install/
 /tests/safeHaskell/check/pkg01/local.db/
+/tests/safeHaskell/check/pkg01/pdb.ImpSafeOnly01/
+/tests/safeHaskell/check/pkg01/pdb.ImpSafeOnly02/
+/tests/safeHaskell/check/pkg01/pdb.ImpSafeOnly03/
+/tests/safeHaskell/check/pkg01/pdb.ImpSafeOnly04/
+/tests/safeHaskell/check/pkg01/pdb.ImpSafeOnly05/
+/tests/safeHaskell/check/pkg01/pdb.ImpSafeOnly06/
+/tests/safeHaskell/check/pkg01/pdb.ImpSafeOnly07/
+/tests/safeHaskell/check/pkg01/pdb.ImpSafeOnly08/
+/tests/safeHaskell/check/pkg01/pdb.ImpSafeOnly09/
+/tests/safeHaskell/check/pkg01/pdb.ImpSafeOnly10/
+/tests/safeHaskell/check/pkg01/pdb.safePkg01/
 /tests/safeHaskell/check/pkg01/setup
-mk/ghc-config
-tests/annotations/should_run/Config.hs
-tests/annotations/should_run/annrun01
-tests/array/should_run/arr001
-tests/array/should_run/arr002
-tests/array/should_run/arr003
-tests/array/should_run/arr004
-tests/array/should_run/arr005
-tests/array/should_run/arr006
-tests/array/should_run/arr007
-tests/array/should_run/arr008
-tests/array/should_run/arr009
-tests/array/should_run/arr010
-tests/array/should_run/arr011
-tests/array/should_run/arr012
-tests/array/should_run/arr013
-tests/array/should_run/arr014
-tests/array/should_run/arr015
-tests/array/should_run/arr016
-tests/array/should_run/arr017
-tests/array/should_run/arr018
-tests/array/should_run/arr019
-tests/array/should_run/arr020
-tests/arrows/should_run/T3822
-tests/arrows/should_run/arrowrun001
-tests/arrows/should_run/arrowrun002
-tests/arrows/should_run/arrowrun003
-tests/arrows/should_run/arrowrun004
-tests/boxy/T2193
-tests/cabal/1750.hs
-tests/cabal/1750.out
-tests/cabal/T1750.hs
-tests/cabal/T1750.out
-tests/cabal/cabal01/dist/
-tests/cabal/cabal01/install/
-tests/cabal/cabal01/local.db/
-tests/cabal/cabal01/setup
-tests/cabal/cabal03/Setup
-tests/cabal/cabal03/p/dist/
-tests/cabal/cabal03/q/dist/
-tests/cabal/cabal03/tmp.d/
-tests/cabal/cabal04/Setup
-tests/cabal/cabal04/dist/
-tests/cabal/cabal04/err
-tests/cabal/local01.package.conf/
-tests/cabal/local03.package.conf/
-tests/cabal/local04.package.conf/
-tests/cabal/local05a.package.conf/
-tests/cabal/local05b.package.conf/
-tests/cabal/local06.package.conf/
-tests/cabal/local1750.package.conf/
-tests/cabal/localT1750.package.conf/
-tests/cabal/localshadow1.package.conf/
-tests/cabal/localshadow2.package.conf/
-tests/cabal/package.conf.ghcpkg02/
-tests/cabal/shadow.hs
-tests/cabal/shadow1.out
-tests/cabal/shadow2.out
-tests/cabal/shadow3.out
-tests/codeGen/should_compile/2578
-tests/codeGen/should_compile/T2578
-tests/codeGen/should_gen_asm/memcpy-unroll-conprop.s
-tests/codeGen/should_gen_asm/memcpy-unroll.s
-tests/codeGen/should_gen_asm/memcpy.s
-tests/codeGen/should_run/1852
-tests/codeGen/should_run/1861
-tests/codeGen/should_run/2080
-tests/codeGen/should_run/2838
-tests/codeGen/should_run/3207
-tests/codeGen/should_run/3561
-tests/codeGen/should_run/3677
-tests/codeGen/should_run/4441
-tests/codeGen/should_run/5129
-tests/codeGen/should_run/5149
-tests/codeGen/should_run/5626
-tests/codeGen/should_run/5747
-tests/codeGen/should_run/5785
-tests/codeGen/should_run/6146
-tests/codeGen/should_run/T1852
-tests/codeGen/should_run/T1861
-tests/codeGen/should_run/T2080
-tests/codeGen/should_run/T2838
-tests/codeGen/should_run/T3207
-tests/codeGen/should_run/T3561
-tests/codeGen/should_run/T3677
-tests/codeGen/should_run/T4441
-tests/codeGen/should_run/T5129
-tests/codeGen/should_run/T5149
-tests/codeGen/should_run/T5626
-tests/codeGen/should_run/T5747
-tests/codeGen/should_run/T5785
-tests/codeGen/should_run/T5900
-tests/codeGen/should_run/T6146
-tests/codeGen/should_run/T7163
-tests/codeGen/should_run/T7319
-tests/codeGen/should_run/T7361
-tests/codeGen/should_run/T7600
-tests/codeGen/should_run/Word2Float64
-tests/codeGen/should_run/cgrun001
-tests/codeGen/should_run/cgrun002
-tests/codeGen/should_run/cgrun003
-tests/codeGen/should_run/cgrun004
-tests/codeGen/should_run/cgrun005
-tests/codeGen/should_run/cgrun006
-tests/codeGen/should_run/cgrun007
-tests/codeGen/should_run/cgrun008
-tests/codeGen/should_run/cgrun009
-tests/codeGen/should_run/cgrun010
-tests/codeGen/should_run/cgrun011
-tests/codeGen/should_run/cgrun012
-tests/codeGen/should_run/cgrun013
-tests/codeGen/should_run/cgrun014
-tests/codeGen/should_run/cgrun015
-tests/codeGen/should_run/cgrun016
-tests/codeGen/should_run/cgrun017
-tests/codeGen/should_run/cgrun018
-tests/codeGen/should_run/cgrun019
-tests/codeGen/should_run/cgrun020
-tests/codeGen/should_run/cgrun021
-tests/codeGen/should_run/cgrun022
-tests/codeGen/should_run/cgrun024
-tests/codeGen/should_run/cgrun026
-tests/codeGen/should_run/cgrun027
-tests/codeGen/should_run/cgrun028
-tests/codeGen/should_run/cgrun031
-tests/codeGen/should_run/cgrun032
-tests/codeGen/should_run/cgrun033
-tests/codeGen/should_run/cgrun034
-tests/codeGen/should_run/cgrun035
-tests/codeGen/should_run/cgrun036
-tests/codeGen/should_run/cgrun037
-tests/codeGen/should_run/cgrun038
-tests/codeGen/should_run/cgrun039
-tests/codeGen/should_run/cgrun040
-tests/codeGen/should_run/cgrun043
-tests/codeGen/should_run/cgrun044
-tests/codeGen/should_run/cgrun045
-tests/codeGen/should_run/cgrun046
-tests/codeGen/should_run/cgrun047
-tests/codeGen/should_run/cgrun048
-tests/codeGen/should_run/cgrun049
-tests/codeGen/should_run/cgrun050
-tests/codeGen/should_run/cgrun051
-tests/codeGen/should_run/cgrun052
-tests/codeGen/should_run/cgrun053
-tests/codeGen/should_run/cgrun054
-tests/codeGen/should_run/cgrun055
-tests/codeGen/should_run/cgrun056
-tests/codeGen/should_run/cgrun057
-tests/codeGen/should_run/cgrun058
-tests/codeGen/should_run/cgrun059
-tests/codeGen/should_run/cgrun060
-tests/codeGen/should_run/cgrun061
-tests/codeGen/should_run/cgrun062
-tests/codeGen/should_run/cgrun063
-tests/codeGen/should_run/cgrun064
-tests/codeGen/should_run/cgrun065
-tests/codeGen/should_run/cgrun066
-tests/codeGen/should_run/cgrun067
-tests/codeGen/should_run/cgrun068
-tests/codeGen/should_run/cgrun069
-tests/codeGen/should_run/cgrun070
-tests/codeGen/should_run/cgrun071
-tests/codeGen/should_run/setByteArray
-tests/concurrent/prog001/concprog001
-tests/concurrent/prog002/concprog002
-tests/concurrent/prog002/concprog002.aux
-tests/concurrent/prog002/concprog002.hp
-tests/concurrent/prog002/concprog002.ps
-tests/concurrent/prog003/concprog003
-tests/concurrent/should_run/1980
-tests/concurrent/should_run/2910
-tests/concurrent/should_run/2910a
-tests/concurrent/should_run/3279
-tests/concurrent/should_run/3429
-tests/concurrent/should_run/367
-tests/concurrent/should_run/367_letnoescape
-tests/concurrent/should_run/4030
-tests/concurrent/should_run/4811
-tests/concurrent/should_run/4813
-tests/concurrent/should_run/5238
-tests/concurrent/should_run/5421
-tests/concurrent/should_run/5558
-tests/concurrent/should_run/5611
-tests/concurrent/should_run/5866
-tests/concurrent/should_run/T1980
-tests/concurrent/should_run/T2910
-tests/concurrent/should_run/T2910a
-tests/concurrent/should_run/T3279
-tests/concurrent/should_run/T3429
-tests/concurrent/should_run/T367
-tests/concurrent/should_run/T367_letnoescape
-tests/concurrent/should_run/T4030
-tests/concurrent/should_run/T4811
-tests/concurrent/should_run/T4813
-tests/concurrent/should_run/T5238
-tests/concurrent/should_run/T5421
-tests/concurrent/should_run/T5558
-tests/concurrent/should_run/T5611
-tests/concurrent/should_run/T5866
-tests/concurrent/should_run/allowinterrupt001
-tests/concurrent/should_run/async001
-tests/concurrent/should_run/conc001
-tests/concurrent/should_run/conc002
-tests/concurrent/should_run/conc003
-tests/concurrent/should_run/conc004
-tests/concurrent/should_run/conc006
-tests/concurrent/should_run/conc007
-tests/concurrent/should_run/conc008
-tests/concurrent/should_run/conc009
-tests/concurrent/should_run/conc010
-tests/concurrent/should_run/conc012
-tests/concurrent/should_run/conc013
-tests/concurrent/should_run/conc014
-tests/concurrent/should_run/conc015
-tests/concurrent/should_run/conc015a
-tests/concurrent/should_run/conc016
-tests/concurrent/should_run/conc017
-tests/concurrent/should_run/conc017a
-tests/concurrent/should_run/conc018
-tests/concurrent/should_run/conc019
-tests/concurrent/should_run/conc020
-tests/concurrent/should_run/conc021
-tests/concurrent/should_run/conc022
-tests/concurrent/should_run/conc023
-tests/concurrent/should_run/conc024
-tests/concurrent/should_run/conc025
-tests/concurrent/should_run/conc026
-tests/concurrent/should_run/conc027
-tests/concurrent/should_run/conc028
-tests/concurrent/should_run/conc029
-tests/concurrent/should_run/conc030
-tests/concurrent/should_run/conc031
-tests/concurrent/should_run/conc032
-tests/concurrent/should_run/conc033
-tests/concurrent/should_run/conc034
-tests/concurrent/should_run/conc035
-tests/concurrent/should_run/conc036
-tests/concurrent/should_run/conc037
-tests/concurrent/should_run/conc038
-tests/concurrent/should_run/conc039
-tests/concurrent/should_run/conc040
-tests/concurrent/should_run/conc041
-tests/concurrent/should_run/conc042
-tests/concurrent/should_run/conc043
-tests/concurrent/should_run/conc044
-tests/concurrent/should_run/conc045
-tests/concurrent/should_run/conc051
-tests/concurrent/should_run/conc058
-tests/concurrent/should_run/conc059
-tests/concurrent/should_run/conc064
-tests/concurrent/should_run/conc065
-tests/concurrent/should_run/conc066
-tests/concurrent/should_run/conc067
-tests/concurrent/should_run/conc068
-tests/concurrent/should_run/conc069
-tests/concurrent/should_run/conc069a
-tests/concurrent/should_run/conc070
-tests/concurrent/should_run/conc071
-tests/concurrent/should_run/conc072
-tests/concurrent/should_run/conc073
-tests/concurrent/should_run/foreignInterruptible
-tests/concurrent/should_run/mask001
-tests/concurrent/should_run/mask002
-tests/concurrent/should_run/numsparks001
-tests/concurrent/should_run/throwto001
-tests/concurrent/should_run/throwto002
-tests/concurrent/should_run/throwto003
-tests/deSugar/should_run/DsLambdaCase
-tests/deSugar/should_run/DsMultiWayIf
-tests/deSugar/should_run/T246
-tests/deSugar/should_run/T3126
-tests/deSugar/should_run/T3382
-tests/deSugar/should_run/T5742
-tests/deSugar/should_run/dsrun001
-tests/deSugar/should_run/dsrun002
-tests/deSugar/should_run/dsrun003
-tests/deSugar/should_run/dsrun004
-tests/deSugar/should_run/dsrun005
-tests/deSugar/should_run/dsrun006
-tests/deSugar/should_run/dsrun007
-tests/deSugar/should_run/dsrun008
-tests/deSugar/should_run/dsrun009
-tests/deSugar/should_run/dsrun010
-tests/deSugar/should_run/dsrun011
-tests/deSugar/should_run/dsrun012
-tests/deSugar/should_run/dsrun013
-tests/deSugar/should_run/dsrun014
-tests/deSugar/should_run/dsrun015
-tests/deSugar/should_run/dsrun016
-tests/deSugar/should_run/dsrun017
-tests/deSugar/should_run/dsrun018
-tests/deSugar/should_run/dsrun019
-tests/deSugar/should_run/dsrun020
-tests/deSugar/should_run/dsrun021
-tests/deSugar/should_run/dsrun022
-tests/deSugar/should_run/dsrun023
-tests/deSugar/should_run/mc01
-tests/deSugar/should_run/mc02
-tests/deSugar/should_run/mc03
-tests/deSugar/should_run/mc04
-tests/deSugar/should_run/mc05
-tests/deSugar/should_run/mc06
-tests/deSugar/should_run/mc07
-tests/deSugar/should_run/mc08
-tests/deriving/should_run/T2529
-tests/deriving/should_run/T4136
-tests/deriving/should_run/T4528a
-tests/deriving/should_run/T5041
-tests/deriving/should_run/T5628
-tests/deriving/should_run/T5712
-tests/deriving/should_run/T7931
-tests/deriving/should_run/drvrun-foldable1
-tests/deriving/should_run/drvrun-functor1
-tests/deriving/should_run/drvrun001
-tests/deriving/should_run/drvrun002
-tests/deriving/should_run/drvrun003
-tests/deriving/should_run/drvrun004
-tests/deriving/should_run/drvrun005
-tests/deriving/should_run/drvrun006
-tests/deriving/should_run/drvrun007
-tests/deriving/should_run/drvrun008
-tests/deriving/should_run/drvrun009
-tests/deriving/should_run/drvrun010
-tests/deriving/should_run/drvrun011
-tests/deriving/should_run/drvrun012
-tests/deriving/should_run/drvrun013
-tests/deriving/should_run/drvrun014
-tests/deriving/should_run/drvrun015
-tests/deriving/should_run/drvrun016
-tests/deriving/should_run/drvrun017
-tests/deriving/should_run/drvrun018
-tests/deriving/should_run/drvrun019
-tests/deriving/should_run/drvrun020
-tests/deriving/should_run/drvrun021
-tests/dph/classes/dph-classes-copy-fast
-tests/dph/classes/dph-classes-fast
-tests/dph/classes/dph-classes-vseg-fast
-tests/dph/diophantine/dph-diophantine-copy-fast
-tests/dph/diophantine/dph-diophantine-copy-opt
-tests/dph/dotp/dph-dotp-copy-fast
-tests/dph/dotp/dph-dotp-copy-opt
-tests/dph/dotp/dph-dotp-opt
-tests/dph/dotp/dph-dotp-vseg-fast
-tests/dph/dotp/dph-dotp-vseg-opt
-tests/dph/nbody/dph-nbody-copy-fast
-tests/dph/nbody/dph-nbody-copy-opt
-tests/dph/nbody/dph-nbody-vseg-fast
-tests/dph/nbody/dph-nbody-vseg-opt
-tests/dph/primespj/dph-primespj-copy-fast
-tests/dph/primespj/dph-primespj-copy-opt
-tests/dph/primespj/dph-primespj-opt
-tests/dph/quickhull/dph-quickhull-copy-fast
-tests/dph/quickhull/dph-quickhull-copy-opt
-tests/dph/quickhull/dph-quickhull-opt
-tests/dph/quickhull/dph-quickhull-vseg-fast
-tests/dph/quickhull/dph-quickhull-vseg-opt
-tests/dph/smvm/dph-smvm-copy
-tests/dph/smvm/dph-smvm-vseg
-tests/dph/sumnats/dph-sumnats-copy
-tests/dph/sumnats/dph-sumnats-vseg
-tests/dph/words/dph-words-copy-fast
-tests/dph/words/dph-words-copy-opt
-tests/dph/words/dph-words-opt
-tests/dph/words/dph-words-vseg-fast
-tests/dph/words/dph-words-vseg-opt
-tests/driver/1959/E.hs
-tests/driver/1959/prog
-tests/driver/3674_pre
-tests/driver/437/Test
-tests/driver/437/Test2
-tests/driver/5313
-tests/driver/A012.ooo
-tests/driver/A013.xhi
-tests/driver/A061a.s
-tests/driver/A061b.s
-tests/driver/A064.hspp
-tests/driver/A065.hspp
-tests/driver/A066.tmp
-tests/driver/A067.tmp
-tests/driver/A070.s
-tests/driver/A071.tmp
-tests/driver/B022/C.ooo
-tests/driver/B023/C.xhi
-tests/driver/B024a/
-tests/driver/B062d/
-tests/driver/B062e/
-tests/driver/F018a.obj.018
-tests/driver/F018a_stub.obj.018
-tests/driver/Hello062a.hs
-tests/driver/Hello062b.hs
-tests/driver/Hello062c.hs
-tests/driver/T1959/E.hs
-tests/driver/T1959/prog
-tests/driver/T3007/A/Setup
-tests/driver/T3007/A/dist/
-tests/driver/T3007/B/Setup
-tests/driver/T3007/B/dist/
-tests/driver/T3007/package.conf
-tests/driver/T3389
-tests/driver/T3674_pre
-tests/driver/T437/Test
-tests/driver/T437/Test2
-tests/driver/T4437
-tests/driver/T5147/B.hs
-tests/driver/T5198dump/
-tests/driver/T5313
-tests/driver/T5584/A.hi-boot
-tests/driver/T5584_out/
-tests/driver/T706.hs
-tests/driver/T7060dump/
-tests/driver/T7373/package.conf
-tests/driver/T7373/pkg/Setup
-tests/driver/T7373/pkg/dist/
-tests/driver/Test.081b
-tests/driver/Test.081b.hs
-tests/driver/Test_081a
-tests/driver/Test_081a.hs
-tests/driver/depend200
-tests/driver/dynHelloWorld
-tests/driver/dynamicToo/A001.dyn_hi
-tests/driver/dynamicToo/A001.dyn_o
-tests/driver/dynamicToo/A002.dyn_hi
-tests/driver/dynamicToo/A002.dyn_o
-tests/driver/dynamicToo/A003.dyn_hi
-tests/driver/dynamicToo/A003.dyn_o
-tests/driver/dynamicToo/B001.dyn_hi
-tests/driver/dynamicToo/B001.dyn_o
-tests/driver/dynamicToo/B002.dyn_hi
-tests/driver/dynamicToo/B002.dyn_o
-tests/driver/dynamicToo/C001.dyn_hi
-tests/driver/dynamicToo/C001.dyn_o
-tests/driver/dynamicToo/C002.dyn_hi
-tests/driver/dynamicToo/C002.dyn_o
-tests/driver/dynamicToo/d001
-tests/driver/dynamicToo/s001
-tests/driver/dynamicToo/dynamicToo004/Setup
-tests/driver/dynamicToo/dynamicToo004/local.package.conf/
-tests/driver/dynamicToo/dynamicToo004/pkg1/dist/
-tests/driver/dynamicToo/dynamicToo004/pkg1dyn/dist/
-tests/driver/dynamicToo/dynamicToo004/pkg2/dist/
-tests/driver/dynamicToo/dynamicToo004/progstatic
-tests/indexed-types/should_fail/T8129.trace
-tests/rts/T5435*_o
-tests/rts/T5435*.so
-tests/driver/dynamic_flags_001/C
-tests/driver/hello062a
-tests/driver/hello062b
-tests/driver/hello062c
-tests/driver/hello062d
-tests/driver/hello062e
-tests/driver/objc/objc-hi
-tests/driver/objc/objcpp-hi
-tests/driver/out019/
-tests/driver/recomp001/B.hs
-tests/driver/recomp001/C
-tests/driver/recomp003/Data/
-tests/driver/recomp003/err
-tests/driver/recomp004/MainX
-tests/driver/recomp004/MainX.hs
-tests/driver/recomp004/c.c
-tests/driver/recomp005/C.hs
-tests/driver/recomp006/B.hs
-tests/driver/recomp006/err
-tests/driver/recomp006/out
-tests/driver/recomp007/Setup
-tests/driver/recomp007/a1/dist/
-tests/driver/recomp007/a2/dist/
-tests/driver/recomp007/b/dist/
-tests/driver/recomp007/local.package.conf/
-tests/driver/recomp008/A.hs
-tests/driver/recomp008/prog
-tests/driver/recomp010/Main
-tests/driver/recomp010/X.hs
-tests/driver/recomp011/A.hsinc
-tests/driver/recomp011/B.hsinc
-tests/driver/recomp011/Main
-tests/driver/recomp012/Foo.hs
-tests/driver/recomp012/Main
-tests/driver/recomp012/Main.hs
-tests/driver/recomp012/MyBool.hs
-tests/driver/rtsOpts
-tests/driver/rtsopts002
-tests/driver/spacesInArgs
-tests/driver/stub017/
-tests/driver/stub028/
-tests/driver/stub035/
-tests/driver/stub045/
-tests/driver/withRtsOpts
-tests/driver/withRtsOpts.out
-tests/dynlibs/T3807-load
-tests/dynlibs/T3807test.so
-tests/dynlibs/T5373A
-tests/dynlibs/T5373B
-tests/dynlibs/T5373C
-tests/dynlibs/T5373D
-tests/ext-core/T7239.hcr
-tests/ffi/should_run/.hpc/
-tests/ffi/should_run/1288
-tests/ffi/should_run/1679
-tests/ffi/should_run/2276
-tests/ffi/should_run/2469
-tests/ffi/should_run/2594
-tests/ffi/should_run/2917a
-tests/ffi/should_run/4038
-tests/ffi/should_run/4221
-tests/ffi/should_run/5402
-tests/ffi/should_run/5594
-tests/ffi/should_run/7170
-tests/ffi/should_run/Capi_Ctype_001
-tests/ffi/should_run/Capi_Ctype_001.hs
-tests/ffi/should_run/Capi_Ctype_002
-tests/ffi/should_run/Capi_Ctype_A_001.hs
-tests/ffi/should_run/Capi_Ctype_A_002.hs
-tests/ffi/should_run/T1288
-tests/ffi/should_run/T1679
-tests/ffi/should_run/T2276
-tests/ffi/should_run/T2469
-tests/ffi/should_run/T2594
-tests/ffi/should_run/T2917a
-tests/ffi/should_run/T4012
-tests/ffi/should_run/T4038
-tests/ffi/should_run/T4221
-tests/ffi/should_run/T5402
-tests/ffi/should_run/T5594
-tests/ffi/should_run/T7170
-tests/ffi/should_run/capi_value
-tests/ffi/should_run/fed001
-tests/ffi/should_run/ffi001
-tests/ffi/should_run/ffi002
-tests/ffi/should_run/ffi003
-tests/ffi/should_run/ffi005
-tests/ffi/should_run/ffi006
-tests/ffi/should_run/ffi007
-tests/ffi/should_run/ffi008
-tests/ffi/should_run/ffi009
-tests/ffi/should_run/ffi010
-tests/ffi/should_run/ffi011
-tests/ffi/should_run/ffi013
-tests/ffi/should_run/ffi014
-tests/ffi/should_run/ffi015
-tests/ffi/should_run/ffi016
-tests/ffi/should_run/ffi017
-tests/ffi/should_run/ffi018
-tests/ffi/should_run/ffi019
-tests/ffi/should_run/ffi020
-tests/ffi/should_run/ffi021
-tests/ffi/should_run/ffi022
-tests/ffi/should_run/ffi_parsing_001
-tests/ffi/should_run/fptr01
-tests/ffi/should_run/fptr02
-tests/ffi/should_run/fptrfail01
-tests/gadt/CasePrune
-tests/gadt/Session
-tests/gadt/gadt2
-tests/gadt/gadt23
-tests/gadt/gadt4
-tests/gadt/gadt5
-tests/gadt/records
-tests/gadt/tc
-tests/gadt/type-rep
-tests/gadt/ubx-records
-tests/gadt/while
-tests/generics/GEq/GEq1
-tests/generics/GEq/GEq2
-tests/generics/GFunctor/GFunctor1
-tests/generics/GMap/GMap1
-tests/generics/GShow/GShow1
-tests/generics/GenNewtype
-tests/generics/Uniplate/GUniplate1
-tests/ghc-api/T4891/T4891
-tests/ghc-api/T7478/A
-tests/ghc-api/T7478/T7478
-tests/ghc-api/apirecomp001/myghc
-tests/ghc-api/dynCompileExpr/dynCompileExpr
-tests/ghc-api/ghcApi
-tests/ghci.debugger/scripts/break022/A.hs
-tests/ghci.debugger/scripts/break023/A.hs
-tests/ghci/linking/dir001/
-tests/ghci/linking/dir002/
-tests/ghci/linking/dir004/
-tests/ghci/linking/dir005/
-tests/ghci/linking/dir006/
-tests/ghci/prog001/C.hs
-tests/ghci/prog001/D.hs
-tests/ghci/prog002/A.hs
-tests/ghci/prog003/D.hs
-tests/ghci/prog004/ctest.c
-tests/ghci/prog005/A.hs
-tests/ghci/prog006/Boot.hs
-tests/ghci/prog009/A.hs
-tests/ghci/prog012/Bar.hs
-tests/ghci/scripts/Ghci058.hs
-tests/ghci/scripts/T1914A.hs
-tests/ghci/scripts/T1914B.hs
-tests/ghci/scripts/T6106.hs
-tests/ghci/scripts/T6106_preproc
-tests/ghci/scripts/ghci027.hs
-tests/ghci/should_run/3171.err
-tests/hsc2hs/3837.hs
-tests/hsc2hs/T3837.hs
-tests/hsc2hs/hsc2hs001.hs
-tests/hsc2hs/hsc2hs002.hs
-tests/hsc2hs/hsc2hs003
-tests/hsc2hs/hsc2hs003.hs
-tests/hsc2hs/hsc2hs004
-tests/hsc2hs/hsc2hs004.hs
-tests/indexed-types/should_run/GMapAssoc
-tests/indexed-types/should_run/GMapTop
-tests/indexed-types/should_run/T2985
-tests/indexed-types/should_run/T4235
-tests/indexed-types/should_run/T5719
-tests/lib/Concurrent/4876
-tests/lib/Concurrent/ThreadDelay001
-tests/lib/Data.ByteString/bytestring002
-tests/lib/Data.ByteString/bytestring003
-tests/lib/Data.ByteString/bytestring006
-tests/lib/IO/2122
-tests/lib/IO/2122-test
-tests/lib/IO/3307
-tests/lib/IO/4808
-tests/lib/IO/4808.test
-tests/lib/IO/4855
-tests/lib/IO/4895
-tests/lib/IO/IOError001
-tests/lib/IO/IOError002
-tests/lib/IO/T4113
-tests/lib/IO/T4144
-tests/lib/IO/chinese-file-*
-tests/lib/IO/chinese-name
-tests/lib/IO/concio002
-tests/lib/IO/countReaders001
-tests/lib/IO/countReaders001.txt
-tests/lib/IO/decodingerror001
-tests/lib/IO/decodingerror002
-tests/lib/IO/encoding001
-tests/lib/IO/encoding001.utf16
-tests/lib/IO/encoding001.utf16.utf16be
-tests/lib/IO/encoding001.utf16.utf16le
-tests/lib/IO/encoding001.utf16.utf32
-tests/lib/IO/encoding001.utf16.utf32be
-tests/lib/IO/encoding001.utf16.utf32le
-tests/lib/IO/encoding001.utf16.utf8
-tests/lib/IO/encoding001.utf16.utf8_bom
-tests/lib/IO/encoding001.utf16be
-tests/lib/IO/encoding001.utf16be.utf16
-tests/lib/IO/encoding001.utf16be.utf16le
-tests/lib/IO/encoding001.utf16be.utf32
-tests/lib/IO/encoding001.utf16be.utf32be
-tests/lib/IO/encoding001.utf16be.utf32le
-tests/lib/IO/encoding001.utf16be.utf8
-tests/lib/IO/encoding001.utf16be.utf8_bom
-tests/lib/IO/encoding001.utf16le
-tests/lib/IO/encoding001.utf16le.utf16
-tests/lib/IO/encoding001.utf16le.utf16be
-tests/lib/IO/encoding001.utf16le.utf32
-tests/lib/IO/encoding001.utf16le.utf32be
-tests/lib/IO/encoding001.utf16le.utf32le
-tests/lib/IO/encoding001.utf16le.utf8
-tests/lib/IO/encoding001.utf16le.utf8_bom
-tests/lib/IO/encoding001.utf32
-tests/lib/IO/encoding001.utf32.utf16
-tests/lib/IO/encoding001.utf32.utf16be
-tests/lib/IO/encoding001.utf32.utf16le
-tests/lib/IO/encoding001.utf32.utf32be
-tests/lib/IO/encoding001.utf32.utf32le
-tests/lib/IO/encoding001.utf32.utf8
-tests/lib/IO/encoding001.utf32.utf8_bom
-tests/lib/IO/encoding001.utf32be
-tests/lib/IO/encoding001.utf32be.utf16
-tests/lib/IO/encoding001.utf32be.utf16be
-tests/lib/IO/encoding001.utf32be.utf16le
-tests/lib/IO/encoding001.utf32be.utf32
-tests/lib/IO/encoding001.utf32be.utf32le
-tests/lib/IO/encoding001.utf32be.utf8
-tests/lib/IO/encoding001.utf32be.utf8_bom
-tests/lib/IO/encoding001.utf32le
-tests/lib/IO/encoding001.utf32le.utf16
-tests/lib/IO/encoding001.utf32le.utf16be
-tests/lib/IO/encoding001.utf32le.utf16le
-tests/lib/IO/encoding001.utf32le.utf32
-tests/lib/IO/encoding001.utf32le.utf32be
-tests/lib/IO/encoding001.utf32le.utf8
-tests/lib/IO/encoding001.utf32le.utf8_bom
-tests/lib/IO/encoding001.utf8
-tests/lib/IO/encoding001.utf8.utf16
-tests/lib/IO/encoding001.utf8.utf16be
-tests/lib/IO/encoding001.utf8.utf16le
-tests/lib/IO/encoding001.utf8.utf32
-tests/lib/IO/encoding001.utf8.utf32be
-tests/lib/IO/encoding001.utf8.utf32le
-tests/lib/IO/encoding001.utf8.utf8_bom
-tests/lib/IO/encoding001.utf8_bom
-tests/lib/IO/encoding001.utf8_bom.utf16
-tests/lib/IO/encoding001.utf8_bom.utf16be
-tests/lib/IO/encoding001.utf8_bom.utf16le
-tests/lib/IO/encoding001.utf8_bom.utf32
-tests/lib/IO/encoding001.utf8_bom.utf32be
-tests/lib/IO/encoding001.utf8_bom.utf32le
-tests/lib/IO/encoding001.utf8_bom.utf8
-tests/lib/IO/encoding002
-tests/lib/IO/encodingerror001
-tests/lib/IO/environment001
-tests/lib/IO/finalization001
-tests/lib/IO/hClose001
-tests/lib/IO/hClose001.tmp
-tests/lib/IO/hClose002
-tests/lib/IO/hClose002.tmp
-tests/lib/IO/hClose003
-tests/lib/IO/hDuplicateTo001
-tests/lib/IO/hFileSize001
-tests/lib/IO/hFileSize002
-tests/lib/IO/hFileSize002.out
-tests/lib/IO/hFlush001
-tests/lib/IO/hFlush001.out
-tests/lib/IO/hGetBuf001
-tests/lib/IO/hGetBuffering001
-tests/lib/IO/hGetChar001
-tests/lib/IO/hGetLine001
-tests/lib/IO/hGetLine002
-tests/lib/IO/hGetLine003
-tests/lib/IO/hGetPosn001
-tests/lib/IO/hGetPosn001.out
-tests/lib/IO/hIsEOF001
-tests/lib/IO/hIsEOF002
-tests/lib/IO/hIsEOF002.out
-tests/lib/IO/hReady001
-tests/lib/IO/hReady002
-tests/lib/IO/hSeek001
-tests/lib/IO/hSeek002
-tests/lib/IO/hSeek003
-tests/lib/IO/hSeek004
-tests/lib/IO/hSeek004.out
-tests/lib/IO/hSetBuffering002
-tests/lib/IO/hSetBuffering003
-tests/lib/IO/hSetBuffering004
-tests/lib/IO/hSetEncoding001
-tests/lib/IO/ioeGetErrorString001
-tests/lib/IO/ioeGetFileName001
-tests/lib/IO/ioeGetHandle001
-tests/lib/IO/isEOF001
-tests/lib/IO/misc001
-tests/lib/IO/misc001.out
-tests/lib/IO/newline001
-tests/lib/IO/newline001.out
-tests/lib/IO/openFile001
-tests/lib/IO/openFile002
-tests/lib/IO/openFile003
-tests/lib/IO/openFile004
-tests/lib/IO/openFile004.out
-tests/lib/IO/openFile005
-tests/lib/IO/openFile005.out1
-tests/lib/IO/openFile005.out2
-tests/lib/IO/openFile006
-tests/lib/IO/openFile006.out
-tests/lib/IO/openFile007
-tests/lib/IO/openFile007.out
-tests/lib/IO/openFile008
-tests/lib/IO/openTempFile001
-tests/lib/IO/putStr001
-tests/lib/IO/readFile001
-tests/lib/IO/readFile001.out
-tests/lib/IO/readwrite001
-tests/lib/IO/readwrite001.inout
-tests/lib/IO/readwrite002
-tests/lib/IO/readwrite002.inout
-tests/lib/IO/readwrite003
-tests/lib/IO/readwrite003.txt
-tests/lib/IO/tmp
-tests/lib/IOExts/echo001
-tests/lib/IOExts/hGetBuf002
-tests/lib/IOExts/hGetBuf003
-tests/lib/IOExts/hPutBuf001
-tests/lib/IOExts/hPutBuf002
-tests/lib/IOExts/hPutBuf002.out
-tests/lib/IOExts/hTell001
-tests/lib/IOExts/hTell002
-tests/lib/IOExts/performGC001
-tests/lib/IOExts/trace001
-tests/lib/IORef/
-tests/lib/Numeric/
-tests/lib/OldException/OldException001
-tests/lib/PrettyPrint/T3911
-tests/lib/PrettyPrint/pp1
-tests/lib/Text.Printf/1548
-tests/lib/Time/T5430
-tests/lib/Time/time002
-tests/lib/Time/time003
-tests/lib/Time/time004
-tests/lib/exceptions/exceptions001
-tests/lib/integer/IntegerConversionRules.simpl
-tests/lib/integer/fromToInteger.simpl
-tests/lib/integer/gcdInteger
-tests/lib/integer/integerBits
-tests/lib/integer/integerConstantFolding
-tests/lib/integer/integerConstantFolding.simpl
-tests/lib/integer/integerConversions
-tests/lib/integer/integerGmpInternals
-tests/lib/libposix/po003.out
-tests/lib/libposix/posix002
-tests/lib/libposix/posix003
-tests/lib/libposix/posix004
-tests/lib/libposix/posix006
-tests/lib/libposix/posix009
-tests/lib/libposix/posix010
-tests/lib/libposix/posix014
-tests/lib/should_run/4006
-tests/lib/should_run/addr001
-tests/lib/should_run/array001
-tests/lib/should_run/array001.data
-tests/lib/should_run/char001
-tests/lib/should_run/char002
-tests/lib/should_run/cstring001
-tests/lib/should_run/dynamic001
-tests/lib/should_run/dynamic002
-tests/lib/should_run/dynamic003
-tests/lib/should_run/dynamic004
-tests/lib/should_run/dynamic005
-tests/lib/should_run/enum01
-tests/lib/should_run/enum02
-tests/lib/should_run/enum03
-tests/lib/should_run/enum04
-tests/lib/should_run/exceptionsrun001
-tests/lib/should_run/exceptionsrun002
-tests/lib/should_run/length001
-tests/lib/should_run/list001
-tests/lib/should_run/list002
-tests/lib/should_run/list003
-tests/lib/should_run/memo001
-tests/lib/should_run/memo002
-tests/lib/should_run/rand001
-tests/lib/should_run/ratio001
-tests/lib/should_run/reads001
-tests/lib/should_run/show001
-tests/lib/should_run/stableptr001
-tests/lib/should_run/stableptr003
-tests/lib/should_run/stableptr004
-tests/lib/should_run/stableptr005
-tests/lib/should_run/text001
-tests/lib/should_run/tup001
-tests/lib/should_run/weak001
-tests/mdo/should_compile/mdo001
-tests/mdo/should_compile/mdo002
-tests/mdo/should_compile/mdo003
-tests/mdo/should_compile/mdo004
-tests/mdo/should_compile/mdo005
-tests/mdo/should_fail/mdofail006
-tests/mdo/should_run/mdorun001
-tests/mdo/should_run/mdorun002
-tests/mdo/should_run/mdorun003
-tests/mdo/should_run/mdorun004
-tests/mdo/should_run/mdorun005
-tests/module/Mod145_A.mod146_hi
-tests/module/Mod145_A.mod146_o
-tests/module/Mod157_A.mod158_hi
-tests/module/Mod157_A.mod158_o
-tests/module/Mod157_B.mod158_hi
-tests/module/Mod157_B.mod158_o
-tests/module/Mod157_C.mod158_hi
-tests/module/Mod157_C.mod158_o
-tests/module/Mod157_D.mod158_hi
-tests/module/Mod157_D.mod158_o
-tests/module/Mod159_A.mod160_hi
-tests/module/Mod159_A.mod160_o
-tests/module/Mod159_B.mod160_hi
-tests/module/Mod159_B.mod160_o
-tests/module/Mod159_C.mod160_hi
-tests/module/Mod159_C.mod160_o
-tests/module/Mod159_D.mod160_hi
-tests/module/Mod159_D.mod160_o
-tests/module/Mod164_A.mod165_hi
-tests/module/Mod164_A.mod165_o
-tests/module/Mod164_A.mod166_hi
-tests/module/Mod164_A.mod166_o
-tests/module/Mod164_A.mod167_hi
-tests/module/Mod164_A.mod167_o
-tests/module/Mod164_B.mod165_hi
-tests/module/Mod164_B.mod165_o
-tests/module/Mod164_B.mod166_hi
-tests/module/Mod164_B.mod166_o
-tests/module/Mod164_B.mod167_hi
-tests/module/Mod164_B.mod167_o
-tests/module/mod166.mod166_hi
-tests/module/mod166.mod166_o
-tests/module/mod167.mod167_hi
-tests/module/mod167.mod167_o
-tests/module/mod175/test
-tests/module/mod175/test2
-tests/module/mod179
-tests/numeric/should_run/3676
-tests/numeric/should_run/4381
-tests/numeric/should_run/4383
-tests/numeric/should_run/T3676
-tests/numeric/should_run/T4381
-tests/numeric/should_run/T4383
-tests/numeric/should_run/T5863
-tests/numeric/should_run/T7014
-tests/numeric/should_run/T7014.simpl
-tests/numeric/should_run/T7233
-tests/numeric/should_run/T7689
-tests/numeric/should_run/add2
-tests/numeric/should_run/arith001
-tests/numeric/should_run/arith002
-tests/numeric/should_run/arith003
-tests/numeric/should_run/arith004
-tests/numeric/should_run/arith005
-tests/numeric/should_run/arith006
-tests/numeric/should_run/arith007
-tests/numeric/should_run/arith008
-tests/numeric/should_run/arith009
-tests/numeric/should_run/arith010
-tests/numeric/should_run/arith011
-tests/numeric/should_run/arith012
-tests/numeric/should_run/arith013
-tests/numeric/should_run/arith014
-tests/numeric/should_run/arith015
-tests/numeric/should_run/arith016
-tests/numeric/should_run/arith017
-tests/numeric/should_run/arith018
-tests/numeric/should_run/arith019
-tests/numeric/should_run/expfloat
-tests/numeric/should_run/mul2
-tests/numeric/should_run/numrun009
-tests/numeric/should_run/numrun010
-tests/numeric/should_run/numrun011
-tests/numeric/should_run/numrun012
-tests/numeric/should_run/numrun013
-tests/numeric/should_run/numrun014
-tests/numeric/should_run/quotRem2
-tests/optasm-log
-tests/optllvm-32-log
-tests/optllvm-log
-tests/overloadedlists/should_run/overloadedlistsrun01
-tests/overloadedlists/should_run/overloadedlistsrun02
-tests/overloadedlists/should_run/overloadedlistsrun03
-tests/overloadedlists/should_run/overloadedlistsrun04
-tests/overloadedlists/should_run/overloadedlistsrun05
-tests/parser/should_compile/T5243
-tests/parser/should_compile/T7476/Main.imports
-tests/parser/should_compile/T7476/T7476
-tests/parser/should_run/ParserMultiWayIf
-tests/parser/should_run/T1344
-tests/parser/should_run/operator
-tests/parser/should_run/operator2
-tests/parser/should_run/readRun001
-tests/parser/should_run/readRun002
-tests/parser/should_run/readRun003
-tests/parser/should_run/readRun004
-tests/parser/unicode/1744
-tests/parser/unicode/T1744
-tests/parser/unicode/utf8_024
-tests/perf/compiler/T1969.comp.stats
-tests/perf/compiler/T3064.comp.stats
-tests/perf/compiler/T3294.comp.stats
-tests/perf/compiler/T4801.comp.stats
-tests/perf/compiler/T5030.comp.stats
-tests/perf/compiler/T5321FD.comp.stats
-tests/perf/compiler/T5321Fun.comp.stats
-tests/perf/compiler/T5631.comp.stats
-tests/perf/compiler/T5642.comp.stats
-tests/perf/compiler/T5837.comp.stats
-tests/perf/compiler/T6048.comp.stats
-tests/perf/compiler/T783.comp.stats
-tests/perf/compiler/parsing001.comp.stats
-tests/perf/should_run/3586
-tests/perf/should_run/3586.stats
-tests/perf/should_run/Conversions
-tests/perf/should_run/Conversions.stats
-tests/perf/should_run/MethSharing
-tests/perf/should_run/MethSharing.stats
-tests/perf/should_run/T149_A
-tests/perf/should_run/T149_B
-tests/perf/should_run/T2902_A
-tests/perf/should_run/T2902_B
-tests/perf/should_run/T3245
-tests/perf/should_run/T3586
-tests/perf/should_run/T3736
-tests/perf/should_run/T3736.speed.f32
-tests/perf/should_run/T3738
-tests/perf/should_run/T3738.stats
-tests/perf/should_run/T4321
-tests/perf/should_run/T4474a
-tests/perf/should_run/T4474a.stats
-tests/perf/should_run/T4474b
-tests/perf/should_run/T4474b.stats
-tests/perf/should_run/T4474c
-tests/perf/should_run/T4474c.stats
-tests/perf/should_run/T4830
-tests/perf/should_run/T4830.stats
-tests/perf/should_run/T4978
-tests/perf/should_run/T4978.stats
-tests/perf/should_run/T5113
-tests/perf/should_run/T5113.stats
-tests/perf/should_run/T5205
-tests/perf/should_run/T5205.stats
-tests/perf/should_run/T5237
-tests/perf/should_run/T5237.stats
-tests/perf/should_run/T5536
-tests/perf/should_run/T5536.data
-tests/perf/should_run/T5536.stats
-tests/perf/should_run/T5549
-tests/perf/should_run/T5549.stats
-tests/perf/should_run/T7257
-tests/perf/should_run/T7257.stats
-tests/perf/should_run/T7436
-tests/perf/should_run/T7436.stats
-tests/perf/should_run/T7507
-tests/perf/should_run/T7797
-tests/perf/should_run/T876
-tests/perf/should_run/lazy-bs-alloc
-tests/perf/should_run/lazy-bs-alloc.stats
-tests/perf/should_run/speed.f32
-tests/perf/space_leaks/T2762
-tests/perf/space_leaks/T2762.stats
-tests/perf/space_leaks/T4018
-tests/perf/space_leaks/T4334
-tests/perf/space_leaks/T4334.stats
-tests/perf/space_leaks/space_leak_001
-tests/perf/space_leaks/space_leak_001.stats
-tests/plugins/plugins01
-tests/plugins/plugins05
-tests/plugins/plugins06
-tests/plugins/simple-plugin/pkg.plugins01/
-tests/plugins/simple-plugin/pkg.plugins02/
-tests/plugins/simple-plugin/pkg.plugins03/
-tests/polykinds/Freeman
-tests/polykinds/MonoidsFD
-tests/polykinds/MonoidsTF
-tests/polykinds/PolyKinds09
-tests/polykinds/PolyKinds10
-tests/profiling/should_compile/prof001
-tests/profiling/should_compile/prof002
-tests/profiling/should_run/2592
-tests/profiling/should_run/2592.aux
-tests/profiling/should_run/2592.hp
-tests/profiling/should_run/2592.ps
-tests/profiling/should_run/5314
-tests/profiling/should_run/5314.hp
-tests/profiling/should_run/5314.ps
-tests/profiling/should_run/T2552
-tests/profiling/should_run/T2592
-tests/profiling/should_run/T3001
-tests/profiling/should_run/T3001-2
-tests/profiling/should_run/T3001-2.hp
-tests/profiling/should_run/T3001-2.ps
-tests/profiling/should_run/T3001.hp
-tests/profiling/should_run/T3001.ps
-tests/profiling/should_run/T5314
-tests/profiling/should_run/T5363
-tests/profiling/should_run/T5559
-tests/profiling/should_run/T680
-tests/profiling/should_run/T949
-tests/profiling/should_run/T949.hp
-tests/profiling/should_run/T949.ps
-tests/profiling/should_run/callstack001
-tests/profiling/should_run/callstack002
-tests/profiling/should_run/heapprof001
-tests/profiling/should_run/heapprof001.hp
-tests/profiling/should_run/heapprof001.ps
-tests/profiling/should_run/ioprof
-tests/profiling/should_run/prof-doc-fib
-tests/profiling/should_run/prof-doc-last
-tests/profiling/should_run/profinline001
-tests/profiling/should_run/scc001
-tests/profiling/should_run/scc002
-tests/profiling/should_run/scc003
-tests/profiling/should_run/scc004
-tests/profiling/should_run/test.bin
-tests/programs/10queens/10queens
-tests/programs/Queens/queens
-tests/programs/andre_monad/andre_monad
-tests/programs/andy_cherry/andy_cherry
-tests/programs/barton-mangler-bug/barton-mangler-bug
-tests/programs/cholewo-eval/cholewo-eval
-tests/programs/cvh_unboxing/cvh_unboxing
-tests/programs/fast2haskell/fast2haskell
-tests/programs/fun_insts/fun_insts
-tests/programs/jl_defaults/jl_defaults
-tests/programs/joao-circular/joao-circular
-tests/programs/jq_readsPrec/jq_readsPrec
-tests/programs/jtod_circint/jtod_circint
-tests/programs/jules_xref/jules_xref
-tests/programs/jules_xref2/jules_xref2
-tests/programs/launchbury/launchbury
-tests/programs/lennart_range/lennart_range
-tests/programs/lex/lex
-tests/programs/life_space_leak/life_space_leak
-tests/programs/north_array/north_array
-tests/programs/record_upd/record_upd
-tests/programs/rittri/rittri
-tests/programs/sanders_array/sanders_array
-tests/programs/seward-space-leak/seward-space-leak
-tests/programs/strict_anns/strict_anns
-tests/programs/thurston-modular-arith/thurston-modular-arith
-tests/quasiquotation/T4491/T4491
-tests/rebindable/T5038
-tests/rebindable/rebindable10
-tests/rebindable/rebindable2
-tests/rebindable/rebindable3
-tests/rebindable/rebindable4
-tests/rebindable/rebindable5
-tests/rebindable/rebindable7
-tests/rename/prog006/local.package.conf
-tests/rename/prog006/pkg.conf
-tests/rename/prog006/pwd
-tests/rename/should_compile/T1792_imports.imports
-tests/rename/should_compile/T4239.imports
-tests/rename/should_compile/T4240.imports
-tests/rename/should_compile/T5592
-tests/rts/2047
-tests/rts/2783
-tests/rts/3236
-tests/rts/3424
-tests/rts/4059
-tests/rts/4850
-tests/rts/5250
-tests/rts/5644/5644
-tests/rts/5993
-tests/rts/7087
-tests/rts/T2047
-tests/rts/T2615
-tests/rts/T2783
-tests/rts/T3236
-tests/rts/T4059
-tests/rts/T4850
-tests/rts/T5250
-tests/rts/T5423
-tests/rts/T5644/T5644
-tests/rts/T5993
-tests/rts/T6006
-tests/rts/T7037
-tests/rts/T7037_main
-tests/rts/T7040
-tests/rts/T7087
-tests/rts/T7160
-tests/rts/T7227
-tests/rts/T7227.stat
-tests/rts/T7636
-tests/rts/T7815
-tests/rts/atomicinc
-tests/rts/bug1010
-tests/rts/derefnull
-tests/rts/divbyzero
-tests/rts/exec_signals
-tests/rts/exec_signals_child
-tests/rts/exec_signals_prepare
-tests/rts/ffishutdown
-tests/rts/libfoo_T2615.so
-tests/rts/outofmem
-tests/rts/outofmem2
-tests/rts/prep.out
-tests/rts/return_mem_to_os
-tests/rts/rtsflags001
-tests/rts/rtsflags002
-tests/rts/stablename001
-tests/rts/stack001
-tests/rts/stack002
-tests/rts/stack003
-tests/rts/testblockalloc
-tests/rts/testwsdeque
-tests/rts/traceEvent
-tests/safeHaskell/check/Check04
-tests/safeHaskell/check/pkg01/pdb.ImpSafeOnly01/
-tests/safeHaskell/check/pkg01/pdb.ImpSafeOnly02/
-tests/safeHaskell/check/pkg01/pdb.ImpSafeOnly03/
-tests/safeHaskell/check/pkg01/pdb.ImpSafeOnly04/
-tests/safeHaskell/check/pkg01/pdb.ImpSafeOnly05/
-tests/safeHaskell/check/pkg01/pdb.ImpSafeOnly06/
-tests/safeHaskell/check/pkg01/pdb.ImpSafeOnly07/
-tests/safeHaskell/check/pkg01/pdb.ImpSafeOnly08/
-tests/safeHaskell/check/pkg01/pdb.ImpSafeOnly09/
-tests/safeHaskell/check/pkg01/pdb.ImpSafeOnly10/
-tests/safeHaskell/check/pkg01/pdb.safePkg01/
-tests/safeHaskell/safeLanguage/SafeLang04
-tests/safeHaskell/safeLanguage/SafeLang05
-tests/safeHaskell/safeLanguage/SafeLang06
-tests/safeHaskell/safeLanguage/SafeLang09
-tests/safeHaskell/safeLanguage/SafeLang11
-tests/safeHaskell/safeLanguage/SafeLang13
-tests/safeHaskell/safeLanguage/SafeLang15
-tests/safeHaskell/unsafeLibs/BadImport02
-tests/simplCore/should_compile/T3055.simpl
-tests/simplCore/should_compile/T4138.simpl
-tests/simplCore/should_compile/T7702plugin/pkg.T7702/
-tests/simplCore/should_compile/T7796.prep
-tests/simplCore/should_run/SeqRule
-tests/simplCore/should_run/T2756
-tests/simplCore/should_run/T3403
-tests/simplCore/should_run/T3437
-tests/simplCore/should_run/T3591
-tests/simplCore/should_run/T3959
-tests/simplCore/should_run/T3972
-tests/simplCore/should_run/T3983
-tests/simplCore/should_run/T4814
-tests/simplCore/should_run/T5315
-tests/simplCore/should_run/T5441
-tests/simplCore/should_run/T5453
-tests/simplCore/should_run/T5587
-tests/simplCore/should_run/T5603
-tests/simplCore/should_run/T5625
-tests/simplCore/should_run/T5915
-tests/simplCore/should_run/T5920
-tests/simplCore/should_run/T5997
-tests/simplCore/should_run/T7101
-tests/simplCore/should_run/T7924
-tests/simplCore/should_run/simplrun001
-tests/simplCore/should_run/simplrun002
-tests/simplCore/should_run/simplrun003
-tests/simplCore/should_run/simplrun004
-tests/simplCore/should_run/simplrun005
-tests/simplCore/should_run/simplrun007
-tests/simplCore/should_run/simplrun008
-tests/simplCore/should_run/simplrun009
-tests/simplCore/should_run/simplrun010
-tests/stranal/should_run/T2756b
-tests/stranal/should_run/T7649
-tests/stranal/should_run/strun001
-tests/stranal/should_run/strun002
-tests/stranal/should_run/strun003
-tests/stranal/should_run/strun004
-tests/th/T1835
-tests/th/T3572
-tests/th/T3920
-tests/th/T5379
-tests/th/T5410
-tests/th/T5555
-tests/th/T7064
-tests/th/T7910
-tests/th/TH_Depends
-tests/th/TH_Depends_external.txt
-tests/th/TH_StringPrimL
-tests/th/TH_import_loop/ModuleA.hi-boot
-tests/th/TH_import_loop/ModuleA.o-boot
-tests/th/TH_lookupName
-tests/th/TH_ppr1
-tests/th/TH_recover
-tests/th/TH_repE2
-tests/th/TH_repGuardOutput
-tests/th/TH_repPrimOutput
-tests/th/TH_repPrimOutput2
-tests/th/TH_spliceE1
-tests/th/TH_spliceE4
-tests/th/TH_spliceE5
-tests/th/TH_spliceE5_prof
-tests/th/TH_spliceViewPat/TH_spliceViewPat
-tests/th/TH_unresolvedInfix
-tests/th/TH_viewPatPrint
-tests/th/TH_where
-tests/typecheck/should_compile/tc159
-tests/typecheck/should_fail/T3468.o-boot
-tests/typecheck/should_fail/tcfail149
-tests/typecheck/should_run/Defer01
-tests/typecheck/should_run/IPRun
-tests/typecheck/should_run/T1624
-tests/typecheck/should_run/T1735
-tests/typecheck/should_run/T2722
-tests/typecheck/should_run/T3500a
-tests/typecheck/should_run/T3500b
-tests/typecheck/should_run/T3731
-tests/typecheck/should_run/T3731-short
-tests/typecheck/should_run/T4809
-tests/typecheck/should_run/T5573a
-tests/typecheck/should_run/T5573b
-tests/typecheck/should_run/T5751
-tests/typecheck/should_run/T5759
-tests/typecheck/should_run/T5913
-tests/typecheck/should_run/T6117
-tests/typecheck/should_run/T7023
-tests/typecheck/should_run/T7126
-tests/typecheck/should_run/T7748
-tests/typecheck/should_run/T7861
-tests/typecheck/should_run/TcNullaryTC
-tests/typecheck/should_run/church
-tests/typecheck/should_run/mc17
-tests/typecheck/should_run/tcrun001
-tests/typecheck/should_run/tcrun002
-tests/typecheck/should_run/tcrun003
-tests/typecheck/should_run/tcrun004
-tests/typecheck/should_run/tcrun005
-tests/typecheck/should_run/tcrun006
-tests/typecheck/should_run/tcrun008
-tests/typecheck/should_run/tcrun009
-tests/typecheck/should_run/tcrun010
-tests/typecheck/should_run/tcrun011
-tests/typecheck/should_run/tcrun012
-tests/typecheck/should_run/tcrun013
-tests/typecheck/should_run/tcrun014
-tests/typecheck/should_run/tcrun015
-tests/typecheck/should_run/tcrun016
-tests/typecheck/should_run/tcrun017
-tests/typecheck/should_run/tcrun018
-tests/typecheck/should_run/tcrun019
-tests/typecheck/should_run/tcrun020
-tests/typecheck/should_run/tcrun021
-tests/typecheck/should_run/tcrun022
-tests/typecheck/should_run/tcrun023
-tests/typecheck/should_run/tcrun024
-tests/typecheck/should_run/tcrun025
-tests/typecheck/should_run/tcrun026
-tests/typecheck/should_run/tcrun027
-tests/typecheck/should_run/tcrun028
-tests/typecheck/should_run/tcrun029
-tests/typecheck/should_run/tcrun030
-tests/typecheck/should_run/tcrun031
-tests/typecheck/should_run/tcrun032
-tests/typecheck/should_run/tcrun033
-tests/typecheck/should_run/tcrun034
-tests/typecheck/should_run/tcrun036
-tests/typecheck/should_run/tcrun037
-tests/typecheck/should_run/tcrun038
-tests/typecheck/should_run/tcrun039
-tests/typecheck/should_run/tcrun040
-tests/typecheck/should_run/tcrun041
-tests/typecheck/should_run/tcrun042
-tests/typecheck/should_run/tcrun043
-tests/typecheck/should_run/tcrun044
-tests/typecheck/should_run/tcrun045
-tests/typecheck/should_run/tcrun046
-tests/typecheck/should_run/tcrun047
-tests/typecheck/should_run/tcrun048
-tests/typecheck/should_run/tcrun049
-tests/typecheck/should_run/tcrun050
-tests/typecheck/should_run/tcrun051
-tests/typecheck/should_run/testeq2
-tests/typecheck/testeq1/typecheck.testeq1
-timeout/calibrate.out
-timeout/dist/
-timeout/install-inplace/
+/tests/safeHaskell/safeLanguage/SafeLang04
+/tests/safeHaskell/safeLanguage/SafeLang05
+/tests/safeHaskell/safeLanguage/SafeLang06
+/tests/safeHaskell/safeLanguage/SafeLang09
+/tests/safeHaskell/safeLanguage/SafeLang11
+/tests/safeHaskell/safeLanguage/SafeLang13
+/tests/safeHaskell/safeLanguage/SafeLang15
+/tests/safeHaskell/unsafeLibs/BadImport02
+/tests/simplCore/should_compile/T3055.simpl
+/tests/simplCore/should_compile/T4138.simpl
+/tests/simplCore/should_compile/T7702plugin/pkg.T7702/
+/tests/simplCore/should_compile/T7796.prep
+/tests/simplCore/should_run/SeqRule
+/tests/simplCore/should_run/T2110
+/tests/simplCore/should_run/T2756
+/tests/simplCore/should_run/T3403
+/tests/simplCore/should_run/T3437
+/tests/simplCore/should_run/T3591
+/tests/simplCore/should_run/T3959
+/tests/simplCore/should_run/T3972
+/tests/simplCore/should_run/T3983
+/tests/simplCore/should_run/T457
+/tests/simplCore/should_run/T4814
+/tests/simplCore/should_run/T5315
+/tests/simplCore/should_run/T5441
+/tests/simplCore/should_run/T5453
+/tests/simplCore/should_run/T5587
+/tests/simplCore/should_run/T5603
+/tests/simplCore/should_run/T5625
+/tests/simplCore/should_run/T5915
+/tests/simplCore/should_run/T5920
+/tests/simplCore/should_run/T5997
+/tests/simplCore/should_run/T7101
+/tests/simplCore/should_run/T7924
+/tests/simplCore/should_run/T9128
+/tests/simplCore/should_run/runST
+/tests/simplCore/should_run/simplrun001
+/tests/simplCore/should_run/simplrun002
+/tests/simplCore/should_run/simplrun003
+/tests/simplCore/should_run/simplrun004
+/tests/simplCore/should_run/simplrun005
+/tests/simplCore/should_run/simplrun007
+/tests/simplCore/should_run/simplrun008
+/tests/simplCore/should_run/simplrun009
+/tests/simplCore/should_run/simplrun010
+/tests/simplCore/should_run/simplrun011
+/tests/stranal/should_run/T2756b
+/tests/stranal/should_run/T7649
+/tests/stranal/should_run/T8425/T8425
+/tests/stranal/should_run/T9254
+/tests/stranal/should_run/strun001
+/tests/stranal/should_run/strun002
+/tests/stranal/should_run/strun003
+/tests/stranal/should_run/strun004
+/tests/th/T1835
+/tests/th/T3572
+/tests/th/T3920
+/tests/th/T5379
+/tests/th/T5410
+/tests/th/T5555
+/tests/th/T7064
+/tests/th/T7910
+/tests/th/T8186
+/tests/th/T8633
+/tests/th/TH_Depends
+/tests/th/TH_Depends_external.txt
+/tests/th/TH_StringPrimL
+/tests/th/TH_import_loop/ModuleA.hi-boot
+/tests/th/TH_import_loop/ModuleA.o-boot
+/tests/th/TH_lookupName
+/tests/th/TH_ppr1
+/tests/th/TH_recover
+/tests/th/TH_repE2
+/tests/th/TH_repGuardOutput
+/tests/th/TH_repPrimOutput
+/tests/th/TH_repPrimOutput2
+/tests/th/TH_spliceE1
+/tests/th/TH_spliceE4
+/tests/th/TH_spliceE5
+/tests/th/TH_spliceE5_prof
+/tests/th/TH_spliceViewPat/TH_spliceViewPat
+/tests/th/TH_unresolvedInfix
+/tests/th/TH_viewPatPrint
+/tests/th/TH_where
+/tests/typecheck/should_compile/tc159
+/tests/typecheck/should_compile/tc263
+/tests/typecheck/should_fail/T3468.o-boot
+/tests/typecheck/should_fail/tcfail149
+/tests/typecheck/should_run/Defer01
+/tests/typecheck/should_run/IPRun
+/tests/typecheck/should_run/T1624
+/tests/typecheck/should_run/T1735
+/tests/typecheck/should_run/T2722
+/tests/typecheck/should_run/T3500a
+/tests/typecheck/should_run/T3500b
+/tests/typecheck/should_run/T3731
+/tests/typecheck/should_run/T3731-short
+/tests/typecheck/should_run/T4809
+/tests/typecheck/should_run/T5573a
+/tests/typecheck/should_run/T5573b
+/tests/typecheck/should_run/T5751
+/tests/typecheck/should_run/T5759
+/tests/typecheck/should_run/T5913
+/tests/typecheck/should_run/T6117
+/tests/typecheck/should_run/T7023
+/tests/typecheck/should_run/T7126
+/tests/typecheck/should_run/T7748
+/tests/typecheck/should_run/T7861
+/tests/typecheck/should_run/T8492
+/tests/typecheck/should_run/T8739
+/tests/typecheck/should_run/TcCoercible
+/tests/typecheck/should_run/TcNullaryTC
+/tests/typecheck/should_run/TcTypeNatSimpleRun
+/tests/typecheck/should_run/church
+/tests/typecheck/should_run/mc17
+/tests/typecheck/should_run/tcrun001
+/tests/typecheck/should_run/tcrun002
+/tests/typecheck/should_run/tcrun003
+/tests/typecheck/should_run/tcrun004
+/tests/typecheck/should_run/tcrun005
+/tests/typecheck/should_run/tcrun006
+/tests/typecheck/should_run/tcrun008
+/tests/typecheck/should_run/tcrun009
+/tests/typecheck/should_run/tcrun010
+/tests/typecheck/should_run/tcrun011
+/tests/typecheck/should_run/tcrun012
+/tests/typecheck/should_run/tcrun013
+/tests/typecheck/should_run/tcrun014
+/tests/typecheck/should_run/tcrun015
+/tests/typecheck/should_run/tcrun016
+/tests/typecheck/should_run/tcrun017
+/tests/typecheck/should_run/tcrun018
+/tests/typecheck/should_run/tcrun019
+/tests/typecheck/should_run/tcrun020
+/tests/typecheck/should_run/tcrun021
+/tests/typecheck/should_run/tcrun022
+/tests/typecheck/should_run/tcrun023
+/tests/typecheck/should_run/tcrun024
+/tests/typecheck/should_run/tcrun025
+/tests/typecheck/should_run/tcrun026
+/tests/typecheck/should_run/tcrun027
+/tests/typecheck/should_run/tcrun028
+/tests/typecheck/should_run/tcrun029
+/tests/typecheck/should_run/tcrun030
+/tests/typecheck/should_run/tcrun031
+/tests/typecheck/should_run/tcrun032
+/tests/typecheck/should_run/tcrun033
+/tests/typecheck/should_run/tcrun034
+/tests/typecheck/should_run/tcrun036
+/tests/typecheck/should_run/tcrun037
+/tests/typecheck/should_run/tcrun038
+/tests/typecheck/should_run/tcrun039
+/tests/typecheck/should_run/tcrun040
+/tests/typecheck/should_run/tcrun041
+/tests/typecheck/should_run/tcrun042
+/tests/typecheck/should_run/tcrun043
+/tests/typecheck/should_run/tcrun044
+/tests/typecheck/should_run/tcrun045
+/tests/typecheck/should_run/tcrun046
+/tests/typecheck/should_run/tcrun047
+/tests/typecheck/should_run/tcrun048
+/tests/typecheck/should_run/tcrun049
+/tests/typecheck/should_run/tcrun050
+/tests/typecheck/should_run/tcrun051
+/tests/typecheck/should_run/testeq2
+/tests/typecheck/testeq1/typecheck.testeq1
+/tests/concurrent/should_run/T9379
+/tests/simplCore/should_run/T9390
+/timeout/calibrate.out
+/timeout/dist/
+/timeout/install-inplace/
diff --git a/testsuite/README.md b/testsuite/README.md
index f93453316526..8fc3efd7e126 100644
--- a/testsuite/README.md
+++ b/testsuite/README.md
@@ -40,4 +40,4 @@ The various ways that GHC supports are defined in `config/ghc`
 
 Please see the more extensive documentation [here][1].
 
-  [1]: http://hackage.haskell.org/trac/ghc/wiki/Building/RunningTests
+  [1]: http://ghc.haskell.org/trac/ghc/wiki/Building/RunningTests
diff --git a/testsuite/config/ghc b/testsuite/config/ghc
index 947f558c08ff..031d955552d5 100644
--- a/testsuite/config/ghc
+++ b/testsuite/config/ghc
@@ -21,8 +21,7 @@ config.compile_ways       = ['normal', 'hpc']
 config.run_ways           = ['normal', 'hpc']
 
 # ways that are not enabled by default, but can always be invoked explicitly
-config.other_ways         = ['extcore','optextcore',
-                             'prof',
+config.other_ways         = ['prof',
                              'prof_hc_hb','prof_hb',
                              'prof_hd','prof_hy','prof_hr',
                              'threaded1_ls', 'threaded2_hT',
@@ -93,8 +92,6 @@ config.way_flags = lambda name : {
     'profasm'      : ['-O', '-prof', '-static', '-auto-all'],
     'profthreaded' : ['-O', '-prof', '-static', '-auto-all', '-threaded'],
     'ghci'         : ['--interactive', '-v0', '-ignore-dot-ghci', '+RTS', '-I0.1', '-RTS'],
-    'extcore'      : ['-fext-core'],
-    'optextcore'   : ['-O', '-fext-core'],
     'threaded1'    : ['-threaded', '-debug'],
     'threaded1_ls' : ['-threaded', '-debug'],
     'threaded2'    : ['-O', '-threaded', '-eventlog'],
@@ -127,8 +124,6 @@ config.way_rts_flags = {
     'profasm'      : ['-hc', '-p'], # test heap profiling too
     'profthreaded' : ['-p'],
     'ghci'         : [],
-    'extcore'      : [],
-    'optextcore'   : [],
     'threaded1'    : [],
     'threaded1_ls' : ['-ls'],
     'threaded2'    : ['-N2 -ls'],
@@ -165,6 +160,10 @@ opt_ways = map (lambda x: x[0], \
                  filter(lambda x: '-O' in x[1], \
                         config.way_flags('dummy_name').items()))
 
+llvm_ways = map (lambda x: x[0], \
+                 filter(lambda x: '-fllvm' in x[1], \
+                        config.way_flags('dummy_name').items()))
+
 def get_compiler_info():
 # This should really not go through the shell
     h = os.popen('"' + config.compiler + '" --info', 'r')
diff --git a/testsuite/driver/runtests.py b/testsuite/driver/runtests.py
index c92eaefacc55..103c7ace7c71 100644
--- a/testsuite/driver/runtests.py
+++ b/testsuite/driver/runtests.py
@@ -98,8 +98,8 @@
         config.skip_perf_tests = True
 
     if opt == '--verbose':
-        if arg not in ["0","1","2","3"]:
-            sys.stderr.write("ERROR: requested verbosity %s not supported, use 0,1,2 or 3" % arg)
+        if arg not in ["0","1","2","3","4"]:
+            sys.stderr.write("ERROR: requested verbosity %s not supported, use 0,1,2,3 or 4" % arg)
             sys.exit(1)
         config.verbose = int(arg)
 
diff --git a/testsuite/driver/testglobals.py b/testsuite/driver/testglobals.py
index 203d85f33644..7b9bd9a68662 100644
--- a/testsuite/driver/testglobals.py
+++ b/testsuite/driver/testglobals.py
@@ -252,6 +252,11 @@ def __init__(self):
        # Extra output normalisation
        self.extra_normaliser = lambda x: x
 
+       # Custom output checker, otherwise do a comparison with expected
+       # stdout file.  Accepts two arguments: filename of actual stdout
+       # output, and a normaliser function given other test options
+       self.check_stdout = None
+
        # Extra normalisation for compiler error messages
        self.extra_errmsg_normaliser = lambda x: x
 
diff --git a/testsuite/driver/testlib.py b/testsuite/driver/testlib.py
index 8c8c60d2f510..9a6951b6e531 100644
--- a/testsuite/driver/testlib.py
+++ b/testsuite/driver/testlib.py
@@ -232,6 +232,17 @@ def exit_code( val ):
 def _exit_code( name, opts, v ):
     opts.exit_code = v
 
+def signal_exit_code( val ):
+    if opsys('solaris2'):
+        return exit_code( val );
+    else:
+        # When application running on Linux receives fatal error
+        # signal, then its exit code is encoded as 128 + signal
+        # value. See http://www.tldp.org/LDP/abs/html/exitcodes.html
+        # I assume that Mac OS X behaves in the same way at least Mac
+        # OS X builder behavior suggests this.
+        return exit_code( val+128 );
+
 # -----
 
 def timeout_multiplier( val ):
@@ -468,6 +479,14 @@ def _compile_cmd_prefix( name, opts, prefix ):
 
 # ----
 
+def check_stdout( f ):
+    return lambda name, opts, f=f: _check_stdout(name, opts, f)
+
+def _check_stdout( name, opts, f ):
+    opts.check_stdout = f
+
+# ----
+
 def normalise_slashes( name, opts ):
     opts.extra_normaliser = normalise_slashes_
 
@@ -675,7 +694,7 @@ def test_common_work (name, opts, func, args):
                     result = runCmdFor(name, 'cd ' + getTestOpts().testdir + ' && ' + cleanCmd)
                     if result != 0:
                         framework_fail(name, 'cleaning', 'clean-command failed: ' + str(result))
-            except e:
+            except:
                 framework_fail(name, 'cleaning', 'clean-command exception')
 
         package_conf_cache_file_end_timestamp = get_package_cache_timestamp();
@@ -738,7 +757,7 @@ def do_test(name, way, func, args):
                 result = runCmdFor(name, 'cd ' + getTestOpts().testdir + ' && ' + preCmd)
                 if result != 0:
                     framework_fail(name, way, 'pre-command failed: ' + str(result))
-        except e:
+        except:
             framework_fail(name, way, 'pre-command exception')
 
         try:
@@ -988,8 +1007,6 @@ def compile_and_run__( name, way, top_mod, extra_mods, extra_hc_opts ):
 
     if way == 'ghci': # interpreted...
         return interpreter_run( name, way, extra_hc_opts, 0, top_mod )
-    elif way == 'extcore' or way == 'optextcore' :
-        return extcore_run( name, way, extra_hc_opts, 0, top_mod )
     else: # compiled...
         force = 0
         if extra_mods:
@@ -1015,12 +1032,14 @@ def multi_compile_and_run( name, way, top_mod, extra_mods, extra_hc_opts ):
 
 def stats( name, way, stats_file ):
     opts = getTestOpts()
-    return checkStats(stats_file, opts.stats_range_fields)
+    return checkStats(name, way, stats_file, opts.stats_range_fields)
 
 # -----------------------------------------------------------------------------
 # Check -t stats info
 
-def checkStats(stats_file, range_fields):
+def checkStats(name, way, stats_file, range_fields):
+    full_name = name + '(' + way + ')'
+
     result = passed()
     if len(range_fields) > 0:
         f = open(in_testdir(stats_file))
@@ -1034,8 +1053,10 @@ def checkStats(stats_file, range_fields):
                 result = failBecause('no such stats field')
             val = int(m.group(1))
 
-            lowerBound = trunc(           expected * ((100 - float(dev))/100));
-            upperBound = trunc(0.5 + ceil(expected * ((100 + float(dev))/100)));
+            lowerBound = trunc(           expected * ((100 - float(dev))/100))
+            upperBound = trunc(0.5 + ceil(expected * ((100 + float(dev))/100)))
+
+            deviation = round(((float(val) * 100)/ expected) - 100, 1)
 
             if val < lowerBound:
                 print field, 'value is too low:'
@@ -1046,7 +1067,7 @@ def checkStats(stats_file, range_fields):
                 print field, 'value is too high:'
                 result = failBecause('stat not good enough')
 
-            if val < lowerBound or val > upperBound:
+            if val < lowerBound or val > upperBound or config.verbose >= 4:
                 valStr = str(val)
                 valLen = len(valStr)
                 expectedStr = str(expected)
@@ -1054,10 +1075,12 @@ def checkStats(stats_file, range_fields):
                 length = max(map (lambda x : len(str(x)), [expected, lowerBound, upperBound, val]))
                 def display(descr, val, extra):
                     print descr, string.rjust(str(val), length), extra
-                display('    Expected    ' + field + ':', expected, '+/-' + str(dev) + '%')
-                display('    Lower bound ' + field + ':', lowerBound, '')
-                display('    Upper bound ' + field + ':', upperBound, '')
-                display('    Actual      ' + field + ':', val, '')
+                display('    Expected    ' + full_name + ' ' + field + ':', expected, '+/-' + str(dev) + '%')
+                display('    Lower bound ' + full_name + ' ' + field + ':', lowerBound, '')
+                display('    Upper bound ' + full_name + ' ' + field + ':', upperBound, '')
+                display('    Actual      ' + full_name + ' ' + field + ':', val, '')
+                if val != expected:
+                    display('    Deviation   ' + full_name + ' ' + field + ':', deviation, '%')
                 
     return result
 
@@ -1148,7 +1171,7 @@ def simple_build( name, way, extra_hc_opts, should_fail, top_mod, link, addsuf,
 
     # ToDo: if the sub-shell was killed by ^C, then exit
 
-    statsResult = checkStats(stats_file, opts.compiler_stats_range_fields)
+    statsResult = checkStats(name, way, stats_file, opts.compiler_stats_range_fields)
 
     if badResult(statsResult):
         return statsResult
@@ -1248,7 +1271,7 @@ def simple_run( name, way, prog, args ):
         if check_prof and not check_prof_ok(name):
             return failBecause('bad profile')
 
-    return checkStats(stats_file, opts.stats_range_fields)
+    return checkStats(name, way, stats_file, opts.stats_range_fields)
 
 def rts_flags(way):
     if (way == ''):
@@ -1376,99 +1399,6 @@ def split_file(in_fn, delimiter, out1_fn, out2_fn):
         line = infile.readline()
     out2.close()
 
-# -----------------------------------------------------------------------------
-# Generate External Core for the given program, then compile the resulting Core
-# and compare its output to the expected output
-
-def extcore_run( name, way, extra_hc_opts, compile_only, top_mod ):
-
-    depsfilename = qualify(name, 'deps')
-    errname = add_suffix(name, 'comp.stderr')
-    qerrname = qualify(errname,'')
-
-    hcname = qualify(name, 'hc')
-    oname = qualify(name, 'o')
-
-    rm_no_fail( qerrname )
-    rm_no_fail( qualify(name, '') )
-
-    if (top_mod == ''):
-        srcname = add_hs_lhs_suffix(name)
-    else:
-        srcname = top_mod
-
-    qcorefilename = qualify(name, 'hcr')
-    corefilename = add_suffix(name, 'hcr')
-    rm_no_fail(qcorefilename)
-
-    # Generate External Core
-
-    if (top_mod == ''):
-        to_do = ' ' + srcname + ' '
-    else:
-        to_do = ' --make ' + top_mod + ' '
-
-    flags = copy.copy(getTestOpts().compiler_always_flags)
-    if getTestOpts().outputdir != None:
-        flags.extend(["-outputdir", getTestOpts().outputdir])
-    cmd = 'cd ' + getTestOpts().testdir + " && '" \
-          + config.compiler + "' " \
-          + join(flags,' ') + ' ' \
-          + join(config.way_flags(name)[way],' ') + ' ' \
-          + extra_hc_opts + ' ' \
-          + getTestOpts().extra_hc_opts \
-          + to_do \
-          + '>' + errname + ' 2>&1'
-    result = runCmdFor(name, cmd)
-
-    exit_code = result >> 8
-
-    if exit_code != 0:
-         if_verbose(1,'Compiling to External Core failed (status ' + `result` + ') errors were:')
-         if_verbose_dump(1,qerrname)
-         return failBecause('ext core exit code non-0')
-
-     # Compile the resulting files -- if there's more than one module, we need to read the output
-     # of the previous compilation in order to find the dependencies
-    if (top_mod == ''):
-        to_compile = corefilename
-    else:
-        result = runCmdFor(name, 'grep Compiling ' + qerrname + ' |  awk \'{print $4}\' > ' + depsfilename)
-        deps = open(depsfilename).read()
-        deplist = string.replace(deps, '\n',' ');
-        deplist2 = string.replace(deplist,'.lhs,', '.hcr');
-        to_compile = string.replace(deplist2,'.hs,', '.hcr');
-
-    flags = join(filter(lambda f: f != '-fext-core',config.way_flags(name)[way]),' ')
-    if getTestOpts().outputdir != None:
-        flags.extend(["-outputdir", getTestOpts().outputdir])
-
-    cmd = 'cd ' + getTestOpts().testdir + " && '" \
-          + config.compiler + "' " \
-          + join(getTestOpts().compiler_always_flags,' ') + ' ' \
-          + to_compile + ' ' \
-          + extra_hc_opts + ' ' \
-          + getTestOpts().extra_hc_opts + ' ' \
-          + flags                   \
-          + ' -fglasgow-exts -o ' + name \
-          + '>' + errname + ' 2>&1'
-
-    result = runCmdFor(name, cmd)
-    exit_code = result >> 8
-
-    if exit_code != 0:
-        if_verbose(1,'Compiling External Core file(s) failed (status ' + `result` + ') errors were:')
-        if_verbose_dump(1,qerrname)
-        return failBecause('ext core exit code non-0')
-
-    # Clean up
-    rm_no_fail ( oname )
-    rm_no_fail ( hcname )
-    rm_no_fail ( qcorefilename )
-    rm_no_fail ( depsfilename )
-
-    return simple_run ( name, way, './'+name, getTestOpts().extra_run_opts )
-
 # -----------------------------------------------------------------------------
 # Utils
 
@@ -1487,8 +1417,14 @@ def norm(str):
       else:
          return normalise_output(str)
 
+   two_norm = two_normalisers(norm, getTestOpts().extra_normaliser)
+
+   check_stdout = getTestOpts().check_stdout
+   if check_stdout:
+      return check_stdout(actual_stdout_file, two_norm)
+
    return compare_outputs('stdout', \
-                          two_normalisers(norm, getTestOpts().extra_normaliser), \
+                          two_norm, \
                           expected_stdout_file, actual_stdout_file)
 
 def dump_stdout( name ):
diff --git a/testsuite/mk/test.mk b/testsuite/mk/test.mk
index 0cc3f21c8a1e..d6e550fb9d51 100644
--- a/testsuite/mk/test.mk
+++ b/testsuite/mk/test.mk
@@ -55,7 +55,7 @@ else
 RUNTEST_OPTS += -e ghc_with_native_codegen=0
 endif
 
-GHC_PRIM_LIBDIR := $(shell "$(GHC_PKG)" field ghc-prim library-dirs --simple-output)
+GHC_PRIM_LIBDIR := $(subst library-dirs: ,,$(shell "$(GHC_PKG)" field ghc-prim library-dirs --simple-output))
 HAVE_VANILLA := $(shell if [ -f $(subst \,/,$(GHC_PRIM_LIBDIR))/GHC/PrimopWrappers.hi ]; then echo YES; else echo NO; fi)
 HAVE_DYNAMIC := $(shell if [ -f $(subst \,/,$(GHC_PRIM_LIBDIR))/GHC/PrimopWrappers.dyn_hi ]; then echo YES; else echo NO; fi)
 HAVE_PROFILING := $(shell if [ -f $(subst \,/,$(GHC_PRIM_LIBDIR))/GHC/PrimopWrappers.p_hi ]; then echo YES; else echo NO; fi)
diff --git a/testsuite/tests/Makefile b/testsuite/tests/Makefile
index 9234bcc68ee0..3b2ce49a3dc4 100644
--- a/testsuite/tests/Makefile
+++ b/testsuite/tests/Makefile
@@ -12,7 +12,9 @@ $(error base library does not seem to be installed)
 endif
 
 # Now find the "tests" directories of those libraries, where they exist
-LIBRARY_TEST_PATHS := $(wildcard $(patsubst %, $(TOP)/../libraries/%/tests, $(LIBRARIES)))
+LIBRARY_TEST_PATHS := $(wildcard $(patsubst %, $(TOP)/../libraries/%/tests, $(LIBRARIES))) \
+      $(wildcard $(patsubst %, $(TOP)/../libraries/%/tests-ghc, $(LIBRARIES)))
+
 
 # Add tests from packages
 RUNTEST_OPTS += $(patsubst %, --rootdir=%, $(LIBRARY_TEST_PATHS))
diff --git a/testsuite/tests/annotations/should_compile/th/AnnHelper.hs b/testsuite/tests/annotations/should_compile/th/AnnHelper.hs
new file mode 100644
index 000000000000..ac0f040ba09d
--- /dev/null
+++ b/testsuite/tests/annotations/should_compile/th/AnnHelper.hs
@@ -0,0 +1,16 @@
+module AnnHelper where
+
+import Language.Haskell.TH
+import Language.Haskell.TH.Syntax
+
+traverseModuleAnnotations :: Q [String]
+traverseModuleAnnotations = do
+  ModuleInfo children <- reifyModule =<< thisModule
+  go children [] []
+  where
+    go []     _visited acc = return acc
+    go (x:xs) visited  acc | x `elem` visited = go xs visited acc
+                           | otherwise = do
+                             ModuleInfo newMods <- reifyModule x
+                             newAnns <- reifyAnnotations $ AnnLookupModule x
+                             go (newMods ++ xs) (x:visited) (newAnns ++ acc)
diff --git a/testsuite/tests/annotations/should_compile/th/Makefile b/testsuite/tests/annotations/should_compile/th/Makefile
new file mode 100644
index 000000000000..4159eeeda1f6
--- /dev/null
+++ b/testsuite/tests/annotations/should_compile/th/Makefile
@@ -0,0 +1,33 @@
+TOP=../../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
+
+annth_make:
+	$(MAKE) clean_annth_make
+	mkdir build_make
+	'$(TEST_HC)' $(TEST_HC_OPTS) -v0 --make \
+	   -odir build_make -hidir build_make -o build_make/annth annth.hs
+
+clean_annth_make:
+	rm -rf build_make
+
+annth_compunits:
+	$(MAKE) clean_annth_compunits
+	mkdir build_compunits
+	'$(TEST_HC)' $(TEST_HC_OPTS) -v0 -dynamic-too \
+	  -odir build_compunits -hidir build_compunits \
+	  -c AnnHelper.hs
+	'$(TEST_HC)' $(TEST_HC_OPTS) -v0 -dynamic-too \
+	  -odir build_compunits -hidir build_compunits \
+	  -c TestModule.hs
+	'$(TEST_HC)' $(TEST_HC_OPTS) -v0 -dynamic-too \
+	  -odir build_compunits -hidir build_compunits \
+	  -c TestModuleTH.hs
+	'$(TEST_HC)' $(TEST_HC_OPTS) -v0 -ibuild_compunits \
+	  -odir build_compunits -hidir build_compunits \
+	  -c annth.hs
+
+clean_annth_compunits:
+	rm -rf build_compunits
+
+.PHONY: annth_make clean_annth_make annth_compunits clean_annth_compunits
diff --git a/testsuite/tests/annotations/should_compile/th/TestModule.hs b/testsuite/tests/annotations/should_compile/th/TestModule.hs
new file mode 100644
index 000000000000..d9519eb8b29c
--- /dev/null
+++ b/testsuite/tests/annotations/should_compile/th/TestModule.hs
@@ -0,0 +1,11 @@
+module TestModule where
+
+{-# ANN module "Module annotation" #-}
+
+{-# ANN type TestType "Type annotation" #-}
+{-# ANN TestType "Constructor annotation" #-}
+data TestType = TestType
+
+{-# ANN testValue "Value annotation" #-}
+testValue :: Int
+testValue = 42
diff --git a/testsuite/tests/annotations/should_compile/th/TestModuleTH.hs b/testsuite/tests/annotations/should_compile/th/TestModuleTH.hs
new file mode 100644
index 000000000000..f21b13764b12
--- /dev/null
+++ b/testsuite/tests/annotations/should_compile/th/TestModuleTH.hs
@@ -0,0 +1,18 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+module TestModuleTH where
+
+import Language.Haskell.TH
+
+$(do
+     modAnn <- pragAnnD ModuleAnnotation
+                        (stringE "TH module annotation")
+     [typ] <- [d| data TestTypeTH = TestTypeTH |]
+     conAnn <- pragAnnD (ValueAnnotation $ mkName "TestTypeTH")
+                        (stringE "TH Constructor annotation")
+     typAnn <- pragAnnD (TypeAnnotation $ mkName "TestTypeTH")
+                        (stringE "TH Type annotation")
+     valAnn <- pragAnnD (ValueAnnotation $ mkName "testValueTH")
+                        (stringE "TH Value annotation")
+     [val] <- [d| testValueTH = (42 :: Int) |]
+     return [modAnn, conAnn, typAnn, typ, valAnn, val] )
diff --git a/testsuite/tests/annotations/should_compile/th/all.T b/testsuite/tests/annotations/should_compile/th/all.T
new file mode 100644
index 000000000000..b44a0d594f6b
--- /dev/null
+++ b/testsuite/tests/annotations/should_compile/th/all.T
@@ -0,0 +1,22 @@
+setTestOpts(when(compiler_profiled(), skip))
+
+# Annotations and Template Haskell, require runtime evaluation.  In
+# order for this to work with profiling, we would have to build the
+# program twice and use -osuf p_o (see the TH_splitE5_prof test).  For
+# now, just disable the profiling ways.
+
+test('annth_make',
+     [req_interp,
+      omit_ways(['profasm','profthreaded']),
+      unless(have_dynamic(),skip),
+      clean_cmd('$MAKE -s clean_annth_make')],
+     run_command,
+     ['$MAKE -s --no-print-directory annth_make'])
+
+test('annth_compunits',
+     [req_interp,
+      omit_ways(['profasm','profthreaded']),
+      unless(have_dynamic(),skip),
+      clean_cmd('$MAKE -s clean_annth_compunits')],
+     run_command,
+     ['$MAKE -s --no-print-directory annth_compunits'])
diff --git a/testsuite/tests/annotations/should_compile/th/annth.hs b/testsuite/tests/annotations/should_compile/th/annth.hs
new file mode 100644
index 000000000000..de5d4d32a885
--- /dev/null
+++ b/testsuite/tests/annotations/should_compile/th/annth.hs
@@ -0,0 +1,26 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+import Language.Haskell.TH
+import Language.Haskell.TH.Syntax
+
+import AnnHelper
+import TestModule
+import TestModuleTH
+
+main = do
+  $(do
+    anns <- traverseModuleAnnotations
+    runIO $ print (anns :: [String])
+    anns <- reifyAnnotations (AnnLookupName 'testValue)
+    runIO $ print (anns :: [String])
+    anns <- reifyAnnotations (AnnLookupName 'testValueTH)
+    runIO $ print (anns :: [String])
+    anns <- reifyAnnotations (AnnLookupName ''TestType)
+    runIO $ print (anns :: [String])
+    anns <- reifyAnnotations (AnnLookupName ''TestTypeTH)
+    runIO $ print (anns :: [String])
+    anns <- reifyAnnotations (AnnLookupName 'TestType)
+    runIO $ print (anns :: [String])
+    anns <- reifyAnnotations (AnnLookupName 'TestTypeTH)
+    runIO $ print (anns :: [String])
+    [| return () |] )
diff --git a/testsuite/tests/annotations/should_compile/th/annth_compunits.stdout b/testsuite/tests/annotations/should_compile/th/annth_compunits.stdout
new file mode 100644
index 000000000000..96e4642c7eec
--- /dev/null
+++ b/testsuite/tests/annotations/should_compile/th/annth_compunits.stdout
@@ -0,0 +1,7 @@
+["TH module annotation","Module annotation"]
+["Value annotation"]
+["TH Value annotation"]
+["Type annotation"]
+["TH Type annotation"]
+["Constructor annotation"]
+["TH Constructor annotation"]
diff --git a/testsuite/tests/annotations/should_compile/th/annth_make.stdout b/testsuite/tests/annotations/should_compile/th/annth_make.stdout
new file mode 100644
index 000000000000..96e4642c7eec
--- /dev/null
+++ b/testsuite/tests/annotations/should_compile/th/annth_make.stdout
@@ -0,0 +1,7 @@
+["TH module annotation","Module annotation"]
+["Value annotation"]
+["TH Value annotation"]
+["Type annotation"]
+["TH Type annotation"]
+["Constructor annotation"]
+["TH Constructor annotation"]
diff --git a/testsuite/tests/annotations/should_fail/annfail01.stderr b/testsuite/tests/annotations/should_fail/annfail01.stderr
index 6cafc25490a6..44ac680a8938 100644
--- a/testsuite/tests/annotations/should_fail/annfail01.stderr
+++ b/testsuite/tests/annotations/should_fail/annfail01.stderr
@@ -1,8 +1,8 @@
 
 annfail01.hs:4:1:
-    Not in scope: type constructor or class ‛Foo’
+    Not in scope: type constructor or class ‘Foo’
     In the annotation: {-# ANN type Foo (1 :: Int) #-}
 
 annfail01.hs:5:1:
-    Not in scope: ‛f’
+    Not in scope: ‘f’
     In the annotation: {-# ANN f (1 :: Int) #-}
diff --git a/testsuite/tests/annotations/should_fail/annfail02.stderr b/testsuite/tests/annotations/should_fail/annfail02.stderr
index 84c954883a51..d52e52abddbb 100644
--- a/testsuite/tests/annotations/should_fail/annfail02.stderr
+++ b/testsuite/tests/annotations/should_fail/annfail02.stderr
@@ -1,8 +1,8 @@
 
 annfail02.hs:6:1:
-    Not in scope: data constructor ‛Foo’
+    Not in scope: data constructor ‘Foo’
     In the annotation: {-# ANN Foo (1 :: Int) #-}
 
 annfail02.hs:7:1:
-    Not in scope: type constructor or class ‛Bar’
+    Not in scope: type constructor or class ‘Bar’
     In the annotation: {-# ANN type Bar (2 :: Int) #-}
diff --git a/testsuite/tests/annotations/should_fail/annfail03.stderr b/testsuite/tests/annotations/should_fail/annfail03.stderr
index 7e880d4d95aa..05e05a6bee70 100644
--- a/testsuite/tests/annotations/should_fail/annfail03.stderr
+++ b/testsuite/tests/annotations/should_fail/annfail03.stderr
@@ -1,6 +1,6 @@
 
 annfail03.hs:17:11:
     GHC stage restriction:
-      ‛InModule’ is used in a top-level splice or annotation,
+      ‘InModule’ is used in a top-level splice or annotation,
       and must be imported, not defined locally
     In the annotation: {-# ANN f InModule #-}
diff --git a/testsuite/tests/annotations/should_fail/annfail04.stderr b/testsuite/tests/annotations/should_fail/annfail04.stderr
index 70ff2e685b39..bb638bc2ab45 100644
--- a/testsuite/tests/annotations/should_fail/annfail04.stderr
+++ b/testsuite/tests/annotations/should_fail/annfail04.stderr
@@ -1,7 +1,7 @@
 
 annfail04.hs:14:12:
     GHC stage restriction:
-      instance for ‛Thing
+      instance for ‘Thing
                       Int’ is used in a top-level splice or annotation,
       and must be imported, not defined locally
     In the annotation: {-# ANN f (thing :: Int) #-}
diff --git a/testsuite/tests/annotations/should_fail/annfail06.stderr b/testsuite/tests/annotations/should_fail/annfail06.stderr
index a807aafd9be1..6bae2c11b70c 100644
--- a/testsuite/tests/annotations/should_fail/annfail06.stderr
+++ b/testsuite/tests/annotations/should_fail/annfail06.stderr
@@ -1,7 +1,7 @@
 
 annfail06.hs:22:1:
     GHC stage restriction:
-      instance for ‛Data
+      instance for ‘Data
                       InstancesInWrongModule’ is used in a top-level splice or annotation,
       and must be imported, not defined locally
     In the annotation: {-# ANN f InstancesInWrongModule #-}
diff --git a/testsuite/tests/annotations/should_fail/annfail07.stderr b/testsuite/tests/annotations/should_fail/annfail07.stderr
index 5f966a7bde76..e7cd8dd000d1 100644
--- a/testsuite/tests/annotations/should_fail/annfail07.stderr
+++ b/testsuite/tests/annotations/should_fail/annfail07.stderr
@@ -1,5 +1,5 @@
 
 annfail07.hs:9:17:
-    Couldn't match expected type ‛[a0]’ with actual type ‛Bool’
-    In the first argument of ‛head’, namely ‛True’
+    Couldn't match expected type ‘[a0]’ with actual type ‘Bool’
+    In the first argument of ‘head’, namely ‘True’
     In the annotation: {-# ANN f (head True) #-}
diff --git a/testsuite/tests/annotations/should_fail/annfail08.stderr b/testsuite/tests/annotations/should_fail/annfail08.stderr
index 8a64c82e1ead..b2d119de687f 100644
--- a/testsuite/tests/annotations/should_fail/annfail08.stderr
+++ b/testsuite/tests/annotations/should_fail/annfail08.stderr
@@ -5,5 +5,5 @@ annfail08.hs:9:1:
     In the annotation: {-# ANN f (id + 1) #-}
 
 annfail08.hs:9:15:
-    No instance for (Num (a0 -> a0)) arising from a use of ‛+’
+    No instance for (Num (a0 -> a0)) arising from a use of ‘+’
     In the annotation: {-# ANN f (id + 1) #-}
diff --git a/testsuite/tests/annotations/should_fail/annfail09.stderr b/testsuite/tests/annotations/should_fail/annfail09.stderr
index f1bd77cb7cd3..f0a03aee9c6f 100644
--- a/testsuite/tests/annotations/should_fail/annfail09.stderr
+++ b/testsuite/tests/annotations/should_fail/annfail09.stderr
@@ -1,6 +1,6 @@
 
 annfail09.hs:11:11:
     GHC stage restriction:
-      ‛g’ is used in a top-level splice or annotation,
+      ‘g’ is used in a top-level splice or annotation,
       and must be imported, not defined locally
     In the annotation: {-# ANN f g #-}
diff --git a/testsuite/tests/annotations/should_fail/annfail10.stderr b/testsuite/tests/annotations/should_fail/annfail10.stderr
index f9bfe2697efd..17d380ea7b31 100644
--- a/testsuite/tests/annotations/should_fail/annfail10.stderr
+++ b/testsuite/tests/annotations/should_fail/annfail10.stderr
@@ -1,25 +1,25 @@
 
 annfail10.hs:9:1:
     No instance for (Data.Data.Data a0) arising from an annotation
-    The type variable ‛a0’ is ambiguous
+    The type variable ‘a0’ is ambiguous
     Note: there are several potential instances:
-      instance Data.Data.Data () -- Defined in ‛Data.Data’
+      instance Data.Data.Data () -- Defined in ‘Data.Data’
       instance (Data.Data.Data a, Data.Data.Data b) =>
                Data.Data.Data (a, b)
-        -- Defined in ‛Data.Data’
+        -- Defined in ‘Data.Data’
       instance (Data.Data.Data a, Data.Data.Data b, Data.Data.Data c) =>
                Data.Data.Data (a, b, c)
-        -- Defined in ‛Data.Data’
+        -- Defined in ‘Data.Data’
       ...plus 31 others
     In the annotation: {-# ANN f 1 #-}
 
 annfail10.hs:9:11:
-    No instance for (Num a0) arising from the literal ‛1’
-    The type variable ‛a0’ is ambiguous
+    No instance for (Num a0) arising from the literal ‘1’
+    The type variable ‘a0’ is ambiguous
     Note: there are several potential instances:
-      instance Num Double -- Defined in ‛GHC.Float’
-      instance Num Float -- Defined in ‛GHC.Float’
+      instance Num Double -- Defined in ‘GHC.Float’
+      instance Num Float -- Defined in ‘GHC.Float’
       instance Integral a => Num (GHC.Real.Ratio a)
-        -- Defined in ‛GHC.Real’
+        -- Defined in ‘GHC.Real’
       ...plus 11 others
     In the annotation: {-# ANN f 1 #-}
diff --git a/testsuite/tests/annotations/should_fail/annfail11.stderr b/testsuite/tests/annotations/should_fail/annfail11.stderr
index 3fa446f8e047..384f6179aabd 100644
--- a/testsuite/tests/annotations/should_fail/annfail11.stderr
+++ b/testsuite/tests/annotations/should_fail/annfail11.stderr
@@ -1,10 +1,10 @@
 
 annfail11.hs:3:1:
-    Not in scope: ‛length’
+    Not in scope: ‘length’
     In the annotation:
       {-# ANN length "Cannot annotate other modules yet" #-}
 
 annfail11.hs:4:1:
-    Not in scope: type constructor or class ‛Integer’
+    Not in scope: type constructor or class ‘Integer’
     In the annotation:
       {-# ANN type Integer "Cannot annotate other modules yet" #-}
diff --git a/testsuite/tests/annotations/should_fail/annfail13.stderr b/testsuite/tests/annotations/should_fail/annfail13.stderr
index 8470592208c8..a35e9e70f302 100644
--- a/testsuite/tests/annotations/should_fail/annfail13.stderr
+++ b/testsuite/tests/annotations/should_fail/annfail13.stderr
@@ -1,2 +1,2 @@
 
-annfail13.hs:4:14: parse error on input ‛1’
+annfail13.hs:4:14: parse error on input ‘1’
diff --git a/testsuite/tests/arrows/should_fail/T5380.stderr b/testsuite/tests/arrows/should_fail/T5380.stderr
index 218d36fb9c39..02e65c536679 100644
--- a/testsuite/tests/arrows/should_fail/T5380.stderr
+++ b/testsuite/tests/arrows/should_fail/T5380.stderr
@@ -1,7 +1,7 @@
 
 T5380.hs:7:27:
-    Couldn't match expected type ‛Bool’ with actual type ‛not_bool’
-      ‛not_bool’ is a rigid type variable bound by
+    Couldn't match expected type ‘Bool’ with actual type ‘not_bool’
+      ‘not_bool’ is a rigid type variable bound by
                  the type signature for
                    testB :: not_bool -> (() -> ()) -> () -> not_unit
                  at T5380.hs:6:10
@@ -13,8 +13,8 @@ T5380.hs:7:27:
     In the expression: proc () -> if b then f -< () else f -< ()
 
 T5380.hs:7:34:
-    Couldn't match type ‛not_unit’ with ‛()’
-      ‛not_unit’ is a rigid type variable bound by
+    Couldn't match type ‘not_unit’ with ‘()’
+      ‘not_unit’ is a rigid type variable bound by
                  the type signature for
                    testB :: not_bool -> (() -> ()) -> () -> not_unit
                  at T5380.hs:6:10
diff --git a/testsuite/tests/arrows/should_fail/arrowfail001.stderr b/testsuite/tests/arrows/should_fail/arrowfail001.stderr
index 6dc2cb76c4a1..5c448c7a162b 100644
--- a/testsuite/tests/arrows/should_fail/arrowfail001.stderr
+++ b/testsuite/tests/arrows/should_fail/arrowfail001.stderr
@@ -1,7 +1,7 @@
 
 arrowfail001.hs:16:36:
-    No instance for (Foo a) arising from a use of ‛foo’
+    No instance for (Foo a) arising from a use of ‘foo’
     In the expression: foo
     In the expression: proc x -> case x of { Bar a -> foo -< a }
-    In an equation for ‛get’:
+    In an equation for ‘get’:
         get = proc x -> case x of { Bar a -> foo -< a }
diff --git a/testsuite/tests/arrows/should_fail/arrowfail002.stderr b/testsuite/tests/arrows/should_fail/arrowfail002.stderr
index 67a93db719a6..569e1d315d2e 100644
--- a/testsuite/tests/arrows/should_fail/arrowfail002.stderr
+++ b/testsuite/tests/arrows/should_fail/arrowfail002.stderr
@@ -1,2 +1,2 @@
 
-arrowfail002.hs:6:17: Not in scope: ‛x’
+arrowfail002.hs:6:17: Not in scope: ‘x’
diff --git a/testsuite/tests/arrows/should_fail/arrowfail004.stderr b/testsuite/tests/arrows/should_fail/arrowfail004.stderr
index 65cef2545b93..1386d14ce27b 100644
--- a/testsuite/tests/arrows/should_fail/arrowfail004.stderr
+++ b/testsuite/tests/arrows/should_fail/arrowfail004.stderr
@@ -3,5 +3,5 @@ arrowfail004.hs:12:15:
     Proc patterns cannot use existential or GADT data constructors
     In the pattern: T x
     In the expression: proc (T x) -> do { returnA -< T x }
-    In an equation for ‛panic’:
+    In an equation for ‘panic’:
         panic = proc (T x) -> do { returnA -< T x }
diff --git a/testsuite/tests/cabal/Makefile b/testsuite/tests/cabal/Makefile
index f0091bceeb2f..062850f76f02 100644
--- a/testsuite/tests/cabal/Makefile
+++ b/testsuite/tests/cabal/Makefile
@@ -165,6 +165,60 @@ shadow:
 	@echo "should SUCCEED:"
 	'$(TEST_HC)' $(TEST_HC_OPTS) -package-db $(PKGCONFSHADOW1) -package-db $(PKGCONFSHADOW2) -package-id shadowdep-1-XXX -c shadow.hs -fno-code
 
+# If we pass --global, we should ignore instances in the user database
+T5442a:
+	@rm -rf package.conf.T5442a.global package.conf.T5442a.user
+	'$(GHC_PKG)' init package.conf.T5442a.global
+	'$(GHC_PKG)' init package.conf.T5442a.user
+	'$(GHC_PKG)' -f package.conf.T5442a.global register --force-files test.pkg 2>/dev/null
+	'$(GHC_PKG)' -f package.conf.T5442a.user register --force-files test.pkg 2>/dev/null
+	'$(GHC_PKG)' --global-package-db=package.conf.T5442a.global --user-package-db=package.conf.T5442a.user --global unregister testpkg
+	@echo "global (should be empty):"
+	'$(GHC_PKG)' -f package.conf.T5442a.global list --simple-output
+	@echo "user:"
+	'$(GHC_PKG)' -f package.conf.T5442a.user list --simple-output
+
+# If we pass --user, we should ignore instances in the global database
+T5442b:
+	@rm -rf package.conf.T5442b.global package.conf.T5442b.user
+	'$(GHC_PKG)' init package.conf.T5442b.global
+	'$(GHC_PKG)' init package.conf.T5442b.user
+	'$(GHC_PKG)' -f package.conf.T5442b.global register --force-files test.pkg 2>/dev/null
+	! '$(GHC_PKG)' --global-package-db=package.conf.T5442b.global --user-package-db=package.conf.T5442b.user --user unregister testpkg
+	@echo "global (should have testpkg):"
+	'$(GHC_PKG)' -f package.conf.T5442b.global list --simple-output
+
+# If we pass -f, we should ignore the user and global databases
+T5442c:
+	@rm -rf package.conf.T5442c.global package.conf.T5442c.user package.conf.T5442c.extra
+	'$(GHC_PKG)' init package.conf.T5442c.global
+	'$(GHC_PKG)' init package.conf.T5442c.user
+	'$(GHC_PKG)' init package.conf.T5442c.extra
+	'$(GHC_PKG)' -f package.conf.T5442c.global register --force-files test.pkg 2>/dev/null
+	'$(GHC_PKG)' -f package.conf.T5442c.user register --force-files test.pkg 2>/dev/null
+	! '$(GHC_PKG)' --global-package-db=package.conf.T5442c.global --user-package-db=package.conf.T5442c.user -f package.conf.T5442c.extra unregister testpkg
+	@echo "global (should have testpkg):"
+	'$(GHC_PKG)' -f package.conf.T5442c.global list --simple-output
+	@echo "use (should have testpkg):"
+	'$(GHC_PKG)' -f package.conf.T5442c.user list --simple-output
+
+# If we pass --global and -f, we remove from the global database, but
+# warn about possible breakage in the full package stack
+T5442d:
+	@rm -rf package.conf.T5442d.global package.conf.T5442d.user package.conf.T5442d.extra
+	'$(GHC_PKG)' init package.conf.T5442d.global
+	'$(GHC_PKG)' init package.conf.T5442d.user
+	'$(GHC_PKG)' init package.conf.T5442d.extra
+	'$(GHC_PKG)' -f package.conf.T5442d.global register --force-files shadow1.pkg 2>/dev/null
+	'$(GHC_PKG)' -f package.conf.T5442d.user register --force-files shadow3.pkg 2>/dev/null
+	'$(GHC_PKG)' --global-package-db=package.conf.T5442d.global -f package.conf.T5442d.extra register --force-files shadow2.pkg 2>/dev/null
+	'$(GHC_PKG)' --global-package-db=package.conf.T5442d.global --user-package-db=package.conf.T5442d.user -f package.conf.T5442d.extra --global unregister shadow --force
+	@echo "global (should be empty):"
+	'$(GHC_PKG)' -f package.conf.T5442d.global list --simple-output
+	@echo "user:"
+	'$(GHC_PKG)' -f package.conf.T5442d.user list --simple-output
+	@echo "extra:"
+	'$(GHC_PKG)' -f package.conf.T5442d.extra list --simple-output
 
 # -----------------------------------------------------------------------------
 # Try piping the output of "ghc-pkg describe" into "ghc-pkg update" for
@@ -182,3 +236,18 @@ ghcpkg02:
 		echo Updating $$i; \
 		$(GHC_PKG) describe --global $$i | $(GHC_PKG_ghcpkg02) update --global --force -; \
 	done
+
+PKGCONF07=local07.package.conf
+LOCAL_GHC_PKG07 = '$(GHC_PKG)' --no-user-package-db -f $(PKGCONF07)
+ghcpkg07:
+	@rm -rf $(PKGCONF07)
+	$(LOCAL_GHC_PKG07) init $(PKGCONF07)
+	$(LOCAL_GHC_PKG07) register --force test.pkg 2>/dev/null
+	$(LOCAL_GHC_PKG07) register --force test7a.pkg 2>/dev/null
+	$(LOCAL_GHC_PKG07) field testpkg7a reexported-modules
+	$(LOCAL_GHC_PKG07) register --force test7b.pkg 2>/dev/null
+	$(LOCAL_GHC_PKG07) field testpkg7b reexported-modules
+
+recache_reexport:
+	@rm -rf recache_reexport_db/package.cache
+	'$(GHC_PKG)' --no-user-package-db --global-package-db=recache_reexport_db recache
diff --git a/testsuite/tests/cabal/T1750A.pkg b/testsuite/tests/cabal/T1750A.pkg
index 9bda51eea08d..3f4a96e22b60 100644
--- a/testsuite/tests/cabal/T1750A.pkg
+++ b/testsuite/tests/cabal/T1750A.pkg
@@ -1,4 +1,5 @@
 name: T1750A
 version: 1
 id: T1750A-1-XXX
+key: T1750A-1
 depends: T1750B-1-XXX
diff --git a/testsuite/tests/cabal/T1750B.pkg b/testsuite/tests/cabal/T1750B.pkg
index 479ce7092c66..caaaefaa1a1e 100644
--- a/testsuite/tests/cabal/T1750B.pkg
+++ b/testsuite/tests/cabal/T1750B.pkg
@@ -1,4 +1,5 @@
 name: T1750B
 version: 1
 id: T1750B-1-XXX
+key: T1750B-1
 depends: T1750A-1-XXX
diff --git a/testsuite/tests/cabal/T5442a.stdout b/testsuite/tests/cabal/T5442a.stdout
new file mode 100644
index 000000000000..7bc64650e0ee
--- /dev/null
+++ b/testsuite/tests/cabal/T5442a.stdout
@@ -0,0 +1,5 @@
+Reading package info from "test.pkg" ... done.
+Reading package info from "test.pkg" ... done.
+global (should be empty):
+user:
+testpkg-1.2.3.4
diff --git a/testsuite/tests/cabal/T5442b.stderr b/testsuite/tests/cabal/T5442b.stderr
new file mode 100644
index 000000000000..da7439820d4f
--- /dev/null
+++ b/testsuite/tests/cabal/T5442b.stderr
@@ -0,0 +1 @@
+ghc-pkg: cannot find package testpkg
diff --git a/testsuite/tests/cabal/T5442b.stdout b/testsuite/tests/cabal/T5442b.stdout
new file mode 100644
index 000000000000..42814de51726
--- /dev/null
+++ b/testsuite/tests/cabal/T5442b.stdout
@@ -0,0 +1,3 @@
+Reading package info from "test.pkg" ... done.
+global (should have testpkg):
+testpkg-1.2.3.4
diff --git a/testsuite/tests/cabal/T5442c.stderr b/testsuite/tests/cabal/T5442c.stderr
new file mode 100644
index 000000000000..da7439820d4f
--- /dev/null
+++ b/testsuite/tests/cabal/T5442c.stderr
@@ -0,0 +1 @@
+ghc-pkg: cannot find package testpkg
diff --git a/testsuite/tests/cabal/T5442c.stdout b/testsuite/tests/cabal/T5442c.stdout
new file mode 100644
index 000000000000..a183e595bade
--- /dev/null
+++ b/testsuite/tests/cabal/T5442c.stdout
@@ -0,0 +1,6 @@
+Reading package info from "test.pkg" ... done.
+Reading package info from "test.pkg" ... done.
+global (should have testpkg):
+testpkg-1.2.3.4
+use (should have testpkg):
+testpkg-1.2.3.4
diff --git a/testsuite/tests/cabal/T5442d.stderr b/testsuite/tests/cabal/T5442d.stderr
new file mode 100644
index 000000000000..be98dec17a22
--- /dev/null
+++ b/testsuite/tests/cabal/T5442d.stderr
@@ -0,0 +1 @@
+unregistering would break the following packages: shadowdep-1 (ignoring)
diff --git a/testsuite/tests/cabal/T5442d.stdout b/testsuite/tests/cabal/T5442d.stdout
new file mode 100644
index 000000000000..05c6619dde18
--- /dev/null
+++ b/testsuite/tests/cabal/T5442d.stdout
@@ -0,0 +1,8 @@
+Reading package info from "shadow1.pkg" ... done.
+Reading package info from "shadow3.pkg" ... done.
+Reading package info from "shadow2.pkg" ... done.
+global (should be empty):
+user:
+shadow-1
+extra:
+shadowdep-1
diff --git a/testsuite/tests/cabal/all.T b/testsuite/tests/cabal/all.T
index d05d05fe1e74..60f8d6df9b8f 100644
--- a/testsuite/tests/cabal/all.T
+++ b/testsuite/tests/cabal/all.T
@@ -47,6 +47,12 @@ test('ghcpkg06',
      run_command,
      ['$MAKE -s --no-print-directory ghcpkg06'])
 
+test('ghcpkg07',
+     extra_clean(['local07.package.conf',
+                  'local07.package.conf.old']),
+     run_command,
+     ['$MAKE -s --no-print-directory ghcpkg07'])
+
 # Test that we *can* compile a module that also belongs to a package
 # (this was disallowed in GHC 6.4 and earlier)
 test('pkg01', normal, compile, [''])
@@ -57,6 +63,28 @@ test('T1750',
                   'localT1750.package.conf.old']),
      run_command, ['$MAKE -s --no-print-directory T1750'])
 
+test('T5442a',
+     [extra_clean(['package.conf.T5442a.global', 'package.conf.T5442a.user'])],
+     run_command,
+     ['$MAKE -s --no-print-directory T5442a'])
+
+test('T5442b',
+     [extra_clean(['package.conf.T5442b.global', 'package.conf.T5442b.user'])],
+     run_command,
+     ['$MAKE -s --no-print-directory T5442b'])
+
+test('T5442c',
+     [extra_clean(['package.conf.T5442c.global', 'package.conf.T5442c.user',
+                   'package.conf.T5442c.extra'])],
+     run_command,
+     ['$MAKE -s --no-print-directory T5442c'])
+
+test('T5442d',
+     [extra_clean(['package.conf.T5442d.global', 'package.conf.T5442d.user',
+                   'package.conf.T5442d.extra'])],
+     run_command,
+     ['$MAKE -s --no-print-directory T5442d'])
+
 test('shadow',
      extra_clean(['shadow.out', 'shadow.hs', 'shadow.hi',
                   'local1shadow1.package.conf',
diff --git a/testsuite/tests/cabal/cabal01/Makefile b/testsuite/tests/cabal/cabal01/Makefile
index b18d8fc3a149..f1b74b4c6822 100644
--- a/testsuite/tests/cabal/cabal01/Makefile
+++ b/testsuite/tests/cabal/cabal01/Makefile
@@ -28,7 +28,7 @@ cabal01:
 # we get a warning if dynlibs are enabled by default that:
 # 	Warning: -rtsopts and -with-rtsopts have no effect with -shared.
 # so we filter the flag out
-	./setup configure -v0 --prefix=$(PREFIX) --with-compiler='$(TEST_HC)' --ghc-options='$(filter-out -rtsopts,$(TEST_HC_OPTS))' --with-hc-pkg='$(GHC_PKG)' --package-db=local.db $(VANILLA) $(PROF) $(DYN)
+	./setup configure -v0 --prefix=$(PREFIX) --with-compiler='$(TEST_HC)' --ghc-options='$(filter-out -rtsopts,$(TEST_HC_OPTS))' --with-hc-pkg='$(GHC_PKG)' --package-db=local.db $(VANILLA) $(PROF) $(DYN) --libsubdir='$$pkgid'
 	./setup build -v0
 	./setup copy -v0
 	echo install1:
@@ -42,4 +42,3 @@ cabal01:
 	echo dist:
 	ls -1 dist
 	if [ "$(CLEANUP)" != "" ]; then $(MAKE) clean; fi
-
diff --git a/testsuite/tests/cabal/cabal05/Makefile b/testsuite/tests/cabal/cabal05/Makefile
new file mode 100644
index 000000000000..d1ade7411382
--- /dev/null
+++ b/testsuite/tests/cabal/cabal05/Makefile
@@ -0,0 +1,72 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
+
+SETUP = ../Setup -v0
+
+# This test is for package reexports
+#   1. install p
+#   2. install q (reexporting p modules)
+#   3. install r (reexporting p and q modules)
+#   4. configure and build s, using modules from q and r
+#
+# Here are the permutations we test for:
+#   - Package qualifier? (YES/NO)
+#   - Where is module? (defined in SELF /
+#         (ORIGinally defined/REEXported) in DEPendency)
+#         For deps, could be BOTH, if there is NO package qualifier
+#   - Renamed? (YES/NO)
+#   - Multiple modules with same name? (YES/NO)
+#
+# It's illegal for the module to be defined in SELF without renaming, or
+# for a package to cause a conflict with itself.  A reexport which does
+# not rename definitionally "conflicts" with the original package's definition.
+#
+# Probably the trickiest bits are when we automatically pick out which package
+# when the package qualifier is missing, and handling whether or not modules
+# should be exposed or hidden.
+
+cabal05: clean
+	$(MAKE) clean
+	'$(GHC_PKG)' init tmp.d
+	'$(TEST_HC)' -v0 --make Setup
+	# build p
+	cd p && $(SETUP) clean
+	cd p && $(SETUP) configure $(CABAL_MINIMAL_BUILD) --with-ghc='$(TEST_HC)' --ghc-options='$(TEST_HC_OPTS)' --package-db=../tmp.d --prefix='$(PWD)/$$pkgid'
+	cd p && $(SETUP) build
+	cd p && $(SETUP) copy
+	cd p && $(SETUP) register
+	# build q
+	cd q && $(SETUP) clean
+	cd q && $(SETUP) configure $(CABAL_MINIMAL_BUILD) --with-ghc='$(TEST_HC)' --ghc-options='$(TEST_HC_OPTS)' --package-db=../tmp.d --prefix='$(PWD)/$$pkgid'
+	cd q && $(SETUP) build
+	cd q && $(SETUP) copy
+	cd q && $(SETUP) register
+	# build r
+	cd r && $(SETUP) clean
+	cd r && $(SETUP) configure $(CABAL_MINIMAL_BUILD) --with-ghc='$(TEST_HC)' --ghc-options='$(TEST_HC_OPTS)' --package-db=../tmp.d --prefix='$(PWD)/$$pkgid'
+	cd r && $(SETUP) build
+	cd r && $(SETUP) copy
+	cd r && $(SETUP) register
+	# build s
+	cd s && $(SETUP) clean
+	cd s && $(SETUP) configure $(CABAL_MINIMAL_BUILD) --with-ghc='$(TEST_HC)' --ghc-options='$(TEST_HC_OPTS)' --package-db=../tmp.d
+	cd s && $(SETUP) build
+	# now test that package recaching works
+	rm tmp.d/package.cache
+	'$(GHC_PKG)' --no-user-package-db --global-package-db=tmp.d recache
+	cd s && $(SETUP) clean
+	cd s && $(SETUP) configure $(CABAL_MINIMAL_BUILD) --with-ghc='$(TEST_HC)' --ghc-options='$(TEST_HC_OPTS)' --package-db=../tmp.d
+	cd s && $(SETUP) build
+	cd t && $(SETUP) clean
+	cd t && $(SETUP) configure $(CABAL_MINIMAL_BUILD) --with-ghc='$(TEST_HC)' --ghc-options='$(TEST_HC_OPTS)' --package-db=../tmp.d
+	! (cd t && $(SETUP) build)
+ifneq "$(CLEANUP)" ""
+	$(MAKE) clean
+endif
+
+clean :
+	'$(GHC_PKG)' unregister --force p >/dev/null 2>&1 || true
+	'$(GHC_PKG)' unregister --force q >/dev/null 2>&1 || true
+	'$(GHC_PKG)' unregister --force r >/dev/null 2>&1 || true
+	$(RM) -r p-* q-* r-* s-* t-* tmp.d *.o *.hi */*.o */*.hi */Setup$(exeext) */dist Setup$(exeext)
diff --git a/testsuite/tests/cabal/cabal05/Setup.hs b/testsuite/tests/cabal/cabal05/Setup.hs
new file mode 100644
index 000000000000..9a994af677b0
--- /dev/null
+++ b/testsuite/tests/cabal/cabal05/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/testsuite/tests/cabal/cabal05/all.T b/testsuite/tests/cabal/cabal05/all.T
new file mode 100644
index 000000000000..36dcbdf9de1a
--- /dev/null
+++ b/testsuite/tests/cabal/cabal05/all.T
@@ -0,0 +1,9 @@
+if default_testopts.cleanup != '':
+   cleanup = 'CLEANUP=1'
+else:
+   cleanup = ''
+
+test('cabal05',
+     ignore_output,
+     run_command,
+     ['$MAKE -s --no-print-directory cabal05 ' + cleanup])
diff --git a/testsuite/tests/cabal/cabal05/p/LICENSE b/testsuite/tests/cabal/cabal05/p/LICENSE
new file mode 100644
index 000000000000..e69de29bb2d1
diff --git a/testsuite/tests/cabal/cabal05/p/P.hs b/testsuite/tests/cabal/cabal05/p/P.hs
new file mode 100644
index 000000000000..f8b82de2ca2d
--- /dev/null
+++ b/testsuite/tests/cabal/cabal05/p/P.hs
@@ -0,0 +1,3 @@
+module P where
+data P = P
+p = True
diff --git a/testsuite/tests/cabal/cabal05/p/P2.hs b/testsuite/tests/cabal/cabal05/p/P2.hs
new file mode 100644
index 000000000000..769760dff84d
--- /dev/null
+++ b/testsuite/tests/cabal/cabal05/p/P2.hs
@@ -0,0 +1 @@
+module P2 where
diff --git a/testsuite/tests/cabal/cabal05/p/Setup.hs b/testsuite/tests/cabal/cabal05/p/Setup.hs
new file mode 100644
index 000000000000..9a994af677b0
--- /dev/null
+++ b/testsuite/tests/cabal/cabal05/p/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/testsuite/tests/cabal/cabal05/p/p.cabal b/testsuite/tests/cabal/cabal05/p/p.cabal
new file mode 100644
index 000000000000..989156c5bea1
--- /dev/null
+++ b/testsuite/tests/cabal/cabal05/p/p.cabal
@@ -0,0 +1,11 @@
+name:                p
+version:             0.1.0.0
+license-file:        LICENSE
+author:              Edward Z. Yang
+maintainer:          ezyang@cs.stanford.edu
+build-type:          Simple
+cabal-version:       >=1.21
+
+library
+  exposed-modules:     P, P2
+  build-depends:       base
diff --git a/testsuite/tests/cabal/cabal05/q/LICENSE b/testsuite/tests/cabal/cabal05/q/LICENSE
new file mode 100644
index 000000000000..e69de29bb2d1
diff --git a/testsuite/tests/cabal/cabal05/q/Q.hs b/testsuite/tests/cabal/cabal05/q/Q.hs
new file mode 100644
index 000000000000..721b231aa1ab
--- /dev/null
+++ b/testsuite/tests/cabal/cabal05/q/Q.hs
@@ -0,0 +1,4 @@
+module Q where
+import P
+data Q = Q
+q = not p
diff --git a/testsuite/tests/cabal/cabal05/q/Setup.hs b/testsuite/tests/cabal/cabal05/q/Setup.hs
new file mode 100644
index 000000000000..9a994af677b0
--- /dev/null
+++ b/testsuite/tests/cabal/cabal05/q/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/testsuite/tests/cabal/cabal05/q/q.cabal b/testsuite/tests/cabal/cabal05/q/q.cabal
new file mode 100644
index 000000000000..338acdd38297
--- /dev/null
+++ b/testsuite/tests/cabal/cabal05/q/q.cabal
@@ -0,0 +1,30 @@
+name:                q
+version:             0.1.0.0
+license-file:        LICENSE
+author:              Edward Z. Yang
+maintainer:          ezyang@cs.stanford.edu
+build-type:          Simple
+cabal-version:       >=1.21
+
+library
+  exposed-modules:     Q
+  reexported-modules:
+    -- qualified=NO, where=DEP(ORIG), renaming=NO, conflict=NO
+    --      impossible
+    -- qualified=NO, where=DEP(ORIG), renaming=NO, conflict=YES (p,s)
+    P,
+    -- qualified=NO, where=DEP(ORIG), renaming=YES, conflict=NO
+    P as QP,
+    -- qualified=NO, where=DEP(ORIG), renaming=YES, conflict=YES (r)
+    P as PMerge,
+    P2 as PMerge2,
+    -- qualified=NO, where=SELF, renaming=NO, conflict=NO
+    --      impossible
+    -- qualified=NO, where=SELF, renaming=NO, conflict=YES
+    --      should error
+    -- qualified=NO, where=SELF, renaming=YES, conflict=NO
+    Q as QQ,
+    -- qualified=NO, where=SELF, renaming=YES, conflict=YES (r)
+    Q as QMerge,
+    P2 as Conflict
+  build-depends:       base, p
diff --git a/testsuite/tests/cabal/cabal05/r/LICENSE b/testsuite/tests/cabal/cabal05/r/LICENSE
new file mode 100644
index 000000000000..e69de29bb2d1
diff --git a/testsuite/tests/cabal/cabal05/r/R.hs b/testsuite/tests/cabal/cabal05/r/R.hs
new file mode 100644
index 000000000000..6f086340cf10
--- /dev/null
+++ b/testsuite/tests/cabal/cabal05/r/R.hs
@@ -0,0 +1,11 @@
+module R where
+import P  -- p (exposed), q (reexport p:P)
+import P2 -- q (reexport p:P)
+import Q  -- q (exposed)
+import qualified QP -- q (reexport p:P)
+import qualified QQ -- q (reexport q:Q)
+import qualified PMerge -- q (reexport p:P)
+import qualified PMerge2 -- q (reexport p:P2)
+import qualified QMerge -- q (reexport q:Q)
+data R = R
+r = p && q
diff --git a/testsuite/tests/cabal/cabal05/r/Setup.hs b/testsuite/tests/cabal/cabal05/r/Setup.hs
new file mode 100644
index 000000000000..9a994af677b0
--- /dev/null
+++ b/testsuite/tests/cabal/cabal05/r/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/testsuite/tests/cabal/cabal05/r/r.cabal b/testsuite/tests/cabal/cabal05/r/r.cabal
new file mode 100644
index 000000000000..b2d4ab0939ca
--- /dev/null
+++ b/testsuite/tests/cabal/cabal05/r/r.cabal
@@ -0,0 +1,33 @@
+name:                r
+version:             0.1.0.0
+license-file:        LICENSE
+author:              Edward Z. Yang
+maintainer:          ezyang@cs.stanford.edu
+build-type:          Simple
+cabal-version:       >=1.21
+
+library
+  exposed-modules:     R
+  reexported-modules:
+    -- qualified=NO, where=DEP(BOTH), renaming=NO, conflict=YES (p,q)
+    P,
+    -- qualified=NO, where=DEP(BOTH), renaming=YES, conflict=NO
+    P as RP2,
+    -- qualified=NO, where=DEP(BOTH), renaming=YES, conflict=YES
+    P as PMerge,
+    -- qualified=YES, where=DEP(ORIG), renaming=YES, conflict=NO
+    p:P as RP,
+    -- qualified=YES, where=DEP(REEX), renaming=YES, conflict=NO
+    q:QP as RQP,
+    -- qualified=YES, where=DEP(REEX), renaming=YES, conflict=NO
+    q:P as RQP2,
+    -- qualified=YES, where=DEP(REEX), renaming=YES, conflict=YES
+    q:QQ as QMerge,
+    -- qualified=YES, where=SELF, renaming=YES, conflict=NO
+    r:R as RR,
+    -- qualified=YES, where=DEP, renaming=NO, conflict=YES (q)
+    q:Q,
+    -- qualified=YES, where=DEP(ORIG), renaming=YES, conflict=YES (q)
+    p:P2 as PMerge2,
+    P as Conflict
+  build-depends:       base, p, q
diff --git a/testsuite/tests/cabal/cabal05/s/LICENSE b/testsuite/tests/cabal/cabal05/s/LICENSE
new file mode 100644
index 000000000000..e69de29bb2d1
diff --git a/testsuite/tests/cabal/cabal05/s/S.hs b/testsuite/tests/cabal/cabal05/s/S.hs
new file mode 100644
index 000000000000..ed3c378072da
--- /dev/null
+++ b/testsuite/tests/cabal/cabal05/s/S.hs
@@ -0,0 +1,18 @@
+module S where
+-- NB: package p is hidden!
+import qualified QP     -- q (reexport p:P)
+import qualified RP     -- r (reexport p:P)
+import qualified Q      -- q (exposed), r (reexport q:Q)
+import qualified R      -- r (exposed)
+import qualified RR     -- r (reexport r:R)
+import qualified RP     -- r (reexport p:P)
+import qualified RQP    -- r (reexport p:P)
+import qualified RQP2   -- r (reexport p:P)
+import qualified PMerge  -- q (reexport p:P), r (reexport p:P)
+import qualified PMerge2 -- q (reexport p:P2), r (reexport p:P2)
+import qualified QMerge  -- q (reexport q:Q), r (reexport q:Q)
+
+x :: QP.P
+x = RP.P
+
+s = QP.p || Q.q || R.r
diff --git a/testsuite/tests/cabal/cabal05/s/Setup.hs b/testsuite/tests/cabal/cabal05/s/Setup.hs
new file mode 100644
index 000000000000..9a994af677b0
--- /dev/null
+++ b/testsuite/tests/cabal/cabal05/s/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/testsuite/tests/cabal/cabal05/s/s.cabal b/testsuite/tests/cabal/cabal05/s/s.cabal
new file mode 100644
index 000000000000..a0b09939a15f
--- /dev/null
+++ b/testsuite/tests/cabal/cabal05/s/s.cabal
@@ -0,0 +1,11 @@
+name:                s
+version:             0.1.0.0
+license-file:        LICENSE
+author:              Edward Z. Yang
+maintainer:          ezyang@cs.stanford.edu
+build-type:          Simple
+cabal-version:       >=1.21
+
+library
+  exposed-modules:     S
+  build-depends:       base, q, r
diff --git a/testsuite/tests/cabal/cabal05/t/LICENSE b/testsuite/tests/cabal/cabal05/t/LICENSE
new file mode 100644
index 000000000000..e69de29bb2d1
diff --git a/testsuite/tests/cabal/cabal05/t/Setup.hs b/testsuite/tests/cabal/cabal05/t/Setup.hs
new file mode 100644
index 000000000000..9a994af677b0
--- /dev/null
+++ b/testsuite/tests/cabal/cabal05/t/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/testsuite/tests/cabal/cabal05/t/T.hs b/testsuite/tests/cabal/cabal05/t/T.hs
new file mode 100644
index 000000000000..fcc3fb0479ba
--- /dev/null
+++ b/testsuite/tests/cabal/cabal05/t/T.hs
@@ -0,0 +1,3 @@
+module T where
+
+import Conflict -- should be ambiguous
diff --git a/testsuite/tests/cabal/cabal05/t/t.cabal b/testsuite/tests/cabal/cabal05/t/t.cabal
new file mode 100644
index 000000000000..10117d6da636
--- /dev/null
+++ b/testsuite/tests/cabal/cabal05/t/t.cabal
@@ -0,0 +1,11 @@
+name:                t
+version:             0.1.0.0
+license-file:        LICENSE
+author:              Edward Z. Yang
+maintainer:          ezyang@cs.stanford.edu
+build-type:          Simple
+cabal-version:       >=1.21
+
+library
+  exposed-modules:     T
+  build-depends:       base, q, r
diff --git a/testsuite/tests/cabal/cabal06/Makefile b/testsuite/tests/cabal/cabal06/Makefile
new file mode 100644
index 000000000000..5934b9b29c64
--- /dev/null
+++ b/testsuite/tests/cabal/cabal06/Makefile
@@ -0,0 +1,70 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
+
+SETUP=../Setup -v0
+
+# This test is for packages whose package IDs overlap, but whose package keys
+# do not.
+#
+#   1. install p-1.0
+#   2. install q-1.0 (depending on p-1.0)
+#   3. install p-1.1
+#   4. install q-1.0, asking for p-1.1
+#   5. install r-1.0 (depending on p-1.1, q-1.0)
+#   6. install r-1.0 asking for p-1.0
+#
+# The notable steps are (4), which previously would have required a reinstall,
+# and (6), where the dependency solver picks between two package keys with the
+# same package ID based on their depenencies.
+#
+# ./Setup configure is pretty dumb, so we spoonfeed it precisely the
+# dependencies it needs.
+
+cabal06: clean
+	$(MAKE) clean
+	'$(GHC_PKG)' init tmp.d
+	'$(TEST_HC)' -v0 --make Setup
+	cd p-1.0 && $(SETUP) clean
+	cd p-1.0 && $(SETUP) configure $(CABAL_MINIMAL_BUILD) --with-ghc='$(TEST_HC)' --ghc-options='$(TEST_HC_OPTS)' --package-db=../tmp.d --prefix='$(PWD)/inst-a' --ghc-pkg-options='--enable-multi-instance'
+	cd p-1.0 && $(SETUP) build
+	cd p-1.0 && $(SETUP) copy
+	cd p-1.0 && $(SETUP) register
+	cd q && $(SETUP) clean
+	cd q && $(SETUP) configure $(CABAL_MINIMAL_BUILD) --with-ghc='$(TEST_HC)' --ghc-options='$(TEST_HC_OPTS)' --package-db=../tmp.d --prefix='$(PWD)/inst-b' --ghc-pkg-options='--enable-multi-instance'
+	cd q && $(SETUP) build
+	cd q && $(SETUP) copy
+	(cd q && $(SETUP) register --print-ipid) > tmp_first_q
+	cd p-1.1 && $(SETUP) clean
+	cd p-1.1 && $(SETUP) configure $(CABAL_MINIMAL_BUILD) --with-ghc='$(TEST_HC)' --ghc-options='$(TEST_HC_OPTS)' --package-db=../tmp.d --prefix='$(PWD)/inst-c' --ghc-pkg-options='--enable-multi-instance'
+	cd p-1.1 && $(SETUP) build
+	cd p-1.1 && $(SETUP) copy
+	cd p-1.1 && $(SETUP) register
+	cd q && $(SETUP) clean
+	cd q && $(SETUP) configure $(CABAL_MINIMAL_BUILD) --with-ghc='$(TEST_HC)' --ghc-options='$(TEST_HC_OPTS)' --package-db=../tmp.d --constraint="p==1.1" --prefix='$(PWD)/inst-d' --ghc-pkg-options='--enable-multi-instance'
+	cd q && $(SETUP) build
+	cd q && $(SETUP) copy
+	(cd q && $(SETUP) register --print-ipid) > tmp_second_q
+	@echo "Does the first instance of q depend on p-1.0?"
+	'$(GHC_PKG)' field --ipid `cat tmp_first_q` depends -f tmp.d | grep p-1.0 | wc -l
+	@echo "Does the second instance of q depend on p-1.0?"
+	'$(GHC_PKG)' field --ipid `cat tmp_second_q` depends -f tmp.d | grep p-1.1 | wc -l
+	cd r && $(SETUP) clean
+	cd r && ../Setup configure $(CABAL_MINIMAL_BUILD) --with-ghc='$(TEST_HC)' --ghc-options='$(TEST_HC_OPTS)' --package-db=../tmp.d --dependency="q=`cat ../tmp_first_q`" --constraint="p==1.0" --prefix='$(PWD)/inst-e' --ghc-pkg-options='--enable-multi-instance'
+	cd r && $(SETUP) build
+	cd r && $(SETUP) copy
+	cd r && $(SETUP) clean
+	cd r && ../Setup configure $(CABAL_MINIMAL_BUILD) --with-ghc='$(TEST_HC)' --ghc-options='$(TEST_HC_OPTS)' --package-db=../tmp.d --dependency="q=`cat ../tmp_second_q`" --constraint="p==1.1" --prefix='$(PWD)/inst-f' --ghc-pkg-options='--enable-multi-instance'
+	cd r && $(SETUP) build
+	cd r && $(SETUP) copy
+	inst-e/bin/cabal06
+	inst-f/bin/cabal06
+ifneq "$(CLEANUP)" ""
+	$(MAKE) clean
+endif
+
+clean :
+	'$(GHC_PKG)' unregister --force p >/dev/null 2>&1 || true
+	'$(GHC_PKG)' unregister --force q >/dev/null 2>&1 || true
+	'$(GHC_PKG)' unregister --force r >/dev/null 2>&1 || true
+	$(RM) -r tmp.d inst-* *.o *.hi */*.o */*.hi */Setup$(exeext) */dist Setup$(exeext)
diff --git a/testsuite/tests/cabal/cabal06/Setup.hs b/testsuite/tests/cabal/cabal06/Setup.hs
new file mode 100644
index 000000000000..9a994af677b0
--- /dev/null
+++ b/testsuite/tests/cabal/cabal06/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/testsuite/tests/cabal/cabal06/all.T b/testsuite/tests/cabal/cabal06/all.T
new file mode 100644
index 000000000000..edca28826502
--- /dev/null
+++ b/testsuite/tests/cabal/cabal06/all.T
@@ -0,0 +1,9 @@
+if default_testopts.cleanup != '':
+   cleanup = 'CLEANUP=1'
+else:
+   cleanup = ''
+
+test('cabal06',
+     normal,
+     run_command,
+     ['$MAKE -s --no-print-directory cabal06 ' + cleanup])
diff --git a/testsuite/tests/cabal/cabal06/cabal06.stderr b/testsuite/tests/cabal/cabal06/cabal06.stderr
new file mode 100644
index 000000000000..e69de29bb2d1
diff --git a/testsuite/tests/cabal/cabal06/cabal06.stdout b/testsuite/tests/cabal/cabal06/cabal06.stdout
new file mode 100644
index 000000000000..e5ff042302ab
--- /dev/null
+++ b/testsuite/tests/cabal/cabal06/cabal06.stdout
@@ -0,0 +1,8 @@
+Does the first instance of q depend on p-1.0?
+1
+Does the second instance of q depend on p-1.0?
+1
+Configuring r-1.0...
+Configuring r-1.0...
+10
+11
diff --git a/testsuite/tests/cabal/cabal06/p-1.0/LICENSE b/testsuite/tests/cabal/cabal06/p-1.0/LICENSE
new file mode 100644
index 000000000000..e69de29bb2d1
diff --git a/testsuite/tests/cabal/cabal06/p-1.0/P.hs b/testsuite/tests/cabal/cabal06/p-1.0/P.hs
new file mode 100644
index 000000000000..7d63e39dac6f
--- /dev/null
+++ b/testsuite/tests/cabal/cabal06/p-1.0/P.hs
@@ -0,0 +1,3 @@
+module P where
+p :: Int
+p = 0
diff --git a/testsuite/tests/cabal/cabal06/p-1.0/p.cabal b/testsuite/tests/cabal/cabal06/p-1.0/p.cabal
new file mode 100644
index 000000000000..ab7b3ebffe0e
--- /dev/null
+++ b/testsuite/tests/cabal/cabal06/p-1.0/p.cabal
@@ -0,0 +1,12 @@
+name:                p
+version:             1.0
+license-file:        LICENSE
+author:              Edward Z. Yang
+maintainer:          ezyang@cs.stanford.edu
+build-type:          Simple
+cabal-version:       >=1.20
+
+library
+  exposed-modules:     P
+  build-depends:       base
+  default-language:    Haskell2010
diff --git a/testsuite/tests/cabal/cabal06/p-1.1/LICENSE b/testsuite/tests/cabal/cabal06/p-1.1/LICENSE
new file mode 100644
index 000000000000..e69de29bb2d1
diff --git a/testsuite/tests/cabal/cabal06/p-1.1/P.hs b/testsuite/tests/cabal/cabal06/p-1.1/P.hs
new file mode 100644
index 000000000000..446448039f39
--- /dev/null
+++ b/testsuite/tests/cabal/cabal06/p-1.1/P.hs
@@ -0,0 +1,3 @@
+module P where
+p :: Int
+p = 1
diff --git a/testsuite/tests/cabal/cabal06/p-1.1/p.cabal b/testsuite/tests/cabal/cabal06/p-1.1/p.cabal
new file mode 100644
index 000000000000..8a7b7b271d15
--- /dev/null
+++ b/testsuite/tests/cabal/cabal06/p-1.1/p.cabal
@@ -0,0 +1,12 @@
+name:                p
+version:             1.1
+license-file:        LICENSE
+author:              Edward Z. Yang
+maintainer:          ezyang@cs.stanford.edu
+build-type:          Simple
+cabal-version:       >=1.20
+
+library
+  exposed-modules:     P
+  build-depends:       base
+  default-language:    Haskell2010
diff --git a/testsuite/tests/cabal/cabal06/q/LICENSE b/testsuite/tests/cabal/cabal06/q/LICENSE
new file mode 100644
index 000000000000..e69de29bb2d1
diff --git a/testsuite/tests/cabal/cabal06/q/Q.hs b/testsuite/tests/cabal/cabal06/q/Q.hs
new file mode 100644
index 000000000000..03d0923450b8
--- /dev/null
+++ b/testsuite/tests/cabal/cabal06/q/Q.hs
@@ -0,0 +1,4 @@
+module Q where
+import P
+q :: Int
+q = p + 10
diff --git a/testsuite/tests/cabal/cabal06/q/q-1.0.conf b/testsuite/tests/cabal/cabal06/q/q-1.0.conf
new file mode 100644
index 000000000000..2c25cee262b6
--- /dev/null
+++ b/testsuite/tests/cabal/cabal06/q/q-1.0.conf
@@ -0,0 +1,19 @@
+name: q
+version: 1.0
+id: q-1.0-beaf238a500e9dd4ea74fe12762b72e1
+
+key: d54a904d84001e92dbb7d30e2bede8ce
+license: AllRightsReserved
+maintainer: ezyang@cs.stanford.edu
+author: Edward Z. Yang
+exposed: True
+exposed-modules:
+    Q
+trusted: False
+import-dirs: /5playpen/t-edyang/ghc-backpack/testsuite/tests/cabal/cabal06/inst-d/lib/x86_64-linux-ghc-7.9.20140719/q-1.0
+library-dirs: /5playpen/t-edyang/ghc-backpack/testsuite/tests/cabal/cabal06/inst-d/lib/x86_64-linux-ghc-7.9.20140719/q-1.0
+hs-libraries: HSd54a904d84001e92dbb7d30e2bede8ce
+depends: base-4.7.1.0-inplace
+         p-1.0-168289aa0216a183a2729001bb18e7a8
+haddock-interfaces: /5playpen/t-edyang/ghc-backpack/testsuite/tests/cabal/cabal06/inst-d/share/doc/x86_64-linux-ghc-7.9.20140719/q-1.0/html/q.haddock
+haddock-html: /5playpen/t-edyang/ghc-backpack/testsuite/tests/cabal/cabal06/inst-d/share/doc/x86_64-linux-ghc-7.9.20140719/q-1.0/html
diff --git a/testsuite/tests/cabal/cabal06/q/q.cabal b/testsuite/tests/cabal/cabal06/q/q.cabal
new file mode 100644
index 000000000000..7b3a074f886f
--- /dev/null
+++ b/testsuite/tests/cabal/cabal06/q/q.cabal
@@ -0,0 +1,12 @@
+name:                q
+version:             1.0
+license-file:        LICENSE
+author:              Edward Z. Yang
+maintainer:          ezyang@cs.stanford.edu
+build-type:          Simple
+cabal-version:       >=1.20
+
+library
+  exposed-modules:     Q
+  build-depends:       base, p
+  default-language:    Haskell2010
diff --git a/testsuite/tests/cabal/cabal06/r/LICENSE b/testsuite/tests/cabal/cabal06/r/LICENSE
new file mode 100644
index 000000000000..e69de29bb2d1
diff --git a/testsuite/tests/cabal/cabal06/r/Main.hs b/testsuite/tests/cabal/cabal06/r/Main.hs
new file mode 100644
index 000000000000..5e626645cdc4
--- /dev/null
+++ b/testsuite/tests/cabal/cabal06/r/Main.hs
@@ -0,0 +1,3 @@
+module Main where
+import Q
+main = print q
diff --git a/testsuite/tests/cabal/cabal06/r/r.cabal b/testsuite/tests/cabal/cabal06/r/r.cabal
new file mode 100644
index 000000000000..60e16c1c78de
--- /dev/null
+++ b/testsuite/tests/cabal/cabal06/r/r.cabal
@@ -0,0 +1,12 @@
+name:                r
+version:             1.0
+license-file:        LICENSE
+author:              Edward Z. Yang
+maintainer:          ezyang@cs.stanford.edu
+build-type:          Simple
+cabal-version:       >=1.20
+
+executable cabal06
+  build-depends:       base, p, q
+  main-is:             Main.hs
+  default-language:    Haskell2010
diff --git a/testsuite/tests/cabal/ghcpkg01.stderr b/testsuite/tests/cabal/ghcpkg01.stderr
index 585c7aaa83b1..a6ef40019e0a 100644
--- a/testsuite/tests/cabal/ghcpkg01.stderr
+++ b/testsuite/tests/cabal/ghcpkg01.stderr
@@ -1,2 +1,2 @@
-ghc-pkg: unregistering testpkg-2.0 would break the following packages: testpkg-3.0 (use --force to override)
+ghc-pkg: unregistering would break the following packages: testpkg-3.0 (use --force to override)
 testpkg-3.0: dependency "testpkg-2.0-XXX" doesn't exist (use --force to override)
diff --git a/testsuite/tests/cabal/ghcpkg01.stdout b/testsuite/tests/cabal/ghcpkg01.stdout
index 5a74666546b6..c8faf7fdbbeb 100644
--- a/testsuite/tests/cabal/ghcpkg01.stdout
+++ b/testsuite/tests/cabal/ghcpkg01.stdout
@@ -4,69 +4,51 @@ Reading package info from "test.pkg" ... done.
 name: testpkg
 version: 1.2.3.4
 id: testpkg-1.2.3.4-XXX
+key: testpkg-1.2.3.4
 license: BSD3
 copyright: (c) The Univsersity of Glasgow 2004
 maintainer: glasgow-haskell-users@haskell.org
 stability: stable
 homepage: http://www.haskell.org/ghc
 package-url: http://www.haskell.org/ghc
-synopsis:
-description: A Test Package
+description:
+    A Test Package
 category: none
 author: simonmar@microsoft.com
 exposed: True
-exposed-modules: A
+exposed-modules:
+    A
 hidden-modules: B C.D
 trusted: False
 import-dirs: /usr/local/lib/testpkg "c:/Program Files/testpkg"
 library-dirs: /usr/local/lib/testpkg "c:/Program Files/testpkg"
 hs-libraries: testpkg-1.2.3.4
-extra-libraries:
-extra-ghci-libraries:
 include-dirs: /usr/local/include/testpkg "c:/Program Files/testpkg"
-includes:
-depends:
-hugs-options:
-cc-options:
-ld-options:
-framework-dirs:
-frameworks:
-haddock-interfaces:
-haddock-html:
 pkgroot: 
 
 name: testpkg
 version: 1.2.3.4
 id: testpkg-1.2.3.4-XXX
+key: testpkg-1.2.3.4
 license: BSD3
 copyright: (c) The Univsersity of Glasgow 2004
 maintainer: glasgow-haskell-users@haskell.org
 stability: stable
 homepage: http://www.haskell.org/ghc
 package-url: http://www.haskell.org/ghc
-synopsis:
-description: A Test Package
+description:
+    A Test Package
 category: none
 author: simonmar@microsoft.com
 exposed: True
-exposed-modules: A
+exposed-modules:
+    A
 hidden-modules: B C.D
 trusted: False
 import-dirs: /usr/local/lib/testpkg "c:/Program Files/testpkg"
 library-dirs: /usr/local/lib/testpkg "c:/Program Files/testpkg"
 hs-libraries: testpkg-1.2.3.4
-extra-libraries:
-extra-ghci-libraries:
 include-dirs: /usr/local/include/testpkg "c:/Program Files/testpkg"
-includes:
-depends:
-hugs-options:
-cc-options:
-ld-options:
-framework-dirs:
-frameworks:
-haddock-interfaces:
-haddock-html:
 pkgroot: 
 
 import-dirs: /usr/local/lib/testpkg "c:/Program Files/testpkg"
@@ -78,103 +60,76 @@ local01.package.conf:
 name: testpkg
 version: 2.0
 id: testpkg-2.0-XXX
+key: testpkg-2.0
 license: BSD3
 copyright: (c) The Univsersity of Glasgow 2004
 maintainer: glasgow-haskell-users@haskell.org
 stability: unstable
 homepage: http://www.haskell.org/ghc
 package-url: http://www.haskell.org/ghc
-synopsis:
-description: A Test Package (new version)
+description:
+    A Test Package (new version)
 category: none
 author: simonmar@microsoft.com
 exposed: False
-exposed-modules: A
+exposed-modules:
+    A
 hidden-modules: B C.D C.E
 trusted: False
 import-dirs: /usr/local/lib/testpkg "c:/Program Files/testpkg"
 library-dirs: /usr/local/lib/testpkg "c:/Program Files/testpkg"
 hs-libraries: testpkg-2.0
-extra-libraries:
-extra-ghci-libraries:
 include-dirs: /usr/local/include/testpkg "c:/Program Files/testpkg"
-includes:
-depends:
-hugs-options:
-cc-options:
-ld-options:
-framework-dirs:
-frameworks:
-haddock-interfaces:
-haddock-html:
 pkgroot: 
 
 name: testpkg
 version: 2.0
 id: testpkg-2.0-XXX
+key: testpkg-2.0
 license: BSD3
 copyright: (c) The Univsersity of Glasgow 2004
 maintainer: glasgow-haskell-users@haskell.org
 stability: unstable
 homepage: http://www.haskell.org/ghc
 package-url: http://www.haskell.org/ghc
-synopsis:
-description: A Test Package (new version)
+description:
+    A Test Package (new version)
 category: none
 author: simonmar@microsoft.com
 exposed: False
-exposed-modules: A
+exposed-modules:
+    A
 hidden-modules: B C.D C.E
 trusted: False
 import-dirs: /usr/local/lib/testpkg "c:/Program Files/testpkg"
 library-dirs: /usr/local/lib/testpkg "c:/Program Files/testpkg"
 hs-libraries: testpkg-2.0
-extra-libraries:
-extra-ghci-libraries:
 include-dirs: /usr/local/include/testpkg "c:/Program Files/testpkg"
-includes:
-depends:
-hugs-options:
-cc-options:
-ld-options:
-framework-dirs:
-frameworks:
-haddock-interfaces:
-haddock-html:
 pkgroot: 
 ---
 name: testpkg
 version: 1.2.3.4
 id: testpkg-1.2.3.4-XXX
+key: testpkg-1.2.3.4
 license: BSD3
 copyright: (c) The Univsersity of Glasgow 2004
 maintainer: glasgow-haskell-users@haskell.org
 stability: stable
 homepage: http://www.haskell.org/ghc
 package-url: http://www.haskell.org/ghc
-synopsis:
-description: A Test Package
+description:
+    A Test Package
 category: none
 author: simonmar@microsoft.com
 exposed: True
-exposed-modules: A
+exposed-modules:
+    A
 hidden-modules: B C.D
 trusted: False
 import-dirs: /usr/local/lib/testpkg "c:/Program Files/testpkg"
 library-dirs: /usr/local/lib/testpkg "c:/Program Files/testpkg"
 hs-libraries: testpkg-1.2.3.4
-extra-libraries:
-extra-ghci-libraries:
 include-dirs: /usr/local/include/testpkg "c:/Program Files/testpkg"
-includes:
-depends:
-hugs-options:
-cc-options:
-ld-options:
-framework-dirs:
-frameworks:
-haddock-interfaces:
-haddock-html:
 pkgroot: 
 
 version: 2.0
@@ -187,35 +142,26 @@ Reading package info from "test3.pkg" ... done.
 name: testpkg
 version: 1.2.3.4
 id: testpkg-1.2.3.4-XXX
+key: testpkg-1.2.3.4
 license: BSD3
 copyright: (c) The Univsersity of Glasgow 2004
 maintainer: glasgow-haskell-users@haskell.org
 stability: stable
 homepage: http://www.haskell.org/ghc
 package-url: http://www.haskell.org/ghc
-synopsis:
-description: A Test Package
+description:
+    A Test Package
 category: none
 author: simonmar@microsoft.com
 exposed: False
-exposed-modules: A
+exposed-modules:
+    A
 hidden-modules: B C.D
 trusted: False
 import-dirs: /usr/local/lib/testpkg "c:/Program Files/testpkg"
 library-dirs: /usr/local/lib/testpkg "c:/Program Files/testpkg"
 hs-libraries: testpkg-1.2.3.4
-extra-libraries:
-extra-ghci-libraries:
 include-dirs: /usr/local/include/testpkg "c:/Program Files/testpkg"
-includes:
-depends:
-hugs-options:
-cc-options:
-ld-options:
-framework-dirs:
-frameworks:
-haddock-interfaces:
-haddock-html:
 pkgroot: 
 
 local01.package.conf:
diff --git a/testsuite/tests/cabal/ghcpkg05.stderr b/testsuite/tests/cabal/ghcpkg05.stderr
index c4e38c16d925..df8d11a6b971 100644
--- a/testsuite/tests/cabal/ghcpkg05.stderr
+++ b/testsuite/tests/cabal/ghcpkg05.stderr
@@ -15,4 +15,4 @@ The following packages are broken, either because they have a problem
 listed above, or because they depend on a broken package.
 testpkg-2.0
 testpkg-3.0
-ghc-pkg: unregistering testpkg-2.0 would break the following packages: testpkg-3.0 (use --force to override)
+ghc-pkg: unregistering would break the following packages: testpkg-3.0 (use --force to override)
diff --git a/testsuite/tests/cabal/ghcpkg07.stdout b/testsuite/tests/cabal/ghcpkg07.stdout
new file mode 100644
index 000000000000..f890b5bfe18b
--- /dev/null
+++ b/testsuite/tests/cabal/ghcpkg07.stdout
@@ -0,0 +1,11 @@
+Reading package info from "test.pkg" ... done.
+Reading package info from "test7a.pkg" ... done.
+reexported-modules: testpkg:A (A@testpkg-1.2.3.4-XXX)
+                    testpkg:A as A1 (A@testpkg-1.2.3.4-XXX)
+                    E as E2 (E@testpkg7a-1.0-XXX)
+Reading package info from "test7b.pkg" ... done.
+reexported-modules: testpkg:A as F1 (A@testpkg-1.2.3.4-XXX)
+                    testpkg7a:A as F2 (A@testpkg-1.2.3.4-XXX)
+                    testpkg7a:A1 as F3 (A@testpkg-1.2.3.4-XXX)
+                    testpkg7a:E as F4 (E@testpkg7a-1.0-XXX) E (E@testpkg7a-1.0-XXX)
+                    E2 as E3 (E@testpkg7a-1.0-XXX)
diff --git a/testsuite/tests/cabal/recache_reexport_db/a.conf b/testsuite/tests/cabal/recache_reexport_db/a.conf
new file mode 100644
index 000000000000..c0698d70b9c2
--- /dev/null
+++ b/testsuite/tests/cabal/recache_reexport_db/a.conf
@@ -0,0 +1,17 @@
+name: testpkg7a
+version: 1.0
+id: testpkg7a-1.0-XXX
+license: BSD3
+copyright: (c) The Univsersity of Glasgow 2004
+maintainer: glasgow-haskell-users@haskell.org
+stability: stable
+homepage: http://www.haskell.org/ghc
+package-url: http://www.haskell.org/ghc
+description: A Test Package
+category: none
+author: simonmar@microsoft.com
+exposed: True
+exposed-modules: E
+reexported-modules: testpkg:A, testpkg:A as A1, E as E2
+hs-libraries: testpkg7a-1.0
+depends: testpkg-1.2.3.4-XXX
diff --git a/testsuite/tests/cabal/shadow1.pkg b/testsuite/tests/cabal/shadow1.pkg
index 7bf047f3d2b1..553ebeb7768b 100644
--- a/testsuite/tests/cabal/shadow1.pkg
+++ b/testsuite/tests/cabal/shadow1.pkg
@@ -1,4 +1,5 @@
 name: shadow
 version: 1
 id: shadow-1-XXX
+key: shadow-1
 depends:
diff --git a/testsuite/tests/cabal/shadow2.pkg b/testsuite/tests/cabal/shadow2.pkg
index b720dc947956..ae8964117613 100644
--- a/testsuite/tests/cabal/shadow2.pkg
+++ b/testsuite/tests/cabal/shadow2.pkg
@@ -1,4 +1,5 @@
 name: shadowdep
 version: 1
 id: shadowdep-1-XXX
+key: shadowdep-1
 depends: shadow-1-XXX
diff --git a/testsuite/tests/cabal/shadow3.pkg b/testsuite/tests/cabal/shadow3.pkg
index 933ed3f67d86..62c93f95e1b3 100644
--- a/testsuite/tests/cabal/shadow3.pkg
+++ b/testsuite/tests/cabal/shadow3.pkg
@@ -1,4 +1,5 @@
 name: shadow
 version: 1
 id: shadow-1-YYY
+key: shadow-1
 depends:
diff --git a/testsuite/tests/cabal/test.pkg b/testsuite/tests/cabal/test.pkg
index 02a07ab7b694..42c557a0f902 100644
--- a/testsuite/tests/cabal/test.pkg
+++ b/testsuite/tests/cabal/test.pkg
@@ -1,6 +1,7 @@
 name: testpkg
 version: 1.2.3.4
 id: testpkg-1.2.3.4-XXX
+key: testpkg-1.2.3.4
 license: BSD3
 copyright: (c) The Univsersity of Glasgow 2004
 maintainer: glasgow-haskell-users@haskell.org
diff --git a/testsuite/tests/cabal/test2.pkg b/testsuite/tests/cabal/test2.pkg
index a6d28d629a35..c027ed3a15b7 100644
--- a/testsuite/tests/cabal/test2.pkg
+++ b/testsuite/tests/cabal/test2.pkg
@@ -1,6 +1,7 @@
 name: "testpkg"
 version: 2.0
 id: testpkg-2.0-XXX
+key: testpkg-2.0
 license: BSD3
 copyright: (c) The Univsersity of Glasgow 2004
 maintainer: glasgow-haskell-users@haskell.org
diff --git a/testsuite/tests/cabal/test3.pkg b/testsuite/tests/cabal/test3.pkg
index 6d3257126bd8..8f1ca04366a6 100644
--- a/testsuite/tests/cabal/test3.pkg
+++ b/testsuite/tests/cabal/test3.pkg
@@ -1,6 +1,7 @@
 name: "testpkg"
 version: 3.0
 id: testpkg-3.0-XXX
+key: testpkg-3.0
 license: BSD3
 copyright: (c) The Univsersity of Glasgow 2004
 maintainer: glasgow-haskell-users@haskell.org
diff --git a/testsuite/tests/cabal/test4.pkg b/testsuite/tests/cabal/test4.pkg
index 598559a80fd1..c4b1883512ea 100644
--- a/testsuite/tests/cabal/test4.pkg
+++ b/testsuite/tests/cabal/test4.pkg
@@ -1,6 +1,7 @@
 name: "testpkg"
 version: 4.0
 id: testpkg-4.0-XXX
+key: testpkg-4.0
 license: BSD3
 copyright: (c) The Univsersity of Glasgow 2004
 maintainer: glasgow-haskell-users@haskell.org
diff --git a/testsuite/tests/cabal/test5.pkg b/testsuite/tests/cabal/test5.pkg
index fc27bc9ba599..48e198cd301b 100644
--- a/testsuite/tests/cabal/test5.pkg
+++ b/testsuite/tests/cabal/test5.pkg
@@ -1,6 +1,7 @@
 name: "newtestpkg"
 version: 2.0
 id: newtestpkg-2.0-XXX
+key: newtestpkg-2.0
 license: BSD3
 copyright: (c) The Univsersity of Glasgow 2004
 maintainer: glasgow-haskell-users@haskell.org
diff --git a/testsuite/tests/cabal/test7a.pkg b/testsuite/tests/cabal/test7a.pkg
new file mode 100644
index 000000000000..f90fa7320f65
--- /dev/null
+++ b/testsuite/tests/cabal/test7a.pkg
@@ -0,0 +1,18 @@
+name: testpkg7a
+version: 1.0
+id: testpkg7a-1.0-XXX
+key: testpkg7a-1.0
+license: BSD3
+copyright: (c) The Univsersity of Glasgow 2004
+maintainer: glasgow-haskell-users@haskell.org
+stability: stable
+homepage: http://www.haskell.org/ghc
+package-url: http://www.haskell.org/ghc
+description: A Test Package
+category: none
+author: simonmar@microsoft.com
+exposed: True
+exposed-modules: E
+reexported-modules: testpkg:A, testpkg:A as A1, E as E2
+hs-libraries: testpkg7a-1.0
+depends: testpkg-1.2.3.4-XXX
diff --git a/testsuite/tests/cabal/test7b.pkg b/testsuite/tests/cabal/test7b.pkg
new file mode 100644
index 000000000000..e89ac444d8da
--- /dev/null
+++ b/testsuite/tests/cabal/test7b.pkg
@@ -0,0 +1,18 @@
+name: testpkg7b
+version: 1.0
+id: testpkg7b-1.0-XXX
+key: testpkg7b-1.0
+license: BSD3
+copyright: (c) The Univsersity of Glasgow 2004
+maintainer: glasgow-haskell-users@haskell.org
+stability: stable
+homepage: http://www.haskell.org/ghc
+package-url: http://www.haskell.org/ghc
+description: A Test Package
+category: none
+author: simonmar@microsoft.com
+exposed: True
+reexported-modules: testpkg:A as F1, testpkg7a:A as F2,
+    testpkg7a:A1 as F3, testpkg7a:E as F4, E, E2 as E3
+hs-libraries: testpkg7b-1.0
+depends: testpkg-1.2.3.4-XXX, testpkg7a-1.0-XXX
diff --git a/testsuite/tests/cabal/testdup.pkg b/testsuite/tests/cabal/testdup.pkg
index 77000eda2737..0e368e5ae894 100644
--- a/testsuite/tests/cabal/testdup.pkg
+++ b/testsuite/tests/cabal/testdup.pkg
@@ -1,5 +1,6 @@
 name: testdup
 version: 1.0
 id: testdup-1.0-XXX
+key: testdup-1.0
 license: BSD3
 depends: testpkg-1.2.3.4-XXX testpkg-1.2.3.4-XXX
diff --git a/testsuite/tests/callarity/Makefile b/testsuite/tests/callarity/Makefile
new file mode 100644
index 000000000000..9a36a1c5fee5
--- /dev/null
+++ b/testsuite/tests/callarity/Makefile
@@ -0,0 +1,3 @@
+TOP=../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
diff --git a/testsuite/tests/callarity/perf/Makefile b/testsuite/tests/callarity/perf/Makefile
new file mode 100644
index 000000000000..9101fbd40ada
--- /dev/null
+++ b/testsuite/tests/callarity/perf/Makefile
@@ -0,0 +1,3 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
diff --git a/testsuite/tests/callarity/perf/T3924.hs b/testsuite/tests/callarity/perf/T3924.hs
new file mode 100644
index 000000000000..164a3a643083
--- /dev/null
+++ b/testsuite/tests/callarity/perf/T3924.hs
@@ -0,0 +1,13 @@
+f2 :: Int -> Int -> Int
+f2 x1 = if x1 == 0 then (\x0 -> x0) else let
+     y = x1 - 1
+     in f3 y y
+f3 :: Int -> Int -> Int -> Int
+f3 x2 = if x2 == 0 then f2 else let
+     y = x2 - 1
+     in f4 y y
+f4 :: Int -> Int -> Int -> Int -> Int
+f4 x3 = if x3 == 0 then f3 else let
+     y = x3 - 1
+     in \x2 x1 x0 -> f4 y x2 x1 (y + x0)
+main = print (f2 100 0)
diff --git a/testsuite/tests/callarity/perf/T3924.stdout b/testsuite/tests/callarity/perf/T3924.stdout
new file mode 100644
index 000000000000..13c5c81aa61b
--- /dev/null
+++ b/testsuite/tests/callarity/perf/T3924.stdout
@@ -0,0 +1 @@
+3921225
diff --git a/testsuite/tests/callarity/perf/all.T b/testsuite/tests/callarity/perf/all.T
new file mode 100644
index 000000000000..1c7969474cef
--- /dev/null
+++ b/testsuite/tests/callarity/perf/all.T
@@ -0,0 +1,12 @@
+test('T3924',
+     [stats_num_field('bytes allocated', 
+          [ (wordsize(64), 50760, 5),
+              # previously, without call-arity: 22326544
+              # 2014-01-18: 51480  (amd64/Linux)
+              # 2014-07-17: 50760  (amd64/Linux) (Roundabout adjustment)
+            (wordsize(32), 44988, 5) ]),
+              # 2014-04-04: 44988  (Windows, 64-bit machine)
+      only_ways(['normal'])
+      ],
+     compile_and_run,
+     ['-O'])
diff --git a/testsuite/tests/callarity/should_run/Makefile b/testsuite/tests/callarity/should_run/Makefile
new file mode 100644
index 000000000000..9101fbd40ada
--- /dev/null
+++ b/testsuite/tests/callarity/should_run/Makefile
@@ -0,0 +1,3 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
diff --git a/testsuite/tests/callarity/should_run/StrictLet.hs b/testsuite/tests/callarity/should_run/StrictLet.hs
new file mode 100644
index 000000000000..bae0183f74c7
--- /dev/null
+++ b/testsuite/tests/callarity/should_run/StrictLet.hs
@@ -0,0 +1,32 @@
+{-# LANGUAGE MagicHash #-}
+
+{-
+If the (unboxed, hence strict) "let thunk =" would survive to the CallArity
+stage, it might yield wrong results (eta-expanding thunk and hence "cond" would
+be called multiple times).
+
+It does not actually happen (CallArity sees a "case"), so this test just
+safe-guards against future changes here.
+-}
+
+import Debug.Trace
+import GHC.Exts
+import System.Environment
+
+cond :: Int# -> Bool
+cond x = trace ("cond called with " ++ show (I# x)) True
+{-# NOINLINE cond #-}
+
+
+bar (I# x) =
+    let go n = let x = thunk n
+               in case n of
+                    100# -> I# x
+                    _    -> go (n +# 1#)
+    in go x
+  where thunk = if cond x then \x -> (x +# 1#) else \x -> (x -# 1#)
+
+
+main = do
+    args <- getArgs
+    bar (length args) `seq` return ()
diff --git a/testsuite/tests/callarity/should_run/StrictLet.stderr b/testsuite/tests/callarity/should_run/StrictLet.stderr
new file mode 100644
index 000000000000..4387bc0b288d
--- /dev/null
+++ b/testsuite/tests/callarity/should_run/StrictLet.stderr
@@ -0,0 +1 @@
+cond called with 0
diff --git a/testsuite/tests/callarity/should_run/all.T b/testsuite/tests/callarity/should_run/all.T
new file mode 100644
index 000000000000..571448c327fe
--- /dev/null
+++ b/testsuite/tests/callarity/should_run/all.T
@@ -0,0 +1 @@
+test('StrictLet', [], compile_and_run, [''])
diff --git a/testsuite/tests/callarity/unittest/CallArity1.hs b/testsuite/tests/callarity/unittest/CallArity1.hs
new file mode 100644
index 000000000000..dbcac513a1a3
--- /dev/null
+++ b/testsuite/tests/callarity/unittest/CallArity1.hs
@@ -0,0 +1,216 @@
+{-# LANGUAGE TupleSections #-}
+import CoreSyn
+import CoreUtils
+import Id
+import Type
+import MkCore
+import CallArity (callArityRHS)
+import MkId
+import SysTools
+import DynFlags
+import ErrUtils
+import Outputable
+import TysWiredIn
+import Literal
+import GHC
+import Control.Monad
+import Control.Monad.IO.Class
+import System.Environment( getArgs )
+import VarSet
+import PprCore
+import Unique
+import CoreLint
+import FastString
+
+-- Build IDs. use mkTemplateLocal, more predictable than proper uniques
+go, go2, x, d, n, y, z, scrut :: Id
+[go, go2, x,d, n, y, z, scrut, f] = mkTestIds
+    (words "go go2 x d n y z scrut f")
+    [ mkFunTys [intTy, intTy] intTy
+    , mkFunTys [intTy, intTy] intTy
+    , intTy
+    , mkFunTys [intTy] intTy
+    , mkFunTys [intTy] intTy
+    , intTy
+    , intTy
+    , boolTy
+    , mkFunTys [intTy, intTy] intTy -- protoypical external function
+    ]
+
+exprs :: [(String, CoreExpr)]
+exprs =
+  [ ("go2",) $
+     mkRFun go [x]
+        (mkLet d (mkACase (Var go `mkVarApps` [x])
+                          (mkLams [y] $ Var y)
+                  ) $ mkLams [z] $ Var d `mkVarApps` [x]) $
+        go `mkLApps` [0, 0]
+  , ("nested_go2",) $
+     mkRFun go [x]
+        (mkLet n (mkACase (Var go `mkVarApps` [x])
+                          (mkLams [y] $ Var y))  $
+            mkACase (Var n) $
+                mkFun go2 [y]
+                    (mkLet d
+                        (mkACase (Var go `mkVarApps` [x])
+                                 (mkLams [y] $ Var y) ) $
+                        mkLams [z] $ Var d `mkVarApps` [x] )$
+                    Var go2 `mkApps` [mkLit 1] ) $
+        go `mkLApps` [0, 0]
+  , ("d0 (go 2 would be bad)",) $
+     mkRFun go [x]
+        (mkLet d (mkACase (Var go `mkVarApps` [x])
+                          (mkLams [y] $ Var y)
+                  ) $
+            mkLams [z] $ Var f `mkApps` [ Var d `mkVarApps` [x],  Var d `mkVarApps` [x] ]) $
+        go `mkLApps` [0, 0]
+  , ("go2 (in case crut)",) $
+     mkRFun go [x]
+        (mkLet d (mkACase (Var go `mkVarApps` [x])
+                          (mkLams [y] $ Var y)
+                  ) $ mkLams [z] $ Var d `mkVarApps` [x]) $
+        Case (go `mkLApps` [0, 0]) z intTy
+            [(DEFAULT, [], Var f `mkVarApps` [z,z])]
+  , ("go2 (in function call)",) $
+     mkRFun go [x]
+        (mkLet d (mkACase (Var go `mkVarApps` [x])
+                          (mkLams [y] $ Var y)
+                  ) $ mkLams [z] $ Var d `mkVarApps` [x]) $
+        f `mkLApps` [0] `mkApps` [go `mkLApps` [0, 0]]
+  , ("go2 (using surrounding interesting let)",) $
+     mkLet n (f `mkLApps` [0]) $
+         mkRFun go [x]
+            (mkLet d (mkACase (Var go `mkVarApps` [x])
+                              (mkLams [y] $ Var y)
+                      ) $ mkLams [z] $ Var d `mkVarApps` [x]) $
+            Var f `mkApps` [n `mkLApps` [0],  go `mkLApps` [0, 0]]
+  , ("go2 (using surrounding boring let)",) $
+     mkLet z (mkLit 0) $
+         mkRFun go [x]
+            (mkLet d (mkACase (Var go `mkVarApps` [x])
+                              (mkLams [y] $ Var y)
+                      ) $ mkLams [z] $ Var d `mkVarApps` [x]) $
+            Var f `mkApps` [Var z,  go `mkLApps` [0, 0]]
+  , ("two calls, one from let and from body (d 1 would be bad)",) $
+     mkLet  d (mkACase (mkLams [y] $ mkLit 0) (mkLams [y] $ mkLit 0)) $
+     mkFun go [x,y] (mkVarApps (Var d) [x]) $
+     mkApps (Var d) [mkLApps go [1,2]]
+  , ("a thunk in a recursion (d 1 would be bad)",) $
+     mkRLet n (mkACase (mkLams [y] $ mkLit 0) (Var n)) $
+     mkRLet d (mkACase (mkLams [y] $ mkLit 0) (Var d)) $
+         Var n `mkApps` [d `mkLApps` [0]]
+  , ("two thunks, one called multiple times (both arity 1 would be bad!)",) $
+     mkLet n (mkACase (mkLams [y] $ mkLit 0) (f `mkLApps` [0])) $
+     mkLet d (mkACase (mkLams [y] $ mkLit 0) (f `mkLApps` [0])) $
+         Var n `mkApps` [Var d `mkApps` [Var d `mkApps` [mkLit 0]]]
+  , ("two functions, not thunks",) $
+     mkLet go  (mkLams [x] (mkACase (mkLams [y] $ mkLit 0) (Var f `mkVarApps` [x]))) $
+     mkLet go2 (mkLams [x] (mkACase (mkLams [y] $ mkLit 0) (Var f `mkVarApps` [x]))) $
+         Var go `mkApps` [go2 `mkLApps` [0,1], mkLit 0]
+  , ("a thunk, called multiple times via a forking recursion (d 1 would be bad!)",) $
+     mkLet  d   (mkACase (mkLams [y] $ mkLit 0) (f `mkLApps` [0])) $
+     mkRLet go2 (mkLams [x] (mkACase (Var go2 `mkApps` [Var go2 `mkApps` [mkLit 0, mkLit 0]]) (Var d))) $
+         go2 `mkLApps` [0,1]
+  , ("a function, one called multiple times via a forking recursion",) $
+     mkLet go   (mkLams [x] (mkACase (mkLams [y] $ mkLit 0) (Var f `mkVarApps` [x]))) $
+     mkRLet go2 (mkLams [x] (mkACase (Var go2 `mkApps` [Var go2 `mkApps` [mkLit 0, mkLit 0]]) (go `mkLApps` [0]))) $
+         go2 `mkLApps` [0,1]
+  , ("two functions (recursive)",) $
+     mkRLet go  (mkLams [x] (mkACase (mkLams [y] $ mkLit 0) (Var go `mkVarApps` [x]))) $
+     mkRLet go2 (mkLams [x] (mkACase (mkLams [y] $ mkLit 0) (Var go2 `mkVarApps` [x]))) $
+         Var go `mkApps` [go2 `mkLApps` [0,1], mkLit 0]
+  , ("mutual recursion (thunks), called mutiple times (both arity 1 would be bad!)",) $
+     Let (Rec [ (n, mkACase (mkLams [y] $ mkLit 0) (Var d))
+              , (d, mkACase (mkLams [y] $ mkLit 0) (Var n))]) $
+         Var n `mkApps` [Var d `mkApps` [Var d `mkApps` [mkLit 0]]]
+  , ("mutual recursion (functions), but no thunks",) $
+     Let (Rec [ (go,  mkLams [x] (mkACase (mkLams [y] $ mkLit 0) (Var go2 `mkVarApps` [x])))
+              , (go2, mkLams [x] (mkACase (mkLams [y] $ mkLit 0) (Var go `mkVarApps` [x])))]) $
+         Var go `mkApps` [go2 `mkLApps` [0,1], mkLit 0]
+  , ("mutual recursion (functions), one boring (d 1 would be bad)",) $
+     mkLet d (f `mkLApps` [0]) $
+         Let (Rec [ (go,  mkLams [x, y] (Var d `mkApps` [go2 `mkLApps` [1,2]]))
+                  , (go2, mkLams [x] (mkACase (mkLams [y] $ mkLit 0) (Var go `mkVarApps` [x])))]) $
+             Var d `mkApps` [go2 `mkLApps` [0,1]]
+  , ("a thunk (non-function-type), called twice, still calls once",) $
+    mkLet d (f `mkLApps` [0]) $
+        mkLet x (d `mkLApps` [1]) $
+            Var f `mkVarApps` [x, x]
+  , ("a thunk (function type), called multiple times, still calls once",) $
+    mkLet d (f `mkLApps` [0]) $
+        mkLet n (Var f `mkApps` [d `mkLApps` [1]]) $
+            mkLams [x] $ Var n `mkVarApps` [x]
+  , ("a thunk (non-function-type), in mutual recursion, still calls once (d 1 would be good)",) $
+    mkLet d (f `mkLApps` [0]) $
+        Let (Rec [ (x, Var d `mkApps` [go `mkLApps` [1,2]])
+                 , (go, mkLams [x] $ mkACase (mkLams [z] $ Var x) (Var go `mkVarApps` [x]) ) ]) $
+            Var go `mkApps` [mkLit 0, go `mkLApps` [0,1]]
+  , ("a thunk (function type), in mutual recursion, still calls once (d 1 would be good)",) $
+    mkLet d (f `mkLApps` [0]) $
+        Let (Rec [ (n, Var go `mkApps` [d `mkLApps` [1]])
+                 , (go, mkLams [x] $ mkACase (Var n) (Var go `mkApps` [Var n `mkVarApps` [x]]) ) ]) $
+            Var go `mkApps` [mkLit 0, go `mkLApps` [0,1]]
+  , ("a thunk (non-function-type) co-calls with the body (d 1 would be bad)",) $
+    mkLet d (f `mkLApps` [0]) $
+        mkLet x (d `mkLApps` [1]) $
+            Var d `mkVarApps` [x]
+  ]
+
+main = do
+    [libdir] <- getArgs
+    runGhc (Just libdir) $ do
+        getSessionDynFlags >>= setSessionDynFlags . flip gopt_set Opt_SuppressUniques
+        dflags <- getSessionDynFlags
+        liftIO $ forM_ exprs $ \(n,e) -> do
+            case lintExpr [f,scrut] e of
+                Just msg -> putMsg dflags (msg $$ text "in" <+> text n)
+                Nothing -> return ()
+            putMsg dflags (text n <> char ':')
+            -- liftIO $ putMsg dflags (ppr e)
+            let e' = callArityRHS e
+            let bndrs = varSetElems (allBoundIds e')
+            -- liftIO $ putMsg dflags (ppr e')
+            forM_ bndrs $ \v -> putMsg dflags $ nest 4 $ ppr v <+> ppr (idCallArity v)
+
+-- Utilities
+mkLApps :: Id -> [Integer] -> CoreExpr
+mkLApps v = mkApps (Var v) . map mkLit
+
+mkACase = mkIfThenElse (Var scrut)
+
+mkTestId :: Int -> String -> Type -> Id
+mkTestId i s ty = mkSysLocal (mkFastString s) (mkBuiltinUnique i) ty
+
+mkTestIds :: [String] -> [Type] -> [Id]
+mkTestIds ns tys = zipWith3 mkTestId [0..] ns tys
+
+mkLet :: Id -> CoreExpr -> CoreExpr -> CoreExpr
+mkLet v rhs body = Let (NonRec v rhs) body
+
+mkRLet :: Id -> CoreExpr -> CoreExpr -> CoreExpr
+mkRLet v rhs body = Let (Rec [(v, rhs)]) body
+
+mkFun :: Id -> [Id] -> CoreExpr -> CoreExpr -> CoreExpr
+mkFun v xs rhs body = mkLet v (mkLams xs rhs) body
+
+mkRFun :: Id -> [Id] -> CoreExpr -> CoreExpr -> CoreExpr
+mkRFun v xs rhs body = mkRLet v (mkLams xs rhs) body
+
+mkLit :: Integer -> CoreExpr
+mkLit i = Lit (mkLitInteger i intTy)
+
+-- Collects all let-bound IDs
+allBoundIds :: CoreExpr -> VarSet
+allBoundIds (Let (NonRec v rhs) body) = allBoundIds rhs `unionVarSet` allBoundIds body `extendVarSet` v
+allBoundIds (Let (Rec binds) body) =
+    allBoundIds body `unionVarSet` unionVarSets
+        [ allBoundIds rhs `extendVarSet` v | (v, rhs) <- binds ]
+allBoundIds (App e1 e2) = allBoundIds e1 `unionVarSet` allBoundIds e2
+allBoundIds (Case scrut _ _ alts) =
+    allBoundIds scrut `unionVarSet` unionVarSets
+        [ allBoundIds e | (_, _ , e) <- alts ]
+allBoundIds (Lam _ e)  = allBoundIds e
+allBoundIds (Tick _ e) = allBoundIds e
+allBoundIds (Cast e _) = allBoundIds e
+allBoundIds _ = emptyVarSet
+
diff --git a/testsuite/tests/callarity/unittest/CallArity1.stderr b/testsuite/tests/callarity/unittest/CallArity1.stderr
new file mode 100644
index 000000000000..bd3803249948
--- /dev/null
+++ b/testsuite/tests/callarity/unittest/CallArity1.stderr
@@ -0,0 +1,73 @@
+go2:
+    go 2
+    d 1
+nested_go2:
+    go 2
+    go2 2
+    d 1
+    n 1
+d0 (go 2 would be bad):
+    go 1
+    d 0
+go2 (in case crut):
+    go 2
+    d 1
+go2 (in function call):
+    go 2
+    d 1
+go2 (using surrounding interesting let):
+    go 2
+    d 1
+    n 1
+go2 (using surrounding boring let):
+    go 2
+    d 1
+    z 0
+two calls, one from let and from body (d 1 would be bad):
+    go 2
+    d 0
+a thunk in a recursion (d 1 would be bad):
+    d 0
+    n 0
+two thunks, one called multiple times (both arity 1 would be bad!):
+    d 0
+    n 1
+two functions, not thunks:
+    go 2
+    go2 2
+a thunk, called multiple times via a forking recursion (d 1 would be bad!):
+    go2 2
+    d 0
+a function, one called multiple times via a forking recursion:
+    go 2
+    go2 2
+two functions (recursive):
+    go 2
+    go2 2
+mutual recursion (thunks), called mutiple times (both arity 1 would be bad!):
+    d 0
+    n 0
+mutual recursion (functions), but no thunks:
+    go 2
+    go2 2
+mutual recursion (functions), one boring (d 1 would be bad):
+    go 2
+    go2 2
+    d 0
+a thunk (non-function-type), called twice, still calls once:
+    x 0
+    d 1
+a thunk (function type), called multiple times, still calls once:
+    d 1
+    n 0
+a thunk (non-function-type), in mutual recursion, still calls once (d 1 would be good):
+    go 2
+    x 0
+    d 1
+a thunk (function type), in mutual recursion, still calls once (d 1 would be good):
+    go 1
+    d 1
+    n 0
+a thunk (non-function-type) co-calls with the body (d 1 would be bad):
+    x 0
+    d 0
diff --git a/testsuite/tests/callarity/unittest/all.T b/testsuite/tests/callarity/unittest/all.T
new file mode 100644
index 000000000000..e39c1d7597e2
--- /dev/null
+++ b/testsuite/tests/callarity/unittest/all.T
@@ -0,0 +1,8 @@
+def f( name, opts ):
+  opts.only_ways = ['normal']
+
+setTestOpts(f)
+setTestOpts(extra_hc_opts('-package ghc'))
+setTestOpts(extra_run_opts('"' + config.libdir + '"'))
+
+test('CallArity1', normal, compile_and_run, [''])
diff --git a/testsuite/tests/codeGen/should_compile/T9155.hs b/testsuite/tests/codeGen/should_compile/T9155.hs
new file mode 100644
index 000000000000..6fac0bcee6c2
--- /dev/null
+++ b/testsuite/tests/codeGen/should_compile/T9155.hs
@@ -0,0 +1,30 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+module M () where
+
+import Data.Bits ((.&.))
+
+bitsSet :: Int -> Int -> Bool
+bitsSet mask i
+  = (i .&. mask == mask)
+
+class Eq b => BitMask b where
+  assocBitMask :: [(b,Int)]
+
+  fromBitMask  :: Int -> b
+  fromBitMask i
+    = walk assocBitMask
+    where
+      walk []         = error "Graphics.UI.WX.Types.fromBitMask: empty list"
+      walk [(x,0)]    = x
+      walk ((x,m):xs) | bitsSet m i = x
+                      | otherwise   = walk xs
+
+data Align   = AlignLeft
+             | AlignCentre
+             deriving Eq
+
+instance BitMask Align where
+  assocBitMask
+    = [(AlignCentre,512)
+      ,(AlignLeft,  256)
+      ]
diff --git a/testsuite/tests/codeGen/should_compile/T9303.hs b/testsuite/tests/codeGen/should_compile/T9303.hs
new file mode 100644
index 000000000000..0b23de251eed
--- /dev/null
+++ b/testsuite/tests/codeGen/should_compile/T9303.hs
@@ -0,0 +1,10 @@
+module M (f) where
+
+f :: Int -> Int
+f i = go [ 1, 0 ]
+    where
+      go :: [Int] -> Int
+      go []     = undefined
+      go [1]    = undefined
+      go (x:xs) | x == i    = 2
+                | otherwise = go xs
diff --git a/testsuite/tests/codeGen/should_compile/T9329.cmm b/testsuite/tests/codeGen/should_compile/T9329.cmm
new file mode 100644
index 000000000000..da200694fec8
--- /dev/null
+++ b/testsuite/tests/codeGen/should_compile/T9329.cmm
@@ -0,0 +1,5 @@
+foo ()
+{
+  STK_CHK_GEN_N (8); /* panics */
+  return (0);
+}
diff --git a/testsuite/tests/codeGen/should_compile/all.T b/testsuite/tests/codeGen/should_compile/all.T
index 487b6b653c51..a6b68943173c 100644
--- a/testsuite/tests/codeGen/should_compile/all.T
+++ b/testsuite/tests/codeGen/should_compile/all.T
@@ -22,3 +22,6 @@ test('massive_array',
 test('T7237', normal, compile, [''])
 test('T7574', [cmm_src, omit_ways(['llvm', 'optllvm'])], compile, [''])
 test('T8205', normal, compile, ['-O0'])
+test('T9155', normal, compile, ['-O2'])
+test('T9303', normal, compile, ['-O2'])
+test('T9329', [cmm_src], compile, [''])
diff --git a/testsuite/tests/codeGen/should_gen_asm/all.T b/testsuite/tests/codeGen/should_gen_asm/all.T
index be30d5fe10a7..9cd3b4577155 100644
--- a/testsuite/tests/codeGen/should_gen_asm/all.T
+++ b/testsuite/tests/codeGen/should_gen_asm/all.T
@@ -4,3 +4,5 @@ test('memcpy-unroll',
      unless(platform('x86_64-unknown-linux'),skip), compile_cmp_asm, [''])
 test('memcpy-unroll-conprop',
      unless(platform('x86_64-unknown-linux'),skip), compile_cmp_asm, [''])
+test('memset-unroll',
+     unless(platform('x86_64-unknown-linux'),skip), compile_cmp_asm, [''])
diff --git a/testsuite/tests/codeGen/should_gen_asm/memset-unroll.asm b/testsuite/tests/codeGen/should_gen_asm/memset-unroll.asm
new file mode 100644
index 000000000000..4c5c20bfdfc2
--- /dev/null
+++ b/testsuite/tests/codeGen/should_gen_asm/memset-unroll.asm
@@ -0,0 +1,14 @@
+.text
+	.align 8
+.globl callMemset
+.type callMemset, @object
+callMemset:
+.Lc5:
+	movl $16843009,0(%rbx)
+	movl $16843009,4(%rbx)
+	movl $16843009,8(%rbx)
+	movl $16843009,12(%rbx)
+	jmp *(%rbp)
+	.size callMemset, .-callMemset
+.section .note.GNU-stack,"",@progbits
+.ident "GHC 7.9.20140311"
diff --git a/testsuite/tests/codeGen/should_gen_asm/memset-unroll.cmm b/testsuite/tests/codeGen/should_gen_asm/memset-unroll.cmm
new file mode 100644
index 000000000000..825e7ead9092
--- /dev/null
+++ b/testsuite/tests/codeGen/should_gen_asm/memset-unroll.cmm
@@ -0,0 +1,8 @@
+#include "Cmm.h"
+
+// Small memsets should unroll
+callMemset (W_ dst)
+{
+  prim %memset(dst, 1, 16, 4);
+  return ();
+}
diff --git a/testsuite/tests/codeGen/should_run/CopySmallArray.hs b/testsuite/tests/codeGen/should_run/CopySmallArray.hs
new file mode 100644
index 000000000000..6902fe2db20d
--- /dev/null
+++ b/testsuite/tests/codeGen/should_run/CopySmallArray.hs
@@ -0,0 +1,300 @@
+{-# LANGUAGE MagicHash, UnboxedTuples #-}
+
+-- !!! simple tests of copying/cloning primitive arrays
+--
+
+module Main ( main ) where
+
+import GHC.Exts hiding (IsList(..))
+import GHC.Prim
+import GHC.ST
+
+main :: IO ()
+main = putStr
+       (test_copyArray
+        ++ "\n" ++ test_copyMutableArray
+        ++ "\n" ++ test_copyMutableArrayOverlap
+        ++ "\n" ++ test_cloneArray
+        ++ "\n" ++ test_cloneArrayStatic
+        ++ "\n" ++ test_cloneMutableArray
+        ++ "\n" ++ test_cloneMutableArrayEmpty
+        ++ "\n" ++ test_cloneMutableArrayStatic
+        ++ "\n" ++ test_freezeArray
+        ++ "\n" ++ test_freezeArrayStatic
+        ++ "\n" ++ test_thawArray
+        ++ "\n" ++ test_thawArrayStatic
+        ++ "\n"
+       )
+
+------------------------------------------------------------------------
+-- Constants
+
+-- All allocated arrays are of this size
+len :: Int
+len = 130
+
+-- We copy these many elements
+copied :: Int
+copied = len - 2
+
+copiedStatic :: Int
+copiedStatic = 16
+{-# INLINE copiedStatic #-}  -- to make sure optimization triggers
+
+------------------------------------------------------------------------
+-- copySmallArray#
+
+-- Copy a slice of the source array into a destination array and check
+-- that the copy succeeded.
+test_copyArray :: String
+test_copyArray =
+    let dst = runST $ do
+            src <- newArray len 0
+            fill src 0 len
+            src <- unsafeFreezeArray src
+            dst <- newArray len (-1)
+            -- Leave the first and last element untouched
+            copyArray src 1 dst 1 copied
+            unsafeFreezeArray dst
+    in shows (toList dst len) "\n"
+
+------------------------------------------------------------------------
+-- copySmallMutableArray#
+
+-- Copy a slice of the source array into a destination array and check
+-- that the copy succeeded.
+test_copyMutableArray :: String
+test_copyMutableArray =
+    let dst = runST $ do
+            src <- newArray len 0
+            fill src 0 len
+            dst <- newArray len (-1)
+            -- Leave the first and last element untouched
+            copyMutableArray src 1 dst 1 copied
+            unsafeFreezeArray dst
+    in shows (toList dst len) "\n"
+
+-- Perform a copy where the source and destination part overlap.
+test_copyMutableArrayOverlap :: String
+test_copyMutableArrayOverlap =
+    let arr = runST $ do
+            marr <- fromList inp
+            -- Overlap of two elements
+            copyMutableArray marr 5 marr 7 8
+            unsafeFreezeArray marr
+    in shows (toList arr (length inp)) "\n"
+  where
+     -- This case was known to fail at some point.
+     inp = [0,169,196,9,16,25,36,16,25,81,100,121,144,169,196]
+
+------------------------------------------------------------------------
+-- cloneSmallArray#
+
+-- Clone a slice of the source array into a destination array and
+-- check that the clone succeeded.
+test_cloneArray :: String
+test_cloneArray =
+    let dst = runST $ do
+            src <- newArray len 0
+            fill src 0 len
+            src <- unsafeFreezeArray src
+            -- Don't include the first and last element.
+            return $! cloneArray src 1 copied
+    in shows (toList dst copied) "\n"
+
+--  Check that the static-size optimization works.
+test_cloneArrayStatic :: String
+test_cloneArrayStatic =
+    let dst = runST $ do
+            src <- newArray len 0
+            fill src 0 len
+            src <- unsafeFreezeArray src
+            -- Don't include the first and last element.
+            return $! cloneArray src 1 copiedStatic
+    in shows (toList dst copiedStatic) "\n"
+
+------------------------------------------------------------------------
+-- cloneMutableSmallArray#
+
+-- Clone a slice of the source array into a destination array and
+-- check that the clone succeeded.
+test_cloneMutableArray :: String
+test_cloneMutableArray =
+    let dst = runST $ do
+            src <- newArray len 0
+            fill src 0 len
+            -- Don't include the first and last element.
+            dst <- cloneMutableArray src 1 copied
+            unsafeFreezeArray dst
+    in shows (toList dst copied) "\n"
+
+-- Check that zero-length clones work.
+test_cloneMutableArrayEmpty :: String
+test_cloneMutableArrayEmpty =
+    let dst = runST $ do
+            src <- newArray len 0
+            dst <- cloneMutableArray src 0 0
+            unsafeFreezeArray dst
+    in shows (toList dst 0) "\n"
+
+--  Check that the static-size optimization works.
+test_cloneMutableArrayStatic :: String
+test_cloneMutableArrayStatic =
+    let dst = runST $ do
+            src <- newArray len 0
+            fill src 0 len
+            -- Don't include the first and last element.
+            dst <- cloneMutableArray src 1 copiedStatic
+            unsafeFreezeArray dst
+    in shows (toList dst copiedStatic) "\n"
+
+------------------------------------------------------------------------
+-- freezeSmallArray#
+
+-- Clone a slice of the source array into a destination array and
+-- check that the clone succeeded.
+test_freezeArray :: String
+test_freezeArray =
+    let dst = runST $ do
+            src <- newArray len 0
+            fill src 0 len
+            -- Don't include the first and last element.
+            freezeArray src 1 copied
+    in shows (toList dst copied) "\n"
+
+--  Check that the static-size optimization works.
+test_freezeArrayStatic :: String
+test_freezeArrayStatic =
+    let dst = runST $ do
+            src <- newArray len 0
+            fill src 0 len
+            -- Don't include the first and last element.
+            freezeArray src 1 copiedStatic
+    in shows (toList dst copiedStatic) "\n"
+
+------------------------------------------------------------------------
+-- thawSmallArray#
+
+-- Clone a slice of the source array into a destination array and
+-- check that the clone succeeded.
+test_thawArray :: String
+test_thawArray =
+    let dst = runST $ do
+            src <- newArray len 0
+            fill src 0 len
+            src <- unsafeFreezeArray src
+            -- Don't include the first and last element.
+            dst <- thawArray src 1 copied
+            unsafeFreezeArray dst
+    in shows (toList dst copied) "\n"
+
+--  Check that the static-size optimization works.
+test_thawArrayStatic :: String
+test_thawArrayStatic =
+    let dst = runST $ do
+            src <- newArray len 0
+            fill src 0 len
+            src <- unsafeFreezeArray src
+            -- Don't include the first and last element.
+            dst <- thawArray src 1 copiedStatic
+            unsafeFreezeArray dst
+    in shows (toList dst copiedStatic) "\n"
+
+------------------------------------------------------------------------
+-- Test helpers
+
+-- Initialize the elements of this array, starting at the given
+-- offset.  The last parameter specifies the number of elements to
+-- initialize.  Element at index @i@ takes the value @i*i@ (i.e. the
+-- first actually modified element will take value @off*off@).
+fill :: MArray s Int -> Int -> Int -> ST s ()
+fill marr off count = go 0
+  where
+    go i
+        | i >= count = return ()
+        | otherwise = writeArray marr (off + i) (i*i) >> go (i + 1)
+
+fromList :: [Int] -> ST s (MArray s Int)
+fromList xs0 = do
+    marr <- newArray (length xs0) bottomElem
+    let go [] i = i `seq` return marr
+        go (x:xs) i = writeArray marr i x >> go xs (i + 1)
+    go xs0 0
+  where
+    bottomElem = error "undefined element"
+
+------------------------------------------------------------------------
+-- Convenience wrappers for SmallArray# and MutableSmallArray#
+
+data Array a = Array { unArray :: SmallArray# a }
+data MArray s a = MArray { unMArray :: SmallMutableArray# s a }
+
+newArray :: Int -> a -> ST s (MArray s a)
+newArray (I# n#) a = ST $ \s# -> case newSmallArray# n# a s# of
+    (# s2#, marr# #) -> (# s2#, MArray marr# #)
+
+indexArray :: Array a -> Int -> a
+indexArray arr i@(I# i#)
+  | i < 0 || i >= len =
+      error $ "bounds error, offset " ++ show i ++ ", length " ++ show len
+  | otherwise = case indexSmallArray# (unArray arr) i# of
+      (# a #) -> a
+  where len = lengthArray arr
+
+writeArray :: MArray s a -> Int -> a -> ST s ()
+writeArray marr i@(I# i#) a
+  | i < 0 || i >= len =
+      error $ "bounds error, offset " ++ show i ++ ", length " ++ show len
+  | otherwise = ST $ \ s# ->
+    case writeSmallArray# (unMArray marr) i# a s# of
+        s2# -> (# s2#, () #)
+  where len = lengthMArray marr
+
+lengthArray :: Array a -> Int
+lengthArray arr = I# (sizeofSmallArray# (unArray arr))
+
+lengthMArray :: MArray s a -> Int
+lengthMArray marr = I# (sizeofSmallMutableArray# (unMArray marr))
+
+unsafeFreezeArray :: MArray s a -> ST s (Array a)
+unsafeFreezeArray marr = ST $ \ s# ->
+    case unsafeFreezeSmallArray# (unMArray marr) s# of
+        (# s2#, arr# #) -> (# s2#, Array arr# #)
+
+copyArray :: Array a -> Int -> MArray s a -> Int -> Int -> ST s ()
+copyArray src (I# six#) dst (I# dix#) (I# n#) = ST $ \ s# ->
+    case copySmallArray# (unArray src) six# (unMArray dst) dix# n# s# of
+        s2# -> (# s2#, () #)
+
+copyMutableArray :: MArray s a -> Int -> MArray s a -> Int -> Int -> ST s ()
+copyMutableArray src (I# six#) dst (I# dix#) (I# n#) = ST $ \ s# ->
+    case copySmallMutableArray# (unMArray src) six# (unMArray dst) dix# n# s# of
+        s2# -> (# s2#, () #)
+
+cloneArray :: Array a -> Int -> Int -> Array a
+cloneArray src (I# six#) (I# n#) = Array (cloneSmallArray# (unArray src) six# n#)
+{-# INLINE cloneArray #-}  -- to make sure optimization triggers
+
+cloneMutableArray :: MArray s a -> Int -> Int -> ST s (MArray s a)
+cloneMutableArray src (I# six#) (I# n#) = ST $ \ s# ->
+    case cloneSmallMutableArray# (unMArray src) six# n# s# of
+        (# s2#, marr# #) -> (# s2#, MArray marr# #)
+{-# INLINE cloneMutableArray #-}  -- to make sure optimization triggers
+
+freezeArray :: MArray s a -> Int -> Int -> ST s (Array a)
+freezeArray src (I# six#) (I# n#) = ST $ \ s# ->
+    case freezeSmallArray# (unMArray src) six# n# s# of
+        (# s2#, arr# #) -> (# s2#, Array arr# #)
+{-# INLINE freezeArray #-}  -- to make sure optimization triggers
+
+thawArray :: Array a -> Int -> Int -> ST s (MArray s a)
+thawArray src (I# six#) (I# n#) = ST $ \ s# ->
+    case thawSmallArray# (unArray src) six# n# s# of
+        (# s2#, marr# #) -> (# s2#, MArray marr# #)
+{-# INLINE thawArray #-}  -- to make sure optimization triggers
+
+toList :: Array a -> Int -> [a]
+toList arr n = go 0
+  where
+    go i | i >= n = []
+         | otherwise = indexArray arr i : go (i+1)
diff --git a/testsuite/tests/codeGen/should_run/CopySmallArray.stdout b/testsuite/tests/codeGen/should_run/CopySmallArray.stdout
new file mode 100644
index 000000000000..86ad8a276c00
--- /dev/null
+++ b/testsuite/tests/codeGen/should_run/CopySmallArray.stdout
@@ -0,0 +1,24 @@
+[-1,1,4,9,16,25,36,49,64,81,100,121,144,169,196,225,256,289,324,361,400,441,484,529,576,625,676,729,784,841,900,961,1024,1089,1156,1225,1296,1369,1444,1521,1600,1681,1764,1849,1936,2025,2116,2209,2304,2401,2500,2601,2704,2809,2916,3025,3136,3249,3364,3481,3600,3721,3844,3969,4096,4225,4356,4489,4624,4761,4900,5041,5184,5329,5476,5625,5776,5929,6084,6241,6400,6561,6724,6889,7056,7225,7396,7569,7744,7921,8100,8281,8464,8649,8836,9025,9216,9409,9604,9801,10000,10201,10404,10609,10816,11025,11236,11449,11664,11881,12100,12321,12544,12769,12996,13225,13456,13689,13924,14161,14400,14641,14884,15129,15376,15625,15876,16129,16384,-1]
+
+[-1,1,4,9,16,25,36,49,64,81,100,121,144,169,196,225,256,289,324,361,400,441,484,529,576,625,676,729,784,841,900,961,1024,1089,1156,1225,1296,1369,1444,1521,1600,1681,1764,1849,1936,2025,2116,2209,2304,2401,2500,2601,2704,2809,2916,3025,3136,3249,3364,3481,3600,3721,3844,3969,4096,4225,4356,4489,4624,4761,4900,5041,5184,5329,5476,5625,5776,5929,6084,6241,6400,6561,6724,6889,7056,7225,7396,7569,7744,7921,8100,8281,8464,8649,8836,9025,9216,9409,9604,9801,10000,10201,10404,10609,10816,11025,11236,11449,11664,11881,12100,12321,12544,12769,12996,13225,13456,13689,13924,14161,14400,14641,14884,15129,15376,15625,15876,16129,16384,-1]
+
+[0,169,196,9,16,25,36,25,36,16,25,81,100,121,144]
+
+[1,4,9,16,25,36,49,64,81,100,121,144,169,196,225,256,289,324,361,400,441,484,529,576,625,676,729,784,841,900,961,1024,1089,1156,1225,1296,1369,1444,1521,1600,1681,1764,1849,1936,2025,2116,2209,2304,2401,2500,2601,2704,2809,2916,3025,3136,3249,3364,3481,3600,3721,3844,3969,4096,4225,4356,4489,4624,4761,4900,5041,5184,5329,5476,5625,5776,5929,6084,6241,6400,6561,6724,6889,7056,7225,7396,7569,7744,7921,8100,8281,8464,8649,8836,9025,9216,9409,9604,9801,10000,10201,10404,10609,10816,11025,11236,11449,11664,11881,12100,12321,12544,12769,12996,13225,13456,13689,13924,14161,14400,14641,14884,15129,15376,15625,15876,16129,16384]
+
+[1,4,9,16,25,36,49,64,81,100,121,144,169,196,225,256]
+
+[1,4,9,16,25,36,49,64,81,100,121,144,169,196,225,256,289,324,361,400,441,484,529,576,625,676,729,784,841,900,961,1024,1089,1156,1225,1296,1369,1444,1521,1600,1681,1764,1849,1936,2025,2116,2209,2304,2401,2500,2601,2704,2809,2916,3025,3136,3249,3364,3481,3600,3721,3844,3969,4096,4225,4356,4489,4624,4761,4900,5041,5184,5329,5476,5625,5776,5929,6084,6241,6400,6561,6724,6889,7056,7225,7396,7569,7744,7921,8100,8281,8464,8649,8836,9025,9216,9409,9604,9801,10000,10201,10404,10609,10816,11025,11236,11449,11664,11881,12100,12321,12544,12769,12996,13225,13456,13689,13924,14161,14400,14641,14884,15129,15376,15625,15876,16129,16384]
+
+[]
+
+[1,4,9,16,25,36,49,64,81,100,121,144,169,196,225,256]
+
+[1,4,9,16,25,36,49,64,81,100,121,144,169,196,225,256,289,324,361,400,441,484,529,576,625,676,729,784,841,900,961,1024,1089,1156,1225,1296,1369,1444,1521,1600,1681,1764,1849,1936,2025,2116,2209,2304,2401,2500,2601,2704,2809,2916,3025,3136,3249,3364,3481,3600,3721,3844,3969,4096,4225,4356,4489,4624,4761,4900,5041,5184,5329,5476,5625,5776,5929,6084,6241,6400,6561,6724,6889,7056,7225,7396,7569,7744,7921,8100,8281,8464,8649,8836,9025,9216,9409,9604,9801,10000,10201,10404,10609,10816,11025,11236,11449,11664,11881,12100,12321,12544,12769,12996,13225,13456,13689,13924,14161,14400,14641,14884,15129,15376,15625,15876,16129,16384]
+
+[1,4,9,16,25,36,49,64,81,100,121,144,169,196,225,256]
+
+[1,4,9,16,25,36,49,64,81,100,121,144,169,196,225,256,289,324,361,400,441,484,529,576,625,676,729,784,841,900,961,1024,1089,1156,1225,1296,1369,1444,1521,1600,1681,1764,1849,1936,2025,2116,2209,2304,2401,2500,2601,2704,2809,2916,3025,3136,3249,3364,3481,3600,3721,3844,3969,4096,4225,4356,4489,4624,4761,4900,5041,5184,5329,5476,5625,5776,5929,6084,6241,6400,6561,6724,6889,7056,7225,7396,7569,7744,7921,8100,8281,8464,8649,8836,9025,9216,9409,9604,9801,10000,10201,10404,10609,10816,11025,11236,11449,11664,11881,12100,12321,12544,12769,12996,13225,13456,13689,13924,14161,14400,14641,14884,15129,15376,15625,15876,16129,16384]
+
+[1,4,9,16,25,36,49,64,81,100,121,144,169,196,225,256]
+
diff --git a/testsuite/tests/codeGen/should_run/CopySmallArrayStressTest.hs b/testsuite/tests/codeGen/should_run/CopySmallArrayStressTest.hs
new file mode 100644
index 000000000000..7243fadb061f
--- /dev/null
+++ b/testsuite/tests/codeGen/should_run/CopySmallArrayStressTest.hs
@@ -0,0 +1,387 @@
+{-# LANGUAGE BangPatterns, GeneralizedNewtypeDeriving, MagicHash,
+             UnboxedTuples #-}
+
+-- !!! stress tests of copying/cloning primitive arrays
+
+-- Note: You can run this test manually with an argument (i.e.
+-- ./CopySmallArrayStressTest 10000) if you want to run the stress
+-- test for longer.
+
+{-
+Test strategy
+=============
+
+We create an array of arrays of integers. Repeatedly we then either
+
+* allocate a new array in place of an old, or
+
+* copy a random segment of an array into another array (which might be
+  the source array).
+
+By running this process long enough we hope to trigger any bugs
+related to garbage collection or edge cases.
+
+We only test copySmallMutableArray# and cloneSmallArray# as they are
+representative of all the primops.
+-}
+
+module Main ( main ) where
+
+import Debug.Trace (trace)
+
+import Control.Exception (assert)
+import Control.Monad
+import Control.Monad.Trans.State.Strict
+import Control.Monad.Trans.Class
+import GHC.Exts hiding (IsList(..))
+import GHC.ST hiding (liftST)
+import Prelude hiding (length, read)
+import qualified Prelude as P
+import qualified Prelude as P
+import System.Environment
+import System.Random
+
+main :: IO ()
+main = do
+    args <- getArgs
+    -- Number of copies to perform
+    let numMods = case args of
+            [] -> 100
+            [n] -> P.read n :: Int
+    putStr (test_copyMutableArray numMods ++ "\n" ++
+            test_cloneMutableArray numMods ++ "\n"
+           )
+
+-- Number of arrays
+numArrays :: Int
+numArrays = 100
+
+-- Maxmimum length of a sub-array
+maxLen :: Int
+maxLen = 1024
+
+-- Create an array of arrays, with each sub-array having random length
+-- and content.
+setup :: Rng s (MArray s (MArray s Int))
+setup = do
+    len <- rnd (1, numArrays)
+    marr <- liftST $ new_ len
+    let go i
+            | i >= len = return ()
+            | otherwise = do
+                n <- rnd (1, maxLen)
+                subarr <- liftST $ fromList [j*j | j <- [(0::Int)..n-1]]
+                liftST $ write marr i subarr
+                go (i+1)
+    go 0
+    return marr
+
+-- Replace one of the sub-arrays with a newly allocated array.
+allocate :: MArray s (MArray s Int) -> Rng s ()
+allocate marr = do
+    ix <- rnd (0, length marr - 1)
+    n <- rnd (1, maxLen)
+    subarr <- liftST $ fromList [j*j | j <- [(0::Int)..n-1]]
+    liftST $ write marr ix subarr
+
+type CopyFunction s a =
+    MArray s a -> Int -> MArray s a -> Int -> Int -> ST s ()
+
+-- Copy a random segment of an array onto another array, using the
+-- supplied copy function.
+copy :: MArray s (MArray s a) -> CopyFunction s a
+     -> Rng s (Int, Int, Int, Int, Int)
+copy marr f = do
+    six <- rnd (0, length marr - 1)
+    dix <- rnd (0, length marr - 1)
+    src <- liftST $ read marr six
+    dst <- liftST $ read marr dix
+    let srcLen = length src
+    srcOff <- rnd (0, srcLen - 1)
+    let dstLen = length dst
+    dstOff <- rnd (0, dstLen - 1)
+    n <- rnd (0, min (srcLen - srcOff) (dstLen - dstOff))
+    liftST $ f src srcOff dst dstOff n
+    return (six, dix, srcOff, dstOff, n)
+
+type CloneFunction s a = MArray s a -> Int -> Int -> ST s (MArray s a)
+
+-- Clone a random segment of an array, replacing another array, using
+-- the supplied clone function.
+clone :: MArray s (MArray s a) -> CloneFunction s a
+      -> Rng s (Int, Int, Int, Int)
+clone marr f = do
+    six <- rnd (0, length marr - 1)
+    dix <- rnd (0, length marr - 1)
+    src <- liftST $ read marr six
+    let srcLen = length src
+    -- N.B. The array length might be zero if we previously cloned
+    -- zero elements from some array.
+    srcOff <- rnd (0, max 0 (srcLen - 1))
+    n <- rnd (0, srcLen - srcOff)
+    dst <- liftST $ f src srcOff n
+    liftST $ write marr dix dst
+    return (six, dix, srcOff, n)
+
+------------------------------------------------------------------------
+-- copySmallMutableArray#
+
+-- Copy a slice of the source array into a destination array and check
+-- that the copy succeeded.
+test_copyMutableArray :: Int -> String
+test_copyMutableArray numMods = runST $ run $ do
+    marr <- local setup
+    marrRef <- setup
+    let go i
+            | i >= numMods = return "test_copyMutableArray: OK"
+            | otherwise = do
+                -- Either allocate or copy
+                alloc <- rnd (True, False)
+                if alloc then doAlloc else doCopy
+                go (i+1)
+
+        doAlloc = do
+            local $ allocate marr
+            allocate marrRef
+
+        doCopy = do
+            inp <- liftST $ asList marr
+            _ <- local $ copy marr copyMArray
+            (six, dix, srcOff, dstOff, n) <- copy marrRef copyMArraySlow
+            el <- liftST $ asList marr
+            elRef <- liftST $ asList marrRef
+            when (el /= elRef) $
+                fail inp el elRef six dix srcOff dstOff n
+    go 0
+  where
+    fail inp el elRef six dix srcOff dstOff n =
+        error $ "test_copyMutableArray: FAIL\n"
+        ++ "   Input: " ++ unlinesShow inp
+        ++ "    Copy: six: " ++ show six ++ " dix: " ++ show dix ++ " srcOff: "
+        ++ show srcOff ++ " dstOff: " ++ show dstOff ++ " n: " ++ show n ++ "\n"
+        ++ "Expected: " ++ unlinesShow elRef
+        ++ "  Actual: " ++ unlinesShow el
+
+asList :: MArray s (MArray s a) -> ST s [[a]]
+asList marr = toListM =<< mapArrayM toListM marr
+
+unlinesShow :: Show a => [a] -> String
+unlinesShow =  concatMap (\ x -> show x ++ "\n")
+
+------------------------------------------------------------------------
+-- cloneSmallMutableArray#
+
+-- Copy a slice of the source array into a destination array and check
+-- that the copy succeeded.
+test_cloneMutableArray :: Int -> String
+test_cloneMutableArray numMods = runST $ run $ do
+    marr <- local setup
+    marrRef <- setup
+    let go i
+            | i >= numMods = return "test_cloneMutableArray: OK"
+            | otherwise = do
+                -- Either allocate or clone
+                alloc <- rnd (True, False)
+                if alloc then doAlloc else doClone
+                go (i+1)
+
+        doAlloc = do
+            local $ allocate marr
+            allocate marrRef
+
+        doClone = do
+            inp <- liftST $ asList marr
+            _ <- local $ clone marr cloneMArray
+            (six, dix, srcOff, n) <- clone marrRef cloneMArraySlow
+            el <- liftST $ asList marr
+            elRef <- liftST $ asList marrRef
+            when (el /= elRef) $
+                fail inp el elRef six dix srcOff n
+    go 0
+  where
+    fail inp el elRef six dix srcOff n =
+        error $ "test_cloneMutableArray: FAIL\n"
+        ++ "   Input: " ++ unlinesShow inp
+        ++ "   Clone: six: " ++ show six ++ " dix: " ++ show dix ++ " srcOff: "
+        ++ show srcOff ++ " n: " ++ show n ++ "\n"
+        ++ "Expected: " ++ unlinesShow elRef
+        ++ "  Actual: " ++ unlinesShow el
+
+------------------------------------------------------------------------
+-- Convenience wrappers for SmallArray# and SmallMutableArray#
+
+data Array a = Array
+    { unArray :: SmallArray# a
+    , lengthA :: {-# UNPACK #-} !Int}
+
+data MArray s a = MArray
+    { unMArray :: SmallMutableArray# s a
+    , lengthM :: {-# UNPACK #-} !Int}
+
+class IArray a where
+    length :: a -> Int
+instance IArray (Array a) where
+    length = lengthA
+instance IArray (MArray s a) where
+    length = lengthM
+
+instance Eq a => Eq (Array a) where
+    arr1 == arr2 = toList arr1 == toList arr2
+
+new :: Int -> a -> ST s (MArray s a)
+new n@(I# n#) a =
+    assert (n >= 0) $
+    ST $ \s# -> case newSmallArray# n# a s# of
+        (# s2#, marr# #) -> (# s2#, MArray marr# n #)
+
+new_ :: Int -> ST s (MArray s a)
+new_ n = new n (error "Undefined element")
+
+write :: MArray s a -> Int -> a -> ST s ()
+write marr i@(I# i#) a =
+    assert (i >= 0) $
+    assert (i < length marr) $
+    ST $ \ s# ->
+    case writeSmallArray# (unMArray marr) i# a s# of
+        s2# -> (# s2#, () #)
+
+read :: MArray s a -> Int -> ST s a
+read marr i@(I# i#) =
+    assert (i >= 0) $
+    assert (i < length marr) $
+    ST $ \ s# ->
+    readSmallArray# (unMArray marr) i# s#
+
+index :: Array a -> Int -> a
+index arr i@(I# i#) =
+    assert (i >= 0) $
+    assert (i < length arr) $
+    case indexSmallArray# (unArray arr) i# of
+        (# a #) -> a
+
+unsafeFreeze :: MArray s a -> ST s (Array a)
+unsafeFreeze marr = ST $ \ s# ->
+    case unsafeFreezeSmallArray# (unMArray marr) s# of
+        (# s2#, arr# #) -> (# s2#, Array arr# (length marr) #)
+
+toList :: Array a -> [a]
+toList arr = go 0
+  where
+    go i | i >= length arr = []
+         | otherwise = index arr i : go (i+1)
+
+fromList :: [e] -> ST s (MArray s e)
+fromList es = do
+    marr <- new_ n
+    let go !_ [] = return ()
+        go i (x:xs) = write marr i x >> go (i+1) xs
+    go 0 es
+    return marr
+  where
+    n = P.length es
+
+mapArrayM :: (a -> ST s b) -> MArray s a -> ST s (MArray s b)
+mapArrayM f src = do
+    dst <- new_ n
+    let go i
+            | i >= n = return dst
+            | otherwise = do
+                el <- read src i
+                el' <- f el
+                write dst i el'
+                go (i+1)
+    go 0
+  where
+    n = length src
+
+toListM :: MArray s e -> ST s [e]
+toListM marr =
+    sequence [read marr i | i <- [0..(length marr)-1]]
+
+------------------------------------------------------------------------
+-- Wrappers around copy/clone primops
+
+copyMArray :: MArray s a -> Int -> MArray s a -> Int -> Int -> ST s ()
+copyMArray src six@(I# six#) dst dix@(I# dix#) n@(I# n#) =
+    assert (six >= 0) $
+    assert (six + n <= length src) $
+    assert (dix >= 0) $
+    assert (dix + n <= length dst) $
+    ST $ \ s# ->
+    case copySmallMutableArray# (unMArray src) six# (unMArray dst) dix# n# s# of
+        s2# -> (# s2#, () #)
+
+cloneMArray :: MArray s a -> Int -> Int -> ST s (MArray s a)
+cloneMArray marr off@(I# off#) n@(I# n#) =
+    assert (off >= 0) $
+    assert (off + n <= length marr) $
+    ST $ \ s# ->
+    case cloneSmallMutableArray# (unMArray marr) off# n# s# of
+        (# s2#, marr2 #) -> (# s2#, MArray marr2 n #)
+
+------------------------------------------------------------------------
+-- Manual versions of copy/clone primops.  Used to validate the
+-- primops
+
+copyMArraySlow :: MArray s e -> Int -> MArray s e -> Int -> Int -> ST s ()
+copyMArraySlow !src !six !dst !dix n =
+    assert (six >= 0) $
+    assert (six + n <= length src) $
+    assert (dix >= 0) $
+    assert (dix + n <= length dst) $
+       if six < dix
+       then goB (six+n-1) (dix+n-1) 0  -- Copy backwards
+       else goF six dix 0  -- Copy forwards
+  where
+    goF !i !j c
+        | c >= n = return ()
+        | otherwise = do b <- read src i
+                         write dst j b
+                         goF (i+1) (j+1) (c+1)
+    goB !i !j c
+        | c >= n = return ()
+        | otherwise = do b <- read src i
+                         write dst j b
+                         goB (i-1) (j-1) (c+1)
+
+cloneMArraySlow :: MArray s a -> Int -> Int -> ST s (MArray s a)
+cloneMArraySlow !marr !off n =
+    assert (off >= 0) $
+    assert (off + n <= length marr) $ do
+        marr2 <- new_ n
+        let go !i !j c
+                | c >= n = return marr2
+                | otherwise = do
+                    b <- read marr i
+                    write marr2 j b
+                    go (i+1) (j+1) (c+1)
+        go off 0 0
+
+------------------------------------------------------------------------
+-- Utilities for simplifying RNG passing
+
+newtype Rng s a = Rng { unRng :: StateT StdGen (ST s) a }
+                deriving Monad
+
+-- Same as 'randomR', but using the RNG state kept in the 'Rng' monad.
+rnd :: Random a => (a, a) -> Rng s a
+rnd r = Rng $ do
+    g <- get
+    let (x, g') = randomR r g
+    put g'
+    return x
+
+-- Run a sub-computation without affecting the RNG state.
+local :: Rng s a -> Rng s a
+local m = Rng $ do
+    g <- get
+    x <- unRng m
+    put g
+    return x
+
+liftST :: ST s a -> Rng s a
+liftST m = Rng $ lift m
+
+run :: Rng s a -> ST s a
+run = flip evalStateT (mkStdGen 13) . unRng
+
diff --git a/testsuite/tests/codeGen/should_run/CopySmallArrayStressTest.stdout b/testsuite/tests/codeGen/should_run/CopySmallArrayStressTest.stdout
new file mode 100644
index 000000000000..122a125a8efa
--- /dev/null
+++ b/testsuite/tests/codeGen/should_run/CopySmallArrayStressTest.stdout
@@ -0,0 +1,2 @@
+test_copyMutableArray: OK
+test_cloneMutableArray: OK
diff --git a/testsuite/tests/codeGen/should_run/SizeOfSmallArray.hs b/testsuite/tests/codeGen/should_run/SizeOfSmallArray.hs
new file mode 100644
index 000000000000..2e6270974871
--- /dev/null
+++ b/testsuite/tests/codeGen/should_run/SizeOfSmallArray.hs
@@ -0,0 +1,32 @@
+{-# LANGUAGE MagicHash, UnboxedTuples #-}
+
+module Main ( main ) where
+
+import GHC.Exts
+import GHC.Prim
+import GHC.ST
+
+main = putStr
+       (test_sizeofArray
+        ++ "\n" ++ test_sizeofMutableArray
+        ++ "\n"
+       )
+
+test_sizeofArray :: String
+test_sizeofArray = flip shows "\n" $ runST $ ST $ \ s# -> go 0 [] s#
+  where
+    go i@(I# i#) acc s#
+        | i < 1000 = case newSmallArray# i# 0 s# of
+            (# s2#, marr# #) -> case unsafeFreezeSmallArray# marr# s2# of
+                (# s3#, arr# #) -> case sizeofSmallArray# arr# of
+                    j# -> go (i+1) ((I# j#):acc) s3#
+        | otherwise = (# s#, reverse acc #)
+
+test_sizeofMutableArray :: String
+test_sizeofMutableArray = flip shows "\n" $ runST $ ST $ \ s# -> go 0 [] s#
+  where
+    go i@(I# i#) acc s#
+        | i < 1000 = case newSmallArray# i# 0 s# of
+            (# s2#, marr# #) -> case sizeofSmallMutableArray# marr# of
+                    j# -> go (i+1) ((I# j#):acc) s2#
+        | otherwise = (# s#, reverse acc #)
diff --git a/testsuite/tests/codeGen/should_run/SizeOfSmallArray.stdout b/testsuite/tests/codeGen/should_run/SizeOfSmallArray.stdout
new file mode 100644
index 000000000000..bf895d50ef73
--- /dev/null
+++ b/testsuite/tests/codeGen/should_run/SizeOfSmallArray.stdout
@@ -0,0 +1,4 @@
+[0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,64,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,91,92,93,94,95,96,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,120,121,122,123,124,125,126,127,128,129,130,131,132,133,134,135,136,137,138,139,140,141,142,143,144,145,146,147,148,149,150,151,152,153,154,155,156,157,158,159,160,161,162,163,164,165,166,167,168,169,170,171,172,173,174,175,176,177,178,179,180,181,182,183,184,185,186,187,188,189,190,191,192,193,194,195,196,197,198,199,200,201,202,203,204,205,206,207,208,209,210,211,212,213,214,215,216,217,218,219,220,221,222,223,224,225,226,227,228,229,230,231,232,233,234,235,236,237,238,239,240,241,242,243,244,245,246,247,248,249,250,251,252,253,254,255,256,257,258,259,260,261,262,263,264,265,266,267,268,269,270,271,272,273,274,275,276,277,278,279,280,281,282,283,284,285,286,287,288,289,290,291,292,293,294,295,296,297,298,299,300,301,302,303,304,305,306,307,308,309,310,311,312,313,314,315,316,317,318,319,320,321,322,323,324,325,326,327,328,329,330,331,332,333,334,335,336,337,338,339,340,341,342,343,344,345,346,347,348,349,350,351,352,353,354,355,356,357,358,359,360,361,362,363,364,365,366,367,368,369,370,371,372,373,374,375,376,377,378,379,380,381,382,383,384,385,386,387,388,389,390,391,392,393,394,395,396,397,398,399,400,401,402,403,404,405,406,407,408,409,410,411,412,413,414,415,416,417,418,419,420,421,422,423,424,425,426,427,428,429,430,431,432,433,434,435,436,437,438,439,440,441,442,443,444,445,446,447,448,449,450,451,452,453,454,455,456,457,458,459,460,461,462,463,464,465,466,467,468,469,470,471,472,473,474,475,476,477,478,479,480,481,482,483,484,485,486,487,488,489,490,491,492,493,494,495,496,497,498,499,500,501,502,503,504,505,506,507,508,509,510,511,512,513,514,515,516,517,518,519,520,521,522,523,524,525,526,527,528,529,530,531,532,533,534,535,536,537,538,539,540,541,542,543,544,545,546,547,548,549,550,551,552,553,554,555,556,557,558,559,560,561,562,563,564,565,566,567,568,569,570,571,572,573,574,575,576,577,578,579,580,581,582,583,584,585,586,587,588,589,590,591,592,593,594,595,596,597,598,599,600,601,602,603,604,605,606,607,608,609,610,611,612,613,614,615,616,617,618,619,620,621,622,623,624,625,626,627,628,629,630,631,632,633,634,635,636,637,638,639,640,641,642,643,644,645,646,647,648,649,650,651,652,653,654,655,656,657,658,659,660,661,662,663,664,665,666,667,668,669,670,671,672,673,674,675,676,677,678,679,680,681,682,683,684,685,686,687,688,689,690,691,692,693,694,695,696,697,698,699,700,701,702,703,704,705,706,707,708,709,710,711,712,713,714,715,716,717,718,719,720,721,722,723,724,725,726,727,728,729,730,731,732,733,734,735,736,737,738,739,740,741,742,743,744,745,746,747,748,749,750,751,752,753,754,755,756,757,758,759,760,761,762,763,764,765,766,767,768,769,770,771,772,773,774,775,776,777,778,779,780,781,782,783,784,785,786,787,788,789,790,791,792,793,794,795,796,797,798,799,800,801,802,803,804,805,806,807,808,809,810,811,812,813,814,815,816,817,818,819,820,821,822,823,824,825,826,827,828,829,830,831,832,833,834,835,836,837,838,839,840,841,842,843,844,845,846,847,848,849,850,851,852,853,854,855,856,857,858,859,860,861,862,863,864,865,866,867,868,869,870,871,872,873,874,875,876,877,878,879,880,881,882,883,884,885,886,887,888,889,890,891,892,893,894,895,896,897,898,899,900,901,902,903,904,905,906,907,908,909,910,911,912,913,914,915,916,917,918,919,920,921,922,923,924,925,926,927,928,929,930,931,932,933,934,935,936,937,938,939,940,941,942,943,944,945,946,947,948,949,950,951,952,953,954,955,956,957,958,959,960,961,962,963,964,965,966,967,968,969,970,971,972,973,974,975,976,977,978,979,980,981,982,983,984,985,986,987,988,989,990,991,992,993,994,995,996,997,998,999]
+
+[0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,64,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,91,92,93,94,95,96,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,120,121,122,123,124,125,126,127,128,129,130,131,132,133,134,135,136,137,138,139,140,141,142,143,144,145,146,147,148,149,150,151,152,153,154,155,156,157,158,159,160,161,162,163,164,165,166,167,168,169,170,171,172,173,174,175,176,177,178,179,180,181,182,183,184,185,186,187,188,189,190,191,192,193,194,195,196,197,198,199,200,201,202,203,204,205,206,207,208,209,210,211,212,213,214,215,216,217,218,219,220,221,222,223,224,225,226,227,228,229,230,231,232,233,234,235,236,237,238,239,240,241,242,243,244,245,246,247,248,249,250,251,252,253,254,255,256,257,258,259,260,261,262,263,264,265,266,267,268,269,270,271,272,273,274,275,276,277,278,279,280,281,282,283,284,285,286,287,288,289,290,291,292,293,294,295,296,297,298,299,300,301,302,303,304,305,306,307,308,309,310,311,312,313,314,315,316,317,318,319,320,321,322,323,324,325,326,327,328,329,330,331,332,333,334,335,336,337,338,339,340,341,342,343,344,345,346,347,348,349,350,351,352,353,354,355,356,357,358,359,360,361,362,363,364,365,366,367,368,369,370,371,372,373,374,375,376,377,378,379,380,381,382,383,384,385,386,387,388,389,390,391,392,393,394,395,396,397,398,399,400,401,402,403,404,405,406,407,408,409,410,411,412,413,414,415,416,417,418,419,420,421,422,423,424,425,426,427,428,429,430,431,432,433,434,435,436,437,438,439,440,441,442,443,444,445,446,447,448,449,450,451,452,453,454,455,456,457,458,459,460,461,462,463,464,465,466,467,468,469,470,471,472,473,474,475,476,477,478,479,480,481,482,483,484,485,486,487,488,489,490,491,492,493,494,495,496,497,498,499,500,501,502,503,504,505,506,507,508,509,510,511,512,513,514,515,516,517,518,519,520,521,522,523,524,525,526,527,528,529,530,531,532,533,534,535,536,537,538,539,540,541,542,543,544,545,546,547,548,549,550,551,552,553,554,555,556,557,558,559,560,561,562,563,564,565,566,567,568,569,570,571,572,573,574,575,576,577,578,579,580,581,582,583,584,585,586,587,588,589,590,591,592,593,594,595,596,597,598,599,600,601,602,603,604,605,606,607,608,609,610,611,612,613,614,615,616,617,618,619,620,621,622,623,624,625,626,627,628,629,630,631,632,633,634,635,636,637,638,639,640,641,642,643,644,645,646,647,648,649,650,651,652,653,654,655,656,657,658,659,660,661,662,663,664,665,666,667,668,669,670,671,672,673,674,675,676,677,678,679,680,681,682,683,684,685,686,687,688,689,690,691,692,693,694,695,696,697,698,699,700,701,702,703,704,705,706,707,708,709,710,711,712,713,714,715,716,717,718,719,720,721,722,723,724,725,726,727,728,729,730,731,732,733,734,735,736,737,738,739,740,741,742,743,744,745,746,747,748,749,750,751,752,753,754,755,756,757,758,759,760,761,762,763,764,765,766,767,768,769,770,771,772,773,774,775,776,777,778,779,780,781,782,783,784,785,786,787,788,789,790,791,792,793,794,795,796,797,798,799,800,801,802,803,804,805,806,807,808,809,810,811,812,813,814,815,816,817,818,819,820,821,822,823,824,825,826,827,828,829,830,831,832,833,834,835,836,837,838,839,840,841,842,843,844,845,846,847,848,849,850,851,852,853,854,855,856,857,858,859,860,861,862,863,864,865,866,867,868,869,870,871,872,873,874,875,876,877,878,879,880,881,882,883,884,885,886,887,888,889,890,891,892,893,894,895,896,897,898,899,900,901,902,903,904,905,906,907,908,909,910,911,912,913,914,915,916,917,918,919,920,921,922,923,924,925,926,927,928,929,930,931,932,933,934,935,936,937,938,939,940,941,942,943,944,945,946,947,948,949,950,951,952,953,954,955,956,957,958,959,960,961,962,963,964,965,966,967,968,969,970,971,972,973,974,975,976,977,978,979,980,981,982,983,984,985,986,987,988,989,990,991,992,993,994,995,996,997,998,999]
+
diff --git a/testsuite/tests/codeGen/should_run/StaticArraySize.hs b/testsuite/tests/codeGen/should_run/StaticArraySize.hs
new file mode 100644
index 000000000000..06c8343bc29c
--- /dev/null
+++ b/testsuite/tests/codeGen/should_run/StaticArraySize.hs
@@ -0,0 +1,90 @@
+{-# LANGUAGE BangPatterns, MagicHash, UnboxedTuples #-}
+
+-- Test allocation of statically sized arrays. There's an optimization
+-- that targets these and we want to make sure that the code generated
+-- in the optimized case is correct.
+--
+-- The tests proceeds by allocating a bunch of arrays of different
+-- sizes and reading elements from them, to try to provoke GC crashes,
+-- which would be a symptom of the optimization not generating correct
+-- code.
+module Main where
+
+import Control.Monad
+import GHC.Exts
+import GHC.IO
+import Prelude hiding (read)
+
+main :: IO ()
+main = do
+    loop 1000
+    putStrLn "success"
+  where
+    loop :: Int -> IO ()
+    loop 0 = return ()
+    loop i = do
+        -- Sizes have been picked to match the triggering of the
+        -- optimization and to match boundary conditions. Sizes are
+        -- given explicitly as to not rely on other optimizations to
+        -- make the static size known to the compiler.
+        marr0 <- newArray 0
+        marr1 <- newArray 1
+        marr2 <- newArray 2
+        marr3 <- newArray 3
+        marr4 <- newArray 4
+        marr5 <- newArray 5
+        marr6 <- newArray 6
+        marr7 <- newArray 7
+        marr8 <- newArray 8
+        marr9 <- newArray 9
+        marr10 <- newArray 10
+        marr11 <- newArray 11
+        marr12 <- newArray 12
+        marr13 <- newArray 13
+        marr14 <- newArray 14
+        marr15 <- newArray 15
+        marr16 <- newArray 16
+        marr17 <- newArray 17
+        let marrs = [marr0, marr1, marr2, marr3, marr4, marr5, marr6, marr7,
+                     marr8, marr9, marr10, marr11, marr12, marr13, marr14,
+                     marr15, marr16, marr17]
+        total <- sumManyArrays marrs
+        unless (total == 153) $
+            putStrLn "incorrect sum"
+        loop (i-1)
+
+sumManyArrays :: [MArray] -> IO Int
+sumManyArrays = go 0
+  where
+    go !acc [] = return acc
+    go acc (marr:marrs) = do
+        n <- sumArray marr
+        go (acc+n) marrs
+
+sumArray :: MArray -> IO Int
+sumArray marr = go 0 0
+  where
+    go :: Int -> Int -> IO Int
+    go !acc i
+      | i < len = do
+          k <- read marr i
+          go (acc + k) (i+1)
+      | otherwise = return acc
+    len = lengthM marr
+
+data MArray = MArray { unMArray :: !(MutableArray# RealWorld Int) }
+
+newArray :: Int -> IO MArray
+newArray (I# sz#) = IO $ \s -> case newArray# sz# 1 s of
+    (# s', marr #) -> (# s', MArray marr #)
+{-# INLINE newArray #-}  -- to make sure optimization triggers
+
+lengthM :: MArray -> Int
+lengthM marr = I# (sizeofMutableArray# (unMArray marr))
+
+read :: MArray -> Int -> IO Int
+read marr i@(I# i#)
+  | i < 0 || i >= len =
+      error $ "bounds error, offset " ++ show i ++ ", length " ++ show len
+  | otherwise = IO $ \ s -> readArray# (unMArray marr) i# s
+  where len = lengthM marr
diff --git a/testsuite/tests/codeGen/should_run/StaticArraySize.stdout b/testsuite/tests/codeGen/should_run/StaticArraySize.stdout
new file mode 100644
index 000000000000..2e9ba477f89e
--- /dev/null
+++ b/testsuite/tests/codeGen/should_run/StaticArraySize.stdout
@@ -0,0 +1 @@
+success
diff --git a/testsuite/tests/codeGen/should_run/StaticByteArraySize.hs b/testsuite/tests/codeGen/should_run/StaticByteArraySize.hs
new file mode 100644
index 000000000000..c2d666049ee4
--- /dev/null
+++ b/testsuite/tests/codeGen/should_run/StaticByteArraySize.hs
@@ -0,0 +1,52 @@
+{-# LANGUAGE MagicHash, UnboxedTuples #-}
+
+-- Test allocation of statically sized byte arrays. There's an
+-- optimization that targets these and we want to make sure that the
+-- code generated in the optimized case is correct.
+--
+-- The tests proceeds by allocating a bunch of byte arrays of
+-- different sizes, to try to provoke GC crashes, which would be a
+-- symptom of the optimization not generating correct code.
+module Main where
+
+import GHC.Exts
+import GHC.IO
+
+main :: IO ()
+main = do
+    loop 1000
+    putStrLn "success"
+  where
+    loop :: Int -> IO ()
+    loop 0 = return ()
+    loop i = do
+        -- Sizes have been picked to match the triggering of the
+        -- optimization and to match boundary conditions. Sizes are
+        -- given explicitly as to not rely on other optimizations to
+        -- make the static size known to the compiler.
+        newByteArray 0
+        newByteArray 1
+        newByteArray 2
+        newByteArray 3
+        newByteArray 4
+        newByteArray 5
+        newByteArray 6
+        newByteArray 7
+        newByteArray 8
+        newByteArray 9
+        newByteArray 10
+        newByteArray 11
+        newByteArray 12
+        newByteArray 13
+        newByteArray 14
+        newByteArray 15
+        newByteArray 16
+        newByteArray 64
+        newByteArray 128
+        newByteArray 129
+        loop (i-1)
+
+newByteArray :: Int -> IO ()
+newByteArray (I# sz#) = IO $ \s -> case newByteArray# sz# s of
+    (# s', _ #) -> (# s', () #)
+{-# INLINE newByteArray #-}  -- to make sure optimization triggers
diff --git a/testsuite/tests/codeGen/should_run/StaticByteArraySize.stdout b/testsuite/tests/codeGen/should_run/StaticByteArraySize.stdout
new file mode 100644
index 000000000000..2e9ba477f89e
--- /dev/null
+++ b/testsuite/tests/codeGen/should_run/StaticByteArraySize.stdout
@@ -0,0 +1 @@
+success
diff --git a/testsuite/tests/codeGen/should_run/T9001.hs b/testsuite/tests/codeGen/should_run/T9001.hs
new file mode 100644
index 000000000000..3fae93efa09c
--- /dev/null
+++ b/testsuite/tests/codeGen/should_run/T9001.hs
@@ -0,0 +1,8 @@
+{-# LANGUAGE RankNTypes #-}
+
+newtype FMList = FM {unFM :: forall m. m -> m}
+
+main = print (delete 2000 (FM id) :: Int)
+
+delete 0 _ = 0
+delete n (FM a) = a $ delete (n-1) $ FM $ \g -> a (const g) undefined
diff --git a/testsuite/tests/codeGen/should_run/T9001.stdout b/testsuite/tests/codeGen/should_run/T9001.stdout
new file mode 100644
index 000000000000..573541ac9702
--- /dev/null
+++ b/testsuite/tests/codeGen/should_run/T9001.stdout
@@ -0,0 +1 @@
+0
diff --git a/testsuite/tests/codeGen/should_run/T9013.hs b/testsuite/tests/codeGen/should_run/T9013.hs
new file mode 100644
index 000000000000..35c074e68d35
--- /dev/null
+++ b/testsuite/tests/codeGen/should_run/T9013.hs
@@ -0,0 +1,14 @@
+{-# LANGUAGE MagicHash, UnboxedTuples #-}
+
+import GHC.Prim
+import GHC.Word
+
+big :: Word
+big = maxBound
+
+carry :: Word
+carry = case big of
+  W# w -> case plusWord2# w w of
+    (# hi, lo #) -> W# hi
+
+main = print carry
diff --git a/testsuite/tests/codeGen/should_run/T9013.stdout b/testsuite/tests/codeGen/should_run/T9013.stdout
new file mode 100644
index 000000000000..d00491fd7e5b
--- /dev/null
+++ b/testsuite/tests/codeGen/should_run/T9013.stdout
@@ -0,0 +1 @@
+1
diff --git a/testsuite/tests/codeGen/should_run/T9340.hs b/testsuite/tests/codeGen/should_run/T9340.hs
new file mode 100644
index 000000000000..45f791ba7307
--- /dev/null
+++ b/testsuite/tests/codeGen/should_run/T9340.hs
@@ -0,0 +1,96 @@
+{-# LANGUAGE MagicHash #-}
+
+import Control.Monad
+import Data.Bits
+import GHC.Exts
+import GHC.Word
+import Numeric (showHex)
+
+-- Reference Implementation
+
+-- count trailing zeros
+ctzRI :: FiniteBits a => a -> Word
+ctzRI x = fromIntegral $ go 0
+  where
+    go i | i >= w      = i
+         | testBit x i = i
+         | otherwise   = go (i+1)
+
+    w = finiteBitSize x
+
+-- count leading zeros
+clzRI :: FiniteBits a => a -> Word
+clzRI x = fromIntegral $ (w-1) - go (w-1)
+  where
+    go i | i < 0       = i -- no bit set
+         | testBit x i = i
+         | otherwise   = go (i-1)
+
+    w = finiteBitSize x
+
+clzRI32, ctzRI32 :: Word -> Word
+clzRI32 x = clzRI (fromIntegral x :: Word32)
+ctzRI32 x = ctzRI (fromIntegral x :: Word32)
+
+clzRI16, ctzRI16 :: Word -> Word
+clzRI16 x = clzRI (fromIntegral x :: Word16)
+ctzRI16 x = ctzRI (fromIntegral x :: Word16)
+
+clzRI8, ctzRI8 :: Word -> Word
+clzRI8 x = clzRI (fromIntegral x :: Word8)
+ctzRI8 x = ctzRI (fromIntegral x :: Word8)
+
+-- Implementation Under Test
+ctzIUT, clzIUT :: Word -> Word
+ctzIUT (W# x#) = W# (ctz# x#)
+clzIUT (W# x#) = W# (clz# x#)
+
+ctzIUT8, clzIUT8 :: Word -> Word
+ctzIUT8 (W# x#) = W# (ctz8# x#)
+clzIUT8 (W# x#) = W# (clz8# x#)
+
+ctzIUT16, clzIUT16 :: Word -> Word
+ctzIUT16 (W# x#) = W# (ctz16# x#)
+clzIUT16 (W# x#) = W# (clz16# x#)
+
+ctzIUT32, clzIUT32 :: Word -> Word
+ctzIUT32 (W# x#) = W# (ctz32# x#)
+clzIUT32 (W# x#) = W# (clz32# x#)
+
+ctzIUT64, clzIUT64 :: Word64 -> Word
+ctzIUT64 (W64# x#) = W# (ctz64# x#)
+clzIUT64 (W64# x#) = W# (clz64# x#)
+
+main :: IO ()
+main = do
+    forM_ testpats $ \w64 -> do
+        let w = fromIntegral w64 :: Word
+
+        check "clz"   clzRI   clzIUT   w
+        check "clz8"  clzRI8  clzIUT8  w
+        check "clz16" clzRI16 clzIUT16 w
+        check "clz32" clzRI32 clzIUT32 w
+        check "clz64" clzRI   clzIUT64 w64
+
+        check "ctz"   ctzRI   ctzIUT   w
+        check "ctz8"  ctzRI8  ctzIUT8  w
+        check "ctz16" ctzRI16 ctzIUT16 w
+        check "ctz32" ctzRI32 ctzIUT32 w
+        check "ctz64" ctzRI   ctzIUT64 w64
+
+    putStrLn $ concat ["tested ", show (length testpats), " patterns"]
+
+  where
+    -- try to construct some interesting patterns
+    testpats :: [Word64]
+    testpats = [ bit i - 1 | i <- [0..63] ] ++
+               [ complement (bit i - 1) | i <- [0..63] ] ++
+               [ bit i .|. bit j | i <- [0..63], j <- [0..i] ]
+
+    check s fri fiut v = unless (vri == viut) $ do
+        putStrLn $ concat [ "FAILED ", s, " for x=0x", showHex v ""
+                          , " (RI=", show vri, " IUT=", show viut, ")"
+                          ]
+      where
+        vri = fri v
+        viut = fiut v
diff --git a/testsuite/tests/codeGen/should_run/T9340.stdout b/testsuite/tests/codeGen/should_run/T9340.stdout
new file mode 100644
index 000000000000..455b0abc1838
--- /dev/null
+++ b/testsuite/tests/codeGen/should_run/T9340.stdout
@@ -0,0 +1 @@
+tested 2208 patterns
diff --git a/testsuite/tests/codeGen/should_run/all.T b/testsuite/tests/codeGen/should_run/all.T
index 768d32028584..03106d479164 100644
--- a/testsuite/tests/codeGen/should_run/all.T
+++ b/testsuite/tests/codeGen/should_run/all.T
@@ -48,9 +48,7 @@ test('cgrun047', normal, compile_and_run, [''])
 test('cgrun048', normal, compile_and_run, [''])
 test('cgrun049', normal, compile_and_run, ['-funbox-strict-fields'])
 test('cgrun050', normal, compile_and_run, [''])
-# Doesn't work with External Core due to datatype declaration with no constructors
-test('cgrun051', [expect_fail_for(['extcore','optextcore']), exit_code(1)],
-     compile_and_run, [''])
+test('cgrun051', [exit_code(1)], compile_and_run, [''])
 test('cgrun052', only_ways(['optasm']), compile_and_run, ['-funbox-strict-fields'])
 test('cgrun053', normal, compile_and_run, [''])
 test('cgrun054', normal, compile_and_run, [''])
@@ -75,7 +73,7 @@ test('cgrun068', reqlib('random'), compile_and_run, [''])
 test('cgrun069', omit_ways(['ghci']), multi_compile_and_run,
                  ['cgrun069', [('cgrun069_cmm.cmm', '')], ''])
 test('cgrun070', normal, compile_and_run, [''])
-test('cgrun071', when(opsys('darwin'), expect_broken(7684)), compile_and_run, [''])
+test('cgrun071', normal, compile_and_run, [''])
 test('cgrun072', normal, compile_and_run, [''])
 
 test('T1852', normal, compile_and_run, [''])
@@ -114,5 +112,14 @@ test('T7361', normal, compile_and_run, [''])
 test('T7600', normal, compile_and_run, [''])
 test('T8103', only_ways(['normal']), compile_and_run, [''])
 test('T7953', reqlib('random'), compile_and_run, [''])
-test('T8256',normal, compile_and_run, [''])
+test('T8256', reqlib('vector'), compile_and_run, [''])
 test('T6084',normal, compile_and_run, ['-O2'])
+test('StaticArraySize', normal, compile_and_run, ['-O2'])
+test('StaticByteArraySize', normal, compile_and_run, ['-O2'])
+test('CopySmallArray', normal, compile_and_run, [''])
+test('CopySmallArrayStressTest', reqlib('random'), compile_and_run, [''])
+test('SizeOfSmallArray', normal, compile_and_run, [''])
+test('T9001', normal, compile_and_run, [''])
+test('T9013', omit_ways(['ghci']),  # ghci doesn't support unboxed tuples
+     compile_and_run, [''])
+test('T9340', normal, compile_and_run, [''])
diff --git a/testsuite/tests/codeGen/should_run/cgrun064.hs b/testsuite/tests/codeGen/should_run/cgrun064.hs
index 24544c43821d..527c6bde6734 100644
--- a/testsuite/tests/codeGen/should_run/cgrun064.hs
+++ b/testsuite/tests/codeGen/should_run/cgrun064.hs
@@ -9,15 +9,20 @@ import GHC.Exts hiding (IsList(..))
 import GHC.Prim
 import GHC.ST
 
+main :: IO ()
 main = putStr
        (test_copyArray
         ++ "\n" ++ test_copyMutableArray
         ++ "\n" ++ test_copyMutableArrayOverlap
         ++ "\n" ++ test_cloneArray
+        ++ "\n" ++ test_cloneArrayStatic
         ++ "\n" ++ test_cloneMutableArray
         ++ "\n" ++ test_cloneMutableArrayEmpty
+        ++ "\n" ++ test_cloneMutableArrayStatic
         ++ "\n" ++ test_freezeArray
+        ++ "\n" ++ test_freezeArrayStatic
         ++ "\n" ++ test_thawArray
+        ++ "\n" ++ test_thawArrayStatic
         ++ "\n"
        )
 
@@ -32,6 +37,10 @@ len = 130
 copied :: Int
 copied = len - 2
 
+copiedStatic :: Int
+copiedStatic = 16
+{-# INLINE copiedStatic #-}  -- to make sure optimization triggers
+
 ------------------------------------------------------------------------
 -- copyArray#
 
@@ -90,9 +99,20 @@ test_cloneArray =
             fill src 0 len
             src <- unsafeFreezeArray src
             -- Don't include the first and last element.
-            return $ cloneArray src 1 copied
+            return $! cloneArray src 1 copied
     in shows (toList dst copied) "\n"
 
+--  Check that the static-size optimization works.
+test_cloneArrayStatic :: String
+test_cloneArrayStatic =
+    let dst = runST $ do
+            src <- newArray len 0
+            fill src 0 len
+            src <- unsafeFreezeArray src
+            -- Don't include the first and last element.
+            return $! cloneArray src 1 copiedStatic
+    in shows (toList dst copiedStatic) "\n"
+
 ------------------------------------------------------------------------
 -- cloneMutableArray#
 
@@ -117,6 +137,17 @@ test_cloneMutableArrayEmpty =
             unsafeFreezeArray dst
     in shows (toList dst 0) "\n"
 
+--  Check that the static-size optimization works.
+test_cloneMutableArrayStatic :: String
+test_cloneMutableArrayStatic =
+    let dst = runST $ do
+            src <- newArray len 0
+            fill src 0 len
+            -- Don't include the first and last element.
+            dst <- cloneMutableArray src 1 copiedStatic
+            unsafeFreezeArray dst
+    in shows (toList dst copiedStatic) "\n"
+
 ------------------------------------------------------------------------
 -- freezeArray#
 
@@ -131,6 +162,16 @@ test_freezeArray =
             freezeArray src 1 copied
     in shows (toList dst copied) "\n"
 
+--  Check that the static-size optimization works.
+test_freezeArrayStatic :: String
+test_freezeArrayStatic =
+    let dst = runST $ do
+            src <- newArray len 0
+            fill src 0 len
+            -- Don't include the first and last element.
+            freezeArray src 1 copiedStatic
+    in shows (toList dst copiedStatic) "\n"
+
 ------------------------------------------------------------------------
 -- thawArray#
 
@@ -147,6 +188,18 @@ test_thawArray =
             unsafeFreezeArray dst
     in shows (toList dst copied) "\n"
 
+--  Check that the static-size optimization works.
+test_thawArrayStatic :: String
+test_thawArrayStatic =
+    let dst = runST $ do
+            src <- newArray len 0
+            fill src 0 len
+            src <- unsafeFreezeArray src
+            -- Don't include the first and last element.
+            dst <- thawArray src 1 copiedStatic
+            unsafeFreezeArray dst
+    in shows (toList dst copiedStatic) "\n"
+
 ------------------------------------------------------------------------
 -- Test helpers
 
@@ -181,13 +234,27 @@ newArray (I# n#) a = ST $ \s# -> case newArray# n# a s# of
     (# s2#, marr# #) -> (# s2#, MArray marr# #)
 
 indexArray :: Array a -> Int -> a
-indexArray arr (I# i#) = case indexArray# (unArray arr) i# of
-    (# a #) -> a
+indexArray arr i@(I# i#)
+  | i < 0 || i >= len =
+      error $ "bounds error, offset " ++ show i ++ ", length " ++ show len
+  | otherwise = case indexArray# (unArray arr) i# of
+      (# a #) -> a
+  where len = lengthArray arr
 
 writeArray :: MArray s a -> Int -> a -> ST s ()
-writeArray marr (I# i#) a = ST $ \ s# ->
+writeArray marr i@(I# i#) a
+  | i < 0 || i >= len =
+      error $ "bounds error, offset " ++ show i ++ ", length " ++ show len
+  | otherwise = ST $ \ s# ->
     case writeArray# (unMArray marr) i# a s# of
         s2# -> (# s2#, () #)
+  where len = lengthMArray marr
+
+lengthArray :: Array a -> Int
+lengthArray arr = I# (sizeofArray# (unArray arr))
+
+lengthMArray :: MArray s a -> Int
+lengthMArray marr = I# (sizeofMutableArray# (unMArray marr))
 
 unsafeFreezeArray :: MArray s a -> ST s (Array a)
 unsafeFreezeArray marr = ST $ \ s# ->
@@ -206,21 +273,25 @@ copyMutableArray src (I# six#) dst (I# dix#) (I# n#) = ST $ \ s# ->
 
 cloneArray :: Array a -> Int -> Int -> Array a
 cloneArray src (I# six#) (I# n#) = Array (cloneArray# (unArray src) six# n#)
+{-# INLINE cloneArray #-}  -- to make sure optimization triggers
 
 cloneMutableArray :: MArray s a -> Int -> Int -> ST s (MArray s a)
 cloneMutableArray src (I# six#) (I# n#) = ST $ \ s# ->
     case cloneMutableArray# (unMArray src) six# n# s# of
         (# s2#, marr# #) -> (# s2#, MArray marr# #)
+{-# INLINE cloneMutableArray #-}  -- to make sure optimization triggers
 
 freezeArray :: MArray s a -> Int -> Int -> ST s (Array a)
 freezeArray src (I# six#) (I# n#) = ST $ \ s# ->
     case freezeArray# (unMArray src) six# n# s# of
         (# s2#, arr# #) -> (# s2#, Array arr# #)
+{-# INLINE freezeArray #-}  -- to make sure optimization triggers
 
 thawArray :: Array a -> Int -> Int -> ST s (MArray s a)
 thawArray src (I# six#) (I# n#) = ST $ \ s# ->
     case thawArray# (unArray src) six# n# s# of
         (# s2#, marr# #) -> (# s2#, MArray marr# #)
+{-# INLINE thawArray #-}  -- to make sure optimization triggers
 
 toList :: Array a -> Int -> [a]
 toList arr n = go 0
diff --git a/testsuite/tests/codeGen/should_run/cgrun064.stdout b/testsuite/tests/codeGen/should_run/cgrun064.stdout
index 8e741ceec657..86ad8a276c00 100644
--- a/testsuite/tests/codeGen/should_run/cgrun064.stdout
+++ b/testsuite/tests/codeGen/should_run/cgrun064.stdout
@@ -6,11 +6,19 @@
 
 [1,4,9,16,25,36,49,64,81,100,121,144,169,196,225,256,289,324,361,400,441,484,529,576,625,676,729,784,841,900,961,1024,1089,1156,1225,1296,1369,1444,1521,1600,1681,1764,1849,1936,2025,2116,2209,2304,2401,2500,2601,2704,2809,2916,3025,3136,3249,3364,3481,3600,3721,3844,3969,4096,4225,4356,4489,4624,4761,4900,5041,5184,5329,5476,5625,5776,5929,6084,6241,6400,6561,6724,6889,7056,7225,7396,7569,7744,7921,8100,8281,8464,8649,8836,9025,9216,9409,9604,9801,10000,10201,10404,10609,10816,11025,11236,11449,11664,11881,12100,12321,12544,12769,12996,13225,13456,13689,13924,14161,14400,14641,14884,15129,15376,15625,15876,16129,16384]
 
+[1,4,9,16,25,36,49,64,81,100,121,144,169,196,225,256]
+
 [1,4,9,16,25,36,49,64,81,100,121,144,169,196,225,256,289,324,361,400,441,484,529,576,625,676,729,784,841,900,961,1024,1089,1156,1225,1296,1369,1444,1521,1600,1681,1764,1849,1936,2025,2116,2209,2304,2401,2500,2601,2704,2809,2916,3025,3136,3249,3364,3481,3600,3721,3844,3969,4096,4225,4356,4489,4624,4761,4900,5041,5184,5329,5476,5625,5776,5929,6084,6241,6400,6561,6724,6889,7056,7225,7396,7569,7744,7921,8100,8281,8464,8649,8836,9025,9216,9409,9604,9801,10000,10201,10404,10609,10816,11025,11236,11449,11664,11881,12100,12321,12544,12769,12996,13225,13456,13689,13924,14161,14400,14641,14884,15129,15376,15625,15876,16129,16384]
 
 []
 
+[1,4,9,16,25,36,49,64,81,100,121,144,169,196,225,256]
+
 [1,4,9,16,25,36,49,64,81,100,121,144,169,196,225,256,289,324,361,400,441,484,529,576,625,676,729,784,841,900,961,1024,1089,1156,1225,1296,1369,1444,1521,1600,1681,1764,1849,1936,2025,2116,2209,2304,2401,2500,2601,2704,2809,2916,3025,3136,3249,3364,3481,3600,3721,3844,3969,4096,4225,4356,4489,4624,4761,4900,5041,5184,5329,5476,5625,5776,5929,6084,6241,6400,6561,6724,6889,7056,7225,7396,7569,7744,7921,8100,8281,8464,8649,8836,9025,9216,9409,9604,9801,10000,10201,10404,10609,10816,11025,11236,11449,11664,11881,12100,12321,12544,12769,12996,13225,13456,13689,13924,14161,14400,14641,14884,15129,15376,15625,15876,16129,16384]
 
+[1,4,9,16,25,36,49,64,81,100,121,144,169,196,225,256]
+
 [1,4,9,16,25,36,49,64,81,100,121,144,169,196,225,256,289,324,361,400,441,484,529,576,625,676,729,784,841,900,961,1024,1089,1156,1225,1296,1369,1444,1521,1600,1681,1764,1849,1936,2025,2116,2209,2304,2401,2500,2601,2704,2809,2916,3025,3136,3249,3364,3481,3600,3721,3844,3969,4096,4225,4356,4489,4624,4761,4900,5041,5184,5329,5476,5625,5776,5929,6084,6241,6400,6561,6724,6889,7056,7225,7396,7569,7744,7921,8100,8281,8464,8649,8836,9025,9216,9409,9604,9801,10000,10201,10404,10609,10816,11025,11236,11449,11664,11881,12100,12321,12544,12769,12996,13225,13456,13689,13924,14161,14400,14641,14884,15129,15376,15625,15876,16129,16384]
 
+[1,4,9,16,25,36,49,64,81,100,121,144,169,196,225,256]
+
diff --git a/testsuite/tests/codeGen/should_run/cgrun071.hs b/testsuite/tests/codeGen/should_run/cgrun071.hs
index 29bf03d986b5..d55ee65e018a 100644
--- a/testsuite/tests/codeGen/should_run/cgrun071.hs
+++ b/testsuite/tests/codeGen/should_run/cgrun071.hs
@@ -37,7 +37,7 @@ popcnt64 (W64# w#) =
     W# (popCnt# w#)
 #endif
 
--- Cribbed from http://hackage.haskell.org/trac/ghc/ticket/3563
+-- Cribbed from http://ghc.haskell.org/trac/ghc/ticket/3563
 slowPopcnt :: Word -> Word
 slowPopcnt x = count' (bitSize x) x 0
   where
diff --git a/testsuite/tests/concurrent/should_run/AtomicPrimops.hs b/testsuite/tests/concurrent/should_run/AtomicPrimops.hs
new file mode 100644
index 000000000000..1789e26bbb46
--- /dev/null
+++ b/testsuite/tests/concurrent/should_run/AtomicPrimops.hs
@@ -0,0 +1,256 @@
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE UnboxedTuples #-}
+
+module Main ( main ) where
+
+import Control.Concurrent
+import Control.Concurrent.MVar
+import Control.Monad (when)
+import Foreign.Storable
+import GHC.Exts
+import GHC.IO
+
+-- | Iterations per worker.
+iters :: Int
+iters = 1000000
+
+main :: IO ()
+main = do
+    fetchAddSubTest
+    fetchAndTest
+    fetchNandTest
+    fetchOrTest
+    fetchXorTest
+    casTest
+    readWriteTest
+
+-- | Test fetchAddIntArray# by having two threads concurrenctly
+-- increment a counter and then checking the sum at the end.
+fetchAddSubTest :: IO ()
+fetchAddSubTest = do
+    tot <- race 0
+        (\ mba -> work fetchAddIntArray mba iters 2)
+        (\ mba -> work fetchSubIntArray mba iters 1)
+    assertEq 1000000 tot "fetchAddSubTest"
+  where
+    work :: (MByteArray -> Int -> Int -> IO ()) -> MByteArray -> Int -> Int
+         -> IO ()
+    work op mba 0 val = return ()
+    work op mba n val = op mba 0 val >> work op mba (n-1) val
+
+-- | Test fetchXorIntArray# by having two threads concurrenctly XORing
+-- and then checking the result at the end. Works since XOR is
+-- commutative.
+--
+-- Covers the code paths for AND, NAND, and OR as well.
+fetchXorTest :: IO ()
+fetchXorTest = do
+    res <- race n0
+        (\ mba -> work mba iters t1pat)
+        (\ mba -> work mba iters t2pat)
+    assertEq expected res "fetchXorTest"
+  where
+    work :: MByteArray -> Int -> Int -> IO ()
+    work mba 0 val = return ()
+    work mba n val = fetchXorIntArray mba 0 val >> work mba (n-1) val
+
+    -- Initial value is a large prime and the two patterns are 1010...
+    -- and 0101...
+    (n0, t1pat, t2pat)
+        | sizeOf (undefined :: Int) == 8 =
+            (0x00000000ffffffff, 0x5555555555555555, 0x9999999999999999)
+        | otherwise = (0x0000ffff, 0x55555555, 0x99999999)
+    expected
+        | sizeOf (undefined :: Int) == 8 = 4294967295
+        | otherwise = 65535
+
+-- The tests for AND, NAND, and OR are trivial for two reasons:
+--
+--  * The code path is already well exercised by 'fetchXorTest'.
+--
+--  * It's harder to test these operations, as a long sequence of them
+--    convert to a single value but we'd like to write a test in the
+--    style of 'fetchXorTest' that applies the operation repeatedly,
+--    to make it likely that any race conditions are detected.
+--
+-- Right now we only test that they return the correct value for a
+-- single op on each thread.
+
+-- | Test an associative operation.
+fetchOpTest :: (MByteArray -> Int -> Int -> IO ())
+            -> Int -> String -> IO ()
+fetchOpTest op expected name = do
+    res <- race n0
+        (\ mba -> work mba t1pat)
+        (\ mba -> work mba t2pat)
+    assertEq expected res name
+  where
+    work :: MByteArray -> Int -> IO ()
+    work mba val = op mba 0 val
+
+-- | Initial value and operation arguments for race test.
+--
+-- Initial value is a large prime and the two patterns are 1010...
+-- and 0101...
+n0, t1pat, t2pat :: Int
+(n0, t1pat, t2pat)
+    | sizeOf (undefined :: Int) == 8 =
+        (0x00000000ffffffff, 0x5555555555555555, 0x9999999999999999)
+    | otherwise = (0x0000ffff, 0x55555555, 0x99999999)
+
+fetchAndTest :: IO ()
+fetchAndTest = fetchOpTest fetchAndIntArray expected "fetchAndTest"
+  where expected
+            | sizeOf (undefined :: Int) == 8 = 286331153
+            | otherwise = 4369
+
+-- | Test NAND without any race, as NAND isn't associative.
+fetchNandTest :: IO ()
+fetchNandTest = do
+    mba <- newByteArray (sizeOf (undefined :: Int))
+    writeIntArray mba 0 n0
+    fetchNandIntArray mba 0 t1pat
+    fetchNandIntArray mba 0 t2pat
+    res <- readIntArray mba 0
+    assertEq expected res "fetchNandTest"
+  where expected
+            | sizeOf (undefined :: Int) == 8 = 7378697629770151799
+            | otherwise = -2576976009
+
+fetchOrTest :: IO ()
+fetchOrTest = fetchOpTest fetchOrIntArray expected "fetchOrTest"
+  where expected
+            | sizeOf (undefined :: Int) == 8 = 15987178197787607039
+            | otherwise = 3722313727
+
+-- | Test casIntArray# by using it to emulate fetchAddIntArray# and
+-- then having two threads concurrenctly increment a counter,
+-- checking the sum at the end.
+casTest :: IO ()
+casTest = do
+    tot <- race 0
+        (\ mba -> work mba iters 1)
+        (\ mba -> work mba iters 2)
+    assertEq 3000000 tot "casTest"
+  where
+    work :: MByteArray -> Int -> Int -> IO ()
+    work mba 0 val = return ()
+    work mba n val = add mba 0 val >> work mba (n-1) val
+
+    -- Fetch-and-add implemented using CAS.
+    add :: MByteArray -> Int -> Int -> IO ()
+    add mba ix n = do
+        old <- readIntArray mba ix
+        old' <- casIntArray mba ix old (old + n)
+        when (old /= old') $ add mba ix n
+
+-- | Tests atomic reads and writes by making sure that one thread sees
+-- updates that are done on another. This test isn't very good at the
+-- moment, as this might work even without atomic ops, but at least it
+-- exercises the code.
+readWriteTest :: IO ()
+readWriteTest = do
+    mba <- newByteArray (sizeOf (undefined :: Int))
+    writeIntArray mba 0 0
+    latch <- newEmptyMVar
+    done <- newEmptyMVar
+    forkIO $ do
+        takeMVar latch
+        n <- atomicReadIntArray mba 0
+        assertEq 1 n "readWriteTest"
+        putMVar done ()
+    atomicWriteIntArray mba 0 1
+    putMVar latch ()
+    takeMVar done
+
+-- | Create two threads that mutate the byte array passed to them
+-- concurrently. The array is one word large.
+race :: Int                    -- ^ Initial value of array element
+     -> (MByteArray -> IO ())  -- ^ Thread 1 action
+     -> (MByteArray -> IO ())  -- ^ Thread 2 action
+     -> IO Int                 -- ^ Final value of array element
+race n0 thread1 thread2 = do
+    done1 <- newEmptyMVar
+    done2 <- newEmptyMVar
+    mba <- newByteArray (sizeOf (undefined :: Int))
+    writeIntArray mba 0 n0
+    forkIO $ thread1 mba >> putMVar done1 ()
+    forkIO $ thread2 mba >> putMVar done2 ()
+    mapM_ takeMVar [done1, done2]
+    readIntArray mba 0
+
+------------------------------------------------------------------------
+-- Test helper
+
+assertEq :: (Eq a, Show a) => a -> a -> String -> IO ()
+assertEq expected actual name
+    | expected == actual = putStrLn $ name ++ ": OK"
+    | otherwise = do
+        putStrLn $ name ++ ": FAIL"
+        putStrLn $ "Expected: " ++ show expected
+        putStrLn $ "  Actual: " ++ show actual
+
+------------------------------------------------------------------------
+-- Wrappers around MutableByteArray#
+
+data MByteArray = MBA (MutableByteArray# RealWorld)
+
+fetchAddIntArray :: MByteArray -> Int -> Int -> IO ()
+fetchAddIntArray (MBA mba#) (I# ix#) (I# n#) = IO $ \ s# ->
+    case fetchAddIntArray# mba# ix# n# s# of
+        (# s2#, _ #) -> (# s2#, () #)
+
+fetchSubIntArray :: MByteArray -> Int -> Int -> IO ()
+fetchSubIntArray (MBA mba#) (I# ix#) (I# n#) = IO $ \ s# ->
+    case fetchSubIntArray# mba# ix# n# s# of
+        (# s2#, _ #) -> (# s2#, () #)
+
+fetchAndIntArray :: MByteArray -> Int -> Int -> IO ()
+fetchAndIntArray (MBA mba#) (I# ix#) (I# n#) = IO $ \ s# ->
+    case fetchAndIntArray# mba# ix# n# s# of
+        (# s2#, _ #) -> (# s2#, () #)
+
+fetchNandIntArray :: MByteArray -> Int -> Int -> IO ()
+fetchNandIntArray (MBA mba#) (I# ix#) (I# n#) = IO $ \ s# ->
+    case fetchNandIntArray# mba# ix# n# s# of
+        (# s2#, _ #) -> (# s2#, () #)
+
+fetchOrIntArray :: MByteArray -> Int -> Int -> IO ()
+fetchOrIntArray (MBA mba#) (I# ix#) (I# n#) = IO $ \ s# ->
+    case fetchOrIntArray# mba# ix# n# s# of
+        (# s2#, _ #) -> (# s2#, () #)
+
+fetchXorIntArray :: MByteArray -> Int -> Int -> IO ()
+fetchXorIntArray (MBA mba#) (I# ix#) (I# n#) = IO $ \ s# ->
+    case fetchXorIntArray# mba# ix# n# s# of
+        (# s2#, _ #) -> (# s2#, () #)
+
+newByteArray :: Int -> IO MByteArray
+newByteArray (I# n#) = IO $ \ s# ->
+    case newByteArray# n# s# of
+        (# s2#, mba# #) -> (# s2#, MBA mba# #)
+
+writeIntArray :: MByteArray -> Int -> Int -> IO ()
+writeIntArray (MBA mba#) (I# ix#) (I# n#) = IO $ \ s# ->
+    case writeIntArray# mba# ix# n# s# of
+        s2# -> (# s2#, () #)
+
+readIntArray :: MByteArray -> Int -> IO Int
+readIntArray (MBA mba#) (I# ix#) = IO $ \ s# ->
+    case readIntArray# mba# ix# s# of
+        (# s2#, n# #) -> (# s2#, I# n# #)
+
+atomicWriteIntArray :: MByteArray -> Int -> Int -> IO ()
+atomicWriteIntArray (MBA mba#) (I# ix#) (I# n#) = IO $ \ s# ->
+    case atomicWriteIntArray# mba# ix# n# s# of
+        s2# -> (# s2#, () #)
+
+atomicReadIntArray :: MByteArray -> Int -> IO Int
+atomicReadIntArray (MBA mba#) (I# ix#) = IO $ \ s# ->
+    case atomicReadIntArray# mba# ix# s# of
+        (# s2#, n# #) -> (# s2#, I# n# #)
+
+casIntArray :: MByteArray -> Int -> Int -> Int -> IO Int
+casIntArray (MBA mba#) (I# ix#) (I# old#) (I# new#) = IO $ \ s# ->
+    case casIntArray# mba# ix# old# new# s# of
+        (# s2#, old2# #) -> (# s2#, I# old2# #)
diff --git a/testsuite/tests/concurrent/should_run/AtomicPrimops.stdout b/testsuite/tests/concurrent/should_run/AtomicPrimops.stdout
new file mode 100644
index 000000000000..c37041a04098
--- /dev/null
+++ b/testsuite/tests/concurrent/should_run/AtomicPrimops.stdout
@@ -0,0 +1,7 @@
+fetchAddSubTest: OK
+fetchAndTest: OK
+fetchNandTest: OK
+fetchOrTest: OK
+fetchXorTest: OK
+casTest: OK
+readWriteTest: OK
diff --git a/testsuite/tests/concurrent/should_run/T9379.hs b/testsuite/tests/concurrent/should_run/T9379.hs
new file mode 100644
index 000000000000..49e6d1eaedfe
--- /dev/null
+++ b/testsuite/tests/concurrent/should_run/T9379.hs
@@ -0,0 +1,17 @@
+import Control.Exception
+import Control.Concurrent
+import Control.Concurrent.STM
+import Foreign.StablePtr
+
+main :: IO ()
+main = do
+  tv <- atomically $ newTVar True
+  _ <- newStablePtr tv
+  t <- mask_ $ forkIO (blockSTM tv)
+  killThread t
+
+blockSTM :: TVar Bool -> IO ()
+blockSTM tv = do
+  atomically $ do
+    v <- readTVar tv
+    check $ not v
diff --git a/testsuite/tests/concurrent/should_run/all.T b/testsuite/tests/concurrent/should_run/all.T
index d4e76c6b1ea3..b43026a2ea98 100644
--- a/testsuite/tests/concurrent/should_run/all.T
+++ b/testsuite/tests/concurrent/should_run/all.T
@@ -78,15 +78,22 @@ test('readMVar1', normal, compile_and_run, [''])
 test('readMVar2', normal, compile_and_run, [''])
 test('readMVar3', normal, compile_and_run, [''])
 test('tryReadMVar1', normal, compile_and_run, [''])
+test('tryReadMVar2', normal, compile_and_run, [''])
 
 test('T7970', normal, compile_and_run, [''])
+test('AtomicPrimops', normal, compile_and_run, [''])
+
+# test uses 2 threads and yield, scheduling can vary with threaded2
+test('threadstatus-9333', [omit_ways(['threaded2'])], compile_and_run, [''])
+
+test('T9379', normal, compile_and_run, [''])
 
 # -----------------------------------------------------------------------------
 # These tests we only do for a full run
 
 def f( name, opts ):
   if config.fast:
-  	opts.skip = 1
+     opts.skip = 1
 
 setTestOpts(f)
 
diff --git a/testsuite/tests/concurrent/should_run/threadstatus-9333.hs b/testsuite/tests/concurrent/should_run/threadstatus-9333.hs
new file mode 100644
index 000000000000..73cd6b895d6f
--- /dev/null
+++ b/testsuite/tests/concurrent/should_run/threadstatus-9333.hs
@@ -0,0 +1,33 @@
+-- test for threadstatus, checking (mvar read, mvar block reasons)
+-- created together with fixing GHC ticket #9333
+
+module Main where
+
+import Control.Concurrent
+import GHC.Conc
+import GHC.Conc.Sync
+
+main = do
+  -- create MVars to block on
+  v1 <- newMVar "full"
+  v2 <- newEmptyMVar
+  -- create a thread which fills both MVars
+  parent <- myThreadId
+  putStrLn "p: forking child thread"
+  child <- forkIO $
+           do putStrLn "c: filling full MVar" -- should block
+              putMVar v1 "filled full var"
+              yield
+              putStrLn "c: filling empty MVar (expect parent to be blocked)"
+              stat2 <- threadStatus parent
+              putStrLn ("c: parent is " ++ show stat2)
+              putMVar v2 "filled empty var"
+  yield
+  putStrLn "p: emptying full MVar (expect child to be blocked on it)"
+  stat1 <- threadStatus child
+  putStrLn ("p: child is " ++ show stat1)
+  s1 <- takeMVar v1 -- should unblock child
+  putStrLn ("p: from MVar: " ++ s1)
+  putStrLn "p: reading empty MVar"
+  s2 <- readMVar v2 -- should block
+  putStrLn ("p: from MVar: " ++ s2)
diff --git a/testsuite/tests/concurrent/should_run/threadstatus-9333.stdout b/testsuite/tests/concurrent/should_run/threadstatus-9333.stdout
new file mode 100644
index 000000000000..7b4f78861589
--- /dev/null
+++ b/testsuite/tests/concurrent/should_run/threadstatus-9333.stdout
@@ -0,0 +1,9 @@
+p: forking child thread
+c: filling full MVar
+p: emptying full MVar (expect child to be blocked on it)
+p: child is ThreadBlocked BlockedOnMVar
+p: from MVar: full
+p: reading empty MVar
+c: filling empty MVar (expect parent to be blocked)
+c: parent is ThreadBlocked BlockedOnMVar
+p: from MVar: filled empty var
diff --git a/testsuite/tests/concurrent/should_run/tryReadMVar2.hs b/testsuite/tests/concurrent/should_run/tryReadMVar2.hs
new file mode 100644
index 000000000000..13b8a45c320c
--- /dev/null
+++ b/testsuite/tests/concurrent/should_run/tryReadMVar2.hs
@@ -0,0 +1,15 @@
+module Main where
+
+import Control.Concurrent
+import Control.Monad
+
+main = do
+    m <- newEmptyMVar
+    done <- newEmptyMVar
+    let q = 200000
+    forkIO (do mapM (\n -> putMVar m n) [1..q]; putMVar done ())
+    forkIO (do replicateM_ q $ readMVar m; putMVar done ())
+    forkIO (do replicateM_ q $ tryReadMVar m; putMVar done ())
+    forkIO (do replicateM_ q $ takeMVar m; putMVar done ())
+    replicateM_ 4 $ takeMVar done
+
diff --git a/testsuite/tests/deSugar/should_compile/GadtOverlap.stderr b/testsuite/tests/deSugar/should_compile/GadtOverlap.stderr
index 359a352edbc6..4e3f1c17f12b 100644
--- a/testsuite/tests/deSugar/should_compile/GadtOverlap.stderr
+++ b/testsuite/tests/deSugar/should_compile/GadtOverlap.stderr
@@ -1,4 +1,4 @@
 
 GadtOverlap.hs:19:1: Warning:
     Pattern match(es) are non-exhaustive
-    In an equation for ‛h’: Patterns not matched: T3
+    In an equation for ‘h’: Patterns not matched: T3
diff --git a/testsuite/tests/deSugar/should_compile/T2395.stderr b/testsuite/tests/deSugar/should_compile/T2395.stderr
index 241a767f7cf5..940f2634121e 100644
--- a/testsuite/tests/deSugar/should_compile/T2395.stderr
+++ b/testsuite/tests/deSugar/should_compile/T2395.stderr
@@ -1,4 +1,4 @@
 
 T2395.hs:12:1: Warning:
     Pattern match(es) are overlapped
-    In an equation for ‛bar’: bar _ = ...
+    In an equation for ‘bar’: bar _ = ...
diff --git a/testsuite/tests/deSugar/should_compile/T2431.stderr b/testsuite/tests/deSugar/should_compile/T2431.stderr
index dbafaedf8297..c40b603d3fa8 100644
--- a/testsuite/tests/deSugar/should_compile/T2431.stderr
+++ b/testsuite/tests/deSugar/should_compile/T2431.stderr
@@ -13,7 +13,7 @@ T2431.$WRefl [InlPrag=INLINE] :: forall a. a T2431.:~: a
 T2431.$WRefl = \ (@ a) -> T2431.Refl @ a @ a @~ <a>_N
 
 T2431.absurd
-  :: forall a. (GHC.Types.Int T2431.:~: GHC.Types.Bool) -> a
+  :: forall a. GHC.Types.Int T2431.:~: GHC.Types.Bool -> a
 [GblId, Arity=1, Caf=NoCafRefs, Str=DmdType <L,U>b]
 T2431.absurd =
   \ (@ a) (x :: GHC.Types.Int T2431.:~: GHC.Types.Bool) ->
diff --git a/testsuite/tests/deSugar/should_compile/T3263-1.stderr b/testsuite/tests/deSugar/should_compile/T3263-1.stderr
index 15b27f6adfe1..b792f1a88776 100644
--- a/testsuite/tests/deSugar/should_compile/T3263-1.stderr
+++ b/testsuite/tests/deSugar/should_compile/T3263-1.stderr
@@ -1,10 +1,10 @@
 
 T3263-1.hs:25:3: Warning:
-    A do-notation statement discarded a result of type ‛Int’
-    Suppress this warning by saying ‛_ <- nonNullM’
+    A do-notation statement discarded a result of type ‘Int’
+    Suppress this warning by saying ‘_ <- nonNullM’
     or by using the flag -fno-warn-unused-do-bind
 
 T3263-1.hs:35:3: Warning:
-    A do-notation statement discarded a result of type ‛Int’
-    Suppress this warning by saying ‛_ <- nonNullM’
+    A do-notation statement discarded a result of type ‘Int’
+    Suppress this warning by saying ‘_ <- nonNullM’
     or by using the flag -fno-warn-unused-do-bind
diff --git a/testsuite/tests/deSugar/should_compile/T3263-2.stderr b/testsuite/tests/deSugar/should_compile/T3263-2.stderr
index 8f4c1774c594..1665d722d508 100644
--- a/testsuite/tests/deSugar/should_compile/T3263-2.stderr
+++ b/testsuite/tests/deSugar/should_compile/T3263-2.stderr
@@ -1,10 +1,10 @@
 
 T3263-2.hs:25:3: Warning:
-    A do-notation statement discarded a result of type ‛m Int’
-    Suppress this warning by saying ‛_ <- return (return 10 :: m Int)’
+    A do-notation statement discarded a result of type ‘m Int’
+    Suppress this warning by saying ‘_ <- return (return 10 :: m Int)’
     or by using the flag -fno-warn-wrong-do-bind
 
 T3263-2.hs:37:3: Warning:
-    A do-notation statement discarded a result of type ‛m Int’
-    Suppress this warning by saying ‛_ <- return (return 10 :: m Int)’
+    A do-notation statement discarded a result of type ‘m Int’
+    Suppress this warning by saying ‘_ <- return (return 10 :: m Int)’
     or by using the flag -fno-warn-wrong-do-bind
diff --git a/testsuite/tests/deSugar/should_compile/T5117.stderr b/testsuite/tests/deSugar/should_compile/T5117.stderr
index 2860940b0c83..93de2cf9e738 100644
--- a/testsuite/tests/deSugar/should_compile/T5117.stderr
+++ b/testsuite/tests/deSugar/should_compile/T5117.stderr
@@ -1,4 +1,4 @@
 
 T5117.hs:15:1: Warning:
     Pattern match(es) are overlapped
-    In an equation for ‛f3’: f3 (MyString "a") = ...
+    In an equation for ‘f3’: f3 (MyString "a") = ...
diff --git a/testsuite/tests/deSugar/should_compile/ds002.stderr-ghc b/testsuite/tests/deSugar/should_compile/ds002.stderr-ghc
index c526e0db48b0..fe4ec9487360 100644
--- a/testsuite/tests/deSugar/should_compile/ds002.stderr-ghc
+++ b/testsuite/tests/deSugar/should_compile/ds002.stderr-ghc
@@ -1,10 +1,10 @@
 
 ds002.hs:7:1: Warning:
     Pattern match(es) are overlapped
-    In an equation for ‛f’:
+    In an equation for ‘f’:
         f y = ...
         f z = ...
 
 ds002.hs:11:1: Warning:
     Pattern match(es) are overlapped
-    In an equation for ‛g’: g x y z = ...
+    In an equation for ‘g’: g x y z = ...
diff --git a/testsuite/tests/deSugar/should_compile/ds003.stderr-ghc b/testsuite/tests/deSugar/should_compile/ds003.stderr-ghc
index f12789da42da..1b4c018b6225 100644
--- a/testsuite/tests/deSugar/should_compile/ds003.stderr-ghc
+++ b/testsuite/tests/deSugar/should_compile/ds003.stderr-ghc
@@ -1,6 +1,6 @@
 
 ds003.hs:5:1: Warning:
     Pattern match(es) are overlapped
-    In an equation for ‛f’:
+    In an equation for ‘f’:
         f (x : x1 : x2 : x3) ~(y, ys) z = ...
         f x y True = ...
diff --git a/testsuite/tests/deSugar/should_compile/ds019.stderr-ghc b/testsuite/tests/deSugar/should_compile/ds019.stderr-ghc
index fd13ec7203f6..4d6e60f1fad6 100644
--- a/testsuite/tests/deSugar/should_compile/ds019.stderr-ghc
+++ b/testsuite/tests/deSugar/should_compile/ds019.stderr-ghc
@@ -1,7 +1,7 @@
 
 ds019.hs:5:1: Warning:
     Pattern match(es) are overlapped
-    In an equation for ‛f’:
+    In an equation for ‘f’:
         f d (j, k) p = ...
         f (e, f, g) l q = ...
         f h (m, n) r = ...
diff --git a/testsuite/tests/deSugar/should_compile/ds020.stderr-ghc b/testsuite/tests/deSugar/should_compile/ds020.stderr-ghc
index 42323200253b..4120a957d3a3 100644
--- a/testsuite/tests/deSugar/should_compile/ds020.stderr-ghc
+++ b/testsuite/tests/deSugar/should_compile/ds020.stderr-ghc
@@ -1,18 +1,18 @@
 
 ds020.hs:8:1: Warning:
     Pattern match(es) are overlapped
-    In an equation for ‛a’: a ~(~[], ~[], ~[]) = ...
+    In an equation for ‘a’: a ~(~[], ~[], ~[]) = ...
 
 ds020.hs:11:1: Warning:
     Pattern match(es) are overlapped
-    In an equation for ‛b’: b ~(~x : ~xs : ~ys) = ...
+    In an equation for ‘b’: b ~(~x : ~xs : ~ys) = ...
 
 ds020.hs:16:1: Warning:
     Pattern match(es) are overlapped
-    In an equation for ‛d’:
+    In an equation for ‘d’:
         d ~(n+43) = ...
         d ~(n+999) = ...
 
 ds020.hs:22:1: Warning:
     Pattern match(es) are overlapped
-    In an equation for ‛f’: f x@(~[]) = ...
+    In an equation for ‘f’: f x@(~[]) = ...
diff --git a/testsuite/tests/deSugar/should_compile/ds022.stderr-ghc b/testsuite/tests/deSugar/should_compile/ds022.stderr-ghc
index 7dd50a2610d6..45fe3d8a95f7 100644
--- a/testsuite/tests/deSugar/should_compile/ds022.stderr-ghc
+++ b/testsuite/tests/deSugar/should_compile/ds022.stderr-ghc
@@ -1,6 +1,6 @@
 
 ds022.hs:20:1: Warning:
     Pattern match(es) are overlapped
-    In an equation for ‛i’:
+    In an equation for ‘i’:
         i 1 0.011e2 = ...
         i 2 2.20000 = ...
diff --git a/testsuite/tests/deSugar/should_compile/ds041.stderr-ghc b/testsuite/tests/deSugar/should_compile/ds041.stderr-ghc
index 48129316fe73..c276b77ce982 100644
--- a/testsuite/tests/deSugar/should_compile/ds041.stderr-ghc
+++ b/testsuite/tests/deSugar/should_compile/ds041.stderr-ghc
@@ -3,6 +3,6 @@ ds041.hs:1:14: Warning:
     -XDatatypeContexts is deprecated: It was widely considered a misfeature, and has been removed from the Haskell language.
 
 ds041.hs:16:7: Warning:
-    Fields of ‛Foo’ not initialised: x
+    Fields of ‘Foo’ not initialised: x
     In the expression: Foo {}
-    In an equation for ‛foo’: foo = Foo {}
+    In an equation for ‘foo’: foo = Foo {}
diff --git a/testsuite/tests/deSugar/should_compile/ds051.stderr-ghc b/testsuite/tests/deSugar/should_compile/ds051.stderr-ghc
index c40c44620eca..76bc4d39685f 100644
--- a/testsuite/tests/deSugar/should_compile/ds051.stderr-ghc
+++ b/testsuite/tests/deSugar/should_compile/ds051.stderr-ghc
@@ -1,12 +1,12 @@
 
 ds051.hs:6:1: Warning:
     Pattern match(es) are overlapped
-    In an equation for ‛f1’: f1 "ab" = ...
+    In an equation for ‘f1’: f1 "ab" = ...
 
 ds051.hs:11:1: Warning:
     Pattern match(es) are overlapped
-    In an equation for ‛f2’: f2 ('a' : 'b' : []) = ...
+    In an equation for ‘f2’: f2 ('a' : 'b' : []) = ...
 
 ds051.hs:16:1: Warning:
     Pattern match(es) are overlapped
-    In an equation for ‛f3’: f3 "ab" = ...
+    In an equation for ‘f3’: f3 "ab" = ...
diff --git a/testsuite/tests/deSugar/should_compile/ds053.stderr-ghc b/testsuite/tests/deSugar/should_compile/ds053.stderr-ghc
index 861e66b84797..52aa9d791750 100644
--- a/testsuite/tests/deSugar/should_compile/ds053.stderr-ghc
+++ b/testsuite/tests/deSugar/should_compile/ds053.stderr-ghc
@@ -1,2 +1,2 @@
 
-ds053.hs:5:1: Warning: Defined but not used: ‛f’
+ds053.hs:5:1: Warning: Defined but not used: ‘f’
diff --git a/testsuite/tests/deSugar/should_compile/ds056.stderr b/testsuite/tests/deSugar/should_compile/ds056.stderr
index f4d2e81b5168..3f44267f2a38 100644
--- a/testsuite/tests/deSugar/should_compile/ds056.stderr
+++ b/testsuite/tests/deSugar/should_compile/ds056.stderr
@@ -1,4 +1,4 @@
 
 ds056.hs:8:1: Warning:
     Pattern match(es) are overlapped
-    In an equation for ‛g’: g _ = ...
+    In an equation for ‘g’: g _ = ...
diff --git a/testsuite/tests/deSugar/should_run/T8952.hs b/testsuite/tests/deSugar/should_run/T8952.hs
new file mode 100644
index 000000000000..42eeb250a9ba
--- /dev/null
+++ b/testsuite/tests/deSugar/should_run/T8952.hs
@@ -0,0 +1,8 @@
+{-# LANGUAGE BangPatterns #-}
+
+module Main where
+
+main = print (case Nothing of
+                  !(~(Just x)) -> "ok"
+                  Nothing   -> "bad")
+
diff --git a/testsuite/tests/deSugar/should_run/T8952.stdout b/testsuite/tests/deSugar/should_run/T8952.stdout
new file mode 100644
index 000000000000..52c33a57c76f
--- /dev/null
+++ b/testsuite/tests/deSugar/should_run/T8952.stdout
@@ -0,0 +1 @@
+"ok"
diff --git a/testsuite/tests/deSugar/should_run/all.T b/testsuite/tests/deSugar/should_run/all.T
index 352a65239eac..233f6485d9c9 100644
--- a/testsuite/tests/deSugar/should_run/all.T
+++ b/testsuite/tests/deSugar/should_run/all.T
@@ -40,3 +40,4 @@ test('mc08', normal, compile_and_run, [''])
 test('T5742', normal, compile_and_run, [''])
 test('DsLambdaCase', when(compiler_lt('ghc', '7.5'), skip), compile_and_run, [''])
 test('DsMultiWayIf', when(compiler_lt('ghc', '7.5'), skip), compile_and_run, [''])
+test('T8952', normal, compile_and_run, [''])
diff --git a/testsuite/tests/deriving/should_compile/T4966.hs b/testsuite/tests/deriving/should_compile/T4966.hs
index d7328c6ef62e..363627a415d9 100644
--- a/testsuite/tests/deriving/should_compile/T4966.hs
+++ b/testsuite/tests/deriving/should_compile/T4966.hs
@@ -2,7 +2,6 @@
 {-# LANGUAGE EmptyDataDecls #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE UndecidableInstances #-}
-{-# LANGUAGE OverlappingInstances #-}
 
 module HTk.Toolkit.TreeList (getObjectFromTreeList) where
 
@@ -10,7 +9,7 @@ class Eq c => CItem c
 
 -- A bizarre instance decl!
 -- People who use instance decls like this are asking for trouble
-instance GUIObject w => Eq w where
+instance {-# OVERLAPPABLE #-} GUIObject w => Eq w where
   w1 == w2 = toGUIObject w1 == toGUIObject w2
 
 data StateEntry a 
@@ -31,7 +30,7 @@ getObjectFromTreeList state = state == state
 
 data CItem a => TreeListObject a
 
-instance CItem a => Eq (TreeListObject a)
+instance {-# OVERLAPPING #-} CItem a => Eq (TreeListObject a)
 
 class GUIObject w where
   toGUIObject     :: w -> GUIOBJECT
diff --git a/testsuite/tests/deriving/should_compile/T4966.stderr b/testsuite/tests/deriving/should_compile/T4966.stderr
index f2e1d836dc1b..dceeaa698f86 100644
--- a/testsuite/tests/deriving/should_compile/T4966.stderr
+++ b/testsuite/tests/deriving/should_compile/T4966.stderr
@@ -2,7 +2,7 @@
 T4966.hs:1:14: Warning:
     -XDatatypeContexts is deprecated: It was widely considered a misfeature, and has been removed from the Haskell language.
 
-T4966.hs:34:10: Warning:
+T4966.hs:33:30: Warning:
     No explicit implementation for
-      either ‛==’ or ‛/=’
-    In the instance declaration for ‛Eq (TreeListObject a)’
+      either ‘==’ or ‘/=’
+    In the instance declaration for ‘Eq (TreeListObject a)’
diff --git a/testsuite/tests/deriving/should_compile/T7269.hs b/testsuite/tests/deriving/should_compile/T7269.hs
new file mode 100644
index 000000000000..2d7331bebb7e
--- /dev/null
+++ b/testsuite/tests/deriving/should_compile/T7269.hs
@@ -0,0 +1,13 @@
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE MultiParamTypeClasses, StandaloneDeriving, GeneralizedNewtypeDeriving #-}
+
+module T7269 where
+
+class C (a :: k)
+
+instance C Int
+
+newtype MyInt = MyInt Int deriving C
+
+newtype YourInt = YourInt Int
+deriving instance C YourInt
diff --git a/testsuite/tests/deriving/should_compile/T8631.hs b/testsuite/tests/deriving/should_compile/T8631.hs
new file mode 100644
index 000000000000..41c70f9d866e
--- /dev/null
+++ b/testsuite/tests/deriving/should_compile/T8631.hs
@@ -0,0 +1,22 @@
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE RankNTypes #-}
+ 
+module T8631 where
+ 
+import Control.Monad.Trans.Cont
+import Control.Monad.Trans.State.Lazy
+ 
+newtype AnyContT m a = AnyContT { unAnyContT :: forall r . ContT r m a }
+ 
+class MonadAnyCont b m where
+  anyContToM :: (forall r . (a -> b r) -> b r) -> m a
+ 
+instance MonadAnyCont b (AnyContT m) where
+  anyContToM _ = error "foo"
+ 
+data DecodeState = DecodeState
+ 
+newtype DecodeAST a = DecodeAST { unDecodeAST :: AnyContT (StateT DecodeState IO) a }
+  deriving (MonadAnyCont IO)
\ No newline at end of file
diff --git a/testsuite/tests/deriving/should_compile/T8678.hs b/testsuite/tests/deriving/should_compile/T8678.hs
new file mode 100644
index 000000000000..655f530b5b37
--- /dev/null
+++ b/testsuite/tests/deriving/should_compile/T8678.hs
@@ -0,0 +1,12 @@
+{-# LANGUAGE DataKinds, DeriveFunctor, FlexibleInstances, GADTs, KindSignatures, StandaloneDeriving #-}
+module T8678 where
+
+data {- kind -} Nat = Z | S Nat
+
+-- GADT in parameter other than the last
+data NonStandard :: Nat -> * -> * -> * where
+    Standard :: a -> NonStandard (S n) a b
+    Non :: NonStandard n a b -> b -> NonStandard (S n) a b
+
+deriving instance (Show a, Show b) => Show (NonStandard n a b)
+deriving instance Functor (NonStandard n a)
diff --git a/testsuite/tests/deriving/should_compile/T8758.hs b/testsuite/tests/deriving/should_compile/T8758.hs
new file mode 100644
index 000000000000..86c54c4a1bf8
--- /dev/null
+++ b/testsuite/tests/deriving/should_compile/T8758.hs
@@ -0,0 +1,9 @@
+{-# LANGUAGE RankNTypes #-}
+
+module T8758 where
+
+class C m where
+  foo :: (forall b. b -> m b) -> c -> m c
+
+instance C [] where
+  foo f c = f c
\ No newline at end of file
diff --git a/testsuite/tests/deriving/should_compile/T8758a.hs b/testsuite/tests/deriving/should_compile/T8758a.hs
new file mode 100644
index 000000000000..4b7fe44cf4e7
--- /dev/null
+++ b/testsuite/tests/deriving/should_compile/T8758a.hs
@@ -0,0 +1,8 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
+module T8758a where
+
+import T8758
+
+newtype MyList a = Mk [a]
+  deriving C
\ No newline at end of file
diff --git a/testsuite/tests/deriving/should_compile/T8865.hs b/testsuite/tests/deriving/should_compile/T8865.hs
new file mode 100644
index 000000000000..ec6c26a22a00
--- /dev/null
+++ b/testsuite/tests/deriving/should_compile/T8865.hs
@@ -0,0 +1,11 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
+module T8865 where
+import Control.Category
+
+instance Category Either where
+  id  = error "urk1"
+  (.) = error "urk2"
+
+newtype T a b = MkT (Either a b) deriving( Category )
+
diff --git a/testsuite/tests/deriving/should_compile/T8893.hs b/testsuite/tests/deriving/should_compile/T8893.hs
new file mode 100644
index 000000000000..2ebcc94624a6
--- /dev/null
+++ b/testsuite/tests/deriving/should_compile/T8893.hs
@@ -0,0 +1,11 @@
+{-# OPTIONS_GHC -Wall #-}
+{-# Language DeriveFunctor #-}
+{-# Language PolyKinds #-}
+
+module T8893 where
+
+data V a = V [a] deriving Functor
+
+data C x a = C (V (P x a)) deriving Functor
+
+data P x a = P (x a) deriving Functor
diff --git a/testsuite/tests/deriving/should_compile/T8950.hs b/testsuite/tests/deriving/should_compile/T8950.hs
new file mode 100644
index 000000000000..b913b27aa88f
--- /dev/null
+++ b/testsuite/tests/deriving/should_compile/T8950.hs
@@ -0,0 +1,18 @@
+{-# LANGUAGE AutoDeriveTypeable, DataKinds, StandaloneDeriving #-}
+
+module T8950 where
+
+import Data.Typeable
+
+data Foo = Bar
+  deriving (Eq)
+
+data Baz = Quux
+
+deriving instance Typeable Baz  -- shouldn't error
+deriving instance Typeable Quux
+
+rep1 = typeRep (Proxy :: Proxy Bool)
+rep2 = typeRep (Proxy :: Proxy 'True)
+rep3 = typeRep (Proxy :: Proxy Foo)
+rep4 = typeRep (Proxy :: Proxy Bar)
diff --git a/testsuite/tests/deriving/should_compile/T8963.hs b/testsuite/tests/deriving/should_compile/T8963.hs
new file mode 100644
index 000000000000..78dcf469e818
--- /dev/null
+++ b/testsuite/tests/deriving/should_compile/T8963.hs
@@ -0,0 +1,9 @@
+{-# LANGUAGE TypeFamilies, GeneralizedNewtypeDeriving #-}
+
+module T8963 where
+
+class C c where
+   data F c r
+
+instance C Int where
+   newtype F Int r = F (IO r) deriving (Functor)
diff --git a/testsuite/tests/deriving/should_compile/T9069.hs b/testsuite/tests/deriving/should_compile/T9069.hs
new file mode 100644
index 000000000000..7ab3af348952
--- /dev/null
+++ b/testsuite/tests/deriving/should_compile/T9069.hs
@@ -0,0 +1,9 @@
+{-# LANGUAGE DeriveTraversable #-}
+
+module T9069 where
+
+import Data.Foldable
+import Data.Traversable
+
+data Trivial a = Trivial a
+   deriving (Functor,Foldable,Traversable)
\ No newline at end of file
diff --git a/testsuite/tests/deriving/should_compile/T9359.hs b/testsuite/tests/deriving/should_compile/T9359.hs
new file mode 100644
index 000000000000..313d66e1ca80
--- /dev/null
+++ b/testsuite/tests/deriving/should_compile/T9359.hs
@@ -0,0 +1,12 @@
+{-# Language GADTs, PolyKinds, TypeFamilies, DataKinds #-}
+module Fam where
+
+data Cmp a where
+ Sup ::      Cmp a
+ V   :: a -> Cmp a
+ deriving (Show, Eq)
+
+data family   CmpInterval (a :: Cmp k) (b :: Cmp k) :: *
+data instance CmpInterval (V c)         Sup          = Starting c
+  deriving( Show )
+
diff --git a/testsuite/tests/deriving/should_compile/all.T b/testsuite/tests/deriving/should_compile/all.T
index 488c8e8f9063..af05006a8886 100644
--- a/testsuite/tests/deriving/should_compile/all.T
+++ b/testsuite/tests/deriving/should_compile/all.T
@@ -42,3 +42,13 @@ test('T7710', normal, compile, [''])
 test('AutoDeriveTypeable', normal, compile, [''])
 
 test('T8138', reqlib('primitive'), compile, ['-O2'])
+test('T8631', normal, compile, [''])
+test('T8758', extra_clean(['T8758a.o', 'T8758a.hi']), multimod_compile, ['T8758a', '-v0'])
+test('T8678', normal, compile, [''])
+test('T8865', normal, compile, [''])
+test('T8893', normal, compile, [''])
+test('T8950', expect_broken(8950), compile, [''])
+test('T8963', normal, compile, [''])
+test('T7269', normal, compile, [''])
+test('T9069', normal, compile, [''])
+test('T9359', normal, compile, [''])
diff --git a/testsuite/tests/deriving/should_compile/deriving-1935.stderr b/testsuite/tests/deriving/should_compile/deriving-1935.stderr
index 4772334b2045..bf2c79cb7abd 100644
--- a/testsuite/tests/deriving/should_compile/deriving-1935.stderr
+++ b/testsuite/tests/deriving/should_compile/deriving-1935.stderr
@@ -1,15 +1,15 @@
 
 deriving-1935.hs:15:11: Warning:
     No explicit implementation for
-      either ‛==’ or ‛/=’
-    In the instance declaration for ‛Eq (T a)’
+      either ‘==’ or ‘/=’
+    In the instance declaration for ‘Eq (T a)’
 
 deriving-1935.hs:18:11: Warning:
     No explicit implementation for
-      either ‛==’ or ‛/=’
-    In the instance declaration for ‛Eq (S a)’
+      either ‘==’ or ‘/=’
+    In the instance declaration for ‘Eq (S a)’
 
 deriving-1935.hs:19:11: Warning:
     No explicit implementation for
-      either ‛compare’ or ‛<=’
-    In the instance declaration for ‛Ord (S a)’
+      either ‘compare’ or ‘<=’
+    In the instance declaration for ‘Ord (S a)’
diff --git a/testsuite/tests/deriving/should_compile/drv003.stderr b/testsuite/tests/deriving/should_compile/drv003.stderr
index 7f58e681cb35..6d9819fee809 100644
--- a/testsuite/tests/deriving/should_compile/drv003.stderr
+++ b/testsuite/tests/deriving/should_compile/drv003.stderr
@@ -1,10 +1,10 @@
 
 drv003.hs:12:10: Warning:
     No explicit implementation for
-      either ‛==’ or ‛/=’
-    In the instance declaration for ‛Eq (Foo a)’
+      either ‘==’ or ‘/=’
+    In the instance declaration for ‘Eq (Foo a)’
 
 drv003.hs:15:10: Warning:
     No explicit implementation for
-      either ‛==’ or ‛/=’
-    In the instance declaration for ‛Eq (Bar b)’
+      either ‘==’ or ‘/=’
+    In the instance declaration for ‘Eq (Bar b)’
diff --git a/testsuite/tests/deriving/should_compile/drv012.hs b/testsuite/tests/deriving/should_compile/drv012.hs
index eb8f3847cd47..1d07a4ee9688 100644
--- a/testsuite/tests/deriving/should_compile/drv012.hs
+++ b/testsuite/tests/deriving/should_compile/drv012.hs
@@ -1,7 +1,7 @@
 {-# LANGUAGE GADTs #-}
 
 -- !!! deriving for GADTs which declare Haskell98 data types.
--- bug reported as http://hackage.haskell.org/trac/ghc/ticket/902
+-- bug reported as http://ghc.haskell.org/trac/ghc/ticket/902
 module ShouldSucceed where
 
 data Maybe1 a where {
diff --git a/testsuite/tests/deriving/should_compile/drv021.stderr b/testsuite/tests/deriving/should_compile/drv021.stderr
index 2071183c5366..e64989c1943b 100644
--- a/testsuite/tests/deriving/should_compile/drv021.stderr
+++ b/testsuite/tests/deriving/should_compile/drv021.stderr
@@ -1,13 +1,13 @@
 
 drv021.hs:9:1: Warning:
-    Module ‛Data.OldTypeable’ is deprecated: Use Data.Typeable instead
+    Module ‘Data.OldTypeable’ is deprecated: Use Data.Typeable instead
 
 drv021.hs:14:19: Warning:
-    In the use of type constructor or class ‛Typeable1’
+    In the use of type constructor or class ‘Typeable1’
     (imported from Data.OldTypeable, but defined in Data.OldTypeable.Internal):
     Deprecated: "Use Data.Typeable.Internal instead"
 
 drv021.hs:15:19: Warning:
-    In the use of type constructor or class ‛Typeable2’
+    In the use of type constructor or class ‘Typeable2’
     (imported from Data.OldTypeable, but defined in Data.OldTypeable.Internal):
     Deprecated: "Use Data.Typeable.Internal instead"
diff --git a/testsuite/tests/deriving/should_fail/T1133A.stderr b/testsuite/tests/deriving/should_fail/T1133A.stderr
index a17e68430965..23b93409dafb 100644
--- a/testsuite/tests/deriving/should_fail/T1133A.stderr
+++ b/testsuite/tests/deriving/should_fail/T1133A.stderr
@@ -1,7 +1,7 @@
 
 T1133A.hs:6:28:
-    Can't make a derived instance of ‛Enum X’:
-      ‛X’ must be an enumeration type
+    Can't make a derived instance of ‘Enum X’:
+      ‘X’ must be an enumeration type
       (an enumeration consists of one or more nullary, non-GADT constructors)
       Try GeneralizedNewtypeDeriving for GHC's newtype-deriving extension
-    In the newtype declaration for ‛X’
+    In the newtype declaration for ‘X’
diff --git a/testsuite/tests/deriving/should_fail/T1496.stderr b/testsuite/tests/deriving/should_fail/T1496.stderr
index a18d3926e761..867d6c684291 100644
--- a/testsuite/tests/deriving/should_fail/T1496.stderr
+++ b/testsuite/tests/deriving/should_fail/T1496.stderr
@@ -1,10 +1,10 @@
 
 T1496.hs:10:32:
-    Could not coerce from ‛c Int’ to ‛c Moo’
-      because ‛c Int’ and ‛c Moo’ are different types.
-      arising from the coercion of the method ‛isInt’ from type
-                   ‛forall (c :: * -> *). c Int -> c Int’ to type
-                   ‛forall (c :: * -> *). c Int -> c Moo’
+    Could not coerce from ‘c Int’ to ‘c Moo’
+      because ‘c Int’ and ‘c Moo’ are different types.
+      arising from the coercion of the method ‘isInt’ from type
+                   ‘forall (c :: * -> *). c Int -> c Int’ to type
+                   ‘forall (c :: * -> *). c Int -> c Moo’
     Possible fix:
       use a standalone 'deriving instance' declaration,
         so you can specify the instance context yourself
diff --git a/testsuite/tests/deriving/should_fail/T2394.stderr b/testsuite/tests/deriving/should_fail/T2394.stderr
index f8ccbda848f0..93093658b197 100644
--- a/testsuite/tests/deriving/should_fail/T2394.stderr
+++ b/testsuite/tests/deriving/should_fail/T2394.stderr
@@ -1,6 +1,6 @@
 
 T2394.hs:9:1:
-    Can't make a derived instance of ‛Data (a -> b)’:
+    Can't make a derived instance of ‘Data (a -> b)’:
       The last argument of the instance must be a data or newtype application
     In the stand-alone deriving instance for
-      ‛(Data a, Data b) => Data (a -> b)’
+      ‘(Data a, Data b) => Data (a -> b)’
diff --git a/testsuite/tests/deriving/should_fail/T2604.stderr b/testsuite/tests/deriving/should_fail/T2604.stderr
index 00262888da44..3000b5002f4d 100644
--- a/testsuite/tests/deriving/should_fail/T2604.stderr
+++ b/testsuite/tests/deriving/should_fail/T2604.stderr
@@ -1,10 +1,10 @@
 
 T2604.hs:7:35:
-    Can't make a derived instance of ‛Typeable DList’:
-      You need DeriveDataTypeable to derive an instance for this class
-    In the data declaration for ‛DList’
+    Can't make a Typeable instance of ‘DList’
+      You need DeriveDataTypeable to derive Typeable instances
+    In the data declaration for ‘DList’
 
 T2604.hs:9:38:
-    Can't make a derived instance of ‛Typeable NList’:
-      You need DeriveDataTypeable to derive an instance for this class
-    In the newtype declaration for ‛NList’
+    Can't make a Typeable instance of ‘NList’
+      You need DeriveDataTypeable to derive Typeable instances
+    In the newtype declaration for ‘NList’
diff --git a/testsuite/tests/deriving/should_fail/T2701.stderr b/testsuite/tests/deriving/should_fail/T2701.stderr
index 722c0c12bf34..ded9a099110c 100644
--- a/testsuite/tests/deriving/should_fail/T2701.stderr
+++ b/testsuite/tests/deriving/should_fail/T2701.stderr
@@ -1,5 +1,5 @@
 
 T2701.hs:10:32:
-    Can't make a derived instance of ‛Data Foo’:
-      Don't know how to derive ‛Data’ for type ‛Int#’
-    In the data declaration for ‛Foo’
+    Can't make a derived instance of ‘Data Foo’:
+      Don't know how to derive ‘Data’ for type ‘Int#’
+    In the data declaration for ‘Foo’
diff --git a/testsuite/tests/deriving/should_fail/T2721.stderr b/testsuite/tests/deriving/should_fail/T2721.stderr
index 64e93c3d1233..908db94dbe5c 100644
--- a/testsuite/tests/deriving/should_fail/T2721.stderr
+++ b/testsuite/tests/deriving/should_fail/T2721.stderr
@@ -1,6 +1,6 @@
 
 T2721.hs:15:28:
-    Can't make a derived instance of ‛C N’
+    Can't make a derived instance of ‘C N’
       (even with cunning newtype deriving):
       the class has associated types
-    In the newtype declaration for ‛N’
+    In the newtype declaration for ‘N’
diff --git a/testsuite/tests/deriving/should_fail/T2851.stderr b/testsuite/tests/deriving/should_fail/T2851.stderr
index c7a3bf59aa56..780e16cbb745 100644
--- a/testsuite/tests/deriving/should_fail/T2851.stderr
+++ b/testsuite/tests/deriving/should_fail/T2851.stderr
@@ -1,7 +1,7 @@
 
 T2851.hs:9:15:
     No instance for (Show (F a))
-      arising from the first field of ‛D’ (type ‛F a’)
+      arising from the first field of ‘D’ (type ‘F a’)
     Possible fix:
       use a standalone 'deriving instance' declaration,
         so you can specify the instance context yourself
diff --git a/testsuite/tests/deriving/should_fail/T3101.stderr b/testsuite/tests/deriving/should_fail/T3101.stderr
index b07e2570afb6..7c976178c4ed 100644
--- a/testsuite/tests/deriving/should_fail/T3101.stderr
+++ b/testsuite/tests/deriving/should_fail/T3101.stderr
@@ -1,6 +1,6 @@
 
 T3101.hs:9:12:
-    Can't make a derived instance of ‛Show Boom’:
-      Constructor ‛Boom’ must have a Haskell-98 type
+    Can't make a derived instance of ‘Show Boom’:
+      Constructor ‘Boom’ has a higher-rank type
       Possible fix: use a standalone deriving declaration instead
-    In the data declaration for ‛Boom’
+    In the data declaration for ‘Boom’
diff --git a/testsuite/tests/deriving/should_fail/T3833.stderr b/testsuite/tests/deriving/should_fail/T3833.stderr
index 3bfb85705c46..4c6bf564eaee 100644
--- a/testsuite/tests/deriving/should_fail/T3833.stderr
+++ b/testsuite/tests/deriving/should_fail/T3833.stderr
@@ -1,6 +1,6 @@
 
 T3833.hs:9:1:
-    Can't make a derived instance of ‛Monoid (DecodeMap e)’:
-      ‛Monoid’ is not a derivable class
+    Can't make a derived instance of ‘Monoid (DecodeMap e)’:
+      ‘Monoid’ is not a derivable class
       Try GeneralizedNewtypeDeriving for GHC's newtype-deriving extension
-    In the stand-alone deriving instance for ‛Monoid (DecodeMap e)’
+    In the stand-alone deriving instance for ‘Monoid (DecodeMap e)’
diff --git a/testsuite/tests/deriving/should_fail/T3834.stderr b/testsuite/tests/deriving/should_fail/T3834.stderr
index ddd67b207447..d732124454cb 100644
--- a/testsuite/tests/deriving/should_fail/T3834.stderr
+++ b/testsuite/tests/deriving/should_fail/T3834.stderr
@@ -1,6 +1,6 @@
 
 T3834.hs:8:1:
-    Can't make a derived instance of ‛C T’:
-      ‛C’ is not a derivable class
+    Can't make a derived instance of ‘C T’:
+      ‘C’ is not a derivable class
       Try GeneralizedNewtypeDeriving for GHC's newtype-deriving extension
-    In the stand-alone deriving instance for ‛C T’
+    In the stand-alone deriving instance for ‘C T’
diff --git a/testsuite/tests/deriving/should_fail/T4528.stderr b/testsuite/tests/deriving/should_fail/T4528.stderr
index 174623915832..0b50737300f9 100644
--- a/testsuite/tests/deriving/should_fail/T4528.stderr
+++ b/testsuite/tests/deriving/should_fail/T4528.stderr
@@ -1,14 +1,14 @@
 
 T4528.hs:9:1:
-    Can't make a derived instance of ‛Enum (Foo a)’:
-      ‛Foo’ must be an enumeration type
+    Can't make a derived instance of ‘Enum (Foo a)’:
+      ‘Foo’ must be an enumeration type
       (an enumeration consists of one or more nullary, non-GADT constructors)
-    In the stand-alone deriving instance for ‛Enum (Foo a)’
+    In the stand-alone deriving instance for ‘Enum (Foo a)’
 
 T4528.hs:10:1:
-    Can't make a derived instance of ‛Bounded (Foo a)’:
-      ‛Foo’ must be an enumeration type
+    Can't make a derived instance of ‘Bounded (Foo a)’:
+      ‘Foo’ must be an enumeration type
       (an enumeration consists of one or more nullary, non-GADT constructors)
         or
-      ‛Foo’ must have precisely one constructor
-    In the stand-alone deriving instance for ‛Bounded (Foo a)’
+      ‘Foo’ must have precisely one constructor
+    In the stand-alone deriving instance for ‘Bounded (Foo a)’
diff --git a/testsuite/tests/deriving/should_fail/T4846.stderr b/testsuite/tests/deriving/should_fail/T4846.stderr
index dde64de90f9f..6024165c254b 100644
--- a/testsuite/tests/deriving/should_fail/T4846.stderr
+++ b/testsuite/tests/deriving/should_fail/T4846.stderr
@@ -1,14 +1,14 @@
 
 T4846.hs:29:1:
-    Could not coerce from ‛Expr Bool’ to ‛Expr BOOL’
-      because the first type argument of ‛Expr’ has role Nominal,
-      but the arguments ‛Bool’ and ‛BOOL’ differ
-      arising from a use of ‛GHC.Prim.coerce’
+    Could not coerce from ‘Expr Bool’ to ‘Expr BOOL’
+      because the first type argument of ‘Expr’ has role Nominal,
+      but the arguments ‘Bool’ and ‘BOOL’ differ
+      arising from a use of ‘GHC.Prim.coerce’
     In the expression:
         GHC.Prim.coerce (mkExpr :: Expr Bool) :: Expr BOOL
-    In an equation for ‛mkExpr’:
+    In an equation for ‘mkExpr’:
         mkExpr = GHC.Prim.coerce (mkExpr :: Expr Bool) :: Expr BOOL
-    When typechecking the code for  ‛mkExpr’
-      in a standalone derived instance for ‛B BOOL’:
+    When typechecking the code for  ‘mkExpr’
+      in a standalone derived instance for ‘B BOOL’:
       To see the code I am typechecking, use -ddump-deriv
-    In the instance declaration for ‛B BOOL’
+    In the instance declaration for ‘B BOOL’
diff --git a/testsuite/tests/deriving/should_fail/T5287.stderr b/testsuite/tests/deriving/should_fail/T5287.stderr
index 2ad7ea09532e..764c422dd1a4 100644
--- a/testsuite/tests/deriving/should_fail/T5287.stderr
+++ b/testsuite/tests/deriving/should_fail/T5287.stderr
@@ -5,7 +5,7 @@ T5287.hs:6:10:
     from the context (A a oops)
       bound by an instance declaration: A a oops => Read (D a)
       at T5287.hs:6:10-31
-    The type variable ‛oops0’ is ambiguous
+    The type variable ‘oops0’ is ambiguous
     In the ambiguity check for: forall a oops. A a oops => Read (D a)
     To defer the ambiguity check to use sites, enable AllowAmbiguousTypes
-    In the instance declaration for ‛Read (D a)’
+    In the instance declaration for ‘Read (D a)’
diff --git a/testsuite/tests/deriving/should_fail/T5478.stderr b/testsuite/tests/deriving/should_fail/T5478.stderr
index e3c968f62f21..6c194a379394 100644
--- a/testsuite/tests/deriving/should_fail/T5478.stderr
+++ b/testsuite/tests/deriving/should_fail/T5478.stderr
@@ -1,5 +1,5 @@
 
 T5478.hs:6:38:
-    Can't make a derived instance of ‛Show Foo’:
-      Don't know how to derive ‛Show’ for type ‛ByteArray#’
-    In the data declaration for ‛Foo’
+    Can't make a derived instance of ‘Show Foo’:
+      Don't know how to derive ‘Show’ for type ‘ByteArray#’
+    In the data declaration for ‘Foo’
diff --git a/testsuite/tests/deriving/should_fail/T5498.stderr b/testsuite/tests/deriving/should_fail/T5498.stderr
index 8adde63a98c4..b613eae36899 100644
--- a/testsuite/tests/deriving/should_fail/T5498.stderr
+++ b/testsuite/tests/deriving/should_fail/T5498.stderr
@@ -1,10 +1,10 @@
 
 T5498.hs:30:39:
-    Could not coerce from ‛c a’ to ‛c (Down a)’
-      because ‛c a’ and ‛c (Down a)’ are different types.
-      arising from the coercion of the method ‛intIso’ from type
-                   ‛forall (c :: * -> *). c a -> c Int’ to type
-                   ‛forall (c :: * -> *). c (Down a) -> c Int’
+    Could not coerce from ‘c a’ to ‘c (Down a)’
+      because ‘c a’ and ‘c (Down a)’ are different types.
+      arising from the coercion of the method ‘intIso’ from type
+                   ‘forall (c :: * -> *). c a -> c Int’ to type
+                   ‘forall (c :: * -> *). c (Down a) -> c Int’
     Possible fix:
       use a standalone 'deriving instance' declaration,
         so you can specify the instance context yourself
diff --git a/testsuite/tests/deriving/should_fail/T5686.stderr b/testsuite/tests/deriving/should_fail/T5686.stderr
index 0bffdf56976b..74f8dd88c7de 100644
--- a/testsuite/tests/deriving/should_fail/T5686.stderr
+++ b/testsuite/tests/deriving/should_fail/T5686.stderr
@@ -1,5 +1,5 @@
 
 T5686.hs:4:29:
-    Can't make a derived instance of ‛Functor U’:
-      Constructor ‛U’ must use the type variable only as the last argument of a data type
-    In the data declaration for ‛U’
+    Can't make a derived instance of ‘Functor U’:
+      Constructor ‘U’ must use the type variable only as the last argument of a data type
+    In the data declaration for ‘U’
diff --git a/testsuite/tests/deriving/should_fail/T5863a.stderr b/testsuite/tests/deriving/should_fail/T5863a.stderr
index 434ed42eb855..d64f1b20ceb8 100644
--- a/testsuite/tests/deriving/should_fail/T5863a.stderr
+++ b/testsuite/tests/deriving/should_fail/T5863a.stderr
@@ -1,10 +1,10 @@
 
 T5863a.hs:9:31:
-    Cannot eta-reduce to an instance of form
-      instance (...) => Typeable T
-    In the data instance declaration for ‛T’
+    Deriving Typeable is not allowed for family instances;
+    derive Typeable for ‘T’ alone
+    In the data instance declaration for ‘T’
 
 T5863a.hs:12:32:
-    Cannot eta-reduce to an instance of form
-      instance (...) => Typeable T
-    In the data instance declaration for ‛T’
+    Deriving Typeable is not allowed for family instances;
+    derive Typeable for ‘T’ alone
+    In the data instance declaration for ‘T’
diff --git a/testsuite/tests/deriving/should_fail/T5922.stderr b/testsuite/tests/deriving/should_fail/T5922.stderr
index 1b58511d95ce..c879b7ecfa99 100644
--- a/testsuite/tests/deriving/should_fail/T5922.stderr
+++ b/testsuite/tests/deriving/should_fail/T5922.stderr
@@ -1,4 +1,4 @@
 
 T5922.hs:3:42:
-    Illegal deriving item ‛show’
-    In the data declaration for ‛Proposition’
+    Illegal deriving item ‘show’
+    In the data declaration for ‘Proposition’
diff --git a/testsuite/tests/deriving/should_fail/T6147.hs b/testsuite/tests/deriving/should_fail/T6147.hs
new file mode 100644
index 000000000000..f57f5af4de0e
--- /dev/null
+++ b/testsuite/tests/deriving/should_fail/T6147.hs
@@ -0,0 +1,13 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving, TypeFamilies #-}
+module T6147 where
+
+data family T a
+data instance T Int = T_Int Int
+
+class C a where
+  foo :: a -> T a
+
+instance C Int where
+  foo = T_Int
+
+newtype Foo = Foo Int deriving(C)
diff --git a/testsuite/tests/deriving/should_fail/T6147.stderr b/testsuite/tests/deriving/should_fail/T6147.stderr
new file mode 100644
index 000000000000..a346ac3216d6
--- /dev/null
+++ b/testsuite/tests/deriving/should_fail/T6147.stderr
@@ -0,0 +1,11 @@
+
+T6147.hs:13:32:
+    Could not coerce from ‘T Int’ to ‘T Foo’
+      because the first type argument of ‘T’ has role Nominal,
+      but the arguments ‘Int’ and ‘Foo’ differ
+      arising from the coercion of the method ‘foo’ from type
+                   ‘Int -> T Int’ to type ‘Foo -> T Foo’
+    Possible fix:
+      use a standalone 'deriving instance' declaration,
+        so you can specify the instance context yourself
+    When deriving the instance for (C Foo)
diff --git a/testsuite/tests/deriving/should_fail/T7148.stderr b/testsuite/tests/deriving/should_fail/T7148.stderr
index 21e350c3fcd1..9b1008a3600e 100644
--- a/testsuite/tests/deriving/should_fail/T7148.stderr
+++ b/testsuite/tests/deriving/should_fail/T7148.stderr
@@ -1,23 +1,23 @@
 
 T7148.hs:27:40:
-    Could not coerce from ‛SameType b1 b’ to ‛SameType b1 (Tagged a b)’
-      because the second type argument of ‛SameType’ has role Nominal,
-      but the arguments ‛b’ and ‛Tagged a b’ differ
-      arising from the coercion of the method ‛iso2’ from type
-                   ‛forall b. SameType b () -> SameType b b’ to type
-                   ‛forall b. SameType b () -> SameType b (Tagged a b)’
+    Could not coerce from ‘SameType b1 b’ to ‘SameType b1 (Tagged a b)’
+      because the second type argument of ‘SameType’ has role Nominal,
+      but the arguments ‘b’ and ‘Tagged a b’ differ
+      arising from the coercion of the method ‘iso2’ from type
+                   ‘forall b. SameType b () -> SameType b b’ to type
+                   ‘forall b. SameType b () -> SameType b (Tagged a b)’
     Possible fix:
       use a standalone 'deriving instance' declaration,
         so you can specify the instance context yourself
     When deriving the instance for (IsoUnit (Tagged a b))
 
 T7148.hs:27:40:
-    Could not coerce from ‛SameType b b1’ to ‛SameType (Tagged a b) b1’
-      because the first type argument of ‛SameType’ has role Nominal,
-      but the arguments ‛b’ and ‛Tagged a b’ differ
-      arising from the coercion of the method ‛iso1’ from type
-                   ‛forall b. SameType () b -> SameType b b’ to type
-                   ‛forall b. SameType () b -> SameType (Tagged a b) b’
+    Could not coerce from ‘SameType b b1’ to ‘SameType (Tagged a b) b1’
+      because the first type argument of ‘SameType’ has role Nominal,
+      but the arguments ‘b’ and ‘Tagged a b’ differ
+      arising from the coercion of the method ‘iso1’ from type
+                   ‘forall b. SameType () b -> SameType b b’ to type
+                   ‘forall b. SameType () b -> SameType (Tagged a b) b’
     Possible fix:
       use a standalone 'deriving instance' declaration,
         so you can specify the instance context yourself
diff --git a/testsuite/tests/deriving/should_fail/T7148a.stderr b/testsuite/tests/deriving/should_fail/T7148a.stderr
index 1984eb9c6c08..5f865d1f5c0b 100644
--- a/testsuite/tests/deriving/should_fail/T7148a.stderr
+++ b/testsuite/tests/deriving/should_fail/T7148a.stderr
@@ -1,10 +1,10 @@
 
 T7148a.hs:19:50:
-    Could not coerce from ‛Result a b’ to ‛b’
-      because ‛Result a b’ and ‛b’ are different types.
-      arising from the coercion of the method ‛coerce’ from type
-                   ‛forall b. Proxy b -> a -> Result a b’ to type
-                   ‛forall b. Proxy b -> IS_NO_LONGER a -> Result (IS_NO_LONGER a) b’
+    Could not coerce from ‘Result a b’ to ‘b’
+      because ‘Result a b’ and ‘b’ are different types.
+      arising from the coercion of the method ‘coerce’ from type
+                   ‘forall b. Proxy b -> a -> Result a b’ to type
+                   ‘forall b. Proxy b -> IS_NO_LONGER a -> Result (IS_NO_LONGER a) b’
     Possible fix:
       use a standalone 'deriving instance' declaration,
         so you can specify the instance context yourself
diff --git a/testsuite/tests/deriving/should_fail/T7800.stderr b/testsuite/tests/deriving/should_fail/T7800.stderr
index 10c790a6dabe..8cd853396875 100644
--- a/testsuite/tests/deriving/should_fail/T7800.stderr
+++ b/testsuite/tests/deriving/should_fail/T7800.stderr
@@ -2,5 +2,5 @@
 [2 of 2] Compiling T7800            ( T7800.hs, T7800.o )
 
 T7800.hs:7:1:
-    To make a Typeable instance of poly-kinded ‛A’, use XPolyKinds
-    In the stand-alone deriving instance for ‛Typeable A’
+    To make a Typeable instance of poly-kinded ‘A’, use XPolyKinds
+    In the stand-alone deriving instance for ‘Typeable A’
diff --git a/testsuite/tests/deriving/should_fail/T7959.hs b/testsuite/tests/deriving/should_fail/T7959.hs
index a798bb06664c..000e759be501 100644
--- a/testsuite/tests/deriving/should_fail/T7959.hs
+++ b/testsuite/tests/deriving/should_fail/T7959.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE NullaryTypeClasses, StandaloneDeriving #-}
+{-# LANGUAGE MultiParamTypeClasses, StandaloneDeriving #-}
 module T7959 where
 
 class A
diff --git a/testsuite/tests/deriving/should_fail/T7959.stderr b/testsuite/tests/deriving/should_fail/T7959.stderr
index 0e805a6b5555..5ca93a7fe325 100644
--- a/testsuite/tests/deriving/should_fail/T7959.stderr
+++ b/testsuite/tests/deriving/should_fail/T7959.stderr
@@ -1,8 +1,8 @@
 
 T7959.hs:5:1:
     Cannot derive instances for nullary classes
-    In the stand-alone deriving instance for ‛A’
+    In the stand-alone deriving instance for ‘A’
 
 T7959.hs:6:17:
-    Cannot derive instances for nullary classes
-    In the data declaration for ‛B’
+    Expected kind ‘k0 -> Constraint’, but ‘A’ has kind ‘Constraint’
+    In the data declaration for ‘B’
diff --git a/testsuite/tests/deriving/should_fail/T8851.hs b/testsuite/tests/deriving/should_fail/T8851.hs
new file mode 100644
index 000000000000..84f0ad4ac1ed
--- /dev/null
+++ b/testsuite/tests/deriving/should_fail/T8851.hs
@@ -0,0 +1,24 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
+module T8851 where
+
+import Control.Applicative
+
+class Parsing m where
+  notFollowedBy :: (Monad m, Show a) => m a -> m ()
+
+data Parser a
+instance Parsing Parser where
+  notFollowedBy = undefined
+
+instance Functor Parser where
+  fmap = undefined
+instance Applicative Parser where
+  pure = undefined
+  (<*>) = undefined
+instance Monad Parser where
+  return = undefined
+  (>>=) = undefined
+
+newtype MyParser a = MkMP (Parser a)
+  deriving Parsing
\ No newline at end of file
diff --git a/testsuite/tests/deriving/should_fail/T8851.stderr b/testsuite/tests/deriving/should_fail/T8851.stderr
new file mode 100644
index 000000000000..348f1f17141b
--- /dev/null
+++ b/testsuite/tests/deriving/should_fail/T8851.stderr
@@ -0,0 +1,12 @@
+
+T8851.hs:24:12:
+    Could not coerce from ‘Monad Parser’ to ‘Monad MyParser’
+      because the first type argument of ‘Monad’ has role Nominal,
+      but the arguments ‘Parser’ and ‘MyParser’ differ
+      arising from the coercion of the method ‘notFollowedBy’ from type
+                   ‘forall a. (Monad Parser, Show a) => Parser a -> Parser ()’ to type
+                   ‘forall a. (Monad MyParser, Show a) => MyParser a -> MyParser ()’
+    Possible fix:
+      use a standalone 'deriving instance' declaration,
+        so you can specify the instance context yourself
+    When deriving the instance for (Parsing MyParser)
diff --git a/testsuite/tests/deriving/should_fail/T9071-2.hs b/testsuite/tests/deriving/should_fail/T9071-2.hs
new file mode 100644
index 000000000000..7a2f4749ce86
--- /dev/null
+++ b/testsuite/tests/deriving/should_fail/T9071-2.hs
@@ -0,0 +1,7 @@
+{-# LANGUAGE DeriveFunctor #-}
+module T9071_2 where
+
+newtype Mu f = Mu (f (Mu f))
+
+newtype K1 a b = K1 a
+newtype F1 a = F1 (Mu (K1 a)) deriving Functor
diff --git a/testsuite/tests/deriving/should_fail/T9071.hs b/testsuite/tests/deriving/should_fail/T9071.hs
new file mode 100644
index 000000000000..dc64f42db846
--- /dev/null
+++ b/testsuite/tests/deriving/should_fail/T9071.hs
@@ -0,0 +1,8 @@
+{-# LANGUAGE DeriveFunctor #-}
+module T9071 where
+
+import T9071a
+
+newtype K a b = K a
+newtype F a = F (Mu (K a)) deriving Functor
+
diff --git a/testsuite/tests/deriving/should_fail/T9071.stderr b/testsuite/tests/deriving/should_fail/T9071.stderr
new file mode 100644
index 000000000000..259adbaef0cc
--- /dev/null
+++ b/testsuite/tests/deriving/should_fail/T9071.stderr
@@ -0,0 +1,10 @@
+[1 of 2] Compiling T9071a           ( T9071a.hs, T9071a.o )
+[2 of 2] Compiling T9071            ( T9071.hs, T9071.o )
+
+T9071.hs:7:37:
+    No instance for (Functor K)
+      arising from the first field of ‘F’ (type ‘Mu (K a)’)
+    Possible fix:
+      use a standalone 'deriving instance' declaration,
+        so you can specify the instance context yourself
+    When deriving the instance for (Functor F)
diff --git a/testsuite/tests/deriving/should_fail/T9071_2.hs b/testsuite/tests/deriving/should_fail/T9071_2.hs
new file mode 100644
index 000000000000..7a2f4749ce86
--- /dev/null
+++ b/testsuite/tests/deriving/should_fail/T9071_2.hs
@@ -0,0 +1,7 @@
+{-# LANGUAGE DeriveFunctor #-}
+module T9071_2 where
+
+newtype Mu f = Mu (f (Mu f))
+
+newtype K1 a b = K1 a
+newtype F1 a = F1 (Mu (K1 a)) deriving Functor
diff --git a/testsuite/tests/deriving/should_fail/T9071_2.stderr b/testsuite/tests/deriving/should_fail/T9071_2.stderr
new file mode 100644
index 000000000000..ae0fcdb92820
--- /dev/null
+++ b/testsuite/tests/deriving/should_fail/T9071_2.stderr
@@ -0,0 +1,8 @@
+
+T9071_2.hs:7:40:
+    No instance for (Functor Mu)
+      arising from the first field of ‘F1’ (type ‘Mu (K1 a)’)
+    Possible fix:
+      use a standalone 'deriving instance' declaration,
+        so you can specify the instance context yourself
+    When deriving the instance for (Functor F1)
diff --git a/testsuite/tests/deriving/should_fail/T9071a.hs b/testsuite/tests/deriving/should_fail/T9071a.hs
new file mode 100644
index 000000000000..bf3a126a1901
--- /dev/null
+++ b/testsuite/tests/deriving/should_fail/T9071a.hs
@@ -0,0 +1,4 @@
+module T9071a where
+
+newtype Mu f = Mu (f (Mu f))
+
diff --git a/testsuite/tests/deriving/should_fail/all.T b/testsuite/tests/deriving/should_fail/all.T
index b2b99ff997a1..99da88a55bb0 100644
--- a/testsuite/tests/deriving/should_fail/all.T
+++ b/testsuite/tests/deriving/should_fail/all.T
@@ -48,3 +48,8 @@ test('T7148', normal, compile_fail, [''])
 test('T7148a', normal, compile_fail, [''])
 test('T7800', normal, multimod_compile_fail, ['T7800',''])
 test('T5498', normal, compile_fail, [''])
+test('T6147', normal, compile_fail, [''])
+test('T8851', normal, compile_fail, [''])
+test('T9071', normal, multimod_compile_fail, ['T9071',''])
+test('T9071_2', normal, compile_fail, [''])
+
diff --git a/testsuite/tests/deriving/should_fail/drvfail-foldable-traversable1.stderr b/testsuite/tests/deriving/should_fail/drvfail-foldable-traversable1.stderr
index e4c07b5220fd..aa115cd10e1a 100644
--- a/testsuite/tests/deriving/should_fail/drvfail-foldable-traversable1.stderr
+++ b/testsuite/tests/deriving/should_fail/drvfail-foldable-traversable1.stderr
@@ -16,11 +16,11 @@ drvfail-foldable-traversable1.hs:13:22:
     When deriving the instance for (Traversable Trivial2)
 
 drvfail-foldable-traversable1.hs:17:22:
-    Can't make a derived instance of ‛Foldable Infinite’:
-      Constructor ‛Infinite’ must not contain function types
-    In the data declaration for ‛Infinite’
+    Can't make a derived instance of ‘Foldable Infinite’:
+      Constructor ‘Infinite’ must not contain function types
+    In the data declaration for ‘Infinite’
 
 drvfail-foldable-traversable1.hs:21:22:
-    Can't make a derived instance of ‛Traversable (Cont r)’:
-      Constructor ‛Cont’ must not contain function types
-    In the data declaration for ‛Cont’
+    Can't make a derived instance of ‘Traversable (Cont r)’:
+      Constructor ‘Cont’ must not contain function types
+    In the data declaration for ‘Cont’
diff --git a/testsuite/tests/deriving/should_fail/drvfail-functor1.stderr b/testsuite/tests/deriving/should_fail/drvfail-functor1.stderr
index 3b5b00c2b875..bff4d27a492e 100644
--- a/testsuite/tests/deriving/should_fail/drvfail-functor1.stderr
+++ b/testsuite/tests/deriving/should_fail/drvfail-functor1.stderr
@@ -1,5 +1,5 @@
 
 drvfail-functor1.hs:6:14:
-    Can't make a derived instance of ‛Functor List’:
+    Can't make a derived instance of ‘Functor List’:
       You need DeriveFunctor to derive an instance for this class
-    In the data declaration for ‛List’
+    In the data declaration for ‘List’
diff --git a/testsuite/tests/deriving/should_fail/drvfail-functor2.stderr b/testsuite/tests/deriving/should_fail/drvfail-functor2.stderr
index 322125cf4a6f..ab7812a3f793 100644
--- a/testsuite/tests/deriving/should_fail/drvfail-functor2.stderr
+++ b/testsuite/tests/deriving/should_fail/drvfail-functor2.stderr
@@ -3,28 +3,28 @@ drvfail-functor2.hs:1:29: Warning:
     -XDatatypeContexts is deprecated: It was widely considered a misfeature, and has been removed from the Haskell language.
 
 drvfail-functor2.hs:7:14:
-    Can't make a derived instance of ‛Functor InFunctionArgument’:
-      Constructor ‛InFunctionArgument’ must not use the type variable in a function argument
-    In the newtype declaration for ‛InFunctionArgument’
+    Can't make a derived instance of ‘Functor InFunctionArgument’:
+      Constructor ‘InFunctionArgument’ must not use the type variable in a function argument
+    In the newtype declaration for ‘InFunctionArgument’
 
 drvfail-functor2.hs:10:14:
-    Can't make a derived instance of ‛Functor OnSecondArg’:
-      Constructor ‛OnSecondArg’ must use the type variable only as the last argument of a data type
-    In the newtype declaration for ‛OnSecondArg’
+    Can't make a derived instance of ‘Functor OnSecondArg’:
+      Constructor ‘OnSecondArg’ must use the type variable only as the last argument of a data type
+    In the newtype declaration for ‘OnSecondArg’
 
 drvfail-functor2.hs:15:14:
-    Cannot derive well-kinded instance of form ‛Functor (NoArguments ...)’
-      Class ‛Functor’ expects an argument of kind ‛* -> *’
-    In the newtype declaration for ‛NoArguments’
+    Cannot derive well-kinded instance of form ‘Functor (NoArguments ...)’
+      Class ‘Functor’ expects an argument of kind ‘* -> *’
+    In the newtype declaration for ‘NoArguments’
 
 drvfail-functor2.hs:20:14:
-    Can't make a derived instance of ‛Functor StupidConstraint’:
-      Data type ‛StupidConstraint’ must not have a class context (Eq a)
-    In the data declaration for ‛StupidConstraint’
+    Can't make a derived instance of ‘Functor StupidConstraint’:
+      Data type ‘StupidConstraint’ must not have a class context (Eq a)
+    In the data declaration for ‘StupidConstraint’
 
 drvfail-functor2.hs:26:14:
     No instance for (Functor NoFunctor)
-      arising from the first field of ‛UseNoFunctor’ (type ‛NoFunctor a’)
+      arising from the first field of ‘UseNoFunctor’ (type ‘NoFunctor a’)
     Possible fix:
       use a standalone 'deriving instance' declaration,
         so you can specify the instance context yourself
diff --git a/testsuite/tests/deriving/should_fail/drvfail001.stderr b/testsuite/tests/deriving/should_fail/drvfail001.stderr
index 3f3d4ec63ca5..7f89e8c52bb8 100644
--- a/testsuite/tests/deriving/should_fail/drvfail001.stderr
+++ b/testsuite/tests/deriving/should_fail/drvfail001.stderr
@@ -1,7 +1,7 @@
 
 drvfail001.hs:16:33:
     No instance for (Show (f (f a)))
-      arising from the first field of ‛ZeroS’ (type ‛f (f a)’)
+      arising from the first field of ‘ZeroS’ (type ‘f (f a)’)
     Possible fix:
       use a standalone 'deriving instance' declaration,
         so you can specify the instance context yourself
diff --git a/testsuite/tests/deriving/should_fail/drvfail002.stderr b/testsuite/tests/deriving/should_fail/drvfail002.stderr
index 8064cb6f4059..9d8e42260140 100644
--- a/testsuite/tests/deriving/should_fail/drvfail002.stderr
+++ b/testsuite/tests/deriving/should_fail/drvfail002.stderr
@@ -1,7 +1,7 @@
 
 drvfail002.hs:19:23:
     No instance for (X T c)
-      arising from the first field of ‛S’ (type ‛T’)
+      arising from the first field of ‘S’ (type ‘T’)
     Possible fix:
       use a standalone 'deriving instance' declaration,
         so you can specify the instance context yourself
diff --git a/testsuite/tests/deriving/should_fail/drvfail003.stderr b/testsuite/tests/deriving/should_fail/drvfail003.stderr
index a2493f3f1ed3..6e06abf3b5c2 100644
--- a/testsuite/tests/deriving/should_fail/drvfail003.stderr
+++ b/testsuite/tests/deriving/should_fail/drvfail003.stderr
@@ -1,7 +1,7 @@
 
 drvfail003.hs:16:56:
     No instance for (Show (v (v a)))
-      arising from the first field of ‛End’ (type ‛v (v a)’)
+      arising from the first field of ‘End’ (type ‘v (v a)’)
     Possible fix:
       use a standalone 'deriving instance' declaration,
         so you can specify the instance context yourself
diff --git a/testsuite/tests/deriving/should_fail/drvfail005.stderr b/testsuite/tests/deriving/should_fail/drvfail005.stderr
index c77f904dc289..1546a37d0795 100644
--- a/testsuite/tests/deriving/should_fail/drvfail005.stderr
+++ b/testsuite/tests/deriving/should_fail/drvfail005.stderr
@@ -1,5 +1,5 @@
 
 drvfail005.hs:4:13:
-    Can't make a derived instance of ‛Show a (Test a)’:
-      ‛Show a’ is not a class
-    In the data declaration for ‛Test’
+    Expected kind ‘k0 -> Constraint’,
+      but ‘Show a’ has kind ‘Constraint’
+    In the data declaration for ‘Test’
diff --git a/testsuite/tests/deriving/should_fail/drvfail007.stderr b/testsuite/tests/deriving/should_fail/drvfail007.stderr
index c9d998e0434f..183a5ff8d55f 100644
--- a/testsuite/tests/deriving/should_fail/drvfail007.stderr
+++ b/testsuite/tests/deriving/should_fail/drvfail007.stderr
@@ -1,7 +1,7 @@
 
 drvfail007.hs:4:38:
     No instance for (Eq (Int -> Int))
-      arising from the first field of ‛Foo’ (type ‛Int -> Int’)
+      arising from the first field of ‘Foo’ (type ‘Int -> Int’)
     Possible fix:
       use a standalone 'deriving instance' declaration,
         so you can specify the instance context yourself
diff --git a/testsuite/tests/deriving/should_fail/drvfail009.stderr b/testsuite/tests/deriving/should_fail/drvfail009.stderr
index d9592c46691e..b9dd90c75876 100644
--- a/testsuite/tests/deriving/should_fail/drvfail009.stderr
+++ b/testsuite/tests/deriving/should_fail/drvfail009.stderr
@@ -1,23 +1,23 @@
 
 drvfail009.hs:10:31:
-    Can't make a derived instance of ‛C T1’
-      (even with cunning newtype deriving):
-      ‛C’ does not have arity 1
-    In the newtype declaration for ‛T1’
+    Expecting one more argument to ‘C’
+    Expected kind ‘* -> Constraint’,
+      but ‘C’ has kind ‘* -> * -> Constraint’
+    In the newtype declaration for ‘T1’
 
 drvfail009.hs:13:31:
-    Cannot derive well-kinded instance of form ‛Monad (T2 ...)’
-      Class ‛Monad’ expects an argument of kind ‛* -> *’
-    In the newtype declaration for ‛T2’
+    Cannot derive well-kinded instance of form ‘Monad (T2 ...)’
+      Class ‘Monad’ expects an argument of kind ‘* -> *’
+    In the newtype declaration for ‘T2’
 
 drvfail009.hs:16:33:
-    Can't make a derived instance of ‛Monad T3’
+    Can't make a derived instance of ‘Monad T3’
       (even with cunning newtype deriving):
       cannot eta-reduce the representation type enough
-    In the newtype declaration for ‛T3’
+    In the newtype declaration for ‘T3’
 
 drvfail009.hs:19:42:
-    Can't make a derived instance of ‛Monad T4’
+    Can't make a derived instance of ‘Monad T4’
       (even with cunning newtype deriving):
       cannot eta-reduce the representation type enough
-    In the newtype declaration for ‛T4’
+    In the newtype declaration for ‘T4’
diff --git a/testsuite/tests/deriving/should_fail/drvfail011.stderr b/testsuite/tests/deriving/should_fail/drvfail011.stderr
index f4b27e9d2172..99e62fc48e1a 100644
--- a/testsuite/tests/deriving/should_fail/drvfail011.stderr
+++ b/testsuite/tests/deriving/should_fail/drvfail011.stderr
@@ -1,10 +1,10 @@
 
 drvfail011.hs:8:1:
-    No instance for (Eq a) arising from a use of ‛==’
+    No instance for (Eq a) arising from a use of ‘==’
     Possible fix: add (Eq a) to the context of the instance declaration
     In the expression: ((a1 == b1))
-    In an equation for ‛==’: (==) (T1 a1) (T1 b1) = ((a1 == b1))
-    When typechecking the code for  ‛==’
-      in a standalone derived instance for ‛Eq (T a)’:
+    In an equation for ‘==’: (==) (T1 a1) (T1 b1) = ((a1 == b1))
+    When typechecking the code for  ‘==’
+      in a standalone derived instance for ‘Eq (T a)’:
       To see the code I am typechecking, use -ddump-deriv
-    In the instance declaration for ‛Eq (T a)’
+    In the instance declaration for ‘Eq (T a)’
diff --git a/testsuite/tests/deriving/should_fail/drvfail013.stderr b/testsuite/tests/deriving/should_fail/drvfail013.stderr
index 4b2350f2a052..abbe95892d5f 100644
--- a/testsuite/tests/deriving/should_fail/drvfail013.stderr
+++ b/testsuite/tests/deriving/should_fail/drvfail013.stderr
@@ -9,7 +9,7 @@ drvfail013.hs:4:70:
 
 drvfail013.hs:6:70:
     No instance for (Eq (m (Maybe a)))
-      arising from the first field of ‛MaybeT'’ (type ‛m (Maybe a)’)
+      arising from the first field of ‘MaybeT'’ (type ‘m (Maybe a)’)
     Possible fix:
       use a standalone 'deriving instance' declaration,
         so you can specify the instance context yourself
diff --git a/testsuite/tests/deriving/should_fail/drvfail014.stderr b/testsuite/tests/deriving/should_fail/drvfail014.stderr
index d228e0d6609b..56a63ff3fbe8 100644
--- a/testsuite/tests/deriving/should_fail/drvfail014.stderr
+++ b/testsuite/tests/deriving/should_fail/drvfail014.stderr
@@ -1,9 +1,9 @@
 
 drvfail014.hs:8:28:
     Use deriving( Typeable ) on a data type declaration
-    In the data declaration for ‛T1’
+    In the data declaration for ‘T1’
 
 drvfail014.hs:12:1:
     Derived Typeable instance must be of form (Typeable2 T2)
     In the stand-alone deriving instance for
-      ‛(Typeable a, Typeable b) => Typeable (T2 a b)’
+      ‘(Typeable a, Typeable b) => Typeable (T2 a b)’
diff --git a/testsuite/tests/deriving/should_fail/drvfail015.stderr b/testsuite/tests/deriving/should_fail/drvfail015.stderr
index e47ca459d5d7..c38ff0045688 100644
--- a/testsuite/tests/deriving/should_fail/drvfail015.stderr
+++ b/testsuite/tests/deriving/should_fail/drvfail015.stderr
@@ -1,13 +1,13 @@
 
 drvfail015.hs:10:19:
-    Illegal instance declaration for ‛Eq T’
+    Illegal instance declaration for ‘Eq T’
       (All instance types must be of the form (T t1 ... tn)
        where T is not a synonym.
        Use TypeSynonymInstances if you want to disable this.)
-    In the stand-alone deriving instance for ‛Eq T’
+    In the stand-alone deriving instance for ‘Eq T’
 
 drvfail015.hs:13:1:
-    Can't make a derived instance of ‛Eq Handle’:
-      The data constructors of ‛Handle’ are not all in scope
+    Can't make a derived instance of ‘Eq Handle’:
+      The data constructors of ‘Handle’ are not all in scope
         so you cannot derive an instance for it
-    In the stand-alone deriving instance for ‛Eq Handle’
+    In the stand-alone deriving instance for ‘Eq Handle’
diff --git a/testsuite/tests/dph/modules/dph-ExportList-vseg-fast.stderr b/testsuite/tests/dph/modules/dph-ExportList-vseg-fast.stderr
index 749c3cdfeba3..bf6f453f71e2 100644
--- a/testsuite/tests/dph/modules/dph-ExportList-vseg-fast.stderr
+++ b/testsuite/tests/dph/modules/dph-ExportList-vseg-fast.stderr
@@ -1,6 +1,9 @@
 [1 of 1] Compiling ExportList       ( ExportList.hs, ExportList.o )
 Warning: vectorisation failure: identityConvTyCon: type constructor contains parallel arrays [::]
-  Could NOT call vectorised from original version ExportList.solveV
+  Could NOT call vectorised from original version
+  ExportList.solveV :: GHC.Types.Double -> [:GHC.Types.Double:]
 Warning: vectorisation failure: identityConvTyCon: type constructor contains parallel arrays NodeV
   Could NOT call vectorised from original version
-  ExportList.solvePA
+  ExportList.solvePA :: ExportList.NodeV
+                        -> GHC.Types.Double
+                        -> Data.Array.Parallel.PArray.PData.Base.PArray GHC.Types.Double
diff --git a/testsuite/tests/driver/B042stub/C.hs b/testsuite/tests/driver/B042stub/C.hs
new file mode 100644
index 000000000000..73f069cb9298
--- /dev/null
+++ b/testsuite/tests/driver/B042stub/C.hs
@@ -0,0 +1,6 @@
+{-# LANGUAGE ForeignFunctionInterface #-}
+module B042stub.C where
+
+foreign export ccall foo :: IO ()
+foo :: IO ()
+foo = return ()
diff --git a/testsuite/tests/driver/Makefile b/testsuite/tests/driver/Makefile
index 767371343d12..62aa2f92c895 100644
--- a/testsuite/tests/driver/Makefile
+++ b/testsuite/tests/driver/Makefile
@@ -222,6 +222,14 @@ test042:
 	"$(TEST_HC)" $(TEST_HC_OPTS_NO_RECOMP) -v0 --make B042/C.hs -odir obj042
 	test -f obj042/B042/C$(OBJSUFFIX)
 
+# test -odir with stubs
+test042stub:
+	$(RM) -rf obj042stub
+	mkdir obj042stub
+	$(RM) B042stub/C.hi
+	"$(TEST_HC)" $(TEST_HC_OPTS_NO_RECOMP) -v0 --make B042stub/C.hs -odir obj042stub
+	test -f obj042stub/B042stub/C$(OBJSUFFIX)
+
 # test -hidir
 test043:
 	$(RM) -f B043/C$(OBJSUFFIX)
@@ -548,9 +556,25 @@ T6037:
 T2507:
 	-LC_ALL=C "$(TEST_HC)" $(TEST_HC_OPTS_NO_RECOMP) -c T2507.hs
 
+.PHONY: T8959a
+T8959a:
+	-LC_ALL=C "$(TEST_HC)" $(TEST_HC_OPTS_NO_RECOMP) -c T8959a.hs -XUnicodeSyntax
+
 .PHONY: T703
 T703:
 	$(RM) -rf T703
 	[ ! -d T703 ]
 	"$(TEST_HC)" $(TEST_HC_OPTS) --make T703.hs -v0
 	! readelf -W -l T703 2>/dev/null | grep 'GNU_STACK' | grep -q 'RWE'
+
+.PHONY: write_interface_oneshot
+write_interface_oneshot:
+	$(RM) -rf write_interface_oneshot/A011.hi
+	"$(TEST_HC)" $(TEST_HC_OPTS) -hidir write_interface_oneshot -fno-code -fwrite-interface -c A011.hs
+	test -f write_interface_oneshot/A011.hi
+
+.PHONY: write_interface_make
+write_interface_make:
+	$(RM) -rf write_interface_make/A011.hi
+	"$(TEST_HC)" $(TEST_HC_OPTS) -hidir write_interface_make -fno-code -fwrite-interface --make A011.hs
+	test -f write_interface_make/A011.hi
diff --git a/testsuite/tests/driver/T1372/T1372.stderr b/testsuite/tests/driver/T1372/T1372.stderr
index e332c563a3ab..d3798fef5ee7 100644
--- a/testsuite/tests/driver/T1372/T1372.stderr
+++ b/testsuite/tests/driver/T1372/T1372.stderr
@@ -1,2 +1,2 @@
 
-Main.hs:5:5: Not in scope: data constructor ‛T’
+Main.hs:5:5: Not in scope: data constructor ‘T’
diff --git a/testsuite/tests/driver/T5147/T5147.stderr b/testsuite/tests/driver/T5147/T5147.stderr
index 43f0f935d312..9e59ee28b00e 100644
--- a/testsuite/tests/driver/T5147/T5147.stderr
+++ b/testsuite/tests/driver/T5147/T5147.stderr
@@ -1,5 +1,5 @@
 
 A.hs:6:15:
-    No instance for (Show (Fields v)) arising from a use of ‛show’
+    No instance for (Show (Fields v)) arising from a use of ‘show’
     In the expression: show a
-    In an equation for ‛showField’: showField a = show a
+    In an equation for ‘showField’: showField a = show a
diff --git a/testsuite/tests/driver/T8959a.hs b/testsuite/tests/driver/T8959a.hs
new file mode 100644
index 000000000000..6f8fd77d157c
--- /dev/null
+++ b/testsuite/tests/driver/T8959a.hs
@@ -0,0 +1,5 @@
+{-# LANGUAGE UnicodeSyntax #-}
+module T8959a where
+
+foo :: Int -> Int
+foo = ()
diff --git a/testsuite/tests/driver/T8959a.stderr b/testsuite/tests/driver/T8959a.stderr
new file mode 100644
index 000000000000..f270bb6d6edf
--- /dev/null
+++ b/testsuite/tests/driver/T8959a.stderr
@@ -0,0 +1,5 @@
+
+T8959a.hs:5:7:
+    Couldn't match expected type `Int -> Int' with actual type `()'
+    In the expression: ()
+    In an equation for `foo': foo = ()
diff --git a/testsuite/tests/driver/T9050.cmm b/testsuite/tests/driver/T9050.cmm
new file mode 100644
index 000000000000..8b1a393741c9
--- /dev/null
+++ b/testsuite/tests/driver/T9050.cmm
@@ -0,0 +1 @@
+// empty
diff --git a/testsuite/tests/driver/all.T b/testsuite/tests/driver/all.T
index aa4bc9b6cc21..7236ec1a3a3a 100644
--- a/testsuite/tests/driver/all.T
+++ b/testsuite/tests/driver/all.T
@@ -142,6 +142,11 @@ test('driver042',
      run_command,
      ['$MAKE -s --no-print-directory test042'])
 
+test('driver042stub',
+     extra_clean(['B042stub/C.hi', 'obj042stub/B042stub/C.o', 'obj042stub/B042stub/', 'obj042stub/']),
+     run_command,
+     ['$MAKE -s --no-print-directory test042stub'])
+
 test('driver043',
      extra_clean(['B043/C.hi', 'B043/C.o',
                   'hi043/B043/C.hi', 'hi043/B043', 'hi043']),
@@ -386,7 +391,18 @@ test('T2507',
      [when(opsys('mingw32'), expect_fail), when(opsys('darwin'), expect_fail)],
      run_command,
      ['$MAKE -s --no-print-directory T2507'])
+test('T8959a',
+     # The testsuite doesn't know how to set a non-Unicode locale on Windows or Mac OS X
+     [when(opsys('mingw32'), expect_fail), when(opsys('darwin'), expect_fail)],
+     run_command,
+     ['$MAKE -s --no-print-directory T8959a'])
 
 test('T703', normal, run_command, ['$MAKE -s --no-print-directory T703'])
 test('T8101', normal, compile, ['-Wall -fno-code'])
 
+def build_T9050(name, way):
+     return simple_build(name + '.cmm', way, '-outputdir=. ', 0, '', 0, 0, 0)
+test('T9050', normal, build_T9050, [])
+
+test('write_interface_oneshot', normal, run_command, ['$MAKE -s --no-print-directory write_interface_oneshot'])
+test('write_interface_make', normal, run_command, ['$MAKE -s --no-print-directory write_interface_make'])
diff --git a/testsuite/tests/driver/bug1677/bug1677.stderr b/testsuite/tests/driver/bug1677/bug1677.stderr
index 9ee41b5cacfd..dd0d4ff9414d 100644
--- a/testsuite/tests/driver/bug1677/bug1677.stderr
+++ b/testsuite/tests/driver/bug1677/bug1677.stderr
@@ -1,5 +1,5 @@
 
 Foo.hs:1:1:
     File name does not match module name:
-    Saw: ‛Main’
-    Expected: ‛Foo’
+    Saw: ‘Main’
+    Expected: ‘Foo’
diff --git a/testsuite/tests/driver/driver063.stderr b/testsuite/tests/driver/driver063.stderr
index a50340dc42e0..25488b80e9be 100644
--- a/testsuite/tests/driver/driver063.stderr
+++ b/testsuite/tests/driver/driver063.stderr
@@ -1,4 +1,4 @@
 
 D063.hs:2:8:
-    Could not find module ‛A063’
+    Could not find module ‘A063’
     It is not a module in the current program, or in any known package.
diff --git a/testsuite/tests/driver/recomp001/recomp001.stderr b/testsuite/tests/driver/recomp001/recomp001.stderr
index bd75be7bde07..724326e08167 100644
--- a/testsuite/tests/driver/recomp001/recomp001.stderr
+++ b/testsuite/tests/driver/recomp001/recomp001.stderr
@@ -1,2 +1,2 @@
 
-C.hs:3:11: Module ‛B’ does not export ‛foo’
+C.hs:3:11: Module ‘B’ does not export ‘foo’
diff --git a/testsuite/tests/driver/recomp005/recomp005.stderr b/testsuite/tests/driver/recomp005/recomp005.stderr
index 130e56249cb7..a34c8a78e1fc 100644
--- a/testsuite/tests/driver/recomp005/recomp005.stderr
+++ b/testsuite/tests/driver/recomp005/recomp005.stderr
@@ -1,4 +1,4 @@
 
 C.hs:7:11: Warning:
-    Rule "f/g" may never fire because ‛f’ might inline first
-    Probable fix: add an INLINE[n] or NOINLINE[n] pragma on ‛f’
+    Rule "f/g" may never fire because ‘f’ might inline first
+    Probable fix: add an INLINE[n] or NOINLINE[n] pragma on ‘f’
diff --git a/testsuite/tests/driver/recomp006/recomp006.stderr b/testsuite/tests/driver/recomp006/recomp006.stderr
index 912273dabad1..25b48f375fd4 100644
--- a/testsuite/tests/driver/recomp006/recomp006.stderr
+++ b/testsuite/tests/driver/recomp006/recomp006.stderr
@@ -1,6 +1,7 @@
 
 A.hs:8:8:
-    Couldn't match expected type ‛Int’ with actual type ‛(t0, t1)’
+    Couldn't match expected type ‘Int’
+                with actual type ‘(Integer, Integer)’
     In the expression: (2, 3)
     In the expression: (1, (2, 3))
-    In an equation for ‛f’: f = (1, (2, 3))
+    In an equation for ‘f’: f = (1, (2, 3))
diff --git a/testsuite/tests/driver/werror.stderr b/testsuite/tests/driver/werror.stderr
index 45c00e93ef58..b723c39364a9 100644
--- a/testsuite/tests/driver/werror.stderr
+++ b/testsuite/tests/driver/werror.stderr
@@ -3,14 +3,14 @@ werror.hs:6:1: Warning:
     Top-level binding with no type signature: main :: IO ()
 
 werror.hs:7:13: Warning:
-    This binding for ‛main’ shadows the existing binding
+    This binding for ‘main’ shadows the existing binding
       defined at werror.hs:6:1
 
-werror.hs:7:13: Warning: Defined but not used: ‛main’
+werror.hs:7:13: Warning: Defined but not used: ‘main’
 
 werror.hs:8:1: Warning: Tab character
 
-werror.hs:10:1: Warning: Defined but not used: ‛f’
+werror.hs:10:1: Warning: Defined but not used: ‘f’
 
 werror.hs:10:1: Warning:
     Top-level binding with no type signature:
@@ -18,11 +18,11 @@ werror.hs:10:1: Warning:
 
 werror.hs:10:1: Warning:
     Pattern match(es) are overlapped
-    In an equation for ‛f’: f [] = ...
+    In an equation for ‘f’: f [] = ...
 
 werror.hs:10:1: Warning:
     Pattern match(es) are non-exhaustive
-    In an equation for ‛f’: Patterns not matched: _ : _
+    In an equation for ‘f’: Patterns not matched: _ : _
 
 <no location info>: 
 Failing due to -Werror.
diff --git a/testsuite/tests/driver/write_interface_make.stdout b/testsuite/tests/driver/write_interface_make.stdout
new file mode 100644
index 000000000000..1594f5ee2f06
--- /dev/null
+++ b/testsuite/tests/driver/write_interface_make.stdout
@@ -0,0 +1 @@
+[1 of 1] Compiling A011             ( A011.hs, nothing )
diff --git a/testsuite/tests/ext-core/Makefile b/testsuite/tests/ext-core/Makefile
deleted file mode 100644
index d52dd9c42888..000000000000
--- a/testsuite/tests/ext-core/Makefile
+++ /dev/null
@@ -1,29 +0,0 @@
-TOP=../..
-include $(TOP)/mk/boilerplate.mk
-include $(TOP)/mk/test.mk
-
-# T5881 needs a script because it goes wrong only when 
-# the modules are compiled separately, not with --make
-T5881:
-	$(RM) -f T5881.hi T5881.o T5881a.hi T5881a.o
-	'$(TEST_HC)' $(TEST_HC_OPTS) -c T5881a.hs
-	'$(TEST_HC)' $(TEST_HC_OPTS) -c T5881.hs
-
-# T6025 is like T5881; needs separate compile
-T6025:
-	$(RM) -f T6025.hi T6025.o T6025a.hi T6025a.o
-	'$(TEST_HC)' $(TEST_HC_OPTS) -c T6025a.hs
-	'$(TEST_HC)' $(TEST_HC_OPTS) -c T6025.hs
-
-# T6054 is like T5881; needs separate compile
-# The second compile fails, and should do so, hence leading "-"
-T6054:
-	$(RM) -f T6054.hi T6054.o T6054a.hi T6054a.o
-	'$(TEST_HC)' $(TEST_HC_OPTS) -c T6054a.hs
-	-'$(TEST_HC)' $(TEST_HC_OPTS) -c T6054.hs
-
-T7022:
-	$(RM) -f T7022.hi T7022.o T7022a.hi T7022a.o T7022b.hi T7022b.o
-	'$(TEST_HC)' $(TEST_HC_OPTS) -c T7022a.hs
-	'$(TEST_HC)' $(TEST_HC_OPTS) -c T7022b.hs -v0
-	-'$(TEST_HC)' $(TEST_HC_OPTS) -c -v0 T7022.hs
diff --git a/testsuite/tests/ext-core/T7239.hs b/testsuite/tests/ext-core/T7239.hs
deleted file mode 100644
index 4331b9e49397..000000000000
--- a/testsuite/tests/ext-core/T7239.hs
+++ /dev/null
@@ -1,8 +0,0 @@
-module Main where
-
-data T a = T a
-
-type C = T Int
-type CL = [C]
-
-main = print 1
diff --git a/testsuite/tests/ext-core/all.T b/testsuite/tests/ext-core/all.T
deleted file mode 100644
index a1fbb8b7e7c7..000000000000
--- a/testsuite/tests/ext-core/all.T
+++ /dev/null
@@ -1,3 +0,0 @@
-setTestOpts(only_compiler_types(['ghc']))
-
-test('T7239', normal, compile, ['-fext-core'])
diff --git a/testsuite/tests/ffi/should_compile/all.T b/testsuite/tests/ffi/should_compile/all.T
index a192a7b0cc83..84c7e8602ec6 100644
--- a/testsuite/tests/ffi/should_compile/all.T
+++ b/testsuite/tests/ffi/should_compile/all.T
@@ -9,30 +9,21 @@ test('cc001', normal, compile, [''])
 # Non-static C call
 # cc004 test also uses stdcall, so it only works on i386.
 if config.platform.startswith('i386-'):
-	ways = expect_fail_for(['extcore','optextcore'])
+    ways = normal
 else:
-	ways = expect_fail
+    ways = expect_fail
 test('cc004', ways, compile, [''])
 
-# foreign label
-test('cc005', expect_fail_for(['extcore','optextcore']), compile, [''])
-
-# Missing:
-# test('cc006', normal, compile, [''])
-
+test('cc005', normal, compile, [''])
 test('cc007', normal, compile, [''])
-# foreign label
-test('cc008', expect_fail_for(['extcore','optextcore']), compile, [''])
-# foreign label
-test('cc009', expect_fail_for(['extcore','optextcore']), compile, [''])
-# Non-static C call
-test('cc010', expect_fail_for(['extcore','optextcore']), compile, [''])
+test('cc008', normal, compile, [''])
+test('cc009', normal, compile, [''])
+test('cc010', normal , compile, [''])
 test('cc011', normal, compile, [''])
 test('cc012', normal, compile, [''])
 test('cc013', normal, compile, [''])
 test('cc014', normal, compile, [''])
 test('ffi-deriv1', normal, compile, [''])
-
 test('T1357', normal, compile, [''])
 test('T3624', normal, compile, [''])
 test('T3742', normal, compile, [''])
diff --git a/testsuite/tests/ffi/should_fail/T3066.stderr b/testsuite/tests/ffi/should_fail/T3066.stderr
index 2bbaf629c759..e6d292d4ec72 100644
--- a/testsuite/tests/ffi/should_fail/T3066.stderr
+++ b/testsuite/tests/ffi/should_fail/T3066.stderr
@@ -1,6 +1,7 @@
 
 T3066.hs:6:1:
-    Unacceptable argument type in foreign declaration: forall u. Ptr ()
+    Unacceptable argument type in foreign declaration:
+      ‘forall u. Ptr ()’ is not a data type
     When checking declaration:
-        foreign import ccall safe "static bla" bla
-          :: (forall u. X u) -> IO ()
+      foreign import ccall safe "static bla" bla
+        :: (forall u. X u) -> IO ()
diff --git a/testsuite/tests/ffi/should_fail/T5664.stderr b/testsuite/tests/ffi/should_fail/T5664.stderr
index 30bd017a1d43..c1652c2288cb 100644
--- a/testsuite/tests/ffi/should_fail/T5664.stderr
+++ b/testsuite/tests/ffi/should_fail/T5664.stderr
@@ -1,13 +1,16 @@
 
 T5664.hs:15:1:
     Unacceptable argument type in foreign declaration:
-      FunPtr (D -> IO ())
+      Expected: Ptr/FunPtr (Int32 -> IO ()),
+        Actual: FunPtr (D -> IO ())
     When checking declaration:
       foreign import ccall safe "dynamic" mkFun3
         :: FunPtr (D -> IO ()) -> CInt -> IO ()
 
 T5664.hs:24:1:
-    Unacceptable result type in foreign declaration: IO (FunPtr (IO D))
+    Unacceptable result type in foreign declaration:
+      Expected: Ptr/FunPtr (IO Int32),
+        Actual: FunPtr (IO D)
     When checking declaration:
       foreign import ccall safe "wrapper" mkCallBack3
         :: IO CInt -> IO (FunPtr (IO D))
diff --git a/testsuite/tests/ffi/should_fail/T7506.stderr b/testsuite/tests/ffi/should_fail/T7506.stderr
index e8e95a92756d..dd893df155ad 100644
--- a/testsuite/tests/ffi/should_fail/T7506.stderr
+++ b/testsuite/tests/ffi/should_fail/T7506.stderr
@@ -1,7 +1,8 @@
 
 T7506.hs:6:1:
-    Unacceptable type in foreign declaration: Int -> IO ()
-    A foreign-imported address (via &foo) must have type (Ptr a) or (FunPtr a)
+    Unacceptable type in foreign declaration:
+      ‘Int -> IO ()’ cannot be marshalled in a foreign call
+      A foreign-imported address (via &foo) must have type (Ptr a) or (FunPtr a)
     When checking declaration:
       foreign import ccall safe "static stdio.h &putchar" c_putchar
         :: Int -> IO ()
diff --git a/testsuite/tests/ffi/should_fail/ccfail001.stderr b/testsuite/tests/ffi/should_fail/ccfail001.stderr
index 813c5d187c6d..e890041b0290 100644
--- a/testsuite/tests/ffi/should_fail/ccfail001.stderr
+++ b/testsuite/tests/ffi/should_fail/ccfail001.stderr
@@ -1,6 +1,7 @@
 
 ccfail001.hs:10:1:
-    Unacceptable result type in foreign declaration: State# RealWorld
+    Unacceptable result type in foreign declaration:
+      ‘State# RealWorld’ cannot be marshalled in a foreign call
     When checking declaration:
-        foreign import ccall safe "static foo" foo
-          :: Int -> State# RealWorld
+      foreign import ccall safe "static foo" foo
+        :: Int -> State# RealWorld
diff --git a/testsuite/tests/ffi/should_fail/ccfail002.stderr b/testsuite/tests/ffi/should_fail/ccfail002.stderr
index dfff4272cd85..309fa521d286 100644
--- a/testsuite/tests/ffi/should_fail/ccfail002.stderr
+++ b/testsuite/tests/ffi/should_fail/ccfail002.stderr
@@ -1,7 +1,7 @@
 
 ccfail002.hs:10:1:
     Unacceptable result type in foreign declaration:
-        (# Int#, Int#, Int# #)
+      ‘(# Int#, Int#, Int# #)’ cannot be marshalled in a foreign call
     When checking declaration:
-        foreign import ccall unsafe "static foo" foo
-          :: Int# -> Int# -> Int# -> (# Int#, Int#, Int# #)
+      foreign import ccall unsafe "static foo" foo
+        :: Int# -> Int# -> Int# -> (# Int#, Int#, Int# #)
diff --git a/testsuite/tests/ffi/should_fail/ccfail003.stderr b/testsuite/tests/ffi/should_fail/ccfail003.stderr
index 4ce9db572d0f..6afdd7678fea 100644
--- a/testsuite/tests/ffi/should_fail/ccfail003.stderr
+++ b/testsuite/tests/ffi/should_fail/ccfail003.stderr
@@ -1,10 +1,12 @@
 
 ccfail003.hs:7:1:
-    Unacceptable argument type in foreign declaration: Int#
+    Unacceptable argument type in foreign declaration:
+      ‘Int#’ cannot be marshalled in a foreign call
     When checking declaration:
       foreign export ccall "foo" foo :: Int# -> IO ()
 
 ccfail003.hs:10:1:
-    Unacceptable result type in foreign declaration: Int#
+    Unacceptable result type in foreign declaration:
+      ‘Int#’ cannot be marshalled in a foreign call
     When checking declaration:
       foreign export ccall "bar" bar :: Int -> Int#
diff --git a/testsuite/tests/ffi/should_fail/ccfail004.stderr b/testsuite/tests/ffi/should_fail/ccfail004.stderr
index cce4258911f9..f54ac91aa3dc 100644
--- a/testsuite/tests/ffi/should_fail/ccfail004.stderr
+++ b/testsuite/tests/ffi/should_fail/ccfail004.stderr
@@ -1,26 +1,36 @@
 
-
 ccfail004.hs:9:1:
-    Unacceptable argument type in foreign declaration: NInt
+    Unacceptable argument type in foreign declaration:
+      ‘NInt’ cannot be marshalled in a foreign call
+        because its data construtor is not in scope
+        Possible fix: import the data constructor to bring it into scope
     When checking declaration:
       foreign import ccall safe "static f1" f1 :: NInt -> IO Int
 
 ccfail004.hs:10:1:
-    Unacceptable result type in foreign declaration: IO NInt
+    Unacceptable result type in foreign declaration:
+      ‘NInt’ cannot be marshalled in a foreign call
+        because its data construtor is not in scope
+        Possible fix: import the data constructor to bring it into scope
     When checking declaration:
       foreign import ccall safe "static f2" f2 :: Int -> IO NInt
 
 ccfail004.hs:11:1:
-    Unacceptable result type in foreign declaration: NIO Int
+    Unacceptable result type in foreign declaration:
+      ‘NIO Int’ cannot be marshalled in a foreign call
+        because the data construtor for ‘NIO’ is not in scope
+        Possible fix: import the data constructor to bring it into scope
     When checking declaration:
       foreign import ccall safe "static f3" f3 :: Int -> NIO Int
 
 ccfail004.hs:14:1:
-    Unacceptable argument type in foreign declaration: [NT]
+    Unacceptable argument type in foreign declaration:
+      ‘[NT]’ cannot be marshalled in a foreign call
     When checking declaration:
       foreign import ccall safe "static f4" f4 :: NT -> IO ()
 
 ccfail004.hs:15:1:
-    Unacceptable result type in foreign declaration: IO [NT]
+    Unacceptable result type in foreign declaration:
+      ‘[NT]’ cannot be marshalled in a foreign call
     When checking declaration:
       foreign import ccall safe "static f5" f5 :: IO NT
diff --git a/testsuite/tests/ffi/should_fail/ccfail005.stderr b/testsuite/tests/ffi/should_fail/ccfail005.stderr
index 0d96fe91e3f3..413faa702c22 100644
--- a/testsuite/tests/ffi/should_fail/ccfail005.stderr
+++ b/testsuite/tests/ffi/should_fail/ccfail005.stderr
@@ -1,10 +1,12 @@
 
 ccfail005.hs:14:1:
-    Unacceptable argument type in foreign declaration: D
+    Unacceptable argument type in foreign declaration:
+      ‘D’ cannot be marshalled in a foreign call
     When checking declaration:
       foreign import ccall safe "static f1" f1 :: F Bool
 
 ccfail005.hs:15:1:
-    Unacceptable result type in foreign declaration: IO D
+    Unacceptable result type in foreign declaration:
+      ‘D’ cannot be marshalled in a foreign call
     When checking declaration:
       foreign import ccall safe "static f2" f2 :: F Char
diff --git a/testsuite/tests/ffi/should_run/all.T b/testsuite/tests/ffi/should_run/all.T
index 567c3e67ce0e..7efc6eb3d81d 100644
--- a/testsuite/tests/ffi/should_run/all.T
+++ b/testsuite/tests/ffi/should_run/all.T
@@ -4,10 +4,7 @@
 #	extra run flags
 #	expected process return value, if not zero
 
-# Doesn't work with External Core due to __labels
-test('fed001', [only_compiler_types(['ghc']),
-                expect_fail_for(['extcore','optextcore'])],
-		compile_and_run, [''])
+test('fed001', normal, compile_and_run, [''])
 
 # Omit GHCi for these two, as they use foreign export
 test('ffi001', omit_ways(['ghci']), compile_and_run, [''])
@@ -37,9 +34,7 @@ test('ffi005', [ omit_ways(prof_ways),
                  exit_code(3) ],
                compile_and_run, [''])
 
-# ffi[006-009] don't work with External Core due to non-static-C foreign calls
-
-test('ffi006', expect_fail_for(['extcore','optextcore']), compile_and_run, [''])
+test('ffi006', normal, compile_and_run, [''])
 
 # Skip ffi00{7,8} for GHCi.  These tests both try to exit or raise an
 # error from a foreign export, which shuts down the runtime.  When
@@ -48,15 +43,8 @@ test('ffi006', expect_fail_for(['extcore','optextcore']), compile_and_run, [''])
 # Sometimes we end up with the wrong exit code, or get an extra
 # 'interrupted' message from the GHCi thread shutting down.
 
-test('ffi007',
-     [omit_ways(['ghci']), expect_fail_for(['extcore','optextcore'])], 
-	       compile_and_run, [''])
-
-test('ffi008',
-     [expect_fail_for(['extcore','optextcore']),
-      exit_code(1),
-      omit_ways(['ghci'])],
-	       compile_and_run, [''])
+test('ffi007', omit_ways(['ghci']), compile_and_run, [''])
+test('ffi008', [exit_code(1), omit_ways(['ghci'])], compile_and_run, [''])
 
 # On i386, we need -msse2 to get reliable floating point results
 maybe_skip = normal
@@ -68,13 +56,11 @@ if config.platform.startswith('i386-'):
    else:
         maybe_skip = only_ways(['ghci'])
 
-test('ffi009', [when(fast(), skip), expect_fail_for(['extcore','optextcore']),
+test('ffi009', [when(fast(), skip),
                 reqlib('random'),
                 maybe_skip] ,compile_and_run, [opts])
 
-# Doesn't work with External Core due to __labels
-test('ffi010', expect_fail_for(['extcore','optextcore']), compile_and_run, [''])
-
+test('ffi010', normal, compile_and_run, [''])
 test('ffi011', normal, compile_and_run, [''])
 
 # The stdcall calling convention works on Windows, and sometimes on
@@ -88,9 +74,7 @@ else:
 	skip_if_not_windows = skip
 
 test('ffi012', skip_if_not_windows, compile_and_run, [''])
-
-# Doesn't work with External Core due to __labels
-test('ffi013', expect_fail_for(['extcore','optextcore']), compile_and_run, [''])
+test('ffi013', normal, compile_and_run, [''])
 
 # threaded2 sometimes gives ffi014: Main_dDu: interrupted
 test('ffi014',
diff --git a/testsuite/tests/gadt/CasePrune.stderr b/testsuite/tests/gadt/CasePrune.stderr
index 64b71572d51b..db22c46a7d35 100644
--- a/testsuite/tests/gadt/CasePrune.stderr
+++ b/testsuite/tests/gadt/CasePrune.stderr
@@ -1,10 +1,10 @@
 
 CasePrune.hs:14:31:
-    Could not coerce from ‛T Int’ to ‛T A’
-      because the first type argument of ‛T’ has role Nominal,
-      but the arguments ‛Int’ and ‛A’ differ
-      arising from the coercion of the method ‛ic’ from type ‛T Int’
-                   to type ‛T A’
+    Could not coerce from ‘T Int’ to ‘T A’
+      because the first type argument of ‘T’ has role Nominal,
+      but the arguments ‘Int’ and ‘A’ differ
+      arising from the coercion of the method ‘ic’ from type ‘T Int’
+                   to type ‘T A’
     Possible fix:
       use a standalone 'deriving instance' declaration,
         so you can specify the instance context yourself
diff --git a/testsuite/tests/gadt/T3163.stderr b/testsuite/tests/gadt/T3163.stderr
index ce64010857a8..5daca38050c9 100644
--- a/testsuite/tests/gadt/T3163.stderr
+++ b/testsuite/tests/gadt/T3163.stderr
@@ -1,5 +1,5 @@
 
 T3163.hs:8:5:
     Illegal polymorphic or qualified type: forall s. s
-    In the definition of data constructor ‛Unreached’
-    In the data declaration for ‛Taker’
+    In the definition of data constructor ‘Unreached’
+    In the data declaration for ‘Taker’
diff --git a/testsuite/tests/gadt/T3169.stderr b/testsuite/tests/gadt/T3169.stderr
index d5c658f71ae7..09276728e2f8 100644
--- a/testsuite/tests/gadt/T3169.stderr
+++ b/testsuite/tests/gadt/T3169.stderr
@@ -3,7 +3,7 @@ T3169.hs:13:22:
     Could not deduce (elt ~ Map b elt)
     from the context (Key a, Key b)
       bound by the instance declaration at T3169.hs:10:10-36
-      ‛elt’ is a rigid type variable bound by
+      ‘elt’ is a rigid type variable bound by
             the type signature for
               lookup :: (a, b) -> Map (a, b) elt -> Maybe elt
             at T3169.hs:12:3
@@ -14,5 +14,5 @@ T3169.hs:13:22:
       b :: b (bound at T3169.hs:12:13)
       lookup :: (a, b) -> Map (a, b) elt -> Maybe elt
         (bound at T3169.hs:12:3)
-    In the second argument of ‛lookup’, namely ‛m’
+    In the second argument of ‘lookup’, namely ‘m’
     In the expression: lookup a m :: Maybe (Map b elt)
diff --git a/testsuite/tests/gadt/T3651.stderr b/testsuite/tests/gadt/T3651.stderr
index 5d5a4923b530..e9230a4538de 100644
--- a/testsuite/tests/gadt/T3651.stderr
+++ b/testsuite/tests/gadt/T3651.stderr
@@ -1,21 +1,21 @@
 
 T3651.hs:11:11:
-    Couldn't match type ‛Bool’ with ‛()’
+    Couldn't match type ‘Bool’ with ‘()’
     Inaccessible code in
-      a pattern with constructor U :: Z (), in an equation for ‛unsafe1’
+      a pattern with constructor U :: Z (), in an equation for ‘unsafe1’
     In the pattern: U
-    In an equation for ‛unsafe1’: unsafe1 B U = ()
+    In an equation for ‘unsafe1’: unsafe1 B U = ()
 
 T3651.hs:14:11:
-    Couldn't match type ‛Bool’ with ‛()’
+    Couldn't match type ‘Bool’ with ‘()’
     Inaccessible code in
-      a pattern with constructor U :: Z (), in an equation for ‛unsafe2’
+      a pattern with constructor U :: Z (), in an equation for ‘unsafe2’
     In the pattern: U
-    In an equation for ‛unsafe2’: unsafe2 B U = ()
+    In an equation for ‘unsafe2’: unsafe2 B U = ()
 
 T3651.hs:17:11:
-    Couldn't match type ‛Bool’ with ‛()’
+    Couldn't match type ‘Bool’ with ‘()’
     Inaccessible code in
-      a pattern with constructor U :: Z (), in an equation for ‛unsafe3’
+      a pattern with constructor U :: Z (), in an equation for ‘unsafe3’
     In the pattern: U
-    In an equation for ‛unsafe3’: unsafe3 B U = True
+    In an equation for ‘unsafe3’: unsafe3 B U = True
diff --git a/testsuite/tests/gadt/T7293.stderr b/testsuite/tests/gadt/T7293.stderr
index 98a4fe402a77..d9719ba65bab 100644
--- a/testsuite/tests/gadt/T7293.stderr
+++ b/testsuite/tests/gadt/T7293.stderr
@@ -1,9 +1,9 @@
 
 T7293.hs:24:5:
-    Couldn't match type ‛'False’ with ‛'True’
+    Couldn't match type ‘'False’ with ‘'True’
     Inaccessible code in
       a pattern with constructor
         Nil :: forall a. Vec a 'Zero,
-      in an equation for ‛nth’
+      in an equation for ‘nth’
     In the pattern: Nil
-    In an equation for ‛nth’: nth Nil _ = undefined
+    In an equation for ‘nth’: nth Nil _ = undefined
diff --git a/testsuite/tests/gadt/T7294.stderr b/testsuite/tests/gadt/T7294.stderr
index bfb64966fcda..f5ad94601bd6 100644
--- a/testsuite/tests/gadt/T7294.stderr
+++ b/testsuite/tests/gadt/T7294.stderr
@@ -1,9 +1,9 @@
 
 T7294.hs:25:5: Warning:
-    Couldn't match type ‛'False’ with ‛'True’
+    Couldn't match type ‘'False’ with ‘'True’
     Inaccessible code in
       a pattern with constructor
         Nil :: forall a. Vec a 'Zero,
-      in an equation for ‛nth’
+      in an equation for ‘nth’
     In the pattern: Nil
-    In an equation for ‛nth’: nth Nil _ = undefined
+    In an equation for ‘nth’: nth Nil _ = undefined
diff --git a/testsuite/tests/gadt/T7558.stderr b/testsuite/tests/gadt/T7558.stderr
index cf5d73dce8c5..f65c74395bc6 100644
--- a/testsuite/tests/gadt/T7558.stderr
+++ b/testsuite/tests/gadt/T7558.stderr
@@ -1,13 +1,13 @@
 
 T7558.hs:8:4:
-    Couldn't match type ‛a’ with ‛Maybe a’
-      ‛a’ is a rigid type variable bound by
+    Couldn't match type ‘a’ with ‘Maybe a’
+      ‘a’ is a rigid type variable bound by
           the type signature for f :: T a a -> Bool at T7558.hs:7:6
     Inaccessible code in
       a pattern with constructor
         MkT :: forall a b. a ~ Maybe b => a -> Maybe b -> T a b,
-      in an equation for ‛f’
+      in an equation for ‘f’
     Relevant bindings include
       f :: T a a -> Bool (bound at T7558.hs:8:1)
     In the pattern: MkT x y
-    In an equation for ‛f’: f (MkT x y) = [x, y] `seq` True
+    In an equation for ‘f’: f (MkT x y) = [x, y] `seq` True
diff --git a/testsuite/tests/gadt/T9096.hs b/testsuite/tests/gadt/T9096.hs
new file mode 100644
index 000000000000..d778798d3651
--- /dev/null
+++ b/testsuite/tests/gadt/T9096.hs
@@ -0,0 +1,6 @@
+{-# LANGUAGE GADTs #-}
+
+module T9096 where
+
+data Foo a where
+  MkFoo :: (->) a (Foo a)
diff --git a/testsuite/tests/gadt/T9380.hs b/testsuite/tests/gadt/T9380.hs
new file mode 100644
index 000000000000..ebc02178f11c
--- /dev/null
+++ b/testsuite/tests/gadt/T9380.hs
@@ -0,0 +1,68 @@
+{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE GADTs #-}
+module Main where
+
+import Foreign
+import Unsafe.Coerce
+
+data M = A | B deriving (Show, Eq)
+
+newtype S (a :: M) = S Int
+
+data SomeS = forall a . SomeS (S a)
+
+data V0 :: M -> * where
+  V0A :: Int -> V0 A
+  V0B :: Double -> V0 B
+
+data V1 :: M -> * where
+  V1A :: Int -> V1 A
+  V1B :: Double -> V1 B
+  V1a :: () -> V1 a
+
+viewV0 :: S a -> V0 a
+viewV0 (S i)
+  | even i = unsafeCoerce $ V0A 1
+  | otherwise = unsafeCoerce $ V0B 2
+
+viewV1 :: S a -> V1 a
+viewV1 (S i)
+  | even i = unsafeCoerce $ V1A 1
+  | otherwise = unsafeCoerce $ V1B 2
+
+
+typeOf :: S a -> M
+typeOf (S i) = if even i then A else B
+
+cast :: M -> SomeS -> S a
+cast ty (SomeS s@(S i))
+  | ty == typeOf s = S i
+  | otherwise = error "cast"
+
+test0 :: IO ()
+test0 =
+  let s = cast A (SomeS (S 0))
+  in case viewV0 s of
+       V0A{} -> putStrLn "test0 - A"
+       V0B{} -> putStrLn "test0 - B"
+
+test1 :: IO ()
+test1 =
+  let s = cast A (SomeS (S 2)) :: S A
+  in case viewV0 s of
+      V0A{} -> putStrLn "test1 - A"
+
+test2 :: IO ()
+test2 =
+  let s = cast A (SomeS (S 4))
+  in case viewV1 s of
+      V1A{} -> putStrLn "test2 - A"
+      V1B{} -> putStrLn "test2 - B"
+      V1a{} -> putStrLn "test2 - O_o"
+
+main = do
+  test0 -- no ouput at all
+  test1 -- A
+  test2 -- O_o
\ No newline at end of file
diff --git a/testsuite/tests/gadt/T9380.stdout b/testsuite/tests/gadt/T9380.stdout
new file mode 100644
index 000000000000..0a5a466ebc3a
--- /dev/null
+++ b/testsuite/tests/gadt/T9380.stdout
@@ -0,0 +1,3 @@
+test0 - A
+test1 - A
+test2 - A
diff --git a/testsuite/tests/gadt/all.T b/testsuite/tests/gadt/all.T
index 9192891d6393..315ecb697d09 100644
--- a/testsuite/tests/gadt/all.T
+++ b/testsuite/tests/gadt/all.T
@@ -40,7 +40,7 @@ test('gadt23',
 test('gadt24', normal, compile, [''])
 
 test('red-black', normal, compile, [''])
-test('type-rep', [ when(fast(), skip), when(compiler_debugged(),expect_broken_for(8569, ['hpc','optasm','threaded2','dyn','optllvm'])) ] , compile_and_run, [''])
+test('type-rep', when(fast(), skip), compile_and_run, [''])
 test('equal', normal, compile, [''])
 test('nbe', normal, compile, [''])
 test('while', normal, compile_and_run, [''])
@@ -122,3 +122,5 @@ test('T7321',
      ['$MAKE -s --no-print-directory T7321'])
 test('T7974', normal, compile, [''])
 test('T7558', normal, compile_fail, [''])
+test('T9096', normal, compile, [''])
+test('T9380', normal, compile_and_run, [''])
diff --git a/testsuite/tests/gadt/gadt-escape1.stderr b/testsuite/tests/gadt/gadt-escape1.stderr
index f701402e3081..35d1bf44d4c2 100644
--- a/testsuite/tests/gadt/gadt-escape1.stderr
+++ b/testsuite/tests/gadt/gadt-escape1.stderr
@@ -1,14 +1,15 @@
 
 gadt-escape1.hs:19:58:
-    Couldn't match type ‛t’ with ‛ExpGADT Int’
-      ‛t’ is untouchable
+    Couldn't match type ‘t’ with ‘ExpGADT Int’
+      ‘t’ is untouchable
         inside the constraints (t1 ~ Int)
         bound by a pattern with constructor
                    ExpInt :: Int -> ExpGADT Int,
                  in a case alternative
         at gadt-escape1.hs:19:43-50
-      ‛t’ is a rigid type variable bound by
+      ‘t’ is a rigid type variable bound by
           the inferred type of weird1 :: t at gadt-escape1.hs:19:1
+    Possible fix: add a type signature for ‘weird1’
     Expected type: t
       Actual type: ExpGADT t1
     Relevant bindings include
diff --git a/testsuite/tests/gadt/gadt10.stderr b/testsuite/tests/gadt/gadt10.stderr
index fa485aade5d6..cc5230e2f29b 100644
--- a/testsuite/tests/gadt/gadt10.stderr
+++ b/testsuite/tests/gadt/gadt10.stderr
@@ -1,7 +1,7 @@
 
 gadt10.hs:6:24:
-    Expecting one more argument to ‛RInt’
-    Expected kind ‛*’, but ‛RInt’ has kind ‛k0 -> *’
-    In the type ‛RInt’
-    In the definition of data constructor ‛R’
-    In the data declaration for ‛RInt’
+    Expecting one more argument to ‘RInt’
+    Expected kind ‘*’, but ‘RInt’ has kind ‘k0 -> *’
+    In the type ‘RInt’
+    In the definition of data constructor ‘R’
+    In the data declaration for ‘RInt’
diff --git a/testsuite/tests/gadt/gadt11.stderr b/testsuite/tests/gadt/gadt11.stderr
index b753bd961caf..016fd2bd7519 100644
--- a/testsuite/tests/gadt/gadt11.stderr
+++ b/testsuite/tests/gadt/gadt11.stderr
@@ -1,6 +1,6 @@
 
 gadt11.hs:12:3:
-    Data constructor ‛L2’ returns type ‛T1 Bool’
-      instead of an instance of its parent type ‛T2 a’
-    In the definition of data constructor ‛L2’
-    In the data declaration for ‛T2’
+    Data constructor ‘L2’ returns type ‘T1 Bool’
+      instead of an instance of its parent type ‘T2 a’
+    In the definition of data constructor ‘L2’
+    In the data declaration for ‘T2’
diff --git a/testsuite/tests/gadt/gadt13.stderr b/testsuite/tests/gadt/gadt13.stderr
index 3b39f07b8f9e..563492dca38a 100644
--- a/testsuite/tests/gadt/gadt13.stderr
+++ b/testsuite/tests/gadt/gadt13.stderr
@@ -1,16 +1,17 @@
 
 gadt13.hs:15:13:
-    Couldn't match expected type ‛t’
-                with actual type ‛String -> [Char]’
-      ‛t’ is untouchable
+    Couldn't match expected type ‘t’
+                with actual type ‘String -> [Char]’
+      ‘t’ is untouchable
         inside the constraints (t1 ~ Int)
         bound by a pattern with constructor
                    I :: Int -> Term Int,
-                 in an equation for ‛shw’
+                 in an equation for ‘shw’
         at gadt13.hs:15:6-8
-      ‛t’ is a rigid type variable bound by
+      ‘t’ is a rigid type variable bound by
           the inferred type of shw :: Term t1 -> t at gadt13.hs:15:1
+    Possible fix: add a type signature for ‘shw’
     Relevant bindings include
       shw :: Term t1 -> t (bound at gadt13.hs:15:1)
     In the expression: ("I " ++) . shows t
-    In an equation for ‛shw’: shw (I t) = ("I " ++) . shows t
+    In an equation for ‘shw’: shw (I t) = ("I " ++) . shows t
diff --git a/testsuite/tests/gadt/gadt17.hs b/testsuite/tests/gadt/gadt17.hs
index acef8100dc80..26eeda9b2ae0 100644
--- a/testsuite/tests/gadt/gadt17.hs
+++ b/testsuite/tests/gadt/gadt17.hs
@@ -4,7 +4,7 @@
 -- This one showed up a bug that required type refinement in TcIface
 -- See the call to coreRefineTys in TcIface
 --
--- Tests for bug: http://hackage.haskell.org/trac/ghc/ticket/685
+-- Tests for bug: http://ghc.haskell.org/trac/ghc/ticket/685
 
 module ShouldCompile where
 
diff --git a/testsuite/tests/gadt/gadt21.stderr b/testsuite/tests/gadt/gadt21.stderr
index 0293eaafb81e..5c234daf99df 100644
--- a/testsuite/tests/gadt/gadt21.stderr
+++ b/testsuite/tests/gadt/gadt21.stderr
@@ -1,19 +1,19 @@
 
 gadt21.hs:21:60:
-    Could not deduce (Ord a1) arising from a use of ‛f’
+    Could not deduce (Ord a1) arising from a use of ‘f’
     from the context (a ~ Set a1)
       bound by a pattern with constructor
                  TypeSet :: forall a. Type a -> Type (Set a),
-               in an equation for ‛withOrdDynExpr’
+               in an equation for ‘withOrdDynExpr’
       at gadt21.hs:21:35-43
     Possible fix:
       add (Ord a1) to the context of
-        the data constructor ‛TypeSet’
-        or the data constructor ‛DynExpr’
+        the data constructor ‘TypeSet’
+        or the data constructor ‘DynExpr’
         or the type signature for
              withOrdDynExpr :: DynExpr
                                -> (forall a. Ord a => Expr a -> b) -> Maybe b
-    In the first argument of ‛Just’, namely ‛(f e)’
+    In the first argument of ‘Just’, namely ‘(f e)’
     In the expression: Just (f e)
-    In an equation for ‛withOrdDynExpr’:
+    In an equation for ‘withOrdDynExpr’:
         withOrdDynExpr (DynExpr e@(Const (TypeSet _) _)) f = Just (f e)
diff --git a/testsuite/tests/gadt/gadt7.stderr b/testsuite/tests/gadt/gadt7.stderr
index a14740580d37..3fb4a6a72d72 100644
--- a/testsuite/tests/gadt/gadt7.stderr
+++ b/testsuite/tests/gadt/gadt7.stderr
@@ -1,16 +1,17 @@
 
 gadt7.hs:16:38:
-    Couldn't match expected type ‛t’ with actual type ‛t1’
-      ‛t1’ is untouchable
+    Couldn't match expected type ‘t’ with actual type ‘t1’
+      ‘t1’ is untouchable
         inside the constraints (t2 ~ Int)
         bound by a pattern with constructor
                    K :: T Int,
                  in a case alternative
         at gadt7.hs:16:33
-      ‛t1’ is a rigid type variable bound by
+      ‘t1’ is a rigid type variable bound by
            the inferred type of i1b :: T t2 -> t1 -> t at gadt7.hs:16:1
-      ‛t’ is a rigid type variable bound by
+      ‘t’ is a rigid type variable bound by
           the inferred type of i1b :: T t2 -> t1 -> t at gadt7.hs:16:1
+    Possible fix: add a type signature for ‘i1b’
     Relevant bindings include
       y1 :: t1 (bound at gadt7.hs:16:16)
       y :: t1 (bound at gadt7.hs:16:7)
diff --git a/testsuite/tests/gadt/gadtSyntaxFail001.stderr b/testsuite/tests/gadt/gadtSyntaxFail001.stderr
index 0413ddf32026..54fa5f992bff 100644
--- a/testsuite/tests/gadt/gadtSyntaxFail001.stderr
+++ b/testsuite/tests/gadt/gadtSyntaxFail001.stderr
@@ -1,7 +1,7 @@
 
 gadtSyntaxFail001.hs:8:5:
-    Data constructor ‛C2’ has existential type variables, a context, or a specialised result type
+    Data constructor ‘C2’ has existential type variables, a context, or a specialised result type
       C2 :: forall a. a -> Char -> Foo a Int
       (Use ExistentialQuantification or GADTs to allow this)
-    In the definition of data constructor ‛C2’
-    In the data declaration for ‛Foo’
+    In the definition of data constructor ‘C2’
+    In the data declaration for ‘Foo’
diff --git a/testsuite/tests/gadt/gadtSyntaxFail002.stderr b/testsuite/tests/gadt/gadtSyntaxFail002.stderr
index 337e39d7e876..194275b52880 100644
--- a/testsuite/tests/gadt/gadtSyntaxFail002.stderr
+++ b/testsuite/tests/gadt/gadtSyntaxFail002.stderr
@@ -1,7 +1,7 @@
 
 gadtSyntaxFail002.hs:8:5:
-    Data constructor ‛C2’ has existential type variables, a context, or a specialised result type
+    Data constructor ‘C2’ has existential type variables, a context, or a specialised result type
       C2 :: forall a. a -> Char -> Foo a a
       (Use ExistentialQuantification or GADTs to allow this)
-    In the definition of data constructor ‛C2’
-    In the data declaration for ‛Foo’
+    In the definition of data constructor ‘C2’
+    In the data declaration for ‘Foo’
diff --git a/testsuite/tests/gadt/gadtSyntaxFail003.stderr b/testsuite/tests/gadt/gadtSyntaxFail003.stderr
index e948698d03e8..22f1f41ea99f 100644
--- a/testsuite/tests/gadt/gadtSyntaxFail003.stderr
+++ b/testsuite/tests/gadt/gadtSyntaxFail003.stderr
@@ -1,7 +1,7 @@
 
 gadtSyntaxFail003.hs:7:5:
-    Data constructor ‛C1’ has existential type variables, a context, or a specialised result type
+    Data constructor ‘C1’ has existential type variables, a context, or a specialised result type
       C1 :: forall b a c. a -> Int -> c -> Foo b a
       (Use ExistentialQuantification or GADTs to allow this)
-    In the definition of data constructor ‛C1’
-    In the data declaration for ‛Foo’
+    In the definition of data constructor ‘C1’
+    In the data declaration for ‘Foo’
diff --git a/testsuite/tests/gadt/lazypat.stderr b/testsuite/tests/gadt/lazypat.stderr
index 460c600b3580..e9abf5854067 100644
--- a/testsuite/tests/gadt/lazypat.stderr
+++ b/testsuite/tests/gadt/lazypat.stderr
@@ -4,4 +4,4 @@ lazypat.hs:7:5:
       inside a lazy (~) pattern
     In the pattern: T x f
     In the pattern: ~(T x f)
-    In an equation for ‛f’: f ~(T x f) = f x
+    In an equation for ‘f’: f ~(T x f) = f x
diff --git a/testsuite/tests/gadt/records-fail1.stderr b/testsuite/tests/gadt/records-fail1.stderr
index 690649d46bc1..aca4d7fea8cf 100644
--- a/testsuite/tests/gadt/records-fail1.stderr
+++ b/testsuite/tests/gadt/records-fail1.stderr
@@ -1,5 +1,5 @@
 
 records-fail1.hs:7:1:
-    Constructors T1 and T4 have a common field ‛x’,
+    Constructors T1 and T4 have a common field ‘x’,
       but have different result types
-    In the data declaration for ‛T’
+    In the data declaration for ‘T’
diff --git a/testsuite/tests/gadt/rw.stderr b/testsuite/tests/gadt/rw.stderr
index 9273dbd27a4d..82b1986e5481 100644
--- a/testsuite/tests/gadt/rw.stderr
+++ b/testsuite/tests/gadt/rw.stderr
@@ -1,20 +1,20 @@
 
 rw.hs:14:47:
-    Couldn't match expected type ‛a’ with actual type ‛Int’
-      ‛a’ is a rigid type variable bound by
+    Couldn't match expected type ‘a’ with actual type ‘Int’
+      ‘a’ is a rigid type variable bound by
           the type signature for writeInt :: T a -> IORef a -> IO ()
           at rw.hs:12:12
     Relevant bindings include
       ref :: IORef a (bound at rw.hs:13:12)
       v :: T a (bound at rw.hs:13:10)
       writeInt :: T a -> IORef a -> IO () (bound at rw.hs:13:1)
-    In the second argument of ‛writeIORef’, namely ‛(1 :: Int)’
+    In the second argument of ‘writeIORef’, namely ‘(1 :: Int)’
     In the expression: writeIORef ref (1 :: Int)
     In a case alternative: ~(Li x) -> writeIORef ref (1 :: Int)
 
 rw.hs:19:51:
-    Couldn't match type ‛a’ with ‛Bool’
-      ‛a’ is a rigid type variable bound by
+    Couldn't match type ‘a’ with ‘Bool’
+      ‘a’ is a rigid type variable bound by
           the type signature for readBool :: T a -> IORef a -> IO ()
           at rw.hs:16:12
     Expected type: a -> Bool
@@ -23,5 +23,5 @@ rw.hs:19:51:
       ref :: IORef a (bound at rw.hs:17:12)
       v :: T a (bound at rw.hs:17:10)
       readBool :: T a -> IORef a -> IO () (bound at rw.hs:17:1)
-    In the second argument of ‛(.)’, namely ‛not’
-    In the second argument of ‛(>>=)’, namely ‛(print . not)’
+    In the second argument of ‘(.)’, namely ‘not’
+    In the second argument of ‘(>>=)’, namely ‘(print . not)’
diff --git a/testsuite/tests/generics/GenCannotDoRep0_0.stderr b/testsuite/tests/generics/GenCannotDoRep0_0.stderr
index ae1cdc7becf2..e1292b8e7eb7 100644
--- a/testsuite/tests/generics/GenCannotDoRep0_0.stderr
+++ b/testsuite/tests/generics/GenCannotDoRep0_0.stderr
@@ -3,21 +3,22 @@ GenCannotDoRep0_0.hs:6:14: Warning:
     -XDatatypeContexts is deprecated: It was widely considered a misfeature, and has been removed from the Haskell language.
 
 GenCannotDoRep0_0.hs:13:45:
-    Can't make a derived instance of ‛Generic Dynamic’:
-      Dynamic must be a vanilla data constructor
-    In the data declaration for ‛Dynamic’
+    Can't make a derived instance of ‘Generic Dynamic’:
+      Constructor ‘Dynamic’ has existentials or constraints in its type
+      Possible fix: use a standalone deriving declaration instead
+    In the data declaration for ‘Dynamic’
 
 GenCannotDoRep0_0.hs:17:1:
-    Can't make a derived instance of ‛Generic (P Int)’:
+    Can't make a derived instance of ‘Generic (P Int)’:
       P must not be instantiated; try deriving `P a' instead
-    In the stand-alone deriving instance for ‛Generic (P Int)’
+    In the stand-alone deriving instance for ‘Generic (P Int)’
 
 GenCannotDoRep0_0.hs:26:1:
-    Can't make a derived instance of ‛Generic (D Char Char)’:
+    Can't make a derived instance of ‘Generic (D Char Char)’:
       D must not be instantiated; try deriving `D Char b' instead
-    In the stand-alone deriving instance for ‛Generic (D Char Char)’
+    In the stand-alone deriving instance for ‘Generic (D Char Char)’
 
 GenCannotDoRep0_0.hs:28:1:
-    Can't make a derived instance of ‛Generic (D Int a)’:
+    Can't make a derived instance of ‘Generic (D Int a)’:
       D must not have a datatype context
-    In the stand-alone deriving instance for ‛Generic (D Int a)’
+    In the stand-alone deriving instance for ‘Generic (D Int a)’
diff --git a/testsuite/tests/generics/GenCannotDoRep0_1.stderr b/testsuite/tests/generics/GenCannotDoRep0_1.stderr
index 280885f1a43f..cb1221c413ee 100644
--- a/testsuite/tests/generics/GenCannotDoRep0_1.stderr
+++ b/testsuite/tests/generics/GenCannotDoRep0_1.stderr
@@ -3,6 +3,6 @@ GenCannotDoRep0_1.hs:1:29: Warning:
     -XDatatypeContexts is deprecated: It was widely considered a misfeature, and has been removed from the Haskell language.
 
 GenCannotDoRep0_1.hs:8:49:
-    Can't make a derived instance of ‛Generic (Context a)’:
+    Can't make a derived instance of ‘Generic (Context a)’:
       Context must not have a datatype context
-    In the data declaration for ‛Context’
+    In the data declaration for ‘Context’
diff --git a/testsuite/tests/generics/GenCannotDoRep0_2.stderr b/testsuite/tests/generics/GenCannotDoRep0_2.stderr
index 6dad193f4b49..9d0f7020d642 100644
--- a/testsuite/tests/generics/GenCannotDoRep0_2.stderr
+++ b/testsuite/tests/generics/GenCannotDoRep0_2.stderr
@@ -1,5 +1,5 @@
 
 GenCannotDoRep0_2.hs:13:1:
-    Can't make a derived instance of ‛Generic (Term a)’:
+    Can't make a derived instance of ‘Generic (Term a)’:
       Int must be a vanilla data constructor
-    In the stand-alone deriving instance for ‛Generic (Term a)’
+    In the stand-alone deriving instance for ‘Generic (Term a)’
diff --git a/testsuite/tests/generics/GenCannotDoRep1_0.stderr b/testsuite/tests/generics/GenCannotDoRep1_0.stderr
index c75205a380f2..7764f24662cf 100644
--- a/testsuite/tests/generics/GenCannotDoRep1_0.stderr
+++ b/testsuite/tests/generics/GenCannotDoRep1_0.stderr
@@ -1,5 +1,6 @@
 
 GenCannotDoRep1_0.hs:9:49:
-    Can't make a derived instance of ‛Generic1 Dynamic’:
-      Dynamic must be a vanilla data constructor
-    In the data declaration for ‛Dynamic’
+    Can't make a derived instance of ‘Generic1 Dynamic’:
+      Constructor ‘Dynamic’ has existentials or constraints in its type
+      Possible fix: use a standalone deriving declaration instead
+    In the data declaration for ‘Dynamic’
diff --git a/testsuite/tests/generics/GenCannotDoRep1_1.stderr b/testsuite/tests/generics/GenCannotDoRep1_1.stderr
index 97eeca51a9fe..6e29d008a2ab 100644
--- a/testsuite/tests/generics/GenCannotDoRep1_1.stderr
+++ b/testsuite/tests/generics/GenCannotDoRep1_1.stderr
@@ -3,6 +3,6 @@ GenCannotDoRep1_1.hs:1:29: Warning:
     -XDatatypeContexts is deprecated: It was widely considered a misfeature, and has been removed from the Haskell language.
 
 GenCannotDoRep1_1.hs:8:49:
-    Can't make a derived instance of ‛Generic1 Context’:
+    Can't make a derived instance of ‘Generic1 Context’:
       Context must not have a datatype context
-    In the data declaration for ‛Context’
+    In the data declaration for ‘Context’
diff --git a/testsuite/tests/generics/GenCannotDoRep1_2.stderr b/testsuite/tests/generics/GenCannotDoRep1_2.stderr
index 32aebb7fc92f..17e1f5944f3c 100644
--- a/testsuite/tests/generics/GenCannotDoRep1_2.stderr
+++ b/testsuite/tests/generics/GenCannotDoRep1_2.stderr
@@ -1,5 +1,5 @@
 
 GenCannotDoRep1_2.hs:13:1:
-    Can't make a derived instance of ‛Generic1 Term’:
+    Can't make a derived instance of ‘Generic1 Term’:
       Int must be a vanilla data constructor
-    In the stand-alone deriving instance for ‛Generic1 Term’
+    In the stand-alone deriving instance for ‘Generic1 Term’
diff --git a/testsuite/tests/generics/GenCannotDoRep1_3.stderr b/testsuite/tests/generics/GenCannotDoRep1_3.stderr
index eb700759203d..2b7a2809237f 100644
--- a/testsuite/tests/generics/GenCannotDoRep1_3.stderr
+++ b/testsuite/tests/generics/GenCannotDoRep1_3.stderr
@@ -1,6 +1,6 @@
 
 GenCannotDoRep1_3.hs:11:33:
-    Can't make a derived instance of ‛Generic1 T’:
-      Constructor ‛T’ applies a type to an argument involving the last parameter
+    Can't make a derived instance of ‘Generic1 T’:
+      Constructor ‘T’ applies a type to an argument involving the last parameter
                       but the applied type is not of kind * -> *
-    In the data declaration for ‛T’
+    In the data declaration for ‘T’
diff --git a/testsuite/tests/generics/GenCannotDoRep1_4.stderr b/testsuite/tests/generics/GenCannotDoRep1_4.stderr
index 898134c117e2..973c9b0843bd 100644
--- a/testsuite/tests/generics/GenCannotDoRep1_4.stderr
+++ b/testsuite/tests/generics/GenCannotDoRep1_4.stderr
@@ -1,6 +1,6 @@
 
 GenCannotDoRep1_4.hs:8:34:
-    Can't make a derived instance of ‛Generic1 T’:
-      Constructor ‛T’ applies a type to an argument involving the last parameter
+    Can't make a derived instance of ‘Generic1 T’:
+      Constructor ‘T’ applies a type to an argument involving the last parameter
                       but the applied type is not of kind * -> *
-    In the data declaration for ‛T’
+    In the data declaration for ‘T’
diff --git a/testsuite/tests/generics/GenCannotDoRep1_6.stderr b/testsuite/tests/generics/GenCannotDoRep1_6.stderr
index be5d96ada609..04d88bf90e4e 100644
--- a/testsuite/tests/generics/GenCannotDoRep1_6.stderr
+++ b/testsuite/tests/generics/GenCannotDoRep1_6.stderr
@@ -1,6 +1,6 @@
 
 GenCannotDoRep1_6.hs:9:43:
-    Can't make a derived instance of ‛Generic1 T’:
-      Constructor ‛T’ applies a type to an argument involving the last parameter
+    Can't make a derived instance of ‘Generic1 T’:
+      Constructor ‘T’ applies a type to an argument involving the last parameter
                       but the applied type is not of kind * -> *
-    In the data declaration for ‛T’
+    In the data declaration for ‘T’
diff --git a/testsuite/tests/generics/GenCannotDoRep1_7.stderr b/testsuite/tests/generics/GenCannotDoRep1_7.stderr
index 34302ca48309..a35df31863f2 100644
--- a/testsuite/tests/generics/GenCannotDoRep1_7.stderr
+++ b/testsuite/tests/generics/GenCannotDoRep1_7.stderr
@@ -1,6 +1,6 @@
 
 GenCannotDoRep1_7.hs:9:32:
-    Can't make a derived instance of ‛Generic1 I’:
-      Constructor ‛I’ applies a type to an argument involving the last parameter
+    Can't make a derived instance of ‘Generic1 I’:
+      Constructor ‘I’ applies a type to an argument involving the last parameter
                       but the applied type is not of kind * -> *
-    In the data declaration for ‛I’
+    In the data declaration for ‘I’
diff --git a/testsuite/tests/generics/GenCannotDoRep1_8.stderr b/testsuite/tests/generics/GenCannotDoRep1_8.stderr
index d42fbe08b7ec..1cf9bb979407 100644
--- a/testsuite/tests/generics/GenCannotDoRep1_8.stderr
+++ b/testsuite/tests/generics/GenCannotDoRep1_8.stderr
@@ -1,6 +1,6 @@
 
 GenCannotDoRep1_8.hs:12:30:
-    Can't make a derived instance of ‛Generic1 T’:
-      Constructor ‛T’ applies a type to an argument involving the last parameter
+    Can't make a derived instance of ‘Generic1 T’:
+      Constructor ‘T’ applies a type to an argument involving the last parameter
                       but the applied type is not of kind * -> *
-    In the data declaration for ‛T’
+    In the data declaration for ‘T’
diff --git a/testsuite/tests/generics/GenShouldFail0.stderr b/testsuite/tests/generics/GenShouldFail0.stderr
index 0c941b97810f..270c872f5605 100644
--- a/testsuite/tests/generics/GenShouldFail0.stderr
+++ b/testsuite/tests/generics/GenShouldFail0.stderr
@@ -1,5 +1,5 @@
 
 GenShouldFail0.hs:9:1:
-    Can't make a derived instance of ‛Generic X’:
+    Can't make a derived instance of ‘Generic X’:
       You need DeriveGeneric to derive an instance for this class
-    In the stand-alone deriving instance for ‛Generic X’
+    In the stand-alone deriving instance for ‘Generic X’
diff --git a/testsuite/tests/generics/GenShouldFail1_0.stderr b/testsuite/tests/generics/GenShouldFail1_0.stderr
index d368be58cd3d..e75404f8bb5b 100644
--- a/testsuite/tests/generics/GenShouldFail1_0.stderr
+++ b/testsuite/tests/generics/GenShouldFail1_0.stderr
@@ -1,5 +1,5 @@
 
 GenShouldFail1_0.hs:9:1:
-    Can't make a derived instance of ‛Generic1 X’:
+    Can't make a derived instance of ‘Generic1 X’:
       You need DeriveGeneric to derive an instance for this class
-    In the stand-alone deriving instance for ‛Generic1 X’
+    In the stand-alone deriving instance for ‘Generic1 X’
diff --git a/testsuite/tests/generics/T8468.stderr b/testsuite/tests/generics/T8468.stderr
index e95c51d3ec5a..62536cec6935 100644
--- a/testsuite/tests/generics/T8468.stderr
+++ b/testsuite/tests/generics/T8468.stderr
@@ -1,5 +1,5 @@
 
 T8468.hs:6:42:
-    Can't make a derived instance of ‛Generic1 Array’:
+    Can't make a derived instance of ‘Generic1 Array’:
       Array must not have unlifted or polymorphic arguments
-    In the data declaration for ‛Array’
+    In the data declaration for ‘Array’
diff --git a/testsuite/tests/generics/Uniplate/GUniplate.hs b/testsuite/tests/generics/Uniplate/GUniplate.hs
index 76f387d636c5..99b0b405a807 100644
--- a/testsuite/tests/generics/Uniplate/GUniplate.hs
+++ b/testsuite/tests/generics/Uniplate/GUniplate.hs
@@ -4,7 +4,8 @@
 {-# LANGUAGE FlexibleContexts           #-}
 {-# LANGUAGE TypeOperators              #-}
 {-# LANGUAGE DefaultSignatures          #-}
-{-# LANGUAGE IncoherentInstances        #-} -- necessary, unfortunately
+{- # LANGUAGE IncoherentInstances        #-} -- necessary, unfortunately
+{-# LANGUAGE OverlappingInstances        #-} 
 
 module GUniplate where
 
@@ -20,7 +21,8 @@ class Uniplate' f b where
 instance Uniplate' U1 a where
   children' U1 = []
 
-instance Uniplate' (K1 i a) a where
+instance {-# OVERLAPPING #-} Uniplate' (K1 i a) a where
+  -- overlaps the (Uniplate' (K1 i a) b) instance
   children' (K1 a) = [a]
 
 instance Uniplate' (K1 i a) b where
diff --git a/testsuite/tests/ghc-api/T4891/T4891.hs b/testsuite/tests/ghc-api/T4891/T4891.hs
index ca4aff91c9db..854bf62998c7 100644
--- a/testsuite/tests/ghc-api/T4891/T4891.hs
+++ b/testsuite/tests/ghc-api/T4891/T4891.hs
@@ -20,7 +20,6 @@ import Unsafe.Coerce
 import Control.Monad
 import Data.Maybe
 import Bag
-import PrelNames (iNTERACTIVE)
 import Outputable
 import GhcMonad
 import X
diff --git a/testsuite/tests/ghc-api/T4891/T4891.stdout b/testsuite/tests/ghc-api/T4891/T4891.stdout
index 47eb1524675d..8ad0b4eabe7b 100644
--- a/testsuite/tests/ghc-api/T4891/T4891.stdout
+++ b/testsuite/tests/ghc-api/T4891/T4891.stdout
@@ -1,20 +1,20 @@
 =====
-Name: GHC.Types.False
+Name: False
 OccString: 'False'
-DataCon: GHC.Types.False
+DataCon: False
 =====
 Name: :
 OccString: ':'
 DataCon: :
 =====
-Name: X.:->
+Name: :->
 OccString: ':->'
-DataCon: X.:->
+DataCon: :->
 =====
-Name: X.:->.
+Name: :->.
 OccString: ':->.'
-DataCon: X.:->.
+DataCon: :->.
 =====
-Name: X.:->.+
+Name: :->.+
 OccString: ':->.+'
-DataCon: X.:->.+
+DataCon: :->.+
diff --git a/testsuite/tests/ghc-api/T6145.hs b/testsuite/tests/ghc-api/T6145.hs
index 98e8bd021918..13b80eef87a2 100644
--- a/testsuite/tests/ghc-api/T6145.hs
+++ b/testsuite/tests/ghc-api/T6145.hs
@@ -27,15 +27,15 @@ main = do
                         l <- loadModule d
                         let ts=typecheckedSource l
 --                        liftIO (putStr (showSDocDebug (ppr ts)))
-                        let fs=filterBag (isDataCon . snd) ts
+                        let fs=filterBag isDataCon ts
                         return $ not $ isEmptyBag fs
         removeFile "Test.hs"
         print ok
     where 
       isDataCon (L _ (AbsBinds { abs_binds = bs }))
-        = not (isEmptyBag (filterBag (isDataCon . snd) bs))
+        = not (isEmptyBag (filterBag isDataCon bs))
       isDataCon (L l (f@FunBind {}))
-        | (MG (m:_) _ _) <- fun_matches f,
+        | (MG (m:_) _ _ _) <- fun_matches f,
           (L _ (c@ConPatOut{}):_)<-hsLMatchPats m,
           (L l _)<-pat_con c
         = isGoodSrcSpan l       -- Check that the source location is a good one
diff --git a/testsuite/tests/ghc-api/T7478/T7478.hs b/testsuite/tests/ghc-api/T7478/T7478.hs
index 15c3559f7dfa..dc6edb21a8cc 100644
--- a/testsuite/tests/ghc-api/T7478/T7478.hs
+++ b/testsuite/tests/ghc-api/T7478/T7478.hs
@@ -9,7 +9,7 @@ import GHC
 import qualified Config as GHC
 import qualified Outputable as GHC
 import GhcMonad (liftIO)
-import Outputable (PprStyle, qualName, qualModule)
+import Outputable (PprStyle, queryQual)
 
 compileInGhc :: [FilePath]          -- ^ Targets
              -> (String -> IO ())   -- ^ handler for each SevOutput message
@@ -42,7 +42,7 @@ compileInGhc targets handlerOutput = do
         _ -> error "fileFromTarget: not a known target"
 
     collectSrcError handlerOutput flags SevOutput _srcspan style msg
-      = handlerOutput $ GHC.showSDocForUser flags (qualName style,qualModule style) msg
+      = handlerOutput $ GHC.showSDocForUser flags (queryQual style) msg
     collectSrcError _ _ _ _ _ _
       = return ()
 
diff --git a/testsuite/tests/ghc-api/T8639_api.stdout b/testsuite/tests/ghc-api/T8639_api.stdout
index 659a1ddccd19..7218302dc18f 100644
--- a/testsuite/tests/ghc-api/T8639_api.stdout
+++ b/testsuite/tests/ghc-api/T8639_api.stdout
@@ -1,2 +1,2 @@
 3
-GHC.Types.Bool
+Bool
diff --git a/testsuite/tests/ghc-api/apirecomp001/apirecomp001.stderr b/testsuite/tests/ghc-api/apirecomp001/apirecomp001.stderr
index 66f83c8b64e3..54915f29537c 100644
--- a/testsuite/tests/ghc-api/apirecomp001/apirecomp001.stderr
+++ b/testsuite/tests/ghc-api/apirecomp001/apirecomp001.stderr
@@ -4,13 +4,13 @@ B.hs:4:1: Warning:
       answer_to_live_the_universe_and_everything :: Int
 
 B.hs:5:13: Warning:
-    Defaulting the following constraint(s) to type ‛Integer’
-      (Num a0) arising from the literal ‛1’ at B.hs:5:13
+    Defaulting the following constraint(s) to type ‘Integer’
+      (Num a0) arising from the literal ‘1’ at B.hs:5:13
       (Enum a0)
-        arising from the arithmetic sequence ‛1 .. 23 * 2’ at B.hs:5:12-20
+        arising from the arithmetic sequence ‘1 .. 23 * 2’ at B.hs:5:12-20
     In the expression: 1
-    In the first argument of ‛length’, namely ‛[1 .. 23 * 2]’
-    In the first argument of ‛(-)’, namely ‛length [1 .. 23 * 2]’
+    In the first argument of ‘length’, namely ‘[1 .. 23 * 2]’
+    In the first argument of ‘(-)’, namely ‘length [1 .. 23 * 2]’
 
 A.hs:7:1: Warning:
     Top-level binding with no type signature: main :: IO ()
@@ -20,13 +20,13 @@ B.hs:4:1: Warning:
       answer_to_live_the_universe_and_everything :: Int
 
 B.hs:5:13: Warning:
-    Defaulting the following constraint(s) to type ‛Integer’
-      (Num a0) arising from the literal ‛1’ at B.hs:5:13
+    Defaulting the following constraint(s) to type ‘Integer’
+      (Num a0) arising from the literal ‘1’ at B.hs:5:13
       (Enum a0)
-        arising from the arithmetic sequence ‛1 .. 23 * 2’ at B.hs:5:12-20
+        arising from the arithmetic sequence ‘1 .. 23 * 2’ at B.hs:5:12-20
     In the expression: 1
-    In the first argument of ‛length’, namely ‛[1 .. 23 * 2]’
-    In the first argument of ‛(-)’, namely ‛length [1 .. 23 * 2]’
+    In the first argument of ‘length’, namely ‘[1 .. 23 * 2]’
+    In the first argument of ‘(-)’, namely ‘length [1 .. 23 * 2]’
 
 A.hs:7:1: Warning:
     Top-level binding with no type signature: main :: IO ()
diff --git a/testsuite/tests/ghc-e/should_run/Makefile b/testsuite/tests/ghc-e/should_run/Makefile
index 1971004d4c9a..5ed1ec2e6c7b 100644
--- a/testsuite/tests/ghc-e/should_run/Makefile
+++ b/testsuite/tests/ghc-e/should_run/Makefile
@@ -30,3 +30,5 @@ T3890:
 T7299:
 	'$(TEST_HC)' $(TEST_HC_OPTS) -ignore-dot-ghci -e "Control.Concurrent.threadDelay (1000 * 1000)"
 
+T9086:
+	'$(TEST_HC)' $(TEST_HC_OPTS) -ignore-dot-ghci -e ":main" T9086.hs
diff --git a/testsuite/tests/ghc-e/should_run/T2636.stderr b/testsuite/tests/ghc-e/should_run/T2636.stderr
index dbe70becec9c..98c109e92d88 100644
--- a/testsuite/tests/ghc-e/should_run/T2636.stderr
+++ b/testsuite/tests/ghc-e/should_run/T2636.stderr
@@ -1,4 +1,4 @@
 
 T2636.hs:1:8:
-    Could not find module ‛MissingModule’
+    Could not find module ‘MissingModule’
     Use -v to see a list of the files searched for.
diff --git a/testsuite/tests/ghc-e/should_run/T9086.hs b/testsuite/tests/ghc-e/should_run/T9086.hs
new file mode 100644
index 000000000000..a2b4ace33a24
--- /dev/null
+++ b/testsuite/tests/ghc-e/should_run/T9086.hs
@@ -0,0 +1 @@
+main = return "this should not be printed"
diff --git a/testsuite/tests/ghc-e/should_run/all.T b/testsuite/tests/ghc-e/should_run/all.T
index 4ab756735810..9f6491819db3 100644
--- a/testsuite/tests/ghc-e/should_run/all.T
+++ b/testsuite/tests/ghc-e/should_run/all.T
@@ -14,3 +14,4 @@ test('T2228',
 test('T2636', req_interp, run_command, ['$MAKE --no-print-directory -s T2636'])
 test('T3890', req_interp, run_command, ['$MAKE --no-print-directory -s T3890'])
 test('T7299', req_interp, run_command, ['$MAKE --no-print-directory -s T7299'])
+test('T9086', req_interp, run_command, ['$MAKE --no-print-directory -s T9086'])
diff --git a/testsuite/tests/ghci.debugger/scripts/break003.stderr b/testsuite/tests/ghci.debugger/scripts/break003.stderr
index c1dda071d557..5baf41bcdfea 100644
--- a/testsuite/tests/ghci.debugger/scripts/break003.stderr
+++ b/testsuite/tests/ghci.debugger/scripts/break003.stderr
@@ -1,4 +1,4 @@
 
 <interactive>:5:1:
-    No instance for (Show (t -> t1)) arising from a use of ‛print’
+    No instance for (Show (t -> t1)) arising from a use of ‘print’
     In a stmt of an interactive GHCi command: print it
diff --git a/testsuite/tests/ghci.debugger/scripts/break006.stderr b/testsuite/tests/ghci.debugger/scripts/break006.stderr
index 8c190057b6d5..bd0d45de3854 100644
--- a/testsuite/tests/ghci.debugger/scripts/break006.stderr
+++ b/testsuite/tests/ghci.debugger/scripts/break006.stderr
@@ -1,26 +1,26 @@
 
 <interactive>:6:1:
-    No instance for (Show t1) arising from a use of ‛print’
-    Cannot resolve unknown runtime type ‛t1’
+    No instance for (Show t1) arising from a use of ‘print’
+    Cannot resolve unknown runtime type ‘t1’
     Use :print or :force to determine these types
     Relevant bindings include it :: t1 (bound at <interactive>:6:1)
     Note: there are several potential instances:
-      instance Show Double -- Defined in ‛GHC.Float’
-      instance Show Float -- Defined in ‛GHC.Float’
+      instance Show Double -- Defined in ‘GHC.Float’
+      instance Show Float -- Defined in ‘GHC.Float’
       instance (Integral a, Show a) => Show (GHC.Real.Ratio a)
-        -- Defined in ‛GHC.Real’
-      ...plus 24 others
+        -- Defined in ‘GHC.Real’
+      ...plus 23 others
     In a stmt of an interactive GHCi command: print it
 
 <interactive>:8:1:
-    No instance for (Show t1) arising from a use of ‛print’
-    Cannot resolve unknown runtime type ‛t1’
+    No instance for (Show t1) arising from a use of ‘print’
+    Cannot resolve unknown runtime type ‘t1’
     Use :print or :force to determine these types
     Relevant bindings include it :: t1 (bound at <interactive>:8:1)
     Note: there are several potential instances:
-      instance Show Double -- Defined in ‛GHC.Float’
-      instance Show Float -- Defined in ‛GHC.Float’
+      instance Show Double -- Defined in ‘GHC.Float’
+      instance Show Float -- Defined in ‘GHC.Float’
       instance (Integral a, Show a) => Show (GHC.Real.Ratio a)
-        -- Defined in ‛GHC.Real’
-      ...plus 24 others
+        -- Defined in ‘GHC.Real’
+      ...plus 23 others
     In a stmt of an interactive GHCi command: print it
diff --git a/testsuite/tests/ghci.debugger/scripts/break019.stderr b/testsuite/tests/ghci.debugger/scripts/break019.stderr
index 41ec1e89e383..36e9ac2327e6 100644
--- a/testsuite/tests/ghci.debugger/scripts/break019.stderr
+++ b/testsuite/tests/ghci.debugger/scripts/break019.stderr
@@ -1,2 +1,2 @@
 
-Top level: Not in scope: data constructor ‛Test2’
+Top level: Not in scope: data constructor ‘Test2’
diff --git a/testsuite/tests/ghci.debugger/scripts/dynbrk001.stderr b/testsuite/tests/ghci.debugger/scripts/dynbrk001.stderr
index ebc73e5d821e..49283bea0869 100644
--- a/testsuite/tests/ghci.debugger/scripts/dynbrk001.stderr
+++ b/testsuite/tests/ghci.debugger/scripts/dynbrk001.stderr
@@ -1,4 +1,4 @@
 
 <no location info>:
-    Could not find module ‛NonModule’
+    Could not find module ‘NonModule’
     It is not a module in the current program, or in any known package.
diff --git a/testsuite/tests/ghci.debugger/scripts/dynbrk001.stdout b/testsuite/tests/ghci.debugger/scripts/dynbrk001.stdout
index 358f44990cf9..55c096fd1c13 100644
--- a/testsuite/tests/ghci.debugger/scripts/dynbrk001.stdout
+++ b/testsuite/tests/ghci.debugger/scripts/dynbrk001.stdout
@@ -2,4 +2,4 @@ Breakpoint 1 does not exist
 No breakpoints found at that location.
 No active breakpoints.
 [4,8,15,16,23,42]
-map :: forall a b. (a -> b) -> [a] -> [b] 	-- Defined in ‛GHC.Base’
+map :: forall a b. (a -> b) -> [a] -> [b] 	-- Defined in ‘GHC.Base’
diff --git a/testsuite/tests/ghci.debugger/scripts/print018.stdout b/testsuite/tests/ghci.debugger/scripts/print018.stdout
index 26861305f311..d5b7d4603cac 100644
--- a/testsuite/tests/ghci.debugger/scripts/print018.stdout
+++ b/testsuite/tests/ghci.debugger/scripts/print018.stdout
@@ -3,9 +3,9 @@ Stopped at ../Test.hs:40:1-17
 _result :: () = _
 Stopped at ../Test.hs:40:10-17
 _result :: () = _
-x :: a = _
-x = (_t1::a)
-x :: a
+x :: a17 = _
+x = (_t1::a17)
+x :: a17
 ()
 x = Unary
 x :: Unary
diff --git a/testsuite/tests/ghci.debugger/scripts/print019.stderr b/testsuite/tests/ghci.debugger/scripts/print019.stderr
index c53fb9cc475a..e364f06f03fa 100644
--- a/testsuite/tests/ghci.debugger/scripts/print019.stderr
+++ b/testsuite/tests/ghci.debugger/scripts/print019.stderr
@@ -1,12 +1,12 @@
 
 <interactive>:11:1:
-    No instance for (Show a1) arising from a use of ‛print’
-    Cannot resolve unknown runtime type ‛a1’
+    No instance for (Show a1) arising from a use of ‘print’
+    Cannot resolve unknown runtime type ‘a1’
     Use :print or :force to determine these types
     Relevant bindings include it :: a1 (bound at <interactive>:11:1)
     Note: there are several potential instances:
-      instance Show a => Show (List1 a) -- Defined at ../Test.hs:11:12
-      instance Show MyInt -- Defined at ../Test.hs:14:16
+      instance Show Unary -- Defined at ../Test.hs:37:29
+      instance Show a => Show (MkT2 a) -- Defined at ../Test.hs:20:12
       instance Show a => Show (MkT a) -- Defined at ../Test.hs:17:13
-      ...plus 32 others
+      ...plus 31 others
     In a stmt of an interactive GHCi command: print it
diff --git a/testsuite/tests/ghci/linking/Makefile b/testsuite/tests/ghci/linking/Makefile
index 60cb9cbfdaaa..08c5158acc14 100644
--- a/testsuite/tests/ghci/linking/Makefile
+++ b/testsuite/tests/ghci/linking/Makefile
@@ -60,6 +60,7 @@ ghcilink004 :
 	echo 'name: test' >>$(PKG004)
 	echo 'version: 1.0' >>$(PKG004)
 	echo 'id: test-XXX' >>$(PKG004)
+	echo 'key: test-1.0' >>$(PKG004)
 	echo 'library-dirs: $${pkgroot}' >>$(PKG004)
 	echo 'extra-libraries: foo' >>$(PKG004)
 	echo '[]' >$(LOCAL_PKGCONF004)
@@ -87,6 +88,7 @@ ghcilink005 :
 	echo 'name: test' >>$(PKG005)
 	echo 'version: 1.0' >>$(PKG005)
 	echo 'id: test-XXX' >>$(PKG005)
+	echo 'key: test-1.0' >>$(PKG005)
 	echo 'library-dirs: $${pkgroot}' >>$(PKG005)
 	echo 'extra-libraries: foo' >>$(PKG005)
 	echo '[]' >$(LOCAL_PKGCONF005)
@@ -111,6 +113,7 @@ ghcilink006 :
 	echo "name: test" >>$(PKG006)
 	echo "version: 1.0" >>$(PKG006)
 	echo "id: test-XXX" >>$(PKG006)
+	echo "key: test-1.0" >>$(PKG006)
 	echo "extra-libraries: stdc++" >>$(PKG006)
 	echo "[]" >$(LOCAL_PKGCONF006)
 	'$(GHC_PKG)' --no-user-package-db -f $(LOCAL_PKGCONF006) register $(PKG006) -v0
diff --git a/testsuite/tests/ghci/prog006/prog006.stderr b/testsuite/tests/ghci/prog006/prog006.stderr
index 0001208e2d8f..7bc3b1b2ef40 100644
--- a/testsuite/tests/ghci/prog006/prog006.stderr
+++ b/testsuite/tests/ghci/prog006/prog006.stderr
@@ -1,4 +1,4 @@
 
 Boot.hs:5:13:
-    Not a data constructor: ‛forall’
+    Not a data constructor: ‘forall’
     Perhaps you intended to use ExistentialQuantification
diff --git a/testsuite/tests/ghci/prog007/C.hs b/testsuite/tests/ghci/prog007/C.hs
index 8273d6bdda3e..a66d000e8e50 100644
--- a/testsuite/tests/ghci/prog007/C.hs
+++ b/testsuite/tests/ghci/prog007/C.hs
@@ -1,5 +1,3 @@
-{-# LANGUAGE OverlappingInstances #-}
-
 module C where
 
 import A
diff --git a/testsuite/tests/ghci/prog009/ghci.prog009.stderr b/testsuite/tests/ghci/prog009/ghci.prog009.stderr
index ca9a7bc591d6..97297522b94f 100644
--- a/testsuite/tests/ghci/prog009/ghci.prog009.stderr
+++ b/testsuite/tests/ghci/prog009/ghci.prog009.stderr
@@ -1,8 +1,8 @@
 
-A.hs:1:16: parse error on input ‛where’
+A.hs:1:16: parse error on input ‘where’
 
 <interactive>:26:1:
-    Not in scope: ‛yan’
-    Perhaps you meant ‛tan’ (imported from Prelude)
+    Not in scope: ‘yan’
+    Perhaps you meant ‘tan’ (imported from Prelude)
 
-A.hs:1:16: parse error on input ‛where’
+A.hs:1:16: parse error on input ‘where’
diff --git a/testsuite/tests/ghci/prog012/prog012.stderr b/testsuite/tests/ghci/prog012/prog012.stderr
index db122d9c64dc..f22f674230e6 100644
--- a/testsuite/tests/ghci/prog012/prog012.stderr
+++ b/testsuite/tests/ghci/prog012/prog012.stderr
@@ -1,2 +1,2 @@
 
-Bar.hs:3:7: Not in scope: ‛nonexistent’
+Bar.hs:3:7: Not in scope: ‘nonexistent’
diff --git a/testsuite/tests/ghci/prog013/Bad.hs b/testsuite/tests/ghci/prog013/Bad.hs
new file mode 100644
index 000000000000..2c26204e77da
--- /dev/null
+++ b/testsuite/tests/ghci/prog013/Bad.hs
@@ -0,0 +1,3 @@
+a = 1
+b = 2
+bad = '
diff --git a/testsuite/tests/ghci/prog013/Good.hs b/testsuite/tests/ghci/prog013/Good.hs
new file mode 100644
index 000000000000..a9aeef048b1e
--- /dev/null
+++ b/testsuite/tests/ghci/prog013/Good.hs
@@ -0,0 +1,3 @@
+a = 1
+b = 2
+c = 3
diff --git a/testsuite/tests/ghci/prog013/prog013.T b/testsuite/tests/ghci/prog013/prog013.T
new file mode 100644
index 000000000000..020bdf81c803
--- /dev/null
+++ b/testsuite/tests/ghci/prog013/prog013.T
@@ -0,0 +1,2 @@
+test('prog013', normal, ghci_script, ['prog013.script'])
+
diff --git a/testsuite/tests/ghci/prog013/prog013.script b/testsuite/tests/ghci/prog013/prog013.script
new file mode 100644
index 000000000000..b9df96893324
--- /dev/null
+++ b/testsuite/tests/ghci/prog013/prog013.script
@@ -0,0 +1,8 @@
+:set editor /bin/echo
+:l Good.hs
+:e
+:l Bad.hs
+:e
+:e ./Bad.hs
+:l Good.hs
+:e
diff --git a/testsuite/tests/ghci/prog013/prog013.stderr b/testsuite/tests/ghci/prog013/prog013.stderr
new file mode 100644
index 000000000000..d8970d4d2e04
--- /dev/null
+++ b/testsuite/tests/ghci/prog013/prog013.stderr
@@ -0,0 +1,9 @@
+
+Bad.hs:3:8:
+    lexical error in string/character literal at character '\n'
+
+Bad.hs:3:8:
+    lexical error in string/character literal at character '\n'
+
+Bad.hs:3:8:
+    lexical error in string/character literal at character '\n'
diff --git a/testsuite/tests/ghci/prog013/prog013.stdout b/testsuite/tests/ghci/prog013/prog013.stdout
new file mode 100644
index 000000000000..0d621dad7725
--- /dev/null
+++ b/testsuite/tests/ghci/prog013/prog013.stdout
@@ -0,0 +1,4 @@
+Good.hs
+Bad.hs +3
+./Bad.hs +3
+Good.hs
diff --git a/testsuite/tests/ghci/scripts/Defer02.stderr b/testsuite/tests/ghci/scripts/Defer02.stderr
index 2d4b8485296b..7635c8f8048f 100644
--- a/testsuite/tests/ghci/scripts/Defer02.stderr
+++ b/testsuite/tests/ghci/scripts/Defer02.stderr
@@ -1,48 +1,48 @@
 
 ../../typecheck/should_run/Defer01.hs:11:40: Warning:
-    Couldn't match type ‛Char’ with ‛[Char]’
+    Couldn't match type ‘Char’ with ‘[Char]’
     Expected type: String
       Actual type: Char
-    In the first argument of ‛putStr’, namely ‛','’
-    In the second argument of ‛(>>)’, namely ‛putStr ','’
+    In the first argument of ‘putStr’, namely ‘','’
+    In the second argument of ‘(>>)’, namely ‘putStr ','’
     In the expression: putStr "Hello World" >> putStr ','
 
 ../../typecheck/should_run/Defer01.hs:14:5: Warning:
-    Couldn't match expected type ‛Int’ with actual type ‛Char’
+    Couldn't match expected type ‘Int’ with actual type ‘Char’
     In the expression: 'p'
-    In an equation for ‛a’: a = 'p'
+    In an equation for ‘a’: a = 'p'
 
 ../../typecheck/should_run/Defer01.hs:18:9: Warning:
-    No instance for (Eq B) arising from a use of ‛==’
+    No instance for (Eq B) arising from a use of ‘==’
     In the expression: x == x
-    In an equation for ‛b’: b x = x == x
+    In an equation for ‘b’: b x = x == x
 
 ../../typecheck/should_run/Defer01.hs:25:4: Warning:
-    Couldn't match type ‛Int’ with ‛Bool’
+    Couldn't match type ‘Int’ with ‘Bool’
     Inaccessible code in
       a pattern with constructor
         C2 :: Bool -> C Bool,
-      in an equation for ‛c’
+      in an equation for ‘c’
     In the pattern: C2 x
-    In an equation for ‛c’: c (C2 x) = True
+    In an equation for ‘c’: c (C2 x) = True
 
 ../../typecheck/should_run/Defer01.hs:28:5: Warning:
-    No instance for (Num (a -> a)) arising from the literal ‛1’
+    No instance for (Num (a -> a)) arising from the literal ‘1’
     In the expression: 1
-    In an equation for ‛d’: d = 1
+    In an equation for ‘d’: d = 1
 
 ../../typecheck/should_run/Defer01.hs:31:5: Warning:
-    Couldn't match expected type ‛Char -> t’ with actual type ‛Char’
+    Couldn't match expected type ‘Char -> t’ with actual type ‘Char’
     Relevant bindings include
       f :: t (bound at ../../typecheck/should_run/Defer01.hs:31:1)
-    The function ‛e’ is applied to one argument,
-    but its type ‛Char’ has none
+    The function ‘e’ is applied to one argument,
+    but its type ‘Char’ has none
     In the expression: e 'q'
-    In an equation for ‛f’: f = e 'q'
+    In an equation for ‘f’: f = e 'q'
 
 ../../typecheck/should_run/Defer01.hs:34:8: Warning:
-    Couldn't match expected type ‛Char’ with actual type ‛a’
-      ‛a’ is a rigid type variable bound by
+    Couldn't match expected type ‘Char’ with actual type ‘a’
+      ‘a’ is a rigid type variable bound by
           the type signature for h :: a -> (Char, Char)
           at ../../typecheck/should_run/Defer01.hs:33:6
     Relevant bindings include
@@ -53,103 +53,103 @@
     In the expression: (x, 'c')
 
 ../../typecheck/should_run/Defer01.hs:39:17: Warning:
-    Couldn't match expected type ‛Bool’ with actual type ‛T a’
+    Couldn't match expected type ‘Bool’ with actual type ‘T a’
     Relevant bindings include
       a :: a (bound at ../../typecheck/should_run/Defer01.hs:39:3)
       i :: a -> () (bound at ../../typecheck/should_run/Defer01.hs:39:1)
-    In the first argument of ‛not’, namely ‛(K a)’
+    In the first argument of ‘not’, namely ‘(K a)’
     In the expression: (not (K a))
 
 ../../typecheck/should_run/Defer01.hs:43:5: Warning:
-    No instance for (MyClass a1) arising from a use of ‛myOp’
+    No instance for (MyClass a1) arising from a use of ‘myOp’
     In the expression: myOp 23
-    In an equation for ‛j’: j = myOp 23
+    In an equation for ‘j’: j = myOp 23
 
 ../../typecheck/should_run/Defer01.hs:43:10: Warning:
-    No instance for (Num a1) arising from the literal ‛23’
-    The type variable ‛a1’ is ambiguous
+    No instance for (Num a1) arising from the literal ‘23’
+    The type variable ‘a1’ is ambiguous
     Note: there are several potential instances:
-      instance Num Double -- Defined in ‛GHC.Float’
-      instance Num Float -- Defined in ‛GHC.Float’
+      instance Num Double -- Defined in ‘GHC.Float’
+      instance Num Float -- Defined in ‘GHC.Float’
       instance Integral a => Num (GHC.Real.Ratio a)
-        -- Defined in ‛GHC.Real’
+        -- Defined in ‘GHC.Real’
       ...plus three others
-    In the first argument of ‛myOp’, namely ‛23’
+    In the first argument of ‘myOp’, namely ‘23’
     In the expression: myOp 23
-    In an equation for ‛j’: j = myOp 23
+    In an equation for ‘j’: j = myOp 23
 
 ../../typecheck/should_run/Defer01.hs:45:6: Warning:
-    Couldn't match type ‛Int’ with ‛Bool’
+    Couldn't match type ‘Int’ with ‘Bool’
     Inaccessible code in
       the type signature for k :: Int ~ Bool => Int -> Bool
     In the ambiguity check for: Int ~ Bool => Int -> Bool
     To defer the ambiguity check to use sites, enable AllowAmbiguousTypes
-    In the type signature for ‛k’: k :: Int ~ Bool => Int -> Bool
+    In the type signature for ‘k’: k :: (Int ~ Bool) => Int -> Bool
 
 ../../typecheck/should_run/Defer01.hs:45:6: Warning:
-    Couldn't match expected type ‛Bool’ with actual type ‛Int’
+    Couldn't match expected type ‘Bool’ with actual type ‘Int’
     In the ambiguity check for: Int ~ Bool => Int -> Bool
     To defer the ambiguity check to use sites, enable AllowAmbiguousTypes
-    In the type signature for ‛k’: k :: Int ~ Bool => Int -> Bool
+    In the type signature for ‘k’: k :: (Int ~ Bool) => Int -> Bool
 
 ../../typecheck/should_run/Defer01.hs:45:6: Warning:
-    Couldn't match type ‛Int’ with ‛Bool’
+    Couldn't match type ‘Int’ with ‘Bool’
     Inaccessible code in
       the type signature for k :: Int ~ Bool => Int -> Bool
 
 ../../typecheck/should_run/Defer01.hs:46:7: Warning:
-    Couldn't match expected type ‛Bool’ with actual type ‛Int’
+    Couldn't match expected type ‘Bool’ with actual type ‘Int’
     In the expression: x
-    In an equation for ‛k’: k x = x
+    In an equation for ‘k’: k x = x
 
 ../../typecheck/should_run/Defer01.hs:49:5: Warning:
-    Couldn't match expected type ‛IO a0’
-                with actual type ‛Char -> IO ()’
-    Probable cause: ‛putChar’ is applied to too few arguments
-    In the first argument of ‛(>>)’, namely ‛putChar’
+    Couldn't match expected type ‘IO a0’
+                with actual type ‘Char -> IO ()’
+    Probable cause: ‘putChar’ is applied to too few arguments
+    In the first argument of ‘(>>)’, namely ‘putChar’
     In the expression: putChar >> putChar 'p'
 *** Exception: ../../typecheck/should_run/Defer01.hs:11:40:
-    Couldn't match type ‛Char’ with ‛[Char]’
+    Couldn't match type ‘Char’ with ‘[Char]’
     Expected type: String
       Actual type: Char
-    In the first argument of ‛putStr’, namely ‛','’
-    In the second argument of ‛(>>)’, namely ‛putStr ','’
+    In the first argument of ‘putStr’, namely ‘','’
+    In the second argument of ‘(>>)’, namely ‘putStr ','’
     In the expression: putStr "Hello World" >> putStr ','
 (deferred type error)
 *** Exception: ../../typecheck/should_run/Defer01.hs:14:5:
-    Couldn't match expected type ‛Int’ with actual type ‛Char’
+    Couldn't match expected type ‘Int’ with actual type ‘Char’
     In the expression: 'p'
-    In an equation for ‛a’: a = 'p'
+    In an equation for ‘a’: a = 'p'
 (deferred type error)
 *** Exception: ../../typecheck/should_run/Defer01.hs:18:9:
-    No instance for (Eq B) arising from a use of ‛==’
+    No instance for (Eq B) arising from a use of ‘==’
     In the expression: x == x
-    In an equation for ‛b’: b x = x == x
+    In an equation for ‘b’: b x = x == x
 (deferred type error)
 
 <interactive>:8:11:
-    Couldn't match type ‛Bool’ with ‛Int’
+    Couldn't match type ‘Bool’ with ‘Int’
     Expected type: C Int
       Actual type: C Bool
-    In the first argument of ‛c’, namely ‛(C2 True)’
-    In the first argument of ‛print’, namely ‛(c (C2 True))’
+    In the first argument of ‘c’, namely ‘(C2 True)’
+    In the first argument of ‘print’, namely ‘(c (C2 True))’
 *** Exception: ../../typecheck/should_run/Defer01.hs:28:5:
-    No instance for (Num (a -> a)) arising from the literal ‛1’
+    No instance for (Num (a -> a)) arising from the literal ‘1’
     In the expression: 1
-    In an equation for ‛d’: d = 1
+    In an equation for ‘d’: d = 1
 (deferred type error)
 *** Exception: ../../typecheck/should_run/Defer01.hs:31:5:
-    Couldn't match expected type ‛Char -> t’ with actual type ‛Char’
+    Couldn't match expected type ‘Char -> t’ with actual type ‘Char’
     Relevant bindings include
       f :: t (bound at ../../typecheck/should_run/Defer01.hs:31:1)
-    The function ‛e’ is applied to one argument,
-    but its type ‛Char’ has none
+    The function ‘e’ is applied to one argument,
+    but its type ‘Char’ has none
     In the expression: e 'q'
-    In an equation for ‛f’: f = e 'q'
+    In an equation for ‘f’: f = e 'q'
 (deferred type error)
 *** Exception: ../../typecheck/should_run/Defer01.hs:34:8:
-    Couldn't match expected type ‛Char’ with actual type ‛a’
-      ‛a’ is a rigid type variable bound by
+    Couldn't match expected type ‘Char’ with actual type ‘a’
+      ‘a’ is a rigid type variable bound by
           the type signature for h :: a -> (Char, Char)
           at ../../typecheck/should_run/Defer01.hs:33:6
     Relevant bindings include
@@ -160,28 +160,28 @@
     In the expression: (x, 'c')
 (deferred type error)
 *** Exception: ../../typecheck/should_run/Defer01.hs:39:17:
-    Couldn't match expected type ‛Bool’ with actual type ‛T a’
+    Couldn't match expected type ‘Bool’ with actual type ‘T a’
     Relevant bindings include
       a :: a (bound at ../../typecheck/should_run/Defer01.hs:39:3)
       i :: a -> () (bound at ../../typecheck/should_run/Defer01.hs:39:1)
-    In the first argument of ‛not’, namely ‛(K a)’
+    In the first argument of ‘not’, namely ‘(K a)’
     In the expression: (not (K a))
 (deferred type error)
 *** Exception: ../../typecheck/should_run/Defer01.hs:43:5:
-    No instance for (MyClass a1) arising from a use of ‛myOp’
+    No instance for (MyClass a1) arising from a use of ‘myOp’
     In the expression: myOp 23
-    In an equation for ‛j’: j = myOp 23
+    In an equation for ‘j’: j = myOp 23
 (deferred type error)
 
 <interactive>:14:8:
-    Couldn't match expected type ‛Bool’ with actual type ‛Int’
-    In the first argument of ‛print’, namely ‛(k 2)’
+    Couldn't match expected type ‘Bool’ with actual type ‘Int’
+    In the first argument of ‘print’, namely ‘(k 2)’
     In the expression: print (k 2)
-    In an equation for ‛it’: it = print (k 2)
+    In an equation for ‘it’: it = print (k 2)
 *** Exception: ../../typecheck/should_run/Defer01.hs:49:5:
-    Couldn't match expected type ‛IO a0’
-                with actual type ‛Char -> IO ()’
-    Probable cause: ‛putChar’ is applied to too few arguments
-    In the first argument of ‛(>>)’, namely ‛putChar’
+    Couldn't match expected type ‘IO a0’
+                with actual type ‘Char -> IO ()’
+    Probable cause: ‘putChar’ is applied to too few arguments
+    In the first argument of ‘(>>)’, namely ‘putChar’
     In the expression: putChar >> putChar 'p'
 (deferred type error)
diff --git a/testsuite/tests/ghci/scripts/T2452.stderr b/testsuite/tests/ghci/scripts/T2452.stderr
index a2fa4fc8a560..68e07ae36730 100644
--- a/testsuite/tests/ghci/scripts/T2452.stderr
+++ b/testsuite/tests/ghci/scripts/T2452.stderr
@@ -1,2 +1,2 @@
 
-<interactive>:1:1: Not in scope: ‛System.IO.hPutStrLn’
+<interactive>:1:1: Not in scope: ‘System.IO.hPutStrLn’
diff --git a/testsuite/tests/ghci/scripts/T2766.stdout b/testsuite/tests/ghci/scripts/T2766.stdout
index f8ee42ff6a91..5bcbd9e75ebb 100644
--- a/testsuite/tests/ghci/scripts/T2766.stdout
+++ b/testsuite/tests/ghci/scripts/T2766.stdout
@@ -1,3 +1,3 @@
 first :: Arrow to => b `to` c -> (b, d) `to` (c, d)
   :: Arrow to => to b c -> to (b, d) (c, d)
-first :: b~>c -> (b, d)~>(c, d) :: (b ~> c) -> (b, d) ~> (c, d)
+first :: b~>c -> (b, d)~>(c, d) :: b ~> c -> (b, d) ~> (c, d)
diff --git a/testsuite/tests/ghci/scripts/T2816.stderr b/testsuite/tests/ghci/scripts/T2816.stderr
index ba4c1bd955cd..a70f7a517944 100644
--- a/testsuite/tests/ghci/scripts/T2816.stderr
+++ b/testsuite/tests/ghci/scripts/T2816.stderr
@@ -1,2 +1,2 @@
 
-<interactive>:2:1: Not in scope: ‛α’
+<interactive>:2:1: Not in scope: ‘α’
diff --git a/testsuite/tests/ghci/scripts/T3263.stderr b/testsuite/tests/ghci/scripts/T3263.stderr
index 9a09c8187083..737f0bbcaaa9 100644
--- a/testsuite/tests/ghci/scripts/T3263.stderr
+++ b/testsuite/tests/ghci/scripts/T3263.stderr
@@ -1,5 +1,5 @@
 
 T3263.hs:8:12: Warning:
-    A do-notation statement discarded a result of type ‛Char’
-    Suppress this warning by saying ‛_ <- getChar’
+    A do-notation statement discarded a result of type ‘Char’
+    Suppress this warning by saying ‘_ <- getChar’
     or by using the flag -fno-warn-unused-do-bind
diff --git a/testsuite/tests/ghci/scripts/T4087.stdout b/testsuite/tests/ghci/scripts/T4087.stdout
index 3f600bd78dce..2ca08aa4492f 100644
--- a/testsuite/tests/ghci/scripts/T4087.stdout
+++ b/testsuite/tests/ghci/scripts/T4087.stdout
@@ -1,4 +1,4 @@
-type role Equal nominal nominal
-data Equal a b where
-  Equal :: Equal a a
-  	-- Defined at T4087.hs:5:1
+type role Equal nominal nominal
+data Equal a b where
+  Equal :: Equal b b
+  	-- Defined at T4087.hs:5:1
diff --git a/testsuite/tests/ghci/scripts/T4127a.stderr b/testsuite/tests/ghci/scripts/T4127a.stderr
index 598bdbc5a3ab..58d1bb683e9a 100644
--- a/testsuite/tests/ghci/scripts/T4127a.stderr
+++ b/testsuite/tests/ghci/scripts/T4127a.stderr
@@ -1,6 +1,6 @@
 
 <interactive>:3:68:
-    Multiple declarations of ‛f’
+    Multiple declarations of ‘f’
     Declared at: <interactive>:3:32
                  <interactive>:3:68
     In the Template Haskell quotation
diff --git a/testsuite/tests/ghci/scripts/T4175.stdout b/testsuite/tests/ghci/scripts/T4175.stdout
index d8b8de0be081..29bca027ce10 100644
--- a/testsuite/tests/ghci/scripts/T4175.stdout
+++ b/testsuite/tests/ghci/scripts/T4175.stdout
@@ -1,53 +1,53 @@
 type family A a b :: * 	-- Defined at T4175.hs:7:1
-type instance A (B a) b -- Defined at T4175.hs:10:1
-type instance A (Maybe a) a -- Defined at T4175.hs:9:1
-type instance A Int Int -- Defined at T4175.hs:8:1
+type instance A (B a) b = () 	-- Defined at T4175.hs:10:1
+type instance A (Maybe a) a = a 	-- Defined at T4175.hs:9:1
+type instance A Int Int = () 	-- Defined at T4175.hs:8:1
 type role B nominal
 data family B a
   	-- Defined at T4175.hs:12:1
 instance G B -- Defined at T4175.hs:34:10
-data instance B () -- Defined at T4175.hs:13:15
-type instance A (B a) b -- Defined at T4175.hs:10:1
+data instance B () = MkB 	-- Defined at T4175.hs:13:15
+type instance A (B a) b = () 	-- Defined at T4175.hs:10:1
 class C a where
   type family D a b :: *
   	-- Defined at T4175.hs:16:5
-type D () () -- Defined at T4175.hs:22:5
-type D Int () -- Defined at T4175.hs:19:5
+type instance D () () = Bool 	-- Defined at T4175.hs:22:5
+type instance D Int () = String 	-- Defined at T4175.hs:19:5
 type family E a :: * where
     E () = Bool
     E Int = String
   	-- Defined at T4175.hs:24:1
-data () = () 	-- Defined in ‛GHC.Tuple’
+data () = () 	-- Defined in ‘GHC.Tuple’
 instance C () -- Defined at T4175.hs:21:10
-instance Bounded () -- Defined in ‛GHC.Enum’
-instance Enum () -- Defined in ‛GHC.Enum’
-instance Eq () -- Defined in ‛GHC.Classes’
-instance Ord () -- Defined in ‛GHC.Classes’
-instance Read () -- Defined in ‛GHC.Read’
-instance Show () -- Defined in ‛GHC.Show’
-type D () () -- Defined at T4175.hs:22:5
-type D Int () -- Defined at T4175.hs:19:5
-data instance B () -- Defined at T4175.hs:13:15
-data Maybe a = Nothing | Just a 	-- Defined in ‛Data.Maybe’
-instance Eq a => Eq (Maybe a) -- Defined in ‛Data.Maybe’
-instance Monad Maybe -- Defined in ‛Data.Maybe’
-instance Functor Maybe -- Defined in ‛Data.Maybe’
-instance Ord a => Ord (Maybe a) -- Defined in ‛Data.Maybe’
-instance Read a => Read (Maybe a) -- Defined in ‛GHC.Read’
-instance Show a => Show (Maybe a) -- Defined in ‛GHC.Show’
-type instance A (Maybe a) a -- Defined at T4175.hs:9:1
-data Int = I# Int# 	-- Defined in ‛GHC.Types’
+instance Bounded () -- Defined in ‘GHC.Enum’
+instance Enum () -- Defined in ‘GHC.Enum’
+instance Eq () -- Defined in ‘GHC.Classes’
+instance Ord () -- Defined in ‘GHC.Classes’
+instance Read () -- Defined in ‘GHC.Read’
+instance Show () -- Defined in ‘GHC.Show’
+type instance D () () = Bool 	-- Defined at T4175.hs:22:5
+type instance D Int () = String 	-- Defined at T4175.hs:19:5
+data instance B () = MkB 	-- Defined at T4175.hs:13:15
+data Maybe a = Nothing | Just a 	-- Defined in ‘Data.Maybe’
+instance Eq a => Eq (Maybe a) -- Defined in ‘Data.Maybe’
+instance Monad Maybe -- Defined in ‘Data.Maybe’
+instance Functor Maybe -- Defined in ‘Data.Maybe’
+instance Ord a => Ord (Maybe a) -- Defined in ‘Data.Maybe’
+instance Read a => Read (Maybe a) -- Defined in ‘GHC.Read’
+instance Show a => Show (Maybe a) -- Defined in ‘GHC.Show’
+type instance A (Maybe a) a = a 	-- Defined at T4175.hs:9:1
+data Int = I# Int# 	-- Defined in ‘GHC.Types’
 instance C Int -- Defined at T4175.hs:18:10
-instance Bounded Int -- Defined in ‛GHC.Enum’
-instance Enum Int -- Defined in ‛GHC.Enum’
-instance Eq Int -- Defined in ‛GHC.Classes’
-instance Integral Int -- Defined in ‛GHC.Real’
-instance Num Int -- Defined in ‛GHC.Num’
-instance Ord Int -- Defined in ‛GHC.Classes’
-instance Read Int -- Defined in ‛GHC.Read’
-instance Real Int -- Defined in ‛GHC.Real’
-instance Show Int -- Defined in ‛GHC.Show’
-type D Int () -- Defined at T4175.hs:19:5
-type instance A Int Int -- Defined at T4175.hs:8:1
+instance Bounded Int -- Defined in ‘GHC.Enum’
+instance Enum Int -- Defined in ‘GHC.Enum’
+instance Eq Int -- Defined in ‘GHC.Classes’
+instance Integral Int -- Defined in ‘GHC.Real’
+instance Num Int -- Defined in ‘GHC.Num’
+instance Ord Int -- Defined in ‘GHC.Classes’
+instance Read Int -- Defined in ‘GHC.Read’
+instance Real Int -- Defined in ‘GHC.Real’
+instance Show Int -- Defined in ‘GHC.Show’
+type instance D Int () = String 	-- Defined at T4175.hs:19:5
+type instance A Int Int = () 	-- Defined at T4175.hs:8:1
 class Z a 	-- Defined at T4175.hs:28:1
 instance F (Z a) -- Defined at T4175.hs:31:10
diff --git a/testsuite/tests/ghci/scripts/T5417.stdout b/testsuite/tests/ghci/scripts/T5417.stdout
index 73d1de932d22..1085a1750f32 100644
--- a/testsuite/tests/ghci/scripts/T5417.stdout
+++ b/testsuite/tests/ghci/scripts/T5417.stdout
@@ -6,4 +6,4 @@ class C.C1 a where
   type role C.F nominal
   data family C.F a
   	-- Defined at T5417a.hs:5:5
-data C.F (B1 a) -- Defined at T5417.hs:8:10
+data instance C.F (B1 a) = B2 a 	-- Defined at T5417.hs:8:10
diff --git a/testsuite/tests/ghci/scripts/T5545.stdout b/testsuite/tests/ghci/scripts/T5545.stdout
index 8ba680a5cb36..6a72f59b84a3 100644
--- a/testsuite/tests/ghci/scripts/T5545.stdout
+++ b/testsuite/tests/ghci/scripts/T5545.stdout
@@ -1,2 +1,2 @@
-($!) :: (a -> b) -> a -> b 	-- Defined in ‛Prelude’
+($!) :: (a -> b) -> a -> b 	-- Defined in ‘Prelude’
 infixr 0 $!
diff --git a/testsuite/tests/ghci/scripts/T5564.stderr b/testsuite/tests/ghci/scripts/T5564.stderr
index e24eacf5c796..c358dab31904 100644
--- a/testsuite/tests/ghci/scripts/T5564.stderr
+++ b/testsuite/tests/ghci/scripts/T5564.stderr
@@ -1,9 +1,9 @@
 
 <interactive>:3:1:
-    Not in scope: ‛git’
-    Perhaps you meant ‛it’ (line 2)
+    Not in scope: ‘git’
+    Perhaps you meant ‘it’ (line 2)
 
 <interactive>:5:1:
-    Not in scope: ‛fit’
+    Not in scope: ‘fit’
     Perhaps you meant one of these:
-      ‛fst’ (imported from Prelude), ‛it’ (line 4)
+      ‘fst’ (imported from Prelude), ‘it’ (line 4)
diff --git a/testsuite/tests/ghci/scripts/T5820.stderr b/testsuite/tests/ghci/scripts/T5820.stderr
index bf623bff1450..dc89a5fa9b42 100644
--- a/testsuite/tests/ghci/scripts/T5820.stderr
+++ b/testsuite/tests/ghci/scripts/T5820.stderr
@@ -1,5 +1,5 @@
 
 T5820.hs:3:10: Warning:
     No explicit implementation for
-      either ‛==’ or ‛/=’
-    In the instance declaration for ‛Eq Foo’
+      either ‘==’ or ‘/=’
+    In the instance declaration for ‘Eq Foo’
diff --git a/testsuite/tests/ghci/scripts/T5836.stderr b/testsuite/tests/ghci/scripts/T5836.stderr
index 5bd37b5c00e2..80de015c5c10 100644
--- a/testsuite/tests/ghci/scripts/T5836.stderr
+++ b/testsuite/tests/ghci/scripts/T5836.stderr
@@ -1,4 +1,4 @@
 
 <no location info>:
-    Could not find module ‛Does.Not.Exist’
+    Could not find module ‘Does.Not.Exist’
     It is not a module in the current program, or in any known package.
diff --git a/testsuite/tests/ghci/scripts/T5979.stderr b/testsuite/tests/ghci/scripts/T5979.stderr
index b4cd88492896..bbdba1230561 100644
--- a/testsuite/tests/ghci/scripts/T5979.stderr
+++ b/testsuite/tests/ghci/scripts/T5979.stderr
@@ -1,4 +1,7 @@
 
 <no location info>:
-    Could not find module ‛Control.Monad.Trans.State’
-    It is not a module in the current program, or in any known package.
+    Could not find module ‘Control.Monad.Trans.State’
+    Perhaps you meant
+      Control.Monad.Trans.State (from transformers-0.4.1.0@trans_ATJ404cg3uBDx7JJZaSn1I)
+      Control.Monad.Trans.Class (from transformers-0.4.1.0@trans_ATJ404cg3uBDx7JJZaSn1I)
+      Control.Monad.Trans.Cont (from transformers-0.4.1.0@trans_ATJ404cg3uBDx7JJZaSn1I)
diff --git a/testsuite/tests/ghci/scripts/T6007.stderr b/testsuite/tests/ghci/scripts/T6007.stderr
index 695d25b3adbd..aa2be4ee6d2d 100644
--- a/testsuite/tests/ghci/scripts/T6007.stderr
+++ b/testsuite/tests/ghci/scripts/T6007.stderr
@@ -1,6 +1,6 @@
 
 <interactive>:1:19:
-    Module ‛System.IO’ does not export ‛does_not_exist’
+    Module ‘System.IO’ does not export ‘does_not_exist’
 
 <interactive>:1:20:
-    Module ‛Data.Maybe’ does not export ‛does_not_exist’
+    Module ‘Data.Maybe’ does not export ‘does_not_exist’
diff --git a/testsuite/tests/ghci/scripts/T7627.stdout b/testsuite/tests/ghci/scripts/T7627.stdout
index 351b9abd66f3..46935eb0ea88 100644
--- a/testsuite/tests/ghci/scripts/T7627.stdout
+++ b/testsuite/tests/ghci/scripts/T7627.stdout
@@ -1,25 +1,25 @@
-data () = () 	-- Defined in ‛GHC.Tuple’
-instance Bounded () -- Defined in ‛GHC.Enum’
-instance Enum () -- Defined in ‛GHC.Enum’
-instance Eq () -- Defined in ‛GHC.Classes’
-instance Ord () -- Defined in ‛GHC.Classes’
-instance Read () -- Defined in ‛GHC.Read’
-instance Show () -- Defined in ‛GHC.Show’
-data (##) = (##) 	-- Defined in ‛GHC.Prim’
+data () = () 	-- Defined in ‘GHC.Tuple’
+instance Bounded () -- Defined in ‘GHC.Enum’
+instance Enum () -- Defined in ‘GHC.Enum’
+instance Eq () -- Defined in ‘GHC.Classes’
+instance Ord () -- Defined in ‘GHC.Classes’
+instance Read () -- Defined in ‘GHC.Read’
+instance Show () -- Defined in ‘GHC.Show’
+data (##) = (##) 	-- Defined in ‘GHC.Prim’
 () :: ()
 (##) :: (# #)
 (   ) :: ()
 (#   #) :: (# #)
-data (,) a b = (,) a b 	-- Defined in ‛GHC.Tuple’
+data (,) a b = (,) a b 	-- Defined in ‘GHC.Tuple’
 instance (Bounded a, Bounded b) => Bounded (a, b)
-  -- Defined in ‛GHC.Enum’
-instance (Eq a, Eq b) => Eq (a, b) -- Defined in ‛GHC.Classes’
-instance Functor ((,) a) -- Defined in ‛GHC.Base’
-instance (Ord a, Ord b) => Ord (a, b) -- Defined in ‛GHC.Classes’
-instance (Read a, Read b) => Read (a, b) -- Defined in ‛GHC.Read’
-instance (Show a, Show b) => Show (a, b) -- Defined in ‛GHC.Show’
+  -- Defined in ‘GHC.Enum’
+instance (Eq a, Eq b) => Eq (a, b) -- Defined in ‘GHC.Classes’
+instance Functor ((,) a) -- Defined in ‘GHC.Base’
+instance (Ord a, Ord b) => Ord (a, b) -- Defined in ‘GHC.Classes’
+instance (Read a, Read b) => Read (a, b) -- Defined in ‘GHC.Read’
+instance (Show a, Show b) => Show (a, b) -- Defined in ‘GHC.Show’
 data (#,#) (a :: OpenKind) (b :: OpenKind) = (#,#) a b
-  	-- Defined in ‛GHC.Prim’
+  	-- Defined in ‘GHC.Prim’
 (,) :: a -> b -> (a, b)
 (#,#) :: a -> b -> (# a, b #)
 (  ,  ) :: a -> b -> (a, b)
diff --git a/testsuite/tests/ghci/scripts/T7730.script b/testsuite/tests/ghci/scripts/T7730.script
new file mode 100644
index 000000000000..f1e01ee1ef3e
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T7730.script
@@ -0,0 +1,7 @@
+:set -XPolyKinds
+data A x y
+:i A
+:kind A
+:set -XExistentialQuantification
+data T a = forall a . MkT a
+:info T
diff --git a/testsuite/tests/ghci/scripts/T7730.stdout b/testsuite/tests/ghci/scripts/T7730.stdout
new file mode 100644
index 000000000000..e3a08c19f42b
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T7730.stdout
@@ -0,0 +1,8 @@
+type role A phantom phantom
+data A (x :: k) (y :: k1)
+  	-- Defined at <interactive>:3:1
+A :: k -> k1 -> *
+type role T phantom
+data T (a :: k) where
+  MkT :: forall (k :: BOX) (a :: k) a1. a1 -> T a
+  	-- Defined at <interactive>:7:1
diff --git a/testsuite/tests/ghci/scripts/T7873.stdout b/testsuite/tests/ghci/scripts/T7873.stdout
index 0167fb2eba05..215757bb694f 100644
--- a/testsuite/tests/ghci/scripts/T7873.stdout
+++ b/testsuite/tests/ghci/scripts/T7873.stdout
@@ -1,5 +1,6 @@
 data D1 where
-  MkD1 :: (forall (p :: k -> *) (a :: k). p a -> Int) -> D1
+  MkD1 :: (forall (k1 :: BOX) (p :: k1 -> *) (a :: k1). p a -> Int)
+          -> D1
   	-- Defined at <interactive>:3:1
 data D2 where
   MkD2 :: (forall (p :: k -> *) (a :: k). p a -> Int) -> D2
diff --git a/testsuite/tests/ghci/scripts/T7894.stderr b/testsuite/tests/ghci/scripts/T7894.stderr
index b0a04e4dfdfa..4cd2a75ff1d0 100644
--- a/testsuite/tests/ghci/scripts/T7894.stderr
+++ b/testsuite/tests/ghci/scripts/T7894.stderr
@@ -1,2 +1,2 @@
 
-Top level: Not in scope: ‛Data.Maybe.->’
+Top level: Not in scope: ‘Data.Maybe.->’
diff --git a/testsuite/tests/ghci/scripts/T7939.hs b/testsuite/tests/ghci/scripts/T7939.hs
index 93b90164c6bf..fbdf883b51c4 100644
--- a/testsuite/tests/ghci/scripts/T7939.hs
+++ b/testsuite/tests/ghci/scripts/T7939.hs
@@ -22,6 +22,6 @@ type family K a where
   K '[] = Nothing
   K (h ': t) = Just h
 
-type family L (a :: k) b :: k where
+type family L (a :: k) (b :: *) :: k where
   L Int Int = Bool
-  L Maybe Bool = IO
\ No newline at end of file
+  L Maybe Bool = IO
diff --git a/testsuite/tests/ghci/scripts/T7939.stdout b/testsuite/tests/ghci/scripts/T7939.stdout
index 9a88b5c2946a..feb890c578d2 100644
--- a/testsuite/tests/ghci/scripts/T7939.stdout
+++ b/testsuite/tests/ghci/scripts/T7939.stdout
@@ -3,21 +3,23 @@ class Foo (a :: k) where
   	-- Defined at T7939.hs:6:4
 Bar :: k -> * -> *
 type family F a :: * 	-- Defined at T7939.hs:8:1
-type instance F Int -- Defined at T7939.hs:9:1
+type instance F Int = Bool 	-- Defined at T7939.hs:9:1
 F :: * -> *
-type family G a :: * where G Int = Bool
+type family G a :: * where
+    G Int = Bool
   	-- Defined at T7939.hs:11:1
 G :: * -> *
-type family H (a :: Bool) :: Bool where H 'False = 'True
+type family H (a :: Bool) :: Bool where
+    H 'False = 'True
   	-- Defined at T7939.hs:14:1
 H :: Bool -> Bool
 type family J (a :: [k]) :: Bool where
-    J '[] = 'False
-    J (h : t) = 'True
+    J k '[] = 'False
+  forall (k :: BOX) (h :: k) (t :: [k]). J k (h : t) = 'True
   	-- Defined at T7939.hs:17:1
 J :: [k] -> Bool
 type family K (a :: [k]) :: Maybe k where
-    K '[] = 'Nothing
-    K (h : t) = 'Just h
+    K k '[] = 'Nothing
+  forall (k :: BOX) (h :: k) (t :: [k]). K k (h : t) = 'Just h
   	-- Defined at T7939.hs:21:1
 K :: [k] -> Maybe k
diff --git a/testsuite/tests/ghci/scripts/T8469.stdout b/testsuite/tests/ghci/scripts/T8469.stdout
index 6c66b35fab73..cd7966ee668a 100644
--- a/testsuite/tests/ghci/scripts/T8469.stdout
+++ b/testsuite/tests/ghci/scripts/T8469.stdout
@@ -1,10 +1,10 @@
-data Int = GHC.Types.I# GHC.Prim.Int# 	-- Defined in ‛GHC.Types’
-instance Bounded Int -- Defined in ‛GHC.Enum’
-instance Enum Int -- Defined in ‛GHC.Enum’
-instance Eq Int -- Defined in ‛GHC.Classes’
-instance Integral Int -- Defined in ‛GHC.Real’
-instance Num Int -- Defined in ‛GHC.Num’
-instance Ord Int -- Defined in ‛GHC.Classes’
-instance Read Int -- Defined in ‛GHC.Read’
-instance Real Int -- Defined in ‛GHC.Real’
-instance Show Int -- Defined in ‛GHC.Show’
+data Int = GHC.Types.I# GHC.Prim.Int# 	-- Defined in ‘GHC.Types’
+instance Bounded Int -- Defined in ‘GHC.Enum’
+instance Enum Int -- Defined in ‘GHC.Enum’
+instance Eq Int -- Defined in ‘GHC.Classes’
+instance Integral Int -- Defined in ‘GHC.Real’
+instance Num Int -- Defined in ‘GHC.Num’
+instance Ord Int -- Defined in ‘GHC.Classes’
+instance Read Int -- Defined in ‘GHC.Read’
+instance Real Int -- Defined in ‘GHC.Real’
+instance Show Int -- Defined in ‘GHC.Show’
diff --git a/testsuite/tests/ghci/scripts/T8485.stderr b/testsuite/tests/ghci/scripts/T8485.stderr
index 1731cbd2d625..66358826c0ac 100644
--- a/testsuite/tests/ghci/scripts/T8485.stderr
+++ b/testsuite/tests/ghci/scripts/T8485.stderr
@@ -1,4 +1,4 @@
 
 <interactive>:3:1:
     Role annotation for a type previously declared: type role X nominal
-    (The role annotation must be given where ‛X’ is declared.)
+    (The role annotation must be given where ‘X’ is declared.)
diff --git a/testsuite/tests/ghci/scripts/T8535.stdout b/testsuite/tests/ghci/scripts/T8535.stdout
index dbc88e18da9d..69efa29fc0d2 100644
--- a/testsuite/tests/ghci/scripts/T8535.stdout
+++ b/testsuite/tests/ghci/scripts/T8535.stdout
@@ -1,4 +1,4 @@
-data (->) a b 	-- Defined in ‛GHC.Prim’
-instance Monad ((->) r) -- Defined in ‛GHC.Base’
-instance Functor ((->) r) -- Defined in ‛GHC.Base’
-instance Monoid b => Monoid (a -> b) -- Defined in ‛Data.Monoid’
+data (->) a b 	-- Defined in ‘GHC.Prim’
+instance Monad ((->) r) -- Defined in ‘GHC.Base’
+instance Functor ((->) r) -- Defined in ‘GHC.Base’
+instance Monoid b => Monoid (a -> b) -- Defined in ‘Data.Monoid’
diff --git a/testsuite/tests/ghci/scripts/T8639.stderr b/testsuite/tests/ghci/scripts/T8639.stderr
index ca52a89a57d0..2c63d731b18c 100644
--- a/testsuite/tests/ghci/scripts/T8639.stderr
+++ b/testsuite/tests/ghci/scripts/T8639.stderr
@@ -1,4 +1,4 @@
 
 <interactive>:1:1:
-    Not in scope: ‛H.bit’
-    Perhaps you meant ‛Q.bit’ (imported from T8639)
+    Not in scope: ‘H.bit’
+    Perhaps you meant ‘Q.bit’ (imported from T8639)
diff --git a/testsuite/tests/ghci/scripts/T8649.stderr b/testsuite/tests/ghci/scripts/T8649.stderr
index 2bd458454941..1fe41defdc71 100644
--- a/testsuite/tests/ghci/scripts/T8649.stderr
+++ b/testsuite/tests/ghci/scripts/T8649.stderr
@@ -1,8 +1,8 @@
 
 <interactive>:5:4:
-    Couldn't match expected type ‛Ghci1.X’
-                with actual type ‛X’
-    NB: ‛Ghci1.X’ is defined at <interactive>:2:1-14
-        ‛X’ is defined at <interactive>:4:1-25
-    In the first argument of ‛f’, namely ‛(Y 3)’
+    Couldn't match expected type ‘Ghci1.X’
+                with actual type ‘X’
+    NB: ‘Ghci1.X’ is defined at <interactive>:2:1-14
+        ‘X’ is defined at <interactive>:4:1-25
+    In the first argument of ‘f’, namely ‘(Y 3)’
     In the expression: f (Y 3)
diff --git a/testsuite/tests/ghci/scripts/T8674.stdout b/testsuite/tests/ghci/scripts/T8674.stdout
index a4f5bbff6e4f..6c13176e6677 100644
--- a/testsuite/tests/ghci/scripts/T8674.stdout
+++ b/testsuite/tests/ghci/scripts/T8674.stdout
@@ -1,5 +1,5 @@
 type role Sing nominal
 data family Sing (a :: k)
   	-- Defined at T8674.hs:4:1
-data instance Sing Bool -- Defined at T8674.hs:6:15
-data instance Sing a -- Defined at T8674.hs:5:15
+data instance Sing Bool = SBool 	-- Defined at T8674.hs:6:15
+data instance Sing a = SNil 	-- Defined at T8674.hs:5:15
diff --git a/testsuite/tests/ghci/scripts/T8696.script b/testsuite/tests/ghci/scripts/T8696.script
new file mode 100644
index 000000000000..8bc8b8abe3bf
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T8696.script
@@ -0,0 +1,4 @@
+:set -fobject-code
+:load T8696A T8696B
+T8696A.a
+T8696B.b
diff --git a/testsuite/tests/ghci/scripts/T8696.stdout b/testsuite/tests/ghci/scripts/T8696.stdout
new file mode 100644
index 000000000000..b94473479cd9
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T8696.stdout
@@ -0,0 +1,2 @@
+3
+4
diff --git a/testsuite/tests/ghci/scripts/T8696A.hs b/testsuite/tests/ghci/scripts/T8696A.hs
new file mode 100644
index 000000000000..465af37ea940
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T8696A.hs
@@ -0,0 +1,4 @@
+module T8696A (a) where
+{-# NOINLINE a #-}
+a :: Int
+a = 3
diff --git a/testsuite/tests/ghci/scripts/T8696B.hs b/testsuite/tests/ghci/scripts/T8696B.hs
new file mode 100644
index 000000000000..e57ab55ee40a
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T8696B.hs
@@ -0,0 +1,4 @@
+module T8696B (b) where
+import T8696A (a)
+b :: Int
+b = a+1
diff --git a/testsuite/tests/ghci/scripts/T8776.hs b/testsuite/tests/ghci/scripts/T8776.hs
new file mode 100644
index 000000000000..55e329cd4309
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T8776.hs
@@ -0,0 +1,6 @@
+{-# LANGUAGE PatternSynonyms, GADTs #-}
+data A x y = (Num x, Eq y) => B
+
+data R = R{ rX :: Int }
+
+pattern P = B
diff --git a/testsuite/tests/ghci/scripts/T8776.script b/testsuite/tests/ghci/scripts/T8776.script
new file mode 100644
index 000000000000..baaca9f66e56
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T8776.script
@@ -0,0 +1,2 @@
+:load T8776.hs
+:i P
diff --git a/testsuite/tests/ghci/scripts/T8776.stdout b/testsuite/tests/ghci/scripts/T8776.stdout
new file mode 100644
index 000000000000..9c9e89ad9410
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T8776.stdout
@@ -0,0 +1 @@
+pattern (Num t, Eq t1) => P :: (A t t1) 	-- Defined at T8776.hs:6:9
diff --git a/testsuite/tests/ghci/scripts/T8831.hs b/testsuite/tests/ghci/scripts/T8831.hs
new file mode 100644
index 000000000000..b0a3cc5bdf54
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T8831.hs
@@ -0,0 +1,3 @@
+{-# LANGUAGE TemplateHaskell #-}
+module T8831 where
+foo = [| 3 |]
diff --git a/testsuite/tests/ghci/scripts/T8831.script b/testsuite/tests/ghci/scripts/T8831.script
new file mode 100644
index 000000000000..bc6ba89440a5
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T8831.script
@@ -0,0 +1,4 @@
+:seti -XTemplateHaskell
+:load T8831.hs
+$foo
+
diff --git a/testsuite/tests/ghci/scripts/T8831.stdout b/testsuite/tests/ghci/scripts/T8831.stdout
new file mode 100644
index 000000000000..00750edc07d6
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T8831.stdout
@@ -0,0 +1 @@
+3
diff --git a/testsuite/tests/ghci/scripts/T8917.hs b/testsuite/tests/ghci/scripts/T8917.hs
new file mode 100644
index 000000000000..b16d928eda4b
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T8917.hs
@@ -0,0 +1,8 @@
+{-# LANGUAGE DataKinds, PolyKinds, TypeFamilies, TypeOperators #-}
+
+module T8917 where
+
+data Nat = Zero | Succ Nat
+type family a + b where
+  Zero + a = a
+  (Succ n) + m = Succ (n + m)
diff --git a/testsuite/tests/ghci/scripts/T8917.script b/testsuite/tests/ghci/scripts/T8917.script
new file mode 100644
index 000000000000..e79ac311e914
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T8917.script
@@ -0,0 +1,4 @@
+:load T8917
+:seti -XDataKinds -XTypeOperators
+:kind! Zero + Succ Zero
+:kind! Succ (Zero + Zero)
\ No newline at end of file
diff --git a/testsuite/tests/ghci/scripts/T8917.stdout b/testsuite/tests/ghci/scripts/T8917.stdout
new file mode 100644
index 000000000000..8426b6ab1029
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T8917.stdout
@@ -0,0 +1,4 @@
+Zero + Succ Zero :: Nat
+= 'Succ 'Zero
+Succ (Zero + Zero) :: Nat
+= 'Succ 'Zero
diff --git a/testsuite/tests/ghci/scripts/T8931.script b/testsuite/tests/ghci/scripts/T8931.script
new file mode 100644
index 000000000000..152747681c00
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T8931.script
@@ -0,0 +1,3 @@
+:m +Data.Typeable
+let {f :: Typeable a => (a->Bool) -> Bool; f _ = True}
+f (\x -> (x == 3))
diff --git a/testsuite/tests/ghci/scripts/T8931.stdout b/testsuite/tests/ghci/scripts/T8931.stdout
new file mode 100644
index 000000000000..0ca95142bb71
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T8931.stdout
@@ -0,0 +1 @@
+True
diff --git a/testsuite/tests/ghci/scripts/T8959.script b/testsuite/tests/ghci/scripts/T8959.script
new file mode 100644
index 000000000000..124b2ab2f558
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T8959.script
@@ -0,0 +1,20 @@
+:set -XPatternGuards -XArrows -XRankNTypes
+
+:t lookup
+:t undefined :: (forall a. a -> a) -> a
+:t () >- () -< () >>- () -<< ()
+let fun foo | True <- () = ()
+
+:set -XUnicodeSyntax
+
+:t lookup
+:t undefined :: (forall a. a -> a) -> a
+:t () >- () -< () >>- () -<< ()
+let fun foo | True <- () = ()
+
+:set -XNoUnicodeSyntax
+
+:t lookup
+:t undefined :: (forall a. a -> a) -> a
+:t () >- () -< () >>- () -<< ()
+let fun foo | True <- () = ()
diff --git a/testsuite/tests/ghci/scripts/T8959.stderr b/testsuite/tests/ghci/scripts/T8959.stderr
new file mode 100644
index 000000000000..b3995c336550
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T8959.stderr
@@ -0,0 +1,36 @@
+
+<interactive>:1:1:
+    Arrow command found where an expression was expected:
+      () >- () -< () >>- () -<< ()
+
+<interactive>:7:15:
+    Couldn't match expected type ‘()’ with actual type ‘Bool’
+    In the pattern: True
+    In a stmt of a pattern guard for
+                   an equation for ‘fun’:
+      True <- ()
+    In an equation for ‘fun’: fun foo | True <- () = ()
+
+<interactive>:1:1:
+    Arrow command found where an expression was expected:
+      () ↣ () ↢ () ⤜ () ⤛ ()
+
+<interactive>:14:15:
+    Couldn't match expected type ‘()’ with actual type ‘Bool’
+    In the pattern: True
+    In a stmt of a pattern guard for
+                   an equation for ‘fun’:
+      True � ()
+    In an equation for ‘fun’: fun foo | True � () = ()
+
+<interactive>:1:1:
+    Arrow command found where an expression was expected:
+      () >- () -< () >>- () -<< ()
+
+<interactive>:21:15:
+    Couldn't match expected type ‘()’ with actual type ‘Bool’
+    In the pattern: True
+    In a stmt of a pattern guard for
+                   an equation for ‘fun’:
+      True <- ()
+    In an equation for ‘fun’: fun foo | True <- () = ()
diff --git a/testsuite/tests/ghci/scripts/T8959.stdout b/testsuite/tests/ghci/scripts/T8959.stdout
new file mode 100644
index 000000000000..4631732c55ea
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T8959.stdout
@@ -0,0 +1,6 @@
+lookup :: Eq a => a -> [(a, b)] -> Maybe b
+undefined :: (forall a. a -> a) -> a :: (forall a1. a1 -> a1) -> a
+lookup ∷ Eq a ⇒ a → [(a, b)] → Maybe b
+undefined :: (forall a. a -> a) -> a ∷ (∀ a1. a1 → a1) → a
+lookup :: Eq a => a -> [(a, b)] -> Maybe b
+undefined :: (forall a. a -> a) -> a :: (forall a1. a1 -> a1) -> a
diff --git a/testsuite/tests/ghci/scripts/T8959b.hs b/testsuite/tests/ghci/scripts/T8959b.hs
new file mode 100644
index 000000000000..064b2670a8f5
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T8959b.hs
@@ -0,0 +1,11 @@
+{-# LANGUAGE UnicodeSyntax, Arrows, RankNTypes #-}
+module T8959b where
+
+foo :: Int -> Int
+foo = ()
+
+bar :: ()
+bar = proc x -> do return -< x
+
+baz = () :: (forall a. a -> a) -> a
+
diff --git a/testsuite/tests/ghci/scripts/T8959b.script b/testsuite/tests/ghci/scripts/T8959b.script
new file mode 100644
index 000000000000..f3c23c97a3cc
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T8959b.script
@@ -0,0 +1 @@
+:l T8959b.hs
diff --git a/testsuite/tests/ghci/scripts/T8959b.stderr b/testsuite/tests/ghci/scripts/T8959b.stderr
new file mode 100644
index 000000000000..4f1ac7a97b44
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T8959b.stderr
@@ -0,0 +1,16 @@
+
+T8959b.hs:5:7:
+    Couldn't match expected type ‘Int → Int’ with actual type ‘()’
+    In the expression: ()
+    In an equation for ‘foo’: foo = ()
+
+T8959b.hs:8:7:
+    Couldn't match expected type ‘()’ with actual type ‘t0 → m0 t0’
+    In the expression: proc x -> do { return ↢ x }
+    In an equation for ‘bar’: bar = proc x -> do { return ↢ x }
+
+T8959b.hs:10:7:
+    Couldn't match expected type ‘(∀ a2. a2 → a2) → a1’
+                with actual type ‘()’
+    In the expression: () ∷ (∀ a. a -> a) -> a
+    In an equation for ‘baz’: baz = () ∷ (∀ a. a -> a) -> a
diff --git a/testsuite/tests/ghci/scripts/T9086b.script b/testsuite/tests/ghci/scripts/T9086b.script
new file mode 100644
index 000000000000..d60156ad026c
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T9086b.script
@@ -0,0 +1,2 @@
+let main = do { putStrLn "hello"; return "discarded" }
+:main
diff --git a/testsuite/tests/ghci/scripts/T9086b.stdout b/testsuite/tests/ghci/scripts/T9086b.stdout
new file mode 100644
index 000000000000..ce013625030b
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T9086b.stdout
@@ -0,0 +1 @@
+hello
diff --git a/testsuite/tests/ghci/scripts/T9181.script b/testsuite/tests/ghci/scripts/T9181.script
new file mode 100644
index 000000000000..b2239b955638
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T9181.script
@@ -0,0 +1 @@
+:browse GHC.TypeLits
diff --git a/testsuite/tests/ghci/scripts/T9181.stdout b/testsuite/tests/ghci/scripts/T9181.stdout
new file mode 100644
index 000000000000..e1ac00cc836f
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T9181.stdout
@@ -0,0 +1,54 @@
+type family (GHC.TypeLits.*) (a :: GHC.TypeLits.Nat)
+                             (b :: GHC.TypeLits.Nat) ::
+  GHC.TypeLits.Nat
+type family (GHC.TypeLits.+) (a :: GHC.TypeLits.Nat)
+                             (b :: GHC.TypeLits.Nat) ::
+  GHC.TypeLits.Nat
+type family (GHC.TypeLits.-) (a :: GHC.TypeLits.Nat)
+                             (b :: GHC.TypeLits.Nat) ::
+  GHC.TypeLits.Nat
+type (GHC.TypeLits.<=) (x :: GHC.TypeLits.Nat)
+                       (y :: GHC.TypeLits.Nat) =
+  (x GHC.TypeLits.<=? y) ~ 'True
+type family (GHC.TypeLits.<=?) (a :: GHC.TypeLits.Nat)
+                               (b :: GHC.TypeLits.Nat) ::
+  Bool
+type family GHC.TypeLits.CmpNat (a :: GHC.TypeLits.Nat)
+                                (b :: GHC.TypeLits.Nat) ::
+  Ordering
+type family GHC.TypeLits.CmpSymbol (a :: GHC.TypeLits.Symbol)
+                                   (b :: GHC.TypeLits.Symbol) ::
+  Ordering
+class GHC.TypeLits.KnownNat (n :: GHC.TypeLits.Nat) where
+  GHC.TypeLits.natSing :: GHC.TypeLits.SNat n
+class GHC.TypeLits.KnownSymbol (n :: GHC.TypeLits.Symbol) where
+  GHC.TypeLits.symbolSing :: GHC.TypeLits.SSymbol n
+data GHC.TypeLits.Nat
+data GHC.TypeLits.SomeNat where
+  GHC.TypeLits.SomeNat :: GHC.TypeLits.KnownNat n =>
+                          (Data.Proxy.Proxy n) -> GHC.TypeLits.SomeNat
+data GHC.TypeLits.SomeSymbol where
+  GHC.TypeLits.SomeSymbol :: GHC.TypeLits.KnownSymbol n =>
+                             (Data.Proxy.Proxy n) -> GHC.TypeLits.SomeSymbol
+data GHC.TypeLits.Symbol
+type family (GHC.TypeLits.^) (a :: GHC.TypeLits.Nat)
+                             (b :: GHC.TypeLits.Nat) ::
+  GHC.TypeLits.Nat
+GHC.TypeLits.natVal ::
+  GHC.TypeLits.KnownNat n => proxy n -> Integer
+GHC.TypeLits.natVal' ::
+  GHC.TypeLits.KnownNat n => GHC.Prim.Proxy# n -> Integer
+GHC.TypeLits.sameNat ::
+  (GHC.TypeLits.KnownNat a, GHC.TypeLits.KnownNat b) =>
+  Data.Proxy.Proxy a
+  -> Data.Proxy.Proxy b -> Maybe (a Data.Type.Equality.:~: b)
+GHC.TypeLits.sameSymbol ::
+  (GHC.TypeLits.KnownSymbol a, GHC.TypeLits.KnownSymbol b) =>
+  Data.Proxy.Proxy a
+  -> Data.Proxy.Proxy b -> Maybe (a Data.Type.Equality.:~: b)
+GHC.TypeLits.someNatVal :: Integer -> Maybe GHC.TypeLits.SomeNat
+GHC.TypeLits.someSymbolVal :: String -> GHC.TypeLits.SomeSymbol
+GHC.TypeLits.symbolVal ::
+  GHC.TypeLits.KnownSymbol n => proxy n -> String
+GHC.TypeLits.symbolVal' ::
+  GHC.TypeLits.KnownSymbol n => GHC.Prim.Proxy# n -> String
diff --git a/testsuite/tests/ghci/scripts/all.T b/testsuite/tests/ghci/scripts/all.T
index a7f6fa144124..d5a313a32833 100755
--- a/testsuite/tests/ghci/scripts/all.T
+++ b/testsuite/tests/ghci/scripts/all.T
@@ -61,6 +61,7 @@ test('ghci041', normal, ghci_script, ['ghci041.script'])
 test('ghci042', normal, ghci_script, ['ghci042.script'])
 test('ghci043', normal, ghci_script, ['ghci043.script'])
 test('ghci044', normal, ghci_script, ['ghci044.script'])
+test('ghci044a', normal, ghci_script, ['ghci044a.script'])
 test('ghci045', normal, ghci_script, ['ghci045.script'])
 test('ghci046', normal, ghci_script, ['ghci046.script'])
 test('ghci047', normal, ghci_script, ['ghci047.script'])
@@ -113,7 +114,7 @@ test('T5564', normal, ghci_script, ['T5564.script'])
 test('Defer02', normal, ghci_script, ['Defer02.script'])
 test('T5820', normal, ghci_script, ['T5820.script'])
 test('T5836', normal, ghci_script, ['T5836.script'])
-test('T5979', normalise_slashes, ghci_script, ['T5979.script'])
+test('T5979', [reqlib('transformers'), normalise_slashes], ghci_script, ['T5979.script'])
 test('T5975a',
      [pre_cmd('touch föøbàr1.hs'),
       clean_cmd('rm föøbàr1.hs')],
@@ -147,6 +148,7 @@ test('T7627', normal, ghci_script, ['T7627.script'])
 test('T7627b', normal, ghci_script, ['T7627b.script'])
 test('T7586', normal, ghci_script, ['T7586.script'])
 test('T4175', normal, ghci_script, ['T4175.script'])
+test('T7730', combined_output, ghci_script, ['T7730.script'])
 test('T7872', normal, ghci_script, ['T7872.script'])
 test('T7873', normal, ghci_script, ['T7873.script'])
 test('T7939', normal, ghci_script, ['T7939.script'])
@@ -165,3 +167,13 @@ test('T8640', normal, ghci_script, ['T8640.script'])
 test('T8579', normal, ghci_script, ['T8579.script'])
 test('T8649', normal, ghci_script, ['T8649.script'])
 test('T8674', normal, ghci_script, ['T8674.script'])
+test('T8696', normal, ghci_script, ['T8696.script'])
+test('T8776', normal, ghci_script, ['T8776.script'])
+test('ghci059', normal, ghci_script, ['ghci059.script'])
+test('T8831', normal, ghci_script, ['T8831.script'])
+test('T8917', normal, ghci_script, ['T8917.script'])
+test('T8931', normal, ghci_script, ['T8931.script'])
+test('T8959', normal, ghci_script, ['T8959.script'])
+test('T8959b', expect_broken(8959), ghci_script, ['T8959b.script'])
+test('T9181', normal, ghci_script, ['T9181.script'])
+test('T9086b', normal, ghci_script, ['T9086b.script'])
diff --git a/testsuite/tests/ghci/scripts/ghci008.stdout b/testsuite/tests/ghci/scripts/ghci008.stdout
index 9eaf1dc96188..f0a3f19a9c81 100644
--- a/testsuite/tests/ghci/scripts/ghci008.stdout
+++ b/testsuite/tests/ghci/scripts/ghci008.stdout
@@ -1,18 +1,18 @@
 class Num a where
   (+) :: a -> a -> a
   ...
-  	-- Defined in ‛GHC.Num’
+  	-- Defined in ‘GHC.Num’
 infixl 6 +
 class Num a where
   (+) :: a -> a -> a
   ...
-  	-- Defined in ‛GHC.Num’
+  	-- Defined in ‘GHC.Num’
 infixl 6 +
 data Data.Complex.Complex a = !a Data.Complex.:+ !a
-  	-- Defined in ‛Data.Complex’
+  	-- Defined in ‘Data.Complex’
 infix 6 Data.Complex.:+
 data Data.Complex.Complex a = !a Data.Complex.:+ !a
-  	-- Defined in ‛Data.Complex’
+  	-- Defined in ‘Data.Complex’
 infix 6 Data.Complex.:+
 class (RealFrac a, Floating a) => RealFloat a where
   floatRadix :: a -> Integer
@@ -29,8 +29,8 @@ class (RealFrac a, Floating a) => RealFloat a where
   isNegativeZero :: a -> Bool
   isIEEE :: a -> Bool
   atan2 :: a -> a -> a
-  	-- Defined in ‛GHC.Float’
-instance RealFloat Float -- Defined in ‛GHC.Float’
-instance RealFloat Double -- Defined in ‛GHC.Float’
+  	-- Defined in ‘GHC.Float’
+instance RealFloat Float -- Defined in ‘GHC.Float’
+instance RealFloat Double -- Defined in ‘GHC.Float’
 Data.List.isPrefixOf :: Eq a => [a] -> [a] -> Bool
-  	-- Defined in ‛Data.List’
+  	-- Defined in ‘Data.List’
diff --git a/testsuite/tests/ghci/scripts/ghci011.stdout b/testsuite/tests/ghci/scripts/ghci011.stdout
index 540572ea810f..239ec078008f 100644
--- a/testsuite/tests/ghci/scripts/ghci011.stdout
+++ b/testsuite/tests/ghci/scripts/ghci011.stdout
@@ -1,22 +1,22 @@
-data [] a = [] | a : [a] 	-- Defined in ‛GHC.Types’
-instance Eq a => Eq [a] -- Defined in ‛GHC.Classes’
-instance Monad [] -- Defined in ‛GHC.Base’
-instance Functor [] -- Defined in ‛GHC.Base’
-instance Ord a => Ord [a] -- Defined in ‛GHC.Classes’
-instance Read a => Read [a] -- Defined in ‛GHC.Read’
-instance Show a => Show [a] -- Defined in ‛GHC.Show’
-data () = () 	-- Defined in ‛GHC.Tuple’
-instance Bounded () -- Defined in ‛GHC.Enum’
-instance Enum () -- Defined in ‛GHC.Enum’
-instance Eq () -- Defined in ‛GHC.Classes’
-instance Ord () -- Defined in ‛GHC.Classes’
-instance Read () -- Defined in ‛GHC.Read’
-instance Show () -- Defined in ‛GHC.Show’
-data (,) a b = (,) a b 	-- Defined in ‛GHC.Tuple’
+data [] a = [] | a : [a] 	-- Defined in ‘GHC.Types’
+instance Eq a => Eq [a] -- Defined in ‘GHC.Classes’
+instance Monad [] -- Defined in ‘GHC.Base’
+instance Functor [] -- Defined in ‘GHC.Base’
+instance Ord a => Ord [a] -- Defined in ‘GHC.Classes’
+instance Read a => Read [a] -- Defined in ‘GHC.Read’
+instance Show a => Show [a] -- Defined in ‘GHC.Show’
+data () = () 	-- Defined in ‘GHC.Tuple’
+instance Bounded () -- Defined in ‘GHC.Enum’
+instance Enum () -- Defined in ‘GHC.Enum’
+instance Eq () -- Defined in ‘GHC.Classes’
+instance Ord () -- Defined in ‘GHC.Classes’
+instance Read () -- Defined in ‘GHC.Read’
+instance Show () -- Defined in ‘GHC.Show’
+data (,) a b = (,) a b 	-- Defined in ‘GHC.Tuple’
 instance (Bounded a, Bounded b) => Bounded (a, b)
-  -- Defined in ‛GHC.Enum’
-instance (Eq a, Eq b) => Eq (a, b) -- Defined in ‛GHC.Classes’
-instance Functor ((,) a) -- Defined in ‛GHC.Base’
-instance (Ord a, Ord b) => Ord (a, b) -- Defined in ‛GHC.Classes’
-instance (Read a, Read b) => Read (a, b) -- Defined in ‛GHC.Read’
-instance (Show a, Show b) => Show (a, b) -- Defined in ‛GHC.Show’
+  -- Defined in ‘GHC.Enum’
+instance (Eq a, Eq b) => Eq (a, b) -- Defined in ‘GHC.Classes’
+instance Functor ((,) a) -- Defined in ‘GHC.Base’
+instance (Ord a, Ord b) => Ord (a, b) -- Defined in ‘GHC.Classes’
+instance (Read a, Read b) => Read (a, b) -- Defined in ‘GHC.Read’
+instance (Show a, Show b) => Show (a, b) -- Defined in ‘GHC.Show’
diff --git a/testsuite/tests/ghci/scripts/ghci019.stderr b/testsuite/tests/ghci/scripts/ghci019.stderr
index 4c4ae6afc4c5..de8c7f090157 100644
--- a/testsuite/tests/ghci/scripts/ghci019.stderr
+++ b/testsuite/tests/ghci/scripts/ghci019.stderr
@@ -1,5 +1,5 @@
 
 ghci019.hs:9:10: Warning:
     No explicit implementation for
-      either ‛Prelude.==’ or ‛Prelude./=’
-    In the instance declaration for ‛Prelude.Eq Foo’
+      either ‘Prelude.==’ or ‘Prelude./=’
+    In the instance declaration for ‘Prelude.Eq Foo’
diff --git a/testsuite/tests/ghci/scripts/ghci020.stdout b/testsuite/tests/ghci/scripts/ghci020.stdout
index 6d621d3c1d34..700a21265123 100644
--- a/testsuite/tests/ghci/scripts/ghci020.stdout
+++ b/testsuite/tests/ghci/scripts/ghci020.stdout
@@ -1,3 +1,3 @@
-data (->) a b 	-- Defined in ‛GHC.Prim’
-instance Monad ((->) r) -- Defined in ‛GHC.Base’
-instance Functor ((->) r) -- Defined in ‛GHC.Base’
+data (->) a b 	-- Defined in ‘GHC.Prim’
+instance Monad ((->) r) -- Defined in ‘GHC.Base’
+instance Functor ((->) r) -- Defined in ‘GHC.Base’
diff --git a/testsuite/tests/ghci/scripts/ghci021.stderr b/testsuite/tests/ghci/scripts/ghci021.stderr
index 18216b8f1871..ea7488174e9d 100644
--- a/testsuite/tests/ghci/scripts/ghci021.stderr
+++ b/testsuite/tests/ghci/scripts/ghci021.stderr
@@ -1,2 +1,2 @@
 
-<no location info>: no such module: ‛ThisDoesNotExist’
+<no location info>: no such module: ‘ThisDoesNotExist’
diff --git a/testsuite/tests/ghci/scripts/ghci025.stdout b/testsuite/tests/ghci/scripts/ghci025.stdout
index 9308dd3f39a9..9cc88b8a07fe 100644
--- a/testsuite/tests/ghci/scripts/ghci025.stdout
+++ b/testsuite/tests/ghci/scripts/ghci025.stdout
@@ -11,7 +11,7 @@ class C a b where
   c4 :: a1 -> b
 c1 :: (C a b, N b) => a -> b
 c2 :: (C a b, N b, S b) => a -> b
-c3 :: C a b => forall a1. a1 -> b
+c3 :: C a b => forall a. a -> b
 c4 :: C a b => forall a1. a1 -> b
 -- imported via Control.Monad
 class Monad m => MonadPlus (m :: * -> *) where
@@ -69,7 +69,7 @@ class C a b where
   c4 :: a1 -> b
 c1 :: (C a b, N b) => a -> b
 c2 :: (C a b, N b, S b) => a -> b
-c3 :: C a b => forall a1. a1 -> b
+c3 :: C a b => forall a. a -> b
 c4 :: C a b => forall a1. a1 -> b
 :browse! T -- with -fprint-explicit-foralls
 -- defined locally
@@ -83,7 +83,7 @@ class C a b where
   c4 :: forall a1. a1 -> b
 c1 :: forall a b. (C a b, N b) => a -> b
 c2 :: forall a b. (C a b, N b, S b) => a -> b
-c3 :: forall a b. C a b => forall a1. a1 -> b
+c3 :: forall a b. C a b => forall a. a -> b
 c4 :: forall a b. C a b => forall a1. a1 -> b
 -- test :browse! <target> relative to different contexts
 :browse! Ghci025C -- from *Ghci025C>
diff --git a/testsuite/tests/ghci/scripts/ghci031.stdout b/testsuite/tests/ghci/scripts/ghci031.stdout
index d90cc7aa0078..796433e1b79a 100644
--- a/testsuite/tests/ghci/scripts/ghci031.stdout
+++ b/testsuite/tests/ghci/scripts/ghci031.stdout
@@ -1 +1,3 @@
-data Eq a => D a = C a 	-- Defined at ghci031.hs:7:1
+type role D nominal
+data Eq a => D a = C a
+  	-- Defined at ghci031.hs:7:1
diff --git a/testsuite/tests/ghci/scripts/ghci034.stderr b/testsuite/tests/ghci/scripts/ghci034.stderr
index 00bf3dfb67b8..1983b7dd7e09 100644
--- a/testsuite/tests/ghci/scripts/ghci034.stderr
+++ b/testsuite/tests/ghci/scripts/ghci034.stderr
@@ -1,2 +1,2 @@
 
-Top level: Not in scope: ‛thisIsNotDefined’
+Top level: Not in scope: ‘thisIsNotDefined’
diff --git a/testsuite/tests/ghci/scripts/ghci036.stderr b/testsuite/tests/ghci/scripts/ghci036.stderr
index e15b1959accc..7e1ac73e101b 100644
--- a/testsuite/tests/ghci/scripts/ghci036.stderr
+++ b/testsuite/tests/ghci/scripts/ghci036.stderr
@@ -1,16 +1,16 @@
 
-<interactive>:1:1: Not in scope: ‛nubBy’
+<interactive>:1:1: Not in scope: ‘nubBy’
 
-<interactive>:1:1: Not in scope: ‛nub’
+<interactive>:1:1: Not in scope: ‘nub’
 
-<interactive>:1:1: Not in scope: ‛nubBy’
+<interactive>:1:1: Not in scope: ‘nubBy’
 
-<interactive>:1:1: Not in scope: ‛nub’
+<interactive>:1:1: Not in scope: ‘nub’
 
 <interactive>:1:1:
-    Not in scope: ‛nub’
-    Perhaps you meant ‛L.nub’ (imported from Data.List)
+    Not in scope: ‘nub’
+    Perhaps you meant ‘L.nub’ (imported from Data.List)
 
-<interactive>:1:1: Not in scope: ‛L.nub’
+<interactive>:1:1: Not in scope: ‘L.nub’
 
-<interactive>:1:1: Not in scope: ‛nub’
+<interactive>:1:1: Not in scope: ‘nub’
diff --git a/testsuite/tests/ghci/scripts/ghci038.stderr b/testsuite/tests/ghci/scripts/ghci038.stderr
index bb2fb850c8ca..d0b562726c2e 100644
--- a/testsuite/tests/ghci/scripts/ghci038.stderr
+++ b/testsuite/tests/ghci/scripts/ghci038.stderr
@@ -1,4 +1,4 @@
 
-<interactive>:1:1: Not in scope: ‛map’
+<interactive>:1:1: Not in scope: ‘map’
 
-<interactive>:1:1: Not in scope: ‛x’
+<interactive>:1:1: Not in scope: ‘x’
diff --git a/testsuite/tests/ghci/scripts/ghci044.script b/testsuite/tests/ghci/scripts/ghci044.script
index 7af66bb9352f..d6f12ada6ebc 100644
--- a/testsuite/tests/ghci/scripts/ghci044.script
+++ b/testsuite/tests/ghci/scripts/ghci044.script
@@ -1,10 +1,15 @@
 --Testing flexible and Overlapping instances
-class C a where { f :: a -> Int; f _ = 3 }
-instance C Int where { f = id }
-instance C [Int]
+class C a where { f :: a -> String; f _ = "Default" }
+instance C Int where { f _ = "Zeroth" }
 :set -XFlexibleInstances
-instance C [Int]
-instance C a => C [a] where f xs = length xs
--- ***This should be an overlapping instances error!***
-:set -XOverlappingInstances
-instance C a => C [a] where f xs = length xs
+instance C [Int] where f _ = "First"
+f [3::Int]
+instance C a => C [a] where f xs = "Second"
+f [4::Int]  -- ***This should be an overlapping instances error!***
+instance {-# OVERLAPPABLE #-} C a => C [a] where f xs = "Third"
+f [5::Int]  -- Should be fine
+instance {-# OVERLAPPABLE #-} C a => C [a] where f xs = "Fourth"
+f [6::Int]  -- Should be fine too, overrides
+instance C Bool where { f _ = "Bool" }
+f [True]  -- Should be fine too, overrides
+
diff --git a/testsuite/tests/ghci/scripts/ghci044.stderr b/testsuite/tests/ghci/scripts/ghci044.stderr
index 173e39aca489..9bc8df999454 100644
--- a/testsuite/tests/ghci/scripts/ghci044.stderr
+++ b/testsuite/tests/ghci/scripts/ghci044.stderr
@@ -1,13 +1,8 @@
 
-<interactive>:5:10:
-    Illegal instance declaration for ‛C [Int]’
-      (All instance types must be of the form (T a1 ... an)
-       where a1 ... an are *distinct type variables*,
-       and each type variable appears at most once in the instance head.
-       Use FlexibleInstances if you want to disable this.)
-    In the instance declaration for ‛C [Int]’
-
-<interactive>:7:10:
-    Overlapping instance declarations:
-      instance C [Int] -- Defined at <interactive>:7:10
+<interactive>:9:1:
+    Overlapping instances for C [Int] arising from a use of ‘f’
+    Matching instances:
+      instance C [Int] -- Defined at <interactive>:6:10
       instance C a => C [a] -- Defined at <interactive>:8:10
+    In the expression: f [4 :: Int]
+    In an equation for ‘it’: it = f [4 :: Int]
diff --git a/testsuite/tests/ghci/scripts/ghci044.stdout b/testsuite/tests/ghci/scripts/ghci044.stdout
new file mode 100644
index 000000000000..eadd22f710fa
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/ghci044.stdout
@@ -0,0 +1,4 @@
+"First"
+"First"
+"First"
+"Fourth"
diff --git a/testsuite/tests/ghci/scripts/ghci044a.hs b/testsuite/tests/ghci/scripts/ghci044a.hs
new file mode 100644
index 000000000000..ac400d3ef99d
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/ghci044a.hs
@@ -0,0 +1,9 @@
+--Testing flexible and Overlapping instances
+class C a where { f :: a -> String; f _ = 3 }
+instance C Int where { f = id }
+:set -XFlexibleInstances
+instance C [Int] where f _ = "First"
+f [3::Int]
+-- Should override the identical one preceding
+instance C [Int] where f _ = "Second"
+f [3::Int]
diff --git a/testsuite/tests/ghci/scripts/ghci044a.script b/testsuite/tests/ghci/scripts/ghci044a.script
new file mode 100644
index 000000000000..d78c5c25bc8b
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/ghci044a.script
@@ -0,0 +1,9 @@
+--Testing flexible and Overlapping instances
+class C a where { f :: a -> String; f _ = "Default" }
+instance C Int where { f _ = "Zeroth" }
+:set -XFlexibleInstances
+instance C [Int] where f _ = "First"
+f [3::Int]
+-- Should override the identical one preceding
+instance C [Int] where f _ = "Second"
+f [3::Int]
diff --git a/testsuite/tests/ghci/scripts/ghci044a.stdout b/testsuite/tests/ghci/scripts/ghci044a.stdout
new file mode 100644
index 000000000000..fe475f4745de
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/ghci044a.stdout
@@ -0,0 +1,2 @@
+"First"
+"Second"
diff --git a/testsuite/tests/ghci/scripts/ghci047.script b/testsuite/tests/ghci/scripts/ghci047.script
index 49d93047f62a..70cc5181d8b9 100644
--- a/testsuite/tests/ghci/scripts/ghci047.script
+++ b/testsuite/tests/ghci/scripts/ghci047.script
@@ -1,7 +1,6 @@
 --Testing GADTs, type families as well as a ton of crazy type stuff
 :set -XGADTs
 :set -XTypeFamilies
-:set -XOverlappingInstances
 :set -XFunctionalDependencies
 :set -XFlexibleContexts
 :set -XFlexibleInstances
@@ -22,8 +21,9 @@ data HTrue
 data HFalse
 
 class TypeEq x y b | x y -> b
-instance (HTrue ~ b)  => TypeEq x x b
-instance (HFalse ~ b) => TypeEq x y b
+instance {-# OVERLAPS #-} (HTrue ~ b)  => TypeEq x x b
+instance {-# OVERLAPS #-} (HTrue ~ b)  => TypeEq x x b
+instance {-# OVERLAPS #-} (HFalse ~ b) => TypeEq x y b
 
 type family Or a b
 type instance Or HTrue  HTrue  = HTrue
diff --git a/testsuite/tests/ghci/scripts/ghci047.stderr b/testsuite/tests/ghci/scripts/ghci047.stderr
index c888b0492cac..dc8dfc9ecbbb 100644
--- a/testsuite/tests/ghci/scripts/ghci047.stderr
+++ b/testsuite/tests/ghci/scripts/ghci047.stderr
@@ -1,16 +1,16 @@
 
 <interactive>:38:1:
-    Couldn't match type ‛HFalse’ with ‛HTrue’
+    Couldn't match type ‘HFalse’ with ‘HTrue’
     Expected type: HTrue
       Actual type: Or HFalse HFalse
     In the expression: f
     In the expression: f $ Baz 'a'
-    In an equation for ‛it’: it = f $ Baz 'a'
+    In an equation for ‘it’: it = f $ Baz 'a'
 
 <interactive>:39:1:
-    Couldn't match type ‛HFalse’ with ‛HTrue’
+    Couldn't match type ‘HFalse’ with ‘HTrue’
     Expected type: HTrue
       Actual type: Or HFalse HFalse
     In the expression: f
     In the expression: f $ Quz
-    In an equation for ‛it’: it = f $ Quz
+    In an equation for ‘it’: it = f $ Quz
diff --git a/testsuite/tests/ghci/scripts/ghci048.stderr b/testsuite/tests/ghci/scripts/ghci048.stderr
index 3809db88e2df..1b96e5da075a 100644
--- a/testsuite/tests/ghci/scripts/ghci048.stderr
+++ b/testsuite/tests/ghci/scripts/ghci048.stderr
@@ -1,10 +1,10 @@
 
 <interactive>:4:16:
-    Multiple declarations of ‛A’
+    Multiple declarations of ‘A’
     Declared at: <interactive>:4:12
                  <interactive>:4:16
 
 <interactive>:6:16:
-    Multiple declarations of ‛A’
+    Multiple declarations of ‘A’
     Declared at: <interactive>:6:12
                  <interactive>:6:16
diff --git a/testsuite/tests/ghci/scripts/ghci050.stderr b/testsuite/tests/ghci/scripts/ghci050.stderr
index 191bf3cf6e2e..4c8de9da4e52 100644
--- a/testsuite/tests/ghci/scripts/ghci050.stderr
+++ b/testsuite/tests/ghci/scripts/ghci050.stderr
@@ -1,8 +1,8 @@
 
 <interactive>:6:49:
-    Couldn't match expected type ‛ListableElem (a, a)’
-                with actual type ‛a’
-      ‛a’ is a rigid type variable bound by
+    Couldn't match expected type ‘ListableElem (a, a)’
+                with actual type ‘a’
+      ‘a’ is a rigid type variable bound by
           the instance declaration at <interactive>:6:10
     Relevant bindings include
       b :: a (bound at <interactive>:6:43)
diff --git a/testsuite/tests/ghci/scripts/ghci051.stderr b/testsuite/tests/ghci/scripts/ghci051.stderr
index 363eeb11f622..327188f42a01 100644
--- a/testsuite/tests/ghci/scripts/ghci051.stderr
+++ b/testsuite/tests/ghci/scripts/ghci051.stderr
@@ -1,10 +1,10 @@
 
 <interactive>:7:9:
-    Couldn't match type ‛T’
-                  with ‛Ghci1.T’
-    NB: ‛T’ is defined at <interactive>:6:1-16
-        ‛Ghci1.T’ is defined at <interactive>:3:1-14
+    Couldn't match type ‘T’
+                  with ‘Ghci1.T’
+    NB: ‘T’ is defined at <interactive>:6:1-16
+        ‘Ghci1.T’ is defined at <interactive>:3:1-14
     Expected type: T'
       Actual type: T
     In the expression: C :: T'
-    In an equation for ‛c’: c = C :: T'
+    In an equation for ‘c’: c = C :: T'
diff --git a/testsuite/tests/ghci/scripts/ghci052.stderr b/testsuite/tests/ghci/scripts/ghci052.stderr
index a653ea0cdd9c..b2b0c7613bc5 100644
--- a/testsuite/tests/ghci/scripts/ghci052.stderr
+++ b/testsuite/tests/ghci/scripts/ghci052.stderr
@@ -1,32 +1,32 @@
 
 <interactive>:9:4:
-    Couldn't match expected type ‛Ghci1.Planet’
-                with actual type ‛Planet’
-    NB: ‛Ghci1.Planet’ is defined at <interactive>:5:1-37
-        ‛Planet’ is defined at <interactive>:8:1-36
-    In the first argument of ‛pn’, namely ‛Mercury’
+    Couldn't match expected type ‘Ghci1.Planet’
+                with actual type ‘Planet’
+    NB: ‘Ghci1.Planet’ is defined at <interactive>:5:1-37
+        ‘Planet’ is defined at <interactive>:8:1-36
+    In the first argument of ‘pn’, namely ‘Mercury’
     In the expression: pn Mercury
 
 <interactive>:10:4:
-    Couldn't match expected type ‛Ghci1.Planet’
-                with actual type ‛Planet’
-    NB: ‛Ghci1.Planet’ is defined at <interactive>:5:1-37
-        ‛Planet’ is defined at <interactive>:8:1-36
-    In the first argument of ‛pn’, namely ‛Venus’
+    Couldn't match expected type ‘Ghci1.Planet’
+                with actual type ‘Planet’
+    NB: ‘Ghci1.Planet’ is defined at <interactive>:5:1-37
+        ‘Planet’ is defined at <interactive>:8:1-36
+    In the first argument of ‘pn’, namely ‘Venus’
     In the expression: pn Venus
 
 <interactive>:11:4:
-    Couldn't match expected type ‛Ghci1.Planet’
-                with actual type ‛Planet’
-    NB: ‛Ghci1.Planet’ is defined at <interactive>:5:1-37
-        ‛Planet’ is defined at <interactive>:8:1-36
-    In the first argument of ‛pn’, namely ‛Mars’
+    Couldn't match expected type ‘Ghci1.Planet’
+                with actual type ‘Planet’
+    NB: ‘Ghci1.Planet’ is defined at <interactive>:5:1-37
+        ‘Planet’ is defined at <interactive>:8:1-36
+    In the first argument of ‘pn’, namely ‘Mars’
     In the expression: pn Mars
 
 <interactive>:13:44:
-    Couldn't match expected type ‛Planet’
-                with actual type ‛Ghci1.Planet’
-    NB: ‛Planet’ is defined at <interactive>:8:1-36
-        ‛Ghci1.Planet’ is defined at <interactive>:5:1-37
+    Couldn't match expected type ‘Planet’
+                with actual type ‘Ghci1.Planet’
+    NB: ‘Planet’ is defined at <interactive>:8:1-36
+        ‘Ghci1.Planet’ is defined at <interactive>:5:1-37
     In the pattern: Earth
-    In an equation for ‛pn’: pn Earth = "E"
+    In an equation for ‘pn’: pn Earth = "E"
diff --git a/testsuite/tests/ghci/scripts/ghci053.stderr b/testsuite/tests/ghci/scripts/ghci053.stderr
index 6ea05924d991..2d91a51d21b0 100644
--- a/testsuite/tests/ghci/scripts/ghci053.stderr
+++ b/testsuite/tests/ghci/scripts/ghci053.stderr
@@ -1,16 +1,16 @@
 
 <interactive>:10:12:
-    Couldn't match expected type ‛Ghci1.Planet’
-                with actual type ‛Planet’
-    NB: ‛Ghci1.Planet’ is defined at <interactive>:5:1-49
-        ‛Planet’ is defined at <interactive>:8:1-41
-    In the second argument of ‛(==)’, namely ‛Mercury’
+    Couldn't match expected type ‘Ghci1.Planet’
+                with actual type ‘Planet’
+    NB: ‘Ghci1.Planet’ is defined at <interactive>:5:1-49
+        ‘Planet’ is defined at <interactive>:8:1-41
+    In the second argument of ‘(==)’, namely ‘Mercury’
     In the expression: mercury == Mercury
 
 <interactive>:12:10:
-    Couldn't match expected type ‛Planet’
-                with actual type ‛Ghci1.Planet’
-    NB: ‛Planet’ is defined at <interactive>:8:1-41
-        ‛Ghci1.Planet’ is defined at <interactive>:5:1-49
-    In the second argument of ‛(==)’, namely ‛Earth’
+    Couldn't match expected type ‘Planet’
+                with actual type ‘Ghci1.Planet’
+    NB: ‘Planet’ is defined at <interactive>:8:1-41
+        ‘Ghci1.Planet’ is defined at <interactive>:5:1-49
+    In the second argument of ‘(==)’, namely ‘Earth’
     In the expression: Venus == Earth
diff --git a/testsuite/tests/ghci/scripts/ghci057.stderr b/testsuite/tests/ghci/scripts/ghci057.stderr
index e26f15e1a939..089704d9b4eb 100644
--- a/testsuite/tests/ghci/scripts/ghci057.stderr
+++ b/testsuite/tests/ghci/scripts/ghci057.stderr
@@ -1,19 +1,19 @@
 
 <interactive>:5:1:
-    Illegal generalised algebraic data declaration for ‛T’
+    Illegal generalised algebraic data declaration for ‘T’
       (Use GADTs to allow GADTs)
-    In the data declaration for ‛T’
+    In the data declaration for ‘T’
 
 ghci057.hs:3:3:
-    Data constructor ‛C’ has existential type variables, a context, or a specialised result type
+    Data constructor ‘C’ has existential type variables, a context, or a specialised result type
       C :: T Int
       (Use ExistentialQuantification or GADTs to allow this)
-    In the definition of data constructor ‛C’
-    In the data declaration for ‛T’
+    In the definition of data constructor ‘C’
+    In the data declaration for ‘T’
 
 ghci057.hs:3:3:
-    Data constructor ‛C’ has existential type variables, a context, or a specialised result type
+    Data constructor ‘C’ has existential type variables, a context, or a specialised result type
       C :: T Int
       (Use ExistentialQuantification or GADTs to allow this)
-    In the definition of data constructor ‛C’
-    In the data declaration for ‛T’
+    In the definition of data constructor ‘C’
+    In the data declaration for ‘T’
diff --git a/testsuite/tests/ghci/scripts/ghci059.script b/testsuite/tests/ghci/scripts/ghci059.script
new file mode 100644
index 000000000000..936277e336c9
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/ghci059.script
@@ -0,0 +1,6 @@
+-- At one point, :info Coercible would not report it as a constraint, but as a
+-- data type. So this test case ensures that this is broken later.
+
+:m + Data.Coerce
+:info Coercible
+:info coerce
diff --git a/testsuite/tests/ghci/scripts/ghci059.stdout b/testsuite/tests/ghci/scripts/ghci059.stdout
new file mode 100644
index 000000000000..ffc893f363d8
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/ghci059.stdout
@@ -0,0 +1,6 @@
+type role Coercible representational representational
+class Coercible (a :: k) (b :: k)
+  	-- Defined in ‘GHC.Types’
+coerce ::
+  forall (k :: BOX) (a :: k) (b :: k). Coercible a b => a -> b
+  	-- Defined in ‘GHC.Prim’
diff --git a/testsuite/tests/haddock/haddock_examples/haddock.Test.stderr b/testsuite/tests/haddock/haddock_examples/haddock.Test.stderr
index 37a2565a4e55..7ce82d006741 100644
--- a/testsuite/tests/haddock/haddock_examples/haddock.Test.stderr
+++ b/testsuite/tests/haddock/haddock_examples/haddock.Test.stderr
@@ -17,51 +17,75 @@ hidden a = a
 [3 of 3] Compiling Test             ( Test.hs, Test.o )
 
 ==================== Parser ====================
-<document comment>
+
+ Module      :  Test
+ Copyright   :  (c) Simon Marlow 2002
+ License     :  BSD-style
+ 
+ Maintainer  :  libraries@haskell.org
+ Stability   :  provisional
+ Portability :  portable
+
+ This module illustrates & tests most of the features of Haddock.
+ Testing references from the description: 'T', 'f', 'g', 'Visible.visible'.
+
 module Test (
         <IEGroup: 1>, <IEGroup: 2>, T(..), T2, T3(..), T4(..), T5(..),
         T6(..), N1(..), N2(..), N3(..), N4, N5(..), N6(..), N7(..),
-        <IEGroup: 2>, R(..), R1(..), <document comment>, p, q, u,
-        <IEGroup: 1>, C(a, b), D(..), E, F(..), <document comment>, a,
+        <IEGroup: 2>, R(..), R1(..),
+         test that we can export record selectors on their own:, p, q, u,
+        <IEGroup: 1>, C(a, b), D(..), E, F(..),
+         Test that we can export a class method on its own:, a,
         <IEGroup: 1>, f, g, <IEGroup: 1>, <IEDocNamed: aux1>,
         <IEDocNamed: aux2>, <IEDocNamed: aux3>, <IEDocNamed: aux4>,
         <IEDocNamed: aux5>, <IEDocNamed: aux6>, <IEDocNamed: aux7>,
         <IEDocNamed: aux8>, <IEDocNamed: aux9>, <IEDocNamed: aux10>,
-        <IEDocNamed: aux11>, <IEDocNamed: aux12>, <document comment>,
+        <IEDocNamed: aux11>, <IEDocNamed: aux12>,
+         This is some inline documentation in the export list
+
+ > a code block using bird-tracks
+ > each line must begin with > (which isn't significant unless it
+ > is at the beginning of the line).,
         <IEGroup: 1>, module Hidden, <IEGroup: 1>, module Visible,
-        <document comment>, <IEGroup: 1>, Ex(..), <IEGroup: 1>, k, l, m, o,
-        <IEGroup: 1>, <IEGroup: 2>, <document comment>, f'
+         nested-style doc comments , <IEGroup: 1>, Ex(..), <IEGroup: 1>, k,
+        l, m, o, <IEGroup: 1>, <IEGroup: 2>,
+        
+ > a literal line
+
+ $ a non /literal/ line $
+, f'
     ) where
 import Hidden
 import Visible
 <document comment>
 data T a b
-  = <document comment> A Int (Maybe Float) |
-    <document comment> B (T a b, T Int Float)
+  =  This comment describes the 'A' constructor A Int (Maybe Float) |
+     This comment describes the 'B' constructor B (T a b, T Int Float)
 <document comment>
 data T2 a b = T2 a b
 <document comment>
 data T3 a b = A1 a | B1 b
 data T4 a b = A2 a | B2 b
-data T5 a b = <document comment> A3 a | <document comment> B3 b
+data T5 a b =  documents 'A3' A3 a |  documents 'B3' B3 b
 <document comment>
 data T6
-  = <document comment> A4 |
-    <document comment> B4 |
-    <document comment> C4
+  =  This is the doc for 'A4' A4 |
+     This is the doc for 'B4' B4 |
+     This is the doc for 'C4' C4
 <document comment>
 newtype N1 a = N1 a
 <document comment>
 newtype N2 a b = N2 {n :: a b}
 <document comment>
-newtype N3 a b = N3 {n3 :: a b <document comment>}
+newtype N3 a b = N3 {n3 :: a b  this is the 'n3' field }
 <document comment>
 newtype N4 a b = N4 a
-newtype N5 a b = N5 {n5 :: a b <document comment>}
-newtype N6 a b = <document comment> N6 {n6 :: a b}
+newtype N5 a b
+  = N5 {n5 :: a b  no docs on the datatype or the constructor}
+newtype N6 a b =  docs on the constructor only N6 {n6 :: a b}
 <document comment>
-newtype N7 a b = <document comment> N7 {n7 :: a b}
-class D a => C a where
+newtype N7 a b =  The 'N7' constructor N7 {n7 :: a b}
+class (D a) => C a where
   a :: IO a
   b :: [a]
   c :: a
@@ -83,22 +107,22 @@ class F a where
   ff :: a
 <document comment>
 data R
-  = <document comment>
-    C1 {p :: Int <document comment>,
-        q :: forall a. a -> a <document comment>,
-        r :: Int <document comment>,
-        s :: Int <document comment>} |
-    <document comment>
+  =  This is the 'C1' record constructor, with the following fields:
+    C1 {p :: Int  This comment applies to the 'p' field,
+        q :: forall a. a -> a  This comment applies to the 'q' field,
+        r :: Int  This comment applies to both 'r' and 's',
+        s :: Int  This comment applies to both 'r' and 's'} |
+     This is the 'C2' record constructor, also with some fields:
     C2 {t :: T1
              -> (T2 Int Int) -> (T3 Bool Bool) -> (T4 Float Float) -> T5 () (),
         u :: Int,
         v :: Int}
 <document comment>
 data R1
-  = <document comment>
-    C3 {s1 :: Int <document comment>,
-        s2 :: Int <document comment>,
-        s3 :: Int <document comment>}
+  =  This is the 'C3' record constructor
+    C3 {s1 :: Int  The 's1' record selector,
+        s2 :: Int  The 's2' record selector,
+        s3 :: Int  The 's3' record selector}
 <document comment>
 <document comment>
 <document comment>
@@ -129,19 +153,26 @@ data Ex a
     Ex4 (forall a. a -> a)
 <document comment>
 k ::
-  T () () <document comment>
-  -> (T2 Int Int) <document comment>
-     -> (T3 Bool Bool -> T4 Float Float) <document comment>
-        -> T5 () () <document comment> -> IO () <document comment>
-l :: (Int, Int, Float) <document comment> -> Int <document comment>
-<document comment>
-m :: R -> N1 () <document comment> -> IO Int <document comment>
-<document comment>
-newn :: R <document comment> -> N1 () <document comment> -> IO Int
+  T () ()  This argument has type 'T'
+  -> (T2 Int Int)  This argument has type 'T2 Int Int'
+     -> (T3 Bool Bool
+         -> T4 Float Float)  This argument has type @T3 Bool Bool -> T4 Float Float@
+        -> T5 () ()  This argument has a very long description that should
+ hopefully cause some wrapping to happen when it is finally
+ rendered by Haddock in the generated HTML page.
+           -> IO ()  This is the result type
+l :: (Int, Int, Float)  takes a triple -> Int  returns an 'Int'
+<document comment>
+m ::
+  R -> N1 ()  one of the arguments -> IO Int  and the return value
+<document comment>
+newn ::
+  R  one of the arguments, an 'R'
+  -> N1 ()  one of the arguments -> IO Int
 newn = undefined
 <document comment>
 foreign import ccall unsafe "static header.h o" o
-  :: Float <document comment> -> IO Float <document comment>
+  :: Float  The input float -> IO Float  The output float
 <document comment>
 newp :: Int
 newp = undefined
@@ -157,10 +188,10 @@ m = undefined
 
 
 
-Test.hs:32:9: Warning: ‛p’ is exported by ‛p’ and ‛R(..)’
+Test.hs:32:9: Warning: ‘p’ is exported by ‘p’ and ‘R(..)’
 
-Test.hs:32:12: Warning: ‛q’ is exported by ‛q’ and ‛R(..)’
+Test.hs:32:12: Warning: ‘q’ is exported by ‘q’ and ‘R(..)’
 
-Test.hs:32:15: Warning: ‛u’ is exported by ‛u’ and ‛R(..)’
+Test.hs:32:15: Warning: ‘u’ is exported by ‘u’ and ‘R(..)’
 
-Test.hs:38:9: Warning: ‛a’ is exported by ‛a’ and ‛C(a, b)’
+Test.hs:38:9: Warning: ‘a’ is exported by ‘a’ and ‘C(a, b)’
diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA014.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA014.stderr
index f71f89a89e2b..a70f6242781b 100644
--- a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA014.stderr
+++ b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA014.stderr
@@ -1,6 +1,6 @@
 
 ==================== Parser ====================
-<document comment>
+ a header
 module HeaderTest where
 <document comment>
 x = 0
diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA015.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA015.stderr
index 356d5b73bfb3..3bfc17d811c9 100644
--- a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA015.stderr
+++ b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA015.stderr
@@ -1,6 +1,6 @@
 
 ==================== Parser ====================
-<document comment>
+ a header
 module HeaderTest where
 <document comment>
 x = 0
diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA016.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA016.stderr
index 1f436a7bec60..48dd0870c9bd 100644
--- a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA016.stderr
+++ b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA016.stderr
@@ -1,6 +1,6 @@
 
 ==================== Parser ====================
-<document comment>
+Module description
 module A where
 
 
diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA018.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA018.stderr
index 1f436a7bec60..2aa5245f50b2 100644
--- a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA018.stderr
+++ b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA018.stderr
@@ -1,6 +1,6 @@
 
 ==================== Parser ====================
-<document comment>
+ module header bla bla 
 module A where
 
 
diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA019.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA019.stderr
index 68e7b4f2259c..ca316bc8b87c 100644
--- a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA019.stderr
+++ b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA019.stderr
@@ -1,7 +1,7 @@
 
 ==================== Parser ====================
 module A (
-	<document comment>, <document comment>
+         bla bla,  blabla 
     ) where
 
 
diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA020.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA020.stderr
index 20c628006d16..2aaa3eba987c 100644
--- a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA020.stderr
+++ b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA020.stderr
@@ -1,7 +1,7 @@
 
 ==================== Parser ====================
 module A (
-	<document comment>, <document comment>, x, <IEGroup: 2>, <document comment>
+         bla bla,  blabla , x, <IEGroup: 2>,  qweljqwelkqjwelqjkq
     ) where
 x = True
 
diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA021.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA021.stderr
index edf523dfa2cd..162c403b84b7 100644
--- a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA021.stderr
+++ b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA021.stderr
@@ -1,8 +1,8 @@
 
 ==================== Parser ====================
 module A (
-	<document comment>, <document comment>, x, <IEGroup: 2>, <document comment>, y,
-	<document comment>, z, <IEGroup: 1>
+         bla bla,  blabla , x, <IEGroup: 2>,  qweljqwelkqjwelqjkq, y,
+         dkashdakj, z, <IEGroup: 1>
     ) where
 x = True
 y = False
diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA023.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA023.stderr
index 2c4f5bc9528a..2bb1a178e0c7 100644
--- a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA023.stderr
+++ b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA023.stderr
@@ -1,10 +1,7 @@
-
-==================== Parser ====================
-module ShouldCompile where
-test ::
-  Eq a =>
-  [a] <document comment>
-  -> [a] <document comment> -> [a] <document comment>
-test xs ys = xs
-
-
+
+==================== Parser ====================
+module ShouldCompile where
+test :: (Eq a) => [a]  doc1  -> [a]  doc2  -> [a]  doc3
+test xs ys = xs
+
+
diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA024.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA024.stderr
index f0d269d0b1ec..b3caa71b9e6e 100644
--- a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA024.stderr
+++ b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA024.stderr
@@ -1,7 +1,7 @@
 
 ==================== Parser ====================
 module ShouldCompile where
-test2 :: a <document comment> -> b <document comment> -> a <document comment>
+test2 :: a  doc1  -> b  doc2  -> a  doc 3 
 test2 x y = x
 
 
diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA025.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA025.stderr
index 792da551558e..472ec1a1ebfd 100644
--- a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA025.stderr
+++ b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA025.stderr
@@ -1,7 +1,7 @@
 
 ==================== Parser ====================
 module ShouldCompile where
-test2 :: a <document comment> -> a
+test2 :: a  doc1  -> a
 test2 x = x
 
 
diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA026.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA026.stderr
index e352980fd4a0..4a57879c5c50 100644
--- a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA026.stderr
+++ b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA026.stderr
@@ -1,10 +1,7 @@
-
-==================== Parser ====================
-module ShouldCompile where
-test ::
-  Eq a =>
-  [a] <document comment>
-  -> forall b. [b] <document comment> -> [a] <document comment>
-test xs ys = xs
-
-
+
+==================== Parser ====================
+module ShouldCompile where
+test :: (Eq a) => [a]  doc1  -> forall b. [b]  doc2  -> [a]  doc3
+test xs ys = xs
+
+
diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA027.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA027.stderr
index 67bf6528c0df..d1cb709c5555 100644
--- a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA027.stderr
+++ b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA027.stderr
@@ -1,11 +1,10 @@
-
-==================== Parser ====================
-module ShouldCompile where
-test ::
-  [a] <document comment>
-  -> forall b. Ord b =>
-     [b] <document comment>
-     -> forall c. Num c => [c] <document comment> -> [a]
-test xs ys zs = xs
-
-
+
+==================== Parser ====================
+module ShouldCompile where
+test ::
+  [a]  doc1 
+  -> forall b. (Ord b) =>
+     [b]  doc2  -> forall c. (Num c) => [c]  doc3 -> [a]
+test xs ys zs = xs
+
+
diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA028.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA028.stderr
index 6d9a8b2181b1..fa0d7019c0cb 100644
--- a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA028.stderr
+++ b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA028.stderr
@@ -2,8 +2,7 @@
 ==================== Parser ====================
 module ShouldCompile where
 data (<-->) a b = Mk a b
-test ::
-  [a] <document comment> -> (a <--> (b -> [a])) <document comment>
+test :: [a]  doc1  -> (a <--> (b -> [a]))  blabla
 test xs ys = xs
 
 
diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA029.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA029.stderr
index aa48d998efe1..820ffa67084c 100644
--- a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA029.stderr
+++ b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA029.stderr
@@ -1,6 +1,7 @@
 
 ==================== Parser ====================
 module ShouldCompile where
-data A = <document comment> A | B | C | D
+data A
+  =  A comment that documents the first constructor A | B | C | D
 
 
diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA030.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA030.stderr
index c879d2244b01..b0ef1391999d 100644
--- a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA030.stderr
+++ b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA030.stderr
@@ -1,6 +1,7 @@
 
 ==================== Parser ====================
 module ShouldCompile where
-data A = <document comment> A | <document comment> B | <document comment> C | D
+data A
+  =  comment for A  A |  comment for B  B |  comment for C   C | D
 
 
diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA031.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA031.stderr
index 75ac2945b8e9..1d033cd6d715 100644
--- a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA031.stderr
+++ b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA031.stderr
@@ -1,9 +1,9 @@
-
-==================== Parser ====================
-module ShouldCompile where
-data A
-    = A |
-      <document comment> forall a. B a a |
-      <document comment> forall a. Num a => C a
-
-
+
+==================== Parser ====================
+module ShouldCompile where
+data A
+  = A |
+     comment for B  forall a. B a a |
+     comment for C  forall a. Num a => C a
+
+
diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA032.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA032.stderr
index 2b0e4d24af79..5cf2d9b034b7 100644
--- a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA032.stderr
+++ b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA032.stderr
@@ -2,9 +2,9 @@
 ==================== Parser ====================
 module ShouldCompile where
 data R a
-    = R {field1 :: a,
-	 field2 :: a <document comment>,
-	 field3 :: a <document comment>,
-	 field4 :: a <document comment>}
+  = R {field1 :: a,
+       field2 :: a  comment for field2,
+       field3 :: a  comment for field3,
+       field4 :: a  comment for field4 }
 
 
diff --git a/testsuite/tests/haddock/should_fail_flag_haddock/haddockE004.stderr b/testsuite/tests/haddock/should_fail_flag_haddock/haddockE004.stderr
index ace4e814f7c3..efd20d2ed1b8 100644
--- a/testsuite/tests/haddock/should_fail_flag_haddock/haddockE004.stderr
+++ b/testsuite/tests/haddock/should_fail_flag_haddock/haddockE004.stderr
@@ -1,2 +1,2 @@
 
-haddockE004.hs:3:1: parse error on input ‛main’
+haddockE004.hs:3:1: parse error on input ‘main’
diff --git a/testsuite/tests/indexed-types/should_compile/Class3.stderr b/testsuite/tests/indexed-types/should_compile/Class3.stderr
index bf288df7f5d5..2616c2e3f54b 100644
--- a/testsuite/tests/indexed-types/should_compile/Class3.stderr
+++ b/testsuite/tests/indexed-types/should_compile/Class3.stderr
@@ -1,5 +1,5 @@
 
 Class3.hs:7:10: Warning:
     No explicit implementation for
-      ‛foo’
-    In the instance declaration for ‛C ()’
+      ‘foo’
+    In the instance declaration for ‘C ()’
diff --git a/testsuite/tests/indexed-types/should_compile/ColInference6.hs b/testsuite/tests/indexed-types/should_compile/ColInference6.hs
index 9273632e2bc5..bc15aa1dbfe9 100644
--- a/testsuite/tests/indexed-types/should_compile/ColInference6.hs
+++ b/testsuite/tests/indexed-types/should_compile/ColInference6.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeFamilies, FlexibleContexts #-}
 
 module ColInference6  where 
 
diff --git a/testsuite/tests/indexed-types/should_compile/Gentle.hs b/testsuite/tests/indexed-types/should_compile/Gentle.hs
index 6cc1512a1f3c..7ceedfd09866 100644
--- a/testsuite/tests/indexed-types/should_compile/Gentle.hs
+++ b/testsuite/tests/indexed-types/should_compile/Gentle.hs
@@ -1,6 +1,6 @@
 {-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies,
              FlexibleInstances,
-             OverlappingInstances, UndecidableInstances #-}
+             UndecidableInstances #-}
 
 -- Rather exotic example posted to Haskell mailing list 17 Oct 07
 -- It concerns context reduction and functional dependencies
diff --git a/testsuite/tests/indexed-types/should_compile/IndTypesPerf.hs b/testsuite/tests/indexed-types/should_compile/IndTypesPerf.hs
index 4edcd0398875..30c92c3a88c4 100644
--- a/testsuite/tests/indexed-types/should_compile/IndTypesPerf.hs
+++ b/testsuite/tests/indexed-types/should_compile/IndTypesPerf.hs
@@ -2,6 +2,8 @@
 -- This used lots of memory, and took a long time to compile, with GHC 6.12:
 -- http://www.haskell.org/pipermail/glasgow-haskell-users/2010-May/018835.html
 
+{-# LANGUAGE FlexibleContexts, TypeFamilies #-}
+
 module IndTypesPerf where
 
 import IndTypesPerfMerge
diff --git a/testsuite/tests/indexed-types/should_compile/IndTypesPerfMerge.hs b/testsuite/tests/indexed-types/should_compile/IndTypesPerfMerge.hs
index 18ed35bdc165..e37bfe323e87 100644
--- a/testsuite/tests/indexed-types/should_compile/IndTypesPerfMerge.hs
+++ b/testsuite/tests/indexed-types/should_compile/IndTypesPerfMerge.hs
@@ -1,7 +1,7 @@
 {-# LANGUAGE EmptyDataDecls, TypeFamilies, UndecidableInstances,
-             ScopedTypeVariables, OverlappingInstances, TypeOperators,
+             ScopedTypeVariables, TypeOperators,
              FlexibleInstances, NoMonomorphismRestriction,
-             MultiParamTypeClasses #-}
+             MultiParamTypeClasses, FlexibleContexts #-}
 module IndTypesPerfMerge where
 
 data a :* b = a :* b
diff --git a/testsuite/tests/indexed-types/should_compile/NonLinearLHS.hs b/testsuite/tests/indexed-types/should_compile/NonLinearLHS.hs
index dc0ae5392a68..26ea632a2913 100644
--- a/testsuite/tests/indexed-types/should_compile/NonLinearLHS.hs
+++ b/testsuite/tests/indexed-types/should_compile/NonLinearLHS.hs
@@ -1,6 +1,6 @@
 {-# LANGUAGE TypeFamilies, EmptyDataDecls, FlexibleContexts #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE FlexibleInstances, OverlappingInstances, UndecidableInstances #-}
+{-# LANGUAGE FlexibleInstances, UndecidableInstances #-}
 
 module NonLinearLHS where
 
diff --git a/testsuite/tests/indexed-types/should_compile/Simple14.stderr b/testsuite/tests/indexed-types/should_compile/Simple14.stderr
index ed94ad575439..e2275b41c954 100644
--- a/testsuite/tests/indexed-types/should_compile/Simple14.stderr
+++ b/testsuite/tests/indexed-types/should_compile/Simple14.stderr
@@ -1,18 +1,18 @@
 
 Simple14.hs:17:19:
-    Couldn't match type ‛z0’ with ‛m’
-      ‛z0’ is untouchable
+    Couldn't match type ‘z0’ with ‘m’
+      ‘z0’ is untouchable
         inside the constraints (Maybe m ~ Maybe n)
         bound by a type expected by the context:
                    Maybe m ~ Maybe n => EQ_ z0 z0
         at Simple14.hs:17:12-33
-      ‛m’ is a rigid type variable bound by
+      ‘m’ is a rigid type variable bound by
           the type signature for foo :: EQ_ (Maybe m) (Maybe n)
           at Simple14.hs:16:15
     Expected type: EQ_ z0 z0
       Actual type: EQ_ m n
     Relevant bindings include
       foo :: EQ_ (Maybe m) (Maybe n) (bound at Simple14.hs:17:1)
-    In the second argument of ‛eqE’, namely ‛(eqI :: EQ_ m n)’
-    In the first argument of ‛ntI’, namely ‛(`eqE` (eqI :: EQ_ m n))’
+    In the second argument of ‘eqE’, namely ‘(eqI :: EQ_ m n)’
+    In the first argument of ‘ntI’, namely ‘(`eqE` (eqI :: EQ_ m n))’
     In the expression: ntI (`eqE` (eqI :: EQ_ m n))
diff --git a/testsuite/tests/indexed-types/should_compile/Simple2.stderr b/testsuite/tests/indexed-types/should_compile/Simple2.stderr
index 9fd84024a18e..11ea628034c2 100644
--- a/testsuite/tests/indexed-types/should_compile/Simple2.stderr
+++ b/testsuite/tests/indexed-types/should_compile/Simple2.stderr
@@ -1,31 +1,31 @@
 
 Simple2.hs:21:1: Warning:
-    No explicit associated type or default declaration for ‛S3n’
-    In the instance declaration for ‛C3 Char’
+    No explicit associated type or default declaration for ‘S3n’
+    In the instance declaration for ‘C3 Char’
 
 Simple2.hs:21:10: Warning:
     No explicit implementation for
-      ‛foo3n’ and ‛bar3n’
-    In the instance declaration for ‛C3 Char’
+      ‘foo3n’ and ‘bar3n’
+    In the instance declaration for ‘C3 Char’
 
 Simple2.hs:29:1: Warning:
-    No explicit associated type or default declaration for ‛S3n’
-    In the instance declaration for ‛C3 Bool’
+    No explicit associated type or default declaration for ‘S3n’
+    In the instance declaration for ‘C3 Bool’
 
 Simple2.hs:29:10: Warning:
     No explicit implementation for
-      ‛foo3n’ and ‛bar3n’
-    In the instance declaration for ‛C3 Bool’
+      ‘foo3n’ and ‘bar3n’
+    In the instance declaration for ‘C3 Bool’
 
 Simple2.hs:39:1: Warning:
-    No explicit associated type or default declaration for ‛S3’
-    In the instance declaration for ‛C3 Float’
+    No explicit associated type or default declaration for ‘S3’
+    In the instance declaration for ‘C3 Float’
 
 Simple2.hs:39:1: Warning:
-    No explicit associated type or default declaration for ‛S3n’
-    In the instance declaration for ‛C3 Float’
+    No explicit associated type or default declaration for ‘S3n’
+    In the instance declaration for ‘C3 Float’
 
 Simple2.hs:39:10: Warning:
     No explicit implementation for
-      ‛foo3n’ and ‛bar3n’
-    In the instance declaration for ‛C3 Float’
+      ‘foo3n’ and ‘bar3n’
+    In the instance declaration for ‘C3 Float’
diff --git a/testsuite/tests/indexed-types/should_compile/T3017.stderr b/testsuite/tests/indexed-types/should_compile/T3017.stderr
index d11fad837711..a6c744a177a6 100644
--- a/testsuite/tests/indexed-types/should_compile/T3017.stderr
+++ b/testsuite/tests/indexed-types/should_compile/T3017.stderr
@@ -3,24 +3,17 @@ TYPE SIGNATURES
   test2 ::
     forall c t t1. (Coll c, Num t1, Num t, Elem c ~ (t, t1)) => c -> c
 TYPE CONSTRUCTORS
-  Coll :: * -> Constraint
-  class Coll c
-    Roles: [nominal]
-    RecFlag NonRecursive
-    type family Elem c :: * (open)
-    empty :: c insert :: Elem c -> c -> c
-  ListColl :: * -> *
-  data ListColl a
-    No C type associated
-    Roles: [representational]
-    RecFlag NonRecursive, Promotable
-    = L :: forall a. [a] -> ListColl a Stricts: _
-    FamilyInstance: none
+  class Coll c where
+    type family Elem c :: * open
+    empty :: c
+    insert :: Elem c -> c -> c
+  data ListColl a = L [a]
+    Promotable
 COERCION AXIOMS
   axiom Foo.TFCo:R:ElemListColl :: Elem (ListColl a) = a
 INSTANCES
   instance Coll (ListColl a) -- Defined at T3017.hs:12:11
 FAMILY INSTANCES
-  type Elem (ListColl a) -- Defined at T3017.hs:13:4
+  type Elem (ListColl a)
 Dependent modules: []
 Dependent packages: [base, ghc-prim, integer-gmp]
diff --git a/testsuite/tests/indexed-types/should_compile/T3208b.stderr b/testsuite/tests/indexed-types/should_compile/T3208b.stderr
index 228749247b1e..a210113ea87b 100644
--- a/testsuite/tests/indexed-types/should_compile/T3208b.stderr
+++ b/testsuite/tests/indexed-types/should_compile/T3208b.stderr
@@ -5,15 +5,15 @@ T3208b.hs:15:10:
       bound by the type signature for
                  fce' :: (OTerm a ~ STerm a, OBJECT a, SUBST a) => a -> c
       at T3208b.hs:14:9-56
-    NB: ‛STerm’ is a type function, and may not be injective
-    The type variable ‛o0’ is ambiguous
+    NB: ‘STerm’ is a type function, and may not be injective
+    The type variable ‘o0’ is ambiguous
     Expected type: STerm o0
       Actual type: OTerm o0
     Relevant bindings include
       f :: a (bound at T3208b.hs:15:6)
       fce' :: a -> c (bound at T3208b.hs:15:1)
     In the expression: fce (apply f)
-    In an equation for ‛fce'’: fce' f = fce (apply f)
+    In an equation for ‘fce'’: fce' f = fce (apply f)
 
 T3208b.hs:15:15:
     Could not deduce (OTerm o0 ~ STerm a)
@@ -21,10 +21,10 @@ T3208b.hs:15:15:
       bound by the type signature for
                  fce' :: (OTerm a ~ STerm a, OBJECT a, SUBST a) => a -> c
       at T3208b.hs:14:9-56
-    The type variable ‛o0’ is ambiguous
+    The type variable ‘o0’ is ambiguous
     Relevant bindings include
       f :: a (bound at T3208b.hs:15:6)
       fce' :: a -> c (bound at T3208b.hs:15:1)
-    In the first argument of ‛fce’, namely ‛(apply f)’
+    In the first argument of ‘fce’, namely ‘(apply f)’
     In the expression: fce (apply f)
-    In an equation for ‛fce'’: fce' f = fce (apply f)
+    In an equation for ‘fce'’: fce' f = fce (apply f)
diff --git a/testsuite/tests/indexed-types/should_compile/T4981-V3.hs b/testsuite/tests/indexed-types/should_compile/T4981-V3.hs
index fe810f265752..e6bcd471d9d6 100644
--- a/testsuite/tests/indexed-types/should_compile/T4981-V3.hs
+++ b/testsuite/tests/indexed-types/should_compile/T4981-V3.hs
@@ -1,44 +1,44 @@
-{-# LANGUAGE CPP, TypeFamilies, FlexibleContexts #-}
-module Class ( cleverNamedResolve ) where
-
-data FL p = FL p
-
-class PatchInspect p where
-instance PatchInspect p => PatchInspect (FL p) where
-
-type family PrimOf p
-type instance PrimOf (FL p) = PrimOf p
-
-data WithName prim = WithName prim
-
-instance PatchInspect prim => PatchInspect (WithName prim) where
-
-class (PatchInspect (PrimOf p)) => Conflict p where
-    resolveConflicts :: p -> PrimOf p
-
-instance Conflict p => Conflict (FL p) where
-    resolveConflicts = undefined
-
-type family OnPrim p
-
-joinPatches :: p -> p
-
-joinPatches = id
-
-cleverNamedResolve :: (Conflict (OnPrim p)
-                      ,PrimOf (OnPrim p) ~ WithName (PrimOf p))
-                   => p -> FL (OnPrim p) -> WithName (PrimOf p)
-cleverNamedResolve x = resolveConflicts . joinPatches
--- I added the parameter 'x' to make the signature unambiguous
--- I don't think that ambiguity is essential to the original problem
-
-{-
-resolveConflicts :: q -> PrimOf q
- (w) FL (OnPrim p) ~ q
- (w) WithName (PrimOf p) ~ PrimOf q
-==>
- (w) PrimOf (OnPrim p) ~ PrimOf (FL (OnPrim p))
-==>
- (w) PrimOf (OnPrim p) ~ PrimOf (OnPrim p)
-
--}
\ No newline at end of file
+{-# LANGUAGE CPP, TypeFamilies, FlexibleContexts #-}
+module Class ( cleverNamedResolve ) where
+
+data FL p = FL p
+
+class PatchInspect p where
+instance PatchInspect p => PatchInspect (FL p) where
+
+type family PrimOf p
+type instance PrimOf (FL p) = PrimOf p
+
+data WithName prim = WithName prim
+
+instance PatchInspect prim => PatchInspect (WithName prim) where
+
+class (PatchInspect (PrimOf p)) => Conflict p where
+    resolveConflicts :: p -> PrimOf p
+
+instance Conflict p => Conflict (FL p) where
+    resolveConflicts = undefined
+
+type family OnPrim p
+
+joinPatches :: p -> p
+
+joinPatches = id
+
+cleverNamedResolve :: (Conflict (OnPrim p)
+                      ,PrimOf (OnPrim p) ~ WithName (PrimOf p))
+                   => p -> FL (OnPrim p) -> WithName (PrimOf p)
+cleverNamedResolve x = resolveConflicts . joinPatches
+-- I added the parameter 'x' to make the signature unambiguous
+-- I don't think that ambiguity is essential to the original problem
+
+{-
+resolveConflicts :: q -> PrimOf q
+ (w) FL (OnPrim p) ~ q
+ (w) WithName (PrimOf p) ~ PrimOf q
+==>
+ (w) PrimOf (OnPrim p) ~ PrimOf (FL (OnPrim p))
+==>
+ (w) PrimOf (OnPrim p) ~ PrimOf (OnPrim p)
+
+-}
diff --git a/testsuite/tests/indexed-types/should_compile/T8889.hs b/testsuite/tests/indexed-types/should_compile/T8889.hs
new file mode 100644
index 000000000000..45c88a6a1857
--- /dev/null
+++ b/testsuite/tests/indexed-types/should_compile/T8889.hs
@@ -0,0 +1,12 @@
+{-# LANGUAGE TypeFamilies, ConstraintKinds #-}
+{-# OPTIONS_GHC -fwarn-missing-signatures #-}  -- Report f's inferred type
+
+module T8889 where
+
+import GHC.Exts
+
+class C f where
+  type C_fmap f a :: Constraint
+  foo :: C_fmap f a => (a -> b) -> f a -> f b
+
+f x = foo x
diff --git a/testsuite/tests/indexed-types/should_compile/T8889.stderr b/testsuite/tests/indexed-types/should_compile/T8889.stderr
new file mode 100644
index 000000000000..77e05d764ba7
--- /dev/null
+++ b/testsuite/tests/indexed-types/should_compile/T8889.stderr
@@ -0,0 +1,6 @@
+
+T8889.hs:12:1: Warning:
+    Top-level binding with no type signature:
+      f :: forall (f :: * -> *) a b.
+           (C_fmap f a, C f) =>
+           (a -> b) -> f a -> f b
diff --git a/testsuite/tests/indexed-types/should_compile/T8913.hs b/testsuite/tests/indexed-types/should_compile/T8913.hs
new file mode 100644
index 000000000000..062a2521494a
--- /dev/null
+++ b/testsuite/tests/indexed-types/should_compile/T8913.hs
@@ -0,0 +1,16 @@
+{-# OPTIONS_GHC -Wall #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE PolyKinds #-}
+
+module T8913 where
+
+class GCat f where
+   gcat :: f p -> Int
+
+cat :: (GCat (MyRep a), MyGeneric a) => a -> Int
+cat x = gcat (from x)
+
+class MyGeneric a where
+   type MyRep a :: * -> *
+   from :: a -> (MyRep a) p
diff --git a/testsuite/tests/indexed-types/should_compile/T8978.hs b/testsuite/tests/indexed-types/should_compile/T8978.hs
new file mode 100644
index 000000000000..077a07db311b
--- /dev/null
+++ b/testsuite/tests/indexed-types/should_compile/T8978.hs
@@ -0,0 +1,12 @@
+{-# LANGUAGE FlexibleContexts, TypeFamilies #-}
+module T8978 where
+
+type Syn a = Associated a
+
+class Eq (Associated a) => Foo a where
+    type Associated a :: *
+    foo :: a -> Syn a -> Bool
+
+instance Foo () where
+    type Associated () = Int
+    foo _ x = x == x
diff --git a/testsuite/tests/indexed-types/should_compile/T8979.hs b/testsuite/tests/indexed-types/should_compile/T8979.hs
new file mode 100644
index 000000000000..85e13cee4e08
--- /dev/null
+++ b/testsuite/tests/indexed-types/should_compile/T8979.hs
@@ -0,0 +1,10 @@
+{-# LANGUAGE TypeFamilies #-}
+module T8979 where
+
+type family F a
+type family G a
+
+type H a = G a
+
+f :: F (G Char) -> F (H Char)
+f a = a
diff --git a/testsuite/tests/indexed-types/should_compile/T9085.hs b/testsuite/tests/indexed-types/should_compile/T9085.hs
new file mode 100644
index 000000000000..13c9321262b8
--- /dev/null
+++ b/testsuite/tests/indexed-types/should_compile/T9085.hs
@@ -0,0 +1,7 @@
+{-# LANGUAGE TypeFamilies #-}
+
+module T9085 where
+
+type family F a where
+  F a = Int
+  F Bool = Bool
diff --git a/testsuite/tests/indexed-types/should_compile/T9085.stderr b/testsuite/tests/indexed-types/should_compile/T9085.stderr
new file mode 100644
index 000000000000..ee968e0d7906
--- /dev/null
+++ b/testsuite/tests/indexed-types/should_compile/T9085.stderr
@@ -0,0 +1,4 @@
+
+T9085.hs:7:3: Warning:
+    Overlapped type family instance equation:
+      F Bool = Bool
diff --git a/testsuite/tests/indexed-types/should_compile/T9316.hs b/testsuite/tests/indexed-types/should_compile/T9316.hs
new file mode 100644
index 000000000000..b5dfca6a947a
--- /dev/null
+++ b/testsuite/tests/indexed-types/should_compile/T9316.hs
@@ -0,0 +1,87 @@
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE FlexibleInstances #-}
+
+module SingletonsBug where
+
+import Control.Applicative
+import Data.Traversable (for)
+import GHC.Exts( Constraint )
+
+-----------------------------------
+-- From 'constraints' library
+-- import Data.Constraint (Dict(..))
+data Dict :: Constraint -> * where
+  Dict :: a => Dict a
+
+-----------------------------------
+-- From 'singletons' library
+-- import Data.Singletons hiding( withSomeSing )
+
+class SingI (a :: k) where
+  -- | Produce the singleton explicitly. You will likely need the @ScopedTypeVariables@
+  -- extension to use this method the way you want.
+  sing :: Sing a
+
+data family Sing (a :: k)
+
+data KProxy (a :: *) = KProxy
+
+data SomeSing (kproxy :: KProxy k) where
+  SomeSing :: Sing (a :: k) -> SomeSing ('KProxy :: KProxy k)
+
+-- SingKind :: forall k. KProxy k -> Constraint
+class (kparam ~ 'KProxy) => SingKind (kparam :: KProxy k) where
+  -- | Get a base type from a proxy for the promoted kind. For example,
+  -- @DemoteRep ('KProxy :: KProxy Bool)@ will be the type @Bool@.
+  type DemoteRep kparam :: *
+
+  -- | Convert a singleton to its unrefined version.
+  fromSing :: Sing (a :: k) -> DemoteRep kparam
+
+  -- | Convert an unrefined type to an existentially-quantified singleton type.
+  toSing   :: DemoteRep kparam -> SomeSing kparam
+
+withSomeSing :: SingKind ('KProxy :: KProxy k)
+             => DemoteRep ('KProxy :: KProxy k)
+             -> (forall (a :: k). Sing a -> r)
+             -> r
+withSomeSing = error "urk"
+
+-----------------------------------
+
+data SubscriptionChannel = BookingsChannel
+type BookingsChannelSym0 = BookingsChannel
+data instance Sing (z_a5I7 :: SubscriptionChannel) where
+   SBookingsChannel :: Sing BookingsChannel
+
+instance SingKind ('KProxy :: KProxy SubscriptionChannel) where
+  type DemoteRep ('KProxy :: KProxy SubscriptionChannel) = SubscriptionChannel
+  fromSing SBookingsChannel = BookingsChannel
+  toSing BookingsChannel = SomeSing SBookingsChannel
+
+instance SingI BookingsChannel where
+  sing = SBookingsChannel
+
+type family T (c :: SubscriptionChannel) :: *
+type instance T 'BookingsChannel = Bool
+
+witnessC :: Sing channel -> Dict (Show (T channel), SingI channel)
+witnessC SBookingsChannel = Dict
+
+forAllSubscriptionChannels
+  :: forall m r. (Applicative m)
+  => (forall channel. (SingI channel, Show (T channel)) => Sing channel -> m r)
+  -> m r
+forAllSubscriptionChannels f =
+  withSomeSing BookingsChannel $ \(sChannel) ->
+    case witnessC sChannel of
+      Dict -> f sChannel
+
diff --git a/testsuite/tests/indexed-types/should_compile/all.T b/testsuite/tests/indexed-types/should_compile/all.T
index f722ea3b4f7f..016444a138d6 100644
--- a/testsuite/tests/indexed-types/should_compile/all.T
+++ b/testsuite/tests/indexed-types/should_compile/all.T
@@ -239,3 +239,9 @@ test('ClosedFam1', extra_clean(['ClosedFam1.o-boot', 'ClosedFam1.hi-boot']),
 test('ClosedFam2', extra_clean(['ClosedFam2.o-boot', 'ClosedFam2.hi-boot']),
      multimod_compile, ['ClosedFam2', '-v0'])
 test('T8651', normal, compile, [''])
+test('T8889', normal, compile, [''])
+test('T8913', normal, compile, [''])
+test('T8978', normal, compile, [''])
+test('T8979', normal, compile, [''])
+test('T9085', normal, compile, [''])
+test('T9316', normal, compile, [''])
diff --git a/testsuite/tests/indexed-types/should_fail/ClosedFam3.hs-boot b/testsuite/tests/indexed-types/should_fail/ClosedFam3.hs-boot
index 0388084fa79c..503e1adfd3f1 100644
--- a/testsuite/tests/indexed-types/should_fail/ClosedFam3.hs-boot
+++ b/testsuite/tests/indexed-types/should_fail/ClosedFam3.hs-boot
@@ -9,5 +9,5 @@ type family Bar a where
   Bar Int = Bool
   Bar Double = Char
 
-type family Baz (a :: k) where
-  Baz Int = Bool
\ No newline at end of file
+type family Baz (a :: k) :: * where
+  Baz Int = Bool
diff --git a/testsuite/tests/indexed-types/should_fail/ClosedFam3.stderr b/testsuite/tests/indexed-types/should_fail/ClosedFam3.stderr
index dfbb7dc1421a..04435ba9622a 100644
--- a/testsuite/tests/indexed-types/should_fail/ClosedFam3.stderr
+++ b/testsuite/tests/indexed-types/should_fail/ClosedFam3.stderr
@@ -1,14 +1,15 @@
 
 ClosedFam3.hs-boot:5:1:
-    Type constructor ‛Foo’ has conflicting definitions in the module
+    Type constructor ‘Foo’ has conflicting definitions in the module
     and its hs-boot file
     Main module: type family Foo a :: * where
                      Foo Int = Bool
                      Foo Double = Char
-    Boot file:   type family Foo a :: * where Foo Int = Bool
+    Boot file:   type family Foo a :: * where
+                     Foo Int = Bool
 
 ClosedFam3.hs-boot:8:1:
-    Type constructor ‛Bar’ has conflicting definitions in the module
+    Type constructor ‘Bar’ has conflicting definitions in the module
     and its hs-boot file
     Main module: type family Bar a :: * where
                      Bar Int = Bool
@@ -18,7 +19,9 @@ ClosedFam3.hs-boot:8:1:
                      Bar Double = Char
 
 ClosedFam3.hs-boot:12:1:
-    Type constructor ‛Baz’ has conflicting definitions in the module
+    Type constructor ‘Baz’ has conflicting definitions in the module
     and its hs-boot file
-    Main module: type family Baz a :: * where Baz Int = Bool
-    Boot file:   type family Baz (a :: k) :: * where Baz Int = Bool
+    Main module: type family Baz a :: * where
+                     Baz Int = Bool
+    Boot file:   type family Baz (a :: k) :: * where
+                     Baz * Int = Bool
diff --git a/testsuite/tests/indexed-types/should_fail/ClosedFam4.stderr b/testsuite/tests/indexed-types/should_fail/ClosedFam4.stderr
index e70ec94a6d7d..2ba73e19ab38 100644
--- a/testsuite/tests/indexed-types/should_fail/ClosedFam4.stderr
+++ b/testsuite/tests/indexed-types/should_fail/ClosedFam4.stderr
@@ -2,4 +2,4 @@
 ClosedFam4.hs:5:1:
     You may omit the equations in a closed type family
     only in a .hs-boot file
-    In the type family declaration for ‛Foo’
+    In the type family declaration for ‘Foo’
diff --git a/testsuite/tests/indexed-types/should_fail/DerivUnsatFam.stderr b/testsuite/tests/indexed-types/should_fail/DerivUnsatFam.stderr
index 1a54b82974cf..dbff63583f69 100644
--- a/testsuite/tests/indexed-types/should_fail/DerivUnsatFam.stderr
+++ b/testsuite/tests/indexed-types/should_fail/DerivUnsatFam.stderr
@@ -1,5 +1,5 @@
 
 DerivUnsatFam.hs:8:1:
-    Can't make a derived instance of ‛Functor T’:
-      No family instance for ‛T’
-    In the stand-alone deriving instance for ‛Functor T’
+    Can't make a derived instance of ‘Functor T’:
+      No family instance for ‘T’
+    In the stand-alone deriving instance for ‘Functor T’
diff --git a/testsuite/tests/indexed-types/should_fail/ExtraTcsUntch.stderr b/testsuite/tests/indexed-types/should_fail/ExtraTcsUntch.stderr
index 4b7532c96270..8ce4d38b7804 100644
--- a/testsuite/tests/indexed-types/should_fail/ExtraTcsUntch.stderr
+++ b/testsuite/tests/indexed-types/should_fail/ExtraTcsUntch.stderr
@@ -1,6 +1,6 @@
 
 ExtraTcsUntch.hs:24:53:
-    Could not deduce (C [t] [a]) arising from a use of ‛op’
+    Could not deduce (C [t] [a]) arising from a use of ‘op’
     from the context (F Int ~ [[t]])
       bound by the inferred type of
                f :: F Int ~ [[t]] => [t] -> ((), ((), ()))
diff --git a/testsuite/tests/indexed-types/should_fail/GADTwrong1.stderr b/testsuite/tests/indexed-types/should_fail/GADTwrong1.stderr
index b12ea509252c..dc94b9a7c384 100644
--- a/testsuite/tests/indexed-types/should_fail/GADTwrong1.stderr
+++ b/testsuite/tests/indexed-types/should_fail/GADTwrong1.stderr
@@ -6,12 +6,12 @@ GADTwrong1.hs:12:19:
                  T :: forall a. a -> T (Const a),
                in a case alternative
       at GADTwrong1.hs:12:12-14
-      ‛a1’ is a rigid type variable bound by
+      ‘a1’ is a rigid type variable bound by
            a pattern with constructor
              T :: forall a. a -> T (Const a),
            in a case alternative
            at GADTwrong1.hs:12:12
-      ‛b’ is a rigid type variable bound by
+      ‘b’ is a rigid type variable bound by
           the type signature for coerce :: a -> b at GADTwrong1.hs:10:20
     Relevant bindings include
       y :: a1 (bound at GADTwrong1.hs:12:14)
diff --git a/testsuite/tests/indexed-types/should_fail/NoMatchErr.stderr b/testsuite/tests/indexed-types/should_fail/NoMatchErr.stderr
index 06a4f0cbe002..d3193d5f30af 100644
--- a/testsuite/tests/indexed-types/should_fail/NoMatchErr.stderr
+++ b/testsuite/tests/indexed-types/should_fail/NoMatchErr.stderr
@@ -4,11 +4,11 @@ NoMatchErr.hs:19:7:
     from the context (Fun d)
       bound by the type signature for f :: Fun d => Memo d a -> Memo d a
       at NoMatchErr.hs:19:7-37
-    NB: ‛Memo’ is a type function, and may not be injective
-    The type variable ‛d0’ is ambiguous
+    NB: ‘Memo’ is a type function, and may not be injective
+    The type variable ‘d0’ is ambiguous
     Expected type: Memo d a -> Memo d a
       Actual type: Memo d0 a -> Memo d0 a
     In the ambiguity check for:
       forall d a. Fun d => Memo d a -> Memo d a
     To defer the ambiguity check to use sites, enable AllowAmbiguousTypes
-    In the type signature for ‛f’: f :: Fun d => Memo d a -> Memo d a
+    In the type signature for ‘f’: f :: (Fun d) => Memo d a -> Memo d a
diff --git a/testsuite/tests/indexed-types/should_fail/NotRelaxedExamples.stderr b/testsuite/tests/indexed-types/should_fail/NotRelaxedExamples.stderr
index b06cae35f75d..dd479b76644d 100644
--- a/testsuite/tests/indexed-types/should_fail/NotRelaxedExamples.stderr
+++ b/testsuite/tests/indexed-types/should_fail/NotRelaxedExamples.stderr
@@ -3,16 +3,16 @@ NotRelaxedExamples.hs:9:15:
     Nested type family application
       in the type family application: F1 (F1 Char)
     (Use UndecidableInstances to permit this)
-    In the type instance declaration for ‛F1’
+    In the type instance declaration for ‘F1’
 
 NotRelaxedExamples.hs:10:15:
     Application is no smaller than the instance head
       in the type family application: F2 [x]
     (Use UndecidableInstances to permit this)
-    In the type instance declaration for ‛F2’
+    In the type instance declaration for ‘F2’
 
 NotRelaxedExamples.hs:11:15:
     Application is no smaller than the instance head
       in the type family application: F3 [Char]
     (Use UndecidableInstances to permit this)
-    In the type instance declaration for ‛F3’
+    In the type instance declaration for ‘F3’
diff --git a/testsuite/tests/indexed-types/should_fail/Overlap10.stderr b/testsuite/tests/indexed-types/should_fail/Overlap10.stderr
index aad494e1a811..5a53870eff5f 100644
--- a/testsuite/tests/indexed-types/should_fail/Overlap10.stderr
+++ b/testsuite/tests/indexed-types/should_fail/Overlap10.stderr
@@ -1,8 +1,8 @@
 
 Overlap10.hs:10:7:
-    Couldn't match expected type ‛F a Bool’ with actual type ‛Bool’
+    Couldn't match expected type ‘F a Bool’ with actual type ‘Bool’
     Relevant bindings include
       x :: a (bound at Overlap10.hs:10:3)
       g :: a -> F a Bool (bound at Overlap10.hs:10:1)
     In the expression: False
-    In an equation for ‛g’: g x = False
+    In an equation for ‘g’: g x = False
diff --git a/testsuite/tests/indexed-types/should_fail/Overlap11.stderr b/testsuite/tests/indexed-types/should_fail/Overlap11.stderr
index 4dc7407e89bb..6e3286eb2708 100644
--- a/testsuite/tests/indexed-types/should_fail/Overlap11.stderr
+++ b/testsuite/tests/indexed-types/should_fail/Overlap11.stderr
@@ -1,8 +1,8 @@
 
 Overlap11.hs:10:8:
-    Couldn't match expected type ‛F a Int’ with actual type ‛Int’
+    Couldn't match expected type ‘F a Int’ with actual type ‘Int’
     Relevant bindings include
       x :: a (bound at Overlap11.hs:10:3)
       g :: a -> F a Int (bound at Overlap11.hs:10:1)
     In the expression: (5 :: Int)
-    In an equation for ‛g’: g x = (5 :: Int)
+    In an equation for ‘g’: g x = (5 :: Int)
diff --git a/testsuite/tests/indexed-types/should_fail/Overlap15.stderr b/testsuite/tests/indexed-types/should_fail/Overlap15.stderr
index bafe63c61efe..a24504caa42e 100644
--- a/testsuite/tests/indexed-types/should_fail/Overlap15.stderr
+++ b/testsuite/tests/indexed-types/should_fail/Overlap15.stderr
@@ -1,7 +1,7 @@
 
 Overlap15.hs:16:9:
-    Couldn't match expected type ‛F b [b] Bool’ with actual type ‛Bool’
+    Couldn't match expected type ‘F b [b] Bool’ with actual type ‘Bool’
     Relevant bindings include
       foo :: Proxy b -> F b [b] Bool (bound at Overlap15.hs:16:1)
     In the expression: False
-    In an equation for ‛foo’: foo _ = False
+    In an equation for ‘foo’: foo _ = False
diff --git a/testsuite/tests/indexed-types/should_fail/Overlap3.stderr b/testsuite/tests/indexed-types/should_fail/Overlap3.stderr
index c8d1b5ef80bb..5659fd18750f 100644
--- a/testsuite/tests/indexed-types/should_fail/Overlap3.stderr
+++ b/testsuite/tests/indexed-types/should_fail/Overlap3.stderr
@@ -1,4 +1,4 @@
 
 Overlap3.hs:8:1:
-    Illegal instance for closed family ‛F’
-    In the type instance declaration for ‛F’
+    Illegal instance for closed family ‘F’
+    In the type instance declaration for ‘F’
diff --git a/testsuite/tests/indexed-types/should_fail/Overlap4.stderr b/testsuite/tests/indexed-types/should_fail/Overlap4.stderr
index 329b1ee11a49..d1622335d8c5 100644
--- a/testsuite/tests/indexed-types/should_fail/Overlap4.stderr
+++ b/testsuite/tests/indexed-types/should_fail/Overlap4.stderr
@@ -1,5 +1,4 @@
 
 Overlap4.hs:7:3:
     Number of parameters must match family declaration; expected 2
-    In the equations for closed type family ‛F’
-    In the type family declaration for ‛F’
+    In the type family declaration for ‘F’
diff --git a/testsuite/tests/indexed-types/should_fail/Overlap5.stderr b/testsuite/tests/indexed-types/should_fail/Overlap5.stderr
index 201dc416c17d..a8891450362c 100644
--- a/testsuite/tests/indexed-types/should_fail/Overlap5.stderr
+++ b/testsuite/tests/indexed-types/should_fail/Overlap5.stderr
@@ -1,5 +1,6 @@
 
 Overlap5.hs:8:3:
-    Mismatched type names in closed type family declaration.
-    First name was F; this one is G
-    In the family declaration for ‛F’
+    Mismatched type name in type family instance.
+      Expected: F
+        Actual: G
+    In the type family declaration for ‘F’
diff --git a/testsuite/tests/indexed-types/should_fail/Overlap6.stderr b/testsuite/tests/indexed-types/should_fail/Overlap6.stderr
index a0167bc2de4a..209e2af3e32c 100644
--- a/testsuite/tests/indexed-types/should_fail/Overlap6.stderr
+++ b/testsuite/tests/indexed-types/should_fail/Overlap6.stderr
@@ -1,7 +1,7 @@
 
 Overlap6.hs:15:7:
-    Couldn't match type ‛x’ with ‛And x 'True’
-      ‛x’ is a rigid type variable bound by
+    Couldn't match type ‘x’ with ‘And x 'True’
+      ‘x’ is a rigid type variable bound by
           the type signature for g :: Proxy x -> Proxy (And x 'True)
           at Overlap6.hs:14:6
     Expected type: Proxy (And x 'True)
@@ -10,4 +10,4 @@ Overlap6.hs:15:7:
       x :: Proxy x (bound at Overlap6.hs:15:3)
       g :: Proxy x -> Proxy (And x 'True) (bound at Overlap6.hs:15:1)
     In the expression: x
-    In an equation for ‛g’: g x = x
+    In an equation for ‘g’: g x = x
diff --git a/testsuite/tests/indexed-types/should_fail/Overlap7.stderr b/testsuite/tests/indexed-types/should_fail/Overlap7.stderr
index 2858f792b238..179251d5a2da 100644
--- a/testsuite/tests/indexed-types/should_fail/Overlap7.stderr
+++ b/testsuite/tests/indexed-types/should_fail/Overlap7.stderr
@@ -1,4 +1,4 @@
 
 Overlap7.hs:8:1:
-    Illegal instance for closed family ‛F’
-    In the type instance declaration for ‛F’
+    Illegal instance for closed family ‘F’
+    In the type instance declaration for ‘F’
diff --git a/testsuite/tests/indexed-types/should_fail/Overlap9.stderr b/testsuite/tests/indexed-types/should_fail/Overlap9.stderr
index 69f37f1137c4..92cf6202de84 100644
--- a/testsuite/tests/indexed-types/should_fail/Overlap9.stderr
+++ b/testsuite/tests/indexed-types/should_fail/Overlap9.stderr
@@ -8,4 +8,4 @@ Overlap9.hs:10:7:
       x :: a (bound at Overlap9.hs:10:3)
       g :: a -> F a (bound at Overlap9.hs:10:1)
     In the expression: length (show x)
-    In an equation for ‛g’: g x = length (show x)
+    In an equation for ‘g’: g x = length (show x)
diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail12.stderr b/testsuite/tests/indexed-types/should_fail/SimpleFail12.stderr
index e93b4f4d1ef5..11664e67bdcb 100644
--- a/testsuite/tests/indexed-types/should_fail/SimpleFail12.stderr
+++ b/testsuite/tests/indexed-types/should_fail/SimpleFail12.stderr
@@ -1,4 +1,4 @@
 
 SimpleFail12.hs:8:15:
     Illegal polymorphic or qualified type: forall a. [a]
-    In the type instance declaration for ‛C’
+    In the type instance declaration for ‘C’
diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail13.stderr b/testsuite/tests/indexed-types/should_fail/SimpleFail13.stderr
index a31dda6b8ba1..6cb6fe0e5022 100644
--- a/testsuite/tests/indexed-types/should_fail/SimpleFail13.stderr
+++ b/testsuite/tests/indexed-types/should_fail/SimpleFail13.stderr
@@ -1,8 +1,8 @@
 
 SimpleFail13.hs:9:1:
     Illegal type synonym family application in instance: [C a]
-    In the data instance declaration for ‛D’
+    In the data instance declaration for ‘D’
 
 SimpleFail13.hs:13:15:
     Illegal type synonym family application in instance: [C a]
-    In the type instance declaration for ‛E’
+    In the type instance declaration for ‘E’
diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail14.stderr b/testsuite/tests/indexed-types/should_fail/SimpleFail14.stderr
index b6015046f70d..666f725ff183 100644
--- a/testsuite/tests/indexed-types/should_fail/SimpleFail14.stderr
+++ b/testsuite/tests/indexed-types/should_fail/SimpleFail14.stderr
@@ -1,6 +1,6 @@
 
 SimpleFail14.hs:5:15:
-    Expected a type, but ‛a ~ a’ has kind ‛Constraint’
-    In the type ‛a ~ a’
-    In the definition of data constructor ‛T’
-    In the data declaration for ‛T’
+    Expected a type, but ‘a ~ a’ has kind ‘Constraint’
+    In the type ‘a ~ a’
+    In the definition of data constructor ‘T’
+    In the data declaration for ‘T’
diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail15.stderr b/testsuite/tests/indexed-types/should_fail/SimpleFail15.stderr
index 1b1d03c2e55c..c54ba1697d11 100644
--- a/testsuite/tests/indexed-types/should_fail/SimpleFail15.stderr
+++ b/testsuite/tests/indexed-types/should_fail/SimpleFail15.stderr
@@ -2,5 +2,5 @@
 SimpleFail15.hs:5:8:
     Illegal polymorphic or qualified type: a ~ b => t
     Perhaps you intended to use RankNTypes or Rank2Types
-    In the type signature for ‛foo’:
+    In the type signature for ‘foo’:
       foo :: (a, b) -> (a ~ b => t) -> (a, b)
diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail16.stderr b/testsuite/tests/indexed-types/should_fail/SimpleFail16.stderr
index 1e50ae1c3c96..0d663a649770 100644
--- a/testsuite/tests/indexed-types/should_fail/SimpleFail16.stderr
+++ b/testsuite/tests/indexed-types/should_fail/SimpleFail16.stderr
@@ -1,9 +1,9 @@
 
 SimpleFail16.hs:10:12:
-    Couldn't match expected type ‛p0 a0’ with actual type ‛F ()’
-    The type variables ‛p0’, ‛a0’ are ambiguous
+    Couldn't match expected type ‘p0 a0’ with actual type ‘F ()’
+    The type variables ‘p0’, ‘a0’ are ambiguous
     Relevant bindings include
       bar :: p0 a0 (bound at SimpleFail16.hs:10:1)
-    In the first argument of ‛foo’, namely ‛(undefined :: F ())’
+    In the first argument of ‘foo’, namely ‘(undefined :: F ())’
     In the expression: foo (undefined :: F ())
-    In an equation for ‛bar’: bar = foo (undefined :: F ())
+    In an equation for ‘bar’: bar = foo (undefined :: F ())
diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail1a.stderr b/testsuite/tests/indexed-types/should_fail/SimpleFail1a.stderr
index 2e7b982a6b69..f57af3908ba0 100644
--- a/testsuite/tests/indexed-types/should_fail/SimpleFail1a.stderr
+++ b/testsuite/tests/indexed-types/should_fail/SimpleFail1a.stderr
@@ -1,4 +1,4 @@
 
 SimpleFail1a.hs:4:1:
-    Couldn't match kind ‛* -> *’ against ‛*’
-    In the data instance declaration for ‛T1’
+    Number of parameters must match family declaration; expected 2
+    In the data instance declaration for ‘T1’
diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail1b.stderr b/testsuite/tests/indexed-types/should_fail/SimpleFail1b.stderr
index 8a3f5dfbcd33..3ecd31a003cd 100644
--- a/testsuite/tests/indexed-types/should_fail/SimpleFail1b.stderr
+++ b/testsuite/tests/indexed-types/should_fail/SimpleFail1b.stderr
@@ -1,4 +1,4 @@
 
 SimpleFail1b.hs:4:1:
-    Number of parameters must match family declaration; expected no more than 2
-    In the data instance declaration for ‛T1’
+    Number of parameters must match family declaration; expected 2
+    In the data instance declaration for ‘T1’
diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail2a.stderr b/testsuite/tests/indexed-types/should_fail/SimpleFail2a.stderr
index 5d058756a308..30a06a3eb382 100644
--- a/testsuite/tests/indexed-types/should_fail/SimpleFail2a.stderr
+++ b/testsuite/tests/indexed-types/should_fail/SimpleFail2a.stderr
@@ -1,6 +1,6 @@
 
 SimpleFail2a.hs:11:3:
     Type indexes must match class instance head
-    Found ‛a’ but expected ‛Int’
-    In the data instance declaration for ‛Sd’
-    In the instance declaration for ‛C Int’
+    Found ‘a’ but expected ‘Int’
+    In the data instance declaration for ‘Sd’
+    In the instance declaration for ‘C Int’
diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail3a.stderr b/testsuite/tests/indexed-types/should_fail/SimpleFail3a.stderr
index cdf425131860..7db6f3b91a65 100644
--- a/testsuite/tests/indexed-types/should_fail/SimpleFail3a.stderr
+++ b/testsuite/tests/indexed-types/should_fail/SimpleFail3a.stderr
@@ -1,5 +1,5 @@
 
 SimpleFail3a.hs:10:3:
     Wrong category of family instance; declaration was for a data type
-    In the type instance declaration for ‛S1’
-    In the instance declaration for ‛C1 Int’
+    In the type instance declaration for ‘S1’
+    In the instance declaration for ‘C1 Int’
diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail4.stderr b/testsuite/tests/indexed-types/should_fail/SimpleFail4.stderr
index b9d99df24381..8c4c743a5656 100644
--- a/testsuite/tests/indexed-types/should_fail/SimpleFail4.stderr
+++ b/testsuite/tests/indexed-types/should_fail/SimpleFail4.stderr
@@ -1,6 +1,6 @@
 
-SimpleFail4.hs:8:8:
-    Type indexes must match class instance head
-    Found ‛Int’ but expected ‛a’
-    In the type synonym instance default declaration for ‛S2’
-    In the class declaration for ‛C2’
+SimpleFail4.hs:8:11:
+    Unexpected type ‘Int’
+    In the default declaration for ‘S2’
+    A default declaration should have form
+      default S2 a = ...
diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail5a.stderr b/testsuite/tests/indexed-types/should_fail/SimpleFail5a.stderr
index 8cadf52b497e..dc88c87c740d 100644
--- a/testsuite/tests/indexed-types/should_fail/SimpleFail5a.stderr
+++ b/testsuite/tests/indexed-types/should_fail/SimpleFail5a.stderr
@@ -1,7 +1,7 @@
 
 SimpleFail5a.hs:31:11:
-    Couldn't match type ‛a’ with ‛Int’
-      ‛a’ is a rigid type variable bound by
+    Couldn't match type ‘a’ with ‘Int’
+      ‘a’ is a rigid type variable bound by
           the type signature for bar3wrong :: S3 a -> a
           at SimpleFail5a.hs:30:14
     Expected type: S3 a
@@ -9,4 +9,4 @@ SimpleFail5a.hs:31:11:
     Relevant bindings include
       bar3wrong :: S3 a -> a (bound at SimpleFail5a.hs:31:1)
     In the pattern: D3Int
-    In an equation for ‛bar3wrong’: bar3wrong D3Int = 1
+    In an equation for ‘bar3wrong’: bar3wrong D3Int = 1
diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail5b.stderr b/testsuite/tests/indexed-types/should_fail/SimpleFail5b.stderr
index 2861582d973d..0dfd570cc07e 100644
--- a/testsuite/tests/indexed-types/should_fail/SimpleFail5b.stderr
+++ b/testsuite/tests/indexed-types/should_fail/SimpleFail5b.stderr
@@ -1,7 +1,7 @@
 
 SimpleFail5b.hs:31:12:
-    Couldn't match type ‛Char’ with ‛Int’
+    Couldn't match type ‘Char’ with ‘Int’
     Expected type: S3 Int
       Actual type: S3 Char
     In the pattern: D3Char
-    In an equation for ‛bar3wrong'’: bar3wrong' D3Char = 'a'
+    In an equation for ‘bar3wrong'’: bar3wrong' D3Char = 'a'
diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail6.stderr b/testsuite/tests/indexed-types/should_fail/SimpleFail6.stderr
index 71e9e566680f..6b12656863d2 100644
--- a/testsuite/tests/indexed-types/should_fail/SimpleFail6.stderr
+++ b/testsuite/tests/indexed-types/should_fail/SimpleFail6.stderr
@@ -1,5 +1,5 @@
 
 SimpleFail6.hs:7:11:
-    Conflicting definitions for ‛a’
+    Conflicting definitions for ‘a’
     Bound at: SimpleFail6.hs:7:11
               SimpleFail6.hs:7:13
diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail7.stderr b/testsuite/tests/indexed-types/should_fail/SimpleFail7.stderr
index 4778f0dcc319..643709ec7e5e 100644
--- a/testsuite/tests/indexed-types/should_fail/SimpleFail7.stderr
+++ b/testsuite/tests/indexed-types/should_fail/SimpleFail7.stderr
@@ -1,4 +1,4 @@
 
 SimpleFail7.hs:8:1:
-    Associated type ‛S5’ must be inside a class instance
-    In the data instance declaration for ‛S5’
+    Associated type ‘S5’ must be inside a class instance
+    In the data instance declaration for ‘S5’
diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail8.stderr b/testsuite/tests/indexed-types/should_fail/SimpleFail8.stderr
index ae25f9da5668..ea54a4a862fb 100644
--- a/testsuite/tests/indexed-types/should_fail/SimpleFail8.stderr
+++ b/testsuite/tests/indexed-types/should_fail/SimpleFail8.stderr
@@ -1,6 +1,6 @@
 
 SimpleFail8.hs:9:8:
-    ‛Map’ is not a (visible) associated type of class ‛C6’
+    ‘Map’ is not a (visible) associated type of class ‘C6’
 
 SimpleFail8.hs:10:8:
-    ‛S3’ is not a (visible) associated type of class ‛C6’
+    ‘S3’ is not a (visible) associated type of class ‘C6’
diff --git a/testsuite/tests/indexed-types/should_fail/T1897b.stderr b/testsuite/tests/indexed-types/should_fail/T1897b.stderr
index 5bb6ef1650fe..6372bd9fba1c 100644
--- a/testsuite/tests/indexed-types/should_fail/T1897b.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T1897b.stderr
@@ -1,14 +1,14 @@
-
-T1897b.hs:16:1:
-    Could not deduce (Depend a0 ~ Depend a)
-    from the context (Bug a)
-      bound by the inferred type for ‛isValid’:
-                 Bug a => [Depend a] -> Bool
-      at T1897b.hs:16:1-41
-    NB: ‛Depend’ is a type function, and may not be injective
-    The type variable ‛a0’ is ambiguous
-    Expected type: [Depend a] -> Bool
-      Actual type: [Depend a0] -> Bool
-    When checking that ‛isValid’
-      has the inferred type ‛forall a. Bug a => [Depend a] -> Bool’
-    Probable cause: the inferred type is ambiguous
+
+T1897b.hs:16:1:
+    Could not deduce (Depend a0 ~ Depend a)
+    from the context (Bug a)
+      bound by the inferred type for ‘isValid’:
+                 Bug a => [Depend a] -> Bool
+      at T1897b.hs:16:1-41
+    NB: ‘Depend’ is a type function, and may not be injective
+    The type variable ‘a0’ is ambiguous
+    Expected type: [Depend a] -> Bool
+      Actual type: [Depend a0] -> Bool
+    When checking that ‘isValid’ has the inferred type
+      isValid :: forall a. Bug a => [Depend a] -> Bool
+    Probable cause: the inferred type is ambiguous
diff --git a/testsuite/tests/indexed-types/should_fail/T1900.stderr b/testsuite/tests/indexed-types/should_fail/T1900.stderr
index 896a441b5a88..d44b4ed210fa 100644
--- a/testsuite/tests/indexed-types/should_fail/T1900.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T1900.stderr
@@ -4,11 +4,11 @@ T1900.hs:13:10:
     from the context (Bug s)
       bound by the type signature for check :: Bug s => Depend s -> Bool
       at T1900.hs:13:10-36
-    NB: ‛Depend’ is a type function, and may not be injective
-    The type variable ‛s0’ is ambiguous
+    NB: ‘Depend’ is a type function, and may not be injective
+    The type variable ‘s0’ is ambiguous
     Expected type: Depend s -> Bool
       Actual type: Depend s0 -> Bool
     In the ambiguity check for: forall s. Bug s => Depend s -> Bool
     To defer the ambiguity check to use sites, enable AllowAmbiguousTypes
-    In the type signature for ‛check’:
-      check :: Bug s => Depend s -> Bool
+    In the type signature for ‘check’:
+      check :: (Bug s) => Depend s -> Bool
diff --git a/testsuite/tests/indexed-types/should_fail/T2157.stderr b/testsuite/tests/indexed-types/should_fail/T2157.stderr
index 0f6f272de979..13d436ae43c0 100644
--- a/testsuite/tests/indexed-types/should_fail/T2157.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T2157.stderr
@@ -1,4 +1,4 @@
 
 T2157.hs:7:15:
-    Type synonym ‛S’ should have 2 arguments, but has been given 1
-    In the type instance declaration for ‛F’
+    Type synonym ‘S’ should have 2 arguments, but has been given 1
+    In the type instance declaration for ‘F’
diff --git a/testsuite/tests/indexed-types/should_fail/T2203a.stderr b/testsuite/tests/indexed-types/should_fail/T2203a.stderr
index 67390f298f19..f6e7f31d3cdd 100644
--- a/testsuite/tests/indexed-types/should_fail/T2203a.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T2203a.stderr
@@ -2,4 +2,4 @@
 T2203a.hs:13:19:
     Illegal type synonym family application in instance:
       Either a (TheFoo a)
-    In the instance declaration for ‛Bar (Either a (TheFoo a))’
+    In the instance declaration for ‘Bar (Either a (TheFoo a))’
diff --git a/testsuite/tests/indexed-types/should_fail/T2239.stderr b/testsuite/tests/indexed-types/should_fail/T2239.stderr
index b322d9f06d3c..4a223ae8cb44 100644
--- a/testsuite/tests/indexed-types/should_fail/T2239.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T2239.stderr
@@ -1,28 +1,28 @@
 
 T2239.hs:47:13:
-    Couldn't match type ‛b -> b’
-                  with ‛forall b1. MyEq b1 Bool => b1 -> b1’
+    Couldn't match type ‘b -> b’
+                  with ‘forall b1. MyEq b1 Bool => b1 -> b1’
     Expected type: (forall b1. MyEq b1 Bool => b1 -> b1) -> b -> b
       Actual type: (b -> b) -> b -> b
     In the expression:
         id ::
           (forall b. MyEq b Bool => b -> b)
           -> (forall b. MyEq b Bool => b -> b)
-    In an equation for ‛complexFD’:
+    In an equation for ‘complexFD’:
         complexFD
           = id ::
               (forall b. MyEq b Bool => b -> b)
               -> (forall b. MyEq b Bool => b -> b)
 
 T2239.hs:50:13:
-    Couldn't match type ‛Bool -> Bool’
-                  with ‛forall b1. b1 ~ Bool => b1 -> b1’
+    Couldn't match type ‘Bool -> Bool’
+                  with ‘forall b1. b1 ~ Bool => b1 -> b1’
     Expected type: (forall b1. b1 ~ Bool => b1 -> b1) -> b -> b
       Actual type: (b -> b) -> b -> b
     In the expression:
         id ::
           (forall b. b ~ Bool => b -> b) -> (forall b. b ~ Bool => b -> b)
-    In an equation for ‛complexTF’:
+    In an equation for ‘complexTF’:
         complexTF
           = id ::
               (forall b. b ~ Bool => b -> b) -> (forall b. b ~ Bool => b -> b)
diff --git a/testsuite/tests/indexed-types/should_fail/T2334A.stderr b/testsuite/tests/indexed-types/should_fail/T2334A.stderr
index ff4e35206f45..6b4197bfb42b 100644
--- a/testsuite/tests/indexed-types/should_fail/T2334A.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T2334A.stderr
@@ -1,15 +1,15 @@
 
 T2334A.hs:9:26:
     The constructor of a newtype must have exactly one field
-      but ‛F’ has two
-    In the definition of data constructor ‛F’
-    In the newtype instance declaration for ‛F’
+      but ‘F’ has two
+    In the definition of data constructor ‘F’
+    In the newtype instance declaration for ‘F’
 
 T2334A.hs:10:27:
     The constructor of a newtype must have exactly one field
-      but ‛H’ has none
-    In the definition of data constructor ‛H’
-    In the newtype instance declaration for ‛F’
+      but ‘H’ has none
+    In the definition of data constructor ‘H’
+    In the newtype instance declaration for ‘F’
 
 T2334A.hs:12:15:
     Conflicting family instance declarations:
diff --git a/testsuite/tests/indexed-types/should_fail/T2544.stderr b/testsuite/tests/indexed-types/should_fail/T2544.stderr
index a068ef326879..244580f922c3 100644
--- a/testsuite/tests/indexed-types/should_fail/T2544.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T2544.stderr
@@ -3,24 +3,24 @@ T2544.hs:15:18:
     Could not deduce (IxMap i0 ~ IxMap l)
     from the context (Ix l, Ix r)
       bound by the instance declaration at T2544.hs:13:10-37
-    NB: ‛IxMap’ is a type function, and may not be injective
-    The type variable ‛i0’ is ambiguous
+    NB: ‘IxMap’ is a type function, and may not be injective
+    The type variable ‘i0’ is ambiguous
     Expected type: IxMap l [Int]
       Actual type: IxMap i0 [Int]
     Relevant bindings include
       empty :: IxMap (l :|: r) [Int] (bound at T2544.hs:15:4)
-    In the first argument of ‛BiApp’, namely ‛empty’
+    In the first argument of ‘BiApp’, namely ‘empty’
     In the expression: BiApp empty empty
 
 T2544.hs:15:24:
     Could not deduce (IxMap i1 ~ IxMap r)
     from the context (Ix l, Ix r)
       bound by the instance declaration at T2544.hs:13:10-37
-    NB: ‛IxMap’ is a type function, and may not be injective
-    The type variable ‛i1’ is ambiguous
+    NB: ‘IxMap’ is a type function, and may not be injective
+    The type variable ‘i1’ is ambiguous
     Expected type: IxMap r [Int]
       Actual type: IxMap i1 [Int]
     Relevant bindings include
       empty :: IxMap (l :|: r) [Int] (bound at T2544.hs:15:4)
-    In the second argument of ‛BiApp’, namely ‛empty’
+    In the second argument of ‘BiApp’, namely ‘empty’
     In the expression: BiApp empty empty
diff --git a/testsuite/tests/indexed-types/should_fail/T2627b.stderr b/testsuite/tests/indexed-types/should_fail/T2627b.stderr
index 61399d02ddf2..2cb51a9fad2d 100644
--- a/testsuite/tests/indexed-types/should_fail/T2627b.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T2627b.stderr
@@ -2,7 +2,7 @@
 T2627b.hs:20:24:
     Occurs check: cannot construct the infinite type:
       a0 ~ Dual (Dual a0)
-    The type variable ‛a0’ is ambiguous
+    The type variable ‘a0’ is ambiguous
     In the expression: conn undefined undefined
-    In an equation for ‛conn’:
+    In an equation for ‘conn’:
         conn (Rd k) (Wr a r) = conn undefined undefined
diff --git a/testsuite/tests/indexed-types/should_fail/T2664.stderr b/testsuite/tests/indexed-types/should_fail/T2664.stderr
index a8d24c816ffa..4104eb58c4ad 100644
--- a/testsuite/tests/indexed-types/should_fail/T2664.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T2664.stderr
@@ -8,16 +8,16 @@ T2664.hs:31:52:
                  newPChan :: ((a :*: b) ~ Dual c, c ~ Dual (a :*: b)) =>
                              IO (PChan (a :*: b), PChan c)
       at T2664.hs:23:5-12
-      ‛b’ is a rigid type variable bound by
+      ‘b’ is a rigid type variable bound by
           the instance declaration at T2664.hs:22:10
-      ‛a’ is a rigid type variable bound by
+      ‘a’ is a rigid type variable bound by
           the instance declaration at T2664.hs:22:10
     Expected type: Dual (Dual a)
       Actual type: b
     Relevant bindings include
       v :: MVar (Either (PChan a) (PChan b)) (bound at T2664.hs:24:9)
       newPChan :: IO (PChan (a :*: b), PChan c) (bound at T2664.hs:23:5)
-    In the third argument of ‛pchoose’, namely ‛newPChan’
-    In the first argument of ‛E’, namely ‛(pchoose Right v newPChan)’
+    In the third argument of ‘pchoose’, namely ‘newPChan’
+    In the first argument of ‘E’, namely ‘(pchoose Right v newPChan)’
     In the expression:
       E (pchoose Right v newPChan) (pchoose Left v newPChan)
diff --git a/testsuite/tests/indexed-types/should_fail/T2693.stderr b/testsuite/tests/indexed-types/should_fail/T2693.stderr
index 34fdfbde74e8..b613ab7ab571 100644
--- a/testsuite/tests/indexed-types/should_fail/T2693.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T2693.stderr
@@ -1,37 +1,38 @@
-
-T2693.hs:11:7:
-    Couldn't match expected type ‛TFn a’ with actual type ‛TFn a0’
-    NB: ‛TFn’ is a type function, and may not be injective
-    The type variable ‛a0’ is ambiguous
-    When checking that ‛x’ has the inferred type ‛forall a. TFn a’
-    Probable cause: the inferred type is ambiguous
-    In the expression:
-      do { let Just x = ...;
-           let n = fst x + fst x;
-           return () }
-    In an equation for ‛f’:
-        f = do { let Just x = ...;
-                 let n = ...;
-                 return () }
-
-T2693.hs:19:15:
-    Couldn't match expected type ‛(a2, b0)’ with actual type ‛TFn a3’
-    The type variables ‛a2’, ‛b0’, ‛a3’ are ambiguous
-    Relevant bindings include n :: a2 (bound at T2693.hs:19:7)
-    In the first argument of ‛fst’, namely ‛x’
-    In the first argument of ‛(+)’, namely ‛fst x’
-
-T2693.hs:19:23:
-    Couldn't match expected type ‛(a4, a2)’ with actual type ‛TFn a5’
-    The type variables ‛a2’, ‛a4’, ‛a5’ are ambiguous
-    Relevant bindings include n :: a2 (bound at T2693.hs:19:7)
-    In the first argument of ‛snd’, namely ‛x’
-    In the second argument of ‛(+)’, namely ‛snd x’
-
-T2693.hs:29:20:
-    Couldn't match type ‛TFn a0’ with ‛PVR a1’
-    The type variables ‛a0’, ‛a1’ are ambiguous
-    Expected type: () -> Maybe (PVR a1)
-      Actual type: () -> Maybe (TFn a0)
-    In the first argument of ‛mapM’, namely ‛g’
-    In a stmt of a 'do' block: pvs <- mapM g undefined
+
+T2693.hs:11:7:
+    Couldn't match expected type ‘TFn a’ with actual type ‘TFn a0’
+    NB: ‘TFn’ is a type function, and may not be injective
+    The type variable ‘a0’ is ambiguous
+    When checking that ‘x’ has the inferred type
+      x :: forall a. TFn a
+    Probable cause: the inferred type is ambiguous
+    In the expression:
+      do { let Just x = ...;
+           let n = fst x + fst x;
+           return () }
+    In an equation for ‘f’:
+        f = do { let Just x = ...;
+                 let n = ...;
+                 return () }
+
+T2693.hs:19:15:
+    Couldn't match expected type ‘(a2, b0)’ with actual type ‘TFn a3’
+    The type variables ‘a2’, ‘b0’, ‘a3’ are ambiguous
+    Relevant bindings include n :: a2 (bound at T2693.hs:19:7)
+    In the first argument of ‘fst’, namely ‘x’
+    In the first argument of ‘(+)’, namely ‘fst x’
+
+T2693.hs:19:23:
+    Couldn't match expected type ‘(a4, a2)’ with actual type ‘TFn a5’
+    The type variables ‘a2’, ‘a4’, ‘a5’ are ambiguous
+    Relevant bindings include n :: a2 (bound at T2693.hs:19:7)
+    In the first argument of ‘snd’, namely ‘x’
+    In the second argument of ‘(+)’, namely ‘snd x’
+
+T2693.hs:29:20:
+    Couldn't match type ‘TFn a0’ with ‘PVR a1’
+    The type variables ‘a0’, ‘a1’ are ambiguous
+    Expected type: () -> Maybe (PVR a1)
+      Actual type: () -> Maybe (TFn a0)
+    In the first argument of ‘mapM’, namely ‘g’
+    In a stmt of a 'do' block: pvs <- mapM g undefined
diff --git a/testsuite/tests/indexed-types/should_fail/T2888.stderr b/testsuite/tests/indexed-types/should_fail/T2888.stderr
new file mode 100644
index 000000000000..3d2c221703cb
--- /dev/null
+++ b/testsuite/tests/indexed-types/should_fail/T2888.stderr
@@ -0,0 +1,5 @@
+
+T2888.hs:6:1:
+    The associated type ‘D’
+    mentions none of the type or kind variables of the class ‘C w’
+    In the class declaration for ‘C’
diff --git a/testsuite/tests/indexed-types/should_fail/T3092.stderr b/testsuite/tests/indexed-types/should_fail/T3092.stderr
index 436db19f8183..141945c78103 100644
--- a/testsuite/tests/indexed-types/should_fail/T3092.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T3092.stderr
@@ -1,10 +1,10 @@
 
 T3092.hs:5:1:
-    Illegal family instance for ‛T’
+    Illegal family instance for ‘T’
       (T is not an indexed type family)
-    In the data instance declaration for ‛T’
+    In the data instance declaration for ‘T’
 
 T3092.hs:8:1:
-    Illegal family instance for ‛S’
+    Illegal family instance for ‘S’
       (S is not an indexed type family)
-    In the type instance declaration for ‛S’
+    In the type instance declaration for ‘S’
diff --git a/testsuite/tests/indexed-types/should_fail/T3330a.stderr b/testsuite/tests/indexed-types/should_fail/T3330a.stderr
index 8f7813c5f8ac..4596f9b7a657 100644
--- a/testsuite/tests/indexed-types/should_fail/T3330a.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T3330a.stderr
@@ -1,7 +1,7 @@
 
 T3330a.hs:19:34:
-    Couldn't match type ‛s’ with ‛(->) (s0 ix0 -> ix1)’
-      ‛s’ is a rigid type variable bound by
+    Couldn't match type ‘s’ with ‘(->) (s0 ix0 -> ix1)’
+      ‘s’ is a rigid type variable bound by
           the type signature for children :: s ix -> PF s r ix -> [AnyF s]
           at T3330a.hs:18:13
     Expected type: (s0 ix0 -> ix1)
@@ -11,12 +11,12 @@ T3330a.hs:19:34:
       x :: PF s r ix (bound at T3330a.hs:19:12)
       p :: s ix (bound at T3330a.hs:19:10)
       children :: s ix -> PF s r ix -> [AnyF s] (bound at T3330a.hs:19:1)
-    In the first argument of ‛hmapM’, namely ‛p’
-    In the first argument of ‛execWriter’, namely ‛(hmapM p collect x)’
+    In the first argument of ‘hmapM’, namely ‘p’
+    In the first argument of ‘execWriter’, namely ‘(hmapM p collect x)’
 
 T3330a.hs:19:34:
-    Couldn't match type ‛ix’ with ‛r ix1 -> Writer [AnyF s] (r'0 ix1)’
-      ‛ix’ is a rigid type variable bound by
+    Couldn't match type ‘ix’ with ‘r ix1 -> Writer [AnyF s] (r'0 ix1)’
+      ‘ix’ is a rigid type variable bound by
            the type signature for children :: s ix -> PF s r ix -> [AnyF s]
            at T3330a.hs:18:13
     Expected type: (s0 ix0 -> ix1)
@@ -26,12 +26,12 @@ T3330a.hs:19:34:
       x :: PF s r ix (bound at T3330a.hs:19:12)
       p :: s ix (bound at T3330a.hs:19:10)
       children :: s ix -> PF s r ix -> [AnyF s] (bound at T3330a.hs:19:1)
-    In the first argument of ‛hmapM’, namely ‛p’
-    In the first argument of ‛execWriter’, namely ‛(hmapM p collect x)’
+    In the first argument of ‘hmapM’, namely ‘p’
+    In the first argument of ‘execWriter’, namely ‘(hmapM p collect x)’
 
 T3330a.hs:19:44:
-    Couldn't match type ‛ix’ with ‛r0 ix0 -> Writer [AnyF s0] (r0 ix0)’
-      ‛ix’ is a rigid type variable bound by
+    Couldn't match type ‘ix’ with ‘r0 ix0 -> Writer [AnyF s0] (r0 ix0)’
+      ‘ix’ is a rigid type variable bound by
            the type signature for children :: s ix -> PF s r ix -> [AnyF s]
            at T3330a.hs:18:13
     Expected type: PF s r (r0 ix0 -> Writer [AnyF s0] (r0 ix0))
@@ -40,5 +40,5 @@ T3330a.hs:19:44:
       x :: PF s r ix (bound at T3330a.hs:19:12)
       p :: s ix (bound at T3330a.hs:19:10)
       children :: s ix -> PF s r ix -> [AnyF s] (bound at T3330a.hs:19:1)
-    In the third argument of ‛hmapM’, namely ‛x’
-    In the first argument of ‛execWriter’, namely ‛(hmapM p collect x)’
+    In the third argument of ‘hmapM’, namely ‘x’
+    In the first argument of ‘execWriter’, namely ‘(hmapM p collect x)’
diff --git a/testsuite/tests/indexed-types/should_fail/T3330c.stderr b/testsuite/tests/indexed-types/should_fail/T3330c.stderr
index 3e938c57055a..f9108f2849c4 100644
--- a/testsuite/tests/indexed-types/should_fail/T3330c.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T3330c.stderr
@@ -5,13 +5,13 @@ T3330c.hs:23:43:
       bound by a pattern with constructor
                  RSum :: forall (f :: * -> *) (g :: * -> *).
                          R f -> R g -> R (f :+: g),
-               in an equation for ‛plug'’
+               in an equation for ‘plug'’
       at T3330c.hs:23:8-17
-      ‛f1’ is a rigid type variable bound by
+      ‘f1’ is a rigid type variable bound by
            a pattern with constructor
              RSum :: forall (f :: * -> *) (g :: * -> *).
                      R f -> R g -> R (f :+: g),
-           in an equation for ‛plug'’
+           in an equation for ‘plug'’
            at T3330c.hs:23:8
     Expected type: Der ((->) x) (f1 x)
       Actual type: R f1
@@ -20,5 +20,5 @@ T3330c.hs:23:43:
       df :: f1 x (bound at T3330c.hs:23:25)
       rf :: R f1 (bound at T3330c.hs:23:13)
       plug' :: R f -> Der f x -> x -> f x (bound at T3330c.hs:23:1)
-    In the first argument of ‛plug’, namely ‛rf’
-    In the first argument of ‛Inl’, namely ‛(plug rf df x)’
+    In the first argument of ‘plug’, namely ‘rf’
+    In the first argument of ‘Inl’, namely ‘(plug rf df x)’
diff --git a/testsuite/tests/indexed-types/should_fail/T3440.stderr b/testsuite/tests/indexed-types/should_fail/T3440.stderr
index b01594951fc5..5e8c7b4f2b3e 100644
--- a/testsuite/tests/indexed-types/should_fail/T3440.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T3440.stderr
@@ -4,14 +4,14 @@ T3440.hs:11:22:
     from the context (Fam a ~ Fam a1)
       bound by a pattern with constructor
                  GADT :: forall a. a -> Fam a -> GADT (Fam a),
-               in an equation for ‛unwrap’
+               in an equation for ‘unwrap’
       at T3440.hs:11:9-16
-      ‛a1’ is a rigid type variable bound by
+      ‘a1’ is a rigid type variable bound by
            a pattern with constructor
              GADT :: forall a. a -> Fam a -> GADT (Fam a),
-           in an equation for ‛unwrap’
+           in an equation for ‘unwrap’
            at T3440.hs:11:9
-      ‛a’ is a rigid type variable bound by
+      ‘a’ is a rigid type variable bound by
           the type signature for unwrap :: GADT (Fam a) -> (a, Fam a)
           at T3440.hs:10:11
     Relevant bindings include
diff --git a/testsuite/tests/indexed-types/should_fail/T4093a.stderr b/testsuite/tests/indexed-types/should_fail/T4093a.stderr
index 8dfd987b36fc..e8b774987167 100644
--- a/testsuite/tests/indexed-types/should_fail/T4093a.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T4093a.stderr
@@ -4,11 +4,11 @@ T4093a.hs:8:8:
     from the context (Foo e ~ Maybe e)
       bound by the type signature for hang :: Foo e ~ Maybe e => Foo e
       at T4093a.hs:7:9-34
-      ‛e’ is a rigid type variable bound by
+      ‘e’ is a rigid type variable bound by
           the type signature for hang :: Foo e ~ Maybe e => Foo e
           at T4093a.hs:7:9
     Expected type: Foo e
       Actual type: Maybe ()
     Relevant bindings include hang :: Foo e (bound at T4093a.hs:8:1)
     In the expression: Just ()
-    In an equation for ‛hang’: hang = Just ()
+    In an equation for ‘hang’: hang = Just ()
diff --git a/testsuite/tests/indexed-types/should_fail/T4093b.stderr b/testsuite/tests/indexed-types/should_fail/T4093b.stderr
index 8d5f80108eb9..7fedfa64d301 100644
--- a/testsuite/tests/indexed-types/should_fail/T4093b.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T4093b.stderr
@@ -8,7 +8,7 @@ T4093b.hs:31:13:
                                      EitherCO x (A C C n) (A C O n) ~ A C x n) =>
                                     Block n e x -> A e x n
       at T4093b.hs:(20,3)-(22,26)
-      ‛e’ is a rigid type variable bound by
+      ‘e’ is a rigid type variable bound by
           the type signature for
             blockToNodeList :: (EitherCO e (A C O n) (A O O n) ~ A e O n,
                                 EitherCO x (A C C n) (A C O n) ~ A C x n) =>
@@ -26,8 +26,8 @@ T4093b.hs:31:13:
       b :: Block n e x (bound at T4093b.hs:25:17)
       blockToNodeList :: Block n e x -> A e x n (bound at T4093b.hs:25:1)
     In the expression: (JustC n, NothingC)
-    In an equation for ‛f’: f n _ = (JustC n, NothingC)
-    In an equation for ‛blockToNodeList’:
+    In an equation for ‘f’: f n _ = (JustC n, NothingC)
+    In an equation for ‘blockToNodeList’:
         blockToNodeList b
           = foldBlockNodesF (f, l) b z
           where
diff --git a/testsuite/tests/indexed-types/should_fail/T4099.stderr b/testsuite/tests/indexed-types/should_fail/T4099.stderr
index 1b21b930d9b4..a16223254d87 100644
--- a/testsuite/tests/indexed-types/should_fail/T4099.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T4099.stderr
@@ -1,21 +1,21 @@
 
 T4099.hs:11:30:
-    Couldn't match expected type ‛T a0’ with actual type ‛T b’
-    NB: ‛T’ is a type function, and may not be injective
-    The type variable ‛a0’ is ambiguous
+    Couldn't match expected type ‘T a0’ with actual type ‘T b’
+    NB: ‘T’ is a type function, and may not be injective
+    The type variable ‘a0’ is ambiguous
     Relevant bindings include
       x :: T b (bound at T4099.hs:11:8)
       a :: b (bound at T4099.hs:11:6)
       bar1 :: b -> T b -> Int (bound at T4099.hs:11:1)
-    In the second argument of ‛foo’, namely ‛x’
+    In the second argument of ‘foo’, namely ‘x’
     In the expression: foo (error "urk") x
 
 T4099.hs:14:30:
-    Couldn't match expected type ‛T a1’ with actual type ‛Maybe b’
-    The type variable ‛a1’ is ambiguous
+    Couldn't match expected type ‘T a1’ with actual type ‘Maybe b’
+    The type variable ‘a1’ is ambiguous
     Relevant bindings include
       x :: Maybe b (bound at T4099.hs:14:8)
       a :: b (bound at T4099.hs:14:6)
       bar2 :: b -> Maybe b -> Int (bound at T4099.hs:14:1)
-    In the second argument of ‛foo’, namely ‛x’
+    In the second argument of ‘foo’, namely ‘x’
     In the expression: foo (error "urk") x
diff --git a/testsuite/tests/indexed-types/should_fail/T4174.stderr b/testsuite/tests/indexed-types/should_fail/T4174.stderr
index 5547b259796d..19d3e8d3e0c9 100644
--- a/testsuite/tests/indexed-types/should_fail/T4174.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T4174.stderr
@@ -1,7 +1,7 @@
 
 T4174.hs:42:12:
-    Couldn't match type ‛False’ with ‛True’
+    Couldn't match type ‘False’ with ‘True’
     Expected type: True
       Actual type: GHCVersion (WayOf m) :>=: GHC6'10 Minor1
     In the expression: sync_large_objects
-    In an equation for ‛testcase’: testcase = sync_large_objects
+    In an equation for ‘testcase’: testcase = sync_large_objects
diff --git a/testsuite/tests/indexed-types/should_fail/T4179.stderr b/testsuite/tests/indexed-types/should_fail/T4179.stderr
index 4ab033d7ebb7..40fb84d83ad4 100644
--- a/testsuite/tests/indexed-types/should_fail/T4179.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T4179.stderr
@@ -7,7 +7,7 @@ T4179.hs:26:16:
                  fCon :: (Functor x, DoC (FCon x)) =>
                          Con x -> A2 (FCon x) -> A3 (FCon x)
       at T4179.hs:25:9-72
-    NB: ‛A3’ is a type function, and may not be injective
+    NB: ‘A3’ is a type function, and may not be injective
     Expected type: x (A2 (FCon x) -> A3 (FCon x))
                    -> A2 (FCon x) -> A3 (FCon x)
       Actual type: x (A2 (FCon x) -> A3 (FCon x))
@@ -16,5 +16,5 @@ T4179.hs:26:16:
     Relevant bindings include
       fCon :: Con x -> A2 (FCon x) -> A3 (FCon x)
         (bound at T4179.hs:26:1)
-    In the first argument of ‛foldDoC’, namely ‛op’
+    In the first argument of ‘foldDoC’, namely ‘op’
     In the expression: foldDoC op
diff --git a/testsuite/tests/indexed-types/should_fail/T4246.hs b/testsuite/tests/indexed-types/should_fail/T4246.hs
index b5c37a68e3fe..60b56405ad18 100644
--- a/testsuite/tests/indexed-types/should_fail/T4246.hs
+++ b/testsuite/tests/indexed-types/should_fail/T4246.hs
@@ -1,13 +1,13 @@
-{-# LANGUAGE TypeFamilies, FlexibleInstances, OverlappingInstances #-}
+{-# LANGUAGE TypeFamilies, FlexibleInstances #-}
 module T4246 where
 
 class Stupid a where
    type F a
 
-instance Stupid a where
+instance {-# OVERLAPPABLE #-} Stupid a where
    type F a = a
 
-instance Stupid Int where
+instance {-# OVERLAPPING #-} Stupid Int where
    type F Int = Bool
 
 type family G a :: *
diff --git a/testsuite/tests/indexed-types/should_fail/T4272.stderr b/testsuite/tests/indexed-types/should_fail/T4272.stderr
index 1214e8492d9d..7c98377ed737 100644
--- a/testsuite/tests/indexed-types/should_fail/T4272.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T4272.stderr
@@ -5,7 +5,7 @@ T4272.hs:15:26:
       bound by the type signature for
                  laws :: TermLike a => TermFamily a a -> b
       at T4272.hs:14:9-53
-      ‛a’ is a rigid type variable bound by
+      ‘a’ is a rigid type variable bound by
           the type signature for laws :: TermLike a => TermFamily a a -> b
           at T4272.hs:14:16
     Expected type: TermFamily a (TermFamily a a)
@@ -13,8 +13,8 @@ T4272.hs:15:26:
     Relevant bindings include
       t :: TermFamily a a (bound at T4272.hs:15:6)
       laws :: TermFamily a a -> b (bound at T4272.hs:15:1)
-    In the first argument of ‛terms’, namely
-      ‛(undefined :: TermFamily a a)’
-    In the second argument of ‛prune’, namely
-      ‛(terms (undefined :: TermFamily a a))’
+    In the first argument of ‘terms’, namely
+      ‘(undefined :: TermFamily a a)’
+    In the second argument of ‘prune’, namely
+      ‘(terms (undefined :: TermFamily a a))’
     In the expression: prune t (terms (undefined :: TermFamily a a))
diff --git a/testsuite/tests/indexed-types/should_fail/T4485.hs b/testsuite/tests/indexed-types/should_fail/T4485.hs
index b48e8206f281..d7d4730362a2 100644
--- a/testsuite/tests/indexed-types/should_fail/T4485.hs
+++ b/testsuite/tests/indexed-types/should_fail/T4485.hs
@@ -11,7 +11,6 @@
 {-# LANGUAGE TypeFamilies, MultiParamTypeClasses
   , FlexibleContexts, FlexibleInstances, UndecidableInstances
   , TypeSynonymInstances, GeneralizedNewtypeDeriving
-  , OverlappingInstances 
   #-}
 module XMLGenerator where
 
@@ -26,9 +25,9 @@ class Monad m => XMLGen m where
 class XMLGen m => EmbedAsChild m c where
     asChild :: c -> XMLGenT m [Child m]
 
-instance (EmbedAsChild m c, m1 ~ m) => EmbedAsChild m (XMLGenT m1 c)
+instance {-# OVERLAPPING #-} (EmbedAsChild m c, m1 ~ m) => EmbedAsChild m (XMLGenT m1 c)
 
-instance (XMLGen m,  XML m ~ x) => EmbedAsChild m x
+instance {-# OVERLAPPABLE #-} (XMLGen m,  XML m ~ x) => EmbedAsChild m x
 
 data Xml = Xml
 data IdentityT m a = IdentityT (m a)
@@ -39,11 +38,11 @@ instance XMLGen (IdentityT m) where
 data Identity a = Identity a
 instance Monad Identity
 
-instance EmbedAsChild (IdentityT IO) (XMLGenT Identity ())
+instance {-# OVERLAPPING #-} EmbedAsChild (IdentityT IO) (XMLGenT Identity ())
 
 data FooBar = FooBar
 
-instance EmbedAsChild (IdentityT IO) FooBar where
+instance {-# OVERLAPPING #-} EmbedAsChild (IdentityT IO) FooBar where
   asChild b = asChild $ (genElement "foo")
   -- asChild :: FooBar -> XMLGenT (XMLGenT (IdentityT IO) [Child (IdentitiyT IO)])
 
diff --git a/testsuite/tests/indexed-types/should_fail/T4485.stderr b/testsuite/tests/indexed-types/should_fail/T4485.stderr
index fca2fc88f7ea..760cdf912dc3 100644
--- a/testsuite/tests/indexed-types/should_fail/T4485.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T4485.stderr
@@ -1,30 +1,29 @@
 
-T4485.hs:47:15:
+T4485.hs:46:15:
     Overlapping instances for EmbedAsChild
                                 (IdentityT IO) (XMLGenT m0 (XML m0))
-      arising from a use of ‛asChild’
+      arising from a use of ‘asChild’
     Matching instances:
-      instance [overlap ok] (EmbedAsChild m c, m1 ~ m) =>
-                            EmbedAsChild m (XMLGenT m1 c)
-        -- Defined at T4485.hs:29:10
-      instance [overlap ok] EmbedAsChild
-                              (IdentityT IO) (XMLGenT Identity ())
-        -- Defined at T4485.hs:42:10
-    (The choice depends on the instantiation of ‛m0’
+      instance [overlapping] (EmbedAsChild m c, m1 ~ m) =>
+                             EmbedAsChild m (XMLGenT m1 c)
+        -- Defined at T4485.hs:28:30
+      instance [overlapping] EmbedAsChild
+                               (IdentityT IO) (XMLGenT Identity ())
+        -- Defined at T4485.hs:41:30
+    (The choice depends on the instantiation of ‘m0’
      To pick the first instance above, use IncoherentInstances
      when compiling the other instance declarations)
     In the expression: asChild
     In the expression: asChild $ (genElement "foo")
-    In an equation for ‛asChild’:
+    In an equation for ‘asChild’:
         asChild b = asChild $ (genElement "foo")
 
-T4485.hs:47:26:
-    No instance for (XMLGen m0) arising from a use of ‛genElement’
-    The type variable ‛m0’ is ambiguous
+T4485.hs:46:26:
+    No instance for (XMLGen m0) arising from a use of ‘genElement’
+    The type variable ‘m0’ is ambiguous
     Note: there is a potential instance available:
-      instance [overlap ok] XMLGen (IdentityT m)
-        -- Defined at T4485.hs:36:10
-    In the second argument of ‛($)’, namely ‛(genElement "foo")’
+      instance XMLGen (IdentityT m) -- Defined at T4485.hs:35:10
+    In the second argument of ‘($)’, namely ‘(genElement "foo")’
     In the expression: asChild $ (genElement "foo")
-    In an equation for ‛asChild’:
+    In an equation for ‘asChild’:
         asChild b = asChild $ (genElement "foo")
diff --git a/testsuite/tests/indexed-types/should_fail/T5439.hs b/testsuite/tests/indexed-types/should_fail/T5439.hs
index 396a5436c468..dfcd399b4fb3 100644
--- a/testsuite/tests/indexed-types/should_fail/T5439.hs
+++ b/testsuite/tests/indexed-types/should_fail/T5439.hs
@@ -9,7 +9,6 @@
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE OverlappingInstances #-}
 {-# LANGUAGE UndecidableInstances #-}
 
 module Main where
diff --git a/testsuite/tests/indexed-types/should_fail/T5439.stderr b/testsuite/tests/indexed-types/should_fail/T5439.stderr
index e6e34b19c532..19517cbf578f 100644
--- a/testsuite/tests/indexed-types/should_fail/T5439.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T5439.stderr
@@ -1,25 +1,26 @@
 
-T5439.hs:83:28:
-    Couldn't match type ‛Attempt (HNth n0 l0) -> Attempt (HElemOf l0)’
-                  with ‛Attempt (WaitOpResult (WaitOps rs))’
+T5439.hs:82:28:
+    Couldn't match type ‘Attempt (HHead (HDrop n0 l0))
+                         -> Attempt (HElemOf l0)’
+                  with ‘Attempt (WaitOpResult (WaitOps rs))’
     Expected type: f (Attempt (HNth n0 l0) -> Attempt (HElemOf l0))
       Actual type: f (Attempt (WaitOpResult (WaitOps rs)))
     Relevant bindings include
       register :: Bool -> Peano n -> WaitOps (HDrop n rs) -> IO Bool
-        (bound at T5439.hs:65:9)
+        (bound at T5439.hs:64:9)
       ev :: f (Attempt (WaitOpResult (WaitOps rs)))
-        (bound at T5439.hs:62:22)
-      ops :: WaitOps rs (bound at T5439.hs:62:18)
+        (bound at T5439.hs:61:22)
+      ops :: WaitOps rs (bound at T5439.hs:61:18)
       registerWaitOp :: WaitOps rs
                         -> f (Attempt (WaitOpResult (WaitOps rs))) -> IO Bool
-        (bound at T5439.hs:62:3)
-    In the first argument of ‛complete’, namely ‛ev’
+        (bound at T5439.hs:61:3)
+    In the first argument of ‘complete’, namely ‘ev’
     In the expression: complete ev
 
-T5439.hs:83:39:
-    Couldn't match expected type ‛Peano n0’
-                with actual type ‛Attempt α0’
-    In the second argument of ‛($)’, namely
-      ‛Failure (e :: SomeException)’
-    In the second argument of ‛($)’, namely
-      ‛inj $ Failure (e :: SomeException)’
+T5439.hs:82:39:
+    Couldn't match expected type ‘Peano n0’
+                with actual type ‘Attempt α0’
+    In the second argument of ‘($)’, namely
+      ‘Failure (e :: SomeException)’
+    In the second argument of ‘($)’, namely
+      ‘inj $ Failure (e :: SomeException)’
diff --git a/testsuite/tests/indexed-types/should_fail/T5515.stderr b/testsuite/tests/indexed-types/should_fail/T5515.stderr
index f8056f0dd979..463a30b79081 100644
--- a/testsuite/tests/indexed-types/should_fail/T5515.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T5515.stderr
@@ -1,8 +1,8 @@
 
 T5515.hs:9:3:
-    The RHS of an associated type declaration mentions type variable ‛a’
+    The RHS of an associated type declaration mentions type variable ‘a’
       All such variables must be bound on the LHS
 
 T5515.hs:15:3:
-    The RHS of an associated type declaration mentions type variable ‛a’
+    The RHS of an associated type declaration mentions type variable ‘a’
       All such variables must be bound on the LHS
diff --git a/testsuite/tests/indexed-types/should_fail/T5934.stderr b/testsuite/tests/indexed-types/should_fail/T5934.stderr
index df0ea6e86a92..67a468057cee 100644
--- a/testsuite/tests/indexed-types/should_fail/T5934.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T5934.stderr
@@ -1,7 +1,8 @@
-
-T5934.hs:12:7:
-    Cannot instantiate unification variable ‛a0’
-    with a type involving foralls: (forall s. GenST s) -> Int
-      Perhaps you want ImpredicativeTypes
-    In the expression: 0
-    In an equation for ‛run’: run = 0
+
+T5934.hs:12:7:
+    Couldn't match type ‘Integer’
+                  with ‘(forall s. Gen (PrimState (ST s))) -> Int’
+    Expected type: Integer -> (forall s. GenST s) -> Int
+      Actual type: Integer -> Integer
+    In the expression: 0
+    In an equation for ‘run’: run = 0
diff --git a/testsuite/tests/indexed-types/should_fail/T6123.stderr b/testsuite/tests/indexed-types/should_fail/T6123.stderr
index 4fbdf9bf4bc9..5aec1761e99a 100644
--- a/testsuite/tests/indexed-types/should_fail/T6123.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T6123.stderr
@@ -1,7 +1,7 @@
 
 T6123.hs:10:14:
     Occurs check: cannot construct the infinite type: a0 ~ Id a0
-    The type variable ‛a0’ is ambiguous
+    The type variable ‘a0’ is ambiguous
     Relevant bindings include cundefined :: a0 (bound at T6123.hs:10:1)
     In the expression: cid undefined
-    In an equation for ‛cundefined’: cundefined = cid undefined
+    In an equation for ‘cundefined’: cundefined = cid undefined
diff --git a/testsuite/tests/indexed-types/should_fail/T7010.stderr b/testsuite/tests/indexed-types/should_fail/T7010.stderr
index d0c300c96238..16891fb6b0f6 100644
--- a/testsuite/tests/indexed-types/should_fail/T7010.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T7010.stderr
@@ -1,7 +1,7 @@
 
 T7010.hs:53:27:
-    Couldn't match type ‛Serial (IO Float)’ with ‛IO Float’
+    Couldn't match type ‘Serial (IO Float)’ with ‘IO Float’
     Expected type: (Float, ValueTuple Vector)
       Actual type: (Float, ValueTuple Float)
-    In the first argument of ‛withArgs’, namely ‛plug’
+    In the first argument of ‘withArgs’, namely ‘plug’
     In the expression: withArgs plug
diff --git a/testsuite/tests/indexed-types/should_fail/T7194.stderr b/testsuite/tests/indexed-types/should_fail/T7194.stderr
index 68c2429fe634..dece4fb9e756 100644
--- a/testsuite/tests/indexed-types/should_fail/T7194.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T7194.stderr
@@ -1,7 +1,7 @@
 
 T7194.hs:18:35:
-    Couldn't match expected type ‛b0’ with actual type ‛F a’
-      because type variable ‛a’ would escape its scope
+    Couldn't match expected type ‘b0’ with actual type ‘F a’
+      because type variable ‘a’ would escape its scope
     This (rigid, skolem) type variable is bound by
       the type signature for g :: C (F a) => a -> Int
       at T7194.hs:17:23-41
@@ -10,4 +10,4 @@ T7194.hs:18:35:
       g :: a -> Int (bound at T7194.hs:18:18)
       x :: b0 (bound at T7194.hs:17:9)
     In the expression: foo y
-    In the first argument of ‛length’, namely ‛[x, foo y]’
+    In the first argument of ‘length’, namely ‘[x, foo y]’
diff --git a/testsuite/tests/indexed-types/should_fail/T7354.stderr b/testsuite/tests/indexed-types/should_fail/T7354.stderr
index c548f151ca96..7c505f187623 100644
--- a/testsuite/tests/indexed-types/should_fail/T7354.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T7354.stderr
@@ -6,5 +6,5 @@ T7354.hs:28:11:
       Actual type: Prim [a] a -> a
     Relevant bindings include
       foo :: Prim [a] a -> t (bound at T7354.hs:28:1)
-    In the first argument of ‛ana’, namely ‛alg’
+    In the first argument of ‘ana’, namely ‘alg’
     In the expression: ana alg
diff --git a/testsuite/tests/indexed-types/should_fail/T7354a.stderr b/testsuite/tests/indexed-types/should_fail/T7354a.stderr
index dbad7967eaa4..ac7bc80cc848 100644
--- a/testsuite/tests/indexed-types/should_fail/T7354a.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T7354a.stderr
@@ -1,6 +1,6 @@
 
 T7354a.hs:5:13:
-    Couldn't match expected type ‛Base t t’ with actual type ‛()’
+    Couldn't match expected type ‘Base t t’ with actual type ‘()’
     Relevant bindings include foo :: t (bound at T7354a.hs:5:1)
-    In the first argument of ‛embed’, namely ‛()’
+    In the first argument of ‘embed’, namely ‘()’
     In the expression: embed ()
diff --git a/testsuite/tests/indexed-types/should_fail/T7536.stderr b/testsuite/tests/indexed-types/should_fail/T7536.stderr
index 0c242a90299d..9e7ed3010ea8 100644
--- a/testsuite/tests/indexed-types/should_fail/T7536.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T7536.stderr
@@ -1,5 +1,5 @@
 
 T7536.hs:8:15:
-    Family instance purports to bind type variable ‛a’
+    Family instance purports to bind type variable ‘a’
       but the real LHS (expanding synonyms) is: TF Int = ...
-    In the type instance declaration for ‛TF’
+    In the type instance declaration for ‘TF’
diff --git a/testsuite/tests/indexed-types/should_fail/T7729.stderr b/testsuite/tests/indexed-types/should_fail/T7729.stderr
index 6b0d203a9bcc..bb5a900c4c93 100644
--- a/testsuite/tests/indexed-types/should_fail/T7729.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T7729.stderr
@@ -6,11 +6,11 @@ T7729.hs:28:14:
                       Monad (Rand m),
                       MonadPrim m)
       bound by the instance declaration at T7729.hs:26:10-42
-    The type variable ‛t0’ is ambiguous
+    The type variable ‘t0’ is ambiguous
     Expected type: t0 (BasePrimMonad (Rand m)) a -> Rand m a
       Actual type: BasePrimMonad (Rand m) a -> Rand m a
     Relevant bindings include
       liftPrim :: BasePrimMonad (Rand m) a -> Rand m a
         (bound at T7729.hs:28:3)
-    In the first argument of ‛(.)’, namely ‛liftPrim’
+    In the first argument of ‘(.)’, namely ‘liftPrim’
     In the expression: liftPrim . lift
diff --git a/testsuite/tests/indexed-types/should_fail/T7729a.stderr b/testsuite/tests/indexed-types/should_fail/T7729a.stderr
index c0019c825935..f90db0c491ce 100644
--- a/testsuite/tests/indexed-types/should_fail/T7729a.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T7729a.stderr
@@ -6,12 +6,12 @@ T7729a.hs:28:26:
                       Monad (Rand m),
                       MonadPrim m)
       bound by the instance declaration at T7729a.hs:26:10-42
-    The type variable ‛t0’ is ambiguous
+    The type variable ‘t0’ is ambiguous
     Expected type: BasePrimMonad (Rand m) a
       Actual type: t0 (BasePrimMonad (Rand m)) a
     Relevant bindings include
       x :: BasePrimMonad (Rand m) a (bound at T7729a.hs:28:12)
       liftPrim :: BasePrimMonad (Rand m) a -> Rand m a
         (bound at T7729a.hs:28:3)
-    In the first argument of ‛liftPrim’, namely ‛(lift x)’
+    In the first argument of ‘liftPrim’, namely ‘(lift x)’
     In the expression: liftPrim (lift x)
diff --git a/testsuite/tests/indexed-types/should_fail/T7786.stderr b/testsuite/tests/indexed-types/should_fail/T7786.stderr
index 8c1f64eac0ad..b081ed69b4f9 100644
--- a/testsuite/tests/indexed-types/should_fail/T7786.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T7786.stderr
@@ -1,9 +1,9 @@
 
 T7786.hs:86:22:
-    Couldn't match type ‛xxx’ with ‛'Empty’
+    Couldn't match type ‘xxx’ with ‘'Empty’
     Inaccessible code in
       a pattern with constructor
-        Nil :: Sing 'Empty,
+        Nil :: forall (k :: BOX). Sing 'Empty,
       in a pattern binding in
            'do' block
     In the pattern: Nil
diff --git a/testsuite/tests/indexed-types/should_fail/T7938.stderr b/testsuite/tests/indexed-types/should_fail/T7938.stderr
index 3ac16f135d32..a6aeb8af0b69 100644
--- a/testsuite/tests/indexed-types/should_fail/T7938.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T7938.stderr
@@ -1,6 +1,6 @@
 
 T7938.hs:12:16:
-    Expected kind ‛*’, but ‛KP’ has kind ‛KProxy k2’
-    In the type ‛(KP :: KProxy k2)’
-    In the type instance declaration for ‛Bar’
-    In the instance declaration for ‛Foo (a :: k1) (b :: k2)’
+    Expected kind ‘*’, but ‘KP’ has kind ‘KProxy k2’
+    In the type ‘(KP :: KProxy k2)’
+    In the type instance declaration for ‘Bar’
+    In the instance declaration for ‘Foo (a :: k1) (b :: k2)’
diff --git a/testsuite/tests/indexed-types/should_fail/T7967.stderr b/testsuite/tests/indexed-types/should_fail/T7967.stderr
index 620077601ff4..a7269451fecc 100644
--- a/testsuite/tests/indexed-types/should_fail/T7967.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T7967.stderr
@@ -1,7 +1,7 @@
 
 T7967.hs:31:26:
-    Couldn't match type ‛'[]’ with ‛h0 : t0’
+    Couldn't match type ‘'[]’ with ‘h0 : t0’
     Expected type: Index n l
       Actual type: Index 'Zero (h0 : t0)
     In the expression: IZero
-    In an equation for ‛sNatToIndex’: sNatToIndex SZero HNil = IZero
+    In an equation for ‘sNatToIndex’: sNatToIndex SZero HNil = IZero
diff --git a/testsuite/tests/indexed-types/should_fail/T8155.stderr b/testsuite/tests/indexed-types/should_fail/T8155.stderr
index c85b84b4c8ea..fb0ceb457b95 100644
--- a/testsuite/tests/indexed-types/should_fail/T8155.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T8155.stderr
@@ -1,9 +1,9 @@
 
 T8155.hs:26:14:
     Could not deduce (Integral (BoundsOf (a -> a)))
-      arising from a use of ‛buildV’
+      arising from a use of ‘buildV’
     from the context (Num a)
       bound by the instance declaration at T8155.hs:25:10-32
     In the expression: buildV
-    In an equation for ‛build'’: build' = buildV
-    In the instance declaration for ‛Build (a -> a)’
+    In an equation for ‘build'’: build' = buildV
+    In the instance declaration for ‘Build (a -> a)’
diff --git a/testsuite/tests/indexed-types/should_fail/T8227.stderr b/testsuite/tests/indexed-types/should_fail/T8227.stderr
index e32d0272f67a..8d490d67ca76 100644
--- a/testsuite/tests/indexed-types/should_fail/T8227.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T8227.stderr
@@ -1,7 +1,7 @@
 
 T8227.hs:16:27:
-    Couldn't match type ‛Scalar (V (Scalar (V a)))’ with ‛Scalar (V a)’
-    NB: ‛Scalar’ is a type function, and may not be injective
+    Couldn't match type ‘Scalar (V (Scalar (V a)))’ with ‘Scalar (V a)’
+    NB: ‘Scalar’ is a type function, and may not be injective
     Expected type: Scalar (V a)
       Actual type: Scalar (V (Scalar (V a)))
                    -> Scalar (V (Scalar (V a)))
@@ -11,5 +11,5 @@ T8227.hs:16:27:
       absoluteToParam :: Scalar (V a) -> a -> Scalar (V a)
         (bound at T8227.hs:16:1)
     In the expression: arcLengthToParam eps eps
-    In an equation for ‛absoluteToParam’:
+    In an equation for ‘absoluteToParam’:
         absoluteToParam eps seg = arcLengthToParam eps eps
diff --git a/testsuite/tests/indexed-types/should_fail/T8368.stderr b/testsuite/tests/indexed-types/should_fail/T8368.stderr
index 2ff63d7bb460..058dfb147cf2 100644
--- a/testsuite/tests/indexed-types/should_fail/T8368.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T8368.stderr
@@ -1,6 +1,6 @@
 
 T8368.hs:9:3:
-    Data constructor ‛MkFam’ returns type ‛Foo’
-      instead of an instance of its parent type ‛Fam a’
-    In the definition of data constructor ‛MkFam’
-    In the data instance declaration for ‛Fam’
+    Data constructor ‘MkFam’ returns type ‘Foo’
+      instead of an instance of its parent type ‘Fam a’
+    In the definition of data constructor ‘MkFam’
+    In the data instance declaration for ‘Fam’
diff --git a/testsuite/tests/indexed-types/should_fail/T8368a.stderr b/testsuite/tests/indexed-types/should_fail/T8368a.stderr
index 247a63305b2d..5b20206745ea 100644
--- a/testsuite/tests/indexed-types/should_fail/T8368a.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T8368a.stderr
@@ -1,6 +1,6 @@
 
 T8368a.hs:7:3:
-    Data constructor ‛MkFam’ returns type ‛Fam Bool b’
-      instead of an instance of its parent type ‛Fam Int b’
-    In the definition of data constructor ‛MkFam’
-    In the data instance declaration for ‛Fam’
+    Data constructor ‘MkFam’ returns type ‘Fam Bool b’
+      instead of an instance of its parent type ‘Fam Int b’
+    In the definition of data constructor ‘MkFam’
+    In the data instance declaration for ‘Fam’
diff --git a/testsuite/tests/indexed-types/should_fail/T9036.hs b/testsuite/tests/indexed-types/should_fail/T9036.hs
new file mode 100644
index 000000000000..550adb4b0a5f
--- /dev/null
+++ b/testsuite/tests/indexed-types/should_fail/T9036.hs
@@ -0,0 +1,18 @@
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE TypeFamilies #-}
+
+
+module T9036 where
+
+class UncurryM t where
+  type GetMonad t :: * -> *
+
+class Curry a b where
+  type Curried a b :: *
+
+gSimple :: String -> String -> [String]
+gSimple = simpleLogger (return ())
+
+simpleLogger :: Maybe (GetMonad t after) -> t `Curried` [t]
+simpleLogger _  _ = undefined
diff --git a/testsuite/tests/indexed-types/should_fail/T9036.stderr b/testsuite/tests/indexed-types/should_fail/T9036.stderr
new file mode 100644
index 000000000000..2df53c712cf6
--- /dev/null
+++ b/testsuite/tests/indexed-types/should_fail/T9036.stderr
@@ -0,0 +1,12 @@
+
+T9036.hs:17:17:
+    Couldn't match type ‘GetMonad t0’ with ‘GetMonad t’
+    NB: ‘GetMonad’ is a type function, and may not be injective
+    The type variable ‘t0’ is ambiguous
+    Expected type: Maybe (GetMonad t after) -> Curried t [t]
+      Actual type: Maybe (GetMonad t0 after) -> Curried t0 [t0]
+    In the ambiguity check for:
+      forall t after. Maybe (GetMonad t after) -> Curried t [t]
+    To defer the ambiguity check to use sites, enable AllowAmbiguousTypes
+    In the type signature for ‘simpleLogger’:
+      simpleLogger :: Maybe (GetMonad t after) -> t `Curried` [t]
diff --git a/testsuite/tests/indexed-types/should_fail/T9097.hs b/testsuite/tests/indexed-types/should_fail/T9097.hs
new file mode 100644
index 000000000000..b18b90b5f351
--- /dev/null
+++ b/testsuite/tests/indexed-types/should_fail/T9097.hs
@@ -0,0 +1,10 @@
+{-# LANGUAGE TypeFamilies, DataKinds #-}
+
+module T9097 where
+
+import GHC.Exts
+
+type family Foo x where
+  Foo True = False
+  Foo False = False
+  Foo Any = True
diff --git a/testsuite/tests/indexed-types/should_fail/T9097.stderr b/testsuite/tests/indexed-types/should_fail/T9097.stderr
new file mode 100644
index 000000000000..02dfc330681a
--- /dev/null
+++ b/testsuite/tests/indexed-types/should_fail/T9097.stderr
@@ -0,0 +1,5 @@
+
+T9097.hs:10:3:
+    Illegal type synonym family application in instance: Any
+    In the equations for closed type family ‘Foo’
+    In the type family declaration for ‘Foo’
diff --git a/testsuite/tests/indexed-types/should_fail/T9160.hs b/testsuite/tests/indexed-types/should_fail/T9160.hs
new file mode 100644
index 000000000000..64ae3b9f9cba
--- /dev/null
+++ b/testsuite/tests/indexed-types/should_fail/T9160.hs
@@ -0,0 +1,19 @@
+{-# LANGUAGE FlexibleInstances, TemplateHaskell, PolyKinds, TypeFamilies #-}
+
+module T9160 where
+import Language.Haskell.TH
+
+$( do { cls_nm <- newName "C"
+      ; a_nm   <- newName "a"
+      ; k_nm   <- newName "k"
+      ; f_nm   <- newName "F"
+      ; return [ClassD [] cls_nm [KindedTV a_nm (VarT k_nm)] []
+                    [FamilyD TypeFam f_nm [] (Just (VarT k_nm))]] } )
+
+-- Splices in:
+--     class C (a :: k) where
+--       type F :: k
+
+instance C (a :: *) where
+  type F = Maybe   -- Should be illegal
+
diff --git a/testsuite/tests/indexed-types/should_fail/T9160.stderr b/testsuite/tests/indexed-types/should_fail/T9160.stderr
new file mode 100644
index 000000000000..7a476d4f42cc
--- /dev/null
+++ b/testsuite/tests/indexed-types/should_fail/T9160.stderr
@@ -0,0 +1,11 @@
+Loading package ghc-prim ... linking ... done.
+Loading package integer-gmp ... linking ... done.
+Loading package base ... linking ... done.
+Loading package pretty-1.1.1.1 ... linking ... done.
+Loading package template-haskell ... linking ... done.
+
+T9160.hs:18:8:
+    Type indexes must match class instance head
+    Found ‘* -> *’ but expected ‘*’
+    In the type instance declaration for ‘F’
+    In the instance declaration for ‘C (a :: *)’
diff --git a/testsuite/tests/indexed-types/should_fail/T9167.hs b/testsuite/tests/indexed-types/should_fail/T9167.hs
new file mode 100644
index 000000000000..2d2f555011b8
--- /dev/null
+++ b/testsuite/tests/indexed-types/should_fail/T9167.hs
@@ -0,0 +1,6 @@
+ {-# LANGUAGE TypeFamilies #-}
+
+module T9167 where
+
+class C a where
+   type F b
diff --git a/testsuite/tests/indexed-types/should_fail/T9167.stderr b/testsuite/tests/indexed-types/should_fail/T9167.stderr
new file mode 100644
index 000000000000..1bd21aed5e94
--- /dev/null
+++ b/testsuite/tests/indexed-types/should_fail/T9167.stderr
@@ -0,0 +1,5 @@
+
+T9167.hs:5:1:
+    The associated type ‘F’
+    mentions none of the type or kind variables of the class ‘C a’
+    In the class declaration for ‘C’
diff --git a/testsuite/tests/indexed-types/should_fail/T9171.hs b/testsuite/tests/indexed-types/should_fail/T9171.hs
new file mode 100644
index 000000000000..72a2d707b0e7
--- /dev/null
+++ b/testsuite/tests/indexed-types/should_fail/T9171.hs
@@ -0,0 +1,10 @@
+{-# LANGUAGE PolyKinds, TypeFamilies #-}
+
+module T9171 where
+data Base
+
+type family GetParam (p::k1) (t::k2) :: k3
+
+type instance GetParam Base t = t
+
+foo = undefined :: GetParam Base (GetParam Base Int)
diff --git a/testsuite/tests/indexed-types/should_fail/T9171.stderr b/testsuite/tests/indexed-types/should_fail/T9171.stderr
new file mode 100644
index 000000000000..fe4992511899
--- /dev/null
+++ b/testsuite/tests/indexed-types/should_fail/T9171.stderr
@@ -0,0 +1,22 @@
+
+T9171.hs:10:1:
+    Couldn't match expected type ‘GetParam Base (GetParam Base Int)’
+                with actual type ‘GetParam Base (GetParam Base Int)’
+    NB: ‘GetParam’ is a type function, and may not be injective
+    The kind variable ‘k0’ is ambiguous
+    Use -fprint-explicit-kinds to see the kind arguments
+    When checking that ‘foo’ has the inferred type
+      foo :: forall (k :: BOX). GetParam Base (GetParam Base Int)
+    Probable cause: the inferred type is ambiguous
+
+T9171.hs:10:20:
+    Couldn't match expected type ‘GetParam Base (GetParam Base Int)’
+                with actual type ‘GetParam Base (GetParam Base Int)’
+    NB: ‘GetParam’ is a type function, and may not be injective
+    The kind variable ‘k0’ is ambiguous
+    Use -fprint-explicit-kinds to see the kind arguments
+    In the ambiguity check for:
+      forall (k :: BOX). GetParam Base (GetParam Base Int)
+    To defer the ambiguity check to use sites, enable AllowAmbiguousTypes
+    In an expression type signature: GetParam Base (GetParam Base Int)
+    In the expression: undefined :: GetParam Base (GetParam Base Int)
diff --git a/testsuite/tests/indexed-types/should_fail/T9357.hs b/testsuite/tests/indexed-types/should_fail/T9357.hs
new file mode 100644
index 000000000000..29c57f4a5cf1
--- /dev/null
+++ b/testsuite/tests/indexed-types/should_fail/T9357.hs
@@ -0,0 +1,8 @@
+{-# LANGUAGE RankNTypes, MagicHash, TypeFamilies, PolyKinds #-}
+
+module T9357 where
+import GHC.Exts
+
+type family F (a :: k1) :: k2
+type instance F Int# = Int
+type instance F (forall a. a->a) = Int
diff --git a/testsuite/tests/indexed-types/should_fail/T9357.stderr b/testsuite/tests/indexed-types/should_fail/T9357.stderr
new file mode 100644
index 000000000000..4d97c31fd630
--- /dev/null
+++ b/testsuite/tests/indexed-types/should_fail/T9357.stderr
@@ -0,0 +1,8 @@
+
+T9357.hs:7:15:
+    Illegal unlifted type: Int#
+    In the type instance declaration for ‘F’
+
+T9357.hs:8:15:
+    Illegal polymorphic or qualified type: forall a. a -> a
+    In the type instance declaration for ‘F’
diff --git a/testsuite/tests/indexed-types/should_fail/T9371.hs b/testsuite/tests/indexed-types/should_fail/T9371.hs
new file mode 100644
index 000000000000..cfec4c051fd3
--- /dev/null
+++ b/testsuite/tests/indexed-types/should_fail/T9371.hs
@@ -0,0 +1,25 @@
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+module T9371 where
+
+import Data.Monoid
+
+class C x where
+    data D x :: *
+    makeD :: D x
+
+instance {-# OVERLAPPABLE #-} Monoid x => C x where
+    data D x = D1 (Either x ())
+    makeD = D1 (Left mempty)
+
+instance (Monoid x, Monoid y) => C (x, y) where
+    data D (x,y) = D2 (x,y)
+    makeD = D2 (mempty, mempty)
+
+instance Show x => Show (D x) where
+    show (D1 x) = show x
+
+
+main = print (makeD :: D (String, String))
diff --git a/testsuite/tests/indexed-types/should_fail/T9371.stderr b/testsuite/tests/indexed-types/should_fail/T9371.stderr
new file mode 100644
index 000000000000..695a7b414285
--- /dev/null
+++ b/testsuite/tests/indexed-types/should_fail/T9371.stderr
@@ -0,0 +1,5 @@
+
+T9371.hs:14:10:
+    Conflicting family instance declarations:
+      D -- Defined at T9371.hs:14:10
+      D (x, y) -- Defined at T9371.hs:18:10
diff --git a/testsuite/tests/indexed-types/should_fail/TyFamArity1.stderr b/testsuite/tests/indexed-types/should_fail/TyFamArity1.stderr
index adfcc37a0045..b99c8d9934a9 100644
--- a/testsuite/tests/indexed-types/should_fail/TyFamArity1.stderr
+++ b/testsuite/tests/indexed-types/should_fail/TyFamArity1.stderr
@@ -1,4 +1,4 @@
 
 TyFamArity1.hs:4:15:
     Number of parameters must match family declaration; expected 2
-    In the type instance declaration for ‛T’
+    In the type instance declaration for ‘T’
diff --git a/testsuite/tests/indexed-types/should_fail/TyFamArity2.stderr b/testsuite/tests/indexed-types/should_fail/TyFamArity2.stderr
index d602a2d5e0ef..28107aaed6a4 100644
--- a/testsuite/tests/indexed-types/should_fail/TyFamArity2.stderr
+++ b/testsuite/tests/indexed-types/should_fail/TyFamArity2.stderr
@@ -1,4 +1,4 @@
 
 TyFamArity2.hs:4:15:
     Number of parameters must match family declaration; expected 1
-    In the type instance declaration for ‛T’
+    In the type instance declaration for ‘T’
diff --git a/testsuite/tests/indexed-types/should_fail/TyFamUndec.stderr b/testsuite/tests/indexed-types/should_fail/TyFamUndec.stderr
index da77e0802490..15cd757181ee 100644
--- a/testsuite/tests/indexed-types/should_fail/TyFamUndec.stderr
+++ b/testsuite/tests/indexed-types/should_fail/TyFamUndec.stderr
@@ -1,18 +1,18 @@
 
 TyFamUndec.hs:6:15:
-    Variable ‛b’ occurs more often than in the instance head
+    Variable ‘b’ occurs more often than in the instance head
       in the type family application: T (b, b)
     (Use UndecidableInstances to permit this)
-    In the type instance declaration for ‛T’
+    In the type instance declaration for ‘T’
 
 TyFamUndec.hs:7:15:
     Application is no smaller than the instance head
       in the type family application: T (a, Maybe b)
     (Use UndecidableInstances to permit this)
-    In the type instance declaration for ‛T’
+    In the type instance declaration for ‘T’
 
 TyFamUndec.hs:8:15:
     Nested type family application
       in the type family application: T (a, T b)
     (Use UndecidableInstances to permit this)
-    In the type instance declaration for ‛T’
+    In the type instance declaration for ‘T’
diff --git a/testsuite/tests/indexed-types/should_fail/all.T b/testsuite/tests/indexed-types/should_fail/all.T
index 54a33cd83d21..6d284cf19d6d 100644
--- a/testsuite/tests/indexed-types/should_fail/all.T
+++ b/testsuite/tests/indexed-types/should_fail/all.T
@@ -47,7 +47,7 @@ test('T2157', normal, compile_fail, [''])
 test('T2203a', normal, compile_fail, [''])
 test('T2627b', normal, compile_fail, [''])
 test('T2693', normal, compile_fail, [''])
-test('T2888', normal, compile, [''])
+test('T2888', normal, compile_fail, [''])
 test('T3092', normal, compile_fail, [''])
 test('NoMatchErr', normal, compile_fail, [''])
 test('T2677', normal, compile_fail, [''])
@@ -119,4 +119,10 @@ test('T8129',
 test('T8368', normal, compile_fail, [''])
 test('T8368a', normal, compile_fail, [''])
 test('T8518', normal, compile_fail, [''])
-
+test('T9036', normal, compile_fail, [''])
+test('T9167', normal, compile_fail, [''])
+test('T9171', normal, compile_fail, [''])
+test('T9097', normal, compile_fail, [''])
+test('T9160', normal, compile_fail, [''])
+test('T9357', normal, compile_fail, [''])
+test('T9371', normal, compile_fail, [''])
diff --git a/testsuite/tests/layout/layout001.stdout b/testsuite/tests/layout/layout001.stdout
index 682f863bcb26..50b2cf4ab7e5 100644
--- a/testsuite/tests/layout/layout001.stdout
+++ b/testsuite/tests/layout/layout001.stdout
@@ -1,7 +1,7 @@
 Running with -XNoAlternativeLayoutRule
 Running with -XAlternativeLayoutRule
 
-layout001.hs:6:3: parse error on input ‛where’
+layout001.hs:6:3: parse error on input ‘where’
 Running with -XAlternativeLayoutRule -XAlternativeLayoutRuleTransitional
 
 layout001.hs:6:3: Warning:
diff --git a/testsuite/tests/layout/layout003.stdout b/testsuite/tests/layout/layout003.stdout
index ef1a1f84bcbf..171dc22d7e6d 100644
--- a/testsuite/tests/layout/layout003.stdout
+++ b/testsuite/tests/layout/layout003.stdout
@@ -1,7 +1,7 @@
 Running with -XNoAlternativeLayoutRule
 Running with -XAlternativeLayoutRule
 
-layout003.hs:11:4: parse error on input ‛|’
+layout003.hs:11:4: parse error on input ‘|’
 Running with -XAlternativeLayoutRule -XAlternativeLayoutRuleTransitional
 
 layout003.hs:11:4: Warning:
diff --git a/testsuite/tests/layout/layout004.stdout b/testsuite/tests/layout/layout004.stdout
index d8e3ab61964e..264606f13cf6 100644
--- a/testsuite/tests/layout/layout004.stdout
+++ b/testsuite/tests/layout/layout004.stdout
@@ -1,7 +1,7 @@
 Running with -XNoAlternativeLayoutRule
 Running with -XAlternativeLayoutRule
 
-layout004.hs:7:14: parse error on input ‛,’
+layout004.hs:7:14: parse error on input ‘,’
 Running with -XAlternativeLayoutRule -XAlternativeLayoutRuleTransitional
 
-layout004.hs:7:14: parse error on input ‛,’
+layout004.hs:7:14: parse error on input ‘,’
diff --git a/testsuite/tests/layout/layout006.stdout b/testsuite/tests/layout/layout006.stdout
index a8986dbfe8c7..cba315173428 100644
--- a/testsuite/tests/layout/layout006.stdout
+++ b/testsuite/tests/layout/layout006.stdout
@@ -1,7 +1,7 @@
 Running with -XNoAlternativeLayoutRule
 Running with -XAlternativeLayoutRule
 
-layout006.hs:12:2: parse error on input ‛|’
+layout006.hs:12:2: parse error on input ‘|’
 Running with -XAlternativeLayoutRule -XAlternativeLayoutRuleTransitional
 
 layout006.hs:12:2: Warning:
diff --git a/testsuite/tests/mdo/should_fail/mdofail001.stderr b/testsuite/tests/mdo/should_fail/mdofail001.stderr
index 8d6d86bc9772..00de25336789 100644
--- a/testsuite/tests/mdo/should_fail/mdofail001.stderr
+++ b/testsuite/tests/mdo/should_fail/mdofail001.stderr
@@ -1,6 +1,6 @@
 
 mdofail001.hs:10:32:
-    No instance for (Num Char) arising from the literal ‛1’
+    No instance for (Num Char) arising from the literal ‘1’
     In the expression: 1
-    In the first argument of ‛l’, namely ‛[1, 2, 3]’
+    In the first argument of ‘l’, namely ‘[1, 2, 3]’
     In the expression: l [1, 2, 3]
diff --git a/testsuite/tests/mdo/should_fail/mdofail002.stderr b/testsuite/tests/mdo/should_fail/mdofail002.stderr
index badd7383e7a5..7c0d7b679c8c 100644
--- a/testsuite/tests/mdo/should_fail/mdofail002.stderr
+++ b/testsuite/tests/mdo/should_fail/mdofail002.stderr
@@ -1,5 +1,5 @@
 
 mdofail002.hs:10:9:
-    Conflicting definitions for ‛x’
+    Conflicting definitions for ‘x’
     Bound at: mdofail002.hs:10:9
               mdofail002.hs:11:9
diff --git a/testsuite/tests/mdo/should_fail/mdofail003.stderr b/testsuite/tests/mdo/should_fail/mdofail003.stderr
index ccb10dfb80f7..6d9741280ebd 100644
--- a/testsuite/tests/mdo/should_fail/mdofail003.stderr
+++ b/testsuite/tests/mdo/should_fail/mdofail003.stderr
@@ -1,5 +1,5 @@
 
 mdofail003.hs:10:9:
-    Conflicting definitions for ‛x’
+    Conflicting definitions for ‘x’
     Bound at: mdofail003.hs:10:9
               mdofail003.hs:11:13
diff --git a/testsuite/tests/mdo/should_fail/mdofail005.stderr b/testsuite/tests/mdo/should_fail/mdofail005.stderr
index e5c81c38380d..548129117a5a 100644
--- a/testsuite/tests/mdo/should_fail/mdofail005.stderr
+++ b/testsuite/tests/mdo/should_fail/mdofail005.stderr
@@ -1,2 +1,2 @@
 
-mdofail005.hs:11:14: parse error on input ‛<-’
+mdofail005.hs:11:14: parse error on input ‘<-’
diff --git a/testsuite/tests/module/T414.stderr b/testsuite/tests/module/T414.stderr
index 57d43af55585..70c0cdecf79c 100644
--- a/testsuite/tests/module/T414.stderr
+++ b/testsuite/tests/module/T414.stderr
@@ -1,2 +1,2 @@
 
-T414.hs:1:1: The IO action ‛main’ is not exported by module ‛Main’
+T414.hs:1:1: The IO action ‘main’ is not exported by module ‘Main’
diff --git a/testsuite/tests/module/T9061.hs b/testsuite/tests/module/T9061.hs
new file mode 100644
index 000000000000..1417dcad759d
--- /dev/null
+++ b/testsuite/tests/module/T9061.hs
@@ -0,0 +1,6 @@
+{-# OPTIONS_GHC -fwarn-unused-imports #-}
+module T9061 where
+
+import Prelude hiding (log)
+
+f = log where log = ()
diff --git a/testsuite/tests/module/all.T b/testsuite/tests/module/all.T
index 8eaa1d5217bf..cb5ce2fe8d83 100644
--- a/testsuite/tests/module/all.T
+++ b/testsuite/tests/module/all.T
@@ -91,7 +91,16 @@ test('mod69', normal, compile_fail, [''])
 test('mod70', normal, compile_fail, [''])
 test('mod71', normal, compile_fail, [''])
 test('mod72', normal, compile_fail, [''])
-test('mod73', normal, compile_fail, [''])
+
+# The order of suggestions in the output for test mod73
+# is subject to variation depending on the optimization level
+# that GHC was built with (and probably minor changes to GHC too).
+# This seems okay since there is unsafePerformIO under the hood
+# in FastString. Allow any order with an extra normaliser. (See #9325.)
+def normalise_mod73_error(x):
+    return x.replace('LT','XX',1).replace('EQ','XX',1).replace('GT','XX',1)
+test('mod73', normalise_errmsg_fun(normalise_mod73_error), compile_fail, [''])
+
 test('mod74', normal, compile_fail, [''])
 test('mod75', normal, compile, [''])
 test('mod76', normal, compile_fail, [''])
@@ -334,3 +343,4 @@ test('T414', normal, compile_fail, [''])
 test('T414a', normal, compile, [''])
 test('T414b', normal, compile, [''])
 test('T3776', normal, compile, [''])
+test('T9061', normal, compile, [''])
diff --git a/testsuite/tests/module/base01/Makefile b/testsuite/tests/module/base01/Makefile
index 815fbff1d4ab..6f77c09a36eb 100644
--- a/testsuite/tests/module/base01/Makefile
+++ b/testsuite/tests/module/base01/Makefile
@@ -9,6 +9,6 @@ clean:
 base01:
 	rm -f GHC/*.o
 	rm -f GHC/*.hi
-	'$(TEST_HC)' $(filter-out -fforce-recomp,$(TEST_HC_OPTS)) -XNoImplicitPrelude -package-name base -c GHC/Base.hs
-	'$(TEST_HC)' $(filter-out -fforce-recomp,$(TEST_HC_OPTS)) -XNoImplicitPrelude -package-name base --make GHC.Foo
+	'$(TEST_HC)' $(filter-out -fforce-recomp,$(TEST_HC_OPTS)) -XNoImplicitPrelude -this-package-key base -c GHC/Base.hs
+	'$(TEST_HC)' $(filter-out -fforce-recomp,$(TEST_HC_OPTS)) -XNoImplicitPrelude -this-package-key base --make GHC.Foo
 
diff --git a/testsuite/tests/module/mod1.stderr b/testsuite/tests/module/mod1.stderr
index 51d9e07b1dee..ecc147513d2a 100644
--- a/testsuite/tests/module/mod1.stderr
+++ b/testsuite/tests/module/mod1.stderr
@@ -1,4 +1,4 @@
 
 mod1.hs:3:1:
-    Failed to load interface for ‛N’
+    Failed to load interface for ‘N’
     Use -v to see a list of the files searched for.
diff --git a/testsuite/tests/module/mod10.stderr b/testsuite/tests/module/mod10.stderr
index 6cc2caf59e82..dd08d880b351 100644
--- a/testsuite/tests/module/mod10.stderr
+++ b/testsuite/tests/module/mod10.stderr
@@ -1,2 +1,2 @@
 
-mod10.hs:2:10: Not in scope: type constructor or class ‛T’
+mod10.hs:2:10: Not in scope: type constructor or class ‘T’
diff --git a/testsuite/tests/module/mod101.stderr b/testsuite/tests/module/mod101.stderr
index 306884fa8f93..bb8eecf5461f 100644
--- a/testsuite/tests/module/mod101.stderr
+++ b/testsuite/tests/module/mod101.stderr
@@ -1,4 +1,4 @@
 
 mod101.hs:8:5:
-    Not in scope: data constructor ‛ConB’
-    Perhaps you meant ‛ConA’ (imported from Mod101_AuxB)
+    Not in scope: data constructor ‘ConB’
+    Perhaps you meant ‘ConA’ (imported from Mod101_AuxB)
diff --git a/testsuite/tests/module/mod102.stderr b/testsuite/tests/module/mod102.stderr
index a33246f12c65..91aca9f6200d 100644
--- a/testsuite/tests/module/mod102.stderr
+++ b/testsuite/tests/module/mod102.stderr
@@ -1,4 +1,4 @@
 
 mod102.hs:8:5:
-    Not in scope: ‛methB’
-    Perhaps you meant ‛methA’ (imported from Mod102_AuxB)
+    Not in scope: ‘methB’
+    Perhaps you meant ‘methA’ (imported from Mod102_AuxB)
diff --git a/testsuite/tests/module/mod110.stderr b/testsuite/tests/module/mod110.stderr
index f3e3ce93fbb2..1018f69f0d36 100644
--- a/testsuite/tests/module/mod110.stderr
+++ b/testsuite/tests/module/mod110.stderr
@@ -1,7 +1,7 @@
 
 mod110.hs:11:10:
-    Ambiguous occurrence ‛Eq’
-    It could refer to either ‛M.Eq’, defined at mod110.hs:7:1
-                          or ‛Prelude.Eq’,
-                             imported from ‛Prelude’ at mod110.hs:4:1-14
-                             (and originally defined in ‛GHC.Classes’)
+    Ambiguous occurrence ‘Eq’
+    It could refer to either ‘M.Eq’, defined at mod110.hs:7:1
+                          or ‘Prelude.Eq’,
+                             imported from ‘Prelude’ at mod110.hs:4:1-14
+                             (and originally defined in ‘GHC.Classes’)
diff --git a/testsuite/tests/module/mod114.stderr b/testsuite/tests/module/mod114.stderr
index 84131b47f53d..673dc95b3a46 100644
--- a/testsuite/tests/module/mod114.stderr
+++ b/testsuite/tests/module/mod114.stderr
@@ -1,2 +1,2 @@
 
-mod114.hs:3:16: Not in scope: type constructor or class ‛Stuff’
+mod114.hs:3:16: Not in scope: type constructor or class ‘Stuff’
diff --git a/testsuite/tests/module/mod116.stderr b/testsuite/tests/module/mod116.stderr
index c46059c5d62e..6dd4a9fc023c 100644
--- a/testsuite/tests/module/mod116.stderr
+++ b/testsuite/tests/module/mod116.stderr
@@ -1,2 +1,2 @@
 
-mod116.hs:2:18: Not in scope: type constructor or class ‛M2’
+mod116.hs:2:18: Not in scope: type constructor or class ‘M2’
diff --git a/testsuite/tests/module/mod120.stderr b/testsuite/tests/module/mod120.stderr
index 2643f9258f8c..8c68fa091cd9 100644
--- a/testsuite/tests/module/mod120.stderr
+++ b/testsuite/tests/module/mod120.stderr
@@ -1,2 +1,2 @@
 
-mod120.hs:5:5: Not in scope: data constructor ‛Foo’
+mod120.hs:5:5: Not in scope: data constructor ‘Foo’
diff --git a/testsuite/tests/module/mod121.stderr b/testsuite/tests/module/mod121.stderr
index 16ea4bf62763..7036ddb935c6 100644
--- a/testsuite/tests/module/mod121.stderr
+++ b/testsuite/tests/module/mod121.stderr
@@ -1,4 +1,4 @@
 
 mod121.hs:5:5:
-    Not in scope: ‛m2’
-    Perhaps you meant ‛m1’ (imported from Mod121_A)
+    Not in scope: ‘m2’
+    Perhaps you meant ‘m1’ (imported from Mod121_A)
diff --git a/testsuite/tests/module/mod122.stderr b/testsuite/tests/module/mod122.stderr
index 45e4f1699c53..90719ecf0661 100644
--- a/testsuite/tests/module/mod122.stderr
+++ b/testsuite/tests/module/mod122.stderr
@@ -1,2 +1,2 @@
 
-mod122.hs:5:6: Not in scope: type constructor or class ‛C’
+mod122.hs:5:6: Not in scope: type constructor or class ‘C’
diff --git a/testsuite/tests/module/mod123.stderr b/testsuite/tests/module/mod123.stderr
index b631454857af..9d9de6bbb26e 100644
--- a/testsuite/tests/module/mod123.stderr
+++ b/testsuite/tests/module/mod123.stderr
@@ -1,2 +1,2 @@
 
-mod123.hs:5:6: Not in scope: type constructor or class ‛T’
+mod123.hs:5:6: Not in scope: type constructor or class ‘T’
diff --git a/testsuite/tests/module/mod124.stderr b/testsuite/tests/module/mod124.stderr
index 66cad7ee3697..83113e9c5f69 100644
--- a/testsuite/tests/module/mod124.stderr
+++ b/testsuite/tests/module/mod124.stderr
@@ -1,2 +1,2 @@
 
-mod124.hs:6:6: Not in scope: type constructor or class ‛T’
+mod124.hs:6:6: Not in scope: type constructor or class ‘T’
diff --git a/testsuite/tests/module/mod125.stderr b/testsuite/tests/module/mod125.stderr
index 9fa21e7875d7..1d56d076afcd 100644
--- a/testsuite/tests/module/mod125.stderr
+++ b/testsuite/tests/module/mod125.stderr
@@ -1,2 +1,2 @@
 
-mod125.hs:7:5: Not in scope: data constructor ‛T’
+mod125.hs:7:5: Not in scope: data constructor ‘T’
diff --git a/testsuite/tests/module/mod126.stderr b/testsuite/tests/module/mod126.stderr
index 474e6eb490c8..26d26330be2d 100644
--- a/testsuite/tests/module/mod126.stderr
+++ b/testsuite/tests/module/mod126.stderr
@@ -1,2 +1,2 @@
 
-mod126.hs:7:5: Not in scope: data constructor ‛T’
+mod126.hs:7:5: Not in scope: data constructor ‘T’
diff --git a/testsuite/tests/module/mod127.stderr b/testsuite/tests/module/mod127.stderr
index b208503368ae..83909e823607 100644
--- a/testsuite/tests/module/mod127.stderr
+++ b/testsuite/tests/module/mod127.stderr
@@ -1,2 +1,2 @@
 
-mod127.hs:6:6: Not in scope: type constructor or class ‛T’
+mod127.hs:6:6: Not in scope: type constructor or class ‘T’
diff --git a/testsuite/tests/module/mod128.stderr-ghc b/testsuite/tests/module/mod128.stderr-ghc
index 4363290fb3b8..bfd02c6b8d8e 100644
--- a/testsuite/tests/module/mod128.stderr-ghc
+++ b/testsuite/tests/module/mod128.stderr-ghc
@@ -1,2 +1,2 @@
 
-Mod128_A.hs:2:19: Warning: ‛T’ is exported by ‛T(Con)’ and ‛T’
+Mod128_A.hs:2:19: Warning: ‘T’ is exported by ‘T(Con)’ and ‘T’
diff --git a/testsuite/tests/module/mod130.stderr b/testsuite/tests/module/mod130.stderr
index bb1aff176b9b..87fb842e7a29 100644
--- a/testsuite/tests/module/mod130.stderr
+++ b/testsuite/tests/module/mod130.stderr
@@ -1,2 +1,2 @@
 
-mod130.hs:7:5: Not in scope: ‛<’
+mod130.hs:7:5: Not in scope: ‘<’
diff --git a/testsuite/tests/module/mod131.stderr b/testsuite/tests/module/mod131.stderr
index 2b877aaae36e..1b362e4a47e9 100644
--- a/testsuite/tests/module/mod131.stderr
+++ b/testsuite/tests/module/mod131.stderr
@@ -1,9 +1,9 @@
 
 mod131.hs:2:27:
-    Conflicting exports for ‛f’:
-       ‛module Mod131_B’ exports ‛f’
-         imported from ‛Mod131_B’ at mod131.hs:3:17
+    Conflicting exports for ‘f’:
+       ‘module Mod131_B’ exports ‘f’
+         imported from ‘Mod131_B’ at mod131.hs:3:17
          (and originally defined at Mod131_B.hs:3:1)
-       ‛Mod131_A.f’ exports ‛Mod131_A.f’
-         imported qualified from ‛Mod131_A’ at mod131.hs:4:27
+       ‘Mod131_A.f’ exports ‘Mod131_A.f’
+         imported qualified from ‘Mod131_A’ at mod131.hs:4:27
          (and originally defined at Mod131_A.hs:3:1)
diff --git a/testsuite/tests/module/mod132.stderr b/testsuite/tests/module/mod132.stderr
index 4afecd8f874a..0a9d25cda8f8 100644
--- a/testsuite/tests/module/mod132.stderr
+++ b/testsuite/tests/module/mod132.stderr
@@ -1,2 +1,4 @@
 
-mod132.hs:6:7: Not in scope: data constructor ‛Foo’
+mod132.hs:6:7:
+    Not in scope: data constructor ‘Foo’
+    Perhaps you meant variable ‘foo’ (line 6)
diff --git a/testsuite/tests/module/mod134.stderr b/testsuite/tests/module/mod134.stderr
index 3270f93b68e9..d6e6f0e30beb 100644
--- a/testsuite/tests/module/mod134.stderr
+++ b/testsuite/tests/module/mod134.stderr
@@ -1,7 +1,7 @@
 
 mod134.hs:6:19:
-    Not in scope: ‛Prelude.head’
+    Not in scope: ‘Prelude.head’
     Perhaps you meant one of these:
-      ‛Prelude.read’ (imported from Prelude),
-      ‛Prelude.reads’ (imported from Prelude),
-      ‛Prelude.snd’ (imported from Prelude)
+      ‘Prelude.read’ (imported from Prelude),
+      ‘Prelude.reads’ (imported from Prelude),
+      data constructor ‘Prelude.Left’ (imported from Prelude)
diff --git a/testsuite/tests/module/mod136.stderr b/testsuite/tests/module/mod136.stderr
index 2a0feed97e24..58dab52093c5 100644
--- a/testsuite/tests/module/mod136.stderr
+++ b/testsuite/tests/module/mod136.stderr
@@ -1,6 +1,6 @@
 
 mod136.hs:6:5:
-    Not in scope: ‛zipWith5’
+    Not in scope: ‘zipWith5’
     Perhaps you meant one of these:
-      ‛zipWith’ (imported from Mod136_A),
-      ‛zipWith3’ (imported from Mod136_A)
+      ‘zipWith’ (imported from Mod136_A),
+      ‘zipWith3’ (imported from Mod136_A)
diff --git a/testsuite/tests/module/mod138.stderr b/testsuite/tests/module/mod138.stderr
index 5b006ee3264f..7886bcdde541 100644
--- a/testsuite/tests/module/mod138.stderr
+++ b/testsuite/tests/module/mod138.stderr
@@ -1,2 +1,2 @@
 
-mod138.hs:7:5: Not in scope: ‛isLatin1’
+mod138.hs:7:5: Not in scope: ‘isLatin1’
diff --git a/testsuite/tests/module/mod14.stderr-ghc b/testsuite/tests/module/mod14.stderr-ghc
index 9eec91d71556..682cbe3400e2 100644
--- a/testsuite/tests/module/mod14.stderr-ghc
+++ b/testsuite/tests/module/mod14.stderr-ghc
@@ -1,3 +1,3 @@
 
 mod14.hs:2:10: Warning:
-    ‛m2’ is exported by ‛C(m1, m2, m2, m3)’ and ‛C(m1, m2, m2, m3)’
+    ‘m2’ is exported by ‘C(m1, m2, m2, m3)’ and ‘C(m1, m2, m2, m3)’
diff --git a/testsuite/tests/module/mod142.stderr b/testsuite/tests/module/mod142.stderr
index f31723d0209a..0ed3fdbbf4a5 100644
--- a/testsuite/tests/module/mod142.stderr
+++ b/testsuite/tests/module/mod142.stderr
@@ -1,7 +1,7 @@
 
 mod142.hs:2:21:
-    Conflicting exports for ‛x’:
-       ‛module Mod142_A’ exports ‛Mod142_A.x’
-         imported from ‛Mod142_A’ at mod142.hs:4:1-15
+    Conflicting exports for ‘x’:
+       ‘module Mod142_A’ exports ‘Mod142_A.x’
+         imported from ‘Mod142_A’ at mod142.hs:4:1-15
          (and originally defined at Mod142_A.hs:3:1)
-       ‛module M’ exports ‛M.x’ defined at mod142.hs:6:1
+       ‘module M’ exports ‘M.x’ defined at mod142.hs:6:1
diff --git a/testsuite/tests/module/mod143.stderr b/testsuite/tests/module/mod143.stderr
index a229aba01647..2e28ad7edb6c 100644
--- a/testsuite/tests/module/mod143.stderr
+++ b/testsuite/tests/module/mod143.stderr
@@ -1,7 +1,7 @@
 
 mod143.hs:2:21:
-    Conflicting exports for ‛Foo’:
-       ‛module Mod143_A’ exports ‛Mod143_A.Foo’
-         imported from ‛Mod143_A’ at mod143.hs:4:1-15
+    Conflicting exports for ‘Foo’:
+       ‘module Mod143_A’ exports ‘Mod143_A.Foo’
+         imported from ‘Mod143_A’ at mod143.hs:4:1-15
          (and originally defined at Mod143_A.hs:3:1-14)
-       ‛module M’ exports ‛M.Foo’ defined at mod143.hs:6:1
+       ‘module M’ exports ‘M.Foo’ defined at mod143.hs:6:1
diff --git a/testsuite/tests/module/mod144.stderr b/testsuite/tests/module/mod144.stderr
index 9742a7611124..02330dc1b923 100644
--- a/testsuite/tests/module/mod144.stderr
+++ b/testsuite/tests/module/mod144.stderr
@@ -1,7 +1,7 @@
 
 mod144.hs:2:27:
-    Conflicting exports for ‛Bar’:
-       ‛module Mod144_A’ exports ‛Mod144_A.Bar’
-         imported from ‛Mod144_A’ at mod144.hs:4:1-15
-       ‛module M’ exports ‛M.Bar’ defined at mod144.hs:6:13
+    Conflicting exports for ‘Bar’:
+       ‘module Mod144_A’ exports ‘Mod144_A.Bar’
+         imported from ‘Mod144_A’ at mod144.hs:4:1-15
+       ‘module M’ exports ‘M.Bar’ defined at mod144.hs:6:13
 exit(1)
diff --git a/testsuite/tests/module/mod145.stderr b/testsuite/tests/module/mod145.stderr
index 1f94faea97b1..ac55593a0150 100644
--- a/testsuite/tests/module/mod145.stderr
+++ b/testsuite/tests/module/mod145.stderr
@@ -1,7 +1,7 @@
 
 mod145.hs:2:30:
-    Conflicting exports for ‛m1’:
-       ‛module Mod145_A’ exports ‛Mod145_A.m1’
-         imported from ‛Mod145_A’ at mod145.hs:4:1-15
+    Conflicting exports for ‘m1’:
+       ‘module Mod145_A’ exports ‘Mod145_A.m1’
+         imported from ‘Mod145_A’ at mod145.hs:4:1-15
          (and originally defined at Mod145_A.hs:4:3-20)
-       ‛module Mod145’ exports ‛Mod145.m1’ defined at mod145.hs:7:3
+       ‘module Mod145’ exports ‘Mod145.m1’ defined at mod145.hs:7:3
diff --git a/testsuite/tests/module/mod146.stderr b/testsuite/tests/module/mod146.stderr
index 160c76c116f0..4d771478ec2e 100644
--- a/testsuite/tests/module/mod146.stderr
+++ b/testsuite/tests/module/mod146.stderr
@@ -1,7 +1,7 @@
 
 mod146.hs:2:30:
-    Conflicting exports for ‛m1’:
-       ‛module Mod145_A’ exports ‛Mod145_A.m1’
-         imported from ‛Mod145_A’ at mod146.hs:4:1-15
-       ‛module Mod146’ exports ‛Mod146.m1’ defined at mod146.hs:7:3
+    Conflicting exports for ‘m1’:
+       ‘module Mod145_A’ exports ‘Mod145_A.m1’
+         imported from ‘Mod145_A’ at mod146.hs:4:1-15
+       ‘module Mod146’ exports ‘Mod146.m1’ defined at mod146.hs:7:3
 exit(1)
diff --git a/testsuite/tests/module/mod147.stderr b/testsuite/tests/module/mod147.stderr
index f57f2d8ad486..ce7101c07704 100644
--- a/testsuite/tests/module/mod147.stderr
+++ b/testsuite/tests/module/mod147.stderr
@@ -1,2 +1,2 @@
 
-mod147.hs:6:5: Not in scope: data constructor ‛D’
+mod147.hs:6:5: Not in scope: data constructor ‘D’
diff --git a/testsuite/tests/module/mod150.stderr b/testsuite/tests/module/mod150.stderr
index e1748d7725f0..2dc9feb66fcd 100644
--- a/testsuite/tests/module/mod150.stderr
+++ b/testsuite/tests/module/mod150.stderr
@@ -1,7 +1,7 @@
 
 mod150.hs:2:20:
-    Conflicting exports for ‛id’:
-       ‛module Prelude’ exports ‛Prelude.id’
-         imported from ‛Prelude’ at mod150.hs:2:8
-         (and originally defined in ‛GHC.Base’)
-       ‛module M’ exports ‛M.id’ defined at mod150.hs:2:42
+    Conflicting exports for ‘id’:
+       ‘module Prelude’ exports ‘Prelude.id’
+         imported from ‘Prelude’ at mod150.hs:2:8
+         (and originally defined in ‘GHC.Base’)
+       ‘module M’ exports ‘M.id’ defined at mod150.hs:2:42
diff --git a/testsuite/tests/module/mod151.stderr b/testsuite/tests/module/mod151.stderr
index 505fdb8c4c9d..9f750584f092 100644
--- a/testsuite/tests/module/mod151.stderr
+++ b/testsuite/tests/module/mod151.stderr
@@ -1,7 +1,7 @@
 
 mod151.hs:2:20:
-    Ambiguous occurrence ‛id’
-    It could refer to either ‛M.id’, defined at mod151.hs:2:30
-                          or ‛Prelude.id’,
-                             imported from ‛Prelude’ at mod151.hs:2:8
-                             (and originally defined in ‛GHC.Base’)
+    Ambiguous occurrence ‘id’
+    It could refer to either ‘M.id’, defined at mod151.hs:2:30
+                          or ‘Prelude.id’,
+                             imported from ‘Prelude’ at mod151.hs:2:8
+                             (and originally defined in ‘GHC.Base’)
diff --git a/testsuite/tests/module/mod152.stderr b/testsuite/tests/module/mod152.stderr
index e385e1e6e4bf..3c96bc1270df 100644
--- a/testsuite/tests/module/mod152.stderr
+++ b/testsuite/tests/module/mod152.stderr
@@ -1,14 +1,14 @@
 
 mod152.hs:2:26:
-    Ambiguous occurrence ‛id’
-    It could refer to either ‛M.id’, defined at mod152.hs:2:36
-                          or ‛Prelude.id’,
-                             imported from ‛Prelude’ at mod152.hs:2:8
-                             (and originally defined in ‛GHC.Base’)
+    Ambiguous occurrence ‘id’
+    It could refer to either ‘M.id’, defined at mod152.hs:2:36
+                          or ‘Prelude.id’,
+                             imported from ‘Prelude’ at mod152.hs:2:8
+                             (and originally defined in ‘GHC.Base’)
 
 mod152.hs:2:26:
-    Conflicting exports for ‛id’:
-       ‛module Prelude’ exports ‛Prelude.id’
-         imported from ‛Prelude’ at mod152.hs:2:8
-         (and originally defined in ‛GHC.Base’)
-       ‛id’ exports ‛M.id’ defined at mod152.hs:2:36
+    Conflicting exports for ‘id’:
+       ‘module Prelude’ exports ‘Prelude.id’
+         imported from ‘Prelude’ at mod152.hs:2:8
+         (and originally defined in ‘GHC.Base’)
+       ‘id’ exports ‘M.id’ defined at mod152.hs:2:36
diff --git a/testsuite/tests/module/mod153.stderr b/testsuite/tests/module/mod153.stderr
index 79532da84620..fa5283b9efba 100644
--- a/testsuite/tests/module/mod153.stderr
+++ b/testsuite/tests/module/mod153.stderr
@@ -1,7 +1,7 @@
 
 mod153.hs:2:11:
-    Ambiguous occurrence ‛id’
-    It could refer to either ‛M.id’, defined at mod153.hs:2:21
-                          or ‛Prelude.id’,
-                             imported from ‛Prelude’ at mod153.hs:2:8
-                             (and originally defined in ‛GHC.Base’)
+    Ambiguous occurrence ‘id’
+    It could refer to either ‘M.id’, defined at mod153.hs:2:21
+                          or ‘Prelude.id’,
+                             imported from ‘Prelude’ at mod153.hs:2:8
+                             (and originally defined in ‘GHC.Base’)
diff --git a/testsuite/tests/module/mod155.stderr b/testsuite/tests/module/mod155.stderr
index 8c026629784a..ba03a62da001 100644
--- a/testsuite/tests/module/mod155.stderr
+++ b/testsuite/tests/module/mod155.stderr
@@ -1,7 +1,7 @@
 
 mod155.hs:2:10:
-    Conflicting exports for ‛id’:
-       ‛module M’ exports ‛M.id’
-         imported from ‛Prelude’ at mod155.hs:4:1-19
-         (and originally defined in ‛GHC.Base’)
-       ‛module M’ exports ‛M.id’ defined at mod155.hs:5:1
+    Conflicting exports for ‘id’:
+       ‘module M’ exports ‘M.id’
+         imported from ‘Prelude’ at mod155.hs:4:1-19
+         (and originally defined in ‘GHC.Base’)
+       ‘module M’ exports ‘M.id’ defined at mod155.hs:5:1
diff --git a/testsuite/tests/module/mod158.stderr b/testsuite/tests/module/mod158.stderr
index 412c05c1b770..4fcc0a036547 100644
--- a/testsuite/tests/module/mod158.stderr
+++ b/testsuite/tests/module/mod158.stderr
@@ -1,3 +1,3 @@
 
-mod158.hs:12:5: Not in scope: data constructor ‛C’
+mod158.hs:12:5: Not in scope: data constructor ‘C’
 exit(1)
diff --git a/testsuite/tests/module/mod160.stderr b/testsuite/tests/module/mod160.stderr
index 1a27420f6128..7c752de09365 100644
--- a/testsuite/tests/module/mod160.stderr
+++ b/testsuite/tests/module/mod160.stderr
@@ -1,6 +1,6 @@
 
 mod160.hs:12:5:
-    Not in scope: ‛m3’
+    Not in scope: ‘m3’
     Perhaps you meant one of these:
-      ‛m1’ (imported from Mod159_D), ‛m2’ (imported from Mod159_D)
+      ‘m1’ (imported from Mod159_D), ‘m2’ (imported from Mod159_D)
 exit(1)
diff --git a/testsuite/tests/module/mod161.stderr b/testsuite/tests/module/mod161.stderr
index f5dc9fd3789e..5a812812ea0f 100644
--- a/testsuite/tests/module/mod161.stderr
+++ b/testsuite/tests/module/mod161.stderr
@@ -1,2 +1,2 @@
 
-mod161.hs:2:12: Not in scope: ‛bar’
+mod161.hs:2:12: Not in scope: ‘bar’
diff --git a/testsuite/tests/module/mod164.stderr b/testsuite/tests/module/mod164.stderr
index e6ebc70bcafc..ecdeff806302 100644
--- a/testsuite/tests/module/mod164.stderr
+++ b/testsuite/tests/module/mod164.stderr
@@ -1,9 +1,9 @@
 
 mod164.hs:9:5:
-    Ambiguous occurrence ‛D1’
-    It could refer to either ‛Mod164_A.D1’,
-                             imported from ‛Mod164_A’ at mod164.hs:4:1-15
+    Ambiguous occurrence ‘D1’
+    It could refer to either ‘Mod164_A.D1’,
+                             imported from ‘Mod164_A’ at mod164.hs:4:1-15
                              (and originally defined at Mod164_A.hs:3:10-11)
-                          or ‛Mod164_B.D1’,
-                             imported from ‛Mod164_B’ at mod164.hs:5:1-15
+                          or ‘Mod164_B.D1’,
+                             imported from ‘Mod164_B’ at mod164.hs:5:1-15
                              (and originally defined at Mod164_B.hs:3:10-11)
diff --git a/testsuite/tests/module/mod165.stderr b/testsuite/tests/module/mod165.stderr
index 334ad0c7f81b..927b36924db6 100644
--- a/testsuite/tests/module/mod165.stderr
+++ b/testsuite/tests/module/mod165.stderr
@@ -1,7 +1,7 @@
 
 mod165.hs:9:5:
-    Ambiguous occurrence ‛A.D1’
-    It could refer to either ‛A.D1’,
-                             imported from ‛Mod164_A’ at mod165.hs:4:1-20
-                          or ‛A.D1’, imported from ‛Mod164_B’ at mod165.hs:5:1-20
+    Ambiguous occurrence ‘A.D1’
+    It could refer to either ‘A.D1’,
+                             imported from ‘Mod164_A’ at mod165.hs:4:1-20
+                          or ‘A.D1’, imported from ‘Mod164_B’ at mod165.hs:5:1-20
 exit(1)
diff --git a/testsuite/tests/module/mod17.stderr b/testsuite/tests/module/mod17.stderr
index 3a911609dd56..9dcf0e612fcc 100644
--- a/testsuite/tests/module/mod17.stderr
+++ b/testsuite/tests/module/mod17.stderr
@@ -1,4 +1,4 @@
 
 mod17.hs:2:10:
-    The export item ‛C(m1, m2, m3, Left)’
+    The export item ‘C(m1, m2, m3, Left)’
     attempts to export constructors or class methods that are not visible here
diff --git a/testsuite/tests/module/mod174.stderr b/testsuite/tests/module/mod174.stderr
index 84fef9942978..a035f92b9028 100644
--- a/testsuite/tests/module/mod174.stderr
+++ b/testsuite/tests/module/mod174.stderr
@@ -1,3 +1,3 @@
 
 mod174.hs:1:1:
-    The IO action ‛main’ is not exported by module ‛Main’
+    The IO action ‘main’ is not exported by module ‘Main’
diff --git a/testsuite/tests/module/mod176.stderr b/testsuite/tests/module/mod176.stderr
index 4dcd689a8a8d..5b8c71b0dd37 100644
--- a/testsuite/tests/module/mod176.stderr
+++ b/testsuite/tests/module/mod176.stderr
@@ -1,4 +1,4 @@
 
 mod176.hs:4:1: Warning:
-    The import of ‛return, Monad’
-    from module ‛Control.Monad’ is redundant
+    The import of ‘return, Monad’
+    from module ‘Control.Monad’ is redundant
diff --git a/testsuite/tests/module/mod177.stderr b/testsuite/tests/module/mod177.stderr
index fe82c64569b1..21bf46cf9c96 100644
--- a/testsuite/tests/module/mod177.stderr
+++ b/testsuite/tests/module/mod177.stderr
@@ -1,5 +1,5 @@
 
 mod177.hs:4:1: Warning:
-    The import of ‛Data.Maybe’ is redundant
-      except perhaps to import instances from ‛Data.Maybe’
+    The import of ‘Data.Maybe’ is redundant
+      except perhaps to import instances from ‘Data.Maybe’
     To import instances alone, use: import Data.Maybe()
diff --git a/testsuite/tests/module/mod178.stderr b/testsuite/tests/module/mod178.stderr
index 755324b58c41..8bd70526d9df 100644
--- a/testsuite/tests/module/mod178.stderr
+++ b/testsuite/tests/module/mod178.stderr
@@ -1,5 +1,5 @@
 
 Mod178_2.hs:1:1:
     File name does not match module name:
-    Saw: ‛Main’
-    Expected: ‛Mod178_2’
+    Saw: ‘Main’
+    Expected: ‘Mod178_2’
diff --git a/testsuite/tests/module/mod18.stderr b/testsuite/tests/module/mod18.stderr
index 922b86286ff6..0e1a4e3b7f52 100644
--- a/testsuite/tests/module/mod18.stderr
+++ b/testsuite/tests/module/mod18.stderr
@@ -1,5 +1,5 @@
 
 mod18.hs:3:1:
-    Multiple declarations of ‛T’
+    Multiple declarations of ‘T’
     Declared at: mod18.hs:2:1
                  mod18.hs:3:1
diff --git a/testsuite/tests/module/mod180.stderr b/testsuite/tests/module/mod180.stderr
index af6826db44b1..732b5c8d0d17 100644
--- a/testsuite/tests/module/mod180.stderr
+++ b/testsuite/tests/module/mod180.stderr
@@ -1,8 +1,8 @@
 
 mod180.hs:8:5:
-    Couldn't match expected type ‛T’
-                with actual type ‛main:Mod180_A.T’
-    NB: ‛T’ is defined at Mod180_B.hs:3:1-10
-        ‛main:Mod180_A.T’ is defined at Mod180_A.hs:3:1-10
+    Couldn't match expected type ‘T’
+                with actual type ‘main:Mod180_A.T’
+    NB: ‘T’ is defined at Mod180_B.hs:3:1-10
+        ‘main:Mod180_A.T’ is defined at Mod180_A.hs:3:1-10
     In the expression: x
-    In an equation for ‛z’: z = x
+    In an equation for ‘z’: z = x
diff --git a/testsuite/tests/module/mod19.stderr b/testsuite/tests/module/mod19.stderr
index d0e7173290bf..b59d584f2164 100644
--- a/testsuite/tests/module/mod19.stderr
+++ b/testsuite/tests/module/mod19.stderr
@@ -1,10 +1,10 @@
 
 mod19.hs:3:1:
-    Multiple declarations of ‛C’
+    Multiple declarations of ‘C’
     Declared at: mod19.hs:2:1
                  mod19.hs:3:1
 
 mod19.hs:3:17:
-    Multiple declarations of ‛m’
+    Multiple declarations of ‘m’
     Declared at: mod19.hs:2:17
                  mod19.hs:3:17
diff --git a/testsuite/tests/module/mod2.stderr b/testsuite/tests/module/mod2.stderr
index c98e3f5ce69e..32522890ba78 100644
--- a/testsuite/tests/module/mod2.stderr
+++ b/testsuite/tests/module/mod2.stderr
@@ -1,4 +1,4 @@
 
 mod2.hs:3:1:
-    Failed to load interface for ‛N’
+    Failed to load interface for ‘N’
     Use -v to see a list of the files searched for.
diff --git a/testsuite/tests/module/mod20.stderr b/testsuite/tests/module/mod20.stderr
index eb92e4a021d8..23190d6a2fc6 100644
--- a/testsuite/tests/module/mod20.stderr
+++ b/testsuite/tests/module/mod20.stderr
@@ -1,5 +1,5 @@
 
 mod20.hs:3:18:
-    Multiple declarations of ‛m’
+    Multiple declarations of ‘m’
     Declared at: mod20.hs:2:18
                  mod20.hs:3:18
diff --git a/testsuite/tests/module/mod21.stderr b/testsuite/tests/module/mod21.stderr
index e9cd1a7f8a65..09c83c05ce8f 100644
--- a/testsuite/tests/module/mod21.stderr
+++ b/testsuite/tests/module/mod21.stderr
@@ -1,5 +1,5 @@
 
 mod21.hs:3:1:
-    Multiple declarations of ‛T’
+    Multiple declarations of ‘T’
     Declared at: mod21.hs:2:1
                  mod21.hs:3:1
diff --git a/testsuite/tests/module/mod22.stderr b/testsuite/tests/module/mod22.stderr
index 0e05809361b2..d1d61ba62860 100644
--- a/testsuite/tests/module/mod22.stderr
+++ b/testsuite/tests/module/mod22.stderr
@@ -1,5 +1,5 @@
 
 mod22.hs:3:11:
-    Multiple declarations of ‛K’
+    Multiple declarations of ‘K’
     Declared at: mod22.hs:2:11
                  mod22.hs:3:11
diff --git a/testsuite/tests/module/mod23.stderr b/testsuite/tests/module/mod23.stderr
index 77f37d3c221f..4387fb737a92 100644
--- a/testsuite/tests/module/mod23.stderr
+++ b/testsuite/tests/module/mod23.stderr
@@ -1,5 +1,5 @@
 
 mod23.hs:3:8:
-    Conflicting definitions for ‛a’
+    Conflicting definitions for ‘a’
     Bound at: mod23.hs:3:8
               mod23.hs:3:10
diff --git a/testsuite/tests/module/mod24.stderr b/testsuite/tests/module/mod24.stderr
index 9f2bb5479876..efc5ad5dd012 100644
--- a/testsuite/tests/module/mod24.stderr
+++ b/testsuite/tests/module/mod24.stderr
@@ -1,5 +1,5 @@
 
 mod24.hs:3:8:
-    Conflicting definitions for ‛a’
+    Conflicting definitions for ‘a’
     Bound at: mod24.hs:3:8
               mod24.hs:3:10
diff --git a/testsuite/tests/module/mod25.stderr b/testsuite/tests/module/mod25.stderr
index 6d8fd0349dce..7a60fa81f4db 100644
--- a/testsuite/tests/module/mod25.stderr
+++ b/testsuite/tests/module/mod25.stderr
@@ -1,2 +1,2 @@
 
-mod25.hs:3:16: Not in scope: type variable ‛b’
+mod25.hs:3:16: Not in scope: type variable ‘b’
diff --git a/testsuite/tests/module/mod26.stderr b/testsuite/tests/module/mod26.stderr
index 0ee82dc57fe4..beb0050e05fb 100644
--- a/testsuite/tests/module/mod26.stderr
+++ b/testsuite/tests/module/mod26.stderr
@@ -1,2 +1,2 @@
 
-mod26.hs:3:21: Not in scope: type variable ‛b’
+mod26.hs:3:21: Not in scope: type variable ‘b’
diff --git a/testsuite/tests/module/mod29.stderr b/testsuite/tests/module/mod29.stderr
index 2abdd7d1de6b..7e25c7f095bd 100644
--- a/testsuite/tests/module/mod29.stderr
+++ b/testsuite/tests/module/mod29.stderr
@@ -1,2 +1,2 @@
 
-mod29.hs:6:12: Not in scope: type constructor or class ‛Char’
+mod29.hs:6:12: Not in scope: type constructor or class ‘Char’
diff --git a/testsuite/tests/module/mod3.stderr b/testsuite/tests/module/mod3.stderr
index f07a431b4513..6e7a88bd6ddd 100644
--- a/testsuite/tests/module/mod3.stderr
+++ b/testsuite/tests/module/mod3.stderr
@@ -1,4 +1,4 @@
 
 mod3.hs:2:10:
-    The export item ‛T(K1)’
+    The export item ‘T(K1)’
     attempts to export constructors or class methods that are not visible here
diff --git a/testsuite/tests/module/mod36.stderr b/testsuite/tests/module/mod36.stderr
index 6ec42d92b0f1..28ed1cdaae8c 100644
--- a/testsuite/tests/module/mod36.stderr
+++ b/testsuite/tests/module/mod36.stderr
@@ -1,2 +1,2 @@
 
-mod36.hs:5:5: Not in scope: ‛const’
+mod36.hs:5:5: Not in scope: ‘const’
diff --git a/testsuite/tests/module/mod38.stderr b/testsuite/tests/module/mod38.stderr
index c271e8d3260c..971d31c9311e 100644
--- a/testsuite/tests/module/mod38.stderr
+++ b/testsuite/tests/module/mod38.stderr
@@ -1,5 +1,5 @@
 
 mod38.hs:4:1:
-    Multiple declarations of ‛C’
+    Multiple declarations of ‘C’
     Declared at: mod38.hs:3:1
                  mod38.hs:4:1
diff --git a/testsuite/tests/module/mod4.stderr b/testsuite/tests/module/mod4.stderr
index 38ea462fde74..2391dadcdc2d 100644
--- a/testsuite/tests/module/mod4.stderr
+++ b/testsuite/tests/module/mod4.stderr
@@ -1,4 +1,4 @@
 
 mod4.hs:2:10:
-    The export item ‛T(K1, K2)’
+    The export item ‘T(K1, K2)’
     attempts to export constructors or class methods that are not visible here
diff --git a/testsuite/tests/module/mod40.stderr b/testsuite/tests/module/mod40.stderr
index aa641e4d8a44..cd977d1e779d 100644
--- a/testsuite/tests/module/mod40.stderr
+++ b/testsuite/tests/module/mod40.stderr
@@ -1,8 +1,8 @@
 
 mod40.hs:3:1:
     Cycle in class declaration (via superclasses): C1 -> C2 -> C1
-    In the class declaration for ‛C1’
+    In the class declaration for ‘C1’
 
 mod40.hs:4:1:
     Cycle in class declaration (via superclasses): C2 -> C1 -> C2
-    In the class declaration for ‛C2’
+    In the class declaration for ‘C2’
diff --git a/testsuite/tests/module/mod41.stderr b/testsuite/tests/module/mod41.stderr
index e9dfe97c33c1..9962da3716a1 100644
--- a/testsuite/tests/module/mod41.stderr
+++ b/testsuite/tests/module/mod41.stderr
@@ -1,8 +1,8 @@
 
 mod41.hs:3:18:
-    Illegal instance declaration for ‛Eq (Either a a)’
+    Illegal instance declaration for ‘Eq (Either a a)’
       (All instance types must be of the form (T a1 ... an)
        where a1 ... an are *distinct type variables*,
        and each type variable appears at most once in the instance head.
        Use FlexibleInstances if you want to disable this.)
-    In the instance declaration for ‛Eq (Either a a)’
+    In the instance declaration for ‘Eq (Either a a)’
diff --git a/testsuite/tests/module/mod42.stderr b/testsuite/tests/module/mod42.stderr
index b09258724fbb..03e7f8cdcef1 100644
--- a/testsuite/tests/module/mod42.stderr
+++ b/testsuite/tests/module/mod42.stderr
@@ -1,8 +1,8 @@
 
 mod42.hs:3:10:
-    Illegal instance declaration for ‛Eq a’
+    Illegal instance declaration for ‘Eq a’
       (All instance types must be of the form (T a1 ... an)
        where a1 ... an are *distinct type variables*,
        and each type variable appears at most once in the instance head.
        Use FlexibleInstances if you want to disable this.)
-    In the instance declaration for ‛Eq a’
+    In the instance declaration for ‘Eq a’
diff --git a/testsuite/tests/module/mod43.stderr b/testsuite/tests/module/mod43.stderr
index dd1dac68ad29..d73c51e4a4e8 100644
--- a/testsuite/tests/module/mod43.stderr
+++ b/testsuite/tests/module/mod43.stderr
@@ -1,7 +1,7 @@
 
 mod43.hs:3:10:
-    Illegal instance declaration for ‛Eq String’
+    Illegal instance declaration for ‘Eq String’
       (All instance types must be of the form (T t1 ... tn)
        where T is not a synonym.
        Use TypeSynonymInstances if you want to disable this.)
-    In the instance declaration for ‛Eq String’
+    In the instance declaration for ‘Eq String’
diff --git a/testsuite/tests/module/mod45.stderr b/testsuite/tests/module/mod45.stderr
index 7102bf2e7dd5..ac8f21b54c16 100644
--- a/testsuite/tests/module/mod45.stderr
+++ b/testsuite/tests/module/mod45.stderr
@@ -3,4 +3,4 @@ mod45.hs:5:11:
     Illegal type signature in instance declaration:
       (==) :: T -> T -> Bool
     (Use InstanceSigs to allow this)
-    In the instance declaration for ‛Eq T’
+    In the instance declaration for ‘Eq T’
diff --git a/testsuite/tests/module/mod46.stderr b/testsuite/tests/module/mod46.stderr
index 516215c6791e..6eb00281995b 100644
--- a/testsuite/tests/module/mod46.stderr
+++ b/testsuite/tests/module/mod46.stderr
@@ -2,4 +2,4 @@
 mod46.hs:4:10:
     No instance for (Eq T)
       arising from the superclasses of an instance declaration
-    In the instance declaration for ‛Ord T’
+    In the instance declaration for ‘Ord T’
diff --git a/testsuite/tests/module/mod47.stderr b/testsuite/tests/module/mod47.stderr
index 44aba92178a0..98bfdab6859c 100644
--- a/testsuite/tests/module/mod47.stderr
+++ b/testsuite/tests/module/mod47.stderr
@@ -6,4 +6,4 @@ mod47.hs:6:10:
       bound by the instance declaration at mod47.hs:6:10-34
     Possible fix:
       add (Num a) to the context of the instance declaration
-    In the instance declaration for ‛Bar [a]’
+    In the instance declaration for ‘Bar [a]’
diff --git a/testsuite/tests/module/mod49.stderr b/testsuite/tests/module/mod49.stderr
index f0fca3e7addb..4354bb77f25b 100644
--- a/testsuite/tests/module/mod49.stderr
+++ b/testsuite/tests/module/mod49.stderr
@@ -1,2 +1,2 @@
 
-mod49.hs:5:3: ‛y’ is not a (visible) method of class ‛C’
+mod49.hs:5:3: ‘y’ is not a (visible) method of class ‘C’
diff --git a/testsuite/tests/module/mod5.stderr-ghc b/testsuite/tests/module/mod5.stderr-ghc
index b48307ab3732..07967f0e21da 100644
--- a/testsuite/tests/module/mod5.stderr-ghc
+++ b/testsuite/tests/module/mod5.stderr-ghc
@@ -1,3 +1,3 @@
 
 mod5.hs:2:10: Warning:
-    ‛K1’ is exported by ‛T(K1, K1)’ and ‛T(K1, K1)’
+    ‘K1’ is exported by ‘T(K1, K1)’ and ‘T(K1, K1)’
diff --git a/testsuite/tests/module/mod50.stderr b/testsuite/tests/module/mod50.stderr
index 453f2f2da38f..593148e3ab06 100644
--- a/testsuite/tests/module/mod50.stderr
+++ b/testsuite/tests/module/mod50.stderr
@@ -1,2 +1,2 @@
 
-mod50.hs:3:22: Not in scope: type constructor or class ‛Foo’
+mod50.hs:3:22: Not in scope: type constructor or class ‘Foo’
diff --git a/testsuite/tests/module/mod53.stderr b/testsuite/tests/module/mod53.stderr
index 4129d3995959..14ec2e2646d6 100644
--- a/testsuite/tests/module/mod53.stderr
+++ b/testsuite/tests/module/mod53.stderr
@@ -1,5 +1,5 @@
 
 mod53.hs:4:22:
-    Can't make a derived instance of ‛C T’:
-      ‛C’ is not a derivable class
-    In the data declaration for ‛T’
+    Can't make a derived instance of ‘C T’:
+      ‘C’ is not a derivable class
+    In the data declaration for ‘T’
diff --git a/testsuite/tests/module/mod55.stderr b/testsuite/tests/module/mod55.stderr
index a1f388f339e4..341de62692c8 100644
--- a/testsuite/tests/module/mod55.stderr
+++ b/testsuite/tests/module/mod55.stderr
@@ -1,6 +1,6 @@
 
 mod55.hs:3:26:
-    Can't make a derived instance of ‛Enum T’:
-      ‛T’ must be an enumeration type
+    Can't make a derived instance of ‘Enum T’:
+      ‘T’ must be an enumeration type
       (an enumeration consists of one or more nullary, non-GADT constructors)
-    In the data declaration for ‛T’
+    In the data declaration for ‘T’
diff --git a/testsuite/tests/module/mod56.stderr b/testsuite/tests/module/mod56.stderr
index 44560cb76429..4e3bb98fa4d0 100644
--- a/testsuite/tests/module/mod56.stderr
+++ b/testsuite/tests/module/mod56.stderr
@@ -1,8 +1,8 @@
 
 mod56.hs:4:39:
-    Can't make a derived instance of ‛Ix T’:
-      ‛T’ must be an enumeration type
+    Can't make a derived instance of ‘Ix T’:
+      ‘T’ must be an enumeration type
       (an enumeration consists of one or more nullary, non-GADT constructors)
         or
-      ‛T’ must have precisely one constructor
-    In the data declaration for ‛T’
+      ‘T’ must have precisely one constructor
+    In the data declaration for ‘T’
diff --git a/testsuite/tests/module/mod59.stderr b/testsuite/tests/module/mod59.stderr
index 26e74034ca89..90fb99a9dfe8 100644
--- a/testsuite/tests/module/mod59.stderr
+++ b/testsuite/tests/module/mod59.stderr
@@ -1,2 +1,2 @@
 
-mod59.hs:3:3: Not in scope: data constructor ‛K’
+mod59.hs:3:3: Not in scope: data constructor ‘K’
diff --git a/testsuite/tests/module/mod60.stderr b/testsuite/tests/module/mod60.stderr
index b25ee48b16a1..1cf46b125366 100644
--- a/testsuite/tests/module/mod60.stderr
+++ b/testsuite/tests/module/mod60.stderr
@@ -1,5 +1,5 @@
 
 mod60.hs:3:4:
-    Constructor ‛Left’ should have 1 argument, but has been given none
+    Constructor ‘Left’ should have 1 argument, but has been given none
     In the pattern: Left
-    In an equation for ‛f’: f (Left) = error "foo"
+    In an equation for ‘f’: f (Left) = error "foo"
diff --git a/testsuite/tests/module/mod61.stderr b/testsuite/tests/module/mod61.stderr
index e96817f659d9..cce1dfe611c4 100644
--- a/testsuite/tests/module/mod61.stderr
+++ b/testsuite/tests/module/mod61.stderr
@@ -1,4 +1,4 @@
 
 mod61.hs:3:11:
     Precedence parsing error
-        cannot mix ‛==’ [infix 4] and ‛==’ [infix 4] in the same infix expression
+        cannot mix ‘==’ [infix 4] and ‘==’ [infix 4] in the same infix expression
diff --git a/testsuite/tests/module/mod62.stderr b/testsuite/tests/module/mod62.stderr
index cac9a6f32c1e..8215ec1e1d7f 100644
--- a/testsuite/tests/module/mod62.stderr
+++ b/testsuite/tests/module/mod62.stderr
@@ -2,5 +2,5 @@
 mod62.hs:3:9: Qualified name in binding position: M.y
 
 mod62.hs:3:22:
-    Not in scope: ‛M.y’
-    Perhaps you meant ‛M.x’ (line 3)
+    Not in scope: ‘M.y’
+    Perhaps you meant ‘M.x’ (line 3)
diff --git a/testsuite/tests/module/mod63.stderr b/testsuite/tests/module/mod63.stderr
index 3a60973366d3..b76c8b06004e 100644
--- a/testsuite/tests/module/mod63.stderr
+++ b/testsuite/tests/module/mod63.stderr
@@ -1,5 +1,5 @@
 
 mod63.hs:3:1:
-    Equations for ‛f’ have different numbers of arguments
+    Equations for ‘f’ have different numbers of arguments
       mod63.hs:3:1-8
       mod63.hs:4:1-11
diff --git a/testsuite/tests/module/mod66.stderr b/testsuite/tests/module/mod66.stderr
index b5fc83fa571d..4a03192ef03f 100644
--- a/testsuite/tests/module/mod66.stderr
+++ b/testsuite/tests/module/mod66.stderr
@@ -1,5 +1,5 @@
 
 mod66.hs:5:1:
-    Multiple declarations of ‛f’
+    Multiple declarations of ‘f’
     Declared at: mod66.hs:3:1
                  mod66.hs:5:1
diff --git a/testsuite/tests/module/mod67.stderr b/testsuite/tests/module/mod67.stderr
index a46c8ab03a94..5c15a8658645 100644
--- a/testsuite/tests/module/mod67.stderr
+++ b/testsuite/tests/module/mod67.stderr
@@ -1,3 +1,3 @@
 
 mod67.hs:3:1:
-    The type signature for ‛f’ lacks an accompanying binding
+    The type signature for ‘f’ lacks an accompanying binding
diff --git a/testsuite/tests/module/mod68.stderr b/testsuite/tests/module/mod68.stderr
index 0d46be073b70..754124f15c56 100644
--- a/testsuite/tests/module/mod68.stderr
+++ b/testsuite/tests/module/mod68.stderr
@@ -1,5 +1,5 @@
 
 mod68.hs:4:1:
-    Duplicate type signatures for ‛f’
+    Duplicate type signatures for ‘f’
     at mod68.hs:3:1
        mod68.hs:4:1
diff --git a/testsuite/tests/module/mod7.stderr b/testsuite/tests/module/mod7.stderr
index 5a446d38772f..20a216a13e63 100644
--- a/testsuite/tests/module/mod7.stderr
+++ b/testsuite/tests/module/mod7.stderr
@@ -1,2 +1,2 @@
 
-mod7.hs:2:10: Not in scope: type constructor or class ‛T’
+mod7.hs:2:10: Not in scope: type constructor or class ‘T’
diff --git a/testsuite/tests/module/mod72.stderr b/testsuite/tests/module/mod72.stderr
index b3ff8a9b3e8a..5726922feb01 100644
--- a/testsuite/tests/module/mod72.stderr
+++ b/testsuite/tests/module/mod72.stderr
@@ -1,2 +1,2 @@
 
-mod72.hs:3:7: Not in scope: ‛g’
+mod72.hs:3:7: Not in scope: ‘g’
diff --git a/testsuite/tests/module/mod73.stderr b/testsuite/tests/module/mod73.stderr
index de239763831d..d19a032cef39 100644
--- a/testsuite/tests/module/mod73.stderr
+++ b/testsuite/tests/module/mod73.stderr
@@ -1,7 +1,7 @@
 
 mod73.hs:3:7:
-    Not in scope: ‛Prelude.g’
+    Not in scope: ‘Prelude.g’
     Perhaps you meant one of these:
-      ‛Prelude.id’ (imported from Prelude),
-      ‛Prelude.log’ (imported from Prelude),
-      ‛Prelude.pi’ (imported from Prelude)
+      data constructor ‘Prelude.GT’ (imported from Prelude),
+      data constructor ‘Prelude.EQ’ (imported from Prelude),
+      data constructor ‘Prelude.LT’ (imported from Prelude)
diff --git a/testsuite/tests/module/mod74.stderr b/testsuite/tests/module/mod74.stderr
index 89d12d495c94..e3660924ccb5 100644
--- a/testsuite/tests/module/mod74.stderr
+++ b/testsuite/tests/module/mod74.stderr
@@ -1,2 +1,2 @@
 
-mod74.hs:3:7: Not in scope: ‛N.g’
+mod74.hs:3:7: Not in scope: ‘N.g’
diff --git a/testsuite/tests/module/mod76.stderr b/testsuite/tests/module/mod76.stderr
index 37226abf36cb..7a90f5178a0f 100644
--- a/testsuite/tests/module/mod76.stderr
+++ b/testsuite/tests/module/mod76.stderr
@@ -1,2 +1,2 @@
 
-mod76.hs:5:1: parse error on input ‛module’
+mod76.hs:5:1: parse error on input ‘module’
diff --git a/testsuite/tests/module/mod77.stderr b/testsuite/tests/module/mod77.stderr
index 1d05d71a0780..c2c78c6a8f5c 100644
--- a/testsuite/tests/module/mod77.stderr
+++ b/testsuite/tests/module/mod77.stderr
@@ -1,3 +1,3 @@
 
 mod77.hs:3:7:
-    The fixity signature for ‛$$$’ lacks an accompanying binding
+    The fixity signature for ‘$$$’ lacks an accompanying binding
diff --git a/testsuite/tests/module/mod79.stderr b/testsuite/tests/module/mod79.stderr
index 329e47625f80..16cdda2c5759 100644
--- a/testsuite/tests/module/mod79.stderr
+++ b/testsuite/tests/module/mod79.stderr
@@ -1,2 +1,2 @@
 
-mod79.hs:3:16: Module ‛Prelude’ does not export ‛C’
+mod79.hs:3:16: Module ‘Prelude’ does not export ‘C’
diff --git a/testsuite/tests/module/mod80.stderr b/testsuite/tests/module/mod80.stderr
index 7908ede6ee23..fa4131e86b10 100644
--- a/testsuite/tests/module/mod80.stderr
+++ b/testsuite/tests/module/mod80.stderr
@@ -1,2 +1,2 @@
 
-mod80.hs:3:16: Module ‛Prelude’ does not export ‛f’
+mod80.hs:3:16: Module ‘Prelude’ does not export ‘f’
diff --git a/testsuite/tests/module/mod81.stderr b/testsuite/tests/module/mod81.stderr
index b3c31ddd386c..a1cb2f5bcba6 100644
--- a/testsuite/tests/module/mod81.stderr
+++ b/testsuite/tests/module/mod81.stderr
@@ -1,3 +1,3 @@
 
 mod81.hs:3:16:
-    Module ‛Prelude’ does not export ‛Either(Left, Right, Foo)’
+    Module ‘Prelude’ does not export ‘Either(Left, Right, Foo)’
diff --git a/testsuite/tests/module/mod87.stderr b/testsuite/tests/module/mod87.stderr
index 99ad6bf351c9..fdb9c84ccb95 100644
--- a/testsuite/tests/module/mod87.stderr
+++ b/testsuite/tests/module/mod87.stderr
@@ -1,2 +1,2 @@
 
-mod87.hs:4:5: Not in scope: data constructor ‛Left’
+mod87.hs:4:5: Not in scope: data constructor ‘Left’
diff --git a/testsuite/tests/module/mod88.stderr b/testsuite/tests/module/mod88.stderr
index 707ad693e258..fea1eddb7d98 100644
--- a/testsuite/tests/module/mod88.stderr
+++ b/testsuite/tests/module/mod88.stderr
@@ -1,2 +1,2 @@
 
-mod88.hs:5:5: Not in scope: data constructor ‛Prelude.Left’
+mod88.hs:5:5: Not in scope: data constructor ‘Prelude.Left’
diff --git a/testsuite/tests/module/mod89.stderr b/testsuite/tests/module/mod89.stderr
index 653c93a810c9..0f956536cbde 100644
--- a/testsuite/tests/module/mod89.stderr
+++ b/testsuite/tests/module/mod89.stderr
@@ -1,2 +1,2 @@
 
-mod89.hs:3:16: Module ‛Prelude’ does not export ‛map(..)’
+mod89.hs:3:16: Module ‘Prelude’ does not export ‘map(..)’
diff --git a/testsuite/tests/module/mod9.stderr b/testsuite/tests/module/mod9.stderr
index deee729ba966..b4eb0d7e40f9 100644
--- a/testsuite/tests/module/mod9.stderr
+++ b/testsuite/tests/module/mod9.stderr
@@ -1,2 +1,2 @@
 
-mod9.hs:2:10: Not in scope: type constructor or class ‛T’
+mod9.hs:2:10: Not in scope: type constructor or class ‘T’
diff --git a/testsuite/tests/module/mod90.stderr b/testsuite/tests/module/mod90.stderr
index 050b53c02e62..9febfe362847 100644
--- a/testsuite/tests/module/mod90.stderr
+++ b/testsuite/tests/module/mod90.stderr
@@ -1,8 +1,8 @@
 
 mod90.hs:3:16:
-    In module ‛Prelude’:
-      ‛Left’ is a data constructor of ‛Either’
+    In module ‘Prelude’:
+      ‘Left’ is a data constructor of ‘Either’
     To import it use
-      ‛import’ Prelude( Either( Left ) )
+      ‘import’ Prelude( Either( Left ) )
     or
-      ‛import’ Prelude( Either(..) )
+      ‘import’ Prelude( Either(..) )
diff --git a/testsuite/tests/module/mod91.stderr b/testsuite/tests/module/mod91.stderr
index 0324f48a013f..5d8bd0b9ff58 100644
--- a/testsuite/tests/module/mod91.stderr
+++ b/testsuite/tests/module/mod91.stderr
@@ -1,3 +1,3 @@
 
 mod91.hs:3:16:
-    Module ‛Prelude’ does not export ‛Eq((==), (/=), eq)’
+    Module ‘Prelude’ does not export ‘Eq((==), (/=), eq)’
diff --git a/testsuite/tests/module/mod97.stderr b/testsuite/tests/module/mod97.stderr
index 03891bc178ce..23e129702ea5 100644
--- a/testsuite/tests/module/mod97.stderr
+++ b/testsuite/tests/module/mod97.stderr
@@ -1,2 +1,2 @@
 
-mod97.hs:4:9: Not in scope: ‛==’
+mod97.hs:4:9: Not in scope: ‘==’
diff --git a/testsuite/tests/numeric/should_run/CarryOverflow.hs b/testsuite/tests/numeric/should_run/CarryOverflow.hs
new file mode 100644
index 000000000000..f83c1cf15c92
--- /dev/null
+++ b/testsuite/tests/numeric/should_run/CarryOverflow.hs
@@ -0,0 +1,89 @@
+{-# LANGUAGE MagicHash, UnboxedTuples #-}
+
+import GHC.Prim
+import GHC.Word
+import GHC.Exts
+
+import Control.Monad
+import Data.Bits
+import Data.List
+import System.Exit
+
+allEqual :: Eq a => [a] -> Bool
+allEqual [] = error "allEqual: nothing to compare"
+allEqual (x:xs) = all (== x) xs
+
+testWords :: [Word]
+testWords = map head . group . sort $
+            concatMap (\w -> [w - 1, w, w + 1]) $
+            concatMap (\w -> [w, maxBound - w]) $
+            trailingOnes ++ randoms
+  where trailingOnes = takeWhile (/= 0) $ iterate (`div` 2) $ maxBound
+        -- What would a Haskell program be without some Fibonacci numbers?
+        randoms = take 40 $ drop 100 fibs
+        fibs = 0 : 1 : zipWith (+) fibs (tail fibs)
+
+
+wordSizeInBits :: Int
+wordSizeInBits = length $ takeWhile (/= 0) $ iterate (`div` 2) (maxBound :: Word)
+
+
+-- plusWord2# (Word# carry)
+
+ways_plusWord2# :: [Word -> Word -> Bool]
+ways_plusWord2# = [ltTest, integerTest, primopTest]
+  where ltTest x y =
+          let r = x + y in r < x
+        integerTest x y =
+          let r = fromIntegral x + fromIntegral y :: Integer
+          in r > fromIntegral (maxBound :: Word)
+        primopTest (W# x) (W# y) = case plusWord2# x y of
+          (# 0##, _ #) -> False
+          (# 1##, _ #) -> True
+          _            -> error "unexpected result from plusWord2#"
+
+-- addIntC# (Int# addition overflow)
+
+ways_addIntC# :: [Int -> Int -> Bool]
+ways_addIntC# = [ltTest, integerTest, highBitTest, primopTest]
+  where ltTest x y =
+          let r = x + y in (y > 0 && r < x) || (y < 0 && r > x)
+        integerTest x y =
+          let r = fromIntegral x + fromIntegral y :: Integer
+          in r < fromIntegral (minBound :: Int) || r > fromIntegral (maxBound :: Int)
+        highBitTest x y =
+          let r = x + y in testBit ((x `xor` r) .&. (y `xor` r)) (wordSizeInBits - 1)
+        primopTest (I# x) (I# y) = case addIntC# x y of
+          (# _, 0# #) -> False
+          _ -> True
+
+-- subIntC# (Int# subtraction overflow)
+
+ways_subIntC# :: [Int -> Int -> Bool]
+ways_subIntC# = [ltTest, integerTest, highBitTest, primopTest]
+  where ltTest x y =
+          let r = x - y in (y > 0 && r > x) || (y < 0 && r < x)
+        integerTest x y =
+          let r = fromIntegral x - fromIntegral y :: Integer
+          in r < fromIntegral (minBound :: Int) || r > fromIntegral (maxBound :: Int)
+        highBitTest x y =
+          let r = x - y in testBit ((x `xor` r) .&. complement (y `xor` r)) (wordSizeInBits - 1)
+        primopTest (I# x) (I# y) = case subIntC# x y of
+          (# _, 0# #) -> False
+          _ -> True
+
+runTest :: Show a => String -> [a -> a -> Bool] -> a -> a -> IO ()
+runTest label ways x y = do
+  let results = map (\f -> f x y) ways
+  unless (allEqual results) $ do
+    putStrLn $ "Failed (" ++ label ++ "): " ++ show (x,y) ++ " " ++ show results
+    exitWith (ExitFailure 1)
+
+main :: IO ()
+main = do
+  forM_ testWords $ \x ->
+    forM_ testWords $ \y -> do
+      runTest "ways_plusWord2#" ways_plusWord2# x y
+      runTest "ways_addIntC#" ways_addIntC# (fromIntegral x) (fromIntegral y)
+      runTest "ways_subIntC#" ways_subIntC# (fromIntegral x) (fromIntegral y)
+  putStrLn "Passed"
diff --git a/testsuite/tests/numeric/should_run/CarryOverflow.stdout b/testsuite/tests/numeric/should_run/CarryOverflow.stdout
new file mode 100644
index 000000000000..863339fb8ced
--- /dev/null
+++ b/testsuite/tests/numeric/should_run/CarryOverflow.stdout
@@ -0,0 +1 @@
+Passed
diff --git a/testsuite/tests/numeric/should_run/T8726.hs b/testsuite/tests/numeric/should_run/T8726.hs
new file mode 100644
index 000000000000..ba5803ab1d30
--- /dev/null
+++ b/testsuite/tests/numeric/should_run/T8726.hs
@@ -0,0 +1,85 @@
+import Control.Monad
+import Data.Bits
+import Data.List
+import Data.Ord
+
+-- | test-values to use as numerator/denominator
+posvals :: [Integer]
+posvals = [1,2,3,4,5,9,10,14,15,16,17] ++
+          [ n | e <- ([5..70]++[96,128,160,192,224])
+              , ofs <- [-1..1], let n = bit e + ofs ]
+
+posvalsSum :: Integer
+posvalsSum = 0x300000003000000030000000300000003000001800000000000000000
+
+vals :: [Integer]
+vals = sortBy (comparing abs) $ map negate posvals ++ [0] ++ posvals
+
+
+main :: IO ()
+main = do
+    unless (sum posvals == posvalsSum) $
+        fail $ "sum posvals == " ++ show (sum posvals)
+
+    forM_ [ (n,d) | n <- vals, d <- vals, d /= 0 ] $ \(n,d) -> do
+        let check sp p = unless (p n d) $ fail (sp ++ " " ++ show n ++ " " ++ show d)
+
+        check "rem0"      prop_rem0
+        check "mod0"      prop_mod0
+
+        check "divMod0"   prop_divMod0
+        check "divMod1"   prop_divMod1
+        check "divMod2"   prop_divMod2
+
+        check "quotRem0"  prop_quotRem0
+        check "quotRem1"  prop_quotRem1
+        check "quotRem2"  prop_quotRem2
+
+    -- putStrLn "passed"
+
+-- QuickCheck style properties
+
+prop_rem0 :: Integer -> Integer -> Bool
+prop_rem0 n d
+  | n >= 0     = (n `rem` d) `inside` (-1,abs d)
+  | otherwise  = (n `rem` d) `inside` (-(abs d),1)
+  where
+    inside v (l,u) = l < v && v < u
+
+prop_mod0 :: Integer -> Integer -> Bool
+prop_mod0 n d
+  | d >= 0     = (n `mod` d) `inside` (-1,d)
+  | otherwise  = (n `mod` d) `inside` (d,1)
+  where
+    inside v (l,u) = l < v && v < u
+
+-- | Invariant from Haskell Report
+prop_divMod0 :: Integer -> Integer -> Bool
+prop_divMod0 n d = (n `div` d) * d + (n `mod` d) == n
+
+prop_divMod1 :: Integer -> Integer -> Bool
+prop_divMod1 n d = divMod n d == (n `div` d, n `mod` d)
+
+-- | Compare IUT to implementation of 'divMod' in terms of 'quotRem'
+prop_divMod2 :: Integer -> Integer -> Bool
+prop_divMod2 n d = divMod n d == divMod' n d
+  where
+    divMod' x y = if signum r == negate (signum y) then (q-1, r+y) else qr
+      where qr@(q,r) = quotRem x y
+
+-- | Invariant from Haskell Report
+prop_quotRem0 :: Integer -> Integer -> Bool
+prop_quotRem0 n d = (n `quot` d) * d + (n `rem` d) == n
+
+prop_quotRem1 :: Integer -> Integer -> Bool
+prop_quotRem1 n d = quotRem n d == (n `quot` d, n `rem` d)
+
+-- | Test symmetry properties of 'quotRem'
+prop_quotRem2 :: Integer -> Integer -> Bool
+prop_quotRem2 n d = (qr == negQ (quotRem n (-d))    &&
+                     qr == negR (quotRem (-n) (-d)) &&
+                     qr == (negQ . negR) (quotRem (-n) d))
+  where
+    qr = quotRem n d
+    negQ (q,r) = (-q,r)
+    negR (q,r) = (q,-r)
diff --git a/testsuite/tests/numeric/should_run/all.T b/testsuite/tests/numeric/should_run/all.T
index 8f658de541f4..72c8e6a74a06 100644
--- a/testsuite/tests/numeric/should_run/all.T
+++ b/testsuite/tests/numeric/should_run/all.T
@@ -61,3 +61,5 @@ test('T7014',
 
 test('T7233', normal, compile_and_run, [''])
 test('NumDecimals', normal, compile_and_run, [''])
+test('T8726', normal, compile_and_run, [''])
+test('CarryOverflow', omit_ways(['ghci']), compile_and_run, [''])
diff --git a/testsuite/tests/overloadedlists/should_fail/overloadedlistsfail01.stderr b/testsuite/tests/overloadedlists/should_fail/overloadedlistsfail01.stderr
index 74ca081ac4d7..cfa2b94a5577 100644
--- a/testsuite/tests/overloadedlists/should_fail/overloadedlistsfail01.stderr
+++ b/testsuite/tests/overloadedlists/should_fail/overloadedlistsfail01.stderr
@@ -1,36 +1,36 @@
 
 overloadedlistsfail01.hs:5:8:
-    No instance for (Show a0) arising from a use of ‛print’
-    The type variable ‛a0’ is ambiguous
+    No instance for (Show a0) arising from a use of ‘print’
+    The type variable ‘a0’ is ambiguous
     Note: there are several potential instances:
-      instance Show Double -- Defined in ‛GHC.Float’
-      instance Show Float -- Defined in ‛GHC.Float’
+      instance Show Double -- Defined in ‘GHC.Float’
+      instance Show Float -- Defined in ‘GHC.Float’
       instance (Integral a, Show a) => Show (GHC.Real.Ratio a)
-        -- Defined in ‛GHC.Real’
-      ...plus 24 others
+        -- Defined in ‘GHC.Real’
+      ...plus 23 others
     In the expression: print [1]
-    In an equation for ‛main’: main = print [1]
+    In an equation for ‘main’: main = print [1]
 
 overloadedlistsfail01.hs:5:14:
     No instance for (GHC.Exts.IsList a0)
       arising from an overloaded list
-    The type variable ‛a0’ is ambiguous
+    The type variable ‘a0’ is ambiguous
     Note: there is a potential instance available:
-      instance GHC.Exts.IsList [a] -- Defined in ‛GHC.Exts’
-    In the first argument of ‛print’, namely ‛[1]’
+      instance GHC.Exts.IsList [a] -- Defined in ‘GHC.Exts’
+    In the first argument of ‘print’, namely ‘[1]’
     In the expression: print [1]
-    In an equation for ‛main’: main = print [1]
+    In an equation for ‘main’: main = print [1]
 
 overloadedlistsfail01.hs:5:15:
     No instance for (Num (GHC.Exts.Item a0))
-      arising from the literal ‛1’
-    The type variable ‛a0’ is ambiguous
+      arising from the literal ‘1’
+    The type variable ‘a0’ is ambiguous
     Note: there are several potential instances:
-      instance Num Double -- Defined in ‛GHC.Float’
-      instance Num Float -- Defined in ‛GHC.Float’
+      instance Num Double -- Defined in ‘GHC.Float’
+      instance Num Float -- Defined in ‘GHC.Float’
       instance Integral a => Num (GHC.Real.Ratio a)
-        -- Defined in ‛GHC.Real’
+        -- Defined in ‘GHC.Real’
       ...plus three others
     In the expression: 1
-    In the first argument of ‛print’, namely ‛[1]’
+    In the first argument of ‘print’, namely ‘[1]’
     In the expression: print [1]
diff --git a/testsuite/tests/overloadedlists/should_fail/overloadedlistsfail02.stderr b/testsuite/tests/overloadedlists/should_fail/overloadedlistsfail02.stderr
index 62f8a0e0bd93..d5f52fd66ecd 100644
--- a/testsuite/tests/overloadedlists/should_fail/overloadedlistsfail02.stderr
+++ b/testsuite/tests/overloadedlists/should_fail/overloadedlistsfail02.stderr
@@ -3,11 +3,11 @@ overloadedlistsfail02.hs:6:8:
     No instance for (GHC.Exts.IsList Foo)
       arising from an overloaded list
     In the expression: [7]
-    In an equation for ‛test’: test = [7]
+    In an equation for ‘test’: test = [7]
 
 overloadedlistsfail02.hs:6:9:
     No instance for (Num (GHC.Exts.Item Foo))
-      arising from the literal ‛7’
+      arising from the literal ‘7’
     In the expression: 7
     In the expression: [7]
-    In an equation for ‛test’: test = [7]
+    In an equation for ‘test’: test = [7]
diff --git a/testsuite/tests/overloadedlists/should_fail/overloadedlistsfail03.stderr b/testsuite/tests/overloadedlists/should_fail/overloadedlistsfail03.stderr
index cd8cbff03239..9c2e41640ec8 100644
--- a/testsuite/tests/overloadedlists/should_fail/overloadedlistsfail03.stderr
+++ b/testsuite/tests/overloadedlists/should_fail/overloadedlistsfail03.stderr
@@ -1,6 +1,6 @@
 
 overloadedlistsfail03.hs:3:27:
-    Couldn't match expected type ‛Char’ with actual type ‛[Char]’
+    Couldn't match expected type ‘Char’ with actual type ‘[Char]’
     In the expression: "b"
-    In the first argument of ‛length’, namely ‛['a', "b"]’
-    In the first argument of ‛print’, namely ‛(length ['a', "b"])’
+    In the first argument of ‘length’, namely ‘['a', "b"]’
+    In the first argument of ‘print’, namely ‘(length ['a', "b"])’
diff --git a/testsuite/tests/overloadedlists/should_fail/overloadedlistsfail04.stderr b/testsuite/tests/overloadedlists/should_fail/overloadedlistsfail04.stderr
index 145c6cd1feee..93811d40c7b1 100644
--- a/testsuite/tests/overloadedlists/should_fail/overloadedlistsfail04.stderr
+++ b/testsuite/tests/overloadedlists/should_fail/overloadedlistsfail04.stderr
@@ -1,8 +1,8 @@
 
 overloadedlistsfail04.hs:3:15:
     No instance for (Enum [Char])
-      arising from the arithmetic sequence ‛"a" .. "b"’
-    In the first argument of ‛print’, namely
-      ‛(["a" .. "b"] :: [String])’
+      arising from the arithmetic sequence ‘"a" .. "b"’
+    In the first argument of ‘print’, namely
+      ‘(["a" .. "b"] :: [String])’
     In the expression: print (["a" .. "b"] :: [String])
-    In an equation for ‛main’: main = print (["a" .. "b"] :: [String])
+    In an equation for ‘main’: main = print (["a" .. "b"] :: [String])
diff --git a/testsuite/tests/overloadedlists/should_fail/overloadedlistsfail05.stderr b/testsuite/tests/overloadedlists/should_fail/overloadedlistsfail05.stderr
index 131294b138ee..c576b5868c6a 100644
--- a/testsuite/tests/overloadedlists/should_fail/overloadedlistsfail05.stderr
+++ b/testsuite/tests/overloadedlists/should_fail/overloadedlistsfail05.stderr
@@ -1,7 +1,7 @@
 
 overloadedlistsfail05.hs:3:29:
-    Couldn't match expected type ‛Char’ with actual type ‛Int’
+    Couldn't match expected type ‘Char’ with actual type ‘Int’
     In the expression: (10 :: Int)
-    In the first argument of ‛length’, namely ‛['a' .. (10 :: Int)]’
-    In the first argument of ‛print’, namely
-      ‛(length ['a' .. (10 :: Int)])’
+    In the first argument of ‘length’, namely ‘['a' .. (10 :: Int)]’
+    In the first argument of ‘print’, namely
+      ‘(length ['a' .. (10 :: Int)])’
diff --git a/testsuite/tests/overloadedlists/should_fail/overloadedlistsfail06.stderr b/testsuite/tests/overloadedlists/should_fail/overloadedlistsfail06.stderr
index 239465670fdf..472bd787e204 100644
--- a/testsuite/tests/overloadedlists/should_fail/overloadedlistsfail06.stderr
+++ b/testsuite/tests/overloadedlists/should_fail/overloadedlistsfail06.stderr
@@ -1,4 +1,4 @@
 
-overloadedlistsfail06.hs:3:3: Not in scope: ‛toList’
+overloadedlistsfail06.hs:3:3: Not in scope: ‘toList’
 
-overloadedlistsfail06.hs:3:8: Not in scope: ‛fromListN’
+overloadedlistsfail06.hs:3:8: Not in scope: ‘fromListN’
diff --git a/testsuite/tests/overloadedlists/should_run/overloadedlistsrun02.hs b/testsuite/tests/overloadedlists/should_run/overloadedlistsrun02.hs
index 8567db3566a4..a6b9bb8edec2 100644
--- a/testsuite/tests/overloadedlists/should_run/overloadedlistsrun02.hs
+++ b/testsuite/tests/overloadedlists/should_run/overloadedlistsrun02.hs
@@ -6,8 +6,3 @@ import GHC.Exts
 main = do print ([] :: (S.Set Int))
           print (['a','b','c'] :: (S.Set Char))
           print (['a','c'..'g'] :: (S.Set Char))
-          
-instance Ord a => IsList (S.Set a) where
- type (Item (S.Set a)) = a
- fromList = S.fromList
- toList = S.toList
diff --git a/testsuite/tests/overloadedlists/should_run/overloadedlistsrun04.hs b/testsuite/tests/overloadedlists/should_run/overloadedlistsrun04.hs
index 478d8d2c2268..1111f9342700 100644
--- a/testsuite/tests/overloadedlists/should_run/overloadedlistsrun04.hs
+++ b/testsuite/tests/overloadedlists/should_run/overloadedlistsrun04.hs
@@ -3,10 +3,10 @@
 import qualified Data.Set as S
 import GHC.Exts
 
-main = do putStrLn (f [])       
-          putStrLn (f [1,2])    
-          putStrLn (f [2,0])    
-          putStrLn (f [3,2])     
+main = do putStrLn (f [])
+          putStrLn (f [1,2])
+          putStrLn (f [2,0])
+          putStrLn (f [3,2])
           putStrLn (f [2,7])
           putStrLn (f [2,2])
           putStrLn (f [1..7])
@@ -18,11 +18,3 @@ f [_] = "one element"
 f [2,_] = "two elements, the smaller one is 2"
 f [_,2] = "two elements, the bigger one is 2"
 f _ = "else"
-
-          
-instance Ord a => IsList (S.Set a) where
- type (Item (S.Set a)) = a
- fromList = S.fromList
- toList = S.toList
-          
-
diff --git a/testsuite/tests/package/Makefile b/testsuite/tests/package/Makefile
new file mode 100644
index 000000000000..9a36a1c5fee5
--- /dev/null
+++ b/testsuite/tests/package/Makefile
@@ -0,0 +1,3 @@
+TOP=../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
diff --git a/testsuite/tests/package/all.T b/testsuite/tests/package/all.T
new file mode 100644
index 000000000000..cb3094912440
--- /dev/null
+++ b/testsuite/tests/package/all.T
@@ -0,0 +1,21 @@
+setTestOpts(only_compiler_types(['ghc']))
+
+hide_all = '-hide-all-packages -XNoImplicitPrelude '
+incr_containers = '-package "containers (Data.Map as Map, Data.Set)" '
+inc_containers = '-package containers '
+incr_ghc = '-package "ghc (HsTypes as MyHsTypes, HsUtils)" '
+inc_ghc = '-package ghc '
+hide_ghc = '-hide-package ghc '
+
+test('package01',  normal, compile,      [hide_all + incr_containers])
+test('package01e', normal, compile_fail, [hide_all + incr_containers])
+test('package02',  normal, compile,      [hide_all + inc_containers + incr_containers])
+test('package03',  normal, compile,      [hide_all + incr_containers + inc_containers])
+test('package04',  normal, compile,      [incr_containers])
+test('package05',  normal, compile,      [incr_ghc + inc_ghc])
+test('package06',  normal, compile,      [incr_ghc])
+test('package06e', normal, compile_fail, [incr_ghc])
+test('package07e', normal, compile_fail, [incr_ghc + inc_ghc + hide_ghc])
+test('package08e', normal, compile_fail, [incr_ghc + hide_ghc])
+test('package09e', normal, compile_fail, ['-package "containers (Data.Map as M, Data.Set as M)"'])
+test('package10',  normal, compile,      ['-hide-all-packages -package "ghc (UniqFM as Prelude)" '])
diff --git a/testsuite/tests/package/package01.hs b/testsuite/tests/package/package01.hs
new file mode 100644
index 000000000000..0fdd41146f2f
--- /dev/null
+++ b/testsuite/tests/package/package01.hs
@@ -0,0 +1,3 @@
+module Package01 where
+import Map
+import Data.Set
diff --git a/testsuite/tests/package/package01e.hs b/testsuite/tests/package/package01e.hs
new file mode 100644
index 000000000000..946d400f7857
--- /dev/null
+++ b/testsuite/tests/package/package01e.hs
@@ -0,0 +1,3 @@
+module Package01e where
+import Data.Map
+import Data.IntMap
diff --git a/testsuite/tests/package/package01e.stderr b/testsuite/tests/package/package01e.stderr
new file mode 100644
index 000000000000..232ec6ce2def
--- /dev/null
+++ b/testsuite/tests/package/package01e.stderr
@@ -0,0 +1,10 @@
+
+package01e.hs:2:1:
+    Failed to load interface for ‘Data.Map’
+    It is a member of the hidden package ‘containers-0.5.5.1’.
+    Use -v to see a list of the files searched for.
+
+package01e.hs:3:1:
+    Failed to load interface for ‘Data.IntMap’
+    It is a member of the hidden package ‘containers-0.5.5.1’.
+    Use -v to see a list of the files searched for.
diff --git a/testsuite/tests/package/package02.hs b/testsuite/tests/package/package02.hs
new file mode 100644
index 000000000000..ea0640493512
--- /dev/null
+++ b/testsuite/tests/package/package02.hs
@@ -0,0 +1,5 @@
+module Package02 where
+import Data.Map
+import Map
+import Data.Set
+import Data.IntMap
diff --git a/testsuite/tests/package/package03.hs b/testsuite/tests/package/package03.hs
new file mode 100644
index 000000000000..d81dc3e037f5
--- /dev/null
+++ b/testsuite/tests/package/package03.hs
@@ -0,0 +1,5 @@
+module Package03 where
+import Data.Map
+import Map
+import Data.Set
+import Data.IntMap
diff --git a/testsuite/tests/package/package04.hs b/testsuite/tests/package/package04.hs
new file mode 100644
index 000000000000..85c2cae05a65
--- /dev/null
+++ b/testsuite/tests/package/package04.hs
@@ -0,0 +1,5 @@
+module Package04 where
+import Data.Map
+import Map
+import Data.Set
+import Data.IntMap
diff --git a/testsuite/tests/package/package05.hs b/testsuite/tests/package/package05.hs
new file mode 100644
index 000000000000..3b0069c5d58d
--- /dev/null
+++ b/testsuite/tests/package/package05.hs
@@ -0,0 +1,4 @@
+module Package05 where
+import HsTypes
+import MyHsTypes
+import HsUtils
diff --git a/testsuite/tests/package/package06.hs b/testsuite/tests/package/package06.hs
new file mode 100644
index 000000000000..096b81b7ba14
--- /dev/null
+++ b/testsuite/tests/package/package06.hs
@@ -0,0 +1,3 @@
+module Package06 where
+import MyHsTypes
+import HsUtils
diff --git a/testsuite/tests/package/package06e.hs b/testsuite/tests/package/package06e.hs
new file mode 100644
index 000000000000..6feaebda6216
--- /dev/null
+++ b/testsuite/tests/package/package06e.hs
@@ -0,0 +1,3 @@
+module Package06e where
+import HsTypes
+import UniqFM
diff --git a/testsuite/tests/package/package06e.stderr b/testsuite/tests/package/package06e.stderr
new file mode 100644
index 000000000000..2d4945549e7a
--- /dev/null
+++ b/testsuite/tests/package/package06e.stderr
@@ -0,0 +1,10 @@
+
+package06e.hs:2:1:
+    Failed to load interface for ‘HsTypes’
+    It is a member of the hidden package ‘ghc’.
+    Use -v to see a list of the files searched for.
+
+package06e.hs:3:1:
+    Failed to load interface for ‘UniqFM’
+    It is a member of the hidden package ‘ghc’.
+    Use -v to see a list of the files searched for.
diff --git a/testsuite/tests/package/package07e.hs b/testsuite/tests/package/package07e.hs
new file mode 100644
index 000000000000..85bb72398992
--- /dev/null
+++ b/testsuite/tests/package/package07e.hs
@@ -0,0 +1,5 @@
+module Package07e where
+import MyHsTypes
+import HsTypes
+import HsUtils
+import UniqFM
diff --git a/testsuite/tests/package/package07e.stderr b/testsuite/tests/package/package07e.stderr
new file mode 100644
index 000000000000..6a72a2e89c5c
--- /dev/null
+++ b/testsuite/tests/package/package07e.stderr
@@ -0,0 +1,20 @@
+
+package07e.hs:2:1:
+    Failed to load interface for ‘MyHsTypes’
+    Perhaps you meant HsTypes (needs flag -package-key ghc)
+    Use -v to see a list of the files searched for.
+
+package07e.hs:3:1:
+    Failed to load interface for ‘HsTypes’
+    It is a member of the hidden package ‘ghc’.
+    Use -v to see a list of the files searched for.
+
+package07e.hs:4:1:
+    Failed to load interface for ‘HsUtils’
+    It is a member of the hidden package ‘ghc’.
+    Use -v to see a list of the files searched for.
+
+package07e.hs:5:1:
+    Failed to load interface for ‘UniqFM’
+    It is a member of the hidden package ‘ghc’.
+    Use -v to see a list of the files searched for.
diff --git a/testsuite/tests/package/package08e.hs b/testsuite/tests/package/package08e.hs
new file mode 100644
index 000000000000..40f814449aa9
--- /dev/null
+++ b/testsuite/tests/package/package08e.hs
@@ -0,0 +1,5 @@
+module Package08e where
+import MyHsTypes
+import HsTypes
+import HsUtils
+import UniqFM
diff --git a/testsuite/tests/package/package08e.stderr b/testsuite/tests/package/package08e.stderr
new file mode 100644
index 000000000000..a7e8433f7a97
--- /dev/null
+++ b/testsuite/tests/package/package08e.stderr
@@ -0,0 +1,20 @@
+
+package08e.hs:2:1:
+    Failed to load interface for ‘MyHsTypes’
+    Perhaps you meant HsTypes (needs flag -package-key ghc)
+    Use -v to see a list of the files searched for.
+
+package08e.hs:3:1:
+    Failed to load interface for ‘HsTypes’
+    It is a member of the hidden package ‘ghc’.
+    Use -v to see a list of the files searched for.
+
+package08e.hs:4:1:
+    Failed to load interface for ‘HsUtils’
+    It is a member of the hidden package ‘ghc’.
+    Use -v to see a list of the files searched for.
+
+package08e.hs:5:1:
+    Failed to load interface for ‘UniqFM’
+    It is a member of the hidden package ‘ghc’.
+    Use -v to see a list of the files searched for.
diff --git a/testsuite/tests/package/package09e.hs b/testsuite/tests/package/package09e.hs
new file mode 100644
index 000000000000..8f08bbd5b232
--- /dev/null
+++ b/testsuite/tests/package/package09e.hs
@@ -0,0 +1,2 @@
+module Package09e where
+import M
diff --git a/testsuite/tests/package/package09e.stderr b/testsuite/tests/package/package09e.stderr
new file mode 100644
index 000000000000..9cd00a29308f
--- /dev/null
+++ b/testsuite/tests/package/package09e.stderr
@@ -0,0 +1,5 @@
+
+package09e.hs:2:1:
+    Ambiguous interface for ‘M’:
+      it is bound as Data.Set by a package flag
+      it is bound as Data.Map by a package flag
diff --git a/testsuite/tests/package/package10.hs b/testsuite/tests/package/package10.hs
new file mode 100644
index 000000000000..6db31da664eb
--- /dev/null
+++ b/testsuite/tests/package/package10.hs
@@ -0,0 +1,2 @@
+module Package10 where
+x = emptyUFM
diff --git a/testsuite/tests/parser/should_compile/T2245.stderr b/testsuite/tests/parser/should_compile/T2245.stderr
index 4d9e04dc7c1b..3a5f21ad214c 100644
--- a/testsuite/tests/parser/should_compile/T2245.stderr
+++ b/testsuite/tests/parser/should_compile/T2245.stderr
@@ -1,22 +1,22 @@
 
 T2245.hs:4:10: Warning:
     No explicit implementation for
-      ‛+’, ‛*’, ‛abs’, ‛signum’, ‛fromInteger’, and (either ‛negate’
+      ‘+’, ‘*’, ‘abs’, ‘signum’, ‘fromInteger’, and (either ‘negate’
                                                             or
-                                                            ‛-’)
-    In the instance declaration for ‛Num T’
+                                                            ‘-’)
+    In the instance declaration for ‘Num T’
 
 T2245.hs:5:10: Warning:
     No explicit implementation for
-      ‛fromRational’ and (either ‛recip’ or ‛/’)
-    In the instance declaration for ‛Fractional T’
+      ‘fromRational’ and (either ‘recip’ or ‘/’)
+    In the instance declaration for ‘Fractional T’
 
 T2245.hs:7:38: Warning:
-    Defaulting the following constraint(s) to type ‛T’
-      (Read b0) arising from a use of ‛read’ at T2245.hs:7:38-41
-      (Ord b0) arising from a use of ‛<’ at T2245.hs:7:27
+    Defaulting the following constraint(s) to type ‘T’
+      (Read b0) arising from a use of ‘read’ at T2245.hs:7:38-41
+      (Ord b0) arising from a use of ‘<’ at T2245.hs:7:27
       (Fractional b0)
-        arising from the literal ‛1e400’ at T2245.hs:7:29-33
-    In the second argument of ‛(.)’, namely ‛read’
-    In the second argument of ‛(.)’, namely ‛(< 1e400) . read’
-    In the second argument of ‛($)’, namely ‛show . (< 1e400) . read’
+        arising from the literal ‘1e400’ at T2245.hs:7:29-33
+    In the second argument of ‘(.)’, namely ‘read’
+    In the second argument of ‘(.)’, namely ‘(< 1e400) . read’
+    In the second argument of ‘($)’, namely ‘show . (< 1e400) . read’
diff --git a/testsuite/tests/parser/should_compile/T3303.stderr b/testsuite/tests/parser/should_compile/T3303.stderr
index 685448f2cc75..df227f47ef9a 100644
--- a/testsuite/tests/parser/should_compile/T3303.stderr
+++ b/testsuite/tests/parser/should_compile/T3303.stderr
@@ -1,6 +1,6 @@
 
 T3303.hs:7:7: Warning:
-    In the use of ‛foo’ (imported from T3303A):
+    In the use of ‘foo’ (imported from T3303A):
     Deprecated: "This is a multi-line
                  deprecation message
                  for foo"
diff --git a/testsuite/tests/parser/should_compile/T5682.hs b/testsuite/tests/parser/should_compile/T5682.hs
new file mode 100644
index 000000000000..c5510edc8fde
--- /dev/null
+++ b/testsuite/tests/parser/should_compile/T5682.hs
@@ -0,0 +1,13 @@
+{-# LANGUAGE DataKinds, PolyKinds, DeriveDataTypeable, StandaloneDeriving, TypeOperators #-}
+
+module T5682 where
+
+import Data.Typeable
+
+data a :+: b = Mk a b
+data Foo = Bool :+: Bool
+
+type X = True ':+: False
+
+deriving instance Typeable '(:+:)
+
diff --git a/testsuite/tests/parser/should_compile/all.T b/testsuite/tests/parser/should_compile/all.T
index 112985611947..e9cc99e95903 100644
--- a/testsuite/tests/parser/should_compile/all.T
+++ b/testsuite/tests/parser/should_compile/all.T
@@ -96,3 +96,4 @@ test('T5243', extra_clean(['T5243A.hi', 'T5243A.o']),
      multimod_compile, ['T5243',''])
 test('T7118', normal, compile, [''])
 test('T7776', normal, compile, [''])
+test('T5682', normal, compile, [''])
\ No newline at end of file
diff --git a/testsuite/tests/parser/should_compile/read014.stderr-ghc b/testsuite/tests/parser/should_compile/read014.stderr-ghc
index 6b585790ae1e..f3d8d604fb9b 100644
--- a/testsuite/tests/parser/should_compile/read014.stderr-ghc
+++ b/testsuite/tests/parser/should_compile/read014.stderr-ghc
@@ -3,11 +3,11 @@ read014.hs:4:1: Warning:
     Top-level binding with no type signature:
       ng1 :: forall t a. Num a => t -> a -> a
 
-read014.hs:4:5: Warning: Defined but not used: ‛x’
+read014.hs:4:5: Warning: Defined but not used: ‘x’
 
 read014.hs:6:10: Warning:
     No explicit implementation for
-      ‛+’, ‛*’, ‛abs’, ‛signum’, and ‛fromInteger’
-    In the instance declaration for ‛Num (a, b)’
+      ‘+’, ‘*’, ‘abs’, ‘signum’, and ‘fromInteger’
+    In the instance declaration for ‘Num (a, b)’
 
-read014.hs:8:53: Warning: Defined but not used: ‛x’
+read014.hs:8:53: Warning: Defined but not used: ‘x’
diff --git a/testsuite/tests/parser/should_fail/ExportCommaComma.stderr b/testsuite/tests/parser/should_fail/ExportCommaComma.stderr
index 99b8d6a777d5..e5cf1b5a5fcd 100644
--- a/testsuite/tests/parser/should_fail/ExportCommaComma.stderr
+++ b/testsuite/tests/parser/should_fail/ExportCommaComma.stderr
@@ -1,2 +1,2 @@
 
-ExportCommaComma.hs:2:38: parse error on input ‛,’
+ExportCommaComma.hs:2:38: parse error on input ‘,’
diff --git a/testsuite/tests/parser/should_fail/ParserNoBinaryLiterals1.hs b/testsuite/tests/parser/should_fail/ParserNoBinaryLiterals1.hs
new file mode 100644
index 000000000000..6b7de0f71278
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/ParserNoBinaryLiterals1.hs
@@ -0,0 +1,5 @@
+module ParserNoBinaryLiterals1 where
+
+f :: Int -> ()
+f 0b0 = ()
+f _   = ()
diff --git a/testsuite/tests/parser/should_fail/ParserNoBinaryLiterals1.stderr b/testsuite/tests/parser/should_fail/ParserNoBinaryLiterals1.stderr
new file mode 100644
index 000000000000..3b57330e59fd
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/ParserNoBinaryLiterals1.stderr
@@ -0,0 +1,5 @@
+
+ParserNoBinaryLiterals1.hs:4:1:
+    Equations for ‘f’ have different numbers of arguments
+      ParserNoBinaryLiterals1.hs:4:1-10
+      ParserNoBinaryLiterals1.hs:5:1-10
diff --git a/testsuite/tests/parser/should_fail/ParserNoBinaryLiterals2.hs b/testsuite/tests/parser/should_fail/ParserNoBinaryLiterals2.hs
new file mode 100644
index 000000000000..e760bd888eda
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/ParserNoBinaryLiterals2.hs
@@ -0,0 +1,9 @@
+{-# LANGUAGE MagicHash #-}
+
+module ParserNoBinaryLiterals2 where
+
+import GHC.Types
+
+f :: Word -> ()
+f (W# 0b0##) = ()
+f _          = ()
diff --git a/testsuite/tests/parser/should_fail/ParserNoBinaryLiterals2.stderr b/testsuite/tests/parser/should_fail/ParserNoBinaryLiterals2.stderr
new file mode 100644
index 000000000000..4a756d6e2727
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/ParserNoBinaryLiterals2.stderr
@@ -0,0 +1,5 @@
+
+ParserNoBinaryLiterals2.hs:8:4:
+    Constructor ‘W#’ should have 1 argument, but has been given 2
+    In the pattern: W# 0 b0##
+    In an equation for ‘f’: f (W# 0 b0##) = ()
diff --git a/testsuite/tests/parser/should_fail/ParserNoBinaryLiterals3.hs b/testsuite/tests/parser/should_fail/ParserNoBinaryLiterals3.hs
new file mode 100644
index 000000000000..b6bc81b68a1d
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/ParserNoBinaryLiterals3.hs
@@ -0,0 +1,9 @@
+{-# LANGUAGE MagicHash #-}
+
+module ParserNoBinaryLiterals3 where
+
+import GHC.Types
+
+f :: Int -> ()
+f (I# 0b0#) = ()
+f _         = ()
diff --git a/testsuite/tests/parser/should_fail/ParserNoBinaryLiterals3.stderr b/testsuite/tests/parser/should_fail/ParserNoBinaryLiterals3.stderr
new file mode 100644
index 000000000000..32c27e6b8a8d
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/ParserNoBinaryLiterals3.stderr
@@ -0,0 +1,5 @@
+
+ParserNoBinaryLiterals3.hs:8:4:
+    Constructor ‘I#’ should have 1 argument, but has been given 2
+    In the pattern: I# 0 b0#
+    In an equation for ‘f’: f (I# 0 b0#) = ()
diff --git a/testsuite/tests/parser/should_fail/ParserNoLambdaCase.stderr b/testsuite/tests/parser/should_fail/ParserNoLambdaCase.stderr
index 00dd88b53f30..147c8fef9cce 100644
--- a/testsuite/tests/parser/should_fail/ParserNoLambdaCase.stderr
+++ b/testsuite/tests/parser/should_fail/ParserNoLambdaCase.stderr
@@ -1,2 +1,2 @@
 
-ParserNoLambdaCase.hs:3:6: parse error on input ‛case’
+ParserNoLambdaCase.hs:3:6: parse error on input ‘case’
diff --git a/testsuite/tests/parser/should_fail/T3811d.stderr b/testsuite/tests/parser/should_fail/T3811d.stderr
index d0cbacc3ffcf..fb23eceb2c45 100644
--- a/testsuite/tests/parser/should_fail/T3811d.stderr
+++ b/testsuite/tests/parser/should_fail/T3811d.stderr
@@ -1,6 +1,6 @@
 
 T3811d.hs:6:11:
-    Unexpected type ‛D Char’
-    In the class declaration for ‛C’
+    Unexpected type ‘D Char’
+    In the class declaration for ‘C’
     A class declaration should have form
       class C a b c where ...
diff --git a/testsuite/tests/parser/should_fail/T7848.stderr b/testsuite/tests/parser/should_fail/T7848.stderr
index 3fc3998a0111..1cbf5f4a8500 100644
--- a/testsuite/tests/parser/should_fail/T7848.stderr
+++ b/testsuite/tests/parser/should_fail/T7848.stderr
@@ -1,14 +1,14 @@
 
 T7848.hs:10:9:
-    Couldn't match expected type ‛forall a. a’
-                with actual type ‛t -> t1 -> A -> A -> A -> A -> t2’
+    Couldn't match expected type ‘forall a. a’
+                with actual type ‘t -> t1 -> A -> A -> A -> A -> t2’
     Relevant bindings include
       z :: t1 (bound at T7848.hs:6:12)
       (&) :: t1 (bound at T7848.hs:6:8)
       (+) :: t (bound at T7848.hs:6:3)
       x :: t -> t1 -> A -> A -> A -> A -> t2 (bound at T7848.hs:6:1)
     In the SPECIALISE pragma {-# SPECIALIZE (&) :: a #-}
-    In an equation for ‛x’:
+    In an equation for ‘x’:
         x (+) ((&)@z) ((:&&) a b) (c :&& d) (e `A` f) (A g h)
           = y
           where
diff --git a/testsuite/tests/parser/should_fail/T8431.stderr b/testsuite/tests/parser/should_fail/T8431.stderr
index 2f0583842555..4a4d1fe1aee3 100644
--- a/testsuite/tests/parser/should_fail/T8431.stderr
+++ b/testsuite/tests/parser/should_fail/T8431.stderr
@@ -1,2 +1,2 @@
 
-T8431.hs:1:1: parse error on input ‛)’
+T8431.hs:1:1: parse error on input ‘)’
diff --git a/testsuite/tests/parser/should_fail/T8506.stderr b/testsuite/tests/parser/should_fail/T8506.stderr
index bfccfaf14c8e..d7de4fe4e388 100644
--- a/testsuite/tests/parser/should_fail/T8506.stderr
+++ b/testsuite/tests/parser/should_fail/T8506.stderr
@@ -1,6 +1,6 @@
 
 T8506.hs:3:16:
-    Unexpected type ‛Int’
-    In the class declaration for ‛Shapable’
+    Unexpected type ‘Int’
+    In the class declaration for ‘Shapable’
     A class declaration should have form
-      class Shapable a b c where ...
+      class Shapable a where ...
diff --git a/testsuite/tests/parser/should_fail/all.T b/testsuite/tests/parser/should_fail/all.T
index 45c471e2c66a..7e286cf3f23b 100644
--- a/testsuite/tests/parser/should_fail/all.T
+++ b/testsuite/tests/parser/should_fail/all.T
@@ -75,6 +75,9 @@ test('readFailTraditionalRecords3', normal, compile_fail, [''])
 test('ParserNoForallUnicode', normal, compile_fail, [''])
 test('ParserNoLambdaCase', when(compiler_lt('ghc', '7.5'), skip), compile_fail, [''])
 test('ParserNoMultiWayIf', when(compiler_lt('ghc', '7.5'), skip), compile_fail, [''])
+test('ParserNoBinaryLiterals1', normal, compile_fail, [''])
+test('ParserNoBinaryLiterals2', normal, compile_fail, [''])
+test('ParserNoBinaryLiterals3', normal, compile_fail, [''])
 
 test('T5425', normal, compile_fail, [''])
 test('T984', normal, compile_fail, [''])
diff --git a/testsuite/tests/parser/should_fail/position001.stderr b/testsuite/tests/parser/should_fail/position001.stderr
index dabcfe45dec5..d83041b460e9 100644
--- a/testsuite/tests/parser/should_fail/position001.stderr
+++ b/testsuite/tests/parser/should_fail/position001.stderr
@@ -1,2 +1,2 @@
 
-position001.hs:6:33: parse error on input ‛module’
+position001.hs:6:33: parse error on input ‘module’
diff --git a/testsuite/tests/parser/should_fail/position002.stderr b/testsuite/tests/parser/should_fail/position002.stderr
index 4bf5e3e80849..a57a790323a5 100644
--- a/testsuite/tests/parser/should_fail/position002.stderr
+++ b/testsuite/tests/parser/should_fail/position002.stderr
@@ -1,2 +1,2 @@
 
-position002.hs:6:33: parse error on input ‛module’
+position002.hs:6:33: parse error on input ‘module’
diff --git a/testsuite/tests/parser/should_fail/readFail001.stderr b/testsuite/tests/parser/should_fail/readFail001.stderr
index dc02e8588fe3..e0859e8a1c67 100644
--- a/testsuite/tests/parser/should_fail/readFail001.stderr
+++ b/testsuite/tests/parser/should_fail/readFail001.stderr
@@ -1,26 +1,26 @@
 
 readFail001.hs:25:11:
-    The fixity signature for ‛+#’ lacks an accompanying binding
+    The fixity signature for ‘+#’ lacks an accompanying binding
 
 readFail001.hs:38:32:
-    Not in scope: type constructor or class ‛Leaf’
+    Not in scope: type constructor or class ‘Leaf’
     A data constructor of that name is in scope; did you mean DataKinds?
 
 readFail001.hs:38:41:
-    Not in scope: type constructor or class ‛Leaf’
+    Not in scope: type constructor or class ‘Leaf’
     A data constructor of that name is in scope; did you mean DataKinds?
 
-readFail001.hs:87:11: Not in scope: ‛x’
+readFail001.hs:87:11: Not in scope: ‘x’
 
-readFail001.hs:88:19: Not in scope: ‛x’
+readFail001.hs:88:19: Not in scope: ‘x’
 
-readFail001.hs:94:19: Not in scope: ‛isSpace’
+readFail001.hs:94:19: Not in scope: ‘isSpace’
 
-readFail001.hs:95:13: Not in scope: ‛foo’
+readFail001.hs:95:13: Not in scope: ‘foo’
 
-readFail001.hs:107:30: Not in scope: data constructor ‛Foo’
+readFail001.hs:107:30: Not in scope: data constructor ‘Foo’
 
-readFail001.hs:107:42: Not in scope: data constructor ‛Bar’
+readFail001.hs:107:42: Not in scope: data constructor ‘Bar’
 
 readFail001.hs:112:23:
-    Not in scope: type constructor or class ‛Foo’
+    Not in scope: type constructor or class ‘Foo’
diff --git a/testsuite/tests/parser/should_fail/readFail006.stderr b/testsuite/tests/parser/should_fail/readFail006.stderr
index f80f2dd5f73e..f697584e4a98 100644
--- a/testsuite/tests/parser/should_fail/readFail006.stderr
+++ b/testsuite/tests/parser/should_fail/readFail006.stderr
@@ -1,2 +1,2 @@
 
-readFail006.hs:8:12: parse error on input ‛@’
+readFail006.hs:8:12: parse error on input ‘@’
diff --git a/testsuite/tests/parser/should_fail/readFail008.stderr b/testsuite/tests/parser/should_fail/readFail008.stderr
index a2701740b073..8fd289a3019f 100644
--- a/testsuite/tests/parser/should_fail/readFail008.stderr
+++ b/testsuite/tests/parser/should_fail/readFail008.stderr
@@ -1,6 +1,6 @@
 
 readFail008.hs:5:15:
     A newtype constructor cannot have a strictness annotation,
-      but ‛T’ does
-    In the definition of data constructor ‛T’
-    In the newtype declaration for ‛N’
+      but ‘T’ does
+    In the definition of data constructor ‘T’
+    In the newtype declaration for ‘N’
diff --git a/testsuite/tests/parser/should_fail/readFail011.stderr b/testsuite/tests/parser/should_fail/readFail011.stderr
index 0d1e52e09a92..5c5504ba9a59 100644
--- a/testsuite/tests/parser/should_fail/readFail011.stderr
+++ b/testsuite/tests/parser/should_fail/readFail011.stderr
@@ -1,2 +1,2 @@
 
-readFail011.hs:7:10: parse error on input ‛=’
+readFail011.hs:7:10: parse error on input ‘=’
diff --git a/testsuite/tests/parser/should_fail/readFail013.stderr b/testsuite/tests/parser/should_fail/readFail013.stderr
index 114252c09430..ee3db9bae16c 100644
--- a/testsuite/tests/parser/should_fail/readFail013.stderr
+++ b/testsuite/tests/parser/should_fail/readFail013.stderr
@@ -1,2 +1,2 @@
 
-readFail013.hs:4:5: parse error on input ‛`’
+readFail013.hs:4:5: parse error on input ‘`’
diff --git a/testsuite/tests/parser/should_fail/readFail014.stderr b/testsuite/tests/parser/should_fail/readFail014.stderr
index 6582b49fcc9a..d8012cc19cd7 100644
--- a/testsuite/tests/parser/should_fail/readFail014.stderr
+++ b/testsuite/tests/parser/should_fail/readFail014.stderr
@@ -1,2 +1,2 @@
 
-readFail014.hs:3:12: parse error on input ‛}’
+readFail014.hs:3:12: parse error on input ‘}’
diff --git a/testsuite/tests/parser/should_fail/readFail016.stderr b/testsuite/tests/parser/should_fail/readFail016.stderr
index 87f3d2c65759..33ccbed4705b 100644
--- a/testsuite/tests/parser/should_fail/readFail016.stderr
+++ b/testsuite/tests/parser/should_fail/readFail016.stderr
@@ -1,4 +1,4 @@
 
 readFail016.hs:7:1:
     Precedence parsing error
-        cannot mix ‛|-’ [infix 6] and ‛:’ [infixr 5] in the same infix expression
+        cannot mix ‘|-’ [infix 6] and ‘:’ [infixr 5] in the same infix expression
diff --git a/testsuite/tests/parser/should_fail/readFail019.stderr b/testsuite/tests/parser/should_fail/readFail019.stderr
index 342817693411..0cf26735a0d0 100644
--- a/testsuite/tests/parser/should_fail/readFail019.stderr
+++ b/testsuite/tests/parser/should_fail/readFail019.stderr
@@ -1,2 +1,2 @@
 
-readFail019.hs:3:18: parse error on input ‛in’
+readFail019.hs:3:18: parse error on input ‘in’
diff --git a/testsuite/tests/parser/should_fail/readFail020.stderr b/testsuite/tests/parser/should_fail/readFail020.stderr
index aba8a92b789d..0e3bde41da97 100644
--- a/testsuite/tests/parser/should_fail/readFail020.stderr
+++ b/testsuite/tests/parser/should_fail/readFail020.stderr
@@ -1,2 +1,2 @@
 
-readFail020.hs:3:16: parse error on input ‛}’
+readFail020.hs:3:16: parse error on input ‘}’
diff --git a/testsuite/tests/parser/should_fail/readFail021.stderr b/testsuite/tests/parser/should_fail/readFail021.stderr
index ee6889fe4fa3..fe9c64b7e770 100644
--- a/testsuite/tests/parser/should_fail/readFail021.stderr
+++ b/testsuite/tests/parser/should_fail/readFail021.stderr
@@ -1,3 +1,3 @@
 
 readFail021.hs:1:1:
-    The IO action ‛main’ is not defined in module ‛Main’
+    The IO action ‘main’ is not defined in module ‘Main’
diff --git a/testsuite/tests/parser/should_fail/readFail023.stderr b/testsuite/tests/parser/should_fail/readFail023.stderr
index c31dc4e9934c..7c60be51085b 100644
--- a/testsuite/tests/parser/should_fail/readFail023.stderr
+++ b/testsuite/tests/parser/should_fail/readFail023.stderr
@@ -1,6 +1,6 @@
 
 readFail023.hs:9:5:
-    The operator ‛**’ [infixl 7] of a section
+    The operator ‘**’ [infixl 7] of a section
         must have lower precedence than that of the operand,
           namely prefix `-' [infixl 6]
-        in the section: ‛- 3 **’
+        in the section: ‘- 3 **’
diff --git a/testsuite/tests/parser/should_fail/readFail024.stderr b/testsuite/tests/parser/should_fail/readFail024.stderr
index 333841022964..45c8458d6c41 100644
--- a/testsuite/tests/parser/should_fail/readFail024.stderr
+++ b/testsuite/tests/parser/should_fail/readFail024.stderr
@@ -1,2 +1,2 @@
 
-readFail024.hs:5:2: parse error on input ‛h’
+readFail024.hs:5:2: parse error on input ‘h’
diff --git a/testsuite/tests/parser/should_fail/readFail025.stderr b/testsuite/tests/parser/should_fail/readFail025.stderr
index e706e52fc96b..5641642c99c6 100644
--- a/testsuite/tests/parser/should_fail/readFail025.stderr
+++ b/testsuite/tests/parser/should_fail/readFail025.stderr
@@ -1,6 +1,6 @@
 
 readFail025.hs:5:8:
-    Unexpected type ‛String’
-    In the data declaration for ‛T’
+    Unexpected type ‘String’
+    In the data declaration for ‘T’
     A data declaration should have form
-      data T a b c = ...
+      data T a = ...
diff --git a/testsuite/tests/parser/should_fail/readFail026.stderr b/testsuite/tests/parser/should_fail/readFail026.stderr
index 3c237954b8b0..0577b26d4569 100644
--- a/testsuite/tests/parser/should_fail/readFail026.stderr
+++ b/testsuite/tests/parser/should_fail/readFail026.stderr
@@ -1,2 +1,2 @@
 
-readFail026.hs:3:7: parse error on input ‛,’
+readFail026.hs:3:7: parse error on input ‘,’
diff --git a/testsuite/tests/parser/should_fail/readFail034.stderr b/testsuite/tests/parser/should_fail/readFail034.stderr
index 201abd40119c..027d0ca13fb4 100644
--- a/testsuite/tests/parser/should_fail/readFail034.stderr
+++ b/testsuite/tests/parser/should_fail/readFail034.stderr
@@ -1,2 +1,2 @@
 
-readFail034.hs:4:6: parse error on input ‛=’
+readFail034.hs:4:6: parse error on input ‘=’
diff --git a/testsuite/tests/parser/should_fail/readFail035.stderr b/testsuite/tests/parser/should_fail/readFail035.stderr
index cd0f2c38ead0..574cde49ab3a 100644
--- a/testsuite/tests/parser/should_fail/readFail035.stderr
+++ b/testsuite/tests/parser/should_fail/readFail035.stderr
@@ -1,4 +1,4 @@
 
 readFail035.hs:6:1:
-    ‛Foo’ has no constructors (EmptyDataDecls permits this)
-    In the data declaration for ‛Foo’
+    ‘Foo’ has no constructors (EmptyDataDecls permits this)
+    In the data declaration for ‘Foo’
diff --git a/testsuite/tests/parser/should_fail/readFail036.stderr b/testsuite/tests/parser/should_fail/readFail036.stderr
index 8c9d4d4aa3f0..0d22eb83633d 100644
--- a/testsuite/tests/parser/should_fail/readFail036.stderr
+++ b/testsuite/tests/parser/should_fail/readFail036.stderr
@@ -1,5 +1,5 @@
 
 readFail036.hs:4:16:
-    Illegal kind signature: ‛*’
+    Illegal kind signature: ‘*’
       Perhaps you intended to use KindSignatures
-    In the data type declaration for ‛Foo’
+    In the data type declaration for ‘Foo’
diff --git a/testsuite/tests/parser/should_fail/readFail037.stderr b/testsuite/tests/parser/should_fail/readFail037.stderr
index e3e65cf6455c..6fcd2db2064f 100644
--- a/testsuite/tests/parser/should_fail/readFail037.stderr
+++ b/testsuite/tests/parser/should_fail/readFail037.stderr
@@ -1,5 +1,5 @@
 
 readFail037.hs:4:1:
-    Too many parameters for class ‛Foo’
+    Too many parameters for class ‘Foo’
     (Use MultiParamTypeClasses to allow multi-parameter classes)
-    In the class declaration for ‛Foo’
+    In the class declaration for ‘Foo’
diff --git a/testsuite/tests/parser/should_fail/readFail039.stderr b/testsuite/tests/parser/should_fail/readFail039.stderr
index a4ffdf8dac78..81d5001624e9 100644
--- a/testsuite/tests/parser/should_fail/readFail039.stderr
+++ b/testsuite/tests/parser/should_fail/readFail039.stderr
@@ -1,6 +1,6 @@
 
 readFail039.hs:8:14:
-    Can't make a derived instance of ‛C Foo’:
-      ‛C’ is not a derivable class
+    Can't make a derived instance of ‘C Foo’:
+      ‘C’ is not a derivable class
       Try GeneralizedNewtypeDeriving for GHC's newtype-deriving extension
-    In the newtype declaration for ‛Foo’
+    In the newtype declaration for ‘Foo’
diff --git a/testsuite/tests/parser/should_fail/readFail040.stderr b/testsuite/tests/parser/should_fail/readFail040.stderr
index 31a36182145b..6cbb3ce525fe 100644
--- a/testsuite/tests/parser/should_fail/readFail040.stderr
+++ b/testsuite/tests/parser/should_fail/readFail040.stderr
@@ -1,2 +1,2 @@
 
-readFail040.hs:7:11: parse error on input ‛<-’
+readFail040.hs:7:11: parse error on input ‘<-’
diff --git a/testsuite/tests/parser/should_fail/readFail041.stderr b/testsuite/tests/parser/should_fail/readFail041.stderr
index f94d2282ed61..c5b28a6f0f28 100644
--- a/testsuite/tests/parser/should_fail/readFail041.stderr
+++ b/testsuite/tests/parser/should_fail/readFail041.stderr
@@ -1,5 +1,5 @@
 
 readFail041.hs:6:1:
-    Fundeps in class ‛Foo’
+    Fundeps in class ‘Foo’
     (Use FunctionalDependencies to allow fundeps)
-    In the class declaration for ‛Foo’
+    In the class declaration for ‘Foo’
diff --git a/testsuite/tests/parser/should_fail/readFail042.stderr b/testsuite/tests/parser/should_fail/readFail042.stderr
index 433397ff11d1..b5d64f81c56c 100644
--- a/testsuite/tests/parser/should_fail/readFail042.stderr
+++ b/testsuite/tests/parser/should_fail/readFail042.stderr
@@ -7,6 +7,6 @@ readFail042.hs:11:9:
     Unexpected transform statement in a list comprehension
     Use TransformListComp
 
-readFail042.hs:11:23: Not in scope: ‛by’
+readFail042.hs:11:23: Not in scope: ‘by’
 
-readFail042.hs:11:26: Not in scope: ‛x’
+readFail042.hs:11:26: Not in scope: ‘x’
diff --git a/testsuite/tests/parser/should_fail/readFail043.stderr b/testsuite/tests/parser/should_fail/readFail043.stderr
index b39f8f87a23e..bdbacb7980e5 100644
--- a/testsuite/tests/parser/should_fail/readFail043.stderr
+++ b/testsuite/tests/parser/should_fail/readFail043.stderr
@@ -3,24 +3,24 @@ readFail043.hs:10:9:
     Unexpected transform statement in a list comprehension
     Use TransformListComp
 
-readFail043.hs:10:20: Not in scope: ‛by’
+readFail043.hs:10:20: Not in scope: ‘by’
 
-readFail043.hs:10:23: Not in scope: ‛x’
+readFail043.hs:10:23: Not in scope: ‘x’
 
-readFail043.hs:10:25: Not in scope: ‛using’
+readFail043.hs:10:25: Not in scope: ‘using’
 
 readFail043.hs:11:9:
     Unexpected transform statement in a list comprehension
     Use TransformListComp
 
-readFail043.hs:11:20: Not in scope: ‛by’
+readFail043.hs:11:20: Not in scope: ‘by’
 
-readFail043.hs:11:23: Not in scope: ‛x’
+readFail043.hs:11:23: Not in scope: ‘x’
 
-readFail043.hs:11:25: Not in scope: ‛using’
+readFail043.hs:11:25: Not in scope: ‘using’
 
 readFail043.hs:12:9:
     Unexpected transform statement in a list comprehension
     Use TransformListComp
 
-readFail043.hs:12:20: Not in scope: ‛using’
+readFail043.hs:12:20: Not in scope: ‘using’
diff --git a/testsuite/tests/parser/should_fail/readFail046.stderr b/testsuite/tests/parser/should_fail/readFail046.stderr
index 072fe530f9ec..5ac8b7091af8 100644
--- a/testsuite/tests/parser/should_fail/readFail046.stderr
+++ b/testsuite/tests/parser/should_fail/readFail046.stderr
@@ -1,4 +1,4 @@
 
 readFail046.hs:1:14:
     Unsupported extension: ExistientialQuantification
-    Perhaps you meant ‛ExistentialQuantification’ or ‛NoExistentialQuantification’
+    Perhaps you meant ‘ExistentialQuantification’ or ‘NoExistentialQuantification’
diff --git a/testsuite/tests/parser/should_run/BinaryLiterals0.hs b/testsuite/tests/parser/should_run/BinaryLiterals0.hs
new file mode 100644
index 000000000000..7257445fbaaf
--- /dev/null
+++ b/testsuite/tests/parser/should_run/BinaryLiterals0.hs
@@ -0,0 +1,19 @@
+-- | Anti-Test for GHC 7.10+'s @BinaryLiterals@ extensions (see GHC #9224)
+--
+-- NB: This code won't compile with -XBinaryLiterals enabled
+
+{-# LANGUAGE NegativeLiterals #-}
+
+module Main where
+
+main :: IO ()
+main = print lst
+  where
+    -- "0b0" is to be parsed as "0 b0"
+    lst = [ (,) 0b0, (,) 0b1, (,) 0b10, (,) 0b11
+          , (,) -0b0, (,) -0b1, (,) -0b10, (,) -0b11
+          ] :: [(Int,Int)]
+    b0 = 60
+    b1 = 61
+    b11 = 611
+    b10 = 610
diff --git a/testsuite/tests/parser/should_run/BinaryLiterals0.stdout b/testsuite/tests/parser/should_run/BinaryLiterals0.stdout
new file mode 100644
index 000000000000..dacce8854ed4
--- /dev/null
+++ b/testsuite/tests/parser/should_run/BinaryLiterals0.stdout
@@ -0,0 +1 @@
+[(0,60),(0,61),(0,610),(0,611),(0,60),(0,61),(0,610),(0,611)]
diff --git a/testsuite/tests/parser/should_run/BinaryLiterals1.hs b/testsuite/tests/parser/should_run/BinaryLiterals1.hs
new file mode 100644
index 000000000000..f9918fb068e6
--- /dev/null
+++ b/testsuite/tests/parser/should_run/BinaryLiterals1.hs
@@ -0,0 +1,25 @@
+-- | Test for GHC 7.10+'s @BinaryLiterals@ extensions (see GHC #9224)
+
+{-# LANGUAGE BinaryLiterals #-}
+{-# LANGUAGE MagicHash #-}
+
+module Main where
+
+import GHC.Types
+
+main = do
+    print [ I# 0b0#, I# -0b0#, I# 0b1#, I# -0b1#
+          , I# 0b00000000000000000000000000000000000000000000000000000000000000000000000000001#
+          , I# -0b00000000000000000000000000000000000000000000000000000000000000000000000000001#
+          , I# -0b11001001#, I# -0b11001001#
+          , I# -0b11111111#, I# -0b11111111#
+          ]
+    print [ W# 0b0##, W# 0b1##, W# 0b11001001##, W# 0b11##, W# 0b11111111##
+          , W# 0b00000000000000000000000000000000000000000000000000000000000000000000000000001##
+          ]
+
+    print [ 0b0, 0b1, 0b10, 0b11, 0b100, 0b101, 0b110, 0b111 :: Integer
+          , -0b0, -0b1, -0b10, -0b11, -0b100, -0b101, -0b110, -0b111
+          , 0b11111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111
+          , -0b11111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111
+          ]
diff --git a/testsuite/tests/parser/should_run/BinaryLiterals1.stdout b/testsuite/tests/parser/should_run/BinaryLiterals1.stdout
new file mode 100644
index 000000000000..e1065be034f5
--- /dev/null
+++ b/testsuite/tests/parser/should_run/BinaryLiterals1.stdout
@@ -0,0 +1,3 @@
+[0,0,1,-1,1,-1,-201,-201,-255,-255]
+[0,1,201,3,255,1]
+[0,1,2,3,4,5,6,7,0,-1,-2,-3,-4,-5,-6,-7,340282366920938463463374607431768211455,-340282366920938463463374607431768211455]
diff --git a/testsuite/tests/parser/should_run/BinaryLiterals2.hs b/testsuite/tests/parser/should_run/BinaryLiterals2.hs
new file mode 100644
index 000000000000..3779d5234169
--- /dev/null
+++ b/testsuite/tests/parser/should_run/BinaryLiterals2.hs
@@ -0,0 +1,29 @@
+-- | Test for GHC 7.10+'s @BinaryLiterals@ extensions (see GHC #9224)
+
+{-# LANGUAGE BinaryLiterals #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE NegativeLiterals #-}
+
+module Main where
+
+import GHC.Types
+import GHC.Int
+
+main = do
+    print [ I# 0B0#, I# -0B0#, I# 0B1#, I# -0B1#
+          , I# 0B00000000000000000000000000000000000000000000000000000000000000000000000000001#
+          , I# -0B00000000000000000000000000000000000000000000000000000000000000000000000000001#
+          , I# -0B11001001#, I# -0B11001001#
+          , I# -0B11111111#, I# -0B11111111#
+          ]
+    print [ W# 0B0##, W# 0B1##, W# 0B11001001##, W# 0B11##, W# 0B11111111##
+          , W# 0B00000000000000000000000000000000000000000000000000000000000000000000000000001##
+          ]
+
+    print [ 0B0, 0B1, 0B10, 0B11, 0B100, 0B101, 0B110, 0B111 :: Integer
+          , -0B0, -0B1, -0B10, -0B11, -0B100, -0B101, -0B110, -0B111
+          , 0B11111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111
+          , -0B11111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111
+          ]
+
+    print [ I8# -0B10000000#, I8# 0B1111111# ]
diff --git a/testsuite/tests/parser/should_run/BinaryLiterals2.stdout b/testsuite/tests/parser/should_run/BinaryLiterals2.stdout
new file mode 100644
index 000000000000..76506e9670ac
--- /dev/null
+++ b/testsuite/tests/parser/should_run/BinaryLiterals2.stdout
@@ -0,0 +1,4 @@
+[0,0,1,-1,1,-1,-201,-201,-255,-255]
+[0,1,201,3,255,1]
+[0,1,2,3,4,5,6,7,0,-1,-2,-3,-4,-5,-6,-7,340282366920938463463374607431768211455,-340282366920938463463374607431768211455]
+[-128,127]
diff --git a/testsuite/tests/parser/should_run/all.T b/testsuite/tests/parser/should_run/all.T
index eee0330e5ea4..cf7ee6fdd32b 100644
--- a/testsuite/tests/parser/should_run/all.T
+++ b/testsuite/tests/parser/should_run/all.T
@@ -6,3 +6,6 @@ test('T1344', normal, compile_and_run, [''])
 test('operator', normal, compile_and_run, [''])
 test('operator2', normal, compile_and_run, [''])
 test('ParserMultiWayIf', when(compiler_lt('ghc', '7.5'), skip), compile_and_run, [''])
+test('BinaryLiterals0', normal, compile_and_run, [''])
+test('BinaryLiterals1', when(compiler_lt('ghc', '7.9'), skip), compile_and_run, [''])
+test('BinaryLiterals2', when(compiler_lt('ghc', '7.9'), skip), compile_and_run, [''])
\ No newline at end of file
diff --git a/testsuite/tests/parser/unicode/T2302.stderr b/testsuite/tests/parser/unicode/T2302.stderr
index 0557a731db6a..7f7f9a9f9267 100644
--- a/testsuite/tests/parser/unicode/T2302.stderr
+++ b/testsuite/tests/parser/unicode/T2302.stderr
@@ -1,2 +1,2 @@
 
-T2302.hs:1:5: Not in scope: data constructor ‛À’
+T2302.hs:1:5: Not in scope: data constructor ‘À’
diff --git a/testsuite/tests/patsyn/should_compile/.gitignore b/testsuite/tests/patsyn/should_compile/.gitignore
deleted file mode 100644
index 492f1e78dd59..000000000000
--- a/testsuite/tests/patsyn/should_compile/.gitignore
+++ /dev/null
@@ -1,9 +0,0 @@
-.hpc.bidir
-.hpc.ex
-.hpc.ex-num
-.hpc.ex-prov
-.hpc.ex-view
-.hpc.incomplete
-.hpc.num
-.hpc.overlap
-.hpc.univ
diff --git a/testsuite/tests/patsyn/should_compile/T8966.hs b/testsuite/tests/patsyn/should_compile/T8966.hs
new file mode 100644
index 000000000000..895ff1b76491
--- /dev/null
+++ b/testsuite/tests/patsyn/should_compile/T8966.hs
@@ -0,0 +1,8 @@
+{-# LANGUAGE PolyKinds, KindSignatures, PatternSynonyms, DataKinds, GADTs  #-}
+
+module T8966 where
+
+data NQ :: [k] -> * where
+   D :: NQ '[a]
+
+pattern Q = D
diff --git a/testsuite/tests/patsyn/should_compile/T9023.hs b/testsuite/tests/patsyn/should_compile/T9023.hs
new file mode 100644
index 000000000000..3a8614009fff
--- /dev/null
+++ b/testsuite/tests/patsyn/should_compile/T9023.hs
@@ -0,0 +1,6 @@
+{-# LANGUAGE PatternSynonyms #-}
+
+module T9023 where
+
+pattern P a b = Just (a, b)
+foo P{} = True
diff --git a/testsuite/tests/patsyn/should_compile/all.T b/testsuite/tests/patsyn/should_compile/all.T
index 84b231cf61b2..d851bc3ac837 100644
--- a/testsuite/tests/patsyn/should_compile/all.T
+++ b/testsuite/tests/patsyn/should_compile/all.T
@@ -7,3 +7,6 @@ test('ex-view', normal, compile, [''])
 test('ex-num', normal, compile, [''])
 test('num', normal, compile, [''])
 test('incomplete', normal, compile, [''])
+test('export', normal, compile, [''])
+test('T8966', normal, compile, [''])
+test('T9023', normal, compile, [''])
diff --git a/testsuite/tests/patsyn/should_compile/export.hs b/testsuite/tests/patsyn/should_compile/export.hs
new file mode 100644
index 000000000000..957f735e202d
--- /dev/null
+++ b/testsuite/tests/patsyn/should_compile/export.hs
@@ -0,0 +1,4 @@
+{-# LANGUAGE PatternSynonyms #-}
+module ShouldCompile (pattern Single) where
+
+pattern Single x <- [x]
diff --git a/testsuite/tests/patsyn/should_fail/T8961.hs b/testsuite/tests/patsyn/should_fail/T8961.hs
new file mode 100644
index 000000000000..087c39993bf2
--- /dev/null
+++ b/testsuite/tests/patsyn/should_fail/T8961.hs
@@ -0,0 +1,7 @@
+module ShouldFail where
+
+import T8961a
+
+single :: [a] -> Maybe a
+single (Single x) = Just x
+single _ = Nothing
diff --git a/testsuite/tests/patsyn/should_fail/T8961.stderr b/testsuite/tests/patsyn/should_fail/T8961.stderr
new file mode 100644
index 000000000000..a58ee3800414
--- /dev/null
+++ b/testsuite/tests/patsyn/should_fail/T8961.stderr
@@ -0,0 +1,7 @@
+[1 of 2] Compiling T8961a           ( T8961a.hs, T8961a.o )
+[2 of 2] Compiling ShouldFail       ( T8961.hs, T8961.o )
+
+T8961.hs:6:9:
+    A pattern match on a pattern synonym requires PatternSynonyms
+    In the pattern: Single x
+    In an equation for ‘single’: single (Single x) = Just x
diff --git a/testsuite/tests/patsyn/should_fail/T8961a.hs b/testsuite/tests/patsyn/should_fail/T8961a.hs
new file mode 100644
index 000000000000..f741d7b5d11b
--- /dev/null
+++ b/testsuite/tests/patsyn/should_fail/T8961a.hs
@@ -0,0 +1,4 @@
+{-# LANGUAGE PatternSynonyms #-}
+module T8961a (pattern Single) where
+
+pattern Single x <- [x]
diff --git a/testsuite/tests/patsyn/should_fail/T9161-1.hs b/testsuite/tests/patsyn/should_fail/T9161-1.hs
new file mode 100644
index 000000000000..c14eb542cc33
--- /dev/null
+++ b/testsuite/tests/patsyn/should_fail/T9161-1.hs
@@ -0,0 +1,7 @@
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE DataKinds #-}
+
+pattern PATTERN = ()
+
+wrongLift :: PATTERN
+wrongLift = undefined
diff --git a/testsuite/tests/patsyn/should_fail/T9161-1.stderr b/testsuite/tests/patsyn/should_fail/T9161-1.stderr
new file mode 100644
index 000000000000..1f05196ebb21
--- /dev/null
+++ b/testsuite/tests/patsyn/should_fail/T9161-1.stderr
@@ -0,0 +1,4 @@
+
+T9161-1.hs:6:14:
+    Pattern synonym ‘PATTERN’ used as a type
+    In the type signature for ‘wrongLift’: wrongLift :: PATTERN
diff --git a/testsuite/tests/patsyn/should_fail/T9161-2.hs b/testsuite/tests/patsyn/should_fail/T9161-2.hs
new file mode 100644
index 000000000000..941d23e35fb0
--- /dev/null
+++ b/testsuite/tests/patsyn/should_fail/T9161-2.hs
@@ -0,0 +1,9 @@
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE DataKinds, KindSignatures, PolyKinds #-}
+
+pattern PATTERN = ()
+
+data Proxy (tag :: k) (a :: *)
+
+wrongLift :: Proxy PATTERN ()
+wrongLift = undefined
diff --git a/testsuite/tests/patsyn/should_fail/T9161-2.stderr b/testsuite/tests/patsyn/should_fail/T9161-2.stderr
new file mode 100644
index 000000000000..8d21be5906b9
--- /dev/null
+++ b/testsuite/tests/patsyn/should_fail/T9161-2.stderr
@@ -0,0 +1,5 @@
+
+T9161-2.hs:8:20:
+    Pattern synonym ‘PATTERN’ used as a type
+    In the type signature for ‘wrongLift’:
+      wrongLift :: Proxy PATTERN ()
diff --git a/testsuite/tests/patsyn/should_fail/all.T b/testsuite/tests/patsyn/should_fail/all.T
index e1708d29e087..bff6bdf8c247 100644
--- a/testsuite/tests/patsyn/should_fail/all.T
+++ b/testsuite/tests/patsyn/should_fail/all.T
@@ -1,3 +1,8 @@
 
 test('mono', normal, compile_fail, [''])
 test('unidir', normal, compile_fail, [''])
+test('local', normal, compile_fail, [''])
+test('T8961', normal, multimod_compile_fail, ['T8961',''])
+test('as-pattern', normal, compile_fail, [''])
+test('T9161-1', normal, compile_fail, [''])
+test('T9161-2', normal, compile_fail, [''])
diff --git a/testsuite/tests/patsyn/should_fail/as-pattern.hs b/testsuite/tests/patsyn/should_fail/as-pattern.hs
new file mode 100644
index 000000000000..2794bed16ae8
--- /dev/null
+++ b/testsuite/tests/patsyn/should_fail/as-pattern.hs
@@ -0,0 +1,4 @@
+{-# LANGUAGE PatternSynonyms #-}
+module ShouldFail where
+
+pattern P x y <- x@(Just y)
diff --git a/testsuite/tests/patsyn/should_fail/as-pattern.stderr b/testsuite/tests/patsyn/should_fail/as-pattern.stderr
new file mode 100644
index 000000000000..62db28f0236a
--- /dev/null
+++ b/testsuite/tests/patsyn/should_fail/as-pattern.stderr
@@ -0,0 +1,4 @@
+
+as-pattern.hs:4:18:
+    Pattern synonym definition cannot contain as-patterns (@):
+      x@(Just y)
diff --git a/testsuite/tests/patsyn/should_fail/local.hs b/testsuite/tests/patsyn/should_fail/local.hs
new file mode 100644
index 000000000000..08314ea4320e
--- /dev/null
+++ b/testsuite/tests/patsyn/should_fail/local.hs
@@ -0,0 +1,7 @@
+{-# LANGUAGE PatternSynonyms #-}
+module ShouldFail where
+
+varWithLocalPatSyn x = case x of
+    P -> ()
+  where
+    pattern P = ()
diff --git a/testsuite/tests/patsyn/should_fail/local.stderr b/testsuite/tests/patsyn/should_fail/local.stderr
new file mode 100644
index 000000000000..a9a8d01af91a
--- /dev/null
+++ b/testsuite/tests/patsyn/should_fail/local.stderr
@@ -0,0 +1,4 @@
+
+local.hs:7:5:
+    Illegal pattern synonym declaration
+      Pattern synonym declarations are only valid in the top-level scope
diff --git a/testsuite/tests/patsyn/should_fail/mono.stderr b/testsuite/tests/patsyn/should_fail/mono.stderr
index db54f0b11abd..2bed60eafb6b 100644
--- a/testsuite/tests/patsyn/should_fail/mono.stderr
+++ b/testsuite/tests/patsyn/should_fail/mono.stderr
@@ -1,12 +1,12 @@
 
 mono.hs:7:4:
-    Couldn't match type ‛Int’ with ‛Bool’
+    Couldn't match type ‘Int’ with ‘Bool’
     Expected type: [Bool]
       Actual type: [Int]
     In the pattern: Single x
-    In an equation for ‛f’: f (Single x) = x
+    In an equation for ‘f’: f (Single x) = x
 
 mono.hs:7:16:
-    Couldn't match expected type ‛Bool’ with actual type ‛Int’
+    Couldn't match expected type ‘Bool’ with actual type ‘Int’
     In the expression: x
-    In an equation for ‛f’: f (Single x) = x
+    In an equation for ‘f’: f (Single x) = x
diff --git a/testsuite/tests/patsyn/should_fail/unidir.stderr b/testsuite/tests/patsyn/should_fail/unidir.stderr
index ea019bc8e1e6..b1161154be6a 100644
--- a/testsuite/tests/patsyn/should_fail/unidir.stderr
+++ b/testsuite/tests/patsyn/should_fail/unidir.stderr
@@ -1,4 +1,4 @@
 
-unidir.hs:1:1:
+unidir.hs:4:18:
     Right-hand side of bidirectional pattern synonym cannot be used as an expression
       x : _
diff --git a/testsuite/tests/patsyn/should_run/.gitignore b/testsuite/tests/patsyn/should_run/.gitignore
deleted file mode 100644
index 7380291005ce..000000000000
--- a/testsuite/tests/patsyn/should_run/.gitignore
+++ /dev/null
@@ -1,7 +0,0 @@
-eval
-ex-prov
-match
-
-.hpc.eval
-.hpc.ex-prov
-.hpc.match
diff --git a/testsuite/tests/patsyn/should_run/all.T b/testsuite/tests/patsyn/should_run/all.T
index f5936c66c250..b3c6b744612e 100644
--- a/testsuite/tests/patsyn/should_run/all.T
+++ b/testsuite/tests/patsyn/should_run/all.T
@@ -1,3 +1,5 @@
 test('eval', normal, compile_and_run, [''])
 test('match', normal, compile_and_run, [''])
 test('ex-prov-run', normal, compile_and_run, [''])
+test('bidir-explicit', normal, compile_and_run, [''])
+test('bidir-explicit-scope', normal, compile_and_run, [''])
diff --git a/testsuite/tests/patsyn/should_run/bidir-explicit-scope.hs b/testsuite/tests/patsyn/should_run/bidir-explicit-scope.hs
new file mode 100644
index 000000000000..390bbb097606
--- /dev/null
+++ b/testsuite/tests/patsyn/should_run/bidir-explicit-scope.hs
@@ -0,0 +1,10 @@
+{-# LANGUAGE PatternSynonyms #-}
+module Main where
+
+pattern First x <- x:_ where
+  First x = foo [x, x, x]
+
+foo :: [a] -> [a]
+foo xs@(First x) = replicate (length xs + 1) x
+
+main = mapM_ print $ First ()
diff --git a/testsuite/tests/patsyn/should_run/bidir-explicit-scope.stdout b/testsuite/tests/patsyn/should_run/bidir-explicit-scope.stdout
new file mode 100644
index 000000000000..35735b4d3b07
--- /dev/null
+++ b/testsuite/tests/patsyn/should_run/bidir-explicit-scope.stdout
@@ -0,0 +1,4 @@
+()
+()
+()
+()
diff --git a/testsuite/tests/patsyn/should_run/bidir-explicit.hs b/testsuite/tests/patsyn/should_run/bidir-explicit.hs
new file mode 100644
index 000000000000..d295191b26b7
--- /dev/null
+++ b/testsuite/tests/patsyn/should_run/bidir-explicit.hs
@@ -0,0 +1,7 @@
+{-# LANGUAGE PatternSynonyms #-}
+module Main where
+
+pattern First x <- x:_ where
+  First x = [x]
+
+main = mapM_ print $ First ()
diff --git a/testsuite/tests/patsyn/should_run/bidir-explicit.stdout b/testsuite/tests/patsyn/should_run/bidir-explicit.stdout
new file mode 100644
index 000000000000..6a452c185a8c
--- /dev/null
+++ b/testsuite/tests/patsyn/should_run/bidir-explicit.stdout
@@ -0,0 +1 @@
+()
diff --git a/testsuite/tests/perf/compiler/T5321FD.hs b/testsuite/tests/perf/compiler/T5321FD.hs
index 6e10939837a6..004f487098a7 100644
--- a/testsuite/tests/perf/compiler/T5321FD.hs
+++ b/testsuite/tests/perf/compiler/T5321FD.hs
@@ -1,7 +1,7 @@
 {-# OPTIONS_GHC -fcontext-stack=1000 #-} 
 {-# LANGUAGE 
      FlexibleContexts, FlexibleInstances, FunctionalDependencies, 
-     MultiParamTypeClasses, OverlappingInstances, TypeSynonymInstances, 
+     MultiParamTypeClasses, TypeSynonymInstances, 
      TypeOperators, UndecidableInstances, TypeFamilies #-} 
 module T5321FD where
 
diff --git a/testsuite/tests/perf/compiler/T5321Fun.hs b/testsuite/tests/perf/compiler/T5321Fun.hs
index efd7db770b10..bf70ce5221c9 100644
--- a/testsuite/tests/perf/compiler/T5321Fun.hs
+++ b/testsuite/tests/perf/compiler/T5321Fun.hs
@@ -1,7 +1,7 @@
 {-# OPTIONS_GHC -fcontext-stack=1000 #-} 
 {-# LANGUAGE 
      FlexibleContexts, FlexibleInstances, FunctionalDependencies, 
-     MultiParamTypeClasses, OverlappingInstances, TypeSynonymInstances, 
+     MultiParamTypeClasses, TypeSynonymInstances, 
      TypeOperators, UndecidableInstances, TypeFamilies #-} 
 module T5321Fun where
 
diff --git a/testsuite/tests/perf/compiler/T5837.stderr b/testsuite/tests/perf/compiler/T5837.stderr
index 9e912ef341cb..5cee13dd1de1 100644
--- a/testsuite/tests/perf/compiler/T5837.stderr
+++ b/testsuite/tests/perf/compiler/T5837.stderr
@@ -158,4 +158,4 @@ T5837.hs:8:6:
                                                                                                                                                           (TF
                                                                                                                                                              a)))))))))))))))))))))))))))))))))))))))))))))))))
     In the ambiguity check for: forall a. a ~ TF (a, Int) => Int
-    In the type signature for ‛t’: t :: a ~ TF (a, Int) => Int
+    In the type signature for ‘t’: t :: (a ~ TF (a, Int)) => Int
diff --git a/testsuite/tests/simplCore/should_compile/simpl015.hs b/testsuite/tests/perf/compiler/T9020.hs
similarity index 100%
rename from testsuite/tests/simplCore/should_compile/simpl015.hs
rename to testsuite/tests/perf/compiler/T9020.hs
diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T
index 498fc5f75190..ea62520b07a2 100644
--- a/testsuite/tests/perf/compiler/all.T
+++ b/testsuite/tests/perf/compiler/all.T
@@ -42,15 +42,17 @@ test('T1969',
              # 2013-02-13 27, very unstable!
              # 2013-09-11 30 (amd64/Linux)
       compiler_stats_num_field('max_bytes_used',
-          [(platform('i386-unknown-mingw32'), 7295012, 20),
+          [(platform('i386-unknown-mingw32'), 5719436, 20),
                                  # 2010-05-17 5717704 (x86/Windows)
                                  # 2013-02-10 5159748 (x86/Windows)
                                  # 2013-02-10 5030080 (x86/Windows)
                                  # 2013-11-13 7295012 (x86/Windows, 64bit machine)
-           (wordsize(32), 6429864, 1),
+                                 # 2014-04-24 5719436 (x86/Windows, 64bit machine)
+           (wordsize(32), 5949188, 1),
              #            6707308 (x86/OS X)
              # 2009-12-31 6149572 (x86/Linux)
              # 2014-01-22 6429864 (x86/Linux)
+             # 2014-06-29 5949188 (x86/Linux)
            (wordsize(64), 11000000, 20)]),
                # looks like the peak is around ~10M, but we're
                # unlikely to GC exactly on the peak.
@@ -58,18 +60,20 @@ test('T1969',
                # hence 10% range.
                # See Note [residency] to get an accurate view.
       compiler_stats_num_field('bytes allocated',
-          [(platform('i386-unknown-mingw32'), 317975916, 5),
+          [(platform('i386-unknown-mingw32'), 301784492, 5),
                                  #            215582916 (x86/Windows)
                                  # 2012-10-29 298921816 (x86/Windows)
                                  # 2013-02-10 310633884 (x86/Windows)
                                  # 2013-11-13 317975916 (x86/Windows, 64bit machine)
-           (wordsize(32), 316103268, 1),
+                                 # 2014-04-04 301784492 (x86/Windows, 64bit machine)
+           (wordsize(32), 303300692, 1),
              #            221667908 (x86/OS X)
              #            274932264 (x86/Linux)
              # 2012-10-08 303930948 (x86/Linux, new codegen)
              # 2013-02-10 322937684 (x86/OSX)
              # 2014-01-22 316103268 (x86/Linux)
-           (wordsize(64), 698612512, 5)]),
+             # 2014-06-29 303300692 (x86/Linux)
+           (wordsize(64), 651626680, 5)]),
              # 17/11/2009 434845560 (amd64/Linux)
              # 08/12/2009 459776680 (amd64/Linux)
              # 17/05/2010 519377728 (amd64/Linux)
@@ -77,19 +81,15 @@ test('T1969',
              # 16/07/2012 589168872 (amd64/Linux)
              # 20/07/2012 595936240 (amd64/Linux)
              # 23/08/2012 606230880 (amd64/Linux)
-             # 29/08/2012 633334184 (amd64/Linux)
-             #            (^ new codegen)
+             # 29/08/2012 633334184 (amd64/Linux) new codegen
              # 18/09/2012 641959976 (amd64/Linux)
-             # 19/10/2012 661832592 (amd64/Linux)
-             #            (^ -fPIC turned on)
-             # 23/10/2012 642594312 (amd64/Linux)
-             #            (^ -fPIC turned off again)
-             # 12/11/2012 658786936 (amd64/Linux)
-             #            (^ UNKNOWN REASON )
-             # 17/1/13:   667160192 (x86_64/Linux)
-             #            (^ new demand analyser)
-             # 18/10/2013 698612512 (x86_64/Linux)
-             #            (fix for #8456)
+             # 19/10/2012 661832592 (amd64/Linux) -fPIC turned on
+             # 23/10/2012 642594312 (amd64/Linux) -fPIC turned off again
+             # 12/11/2012 658786936 (amd64/Linux) UNKNOWN REASON
+             # 17/1/13:   667160192 (x86_64/Linux) new demand analyser
+             # 18/10/2013 698612512 (x86_64/Linux) fix for #8456
+             # 10/02/2014 660922376 (x86_64/Linux) call artiy analysis
+             # 17/07/2014 651626680 (x86_64/Linux) roundabout update
       only_ways(['normal']),
 
       extra_hc_opts('-dcore-lint -static')
@@ -114,13 +114,14 @@ else:
 test('T3294',
      [
       compiler_stats_num_field('max_bytes_used', # Note [residency]
-          [(wordsize(32), 24009436, 15),
+          [(wordsize(32), 19882188, 15),
              #            17725476 (x86/OS X)
              #            14593500 (Windows)
              # 2013-02-10 20651576 (x86/Windows)
              # 2013-02-10 20772984 (x86/OSX)
              # 2013-11-13 24009436 (x86/Windows, 64bit machine)
-           (wordsize(64), 43224080, 15)]),
+             # 2014-04-24 19882188 (x86/Windows, 64bit machine)
+           (wordsize(64), 40000000, 15)]),
              # prev:           25753192 (amd64/Linux)
              # 29/08/2012:     37724352 (amd64/Linux)
              #  (increase due to new codegen, see #7198)
@@ -130,23 +131,27 @@ test('T3294',
              #  (reason for decrease unknown)
              # 29/5/2013:      43224080  (amd64/Linux)
              #  (reason for increase back to earlier value unknown)
+             # 2014-07-14:     36670800  (amd64/Linux)
+             #  (reason unknown, setting expected value somewhere in between)
 
       compiler_stats_num_field('bytes allocated',
-          [(wordsize(32), 1565185140, 5),
+          [(wordsize(32), 1377050640, 5),
            # previous:     815479800  (x86/Linux)
            # (^ increase due to new codegen, see #7198)
            # 2012-10-08:  1373514844 (x86/Linux)
            # 2013-11-13: 1478325844  (x86/Windows, 64bit machine)
            # 2014-01-12: 1565185140  (x86/Linux)
-           (wordsize(64), 3083825616, 5)]),
+           # 2013-04-04: 1377050640  (x86/Windows, 64bit machine)
+           (wordsize(64), 2671595512, 5)]),
             # old:        1357587088 (amd64/Linux)
             # 29/08/2012: 2961778696 (amd64/Linux)
             # (^ increase due to new codegen, see #7198)
             # 18/09/2012: 2717327208 (amd64/Linux)
-            # 08/06/2013: 2901451552 (amd64/Linux)
-            # (^ reason unknown)
-            # 12/12/2013: 3083825616 (amd64/Linux)
-            # (^ reason unknown)
+            # 08/06/2013: 2901451552 (amd64/Linux) (reason unknown)
+            # 12/12/2013: 3083825616 (amd64/Linux) (reason unknown)
+            # 18/02/2014: 2897630040 (amd64/Linux) (call arity improvements)
+            # 12/03/2014: 2705289664 (amd64/Linux) (more call arity improvements)
+            # 2014-17-07: 2671595512 (amd64/Linux) (round-about update)
       conf_3294
       ],
      compile,
@@ -190,7 +195,7 @@ test('T4801',
              # 2013-02-10:  11207828 (x86/OSX)
              # (some date): 11139444
              # 2013-11-13:  11829000 (x86/Windows, 64bit machine)
-           (wordsize(64), 22646000, 10)]),
+           (wordsize(64), 25002136, 10)]),
                 # prev:       20486256 (amd64/OS X)
                 # 30/08/2012: 17305600--20391920 (varies a lot)
                 # 19/10/2012: 26882576 (-fPIC turned on)
@@ -198,6 +203,7 @@ test('T4801',
                 # 24/12/2012: 21657520 (perhaps gc sampling time wibbles?)
                 # 10/01/2014: 25166280 
                 # 13/01/2014: 22646000 (mostly due to #8647)
+                # 18/02/2014: 25002136 (call arity analysis changes)
        only_ways(['normal']),
        extra_hc_opts('-static')
       ],
@@ -211,7 +217,7 @@ test('T3064',
             # expected value: 14 (x86/Linux 28-06-2012):
             # 2013-11-13:     18 (x86/Windows, 64bit machine)
             # 2014-01-22:     23 (x86/Linux)
-           (wordsize(64), 37, 20)]),
+           (wordsize(64), 42, 20)]),
             # (amd64/Linux):            18
             # (amd64/Linux) 2012-02-07: 26
             # (amd64/Linux) 2013-02-12: 23; increased range to 10%
@@ -227,20 +233,23 @@ test('T3064',
             # 2012-10-30: 111189536 (x86/Windows)
             # 2013-11-13: 146626504 (x86/Windows, 64bit machine)
             # 2014-01-22: 162457940 (x86/Linux)
-           (wordsize(64), 329795912, 5)]),
+           (wordsize(64), 332702112, 5)]),
             # (amd64/Linux) (28/06/2011):  73259544
             # (amd64/Linux) (07/02/2013): 224798696
             # (amd64/Linux) (02/08/2013): 236404384, increase from roles
             # (amd64/Linux) (11/09/2013): 290165632, increase from AMP warnings
             # (amd64/Linux) (22/11/2013): 308300448, GND via Coercible and counters for constraints solving
-	    # (amd64/Linux) (02/12/2013): 329795912, Coercible refactor
+                # (amd64/Linux) (02/12/2013): 329795912, Coercible refactor
+            # (amd64/Linux) (11/02/2014): 308422280, optimize Coercions in simpleOptExpr
+            # (amd64/Linux) (23/05/2014): 324022680, unknown cause
+            # (amd64/Linux) (2014-07-17): 332702112, general round of updates
 
       compiler_stats_num_field('max_bytes_used',
-          [(wordsize(32), 7218200 , 20),
-            # 2011-06-28: 2247016 (x86/Linux) (28/6/2011):
-            #(some date): 5511604
-            # 2013-11-13: 7218200 (x86/Windows, 64bit machine)
-      
+          [(wordsize(32), 11202304, 20),
+            # 2011-06-28:  2247016 (x86/Linux) (28/6/2011):
+            #(some date):  5511604
+            # 2013-11-13:  7218200 (x86/Windows, 64bit machine)
+            # 2014-04-04: 11202304 (x86/Windows, 64bit machine)
            (wordsize(64), 19821544, 20)]),
             # (amd64/Linux, intree) (28/06/2011):  4032024
             # (amd64/Linux, intree) (07/02/2013):  9819288
@@ -268,7 +277,7 @@ test('T5030',
            # previous:    196457520
            # 2012-10-08:  259547660 (x86/Linux, new codegen)
            # 2013-11-21:  198573456 (x86 Windows, 64 bit machine)
-           (wordsize(64), 397672152, 10)]),
+           (wordsize(64), 409314320, 10)]),
              # Previously 530000000 (+/- 10%)
              # 17/1/13:   602993184  (x86_64/Linux)
              #            (new demand analyser)
@@ -278,6 +287,8 @@ test('T5030',
              # decrease from more aggressive coercion optimisations from roles
              # 2013-11-12 397672152  (amd64/Linux)
              # big decrease following better CSE and arity
+             # 2014-07-17 409314320  (amd64/Linux)
+             # general round of updates
 
        only_ways(['normal'])
       ],
@@ -286,11 +297,13 @@ test('T5030',
 
 test('T5631',
      [compiler_stats_num_field('bytes allocated',
-          [(wordsize(32), 392904228, 10),
+          [(wordsize(32), 346389856, 10),
         # expected value: 392904228 (x86/Linux)
-           (wordsize(64), 735486328, 5)]),
+        # 2014-04-04:     346389856 (x86 Windows, 64 bit machine)
+           (wordsize(64), 690742040, 5)]),
         # expected value: 774595008 (amd64/Linux):
         # expected value: 735486328 (amd64/Linux) 2012/12/12:
+        # expected value: 690742040 (amd64/Linux) Call Arity improvements
        only_ways(['normal'])
       ],
      compile,
@@ -310,11 +323,12 @@ test('T783',
      [ only_ways(['normal']),  # no optimisation for this one
       # expected value: 175,569,928 (x86/Linux)
       compiler_stats_num_field('bytes allocated',
-          [(wordsize(32), 333833658, 2),
+          [(wordsize(32), 319179104, 5),
             # 2012-10-08: 226907420 (x86/Linux)
             # 2013-02-10: 329202116 (x86/Windows)
             # 2013-02-10: 338465200 (x86/OSX)
-           (wordsize(64), 654804144, 10)]),
+            # 2014-04-04: 319179104 (x86 Windows, 64 bit machine)
+           (wordsize(64), 640031840, 10)]),
             # prev:       349263216 (amd64/Linux)
             # 07/08/2012: 384479856 (amd64/Linux)
             # 29/08/2012: 436927840 (amd64/Linux)
@@ -325,6 +339,8 @@ test('T783',
             #   (fix for #8456)
             # 24/10/2013: 654804144 (amd64/Linux)
             #   (fix previous fix for #8456)
+            # 2014-07-17: 640031840 (amd64/Linux)
+            #   (general round of updates)
       extra_hc_opts('-static')
       ],
       compile,[''])
@@ -350,11 +366,13 @@ test('T5321Fun',
 test('T5321FD',
      [ only_ways(['normal']),  # no optimisation for this one
       compiler_stats_num_field('bytes allocated',
-          [(wordsize(32), 240302920, 10),
+          [(wordsize(32), 211699816, 10),
             # prev:       213380256
             # 2012-10-08: 240302920 (x86/Linux)
             #  (increase due to new codegen)
-           (wordsize(64), 476497048, 10)])
+            # 2014-07-31: 211699816 (Windows) (-11%)
+            #  (due to better optCoercion, 5e7406d9, #9233)
+           (wordsize(64), 426960992, 10)])
             # prev:       418306336
             # 29/08/2012: 492905640
             #  (increase due to new codegen)
@@ -362,6 +380,10 @@ test('T5321FD',
             #  (reason for decrease unknown)
             # 08/06/2013: 476497048
             #  (reason for increase unknown)
+            # before 2014-07-17: 441997096
+            #  (with -8%, still in range, hence cause not known)
+            # 2014-07-17: 426960992 (-11% of previous value)
+            #  (due to better optCoercion, 5e7406d9, #9233)
       ],
       compile,[''])
 
@@ -370,7 +392,10 @@ test('T5642',
        compiler_stats_num_field('bytes allocated',
            [(wordsize(32), 650000000, 10),
                      # sample from x86/Linux
-            (wordsize(64), 1300000000, 10)])
+            (wordsize(64), 1402242360, 10)])
+            # prev:        1300000000
+            # 2014-07-17:  1358833928 (general round of updates)
+            # 2014-08-07:  1402242360 (caused by 1fc60ea)
       ],
       compile,['-O'])
 
@@ -385,19 +410,36 @@ test('T5837',
              # 2012-10-02 81879216
              # 2012-09-20 87254264 amd64/Linux
              # 2013-09-18 90587232 amd64/Linux
-	     # 2013-11-21 86795752 amd64/Linux, GND via Coercible and counters
-	     #                                  for constraints solving
+             # 2013-11-21 86795752 amd64/Linux, GND via Coercible and counters
+             #                                  for constraints solving
       ],
       compile_fail,['-ftype-function-depth=50'])
 
 test('T6048',
      [ only_ways(['optasm']),
       compiler_stats_num_field('bytes allocated',
-          [(wordsize(32), 48887164, 10),
+          [(wordsize(32), 62618072, 10),
             # prev:       38000000 (x86/Linux)
             # 2012-10-08: 48887164 (x86/Linux)
-           (wordsize(64), 108578664, 10)])
-             # 18/09/2012 97247032 amd64/Linux
-             # 16/01/2014 108578664 amd64/Linux (unknown)
+            # 2014-04-04: 62618072 (x86 Windows, 64 bit machine)
+           (wordsize(64), 125431448, 12)])
+             # 18/09/2012  97247032 amd64/Linux
+             # 16/01/2014 108578664 amd64/Linux (unknown, likely foldl-via-foldr)
+             # 18/01/2014  95960720 amd64/Linux Call Arity improvements
+             # 28/02/2014 105556793 amd64/Linux (unknown, tweak in base/4d9e7c9e3 resulted in change)
+             # 05/03/2014 110646312 amd64/Linux Call Arity became more elaborate
+             # 14/07/2014 125431448 amd64/Linux unknown reason. Even worse in GHC-7.8.3. *shurg*
+      ],
+      compile,[''])
+
+test('T9020',
+     [ only_ways(['optasm']),
+      compiler_stats_num_field('bytes allocated',
+          [(wordsize(32), 343005716, 10),
+           # Original:    381360728
+           # 2014-07-31:  343005716 (Windows) (general round of updates)
+           (wordsize(64), 728263536, 10)])
+           # prev:        795469104
+           # 2014-07-17:  728263536 (general round of updates)
       ],
       compile,[''])
diff --git a/testsuite/tests/perf/compiler/parsing001.stderr b/testsuite/tests/perf/compiler/parsing001.stderr
index fe5939628cbd..0f86f7f994db 100644
--- a/testsuite/tests/perf/compiler/parsing001.stderr
+++ b/testsuite/tests/perf/compiler/parsing001.stderr
@@ -1,4 +1,4 @@
 
 parsing001.hs:3:1:
-    Failed to load interface for ‛Wibble’
+    Failed to load interface for ‘Wibble’
     Use -v to see a list of the files searched for.
diff --git a/testsuite/tests/perf/compiler/simpl015.hs b/testsuite/tests/perf/compiler/simpl015.hs
new file mode 100644
index 000000000000..2ce70406be5e
--- /dev/null
+++ b/testsuite/tests/perf/compiler/simpl015.hs
@@ -0,0 +1,1683 @@
+-- Test for ticket #830, simplifier taking too long on large do expression
+
+main = do
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
+  return ()
diff --git a/testsuite/tests/perf/haddock/all.T b/testsuite/tests/perf/haddock/all.T
index 73ece18f63ad..1ef4fbc0d4ce 100644
--- a/testsuite/tests/perf/haddock/all.T
+++ b/testsuite/tests/perf/haddock/all.T
@@ -10,27 +10,30 @@ test('haddock.base',
           ,(platform('i386-unknown-mingw32'), 163, 10)
             # 2013-02-10:                     133 (x86/Windows)
             # 2013-11-13:                     163 (x86/Windows, 64bit machine)
-          ,(wordsize(32), 168, 1)])
+          ,(wordsize(32), 156, 1)])
             # 2012-08-14: 144 (x86/OSX)
             # 2012-10-30: 113 (x86/Windows)
             # 2013-02-10: 139 (x86/OSX)
             # 2014-01-22: 168 (x86/Linux - new haddock)
+            # 2014-06-29: 156 (x86/Linux)
      ,stats_num_field('max_bytes_used',
-          [(wordsize(64), 115113864, 10)
-            # 2012-08-14: 87374568 (amd64/Linux)
-            # 2012-08-21: 86428216 (amd64/Linux)
-            # 2012-09-20: 84794136 (amd64/Linux)
-            # 2012-11-12: 87265136 (amd64/Linux)
-            # 2013-01-29: 96022312 (amd64/Linux)
+          [(wordsize(64), 127954488, 10)
+            # 2012-08-14:  87374568 (amd64/Linux)
+            # 2012-08-21:  86428216 (amd64/Linux)
+            # 2012-09-20:  84794136 (amd64/Linux)
+            # 2012-11-12:  87265136 (amd64/Linux)
+            # 2013-01-29:  96022312 (amd64/Linux)
             # 2013-10-18: 115113864 (amd64/Linux)
+	    # 2014-07-31: 127954488 (amd64/Linux), correlates with 1ae5fa45
           ,(platform('i386-unknown-mingw32'), 58557136, 10)
             # 2013-02-10:                     47988488 (x86/Windows)
             # 2013-11-13:                     58557136 (x86/Windows, 64bit machine)
-          ,(wordsize(32), 62189068, 1)])
+          ,(wordsize(32), 58243640, 1)])
             # 2013-02-10: 52237984 (x86/OSX)
             # 2014-01-22: 62189068 (x86/Linux)
+            # 2014-06-29: 58243640 (x86/Linux)
      ,stats_num_field('bytes allocated',
-          [(wordsize(64), 7128342344,  5)
+          [(wordsize(64), 7946284944,  5)
             # 2012-08-14: 5920822352 (amd64/Linux)
             # 2012-09-20: 5829972376 (amd64/Linux)
             # 2012-10-08: 5902601224 (amd64/Linux)
@@ -40,14 +43,21 @@ test('haddock.base',
             # 2013-09-18: 6294339840 (x86_64/Linux)
             # 2013-11-21: 6756213256 (x86_64/Linux)
             # 2014-01-12: 7128342344 (x86_64/Linux)
-          ,(platform('i386-unknown-mingw32'), 3097751052, 1)
+            # 2014-06-12: 7498123680 (x86_64/Linux)
+            # 2014-08-05: 7992757384 (x86_64/Linux - bugfix for #314, Haddock now parses more URLs)
+            # 2014-08-08: 7946284944 (x86_64/Linux - Haddock updates to attoparsec-0.12.1.0)
+          ,(platform('i386-unknown-mingw32'), 3548581572, 5)
             # 2013-02-10:                     3358693084 (x86/Windows)
             # 2013-11-13:                     3097751052 (x86/Windows, 64bit machine)
-          ,(wordsize(32), 3554624600, 1)])
+            # 2014-04-04:                     3548581572 (x86/Windows, 64bit machine)
+            # 2014-08-05: XXX TODO UPDATE ME XXX
+          ,(wordsize(32), 3799130400, 1)])
             # 2012-08-14: 3046487920 (x86/OSX)
             # 2012-10-30: 2955470952 (x86/Windows)
             # 2013-02-10: 3146596848 (x86/OSX)
             # 2014-02-22: 3554624600 (x86/Linux - new haddock)
+            # 2014-06-29: 3799130400 (x86/Linux)
+            # 2014-08-05: XXX TODO UPDATE ME XXX
       ],
      stats,
      ['../../../../libraries/base/dist-install/doc/html/base/base.haddock.t'])
@@ -55,7 +65,7 @@ test('haddock.base',
 test('haddock.Cabal',
      [unless(in_tree_compiler(), skip)
      ,stats_num_field('peak_megabytes_allocated',
-          [(wordsize(64), 278, 10)
+          [(wordsize(64), 309, 10)
             # 2012-08-14: 202 (amd64/Linux)
             # 2012-08-29: 211 (amd64/Linux, new codegen)
             # 2012-09-20: 227 (amd64/Linux)
@@ -63,30 +73,37 @@ test('haddock.Cabal',
             # 2013-06-07: 246 (amd64/Linux) (reason unknown)
             # 2013-11-21: 269
             # 2013-11-22: 278 (amd64/Linux) (TH refactoring; weird)
-          ,(platform('i386-unknown-mingw32'), 129, 1)
+	    # 2014-07-14: 309 (amd64/Linux)
+          ,(platform('i386-unknown-mingw32'), 144, 10)
             # 2012-10-30:                      83 (x86/Windows)
             # 2013-02-10:                     116 (x86/Windows)
-            # 2013-11-13:                     129(x86/Windows, 64bit machine)
-          ,(wordsize(32), 139, 1)])
+            # 2013-11-13:                     129 (x86/Windows, 64bit machine)
+            # 2014-01-28:                     136
+            # 2014-04-04:                     144
+          ,(wordsize(32), 147, 1)])
            # 2012-08-14: 116 (x86/OSX)
            # 2013-02-10:  89 (x86/Windows)
            # 2014-01-22: 139 (x86/Linux - new haddock, but out of date before)
+           # 2014-06-29: 147 (x86/Linux)
      ,stats_num_field('max_bytes_used',
-          [(wordsize(64), 95356616, 15)
-            # 2012-08-14: 74119424 (amd64/Linux)
-            # 2012-08-29: 77992512 (amd64/Linux, new codegen)
-            # 2012-10-02: 91341568 (amd64/Linux)
-            # 2012-10-08: 80590280 (amd64/Linux)
-            # 2013-03-13: 95356616 (amd64/Linux) Cabal updated
-          ,(platform('i386-unknown-mingw32'), 49391436, 15)
+          [(wordsize(64), 113232208, 15)
+            # 2012-08-14:  74119424 (amd64/Linux)
+            # 2012-08-29:  77992512 (amd64/Linux, new codegen)
+            # 2012-10-02:  91341568 (amd64/Linux)
+            # 2012-10-08:  80590280 (amd64/Linux)
+            # 2013-03-13:  95356616 (amd64/Linux) Cabal updated
+            # 2014-07-14: 113232208 (amd64/Linux)
+          ,(platform('i386-unknown-mingw32'), 63493200, 15)
             # 2012-10-30: 44224896 (x86/Windows)
             # 2013-11-13: 49391436 (x86/Windows, 64bit machine)
-          ,(wordsize(32), 52718512, 1)])
+            # 2014-04-04: 63493200 (x86/Windows, 64bit machine)
+          ,(wordsize(32), 66411508, 1)])
             # 2012-08-14: 47461532 (x86/OSX)
             # 2013-02-10: 46563344 (x86/OSX)
             # 2014-01-22: 52718512 (x86/Linux)
+            # 2014-06-29: 66411508 (x86/Linux)
      ,stats_num_field('bytes allocated',
-          [(wordsize(64), 3979151552, 5)
+          [(wordsize(64), 4493770224, 5)
             # 2012-08-14: 3255435248 (amd64/Linux)
             # 2012-08-29: 3324606664 (amd64/Linux, new codegen)
             # 2012-10-08: 3373401360 (amd64/Linux)
@@ -97,12 +114,19 @@ test('haddock.Cabal',
             # 2013-11-21: 3908586784 (amd64/Linux) Cabal updated
             # 2013-12-12: 3828567272 (amd64/Linux)
             # 2014-01-12: 3979151552 (amd64/Linux) new parser
-          ,(platform('i386-unknown-mingw32'), 1906532680, 1)
+            # 2014-06-29: 4200993768 (amd64/Linux)
+            # 2014-08-05: 4493770224 (x86_64/Linux - bugfix for #314, Haddock now parses more URLs)
+          ,(platform('i386-unknown-mingw32'), 2052220292, 5)
             # 2012-10-30:                     1733638168 (x86/Windows)
             # 2013-02-10:                     1906532680 (x86/Windows)
-          ,(wordsize(32), 1986290624, 1)])
+            # 2014-01-28:                     1966911336 (x86/Windows)
+            # 2014-04-24:                     2052220292 (x86/Windows)
+            # 2014-08-05: XXX TODO UPDATE ME XXX
+          ,(wordsize(32), 2127198484, 1)])
             # 2012-08-14: 1648610180 (x86/OSX)
             # 2014-01-22: 1986290624 (x86/Linux)
+            # 2014-06-29: 2127198484 (x86/Linux)
+            # 2014-08-05: XXX TODO UPDATE ME XXX
       ],
      stats,
      ['../../../../libraries/Cabal/Cabal/dist-install/doc/html/Cabal/Cabal.haddock.t'])
@@ -122,10 +146,11 @@ test('haddock.compiler',
             # 2012-10-30:                     606 (x86/Windows)
             # 2013-02-10:                     653 (x86/Windows)
             # 2013-11-13:                     735 (x86/Windows, 64bit machine)
-          ,(wordsize(32), 727, 1)])
+          ,(wordsize(32), 771, 1)])
             # 2012-08-14: 631 (x86/OSX)
             # 2013-02-10: 663 (x86/OSX)
             # 2014-01-22: 727 (x86/Linux - new haddock, but out of date before)
+            # 2014-06-29: 771 (x86/Linux)
      ,stats_num_field('max_bytes_used',
           [(wordsize(64), 541926264, 10)
             # 2012-08-14: 428775544 (amd64/Linux)
@@ -135,28 +160,33 @@ test('haddock.compiler',
             # 2013-06-08: 477593712 (amd64/Linux) (reason unknown)
             # 2013-11-21: 502920176 (amd64/Linux)
             # 2013-11-22: 541926264 (amd64/Linux) (TH refactoring; weird)
-          ,(platform('i386-unknown-mingw32'), 269147084, 1)
+          ,(platform('i386-unknown-mingw32'), 278706344, 10)
             # 2012-10-30:                     220847924 (x86/Windows)
             # 2013-02-10:                     238529512 (x86/Windows)
-            # 2013-11-13:                     269147084  (x86/Windows, 64bit machine)
-          ,(wordsize(32), 278124612, 1)])
+            # 2013-11-13:                     269147084 (x86/Windows, 64bit machine)
+            # 2014-01-28:                     283814088 (x86/Windows)
+            # 2014-04-04:                     278706344 (x86/Windows)
+          ,(wordsize(32), 284082916, 1)])
             # 2012-08-14: 231064920 (x86/OSX)
             # 2013-02-10: 241785276 (x86/Windows)
             # 2014-01-22: 278124612 (x86/Linux - new haddock)
+            # 2014-06-29: 284082916 (x86/Linux)
      ,stats_num_field('bytes allocated',
-          [(wordsize(64), 28708374824, 10)
+          [(wordsize(64), 29809571376, 10)
             # 2012-08-14: 26070600504 (amd64/Linux)
             # 2012-08-29: 26353100288 (amd64/Linux, new CG)
             # 2012-09-18: 26882813032 (amd64/Linux)
             # 2012-11-12: 25990254632 (amd64/Linux)
+            # 2014-07-17: 29809571376 (amd64/Linux) general round of updates
 	    # 2012-11-27: 28708374824 (amd64/Linux)
           ,(platform('i386-unknown-mingw32'), 14328363592, 10)
             # 2012-10-30:                     13773051312 (x86/Windows)
             # 2013-02-10:                     14925262356 (x86/Windows)
             # 2013-11-13:                     14328363592 (x86/Windows, 64bit machine)
-          ,(wordsize(32), 14581475024, 1)])
+          ,(wordsize(32), 15110426000, 1)])
             # 2012-08-14: 13471797488 (x86/OSX)
             # 2014-01-22: 14581475024 (x86/Linux - new haddock)
+            # 2014-06-29: 15110426000 (x86/Linux)
       ],
      stats,
      ['../../../../compiler/stage2/doc/html/ghc/ghc.haddock.t'])
diff --git a/testsuite/tests/perf/should_run/InlineArrayAlloc.hs b/testsuite/tests/perf/should_run/InlineArrayAlloc.hs
new file mode 100644
index 000000000000..09f3e405864f
--- /dev/null
+++ b/testsuite/tests/perf/should_run/InlineArrayAlloc.hs
@@ -0,0 +1,16 @@
+{-# LANGUAGE BangPatterns, MagicHash, UnboxedTuples #-}
+module Main where
+
+import GHC.Exts
+import GHC.IO
+
+main :: IO ()
+main = loop 10000000
+  where
+    loop :: Int -> IO ()
+    loop 0 = return ()
+    loop i = newArray >> loop (i-1)
+
+newArray :: IO ()
+newArray = IO $ \s -> case newArray# 16# () s of
+    (# s', _ #) -> (# s', () #)
diff --git a/testsuite/tests/perf/should_run/InlineByteArrayAlloc.hs b/testsuite/tests/perf/should_run/InlineByteArrayAlloc.hs
new file mode 100644
index 000000000000..fa4883fa5874
--- /dev/null
+++ b/testsuite/tests/perf/should_run/InlineByteArrayAlloc.hs
@@ -0,0 +1,16 @@
+{-# LANGUAGE MagicHash, UnboxedTuples #-}
+module Main where
+
+import GHC.Exts
+import GHC.IO
+
+main :: IO ()
+main = loop 10000000
+  where
+    loop :: Int -> IO ()
+    loop 0 = return ()
+    loop i = newByteArray >> loop (i-1)
+
+newByteArray :: IO ()
+newByteArray = IO $ \s -> case newByteArray# 128# s of
+    (# s', _ #) -> (# s', () #)
diff --git a/testsuite/tests/perf/should_run/InlineCloneArrayAlloc.hs b/testsuite/tests/perf/should_run/InlineCloneArrayAlloc.hs
new file mode 100644
index 000000000000..54243fe79335
--- /dev/null
+++ b/testsuite/tests/perf/should_run/InlineCloneArrayAlloc.hs
@@ -0,0 +1,24 @@
+{-# LANGUAGE MagicHash, UnboxedTuples #-}
+module Main where
+
+import GHC.Exts
+import GHC.IO
+
+main :: IO ()
+main = do
+    marr <- newArray
+    loop 10000000 (unMArray marr)
+  where
+    loop :: Int -> MutableArray# RealWorld () -> IO ()
+    loop 0 _    = return ()
+    loop i marr = freezeArray marr >> loop (i-1) marr
+
+data MArray = MArray { unMArray :: !(MutableArray# RealWorld ()) }
+
+newArray :: IO MArray
+newArray = IO $ \s -> case newArray# 16# () s of
+    (# s', marr# #) -> (# s', MArray marr# #)
+
+freezeArray :: MutableArray# RealWorld () -> IO ()
+freezeArray marr# = IO $ \s -> case freezeArray# marr# 0# 16# s of
+    (# s', _ #) -> (# s', () #)
diff --git a/testsuite/tests/perf/should_run/T149_A.hs b/testsuite/tests/perf/should_run/T149_A.hs
index dd745460c058..22ec276ebca7 100644
--- a/testsuite/tests/perf/should_run/T149_A.hs
+++ b/testsuite/tests/perf/should_run/T149_A.hs
@@ -2,7 +2,7 @@ module Main (main) where
 
 -- See Trac #149
 
--- Curently (with GHC 7.0) the CSE works, just,
+-- Currently (with GHC 7.0) the CSE works, just,
 -- but it's delicate.
 
 
@@ -21,5 +21,5 @@ playerMostOccur1 (x:xs)
  | otherwise = playerMostOccur1 xs
 
 numOccur :: Int -> [Int] -> Int
-numOccur i is = length $ filter (i ==) is
+numOccur i is = length is
 
diff --git a/testsuite/tests/perf/should_run/T149_B.hs b/testsuite/tests/perf/should_run/T149_B.hs
index fcc87cdf55cc..514fd16a9ca5 100644
--- a/testsuite/tests/perf/should_run/T149_B.hs
+++ b/testsuite/tests/perf/should_run/T149_B.hs
@@ -2,7 +2,7 @@ module Main (main) where
 
 -- See Trac #149
 
--- Curently (with GHC 7.0) the CSE works, just,
+-- Currently (with GHC 7.0) the CSE works, just,
 -- but it's delicate.
 
 
@@ -22,5 +22,5 @@ playerMostOccur2 (x:xs)
     where pmo = playerMostOccur2 xs
 
 numOccur :: Int -> [Int] -> Int
-numOccur i is = length $ filter (i ==) is
+numOccur i is = length is
 
diff --git a/testsuite/tests/perf/should_run/T2902_A.hs b/testsuite/tests/perf/should_run/T2902_A.hs
index c0939104f3ca..cb2cec990c0f 100644
--- a/testsuite/tests/perf/should_run/T2902_A.hs
+++ b/testsuite/tests/perf/should_run/T2902_A.hs
@@ -1,5 +1,5 @@
 
-{-# LANGUAGE UnicodeSyntax #-}
+{-# LANGUAGE UnicodeSyntax, FlexibleContexts #-}
 
 module Main (main) where
 
diff --git a/testsuite/tests/perf/should_run/T2902_B.hs b/testsuite/tests/perf/should_run/T2902_B.hs
index c6558c625b0b..65cb1a6a900c 100644
--- a/testsuite/tests/perf/should_run/T2902_B.hs
+++ b/testsuite/tests/perf/should_run/T2902_B.hs
@@ -1,5 +1,5 @@
 
-{-# LANGUAGE UnicodeSyntax #-}
+{-# LANGUAGE UnicodeSyntax, FlexibleContexts #-}
 
 module Main (main) where
 
diff --git a/testsuite/tests/perf/should_run/T5113.hs b/testsuite/tests/perf/should_run/T5113.hs
index e87bcb6cade2..6ad6750aab4f 100644
--- a/testsuite/tests/perf/should_run/T5113.hs
+++ b/testsuite/tests/perf/should_run/T5113.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE BangPatterns, FlexibleContexts #-}
 module Main where
 
 import Data.Array.Base (unsafeRead, unsafeWrite)
diff --git a/testsuite/tests/perf/should_run/T9203.hs b/testsuite/tests/perf/should_run/T9203.hs
new file mode 100644
index 000000000000..500fd8c98e61
--- /dev/null
+++ b/testsuite/tests/perf/should_run/T9203.hs
@@ -0,0 +1,9 @@
+module Main where
+
+import Data.Typeable
+
+f :: Typeable a => Int -> a -> TypeRep
+f 0 a = typeOf a
+f n a = f (n-1) [a]
+
+main = print (f 50000 () == f 50001 ())
diff --git a/testsuite/tests/perf/should_run/T9203.stdout b/testsuite/tests/perf/should_run/T9203.stdout
new file mode 100644
index 000000000000..bc59c12aa16b
--- /dev/null
+++ b/testsuite/tests/perf/should_run/T9203.stdout
@@ -0,0 +1 @@
+False
diff --git a/testsuite/tests/perf/should_run/T9339.hs b/testsuite/tests/perf/should_run/T9339.hs
new file mode 100644
index 000000000000..96f5f7201a6c
--- /dev/null
+++ b/testsuite/tests/perf/should_run/T9339.hs
@@ -0,0 +1,4 @@
+-- Tests that `last` successfully fuses.
+
+main :: IO ()
+main = print $ last $ filter odd $ [1::Int ..10000000]
diff --git a/testsuite/tests/perf/should_run/T9339.stdout b/testsuite/tests/perf/should_run/T9339.stdout
new file mode 100644
index 000000000000..e161ae369454
--- /dev/null
+++ b/testsuite/tests/perf/should_run/T9339.stdout
@@ -0,0 +1 @@
+9999999
diff --git a/testsuite/tests/perf/should_run/all.T b/testsuite/tests/perf/should_run/all.T
index 0d951fc919df..8b8547eae942 100644
--- a/testsuite/tests/perf/should_run/all.T
+++ b/testsuite/tests/perf/should_run/all.T
@@ -6,8 +6,9 @@
 test('T3586',
      [stats_num_field('peak_megabytes_allocated', (17, 1)),
                                  # expected value: 17 (amd64/Linux)
-      stats_num_field('bytes allocated', (16835544, 5)),
-                        # expected value: 16835544 (amd64/Linux)
+      stats_num_field('bytes allocated', (16102024, 5)),
+                        # prev:           16835544 (amd64/Linux)
+                        # 2014-07-17:     16102024 (amd64/Linux), general round of updates
       only_ways(['normal'])
       ],
      compile_and_run,
@@ -19,9 +20,11 @@ test('T4830',
            #             127000 (amd64/Linux)
            # 2013-02-07:  99264 (amd64/Linux)
            # 2014-01-13:  98248 (amd64/Linux) due to #8647
-           (wordsize(32), 70646, 2)]),
+           (wordsize(32), 70646, 3)]),
            # 2013-02-10:  69744 (x86/Windows)
            # 2013-02-10:  71548 (x86/OSX)
+           # 2014-01-28:  Widen range 2->3
+           #                (x86/Windows - actual 69000, lower was 69233)
       only_ways(['normal'])
       ],
      compile_and_run,
@@ -40,10 +43,11 @@ test('lazy-bs-alloc',
             #             489776 (amd64/Linux)
             # 2013-02-07: 429744 (amd64/Linux)
             # 2013-12-12: 425400 (amd64/Linux)
-           (wordsize(32), 411500, 1)]),
+           (wordsize(32), 411500, 2)]),
             # 2013-02-10: 421296 (x86/Windows)
             # 2013-02-10: 414180 (x86/OSX)
             # 2014-01-22: 411500 (x86/Linux)
+            # 2014-01-28: Widen 1->2% (x86/Windows was at 425212)
       only_ways(['normal']),
       extra_run_opts('../../numeric/should_run/arith011.stdout'),
       ignore_output
@@ -54,9 +58,13 @@ test('lazy-bs-alloc',
 
 test('T876',
      [stats_num_field('bytes allocated',
-          [(wordsize(64), 1263712 , 5),
+          [(wordsize(64), 63216 , 5),
               # 2013-02-14: 1263712 (x86_64/Linux)
-           (wordsize(32), 663712, 5)]),
+              # 2014-02-10:   63216 (x86_64/Linux), call arity analysis
+           (wordsize(32), 53024, 5) ]),
+              # some date:  663712  (Windows, 64-bit machine)
+              # 2014-04-04:  56820  (Windows, 64-bit machine)
+              # 2014-06-29:  53024  (x86_64/Linux)
       only_ways(['normal']),
       extra_run_opts('10000')
       ],
@@ -83,9 +91,10 @@ test('T3738',
                                  # expected value: 1 (amd64/Linux)
       stats_num_field('bytes allocated',
                       [(wordsize(32), 45648, 5),
-                    # expected value: 45648 (x86/Linux)
+                    # expected value: 50520 (x86/Linux)
                        (wordsize(64), 49400, 5)]),
-                    # expected value: 49400 (amd64/Linux)
+                    # prev:           49400 (amd64/Linux)
+                    # 2014-07-17:     50520 (amd64/Linux) general round of updates
       only_ways(['normal'])
       ],
      compile_and_run,
@@ -147,8 +156,9 @@ test('T5205',
      [stats_num_field('bytes allocated',
                       [(wordsize(32), 47088, 5),
                     # expected value: 47088 (x86/Darwin)
-                       (wordsize(64), 51320, 5)]),
+                       (wordsize(64), 52600, 5)]),
                     # expected value: 51320 (amd64/Linux)
+                    # 2014-07-17:     52600 (amd64/Linux) general round of updates
       only_ways(['normal', 'optasm'])
       ],
      compile_and_run,
@@ -195,7 +205,8 @@ test('T4474c',
 
 test('T5237',
      [stats_num_field('bytes allocated',
-                        [(wordsize(32), 78328, 5),
+                        [(platform('i386-unknown-mingw32'), 73280, 5),
+                         (wordsize(32), 78328, 5),
                       # expected value: 78328 (i386/Linux)
                          (wordsize(64), 104176, 5)]),
                       # expected value: 110888 (amd64/Linux)
@@ -240,13 +251,14 @@ test('T7257',
 
 test('Conversions',
      [stats_num_field('bytes allocated',
-                      [(wordsize(32), 76768, 2),
+                      [(wordsize(32), 76768, 3),
                         # 2012-12-18: 55316 Guessed 64-bit value / 2
                         # 2013-02-10: 77472 (x86/OSX)
                         # 2013-02-10: 79276 (x86/Windows)
                         # 2014-01-13: 76768 (x86/Linux) due to #8647
-                       (wordsize(64), 110632, 5)]),
+                       (wordsize(64), 107544, 5)]),
                         # 2012-12-18: 109608 (amd64/OS X)
+                        # 2014-07-17: 107544 (amd64/Linux)
 
       only_ways(['normal'])
      ],
@@ -284,8 +296,11 @@ test('T7797',
 
 test('T7954',
       [stats_num_field('bytes allocated',
-                      [(wordsize(32), 1380051408, 10),
-                       (wordsize(64), 2720051528, 10)]),
+                      [(wordsize(32), 920045264, 10),
+              # some date:  1380051408    (64-bit Windows machine)
+              # 2014-04-04:  920045264    (64-bit Windows machine)
+                       (wordsize(64), 1680051336, 10)]),
+              # 2014-02-10: 1680051336 (x86_64/Linux), call arity analysis
       only_ways(['normal'])
       ],
      compile_and_run,
@@ -301,7 +316,8 @@ test('T7850',
 
 test('T5949',
      [stats_num_field('bytes allocated',
-                      [ (wordsize(64), 201008, 10)]),
+                      [ (wordsize(32), 116020, 10),
+                        (wordsize(64), 201008, 10)]),
                       # previously, it was >400000 bytes
       only_ways(['normal'])],
      compile_and_run,
@@ -309,17 +325,66 @@ test('T5949',
 
 test('T4267',
      [stats_num_field('bytes allocated',
-                      [ (wordsize(64), 130000, 10)]),
+                      [ (wordsize(32), 36012, 10)
+                      # 32-bit value close to 64 bit; c.f. T7619
+                      , (wordsize(64), 40992, 10) ]),
                       # previously, it was >170000 bytes
+                      # 2014-01-17: 130000
+                      # 2014-02-10: 40992 (x86_64/Linux), call arity analysis
       only_ways(['normal'])],
      compile_and_run,
      ['-O'])
 
 test('T7619',
      [stats_num_field('bytes allocated',
-                      [ (wordsize(64), 40992, 10)]),
+                      [ (wordsize(32), 36012, 10)
+                      # 32-bit close to 64-bit value; most of this very 
+                      # small number is standard start-up boilerplate I think
+                      , (wordsize(64), 40992, 10) ]),
                       # previously, it was >400000 bytes
       only_ways(['normal'])],
      compile_and_run,
      ['-O'])
 
+test('InlineArrayAlloc',
+     [stats_num_field('bytes allocated',
+                      [ (wordsize(32), 800040960, 5)
+                      , (wordsize(64), 1600040960, 5) ]),
+      only_ways(['normal'])],
+     compile_and_run,
+     ['-O2'])
+
+test('InlineByteArrayAlloc',
+     [stats_num_field('bytes allocated',
+                      [ (wordsize(32), 1360036012, 5)
+                      , (wordsize(64), 1440040960, 5) ]),
+         # 32 and 64 bit not so different, because 
+         # we are allocating *byte* arrays
+      only_ways(['normal'])],
+     compile_and_run,
+     ['-O2'])
+
+test('InlineCloneArrayAlloc',
+     [stats_num_field('bytes allocated',
+                      [ (wordsize(32), 800041120, 5) 
+                      , (wordsize(64), 1600041120, 5) ]),
+      only_ways(['normal'])],
+     compile_and_run,
+     ['-O2'])
+
+test('T9203',
+     [stats_num_field('bytes allocated',
+                      [ (wordsize(32), 50000000, 5)
+                      , (wordsize(64), 95747304, 5) ]),
+      only_ways(['normal'])],
+     compile_and_run,
+     ['-O2'])
+
+test('T9339',
+     [stats_num_field('bytes allocated',
+                      [ (wordsize(64),    80050760, 5) ]),
+                      # w/o fusing last: 320005080
+                      # 2014-07-22:       80050760
+      only_ways(['normal'])],
+     compile_and_run,
+     ['-O2'])
diff --git a/testsuite/tests/plugins/plugins02.stderr b/testsuite/tests/plugins/plugins02.stderr
index 2fee69361e98..185d13be9a2e 100644
--- a/testsuite/tests/plugins/plugins02.stderr
+++ b/testsuite/tests/plugins/plugins02.stderr
@@ -1 +1 @@
-<command line>: The value Simple.BadlyTypedPlugin.plugin did not have the type CoreMonad.Plugin as required
+<command line>: The value plugin did not have the type Plugin as required
diff --git a/testsuite/tests/plugins/plugins03.stderr b/testsuite/tests/plugins/plugins03.stderr
index 24feee818b0d..e04d80cb8789 100644
--- a/testsuite/tests/plugins/plugins03.stderr
+++ b/testsuite/tests/plugins/plugins03.stderr
@@ -1,2 +1,2 @@
-<command line>: Could not find module ‛Simple.NonExistantPlugin’
+<command line>: Could not find module ‘Simple.NonExistantPlugin’
 Use -v to see a list of the files searched for.
diff --git a/testsuite/tests/plugins/plugins04.stderr b/testsuite/tests/plugins/plugins04.stderr
index 13f94e439215..f0acc67d22e0 100644
--- a/testsuite/tests/plugins/plugins04.stderr
+++ b/testsuite/tests/plugins/plugins04.stderr
@@ -1,2 +1,2 @@
 Module imports form a cycle:
-  module ‛HomePackagePlugin’ (./HomePackagePlugin.hs) imports itself
+  module ‘HomePackagePlugin’ (./HomePackagePlugin.hs) imports itself
diff --git a/testsuite/tests/polykinds/Makefile b/testsuite/tests/polykinds/Makefile
index aa8b482b7397..8636bb959fd1 100644
--- a/testsuite/tests/polykinds/Makefile
+++ b/testsuite/tests/polykinds/Makefile
@@ -38,3 +38,9 @@ T8449:
 	$(RM) -f T8449.hi T8449.o T8449a.hi T8449a.o
 	'$(TEST_HC)' $(TEST_HC_OPTS) -c T8449a.hs
 	'$(TEST_HC)' $(TEST_HC_OPTS) -c T8449.hs
+
+T9263:
+	$(RM) -f T9263.hi T9263.o T9263a.hi T9263a.o T9263b.hi T9263b.o
+	'$(TEST_HC)' $(TEST_HC_OPTS) -c T9263b.hs
+	'$(TEST_HC)' $(TEST_HC_OPTS) -c T9263a.hs
+	'$(TEST_HC)' $(TEST_HC_OPTS) -c T9263.hs
diff --git a/testsuite/tests/polykinds/PolyKinds02.stderr b/testsuite/tests/polykinds/PolyKinds02.stderr
index 8fd49c815814..ab646d81c7bd 100644
--- a/testsuite/tests/polykinds/PolyKinds02.stderr
+++ b/testsuite/tests/polykinds/PolyKinds02.stderr
@@ -1,5 +1,5 @@
 
 PolyKinds02.hs:13:16:
-    The second argument of ‛Vec’ should have kind ‛Nat’,
-      but ‛Nat’ has kind ‛*’
-    In the type signature for ‛vec’: vec :: Vec Nat Nat
+    The second argument of ‘Vec’ should have kind ‘Nat’,
+      but ‘Nat’ has kind ‘*’
+    In the type signature for ‘vec’: vec :: Vec Nat Nat
diff --git a/testsuite/tests/polykinds/PolyKinds04.stderr b/testsuite/tests/polykinds/PolyKinds04.stderr
index 1ffdf3910bfc..eaa4c079093a 100644
--- a/testsuite/tests/polykinds/PolyKinds04.stderr
+++ b/testsuite/tests/polykinds/PolyKinds04.stderr
@@ -1,8 +1,8 @@
 
 PolyKinds04.hs:5:16:
-    Expecting one more argument to ‛Maybe’
-    The first argument of ‛A’ should have kind ‛*’,
-      but ‛Maybe’ has kind ‛* -> *’
-    In the type ‛A Maybe’
-    In the definition of data constructor ‛B1’
-    In the data declaration for ‛B’
+    Expecting one more argument to ‘Maybe’
+    The first argument of ‘A’ should have kind ‘*’,
+      but ‘Maybe’ has kind ‘* -> *’
+    In the type ‘A Maybe’
+    In the definition of data constructor ‘B1’
+    In the data declaration for ‘B’
diff --git a/testsuite/tests/polykinds/PolyKinds06.stderr b/testsuite/tests/polykinds/PolyKinds06.stderr
index fc1700f31ff9..d6fa854c8f3b 100644
--- a/testsuite/tests/polykinds/PolyKinds06.stderr
+++ b/testsuite/tests/polykinds/PolyKinds06.stderr
@@ -1,5 +1,5 @@
 
 PolyKinds06.hs:9:11:
-    Type constructor ‛A’ cannot be used here
+    Type constructor ‘A’ cannot be used here
       (it is defined and used in the same recursive group)
-    In the kind ‛A -> *’
+    In the kind ‘A -> *’
diff --git a/testsuite/tests/polykinds/PolyKinds07.stderr b/testsuite/tests/polykinds/PolyKinds07.stderr
index 761f13aeb54d..6b1d6c137dfe 100644
--- a/testsuite/tests/polykinds/PolyKinds07.stderr
+++ b/testsuite/tests/polykinds/PolyKinds07.stderr
@@ -1,7 +1,7 @@
 
 PolyKinds07.hs:10:11:
-    Data constructor ‛A1’ cannot be used here
+    Data constructor ‘A1’ cannot be used here
       (it is defined and used in the same recursive group)
-    In the type ‛B A1’
-    In the definition of data constructor ‛B1’
-    In the data declaration for ‛B’
+    In the type ‘B A1’
+    In the definition of data constructor ‘B1’
+    In the data declaration for ‘B’
diff --git a/testsuite/tests/polykinds/T5716.stderr b/testsuite/tests/polykinds/T5716.stderr
index f32e604c2c3e..227a6b88c6b7 100644
--- a/testsuite/tests/polykinds/T5716.stderr
+++ b/testsuite/tests/polykinds/T5716.stderr
@@ -1,4 +1,4 @@
 
 T5716.hs:13:11:
-    ‛U’ of kind ‛*’ is not promotable
-    In the kind ‛U -> *’
+    ‘U’ of kind ‘*’ is not promotable
+    In the kind ‘U -> *’
diff --git a/testsuite/tests/polykinds/T5716a.stderr b/testsuite/tests/polykinds/T5716a.stderr
index e21d4466784d..5cee2edc2e18 100644
--- a/testsuite/tests/polykinds/T5716a.stderr
+++ b/testsuite/tests/polykinds/T5716a.stderr
@@ -1,7 +1,7 @@
 
 T5716a.hs:10:27:
-    Data constructor ‛Bar’ cannot be used here
+    Data constructor ‘Bar’ cannot be used here
       (it comes from a data family instance)
-    In the type ‛Bar a’
-    In the definition of data constructor ‛Bar’
-    In the data instance declaration for ‛DF’
+    In the type ‘Bar a’
+    In the definition of data constructor ‘Bar’
+    In the data instance declaration for ‘DF’
diff --git a/testsuite/tests/polykinds/T6021.stderr b/testsuite/tests/polykinds/T6021.stderr
index 706729113a61..ea3b9e3427ef 100644
--- a/testsuite/tests/polykinds/T6021.stderr
+++ b/testsuite/tests/polykinds/T6021.stderr
@@ -1,4 +1,4 @@
 
 T6021.hs:5:10:
-    Kind variable also used as type variable: ‛b’
+    Kind variable also used as type variable: ‘b’
     In an instance declaration
diff --git a/testsuite/tests/polykinds/T6039.stderr b/testsuite/tests/polykinds/T6039.stderr
index 20b947b861e6..def904ea3372 100644
--- a/testsuite/tests/polykinds/T6039.stderr
+++ b/testsuite/tests/polykinds/T6039.stderr
@@ -1,4 +1,4 @@
 
 T6039.hs:5:14:
-    Kind variable ‛j’ cannot appear in a function position
-    In the kind ‛j k’
+    Kind variable ‘j’ cannot appear in a function position
+    In the kind ‘j k’
diff --git a/testsuite/tests/polykinds/T6054.stderr b/testsuite/tests/polykinds/T6054.stderr
index c05dcd5935dd..645db8912f06 100644
--- a/testsuite/tests/polykinds/T6054.stderr
+++ b/testsuite/tests/polykinds/T6054.stderr
@@ -2,8 +2,8 @@
 T6054.hs:7:14:
     No instance for (Bar '() a0)
       arising from an expression type signature
-    In the first argument of ‛print’, namely
-      ‛(Proxy :: Bar () a => Proxy a)’
+    In the first argument of ‘print’, namely
+      ‘(Proxy :: Bar () a => Proxy a)’
     In the expression: print (Proxy :: Bar () a => Proxy a)
-    In an equation for ‛foo’:
+    In an equation for ‘foo’:
         foo = print (Proxy :: Bar () a => Proxy a)
diff --git a/testsuite/tests/polykinds/T6129.stderr b/testsuite/tests/polykinds/T6129.stderr
index 9b8d66f20240..36b749680b1e 100644
--- a/testsuite/tests/polykinds/T6129.stderr
+++ b/testsuite/tests/polykinds/T6129.stderr
@@ -1,7 +1,7 @@
 
 T6129.hs:12:11:
-    Data constructor ‛DInt’ cannot be used here
+    Data constructor ‘DInt’ cannot be used here
       (it comes from a data family instance)
-    In the type ‛X DInt’
-    In the definition of data constructor ‛X1’
-    In the data declaration for ‛X’
+    In the type ‘X DInt’
+    In the definition of data constructor ‘X1’
+    In the data declaration for ‘X’
diff --git a/testsuite/tests/polykinds/T7053.hs b/testsuite/tests/polykinds/T7053.hs
index 4db1e0d7e9d4..d45dbadaee3f 100644
--- a/testsuite/tests/polykinds/T7053.hs
+++ b/testsuite/tests/polykinds/T7053.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE PolyKinds, GADTs #-}
 
 module T7053 where
 
diff --git a/testsuite/tests/polykinds/T7053.stderr b/testsuite/tests/polykinds/T7053.stderr
deleted file mode 100644
index f5c3efc4f978..000000000000
--- a/testsuite/tests/polykinds/T7053.stderr
+++ /dev/null
@@ -1,8 +0,0 @@
-
-T7053.hs:6:52:
-    Kind occurs check
-    The first argument of ‛a’ should have kind ‛k0’,
-      but ‛b’ has kind ‛k0 -> k1’
-    In the type ‛TypeRep (a b)’
-    In the definition of data constructor ‛TyApp’
-    In the data declaration for ‛TypeRep’
diff --git a/testsuite/tests/polykinds/T7151.stderr b/testsuite/tests/polykinds/T7151.stderr
index 61949db94ff1..00fed221c12c 100644
--- a/testsuite/tests/polykinds/T7151.stderr
+++ b/testsuite/tests/polykinds/T7151.stderr
@@ -1,4 +1,4 @@
 
 T7151.hs:3:12:
-    Illegal type: ‛'[Int, String]’
+    Illegal type: ‘'[Int, String]’
       Perhaps you intended to use DataKinds
diff --git a/testsuite/tests/polykinds/T7224.stderr b/testsuite/tests/polykinds/T7224.stderr
index 1ae01218aa45..90ebc0f3ec6b 100644
--- a/testsuite/tests/polykinds/T7224.stderr
+++ b/testsuite/tests/polykinds/T7224.stderr
@@ -1,5 +1,5 @@
 
 T7224.hs:6:19:
-    Kind variable ‛i’ used as a type
-    In the type ‛a -> m i i a’
-    In the class declaration for ‛PMonad'’
+    Kind variable ‘i’ used as a type
+    In the type ‘a -> m i i a’
+    In the class declaration for ‘PMonad'’
diff --git a/testsuite/tests/polykinds/T7230.stderr b/testsuite/tests/polykinds/T7230.stderr
index ab9037da0355..0c3424922392 100644
--- a/testsuite/tests/polykinds/T7230.stderr
+++ b/testsuite/tests/polykinds/T7230.stderr
@@ -7,15 +7,15 @@ T7230.hs:48:32:
       at T7230.hs:47:10-68
     or from (xs ~ (x : xs1))
       bound by a pattern with constructor
-                 SCons :: forall (x :: k) (xs :: [k]).
+                 SCons :: forall (k :: BOX) (x :: k) (xs :: [k]).
                           Sing x -> Sing xs -> Sing (x : xs),
-               in an equation for ‛crash’
+               in an equation for ‘crash’
       at T7230.hs:48:8-27
     or from (xs1 ~ (x1 : xs2))
       bound by a pattern with constructor
-                 SCons :: forall (x :: k) (xs :: [k]).
+                 SCons :: forall (k :: BOX) (x :: k) (xs :: [k]).
                           Sing x -> Sing xs -> Sing (x : xs),
-               in an equation for ‛crash’
+               in an equation for ‘crash’
       at T7230.hs:48:17-26
     Expected type: SBool (Increasing xs)
       Actual type: SBool (x :<<= x1)
@@ -23,5 +23,5 @@ T7230.hs:48:32:
       y :: Sing x1 (bound at T7230.hs:48:23)
       x :: Sing x (bound at T7230.hs:48:14)
     In the expression: x %:<<= y
-    In an equation for ‛crash’:
+    In an equation for ‘crash’:
         crash (SCons x (SCons y xs)) = x %:<<= y
diff --git a/testsuite/tests/polykinds/T7278.stderr b/testsuite/tests/polykinds/T7278.stderr
index a242e5aaf85f..3d615c12f74e 100644
--- a/testsuite/tests/polykinds/T7278.stderr
+++ b/testsuite/tests/polykinds/T7278.stderr
@@ -1,5 +1,5 @@
 
 T7278.hs:8:43:
-    ‛t’ is applied to too many type arguments
-    In the type signature for ‛f’:
-      f :: C (t :: k) (TF t) => TF t p1 p0 -> t p1 p0
+    ‘t’ is applied to too many type arguments
+    In the type signature for ‘f’:
+      f :: (C (t :: k) (TF t)) => TF t p1 p0 -> t p1 p0
diff --git a/testsuite/tests/polykinds/T7328.stderr b/testsuite/tests/polykinds/T7328.stderr
index 54508c07736e..7fcd8edf907e 100644
--- a/testsuite/tests/polykinds/T7328.stderr
+++ b/testsuite/tests/polykinds/T7328.stderr
@@ -1,7 +1,7 @@
 
 T7328.hs:8:34:
     Kind occurs check
-    The first argument of ‛Foo’ should have kind ‛k0’,
-      but ‛f’ has kind ‛k1 -> k0’
-    In the type ‛a ~ f i => Proxy (Foo f)’
-    In the class declaration for ‛Foo’
+    The first argument of ‘Foo’ should have kind ‘k0’,
+      but ‘f’ has kind ‘k1 -> k0’
+    In the type ‘a ~ f i => Proxy (Foo f)’
+    In the class declaration for ‘Foo’
diff --git a/testsuite/tests/polykinds/T7341.stderr b/testsuite/tests/polykinds/T7341.stderr
index 36ab4eaaf268..c5dd26066051 100644
--- a/testsuite/tests/polykinds/T7341.stderr
+++ b/testsuite/tests/polykinds/T7341.stderr
@@ -1,6 +1,6 @@
 
 T7341.hs:11:12:
-    Expecting one more argument to ‛[]’
-    The first argument of ‛C’ should have kind ‛*’,
-      but ‛[]’ has kind ‛* -> *’
-    In the instance declaration for ‛C []’
+    Expecting one more argument to ‘[]’
+    The first argument of ‘C’ should have kind ‘*’,
+      but ‘[]’ has kind ‘* -> *’
+    In the instance declaration for ‘C []’
diff --git a/testsuite/tests/polykinds/T7404.stderr b/testsuite/tests/polykinds/T7404.stderr
index a228e0c1ba71..d9d4288c56f3 100644
--- a/testsuite/tests/polykinds/T7404.stderr
+++ b/testsuite/tests/polykinds/T7404.stderr
@@ -1,4 +1,4 @@
 
 T7404.hs:4:1:
-    Kind variable also used as type variable: ‛x’
-    In the declaration for type family ‛Foo’
+    Kind variable also used as type variable: ‘x’
+    In the declaration for type family ‘Foo’
diff --git a/testsuite/tests/polykinds/T7433.stderr b/testsuite/tests/polykinds/T7433.stderr
index 97ba56e1958a..d3f57a9ee792 100644
--- a/testsuite/tests/polykinds/T7433.stderr
+++ b/testsuite/tests/polykinds/T7433.stderr
@@ -1,6 +1,6 @@
 
 T7433.hs:2:10:
-    Data constructor ‛Z’ cannot be used here
+    Data constructor ‘Z’ cannot be used here
       (Perhaps you intended to use DataKinds)
-    In the type ‛Z’
-    In the type declaration for ‛T’
+    In the type ‘Z’
+    In the type declaration for ‘T’
diff --git a/testsuite/tests/polykinds/T7438.stderr b/testsuite/tests/polykinds/T7438.stderr
index 3f8ba8981e27..b84465545f86 100644
--- a/testsuite/tests/polykinds/T7438.stderr
+++ b/testsuite/tests/polykinds/T7438.stderr
@@ -1,18 +1,19 @@
 
 T7438.hs:6:14:
-    Couldn't match expected type ‛t1’ with actual type ‛t’
-      ‛t’ is untouchable
+    Couldn't match expected type ‘t1’ with actual type ‘t’
+      ‘t’ is untouchable
         inside the constraints (t2 ~ t3)
         bound by a pattern with constructor
-                   Nil :: forall (a :: k). Thrist a a,
-                 in an equation for ‛go’
+                   Nil :: forall (k :: BOX) (b :: k). Thrist b b,
+                 in an equation for ‘go’
         at T7438.hs:6:4-6
-      ‛t’ is a rigid type variable bound by
+      ‘t’ is a rigid type variable bound by
           the inferred type of go :: Thrist t2 t3 -> t -> t1 at T7438.hs:6:1
-      ‛t1’ is a rigid type variable bound by
+      ‘t1’ is a rigid type variable bound by
            the inferred type of go :: Thrist t2 t3 -> t -> t1 at T7438.hs:6:1
+    Possible fix: add a type signature for ‘go’
     Relevant bindings include
       acc :: t (bound at T7438.hs:6:8)
       go :: Thrist t2 t3 -> t -> t1 (bound at T7438.hs:6:1)
     In the expression: acc
-    In an equation for ‛go’: go Nil acc = acc
+    In an equation for ‘go’: go Nil acc = acc
diff --git a/testsuite/tests/polykinds/T7481.hs b/testsuite/tests/polykinds/T7481.hs
new file mode 100644
index 000000000000..cb64d393a4ed
--- /dev/null
+++ b/testsuite/tests/polykinds/T7481.hs
@@ -0,0 +1,12 @@
+ {-# LANGUAGE DataKinds, PolyKinds, RankNTypes, GADTs #-}
+
+module T7481 where
+
+import Data.Proxy
+
+data D a where
+  D1 :: a -> D a
+  D2 :: (a~Int) => D a
+  D3 :: forall (a::k) b. Proxy a -> D b
+
+data Foo :: D * -> *
\ No newline at end of file
diff --git a/testsuite/tests/polykinds/T7481.stderr b/testsuite/tests/polykinds/T7481.stderr
new file mode 100644
index 000000000000..cca905d5e53c
--- /dev/null
+++ b/testsuite/tests/polykinds/T7481.stderr
@@ -0,0 +1,4 @@
+
+T7481.hs:12:13:
+    ‘D’ of kind ‘* -> *’ is not promotable
+    In the kind ‘D * -> *’
diff --git a/testsuite/tests/polykinds/T7594.stderr b/testsuite/tests/polykinds/T7594.stderr
index 08bc36e02b25..31faf3d287e4 100644
--- a/testsuite/tests/polykinds/T7594.stderr
+++ b/testsuite/tests/polykinds/T7594.stderr
@@ -1,14 +1,15 @@
 
 T7594.hs:33:12:
-    Couldn't match type ‛b’ with ‛IO ()’
-      ‛b’ is untouchable
+    Couldn't match type ‘b’ with ‘IO ()’
+      ‘b’ is untouchable
         inside the constraints ((:&:) c0 Real a)
         bound by a type expected by the context: (:&:) c0 Real a => a -> b
         at T7594.hs:33:8-19
-      ‛b’ is a rigid type variable bound by
+      ‘b’ is a rigid type variable bound by
           the inferred type of bar2 :: b at T7594.hs:33:1
+    Possible fix: add a type signature for ‘bar2’
     Expected type: a -> b
       Actual type: a -> IO ()
     Relevant bindings include bar2 :: b (bound at T7594.hs:33:1)
-    In the first argument of ‛app’, namely ‛print’
+    In the first argument of ‘app’, namely ‘print’
     In the expression: app print q2
diff --git a/testsuite/tests/polykinds/T7805.stderr b/testsuite/tests/polykinds/T7805.stderr
index db9761a770fd..bdf0f21b1412 100644
--- a/testsuite/tests/polykinds/T7805.stderr
+++ b/testsuite/tests/polykinds/T7805.stderr
@@ -1,4 +1,4 @@
 
 T7805.hs:6:21:
-    ‛HigherRank’ of kind ‛*’ is not promotable
-    In the kind ‛HigherRank’
+    ‘HigherRank’ of kind ‘*’ is not promotable
+    In the kind ‘HigherRank’
diff --git a/testsuite/tests/polykinds/T7939a.stderr b/testsuite/tests/polykinds/T7939a.stderr
index 7485eb019f79..22388ddca003 100644
--- a/testsuite/tests/polykinds/T7939a.stderr
+++ b/testsuite/tests/polykinds/T7939a.stderr
@@ -1,7 +1,7 @@
 
 T7939a.hs:7:5:
-    Expecting one more argument to ‛Maybe’
-    The first argument of ‛F’ should have kind ‛*’,
-      but ‛Maybe’ has kind ‛* -> *’
-    In the type ‛Maybe’
-    In the family declaration for ‛F’
+    Expecting one more argument to ‘Maybe’
+    The first argument of ‘F’ should have kind ‘*’,
+      but ‘Maybe’ has kind ‘* -> *’
+    In the type ‘Maybe’
+    In the type family declaration for ‘F’
diff --git a/testsuite/tests/polykinds/T8566.stderr b/testsuite/tests/polykinds/T8566.stderr
index 639f72be57f9..ad0d15e69c90 100644
--- a/testsuite/tests/polykinds/T8566.stderr
+++ b/testsuite/tests/polykinds/T8566.stderr
@@ -1,18 +1,19 @@
 
 T8566.hs:31:9:
     Could not deduce (C ('AA (t (I a ps)) as) ps fs0)
-      arising from a use of ‛c’
+      arising from a use of ‘c’
     from the context (C ('AA (t (I a ps)) as) ps fs)
       bound by the instance declaration at T8566.hs:29:10-67
     or from ('AA t (a : as) ~ 'AA t1 as1)
       bound by a pattern with constructor
-                 A :: forall (r :: [*]) (t :: k) (as :: [U *]). I ('AA t as) r,
-               in an equation for ‛c’
+                 A :: forall (r :: [*]) (k :: BOX) (t :: k) (as :: [U *]).
+                      I ('AA t as) r,
+               in an equation for ‘c’
       at T8566.hs:31:5
-    The type variable ‛fs0’ is ambiguous
+    The type variable ‘fs0’ is ambiguous
     Relevant bindings include
       c :: I ('AA t (a : as)) ps -> I ('AA t (a : as)) ps
         (bound at T8566.hs:31:3)
     In the expression: c undefined
-    In an equation for ‛c’: c A = c undefined
-    In the instance declaration for ‛C ('AA t (a : as)) ps fs’
+    In an equation for ‘c’: c A = c undefined
+    In the instance declaration for ‘C ('AA t (a : as)) ps fs’
diff --git a/testsuite/tests/polykinds/T8616.stderr b/testsuite/tests/polykinds/T8616.stderr
index 4e1b9ec371eb..5c8449826da4 100644
--- a/testsuite/tests/polykinds/T8616.stderr
+++ b/testsuite/tests/polykinds/T8616.stderr
@@ -1,7 +1,7 @@
 
 T8616.hs:8:29:
-    Expected a type, but ‛Any’ has kind ‛k’
+    Expected a type, but ‘Any’ has kind ‘k’
     In an expression type signature: (Any :: k)
     In the expression: undefined :: (Any :: k)
-    In an equation for ‛withSomeSing’:
+    In an equation for ‘withSomeSing’:
         withSomeSing = undefined :: (Any :: k)
diff --git a/testsuite/tests/polykinds/T8705.hs b/testsuite/tests/polykinds/T8705.hs
new file mode 100644
index 000000000000..d066f2127057
--- /dev/null
+++ b/testsuite/tests/polykinds/T8705.hs
@@ -0,0 +1,23 @@
+{-# LANGUAGE TypeOperators, DataKinds, PolyKinds,
+             MultiParamTypeClasses, GADTs, ConstraintKinds, TypeFamilies #-}
+module T8705 where
+
+data family Sing (a :: k)
+data Proxy a = Proxy
+
+data instance Sing (a :: Maybe k) where
+  SJust :: Sing h -> Sing (Just h)
+
+data Dict c where
+  Dict :: c => Dict c
+
+-- A less-than-or-equal relation among naturals
+class a :<=: b
+
+sLeq :: Sing n -> Sing n2 -> Dict (n :<=: n2)
+sLeq = undefined
+
+insert_ascending :: (lst ~ Just n1) => Proxy n1 -> Sing n -> Sing lst -> Dict (n :<=: n1)
+insert_ascending _ n (SJust h)
+  = case sLeq n h of
+      Dict -> Dict
diff --git a/testsuite/tests/polykinds/T8985.hs b/testsuite/tests/polykinds/T8985.hs
new file mode 100644
index 000000000000..28a354be2722
--- /dev/null
+++ b/testsuite/tests/polykinds/T8985.hs
@@ -0,0 +1,16 @@
+{-# LANGUAGE DataKinds, PolyKinds, TypeFamilies, GADTs, TypeOperators #-}
+
+module T8905 where
+
+data X (xs :: [k]) = MkX
+data Y :: (k -> *) -> [k] -> * where
+  MkY :: f x -> Y f (x ': xs)
+
+type family F (a :: [[*]]) :: *
+type instance F xss = Y X xss
+
+works :: Y X '[ '[ ] ] -> ()
+works (MkY MkX) = ()
+
+fails :: F '[ '[ ] ] -> ()
+fails (MkY MkX) = ()
diff --git a/testsuite/tests/polykinds/T9063.hs b/testsuite/tests/polykinds/T9063.hs
new file mode 100644
index 000000000000..007f475c0694
--- /dev/null
+++ b/testsuite/tests/polykinds/T9063.hs
@@ -0,0 +1,16 @@
+{-# LANGUAGE DataKinds, PolyKinds, TypeFamilies, TypeOperators,
+             UndecidableInstances #-}
+
+module T9063 where
+
+import Data.Type.Equality
+import Data.Proxy
+
+class kproxy ~ 'KProxy => PEq (kproxy :: KProxy a) where
+  type (:==) (x :: a) (y :: a) :: Bool
+  type x :== y = x == y
+
+instance PEq ('KProxy :: KProxy Bool)
+
+foo :: Proxy (True :== True) -> Proxy (True == True)
+foo = id
diff --git a/testsuite/tests/polykinds/T9106.hs b/testsuite/tests/polykinds/T9106.hs
new file mode 100644
index 000000000000..eaf036423543
--- /dev/null
+++ b/testsuite/tests/polykinds/T9106.hs
@@ -0,0 +1,14 @@
+{-# LANGUAGE MultiParamTypeClasses, DataKinds, FunctionalDependencies,
+   KindSignatures, PolyKinds, FlexibleInstances, FlexibleContexts,
+   UndecidableInstances #-}
+
+module T9106 where
+
+import GHC.TypeLits
+
+class FunctorN (n :: Nat) f (a :: *) (fa :: *) | n f a -> fa where
+
+instance FunctorN 0 f a a where
+
+instance FunctorN n f a (f fa)
+
diff --git a/testsuite/tests/polykinds/T9106.stderr b/testsuite/tests/polykinds/T9106.stderr
new file mode 100644
index 000000000000..0b239f2ea481
--- /dev/null
+++ b/testsuite/tests/polykinds/T9106.stderr
@@ -0,0 +1,8 @@
+
+T9106.hs:13:10:
+    Illegal instance declaration for ‘FunctorN n f a (f fa)’
+      The liberal coverage condition fails in class ‘FunctorN’
+        for functional dependency: ‘n f a -> fa’
+      Reason: lhs types ‘n’, ‘f’, ‘a’
+        do not jointly determine rhs type ‘f fa’
+    In the instance declaration for ‘FunctorN n f a (f fa)’
diff --git a/testsuite/tests/polykinds/T9144.hs b/testsuite/tests/polykinds/T9144.hs
new file mode 100644
index 000000000000..0a9ef08afa37
--- /dev/null
+++ b/testsuite/tests/polykinds/T9144.hs
@@ -0,0 +1,34 @@
+{-# LANGUAGE PolyKinds, DataKinds, TypeFamilies, GADTs, RankNTypes #-}
+
+module T9144 where
+
+import Data.Proxy
+import GHC.TypeLits
+
+data family Sing (a :: k)
+
+data SomeSing :: KProxy k -> * where
+  SomeSing :: forall (a :: k). Sing a -> SomeSing ('KProxy :: KProxy k)
+
+class kproxy ~ 'KProxy => SingKind (kproxy :: KProxy k) where
+  fromSing :: forall (a :: k). Sing a -> DemoteRep ('KProxy :: KProxy k)
+  toSing :: DemoteRep ('KProxy :: KProxy k) -> SomeSing ('KProxy :: KProxy k)
+
+type family DemoteRep (kproxy :: KProxy k) :: *
+
+data Foo = Bar Nat
+data FooTerm = BarTerm Integer
+
+data instance Sing (x :: Foo) where
+  SBar :: Sing n -> Sing (Bar n)
+
+type instance DemoteRep ('KProxy :: KProxy Nat) = Integer
+type instance DemoteRep ('KProxy :: KProxy Foo) = FooTerm
+
+instance SingKind ('KProxy :: KProxy Nat) where
+  fromSing = undefined
+  toSing = undefined
+
+instance SingKind ('KProxy :: KProxy Foo) where
+  fromSing (SBar n) = BarTerm (fromSing n)
+  toSing n = case toSing n of SomeSing n' -> SomeSing (SBar n')
diff --git a/testsuite/tests/polykinds/T9144.stderr b/testsuite/tests/polykinds/T9144.stderr
new file mode 100644
index 000000000000..f2c65530eec1
--- /dev/null
+++ b/testsuite/tests/polykinds/T9144.stderr
@@ -0,0 +1,7 @@
+
+T9144.hs:34:26:
+    Couldn't match type ‘Integer’ with ‘FooTerm’
+    Expected type: DemoteRep 'KProxy
+      Actual type: DemoteRep 'KProxy
+    In the first argument of ‘toSing’, namely ‘n’
+    In the expression: toSing n
diff --git a/testsuite/tests/polykinds/T9200.hs b/testsuite/tests/polykinds/T9200.hs
new file mode 100644
index 000000000000..ca050661a26b
--- /dev/null
+++ b/testsuite/tests/polykinds/T9200.hs
@@ -0,0 +1,29 @@
+{-# LANGUAGE PolyKinds, MultiParamTypeClasses, FlexibleContexts, DataKinds,
+             TypeFamilies #-}
+
+module T9200 where
+
+------
+-- test CUSK on classes
+
+class C (f :: k) (a :: k2) where
+  c_meth :: D a => ()
+  
+class C () a => D a
+
+
+---------
+--- test CUSK on type synonyms
+data T1 a b c = MkT1 (S True b c)
+data T2 p q r = MkT2 (S p 5 r)
+data T3 x y q = MkT3 (S x y '())
+type S (f :: k1) (g :: k2) (h :: k3) = ((T1 f g h, T2 f g h, T3 f g h) :: *)
+
+
+----------
+-- test CUSK on closed type families
+type family F (a :: k) :: k where
+  F True = False
+  F False = True
+  F x = x
+
diff --git a/testsuite/tests/polykinds/T9200b.hs b/testsuite/tests/polykinds/T9200b.hs
new file mode 100644
index 000000000000..f780aba16a3a
--- /dev/null
+++ b/testsuite/tests/polykinds/T9200b.hs
@@ -0,0 +1,10 @@
+{-# LANGUAGE TypeFamilies, PolyKinds, DataKinds #-}
+
+module T9200b where
+
+---------
+--- test CUSK on closed type families
+type family F (a :: k) where
+  F True = False
+  F False = True
+  F x = x
diff --git a/testsuite/tests/polykinds/T9200b.stderr b/testsuite/tests/polykinds/T9200b.stderr
new file mode 100644
index 000000000000..5e8c73087863
--- /dev/null
+++ b/testsuite/tests/polykinds/T9200b.stderr
@@ -0,0 +1,6 @@
+
+T9200b.hs:8:5:
+    The first argument of ‘F’ should have kind ‘k’,
+      but ‘True’ has kind ‘Bool’
+    In the type ‘True’
+    In the type family declaration for ‘F’
diff --git a/testsuite/tests/polykinds/T9222.hs b/testsuite/tests/polykinds/T9222.hs
new file mode 100644
index 000000000000..df112519ac6b
--- /dev/null
+++ b/testsuite/tests/polykinds/T9222.hs
@@ -0,0 +1,7 @@
+{-# LANGUAGE RankNTypes, GADTs, DataKinds, PolyKinds, TypeOperators, TypeFamilies #-}
+module T9222 where
+
+import Data.Proxy
+
+data Want :: (i,j) -> * where
+  Want :: (a ~ '(b,c) => Proxy b) -> Want a
diff --git a/testsuite/tests/polykinds/T9263.hs b/testsuite/tests/polykinds/T9263.hs
new file mode 100644
index 000000000000..e913e1f6538e
--- /dev/null
+++ b/testsuite/tests/polykinds/T9263.hs
@@ -0,0 +1,2 @@
+module T9263 where
+  import T9263a
diff --git a/testsuite/tests/polykinds/T9263a.hs b/testsuite/tests/polykinds/T9263a.hs
new file mode 100644
index 000000000000..1cecabad38df
--- /dev/null
+++ b/testsuite/tests/polykinds/T9263a.hs
@@ -0,0 +1,9 @@
+{-# LANGUAGE DataKinds, KindSignatures, TypeFamilies #-}
+module T9263a where
+
+import T9263b
+import Data.Proxy
+
+data Void
+
+instance PEq ('KProxy :: KProxy Void)
diff --git a/testsuite/tests/polykinds/T9263b.hs b/testsuite/tests/polykinds/T9263b.hs
new file mode 100644
index 000000000000..d267eaca79f2
--- /dev/null
+++ b/testsuite/tests/polykinds/T9263b.hs
@@ -0,0 +1,8 @@
+{-# LANGUAGE DataKinds, PolyKinds, TypeFamilies #-}
+module T9263b where
+
+import Data.Proxy
+
+class kproxy ~ 'KProxy => PEq (kproxy :: KProxy a) where
+   type F (x :: a) :: Bool
+   type F (x :: a) = False
diff --git a/testsuite/tests/polykinds/T9264.hs b/testsuite/tests/polykinds/T9264.hs
new file mode 100644
index 000000000000..df75599e5616
--- /dev/null
+++ b/testsuite/tests/polykinds/T9264.hs
@@ -0,0 +1,6 @@
+{-# LANGUAGE PolyKinds, TypeFamilies, ScopedTypeVariables #-}
+module T9264 where
+
+class C (a :: k) where
+   type F (a :: k)
+   type F (a :: k) = Int
diff --git a/testsuite/tests/polykinds/all.T b/testsuite/tests/polykinds/all.T
index 34253fd45d43..5b02dda80c87 100644
--- a/testsuite/tests/polykinds/all.T
+++ b/testsuite/tests/polykinds/all.T
@@ -54,7 +54,7 @@ test('T6137', normal, compile,[''])
 test('T6093', normal, compile,[''])
 test('T6049', normal, compile,[''])
 test('T6129', normal, compile_fail,[''])
-test('T7053', normal, compile_fail,[''])
+test('T7053', normal, compile,[''])
 test('T7053a', normal, compile,[''])
 test('T7020', normal, compile,[''])
 test('T7022', normal, run_command, ['$MAKE -s --no-print-directory T7022'])
@@ -97,3 +97,14 @@ test('T8534', normal, compile, [''])
 test('T8566', normal, compile_fail,[''])
 test('T8616', normal, compile_fail,[''])
 test('T8566a', expect_broken(8566), compile,[''])
+test('T7481', normal, compile_fail,[''])
+test('T8705', normal, compile, [''])
+test('T8985', normal, compile, [''])
+test('T9106', normal, compile_fail, [''])
+test('T9144', normal, compile_fail, [''])
+test('T9222', normal, compile, [''])
+test('T9264', normal, compile, [''])
+test('T9263', normal, run_command, ['$MAKE -s --no-print-directory T9263'])
+test('T9063', normal, compile, [''])
+test('T9200', normal, compile, [''])
+test('T9200b', normal, compile_fail, [''])
diff --git a/testsuite/tests/profiling/should_run/all.T b/testsuite/tests/profiling/should_run/all.T
index 493c846bc76e..ac70b9f643b2 100644
--- a/testsuite/tests/profiling/should_run/all.T
+++ b/testsuite/tests/profiling/should_run/all.T
@@ -25,7 +25,7 @@ test('T3001-2',
 test('scc001', [req_profiling,
                 extra_ways(['prof']), only_ways(prof_ways)],
      compile_and_run,
-     ['-fno-state-hack']) # Note [consistent stacks]
+     ['-fno-state-hack -fno-full-laziness']) # Note [consistent stacks]
 
 test('scc002', [req_profiling,
                 extra_ways(['prof']), only_ways(prof_ways)],
diff --git a/testsuite/tests/profiling/should_run/ioprof.prof.sample b/testsuite/tests/profiling/should_run/ioprof.prof.sample
index 0cdfa82f48da..07257e2dfeb4 100644
--- a/testsuite/tests/profiling/should_run/ioprof.prof.sample
+++ b/testsuite/tests/profiling/should_run/ioprof.prof.sample
@@ -1,39 +1,37 @@
-	Mon Nov 14 13:28 2011 Time and Allocation Profiling Report  (Final)
+	Mon Apr 28 15:29 2014 Time and Allocation Profiling Report  (Final)
 
 	   ioprof +RTS -hc -p -RTS
 
-	total time  =        0.00 secs   (0 ticks @ 20 ms)
-	total alloc =      53,288 bytes  (excludes profiling overheads)
+	total time  =        0.00 secs   (0 ticks @ 1000 us, 1 processor)
+	total alloc =      52,208 bytes  (excludes profiling overheads)
 
 COST CENTRE MODULE           %time %alloc
 
-main        Main               0.0   16.4
-errorM.\    Main               0.0    8.3
-CAF         GHC.IO.Handle.FD   0.0   65.5
+MAIN        MAIN               0.0    1.4
+CAF         GHC.IO.Encoding    0.0    6.3
 CAF         GHC.Conc.Signal    0.0    1.3
-CAF         GHC.IO.Encoding    0.0    5.9
+CAF         GHC.IO.Handle.FD   0.0   66.2
+main        Main               0.0   16.7
+errorM.\    Main               0.0    7.0
 
 
-                                                          individual     inherited
-COST CENTRE     MODULE                  no.     entries  %time %alloc   %time %alloc
+                                                            individual     inherited
+COST CENTRE       MODULE                  no.     entries  %time %alloc   %time %alloc
 
-MAIN            MAIN                     45           0    0.0    0.7     0.0  100.0
- CAF            GHC.IO.Encoding.Iconv    76           0    0.0    0.5     0.0    0.5
- CAF            GHC.Conc.Sync            74           0    0.0    0.5     0.0    0.5
- CAF            GHC.IO.Encoding          65           0    0.0    5.9     0.0    5.9
- CAF            GHC.Conc.Signal          62           0    0.0    1.3     0.0    1.3
- CAF            GHC.IO.Handle.FD         56           0    0.0   65.5     0.0   65.5
- CAF            GHC.Exception            55           0    0.0    0.2     0.0    0.2
- CAF            Main                     51           0    0.0    0.6     0.0   25.6
-  main          Main                     90           1    0.0   16.4     0.0   24.9
-   runM         Main                     93           1    0.0    0.0     0.0    8.3
-    bar         Main                     94           0    0.0    0.0     0.0    8.3
-     foo        Main                     99           0    0.0    0.0     0.0    8.3
-      errorM    Main                    100           0    0.0    0.0     0.0    8.3
-       errorM.\ Main                    101           1    0.0    8.3     0.0    8.3
-     >>=        Main                     95           0    0.0    0.0     0.0    0.0
-      >>=.\     Main                     96           1    0.0    0.0     0.0    0.0
-   bar          Main                     91           1    0.0    0.2     0.0    0.2
-    foo         Main                     97           1    0.0    0.0     0.0    0.0
-     errorM     Main                     98           1    0.0    0.0     0.0    0.0
-    >>=         Main                     92           1    0.0    0.0     0.0    0.0
+MAIN              MAIN                     44           0    0.0    1.4     0.0  100.0
+ main             Main                     89           0    0.0   16.5     0.0   16.5
+ CAF              Main                     87           0    0.0    0.0     0.0    7.4
+  main            Main                     88           1    0.0    0.2     0.0    7.4
+   runM           Main                     90           1    0.0    0.2     0.0    7.2
+    bar           Main                     91           1    0.0    0.0     0.0    7.1
+     errorM       Main                     93           1    0.0    0.0     0.0    0.0
+     >>=          Main                     92           1    0.0    0.0     0.0    7.0
+      >>=.\       Main                     94           1    0.0    0.0     0.0    7.0
+       foo        Main                     95           1    0.0    0.0     0.0    7.0
+        errorM    Main                     96           0    0.0    0.0     0.0    7.0
+         errorM.\ Main                     97           1    0.0    7.0     0.0    7.0
+ CAF              GHC.IO.Handle.FD         84           0    0.0   66.2     0.0   66.2
+ CAF              GHC.Conc.Signal          82           0    0.0    1.3     0.0    1.3
+ CAF              GHC.Conc.Sync            81           0    0.0    0.4     0.0    0.4
+ CAF              GHC.IO.Encoding          74           0    0.0    6.3     0.0    6.3
+ CAF              GHC.IO.Encoding.Iconv    56           0    0.0    0.4     0.0    0.4
diff --git a/testsuite/tests/programs/hs-boot/hs-boot.stderr b/testsuite/tests/programs/hs-boot/hs-boot.stderr
index b171e1b547c1..42ca07311746 100644
--- a/testsuite/tests/programs/hs-boot/hs-boot.stderr
+++ b/testsuite/tests/programs/hs-boot/hs-boot.stderr
@@ -1,2 +1,2 @@
 
-B.hs:5:23: Warning: {-# SOURCE #-} unnecessary in import of  ‛A’
+B.hs:5:23: Warning: {-# SOURCE #-} unnecessary in import of  ‘A’
diff --git a/testsuite/tests/quasiquotation/T3953.stderr b/testsuite/tests/quasiquotation/T3953.stderr
index bd2b0fed569f..0a067dd4b2e9 100644
--- a/testsuite/tests/quasiquotation/T3953.stderr
+++ b/testsuite/tests/quasiquotation/T3953.stderr
@@ -1,2 +1,2 @@
 
-T3953.hs:5:7: Not in scope: ‛notDefinedHere’
+T3953.hs:5:7: Not in scope: ‘notDefinedHere’
diff --git a/testsuite/tests/quasiquotation/T7918.stdout b/testsuite/tests/quasiquotation/T7918.stdout
index 43de631493e0..f4d406b5910b 100644
--- a/testsuite/tests/quasiquotation/T7918.stdout
+++ b/testsuite/tests/quasiquotation/T7918.stdout
@@ -1,27 +1,27 @@
-(GHC.Types.True, T7918B.hs:6:11-14)
-(GHC.Base.id, T7918B.hs:7:11-14)
-(GHC.Types.True, T7918B.hs:7:11-14)
-(GHC.Types.True, T7918B.hs:8:11-14)
-(GHC.Classes.||, T7918B.hs:8:11-14)
-(GHC.Types.False, T7918B.hs:8:11-14)
-(GHC.Types.False, T7918B.hs:9:11-14)
-(GHC.Err.undefined, T7918B.hs:11:7-15)
-(GHC.Types.Bool, T7918B.hs:11:24-27)
-(GHC.Err.undefined, T7918B.hs:12:7-15)
-(Data.Maybe.Maybe, T7918B.hs:12:24-27)
-(GHC.Types.Bool, T7918B.hs:12:24-27)
-(GHC.Err.undefined, T7918B.hs:13:7-15)
-(Data.Either.Either, T7918B.hs:13:24-27)
-(GHC.Types.Bool, T7918B.hs:13:24-27)
-(GHC.Types.Int, T7918B.hs:13:24-27)
-(GHC.Err.undefined, T7918B.hs:14:7-15)
-(GHC.Types.Int, T7918B.hs:14:24-27)
+(True, T7918B.hs:6:11-14)
+(id, T7918B.hs:7:11-14)
+(True, T7918B.hs:7:11-14)
+(True, T7918B.hs:8:11-14)
+(||, T7918B.hs:8:11-14)
+(False, T7918B.hs:8:11-14)
+(False, T7918B.hs:9:11-14)
+(undefined, T7918B.hs:11:7-15)
+(Bool, T7918B.hs:11:24-27)
+(undefined, T7918B.hs:12:7-15)
+(Maybe, T7918B.hs:12:24-27)
+(Bool, T7918B.hs:12:24-27)
+(undefined, T7918B.hs:13:7-15)
+(Either, T7918B.hs:13:24-27)
+(Bool, T7918B.hs:13:24-27)
+(Int, T7918B.hs:13:24-27)
+(undefined, T7918B.hs:14:7-15)
+(Int, T7918B.hs:14:24-27)
 (x, T7918B.hs:16:9-12)
-(GHC.Err.undefined, T7918B.hs:16:16-24)
+(undefined, T7918B.hs:16:16-24)
 (x, T7918B.hs:17:9-12)
-(GHC.Err.undefined, T7918B.hs:17:16-24)
+(undefined, T7918B.hs:17:16-24)
 (x, T7918B.hs:18:9-12)
 (y, T7918B.hs:18:9-12)
-(GHC.Err.undefined, T7918B.hs:18:16-24)
+(undefined, T7918B.hs:18:16-24)
 (y, T7918B.hs:19:9-12)
-(GHC.Err.undefined, T7918B.hs:19:16-24)
+(undefined, T7918B.hs:19:16-24)
diff --git a/testsuite/tests/rebindable/DoRestrictedM.hs b/testsuite/tests/rebindable/DoRestrictedM.hs
index dea2b1ea03ff..2e982c153240 100644
--- a/testsuite/tests/rebindable/DoRestrictedM.hs
+++ b/testsuite/tests/rebindable/DoRestrictedM.hs
@@ -1,5 +1,5 @@
 {-# LANGUAGE RebindableSyntax, MultiParamTypeClasses,
-             FlexibleInstances #-}
+             FlexibleInstances, FlexibleContexts #-}
 
 -- Tests of the do-notation for the restricted monads
 -- We demonstrate that all ordinary monads are restricted monads,
diff --git a/testsuite/tests/rebindable/rebindable6.stderr b/testsuite/tests/rebindable/rebindable6.stderr
index 6833a511fd74..4d22904d6e4f 100644
--- a/testsuite/tests/rebindable/rebindable6.stderr
+++ b/testsuite/tests/rebindable/rebindable6.stderr
@@ -2,7 +2,7 @@
 rebindable6.hs:106:17:
     No instance for (HasSeq (IO a -> t0 -> IO b))
       arising from a do statement
-    The type variable ‛t0’ is ambiguous
+    The type variable ‘t0’ is ambiguous
     Relevant bindings include
       g :: IO (Maybe b) (bound at rebindable6.hs:104:19)
       f :: IO a (bound at rebindable6.hs:104:17)
@@ -16,7 +16,7 @@ rebindable6.hs:106:17:
       do { f;
            Just (b :: b) <- g;
            return b }
-    In an equation for ‛test_do’:
+    In an equation for ‘test_do’:
         test_do f g
           = do { f;
                  Just (b :: b) <- g;
@@ -25,7 +25,7 @@ rebindable6.hs:106:17:
 rebindable6.hs:107:17:
     No instance for (HasBind (IO (Maybe b) -> (Maybe b -> t1) -> t0))
       arising from a do statement
-    The type variables ‛t0’, ‛t1’ are ambiguous
+    The type variables ‘t0’, ‘t1’ are ambiguous
     Relevant bindings include
       g :: IO (Maybe b) (bound at rebindable6.hs:104:19)
       test_do :: IO a -> IO (Maybe b) -> IO b
@@ -38,7 +38,7 @@ rebindable6.hs:107:17:
       do { f;
            Just (b :: b) <- g;
            return b }
-    In an equation for ‛test_do’:
+    In an equation for ‘test_do’:
         test_do f g
           = do { f;
                  Just (b :: b) <- g;
@@ -46,8 +46,8 @@ rebindable6.hs:107:17:
 
 rebindable6.hs:108:17:
     No instance for (HasReturn (b -> t1))
-      arising from a use of ‛return’
-    The type variable ‛t1’ is ambiguous
+      arising from a use of ‘return’
+    The type variable ‘t1’ is ambiguous
     Relevant bindings include
       b :: b (bound at rebindable6.hs:107:23)
       g :: IO (Maybe b) (bound at rebindable6.hs:104:19)
@@ -60,7 +60,7 @@ rebindable6.hs:108:17:
       do { f;
            Just (b :: b) <- g;
            return b }
-    In an equation for ‛test_do’:
+    In an equation for ‘test_do’:
         test_do f g
           = do { f;
                  Just (b :: b) <- g;
diff --git a/testsuite/tests/rename/prog002/rename.prog002.stderr b/testsuite/tests/rename/prog002/rename.prog002.stderr
index 3d488acb5a3f..b9dbf7f54a81 100644
--- a/testsuite/tests/rename/prog002/rename.prog002.stderr
+++ b/testsuite/tests/rename/prog002/rename.prog002.stderr
@@ -1,2 +1,2 @@
 
-rnfail037.hs:8:7: Not in scope: data constructor ‛Rn037Help.C’
+rnfail037.hs:8:7: Not in scope: data constructor ‘Rn037Help.C’
diff --git a/testsuite/tests/rename/prog003/rename.prog003.stderr b/testsuite/tests/rename/prog003/rename.prog003.stderr
index 42cc924bea23..7a0b5244c0c3 100644
--- a/testsuite/tests/rename/prog003/rename.prog003.stderr
+++ b/testsuite/tests/rename/prog003/rename.prog003.stderr
@@ -1,2 +1,2 @@
 
-B.hs:4:6: Not in scope: type constructor or class ‛Class’
+B.hs:4:6: Not in scope: type constructor or class ‘Class’
diff --git a/testsuite/tests/rename/prog006/Makefile b/testsuite/tests/rename/prog006/Makefile
index fec1ce42d3d7..4124feccf059 100644
--- a/testsuite/tests/rename/prog006/Makefile
+++ b/testsuite/tests/rename/prog006/Makefile
@@ -28,11 +28,12 @@ rn.prog006:
 	rm -f pkg.conf
 	rm -f pwd pwd.exe pwd.exe.manifest pwd.hi pwd.o
 	'$(TEST_HC)' $(TEST_HC_OPTS) --make pwd -v0
-	'$(TEST_HC)' $(TEST_HC_OPTS) --make -package-name test-1.0 B.C -fforce-recomp -v0 $(RM_PROG006_EXTRA_FLAGS)
+	'$(TEST_HC)' $(TEST_HC_OPTS) --make -this-package-key test-1.0 B.C -fforce-recomp -v0 $(RM_PROG006_EXTRA_FLAGS)
 	rm -f pkg.conf
 	echo "name: test" >>pkg.conf
 	echo "version: 1.0" >>pkg.conf
 	echo "id: test-XXX" >>pkg.conf
+	echo "key: test-1.0" >>pkg.conf
 	echo "import-dirs: `./pwd`" >>pkg.conf
 	echo "exposed-modules: B.C" >>pkg.conf
 	echo "[]" >$(LOCAL_PKGCONF)
diff --git a/testsuite/tests/rename/should_compile/T1789.stderr b/testsuite/tests/rename/should_compile/T1789.stderr
index 3fd1f1a037d1..e4057921d5c2 100644
--- a/testsuite/tests/rename/should_compile/T1789.stderr
+++ b/testsuite/tests/rename/should_compile/T1789.stderr
@@ -1,12 +1,12 @@
 
 T1789.hs:6:1: Warning:
-    The module ‛Prelude’ does not have an explicit import list
+    The module ‘Prelude’ does not have an explicit import list
 
 T1789.hs:7:1: Warning:
-    The module ‛Data.Map’ does not have an explicit import list
+    The module ‘Data.Map’ does not have an explicit import list
 
 T1789.hs:9:1: Warning:
-    The import item ‛Maybe(..)’ does not have an explicit import list
+    The import item ‘Maybe(..)’ does not have an explicit import list
 
 T1789.hs:10:1: Warning:
-    The module ‛Data.Maybe’ does not have an explicit import list
+    The module ‘Data.Maybe’ does not have an explicit import list
diff --git a/testsuite/tests/rename/should_compile/T1972.stderr b/testsuite/tests/rename/should_compile/T1972.stderr
index 1cb78fbc29cb..e8e8f39a6b18 100644
--- a/testsuite/tests/rename/should_compile/T1972.stderr
+++ b/testsuite/tests/rename/should_compile/T1972.stderr
@@ -1,11 +1,11 @@
 
 T1972.hs:12:3: Warning:
-    This binding for ‛name’ shadows the existing binding
+    This binding for ‘name’ shadows the existing binding
       defined at T1972.hs:9:19
 
 T1972.hs:14:3: Warning:
-    This binding for ‛mapAccumL’ shadows the existing bindings
+    This binding for ‘mapAccumL’ shadows the existing bindings
       defined at T1972.hs:16:1
-      imported from ‛Data.List’ at T1972.hs:7:1-16
+      imported from ‘Data.List’ at T1972.hs:7:1-16
 
-T1972.hs:20:10: Warning: Defined but not used: ‛c’
+T1972.hs:20:10: Warning: Defined but not used: ‘c’
diff --git a/testsuite/tests/rename/should_compile/T3103/T3103.stderr b/testsuite/tests/rename/should_compile/T3103/T3103.stderr
index ed041023e9ff..f1d4c531fa6c 100644
--- a/testsuite/tests/rename/should_compile/T3103/T3103.stderr
+++ b/testsuite/tests/rename/should_compile/T3103/T3103.stderr
@@ -1,3 +1,3 @@
 
 GHC/Word.hs:10:23:
-    Warning: {-# SOURCE #-} unnecessary in import of  ‛GHC.Unicode’
+    Warning: {-# SOURCE #-} unnecessary in import of  ‘GHC.Unicode’
diff --git a/testsuite/tests/rename/should_compile/T3103/test.T b/testsuite/tests/rename/should_compile/T3103/test.T
index d1e5b643f31c..51ee2830bdfe 100644
--- a/testsuite/tests/rename/should_compile/T3103/test.T
+++ b/testsuite/tests/rename/should_compile/T3103/test.T
@@ -11,5 +11,5 @@ test('T3103',
                    'GHC/Unicode.o',  'GHC/Unicode.o-boot',
                    'GHC/Word.hi',    'GHC/Word.o'])],
      multimod_compile,
-     ['Foreign.Ptr', '-v0 -hide-all-packages -package ghc-prim -package integer-gmp -package-name base'])
+     ['Foreign.Ptr', '-v0 -hide-all-packages -package ghc-prim -package integer-gmp -this-package-key base'])
 
diff --git a/testsuite/tests/rename/should_compile/T3262.stderr-ghc b/testsuite/tests/rename/should_compile/T3262.stderr-ghc
index b3250fd5a394..0639076dc031 100644
--- a/testsuite/tests/rename/should_compile/T3262.stderr-ghc
+++ b/testsuite/tests/rename/should_compile/T3262.stderr-ghc
@@ -1,8 +1,8 @@
 
 T3262.hs:12:11: Warning:
-    This binding for ‛not_ignored’ shadows the existing binding
+    This binding for ‘not_ignored’ shadows the existing binding
       bound at T3262.hs:11:11
 
 T3262.hs:20:15: Warning:
-    This binding for ‛not_ignored’ shadows the existing binding
+    This binding for ‘not_ignored’ shadows the existing binding
       bound at T3262.hs:19:15
diff --git a/testsuite/tests/rename/should_compile/T3371.stderr b/testsuite/tests/rename/should_compile/T3371.stderr
index 944739e45a42..20a597fd3ec7 100644
--- a/testsuite/tests/rename/should_compile/T3371.stderr
+++ b/testsuite/tests/rename/should_compile/T3371.stderr
@@ -1,2 +1,2 @@
 
-T3371.hs:10:14: Warning: Defined but not used: ‛a’
+T3371.hs:10:14: Warning: Defined but not used: ‘a’
diff --git a/testsuite/tests/rename/should_compile/T3449.stderr b/testsuite/tests/rename/should_compile/T3449.stderr
index 32ddc6f35d03..bfb002114041 100644
--- a/testsuite/tests/rename/should_compile/T3449.stderr
+++ b/testsuite/tests/rename/should_compile/T3449.stderr
@@ -1,2 +1,2 @@
 
-T3449.hs-boot:8:1: Warning: Defined but not used: ‛unused’
+T3449.hs-boot:8:1: Warning: Defined but not used: ‘unused’
diff --git a/testsuite/tests/rename/should_compile/T3823.stderr b/testsuite/tests/rename/should_compile/T3823.stderr
index 4672d3ccb8ed..8ab375fcd44e 100644
--- a/testsuite/tests/rename/should_compile/T3823.stderr
+++ b/testsuite/tests/rename/should_compile/T3823.stderr
@@ -1,5 +1,5 @@
 
 T3823B.hs:8:7:
-    Couldn't match expected type ‛A’ with actual type ‛Bool’
-    In the first argument of ‛y’, namely ‛a’
+    Couldn't match expected type ‘A’ with actual type ‘Bool’
+    In the first argument of ‘y’, namely ‘a’
     In the expression: y a
diff --git a/testsuite/tests/rename/should_compile/T4489.stderr b/testsuite/tests/rename/should_compile/T4489.stderr
index 5fd076ee4254..2e7f9186a8bc 100644
--- a/testsuite/tests/rename/should_compile/T4489.stderr
+++ b/testsuite/tests/rename/should_compile/T4489.stderr
@@ -1,6 +1,6 @@
 
 T4489.hs:4:1: Warning:
-    The module ‛Data.Maybe’ does not have an explicit import list
+    The module ‘Data.Maybe’ does not have an explicit import list
 
 T4489.hs:5:1: Warning:
-    The import item ‛Maybe(..)’ does not have an explicit import list
+    The import item ‘Maybe(..)’ does not have an explicit import list
diff --git a/testsuite/tests/rename/should_compile/T5331.stderr b/testsuite/tests/rename/should_compile/T5331.stderr
index e78dd64daf36..562aa699788f 100644
--- a/testsuite/tests/rename/should_compile/T5331.stderr
+++ b/testsuite/tests/rename/should_compile/T5331.stderr
@@ -1,13 +1,13 @@
 
 T5331.hs:8:17: Warning:
-    Unused quantified type variable ‛a’
-    In the definition of data constructor ‛S1’
+    Unused quantified type variable ‘a’
+    In the definition of data constructor ‘S1’
 
 T5331.hs:11:16: Warning:
-    Unused quantified type variable ‛a’
-    In the definition of data constructor ‛W1’
+    Unused quantified type variable ‘a’
+    In the definition of data constructor ‘W1’
 
 T5331.hs:13:13: Warning:
-    Unused quantified type variable ‛a’
-    In the type ‛forall a. Int’
-    In the type signature for ‛f’
+    Unused quantified type variable ‘a’
+    In the type ‘forall a. Int’
+    In the type signature for ‘f’
diff --git a/testsuite/tests/rename/should_compile/T5334.stderr b/testsuite/tests/rename/should_compile/T5334.stderr
index 2985386338de..866eae20fce7 100644
--- a/testsuite/tests/rename/should_compile/T5334.stderr
+++ b/testsuite/tests/rename/should_compile/T5334.stderr
@@ -1,13 +1,13 @@
 
 T5334.hs:7:5: Warning:
-    Fields of ‛T’ not initialised: b
+    Fields of ‘T’ not initialised: b
     In the expression: T {..}
-    In an equation for ‛t’:
+    In an equation for ‘t’:
         t = T {..}
           where
               a = 1
 
 T5334.hs:14:5: Warning:
-    Fields of ‛S’ not initialised: y
+    Fields of ‘S’ not initialised: y
     In the expression: S {x = 1}
-    In an equation for ‛s’: s = S {x = 1}
+    In an equation for ‘s’: s = S {x = 1}
diff --git a/testsuite/tests/rename/should_compile/T5867.stderr b/testsuite/tests/rename/should_compile/T5867.stderr
index 0ada9be52c04..b347240a9eab 100644
--- a/testsuite/tests/rename/should_compile/T5867.stderr
+++ b/testsuite/tests/rename/should_compile/T5867.stderr
@@ -1,8 +1,8 @@
 
 T5867.hs:4:7: Warning:
-    In the use of ‛f’ (imported from T5867a):
+    In the use of ‘f’ (imported from T5867a):
     Deprecated: "Don't use f!"
 
 T5867.hs:5:7: Warning:
-    In the use of ‛f’ (imported from T5867a):
+    In the use of ‘f’ (imported from T5867a):
     Deprecated: "Don't use f!"
diff --git a/testsuite/tests/rename/should_compile/T7145b.hs b/testsuite/tests/rename/should_compile/T7145b.hs
index 54200c320f52..2d753c8bf7da 100644
--- a/testsuite/tests/rename/should_compile/T7145b.hs
+++ b/testsuite/tests/rename/should_compile/T7145b.hs
@@ -1,7 +1,4 @@
 {-# LANGUAGE CPP #-}
-#if __GLASGOW_HASKELL__ >= 707
-{-# OPTIONS_GHC -fno-warn-amp #-}
-#endif
 module T7145b ( A.Applicative(pure) ) where
 
 import qualified Control.Applicative as A
diff --git a/testsuite/tests/rename/should_compile/T7145b.stderr b/testsuite/tests/rename/should_compile/T7145b.stderr
index 1839bf7ad3b0..ed2333e8c447 100644
--- a/testsuite/tests/rename/should_compile/T7145b.stderr
+++ b/testsuite/tests/rename/should_compile/T7145b.stderr
@@ -1,2 +1,2 @@
 
-T7145b.hs:10:1: Warning: Defined but not used: ‛pure’
+T7145b.hs:7:1: Warning: Defined but not used: ‘pure’
diff --git a/testsuite/tests/rename/should_compile/T7167.stderr b/testsuite/tests/rename/should_compile/T7167.stderr
index cddbbfe74de5..ecad80cfd2e0 100644
--- a/testsuite/tests/rename/should_compile/T7167.stderr
+++ b/testsuite/tests/rename/should_compile/T7167.stderr
@@ -1,2 +1,2 @@
 
-T7167.hs:5:1: Warning: Module ‛Data.List’ does not export ‛foo’
+T7167.hs:5:1: Warning: Module ‘Data.List’ does not export ‘foo’
diff --git a/testsuite/tests/rename/should_compile/T7336.stderr b/testsuite/tests/rename/should_compile/T7336.stderr
index 0610b13e21f0..c8af8c5589e8 100644
--- a/testsuite/tests/rename/should_compile/T7336.stderr
+++ b/testsuite/tests/rename/should_compile/T7336.stderr
@@ -1,3 +1,3 @@
 
 T7336.hs:3:10: Warning:
-    Defined but not used: data constructor ‛MkU’
+    Defined but not used: data constructor ‘MkU’
diff --git a/testsuite/tests/rename/should_compile/T9127.hs b/testsuite/tests/rename/should_compile/T9127.hs
new file mode 100644
index 000000000000..c8e827f88887
--- /dev/null
+++ b/testsuite/tests/rename/should_compile/T9127.hs
@@ -0,0 +1,5 @@
+{-# LANGUAGE BangPatterns #-}
+module T9127 where
+
+f = let !_ = 2 * 2
+    in 2*2
diff --git a/testsuite/tests/rename/should_compile/T9127.stderr b/testsuite/tests/rename/should_compile/T9127.stderr
new file mode 100644
index 000000000000..e69de29bb2d1
diff --git a/testsuite/tests/rename/should_compile/all.T b/testsuite/tests/rename/should_compile/all.T
index 0ce4ca125d37..d104df4910ce 100644
--- a/testsuite/tests/rename/should_compile/all.T
+++ b/testsuite/tests/rename/should_compile/all.T
@@ -110,6 +110,8 @@ test('rn067',
      extra_clean(['Rn067_A.hi', 'Rn067_A.o']),
      multimod_compile, ['rn067', '-v0'])
 
+test('rn068', normal, compile, [''])
+
 test('T1972', normal, compile, [''])
 test('T2205', normal, compile, [''])
 
@@ -214,3 +216,4 @@ test('T7969',
                    'T7969.imports'])],
      run_command,
      ['$MAKE -s --no-print-directory T7969'])
+test('T9127', normal, compile, [''])
diff --git a/testsuite/tests/rename/should_compile/mc10.stderr-ghc b/testsuite/tests/rename/should_compile/mc10.stderr-ghc
index 56a21b870051..b0d32552b4ad 100644
--- a/testsuite/tests/rename/should_compile/mc10.stderr-ghc
+++ b/testsuite/tests/rename/should_compile/mc10.stderr-ghc
@@ -1,2 +1,2 @@
 
-mc10.hs:14:11: Warning: Defined but not used: ‛y’
+mc10.hs:14:11: Warning: Defined but not used: ‘y’
diff --git a/testsuite/tests/rename/should_compile/rn037.stderr-ghc b/testsuite/tests/rename/should_compile/rn037.stderr-ghc
index ad171a42633a..8dea678d4206 100644
--- a/testsuite/tests/rename/should_compile/rn037.stderr-ghc
+++ b/testsuite/tests/rename/should_compile/rn037.stderr-ghc
@@ -1,5 +1,5 @@
 
 rn037.hs:3:1: Warning:
-    The import of ‛Data.List’ is redundant
-      except perhaps to import instances from ‛Data.List’
+    The import of ‘Data.List’ is redundant
+      except perhaps to import instances from ‘Data.List’
     To import instances alone, use: import Data.List()
diff --git a/testsuite/tests/rename/should_compile/rn039.stderr-ghc b/testsuite/tests/rename/should_compile/rn039.stderr-ghc
index 2b87c367e3a3..de8618d5f08c 100644
--- a/testsuite/tests/rename/should_compile/rn039.stderr-ghc
+++ b/testsuite/tests/rename/should_compile/rn039.stderr-ghc
@@ -1,5 +1,5 @@
 
 rn039.hs:6:16: Warning:
-    This binding for ‛-’ shadows the existing binding
-      imported from ‛Prelude’ at rn039.hs:2:8-20
-      (and originally defined in ‛GHC.Num’)
+    This binding for ‘-’ shadows the existing binding
+      imported from ‘Prelude’ at rn039.hs:2:8-20
+      (and originally defined in ‘GHC.Num’)
diff --git a/testsuite/tests/rename/should_compile/rn040.stderr-ghc b/testsuite/tests/rename/should_compile/rn040.stderr-ghc
index f5802287b81c..f482b475115f 100644
--- a/testsuite/tests/rename/should_compile/rn040.stderr-ghc
+++ b/testsuite/tests/rename/should_compile/rn040.stderr-ghc
@@ -1,4 +1,4 @@
 
-rn040.hs:6:12: Warning: Defined but not used: ‛y’
+rn040.hs:6:12: Warning: Defined but not used: ‘y’
 
-rn040.hs:8:8: Warning: Defined but not used: ‛w’
+rn040.hs:8:8: Warning: Defined but not used: ‘w’
diff --git a/testsuite/tests/rename/should_compile/rn041.stderr-ghc b/testsuite/tests/rename/should_compile/rn041.stderr-ghc
index fbf27899ade9..e9c272774241 100644
--- a/testsuite/tests/rename/should_compile/rn041.stderr-ghc
+++ b/testsuite/tests/rename/should_compile/rn041.stderr-ghc
@@ -1,6 +1,6 @@
 
-rn041.hs:7:1: Warning: Defined but not used: ‛f’
+rn041.hs:7:1: Warning: Defined but not used: ‘f’
 
-rn041.hs:9:1: Warning: Defined but not used: ‛g’
+rn041.hs:9:1: Warning: Defined but not used: ‘g’
 
-rn041.hs:10:1: Warning: Defined but not used: ‛h’
+rn041.hs:10:1: Warning: Defined but not used: ‘h’
diff --git a/testsuite/tests/rename/should_compile/rn046.stderr-ghc b/testsuite/tests/rename/should_compile/rn046.stderr-ghc
index 433537613741..c2a4195287a3 100644
--- a/testsuite/tests/rename/should_compile/rn046.stderr-ghc
+++ b/testsuite/tests/rename/should_compile/rn046.stderr-ghc
@@ -1,8 +1,8 @@
 
 rn046.hs:2:1: Warning:
-    The import of ‛Data.List’ is redundant
-      except perhaps to import instances from ‛Data.List’
+    The import of ‘Data.List’ is redundant
+      except perhaps to import instances from ‘Data.List’
     To import instances alone, use: import Data.List()
 
 rn046.hs:3:1: Warning:
-    The import of ‛ord’ from module ‛Data.Char’ is redundant
+    The import of ‘ord’ from module ‘Data.Char’ is redundant
diff --git a/testsuite/tests/rename/should_compile/rn047.stderr-ghc b/testsuite/tests/rename/should_compile/rn047.stderr-ghc
index 588237d267e5..0987f356fa68 100644
--- a/testsuite/tests/rename/should_compile/rn047.stderr-ghc
+++ b/testsuite/tests/rename/should_compile/rn047.stderr-ghc
@@ -1,2 +1,2 @@
 
-rn047.hs:12:11: Warning: Defined but not used: ‛y’
+rn047.hs:12:11: Warning: Defined but not used: ‘y’
diff --git a/testsuite/tests/rename/should_compile/rn050.stderr b/testsuite/tests/rename/should_compile/rn050.stderr
index 2554787a458c..472333ed5731 100644
--- a/testsuite/tests/rename/should_compile/rn050.stderr
+++ b/testsuite/tests/rename/should_compile/rn050.stderr
@@ -1,8 +1,8 @@
 
 rn050.hs:13:7: Warning:
-    In the use of ‛op’ (imported from Rn050_A):
+    In the use of ‘op’ (imported from Rn050_A):
     Deprecated: "Use bop instead"
 
 rn050.hs:13:10: Warning:
-    In the use of data constructor ‛C’ (imported from Rn050_A):
+    In the use of data constructor ‘C’ (imported from Rn050_A):
     Deprecated: "Use D instead"
diff --git a/testsuite/tests/rename/should_compile/rn063.stderr b/testsuite/tests/rename/should_compile/rn063.stderr
index 635ef98bd9a6..93cd8654f3c7 100644
--- a/testsuite/tests/rename/should_compile/rn063.stderr
+++ b/testsuite/tests/rename/should_compile/rn063.stderr
@@ -1,4 +1,4 @@
 
-rn063.hs:10:9: Warning: Defined but not used: ‛x’
+rn063.hs:10:9: Warning: Defined but not used: ‘x’
 
-rn063.hs:13:9: Warning: Defined but not used: ‛y’
+rn063.hs:13:9: Warning: Defined but not used: ‘y’
diff --git a/testsuite/tests/rename/should_compile/rn064.stderr b/testsuite/tests/rename/should_compile/rn064.stderr
index 6ca77eaf25b7..09d95871debe 100644
--- a/testsuite/tests/rename/should_compile/rn064.stderr
+++ b/testsuite/tests/rename/should_compile/rn064.stderr
@@ -1,4 +1,4 @@
 
 rn064.hs:13:12: Warning:
-    This binding for ‛r’ shadows the existing binding
+    This binding for ‘r’ shadows the existing binding
       bound at rn064.hs:15:9
diff --git a/testsuite/tests/rename/should_compile/rn066.stderr b/testsuite/tests/rename/should_compile/rn066.stderr
index 52e82e9e7a00..b82b50fcdbaa 100644
--- a/testsuite/tests/rename/should_compile/rn066.stderr
+++ b/testsuite/tests/rename/should_compile/rn066.stderr
@@ -1,8 +1,8 @@
 
 rn066.hs:13:7: Warning:
-    In the use of ‛op’ (imported from Rn066_A):
+    In the use of ‘op’ (imported from Rn066_A):
     "Is that really a good idea?"
 
 rn066.hs:13:10: Warning:
-    In the use of data constructor ‛C’ (imported from Rn066_A):
+    In the use of data constructor ‘C’ (imported from Rn066_A):
     "Are you sure you want to do that?"
diff --git a/testsuite/tests/rename/should_compile/rn068.hs b/testsuite/tests/rename/should_compile/rn068.hs
new file mode 100644
index 000000000000..83ed851ed8a6
--- /dev/null
+++ b/testsuite/tests/rename/should_compile/rn068.hs
@@ -0,0 +1,5 @@
+module Foo where
+
+data A = A1 { a, b :: Int }
+       | A2 { a, b :: Int }
+       | A3 { a, b :: Int }
diff --git a/testsuite/tests/rename/should_fail/T1595a.stderr b/testsuite/tests/rename/should_fail/T1595a.stderr
index f7dd8113f0c6..9705293a0a7a 100644
--- a/testsuite/tests/rename/should_fail/T1595a.stderr
+++ b/testsuite/tests/rename/should_fail/T1595a.stderr
@@ -1,2 +1,2 @@
 
-T1595a.hs:3:20: Not in scope: type constructor or class ‛Tpyo’
+T1595a.hs:3:20: Not in scope: type constructor or class ‘Tpyo’
diff --git a/testsuite/tests/rename/should_fail/T2310.stderr b/testsuite/tests/rename/should_fail/T2310.stderr
index a5dd532a0c6a..807a574f75f3 100644
--- a/testsuite/tests/rename/should_fail/T2310.stderr
+++ b/testsuite/tests/rename/should_fail/T2310.stderr
@@ -1,10 +1,10 @@
 
 T2310.hs:5:22:
-    Illegal result type signature ‛a’
+    Illegal result type signature ‘a’
       Result signatures are no longer supported in pattern matches
     In a lambda abstraction: \ x :: a -> (x :: a)
 
 T2310.hs:5:39:
-    Not in scope: ‛co’
+    Not in scope: ‘co’
     Perhaps you meant one of these:
-      ‛c’ (line 5), ‛cos’ (imported from Prelude)
+      ‘c’ (line 5), ‘cos’ (imported from Prelude)
diff --git a/testsuite/tests/rename/should_fail/T2723.stderr b/testsuite/tests/rename/should_fail/T2723.stderr
index b34816145335..66b2deef470a 100644
--- a/testsuite/tests/rename/should_fail/T2723.stderr
+++ b/testsuite/tests/rename/should_fail/T2723.stderr
@@ -1,4 +1,4 @@
 
 T2723.hs:15:5: Warning:
-    This binding for ‛field3’ shadows the existing binding
+    This binding for ‘field3’ shadows the existing binding
       defined at T2723.hs:7:1
diff --git a/testsuite/tests/rename/should_fail/T2901.stderr b/testsuite/tests/rename/should_fail/T2901.stderr
index fedaee6329b8..b240139bd838 100644
--- a/testsuite/tests/rename/should_fail/T2901.stderr
+++ b/testsuite/tests/rename/should_fail/T2901.stderr
@@ -1,4 +1,4 @@
 
-T2901.hs:6:5: Not in scope: data constructor ‛F.Foo’
+T2901.hs:6:5: Not in scope: data constructor ‘F.Foo’
 
-T2901.hs:6:13: ‛F.field’ is not a (visible) constructor field name
+T2901.hs:6:13: ‘F.field’ is not a (visible) constructor field name
diff --git a/testsuite/tests/rename/should_fail/T2993.stderr b/testsuite/tests/rename/should_fail/T2993.stderr
index ec6fa1ea2a2a..00679dd1a56a 100644
--- a/testsuite/tests/rename/should_fail/T2993.stderr
+++ b/testsuite/tests/rename/should_fail/T2993.stderr
@@ -1,2 +1,2 @@
 
-T2993.hs:7:13: Not in scope: ‛<$>’
+T2993.hs:7:13: Not in scope: ‘<$>’
diff --git a/testsuite/tests/rename/should_fail/T3265.stderr b/testsuite/tests/rename/should_fail/T3265.stderr
index 185861a9df02..999b6b3ed2bb 100644
--- a/testsuite/tests/rename/should_fail/T3265.stderr
+++ b/testsuite/tests/rename/should_fail/T3265.stderr
@@ -1,8 +1,8 @@
 
 T3265.hs:7:8:
-    Illegal declaration of a type or class operator ‛:+:’
+    Illegal declaration of a type or class operator ‘:+:’
       Use TypeOperators to declare operators in type and declarations
 
 T3265.hs:9:9:
-    Illegal declaration of a type or class operator ‛:*:’
+    Illegal declaration of a type or class operator ‘:*:’
       Use TypeOperators to declare operators in type and declarations
diff --git a/testsuite/tests/rename/should_fail/T5211.stderr b/testsuite/tests/rename/should_fail/T5211.stderr
index 8dcc5b68bde0..2a736dbdaa6c 100644
--- a/testsuite/tests/rename/should_fail/T5211.stderr
+++ b/testsuite/tests/rename/should_fail/T5211.stderr
@@ -1,5 +1,5 @@
 
 T5211.hs:5:1: Warning:
-    The qualified import of ‛Foreign.Storable’ is redundant
-      except perhaps to import instances from ‛Foreign.Storable’
+    The qualified import of ‘Foreign.Storable’ is redundant
+      except perhaps to import instances from ‘Foreign.Storable’
     To import instances alone, use: import Foreign.Storable()
diff --git a/testsuite/tests/rename/should_fail/T5281.stderr b/testsuite/tests/rename/should_fail/T5281.stderr
index 99ad47b5846b..d8bcc8f78702 100644
--- a/testsuite/tests/rename/should_fail/T5281.stderr
+++ b/testsuite/tests/rename/should_fail/T5281.stderr
@@ -1,4 +1,4 @@
 
 T5281.hs:6:5: Warning:
-    In the use of ‛deprec’ (imported from T5281A):
+    In the use of ‘deprec’ (imported from T5281A):
     Deprecated: "This is deprecated"
diff --git a/testsuite/tests/rename/should_fail/T5372.stderr b/testsuite/tests/rename/should_fail/T5372.stderr
index 667787508365..9d3f06e7d46d 100644
--- a/testsuite/tests/rename/should_fail/T5372.stderr
+++ b/testsuite/tests/rename/should_fail/T5372.stderr
@@ -1,6 +1,6 @@
 
 T5372.hs:4:11:
-    Not in scope: data constructor ‛MkS’
-    Perhaps you meant ‛T5372a.MkS’ (imported from T5372a)
+    Not in scope: data constructor ‘MkS’
+    Perhaps you meant ‘T5372a.MkS’ (imported from T5372a)
 
-T5372.hs:4:17: ‛x’ is not a (visible) constructor field name
+T5372.hs:4:17: ‘x’ is not a (visible) constructor field name
diff --git a/testsuite/tests/rename/should_fail/T5385.stderr b/testsuite/tests/rename/should_fail/T5385.stderr
index 2c87a0a47a93..677c31ff3e39 100644
--- a/testsuite/tests/rename/should_fail/T5385.stderr
+++ b/testsuite/tests/rename/should_fail/T5385.stderr
@@ -1,8 +1,8 @@
 
 T5385.hs:3:16:
-    In module ‛T5385a’:
-      ‛(:::)’ is a data constructor of ‛T’
+    In module ‘T5385a’:
+      ‘(:::)’ is a data constructor of ‘T’
     To import it use
-      ‛import’ T5385a( T( (:::) ) )
+      ‘import’ T5385a( T( (:::) ) )
     or
-      ‛import’ T5385a( T(..) )
+      ‘import’ T5385a( T(..) )
diff --git a/testsuite/tests/rename/should_fail/T5533.stderr b/testsuite/tests/rename/should_fail/T5533.stderr
index ce13e14e2eba..5d514685d4ef 100644
--- a/testsuite/tests/rename/should_fail/T5533.stderr
+++ b/testsuite/tests/rename/should_fail/T5533.stderr
@@ -1,4 +1,4 @@
 
 T5533.hs:4:1:
-    The type signature for ‛f2’ lacks an accompanying binding
+    The type signature for ‘f2’ lacks an accompanying binding
       (You cannot give a type signature for a record selector or class method)
diff --git a/testsuite/tests/rename/should_fail/T5589.stderr b/testsuite/tests/rename/should_fail/T5589.stderr
index cf0c0a9a12b2..f3e5e8d05ccb 100644
--- a/testsuite/tests/rename/should_fail/T5589.stderr
+++ b/testsuite/tests/rename/should_fail/T5589.stderr
@@ -1,5 +1,5 @@
 
 T5589.hs:4:1:
-    Duplicate type signatures for ‛aaa’
+    Duplicate type signatures for ‘aaa’
     at T5589.hs:3:6-8
        T5589.hs:4:1-3
diff --git a/testsuite/tests/rename/should_fail/T5657.stderr b/testsuite/tests/rename/should_fail/T5657.stderr
index 17a223d41c1d..aa5f870b7bbe 100644
--- a/testsuite/tests/rename/should_fail/T5657.stderr
+++ b/testsuite/tests/rename/should_fail/T5657.stderr
@@ -1,5 +1,5 @@
 
-T5657.hs:3:8: Not in scope: ‛LT..’
+T5657.hs:3:8: Not in scope: ‘LT..’
 
 T5657.hs:3:8:
     A section must be enclosed in parentheses thus: (LT.. GT)
diff --git a/testsuite/tests/rename/should_fail/T5745.stderr b/testsuite/tests/rename/should_fail/T5745.stderr
index b71e1e20577a..577ae069b3be 100644
--- a/testsuite/tests/rename/should_fail/T5745.stderr
+++ b/testsuite/tests/rename/should_fail/T5745.stderr
@@ -1,2 +1,2 @@
 
-T5745.hs:5:6: Not in scope: type constructor or class ‛T’
+T5745.hs:5:6: Not in scope: type constructor or class ‘T’
diff --git a/testsuite/tests/rename/should_fail/T5892a.stderr b/testsuite/tests/rename/should_fail/T5892a.stderr
index a378dc39195f..1600d8fa39bd 100644
--- a/testsuite/tests/rename/should_fail/T5892a.stderr
+++ b/testsuite/tests/rename/should_fail/T5892a.stderr
@@ -1,9 +1,9 @@
 
 T5892a.hs:12:8: Warning:
-    Fields of ‛Version’ not initialised: Data.Version.versionTags
+    Fields of ‘Version’ not initialised: Data.Version.versionTags
     In the expression: Version {..}
     In the expression: let versionBranch = [] in Version {..}
-    In an equation for ‛foo’:
+    In an equation for ‘foo’:
         foo (Version {..}) = let versionBranch = ... in Version {..}
 
 <no location info>: 
diff --git a/testsuite/tests/rename/should_fail/T5892b.stderr b/testsuite/tests/rename/should_fail/T5892b.stderr
index 10d1fd139e6b..3d25973fc2f8 100644
--- a/testsuite/tests/rename/should_fail/T5892b.stderr
+++ b/testsuite/tests/rename/should_fail/T5892b.stderr
@@ -1,4 +1,4 @@
 
 T5892b.hs:11:7:
-    Not in scope: ‛T5892b.versionTags’
-    Perhaps you meant ‛T5892b.versionBranch’ (line 7)
+    Not in scope: ‘T5892b.versionTags’
+    Perhaps you meant ‘T5892b.versionBranch’ (line 7)
diff --git a/testsuite/tests/rename/should_fail/T7164.stderr b/testsuite/tests/rename/should_fail/T7164.stderr
index 5e27fb876d2f..8049b27cde70 100644
--- a/testsuite/tests/rename/should_fail/T7164.stderr
+++ b/testsuite/tests/rename/should_fail/T7164.stderr
@@ -1,5 +1,5 @@
 
 T7164.hs:8:1:
-    Multiple declarations of ‛derp’
+    Multiple declarations of ‘derp’
     Declared at: T7164.hs:5:5
                  T7164.hs:8:1
diff --git a/testsuite/tests/rename/should_fail/T7338.stderr b/testsuite/tests/rename/should_fail/T7338.stderr
index b1e6e5c80303..ceb6753a2208 100644
--- a/testsuite/tests/rename/should_fail/T7338.stderr
+++ b/testsuite/tests/rename/should_fail/T7338.stderr
@@ -1,6 +1,6 @@
 
 T7338.hs:4:1:
-    Duplicate type signatures for ‛a’
+    Duplicate type signatures for ‘a’
     at T7338.hs:3:1
        T7338.hs:3:4
        T7338.hs:4:1
diff --git a/testsuite/tests/rename/should_fail/T7338a.stderr b/testsuite/tests/rename/should_fail/T7338a.stderr
index b4b00a35908f..8d6d00097cda 100644
--- a/testsuite/tests/rename/should_fail/T7338a.stderr
+++ b/testsuite/tests/rename/should_fail/T7338a.stderr
@@ -1,10 +1,10 @@
 
 T7338a.hs:7:4:
-    Duplicate type signatures for ‛a’
+    Duplicate type signatures for ‘a’
     at T7338a.hs:3:1
        T7338a.hs:7:4
 
 T7338a.hs:10:1:
-    Duplicate type signatures for ‛c’
+    Duplicate type signatures for ‘c’
     at T7338a.hs:7:1
        T7338a.hs:10:1
diff --git a/testsuite/tests/rename/should_fail/T7454.stderr b/testsuite/tests/rename/should_fail/T7454.stderr
index a8d11886e454..9f8998591aef 100644
--- a/testsuite/tests/rename/should_fail/T7454.stderr
+++ b/testsuite/tests/rename/should_fail/T7454.stderr
@@ -1,3 +1,3 @@
 
 T7454.hs:5:1: Warning:
-    The import of ‛Arrow’ from module ‛Control.Arrow’ is redundant
+    The import of ‘Arrow’ from module ‘Control.Arrow’ is redundant
diff --git a/testsuite/tests/rename/should_fail/T7906.stderr b/testsuite/tests/rename/should_fail/T7906.stderr
index 30ccbed6e909..3f06d8b2fb8a 100644
--- a/testsuite/tests/rename/should_fail/T7906.stderr
+++ b/testsuite/tests/rename/should_fail/T7906.stderr
@@ -1,4 +1,4 @@
 
 T7906.hs:5:16:
-    The INLINABLE pragma for ‛foo’ lacks an accompanying binding
+    The INLINABLE pragma for ‘foo’ lacks an accompanying binding
       (You cannot give a INLINABLE pragma for a record selector or class method)
diff --git a/testsuite/tests/rename/should_fail/T7937.stderr b/testsuite/tests/rename/should_fail/T7937.stderr
index 09eb845cbdc0..3bae06407283 100644
--- a/testsuite/tests/rename/should_fail/T7937.stderr
+++ b/testsuite/tests/rename/should_fail/T7937.stderr
@@ -1,4 +1,4 @@
 
 T7937.hs:8:13:
-    Not in scope: ‛***’
-    Perhaps you meant ‛**’ (imported from Prelude)
+    Not in scope: ‘***’
+    Perhaps you meant ‘**’ (imported from Prelude)
diff --git a/testsuite/tests/rename/should_fail/T8448.stderr b/testsuite/tests/rename/should_fail/T8448.stderr
index 28bfacf62cc7..e5834fbcafd4 100644
--- a/testsuite/tests/rename/should_fail/T8448.stderr
+++ b/testsuite/tests/rename/should_fail/T8448.stderr
@@ -1,2 +1,2 @@
 
-T8448.hs:5:21: ‛r’ is not a (visible) field of constructor ‛[]’
+T8448.hs:5:21: ‘r’ is not a (visible) field of constructor ‘[]’
diff --git a/testsuite/tests/rename/should_fail/T9006.hs b/testsuite/tests/rename/should_fail/T9006.hs
new file mode 100644
index 000000000000..8fc1e6884711
--- /dev/null
+++ b/testsuite/tests/rename/should_fail/T9006.hs
@@ -0,0 +1,3 @@
+module T9006 where
+
+import T9006a (T(T))
diff --git a/testsuite/tests/rename/should_fail/T9006.stderr b/testsuite/tests/rename/should_fail/T9006.stderr
new file mode 100644
index 000000000000..dc82687453b6
--- /dev/null
+++ b/testsuite/tests/rename/should_fail/T9006.stderr
@@ -0,0 +1,2 @@
+
+T9006.hs:3:16: Module ‘T9006a’ does not export ‘T(T)’
diff --git a/testsuite/tests/rename/should_fail/T9006a.hs b/testsuite/tests/rename/should_fail/T9006a.hs
new file mode 100644
index 000000000000..fe8eeefa58f3
--- /dev/null
+++ b/testsuite/tests/rename/should_fail/T9006a.hs
@@ -0,0 +1,3 @@
+module T9006a( T )where
+
+data T = T
diff --git a/testsuite/tests/rename/should_fail/T9156.hs b/testsuite/tests/rename/should_fail/T9156.hs
new file mode 100644
index 000000000000..f4ffd1a128cf
--- /dev/null
+++ b/testsuite/tests/rename/should_fail/T9156.hs
@@ -0,0 +1,4 @@
+module T9156 where
+
+data D = D1 { f1 :: Int }
+       | D2 { f1, f1 :: Int }
diff --git a/testsuite/tests/rename/should_fail/T9156.stderr b/testsuite/tests/rename/should_fail/T9156.stderr
new file mode 100644
index 000000000000..361ed379df05
--- /dev/null
+++ b/testsuite/tests/rename/should_fail/T9156.stderr
@@ -0,0 +1,5 @@
+
+T9156.hs:4:19:
+    Multiple declarations of ‘f1’
+    Declared at: T9156.hs:3:15
+                 T9156.hs:4:19
diff --git a/testsuite/tests/rename/should_fail/T9177.hs b/testsuite/tests/rename/should_fail/T9177.hs
new file mode 100644
index 000000000000..9fbb9407be34
--- /dev/null
+++ b/testsuite/tests/rename/should_fail/T9177.hs
@@ -0,0 +1,17 @@
+module T9177 where
+
+-- the main use case
+type Foo = (int)
+
+-- other interesting cases
+type Foo2 = (integerr)
+
+foo3 = bar
+foo4 = Fun
+
+-- this warning is suboptimal (fun would be illegal here)
+foo5 Fun = ()
+
+-- No errors here:
+data Bar = Bar
+fun x = x
diff --git a/testsuite/tests/rename/should_fail/T9177.stderr b/testsuite/tests/rename/should_fail/T9177.stderr
new file mode 100644
index 000000000000..624034053f8b
--- /dev/null
+++ b/testsuite/tests/rename/should_fail/T9177.stderr
@@ -0,0 +1,20 @@
+
+T9177.hs:4:13:
+    Not in scope: type variable ‘int’
+    Perhaps you meant type constructor or class ‘Int’ (imported from Prelude)
+
+T9177.hs:7:14:
+    Not in scope: type variable ‘integerr’
+    Perhaps you meant type constructor or class ‘Integer’ (imported from Prelude)
+
+T9177.hs:9:8:
+    Not in scope: ‘bar’
+    Perhaps you meant data constructor ‘Bar’ (line 16)
+
+T9177.hs:10:8:
+    Not in scope: data constructor ‘Fun’
+    Perhaps you meant variable ‘fun’ (line 17)
+
+T9177.hs:13:6:
+    Not in scope: data constructor ‘Fun’
+    Perhaps you meant variable ‘fun’ (line 17)
diff --git a/testsuite/tests/rename/should_fail/all.T b/testsuite/tests/rename/should_fail/all.T
index bf48e14edeae..d1bf2b6576e3 100644
--- a/testsuite/tests/rename/should_fail/all.T
+++ b/testsuite/tests/rename/should_fail/all.T
@@ -111,3 +111,8 @@ test('T7906', normal, compile_fail, [''])
 test('T7937', normal, compile_fail, [''])
 test('T7943', normal, compile_fail, [''])
 test('T8448', normal, compile_fail, [''])
+test('T9006',
+     extra_clean(['T9006a.hi', 'T9006a.o']),
+     multimod_compile_fail, ['T9006', '-v0'])
+test('T9156', normal, compile_fail, [''])
+test('T9177', normal, compile_fail, [''])
diff --git a/testsuite/tests/rename/should_fail/mc13.stderr b/testsuite/tests/rename/should_fail/mc13.stderr
index 3cf06955a49b..4d615c2f2365 100644
--- a/testsuite/tests/rename/should_fail/mc13.stderr
+++ b/testsuite/tests/rename/should_fail/mc13.stderr
@@ -1,2 +1,2 @@
 
-mc13.hs:12:37: Not in scope: ‛f’
+mc13.hs:12:37: Not in scope: ‘f’
diff --git a/testsuite/tests/rename/should_fail/mc14.stderr b/testsuite/tests/rename/should_fail/mc14.stderr
index 28d2ca224172..04321ff52407 100644
--- a/testsuite/tests/rename/should_fail/mc14.stderr
+++ b/testsuite/tests/rename/should_fail/mc14.stderr
@@ -1,2 +1,2 @@
 
-mc14.hs:14:49: Not in scope: ‛f’
+mc14.hs:14:49: Not in scope: ‘f’
diff --git a/testsuite/tests/rename/should_fail/rn_dup.stderr b/testsuite/tests/rename/should_fail/rn_dup.stderr
index f0d101c0a35a..961e420ac78d 100644
--- a/testsuite/tests/rename/should_fail/rn_dup.stderr
+++ b/testsuite/tests/rename/should_fail/rn_dup.stderr
@@ -1,22 +1,22 @@
 
 rn_dup.hs:9:10:
-    Multiple declarations of ‛MkT’
+    Multiple declarations of ‘MkT’
     Declared at: rn_dup.hs:7:10
                  rn_dup.hs:7:16
                  rn_dup.hs:9:10
 
 rn_dup.hs:12:16:
-    Multiple declarations of ‛rf’
+    Multiple declarations of ‘rf’
     Declared at: rn_dup.hs:11:16
                  rn_dup.hs:11:27
                  rn_dup.hs:12:16
 
 rn_dup.hs:17:3:
-    Multiple declarations of ‛CT’
+    Multiple declarations of ‘CT’
     Declared at: rn_dup.hs:15:3
                  rn_dup.hs:17:3
 
 rn_dup.hs:18:3:
-    Multiple declarations of ‛f’
+    Multiple declarations of ‘f’
     Declared at: rn_dup.hs:16:3
                  rn_dup.hs:18:3
diff --git a/testsuite/tests/rename/should_fail/rnfail001.stderr b/testsuite/tests/rename/should_fail/rnfail001.stderr
index d8baefcb429e..3046ff10a147 100644
--- a/testsuite/tests/rename/should_fail/rnfail001.stderr
+++ b/testsuite/tests/rename/should_fail/rnfail001.stderr
@@ -1,6 +1,6 @@
 
 rnfail001.hs:3:3:
-    Conflicting definitions for ‛x’
+    Conflicting definitions for ‘x’
     Bound at: rnfail001.hs:3:3
               rnfail001.hs:3:5
-    In an equation for ‛f’
+    In an equation for ‘f’
diff --git a/testsuite/tests/rename/should_fail/rnfail002.stderr b/testsuite/tests/rename/should_fail/rnfail002.stderr
index 6c15ef103d4c..ffa05e767d40 100644
--- a/testsuite/tests/rename/should_fail/rnfail002.stderr
+++ b/testsuite/tests/rename/should_fail/rnfail002.stderr
@@ -1,5 +1,5 @@
 
 rnfail002.hs:6:1:
-    Multiple declarations of ‛y’
+    Multiple declarations of ‘y’
     Declared at: rnfail002.hs:5:1
                  rnfail002.hs:6:1
diff --git a/testsuite/tests/rename/should_fail/rnfail003.stderr b/testsuite/tests/rename/should_fail/rnfail003.stderr
index 04823326266e..24c74a6cbb72 100644
--- a/testsuite/tests/rename/should_fail/rnfail003.stderr
+++ b/testsuite/tests/rename/should_fail/rnfail003.stderr
@@ -1,5 +1,5 @@
 
 rnfail003.hs:4:1:
-    Multiple declarations of ‛f’
+    Multiple declarations of ‘f’
     Declared at: rnfail003.hs:2:1
                  rnfail003.hs:4:1
diff --git a/testsuite/tests/rename/should_fail/rnfail004.stderr b/testsuite/tests/rename/should_fail/rnfail004.stderr
index 23e22fe28f3f..6e9a61f6eaac 100644
--- a/testsuite/tests/rename/should_fail/rnfail004.stderr
+++ b/testsuite/tests/rename/should_fail/rnfail004.stderr
@@ -1,10 +1,10 @@
 
 rnfail004.hs:6:5:
-    Conflicting definitions for ‛a’
+    Conflicting definitions for ‘a’
     Bound at: rnfail004.hs:6:5
               rnfail004.hs:7:10
 
 rnfail004.hs:7:6:
-    Conflicting definitions for ‛b’
+    Conflicting definitions for ‘b’
     Bound at: rnfail004.hs:7:6
               rnfail004.hs:8:8
diff --git a/testsuite/tests/rename/should_fail/rnfail007.stderr b/testsuite/tests/rename/should_fail/rnfail007.stderr
index 9108173c0183..98f96f1e0207 100644
--- a/testsuite/tests/rename/should_fail/rnfail007.stderr
+++ b/testsuite/tests/rename/should_fail/rnfail007.stderr
@@ -1,3 +1,3 @@
 
 rnfail007.hs:1:1:
-    The IO action ‛main’ is not defined in module ‛Main’
+    The IO action ‘main’ is not defined in module ‘Main’
diff --git a/testsuite/tests/rename/should_fail/rnfail008.stderr b/testsuite/tests/rename/should_fail/rnfail008.stderr
index f565d8799005..bf4b0e4d0857 100644
--- a/testsuite/tests/rename/should_fail/rnfail008.stderr
+++ b/testsuite/tests/rename/should_fail/rnfail008.stderr
@@ -1,2 +1,2 @@
 
-rnfail008.hs:18:9: ‛op3’ is not a (visible) method of class ‛K’
+rnfail008.hs:18:9: ‘op3’ is not a (visible) method of class ‘K’
diff --git a/testsuite/tests/rename/should_fail/rnfail009.stderr b/testsuite/tests/rename/should_fail/rnfail009.stderr
index 9f5e98ecb112..d8d3fa5fccd1 100644
--- a/testsuite/tests/rename/should_fail/rnfail009.stderr
+++ b/testsuite/tests/rename/should_fail/rnfail009.stderr
@@ -1,5 +1,5 @@
 
 rnfail009.hs:5:10:
-    Multiple declarations of ‛A’
+    Multiple declarations of ‘A’
     Declared at: rnfail009.hs:3:10
                  rnfail009.hs:5:10
diff --git a/testsuite/tests/rename/should_fail/rnfail010.stderr b/testsuite/tests/rename/should_fail/rnfail010.stderr
index d2f7a9385b93..bd20f39188cd 100644
--- a/testsuite/tests/rename/should_fail/rnfail010.stderr
+++ b/testsuite/tests/rename/should_fail/rnfail010.stderr
@@ -1,5 +1,5 @@
 
 rnfail010.hs:6:1:
-    Multiple declarations of ‛f’
+    Multiple declarations of ‘f’
     Declared at: rnfail010.hs:2:1
                  rnfail010.hs:6:1
diff --git a/testsuite/tests/rename/should_fail/rnfail011.stderr b/testsuite/tests/rename/should_fail/rnfail011.stderr
index 352b4da8370a..0d55b36f508f 100644
--- a/testsuite/tests/rename/should_fail/rnfail011.stderr
+++ b/testsuite/tests/rename/should_fail/rnfail011.stderr
@@ -1,5 +1,5 @@
 
 rnfail011.hs:6:1:
-    Multiple declarations of ‛A’
+    Multiple declarations of ‘A’
     Declared at: rnfail011.hs:2:1
                  rnfail011.hs:6:1
diff --git a/testsuite/tests/rename/should_fail/rnfail012.stderr b/testsuite/tests/rename/should_fail/rnfail012.stderr
index 0dd75d65f745..833256a1caa6 100644
--- a/testsuite/tests/rename/should_fail/rnfail012.stderr
+++ b/testsuite/tests/rename/should_fail/rnfail012.stderr
@@ -1,5 +1,5 @@
 
 rnfail012.hs:8:1:
-    Multiple declarations of ‛A’
+    Multiple declarations of ‘A’
     Declared at: rnfail012.hs:2:1
                  rnfail012.hs:8:1
diff --git a/testsuite/tests/rename/should_fail/rnfail013.stderr b/testsuite/tests/rename/should_fail/rnfail013.stderr
index eebfaa2e020e..ae2ead8fc4bf 100644
--- a/testsuite/tests/rename/should_fail/rnfail013.stderr
+++ b/testsuite/tests/rename/should_fail/rnfail013.stderr
@@ -1,5 +1,5 @@
 
 rnfail013.hs:7:11:
-    Multiple declarations of ‛MkT’
+    Multiple declarations of ‘MkT’
     Declared at: rnfail013.hs:5:11
                  rnfail013.hs:7:11
diff --git a/testsuite/tests/rename/should_fail/rnfail015.stderr b/testsuite/tests/rename/should_fail/rnfail015.stderr
index 999a7acabf06..8edd5e3740d7 100644
--- a/testsuite/tests/rename/should_fail/rnfail015.stderr
+++ b/testsuite/tests/rename/should_fail/rnfail015.stderr
@@ -1,5 +1,5 @@
 
 rnfail015.hs:14:9:
-    Multiple declarations of ‛TokLiteral’
+    Multiple declarations of ‘TokLiteral’
     Declared at: rnfail015.hs:8:9
                  rnfail015.hs:14:9
diff --git a/testsuite/tests/rename/should_fail/rnfail017.stderr b/testsuite/tests/rename/should_fail/rnfail017.stderr
index a89b6be1c03e..de2990864fb9 100644
--- a/testsuite/tests/rename/should_fail/rnfail017.stderr
+++ b/testsuite/tests/rename/should_fail/rnfail017.stderr
@@ -1,8 +1,8 @@
 
 rnfail017.hs:5:10:
     Precedence parsing error
-        cannot mix ‛+’ [infixl 6] and prefix `-' [infixl 6] in the same infix expression
+        cannot mix ‘+’ [infixl 6] and prefix `-' [infixl 6] in the same infix expression
 
 rnfail017.hs:6:10:
     Precedence parsing error
-        cannot mix ‛*’ [infixl 7] and prefix `-' [infixl 6] in the same infix expression
+        cannot mix ‘*’ [infixl 7] and prefix `-' [infixl 6] in the same infix expression
diff --git a/testsuite/tests/rename/should_fail/rnfail018.stderr b/testsuite/tests/rename/should_fail/rnfail018.stderr
index 7658b18baadc..847cfe211efe 100644
--- a/testsuite/tests/rename/should_fail/rnfail018.stderr
+++ b/testsuite/tests/rename/should_fail/rnfail018.stderr
@@ -1,8 +1,8 @@
 
-rnfail018.hs:12:37: Not in scope: type variable ‛a’
+rnfail018.hs:12:37: Not in scope: type variable ‘a’
 
-rnfail018.hs:12:42: Not in scope: type variable ‛m’
+rnfail018.hs:12:42: Not in scope: type variable ‘m’
 
-rnfail018.hs:12:47: Not in scope: type variable ‛m’
+rnfail018.hs:12:47: Not in scope: type variable ‘m’
 
-rnfail018.hs:12:49: Not in scope: type variable ‛a’
+rnfail018.hs:12:49: Not in scope: type variable ‘a’
diff --git a/testsuite/tests/rename/should_fail/rnfail019.stderr b/testsuite/tests/rename/should_fail/rnfail019.stderr
index 449da500e1e9..2520641bd61b 100644
--- a/testsuite/tests/rename/should_fail/rnfail019.stderr
+++ b/testsuite/tests/rename/should_fail/rnfail019.stderr
@@ -1,6 +1,6 @@
 
 rnfail019.hs:5:9:
-    The operator ‛:’ [infixr 5] of a section
+    The operator ‘:’ [infixr 5] of a section
         must have lower precedence than that of the operand,
-          namely ‛:’ [infixr 5]
-        in the section: ‛x : y :’
+          namely ‘:’ [infixr 5]
+        in the section: ‘x : y :’
diff --git a/testsuite/tests/rename/should_fail/rnfail022.stderr b/testsuite/tests/rename/should_fail/rnfail022.stderr
index d443cec996bc..fe2326854855 100644
--- a/testsuite/tests/rename/should_fail/rnfail022.stderr
+++ b/testsuite/tests/rename/should_fail/rnfail022.stderr
@@ -1,4 +1,4 @@
 
 rnfail022.hs:8:5:
-    Not in scope: ‛intersperse’
-    Perhaps you meant ‛L.intersperse’ (imported from Data.List)
+    Not in scope: ‘intersperse’
+    Perhaps you meant ‘L.intersperse’ (imported from Data.List)
diff --git a/testsuite/tests/rename/should_fail/rnfail023.stderr b/testsuite/tests/rename/should_fail/rnfail023.stderr
index 7fa68c3f1928..d10427ae7e47 100644
--- a/testsuite/tests/rename/should_fail/rnfail023.stderr
+++ b/testsuite/tests/rename/should_fail/rnfail023.stderr
@@ -1,9 +1,9 @@
 
 rnfail023.hs:7:1:
-    The type signature for ‛f’ lacks an accompanying binding
+    The type signature for ‘f’ lacks an accompanying binding
 
 rnfail023.hs:8:12:
-    The INLINE pragma for ‛f’ lacks an accompanying binding
+    The INLINE pragma for ‘f’ lacks an accompanying binding
 
 rnfail023.hs:14:7:
-    The type signature for ‛g’ lacks an accompanying binding
+    The type signature for ‘g’ lacks an accompanying binding
diff --git a/testsuite/tests/rename/should_fail/rnfail024.stderr b/testsuite/tests/rename/should_fail/rnfail024.stderr
index f3e6cbe61533..83eed48b3a02 100644
--- a/testsuite/tests/rename/should_fail/rnfail024.stderr
+++ b/testsuite/tests/rename/should_fail/rnfail024.stderr
@@ -1,6 +1,6 @@
 
 rnfail024.hs:3:1:
-    The type signature for ‛sig_without_a_defn’
+    The type signature for ‘sig_without_a_defn’
       lacks an accompanying binding
 
-rnfail024.hs:6:5: Not in scope: ‛sig_without_a_defn’
+rnfail024.hs:6:5: Not in scope: ‘sig_without_a_defn’
diff --git a/testsuite/tests/rename/should_fail/rnfail025.stderr b/testsuite/tests/rename/should_fail/rnfail025.stderr
index bdb07ad5cfae..2f57250f3319 100644
--- a/testsuite/tests/rename/should_fail/rnfail025.stderr
+++ b/testsuite/tests/rename/should_fail/rnfail025.stderr
@@ -1,4 +1,4 @@
 
 rnfail025.hs:3:1:
-    The type signature for ‛sig_without_a_defn’
+    The type signature for ‘sig_without_a_defn’
       lacks an accompanying binding
diff --git a/testsuite/tests/rename/should_fail/rnfail026.stderr b/testsuite/tests/rename/should_fail/rnfail026.stderr
index 1b17272ae12d..22caa11c1d83 100644
--- a/testsuite/tests/rename/should_fail/rnfail026.stderr
+++ b/testsuite/tests/rename/should_fail/rnfail026.stderr
@@ -1,9 +1,9 @@
 
 rnfail026.hs:16:17:
-    The first argument of ‛Monad’ should have kind ‛* -> *’,
-      but ‛forall a. Eq a => Set a’ has kind ‛*’
-    In the instance declaration for ‛Monad (forall a. Eq a => Set a)’
+    The first argument of ‘Monad’ should have kind ‘* -> *’,
+      but ‘forall a. Eq a => Set a’ has kind ‘*’
+    In the instance declaration for ‘Monad (forall a. Eq a => Set a)’
 
 rnfail026.hs:19:10:
     Illegal polymorphic or qualified type: forall a. [a]
-    In the instance declaration for ‛Eq (forall a. [a])’
+    In the instance declaration for ‘Eq (forall a. [a])’
diff --git a/testsuite/tests/rename/should_fail/rnfail027.stderr b/testsuite/tests/rename/should_fail/rnfail027.stderr
index 062600ac8d1a..c58a74f75849 100644
--- a/testsuite/tests/rename/should_fail/rnfail027.stderr
+++ b/testsuite/tests/rename/should_fail/rnfail027.stderr
@@ -1,3 +1,3 @@
 
 rnfail027.hs:5:10:
-    The fixity signature for ‛wibble’ lacks an accompanying binding
+    The fixity signature for ‘wibble’ lacks an accompanying binding
diff --git a/testsuite/tests/rename/should_fail/rnfail029.stderr b/testsuite/tests/rename/should_fail/rnfail029.stderr
index 671b035c4649..c1d97b3acfa7 100644
--- a/testsuite/tests/rename/should_fail/rnfail029.stderr
+++ b/testsuite/tests/rename/should_fail/rnfail029.stderr
@@ -1,8 +1,8 @@
 
 rnfail029.hs:2:36:
-    Conflicting exports for ‛map’:
-       ‛Data.List.map’ exports ‛Data.List.map’
-         imported qualified from ‛Data.List’ at rnfail029.hs:3:1-26
-         (and originally defined in ‛GHC.Base’)
-       ‛module ShouldFail’ exports ‛ShouldFail.map’
+    Conflicting exports for ‘map’:
+       ‘Data.List.map’ exports ‘Data.List.map’
+         imported qualified from ‘Data.List’ at rnfail029.hs:3:1-26
+         (and originally defined in ‘GHC.Base’)
+       ‘module ShouldFail’ exports ‘ShouldFail.map’
          defined at rnfail029.hs:4:1
diff --git a/testsuite/tests/rename/should_fail/rnfail030.stderr b/testsuite/tests/rename/should_fail/rnfail030.stderr
index cbac79dc42b1..5b2cd363585b 100644
--- a/testsuite/tests/rename/should_fail/rnfail030.stderr
+++ b/testsuite/tests/rename/should_fail/rnfail030.stderr
@@ -1,2 +1,2 @@
 
-rnfail030.hs:2:21: Not in scope: ‛Data.List.map’
+rnfail030.hs:2:21: Not in scope: ‘Data.List.map’
diff --git a/testsuite/tests/rename/should_fail/rnfail031.stderr b/testsuite/tests/rename/should_fail/rnfail031.stderr
index eee31a2ec885..828d5121c807 100644
--- a/testsuite/tests/rename/should_fail/rnfail031.stderr
+++ b/testsuite/tests/rename/should_fail/rnfail031.stderr
@@ -1,2 +1,2 @@
 
-rnfail031.hs:2:21: Not in scope: ‛Data.List.map’
+rnfail031.hs:2:21: Not in scope: ‘Data.List.map’
diff --git a/testsuite/tests/rename/should_fail/rnfail032.stderr b/testsuite/tests/rename/should_fail/rnfail032.stderr
index f4cf86597782..8a2bf0c4d167 100644
--- a/testsuite/tests/rename/should_fail/rnfail032.stderr
+++ b/testsuite/tests/rename/should_fail/rnfail032.stderr
@@ -1,7 +1,7 @@
 
 rnfail032.hs:2:21:
-    Not in scope: ‛Data.List.map’
+    Not in scope: ‘Data.List.map’
     Perhaps you meant one of these:
-      ‛Data.List.zip’ (imported from Data.List),
-      ‛Data.List.sum’ (imported from Data.List),
-      ‛Data.List.all’ (imported from Data.List)
+      ‘Data.List.zip’ (imported from Data.List),
+      ‘Data.List.sum’ (imported from Data.List),
+      ‘Data.List.all’ (imported from Data.List)
diff --git a/testsuite/tests/rename/should_fail/rnfail033.stderr b/testsuite/tests/rename/should_fail/rnfail033.stderr
index 4a2e76222ce1..9e95a85e53d9 100644
--- a/testsuite/tests/rename/should_fail/rnfail033.stderr
+++ b/testsuite/tests/rename/should_fail/rnfail033.stderr
@@ -1,7 +1,7 @@
 
 rnfail033.hs:2:21:
-    Not in scope: ‛Data.List.map’
+    Not in scope: ‘Data.List.map’
     Perhaps you meant one of these:
-      ‛Data.List.zip’ (imported from Data.List),
-      ‛Data.List.sum’ (imported from Data.List),
-      ‛Data.List.all’ (imported from Data.List)
+      ‘Data.List.zip’ (imported from Data.List),
+      ‘Data.List.sum’ (imported from Data.List),
+      ‘Data.List.all’ (imported from Data.List)
diff --git a/testsuite/tests/rename/should_fail/rnfail034.stderr b/testsuite/tests/rename/should_fail/rnfail034.stderr
index 6c9b49ec4f7e..78bc649c29ed 100644
--- a/testsuite/tests/rename/should_fail/rnfail034.stderr
+++ b/testsuite/tests/rename/should_fail/rnfail034.stderr
@@ -2,5 +2,5 @@
 rnfail034.hs:4:11: Qualified name in binding position: M.y
 
 rnfail034.hs:4:26:
-    Not in scope: ‛M.y’
-    Perhaps you meant ‛M.g’ (line 4)
+    Not in scope: ‘M.y’
+    Perhaps you meant ‘M.g’ (line 4)
diff --git a/testsuite/tests/rename/should_fail/rnfail035.stderr b/testsuite/tests/rename/should_fail/rnfail035.stderr
index 35dd128e2407..b5de0c07004f 100644
--- a/testsuite/tests/rename/should_fail/rnfail035.stderr
+++ b/testsuite/tests/rename/should_fail/rnfail035.stderr
@@ -1,2 +1,2 @@
 
-rnfail035.hs:2:21: Not in scope: type constructor or class ‛C’
+rnfail035.hs:2:21: Not in scope: type constructor or class ‘C’
diff --git a/testsuite/tests/rename/should_fail/rnfail040.stderr b/testsuite/tests/rename/should_fail/rnfail040.stderr
index 1ff86a826215..38ffb08b6011 100644
--- a/testsuite/tests/rename/should_fail/rnfail040.stderr
+++ b/testsuite/tests/rename/should_fail/rnfail040.stderr
@@ -1,8 +1,8 @@
 
 rnfail040.hs:7:12:
-    Conflicting exports for ‛nub’:
-       ‛module M’ exports ‛M.nub’
-         imported from ‛Data.List’ at rnfail040.hs:10:2-22
-       ‛module M’ exports ‛T.nub’
-         imported from ‛Rnfail040_A’ at rnfail040.hs:11:2-24
+    Conflicting exports for ‘nub’:
+       ‘module M’ exports ‘M.nub’
+         imported from ‘Data.List’ at rnfail040.hs:10:2-22
+       ‘module M’ exports ‘T.nub’
+         imported from ‘Rnfail040_A’ at rnfail040.hs:11:2-24
          (and originally defined at Rnfail040_A.hs:2:3-5)
diff --git a/testsuite/tests/rename/should_fail/rnfail041.stderr b/testsuite/tests/rename/should_fail/rnfail041.stderr
index bebccf2176a9..c5532569d154 100644
--- a/testsuite/tests/rename/should_fail/rnfail041.stderr
+++ b/testsuite/tests/rename/should_fail/rnfail041.stderr
@@ -1,6 +1,6 @@
 
 rnfail041.hs:4:1:
-    The type signature for ‛h’ lacks an accompanying binding
+    The type signature for ‘h’ lacks an accompanying binding
 
 rnfail041.hs:5:1:
-    The type signature for ‛j’ lacks an accompanying binding
+    The type signature for ‘j’ lacks an accompanying binding
diff --git a/testsuite/tests/rename/should_fail/rnfail043.stderr b/testsuite/tests/rename/should_fail/rnfail043.stderr
index 61cef734f917..3547ac55b9d8 100644
--- a/testsuite/tests/rename/should_fail/rnfail043.stderr
+++ b/testsuite/tests/rename/should_fail/rnfail043.stderr
@@ -1,5 +1,5 @@
 
 rnfail043.hs:10:1:
-    Multiple declarations of ‛f’
+    Multiple declarations of ‘f’
     Declared at: rnfail043.hs:6:1
                  rnfail043.hs:10:1
diff --git a/testsuite/tests/rename/should_fail/rnfail044.stderr b/testsuite/tests/rename/should_fail/rnfail044.stderr
index fdae4e17c07e..eef15b2209f1 100644
--- a/testsuite/tests/rename/should_fail/rnfail044.stderr
+++ b/testsuite/tests/rename/should_fail/rnfail044.stderr
@@ -1,7 +1,7 @@
 
 rnfail044.hs:5:12:
-    Ambiguous occurrence ‛splitAt’
-    It could refer to either ‛A.splitAt’, defined at rnfail044.hs:8:3
-                          or ‛Data.List.splitAt’,
-                             imported from ‛Prelude’ at rnfail044.hs:5:8
-                             (and originally defined in ‛GHC.List’)
+    Ambiguous occurrence ‘splitAt’
+    It could refer to either ‘A.splitAt’, defined at rnfail044.hs:8:3
+                          or ‘Data.List.splitAt’,
+                             imported from ‘Prelude’ at rnfail044.hs:5:8
+                             (and originally defined in ‘GHC.List’)
diff --git a/testsuite/tests/rename/should_fail/rnfail045.stderr b/testsuite/tests/rename/should_fail/rnfail045.stderr
index 9cba624ac315..52069f567c84 100644
--- a/testsuite/tests/rename/should_fail/rnfail045.stderr
+++ b/testsuite/tests/rename/should_fail/rnfail045.stderr
@@ -1,10 +1,10 @@
 
 rnfail045.hs:5:1:
-    Equations for ‛op1’ have different numbers of arguments
+    Equations for ‘op1’ have different numbers of arguments
       rnfail045.hs:5:1-16
       rnfail045.hs:6:1-13
 
 rnfail045.hs:8:1:
-    Equations for ‛op2’ have different numbers of arguments
+    Equations for ‘op2’ have different numbers of arguments
       rnfail045.hs:8:1-13
       rnfail045.hs:9:1-16
diff --git a/testsuite/tests/rename/should_fail/rnfail048.stderr b/testsuite/tests/rename/should_fail/rnfail048.stderr
index 7dd35d12a329..64955c398241 100644
--- a/testsuite/tests/rename/should_fail/rnfail048.stderr
+++ b/testsuite/tests/rename/should_fail/rnfail048.stderr
@@ -1,6 +1,6 @@
 
 rnfail048.hs:11:12:
-    Duplicate INLINE pragmas for ‛foo’
+    Duplicate INLINE pragmas for ‘foo’
     at rnfail048.hs:6:17-19
        rnfail048.hs:7:18-20
        rnfail048.hs:8:14-16
diff --git a/testsuite/tests/rename/should_fail/rnfail049.stderr b/testsuite/tests/rename/should_fail/rnfail049.stderr
index 8f08407ac24b..8fab0fef8b72 100644
--- a/testsuite/tests/rename/should_fail/rnfail049.stderr
+++ b/testsuite/tests/rename/should_fail/rnfail049.stderr
@@ -1,2 +1,2 @@
 
-rnfail049.hs:12:49: Not in scope: ‛f’
+rnfail049.hs:12:49: Not in scope: ‘f’
diff --git a/testsuite/tests/rename/should_fail/rnfail050.stderr b/testsuite/tests/rename/should_fail/rnfail050.stderr
index bbd122543810..61e0b4364014 100644
--- a/testsuite/tests/rename/should_fail/rnfail050.stderr
+++ b/testsuite/tests/rename/should_fail/rnfail050.stderr
@@ -1,2 +1,2 @@
 
-rnfail050.hs:10:37: Not in scope: ‛f’
+rnfail050.hs:10:37: Not in scope: ‘f’
diff --git a/testsuite/tests/rename/should_fail/rnfail053.stderr b/testsuite/tests/rename/should_fail/rnfail053.stderr
index 183c8a72ec45..a6d88d2a42e8 100644
--- a/testsuite/tests/rename/should_fail/rnfail053.stderr
+++ b/testsuite/tests/rename/should_fail/rnfail053.stderr
@@ -1,4 +1,4 @@
 
 rnfail053.hs:5:10:
-    Not a data constructor: ‛forall’
+    Not a data constructor: ‘forall’
     Perhaps you intended to use ExistentialQuantification
diff --git a/testsuite/tests/rename/should_fail/rnfail054.stderr b/testsuite/tests/rename/should_fail/rnfail054.stderr
index ef5b6d55b00a..edfac8a1c84c 100644
--- a/testsuite/tests/rename/should_fail/rnfail054.stderr
+++ b/testsuite/tests/rename/should_fail/rnfail054.stderr
@@ -1,5 +1,5 @@
 
 rnfail054.hs:6:13:
-    ‛foo’ is not a record selector
+    ‘foo’ is not a record selector
     In the expression: x {foo = 1}
-    In an equation for ‛foo’: foo x = x {foo = 1}
+    In an equation for ‘foo’: foo x = x {foo = 1}
diff --git a/testsuite/tests/rename/should_fail/rnfail055.stderr b/testsuite/tests/rename/should_fail/rnfail055.stderr
index 3a3eb04b011f..c7b51a1d1f45 100644
--- a/testsuite/tests/rename/should_fail/rnfail055.stderr
+++ b/testsuite/tests/rename/should_fail/rnfail055.stderr
@@ -6,35 +6,38 @@ RnFail055.hs-boot:1:73: Warning:
     -XDatatypeContexts is deprecated: It was widely considered a misfeature, and has been removed from the Haskell language.
 
 RnFail055.hs-boot:4:1:
-    Identifier ‛f1’ has conflicting definitions in the module
+    Identifier ‘f1’ has conflicting definitions in the module
     and its hs-boot file
     Main module: f1 :: Int -> Float
     Boot file:   f1 :: Float -> Int
 
 RnFail055.hs-boot:6:1:
-    Type constructor ‛S1’ has conflicting definitions in the module
+    Type constructor ‘S1’ has conflicting definitions in the module
     and its hs-boot file
     Main module: type S1 a b = (a, b)
     Boot file:   type S1 a b c = (a, b)
 
 RnFail055.hs-boot:8:1:
-    Type constructor ‛S2’ has conflicting definitions in the module
+    Type constructor ‘S2’ has conflicting definitions in the module
     and its hs-boot file
-    Main module: type S2 a b = forall a. (a, b)
-    Boot file:   type S2 a b = forall b. (a, b)
+    Main module: type S2 a b = forall a1. (a1, b)
+    Boot file:   type S2 a b = forall b1. (a, b1)
 
 RnFail055.hs-boot:12:1:
-    Type constructor ‛T1’ has conflicting definitions in the module
+    Type constructor ‘T1’ has conflicting definitions in the module
     and its hs-boot file
     Main module: data T1 a b = T1 [b] [a]
     Boot file:   data T1 a b = T1 [a] [b]
 
 RnFail055.hs-boot:14:1:
-    Type constructor ‛T2’ has conflicting definitions in the module
+    Type constructor ‘T2’ has conflicting definitions in the module
     and its hs-boot file
-    Main module: type role T2 representational phantom
-                 data Eq b => T2 a b = T2 a
-    Boot file:   data Eq a => T2 a b = T2 a
+    Main module: type role T2 representational nominal
+                 data Eq b => T2 a b
+                   = T2 a
+    Boot file:   type role T2 nominal representational
+                 data Eq a => T2 a b
+                   = T2 a
 
 RnFail055.hs-boot:16:11:
     T3 is exported by the hs-boot file, but not exported by the module
@@ -43,30 +46,30 @@ RnFail055.hs-boot:17:12:
     T3' is exported by the hs-boot file, but not exported by the module
 
 RnFail055.hs-boot:21:1:
-    Type constructor ‛T5’ has conflicting definitions in the module
+    Type constructor ‘T5’ has conflicting definitions in the module
     and its hs-boot file
     Main module: data T5 a = T5 {field5 :: a}
     Boot file:   data T5 a = T5 a
 
 RnFail055.hs-boot:23:1:
-    Type constructor ‛T6’ has conflicting definitions in the module
+    Type constructor ‘T6’ has conflicting definitions in the module
     and its hs-boot file
     Main module: data T6 = T6 Int
     Boot file:   data T6 = T6 !Int
 
 RnFail055.hs-boot:25:1:
-    Type constructor ‛T7’ has conflicting definitions in the module
+    Type constructor ‘T7’ has conflicting definitions in the module
     and its hs-boot file
     Main module: type role T7 phantom
                  data T7 a where
-                   T7 :: a -> T7 a
+                   T7 :: a1 -> T7 a
     Boot file:   data T7 a = T7 a
 
 RnFail055.hs-boot:27:22:
     RnFail055.m1 is exported by the hs-boot file, but not exported by the module
 
 RnFail055.hs-boot:28:1:
-    Class ‛C2’ has conflicting definitions in the module
+    Class ‘C2’ has conflicting definitions in the module
     and its hs-boot file
     Main module: class C2 a b where
                    m2 :: a -> b
@@ -75,7 +78,7 @@ RnFail055.hs-boot:28:1:
                    m2 :: a -> b
 
 RnFail055.hs-boot:29:1:
-    Class ‛C3’ has conflicting definitions in the module
+    Class ‘C3’ has conflicting definitions in the module
     and its hs-boot file
     Main module: class (Eq a, Ord a) => C3 a
     Boot file:   class (Ord a, Eq a) => C3 a
diff --git a/testsuite/tests/rename/should_fail/rnfail057.stderr b/testsuite/tests/rename/should_fail/rnfail057.stderr
index 682365654d95..aaeb29dc4fca 100644
--- a/testsuite/tests/rename/should_fail/rnfail057.stderr
+++ b/testsuite/tests/rename/should_fail/rnfail057.stderr
@@ -1,3 +1,3 @@
 
 rnfail057.hs:5:16:
-    Not in scope: type constructor or class ‛DontExistKind’
+    Not in scope: type constructor or class ‘DontExistKind’
diff --git a/testsuite/tests/roles/should_compile/Roles1.stderr b/testsuite/tests/roles/should_compile/Roles1.stderr
index e1808e8b2b1c..96d5603bbf5e 100644
--- a/testsuite/tests/roles/should_compile/Roles1.stderr
+++ b/testsuite/tests/roles/should_compile/Roles1.stderr
@@ -1,54 +1,20 @@
 TYPE SIGNATURES
 TYPE CONSTRUCTORS
-  T1 :: * -> *
-  data T1 a
-      No C type associated
-      Roles: [nominal]
-      RecFlag NonRecursive, Promotable
-      = K1 :: forall a. a -> T1 a Stricts: _
-      FamilyInstance: none
-  T2 :: * -> *
-  data T2 a
-      No C type associated
-      Roles: [representational]
-      RecFlag NonRecursive, Promotable
-      = K2 :: forall a. a -> T2 a Stricts: _
-      FamilyInstance: none
-  T3 :: k -> *
-  data T3 (k::BOX) (a::k)
-      No C type associated
-      Roles: [nominal, phantom]
-      RecFlag NonRecursive, Not promotable
-      = K3 :: forall (k::BOX) (a::k). T3 k a
-      FamilyInstance: none
-  T4 :: (* -> *) -> * -> *
-  data T4 (a::* -> *) b
-      No C type associated
-      Roles: [nominal, nominal]
-      RecFlag NonRecursive, Not promotable
-      = K4 :: forall (a::* -> *) b. (a b) -> T4 a b Stricts: _
-      FamilyInstance: none
-  T5 :: * -> *
-  data T5 a
-      No C type associated
-      Roles: [representational]
-      RecFlag NonRecursive, Promotable
-      = K5 :: forall a. a -> T5 a Stricts: _
-      FamilyInstance: none
-  T6 :: k -> *
-  data T6 (k::BOX) (a::k)
-      No C type associated
-      Roles: [nominal, phantom]
-      RecFlag NonRecursive, Not promotable
-      = K6 :: forall (k::BOX) (a::k). T6 k a
-      FamilyInstance: none
-  T7 :: k -> * -> *
-  data T7 (k::BOX) (a::k) b
-      No C type associated
-      Roles: [nominal, phantom, representational]
-      RecFlag NonRecursive, Not promotable
-      = K7 :: forall (k::BOX) (a::k) b. b -> T7 k a b Stricts: _
-      FamilyInstance: none
+  type role T1 nominal
+  data T1 a = K1 a
+    Promotable
+  data T2 a = K2 a
+    Promotable
+  type role T3 phantom
+  data T3 (a :: k) = K3
+  type role T4 nominal nominal
+  data T4 (a :: * -> *) b = K4 (a b)
+  data T5 a = K5 a
+    Promotable
+  type role T6 phantom
+  data T6 (a :: k) = K6
+  type role T7 phantom representational
+  data T7 (a :: k) b = K7 b
 COERCION AXIOMS
 Dependent modules: []
 Dependent packages: [base, ghc-prim, integer-gmp]
diff --git a/testsuite/tests/roles/should_compile/Roles13.stderr b/testsuite/tests/roles/should_compile/Roles13.stderr
index 647e59ba51dd..b0dda24f2c70 100644
--- a/testsuite/tests/roles/should_compile/Roles13.stderr
+++ b/testsuite/tests/roles/should_compile/Roles13.stderr
@@ -13,8 +13,7 @@ Roles13.convert =
   `cast` (<Roles13.Wrap Roles13.Age>_R
           -> Roles13.NTCo:Wrap[0] Roles13.NTCo:Age[0]
           :: (Roles13.Wrap Roles13.Age -> Roles13.Wrap Roles13.Age)
-               ~#
-             (Roles13.Wrap Roles13.Age -> GHC.Types.Int))
+             ~R# (Roles13.Wrap Roles13.Age -> GHC.Types.Int))
 
 
 
diff --git a/testsuite/tests/roles/should_compile/Roles14.hs b/testsuite/tests/roles/should_compile/Roles14.hs
new file mode 100644
index 000000000000..121aad7b874b
--- /dev/null
+++ b/testsuite/tests/roles/should_compile/Roles14.hs
@@ -0,0 +1,7 @@
+{-# LANGUAGE RoleAnnotations, IncoherentInstances #-}
+
+module Roles12 where
+
+type role C2 representational
+class C2 a where
+  meth2 :: a -> a
diff --git a/testsuite/tests/roles/should_compile/Roles14.stderr b/testsuite/tests/roles/should_compile/Roles14.stderr
new file mode 100644
index 000000000000..e0f26a14d327
--- /dev/null
+++ b/testsuite/tests/roles/should_compile/Roles14.stderr
@@ -0,0 +1,12 @@
+TYPE SIGNATURES
+TYPE CONSTRUCTORS
+  type role C2 representational
+  class C2 a where
+    meth2 :: a -> a
+COERCION AXIOMS
+  axiom Roles12.NTCo:C2 :: C2 a = a -> a
+Dependent modules: []
+Dependent packages: [base, ghc-prim, integer-gmp]
+
+==================== Typechecker ====================
+
diff --git a/testsuite/tests/roles/should_compile/Roles2.stderr b/testsuite/tests/roles/should_compile/Roles2.stderr
index ac7a94bbfa21..2c7ab6c66f96 100644
--- a/testsuite/tests/roles/should_compile/Roles2.stderr
+++ b/testsuite/tests/roles/should_compile/Roles2.stderr
@@ -1,19 +1,8 @@
 TYPE SIGNATURES
 TYPE CONSTRUCTORS
-  T1 :: * -> *
-  data T1 a
-      No C type associated
-      Roles: [representational]
-      RecFlag NonRecursive, Not promotable
-      = K1 :: forall a. (IO a) -> T1 a Stricts: _
-      FamilyInstance: none
-  T2 :: * -> *
-  data T2 a
-      No C type associated
-      Roles: [representational]
-      RecFlag NonRecursive, Not promotable
-      = K2 :: forall a. (FunPtr a) -> T2 a Stricts: _
-      FamilyInstance: none
+  data T1 a = K1 (IO a)
+  type role T2 phantom
+  data T2 a = K2 (FunPtr a)
 COERCION AXIOMS
 Dependent modules: []
 Dependent packages: [base, ghc-prim, integer-gmp]
diff --git a/testsuite/tests/roles/should_compile/Roles3.stderr b/testsuite/tests/roles/should_compile/Roles3.stderr
index 62eb2a94746d..270afca9cd83 100644
--- a/testsuite/tests/roles/should_compile/Roles3.stderr
+++ b/testsuite/tests/roles/should_compile/Roles3.stderr
@@ -1,31 +1,16 @@
 TYPE SIGNATURES
 TYPE CONSTRUCTORS
-  C1 :: * -> Constraint
-  class C1 a
-    Roles: [nominal]
-    RecFlag NonRecursive
+  class C1 a where
     meth1 :: a -> a
-  C2 :: * -> * -> Constraint
-  class C2 a b
-    Roles: [nominal, nominal]
-    RecFlag NonRecursive
-    meth2 :: (~) * a b -> a -> b
-  C3 :: * -> * -> Constraint
-  class C3 a b
-    Roles: [nominal, nominal]
-    RecFlag NonRecursive
-    type family F3 b :: * (open)
+  class C2 a b where
+    meth2 :: a ~ b => a -> b
+  class C3 a b where
+    type family F3 b :: * open
     meth3 :: a -> F3 b -> F3 b
-  C4 :: * -> * -> Constraint
-  class C4 a b
-    Roles: [nominal, nominal]
-    RecFlag NonRecursive
+  class C4 a b where
     meth4 :: a -> F4 b -> F4 b
-  F4 :: * -> *
-  type family F4 a :: * (open)
-  Syn1 :: * -> *
+  type family F4 a :: * open
   type Syn1 a = F4 a
-  Syn2 :: * -> *
   type Syn2 a = [a]
 COERCION AXIOMS
   axiom Roles3.NTCo:C1 :: C1 a = a -> a
diff --git a/testsuite/tests/roles/should_compile/Roles4.hs b/testsuite/tests/roles/should_compile/Roles4.hs
index b5c404a84c7a..d7aa78f7b7f0 100644
--- a/testsuite/tests/roles/should_compile/Roles4.hs
+++ b/testsuite/tests/roles/should_compile/Roles4.hs
@@ -6,10 +6,6 @@ type role C1 nominal
 class C1 a where
   meth1 :: a -> a
 
-type role C2 representational
-class C2 a where
-  meth2 :: a -> a
-
 type Syn1 a = [a]
 
 class C3 a where
diff --git a/testsuite/tests/roles/should_compile/Roles4.stderr b/testsuite/tests/roles/should_compile/Roles4.stderr
index e69b8525dc52..f2b590fadd3f 100644
--- a/testsuite/tests/roles/should_compile/Roles4.stderr
+++ b/testsuite/tests/roles/should_compile/Roles4.stderr
@@ -1,25 +1,12 @@
 TYPE SIGNATURES
 TYPE CONSTRUCTORS
-  C1 :: * -> Constraint
-  class C1 a
-    Roles: [nominal]
-    RecFlag NonRecursive
+  class C1 a where
     meth1 :: a -> a
-  C2 :: * -> Constraint
-  class C2 a
-    Roles: [representational]
-    RecFlag NonRecursive
-    meth2 :: a -> a
-  C3 :: * -> Constraint
-  class C3 a
-    Roles: [nominal]
-    RecFlag NonRecursive
+  class C3 a where
     meth3 :: a -> Syn1 a
-  Syn1 :: * -> *
   type Syn1 a = [a]
 COERCION AXIOMS
   axiom Roles4.NTCo:C1 :: C1 a = a -> a
-  axiom Roles4.NTCo:C2 :: C2 a = a -> a
   axiom Roles4.NTCo:C3 :: C3 a = a -> Syn1 a
 Dependent modules: []
 Dependent packages: [base, ghc-prim, integer-gmp]
diff --git a/testsuite/tests/roles/should_compile/T8958.hs b/testsuite/tests/roles/should_compile/T8958.hs
new file mode 100644
index 000000000000..b3c2910e2ec7
--- /dev/null
+++ b/testsuite/tests/roles/should_compile/T8958.hs
@@ -0,0 +1,13 @@
+{-# LANGUAGE RoleAnnotations, DatatypeContexts, IncoherentInstances,
+             FlexibleInstances #-}
+
+module T8958 where
+
+class Nominal a
+instance Nominal a
+
+class Representational a
+instance Representational a
+type role Representational representational
+
+newtype (Nominal k, Representational v) => Map k v = MkMap [(k,v)]
diff --git a/testsuite/tests/roles/should_compile/T8958.stderr b/testsuite/tests/roles/should_compile/T8958.stderr
new file mode 100644
index 000000000000..b53df162a870
--- /dev/null
+++ b/testsuite/tests/roles/should_compile/T8958.stderr
@@ -0,0 +1,40 @@
+
+T8958.hs:1:31: Warning:
+    -XDatatypeContexts is deprecated: It was widely considered a misfeature, and has been removed from the Haskell language.
+TYPE SIGNATURES
+TYPE CONSTRUCTORS
+  type role Map nominal representational
+  newtype (Nominal k, Representational v) => Map k v = MkMap [(k, v)]
+    Promotable
+  class Nominal a
+  type role Representational representational
+  class Representational a
+COERCION AXIOMS
+  axiom T8958.NTCo:Map :: Map k v = [(k, v)]
+INSTANCES
+  instance [incoherent] Nominal a -- Defined at T8958.hs:7:10
+  instance [incoherent] Representational a
+    -- Defined at T8958.hs:10:10
+Dependent modules: []
+Dependent packages: [base, ghc-prim, integer-gmp]
+
+==================== Typechecker ====================
+AbsBinds [a] []
+  {Exports: [T8958.$fRepresentationala <= $dRepresentational
+               <>]
+   Exported types: T8958.$fRepresentationala [InlPrag=[ALWAYS] CONLIKE]
+                     :: forall a. Representational a
+                   [LclIdX[DFunId],
+                    Str=DmdType,
+                    Unf=DFun: \ (@ a) -> T8958.D:Representational TYPE a]
+   Binds: $dRepresentational = T8958.D:Representational}
+AbsBinds [a] []
+  {Exports: [T8958.$fNominala <= $dNominal
+               <>]
+   Exported types: T8958.$fNominala [InlPrag=[ALWAYS] CONLIKE]
+                     :: forall a. Nominal a
+                   [LclIdX[DFunId],
+                    Str=DmdType,
+                    Unf=DFun: \ (@ a) -> T8958.D:Nominal TYPE a]
+   Binds: $dNominal = T8958.D:Nominal}
+
diff --git a/testsuite/tests/roles/should_compile/all.T b/testsuite/tests/roles/should_compile/all.T
index 266a260f093d..681092bd484b 100644
--- a/testsuite/tests/roles/should_compile/all.T
+++ b/testsuite/tests/roles/should_compile/all.T
@@ -1,6 +1,8 @@
-test('Roles1', only_ways('normal'), compile, ['-ddump-tc'])
-test('Roles2', only_ways('normal'), compile, ['-ddump-tc'])
+test('Roles1', only_ways('normal'), compile, ['-ddump-tc -fprint-explicit-foralls'])
+test('Roles2', only_ways('normal'), compile, ['-ddump-tc -fprint-explicit-foralls'])
 test('Roles3', only_ways('normal'), compile, ['-ddump-tc'])
 test('Roles4', only_ways('normal'), compile, ['-ddump-tc'])
 test('Roles13', only_ways('normal'), compile, ['-ddump-simpl -dsuppress-uniques'])
-test('RolesIArray', only_ways('normal'), compile, [''])
\ No newline at end of file
+test('Roles14', only_ways('normal'), compile, ['-ddump-tc'])
+test('RolesIArray', only_ways('normal'), compile, [''])
+test('T8958', only_ways('normal'), compile, ['-ddump-tc -dsuppress-uniques'])
diff --git a/testsuite/tests/roles/should_fail/Roles10.stderr b/testsuite/tests/roles/should_fail/Roles10.stderr
index 1c636580b9f6..21022982699a 100644
--- a/testsuite/tests/roles/should_fail/Roles10.stderr
+++ b/testsuite/tests/roles/should_fail/Roles10.stderr
@@ -1,9 +1,9 @@
 
 Roles10.hs:16:12:
-    Could not coerce from ‛Bool’ to ‛Char’
-      because ‛Bool’ and ‛Char’ are different types.
-      arising from the coercion of the method ‛meth’ from type
-                   ‛Int -> F Int’ to type ‛Age -> F Age’
+    Could not coerce from ‘Bool’ to ‘Char’
+      because ‘Bool’ and ‘Char’ are different types.
+      arising from the coercion of the method ‘meth’ from type
+                   ‘Int -> F Int’ to type ‘Age -> F Age’
     Possible fix:
       use a standalone 'deriving instance' declaration,
         so you can specify the instance context yourself
diff --git a/testsuite/tests/roles/should_fail/Roles11.stderr b/testsuite/tests/roles/should_fail/Roles11.stderr
index 55ef3bdd5ba3..1fa09997c548 100644
--- a/testsuite/tests/roles/should_fail/Roles11.stderr
+++ b/testsuite/tests/roles/should_fail/Roles11.stderr
@@ -2,4 +2,4 @@
 Roles11.hs:5:1:
     Role mismatch on variable a:
       Annotation says representational but role nominal is required
-    while checking a role annotation for ‛T2’
+    while checking a role annotation for ‘T2’
diff --git a/testsuite/tests/roles/should_fail/Roles12.stderr b/testsuite/tests/roles/should_fail/Roles12.stderr
index fd986b66fc9a..9b0f2cfdb5e1 100644
--- a/testsuite/tests/roles/should_fail/Roles12.stderr
+++ b/testsuite/tests/roles/should_fail/Roles12.stderr
@@ -1,7 +1,7 @@
 
 Roles12.hs:5:1:
-    Type constructor ‛T’ has conflicting definitions in the module
+    Type constructor ‘T’ has conflicting definitions in the module
     and its hs-boot file
     Main module: type role T phantom
                  data T a
-    Boot file:   data T a
+    Boot file:   abstract T a
diff --git a/testsuite/tests/roles/should_fail/Roles5.stderr b/testsuite/tests/roles/should_fail/Roles5.stderr
index 20172ff2600a..cb79845a5591 100644
--- a/testsuite/tests/roles/should_fail/Roles5.stderr
+++ b/testsuite/tests/roles/should_fail/Roles5.stderr
@@ -2,12 +2,12 @@
 Roles5.hs:7:1:
     Illegal role annotation for T;
     did you intend to use RoleAnnotations?
-    while checking a role annotation for ‛T’
+    while checking a role annotation for ‘T’
 
 Roles5.hs:8:1:
     Illegal role annotation for C;
     did you intend to use RoleAnnotations?
-    while checking a role annotation for ‛C’
+    while checking a role annotation for ‘C’
 
 Roles5.hs:9:1:
     Illegal role annotation for S;
diff --git a/testsuite/tests/roles/should_fail/Roles6.stderr b/testsuite/tests/roles/should_fail/Roles6.stderr
index 9f09ab35284d..91bcce99c8c5 100644
--- a/testsuite/tests/roles/should_fail/Roles6.stderr
+++ b/testsuite/tests/roles/should_fail/Roles6.stderr
@@ -3,4 +3,4 @@ Roles6.hs:7:1:
     Wrong number of roles listed in role annotation;
     Expected 2, got 3:
       type role Foo nominal representational phantom
-    while checking a role annotation for ‛Foo’
+    while checking a role annotation for ‘Foo’
diff --git a/testsuite/tests/roles/should_fail/Roles7.stderr b/testsuite/tests/roles/should_fail/Roles7.stderr
index e4774f1aa840..ae62543e288d 100644
--- a/testsuite/tests/roles/should_fail/Roles7.stderr
+++ b/testsuite/tests/roles/should_fail/Roles7.stderr
@@ -1,4 +1,4 @@
 
 Roles7.hs:6:15:
-    Illegal role name ‛repesentational’
-    Perhaps you meant ‛representational’
+    Illegal role name ‘repesentational’
+    Perhaps you meant ‘representational’
diff --git a/testsuite/tests/roles/should_fail/Roles8.stderr b/testsuite/tests/roles/should_fail/Roles8.stderr
index 22f66f466771..5f2152794232 100644
--- a/testsuite/tests/roles/should_fail/Roles8.stderr
+++ b/testsuite/tests/roles/should_fail/Roles8.stderr
@@ -1,10 +1,10 @@
 
 Roles8.hs:7:1:
-    Duplicate role annotations for ‛T1’:
+    Duplicate role annotations for ‘T1’:
       type role T1 nominal -- written at Roles8.hs:7:1-20
       type role T1 nominal -- written at Roles8.hs:8:1-20
 
 Roles8.hs:12:1:
-    Duplicate role annotations for ‛T2’:
+    Duplicate role annotations for ‘T2’:
       type role T2 representational -- written at Roles8.hs:12:1-29
       type role T2 phantom -- written at Roles8.hs:13:1-20
diff --git a/testsuite/tests/roles/should_fail/Roles9.stderr b/testsuite/tests/roles/should_fail/Roles9.stderr
index 0cd02f9b5f77..e9f824b8ce31 100644
--- a/testsuite/tests/roles/should_fail/Roles9.stderr
+++ b/testsuite/tests/roles/should_fail/Roles9.stderr
@@ -1,7 +1,7 @@
 
 Roles9.hs:13:12:
-    Can't make a derived instance of ‛C Age’
+    Can't make a derived instance of ‘C Age’
       (even with cunning newtype deriving):
       it is not type-safe to use GeneralizedNewtypeDeriving on this class;
-      the last parameter of ‛C’ is at role Nominal
-    In the newtype declaration for ‛Age’
+      the last parameter of ‘C’ is at role Nominal
+    In the newtype declaration for ‘Age’
diff --git a/testsuite/tests/roles/should_fail/T8773.hs b/testsuite/tests/roles/should_fail/T8773.hs
new file mode 100644
index 000000000000..d0984b40eb40
--- /dev/null
+++ b/testsuite/tests/roles/should_fail/T8773.hs
@@ -0,0 +1,7 @@
+{-# LANGUAGE RoleAnnotations #-}
+
+module T8773 where
+
+type role C2 representational
+class C2 a where
+  meth2 :: a -> a
diff --git a/testsuite/tests/roles/should_fail/T8773.stderr b/testsuite/tests/roles/should_fail/T8773.stderr
new file mode 100644
index 000000000000..fac02f30d10d
--- /dev/null
+++ b/testsuite/tests/roles/should_fail/T8773.stderr
@@ -0,0 +1,5 @@
+
+T8773.hs:5:1:
+    Roles other than ‘nominal’ for class parameters can lead to incoherence.
+    Use IncoherentInstances to allow this; bad role found
+    while checking a role annotation for ‘C2’
diff --git a/testsuite/tests/roles/should_fail/all.T b/testsuite/tests/roles/should_fail/all.T
index 0e30472b096d..d0d5c4d17c28 100644
--- a/testsuite/tests/roles/should_fail/all.T
+++ b/testsuite/tests/roles/should_fail/all.T
@@ -7,3 +7,4 @@ test('Roles11', normal, compile_fail, [''])
 test('Roles12',
      extra_clean(['Roles12.o-boot', 'Roles12.hi-boot']),
      run_command, ['$MAKE --no-print-directory -s Roles12'])
+test('T8773', normal, compile_fail, [''])
\ No newline at end of file
diff --git a/testsuite/tests/rts/Makefile b/testsuite/tests/rts/Makefile
index d506d3a1ced9..02a50a4644fa 100644
--- a/testsuite/tests/rts/Makefile
+++ b/testsuite/tests/rts/Makefile
@@ -84,6 +84,9 @@ T5435_dyn_asm :
 T6006_setup :
 	'$(TEST_HC)' $(TEST_HC_OPTS) -c T6006.hs
 
+T8124_setup :
+	'$(TEST_HC)' $(TEST_HC_OPTS) -c T8124.hs
+
 ifeq "$(TARGETPLATFORM)" "i386-unknown-mingw32"
 T7037_CONST = const
 else
@@ -105,7 +108,11 @@ BASE_DIR = $(shell $(LOCAL_GHC_PKG) field base library-dirs | sed 's/^.*: *//')
 BASE_LIB = $(shell $(LOCAL_GHC_PKG) field base hs-libraries | sed 's/^.*: *//')
 GHC_PRIM_DIR = $(shell $(LOCAL_GHC_PKG) field ghc-prim library-dirs | sed 's/^.*: *//')
 GHC_PRIM_LIB = $(shell $(LOCAL_GHC_PKG) field ghc-prim hs-libraries | sed 's/^.*: *//')
-INTEGER_GMP_DIR = $(shell $(LOCAL_GHC_PKG) field integer-gmp library-dirs | sed 's/^.*: *//')
+# We need to get first library directory here in order to get rid of
+# system gmp library directory installation when ghc is configured
+# with --with-gmp-libraries=<dir> parameter
+INTEGER_GMP_DIR = $(shell $(LOCAL_GHC_PKG) field integer-gmp library-dirs \
+	| sed 's/^.*: *//' | head -1)
 INTEGER_GMP_LIB = $(shell $(LOCAL_GHC_PKG) field integer-gmp hs-libraries | sed 's/^.*: *//')
 
 BASE        = $(BASE_DIR)/lib$(BASE_LIB).a
diff --git a/testsuite/tests/rts/T8124.hs b/testsuite/tests/rts/T8124.hs
new file mode 100644
index 000000000000..c914b03ec5b4
--- /dev/null
+++ b/testsuite/tests/rts/T8124.hs
@@ -0,0 +1,6 @@
+module T8124 where
+
+f :: Int -> Int
+f x = x + 1
+
+foreign export ccall "f" f :: Int -> Int
diff --git a/testsuite/tests/rts/T8124_c.c b/testsuite/tests/rts/T8124_c.c
new file mode 100644
index 000000000000..e7e8739ae1ea
--- /dev/null
+++ b/testsuite/tests/rts/T8124_c.c
@@ -0,0 +1,42 @@
+#include <stdlib.h>
+#include "T8124_stub.h"
+#include "HsFFI.h"
+#include <pthread.h>
+
+void *thread(void *param)
+{
+    f(3);
+    hs_thread_done();
+    pthread_exit(NULL);
+}
+
+int main (int argc, char *argv[])
+{
+    hs_init(&argc,&argv);
+
+    // check that we can call hs_thread_done() without having made any
+    // Haskell calls:
+    hs_thread_done();
+
+    // check that we can call hs_thread_done() and then make another Haskell
+    // call:
+    int i;
+    for (i=0; i < 1000; i++) {
+        f(3);
+        hs_thread_done();
+    }
+
+    // check that we can call hs_thread_done() twice:
+    hs_thread_done();
+    hs_thread_done();
+
+    // check that hs_thread_done() from child threads works:
+    pthread_t pid;
+    for (i=0; i < 1000; i++) {
+        pthread_create(&pid, NULL, thread, NULL);
+        pthread_join(pid, NULL);
+    }
+
+    hs_exit();
+    exit(0);
+}
diff --git a/testsuite/tests/rts/T9045.hs b/testsuite/tests/rts/T9045.hs
new file mode 100644
index 000000000000..1e581efa3585
--- /dev/null
+++ b/testsuite/tests/rts/T9045.hs
@@ -0,0 +1,22 @@
+-- This is nofib/smp/threads006.  It fails in GHC 7.8.2 with a GC crash.
+
+{-# OPTIONS_GHC -O2 #-}
+import System.IO
+import System.Environment
+import System.CPUTime
+import Text.Printf
+import Control.Monad
+import Control.Concurrent
+import Control.Concurrent.MVar
+import Control.Exception
+
+main :: IO ()
+main = do
+    hSetBuffering stdout NoBuffering
+    [nthreads] <- fmap (map read) getArgs
+    tids <- replicateM nthreads . mask $ \_ -> forkIO $ return ()
+    m <- newEmptyMVar
+    -- do it in a subthread to avoid bound-thread overhead
+    forkIO $ do mapM_ killThread tids; putMVar m ()
+    takeMVar m
+    return ()
diff --git a/testsuite/tests/rts/T9078.hs b/testsuite/tests/rts/T9078.hs
new file mode 100644
index 000000000000..d0389f1330b4
--- /dev/null
+++ b/testsuite/tests/rts/T9078.hs
@@ -0,0 +1,10 @@
+module Main where
+
+import Control.Monad
+import System.Mem.StableName
+
+main :: IO ()
+main = replicateM_ 500000 (makeStableName foo)
+
+foo :: Int
+foo = 1
diff --git a/testsuite/tests/rts/T9078.stderr b/testsuite/tests/rts/T9078.stderr
new file mode 100644
index 000000000000..901a1ca49cc3
--- /dev/null
+++ b/testsuite/tests/rts/T9078.stderr
@@ -0,0 +1,2 @@
+cap 0: initialised
+cap 0: shutting down
diff --git a/testsuite/tests/rts/all.T b/testsuite/tests/rts/all.T
index dfa0e89801eb..d7c74c5847b5 100644
--- a/testsuite/tests/rts/all.T
+++ b/testsuite/tests/rts/all.T
@@ -130,13 +130,28 @@ test('T5423',
      run_command,
      ['$MAKE -s --no-print-directory T5423'])
 
+# Workaround bug #8458: old dlopen opens sections in the wrong order,
+# so we just accept both orders.
+def checkDynAsm(actual_file, normaliser):
+    actual_raw = read_no_crs(actual_file)
+    actual_str = normaliser(actual_raw)
+    actual = actual_str.split()
+    if actual == ['initArray1', 'initArray2', 'ctors1', 'ctors2', 'success']:
+        return 1
+    elif actual == ['ctors1', 'ctors2', 'initArray1', 'initArray2', 'success']:
+        if_verbose(1, 'T5435_dyn_asm detected old-style dlopen, see #8458')
+        return 1
+    else:
+        if_verbose(1, 'T5435_dyn_asm failed with %s, see all.T for details' % actual)
+        return 0
+
 # These should have extra_clean() arguments, but I need
 # to somehow extract out the name of DLLs to do that
 
 test('T5435_v_asm', normal, run_command, ['$MAKE -s --no-print-directory T5435_v_asm'])
 test('T5435_v_gcc', normal, run_command, ['$MAKE -s --no-print-directory T5435_v_gcc'])
-test('T5435_dyn_asm', normal, run_command, ['$MAKE -s --no-print-directory T5435_dyn_asm'])
-test('T5435_dyn_gcc', normal, run_command, ['$MAKE -s --no-print-directory T5435_dyn_gcc'])
+test('T5435_dyn_asm', check_stdout(checkDynAsm), run_command, ['$MAKE -s --no-print-directory T5435_dyn_asm'])
+test('T5435_dyn_gcc', normal , run_command, ['$MAKE -s --no-print-directory T5435_dyn_gcc'])
 
 test('T5993', extra_run_opts('+RTS -k8 -RTS'), compile_and_run, [''])
 
@@ -199,3 +214,24 @@ test('T8209', [ only_ways(threaded_ways), ignore_output ],
 
 test('T8242', [ only_ways(threaded_ways), ignore_output ],
               compile_and_run, [''])
+
+test('T8124', [ only_ways(threaded_ways), omit_ways(['ghci']),
+                 extra_clean(['T8124_c.o']),
+                 pre_cmd('$MAKE -s --no-print-directory T8124_setup') ],
+                 # The T8124_setup hack is to ensure that we generate
+                 # T8124_stub.h before compiling T8124_c.c, which
+                 # needs it.
+               compile_and_run, ['T8124_c.c -no-hs-main'])
+
+# +RTS -A8k makes it fail faster
+# The ghci way gets confused by the RTS options
+test('T9045', [ omit_ways(['ghci']), extra_run_opts('10000 +RTS -A8k -RTS') ], compile_and_run, [''])
+
+# I couldn't reproduce 9078 with the -threaded runtime, but could easily
+# with the non-threaded one.
+test('T9078', [ omit_ways(threaded_ways) ], compile_and_run, ['-with-rtsopts="-DS" -debug'])
+
+# 251 = RTS exit code for "out of memory"
+test('overflow1', [ exit_code(251) ], compile_and_run, [''])
+test('overflow2', [ exit_code(251) ], compile_and_run, [''])
+test('overflow3', [ exit_code(251) ], compile_and_run, [''])
diff --git a/testsuite/tests/rts/exec_signals_prepare.c b/testsuite/tests/rts/exec_signals_prepare.c
index 26f30acc57f5..2b01dd5d1c46 100644
--- a/testsuite/tests/rts/exec_signals_prepare.c
+++ b/testsuite/tests/rts/exec_signals_prepare.c
@@ -2,6 +2,7 @@
 #include <stdio.h>
 #include <errno.h>
 #include <string.h>
+#include <unistd.h>
 
 // Invokes a process, making sure that the state of the signal
 // handlers has all been set back to the unix default.
diff --git a/testsuite/tests/rts/linker_unload.c b/testsuite/tests/rts/linker_unload.c
index 55870c348f94..f1cc891df187 100644
--- a/testsuite/tests/rts/linker_unload.c
+++ b/testsuite/tests/rts/linker_unload.c
@@ -1,3 +1,4 @@
+#include "ghcconfig.h"
 #include <stdio.h>
 #include <stdlib.h>
 #include "Rts.h"
diff --git a/testsuite/tests/rts/overflow1.hs b/testsuite/tests/rts/overflow1.hs
new file mode 100644
index 000000000000..63ed5a4e0240
--- /dev/null
+++ b/testsuite/tests/rts/overflow1.hs
@@ -0,0 +1,11 @@
+module Main where
+
+import Data.Array.IO
+import Data.Word
+
+-- Try to overflow BLOCK_ROUND_UP in the computation of req_blocks in allocate()
+-- Here we invoke allocate() via newByteArray# and the array package.
+-- Request a number of bytes close to HS_WORD_MAX,
+-- subtracting a few words for overhead in newByteArray#.
+-- Allocate Word32s (rather than Word8s) to get around bounds-checking in array.
+main = newArray (0,maxBound `div` 4 - 10) 0 :: IO (IOUArray Word Word32)
diff --git a/testsuite/tests/rts/overflow1.stderr b/testsuite/tests/rts/overflow1.stderr
new file mode 100644
index 000000000000..734ca954cad5
--- /dev/null
+++ b/testsuite/tests/rts/overflow1.stderr
@@ -0,0 +1 @@
+overflow1: out of memory
diff --git a/testsuite/tests/rts/overflow2.hs b/testsuite/tests/rts/overflow2.hs
new file mode 100644
index 000000000000..ac72158f454a
--- /dev/null
+++ b/testsuite/tests/rts/overflow2.hs
@@ -0,0 +1,20 @@
+{-# LANGUAGE ForeignFunctionInterface #-}
+module Main where
+
+import Foreign
+
+-- Test allocate(), the easy way.
+data Cap = Cap
+foreign import ccall "rts_unsafeGetMyCapability" myCapability :: IO (Ptr Cap)
+foreign import ccall "allocate" allocate :: Ptr Cap -> Word -> IO (Ptr ())
+
+-- Number of words n such that n * sizeof(W_) exactly overflows a word
+-- (2^30 on a 32-bit system, 2^61 on a 64-bit system)
+overflowWordCount :: Word
+overflowWordCount = fromInteger $
+                    (fromIntegral (maxBound :: Word) + 1) `div`
+                    fromIntegral (sizeOf (undefined :: Word))
+
+main = do
+  cap <- myCapability
+  allocate cap (overflowWordCount - 1)
diff --git a/testsuite/tests/rts/overflow2.stderr b/testsuite/tests/rts/overflow2.stderr
new file mode 100644
index 000000000000..be65509ea928
--- /dev/null
+++ b/testsuite/tests/rts/overflow2.stderr
@@ -0,0 +1 @@
+overflow2: out of memory
diff --git a/testsuite/tests/rts/overflow3.hs b/testsuite/tests/rts/overflow3.hs
new file mode 100644
index 000000000000..31dfd5db53e7
--- /dev/null
+++ b/testsuite/tests/rts/overflow3.hs
@@ -0,0 +1,20 @@
+{-# LANGUAGE ForeignFunctionInterface #-}
+module Main where
+
+import Foreign
+
+-- Test allocate(), the easy way.
+data Cap = Cap
+foreign import ccall "rts_unsafeGetMyCapability" myCapability :: IO (Ptr Cap)
+foreign import ccall "allocate" allocate :: Ptr Cap -> Word -> IO (Ptr ())
+
+-- Number of words n such that n * sizeof(W_) exactly overflows a word
+-- (2^30 on a 32-bit system, 2^61 on a 64-bit system)
+overflowWordCount :: Word
+overflowWordCount = fromInteger $
+                    (fromIntegral (maxBound :: Word) + 1) `div`
+                    fromIntegral (sizeOf (undefined :: Word))
+
+main = do
+  cap <- myCapability
+  allocate cap (overflowWordCount + 1)
diff --git a/testsuite/tests/rts/overflow3.stderr b/testsuite/tests/rts/overflow3.stderr
new file mode 100644
index 000000000000..6c804e504896
--- /dev/null
+++ b/testsuite/tests/rts/overflow3.stderr
@@ -0,0 +1 @@
+overflow3: out of memory
diff --git a/testsuite/tests/safeHaskell/check/pkg01/ImpSafeOnly07.stderr b/testsuite/tests/safeHaskell/check/pkg01/ImpSafeOnly07.stderr
index a22386b7a843..43306a9eb7f3 100644
--- a/testsuite/tests/safeHaskell/check/pkg01/ImpSafeOnly07.stderr
+++ b/testsuite/tests/safeHaskell/check/pkg01/ImpSafeOnly07.stderr
@@ -3,4 +3,4 @@
     The package (base) is required to be trusted but it isn't!
 
 <no location info>:
-    The package (bytestring-0.10.1.0) is required to be trusted but it isn't!
+    The package (bytestring-0.10.4.0) is required to be trusted but it isn't!
diff --git a/testsuite/tests/safeHaskell/check/pkg01/ImpSafeOnly08.stderr b/testsuite/tests/safeHaskell/check/pkg01/ImpSafeOnly08.stderr
index a22386b7a843..43306a9eb7f3 100644
--- a/testsuite/tests/safeHaskell/check/pkg01/ImpSafeOnly08.stderr
+++ b/testsuite/tests/safeHaskell/check/pkg01/ImpSafeOnly08.stderr
@@ -3,4 +3,4 @@
     The package (base) is required to be trusted but it isn't!
 
 <no location info>:
-    The package (bytestring-0.10.1.0) is required to be trusted but it isn't!
+    The package (bytestring-0.10.4.0) is required to be trusted but it isn't!
diff --git a/testsuite/tests/safeHaskell/check/pkg01/safePkg01.stdout b/testsuite/tests/safeHaskell/check/pkg01/safePkg01.stdout
index 1308a312842b..a37dfa55a393 100644
--- a/testsuite/tests/safeHaskell/check/pkg01/safePkg01.stdout
+++ b/testsuite/tests/safeHaskell/check/pkg01/safePkg01.stdout
@@ -25,21 +25,21 @@ require own pkg trusted: True
 
 M_SafePkg5
 package dependencies: base* ghc-prim integer-gmp
-trusted: safe-inferred
+trusted: safe
 require own pkg trusted: True
 
 M_SafePkg6
-package dependencies: array-0.4.0.1 base* bytestring-0.10.1.0*
+package dependencies: array-0.5.0.0@array_H3W2D8UaI9TKGEhUuQHax2
 trusted: trustworthy
 require own pkg trusted: False
 
 M_SafePkg7
-package dependencies: array-0.4.0.1 base* bytestring-0.10.1.0*
+package dependencies: array-0.5.0.0@array_H3W2D8UaI9TKGEhUuQHax2
 trusted: safe
 require own pkg trusted: False
 
 M_SafePkg8
-package dependencies: array-0.4.0.1 base bytestring-0.10.1.0*
+package dependencies: array-0.5.0.0@array_H3W2D8UaI9TKGEhUuQHax2
 trusted: trustworthy
 require own pkg trusted: False
 
diff --git a/testsuite/tests/safeHaskell/flags/SafeFlags22.stderr b/testsuite/tests/safeHaskell/flags/SafeFlags22.stderr
index 784f0472be10..5e1801c0cbfa 100644
--- a/testsuite/tests/safeHaskell/flags/SafeFlags22.stderr
+++ b/testsuite/tests/safeHaskell/flags/SafeFlags22.stderr
@@ -1,6 +1,6 @@
 
 SafeFlags22.hs:1:16: Warning:
-    ‛SafeFlags22’ has been inferred as unsafe!
+    ‘SafeFlags22’ has been inferred as unsafe!
     Reason:
         SafeFlags22.hs:7:1:
             System.IO.Unsafe: Can't be safely imported!
diff --git a/testsuite/tests/safeHaskell/flags/SafeFlags23.stderr b/testsuite/tests/safeHaskell/flags/SafeFlags23.stderr
index 8af4d95f570f..b2a57091ce03 100644
--- a/testsuite/tests/safeHaskell/flags/SafeFlags23.stderr
+++ b/testsuite/tests/safeHaskell/flags/SafeFlags23.stderr
@@ -1,6 +1,6 @@
 
 SafeFlags23.hs:1:16: Warning:
-    ‛SafeFlags22’ has been inferred as unsafe!
+    ‘SafeFlags22’ has been inferred as unsafe!
     Reason:
         SafeFlags23.hs:7:1:
             System.IO.Unsafe: Can't be safely imported!
diff --git a/testsuite/tests/safeHaskell/flags/SafeFlags25.stderr b/testsuite/tests/safeHaskell/flags/SafeFlags25.stderr
index 3e1d7b360757..434ea2b9ca9c 100644
--- a/testsuite/tests/safeHaskell/flags/SafeFlags25.stderr
+++ b/testsuite/tests/safeHaskell/flags/SafeFlags25.stderr
@@ -1,3 +1,3 @@
 
 SafeFlags25.hs:1:16: Warning:
-    ‛SafeFlags25’ has been inferred as safe!
+    ‘SafeFlags25’ has been inferred as safe!
diff --git a/testsuite/tests/safeHaskell/flags/SafeFlags26.stderr b/testsuite/tests/safeHaskell/flags/SafeFlags26.stderr
index 640f5be414b5..47dd8828d4d9 100644
--- a/testsuite/tests/safeHaskell/flags/SafeFlags26.stderr
+++ b/testsuite/tests/safeHaskell/flags/SafeFlags26.stderr
@@ -1,6 +1,6 @@
 
 SafeFlags26.hs:1:16: Warning:
-    ‛SafeFlags26’ has been inferred as safe!
+    ‘SafeFlags26’ has been inferred as safe!
 
 <no location info>: 
 Failing due to -Werror.
diff --git a/testsuite/tests/safeHaskell/ghci/p10.stderr b/testsuite/tests/safeHaskell/ghci/p10.stderr
index 71ace7356921..d8ba4ab762cb 100644
--- a/testsuite/tests/safeHaskell/ghci/p10.stderr
+++ b/testsuite/tests/safeHaskell/ghci/p10.stderr
@@ -1,2 +1,2 @@
 
-<interactive>:10:1: Not in scope: ‛b’
+<interactive>:10:1: Not in scope: ‘b’
diff --git a/testsuite/tests/safeHaskell/ghci/p13.script b/testsuite/tests/safeHaskell/ghci/p13.script
index 4e96c844ed7e..950f95ab676d 100644
--- a/testsuite/tests/safeHaskell/ghci/p13.script
+++ b/testsuite/tests/safeHaskell/ghci/p13.script
@@ -1,12 +1,11 @@
 -- Test restricted functionality: Overlapping
 :unset +s
 :set -XSafe
-:set -XOverlappingInstances
 :set -XFlexibleInstances
 
 :l P13_A
 
-instance Pos [Int] where { res _ = error "This curry is poisoned!" }
+instance {-# OVERLAPPING #-} Pos [Int] where { res _ = error "This curry is poisoned!" }
 
 res [1::Int, 2::Int]
 -- res 'c'
diff --git a/testsuite/tests/safeHaskell/ghci/p13.stderr b/testsuite/tests/safeHaskell/ghci/p13.stderr
index 226aac2f05c1..7a743f18eb0f 100644
--- a/testsuite/tests/safeHaskell/ghci/p13.stderr
+++ b/testsuite/tests/safeHaskell/ghci/p13.stderr
@@ -1,13 +1,16 @@
 
-<interactive>:12:1:
+P13_A.hs:1:14: Warning:
+    -XOverlappingInstances is deprecated: instead use per-instance pragmas OVERLAPPING/OVERLAPPABLE/OVERLAPS
+
+<interactive>:11:1:
     Unsafe overlapping instances for Pos [Int]
-      arising from a use of ‛res’
+      arising from a use of ‘res’
     The matching instance is:
-      instance [overlap ok] [safe] Pos [Int]
-        -- Defined at <interactive>:10:10
+      instance [overlapping] [safe] Pos [Int]
+        -- Defined at <interactive>:9:30
     It is compiled in a Safe module and as such can only
     overlap instances from the same module, however it
     overlaps the following instances from different modules:
       instance [overlap ok] [safe] Pos [a] -- Defined at P13_A.hs:6:10
     In the expression: res [1 :: Int, 2 :: Int]
-    In an equation for ‛it’: it = res [1 :: Int, 2 :: Int]
+    In an equation for ‘it’: it = res [1 :: Int, 2 :: Int]
diff --git a/testsuite/tests/safeHaskell/ghci/p14.stderr b/testsuite/tests/safeHaskell/ghci/p14.stderr
index 0d1b1728a7f4..4d0b14e970f3 100644
--- a/testsuite/tests/safeHaskell/ghci/p14.stderr
+++ b/testsuite/tests/safeHaskell/ghci/p14.stderr
@@ -1,2 +1,2 @@
 
-<interactive>:10:1: parse error on input ‛{-# RULES’
+<interactive>:10:1: parse error on input ‘{-# RULES’
diff --git a/testsuite/tests/safeHaskell/ghci/p15.stderr b/testsuite/tests/safeHaskell/ghci/p15.stderr
index 0bc16dfbf1c1..55b5d4beae4e 100644
--- a/testsuite/tests/safeHaskell/ghci/p15.stderr
+++ b/testsuite/tests/safeHaskell/ghci/p15.stderr
@@ -1,18 +1,20 @@
 
 Top level: Warning:
-    Module ‛Data.OldTypeable’ is deprecated: Use Data.Typeable instead
+    Module ‘Data.OldTypeable’ is deprecated: Use Data.Typeable instead
 
 <interactive>:10:36: Warning:
-    In the use of type constructor or class ‛Typeable’
+    In the use of type constructor or class ‘Typeable’
     (imported from Data.OldTypeable, but defined in Data.OldTypeable.Internal):
     Deprecated: "Use Data.Typeable.Internal instead"
 
 <interactive>:14:10:
-    Can't create hand written instances of Typeable in Safe Haskell! Can only derive them
+    Typeable instances can only be derived in Safe Haskell.
+    Replace the following instance:
+      instance [safe] Typeable G
 
 <interactive>:22:22:
-    No instance for (Typeable G) arising from a use of ‛cast’
+    No instance for (Typeable G) arising from a use of ‘cast’
     In the expression: (cast y) :: Maybe H
     In a pattern binding: (Just y_as_H) = (cast y) :: Maybe H
 
-<interactive>:23:1: Not in scope: ‛y_as_H’
+<interactive>:23:1: Not in scope: ‘y_as_H’
diff --git a/testsuite/tests/safeHaskell/ghci/p16.stderr b/testsuite/tests/safeHaskell/ghci/p16.stderr
index 77d3b1bed106..a5dab96c1ee2 100644
--- a/testsuite/tests/safeHaskell/ghci/p16.stderr
+++ b/testsuite/tests/safeHaskell/ghci/p16.stderr
@@ -3,13 +3,13 @@
     -XGeneralizedNewtypeDeriving is not allowed in Safe Haskell; ignoring -XGeneralizedNewtypeDeriving
 
 <interactive>:16:29:
-    Can't make a derived instance of ‛Op T2’:
-      ‛Op’ is not a derivable class
+    Can't make a derived instance of ‘Op T2’:
+      ‘Op’ is not a derivable class
       Try GeneralizedNewtypeDeriving for GHC's newtype-deriving extension
-    In the newtype declaration for ‛T2’
+    In the newtype declaration for ‘T2’
 
 <interactive>:19:9:
-    Not in scope: data constructor ‛T2’
-    Perhaps you meant ‛T1’ (line 13)
+    Not in scope: data constructor ‘T2’
+    Perhaps you meant ‘T1’ (line 13)
 
-<interactive>:22:4: Not in scope: ‛y’
+<interactive>:22:4: Not in scope: ‘y’
diff --git a/testsuite/tests/safeHaskell/ghci/p4.stderr b/testsuite/tests/safeHaskell/ghci/p4.stderr
index 8ff140a7bd80..c7eb6070e114 100644
--- a/testsuite/tests/safeHaskell/ghci/p4.stderr
+++ b/testsuite/tests/safeHaskell/ghci/p4.stderr
@@ -1,6 +1,6 @@
 
-<interactive>:6:9: Not in scope: ‛System.IO.Unsafe.unsafePerformIO’
+<interactive>:6:9: Not in scope: ‘System.IO.Unsafe.unsafePerformIO’
 
-<interactive>:7:9: Not in scope: ‛x’
+<interactive>:7:9: Not in scope: ‘x’
 
-<interactive>:8:1: Not in scope: ‛y’
+<interactive>:8:1: Not in scope: ‘y’
diff --git a/testsuite/tests/safeHaskell/ghci/p6.stderr b/testsuite/tests/safeHaskell/ghci/p6.stderr
index f46c1f815e46..ec7cd64bb3d1 100644
--- a/testsuite/tests/safeHaskell/ghci/p6.stderr
+++ b/testsuite/tests/safeHaskell/ghci/p6.stderr
@@ -1,10 +1,10 @@
 
 <interactive>:12:1:
-    Unacceptable result type in foreign declaration: Double
-    Safe Haskell is on, all FFI imports must be in the IO monad
+    Unacceptable result type in foreign declaration:
+      Safe Haskell is on, all FFI imports must be in the IO monad
     When checking declaration:
       foreign import ccall safe "static sin" c_sin :: Double -> Double
 
 <interactive>:13:1:
-    Not in scope: ‛c_sin’
-    Perhaps you meant ‛c_sin'’ (line 8)
+    Not in scope: ‘c_sin’
+    Perhaps you meant ‘c_sin'’ (line 8)
diff --git a/testsuite/tests/safeHaskell/ghci/p9.stderr b/testsuite/tests/safeHaskell/ghci/p9.stderr
index 71ace7356921..d8ba4ab762cb 100644
--- a/testsuite/tests/safeHaskell/ghci/p9.stderr
+++ b/testsuite/tests/safeHaskell/ghci/p9.stderr
@@ -1,2 +1,2 @@
 
-<interactive>:10:1: Not in scope: ‛b’
+<interactive>:10:1: Not in scope: ‘b’
diff --git a/testsuite/tests/safeHaskell/safeInfered/SafeInfered05.hs b/testsuite/tests/safeHaskell/safeInfered/SafeInfered05.hs
new file mode 100644
index 000000000000..0b42002b25cc
--- /dev/null
+++ b/testsuite/tests/safeHaskell/safeInfered/SafeInfered05.hs
@@ -0,0 +1,32 @@
+{-# LANGUAGE Unsafe #-}
+{-# LANGUAGE OverlappingInstances #-}
+{-# LANGUAGE FlexibleInstances #-}
+
+-- |
+-- This module should actually fail to compile since we have the instances C
+-- [Int] from the -XSafe module SafeInfered05_A overlapping as the most
+-- specific instance the other instance C [a] from this module. This is in
+-- violation of our single-origin-policy.
+--
+-- Right now though, the above actually compiles fine but *this is a bug*.
+-- Compiling module SafeInfered05_A with -XSafe has the right affect of causing
+-- the compilation of module SafeInfered05 to then subsequently fail. So we
+-- have a discrepancy between a safe-inferred module and a -XSafe module, which
+-- there should not be.
+--
+-- It does raise a question of if this bug should be fixed. Right now we've
+-- designed Safe Haskell to be completely opt-in, even with safe-inference.
+-- Fixing this of course changes this, causing safe-inference to alter the
+-- compilation success of some cases. How common it is to have overlapping
+-- declarations without -XOverlappingInstances specified needs to be tested.
+--
+module SafeInfered05 where
+
+import safe SafeInfered05_A
+
+instance C [a] where
+  f _ = "[a]"
+
+test2 :: String
+test2 = f ([1,2,3,4] :: [Int])
+
diff --git a/testsuite/tests/safeHaskell/safeInfered/SafeInfered05_A.hs b/testsuite/tests/safeHaskell/safeInfered/SafeInfered05_A.hs
new file mode 100644
index 000000000000..a1e12a6526ad
--- /dev/null
+++ b/testsuite/tests/safeHaskell/safeInfered/SafeInfered05_A.hs
@@ -0,0 +1,9 @@
+{-# LANGUAGE FlexibleInstances #-}
+module SafeInfered05_A where
+
+class C a where
+  f :: a -> String
+
+instance C [Int] where
+  f _ = "[Int]"
+
diff --git a/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered07.stderr b/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered07.stderr
index e318319eaa87..153ba0f77e0e 100644
--- a/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered07.stderr
+++ b/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered07.stderr
@@ -1,20 +1,20 @@
 [1 of 2] Compiling UnsafeInfered07_A ( UnsafeInfered07_A.hs, UnsafeInfered07_A.o )
 
 UnsafeInfered07_A.hs:4:1: Warning:
-    Module ‛Data.OldTypeable’ is deprecated: Use Data.Typeable instead
+    Module ‘Data.OldTypeable’ is deprecated: Use Data.Typeable instead
 
 UnsafeInfered07_A.hs:8:10: Warning:
-    In the use of type constructor or class ‛Typeable’
+    In the use of type constructor or class ‘Typeable’
     (imported from Data.OldTypeable, but defined in Data.OldTypeable.Internal):
     Deprecated: "Use Data.Typeable.Internal instead"
 
 UnsafeInfered07_A.hs:8:10: Warning:
-    In the use of type constructor or class ‛Typeable’
+    In the use of type constructor or class ‘Typeable’
     (imported from Data.OldTypeable, but defined in Data.OldTypeable.Internal):
     Deprecated: "Use Data.Typeable.Internal instead"
 
 UnsafeInfered07_A.hs:9:16: Warning:
-    In the use of ‛typeOf’
+    In the use of ‘typeOf’
     (imported from Data.OldTypeable, but defined in Data.OldTypeable.Internal):
     Deprecated: "Use Data.Typeable.Internal instead"
 [2 of 2] Compiling UnsafeInfered07  ( UnsafeInfered07.hs, UnsafeInfered07.o )
diff --git a/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered08_A.hs b/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered08_A.hs
index 13f22ce3d78f..4cd276fafd8e 100644
--- a/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered08_A.hs
+++ b/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered08_A.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE OverlappingInstances #-}
+{-# OPTIONS_GHC -w #-}  -- Turn off deprecation for OverlappingInstances
 -- | Unsafe as uses overlapping instances
 -- Although it isn't defining any so can we mark safe
 -- still?
diff --git a/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered11.stderr b/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered11.stderr
index ec700d62fdb4..d1cfe9915836 100644
--- a/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered11.stderr
+++ b/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered11.stderr
@@ -1,7 +1,7 @@
 [1 of 2] Compiling UnsafeInfered11_A ( UnsafeInfered11_A.hs, UnsafeInfered11_A.o )
 
 UnsafeInfered11_A.hs:1:16: Warning:
-    ‛UnsafeInfered11_A’ has been inferred as unsafe!
+    ‘UnsafeInfered11_A’ has been inferred as unsafe!
     Reason:
         UnsafeInfered11_A.hs:17:11: Warning:
             Rule "lookupx/T" ignored
diff --git a/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered12.stderr b/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered12.stderr
index 53d7a4c3285a..470e1b71e6e4 100644
--- a/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered12.stderr
+++ b/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered12.stderr
@@ -1,6 +1,6 @@
 
 UnsafeInfered12.hs:2:16: Warning:
-    ‛UnsafeInfered12’ has been inferred as unsafe!
+    ‘UnsafeInfered12’ has been inferred as unsafe!
     Reason:
         UnsafeInfered12.hs:1:14:
             -XTemplateHaskell is not allowed in Safe Haskell
diff --git a/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered13.hs b/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered13.hs
new file mode 100644
index 000000000000..defc3a52439e
--- /dev/null
+++ b/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered13.hs
@@ -0,0 +1,10 @@
+{-# OPTIONS_GHC -fwarn-unsafe -Werror #-}
+{-# LANGUAGE FlexibleInstances #-}
+module UnsafeInfered13 where
+
+class C a where
+  f :: a -> String
+
+instance {-# OVERLAPS #-} C a where
+  f _ = "a"
+
diff --git a/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered13.stderr b/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered13.stderr
new file mode 100644
index 000000000000..c545d4030810
--- /dev/null
+++ b/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered13.stderr
@@ -0,0 +1,7 @@
+
+UnsafeInfered13.hs:1:16: Warning:
+    ‘UnsafeInfered13’ has been inferred as unsafe!
+    Reason:
+
+<no location info>: 
+Failing due to -Werror.
diff --git a/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered14.hs b/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered14.hs
new file mode 100644
index 000000000000..5b9f64210fb0
--- /dev/null
+++ b/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered14.hs
@@ -0,0 +1,10 @@
+{-# OPTIONS_GHC -fwarn-unsafe -Werror #-}
+{-# LANGUAGE FlexibleInstances #-}
+module UnsafeInfered14 where
+
+class C a where
+  f :: a -> String
+
+instance {-# OVERLAPPABLE #-} C a where
+  f _ = "a"
+
diff --git a/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered14.stderr b/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered14.stderr
new file mode 100644
index 000000000000..b7c41ac6c362
--- /dev/null
+++ b/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered14.stderr
@@ -0,0 +1,7 @@
+
+UnsafeInfered14.hs:1:16: Warning:
+    ‘UnsafeInfered14’ has been inferred as unsafe!
+    Reason:
+
+<no location info>: 
+Failing due to -Werror.
diff --git a/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered15.hs b/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered15.hs
new file mode 100644
index 000000000000..427c97b0acca
--- /dev/null
+++ b/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered15.hs
@@ -0,0 +1,10 @@
+{-# OPTIONS_GHC -fwarn-unsafe -Werror #-}
+{-# LANGUAGE FlexibleInstances #-}
+module UnsafeInfered15 where
+
+class C a where
+  f :: a -> String
+
+instance {-# OVERLAPPING #-} C a where
+  f _ = "a"
+
diff --git a/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered15.stderr b/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered15.stderr
new file mode 100644
index 000000000000..dbf20949f75b
--- /dev/null
+++ b/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered15.stderr
@@ -0,0 +1,7 @@
+
+UnsafeInfered15.hs:1:16: Warning:
+    ‘UnsafeInfered15’ has been inferred as unsafe!
+    Reason:
+
+<no location info>: 
+Failing due to -Werror.
diff --git a/testsuite/tests/safeHaskell/safeInfered/all.T b/testsuite/tests/safeHaskell/safeInfered/all.T
index 47e9656279a9..a995c76c6d6f 100644
--- a/testsuite/tests/safeHaskell/safeInfered/all.T
+++ b/testsuite/tests/safeHaskell/safeInfered/all.T
@@ -21,6 +21,11 @@ test('SafeInfered04',
      [ extra_clean(['SafeInfered04_A.hi', 'SafeInfered04_A.o']) ],
      multimod_compile, ['SafeInfered04', ''])
 
+# Test should fail, tests an earlier bug in 7.8
+# test('SafeInfered05',
+#      [ extra_clean(['SafeInfered05_A.hi', 'SafeInfered05_A.o']) ],
+#      multimod_compile_fail, ['SafeInfered05', ''])
+
 # Tests that should fail to compile as they should be infered unsafe
 test('UnsafeInfered01',
      [ extra_clean(['UnsafeInfered01_A.hi', 'UnsafeInfered01_A.o']) ],
@@ -56,8 +61,11 @@ test('UnsafeInfered11',
      [ extra_clean(['UnsafeInfered11_A.hi', 'UnsafeInfered11_A.o']) ],
      multimod_compile_fail, ['UnsafeInfered11', ''])
 
-# test should fail as unsafe and we made warn unsafe + -Werror
+# Test should fail as unsafe and we made warn unsafe + -Werror
 test('UnsafeInfered12', normal, compile_fail, [''])
+test('UnsafeInfered13', normal, compile_fail, [''])
+test('UnsafeInfered14', normal, compile_fail, [''])
+test('UnsafeInfered15', normal, compile_fail, [''])
 
 # Mixed tests
 test('Mixed01', normal, compile_fail, [''])
diff --git a/testsuite/tests/safeHaskell/safeLanguage/SafeLang07.stderr b/testsuite/tests/safeHaskell/safeLanguage/SafeLang07.stderr
index 50c0ef7e5665..276c723203a0 100644
--- a/testsuite/tests/safeHaskell/safeLanguage/SafeLang07.stderr
+++ b/testsuite/tests/safeHaskell/safeLanguage/SafeLang07.stderr
@@ -3,5 +3,5 @@ SafeLang07.hs:2:14: Warning:
     -XGeneralizedNewtypeDeriving is not allowed in Safe Haskell; ignoring -XGeneralizedNewtypeDeriving
 
 SafeLang07.hs:15:1:
-    Failed to load interface for ‛SafeLang07_A’
+    Failed to load interface for ‘SafeLang07_A’
     Use -v to see a list of the files searched for.
diff --git a/testsuite/tests/safeHaskell/safeLanguage/SafeLang08.stderr b/testsuite/tests/safeHaskell/safeLanguage/SafeLang08.stderr
index 7785b2459ebf..7d06e2f11cc1 100644
--- a/testsuite/tests/safeHaskell/safeLanguage/SafeLang08.stderr
+++ b/testsuite/tests/safeHaskell/safeLanguage/SafeLang08.stderr
@@ -1,7 +1,7 @@
 
 SafeLang08.hs:9:1:
-    Unacceptable result type in foreign declaration: Double
-    Safe Haskell is on, all FFI imports must be in the IO monad
+    Unacceptable result type in foreign declaration:
+      Safe Haskell is on, all FFI imports must be in the IO monad
     When checking declaration:
       foreign import ccall safe "static SafeLang08_A" c_sin
         :: CDouble -> CDouble
diff --git a/testsuite/tests/safeHaskell/safeLanguage/SafeLang10.stderr b/testsuite/tests/safeHaskell/safeLanguage/SafeLang10.stderr
index a226c797443b..d0c5c68d6a02 100644
--- a/testsuite/tests/safeHaskell/safeLanguage/SafeLang10.stderr
+++ b/testsuite/tests/safeHaskell/safeLanguage/SafeLang10.stderr
@@ -4,16 +4,16 @@
 
 SafeLang10.hs:8:13:
     Unsafe overlapping instances for Pos [Int]
-      arising from a use of ‛res’
+      arising from a use of ‘res’
     The matching instance is:
-      instance [overlap ok] [safe] Pos [Int]
-        -- Defined at SafeLang10_B.hs:14:10
+      instance [overlapping] [safe] Pos [Int]
+        -- Defined at SafeLang10_B.hs:13:30
     It is compiled in a Safe module and as such can only
     overlap instances from the same module, however it
     overlaps the following instances from different modules:
       instance Pos [a] -- Defined at SafeLang10_A.hs:13:10
     In the expression: res [(1 :: Int)]
-    In an equation for ‛r’: r = res [(1 :: Int)]
+    In an equation for ‘r’: r = res [(1 :: Int)]
     In the expression:
       do { let r = res ...;
            putStrLn $ "Result: " ++ show r;
diff --git a/testsuite/tests/safeHaskell/safeLanguage/SafeLang10_B.hs b/testsuite/tests/safeHaskell/safeLanguage/SafeLang10_B.hs
index 5b9954c12e6c..d9a8f63f506b 100644
--- a/testsuite/tests/safeHaskell/safeLanguage/SafeLang10_B.hs
+++ b/testsuite/tests/safeHaskell/safeLanguage/SafeLang10_B.hs
@@ -1,5 +1,4 @@
 {-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE OverlappingInstances #-}
 {-# LANGUAGE Safe #-}
 
 -- Untrusted plugin! Don't wan't it changing behaviour of our
@@ -8,10 +7,10 @@ module SafeLang10_B where
 
 import SafeLang10_A
 
-instance Pos a where
+instance {-# OVERLAPPABLE #-} Pos a where
     res _ = False
 
-instance Pos [Int] where
+instance {-# OVERLAPPING #-} Pos [Int] where
     res _ = error "This curry is poisoned!"
 
 function :: Int
diff --git a/testsuite/tests/safeHaskell/safeLanguage/SafeLang14.stderr b/testsuite/tests/safeHaskell/safeLanguage/SafeLang14.stderr
index af8dca390d8a..c0f94d54909b 100644
--- a/testsuite/tests/safeHaskell/safeLanguage/SafeLang14.stderr
+++ b/testsuite/tests/safeHaskell/safeLanguage/SafeLang14.stderr
@@ -2,7 +2,11 @@
 [2 of 2] Compiling Main             ( SafeLang14.hs, SafeLang14.o )
 
 SafeLang14.hs:14:10:
-    Can't create hand written instances of Typeable in Safe Haskell! Can only derive them
+    Typeable instances can only be derived in Safe Haskell.
+    Replace the following instance:
+      instance [safe] Typeable G
 
 SafeLang14.hs:17:10:
-    Can't create hand written instances of Typeable in Safe Haskell! Can only derive them
+    Typeable instances can only be derived in Safe Haskell.
+    Replace the following instance:
+      instance [safe] Typeable P
diff --git a/testsuite/tests/safeHaskell/safeLanguage/SafeLang15.stderr b/testsuite/tests/safeHaskell/safeLanguage/SafeLang15.stderr
index 41fa100504d5..5aed2c55ef06 100644
--- a/testsuite/tests/safeHaskell/safeLanguage/SafeLang15.stderr
+++ b/testsuite/tests/safeHaskell/safeLanguage/SafeLang15.stderr
@@ -1,2 +1,2 @@
-SafeLang15: SafeLang15.hs:22:9-37: Irrefutable pattern failed for pattern Data.Maybe.Just p'
+SafeLang15: SafeLang15.hs:22:9-37: Irrefutable pattern failed for pattern Just p'
 
diff --git a/testsuite/tests/safeHaskell/unsafeLibs/BadImport03.stderr b/testsuite/tests/safeHaskell/unsafeLibs/BadImport03.stderr
index 03b80286710e..d32e33f78f09 100644
--- a/testsuite/tests/safeHaskell/unsafeLibs/BadImport03.stderr
+++ b/testsuite/tests/safeHaskell/unsafeLibs/BadImport03.stderr
@@ -2,4 +2,6 @@
 [2 of 2] Compiling Main             ( BadImport03.hs, BadImport03.o )
 
 BadImport03.hs:16:10:
-    Can't create hand written instances of Typeable in Safe Haskell! Can only derive them
+    Typeable instances can only be derived in Safe Haskell.
+    Replace the following instance:
+      instance [safe] Typeable NInt
diff --git a/testsuite/tests/simplCore/should_compile/Makefile b/testsuite/tests/simplCore/should_compile/Makefile
index 60ad4c7a72d0..d615a5e8d566 100644
--- a/testsuite/tests/simplCore/should_compile/Makefile
+++ b/testsuite/tests/simplCore/should_compile/Makefile
@@ -2,6 +2,10 @@ TOP=../../..
 include $(TOP)/mk/boilerplate.mk
 include $(TOP)/mk/test.mk
 
+T8832:
+	$(RM) -f T8832.o T8832.hi
+	'$(TEST_HC)' $(TEST_HC_OPTS) -O -c -ddump-simpl T8832.hs | grep '#'
+
 T7865:
 	$(RM) -f T7865.o T7865.hi
 	'$(TEST_HC)' $(TEST_HC_OPTS) -dsuppress-uniques -O2 -c -ddump-simpl T7865.hs | grep expensive
@@ -13,12 +17,12 @@ T3055:
 
 T5658b:
 	$(RM) -f T5658b.o T5658b.hi
-	'$(TEST_HC)' $(TEST_HC_OPTS) -O -c T5658b.hs -ddump-simpl | grep --count indexIntArray
+	'$(TEST_HC)' $(TEST_HC_OPTS) -O -c T5658b.hs -ddump-simpl | grep -c indexIntArray
 # Trac 5658 meant that there were three calls to indexIntArray instead of two
 
 T5776:
 	$(RM) -f T5776.o T5776.hi
-	'$(TEST_HC)' $(TEST_HC_OPTS) -O -c T5776.hs -ddump-rules | grep --count dEq
+	'$(TEST_HC)' $(TEST_HC_OPTS) -O -c T5776.hs -ddump-rules | grep -c dEq
 
 T3772:
 	$(RM) -f T3772*.hi T3772*.o
@@ -31,9 +35,12 @@ T4306:
 	'$(TEST_HC)' $(TEST_HC_OPTS) --show-iface T4306.hi | grep 'wupd ::'
 
 T4201:
-	$(RM) -f T4201.hi T4201.o
+	$(RM) -f T4201.hi T4201.o T4201.list
 	'$(TEST_HC)' $(TEST_HC_OPTS) -c -O T4201.hs
-	'$(TEST_HC)' $(TEST_HC_OPTS) --show-iface T4201.hi | grep -B2 'Sym'
+	'$(TEST_HC)' $(TEST_HC_OPTS) --show-iface T4201.hi > T4201.list
+	# poor man idea about how to replace GNU grep -B2 "Sym" invocation with pure POSIX tools
+	for i in `grep -n "Sym" T4201.list |cut -d ':' -f -1`; do head -$$i T4201.list | tail -3 ; done
+	$(RM) -f T4201.list
 
 # This one looped as a result of bogus specialisation
 T4903:
diff --git a/testsuite/tests/simplCore/should_compile/T3234.stderr b/testsuite/tests/simplCore/should_compile/T3234.stderr
index 4ccc5a18faa6..c3591d02fe13 100644
--- a/testsuite/tests/simplCore/should_compile/T3234.stderr
+++ b/testsuite/tests/simplCore/should_compile/T3234.stderr
@@ -61,6 +61,6 @@ Total ticks:     45
   1 c
   1 n
   1 a
-10 SimplifierDone 10
+11 SimplifierDone 11
 
 
diff --git a/testsuite/tests/simplCore/should_compile/T4201.stdout b/testsuite/tests/simplCore/should_compile/T4201.stdout
index ed519ed02fa5..6ff469285477 100644
--- a/testsuite/tests/simplCore/should_compile/T4201.stdout
+++ b/testsuite/tests/simplCore/should_compile/T4201.stdout
@@ -1,3 +1,3 @@
-    {- Arity: 1, HasNoCafRefs, Strictness: <S,1*U()>m,
-       Unfolding: InlineRule (0, True, True)
-                  Eta.bof `cast` (Sym (Eta.NTCo:Foo[0]) ->_R <Eta.T>_R) -}
+  {- Arity: 1, HasNoCafRefs, Strictness: <S,1*U()>m,
+     Unfolding: InlineRule (0, True, True)
+                Eta.bof `cast` (Sym (Eta.NTCo:Foo[0]) ->_R <Eta.T>_R) -}
diff --git a/testsuite/tests/simplCore/should_compile/T4398.stderr b/testsuite/tests/simplCore/should_compile/T4398.stderr
index 692583e68023..2f1f567d4914 100644
--- a/testsuite/tests/simplCore/should_compile/T4398.stderr
+++ b/testsuite/tests/simplCore/should_compile/T4398.stderr
@@ -1,3 +1,22 @@
-
-T4398.hs:5:11: Warning:
-    Forall'd constraint ‛Ord a’ is not bound in RULE lhs f @ a x y
+
+T4398.hs:5:11: Warning:
+    Forall'd constraint ‘Ord a’ is not bound in RULE lhs
+      Orig bndrs: [a, $dOrd, x, y]
+      Orig lhs: let {
+                  $dEq :: Eq a
+                  [LclId, Str=DmdType]
+                  $dEq = GHC.Classes.$p1Ord @ a $dOrd } in
+                f @ a
+                  ((\ ($dOrd :: Ord a) ->
+                      let {
+                        $dEq :: Eq a
+                        [LclId, Str=DmdType]
+                        $dEq = GHC.Classes.$p1Ord @ a $dOrd } in
+                      let {
+                        $dEq :: Eq a
+                        [LclId, Str=DmdType]
+                        $dEq = GHC.Classes.$p1Ord @ a $dOrd } in
+                      x)
+                     $dOrd)
+                  y
+      optimised lhs: f @ a x y
diff --git a/testsuite/tests/simplCore/should_compile/T4918.stdout b/testsuite/tests/simplCore/should_compile/T4918.stdout
index c79b116f0360..708be353c4d4 100644
--- a/testsuite/tests/simplCore/should_compile/T4918.stdout
+++ b/testsuite/tests/simplCore/should_compile/T4918.stdout
@@ -1,2 +1,2 @@
-    {- HasNoCafRefs, Strictness: m, Unfolding: (GHC.Types.C# 'p') -}
-    {- HasNoCafRefs, Strictness: m, Unfolding: (GHC.Types.C# 'q') -}
+  {- HasNoCafRefs, Strictness: m, Unfolding: (GHC.Types.C# 'p') -}
+  {- HasNoCafRefs, Strictness: m, Unfolding: (GHC.Types.C# 'q') -}
diff --git a/testsuite/tests/simplCore/should_compile/T5359b.hs b/testsuite/tests/simplCore/should_compile/T5359b.hs
index 6348defdd1c2..f1ce2091a977 100644
--- a/testsuite/tests/simplCore/should_compile/T5359b.hs
+++ b/testsuite/tests/simplCore/should_compile/T5359b.hs
@@ -1,5 +1,4 @@
 {-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE OverlappingInstances #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE TypeOperators #-}
diff --git a/testsuite/tests/simplCore/should_compile/T5359b.stderr b/testsuite/tests/simplCore/should_compile/T5359b.stderr
index 6106f3e17b73..2802476a2d49 100644
--- a/testsuite/tests/simplCore/should_compile/T5359b.stderr
+++ b/testsuite/tests/simplCore/should_compile/T5359b.stderr
@@ -1,3 +1,3 @@
 
-T5359b.hs:62:1: Warning:
-    SPECIALISE pragma on INLINE function probably won't fire: ‛genum’
+T5359b.hs:61:1: Warning:
+    SPECIALISE pragma on INLINE function probably won't fire: ‘genum’
diff --git a/testsuite/tests/simplCore/should_compile/T5776.stdout b/testsuite/tests/simplCore/should_compile/T5776.stdout
index b8626c4cff28..00750edc07d6 100644
--- a/testsuite/tests/simplCore/should_compile/T5776.stdout
+++ b/testsuite/tests/simplCore/should_compile/T5776.stdout
@@ -1 +1 @@
-4
+3
diff --git a/testsuite/tests/simplCore/should_compile/T6082-RULE.stderr b/testsuite/tests/simplCore/should_compile/T6082-RULE.stderr
index e133ec7e5859..f61968715143 100644
--- a/testsuite/tests/simplCore/should_compile/T6082-RULE.stderr
+++ b/testsuite/tests/simplCore/should_compile/T6082-RULE.stderr
@@ -1,8 +1,8 @@
 
 T6082-RULE.hs:5:11: Warning:
-    Rule "foo1" may never fire because ‛foo1’ might inline first
-    Probable fix: add an INLINE[n] or NOINLINE[n] pragma on ‛foo1’
+    Rule "foo1" may never fire because ‘foo1’ might inline first
+    Probable fix: add an INLINE[n] or NOINLINE[n] pragma on ‘foo1’
 
 T6082-RULE.hs:10:11: Warning:
-    Rule "foo2" may never fire because ‛foo2’ might inline first
-    Probable fix: add an INLINE[n] or NOINLINE[n] pragma on ‛foo2’
+    Rule "foo2" may never fire because ‘foo2’ might inline first
+    Probable fix: add an INLINE[n] or NOINLINE[n] pragma on ‘foo2’
diff --git a/testsuite/tests/simplCore/should_compile/T7785.stderr b/testsuite/tests/simplCore/should_compile/T7785.stderr
index fbe217cd243b..d32eacce485c 100644
--- a/testsuite/tests/simplCore/should_compile/T7785.stderr
+++ b/testsuite/tests/simplCore/should_compile/T7785.stderr
@@ -1,9 +1,8 @@
 
 ==================== Tidy Core rules ====================
 "SPEC Foo.shared [[]]" [ALWAYS]
-    forall ($dMyFunctor :: Foo.MyFunctor [])
-           (irred :: Foo.Domain [] GHC.Types.Int).
-      Foo.shared @ [] $dMyFunctor irred
-      = Foo.bar_$sshared
+    forall ($dMyFunctor :: MyFunctor []) (irred :: Domain [] Int).
+      shared @ [] $dMyFunctor irred
+      = bar_$sshared
 
 
diff --git a/testsuite/tests/simplCore/should_compile/T8331.hs b/testsuite/tests/simplCore/should_compile/T8331.hs
new file mode 100644
index 000000000000..04cb1aff735b
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/T8331.hs
@@ -0,0 +1,59 @@
+{-# LANGUAGE FlexibleInstances, RankNTypes #-}
+
+module Main ( main, useAbstractMonad ) where
+
+import Control.Monad
+import Control.Monad.ST
+import Control.Applicative
+
+newtype ReaderT r m a = ReaderT {
+        -- | The underlying computation, as a function of the environment.
+        runReaderT :: r -> m a
+    }
+
+instance (Applicative m) => Applicative (ReaderT r m) where
+    pure    = liftReaderT . pure
+    f <*> v = ReaderT $ \ r -> runReaderT f r <*> runReaderT v r
+
+instance (Functor m) => Functor (ReaderT r m) where
+    fmap f  = mapReaderT (fmap f)
+
+instance (Monad m) => Monad (ReaderT r m) where
+    return x  = ReaderT (\_ -> return x)
+    m >>= k  = ReaderT $ \ r -> do
+        a <- runReaderT m r
+        runReaderT (k a) r
+    fail msg = ReaderT (\_ -> fail msg)
+
+mapReaderT :: (m a -> n b) -> ReaderT r m a -> ReaderT r n b
+mapReaderT f m = ReaderT $ f . runReaderT m
+
+liftReaderT :: m a -> ReaderT r m a
+liftReaderT m = ReaderT (const m)
+
+ask :: (Monad m) => ReaderT r m r
+ask = ReaderT return
+
+class (Applicative m, Functor m , Monad m) => MonadAbstractIOST m where
+    addstuff :: Int -> m Int
+
+type ReaderST s = ReaderT (Int) (ST s)
+
+instance MonadAbstractIOST (ReaderST s) where
+    addstuff a = return . (a +) =<< ask
+
+runAbstractST :: (forall s. ReaderST s a) -> a
+runAbstractST f = runST $ runReaderT f 99
+
+{-# SPECIALIZE useAbstractMonad :: Int -> ReaderST s Int #-}
+-- Note the polymorphism
+useAbstractMonad :: MonadAbstractIOST m => Int -> m Int
+useAbstractMonad n = foldM (\a b -> a `seq` return . (a +) =<< (addstuff b)) 0 [1..n]
+
+-- useConcreteMonad :: Int -> ReaderST s Int
+-- useConcreteMonad = foldM (\a b -> a `seq` return . (a +) =<< (addstuff b)) 0 [1..n]
+
+main :: IO ()
+main = do
+    let st = runAbstractST (useAbstractMonad 5000000)
+    putStrLn . show $ st
diff --git a/testsuite/tests/simplCore/should_compile/T8331.stderr b/testsuite/tests/simplCore/should_compile/T8331.stderr
new file mode 100644
index 000000000000..1b3c21eaeabe
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/T8331.stderr
@@ -0,0 +1,9 @@
+
+==================== Tidy Core rules ====================
+"SPEC useAbstractMonad" [ALWAYS]
+    forall (@ s)
+           ($dMonadAbstractIOST :: MonadAbstractIOST (ReaderT Int (ST s))).
+      useAbstractMonad @ (ReaderT Int (ST s)) $dMonadAbstractIOST
+      = useAbstractMonad_$suseAbstractMonad @ s
+
+
diff --git a/testsuite/tests/simplCore/should_compile/T8537.stderr b/testsuite/tests/simplCore/should_compile/T8537.stderr
index f27ee675a59e..0613a1cfa3a7 100644
--- a/testsuite/tests/simplCore/should_compile/T8537.stderr
+++ b/testsuite/tests/simplCore/should_compile/T8537.stderr
@@ -1,3 +1,3 @@
 
 T8537.hs:20:5: Warning:
-    SPECIALISE pragma for non-overloaded function ‛fmap’
+    SPECIALISE pragma for non-overloaded function ‘fmap’
diff --git a/testsuite/tests/simplCore/should_compile/T8714.hs b/testsuite/tests/simplCore/should_compile/T8714.hs
new file mode 100644
index 000000000000..8199d6fd59b4
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/T8714.hs
@@ -0,0 +1,9 @@
+{-# LANGUAGE ExistentialQuantification #-}
+module T8714 where
+
+data HLState = forall a. HLState (a -> a) !a
+
+data BufferImpl = FBufferData !HLState
+
+focusAst :: BufferImpl -> HLState
+focusAst (FBufferData (HLState f x)) = HLState f (f x)
diff --git a/testsuite/tests/simplCore/should_compile/T8832.hs b/testsuite/tests/simplCore/should_compile/T8832.hs
new file mode 100644
index 000000000000..9059a180cf2b
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/T8832.hs
@@ -0,0 +1,28 @@
+{-# LANGUAGE CPP #-}
+
+-- I'm concerned that the -ddump-simpl output may differ on 32 and 64-bit
+-- platforms.  So far I've only put in output for 64-bit platforms.
+
+module T8832 where
+
+import Data.Bits
+import Data.Int
+import Data.Word
+
+#define T(s,T) \
+s :: T ; \
+s = clearBit (bit 0) 0 ; \
+
+T(i,Int)
+T(i8,Int8)
+T(i16,Int16)
+T(i32,Int32)
+T(i64,Int64)
+
+T(w,Word)
+T(w8,Word8)
+T(w16,Word16)
+T(w32,Word32)
+T(w64,Word64)
+
+T(z,Integer)
\ No newline at end of file
diff --git a/testsuite/tests/simplCore/should_compile/T8832.stdout b/testsuite/tests/simplCore/should_compile/T8832.stdout
new file mode 100644
index 000000000000..271963122db4
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/T8832.stdout
@@ -0,0 +1,10 @@
+T8832.i = GHC.Types.I# 0
+T8832.i8 = GHC.Int.I8# 0
+T8832.i16 = GHC.Int.I16# 0
+T8832.i32 = GHC.Int.I32# 0
+T8832.i64 = GHC.Int.I64# 0
+T8832.w = GHC.Types.W# (__word 0)
+T8832.w8 = GHC.Word.W8# (__word 0)
+T8832.w16 = GHC.Word.W16# (__word 0)
+T8832.w32 = GHC.Word.W32# (__word 0)
+T8832.w64 = GHC.Word.W64# (__word 0)
diff --git a/testsuite/tests/simplCore/should_compile/T8848.hs b/testsuite/tests/simplCore/should_compile/T8848.hs
new file mode 100644
index 000000000000..1ddfe94596b8
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/T8848.hs
@@ -0,0 +1,26 @@
+{-# LANGUAGE KindSignatures, GADTs, DataKinds, FlexibleInstances, FlexibleContexts #-}
+{-# OPTIONS_GHC -fno-warn-missing-methods #-}
+
+module T8848 where
+
+import qualified Control.Applicative as A
+import qualified Data.Functor as Fun
+
+data Nat = S Nat  | Z
+
+data Shape (rank :: Nat) a where
+    Nil  :: Shape Z a
+    (:*) ::  a -> Shape r a -> Shape  (S r) a
+
+instance A.Applicative (Shape Z) where
+instance A.Applicative (Shape r)=> A.Applicative (Shape (S r)) where
+instance Fun.Functor (Shape Z) where
+instance (Fun.Functor (Shape r)) => Fun.Functor (Shape (S r)) where
+
+map2 :: (A.Applicative (Shape r))=> (a->b ->c) -> (Shape r a) -> (Shape r b) -> (Shape r c )
+map2 = \f l r -> A.pure f A.<*>  l  A.<*> r
+
+{-# SPECIALIZE map2 :: (a->b->c)-> (Shape (S (S Z)) a )-> Shape (S (S Z)) b -> Shape (S (S Z)) c #-}
+
+map3 :: (a->b->c)-> (Shape (S (S Z)) a )-> Shape (S (S Z)) b -> Shape (S (S Z)) c 
+map3 x y z = map2 x y z
\ No newline at end of file
diff --git a/testsuite/tests/simplCore/should_compile/T8848.stderr b/testsuite/tests/simplCore/should_compile/T8848.stderr
new file mode 100644
index 000000000000..ed815141b529
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/T8848.stderr
@@ -0,0 +1,17 @@
+Rule fired: Class op fmap
+Rule fired: Class op fmap
+Rule fired: Class op pure
+Rule fired: Class op <*>
+Rule fired: Class op <*>
+Rule fired: SPEC map2
+Rule fired: Class op $p1Applicative
+Rule fired: Class op <*>
+Rule fired: Class op $p1Applicative
+Rule fired: Class op <*>
+Rule fired: Class op $p1Applicative
+Rule fired: Class op fmap
+Rule fired: Class op <*>
+Rule fired: Class op $p1Applicative
+Rule fired: Class op fmap
+Rule fired: Class op <*>
+Rule fired: SPEC T8848.$fFunctorShape ['T8848.Z]
diff --git a/testsuite/tests/simplCore/should_compile/T8848a.hs b/testsuite/tests/simplCore/should_compile/T8848a.hs
new file mode 100644
index 000000000000..81e757f8c240
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/T8848a.hs
@@ -0,0 +1,19 @@
+module T8848a where
+
+f :: Ord a => b -> a -> a
+f y x = x
+
+{-# SPECIALISE f :: b -> [Int] -> [Int] #-}
+
+{- Specialised badly:
+
+"SPEC Spec.f" [ALWAYS]
+    forall (@ b_aX7).
+      Spec.f @ b_aX7
+             @ [GHC.Types.Int]
+             (GHC.Classes.$fOrd[]
+                @ GHC.Types.Int
+                (GHC.Classes.$fEq[] @ GHC.Types.Int GHC.Classes.$fEqInt)
+                GHC.Classes.$fOrdInt)
+      = Spec.f_$sf @ b_aX7
+-}
\ No newline at end of file
diff --git a/testsuite/tests/simplCore/should_compile/T8848a.stderr b/testsuite/tests/simplCore/should_compile/T8848a.stderr
new file mode 100644
index 000000000000..9d06c08461ac
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/T8848a.stderr
@@ -0,0 +1,6 @@
+
+==================== Tidy Core rules ====================
+"SPEC f" [ALWAYS]
+    forall (@ b) ($dOrd :: Ord [Int]). f @ b @ [Int] $dOrd = f_$sf @ b
+
+
diff --git a/testsuite/tests/simplCore/should_compile/all.T b/testsuite/tests/simplCore/should_compile/all.T
index ecc88e176e22..f9a5846eac76 100644
--- a/testsuite/tests/simplCore/should_compile/all.T
+++ b/testsuite/tests/simplCore/should_compile/all.T
@@ -15,8 +15,7 @@ test('simpl011', normal, compile, [''])
 test('simpl012', normal, compile, [''])
 test('simpl013', normal, compile, [''])
 test('simpl014', normal, compile, [''])
-test('simpl015', only_ways(['optasm']), compile, [''])
-test('simpl016', normal, compile, [''])
+test('simpl016', normal, compile, ['-dsuppress-uniques'])
 test('simpl017', normal, compile_fail, [''])
 test('simpl018', normal, compile, [''])
 test('simpl019', normal, compile, [''])
@@ -96,7 +95,7 @@ test('EvalTest',
 
 test('T3831', normal, compile, [''])
 test('T4345', normal, compile, [''])
-test('T4398', normal, compile, [''])
+test('T4398', normal, compile, ['-dsuppress-uniques'])
 
 test('T4903',
      extra_clean(['T4903a.hi', 'T4903a.o']),
@@ -198,3 +197,10 @@ test('T5996',
      run_command,
      ['$MAKE -s --no-print-directory T5996'])
 test('T8537', normal, compile, [''])
+test('T8832',
+     [when(wordsize(32), expect_fail), extra_clean(['T8832.hi', 'T8832a.o'])],
+     run_command,
+     ['$MAKE -s --no-print-directory T8832'])
+test('T8848', only_ways(['optasm']), compile, ['-ddump-rule-firings'])
+test('T8848a', only_ways(['optasm']), compile, ['-ddump-rules'])
+test('T8331', only_ways(['optasm']), compile, ['-ddump-rules'])
diff --git a/testsuite/tests/simplCore/should_compile/rule2.stderr b/testsuite/tests/simplCore/should_compile/rule2.stderr
index dbc7b0ce6964..2c29fa40d536 100644
--- a/testsuite/tests/simplCore/should_compile/rule2.stderr
+++ b/testsuite/tests/simplCore/should_compile/rule2.stderr
@@ -25,6 +25,6 @@ Total ticks:     11
   1 a
   1 m
   1 b
-8 SimplifierDone 8
+9 SimplifierDone 9
 
 
diff --git a/testsuite/tests/simplCore/should_compile/simpl007.hs b/testsuite/tests/simplCore/should_compile/simpl007.hs
index 2b42cc29eebb..c7277b7f66ef 100644
--- a/testsuite/tests/simplCore/should_compile/simpl007.hs
+++ b/testsuite/tests/simplCore/should_compile/simpl007.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE OverlappingInstances, UndecidableInstances,
+{-# LANGUAGE UndecidableInstances,
              ExistentialQuantification, FlexibleInstances #-}
 
 -- module Formula where
@@ -186,7 +186,7 @@ class AddT a where
     addT :: a -> Formula -> Maybe Formula
     addT _ _ = Nothing
 
-instance (FORMULA a) => AddT a where {}
+instance {-# OVERLAPPABLE #-} (FORMULA a) => AddT a where {}
 
 instance AddT Formula where
     addT (Formula f) = addT f
diff --git a/testsuite/tests/simplCore/should_compile/simpl014.hs b/testsuite/tests/simplCore/should_compile/simpl014.hs
index bb96547a6755..2f2e78fa76d5 100644
--- a/testsuite/tests/simplCore/should_compile/simpl014.hs
+++ b/testsuite/tests/simplCore/should_compile/simpl014.hs
@@ -3,7 +3,7 @@
 
 -- This one make SpecConstr generate bogus code (hence -O2), 
 -- with a lint error, in GHC 6.4.1
--- C.f. http://hackage.haskell.org/trac/ghc/ticket/737
+-- C.f. http://ghc.haskell.org/trac/ghc/ticket/737
 
 module ShouldCompile where
 
diff --git a/testsuite/tests/simplCore/should_compile/simpl016.stderr b/testsuite/tests/simplCore/should_compile/simpl016.stderr
index 0bd07fd0eb70..e08b16db8d51 100644
--- a/testsuite/tests/simplCore/should_compile/simpl016.stderr
+++ b/testsuite/tests/simplCore/should_compile/simpl016.stderr
@@ -1,4 +1,10 @@
-
-simpl016.hs:5:1: Warning:
-    Forall'd constraint ‛Num b’ is not bound in RULE lhs
-      delta' @ Int @ b GHC.Classes.$fEqInt
+
+simpl016.hs:5:1: Warning:
+    Forall'd constraint ‘Num b’ is not bound in RULE lhs
+      Orig bndrs: [b, $dNum]
+      Orig lhs: let {
+                  $dEq :: Eq Int
+                  [LclId, Str=DmdType]
+                  $dEq = GHC.Classes.$fEqInt } in
+                delta' @ Int @ b $dEq
+      optimised lhs: delta' @ Int @ b $dEq
diff --git a/testsuite/tests/simplCore/should_compile/simpl017.stderr b/testsuite/tests/simplCore/should_compile/simpl017.stderr
index 681c89024681..18b0a692ce97 100644
--- a/testsuite/tests/simplCore/should_compile/simpl017.stderr
+++ b/testsuite/tests/simplCore/should_compile/simpl017.stderr
@@ -1,44 +1,38 @@
 
 simpl017.hs:44:12:
-    Couldn't match expected type ‛forall v. [E m i] -> E' v m a’
-                with actual type ‛[E m i] -> E' v0 m a’
+    Couldn't match expected type ‘forall v. [E m i] -> E' v m a’
+                with actual type ‘[E m i] -> E' v0 m a’
     Relevant bindings include
       f :: [E m i] -> E' v0 m a (bound at simpl017.hs:43:9)
       ix :: [E m i] -> m i (bound at simpl017.hs:41:9)
       a :: arr i a (bound at simpl017.hs:39:11)
       liftArray :: arr i a -> E m (forall v. [E m i] -> E' v m a)
         (bound at simpl017.hs:39:1)
-    In the first argument of ‛return’, namely ‛f’
+    In the first argument of ‘return’, namely ‘f’
     In a stmt of a 'do' block: return f
 
 simpl017.hs:63:5:
-    Couldn't match type ‛forall v.
-                         [E' RValue (ST s) Int] -> E' v (ST s) Int’
-                  with ‛[E (ST t0) Int] -> E' RValue (ST s) Int’
-    Expected type: [E (ST t0) Int] -> E (ST s) Int
-      Actual type: forall v. [E (ST s) Int] -> E' v (ST s) Int
+    Couldn't match expected type ‘[E (ST t0) Int] -> E (ST s) Int’
+                with actual type ‘forall v. [E (ST s) Int] -> E' v (ST s) Int’
     Relevant bindings include
       a :: forall v. [E (ST s) Int] -> E' v (ST s) Int
         (bound at simpl017.hs:60:5)
       ma :: STArray s Int Int (bound at simpl017.hs:59:5)
       foo :: STArray s Int Int -> ST s Int (bound at simpl017.hs:59:1)
-    The function ‛a’ is applied to one argument,
-    but its type ‛forall v. [E (ST s) Int] -> E' v (ST s) Int’ has none
-    In the first argument of ‛plus’, namely ‛a [one]’
+    The function ‘a’ is applied to one argument,
+    but its type ‘forall v. [E (ST s) Int] -> E' v (ST s) Int’ has none
+    In the first argument of ‘plus’, namely ‘a [one]’
     In a stmt of a 'do' block: a [one] `plus` a [one]
 
 simpl017.hs:63:19:
-    Couldn't match type ‛forall v.
-                         [E' RValue (ST s) Int] -> E' v (ST s) Int’
-                  with ‛[E (ST t1) Int] -> E' RValue (ST s) Int’
-    Expected type: [E (ST t1) Int] -> E (ST s) Int
-      Actual type: forall v. [E (ST s) Int] -> E' v (ST s) Int
+    Couldn't match expected type ‘[E (ST t1) Int] -> E (ST s) Int’
+                with actual type ‘forall v. [E (ST s) Int] -> E' v (ST s) Int’
     Relevant bindings include
       a :: forall v. [E (ST s) Int] -> E' v (ST s) Int
         (bound at simpl017.hs:60:5)
       ma :: STArray s Int Int (bound at simpl017.hs:59:5)
       foo :: STArray s Int Int -> ST s Int (bound at simpl017.hs:59:1)
-    The function ‛a’ is applied to one argument,
-    but its type ‛forall v. [E (ST s) Int] -> E' v (ST s) Int’ has none
-    In the second argument of ‛plus’, namely ‛a [one]’
+    The function ‘a’ is applied to one argument,
+    but its type ‘forall v. [E (ST s) Int] -> E' v (ST s) Int’ has none
+    In the second argument of ‘plus’, namely ‘a [one]’
     In a stmt of a 'do' block: a [one] `plus` a [one]
diff --git a/testsuite/tests/simplCore/should_compile/simpl020.stderr b/testsuite/tests/simplCore/should_compile/simpl020.stderr
index f11001b85755..22b40f8d9fc3 100644
--- a/testsuite/tests/simplCore/should_compile/simpl020.stderr
+++ b/testsuite/tests/simplCore/should_compile/simpl020.stderr
@@ -1,5 +1,5 @@
 
 Simpl020_A.hs:25:10: Warning:
     No explicit implementation for
-      ‛toGUIObject’ and ‛cset’
-    In the instance declaration for ‛GUIObject ()’
+      ‘toGUIObject’ and ‘cset’
+    In the instance declaration for ‘GUIObject ()’
diff --git a/testsuite/tests/simplCore/should_compile/spec001.hs b/testsuite/tests/simplCore/should_compile/spec001.hs
index 0afdaf4a5b01..5a6fb039f467 100644
--- a/testsuite/tests/simplCore/should_compile/spec001.hs
+++ b/testsuite/tests/simplCore/should_compile/spec001.hs
@@ -1,6 +1,5 @@
 {-# LANGUAGE CPP, UnboxedTuples, MagicHash, StandaloneDeriving, DeriveDataTypeable #-}
 {-# OPTIONS_GHC -O #-}
-{-# OPTIONS_GHC -fno-warn-amp #-}
 
 -- In GHC 6.4, compiling this module gave a Core Lint failure following the
 -- specialier, because a function was floated out that had a RULE that
@@ -12,76 +11,77 @@
 
 
 module Data.PackedString.Latin1 (
-	-- * The @PackedString@ type
+        -- * The @PackedString@ type
         PackedString,      -- abstract, instances: Eq, Ord, Show, Typeable
 
          -- * Converting to and from @PackedString@s
-	pack,
-	unpack,
-
-	-- * I\/O with @PackedString@s	
-	hPut, hGet,
-
-	-- * List-like manipulation functions
-	nil,
-	cons,
-	head,
-	tail,
-	null,
-	append,
-	length,
-	index,
-	map,
-	filter,
-	reverse,
-	concat,
-	elem,
-	substr,
-	take,
-	drop,
-	splitAt,
-	foldl,
-	foldr,
-	takeWhile,
-	dropWhile,
-	span,
-	break,
-	lines,
-	unlines,
-	words,
-	unwords,
-	split,
-	splitWith,
-	join,
---	unpackList, -- eek, otherwise it gets thrown away by the simplifier
+        pack,
+        unpack,
+
+        -- * I\/O with @PackedString@s
+        hPut, hGet,
+
+        -- * List-like manipulation functions
+        nil,
+        cons,
+        head,
+        tail,
+        null,
+        append,
+        length,
+        index,
+        map,
+        filter,
+        reverse,
+        concat,
+        elem,
+        substr,
+        take,
+        drop,
+        splitAt,
+        foldl,
+        foldr,
+        takeWhile,
+        dropWhile,
+        span,
+        break,
+        lines,
+        unlines,
+        words,
+        unwords,
+        split,
+        splitWith,
+        join,
+--      unpackList, -- eek, otherwise it gets thrown away by the simplifier
 
     ) where
 
 import qualified Prelude
 import Prelude hiding (
-	head,
-	tail,
-	null,
-	length,
-	(!!),
-	map,
-	filter,
-	reverse,
-	concat,
-	elem,
-	take,
-	drop,
-	foldl,
-	foldr,
-	splitAt,
-	takeWhile,
-	dropWhile,
-	span,
-	break,
-	lines,
-	unlines,
-	words,
-	unwords
+        head,
+        tail,
+        null,
+        length,
+        (!!),
+        map,
+        filter,
+        reverse,
+        concat,
+        elem,
+        take,
+        drop,
+        foldl,
+        foldr,
+        splitAt,
+        takeWhile,
+        dropWhile,
+        span,
+        break,
+        lines,
+        unlines,
+        words,
+        unwords,
+        join
  )
 
 import GHC.Exts
@@ -98,12 +98,12 @@ import System.IO
 -- | A space-efficient representation of a 'String', which supports
 -- various efficient operations.  A 'PackedString' contains Latin1
 -- (8-bit) characters only.
-data PackedString = PS {-#UNPACK#-}!Int {-#UNPACK#-}!Int 
-		       {-#UNPACK#-}!(ForeignPtr Word8)
-	-- this is a pretty efficient representation, and can be
-	-- converted to/from a StorableArray.
-	-- When the ForeignPtr is unpacked, we get the Addr# stored
-	-- directly in the PS constructor.
+data PackedString = PS {-#UNPACK#-}!Int {-#UNPACK#-}!Int
+                       {-#UNPACK#-}!(ForeignPtr Word8)
+        -- this is a pretty efficient representation, and can be
+        -- converted to/from a StorableArray.
+        -- When the ForeignPtr is unpacked, we get the Addr# stored
+        -- directly in the PS constructor.
 
 -- Perhaps making a slice should be conditional on the ratio of the
 -- slice/string size to limit memory leaks.
@@ -116,9 +116,9 @@ instance Ord PackedString where
 
 comparePS (PS off1 len1 fp1) (PS off2 len2 fp2)
   = inlinePerformIO $
-	withForeignPtr fp1 $ \p1 -> 
-	withForeignPtr fp2 $ \p2 ->
-	cmp (p1 `plusPtr` off1) (p2 `plusPtr` off2) len1
+        withForeignPtr fp1 $ \p1 ->
+        withForeignPtr fp2 $ \p2 ->
+        cmp (p1 `plusPtr` off1) (p2 `plusPtr` off2) len1
   where
     cmp :: Ptr Word8 -> Ptr Word8 -> Int -> IO Ordering
     cmp p1 p2 n
@@ -128,9 +128,9 @@ comparePS (PS off1 len1 fp1) (PS off2 len2 fp2)
           a <- peekElemOff p1 n
           b <- peekElemOff p2 n
           case a `compare` b of
-		EQ -> cmp p1 p2 (n+1)      
-		LT -> return LT
-		GT -> return GT
+                EQ -> cmp p1 p2 (n+1)
+                LT -> return LT
+                GT -> return GT
 
 --instance Read PackedString: ToDo
 
@@ -145,8 +145,8 @@ deriving instance Typeable PackedString
 -- | The 'nilPS' value is the empty string.
 nil :: PackedString
 nil = inlinePerformIO $ do
-		fp <- newForeignPtr_ nullPtr
-		return (PS 0 0 fp)
+                fp <- newForeignPtr_ nullPtr
+                return (PS 0 0 fp)
 
 -- | The 'consPS' function prepends the given character to the
 -- given string.
@@ -155,11 +155,11 @@ cons c cs = pack (c : (unpack cs)) -- ToDo:better
 
 -- | Convert a 'String' into a 'PackedString'
 packLen :: Int -> String -> PackedString
-packLen len str = inlinePerformIO $ do 
+packLen len str = inlinePerformIO $ do
   fp <- mallocForeignPtrBytes len
-  withForeignPtr fp $ \p -> do 
-	fill_it_in p 0 str
-	return (PS 0 len fp)
+  withForeignPtr fp $ \p -> do
+        fill_it_in p 0 str
+        return (PS 0 len fp)
 
 fill_it_in p i [] = return ()
 fill_it_in p i (c:cs) = do pokeElemOff p i (c2w c); fill_it_in p (i+1) cs
@@ -185,7 +185,7 @@ length (PS _ len _) = len
 -- | The 'index' function returns the character in the string at the
 -- given position.
 index :: PackedString -> Int -> Char
-index ps i 
+index ps i
   | i >= 0 && i < len = unsafeIndex ps i
   | otherwise = error "Data.PackedString.Latin1.index: index out of range"
   where len = length ps
@@ -245,7 +245,7 @@ take :: Int -> PackedString -> PackedString
 take n ps = substr ps 0 (n-1)
 
 -- | The 'drop' function drops the first @n@ characters of a 'PackedString'.
-drop	:: Int -> PackedString -> PackedString
+drop    :: Int -> PackedString -> PackedString
 drop n ps = substr ps n (length ps - 1)
 
 -- | The 'splitWith' function splits a 'PackedString' at a given index.
@@ -315,7 +315,7 @@ join filler pss = concat (splice pss)
 {-
   Some properties that hold:
 
-  * split x ls = ls'   
+  * split x ls = ls'
       where False = any (map (x `elem`) ls')
 
   * join (pack [x]) (split x ls) = ls
@@ -333,15 +333,15 @@ splitWith' pred off len fp =
   withPackedString fp $ \p -> splitLoop pred p 0 off len fp
 
 splitLoop pred p idx off len fp
-	| p `seq` idx `seq` off `seq` fp `seq` False = undefined
+        | p `seq` idx `seq` off `seq` fp `seq` False = undefined
 splitLoop pred p idx off len fp
-	| idx >= len  = return [PS off idx fp]
-	| otherwise = do
-		w <- peekElemOff p (off+idx)
-		if pred (w2c w) 
-		   then return (PS off idx fp : 
-			          splitWith' pred (off+idx+1) (len-idx-1) fp)
-		   else splitLoop pred p (idx+1) off len fp
+        | idx >= len  = return [PS off idx fp]
+        | otherwise = do
+                w <- peekElemOff p (off+idx)
+                if pred (w2c w)
+                   then return (PS off idx fp :
+                                  splitWith' pred (off+idx+1) (len-idx-1) fp)
+                   else splitLoop pred p (idx+1) off len fp
 
 -- -----------------------------------------------------------------------------
 -- Local utility functions
@@ -372,9 +372,9 @@ hPut h (PS off l fp) =
 
 -- | Read a 'PackedString' directly from the specified 'Handle'.
 -- This is far more efficient than reading the characters into a 'String'
--- and then using 'pack'.  
+-- and then using 'pack'.
 --
--- NOTE: as with 'hPut', the string representation in the file is 
+-- NOTE: as with 'hPut', the string representation in the file is
 -- assumed to be Latin-1.
 hGet :: Handle -> Int -> IO PackedString
 hGet h i = do
@@ -398,19 +398,19 @@ unpackList :: PackedString -> [Char]
 unpackList (PS off len fp) =
    withPackedString fp $ \p -> do
       let loop p (-1) acc = return acc
-	  loop p n acc = do
+          loop p n acc = do
              a <- peekElemOff p n
-	     loop p (n-1) (w2c a : acc)
+             loop p (n-1) (w2c a : acc)
       loop (p `plusPtr` off) (len-1) []
 
 {-# INLINE [0] unpackFoldr #-}
 unpackFoldr :: PackedString -> (Char -> a -> a) -> a -> a
-unpackFoldr (PS off len fp) f c = 
+unpackFoldr (PS off len fp) f c =
    withPackedString fp $ \p -> do
       let loop p (-1) acc = return acc
-	  loop p n acc = do
+          loop p n acc = do
              a <- peekElemOff p n
-	     loop p (n-1) (w2c a `f` acc)
+             loop p (n-1) (w2c a `f` acc)
       loop (p `plusPtr` off) (len-1) c
 
 -- -----------------------------------------------------------------------------
diff --git a/testsuite/tests/simplCore/should_run/T2110.hs b/testsuite/tests/simplCore/should_run/T2110.hs
new file mode 100644
index 000000000000..610be095ae2d
--- /dev/null
+++ b/testsuite/tests/simplCore/should_run/T2110.hs
@@ -0,0 +1,24 @@
+{-# LANGUAGE MagicHash #-}
+
+import GHC.Exts
+import Unsafe.Coerce
+
+newtype Age = Age Int
+
+fooAge :: [Int] -> [Age]
+fooAge = map Age
+fooCoerce :: [Int] -> [Age]
+fooCoerce = map coerce
+fooUnsafeCoerce :: [Int] -> [Age]
+fooUnsafeCoerce = map unsafeCoerce
+
+same :: a -> b -> IO ()
+same x y = case reallyUnsafePtrEquality# (unsafeCoerce x) y of
+    1# -> putStrLn "yes"
+    _  -> putStrLn "no"
+
+main = do
+    let l = [1,2,3]
+    same (fooAge l) l
+    same (fooCoerce l) l
+    same (fooUnsafeCoerce l) l
diff --git a/testsuite/tests/simplCore/should_run/T2110.stdout b/testsuite/tests/simplCore/should_run/T2110.stdout
new file mode 100644
index 000000000000..55f7ebb441c0
--- /dev/null
+++ b/testsuite/tests/simplCore/should_run/T2110.stdout
@@ -0,0 +1,3 @@
+yes
+yes
+yes
diff --git a/testsuite/tests/simplCore/should_run/T2486.stderr b/testsuite/tests/simplCore/should_run/T2486.stderr
index 968e8dbdb40b..c85297c5cb44 100644
--- a/testsuite/tests/simplCore/should_run/T2486.stderr
+++ b/testsuite/tests/simplCore/should_run/T2486.stderr
@@ -1,24 +1,20 @@
 
 ==================== Tidy Core rules ====================
 "SPEC Main.fib [GHC.Types.Double]" [ALWAYS]
-    forall ($dNum :: GHC.Num.Num GHC.Types.Double)
-           ($dOrd :: GHC.Classes.Ord GHC.Types.Double).
-      Main.fib @ GHC.Types.Double $dNum $dOrd
-      = Main.fib_$sfib1
+    forall ($dNum :: Num Double) ($dOrd :: Ord Double).
+      fib @ Double $dNum $dOrd
+      = fib_$sfib1
 "SPEC Main.fib [GHC.Types.Int]" [ALWAYS]
-    forall ($dNum :: GHC.Num.Num GHC.Types.Int)
-           ($dOrd :: GHC.Classes.Ord GHC.Types.Int).
-      Main.fib @ GHC.Types.Int $dNum $dOrd
-      = Main.fib_$sfib
+    forall ($dNum :: Num Int) ($dOrd :: Ord Int).
+      fib @ Int $dNum $dOrd
+      = fib_$sfib
 "SPEC Main.tak [GHC.Types.Double]" [ALWAYS]
-    forall ($dNum :: GHC.Num.Num GHC.Types.Double)
-           ($dOrd :: GHC.Classes.Ord GHC.Types.Double).
-      Main.tak @ GHC.Types.Double $dNum $dOrd
-      = Main.tak_$stak1
+    forall ($dNum :: Num Double) ($dOrd :: Ord Double).
+      tak @ Double $dNum $dOrd
+      = tak_$stak1
 "SPEC Main.tak [GHC.Types.Int]" [ALWAYS]
-    forall ($dNum :: GHC.Num.Num GHC.Types.Int)
-           ($dOrd :: GHC.Classes.Ord GHC.Types.Int).
-      Main.tak @ GHC.Types.Int $dNum $dOrd
-      = Main.tak_$stak
+    forall ($dNum :: Num Int) ($dOrd :: Ord Int).
+      tak @ Int $dNum $dOrd
+      = tak_$stak
 
 
diff --git a/testsuite/tests/simplCore/should_run/T9128.hs b/testsuite/tests/simplCore/should_run/T9128.hs
new file mode 100644
index 000000000000..73aa39b31bd1
--- /dev/null
+++ b/testsuite/tests/simplCore/should_run/T9128.hs
@@ -0,0 +1,12 @@
+module Main where
+
+newtype T a = MkT a
+
+-- Trac #9128: we treated x as absent!!!!
+
+f x = let {-# NOINLINE h #-}
+          h = case x of MkT g -> g
+      in 
+      h (h (h (h (h (h True)))))
+
+main = print (f (MkT id))
diff --git a/testsuite/tests/simplCore/should_run/T9128.stdout b/testsuite/tests/simplCore/should_run/T9128.stdout
new file mode 100644
index 000000000000..0ca95142bb71
--- /dev/null
+++ b/testsuite/tests/simplCore/should_run/T9128.stdout
@@ -0,0 +1 @@
+True
diff --git a/testsuite/tests/simplCore/should_run/T9390.hs b/testsuite/tests/simplCore/should_run/T9390.hs
new file mode 100644
index 000000000000..04b4da0e4dde
--- /dev/null
+++ b/testsuite/tests/simplCore/should_run/T9390.hs
@@ -0,0 +1,27 @@
+{-# LANGUAGE MagicHash, UnboxedTuples #-}
+module Main(main ) where
+
+import GHC.IO (IO (..))
+import GHC.Prim
+
+writeB :: MutableArray# RealWorld Char -> IO ()
+writeB arr# = IO $ \s0# -> (# writeArray# arr# 0# 'B' s0#, () #)
+
+inlineWriteB :: MutableArray# RealWorld Char -> ()
+inlineWriteB arr# =
+    case f realWorld# of
+        (# _, x #) -> x
+  where
+    IO f = writeB arr#
+
+test :: IO Char
+test = IO $ \s0# ->
+  case newArray# 1# 'A' s0# of
+    (# s1#, arr# #) ->
+      case seq# (inlineWriteB arr#) s1# of
+        (# s2#, () #) ->
+          readArray# arr# 0# s2#
+
+main :: IO ()
+main = test >>= print
+
diff --git a/testsuite/tests/simplCore/should_run/T9390.stdout b/testsuite/tests/simplCore/should_run/T9390.stdout
new file mode 100644
index 000000000000..69349b451d18
--- /dev/null
+++ b/testsuite/tests/simplCore/should_run/T9390.stdout
@@ -0,0 +1 @@
+'B'
diff --git a/testsuite/tests/simplCore/should_run/all.T b/testsuite/tests/simplCore/should_run/all.T
index 430d61f1c5fd..93dc4c66f9b8 100644
--- a/testsuite/tests/simplCore/should_run/all.T
+++ b/testsuite/tests/simplCore/should_run/all.T
@@ -21,6 +21,7 @@ test('simplrun009', normal, compile_and_run, [''])
 test('simplrun010', [extra_run_opts('24 16 8 +RTS -M10m -RTS'),
                      exit_code(251)]
                   , compile_and_run, [''])
+test('simplrun011', normal, compile_and_run, [''])
 
 # Really we'd like to run T2486 too, to check that its
 # runtime has not gone up, but here I just compile it so that
@@ -51,6 +52,7 @@ test('T5453', normal, compile_and_run, [''])
 test('T5441', extra_clean(['T5441a.o','T5441a.hi']), 
               multimod_compile_and_run, ['T5441',''])
 test('T5603', normal, compile_and_run, [''])
+test('T2110', normal, compile_and_run, [''])
 
 # Run these tests *without* optimisation too
 test('T5625', [ only_ways(['normal','optasm']), exit_code(1) ], compile_and_run, [''])
@@ -63,3 +65,6 @@ test('T7924', exit_code(1), compile_and_run, [''])
 
 # Run this test *without* optimisation too
 test('T457', [ only_ways(['normal','optasm']), exit_code(1) ], compile_and_run, [''])
+
+test('T9128', normal, compile_and_run, [''])
+test('T9390', normal, compile_and_run, [''])
diff --git a/testsuite/tests/simplCore/should_run/simplrun011.hs b/testsuite/tests/simplCore/should_run/simplrun011.hs
new file mode 100644
index 000000000000..e7f664602b4f
--- /dev/null
+++ b/testsuite/tests/simplCore/should_run/simplrun011.hs
@@ -0,0 +1,37 @@
+module Main where
+
+import GHC.Exts
+
+-- This checks that rules look through unfoldings when matching
+-- lambdas, but only in the right phase
+
+foo :: (Int -> IO ()) -> IO ()
+foo f = putStr "not fired: " >> f 0
+{-# NOINLINE foo #-}
+
+f1 :: Int -> IO ()
+f1 _ = putStrLn "f1"
+{-# NOINLINE[0] f1 #-}
+
+f2 :: Int -> IO ()
+f2 _ = putStrLn "f2"
+{-# NOINLINE f2 #-}
+
+newtype Age = MkAge Int
+
+-- It also checks that this can look through casted lambdas
+
+f3 :: Age -> IO ()
+f3 _ = putStrLn "f3"
+{-# NOINLINE[0] f3 #-}
+
+
+{-# RULES "foo" [0] forall g . foo (\x -> g) = putStr "fired: " >> g #-}
+
+main = do
+    foo f1
+    foo f1
+    foo f2
+    foo f2
+    foo (coerce f3)
+    foo (coerce f3)
diff --git a/testsuite/tests/simplCore/should_run/simplrun011.stdout b/testsuite/tests/simplCore/should_run/simplrun011.stdout
new file mode 100644
index 000000000000..3751791728f4
--- /dev/null
+++ b/testsuite/tests/simplCore/should_run/simplrun011.stdout
@@ -0,0 +1,6 @@
+fired: f1
+fired: f1
+not fired: f2
+not fired: f2
+fired: f3
+fired: f3
diff --git a/testsuite/tests/stranal/should_compile/T8743.hs b/testsuite/tests/stranal/should_compile/T8743.hs
new file mode 100644
index 000000000000..a69e5222ed58
--- /dev/null
+++ b/testsuite/tests/stranal/should_compile/T8743.hs
@@ -0,0 +1,11 @@
+module T8743 where
+
+-- Without the following import, it does not fail
+import {-# SOURCE #-} T8743 ()
+
+-- [()] required, () does not work.
+class ToRow a where toRow :: a -> [()]
+
+instance ToRow (Maybe a) where
+    toRow Nothing  = [()]
+    toRow (Just _) = [()]
diff --git a/testsuite/tests/stranal/should_compile/T8743.hs-boot b/testsuite/tests/stranal/should_compile/T8743.hs-boot
new file mode 100644
index 000000000000..7f22b248c281
--- /dev/null
+++ b/testsuite/tests/stranal/should_compile/T8743.hs-boot
@@ -0,0 +1,3 @@
+module T8743 where
+class ToRow a
+instance ToRow (Maybe a)
diff --git a/testsuite/tests/stranal/should_compile/T9208.hs b/testsuite/tests/stranal/should_compile/T9208.hs
new file mode 100644
index 000000000000..d3415bb8599f
--- /dev/null
+++ b/testsuite/tests/stranal/should_compile/T9208.hs
@@ -0,0 +1,98 @@
+{-# LANGUAGE CPP, LambdaCase, BangPatterns, MagicHash, TupleSections, ScopedTypeVariables #-}
+{-# OPTIONS_GHC -w #-}  -- Suppress warnings for unimplemented methods
+
+{- | Evaluate Template Haskell splices on node.js,
+     using pipes to communicate with GHCJS
+ -}
+
+-- module GHCJS.Prim.TH.Eval
+module Eval (
+         runTHServer
+       ) where
+
+import           Control.Applicative
+import           Control.Monad
+
+import           Data.Binary
+import           Data.Binary.Get
+import           Data.ByteString          (ByteString)
+import qualified Data.ByteString          as B
+import qualified Data.ByteString.Lazy     as BL
+
+import           GHC.Prim
+
+import qualified Language.Haskell.TH        as TH
+import qualified Language.Haskell.TH.Syntax as TH
+
+import           Unsafe.Coerce
+
+data THResultType = THExp | THPat | THType | THDec
+
+data Message
+  -- | GHCJS compiler to node.js requests
+  = RunTH THResultType ByteString TH.Loc 
+  -- | node.js to GHCJS compiler responses
+  | RunTH' THResultType ByteString [TH.Dec] -- ^ serialized AST and additional toplevel declarations
+
+instance Binary THResultType where
+  put _ = return ()
+  get   = return undefined
+
+instance Binary Message where
+  put _ = return ()
+  get   = return undefined
+
+data QState = QState
+
+data GHCJSQ a = GHCJSQ { runGHCJSQ :: QState -> IO (a, QState) }
+
+instance Functor GHCJSQ where
+  fmap f (GHCJSQ s) = GHCJSQ $ fmap (\(x,s') -> (f x,s')) . s
+
+instance Applicative GHCJSQ where
+  f <*> a = GHCJSQ $ \s ->
+    do (f',s')   <- runGHCJSQ f s
+       (a', s'') <- runGHCJSQ a s'
+       return (f' a', s'')
+  pure x = GHCJSQ (\s -> return (x,s))
+
+instance Monad GHCJSQ where
+  (>>=) m f = GHCJSQ $ \s ->
+    do (m', s')  <- runGHCJSQ m s
+       (a,  s'') <- runGHCJSQ (f m') s'
+       return (a, s'')
+  return    = pure
+
+instance TH.Quasi GHCJSQ where qRunIO m = GHCJSQ $ \s -> fmap (,s) m
+
+-- | the Template Haskell server
+runTHServer :: IO ()
+runTHServer = void $ runGHCJSQ server QState
+  where
+    server = TH.qRunIO awaitMessage >>= \case
+      RunTH t code loc -> do
+        a <- TH.qRunIO $ loadTHData code
+        runTH t a loc
+      _ -> TH.qRunIO (putStrLn "warning: ignoring unexpected message type")
+
+runTH :: THResultType -> Any -> TH.Loc -> GHCJSQ ()
+runTH rt obj loc = do
+  res <- case rt of
+           THExp  -> runTHCode (unsafeCoerce obj :: TH.Q TH.Exp)
+           THPat  -> runTHCode (unsafeCoerce obj :: TH.Q TH.Pat) 
+           THType -> runTHCode (unsafeCoerce obj :: TH.Q TH.Type)
+           THDec  -> runTHCode (unsafeCoerce obj :: TH.Q [TH.Dec])
+  TH.qRunIO (sendResult $ RunTH' rt res [])
+
+runTHCode :: {- Binary a => -} TH.Q a -> GHCJSQ ByteString
+runTHCode c = TH.runQ c >> return B.empty
+
+loadTHData :: ByteString -> IO Any
+loadTHData bs = return (unsafeCoerce ()) 
+
+awaitMessage :: IO Message
+awaitMessage = fmap (runGet get) (return BL.empty)
+
+-- | send result back
+sendResult :: Message -> IO ()
+sendResult msg = return ()
diff --git a/testsuite/tests/stranal/should_compile/all.T b/testsuite/tests/stranal/should_compile/all.T
index 7ee45ad358bc..184ff1ec882f 100644
--- a/testsuite/tests/stranal/should_compile/all.T
+++ b/testsuite/tests/stranal/should_compile/all.T
@@ -18,3 +18,8 @@ test('newtype', req_profiling, compile, ['-prof -auto-all'])
 test('T1988', normal, compile, [''])
 test('T8467', normal, compile, [''])
 test('T8037', normal, compile, [''])
+test('T8743', [ extra_clean(['T8743.o-boot', 'T8743.hi-boot']) ], multimod_compile, ['T8743', '-v0'])
+
+test('T9208', when(compiler_debugged(), expect_broken(9208)), compile, [''])
+# T9208 fails (and should do so) if you have assertion checking on in the compiler
+# Hence the above expect_broken.  See comments in the Trac ticket
\ No newline at end of file
diff --git a/testsuite/tests/stranal/should_run/T9254.hs b/testsuite/tests/stranal/should_run/T9254.hs
new file mode 100644
index 000000000000..279eb5c1ec15
--- /dev/null
+++ b/testsuite/tests/stranal/should_run/T9254.hs
@@ -0,0 +1,20 @@
+{-# LANGUAGE MagicHash, UnboxedTuples #-}
+module Main where
+import GHC.Exts
+
+f :: (() -> (# Int#, () #)) -> ()
+{-# NOINLINE f #-}
+-- Strictness signature was (7.8.2)
+--    <C(S(LS)), 1*C1(U(A,1*U()))>
+-- I.e. calls k, but discards first component of result
+f k = case k () of (# _, r #) -> r
+
+g :: Int -> ()
+g y = f (\n -> (# case y of I# y2 -> h (h (h (h (h (h (h y2)))))), n #))
+   -- RHS is big enough to force worker/wrapper
+
+{-# NOINLINE h #-}
+h :: Int# -> Int#
+h n = n +# 1#
+
+main = print (g 1)
diff --git a/testsuite/tests/stranal/should_run/T9254.stdout b/testsuite/tests/stranal/should_run/T9254.stdout
new file mode 100644
index 000000000000..6a452c185a8c
--- /dev/null
+++ b/testsuite/tests/stranal/should_run/T9254.stdout
@@ -0,0 +1 @@
+()
diff --git a/testsuite/tests/stranal/should_run/all.T b/testsuite/tests/stranal/should_run/all.T
index 0c43aac8c4ad..2ca65b511038 100644
--- a/testsuite/tests/stranal/should_run/all.T
+++ b/testsuite/tests/stranal/should_run/all.T
@@ -7,3 +7,4 @@ test('strun003', normal, compile_and_run, [''])
 test('strun004', normal, compile_and_run, [''])
 test('T2756b', normal, compile_and_run, [''])
 test('T7649', normal, compile_and_run, [''])
+test('T9254', normal, compile_and_run, [''])
diff --git a/testsuite/tests/stranal/sigs/all.T b/testsuite/tests/stranal/sigs/all.T
index 9d36479c172f..9accd01af5dc 100644
--- a/testsuite/tests/stranal/sigs/all.T
+++ b/testsuite/tests/stranal/sigs/all.T
@@ -8,7 +8,7 @@ setTestOpts(extra_hc_opts('-ddump-strsigs'))
 setTestOpts(only_ways(['optasm']))
 
 test('StrAnalExample', normal, compile, [''])
-test('T8569', expect_broken(8569), compile, [''])
+test('T8569', normal, compile, [''])
 test('HyperStrUse', normal, compile, [''])
 test('T8598', normal, compile, [''])
 test('FacState', expect_broken(1600), compile, [''])
diff --git a/testsuite/tests/th/T2674.stderr b/testsuite/tests/th/T2674.stderr
index 6875684dda79..0d9a3826ffcf 100644
--- a/testsuite/tests/th/T2674.stderr
+++ b/testsuite/tests/th/T2674.stderr
@@ -1,4 +1,4 @@
 
 T2674.hs:9:3:
-    Function binding for ‛foo’ has no equations
+    Function binding for ‘foo’ has no equations
     When splicing a TH declaration: 
diff --git a/testsuite/tests/th/T2713.stderr b/testsuite/tests/th/T2713.stderr
index c036b4384817..89a15ca83a5f 100644
--- a/testsuite/tests/th/T2713.stderr
+++ b/testsuite/tests/th/T2713.stderr
@@ -1,8 +1,8 @@
 
 T2713.hs:11:10:
-    The fixity signature for ‛.*.’ lacks an accompanying binding
-      (The fixity signature must be given where ‛.*.’ is declared)
+    The fixity signature for ‘.*.’ lacks an accompanying binding
+      (The fixity signature must be given where ‘.*.’ is declared)
 
 T2713.hs:12:1:
-    The type signature for ‛f’ lacks an accompanying binding
-      (The type signature must be given where ‛f’ is declared)
+    The type signature for ‘f’ lacks an accompanying binding
+      (The type signature must be given where ‘f’ is declared)
diff --git a/testsuite/tests/th/T3177a.stderr b/testsuite/tests/th/T3177a.stderr
index 94d4f2e2d141..88614ff3e846 100644
--- a/testsuite/tests/th/T3177a.stderr
+++ b/testsuite/tests/th/T3177a.stderr
@@ -1,8 +1,8 @@
 
 T3177a.hs:8:6:
-    ‛Int’ is applied to too many type arguments
-    In the type signature for ‛f’: f :: Int Int
+    ‘Int’ is applied to too many type arguments
+    In the type signature for ‘f’: f :: Int Int
 
 T3177a.hs:11:6:
-    ‛Int’ is applied to too many type arguments
-    In the type signature for ‛g’: g :: Int Int
+    ‘Int’ is applied to too many type arguments
+    In the type signature for ‘g’: g :: Int Int
diff --git a/testsuite/tests/th/T4135a.hs b/testsuite/tests/th/T4135a.hs
index 41549cad4043..d78de088a065 100644
--- a/testsuite/tests/th/T4135a.hs
+++ b/testsuite/tests/th/T4135a.hs
@@ -1,5 +1,5 @@
 {-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, TypeFamilies,
-             FlexibleInstances, OverlappingInstances #-}
+             FlexibleInstances #-}
 
 module T4135a where
 
diff --git a/testsuite/tests/th/T5795.stderr b/testsuite/tests/th/T5795.stderr
index 757ba72cfd5e..bdc218c86c43 100644
--- a/testsuite/tests/th/T5795.stderr
+++ b/testsuite/tests/th/T5795.stderr
@@ -1,6 +1,6 @@
 
 T5795.hs:9:6:
     GHC stage restriction:
-      ‛ty’ is used in a top-level splice or annotation,
+      ‘ty’ is used in a top-level splice or annotation,
       and must be imported, not defined locally
     In the splice: $ty
diff --git a/testsuite/tests/th/T5971.stderr b/testsuite/tests/th/T5971.stderr
index 9d647d1ea73e..07bae41015a4 100644
--- a/testsuite/tests/th/T5971.stderr
+++ b/testsuite/tests/th/T5971.stderr
@@ -1,6 +1,6 @@
 
 T5971.hs:6:7:
-    The exact Name ‛x’ is not in scope
+    The exact Name ‘x’ is not in scope
       Probable cause: you used a unique Template Haskell name (NameU), 
       perhaps via newName, but did not bind it
       If that's it, then -ddump-splices might be useful
diff --git a/testsuite/tests/th/T6114.stderr b/testsuite/tests/th/T6114.stderr
index 6267aa6405c1..917b56f768fe 100644
--- a/testsuite/tests/th/T6114.stderr
+++ b/testsuite/tests/th/T6114.stderr
@@ -1,6 +1,6 @@
 
 T6114.hs:6:17:
-    The exact Name ‛x’ is not in scope
+    The exact Name ‘x’ is not in scope
       Probable cause: you used a unique Template Haskell name (NameU), 
       perhaps via newName, but did not bind it
       If that's it, then -ddump-splices might be useful
diff --git a/testsuite/tests/th/T7021.hs b/testsuite/tests/th/T7021.hs
new file mode 100644
index 000000000000..31e18431addd
--- /dev/null
+++ b/testsuite/tests/th/T7021.hs
@@ -0,0 +1,7 @@
+{-# LANGUAGE TemplateHaskell #-}
+module T7021 where
+
+import T7021a
+
+func :: a -> Int
+func = $(test)
diff --git a/testsuite/tests/th/T7021a.hs b/testsuite/tests/th/T7021a.hs
new file mode 100644
index 000000000000..bd191336dd6e
--- /dev/null
+++ b/testsuite/tests/th/T7021a.hs
@@ -0,0 +1,31 @@
+{-# LANGUAGE ConstraintKinds, TemplateHaskell, PolyKinds, TypeFamilies #-}
+
+module T7021a where
+
+import GHC.Prim
+import Language.Haskell.TH
+
+type IOable a = (Show a, Read a)
+type family ALittleSilly :: Constraint
+
+data Proxy a = Proxy
+
+foo :: IOable a => a
+foo = undefined
+
+baz :: a b => Proxy a -> b
+baz = undefined
+
+bar :: ALittleSilly  => a
+bar = undefined
+
+test :: Q Exp
+test = do
+    Just fooName <- lookupValueName "foo"
+    Just bazName <- lookupValueName "baz"
+    Just barName <- lookupValueName "bar"
+    reify fooName
+    reify bazName
+    reify barName
+    [t| (Show a, (Read a, Num a)) => a -> a |]
+    [| \_ -> 0 |]
diff --git a/testsuite/tests/th/T7241.hs b/testsuite/tests/th/T7241.hs
new file mode 100644
index 000000000000..971a2678f898
--- /dev/null
+++ b/testsuite/tests/th/T7241.hs
@@ -0,0 +1,7 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+module T7241 where
+
+import Language.Haskell.TH
+
+$(newName "Foo" >>= \o -> return [DataD [] o [] [RecC o []] []])
diff --git a/testsuite/tests/th/T7241.stderr b/testsuite/tests/th/T7241.stderr
new file mode 100644
index 000000000000..343cdc827d40
--- /dev/null
+++ b/testsuite/tests/th/T7241.stderr
@@ -0,0 +1,6 @@
+
+T7241.hs:7:3:
+    Duplicate exact Name ‘Foo’
+      Probable cause: you used a unique Template Haskell name (NameU), 
+      perhaps via newName, but bound it multiple times
+      If that's it, then -ddump-splices might be useful
diff --git a/testsuite/tests/th/T7276.stderr b/testsuite/tests/th/T7276.stderr
index 7b7696661747..8d6f54557641 100644
--- a/testsuite/tests/th/T7276.stderr
+++ b/testsuite/tests/th/T7276.stderr
@@ -1,7 +1,7 @@
 
 T7276.hs:6:8:
-    Couldn't match type ‛[Language.Haskell.TH.Syntax.Dec]’
-                  with ‛Language.Haskell.TH.Syntax.Exp’
+    Couldn't match type ‘[Language.Haskell.TH.Syntax.Dec]’
+                  with ‘Language.Haskell.TH.Syntax.Exp’
     Expected type: Language.Haskell.TH.Lib.ExpQ
       Actual type: Language.Haskell.TH.Lib.DecsQ
     In the expression: [d| y = 3 |]
diff --git a/testsuite/tests/th/T7276a.stdout b/testsuite/tests/th/T7276a.stdout
index 2edeaaeb3f03..6ad7f9890752 100644
--- a/testsuite/tests/th/T7276a.stdout
+++ b/testsuite/tests/th/T7276a.stdout
@@ -1,19 +1,19 @@
 
 <interactive>:4:9: Warning:
-    Couldn't match type ‛[Dec]’ with ‛Exp’
+    Couldn't match type ‘[Dec]’ with ‘Exp’
     Expected type: Q Exp
       Actual type: DecsQ
     In the expression: [d| a = () |] :: Q Exp
-    In an equation for ‛x’: x = [d| a = () |] :: Q Exp
+    In an equation for ‘x’: x = [d| a = () |] :: Q Exp
 
 <interactive>:1:1:
     Exception when trying to run compile-time code:
       <interactive>:4:9:
-    Couldn't match type ‛[Dec]’ with ‛Exp’
+    Couldn't match type ‘[Dec]’ with ‘Exp’
     Expected type: Q Exp
       Actual type: DecsQ
     In the expression: [d| a = () |] :: Q Exp
-    In an equation for ‛x’: x = [d| a = () |] :: Q Exp
+    In an equation for ‘x’: x = [d| a = () |] :: Q Exp
 (deferred type error)
     Code: x
     In the splice: $x
diff --git a/testsuite/tests/th/T7477.stderr b/testsuite/tests/th/T7477.stderr
index f6a9e0de892d..f94de686d091 100644
--- a/testsuite/tests/th/T7477.stderr
+++ b/testsuite/tests/th/T7477.stderr
@@ -1,3 +1,3 @@
 
 T7477.hs:10:4: Warning:
-    type instance T7477.F GHC.Prim.* GHC.Types.Int = GHC.Types.Bool
+    type instance T7477.F GHC.Types.Int = GHC.Types.Bool
diff --git a/testsuite/tests/th/T7667a.stderr b/testsuite/tests/th/T7667a.stderr
index 7e85d06017b4..1b54ed3c8661 100644
--- a/testsuite/tests/th/T7667a.stderr
+++ b/testsuite/tests/th/T7667a.stderr
@@ -1,5 +1,5 @@
 
 T7667a.hs:8:12:
-    Illegal variable name: ‛False’
+    Illegal variable name: ‘False’
     When splicing a TH expression: False
     In the splice: $(return $ VarE (mkName "False"))
diff --git a/testsuite/tests/th/T8577.stderr b/testsuite/tests/th/T8577.stderr
index 6e35e4a6b544..734007e6cc36 100644
--- a/testsuite/tests/th/T8577.stderr
+++ b/testsuite/tests/th/T8577.stderr
@@ -1,6 +1,6 @@
 
 T8577.hs:9:11:
-    Couldn't match type ‛Int’ with ‛Bool’
+    Couldn't match type ‘Int’ with ‘Bool’
     Expected type: Q (TExp (A Bool))
       Actual type: Q (TExp (A Int))
     In the expression: y
diff --git a/testsuite/tests/th/T8625.stdout b/testsuite/tests/th/T8625.stdout
index e6ce48be3a73..4453d692ba16 100644
--- a/testsuite/tests/th/T8625.stdout
+++ b/testsuite/tests/th/T8625.stdout
@@ -1,2 +1,2 @@
-[InstanceD [EqualP (VarT y_0) (AppT (AppT ArrowT (VarT t_1)) (VarT t_1))] (AppT (ConT Ghci1.Member) (ConT GHC.Types.Bool)) []]
-[SigD f_2 (ForallT [PlainTV y_3,PlainTV t_4] [EqualP (VarT y_3) (AppT (AppT ArrowT (VarT t_4)) (VarT t_4))] (AppT (AppT ArrowT (VarT y_3)) (VarT t_4))),FunD f_2 [Clause [VarP x_5] (NormalB (VarE x_5)) []]]
+[InstanceD [AppT (AppT EqualityT (VarT y_0)) (AppT (AppT ArrowT (VarT t_1)) (VarT t_1))] (AppT (ConT Ghci1.Member) (ConT GHC.Types.Bool)) []]
+[SigD f_2 (ForallT [PlainTV y_3,PlainTV t_4] [AppT (AppT EqualityT (VarT y_3)) (AppT (AppT ArrowT (VarT t_4)) (VarT t_4))] (AppT (AppT ArrowT (VarT y_3)) (VarT t_4))),FunD f_2 [Clause [VarP x_5] (NormalB (VarE x_5)) []]]
diff --git a/testsuite/tests/th/T8759.hs b/testsuite/tests/th/T8759.hs
new file mode 100644
index 000000000000..298761a5a4ce
--- /dev/null
+++ b/testsuite/tests/th/T8759.hs
@@ -0,0 +1,11 @@
+{-# LANGUAGE TemplateHaskell, PatternSynonyms #-}
+
+module T8759 where
+
+import Language.Haskell.TH
+
+pattern P = ()
+
+$( do info <- reify 'P
+      reportWarning (show info)
+      return [] )
diff --git a/testsuite/tests/th/T8759.stderr b/testsuite/tests/th/T8759.stderr
new file mode 100644
index 000000000000..3b5474b1ae16
--- /dev/null
+++ b/testsuite/tests/th/T8759.stderr
@@ -0,0 +1,3 @@
+
+T8759.hs:9:4:
+    Can't represent pattern synonyms in Template Haskell: P
diff --git a/testsuite/tests/th/T8759a.hs b/testsuite/tests/th/T8759a.hs
new file mode 100644
index 000000000000..3d8089c2fa64
--- /dev/null
+++ b/testsuite/tests/th/T8759a.hs
@@ -0,0 +1,5 @@
+{-# LANGUAGE TemplateHaskell, PatternSynonyms #-}
+
+module T8759a where
+
+foo = [d| pattern Q = False |]
diff --git a/testsuite/tests/th/T8759a.stderr b/testsuite/tests/th/T8759a.stderr
new file mode 100644
index 000000000000..ff0fd495dfc2
--- /dev/null
+++ b/testsuite/tests/th/T8759a.stderr
@@ -0,0 +1,4 @@
+
+T8759a.hs:5:7:
+    pattern synonyms not (yet) handled by Template Haskell
+      pattern Q = False
diff --git a/testsuite/tests/th/T8807.hs b/testsuite/tests/th/T8807.hs
new file mode 100644
index 000000000000..3090123f95f3
--- /dev/null
+++ b/testsuite/tests/th/T8807.hs
@@ -0,0 +1,8 @@
+{-# LANGUAGE ConstraintKinds #-}
+
+module T8807 where
+
+import Data.Proxy
+
+foo :: $( [t| a b => Proxy a -> b -> b |] )
+foo = undefined
\ No newline at end of file
diff --git a/testsuite/tests/th/T8884.hs b/testsuite/tests/th/T8884.hs
new file mode 100644
index 000000000000..ca6ed9c4b1ae
--- /dev/null
+++ b/testsuite/tests/th/T8884.hs
@@ -0,0 +1,23 @@
+{-# LANGUAGE TemplateHaskell, TypeFamilies, PolyKinds #-}
+
+module T8884 where
+
+import Language.Haskell.TH
+import System.IO
+
+type family Foo a where
+  Foo x = x
+
+type family Baz (a :: k)
+type instance Baz x = x
+
+$( do FamilyI foo@(ClosedTypeFamilyD _ tvbs1 m_kind1 eqns1) [] <- reify ''Foo
+      FamilyI baz@(FamilyD TypeFam _ tvbs2 m_kind2)
+              [inst@(TySynInstD _ eqn2)] <- reify ''Baz
+      runIO $ putStrLn $ pprint foo
+      runIO $ putStrLn $ pprint baz
+      runIO $ putStrLn $ pprint inst
+      runIO $ hFlush stdout
+      return [ ClosedTypeFamilyD (mkName "Foo'") tvbs1 m_kind1 eqns1
+             , FamilyD TypeFam (mkName "Baz'") tvbs2 m_kind2
+             , TySynInstD (mkName "Baz'") eqn2 ] )
diff --git a/testsuite/tests/th/T8884.stderr b/testsuite/tests/th/T8884.stderr
new file mode 100644
index 000000000000..3c45d0e8ead7
--- /dev/null
+++ b/testsuite/tests/th/T8884.stderr
@@ -0,0 +1,3 @@
+type family T8884.Foo (a_0 :: k_1) :: k_1 where T8884.Foo x_2 = x_2
+type family T8884.Baz (a_0 :: k_1) :: *
+type instance T8884.Baz x_0 = x_0
diff --git a/testsuite/tests/th/T8932.hs b/testsuite/tests/th/T8932.hs
new file mode 100644
index 000000000000..05630f331f43
--- /dev/null
+++ b/testsuite/tests/th/T8932.hs
@@ -0,0 +1,12 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+module T8932 where
+
+$([d|
+   foo :: a -> a
+   foo x = x
+  |])
+
+foo :: a
+foo = undefined
+
diff --git a/testsuite/tests/th/T8932.stderr b/testsuite/tests/th/T8932.stderr
new file mode 100644
index 000000000000..c86123509187
--- /dev/null
+++ b/testsuite/tests/th/T8932.stderr
@@ -0,0 +1,11 @@
+
+T8932.hs:5:3:
+    Duplicate exact Name ‘foo’
+      Probable cause: you used a unique Template Haskell name (NameU), 
+      perhaps via newName, but bound it multiple times
+      If that's it, then -ddump-splices might be useful
+
+T8932.hs:11:1:
+    Multiple declarations of ‘foo’
+    Declared at: T8932.hs:5:3
+                 T8932.hs:11:1
diff --git a/testsuite/tests/th/T8954.hs b/testsuite/tests/th/T8954.hs
new file mode 100644
index 000000000000..4aa308135818
--- /dev/null
+++ b/testsuite/tests/th/T8954.hs
@@ -0,0 +1,15 @@
+{-# LANGUAGE TemplateHaskell, MagicHash, UnboxedTuples #-}
+
+module T8954 where
+
+import Language.Haskell.TH
+
+$( do _ <- reify '(##)
+      _ <- reify '(#,#)
+      _ <- reify ''(##)
+      _ <- reify ''(#,#)
+      _ <- reify '()
+      _ <- reify ''()
+      _ <- reify '[]
+      _ <- reify ''[]
+      return [] )
diff --git a/testsuite/tests/th/T8987.hs b/testsuite/tests/th/T8987.hs
new file mode 100644
index 000000000000..d6f578102c50
--- /dev/null
+++ b/testsuite/tests/th/T8987.hs
@@ -0,0 +1,6 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+module T8987 where
+import Language.Haskell.TH
+
+$(reportWarning ['1', undefined] >> return [])
\ No newline at end of file
diff --git a/testsuite/tests/th/T8987.stderr b/testsuite/tests/th/T8987.stderr
new file mode 100644
index 000000000000..2b128bb10107
--- /dev/null
+++ b/testsuite/tests/th/T8987.stderr
@@ -0,0 +1,5 @@
+
+T8987.hs:1:1:
+    Exception when trying to run compile-time code:
+      Prelude.undefined
+    Code: (>>) reportWarning ['1', undefined] return []
diff --git a/testsuite/tests/th/T9199.hs b/testsuite/tests/th/T9199.hs
new file mode 100644
index 000000000000..aa41198b5752
--- /dev/null
+++ b/testsuite/tests/th/T9199.hs
@@ -0,0 +1,9 @@
+{-# LANGUAGE TemplateHaskell, PolyKinds, TypeFamilies #-}
+
+module T9160 where
+
+$( [d| class C (a :: k) where
+          type F (a :: k) :: *
+    |]
+ )
+
diff --git a/testsuite/tests/th/TH_RichKinds2.stderr b/testsuite/tests/th/TH_RichKinds2.stderr
index 625d03e9615f..8370df332d31 100644
--- a/testsuite/tests/th/TH_RichKinds2.stderr
+++ b/testsuite/tests/th/TH_RichKinds2.stderr
@@ -3,7 +3,7 @@ TH_RichKinds2.hs:23:4: Warning:
     data SMaybe_0 (t_1 :: k_0 -> *) (t_3 :: Data.Maybe.Maybe k_0)
     = forall . t_3 ~ 'Data.Maybe.Nothing => SNothing_4
     | forall a_5 . t_3 ~ 'Data.Maybe.Just a_5 => SJust_6 (t_1 a_5)
-type instance TH_RichKinds2.Map f_7 '[] = '[]
+type instance TH_RichKinds2.Map f_7 'GHC.Types.[] = 'GHC.Types.[]
 type instance TH_RichKinds2.Map f_8
                                 ('GHC.Types.: h_9 t_10) = 'GHC.Types.: (f_8 h_9)
                                                                        (TH_RichKinds2.Map f_8 t_10)
diff --git a/testsuite/tests/th/TH_Roles1.stderr b/testsuite/tests/th/TH_Roles1.stderr
index f819da1ecad7..952b3317ce5c 100644
--- a/testsuite/tests/th/TH_Roles1.stderr
+++ b/testsuite/tests/th/TH_Roles1.stderr
@@ -2,4 +2,4 @@
 TH_Roles1.hs:7:4:
     Illegal role annotation for T;
     did you intend to use RoleAnnotations?
-    while checking a role annotation for ‛T’
+    while checking a role annotation for ‘T’
diff --git a/testsuite/tests/th/TH_Roles2.stderr b/testsuite/tests/th/TH_Roles2.stderr
index 8d712576d857..ab61060000fa 100644
--- a/testsuite/tests/th/TH_Roles2.stderr
+++ b/testsuite/tests/th/TH_Roles2.stderr
@@ -1,16 +1,10 @@
 TYPE SIGNATURES
 TYPE CONSTRUCTORS
-  T :: k -> *
-  data T (k::BOX) (a::k)
-      No C type associated
-      Roles: [nominal, representational]
-      RecFlag NonRecursive, Not promotable
-      =
-      FamilyInstance: none
+  type role T representational
+  data T (a :: k)
 COERCION AXIOMS
 Dependent modules: []
-Dependent packages: [array-0.5.0.0, base, containers-0.5.4.0,
-                     deepseq-1.3.0.2, ghc-prim, integer-gmp, pretty-1.1.1.1,
+Dependent packages: [base, ghc-prim, integer-gmp, pretty-1.1.1.1,
                      template-haskell]
 
 ==================== Typechecker ====================
diff --git a/testsuite/tests/th/TH_dupdecl.stderr b/testsuite/tests/th/TH_dupdecl.stderr
index 4bd90febade5..e08af85233e2 100644
--- a/testsuite/tests/th/TH_dupdecl.stderr
+++ b/testsuite/tests/th/TH_dupdecl.stderr
@@ -1,5 +1,5 @@
 
 TH_dupdecl.hs:10:4:
-    Multiple declarations of ‛x’
+    Multiple declarations of ‘x’
     Declared at: TH_dupdecl.hs:8:4
                  TH_dupdecl.hs:10:4
diff --git a/testsuite/tests/th/TH_genExLib.hs b/testsuite/tests/th/TH_genExLib.hs
index 02784ac87b06..d43923181539 100644
--- a/testsuite/tests/th/TH_genExLib.hs
+++ b/testsuite/tests/th/TH_genExLib.hs
@@ -11,10 +11,10 @@ genAny decl = do { d <- decl
 	}
 
 genAnyClass :: Name -> [Dec] -> Dec
-genAnyClass name decls 
+genAnyClass name decls
   = DataD [] anyName [] [constructor] []
   where
     anyName = mkName ("Any" ++ nameBase name ++ "1111")
-    constructor = ForallC [PlainTV var_a] [ClassP name [VarT var_a]] $
+    constructor = ForallC [PlainTV var_a] [AppT (ConT name) (VarT var_a)] $
 		  NormalC anyName [(NotStrict, VarT var_a)]
     var_a = mkName "a"
diff --git a/testsuite/tests/th/TH_reifyDecl1.stderr b/testsuite/tests/th/TH_reifyDecl1.stderr
index 82a4f572ce21..9c3b6dad26c7 100644
--- a/testsuite/tests/th/TH_reifyDecl1.stderr
+++ b/testsuite/tests/th/TH_reifyDecl1.stderr
@@ -21,15 +21,15 @@ class TH_reifyDecl1.C2 a_0
 instance TH_reifyDecl1.C2 GHC.Types.Int
 class TH_reifyDecl1.C3 a_0
 instance TH_reifyDecl1.C3 GHC.Types.Int
-type family TH_reifyDecl1.AT1 a_0 :: * -> *
+type family TH_reifyDecl1.AT1 a_0 :: *
 type instance TH_reifyDecl1.AT1 GHC.Types.Int = GHC.Types.Bool
-data family TH_reifyDecl1.AT2 a_0 :: * -> *
+data family TH_reifyDecl1.AT2 a_0 :: *
 data instance TH_reifyDecl1.AT2 GHC.Types.Int
     = TH_reifyDecl1.AT2Int
-type family TH_reifyDecl1.TF1 a_0 :: * -> *
-type family TH_reifyDecl1.TF2 a_0 :: * -> *
+type family TH_reifyDecl1.TF1 a_0 :: *
+type family TH_reifyDecl1.TF2 a_0 :: *
 type instance TH_reifyDecl1.TF2 GHC.Types.Bool = GHC.Types.Bool
-data family TH_reifyDecl1.DF1 a_0 :: * -> *
-data family TH_reifyDecl1.DF2 a_0 :: * -> *
+data family TH_reifyDecl1.DF1 a_0 :: *
+data family TH_reifyDecl1.DF2 a_0 :: *
 data instance TH_reifyDecl1.DF2 GHC.Types.Bool
     = TH_reifyDecl1.DBool
diff --git a/testsuite/tests/th/TH_spliceD1.stderr b/testsuite/tests/th/TH_spliceD1.stderr
index 2a93bb4f5a66..9e6fb5013a7b 100644
--- a/testsuite/tests/th/TH_spliceD1.stderr
+++ b/testsuite/tests/th/TH_spliceD1.stderr
@@ -1,6 +1,6 @@
 
 TH_spliceD1.hs:10:3:
-    Conflicting definitions for ‛c’
+    Conflicting definitions for ‘c’
     Bound at: TH_spliceD1.hs:10:3-5
               TH_spliceD1.hs:10:3-5
-    In an equation for ‛f’
+    In an equation for ‘f’
diff --git a/testsuite/tests/th/TH_unresolvedInfix2.stderr b/testsuite/tests/th/TH_unresolvedInfix2.stderr
index 4baa35a351ad..57d93dc89692 100644
--- a/testsuite/tests/th/TH_unresolvedInfix2.stderr
+++ b/testsuite/tests/th/TH_unresolvedInfix2.stderr
@@ -1,9 +1,9 @@
 
 TH_unresolvedInfix2.hs:14:11:
-    The operator ‛:+’ [infixl 6] of a section
+    The operator ‘:+’ [infixl 6] of a section
         must have lower precedence than that of the operand,
-          namely ‛:+’ [infixl 6]
-        in the section: ‛:+ N :+ N’
+          namely ‘:+’ [infixl 6]
+        in the section: ‘:+ N :+ N’
     In the splice:
       $(let
           plus = conE ...
diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T
index 5b064ba2ea3d..6e86d303e5cf 100644
--- a/testsuite/tests/th/all.T
+++ b/testsuite/tests/th/all.T
@@ -317,3 +317,15 @@ test('T8577',
      ['T8577', '-v0 ' + config.ghc_th_way_flags])
 test('T8633', normal, compile_and_run, [''])
 test('T8625', normal, ghci_script, ['T8625.script'])
+test('T8759', normal, compile_fail, ['-v0'])
+test('T8759a', normal, compile_fail, ['-v0'])
+test('T7021',
+     extra_clean(['T7021a.hi', 'T7021a.o']), multimod_compile, ['T7021','-v0'])
+test('T8807', normal, compile, ['-v0'])
+test('T8884', normal, compile, ['-v0'])
+test('T8954', normal, compile, ['-v0'])
+test('T8932', normal, compile_fail, ['-v0'])
+test('T8987', normal, compile_fail, ['-v0'])
+test('T7241', normal, compile_fail, ['-v0'])
+test('T9199', normal, compile, ['-v0'])
+
diff --git a/testsuite/tests/typecheck/bug1465/bug1465.stderr b/testsuite/tests/typecheck/bug1465/bug1465.stderr
index 44b3de11c189..118d070075e1 100644
--- a/testsuite/tests/typecheck/bug1465/bug1465.stderr
+++ b/testsuite/tests/typecheck/bug1465/bug1465.stderr
@@ -1,8 +1,8 @@
 
 C.hs:6:11:
-    Couldn't match expected type ‛bug1465-1.0:A.T’
-                with actual type ‛A.T’
-    NB: ‛bug1465-1.0:A.T’ is defined in ‛A’ in package ‛bug1465-1.0’
-        ‛A.T’ is defined in ‛A’ in package ‛bug1465-2.0’
+    Couldn't match expected type ‘bug1465-1.0:A.T’
+                with actual type ‘A.T’
+    NB: ‘bug1465-1.0:A.T’ is defined in ‘A’ in package ‘bug1465-1.0’
+        ‘A.T’ is defined in ‘A’ in package ‘bug1465-2.0’
     In the expression: B2.f
     In the expression: [B1.f, B2.f]
diff --git a/testsuite/tests/typecheck/prog001/typecheck.prog001.stderr-ghc b/testsuite/tests/typecheck/prog001/typecheck.prog001.stderr-ghc
index d13e8c917500..70e210fa3ee6 100644
--- a/testsuite/tests/typecheck/prog001/typecheck.prog001.stderr-ghc
+++ b/testsuite/tests/typecheck/prog001/typecheck.prog001.stderr-ghc
@@ -1,5 +1,5 @@
 
 B.hs:7:10: Warning:
     No explicit implementation for
-      ‛row’
-    In the instance declaration for ‛Matrix Bool Val’
+      ‘row’
+    In the instance declaration for ‘Matrix Bool Val’
diff --git a/testsuite/tests/typecheck/should_compile/FD1.stderr b/testsuite/tests/typecheck/should_compile/FD1.stderr
index 5fa16fdf1506..98ed785956f0 100644
--- a/testsuite/tests/typecheck/should_compile/FD1.stderr
+++ b/testsuite/tests/typecheck/should_compile/FD1.stderr
@@ -5,9 +5,9 @@ FD1.hs:16:1:
       bound by the type signature for
                  plus :: E a (Int -> Int) => Int -> a
       at FD1.hs:15:9-38
-      ‛a’ is a rigid type variable bound by
+      ‘a’ is a rigid type variable bound by
           the type signature for plus :: E a (Int -> Int) => Int -> a
           at FD1.hs:15:9
     Relevant bindings include plus :: Int -> a (bound at FD1.hs:16:1)
-    The equation(s) for ‛plus’ have two arguments,
-    but its type ‛Int -> a’ has only one
+    The equation(s) for ‘plus’ have two arguments,
+    but its type ‘Int -> a’ has only one
diff --git a/testsuite/tests/typecheck/should_compile/FD2.stderr b/testsuite/tests/typecheck/should_compile/FD2.stderr
index 679f05ddeb0f..06e5afd7306d 100644
--- a/testsuite/tests/typecheck/should_compile/FD2.stderr
+++ b/testsuite/tests/typecheck/should_compile/FD2.stderr
@@ -2,7 +2,7 @@
 FD2.hs:26:34:
     Could not deduce (e ~ e1)
     from the context (Foldable a)
-      bound by the class declaration for ‛Foldable’
+      bound by the class declaration for ‘Foldable’
       at FD2.hs:(17,1)-(26,39)
     or from (Elem a e)
       bound by the type signature for
@@ -12,11 +12,11 @@ FD2.hs:26:34:
       bound by the type signature for
                  mf :: Elem a e1 => e1 -> Maybe e1 -> Maybe e1
       at FD2.hs:24:18-54
-      ‛e’ is a rigid type variable bound by
+      ‘e’ is a rigid type variable bound by
           the type signature for
             foldr1 :: Elem a e => (e -> e -> e) -> a -> e
           at FD2.hs:21:13
-      ‛e1’ is a rigid type variable bound by
+      ‘e1’ is a rigid type variable bound by
            the type signature for
              mf :: Elem a e1 => e1 -> Maybe e1 -> Maybe e1
            at FD2.hs:24:18
@@ -26,5 +26,5 @@ FD2.hs:26:34:
       mf :: e1 -> Maybe e1 -> Maybe e1 (bound at FD2.hs:25:12)
       f :: e -> e -> e (bound at FD2.hs:22:10)
       foldr1 :: (e -> e -> e) -> a -> e (bound at FD2.hs:22:3)
-    In the first argument of ‛Just’, namely ‛(f x y)’
+    In the first argument of ‘Just’, namely ‘(f x y)’
     In the expression: Just (f x y)
diff --git a/testsuite/tests/typecheck/should_compile/FD3.stderr b/testsuite/tests/typecheck/should_compile/FD3.stderr
index 664fd3555342..d2364921f6cb 100644
--- a/testsuite/tests/typecheck/should_compile/FD3.stderr
+++ b/testsuite/tests/typecheck/should_compile/FD3.stderr
@@ -1,5 +1,5 @@
 
 FD3.hs:15:15:
-    No instance for (MkA (String, a) a) arising from a use of ‛mkA’
+    No instance for (MkA (String, a) a) arising from a use of ‘mkA’
     In the expression: mkA a
-    In an equation for ‛translate’: translate a = mkA a
+    In an equation for ‘translate’: translate a = mkA a
diff --git a/testsuite/tests/typecheck/should_compile/FD4.hs b/testsuite/tests/typecheck/should_compile/FD4.hs
index 5d5869ca01ba..dcf25f72931d 100644
--- a/testsuite/tests/typecheck/should_compile/FD4.hs
+++ b/testsuite/tests/typecheck/should_compile/FD4.hs
@@ -2,7 +2,6 @@
     MultiParamTypeClasses,
     FunctionalDependencies,
     UndecidableInstances,
-    OverlappingInstances,
     FlexibleInstances,
     EmptyDataDecls #-}
 
diff --git a/testsuite/tests/typecheck/should_compile/HasKey.stderr-ghc b/testsuite/tests/typecheck/should_compile/HasKey.stderr-ghc
index 54607457e576..dd4d290cda8d 100644
--- a/testsuite/tests/typecheck/should_compile/HasKey.stderr-ghc
+++ b/testsuite/tests/typecheck/should_compile/HasKey.stderr-ghc
@@ -1,5 +1,5 @@
 
 HasKey.hs:22:10: Warning:
     No explicit implementation for
-      either ‛compare’ or ‛<=’
-    In the instance declaration for ‛Ord (Keyed x)’
+      either ‘compare’ or ‘<=’
+    In the instance declaration for ‘Ord (Keyed x)’
diff --git a/testsuite/tests/typecheck/should_compile/LoopOfTheDay3.hs b/testsuite/tests/typecheck/should_compile/LoopOfTheDay3.hs
index dce1601a7054..f1c1b498393c 100644
--- a/testsuite/tests/typecheck/should_compile/LoopOfTheDay3.hs
+++ b/testsuite/tests/typecheck/should_compile/LoopOfTheDay3.hs
@@ -1,5 +1,5 @@
 {-# LANGUAGE MultiParamTypeClasses, FlexibleInstances,
-             OverlappingInstances, UndecidableInstances #-}
+             UndecidableInstances #-}
 
 -- Instances compile fine but instance selection loops in GHC 6.2.
 -- try: :t foo (T1a 1)
diff --git a/testsuite/tests/typecheck/should_compile/Makefile b/testsuite/tests/typecheck/should_compile/Makefile
index 518f92368975..e361556f8ffd 100644
--- a/testsuite/tests/typecheck/should_compile/Makefile
+++ b/testsuite/tests/typecheck/should_compile/Makefile
@@ -9,8 +9,8 @@ tc170:
 
 tc173:
 	$(RM) Tc173a.o Tc173a.hi Tc173b.o Tc173b.hi
-	'$(TEST_HC)' $(TEST_HC_OPTS) -c -XFlexibleInstances -XTypeSynonymInstances -XUndecidableInstances -XOverlappingInstances Tc173a.hs
-	'$(TEST_HC)' $(TEST_HC_OPTS) -c -XUndecidableInstances -XOverlappingInstances Tc173b.hs
+	'$(TEST_HC)' $(TEST_HC_OPTS) -c Tc173a.hs
+	'$(TEST_HC)' $(TEST_HC_OPTS) -c Tc173b.hs
 
 T2412:
 	$(RM) -f T2412.hi-boot T2412.o-boot T2412A.hi T2412A.o T2412.hi T2412.o
diff --git a/testsuite/tests/typecheck/should_compile/MutRec.hs b/testsuite/tests/typecheck/should_compile/MutRec.hs
new file mode 100644
index 000000000000..1a2a01f3291e
--- /dev/null
+++ b/testsuite/tests/typecheck/should_compile/MutRec.hs
@@ -0,0 +1,11 @@
+module MutRec where
+
+-- Mutual recursion with different
+-- names for the same type variable
+f t = x
+  where
+    x :: [a]
+    y :: b
+    (x,y,z,r) = ([y,z], z, head x, t)
+
+
diff --git a/testsuite/tests/typecheck/should_compile/T1470.hs b/testsuite/tests/typecheck/should_compile/T1470.hs
index d466e487e9ba..2482696452eb 100644
--- a/testsuite/tests/typecheck/should_compile/T1470.hs
+++ b/testsuite/tests/typecheck/should_compile/T1470.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts, FlexibleInstances, OverlappingInstances, UndecidableInstances, KindSignatures #-}
+{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts, FlexibleInstances, UndecidableInstances, KindSignatures #-}
 
 -- Trac #1470
 
@@ -15,10 +15,9 @@ data FooD a = FooD
 
 instance Foo t => Sat (FooD t)
 
-instance Data FooD a => Foo a
-
-
-instance Foo a       => Foo [a]
+instance {-# OVERLAPPABLE #-} Data FooD a => Foo a
+instance {-# OVERLAPS #-}     Foo a       => Foo [a]
+instance {-# OVERLAPPING #-}                 Foo [Char]
 {-
  Given:                Foo a,
  and its superclasses: Data FooD a
@@ -35,4 +34,3 @@ instance Foo a       => Foo [a]
 BUT THIS INSTANCE OVERLAPS
 -}
 
-instance                Foo [Char]
diff --git a/testsuite/tests/typecheck/should_compile/T2494.stderr b/testsuite/tests/typecheck/should_compile/T2494.stderr
index 201230b1a50b..dee00ab6b4fe 100644
--- a/testsuite/tests/typecheck/should_compile/T2494.stderr
+++ b/testsuite/tests/typecheck/should_compile/T2494.stderr
@@ -1,9 +1,9 @@
 
 T2494.hs:15:14:
-    Couldn't match type ‛b’ with ‛a’
-      ‛b’ is a rigid type variable bound by
+    Couldn't match type ‘b’ with ‘a’
+      ‘b’ is a rigid type variable bound by
           the RULE "foo/foo" at T2494.hs:14:16
-      ‛a’ is a rigid type variable bound by
+      ‘a’ is a rigid type variable bound by
           the RULE "foo/foo" at T2494.hs:13:16
     Expected type: Maybe (m a) -> Maybe (m a)
       Actual type: Maybe (m b) -> Maybe (m b)
@@ -13,14 +13,14 @@ T2494.hs:15:14:
       g :: forall (m :: * -> *). Monad m => Maybe (m b) -> Maybe (m b)
         (bound at T2494.hs:14:11)
       x :: Maybe a (bound at T2494.hs:14:65)
-    In the first argument of ‛foo’, namely ‛g’
-    In the second argument of ‛foo’, namely ‛(foo g x)’
+    In the first argument of ‘foo’, namely ‘g’
+    In the second argument of ‘foo’, namely ‘(foo g x)’
 
 T2494.hs:15:30:
-    Couldn't match type ‛b’ with ‛a’
-      ‛b’ is a rigid type variable bound by
+    Couldn't match type ‘b’ with ‘a’
+      ‘b’ is a rigid type variable bound by
           the RULE "foo/foo" at T2494.hs:14:16
-      ‛a’ is a rigid type variable bound by
+      ‘a’ is a rigid type variable bound by
           the RULE "foo/foo" at T2494.hs:13:16
     Expected type: Maybe (m a) -> Maybe (m a)
       Actual type: Maybe (m b) -> Maybe (m b)
@@ -30,5 +30,5 @@ T2494.hs:15:30:
       g :: forall (m :: * -> *). Monad m => Maybe (m b) -> Maybe (m b)
         (bound at T2494.hs:14:11)
       x :: Maybe a (bound at T2494.hs:14:65)
-    In the second argument of ‛(.)’, namely ‛g’
-    In the first argument of ‛foo’, namely ‛(f . g)’
+    In the second argument of ‘(.)’, namely ‘g’
+    In the first argument of ‘foo’, namely ‘(f . g)’
diff --git a/testsuite/tests/typecheck/should_compile/T2497.stderr b/testsuite/tests/typecheck/should_compile/T2497.stderr
index 7ee9bee08e88..cd7ad8bc202a 100644
--- a/testsuite/tests/typecheck/should_compile/T2497.stderr
+++ b/testsuite/tests/typecheck/should_compile/T2497.stderr
@@ -1,2 +1,2 @@
 
-T2497.hs:18:1: Warning: Defined but not used: ‛beq’
+T2497.hs:18:1: Warning: Defined but not used: ‘beq’
diff --git a/testsuite/tests/typecheck/should_compile/T3018.hs b/testsuite/tests/typecheck/should_compile/T3018.hs
index a0868afa2403..443d73a17ad9 100644
--- a/testsuite/tests/typecheck/should_compile/T3018.hs
+++ b/testsuite/tests/typecheck/should_compile/T3018.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE OverlappingInstances , UndecidableInstances, EmptyDataDecls #-}
+{-# LANGUAGE UndecidableInstances, EmptyDataDecls #-}
 {-# LANGUAGE RankNTypes, KindSignatures, MultiParamTypeClasses, FlexibleInstances #-}
 
 -- Works with new constraint solver
diff --git a/testsuite/tests/typecheck/should_compile/T3108.hs b/testsuite/tests/typecheck/should_compile/T3108.hs
index 774d5f38010d..2adaa1aef7ae 100644
--- a/testsuite/tests/typecheck/should_compile/T3108.hs
+++ b/testsuite/tests/typecheck/should_compile/T3108.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE OverlappingInstances, UndecidableInstances, MultiParamTypeClasses, 
+{-# LANGUAGE UndecidableInstances, MultiParamTypeClasses, 
              FunctionalDependencies, FlexibleInstances #-}
 
 module T3108 where
@@ -10,9 +10,9 @@ class C0 x
  m0 :: x -> ()
  m0 = const undefined
 
-instance (C0 x, C0 y) => C0 (x,y)
-instance C0 Bool
-instance C0 (x,Bool) => C0 x
+instance {-# OVERLAPPING #-} (C0 x, C0 y) => C0 (x,y)
+instance {-# OVERLAPPING #-} C0 Bool
+instance {-# OVERLAPPABLE #-} C0 (x,Bool) => C0 x
 
 foo :: ()
 foo = m0 (1::Int)
@@ -25,9 +25,9 @@ class C1 x
  m1 :: x -> ()
  m1 = const undefined
 
-instance (C1 x, C1 y) => C1 (x,y)
-instance C1 Bool
-instance (C2 x y, C1 (y,Bool)) => C1 x
+instance {-# OVERLAPPING #-} (C1 x, C1 y) => C1 (x,y)
+instance {-# OVERLAPPING #-} C1 Bool
+instance {-# OVERLAPPABLE #-} (C2 x y, C1 (y,Bool)) => C1 x
 
 class C2 x y | x -> y
 instance C2 Int Int
diff --git a/testsuite/tests/typecheck/should_compile/T4912.stderr b/testsuite/tests/typecheck/should_compile/T4912.stderr
index 50d2deb3cd27..0e0920f034b9 100644
--- a/testsuite/tests/typecheck/should_compile/T4912.stderr
+++ b/testsuite/tests/typecheck/should_compile/T4912.stderr
@@ -1,4 +1,12 @@
 
-T4912.hs:10:10: Warning: Orphan instance: instance Foo TheirData
+T4912.hs:10:10: Warning:
+    Orphan instance: instance Foo TheirData
+    To avoid this
+        move the instance declaration to the module of the class or of the type, or
+        wrap the type with a newtype and declare the instance on the new type.
 
-T4912.hs:13:10: Warning: Orphan instance: instance Bar OurData
+T4912.hs:13:10: Warning:
+    Orphan instance: instance Bar OurData
+    To avoid this
+        move the instance declaration to the module of the class or of the type, or
+        wrap the type with a newtype and declare the instance on the new type.
diff --git a/testsuite/tests/typecheck/should_compile/T5481.stderr b/testsuite/tests/typecheck/should_compile/T5481.stderr
index bf59427da688..719c4ce5c71b 100644
--- a/testsuite/tests/typecheck/should_compile/T5481.stderr
+++ b/testsuite/tests/typecheck/should_compile/T5481.stderr
@@ -1,8 +1,4 @@
 
-T5481.hs:6:5:
-    The RHS of an associated type declaration mentions type variable ‛b’
-      All such variables must be bound on the LHS
+T5481.hs:6:16: Not in scope: type variable ‘b’
 
-T5481.hs:8:5:
-    The RHS of an associated type declaration mentions type variable ‛a’
-      All such variables must be bound on the LHS
+T5481.hs:8:16: Not in scope: type variable ‘a’
diff --git a/testsuite/tests/typecheck/should_compile/T7050.stderr b/testsuite/tests/typecheck/should_compile/T7050.stderr
index 860c90757fb4..a7154f67ac28 100644
--- a/testsuite/tests/typecheck/should_compile/T7050.stderr
+++ b/testsuite/tests/typecheck/should_compile/T7050.stderr
@@ -1,5 +1,5 @@
 
 T7050.hs:3:14: Warning:
-    Ignoring unusable UNPACK pragma on the first argument of ‛Foo’
-    In the definition of data constructor ‛Foo’
-    In the data declaration for ‛Foo’
+    Ignoring unusable UNPACK pragma on the first argument of ‘Foo’
+    In the definition of data constructor ‘Foo’
+    In the data declaration for ‘Foo’
diff --git a/testsuite/tests/typecheck/should_compile/T7562.stderr b/testsuite/tests/typecheck/should_compile/T7562.stderr
index 36f1de5780d7..fb663fc639c0 100644
--- a/testsuite/tests/typecheck/should_compile/T7562.stderr
+++ b/testsuite/tests/typecheck/should_compile/T7562.stderr
@@ -1,5 +1,5 @@
 
 T7562.hs:3:14: Warning:
-    UNPACK pragma lacks '!' on the first argument of ‛Pair2’
-    In the definition of data constructor ‛Pair2’
-    In the data declaration for ‛Pair2’
+    UNPACK pragma lacks '!' on the first argument of ‘Pair2’
+    In the definition of data constructor ‘Pair2’
+    In the data declaration for ‘Pair2’
diff --git a/testsuite/tests/typecheck/should_compile/T7903.stderr-ghc b/testsuite/tests/typecheck/should_compile/T7903.stderr-ghc
index 594196a06c94..2214c3531f71 100644
--- a/testsuite/tests/typecheck/should_compile/T7903.stderr-ghc
+++ b/testsuite/tests/typecheck/should_compile/T7903.stderr-ghc
@@ -1,10 +1,10 @@
 
 T7903.hs:5:10: Warning:
     No explicit implementation for
-      either ‛==’ or ‛/=’
-    In the instance declaration for ‛Eq (a -> b)’
+      either ‘==’ or ‘/=’
+    In the instance declaration for ‘Eq (a -> b)’
 
 T7903.hs:6:10: Warning:
     No explicit implementation for
-      either ‛compare’ or ‛<=’
-    In the instance declaration for ‛Ord (a -> b)’
+      either ‘compare’ or ‘<=’
+    In the instance declaration for ‘Ord (a -> b)’
diff --git a/testsuite/tests/typecheck/should_compile/T8739.hs b/testsuite/tests/typecheck/should_compile/T8739.hs
new file mode 100644
index 000000000000..3fb4df3d56ab
--- /dev/null
+++ b/testsuite/tests/typecheck/should_compile/T8739.hs
@@ -0,0 +1,10 @@
+{-# LANGUAGE MagicHash #-}
+module Main where
+import GHC.Exts
+
+go :: () -> Int#
+go () = 0#
+
+main = print (I# (go $ ()))
+
+
diff --git a/testsuite/tests/typecheck/should_compile/T8762.hs b/testsuite/tests/typecheck/should_compile/T8762.hs
new file mode 100644
index 000000000000..8eb13a73eb07
--- /dev/null
+++ b/testsuite/tests/typecheck/should_compile/T8762.hs
@@ -0,0 +1,10 @@
+{-# LANGUAGE UnboxedTuples #-}
+module T8762 where
+
+type Ty a = Int
+
+bug :: Ty a -> (# Ty a, () #)
+bug ty = (# ty, () #)
+
+foo = let (# a, b #) = bug undefined
+      in ()
diff --git a/testsuite/tests/typecheck/should_compile/T8856.hs b/testsuite/tests/typecheck/should_compile/T8856.hs
new file mode 100644
index 000000000000..6605e479fda5
--- /dev/null
+++ b/testsuite/tests/typecheck/should_compile/T8856.hs
@@ -0,0 +1,6 @@
+{-# LANGUAGE ScopedTypeVariables, RankNTypes, PolyKinds #-}
+module T8856 where
+
+import Data.Proxy
+
+foo = (undefined :: Proxy a) :: forall a. Proxy a
diff --git a/testsuite/tests/typecheck/should_compile/T9117.hs b/testsuite/tests/typecheck/should_compile/T9117.hs
new file mode 100644
index 000000000000..cb05bf2c2301
--- /dev/null
+++ b/testsuite/tests/typecheck/should_compile/T9117.hs
@@ -0,0 +1,13 @@
+{-# LANGUAGE RoleAnnotations #-}
+
+-- Also see Note [Order of Coercible Instances]
+
+module T9117 where
+
+import Data.Coerce
+
+newtype Phant a = MkPhant Char
+type role Phant representational
+
+ex1 :: Phant Bool
+ex1 = coerce (MkPhant 'x' :: Phant Int)
diff --git a/testsuite/tests/typecheck/should_compile/T9117_2.hs b/testsuite/tests/typecheck/should_compile/T9117_2.hs
new file mode 100644
index 000000000000..e7b08d8b6c72
--- /dev/null
+++ b/testsuite/tests/typecheck/should_compile/T9117_2.hs
@@ -0,0 +1,10 @@
+module T9117_2 where
+
+
+import Data.Coerce
+
+newtype Foo a = Foo (Foo a)
+newtype Age = MkAge Int
+
+ex1 :: (Foo Age) -> (Foo Int)
+ex1 = coerce
diff --git a/testsuite/tests/typecheck/should_compile/Tc173a.hs b/testsuite/tests/typecheck/should_compile/Tc173a.hs
index c8a589d2b31a..f3704ccd9ab9 100644
--- a/testsuite/tests/typecheck/should_compile/Tc173a.hs
+++ b/testsuite/tests/typecheck/should_compile/Tc173a.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE FlexibleInstances, TypeSynonymInstances, UndecidableInstances #-}
 module Tc173a where
 
 class FormValue value where
@@ -8,10 +9,10 @@ class FormTextField value
 
 instance FormTextField String
 
-instance FormTextField value => FormTextFieldIO value
+instance {-# OVERLAPPABLE #-} FormTextField value => FormTextFieldIO value
 
 class FormTextFieldIO value
 
 instance FormTextFieldIO value => FormValue value
 
-instance FormTextFieldIO value => FormTextFieldIO (Maybe value)
+instance {-# OVERLAPPING #-} FormTextFieldIO value => FormTextFieldIO (Maybe value)
diff --git a/testsuite/tests/typecheck/should_compile/Tc173b.hs b/testsuite/tests/typecheck/should_compile/Tc173b.hs
index c98c57acd836..d14663d86698 100644
--- a/testsuite/tests/typecheck/should_compile/Tc173b.hs
+++ b/testsuite/tests/typecheck/should_compile/Tc173b.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE UndecidableInstances #-}
 module Tc173b where
 
 import Tc173a
diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T
index 0fe6968bf779..07d05b8a0eea 100644
--- a/testsuite/tests/typecheck/should_compile/all.T
+++ b/testsuite/tests/typecheck/should_compile/all.T
@@ -415,3 +415,8 @@ test('T8474', normal, compile, [''])
 test('T8563', normal, compile, [''])
 test('T8565', normal, compile, [''])
 test('T8644', normal, compile, [''])
+test('T8762', normal, compile, [''])
+test('MutRec', normal, compile, [''])
+test('T8856', normal, compile, [''])
+test('T9117', normal, compile, [''])
+test('T9117_2', expect_broken('9117'), compile, [''])
diff --git a/testsuite/tests/typecheck/should_compile/holes.stderr b/testsuite/tests/typecheck/should_compile/holes.stderr
index 2985863b63b7..da1408ff09d4 100644
--- a/testsuite/tests/typecheck/should_compile/holes.stderr
+++ b/testsuite/tests/typecheck/should_compile/holes.stderr
@@ -1,33 +1,33 @@
 
 holes.hs:3:5: Warning:
-    Found hole ‛_’ with type: t
-    Where: ‛t’ is a rigid type variable bound by
+    Found hole ‘_’ with type: t
+    Where: ‘t’ is a rigid type variable bound by
                the inferred type of f :: t at holes.hs:3:1
     Relevant bindings include f :: t (bound at holes.hs:3:1)
     In the expression: _
-    In an equation for ‛f’: f = _
+    In an equation for ‘f’: f = _
 
 holes.hs:6:7: Warning:
-    Found hole ‛_’ with type: Char
+    Found hole ‘_’ with type: Char
     Relevant bindings include
       x :: Int (bound at holes.hs:6:3)
       g :: Int -> Char (bound at holes.hs:6:1)
     In the expression: _
-    In an equation for ‛g’: g x = _
+    In an equation for ‘g’: g x = _
 
 holes.hs:8:5: Warning:
-    Found hole ‛_’ with type: [Char]
+    Found hole ‘_’ with type: [Char]
     Relevant bindings include h :: [Char] (bound at holes.hs:8:1)
-    In the first argument of ‛(++)’, namely ‛_’
+    In the first argument of ‘(++)’, namely ‘_’
     In the expression: _ ++ "a"
-    In an equation for ‛h’: h = _ ++ "a"
+    In an equation for ‘h’: h = _ ++ "a"
 
 holes.hs:11:15: Warning:
-    Found hole ‛_’ with type: b0
-    Where: ‛b0’ is an ambiguous type variable
+    Found hole ‘_’ with type: b0
+    Where: ‘b0’ is an ambiguous type variable
     Relevant bindings include
       y :: [a] (bound at holes.hs:11:3)
       z :: [a] -> [a] (bound at holes.hs:11:1)
-    In the second argument of ‛const’, namely ‛_’
+    In the second argument of ‘const’, namely ‘_’
     In the expression: const y _
-    In an equation for ‛z’: z y = const y _
+    In an equation for ‘z’: z y = const y _
diff --git a/testsuite/tests/typecheck/should_compile/holes2.stderr b/testsuite/tests/typecheck/should_compile/holes2.stderr
index d75b5f3f1ae2..0c7e5666b460 100644
--- a/testsuite/tests/typecheck/should_compile/holes2.stderr
+++ b/testsuite/tests/typecheck/should_compile/holes2.stderr
@@ -1,20 +1,20 @@
 
 holes2.hs:3:5: Warning:
-    No instance for (Show a0) arising from a use of ‛show’
-    The type variable ‛a0’ is ambiguous
+    No instance for (Show a0) arising from a use of ‘show’
+    The type variable ‘a0’ is ambiguous
     Note: there are several potential instances:
-      instance Show Double -- Defined in ‛GHC.Float’
-      instance Show Float -- Defined in ‛GHC.Float’
+      instance Show Double -- Defined in ‘GHC.Float’
+      instance Show Float -- Defined in ‘GHC.Float’
       instance (Integral a, Show a) => Show (GHC.Real.Ratio a)
-        -- Defined in ‛GHC.Real’
-      ...plus 24 others
+        -- Defined in ‘GHC.Real’
+      ...plus 23 others
     In the expression: show _
-    In an equation for ‛f’: f = show _
+    In an equation for ‘f’: f = show _
 
 holes2.hs:3:10: Warning:
-    Found hole ‛_’ with type: a0
-    Where: ‛a0’ is an ambiguous type variable
+    Found hole ‘_’ with type: a0
+    Where: ‘a0’ is an ambiguous type variable
     Relevant bindings include f :: String (bound at holes2.hs:3:1)
-    In the first argument of ‛show’, namely ‛_’
+    In the first argument of ‘show’, namely ‘_’
     In the expression: show _
-    In an equation for ‛f’: f = show _
+    In an equation for ‘f’: f = show _
diff --git a/testsuite/tests/typecheck/should_compile/holes3.stderr b/testsuite/tests/typecheck/should_compile/holes3.stderr
index abfeab0e4a65..e203acaa749c 100644
--- a/testsuite/tests/typecheck/should_compile/holes3.stderr
+++ b/testsuite/tests/typecheck/should_compile/holes3.stderr
@@ -1,33 +1,33 @@
 
 holes3.hs:3:5:
-    Found hole ‛_’ with type: t
-    Where: ‛t’ is a rigid type variable bound by
+    Found hole ‘_’ with type: t
+    Where: ‘t’ is a rigid type variable bound by
                the inferred type of f :: t at holes3.hs:3:1
     Relevant bindings include f :: t (bound at holes3.hs:3:1)
     In the expression: _
-    In an equation for ‛f’: f = _
+    In an equation for ‘f’: f = _
 
 holes3.hs:6:7:
-    Found hole ‛_gr’ with type: Char
+    Found hole ‘_gr’ with type: Char
     Relevant bindings include
       x :: Int (bound at holes3.hs:6:3)
       g :: Int -> Char (bound at holes3.hs:6:1)
     In the expression: _gr
-    In an equation for ‛g’: g x = _gr
+    In an equation for ‘g’: g x = _gr
 
 holes3.hs:8:5:
-    Found hole ‛_aa’ with type: [Char]
+    Found hole ‘_aa’ with type: [Char]
     Relevant bindings include h :: [Char] (bound at holes3.hs:8:1)
-    In the first argument of ‛(++)’, namely ‛_aa’
+    In the first argument of ‘(++)’, namely ‘_aa’
     In the expression: _aa ++ "a"
-    In an equation for ‛h’: h = _aa ++ "a"
+    In an equation for ‘h’: h = _aa ++ "a"
 
 holes3.hs:11:15:
-    Found hole ‛_x’ with type: b0
-    Where: ‛b0’ is an ambiguous type variable
+    Found hole ‘_x’ with type: b0
+    Where: ‘b0’ is an ambiguous type variable
     Relevant bindings include
       y :: [a] (bound at holes3.hs:11:3)
       z :: [a] -> [a] (bound at holes3.hs:11:1)
-    In the second argument of ‛const’, namely ‛_x’
+    In the second argument of ‘const’, namely ‘_x’
     In the expression: const y _x
-    In an equation for ‛z’: z y = const y _x
+    In an equation for ‘z’: z y = const y _x
diff --git a/testsuite/tests/typecheck/should_compile/tc056.stderr b/testsuite/tests/typecheck/should_compile/tc056.stderr
index c05f9b3bc2db..0c8f669b30cf 100644
--- a/testsuite/tests/typecheck/should_compile/tc056.stderr
+++ b/testsuite/tests/typecheck/should_compile/tc056.stderr
@@ -3,4 +3,4 @@ tc056.hs:16:10: Warning:
     Duplicate constraint(s): Eq' a
     In the context: (Eq' a, Eq' a)
     While checking an instance declaration
-    In the instance declaration for ‛Eq' [a]’
+    In the instance declaration for ‘Eq' [a]’
diff --git a/testsuite/tests/typecheck/should_compile/tc078.stderr-ghc b/testsuite/tests/typecheck/should_compile/tc078.stderr-ghc
index 5eae74e23f59..bb5d9f566ebc 100644
--- a/testsuite/tests/typecheck/should_compile/tc078.stderr-ghc
+++ b/testsuite/tests/typecheck/should_compile/tc078.stderr-ghc
@@ -1,10 +1,10 @@
 
 tc078.hs:7:10: Warning:
     No explicit implementation for
-      either ‛==’ or ‛/=’
-    In the instance declaration for ‛Eq (Bar a)’
+      either ‘==’ or ‘/=’
+    In the instance declaration for ‘Eq (Bar a)’
 
 tc078.hs:8:10: Warning:
     No explicit implementation for
-      either ‛compare’ or ‛<=’
-    In the instance declaration for ‛Ord (Bar a)’
+      either ‘compare’ or ‘<=’
+    In the instance declaration for ‘Ord (Bar a)’
diff --git a/testsuite/tests/typecheck/should_compile/tc115.stderr-ghc b/testsuite/tests/typecheck/should_compile/tc115.stderr-ghc
index c9f18fb3c0da..e90ef21e1287 100644
--- a/testsuite/tests/typecheck/should_compile/tc115.stderr-ghc
+++ b/testsuite/tests/typecheck/should_compile/tc115.stderr-ghc
@@ -1,5 +1,5 @@
 
 tc115.hs:12:10: Warning:
     No explicit implementation for
-      ‛foo’
-    In the instance declaration for ‛Foo [m a] (m a)’
+      ‘foo’
+    In the instance declaration for ‘Foo [m a] (m a)’
diff --git a/testsuite/tests/typecheck/should_compile/tc116.stderr-ghc b/testsuite/tests/typecheck/should_compile/tc116.stderr-ghc
index 641f54129085..91fa0a1130b7 100644
--- a/testsuite/tests/typecheck/should_compile/tc116.stderr-ghc
+++ b/testsuite/tests/typecheck/should_compile/tc116.stderr-ghc
@@ -1,5 +1,5 @@
 
 tc116.hs:12:10: Warning:
     No explicit implementation for
-      ‛foo’
-    In the instance declaration for ‛Foo [m a] (m a)’
+      ‘foo’
+    In the instance declaration for ‘Foo [m a] (m a)’
diff --git a/testsuite/tests/typecheck/should_compile/tc125.stderr-ghc b/testsuite/tests/typecheck/should_compile/tc125.stderr-ghc
index 5b92b3321e93..5631c08a1c96 100644
--- a/testsuite/tests/typecheck/should_compile/tc125.stderr-ghc
+++ b/testsuite/tests/typecheck/should_compile/tc125.stderr-ghc
@@ -1,25 +1,25 @@
 
 tc125.hs:16:10: Warning:
     No explicit implementation for
-      ‛add’
-    In the instance declaration for ‛Add Z a a’
+      ‘add’
+    In the instance declaration for ‘Add Z a a’
 
 tc125.hs:17:10: Warning:
     No explicit implementation for
-      ‛add’
-    In the instance declaration for ‛Add (S a) b (S c)’
+      ‘add’
+    In the instance declaration for ‘Add (S a) b (S c)’
 
 tc125.hs:21:10: Warning:
     No explicit implementation for
-      ‛mul’
-    In the instance declaration for ‛Mul Z a Z’
+      ‘mul’
+    In the instance declaration for ‘Mul Z a Z’
 
 tc125.hs:22:10: Warning:
     No explicit implementation for
-      ‛mul’
-    In the instance declaration for ‛Mul (S a) b d’
+      ‘mul’
+    In the instance declaration for ‘Mul (S a) b d’
 
 tc125.hs:29:10: Warning:
     No explicit implementation for
-      ‛add’
-    In the instance declaration for ‛Add (Q a b) (Q c d) (Q ad_bc bd)’
+      ‘add’
+    In the instance declaration for ‘Add (Q a b) (Q c d) (Q ad_bc bd)’
diff --git a/testsuite/tests/typecheck/should_compile/tc126.stderr-ghc b/testsuite/tests/typecheck/should_compile/tc126.stderr-ghc
index 1e84ac3d95b6..4adc2a29f41f 100644
--- a/testsuite/tests/typecheck/should_compile/tc126.stderr-ghc
+++ b/testsuite/tests/typecheck/should_compile/tc126.stderr-ghc
@@ -1,10 +1,10 @@
 
 tc126.hs:15:25: Warning:
     No explicit implementation for
-      ‛bug’
-    In the instance declaration for ‛Bug (Int -> r) Int r’
+      ‘bug’
+    In the instance declaration for ‘Bug (Int -> r) Int r’
 
 tc126.hs:16:10: Warning:
     No explicit implementation for
-      ‛bug’
-    In the instance declaration for ‛Bug f (c a) (c r)’
+      ‘bug’
+    In the instance declaration for ‘Bug f (c a) (c r)’
diff --git a/testsuite/tests/typecheck/should_compile/tc141.stderr b/testsuite/tests/typecheck/should_compile/tc141.stderr
index b63aa997cec4..9279d033b5f5 100644
--- a/testsuite/tests/typecheck/should_compile/tc141.stderr
+++ b/testsuite/tests/typecheck/should_compile/tc141.stderr
@@ -1,14 +1,14 @@
 
 tc141.hs:11:12:
-    You cannot bind scoped type variable ‛a’
+    You cannot bind scoped type variable ‘a’
       in a pattern binding signature
     In the pattern: p :: a
     In the pattern: (p :: a, q :: a)
     In a pattern binding: (p :: a, q :: a) = x
 
 tc141.hs:11:31:
-    Couldn't match expected type ‛a1’ with actual type ‛a’
-      because type variable ‛a1’ would escape its scope
+    Couldn't match expected type ‘a1’ with actual type ‘a’
+      because type variable ‘a1’ would escape its scope
     This (rigid, skolem) type variable is bound by
       an expression type signature: a1
       at tc141.hs:11:31-34
@@ -21,7 +21,7 @@ tc141.hs:11:31:
     In the expression: (q :: a, p)
 
 tc141.hs:13:13:
-    You cannot bind scoped type variable ‛a’
+    You cannot bind scoped type variable ‘a’
       in a pattern binding signature
     In the pattern: y :: a
     In a pattern binding: y :: a = a
@@ -33,8 +33,8 @@ tc141.hs:13:13:
       in v
 
 tc141.hs:15:18:
-    Couldn't match expected type ‛a2’ with actual type ‛t’
-      because type variable ‛a2’ would escape its scope
+    Couldn't match expected type ‘a2’ with actual type ‘t’
+      because type variable ‘a2’ would escape its scope
     This (rigid, skolem) type variable is bound by
       the type signature for v :: a2
       at tc141.hs:14:19
@@ -43,4 +43,4 @@ tc141.hs:15:18:
       b :: t (bound at tc141.hs:13:5)
       g :: a -> t -> a1 (bound at tc141.hs:13:1)
     In the expression: b
-    In an equation for ‛v’: v = b
+    In an equation for ‘v’: v = b
diff --git a/testsuite/tests/typecheck/should_compile/tc161.stderr-ghc b/testsuite/tests/typecheck/should_compile/tc161.stderr-ghc
index a91168c22a1d..163fde19cd98 100644
--- a/testsuite/tests/typecheck/should_compile/tc161.stderr-ghc
+++ b/testsuite/tests/typecheck/should_compile/tc161.stderr-ghc
@@ -1,5 +1,5 @@
 
 tc161.hs:17:10: Warning:
     No explicit implementation for
-      ‛op’
-    In the instance declaration for ‛Foo Int’
+      ‘op’
+    In the instance declaration for ‘Foo Int’
diff --git a/testsuite/tests/typecheck/should_compile/tc167.stderr b/testsuite/tests/typecheck/should_compile/tc167.stderr
index 32d0c80c436e..5d869af801d7 100644
--- a/testsuite/tests/typecheck/should_compile/tc167.stderr
+++ b/testsuite/tests/typecheck/should_compile/tc167.stderr
@@ -1,5 +1,5 @@
 
 tc167.hs:8:15:
-    Expecting a lifted type, but ‛Int#’ is unlifted
-    In the type ‛(->) Int#’
-    In the type declaration for ‛T’
+    Expecting a lifted type, but ‘Int#’ is unlifted
+    In the type ‘(->) Int#’
+    In the type declaration for ‘T’
diff --git a/testsuite/tests/typecheck/should_compile/tc168.hs b/testsuite/tests/typecheck/should_compile/tc168.hs
index 0aa56d169a1e..bd515331c4f6 100644
--- a/testsuite/tests/typecheck/should_compile/tc168.hs
+++ b/testsuite/tests/typecheck/should_compile/tc168.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts #-}
 
 -- We want to get the type
 --   	g :: forall a b c.  C a (b,c) => a -> b
diff --git a/testsuite/tests/typecheck/should_compile/tc168.stderr b/testsuite/tests/typecheck/should_compile/tc168.stderr
index 6fbc96f9343b..b46cdd04b355 100644
--- a/testsuite/tests/typecheck/should_compile/tc168.stderr
+++ b/testsuite/tests/typecheck/should_compile/tc168.stderr
@@ -1,11 +1,11 @@
-
-tc168.hs:17:1:
-    Could not deduce (C a1 (a, b0))
-      arising from the ambiguity check for ‛g’
-    from the context (C a1 (a, b))
-      bound by the inferred type for ‛g’: C a1 (a, b) => a1 -> a
-      at tc168.hs:17:1-16
-    The type variable ‛b0’ is ambiguous
-    When checking that ‛g’
-      has the inferred type ‛forall a b a1. C a1 (a, b) => a1 -> a’
-    Probable cause: the inferred type is ambiguous
+
+tc168.hs:17:1:
+    Could not deduce (C a1 (a, b0))
+      arising from the ambiguity check for ‘g’
+    from the context (C a1 (a, b))
+      bound by the inferred type for ‘g’: C a1 (a, b) => a1 -> a
+      at tc168.hs:17:1-16
+    The type variable ‘b0’ is ambiguous
+    When checking that ‘g’ has the inferred type
+      g :: forall a b a1. C a1 (a, b) => a1 -> a
+    Probable cause: the inferred type is ambiguous
diff --git a/testsuite/tests/typecheck/should_compile/tc175.stderr b/testsuite/tests/typecheck/should_compile/tc175.stderr
index 982cee89b7b1..b7a0eedb68c3 100644
--- a/testsuite/tests/typecheck/should_compile/tc175.stderr
+++ b/testsuite/tests/typecheck/should_compile/tc175.stderr
@@ -1,5 +1,5 @@
 
 tc175.hs:13:10: Warning:
     No explicit implementation for
-      either ‛showsPrec’ or ‛show’
-    In the instance declaration for ‛Show (a -> b)’
+      either ‘showsPrec’ or ‘show’
+    In the instance declaration for ‘Show (a -> b)’
diff --git a/testsuite/tests/typecheck/should_compile/tc176.hs b/testsuite/tests/typecheck/should_compile/tc176.hs
index d05ccdbe29f1..94fdcb2227da 100644
--- a/testsuite/tests/typecheck/should_compile/tc176.hs
+++ b/testsuite/tests/typecheck/should_compile/tc176.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE FlexibleInstances, OverlappingInstances #-}
+{-# LANGUAGE FlexibleInstances #-}
 
 {-  With "hugs -98 +o test.hs" gives me:
     ERROR "test.hs":8 - Cannot justify constraints in instance member binding
@@ -29,8 +29,8 @@ class FromStr a where
 typeError :: FromStr a => a -> a
 typeError t = error "type error"
 
-instance FromStr [a] where
+instance {-# OVERLAPPABLE #-} FromStr [a] where
      fromStr _ = typeError undefined  -- line 8
 
-instance FromStr [(String,a)] where  -- line 10
+instance {-# OVERLAPPING #-} FromStr [(String,a)] where  -- line 10
      fromStr _ = typeError undefined  -- line 11
diff --git a/testsuite/tests/typecheck/should_compile/tc179.hs b/testsuite/tests/typecheck/should_compile/tc179.hs
index 110950587de4..62db4726a035 100644
--- a/testsuite/tests/typecheck/should_compile/tc179.hs
+++ b/testsuite/tests/typecheck/should_compile/tc179.hs
@@ -1,5 +1,4 @@
-{-# LANGUAGE ExistentialQuantification, FlexibleInstances,
-             OverlappingInstances, UndecidableInstances #-}
+{-# LANGUAGE ExistentialQuantification, FlexibleInstances, UndecidableInstances #-}
 
 -- Tests context reduction for existentials
 
@@ -7,9 +6,9 @@ module TestWrappedNode where
 
 class Foo a where { op :: a -> Int }
 
-instance Foo a => Foo [a] where  	-- NB overlap
+instance {-# OVERLAPPABLE #-} Foo a => Foo [a] where  	-- NB overlap
   op (x:xs) = op x
-instance Foo [Int] where		-- NB overlap
+instance {-# OVERLAPPING #-} Foo [Int] where		-- NB overlap
   op x = 1
 
 data T = forall a. Foo a => MkT a
diff --git a/testsuite/tests/typecheck/should_compile/tc211.stderr b/testsuite/tests/typecheck/should_compile/tc211.stderr
index 00e1d0351db5..533155a657c6 100644
--- a/testsuite/tests/typecheck/should_compile/tc211.stderr
+++ b/testsuite/tests/typecheck/should_compile/tc211.stderr
@@ -1,82 +1,25 @@
-
-tc211.hs:15:22:
-    Couldn't match type ‛forall a6. a6 -> a6’ with ‛a -> a’
-    Expected type: [a -> a]
-      Actual type: [forall a. a -> a]
-    In the first argument of ‛head’, namely ‛foo’
-    In the first argument of ‛(:) ::
-                                (forall a. a -> a)
-                                -> [forall a. a -> a] -> [forall a. a -> a]’, namely
-      ‛(head foo)’
-
-tc211.hs:48:19:
-    Could not deduce (Num a2) arising from the literal ‛3’
-    from the context (Num a)
-      bound by the inferred type of
-               h1 :: Num a => (forall a1. a1 -> a1) -> a
-      at tc211.hs:(47,1)-(49,9)
-    The type variable ‛a2’ is ambiguous
-    Relevant bindings include
-      y :: Pair a2 (Pair a3 b1) (bound at tc211.hs:48:10)
-    Note: there are several potential instances:
-      instance Num Double -- Defined in ‛GHC.Float’
-      instance Num Float -- Defined in ‛GHC.Float’
-      instance Integral a => Num (GHC.Real.Ratio a)
-        -- Defined in ‛GHC.Real’
-      ...plus three others
-    In the first argument of ‛g’, namely ‛3’
-    In the first argument of ‛P’, namely ‛(g 3)’
-    In the expression: P (g 3) (g (P 3 4))
-
-tc211.hs:48:28:
-    Could not deduce (Num a3) arising from the literal ‛3’
-    from the context (Num a)
-      bound by the inferred type of
-               h1 :: Num a => (forall a1. a1 -> a1) -> a
-      at tc211.hs:(47,1)-(49,9)
-    The type variable ‛a3’ is ambiguous
-    Relevant bindings include
-      y :: Pair a2 (Pair a3 b1) (bound at tc211.hs:48:10)
-    Note: there are several potential instances:
-      instance Num Double -- Defined in ‛GHC.Float’
-      instance Num Float -- Defined in ‛GHC.Float’
-      instance Integral a => Num (GHC.Real.Ratio a)
-        -- Defined in ‛GHC.Real’
-      ...plus three others
-    In the first argument of ‛P’, namely ‛3’
-    In the first argument of ‛g’, namely ‛(P 3 4)’
-    In the second argument of ‛P’, namely ‛(g (P 3 4))’
-
-tc211.hs:48:30:
-    Could not deduce (Num b1) arising from the literal ‛4’
-    from the context (Num a)
-      bound by the inferred type of
-               h1 :: Num a => (forall a1. a1 -> a1) -> a
-      at tc211.hs:(47,1)-(49,9)
-    The type variable ‛b1’ is ambiguous
-    Relevant bindings include
-      y :: Pair a2 (Pair a3 b1) (bound at tc211.hs:48:10)
-    Note: there are several potential instances:
-      instance Num Double -- Defined in ‛GHC.Float’
-      instance Num Float -- Defined in ‛GHC.Float’
-      instance Integral a => Num (GHC.Real.Ratio a)
-        -- Defined in ‛GHC.Real’
-      ...plus three others
-    In the second argument of ‛P’, namely ‛4’
-    In the first argument of ‛g’, namely ‛(P 3 4)’
-    In the second argument of ‛P’, namely ‛(g (P 3 4))’
-
-tc211.hs:70:9:
-    Couldn't match type ‛forall a7. a7 -> a7’ with ‛a6 -> a6’
-    Expected type: List (forall a. a -> a)
-                   -> (forall a. a -> a) -> a6 -> a6
-      Actual type: List (forall a. a -> a)
-                   -> (forall a. a -> a) -> forall a. a -> a
-    In the expression:
-        foo2 ::
-          List (forall a. a -> a) -> (forall a. a -> a) -> (forall a. a -> a)
-    In the expression:
-      (foo2 ::
-         List (forall a. a -> a)
-         -> (forall a. a -> a) -> (forall a. a -> a))
-        xs1 (\ x -> x)
+
+tc211.hs:15:22:
+    Couldn't match type ‘forall a1. a1 -> a1’ with ‘a -> a’
+    Expected type: [a -> a]
+      Actual type: [forall a. a -> a]
+    In the first argument of ‘head’, namely ‘foo’
+    In the first argument of ‘(:) ::
+                                (forall a. a -> a)
+                                -> [forall a. a -> a] -> [forall a. a -> a]’, namely
+      ‘(head foo)’
+
+tc211.hs:70:9:
+    Couldn't match type ‘forall a2. a2 -> a2’ with ‘a1 -> a1’
+    Expected type: List (forall a. a -> a)
+                   -> (forall a. a -> a) -> a1 -> a1
+      Actual type: List (forall a. a -> a)
+                   -> (forall a. a -> a) -> forall a. a -> a
+    In the expression:
+        foo2 ::
+          List (forall a. a -> a) -> (forall a. a -> a) -> (forall a. a -> a)
+    In the expression:
+      (foo2 ::
+         List (forall a. a -> a)
+         -> (forall a. a -> a) -> (forall a. a -> a))
+        xs1 (\ x -> x)
diff --git a/testsuite/tests/typecheck/should_compile/tc231.hs b/testsuite/tests/typecheck/should_compile/tc231.hs
index 304748994b80..a7270ef7694e 100644
--- a/testsuite/tests/typecheck/should_compile/tc231.hs
+++ b/testsuite/tests/typecheck/should_compile/tc231.hs
@@ -1,5 +1,5 @@
 {-# OPTIONS_GHC -ddump-types #-}
-{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}
+{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleContexts #-}
 
 -- See Trac #1456
 
diff --git a/testsuite/tests/typecheck/should_compile/tc231.stderr b/testsuite/tests/typecheck/should_compile/tc231.stderr
index 4334d62a42e2..4421e8aba387 100644
--- a/testsuite/tests/typecheck/should_compile/tc231.stderr
+++ b/testsuite/tests/typecheck/should_compile/tc231.stderr
@@ -5,26 +5,12 @@ TYPE SIGNATURES
     Q s (Z [Char]) chain -> ST s ()
   s :: forall t t1. Q t (Z [Char]) t1 -> Q t (Z [Char]) t1
 TYPE CONSTRUCTORS
-  Q :: * -> * -> * -> *
-  data Q s a chain
-    No C type associated
-    Roles: [representational, representational, representational]
-    RecFlag NonRecursive, Promotable
-    = Node :: forall s a chain. s -> a -> chain -> Q s a chain
-        Stricts: _ _ _
-    FamilyInstance: none
-  Z :: * -> *
-  data Z a
-    No C type associated
-    Roles: [representational]
-    RecFlag NonRecursive, Promotable
-    = Z :: forall a. a -> Z a Stricts: _
-    FamilyInstance: none
-  Zork :: * -> * -> * -> Constraint
-  class Zork s a b | a -> b
-    Roles: [nominal, nominal, nominal]
-    RecFlag NonRecursive
-    huh :: forall chain. Q s a chain -> ST s ()
+  data Q s a chain = Node s a chain
+    Promotable
+  data Z a = Z a
+    Promotable
+  class Zork s a b | a -> b where
+    huh :: Q s a chain -> ST s ()
 COERCION AXIOMS
   axiom ShouldCompile.NTCo:Zork ::
       Zork s a b = forall chain. Q s a chain -> ST s ()
diff --git a/testsuite/tests/typecheck/should_compile/tc253.hs b/testsuite/tests/typecheck/should_compile/tc253.hs
index 4771b8243557..3ce439e4f202 100644
--- a/testsuite/tests/typecheck/should_compile/tc253.hs
+++ b/testsuite/tests/typecheck/should_compile/tc253.hs
@@ -4,8 +4,11 @@ module ShouldCompile where
 class Cls a where
     type Fam a b :: *
     -- Multiple defaults!
-    type Fam a Bool = Maybe a
-    type Fam a Int = (String, a)
+    type Fam a x = FamHelper a x
+
+type family FamHelper a x
+type instance FamHelper a Bool = Maybe a
+type instance FamHelper a Int  = (String, a)
 
 instance Cls Int where
     -- Gets type family from default
diff --git a/testsuite/tests/typecheck/should_compile/tc254.stderr b/testsuite/tests/typecheck/should_compile/tc254.stderr
index a721c7e3b447..885b505828ec 100644
--- a/testsuite/tests/typecheck/should_compile/tc254.stderr
+++ b/testsuite/tests/typecheck/should_compile/tc254.stderr
@@ -1,4 +1,4 @@
 
 tc254.hs:8:1: Warning:
-    No explicit associated type or default declaration for ‛Typ’
-    In the instance declaration for ‛Cls Int’
+    No explicit associated type or default declaration for ‘Typ’
+    In the instance declaration for ‘Cls Int’
diff --git a/testsuite/tests/typecheck/should_fail/AssocTyDef01.stderr b/testsuite/tests/typecheck/should_fail/AssocTyDef01.stderr
index e342e900a6bb..b865437c8668 100644
--- a/testsuite/tests/typecheck/should_fail/AssocTyDef01.stderr
+++ b/testsuite/tests/typecheck/should_fail/AssocTyDef01.stderr
@@ -1,3 +1,3 @@
 
 AssocTyDef01.hs:9:10:
-    ‛OtherType’ is not a (visible) associated type of class ‛Cls’
+    ‘OtherType’ is not a (visible) associated type of class ‘Cls’
diff --git a/testsuite/tests/typecheck/should_fail/AssocTyDef02.stderr b/testsuite/tests/typecheck/should_fail/AssocTyDef02.stderr
index 749e42c991c6..b310a79a6fae 100644
--- a/testsuite/tests/typecheck/should_fail/AssocTyDef02.stderr
+++ b/testsuite/tests/typecheck/should_fail/AssocTyDef02.stderr
@@ -1,6 +1,6 @@
 
-AssocTyDef02.hs:6:10:
-    Type indexes must match class instance head
-    Found ‛[b]’ but expected ‛a’
-    In the type synonym instance default declaration for ‛Typ’
-    In the class declaration for ‛Cls’
+AssocTyDef02.hs:6:14:
+    Unexpected type ‘[b]’
+    In the default declaration for ‘Typ’
+    A default declaration should have form
+      default Typ a = ...
diff --git a/testsuite/tests/typecheck/should_fail/AssocTyDef03.stderr b/testsuite/tests/typecheck/should_fail/AssocTyDef03.stderr
index 82e9b0f3a303..c0950bcc747b 100644
--- a/testsuite/tests/typecheck/should_fail/AssocTyDef03.stderr
+++ b/testsuite/tests/typecheck/should_fail/AssocTyDef03.stderr
@@ -1,5 +1,5 @@
-
-AssocTyDef03.hs:6:5:
-    Wrong category of family instance; declaration was for a data type
-    In the type instance declaration for ‛Typ’
-    In the class declaration for ‛Cls’
+
+AssocTyDef03.hs:6:5:
+    Wrong category of family instance; declaration was for a data type
+    In the default type instance declaration for ‘Typ’
+    In the class declaration for ‘Cls’
diff --git a/testsuite/tests/typecheck/should_fail/AssocTyDef04.stderr b/testsuite/tests/typecheck/should_fail/AssocTyDef04.stderr
index b03eb045e5f3..4fbaaef19956 100644
--- a/testsuite/tests/typecheck/should_fail/AssocTyDef04.stderr
+++ b/testsuite/tests/typecheck/should_fail/AssocTyDef04.stderr
@@ -1,7 +1,7 @@
-
-AssocTyDef04.hs:6:18:
-    Expecting one more argument to ‛Maybe’
-    Expected kind ‛*’, but ‛Maybe’ has kind ‛* -> *’
-    In the type ‛Maybe’
-    In the type instance declaration for ‛Typ’
-    In the class declaration for ‛Cls’
+
+AssocTyDef04.hs:6:18:
+    Expecting one more argument to ‘Maybe’
+    Expected kind ‘*’, but ‘Maybe’ has kind ‘* -> *’
+    In the type ‘Maybe’
+    In the default type instance declaration for ‘Typ’
+    In the class declaration for ‘Cls’
diff --git a/testsuite/tests/typecheck/should_fail/AssocTyDef05.stderr b/testsuite/tests/typecheck/should_fail/AssocTyDef05.stderr
index 5d003e9a429f..660d081ca351 100644
--- a/testsuite/tests/typecheck/should_fail/AssocTyDef05.stderr
+++ b/testsuite/tests/typecheck/should_fail/AssocTyDef05.stderr
@@ -1,5 +1,5 @@
-
-AssocTyDef05.hs:6:10:
-    Number of parameters must match family declaration; expected 1
-    In the type synonym instance default declaration for ‛Typ’
-    In the class declaration for ‛Cls’
+
+AssocTyDef05.hs:6:5:
+    Number of parameters must match family declaration; expected 1
+    In the default type instance declaration for ‘Typ’
+    In the class declaration for ‘Cls’
diff --git a/testsuite/tests/typecheck/should_fail/AssocTyDef06.stderr b/testsuite/tests/typecheck/should_fail/AssocTyDef06.stderr
index fb7f91033c18..665ad223d2b7 100644
--- a/testsuite/tests/typecheck/should_fail/AssocTyDef06.stderr
+++ b/testsuite/tests/typecheck/should_fail/AssocTyDef06.stderr
@@ -1,5 +1,6 @@
-
-AssocTyDef06.hs:6:10:
-    Number of parameters must match family declaration; expected no more than 1
-    In the type instance declaration for ‛Typ’
-    In the class declaration for ‛Cls’
+
+AssocTyDef06.hs:6:16:
+    Unexpected type ‘Int’
+    In the default declaration for ‘Typ’
+    A default declaration should have form
+      default Typ a b = ...
diff --git a/testsuite/tests/typecheck/should_fail/AssocTyDef07.stderr b/testsuite/tests/typecheck/should_fail/AssocTyDef07.stderr
index 151f5a9b8fee..c4498ed5834c 100644
--- a/testsuite/tests/typecheck/should_fail/AssocTyDef07.stderr
+++ b/testsuite/tests/typecheck/should_fail/AssocTyDef07.stderr
@@ -1,3 +1,3 @@
 
 AssocTyDef07.hs:5:10:
-    ‛Typ’ is not a (visible) associated type of class ‛Cls’
+    ‘Typ’ is not a (visible) associated type of class ‘Cls’
diff --git a/testsuite/tests/typecheck/should_fail/AssocTyDef08.stderr b/testsuite/tests/typecheck/should_fail/AssocTyDef08.stderr
index 97147c7dfdcb..d63d36957039 100644
--- a/testsuite/tests/typecheck/should_fail/AssocTyDef08.stderr
+++ b/testsuite/tests/typecheck/should_fail/AssocTyDef08.stderr
@@ -1,3 +1,3 @@
 
 AssocTyDef08.hs:4:10:
-    ‛Typ’ is not a (visible) associated type of class ‛Cls’
+    ‘Typ’ is not a (visible) associated type of class ‘Cls’
diff --git a/testsuite/tests/typecheck/should_fail/AssocTyDef09.stderr b/testsuite/tests/typecheck/should_fail/AssocTyDef09.stderr
index 3f8c11328974..c6dfdeb0da02 100644
--- a/testsuite/tests/typecheck/should_fail/AssocTyDef09.stderr
+++ b/testsuite/tests/typecheck/should_fail/AssocTyDef09.stderr
@@ -1,3 +1,3 @@
 
 AssocTyDef09.hs:8:10:
-    ‛OtherType’ is not a (visible) associated type of class ‛Cls’
+    ‘OtherType’ is not a (visible) associated type of class ‘Cls’
diff --git a/testsuite/tests/typecheck/should_fail/ContextStack1.stderr b/testsuite/tests/typecheck/should_fail/ContextStack1.stderr
index 425c79a2fe44..d11a6255ed5a 100644
--- a/testsuite/tests/typecheck/should_fail/ContextStack1.stderr
+++ b/testsuite/tests/typecheck/should_fail/ContextStack1.stderr
@@ -4,4 +4,4 @@ ContextStack1.hs:10:5:
     Use -fcontext-stack=N to increase stack size to N
       Cls [[[[[[[[[[[()]]]]]]]]]]]
     In the expression: meth
-    In an equation for ‛t’: t = meth
+    In an equation for ‘t’: t = meth
diff --git a/testsuite/tests/typecheck/should_fail/ContextStack2.stderr b/testsuite/tests/typecheck/should_fail/ContextStack2.stderr
index 210e22d8dbf9..e99e4c4264a5 100644
--- a/testsuite/tests/typecheck/should_fail/ContextStack2.stderr
+++ b/testsuite/tests/typecheck/should_fail/ContextStack2.stderr
@@ -6,4 +6,4 @@ ContextStack2.hs:8:6:
        TF (TF (TF (TF (TF (TF (TF (TF (TF (TF (TF Int)))))))))))
       ~ TF (TF (TF (TF (TF (TF (TF (TF (TF (TF a)))))))))
     In the ambiguity check for: forall a. a ~ TF (a, Int) => Int
-    In the type signature for ‛t’: t :: a ~ TF (a, Int) => Int
+    In the type signature for ‘t’: t :: (a ~ TF (a, Int)) => Int
diff --git a/testsuite/tests/typecheck/should_fail/FDsFromGivens.stderr b/testsuite/tests/typecheck/should_fail/FDsFromGivens.stderr
index cb47049f0634..56d3006260a9 100644
--- a/testsuite/tests/typecheck/should_fail/FDsFromGivens.stderr
+++ b/testsuite/tests/typecheck/should_fail/FDsFromGivens.stderr
@@ -1,10 +1,10 @@
 
 FDsFromGivens.hs:21:15:
-    Could not deduce (C Char [a]) arising from a use of ‛f’
+    Could not deduce (C Char [a]) arising from a use of ‘f’
     from the context (C Char Char)
       bound by a pattern with constructor
                  KCC :: C Char Char => () -> KCC,
-               in an equation for ‛bar’
+               in an equation for ‘bar’
       at FDsFromGivens.hs:21:6-10
     In the expression: f
-    In an equation for ‛bar’: bar (KCC _) = f
+    In an equation for ‘bar’: bar (KCC _) = f
diff --git a/testsuite/tests/typecheck/should_fail/FailDueToGivenOverlapping.stderr b/testsuite/tests/typecheck/should_fail/FailDueToGivenOverlapping.stderr
index 74e0bc7341c2..5ccc035c7659 100644
--- a/testsuite/tests/typecheck/should_fail/FailDueToGivenOverlapping.stderr
+++ b/testsuite/tests/typecheck/should_fail/FailDueToGivenOverlapping.stderr
@@ -1,12 +1,12 @@
 
 FailDueToGivenOverlapping.hs:27:9:
-    Overlapping instances for E [t0] arising from a use of ‛eop’
+    Overlapping instances for E [t0] arising from a use of ‘eop’
     Matching givens (or their superclasses):
       (E [Int])
         bound by the type signature for bar :: E [Int] => () -> ()
         at FailDueToGivenOverlapping.hs:26:8-26
     Matching instances:
       instance E [a] -- Defined at FailDueToGivenOverlapping.hs:21:10
-    (The choice depends on the instantiation of ‛t0’)
+    (The choice depends on the instantiation of ‘t0’)
     In the expression: eop [undefined]
-    In an equation for ‛bar’: bar _ = eop [undefined]
+    In an equation for ‘bar’: bar _ = eop [undefined]
diff --git a/testsuite/tests/typecheck/should_fail/FrozenErrorTests.stderr b/testsuite/tests/typecheck/should_fail/FrozenErrorTests.stderr
index 471643b574dc..848920c18189 100644
--- a/testsuite/tests/typecheck/should_fail/FrozenErrorTests.stderr
+++ b/testsuite/tests/typecheck/should_fail/FrozenErrorTests.stderr
@@ -1,6 +1,6 @@
 
 FrozenErrorTests.hs:12:12:
-    Couldn't match type ‛Int’ with ‛Bool’
+    Couldn't match type ‘Int’ with ‘Bool’
     Inaccessible code in
       a pattern with constructor
         MkT3 :: forall a. a ~ Bool => T a,
@@ -16,38 +16,38 @@ FrozenErrorTests.hs:26:9:
     Relevant bindings include
       test1 :: a (bound at FrozenErrorTests.hs:26:1)
     In the expression: goo1 False undefined
-    In an equation for ‛test1’: test1 = goo1 False undefined
+    In an equation for ‘test1’: test1 = goo1 False undefined
 
 FrozenErrorTests.hs:29:15:
-    Couldn't match type ‛Int’ with ‛[Int]’
+    Couldn't match type ‘Int’ with ‘[Int]’
     Expected type: [[Int]]
       Actual type: F [Int] Bool
-    In the first argument of ‛goo2’, namely ‛(goo1 False undefined)’
+    In the first argument of ‘goo2’, namely ‘(goo1 False undefined)’
     In the expression: goo2 (goo1 False undefined)
-    In an equation for ‛test2’: test2 = goo2 (goo1 False undefined)
+    In an equation for ‘test2’: test2 = goo2 (goo1 False undefined)
 
 FrozenErrorTests.hs:30:9:
-    Couldn't match type ‛[Int]’ with ‛Int’
+    Couldn't match type ‘[Int]’ with ‘Int’
     Expected type: [[Int]]
       Actual type: F [Int] Bool
     In the expression: goo1 False (goo2 undefined)
-    In an equation for ‛test3’: test3 = goo1 False (goo2 undefined)
+    In an equation for ‘test3’: test3 = goo1 False (goo2 undefined)
 
 FrozenErrorTests.hs:45:15:
-    Couldn't match type ‛T2 c c’ with ‛M (T2 (T2 c c) c)’
+    Couldn't match type ‘T2 c c’ with ‘M (T2 (T2 c c) c)’
     Expected type: T2 (M (T2 (T2 c c) c)) (T2 (T2 c c) c)
       Actual type: F (T2 (T2 c c) c) Bool
     Relevant bindings include
       test4 :: T2 (T2 c c) c (bound at FrozenErrorTests.hs:45:1)
-    In the first argument of ‛goo4’, namely ‛(goo3 False undefined)’
+    In the first argument of ‘goo4’, namely ‘(goo3 False undefined)’
     In the expression: goo4 (goo3 False undefined)
-    In an equation for ‛test4’: test4 = goo4 (goo3 False undefined)
+    In an equation for ‘test4’: test4 = goo4 (goo3 False undefined)
 
 FrozenErrorTests.hs:46:9:
-    Couldn't match type ‛T2 c c’ with ‛M (T2 (T2 c c) c)’
+    Couldn't match type ‘T2 c c’ with ‘M (T2 (T2 c c) c)’
     Expected type: T2 (M (T2 (T2 c c) c)) (T2 (T2 c c) c)
       Actual type: F (T2 (T2 c c) c) Bool
     Relevant bindings include
       test5 :: T2 (T2 c c) c (bound at FrozenErrorTests.hs:46:1)
     In the expression: goo3 False (goo4 undefined)
-    In an equation for ‛test5’: test5 = goo3 False (goo4 undefined)
+    In an equation for ‘test5’: test5 = goo3 False (goo4 undefined)
diff --git a/testsuite/tests/typecheck/should_fail/IPFail.stderr b/testsuite/tests/typecheck/should_fail/IPFail.stderr
index 127693a5caf1..c617cfb776a1 100644
--- a/testsuite/tests/typecheck/should_fail/IPFail.stderr
+++ b/testsuite/tests/typecheck/should_fail/IPFail.stderr
@@ -1,9 +1,9 @@
 
 IPFail.hs:6:18:
-    Could not deduce (Num Bool) arising from the literal ‛5’
+    Could not deduce (Num Bool) arising from the literal ‘5’
     from the context (?x::Int)
       bound by the type signature for f0 :: (?x::Int) => () -> Bool
       at IPFail.hs:5:7-31
     In the expression: 5
     In the expression: let ?x = 5 in ?x
-    In an equation for ‛f0’: f0 () = let ?x = 5 in ?x
+    In an equation for ‘f0’: f0 () = let ?x = 5 in ?x
diff --git a/testsuite/tests/typecheck/should_fail/LongWayOverlapping.hs b/testsuite/tests/typecheck/should_fail/LongWayOverlapping.hs
index 4a79e69ed620..663143ceb4a8 100644
--- a/testsuite/tests/typecheck/should_fail/LongWayOverlapping.hs
+++ b/testsuite/tests/typecheck/should_fail/LongWayOverlapping.hs
@@ -1,7 +1,6 @@
 {-# LANGUAGE TypeFamilies, MultiParamTypeClasses
   , FlexibleContexts, FlexibleInstances, UndecidableInstances
   , TypeSynonymInstances, GeneralizedNewtypeDeriving
-  , OverlappingInstances 
   #-}
 
 module LongWayOverlapping where
diff --git a/testsuite/tests/typecheck/should_fail/LongWayOverlapping.stderr b/testsuite/tests/typecheck/should_fail/LongWayOverlapping.stderr
index d50cc847ddf2..f1eb2db530f9 100644
--- a/testsuite/tests/typecheck/should_fail/LongWayOverlapping.stderr
+++ b/testsuite/tests/typecheck/should_fail/LongWayOverlapping.stderr
@@ -1,7 +1,7 @@
 
-LongWayOverlapping.hs:23:11:
+LongWayOverlapping.hs:22:11:
     No instance for (EmbAsChild [Char] Char)
-      arising from a use of ‛emb’
+      arising from a use of ‘emb’
     In the expression: emb 'c'
-    In an equation for ‛emb’: emb _ = emb 'c'
-    In the instance declaration for ‛EmbAsChild [Char] Bool’
+    In an equation for ‘emb’: emb _ = emb 'c'
+    In the instance declaration for ‘EmbAsChild [Char] Bool’
diff --git a/testsuite/tests/typecheck/should_fail/SCLoop.stderr b/testsuite/tests/typecheck/should_fail/SCLoop.stderr
index 309dd91af016..90fe75cd3e07 100644
--- a/testsuite/tests/typecheck/should_fail/SCLoop.stderr
+++ b/testsuite/tests/typecheck/should_fail/SCLoop.stderr
@@ -1,5 +1,5 @@
 
 SCLoop.hs:22:7:
-    No instance for (SC ()) arising from a use of ‛op’
+    No instance for (SC ()) arising from a use of ‘op’
     In the expression: op () ([Just True])
-    In an equation for ‛foo’: foo = op () ([Just True])
+    In an equation for ‘foo’: foo = op () ([Just True])
diff --git a/testsuite/tests/typecheck/should_fail/SilentParametersOverlapping.stderr b/testsuite/tests/typecheck/should_fail/SilentParametersOverlapping.stderr
index 255e6513ebff..62d1c7820bc5 100644
--- a/testsuite/tests/typecheck/should_fail/SilentParametersOverlapping.stderr
+++ b/testsuite/tests/typecheck/should_fail/SilentParametersOverlapping.stderr
@@ -1,13 +1,13 @@
 
 SilentParametersOverlapping.hs:15:9:
-    Overlapping instances for C [(t0, t1)] arising from a use of ‛c’
+    Overlapping instances for C [(t0, t1)] arising from a use of ‘c’
     Matching givens (or their superclasses):
       (C [(a, b)])
         bound by the instance declaration
         at SilentParametersOverlapping.hs:14:37-45
     Matching instances:
       instance C [a] -- Defined at SilentParametersOverlapping.hs:11:10
-    (The choice depends on the instantiation of ‛t0, t1’)
+    (The choice depends on the instantiation of ‘t0, t1’)
     In the expression: c [(undefined, undefined)]
-    In an equation for ‛b’: b x = c [(undefined, undefined)]
-    In the instance declaration for ‛B [(a, b)]’
+    In an equation for ‘b’: b x = c [(undefined, undefined)]
+    In the instance declaration for ‘B [(a, b)]’
diff --git a/testsuite/tests/typecheck/should_fail/T1595.stderr b/testsuite/tests/typecheck/should_fail/T1595.stderr
index a84903ded706..1f999c636b0a 100644
--- a/testsuite/tests/typecheck/should_fail/T1595.stderr
+++ b/testsuite/tests/typecheck/should_fail/T1595.stderr
@@ -1,6 +1,6 @@
 
 T1595.hs:8:15:
-    Not in scope: type constructor or class ‛DoesNotExist’
+    Not in scope: type constructor or class ‘DoesNotExist’
 
 T1595.hs:13:22:
-    Not in scope: type constructor or class ‛DoesNotExist’
+    Not in scope: type constructor or class ‘DoesNotExist’
diff --git a/testsuite/tests/typecheck/should_fail/T1633.stderr b/testsuite/tests/typecheck/should_fail/T1633.stderr
index 8a01bd9fd674..63eced334d52 100644
--- a/testsuite/tests/typecheck/should_fail/T1633.stderr
+++ b/testsuite/tests/typecheck/should_fail/T1633.stderr
@@ -1,5 +1,5 @@
 
 T1633.hs:6:18:
-    The first argument of ‛Functor’ should have kind ‛* -> *’,
-      but ‛Bool’ has kind ‛*’
-    In the instance declaration for ‛Functor Bool’
+    The first argument of ‘Functor’ should have kind ‘* -> *’,
+      but ‘Bool’ has kind ‘*’
+    In the instance declaration for ‘Functor Bool’
diff --git a/testsuite/tests/typecheck/should_fail/T1897a.stderr b/testsuite/tests/typecheck/should_fail/T1897a.stderr
index b495f17b1c6e..58f1a2d6ffa0 100644
--- a/testsuite/tests/typecheck/should_fail/T1897a.stderr
+++ b/testsuite/tests/typecheck/should_fail/T1897a.stderr
@@ -1,11 +1,11 @@
-
-T1897a.hs:9:1:
-    Could not deduce (Wob a0 b)
-      arising from the ambiguity check for ‛foo’
-    from the context (Wob a b)
-      bound by the inferred type for ‛foo’: Wob a b => b -> [b]
-      at T1897a.hs:9:1-24
-    The type variable ‛a0’ is ambiguous
-    When checking that ‛foo’
-      has the inferred type ‛forall a b. Wob a b => b -> [b]’
-    Probable cause: the inferred type is ambiguous
+
+T1897a.hs:9:1:
+    Could not deduce (Wob a0 b)
+      arising from the ambiguity check for ‘foo’
+    from the context (Wob a b)
+      bound by the inferred type for ‘foo’: Wob a b => b -> [b]
+      at T1897a.hs:9:1-24
+    The type variable ‘a0’ is ambiguous
+    When checking that ‘foo’ has the inferred type
+      foo :: forall a b. Wob a b => b -> [b]
+    Probable cause: the inferred type is ambiguous
diff --git a/testsuite/tests/typecheck/should_fail/T1899.stderr b/testsuite/tests/typecheck/should_fail/T1899.stderr
index 55fc35632455..a8baba78cc53 100644
--- a/testsuite/tests/typecheck/should_fail/T1899.stderr
+++ b/testsuite/tests/typecheck/should_fail/T1899.stderr
@@ -1,11 +1,11 @@
 
 T1899.hs:12:29:
-    Couldn't match expected type ‛a’ with actual type ‛Proposition a0’
-      ‛a’ is a rigid type variable bound by
+    Couldn't match expected type ‘a’ with actual type ‘Proposition a0’
+      ‘a’ is a rigid type variable bound by
           the type signature for transRHS :: [a] -> Int -> Constraint a
           at T1899.hs:9:14
     Relevant bindings include
       varSet :: [a] (bound at T1899.hs:10:11)
       transRHS :: [a] -> Int -> Constraint a (bound at T1899.hs:10:2)
-    In the first argument of ‛Prop’, namely ‛(Auxiliary undefined)’
+    In the first argument of ‘Prop’, namely ‘(Auxiliary undefined)’
     In the expression: Prop (Auxiliary undefined)
diff --git a/testsuite/tests/typecheck/should_fail/T2126.stderr b/testsuite/tests/typecheck/should_fail/T2126.stderr
index 1e0a72df2edd..c91014831792 100644
--- a/testsuite/tests/typecheck/should_fail/T2126.stderr
+++ b/testsuite/tests/typecheck/should_fail/T2126.stderr
@@ -1,4 +1,4 @@
 
 T2126.hs:5:1:
-    A newtype must have exactly one constructor, but ‛X’ has none
-    In the newtype declaration for ‛X’
+    A newtype must have exactly one constructor, but ‘X’ has none
+    In the newtype declaration for ‘X’
diff --git a/testsuite/tests/typecheck/should_fail/T2247.stderr b/testsuite/tests/typecheck/should_fail/T2247.stderr
index 6a99d541d672..edf4246b4638 100644
--- a/testsuite/tests/typecheck/should_fail/T2247.stderr
+++ b/testsuite/tests/typecheck/should_fail/T2247.stderr
@@ -1,7 +1,7 @@
 
 T2247.hs:6:10:
-    Illegal instance declaration for ‛FD a b’
-      The liberal coverage condition fails in class ‛FD’
-        for functional dependency: ‛a -> b’
-      Reason: lhs type ‛a’ does not determine rhs type ‛b’
-    In the instance declaration for ‛FD a b’
+    Illegal instance declaration for ‘FD a b’
+      The liberal coverage condition fails in class ‘FD’
+        for functional dependency: ‘a -> b’
+      Reason: lhs type ‘a’ does not determine rhs type ‘b’
+    In the instance declaration for ‘FD a b’
diff --git a/testsuite/tests/typecheck/should_fail/T2307.hs b/testsuite/tests/typecheck/should_fail/T2307.hs
index 321c2d56418c..ea0c335a962a 100644
--- a/testsuite/tests/typecheck/should_fail/T2307.hs
+++ b/testsuite/tests/typecheck/should_fail/T2307.hs
@@ -1,5 +1,5 @@
 {-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies,
-              OverlappingInstances, UndecidableInstances,
+              UndecidableInstances,
 	      IncoherentInstances,
               FlexibleInstances #-}
 
diff --git a/testsuite/tests/typecheck/should_fail/T2354.stderr b/testsuite/tests/typecheck/should_fail/T2354.stderr
index cc0fac9794c1..5c5fcfcf0ee6 100644
--- a/testsuite/tests/typecheck/should_fail/T2354.stderr
+++ b/testsuite/tests/typecheck/should_fail/T2354.stderr
@@ -1,6 +1,6 @@
 
 T2354.hs:4:3:
-    The NOINLINE pragma for default method ‛toInt’ lacks an accompanying binding
+    The NOINLINE pragma for default method ‘toInt’ lacks an accompanying binding
 
 T2354.hs:6:3:
-    The NOINLINE pragma for default method ‛fromInt’ lacks an accompanying binding
+    The NOINLINE pragma for default method ‘fromInt’ lacks an accompanying binding
diff --git a/testsuite/tests/typecheck/should_fail/T2414.stderr b/testsuite/tests/typecheck/should_fail/T2414.stderr
index cedf04d8cf31..7c4310398d06 100644
--- a/testsuite/tests/typecheck/should_fail/T2414.stderr
+++ b/testsuite/tests/typecheck/should_fail/T2414.stderr
@@ -3,5 +3,5 @@ T2414.hs:9:13:
     Occurs check: cannot construct the infinite type: b0 ~ (Bool, b0)
     Expected type: b0 -> Maybe (Bool, b0)
       Actual type: b0 -> Maybe b0
-    In the first argument of ‛unfoldr’, namely ‛Just’
+    In the first argument of ‘unfoldr’, namely ‘Just’
     In the expression: unfoldr Just
diff --git a/testsuite/tests/typecheck/should_fail/T2534.stderr b/testsuite/tests/typecheck/should_fail/T2534.stderr
index 389b515957ec..7a0aa3a9911a 100644
--- a/testsuite/tests/typecheck/should_fail/T2534.stderr
+++ b/testsuite/tests/typecheck/should_fail/T2534.stderr
@@ -1,8 +1,8 @@
 
 T2534.hs:3:19:
-    Couldn't match expected type ‛a -> a -> b’ with actual type ‛[t0]’
+    Couldn't match expected type ‘a -> a -> b’ with actual type ‘[t0]’
     Relevant bindings include
       foo :: a -> a -> b (bound at T2534.hs:3:1)
-    In the second argument of ‛foldr’, namely ‛[]’
+    In the second argument of ‘foldr’, namely ‘[]’
     In the expression: foldr (>>=) [] []
-    In an equation for ‛foo’: foo = foldr (>>=) [] []
+    In an equation for ‘foo’: foo = foldr (>>=) [] []
diff --git a/testsuite/tests/typecheck/should_fail/T2538.stderr b/testsuite/tests/typecheck/should_fail/T2538.stderr
index 9838eb5bffe2..884eafb27170 100644
--- a/testsuite/tests/typecheck/should_fail/T2538.stderr
+++ b/testsuite/tests/typecheck/should_fail/T2538.stderr
@@ -2,13 +2,13 @@
 T2538.hs:6:6:
     Illegal polymorphic or qualified type: Eq a => a -> a
     Perhaps you intended to use RankNTypes or Rank2Types
-    In the type signature for ‛f’: f :: (Eq a => a -> a) -> Int
+    In the type signature for ‘f’: f :: (Eq a => a -> a) -> Int
 
 T2538.hs:9:6:
     Illegal polymorphic or qualified type: Eq a => a -> a
     Perhaps you intended to use ImpredicativeTypes
-    In the type signature for ‛g’: g :: [Eq a => a -> a] -> Int
+    In the type signature for ‘g’: g :: [Eq a => a -> a] -> Int
 
 T2538.hs:12:6:
     Illegal polymorphic or qualified type: Eq a => a -> a
-    In the type signature for ‛h’: h :: Ix (Eq a => a -> a) => Int
+    In the type signature for ‘h’: h :: Ix (Eq a => a -> a) => Int
diff --git a/testsuite/tests/typecheck/should_fail/T2688.stderr b/testsuite/tests/typecheck/should_fail/T2688.stderr
index 6ee894487d01..b117f02f9f30 100644
--- a/testsuite/tests/typecheck/should_fail/T2688.stderr
+++ b/testsuite/tests/typecheck/should_fail/T2688.stderr
@@ -2,15 +2,15 @@
 T2688.hs:8:22:
     Could not deduce (s ~ v)
     from the context (VectorSpace v s)
-      bound by the class declaration for ‛VectorSpace’
+      bound by the class declaration for ‘VectorSpace’
       at T2688.hs:(5,1)-(8,23)
-      ‛s’ is a rigid type variable bound by
-          the class declaration for ‛VectorSpace’ at T2688.hs:5:21
-      ‛v’ is a rigid type variable bound by
-          the class declaration for ‛VectorSpace’ at T2688.hs:5:19
+      ‘s’ is a rigid type variable bound by
+          the class declaration for ‘VectorSpace’ at T2688.hs:5:21
+      ‘v’ is a rigid type variable bound by
+          the class declaration for ‘VectorSpace’ at T2688.hs:5:19
     Relevant bindings include
       s :: s (bound at T2688.hs:8:10)
       v :: v (bound at T2688.hs:8:5)
       (^/) :: v -> s -> v (bound at T2688.hs:8:5)
-    In the second argument of ‛(/)’, namely ‛s’
-    In the second argument of ‛(*^)’, namely ‛(1 / s)’
+    In the second argument of ‘(/)’, namely ‘s’
+    In the second argument of ‘(*^)’, namely ‘(1 / s)’
diff --git a/testsuite/tests/typecheck/should_fail/T2714.stderr b/testsuite/tests/typecheck/should_fail/T2714.stderr
index 4b42c0644015..df648525572c 100644
--- a/testsuite/tests/typecheck/should_fail/T2714.stderr
+++ b/testsuite/tests/typecheck/should_fail/T2714.stderr
@@ -1,7 +1,7 @@
 
 T2714.hs:8:5:
-    Couldn't match type ‛a’ with ‛f0 b’
-      ‛a’ is a rigid type variable bound by
+    Couldn't match type ‘a’ with ‘f0 b’
+      ‘a’ is a rigid type variable bound by
           the type signature for f :: ((a -> b) -> b) -> forall c. c -> a
           at T2714.hs:7:6
     Expected type: ((a -> b) -> b) -> c -> a
@@ -9,11 +9,11 @@ T2714.hs:8:5:
     Relevant bindings include
       f :: ((a -> b) -> b) -> forall c. c -> a (bound at T2714.hs:8:1)
     In the expression: ffmap
-    In an equation for ‛f’: f = ffmap
+    In an equation for ‘f’: f = ffmap
 
 T2714.hs:8:5:
-    Couldn't match type ‛c’ with ‛f0 (a -> b)’
-      ‛c’ is a rigid type variable bound by
+    Couldn't match type ‘c’ with ‘f0 (a -> b)’
+      ‘c’ is a rigid type variable bound by
           the type signature for f :: ((a -> b) -> b) -> c -> a
           at T2714.hs:8:1
     Expected type: ((a -> b) -> b) -> c -> a
@@ -21,4 +21,4 @@ T2714.hs:8:5:
     Relevant bindings include
       f :: ((a -> b) -> b) -> forall c. c -> a (bound at T2714.hs:8:1)
     In the expression: ffmap
-    In an equation for ‛f’: f = ffmap
+    In an equation for ‘f’: f = ffmap
diff --git a/testsuite/tests/typecheck/should_fail/T2806.stderr b/testsuite/tests/typecheck/should_fail/T2806.stderr
index b0130e223a47..25cc8e65a0bc 100644
--- a/testsuite/tests/typecheck/should_fail/T2806.stderr
+++ b/testsuite/tests/typecheck/should_fail/T2806.stderr
@@ -2,7 +2,7 @@
 T2806.hs:12:11:
     Pattern bindings containing unlifted types should use an outermost bang pattern:
       (I# _x) = 4
-    In an equation for ‛foo’:
+    In an equation for ‘foo’:
         foo
           = 3
           where
diff --git a/testsuite/tests/typecheck/should_fail/T2846b.stderr b/testsuite/tests/typecheck/should_fail/T2846b.stderr
index 23b6a6a0e2c4..34d24ae8f689 100644
--- a/testsuite/tests/typecheck/should_fail/T2846b.stderr
+++ b/testsuite/tests/typecheck/should_fail/T2846b.stderr
@@ -1,5 +1,5 @@
 
 T2846b.hs:5:5:
-    No instance for (Show (Num a0 => a0)) arising from a use of ‛show’
+    No instance for (Show (Num a0 => a0)) arising from a use of ‘show’
     In the expression: show ([1, 2, 3] :: [Num a => a])
-    In an equation for ‛f’: f = show ([1, 2, 3] :: [Num a => a])
+    In an equation for ‘f’: f = show ([1, 2, 3] :: [Num a => a])
diff --git a/testsuite/tests/typecheck/should_fail/T2994.stderr b/testsuite/tests/typecheck/should_fail/T2994.stderr
index 2794cb2afc58..83e96b45da95 100644
--- a/testsuite/tests/typecheck/should_fail/T2994.stderr
+++ b/testsuite/tests/typecheck/should_fail/T2994.stderr
@@ -1,16 +1,16 @@
 
 T2994.hs:11:10:
-    Expecting one more argument to ‛MonadReader Int’
+    Expecting one more argument to ‘MonadReader Int’
     Expected a constraint,
-      but ‛MonadReader Int’ has kind ‛* -> Constraint’
-    In the instance declaration for ‛MonadReader Int’
+      but ‘MonadReader Int’ has kind ‘* -> Constraint’
+    In the instance declaration for ‘MonadReader Int’
 
 T2994.hs:13:23:
-    Expecting one more argument to ‛Reader' r’
-    The first argument of ‛MonadReader’ should have kind ‛*’,
-      but ‛Reader' r’ has kind ‛* -> *’
-    In the instance declaration for ‛MonadReader (Reader' r)’
+    Expecting one more argument to ‘Reader' r’
+    The first argument of ‘MonadReader’ should have kind ‘*’,
+      but ‘Reader' r’ has kind ‘* -> *’
+    In the instance declaration for ‘MonadReader (Reader' r)’
 
 T2994.hs:15:10:
-    ‛MonadReader’ is applied to too many type arguments
-    In the instance declaration for ‛MonadReader r r (Reader' r)’
+    ‘MonadReader’ is applied to too many type arguments
+    In the instance declaration for ‘MonadReader r r (Reader' r)’
diff --git a/testsuite/tests/typecheck/should_fail/T3102.stderr b/testsuite/tests/typecheck/should_fail/T3102.stderr
index 1d4348ed124e..d23a2729c183 100644
--- a/testsuite/tests/typecheck/should_fail/T3102.stderr
+++ b/testsuite/tests/typecheck/should_fail/T3102.stderr
@@ -1,9 +1,9 @@
 
 T3102.hs:11:12:
-    Couldn't match type ‛a’ with ‛(?p::Int) => a0’
-      ‛a’ is a rigid type variable bound by
+    Couldn't match type ‘a’ with ‘(?p::Int) => a0’
+      ‘a’ is a rigid type variable bound by
           a type expected by the context: a -> String at T3102.hs:11:10
     Expected type: a -> String
       Actual type: ((?p::Int) => a0) -> String
-    In the first argument of ‛f’, namely ‛t’
+    In the first argument of ‘f’, namely ‘t’
     In the expression: f t
diff --git a/testsuite/tests/typecheck/should_fail/T3176.stderr b/testsuite/tests/typecheck/should_fail/T3176.stderr
index 160eb4769e3f..50e6b52c78a5 100644
--- a/testsuite/tests/typecheck/should_fail/T3176.stderr
+++ b/testsuite/tests/typecheck/should_fail/T3176.stderr
@@ -1,7 +1,7 @@
 
 T3176.hs:9:27:
-    Cannot use record selector ‛unES’ as a function due to escaped type variables
+    Cannot use record selector ‘unES’ as a function due to escaped type variables
     Probable fix: use pattern-matching syntax instead
     In the expression: unES
-    In the second argument of ‛($)’, namely ‛unES $ f t’
+    In the second argument of ‘($)’, namely ‘unES $ f t’
     In the expression: show $ unES $ f t
diff --git a/testsuite/tests/typecheck/should_fail/T3323.stderr b/testsuite/tests/typecheck/should_fail/T3323.stderr
index 029ef7357800..2f8344bb4e97 100644
--- a/testsuite/tests/typecheck/should_fail/T3323.stderr
+++ b/testsuite/tests/typecheck/should_fail/T3323.stderr
@@ -2,4 +2,4 @@
 T3323.hs:18:7:
     Record update for insufficiently polymorphic field: haDevice :: dev
     In the expression: h {haDevice = undefined}
-    In an equation for ‛f’: f h = h {haDevice = undefined}
+    In an equation for ‘f’: f h = h {haDevice = undefined}
diff --git a/testsuite/tests/typecheck/should_fail/T3406.stderr b/testsuite/tests/typecheck/should_fail/T3406.stderr
index 40779d4f2ebb..4525bba5d64e 100644
--- a/testsuite/tests/typecheck/should_fail/T3406.stderr
+++ b/testsuite/tests/typecheck/should_fail/T3406.stderr
@@ -1,10 +1,10 @@
 
 T3406.hs:11:6:
-    The type variables ‛a, b’
-    should be bound by the pattern signature ‛ItemColID a b’
+    The type variables ‘a, b’
+    should be bound by the pattern signature ‘ItemColID a b’
     but are actually discarded by a type synonym
     To fix this, expand the type synonym
     [Note: I hope to lift this restriction in due course]
     In the pattern: x :: ItemColID a b
-    In an equation for ‛get’:
+    In an equation for ‘get’:
         get (x :: ItemColID a b) = x :: ItemColID a b
diff --git a/testsuite/tests/typecheck/should_fail/T3468.stderr b/testsuite/tests/typecheck/should_fail/T3468.stderr
index 010d673e4d24..26ec1920a6cd 100644
--- a/testsuite/tests/typecheck/should_fail/T3468.stderr
+++ b/testsuite/tests/typecheck/should_fail/T3468.stderr
@@ -1,8 +1,8 @@
 
 T3468.hs-boot:3:1:
-    Type constructor ‛Tool’ has conflicting definitions in the module
+    Type constructor ‘Tool’ has conflicting definitions in the module
     and its hs-boot file
     Main module: type role Tool phantom
                  data Tool d where
                    F :: a -> Tool d
-    Boot file:   data Tool
+    Boot file:   abstract Tool
diff --git a/testsuite/tests/typecheck/should_fail/T3540.stderr b/testsuite/tests/typecheck/should_fail/T3540.stderr
index db84dcd62c01..3c447bb1e54a 100644
--- a/testsuite/tests/typecheck/should_fail/T3540.stderr
+++ b/testsuite/tests/typecheck/should_fail/T3540.stderr
@@ -1,20 +1,20 @@
 
 T3540.hs:4:12:
-    Expected a type, but ‛a ~ Int’ has kind ‛Constraint’
-    In the type signature for ‛thing’: thing :: a ~ Int
+    Expected a type, but ‘a ~ Int’ has kind ‘Constraint’
+    In the type signature for ‘thing’: thing :: a ~ Int
 
 T3540.hs:7:20:
-    Expected a type, but ‛a ~ Int’ has kind ‛Constraint’
-    In the type signature for ‛thing1’: thing1 :: Int -> (a ~ Int)
+    Expected a type, but ‘a ~ Int’ has kind ‘Constraint’
+    In the type signature for ‘thing1’: thing1 :: Int -> (a ~ Int)
 
 T3540.hs:10:13:
-    Expected a type, but ‛a ~ Int’ has kind ‛Constraint’
-    In the type signature for ‛thing2’: thing2 :: (a ~ Int) -> Int
+    Expected a type, but ‘a ~ Int’ has kind ‘Constraint’
+    In the type signature for ‘thing2’: thing2 :: (a ~ Int) -> Int
 
 T3540.hs:13:12:
-    Expected a type, but ‛?dude :: Int’ has kind ‛Constraint’
-    In the type signature for ‛thing3’: thing3 :: (?dude :: Int) -> Int
+    Expected a type, but ‘?dude :: Int’ has kind ‘Constraint’
+    In the type signature for ‘thing3’: thing3 :: (?dude :: Int) -> Int
 
 T3540.hs:16:11:
-    Expected a type, but ‛Eq a’ has kind ‛Constraint’
-    In the type signature for ‛thing4’: thing4 :: (Eq a) -> Int
+    Expected a type, but ‘Eq a’ has kind ‘Constraint’
+    In the type signature for ‘thing4’: thing4 :: (Eq a) -> Int
diff --git a/testsuite/tests/typecheck/should_fail/T3592.stderr b/testsuite/tests/typecheck/should_fail/T3592.stderr
index be59667e3407..a7f0f28b1679 100644
--- a/testsuite/tests/typecheck/should_fail/T3592.stderr
+++ b/testsuite/tests/typecheck/should_fail/T3592.stderr
@@ -1,13 +1,13 @@
 
 T3592.hs:8:5:
-    No instance for (Show (T a)) arising from a use of ‛show’
+    No instance for (Show (T a)) arising from a use of ‘show’
     In the expression: show
-    In an equation for ‛f’: f = show
+    In an equation for ‘f’: f = show
 
 T3592.hs:11:7:
-    No instance for (Show a) arising from a use of ‛show’
+    No instance for (Show a) arising from a use of ‘show’
     Possible fix:
       add (Show a) to the context of
         the type signature for g :: T a -> String
     In the expression: show x
-    In an equation for ‛g’: g x = show x
+    In an equation for ‘g’: g x = show x
diff --git a/testsuite/tests/typecheck/should_fail/T3613.stderr b/testsuite/tests/typecheck/should_fail/T3613.stderr
index cbd4889b5734..f230fc469d2b 100644
--- a/testsuite/tests/typecheck/should_fail/T3613.stderr
+++ b/testsuite/tests/typecheck/should_fail/T3613.stderr
@@ -1,16 +1,16 @@
 
 T3613.hs:14:20:
-    Couldn't match type ‛IO’ with ‛Maybe’
+    Couldn't match type ‘IO’ with ‘Maybe’
     Expected type: Maybe ()
       Actual type: IO ()
-    In the first argument of ‛(>>)’, namely ‛bar’
-    In the first argument of ‛fooThen’, namely ‛(bar >> undefined)’
+    In the first argument of ‘(>>)’, namely ‘bar’
+    In the first argument of ‘fooThen’, namely ‘(bar >> undefined)’
 
 T3613.hs:17:24:
-    Couldn't match type ‛IO’ with ‛Maybe’
+    Couldn't match type ‘IO’ with ‘Maybe’
     Expected type: Maybe ()
       Actual type: IO ()
     In a stmt of a 'do' block: bar
-    In the first argument of ‛fooThen’, namely
-      ‛(do { bar;
+    In the first argument of ‘fooThen’, namely
+      ‘(do { bar;
              undefined })’
diff --git a/testsuite/tests/typecheck/should_fail/T3950.stderr b/testsuite/tests/typecheck/should_fail/T3950.stderr
index 56e69e2c43a9..0fc428e18395 100644
--- a/testsuite/tests/typecheck/should_fail/T3950.stderr
+++ b/testsuite/tests/typecheck/should_fail/T3950.stderr
@@ -1,9 +1,9 @@
 
 T3950.hs:15:13:
-    Couldn't match type ‛Id p0 x0’ with ‛Id p’
+    Couldn't match type ‘Id p0 x0’ with ‘Id p’
     Expected type: w (Id p)
       Actual type: Sealed (Id p0 x0)
     Relevant bindings include
       rp :: Bool -> Maybe (w (Id p)) (bound at T3950.hs:15:1)
-    In the first argument of ‛Just’, namely ‛rp'’
+    In the first argument of ‘Just’, namely ‘rp'’
     In the expression: Just rp'
diff --git a/testsuite/tests/typecheck/should_fail/T3966.stderr b/testsuite/tests/typecheck/should_fail/T3966.stderr
index 6e292b088736..7c98948f0e01 100644
--- a/testsuite/tests/typecheck/should_fail/T3966.stderr
+++ b/testsuite/tests/typecheck/should_fail/T3966.stderr
@@ -1,8 +1,8 @@
 
 T3966.hs:5:16: Warning:
-    Ignoring unusable UNPACK pragma on the first argument of ‛Foo’
-    In the definition of data constructor ‛Foo’
-    In the data declaration for ‛Foo’
+    Ignoring unusable UNPACK pragma on the first argument of ‘Foo’
+    In the definition of data constructor ‘Foo’
+    In the data declaration for ‘Foo’
 
 <no location info>: 
 Failing due to -Werror.
diff --git a/testsuite/tests/typecheck/should_fail/T4875.stderr b/testsuite/tests/typecheck/should_fail/T4875.stderr
index ae88bdf9762b..6f885d24feda 100644
--- a/testsuite/tests/typecheck/should_fail/T4875.stderr
+++ b/testsuite/tests/typecheck/should_fail/T4875.stderr
@@ -1,5 +1,5 @@
 
 T4875.hs:27:24:
-    ‛r’ is applied to too many type arguments
-    In the type ‛r c -> [c]’
-    In the class declaration for ‛Morphic’
+    ‘r’ is applied to too many type arguments
+    In the type ‘r c -> [c]’
+    In the class declaration for ‘Morphic’
diff --git a/testsuite/tests/typecheck/should_fail/T5051.hs b/testsuite/tests/typecheck/should_fail/T5051.hs
index 6c5faf917041..e3278d83d347 100644
--- a/testsuite/tests/typecheck/should_fail/T5051.hs
+++ b/testsuite/tests/typecheck/should_fail/T5051.hs
@@ -1,11 +1,11 @@
-{-# LANGUAGE FlexibleInstances, OverlappingInstances #-}
+{-# LANGUAGE FlexibleInstances #-}
 
 -- A very delicate interaction of overlapping instances
 
 module T5051 where
 
 data T = T deriving( Eq, Ord )
-instance Eq [T] 
+instance {-# OVERLAPPING #-} Eq [T] 
 
 foo :: Ord a => [a] -> Bool
 foo x = x >= x
diff --git a/testsuite/tests/typecheck/should_fail/T5051.stderr b/testsuite/tests/typecheck/should_fail/T5051.stderr
index 2dae81062f5e..3fc46f9e98ce 100644
--- a/testsuite/tests/typecheck/should_fail/T5051.stderr
+++ b/testsuite/tests/typecheck/should_fail/T5051.stderr
@@ -1,11 +1,11 @@
 
 T5051.hs:11:11:
-    Overlapping instances for Eq [a] arising from a use of ‛>=’
+    Overlapping instances for Eq [a] arising from a use of ‘>=’
     Matching instances:
-      instance Eq a => Eq [a] -- Defined in ‛GHC.Classes’
-      instance [overlap ok] Eq [T] -- Defined at T5051.hs:8:10
-    (The choice depends on the instantiation of ‛a’
+      instance Eq a => Eq [a] -- Defined in ‘GHC.Classes’
+      instance [overlapping] Eq [T] -- Defined at T5051.hs:8:30
+    (The choice depends on the instantiation of ‘a’
      To pick the first instance above, use IncoherentInstances
      when compiling the other instance declarations)
     In the expression: x >= x
-    In an equation for ‛foo’: foo x = x >= x
+    In an equation for ‘foo’: foo x = x >= x
diff --git a/testsuite/tests/typecheck/should_fail/T5084.stderr b/testsuite/tests/typecheck/should_fail/T5084.stderr
index de9b4b1469a2..c2bd522a0b32 100644
--- a/testsuite/tests/typecheck/should_fail/T5084.stderr
+++ b/testsuite/tests/typecheck/should_fail/T5084.stderr
@@ -1,3 +1,3 @@
 
 T5084.hs:6:5:
-    The INLINE pragma for default method ‛bar’ lacks an accompanying binding
+    The INLINE pragma for default method ‘bar’ lacks an accompanying binding
diff --git a/testsuite/tests/typecheck/should_fail/T5095.hs b/testsuite/tests/typecheck/should_fail/T5095.hs
index 80e080802e6a..7942a87433e8 100644
--- a/testsuite/tests/typecheck/should_fail/T5095.hs
+++ b/testsuite/tests/typecheck/should_fail/T5095.hs
@@ -1,8 +1,8 @@
-{-# LANGUAGE FlexibleInstances, OverlappingInstances, UndecidableInstances #-}
+{-# LANGUAGE FlexibleInstances, UndecidableInstances #-}
 
 module Test where
 
-instance Show a => Eq a where
+instance {-# OVERLAPPABLE #-} Show a => Eq a where
    x == y =  length (show x) == length (show y)
 
 f :: Show a => a -> a -> Bool
diff --git a/testsuite/tests/typecheck/should_fail/T5095.stderr b/testsuite/tests/typecheck/should_fail/T5095.stderr
index 37bfccbf1775..a572c077888c 100644
--- a/testsuite/tests/typecheck/should_fail/T5095.stderr
+++ b/testsuite/tests/typecheck/should_fail/T5095.stderr
@@ -1,66 +1,64 @@
 
 T5095.hs:9:11:
-    Overlapping instances for Eq a arising from a use of ‛==’
+    Overlapping instances for Eq a arising from a use of ‘==’
     Matching instances:
-      instance [overlap ok] Show a => Eq a -- Defined at T5095.hs:5:10
-      instance Eq a => Eq (GHC.Real.Ratio a) -- Defined in ‛GHC.Real’
-      instance Eq () -- Defined in ‛GHC.Classes’
-      instance (Eq a, Eq b) => Eq (a, b) -- Defined in ‛GHC.Classes’
+      instance [overlappable] Show a => Eq a -- Defined at T5095.hs:5:31
+      instance Eq a => Eq (GHC.Real.Ratio a) -- Defined in ‘GHC.Real’
+      instance Eq () -- Defined in ‘GHC.Classes’
+      instance (Eq a, Eq b) => Eq (a, b) -- Defined in ‘GHC.Classes’
       instance (Eq a, Eq b, Eq c) => Eq (a, b, c)
-        -- Defined in ‛GHC.Classes’
+        -- Defined in ‘GHC.Classes’
       instance (Eq a, Eq b, Eq c, Eq d) => Eq (a, b, c, d)
-        -- Defined in ‛GHC.Classes’
+        -- Defined in ‘GHC.Classes’
       instance (Eq a, Eq b, Eq c, Eq d, Eq e) => Eq (a, b, c, d, e)
-        -- Defined in ‛GHC.Classes’
+        -- Defined in ‘GHC.Classes’
       instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f) =>
                Eq (a, b, c, d, e, f)
-        -- Defined in ‛GHC.Classes’
+        -- Defined in ‘GHC.Classes’
       instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g) =>
                Eq (a, b, c, d, e, f, g)
-        -- Defined in ‛GHC.Classes’
+        -- Defined in ‘GHC.Classes’
       instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g, Eq h) =>
                Eq (a, b, c, d, e, f, g, h)
-        -- Defined in ‛GHC.Classes’
+        -- Defined in ‘GHC.Classes’
       instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g, Eq h, Eq i) =>
                Eq (a, b, c, d, e, f, g, h, i)
-        -- Defined in ‛GHC.Classes’
+        -- Defined in ‘GHC.Classes’
       instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g, Eq h, Eq i,
                 Eq j) =>
                Eq (a, b, c, d, e, f, g, h, i, j)
-        -- Defined in ‛GHC.Classes’
+        -- Defined in ‘GHC.Classes’
       instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g, Eq h, Eq i,
                 Eq j, Eq k) =>
                Eq (a, b, c, d, e, f, g, h, i, j, k)
-        -- Defined in ‛GHC.Classes’
+        -- Defined in ‘GHC.Classes’
       instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g, Eq h, Eq i,
                 Eq j, Eq k, Eq l) =>
                Eq (a, b, c, d, e, f, g, h, i, j, k, l)
-        -- Defined in ‛GHC.Classes’
+        -- Defined in ‘GHC.Classes’
       instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g, Eq h, Eq i,
                 Eq j, Eq k, Eq l, Eq m) =>
                Eq (a, b, c, d, e, f, g, h, i, j, k, l, m)
-        -- Defined in ‛GHC.Classes’
+        -- Defined in ‘GHC.Classes’
       instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g, Eq h, Eq i,
                 Eq j, Eq k, Eq l, Eq m, Eq n) =>
                Eq (a, b, c, d, e, f, g, h, i, j, k, l, m, n)
-        -- Defined in ‛GHC.Classes’
+        -- Defined in ‘GHC.Classes’
       instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g, Eq h, Eq i,
                 Eq j, Eq k, Eq l, Eq m, Eq n, Eq o) =>
                Eq (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o)
-        -- Defined in ‛GHC.Classes’
-      instance Eq Bool -- Defined in ‛GHC.Classes’
-      instance Eq Char -- Defined in ‛GHC.Classes’
-      instance Eq Double -- Defined in ‛GHC.Classes’
-      instance Eq Float -- Defined in ‛GHC.Classes’
-      instance Eq Int -- Defined in ‛GHC.Classes’
-      instance Eq Ordering -- Defined in ‛GHC.Classes’
-      instance Eq GHC.Types.Word -- Defined in ‛GHC.Classes’
-      instance Eq a => Eq [a] -- Defined in ‛GHC.Classes’
-      instance Eq a => Eq (Control.Applicative.ZipList a)
-        -- Defined in ‛Control.Applicative’
-      instance Eq Integer -- Defined in ‛integer-gmp:GHC.Integer.Type’
-    (The choice depends on the instantiation of ‛a’
+        -- Defined in ‘GHC.Classes’
+      instance Eq Bool -- Defined in ‘GHC.Classes’
+      instance Eq Char -- Defined in ‘GHC.Classes’
+      instance Eq Double -- Defined in ‘GHC.Classes’
+      instance Eq Float -- Defined in ‘GHC.Classes’
+      instance Eq Int -- Defined in ‘GHC.Classes’
+      instance Eq Ordering -- Defined in ‘GHC.Classes’
+      instance Eq GHC.Types.Word -- Defined in ‘GHC.Classes’
+      instance Eq a => Eq [a] -- Defined in ‘GHC.Classes’
+      instance Eq Integer -- Defined in ‘integer-gmp:GHC.Integer.Type’
+    (The choice depends on the instantiation of ‘a’
      To pick the first instance above, use IncoherentInstances
      when compiling the other instance declarations)
     In the expression: x == y
-    In an equation for ‛f’: f x y = x == y
+    In an equation for ‘f’: f x y = x == y
diff --git a/testsuite/tests/typecheck/should_fail/T5236.stderr b/testsuite/tests/typecheck/should_fail/T5236.stderr
index f448534b67a4..557a0413c978 100644
--- a/testsuite/tests/typecheck/should_fail/T5236.stderr
+++ b/testsuite/tests/typecheck/should_fail/T5236.stderr
@@ -1,5 +1,5 @@
 
 T5236.hs:17:5:
-    No instance for (Id A B) arising from a use of ‛loop’
+    No instance for (Id A B) arising from a use of ‘loop’
     In the expression: loop
-    In an equation for ‛f’: f = loop
+    In an equation for ‘f’: f = loop
diff --git a/testsuite/tests/typecheck/should_fail/T5246.stderr b/testsuite/tests/typecheck/should_fail/T5246.stderr
index fc8e35ef51f4..bd075cbb435e 100644
--- a/testsuite/tests/typecheck/should_fail/T5246.stderr
+++ b/testsuite/tests/typecheck/should_fail/T5246.stderr
@@ -1,9 +1,9 @@
 
 T5246.hs:11:10:
-    Could not deduce (?x::Int) arising from a use of ‛foo’
+    Could not deduce (?x::Int) arising from a use of ‘foo’
     from the context (?x::[Char])
       bound by the implicit-parameter bindings for ?x
       at T5246.hs:(10,7)-(11,12)
     In the expression: foo
     In the expression: let ?x = "hello" in foo
-    In an equation for ‛bar’: bar = let ?x = "hello" in foo
+    In an equation for ‘bar’: bar = let ?x = "hello" in foo
diff --git a/testsuite/tests/typecheck/should_fail/T5300.stderr b/testsuite/tests/typecheck/should_fail/T5300.stderr
index d32af5b18e3c..c94f11531ff2 100644
--- a/testsuite/tests/typecheck/should_fail/T5300.stderr
+++ b/testsuite/tests/typecheck/should_fail/T5300.stderr
@@ -1,34 +1,34 @@
 
 T5300.hs:11:7:
     Could not deduce (C1 a b c0)
-      arising from the ambiguity check for ‛f1’
+      arising from the ambiguity check for ‘f1’
     from the context (Monad m, C1 a b c)
       bound by the type signature for
                  f1 :: (Monad m, C1 a b c) => a -> StateT (T b) m a
       at T5300.hs:11:7-50
-    The type variable ‛c0’ is ambiguous
+    The type variable ‘c0’ is ambiguous
     In the ambiguity check for:
       forall a b (m :: * -> *) c.
       (Monad m, C1 a b c) =>
       a -> StateT (T b) m a
     To defer the ambiguity check to use sites, enable AllowAmbiguousTypes
-    In the type signature for ‛f1’:
+    In the type signature for ‘f1’:
       f1 :: (Monad m, C1 a b c) => a -> StateT (T b) m a
 
 T5300.hs:14:7:
     Could not deduce (C1 a1 b1 c10)
-      arising from the ambiguity check for ‛f2’
+      arising from the ambiguity check for ‘f2’
     from the context (Monad m, C1 a1 b1 c1, C2 a2 b2 c2)
       bound by the type signature for
                  f2 :: (Monad m, C1 a1 b1 c1, C2 a2 b2 c2) =>
                        a1 -> StateT (T b2) m a2
       at T5300.hs:14:7-69
-    The type variable ‛c10’ is ambiguous
+    The type variable ‘c10’ is ambiguous
     In the ambiguity check for:
       forall a1 b2 (m :: * -> *) a2 b1 c1 c2.
       (Monad m, C1 a1 b1 c1, C2 a2 b2 c2) =>
       a1 -> StateT (T b2) m a2
     To defer the ambiguity check to use sites, enable AllowAmbiguousTypes
-    In the type signature for ‛f2’:
+    In the type signature for ‘f2’:
       f2 :: (Monad m, C1 a1 b1 c1, C2 a2 b2 c2) =>
             a1 -> StateT (T b2) m a2
diff --git a/testsuite/tests/typecheck/should_fail/T5570.stderr b/testsuite/tests/typecheck/should_fail/T5570.stderr
index 7bf75358154b..626533cdaa06 100644
--- a/testsuite/tests/typecheck/should_fail/T5570.stderr
+++ b/testsuite/tests/typecheck/should_fail/T5570.stderr
@@ -3,6 +3,6 @@ T5570.hs:7:16:
     Kind incompatibility when matching types:
       s0 :: *
       Double# :: #
-    In the second argument of ‛($)’, namely ‛D# $ 3.0##’
+    In the second argument of ‘($)’, namely ‘D# $ 3.0##’
     In the expression: print $ D# $ 3.0##
-    In an equation for ‛main’: main = print $ D# $ 3.0##
+    In an equation for ‘main’: main = print $ D# $ 3.0##
diff --git a/testsuite/tests/typecheck/should_fail/T5684.stderr b/testsuite/tests/typecheck/should_fail/T5684.stderr
index f3534f506d49..56b0800351f0 100644
--- a/testsuite/tests/typecheck/should_fail/T5684.stderr
+++ b/testsuite/tests/typecheck/should_fail/T5684.stderr
@@ -1,64 +1,64 @@
 
 T5684.hs:25:12:
-    No instance for (A b6) arising from a use of ‛op’
+    No instance for (A b6) arising from a use of ‘op’
     In the expression: op True undefined
     In the expression:
       [op False False, op 'c' undefined, op True undefined]
-    In an equation for ‛flop1’:
+    In an equation for ‘flop1’:
         flop1 = [op False False, op 'c' undefined, op True undefined]
 
 T5684.hs:30:12:
-    No instance for (A b5) arising from a use of ‛op’
+    No instance for (A b5) arising from a use of ‘op’
     In the expression: op True undefined
     In the expression:
       [op False False, op True undefined, op 'c' undefined]
-    In an equation for ‛flop2’:
+    In an equation for ‘flop2’:
         flop2 = [op False False, op True undefined, op 'c' undefined]
 
 T5684.hs:36:12:
-    No instance for (A b4) arising from a use of ‛op’
+    No instance for (A b4) arising from a use of ‘op’
     In the expression: op True undefined
     In the expression:
       [op 'c' undefined, op True undefined, op False False]
-    In an equation for ‛flop3’:
+    In an equation for ‘flop3’:
         flop3 = [op 'c' undefined, op True undefined, op False False]
 
 T5684.hs:42:12:
-    No instance for (A b3) arising from a use of ‛op’
+    No instance for (A b3) arising from a use of ‘op’
     In the expression: op True undefined
     In the expression:
       [op 'c' undefined, op False False, op True undefined]
-    In an equation for ‛flop4’:
+    In an equation for ‘flop4’:
         flop4 = [op 'c' undefined, op False False, op True undefined]
 
 T5684.hs:46:12:
-    No instance for (A b2) arising from a use of ‛op’
+    No instance for (A b2) arising from a use of ‘op’
     In the expression: op True undefined
     In the expression:
       [op True undefined, op 'c' undefined, op False False]
-    In an equation for ‛flop5’:
+    In an equation for ‘flop5’:
         flop5 = [op True undefined, op 'c' undefined, op False False]
 
 T5684.hs:52:12:
-    No instance for (A b0) arising from a use of ‛op’
+    No instance for (A b0) arising from a use of ‘op’
     In the expression: op True undefined
     In the expression:
       [op True undefined, op False False, op 'c' undefined]
-    In an equation for ‛flop6’:
+    In an equation for ‘flop6’:
         flop6 = [op True undefined, op False False, op 'c' undefined]
 
 T5684.hs:53:12:
-    No instance for (A Bool) arising from a use of ‛op’
+    No instance for (A Bool) arising from a use of ‘op’
     In the expression: op False False
     In the expression:
       [op True undefined, op False False, op 'c' undefined]
-    In an equation for ‛flop6’:
+    In an equation for ‘flop6’:
         flop6 = [op True undefined, op False False, op 'c' undefined]
 
 T5684.hs:54:12:
-    No instance for (B Char b1) arising from a use of ‛op’
+    No instance for (B Char b1) arising from a use of ‘op’
     In the expression: op 'c' undefined
     In the expression:
       [op True undefined, op False False, op 'c' undefined]
-    In an equation for ‛flop6’:
+    In an equation for ‘flop6’:
         flop6 = [op True undefined, op False False, op 'c' undefined]
diff --git a/testsuite/tests/typecheck/should_fail/T5689.stderr b/testsuite/tests/typecheck/should_fail/T5689.stderr
index 33d7fc9d6d4e..211ec522a1b6 100644
--- a/testsuite/tests/typecheck/should_fail/T5689.stderr
+++ b/testsuite/tests/typecheck/should_fail/T5689.stderr
@@ -1,6 +1,6 @@
 
 T5689.hs:10:36:
-    Couldn't match expected type ‛Bool’ with actual type ‛t’
+    Couldn't match expected type ‘Bool’ with actual type ‘t’
     Relevant bindings include
       v :: t (bound at T5689.hs:10:28)
       r :: IORef (t -> t) (bound at T5689.hs:7:14)
@@ -8,7 +8,7 @@ T5689.hs:10:36:
     In the expression: if v then False else True
 
 T5689.hs:10:43:
-    Couldn't match expected type ‛t’ with actual type ‛Bool’
+    Couldn't match expected type ‘t’ with actual type ‘Bool’
     Relevant bindings include
       v :: t (bound at T5689.hs:10:28)
       r :: IORef (t -> t) (bound at T5689.hs:7:14)
@@ -16,7 +16,7 @@ T5689.hs:10:43:
     In the expression: if v then False else True
 
 T5689.hs:10:54:
-    Couldn't match expected type ‛t’ with actual type ‛Bool’
+    Couldn't match expected type ‘t’ with actual type ‘Bool’
     Relevant bindings include
       v :: t (bound at T5689.hs:10:28)
       r :: IORef (t -> t) (bound at T5689.hs:7:14)
@@ -24,9 +24,9 @@ T5689.hs:10:54:
     In the expression: if v then False else True
 
 T5689.hs:14:23:
-    Couldn't match expected type ‛t’ with actual type ‛Bool’
+    Couldn't match expected type ‘t’ with actual type ‘Bool’
     Relevant bindings include
       c :: t -> t (bound at T5689.hs:12:13)
       r :: IORef (t -> t) (bound at T5689.hs:7:14)
-    In the first argument of ‛c’, namely ‛True’
-    In the second argument of ‛($)’, namely ‛c True’
+    In the first argument of ‘c’, namely ‘True’
+    In the second argument of ‘($)’, namely ‘c True’
diff --git a/testsuite/tests/typecheck/should_fail/T5691.stderr b/testsuite/tests/typecheck/should_fail/T5691.stderr
index 497ec7794a7b..674ffc76d7fc 100644
--- a/testsuite/tests/typecheck/should_fail/T5691.stderr
+++ b/testsuite/tests/typecheck/should_fail/T5691.stderr
@@ -1,16 +1,16 @@
 
 T5691.hs:14:9:
-    Couldn't match type ‛p’ with ‛PrintRuleInterp’
+    Couldn't match type ‘p’ with ‘PrintRuleInterp’
     Expected type: PrintRuleInterp a
       Actual type: p a
     In the pattern: f :: p a
-    In an equation for ‛test’: test (f :: p a) = MkPRI $ printRule_ f
-    In the instance declaration for ‛Test PrintRuleInterp’
+    In an equation for ‘test’: test (f :: p a) = MkPRI $ printRule_ f
+    In the instance declaration for ‘Test PrintRuleInterp’
 
 T5691.hs:15:24:
-    Couldn't match type ‛p’ with ‛PrintRuleInterp’
+    Couldn't match type ‘p’ with ‘PrintRuleInterp’
     Expected type: PrintRuleInterp a
       Actual type: p a
     Relevant bindings include f :: p a (bound at T5691.hs:14:9)
-    In the first argument of ‛printRule_’, namely ‛f’
-    In the second argument of ‛($)’, namely ‛printRule_ f’
+    In the first argument of ‘printRule_’, namely ‘f’
+    In the second argument of ‘($)’, namely ‘printRule_ f’
diff --git a/testsuite/tests/typecheck/should_fail/T5853.stderr b/testsuite/tests/typecheck/should_fail/T5853.stderr
index 770b7bb621cd..997ce196c342 100644
--- a/testsuite/tests/typecheck/should_fail/T5853.stderr
+++ b/testsuite/tests/typecheck/should_fail/T5853.stderr
@@ -8,7 +8,7 @@ T5853.hs:15:52:
                       Elem (Subst fa a) ~ a,
                       Subst (Subst fa a) (Elem fa) ~ fa)
       bound by the RULE "map/map" at T5853.hs:15:2-57
-    NB: ‛Subst’ is a type function, and may not be injective
+    NB: ‘Subst’ is a type function, and may not be injective
     Relevant bindings include
       f :: Elem fa -> b (bound at T5853.hs:15:19)
       g :: a -> Elem fa (bound at T5853.hs:15:21)
diff --git a/testsuite/tests/typecheck/should_fail/T5858.stderr b/testsuite/tests/typecheck/should_fail/T5858.stderr
index 893fd1a62b7e..9cd1deee697f 100644
--- a/testsuite/tests/typecheck/should_fail/T5858.stderr
+++ b/testsuite/tests/typecheck/should_fail/T5858.stderr
@@ -1,10 +1,10 @@
 
 T5858.hs:11:7:
     No instance for (InferOverloaded ([t0], [t1]))
-      arising from a use of ‛infer’
-    The type variables ‛t0’, ‛t1’ are ambiguous
+      arising from a use of ‘infer’
+    The type variables ‘t0’, ‘t1’ are ambiguous
     Note: there is a potential instance available:
       instance t1 ~ String => InferOverloaded (t1, t1)
         -- Defined at T5858.hs:8:10
     In the expression: infer ([], [])
-    In an equation for ‛foo’: foo = infer ([], [])
+    In an equation for ‘foo’: foo = infer ([], [])
diff --git a/testsuite/tests/typecheck/should_fail/T5957.stderr b/testsuite/tests/typecheck/should_fail/T5957.stderr
index 3b4f5e80d50b..1c457ad6fb96 100644
--- a/testsuite/tests/typecheck/should_fail/T5957.stderr
+++ b/testsuite/tests/typecheck/should_fail/T5957.stderr
@@ -2,5 +2,5 @@
 T5957.hs:3:9:
     Illegal polymorphic or qualified type: Show a => a -> String
     Perhaps you intended to use RankNTypes or Rank2Types
-    In the type signature for ‛flex’:
+    In the type signature for ‘flex’:
       flex :: Int -> Show a => a -> String
diff --git a/testsuite/tests/typecheck/should_fail/T5978.stderr b/testsuite/tests/typecheck/should_fail/T5978.stderr
index 0deac96834d0..db6b8f355efa 100644
--- a/testsuite/tests/typecheck/should_fail/T5978.stderr
+++ b/testsuite/tests/typecheck/should_fail/T5978.stderr
@@ -1,5 +1,5 @@
 
 T5978.hs:22:11:
-    No instance for (C Double Char) arising from a use of ‛polyBar’
+    No instance for (C Double Char) arising from a use of ‘polyBar’
     In the expression: polyBar id monoFoo
-    In an equation for ‛monoBar’: monoBar = polyBar id monoFoo
+    In an equation for ‘monoBar’: monoBar = polyBar id monoFoo
diff --git a/testsuite/tests/typecheck/should_fail/T6001.stderr b/testsuite/tests/typecheck/should_fail/T6001.stderr
index b1ef88d9fbfa..593b43f6d8c3 100644
--- a/testsuite/tests/typecheck/should_fail/T6001.stderr
+++ b/testsuite/tests/typecheck/should_fail/T6001.stderr
@@ -2,4 +2,4 @@
 T6001.hs:8:18:
     Method signature does not match class; it should be
       fromInteger :: Integer -> DayKind
-    In the instance declaration for ‛Num DayKind’
+    In the instance declaration for ‘Num DayKind’
diff --git a/testsuite/tests/typecheck/should_fail/T6069.stderr b/testsuite/tests/typecheck/should_fail/T6069.stderr
index 4f82c0d89624..81b1552cba2a 100644
--- a/testsuite/tests/typecheck/should_fail/T6069.stderr
+++ b/testsuite/tests/typecheck/should_fail/T6069.stderr
@@ -1,21 +1,21 @@
 
 T6069.hs:13:15:
-    Couldn't match type ‛ST s0 Int’ with ‛forall s. ST s b0’
+    Couldn't match type ‘ST s0 Int’ with ‘forall s. ST s b0’
     Expected type: ST s0 Int -> b0
       Actual type: (forall s. ST s b0) -> b0
-    In the second argument of ‛(.)’, namely ‛runST’
+    In the second argument of ‘(.)’, namely ‘runST’
     In the expression: print . runST
 
 T6069.hs:14:15:
-    Couldn't match type ‛ST s1 Int’ with ‛forall s. ST s b1’
+    Couldn't match type ‘ST s1 Int’ with ‘forall s. ST s b1’
     Expected type: ST s1 Int -> b1
       Actual type: (forall s. ST s b1) -> b1
-    In the second argument of ‛(.)’, namely ‛runST’
+    In the second argument of ‘(.)’, namely ‘runST’
     In the expression: (print . runST)
 
 T6069.hs:15:16:
-    Couldn't match type ‛ST s2 Int’ with ‛forall s. ST s b2’
+    Couldn't match type ‘ST s2 Int’ with ‘forall s. ST s b2’
     Expected type: ST s2 Int -> b2
       Actual type: (forall s. ST s b2) -> b2
-    In the second argument of ‛(.)’, namely ‛runST’
-    In the first argument of ‛($)’, namely ‛(print . runST)’
+    In the second argument of ‘(.)’, namely ‘runST’
+    In the first argument of ‘($)’, namely ‘(print . runST)’
diff --git a/testsuite/tests/typecheck/should_fail/T6078.stderr b/testsuite/tests/typecheck/should_fail/T6078.stderr
index 32e3e056d3ae..467dede23fca 100644
--- a/testsuite/tests/typecheck/should_fail/T6078.stderr
+++ b/testsuite/tests/typecheck/should_fail/T6078.stderr
@@ -7,5 +7,5 @@ T6078.hs:8:10:
       let ip1p@(Ptr ip1) = Ptr ip0 `plusPtr` len in ip1p
     In the expression:
       \ fpbuf ip0 ipe s0 -> let ip1p@(Ptr ip1) = ... in ip1p
-    In an equation for ‛byteStringSlice’:
+    In an equation for ‘byteStringSlice’:
         byteStringSlice len = \ fpbuf ip0 ipe s0 -> let ... in ip1p
diff --git a/testsuite/tests/typecheck/should_fail/T6161.stderr b/testsuite/tests/typecheck/should_fail/T6161.stderr
index afc3a946f86f..0d10738509cf 100644
--- a/testsuite/tests/typecheck/should_fail/T6161.stderr
+++ b/testsuite/tests/typecheck/should_fail/T6161.stderr
@@ -1,5 +1,5 @@
 
 T6161.hs:29:12:
-    No instance for (Super (Fam Float)) arising from a use of ‛testDup’
+    No instance for (Super (Fam Float)) arising from a use of ‘testDup’
     In the expression: testDup (FamFloat 3.0)
-    In an equation for ‛testProg’: testProg = testDup (FamFloat 3.0)
+    In an equation for ‘testProg’: testProg = testDup (FamFloat 3.0)
diff --git a/testsuite/tests/typecheck/should_fail/T7019.stderr b/testsuite/tests/typecheck/should_fail/T7019.stderr
index 935c3be522f1..6e47926037eb 100644
--- a/testsuite/tests/typecheck/should_fail/T7019.stderr
+++ b/testsuite/tests/typecheck/should_fail/T7019.stderr
@@ -1,6 +1,5 @@
 
-T7019.hs:14:10:
-    Malformed predicate ‛C c’
-    In the context: (C c)
-    While checking an instance declaration
-    In the instance declaration for ‛Monad (Free c)’
+T7019.hs:11:12:
+    Illegal constraint: forall a. c (Free c a)
+    In the type ‘forall a. c (Free c a)’
+    In the type declaration for ‘C’
diff --git a/testsuite/tests/typecheck/should_fail/T7019a.stderr b/testsuite/tests/typecheck/should_fail/T7019a.stderr
index cd474af8a63d..f88893153f65 100644
--- a/testsuite/tests/typecheck/should_fail/T7019a.stderr
+++ b/testsuite/tests/typecheck/should_fail/T7019a.stderr
@@ -1,6 +1,4 @@
 
-T7019a.hs:11:1:
-    Malformed predicate ‛forall b. Context (Associated a b)’
-    In the context: (forall b. Context (Associated a b))
-    While checking the super-classes of class ‛Class’
-    In the class declaration for ‛Class’
+T7019a.hs:11:8:
+    Illegal constraint: forall b. Context (Associated a b)
+    In the class declaration for ‘Class’
diff --git a/testsuite/tests/typecheck/should_fail/T7175.stderr b/testsuite/tests/typecheck/should_fail/T7175.stderr
index e65918c22b94..e6a5b1e5a3ab 100644
--- a/testsuite/tests/typecheck/should_fail/T7175.stderr
+++ b/testsuite/tests/typecheck/should_fail/T7175.stderr
@@ -1,6 +1,6 @@
 
 T7175.hs:8:4:
-    Data constructor ‛G1C’ returns type ‛F Int’
-      instead of an instance of its parent type ‛G1 a’
-    In the definition of data constructor ‛G1C’
-    In the data declaration for ‛G1’
+    Data constructor ‘G1C’ returns type ‘F Int’
+      instead of an instance of its parent type ‘G1 a’
+    In the definition of data constructor ‘G1C’
+    In the data declaration for ‘G1’
diff --git a/testsuite/tests/typecheck/should_fail/T7210.stderr b/testsuite/tests/typecheck/should_fail/T7210.stderr
index 148f9bcd5e8a..a7ee2afc8515 100644
--- a/testsuite/tests/typecheck/should_fail/T7210.stderr
+++ b/testsuite/tests/typecheck/should_fail/T7210.stderr
@@ -1,6 +1,6 @@
 
 T7210.hs:5:19:
     Unexpected strictness annotation: !IntMap
-    In the type ‛!IntMap Int’
-    In the definition of data constructor ‛C’
-    In the data declaration for ‛T’
+    In the type ‘!IntMap Int’
+    In the definition of data constructor ‘C’
+    In the data declaration for ‘T’
diff --git a/testsuite/tests/typecheck/should_fail/T7220.stderr b/testsuite/tests/typecheck/should_fail/T7220.stderr
index 5dba6b5c28c9..86c4c5f1cb46 100644
--- a/testsuite/tests/typecheck/should_fail/T7220.stderr
+++ b/testsuite/tests/typecheck/should_fail/T7220.stderr
@@ -1,9 +1,9 @@
 
 T7220.hs:24:6:
-    Cannot instantiate unification variable ‛b0’
+    Cannot instantiate unification variable ‘b0’
     with a type involving foralls: forall b. (C A b, TF b ~ Y) => b
       Perhaps you want ImpredicativeTypes
     In the expression: f :: (forall b. (C A b, TF b ~ Y) => b) -> X
     In the expression: (f :: (forall b. (C A b, TF b ~ Y) => b) -> X) u
-    In an equation for ‛v’:
+    In an equation for ‘v’:
         v = (f :: (forall b. (C A b, TF b ~ Y) => b) -> X) u
diff --git a/testsuite/tests/typecheck/should_fail/T7264.stderr b/testsuite/tests/typecheck/should_fail/T7264.stderr
index 6314b56f97ef..b2696d41bbd8 100644
--- a/testsuite/tests/typecheck/should_fail/T7264.stderr
+++ b/testsuite/tests/typecheck/should_fail/T7264.stderr
@@ -1,12 +1,12 @@
 
 T7264.hs:13:19:
-    Couldn't match type ‛a’ with ‛forall r. r -> String’
-      ‛a’ is a rigid type variable bound by
+    Couldn't match type ‘a’ with ‘forall r. r -> String’
+      ‘a’ is a rigid type variable bound by
           the inferred type of mkFoo2 :: a -> Maybe Foo at T7264.hs:13:1
     Expected type: a -> Foo
       Actual type: (forall r. r -> String) -> Foo
     Relevant bindings include
       val :: a (bound at T7264.hs:13:8)
       mkFoo2 :: a -> Maybe Foo (bound at T7264.hs:13:1)
-    In the first argument of ‛mmap’, namely ‛Foo’
+    In the first argument of ‘mmap’, namely ‘Foo’
     In the expression: mmap Foo (Just val)
diff --git a/testsuite/tests/typecheck/should_fail/T7279.stderr b/testsuite/tests/typecheck/should_fail/T7279.stderr
index d768d90c23f6..df0328ccdd94 100644
--- a/testsuite/tests/typecheck/should_fail/T7279.stderr
+++ b/testsuite/tests/typecheck/should_fail/T7279.stderr
@@ -5,7 +5,7 @@ T7279.hs:6:10:
     from the context (Eq a, Show b)
       bound by an instance declaration: (Eq a, Show b) => Eq (T a)
       at T7279.hs:6:10-35
-    The type variable ‛b0’ is ambiguous
+    The type variable ‘b0’ is ambiguous
     In the ambiguity check for: forall a b. (Eq a, Show b) => Eq (T a)
     To defer the ambiguity check to use sites, enable AllowAmbiguousTypes
-    In the instance declaration for ‛Eq (T a)’
+    In the instance declaration for ‘Eq (T a)’
diff --git a/testsuite/tests/typecheck/should_fail/T7368.stderr b/testsuite/tests/typecheck/should_fail/T7368.stderr
index b4e10423463c..c2e636001882 100644
--- a/testsuite/tests/typecheck/should_fail/T7368.stderr
+++ b/testsuite/tests/typecheck/should_fail/T7368.stderr
@@ -5,5 +5,5 @@ T7368.hs:3:10:
       (->) a0 :: * -> *
     Expected type: a0 -> b0
       Actual type: c0 Maybe
-    In the first argument of ‛b’, namely ‛(l Nothing)’
+    In the first argument of ‘b’, namely ‘(l Nothing)’
     In the expression: b (l Nothing)
diff --git a/testsuite/tests/typecheck/should_fail/T7368a.stderr b/testsuite/tests/typecheck/should_fail/T7368a.stderr
index 94d3688d3253..1316d5a8d4d2 100644
--- a/testsuite/tests/typecheck/should_fail/T7368a.stderr
+++ b/testsuite/tests/typecheck/should_fail/T7368a.stderr
@@ -1,11 +1,11 @@
 
 T7368a.hs:8:6:
-    Couldn't match type ‛f’ with ‛Bad’
-      ‛f’ is a rigid type variable bound by
+    Couldn't match type ‘f’ with ‘Bad’
+      ‘f’ is a rigid type variable bound by
           the type signature for fun :: f (Bad f) -> Bool at T7368a.hs:7:15
     Expected type: f (Bad f)
       Actual type: Bad t0
     Relevant bindings include
       fun :: f (Bad f) -> Bool (bound at T7368a.hs:8:1)
     In the pattern: Bad x
-    In an equation for ‛fun’: fun (Bad x) = True
+    In an equation for ‘fun’: fun (Bad x) = True
diff --git a/testsuite/tests/typecheck/should_fail/T7410.stderr b/testsuite/tests/typecheck/should_fail/T7410.stderr
index 877377e1b05c..812636263390 100644
--- a/testsuite/tests/typecheck/should_fail/T7410.stderr
+++ b/testsuite/tests/typecheck/should_fail/T7410.stderr
@@ -1,6 +1,6 @@
 
 T7410.hs:3:9:
-    Expecting one more argument to ‛Either Int’
-    The first argument of a tuple should have kind ‛*’,
-      but ‛Either Int’ has kind ‛* -> *’
-    In the type signature for ‛foo’: foo :: (Either Int, Int)
+    Expecting one more argument to ‘Either Int’
+    The first argument of a tuple should have kind ‘*’,
+      but ‘Either Int’ has kind ‘* -> *’
+    In the type signature for ‘foo’: foo :: (Either Int, Int)
diff --git a/testsuite/tests/typecheck/should_fail/T7453.stderr b/testsuite/tests/typecheck/should_fail/T7453.stderr
index 573d2ff7e1ed..c47446015551 100644
--- a/testsuite/tests/typecheck/should_fail/T7453.stderr
+++ b/testsuite/tests/typecheck/should_fail/T7453.stderr
@@ -1,7 +1,7 @@
 
 T7453.hs:10:30:
-    Couldn't match expected type ‛t1’ with actual type ‛t’
-      because type variable ‛t1’ would escape its scope
+    Couldn't match expected type ‘t1’ with actual type ‘t’
+      because type variable ‘t1’ would escape its scope
     This (rigid, skolem) type variable is bound by
       the type signature for z :: Id t1
       at T7453.hs:8:16-19
@@ -10,12 +10,12 @@ T7453.hs:10:30:
       z :: Id t1 (bound at T7453.hs:9:11)
       v :: t (bound at T7453.hs:7:7)
       cast1 :: t -> a (bound at T7453.hs:7:1)
-    In the first argument of ‛Id’, namely ‛v’
+    In the first argument of ‘Id’, namely ‘v’
     In the expression: Id v
 
 T7453.hs:16:33:
-    Couldn't match expected type ‛t2’ with actual type ‛t’
-      because type variable ‛t2’ would escape its scope
+    Couldn't match expected type ‘t2’ with actual type ‘t’
+      because type variable ‘t2’ would escape its scope
     This (rigid, skolem) type variable is bound by
       the type signature for z :: () -> t2
       at T7453.hs:14:16-22
@@ -24,12 +24,12 @@ T7453.hs:16:33:
       z :: () -> t2 (bound at T7453.hs:15:11)
       v :: t (bound at T7453.hs:13:7)
       cast2 :: t -> t1 (bound at T7453.hs:13:1)
-    In the first argument of ‛const’, namely ‛v’
+    In the first argument of ‘const’, namely ‘v’
     In the expression: const v
 
 T7453.hs:21:15:
-    Couldn't match expected type ‛t1’ with actual type ‛a’
-      because type variable ‛t1’ would escape its scope
+    Couldn't match expected type ‘t1’ with actual type ‘a’
+      because type variable ‘t1’ would escape its scope
     This (rigid, skolem) type variable is bound by
       the type signature for z :: t1
       at T7453.hs:20:16
@@ -39,7 +39,7 @@ T7453.hs:21:15:
       v :: a (bound at T7453.hs:19:7)
       cast3 :: a -> t (bound at T7453.hs:19:1)
     In the expression: v
-    In an equation for ‛z’:
+    In an equation for ‘z’:
         z = v
           where
               aux = const v
diff --git a/testsuite/tests/typecheck/should_fail/T7525.stderr b/testsuite/tests/typecheck/should_fail/T7525.stderr
index 1e2c0eb235bd..9524d1a3e2da 100644
--- a/testsuite/tests/typecheck/should_fail/T7525.stderr
+++ b/testsuite/tests/typecheck/should_fail/T7525.stderr
@@ -1,9 +1,9 @@
 
 T7525.hs:5:30:
     Could not deduce (?b::Bool)
-      arising from a use of implicit parameter ‛?b’
+      arising from a use of implicit parameter ‘?b’
     from the context (?a::Bool)
       bound by the implicit-parameter bindings for ?a at T7525.hs:5:7-31
-    In the second argument of ‛(&&)’, namely ‛?b’
+    In the second argument of ‘(&&)’, namely ‘?b’
     In the expression: ?a && ?b
     In the expression: let ?a = True in ?a && ?b
diff --git a/testsuite/tests/typecheck/should_fail/T7545.stderr b/testsuite/tests/typecheck/should_fail/T7545.stderr
index dc661dae73a9..a1f2853fc997 100644
--- a/testsuite/tests/typecheck/should_fail/T7545.stderr
+++ b/testsuite/tests/typecheck/should_fail/T7545.stderr
@@ -2,4 +2,4 @@
 T7545.hs:8:9:
     Method signature does not match class; it should be
       f :: forall b1. (a -> b) -> b1
-    In the instance declaration for ‛C (a -> b)’
+    In the instance declaration for ‘C (a -> b)’
diff --git a/testsuite/tests/typecheck/should_fail/T7609.stderr b/testsuite/tests/typecheck/should_fail/T7609.stderr
index 2027c3bb64bb..b02dbe20f8ec 100644
--- a/testsuite/tests/typecheck/should_fail/T7609.stderr
+++ b/testsuite/tests/typecheck/should_fail/T7609.stderr
@@ -1,10 +1,10 @@
-
-T7609.hs:7:16:
-    Expecting one more argument to ‛Maybe’
-    The second argument of a tuple should have kind ‛*’,
-      but ‛Maybe’ has kind ‛* -> *’
-    In the type signature for ‛f’: f :: (a `X` a, Maybe)
-
-T7609.hs:10:7:
-    Expected a constraint, but ‛a `X` a’ has kind ‛*’
-    In the type signature for ‛g’: g :: a `X` a => Maybe
+
+T7609.hs:7:16:
+    Expecting one more argument to ‘Maybe’
+    The second argument of a tuple should have kind ‘*’,
+      but ‘Maybe’ has kind ‘* -> *’
+    In the type signature for ‘f’: f :: (a `X` a, Maybe)
+
+T7609.hs:10:7:
+    Expected a constraint, but ‘a `X` a’ has kind ‘*’
+    In the type signature for ‘g’: g :: (a `X` a) => Maybe
diff --git a/testsuite/tests/typecheck/should_fail/T7645.stderr b/testsuite/tests/typecheck/should_fail/T7645.stderr
index ae00e21ca68a..12d6c15e498b 100644
--- a/testsuite/tests/typecheck/should_fail/T7645.stderr
+++ b/testsuite/tests/typecheck/should_fail/T7645.stderr
@@ -1,6 +1,6 @@
 
 T7645.hs:6:23:
-    Expecting one more argument to ‛Maybe’
-    The second argument of a tuple should have kind ‛*’,
-      but ‛Maybe’ has kind ‛* -> *’
-    In the type signature for ‛f’: f :: ((+) a (a :: *), Maybe)
+    Expecting one more argument to ‘Maybe’
+    The second argument of a tuple should have kind ‘*’,
+      but ‘Maybe’ has kind ‘* -> *’
+    In the type signature for ‘f’: f :: ((+) a (a :: *), Maybe)
diff --git a/testsuite/tests/typecheck/should_fail/T7696.stderr b/testsuite/tests/typecheck/should_fail/T7696.stderr
index b166faa21bb4..65dfb79d2bba 100644
--- a/testsuite/tests/typecheck/should_fail/T7696.stderr
+++ b/testsuite/tests/typecheck/should_fail/T7696.stderr
@@ -1,7 +1,7 @@
 
 T7696.hs:7:6:
-    Couldn't match type ‛m0 a0’ with ‛()’
+    Couldn't match type ‘m0 a0’ with ‘()’
     Expected type: ((), w ())
       Actual type: (m0 a0, t0 m0)
     In the expression: f1
-    In an equation for ‛f2’: f2 = f1
+    In an equation for ‘f2’: f2 = f1
diff --git a/testsuite/tests/typecheck/should_fail/T7697.stderr b/testsuite/tests/typecheck/should_fail/T7697.stderr
index 759d4abf5c49..477acc1d09df 100644
--- a/testsuite/tests/typecheck/should_fail/T7697.stderr
+++ b/testsuite/tests/typecheck/should_fail/T7697.stderr
@@ -1,4 +1,4 @@
 
 T7697.hs:3:6:
-    Expected a constraint, but ‛Int’ has kind ‛*’
-    In the type signature for ‛f’: f :: Int => Int
+    Expected a constraint, but ‘Int’ has kind ‘*’
+    In the type signature for ‘f’: f :: Int => Int
diff --git a/testsuite/tests/typecheck/should_fail/T7734.stderr b/testsuite/tests/typecheck/should_fail/T7734.stderr
index fc3348abb728..3f5934044184 100644
--- a/testsuite/tests/typecheck/should_fail/T7734.stderr
+++ b/testsuite/tests/typecheck/should_fail/T7734.stderr
@@ -4,7 +4,7 @@ T7734.hs:4:13:
     Relevant bindings include
       x :: t2 -> t1 (bound at T7734.hs:4:1)
       f :: (t2 -> t1) -> t -> t1 (bound at T7734.hs:4:1)
-    In the first argument of ‛x’, namely ‛x’
+    In the first argument of ‘x’, namely ‘x’
     In the expression: x x
 
 T7734.hs:5:13:
@@ -12,5 +12,5 @@ T7734.hs:5:13:
     Relevant bindings include
       x :: t2 -> t1 (bound at T7734.hs:5:5)
       (&) :: (t2 -> t1) -> t -> t1 (bound at T7734.hs:5:1)
-    In the first argument of ‛x’, namely ‛x’
+    In the first argument of ‘x’, namely ‘x’
     In the expression: x x
diff --git a/testsuite/tests/typecheck/should_fail/T7748a.stderr b/testsuite/tests/typecheck/should_fail/T7748a.stderr
index 0e039e72379c..de451eb52f70 100644
--- a/testsuite/tests/typecheck/should_fail/T7748a.stderr
+++ b/testsuite/tests/typecheck/should_fail/T7748a.stderr
@@ -1,7 +1,7 @@
 
 T7748a.hs:14:24:
-    Couldn't match expected type ‛a’ with actual type ‛Maybe t0’
-      ‛a’ is a rigid type variable bound by
+    Couldn't match expected type ‘a’ with actual type ‘Maybe t0’
+      ‘a’ is a rigid type variable bound by
           the type signature for test :: a -> r -> () at T7748a.hs:11:9
     Relevant bindings include
       zd :: a (bound at T7748a.hs:12:6)
diff --git a/testsuite/tests/typecheck/should_fail/T7778.stderr b/testsuite/tests/typecheck/should_fail/T7778.stderr
index 89196dfb0c9d..136625af75b6 100644
--- a/testsuite/tests/typecheck/should_fail/T7778.stderr
+++ b/testsuite/tests/typecheck/should_fail/T7778.stderr
@@ -1,5 +1,5 @@
 
 T7778.hs:3:19:
-    Expecting one more argument to ‛Num’
-    Expected a type, but ‛Num’ has kind ‛* -> Constraint’
-    In the type signature for ‛v’: v :: (Num Int => Num) () => ()
+    Expecting one more argument to ‘Num’
+    Expected a type, but ‘Num’ has kind ‘* -> Constraint’
+    In the type signature for ‘v’: v :: ((Num Int => Num) ()) => ()
diff --git a/testsuite/tests/typecheck/should_fail/T7809.stderr b/testsuite/tests/typecheck/should_fail/T7809.stderr
index ebfb3f5804df..e306f8dcd39a 100644
--- a/testsuite/tests/typecheck/should_fail/T7809.stderr
+++ b/testsuite/tests/typecheck/should_fail/T7809.stderr
@@ -2,4 +2,4 @@
 T7809.hs:8:8:
     Illegal polymorphic or qualified type: PolyId
     Perhaps you intended to use ImpredicativeTypes
-    In the type signature for ‛foo’: foo :: F PolyId
+    In the type signature for ‘foo’: foo :: F PolyId
diff --git a/testsuite/tests/typecheck/should_fail/T7851.stderr b/testsuite/tests/typecheck/should_fail/T7851.stderr
index ba5fc7ce4537..64148511e7bd 100644
--- a/testsuite/tests/typecheck/should_fail/T7851.stderr
+++ b/testsuite/tests/typecheck/should_fail/T7851.stderr
@@ -1,7 +1,7 @@
 
 T7851.hs:5:10:
-    Couldn't match expected type ‛IO a0’ with actual type ‛a1 -> IO ()’
-    Probable cause: ‛print’ is applied to too few arguments
+    Couldn't match expected type ‘IO a0’ with actual type ‘a1 -> IO ()’
+    Probable cause: ‘print’ is applied to too few arguments
     In a stmt of a 'do' block: print
     In the expression:
       do { print;
diff --git a/testsuite/tests/typecheck/should_fail/T7856.stderr b/testsuite/tests/typecheck/should_fail/T7856.stderr
index 566018894fbc..e6fe2bd42fdc 100644
--- a/testsuite/tests/typecheck/should_fail/T7856.stderr
+++ b/testsuite/tests/typecheck/should_fail/T7856.stderr
@@ -1,10 +1,10 @@
 
 T7856.hs:4:7:
-    Couldn't match expected type ‛String -> IO ()’
-                with actual type ‛IO ()’
-    Possible cause: ‛sequence_’ is applied to too many arguments
+    Couldn't match expected type ‘String -> IO ()’
+                with actual type ‘IO ()’
+    Possible cause: ‘sequence_’ is applied to too many arguments
     In the expression: sequence_ lst
-    In an equation for ‛tmp’:
+    In an equation for ‘tmp’:
         tmp
           = sequence_ lst
           where
diff --git a/testsuite/tests/typecheck/should_fail/T7857.stderr b/testsuite/tests/typecheck/should_fail/T7857.stderr
index d360c389b074..3519b3fa8d62 100644
--- a/testsuite/tests/typecheck/should_fail/T7857.stderr
+++ b/testsuite/tests/typecheck/should_fail/T7857.stderr
@@ -1,17 +1,17 @@
 
 T7857.hs:8:11:
-    Could not deduce (PrintfType s0) arising from a use of ‛printf’
+    Could not deduce (PrintfType s0) arising from a use of ‘printf’
     from the context (PrintfArg t)
-      bound by the inferred type of g :: PrintfArg t => t -> s
+      bound by the inferred type of g :: PrintfArg t => t -> b
       at T7857.hs:8:1-21
-    The type variable ‛s0’ is ambiguous
+    The type variable ‘s0’ is ambiguous
     Note: there are several potential instances:
       instance [safe] (PrintfArg a, PrintfType r) => PrintfType (a -> r)
-        -- Defined in ‛Text.Printf’
+        -- Defined in ‘Text.Printf’
       instance [safe] a ~ () => PrintfType (IO a)
-        -- Defined in ‛Text.Printf’
+        -- Defined in ‘Text.Printf’
       instance [safe] IsChar c => PrintfType [c]
-        -- Defined in ‛Text.Printf’
-    In the second argument of ‛($)’, namely ‛printf "" i’
+        -- Defined in ‘Text.Printf’
+    In the second argument of ‘($)’, namely ‘printf "" i’
     In the expression: f $ printf "" i
-    In an equation for ‛g’: g i = f $ printf "" i
+    In an equation for ‘g’: g i = f $ printf "" i
diff --git a/testsuite/tests/typecheck/should_fail/T7869.stderr b/testsuite/tests/typecheck/should_fail/T7869.stderr
index 1324b06ae55f..dd3aabc4642b 100644
--- a/testsuite/tests/typecheck/should_fail/T7869.stderr
+++ b/testsuite/tests/typecheck/should_fail/T7869.stderr
@@ -1,7 +1,7 @@
 
 T7869.hs:3:12:
-    Couldn't match type ‛a’ with ‛a1’
-      because type variable ‛a1’ would escape its scope
+    Couldn't match type ‘a’ with ‘a1’
+      because type variable ‘a1’ would escape its scope
     This (rigid, skolem) type variable is bound by
       an expression type signature: [a1] -> b1
       at T7869.hs:3:5-27
@@ -12,11 +12,11 @@ T7869.hs:3:12:
       f :: [a] -> b (bound at T7869.hs:3:1)
     In the expression: f x
     In the expression: (\ x -> f x) :: [a] -> b
-    In an equation for ‛f’: f = (\ x -> f x) :: [a] -> b
+    In an equation for ‘f’: f = (\ x -> f x) :: [a] -> b
 
 T7869.hs:3:12:
-    Couldn't match type ‛b’ with ‛b1’
-      because type variable ‛b1’ would escape its scope
+    Couldn't match type ‘b’ with ‘b1’
+      because type variable ‘b1’ would escape its scope
     This (rigid, skolem) type variable is bound by
       an expression type signature: [a1] -> b1
       at T7869.hs:3:5-27
@@ -25,4 +25,4 @@ T7869.hs:3:12:
     Relevant bindings include f :: [a] -> b (bound at T7869.hs:3:1)
     In the expression: f x
     In the expression: (\ x -> f x) :: [a] -> b
-    In an equation for ‛f’: f = (\ x -> f x) :: [a] -> b
+    In an equation for ‘f’: f = (\ x -> f x) :: [a] -> b
diff --git a/testsuite/tests/typecheck/should_fail/T7892.stderr b/testsuite/tests/typecheck/should_fail/T7892.stderr
index eec7bd73dc38..559ac67270c9 100644
--- a/testsuite/tests/typecheck/should_fail/T7892.stderr
+++ b/testsuite/tests/typecheck/should_fail/T7892.stderr
@@ -1,2 +1,2 @@
 
-T7892.hs:5:4: Couldn't match kind ‛*’ against ‛* -> *’
+T7892.hs:5:4: Couldn't match kind ‘*’ against ‘* -> *’
diff --git a/testsuite/tests/typecheck/should_fail/T7989.stderr b/testsuite/tests/typecheck/should_fail/T7989.stderr
index 3ba815e5f415..8b02d0df319f 100644
--- a/testsuite/tests/typecheck/should_fail/T7989.stderr
+++ b/testsuite/tests/typecheck/should_fail/T7989.stderr
@@ -1,15 +1,15 @@
 
 T7989.hs:6:7:
-    No constructor has all these fields: ‛a0’, ‛b0’
+    No constructor has all these fields: ‘a0’, ‘b0’
     In the expression: x {a0 = 3, a1 = 2, b0 = 4, b1 = 5}
-    In an equation for ‛f’: f x = x {a0 = 3, a1 = 2, b0 = 4, b1 = 5}
+    In an equation for ‘f’: f x = x {a0 = 3, a1 = 2, b0 = 4, b1 = 5}
 
 T7989.hs:9:7:
-    No constructor has all these fields: ‛x’, ‛y’, ‛z’
+    No constructor has all these fields: ‘x’, ‘y’, ‘z’
     In the expression: a {x = 0, y = 0, z = 0, v = 0}
-    In an equation for ‛g’: g a = a {x = 0, y = 0, z = 0, v = 0}
+    In an equation for ‘g’: g a = a {x = 0, y = 0, z = 0, v = 0}
 
 T7989.hs:11:7:
-    No constructor has all these fields: ‛x’, ‛a0’
+    No constructor has all these fields: ‘x’, ‘a0’
     In the expression: a {x = 0, a0 = 0}
-    In an equation for ‛h’: h a = a {x = 0, a0 = 0}
+    In an equation for ‘h’: h a = a {x = 0, a0 = 0}
diff --git a/testsuite/tests/typecheck/should_fail/T8142.stderr b/testsuite/tests/typecheck/should_fail/T8142.stderr
index c1c32fe56655..d585abdcd2c5 100644
--- a/testsuite/tests/typecheck/should_fail/T8142.stderr
+++ b/testsuite/tests/typecheck/should_fail/T8142.stderr
@@ -1,28 +1,28 @@
-
-T8142.hs:6:18:
-    Couldn't match type ‛Nu ((,) t0)’ with ‛Nu ((,) t)’
-    NB: ‛Nu’ is a type function, and may not be injective
-    The type variable ‛t0’ is ambiguous
-    Expected type: Nu ((,) t) -> Nu f
-      Actual type: Nu ((,) t0) -> Nu f0
-    When checking that ‛h’
-      has the inferred type ‛forall t (f :: * -> *). Nu ((,) t) -> Nu f’
-    Probable cause: the inferred type is ambiguous
-    In an equation for ‛tracer’:
-        tracer
-          = h
-          where
-              h = (\ (_, b) -> ((outI . fmap h) b)) . out
-
-T8142.hs:6:57:
-    Could not deduce (Nu ((,) t) ~ f1 (Nu ((,) t)))
-    from the context (Functor f, Coinductive f)
-      bound by the type signature for
-                 tracer :: (Functor f, Coinductive f) => (c -> f c) -> c -> f c
-      at T8142.hs:5:11-64
-    Expected type: Nu ((,) t) -> (t, f1 (Nu ((,) t)))
-      Actual type: Nu ((,) t) -> (t, Nu ((,) t))
-    Relevant bindings include
-      h :: Nu ((,) t) -> Nu f1 (bound at T8142.hs:6:18)
-    In the second argument of ‛(.)’, namely ‛out’
-    In the expression: (\ (_, b) -> ((outI . fmap h) b)) . out
+
+T8142.hs:6:18:
+    Couldn't match type ‘Nu ((,) t0)’ with ‘Nu ((,) t)’
+    NB: ‘Nu’ is a type function, and may not be injective
+    The type variable ‘t0’ is ambiguous
+    Expected type: Nu ((,) t) -> Nu f
+      Actual type: Nu ((,) t0) -> Nu f0
+    When checking that ‘h’ has the inferred type
+      h :: forall t (f :: * -> *). Nu ((,) t) -> Nu f
+    Probable cause: the inferred type is ambiguous
+    In an equation for ‘tracer’:
+        tracer
+          = h
+          where
+              h = (\ (_, b) -> ((outI . fmap h) b)) . out
+
+T8142.hs:6:57:
+    Could not deduce (Nu ((,) t) ~ f1 (Nu ((,) t)))
+    from the context (Functor f, Coinductive f)
+      bound by the type signature for
+                 tracer :: (Functor f, Coinductive f) => (c -> f c) -> c -> f c
+      at T8142.hs:5:11-64
+    Expected type: Nu ((,) t) -> (t, f1 (Nu ((,) t)))
+      Actual type: Nu ((,) t) -> (t, Nu ((,) t))
+    Relevant bindings include
+      h :: Nu ((,) t) -> Nu f1 (bound at T8142.hs:6:18)
+    In the second argument of ‘(.)’, namely ‘out’
+    In the expression: (\ (_, b) -> ((outI . fmap h) b)) . out
diff --git a/testsuite/tests/typecheck/should_fail/T8262.stderr b/testsuite/tests/typecheck/should_fail/T8262.stderr
index db908de694dd..44c2fb861a06 100644
--- a/testsuite/tests/typecheck/should_fail/T8262.stderr
+++ b/testsuite/tests/typecheck/should_fail/T8262.stderr
@@ -5,6 +5,6 @@ T8262.hs:5:15:
       GHC.Prim.Int# :: #
     Relevant bindings include
       foo :: t -> Maybe a (bound at T8262.hs:5:1)
-    In the first argument of ‛Just’, namely ‛(1#)’
+    In the first argument of ‘Just’, namely ‘(1#)’
     In the expression: Just (1#)
-    In an equation for ‛foo’: foo x = Just (1#)
+    In an equation for ‘foo’: foo x = Just (1#)
diff --git a/testsuite/tests/typecheck/should_fail/T8392a.stderr b/testsuite/tests/typecheck/should_fail/T8392a.stderr
index 6e102227cffc..ed33600a1e9c 100644
--- a/testsuite/tests/typecheck/should_fail/T8392a.stderr
+++ b/testsuite/tests/typecheck/should_fail/T8392a.stderr
@@ -1,7 +1,7 @@
 
 T8392a.hs:6:8:
-    Couldn't match type ‛Int’ with ‛Bool’
+    Couldn't match type ‘Int’ with ‘Bool’
     Inaccessible code in
       the type signature for foo :: Int ~ Bool => a -> a
     In the ambiguity check for: forall a. Int ~ Bool => a -> a
-    In the type signature for ‛foo’: foo :: Int ~ Bool => a -> a
+    In the type signature for ‘foo’: foo :: (Int ~ Bool) => a -> a
diff --git a/testsuite/tests/typecheck/should_fail/T8428.stderr b/testsuite/tests/typecheck/should_fail/T8428.stderr
index 235135192e5f..49c20a5b8f2f 100644
--- a/testsuite/tests/typecheck/should_fail/T8428.stderr
+++ b/testsuite/tests/typecheck/should_fail/T8428.stderr
@@ -1,10 +1,10 @@
 
 T8428.hs:11:19:
-    Couldn't match type ‛(forall s. ST s) a’ with ‛forall s. ST s a’
+    Couldn't match type ‘(forall s. ST s) a’ with ‘forall s. ST s a’
     Expected type: IdentityT (forall s. ST s) a -> forall s. ST s a
       Actual type: IdentityT (forall s. ST s) a -> (forall s. ST s) a
     Relevant bindings include
       runIdST :: IdentityT (forall s. ST s) a -> a
         (bound at T8428.hs:11:1)
-    In the second argument of ‛(.)’, namely ‛runIdentityT’
+    In the second argument of ‘(.)’, namely ‘runIdentityT’
     In the expression: runST . runIdentityT
diff --git a/testsuite/tests/typecheck/should_fail/T8450.stderr b/testsuite/tests/typecheck/should_fail/T8450.stderr
index 3688005dbba7..ef3c62e7b6eb 100644
--- a/testsuite/tests/typecheck/should_fail/T8450.stderr
+++ b/testsuite/tests/typecheck/should_fail/T8450.stderr
@@ -1,13 +1,13 @@
 
 T8450.hs:8:20:
-    Couldn't match type ‛a’ with ‛Bool’
-      ‛a’ is a rigid type variable bound by
+    Couldn't match type ‘a’ with ‘Bool’
+      ‘a’ is a rigid type variable bound by
           the type signature for run :: a at T8450.hs:7:15
     Expected type: Either Bool ()
       Actual type: Either a ()
     Relevant bindings include run :: a (bound at T8450.hs:8:1)
-    In the second argument of ‛($)’, namely
-      ‛(undefined :: Either a ())’
+    In the second argument of ‘($)’, namely
+      ‘(undefined :: Either a ())’
     In the expression: runEffect $ (undefined :: Either a ())
-    In an equation for ‛run’:
+    In an equation for ‘run’:
         run = runEffect $ (undefined :: Either a ())
diff --git a/testsuite/tests/typecheck/should_fail/T8514.stderr b/testsuite/tests/typecheck/should_fail/T8514.stderr
index 254dacd8ed9a..41aeb3b52eeb 100644
--- a/testsuite/tests/typecheck/should_fail/T8514.stderr
+++ b/testsuite/tests/typecheck/should_fail/T8514.stderr
@@ -1,7 +1,7 @@
 
 T8514.hs:3:16:
-    Expecting one more argument to ‛Maybe’
-    The second argument of a tuple should have kind ‛*’,
-      but ‛Maybe’ has kind ‛* -> *’
-    In the type ‛(a, Maybe)’
-    In the type declaration for ‛T’
+    Expecting one more argument to ‘Maybe’
+    The second argument of a tuple should have kind ‘*’,
+      but ‘Maybe’ has kind ‘* -> *’
+    In the type ‘(a, Maybe)’
+    In the type declaration for ‘T’
diff --git a/testsuite/tests/typecheck/should_fail/T8570.stderr b/testsuite/tests/typecheck/should_fail/T8570.stderr
index 18653eac3890..75d736cf1d3a 100644
--- a/testsuite/tests/typecheck/should_fail/T8570.stderr
+++ b/testsuite/tests/typecheck/should_fail/T8570.stderr
@@ -1,6 +1,6 @@
 
 T8570.hs:6:18:
-    Constructor ‛Image’ does not have field ‛filepath’
+    Constructor ‘Image’ does not have field ‘filepath’
     In the pattern: Image {filepath = x}
     In a pattern binding: Image {filepath = x} = logo
     In the expression: let Image {filepath = x} = logo in x
diff --git a/testsuite/tests/typecheck/should_fail/T8603.stderr b/testsuite/tests/typecheck/should_fail/T8603.stderr
index 1777dc9535c2..8ee8cccb4a73 100644
--- a/testsuite/tests/typecheck/should_fail/T8603.stderr
+++ b/testsuite/tests/typecheck/should_fail/T8603.stderr
@@ -1,11 +1,11 @@
 
 T8603.hs:29:17:
-    Couldn't match type ‛(->) [a0]’ with ‛[t1]’
-    Expected type: [t1] -> StateT s RV t0
-      Actual type: t2 ((->) [a0]) (StateT s RV t0)
-    The function ‛lift’ is applied to two arguments,
-    but its type ‛([a0] -> StateT s RV t0)
-                  -> t2 ((->) [a0]) (StateT s RV t0)’
+    Couldn't match type ‘(->) [a0]’ with ‘[Integer]’
+    Expected type: [Integer] -> StateT s RV t0
+      Actual type: t1 ((->) [a0]) (StateT s RV t0)
+    The function ‘lift’ is applied to two arguments,
+    but its type ‘([a0] -> StateT s RV t0)
+                  -> t1 ((->) [a0]) (StateT s RV t0)’
     has only one
     In a stmt of a 'do' block: prize <- lift uniform [1, 2, 3]
     In the expression:
@@ -13,10 +13,10 @@ T8603.hs:29:17:
            return False }
 
 T8603.hs:29:22:
-    Couldn't match type ‛StateT s RV t0’ with ‛RV a0’
+    Couldn't match type ‘StateT s RV t0’ with ‘RV a0’
     Expected type: [a0] -> StateT s RV t0
       Actual type: [a0] -> RV a0
     Relevant bindings include
       testRVState1 :: RVState s Bool (bound at T8603.hs:28:1)
-    In the first argument of ‛lift’, namely ‛uniform’
+    In the first argument of ‘lift’, namely ‘uniform’
     In a stmt of a 'do' block: prize <- lift uniform [1, 2, 3]
diff --git a/testsuite/tests/typecheck/should_fail/T8806.hs b/testsuite/tests/typecheck/should_fail/T8806.hs
new file mode 100644
index 000000000000..6b80f15ee199
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T8806.hs
@@ -0,0 +1,9 @@
+-- Trac #8806
+
+module T8806 where
+
+f :: Int => Int
+f x = x + 1
+
+g :: (Int => Show a) => Int
+g = undefined
diff --git a/testsuite/tests/typecheck/should_fail/T8806.stderr b/testsuite/tests/typecheck/should_fail/T8806.stderr
new file mode 100644
index 000000000000..ab88b7f2eb1e
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T8806.stderr
@@ -0,0 +1,8 @@
+
+T8806.hs:5:6:
+    Expected a constraint, but ‘Int’ has kind ‘*’
+    In the type signature for ‘f’: f :: Int => Int
+
+T8806.hs:8:7:
+    Illegal constraint: Int => Show a
+    In the type signature for ‘g’: g :: (Int => Show a) => Int
diff --git a/testsuite/tests/typecheck/should_fail/T8883.hs b/testsuite/tests/typecheck/should_fail/T8883.hs
new file mode 100644
index 000000000000..5b0fc5922c27
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T8883.hs
@@ -0,0 +1,20 @@
+{-# LANGUAGE TypeFamilies #-}
+
+-- Trac #8883
+
+module T8883 where
+
+type family PF a :: * -> *
+
+class Regular a where
+  from :: a -> PF a a
+
+-- For fold we infer following type signature:
+--
+-- fold :: (Functor (PF a), Regular a) => (PF a b -> b) -> a -> b
+--
+-- However, this signature requires FlexibleContexts since the first
+-- type-class constraint is not of the form (class type-variable) nor
+-- (class (type-variable type1 type2 ... typen)). Since this extension
+-- is not enabled compilation should fail.
+fold f = f . fmap (fold f) . from
diff --git a/testsuite/tests/typecheck/should_fail/T8883.stderr b/testsuite/tests/typecheck/should_fail/T8883.stderr
new file mode 100644
index 000000000000..d02f02338e8c
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T8883.stderr
@@ -0,0 +1,8 @@
+
+T8883.hs:20:1:
+    Non type-variable argument in the constraint: Functor (PF a)
+    (Use FlexibleContexts to permit this)
+    When checking that ‘fold’ has the inferred type
+      fold :: forall a b.
+              (Regular a, Functor (PF a)) =>
+              (PF a b -> b) -> a -> b
diff --git a/testsuite/tests/typecheck/should_fail/T8912.hs b/testsuite/tests/typecheck/should_fail/T8912.hs
new file mode 100644
index 000000000000..5ffb47ebde36
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T8912.hs
@@ -0,0 +1,11 @@
+{-# LANGUAGE ImplicitParams #-}
+module T8912 where
+
+class C a where
+  toInt :: a -> Int
+
+instance (?imp :: Int) => C [a] where
+  toInt _ = ?imp
+
+test :: Int
+test = let ?imp = 5 in toInt "Hello, world"
diff --git a/testsuite/tests/typecheck/should_fail/T8912.stderr b/testsuite/tests/typecheck/should_fail/T8912.stderr
new file mode 100644
index 000000000000..ad343f33c516
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T8912.stderr
@@ -0,0 +1,6 @@
+
+T8912.hs:7:10:
+    Illegal implicit parameter ‘?imp::Int’
+    In the context: (?imp::Int)
+    While checking an instance declaration
+    In the instance declaration for ‘C [a]’
diff --git a/testsuite/tests/typecheck/should_fail/T9033.hs b/testsuite/tests/typecheck/should_fail/T9033.hs
new file mode 100644
index 000000000000..cc9277fc1765
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T9033.hs
@@ -0,0 +1,7 @@
+module T9030 where
+
+bad :: Bool
+bad = ()
+
+square :: Integral i => i -> i
+square x = x^2
diff --git a/testsuite/tests/typecheck/should_fail/T9033.stderr b/testsuite/tests/typecheck/should_fail/T9033.stderr
new file mode 100644
index 000000000000..c2fd56312463
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T9033.stderr
@@ -0,0 +1,5 @@
+
+T9033.hs:4:7:
+    Couldn't match expected type ‘Bool’ with actual type ‘()’
+    In the expression: ()
+    In an equation for ‘bad’: bad = ()
diff --git a/testsuite/tests/typecheck/should_fail/T9196.hs b/testsuite/tests/typecheck/should_fail/T9196.hs
new file mode 100644
index 000000000000..11d713b5e9c2
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T9196.hs
@@ -0,0 +1,8 @@
+{-# LANGUAGE RankNTypes #-}
+module T9196 where
+
+f :: (forall a. Eq a) => a -> a
+f x = x
+
+g :: (Eq a => Ord a) => a -> a
+g x = x
diff --git a/testsuite/tests/typecheck/should_fail/T9196.stderr b/testsuite/tests/typecheck/should_fail/T9196.stderr
new file mode 100644
index 000000000000..6f5a204eddca
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T9196.stderr
@@ -0,0 +1,8 @@
+
+T9196.hs:4:7:
+    Illegal constraint: forall a. Eq a
+    In the type signature for ‘f’: f :: (forall a. Eq a) => a -> a
+
+T9196.hs:7:7:
+    Illegal constraint: Eq a => Ord a
+    In the type signature for ‘g’: g :: (Eq a => Ord a) => a -> a
diff --git a/testsuite/tests/typecheck/should_fail/T9305.hs b/testsuite/tests/typecheck/should_fail/T9305.hs
new file mode 100644
index 000000000000..b6ad3b780e6d
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T9305.hs
@@ -0,0 +1,8 @@
+{-# LANGUAGE DeriveFunctor#-}
+module Main where
+
+data Event a b = Event a deriving (Functor)
+
+newtype F f = F (f (F f))
+
+data EventF a = EventF (F (Event a)) deriving (Functor)
diff --git a/testsuite/tests/typecheck/should_fail/T9305.stderr b/testsuite/tests/typecheck/should_fail/T9305.stderr
new file mode 100644
index 000000000000..16104237b970
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T9305.stderr
@@ -0,0 +1,8 @@
+
+T9305.hs:8:48:
+    No instance for (Functor Event)
+      arising from the first field of ‘EventF’ (type ‘F (Event a)’)
+    Possible fix:
+      use a standalone 'deriving instance' declaration,
+        so you can specify the instance context yourself
+    When deriving the instance for (Functor EventF)
diff --git a/testsuite/tests/typecheck/should_fail/T9323.hs b/testsuite/tests/typecheck/should_fail/T9323.hs
new file mode 100644
index 000000000000..1aea288bbea0
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T9323.hs
@@ -0,0 +1,7 @@
+module T9323 where
+
+broken :: [Int]
+broken = ()
+
+ambiguous :: a -> String
+ambiguous _ = show 0
diff --git a/testsuite/tests/typecheck/should_fail/T9323.stderr b/testsuite/tests/typecheck/should_fail/T9323.stderr
new file mode 100644
index 000000000000..f98ce7bafe03
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T9323.stderr
@@ -0,0 +1,5 @@
+
+T9323.hs:4:10:
+    Couldn't match expected type ‘[Int]’ with actual type ‘()’
+    In the expression: ()
+    In an equation for ‘broken’: broken = ()
diff --git a/testsuite/tests/typecheck/should_fail/T9415.hs b/testsuite/tests/typecheck/should_fail/T9415.hs
new file mode 100644
index 000000000000..db77ff0a85e0
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T9415.hs
@@ -0,0 +1,5 @@
+module T9415 where
+
+class D a => C a where
+  meth :: D a => ()
+class C a => D a
diff --git a/testsuite/tests/typecheck/should_fail/T9415.stderr b/testsuite/tests/typecheck/should_fail/T9415.stderr
new file mode 100644
index 000000000000..516759ee30e2
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T9415.stderr
@@ -0,0 +1,8 @@
+
+T9415.hs:3:1:
+    Cycle in class declaration (via superclasses): C -> D -> C
+    In the class declaration for ‘C’
+
+T9415.hs:5:1:
+    Cycle in class declaration (via superclasses): D -> C -> D
+    In the class declaration for ‘D’
diff --git a/testsuite/tests/typecheck/should_fail/TcCoercibleFail.hs b/testsuite/tests/typecheck/should_fail/TcCoercibleFail.hs
index 1ad76d4e3729..0431eee18472 100644
--- a/testsuite/tests/typecheck/should_fail/TcCoercibleFail.hs
+++ b/testsuite/tests/typecheck/should_fail/TcCoercibleFail.hs
@@ -1,6 +1,6 @@
 {-# LANGUAGE RoleAnnotations, RankNTypes, ScopedTypeVariables #-}
 
-import GHC.Prim (coerce, Coercible)
+import Data.Coerce (coerce, Coercible)
 import Data.Ord (Down)
 
 newtype Age = Age Int deriving Show
diff --git a/testsuite/tests/typecheck/should_fail/TcCoercibleFail.stderr b/testsuite/tests/typecheck/should_fail/TcCoercibleFail.stderr
index d6fd5eb0daa2..2851bcd934a9 100644
--- a/testsuite/tests/typecheck/should_fail/TcCoercibleFail.stderr
+++ b/testsuite/tests/typecheck/should_fail/TcCoercibleFail.stderr
@@ -1,59 +1,59 @@
 
 TcCoercibleFail.hs:11:8:
-    Could not coerce from ‛Int’ to ‛()’
-      because ‛Int’ and ‛()’ are different types.
-      arising from a use of ‛coerce’
+    Could not coerce from ‘Int’ to ‘()’
+      because ‘Int’ and ‘()’ are different types.
+      arising from a use of ‘coerce’
     In the expression: coerce
     In the expression: coerce $ one :: ()
-    In an equation for ‛foo1’: foo1 = coerce $ one :: ()
+    In an equation for ‘foo1’: foo1 = coerce $ one :: ()
 
 TcCoercibleFail.hs:14:8:
-    Could not coerce from ‛m Int’ to ‛m Age’
-      because ‛m Int’ and ‛m Age’ are different types.
-      arising from a use of ‛coerce’
+    Could not coerce from ‘m Int’ to ‘m Age’
+      because ‘m Int’ and ‘m Age’ are different types.
+      arising from a use of ‘coerce’
     from the context (Monad m)
       bound by the type signature for foo2 :: Monad m => m Age
       at TcCoercibleFail.hs:13:9-34
     In the expression: coerce
     In the expression: coerce $ (return one :: m Int)
-    In an equation for ‛foo2’: foo2 = coerce $ (return one :: m Int)
+    In an equation for ‘foo2’: foo2 = coerce $ (return one :: m Int)
 
 TcCoercibleFail.hs:16:8:
-    Could not coerce from ‛Map Int ()’ to ‛Map Age ()’
-      because the first type argument of ‛Map’ has role Nominal,
-      but the arguments ‛Int’ and ‛Age’ differ
-      arising from a use of ‛coerce’
+    Could not coerce from ‘Map Int ()’ to ‘Map Age ()’
+      because the first type argument of ‘Map’ has role Nominal,
+      but the arguments ‘Int’ and ‘Age’ differ
+      arising from a use of ‘coerce’
     In the expression: coerce
     In the expression: coerce $ Map one () :: Map Age ()
-    In an equation for ‛foo3’: foo3 = coerce $ Map one () :: Map Age ()
+    In an equation for ‘foo3’: foo3 = coerce $ Map one () :: Map Age ()
 
 TcCoercibleFail.hs:18:8:
-    Could not coerce from ‛Int’ to ‛Down Int’
-    because the constructor of ‛Down’ is not imported
-      arising from a use of ‛coerce’
+    Could not coerce from ‘Int’ to ‘Down Int’
+    because the constructor of ‘Down’ is not imported
+      arising from a use of ‘coerce’
     In the expression: coerce
     In the expression: coerce $ one :: Down Int
-    In an equation for ‛foo4’: foo4 = coerce $ one :: Down Int
+    In an equation for ‘foo4’: foo4 = coerce $ one :: Down Int
 
 TcCoercibleFail.hs:21:8:
     Context reduction stack overflow; size = 21
     Use -fcontext-stack=N to increase stack size to N
       Coercible Void ()
     In the expression: coerce :: Void -> ()
-    In an equation for ‛foo5’: foo5 = coerce :: Void -> ()
+    In an equation for ‘foo5’: foo5 = coerce :: Void -> ()
 
 TcCoercibleFail.hs:30:8:
     Context reduction stack overflow; size = 21
     Use -fcontext-stack=N to increase stack size to N
       Coercible Int Age
     In the expression: coerce :: Fix (Either Int) -> Fix (Either Age)
-    In an equation for ‛foo6’:
+    In an equation for ‘foo6’:
         foo6 = coerce :: Fix (Either Int) -> Fix (Either Age)
 
 TcCoercibleFail.hs:31:8:
-    Could not coerce from ‛Either Int (Fix (Either Int))’ to ‛()’
-      because ‛Either
-                 Int (Fix (Either Int))’ and ‛()’ are different types.
-      arising from a use of ‛coerce’
+    Could not coerce from ‘Either Int (Fix (Either Int))’ to ‘()’
+      because ‘Either
+                 Int (Fix (Either Int))’ and ‘()’ are different types.
+      arising from a use of ‘coerce’
     In the expression: coerce :: Fix (Either Int) -> ()
-    In an equation for ‛foo7’: foo7 = coerce :: Fix (Either Int) -> ()
+    In an equation for ‘foo7’: foo7 = coerce :: Fix (Either Int) -> ()
diff --git a/testsuite/tests/typecheck/should_fail/TcCoercibleFail2.hs b/testsuite/tests/typecheck/should_fail/TcCoercibleFail2.hs
index 13a3234fcc2c..8d89b526398c 100644
--- a/testsuite/tests/typecheck/should_fail/TcCoercibleFail2.hs
+++ b/testsuite/tests/typecheck/should_fail/TcCoercibleFail2.hs
@@ -1,4 +1,4 @@
-import GHC.Prim (Coercible)
+import Data.Coerce (Coercible)
 
 instance Coercible () ()
 
diff --git a/testsuite/tests/typecheck/should_fail/TcCoercibleFail2.stderr b/testsuite/tests/typecheck/should_fail/TcCoercibleFail2.stderr
index f180a9a2123b..29c268d22f86 100644
--- a/testsuite/tests/typecheck/should_fail/TcCoercibleFail2.stderr
+++ b/testsuite/tests/typecheck/should_fail/TcCoercibleFail2.stderr
@@ -1,5 +1,5 @@
 
 TcCoercibleFail2.hs:3:10:
-    Illegal instance declaration for ‛Coercible () ()’
+    Illegal instance declaration for ‘Coercible () ()’
       The class is abstract, manual instances are not permitted.
-    In the instance declaration for ‛Coercible () ()’
+    In the instance declaration for ‘Coercible () ()’
diff --git a/testsuite/tests/typecheck/should_fail/TcCoercibleFail3.hs b/testsuite/tests/typecheck/should_fail/TcCoercibleFail3.hs
index 4caf1c263293..eb9b72512b2f 100644
--- a/testsuite/tests/typecheck/should_fail/TcCoercibleFail3.hs
+++ b/testsuite/tests/typecheck/should_fail/TcCoercibleFail3.hs
@@ -1,6 +1,6 @@
 {-# LANGUAGE RoleAnnotations, RankNTypes, ScopedTypeVariables #-}
 
-import GHC.Prim (coerce, Coercible)
+import Data.Coerce (coerce, Coercible)
 
 newtype List a = List [a]
 data T f = T (f Int)
diff --git a/testsuite/tests/typecheck/should_fail/TcCoercibleFail3.stderr b/testsuite/tests/typecheck/should_fail/TcCoercibleFail3.stderr
index 54cd96ff6aec..619e81fdfbb6 100644
--- a/testsuite/tests/typecheck/should_fail/TcCoercibleFail3.stderr
+++ b/testsuite/tests/typecheck/should_fail/TcCoercibleFail3.stderr
@@ -1,7 +1,7 @@
 
 TcCoercibleFail3.hs:12:7:
-    Could not coerce from ‛NT1’ to ‛NT2’
-      because ‛NT1’ and ‛NT2’ are different types.
-      arising from a use of ‛coerce’
+    Could not coerce from ‘NT1’ to ‘NT2’
+      because ‘NT1’ and ‘NT2’ are different types.
+      arising from a use of ‘coerce’
     In the expression: coerce
-    In an equation for ‛foo’: foo = coerce
+    In an equation for ‘foo’: foo = coerce
diff --git a/testsuite/tests/typecheck/should_fail/TcCoercibleFailSafe.hs b/testsuite/tests/typecheck/should_fail/TcCoercibleFailSafe.hs
deleted file mode 100644
index 85f86b6e3353..000000000000
--- a/testsuite/tests/typecheck/should_fail/TcCoercibleFailSafe.hs
+++ /dev/null
@@ -1,11 +0,0 @@
-{-# LANGUAGE RoleAnnotations, RankNTypes, ScopedTypeVariables, Safe #-}
-
-import GHC.Prim (coerce, Coercible)
-import Data.Ord (Down)
-
-newtype Age = Age Int deriving Show
-
-foo1 :: (Down Age -> Down Int)
-foo1 = coerce 
-
-main = return ()
diff --git a/testsuite/tests/typecheck/should_fail/TcCoercibleFailSafe.stderr b/testsuite/tests/typecheck/should_fail/TcCoercibleFailSafe.stderr
deleted file mode 100644
index 90643dfbe49d..000000000000
--- a/testsuite/tests/typecheck/should_fail/TcCoercibleFailSafe.stderr
+++ /dev/null
@@ -1,8 +0,0 @@
-
-TcCoercibleFailSafe.hs:9:8:
-    Could not coerce from ‛Down Age’ to ‛Down Int’
-      because the constructor of ‛Down’ is not imported
-      as required in SafeHaskell mode
-      arising from a use of ‛coerce’
-    In the expression: coerce
-    In an equation for ‛foo1’: foo1 = coerce
diff --git a/testsuite/tests/typecheck/should_fail/TcMultiWayIfFail.stderr b/testsuite/tests/typecheck/should_fail/TcMultiWayIfFail.stderr
index 5655af9da6d3..70ac94f060c0 100644
--- a/testsuite/tests/typecheck/should_fail/TcMultiWayIfFail.stderr
+++ b/testsuite/tests/typecheck/should_fail/TcMultiWayIfFail.stderr
@@ -1,16 +1,16 @@
 
 TcMultiWayIfFail.hs:6:24:
-    Couldn't match expected type ‛Int’ with actual type ‛[Char]’
+    Couldn't match expected type ‘Int’ with actual type ‘[Char]’
     In the expression: "2"
     In the expression:
       if | True -> 1 :: Int | False -> "2" | otherwise -> [3 :: Int]
-    In an equation for ‛x1’:
+    In an equation for ‘x1’:
         x1 = if | True -> 1 :: Int | False -> "2" | otherwise -> [3 :: Int]
 
 TcMultiWayIfFail.hs:7:24:
-    Couldn't match expected type ‛Int’ with actual type ‛[Int]’
+    Couldn't match expected type ‘Int’ with actual type ‘[Int]’
     In the expression: [3 :: Int]
     In the expression:
       if | True -> 1 :: Int | False -> "2" | otherwise -> [3 :: Int]
-    In an equation for ‛x1’:
+    In an equation for ‘x1’:
         x1 = if | True -> 1 :: Int | False -> "2" | otherwise -> [3 :: Int]
diff --git a/testsuite/tests/typecheck/should_fail/TcNoNullaryTC.stderr b/testsuite/tests/typecheck/should_fail/TcNoNullaryTC.stderr
index 90ef78718a6d..80f6ec4ec077 100644
--- a/testsuite/tests/typecheck/should_fail/TcNoNullaryTC.stderr
+++ b/testsuite/tests/typecheck/should_fail/TcNoNullaryTC.stderr
@@ -1,5 +1,5 @@
 
 TcNoNullaryTC.hs:3:1:
-    No parameters for class ‛A’
-    (Use NullaryTypeClasses to allow no-parameter classes)
-    In the class declaration for ‛A’
+    No parameters for class ‘A’
+    (Use MultiParamTypeClasses to allow no-parameter classes)
+    In the class declaration for ‘A’
diff --git a/testsuite/tests/typecheck/should_fail/TcNullaryTCFail.hs b/testsuite/tests/typecheck/should_fail/TcNullaryTCFail.hs
index b127300b755f..b00200db2a17 100644
--- a/testsuite/tests/typecheck/should_fail/TcNullaryTCFail.hs
+++ b/testsuite/tests/typecheck/should_fail/TcNullaryTCFail.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE NullaryTypeClasses #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
 module TcNullaryTCFail where
 
 class A
diff --git a/testsuite/tests/typecheck/should_fail/Tcfail218_Help.hs b/testsuite/tests/typecheck/should_fail/Tcfail218_Help.hs
deleted file mode 100644
index e5ee76d755b8..000000000000
--- a/testsuite/tests/typecheck/should_fail/Tcfail218_Help.hs
+++ /dev/null
@@ -1,7 +0,0 @@
-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}
-
-module Tcfail218_Help where
-
-class C a b where foo :: (a,b)
-
-instance C [Int] b where foo = undefined
diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T
index faef06382db3..4f001f5ab732 100644
--- a/testsuite/tests/typecheck/should_fail/all.T
+++ b/testsuite/tests/typecheck/should_fail/all.T
@@ -243,10 +243,7 @@ test('tcfail214', normal, compile_fail, [''])
 test('tcfail215', normal, compile_fail, [''])
 test('tcfail216', normal, compile_fail, [''])
 test('tcfail217', normal, compile_fail, [''])
-test('tcfail218',
-    extra_clean(['Tcfail218_Help.o','Tcfail218_Help.hi']),
-    multimod_compile_fail, ['tcfail218','-v0'])
-
+test('tcfail218', normal, compile_fail, [''])
 test('SilentParametersOverlapping', normal, compile_fail, [''])
 test('FailDueToGivenOverlapping', normal, compile_fail, [''])
 test('LongWayOverlapping', normal, compile_fail, [''])
@@ -317,7 +314,6 @@ test('T7989', normal, compile_fail, [''])
 test('T8142', normal, compile_fail, [''])
 test('T8262', normal, compile_fail, [''])
 test('TcCoercibleFail', when(compiler_lt('ghc', '7.7'), skip), compile_fail, [''])
-test('TcCoercibleFailSafe', when(compiler_lt('ghc', '7.7'), skip), compile_fail, [''])
 test('TcCoercibleFail2', when(compiler_lt('ghc', '7.7'), skip), compile_fail, [''])
 test('TcCoercibleFail3', when(compiler_lt('ghc', '7.7'), skip), compile_fail, [''])
 test('T8306', normal, compile_fail, [''])
@@ -330,3 +326,11 @@ test('ContextStack2', normal, compile_fail, ['-ftype-function-depth=10'])
 test('T8570', extra_clean(['T85570a.o', 'T8570a.hi','T85570b.o', 'T8570b.hi']),
      multimod_compile_fail, ['T8570', '-v0'])
 test('T8603', normal, compile_fail, [''])
+test('T8806', normal, compile_fail, [''])
+test('T8912', normal, compile_fail, [''])
+test('T9033', normal, compile_fail, [''])
+test('T8883', normal, compile_fail, [''])
+test('T9196', normal, compile_fail, [''])
+test('T9305', normal, compile_fail, [''])
+test('T9323', normal, compile_fail, [''])
+test('T9415', normal, compile_fail, [''])
diff --git a/testsuite/tests/typecheck/should_fail/fd-loop.stderr b/testsuite/tests/typecheck/should_fail/fd-loop.stderr
index f26bda816d4d..96fbc3ef189e 100644
--- a/testsuite/tests/typecheck/should_fail/fd-loop.stderr
+++ b/testsuite/tests/typecheck/should_fail/fd-loop.stderr
@@ -1,12 +1,12 @@
 
 fd-loop.hs:12:10:
-    Variable ‛b’ occurs more often than in the instance head
+    Variable ‘b’ occurs more often than in the instance head
       in the constraint: C a b
     (Use UndecidableInstances to permit this)
-    In the instance declaration for ‛Eq (T a)’
+    In the instance declaration for ‘Eq (T a)’
 
 fd-loop.hs:12:10:
-    Variable ‛b’ occurs more often than in the instance head
+    Variable ‘b’ occurs more often than in the instance head
       in the constraint: Eq b
     (Use UndecidableInstances to permit this)
-    In the instance declaration for ‛Eq (T a)’
+    In the instance declaration for ‘Eq (T a)’
diff --git a/testsuite/tests/typecheck/should_fail/mc19.stderr b/testsuite/tests/typecheck/should_fail/mc19.stderr
index a5e9bc5e7f11..d7181ad8a76b 100644
--- a/testsuite/tests/typecheck/should_fail/mc19.stderr
+++ b/testsuite/tests/typecheck/should_fail/mc19.stderr
@@ -1,7 +1,7 @@
 
 mc19.hs:10:31:
-    Couldn't match type ‛a’ with ‛[a]’
-      ‛a’ is a rigid type variable bound by
+    Couldn't match type ‘a’ with ‘[a]’
+      ‘a’ is a rigid type variable bound by
           a type expected by the context: [a] -> [a] at mc19.hs:10:26
     Expected type: [a] -> [a]
       Actual type: [a] -> [[a]]
diff --git a/testsuite/tests/typecheck/should_fail/mc20.stderr b/testsuite/tests/typecheck/should_fail/mc20.stderr
index 86be7f4a1af5..798160fbf7c5 100644
--- a/testsuite/tests/typecheck/should_fail/mc20.stderr
+++ b/testsuite/tests/typecheck/should_fail/mc20.stderr
@@ -1,6 +1,6 @@
 
 mc20.hs:14:31:
-    No instance for (Ord Unorderable) arising from a use of ‛groupWith’
+    No instance for (Ord Unorderable) arising from a use of ‘groupWith’
     In the expression: groupWith
     In a stmt of a monad comprehension: then group by x using groupWith
     In the expression:
diff --git a/testsuite/tests/typecheck/should_fail/mc21.stderr b/testsuite/tests/typecheck/should_fail/mc21.stderr
index 853f982979b1..337c84369b2e 100644
--- a/testsuite/tests/typecheck/should_fail/mc21.stderr
+++ b/testsuite/tests/typecheck/should_fail/mc21.stderr
@@ -1,7 +1,7 @@
 
 mc21.hs:12:26:
-    Couldn't match type ‛a’ with ‛[a]’
-      ‛a’ is a rigid type variable bound by
+    Couldn't match type ‘a’ with ‘[a]’
+      ‘a’ is a rigid type variable bound by
           a type expected by the context: [a] -> [[a]] at mc21.hs:12:9
     Expected type: [a] -> [[a]]
       Actual type: [a] -> [a]
diff --git a/testsuite/tests/typecheck/should_fail/mc22.stderr b/testsuite/tests/typecheck/should_fail/mc22.stderr
index 23b53d7e0758..f3da3c5eeb2f 100644
--- a/testsuite/tests/typecheck/should_fail/mc22.stderr
+++ b/testsuite/tests/typecheck/should_fail/mc22.stderr
@@ -1,6 +1,6 @@
 
 mc22.hs:10:9:
-    No instance for (Functor t) arising from a use of ‛fmap’
+    No instance for (Functor t) arising from a use of ‘fmap’
     Possible fix:
       add (Functor t) to the context of
         a type expected by the context: (a -> b) -> t a -> t b
@@ -11,8 +11,8 @@ mc22.hs:10:9:
       [x + 1 | x <- ["Hello", "World"], then group using take 5]
 
 mc22.hs:10:26:
-    Couldn't match type ‛a’ with ‛t a’
-      ‛a’ is a rigid type variable bound by
+    Couldn't match type ‘a’ with ‘t a’
+      ‘a’ is a rigid type variable bound by
           a type expected by the context: [a] -> [t a] at mc22.hs:10:9
     Expected type: [a] -> [t a]
       Actual type: [a] -> [a]
diff --git a/testsuite/tests/typecheck/should_fail/mc23.stderr b/testsuite/tests/typecheck/should_fail/mc23.stderr
index 4bd18c10c75d..cdb10800e417 100644
--- a/testsuite/tests/typecheck/should_fail/mc23.stderr
+++ b/testsuite/tests/typecheck/should_fail/mc23.stderr
@@ -1,9 +1,9 @@
 
 mc23.hs:9:29:
-    Couldn't match type ‛[a0]’ with ‛a -> b’
+    Couldn't match type ‘[a0]’ with ‘a -> b’
     Expected type: (a -> b) -> [a] -> t a
       Actual type: [a0] -> [a0]
     Relevant bindings include z :: t b (bound at mc23.hs:9:1)
-    Possible cause: ‛take’ is applied to too many arguments
+    Possible cause: ‘take’ is applied to too many arguments
     In the expression: take 5
     In a stmt of a monad comprehension: then take 5 by x
diff --git a/testsuite/tests/typecheck/should_fail/mc24.stderr b/testsuite/tests/typecheck/should_fail/mc24.stderr
index 2e0515b282f8..495693c9f8eb 100644
--- a/testsuite/tests/typecheck/should_fail/mc24.stderr
+++ b/testsuite/tests/typecheck/should_fail/mc24.stderr
@@ -1,8 +1,8 @@
-
-mc24.hs:10:31:
-    Couldn't match type ‛[a0]’ with ‛a -> a1’
-    Expected type: (a -> a1) -> [a] -> t [a]
-      Actual type: [a0] -> [a0]
-    Possible cause: ‛take’ is applied to too many arguments
-    In the expression: take 2
-    In a stmt of a monad comprehension: then group by x using take 2
+
+mc24.hs:10:31:
+    Couldn't match type ‘[a0]’ with ‘a -> Integer’
+    Expected type: (a -> Integer) -> [a] -> t [a]
+      Actual type: [a0] -> [a0]
+    Possible cause: ‘take’ is applied to too many arguments
+    In the expression: take 2
+    In a stmt of a monad comprehension: then group by x using take 2
diff --git a/testsuite/tests/typecheck/should_fail/mc25.stderr b/testsuite/tests/typecheck/should_fail/mc25.stderr
index 042de5b6205a..6af388febe87 100644
--- a/testsuite/tests/typecheck/should_fail/mc25.stderr
+++ b/testsuite/tests/typecheck/should_fail/mc25.stderr
@@ -1,6 +1,6 @@
 
 mc25.hs:9:24:
-    No instance for (Functor t1) arising from a use of ‛fmap’
+    No instance for (Functor t1) arising from a use of ‘fmap’
     Possible fix:
       add (Functor t1) to the context of
         a type expected by the context: (a -> b) -> t1 a -> t1 b
@@ -10,7 +10,7 @@ mc25.hs:9:24:
     In the expression: [x | x <- [1 .. 10], then group by x using take]
 
 mc25.hs:9:46:
-    Couldn't match type ‛Int’ with ‛a -> t’
+    Couldn't match type ‘Int’ with ‘a -> t’
     Expected type: (a -> t) -> [a] -> [t1 a]
       Actual type: Int -> [a] -> [a]
     Relevant bindings include z :: [t1 t] (bound at mc25.hs:9:1)
diff --git a/testsuite/tests/typecheck/should_fail/tcfail001.stderr b/testsuite/tests/typecheck/should_fail/tcfail001.stderr
index 32418ac5c2b1..3c6788254600 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail001.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail001.stderr
@@ -1,7 +1,7 @@
 
 tcfail001.hs:9:2:
-    Couldn't match expected type ‛[t0] -> [t1]’ with actual type ‛[a]’
+    Couldn't match expected type ‘[t0] -> [t1]’ with actual type ‘[a]’
     Relevant bindings include op :: [a] (bound at tcfail001.hs:9:2)
-    The equation(s) for ‛op’ have one argument,
-    but its type ‛[a]’ has none
-    In the instance declaration for ‛A [a]’
+    The equation(s) for ‘op’ have one argument,
+    but its type ‘[a]’ has none
+    In the instance declaration for ‘A [a]’
diff --git a/testsuite/tests/typecheck/should_fail/tcfail002.stderr b/testsuite/tests/typecheck/should_fail/tcfail002.stderr
index 67248f40647e..11e8078a1b52 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail002.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail002.stderr
@@ -5,4 +5,4 @@ tcfail002.hs:4:7:
       z :: [t] (bound at tcfail002.hs:4:3)
       c :: [t] -> t (bound at tcfail002.hs:3:1)
     In the expression: z
-    In an equation for ‛c’: c z = z
+    In an equation for ‘c’: c z = z
diff --git a/testsuite/tests/typecheck/should_fail/tcfail003.stderr b/testsuite/tests/typecheck/should_fail/tcfail003.stderr
index e605497890b9..54490cd22dac 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail003.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail003.stderr
@@ -1,6 +1,6 @@
 
 tcfail003.hs:3:10:
-    No instance for (Num Char) arising from the literal ‛1’
+    No instance for (Num Char) arising from the literal ‘1’
     In the expression: 1
     In the expression: [1, 'a']
     In a pattern binding: (d : e) = [1, 'a']
diff --git a/testsuite/tests/typecheck/should_fail/tcfail004.stderr b/testsuite/tests/typecheck/should_fail/tcfail004.stderr
index fd73db69aef1..48840e7298c6 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail004.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail004.stderr
@@ -1,9 +1,9 @@
-
-tcfail004.hs:3:9:
-    Couldn't match expected type ‛(t, t3)’
-                with actual type ‛(t0, t1, t2)’
-    Relevant bindings include
-      f :: t (bound at tcfail004.hs:3:2)
-      g :: t3 (bound at tcfail004.hs:3:4)
-    In the expression: (1, 2, 3)
-    In a pattern binding: (f, g) = (1, 2, 3)
+
+tcfail004.hs:3:9:
+    Couldn't match expected type ‘(t, t1)’
+                with actual type ‘(Integer, Integer, Integer)’
+    Relevant bindings include
+      f :: t (bound at tcfail004.hs:3:2)
+      g :: t1 (bound at tcfail004.hs:3:4)
+    In the expression: (1, 2, 3)
+    In a pattern binding: (f, g) = (1, 2, 3)
diff --git a/testsuite/tests/typecheck/should_fail/tcfail005.stderr b/testsuite/tests/typecheck/should_fail/tcfail005.stderr
index 401bc35194df..36f0e738e42d 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail005.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail005.stderr
@@ -1,8 +1,9 @@
-
-tcfail005.hs:3:9:
-    Couldn't match expected type ‛[t]’ with actual type ‛(t0, Char)’
-    Relevant bindings include
-      h :: t (bound at tcfail005.hs:3:2)
-      i :: [t] (bound at tcfail005.hs:3:4)
-    In the expression: (1, 'a')
-    In a pattern binding: (h : i) = (1, 'a')
+
+tcfail005.hs:3:9:
+    Couldn't match expected type ‘[t]’
+                with actual type ‘(Integer, Char)’
+    Relevant bindings include
+      h :: t (bound at tcfail005.hs:3:2)
+      i :: [t] (bound at tcfail005.hs:3:4)
+    In the expression: (1, 'a')
+    In a pattern binding: (h : i) = (1, 'a')
diff --git a/testsuite/tests/typecheck/should_fail/tcfail006.stderr b/testsuite/tests/typecheck/should_fail/tcfail006.stderr
index 387fe56b4921..7bfaf2d9a681 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail006.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail006.stderr
@@ -1,6 +1,6 @@
 
 tcfail006.hs:4:24:
-    No instance for (Num Bool) arising from the literal ‛1’
+    No instance for (Num Bool) arising from the literal ‘1’
     In the expression: 1
     In the expression: (True, 1)
     In a case alternative: True -> (True, 1)
diff --git a/testsuite/tests/typecheck/should_fail/tcfail007.stderr b/testsuite/tests/typecheck/should_fail/tcfail007.stderr
index 99c9504a7ec9..5ea979225606 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail007.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail007.stderr
@@ -1,8 +1,8 @@
 
 tcfail007.hs:3:15:
-    No instance for (Num Bool) arising from a use of ‛+’
+    No instance for (Num Bool) arising from a use of ‘+’
     In the expression: x + 1
-    In an equation for ‛n’:
+    In an equation for ‘n’:
         n x
           | True = x + 1
           | False = True
diff --git a/testsuite/tests/typecheck/should_fail/tcfail008.stderr b/testsuite/tests/typecheck/should_fail/tcfail008.stderr
index 09c4c54558e2..c633a153253d 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail008.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail008.stderr
@@ -1,20 +1,20 @@
 
 tcfail008.hs:3:5:
-    No instance for (Num a0) arising from the literal ‛1’
-    The type variable ‛a0’ is ambiguous
+    No instance for (Num a0) arising from the literal ‘1’
+    The type variable ‘a0’ is ambiguous
     Relevant bindings include o :: [a0] (bound at tcfail008.hs:3:1)
     Note: there are several potential instances:
-      instance Num Double -- Defined in ‛GHC.Float’
-      instance Num Float -- Defined in ‛GHC.Float’
+      instance Num Double -- Defined in ‘GHC.Float’
+      instance Num Float -- Defined in ‘GHC.Float’
       instance Integral a => Num (GHC.Real.Ratio a)
-        -- Defined in ‛GHC.Real’
+        -- Defined in ‘GHC.Real’
       ...plus three others
-    In the first argument of ‛(:)’, namely ‛1’
+    In the first argument of ‘(:)’, namely ‘1’
     In the expression: 1 : 2
-    In an equation for ‛o’: o = 1 : 2
+    In an equation for ‘o’: o = 1 : 2
 
 tcfail008.hs:3:7:
-    No instance for (Num [a0]) arising from the literal ‛2’
-    In the second argument of ‛(:)’, namely ‛2’
+    No instance for (Num [a0]) arising from the literal ‘2’
+    In the second argument of ‘(:)’, namely ‘2’
     In the expression: 1 : 2
-    In an equation for ‛o’: o = 1 : 2
+    In an equation for ‘o’: o = 1 : 2
diff --git a/testsuite/tests/typecheck/should_fail/tcfail009.stderr b/testsuite/tests/typecheck/should_fail/tcfail009.stderr
index 517e39c36fc2..2597a00c4b3d 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail009.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail009.stderr
@@ -1,6 +1,6 @@
 
 tcfail009.hs:3:17:
-    Couldn't match expected type ‛Int’ with actual type ‛Integer’
+    Couldn't match expected type ‘Int’ with actual type ‘Integer’
     In the expression: (2 :: Integer)
     In the expression: [(1 :: Int) .. (2 :: Integer)]
-    In an equation for ‛p’: p = [(1 :: Int) .. (2 :: Integer)]
+    In an equation for ‘p’: p = [(1 :: Int) .. (2 :: Integer)]
diff --git a/testsuite/tests/typecheck/should_fail/tcfail010.stderr b/testsuite/tests/typecheck/should_fail/tcfail010.stderr
index 3f718371aacb..abffc1acd24d 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail010.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail010.stderr
@@ -1,6 +1,6 @@
 
 tcfail010.hs:3:17:
-    No instance for (Num [t0]) arising from a use of ‛+’
+    No instance for (Num [t0]) arising from a use of ‘+’
     In the expression: z + 2
     In the expression: \ (y : z) -> z + 2
-    In an equation for ‛q’: q = \ (y : z) -> z + 2
+    In an equation for ‘q’: q = \ (y : z) -> z + 2
diff --git a/testsuite/tests/typecheck/should_fail/tcfail011.stderr b/testsuite/tests/typecheck/should_fail/tcfail011.stderr
index 8ef94fec12ad..8a69d5410153 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail011.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail011.stderr
@@ -1,2 +1,2 @@
 
-tcfail011.hs:3:25: Not in scope: ‛y’
+tcfail011.hs:3:25: Not in scope: ‘y’
diff --git a/testsuite/tests/typecheck/should_fail/tcfail012.stderr b/testsuite/tests/typecheck/should_fail/tcfail012.stderr
index 257eca351f51..572c7a677c0a 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail012.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail012.stderr
@@ -1,5 +1,5 @@
 
 tcfail012.hs:3:8:
-    Couldn't match expected type ‛Bool’ with actual type ‛[t0]’
+    Couldn't match expected type ‘Bool’ with actual type ‘[t0]’
     In the expression: []
     In a pattern binding: True = []
diff --git a/testsuite/tests/typecheck/should_fail/tcfail013.stderr b/testsuite/tests/typecheck/should_fail/tcfail013.stderr
index 075c4dab8743..bf567acc2ba4 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail013.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail013.stderr
@@ -1,6 +1,6 @@
 
 tcfail013.hs:4:3:
-    Couldn't match expected type ‛[t]’ with actual type ‛Bool’
+    Couldn't match expected type ‘[t]’ with actual type ‘Bool’
     Relevant bindings include f :: [t] -> a (bound at tcfail013.hs:3:1)
     In the pattern: True
-    In an equation for ‛f’: f True = 2
+    In an equation for ‘f’: f True = 2
diff --git a/testsuite/tests/typecheck/should_fail/tcfail014.stderr b/testsuite/tests/typecheck/should_fail/tcfail014.stderr
index 79af8623e14a..d133863e348c 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail014.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail014.stderr
@@ -4,5 +4,5 @@ tcfail014.hs:5:33:
     Relevant bindings include
       z :: t8 -> t7 (bound at tcfail014.hs:5:27)
       h :: (t8 -> t7) -> t7 (bound at tcfail014.hs:5:25)
-    In the first argument of ‛z’, namely ‛z’
+    In the first argument of ‘z’, namely ‘z’
     In the expression: z z
diff --git a/testsuite/tests/typecheck/should_fail/tcfail015.stderr b/testsuite/tests/typecheck/should_fail/tcfail015.stderr
index 7e0225376013..c8332e1b3265 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail015.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail015.stderr
@@ -1,5 +1,5 @@
 
 tcfail015.hs:7:13:
-    No instance for (Num Bool) arising from the literal ‛2’
+    No instance for (Num Bool) arising from the literal ‘2’
     In the expression: 2
-    In an equation for ‛g’: g (ANull) = 2
+    In an equation for ‘g’: g (ANull) = 2
diff --git a/testsuite/tests/typecheck/should_fail/tcfail016.stderr b/testsuite/tests/typecheck/should_fail/tcfail016.stderr
index 3b8e2a9712dd..418000712230 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail016.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail016.stderr
@@ -1,22 +1,22 @@
 
 tcfail016.hs:9:20:
-    Couldn't match type ‛(t, Expr t)’ with ‛Expr t’
+    Couldn't match type ‘(t, Expr t)’ with ‘Expr t’
     Expected type: Expr t
       Actual type: AnnExpr t
     Relevant bindings include
       e2 :: AnnExpr t (bound at tcfail016.hs:9:11)
       e1 :: AnnExpr t (bound at tcfail016.hs:9:8)
       g :: Expr t -> [[Char]] (bound at tcfail016.hs:8:1)
-    In the first argument of ‛g’, namely ‛e1’
-    In the first argument of ‛(++)’, namely ‛(g e1)’
+    In the first argument of ‘g’, namely ‘e1’
+    In the first argument of ‘(++)’, namely ‘(g e1)’
 
 tcfail016.hs:9:28:
-    Couldn't match type ‛(t, Expr t)’ with ‛Expr t’
+    Couldn't match type ‘(t, Expr t)’ with ‘Expr t’
     Expected type: Expr t
       Actual type: AnnExpr t
     Relevant bindings include
       e2 :: AnnExpr t (bound at tcfail016.hs:9:11)
       e1 :: AnnExpr t (bound at tcfail016.hs:9:8)
       g :: Expr t -> [[Char]] (bound at tcfail016.hs:8:1)
-    In the first argument of ‛g’, namely ‛e2’
-    In the second argument of ‛(++)’, namely ‛(g e2)’
+    In the first argument of ‘g’, namely ‘e2’
+    In the second argument of ‘(++)’, namely ‘(g e2)’
diff --git a/testsuite/tests/typecheck/should_fail/tcfail017.stderr b/testsuite/tests/typecheck/should_fail/tcfail017.stderr
index a0d73da86265..87befa82ed4c 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail017.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail017.stderr
@@ -4,4 +4,4 @@ tcfail017.hs:10:10:
       arising from the superclasses of an instance declaration
     from the context (B a)
       bound by the instance declaration at tcfail017.hs:10:10-23
-    In the instance declaration for ‛B [a]’
+    In the instance declaration for ‘B [a]’
diff --git a/testsuite/tests/typecheck/should_fail/tcfail018.stderr b/testsuite/tests/typecheck/should_fail/tcfail018.stderr
index 687938983bdf..ef3270512655 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail018.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail018.stderr
@@ -1,5 +1,5 @@
 
 tcfail018.hs:5:10:
-    No instance for (Num [t0]) arising from the literal ‛1’
+    No instance for (Num [t0]) arising from the literal ‘1’
     In the expression: 1
     In a pattern binding: (a : []) = 1
diff --git a/testsuite/tests/typecheck/should_fail/tcfail019.stderr b/testsuite/tests/typecheck/should_fail/tcfail019.stderr
index 848805abda24..49eb857593ee 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail019.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail019.stderr
@@ -2,4 +2,4 @@
 tcfail019.hs:18:10:
     No instance for (B [a])
       arising from the superclasses of an instance declaration
-    In the instance declaration for ‛D [a]’
+    In the instance declaration for ‘D [a]’
diff --git a/testsuite/tests/typecheck/should_fail/tcfail020.stderr b/testsuite/tests/typecheck/should_fail/tcfail020.stderr
index 9dfaa63a4e43..4600f207978b 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail020.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail020.stderr
@@ -4,4 +4,4 @@ tcfail020.hs:10:10:
       arising from the superclasses of an instance declaration
     from the context (A a)
       bound by the instance declaration at tcfail020.hs:10:10-23
-    In the instance declaration for ‛B [a]’
+    In the instance declaration for ‘B [a]’
diff --git a/testsuite/tests/typecheck/should_fail/tcfail027.stderr b/testsuite/tests/typecheck/should_fail/tcfail027.stderr
index cc4ffcaab3a0..9cfdcf4a9a36 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail027.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail027.stderr
@@ -1,8 +1,8 @@
 
 tcfail027.hs:4:1:
     Cycle in class declaration (via superclasses): A -> B -> A
-    In the class declaration for ‛A’
+    In the class declaration for ‘A’
 
 tcfail027.hs:7:1:
     Cycle in class declaration (via superclasses): B -> A -> B
-    In the class declaration for ‛B’
+    In the class declaration for ‘B’
diff --git a/testsuite/tests/typecheck/should_fail/tcfail028.stderr b/testsuite/tests/typecheck/should_fail/tcfail028.stderr
index a5c0a59612db..38791e6c0f25 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail028.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail028.stderr
@@ -1,7 +1,7 @@
 
 tcfail028.hs:4:17:
-    Expecting one more argument to ‛A a’
-    Expected a type, but ‛A a’ has kind ‛k0 -> *’
-    In the type ‛A a’
-    In the definition of data constructor ‛B’
-    In the data declaration for ‛A’
+    Expecting one more argument to ‘A a’
+    Expected a type, but ‘A a’ has kind ‘k0 -> *’
+    In the type ‘A a’
+    In the definition of data constructor ‘B’
+    In the data declaration for ‘A’
diff --git a/testsuite/tests/typecheck/should_fail/tcfail029.stderr b/testsuite/tests/typecheck/should_fail/tcfail029.stderr
index 13a1e4936ed8..5b794458e893 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail029.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail029.stderr
@@ -1,5 +1,5 @@
 
 tcfail029.hs:6:9:
-    No instance for (Ord Foo) arising from a use of ‛>’
+    No instance for (Ord Foo) arising from a use of ‘>’
     In the expression: x > Bar
-    In an equation for ‛f’: f x = x > Bar
+    In an equation for ‘f’: f x = x > Bar
diff --git a/testsuite/tests/typecheck/should_fail/tcfail030.stderr b/testsuite/tests/typecheck/should_fail/tcfail030.stderr
index 1e0f08d021c6..66b129076b8d 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail030.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail030.stderr
@@ -1,3 +1,3 @@
 
 tcfail030.hs:1:1:
-    The IO action ‛main’ is not defined in module ‛Main’
+    The IO action ‘main’ is not defined in module ‘Main’
diff --git a/testsuite/tests/typecheck/should_fail/tcfail031.stderr b/testsuite/tests/typecheck/should_fail/tcfail031.stderr
index 5d55430eaa43..2a22e1b29ef8 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail031.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail031.stderr
@@ -1,6 +1,6 @@
 
 tcfail031.hs:3:10:
-    Couldn't match expected type ‛Bool’ with actual type ‛Char’
+    Couldn't match expected type ‘Bool’ with actual type ‘Char’
     In the expression: 'a'
     In the expression: if 'a' then 1 else 2
-    In an equation for ‛f’: f x = if 'a' then 1 else 2
+    In an equation for ‘f’: f x = if 'a' then 1 else 2
diff --git a/testsuite/tests/typecheck/should_fail/tcfail032.stderr b/testsuite/tests/typecheck/should_fail/tcfail032.stderr
index 75d64ee76ba8..4d41c103dab9 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail032.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail032.stderr
@@ -1,12 +1,12 @@
 
 tcfail032.hs:14:8:
-    Couldn't match expected type ‛a1 -> Int’ with actual type ‛t’
-      because type variable ‛a1’ would escape its scope
+    Couldn't match expected type ‘a1 -> Int’ with actual type ‘t’
+      because type variable ‘a1’ would escape its scope
     This (rigid, skolem) type variable is bound by
       an expression type signature: Eq a1 => a1 -> Int
       at tcfail032.hs:14:8-30
     Relevant bindings include
       x :: t (bound at tcfail032.hs:14:3)
       f :: t -> a -> Int (bound at tcfail032.hs:14:1)
-    In the expression: (x :: Eq a => a -> Int)
-    In an equation for ‛f’: f x = (x :: Eq a => a -> Int)
+    In the expression: (x :: (Eq a) => a -> Int)
+    In an equation for ‘f’: f x = (x :: (Eq a) => a -> Int)
diff --git a/testsuite/tests/typecheck/should_fail/tcfail034.stderr b/testsuite/tests/typecheck/should_fail/tcfail034.stderr
index 3fca8122b98a..9107051d8c4a 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail034.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail034.stderr
@@ -1,12 +1,12 @@
 
 tcfail034.hs:17:13:
-    Could not deduce (Integral a) arising from a use of ‛mod’
+    Could not deduce (Integral a) arising from a use of ‘mod’
     from the context (Num a, Eq a)
       bound by the type signature for test :: (Num a, Eq a) => a -> Bool
       at tcfail034.hs:16:7-32
     Possible fix:
       add (Integral a) to the context of
         the type signature for test :: (Num a, Eq a) => a -> Bool
-    In the first argument of ‛(==)’, namely ‛(x `mod` 3)’
+    In the first argument of ‘(==)’, namely ‘(x `mod` 3)’
     In the expression: (x `mod` 3) == 0
-    In an equation for ‛test’: test x = (x `mod` 3) == 0
+    In an equation for ‘test’: test x = (x `mod` 3) == 0
diff --git a/testsuite/tests/typecheck/should_fail/tcfail036.stderr b/testsuite/tests/typecheck/should_fail/tcfail036.stderr
index 465e4547127f..a9aef1192b44 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail036.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail036.stderr
@@ -5,7 +5,7 @@ tcfail036.hs:6:10:
       instance Num NUM -- Defined at tcfail036.hs:8:10
 
 tcfail036.hs:9:13:
-    Expecting one more argument to ‛Num’
-    The first argument of ‛Eq’ should have kind ‛*’,
-      but ‛Num’ has kind ‛* -> Constraint’
-    In the instance declaration for ‛Eq Num’
+    Expecting one more argument to ‘Num’
+    The first argument of ‘Eq’ should have kind ‘*’,
+      but ‘Num’ has kind ‘* -> Constraint’
+    In the instance declaration for ‘Eq Num’
diff --git a/testsuite/tests/typecheck/should_fail/tcfail037.stderr b/testsuite/tests/typecheck/should_fail/tcfail037.stderr
index 00f757841c1f..5ada45cc84ee 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail037.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail037.stderr
@@ -1,8 +1,8 @@
 
 tcfail037.hs:7:11:
-    Ambiguous occurrence ‛+’
-    It could refer to either ‛ShouldFail.+’,
+    Ambiguous occurrence ‘+’
+    It could refer to either ‘ShouldFail.+’,
                              defined at tcfail037.hs:10:5
-                          or ‛Prelude.+’,
-                             imported from ‛Prelude’ at tcfail037.hs:3:8-17
-                             (and originally defined in ‛GHC.Num’)
+                          or ‘Prelude.+’,
+                             imported from ‘Prelude’ at tcfail037.hs:3:8-17
+                             (and originally defined in ‘GHC.Num’)
diff --git a/testsuite/tests/typecheck/should_fail/tcfail038.stderr b/testsuite/tests/typecheck/should_fail/tcfail038.stderr
index f8b7915e0012..2d3e9e5bc9e4 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail038.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail038.stderr
@@ -1,10 +1,10 @@
 
 tcfail038.hs:7:11:
-    Conflicting definitions for ‛==’
+    Conflicting definitions for ‘==’
     Bound at: tcfail038.hs:7:11-12
               tcfail038.hs:9:11-12
 
 tcfail038.hs:8:11:
-    Conflicting definitions for ‛/=’
+    Conflicting definitions for ‘/=’
     Bound at: tcfail038.hs:8:11-12
               tcfail038.hs:10:11-12
diff --git a/testsuite/tests/typecheck/should_fail/tcfail040.stderr b/testsuite/tests/typecheck/should_fail/tcfail040.stderr
index 90fb76d99d98..923be56470ba 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail040.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail040.stderr
@@ -1,9 +1,9 @@
 
 tcfail040.hs:19:5:
-    No instance for (ORD a0) arising from a use of ‛<<’
-    The type variable ‛a0’ is ambiguous
+    No instance for (ORD a0) arising from a use of ‘<<’
+    The type variable ‘a0’ is ambiguous
     Note: there is a potential instance available:
       instance ORD (a -> b) -- Defined at tcfail040.hs:17:10
-    In the first argument of ‛(===)’, namely ‛(<<)’
+    In the first argument of ‘(===)’, namely ‘(<<)’
     In the expression: (<<) === (<<)
-    In an equation for ‛f’: f = (<<) === (<<)
+    In an equation for ‘f’: f = (<<) === (<<)
diff --git a/testsuite/tests/typecheck/should_fail/tcfail041.stderr b/testsuite/tests/typecheck/should_fail/tcfail041.stderr
index f86384133d49..c81d30979a41 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail041.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail041.stderr
@@ -1,5 +1,6 @@
 
-tcfail041.hs:9:10:
-    Unbound implicit parameter (?imp::Int)
-      arising from the superclasses of an instance declaration
-    In the instance declaration for ‛D Int’
+tcfail041.hs:5:1:
+    Illegal implicit parameter ‘?imp::Int’
+    In the context: (?imp::Int)
+    While checking the super-classes of class ‘D’
+    In the class declaration for ‘D’
diff --git a/testsuite/tests/typecheck/should_fail/tcfail042.stderr b/testsuite/tests/typecheck/should_fail/tcfail042.stderr
index 1e1c5ad01ee0..584d18910031 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail042.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail042.stderr
@@ -6,4 +6,4 @@ tcfail042.hs:15:10:
       bound by the instance declaration at tcfail042.hs:15:10-34
     Possible fix:
       add (Num a) to the context of the instance declaration
-    In the instance declaration for ‛Bar [a]’
+    In the instance declaration for ‘Bar [a]’
diff --git a/testsuite/tests/typecheck/should_fail/tcfail043.stderr b/testsuite/tests/typecheck/should_fail/tcfail043.stderr
index df750a4a3c77..6215ce6ad264 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail043.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail043.stderr
@@ -1,7 +1,7 @@
 
 tcfail043.hs:38:17:
-    No instance for (Ord_ a0) arising from a use of ‛gt’
-    The type variable ‛a0’ is ambiguous
+    No instance for (Ord_ a0) arising from a use of ‘gt’
+    The type variable ‘a0’ is ambiguous
     Relevant bindings include
       bs :: [a0] (bound at tcfail043.hs:38:8)
       a :: a0 (bound at tcfail043.hs:38:6)
@@ -22,8 +22,8 @@ tcfail043.hs:38:17:
                if eq a (hd bs) then True else search a (tl bs)
 
 tcfail043.hs:40:25:
-    No instance for (Eq_ a0) arising from a use of ‛eq’
-    The type variable ‛a0’ is ambiguous
+    No instance for (Eq_ a0) arising from a use of ‘eq’
+    The type variable ‘a0’ is ambiguous
     Relevant bindings include
       bs :: [a0] (bound at tcfail043.hs:38:8)
       a :: a0 (bound at tcfail043.hs:38:6)
diff --git a/testsuite/tests/typecheck/should_fail/tcfail044.stderr b/testsuite/tests/typecheck/should_fail/tcfail044.stderr
index eaf769f8b773..9733cc4fc837 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail044.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail044.stderr
@@ -1,16 +1,16 @@
 
 tcfail044.hs:5:20:
-    Illegal instance declaration for ‛Eq (a -> a)’
+    Illegal instance declaration for ‘Eq (a -> a)’
       (All instance types must be of the form (T a1 ... an)
        where a1 ... an are *distinct type variables*,
        and each type variable appears at most once in the instance head.
        Use FlexibleInstances if you want to disable this.)
-    In the instance declaration for ‛Eq (a -> a)’
+    In the instance declaration for ‘Eq (a -> a)’
 
 tcfail044.hs:8:21:
-    Illegal instance declaration for ‛Num (a -> a)’
+    Illegal instance declaration for ‘Num (a -> a)’
       (All instance types must be of the form (T a1 ... an)
        where a1 ... an are *distinct type variables*,
        and each type variable appears at most once in the instance head.
        Use FlexibleInstances if you want to disable this.)
-    In the instance declaration for ‛Num (a -> a)’
+    In the instance declaration for ‘Num (a -> a)’
diff --git a/testsuite/tests/typecheck/should_fail/tcfail046.stderr b/testsuite/tests/typecheck/should_fail/tcfail046.stderr
index b029915b12f8..1dbfdad8f346 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail046.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail046.stderr
@@ -1,7 +1,7 @@
 
 tcfail046.hs:10:50:
     No instance for (Eq (Process a))
-      arising from the first field of ‛Do’ (type ‛Process a’)
+      arising from the first field of ‘Do’ (type ‘Process a’)
     Possible fix:
       use a standalone 'deriving instance' declaration,
         so you can specify the instance context yourself
@@ -9,7 +9,7 @@ tcfail046.hs:10:50:
 
 tcfail046.hs:22:25:
     No instance for (Eq (Process a))
-      arising from the first field of ‛Create’ (type ‛Process a’)
+      arising from the first field of ‘Create’ (type ‘Process a’)
     Possible fix:
       use a standalone 'deriving instance' declaration,
         so you can specify the instance context yourself
diff --git a/testsuite/tests/typecheck/should_fail/tcfail047.stderr b/testsuite/tests/typecheck/should_fail/tcfail047.stderr
index b9778baf9b3a..53eb4defddf1 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail047.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail047.stderr
@@ -1,8 +1,8 @@
 
 tcfail047.hs:6:10:
-    Illegal instance declaration for ‛A (a, (b, c))’
+    Illegal instance declaration for ‘A (a, (b, c))’
       (All instance types must be of the form (T a1 ... an)
        where a1 ... an are *distinct type variables*,
        and each type variable appears at most once in the instance head.
        Use FlexibleInstances if you want to disable this.)
-    In the instance declaration for ‛A (a, (b, c))’
+    In the instance declaration for ‘A (a, (b, c))’
diff --git a/testsuite/tests/typecheck/should_fail/tcfail048.stderr b/testsuite/tests/typecheck/should_fail/tcfail048.stderr
index 29d205e27956..eaa2e52d36ef 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail048.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail048.stderr
@@ -1,2 +1,2 @@
 
-tcfail048.hs:3:8: Not in scope: type constructor or class ‛B’
+tcfail048.hs:3:8: Not in scope: type constructor or class ‘B’
diff --git a/testsuite/tests/typecheck/should_fail/tcfail049.stderr b/testsuite/tests/typecheck/should_fail/tcfail049.stderr
index 3a632e2425cb..6e871b0b8687 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail049.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail049.stderr
@@ -1,2 +1,2 @@
 
-tcfail049.hs:3:7: Not in scope: ‛g’
+tcfail049.hs:3:7: Not in scope: ‘g’
diff --git a/testsuite/tests/typecheck/should_fail/tcfail050.stderr b/testsuite/tests/typecheck/should_fail/tcfail050.stderr
index 5d7a917f53d6..db312bd721db 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail050.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail050.stderr
@@ -1,2 +1,2 @@
 
-tcfail050.hs:3:7: Not in scope: data constructor ‛B’
+tcfail050.hs:3:7: Not in scope: data constructor ‘B’
diff --git a/testsuite/tests/typecheck/should_fail/tcfail051.stderr b/testsuite/tests/typecheck/should_fail/tcfail051.stderr
index f4b0c0c56398..958d0530acd6 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail051.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail051.stderr
@@ -1,2 +1,2 @@
 
-tcfail051.hs:3:10: Not in scope: type constructor or class ‛B’
+tcfail051.hs:3:10: Not in scope: type constructor or class ‘B’
diff --git a/testsuite/tests/typecheck/should_fail/tcfail052.stderr b/testsuite/tests/typecheck/should_fail/tcfail052.stderr
index 2359b4433e93..671565b5068d 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail052.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail052.stderr
@@ -1,2 +1,2 @@
 
-tcfail052.hs:3:16: Not in scope: type variable ‛c’
+tcfail052.hs:3:16: Not in scope: type variable ‘c’
diff --git a/testsuite/tests/typecheck/should_fail/tcfail053.stderr b/testsuite/tests/typecheck/should_fail/tcfail053.stderr
index c014f2f4f38f..a9b13bd6dae2 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail053.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail053.stderr
@@ -1,2 +1,2 @@
 
-tcfail053.hs:3:12: Not in scope: type constructor or class ‛A’
+tcfail053.hs:3:12: Not in scope: type constructor or class ‘A’
diff --git a/testsuite/tests/typecheck/should_fail/tcfail054.stderr b/testsuite/tests/typecheck/should_fail/tcfail054.stderr
index 93b200983f36..79662bf1feb4 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail054.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail054.stderr
@@ -1,2 +1,2 @@
 
-tcfail054.hs:3:4: Not in scope: data constructor ‛B’
+tcfail054.hs:3:4: Not in scope: data constructor ‘B’
diff --git a/testsuite/tests/typecheck/should_fail/tcfail055.stderr b/testsuite/tests/typecheck/should_fail/tcfail055.stderr
index c82e9af2aae4..f70bad6a0213 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail055.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail055.stderr
@@ -1,5 +1,5 @@
 
 tcfail055.hs:3:8:
-    Couldn't match expected type ‛Float’ with actual type ‛Int’
+    Couldn't match expected type ‘Float’ with actual type ‘Int’
     In the expression: (x + 1 :: Int) :: Float
-    In an equation for ‛f’: f x = (x + 1 :: Int) :: Float
+    In an equation for ‘f’: f x = (x + 1 :: Int) :: Float
diff --git a/testsuite/tests/typecheck/should_fail/tcfail056.stderr b/testsuite/tests/typecheck/should_fail/tcfail056.stderr
index 60bba9745312..16f44eacb87b 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail056.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail056.stderr
@@ -1,2 +1,2 @@
 
-tcfail056.hs:10:15: ‛<=’ is not a (visible) method of class ‛Eq’
+tcfail056.hs:10:15: ‘<=’ is not a (visible) method of class ‘Eq’
diff --git a/testsuite/tests/typecheck/should_fail/tcfail057.stderr b/testsuite/tests/typecheck/should_fail/tcfail057.stderr
index 5b19563bfcc8..d581207afade 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail057.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail057.stderr
@@ -1,4 +1,4 @@
 
 tcfail057.hs:5:7:
-    Expected a type, but ‛RealFrac a’ has kind ‛Constraint’
-    In the type signature for ‛f’: f :: (RealFrac a) -> a -> a
+    Expected a type, but ‘RealFrac a’ has kind ‘Constraint’
+    In the type signature for ‘f’: f :: (RealFrac a) -> a -> a
diff --git a/testsuite/tests/typecheck/should_fail/tcfail058.stderr b/testsuite/tests/typecheck/should_fail/tcfail058.stderr
index f5770a42ddf7..74db76afd8b7 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail058.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail058.stderr
@@ -1,5 +1,5 @@
 
 tcfail058.hs:6:7:
-    Expecting one more argument to ‛Array a’
-    Expected a constraint, but ‛Array a’ has kind ‛* -> *’
-    In the type signature for ‛f’: f :: Array a => a -> b
+    Expecting one more argument to ‘Array a’
+    Expected a constraint, but ‘Array a’ has kind ‘* -> *’
+    In the type signature for ‘f’: f :: (Array a) => a -> b
diff --git a/testsuite/tests/typecheck/should_fail/tcfail061.stderr b/testsuite/tests/typecheck/should_fail/tcfail061.stderr
index 14ce5aec71eb..abd72aa2bc0d 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail061.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail061.stderr
@@ -1,8 +1,8 @@
 
-tcfail061.hs:5:17: Not in scope: type variable ‛b’
+tcfail061.hs:5:17: Not in scope: type variable ‘b’
 
-tcfail061.hs:5:19: Not in scope: type variable ‛b’
+tcfail061.hs:5:19: Not in scope: type variable ‘b’
 
-tcfail061.hs:11:22: Not in scope: type variable ‛b’
+tcfail061.hs:11:22: Not in scope: type variable ‘b’
 
-tcfail061.hs:11:24: Not in scope: type variable ‛b’
+tcfail061.hs:11:24: Not in scope: type variable ‘b’
diff --git a/testsuite/tests/typecheck/should_fail/tcfail062.stderr b/testsuite/tests/typecheck/should_fail/tcfail062.stderr
index 2111c7e0fa24..ff4915dfd23e 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail062.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail062.stderr
@@ -1,6 +1,8 @@
 
 tcfail062.hs:34:6:
-    Not in scope: type variable ‛behaviouralExpression’
+    Not in scope: type variable ‘behaviouralExpression’
+    Perhaps you meant type constructor or class ‘BehaviouralExpression’ (line 25)
 
 tcfail062.hs:34:29:
-    Not in scope: type variable ‛behaviouralExpression’
+    Not in scope: type variable ‘behaviouralExpression’
+    Perhaps you meant type constructor or class ‘BehaviouralExpression’ (line 25)
diff --git a/testsuite/tests/typecheck/should_fail/tcfail063.stderr b/testsuite/tests/typecheck/should_fail/tcfail063.stderr
index 046439672558..45bdaa36e2d6 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail063.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail063.stderr
@@ -1,5 +1,5 @@
 
 tcfail063.hs:6:9:
-    Expecting one more argument to ‛Num’
-    Expected a constraint, but ‛Num’ has kind ‛* -> Constraint’
-    In the type signature for ‛moby’: moby :: Num => Int -> a -> Int
+    Expecting one more argument to ‘Num’
+    Expected a constraint, but ‘Num’ has kind ‘* -> Constraint’
+    In the type signature for ‘moby’: moby :: Num => Int -> a -> Int
diff --git a/testsuite/tests/typecheck/should_fail/tcfail065.stderr b/testsuite/tests/typecheck/should_fail/tcfail065.stderr
index 89ac58145aec..f912a68cdd7c 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail065.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail065.stderr
@@ -1,13 +1,13 @@
 
 tcfail065.hs:29:20:
-    Couldn't match expected type ‛x’ with actual type ‛x1’
-      ‛x1’ is a rigid type variable bound by
+    Couldn't match expected type ‘x’ with actual type ‘x1’
+      ‘x1’ is a rigid type variable bound by
            the type signature for setX :: x1 -> X x -> X x
            at tcfail065.hs:29:3
-      ‛x’ is a rigid type variable bound by
+      ‘x’ is a rigid type variable bound by
           the instance declaration at tcfail065.hs:28:10
     Relevant bindings include
       x :: x1 (bound at tcfail065.hs:29:8)
       setX :: x1 -> X x -> X x (bound at tcfail065.hs:29:3)
-    In the first argument of ‛X’, namely ‛x’
+    In the first argument of ‘X’, namely ‘x’
     In the expression: X x
diff --git a/testsuite/tests/typecheck/should_fail/tcfail067.stderr b/testsuite/tests/typecheck/should_fail/tcfail067.stderr
index ebe87035d1cd..e3f6444572c7 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail067.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail067.stderr
@@ -3,24 +3,24 @@ tcfail067.hs:1:14: Warning:
     -XDatatypeContexts is deprecated: It was widely considered a misfeature, and has been removed from the Haskell language.
 
 tcfail067.hs:12:16:
-    No instance for (Ord a) arising from a use of ‛SubRange’
+    No instance for (Ord a) arising from a use of ‘SubRange’
     Possible fix:
       add (Ord a) to the context of
         the type signature for subRangeValue :: SubRange a -> a
     In the pattern: SubRange (lower, upper) value
-    In an equation for ‛subRangeValue’:
+    In an equation for ‘subRangeValue’:
         subRangeValue (SubRange (lower, upper) value) = value
 
 tcfail067.hs:15:11:
-    No instance for (Ord a) arising from a use of ‛SubRange’
+    No instance for (Ord a) arising from a use of ‘SubRange’
     Possible fix:
       add (Ord a) to the context of
         the type signature for subRange :: SubRange a -> (a, a)
     In the pattern: SubRange r value
-    In an equation for ‛subRange’: subRange (SubRange r value) = r
+    In an equation for ‘subRange’: subRange (SubRange r value) = r
 
 tcfail067.hs:46:12:
-    Could not deduce (Ord a) arising from a use of ‛SubRange’
+    Could not deduce (Ord a) arising from a use of ‘SubRange’
     from the context (Show a)
       bound by the type signature for
                  showRange :: Show a => SubRange a -> String
@@ -29,35 +29,35 @@ tcfail067.hs:46:12:
       add (Ord a) to the context of
         the type signature for showRange :: Show a => SubRange a -> String
     In the pattern: SubRange (lower, upper) value
-    In an equation for ‛showRange’:
+    In an equation for ‘showRange’:
         showRange (SubRange (lower, upper) value)
           = show value ++ " :" ++ show lower ++ ".." ++ show upper
 
 tcfail067.hs:61:12:
-    Could not deduce (Show a) arising from a use of ‛numSubRangeNegate’
+    Could not deduce (Show a) arising from a use of ‘numSubRangeNegate’
     from the context (Num a)
       bound by the instance declaration at tcfail067.hs:60:10-34
     Possible fix:
       add (Show a) to the context of the instance declaration
     In the expression: numSubRangeNegate
-    In an equation for ‛negate’: negate = numSubRangeNegate
-    In the instance declaration for ‛Num (SubRange a)’
+    In an equation for ‘negate’: negate = numSubRangeNegate
+    In the instance declaration for ‘Num (SubRange a)’
 
 tcfail067.hs:65:19:
-    Could not deduce (Ord a) arising from a use of ‛SubRange’
+    Could not deduce (Ord a) arising from a use of ‘SubRange’
     from the context (Num a)
       bound by the instance declaration at tcfail067.hs:60:10-34
     Possible fix:
       add (Ord a) to the context of the instance declaration
     In the expression:
       SubRange (fromInteger a, fromInteger a) (fromInteger a)
-    In an equation for ‛fromInteger’:
+    In an equation for ‘fromInteger’:
         fromInteger a
           = SubRange (fromInteger a, fromInteger a) (fromInteger a)
-    In the instance declaration for ‛Num (SubRange a)’
+    In the instance declaration for ‘Num (SubRange a)’
 
 tcfail067.hs:74:5:
-    Could not deduce (Ord a) arising from a use of ‛SubRange’
+    Could not deduce (Ord a) arising from a use of ‘SubRange’
     from the context (Num a)
       bound by the type signature for
                  numSubRangeBinOp :: Num a =>
@@ -69,7 +69,7 @@ tcfail067.hs:74:5:
           numSubRangeBinOp :: Num a =>
                               (a -> a -> a) -> SubRange a -> SubRange a -> SubRange a
     In the expression: SubRange (result, result) result
-    In an equation for ‛numSubRangeBinOp’:
+    In an equation for ‘numSubRangeBinOp’:
         numSubRangeBinOp op a b
           = SubRange (result, result) result
           where
diff --git a/testsuite/tests/typecheck/should_fail/tcfail068.stderr b/testsuite/tests/typecheck/should_fail/tcfail068.stderr
index 8b2cd42158d1..1df6fb8bb457 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail068.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail068.stderr
@@ -5,10 +5,10 @@ tcfail068.hs:14:9:
       bound by the type signature for
                  itgen :: Constructed a => (Int, Int) -> a -> IndTree s a
       at tcfail068.hs:11:10-55
-      ‛s1’ is a rigid type variable bound by
+      ‘s1’ is a rigid type variable bound by
            a type expected by the context: GHC.ST.ST s1 (IndTree s a)
            at tcfail068.hs:13:9
-      ‛s’ is a rigid type variable bound by
+      ‘s’ is a rigid type variable bound by
           the type signature for
             itgen :: Constructed a => (Int, Int) -> a -> IndTree s a
           at tcfail068.hs:11:10
@@ -17,8 +17,8 @@ tcfail068.hs:14:9:
     Relevant bindings include
       itgen :: (Int, Int) -> a -> IndTree s a
         (bound at tcfail068.hs:12:1)
-    In the first argument of ‛runST’, namely
-      ‛(newSTArray ((1, 1), n) x)’
+    In the first argument of ‘runST’, namely
+      ‘(newSTArray ((1, 1), n) x)’
     In the expression: runST (newSTArray ((1, 1), n) x)
 
 tcfail068.hs:19:21:
@@ -28,12 +28,12 @@ tcfail068.hs:19:21:
                  itiap :: Constructed a =>
                           (Int, Int) -> (a -> a) -> IndTree s a -> IndTree s a
       at tcfail068.hs:16:10-75
-      ‛s’ is a rigid type variable bound by
+      ‘s’ is a rigid type variable bound by
           the type signature for
             itiap :: Constructed a =>
                      (Int, Int) -> (a -> a) -> IndTree s a -> IndTree s a
           at tcfail068.hs:16:10
-      ‛s1’ is a rigid type variable bound by
+      ‘s1’ is a rigid type variable bound by
            a type expected by the context: GHC.ST.ST s1 (IndTree s a)
            at tcfail068.hs:18:9
     Expected type: STArray s1 (Int, Int) a
@@ -42,8 +42,8 @@ tcfail068.hs:19:21:
       arr :: IndTree s a (bound at tcfail068.hs:17:11)
       itiap :: (Int, Int) -> (a -> a) -> IndTree s a -> IndTree s a
         (bound at tcfail068.hs:17:1)
-    In the first argument of ‛readSTArray’, namely ‛arr’
-    In the first argument of ‛(>>=)’, namely ‛readSTArray arr i’
+    In the first argument of ‘readSTArray’, namely ‘arr’
+    In the first argument of ‘(>>=)’, namely ‘readSTArray arr i’
 
 tcfail068.hs:24:35:
     Could not deduce (s ~ s1)
@@ -52,12 +52,12 @@ tcfail068.hs:24:35:
                  itrap :: Constructed a =>
                           ((Int, Int), (Int, Int)) -> (a -> a) -> IndTree s a -> IndTree s a
       at tcfail068.hs:23:10-87
-      ‛s’ is a rigid type variable bound by
+      ‘s’ is a rigid type variable bound by
           the type signature for
             itrap :: Constructed a =>
                      ((Int, Int), (Int, Int)) -> (a -> a) -> IndTree s a -> IndTree s a
           at tcfail068.hs:23:10
-      ‛s1’ is a rigid type variable bound by
+      ‘s1’ is a rigid type variable bound by
            a type expected by the context: GHC.ST.ST s1 (IndTree s a)
            at tcfail068.hs:24:29
     Expected type: GHC.ST.ST s1 (IndTree s a)
@@ -71,7 +71,7 @@ tcfail068.hs:24:35:
       itrap :: ((Int, Int), (Int, Int))
                -> (a -> a) -> IndTree s a -> IndTree s a
         (bound at tcfail068.hs:24:1)
-    In the first argument of ‛runST’, namely ‛(itrap' i k)’
+    In the first argument of ‘runST’, namely ‘(itrap' i k)’
     In the expression: runST (itrap' i k)
 
 tcfail068.hs:36:46:
@@ -87,7 +87,7 @@ tcfail068.hs:36:46:
                                -> IndTree s b
                                -> (c, IndTree s b)
       at tcfail068.hs:(34,15)-(35,62)
-      ‛s’ is a rigid type variable bound by
+      ‘s’ is a rigid type variable bound by
           the type signature for
             itrapstate :: Constructed b =>
                           ((Int, Int), (Int, Int))
@@ -98,7 +98,7 @@ tcfail068.hs:36:46:
                           -> IndTree s b
                           -> (c, IndTree s b)
           at tcfail068.hs:34:15
-      ‛s1’ is a rigid type variable bound by
+      ‘s1’ is a rigid type variable bound by
            a type expected by the context: GHC.ST.ST s1 (c, IndTree s b)
            at tcfail068.hs:36:40
     Expected type: GHC.ST.ST s1 (c, IndTree s b)
@@ -117,5 +117,5 @@ tcfail068.hs:36:46:
                     -> IndTree s b
                     -> (c, IndTree s b)
         (bound at tcfail068.hs:36:1)
-    In the first argument of ‛runST’, namely ‛(itrapstate' i k s)’
+    In the first argument of ‘runST’, namely ‘(itrapstate' i k s)’
     In the expression: runST (itrapstate' i k s)
diff --git a/testsuite/tests/typecheck/should_fail/tcfail069.stderr b/testsuite/tests/typecheck/should_fail/tcfail069.stderr
index 7c793c49ba32..195119d26d02 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail069.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail069.stderr
@@ -1,7 +1,7 @@
 
 tcfail069.hs:21:7:
-    Couldn't match expected type ‛([Int], [Int])’
-                with actual type ‛[t0]’
+    Couldn't match expected type ‘([Int], [Int])’
+                with actual type ‘[t0]’
     In the pattern: []
     In a case alternative: [] -> error "foo"
     In the expression: case (list1, list2) of { [] -> error "foo" }
diff --git a/testsuite/tests/typecheck/should_fail/tcfail070.stderr b/testsuite/tests/typecheck/should_fail/tcfail070.stderr
index bc0590aae8f4..d98857de4c9a 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail070.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail070.stderr
@@ -1,5 +1,5 @@
 
 tcfail070.hs:15:15:
-    ‛[Int]’ is applied to too many type arguments
-    In the type ‛[Int] Bool’
-    In the type declaration for ‛State’
+    ‘[Int]’ is applied to too many type arguments
+    In the type ‘[Int] Bool’
+    In the type declaration for ‘State’
diff --git a/testsuite/tests/typecheck/should_fail/tcfail072.stderr b/testsuite/tests/typecheck/should_fail/tcfail072.stderr
index 828de022e611..dc301a8e60f4 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail072.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail072.stderr
@@ -1,16 +1,16 @@
 
 tcfail072.hs:23:13:
-    Could not deduce (Ord q0) arising from a use of ‛g’
+    Could not deduce (Ord q0) arising from a use of ‘g’
     from the context (Ord p, Ord q)
       bound by the type signature for
                  g :: (Ord p, Ord q) => AB p q -> Bool
       at tcfail072.hs:22:6-38
-    The type variable ‛q0’ is ambiguous
+    The type variable ‘q0’ is ambiguous
     Note: there are several potential instances:
       instance Integral a => Ord (GHC.Real.Ratio a)
-        -- Defined in ‛GHC.Real’
-      instance Ord () -- Defined in ‛GHC.Classes’
-      instance (Ord a, Ord b) => Ord (a, b) -- Defined in ‛GHC.Classes’
-      ...plus 23 others
+        -- Defined in ‘GHC.Real’
+      instance Ord () -- Defined in ‘GHC.Classes’
+      instance (Ord a, Ord b) => Ord (a, b) -- Defined in ‘GHC.Classes’
+      ...plus 22 others
     In the expression: g A
-    In an equation for ‛g’: g (B _ _) = g A
+    In an equation for ‘g’: g (B _ _) = g A
diff --git a/testsuite/tests/typecheck/should_fail/tcfail073.stderr b/testsuite/tests/typecheck/should_fail/tcfail073.stderr
index 16bcdf4c0faa..da7f1e4e6d7b 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail073.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail073.stderr
@@ -2,4 +2,4 @@
 tcfail073.hs:8:10:
     Duplicate instance declarations:
       instance Eq a => Eq (a, b) -- Defined at tcfail073.hs:8:10
-      instance (Eq a, Eq b) => Eq (a, b) -- Defined in ‛GHC.Classes’
+      instance (Eq a, Eq b) => Eq (a, b) -- Defined in ‘GHC.Classes’
diff --git a/testsuite/tests/typecheck/should_fail/tcfail076.stderr b/testsuite/tests/typecheck/should_fail/tcfail076.stderr
index d6d23eb9c2b9..b5ad5cd2d6cb 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail076.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail076.stderr
@@ -1,10 +1,10 @@
 
 tcfail076.hs:18:82:
-    Couldn't match type ‛res’ with ‛res1’
-      ‛res’ is a rigid type variable bound by
+    Couldn't match type ‘res’ with ‘res1’
+      ‘res’ is a rigid type variable bound by
             a type expected by the context: (a -> m res) -> m res
             at tcfail076.hs:18:28
-      ‛res1’ is a rigid type variable bound by
+      ‘res1’ is a rigid type variable bound by
              a type expected by the context: (b -> m res1) -> m res1
              at tcfail076.hs:18:64
     Expected type: m res1
@@ -13,4 +13,4 @@ tcfail076.hs:18:82:
       cont' :: b -> m res1 (bound at tcfail076.hs:18:73)
       cont :: a -> m res (bound at tcfail076.hs:18:37)
     In the expression: cont a
-    In the first argument of ‛KContT’, namely ‛(\ cont' -> cont a)’
+    In the first argument of ‘KContT’, namely ‘(\ cont' -> cont a)’
diff --git a/testsuite/tests/typecheck/should_fail/tcfail077.stderr b/testsuite/tests/typecheck/should_fail/tcfail077.stderr
index 3f25950faf46..39ee49db3f0f 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail077.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail077.stderr
@@ -1,2 +1,2 @@
 
-tcfail077.hs:8:3: ‛op2’ is not a (visible) method of class ‛Foo’
+tcfail077.hs:8:3: ‘op2’ is not a (visible) method of class ‘Foo’
diff --git a/testsuite/tests/typecheck/should_fail/tcfail078.stderr b/testsuite/tests/typecheck/should_fail/tcfail078.stderr
index b3fabd30b9c8..9266b951f14b 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail078.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail078.stderr
@@ -1,4 +1,4 @@
 
 tcfail078.hs:5:6:
-    ‛Integer’ is applied to too many type arguments
-    In the type signature for ‛f’: f :: Integer i => i
+    ‘Integer’ is applied to too many type arguments
+    In the type signature for ‘f’: f :: Integer i => i
diff --git a/testsuite/tests/typecheck/should_fail/tcfail079.stderr b/testsuite/tests/typecheck/should_fail/tcfail079.stderr
index 4cce1a69ba6b..125c6f13f6d6 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail079.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail079.stderr
@@ -1,6 +1,6 @@
 
 tcfail079.hs:9:27:
-    Expecting a lifted type, but ‛Int#’ is unlifted
-    In the type ‛Int#’
-    In the definition of data constructor ‛Unboxed’
-    In the newtype declaration for ‛Unboxed’
+    Expecting a lifted type, but ‘Int#’ is unlifted
+    In the type ‘Int#’
+    In the definition of data constructor ‘Unboxed’
+    In the newtype declaration for ‘Unboxed’
diff --git a/testsuite/tests/typecheck/should_fail/tcfail080.stderr b/testsuite/tests/typecheck/should_fail/tcfail080.stderr
index 23afa16ba330..4e02b3e012da 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail080.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail080.stderr
@@ -1,13 +1,11 @@
-
-tcfail080.hs:27:1:
-    Could not deduce (Collection c0 a)
-      arising from the ambiguity check for ‛q’
-    from the context (Collection c a)
-      bound by the inferred type for ‛q’: Collection c a => a -> Bool
-      at tcfail080.hs:27:1-27
-    The type variable ‛c0’ is ambiguous
-    When checking that ‛q’
-      has the inferred type ‛forall (c :: * -> *) a.
-                             Collection c a =>
-                             a -> Bool’
-    Probable cause: the inferred type is ambiguous
+
+tcfail080.hs:27:1:
+    Could not deduce (Collection c0 a)
+      arising from the ambiguity check for ‘q’
+    from the context (Collection c a)
+      bound by the inferred type for ‘q’: Collection c a => a -> Bool
+      at tcfail080.hs:27:1-27
+    The type variable ‘c0’ is ambiguous
+    When checking that ‘q’ has the inferred type
+      q :: forall (c :: * -> *) a. Collection c a => a -> Bool
+    Probable cause: the inferred type is ambiguous
diff --git a/testsuite/tests/typecheck/should_fail/tcfail082.stderr b/testsuite/tests/typecheck/should_fail/tcfail082.stderr
index 11823fe448c3..4e3d6ce99686 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail082.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail082.stderr
@@ -1,12 +1,12 @@
 
 tcfail082.hs:2:1:
-    Failed to load interface for ‛Data82’
+    Failed to load interface for ‘Data82’
     Use -v to see a list of the files searched for.
 
 tcfail082.hs:3:1:
-    Failed to load interface for ‛Inst82_1’
+    Failed to load interface for ‘Inst82_1’
     Use -v to see a list of the files searched for.
 
 tcfail082.hs:4:1:
-    Failed to load interface for ‛Inst82_2’
+    Failed to load interface for ‘Inst82_2’
     Use -v to see a list of the files searched for.
diff --git a/testsuite/tests/typecheck/should_fail/tcfail083.stderr b/testsuite/tests/typecheck/should_fail/tcfail083.stderr
index 8bcd75be638b..badd43909d2e 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail083.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail083.stderr
@@ -1,7 +1,7 @@
 
 tcfail083.hs:8:39:
-    Constructor ‛Bar’ does not have field ‛baz’
+    Constructor ‘Bar’ does not have field ‘baz’
     In the pattern: Bar {flag = f, baz = b}
     In the pattern: State {bar = Bar {flag = f, baz = b}}
-    In an equation for ‛display’:
+    In an equation for ‘display’:
         display (State {bar = Bar {flag = f, baz = b}}) = print (f, b)
diff --git a/testsuite/tests/typecheck/should_fail/tcfail084.stderr b/testsuite/tests/typecheck/should_fail/tcfail084.stderr
index cfa0ff4835e0..df09cd91bed6 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail084.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail084.stderr
@@ -1,5 +1,5 @@
 
 tcfail084.hs:10:5:
-    Constructor ‛F’ does not have field ‛y’
+    Constructor ‘F’ does not have field ‘y’
     In the expression: F {y = 2}
-    In an equation for ‛z’: z = F {y = 2}
+    In an equation for ‘z’: z = F {y = 2}
diff --git a/testsuite/tests/typecheck/should_fail/tcfail085.stderr b/testsuite/tests/typecheck/should_fail/tcfail085.stderr
index feb7c6daf31a..6c2e9bd9138a 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail085.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail085.stderr
@@ -1,5 +1,5 @@
 
 tcfail085.hs:9:5:
-    Constructor ‛F’ does not have the required strict field(s): y
+    Constructor ‘F’ does not have the required strict field(s): y
     In the expression: F {x = 2}
-    In an equation for ‛z’: z = F {x = 2}
+    In an equation for ‘z’: z = F {x = 2}
diff --git a/testsuite/tests/typecheck/should_fail/tcfail086.stderr b/testsuite/tests/typecheck/should_fail/tcfail086.stderr
index ebf4d4e8e6e4..f88fde164b50 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail086.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail086.stderr
@@ -1,6 +1,6 @@
 
 tcfail086.hs:6:38:
-    Can't make a derived instance of ‛Eq Ex’:
-      Constructor ‛Ex’ must have a Haskell-98 type
+    Can't make a derived instance of ‘Eq Ex’:
+      Constructor ‘Ex’ has existentials or constraints in its type
       Possible fix: use a standalone deriving declaration instead
-    In the data declaration for ‛Ex’
+    In the data declaration for ‘Ex’
diff --git a/testsuite/tests/typecheck/should_fail/tcfail088.stderr b/testsuite/tests/typecheck/should_fail/tcfail088.stderr
index 1c303d9a653d..d9cd5427b7e3 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail088.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail088.stderr
@@ -1,4 +1,4 @@
 
 tcfail088.hs:9:19:
     Illegal polymorphic or qualified type: forall s. T s a
-    In the instance declaration for ‛Ord (forall s. T s a)’
+    In the instance declaration for ‘Ord (forall s. T s a)’
diff --git a/testsuite/tests/typecheck/should_fail/tcfail090.stderr b/testsuite/tests/typecheck/should_fail/tcfail090.stderr
index 1b93cba9c77e..c4a8a31b60d6 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail090.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail090.stderr
@@ -4,4 +4,4 @@ tcfail090.hs:11:9:
       a0 :: *
       ByteArray# :: #
     In the expression: my_undefined
-    In an equation for ‛die’: die _ = my_undefined
+    In an equation for ‘die’: die _ = my_undefined
diff --git a/testsuite/tests/typecheck/should_fail/tcfail092.stderr b/testsuite/tests/typecheck/should_fail/tcfail092.stderr
index d1079d879e4d..68f94ea7d985 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail092.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail092.stderr
@@ -1,3 +1,3 @@
 
 tcfail092.hs:7:27:
-    Duplicate binding in parallel list comprehension for: ‛a’
+    Duplicate binding in parallel list comprehension for: ‘a’
diff --git a/testsuite/tests/typecheck/should_fail/tcfail093.hs b/testsuite/tests/typecheck/should_fail/tcfail093.hs
index 9c2d8ea80a10..1f2063a1c263 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail093.hs
+++ b/testsuite/tests/typecheck/should_fail/tcfail093.hs
@@ -1,5 +1,5 @@
 {-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies,
-             FlexibleInstances, UndecidableInstances #-}
+             FlexibleInstances, UndecidableInstances, FlexibleContexts #-}
 -- UndecidableInstances now needed because the Coverage Condition fails
 
 module ShouldFail where
diff --git a/testsuite/tests/typecheck/should_fail/tcfail097.stderr b/testsuite/tests/typecheck/should_fail/tcfail097.stderr
index 4d5d40c8d3d8..cbd5612b96b8 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail097.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail097.stderr
@@ -1,10 +1,10 @@
 
 tcfail097.hs:5:6:
-    Could not deduce (Eq a0) arising from the ambiguity check for ‛f’
+    Could not deduce (Eq a0) arising from the ambiguity check for ‘f’
     from the context (Eq a)
       bound by the type signature for f :: Eq a => Int -> Int
       at tcfail097.hs:5:6-23
-    The type variable ‛a0’ is ambiguous
+    The type variable ‘a0’ is ambiguous
     In the ambiguity check for: forall a. Eq a => Int -> Int
     To defer the ambiguity check to use sites, enable AllowAmbiguousTypes
-    In the type signature for ‛f’: f :: Eq a => Int -> Int
+    In the type signature for ‘f’: f :: Eq a => Int -> Int
diff --git a/testsuite/tests/typecheck/should_fail/tcfail098.stderr b/testsuite/tests/typecheck/should_fail/tcfail098.stderr
index 15d33b12451a..94ade759464e 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail098.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail098.stderr
@@ -5,7 +5,7 @@ tcfail098.hs:12:10:
     from the context (Bar a)
       bound by an instance declaration: Bar a => Bar Bool
       at tcfail098.hs:12:10-26
-    The type variable ‛a0’ is ambiguous
+    The type variable ‘a0’ is ambiguous
     In the ambiguity check for: forall a. Bar a => Bar Bool
     To defer the ambiguity check to use sites, enable AllowAmbiguousTypes
-    In the instance declaration for ‛Bar Bool’
+    In the instance declaration for ‘Bar Bool’
diff --git a/testsuite/tests/typecheck/should_fail/tcfail099.stderr b/testsuite/tests/typecheck/should_fail/tcfail099.stderr
index 73293eb6b65e..7b1f5bc0e0af 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail099.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail099.stderr
@@ -1,15 +1,15 @@
 
 tcfail099.hs:9:20:
-    Couldn't match expected type ‛a’ with actual type ‛t’
-      because type variable ‛a’ would escape its scope
+    Couldn't match expected type ‘a’ with actual type ‘t’
+      because type variable ‘a’ would escape its scope
     This (rigid, skolem) type variable is bound by
       a pattern with constructor
         C :: forall a. (a -> Int) -> DS,
-      in an equation for ‛call’
+      in an equation for ‘call’
       at tcfail099.hs:9:7-9
     Relevant bindings include
       arg :: t (bound at tcfail099.hs:9:12)
       f :: a -> Int (bound at tcfail099.hs:9:9)
       call :: DS -> t -> Int (bound at tcfail099.hs:9:1)
-    In the first argument of ‛f’, namely ‛arg’
+    In the first argument of ‘f’, namely ‘arg’
     In the expression: f arg
diff --git a/testsuite/tests/typecheck/should_fail/tcfail100.stderr b/testsuite/tests/typecheck/should_fail/tcfail100.stderr
index 1e780767012a..c2bf429fd6f5 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail100.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail100.stderr
@@ -1,4 +1,4 @@
 
 tcfail100.hs:7:1:
-    Type synonym ‛A’ should have 1 argument, but has been given none
-    In the type declaration for ‛B’
+    Type synonym ‘A’ should have 1 argument, but has been given none
+    In the type declaration for ‘B’
diff --git a/testsuite/tests/typecheck/should_fail/tcfail101.stderr b/testsuite/tests/typecheck/should_fail/tcfail101.stderr
index f9b3f2f71f9c..ddf8e433f038 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail101.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail101.stderr
@@ -1,4 +1,4 @@
 
 tcfail101.hs:9:6:
-    Type synonym ‛A’ should have 1 argument, but has been given none
-    In the type signature for ‛f’: f :: T A
+    Type synonym ‘A’ should have 1 argument, but has been given none
+    In the type signature for ‘f’: f :: T A
diff --git a/testsuite/tests/typecheck/should_fail/tcfail102.stderr b/testsuite/tests/typecheck/should_fail/tcfail102.stderr
index 1009fb4ccae6..01a8bba99a11 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail102.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail102.stderr
@@ -3,11 +3,11 @@ tcfail102.hs:1:14: Warning:
     -XDatatypeContexts is deprecated: It was widely considered a misfeature, and has been removed from the Haskell language.
 
 tcfail102.hs:9:15:
-    Could not deduce (Integral (Ratio a)) arising from a use of ‛p’
+    Could not deduce (Integral (Ratio a)) arising from a use of ‘p’
     from the context (Integral a)
       bound by the type signature for
                  f :: Integral a => P (Ratio a) -> P (Ratio a)
       at tcfail102.hs:8:6-45
-    In the ‛p’ field of a record
+    In the ‘p’ field of a record
     In the expression: x {p = p x}
-    In an equation for ‛f’: f x = x {p = p x}
+    In an equation for ‘f’: f x = x {p = p x}
diff --git a/testsuite/tests/typecheck/should_fail/tcfail103.stderr b/testsuite/tests/typecheck/should_fail/tcfail103.stderr
index 4f1315331d0f..1d71a6aa9a3f 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail103.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail103.stderr
@@ -1,9 +1,9 @@
 
 tcfail103.hs:15:23:
-    Couldn't match type ‛t’ with ‛s’
-      ‛t’ is a rigid type variable bound by
+    Couldn't match type ‘t’ with ‘s’
+      ‘t’ is a rigid type variable bound by
           the type signature for f :: ST t Int at tcfail103.hs:10:5
-      ‛s’ is a rigid type variable bound by
+      ‘s’ is a rigid type variable bound by
           the type signature for g :: ST s Int at tcfail103.hs:13:14
     Expected type: STRef s Int
       Actual type: STRef t Int
@@ -11,5 +11,5 @@ tcfail103.hs:15:23:
       g :: ST s Int (bound at tcfail103.hs:15:9)
       v :: STRef t Int (bound at tcfail103.hs:12:5)
       f :: ST t Int (bound at tcfail103.hs:11:1)
-    In the first argument of ‛readSTRef’, namely ‛v’
+    In the first argument of ‘readSTRef’, namely ‘v’
     In the expression: readSTRef v
diff --git a/testsuite/tests/typecheck/should_fail/tcfail104.stderr b/testsuite/tests/typecheck/should_fail/tcfail104.stderr
index ea41dfad92f8..cb14d9af267b 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail104.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail104.stderr
@@ -1,12 +1,12 @@
 
 tcfail104.hs:16:19:
-    Couldn't match expected type ‛Char -> Char’
-                with actual type ‛forall a. a -> a’
+    Couldn't match expected type ‘Char -> Char’
+                with actual type ‘forall a. a -> a’
     In the expression: x
     In the expression: (\ x -> x)
 
 tcfail104.hs:22:39:
-    Couldn't match expected type ‛forall a. a -> a’
-                with actual type ‛a0 -> a0’
+    Couldn't match expected type ‘forall a. a -> a’
+                with actual type ‘a0 -> a0’
     In the expression: x
     In the expression: (\ (x :: forall a. a -> a) -> x)
diff --git a/testsuite/tests/typecheck/should_fail/tcfail106.stderr b/testsuite/tests/typecheck/should_fail/tcfail106.stderr
index 2eeaf7197970..8d8d1a61d8a2 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail106.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail106.stderr
@@ -2,4 +2,4 @@
 tcfail106.hs:14:10:
     No instance for (S Int)
       arising from the superclasses of an instance declaration
-    In the instance declaration for ‛D Int’
+    In the instance declaration for ‘D Int’
diff --git a/testsuite/tests/typecheck/should_fail/tcfail107.stderr b/testsuite/tests/typecheck/should_fail/tcfail107.stderr
index b658814776eb..43d0c2d1fd35 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail107.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail107.stderr
@@ -1,5 +1,5 @@
 
 tcfail107.hs:13:9:
-    Type synonym ‛Const’ should have 2 arguments, but has been given 1
-    In the type signature for ‛test’:
+    Type synonym ‘Const’ should have 2 arguments, but has been given 1
+    In the type signature for ‘test’:
       test :: Thing (Const Int) -> Thing (Const Int)
diff --git a/testsuite/tests/typecheck/should_fail/tcfail108.stderr b/testsuite/tests/typecheck/should_fail/tcfail108.stderr
index e1b8c71824e0..490640f74b9d 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail108.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail108.stderr
@@ -4,4 +4,4 @@ tcfail108.hs:7:10:
     (Use FlexibleContexts to permit this)
     In the context: (Eq (f (Rec f)))
     While checking an instance declaration
-    In the instance declaration for ‛Eq (Rec f)’
+    In the instance declaration for ‘Eq (Rec f)’
diff --git a/testsuite/tests/typecheck/should_fail/tcfail109.stderr b/testsuite/tests/typecheck/should_fail/tcfail109.stderr
index 4b5960718670..ce8011a5e749 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail109.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail109.stderr
@@ -2,4 +2,4 @@
 tcfail109.hs:16:10:
     No instance for (Eq Stupid)
       arising from the superclasses of an instance declaration
-    In the instance declaration for ‛Collects Bool Stupid’
+    In the instance declaration for ‘Collects Bool Stupid’
diff --git a/testsuite/tests/typecheck/should_fail/tcfail110.stderr b/testsuite/tests/typecheck/should_fail/tcfail110.stderr
index 840dc29deea3..cb60a79d9338 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail110.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail110.stderr
@@ -1,6 +1,6 @@
 
 tcfail110.hs:8:30:
-    Expecting one more argument to ‛Foo a’
-    Expected a type, but ‛Foo a’ has kind ‛* -> *’
-    In the type signature for ‛bar’:
+    Expecting one more argument to ‘Foo a’
+    Expected a type, but ‘Foo a’ has kind ‘* -> *’
+    In the type signature for ‘bar’:
       bar :: String -> (forall a. Foo a) -> IO ()
diff --git a/testsuite/tests/typecheck/should_fail/tcfail112.stderr b/testsuite/tests/typecheck/should_fail/tcfail112.stderr
index 70cd77bca3a2..a90cdfefe613 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail112.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail112.stderr
@@ -1,15 +1,15 @@
 
 tcfail112.hs:11:6:
-    Constructor ‛S’ does not have the required strict field(s): y
+    Constructor ‘S’ does not have the required strict field(s): y
     In the expression: S {}
-    In an equation for ‛s1’: s1 = S {}
+    In an equation for ‘s1’: s1 = S {}
 
 tcfail112.hs:12:6:
-    Constructor ‛S’ does not have the required strict field(s): y
+    Constructor ‘S’ does not have the required strict field(s): y
     In the expression: S {x = 3}
-    In an equation for ‛s2’: s2 = S {x = 3}
+    In an equation for ‘s2’: s2 = S {x = 3}
 
 tcfail112.hs:14:6:
-    Constructor ‛T’ does not have the required strict field(s)
+    Constructor ‘T’ does not have the required strict field(s)
     In the expression: T {}
-    In an equation for ‛t’: t = T {}
+    In an equation for ‘t’: t = T {}
diff --git a/testsuite/tests/typecheck/should_fail/tcfail113.stderr b/testsuite/tests/typecheck/should_fail/tcfail113.stderr
index f9314f5dcc38..8584008cd3b4 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail113.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail113.stderr
@@ -1,14 +1,14 @@
 
 tcfail113.hs:12:7:
-    Expecting one more argument to ‛Maybe’
-    Expected kind ‛*’, but ‛Maybe’ has kind ‛* -> *’
-    In the type signature for ‛f’: f :: [Maybe]
+    Expecting one more argument to ‘Maybe’
+    Expected kind ‘*’, but ‘Maybe’ has kind ‘* -> *’
+    In the type signature for ‘f’: f :: [Maybe]
 
 tcfail113.hs:15:8:
-    The first argument of ‛T’ should have kind ‛* -> *’,
-      but ‛Int’ has kind ‛*’
-    In the type signature for ‛g’: g :: T Int
+    The first argument of ‘T’ should have kind ‘* -> *’,
+      but ‘Int’ has kind ‘*’
+    In the type signature for ‘g’: g :: T Int
 
 tcfail113.hs:18:6:
-    ‛Int’ is applied to too many type arguments
-    In the type signature for ‛h’: h :: Int Int
+    ‘Int’ is applied to too many type arguments
+    In the type signature for ‘h’: h :: Int Int
diff --git a/testsuite/tests/typecheck/should_fail/tcfail114.stderr b/testsuite/tests/typecheck/should_fail/tcfail114.stderr
index 41c8a65cec06..0ba84aad7149 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail114.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail114.stderr
@@ -1,5 +1,5 @@
 
 tcfail114.hs:11:20:
-    ‛foo’ is not a record selector
+    ‘foo’ is not a record selector
     In the expression: undefined {foo = ()}
-    In an equation for ‛test’: test = undefined {foo = ()}
+    In an equation for ‘test’: test = undefined {foo = ()}
diff --git a/testsuite/tests/typecheck/should_fail/tcfail116.stderr b/testsuite/tests/typecheck/should_fail/tcfail116.stderr
index d49438dd97ad..0136173201d1 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail116.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail116.stderr
@@ -1,6 +1,6 @@
 
 tcfail116.hs:5:1:
-    The class method ‛bug’
-    mentions none of the type variables of the class Foo a
+    The class method ‘bug’
+    mentions none of the type or kind variables of the class ‘Foo a’
     When checking the class method: bug :: ()
-    In the class declaration for ‛Foo’
+    In the class declaration for ‘Foo’
diff --git a/testsuite/tests/typecheck/should_fail/tcfail117.stderr b/testsuite/tests/typecheck/should_fail/tcfail117.stderr
index 3f2248a61fa7..e35a2581c847 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail117.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail117.stderr
@@ -1,13 +1,13 @@
 
 tcfail117.hs:5:32:
-    Can't make a derived instance of ‛Enum N1’:
-      ‛N1’ must be an enumeration type
+    Can't make a derived instance of ‘Enum N1’:
+      ‘N1’ must be an enumeration type
       (an enumeration consists of one or more nullary, non-GADT constructors)
       Try GeneralizedNewtypeDeriving for GHC's newtype-deriving extension
-    In the newtype declaration for ‛N1’
+    In the newtype declaration for ‘N1’
 
 tcfail117.hs:6:32:
-    Can't make a derived instance of ‛Enum N2’:
-      ‛N2’ must be an enumeration type
+    Can't make a derived instance of ‘Enum N2’:
+      ‘N2’ must be an enumeration type
       (an enumeration consists of one or more nullary, non-GADT constructors)
-    In the data declaration for ‛N2’
+    In the data declaration for ‘N2’
diff --git a/testsuite/tests/typecheck/should_fail/tcfail118.stderr b/testsuite/tests/typecheck/should_fail/tcfail118.stderr
index 01f6654c9d4a..098af7973665 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail118.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail118.stderr
@@ -1,7 +1,7 @@
 
 tcfail118.hs:10:29:
     Overlapping instances for Eq Foo
-      arising from the first field of ‛Bar’ (type ‛Foo’)
+      arising from the first field of ‘Bar’ (type ‘Foo’)
     Matching instances:
       instance Eq Foo -- Defined at tcfail118.hs:11:25
       instance Eq Foo -- Defined at tcfail118.hs:13:10
diff --git a/testsuite/tests/typecheck/should_fail/tcfail119.stderr b/testsuite/tests/typecheck/should_fail/tcfail119.stderr
index 45a1bc7707c0..5c22aefc4e63 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail119.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail119.stderr
@@ -1,5 +1,5 @@
 
 tcfail119.hs:11:8:
-    Couldn't match expected type ‛Bool’ with actual type ‛[Char]’
+    Couldn't match expected type ‘Bool’ with actual type ‘[Char]’
     In the pattern: "Foo"
-    In an equation for ‛b’: b x "Foo" = ()
+    In an equation for ‘b’: b x "Foo" = ()
diff --git a/testsuite/tests/typecheck/should_fail/tcfail121.hs b/testsuite/tests/typecheck/should_fail/tcfail121.hs
index 86c2a92c5c76..84966c4e7e92 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail121.hs
+++ b/testsuite/tests/typecheck/should_fail/tcfail121.hs
@@ -1,13 +1,13 @@
 
-{-# LANGUAGE OverlappingInstances, FlexibleInstances #-}
+{-# LANGUAGE FlexibleInstances #-}
 
 module ShouldFail where
 
 class Foo a where
   op :: a -> a
 
-instance Foo a => Foo [a] 
-instance Foo [Int]
+instance {-# OVERLAPPABLE #-} Foo a => Foo [a] 
+instance {-# OVERLAPPING #-} Foo [Int]
 
 foo :: Foo a => [a] -> [a]
 foo x = op x
diff --git a/testsuite/tests/typecheck/should_fail/tcfail121.stderr b/testsuite/tests/typecheck/should_fail/tcfail121.stderr
index abad2d420672..dc0679edcaec 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail121.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail121.stderr
@@ -1,12 +1,12 @@
 
 tcfail121.hs:13:9:
-    Overlapping instances for Foo [a] arising from a use of ‛op’
+    Overlapping instances for Foo [a] arising from a use of ‘op’
     Matching instances:
-      instance [overlap ok] Foo a => Foo [a]
-        -- Defined at tcfail121.hs:9:10
-      instance [overlap ok] Foo [Int] -- Defined at tcfail121.hs:10:10
-    (The choice depends on the instantiation of ‛a’
+      instance [overlappable] Foo a => Foo [a]
+        -- Defined at tcfail121.hs:9:31
+      instance [overlapping] Foo [Int] -- Defined at tcfail121.hs:10:30
+    (The choice depends on the instantiation of ‘a’
      To pick the first instance above, use IncoherentInstances
      when compiling the other instance declarations)
     In the expression: op x
-    In an equation for ‛foo’: foo x = op x
+    In an equation for ‘foo’: foo x = op x
diff --git a/testsuite/tests/typecheck/should_fail/tcfail122.stderr b/testsuite/tests/typecheck/should_fail/tcfail122.stderr
index 901ceb84d18e..b643d585a81e 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail122.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail122.stderr
@@ -11,7 +11,7 @@ tcfail122.hs:8:9:
     In the expression:
       [undefined :: forall a b. a b,
        undefined :: forall (c :: (* -> *) -> *) (d :: * -> *). c d]
-    In an equation for ‛foo’:
+    In an equation for ‘foo’:
         foo
           = [undefined :: forall a b. a b,
              undefined :: forall (c :: (* -> *) -> *) (d :: * -> *). c d]
diff --git a/testsuite/tests/typecheck/should_fail/tcfail123.stderr b/testsuite/tests/typecheck/should_fail/tcfail123.stderr
index 510d1db49009..1fcb62d1a300 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail123.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail123.stderr
@@ -3,6 +3,6 @@ tcfail123.hs:11:9:
     Kind incompatibility when matching types:
       t0 :: *
       GHC.Prim.Int# :: #
-    In the first argument of ‛f’, namely ‛3#’
+    In the first argument of ‘f’, namely ‘3#’
     In the expression: f 3#
-    In an equation for ‛h’: h v = f 3#
+    In an equation for ‘h’: h v = f 3#
diff --git a/testsuite/tests/typecheck/should_fail/tcfail125.stderr b/testsuite/tests/typecheck/should_fail/tcfail125.stderr
index 592698f7d43a..b3e0720f79ef 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail125.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail125.stderr
@@ -3,9 +3,9 @@ tcfail125.hs:1:14: Warning:
     -XDatatypeContexts is deprecated: It was widely considered a misfeature, and has been removed from the Haskell language.
 
 tcfail125.hs:11:4:
-    No instance for (Show a) arising from a use of ‛LiftObs’
+    No instance for (Show a) arising from a use of ‘LiftObs’
     Possible fix:
       add (Show a) to the context of
         the type signature for f :: Obs a -> String
     In the pattern: LiftObs _ _
-    In an equation for ‛f’: f (LiftObs _ _) = "yes"
+    In an equation for ‘f’: f (LiftObs _ _) = "yes"
diff --git a/testsuite/tests/typecheck/should_fail/tcfail127.stderr b/testsuite/tests/typecheck/should_fail/tcfail127.stderr
index fb91cfb90db3..d05a234010a8 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail127.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail127.stderr
@@ -2,4 +2,4 @@
 tcfail127.hs:3:8:
     Illegal polymorphic or qualified type: Num a => a -> a
     Perhaps you intended to use ImpredicativeTypes
-    In the type signature for ‛foo’: foo :: IO (Num a => a -> a)
+    In the type signature for ‘foo’: foo :: IO (Num a => a -> a)
diff --git a/testsuite/tests/typecheck/should_fail/tcfail128.stderr b/testsuite/tests/typecheck/should_fail/tcfail128.stderr
index 38ae102d9925..b33dffb289f0 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail128.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail128.stderr
@@ -1,11 +1,11 @@
 
 tcfail128.hs:18:16:
     No instance for (Data.Array.Base.MArray b0 FlatVector IO)
-      arising from a use of ‛thaw’
-    The type variable ‛b0’ is ambiguous
+      arising from a use of ‘thaw’
+    The type variable ‘b0’ is ambiguous
     Note: there is a potential instance available:
       instance Data.Array.Base.MArray GHC.IOArray.IOArray e IO
-        -- Defined in ‛Data.Array.Base’
+        -- Defined in ‘Data.Array.Base’
     In a stmt of a 'do' block: v <- thaw tmp
     In the expression:
       do { let sL = ...
@@ -13,7 +13,7 @@ tcfail128.hs:18:16:
                ....;
            v <- thaw tmp;
            return () }
-    In an equation for ‛main’:
+    In an equation for ‘main’:
         main
           = do { let sL = ...
                      ....;
diff --git a/testsuite/tests/typecheck/should_fail/tcfail129.stderr b/testsuite/tests/typecheck/should_fail/tcfail129.stderr
index 0bffcbf76fdc..2c1b4bfb72da 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail129.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail129.stderr
@@ -1,12 +1,12 @@
 
 tcfail129.hs:12:21:
-    Type synonym ‛Foo’ should have 1 argument, but has been given none
+    Type synonym ‘Foo’ should have 1 argument, but has been given none
     In an expression type signature: Bar Foo
     In the expression: undefined :: Bar Foo
-    In an equation for ‛blah’: blah = undefined :: Bar Foo
+    In an equation for ‘blah’: blah = undefined :: Bar Foo
 
 tcfail129.hs:17:22:
-    Type synonym ‛Foo1’ should have 1 argument, but has been given none
+    Type synonym ‘Foo1’ should have 1 argument, but has been given none
     In an expression type signature: Bar1 Foo1
     In the expression: undefined :: Bar1 Foo1
-    In an equation for ‛blah1’: blah1 = undefined :: Bar1 Foo1
+    In an equation for ‘blah1’: blah1 = undefined :: Bar1 Foo1
diff --git a/testsuite/tests/typecheck/should_fail/tcfail130.stderr b/testsuite/tests/typecheck/should_fail/tcfail130.stderr
index 37f3614b5f74..8e71045bef27 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail130.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail130.stderr
@@ -1,5 +1,5 @@
 
 tcfail130.hs:10:7:
-    Unbound implicit parameter (?x::Int) arising from a use of ‛woggle’
+    Unbound implicit parameter (?x::Int) arising from a use of ‘woggle’
     In the expression: woggle 3
-    In an equation for ‛foo’: foo = woggle 3
+    In an equation for ‘foo’: foo = woggle 3
diff --git a/testsuite/tests/typecheck/should_fail/tcfail131.stderr b/testsuite/tests/typecheck/should_fail/tcfail131.stderr
index da75512b9e0e..41e8af681fa2 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail131.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail131.stderr
@@ -4,10 +4,10 @@ tcfail131.hs:7:9:
     from the context (Num b)
       bound by the type signature for g :: Num b => b -> b
       at tcfail131.hs:6:8-22
-      ‛b’ is a rigid type variable bound by
+      ‘b’ is a rigid type variable bound by
           the type signature for g :: Num b => b -> b at tcfail131.hs:6:8
     Relevant bindings include
       x :: b (bound at tcfail131.hs:7:5)
       g :: b -> b (bound at tcfail131.hs:7:3)
     In the expression: f x x
-    In an equation for ‛g’: g x = f x x
+    In an equation for ‘g’: g x = f x x
diff --git a/testsuite/tests/typecheck/should_fail/tcfail132.stderr b/testsuite/tests/typecheck/should_fail/tcfail132.stderr
index 8440cc89abbb..16fee3fbb4a3 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail132.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail132.stderr
@@ -1,6 +1,6 @@
 
 tcfail132.hs:17:37:
-    The first argument of ‛T’ should have kind ‛* -> * -> * -> *’,
-      but ‛Object f' f t’ has kind ‛* -> * -> *’
-    In the type ‛T (Object f' f t) (DUnit t)’
-    In the type declaration for ‛LiftObject’
+    The first argument of ‘T’ should have kind ‘* -> * -> * -> *’,
+      but ‘Object f' f t’ has kind ‘* -> * -> *’
+    In the type ‘T (Object f' f t) (DUnit t)’
+    In the type declaration for ‘LiftObject’
diff --git a/testsuite/tests/typecheck/should_fail/tcfail133.stderr b/testsuite/tests/typecheck/should_fail/tcfail133.stderr
index 1d840d46246c..b23b9447aece 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail133.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail133.stderr
@@ -3,24 +3,24 @@ tcfail133.hs:2:61: Warning:
     -XDatatypeContexts is deprecated: It was widely considered a misfeature, and has been removed from the Haskell language.
 
 tcfail133.hs:68:7:
-    No instance for (Show s0) arising from a use of ‛show’
-    The type variable ‛s0’ is ambiguous
+    No instance for (Show s0) arising from a use of ‘show’
+    The type variable ‘s0’ is ambiguous
     Note: there are several potential instances:
       instance Show Zero -- Defined at tcfail133.hs:8:29
       instance Show One -- Defined at tcfail133.hs:9:28
       instance (Show a, Show b, Number a, Digit b) => Show (a :@ b)
         -- Defined at tcfail133.hs:11:54
-      ...plus 27 others
+      ...plus 26 others
     In the expression: show
     In the expression: show $ add (One :@ Zero) (One :@ One)
-    In an equation for ‛foo’:
+    In an equation for ‘foo’:
         foo = show $ add (One :@ Zero) (One :@ One)
 
 tcfail133.hs:68:14:
     No instance for (AddDigit (Zero :@ (One :@ One)) One s0)
-      arising from a use of ‛add’
-    In the second argument of ‛($)’, namely
-      ‛add (One :@ Zero) (One :@ One)’
+      arising from a use of ‘add’
+    In the second argument of ‘($)’, namely
+      ‘add (One :@ Zero) (One :@ One)’
     In the expression: show $ add (One :@ Zero) (One :@ One)
-    In an equation for ‛foo’:
+    In an equation for ‘foo’:
         foo = show $ add (One :@ Zero) (One :@ One)
diff --git a/testsuite/tests/typecheck/should_fail/tcfail134.stderr b/testsuite/tests/typecheck/should_fail/tcfail134.stderr
index 7ba962009227..b73d2f38a997 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail134.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail134.stderr
@@ -1,6 +1,6 @@
 
 tcfail134.hs:5:33:
-    Expecting one more argument to ‛XML’
-    Expected a type, but ‛XML’ has kind ‛* -> Constraint’
-    In the type ‛a -> XML’
-    In the class declaration for ‛XML’
+    Expecting one more argument to ‘XML’
+    Expected a type, but ‘XML’ has kind ‘* -> Constraint’
+    In the type ‘a -> XML’
+    In the class declaration for ‘XML’
diff --git a/testsuite/tests/typecheck/should_fail/tcfail135.stderr b/testsuite/tests/typecheck/should_fail/tcfail135.stderr
index 33712e3a9867..251284365cab 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail135.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail135.stderr
@@ -1,6 +1,6 @@
 
 tcfail135.hs:6:23:
-    Expecting one more argument to ‛f’
-    Expected a type, but ‛f’ has kind ‛k0 -> *’
-    In the type ‛f a -> f’
-    In the class declaration for ‛Foo’
+    Expecting one more argument to ‘f’
+    Expected a type, but ‘f’ has kind ‘k0 -> *’
+    In the type ‘f a -> f’
+    In the class declaration for ‘Foo’
diff --git a/testsuite/tests/typecheck/should_fail/tcfail136.stderr b/testsuite/tests/typecheck/should_fail/tcfail136.stderr
index c2cb9d9cf81d..3d6a520c91fa 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail136.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail136.stderr
@@ -1,7 +1,7 @@
 
 tcfail136.hs:9:35:
-    Expecting one more argument to ‛SymDict’
-    Expected a type, but ‛SymDict’ has kind ‛* -> *’
-    In the type ‛SymDict’
-    In the definition of data constructor ‛SymTable’
-    In the data declaration for ‛SymTable’
+    Expecting one more argument to ‘SymDict’
+    Expected a type, but ‘SymDict’ has kind ‘* -> *’
+    In the type ‘SymDict’
+    In the definition of data constructor ‘SymTable’
+    In the data declaration for ‘SymTable’
diff --git a/testsuite/tests/typecheck/should_fail/tcfail137.stderr b/testsuite/tests/typecheck/should_fail/tcfail137.stderr
index 05890e0b7d3d..520dcdcc4008 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail137.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail137.stderr
@@ -3,6 +3,6 @@ tcfail137.hs:1:14: Warning:
     -XDatatypeContexts is deprecated: It was widely considered a misfeature, and has been removed from the Haskell language.
 
 tcfail137.hs:8:5:
-    No instance for (Floating Bool) arising from a use of ‛Test’
+    No instance for (Floating Bool) arising from a use of ‘Test’
     In the expression: Test [False, True]
-    In an equation for ‛x’: x = Test [False, True]
+    In an equation for ‘x’: x = Test [False, True]
diff --git a/testsuite/tests/typecheck/should_fail/tcfail139.stderr b/testsuite/tests/typecheck/should_fail/tcfail139.stderr
index 731181ef7116..e97ff3bf8a06 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail139.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail139.stderr
@@ -1,7 +1,7 @@
 
 tcfail139.hs:6:10:
-    Illegal instance declaration for ‛Bounded Foo’
+    Illegal instance declaration for ‘Bounded Foo’
       (All instance types must be of the form (T t1 ... tn)
        where T is not a synonym.
        Use TypeSynonymInstances if you want to disable this.)
-    In the instance declaration for ‛Bounded Foo’
+    In the instance declaration for ‘Bounded Foo’
diff --git a/testsuite/tests/typecheck/should_fail/tcfail140.stderr b/testsuite/tests/typecheck/should_fail/tcfail140.stderr
index 2ed025a87076..7593497fe280 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail140.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail140.stderr
@@ -1,38 +1,38 @@
-
-tcfail140.hs:10:7:
-    Couldn't match expected type ‛a0 -> t’ with actual type ‛Int’
-    Relevant bindings include bar :: t (bound at tcfail140.hs:10:1)
-    The function ‛f’ is applied to two arguments,
-    but its type ‛Int -> Int’ has only one
-    In the expression: f 3 9
-    In an equation for ‛bar’: bar = f 3 9
-
-tcfail140.hs:12:10:
-    Couldn't match expected type ‛a1 -> t1’ with actual type ‛Int’
-    Relevant bindings include
-      rot :: t -> t1 (bound at tcfail140.hs:12:1)
-    The operator ‛f’ takes two arguments,
-    but its type ‛Int -> Int’ has only one
-    In the expression: 3 `f` 4
-    In an equation for ‛rot’: rot xs = 3 `f` 4
-
-tcfail140.hs:14:15:
-    Couldn't match expected type ‛a -> b’ with actual type ‛Int’
-    Relevant bindings include
-      xs :: [a] (bound at tcfail140.hs:14:5)
-      bot :: [a] -> [b] (bound at tcfail140.hs:14:1)
-    The operator ‛f’ takes two arguments,
-    but its type ‛Int -> Int’ has only one
-    In the first argument of ‛map’, namely ‛(3 `f`)’
-    In the expression: map (3 `f`) xs
-
-tcfail140.hs:16:8:
-    Constructor ‛Just’ should have 1 argument, but has been given none
-    In the pattern: Just
-    In the expression: (\ Just x -> x) :: Maybe a -> a
-    In the expression: ((\ Just x -> x) :: Maybe a -> a) (Just 1)
-
-tcfail140.hs:19:1:
-    Couldn't match expected type ‛t0 -> Bool’ with actual type ‛Int’
-    The equation(s) for ‛g’ have two arguments,
-    but its type ‛Int -> Int’ has only one
+
+tcfail140.hs:10:7:
+    Couldn't match expected type ‘Integer -> t’ with actual type ‘Int’
+    Relevant bindings include bar :: t (bound at tcfail140.hs:10:1)
+    The function ‘f’ is applied to two arguments,
+    but its type ‘Int -> Int’ has only one
+    In the expression: f 3 9
+    In an equation for ‘bar’: bar = f 3 9
+
+tcfail140.hs:12:10:
+    Couldn't match expected type ‘Integer -> t1’ with actual type ‘Int’
+    Relevant bindings include
+      rot :: t -> t1 (bound at tcfail140.hs:12:1)
+    The operator ‘f’ takes two arguments,
+    but its type ‘Int -> Int’ has only one
+    In the expression: 3 `f` 4
+    In an equation for ‘rot’: rot xs = 3 `f` 4
+
+tcfail140.hs:14:15:
+    Couldn't match expected type ‘a -> b’ with actual type ‘Int’
+    Relevant bindings include
+      xs :: [a] (bound at tcfail140.hs:14:5)
+      bot :: [a] -> [b] (bound at tcfail140.hs:14:1)
+    The operator ‘f’ takes two arguments,
+    but its type ‘Int -> Int’ has only one
+    In the first argument of ‘map’, namely ‘(3 `f`)’
+    In the expression: map (3 `f`) xs
+
+tcfail140.hs:16:8:
+    Constructor ‘Just’ should have 1 argument, but has been given none
+    In the pattern: Just
+    In the expression: (\ Just x -> x) :: Maybe a -> a
+    In the expression: ((\ Just x -> x) :: Maybe a -> a) (Just 1)
+
+tcfail140.hs:19:1:
+    Couldn't match expected type ‘t0 -> Bool’ with actual type ‘Int’
+    The equation(s) for ‘g’ have two arguments,
+    but its type ‘Int -> Int’ has only one
diff --git a/testsuite/tests/typecheck/should_fail/tcfail142.stderr b/testsuite/tests/typecheck/should_fail/tcfail142.stderr
index cd8fd53cefbe..e2338eb917e6 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail142.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail142.stderr
@@ -1,11 +1,11 @@
 
 tcfail142.hs:18:8:
     Could not deduce (Bar a0 r)
-      arising from the ambiguity check for ‛bar’
+      arising from the ambiguity check for ‘bar’
     from the context (Bar a r)
       bound by the type signature for bar :: Bar a r => r -> ()
       at tcfail142.hs:18:8-25
-    The type variable ‛a0’ is ambiguous
+    The type variable ‘a0’ is ambiguous
     In the ambiguity check for: forall r a. Bar a r => r -> ()
     To defer the ambiguity check to use sites, enable AllowAmbiguousTypes
-    In the type signature for ‛bar’: bar :: Bar a r => r -> ()
+    In the type signature for ‘bar’: bar :: Bar a r => r -> ()
diff --git a/testsuite/tests/typecheck/should_fail/tcfail143.stderr b/testsuite/tests/typecheck/should_fail/tcfail143.stderr
index 7c1cc92d604e..394fa43c4e98 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail143.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail143.stderr
@@ -1,5 +1,5 @@
 
 tcfail143.hs:29:9:
-    No instance for (MinMax (S Z) Z Z Z) arising from a use of ‛extend’
+    No instance for (MinMax (S Z) Z Z Z) arising from a use of ‘extend’
     In the expression: n1 `extend` n0
-    In an equation for ‛t2’: t2 = n1 `extend` n0
+    In an equation for ‘t2’: t2 = n1 `extend` n0
diff --git a/testsuite/tests/typecheck/should_fail/tcfail146.stderr b/testsuite/tests/typecheck/should_fail/tcfail146.stderr
index b62824e8cb50..6d8cb0e5e641 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail146.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail146.stderr
@@ -1,6 +1,6 @@
 
 tcfail146.hs:7:22:
-    Expected a type, but ‛SClass a’ has kind ‛Constraint’
-    In the type ‛SClass a’
-    In the definition of data constructor ‛SCon’
-    In the data declaration for ‛SData’
+    Expected a type, but ‘SClass a’ has kind ‘Constraint’
+    In the type ‘SClass a’
+    In the definition of data constructor ‘SCon’
+    In the data declaration for ‘SData’
diff --git a/testsuite/tests/typecheck/should_fail/tcfail147.stderr b/testsuite/tests/typecheck/should_fail/tcfail147.stderr
index b7e75b06b2db..68ec767eed9d 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail147.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail147.stderr
@@ -1,7 +1,7 @@
 
 tcfail147.hs:7:19:
-    Expecting one more argument to ‛XClass’
-    Expected a type, but ‛XClass’ has kind ‛k0 -> Constraint’
-    In the type ‛XClass’
-    In the definition of data constructor ‛XCon’
-    In the data declaration for ‛XData’
+    Expecting one more argument to ‘XClass’
+    Expected a type, but ‘XClass’ has kind ‘k0 -> Constraint’
+    In the type ‘XClass’
+    In the definition of data constructor ‘XCon’
+    In the data declaration for ‘XData’
diff --git a/testsuite/tests/typecheck/should_fail/tcfail148.stderr b/testsuite/tests/typecheck/should_fail/tcfail148.stderr
index cfa81e5b0a73..7fc107a616b0 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail148.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail148.stderr
@@ -1,7 +1,7 @@
 
 tcfail148.hs:5:28:
-    Expecting one more argument to ‛List’
-    Expected a type, but ‛List’ has kind ‛* -> *’
-    In the type ‛List’
-    In the definition of data constructor ‛Cons’
-    In the data declaration for ‛List’
+    Expecting one more argument to ‘List’
+    Expected a type, but ‘List’ has kind ‘* -> *’
+    In the type ‘List’
+    In the definition of data constructor ‘Cons’
+    In the data declaration for ‘List’
diff --git a/testsuite/tests/typecheck/should_fail/tcfail151.stderr b/testsuite/tests/typecheck/should_fail/tcfail151.stderr
index d0dd7960b54c..3e675c2ef0b6 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail151.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail151.stderr
@@ -3,6 +3,6 @@ tcfail151.hs:1:14: Warning:
     -XDatatypeContexts is deprecated: It was widely considered a misfeature, and has been removed from the Haskell language.
 
 tcfail151.hs:8:6:
-    Expecting one more argument to ‛Name a’
-    Expected a constraint, but ‛Name a’ has kind ‛* -> Constraint’
-    In the data declaration for ‛Exp’
+    Expecting one more argument to ‘Name a’
+    Expected a constraint, but ‘Name a’ has kind ‘* -> Constraint’
+    In the data declaration for ‘Exp’
diff --git a/testsuite/tests/typecheck/should_fail/tcfail152.stderr b/testsuite/tests/typecheck/should_fail/tcfail152.stderr
index 507587d072de..1db77b0657d1 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail152.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail152.stderr
@@ -1,7 +1,7 @@
 
 tcfail152.hs:10:14:
-    No instance for (Integral a) arising from a use of ‛toInteger’
+    No instance for (Integral a) arising from a use of ‘toInteger’
     Possible fix:
-      add (Integral a) to the context of the data constructor ‛C’
+      add (Integral a) to the context of the data constructor ‘C’
     In the expression: toInteger x
-    In an equation for ‛test’: test (C x) = toInteger x
+    In an equation for ‘test’: test (C x) = toInteger x
diff --git a/testsuite/tests/typecheck/should_fail/tcfail153.stderr b/testsuite/tests/typecheck/should_fail/tcfail153.stderr
index 50908ec6772f..80efb9221ce3 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail153.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail153.stderr
@@ -1,7 +1,7 @@
 
 tcfail153.hs:6:7:
-    Couldn't match type ‛a’ with ‛Bool’
-      ‛a’ is a rigid type variable bound by
+    Couldn't match type ‘a’ with ‘Bool’
+      ‘a’ is a rigid type variable bound by
           the type signature for f :: a -> [a] at tcfail153.hs:5:6
     Expected type: [a]
       Actual type: [Bool]
@@ -9,7 +9,7 @@ tcfail153.hs:6:7:
       x :: a (bound at tcfail153.hs:6:3)
       f :: a -> [a] (bound at tcfail153.hs:6:1)
     In the expression: g x
-    In an equation for ‛f’:
+    In an equation for ‘f’:
         f x
           = g x
           where
diff --git a/testsuite/tests/typecheck/should_fail/tcfail154.stderr b/testsuite/tests/typecheck/should_fail/tcfail154.stderr
index 80eba2d79026..9014b643df34 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail154.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail154.stderr
@@ -1,6 +1,6 @@
 
 tcfail154.hs:12:10:
-    Variable ‛a’ occurs more often than in the instance head
+    Variable ‘a’ occurs more often than in the instance head
       in the constraint: C a a
     (Use UndecidableInstances to permit this)
-    In the instance declaration for ‛Eq (T a)’
+    In the instance declaration for ‘Eq (T a)’
diff --git a/testsuite/tests/typecheck/should_fail/tcfail155.stderr b/testsuite/tests/typecheck/should_fail/tcfail155.stderr
index 58426f415072..64583eba33ea 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail155.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail155.stderr
@@ -1,6 +1,6 @@
 
 tcfail155.hs:8:6:
-    Data constructor ‛P’ returns type ‛L2’
-      instead of an instance of its parent type ‛T a’
-    In the definition of data constructor ‛P’
-    In the data declaration for ‛T’
+    Data constructor ‘P’ returns type ‘L2’
+      instead of an instance of its parent type ‘T a’
+    In the definition of data constructor ‘P’
+    In the data declaration for ‘T’
diff --git a/testsuite/tests/typecheck/should_fail/tcfail156.stderr b/testsuite/tests/typecheck/should_fail/tcfail156.stderr
index a4d2cbe8a781..280f118f90ae 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail156.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail156.stderr
@@ -2,5 +2,5 @@
 tcfail156.hs:7:15:
     A newtype constructor cannot have existential type variables
     Foo :: forall a. a -> Foo
-    In the definition of data constructor ‛Foo’
-    In the newtype declaration for ‛Foo’
+    In the definition of data constructor ‘Foo’
+    In the newtype declaration for ‘Foo’
diff --git a/testsuite/tests/typecheck/should_fail/tcfail157.stderr b/testsuite/tests/typecheck/should_fail/tcfail157.stderr
index 523d118985a4..acdc7df8cf20 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail157.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail157.stderr
@@ -1,12 +1,12 @@
 
 tcfail157.hs:27:10:
-    Variable ‛b’ occurs more often than in the instance head
+    Variable ‘b’ occurs more often than in the instance head
       in the constraint: E m a b
     (Use UndecidableInstances to permit this)
-    In the instance declaration for ‛Foo m (a -> ())’
+    In the instance declaration for ‘Foo m (a -> ())’
 
 tcfail157.hs:27:10:
-    Variable ‛b’ occurs more often than in the instance head
+    Variable ‘b’ occurs more often than in the instance head
       in the constraint: Foo m b
     (Use UndecidableInstances to permit this)
-    In the instance declaration for ‛Foo m (a -> ())’
+    In the instance declaration for ‘Foo m (a -> ())’
diff --git a/testsuite/tests/typecheck/should_fail/tcfail158.stderr b/testsuite/tests/typecheck/should_fail/tcfail158.stderr
index 47e05a5c775a..e359c8bdb207 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail158.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail158.stderr
@@ -1,5 +1,5 @@
 
 tcfail158.hs:14:19:
-    Expecting one more argument to ‛Val v’
-    Expected a type, but ‛Val v’ has kind ‛* -> *’
-    In the type signature for ‛bar’: bar :: forall v. Val v
+    Expecting one more argument to ‘Val v’
+    Expected a type, but ‘Val v’ has kind ‘* -> *’
+    In the type signature for ‘bar’: bar :: forall v. Val v
diff --git a/testsuite/tests/typecheck/should_fail/tcfail160.stderr b/testsuite/tests/typecheck/should_fail/tcfail160.stderr
index 4d3a01fe17d6..7a740403d8da 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail160.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail160.stderr
@@ -1,5 +1,5 @@
 
 tcfail160.hs:7:8:
-    The first argument of ‛T’ should have kind ‛* -> *’,
-      but ‛Int’ has kind ‛*’
-    In the type signature for ‛g’: g :: T Int
+    The first argument of ‘T’ should have kind ‘* -> *’,
+      but ‘Int’ has kind ‘*’
+    In the type signature for ‘g’: g :: T Int
diff --git a/testsuite/tests/typecheck/should_fail/tcfail161.stderr b/testsuite/tests/typecheck/should_fail/tcfail161.stderr
index 79ca81dfaa6f..90e1c2ec5ea6 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail161.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail161.stderr
@@ -1,5 +1,5 @@
 
 tcfail161.hs:5:7:
-    Expecting one more argument to ‛Maybe’
-    Expected kind ‛*’, but ‛Maybe’ has kind ‛* -> *’
-    In the type signature for ‛f’: f :: [Maybe]
+    Expecting one more argument to ‘Maybe’
+    Expected kind ‘*’, but ‘Maybe’ has kind ‘* -> *’
+    In the type signature for ‘f’: f :: [Maybe]
diff --git a/testsuite/tests/typecheck/should_fail/tcfail162.stderr b/testsuite/tests/typecheck/should_fail/tcfail162.stderr
index c14956e6b391..3d1e79879be9 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail162.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail162.stderr
@@ -1,7 +1,7 @@
 
 tcfail162.hs:10:33:
-    Expecting one more argument to ‛ForeignPtr’
-    Expected a type, but ‛ForeignPtr’ has kind ‛* -> *’
-    In the type ‛ForeignPtr’
-    In the definition of data constructor ‛Foo’
-    In the data declaration for ‛Foo’
+    Expecting one more argument to ‘ForeignPtr’
+    Expected a type, but ‘ForeignPtr’ has kind ‘* -> *’
+    In the type ‘ForeignPtr’
+    In the definition of data constructor ‘Foo’
+    In the data declaration for ‘Foo’
diff --git a/testsuite/tests/typecheck/should_fail/tcfail164.stderr b/testsuite/tests/typecheck/should_fail/tcfail164.stderr
index 4a3be9027bb0..9532466c6640 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail164.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail164.stderr
@@ -4,12 +4,12 @@ tcfail164.hs:11:5:
       Specify the type by giving a type signature
       e.g. (tagToEnum# x) :: Bool
     In the expression: tagToEnum# 0#
-    In an equation for ‛f’: f = tagToEnum# 0#
+    In an equation for ‘f’: f = tagToEnum# 0#
 
 tcfail164.hs:17:34:
     Bad call to tagToEnum# at type Int
       Result type must be an enumeration type
     In the expression: tagToEnum# value#
-    In an equation for ‛readUnboxable’:
+    In an equation for ‘readUnboxable’:
         readUnboxable (I# value#) = tagToEnum# value#
-    In the instance declaration for ‛Unboxable Int’
+    In the instance declaration for ‘Unboxable Int’
diff --git a/testsuite/tests/typecheck/should_fail/tcfail165.stderr b/testsuite/tests/typecheck/should_fail/tcfail165.stderr
index 09f359f834f3..2b8b43438553 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail165.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail165.stderr
@@ -1,9 +1,9 @@
 
 tcfail165.hs:15:23:
-    Couldn't match expected type ‛forall a. Show a => a -> String’
-                with actual type ‛b0 -> String’
-    In the second argument of ‛putMVar’, namely
-      ‛(show :: forall b. Show b => b -> String)’
+    Couldn't match expected type ‘forall a. Show a => a -> String’
+                with actual type ‘b0 -> String’
+    In the second argument of ‘putMVar’, namely
+      ‘(show :: forall b. Show b => b -> String)’
     In a stmt of a 'do' block:
       putMVar var (show :: forall b. Show b => b -> String)
     In the expression:
diff --git a/testsuite/tests/typecheck/should_fail/tcfail167.stderr b/testsuite/tests/typecheck/should_fail/tcfail167.stderr
index 1613d4efadd2..e20e1cfe7c9b 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail167.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail167.stderr
@@ -1,9 +1,9 @@
 
 tcfail167.hs:14:14:
-    Couldn't match type ‛Char’ with ‛Float’
+    Couldn't match type ‘Char’ with ‘Float’
     Inaccessible code in
       a pattern with constructor
         C2 :: T Float,
-      in an equation for ‛inaccessible’
+      in an equation for ‘inaccessible’
     In the pattern: C2
-    In an equation for ‛inaccessible’: inaccessible C2 = ' '
+    In an equation for ‘inaccessible’: inaccessible C2 = ' '
diff --git a/testsuite/tests/typecheck/should_fail/tcfail168.stderr b/testsuite/tests/typecheck/should_fail/tcfail168.stderr
index 4eec056fa3bb..e8c6c313e1d4 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail168.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail168.stderr
@@ -1,8 +1,8 @@
 
 tcfail168.hs:7:11:
-    Couldn't match expected type ‛IO a0’
-                with actual type ‛Char -> IO ()’
-    Probable cause: ‛putChar’ is applied to too few arguments
+    Couldn't match expected type ‘IO a0’
+                with actual type ‘Char -> IO ()’
+    Probable cause: ‘putChar’ is applied to too few arguments
     In a stmt of a 'do' block: putChar
     In the expression:
       do { putChar;
diff --git a/testsuite/tests/typecheck/should_fail/tcfail169.stderr b/testsuite/tests/typecheck/should_fail/tcfail169.stderr
index e1ac2db71147..75ae3a41a4c4 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail169.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail169.stderr
@@ -1,7 +1,7 @@
 
 tcfail169.hs:7:51:
     No instance for (Show (Succ a))
-      arising from the second field of ‛Cons’ (type ‛Seq (Succ a)’)
+      arising from the second field of ‘Cons’ (type ‘Seq (Succ a)’)
     Possible fix:
       use a standalone 'deriving instance' declaration,
         so you can specify the instance context yourself
diff --git a/testsuite/tests/typecheck/should_fail/tcfail170.stderr b/testsuite/tests/typecheck/should_fail/tcfail170.stderr
index 18a63a7edfb5..bb952ba37406 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail170.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail170.stderr
@@ -1,7 +1,7 @@
 
 tcfail170.hs:7:10:
-    Illegal instance declaration for ‛C [p] [q]’
-      The coverage condition fails in class ‛C’
-        for functional dependency: ‛a -> b’
-      Reason: lhs type ‛[p]’ does not determine rhs type ‛[q]’
-    In the instance declaration for ‛C [p] [q]’
+    Illegal instance declaration for ‘C [p] [q]’
+      The coverage condition fails in class ‘C’
+        for functional dependency: ‘a -> b’
+      Reason: lhs type ‘[p]’ does not determine rhs type ‘[q]’
+    In the instance declaration for ‘C [p] [q]’
diff --git a/testsuite/tests/typecheck/should_fail/tcfail171.stderr b/testsuite/tests/typecheck/should_fail/tcfail171.stderr
index e42b06ad08b9..849ce3aa1005 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail171.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail171.stderr
@@ -1,8 +1,8 @@
 
 tcfail171.hs:9:10:
-    No instance for (PrintfArg a) arising from a use of ‛printf’
+    No instance for (PrintfArg a) arising from a use of ‘printf’
     Possible fix:
       add (PrintfArg a) to the context of
         the type signature for phex :: a -> b
     In the expression: printf "0x%x" x
-    In an equation for ‛phex’: phex x = printf "0x%x" x
+    In an equation for ‘phex’: phex x = printf "0x%x" x
diff --git a/testsuite/tests/typecheck/should_fail/tcfail173.stderr b/testsuite/tests/typecheck/should_fail/tcfail173.stderr
index 2c87b91d1b36..70a22c3af91a 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail173.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail173.stderr
@@ -1,4 +1,4 @@
 
 tcfail173.hs:5:12:
-    Illegal declaration of a type or class operator ‛<.>’
+    Illegal declaration of a type or class operator ‘<.>’
       Use TypeOperators to declare operators in type and declarations
diff --git a/testsuite/tests/typecheck/should_fail/tcfail174.stderr b/testsuite/tests/typecheck/should_fail/tcfail174.stderr
index f37bcdf73bba..f48d15369ec4 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail174.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail174.stderr
@@ -1,13 +1,13 @@
 
 tcfail174.hs:9:10:
-    Couldn't match expected type ‛forall a. a -> a’
-                with actual type ‛a0 -> a0’
-    In the first argument of ‛Base’, namely ‛id’
+    Couldn't match expected type ‘forall a. a -> a’
+                with actual type ‘a0 -> a0’
+    In the first argument of ‘Base’, namely ‘id’
     In the expression: Base id
 
 tcfail174.hs:13:14:
-    Couldn't match type ‛a’ with ‛a1’
-      because type variable ‛a1’ would escape its scope
+    Couldn't match type ‘a’ with ‘a1’
+      because type variable ‘a1’ would escape its scope
     This (rigid, skolem) type variable is bound by
       the type forall a2. a2 -> a2
       at tcfail174.hs:13:14
@@ -15,18 +15,18 @@ tcfail174.hs:13:14:
       Actual type: Capture (forall a. a -> a)
     Relevant bindings include
       h1 :: Capture a (bound at tcfail174.hs:13:1)
-    In the first argument of ‛Capture’, namely ‛g’
+    In the first argument of ‘Capture’, namely ‘g’
     In the expression: Capture g
 
 tcfail174.hs:16:14:
-    Couldn't match type ‛a’ with ‛b’
-      ‛a’ is a rigid type variable bound by
+    Couldn't match type ‘a’ with ‘b’
+      ‘a’ is a rigid type variable bound by
           the type forall a1. a1 -> a1 at tcfail174.hs:16:14
-      ‛b’ is a rigid type variable bound by
+      ‘b’ is a rigid type variable bound by
           the type signature for h2 :: Capture b at tcfail174.hs:15:7
     Expected type: Capture (forall x. x -> b)
       Actual type: Capture (forall a. a -> a)
     Relevant bindings include
       h2 :: Capture b (bound at tcfail174.hs:16:1)
-    In the first argument of ‛Capture’, namely ‛g’
+    In the first argument of ‘Capture’, namely ‘g’
     In the expression: Capture g
diff --git a/testsuite/tests/typecheck/should_fail/tcfail175.stderr b/testsuite/tests/typecheck/should_fail/tcfail175.stderr
index 6d0c103153d2..623aab270632 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail175.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail175.stderr
@@ -1,10 +1,10 @@
 
 tcfail175.hs:11:1:
-    Couldn't match expected type ‛String -> String -> String’
-                with actual type ‛a’
-      ‛a’ is a rigid type variable bound by
+    Couldn't match expected type ‘String -> String -> String’
+                with actual type ‘a’
+      ‘a’ is a rigid type variable bound by
           the type signature for evalRHS :: Int -> a at tcfail175.hs:10:12
     Relevant bindings include
       evalRHS :: Int -> a (bound at tcfail175.hs:11:1)
-    The equation(s) for ‛evalRHS’ have three arguments,
-    but its type ‛Int -> a’ has only one
+    The equation(s) for ‘evalRHS’ have three arguments,
+    but its type ‘Int -> a’ has only one
diff --git a/testsuite/tests/typecheck/should_fail/tcfail176.stderr b/testsuite/tests/typecheck/should_fail/tcfail176.stderr
index cb829b43afaa..35c96d33320f 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail176.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail176.stderr
@@ -1,6 +1,6 @@
 
 tcfail176.hs:7:21:
-    Data constructor ‛Bug’ returns type ‛Maybe a’
-      instead of an instance of its parent type ‛Bug a’
-    In the definition of data constructor ‛Bug’
-    In the newtype declaration for ‛Bug’
+    Data constructor ‘Bug’ returns type ‘Maybe a’
+      instead of an instance of its parent type ‘Bug a’
+    In the definition of data constructor ‘Bug’
+    In the newtype declaration for ‘Bug’
diff --git a/testsuite/tests/typecheck/should_fail/tcfail177.stderr b/testsuite/tests/typecheck/should_fail/tcfail177.stderr
index a2d6e7bac968..54d733117218 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail177.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail177.stderr
@@ -1,170 +1,170 @@
 
 tcfail177.hs:10:12:
-    Couldn't match expected type ‛Bool’ with actual type ‛Int’
+    Couldn't match expected type ‘Bool’ with actual type ‘Int’
     In the expression:
       foo
         [a ~?= b, "Three" ~?= "3", "Four" ~?= "4", "Five" ~?= "5", ....]
-    In an equation for ‛allTests’:
+    In an equation for ‘allTests’:
         allTests = foo [a ~?= b, "Three" ~?= "3", "Four" ~?= "4", ....]
 
 tcfail177.hs:20:13:
-    Couldn't match expected type ‛Bool’ with actual type ‛[Char]’
+    Couldn't match expected type ‘Bool’ with actual type ‘[Char]’
     In the expression: "Two"
-    In the first argument of ‛foo’, namely
-      ‛[a ~?= b, "Three" ~?= "3", "Four" ~?= "4", "Five" ~?= "5", ....]’
+    In the first argument of ‘foo’, namely
+      ‘[a ~?= b, "Three" ~?= "3", "Four" ~?= "4", "Five" ~?= "5", ....]’
     In the expression:
       foo
         [a ~?= b, "Three" ~?= "3", "Four" ~?= "4", "Five" ~?= "5", ....]
 
 tcfail177.hs:20:20:
-    Couldn't match expected type ‛Bool’ with actual type ‛[Char]’
+    Couldn't match expected type ‘Bool’ with actual type ‘[Char]’
     In the expression: "Two"
-    In the first argument of ‛foo’, namely
-      ‛[a ~?= b, "Three" ~?= "3", "Four" ~?= "4", "Five" ~?= "5", ....]’
+    In the first argument of ‘foo’, namely
+      ‘[a ~?= b, "Three" ~?= "3", "Four" ~?= "4", "Five" ~?= "5", ....]’
     In the expression:
       foo
         [a ~?= b, "Three" ~?= "3", "Four" ~?= "4", "Five" ~?= "5", ....]
 
 tcfail177.hs:20:27:
-    Couldn't match expected type ‛Bool’ with actual type ‛[Char]’
+    Couldn't match expected type ‘Bool’ with actual type ‘[Char]’
     In the expression: "Two"
-    In the first argument of ‛foo’, namely
-      ‛[a ~?= b, "Three" ~?= "3", "Four" ~?= "4", "Five" ~?= "5", ....]’
+    In the first argument of ‘foo’, namely
+      ‘[a ~?= b, "Three" ~?= "3", "Four" ~?= "4", "Five" ~?= "5", ....]’
     In the expression:
       foo
         [a ~?= b, "Three" ~?= "3", "Four" ~?= "4", "Five" ~?= "5", ....]
 
 tcfail177.hs:21:13:
-    Couldn't match expected type ‛Bool’ with actual type ‛[Char]’
+    Couldn't match expected type ‘Bool’ with actual type ‘[Char]’
     In the expression: "Two"
-    In the first argument of ‛foo’, namely
-      ‛[a ~?= b, "Three" ~?= "3", "Four" ~?= "4", "Five" ~?= "5", ....]’
+    In the first argument of ‘foo’, namely
+      ‘[a ~?= b, "Three" ~?= "3", "Four" ~?= "4", "Five" ~?= "5", ....]’
     In the expression:
       foo
         [a ~?= b, "Three" ~?= "3", "Four" ~?= "4", "Five" ~?= "5", ....]
 
 tcfail177.hs:21:20:
-    Couldn't match expected type ‛Bool’ with actual type ‛[Char]’
+    Couldn't match expected type ‘Bool’ with actual type ‘[Char]’
     In the expression: "Two"
-    In the first argument of ‛foo’, namely
-      ‛[a ~?= b, "Three" ~?= "3", "Four" ~?= "4", "Five" ~?= "5", ....]’
+    In the first argument of ‘foo’, namely
+      ‘[a ~?= b, "Three" ~?= "3", "Four" ~?= "4", "Five" ~?= "5", ....]’
     In the expression:
       foo
         [a ~?= b, "Three" ~?= "3", "Four" ~?= "4", "Five" ~?= "5", ....]
 
 tcfail177.hs:21:27:
-    Couldn't match expected type ‛Bool’ with actual type ‛[Char]’
+    Couldn't match expected type ‘Bool’ with actual type ‘[Char]’
     In the expression: "Two"
-    In the first argument of ‛foo’, namely
-      ‛[a ~?= b, "Three" ~?= "3", "Four" ~?= "4", "Five" ~?= "5", ....]’
+    In the first argument of ‘foo’, namely
+      ‘[a ~?= b, "Three" ~?= "3", "Four" ~?= "4", "Five" ~?= "5", ....]’
     In the expression:
       foo
         [a ~?= b, "Three" ~?= "3", "Four" ~?= "4", "Five" ~?= "5", ....]
 
 tcfail177.hs:22:13:
-    Couldn't match expected type ‛Bool’ with actual type ‛[Char]’
+    Couldn't match expected type ‘Bool’ with actual type ‘[Char]’
     In the expression: "Two"
-    In the first argument of ‛foo’, namely
-      ‛[a ~?= b, "Three" ~?= "3", "Four" ~?= "4", "Five" ~?= "5", ....]’
+    In the first argument of ‘foo’, namely
+      ‘[a ~?= b, "Three" ~?= "3", "Four" ~?= "4", "Five" ~?= "5", ....]’
     In the expression:
       foo
         [a ~?= b, "Three" ~?= "3", "Four" ~?= "4", "Five" ~?= "5", ....]
 
 tcfail177.hs:22:20:
-    Couldn't match expected type ‛Bool’ with actual type ‛[Char]’
+    Couldn't match expected type ‘Bool’ with actual type ‘[Char]’
     In the expression: "Two"
-    In the first argument of ‛foo’, namely
-      ‛[a ~?= b, "Three" ~?= "3", "Four" ~?= "4", "Five" ~?= "5", ....]’
+    In the first argument of ‘foo’, namely
+      ‘[a ~?= b, "Three" ~?= "3", "Four" ~?= "4", "Five" ~?= "5", ....]’
     In the expression:
       foo
         [a ~?= b, "Three" ~?= "3", "Four" ~?= "4", "Five" ~?= "5", ....]
 
 tcfail177.hs:22:27:
-    Couldn't match expected type ‛Bool’ with actual type ‛[Char]’
+    Couldn't match expected type ‘Bool’ with actual type ‘[Char]’
     In the expression: "Two"
-    In the first argument of ‛foo’, namely
-      ‛[a ~?= b, "Three" ~?= "3", "Four" ~?= "4", "Five" ~?= "5", ....]’
+    In the first argument of ‘foo’, namely
+      ‘[a ~?= b, "Three" ~?= "3", "Four" ~?= "4", "Five" ~?= "5", ....]’
     In the expression:
       foo
         [a ~?= b, "Three" ~?= "3", "Four" ~?= "4", "Five" ~?= "5", ....]
 
 tcfail177.hs:23:13:
-    Couldn't match expected type ‛Bool’ with actual type ‛[Char]’
+    Couldn't match expected type ‘Bool’ with actual type ‘[Char]’
     In the expression: "Two"
-    In the first argument of ‛foo’, namely
-      ‛[a ~?= b, "Three" ~?= "3", "Four" ~?= "4", "Five" ~?= "5", ....]’
+    In the first argument of ‘foo’, namely
+      ‘[a ~?= b, "Three" ~?= "3", "Four" ~?= "4", "Five" ~?= "5", ....]’
     In the expression:
       foo
         [a ~?= b, "Three" ~?= "3", "Four" ~?= "4", "Five" ~?= "5", ....]
 
 tcfail177.hs:23:20:
-    Couldn't match expected type ‛Bool’ with actual type ‛[Char]’
+    Couldn't match expected type ‘Bool’ with actual type ‘[Char]’
     In the expression: "Two"
-    In the first argument of ‛foo’, namely
-      ‛[a ~?= b, "Three" ~?= "3", "Four" ~?= "4", "Five" ~?= "5", ....]’
+    In the first argument of ‘foo’, namely
+      ‘[a ~?= b, "Three" ~?= "3", "Four" ~?= "4", "Five" ~?= "5", ....]’
     In the expression:
       foo
         [a ~?= b, "Three" ~?= "3", "Four" ~?= "4", "Five" ~?= "5", ....]
 
 tcfail177.hs:23:27:
-    Couldn't match expected type ‛Bool’ with actual type ‛[Char]’
+    Couldn't match expected type ‘Bool’ with actual type ‘[Char]’
     In the expression: "Two"
-    In the first argument of ‛foo’, namely
-      ‛[a ~?= b, "Three" ~?= "3", "Four" ~?= "4", "Five" ~?= "5", ....]’
+    In the first argument of ‘foo’, namely
+      ‘[a ~?= b, "Three" ~?= "3", "Four" ~?= "4", "Five" ~?= "5", ....]’
     In the expression:
       foo
         [a ~?= b, "Three" ~?= "3", "Four" ~?= "4", "Five" ~?= "5", ....]
 
 tcfail177.hs:24:13:
-    Couldn't match expected type ‛Bool’ with actual type ‛[Char]’
+    Couldn't match expected type ‘Bool’ with actual type ‘[Char]’
     In the expression: "Two"
-    In the first argument of ‛foo’, namely
-      ‛[a ~?= b, "Three" ~?= "3", "Four" ~?= "4", "Five" ~?= "5", ....]’
+    In the first argument of ‘foo’, namely
+      ‘[a ~?= b, "Three" ~?= "3", "Four" ~?= "4", "Five" ~?= "5", ....]’
     In the expression:
       foo
         [a ~?= b, "Three" ~?= "3", "Four" ~?= "4", "Five" ~?= "5", ....]
 
 tcfail177.hs:24:20:
-    Couldn't match expected type ‛Bool’ with actual type ‛[Char]’
+    Couldn't match expected type ‘Bool’ with actual type ‘[Char]’
     In the expression: "Two"
-    In the first argument of ‛foo’, namely
-      ‛[a ~?= b, "Three" ~?= "3", "Four" ~?= "4", "Five" ~?= "5", ....]’
+    In the first argument of ‘foo’, namely
+      ‘[a ~?= b, "Three" ~?= "3", "Four" ~?= "4", "Five" ~?= "5", ....]’
     In the expression:
       foo
         [a ~?= b, "Three" ~?= "3", "Four" ~?= "4", "Five" ~?= "5", ....]
 
 tcfail177.hs:24:27:
-    Couldn't match expected type ‛Bool’ with actual type ‛[Char]’
+    Couldn't match expected type ‘Bool’ with actual type ‘[Char]’
     In the expression: "Two"
-    In the first argument of ‛foo’, namely
-      ‛[a ~?= b, "Three" ~?= "3", "Four" ~?= "4", "Five" ~?= "5", ....]’
+    In the first argument of ‘foo’, namely
+      ‘[a ~?= b, "Three" ~?= "3", "Four" ~?= "4", "Five" ~?= "5", ....]’
     In the expression:
       foo
         [a ~?= b, "Three" ~?= "3", "Four" ~?= "4", "Five" ~?= "5", ....]
 
 tcfail177.hs:25:13:
-    Couldn't match expected type ‛Bool’ with actual type ‛[Char]’
+    Couldn't match expected type ‘Bool’ with actual type ‘[Char]’
     In the expression: "Two"
-    In the first argument of ‛foo’, namely
-      ‛[a ~?= b, "Three" ~?= "3", "Four" ~?= "4", "Five" ~?= "5", ....]’
+    In the first argument of ‘foo’, namely
+      ‘[a ~?= b, "Three" ~?= "3", "Four" ~?= "4", "Five" ~?= "5", ....]’
     In the expression:
       foo
         [a ~?= b, "Three" ~?= "3", "Four" ~?= "4", "Five" ~?= "5", ....]
 
 tcfail177.hs:25:20:
-    Couldn't match expected type ‛Bool’ with actual type ‛[Char]’
+    Couldn't match expected type ‘Bool’ with actual type ‘[Char]’
     In the expression: "Two"
-    In the first argument of ‛foo’, namely
-      ‛[a ~?= b, "Three" ~?= "3", "Four" ~?= "4", "Five" ~?= "5", ....]’
+    In the first argument of ‘foo’, namely
+      ‘[a ~?= b, "Three" ~?= "3", "Four" ~?= "4", "Five" ~?= "5", ....]’
     In the expression:
       foo
         [a ~?= b, "Three" ~?= "3", "Four" ~?= "4", "Five" ~?= "5", ....]
 
 tcfail177.hs:25:27:
-    Couldn't match expected type ‛Bool’ with actual type ‛[Char]’
+    Couldn't match expected type ‘Bool’ with actual type ‘[Char]’
     In the expression: "Two"
-    In the first argument of ‛foo’, namely
-      ‛[a ~?= b, "Three" ~?= "3", "Four" ~?= "4", "Five" ~?= "5", ....]’
+    In the first argument of ‘foo’, namely
+      ‘[a ~?= b, "Three" ~?= "3", "Four" ~?= "4", "Five" ~?= "5", ....]’
     In the expression:
       foo
         [a ~?= b, "Three" ~?= "3", "Four" ~?= "4", "Five" ~?= "5", ....]
diff --git a/testsuite/tests/typecheck/should_fail/tcfail178.stderr b/testsuite/tests/typecheck/should_fail/tcfail178.stderr
index 62af0f90517a..7ed00156d686 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail178.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail178.stderr
@@ -1,14 +1,14 @@
 
 tcfail178.hs:15:7:
-    Couldn't match type ‛()’ with ‛[a]’
+    Couldn't match type ‘()’ with ‘[a]’
     Expected type: Bool -> [a]
       Actual type: Bool -> ()
     Relevant bindings include c :: [a] (bound at tcfail178.hs:15:1)
-    In the first argument of ‛a’, namely ‛y’
+    In the first argument of ‘a’, namely ‘y’
     In the expression: a y
 
 tcfail178.hs:18:7:
-    Couldn't match expected type ‛Bool -> [a]’ with actual type ‛()’
+    Couldn't match expected type ‘Bool -> [a]’ with actual type ‘()’
     Relevant bindings include d :: [a] (bound at tcfail178.hs:18:1)
-    In the first argument of ‛a’, namely ‛()’
+    In the first argument of ‘a’, namely ‘()’
     In the expression: a ()
diff --git a/testsuite/tests/typecheck/should_fail/tcfail179.stderr b/testsuite/tests/typecheck/should_fail/tcfail179.stderr
index db5966f6f90b..0fdaeade03ce 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail179.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail179.stderr
@@ -1,17 +1,17 @@
 
 tcfail179.hs:14:39:
-    Couldn't match expected type ‛s’ with actual type ‛x’
-      ‛x’ is a rigid type variable bound by
+    Couldn't match expected type ‘s’ with actual type ‘x’
+      ‘x’ is a rigid type variable bound by
           a pattern with constructor
             T :: forall s x. (s -> (x -> s) -> (x, s, Int)) -> T s,
           in a case alternative
           at tcfail179.hs:14:14
-      ‛s’ is a rigid type variable bound by
+      ‘s’ is a rigid type variable bound by
           the type signature for run :: T s -> Int at tcfail179.hs:12:8
     Relevant bindings include
       x :: x (bound at tcfail179.hs:14:26)
       g :: s -> (x -> s) -> (x, s, Int) (bound at tcfail179.hs:14:16)
       ts :: T s (bound at tcfail179.hs:13:5)
       run :: T s -> Int (bound at tcfail179.hs:13:1)
-    In the first argument of ‛g’, namely ‛x’
+    In the first argument of ‘g’, namely ‘x’
     In the expression: g x id
diff --git a/testsuite/tests/typecheck/should_fail/tcfail180.stderr b/testsuite/tests/typecheck/should_fail/tcfail180.stderr
index 8baeb4ed51c7..7764b7798b3e 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail180.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail180.stderr
@@ -1,6 +1,6 @@
 
 tcfail180.hs:10:9:
-    Couldn't match expected type ‛f0 b0’ with actual type ‛Bool’
+    Couldn't match expected type ‘f0 b0’ with actual type ‘Bool’
     In the pattern: True
     In a case alternative: True -> ()
     In the expression: case p of { True -> () }
diff --git a/testsuite/tests/typecheck/should_fail/tcfail181.stderr b/testsuite/tests/typecheck/should_fail/tcfail181.stderr
index 5f272da112a4..3502f2bbea22 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail181.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail181.stderr
@@ -1,16 +1,15 @@
 
 tcfail181.hs:17:9:
-    Could not deduce (Monad m0) arising from a use of ‛foo’
+    Could not deduce (Monad m0) arising from a use of ‘foo’
     from the context (Monad m)
       bound by the inferred type of
                wog :: Monad m => t -> Something (m Bool) e
       at tcfail181.hs:17:1-30
-    The type variable ‛m0’ is ambiguous
+    The type variable ‘m0’ is ambiguous
     Note: there are several potential instances:
-      instance Monad ((->) r) -- Defined in ‛GHC.Base’
-      instance Monad IO -- Defined in ‛GHC.Base’
-      instance Monad [] -- Defined in ‛GHC.Base’
-      ...plus one other
+      instance Monad ((->) r) -- Defined in ‘GHC.Base’
+      instance Monad IO -- Defined in ‘GHC.Base’
+      instance Monad [] -- Defined in ‘GHC.Base’
     In the expression: foo
     In the expression: foo {bar = return True}
-    In an equation for ‛wog’: wog x = foo {bar = return True}
+    In an equation for ‘wog’: wog x = foo {bar = return True}
diff --git a/testsuite/tests/typecheck/should_fail/tcfail182.stderr b/testsuite/tests/typecheck/should_fail/tcfail182.stderr
index ad01d392f0c8..c242ccf54ae5 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail182.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail182.stderr
@@ -1,10 +1,10 @@
 
 tcfail182.hs:9:3:
-    Couldn't match expected type ‛Prelude.Maybe a’
-                with actual type ‛Maybe t0’
-    NB: ‛Prelude.Maybe’ is defined in ‛Data.Maybe’ in package ‛base’
-        ‛Maybe’ is defined at tcfail182.hs:6:1-18
+    Couldn't match expected type ‘Prelude.Maybe a’
+                with actual type ‘Maybe t0’
+    NB: ‘Prelude.Maybe’ is defined in ‘Data.Maybe’ in package ‘base’
+        ‘Maybe’ is defined at tcfail182.hs:6:1-18
     Relevant bindings include
       f :: Prelude.Maybe a -> Int (bound at tcfail182.hs:9:1)
     In the pattern: Foo
-    In an equation for ‛f’: f Foo = 3
+    In an equation for ‘f’: f Foo = 3
diff --git a/testsuite/tests/typecheck/should_fail/tcfail184.stderr b/testsuite/tests/typecheck/should_fail/tcfail184.stderr
index 6efa33726ac3..8d349cd86403 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail184.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail184.stderr
@@ -3,5 +3,5 @@ tcfail184.hs:8:19:
     Illegal polymorphic or qualified type:
       forall a. Ord a => [a] -> [a]
     Perhaps you intended to use RankNTypes or Rank2Types
-    In the definition of data constructor ‛MkSwizzle’
-    In the newtype declaration for ‛Swizzle’
+    In the definition of data constructor ‘MkSwizzle’
+    In the newtype declaration for ‘Swizzle’
diff --git a/testsuite/tests/typecheck/should_fail/tcfail185.stderr b/testsuite/tests/typecheck/should_fail/tcfail185.stderr
index 2c39b007d431..785b5d6dd064 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail185.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail185.stderr
@@ -1,6 +1,6 @@
 
 tcfail185.hs:7:46:
-    Couldn't match expected type ‛Int -> Int’ with actual type ‛Bool’
+    Couldn't match expected type ‘Int -> Int’ with actual type ‘Bool’
     In the expression: x
     In the expression:
       let
diff --git a/testsuite/tests/typecheck/should_fail/tcfail186.stderr b/testsuite/tests/typecheck/should_fail/tcfail186.stderr
index f9ced11d3617..1842628e40ba 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail186.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail186.stderr
@@ -1,8 +1,8 @@
 
 tcfail186.hs:7:9:
-    Couldn't match type ‛[Char]’ with ‛Int’
+    Couldn't match type ‘[Char]’ with ‘Int’
     Expected type: PhantomSyn a0
       Actual type: [Char]
-    In the first argument of ‛f’, namely ‛"hoo"’
+    In the first argument of ‘f’, namely ‘"hoo"’
     In the expression: f "hoo"
-    In an equation for ‛foo’: foo = f "hoo"
+    In an equation for ‘foo’: foo = f "hoo"
diff --git a/testsuite/tests/typecheck/should_fail/tcfail187.stderr b/testsuite/tests/typecheck/should_fail/tcfail187.stderr
index 10a9115ff574..799485a69f4d 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail187.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail187.stderr
@@ -1,5 +1,5 @@
 
 tcfail187.hs:7:6:
-    Constructor ‛:::’ should have no arguments, but has been given 2
+    Constructor ‘:::’ should have no arguments, but has been given 2
     In the pattern: x ::: y
-    In an equation for ‛foo’: foo (x ::: y) = ()
+    In an equation for ‘foo’: foo (x ::: y) = ()
diff --git a/testsuite/tests/typecheck/should_fail/tcfail189.stderr b/testsuite/tests/typecheck/should_fail/tcfail189.stderr
index fd86dbdf7030..6bd08a266c03 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail189.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail189.stderr
@@ -1,8 +1,8 @@
-
-tcfail189.hs:10:31:
-    Couldn't match type ‛[a0]’ with ‛a -> a1’
-    Expected type: (a -> a1) -> [a] -> [[a]]
-      Actual type: [a0] -> [a0]
-    Possible cause: ‛take’ is applied to too many arguments
-    In the expression: take 2
-    In a stmt of a list comprehension: then group by x using take 2
+
+tcfail189.hs:10:31:
+    Couldn't match type ‘[a0]’ with ‘a -> Integer’
+    Expected type: (a -> Integer) -> [a] -> [[a]]
+      Actual type: [a0] -> [a0]
+    Possible cause: ‘take’ is applied to too many arguments
+    In the expression: take 2
+    In a stmt of a list comprehension: then group by x using take 2
diff --git a/testsuite/tests/typecheck/should_fail/tcfail190.stderr b/testsuite/tests/typecheck/should_fail/tcfail190.stderr
index df56a79a73f2..6b5374416ecc 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail190.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail190.stderr
@@ -1,6 +1,6 @@
 
 tcfail190.hs:14:31:
-    No instance for (Ord Unorderable) arising from a use of ‛groupWith’
+    No instance for (Ord Unorderable) arising from a use of ‘groupWith’
     In the expression: groupWith
     In a stmt of a list comprehension: then group by x using groupWith
     In the expression:
diff --git a/testsuite/tests/typecheck/should_fail/tcfail191.stderr b/testsuite/tests/typecheck/should_fail/tcfail191.stderr
index e82a54af6e7b..c76669988053 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail191.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail191.stderr
@@ -1,7 +1,7 @@
 
 tcfail191.hs:11:26:
-    Couldn't match type ‛a’ with ‛[a]’
-      ‛a’ is a rigid type variable bound by
+    Couldn't match type ‘a’ with ‘[a]’
+      ‘a’ is a rigid type variable bound by
           a type expected by the context: [a] -> [[a]] at tcfail191.hs:11:9
     Expected type: [a] -> [[a]]
       Actual type: [a] -> [a]
diff --git a/testsuite/tests/typecheck/should_fail/tcfail192.stderr b/testsuite/tests/typecheck/should_fail/tcfail192.stderr
index b6388c25ed1a..412aac6b7419 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail192.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail192.stderr
@@ -1,7 +1,7 @@
 
 tcfail192.hs:10:26:
-    Couldn't match type ‛a’ with ‛[a]’
-      ‛a’ is a rigid type variable bound by
+    Couldn't match type ‘a’ with ‘[a]’
+      ‘a’ is a rigid type variable bound by
           a type expected by the context: [a] -> [[a]] at tcfail192.hs:10:9
     Expected type: [a] -> [[a]]
       Actual type: [a] -> [a]
diff --git a/testsuite/tests/typecheck/should_fail/tcfail193.stderr b/testsuite/tests/typecheck/should_fail/tcfail193.stderr
index 0ae78576c5be..6cbf6d81bbfc 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail193.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail193.stderr
@@ -1,7 +1,7 @@
 
 tcfail193.hs:10:31:
-    Couldn't match type ‛a’ with ‛[a]’
-      ‛a’ is a rigid type variable bound by
+    Couldn't match type ‘a’ with ‘[a]’
+      ‘a’ is a rigid type variable bound by
           a type expected by the context: [a] -> [a] at tcfail193.hs:10:26
     Expected type: [a] -> [a]
       Actual type: [a] -> [[a]]
diff --git a/testsuite/tests/typecheck/should_fail/tcfail194.stderr b/testsuite/tests/typecheck/should_fail/tcfail194.stderr
index 1b21e5a616e4..eeae9d02196c 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail194.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail194.stderr
@@ -1,9 +1,9 @@
 
 tcfail194.hs:9:29:
-    Couldn't match type ‛[a0]’ with ‛a -> t’
+    Couldn't match type ‘[a0]’ with ‘a -> t’
     Expected type: (a -> t) -> [a] -> [a]
       Actual type: [a0] -> [a0]
     Relevant bindings include z :: [t] (bound at tcfail194.hs:9:1)
-    Possible cause: ‛take’ is applied to too many arguments
+    Possible cause: ‘take’ is applied to too many arguments
     In the expression: take 5
     In a stmt of a list comprehension: then take 5 by x
diff --git a/testsuite/tests/typecheck/should_fail/tcfail195.stderr b/testsuite/tests/typecheck/should_fail/tcfail195.stderr
index 4800e75642c2..96d968f8bfba 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail195.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail195.stderr
@@ -1,5 +1,5 @@
 
 tcfail195.hs:6:3:
     Illegal polymorphic or qualified type: forall a. a
-    In the definition of data constructor ‛Foo’
-    In the data declaration for ‛Foo’
+    In the definition of data constructor ‘Foo’
+    In the data declaration for ‘Foo’
diff --git a/testsuite/tests/typecheck/should_fail/tcfail196.stderr b/testsuite/tests/typecheck/should_fail/tcfail196.stderr
index ffedbdf1b9ba..723c91de5ea5 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail196.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail196.stderr
@@ -1,5 +1,5 @@
 
 tcfail196.hs:5:8:
     Illegal polymorphic or qualified type: forall a. a
-    In the type signature for ‛bar’:
+    In the type signature for ‘bar’:
       bar :: Num (forall a. a) => Int -> Int
diff --git a/testsuite/tests/typecheck/should_fail/tcfail197.stderr b/testsuite/tests/typecheck/should_fail/tcfail197.stderr
index c2b16028217f..35d24e490c58 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail197.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail197.stderr
@@ -2,4 +2,4 @@
 tcfail197.hs:5:8:
     Illegal polymorphic or qualified type: forall a. a
     Perhaps you intended to use ImpredicativeTypes
-    In the type signature for ‛foo’: foo :: [forall a. a] -> Int
+    In the type signature for ‘foo’: foo :: [forall a. a] -> Int
diff --git a/testsuite/tests/typecheck/should_fail/tcfail198.stderr b/testsuite/tests/typecheck/should_fail/tcfail198.stderr
index 62e9eeed154c..76557906ba56 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail198.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail198.stderr
@@ -1,7 +1,7 @@
 
 tcfail198.hs:6:36:
-    Couldn't match expected type ‛a1’ with actual type ‛a’
-      because type variable ‛a1’ would escape its scope
+    Couldn't match expected type ‘a1’ with actual type ‘a’
+      because type variable ‘a1’ would escape its scope
     This (rigid, skolem) type variable is bound by
       an expression type signature: a1
       at tcfail198.hs:6:36-41
@@ -10,4 +10,4 @@ tcfail198.hs:6:36:
       x :: a (bound at tcfail198.hs:6:19)
       f3 :: [a] -> [a] (bound at tcfail198.hs:6:6)
     In the expression: x :: a
-    In the second argument of ‛(++)’, namely ‛[x :: a]’
+    In the second argument of ‘(++)’, namely ‘[x :: a]’
diff --git a/testsuite/tests/typecheck/should_fail/tcfail199.stderr b/testsuite/tests/typecheck/should_fail/tcfail199.stderr
index 660e69d04c17..4833c769f981 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail199.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail199.stderr
@@ -1,5 +1,5 @@
 
 tcfail199.hs:5:1:
-    Couldn't match expected type ‛IO t0’ with actual type ‛[Char]’
+    Couldn't match expected type ‘IO t0’ with actual type ‘[Char]’
     In the expression: main
-    When checking the type of the IO action ‛main’
+    When checking the type of the IO action ‘main’
diff --git a/testsuite/tests/typecheck/should_fail/tcfail200.stderr b/testsuite/tests/typecheck/should_fail/tcfail200.stderr
index e70a55cef97e..5a35839689e4 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail200.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail200.stderr
@@ -7,4 +7,4 @@ tcfail200.hs:5:15:
       x :: (t1, Char) (bound at tcfail200.hs:5:9)
     In the expression: 1#
     In the expression: (1#, 'c')
-    In an equation for ‛x’: x = (1#, 'c')
+    In an equation for ‘x’: x = (1#, 'c')
diff --git a/testsuite/tests/typecheck/should_fail/tcfail201.stderr b/testsuite/tests/typecheck/should_fail/tcfail201.stderr
index 23d22744ebb2..a029e8c6d37d 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail201.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail201.stderr
@@ -1,7 +1,7 @@
 
 tcfail201.hs:17:27:
-    Couldn't match expected type ‛a’ with actual type ‛HsDoc t0’
-      ‛a’ is a rigid type variable bound by
+    Couldn't match expected type ‘a’ with actual type ‘HsDoc t0’
+      ‘a’ is a rigid type variable bound by
           the type signature for
             gfoldl' :: (forall a1 b. c (a1 -> b) -> a1 -> c b)
                        -> (forall g. g -> c g) -> a -> c a
diff --git a/testsuite/tests/typecheck/should_fail/tcfail202.hs b/testsuite/tests/typecheck/should_fail/tcfail202.hs
index 75657552182d..6878e4ece6ec 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail202.hs
+++ b/testsuite/tests/typecheck/should_fail/tcfail202.hs
@@ -2,7 +2,7 @@
 -- This was accepted due to a bug in GHC
 
 {-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies,
-             OverlappingInstances, UndecidableInstances, IncoherentInstances,
+             UndecidableInstances, IncoherentInstances,
              FlexibleInstances #-}
 
 module Foo where
diff --git a/testsuite/tests/typecheck/should_fail/tcfail203.stderr b/testsuite/tests/typecheck/should_fail/tcfail203.stderr
index e1a00c301832..21454e345da9 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail203.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail203.stderr
@@ -2,7 +2,7 @@
 tcfail203.hs:28:11:
     Pattern bindings containing unlifted types should use an outermost bang pattern:
       (I# x) = 5
-    In an equation for ‛fail2’:
+    In an equation for ‘fail2’:
         fail2
           = 'a'
           where
@@ -11,7 +11,7 @@ tcfail203.hs:28:11:
 tcfail203.hs:31:11:
     Pattern bindings containing unlifted types should use an outermost bang pattern:
       (b, I# x) = (True, 5)
-    In an equation for ‛fail3’:
+    In an equation for ‘fail3’:
         fail3
           = 'a'
           where
@@ -20,7 +20,7 @@ tcfail203.hs:31:11:
 tcfail203.hs:40:11:
     Pattern bindings containing unlifted types should use an outermost bang pattern:
       (I# !x) = 5
-    In an equation for ‛fail6’:
+    In an equation for ‘fail6’:
         fail6
           = 'a'
           where
@@ -29,7 +29,7 @@ tcfail203.hs:40:11:
 tcfail203.hs:43:11:
     Pattern bindings containing unlifted types should use an outermost bang pattern:
       (b, !(I# x)) = (True, 5)
-    In an equation for ‛fail7’:
+    In an equation for ‘fail7’:
         fail7
           = 'a'
           where
diff --git a/testsuite/tests/typecheck/should_fail/tcfail204.stderr b/testsuite/tests/typecheck/should_fail/tcfail204.stderr
index 0834428783cd..66d7269262c0 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail204.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail204.stderr
@@ -1,12 +1,12 @@
 
 tcfail204.hs:10:7: Warning:
-    Defaulting the following constraint(s) to type ‛Double’
+    Defaulting the following constraint(s) to type ‘Double’
       (RealFrac a0)
-        arising from a use of ‛ceiling’ at tcfail204.hs:10:7-13
+        arising from a use of ‘ceiling’ at tcfail204.hs:10:7-13
       (Fractional a0)
-        arising from the literal ‛6.3’ at tcfail204.hs:10:15-17
+        arising from the literal ‘6.3’ at tcfail204.hs:10:15-17
     In the expression: ceiling 6.3
-    In an equation for ‛foo’: foo = ceiling 6.3
+    In an equation for ‘foo’: foo = ceiling 6.3
 
 <no location info>: 
 Failing due to -Werror.
diff --git a/testsuite/tests/typecheck/should_fail/tcfail206.stderr b/testsuite/tests/typecheck/should_fail/tcfail206.stderr
index 5a30f93e8108..3eec7088cdcc 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail206.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail206.stderr
@@ -1,50 +1,51 @@
 
 tcfail206.hs:5:5:
-    Couldn't match type ‛Bool’ with ‛Int’
+    Couldn't match type ‘Bool’ with ‘Int’
     Expected type: Bool -> (Int, Bool)
       Actual type: Bool -> (Bool, Bool)
     In the expression: (, True)
-    In an equation for ‛a’: a = (, True)
+    In an equation for ‘a’: a = (, True)
 
 tcfail206.hs:8:5:
-    Couldn't match type ‛(t0, Int)’ with ‛Bool -> (Int, Bool)’
+    Couldn't match type ‘(Integer, Int)’ with ‘Bool -> (Int, Bool)’
     Expected type: Int -> Bool -> (Int, Bool)
-      Actual type: Int -> (t0, Int)
+      Actual type: Int -> (Integer, Int)
     In the expression: (1,)
-    In an equation for ‛b’: b = (1,)
+    In an equation for ‘b’: b = (1,)
 
 tcfail206.hs:11:5:
-    Couldn't match type ‛a’ with ‛Bool’
-      ‛a’ is a rigid type variable bound by
+    Couldn't match type ‘a’ with ‘Bool’
+      ‘a’ is a rigid type variable bound by
           the type signature for c :: a -> (a, Bool) at tcfail206.hs:10:6
     Expected type: a -> (a, Bool)
       Actual type: a -> (a, a)
     Relevant bindings include
       c :: a -> (a, Bool) (bound at tcfail206.hs:11:1)
     In the expression: (True || False,)
-    In an equation for ‛c’: c = (True || False,)
+    In an equation for ‘c’: c = (True || False,)
 
 tcfail206.hs:14:5:
-    Couldn't match type ‛Bool’ with ‛Int’
+    Couldn't match type ‘Bool’ with ‘Int’
     Expected type: Bool -> (# Int, Bool #)
       Actual type: Bool -> (# Bool, Bool #)
     In the expression: (# , True #)
-    In an equation for ‛d’: d = (# , True #)
+    In an equation for ‘d’: d = (# , True #)
 
 tcfail206.hs:17:5:
-    Couldn't match type ‛(# a0, Int #)’ with ‛Bool -> (# Int, Bool #)’
+    Couldn't match type ‘(# Integer, Int #)’
+                  with ‘Bool -> (# Int, Bool #)’
     Expected type: Int -> Bool -> (# Int, Bool #)
-      Actual type: Int -> (# a0, Int #)
+      Actual type: Int -> (# Integer, Int #)
     In the expression: (# 1, #)
-    In an equation for ‛e’: e = (# 1, #)
+    In an equation for ‘e’: e = (# 1, #)
 
 tcfail206.hs:20:5:
-    Couldn't match type ‛a’ with ‛Bool’
-      ‛a’ is a rigid type variable bound by
+    Couldn't match type ‘a’ with ‘Bool’
+      ‘a’ is a rigid type variable bound by
           the type signature for f :: a -> (# a, Bool #) at tcfail206.hs:19:6
     Expected type: a -> (# a, Bool #)
       Actual type: a -> (# a, a #)
     Relevant bindings include
       f :: a -> (# a, Bool #) (bound at tcfail206.hs:20:1)
     In the expression: (# True || False, #)
-    In an equation for ‛f’: f = (# True || False, #)
+    In an equation for ‘f’: f = (# True || False, #)
diff --git a/testsuite/tests/typecheck/should_fail/tcfail207.stderr b/testsuite/tests/typecheck/should_fail/tcfail207.stderr
index 3263589203c4..986d7d5740aa 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail207.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail207.stderr
@@ -1,14 +1,14 @@
 
 tcfail207.hs:5:7:
-    Couldn't match expected type ‛[Int] -> [Int]’
-                with actual type ‛[a1]’
-    Possible cause: ‛take’ is applied to too many arguments
+    Couldn't match expected type ‘[Int] -> [Int]’
+                with actual type ‘[a1]’
+    Possible cause: ‘take’ is applied to too many arguments
     In the expression: take x []
-    In an equation for ‛f’: f x = take x []
+    In an equation for ‘f’: f x = take x []
 
 tcfail207.hs:9:5:
-    Couldn't match expected type ‛[Int]’
-                with actual type ‛[a0] -> [a0]’
-    Probable cause: ‛take’ is applied to too few arguments
+    Couldn't match expected type ‘[Int]’
+                with actual type ‘[a0] -> [a0]’
+    Probable cause: ‘take’ is applied to too few arguments
     In the expression: take 3
-    In an equation for ‛g’: g = take 3
+    In an equation for ‘g’: g = take 3
diff --git a/testsuite/tests/typecheck/should_fail/tcfail208.stderr b/testsuite/tests/typecheck/should_fail/tcfail208.stderr
index 7419e90c523b..c83c63be3f82 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail208.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail208.stderr
@@ -1,9 +1,9 @@
 
 tcfail208.hs:4:19:
-    Could not deduce (Eq (m a)) arising from a use of ‛==’
+    Could not deduce (Eq (m a)) arising from a use of ‘==’
     from the context (Monad m, Eq a)
       bound by the type signature for
                  f :: (Monad m, Eq a) => a -> m a -> Bool
       at tcfail208.hs:3:6-40
     In the expression: (return x == y)
-    In an equation for ‛f’: f x y = (return x == y)
+    In an equation for ‘f’: f x y = (return x == y)
diff --git a/testsuite/tests/typecheck/should_fail/tcfail209.stderr b/testsuite/tests/typecheck/should_fail/tcfail209.stderr
index 7e7e2bd19a83..d9a9ca37aec4 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail209.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail209.stderr
@@ -1,5 +1,5 @@
 
 tcfail209.hs:3:1:
-    Illegal constraint synonym of kind: ‛* -> Constraint’
+    Illegal constraint synonym of kind: ‘* -> Constraint’
       (Use ConstraintKinds to permit this)
-    In the type declaration for ‛Showish’
+    In the type declaration for ‘Showish’
diff --git a/testsuite/tests/typecheck/should_fail/tcfail209a.stderr b/testsuite/tests/typecheck/should_fail/tcfail209a.stderr
index 25721019c7c2..446d76f4214e 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail209a.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail209a.stderr
@@ -2,5 +2,5 @@
 tcfail209a.hs:3:6:
     Illegal tuple constraint: (Show a, Num a)
       (Use ConstraintKinds to permit this)
-    In the type signature for ‛g’:
+    In the type signature for ‘g’:
       g :: ((Show a, Num a), Eq a) => a -> a
diff --git a/testsuite/tests/typecheck/should_fail/tcfail210.stderr b/testsuite/tests/typecheck/should_fail/tcfail210.stderr
index 9b998d425efe..9df9b7ef8f8f 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail210.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail210.stderr
@@ -1,3 +1,3 @@
 
 tcfail210.hs:4:31:
-    Not in scope: type constructor or class ‛Constraint’
+    Not in scope: type constructor or class ‘Constraint’
diff --git a/testsuite/tests/typecheck/should_fail/tcfail211.stderr b/testsuite/tests/typecheck/should_fail/tcfail211.stderr
index 491349b1237e..0d9d23d9b166 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail211.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail211.stderr
@@ -1,6 +1,6 @@
 
-tcfail211.hs:16:13:
-    Unbound implicit parameter (?imp::Int) arising from a use of ‛test’
-    In the first argument of ‛print’, namely ‛test’
-    In the expression: print test
-    In an equation for ‛use’: use = print test
+tcfail211.hs:5:1:
+    Illegal implicit parameter ‘?imp::Int’
+    In the context: (?imp::Int)
+    While checking the super-classes of class ‘D’
+    In the class declaration for ‘D’
diff --git a/testsuite/tests/typecheck/should_fail/tcfail212.stderr b/testsuite/tests/typecheck/should_fail/tcfail212.stderr
index b116fd1d9580..72e5fe8104ef 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail212.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail212.stderr
@@ -1,10 +1,10 @@
 
 tcfail212.hs:10:7:
-    Expecting one more argument to ‛Maybe’
-    The first argument of a tuple should have kind ‛*’,
-      but ‛Maybe’ has kind ‛* -> *’
-    In the type signature for ‛f’: f :: (Maybe, Either Int)
+    Expecting one more argument to ‘Maybe’
+    The first argument of a tuple should have kind ‘*’,
+      but ‘Maybe’ has kind ‘* -> *’
+    In the type signature for ‘f’: f :: (Maybe, Either Int)
 
 tcfail212.hs:13:7:
-    Expecting a lifted type, but ‛Int#’ is unlifted
-    In the type signature for ‛g’: g :: (Int#, Int#)
+    Expecting a lifted type, but ‘Int#’ is unlifted
+    In the type signature for ‘g’: g :: (Int#, Int#)
diff --git a/testsuite/tests/typecheck/should_fail/tcfail213.stderr b/testsuite/tests/typecheck/should_fail/tcfail213.stderr
index 14c330be87e6..f54379481fc4 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail213.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail213.stderr
@@ -1,7 +1,7 @@
 
 tcfail213.hs:8:1:
-    Illegal constraint ‛F a’ in a superclass/instance context
+    Illegal constraint ‘F a’ in a superclass/instance context
       (Use UndecidableInstances to permit this)
     In the context: (F a)
-    While checking the super-classes of class ‛C’
-    In the class declaration for ‛C’
+    While checking the super-classes of class ‘C’
+    In the class declaration for ‘C’
diff --git a/testsuite/tests/typecheck/should_fail/tcfail214.stderr b/testsuite/tests/typecheck/should_fail/tcfail214.stderr
index f3d90784db97..93101f45cc35 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail214.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail214.stderr
@@ -1,7 +1,7 @@
 
 tcfail214.hs:9:10:
-    Illegal constraint ‛F a’ in a superclass/instance context
+    Illegal constraint ‘F a’ in a superclass/instance context
       (Use UndecidableInstances to permit this)
     In the context: (F a)
     While checking an instance declaration
-    In the instance declaration for ‛C [a]’
+    In the instance declaration for ‘C [a]’
diff --git a/testsuite/tests/typecheck/should_fail/tcfail215.stderr b/testsuite/tests/typecheck/should_fail/tcfail215.stderr
index a9fe4da24e17..215756182741 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail215.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail215.stderr
@@ -1,4 +1,4 @@
 
 tcfail215.hs:8:15:
-    Expecting a lifted type, but ‛Int#’ is unlifted
-    In the type signature for ‛foo’: foo :: ?x :: Int# => Int
+    Expecting a lifted type, but ‘Int#’ is unlifted
+    In the type signature for ‘foo’: foo :: (?x :: Int#) => Int
diff --git a/testsuite/tests/typecheck/should_fail/tcfail216.stderr b/testsuite/tests/typecheck/should_fail/tcfail216.stderr
index 11b077e7e11c..d3548674800c 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail216.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail216.stderr
@@ -1,4 +1,4 @@
 
 tcfail216.hs:5:1:
     Cycle in class declaration (via superclasses): A -> A
-    In the class declaration for ‛A’
+    In the class declaration for ‘A’
diff --git a/testsuite/tests/typecheck/should_fail/tcfail217.stderr b/testsuite/tests/typecheck/should_fail/tcfail217.stderr
index 64584169e9c4..c51b97d8b5d3 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail217.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail217.stderr
@@ -1,4 +1,4 @@
 
 tcfail217.hs:7:1:
     Cycle in class declaration (via superclasses): A -> Aish -> A
-    In the class declaration for ‛A’
+    In the class declaration for ‘A’
diff --git a/testsuite/tests/typecheck/should_fail/tcfail218.hs b/testsuite/tests/typecheck/should_fail/tcfail218.hs
index ed054596c031..9a5f4ce7d29d 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail218.hs
+++ b/testsuite/tests/typecheck/should_fail/tcfail218.hs
@@ -1,12 +1,22 @@
-{-# LANGUAGE IncoherentInstances, MultiParamTypeClasses, FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}
 
-import Tcfail218_Help
+module Tcfail218 where
 
-instance C [a] b where foo = undefined
-instance C a Int where foo = undefined
+class C a b where foo :: (a,b)
 
--- Should fail, as a more specific, unifying but not matching, non-incoherent instance exists.
-x :: ([a],b)
+instance                    C [Int] Bool where foo = undefined
+instance                    C [a]   b   where foo = undefined
+instance {-# INCOHERENT #-} C a     Int where foo = undefined
+
+
+x :: ([a],Bool)
+-- Needs C [a] b.
+-- Should fail, as a more specific, unifying but not matching
+-- non-incoherent instance exists, namely C [Int] Bool
 x = foo
 
-main = return ()
+-- Needs C [a] Int.
+-- Should succeed, because two instances match, but one is incoherent
+y :: ([a],Int)
+y = foo
+
diff --git a/testsuite/tests/typecheck/should_fail/tcfail218.stderr b/testsuite/tests/typecheck/should_fail/tcfail218.stderr
index 2afa2016527d..efb6c4c9d3d6 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail218.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail218.stderr
@@ -1,11 +1,11 @@
 
-tcfail218.hs:10:5:
-    Overlapping instances for C [a] b arising from a use of ‛foo’
+tcfail218.hs:16:5:
+    Overlapping instances for C [a] Bool arising from a use of ‘foo’
     Matching instances:
-      instance [incoherent] C [a] b -- Defined at tcfail218.hs:5:10
-      instance C [Int] b -- Defined at Tcfail218_Help.hs:7:10
-    (The choice depends on the instantiation of ‛a, b’
+      instance C [a] b -- Defined at tcfail218.hs:8:29
+      instance C [Int] Bool -- Defined at tcfail218.hs:7:29
+    (The choice depends on the instantiation of ‘a’
      To pick the first instance above, use IncoherentInstances
      when compiling the other instance declarations)
     In the expression: foo
-    In an equation for ‛x’: x = foo
+    In an equation for ‘x’: x = foo
diff --git a/testsuite/tests/typecheck/should_run/T7861.stderr b/testsuite/tests/typecheck/should_run/T7861.stderr
index 4f2b6230b0b6..b3e3140edc52 100644
--- a/testsuite/tests/typecheck/should_run/T7861.stderr
+++ b/testsuite/tests/typecheck/should_run/T7861.stderr
@@ -1,10 +1,10 @@
 T7861: T7861.hs:11:5:
-    Couldn't match type ‛a’ with ‛[a]’
-      ‛a’ is a rigid type variable bound by
+    Couldn't match type ‘a’ with ‘[a]’
+      ‘a’ is a rigid type variable bound by
           the type signature for f :: A a -> a at T7861.hs:10:6
     Expected type: A a -> a
       Actual type: A a -> [a]
     Relevant bindings include f :: A a -> a (bound at T7861.hs:11:1)
     In the expression: doA
-    In an equation for ‛f’: f = doA
+    In an equation for ‘f’: f = doA
 (deferred type error)
diff --git a/testsuite/tests/typecheck/should_run/T8739.hs b/testsuite/tests/typecheck/should_run/T8739.hs
new file mode 100644
index 000000000000..233d11d79cbb
--- /dev/null
+++ b/testsuite/tests/typecheck/should_run/T8739.hs
@@ -0,0 +1,10 @@
+{-# LANGUAGE MagicHash #-}
+module Main where
+import GHC.Exts
+
+go :: () -> Int#
+go () = 0#
+
+main = print (lazy (I# (go $ ())))
+
+
diff --git a/testsuite/tests/typecheck/should_run/T8739.stdout b/testsuite/tests/typecheck/should_run/T8739.stdout
new file mode 100644
index 000000000000..573541ac9702
--- /dev/null
+++ b/testsuite/tests/typecheck/should_run/T8739.stdout
@@ -0,0 +1 @@
+0
diff --git a/testsuite/tests/typecheck/should_run/TcCoercible.hs b/testsuite/tests/typecheck/should_run/TcCoercible.hs
index e3b29af23b5b..284984029fb7 100644
--- a/testsuite/tests/typecheck/should_run/TcCoercible.hs
+++ b/testsuite/tests/typecheck/should_run/TcCoercible.hs
@@ -1,6 +1,6 @@
 {-# LANGUAGE RoleAnnotations, StandaloneDeriving, FlexibleContexts, UndecidableInstances, GADTs, TypeFamilies #-}
 
-import GHC.Prim (Coercible, coerce)
+import Data.Coerce (Coercible, coerce)
 import Data.Monoid (mempty, First(First), Last())
 
 newtype Age = Age Int deriving Show
@@ -23,7 +23,8 @@ newtype NonEtad a b = NonEtad (Either b a) deriving Show
 newtype Fix f = Fix (f (Fix f))
 deriving instance Show (f (Fix f)) => Show (Fix f)
 
-newtype FixEither a = FixEither (Either a (FixEither a)) deriving Show
+-- Later, however, this stopped working (#9117)
+-- newtype FixEither a = FixEither (Either a (FixEither a)) deriving Show
 
 -- This ensures that explicitly given constraints are consulted, even 
 -- at higher depths
@@ -59,8 +60,8 @@ main = do
     print (coerce $ (Fix (Left ()) :: Fix (Either ())) :: Either () (Fix (Either ())))
     print (coerce $ (Left () :: Either () (Fix (Either ()))) :: Fix (Either ()))
 
-    print (coerce $ (FixEither (Left age) :: FixEither Age) :: Either Int (FixEither Int))
-    print (coerce $ (Left one :: Either Int (FixEither Age)) :: FixEither Age)
+    -- print (coerce $ (FixEither (Left age) :: FixEither Age) :: Either Int (FixEither Int))
+    -- print (coerce $ (Left one :: Either Int (FixEither Age)) :: FixEither Age)
 
     print (coerce $ True :: Fam Int)
     print (coerce $ FamInt True :: Bool)
diff --git a/testsuite/tests/typecheck/should_run/TcCoercible.stdout b/testsuite/tests/typecheck/should_run/TcCoercible.stdout
index 7b8071fe12b0..8ac218144063 100644
--- a/testsuite/tests/typecheck/should_run/TcCoercible.stdout
+++ b/testsuite/tests/typecheck/should_run/TcCoercible.stdout
@@ -14,7 +14,5 @@ List [1]
 NonEtad (Right 1)
 Left ()
 Fix (Left ())
-Left 1
-FixEither (Left (Age 1))
 FamInt True
 True
diff --git a/testsuite/tests/typecheck/should_run/TcNullaryTC.hs b/testsuite/tests/typecheck/should_run/TcNullaryTC.hs
index a94d3058b04d..17e3f4c425ae 100644
--- a/testsuite/tests/typecheck/should_run/TcNullaryTC.hs
+++ b/testsuite/tests/typecheck/should_run/TcNullaryTC.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE NullaryTypeClasses #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
 
 module Main where
 
diff --git a/testsuite/tests/typecheck/should_run/all.T b/testsuite/tests/typecheck/should_run/all.T
index fe87cecaefd2..760d5e1452de 100755
--- a/testsuite/tests/typecheck/should_run/all.T
+++ b/testsuite/tests/typecheck/should_run/all.T
@@ -12,6 +12,8 @@ test('tcrun003', normal, compile_and_run, [''])
 test('tcrun004', normal, compile_and_run, [''])
 test('tcrun005', normal, compile_and_run, [''])
 test('Defer01', normal, compile_and_run, [''])
+test('TcNullaryTC', when(compiler_lt('ghc', '7.7'), skip), compile_and_run, [''])
+test('TcCoercible', when(compiler_lt('ghc', '7.7'), skip), compile_and_run, [''])
 
 # -----------------------------------------------------------------------------
 # Skip everything else if fast is on
@@ -35,9 +37,7 @@ test('tcrun017', normal, compile_and_run, [''])
 test('tcrun018', normal, compile_and_run, [''])
 test('tcrun019', normal, compile_and_run, [''])
 test('tcrun020', normal, compile_and_run, [''])
-# Doesn't work with External Core due to datatype with no constructors
-test('tcrun021', expect_fail_for(['extcore','optextcore']),
-     compile_and_run, ['-package containers'])
+test('tcrun021', normal, compile_and_run, ['-package containers'])
 test('tcrun022', [omit_ways(['ghci']),only_compiler_types(['ghc'])],
      compile_and_run, ['-O'])
 test('tcrun023', normal, compile_and_run, ['-O'])
@@ -46,8 +46,7 @@ test('tcrun025', extra_clean(['TcRun025_B.hi', 'TcRun025_B.o']),
      multimod_compile_and_run, ['tcrun025',''])
 test('tcrun026', normal, compile_and_run, [''])
 test('tcrun027', normal, compile_and_run, [''])
-# Doesn't work with External Core due to datatype with no constructors
-test('tcrun028', expect_fail_for(['extcore','optextcore']), compile_and_run, [''])
+test('tcrun028', normal, compile_and_run, [''])
 test('tcrun029', normal, compile_and_run, [''])
 test('tcrun030', normal, compile_and_run, [''])
 test('tcrun031', only_compiler_types(['ghc']), compile_and_run, [''])
@@ -69,7 +68,7 @@ test('tcrun041', omit_ways(['ghci']), compile_and_run, [''])
 test('tcrun042', normal, compile_and_run, [''])
 test('tcrun043', normal, compile_and_run, [''])
 test('tcrun044', normal, compile_and_run, [''])
-test('tcrun045', normal, compile_and_run, [''])
+test('tcrun045', normal, compile_fail, [''])
 test('tcrun046', normal, compile_and_run, [''])
 test('tcrun047', [omit_ways(['ghci']), only_compiler_types(['ghc'])],
      compile_and_run, [''])
@@ -108,9 +107,8 @@ test('T6117', normal, compile_and_run, [''])
 test('T5751', normal, compile_and_run, [''])
 test('T5913', normal, compile_and_run, [''])
 test('T7748', normal, compile_and_run, [''])
-test('TcNullaryTC', when(compiler_lt('ghc', '7.7'), skip), compile_and_run, [''])
 test('T7861', exit_code(1), compile_and_run, [''])
 test('TcTypeNatSimpleRun', normal, compile_and_run, [''])
-test('TcCoercible', when(compiler_lt('ghc', '7.7'), skip), compile_and_run, [''])
 test('T8119', normal, ghci_script, ['T8119.script'])
 test('T8492', normal, compile_and_run, [''])
+test('T8739', normal, compile_and_run, [''])
diff --git a/testsuite/tests/typecheck/should_run/tcrun.stderr b/testsuite/tests/typecheck/should_run/tcrun.stderr
new file mode 100644
index 000000000000..0519ecba6ea9
--- /dev/null
+++ b/testsuite/tests/typecheck/should_run/tcrun.stderr
@@ -0,0 +1 @@
+ 
\ No newline at end of file
diff --git a/testsuite/tests/typecheck/should_run/tcrun035.stderr b/testsuite/tests/typecheck/should_run/tcrun035.stderr
index 9c7a3c748857..2eed11d2f32d 100644
--- a/testsuite/tests/typecheck/should_run/tcrun035.stderr
+++ b/testsuite/tests/typecheck/should_run/tcrun035.stderr
@@ -1,11 +1,11 @@
 
 tcrun035.hs:13:7:
-    Couldn't match type ‛IO a’
-                  with ‛forall (m :: * -> *). Monad m => m a’
+    Couldn't match type ‘IO a’
+                  with ‘forall (m :: * -> *). Monad m => m a’
     Expected type: (forall (m :: * -> *). Monad m => m a) -> IO a
       Actual type: IO a -> IO a
     Relevant bindings include
       foo :: (forall (m :: * -> *). Monad m => m a) -> IO a
         (bound at tcrun035.hs:13:1)
     In the expression: id . id
-    In an equation for ‛foo’: foo = id . id
+    In an equation for ‘foo’: foo = id . id
diff --git a/testsuite/tests/typecheck/should_run/tcrun045.stderr b/testsuite/tests/typecheck/should_run/tcrun045.stderr
new file mode 100644
index 000000000000..4017279ecca9
--- /dev/null
+++ b/testsuite/tests/typecheck/should_run/tcrun045.stderr
@@ -0,0 +1,6 @@
+
+tcrun045.hs:24:1:
+    Illegal implicit parameter ‘?imp::Int’
+    In the context: (?imp::Int)
+    While checking the super-classes of class ‘D’
+    In the class declaration for ‘D’
diff --git a/testsuite/tests/warnings/minimal/WarnMinimal.stderr b/testsuite/tests/warnings/minimal/WarnMinimal.stderr
index 09db27bc5a1a..d07eee875a63 100644
--- a/testsuite/tests/warnings/minimal/WarnMinimal.stderr
+++ b/testsuite/tests/warnings/minimal/WarnMinimal.stderr
@@ -1,54 +1,54 @@
 
 WarnMinimal.hs:16:10: Warning:
     No explicit implementation for
-      either ‛foo1’ or ‛foo2’
-    In the instance declaration for ‛Foo Int’
+      either ‘foo1’ or ‘foo2’
+    In the instance declaration for ‘Foo Int’
 
 WarnMinimal.hs:60:10: Warning:
     No explicit implementation for
-      either ‛join'’ or ‛bind'’
-    In the instance declaration for ‛Monad' ((->) e)’
+      either ‘join'’ or ‘bind'’
+    In the instance declaration for ‘Monad' ((->) e)’
 
 WarnMinimal.hs:66:10: Warning:
     No explicit implementation for
-      ‛return'’
-    In the instance declaration for ‛Monad' Id’
+      ‘return'’
+    In the instance declaration for ‘Monad' Id’
 
 WarnMinimal.hs:72:10: Warning:
     No explicit implementation for
-      ‛return'’
-    In the instance declaration for ‛Monad' Id2’
+      ‘return'’
+    In the instance declaration for ‘Monad' Id2’
 
 WarnMinimal.hs:79:10: Warning:
     No explicit implementation for
-      ‛return'’ and (either (‛fmap'’ and ‛join'’) or ‛bind'’)
-    In the instance declaration for ‛Monad' Id3’
+      ‘return'’ and (either (‘fmap'’ and ‘join'’) or ‘bind'’)
+    In the instance declaration for ‘Monad' Id3’
 
 WarnMinimal.hs:84:1: Warning:
     The MINIMAL pragma does not require:
-      ‛cheater’
+      ‘cheater’
     but there is no default implementation.
-    In the class declaration for ‛Cheater’
+    In the class declaration for ‘Cheater’
 
 WarnMinimal.hs:92:1: Warning:
     The MINIMAL pragma does not require:
-      ‛cheater3b’
+      ‘cheater3b’
     but there is no default implementation.
-    In the class declaration for ‛Cheater3’
+    In the class declaration for ‘Cheater3’
 
 WarnMinimal.hs:99:10: Warning:
     No explicit implementation for
-      ‛+’, ‛*’, ‛abs’, ‛signum’, ‛fromInteger’, and (either ‛negate’
+      ‘+’, ‘*’, ‘abs’, ‘signum’, ‘fromInteger’, and (either ‘negate’
                                                             or
-                                                            ‛-’)
-    In the instance declaration for ‛Num Bool’
+                                                            ‘-’)
+    In the instance declaration for ‘Num Bool’
 
 WarnMinimal.hs:105:10: Warning:
     No explicit implementation for
-      ‛needed’
-    In the instance declaration for ‛NoExplicit Int’
+      ‘needed’
+    In the instance declaration for ‘NoExplicit Int’
 
 WarnMinimal.hs:116:10: Warning:
     No explicit implementation for
-      either ‛===’ or ‛/==’
-    In the instance declaration for ‛Eq' Blarg’
+      either ‘===’ or ‘/==’
+    In the instance declaration for ‘Eq' Blarg’
diff --git a/testsuite/tests/warnings/minimal/WarnMinimalFail2.stderr b/testsuite/tests/warnings/minimal/WarnMinimalFail2.stderr
index 2648b4718381..70584cdf2839 100644
--- a/testsuite/tests/warnings/minimal/WarnMinimalFail2.stderr
+++ b/testsuite/tests/warnings/minimal/WarnMinimalFail2.stderr
@@ -1,3 +1,3 @@
 
 WarnMinimalFail2.hs:8:15:
-    ‛global’ is not a (visible) method of class ‛Foo’
+    ‘global’ is not a (visible) method of class ‘Foo’
diff --git a/testsuite/tests/warnings/minimal/WarnMinimalFail3.stderr b/testsuite/tests/warnings/minimal/WarnMinimalFail3.stderr
index 511117595c70..3b2616b60d39 100644
--- a/testsuite/tests/warnings/minimal/WarnMinimalFail3.stderr
+++ b/testsuite/tests/warnings/minimal/WarnMinimalFail3.stderr
@@ -1,3 +1,3 @@
 
 WarnMinimalFail3.hs:12:15:
-    ‛parent’ is not a (visible) method of class ‛Child’
+    ‘parent’ is not a (visible) method of class ‘Child’
diff --git a/testsuite/tests/warnings/should_compile/Makefile b/testsuite/tests/warnings/should_compile/Makefile
new file mode 100644
index 000000000000..9101fbd40ada
--- /dev/null
+++ b/testsuite/tests/warnings/should_compile/Makefile
@@ -0,0 +1,3 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
diff --git a/testsuite/tests/warnings/should_compile/T9178.hs b/testsuite/tests/warnings/should_compile/T9178.hs
new file mode 100644
index 000000000000..9171381e3516
--- /dev/null
+++ b/testsuite/tests/warnings/should_compile/T9178.hs
@@ -0,0 +1,9 @@
+
+
+module T9178 where
+
+import T9178DataType
+
+
+instance Show T9178_Type where
+         show _ = undefined
\ No newline at end of file
diff --git a/testsuite/tests/warnings/should_compile/T9178.stderr b/testsuite/tests/warnings/should_compile/T9178.stderr
new file mode 100644
index 000000000000..6f4b6c02958c
--- /dev/null
+++ b/testsuite/tests/warnings/should_compile/T9178.stderr
@@ -0,0 +1,8 @@
+[1 of 2] Compiling T9178DataType    ( T9178DataType.hs, T9178DataType.o )
+[2 of 2] Compiling T9178            ( T9178.hs, T9178.o )
+
+T9178.hs:8:10: Warning:
+    Orphan instance: instance Show T9178_Type
+    To avoid this
+        move the instance declaration to the module of the class or of the type, or
+        wrap the type with a newtype and declare the instance on the new type.
diff --git a/testsuite/tests/warnings/should_compile/T9178DataType.hs b/testsuite/tests/warnings/should_compile/T9178DataType.hs
new file mode 100644
index 000000000000..e274117fe320
--- /dev/null
+++ b/testsuite/tests/warnings/should_compile/T9178DataType.hs
@@ -0,0 +1,5 @@
+
+
+module T9178DataType where
+
+data T9178_Type
diff --git a/testsuite/tests/warnings/should_compile/all.T b/testsuite/tests/warnings/should_compile/all.T
new file mode 100644
index 000000000000..f6747bf849e7
--- /dev/null
+++ b/testsuite/tests/warnings/should_compile/all.T
@@ -0,0 +1,3 @@
+test('T9178', extra_clean(['T9178.o', 'T9178DataType.o',
+			   'T9178.hi', 'T9178DataType.hi']),
+	      multimod_compile, ['T9178', '-Wall'])
\ No newline at end of file
diff --git a/testsuite/timeout/timeout.hs b/testsuite/timeout/timeout.hs
index 08066879b00e..f78baa10ea69 100644
--- a/testsuite/timeout/timeout.hs
+++ b/testsuite/timeout/timeout.hs
@@ -33,10 +33,6 @@ main = do
           _ -> die ("Can't parse " ++ show secs ++ " as a number of seconds")
       _ -> die ("Bad arguments " ++ show args)
 
-die :: String -> IO ()
-die msg = do hPutStrLn stderr ("timeout: " ++ msg)
-             exitWith (ExitFailure 1)
-
 timeoutMsg :: String
 timeoutMsg = "Timeout happened...killing process..."
 
diff --git a/utils/checkUniques/Makefile b/utils/checkUniques/Makefile
index a7b2df17e2de..b017473da323 100644
--- a/utils/checkUniques/Makefile
+++ b/utils/checkUniques/Makefile
@@ -13,4 +13,4 @@ check: checkUniques
 	./checkUniques mkPreludeMiscIdUnique  $(PREL_NAMES) $(DS_META)
 
 checkUniques: checkUniques.hs
-	$(GHC) --make $@
+	$(GHC) -O -XHaskell2010 --make $@
diff --git a/utils/checkUniques/checkUniques.hs b/utils/checkUniques/checkUniques.hs
index d8858dee261b..2eda188e3c76 100644
--- a/utils/checkUniques/checkUniques.hs
+++ b/utils/checkUniques/checkUniques.hs
@@ -1,5 +1,3 @@
-{-# LANGUAGE PatternGuards #-}
-
 -- Some things could be improved, e.g.:
 -- * Check that each file given contains at least one instance of the
 --   function
diff --git a/utils/compare_sizes/Main.hs b/utils/compare_sizes/Main.hs
index bb1685ff6a0e..c64a55485bfe 100644
--- a/utils/compare_sizes/Main.hs
+++ b/utils/compare_sizes/Main.hs
@@ -1,4 +1,4 @@
--- This program compares the sizes of corresponding files in two tress
+-- This program compares the sizes of corresponding files in two trees
 
 --   $ ./compareSizes --hi ~/ghc/darcs/ghc ~/ghc/6.12-branch/ghc
 --        Size | Change | Filename
diff --git a/utils/compare_sizes/compareSizes.cabal b/utils/compare_sizes/compareSizes.cabal
index 32acb1d6e728..f8f42636a796 100644
--- a/utils/compare_sizes/compareSizes.cabal
+++ b/utils/compare_sizes/compareSizes.cabal
@@ -1,6 +1,6 @@
 name:                 compareSizes
 version:              0.1.0.0
-cabal-version:        >= 1.6
+cabal-version:        >=1.10
 license:              BSD3
 build-type:           Simple
 license-file:         LICENSE
@@ -10,6 +10,8 @@ description:          Size comparison util
 category:             Development
 
 executable compareSizes
+  default-language: Haskell2010
+
   build-depends:
     base >= 4 && < 5,
     directory,
diff --git a/utils/coverity/model.c b/utils/coverity/model.c
new file mode 100644
index 000000000000..d0a3708b65bf
--- /dev/null
+++ b/utils/coverity/model.c
@@ -0,0 +1,112 @@
+/* Coverity Scan model
+ * This is a modeling file for Coverity Scan. Modeling helps to avoid false
+ * positives.
+ *
+ * - A model file can't import any header files.  Some built-in primitives are
+ *   available but not wchar_t, NULL etc.
+ * - Modeling doesn't need full structs and typedefs. Rudimentary structs
+ *   and similar types are sufficient.
+ * - An uninitialized local variable signifies that the variable could be
+ *   any value.
+ *
+ * The model file must be uploaded by an admin in the analysis settings of
+ * http://scan.coverity.com/projects/1919
+ */
+
+#define NULL ((void*)0)
+#define assert(x) if (!(x)) __coverity_panic__();
+
+/* type decls */
+typedef struct {} va_list;
+
+/* glibc functions */
+void *malloc (size_t);
+void *calloc (size_t, size_t);
+void *realloc (void *, size_t);
+void free (void *);
+
+/* rts allocation functions */
+
+void* stgMallocBytes(int n, char *msg)
+{
+  void *mem;
+  __coverity_negative_sink__((size_t)n);
+  mem = malloc((size_t)n);
+  assert(mem != NULL);
+  return mem;
+}
+
+void* stgReallocBytes(void *p, int n, char *msg)
+{
+  void *mem;
+  __coverity_negative_sink__((size_t)n);
+
+  /* man 3 realloc: if p == NULL, then realloc is equivalent to malloc() */
+  if (p == NULL) {
+    mem = malloc((size_t)n);
+    assert(mem != NULL);
+    return mem;
+  }
+
+  /* man 3 realloc: if n == 0, then realloc is equivalent to free() */
+  if (n == 0) {
+    free(p);
+    return NULL;
+  } else {
+    mem = realloc(p, (size_t)n);
+    assert(mem != NULL);
+    return mem;
+  }
+}
+
+void* stgCallocBytes(int n, int m, char *msg)
+{
+  void *mem;
+  __coverity_negative_sink__((size_t)n);
+  __coverity_negative_sink__((size_t)m);
+  mem = calloc(n, m);
+  assert(mem != NULL);
+  return mem;
+}
+
+void stgFree(void* p)
+{
+  free(p);
+}
+
+/* Kill paths */
+
+void stg_exit(int n)
+{
+  __coverity_panic__();
+}
+
+void shutdownThread(void)
+{
+  __coverity_panic__();
+}
+
+void shutdownHaskellAndExit(int exitCode, int fastExit)
+{
+  __coverity_panic__();
+}
+
+void shutdownHaskellAndSignal(int sig, int fastExit)
+{
+  __coverity_panic__();
+}
+
+void _assertFail(const char *filename, unsigned int linenum)
+{
+  __coverity_panic__();
+}
+
+void barf(const char *s, ...)
+{
+  __coverity_panic__();
+}
+
+void vbarf(const char *s, va_list ap)
+{
+  __coverity_panic__();
+}
diff --git a/utils/deriveConstants/DeriveConstants.hs b/utils/deriveConstants/DeriveConstants.hs
index 10df61ca7d21..9ee91397279b 100644
--- a/utils/deriveConstants/DeriveConstants.hs
+++ b/utils/deriveConstants/DeriveConstants.hs
@@ -10,20 +10,20 @@ into non-C source containing this information.
 
 ------------------------------------------------------------------------ -}
 
-import Control.Monad
-import Data.Bits
-import Data.Char
-import Data.List
+import Control.Monad (when, unless)
+import Data.Bits (shiftL)
+import Data.Char (toLower)
+import Data.List (stripPrefix)
 import Data.Map (Map)
 import qualified Data.Map as Map
-import Data.Maybe
-import Numeric
-import System.Environment
-import System.Exit
-import System.FilePath
-import System.IO
-import System.Info
-import System.Process
+import Data.Maybe (catMaybes)
+import Numeric (readHex)
+import System.Environment (getArgs)
+import System.Exit (ExitCode(ExitSuccess), exitFailure)
+import System.FilePath ((</>))
+import System.IO (stderr, hPutStrLn)
+import System.Info (os)
+import System.Process (showCommandForUser, readProcess, rawSystem)
 
 main :: IO ()
 main = do opts <- parseArgs
@@ -349,6 +349,10 @@ wanteds = concat
           ,structField C    "Capability" "context_switch"
           ,structField C    "Capability" "interrupt"
           ,structField C    "Capability" "sparks"
+          ,structField C    "Capability" "weak_ptr_list_hd"
+          ,structField C    "Capability" "weak_ptr_list_tl"
+          ,structField C    "Capability" "heap_ip_sample_count"
+          ,structField C    "Capability" "heap_ip_samples"
 
           ,structField Both "bdescr" "start"
           ,structField Both "bdescr" "free"
@@ -391,8 +395,11 @@ wanteds = concat
           ,closureField Both "StgMutArrPtrs" "ptrs"
           ,closureField Both "StgMutArrPtrs" "size"
 
+          ,closureSize  Both "StgSmallMutArrPtrs"
+          ,closureField Both "StgSmallMutArrPtrs" "ptrs"
+
           ,closureSize    Both "StgArrWords"
-          ,closureField   C    "StgArrWords" "bytes"
+          ,closureField   Both "StgArrWords" "bytes"
           ,closurePayload C    "StgArrWords" "payload"
 
           ,closureField  C    "StgTSO"      "_link"
@@ -638,7 +645,7 @@ getWanted verbose tmpdir gccProgram gccFlags nmProgram
              oFile = tmpdir </> "tmp.o"
          writeFile cFile cStuff
          execute verbose gccProgram (gccFlags ++ ["-c", cFile, "-o", oFile])
-         xs <- readProcess nmProgram [oFile] ""
+         xs <- readProcess nmProgram ["-P", oFile] ""
          let ls = lines xs
              ms = map parseNmLine ls
              m = Map.fromList $ catMaybes ms
@@ -707,28 +714,21 @@ getWanted verbose tmpdir gccProgram gccFlags nmProgram
           doWanted (ClosurePayloadMacro {}) = []
           doWanted (FieldTypeGcptrMacro {}) = []
 
-          -- parseNmLine parses nm output that looks like
-          -- "0000000b C derivedConstantMAX_Vanilla_REG"
+          -- parseNmLine parses "nm -P" output that looks like
+          -- "derivedConstantMAX_Vanilla_REG C 0000000b 0000000b" (GNU nm)
+          -- "_derivedConstantMAX_Vanilla_REG C b 0" (Mac OS X)
+          -- "_derivedConstantMAX_Vanilla_REG C 000000b" (MinGW)
+          -- "derivedConstantMAX_Vanilla_REG D        1        b" (Solaris)
           -- and returns ("MAX_Vanilla_REG", 11)
-          parseNmLine xs0 = case break (' ' ==) xs0 of
-                            (x1, ' ' : xs1) ->
-                                case break (' ' ==) xs1 of
-                                (x2, ' ' : x3) ->
-                                    case readHex x1 of
-                                    [(size, "")] ->
-                                        case x2 of
-                                        "C" ->
-                                            let x3' = case x3 of
-                                                      '_' : rest -> rest
-                                                      _          -> x3
-                                            in case stripPrefix prefix x3' of
-                                               Just name ->
-                                                   Just (name, size)
-                                               _ -> Nothing
-                                        _ -> Nothing
-                                    _ -> Nothing
-                                _ -> Nothing
-                            _ -> Nothing
+          parseNmLine line
+              = case words line of
+                ('_' : n) : "C" : s : _ -> mkP n s
+                n : "C" : s : _ -> mkP n s
+                [n, "D", _, s] -> mkP n s
+                _ -> Nothing
+              where mkP r s = case (stripPrefix prefix r, readHex s) of
+                        (Just name, [(size, "")]) -> Just (name, size)
+                        _ -> Nothing
 
           -- If an Int value is larger than 2^28 or smaller
           -- than -2^28, then fail.
diff --git a/utils/dll-split/Main.hs b/utils/dll-split/Main.hs
index c0e370641c56..c3f5a15a4a31 100644
--- a/utils/dll-split/Main.hs
+++ b/utils/dll-split/Main.hs
@@ -1,6 +1,3 @@
-
-{-# LANGUAGE PatternGuards #-}
-
 module Main (main) where
 
 import Control.Monad
diff --git a/utils/dll-split/dll-split.cabal b/utils/dll-split/dll-split.cabal
index bece0a47700e..290af0647203 100644
--- a/utils/dll-split/dll-split.cabal
+++ b/utils/dll-split/dll-split.cabal
@@ -10,9 +10,10 @@ Description:
 	XXX
 Category: Development
 build-type: Simple
-cabal-version: >=1.2
+cabal-version: >=1.10
 
 Executable dll-split
+    Default-Language: Haskell2010
     Main-Is: Main.hs
 
     Build-Depends: base       >= 4   && < 5,
diff --git a/utils/genapply/GenApply.hs b/utils/genapply/GenApply.hs
index dab6e91fde48..cfea2aa6c4d3 100644
--- a/utils/genapply/GenApply.hs
+++ b/utils/genapply/GenApply.hs
@@ -21,6 +21,7 @@ import Data.List        ( intersperse, nub, sort )
 import System.Exit
 import System.Environment
 import System.IO
+import Control.Arrow ((***))
 
 -- -----------------------------------------------------------------------------
 -- Argument kinds (rougly equivalent to PrimRep)
@@ -199,6 +200,45 @@ mb_tag_node arity | Just tag <- tagForArity arity = mkTagStmt tag <> semi
 
 mkTagStmt tag = text ("R1 = R1 + "++ show tag)
 
+type StackUsage = (Int, Int)  -- PROFILING, normal
+
+maxStack :: [StackUsage] -> StackUsage
+maxStack = (maximum *** maximum) . unzip
+
+stackCheck
+   :: RegStatus  -- Registerised status
+   -> [ArgRep]
+   -> Bool       -- args in regs?
+   -> Doc        -- fun_info_label
+   -> StackUsage
+   -> Doc
+stackCheck regstatus args args_in_regs fun_info_label (prof_sp, norm_sp) =
+  let
+     (reg_locs, leftovers, sp_offset) = assignRegs regstatus 1 args
+
+     cmp_sp n
+       | n > 0 =
+          text "if (Sp - WDS(" <> int n <> text ") < SpLim) {" $$
+          nest 4 (vcat [
+            if args_in_regs
+               then
+                 text "Sp_adj" <> parens (int (-sp_offset)) <> semi $$
+                 saveRegOffs reg_locs
+               else
+                 empty,
+            text "Sp(0) = " <> fun_info_label <> char ';',
+            mkJump regstatus (text "__stg_gc_enter_1") ["R1"] [] <> semi
+            ]) $$
+          char '}'
+       | otherwise = empty
+  in
+  vcat [ text "#ifdef PROFILING",
+         cmp_sp prof_sp,
+         text "#else",
+         cmp_sp norm_sp,
+         text "#endif"
+       ]
+
 genMkPAP :: RegStatus -- Register status
          -> String    -- Macro
          -> String    -- Jump target
@@ -212,17 +252,19 @@ genMkPAP :: RegStatus -- Register status
          -> Int       -- Size of all arguments
          -> Doc       -- info label
          -> Bool      -- Is a function
-         -> Doc
+         -> (Doc, StackUsage)
 genMkPAP regstatus macro jump live ticker disamb
         no_load_regs    -- don't load argument regs before jumping
         args_in_regs    -- arguments are already in regs
         is_pap args all_args_size fun_info_label
         is_fun_case
-  =  smaller_arity_cases
-  $$ exact_arity_case
-  $$ larger_arity_case
-        
+  = (doc, stack_usage)
+
   where
+    doc = vcat smaller_arity_doc $$ exact_arity_case $$ larger_arity_doc
+
+    stack_usage = maxStack (larger_arity_stack : smaller_arity_stack)
+
     n_args = length args
 
         -- offset of arguments on the stack at slow apply calls.
@@ -237,10 +279,17 @@ genMkPAP regstatus macro jump live ticker disamb
 --          Sp[0] = Sp[1];
 --          Sp[1] = (W_)&stg_ap_1_info;
 --          JMP_(GET_ENTRY(R1.cl));
-    smaller_arity_cases = vcat [ smaller_arity i | i <- [1..n_args-1] ]
+    (smaller_arity_doc, smaller_arity_stack)
+       = unzip [ smaller_arity i | i <- [1..n_args-1] ]
+
+    smaller_arity arity = (doc, stack_usage)
+      where
+        (save_regs, stack_usage)
+          | overflow_regs = save_extra_regs
+          | otherwise     = shuffle_extra_args
 
-    smaller_arity arity
-        =  text "if (arity == " <> int arity <> text ") {" $$
+        doc =
+           text "if (arity == " <> int arity <> text ") {" $$
            nest 4 (vcat [
            --  text "TICK_SLOW_CALL_" <> text ticker <> text "_TOO_MANY();",
 
@@ -253,9 +302,7 @@ genMkPAP regstatus macro jump live ticker disamb
                 -- If the extra arguments are on the stack, then we must
                 -- instead shuffle them down to make room for the info
                 -- table for the follow-on call.
-             if overflow_regs
-                then save_extra_regs
-                else shuffle_extra_args,
+             save_regs,
 
                 -- for a PAP, we have to arrange that the stack contains a
                 -- return address in the event that stg_PAP_entry fails its
@@ -271,81 +318,88 @@ genMkPAP regstatus macro jump live ticker disamb
             ]) $$
            text "}"
 
-        where
-                -- offsets in case we need to save regs:
-             (reg_locs, _, _)
-                = assignRegs regstatus stk_args_offset args
-
-                -- register assignment for *this function call*
-             (reg_locs', reg_call_leftovers, reg_call_sp_stk_args) 
-                = assignRegs regstatus stk_args_offset (take arity args)
-
-             load_regs
-                | no_load_regs || args_in_regs = empty
-                | otherwise                    = loadRegOffs reg_locs'
-
-             (this_call_args, rest_args) = splitAt arity args
-
-                -- the offset of the stack args from initial Sp
-             sp_stk_args
-                | args_in_regs = stk_args_offset
-                | no_load_regs = stk_args_offset
-                | otherwise    = reg_call_sp_stk_args
-
-                -- the stack args themselves
-             this_call_stack_args
-                | args_in_regs = reg_call_leftovers -- sp offsets are wrong
-                | no_load_regs = this_call_args
-                | otherwise    = reg_call_leftovers
-
-             stack_args_size = sum (map argSize this_call_stack_args)
-                
-             overflow_regs = args_in_regs && length reg_locs > length reg_locs'
-
-             save_extra_regs
-                = -- we have extra arguments in registers to save
-                  let
-                   extra_reg_locs = drop (length reg_locs') (reverse reg_locs)
-                   adj_reg_locs = [ (reg, off - adj + 1) | 
-                                    (reg,off) <- extra_reg_locs ]
-                   adj = case extra_reg_locs of
-                           (reg, fst_off):_ -> fst_off
-                   size = snd (last adj_reg_locs)
-                   in
-                   text "Sp_adj(" <> int (-size - 1) <> text ");" $$
-                   saveRegOffs adj_reg_locs $$
-                   loadSpWordOff "W_" 0 <> text " = " <>
-                                mkApplyInfoName rest_args <> semi
-
-             shuffle_extra_args
-                = vcat [text "#ifdef PROFILING",
-                        shuffle True,
+           -- offsets in case we need to save regs:
+        (reg_locs, _, _)
+           = assignRegs regstatus stk_args_offset args
+
+           -- register assignment for *this function call*
+        (reg_locs', reg_call_leftovers, reg_call_sp_stk_args) 
+           = assignRegs regstatus stk_args_offset (take arity args)
+
+        load_regs
+           | no_load_regs || args_in_regs = empty
+           | otherwise                    = loadRegOffs reg_locs'
+
+        (this_call_args, rest_args) = splitAt arity args
+
+           -- the offset of the stack args from initial Sp
+        sp_stk_args
+           | args_in_regs = stk_args_offset
+           | no_load_regs = stk_args_offset
+           | otherwise    = reg_call_sp_stk_args
+
+           -- the stack args themselves
+        this_call_stack_args
+           | args_in_regs = reg_call_leftovers -- sp offsets are wrong
+           | no_load_regs = this_call_args
+           | otherwise    = reg_call_leftovers
+
+        stack_args_size = sum (map argSize this_call_stack_args)
+           
+        overflow_regs = args_in_regs && length reg_locs > length reg_locs'
+
+        save_extra_regs = (doc, (size,size))
+          where
+             -- we have extra arguments in registers to save
+              extra_reg_locs = drop (length reg_locs') (reverse reg_locs)
+              adj_reg_locs = [ (reg, off - adj + 1) | 
+                               (reg,off) <- extra_reg_locs ]
+              adj = case extra_reg_locs of
+                      (reg, fst_off):_ -> fst_off
+              size = snd (last adj_reg_locs) + 1
+
+              doc =
+                text "Sp_adj(" <> int (-size) <> text ");" $$
+                saveRegOffs adj_reg_locs $$
+                loadSpWordOff "W_" 0 <> text " = " <>
+                             mkApplyInfoName rest_args <> semi
+
+        shuffle_extra_args = (doc, (shuffle_prof_stack, shuffle_norm_stack))
+          where
+           doc = vcat [ text "#ifdef PROFILING",
+                        shuffle_prof_doc,
                         text "#else",
-                        shuffle False,
+                        shuffle_norm_doc,
                         text "#endif"]
-               where
-                -- Sadly here we have to insert an stg_restore_cccs frame
-                -- just underneath the stg_ap_*_info frame if we're
-                -- profiling; see Note [jump_SAVE_CCCS]
-                shuffle prof =
-                  let offset = if prof then 2 else 0 in
-                  vcat (map (shuffle_down (offset+1))
-                         [sp_stk_args .. sp_stk_args+stack_args_size-1]) $$
-                  (if prof
-                    then
-                      loadSpWordOff "W_" (sp_stk_args+stack_args_size-3)
-                        <> text " = stg_restore_cccs_info;" $$
-                      loadSpWordOff "W_" (sp_stk_args+stack_args_size-2)
-                        <> text " = CCCS;"
-                    else empty) $$
-                  loadSpWordOff "W_" (sp_stk_args+stack_args_size-1)
-                        <> text " = "
-                        <> mkApplyInfoName rest_args <> semi $$
-                  text "Sp_adj(" <> int (sp_stk_args -  1 - offset) <> text ");"
-
-             shuffle_down j i =
-                  loadSpWordOff "W_" (i-j) <> text " = " <>
-                  loadSpWordOff "W_" i <> semi
+
+           (shuffle_prof_doc, shuffle_prof_stack) = shuffle True
+           (shuffle_norm_doc, shuffle_norm_stack) = shuffle False
+
+           -- Sadly here we have to insert an stg_restore_cccs frame
+           -- just underneath the stg_ap_*_info frame if we're
+           -- profiling; see Note [jump_SAVE_CCCS]
+           shuffle prof = (doc, -sp_adj)
+             where
+             sp_adj = sp_stk_args - 1 - offset
+             offset = if prof then 2 else 0
+             doc =
+               vcat (map (shuffle_down (offset+1))
+                      [sp_stk_args .. sp_stk_args+stack_args_size-1]) $$
+               (if prof
+                 then
+                   loadSpWordOff "W_" (sp_stk_args+stack_args_size-3)
+                     <> text " = stg_restore_cccs_info;" $$
+                   loadSpWordOff "W_" (sp_stk_args+stack_args_size-2)
+                     <> text " = CCCS;"
+                 else empty) $$
+               loadSpWordOff "W_" (sp_stk_args+stack_args_size-1)
+                     <> text " = "
+                     <> mkApplyInfoName rest_args <> semi $$
+               text "Sp_adj(" <> int sp_adj <> text ");"
+
+        shuffle_down j i =
+             loadSpWordOff "W_" (i-j) <> text " = " <>
+             loadSpWordOff "W_" i <> semi
 
 
 -- The EXACT ARITY case
@@ -378,7 +432,17 @@ genMkPAP regstatus macro jump live ticker disamb
 --          BUILD_PAP(1,0,(W_)&stg_ap_v_info);
 --      }
 
-    larger_arity_case = 
+    (larger_arity_doc, larger_arity_stack) = (doc, stack)
+     where
+       -- offsets in case we need to save regs:
+       (reg_locs, leftovers, sp_offset)
+           = assignRegs regstatus stk_args_slow_offset args
+           -- BUILD_PAP assumes args start at offset 1
+
+       stack | args_in_regs = (sp_offset, sp_offset)
+             | otherwise    = (0,0)
+
+       doc =
            text "} else {" $$
            let
              save_regs
@@ -407,11 +471,7 @@ genMkPAP regstatus macro jump live ticker disamb
                                         text ");"
            ]) $$
            char '}'
-        where
-          -- offsets in case we need to save regs:
-          (reg_locs, leftovers, sp_offset) 
-                = assignRegs regstatus stk_args_slow_offset args
-                -- BUILD_PAP assumes args start at offset 1
+
 
 -- Note [jump_SAVE_CCCS]
 
@@ -453,13 +513,14 @@ enterFastPathHelper :: Int
                     -> [ArgRep]
                     -> Doc
 enterFastPathHelper tag regstatus no_load_regs args_in_regs args =
-  vcat [text "if (GETTAG(R1)==" <> int tag <> text ") {",
-        reg_doc,
-        text "  Sp_adj(" <> int sp' <> text ");",
-        -- enter, but adjust offset with tag
-        text "  " <> mkJump regstatus (text "%GET_ENTRY(R1-" <> int tag <> text ")") ["R1"] args <> semi,
-        text "}"
-       ]
+  text "if (GETTAG(R1)==" <> int tag <> text ") {" $$
+  nest 4 (vcat [
+    reg_doc,
+    text "Sp_adj(" <> int sp' <> text ");",
+    -- enter, but adjust offset with tag
+    mkJump regstatus (text "%GET_ENTRY(R1-" <> int tag <> text ")") ["R1"] args <> semi
+  ]) $$
+  text "}"
   -- I don't totally understand this code, I copied it from
   -- exact_arity_case
   -- TODO: refactor
@@ -519,6 +580,23 @@ genApply regstatus args =
     fun_ret_label  = mkApplyRetName args
     fun_info_label = mkApplyInfoName args
     all_args_size  = sum (map argSize args)
+
+    (bco_doc, bco_stack) =
+       genMkPAP regstatus "BUILD_PAP" "ENTRY_LBL(stg_BCO)" ["R1"] "FUN" "BCO"
+             True{-stack apply-} False{-args on stack-} False{-not a PAP-}
+             args all_args_size fun_info_label {- tag stmt -}False
+
+    (fun_doc, fun_stack) =
+       genMkPAP regstatus "BUILD_PAP" "%GET_ENTRY(UNTAG(R1))" ["R1"] "FUN" "FUN"
+             False{-reg apply-} False{-args on stack-} False{-not a PAP-}
+             args all_args_size fun_info_label {- tag stmt -}True
+
+    (pap_doc, pap_stack) =
+       genMkPAP regstatus "NEW_PAP" "stg_PAP_apply" ["R1", "R2"] "PAP" "PAP"
+             True{-stack apply-} False{-args on stack-} True{-is a PAP-}
+             args all_args_size fun_info_label {- tag stmt -}False
+
+    stack_usage = maxStack [bco_stack, fun_stack, pap_stack]
    in
     vcat [
       text "INFO_TABLE_RET(" <> mkApplyName args <> text ", " <>
@@ -527,6 +605,7 @@ genApply regstatus args =
       nest 4 (vcat [
        text "W_ info;",
        text "W_ arity;",
+       text "unwind Sp = Sp + WDS(" <> int (1+all_args_size) <> text ");",
 
 --    if fast == 1:
 --        print "static void *lbls[] ="
@@ -579,6 +658,9 @@ genApply regstatus args =
        -- if pointer is tagged enter it fast!
        enterFastPath regstatus False False args,
 
+       stackCheck regstatus args False{-args on stack-}
+                  fun_info_label stack_usage,
+
        -- Functions can be tagged, so we untag them!
        text  "R1 = UNTAG(R1);",
        text  "info = %INFO_PTR(R1);",
@@ -596,9 +678,7 @@ genApply regstatus args =
         nest 4 (vcat [
           text "arity = TO_W_(StgBCO_arity(R1));",
           text "ASSERT(arity > 0);",
-          genMkPAP regstatus "BUILD_PAP" "ENTRY_LBL(stg_BCO)" ["R1"] "FUN" "BCO"
-                True{-stack apply-} False{-args on stack-} False{-not a PAP-}
-                args all_args_size fun_info_label {- tag stmt -}False
+          bco_doc
          ]),
         text "}",
 
@@ -615,9 +695,7 @@ genApply regstatus args =
         nest 4 (vcat [
           text "arity = TO_W_(StgFunInfoExtra_arity(%FUN_INFO(info)));",
           text "ASSERT(arity > 0);",
-          genMkPAP regstatus "BUILD_PAP" "%GET_ENTRY(UNTAG(R1))" ["R1"] "FUN" "FUN"
-                False{-reg apply-} False{-args on stack-} False{-not a PAP-}
-                args all_args_size fun_info_label {- tag stmt -}True
+          fun_doc
          ]),
         text "}",
 
@@ -629,9 +707,7 @@ genApply regstatus args =
         nest 4 (vcat [
           text "arity = TO_W_(StgPAP_arity(R1));",
           text "ASSERT(arity > 0);",
-          genMkPAP regstatus "NEW_PAP" "stg_PAP_apply" ["R1", "R2"] "PAP" "PAP"
-                True{-stack apply-} False{-args on stack-} True{-is a PAP-}
-                args all_args_size fun_info_label {- tag stmt -}False
+          pap_doc
          ]),
         text "}",
 
@@ -690,6 +766,7 @@ genApply regstatus args =
         ]),
        text "}"
       ]),
+
       text "}"
     ]
 
@@ -702,6 +779,15 @@ genApplyFast regstatus args =
     fun_ret_label  = text "RET_LBL" <> parens (mkApplyName args)
     fun_info_label = mkApplyInfoName args
     all_args_size  = sum (map argSize args)
+
+    (fun_doc, fun_stack) =
+       genMkPAP regstatus "BUILD_PAP" "%GET_ENTRY(UNTAG(R1))" ["R1"] "FUN" "FUN"
+            False{-reg apply-} True{-args in regs-} False{-not a PAP-}
+            args all_args_size fun_info_label {- tag stmt -}True
+
+    (reg_locs, leftovers, sp_offset) = assignRegs regstatus 1 args
+
+    stack_usage = maxStack [fun_stack, (sp_offset,sp_offset)]
    in
     vcat [
      fun_fast_label,
@@ -715,6 +801,9 @@ genApplyFast regstatus args =
         -- if pointer is tagged enter it fast!
         enterFastPath regstatus False True args,
 
+        stackCheck regstatus args True{-args in regs-}
+                   fun_info_label stack_usage,
+
         -- Functions can be tagged, so we untag them!
         text  "R1 = UNTAG(R1);",
         text  "info = %GET_STD_INFO(R1);",
@@ -730,18 +819,11 @@ genApplyFast regstatus args =
           nest 4 (vcat [
             text "arity = TO_W_(StgFunInfoExtra_arity(%GET_FUN_INFO(R1)));",
             text "ASSERT(arity > 0);",
-            genMkPAP regstatus "BUILD_PAP" "%GET_ENTRY(UNTAG(R1))" ["R1"] "FUN" "FUN"
-                False{-reg apply-} True{-args in regs-} False{-not a PAP-}
-                args all_args_size fun_info_label {- tag stmt -}True
+            fun_doc
            ]),
           char '}',
           
           text "default: {",
-          let
-             (reg_locs, leftovers, sp_offset) = assignRegs regstatus 1 args
-                -- leave a one-word space on the top of the stack when
-                -- calling the slow version
-          in
           nest 4 (vcat [
              text "Sp_adj" <> parens (int (-sp_offset)) <> semi,
              saveRegOffs reg_locs,
@@ -749,8 +831,9 @@ genApplyFast regstatus args =
           ]),
           char '}'
         ]),
-        char '}'
-      ]),
+
+       char '}'
+     ]),
      char '}'
    ]
 
@@ -810,7 +893,12 @@ genStackSave regstatus args =
                 text "Sp(2) = R1;",
                 text "Sp(1) =" <+> int stk_args <> semi,
                 text "Sp(0) = stg_gc_fun_info;",
-                text "jump stg_gc_noregs [];"
+                text "#ifdef TRACING",
+                text "R1 = %GET_ENTRY(UNTAG(R1));",
+                text "jump stg_gc_noregs [R1];",
+                text "#else",
+                text "jump stg_gc_noregs [];",
+                text "#endif"
                 ]
 
    std_frame_size = 3 -- the std bits of the frame. See StgRetFun in Closures.h,
diff --git a/utils/genargs/genargs.pl b/utils/genargs/genargs.pl
index 2ef2dfa3e622..33dd2a0c8c89 100644
--- a/utils/genargs/genargs.pl
+++ b/utils/genargs/genargs.pl
@@ -1,4 +1,7 @@
-#!/usr/bin/perl
+#!/usr/bin/env perl
+
+use warnings;
+
 my $quote_open = 0;
 my $quote_char = '';
 my $accum = "";
diff --git a/utils/genprimopcode/Lexer.x b/utils/genprimopcode/Lexer.x
index a796b8adce7b..527a03fe7243 100644
--- a/utils/genprimopcode/Lexer.x
+++ b/utils/genprimopcode/Lexer.x
@@ -48,7 +48,6 @@ words :-
     <0>         "primop"            { mkT TPrimop }
     <0>         "pseudoop"          { mkT TPseudoop }
     <0>         "primtype"          { mkT TPrimtype }
-    <0>         "primclass"         { mkT TPrimclass }
     <0>         "with"              { mkT TWith }
     <0>         "defaults"          { mkT TDefaults }
     <0>         "True"              { mkT TTrue }
diff --git a/utils/genprimopcode/Main.hs b/utils/genprimopcode/Main.hs
index d60081f6d3e9..7fe375a7d237 100644
--- a/utils/genprimopcode/Main.hs
+++ b/utils/genprimopcode/Main.hs
@@ -118,7 +118,7 @@ main = getArgs >>= \args ->
        do s <- getContents
           case parse s of
              Left err -> error ("parse error at " ++ (show err))
-             Right p_o_specs@(Info _ entries)
+             Right p_o_specs@(Info _ _)
                 -> seq (sanityTop p_o_specs) (
                    case head args of
 
@@ -187,9 +187,6 @@ main = getArgs >>= \args ->
                       "--make-haskell-source" 
                          -> putStr (gen_hs_source p_o_specs)
 
-                      "--make-ext-core-source"
-                         -> putStr (gen_ext_core_source entries)
-
                       "--make-latex-doc"
                          -> putStr (gen_latex_doc p_o_specs)
 
@@ -215,7 +212,6 @@ known_args
        "--primop-vector-tycons",
        "--make-haskell-wrappers",
        "--make-haskell-source",
-       "--make-ext-core-source",
        "--make-latex-doc"
      ]
 
@@ -252,6 +248,7 @@ gen_hs_source (Info defaults entries) =
     ++ "{-\n"
         ++ unlines (map opt defaults)
     ++ "-}\n"
+    ++ "import GHC.Types (Coercible)\n"
         ++ unlines (concatMap ent entries') ++ "\n\n\n"
      where entries' = concatMap desugarVectorSpec entries
 
@@ -268,8 +265,6 @@ gen_hs_source (Info defaults entries) =
            hdr (PseudoOpSpec { name = n })                       = wrapOp n ++ ","
            hdr (PrimTypeSpec { ty = TyApp (TyCon n) _ })         = wrapTy n ++ ","
            hdr (PrimTypeSpec {})                                 = error $ "Illegal type spec"
-           hdr (PrimClassSpec { cls = TyApp (TyCon n) _ })       = wrapTy n ++ ","
-           hdr (PrimClassSpec {})                                = error "Illegal class spec"
            hdr (PrimVecTypeSpec { ty = TyApp (VecTyCon n _) _ }) = wrapTy n ++ ","
            hdr (PrimVecTypeSpec {})                              = error $ "Illegal type spec"
 
@@ -277,7 +272,6 @@ gen_hs_source (Info defaults entries) =
            ent o@(PrimOpSpec {})      = spec o
            ent o@(PrimVecOpSpec {})   = spec o
            ent o@(PrimTypeSpec {})    = spec o
-           ent o@(PrimClassSpec {})   = spec o
            ent o@(PrimVecTypeSpec {}) = spec o
            ent o@(PseudoOpSpec {})    = spec o
 
@@ -301,8 +295,6 @@ gen_hs_source (Info defaults entries) =
                               wrapOp n ++ " = let x = x in x" ]
                         PrimTypeSpec { ty = t }   ->
                             [ "data " ++ pprTy t ]
-                        PrimClassSpec { cls = t }   ->
-                            [ "class " ++ pprTy t ]
                         PrimVecTypeSpec { ty = t }   ->
                             [ "data " ++ pprTy t ]
                         Section { } -> []
@@ -496,13 +488,6 @@ gen_latex_doc (Info defaults entries)
                  ++ d ++ "}{"
                  ++ mk_options o
                  ++ "}\n"
-           mk_entry (PrimClassSpec {cls=t,desc=d,opts=o}) =
-                 "\\primclassspec{"
-                 ++ latex_encode (mk_source_ty t) ++ "}{"
-                 ++ latex_encode (mk_core_ty t) ++ "}{"
-                 ++ d ++ "}{"
-                 ++ mk_options o
-                 ++ "}\n"
            mk_entry (PrimVecTypeSpec {}) =
                  ""
            mk_entry (PseudoOpSpec {name=n,ty=t,desc=d,opts=o}) =
@@ -904,10 +889,13 @@ ppType (TyApp (TyCon "MutVar#") [x,y])          = "mkMutVarPrimTy " ++ ppType x
 ppType (TyApp (TyCon "MutableArray#") [x,y])    = "mkMutableArrayPrimTy " ++ ppType x
                                                    ++ " " ++ ppType y
 ppType (TyApp (TyCon "MutableArrayArray#") [x]) = "mkMutableArrayArrayPrimTy " ++ ppType x
+ppType (TyApp (TyCon "SmallMutableArray#") [x,y]) = "mkSmallMutableArrayPrimTy " ++ ppType x
+                                                    ++ " " ++ ppType y
 ppType (TyApp (TyCon "MutableByteArray#") [x])  = "mkMutableByteArrayPrimTy " 
                                                    ++ ppType x
 ppType (TyApp (TyCon "Array#") [x])             = "mkArrayPrimTy " ++ ppType x
 ppType (TyApp (TyCon "ArrayArray#") [])         = "mkArrayArrayPrimTy"
+ppType (TyApp (TyCon "SmallArray#") [x])        = "mkSmallArrayPrimTy " ++ ppType x
 
 
 ppType (TyApp (TyCon "Weak#")       [x]) = "mkWeakPrimTy " ++ ppType x
diff --git a/utils/genprimopcode/Parser.y b/utils/genprimopcode/Parser.y
index ef6e27e658d9..424efe6a4aa9 100644
--- a/utils/genprimopcode/Parser.y
+++ b/utils/genprimopcode/Parser.y
@@ -40,7 +40,6 @@ import Syntax
     primop          { TPrimop }
     pseudoop        { TPseudoop }
     primtype        { TPrimtype }
-    primclass       { TPrimclass }
     with            { TWith }
     defaults        { TDefaults }
     true            { TTrue }
@@ -99,7 +98,6 @@ pEntries : pEntry pEntries { $1 : $2 }
 pEntry :: { Entry }
 pEntry : pPrimOpSpec   { $1 }
        | pPrimTypeSpec { $1 }
-       | pPrimClassSpec { $1 }
        | pPseudoOpSpec { $1 }
        | pSection      { $1 }
 
@@ -120,10 +118,6 @@ pPrimTypeSpec :: { Entry }
 pPrimTypeSpec : primtype pType pDesc pWithOptions
                 { PrimTypeSpec { ty = $2, desc = $3, opts = $4 } }
 
-pPrimClassSpec :: { Entry }
-pPrimClassSpec : primclass pType pDesc pWithOptions
-                { PrimClassSpec { cls = $2, desc = $3, opts = $4 } }
-
 pPseudoOpSpec :: { Entry }
 pPseudoOpSpec : pseudoop string pType pDesc pWithOptions
                 { PseudoOpSpec { name = $2, ty = $3, desc = $4, opts = $5 } }
diff --git a/utils/genprimopcode/ParserM.hs b/utils/genprimopcode/ParserM.hs
index 0a69db6b8f5a..4dedfa39dd2a 100644
--- a/utils/genprimopcode/ParserM.hs
+++ b/utils/genprimopcode/ParserM.hs
@@ -83,7 +83,6 @@ data Token = TEOF
            | TPrimop
            | TPseudoop
            | TPrimtype
-           | TPrimclass
            | TWith
            | TDefaults
            | TTrue
diff --git a/utils/genprimopcode/Syntax.hs b/utils/genprimopcode/Syntax.hs
index d0c380cf59ed..68b20adbdddf 100644
--- a/utils/genprimopcode/Syntax.hs
+++ b/utils/genprimopcode/Syntax.hs
@@ -35,9 +35,6 @@ data Entry
     | PrimTypeSpec { ty    :: Ty,      -- name in prog text
                      desc  :: String,      -- description
                      opts  :: [Option] }   -- default overrides
-    | PrimClassSpec { cls   :: Ty,      -- name in prog text
-                      desc  :: String,      -- description
-                      opts  :: [Option] }   -- default overrides
     | PrimVecTypeSpec { ty    :: Ty,      -- name in prog text
                         prefix  :: String,    -- prefix for generated names
                         veclen  :: Int,       -- vector length
diff --git a/utils/ghc-cabal/Main.hs b/utils/ghc-cabal/Main.hs
index 8fa2c2911372..47eb1de4fd43 100644
--- a/utils/ghc-cabal/Main.hs
+++ b/utils/ghc-cabal/Main.hs
@@ -12,6 +12,7 @@ import Distribution.Simple.Configure
 import Distribution.Simple.LocalBuildInfo
 import Distribution.Simple.Program
 import Distribution.Simple.Program.HcPkg
+import Distribution.Simple.Setup (ConfigFlags(configStripLibs), fromFlag, toFlag)
 import Distribution.Simple.Utils (defaultPackageDesc, writeFileAtomic, toUTF8)
 import Distribution.Simple.Build (writeAutogenFiles)
 import Distribution.Simple.Register
@@ -27,7 +28,7 @@ import Data.Maybe
 import System.IO
 import System.Directory
 import System.Environment
-import System.Exit
+import System.Exit      (exitWith, ExitCode(..))
 import System.FilePath
 
 main :: IO ()
@@ -174,8 +175,17 @@ doCopy directory distDir
             let lbi' = lbi {
                                withPrograms = progs',
                                installDirTemplates = idts,
+                               configFlags = cfg,
+                               stripLibs = fromFlag (configStripLibs cfg),
                                withSharedLib = withSharedLibs
                            }
+
+                -- This hack allows to interpret the "strip"
+                -- command-line argument being set to ':' to signify
+                -- disabled library stripping
+                cfg | strip == ":" = (configFlags lbi) { configStripLibs = toFlag False }
+                    | otherwise    = configFlags lbi
+
             f pd lbi' us flags
 
 doRegister :: FilePath -> FilePath -> FilePath -> FilePath
@@ -250,7 +260,7 @@ updateInstallDirTemplates relocatableBuild myPrefix myLibdir myDocdir idts
                           if relocatableBuild
                           then "$topdir"
                           else myLibdir,
-          libsubdir = toPathTemplate "$pkgid",
+          libsubdir = toPathTemplate "$pkgkey",
           docdir    = toPathTemplate $
                           if relocatableBuild
                           then "$topdir/../doc/html/libraries/$pkgid"
@@ -346,6 +356,7 @@ generate directory distdir dll0Modules config_args
              writeFileAtomic (distdir </> "inplace-pkg-config") (BS.pack $ toUTF8 content)
 
       let
+          comp = compiler lbi
           libBiModules lib = (libBuildInfo lib, libModules lib)
           exeBiModules exe = (buildInfo exe, ModuleName.main : exeModules exe)
           biModuless = (maybeToList $ fmap libBiModules $ library pd)
@@ -388,10 +399,25 @@ generate directory distdir dll0Modules config_args
 
           dep_ids  = map snd (externalPackageDeps lbi)
           deps     = map display dep_ids
+          dep_keys
+            | packageKeySupported comp
+                   = map (display
+                        . Installed.packageKey
+                        . fromMaybe (error "ghc-cabal: dep_keys failed")
+                        . PackageIndex.lookupInstalledPackageId
+                                                           (installedPkgs lbi)
+                        . fst)
+                   . externalPackageDeps
+                   $ lbi
+            | otherwise = deps
           depNames = map (display . packageName) dep_ids
 
           transitive_dep_ids = map Installed.sourcePackageId dep_pkgs
           transitiveDeps = map display transitive_dep_ids
+          transitiveDepKeys
+            | packageKeySupported comp
+                   = map (display . Installed.packageKey) dep_pkgs
+            | otherwise = transitiveDeps
           transitiveDepNames = map (display . packageName) transitive_dep_ids
 
           libraryDirs = forDeps Installed.libraryDirs
@@ -410,13 +436,16 @@ generate directory distdir dll0Modules config_args
           otherMods = map display (otherModules bi)
           allMods = mods ++ otherMods
       let xs = [variablePrefix ++ "_VERSION = " ++ display (pkgVersion (package pd)),
+                variablePrefix ++ "_PACKAGE_KEY = " ++ display (pkgKey lbi),
                 variablePrefix ++ "_MODULES = " ++ unwords mods,
                 variablePrefix ++ "_HIDDEN_MODULES = " ++ unwords otherMods,
                 variablePrefix ++ "_SYNOPSIS =" ++ synopsis pd,
                 variablePrefix ++ "_HS_SRC_DIRS = " ++ unwords (hsSourceDirs bi),
                 variablePrefix ++ "_DEPS = " ++ unwords deps,
+                variablePrefix ++ "_DEP_KEYS = " ++ unwords dep_keys,
                 variablePrefix ++ "_DEP_NAMES = " ++ unwords depNames,
                 variablePrefix ++ "_TRANSITIVE_DEPS = " ++ unwords transitiveDeps,
+                variablePrefix ++ "_TRANSITIVE_DEP_KEYS = " ++ unwords transitiveDepKeys,
                 variablePrefix ++ "_TRANSITIVE_DEP_NAMES = " ++ unwords transitiveDepNames,
                 variablePrefix ++ "_INCLUDE_DIRS = " ++ unwords (includeDirs bi),
                 variablePrefix ++ "_INCLUDES = " ++ unwords (includes bi),
@@ -452,7 +481,8 @@ generate directory distdir dll0Modules config_args
                 "$(eval $(" ++ directory ++ "_PACKAGE_MAGIC))"
                 ]
       writeFile (distdir ++ "/package-data.mk") $ unlines xs
-      writeFile (distdir ++ "/haddock-prologue.txt") $
+
+      writeFileUtf8 (distdir ++ "/haddock-prologue.txt") $
           if null (description pd) then synopsis pd
                                    else description pd
       unless (null dll0Modules) $
@@ -475,3 +505,8 @@ generate directory distdir dll0Modules config_args
      mkSearchPath = intercalate [searchPathSeparator]
      boolToYesNo True = "YES"
      boolToYesNo False = "NO"
+
+     -- | Version of 'writeFile' that always uses UTF8 encoding
+     writeFileUtf8 f txt = withFile f WriteMode $ \hdl -> do
+         hSetEncoding hdl utf8
+         hPutStr hdl txt
diff --git a/utils/ghc-cabal/ghc-cabal.cabal b/utils/ghc-cabal/ghc-cabal.cabal
index 10d6e0a9e448..2641f1956801 100644
--- a/utils/ghc-cabal/ghc-cabal.cabal
+++ b/utils/ghc-cabal/ghc-cabal.cabal
@@ -6,18 +6,18 @@ License: BSD3
 Author: XXX
 Maintainer: XXX
 Synopsis: XXX
-Description:
-	XXX
+Description: XXX
 Category: Development
 build-type: Simple
-cabal-version: >=1.2
+cabal-version: >=1.10
 
 Executable ghc-cabal
+    Default-Language: Haskell2010
     Main-Is: ghc-cabal.hs
 
     Build-Depends: base       >= 3   && < 5,
                    bytestring >= 0.10 && < 0.11,
-                   Cabal      >= 1.18 && < 1.19,
+                   Cabal      >= 1.20 && < 1.22,
                    directory  >= 1.1 && < 1.3,
                    filepath   >= 1.2 && < 1.4
 
diff --git a/utils/ghc-cabal/ghc.mk b/utils/ghc-cabal/ghc.mk
index 29db69cfefe4..ff5762a6553e 100644
--- a/utils/ghc-cabal/ghc.mk
+++ b/utils/ghc-cabal/ghc.mk
@@ -31,7 +31,10 @@ $(ghc-cabal_DIST_BINARY): $(wildcard libraries/Cabal/Cabal/Distribution/*/*.hs)
 $(ghc-cabal_DIST_BINARY): $(wildcard libraries/Cabal/Cabal/Distribution/*.hs)
 
 $(ghc-cabal_DIST_BINARY): utils/ghc-cabal/Main.hs $(TOUCH_DEP) | $$(dir $$@)/. bootstrapping/.
-	"$(GHC)" $(SRC_HC_OPTS) --make utils/ghc-cabal/Main.hs -o $@ \
+	"$(GHC)" $(SRC_HC_OPTS) \
+	       $(addprefix -optc, $(SRC_CC_OPTS) $(CONF_CC_OPTS_STAGE0)) \
+	       $(addprefix -optl, $(SRC_LD_OPTS) $(CONF_LD_OPTS_STAGE0)) \
+	       --make utils/ghc-cabal/Main.hs -o $@ \
 	       -no-user-$(GHC_PACKAGE_DB_FLAG) \
 	       -Wall -fno-warn-unused-imports -fno-warn-warnings-deprecations \
 	       -DCABAL_VERSION=$(CABAL_VERSION) \
@@ -65,4 +68,3 @@ utils/ghc-cabal_dist-install_WANT_BINDIST_WRAPPER = YES
 utils/ghc-cabal_dist-install_MODULES         = Main
 
 $(eval $(call build-prog,utils/ghc-cabal,dist-install,1))
-
diff --git a/utils/ghc-pkg/Main.hs b/utils/ghc-pkg/Main.hs
index 30acbe2eb811..c88b814a716a 100644
--- a/utils/ghc-pkg/Main.hs
+++ b/utils/ghc-pkg/Main.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE PatternGuards, CPP, ForeignFunctionInterface #-}
+{-# LANGUAGE CPP #-}
 -----------------------------------------------------------------------------
 --
 -- (c) The University of Glasgow 2004-2009.
@@ -16,6 +16,7 @@ import Distribution.ModuleName hiding (main)
 import Distribution.InstalledPackageInfo
 import Distribution.Compat.ReadP
 import Distribution.ParseUtils
+import Distribution.ModuleExport
 import Distribution.Package hiding (depends)
 import Distribution.Text
 import Distribution.Version
@@ -32,6 +33,8 @@ import System.Console.GetOpt
 import qualified Control.Exception as Exception
 import Data.Maybe
 
+import qualified Data.Set as Set
+
 import Data.Char ( isSpace, toLower )
 import Data.Ord (comparing)
 import Control.Applicative (Applicative(..))
@@ -111,9 +114,11 @@ data Flag
   | FlagVersion
   | FlagConfig FilePath
   | FlagGlobalConfig FilePath
+  | FlagUserConfig FilePath
   | FlagForce
   | FlagForceFiles
   | FlagAutoGHCiLibs
+  | FlagMultiInstance
   | FlagExpandEnvVars
   | FlagExpandPkgroot
   | FlagNoExpandPkgroot
@@ -122,6 +127,7 @@ data Flag
   | FlagIgnoreCase
   | FlagNoUserDb
   | FlagVerbosity (Maybe String)
+  | FlagIPId
   deriving Eq
 
 flags :: [OptDescr Flag]
@@ -138,6 +144,8 @@ flags = [
         "location of the global package database",
   Option [] ["no-user-package-db"] (NoArg FlagNoUserDb)
         "never read the user package database",
+  Option [] ["user-package-db"] (ReqArg FlagUserConfig "DIR")
+        "location of the user package database (use instead of default)",
   Option [] ["no-user-package-conf"] (NoArg FlagNoUserDb)
         "never read the user package database (DEPRECATED)",
   Option [] ["force"] (NoArg FlagForce)
@@ -146,6 +154,8 @@ flags = [
          "ignore missing directories and libraries only",
   Option ['g'] ["auto-ghci-libs"] (NoArg FlagAutoGHCiLibs)
         "automatically build libs for GHCi (with register)",
+  Option [] ["enable-multi-instance"] (NoArg FlagMultiInstance)
+        "allow registering multiple instances of the same package version",
   Option [] ["expand-env-vars"] (NoArg FlagExpandEnvVars)
         "expand environment variables (${name}-style) in input package descriptions",
   Option [] ["expand-pkgroot"] (NoArg FlagExpandPkgroot)
@@ -162,6 +172,8 @@ flags = [
         "only print package names, not versions; can only be used with list --simple-output",
   Option [] ["ignore-case"] (NoArg FlagIgnoreCase)
         "ignore case for substring matching",
+  Option [] ["ipid"] (NoArg FlagIPId)
+        "interpret package arguments as installed package IDs",
   Option ['v'] ["verbose"] (OptArg FlagVerbosity "Verbosity")
         "verbosity level (0-2, default 1)"
   ]
@@ -270,7 +282,8 @@ usageHeader prog = substProg prog $
   "\n" ++
   " Substring matching is supported for {module} in find-module and\n" ++
   " for {pkg} in list, describe, and field, where a '*' indicates\n" ++
-  " open substring ends (prefix*, *suffix, *infix*).\n" ++
+  " open substring ends (prefix*, *suffix, *infix*).  Use --ipid to\n" ++
+  " match against the installed package ID instead.\n" ++
   "\n" ++
   "  When asked to modify a database (register, unregister, update,\n"++
   "  hide, expose, and also check), ghc-pkg modifies the global database by\n"++
@@ -297,7 +310,17 @@ substProg prog (c:xs) = c : substProg prog xs
 data Force = NoForce | ForceFiles | ForceAll | CannotForce
   deriving (Eq,Ord)
 
-data PackageArg = Id PackageIdentifier | Substring String (String->Bool)
+-- | Represents how a package may be specified by a user on the command line.
+data PackageArg
+    -- | A package identifier foo-0.1; the version might be a glob.
+    = Id PackageIdentifier
+    -- | An installed package ID foo-0.1-HASH.  This is guaranteed to uniquely
+    -- match a single entry in the package database.
+    | IPId InstalledPackageId
+    -- | A glob against the package name.  The first string is the literal
+    -- glob, the second is a function which returns @True@ if the the argument
+    -- matches.
+    | Substring String (String->Bool)
 
 runit :: Verbosity -> [Flag] -> [String] -> IO ()
 runit verbosity cli nonopts = do
@@ -308,7 +331,9 @@ runit verbosity cli nonopts = do
           | FlagForce `elem` cli        = ForceAll
           | FlagForceFiles `elem` cli   = ForceFiles
           | otherwise                   = NoForce
+        as_ipid = FlagIPId `elem` cli
         auto_ghci_libs = FlagAutoGHCiLibs `elem` cli
+        multi_instance = FlagMultiInstance `elem` cli
         expand_env_vars= FlagExpandEnvVars `elem` cli
         mexpand_pkgroot= foldl' accumExpandPkgroot Nothing cli
           where accumExpandPkgroot _ FlagExpandPkgroot   = Just True
@@ -319,6 +344,28 @@ runit verbosity cli nonopts = do
           where splitComma "" = Nothing
                 splitComma fs = Just $ break (==',') (tail fs)
 
+        -- | Parses a glob into a predicate which tests if a string matches
+        -- the glob.  Returns Nothing if the string in question is not a glob.
+        -- At the moment, we only support globs at the beginning and/or end of
+        -- strings.  This function respects case sensitivity.
+        --
+        -- >>> fromJust (substringCheck "*") "anything"
+        -- True
+        --
+        -- >>> fromJust (substringCheck "string") "string"
+        -- True
+        --
+        -- >>> fromJust (substringCheck "*bar") "foobar"
+        -- True
+        --
+        -- >>> fromJust (substringCheck "foo*") "foobar"
+        -- True
+        --
+        -- >>> fromJust (substringCheck "*ooba*") "foobar"
+        -- True
+        --
+        -- >>> fromJust (substringCheck "f*bar") "foobar"
+        -- False
         substringCheck :: String -> Maybe (String -> Bool)
         substringCheck ""    = Nothing
         substringCheck "*"   = Just (const True)
@@ -355,32 +402,35 @@ runit verbosity cli nonopts = do
         initPackageDB filename verbosity cli
     ["register", filename] ->
         registerPackage filename verbosity cli
-                        auto_ghci_libs expand_env_vars False force
+                        auto_ghci_libs multi_instance
+                        expand_env_vars False force
     ["update", filename] ->
         registerPackage filename verbosity cli
-                        auto_ghci_libs expand_env_vars True force
-    ["unregister", pkgid_str] -> do
-        pkgid <- readGlobPkgId pkgid_str
-        unregisterPackage pkgid verbosity cli force
-    ["expose", pkgid_str] -> do
-        pkgid <- readGlobPkgId pkgid_str
-        exposePackage pkgid verbosity cli force
-    ["hide",   pkgid_str] -> do
-        pkgid <- readGlobPkgId pkgid_str
-        hidePackage pkgid verbosity cli force
-    ["trust",    pkgid_str] -> do
-        pkgid <- readGlobPkgId pkgid_str
-        trustPackage pkgid verbosity cli force
-    ["distrust", pkgid_str] -> do
-        pkgid <- readGlobPkgId pkgid_str
-        distrustPackage pkgid verbosity cli force
+                        auto_ghci_libs multi_instance
+                        expand_env_vars True force
+    ["unregister", pkgarg_str] -> do
+        pkgarg <- readPackageArg as_ipid pkgarg_str
+        unregisterPackage pkgarg verbosity cli force
+    ["expose", pkgarg_str] -> do
+        pkgarg <- readPackageArg as_ipid pkgarg_str
+        exposePackage pkgarg verbosity cli force
+    ["hide",   pkgarg_str] -> do
+        pkgarg <- readPackageArg as_ipid pkgarg_str
+        hidePackage pkgarg verbosity cli force
+    ["trust",    pkgarg_str] -> do
+        pkgarg <- readPackageArg as_ipid pkgarg_str
+        trustPackage pkgarg verbosity cli force
+    ["distrust", pkgarg_str] -> do
+        pkgarg <- readPackageArg as_ipid pkgarg_str
+        distrustPackage pkgarg verbosity cli force
     ["list"] -> do
         listPackages verbosity cli Nothing Nothing
-    ["list", pkgid_str] ->
-        case substringCheck pkgid_str of
-          Nothing -> do pkgid <- readGlobPkgId pkgid_str
-                        listPackages verbosity cli (Just (Id pkgid)) Nothing
-          Just m -> listPackages verbosity cli (Just (Substring pkgid_str m)) Nothing
+    ["list", pkgarg_str] ->
+        case substringCheck pkgarg_str of
+          Nothing -> do pkgarg <- readPackageArg as_ipid pkgarg_str
+                        listPackages verbosity cli (Just pkgarg) Nothing
+          Just m -> listPackages verbosity cli
+                                 (Just (Substring pkgarg_str m)) Nothing
     ["dot"] -> do
         showPackageDot verbosity cli
     ["find-module", moduleName] -> do
@@ -391,13 +441,13 @@ runit verbosity cli nonopts = do
         latestPackage verbosity cli pkgid
     ["describe", pkgid_str] -> do
         pkgarg <- case substringCheck pkgid_str of
-          Nothing -> liftM Id (readGlobPkgId pkgid_str)
+          Nothing -> readPackageArg as_ipid pkgid_str
           Just m  -> return (Substring pkgid_str m)
         describePackage verbosity cli pkgarg (fromMaybe False mexpand_pkgroot)
         
     ["field", pkgid_str, fields] -> do
         pkgarg <- case substringCheck pkgid_str of
-          Nothing -> liftM Id (readGlobPkgId pkgid_str)
+          Nothing -> readPackageArg as_ipid pkgid_str
           Just m  -> return (Substring pkgid_str m)
         describeField verbosity cli pkgarg
                       (splitFields fields) (fromMaybe True mexpand_pkgroot)
@@ -433,6 +483,11 @@ parseGlobPackageId =
       _ <- string "-*"
       return (PackageIdentifier{ pkgName = n, pkgVersion = globVersion }))
 
+readPackageArg :: Bool -> String -> IO PackageArg
+readPackageArg True str =
+    parseCheck (IPId `fmap` parse) str "installed package id"
+readPackageArg False str = Id `fmap` readGlobPkgId str
+
 -- globVersion means "all versions"
 globVersion :: Version
 globVersion = Version{ versionBranch=[], versionTags=["*"] }
@@ -515,16 +570,18 @@ getPkgDatabases verbosity modify use_cache expand_vars my_flags = do
   e_appdir <- tryIO $ getAppUserDataDirectory "ghc"
 
   mb_user_conf <-
-     if no_user_db then return Nothing else
-     case e_appdir of
-       Left _    -> return Nothing
-       Right appdir -> do
-         let subdir = targetARCH ++ '-':targetOS ++ '-':Version.version
-             dir = appdir </> subdir
-         r <- lookForPackageDBIn dir
-         case r of
-           Nothing -> return (Just (dir </> "package.conf.d", False))
-           Just f  -> return (Just (f, True))
+    case [ f | FlagUserConfig f <- my_flags ] of
+      _ | no_user_db -> return Nothing
+      [] -> case e_appdir of
+        Left _    -> return Nothing
+        Right appdir -> do
+          let subdir = targetARCH ++ '-':targetOS ++ '-':Version.version
+              dir = appdir </> subdir
+          r <- lookForPackageDBIn dir
+          case r of
+            Nothing -> return (Just (dir </> "package.conf.d", False))
+            Just f  -> return (Just (f, True))
+      fs -> return (Just (last fs, True))
 
   -- If the user database doesn't exist, and this command isn't a
   -- "modify" command, then we won't attempt to create or use it.
@@ -585,6 +642,11 @@ getPkgDatabases verbosity modify use_cache expand_vars my_flags = do
   let flag_db_stack = [ db | db_name <- flag_db_names,
                         db <- db_stack, location db == db_name ]
 
+  when (verbosity > Normal) $ do
+    infoLn ("db stack: " ++ show (map location db_stack))
+    infoLn ("modifying: " ++ show to_modify)
+    infoLn ("flag db stack: " ++ show (map location flag_db_stack))
+
   return (db_stack, to_modify, flag_db_stack)
 
 
@@ -593,9 +655,9 @@ lookForPackageDBIn dir = do
   let path_dir = dir </> "package.conf.d"
   exists_dir <- doesDirectoryExist path_dir
   if exists_dir then return (Just path_dir) else do
-  let path_file = dir </> "package.conf"
-  exists_file <- doesFileExist path_file
-  if exists_file then return (Just path_file) else return Nothing
+    let path_file = dir </> "package.conf"
+    exists_file <- doesFileExist path_file
+    if exists_file then return (Just path_file) else return Nothing
 
 readParseDatabase :: Verbosity
                   -> Maybe (FilePath,Bool)
@@ -782,11 +844,13 @@ registerPackage :: FilePath
                 -> Verbosity
                 -> [Flag]
                 -> Bool              -- auto_ghci_libs
+                -> Bool              -- multi_instance
                 -> Bool              -- expand_env_vars
                 -> Bool              -- update
                 -> Force
                 -> IO ()
-registerPackage input verbosity my_flags auto_ghci_libs expand_env_vars update force = do
+registerPackage input verbosity my_flags auto_ghci_libs multi_instance
+                expand_env_vars update force = do
   (db_stack, Just to_modify, _flag_dbs) <- 
       getPkgDatabases verbosity True True False{-expand vars-} my_flags
 
@@ -829,20 +893,30 @@ registerPackage input verbosity my_flags auto_ghci_libs expand_env_vars update f
   let truncated_stack = dropWhile ((/= to_modify).location) db_stack
   -- truncate the stack for validation, because we don't allow
   -- packages lower in the stack to refer to those higher up.
-  validatePackageConfig pkg_expanded verbosity truncated_stack auto_ghci_libs update force
+  validatePackageConfig pkg_expanded verbosity truncated_stack
+                        auto_ghci_libs multi_instance update force
+
+  -- postprocess the package
+  pkg' <- resolveReexports truncated_stack pkg
+
   let 
+     -- In the normal mode, we only allow one version of each package, so we
+     -- remove all instances with the same source package id as the one we're
+     -- adding. In the multi instance mode we don't do that, thus allowing
+     -- multiple instances with the same source package id.
      removes = [ RemovePackage p
-               | p <- packages db_to_operate_on,
+               | not multi_instance,
+                 p <- packages db_to_operate_on,
                  sourcePackageId p == sourcePackageId pkg ]
   --
-  changeDB verbosity (removes ++ [AddPackage pkg]) db_to_operate_on
+  changeDB verbosity (removes ++ [AddPackage pkg']) db_to_operate_on
 
 parsePackageInfo
         :: String
         -> IO (InstalledPackageInfo, [ValidateWarning])
 parsePackageInfo str =
   case parseInstalledPackageInfo str of
-    ParseOk warnings ok -> return (ok, ws)
+    ParseOk warnings ok -> return (mungePackageInfo ok, ws)
       where
         ws = [ msg | PWarning msg <- warnings
                    , not ("Unrecognized field pkgroot" `isPrefixOf` msg) ]
@@ -850,6 +924,55 @@ parsePackageInfo str =
                            (Nothing, s) -> die s
                            (Just l, s) -> die (show l ++ ": " ++ s)
 
+mungePackageInfo :: InstalledPackageInfo -> InstalledPackageInfo
+mungePackageInfo ipi = ipi { packageKey = packageKey' }
+  where
+    packageKey'
+      | OldPackageKey (PackageIdentifier (PackageName "") _) <- packageKey ipi
+          = OldPackageKey (sourcePackageId ipi)
+      | otherwise = packageKey ipi
+
+-- | Takes the "reexported-modules" field of an InstalledPackageInfo
+-- and resolves the references so they point to the original exporter
+-- of a module (i.e. the module is in exposed-modules, not
+-- reexported-modules).  This is done by maintaining an invariant on
+-- the installed package database that a reexported-module field always
+-- points to the original exporter.
+resolveReexports :: PackageDBStack
+                 -> InstalledPackageInfo
+                 -> IO InstalledPackageInfo
+resolveReexports db_stack pkg = do
+  let dep_mask = Set.fromList (depends pkg)
+      deps = filter (flip Set.member dep_mask . installedPackageId)
+                    (allPackagesInStack db_stack)
+      matchExposed pkg_dep m = map ((,) (installedPackageId pkg_dep))
+                                   (filter (==m) (exposedModules pkg_dep))
+      worker ModuleExport{ exportOrigPackageName = Just pnm } pkg_dep
+        | pnm /= packageName (sourcePackageId pkg_dep) = []
+      -- Now, either the package matches, *or* we were asked to search the
+      -- true location ourselves.
+      worker ModuleExport{ exportOrigName = m } pkg_dep =
+            matchExposed pkg_dep m ++
+            map (fromMaybe (error $ "Impossible! Missing true location in " ++
+                                    display (installedPackageId pkg_dep))
+                    . exportCachedTrueOrig)
+                (filter ((==m) . exportName) (reexportedModules pkg_dep))
+      self_reexports ModuleExport{ exportOrigPackageName = Just pnm }
+        | pnm /= packageName (sourcePackageId pkg) = []
+      self_reexports ModuleExport{ exportName = m', exportOrigName = m }
+        -- Self-reexport without renaming doesn't make sense
+        | m == m' = []
+        -- *Only* match against exposed modules!
+        | otherwise = matchExposed pkg m
+
+  r <- forM (reexportedModules pkg) $ \me -> do
+    case nub (concatMap (worker me) deps ++ self_reexports me) of
+      [c] -> return me { exportCachedTrueOrig = Just c }
+      [] -> die $ "Couldn't resolve reexport " ++ display me
+      cs -> die $ "Found multiple possible ways to resolve reexport " ++
+                  display me ++ ": " ++ show cs
+  return (pkg { reexportedModules = r })
+
 -- -----------------------------------------------------------------------------
 -- Making changes to a package database
 
@@ -911,52 +1034,60 @@ updateDBCache verbosity db = do
 -- -----------------------------------------------------------------------------
 -- Exposing, Hiding, Trusting, Distrusting, Unregistering are all similar
 
-exposePackage :: PackageIdentifier -> Verbosity -> [Flag] -> Force -> IO ()
+exposePackage :: PackageArg -> Verbosity -> [Flag] -> Force -> IO ()
 exposePackage = modifyPackage (\p -> ModifyPackage p{exposed=True})
 
-hidePackage :: PackageIdentifier -> Verbosity -> [Flag] -> Force -> IO ()
+hidePackage :: PackageArg -> Verbosity -> [Flag] -> Force -> IO ()
 hidePackage = modifyPackage (\p -> ModifyPackage p{exposed=False})
 
-trustPackage :: PackageIdentifier -> Verbosity -> [Flag] -> Force -> IO ()
+trustPackage :: PackageArg -> Verbosity -> [Flag] -> Force -> IO ()
 trustPackage = modifyPackage (\p -> ModifyPackage p{trusted=True})
 
-distrustPackage :: PackageIdentifier -> Verbosity -> [Flag] -> Force -> IO ()
+distrustPackage :: PackageArg -> Verbosity -> [Flag] -> Force -> IO ()
 distrustPackage = modifyPackage (\p -> ModifyPackage p{trusted=False})
 
-unregisterPackage :: PackageIdentifier -> Verbosity -> [Flag] -> Force -> IO ()
+unregisterPackage :: PackageArg -> Verbosity -> [Flag] -> Force -> IO ()
 unregisterPackage = modifyPackage RemovePackage
 
 modifyPackage
   :: (InstalledPackageInfo -> DBOp)
-  -> PackageIdentifier
+  -> PackageArg
   -> Verbosity
   -> [Flag]
   -> Force
   -> IO ()
-modifyPackage fn pkgid verbosity my_flags force = do
-  (db_stack, Just _to_modify, _flag_dbs) <- 
+modifyPackage fn pkgarg verbosity my_flags force = do
+  (db_stack, Just _to_modify, flag_dbs) <-
       getPkgDatabases verbosity True{-modify-} True{-use cache-} False{-expand vars-} my_flags
 
-  (db, ps) <- fmap head $ findPackagesByDB db_stack (Id pkgid)
+  -- Do the search for the package respecting flags...
+  (db, ps) <- fmap head $ findPackagesByDB flag_dbs pkgarg
   let 
       db_name = location db
       pkgs    = packages db
 
-      pids = map sourcePackageId ps
+      pks = map packageKey ps
 
-      cmds = [ fn pkg | pkg <- pkgs, sourcePackageId pkg `elem` pids ]
+      cmds = [ fn pkg | pkg <- pkgs, packageKey pkg `elem` pks ]
       new_db = updateInternalDB db cmds
 
+      -- ...but do consistency checks with regards to the full stack
       old_broken = brokenPackages (allPackagesInStack db_stack)
       rest_of_stack = filter ((/= db_name) . location) db_stack
       new_stack = new_db : rest_of_stack
-      new_broken = map sourcePackageId (brokenPackages (allPackagesInStack new_stack))
-      newly_broken = filter (`notElem` map sourcePackageId old_broken) new_broken
+      new_broken = brokenPackages (allPackagesInStack new_stack)
+      newly_broken = filter ((`notElem` map packageKey old_broken)
+                            . packageKey) new_broken
   --
+  let displayQualPkgId pkg
+        | [_] <- filter ((== pkgid) . sourcePackageId)
+                        (allPackagesInStack db_stack)
+            = display pkgid
+        | otherwise = display pkgid ++ "@" ++ display (packageKey pkg)
+        where pkgid = sourcePackageId pkg
   when (not (null newly_broken)) $
-      dieOrForceAll force ("unregistering " ++ display pkgid ++
-           " would break the following packages: "
-              ++ unwords (map display newly_broken))
+      dieOrForceAll force ("unregistering would break the following packages: "
+              ++ unwords (map displayQualPkgId newly_broken))
 
   changeDB verbosity cmds db
 
@@ -998,7 +1129,10 @@ listPackages verbosity my_flags mPackageName mModuleName = do
                    case pkgName p1 `compare` pkgName p2 of
                         LT -> LT
                         GT -> GT
-                        EQ -> pkgVersion p1 `compare` pkgVersion p2
+                        EQ -> case pkgVersion p1 `compare` pkgVersion p2 of
+                                LT -> LT
+                                GT -> GT
+                                EQ -> packageKey pkg1 `compare` packageKey pkg2
                    where (p1,p2) = (sourcePackageId pkg1, sourcePackageId pkg2)
 
       stack = reverse db_stack_sorted
@@ -1006,7 +1140,7 @@ listPackages verbosity my_flags mPackageName mModuleName = do
       match `exposedInPkg` pkg = any match (map display $ exposedModules pkg)
 
       pkg_map = allPackagesInStack db_stack
-      broken = map sourcePackageId (brokenPackages pkg_map)
+      broken = map packageKey (brokenPackages pkg_map)
 
       show_normal PackageDB{ location = db_name, packages = pkg_confs } =
           do hPutStrLn stdout (db_name ++ ":")
@@ -1017,7 +1151,7 @@ listPackages verbosity my_flags mPackageName mModuleName = do
                  -- Sort using instance Ord PackageId
                  pp_pkgs = map pp_pkg . sortBy (comparing installedPackageId) $ pkg_confs
                  pp_pkg p
-                   | sourcePackageId p `elem` broken = printf "{%s}" doc
+                   | packageKey p `elem` broken = printf "{%s}" doc
                    | exposed p = doc
                    | otherwise = printf "(%s)" doc
                    where doc | verbosity >= Verbose = printf "%s (%s)" pkg ipid
@@ -1035,34 +1169,34 @@ listPackages verbosity my_flags mPackageName mModuleName = do
   if simple_output then show_simple stack else do
 
 #if defined(mingw32_HOST_OS) || defined(BOOTSTRAPPING)
-  mapM_ show_normal stack
+    mapM_ show_normal stack
 #else
-  let
-     show_colour withF db =
-         mconcat $ map (<#> termText "\n") $
-             (termText (location db) :
-                map (termText "   " <#>) (map pp_pkg (packages db)))
-        where
-                 pp_pkg p
-                   | sourcePackageId p `elem` broken = withF Red  doc
-                   | exposed p                       = doc
-                   | otherwise                       = withF Blue doc
-                   where doc | verbosity >= Verbose
-                             = termText (printf "%s (%s)" pkg ipid)
-                             | otherwise
-                             = termText pkg
-                          where
-                          InstalledPackageId ipid = installedPackageId p
-                          pkg = display (sourcePackageId p)
-
-  is_tty <- hIsTerminalDevice stdout
-  if not is_tty
-     then mapM_ show_normal stack
-     else do tty <- Terminfo.setupTermFromEnv
-             case Terminfo.getCapability tty withForegroundColor of
-                 Nothing -> mapM_ show_normal stack
-                 Just w  -> runTermOutput tty $ mconcat $
-                                                map (show_colour w) stack
+    let
+       show_colour withF db =
+           mconcat $ map (<#> termText "\n") $
+               (termText (location db) :
+                  map (termText "   " <#>) (map pp_pkg (packages db)))
+          where
+                   pp_pkg p
+                     | packageKey p `elem` broken = withF Red  doc
+                     | exposed p                       = doc
+                     | otherwise                       = withF Blue doc
+                     where doc | verbosity >= Verbose
+                               = termText (printf "%s (%s)" pkg ipid)
+                               | otherwise
+                               = termText pkg
+                            where
+                            InstalledPackageId ipid = installedPackageId p
+                            pkg = display (sourcePackageId p)
+
+    is_tty <- hIsTerminalDevice stdout
+    if not is_tty
+       then mapM_ show_normal stack
+       else do tty <- Terminfo.setupTermFromEnv
+               case Terminfo.getCapability tty withForegroundColor of
+                   Nothing -> mapM_ show_normal stack
+                   Just w  -> runTermOutput tty $ mconcat $
+                                                  map (show_colour w) stack
 #endif
 
 simplePackageList :: [Flag] -> [InstalledPackageInfo] -> IO ()
@@ -1096,6 +1230,8 @@ showPackageDot verbosity myflags = do
 -- -----------------------------------------------------------------------------
 -- Prints the highest (hidden or exposed) version of a package
 
+-- ToDo: This is no longer well-defined with package keys, because the
+-- dependencies may be varying versions
 latestPackage ::  Verbosity -> [Flag] -> PackageIdentifier -> IO ()
 latestPackage verbosity my_flags pkgid = do
   (_, _, flag_db_stack) <- 
@@ -1155,6 +1291,7 @@ findPackagesByDB db_stack pkgarg
         ps -> return ps
   where
         pkg_msg (Id pkgid)           = display pkgid
+        pkg_msg (IPId ipid)          = display ipid
         pkg_msg (Substring pkgpat _) = "matching " ++ pkgpat
 
 matches :: PackageIdentifier -> PackageIdentifier -> Bool
@@ -1168,6 +1305,7 @@ realVersion pkgid = versionBranch (pkgVersion pkgid) /= []
 
 matchesPkg :: PackageArg -> InstalledPackageInfo -> Bool
 (Id pid)        `matchesPkg` pkg = pid `matches` sourcePackageId pkg
+(IPId ipid)     `matchesPkg` pkg = ipid == installedPackageId pkg
 (Substring _ m) `matchesPkg` pkg = m (display (sourcePackageId pkg))
 
 -- -----------------------------------------------------------------------------
@@ -1204,7 +1342,8 @@ checkConsistency verbosity my_flags = do
   let pkgs = allPackagesInStack db_stack
 
       checkPackage p = do
-         (_,es,ws) <- runValidate $ checkPackageConfig p verbosity db_stack False True
+         (_,es,ws) <- runValidate $ checkPackageConfig p verbosity db_stack
+                                                       False True True
          if null es
             then do when (not simple_output) $ do
                       _ <- reportValidateErrors [] ws "" Nothing
@@ -1267,15 +1406,19 @@ type InstalledPackageInfoString = InstalledPackageInfo_ String
 convertPackageInfoOut :: InstalledPackageInfo -> InstalledPackageInfoString
 convertPackageInfoOut
     (pkgconf@(InstalledPackageInfo { exposedModules = e,
+                                     reexportedModules = r,
                                      hiddenModules = h })) =
         pkgconf{ exposedModules = map display e,
+                 reexportedModules = map (fmap display) r,
                  hiddenModules  = map display h }
 
 convertPackageInfoIn :: InstalledPackageInfoString -> InstalledPackageInfo
 convertPackageInfoIn
     (pkgconf@(InstalledPackageInfo { exposedModules = e,
+                                     reexportedModules = r,
                                      hiddenModules = h })) =
         pkgconf{ exposedModules = map convert e,
+                 reexportedModules = map (fmap convert) r,
                  hiddenModules  = map convert h }
     where convert = fromJust . simpleParse
 
@@ -1354,11 +1497,15 @@ validatePackageConfig :: InstalledPackageInfo
                       -> Verbosity
                       -> PackageDBStack
                       -> Bool   -- auto-ghc-libs
+                      -> Bool   -- multi_instance
                       -> Bool   -- update, or check
                       -> Force
                       -> IO ()
-validatePackageConfig pkg verbosity db_stack auto_ghci_libs update force = do
-  (_,es,ws) <- runValidate $ checkPackageConfig pkg verbosity db_stack auto_ghci_libs update
+validatePackageConfig pkg verbosity db_stack auto_ghci_libs
+                      multi_instance update force = do
+  (_,es,ws) <- runValidate $
+                 checkPackageConfig pkg verbosity db_stack
+                                    auto_ghci_libs multi_instance update
   ok <- reportValidateErrors es ws (display (sourcePackageId pkg) ++ ": ") (Just force)
   when (not ok) $ exitWith (ExitFailure 1)
 
@@ -1366,12 +1513,15 @@ checkPackageConfig :: InstalledPackageInfo
                       -> Verbosity
                       -> PackageDBStack
                       -> Bool   -- auto-ghc-libs
+                      -> Bool   -- multi_instance
                       -> Bool   -- update, or check
                       -> Validate ()
-checkPackageConfig pkg verbosity db_stack auto_ghci_libs update = do
+checkPackageConfig pkg verbosity db_stack auto_ghci_libs
+                   multi_instance update = do
   checkInstalledPackageId pkg db_stack update
   checkPackageId pkg
-  checkDuplicates db_stack pkg update
+  checkPackageKey pkg
+  checkDuplicates db_stack pkg multi_instance update
   mapM_ (checkDep db_stack) (depends pkg)
   checkDuplicateDepends (depends pkg)
   mapM_ (checkDir False "import-dirs")  (importDirs pkg)
@@ -1410,15 +1560,25 @@ checkPackageId ipi =
     []  -> verror CannotForce ("invalid package identifier: " ++ str)
     _   -> verror CannotForce ("ambiguous package identifier: " ++ str)
 
-checkDuplicates :: PackageDBStack -> InstalledPackageInfo -> Bool -> Validate ()
-checkDuplicates db_stack pkg update = do
+checkPackageKey :: InstalledPackageInfo -> Validate ()
+checkPackageKey ipi =
+  let str = display (packageKey ipi) in
+  case [ x :: PackageKey | (x,ys) <- readP_to_S parse str, all isSpace ys ] of
+    [_] -> return ()
+    []  -> verror CannotForce ("invalid package key: " ++ str)
+    _   -> verror CannotForce ("ambiguous package key: " ++ str)
+
+checkDuplicates :: PackageDBStack -> InstalledPackageInfo
+                -> Bool -> Bool-> Validate ()
+checkDuplicates db_stack pkg multi_instance update = do
   let
         pkgid = sourcePackageId pkg
         pkgs  = packages (head db_stack)
   --
   -- Check whether this package id already exists in this DB
   --
-  when (not update && (pkgid `elem` map sourcePackageId pkgs)) $
+  when (not update && not multi_instance
+                   && (pkgid `elem` map sourcePackageId pkgs)) $
        verror CannotForce $
           "package " ++ display pkgid ++ " is already installed"
 
@@ -1504,6 +1664,7 @@ doesFileExistOnPath filenames paths = go fullFilenames
         go ((p, fp) : xs) = do b <- doesFileExist fp
                                if b then return (Just p) else go xs
 
+-- XXX maybe should check reexportedModules too
 checkModules :: InstalledPackageInfo -> Validate ()
 checkModules pkg = do
   mapM_ findModule (exposedModules pkg ++ hiddenModules pkg)
diff --git a/utils/ghc-pkg/ghc-pkg.cabal b/utils/ghc-pkg/ghc-pkg.cabal
index 2f42e31f15c2..317aab7cfa77 100644
--- a/utils/ghc-pkg/ghc-pkg.cabal
+++ b/utils/ghc-pkg/ghc-pkg.cabal
@@ -7,20 +7,21 @@ License: BSD3
 Author: XXX
 Maintainer: cvs-fptools@haskell.org
 Synopsis: XXX
-Description:
-	XXX
+Description: XXX
 Category: Development
 build-type: Simple
-cabal-version: >=1.4
+cabal-version: >=1.10
 
 Executable ghc-pkg
+    Default-Language: Haskell2010
     Main-Is: Main.hs
     Other-Modules: Version
-    Extensions: CPP, ForeignFunctionInterface, NondecreasingIndentation
+    Other-Extensions: CPP
 
     Build-Depends: base       >= 4   && < 5,
                    directory  >= 1   && < 1.3,
                    process    >= 1   && < 1.3,
+                   containers,
                    filepath,
                    Cabal,
                    binary,
diff --git a/utils/ghc-pwd/ghc-pwd.cabal b/utils/ghc-pwd/ghc-pwd.cabal
index ba2eb63b8271..4d155b031766 100644
--- a/utils/ghc-pwd/ghc-pwd.cabal
+++ b/utils/ghc-pwd/ghc-pwd.cabal
@@ -9,9 +9,10 @@ Synopsis: XXX
 Description:
 	XXX
 build-type: Simple
-cabal-version: >=1.2
+cabal-version: >=1.10
 
 Executable ghc-pwd
+    Default-Language: Haskell2010
     Main-Is: ghc-pwd.hs
     Build-Depends: base       >= 3   && < 5,
                    directory  >= 1   && < 1.3
diff --git a/utils/ghctags/Main.hs b/utils/ghctags/Main.hs
index 9fffd5246474..4a094f50a1a3 100644
--- a/utils/ghctags/Main.hs
+++ b/utils/ghctags/Main.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE PatternGuards, ScopedTypeVariables #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 module Main where
 
 import Prelude hiding ( mod, id, mapM )
@@ -20,7 +20,6 @@ import SrcLoc
 
 import Distribution.Simple.GHC ( componentGhcOptions )
 import Distribution.Simple.Configure ( getPersistBuildConfig )
-import Distribution.Simple.Compiler ( compilerVersion )
 import Distribution.Simple.Program.GHC ( renderGhcOptions )
 import Distribution.PackageDescription ( library, libBuildInfo )
 import Distribution.Simple.LocalBuildInfo
@@ -191,8 +190,7 @@ flagsFromCabal distPref = do
       let bi = libBuildInfo lib
           odir = buildDir lbi
           opts = componentGhcOptions V.normal lbi bi clbi odir
-          version = compilerVersion (compiler lbi)
-      in return $ renderGhcOptions version opts
+      in return $ renderGhcOptions (compiler lbi) opts
     _ -> error "no library"
 
 ----------------------------------------------------------------
@@ -257,7 +255,7 @@ boundValues mod group =
   let vals = case hs_valds group of
                ValBindsOut nest _sigs ->
                    [ x | (_rec, binds) <- nest
-                       , (_, bind) <- bagToList binds
+                       , bind <- bagToList binds
                        , x <- boundThings mod bind ]
                _other -> error "boundValues"
       tys = [ n | ns <- map hsLTyClDeclBinders (tyClGroupConcat (hs_tyclds group))
@@ -284,7 +282,7 @@ boundThings modname lbinding =
     PatBind { pat_lhs = lhs } -> patThings lhs []
     VarBind { var_id = id } -> [FoundThing modname (getOccString id) (startOfLocated lbinding)]
     AbsBinds { } -> [] -- nothing interesting in a type abstraction
-    PatSynBind { patsyn_id = id } -> [thing id]
+    PatSynBind PSB{ psb_id = id } -> [thing id]
   where thing = foundOfLName modname
         patThings lpat tl =
           let loc = startOfLocated lpat
diff --git a/utils/ghctags/ghctags.cabal b/utils/ghctags/ghctags.cabal
index 07221d3e088e..cfa841dcb067 100644
--- a/utils/ghctags/ghctags.cabal
+++ b/utils/ghctags/ghctags.cabal
@@ -6,17 +6,18 @@ License: BSD3
 Author: XXX
 Maintainer: XXX
 Synopsis: XXX
-Description:
-	XXX
+Description: XXX
 Category: Development
 build-type: Simple
-cabal-version: >=1.2
+cabal-version: >=1.10
 
 Executable ghctags
+    Default-Language: Haskell2010
+
     Main-Is: Main.hs
 
     Build-Depends: base       >= 4   && < 5,
                    containers,
-                   Cabal,
+                   Cabal      >= 1.20 && <1.22,
                    ghc
 
diff --git a/utils/haddock b/utils/haddock
new file mode 160000
index 000000000000..f32ad30e9b8c
--- /dev/null
+++ b/utils/haddock
@@ -0,0 +1 @@
+Subproject commit f32ad30e9b8c5d4ee54c60c9c3b282fef7d297a5
diff --git a/utils/heap-view/Graph.lhs b/utils/heap-view/Graph.lhs
deleted file mode 100644
index b8e08dbb9bc9..000000000000
--- a/utils/heap-view/Graph.lhs
+++ /dev/null
@@ -1,165 +0,0 @@
-Started 29/11/93: 
-
-> module Main where
-> import PreludeGlaST
-> import LibSystem
-
-Program to draw a graph of last @n@ pieces of data from standard input
-continuously.
-
-> n :: Int
-> n = 40
-
-> max_sample :: Int
-> max_sample = 100
-
-> screen_size :: Int
-> screen_size = 200
-
-Version of grapher that can handle the output of ghc's @+RTS -Sstderr@
-option.  
-
-Nice variant would be to take a list of numbers from the commandline
-and display several graphs at once.
-
-> main :: IO ()
-> main =
->	getArgs				>>= \ r ->
->	case r of 
->	  [select] -> 
->		let selection = read select
->		in
->		xInitialise [] screen_size screen_size	>>
-> 		hGetContents stdin			>>= \ input ->
->  		graphloop2 (parseGCData selection input) [] 
->	  _ -> 
->		error "usage: graph <number in range 0..17>\n"
-
-The format of glhc18's stderr stuff is:
-
--- start of example (view in 120 column window)
-graph +RTS -Sstderr -H500 
-
-Collector: APPEL  HeapSize: 500 (bytes)
-
-  Alloc  Collect   Live   Resid   GC    GC     TOT     TOT  Page Flts   No of Roots  Caf  Mut-  Old  Collec  Resid
-  bytes   bytes    bytes   ency  user  elap    user    elap   GC  MUT  Astk Bstk Reg  No  able  Gen   tion   %heap
-     248     248      60  24.2%  0.00  0.04    0.05    0.23    1    1     1    0   0   1     0    0   Minor
--- end of example
-     0       1      2       3      4    5      6       7       8    9    10   11  12  13    14   15      16     17
-
-That is: 6 header lines followed by 17-18 columns of integers,
-percentages, floats and text.
-
-The scaling in the following is largely based on guesses about likely
-values - needs tuned.  
-
-@gcParsers@ is a list of functions which parse the corresponding
-column and attempts to scale the numbers into the range $0.0 .. 1.0$.
-(But may return a number avove $1.0$ which graphing part will scale to
-fit screen...)
-
-(Obvious optimisation - replace by list of scaling information!)
-
-(Obvious improvement - return (x,y) pair based on elapsed (or user) time.)
-
-> gcParsers :: [ String -> Float ]
-> gcParsers = [ heap, heap, heap, percent, time, time, time, time, flts, flts, stk, stk, reg, caf, caf, heap, text, percent ]
->  where
->   heap = scale 100000.0 . fromInt . check 0 . readDec
->   stk  = scale  25000.0 . fromInt . check 0 . readDec
->   int  = scale   1000.0 . fromInt . check 0 . readDec
->   reg = scale   10.0 . fromInt . check 0 . readDec
->   caf = scale  100.0 . fromInt . check 0 . readDec
->   flts = scale  100.0 . fromInt . check 0 . readDec
->   percent = scale 100.0 . check 0.0 . readFloat
->   time   = scale  20.0 . check 0.0 . readFloat
->   text s = 0.0
-
-> check :: a -> [(a,String)] -> a
-> check error_value parses = 
->	case parses of
->	  [] 		-> error_value
->	  ((a,s):_) 	-> a
-
-> scale :: Float -> Float -> Float
-> scale max n = n / max
-
-> parseGCData :: Int -> String -> [Float]
-> parseGCData column input = 
->	map ((gcParsers !! column) . (!! column) . words) (drop 6 (lines input))
-
-Hmmm, how to add logarithmic scaling neatly?  Do I still need to?
-
-Note: unpleasant as it is, the code cannot be simplified to something
-like the following.  The problem is that the graph won't start to be
-drawn until the first @n@ values are available. (Is there also a
-danger of clearing the screen while waiting for the next input value?)
-A possible alternative solution is to keep count of how many values
-have actually been received.
-
-< graphloop2 :: [Float] -> [Float] -> IO ()
-< graphloop2 [] =
-<	return ()
-< graphloop2 ys =
-<	let ys' = take n ys
-<	    m = maximum ys'
-<	    y_scale = (floor m) + 1
-<	    y_scale' = fromInt y_scale
-<	in
-<	xCls						>>
-< 	drawScales y_scale				>>
-<	draw x_coords [ x / y_scale' | x <- ys' ]	>>
-<	xHandleEvent					>>
-<	graphloop2 (tail ys)
-
-
-> graphloop2 :: [Float] -> [Float] -> IO ()
-> graphloop2 (y:ys) xs =
->	let xs' = take n (y:xs)
->	    m = maximum xs'
->	    y_scale = (floor m) + 1
->	    y_scale' = fromInt y_scale
->	in
->	xCls						>>
-> 	drawScales y_scale				>>
->	draw x_coords [ x / y_scale' | x <- xs' ]	>>
->	xHandleEvent					>>
->	graphloop2 ys xs'
-> graphloop2 [] xs =
->	return ()
-
-> x_coords :: [Float]
-> x_coords = [ 0.0, 1 / (fromInt n) .. ]
-
-Draw lines specified by coordinates in range (0.0 .. 1.0) onto screen.
-
-> draw :: [Float] -> [Float] -> IO ()
-> draw xs ys = drawPoly (zip xs' (reverse ys'))
->  where
->   xs' = [ floor (x * sz) | x <- xs ]
->   ys' = [ floor ((1.0 - y) * sz) | y <- ys ]
->   sz = fromInt screen_size
-
-> drawPoly :: [(Int, Int)] -> IO ()
-> drawPoly ((x1,y1):(x2,y2):poly) =
->	xDrawLine x1 y1 x2 y2		>>
->	drawPoly ((x2,y2):poly)
-> drawPoly _ = return ()
-
-Draw horizontal line at major points on y-axis.
-
-> drawScales :: Int -> IO ()
-> drawScales y_scale =
->	sequence (map drawScale ys)	>>
->	return ()
->  where
->   ys = [ (fromInt i) / (fromInt y_scale) | i <- [1 .. y_scale - 1] ]
-
-> drawScale :: Float -> IO ()
-> drawScale y =
->	let y' = floor ((1.0 - y) * (fromInt screen_size))
->	in
->	xDrawLine 0 y' screen_size y'
-
->#include "common-bits"
diff --git a/utils/heap-view/HaskXLib.c b/utils/heap-view/HaskXLib.c
deleted file mode 100644
index b6cf1f137c64..000000000000
--- a/utils/heap-view/HaskXLib.c
+++ /dev/null
@@ -1,297 +0,0 @@
-/*----------------------------------------------------------------------*
- *  X from Haskell (PicoX)
- *
- * (c) 1993 Andy Gill
- *
- *----------------------------------------------------------------------*/
-
-#include <X11/Xlib.h>
-#include <X11/Xutil.h>
-#include <X11/Xatom.h>
-#include <stdio.h>
-#include <strings.h>
-
-/*----------------------------------------------------------------------*/
-
-/* First the X Globals */
-
-Display *MyDisplay;
-int	 MyScreen;
-Window   MyWindow;
-XEvent   MyWinEvent;
-GC       DrawGC;
-GC       UnDrawGC;
-
-/* and the Haskell globals */
-
-typedef struct {
-  int HaskButtons[5];
-  int HaskPointerX,HaskPointerY;
-  int PointMoved;
-} HaskGlobType;
-
-HaskGlobType HaskGlob;
-
-/*----------------------------------------------------------------------*/
-
-/*
- * Now the access functions into the haskell globals
- */
-
-int haskGetButtons(int n)
-{
-  return(HaskGlob.HaskButtons[n]);
-}
-
-int haskGetPointerX(void)
-{
-  return(HaskGlob.HaskPointerX);
-}
-
-int haskGetPointerY(void)
-{
-  return(HaskGlob.HaskPointerY);
-}
-
-/*----------------------------------------------------------------------*/
-
-/*
- *The (rather messy) initiualisation
- */
-
-haskXBegin(int x,int y,int sty)
-{
- /*
-  *  later include these via interface hacks
-  */
-
- /* (int argc, char **argv) */
-  int argc = 0;
-  char **argv = 0;
-
-  XSizeHints XHints;
-  int MyWinFG, MyWinBG,tmp;
- 
-  if ((MyDisplay = XOpenDisplay("")) == NULL) {
-      fprintf(stderr, "Cannot connect to X server '%s'\n", XDisplayName(""));
-      exit(1);
-  }
-
-  MyScreen = DefaultScreen(MyDisplay);
-
-  MyWinBG = WhitePixel(MyDisplay, MyScreen);
-  MyWinFG = BlackPixel(MyDisplay, MyScreen);
- 
-  XHints.x      = x;
-  XHints.y      = y;
-  XHints.width  = x;
-  XHints.height = y;
-  XHints.flags  = PPosition | PSize;
- 
-  MyWindow =
-      XCreateSimpleWindow(
-			  MyDisplay,
-			  DefaultRootWindow(MyDisplay),
-			  x,y, x, y,
-			  5,
-			  MyWinFG,
-			  MyWinBG
-			  );
- 
-  XSetStandardProperties(
-			 MyDisplay,
-			 MyWindow,
-			 "XLib for Glasgow Haskell",
-			 "XLib for Glasgow Haskell",
-			 None,
-			 argv,
-			 argc,
-			 &XHints
-			 );
- 
-  /* Create drawing and erasing GC */
- 
-  DrawGC = XCreateGC(MyDisplay,MyWindow,0, 0);
-  XSetBackground(MyDisplay,DrawGC,MyWinBG);
-  XSetForeground(MyDisplay,DrawGC,MyWinFG);
-
-  UnDrawGC = XCreateGC(MyDisplay,MyWindow,0, 0);
-  XSetBackground(MyDisplay,UnDrawGC,MyWinFG);
-  XSetForeground(MyDisplay,UnDrawGC,MyWinBG);
-
-  XSetGraphicsExposures(MyDisplay,DrawGC,False);
-  XSetGraphicsExposures(MyDisplay,UnDrawGC,False);
-  XMapRaised(MyDisplay,MyWindow);
- 
-  /* the user should be able to choose which are tested for
-   */
-
-  XSelectInput(
-	       MyDisplay,
-	       MyWindow,
-	           ButtonPressMask | ButtonReleaseMask | PointerMotionMask 
-	       );
-
-  /*  later have more drawing styles
-   */
-
-  switch (sty)
-    {
-    case 0:   
-      /* Andy, this used to be GXor not much use for Undrawing so I
-         changed it. (Not much use for colour either - see next
-         comment */
-      XSetFunction(MyDisplay,DrawGC,GXcopy);
-      XSetFunction(MyDisplay,UnDrawGC,GXcopy);
-      break;
-    case 1:   
-      /* Andy, this can have totally bogus results on a colour screen */
-      XSetFunction(MyDisplay,DrawGC,GXxor);
-      XSetFunction(MyDisplay,UnDrawGC,GXxor);
-      break;
-    default:
-      /* Andy, is this really a good error message? */
-      printf(stderr,"Wrong Argument to XSet function\n");
-    }
- /*
-  *  reset the (Haskell) globals
-  */
-
- for(tmp=0;tmp<5;tmp++)
-   {
-     HaskGlob.HaskButtons[tmp] = 0;
-   }
-  HaskGlob.HaskPointerX = 0;
-  HaskGlob.HaskPointerY = 0;
-  HaskGlob.PointMoved = 0;
-
-  XFlush(MyDisplay);
-
-} 
-
-/*----------------------------------------------------------------------*/
-
-/* Boring X ``Do Something'' functions
- */
-
-haskXClose(void)
-{
-  XFreeGC( MyDisplay, DrawGC);
-  XFreeGC( MyDisplay, UnDrawGC);
-  XDestroyWindow( MyDisplay, MyWindow);
-  XCloseDisplay( MyDisplay);
-  return(0);
-}
-
-haskXDraw(x,y,x1,y1)
-int x,y,x1,y1;
-{
-  XDrawLine(MyDisplay,
-	    MyWindow,
-	    DrawGC,
-	    x,y,x1,y1);
-  return(0);
-}
-
-
-haskXPlot(c,x,y)
-int c;
-int x,y;
-{
-  XDrawPoint(MyDisplay,
-	    MyWindow,
-	    (c?DrawGC:UnDrawGC), 
-	    x,y);
-  return(0);
-}
-
-haskXFill(c,x,y,w,h)
-int c;
-int x, y;
-int w, h;
-{
-  XFillRectangle(MyDisplay,
-	    MyWindow,
-	    (c?DrawGC:UnDrawGC),
-	    x, y, w, h);
-  return(0);
-}
-
-/*----------------------------------------------------------------------*/
- 
- /* This has to be called every time round the loop,
-  * it flushed the buffer and handles input from the user
-  */
-
-haskHandleEvent()
-{
-  XFlush( MyDisplay);
-  while (XEventsQueued( MyDisplay, QueuedAfterReading) != 0) {
-    XNextEvent( MyDisplay, &MyWinEvent);
-    switch (MyWinEvent.type) {
-    case ButtonPress:
-      switch (MyWinEvent.xbutton.button) 
-	{
-	case Button1: HaskGlob.HaskButtons[0] = 1; break;
-	case Button2: HaskGlob.HaskButtons[1] = 1; break;
-	case Button3: HaskGlob.HaskButtons[2] = 1; break;
-	case Button4: HaskGlob.HaskButtons[3] = 1; break;
-	case Button5: HaskGlob.HaskButtons[4] = 1; break;
-	}
-      break;
-    case ButtonRelease:
-      switch (MyWinEvent.xbutton.button) 
-	{
-	case Button1: HaskGlob.HaskButtons[0] = 0; break;
-	case Button2: HaskGlob.HaskButtons[1] = 0; break;
-	case Button3: HaskGlob.HaskButtons[2] = 0; break;
-	case Button4: HaskGlob.HaskButtons[3] = 0; break;
-	case Button5: HaskGlob.HaskButtons[4] = 0; break;
-	}
-      break;
-    case MotionNotify: 
-        HaskGlob.HaskPointerX = MyWinEvent.xmotion.x;
-        HaskGlob.HaskPointerY = MyWinEvent.xmotion.y;
-        HaskGlob.PointMoved = 1;
-      break;
-    default:
-    printf("UNKNOWN INTERUPT ???? (%d) \n",MyWinEvent.type); 
-      break;
-    } /*switch*/
-  } /*if*/
-  return(0);
-} 
-
-
-/*----------------------------------------------------------------------*/
-
- /* A function to clear the screen 
-  */
-
-haskXCls(void)
-{
-  XClearWindow(MyDisplay,MyWindow);
-}
-
-/*----------------------------------------------------------------------*/
-
- /* A function to write a string
-  */
-
-haskXDrawString(int x,int y,char *str)
-{
-  return(0);
-/*  printf("GOT HERE %s %d %d",str,x,y); 
-  XDrawString(MyDisplay,MyWindow,DrawGC,x,y,str,strlen(str));
-*/
-}
-
-/*----------------------------------------------------------------------*/
-
-extern int prog_argc;
-extern char **prog_argv;
-
-haskArgs()
-{
-  return(prog_argc > 1 ? atoi(prog_argv[1]) : 0);
-}
diff --git a/utils/heap-view/HpView.lhs b/utils/heap-view/HpView.lhs
deleted file mode 100644
index a7b4cbb78ead..000000000000
--- a/utils/heap-view/HpView.lhs
+++ /dev/null
@@ -1,296 +0,0 @@
-> module Main where
-> import PreludeGlaST
-> import LibSystem
-
-> import Parse
-
-Program to interpret a heap profile.
-
-Started 28/11/93: parsing of profile
-Tweaked 28/11/93: parsing fiddled till it worked and graphical backend added
-
-To be done:
-
-0) think about where I want to go with this
-1) further processing... sorting, filtering, ...
-2) get dynamic display
-3) maybe use widgets
-
-Here's an example heap profile
-
-          JOB "a.out -p"
-          DATE "Fri Apr 17 11:43:45 1992"
-          SAMPLE_UNIT "seconds"
-          VALUE_UNIT "bytes"
-          BEGIN_SAMPLE 0.00
-            SYSTEM 24
-          END_SAMPLE 0.00
-          BEGIN_SAMPLE 1.00
-            elim 180
-            insert 24
-            intersect 12
-            disin 60
-            main 12
-            reduce 20
-            SYSTEM 12
-          END_SAMPLE 1.00
-          MARK 1.50
-          MARK 1.75
-          MARK 1.80
-          BEGIN_SAMPLE 2.00
-            elim 192
-            insert 24
-            intersect 12
-            disin 84
-            main 12
-            SYSTEM 24
-          END_SAMPLE 2.00
-          BEGIN_SAMPLE 2.82
-          END_SAMPLE 2.82
-
-By inspection, the format seems to be:
-
-profile :== header { sample }
-header :== job date { unit }
-job :== "JOB" command
-date :== "DATE" dte
-unit :== "SAMPLE_UNIT" string | "VALUE_UNIT" string
-
-sample :== samp | mark
-samp :== "BEGIN_SAMPLE" time {pairs} "END_SAMPLE" time
-pairs :== identifer count
-mark :== "MARK" time
-
-command :== string
-dte :== string
-time :== float
-count :== integer
-
-But, this doesn't indicate the line structure.  The simplest way to do
-this is to treat each line as a single token --- for which the
-following parser is useful:
-
-Special purpose parser that recognises a string if it matches a given
-prefix and returns the remainder.
-
-> prefixP :: String -> P String String
-> prefixP p =
->	itemP 			`thenP` \ a -> 
->	let (p',a') = splitAt (length p) a
->	in 	if p == p'
->		then unitP a'
->		else zeroP
-
-
-To begin with I want to parse a profile into a list of readings for
-each identifier at each time.
-
-> type Sample = (Float, [(String, Int)])
-
-> type Line = String
-
-
-> profile :: P Line [Sample]
-> profile = 
->	header			`thenP_`
->	zeroOrMoreP sample	
-
-> header :: P Line ()
-> header =
->	job			`thenP_`
->	date			`thenP_`
->	zeroOrMoreP unit	`thenP_`
->	unitP ()
-
-> job :: P Line String
-> job =	prefixP "JOB "
-
-> date :: P Line String
-> date = prefixP "DATE "
-
-> unit :: P Line String
-> unit =
->	( prefixP "SAMPLE_UNIT " )
->	`plusP`
->	( prefixP "VALUE_UNIT " )
-
-> sample :: P Line Sample
-> sample =
->	samp `plusP` mark
-
-> mark :: P Line Sample
-> mark =
->	prefixP "MARK "		`thenP` \ time ->
->	unitP (read time, [])
-
-ToDo: check that @time1 == time2@
-
-> samp :: P Line Sample
-> samp = 
->	prefixP "BEGIN_SAMPLE " 	`thenP` \ time1 ->
->	zeroOrMoreP pair		`thenP` \ pairs ->
->	prefixP "END_SAMPLE "		`thenP` \ time2 ->
->	unitP (read time1, pairs)
-
-> pair :: P Line (String, Int)
-> pair =
->	prefixP "  "			`thenP` \ sample_line ->
->	let [identifier,count] = words sample_line
->	in unitP (identifier, read count)
-
-This test works fine
-
-> {-
-> test :: String -> String
-> test str = ppSamples (theP profile (lines str))
-
-> test1 = test example
-
-> test2 :: String -> Dialogue
-> test2 file =
->	readFile file				exit
->	(\ hp -> appendChan stdout (test hp)	exit
->	done)
-> -}
-
-Inefficient pretty-printer (uses ++ excessively)
-
-> ppSamples :: [ Sample ] -> String
-> ppSamples = unlines . map ppSample
-
-> ppSample :: Sample -> String
-> ppSample (time, samps) = 
->	(show time) ++ unwords (map ppSamp samps)
-
-> ppSamp :: (String, Int) -> String
-> ppSamp (identifier, count) = identifier ++ ":" ++ show count
-
-To get the test1 to work in gofer, you need to fiddle with the input
-a bit to get over Gofer's lack of string-parsing code.
-
-> example =
->  "JOB \"a.out -p\"\n" ++
->  "DATE \"Fri Apr 17 11:43:45 1992\"\n" ++
->  "SAMPLE_UNIT \"seconds\"\n" ++
->  "VALUE_UNIT \"bytes\"\n" ++
->  "BEGIN_SAMPLE 0.00\n" ++
->  "  SYSTEM 24\n" ++
->  "END_SAMPLE 0.00\n" ++
->  "BEGIN_SAMPLE 1.00\n" ++
->  "  elim 180\n" ++
->  "  insert 24\n" ++
->  "  intersect 12\n" ++
->  "  disin 60\n" ++
->  "  main 12\n" ++
->  "  reduce 20\n" ++
->  "  SYSTEM 12\n" ++
->  "END_SAMPLE 1.00\n" ++
->  "MARK 1.50\n" ++
->  "MARK 1.75\n" ++
->  "MARK 1.80\n" ++
->  "BEGIN_SAMPLE 2.00\n" ++
->  "  elim 192\n" ++
->  "  insert 24\n" ++
->  "  intersect 12\n" ++
->  "  disin 84\n" ++
->  "  main 12\n" ++
->  "  SYSTEM 24\n" ++
->  "END_SAMPLE 2.00\n" ++
->  "BEGIN_SAMPLE 2.82\n" ++
->  "END_SAMPLE 2.82"
-
- 
-
-
-Hack to let me test this code... Gofer doesn't have integer parsing built in.
-
-> {-
-> read :: String -> Int
-> read s = 0
-> -}
-
-> screen_size = 200
-
-ToDo: 
-
-1) the efficiency of finding slices can probably be dramatically
-   improved... if it matters.
-
-2) the scaling should probably depend on the slices used
-
-3) labelling graphs, colour, ...
-
-4) responding to resize events
-
-> main :: IO ()
-> main =
->	getArgs				>>= \ r ->
->	case r of 
->	  filename:idents -> 
->		readFile filename	>>= \ hp ->
->		let samples = theP profile (lines hp)
->
->		    times = [ t | (t,ss) <- samples ]
->		    names = [ n | (t,ss) <- samples, (n,c) <- ss ]
->		    counts = [ c | (t,ss) <- samples, (n,c) <- ss ]
->
->		    time = maximum times
->		    x_scale = (fromInt screen_size) / time
->
->		    max_count = maximum counts
->		    y_scale = (fromInt screen_size) / (fromInt max_count)
->
->		    slices = map (slice samples) idents
->		in
->		xInitialise [] screen_size screen_size		    >>
-> --		drawHeap x_scale y_scale samples		    >>
-> 		sequence (map (drawSlice x_scale y_scale) slices)   >>
->		freeze
->	  _ -> error "usage: hpView filename identifiers\n"
-
-> freeze :: IO ()
-> freeze =
->	xHandleEvent				>>
-> 	usleep 100				>>
->	freeze
-
-
-Slice drawing stuff... shows profile for each identifier
-
-> slice :: [Sample] -> String -> [(Float,Int)]
-> slice samples ident =
->	[ (t,c) | (t,ss) <- samples, c <- [lookupPairs ss ident 0] ]
-
-> lookupPairs :: Eq a => [(a, b)] -> a -> b -> b
-> lookupPairs ((a', b') : hs) a b =
->	if a == a' then b' else lookupPairs hs a b
-> lookupPairs [] a b = b
-
-> drawSlice :: Float -> Float -> [(Float,Int)] -> IO ()
-> drawSlice x_scale y_scale slc = 
->	drawPoly 
->	[ (round (x*x_scale), screen_size - (round ((fromInt y)*y_scale))) | (x,y) <- slc ]
-
-> drawPoly :: [(Int, Int)] -> IO ()
-> drawPoly ((x1,y1):(x2,y2):poly) =
->	xDrawLine x1 y1 x2 y2		>>
->	drawPoly ((x2,y2):poly)
-> drawPoly _ = return ()
-
-
-Very simple heap profiler... doesn't do a proper job at all.  Good for
-testing.
-
-> drawHeap :: Float -> Float -> [Sample] -> IO ()
-> drawHeap x_scale y_scale samples =
->	sequence (map xBar 
->		[ (t*x_scale, (fromInt c)*y_scale) 
->		| (t,ss) <- samples, (n,c) <- ss ])	>>	
->	return ()
-
-> xBar :: (Float, Float) -> IO ()
-> xBar (x, y) = 
->	let {x' = round x; y' = round y} 
->	in xDrawLine x' screen_size x' (screen_size - y')
-
->#include "common-bits"
diff --git a/utils/heap-view/HpView2.lhs b/utils/heap-view/HpView2.lhs
deleted file mode 100644
index fa8044b8b4dd..000000000000
--- a/utils/heap-view/HpView2.lhs
+++ /dev/null
@@ -1,225 +0,0 @@
-> module Main where
-> import PreludeGlaST
-> import LibSystem
-
-> import Parse
-
-Program to do continuous heap profile.
-
-Bad News: 
-
-    The ghc runtime system writes its heap profile information to a
-    named file (<progname>.hp).  The program merrily reads its input
-    from a named file but has no way of synchronising with the program
-    generating the file.
-
-Good News 0:
-
-    You can save the heap profile to a file:
-
-	    <progname> <parameters> +RTS -h -i0.1 -RTS
-
-    and then run:
-
-	    hpView2 <progname>.hp Main:<functionname>
-
-    This is very like using hp2ps but much more exciting because you
-    never know what's going to happen next :-)
-
-
-Good News 1:
-
-    The prophet Stallman has blessed us with the shell command @mkfifo@
-    (is there a standard Unix version?) which creates a named pipe.  If we
-    instead run:
-
-	    mkfifo <progname>.hp
-	    hpView2 <progname>.hp Main:<functionname> &
-	    <progname> <parameters> +RTS -h -i0.1 -RTS
-	    rm <progname>.hp
-
-    Good Things happen.
-
-    NB If you don't delete the pipe, Bad Things happen: the program
-    writes profiling info to the pipe until the pipe fills up then it
-    blocks...
-
-
-Right, on with the program:
-
-Here's an example heap profile
-
-          JOB "a.out -p"
-          DATE "Fri Apr 17 11:43:45 1992"
-          SAMPLE_UNIT "seconds"
-          VALUE_UNIT "bytes"
-          BEGIN_SAMPLE 0.00
-            SYSTEM 24
-          END_SAMPLE 0.00
-          BEGIN_SAMPLE 1.00
-            elim 180
-            insert 24
-            intersect 12
-            disin 60
-            main 12
-            reduce 20
-            SYSTEM 12
-          END_SAMPLE 1.00
-          MARK 1.50
-          MARK 1.75
-          MARK 1.80
-          BEGIN_SAMPLE 2.00
-            elim 192
-            insert 24
-            intersect 12
-            disin 84
-            main 12
-            SYSTEM 24
-          END_SAMPLE 2.00
-          BEGIN_SAMPLE 2.82
-          END_SAMPLE 2.82
-
-In HpView.lhs, I had a fancy parser to handle all this - but it was
-immensely inefficient.  We can produce something a lot more efficient
-and robust very easily by noting that the only lines we care about
-have precisely two entries on them.
-
-> type Line = String
-> type Word = String
-> type Sample = (Float, [(String, Int)])
-
-> parseProfile :: [[Word]] -> [Sample]
-> parseProfile [] = []
-> parseProfile ([keyword, time]:lines) | keyword == "BEGIN_SAMPLE" =
->	let (sample,rest) = parseSample lines
->	in
->	(read time, sample) : parseProfile rest
-> parseProfile (_:xs) = parseProfile xs
-
-> parseSample :: [[Word]] -> ([(String,Int)],[[Word]])
-> parseSample ([word, count]:lines) =
->	if word == "END_SAMPLE" 
->	then ([], lines)
->	else let (samples, rest) = parseSample lines
->	     in ( (word, read count):samples,  rest )
-> parseSample duff_lines = ([],duff_lines)
-
-> screen_size = 200
-
-> main :: IO ()
-> main =
->	getArgs					>>= \ r ->
->	case r of 
->	  [filename, ident] -> 
->		xInitialise [] screen_size screen_size	>>
->		readFile filename			>>= \ hp ->
->		let samples = parseProfile (map words (lines hp))
->		    totals = [ sum [ s | (_,s) <- ss ] | (t,ss) <- samples ]
->
->		    ts = map scale totals
->		    is = map scale (slice samples ident)
->  		in
->		graphloop2 (is, []) (ts, [])
->	  _ -> error "usage: hpView2 file identifier\n"
-
-For the example I'm running this on, the following scale does nicely.
-
-> scale :: Int -> Float
-> scale n = (fromInt n) / 10000.0
-
-Slice drawing stuff... shows profile for each identifier (Ignores time
-info in this version...)
-
-> slice :: [Sample] -> String -> [Int]
-> slice samples ident =
->	[ c | (t,ss) <- samples, c <- [lookupPairs ss ident 0] ]
-
-> lookupPairs :: Eq a => [(a, b)] -> a -> b -> b
-> lookupPairs ((a', b') : hs) a b =
->	if a == a' then b' else lookupPairs hs a b
-> lookupPairs [] a b = b
-
-Number of samples to display on screen
-
-> n :: Int
-> n = 40
-
-Graph-drawing loop.  Get's the data for the particular identifier and
-the total usage, scales to get total to fit screen and draws them.
-
-> graphloop2 :: ([Float], [Float]) -> ([Float], [Float]) -> IO ()
-> graphloop2 (i:is,is') (t:ts, ts') =
->	let is'' = take n (i:is')
->	    ts'' = take n (t:ts')
->
->	    -- scaling information:
->	    m = maximum ts''
->	    y_scale = (floor m) + 1
->	    y_scale' = fromInt y_scale
->	in
->	xCls						>>
-> 	drawScales y_scale				>>
->	draw x_coords [ x / y_scale' | x <- is'' ]	>>
->	draw x_coords [ x / y_scale' | x <- ts'' ]	>>
->	xHandleEvent					>>
->	graphloop2 (is,is'') (ts, ts'')
-> graphloop2 _ _ =
->	return ()
-
-> x_coords :: [Float]
-> x_coords = [ 0.0, 1 / (fromInt n) .. ]
-
-Note: unpleasant as it is, the code cannot be simplified to something
-like the following (which has scope for changing draw to take a list
-of pairs).  The problem is that the graph won't start to be drawn
-until the first @n@ values are available. (Is there also a danger of
-clearing the screen while waiting for the next input value?)  A
-possible alternative solution is to keep count of how many values have
-actually been received.
-
-< graphloop2 :: [Float] -> [Float] -> IO ()
-< graphloop2 [] =
-<	return ()
-< graphloop2 ys =
-<	let ys' = take n ys
-<	    m = maximum ys'
-<	    y_scale = (floor m) + 1
-<	    y_scale' = fromInt y_scale
-<	in
-<	xCls						>>
-< 	drawScales y_scale				>>
-<	draw x_coords [ x / y_scale' | x <- ys' ]	>>
-<	xHandleEvent					>>
-<	graphloop2 (tail ys)
-
-Draw lines specified by coordinates in range (0.0 .. 1.0) onto screen.
-
-> draw :: [Float] -> [Float] -> IO ()
-> draw xs ys = drawPoly (zip xs' (reverse ys'))
->  where
->   xs' = [ floor (x * sz) | x <- xs ]
->   ys' = [ floor ((1.0 - y) * sz) | y <- ys ]
->   sz = fromInt screen_size
-
-> drawPoly :: [(Int, Int)] -> IO ()
-> drawPoly ((x1,y1):(x2,y2):poly) =
->	xDrawLine x1 y1 x2 y2		>>
->	drawPoly ((x2,y2):poly)
-> drawPoly _ = return ()
-
-Draw horizontal line at major points on y-axis.
-
-> drawScales :: Int -> IO ()
-> drawScales y_scale =
->	sequence (map drawScale ys)	>>
->	return ()
->  where
->   ys = [ (fromInt i) / (fromInt y_scale) | i <- [1 .. y_scale - 1] ]
-
-> drawScale :: Float -> IO ()
-> drawScale y =
->	let y' = floor ((1.0 - y) * (fromInt screen_size))
->	in
->	xDrawLine 0 y' screen_size y'
-
->#include "common-bits"
diff --git a/utils/heap-view/MAIL b/utils/heap-view/MAIL
deleted file mode 100644
index 966fcdcfc736..000000000000
--- a/utils/heap-view/MAIL
+++ /dev/null
@@ -1,67 +0,0 @@
-To: partain@dcs.gla.ac.uk
-cc: areid@dcs.gla.ac.uk, andy@dcs.gla.ac.uk
-Subject: Heap profiling programs
-Date: Thu, 09 Dec 93 17:33:09 +0000
-From: Alastair Reid <areid@dcs.gla.ac.uk>
-
-
-I've hacked up a couple of programs which it might be worth putting in
-the next ghc distribution.  They are:
-
-graph:	
-
-  Draws a continuous graph of any one column of the statistics
-  produced using the "+RTS -Sstderr" option.
-
-  I'm not convinced this is astonishingly useful since I'm yet to
-  learn anything useful from (manually) examining these statistics.
-  (Although I do vaguely remember asking Patrick if the heap profiler
-  could do stack profiles too.)
-
-  A typical usage is:
-
-    slife 2 Unis/gardenofeden +RTS -Sstderr -H1M -RTS |& graph 2
-
-  which draws a graph of the third column (ie column 2!) of the
-  stats.
-
-  (btw is there a neater way of connecting stderr to graph's stdin?)
-
-hpView2:	
-
-  Draws a continuous graph of the statistics reported by the "+RTS -h"
-  option.
-
-  Since I understand what the figures mean, this seems to be the more
-  useful program.
-
-  A typical usage is:
-
-    mkfifo slife.hp
-    hpView2 slife.hp Main:mkQuad &
-    slife 2 Unis/gardenofeden +RTS -h -i0.1 -RTS 
-    rm slife.hp
-
-  which draws a graph of the total heap usage and the usage for Main:mkQuad.
-
-
-Minor problems:
-
-The code is a gross hack... but it works.  (Maybe distribute in rot13
-format so that you don't get accidentally get exposed to obscene code
-:-))
-
-The code uses a variant of Andy's picoXlibrary (which he was talking
-about releasing but maybe isn't ready to do yet.)
-
-Also, there are lots of obvious extensions etc which could be made but
-haven't yet...  (The major one is being able to set the initial
-scale-factor for displaying the graphs or being able to graph several
-stats at once without having to tee.)
-
-
-Hope you find them interesting.
-
-Alastair
-
-ps Code is in ~areid/hask/Life and should be readable/executable.
diff --git a/utils/heap-view/Makefile b/utils/heap-view/Makefile
deleted file mode 100644
index e8fa8faf087f..000000000000
--- a/utils/heap-view/Makefile
+++ /dev/null
@@ -1,31 +0,0 @@
-TOP=../..
-include $(TOP)/mk/boilerplate.mk
-
-PROGRAMS = graph hpView hpView2
-
-SRC_HC_OPTS += -hi-diffs -fglasgow-exts -fhaskell-1.3 -O -L/usr/X11/lib -cpp
-SRC_CC_OPTS += -ansi -I/usr/X11/include
-# ToDo: use AC_PATH_X in configure to get lib/include dirs for X.
-
-OBJS_graph   = Graph.o           HaskXLib.o
-OBJS_hpView  = HpView.o  Parse.o HaskXLib.o
-OBJS_hpView2 = HpView2.o Parse.o HaskXLib.o
-
-all :: $(PROGRAMS)
-
-graph : $(OBJS_graph)
-	$(HC) -o $@ $(HC_OPTS) $(LD_OPTS) $(OBJS_graph) -lX11
-
-hpView : $(OBJS_hpView)
-	$(HC) -o $@ $(HC_OPTS) $(LD_OPTS) $(OBJS_hpView) -lX11
-
-hpView2 : $(OBJS_hpView2)
-	$(HC) -o $@ $(HC_OPTS) $(LD_OPTS) $(OBJS_hpView2) -lX11
-
-HaskXLib.o : HaskXLib.c
-	$(CC) -c $(CC_OPTS) HaskXLib.c
-
-INSTALL_PROGS += $(PROGRAMS)
-CLEAN_FILES   += $(PROGRAMS)
-
-include $(TOP)/mk/target.mk
diff --git a/utils/heap-view/Makefile.original b/utils/heap-view/Makefile.original
deleted file mode 100644
index 1e35bc2e43e0..000000000000
--- a/utils/heap-view/Makefile.original
+++ /dev/null
@@ -1,48 +0,0 @@
-CC=gcc
-GLHC18 = glhc18
-GLHC19 = /users/fp/partain/bin/sun4/glhc
-HC= ghc -hi-diffs -fglasgow-exts -fhaskell-1.3
-HC_FLAGS = -O -prof -auto-all
-#HC_FLAGS = -O
-LIBS=-lX11
-FILES2 = Life2.o HaskXLib.o
-FILESS = LifeWithStability.o HaskXLib.o
-FILES = Life.o HaskXLib.o
-
-all : hpView hpView2
-
-# ADR's heap profile viewer
-hpView:	HpView.o Parse.o HaskXLib.o
-	$(HC) -o hpView $(HC_FLAGS) HpView.o Parse.o HaskXLib.o $(LIBS) -L/usr/X11/lib
-clean::
-	rm -f hpView
-
-# ADR's continuous heap profile viewer (handles output of -p)
-hpView2:	HpView2.o Parse.o HaskXLib.o
-	$(HC) -o hpView2 $(HC_FLAGS) HpView2.o Parse.o HaskXLib.o $(LIBS) -L/usr/X11/lib
-clean::
-	rm -f hpView2
-
-
-# ADR's continuous graph program (handles output of -Sstderr)
-graph:	Graph.o HaskXLib.o
-	$(HC) -o graph $(HC_FLAGS) Graph.o HaskXLib.o $(LIBS) -L/usr/X11/lib
-clean::
-	rm -f graph
-
-# ADR's continuous graph program (part of heap profile viewer) that
-# crashes the compiler
-bugGraph:	bugGraph.o HaskXLib.o
-	$(HC) -o bugGraph $(HC_FLAGS) bugGraph.o HaskXLib.o $(LIBS) -L/usr/X11/lib
-clean::
-	rm -f bugGraph
-
-%.o:%.c
-	$(CC) -c -ansi -traditional -g -I/usr/X11/include/ $< $(INC)
-
-%.o:%.lhs
-	$(HC) $(HC_FLAGS) -c $< $(INC)
-	
-clean::
-	rm -f core *.o *% #* 
-	rm -f *.hc
diff --git a/utils/heap-view/Parse.lhs b/utils/heap-view/Parse.lhs
deleted file mode 100644
index 9d7652fdcccb..000000000000
--- a/utils/heap-view/Parse.lhs
+++ /dev/null
@@ -1,92 +0,0 @@
-> module Parse where
-
-The Parser monad in "Comprehending Monads"
-
-> infixr 9 `thenP`
-> infixr 9 `thenP_`
-> infixr 9 `plusP`
-
-> type P t a = [t] -> [(a,[t])]
-
-> unitP :: a -> P t a
-> unitP a = \i -> [(a,i)]
-
-> thenP :: P t a -> (a -> P t b) -> P t b
-> m `thenP` k = \i0 -> [(b,i2) | (a,i1) <- m i0, (b,i2) <- k a i1]
-
-> thenP_ :: P t a -> P t b -> P t b
-> m `thenP_` k = \i0 -> [(b,i2) | (a,i1) <- m i0, (b,i2) <- k i1]
-
-zeroP is the parser that always fails to parse its input
-
-> zeroP :: P t a
-> zeroP = \i -> []
-
-plusP combines two parsers in parallel
-(called "alt" in "Comprehending Monads")
-
-> plusP :: P t a -> P t a -> P t a
-> a1 `plusP` a2 = \i -> (a1 i) ++ (a2 i)
-
-itemP is the parser that parses a single token
-(called "next" in "Comprehending Monads")
-
-> itemP :: P t t
-> itemP = \i -> [(head i, tail i) | not (null i)]
-
-force successful parse
-
-> cutP :: P t a -> P t a
-> cutP p = \u -> let l = p u in if null l then [] else [head l]
-
-find all complete parses of a given string
-
-> useP :: P t a -> [t] -> [a]
-> useP m =  \x -> [ a | (a,[]) <- m x ]
-
-find first complete parse
-
-> theP :: P t a -> [t] -> a
-> theP m = head . (useP m)
-
-
-Some standard parser definitions
-
-mapP applies f to all current parse trees
-
-> mapP :: (a -> b) -> P t a -> P t b
-> f `mapP` m =  m `thenP` (\a -> unitP (f a))
-
-filter is the parser that parses a single token if it satisfies a
-predicate and fails otherwise.
-
-> filterP :: (a -> Bool) -> P t a -> P t a
-> p `filterP` m = m `thenP` (\a -> (if p a then unitP a else zeroP))
-
-lit recognises literals
-
-> litP :: Eq t => t -> P t ()
-> litP t = ((==t) `filterP` itemP) `thenP` (\c -> unitP () )
-
-> showP :: (Text a) => P t a -> [t] -> String
-> showP m xs = show (theP m xs)
-
-
-Simon Peyton Jones adds some useful operations:
-
-> zeroOrMoreP :: P t a -> P t [a]
-> zeroOrMoreP p = oneOrMoreP p `plusP` unitP []
-
-> oneOrMoreP :: P t a -> P t [a]
-> oneOrMoreP p = seq p
->  where seq p = p		`thenP` (\a ->
->		(seq p		`thenP` (\as -> unitP (a:as)))
->		`plusP`
->		unitP [a] )
-
-> oneOrMoreWithSepP :: P t a -> P t b -> P t [a]
-> oneOrMoreWithSepP p1 p2 = seq1 p1 p2
->   where seq1 p1 p2 =	p1 `thenP` (\a -> seq2 p1 p2 a `plusP`  unitP [a])
->         seq2 p1 p2 a =	p2		`thenP` (\_ ->
->				seq1 p1 p2	`thenP` (\as -> unitP (a:as) ))
-
diff --git a/utils/heap-view/README b/utils/heap-view/README
deleted file mode 100644
index db9503abc4d1..000000000000
--- a/utils/heap-view/README
+++ /dev/null
@@ -1,62 +0,0 @@
-@HpView.lhs@ is a very primitive heap profile viewer written in
-Haskell.  It feeds off the same files as hp2ps.  It needs a lot of
-tidying up and would be far more useful as a continuous display.
-(It's in this directory `cos there happens to be a heap profile here
-and I couldn't be bothered setting up a new directory, Makefile, etc.)
-
-@Graph.lhs@ is a continuous heap viewer that "parses" the output of
-the +RTS -Sstderr option.  Typical usage:
-
-   slife 1 r4 +RTS -Sstderr |& graph 2
-
-(You might also try 
-
-   cat data | graph 2
-
- to see it in action on some sample data.
-)
-
-Things to watch:
-
-  1) Scaling varies from column to column - consult the source.
-
-  2) The horizontal scale is not time - it is garbage collections.
-
-  3) The graph is of the (n+1)st column of the -Sstderr output. 
-
-     The data is not always incredibly useful: For example, when using
-     the (default) Appel 2-space garbage collector, the 3rd column
-     displays the amount of "live" data in the minor space.  A program
-     with a constant data usage will appear to have a sawtooth usage
-     as minor data gradually transfers to the major space and then,
-     suddenly, all gets transferred back at major collections.
-     Decreasing heap size decreases the size of the minor collections
-     and increases major collections exaggerating the sawtooth.
-
-  4) The program is not as robust as it might be.
-
-
-@HpView2.lhs@ is the result of a casual coupling of @Graph.lhs@ and
-@HpView.lhs@ which draws continuous graphs of the heap consisting of:
-total usage and usage by one particular cost centre.  For example:
-
-    mkfifo slife.hp
-    hpView2 slife.hp Main:mkQuad &
-    slife 2 Unis/gardenofeden +RTS -h -i0.1 -RTS 
-    rm slife.hp
-
-draws a graph of total usage and usage by the function @mkQuad@.  
-
-(You might also try 
-
-	hpView2 slife.old-hp Main:mkQuad
-
- to see it in action on some older data)
-
-The business with named pipes (mkfifo) is a little unfortunate - it
-would be nicer if the Haskell runtime system could output to stderr
-(say) which I could pipe into hpView which could just graph it's stdin
-(like graph does).  It's probably worth wrapping the whole thing up in
-a little shell-script.
-
-
diff --git a/utils/heap-view/common-bits b/utils/heap-view/common-bits
deleted file mode 100644
index f41223b7f430..000000000000
--- a/utils/heap-view/common-bits
+++ /dev/null
@@ -1,35 +0,0 @@
- -----------------------------------------------------------------------------
-
- xInitialise :: [String] -> Int -> Int -> IO ()
- xInitialise str x y = 
-	 _ccall_ haskXBegin x y (0::Int)	`seqPrimIO`
-	 return ()
-
- xHandleEvent :: IO ()
- xHandleEvent = 
-	 _ccall_ haskHandleEvent		`thenPrimIO` \ n ->
-	 case (n::Int) of
-		 0 -> return ()
-		 _ -> error "Unknown Message back from Handle Event"
-
- xClose :: IO ()
- xClose =
-	  _ccall_ haskXClose		`seqPrimIO`
-	  return ()
-
- xCls :: IO ()
- xCls = 
-	 _ccall_ haskXCls		`seqPrimIO`
-	 return ()
-
- xDrawLine :: Int -> Int -> Int -> Int -> IO ()
- xDrawLine x1 y1 x2 y2 =
-	 _ccall_ haskXDraw x1 y1 x2 y2	`seqPrimIO`
-	 return ()
-
- ----------------------------------------------------------------
-
- usleep :: Int -> IO ()
- usleep t =
-	 _ccall_ usleep t		`seqPrimIO`
-	 return ()
diff --git a/utils/hp2ps/HpFile.c b/utils/hp2ps/HpFile.c
index 86cbfb20490a..9459247a0341 100644
--- a/utils/hp2ps/HpFile.c
+++ b/utils/hp2ps/HpFile.c
@@ -227,7 +227,7 @@ GetHpLine(FILE *infp)
 	    Error("%s, line %d: integer must follow identifier", hpfile, 
                   linenum);
 	}
-        StoreSample(GetEntry(theident), nsamples, (floatish) theinteger);
+        StoreSample(GetEntry(theident), nsamples, thefloatish);
 	GetHpTok(infp); 
         break;
 
@@ -332,7 +332,7 @@ GetHpTok(FILE *infp)
  *	"thefloatish").
  */
 
-static char numberstring[ NUMBER_LENGTH - 1 ];
+static char numberstring[ NUMBER_LENGTH + 1 ];
 
 token
 GetNumber(FILE *infp)
@@ -350,7 +350,7 @@ GetNumber(FILE *infp)
         ch = getc(infp);
     }   
  
-    ASSERT(i < NUMBER_LENGTH); /* did not overflow */
+    ASSERT(i <= NUMBER_LENGTH); /* did not overflow */
 
     numberstring[ i ] = '\0';
  
@@ -358,8 +358,13 @@ GetNumber(FILE *infp)
         thefloatish = (floatish) atof(numberstring);
 	return FLOAT_TOK;
     } else {
-	theinteger = atoi(numberstring);
-	return INTEGER_TOK;
+        theinteger = atoi(numberstring);
+        /* Set thefloatish too.
+           If this is an identifier line, the value might exceed
+           the size of 'int', and we are going to convert it to
+           a floatish anyways. */
+        thefloatish = (floatish) atof(numberstring);
+        return INTEGER_TOK;
     }
 }
 
@@ -423,6 +428,8 @@ GetString(FILE *infp)
     stringbuffer[i] = '\0'; 
     thestring = copystring(stringbuffer);
 
+    free(stringbuffer);
+
     ASSERT(ch == '\"');
 
     ch = getc(infp);      /* skip the '\"' that terminates the string */
diff --git a/utils/hpc/ghc.mk b/utils/hpc/ghc.mk
index 728072967558..f70be9459956 100644
--- a/utils/hpc/ghc.mk
+++ b/utils/hpc/ghc.mk
@@ -15,4 +15,7 @@ utils/hpc_PACKAGE                      = hpc-bin
 utils/hpc_dist-install_INSTALL         = YES
 utils/hpc_dist-install_INSTALL_INPLACE = YES
 utils/hpc_dist-install_PROGNAME        = hpc
+utils/hpc_dist-install_SHELL_WRAPPER   = YES
+utils/hpc_dist-install_INSTALL_SHELL_WRAPPER_NAME = hpc
+
 $(eval $(call build-prog,utils/hpc,dist-install,1))
diff --git a/utils/hpc/hpc-bin.cabal b/utils/hpc/hpc-bin.cabal
index 4f94ab0fa02d..8ec6e5b7904e 100644
--- a/utils/hpc/hpc-bin.cabal
+++ b/utils/hpc/hpc-bin.cabal
@@ -11,7 +11,7 @@ Description:
 	XXX
 Category: Development
 build-type: Simple
-cabal-version: >=1.2
+cabal-version: >=1.10
 
 Flag base4
     Description: Choose the even newer, even smaller, split-up base package.
@@ -20,6 +20,7 @@ Flag base3
     Description: Choose the new smaller, split-up base package.
 
 Executable hpc
+    Default-Language: Haskell2010
     Main-Is: Hpc.hs
     Other-Modules: HpcParser
                    HpcCombine
@@ -45,5 +46,4 @@ Executable hpc
                        containers >= 0.1 && < 0.6,
                        array      >= 0.1 && < 0.6
     Build-Depends: hpc
-    Extensions: CPP
 
diff --git a/utils/hpc/hpc.wrapper b/utils/hpc/hpc.wrapper
new file mode 100644
index 000000000000..22982ef0f840
--- /dev/null
+++ b/utils/hpc/hpc.wrapper
@@ -0,0 +1,2 @@
+#!/bin/sh
+exec "$executablename" ${1+"$@"}
diff --git a/utils/hsc2hs b/utils/hsc2hs
new file mode 160000
index 000000000000..4a0f67704d89
--- /dev/null
+++ b/utils/hsc2hs
@@ -0,0 +1 @@
+Subproject commit 4a0f67704d89712f8493a0c7eccffa9243d6ef09
diff --git a/utils/mkUserGuidePart/mkUserGuidePart.cabal b/utils/mkUserGuidePart/mkUserGuidePart.cabal
index 3cadaacd4765..112bbf6a8173 100644
--- a/utils/mkUserGuidePart/mkUserGuidePart.cabal
+++ b/utils/mkUserGuidePart/mkUserGuidePart.cabal
@@ -9,9 +9,10 @@ Synopsis: XXX
 Description:
 	XXX
 build-type: Simple
-cabal-version: >=1.2
+cabal-version: >=1.10
 
 Executable mkUserGuidePart
+    Default-Language: Haskell2010
     Main-Is: Main.hs
     Build-Depends: base       >= 3   && < 5,
                    ghc
diff --git a/utils/pvm/README b/utils/pvm/README
deleted file mode 100644
index 5ab58ddec80d..000000000000
--- a/utils/pvm/README
+++ /dev/null
@@ -1,4 +0,0 @@
-"debugger2" is our hacked version of the one that
-comes with PVM 3.3.7.
-
-Less sure about "debugger.emacs"...
diff --git a/utils/pvm/debugger.emacs b/utils/pvm/debugger.emacs
deleted file mode 100644
index ee053ca7b4e7..000000000000
--- a/utils/pvm/debugger.emacs
+++ /dev/null
@@ -1,37 +0,0 @@
-#!/bin/csh -f
-#
-#	debugger.csh
-#
-#	this script is invoked by the pvmd when a task is spawned with
-#	the PvmTaskDebug flag set.  it execs an xterm with script
-#	debugger2 running inside.
-#
-#	06 Apr 1993  Manchek
-#
-
-if ($#argv < 1) then
-	echo "usage: debugger command [args]"
-	exit 1
-endif
-
-# scratch file for debugger commands
-
-set TEMPCMD=gdb$$.cmd
-set TEMPLISP=gdb$$.el
-
-# default debugger and flags
-
-#
-# run the debugger
-#
-
-echo run $argv[2-] > $TEMPCMD
-echo "(gdb "'"'"$argv[1] -q -x $TEMPCMD"'")' > $TEMPLISP
-
-emacs -l $TEMPLISP
-
-#rm -f $TEMPCMD $TEMPLISP
-
-exit 0
-
-
diff --git a/utils/pvm/debugger2 b/utils/pvm/debugger2
deleted file mode 100644
index 7cdf8b9a1aac..000000000000
--- a/utils/pvm/debugger2
+++ /dev/null
@@ -1,48 +0,0 @@
-#!/bin/csh -f
-#
-#	debugger2.csh
-#
-#	this script is invoked in an xterm by the generic debugger script.
-#	it starts the debugger and waits when it exits to prevent the
-#	window from closing.
-#
-#	it expects the pvmd to set envar PVM_ARCH.
-#
-#	06 Apr 1993  Manchek
-#
-
-set noglob
-
-# scratch file for debugger commands
-
-set TEMPCMD=/tmp/debugger2.$$
-
-# default debugger and flags
-
-set DBCMD="gdb"
-set DBFF="-q -x $TEMPCMD"
-
-#
-# try to pick the debugger by arch name
-#
-
-#
-# run the debugger
-#
-
-echo run $argv[2-] > $TEMPCMD
-$DBCMD $DBFF $argv[1]
-
-#$DBCMD $argv[1]
-
-#rm -f $TEMPCMD
-
-#
-# wait to go away
-#
-
-#reset
-#sleep 1
-rm -f $TEMPCMD
-exit 0
-
diff --git a/utils/runghc/runghc.cabal.in b/utils/runghc/runghc.cabal.in
index f9cbacca5411..fde6b9a4d6e6 100644
--- a/utils/runghc/runghc.cabal.in
+++ b/utils/runghc/runghc.cabal.in
@@ -10,12 +10,13 @@ Description:
 	XXX
 Category: Development
 build-type: Simple
-cabal-version: >=1.2
+cabal-version: >=1.10
 
 Flag base3
     Description: Choose the new smaller, split-up base package.
 
 Executable runghc
+    Default-Language: Haskell2010
     Main-Is: runghc.hs
 
     if flag(base3)
diff --git a/utils/runghc/runghc.hs b/utils/runghc/runghc.hs
index 5280cb3344d2..47a6bc57d57b 100644
--- a/utils/runghc/runghc.hs
+++ b/utils/runghc/runghc.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE CPP, ForeignFunctionInterface #-}
+{-# LANGUAGE CPP #-}
 #include "ghcconfig.h"
 -----------------------------------------------------------------------------
 --
diff --git a/utils/vagrant/bootstrap-deb.sh b/utils/vagrant/bootstrap-deb.sh
new file mode 100755
index 000000000000..b9ba957b4a40
--- /dev/null
+++ b/utils/vagrant/bootstrap-deb.sh
@@ -0,0 +1,3 @@
+#!/bin/sh
+apt-get update
+apt-get build-dep -y ghc
diff --git a/utils/vagrant/bootstrap-rhel.sh b/utils/vagrant/bootstrap-rhel.sh
new file mode 100755
index 000000000000..5086279dc6ee
--- /dev/null
+++ b/utils/vagrant/bootstrap-rhel.sh
@@ -0,0 +1,4 @@
+#!/bin/sh
+yum update -y
+yum install -y glibc-devel ncurses-devel gmp-devel autoconf automake libtool \
+ gcc make perl python ghc git docbook-utils docbook-utils-pdf docbook-style-xsl
diff --git a/validate b/validate
index 889c0e83a907..7a7b1256a5c3 100755
--- a/validate
+++ b/validate
@@ -22,9 +22,7 @@ Flags:
   --fast            Omit dyn way, omit binary distribution
   --slow            Build stage2 with -DDEBUG.
                     2008-07-01: 14% slower than the default.
-  --no-dph:         Skip requiring libraries/dph. In --slow mode, these tests
-                    can take a substantial amount of time, and on some platforms
-                    with broken linkers, we don't want to try compiling it.
+  --dph:            Also build libraries/dph and run associated tests.
   --help            shows this usage help.
 
   Set environment variable 'CPUS' to number of cores, to exploit
@@ -39,7 +37,7 @@ no_clean=0
 testsuite_only=0
 hpc=NO
 speed=NORMAL
-skip_dph=0
+use_dph=0
 
 while [ $# -gt 0 ]
 do
@@ -62,8 +60,11 @@ do
     --normal)
         speed=NORMAL
         ;;
-    --no-dph)
-        skip_dph=1
+    --no-dph) # for backward compat
+        use_dph=0
+        ;;
+    --dph)
+        use_dph=1
         ;;
     --help)
         show_help
@@ -121,10 +122,10 @@ if [ $no_clean -eq 0 ]; then
         INSTDIR=`cygpath -m "$INSTDIR"`
     fi
 
-    if [ $skip_dph -eq 1 ]; then
-        /usr/bin/perl -w boot --validate
-    else
+    if [ $use_dph -eq 1 ]; then
         /usr/bin/perl -w boot --validate --required-tag=dph
+    else
+        /usr/bin/perl -w boot --validate
     fi
     ./configure --prefix="$INSTDIR" $config_args
 fi
@@ -135,6 +136,12 @@ echo "Validating=YES"       >  mk/are-validating.mk
 echo "ValidateSpeed=$speed" >> mk/are-validating.mk
 echo "ValidateHpc=$hpc"     >> mk/are-validating.mk
 
+if [ $use_dph -eq 1 ]; then
+    echo "BUILD_DPH=YES"    >> mk/are-validating.mk
+else
+    echo "BUILD_DPH=NO"     >> mk/are-validating.mk
+fi
+
 $make -j$threads
 # For a "debug make", add "--debug=b --debug=m"