Merge branch 'ghc-7.8' of https://github.com/ghc/ghc into ghc-7.8

66 files changed, 1112 insertions, 322 deletions

diff --git a/Makefile b/Makefile
index 6872cb329d..4145d97687 100644
--- a/Makefile
+++ b/Makefile
@@ -44,6 +44,13 @@ endif
 
 include mk/custom-settings.mk
 
+# Verify that stage 0 LLVM backend isn't affected by Bug #9439 if needed
+ifeq "$(GHC_LLVM_AFFECTED_BY_9439)" "1"
+ifneq "$(findstring -fllvm,$(GhcHcOpts) $(GhcStage1HcOpts))" ""
+$(error Stage 0 compiler is affected by Bug #9439. Refusing to bootstrap with -fllvm)
+endif
+endif
+
 # No need to update makefiles for these targets:
 REALGOALS=$(filter-out binary-dist binary-dist-prep bootstrapping-files framework-pkg clean clean_% distclean maintainer-clean show echo help test fulltest,$(MAKECMDGOALS))
 
diff --git a/aclocal.m4 b/aclocal.m4
index 7224cd5b3b..4916212c8f 100644
--- a/aclocal.m4
+++ b/aclocal.m4
@@ -470,18 +470,18 @@ AC_DEFUN([FP_SETTINGS],
         SettingsWindresCommand="/bin/false"
         SettingsLibtoolCommand="libtool"
         SettingsTouchCommand='touch'
-        if test -z "$LlcCmd"
-        then
-          SettingsLlcCommand="llc"
-        else
-          SettingsLlcCommand="$LlcCmd"
-        fi
-        if test -z "$OptCmd"
-        then
-          SettingsOptCommand="opt"
-        else
-          SettingsOptCommand="$OptCmd"
-        fi
+    fi
+    if test -z "$LlcCmd"
+    then
+      SettingsLlcCommand="llc"
+    else
+      SettingsLlcCommand="$LlcCmd"
+    fi
+    if test -z "$OptCmd"
+    then
+      SettingsOptCommand="opt"
+    else
+      SettingsOptCommand="$OptCmd"
     fi
     SettingsCCompilerFlags="$CONF_CC_OPTS_STAGE2"
     SettingsCCompilerLinkFlags="$CONF_GCC_LINKER_OPTS_STAGE2"
diff --git a/compiler/basicTypes/PatSyn.lhs b/compiler/basicTypes/PatSyn.lhs
index 32908f6c6d..aa5a86aa13 100644
--- a/compiler/basicTypes/PatSyn.lhs
+++ b/compiler/basicTypes/PatSyn.lhs
@@ -16,7 +16,7 @@ module PatSyn (
         patSynWrapper, patSynMatcher,
         patSynExTyVars, patSynSig,
         patSynInstArgTys, patSynInstResTy,
-        tidyPatSynIds, patSynIds
+        tidyPatSynIds
     ) where
 
 #include "HsVersions.h"
@@ -266,12 +266,6 @@ 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 }
diff --git a/compiler/cmm/CLabel.hs b/compiler/cmm/CLabel.hs
index 65c597cb69..991fc57b17 100644
--- a/compiler/cmm/CLabel.hs
+++ b/compiler/cmm/CLabel.hs
@@ -801,6 +801,7 @@ labelType (CmmLabel _ _ CmmClosure)             = GcPtrLabel
 labelType (CmmLabel _ _ CmmCode)                = CodeLabel
 labelType (CmmLabel _ _ CmmInfo)                = DataLabel
 labelType (CmmLabel _ _ CmmEntry)               = CodeLabel
+labelType (CmmLabel _ _ CmmPrimCall)            = CodeLabel
 labelType (CmmLabel _ _ CmmRetInfo)             = DataLabel
 labelType (CmmLabel _ _ CmmRet)                 = CodeLabel
 labelType (RtsLabel (RtsSelectorInfoTable _ _)) = DataLabel
diff --git a/compiler/cmm/PprC.hs b/compiler/cmm/PprC.hs
index 23989811dd..e957f3e691 100644
--- a/compiler/cmm/PprC.hs
+++ b/compiler/cmm/PprC.hs
@@ -1214,8 +1214,9 @@ commafy xs = hsep $ punctuate comma xs
 pprHexVal :: Integer -> Width -> SDoc
 pprHexVal 0 _ = ptext (sLit "0x0")
 pprHexVal w rep
-  | w < 0     = parens (char '-' <> ptext (sLit "0x") <> go (-w) <> repsuffix rep)
-  | otherwise = ptext (sLit "0x") <> go w <> repsuffix rep
+  | w < 0     = parens (char '-' <>
+                    ptext (sLit "0x") <> intToDoc (-w) <> repsuffix rep)
+  | otherwise =     ptext (sLit "0x") <> intToDoc   w  <> repsuffix rep
   where
         -- type suffix for literals:
         -- Integer literals are unsigned in Cmm/C.  We explicitly cast to
@@ -1230,10 +1231,33 @@ pprHexVal w rep
           else panic "pprHexVal: Can't find a 64-bit type"
       repsuffix _ = char 'U'
 
+      intToDoc :: Integer -> SDoc
+      intToDoc i = go (truncInt i)
+
+      -- We need to truncate value as Cmm backend does not drop
+      -- redundant bits to ease handling of negative values.
+      -- Thus the following Cmm code on 64-bit arch, like amd64:
+      --     CInt v;
+      --     v = {something};
+      --     if (v == %lobits32(-1)) { ...
+      -- leads to the following C code:
+      --     StgWord64 v = (StgWord32)({something});
+      --     if (v == 0xFFFFffffFFFFffffU) { ...
+      -- Such code is incorrect as it promotes both operands to StgWord64
+      -- and the whole condition is always false.
+      truncInt :: Integer -> Integer
+      truncInt i =
+          case rep of
+              W8  -> i `rem` (2^(8 :: Int))
+              W16 -> i `rem` (2^(16 :: Int))
+              W32 -> i `rem` (2^(32 :: Int))
+              W64 -> i `rem` (2^(64 :: Int))
+              _   -> panic ("pprHexVal/truncInt: C backend can't encode "
+                            ++ show rep ++ " literals")
+
       go 0 = empty
       go w' = go q <> dig
            where
              (q,r) = w' `quotRem` 16
              dig | r < 10    = char (chr (fromInteger r + ord '0'))
                  | otherwise = char (chr (fromInteger r - 10 + ord 'a'))
-
diff --git a/compiler/coreSyn/CoreLint.lhs b/compiler/coreSyn/CoreLint.lhs
index 8665ec4111..2689900549 100644
--- a/compiler/coreSyn/CoreLint.lhs
+++ b/compiler/coreSyn/CoreLint.lhs
@@ -727,13 +727,20 @@ lintType ty@(FunTy t1 t2)    -- (->) has two different rules, for types and kind
        ; lintArrow (ptext (sLit "type or kind") <+> quotes (ppr ty)) k1 k2 }
 
 lintType ty@(TyConApp tc tys)
-  | not (isUnLiftedTyCon tc) || tys `lengthIs` tyConArity tc
-       -- Check that primitive types are saturated
+  | Just ty' <- coreView ty
+  = lintType ty'   -- Expand type synonyms, so that we do not bogusly complain
+                   --  about un-saturated type synonyms
+                   -- 
+
+  | isUnLiftedTyCon tc || isSynTyCon tc
        -- See Note [The kind invariant] in TypeRep
+       -- Also type synonyms and type families
+  , length tys < tyConArity tc
+  = failWithL (hang (ptext (sLit "Un-saturated type application")) 2 (ppr ty))
+
+  | otherwise
   = do { ks <- mapM lintType tys
        ; lint_ty_app ty (tyConKind tc) (tys `zip` ks) }
-  | otherwise
-  = failWithL (hang (ptext (sLit "Malformed type:")) 2 (ppr ty))
 
 lintType (ForAllTy tv ty)
   = do { lintTyBndrKind tv
diff --git a/compiler/deSugar/DsArrows.lhs b/compiler/deSugar/DsArrows.lhs
index f87877681c..0ea18d11fb 100644
--- a/compiler/deSugar/DsArrows.lhs
+++ b/compiler/deSugar/DsArrows.lhs
@@ -465,8 +465,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
diff --git a/compiler/deSugar/DsCCall.lhs b/compiler/deSugar/DsCCall.lhs
index f3f0adc668..69735f1531 100644
--- a/compiler/deSugar/DsCCall.lhs
+++ b/compiler/deSugar/DsCCall.lhs
@@ -236,9 +236,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 a9b7003788..5d8f34bf07 100644
--- a/compiler/deSugar/DsExpr.lhs
+++ b/compiler/deSugar/DsExpr.lhs
@@ -290,9 +290,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 +433,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:
diff --git a/compiler/deSugar/DsMeta.hs b/compiler/deSugar/DsMeta.hs
index 65bb935825..85143252f9 100644
--- a/compiler/deSugar/DsMeta.hs
+++ b/compiler/deSugar/DsMeta.hs
@@ -1490,7 +1490,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 []
diff --git a/compiler/deSugar/MatchLit.lhs b/compiler/deSugar/MatchLit.lhs
index 9652bdf3ff..ff834e6925 100644
--- a/compiler/deSugar/MatchLit.lhs
+++ b/compiler/deSugar/MatchLit.lhs
@@ -90,7 +90,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
diff --git a/compiler/ghc.mk b/compiler/ghc.mk
index 389543f387..58b5ab3f4f 100644
--- a/compiler/ghc.mk
+++ b/compiler/ghc.mk
@@ -461,36 +461,15 @@ compiler_stage2_dll0_MODULES = \
 	BasicTypes \
 	BinIface \
 	Binary \
-	Bitmap \
-	BlockId \
 	BooleanFormula \
 	BreakArray \
 	BufWrite \
 	BuildTyCl \
-	ByteCodeAsm \
-	ByteCodeInstr \
-	ByteCodeItbls \
-	CLabel \
 	Class \
 	CmdLineParser \
-	Cmm \
-	CmmCallConv \
-	CmmExpr \
-	CmmInfo \
-	CmmMachOp \
-	CmmNode \
 	CmmType \
-	CmmUtils \
 	CoAxiom \
 	ConLike \
-	CodeGen.Platform \
-	CodeGen.Platform.ARM \
-	CodeGen.Platform.NoRegs \
-	CodeGen.Platform.PPC \
-	CodeGen.Platform.PPC_Darwin \
-	CodeGen.Platform.SPARC \
-	CodeGen.Platform.X86 \
-	CodeGen.Platform.X86_64 \
 	Coercion \
 	Config \
 	Constants \
@@ -514,7 +493,6 @@ compiler_stage2_dll0_MODULES = \
 	Exception \
 	ExtsCompat46 \
 	FamInstEnv \
-	FastBool \
 	FastFunctions \
 	FastMutInt \
 	FastString \
@@ -524,8 +502,6 @@ compiler_stage2_dll0_MODULES = \
 	FiniteMap \
 	ForeignCall \
 	Hooks \
-	Hoopl \
-	Hoopl.Dataflow \
 	HsBinds \
 	HsDecls \
 	HsDoc \
@@ -544,14 +520,12 @@ compiler_stage2_dll0_MODULES = \
 	IfaceSyn \
 	IfaceType \
 	InstEnv \
-	InteractiveEvalTypes \
 	Kind \
 	ListSetOps \
 	Literal \
 	LoadIface \
 	Maybes \
 	MkCore \
-	MkGraph \
 	MkId \
 	Module \
 	MonadUtils \
@@ -571,9 +545,6 @@ compiler_stage2_dll0_MODULES = \
 	PipelineMonad \
 	Platform \
 	PlatformConstants \
-	PprCmm \
-	PprCmmDecl \
-	PprCmmExpr \
 	PprCore \
 	PrelInfo \
 	PrelNames \
@@ -581,23 +552,10 @@ compiler_stage2_dll0_MODULES = \
 	Pretty \
 	PrimOp \
 	RdrName \
-	Reg \
-	RegClass \
 	Rules \
-	SMRep \
 	Serialized \
 	SrcLoc \
 	StaticFlags \
-	StgCmmArgRep \
-	StgCmmClosure \
-	StgCmmEnv \
-	StgCmmLayout \
-	StgCmmMonad \
-	StgCmmProf \
-	StgCmmTicky \
-	StgCmmUtils \
-	StgSyn \
-	Stream \
 	StringBuffer \
 	TcEvidence \
 	TcIface \
@@ -621,6 +579,54 @@ compiler_stage2_dll0_MODULES = \
 	VarEnv \
 	VarSet
 
+ifeq "$(GhcWithInterpreter)" "YES"
+# These files are reacheable from DynFlags
+# only by GHCi-enabled code (see #9552)
+compiler_stage2_dll0_MODULES += \
+	Bitmap \
+	BlockId \
+	ByteCodeAsm \
+	ByteCodeInstr \
+	ByteCodeItbls \
+	CLabel \
+	Cmm \
+	CmmCallConv \
+	CmmExpr \
+	CmmInfo \
+	CmmMachOp \
+	CmmNode \
+	CmmUtils \
+	CodeGen.Platform \
+	CodeGen.Platform.ARM \
+	CodeGen.Platform.NoRegs \
+	CodeGen.Platform.PPC \
+	CodeGen.Platform.PPC_Darwin \
+	CodeGen.Platform.SPARC \
+	CodeGen.Platform.X86 \
+	CodeGen.Platform.X86_64 \
+	FastBool \
+	Hoopl \
+	Hoopl.Dataflow \
+	InteractiveEvalTypes \
+	MkGraph \
+	PprCmm \
+	PprCmmDecl \
+	PprCmmExpr \
+	Reg \
+	RegClass \
+	SMRep \
+	StgCmmArgRep \
+	StgCmmClosure \
+	StgCmmEnv \
+	StgCmmLayout \
+	StgCmmMonad \
+	StgCmmProf \
+	StgCmmTicky \
+	StgCmmUtils \
+	StgSyn \
+	Stream
+endif
+
 compiler_stage2_dll0_HS_OBJS = \
     $(patsubst %,compiler/stage2/build/%.$(dyn_osuf),$(subst .,/,$(compiler_stage2_dll0_MODULES)))
 
diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs
index d2d2bc0bab..745199e1de 100644
--- a/compiler/main/DriverPipeline.hs
+++ b/compiler/main/DriverPipeline.hs
@@ -1208,6 +1208,7 @@ runPhase (RealPhase (As with_cpp)) input_fn dflags
 
         as_prog <- whichAsProg
         let cmdline_include_paths = includePaths dflags
+        let pic_c_flags = picCCOpts dflags
 
         next_phase <- maybeMergeStub
         output_fn <- phaseOutputFilename next_phase
@@ -1221,6 +1222,9 @@ runPhase (RealPhase (As with_cpp)) input_fn dflags
                 = liftIO $ as_prog dflags
                        ([ SysTools.Option ("-I" ++ p) | p <- cmdline_include_paths ]
 
+                       -- See Note [-fPIC for assembler]
+                       ++ map SysTools.Option pic_c_flags
+
         -- We only support SparcV9 and better because V8 lacks an atomic CAS
         -- instruction so we have to make sure that the assembler accepts the
         -- instruction set. Note that the user can still override this
@@ -1262,6 +1266,8 @@ runPhase (RealPhase SplitAs) _input_fn dflags
             osuf = objectSuf dflags
             split_odir  = base_o ++ "_" ++ osuf ++ "_split"
 
+        let pic_c_flags = picCCOpts dflags
+
         -- this also creates the hierarchy
         liftIO $ createDirectoryIfMissing True split_odir
 
@@ -1295,6 +1301,9 @@ runPhase (RealPhase SplitAs) _input_fn dflags
                            then [SysTools.Option "-mcpu=v9"]
                            else []) ++
 
+                          -- See Note [-fPIC for assembler]
+                          map SysTools.Option pic_c_flags ++
+
                           [ SysTools.Option "-c"
                           , SysTools.Option "-o"
                           , SysTools.FileOption "" (split_obj n)
@@ -2210,3 +2219,38 @@ haveRtsOptsFlags dflags =
          isJust (rtsOpts dflags) || case rtsOptsEnabled dflags of
                                         RtsOptsSafeOnly -> False
                                         _ -> True
+
+-- Note [-fPIC for assembler]
+-- When compiling .c source file GHC's driver pipeline basically
+-- does the following two things:
+--   1. ${CC}              -S 'PIC_CFLAGS' source.c
+--   2. ${CC} -x assembler -c 'PIC_CFLAGS' source.S
+--
+-- Why do we need to pass 'PIC_CFLAGS' both to C compiler and assembler?
+-- Because on some architectures (at least sparc32) assembler also choses
+-- relocation type!
+-- Consider the following C module:
+--
+--     /* pic-sample.c */
+--     int v;
+--     void set_v (int n) { v = n; }
+--     int  get_v (void)  { return v; }
+--
+--     $ gcc -S -fPIC pic-sample.c
+--     $ gcc -c       pic-sample.s -o pic-sample.no-pic.o # incorrect binary
+--     $ gcc -c -fPIC pic-sample.s -o pic-sample.pic.o    # correct binary
+--
+--     $ objdump -r -d pic-sample.pic.o    > pic-sample.pic.o.od
+--     $ objdump -r -d pic-sample.no-pic.o > pic-sample.no-pic.o.od
+--     $ diff -u pic-sample.pic.o.od pic-sample.no-pic.o.od
+--
+-- Most of architectures won't show any difference in this test, but on sparc32
+-- the following assembly snippet:
+--
+--    sethi   %hi(_GLOBAL_OFFSET_TABLE_-8), %l7
+--
+-- generates two kinds or relocations, only 'R_SPARC_PC22' is correct:
+--
+--       3c:  2f 00 00 00     sethi  %hi(0), %l7
+--    -                       3c: R_SPARC_PC22        _GLOBAL_OFFSET_TABLE_-0x8
+--    +                       3c: R_SPARC_HI22        _GLOBAL_OFFSET_TABLE_-0x8
diff --git a/compiler/main/SysTools.lhs b/compiler/main/SysTools.lhs
index 2945911ca2..8c02cc4033 100644
--- a/compiler/main/SysTools.lhs
+++ b/compiler/main/SysTools.lhs
@@ -490,6 +490,51 @@ readCreateProcess proc = do
 
     return (ex, output)
 
+readProcessEnvWithExitCode
+    :: String -- ^ program path
+    -> [String] -- ^ program args
+    -> [(String, String)] -- ^ environment to override
+    -> IO (ExitCode, String, String) -- ^ (exit_code, stdout, stderr)
+readProcessEnvWithExitCode prog args env_update = do
+    current_env <- getEnvironment
+    let new_env = env_update ++ [ (k, v)
+                                | let overriden_keys = map fst env_update
+                                , (k, v) <- current_env
+                                , k `notElem` overriden_keys
+                                ]
+        p       = proc prog args
+
+    (_stdin, Just stdoh, Just stdeh, pid) <-
+        createProcess p{ std_out = CreatePipe
+                       , std_err = CreatePipe
+                       , env     = Just new_env
+                       }
+
+    outMVar <- newEmptyMVar
+    errMVar <- newEmptyMVar
+
+    _ <- forkIO $ do
+        stdo <- hGetContents stdoh
+        _ <- evaluate (length stdo)
+        putMVar outMVar stdo
+
+    _ <- forkIO $ do
+        stde <- hGetContents stdeh
+        _ <- evaluate (length stde)
+        putMVar errMVar stde
+
+    out <- takeMVar outMVar
+    hClose stdoh
+    err <- takeMVar errMVar
+    hClose stdeh
+
+    ex <- waitForProcess pid
+
+    return (ex, out, err)
+
+-- Don't let gcc localize version info string, #8825
+en_locale_env :: [(String, String)]
+en_locale_env = [("LANGUAGE", "en")]
 
 -- If the -B<dir> option is set, add <dir> to PATH.  This works around
 -- a bug in gcc on Windows Vista where it can't find its auxiliary
@@ -694,7 +739,10 @@ getLinkerInfo' :: DynFlags -> IO LinkerInfo
 getLinkerInfo' dflags = do
   let platform = targetPlatform dflags
       os = platformOS platform
-      (pgm,_) = pgm_l dflags
+      (pgm,args0) = pgm_l dflags
+      args1     = map Option (getOpts dflags opt_l)
+      args2     = args0 ++ args1
+      args3     = filter notNull (map showOpt args2)
 
       -- Try to grab the info from the process output.
       parseLinkerInfo stdo _stde _exitc
@@ -744,8 +792,9 @@ getLinkerInfo' dflags = do
                _ -> do
                  -- In practice, we use the compiler as the linker here. Pass
                  -- -Wl,--version to get linker version info.
-                 (exitc, stdo, stde) <- readProcessWithExitCode pgm
-                                        ["-Wl,--version"] ""
+                 (exitc, stdo, stde) <- readProcessEnvWithExitCode pgm
+                                        (["-Wl,--version"] ++ args3)
+                                        en_locale_env
                  -- Split the output by lines to make certain kinds
                  -- of processing easier. In particular, 'clang' and 'gcc'
                  -- have slightly different outputs for '-Wl,--version', but
@@ -800,7 +849,8 @@ getCompilerInfo' dflags = do
 
   -- Process the executable call
   info <- catchIO (do
-                (exitc, stdo, stde) <- readProcessWithExitCode pgm ["-v"] ""
+                (exitc, stdo, stde) <-
+                    readProcessEnvWithExitCode pgm ["-v"] en_locale_env
                 -- Split the output by lines to make certain kinds
                 -- of processing easier.
                 parseCompilerInfo (lines stdo) (lines stde) exitc
@@ -900,7 +950,8 @@ readElfSection _dflags section exe = do
      prog = "readelf"
      args = [Option "-p", Option section, FileOption "" exe]
   --
-  r <- readProcessWithExitCode prog (filter notNull (map showOpt args)) ""
+  r <- readProcessEnvWithExitCode prog (filter notNull (map showOpt args))
+                                  en_locale_env
   case r of
     (ExitSuccess, out, _err) -> return (doFilter (lines out))
     _ -> return Nothing
diff --git a/compiler/main/TidyPgm.lhs b/compiler/main/TidyPgm.lhs
index ef7661a016..5d2b6faa42 100644
--- a/compiler/main/TidyPgm.lhs
+++ b/compiler/main/TidyPgm.lhs
@@ -139,12 +139,12 @@ mkBootModDetailsTc hsc_env
         ; showPass dflags CoreTidy
 
         ; 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_env'  = extendTypeEnvWithIds type_env1 (pat_syn_ids ++ dfun_ids)
+              ; pat_syns'   = map (tidyPatSynIds   globaliseAndTidyId) pat_syns
+              ; type_env2  = extendTypeEnvWithPatSyns pat_syns' type_env1
+              ; dfun_ids    = map instanceDFunId insts'
+              ; type_env'  = extendTypeEnvWithIds type_env2 dfun_ids
               }
         ; return (ModDetails { md_types     = type_env'
                              , md_insts     = insts'
@@ -357,8 +357,7 @@ tidyProgram hsc_env  (ModGuts { mg_module    = mod
                 -- 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 ]
+              ; type_env2    = extendTypeEnvWithPatSyns tidy_patsyns type_env1
 
               ; tidy_type_env = tidyTypeEnv omit_prags type_env2
 
@@ -454,6 +453,10 @@ trimThing (AnId id)
 
 trimThing other_thing
   = other_thing
+
+extendTypeEnvWithPatSyns :: [PatSyn] -> TypeEnv -> TypeEnv
+extendTypeEnvWithPatSyns tidy_patsyns type_env
+  = extendTypeEnvList type_env [AConLike (PatSynCon ps) | ps <- tidy_patsyns ]
 \end{code}
 
 \begin{code}
diff --git a/compiler/nativeGen/X86/CodeGen.hs b/compiler/nativeGen/X86/CodeGen.hs
index 2456688744..8b7d0df509 100644
--- a/compiler/nativeGen/X86/CodeGen.hs
+++ b/compiler/nativeGen/X86/CodeGen.hs
@@ -1710,15 +1710,19 @@ genCCall is32Bit (PrimTarget (MO_PopCnt width)) dest_regs@[dst]
     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
diff --git a/compiler/rename/RnBinds.lhs b/compiler/rename/RnBinds.lhs
index 7251492ccf..3991e24938 100644
--- a/compiler/rename/RnBinds.lhs
+++ b/compiler/rename/RnBinds.lhs
@@ -698,6 +698,11 @@ rnMethodBind _ _ (L loc bind@(PatBind {})) = do
     addErrAt loc (methodBindErr bind)
     return (emptyBag, emptyFVs)
 
+-- Associated pattern synonyms are not implemented yet
+rnMethodBind _ _ (L loc bind@(PatSynBind {})) = do
+    addErrAt loc $ methodPatSynErr bind
+    return (emptyBag, emptyFVs)
+
 rnMethodBind _ _ b = pprPanic "rnMethodBind" (ppr b)
 \end{code}
 
@@ -1012,6 +1017,11 @@ methodBindErr mbind
  =  hang (ptext (sLit "Pattern bindings (except simple variables) not allowed in instance declarations"))
        2 (ppr mbind)
 
+methodPatSynErr :: HsBindLR RdrName RdrName -> SDoc
+methodPatSynErr mbind
+ =  hang (ptext (sLit "Pattern synonyms not allowed in instance declarations"))
+       2 (ppr mbind)
+
 bindsInHsBootFile :: LHsBindsLR Name RdrName -> SDoc
 bindsInHsBootFile mbinds
   = hang (ptext (sLit "Bindings in hs-boot files are not allowed"))
diff --git a/compiler/rename/RnNames.lhs b/compiler/rename/RnNames.lhs
index 2fb7d4fe4e..55997643dc 100644
--- a/compiler/rename/RnNames.lhs
+++ b/compiler/rename/RnNames.lhs
@@ -572,6 +572,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 +628,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 +651,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 +688,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 +724,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
diff --git a/compiler/specialise/SpecConstr.lhs b/compiler/specialise/SpecConstr.lhs
index 060c705cda..0b612ee888 100644
--- a/compiler/specialise/SpecConstr.lhs
+++ b/compiler/specialise/SpecConstr.lhs
@@ -33,6 +33,7 @@ import Rules
 import Type             hiding ( substTy )
 import TyCon            ( isRecursiveTyCon, tyConName )
 import Id
+import PprCore          ( pprParendExpr )
 import MkCore           ( mkImpossibleExpr )
 import Var
 import VarEnv
@@ -396,16 +397,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.
 
-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.
+(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.
 
 The actual seeding of the specialisation is very similar to Note [Local recursive group].
 
@@ -1014,15 +1018,27 @@ data ScUsage
      }                                  -- The domain is OutIds
 
 type CallEnv = IdEnv [Call]
-type Call = (ValueEnv, [CoreArg])
+data Call = Call Id [CoreArg] ValueEnv
         -- The arguments of the call, together with the
         -- env giving the constructor bindings at the call site
+        -- We keep the function mainly for debug output
+
+instance Outputable Call where
+  ppr (Call fn args _) = ppr fn <+> fsep (map pprParendExpr args)
 
 nullUsage :: ScUsage
 nullUsage = SCU { scu_calls = emptyVarEnv, scu_occs = emptyVarEnv }
 
 combineCalls :: CallEnv -> CallEnv -> CallEnv
 combineCalls = plusVarEnv_C (++)
+  where
+--    plus cs ds | length res > 1
+--               = pprTrace "combineCalls" (vcat [ ptext (sLit "cs:") <+> ppr cs
+--                                               , ptext (sLit "ds:") <+> ppr ds])
+--                 res
+--               | otherwise = res
+--       where
+--          res = cs ++ ds
 
 combineUsage :: ScUsage -> ScUsage -> ScUsage
 combineUsage u1 u2 = SCU { scu_calls = combineCalls (scu_calls u1) (scu_calls u2),
@@ -1193,7 +1209,7 @@ scExpr' env (Let (NonRec bndr rhs) body)
                                           (SI [] 0 (Just rhs_usg))
 
         ; return (body_usg { scu_calls = scu_calls body_usg `delVarEnv` bndr' }
-                    `combineUsage` rhs_usg `combineUsage` spec_usg,
+                    `combineUsage` spec_usg,  -- Note [spec_usg includes rhs_usg]
                   mkLets [NonRec b r | (b,r) <- specInfoBinds rhs_info specs] body')
         }
 
@@ -1217,8 +1233,7 @@ scExpr' env (Let (Rec prs) body)
                 -- Instead use them only if we find an unspecialised call
                 -- See Note [Local recursive groups]
 
-        ; let rhs_usg = combineUsages rhs_usgs
-              all_usg = spec_usg `combineUsage` rhs_usg `combineUsage` body_usg
+        ; let all_usg = spec_usg `combineUsage` body_usg  -- Note [spec_usg includes rhs_usg]
               bind'   = Rec (concat (zipWith specInfoBinds rhs_infos specs))
 
         ; return (all_usg { scu_calls = scu_calls all_usg `delVarEnvList` bndrs' },
@@ -1280,7 +1295,7 @@ scApp env (other_fn, args)
 mkVarUsage :: ScEnv -> Id -> [CoreExpr] -> ScUsage
 mkVarUsage env fn args
   = case lookupHowBound env fn of
-        Just RecFun -> SCU { scu_calls = unitVarEnv fn [(sc_vals env, args)]
+        Just RecFun -> SCU { scu_calls = unitVarEnv fn [Call fn args (sc_vals env)]
                            , scu_occs  = emptyVarEnv }
         Just RecArg -> SCU { scu_calls = emptyVarEnv
                            , scu_occs  = unitVarEnv fn arg_occ }
@@ -1314,37 +1329,36 @@ scTopBind _ usage _
   | pprTrace "scTopBind_usage" (ppr (scu_calls usage)) False
   = error "false"
 -}
- 
-scTopBind env usage (Rec prs)
+
+scTopBind env body_usage (Rec prs)
   | Just threshold <- sc_size env
   , not force_spec
   , not (all (couldBeSmallEnoughToInline (sc_dflags env) threshold) rhss)
                 -- No specialisation
   = do  { (rhs_usgs, rhss')   <- mapAndUnzipM (scExpr env) rhss
-        ; return (usage `combineUsage` (combineUsages rhs_usgs), Rec (bndrs `zip` rhss')) }
+        ; return (body_usage `combineUsage` combineUsages rhs_usgs, Rec (bndrs `zip` rhss')) }
+
   | otherwise   -- Do specialisation
-  = do  { (rhs_usgs, rhs_infos) <- mapAndUnzipM (scRecRhs env) (bndrs `zip` rhss)
-        -- ; pprTrace "scTopBind" (ppr bndrs $$ ppr (map (lookupVarEnv (scu_calls usage)) bndrs)) (return ())
+  = do  { (rhs_usgs, rhs_infos) <- mapAndUnzipM (scRecRhs env) prs
+        -- ; pprTrace "scTopBind" (ppr bndrs $$ ppr (map (lookupVarEnv (scu_calls body_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
+                         = ( body_usage,             [SI [] 0 (Just us) | us <- rhs_usgs] )
 
-        ; (usage', specs) <- specLoop (scForce env force_spec)
-                                 (scu_calls usg) rhs_infos nullUsage rest
+        ; (spec_usage, specs) <- specLoop (scForce env force_spec)
+                                          (scu_calls usg) rhs_infos nullUsage rest
 
-        ; return (usage `combineUsage` usage',
+        ; return (body_usage `combineUsage` spec_usage,
                   Rec (concat (zipWith specInfoBinds rhs_infos specs))) }
   where
     (bndrs,rhss) = unzip prs
     force_spec   = any (forceSpecBndr env) bndrs
       -- Note [Forcing specialisation]
 
-scTopBind env usage (NonRec bndr rhs)
+scTopBind env usage (NonRec bndr rhs)   -- Oddly, we don't seem to specialise top-level non-rec functions
   = do  { (rhs_usg', rhs') <- scExpr env rhs
         ; return (usage `combineUsage` rhs_usg', NonRec bndr rhs') }
 
@@ -1401,6 +1415,7 @@ data SpecInfo = SI [OneSpec]            -- The specialisations we have generated
                                         --             unleashed)
                                         -- Nothing => we have
                                         -- See Note [Local recursive groups]
+                                        -- See Note [spec_usg includes rhs_usg]
 
         -- One specialisation: Rule plus definition
 data OneSpec  = OS CallPat              -- Call pattern that generated this specialisation
@@ -1427,10 +1442,12 @@ specLoop env all_calls rhs_infos usg_so_far specs_so_far
 
 specialise
    :: ScEnv
-   -> CallEnv                           -- Info on calls
+   -> CallEnv                     -- Info on newly-discovered calls to this function
    -> RhsInfo
-   -> SpecInfo                          -- Original RHS plus patterns dealt with
-   -> UniqSM (ScUsage, SpecInfo)        -- New specialised versions and their usage
+   -> SpecInfo                    -- Original RHS plus patterns dealt with
+   -> UniqSM (ScUsage, SpecInfo)  -- New specialised versions and their usage
+
+-- See Note [spec_usg includes rhs_usg]
 
 -- Note: this only generates *specialised* bindings
 -- The original binding is added by specInfoBinds
@@ -1441,16 +1458,20 @@ specialise
 
 specialise env bind_calls (RI fn _ arg_bndrs body arg_occs)
                spec_info@(SI specs spec_count mb_unspec)
-  | not (isBottomingId fn)      -- Note [Do not specialise diverging functions]
-  , not (isNeverActive (idInlineActivation fn)) -- See Note [Transfer activation]
-  , 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 ()
+  | isBottomingId fn      -- Note [Do not specialise diverging functions]
+                          -- and do not generate specialisation seeds from its RHS
+  = return (nullUsage, spec_info)
+
+  | isNeverActive (idInlineActivation fn) -- See Note [Transfer activation]
+    || null arg_bndrs                     -- Only specialise functions
+  = case mb_unspec of    -- Behave as if there was a single, boring call
+      Just rhs_usg -> return (rhs_usg, SI specs spec_count Nothing)
+                         -- See Note [spec_usg includes rhs_usg]
+      Nothing      -> return (nullUsage, spec_info)
+
+  | Just all_calls <- lookupVarEnv bind_calls fn
+  = -- pprTrace "specialise entry {" (ppr fn <+> ppr (length all_calls)) $
+    do  { (boring_call, pats) <- callsToPats env specs arg_occs all_calls
 
                 -- Bale out if too many specialisations
         ; let n_pats      = length pats
@@ -1473,20 +1494,37 @@ 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)
                       _                          -> (spec_usg,                      mb_unspec)
 
-        ; return (new_usg, SI (new_specs ++ specs) spec_count' mb_unspec') } }
-  | otherwise
-  = return (nullUsage, spec_info)               -- The boring case
+--        ; pprTrace "specialise return }" (ppr fn
+--                                        <+> ppr (scu_calls new_usg))
+          ; return (new_usg, SI (new_specs ++ specs) spec_count' mb_unspec') } }
+
+
+  | otherwise  -- No new seeds, so return nullUsage
+  = return (nullUsage, spec_info)
 
 
 ---------------------
@@ -1588,6 +1626,16 @@ calcSpecStrictness fn qvars pats
     go_one env _         _ = env
 \end{code}
 
+Note [spec_usg includes rhs_usg]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+In calls to 'specialise', the returned ScUsage must include the rhs_usg in
+the passed-in SpecInfo, unless there are no calls at all to the function.
+
+The caller can, indeed must, assume this.  He should not combine in rhs_usg
+himself, or he'll get rhs_usg twice -- and that can lead to an exponential
+blowup of duplicates in the CallEnv.  This is what gave rise to the massive
+performace loss in Trac #8852.
+
 Note [Specialise original body]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 The RhsInfo for a binding keeps the *original* body of the binding.  We
@@ -1700,7 +1748,7 @@ callToPats :: ScEnv -> [ArgOcc] -> Call -> UniqSM (Maybe (CallPat, ValueEnv))
         --      Type variables come first, since they may scope
         --      over the following term variables
         -- The [CoreExpr] are the argument patterns for the rule
-callToPats env bndr_occs (con_env, args)
+callToPats env bndr_occs (Call _ args con_env)
   | length args < length bndr_occs      -- Check saturated
   = return Nothing
   | otherwise
diff --git a/compiler/typecheck/TcGenGenerics.lhs b/compiler/typecheck/TcGenGenerics.lhs
index 35bf4245dc..923d71f69a 100644
--- a/compiler/typecheck/TcGenGenerics.lhs
+++ b/compiler/typecheck/TcGenGenerics.lhs
@@ -491,10 +491,11 @@ tc_mkRepFamInsts gk tycon metaDts mod =
                      -- `appT` = D Int a b (data families case)
                      Just (famtycon, apps) ->
                        -- `fam` = D
-                       -- `apps` = [Int, a]
-                       let allApps = apps ++
-                                     drop (length apps + length tyvars
-                                           - tyConArity famtycon) tyvar_args
+                       -- `apps` = [Int, a, b]
+                       let allApps = case gk of
+                                       Gen0 -> apps
+                                       Gen1 -> ASSERT(not $ null apps)
+                                               init apps
                        in [mkTyConApp famtycon allApps]
                      -- `appT` = D a b (normal case)
                      Nothing -> [mkTyConApp tycon tyvar_args]
diff --git a/compiler/typecheck/TcSimplify.lhs b/compiler/typecheck/TcSimplify.lhs
index a5a03d1377..24d68c334a 100644
--- a/compiler/typecheck/TcSimplify.lhs
+++ b/compiler/typecheck/TcSimplify.lhs
@@ -815,39 +815,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
@@ -1008,6 +975,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
@@ -1053,8 +1094,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
@@ -1098,116 +1190,95 @@ 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.
 
-
 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]
-
-    type family F a :: *
-
-    h :: F Int -> ()
-    h = undefined
-
-    data TEx where
-      TEx :: a -> TEx
+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
 
+Some notes
 
-    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)
+* 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.
 
+  (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.
 
-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.
 
 
 *********************************************************************************
diff --git a/compiler/typecheck/TcSplice.lhs-boot b/compiler/typecheck/TcSplice.lhs-boot
index c496aed798..dccc6693f1 100644
--- a/compiler/typecheck/TcSplice.lhs-boot
+++ b/compiler/typecheck/TcSplice.lhs-boot
@@ -3,7 +3,6 @@ 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 +10,7 @@ import TcType   ( TcRhoType )
 import Annotations ( Annotation, CoreAnnTarget )
 
 #ifdef GHCI
+import Id       ( Id )
 import qualified Language.Haskell.TH as TH
 #endif
 
@@ -26,20 +26,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 1345696ba8..62a4dc68d7 100644
--- a/compiler/typecheck/TcTyClsDecls.lhs
+++ b/compiler/typecheck/TcTyClsDecls.lhs
@@ -1340,10 +1340,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 ()
@@ -1589,6 +1603,7 @@ checkValidClass cls
         ; checkValidTheta (ClassSCCtxt (className cls)) theta
 
           -- Now check for cyclic superclasses
+          -- If there are superclass cycles, checkClassCycleErrs bails.
         ; checkClassCycleErrs cls
 
         -- Check the class operations
@@ -1655,7 +1670,7 @@ checkFamFlag tc_name
   = do { idx_tys <- xoptM Opt_TypeFamilies
        ; checkTc idx_tys err_msg }
   where
-    err_msg = hang (ptext (sLit "Illegal family declaraion for") <+> quotes (ppr tc_name))
+    err_msg = hang (ptext (sLit "Illegal family declaration for") <+> quotes (ppr tc_name))
                  2 (ptext (sLit "Use TypeFamilies to allow indexed type families"))
 \end{code}
 
diff --git a/compiler/typecheck/TcValidity.lhs b/compiler/typecheck/TcValidity.lhs
index ebb375dd5e..7e73ee6289 100644
--- a/compiler/typecheck/TcValidity.lhs
+++ b/compiler/typecheck/TcValidity.lhs
@@ -290,7 +290,7 @@ check_type ctxt rank (AppTy ty1 ty2)
         ; check_arg_type ctxt rank ty2 }
 
 check_type ctxt rank ty@(TyConApp tc tys)
-  | isTypeSynonymTyCon tc  = check_syn_tc_app ctxt rank ty tc tys
+  | isSynTyCon 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
 
@@ -301,6 +301,9 @@ check_type _ _ ty = pprPanic "check_type" (ppr ty)
 ----------------------------------------
 check_syn_tc_app :: UserTypeCtxt -> Rank -> KindOrType 
                  -> TyCon -> [KindOrType] -> TcM ()
+-- Used for type synonyms and type synonym families,
+-- which must be saturated, 
+-- but not data families, which need not be saturated
 check_syn_tc_app ctxt rank ty tc tys
   | tc_arity <= n_args   -- Saturated
        -- Check that the synonym has enough args
diff --git a/compiler/types/Unify.lhs b/compiler/types/Unify.lhs
index f2b45e8099..2acbb2456a 100644
--- a/compiler/types/Unify.lhs
+++ b/compiler/types/Unify.lhs
@@ -415,6 +415,26 @@ 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
@@ -590,7 +610,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
diff --git a/configure.ac b/configure.ac
index 8f53bdfd2d..2414a2fd99 100644
--- a/configure.ac
+++ b/configure.ac
@@ -13,10 +13,10 @@ dnl
 # see what flags are available. (Better yet, read the documentation!)
 #
 
-AC_INIT([The Glorious Glasgow Haskell Compilation System], [7.8.3], [glasgow-haskell-bugs@haskell.org], [ghc])
+AC_INIT([The Glorious Glasgow Haskell Compilation System], [7.8.4], [glasgow-haskell-bugs@haskell.org], [ghc])
 
 # Set this to YES for a released version, otherwise NO
-: ${RELEASE=NO}
+: ${RELEASE=YES}
 
 # The primary version (e.g. 7.5, 7.4.1) is set in the AC_INIT line
 # above.  If this is not a released version, then we will append the
@@ -184,6 +184,56 @@ AC_SUBST([WithGhc])
 dnl ** Without optimization some INLINE trickery fails for GHCi
 SRC_CC_OPTS="-O"
 
+dnl ** Bug 9439: Some GHC 7.8 releases had broken LLVM code generator.
+dnl Unfortunately we don't know whether the user is going to request a
+dnl build with the LLVM backend as this is only given in build.mk.
+dnl
+dnl Instead, we try to do as much work as possible here, checking
+dnl whether -fllvm is the stage 0 compiler's default. If so we
+dnl fail. If not, we check whether -fllvm is affected explicitly and
+dnl if so set a flag. The build system will later check this flag
+dnl after the desired build flags are known.
+AC_MSG_CHECKING(whether bootstrap compiler is affected by bug 9439)
+echo "main = putStrLn \"%function\"" > conftestghc.hs
+
+# Check whether LLVM backend is default for this platform
+${WithGhc} conftestghc.hs 2>&1 >/dev/null
+res=`./conftestghc`
+if test "x$res" = "x%object"
+then
+    AC_MSG_RESULT(yes)
+    echo "Buggy bootstrap compiler"
+    echo ""
+    echo "The stage 0 compiler $WithGhc is affected by GHC Bug \#9439"
+    echo "and therefore will miscompile the LLVM backend if -fllvm is"
+    echo "used."
+    echo
+    echo "Please use another bootstrap compiler"
+    exit 1
+fi
+
+# -fllvm is not the default, but set a flag so the Makefile can check
+# -for it in the build flags later on
+${WithGhc} -fforce-recomp -fllvm conftestghc.hs 2>&1 >/dev/null
+if test $? = 0
+then
+    res=`./conftestghc`
+    if test "x$res" = "x%object"
+    then
+        AC_MSG_RESULT(yes)
+        GHC_LLVM_AFFECTED_BY_9439=1
+    elif test "x$res" = "x%function"
+    then
+        AC_MSG_RESULT(no)
+        GHC_LLVM_AFFECTED_BY_9439=0
+    else
+        AC_MSG_WARN(unexpected output $res)
+    fi
+else
+    AC_MSG_RESULT(failed to compile, assuming no)
+fi
+AC_SUBST([GHC_LLVM_AFFECTED_BY_9439])
+
 dnl--------------------------------------------------------------------
 dnl * Choose host(/target/build) platform
 dnl--------------------------------------------------------------------
diff --git a/docs/users_guide/7.8.4-notes.xml b/docs/users_guide/7.8.4-notes.xml
new file mode 100644
index 0000000000..7aab9a50b5
--- /dev/null
+++ b/docs/users_guide/7.8.4-notes.xml
@@ -0,0 +1,158 @@
+<?xml version="1.0" encoding="iso-8859-1"?>
+<sect1 id="release-7-8-4">
+  <title>Release notes for version 7.8.4</title>
+
+  <para>
+    The 7.8.4 release is a bugfix release. The major bugfixes relative
+    to 7.8.3 are listed below.
+  </para>
+
+  <sect2>
+    <title>GHC</title>
+
+    <itemizedlist>
+       <listitem>
+          <para>
+	    A critical bug in the LLVM backend which would cause the
+	    compiler to generate incorrect code has been fixed (issue
+	    #9439).
+          </para>
+       </listitem>
+       <listitem>
+          <para>
+	    Several bugs in the code generator have been fixed for
+	    unregisterised platforms, such as 64bit PowerPC (issue
+	    #8819 and #8849).
+          </para>
+       </listitem>
+       <listitem>
+          <para>
+	    A bug that could cause GHC's constructor specialization
+	    pass (enabled by default at <literal>-O2</literal>, or via
+	    <literal>-fspec-constr</literal>) to loop forever and
+	    consume large amounts of memory has been fixed (issue
+	    #8960).
+          </para>
+       </listitem>
+       <listitem>
+          <para>
+	    A bug that would cause GHC to fail when attempting to
+	    determine GCC's version information in non-english locales
+	    has been fixed (issue #8825).
+          </para>
+       </listitem>
+       <listitem>
+          <para>
+	    A minor bug that allowed GHC to seemingly import (but not
+	    use) private data constructors has been fixed (issue
+	    #9006).
+          </para>
+       </listitem>
+       <listitem>
+          <para>
+	    A bug in the register allocator which would cause GHC to
+	    crash during compilation has been fixed (issue #9303).
+          </para>
+       </listitem>
+       <listitem>
+          <para>
+	    A bug that caused the compiler to panic on some input C--
+	    code has been fixed (issue #9329).
+          </para>
+       </listitem>
+       <listitem>
+          <para>
+	    A few various minor deadlocks in the runtime system when
+	    using <literal>forkProcess</literal> have been fixed.
+          </para>
+       </listitem>
+       <listitem>
+          <para>
+	    A bug which made blocked STM transactions
+	    non-interruptible has been fixed (issue #9379).
+          </para>
+       </listitem>
+       <listitem>
+          <para>
+	    A bug in the compiler which broke pattern synonym imports
+	    across modules in Haddock has been fixed (issue #9417).
+          </para>
+       </listitem>
+       <listitem>
+          <para>
+	    A minor bug in the code generator in which the
+	    <literal>popCnt16#</literal> did not zero-extend its
+	    result has been fixed (issue #9435).
+          </para>
+       </listitem>
+       <listitem>
+          <para>
+	    A bug which caused the compiler to panic on pattern
+	    synonyms inside a class declaration has been fixed (issue
+	    #9705).
+          </para>
+       </listitem>
+       <listitem>
+          <para>
+	    A bug in the typechecker revolving around un-saturated
+	    type family applications has been fixed (issue #9433).
+          </para>
+       </listitem>
+       <listitem>
+          <para>
+            Several bugs have been fixed causing problems with
+            building GHC on ARM (issues #8951, #9620, #9336, and
+            #9552).
+          </para>
+       </listitem>
+       <listitem>
+          <para>
+            A bug in the typechecker that could cause an infinite loop
+            when using superclasses in a cycle has been fixed (issue #9415).
+          </para>
+       </listitem>
+       <listitem>
+          <para>
+            A bug causing corruption in signal handling with the
+            single-threaded runtime system has been fixed (issue
+            #9817).
+          </para>
+       </listitem>
+       <listitem>
+          <para>
+            A bug that could cause compiled programs to crash due to
+            use of overlapping type families has been fixed (issue
+            #9371).
+          </para>
+       </listitem>
+       <listitem>
+          <para>
+            A bug in the inliner that caused certain expressions
+            within unboxed tuples to not be properly evaluated has
+            been fixed (issue #9390).
+          </para>
+       </listitem>
+       <listitem>
+          <para>
+            A bug that caused the compiler to not always properly
+            detect LLVM tools (particularly on Windows) has been fixed
+            (issue #7143).
+          </para>
+       </listitem>
+       <listitem>
+          <para>
+            A bug that prevented GHC from deriving
+            <literal>Generic1</literal> instances for data families
+            has been fixed (#9563).
+          </para>
+       </listitem>
+       <listitem>
+          <para>
+            A bug that caused type inference to infer the incorrect
+            type in the presence of certain type families and
+            constraints has been fixed (issue #9316).
+          </para>
+       </listitem>
+    </itemizedlist>
+  </sect2>
+</sect1>
diff --git a/docs/users_guide/bugs.xml b/docs/users_guide/bugs.xml
index dba0d86630..8bb9772cc9 100644
--- a/docs/users_guide/bugs.xml
+++ b/docs/users_guide/bugs.xml
@@ -466,6 +466,15 @@ checking for duplicates.  The reason for this is efficiency, pure and simple.
 
     <itemizedlist>
       <listitem>
+	<para>GHC has a bug in 7.8 that causes the new extension
+	<literal>-XAutoDeriveTypeable</literal> to not take affect -
+	however, you can easily work around this by merely using
+	<literal>-XDeriveDataTypeable</literal> and using
+	<literal>deriving Typeable</literal> instead. See GHC issue
+	#9575.</para>
+      </listitem>
+
+      <listitem>
 	<para> GHC can warn about non-exhaustive or overlapping
         patterns (see <xref linkend="options-sanity"/>), and usually
         does so correctly.  But not always.  It gets confused by
diff --git a/docs/users_guide/intro.xml b/docs/users_guide/intro.xml
index fb7116ea7a..0bbc7acc44 100644
--- a/docs/users_guide/intro.xml
+++ b/docs/users_guide/intro.xml
@@ -310,6 +310,7 @@
 &relnotes1;
 &relnotes2;
 &relnotes3;
+&relnotes4;
 
 </chapter>
 
diff --git a/docs/users_guide/ug-ent.xml.in b/docs/users_guide/ug-ent.xml.in
index 5df3a041b9..ab5c54a103 100644
--- a/docs/users_guide/ug-ent.xml.in
+++ b/docs/users_guide/ug-ent.xml.in
@@ -6,6 +6,7 @@
 <!ENTITY relnotes1      SYSTEM "7.8.1-notes.xml" >
 <!ENTITY relnotes2      SYSTEM "7.8.2-notes.xml" >
 <!ENTITY relnotes3      SYSTEM "7.8.3-notes.xml" >
+<!ENTITY relnotes4      SYSTEM "7.8.4-notes.xml" >
 <!ENTITY using          SYSTEM "using.xml" >
 <!ENTITY code-gens      SYSTEM "codegens.xml" >
 <!ENTITY runtime        SYSTEM "runtime_control.xml" >
diff --git a/ghc/Main.hs b/ghc/Main.hs
index d8be08adc1..b633d065cf 100644
--- a/ghc/Main.hs
+++ b/ghc/Main.hs
@@ -704,7 +704,7 @@ showOptions = putStr (unlines availableOptions)
     where
       availableOptions     = map ((:) '-') $
                              getFlagNames mode_flags   ++
-                             getFlagNames flagsDynamic ++
+                             getFlagNames flagsAll ++
                              (filterUnwantedStatic . getFlagNames $ flagsStatic) ++
                              flagsStaticNames
       getFlagNames opts         = map getFlagName opts
diff --git a/includes/stg/SMP.h b/includes/stg/SMP.h
index 01663dd86e..7e39e5adf0 100644
--- a/includes/stg/SMP.h
+++ b/includes/stg/SMP.h
@@ -14,13 +14,13 @@
 #ifndef SMP_H
 #define SMP_H
 
-#if defined(THREADED_RTS)
-
 #if arm_HOST_ARCH && defined(arm_HOST_ARCH_PRE_ARMv6)
 void arm_atomic_spin_lock(void);
 void arm_atomic_spin_unlock(void);
 #endif
 
+#if defined(THREADED_RTS)
+
 /* ----------------------------------------------------------------------------
    Atomic operations
    ------------------------------------------------------------------------- */
diff --git a/libffi/ghc.mk b/libffi/ghc.mk
index bc62ad9721..4e177d24a4 100644
--- a/libffi/ghc.mk
+++ b/libffi/ghc.mk
@@ -69,6 +69,13 @@ $(libffi_STAMP_CONFIGURE): $(TOUCH_DEP)
 	mv libffi/build/Makefile.in libffi/build/Makefile.in.orig
 	sed "s/-MD/-MMD/" < libffi/build/Makefile.in.orig > libffi/build/Makefile.in
 
+	# We attempt to specify the installation directory below with --libdir,
+	# but libffi installs into 'toolexeclibdir' instead, which may differ
+	# on systems where gcc has multilib support. Force libffi to use libdir.
+	# (https://sourceware.org/ml/libffi-discuss/2014/msg00016.html)
+	mv libffi/build/Makefile.in libffi/build/Makefile.in.orig
+	sed 's:@toolexeclibdir@:$$(libdir):g' < libffi/build/Makefile.in.orig > libffi/build/Makefile.in
+
 	# Their cmd invocation only works on msys. On cygwin it starts
 	# a cmd interactive shell. The replacement works in both environments.
 	mv libffi/build/ltmain.sh libffi/build/ltmain.sh.orig
diff --git a/libraries/Cabal b/libraries/Cabal
-Subproject c226c0de042999bbe4c5c339c6c28a9be7f0c6d
+Subproject 5462f486f0ac344b5714382b1a7498ad6d85d08
diff --git a/mk/project.mk.in b/mk/project.mk.in
index 28692d4cbb..69ed88575e 100644
--- a/mk/project.mk.in
+++ b/mk/project.mk.in
@@ -157,3 +157,6 @@ SOLARIS_BROKEN_SHLD=@SOLARIS_BROKEN_SHLD@
 # Do we have a C compiler using an LLVM back end?
 CC_LLVM_BACKEND  = @CC_LLVM_BACKEND@
 CC_CLANG_BACKEND = @CC_CLANG_BACKEND@
+
+# Is the stage0 compiler affected by Bug #9439?
+GHC_LLVM_AFFECTED_BY_9439 = @GHC_LLVM_AFFECTED_BY_9439@
diff --git a/rts/Linker.c b/rts/Linker.c
index 47b4008386..ceb6a4f6d8 100644
--- a/rts/Linker.c
+++ b/rts/Linker.c
@@ -1090,6 +1090,7 @@ typedef struct _RtsSymbolVal {
       SymI_HasProto(__word_encodeFloat)                                 \
       SymI_HasProto(stg_atomicallyzh)                                   \
       SymI_HasProto(barf)                                               \
+      SymI_HasProto(deRefStablePtr)                                     \
       SymI_HasProto(debugBelch)                                         \
       SymI_HasProto(errorBelch)                                         \
       SymI_HasProto(sysErrorBelch)                                      \
diff --git a/rts/OldARMAtomic.c b/rts/OldARMAtomic.c
index b2c52fc1da..1ca635e500 100644
--- a/rts/OldARMAtomic.c
+++ b/rts/OldARMAtomic.c
@@ -5,6 +5,12 @@
  * Inefficient but necessary atomic locks used for implementing atomic
  * operations on ARM architectures pre-ARMv6.
  *
+ * These operations are not only referenced in the threaded RTS, but also in
+ * ghc (the library), via the operations in compiler/cbits/genSym.c.
+ * They are not actually called in a non-threaded environment, but we still
+ * need them in every RTS to make the linker happy, hence no
+ * #if defined(THREADED_RTS) here. See #8951.
+ *
  * -------------------------------------------------------------------------- */
 
 #include "PosixSource.h"
@@ -14,8 +20,6 @@
 #include <sched.h>
 #endif
 
-#if defined(THREADED_RTS)
-
 #if arm_HOST_ARCH && defined(arm_HOST_ARCH_PRE_ARMv6)
 
 static volatile int atomic_spin = 0;
@@ -51,6 +55,3 @@ void arm_atomic_spin_unlock()
 } 
 
 #endif  /* arm_HOST_ARCH && defined(arm_HOST_ARCH_PRE_ARMv6) */
-
-#endif  /* defined(THREADED_RTS) */
-
diff --git a/rts/Prelude.h b/rts/Prelude.h
index 89e80a0a3d..5923da229a 100644
--- a/rts/Prelude.h
+++ b/rts/Prelude.h
@@ -46,7 +46,7 @@ PRELUDE_CLOSURE(base_ControlziExceptionziBase_nestedAtomically_closure);
 PRELUDE_CLOSURE(base_GHCziConcziSync_runSparks_closure);
 PRELUDE_CLOSURE(base_GHCziConcziIO_ensureIOManagerIsRunning_closure);
 PRELUDE_CLOSURE(base_GHCziConcziIO_ioManagerCapabilitiesChanged_closure);
-PRELUDE_CLOSURE(base_GHCziConcziSignal_runHandlers_closure);
+PRELUDE_CLOSURE(base_GHCziConcziSignal_runHandlersPtr_closure);
 
 PRELUDE_CLOSURE(base_GHCziTopHandler_flushStdHandles_closure);
 
@@ -94,7 +94,7 @@ PRELUDE_INFO(base_GHCziStable_StablePtr_con_info);
 #define runSparks_closure         DLL_IMPORT_DATA_REF(base_GHCziConcziSync_runSparks_closure)
 #define ensureIOManagerIsRunning_closure DLL_IMPORT_DATA_REF(base_GHCziConcziIO_ensureIOManagerIsRunning_closure)
 #define ioManagerCapabilitiesChanged_closure DLL_IMPORT_DATA_REF(base_GHCziConcziIO_ioManagerCapabilitiesChanged_closure)
-#define runHandlers_closure       DLL_IMPORT_DATA_REF(base_GHCziConcziSignal_runHandlers_closure)
+#define runHandlersPtr_closure       DLL_IMPORT_DATA_REF(base_GHCziConcziSignal_runHandlersPtr_closure)
 
 #define flushStdHandles_closure   DLL_IMPORT_DATA_REF(base_GHCziTopHandler_flushStdHandles_closure)
 
diff --git a/rts/RtsStartup.c b/rts/RtsStartup.c
index 15e48a690d..24d50eedd0 100644
--- a/rts/RtsStartup.c
+++ b/rts/RtsStartup.c
@@ -214,7 +214,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)runHandlers_closure);
+    getStablePtr((StgPtr)runHandlersPtr_closure);
 #endif
 
     /* initialise the shared Typeable store */
diff --git a/rts/package.conf.in b/rts/package.conf.in
index 4c8686f262..a364fd38a0 100644
--- a/rts/package.conf.in
+++ b/rts/package.conf.in
@@ -106,7 +106,7 @@ ld-options:
          , "-Wl,-u,_base_GHCziConcziIO_ensureIOManagerIsRunning_closure"
          , "-Wl,-u,_base_GHCziConcziIO_ioManagerCapabilitiesChanged_closure"
          , "-Wl,-u,_base_GHCziConcziSync_runSparks_closure"
-         , "-Wl,-u,_base_GHCziConcziSignal_runHandlers_closure"
+         , "-Wl,-u,_base_GHCziConcziSignal_runHandlersPtr_closure"
 #else
            "-Wl,-u,ghczmprim_GHCziTypes_Izh_static_info"
          , "-Wl,-u,ghczmprim_GHCziTypes_Czh_static_info"
@@ -146,7 +146,7 @@ ld-options:
          , "-Wl,-u,base_GHCziConcziIO_ensureIOManagerIsRunning_closure"
          , "-Wl,-u,base_GHCziConcziIO_ioManagerCapabilitiesChanged_closure"
          , "-Wl,-u,base_GHCziConcziSync_runSparks_closure"
-         , "-Wl,-u,base_GHCziConcziSignal_runHandlers_closure"
+         , "-Wl,-u,base_GHCziConcziSignal_runHandlersPtr_closure"
 #endif
 
 /*  Pick up static libraries in preference over dynamic if in earlier search
diff --git a/rts/posix/Signals.c b/rts/posix/Signals.c
index f4a8341c6a..6ebbfd3d86 100644
--- a/rts/posix/Signals.c
+++ b/rts/posix/Signals.c
@@ -448,7 +448,7 @@ startSignalHandlers(Capability *cap)
 		       RtsFlags.GcFlags.initialStkSize, 
                        rts_apply(cap,
                                  rts_apply(cap,
-                                           &base_GHCziConcziSignal_runHandlers_closure,
+                                           &base_GHCziConcziSignal_runHandlersPtr_closure,
                                            rts_mkPtr(cap, info)),
                                  rts_mkInt(cap, info->si_signo))));
   }
diff --git a/rts/sm/Scav.c b/rts/sm/Scav.c
index 5b1e5d0fc8..1cc148216f 100644
--- a/rts/sm/Scav.c
+++ b/rts/sm/Scav.c
@@ -55,7 +55,12 @@ scavengeTSO (StgTSO *tso)
 
     // update the pointer from the InCall.
     if (tso->bound != NULL) {
-        tso->bound->tso = tso;
+        // NB. We can't just set tso->bound->tso = tso, because this
+        // might be an invalid copy the TSO resulting from multiple
+        // threads evacuating the TSO simultaneously (see
+        // Evac.c:copy_tag()).  Calling evacuate() on this pointer
+        // will ensure that we update it to point to the correct copy.
+        evacuate((StgClosure **)&tso->bound->tso);
     }
 
     saved_eager = gct->eager_promotion;
diff --git a/testsuite/mk/test.mk b/testsuite/mk/test.mk
index 0cc3f21c8a..ab059bf716 100644
--- a/testsuite/mk/test.mk
+++ b/testsuite/mk/test.mk
@@ -25,6 +25,13 @@ COMPILER     = ghc
 CONFIGDIR    = $(TOP)/config
 CONFIG       = $(CONFIGDIR)/$(COMPILER)
 
+ifeq "$(GhcUnregisterised)" "YES"
+    # Otherwise C backend generates many warnings about
+    # imcompatible proto casts for GCC's buitins:
+    #    memcpy, printf, strlen.
+    EXTRA_HC_OPTS += -optc-fno-builtin
+endif
+
 # TEST_HC_OPTS is passed to every invocation of TEST_HC 
 # in nested Makefiles
 TEST_HC_OPTS = -fforce-recomp -dcore-lint -dcmm-lint -dno-debug-output -no-user-$(GhcPackageDbFlag) -rtsopts $(EXTRA_HC_OPTS)
diff --git a/testsuite/tests/generics/T9563.hs b/testsuite/tests/generics/T9563.hs
new file mode 100644
index 0000000000..fd128658e9
--- /dev/null
+++ b/testsuite/tests/generics/T9563.hs
@@ -0,0 +1,18 @@
+{-# LANGUAGE TypeFamilies       #-}
+{-# LANGUAGE DeriveGeneric      #-}
+{-# LANGUAGE FlexibleInstances  #-}
+{-# LANGUAGE StandaloneDeriving #-}
+
+module T9563 where
+
+import GHC.Generics
+
+data family F typ :: * -> *
+data A
+data instance F A a = AData a
+  deriving (Generic, Generic1)
+
+data family G a b c d
+data instance G Int b Float d = H deriving Generic
+
+deriving instance Generic1 (G Int b Float)
diff --git a/testsuite/tests/generics/all.T b/testsuite/tests/generics/all.T
index 1231c61b34..df95fa604f 100644
--- a/testsuite/tests/generics/all.T
+++ b/testsuite/tests/generics/all.T
@@ -32,3 +32,4 @@ test('T7878', extra_clean(['T7878A.o'     ,'T7878A.hi'
 
 test('T8468', normal, compile_fail, [''])
 test('T8479', normal, compile, [''])
+test('T9563', normal, compile, [''])
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 0000000000..b5dfca6a94
--- /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 7c41be8afb..016444a138 100644
--- a/testsuite/tests/indexed-types/should_compile/all.T
+++ b/testsuite/tests/indexed-types/should_compile/all.T
@@ -244,3 +244,4 @@ 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/T9371.hs b/testsuite/tests/indexed-types/should_fail/T9371.hs
new file mode 100644
index 0000000000..cfec4c051f
--- /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 0000000000..695a7b4142
--- /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/T9433.hs b/testsuite/tests/indexed-types/should_fail/T9433.hs
new file mode 100644
index 0000000000..c7b6161f0d
--- /dev/null
+++ b/testsuite/tests/indexed-types/should_fail/T9433.hs
@@ -0,0 +1,15 @@
+{-# LANGUAGE
+     TypeFamilies
+   , KindSignatures
+   #-}
+
+module T9433 where
+
+type family Id x :: *
+type instance Id a = a
+
+type family Map (f :: * -> *) x :: *
+type instance Map f [a] = [f a]
+
+x :: Map Id [Bool]
+x = []
diff --git a/testsuite/tests/indexed-types/should_fail/T9433.stderr b/testsuite/tests/indexed-types/should_fail/T9433.stderr
new file mode 100644
index 0000000000..0b17f57a0f
--- /dev/null
+++ b/testsuite/tests/indexed-types/should_fail/T9433.stderr
@@ -0,0 +1,4 @@
+

+T9433.hs:14:6:

+    Type synonym ‘Id’ should have 1 argument, but has been given none

+    In the type signature for ‘x’: x :: Map Id [Bool]

diff --git a/testsuite/tests/indexed-types/should_fail/all.T b/testsuite/tests/indexed-types/should_fail/all.T
index 53405747ca..cca56db346 100644
--- a/testsuite/tests/indexed-types/should_fail/all.T
+++ b/testsuite/tests/indexed-types/should_fail/all.T
@@ -120,3 +120,5 @@ test('T8368', normal, compile_fail, [''])
 test('T8368a', normal, compile_fail, [''])
 test('T8518', normal, compile_fail, [''])
 test('T9160', normal, compile_fail, [''])
+test('T9433', normal, compile_fail, [''])
+test('T9371', normal, compile_fail, [''])
diff --git a/testsuite/tests/patsyn/should_fail/T9705.hs b/testsuite/tests/patsyn/should_fail/T9705.hs
new file mode 100644
index 0000000000..54d1d00e7f
--- /dev/null
+++ b/testsuite/tests/patsyn/should_fail/T9705.hs
@@ -0,0 +1,3 @@
+{-# LANGUAGE PatternSynonyms #-}
+class C a where
+    pattern P = ()
diff --git a/testsuite/tests/patsyn/should_fail/T9705.stderr b/testsuite/tests/patsyn/should_fail/T9705.stderr
new file mode 100644
index 0000000000..d9a3a495c9
--- /dev/null
+++ b/testsuite/tests/patsyn/should_fail/T9705.stderr
@@ -0,0 +1,4 @@
+
+T9705.hs:3:5:
+    Pattern synonyms not allowed in instance declarations
+      pattern P = ()
diff --git a/testsuite/tests/patsyn/should_fail/all.T b/testsuite/tests/patsyn/should_fail/all.T
index bff6bdf8c2..298f23bf2a 100644
--- a/testsuite/tests/patsyn/should_fail/all.T
+++ b/testsuite/tests/patsyn/should_fail/all.T
@@ -6,3 +6,4 @@ 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, [''])
+test('T9705', normal, compile_fail, [''])
diff --git a/testsuite/tests/rename/should_fail/T9006.hs b/testsuite/tests/rename/should_fail/T9006.hs
new file mode 100644
index 0000000000..8fc1e68847
--- /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 0000000000..dc82687453
--- /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 0000000000..fe8eeefa58
--- /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/all.T b/testsuite/tests/rename/should_fail/all.T
index bf48e14ede..f4c3570d3d 100644
--- a/testsuite/tests/rename/should_fail/all.T
+++ b/testsuite/tests/rename/should_fail/all.T
@@ -111,3 +111,6 @@ 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'])
diff --git a/testsuite/tests/rts/all.T b/testsuite/tests/rts/all.T
index 920368a0e3..1506f3ce10 100644
--- a/testsuite/tests/rts/all.T
+++ b/testsuite/tests/rts/all.T
@@ -49,6 +49,7 @@ test('T2783', [ omit_ways(['ghci']), exit_code(1) ], compile_and_run, [''])
 # Test the work-stealing deque implementation.  We run this test in
 # both threaded1 (-threaded -debug) and threaded2 (-threaded) ways.
 test('testwsdeque', [unless(in_tree_compiler(), skip),
+                    req_smp, # needs atomic 'cas'
                     c_src, only_ways(['threaded1', 'threaded2'])],
                     compile_and_run, ['-I../../../rts'])
 
@@ -176,6 +177,7 @@ test('stablename001', expect_fail_for(['hpc']), compile_and_run, [''])
 
 test('T7815', [ multi_cpu_race,
                 extra_run_opts('50000 +RTS -N2 -RTS'),
+                req_smp,
                 only_ways(['threaded1', 'threaded2']) ], compile_and_run, [''] )
 
 # ignore_output because it contains a unique:
diff --git a/testsuite/tests/simplCore/should_run/T9390.hs b/testsuite/tests/simplCore/should_run/T9390.hs
new file mode 100644
index 0000000000..04b4da0e4d
--- /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 0000000000..69349b451d
--- /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 ed7de1c461..606078cd40 100644
--- a/testsuite/tests/simplCore/should_run/all.T
+++ b/testsuite/tests/simplCore/should_run/all.T
@@ -65,3 +65,4 @@ test('T7924', exit_code(1), compile_and_run, [''])
 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/typecheck/should_fail/T9415.hs b/testsuite/tests/typecheck/should_fail/T9415.hs
new file mode 100644
index 0000000000..db77ff0a85
--- /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 0000000000..516759ee30
--- /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/all.T b/testsuite/tests/typecheck/should_fail/all.T
index 37546d6d8f..1248e031dd 100644
--- a/testsuite/tests/typecheck/should_fail/all.T
+++ b/testsuite/tests/typecheck/should_fail/all.T
@@ -330,3 +330,4 @@ test('T8570', extra_clean(['T85570a.o', 'T8570a.hi','T85570b.o', 'T8570b.hi']),
      multimod_compile_fail, ['T8570', '-v0'])
 test('T8603', normal, compile_fail, [''])
 test('T8912', normal, compile_fail, [''])
+test('T9415', normal, compile_fail, [''])